home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / d / k12enb.pal < prev    next >
Text File  |  2020-01-01  |  23KB  |  709 lines
  1. /    OS/8 BOO ENCODING PROGRAM
  2.  
  3. /    LAST EDIT:    01-OCT-1991    15:00:00    CJL
  4.  
  5. /    MAY BE ASSEMBLED WITH '/F' SWITCH SET.
  6.  
  7. /    PROGRAM TO ENCODE ANY  TYPE  OF  OS/8  FILE  INTO  "PRINTABLE"  ASCII (".BOO")
  8. /    FORMAT.  THIS IS A  COMMON  DISTRIBUTION FORMAT FOR MANY COLUMBIA KERMIT FILES
  9. /    AND IS AN ALTERNATIVE TO ENCODE FORMAT FOR PDP-8 AND DECMATE USERS.
  10.  
  11. /    DISTRIBUTED BY CUCCA AS "K12ENB.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE.
  12.  
  13. /    WRITTEN BY:
  14.  
  15. /    CHARLES LASNER (CJL)
  16. /    CLA SYSTEMS
  17. /    72-55 METROPOLITAN AVENUE
  18. /    MIDDLE VILLAGE, NEW YORK 11379-2107
  19. /    (718) 894-6499
  20.  
  21. /    USAGE:
  22.  
  23. /    .RUN DEV ENBOO        INVOKE PROGRAM
  24. /    *OUTPUT<INPUT        PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <CR>)
  25. /    *OUTPUT<INPUT$        PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <ESC>)
  26. /    .            PROGRAM EXITS NORMALLY
  27.  
  28. /    INPUT FILE ASSUMES .SV EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION.
  29.  
  30. /    PROGRAM EXIT  IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
  31. /    KEYBOARD DURING THE  COMMAND,  OR  ENDING THE COMMAND INPUT LINE WITH AN <ESC>
  32. /    CHARACTER.
  33.  
  34. /    THIS PROGRAM SUPPORTS THE .BOO FORMAT  FOR  FILE  ENCODING WHICH IS POPULAR IN
  35. /    OTHER  SYSTEMS.  THIS VERSION IMPLEMENTS THE  FILE  LENGTH  PROTECTION  SCHEME
  36. /    DEVELOPED BY CHARLES LASNER TO ENSURE PRECISE FILE LENGTH.
  37.  
  38. /    MANY .BOO PROGRAMS HAVE PROBLEMS MAINTAINING PRECISE FILE  LENGTH.  THE ACTUAL
  39. /    LENGTH  MAY  BE IMPRECISELY STATED BY ONE OR TWO  BYTES  DUE  TO  AN  INHERENT
  40. /    WEAKNESS  IN  THE  ORIGINAL .BOO ENCODING FORMAT DESIGN.  THIS  IMPLEMENTATION
  41. /    APPENDS CORRECTION BYTES AS NECESSARY TO THE BASIC .BOO FILE TO  ENSURE PROPER
  42. /    DECODING BY PROGRAMS COMPATIBLE WITH THIS EXTENSION.  
  43.  
  44. /    FILES CREATED BY THIS PROGRAM MAY BE  USED  WITH  EARLIER  .BOO DECODERS;  THE
  45. /    RESULTANT FILES MAY INACCURATELY RECREATE THE ORIGINAL FILES BY AS MUCH AS TWO
  46. /    EXTRANEOUS  TRAILING  BYTES.   THERE WILL BE NO PROBLEMS  (BEYOND  THE  LENGTH
  47. /    ANOMALY)  AS LONG AS THE DECODERS IMPLEMENT ZERO-LENGTH COMPRESSION FIELDS  AS
  48. /    NO  OPERATION.  IT IS POSSIBLE THAT CERTAIN DECODERS COULD ERRONEOUSLY  APPEND
  49. /    MASSIVE  QUANTITIES  OF  ZEROES  ONTO  THE END OF THE DECODED FILES, BUT  THIS
  50. /    ACTION WOULD CERTAINLY BE CAUSED BY DEFECTIVE PROGRAM CODE WITHIN THE DECODER.
  51. /    (ALTHOUGH NOT  LIKELY  SEEN  BEFORE  ENCOUNTERING FILES WITH LENGTH CORRECTION
  52. /    BYTES, THIS WOULD  BE  A  LATENT  BUG  IN  THESE  DECODING  PROGRAMS.  UPDATED
  53. /    VERSIONS SHOULD BE SOUGHT IF THIS PROBLEM SURFACES.)
  54. /    ERROR MESSAGES.
  55.  
  56. /    ERROR MESSAGES ARE ONE OF TWO VARIETIES:   COMMAND  DECODER  MESSAGES AND USER
  57. /    (PROGRAM-SIGNALLED) MESSAGES.
  58.  
  59. /    COMMAND  DECODER  MESSAGES  ARE  NON-FATAL  AND  MERELY  REQUIRE RETYPING  THE
  60. /    COMMAND.  ATTEMPTING TO USE MORE THAN ONE OUTPUT FILE  WILL  YIELD THE COMMAND
  61. /    DECODER  MESSAGE  "TOO MANY FILES" AND CAUSE A REPEAT OF THE  COMMAND  DECODER
  62. /    PROMPT REQUIRING  USER  INPUT.  THE USER IS DIRECTED TO OTHER DOCUMENTATION OF
  63. /    THE "SPECIAL" MODE  OF  THE  COMMAND DECODER, AS THAT IS THE ONLY MODE USED BY
  64. /    THIS UTILITY PROGRAM.
  65.  
  66. /    ANY USER MESSAGE PRINTED IS A  FATAL  ERROR MESSAGE CAUSED BY A PROBLEM BEYOND
  67. /    THE SCOPE OF THE COMMAND DECODER.   ALL  USER  MESSAGES  ARE THE STANDARD OS/8
  68. /    "USER" ERROR MESSAGES OF THE FORM:  "USER  ERROR  X  AT AAAAA", WHERE X IS THE
  69. /    ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE  THE  ERROR  WAS DETECTED.
  70. /    THE FOLLOWING USER ERRORS ARE DEFINED:
  71.  
  72. /    ERROR NUMBER        PROBABLE CAUSE
  73.  
  74. /    0            NO OUTPUT FILE.
  75.  
  76. /    1            INPUT FILE ERROR  (CAN'T  FIND INPUT FILE) OR NO INPUT
  77. /                FILE SPECIFIED OR TOO MANY INPUT FILES SPECIFIED.
  78. /    2            ILLEGAL OUTPUT FILE NAME (WILD CARDS NOT ALLOWED).
  79.  
  80. /    3            NO OUTPUT FILE NAME (DEVICE ONLY IS NOT ALLOWED).
  81.  
  82. /    4            ERROR WHILE FETCHING FILE HANDLER.
  83.  
  84. /    5            ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
  85.  
  86. /    6            OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
  87.  
  88. /    7            ERROR WHILE CLOSING THE OUTPUT FILE.
  89.  
  90. /    8            I/O ERROR WHILE ENCODING FILE DATA.
  91.  
  92. /    9            OUTPUT ERROR WHILE ENCODING FILE DATA.
  93.  
  94. /    ASSEMBLY INSTRUCTIONS.
  95.  
  96. /    IT IS  ASSUMED  THE  SOURCE  FILE  K12ENB.PAL  HAS  BEEN  MOVED AND RENAMED TO
  97. /    DSK:ENBOO.PA.
  98.  
  99. /    .PAL ENBOO<ENBOO/E/F    ASSEMBLE SOURCE PROGRAM
  100. /    .LOAD ENBOO        LOAD THE BINARY FILE
  101. /    .SAVE DEV ENBOO=2001    SAVE THE CORE-IMAGE FILE
  102. /    DEFINITIONS.
  103.  
  104.     CLOSE=    4        /CLOSE OUTPUT FILE
  105.     DECODE=    5        /CALL COMMAND DECODER
  106.     ENTER=    3        /ENTER TENTATIVE FILE
  107.     FETCH=    1        /FETCH HANDLER
  108.     IHNDBUF=7200        /INPUT HANDLER BUFFER
  109.     INBUFFE=6200        /INPUT BUFFER
  110.     INFILE=    7605        /INPUT FILE INFORMATION HERE
  111.     LOOKUP=    2        /LOOKUP INPUT FILE
  112.     NL0001=    CLA IAC        /LOAD AC WITH 0001
  113.     NL0002=    CLA CLL CML RTL    /LOAD AC WITH 0002
  114.     NL7776=    CLA CLL CMA RAL    /LOAD AC WITH 7776
  115.     NL7777=    CLA CMA        /LOAD AC WITH 7777
  116.     OHNDBUF=6600        /OUTPUT HANDLER BUFFER
  117.     OUTBUFF=5600        /OUTPUT BUFFER
  118.     OUTFILE=7600        /OUTPUT FILE INFORMATION HERE
  119.     PRGFLD=    00        /PROGRAM FIELD
  120.     RESET=    13        /RESET SYSTEM TABLES
  121.     SBOOT=    7600        /MONITOR EXIT
  122.     TBLFLD=    10        /COMMAND DECODER TABLE FIELD
  123.     TERMWRD=7642        /TERMINATOR WORD
  124.     USERROR=7        /USER SIGNALLED ERROR
  125.     USR=    0200        /USR ENTRY POINT
  126.     USRENT=    7700        /USR ENTRY POINT WHEN NON-RESIDENT
  127.     USRFLD=    10        /USR FIELD
  128.     USRIN=    10        /LOCK USR IN CORE
  129.     WIDTH=    114        /LINES MUST BE 76 WIDE OR LESS
  130.     WRITE=    4000        /I/O WRITE BIT
  131.     *0            /START AT THE BEGINNING
  132.  
  133.     *20            /GET PAST AUTO-INDEX AREA
  134.  
  135. BUFPTR,    .-.            /OUTPUT BUFFER POINTER
  136. CHAR,    .-.            /LATEST INPUT BYTE
  137. CHARPTR,.-.            /OUTPUT BYTE POINTER
  138. CHARS,    ZBLOCK    3        /OUTPUT BYTES HERE
  139. CMPCNT,    .-.            /MATCH COUNT FOR COMPRESSION
  140. COLUMN,    .-.            /LATEST COLUMN
  141. DANGCNT,.-.            /DANGER COUNT
  142. IDNUMBE,.-.            /INPUT DEVICE NUMBER
  143. IFNAME,    ZBLOCK    4        /INPUT FILENAME
  144. INLEN,    .-.            /INPUT FILE LENGTH
  145. INPTR,    .-.            /INPUT BUFFER POINTER
  146. INPUT,    .-.            /INPUT HANDLER POINTER
  147. INRECOR,.-.            /INPUT RECORD
  148. FNAME,    ZBLOCK    4        /OUTPUT FILENAME
  149. LATEST,    .-.            /LATEST OUTPUT CHARACTER
  150. ODNUMBE,.-.            /OUTPUT DEVICE NUMBER
  151. OUTPUT,    .-.            /OUTPUT HANDLER POINTER
  152. OUTRECO,.-.            /OUTPUT RECORD
  153. PIFTEMP,.-.            /PRINT INPUT FILENAME TEMPORARY
  154. TEMPTR,    .-.            /TEMPORARY POINTER
  155. THIRD,    .-.            /THIRD INPUT BYTE UNPACKING TEMPORARY
  156.     PAGE            /START AT THE USUAL PLACE
  157.  
  158. BEGIN,    NOP            /IN CASE WE'RE CHAINED TO
  159.     CLA            /CLEAN UP
  160. START,    CIF    USRFLD        /GOTO USR FIELD
  161.     JMS I    (USRENT)    /CALL USR ROUTINE
  162.     USRIN            /GET IT LOCKED IN
  163.     CIF    USRFLD        /GOTO USR FIELD
  164.     JMS I    [USR]        /CALL USR ROUTINE
  165.     DECODE            /WANT COMMAND DECODER
  166.     "*^100            /USING SPECIAL MODE
  167.     CDF    TBLFLD        /GOTO TABLE FIELD
  168.     TAD I    (TERMWRD)    /GET TERMINATOR WORD
  169.     SPA CLA            /SKIP IF <CR> TERMINATED THE LINE
  170.     DCA    EXITZAP        /ELSE CAUSE EXIT LATER
  171.     TAD I    (OUTFILE)    /GET OUTPUT FILE DEVICE WORD
  172.     SNA            /SKIP IF FIRST OUTPUT FILE PRESENT
  173.     JMP    TSTMORE        /JUMP IF NOT THERE
  174.     AND    [17]        /JUST DEVICE BITS
  175.     DCA    ODNUMBER    /SAVE OUTPUT DEVICE NUMBER
  176.     TAD I    (INFILE)    /GET FIRST INPUT FILE DEVICE WORD
  177.     SNA            /SKIP IF PRESENT
  178.     JMP    INERR        /JUMP IF NOT
  179.     AND    [17]        /JUST DEVICE BITS
  180.     DCA    IDNUMBER    /SAVE INPUT DEVICE NUMBER
  181.     TAD I    (INFILE+5)    /GET SECOND INPUT FILE DEVICE WORD
  182.     SZA CLA            /SKIP IF ONLY ONE INPUT FILE
  183.     JMP    INERR        /ELSE COMPLAIN
  184.     JMS I    (MIFNAME)    /MOVE INPUT FILENAME WITH ADJUSTED EXTENSION
  185.     TAD I    [OUTFILE+1]    /GET FIRST OUTPUT FILENAME WORD
  186.     SNA CLA            /SKIP IF NAME PRESENT
  187.     JMP    NONAME        /JUMP IF DEVICE ONLY
  188.     JMS I    (MOFNAME)    /MOVE OUTPUT FILENAME
  189.     CDF    PRGFLD        /BACK TO OUR FIELD
  190.     CIF    USRFLD        /GOTO USR FIELD
  191.     JMS I    [USR]        /CALL USR ROUTINE
  192.     RESET            /RESET SYSTEM TABLES
  193.     TAD    (OHNDBUFFER+1)    /GET BUFFER POINTER+TWO-PAGE BIT
  194.     DCA    OHPTR        /STORE IN-LINE
  195.     TAD    ODNUMBER    /GET OUTPUT DEVICE NUMBER
  196.     CIF    USRFLD        /GOTO USR FIELD
  197.     JMS I    [USR]        /CALL USR ROUTINE
  198.     FETCH            /FETCH HANDLER
  199. OHPTR,    .-.            /WILL BE BUFFER POINTER+TWO-PAGE BIT
  200.     JMP    FERROR        /FETCH ERROR
  201.     TAD    OHPTR        /GET RETURNED ADDRESS
  202.     DCA    OUTPUT        /STORE AS OUTPUT HANDLER ADDRESS
  203.     TAD    (IHNDBUFFER+1)    /GET INPUT BUFFER POINTER+TWO-PAGE BIT
  204.     DCA    IHPTR        /STORE IN-LINE
  205.     TAD    IDNUMBER    /GET INPUT DEVICE NUMBER
  206.     CIF    USRFLD        /GOTO USR FIELD
  207.     JMS I    [USR]        /CALL USR ROUTINE
  208.     FETCH            /FETCH HANDLER
  209. IHPTR,    .-.            /WILL BE BUFFER POINTER+TWO-PAGE BIT
  210.     JMP    FERROR        /FETCH ERROR
  211.     TAD    IHPTR        /GET RETURNED ADDRESS
  212.     DCA    INPUT        /STORE AS INPUT HANDLER ADDRESS
  213.     JMS I    (GEIFILE)    /GO LOOKUP INPUT FILE
  214.     TAD    (FNAME)        /POINT TO
  215.     DCA    ENTAR1        /STORED FILENAME
  216.     DCA    ENTAR2        /CLEAR SECOND ARGUMENT
  217.     TAD    ODNUMBER    /GET OUTPUT DEVICE NUMBER
  218.     CIF    USRFLD        /GOTO USR FIELD
  219.     JMS I    [USR]        /CALL USR ROUTINE
  220.     ENTER            /ENTER TENTATIVE FILENAME
  221. ENTAR1,    .-.            /WILL POINT TO FILENAME
  222. ENTAR2,    .-.            /WILL BE ZERO
  223.     JMP    ENTERR        /ENTER ERROR
  224.     TAD    ENTAR1        /GET RETURNED FIRST RECORD
  225.     DCA    OUTRECORD    /STORE IT
  226.     TAD    ENTAR2        /GET RETURNED EMPTY LENGTH
  227.     IAC            /ADD 2-1 FOR OS/278 CRAZINESS
  228.     DCA    DANGCNT        /STORE AS DANGER COUNT
  229.     JMS I    (ENCODIT)    /GO DO THE ACTUAL ENCODING
  230.     JMP    PROCERR        /ERROR WHILE ENCODING
  231.     TAD    ODNUMBER    /GET OUTPUT DEVICE NUMBER
  232.     CIF    USRFLD        /GOTO USR FIELD
  233.     JMS I    [USR]        /CALL USR ROUTINE
  234.     CLOSE            /CLOSE OUTPUT FILE
  235.     FNAME            /POINTER TO FILENAME
  236. OUTCNT,    .-.            /WILL BE ACTUAL COUNT
  237.     JMP    CLSERR        /CLOSE ERROR
  238. EXITZAP,JMP    START        /**** <ESC> TERMINATION **** 0000
  239.     JMP I    (SBOOT)        /EXIT TO MONITOR
  240. /    OUTPUT FILE ERROR WHILE PROCESSING.
  241.  
  242. ENCERRO,TAD    [3]        /SET INCREMENT
  243.     SKP            /DON'T USE NEXT
  244.  
  245. /    ERROR WHILE PROCESSING INPUT FILE.
  246.  
  247. PROCERR,NL0002            /SET INCREMENT
  248.     SKP            /DON'T USE NEXT
  249.  
  250. /    ERROR WHILE CLOSING THE OUTPUT FILE.
  251.  
  252. CLSERR,    NL0001            /SET INCREMENT
  253.     SKP            /DON'T CLEAR IT
  254.  
  255. /    OUTPUT FILE TOO LARGE ERROR.
  256.  
  257. SIZERR,    CLA            /CLEAN UP
  258.     TAD    [3]        /SET INCREMENT
  259.     SKP            /DON'T USE NEXT
  260.  
  261. /    ENTER ERROR.
  262.  
  263. ENTERR,    NL0002            /SET INCREMENT
  264.     SKP            /DON'T USE NEXT
  265.  
  266. /    HANDLER FETCH ERROR.
  267.  
  268. FERROR,    NL0001            /SET INCREMENT
  269.  
  270. /    NO OUTPUT FILENAME ERROR.
  271.  
  272. NONAME,    IAC            /SET INCREMENT
  273.  
  274. /    ILLEGAL OUTPUT FILE NAME ERROR.
  275.  
  276. BADNAME,IAC            /SET INCREMENT
  277.  
  278. /    INPUT FILESPEC ERROR.
  279.  
  280. INERR,    IAC            /SET INCREMENT
  281.  
  282. /    OUTPUT FILESPEC ERROR.
  283.  
  284. OUTERR,    DCA    ERRNUMBER    /STORE ERROR NUMBER
  285.     CDF    PRGFLD        /ENSURE OUR FIELD
  286.     CIF    USRFLD        /GOTO USR FIELD
  287.     JMS I    [USR]        /CALL USR ROUTINE
  288.     USERROR            /USER ERROR
  289. ERRNUMB,.-.            /WILL BE PASSED ERROR NUMBER
  290. /    COMES HERE TO TEST FOR NULL LINE.
  291.  
  292. TSTMORE,TAD I    (INFILE)    /GET FIRST INPUT FILE DEVICE WORD
  293.     SZA CLA            /SKIP NO INPUT OR OUTPUT GIVEN
  294.     JMP    OUTERR        /ELSE COMPLAIN
  295.     CDF    PRGFLD        /BACK TO OUR FIELD
  296.     JMP    EXITZAP        /MIGHT BE LAST TIME, SO GO THERE FIRST
  297.  
  298.     PAGE
  299. ENCODIT,.-.            /ENCODING ROUTINE
  300.     NL7777            /SETUP INITIALIZE VALUE
  301.     JMS I    [DOBYTE]    /INITIALIZE OUTPUT ROUTINE
  302.     JMS I    (PIFNAME)    /OUTPUT THE INPUT FILENAME
  303.     JMS I    (PCRLF)        /OUTPUT <CR>/<LF> AND CLEAR COLUMN COUNTER
  304.     DCA    CMPCNT        /CLEAR COMPRESSION
  305.     TAD    [CHARS]        /SETUP THE
  306.     DCA    CHARPTR        /OUTPUT POINTER
  307.     NL7777            /MAKE IT INITIALIZE
  308. LOOP,    JMS I    (GETBYTE)    /GET LATEST BYTE
  309.     JMP    ENDCHECK    /AREN'T ANY MORE, FINISH THE FILE
  310.  
  311. /    TEST IF ALREADY WITHIN A DEVELOPING COMPRESSION FIELD.
  312.  
  313.     TAD    CMPCNT        /GET COMPRESSION COUNT
  314.     SNA CLA            /SKIP IF COMPRESSION IN PROGRESS
  315.     JMP    NOCOMP        /JUMP IF NOT
  316.  
  317. /    CHECK IF LATEST INPUT BYTE IS ZERO.
  318.  
  319.     TAD    CHAR        /GET LATEST
  320.     SZA CLA            /SKIP IF SO
  321.     JMP    ENDCOMPRESS    /JUMP IF NOT
  322. SETCOMP,ISZ    CMPCNT        /BUMP COMPRESSION COUNT
  323.     TAD    CMPCNT        /GET LATEST COUNT
  324.     TAD    (-116)        /COMPARE TO MAXIMUM ALLOWED
  325.     SNA CLA            /SKIP IF NOT
  326.     JMS I    (COMPRESSOUT)     /OUTPUT MAXIMUM COMPRESSION AND CANCEL COMPRESSION
  327.     JMP    LOOP        /GO GET ANOTHER ONE
  328.  
  329. /    IF LATEST IS NON-ZERO, THEN COMPLETE EXISTING COMPRESSION FIELD.
  330.  
  331. ENDCOMP,NL7777            /-1
  332.     TAD    CMPCNT        /COMPARE TO COMPRESSION COUNT
  333.     SZA CLA            /SKIP IF TRIVIAL CASE
  334.     JMP    OUTCOMPRESS    /JUMP IF NOT
  335.  
  336. /    CANCEL TRIVIAL CASE OF ONE BYTE COMPRESSION.
  337.  
  338.     DCA    CMPCNT        /CLEAR COMPRESSION MODE
  339.     DCA    CHARS        /FIRST BYTE WAS ZERO
  340.     TAD    (CHARS+1)    /SETUP OUTPUT POINTER TO
  341.     DCA    CHARPTR        /STORE INTO SECOND BYTE
  342.     JMP    BYTEINSERT    /CONTINUE THERE
  343. /    OUTPUT LATEST COMPRESSION AND PROCESS NEW NON-ZERO BYTE.
  344.  
  345. OUTCOMP,JMS I    (COMPRESSOUT)    /OUTPUT COMPRESSION FIELD AND CANCEL COMPRESSION
  346.  
  347. /    COMES HERE IF NOT WITHIN A COMPRESSION REGION.
  348.  
  349. NOCOMP,    TAD    CHARPTR        /GET POINTER
  350.     TAD    (-CHARS)    /CHECK IF AT BEGINNING
  351.     SZA CLA            /SKIP IF BUFFER EMPTY
  352.     JMP    BYTEINSERT    /JUMP IF NOT
  353.  
  354. /    IF AT BEGINNING OF THREE BYTES, TEST IF LATEST STARTS A COMPRESSION FIELD.
  355.  
  356.     TAD    CHAR        /GET LATEST BYTE
  357.     SNA CLA            /SKIP IF NOT ZERO
  358.     JMP    SETCOMPRESSION    /JUMP IF SO
  359. BYTEINS,TAD    CHAR        /GET LATEST BYTE
  360.     DCA I    CHARPTR        /STORE IT
  361.     ISZ    CHARPTR        /BUMP TO NEXT
  362.     TAD    CHARPTR        /GET THE UPDATED POINTER
  363.     TAD    (-CHARS-2-1)    /COMPARE TO UPPER LIMIT
  364.     SNA CLA            /SKIP IF LESS THAN THREE PRESENT
  365.     JMS I    (OUT3)        /ELSE OUTPUT THE THREE BYTES AND RESET THE BUFFER
  366.     JMP    LOOP        /GO GET ANOTHER ONE
  367.  
  368. /    COMES HERE AT END OF INPUT.
  369.  
  370. ENDCHEC,NL7776            /-2
  371.     TAD    CMPCNT        /COMPARE TO COMPRESSION COUNT
  372.     SMA            /SKIP IF AT TRIVIAL CASE OR NO COMPRESSION CURRENTLY
  373.     JMP    ENDFCOMPRESS    /FINISH WITH A COMPRESSION FIELD
  374.     IAC            /CHECK FURTHER
  375.     SZA CLA            /SKIP IF TRIVIAL COMPRESSION AT END
  376.     JMP    NORMEND        /JUMP IF NOT WITHIN COMPRESSION
  377.  
  378. /    THE TRIVIAL CASE  CONVERTS  TO  AN INCOMPLETE OUTPUT, COMPLETE WITH CORRECTION
  379. /    BYTES TO INDICATE THE SHORT FIELD.
  380.  
  381.     DCA    CHARS        /MOVE ZERO BYTE TO FIRST POSITION
  382. NORM1,    DCA    CHARS+1        /CLEAR SECOND POSITION
  383.     DCA    CHARS+2        /CLEAR THIRD POSITION
  384.     JMS I    (OUT3)        /OUTPUT THE THREE BYTES
  385.     DCA    CMPCNT        /CLEAR COMPRESSION COUNT
  386.     JMS I    (COMPRESSOUT)    /OUTPUT NULL COMPRESSION FIELD TO CANCEL THIRD BYTE
  387.                 /NEXT WILL CANCEL SECOND BYTE
  388.  
  389. /    COMES HERE IF FILE ENDS ON A COMPRESSION FIELD.
  390.  
  391. ENDFCOM,JMS I    (COMPRESSOUT)    /OUTPUT COMPRESSION FIELD AND CANCEL COMPRESSION
  392.     JMP    CLOSFILE    /FINISH IT THERE
  393. /    COMES HERE IF FILE ENDS IN SOME FORM OF DATA FIELD.
  394.  
  395. NORMEND,TAD    CHARPTR        /GET CHARACTER POINTER
  396.     TAD    (-CHARS-2)    /COMPARE TO TWO PRESENT VALUE
  397.     SNA            /SKIP IF NOT THE CASE
  398.     JMP    NORM2        /JUMP IF SO
  399.     IAC            /BUMP TO ONE PRESENT VALUE
  400.     SNA CLA            /SKIP IF NOT THE CASE
  401.     JMP    NORM1        /JUMP IF SO
  402. CLOSFIL,TAD    COLUMN        /GET CURRENT COLUMN COUNTER
  403.     SZA CLA            /SKIP IF AT BEGINNING ALREADY
  404.     JMS I    (PCRLF)        /ELSE OUTPUT <CR>/<LF> NOW
  405.     TAD    ("Z&37)        /GET <^Z>
  406. CLOSLUP,JMS I    [DOBYTE]    /OUTPUT A BYTE (^Z OR NULL)
  407.     TAD    BUFPTR        /GET THE OUTPUT BUFFER POINTER
  408.     TAD    (-OUTBUFFER)    /COMPARE TO RESET VALUE
  409.     SZA CLA            /SKIP IF IT MATCHES
  410.     JMP    CLOSLUP        /ELSE KEEP GOING
  411.     ISZ    ENCODIT        /NO ERRORS
  412.     JMP I    ENCODIT        /RETURN
  413.  
  414. /    COMES HERE IF FILE ENDS WITH ONLY TWO DATA CHARACTERS.
  415.  
  416. NORM2,    DCA    CHARS+2        /CLEAR THIRD CHARACTER
  417.     JMS I    (OUT3)        /OUTPUT THE THREE BYTES
  418.     JMP    ENDFCOMPRESS    /FINISH IT THERE
  419.  
  420.     PAGE
  421. /    GET AN INPUT BYTE ROUTINE.
  422.  
  423. GETBYTE,.-.                /GET A BYTE ROUTINE
  424.     SNA CLA                /INITIALIZING?
  425.     JMP I    PUTC            /NO, GO GET NEXT BYTE
  426.     TAD    INRECORD        /GET INPUT FILE STARTING RECORD
  427.     DCA    GETRECORD        /STORE IN-LINE
  428. GETNEWR,JMS I    INPUT            /CALL INPUT HANDLER
  429.     2^100                /READ TWO PAGES
  430. PINBUFF,INBUFFER            /INTO INPUT BUFFER
  431. GETRECO,.-.                /WILL BE LATEST INPUT FILE RECORD
  432.     JMP I    (PROCERR)        /INPUT READ ERROR, GO COMPLAIN
  433.     TAD    PINBUFFER/(INBUFFER)    /SETUP THE
  434.     DCA    INPTR            /BUFFER POINTER
  435. GETLOOP,DCA    THIRD            /CLEAR THIRD BYTE NOW
  436.     JMS    PUTONE            /OBTAIN AND SEND BACK FIRST BYTE
  437.     JMS    PUTONE            /OBTAIN AND SEND BACK SECOND BYTE
  438.     TAD    THIRD            /GET THIRD BYTE
  439.     JMS    PUTC            /SEND IT BACK
  440.     TAD    INPTR            /GET THE POINTER
  441.     TAD    (-2^200-INBUFFER)    /COMPARE TO LIMIT
  442.     SZA CLA                /SKIP IF AT END
  443.     JMP    GETLOOP            /KEEP GOING
  444.     ISZ    GETRECORD        /BUMP TO NEXT RECORD
  445.     NOP                /JUST IN CASE
  446.     ISZ    INLEN            /DONE ALL INPUT RECORDS?
  447.     JMP    GETNEWRECORD        /NO, KEEP GOING
  448.  
  449. /    AT END-OF-FILE, SO JUST TAKE IMMEDIATE RETURN.
  450.  
  451.     JMP I    GETBYTE            /RETURN TO CALLER
  452.  
  453. PUTONE,    .-.                /SEND BACK A BYTE ROUTINE
  454.     TAD I    INPTR            /GET LATEST WORD
  455.     AND    [7400]            /JUST THIRD-BYTE NYBBLE
  456.     CLL RAL                /MOVE UP
  457.     TAD    THIRD            /GET OLD NYBBLE (IF ANY)
  458.     RTL;RTL                /MOVE UP NYBBLE BITS
  459.     DCA    THIRD            /SAVE FOR NEXT TIME
  460.     TAD I    INPTR            /GET LATEST WORD AGAIN
  461.     JMS    PUTC            /SEND BACK CURRENT BYTE
  462.     ISZ    INPTR            /BUMP TO NEXT WORD
  463.     JMP I    PUTONE            /RETURN
  464.  
  465. PUTC,    .-.                /SEND BACK LATEST BYTE ROUTINE
  466.     AND    (377)            /KEEP ONLY GOOD BITS
  467.     DCA    CHAR            /SAVE AS LATEST BYTE
  468.     ISZ    GETBYTE            /BUMP PAST <EOF> RETURN
  469.     JMP I    GETBYTE            /RETURN TO MAIN CALLER
  470. /    COMPRESSION FIELD OUTPUT ROUTINE.
  471.  
  472. COMPRES,.-.            /COMPRESSION OUTPUT ROUTINE
  473.     CLA            /CLEAN UP
  474.     TAD    COLUMN        /GET CURRENT COLUMN COUNTER
  475.     TAD    (-WIDTH+2)    /COMPARE TO UPPER LIMIT
  476.     SMA SZA CLA        /SKIP IF NOT ABOVE LIMIT
  477.     JMS    PCRLF        /ELSE DO <CR>/<LF> FIRST
  478.     TAD    (176)        /GET TILDE VALUE
  479.     JMS I    [DOBYTE]    /OUTPUT IT
  480.     TAD    CMPCNT        /GET COMPRESSION COUNT
  481.     JMS    PDIGIT        /OUTPUT IT
  482.     DCA    CMPCNT        /CLEAR COMPRESSION
  483.     JMP I    COMPRESSOUT    /RETURN
  484.  
  485. /    DATA FIELD OUTPUT ROUTINE.
  486.  
  487. OUT3,    .-.            /OUTPUT THREE BYTES ROUTINE
  488.     TAD    COLUMN        /GET CURRENT COLUMN COUNTER
  489.     TAD    (-WIDTH+4)    /COMPARE TO UPPER LIMIT
  490.     SMA SZA CLA        /SKIP IF NOT ABOVE LIMIT
  491.     JMS    PCRLF        /ELSE DO <CR>/<LF> FIRST
  492.     TAD    CHARS        /GET FIRST BYTE
  493.     RTR            /WANT HIGH SIX BITS FIRST
  494.     JMS    PDIGIT        /OUTPUT THEM
  495.     TAD    CHARS        /GET IT AGAIN
  496.     AND    [3]        /JUST TWO LOWEST BITS
  497.     CLL RTR;RTR;RAR        /MOVE UP
  498.     TAD    CHARS+1        /GET SECOND BYTE
  499.     RTR;RTR            /MOVE DOWN
  500.     JMS    PDIGIT        /OUTPUT THEM
  501.     TAD    CHARS+2        /GET THIRD BYTE
  502.     AND    (300)        /JUST TWO HIGHEST BITS NEEDED
  503.     CLL RTL;RTL;RAL        /MOVE INTO POSITION
  504.     TAD    CHARS+1        /GET SECOND BYTE
  505.     RTL            /MOVE UP
  506.     AND    [77]        /JUST DESIRED BITS
  507.     JMS    PDIGIT        /OUTPUT THEM
  508.     TAD    CHARS+2        /GET THIRD BYTE
  509.     AND    [77]        /JUST SIX BITS
  510.     JMS    PDIGIT        /OUTPUT THEM
  511.     TAD    [CHARS]        /RESET THE
  512.     DCA    CHARPTR        /OUTPUT POINTER
  513.     JMP I    OUT3        /RETURN
  514.  
  515. PDIGIT,    .-.            /PRINT AS A DIGIT INTO FILE ROUTINE
  516.     AND    [177]        /REMOVE JUNK BITS
  517.     TAD    ("0&177)    /TURN PASSED VALUE INTO A DIGIT
  518.     JMS I    [DOBYTE]    /OUTPUT IT
  519.     JMP I    PDIGIT        /RETURN
  520. PCRLF,    .-.            /PRINT <CR>/<LF> INTO FILE ROUTINE
  521.     TAD    ("M&37)        /GET A <CR>
  522.     JMS I    [DOBYTE]    /OUTPUT IT
  523.     TAD    ("J&37)        /GET A <LF>
  524.     JMS I    [DOBYTE]    /OUTPUT IT
  525.     DCA    COLUMN        /CLEAR COLUMN COUNTER
  526.     JMP I    PCRLF        /RETURN
  527.  
  528.     PAGE
  529. PUTBYTE,.-.            /OUTPUT A BYTE ROUTINE
  530.     SPA            /ARE WE INITIALIZING?
  531.     JMP    PUTINITIALIZE    /YES
  532.     AND    [177]        /JUST IN CASE
  533.     DCA    LATEST        /SAVE LATEST CHARACTER
  534.     TAD    LATEST        /GET LATEST CHARACTER
  535.     JMP I    PUTNEXT        /GO WHERE YOU SHOULD GO
  536.  
  537. PUTNEXT,.-.            /EXIT ROUTINE
  538.     ISZ    PUTBYTE        /BUMP TO GOOD RETURN
  539. PUTERRO,CLA CLL            /CLEAN UP
  540.     JMP I    PUTBYTE        /RETURN TO MAIN CALLER
  541.  
  542. PUTINIT,CLA            /CLEAN UP
  543.     TAD    OUTRECORD    /GET STARTING RECORD OF TENTATIVE FILE
  544.     DCA    PUTRECORD    /STORE IN-LINE
  545.     DCA I    (OUTCNT)    /CLEAR ACTUAL FILE LENGTH
  546. PUTNEWR,TAD    (OUTBUFFER)    /SETUP THE
  547.     DCA    BUFPTR        /BUFFER POINTER
  548. PUTLOOP,JMS    PUTNEXT        /GET A CHARACTER
  549.     DCA I    BUFPTR        /STORE IT
  550.     TAD    BUFPTR        /GET POINTER VALUE
  551.     DCA    TEMPTR        /SAVE FOR LATER
  552.     ISZ    BUFPTR        /BUMP TO NEXT
  553.     JMS    PUTNEXT        /GET A CHARACTER
  554.     DCA I    BUFPTR        /STORE IT
  555.     JMS    PUTNEXT        /GET A CHARACTER
  556.     RTL;RTL            /MOVE UP
  557.     AND    [7400]        /ISOLATE HIGH NYBBLE
  558.     TAD I    TEMPTR        /ADD ON FIRST BYTE
  559.     DCA I    TEMPTR        /STORE COMPOSITE
  560.     TAD    LATEST        /GET LATEST CHARACTER
  561.     RTR;RTR;RAR        /MOVE UP AND
  562.     AND    [7400]        /ISOLATE LOW NYBBLE
  563.     TAD I    BUFPTR        /ADD ON SECOND BYTE
  564.     DCA I    BUFPTR        /STORE COMPOSITE
  565.     ISZ    BUFPTR        /BUMP TO NEXT
  566.     TAD    BUFPTR        /GET LATEST POINTER VALUE
  567.     TAD    (-2^200-OUTBUFF)/COMPARE TO LIMIT
  568.     SZA CLA            /SKIP IF AT END
  569.     JMP    PUTLOOP        /KEEP GOING
  570.     ISZ    DANGCNT        /TOO MANY RECORDS?
  571.     SKP            /SKIP IF NOT
  572.     JMP I    (SIZERR)    /JUMP IF SO
  573.     JMS I    OUTPUT        /CALL I/O HANDLER
  574.     2^100+WRITE        /WRITE SOME PAGES FROM OUTPUT BUFFER
  575.     OUTBUFFER        /BUFFER ADDRESS
  576. PUTRECO,.-.            /WILL BE LATEST RECORD NUMBER
  577.     JMP    PUTERROR    /OUTPUT ERROR!
  578.     ISZ I    (OUTCNT)    /BUMP ACTUAL LENGTH
  579.     ISZ    PUTRECORD    /BUMP TO NEXT RECORD
  580.     JMP    PUTNEWRECORD    /KEEP GOING
  581. /    INPUT FILENAME MOVE ROUTINE; USES DEFAULT EXTENSION IF NONE PROVIDED BY USER.
  582.  
  583. MIFNAME,.-.            /MOVE INPUT FILENAME ROUTINE
  584.     TAD I    (INFILE+1)    /GET FIRST INPUT FILENAME WORD
  585.     DCA    IFNAME        /STASH IT
  586.     TAD I    (INFILE+2)    /GET SECOND INPUT FILENAME WORD
  587.     DCA    IFNAME+1    /STASH IT
  588.     TAD I    (INFILE+3)    /GET THIRD INPUT FILENAME WORD
  589.     DCA    IFNAME+2    /STASH IT
  590.     TAD I    [INFILE+4]    /GET FOURTH INPUT FILENAME WORD
  591.     SNA            /SKIP IF SOMETHING THERE
  592.     TAD    ("S^100+"V-300)    /ELSE USE DEFAULT EXTENSION VALUE
  593.     DCA    IFNAME+3    /STASH IT EITHER WAY
  594.     JMP I    MIFNAME        /RETURN
  595.  
  596. DOBYTE,    .-.            /OUTPUT A BYTE ROUTINE
  597.     JMS    PUTBYTE        /OUTPUT PASSED VALUE
  598.     JMP I    (ENCERROR)    /COULDN'T DO IT
  599.     ISZ    COLUMN        /BUMP COLUMN COUNTER
  600.     JMP I    DOBYTE        /RETURN
  601.  
  602.     PAGE
  603. /    INPUT FILE ROUTINE.
  604.  
  605. GEIFILE,.-.            /GET INPUT FILE ROUTINE
  606.     JMS    LUKUP        /TRY TO LOOKUP THE FILE
  607.     SKP            /SKIP IF IT WORKED
  608.     JMP    TRYNULL        /TRY NULL EXTENSION VERSION
  609. NULLOK,    TAD    LARG1        /GET FIRST INPUT RECORD
  610.     DCA    INRECORD    /STASH IT
  611.     TAD    LARG2        /GET NEGATED LENGTH
  612.     DCA    INLEN        /STASH IT
  613.     JMP I    GEIFILE        /RETURN
  614.  
  615. /    COMES HERE IF LOOKUP FAILED.
  616.  
  617. TRYNULL,CDF    TBLFLD        /GOTO TABLE FIELD
  618.     TAD I    [INFILE+4]    /GET ORIGINAL FILENAME'S EXTENSION
  619.     CDF    PRGFLD        /BACK TO OUR FIELD
  620.     SZA CLA            /SKIP IF IT WAS NULL ORIGINALLY
  621.     JMP I    (INERR)        /ELSE COMPLAIN OF EXPLICIT LOOKUP FAILURE
  622.     DCA    IFNAME+3    /NOW TRY NULL VERSION INSTEAD OF DEFAULT VERSION
  623.     JMS    LUKUP        /TRY TO LOOK IT UP AGAIN
  624.     JMP    NULLOK        /THAT WORKED!
  625.     JMP I    (INERR)        /COMPLAIN OF LOOKUP FAILURE
  626.  
  627. LUKUP,    .-.            /LOW-LEVEL LOOKUP ROUTINE
  628.     TAD    (IFNAME)    /GET OUR FILENAME POINTER
  629.     DCA    LARG1        /STORE IN-LINE
  630.     DCA    LARG2        /CLEAR SECOND ARGUMENT
  631.     TAD    IDNUMBER    /GET INPUT DEVICE NUMBER
  632.     CIF    USRFLD        /GOTO USR FIELD
  633.     JMS I    [USR]        /CALL USR ROUTINE
  634.     LOOKUP            /WANT LOOKUP FUNCTION
  635. LARG1,    .-.            /WILL BE POINTER TO OUR FILENAME
  636. LARG2,    .-.            /WILL RETURN FILE LENGTH (HOPEFULLY)
  637.     ISZ    LUKUP        /LOOKUP FAILED, SO BUMP RETURN ADDRESS
  638.     JMP I    LUKUP        /RETURN EITHER WAY
  639. /    INPUT FILENAME PRINT ROUTINE.
  640.  
  641. PIFNAME,.-.            /PRINT INPUT FILENAME ROUTINE
  642.     TAD    IFNAME        /GET FIRST PAIR
  643.     JMS    PIF2        /PRINT IT
  644.     TAD    IFNAME+1    /GET SECOND PAIR
  645.     JMS    PIF2        /PRINT IT
  646.     TAD    IFNAME+2    /GET THIRD PAIR
  647.     JMS    PIF2        /PRINT IT
  648.     TAD    (".&177)    /GET SEPARATOR
  649.     JMS    PIFOUT        /PRINT IT
  650.     TAD    IFNAME+3    /GET FOURTH PAIR
  651.     JMS    PIF2        /PRINT IT
  652.     JMP I    PIFNAME        /RETURN
  653.  
  654. PIF2,    .-.            /PRINT A PAIR ROUTINE
  655.     DCA    PIFTEMP        /SAVE PASSED PAIR
  656.     TAD    PIFTEMP        /GET IT BACK
  657.     RTR;RTR;RTR        /MOVE DOWN
  658.     JMS    PIFOUT        /PRINT HIGH-ORDER FIRST
  659.     TAD    PIFTEMP        /GET IT AGAIN
  660.     JMS    PIFOUT        /PRINT LOW-ORDER
  661.     JMP I    PIF2        /RETURN
  662.  
  663. PIFOUT,    .-.            /FILENAME CHARACTER OUTPUT ROUTINE
  664.     AND    [77]        /JUST SIXBIT
  665.     SNA            /SKIP IF SOMETHING THERE
  666.     JMP I    PIFOUT        /ELSE IGNORE IT
  667.     TAD    [40]        /INVERT IT
  668.     AND    [77]        /REMOVE EXCESS
  669.     TAD    [40]        /INVERT IT AGAIN
  670.     JMS I    [DOBYTE]    /OUTPUT IT
  671.     JMP I    PIFOUT        /RETURN
  672.  
  673. MOFNAME,.-.            /MOVE OUTPUT FILENAME ROUTINE
  674.     TAD I    [OUTFILE+1]    /GET FIRST OUTPUT FILENAME WORD
  675.     JMS    CHKNAME        /CHECK IF LEGAL
  676.     DCA    FNAME        /STASH IT
  677.     TAD I    (OUTFILE+2)    /GET SECOND OUTPUT FILENAME WORD
  678.     JMS    CHKNAME        /CHECK IF LEGAL
  679.     DCA    FNAME+1        /STASH IT
  680.     TAD I    (OUTFILE+3)    /GET THIRD OUTPUT FILENAME WORD
  681.     JMS    CHKNAME        /CHECK IF LEGAL
  682.     DCA    FNAME+2        /STASH IT
  683.     TAD I    (OUTFILE+4)    /GET FOURTH OUTPUT FILENAME WORD
  684.     JMS    CHKNAME        /CHECK IF LEGAL
  685.     DCA    FNAME+3        /STASH IT
  686.     JMP I    MOFNAME        /RETURN
  687. /    OUTPUT NAME CHECK ROUTINE.
  688.  
  689. CHKNAME,.-.            /OUTPUT NAME CHECK ROUTINE
  690.     DCA    LUKUP        /SAVE PASSED VALUE
  691.     TAD    LUKUP        /GET IT BACK
  692.     RTR;RTR;RTR        /MOVE DOWN
  693.     JMS    CHKIT        /CHECK HIGH-ORDER AND GET IT BACK
  694.     JMS    CHKIT        /CHECK LOW-ORDER AND GET IT BACK
  695.     JMP I    CHKNAME        /RETURN
  696.  
  697. CHKIT,    .-.            /ONE CHARACTER CHECK ROUTINE
  698.     AND    [77]        /JUST SIX BITS
  699.     TAD    (-"?!200)    /COMPARE TO "?"
  700.     SZA            /SKIP IF ALREADY BAD
  701.     TAD    (-"*+"?)    /ELSE COMPARE TO "*"
  702.     SNA CLA            /SKIP IF NEITHER BAD CASE
  703.     JMP I    (BADNAME)    /COMPLAIN OF WILD CHARACTER
  704.     TAD    LUKUP        /GET THE PAIR BACK FOR NEXT TIME
  705.     JMP I    CHKIT        /RETURN
  706.  
  707.     PAGE
  708.     $            /THAT'S ALL FOLK!
  709.