home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / d / k12deb.pal < prev    next >
Text File  |  2020-01-01  |  22KB  |  677 lines
  1. /    OS/8 BOO DECODING PROGRAM
  2.  
  3. /    LAST EDIT:    22-OCT-1991    12:00:00    CJL
  4.  
  5. /    MAY BE ASSEMBLED WITH '/F' SWITCH SET.
  6.  
  7. /    PROGRAM TO  DECODE  OS/8  FILES  FROM  "PRINTABLE"  ASCII  (".BOO")  FORMAT TO
  8. /    BINARY-IMAGE FORMAT.   INTERMEDIATE  "ASCII"  CONVERSION SHOULD BE HARMLESS AS
  9. /    LONG AS ALL PRINTING DATA CHARACTERS ARE NOT MODIFIED.
  10.  
  11. /    DISTRIBUTED BY CUCCA AS "K12DEB.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. /    THIS PROGRAM OPERATES ON "PRINTABLE" ASCII FILES WHICH  HAVE  BEEN  CREATED BY
  24. /    ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES.  THE ENCODING FORMAT ALLOWS
  25. /    FOR  CERTAIN  "WHITE  SPACE" MODIFICATIONS SUCH AS LINE WIDTH REFORMATTING  AS
  26. /    LONG  AS  ALL  PRINTING CHARACTERS ARE UNMODIFIED.  EXTRANEOUS <CR>/<LF> PAIRS
  27. /    AND ALL OTHER CONTROL CHARACTERS (<FF>, <VT>, ETC.) ARE IGNORED.
  28.  
  29. /    WHEN CREATING THE DESCENDANT DECODED FILE,  THE  USER  MAY  SPECIFY EITHER THE
  30. /    IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE
  31. /    OR A SPECIFIED DEVICE: 
  32.  
  33. /    .RUN DEV DEBOO        INVOKE PROGRAM.
  34. /    *INPUT            INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT).
  35. /    *DEV:OUTPUT.EX<INPUT    INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:.
  36. /    *DEV:<INPUT        INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:.
  37. /    *OUTPUT.EX<INPUT$    INPUT IS  DECODED  INTO  OUTPUT.EX ON DSK:  (DEFAULT).
  38. /                THE <ESC> CHARACTER  WAS  USED  TO  TERMINATE THE LINE
  39. /                (THIS IS SIGNIFIED BY $).  THIS CAUSES PROGRAM EXIT.
  40. /    .            PROGRAM EXITS NORMALLY.
  41.  
  42. /    INPUT FILE ASSUMES .BO EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION.
  43.  
  44. /    PROGRAM EXIT IS THE NORMAL  OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
  45. /    KEYBOARD DURING THE COMMAND, OR ENDING  THE  COMMAND  INPUT LINE WITH AN <ESC>
  46. /    CHARACTER.
  47. /    .BOO FORMAT IMPLEMENTATION DESCRIPTION.
  48.  
  49. /    THIS  PROGRAM  SUPPORTS  STANDARD .BOO FORMAT ENCODED FILES AND OPTIONALLY THE
  50. /    USE OF LENGTH CORRECTION BYTES AT THE FILE'S END TO ENSURE PROPER  LENGTH.  IF
  51. /    NO  LENGTH CORRECTION FIELDS ARE FOUND, IT IS ASSUMED THEY AREN'T NEEDED;   IT
  52. /    IS THE RESPONIBILITY OF THE ENCODER TO INSERT THESE FIELDS IF NECESSARY.  OS/8
  53. /    FILES PROPERLY  ENCODED  BY THE COMPANION ENBOO-ING PROGRAM (ENBOO AKA K12ENB)
  54. /    WILL CONTAIN SUCH  BYTES AS NECESSARY, AND WILL BE PROPERLY DECODED INTO THEIR
  55. /    ORIGINAL FORM WITHOUT LOSS.  ALL OTHER FILES WILL BE <NUL>-PADDED AS NECESSARY
  56. /    TO ROUND-UP THE FILE SIZE  TO  A  NUMBER  OF  COMPLETE  OS/8  RECORDS;   THEIR
  57. /    ORIGINAL LENGTH WILL BE LOST.
  58.  
  59. /    **** WARNING **** USE OF  ENBOO-ING  PROGRAMS NOT COMPATIBLE WITH THE OPTIONAL
  60. /    LENGTH  CORRECTION SCHEME CAN PRODUCE FILES  DRASTICALLY  DIFFERENT  FROM  THE
  61. /    ORIGINAL;  AN ENTIRE OS/8 RECORD CONTAINING <NUL> CHARACTERS COULD BE APPENDED
  62. /    TO THE END OF THE  FILES.    BEYOND  THE  WASTE OF DISK SPACE, THESE DEFECTIVE
  63. /    FILES COULD ACTUALLY BE DANGEROUS TO USE UNDER OS/8.
  64.  
  65. /    ORDINARILY THESE FILES SHOULDN'T EXIST, BUT COULD BE CREATED  BY  METHODS SUCH
  66. /    AS DECODING ON OTHER SYSTEMS FOLLOWED BY USE OF ENCODERS INCOMPATIBLE WITH THE
  67. /    LENGTH CORRECTION SCHEME.  THIS TENDS TO MAKE THE FILE SIZE  WRONG  BY  ONE OR
  68. /    TWO  BYTES,  WHICH  WHEN  DECODED  HERE  WILL CAUSE THE CREATION OF AN  ENTIRE
  69. /    ERRONEOUS  RECORD.    IT IS RECOMMENDED THAT FILES STORED ON OTHER SYSTEMS FOR
  70. /    EVENTUALLY DELIVERY  TO  OS/8  SYSTEMS BE MAINTAINED IN .BOO FORMAT TO PREVENT
  71. /    THIS FORM OF FILE CORRUPTION.
  72.  
  73. /    ERROR MESSAGES.
  74.  
  75. /    ANY MESSAGE  PRINTED  IS A FATAL ERROR MESSAGE.  ALL MESSAGES ARE THE STANDARD
  76. /    OS/8 "USER" ERROR  MESSAGES OF THE FORM:  USER ERROR X AT AAAAA WHERE X IS THE
  77. /    ERROR NUMBER AND AAAAA  IS  THE  PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
  78. /    THE FOLLOWING USER ERRORS ARE DEFINED:
  79.  
  80. /    ERROR NUMBER        PROBABLE CAUSE
  81.  
  82. /    0            TOO MANY OUTPUT FILES.
  83.  
  84. /    1            NO INPUT FILE OR TOO MANY INPUT FILES.
  85.  
  86. /    2            IMBEDDED OUTPUT FILENAME FORMAT ERROR.
  87.  
  88. /    3            I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME.
  89.  
  90. /    4            ERROR WHILE FETCHING FILE HANDLER.
  91.  
  92. /    5            ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
  93.  
  94. /    6            OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
  95.  
  96. /    7            ERROR WHILE CLOSING THE OUTPUT FILE.
  97.  
  98. /    8            I/O ERROR WHILE DECODING FILE DATA OR BAD DATA.
  99.  
  100. /    9            OUTPUT ERROR WHILE DECODING FILE DATA.
  101. /    ASSEMBLY INSTRUCTIONS.
  102.  
  103. /    IT IS  ASSUMED  THE  SOURCE  FILE  K12DEB.PAL  HAS  BEEN  MOVED AND RENAMED TO
  104. /    DSK:DEBOO.PA.
  105.  
  106. /    .PAL DEBOO<DEBOO/E/F    ASSEMBLE SOURCE PROGRAM
  107. /    .LOAD DEBOO        LOAD THE BINARY FILE
  108. /    .SAVE DEV DEBOO=0    SAVE THE CORE-IMAGE FILE
  109. /    DEFINITIONS.
  110.  
  111.     CLOSE=    4        /CLOSE OUTPUT FILE
  112.     DECODE=    5        /CALL COMMAND DECODER
  113.     ENTER=    3        /ENTER TENTATIVE FILE
  114.     FETCH=    1        /FETCH HANDLER
  115.     IHNDBUF=7200        /INPUT HANDLER BUFFER
  116.     INBUFFE=6200        /INPUT BUFFER
  117.     INFILE=    7617        /INPUT FILE INFORMATION HERE
  118.     INQUIRE=12        /INQUIRE ABOUT HANDLER
  119.     NL0001=    CLA IAC        /LOAD AC WITH 0001
  120.     NL0002=    CLA CLL CML RTL    /LOAD AC WITH 0002
  121.     NL7776=    CLA CLL CMA RAL    /LOAD AC WITH 7776
  122.     NL7777=    CLA CMA        /LOAD AC WITH 7777
  123.     OHNDBUF=6600        /OUTPUT HANDLER BUFFER
  124.     OUTBUFF=5600        /OUTPUT BUFFER
  125.     OUTFILE=7600        /OUTPUT FILE INFORMATION HERE
  126.     PRGFLD=    00        /PROGRAM FIELD
  127.     RESET=    13        /RESET SYSTEM TABLES
  128.     SBOOT=    7600        /MONITOR EXIT
  129.     TBLFLD=    10        /COMMAND DECODER TABLE FIELD
  130.     TERMWRD=7642        /TERMINATOR WORD
  131.     USERROR=7        /USER SIGNALLED ERROR
  132.     USR=    7700        /USR ENTRY POINT
  133.     USRFLD=    10        /USR FIELD
  134.     WRITE=    4000        /I/O WRITE BIT
  135.     *0            /START AT THE BEGINNING
  136.  
  137.     *10            /DEFINE AUTO-INDEX AREA
  138.  
  139. XR1,    .-.            /AUTO-INDEX NUMBER 1
  140. XR2,    .-.            /AUTO-INDEX NUMBER 2
  141.  
  142.     *20            /GET PAST AUTO-INDEX AREA
  143.  
  144. BUFPTR,    .-.            /INPUT BUFFER POINTER
  145. BYTES,    ZBLOCK    3        /DATA BYTES
  146. CHRCNT,    .-.            /CHARACTER COUNTER
  147. CMPCNT,    .-.            /COMPRESSION COUNTER
  148. DANGCNT,.-.            /DANGER COUNT
  149. DATCNT,    .-.            /DATA COUNTER
  150. IDNUMBE,.-.            /INPUT DEVICE NUMBER
  151. INPUT,    .-.            /INPUT HANDLER POINTER
  152. INRECOR,.-.            /INPUT RECORD
  153. FNAME,    ZBLOCK    4        /OUTPUT FILENAME
  154. GETBERR,.-.            /ERROR ROUTINE POINTER FOR GETBYTE ROUTINE
  155. LATEST,    .-.            /LATEST OUTPUT BYTE
  156. ODNUMBE,.-.            /OUTPUT DEVICE NUMBER
  157. ONAME,    ZBLOCK    10        /OUTPUT NAME FIELD
  158. OUTPUT,    .-.            /OUTPUT HANDLER POINTER
  159. OUTRECO,.-.            /OUTPUT RECORD
  160. PUTEMP,    .-.            /INPUT TEMPORARY
  161. PUTPTR,    .-.            /OUTPUT POINTER
  162. TEMPTR,    .-.            /TERMPORARY OUTPUT POINTER
  163. THIRD,    .-.            /THIRD BYTE TEMPORARY
  164.  
  165.     PAGE            /START AT THE USUAL PLACE
  166.  
  167. BEGIN,    NOP            /HERE IN CASE WE'RE CHAINED TO
  168.     CLA            /CLEAN UP
  169. START,    CIF    USRFLD        /GOTO USR FIELD
  170.     JMS I    [USR]        /CALL USR ROUTINE
  171.     DECODE            /WANT COMMAND DECODER
  172.     "B^100+"O-300        /.BO IS DEFAULT EXTENSION
  173.     CDF    TBLFLD        /GOTO TABLE FIELD
  174.     TAD I    (TERMWRD)    /GET TERMINATOR WORD
  175.     SPA CLA            /SKIP IF <CR> TERMINATED THE LINE
  176.     DCA    EXITZAP        /ELSE CAUSE EXIT LATER
  177.     TAD I    (OUTFILE)    /GET FIRST OUTPUT FILE DEVICE WORD
  178.     SNA            /SKIP IF FIRST OUTPUT FILE PRESENT
  179.     JMP    TSTMORE        /JUMP IF NOT THERE
  180.     AND    [17]        /JUST DEVICE BITS
  181. ODNULL,    DCA    ODNUMBER    /SAVE OUTPUT DEVICE NUMBER
  182.     TAD I    (OUTFILE+5)    /GET SECOND OUTPUT FILE DEVICE WORD
  183.     SNA            /SKIP IF THERE
  184.     TAD I    (OUTFILE+12)    /ELSE GET THIRD OUTPUT FILE DEVICE WORD
  185.     SZA CLA            /SKIP IF BOTH NOT PRESENT
  186.     JMP    OUTERR        /ELSE COMPLAIN
  187.     TAD I    (INFILE)    /GET FIRST INPUT FILE DEVICE WORD
  188.     SNA            /SKIP IF PRESENT
  189.     JMP    INERR        /JUMP IF NOT
  190.     AND    [17]        /JUST DEVICE BITS
  191.     DCA    IDNUMBER    /SAVE INPUT DEVICE NUMBER
  192.     TAD I    (INFILE+2)    /GET SECOND INPUT FILE DEVICE WORD
  193.     SZA CLA            /SKIP IF ONLY ONE INPUT FILE
  194.     JMP    INERR        /ELSE COMPLAIN
  195.     TAD I    (INFILE+1)    /GET FIRST INPUT FILE STARTING RECORD
  196.     DCA    INRECORD    /SET IT UP
  197.     CDF    PRGFLD        /BACK TO OUR FIELD
  198.     CIF    USRFLD        /GOTO USR FIELD
  199.     JMS I    [USR]        /CALL USR ROUTINE
  200.     RESET            /RESET SYSTEM TABLES
  201.     TAD    (IHNDBUFFER+1)    /GET INPUT BUFFER POINTER+TWO-PAGE BIT
  202.     DCA    IHPTR        /STORE IN-LINE
  203.     TAD    IDNUMBER    /GET INPUT DEVICE NUMBER
  204.     CIF    USRFLD        /GOTO USR FIELD
  205.     JMS I    [USR]        /CALL USR ROUTINE
  206.     FETCH            /FETCH HANDLER
  207. IHPTR,    .-.            /WILL BE BUFFER POINTER+TWO-PAGE BIT
  208.     JMP    FERROR        /FETCH ERROR
  209.     TAD    IHPTR        /GET RETURNED ADDRESS
  210.     DCA    INPUT        /STORE AS INPUT HANDLER ADDRESS
  211.     JMS I    (GEOFILE)    /GET OUTPUT FILE INFORMATION
  212.     TAD    (OHNDBUFFER+1)    /GET BUFFER POINTER+TWO-PAGE BIT
  213.     DCA    OHPTR        /STORE IN-LINE
  214.     TAD    ODNUMBER    /GET OUTPUT DEVICE NUMBER
  215.     CIF    USRFLD        /GOTO USR FIELD
  216.     JMS I    [USR]        /CALL USR ROUTINE
  217.     FETCH            /FETCH HANDLER
  218. OHPTR,    .-.            /WILL BE BUFFER POINTER+TWO-PAGE BIT
  219.     JMP    FERROR        /FETCH ERROR
  220.     TAD    OHPTR        /GET RETURNED ADDRESS
  221.     DCA    OUTPUT        /STORE AS OUTPUT HANDLER ADDRESS
  222.     TAD    (FNAME)        /POINT TO
  223.     DCA    ENTAR1        /STORED FILENAME
  224.     DCA    ENTAR2        /CLEAR SECOND ARGUMENT
  225.     TAD    ODNUMBER    /GET OUTPUT DEVICE NUMBER
  226.     CIF    USRFLD        /GOTO USR FIELD
  227.     JMS I    [USR]        /CALL USR ROUTINE
  228.     ENTER            /ENTER TENTATIVE FILENAME
  229. ENTAR1,    .-.            /WILL POINT TO FILENAME
  230. ENTAR2,    .-.            /WILL BE ZERO
  231.     JMP    ENTERR        /ENTER ERROR
  232.     TAD    ENTAR1        /GET RETURNED FIRST RECORD
  233.     DCA    OUTRECORD    /STORE IT
  234.     TAD    ENTAR2        /GET RETURNED EMPTY LENGTH
  235.     IAC            /ADD 2-1 FOR OS/278 CRAZINESS
  236.     DCA    DANGCNT        /STORE AS DANGER COUNT
  237.     JMS I    (DECODIT)    /GO DO THE ACTUAL DECODING
  238.     JMP    PROCERR        /ERROR WHILE DECODING
  239.     TAD    ODNUMBER    /GET OUTPUT DEVICE NUMBER
  240.     CIF    USRFLD        /GOTO USR FIELD
  241.     JMS I    [USR]        /CALL USR ROUTINE
  242.     CLOSE            /CLOSE OUTPUT FILE
  243.     FNAME            /POINTER TO FILENAME
  244. OUTCNT,    .-.            /WILL BE ACTUAL COUNT
  245.     JMP    CLSERR        /CLOSE ERROR
  246. EXITZAP,JMP    START        /**** <ESC> TERMINATION **** 0000
  247.     JMP I    (SBOOT)        /EXIT TO MONITOR
  248. /    OUTPUT FILE ERROR WHILE PROCESSING.
  249.  
  250. OERROR,    TAD    [3]        /SET INCREMENT
  251.     SKP            /DON'T USE NEXT
  252.  
  253. /    ERROR WHILE PROCESSING INPUT FILE.
  254.  
  255. PROCERR,NL0002            /SET INCREMENT
  256.     SKP            /DON'T USE NEXT
  257.  
  258. /    ERROR WHILE CLOSING THE OUTPUT FILE.
  259.  
  260. CLSERR,    NL0001            /SET INCREMENT
  261.     SKP            /DON'T CLEAR IT
  262.  
  263. /    OUTPUT FILE TOO LARGE ERROR.
  264.  
  265. SIZERR,    CLA            /CLEAN UP
  266.     TAD    [3]        /SET INCREMENT
  267.     SKP            /DON'T USE NEXT
  268.  
  269. /    ENTER ERROR.
  270.  
  271. ENTERR,    NL0002            /SET INCREMENT
  272.     SKP            /DON'T USE NEXT
  273.  
  274. /    HANDLER FETCH ERROR.
  275.  
  276. FERROR,    NL0001            /SET INCREMENT
  277.  
  278. /    I/O ERROR WHILE PROCESSING IMBEDDED FILENAME.
  279.  
  280. NIOERR,    IAC            /SET INCREMENT
  281.  
  282. /    FORMAT ERROR WHILE PROCESSING IMBEDDED FILENAME.
  283.  
  284. CHARERR,IAC            /SET INCREMENT
  285.  
  286. /    INPUT FILESPEC ERROR.
  287.  
  288. INERR,    IAC            /SET INCREMENT
  289.  
  290. /    OUTPUT FILESPEC ERROR.
  291.  
  292. OUTERR,    DCA    ERRNUMBER    /STORE ERROR NUMBER
  293.     CDF    PRGFLD        /ENSURE OUR FIELD
  294.     CIF    USRFLD        /GOTO USR FIELD
  295.     JMS I    [USR]        /CALL USR ROUTINE
  296.     USERROR            /USER ERROR
  297. ERRNUMB,.-.            /WILL BE PASSED ERROR NUMBER
  298. /    COMES HERE TO TEST FOR NULL LINE.
  299.  
  300. TSTMORE,TAD I    (OUTFILE+5)    /GET SECOND OUTPUT FILE DEVICE WORD
  301.     SNA            /SKIP IF PRESENT
  302.     TAD I    (OUTFILE+12)    /ELSE GET THIRD OUTPUT FILE DEVICE WORD
  303.     SZA CLA            /SKIP IF NO OUTPUT FILES
  304.     JMP    OUTERR        /ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT 
  305.     TAD I    (INFILE)    /GET FIRST OUTPUT FILE DEVICE WORD
  306.     SZA CLA            /SKIP IF NO INPUT FILES
  307.     JMP    ODNULL        /JUMP IF INPUT WITHOUT OUTPUT
  308.     CDF    PRGFLD        /BACK TO OUR FIELD
  309.     JMP    EXITZAP        /MIGHT BE LAST TIME, SO GO THERE FIRST
  310.  
  311.     PAGE
  312. DECODIT,.-.            /DECODING ROUTINE
  313.     TAD    (DECERR)    /SETUP THE
  314.     DCA    GETBERROR    /GETBYTE ERROR ROUTINE
  315.     DCA    DATCNT        /CLEAR DATA COUNT
  316.     NL7777            /SETUP FOR INITIALIZING
  317.     JMS I    (PUTBYTE)    /INITIALIZE OUTPUT FILE
  318. LOOP,    JMS    GETCHR        /GET A CHARACTER
  319.     JMP    ENDIT        /WEREN'T ANY MORE
  320.     TAD    (-176)        /COMPARE TO TILDE
  321.     SZA CLA            /SKIP IF IT MATCHES
  322.     JMP    DATPROCESS    /JUMP IF NOT
  323.     JMS    GETCHR        /GET A CHARACTER
  324. DECERR,    JMP I    DECODIT        /WASN'T ANY
  325.     TAD    (-"0!200)    /REMOVE PRINTING OFFSET
  326.     SNA            /SKIP IF SIGNIFICENT COMPRESSION
  327.     JMP    DATCORRECT    /JUMP IF NOT
  328.     CIA            /INVERT FOR COUNTING
  329.     DCA    CMPCNT        /SAVE COMPRESSION COUNT
  330.     JMS    DATOUT        /OUTPUT DATA FIELD (IF ANY) AND CLEAR DATA COUNT
  331. COMPLP,    JMS I    (PUTBYTE)    /OUTPUT A <NUL> BYTE
  332.     ISZ    CMPCNT        /DONE YET?
  333.     JMP    COMPLP        /NO, KEEP GOING
  334.     JMP    LOOP        /YES, GO BACK FOR MORE FILE ITEMS
  335.  
  336. /    ZERO-LENGTH COMPRESSION (CORRECTION) FIELD FOUND.
  337.  
  338. DATCORR,NL7777            /BACKUP
  339.     TAD    DATCNT        /NOW HAVE CORRECTED DATA COUNT
  340.     SPA            /SKIP IF COUNT WASN'T ZERO
  341.     JMP    LOOP        /IGNORE BECAUSE THERE IS NO DATA
  342.     SNA            /SKIP IF ENOUGH TO CORRECT
  343.     JMP I    DECODIT        /TAKE ERROR RETURN IF NOT
  344.     DCA    DATCNT        /STORE CORRECTED COUNT
  345.     JMP    LOOP        /GO BACK FOR MORE FILE ITEMS
  346. /    UN-COMPRESSED DATA FOUND.
  347.  
  348. DATPROC,JMS    DATOUT        /OUTPUT PREVIOUS DATA FIELD (IF ANY), CLEAR DATA COUNT
  349.     TAD    PUTEMP        /GET LATEST BACK
  350.     TAD    (-"0!200)    /REMOVE DIGIT OFFSET
  351.     CLL RTL            /MOVE UP
  352.     DCA    BYTES        /STORE IT
  353.     JMS    GETCHR        /GET NEXT CHARACTER
  354.     JMP I    DECODIT        /WASN'T ANY
  355.     AND    (17)        /JUST LOW-ORDER BITS
  356.     CLL RTL;RTL        /MOVE UP
  357.     DCA    BYTES+1        /STORE IT
  358.     TAD    PUTEMP        /GET IT AGAIN
  359.     RTR;RTR            /MOVE DOWN
  360.     IAC            /REMOVE DIGIT BIAS
  361.     AND    (3)        /JUST GOOD BITS
  362.     TAD    BYTES        /GET OLD BITS
  363.     DCA    BYTES        /STORE COMPOSITE
  364.     JMS    GETCHR        /GET NEXT CHARACTER
  365.     JMP I    DECODIT        /WASN'T ANY
  366.     TAD    (-"0!200)    /REMOVE DIGIT OFFSET
  367.     RTR            /MOVE DOWN
  368.     AND    (17)        /ISOLATE GOOD BITS
  369.     TAD    BYTES+1        /GET OLD BITS
  370.     DCA    BYTES+1        /STORE COMPOSITE
  371.     TAD    PUTEMP        /GET IT AGAIN
  372.     AND    (3)        /ISOLATE GOOD BITS
  373.     CLL RTL;RTL;RTL        /MOVE UP
  374.     DCA    BYTES+2        /STORE IT
  375.     JMS    GETCHR        /GET NEXT CHARACTER
  376.     JMP I    DECODIT        /WASN'T ANY
  377.     TAD    (-"0!200)    /REMOVE DIGIT OFFSET
  378.     TAD    BYTES+2        /GET OLD BITS
  379.     DCA    BYTES+2        /STORE COMPOSITE
  380.     TAD    (3)        /SETUP THE
  381.     DCA    DATCNT        /DATA COUNT
  382.     JMP    LOOP        /GO GET NEXT FILE ITEM
  383.  
  384. /    COMES HERE AT END-OF-FILE.
  385.  
  386. ENDIT,    JMS    DATOUT        /OUTPUT ANY LEFTOVER DATA
  387.     SKP            /DON'T OUTPUT YET
  388. CLOSLUP,JMS I    (PUTBYTE)    /OUTPUT A <NUL> BYTE
  389.     TAD    PUTPTR        /GET THE OUTPUT BUFFER POINTER
  390.     TAD    (-OUTBUFFER)    /COMPARE TO RESET VALUE
  391.     SZA CLA            /SKIP IF IT MATCHES
  392.     JMP    CLOSLUP        /ELSE KEEP GOING
  393.     ISZ    DECODIT        /BUMP TO GOOD RETURN
  394.     JMP I    DECODIT        /RETURN TO CALLER
  395. DATOUT,    .-.            /DATA OUTPUT ROUTINE
  396.     TAD    DATCNT        /GET CURRENT DATA COUNT
  397.     CMA            /SETUP FOR COUNTING
  398.     DCA    DATCNT        /STORE IT
  399.     TAD    (BYTES-1)    /POINT TO
  400.     DCA    XR1        /DATA AREA
  401.     JMP    DATEST        /CHECK BEFORE OUTPUTTING
  402.  
  403. DATLUP,    TAD I    XR1        /GET A BYTE
  404.     JMS I    (PUTBYTE)    /OUTPUT IT
  405. DATEST,    ISZ    DATCNT        /DONE YET?
  406.     JMP    DATLUP        /NO, KEEP GOING
  407.     JMP I    DATOUT        /YES, RETURN TO CALLER
  408.  
  409. GETCHR,    .-.            /GET A CHARACTER ROUTINE
  410. GETCAGN,CLA            /GET A CHARACTER
  411.     JMS I    [GETBYTE]    /GET A CHARACTER FROM FILE
  412.     JMP I    GETCHR        /WASN'T ANY, TAKE IMMEDIATE RETURN
  413.     TAD    [-" !200]    /COMPARE TO <SPACE>
  414.     SPA SNA CLA        /SKIP IF NOT CONTROL CHARACTER OR <SPACE>
  415.     JMP    GETCAGN        /GO GET ANOTHER ONE
  416.     TAD    PUTEMP        /GET GOOD CHARACTER
  417.     ISZ    GETCHR        /BUMP RETURN ADDRESS
  418.     JMP I    GETCHR        /RETURN TO CALLER
  419.  
  420.     PAGE
  421. PUTBYTE,.-.                /OUTPUT A BYTE ROUTINE
  422.     SPA                /ARE WE INITIALIZING?
  423.     JMP    PUTINITIALIZE        /YES
  424.     AND    (377)            /JUST IN CASE
  425.     DCA    LATEST            /SAVE LATEST CHARACTER
  426.     TAD    LATEST            /GET LATEST CHARACTER
  427.     JMP I    PUTNEXT            /GO WHERE YOU SHOULD GO
  428.  
  429. PUTNEXT,.-.                /EXIT ROUTINE
  430.     JMP I    PUTBYTE            /RETURN TO MAIN CALLER
  431.  
  432. PUTINIT,CLA                /CLEAN UP
  433.     TAD    OUTRECORD        /GET STARTING RECORD OF TENTATIVE FILE
  434.     DCA    PUTRECORD        /STORE IN-LINE
  435.     DCA I    (OUTCNT)        /CLEAR ACTUAL FILE LENGTH
  436. PUTNEWR,TAD    POUTBUFFER/(OUTBUFFER)    /SETUP THE
  437.     DCA    PUTPTR            /BUFFER POINTER
  438. PUTLOOP,JMS    PUTNEXT            /GET A CHARACTER
  439.     DCA I    PUTPTR            /STORE IT
  440.     TAD    PUTPTR            /GET POINTER VALUE
  441.     DCA    TEMPTR            /SAVE FOR LATER
  442.     ISZ    PUTPTR            /BUMP TO NEXT
  443.     JMS    PUTNEXT            /GET A CHARACTER
  444.     DCA I    PUTPTR            /STORE IT
  445.     JMS    PUTNEXT            /GET A CHARACTER
  446.     RTL;RTL                /MOVE UP
  447.     AND    [7400]            /ISOLATE HIGH NYBBLE
  448.     TAD I    TEMPTR            /ADD ON FIRST BYTE
  449.     DCA I    TEMPTR            /STORE COMPOSITE
  450.     TAD    LATEST            /GET LATEST CHARACTER
  451.     RTR;RTR;RAR            /MOVE UP AND
  452.     AND    [7400]            /ISOLATE LOW NYBBLE
  453.     TAD I    PUTPTR            /ADD ON SECOND BYTE
  454.     DCA I    PUTPTR            /STORE COMPOSITE
  455.     ISZ    PUTPTR            /BUMP TO NEXT
  456.     TAD    PUTPTR            /GET LATEST POINTER VALUE
  457.     TAD    (-2^200-OUTBUFFER)    /COMPARE TO LIMIT
  458.     SZA CLA                /SKIP IF AT END
  459.     JMP    PUTLOOP            /KEEP GOING
  460.     ISZ    DANGCNT            /TOO MANY RECORDS?
  461.     SKP                /SKIP IF NOT
  462.     JMP I    (SIZERR)        /JUMP IF SO
  463.     JMS I    OUTPUT            /CALL I/O HANDLER
  464.     2^100+WRITE            /WRITE SOME PAGES FROM OUTPUT BUFFER
  465. POUTBUF,OUTBUFFER            /BUFFER ADDRESS
  466. PUTRECO,.-.                /WILL BE LATEST RECORD NUMBER
  467.     JMP I    (OERROR)        /OUTPUT ERROR!
  468.     ISZ I    (OUTCNT)        /BUMP ACTUAL LENGTH
  469.     ISZ    PUTRECORD        /BUMP TO NEXT RECORD
  470.     JMP    PUTNEWRECORD        /KEEP GOING
  471. /    OS/8 FILE UNPACK ROUTINE.
  472.  
  473. GETBYTE,.-.                /GET A BYTE ROUTINE
  474.     SNA CLA                /INITIALIZING?
  475.     JMP I    PUTC            /NO, GO GET NEXT BYTE
  476.     TAD    INRECORD        /GET STARTING RECORD OF INPUT FILE
  477.     DCA    GETRECORD        /STORE IN-LINE
  478. GETNEWR,JMS I    INPUT            /CALL I/O HANDLER
  479.     2^100                /READ TWO PAGES INTO BUFFER
  480. PINBUFF,INBUFFER            /BUFFER ADDRESS
  481. GETRECO,.-.                /WILL BE LATEST RECORD NUMBER
  482.     JMP I    GETBERROR        /INPUT ERROR!
  483.     TAD    PINBUFFER/(INBUFFER)    /SETUP THE
  484.     DCA    BUFPTR            /BUFFER POINTER
  485. GETLOOP,DCA    THIRD            /CLEAR THIRD BYTE NOW
  486.     JMS    PUTONE            /OBTAIN AND SEND BACK FIRST BYTE
  487.     JMS    PUTONE            /OBTAIN AND SEND BACK SECOND BYTE
  488.     TAD    THIRD            /GET THIRD BYTE
  489.     JMS    PUTC            /SEND IT BACK
  490.     TAD    BUFPTR            /GET THE POINTER
  491.     TAD    (-2^200-INBUFFER)    /COMPARE TO LIMIT
  492.     SZA CLA                /SKIP IF AT END
  493.     JMP    GETLOOP            /KEEP GOING
  494.     ISZ    GETRECORD        /BUMP TO NEXT RECORD
  495.     JMP    GETNEWRECORD        /GO DO ANOTHER ONE
  496.  
  497. PUTONE,    .-.                /SEND BACK A BYTE ROUTINE
  498.     TAD I    BUFPTR            /GET LATEST WORD
  499.     AND    [7400]            /JUST THIRD-BYTE NYBBLE
  500.     CLL RAL                /MOVE UP
  501.     TAD    THIRD            /GET OLD NYBBLE (IF ANY)
  502.     RTL;RTL                /MOVE UP NYBBLE BITS
  503.     DCA    THIRD            /SAVE FOR NEXT TIME
  504.     TAD I    BUFPTR            /GET LATEST WORD AGAIN
  505.     JMS    PUTC            /SEND BACK CURRENT BYTE
  506.     ISZ    BUFPTR            /BUMP TO NEXT WORD
  507.     JMP I    PUTONE            /RETURN
  508.  
  509. PUTC,    .-.                /SEND BACK LATEST BYTE ROUTINE
  510.     AND    (177)            /KEEP ONLY GOOD BITS
  511.     DCA    PUTEMP            /SAVE IT
  512.     TAD    PUTEMP            /GET IT BACK
  513.     TAD    (-"Z!300)        /COMPARE TO <^Z>
  514.     SNA CLA                /SKIP IF NOT ASCII <EOF>
  515.     JMP I    GETBYTE            /RETURN IF ASCII MODE <EOF>
  516.     TAD    PUTEMP            /RESTORE THE CHARACTER
  517.     ISZ    GETBYTE            /BUMP PAST <EOF> RETURN
  518.     JMP I    GETBYTE            /RETURN TO MAIN CALLER
  519.     PAGE
  520. GEOFILE,.-.            /GET OUTPUT FILE ROUTINE
  521.     TAD    ODNUMBER    /GET OUTPUT DEVICE NUMBER
  522.     SZA CLA            /SKIP IF NOT ESTABLISHED YET
  523.     JMP    GOTOD        /JUMP IF DETERMINED ALREADY
  524.     TAD    ("D^100+"S-300)    /GET BEGINNING OF "DSK"
  525.     DCA    DEVNAME        /STORE IN-LINE
  526.     TAD    ("K^100)    /GET REST OF "DSK"
  527.     DCA    DEVNAME+1    /STORE IN-LINE
  528.     DCA    RETVAL        /CLEAR HANDLER ENTRY WORD
  529.     CDF    PRGFLD        /INDICATE OUR FIELD
  530.     CIF    USRFLD        /GOTO USR FIELD
  531.     JMS I    [USR]        /CALL USR ROUTINE
  532.     INQUIRE            /INQUIRE ABOUT HANDLER
  533. DEVNAME,ZBLOCK    2        /WILL BE DEVICE DSK
  534. RETVAL,    .-.            /BECOMES HANDLER ENTRY POINT WORD
  535.     HLT            /DSK: NOT IN SYSTEM IS IMPOSSIBLE!
  536.     TAD    DEVNAME+1    /GET DEVICE NUMBER FOR DSK:
  537.     AND    [17]        /JUST DEVICE BITS
  538.     DCA    ODNUMBER    /STORE OUTPUT DEVICE
  539. GOTOD,    JMS    SCANAME        /SCAN OFF FILE NAME
  540.     CDF    TBLFLD        /BACK TO TABLE FIELD
  541.     TAD I    (OUTFILE+1)    /GET OUTPUT FILE FIRST NAME WORD
  542.     SNA            /SKIP IF PRESENT
  543.     JMP    GFLNAME        /JUMP IF NOT
  544.     DCA    FNAME        /MOVE TO OUR AREA
  545.     TAD I    (OUTFILE+2)    /GET SECOND NAME WORD
  546.     DCA    FNAME+1        /MOVE IT
  547.     TAD I    (OUTFILE+3)    /GET THIRD NAME WORD
  548.     DCA    FNAME+2        /MOVE IT
  549.     TAD I    (OUTFILE+4)    /GET EXTENSION WORD
  550.     DCA    FNAME+3        /MOVE IT
  551.     CDF    PRGFLD        /BACK TO OUR FIELD
  552.     JMP I    GEOFILE        /RETURN
  553.  
  554. /    WE MUST TAKE THE FILENAME FROM THE IMBEDDED FILENAME SUPPLIED.
  555.  
  556. GFLNAME,CDF    PRGFLD        /BACK TO OUR FIELD
  557.     TAD    ONAME        /GET THE FIRST CHARACTER
  558.     SNA CLA            /SKIP IF SOMETHING THERE
  559.     JMP I    (CHARERROR)    /COMPLAIN IF NONE THERE
  560.     TAD    (ONAME-1)    /SETUP POINTER
  561.     DCA    XR1        /TO NAME CHARACTERS
  562.     TAD    (FNAME-1)    /SETUP POINTER
  563.     DCA    XR2        /TO PACKED NAME AREA
  564.     TAD    (-4)        /SETUP THE
  565.     DCA    CHRCNT        /MOVE COUNT
  566. CHRLOOP,TAD I    XR1        /GET FIRST CHARACTER
  567.     CLL RTL;RTL;RTL        /MOVE UP
  568.     TAD I    XR1        /ADD ON SECOND CHARACTER
  569.     DCA I    XR2        /STORE THE PAIR
  570.     ISZ    CHRCNT        /DONE YET?
  571.     JMP    CHRLOOP        /NO, KEEP GOING
  572.     JMP I    GEOFILE        /YES, RETURN
  573. SCANAME,.-.            /SCAN OFF FILENAME ROUTINE
  574.     TAD    (NIOERROR)    /SETUP THE
  575.     DCA    GETBERROR    /I/O ERROR HANDLER
  576.  
  577. /    ZERO OUT THE FILENAME AREA.
  578.  
  579.     TAD    (-10)        /SETUP THE
  580.     DCA    CHRCNT        /CLEAR COUNTER
  581.     TAD    (ONAME-1)    /SETUP THE
  582.     DCA    XR1        /POINTER
  583.     JMS    CLRNAME        /CLEAR THE NAME BUFFER
  584.  
  585. /    SETUP FOR SCANNING THE NAME PORTION.
  586.  
  587.     TAD    (-6)        /SETUP THE
  588.     DCA    CHRCNT        /SCAN COUNT
  589.     TAD    (ONAME-1)    /SETUP THE
  590.     DCA    XR1        /POINTER
  591.     NL7777            /MAKE IT INITIALIZE
  592. FNCAGN,    JMS I    (GETAN)        /GET A CHARACTER
  593.     JMP    GOTSEPARATOR    /GOT "."; GOTO NEXT FIELD
  594.     DCA I    XR1        /STASH THE CHARACTER
  595.     ISZ    CHRCNT        /DONE ALL YET?
  596.     JMP    FNCAGN        /NO, KEEP GOING
  597.  
  598. /    THROW AWAY EXTRA NAME CHARACTERS.
  599.  
  600. TOSSNAM,JMS I    (GETAN)        /GET A CHARACTER
  601.     JMP    GOTSEPARATOR    /GOT "."; GOTO NEXT FIELD
  602.     CLA            /THROW AWAY THE CHARACTER
  603.     JMP    TOSSNAME    /KEEP GOING
  604.  
  605. /    COMES HERE AFTER "." FOUND.
  606.  
  607. GOTSEPA,JMS    CLRNAME        /CLEAR OUT THE REMAINING NAME FIELD
  608.     NL7776            /SETUP THE
  609.     DCA    CHRCNT        /SCAN COUNT
  610. EXCAGN,    JMS I    (GETAN)        /GET A CHARACTER
  611.     JMP I    (CHARERROR)    /GOT "."; COMPLAIN
  612.     DCA I    XR1        /STASH THE CHARACTER
  613.     ISZ    CHRCNT        /DONE ENOUGH YET?
  614.     JMP    EXCAGN        /NO, KEEP GOING
  615.  
  616. /    TOSS ANY EXTRA EXTENSION CHARACTERS.
  617.  
  618. TOSSEXT,JMS I    (GETAN)        /GET A CHARACTER
  619.     JMP I    (CHARERROR)    /GOT "."; COMPLAIN
  620.     CLA            /THROW AWAY THE CHARACTER
  621.     JMP    TOSSEXTENSION    /KEEP GOING
  622.  
  623. /    COMES HERE WHEN TRAILING <CR> IS FOUND.
  624.  
  625. GOTCR,    JMS    CLRNAME        /CLEAR ANY REMAINING EXTENSION CHARACTERS
  626.     JMP I    SCANAME        /RETURN
  627. CLRNAME,.-.            /NAME FIELD CLEARING ROUTINE
  628.     TAD    CHRCNT        /GET CHARACTER COUNTER
  629.     SNA CLA            /SKIP IF ANY TO CLEAR
  630.     JMP I    CLRNAME        /ELSE JUST RETURN
  631.     DCA I    XR1        /CLEAR A NAME WORD
  632.     ISZ    CHRCNT        /COUNT IT
  633.     JMP    .-2        /KEEP GOING
  634.     JMP I    CLRNAME        /RETURN
  635.  
  636.     PAGE
  637. GETCHAR,.-.            /GET A CHARACTER ROUTINE
  638.     JMS I    [GETBYTE]    /GET A CHARACTER
  639.     JMP I    (CHARERROR)    /COMPLAIN IF <EOF> REACHED
  640.     TAD    (-"M!300)    /COMPARE TO <CR>
  641.     SNA            /SKIP IF OTHER
  642.     JMP I    (GOTCR)        /JUMP IF IT MATCHES
  643.     TAD    (-140+"M-300)    /COMPARE TO LOWER-CASE LIMIT
  644.     SPA            /SKIP IF LOWER-CASE
  645.     TAD    (40)        /RESTORE ORIGINAL IF UPPER-CASE
  646.     AND    (77)        /JUST SIX-BIT
  647.     DCA    PUTEMP        /SAVE IN CASE WE NEED IT
  648.     TAD    PUTEMP        /GET IT BACK
  649.     JMP I    GETCHAR        /RETURN
  650.  
  651. GETAN,    .-.            /GET ALPHANUMERIC ROUTINE
  652. GETNAGN,JMS    GETCHAR        /GET A CHARACTER
  653.     TAD    [-" !200]    /COMPARE TO <SPACE>
  654.     SNA CLA            /SKIP IF OTHER
  655.     JMP    GETNAGN        /JUMP IF IT MATCHES
  656.     TAD    PUTEMP        /GET THE CHARACTER BACK
  657.     TAD    (-".!200)    /COMPARE TO "."
  658.     SNA            /SKIP IF OTHER
  659.     JMP I    GETAN        /TAKE FIRST RETURN IF IT MATCHES
  660.     TAD    (-":+".)    /SUBTRACT UPPER LIMIT
  661.     CLL            /CLEAR LINK FOR TEST
  662.     TAD    (":-"0)        /ADD ON RANGE
  663.     SZL CLA            /SKIP IF NOT NUMERIC
  664.     JMP    GETANOK        /JUMP IF NUMERIC
  665.     TAD    PUTEMP        /GET THE CHARACTER BACK
  666.     TAD    (-"[!300)    /SUBTRACT UPPER LIMIT
  667.     CLL            /CLEAR LINK FOR TEST
  668.     TAD    ("[-"A)        /ADD ON RANGE
  669.     SNL CLA            /SKIP IF ALPHABETIC
  670.     JMP I    (CHARERROR)    /ELSE COMPLAIN
  671. GETANOK,TAD    PUTEMP        /GET GOOD ALPHANUMERIC CHARACTER
  672.     ISZ    GETAN        /BUMP TO SKIP RETURN
  673.     JMP I    GETAN        /RETURN
  674.  
  675.     PAGE
  676.     $            /THAT'S ALL FOLK!
  677.