home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / d / k12dec.pal < prev    next >
Text File  |  2020-01-01  |  34KB  |  1,017 lines
  1. /    OS/8 DECODING PROGRAM
  2.  
  3. /    LAST EDIT:    08-JUL-1992    22:00:00    CJL
  4.  
  5. /    PROGRAM TO  DECODE  OS/8  FILES  FROM "PRINTABLE" ASCII FORMAT TO BINARY-IMAGE
  6. /    FORMAT.  INTERMEDIATE  "ASCII"  CONVERSION  SHOULD  BE HARMLESS AS LONG AS ALL
  7. /    PRINTING DATA CHARACTERS ARE NOT MODIFIED.
  8.  
  9. /    DISTRIBUTED BY CUCCA AS "K12DEC.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE.
  10.  
  11. /    WRITTEN BY:
  12.  
  13. /    CHARLES LASNER (CJL)
  14. /    CLA SYSTEMS
  15. /    72-55 METROPOLITAN AVENUE
  16. /    MIDDLE VILLAGE, NEW YORK 11379-2107
  17. /    (718) 894-6499
  18.  
  19. /    USAGE:
  20.  
  21. /    THIS PROGRAM OPERATES ON "PRINTABLE"  ASCII  FILES  WHICH HAVE BEEN CREATED BY
  22. /    ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES.  THE ENCODING FORMAT ALLOWS
  23. /    FOR SOME INNOCUOUS CONTENT MODIFICATION SUCH AS  EXTRANEOUS  WHITE  SPACE  AND
  24. /    EXTRA <CR>/<LF> PAIRS, BUT RIGOROUSLY VALIDATES CERTAIN ASPECTS OF THE FORMAT,
  25. /    SUCH AS A TRAILING CHECKSUM.
  26.  
  27. /    CERTAIN IMBEDDED COMMANDS ARE USED SUCH AS (REMARK .........) WHICH ALLOWS FOR
  28. /    COMMENTARY LINES WITHIN THE FILE FOR IDENTIFICATION PURPOSES.  THE (FILE ) AND
  29. /    (END )  COMMANDS  CONTAIN  THE  SUGGESTED  FILENAME FOR THE DESCENDANT DECODED
  30. /    FILE.
  31. /    WHEN CREATING THE DESCENDANT DECODED FILE,  THE  USER  MAY  SPECIFY EITHER THE
  32. /    IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE
  33. /    OR A SPECIFIED DEVICE: 
  34.  
  35. /    .RUN DEV DECODE        INVOKE PROGRAM.
  36. /    *INPUT            INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT).
  37. /    *DEV:OUTPUT.EX<INPUT    INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:.
  38. /    *DEV:<INPUT        INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:.
  39. /    *DEV:<INPUT=NNNN/I    **** SPECIAL IMAGE TRANSFER MODE **** INPUT IS DECODED
  40. /                INTO  RECORD 0000-[NNNN-1] ON DEVICE DEV:.  THE  =NNNN
  41. /                VALUE SHOULD BE CAREFULLY CHOSEN LARGE ENOUGH TO WRITE
  42. /                ALL  DATA  RECORDS,  BUT  NEED NOT BE STATED  EXACTLY.
  43. /                (THE ENCODE PROGRAM  REQUIRES PRECISE STATEMENT OF THE
  44. /                LENGTH  IN IMAGE TRANSFER ENCODING MODE.    ****  NOTE
  45. /                ****  THIS  METHOD  VIOLATES ALL OS/8 DEVICE STRUCTURE
  46. /                AND  IS  MEANT  FOR TRANSFER OF COMPLETE DEVICE IMAGES
  47. /                ONLY;  USE WITH CARE!
  48. /    *DEV:<INPUT=NNNN/I/1    **** SPECIAL IMAGE TRANSFER  MODE **** SAME AS REGULAR
  49. /                IMAGE MODE EXCEPT ONLY THE FIRST  HALF  OF THE DATA IS
  50. /                USED.  NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY
  51. /                BECAUSE IT IS USED TO CALCULATE THE APPROX.  1/2 VALUE
  52. /                ACTUALLY  USED  IN  THIS HALF OF THE OVERALL TRANSFER.
  53. /                THIS  MODE  SHOULD  BE USED WITH FILES CREATED FOR THE
  54. /                EXPRESS PURPOSE  OF  TRANSMISSION BY HALVES ONLY;  USE
  55. /                WITH CARE!
  56. /    *DEV:<INPUT=NNNN/I/2    **** SPECIAL IMAGE  TRANSFER MODE **** SAME AS REGULAR
  57. /                IMAGE MODE EXCEPT ONLY THE SECOND  HALF OF THE DATA IS
  58. /                USED.  NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY
  59. /                BECAUSE IT IS USED TO CALCULATE THE STARTING RECORD OF
  60. /                THE APPROX.  1/2 VALUE ACTUALLY USED IN  THIS  HALF OF
  61. /                THE OVERALL TRANSFER.    THIS MODE SHOULD BE USED WITH
  62. /                FILES CREATED FOR THE EXPRESS PURPOSE OF  TRANSMISSION
  63. /                BY HALVES ONLY;  USE WITH CARE!  NOTE THAT  THERE MUST
  64. /                BE TWO  FILES  CREATED,  ONE  USING /I/1 AND THE OTHER
  65. /                USING  /I/2 TO  COMPLETELY  TRANSFER  A  DEVICE  IMAGE
  66. /                UNLESS /I IS USED ALONE!
  67. /    *OUTPUT.EX<INPUT$    INPUT IS  DECODED  INTO  OUTPUT.EX ON DSK:  (DEFAULT).
  68. /                THE <ESC> CHARACTER  WAS  USED  TO  TERMINATE THE LINE
  69. /                (THIS IS SIGNIFIED BY $).  THIS CAUSES PROGRAM EXIT.
  70. /    .            PROGRAM EXITS NORMALLY.
  71. /    INPUT  FILE  ASSUMES  .EN  EXTENSION;  THERE IS NO ASSUMED  OUTPUT  EXTENSION.
  72. /    IMAGE TRANSFER MODE DOESN'T USE OUTPUT FILENAMES, AS THE TRANSFER DESTROYS THE
  73. /    OS/8 FILE STRUCTURE (POSSIBLY PRESENT) ON THE DEVICE.
  74.  
  75. /    PROGRAM EXIT IS THE NORMAL  OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
  76. /    KEYBOARD DURING THE COMMAND, OR ENDING  THE  COMMAND  INPUT LINE WITH AN <ESC>
  77. /    CHARACTER.
  78.  
  79. /    THIS PROGRAM  SUPPORTS  A PROPER SUBSET OF THE ASCII ENCODING SCHEME DISCUSSED
  80. /    BY CHARLES LASNER  AND  FRANK  DA  CRUZ.  THE SCHEME USED IS FIVE-BIT ENCODING
  81. /    WITH COMPRESSION, (AS OPPOSED  TO SIX-BIT WITHOUT COMPRESSION AS USED IN PRIOR
  82. /    VERSIONS).
  83.  
  84. /    RESTRICTIONS:
  85.  
  86. /    A)    SUPPORTS ONLY ONE DECODABLE FILE PER ENCODED FILE.
  87.  
  88. /    B)    IGNORES ALL (END ) COMMANDS.
  89.  
  90. /    C)    <CR> <LF> < ALWAYS INDICATES ENCODED DATA LINES;  NO CHECK IS MADE FOR
  91. /        WHETHER THE > IS ON THE SAME LINE AS THE <.
  92.  
  93. /    D)     PDP-8 GENERATED CHECKSUM DATA MUST  BE  THE  FINAL DATA IN THE FILE IN
  94. /        THE  PROPER  FORMAT:    ZCCCCCCCCCCCC  WHERE  CCCCCCCCCCCC    IS   THE
  95. /        TWELVE-CHARACTER PDP-8 CHECKSUM DATA.
  96.  
  97. /    IF THE ENCODED FILE IS PASSED THROUGH ANY  INTERMEDIARY  PROCESS THAT MODIFIES
  98. /    THE CONTENTS IN A WAY THAT INTERFERES WITH ANY  OF  THE  ABOVE,  THIS DECODING
  99. /    PROGRAM  WILL  FAIL.   IT IS THE USER'S RESPONSIBILITY TO  EDIT  OUT  UNWANTED
  100. /    CHANGES TO THE ENCODED FILE.  ALL OTHER ASPECTS OF THE  PROTOCOL  ARE  OBEYED,
  101. /    SUCH AS IMBEDDED <FF>, EXTRA <CR> <LF>, OR TRAILING SPACES HAVE NO  EFFECT  ON
  102. /    THE RELIABILITY OF THE DECODING PROCESS, ETC.
  103. /    ERROR MESSAGES.
  104.  
  105. /    ANY MESSAGE  PRINTED  IS A FATAL ERROR MESSAGE.  ALL MESSAGES ARE THE STANDARD
  106. /    OS/8 "USER" ERROR  MESSAGES OF THE FORM:  USER ERROR X AT AAAAA WHERE X IS THE
  107. /    ERROR NUMBER AND AAAAA  IS  THE  PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
  108. /    THE FOLLOWING USER ERRORS ARE DEFINED:
  109.  
  110. /    ERROR NUMBER        PROBABLE CAUSE
  111.  
  112. /    0            TOO MANY OUTPUT FILES.
  113.  
  114. /    1            NO INPUT FILE OR TOO MANY INPUT FILES.
  115.  
  116. /    2            IMBEDDED OUTPUT FILENAME FORMAT ERROR.
  117.  
  118. /    3            I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME.
  119.  
  120. /    4            ERROR WHILE FETCHING FILE HANDLER.
  121.  
  122. /    5            ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
  123.  
  124. /    6            OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
  125.  
  126. /    7            ERROR WHILE CLOSING THE OUTPUT FILE.
  127.  
  128. /    8            I/O ERROR WHILE DECODING FILE DATA OR BAD DATA.
  129.  
  130. /    ASSEMBLY INSTRUCTIONS.
  131.  
  132. /    IT IS  ASSUMED  THE  SOURCE  FILE  K12DEC.PAL  HAS  BEEN  MOVED AND RENAMED TO
  133. /    DSK:DECODE.PA.
  134.  
  135. /    .PAL DECODE<DECODE    ASSEMBLE SOURCE PROGRAM
  136. /    .LOAD DECODE        LOAD THE BINARY FILE
  137. /    .SAVE DEV DECODE=0    SAVE THE CORE-IMAGE FILE
  138. /    DEFINITIONS.
  139.  
  140.     CLOSE=    4            /CLOSE OUTPUT FILE
  141.     DECODE=    5            /CALL COMMAND DECODER
  142.     ENTER=    3            /ENTER TENTATIVE FILE
  143.     EQUWRD=    7646            /EQUALS PARAMETER HERE IN TABLE FIELD
  144.     FETCH=    1            /FETCH HANDLER
  145.     IHNDBUF=7200            /INPUT HANDLER BUFFER
  146.     INBUFFE=6200            /INPUT BUFFER
  147.     INFILE=    7617            /INPUT FILE INFORMATION HERE
  148.     INQUIRE=12            /INQUIRE ABOUT HANDLER
  149.     NL0001=    CLA IAC            /LOAD AC WITH 0001
  150.     NL0002=    CLA CLL CML RTL        /LOAD AC WITH 0002
  151.     NL4000=    CLA CLL CML RAR        /LOAD AC WITH 4000
  152.     NL7776=    CLA CLL CMA RAL        /LOAD AC WITH 7776
  153.     NL7777=    CLA CMA            /LOAD AC WITH 7777
  154.     OHNDBUF=6600            /OUTPUT HANDLER BUFFER
  155.     OUTBUFF=5600            /OUTPUT BUFFER
  156.     OUTFILE=7600            /OUTPUT FILE INFORMATION HERE
  157.     PRGFLD=    00            /PROGRAM FIELD
  158.     RESET=    13            /RESET SYSTEM TABLES
  159.     SBOOT=    7600            /MONITOR EXIT
  160.     SWAL=    7643            /A-/L SWITCHES HERE IN TABLE FIELD
  161.     SWY9=    7645            /Y-/9 SWITCHES HERE IN TABLE FIELD
  162.     TBLFLD=    10            /COMMAND DECODER TABLE FIELD
  163.     TERMWRD=7642            /TERMINATOR WORD
  164.     USERROR=7            /USER SIGNALLED ERROR
  165.     USR=    7700            /USR ENTRY POINT
  166.     USRFLD=    10            /USR FIELD
  167.     WIDTH=    107-2            /69 DATA CHARACTERS PER LINE (TOTAL 71)
  168.     WRITE=    4000            /I/O WRITE BIT
  169.     *0                /START AT THE BEGINNING
  170.  
  171.     *10                /DEFINE AUTO-INDEX AREA
  172.  
  173. XR1,    .-.                /AUTO-INDEX NUMBER 1
  174. XR2,    .-.                /AUTO-INDEX NUMBER 2
  175.  
  176.     *20                /GET PAST AUTO-INDEX AREA
  177.  
  178. BUFPTR,    .-.                /OUTPUT BUFFER POINTER
  179. CCNT,    .-.                /CHECKSUM COUNTER
  180. CHKSUM,    ZBLOCK    5            /CHECKSUM TEMPORARY
  181. CHRCNT,    .-.                /CHARACTER COUNTER
  182. CSUMTMP,.-.                /CHECKSUM TEMPORARY
  183. DANGCNT,.-.                /DANGER COUNT
  184. DATCNT,    .-.                /DATA COUNTER
  185. DSTATE,    .-.                /DATA STATE VARIABLE
  186. IDNUMBE,.-.                /INPUT DEVICE NUMBER
  187. IMSW,    .-.                /IMAGE-MODE SWITCH
  188. INITFLA,.-.                /INITIALIZE INPUT FLAG
  189. INPUT,    .-.                /INPUT HANDLER POINTER
  190. INRECOR,.-.                /INPUT RECORD
  191. FCHKSUM,ZBLOCK    5            /FILE CHECKSUM
  192. FNAME,    ZBLOCK    4            /OUTPUT FILENAME
  193. GWTMP1,    .-.                /GETWORD TEMPORARY
  194. GWTMP2,    .-.                /GETWORD TEMPORARY
  195. GWVALUE,.-.                /LATEST WORD VALUE
  196. ODNUMBE,.-.                /OUTPUT DEVICE NUMBER
  197. OUTPUT,    .-.                /OUTPUT HANDLER POINTER
  198. OUTRECO,.-.                /OUTPUT RECORD
  199. PUTEMP,    .-.                /OUTPUT TEMPORARY
  200. PUTPTR,    .-.                /OUTPUT POINTER
  201. THIRD,    .-.                /THIRD BYTE TEMPORARY
  202.  
  203. /    STATE TABLE.
  204.  
  205. P,    SCANIT                /0000 LOOKING FOR "(" OR "<"
  206.     FNDCOMMAND            /0001 FOUND "(" AND NOW LOOKING FOR ")"
  207.     FNDCEND                /0002 FOUND ")" AND NOW LOOKING FOR <CR>
  208.     FNDCR                /0003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET
  209.     STORDATA            /4000 FOUND "<" AND PROCESSING 69 DATA BYTES
  210.     ENDATA                /4001 FOUND 69 DATA BYTES AND NOW LOOKING FOR ">"
  211.     ENDCR                /4002 FOUND ">" AND NOW LOOKING FOR <CR>
  212.     FNDCR/ENDLF            /4003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET
  213.     PAGE                /START AT THE USUAL PLACE
  214.  
  215. BEGIN,    NOP                /HERE IN CASE WE'RE CHAINED TO
  216.     CLA                /CLEAN UP
  217. START,    CIF    USRFLD            /GOTO USR FIELD
  218.     JMS I    [USR]            /CALL USR ROUTINE
  219.     DECODE                /WANT COMMAND DECODER
  220.     "E^100+"N-300            /.EN IS DEFAULT EXTENSION
  221.     CDF    TBLFLD            /GOTO TABLE FIELD
  222.     TAD I    (TERMWRD)        /GET TERMINATOR WORD
  223.     SPA CLA                /SKIP IF <CR> TERMINATED THE LINE
  224.     DCA    EXITZAP            /ELSE CAUSE EXIT LATER
  225.     DCA    IMSW            /CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH
  226.     TAD I    (OUTFILE)        /GET FIRST OUTPUT FILE DEVICE WORD
  227.     SNA                /SKIP IF FIRST OUTPUT FILE PRESENT
  228.     JMP    TSTMORE            /JUMP IF NOT THERE
  229.     AND    [17]            /JUST DEVICE BITS
  230. ODNULL,    DCA    ODNUMBER        /SAVE OUTPUT DEVICE NUMBER
  231.     TAD I    (OUTFILE+5)        /GET SECOND OUTPUT FILE DEVICE WORD
  232.     SNA                /SKIP IF THERE
  233.     TAD I    (OUTFILE+12)        /ELSE GET THIRD OUTPUT FILE DEVICE WORD
  234.     SZA CLA                /SKIP IF BOTH NOT PRESENT
  235.     JMP I    (OUTERR)        /ELSE COMPLAIN
  236.     TAD I    (INFILE)        /GET FIRST INPUT FILE DEVICE WORD
  237.     SNA                /SKIP IF PRESENT
  238.     JMP I    (INERR)            /JUMP IF NOT
  239.     AND    [17]            /JUST DEVICE BITS
  240.     DCA    IDNUMBER        /SAVE INPUT DEVICE NUMBER
  241.     TAD I    (INFILE+2)        /GET SECOND INPUT FILE DEVICE WORD
  242.     SZA CLA                /SKIP IF ONLY ONE INPUT FILE
  243.     JMP I    (INERR)            /ELSE COMPLAIN
  244.     TAD I    (INFILE+1)        /GET FIRST INPUT FILE STARTING RECORD
  245.     DCA    INRECORD        /SET IT UP
  246.     CDF    PRGFLD            /BACK TO OUR FIELD
  247.     CIF    USRFLD            /GOTO USR FIELD
  248.     JMS I    [USR]            /CALL USR ROUTINE
  249.     RESET                /RESET SYSTEM TABLES
  250.     TAD    (IHNDBUFFER+1)        /GET INPUT BUFFER POINTER+TWO-PAGE BIT
  251.     DCA    IHPTR            /STORE IN-LINE
  252.     TAD    IDNUMBER        /GET INPUT DEVICE NUMBER
  253.     CIF    USRFLD            /GOTO USR FIELD
  254.     JMS I    [USR]            /CALL USR ROUTINE
  255.     FETCH                /FETCH HANDLER
  256. IHPTR,    .-.                /WILL BE BUFFER POINTER+TWO-PAGE BIT
  257.     JMP I    (FERROR)        /FETCH ERROR
  258.     TAD    IHPTR            /GET RETURNED ADDRESS
  259.     DCA    INPUT            /STORE AS INPUT HANDLER ADDRESS
  260.     JMS I    (GEOFILE)        /GET OUTPUT FILE INFORMATION
  261.     TAD    (OHNDBUFFER+1)        /GET BUFFER POINTER+TWO-PAGE BIT
  262.     DCA    OHPTR            /STORE IN-LINE
  263.     TAD    ODNUMBER        /GET OUTPUT DEVICE NUMBER
  264.     CIF    USRFLD            /GOTO USR FIELD
  265.     JMS I    [USR]            /CALL USR ROUTINE
  266.     FETCH                /FETCH HANDLER
  267. OHPTR,    .-.                /WILL BE BUFFER POINTER+TWO-PAGE BIT
  268.     JMP I    (FERROR)        /FETCH ERROR
  269.     TAD    OHPTR            /GET RETURNED ADDRESS
  270.     DCA    OUTPUT            /STORE AS OUTPUT HANDLER ADDRESS
  271.     TAD    IMSW            /GET IMAGE-MODE SWITCH
  272.     SNA CLA                /SKIP IF SET
  273.     JMP    NOIMAGE            /JUMP IF NOT
  274.  
  275. /    IF /2 IS SET,  THE  DATA  STARTS  HALF-WAY  INTO THE IMAGE.  OTHER IMAGE MODES
  276. /    START AT RECORD 0000.
  277.  
  278.     CDF    TBLFLD            /GOTO TABLE FIELD
  279.     TAD I    [SWY9]            /GET /Y-/9 SWITCHES
  280.     AND    (200)            /JUST /2 SWITCH
  281.     SNA CLA                /SKIP IF SET
  282.     JMP    IMAGE1            /JUMP IF /1 OR NEITHER /1, /2 SET
  283.     TAD I    [EQUWRD]        /GET EQUALS PARAMETER
  284.     CLL RAR                /%2
  285. IMAGE1,    DCA    OUTRECORD        /STORE STARTING OUTPUT RECORD
  286.     CDF    PRGFLD            /BACK TO OUR FIELD
  287.     SKP                /DON'T ENTER FILE NAME
  288. NOIMAGE,JMS I    (FENTER)        /ENTER THE TENTATIVE FILE NAME
  289.     DCA    DSTATE            /SET INITIAL DATA STATE
  290.     JMS I    (CLRCHKSUM)        /CLEAR OUT CHECKSUM
  291.     JMS I    (DECODIT)        /GO DO THE ACTUAL DECODING
  292.     JMP I    (PROCERR)        /ERROR WHILE DECODING
  293.     TAD    IMSW            /GET IMAGE-MODE SWITCH
  294.     SZA CLA                /SKIP IF CLEAR
  295.     JMP    EXITZAP            /JUMP IF SET
  296.     TAD    ODNUMBER        /GET OUTPUT DEVICE NUMBER
  297.     CIF    USRFLD            /GOTO USR FIELD
  298.     JMS I    [USR]            /CALL USR ROUTINE
  299.     CLOSE                /CLOSE OUTPUT FILE
  300.     FNAME                /POINTER TO FILENAME
  301. OUTCNT,    .-.                /WILL BE ACTUAL COUNT
  302.     JMP I    (CLSERR)        /CLOSE ERROR
  303. EXITZAP,JMP    START            /**** <ESC> TERMINATION **** 0000
  304.     JMP I    (SBOOT)            /EXIT TO MONITOR
  305. /    COMES HERE TO TEST FOR NULL LINE.
  306.  
  307. TSTMORE,TAD I    (OUTFILE+5)        /GET SECOND OUTPUT FILE DEVICE WORD
  308.     SNA                /SKIP IF PRESENT
  309.     TAD I    (OUTFILE+12)        /ELSE GET THIRD OUTPUT FILE DEVICE WORD
  310.     SZA CLA                /SKIP IF NO OUTPUT FILES
  311.     JMP I    (OUTERR)        /ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT 
  312.     TAD I    (INFILE)        /GET FIRST OUTPUT FILE DEVICE WORD
  313.     SZA CLA                /SKIP IF NO INPUT FILES
  314.     JMP    ODNULL            /JUMP IF INPUT WITHOUT OUTPUT
  315.     CDF    PRGFLD            /BACK TO OUR FIELD
  316.     JMP    EXITZAP            /MIGHT BE LAST TIME, SO GO THERE FIRST
  317.  
  318.     PAGE
  319. /    ERROR WHILE PROCESSING INPUT FILE.
  320.  
  321. PROCERR,NL0002                /SET INCREMENT
  322.     SKP                /DON'T USE NEXT
  323.  
  324. /    ERROR WHILE CLOSING THE OUTPUT FILE.
  325.  
  326. CLSERR,    NL0001                /SET INCREMENT
  327.     SKP                /DON'T CLEAR IT
  328.  
  329. /    OUTPUT FILE TOO LARGE ERROR.
  330.  
  331. SIZERR,    CLA                /CLEAN UP
  332.     TAD    [3]            /SET INCREMENT
  333.     SKP                /DON'T USE NEXT
  334.  
  335. /    ENTER ERROR.
  336.  
  337. ENTERR,    NL0002                /SET INCREMENT
  338.     SKP                /DON'T USE NEXT
  339.  
  340. /    HANDLER FETCH ERROR.
  341.  
  342. FERROR,    NL0001                /SET INCREMENT
  343.  
  344. /    I/O ERROR WHILE PROCESSING (FILE ) COMMAND.
  345.  
  346. NIOERR,    IAC                /SET INCREMENT
  347.  
  348. /    FORMAT ERROR WHILE PROCESSING (FILE ) COMMAND.
  349.  
  350. CHARERR,IAC                /SET INCREMENT
  351.  
  352. /    INPUT FILESPEC ERROR.
  353.  
  354. INERR,    IAC                /SET INCREMENT
  355.  
  356. /    OUTPUT FILESPEC ERROR.
  357.  
  358. OUTERR,    DCA    ERRNUMBER        /STORE ERROR NUMBER
  359.     CDF    PRGFLD            /ENSURE OUR FIELD
  360.     CIF    USRFLD            /GOTO USR FIELD
  361.     JMS I    [USR]            /CALL USR ROUTINE
  362.     USERROR                /USER ERROR
  363. ERRNUMB,.-.                /WILL BE PASSED ERROR NUMBER
  364. DECODIT,.-.                /DECODING ROUTINE
  365.     TAD    OUTRECORD        /GET STARTING RECORD OF TENTATIVE FILE
  366.     DCA    PUTRECORD        /STORE IN-LINE
  367.     DCA I    (OUTCNT)        /CLEAR ACTUAL FILE LENGTH
  368.     NL7777                /SETUP THE
  369.     DCA    INITFLAG        /INITIALIZE FLAG
  370.     TAD    (GWLOOP)        /INITIALIZE THE
  371.     DCA I    (GWNEXT)        /DECODE PACK ROUTINE
  372. PUTNEWR,TAD    POUTBUFFER/(OUTBUFFER)    /SETUP THE
  373.     DCA    PUTPTR            /OUTPUT BUFFER POINTER
  374. PUTLOOP,JMS I    (GETWORD)        /GET A WORD
  375.     DCA I    PUTPTR            /STORE IT
  376.     ISZ    PUTPTR            /BUMP TO NEXT
  377.     TAD    PUTPTR            /GET THE POINTER
  378.     TAD    (-2^200-OUTBUFFER)    /COMPARE TO LIMIT
  379.     SZA CLA                /SKIP IF AT END
  380.     JMP    PUTLOOP            /KEEP GOING
  381.     ISZ    DANGCNT            /TOO MANY RECORDS?
  382.     SKP                /SKIP IF NOT
  383.     JMP I    (SIZERROR)        /NOT ENOUGH SPACE AVAILABLE
  384.     JMS I    OUTPUT            /CALL OUTPUT HANDLER
  385.     2^100+WRITE            /WRITE LATEST RECORD
  386. POUTBUF,OUTBUFFER            /OUTPUT BUFFER ADDRESS
  387. PUTRECO,.-.                /WILL BE LATEST RECORD NUMBER
  388. DECERR,    JMP I    DECODIT            /I/O ERROR
  389.     ISZ    PUTRECORD        /BUMP TO NEXT RECORD
  390.     NOP                /JUST IN CASE
  391.     ISZ I    (OUTCNT)        /BUMP ACTUAL LENGTH
  392.     JMP    PUTNEWRECORD        /GO DO ANOTHER ONE
  393.  
  394. /    GOOD RETURN HERE.
  395.  
  396. DECBMP,    ISZ    DECODIT            /BUMP TO GOOD RETURN
  397.     JMP I    DECODIT            /RETURN
  398. /    OS/8 FILE UNPACK ROUTINE.
  399.  
  400. GETBYTE,.-.                /GET A BYTE ROUTINE
  401.     SNA CLA                /INITIALIZING?
  402.     JMP I    PUTC            /NO, GO GET NEXT BYTE
  403.     TAD    INRECORD        /GET STARTING RECORD OF INPUT FILE
  404.     DCA    GETRECORD        /STORE IN-LINE
  405. GETNEWR,JMS I    INPUT            /CALL I/O HANDLER
  406.     2^100                /READ TWO PAGES INTO BUFFER
  407.     INBUFFER            /BUFFER ADDRESS
  408. GETRECO,.-.                /WILL BE LATEST RECORD NUMBER
  409.     JMP I    GETBYTE            /INPUT ERROR!
  410.     TAD    (INBUFFER)        /SETUP THE
  411.     DCA    BUFPTR            /BUFFER POINTER
  412. GETLOOP,DCA    THIRD            /CLEAR THIRD BYTE NOW
  413.     JMS    PUTONE            /OBTAIN AND SEND BACK FIRST BYTE
  414.     JMS    PUTONE            /OBTAIN AND SEND BACK SECOND BYTE
  415.     TAD    THIRD            /GET THIRD BYTE
  416.     JMS    PUTC            /SEND IT BACK
  417.     TAD    BUFPTR            /GET THE POINTER
  418.     TAD    (-2^200-INBUFFER)    /COMPARE TO LIMIT
  419.     SZA CLA                /SKIP IF AT END
  420.     JMP    GETLOOP            /KEEP GOING
  421.     ISZ    GETRECORD        /BUMP TO NEXT RECORD
  422.     JMP    GETNEWRECORD        /GO DO ANOTHER ONE
  423.  
  424. PUTONE,    .-.                /SEND BACK A BYTE ROUTINE
  425.     TAD I    BUFPTR            /GET LATEST WORD
  426.     AND    (7400)            /JUST THIRD-BYTE NYBBLE
  427.     CLL RAL                /MOVE UP
  428.     TAD    THIRD            /GET OLD NYBBLE (IF ANY)
  429.     RTL;RTL                /MOVE UP NYBBLE BITS
  430.     DCA    THIRD            /SAVE FOR NEXT TIME
  431.     TAD I    BUFPTR            /GET LATEST WORD AGAIN
  432.     JMS    PUTC            /SEND BACK CURRENT BYTE
  433.     ISZ    BUFPTR            /BUMP TO NEXT WORD
  434.     JMP I    PUTONE            /RETURN
  435.  
  436. PUTC,    .-.                /SEND BACK LATEST BYTE ROUTINE
  437.     AND    (177)            /KEEP ONLY GOOD BITS
  438.     TAD    (-"Z!300)        /COMPARE TO <^Z>
  439.     SNA                /SKIP IF NOT ASCII <EOF>
  440.     JMP    GETEOF            /JUMP IF ASCII MODE <EOF>
  441.     TAD    ("Z&37)            /RESTORE THE CHARACTER
  442.     ISZ    GETBYTE            /BUMP PAST <EOF> RETURN
  443. GETEOF,    ISZ    GETBYTE            /BUMP PAST I/O ERROR RETURN
  444.     JMP I    GETBYTE            /RETURN TO MAIN CALLER
  445.     PAGE
  446. /    GET A DECODED WORD ROUTINE.
  447.  
  448. GETWORD,.-.                /GET A WORD ROUTINE
  449.     JMP I    GWNEXT            /GO WHERE YOU SHOULD GO
  450.  
  451. GWNEXT,    .-.                /EXIT ROUTINE
  452.     SNL                /SKIP IF CHECKSUM PREVENTED
  453.     JMS I    (DOCHECK)        /ELSE DO CHECKSUM
  454.     JMP I    GETWORD            /RETURN TO MAIN CALLER
  455.  
  456. /    COMES HERE TO PROCESSED COMPRESSED DATA.
  457.  
  458. GWX,    JMS I    (GETCHR)        /GET NEXT CHARACTER
  459.     JMS I    (GWORD0)        /GET 12-BIT WORD
  460.     JMS I    (DOCHECK)        /INCLUDE IN CHECKSUM
  461.     DCA    GWVALUE            /SAVE AS COMPRESSED VALUE
  462.     TAD    GWTMP2            /GET LATEST CHARACTER
  463.     AND    [7]            /ISOLATE BITS[9-11]
  464.     CLL RTR;RTR            /BITS[9-11] => AC[0-2]
  465.     DCA    GWTMP1            /SAVE FOR NOW
  466.     JMS    GBIHEXBINARY        /GET A CHARACTER
  467.     CLL RTL;RTL            /BITS[7-11] => AC[3-7]
  468.     TAD    GWTMP1            /ADD ON BITS[0-2]
  469.     JMS I    (DOCHECK)        /INCLUDE IN CHECKSUM
  470.     CLL RTR;RTR            /BITS[0-7] => AC[4-11]
  471.     SNA                /SKIP IF NOT 256
  472.     TAD    [400]            /000 => 256
  473.     CIA                /INVERT FOR COUNTING
  474.     DCA    GWTMP1            /SAVE AS REPEAT COUNTER
  475. GWXLUP,    TAD    GWVALUE            /GET THE VALUE
  476.     STL                /PREVENT CHECKSUMMING IT
  477.     JMS    GWNEXT            /RETURN IT TO THEM
  478.     ISZ    GWTMP1            /DONE ENOUGH?
  479.     JMP    GWXLUP            /NO, KEEP GOING
  480. /    COMES HERE TO INITIATE ANOTHER DATA GROUP.
  481.  
  482. GWLOOP,    JMS I    (GETCHR)        /GET LATEST FILE CHARACTER
  483.     TAD    (-"Z!200)        /COMPARE TO EOF INDICATOR
  484.     SNA                /SKIP IF OTHER
  485.     JMP    GWZ            /JUMP IF IT MATCHES
  486.     TAD    (-"X+"Z)        /COMPARE TO COMPRESSION INDICATOR
  487.     SNA CLA                /SKIP IF OTHER
  488.     JMP    GWX            /JUMP IF IT MATCHES
  489.     TAD    PUTEMP            /GET THE CHARACTER BACK
  490.     JMS I    (GWORD0)        /GET A 12-BIT WORD
  491.     JMS    GWNEXT            /RETURN IT
  492.     JMS I    (GWORD1)        /GET NEXT 12-BIT WORD
  493.     JMS    GWNEXT            /RETURN IT
  494.     JMS I    (GWORD2)        /GET NEXT 12-BIT WORD
  495.     JMS    GWNEXT            /RETURN IT
  496.     JMS I    (GWORD3)        /GET NEXT 12-BIT WORD
  497.     JMS    GWNEXT            /RETURN IT
  498.     JMS I    (GWORD4)        /GET NEXT 12-BIT WORD
  499.     JMS    GWNEXT            /RETURN IT
  500.     JMP    GWLOOP            /KEEP GOING
  501.  
  502. /    COMES HERE WHEN EOF INDICATOR FOUND.
  503.  
  504. GWZ,    TAD    (FCHKSUM-1)        /SETUP THE
  505.     DCA    XR1            /CHECKSUM POINTER
  506.     JMS I    (GETCHR)        /GET NEXT CHARACTER
  507.     JMS I    (GWORD0)        /GET A 12-BIT WORD
  508.     DCA I    XR1            /STORE IT
  509.     JMS I    (GWORD1)        /GET NEXT WORD
  510.     DCA I    XR1            /STORE IT
  511.     JMS I    (GWORD2)        /GET NEXT WORD
  512.     DCA I    XR1            /STORE IT
  513.     JMS I    (GWORD3)        /GET NEXT WORD
  514.     DCA I    XR1            /STORE IT
  515.     JMS I    (GWORD4)        /GET NEXT WORD
  516.     DCA I    XR1            /STORE IT
  517.     TAD    (CHKSUM-1)        /POINT TO
  518.     DCA    XR1            /CALCULATED CHECKSUM
  519.     TAD    (FCHKSUM-1)        /POINT TO
  520.     DCA    XR2            /FILE CHECKSUM
  521.     TAD    [-5]            /SETUP THE
  522.     DCA    CCNT            /COMPARE COUNT
  523.     CLL                /CLEAR LINK FOR TEST
  524. GWCMPLP,RAL                /GET CARRY
  525.     TAD I    XR1            /GET A CALCULATED WORD
  526.     TAD I    XR2            /COMPARE TO FILE WORD
  527.     SZA CLA                /SKIP IF OK
  528.     JMP I    (DECERR)        /ELSE COMPLAIN
  529.     ISZ    CCNT            /DONE ALL?
  530.     JMP    GWCMPLP            /NO, KEEP GOING
  531. /    THE CHECKSUM IS OK, CHECK IF FILE ENDED IN A PLAUSIBLE PLACE.
  532.  
  533.     TAD    PUTPTR            /GET OUTPUT POINTER
  534.     TAD    (-OUTBUFFER-4)        /COMPARE TO LIMIT
  535.     SMA SZA CLA            /SKIP IF GOOD VALUE
  536.     JMP I    (DECERROR)        /JUMP IF NOT
  537.  
  538. /    THE FILE ENDED OK, THERE WERE POSSIBLY A  FEW  CHARACTERS  LEFTOVER BECAUSE OF
  539. /    ALIGNMENT  CONSIDERATIONS.    THEY  SHOULD  BE  IGNORED SINCE OS/8  FILES  ARE
  540. /    MULTIPLES OF WHOLE RECORDS.
  541.  
  542.     JMP I    (DECBMP)        /RETURN WITH ALL OK
  543.  
  544. GBIHEXB,.-.                /GET BINARY VALUE OF BIHEXADECIMAL CHARACTER
  545.     CLA                /CLEAN UP
  546.     TAD    GBIHEXBINARY        /GET OUR CALLER
  547.     DCA    BIHEXBINARY        /MAKE IT THEIRS
  548.     JMS I    (GETCHR)        /GET A CHARACTER
  549.     SKP                /DON'T EXECUTE HEADER!
  550.  
  551. BIHEXBI,.-.                /CONVERT BIHEXADECIMAL TO BINARY
  552.     TAD    (-"A!200)        /COMPARE TO ALPHABETIC LIMIT
  553.     SMA                /SKIP IF LESS
  554.     TAD    ("9+1-"A)        /ELSE ADD ON ALPHABETIC OFFSET
  555.     TAD    (-"0+"A)        /MAKE IT BINARY, NOT ASCII
  556.     DCA    GWTMP2            /SAVE IT
  557.     TAD    GWTMP2            /GET IT BACK
  558.     JMP I    BIHEXBINARY        /RETURN
  559.  
  560.     PAGE
  561. /    GET  WORD[0]  ROUTINE.      AC  MUST  ALREADY  CONTAIN THE FIRST  BI-HEXADECIMAL
  562. /    CHARACTER.
  563.  
  564. GWORD0,    .-.                /GET 12-BIT WORD[0]
  565.     JMS I    (BIHEXBINARY)        /CONVERT PASSED VALUE TO BINARY
  566.     CLL RTR;RTR;RTR            /BITS[7-11] => AC[0-4]
  567.     DCA    GWTMP1            /SAVE FOR NOW
  568.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  569.     CLL RTL                /BITS[7-11] => AC[5-9]
  570.     TAD    GWTMP1            /ADD ON BITS[0-4]
  571.     DCA    GWTMP1            /SAVE FOR NOW
  572.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  573.     RTR;RAR                /BITS[7-8] => AC[10-11]
  574.     AND    [3]            /ISOLATE BITS[10-11]
  575.     TAD    GWTMP1            /ADD ON BITS[0-9]
  576.     CLL                /CLEAR LINK
  577.     JMP I    GWORD0            /RETURN
  578.  
  579. /    GET  WORD[1] ROUTINE.  GWORD0 MUST HAVE BEEN CALLED LAST, SO  GWTMP2  CONTAINS
  580. /    THE PREVIOUS CHARACTER.
  581.  
  582. GWORD1,    .-.                /GET 12-BIT WORD[1]
  583.     TAD    GWTMP2            /GET PREVIOUS CHARACTER
  584.     AND    [7]            /ISOLATE BITS[9-11]
  585.     CLL RTR;RTR            /BITS[9-11] => AC[0-2]
  586.     DCA    GWTMP1            /SAVE FOR NOW
  587.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  588.     CLL RTL;RTL            /BITS[7-11] => AC[3-7]
  589.     TAD    GWTMP1            /ADD ON BITS[0-2]
  590.     DCA    GWTMP1            /SAVE FOR NOW
  591.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  592.     CLL RAR                /BITS[7-10] => AC[8-11]
  593.     TAD    GWTMP1            /ADD ON BITS[0-7]
  594.     CLL                /CLEAR LINK
  595.     JMP I    GWORD1            /RETURN
  596. /    GET  WORD[2]  ROUTINE.    GWORD1 MUST HAVE BEEN CALLED LAST, SO GWTMP2  CONTAINS
  597. /    THE PREVIOUS CHARACTER.
  598.  
  599. GWORD2,    .-.                /GET 12-BIT WORD[2]
  600.     TAD    GWTMP2            /GET PREVIOUS CHARACTER
  601.     RAR;CLA RAR            /BIT[11] => AC[0]
  602.     DCA    GWTMP1            /SAVE FOR NOW
  603.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  604.     CLL RTL;RTL;RTL            /BITS[7-11] => AC[1-5]
  605.     TAD    GWTMP1            /ADD ON BIT[0]
  606.     DCA    GWTMP1            /SAVE FOR NOW
  607.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  608.     CLL RAL                /BITS[7-11] => AC[6-10]
  609.     TAD    GWTMP1            /ADD ON BITS[0-5]
  610.     DCA    GWTMP1            /SAVE FOR NOW
  611.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  612.     AND    (20)            /ISOLATE BIT[7]
  613.     CLL RTR;RTR            /BIT[7] => AC[11]
  614.     TAD    GWTMP1            /ADD ON BITS[0-10]
  615.     CLL                /CLEAR LINK
  616.     JMP I    GWORD2            /RETURN
  617.  
  618. /    GET  WORD[3]  ROUTINE.   GWORD2 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
  619. /    THE PREVIOUS CHARACTER.
  620.  
  621. GWORD3,    .-.                /GET 12-BIT WORD[3]
  622.     TAD    GWTMP2            /GET PREVIOUS CHARACTER
  623.     CLL RTR;RTR;RAR            /BITS[8-11] => AC[0-3]
  624.     DCA    GWTMP1            /SAVE FOR NOW
  625.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  626.     CLL RTL;RAL            /BITS[7-11] => AC[4-8]
  627.     TAD    GWTMP1            /ADD ON BITS[0-3]
  628.     DCA    GWTMP1            /SAVE FOR NOW
  629.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  630.     RTR                /BITS[7-9] => AC[9-11]
  631.     AND    [7]            /ISOLATE BITS[9-11]
  632.     TAD    GWTMP1            /ADD ON BITS[0-8]
  633.     CLL                /CLEAR LINK
  634.     JMP I    GWORD3            /RETURN
  635. /    GET WORD[4]  ROUTINE.     GWORD3 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
  636. /    THE PREVIOUS CHARACTER.
  637.  
  638. GWORD4,    .-.                /GET 12-BIT WORD[4]
  639.     TAD    GWTMP2            /GET PREVIOUS CHARACTER
  640.     AND    [3]            /ISOLATE BITS[10-11]
  641.     CLL RTR;RAR            /BITS[10-11] => AC[0-1]
  642.     DCA    GWTMP1            /SAVE FOR NOW
  643.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  644.     CLL RTL;RTL;RAL            /BITS[7-11] => AC[2-6]
  645.     TAD    GWTMP1            /ADD ON BITS[0-1]
  646.     DCA    GWTMP1            /SAVE FOR NOW
  647.     JMS I    (GBIHEXBINARY)        /GET NEXT CHARACTER IN BINARY
  648.     TAD    GWTMP1            /ADD ON BITS[0-6] TO BITS[7-11]
  649.     CLL                /CLEAR LINK
  650.     JMP I    GWORD4            /RETURN
  651.  
  652. DOCHECK,.-.                /CHECKSUM ROUTINE
  653.     DCA    CSUMTMP            /SAVE PASSED VALUE
  654.     TAD    (CHKSUM-1)        /SETUP THE
  655.     DCA    XR1            /INPUT POINTER
  656.     TAD    (CHKSUM-1)        /SETUP THE
  657.     DCA    XR2            /OUTPUT POINTER
  658.     TAD    [-5]            /SETUP THE
  659.     DCA    CCNT            /SUM COUNT
  660.     TAD    CSUMTMP            /GET THE VALUE
  661.     CLL RAR                /ADJUST FOR OPENING ITERATION
  662. CSUMLUP,RAL                /GET CARRY
  663.     TAD I    XR1            /ADD ON A WORD
  664.     DCA I    XR2            /STORE BACK
  665.     ISZ    CCNT            /DONE ALL YET?
  666.     JMP    CSUMLUP            /NO, KEEP GOING
  667.     TAD    CSUMTMP            /GET LATEST VALUE
  668.     JMP I    DOCHECK            /RETURN
  669.  
  670.     PAGE
  671. GETCHR,    .-.                /GET A VALID CHARACTER ROUTINE
  672. GETMORE,TAD    INITFLAG        /GET INITIALIZE FLAG
  673.     JMS I    [GETBYTE]        /GET A CHARACTER
  674.     JMP I    (DECERR)        /I/O ERROR
  675.     JMP I    (DECERR)        /<EOF>
  676.     DCA    PUTEMP            /SAVE THE CHARACTER
  677.     DCA    INITFLAG        /CLEAR INITIALIZE FLAG
  678.     TAD    DSTATE            /GET DATA STATE
  679.     SPA                /SKIP IF NOT ONE OF THE DATA-ORIENTED STATES
  680.     TAD    (4004)            /ADD ON DATA-ORIENTED STATES OFFSET
  681.     TAD    (JMP I    P)        /SETUP JUMP INSTRUCTION
  682.     DCA    .+1            /STORE IN-LINE
  683.     .-.                /AND EXECUTE IT
  684.  
  685. /    LOOKING FOR OPENING CHARACTER.
  686.  
  687. SCANIT,    TAD    PUTEMP            /GET THE CHARACTER
  688.     TAD    (-"<!200)        /COMPARE TO OPENING DATA CHARACTER
  689.     SNA                /SKIP IF NO MATCH
  690.     JMP    FNDATA            /JUMP IF IT MATCHES
  691.     TAD    (-"(+"<)        /COMPARE TO OPENING COMMAND CHARACTER
  692.     SNA CLA                /SKIP IF NO MATCH
  693.     ISZ    DSTATE            /INDICATE LOOKING FOR END OF COMMAND
  694.     JMP    GETMORE            /KEEP GOING
  695.  
  696. /    FOUND OPENING COMMAND CHARACTER.
  697.  
  698. FNDCOMM,TAD    PUTEMP            /GET THE CHARACTER
  699.     TAD    (-")!200)        /COMPARE TO CLOSING COMMAND CHARACTER
  700.     SNA CLA                /SKIP IF NO MATCH
  701.     ISZ    DSTATE            /INDICATE LOOKING FOR <CR>
  702.     JMP    GETMORE            /KEEP GOING
  703.  
  704. /    FOUND CLOSING COMMAND CHARACTER.
  705.  
  706. FNDCEND,TAD    PUTEMP            /GET THE CHARACTER
  707.     TAD    (-"M!300)        /COMPARE TO <CR>
  708.     SNA CLA                /SKIP IF NO MATCH
  709.     ISZ    DSTATE            /INDICATE LOOKING FOR <LF>
  710.     JMP    GETMORE            /KEEP GOING
  711.  
  712. /    FOUND <CR> AFTER COMMAND.
  713.  
  714. FNDCR,    TAD    PUTEMP            /GET THE CHARACTER
  715.     TAD    (-"J!300)        /COMPARE TO <LF>
  716.     SNA CLA                /SKIP IF NO MATCH
  717.     DCA    DSTATE            /RESET TO SCANNING STATE
  718.     JMP    GETMORE            /KEEP GOING
  719. /    FOUND OPENING DATA CHARACTER.
  720.  
  721. FNDATA,    TAD    (-WIDTH)        /SETUP THE
  722.     DCA    DATCNT            /DATA COUNTER
  723.     NL4000                /SETUP THE
  724.     DCA    DSTATE            /NEW STATE
  725.     JMP    GETMORE            /KEEP GOING
  726.  
  727. /    PROCESSING ONE OF 69 DATA CHARACTERS.
  728.  
  729. STORDAT,TAD    PUTEMP            /GET THE CHARACTER
  730.     TAD    [-140]            /SUBTRACT UPPER-CASE LIMIT
  731.     SPA                /SKIP IF LOWER-CASE
  732.     TAD    [40]            /RESTORE UPPER-CASE
  733.     TAD    (100)            /RESTORE THE CHARACTER
  734.     DCA    PUTEMP            /SAVE IT BACK
  735.     TAD    PUTEMP            /GET IT AGAIN
  736.     TAD    (-"Z!200-1)        /SUBTRACT UPPER LIMIT
  737.     CLL                /CLEAR LINK FOR TEST
  738.     TAD    ("Z-"A+1)        /ADD ON RANGE
  739.     SZL CLA                /SKIP IF NOT ALPHABETIC
  740.     JMP    ALPHAOK            /JUMP IF ALPHABETIC
  741.     TAD    PUTEMP            /GET THE CHARACTER
  742.     TAD    (-"9!200-1)        /ADD ON UPPER LIMIT
  743.     CLL                /CLEAR LINK FOR TEST
  744.     TAD    ("9-"0+1)        /ADD ON RANGE
  745.     SNL CLA                /SKIP IF OK
  746.     JMP    GETMORE            /IGNORE IF NOT
  747. ALPHAOK,TAD    PUTEMP            /GET THE CHARACTER
  748.     ISZ    DATCNT            /DONE 69 CHARACTERS?
  749.     SKP                /SKIP IF NOT
  750.     ISZ    DSTATE            /ADVANCE TO NEXT STATE
  751.     JMP I    GETCHR            /RETURN
  752.  
  753. /    PROCESSED 69 DATA CHARACTERS; NOW LOOKING FOR ENDING DATA CHARACTER.
  754.  
  755. ENDATA,    TAD    PUTEMP            /GET THE CHARACTER
  756.     TAD    (-">!200)        /COMPARE TO ENDING DATA VALUE
  757.     SNA CLA                /SKIP IF NO MATCH
  758.     ISZ    DSTATE            /ELSE ADVANCE TO NEXT STATE
  759.     JMP    GETMORE            /KEEP GOING
  760.  
  761. /    FOUND ENDING DATA CHARACTER; NOW LOOKING FOR <CR>.
  762.  
  763. ENDCR,    TAD    PUTEMP            /GET THE CHARACTER
  764.     TAD    (-"M!300)        /COMPARE TO <CR>
  765.     SNA CLA                /SKIP IF NO MATCH
  766.     ISZ    DSTATE            /ELSE ADVANCE TO NEXT STATE
  767.     JMP    GETMORE            /KEEP GOING
  768. /    FOUND ENDING DATA CHARACTER AND <CR>; NOW LOOKING FOR <LF>.
  769.  
  770. /ENDLF,    TAD    PUTEMP            /GET THE CHARACTER
  771. /    TAD    (-"J!300)        /COMPARE TO <LF>
  772. /    SNA CLA                /SKIP IF NO MATCH
  773. /    DCA    DSTATE            /RESET TO SCANNING STATE
  774. /    JMP    GETMORE            /KEEP GOING
  775.  
  776. CLRCHKS,.-.                /CLEAR CALCULATED CHECKSUM ROUTINE
  777.     DCA    CHKSUM+0        /CLEAR LOW-ORDER
  778.     DCA    CHKSUM+1        /CLEAR NEXT
  779.     DCA    CHKSUM+2        /CLEAR NEXT
  780.     DCA    CHKSUM+3        /CLEAR NEXT
  781.     DCA    CHKSUM+4        /CLEAR HIGH-ORDER
  782.     JMP I    CLRCHKSUM        /RETURN
  783.  
  784.     PAGE
  785. GEOFILE,.-.                /GET OUTPUT FILE ROUTINE
  786.     TAD    ODNUMBER        /GET OUTPUT DEVICE NUMBER
  787.     SZA CLA                /SKIP IF NOT ESTABLISHED YET
  788.     JMP    GOTOD            /JUMP IF DETERMINED ALREADY
  789.     TAD    ("D^100+"S-300)        /GET BEGINNING OF "DSK"
  790.     DCA    DEVNAME            /STORE IN-LINE
  791.     TAD    ("K^100)        /GET REST OF "DSK"
  792.     DCA    DEVNAME+1        /STORE IN-LINE
  793.     DCA    RETVAL            /CLEAR HANDLER ENTRY WORD
  794.     CDF    PRGFLD            /INDICATE OUR FIELD
  795.     CIF    USRFLD            /GOTO USR FIELD
  796.     JMS I    [USR]            /CALL USR ROUTINE
  797.     INQUIRE                /INQUIRE ABOUT HANDLER
  798. DEVNAME,ZBLOCK    2            /WILL BE DEVICE DSK
  799. RETVAL,    .-.                /BECOMES HANDLER ENTRY POINT WORD
  800.     HLT                /DSK: NOT IN SYSTEM IS IMPOSSIBLE!
  801.     TAD    DEVNAME+1        /GET DEVICE NUMBER FOR DSK:
  802.     AND    [17]            /JUST DEVICE BITS
  803.     DCA    ODNUMBER        /STORE OUTPUT DEVICE
  804. GOTOD,    CDF    TBLFLD            /BACK TO TABLE FIELD
  805.     TAD I    (OUTFILE+1)        /GET OUTPUT FILE FIRST NAME WORD
  806.     SNA                /SKIP IF PRESENT
  807.     JMP    GFLNAME            /JUMP IF NOT
  808.     DCA    FNAME            /MOVE TO OUR AREA
  809.     TAD I    (OUTFILE+2)        /GET SECOND NAME WORD
  810.     DCA    FNAME+1            /MOVE IT
  811.     TAD I    (OUTFILE+3)        /GET THIRD NAME WORD
  812.     DCA    FNAME+2            /MOVE IT
  813.     TAD I    (OUTFILE+4)        /GET EXTENSION WORD
  814.     DCA    FNAME+3            /MOVE IT
  815. GEOFXIT,CDF    PRGFLD            /BACK TO OUR FIELD
  816.     JMP I    GEOFILE            /RETURN
  817.  
  818. /    WE  MUST  TAKE  THE  FILENAME  FROM  THE IMBEDDED (FILE ) COMMAND.   THE  ONLY
  819. /    EXCEPTION IS IF WE ARE DOING AN IMAGE TRANSFER.
  820.  
  821. GFLNAME,TAD I    (SWAL)            /GET /A-/L SWITCHES
  822.     AND    (10)            /JUST /I BIT
  823.     SZA CLA                /SKIP IF NOT SET
  824.     TAD I    [EQUWRD]        /GET EQUALS PARAMETER
  825.     SNA                /SKIP IF SET TO SOMETHING
  826.     JMP    DOFLNAME        /JUMP IF PARAMETERS NOT SET
  827.     CMA                /INVERT IT
  828.     DCA    DANGCNT            /STORE AS DANGER COUNT
  829.     ISZ    IMSW            /SET IMAGE-MODE SWITCH
  830.     TAD I    [SWY9]            /GET /Y-/9 SWITCHES
  831.     AND    (600)            /JUST /1, /2 SWITCHES
  832.     SNA                /SKIP IF EITHER SET
  833.     JMP    GEOFXIT            /JUMP IF NEITHER SET
  834.     AND    [400]            /JUST /1 SWITCH
  835.     SNA CLA                /SKIP IF /1 SET
  836.     JMP    IM2            /JUMP IF /2 SET
  837.     TAD I    [EQUWRD]        /GET EQUALS PARAMETER
  838.     CLL RAR                /%2
  839.     JMP    IMCOMMON        /CONTINUE THERE
  840. IM2,    TAD I    [EQUWRD]        /GET EQUALS PARAMETER
  841.     CLL RAR                /%2
  842.     CIA                /SUBTRACT PART 1 VALUE
  843.     TAD I    [EQUWRD]        /FROM EQUALS PARAMETER
  844. IMCOMMO,CMA                /INVERT IT
  845.     DCA    DANGCNT            /STORE AS DANGER COUNT
  846.     JMP    GEOFXIT            /EXIT THERE
  847.  
  848. DOFLNAM,CDF    PRGFLD            /BACK TO OUR FIELD
  849.     NL7777                /SETUP THE
  850.     DCA    INITFLAG        /INPUT FILE INITIALIZATION
  851.     JMS I    (SCNFILE)        /SCAN OFF "(FILE"
  852.  
  853. /    HAVING FOUND THE (FILE ) COMMAND, WE MUST FIND THE FILENAME.
  854.  
  855. /    ZERO OUT THE FILENAME AREA.
  856.  
  857.     TAD    (-10)            /SETUP THE
  858.     DCA    CHRCNT            /CLEAR COUNTER
  859.     TAD    (ONAME-1)        /SETUP THE
  860.     DCA    XR1            /POINTER
  861.     JMS I    (CLRNAME)        /CLEAR THE NAME BUFFER
  862.  
  863. /    SETUP FOR SCANNING THE NAME PORTION.
  864.  
  865.     TAD    (-6)            /SETUP THE
  866.     DCA    CHRCNT            /SCAN COUNT
  867.     TAD    (ONAME-1)        /SETUP THE
  868.     DCA    XR1            /POINTER
  869. FNCAGN,    JMS I    (GETAN)            /GET A CHARACTER
  870.     JMP    GOTSEPARATOR        /GOT "."; GOTO NEXT FIELD
  871.     DCA I    XR1            /STASH THE CHARACTER
  872.     ISZ    CHRCNT            /DONE ALL YET?
  873.     JMP    FNCAGN            /NO, KEEP GOING
  874.  
  875. /    THROW AWAY EXTRA NAME CHARACTERS.
  876.  
  877. TOSSNAM,JMS I    (GETAN)            /GET A CHARACTER
  878.     JMP    GOTSEPARATOR        /GOT "."; GOTO NEXT FIELD
  879.     JMP    TOSSNAME        /KEEP GOING
  880.  
  881. /    COMES HERE AFTER "." FOUND.
  882.  
  883. GOTSEPA,JMS I    (CLRNAME)        /CLEAR OUT THE REMAINING NAME FIELD
  884.     NL7776                /SETUP THE
  885.     DCA    CHRCNT            /SCAN COUNT
  886. EXCAGN,    JMS I    (GETAN)            /GET A CHARACTER
  887.     JMP I    [CHARERROR]        /GOT "."; COMPLAIN
  888.     DCA I    XR1            /STASH THE CHARACTER
  889.     ISZ    CHRCNT            /DONE ENOUGH YET?
  890.     JMP    EXCAGN            /NO, KEEP GOING
  891. /    TOSS ANY EXTRA EXTENSION CHARACTERS.
  892.  
  893. TOSSEXT,JMS I    (GETAN)            /GET A CHARACTER
  894.     JMP I    [CHARERROR]        /GOT "."; COMPLAIN
  895.     JMP    TOSSEXTENSION        /KEEP GOING
  896.  
  897. /    COMES HERE WHEN TRAILING ")" IS FOUND.
  898.  
  899. GOTRPAR,JMS I    (CLRNAME)        /CLEAR ANY REMAINING EXTENSION CHARACTERS
  900.     TAD I    (ONAME)            /GET THE FIRST CHARACTER
  901.     SNA CLA                /SKIP IF SOMETHING THERE
  902.     JMP I    [CHARERROR]        /COMPLAIN IF NONE THERE
  903.     TAD    (ONAME-1)        /SETUP POINTER
  904.     DCA    XR1            /TO NAME CHARACTERS
  905.     TAD    (FNAME-1)        /SETUP POINTER
  906.     DCA    XR2            /TO PACKED NAME AREA
  907.     TAD    (-4)            /SETUP THE
  908.     DCA    CHRCNT            /MOVE COUNT
  909. CHRLOOP,TAD I    XR1            /GET FIRST CHARACTER
  910.     CLL RTL;RTL;RTL            /MOVE UP
  911.     TAD I    XR1            /ADD ON SECOND CHARACTER
  912.     DCA I    XR2            /STORE THE PAIR
  913.     ISZ    CHRCNT            /DONE YET?
  914.     JMP    CHRLOOP            /NO, KEEP GOING
  915.     JMP I    GEOFILE            /YES, RETURN
  916.  
  917.     PAGE
  918. SCNFILE,.-.                /SCAN "(FILE" ROUTINE
  919. MATAGN,    JMS    GETNSPC            /GET A CHARACTER
  920.     TAD    (-"(!200)        /COMPARE TO "("
  921.     SZA CLA                /SKIP IF IT MATCHES
  922.     JMP    MATAGN            /JUMP IF NOT
  923.     JMS    GETNSPC            /GET NEXT CHARACTER
  924.     TAD    (-"F!300)        /COMPARE TO "F"
  925.     SZA CLA                /SKIP IF IT MATCHES
  926.     JMP    MATAGN            /JUMP IF NOT
  927.     JMS    GETNSPC            /GET NEXT CHARACTER
  928.     TAD    (-"I!300)        /COMPARE TO "I"
  929.     SZA CLA                /SKIP IF IT MATCHES
  930.     JMP    MATAGN            /JUMP IF NOT
  931.     JMS    GETNSPC            /GET NEXT CHARACTER
  932.     TAD    (-"L!300)        /COMPARE TO "L"
  933.     SZA CLA                /SKIP IF IT MATCHES
  934.     JMP    MATAGN            /JUMP IF NOT
  935.     JMS    GETNSPC            /GET NEXT CHARACTER
  936.     TAD    (-"E!300)        /COMPARE TO "E"
  937.     SZA CLA                /SKIP IF IT MATCHES
  938.     JMP    MATAGN            /JUMP IF NOT
  939.     JMP I    SCNFILE            /RETURN
  940.  
  941. CLRNAME,.-.                /NAME FIELD CLEARING ROUTINE
  942.     TAD    CHRCNT            /GET CHARACTER COUNTER
  943.     SNA CLA                /SKIP IF ANY TO CLEAR
  944.     JMP I    CLRNAME            /ELSE JUST RETURN
  945.     DCA I    XR1            /CLEAR A NAME WORD
  946.     ISZ    CHRCNT            /COUNT IT
  947.     JMP    .-2            /KEEP GOING
  948.     JMP I    CLRNAME            /RETURN
  949.  
  950. GETNSPC,.-.                /GET NON-<SPACE> CHARACTER
  951. GETNAGN,JMS    GETCHAR            /GET A CHARACTER
  952.     TAD    (-" !200)        /COMPARE TO <SPACE>
  953.     SNA CLA                /SKIP IF OTHER
  954.     JMP    GETNAGN            /JUMP IF IT MATCHES
  955.     TAD    PUTEMP            /GET THE CHARACTER BACK
  956.     JMP I    GETNSPC            /RETURN
  957.  
  958. GETCHAR,.-.                /GET A CHARACTER ROUTINE
  959.     CLA                /CLEAN UP
  960.     TAD    INITFLAG        /GET INITIALIZE FLAG
  961.     JMS I    [GETBYTE]        /GET A CHARACTER
  962.     JMP I    (NIOERROR)        /COMPLAIN IF AN ERROR
  963.     JMP I    [CHARERROR]        /COMPLAIN IF <EOF> REACHED
  964.     TAD    [-140]            /COMPARE TO LOWER-CASE LIMIT
  965.     SPA                /SKIP IF LOWER-CASE
  966.     TAD    [40]            /RESTORE ORIGINAL IF UPPER-CASE
  967.     AND    (77)            /JUST SIX-BIT
  968.     DCA    PUTEMP            /SAVE IN CASE WE NEED IT
  969.     DCA    INITFLAG        /CLEAR INITIALIZE FLAG
  970.     TAD    PUTEMP            /GET IT BACK
  971.     JMP I    GETCHAR            /RETURN
  972. GETAN,    .-.                /GET ALPHANUMERIC ROUTINE
  973.     JMS    GETNSPC            /GET A NON-<SPACE> CHARACTER
  974.     TAD    (-".!200)        /COMPARE TO "."
  975.     SNA                /SKIP IF OTHER
  976.     JMP I    GETAN            /TAKE FIRST RETURN IF IT MATCHES
  977.     TAD    (-")+".)        /COMPARE TO ")"
  978.     SNA                /SKIP IF OTHER
  979.     JMP I    (GOTRPAREN)        /TAKE DEDICATED RETURN IF IT MATCHES
  980.     TAD    (-":+"))        /SUBTRACT UPPER LIMIT
  981.     CLL                /CLEAR LINK FOR TEST
  982.     TAD    (":-"0)            /ADD ON RANGE
  983.     SZL CLA                /SKIP IF NOT NUMERIC
  984.     JMP    GETANOK            /JUMP IF NUMERIC
  985.     TAD    PUTEMP            /GET THE CHARACTER BACK
  986.     TAD    (-"[!300)        /SUBTRACT UPPER LIMIT
  987.     CLL                /CLEAR LINK FOR TEST
  988.     TAD    ("[-"A)            /ADD ON RANGE
  989.     SNL CLA                /SKIP IF ALPHABETIC
  990.     JMP I    [CHARERROR]        /ELSE COMPLAIN
  991. GETANOK,TAD    PUTEMP            /GET GOOD ALPHANUMERIC CHARACTER
  992.     ISZ    GETAN            /BUMP TO SKIP RETURN
  993.     JMP I    GETAN            /RETURN
  994.  
  995. ONAME,    ZBLOCK    10            /OUTPUT NAME FIELD
  996.  
  997. FENTER, .-.                         /FILE ENTER ROUTINE
  998.     TAD    (FNAME)            /POINT TO
  999.     DCA    ENTAR1            /STORED FILENAME
  1000.     DCA    ENTAR2            /CLEAR SECOND ARGUMENT
  1001.     TAD    ODNUMBER        /GET OUTPUT DEVICE NUMBER
  1002.     CIF    USRFLD            /GOTO USR FIELD
  1003.     JMS I    [USR]            /CALL USR ROUTINE
  1004.     ENTER                /ENTER TENTATIVE FILENAME
  1005. ENTAR1,    .-.                /WILL POINT TO FILENAME
  1006. ENTAR2,    .-.                /WILL BE ZERO
  1007.     JMP I    (ENTERR)        /ENTER ERROR
  1008.     TAD    ENTAR2            /GET RETURNED EMPTY LENGTH
  1009.     IAC                /ADD 2-1 FOR OS/278 CRAZINESS
  1010.     DCA    DANGCNT            /STORE AS DANGER COUNT
  1011.     TAD    ENTAR1            /GET RETURNED FIRST RECORD
  1012.     DCA    OUTRECORD        /SETUP OUTPUT RECORD
  1013.         JMP I   FENTER              /RETURN
  1014.     PAGE
  1015.  
  1016.     $                /THAT'S ALL FOLK!
  1017.