home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / d / k12enc.pal < prev    next >
Text File  |  2020-01-01  |  35KB  |  1,090 lines
  1. /    OS/8 ENCODING PROGRAM
  2.  
  3. /    LAST EDIT:    08-JUL-1992    22:00:00    CJL
  4.  
  5. /    MUST BE ASSEMBLED WITH '/F' SWITCH SET.
  6.  
  7. /    PROGRAM TO ENCODE OS/8 FILES INTO "PRINTABLE" ASCII FORMAT ("ENCODE").
  8.  
  9. /    DISTRIBUTED BY CUCCA AS "K12ENC.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. /    .RUN DEV ENCODE        INVOKE PROGRAM
  22. /    *OUTPUT<INPUT        PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <CR>)
  23. /    *OUTPUT<DEV:=NNNN/I     ****  SPECIAL IMAGE TRANSFER MODE **** INPUT IS RECORD
  24. /                0000-[NNNN-1] ON DEVICE DEV:.  THE =NNNN VALUE MUST BE
  25. /                STATED PRECISELY TO  TRANSFER  THE REQUISITE AMOUNT OF
  26. /                THE DEVICE AS REQUIRED.    THE  VALUE IS GENERALLY THE
  27. /                TOTAL  LENGTH OF THE DEVICE,  BUT  COULD  BE  LESS  AS
  28. /                NECESSARY;  LARGER VALUES WILL GENERALLY  FAIL.   THIS
  29. /                MODE  SHOULD  ONLY  BE  USED  TO  EFFECT  TRANSFER  OF
  30. /                COMPLETE  DEVICE  IMAGES  WHERE  THE  NORMAL OS/8 FILE
  31. /                STRUCTURE IS UNSUITABLE.  IN THIS MODE, THE OS/8  FILE
  32. /                (POSSIBLY PRESENT)  ON  THE  DEVICE  IS IGNORED.  ****
  33. /                NOTE  ****  THIS   METHOD  VIOLATES  ALL  OS/8  DEVICE
  34. /                STRUCTURE AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE
  35. /                IMAGES ONLY;  USE WITH CARE!
  36. /    *OUTPUT<DEV:=NNNN/I/1    **** SPECIAL IMAGE TRANSFER  MODE **** SAME AS REGULAR
  37. /                IMAGE MODE EXCEPT ONLY THE FIRST  HALF  OF THE DATA IS
  38. /                USED.    THE  DECODER  MUST  BE  GIVEN THE  EQUIVALENT
  39. /                PARAMETERS TO TRANSFER THE FIRST HALF.
  40. /    *OUTPUT<DEV:=NNNN/I/2    **** SPECIAL IMAGE  TRANSFER MODE **** SAME AS REGULAR
  41. /                IMAGE MODE EXCEPT ONLY THE SECOND  HALF OF THE DATA IS
  42. /                USED.  NOTE THAT THERE MUST BE TWO  FILES CREATED, ONE
  43. /                USING  /I/1  AND  THE  OTHER  USING /I/2 TO COMPLETELY
  44. /                TRANSFER A DEVICE IMAGE UNLESS /I IS USED ALONE!
  45. /    *OUTPUT<INPUT$        PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <ESC>)
  46. /    .            PROGRAM EXITS NORMALLY
  47.  
  48. /    INPUT FILE ASSUMES .SV EXTENSION;  THERE IS NO ASSUMED OUTPUT  EXTENSION.   IF
  49. /    IMAGE MODE IS USED, THERE IS NO INPUT FILE SPECIFICATION;  ONLY  A  DEVICE  IS
  50. /    GIVEN ALONG WITH A LENGTH AND THE MANDATORY /I SWITCH.
  51.  
  52. /    PROGRAM EXIT  IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
  53. /    KEYBOARD DURING THE  COMMAND,  OR  ENDING THE COMMAND INPUT LINE WITH AN <ESC>
  54. /    CHARACTER.
  55. /    THIS PROGRAM SUPPORTS A SUBSET OF THE  ASCII FILE ENCODING SCHEME DEVELOPED BY
  56. /    CHARLES LASNER AND FRANK DA CRUZ.  THE  SCHEME  USED IS FIVE-BIT ENCODING WITH
  57. /    COMPRESSION,  (AS  OPPOSED  TO  SIX-BIT WITHOUT COMPRESSION AS USED  IN  PRIOR
  58. /    VERSIONS).
  59.  
  60. /    RESTRICTIONS:
  61.  
  62. /    A)    NO SUPPORT FOR MULTIPLE DECODABLE FILES PER ENCODED FILE.
  63.  
  64. /    B)    CREATES ENCODED PDP-8 60-BIT CHECKSUM AT END OF FILE.
  65.  
  66. /    C)    CUSTOMIZED (REMARK) COMMANDS MUST BE SEPARATELY ADDED BY THE USER.
  67.  
  68. /    D)    THE FILENAME IN THE (FILE ) AND (END ) COMMANDS WILL BE  IDENTICAL  TO
  69. /        THE ACTUAL INVOKED INPUT FILE.  THE USER MUST SEPARATELY MODIFY  THESE
  70. /        COMMANDS  WHEN  EXPORTING  THE ENCODED FILE TO A SYSTEM WITH DIFFERENT
  71. /        NAMING CONVENTIONS.
  72.  
  73. /    ERROR MESSAGES.
  74.  
  75. /    ERROR MESSAGES ARE ONE OF TWO VARIETIES:   COMMAND  DECODER  MESSAGES AND USER
  76. /    (PROGRAM-SIGNALLED) MESSAGES.
  77.  
  78. /    COMMAND  DECODER  MESSAGES  ARE  NON-FATAL  AND  MERELY  REQUIRE RETYPING  THE
  79. /    COMMAND.  ATTEMPTING TO USE MORE THAN ONE OUTPUT FILE  WILL  YIELD THE COMMAND
  80. /    DECODER  MESSAGE  "TOO MANY FILES" AND CAUSE A REPEAT OF THE  COMMAND  DECODER
  81. /    PROMPT REQUIRING  USER  INPUT.  THE USER IS DIRECTED TO OTHER DOCUMENTATION OF
  82. /    THE "SPECIAL" MODE  OF  THE  COMMAND DECODER, AS THAT IS THE ONLY MODE USED BY
  83. /    THIS UTILITY PROGRAM.
  84.  
  85. /    ANY USER MESSAGE PRINTED IS A  FATAL  ERROR MESSAGE CAUSED BY A PROBLEM BEYOND
  86. /    THE SCOPE OF THE COMMAND DECODER.   ALL  USER  MESSAGES  ARE THE STANDARD OS/8
  87. /    "USER" ERROR MESSAGES OF THE FORM:  "USER  ERROR  X  AT AAAAA", WHERE X IS THE
  88. /    ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE  THE  ERROR  WAS DETECTED.
  89. /    THE FOLLOWING USER ERRORS ARE DEFINED:
  90.  
  91. /    ERROR NUMBER        PROBABLE CAUSE
  92.  
  93. /    0            NO OUTPUT FILE.
  94.  
  95. /    1            INPUT FILE ERROR  (CAN'T  FIND INPUT FILE) OR NO INPUT
  96. /                FILE SPECIFIED OR TOO MANY INPUT FILES SPECIFIED.
  97. /    2            ILLEGAL OUTPUT FILE NAME (WILD CARDS NOT ALLOWED).
  98.  
  99. /    3            NO OUTPUT FILE NAME (DEVICE ONLY IS NOT ALLOWED).
  100.  
  101. /    4            ERROR WHILE FETCHING FILE HANDLER.
  102.  
  103. /    5            ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
  104.  
  105. /    6            OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
  106.  
  107. /    7            ERROR WHILE CLOSING THE OUTPUT FILE.
  108.  
  109. /    8            I/O ERROR WHILE ENCODING FILE DATA.
  110. /    ASSEMBLY INSTRUCTIONS.
  111.  
  112. /    IT IS  ASSUMED  THE  SOURCE  FILE  K12ENC.PAL  HAS  BEEN  MOVED AND RENAMED TO
  113. /    DSK:ENCODE.PA.
  114.  
  115. /    .PAL ENCODE<ENCODE/E/F    ASSEMBLE SOURCE PROGRAM
  116. /    .LOAD ENCODE        LOAD THE BINARY FILE
  117. /    .SAVE DEV ENCODE=2001    SAVE THE CORE-IMAGE FILE
  118. /    DEFINITIONS.
  119.  
  120.     AIWCNT=    1404            /ADDITIONAL INFORMATION WORDS COUNT HERE
  121.     AIWXR=    0017            /POINTER TO ADDITIONAL INFORMATION WORDS
  122.     CLOSE=    4            /CLOSE OUTPUT FILE
  123.     DATEXT=    7777            /DATE EXTENSION HERE
  124.     DATWRD=    7666            /OS/8 DATE WORD
  125.     DECODE=    5            /CALL COMMAND DECODER
  126.     ENTER=    3            /ENTER TENTATIVE FILE
  127.     EQUWRD=    7646            /EQUALS PARAMETER HERE IN TABLE FIELD
  128.     FETCH=    1            /FETCH HANDLER
  129.     IHNDBUF=7200            /INPUT HANDLER BUFFER
  130.     INBUFFE=6200            /INPUT BUFFER
  131.     INFILE=    7605            /INPUT FILE INFORMATION HERE
  132.     LOOKUP=    2            /LOOKUP INPUT FILE
  133.     NL0001=    CLA IAC            /LOAD AC WITH 0001
  134.     NL0002=    CLA CLL CML RTL        /LOAD AC WITH 0002
  135.     NL7776=    CLA CLL CMA RAL        /LOAD AC WITH 7776
  136.     NL7777=    CLA CMA            /LOAD AC WITH 7777
  137.     OHNDBUF=6600            /OUTPUT HANDLER BUFFER
  138.     OUTBUFF=5600            /OUTPUT BUFFER
  139.     OUTFILE=7600            /OUTPUT FILE INFORMATION HERE
  140.     PRGFLD=    00            /PROGRAM FIELD
  141.     RESET=    13            /RESET SYSTEM TABLES
  142.     REVISIO=1            /PROGRAM REVISION
  143.     SBOOT=    7600            /MONITOR EXIT
  144.     SWAL=    7643            /A-/L SWITCHES HERE IN TABLE FIELD
  145.     SWY9=    7645            /Y-/9 SWITCHES HERE IN TABLE FIELD
  146.     TBLFLD=    10            /COMMAND DECODER TABLE FIELD
  147.     TERMWRD=7642            /TERMINATOR WORD
  148.     USERROR=7            /USER SIGNALLED ERROR
  149.     USR=    0200            /USR ENTRY POINT
  150.     USRENT=    7700            /USR ENTRY POINT WHEN NON-RESIDENT
  151.     USRFLD=    10            /USR FIELD
  152.     USRIN=    10            /LOCK USR IN CORE
  153.     VERSION=2            /PROGRAM VERSION
  154.     WIDTH=    107-2            /69 DATA CHARACTERS PER LINE (TOTAL 71)
  155.     WRITE=    4000            /I/O WRITE BIT
  156.     *0                /START AT THE BEGINNING
  157.  
  158.     *10                /DEFINE AUTO-INDEX AREA
  159.  
  160. XR1,    .-.                /AUTO-INDEX NUMBER 1
  161. XR2,    .-.                /AUTO-INDEX NUMBER 2
  162.  
  163.     *20                /GET PAST AUTO-INDEX AREA
  164.  
  165. BUFPTR,    .-.                /OUTPUT BUFFER POINTER
  166. CCNT,    .-.                /CHECKSUM COUNTER
  167. CHKFLG,    .-.                /CHECKSUMMING ALLOWED FLAG
  168. CHKSUM,    ZBLOCK    5            /CHECKSUM
  169. CMPCNT,    .-.                /MATCH COUNT FOR COMPRESSION
  170. DANGCNT,.-.                /DANGER COUNT
  171. FDATE,    .-.                /FILE DATE
  172. FILLVAL,.-.                /FILL VALUE FOR SPECIAL OUTPUT CHARACTERS
  173. IDNUMBE,.-.                /INPUT DEVICE NUMBER
  174. IFNAME,    ZBLOCK    4            /INPUT FILENAME
  175. IMSW,    .-.                /IMAGE-MODE SWITCH
  176. INLEN,    .-.                /INPUT FILE LENGTH
  177. INPTR,    .-.                /INPUT BUFFER POINTER
  178. INPUT,    .-.                /INPUT HANDLER POINTER
  179. INRECOR,.-.                /INPUT RECORD
  180. FNAME,    ZBLOCK    4            /OUTPUT FILENAME
  181. LATEST,    .-.                /LATEST OUTPUT CHARACTER
  182. OBOUND,    .-.                /OUTPUT BOUNDARY COUNTER
  183. OCTCNT,    .-.                /OCTAL OUTPUT ROUTINE COUNTER
  184. OCTEMP,    .-.                /OCTAL OUTPUT ROUTINE TEMPORARY
  185. ODNUMBE,.-.                /OUTPUT DEVICE NUMBER
  186. OUTPUT,    .-.                /OUTPUT HANDLER POINTER
  187. OUTRECO,.-.                /OUTPUT RECORD
  188. PRTEMP,    .-.                /DATE OUTPUT TEMPORARY
  189. PUTEMP,    .-.                /OUTPUT TEMPORARY
  190. PUTLATE,.-.                /LATEST 5-BIT CHARACTER
  191. PUTPREV,.-.                /PREVIOUS OUTPUT TEMPORARY
  192. QUO,    .-.                /DIVIDE QUOTIENT
  193. REM,    .-.                /DIVIDE REMAINDER
  194. SCRCASE,.-.                /CURRENT MESSAGE CASE
  195. SCRCHAR,.-.                /LATEST MESSAGE CHARACTER
  196. SCRPTR,    .-.                /MESSAGE POINTER
  197. TDATE,    .-.                /TODAY'S DATE
  198. TEMP,    .-.                /TEMPORARY
  199. TEMPTR,    .-.                /TEMPORARY OUTPUT POINTER
  200. WIDCNT,    .-.                /LINE WIDTH COUNTER
  201.     PAGE                /START AT THE USUAL PLACE
  202.  
  203. BEGIN,    NOP                /IN CASE WE'RE CHAINED TO
  204.     CLA                /CLEAN UP
  205. START,    CIF    USRFLD            /GOTO USR FIELD
  206.     JMS I    (USRENTRY)        /CALL USR ROUTINE
  207.     USRIN                /GET IT LOCKED IN
  208.     CIF    USRFLD            /GOTO USR FIELD
  209.     JMS I    [USR]            /CALL USR ROUTINE
  210.     DECODE                /WANT COMMAND DECODER
  211.     "*^100                /USING SPECIAL MODE
  212.     CDF    TBLFLD            /GOTO TABLE FIELD
  213.     TAD I    (TERMWRD)        /GET TERMINATOR WORD
  214.     SPA CLA                /SKIP IF <CR> TERMINATED THE LINE
  215.     DCA    EXITZAP            /ELSE CAUSE EXIT LATER
  216.     DCA    IMSW            /CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH
  217.     TAD I    (OUTFILE)        /GET OUTPUT FILE DEVICE WORD
  218.     SNA                /SKIP IF OUTPUT FILE PRESENT
  219.     JMP    TSTMORE            /JUMP IF NOT THERE
  220.     AND    [17]            /JUST DEVICE BITS
  221.     DCA    ODNUMBER        /SAVE OUTPUT DEVICE NUMBER
  222.     TAD I    (INFILE)        /GET FIRST INPUT FILE DEVICE WORD
  223.     SNA                /SKIP IF PRESENT
  224.     JMP    INERR            /JUMP IF NOT
  225.     AND    [17]            /JUST DEVICE BITS
  226.     DCA    IDNUMBER        /SAVE INPUT DEVICE NUMBER
  227.     TAD I    (INFILE+5)        /GET SECOND INPUT FILE DEVICE WORD
  228.     SZA CLA                /SKIP IF ONLY ONE INPUT FILE
  229.     JMP    INERR            /ELSE COMPLAIN
  230.     JMS I    (MIFNAME)        /MOVE INPUT FILENAME WITH ADJUSTED EXTENSION
  231.     TAD I    [OUTFILE+1]        /GET FIRST OUTPUT FILENAME WORD
  232.     SNA CLA                /SKIP IF NAME PRESENT
  233.     JMP    NONAMERROR        /JUMP IF DEVICE ONLY
  234.     JMS I    (MOFNAME)        /MOVE OUTPUT FILENAME
  235.     CDF    PRGFLD            /BACK TO OUR FIELD
  236.     CIF    USRFLD            /GOTO USR FIELD
  237.     JMS I    [USR]            /CALL USR ROUTINE
  238.     RESET                /RESET SYSTEM TABLES
  239.     TAD    (OHNDBUFFER+1)        /GET BUFFER POINTER+TWO-PAGE BIT
  240.     DCA    OHPTR            /STORE IN-LINE
  241.     TAD    ODNUMBER        /GET OUTPUT DEVICE NUMBER
  242.     CIF    USRFLD            /GOTO USR FIELD
  243.     JMS I    [USR]            /CALL USR ROUTINE
  244.     FETCH                /FETCH HANDLER
  245. OHPTR,    .-.                /WILL BE BUFFER POINTER+TWO-PAGE BIT
  246.     JMP    FERROR            /FETCH ERROR
  247.     TAD    OHPTR            /GET RETURNED ADDRESS
  248.     DCA    OUTPUT            /STORE AS OUTPUT HANDLER ADDRESS
  249.     TAD    (IHNDBUFFER+1)        /GET INPUT BUFFER POINTER+TWO-PAGE BIT
  250.     DCA    IHPTR            /STORE IN-LINE
  251.     TAD    IDNUMBER        /GET INPUT DEVICE NUMBER
  252.     CIF    USRFLD            /GOTO USR FIELD
  253.     JMS I    [USR]            /CALL USR ROUTINE
  254.     FETCH                /FETCH HANDLER
  255. IHPTR,    .-.                /WILL BE BUFFER POINTER+TWO-PAGE BIT
  256.     JMP    FERROR            /FETCH ERROR
  257.     TAD    IHPTR            /GET RETURNED ADDRESS
  258.     DCA    INPUT            /STORE AS INPUT HANDLER ADDRESS
  259.     TAD    IMSW            /GET IMAGE-MODE SWITCH
  260.     SNA CLA                /SKIP IF IMAGE MODE SET
  261.     JMS I    (GEIFILE)        /GO LOOKUP INPUT FILE
  262.     TAD    (FNAME)            /POINT TO
  263.     DCA    ENTAR1            /STORED FILENAME
  264.     DCA    ENTAR2            /CLEAR SECOND ARGUMENT
  265.     JMS I    (INDATE)        /GET INPUT FILE'S DATE
  266.     TAD    ODNUMBER        /GET OUTPUT DEVICE NUMBER
  267.     CIF    USRFLD            /GOTO USR FIELD
  268.     JMS I    [USR]            /CALL USR ROUTINE
  269.     ENTER                /ENTER TENTATIVE FILENAME
  270. ENTAR1,    .-.                /WILL POINT TO FILENAME
  271. ENTAR2,    .-.                /WILL BE ZERO
  272.     JMP    ENTERR            /ENTER ERROR
  273.     TAD    ENTAR1            /GET RETURNED FIRST RECORD
  274.     DCA    OUTRECORD        /STORE IT
  275.     TAD    ENTAR2            /GET RETURNED EMPTY LENGTH
  276.     IAC                /ADD 2-1 FOR OS/278 CRAZINESS
  277.     DCA    DANGCNT            /STORE AS DANGER COUNT
  278.     JMS I    (CLRCHKSUM)        /CLEAR THE CHECKSUM
  279.     JMS I    (ENCODIT)        /GO DO THE ACTUAL ENCODING
  280.     JMP    PROCERR            /ERROR WHILE ENCODING
  281.     TAD    ODNUMBER        /GET OUTPUT DEVICE NUMBER
  282.     CIF    USRFLD            /GOTO USR FIELD
  283.     JMS I    [USR]            /CALL USR ROUTINE
  284.     CLOSE                /CLOSE OUTPUT FILE
  285.     FNAME                /POINTER TO FILENAME
  286. OUTCNT,    .-.                /WILL BE ACTUAL COUNT
  287.     JMP    CLSERR            /CLOSE ERROR
  288. EXITZAP,JMP    START            /**** <ESC> TERMINATION **** 0000
  289.     JMP I    (SBOOT)            /EXIT TO MONITOR
  290. /    ERROR WHILE PROCESSING INPUT FILE.
  291.  
  292. PROCERR,NL0002                /SET INCREMENT
  293.     SKP                /DON'T USE NEXT
  294.  
  295. /    ERROR WHILE CLOSING THE OUTPUT FILE.
  296.  
  297. CLSERR,    NL0001                /SET INCREMENT
  298.     SKP                /DON'T CLEAR IT
  299.  
  300. /    OUTPUT FILE TOO LARGE ERROR.
  301.  
  302. SIZERR,    CLA                /CLEAN UP
  303.     TAD    [3]            /SET INCREMENT
  304.     SKP                /DON'T USE NEXT
  305.  
  306. /    ENTER ERROR.
  307.  
  308. ENTERR,    NL0002                /SET INCREMENT
  309.     SKP                /DON'T USE NEXT
  310.  
  311. /    HANDLER FETCH ERROR.
  312.  
  313. FERROR,    NL0001                /SET INCREMENT
  314.  
  315. /    NO OUTPUT FILENAME ERROR.
  316.  
  317. NONAMER,IAC                /SET INCREMENT
  318.  
  319. /    ILLEGAL OUTPUT FILE NAME ERROR.
  320.  
  321. BADNAME,IAC                /SET INCREMENT
  322.  
  323. /    INPUT FILESPEC ERROR.
  324.  
  325. INERR,    IAC                /SET INCREMENT
  326.  
  327. /    OUTPUT FILESPEC ERROR.
  328.  
  329. OUTERR,    DCA    ERRNUMBER        /STORE ERROR NUMBER
  330.     CDF    PRGFLD            /ENSURE OUR FIELD
  331.     CIF    USRFLD            /GOTO USR FIELD
  332.     JMS I    [USR]            /CALL USR ROUTINE
  333.     USERROR                /USER ERROR
  334. ERRNUMB,.-.                /WILL BE PASSED ERROR NUMBER
  335.  
  336. /    COMES HERE TO TEST FOR NULL LINE.
  337.  
  338. TSTMORE,TAD I    (INFILE)        /GET FIRST INPUT FILE DEVICE WORD
  339.     SZA CLA                /SKIP NO INPUT OR OUTPUT GIVEN
  340.     JMP    OUTERR            /ELSE COMPLAIN
  341.     CDF    PRGFLD            /BACK TO OUR FIELD
  342.     JMP    EXITZAP            /MIGHT BE LAST TIME, SO GO THERE FIRST
  343.     PAGE
  344. ENCODIT,.-.                /ENCODING ROUTINE
  345.     TAD    INRECORD        /GET INPUT FILE STARTING RECORD
  346.     DCA    INREC            /STORE IN-LINE
  347.     NL7777                /SETUP INITIALIZE VALUE
  348.     JMS I    [DOBYTE]        /INITIALIZE OUTPUT ROUTINE
  349.     JMS I    (TDMESSAGE)        /OUTPUT TODAY'S DATE MESSAGE
  350.     JMS I    (FDMESSAGE)        /OUTPUT FILE DATE MESSAGE
  351.     JMS I    [SCRIBE]        /OUTPUT THE
  352.     FILMSG                /(FILE MESSAGE
  353.     JMS I    (PIFNAME)        /OUTPUT THE INPUT FILENAME
  354.     JMS I    [SCRIBE]        /OUTPUT THE
  355.     EMSG                /LINE ENDING
  356.     TAD    [-WIDTH]        /SETUP THE
  357.     DCA    WIDCNT            /LINE WIDTH COUNTER
  358.     JMS I    (OUTSETUP)        /SETUP PACKING ROUTINE AND CLEAR FILL
  359.     TAD    [-5]            /INITIALIZE
  360.     DCA    OBOUND            /BOUNDARY COUNTER
  361. ENCLOOP,JMS I    INPUT            /CALL INPUT HANDLER
  362.     2^100                /READ TWO PAGES
  363. PINBUFF,INBUFFER            /INTO INPUT BUFFER
  364. INREC,    .-.                /WILL BE LATEST INPUT FILE RECORD
  365. ENCERRO,JMP I    ENCODIT            /INPUT ERROR, TAKE IMMEDIATE RETURN
  366.     ISZ    INREC            /BUMP TO NEXT RECORD
  367.     NOP                /JUST IN CASE
  368.     TAD    PINBUFFER/(INBUFFER)    /SETUP THE
  369.     DCA    INPTR            /BUFFER POINTER
  370. LOOP,    JMS I    (CHKBND)        /CHECK IF ON A GOOD BOUNDARY
  371.     JMP    NOCOMPRESSION        /COMPRESS IS NOT ALLOWED AT THIS TIME
  372.     TAD    INPTR            /GET CURRENT POINTER
  373.     DCA    XR1            /STASH FOR SEARCH
  374.     DCA    CMPCNT            /CLEAR MATCH COUNT
  375. CMPLUP,    TAD    XR1            /GET INDEX VALUE
  376.     TAD    (-2^200-INBUFFER+1)    /COMPARE TO LIMIT
  377.     SNA CLA                /SKIP IF NOT AT END OF BUFFER
  378.     JMP    CMPEND            /JUMP IF AT END OF BUFFER
  379.     TAD I    XR1            /GET A CANDIDATE WORD
  380.     CIA                /INVERT FOR TEST
  381.     TAD I    INPTR            /COMPARE TO CURRENT TEST VALUE
  382.     SZA CLA                /SKIP IF IT MATCHES
  383.      JMP    CMPEND            /JUMP IF THIS IS NOT A REPEAT
  384.     ISZ    CMPCNT            /BUMP MATCH COUNT
  385.     JMP    CMPLUP            /TRY TO FIND MORE
  386. /    COMES HERE POSSIBLY WITH SOME COMPRESSED VALUES COUNTED.
  387.  
  388. CMPEND,    NL7776                /-2
  389.     TAD    CMPCNT            /DID WE FIND ENOUGH MATCHES?
  390.     SPA CLA                /SKIP IF SO
  391.     JMP    NOCOMPRESSION        /FORGET IT
  392.     TAD    ("X-"0)            /SETUP COMPRESSION INDICATOR
  393.     JMS I    (OUTSETUP)        /SETUP SPECIAL MODE
  394.     JMS I    (PUT5)            /OUTPUT "X"
  395.     JMS I    (OUTSETUP)        /SETUP NORMAL NUMERICAL MODE
  396.     TAD I    INPTR            /GET THE VALUE
  397.     JMS I    [PUTIT]            /OUTPUT IT
  398.     ISZ    CMPCNT            /ACCOUNT FOR ORIGINAL
  399.     TAD    CMPCNT            /GET COMPRESSION COUNT
  400.     CLL RTL;RTL            /*16
  401.     JMS I    [PUTIT]            /OUTPUT BITS[0-7] ONLY
  402.     JMS I    (OUTSETUP)        /SETUP NORMAL NUMERICAL MODE AGAIN
  403.     TAD    INPTR            /GET INPUT POINTER
  404.     TAD    CMPCNT            /UPDATE PAST ALL COMPRESSED VALUES
  405.     DCA    INPTR            /STORE BACK
  406.     JMP    TEST            /CONTINUE THERE
  407.  
  408. /    COMES HERE IF NO COMPRESSION FOUND (OR NOT ALLOWED).
  409.  
  410. NOCOMPR,TAD I    INPTR            /GET LATEST VALUE
  411.     JMS I    [PUTIT]            /OUTPUT IT
  412.     ISZ    INPTR            /BUMP TO NEXT
  413.     ISZ    OBOUND            /BUMP TO NEXT WORD
  414.     JMP    TEST            /KEEP GOING
  415.     TAD    [-5]            /RESET THE
  416.     DCA    OBOUND            /BOUNDARY COUNTER
  417. TEST,    TAD    INPTR            /GET INPUT POINTER
  418.     TAD    (-2^200-INBUFFER)    /COMPARE TO UPPER LIMIT
  419.     SZA CLA                /SKIP IF AT END OF BUFFER
  420.     JMP    LOOP            /ELSE JUST KEEP GOING
  421.     ISZ    INLEN            /DONE ALL INPUT RECORDS?
  422.     JMP    ENCLOOP            /NO, KEEP GOING
  423.  
  424. /    WE MUST FINISH THE LAST [5 WORDS => 12 BYTES] SEQUENCE.
  425.  
  426. ENDLUP,    JMS I    (CHKBND)        /AT A GOOD BOUNDARY?
  427.     SKP                /SKIP IF NOT
  428.     JMP    ENDONE            /JUMP IF SO
  429.     JMS I    [PUTIT]            /OUTPUT SOME WASTE BYTES
  430.     ISZ    OBOUND            /AT A GOOD BOUNDARY NOW?
  431.     JMP    ENDLUP            /NO, TRY AGAIN
  432. ENDONE,    TAD    ("Z-"0)        /GET END INDICATOR
  433.     JMS I    (OUTSETUP)        /SETUP SPECIAL MODE
  434.     JMS I    (PUT5)            /OUTPUT A "Z"
  435.     JMS I    (INVCHKSUM)        /INVERT THE CHECKSUM
  436.     JMS I    (OUTSETUP)        /SETUP NORMAL NUMERICAL MODE
  437.     JMS I    (CHKOUT)        /OUTPUT THE CHECKSUM
  438.     JMS I    [SCRIBE]        /OUTPUT THE
  439.     ENDMSG                /END MESSAGE
  440.     JMS I    (PIFNAME)        /OUTPUT THE INPUT FILENAME
  441.     JMS I    [SCRIBE]        /OUTPUT THE
  442.     EMSG                /LINE ENDING
  443.     JMS I    [SCRIBE]        /OUTPUT THE
  444.     EOFMSG                /FINAL MESSAGE
  445.     TAD    ("Z&37)            /GET <^Z>
  446. CLOSLUP,JMS I    [DOBYTE]        /OUTPUT A BYTE (^Z OR NULL)
  447.     TAD    BUFPTR            /GET THE OUTPUT BUFFER POINTER
  448.     TAD    (-OUTBUFFER)        /COMPARE TO RESET VALUE
  449.     SZA CLA                /SKIP IF IT MATCHES
  450.     JMP    CLOSLUP            /ELSE KEEP GOING
  451.     ISZ    ENCODIT            /NO ERRORS
  452.     JMP I    ENCODIT            /RETURN
  453.  
  454.     PAGE
  455. PUTIT,    .-.                /WORD OUTPUT ROUTINE
  456.     DCA    PUTEMP            /SAVE PASSED VALUE
  457.     JMS I    (CALCHKSUM)        /UPDATE CHECKSUM
  458.     JMP I    PUTNXT            /GO WHERE YOU SHOULD GO
  459.  
  460. PUTNXT,    PUT0                /OUTPUT EXIT ROUTINE
  461.     TAD    PUTEMP            /GET LATEST VALUE
  462.     DCA    PUTPREV            /SAVE FOR NEXT TIME
  463.     JMP I    PUTIT            /RETURN TO MAIL CALLER
  464.  
  465. PUTLUP,    JMS    PUTNXT            /GET ANOTHER WORD
  466. PUT0,    TAD    PUTEMP            /GET WORD[0]
  467.     RTL;RTL;RTL            /BITS[0-4] => AC[7-11]
  468.     JMS    PUT5            /OUTPUT A CHARACTER
  469.     TAD    PUTEMP            /GET WORD[0] AGAIN
  470.     RTR                /BITS[5-9] => AC[7-11]
  471.     JMS    PUT5            /OUTPUT A CHARACTER
  472.     JMS    PUTNXT            /GET ANOTHER WORD
  473. PUT1,    TAD    PUTPREV            /GET WORD[0]
  474.     AND    [3]            /ISOLATE BITS[10-11]
  475.     CLL RTL;RAL            /BITS[10-11] => AC[7-8]
  476.     DCA    PUTPREV            /SAVE FOR NOW
  477.     TAD    PUTEMP            /GET WORD[1]
  478.     RTL;RTL                /BITS[0-2] => AC[9-11]
  479.     AND    [7]            /ISOLATE DESIRED BITS
  480.     TAD    PUTPREV            /ADD ON WORD[0] BITS IN AC[7-8]
  481.     JMS    PUT5            /OUTPUT A CHARACTER
  482.     TAD    PUTEMP            /GET WORD[1]
  483.     RTR;RTR                /BITS[3-7] => AC[7-11]
  484.     JMS    PUT5            /OUTPUT A CHARACTER
  485.     JMS    PUTNXT            /GET ANOTHER WORD
  486. PUT2,    TAD    PUTEMP            /GET WORD[2]
  487.     RAL                /BIT[0] => L
  488.     CLA                /CLEAN UP
  489.     TAD    PUTPREV            /GET WORD[1]
  490.     RAL                /BITS[8-11],L => AC[7-11]
  491.     JMS    PUT5            /OUTPUT A CHARACTER
  492.     TAD    PUTEMP            /GET WORD[2]
  493.     RTR;RTR;RTR            /BITS[1-5] => AC[7-11]
  494.     JMS    PUT5            /OUTPUT A CHARACTER
  495.     TAD    PUTEMP            /GET WORD[2]
  496.     RAR                /BITS[6-10] => AC[7-11]
  497.     JMS    PUT5            /OUTPUT A CHARACTER
  498.     JMS    PUTNXT            /GET ANOTHER WORD
  499. PUT3,    TAD    PUTPREV            /GET WORD[2]
  500.     RAR                /BIT[11] => L
  501.     CLA                /CLEAN UP
  502.     TAD    PUTEMP            /GET WORD[3]
  503.     RTL;RTL;RAL            /L, BITS[0-3] => AC[7-11]
  504.     JMS    PUT5            /OUTPUT A CHARACTER
  505.     TAD    PUTEMP            /GET WORD[3]
  506.     RTR;RAR                /BITS[4-8] => AC[7-11]
  507.     JMS    PUT5            /OUTPUT A CHARACTER
  508.     JMS    PUTNXT            /GET ANOTHER WORD
  509. PUT4,    TAD    PUTPREV            /GET WORD[3]
  510.     AND    [7]            /ISOLATE BITS[9-11]
  511.     CLL RTL                /BITS[9-11] => AC[7-9]
  512.     DCA    PUTPREV            /SAVE FOR NOW
  513.     TAD    PUTEMP            /GET WORD[4]
  514.     RTL;RAL                /BITS[0-1] => AC[10-11]
  515.     AND    [3]            /ISOLATE BITS[10-11]
  516.     TAD    PUTPREV            /ADD ON WORD[3] BITS IN AC[7-9]
  517.     JMS    PUT5            /OUTPUT A CHARACTER
  518.     TAD    PUTEMP            /GET WORD[4]
  519.     RTR;RTR;RAR            /BITS[2-6] => AC[7-11]
  520.     JMS    PUT5            /OUTPUT A CHARACTER
  521.     TAD    PUTEMP            /GET WORD[4] BITS[7-11] IN AC[7-11]
  522.     JMS    PUT5            /OUTPUT A CHARACTER
  523.     JMP    PUTLUP            /GO DO ANOTHER GROUP OF FIVE WORDS
  524.  
  525. CHKNL,    .-.                /CHECK IF AT NEW LINE ROUTINE
  526.     TAD    WIDCNT            /GET LINE WIDTH COUNTER
  527.     TAD    (WIDTH)            /COMPARE TO MAXIMIM VALUE
  528.     SZA CLA                /SKIP IF AT MAXIMUM
  529.     ISZ    CHKNL            /TAKE SKIP RETURN IF NOT AT MAXIMUM
  530.     JMP I    CHKNL            /RETURN EITHER WAY
  531.  
  532. OUTSETU,.-.                /OUTPUT SETUP ROUTINE
  533.     DCA    FILLVALUE        /STORE PASSED FILL VALUE
  534.     TAD    (PUT0)            /SETUP THE
  535.     DCA    PUTNXT            /OUTPUT CO-ROUTINE
  536.     JMP I    OUTSETUP        /RETURN
  537. PUT5,    .-.                /FIVE-BIT OUTPUT ROUTINE
  538.     AND    [37]            /JUST 5 BITS
  539.     DCA    PUTLATEST        /SAVE IT
  540.     JMS    CHKNL            /CHECK IF AT BEGINNING OF LINE
  541.     SKP                /SKIP IF NOT
  542.     JMP    PUTNORMAL        /JUMP IF SO
  543.     TAD    ("<&177)        /GET BEGINNING BRACKET
  544.     JMS I    [DOBYTE]        /OUTPUT IT
  545. PUTNORM,TAD    PUTLATEST        /GET LATEST VALUE
  546.     TAD    ("0-"9-1)        /COMPARE TO FIRST LIMIT
  547.     SMA CLA                /SKIP IF LESS
  548.     TAD    ["A-"9-1]        /CONVERT LARGER VALUES TO A-V
  549.     TAD    PUTLATEST        /ADD ON LATEST VALUE
  550.     TAD    ["0&177]        /MAKE IT ASCII
  551.     TAD    FILLVALUE        /ADD ON FILL VALUE FOR SPECIAL MODE
  552.     JMS I    [DOBYTE]        /OUTPUT IT
  553.     ISZ    WIDCNT            /BUMP LINE COUNTER
  554.     TAD    WIDCNT            /GET LINE COUNTER
  555.     SZA CLA                /SKIP IF AT END OF LINE
  556.     JMP I    PUT5            /ELSE JUST RETURN
  557.     TAD    (">&177)        /GET DATA CLOSING CHARACTER
  558.     JMS I    [DOBYTE]        /OUTPUT IT
  559.     TAD    ["M&37]            /GET A <CR>
  560.     JMS I    [DOBYTE]        /OUTPUT IT
  561.     TAD    ["J&37]            /GET A <LF>
  562.     JMS I    [DOBYTE]        /OUTPUT IT
  563.     TAD    [-WIDTH]        /RESET THE
  564.     DCA    WIDCNT            /LINE WIDTH COUNTER
  565.     JMP I    PUT5            /RETURN
  566.  
  567.     PAGE
  568. /    MESSAGE PRINT ROUTINE.
  569.  
  570. SCRIBE,    .-.                /MESSAGE PRINT ROUTINE
  571.     TAD I    SCRIBE            /GET IN-LINE POINTER ARGUMENT
  572.     DCA    SCRPTR            /STASH THE POINTER
  573.     ISZ    SCRIBE            /BUMP PAST ARGUMENT
  574.     TAD    (140)            /INITIALIZE TO
  575.     DCA    SCRCASE            /LOWER-CASE
  576. SCRLUP,    TAD I    SCRPTR            /GET LEFT HALF-WORD
  577.     RTR;RTR;RTR            /MOVE OVER
  578.     JMS    SCRPRNT            /PRINT IT
  579.     TAD I    SCRPTR            /GET RIGHT HALF-WORD
  580.     JMS    SCRPRNT            /PRINT IT
  581.     ISZ    SCRPTR            /BUMP TO NEXT PAIR
  582.     JMP    SCRLUP            /KEEP GOING
  583.  
  584. SCRPRNT,.-.                /CHARACTER PRINT ROUTINE
  585.     AND    [77]            /JUST SIX BITS
  586.     SNA                /END OF MESSAGE?
  587.     JMP I    SCRIBE            /YES, RETURN TO ORIGINAL CALLER
  588.     DCA    SCRCHAR            /NO, SAVE FOR NOW
  589.     TAD    SCRCHAR            /GET IT BACK
  590.     TAD    (-"%!200)        /IS IT "%"?
  591.     SNA                /SKIP IF NOT
  592.     JMP    SCRCRLF            /JUMP IF IT MATCHES
  593.     TAD    (-"^+100+"%)        /IS IT "^"
  594.     SNA CLA                /SKIP IF NOT
  595.     JMP    SCRFLIP            /JUMP IF IT MATCHES
  596.     TAD    SCRCHAR            /GET THE CHARACTER
  597.     AND    [40]            /DOES CASE MATTER?
  598.     SNA CLA                /SKIP IF NOT
  599.     TAD    SCRCASE            /ELSE GET PREVAILING CASE
  600.     TAD    SCRCHAR            /GET THE CHARACTER
  601. SCRPRLF,JMS I    [DOBYTE]        /OUTPUT THE CHARACTER
  602.     JMP I    SCRPRNT            /RETURN
  603.  
  604. SCRCRLF,TAD    ["M&37]            /GET A <CR>
  605.     JMS I    [DOBYTE]        /OUTPUT IT
  606.     TAD    ["J&37]            /GET A <LF>
  607.     JMP    SCRPRLF            /CONTINUE THERE
  608.  
  609. SCRFLIP,TAD    SCRCASE            /GET CURRENT CASE
  610.     CIA                /INVERT IT
  611.     TAD    (140+100)        /ADD SUM OF POSSIBLE VALUES
  612.     DCA    SCRCASE            /STORE NEW INVERTED CASE
  613.     JMP I    SCRPRNT            /RETURN
  614. PUTBYTE,.-.                /OUTPUT A BYTE ROUTINE
  615.     SPA                /ARE WE INITIALIZING?
  616.     JMP    PUTINITIALIZE        /YES
  617.     AND    (177)            /JUST IN CASE
  618.     DCA    LATEST            /SAVE LATEST CHARACTER
  619.     TAD    LATEST            /GET LATEST CHARACTER
  620.     JMP I    PUTNEXT            /GO WHERE YOU SHOULD GO
  621.  
  622. PUTNEXT,.-.                /EXIT ROUTINE
  623.     ISZ    PUTBYTE            /BUMP TO GOOD RETURN
  624. PUTERRO,CLA CLL                /CLEAN UP
  625.     JMP I    PUTBYTE            /RETURN TO MAIN CALLER
  626.  
  627. PUTINIT,CLA                /CLEAN UP
  628.     TAD    OUTRECORD        /GET STARTING RECORD OF TENTATIVE FILE
  629.     DCA    PUTRECORD        /STORE IN-LINE
  630.     DCA I    (OUTCNT)        /CLEAR ACTUAL FILE LENGTH
  631. PUTNEWR,TAD    (OUTBUFFER)        /SETUP THE
  632.     DCA    BUFPTR            /BUFFER POINTER
  633. PUTLOOP,JMS    PUTNEXT            /GET A CHARACTER
  634.     DCA I    BUFPTR            /STORE IT
  635.     TAD    BUFPTR            /GET POINTER VALUE
  636.     DCA    TEMPTR            /SAVE FOR LATER
  637.     ISZ    BUFPTR            /BUMP TO NEXT
  638.     JMS    PUTNEXT            /GET A CHARACTER
  639.     DCA I    BUFPTR            /STORE IT
  640.     JMS    PUTNEXT            /GET A CHARACTER
  641.     RTL;RTL                /MOVE UP
  642.     AND    [7400]            /ISOLATE HIGH NYBBLE
  643.     TAD I    TEMPTR            /ADD ON FIRST BYTE
  644.     DCA I    TEMPTR            /STORE COMPOSITE
  645.     TAD    LATEST            /GET LATEST CHARACTER
  646.     RTR;RTR;RAR            /MOVE UP AND
  647.     AND    [7400]            /ISOLATE LOW NYBBLE
  648.     TAD I    BUFPTR            /ADD ON SECOND BYTE
  649.     DCA I    BUFPTR            /STORE COMPOSITE
  650.     ISZ    BUFPTR            /BUMP TO NEXT
  651.     TAD    BUFPTR            /GET LATEST POINTER VALUE
  652.     TAD    (-2^200-OUTBUFFERR)    /COMPARE TO LIMIT
  653.     SZA CLA                /SKIP IF AT END
  654.     JMP    PUTLOOP            /KEEP GOING
  655.     ISZ    DANGCNT            /TOO MANY RECORDS?
  656.     SKP                /SKIP IF NOT
  657.     JMP I    (SIZERR)        /JUMP IF SO
  658.     JMS I    OUTPUT            /CALL I/O HANDLER
  659.     2^100+WRITE            /WRITE SOME PAGES FROM OUTPUT BUFFER
  660.     OUTBUFFER            /BUFFER ADDRESS
  661. PUTRECO,.-.                /WILL BE LATEST RECORD NUMBER
  662.     JMP    PUTERROR        /OUTPUT ERROR!
  663.     ISZ I    (OUTCNT)        /BUMP ACTUAL LENGTH
  664.     ISZ    PUTRECORD        /BUMP TO NEXT RECORD
  665.     JMP    PUTNEWRECORD        /KEEP GOING
  666. DOBYTE,    .-.                /OUTPUT A BYTE ROUTINE
  667.     JMS    PUTBYTE            /OUTPUT PASSED VALUE
  668.     JMP I    (ENCERROR)        /COULDN'T DO IT
  669.     JMP I    DOBYTE            /RETURN
  670.  
  671.     PAGE
  672. /    INPUT FILE ROUTINE.
  673.  
  674. GEIFILE,.-.                /GET INPUT FILE ROUTINE
  675.     JMS    LUKUP            /TRY TO LOOKUP THE FILE
  676.     SKP                /SKIP IF IT WORKED
  677.     JMP    TRYNULL            /TRY NULL EXTENSION VERSION
  678. NULLOK,    TAD    LARG2            /GET NEGATED LENGTH
  679.     DCA    INLEN            /STASH IT
  680.     TAD    LARG1            /GET FIRST INPUT RECORD
  681.     DCA    INRECORD        /STASH IT
  682.     JMP I    GEIFILE            /RETURN
  683.  
  684. /    COMES HERE IF LOOKUP FAILED.
  685.  
  686. TRYNULL,CDF    TBLFLD            /GOTO TABLE FIELD
  687.     TAD I    [INFILE+4]        /GET ORIGINAL FILENAME'S EXTENSION
  688.     CDF    PRGFLD            /BACK TO OUR FIELD
  689.     SZA CLA                /SKIP IF IT WAS NULL ORIGINALLY
  690.     JMP I    (INERR)            /ELSE COMPLAIN OF EXPLICIT LOOKUP FAILURE
  691.     DCA    IFNAME+3        /NOW TRY NULL VERSION INSTEAD OF DEFAULT VERSION
  692.     JMS    LUKUP            /TRY TO LOOK IT UP AGAIN
  693.     JMP    NULLOK            /THAT WORKED!
  694.     JMP I    (INERR)            /COMPLAIN OF LOOKUP FAILURE
  695.  
  696. LUKUP,    .-.                /LOW-LEVEL LOOKUP ROUTINE
  697.     TAD    (IFNAME)        /GET OUR FILENAME POINTER
  698.     DCA    LARG1            /STORE IN-LINE
  699.     DCA    LARG2            /CLEAR SECOND ARGUMENT
  700.     TAD    IDNUMBER        /GET INPUT DEVICE NUMBER
  701.     CIF    USRFLD            /GOTO USR FIELD
  702.     JMS I    [USR]            /CALL USR ROUTINE
  703.     LOOKUP                /WANT LOOKUP FUNCTION
  704. LARG1,    .-.                /WILL BE POINTER TO OUR FILENAME
  705. LARG2,    .-.                /WILL RETURN FILE LENGTH (HOPEFULLY)
  706.     ISZ    LUKUP            /LOOKUP FAILED, SO BUMP RETURN ADDRESS
  707.     JMP I    LUKUP            /RETURN EITHER WAY
  708. /    INPUT FILENAME PRINT ROUTINE.
  709.  
  710. PIFNAME,.-.                /PRINT INPUT FILENAME ROUTINE
  711.     TAD    IMSW            /GET IMAGE-MODE SWITCH
  712.     SNA CLA                /SKIP IF SET
  713.     JMP    DOIFNAME        /JUMP IF NOT
  714.     JMS I    [SCRIBE]        /OUTPUT THE
  715.     IFMSG                /IMAGE MESSAGE
  716.     CDF    TBLFLD            /GOTO TABLE FIELD
  717.     TAD I    [EQUWRD]        /GET EQUALS PARAMETER
  718.     CDF    PRGFLD            /BACK TO OUR FIELD
  719.     JMS I    (OCTOUT)        /OUTPUT IT
  720.     CDF    TBLFLD            /GOTO TABLE FIELD
  721.     TAD I    [SWY9]            /GET /Y-/9 SWITCHES
  722.     CDF    PRGFLD            /BACK TO OUR FIELD
  723.     AND    [600]            /JUST /1, /2 BITS
  724.     SNA                /SKIP IF SOMETHING SET
  725.     JMP I    PIFNAME            /JUST RETURN IF NOT
  726.     AND    [400]            /JUST /1 BIT
  727.     SNA CLA                /SKIP IF /1 SET
  728.     JMP    PIFPT2            /JUMP IF /2 SET
  729.     JMS I    [SCRIBE]        /OUTPUT THE
  730.     PT1MSG                /PART ONE MESSAGE
  731.     JMP I    PIFNAME            /RETURN
  732.  
  733. PIFPT2,    JMS I    [SCRIBE]        /OUTPUT THE
  734.     PT2MSG                /PART TWO MESSAGE
  735.     JMP I    PIFNAME            /RETURN
  736.  
  737. DOIFNAM,TAD    IFNAME            /GET FIRST PAIR
  738.     JMS    PIF2            /PRINT IT
  739.     TAD    IFNAME+1        /GET SECOND PAIR
  740.     JMS    PIF2            /PRINT IT
  741.     TAD    IFNAME+2        /GET THIRD PAIR
  742.     JMS    PIF2            /PRINT IT
  743.     TAD    (".&177)        /GET SEPARATOR
  744.     JMS    PIFOUT            /PRINT IT
  745.     TAD    IFNAME+3        /GET FOURTH PAIR
  746.     JMS    PIF2            /PRINT IT
  747.     JMP I    PIFNAME            /RETURN
  748.  
  749. PIF2,    .-.                /PRINT A PAIR ROUTINE
  750.     DCA    SCRCHAR            /SAVE PASSED PAIR
  751.     TAD    SCRCHAR            /GET IT BACK
  752.     RTR;RTR;RTR            /MOVE DOWN
  753.     JMS    PIFOUT            /PRINT HIGH-ORDER FIRST
  754.     TAD    SCRCHAR            /GET IT AGAIN
  755.     JMS    PIFOUT            /PRINT LOW-ORDER
  756.     JMP I    PIF2            /RETURN
  757. PIFOUT,    .-.                /FILENAME CHARACTER OUTPUT ROUTINE
  758.     AND    [77]            /JUST SIXBIT
  759.     SNA                /SKIP IF SOMETHING THERE
  760.     JMP I    PIFOUT            /ELSE IGNORE IT
  761.     TAD    [40]            /INVERT IT
  762.     AND    [77]            /REMOVE EXCESS
  763.     TAD    [40]            /INVERT IT AGAIN
  764.     JMS I    [DOBYTE]        /OUTPUT IT
  765.     JMP I    PIFOUT            /RETURN
  766.  
  767. MOFNAME,.-.                /MOVE OUTPUT FILENAME ROUTINE
  768.     TAD I    [OUTFILE+1]        /GET FIRST OUTPUT FILENAME WORD
  769.     JMS    CHKNAME            /CHECK IF LEGAL
  770.     DCA    FNAME            /STASH IT
  771.     TAD I    (OUTFILE+2)        /GET SECOND OUTPUT FILENAME WORD
  772.     JMS    CHKNAME            /CHECK IF LEGAL
  773.     DCA    FNAME+1            /STASH IT
  774.     TAD I    (OUTFILE+3)        /GET THIRD OUTPUT FILENAME WORD
  775.     JMS    CHKNAME            /CHECK IF LEGAL
  776.     DCA    FNAME+2            /STASH IT
  777.     TAD I    (OUTFILE+4)        /GET FOURTH OUTPUT FILENAME WORD
  778.     JMS    CHKNAME            /CHECK IF LEGAL
  779.     DCA    FNAME+3            /STASH IT
  780.     JMP I    MOFNAME            /RETURN
  781.  
  782. /    OUTPUT NAME CHECK ROUTINE.
  783.  
  784. CHKNAME,.-.                /OUTPUT NAME CHECK ROUTINE
  785.     DCA    LUKUP            /SAVE PASSED VALUE
  786.     TAD    LUKUP            /GET IT BACK
  787.     RTR;RTR;RTR            /MOVE DOWN
  788.     JMS    CHKIT            /CHECK HIGH-ORDER AND GET IT BACK
  789.     JMS    CHKIT            /CHECK LOW-ORDER AND GET IT BACK
  790.     JMP I    CHKNAME            /RETURN
  791.  
  792. CHKIT,    .-.                /ONE CHARACTER CHECK ROUTINE
  793.     AND    [77]            /JUST SIX BITS
  794.     TAD    (-"?!200)        /COMPARE TO "?"
  795.     SZA                /SKIP IF ALREADY BAD
  796.     TAD    (-"*+"?)        /ELSE COMPARE TO "*"
  797.     SNA CLA                /SKIP IF NEITHER BAD CASE
  798.     JMP I    (BADNAME)        /COMPLAIN OF WILD CHARACTER
  799.     TAD    LUKUP            /GET THE PAIR BACK FOR NEXT TIME
  800.     JMP I    CHKIT            /RETURN
  801.     PAGE
  802. CALCHKS,.-.                /CALCULATE CHECKSUM ROUTINE
  803.     TAD    CHKFLG            /SHOULD WE CHECKSUM?
  804.     SZA CLA                /SKIP IF SO
  805.     JMP I    CALCHKSUM        /JUMP IF NOT
  806.     JMS    CHKSETUP        /SETUP
  807.     TAD    PUTEMP            /GET PASSED VALUE
  808.     CLL RAR                /CLEAR LINK AND MOVE OVER
  809. ADDLUP,    RAL                /MOVE OVER CARRY
  810.     TAD I    XR1            /ADD A WORD
  811.     DCA I    XR2            /STORE BACK
  812.     ISZ    CCNT            /DONE ENOUGH?
  813.     JMP    ADDLUP            /NO, KEEP GOING
  814.     JMP I    CALCHKSUM        /YES, RETURN
  815.  
  816. CHKOUT,    .-.                /OUTPUT THE CHECKSUM ROUTINE
  817.     JMS    CHKSETUP        /SETUP
  818.     ISZ    CHKFLG            /DISABLE CHECKSUMMING
  819.     TAD I    XR1            /GET A WORD
  820.     JMS I    [PUTIT]            /OUTPUT IT
  821.     ISZ    CCNT            /DONE YET?
  822.     JMP    .-3            /NO, KEEP GOING
  823.     JMP I    CHKOUT            /YES, WE'RE DONE
  824.  
  825. CLRCHKS,.-.                /CLEAR CHECKSUM ROUTINE
  826.     JMS    CHKSETUP        /SETUP
  827.     DCA I    XR1            /CLEAR A WORD
  828.     ISZ    CCNT            /DONE YET?
  829.     JMP    .-2            /NO, DO ANOTHER
  830.     DCA    CHKFLG            /ENABLE CHECKSUMMING
  831.     JMP I    CLRCHKSUM        /RETURN
  832.  
  833. INVCHKS,.-.                /CHECKSUM INVERSION ROUTINE
  834.     JMS    CHKSETUP        /SETUP
  835.     STL                /FORCE INITIAL CARRY
  836. COMLUP,    TAD I    XR1            /GET A WORD
  837.     CMA                /INVERT IT
  838.     SZL                /SKIP IF NO CARRY
  839.     CLL IAC                /ELSE ADD ONE AND CLEAR CARRY FOR NEXT TIME
  840.     DCA I    XR2            /STORE BACK
  841.     ISZ    CCNT            /DONE ALL YET?
  842.     JMP    COMLUP            /NO, KEEP GOING
  843.     JMP I    INVCHKSUM        /YES, RETURN
  844.  
  845. CHKSETU,.-.                /CHECKSUM SETUP ROUTINE
  846.     TAD    (CHKSUM-1)        /POINT TO
  847.     DCA    XR1            /CHECKSUM AREA
  848.     TAD    (CHKSUM-1)        /POINT TO
  849.     DCA    XR2            /CHECKSUM AREA
  850.     TAD    [-5]            /SETUP THE
  851.     DCA    CCNT            /CHECKSUM COUNT
  852.     JMP I    CHKSETUP        /RETURN
  853. /    FILE DATE ROUTINE.
  854.  
  855. FDMESSA,.-.                /PUT FILE DATE IN MESSAGE ROUTINE
  856.     TAD    FDATE            /GET INPUT FILE'S DATE
  857.     SNA CLA                /SKIP IF ANY
  858.     JMP I    FDMESSAGE        /RETURN IF NONE
  859.     JMS I    [SCRIBE]        /PRINT OUT THE
  860.     DATMSG                /DATE BLURB
  861.     TAD    FDATE            /GET IT BACK
  862.     JMS    PRDATE            /PRINT THE DATE
  863.     JMS I    [SCRIBE]        /PRINT THE
  864.     EMSG                /END MESSAGE
  865.     JMP I    FDMESSAGE        /RETURN
  866.  
  867. TDMESSA,.-.                /PUT TODAY'S DATE IN MESSAGE ROUTINE
  868.     JMS I    [SCRIBE]        /OUTPUT THE
  869.     REMMSG                /OPENING REMARKS
  870.     CDF    TBLFLD            /GOTO TABLE FIELD
  871.     TAD I    (DATWRD)        /GET DATE WORD
  872.     CDF    PRGFLD            /BACK TO OUR FIELD
  873.     SNA                /SKIP IF THERE
  874.     JMP    NOTDATE            /JUMP IF NOT
  875.     DCA    TDATE            /SAVE TODAY'S DATE
  876.     JMS I    [SCRIBE]        /OUTPUT THE
  877.     ONMSG                /BRIDGING MESSAGE
  878.     TAD    TDATE            /GET TODAY'S DATE
  879.     JMS    PRDATE            /PRINT TODAY'S DATE
  880. NOTDATE,JMS I    [SCRIBE]        /OUTPUT THE
  881.     EMSG                /END MESSAGE
  882.     JMP I    TDMESSAGE        /RETURN
  883. PRDATE,    .-.                /DATE PRINT ROUTINE
  884.     DCA    PRTEMP            /SAVE PASSED VALUE
  885.     TAD    PRTEMP            /GET IT BACK
  886.     RTR;RAR                /MOVE DOWN
  887.     AND    [37]            /JUST DAY BITS
  888.     JMS I    (DEC2)            /PRINT AS TWO DIGITS
  889.     TAD    PRTEMP            /GET DATE AGAIN
  890.     AND    [7400]            /JUST MONTH BITS
  891.     CLL RTL;RTL;RTL            /MOVE DOWN
  892.     TAD    (MONLST-2-1)        /POINT TO PROPER ELEMENT
  893.     DCA    XR1            /STASH THE POINTER
  894.     TAD I    XR1            /GET FIRST PAIR
  895.     DCA I    (MMSG+1)        /STORE IN MESSAGE
  896.     TAD I    XR1            /GET SECOND PAIR
  897.     DCA I    (MMSG+2)        /STORE IN MESSAGE
  898.     JMS I    [SCRIBE]        /OUTPUT THE
  899.     MMSG                /MONTH MESSAGE
  900.     TAD    PRTEMP            /GET DATE AGAIN
  901.     AND    [7]            /JUST YEAR BITS
  902.     DCA    TEMP            /SAVE IT
  903.     CDF    TBLFLD            /GOTO TABLE FIELD
  904.     TAD I    (DATWRD)        /GET CURRENT DATE WORD
  905.     CDF    PRGFLD            /BACK TO OUR FIELD
  906.     AND    [7]            /JUST YEAR BITS
  907.     CIA                /INVERT FOR TEST
  908.     TAD    TEMP            /COMPARE TO DESIRED YEAR
  909.     SMA SZA CLA            /SKIP IF THEY MATCH OR ARE EARLIER
  910.     TAD    (-10)            /ELSE BACKUP A GROUP
  911.     TAD    TEMP            /ADD TO YEAR
  912.     DCA    TEMP            /STORE BACK
  913.     TAD I    (DATEXT)        /GET EXTENSION WORD
  914.     AND    [600]            /JUST EXTENSION BITS
  915.     CLL RTR;RTR            /MAKE IT GROUP COUNT
  916.     TAD    TEMP            /ADD ON RELATIVE YEAR
  917.     TAD    (106)            /MAKE IT ABSOLUTE YEAR (70-99)
  918.     JMS I    (DEC2)            /PRINT AS TWO DIGITS
  919.     JMP I    PRDATE            /RETURN
  920.  
  921.     PAGE
  922. DEC2,    .-.                /PRINT TWO DIGITS ROUTINE
  923.     JMS    DIVIDE            /DIVIDE
  924.     12                /BY 10
  925.     TAD    ["0&177]        /MAKE IT ASCII
  926.     JMS I    [DOBYTE]        /OUTPUT IT
  927.     TAD    REM            /GET SECOND DIGIT
  928.     TAD    ["0&177]        /MAKE IT ASCII
  929.     JMS I    [DOBYTE]        /OUTPUT IT
  930.     JMP I    DEC2            /RETURN
  931.  
  932. /    DIVIDE ROUTINE.
  933.  
  934. DIVIDE,    .-.                /DIVIDE ROUTINE
  935.     DCA    REM            /SAVE IN REMAINDER
  936.     DCA    QUO            /CLEAR QUOTIENT
  937.     TAD    REM            /GET IT BACK
  938.     STL CIA                /INVERT
  939.     SKP                /DON'T FIRST TIME
  940. DVLOOP,    ISZ    QUO            /BUMP UP QUOTIENT
  941.     TAD I    DIVIDE            /ADD ON ARGUMENT
  942.     SNA SZL                /UNDERFLOW?
  943.     JMP    DVLOOP            /NO, KEEP GOING
  944.     CIA                /YES, INVERT IT BACK
  945.     TAD I    DIVIDE            /RESTORE LOST VALUE
  946.     DCA    REM            /SAVE AS REMAINDER
  947.     TAD    QUO            /GET THE QUOTIENT
  948.     ISZ    DIVIDE            /BUMP PAST ARGUMENT
  949.     JMP I    DIVIDE            /RETURN
  950.  
  951. INDATE,    .-.                /GET INPUT FILE'S DATE WORD
  952.     CDF    TBLFLD            /GOTO TABLE FIELD
  953.     TAD    IMSW            /GET IMAGE-MODE SWITCH
  954.     SNA CLA                /SKIP IF SET
  955.     JMP    NOIMG            /JUMP IF NOT
  956.     TAD I    (DATWRD)        /USE TODAY'S DATE
  957.     JMP    NOAIW            /CONTINUE THERE
  958.  
  959. NOIMG,    TAD I    (AIWCNT)        /GET AIW COUNT
  960.     SNA                /SKIP IF ANY
  961.     JMP    NOAIW            /JUMP IF NOT
  962.     TAD I    [AIWXR]            /GET ENTRY POINTER
  963.     DCA    TEMP            /STASH FIRST AIW POINTER
  964.     TAD I    TEMP            /GET FIRST AIW
  965. NOAIW,    DCA    FDATE            /SAVE AS FILE'S DATE
  966.     CDF    PRGFLD            /BACK TO OUR FIELD
  967.     JMP I    INDATE            /RETURN
  968. /    INPUT FILENAME MOVE ROUTINE; USES DEFAULT EXTENSION IF NONE PROVIDED BY USER.
  969.  
  970. MIFNAME,.-.                /MOVE INPUT FILENAME ROUTINE
  971.     TAD I    (INFILE+1)        /GET FIRST INPUT FILENAME WORD
  972.     SNA                /SKIP IF SOMETHING THERE
  973.     JMP    IMTEST            /JUMP IF NOT
  974. IFNAMOK,DCA    IFNAME            /STASH IT
  975.     TAD I    (INFILE+2)        /GET SECOND INPUT FILENAME WORD
  976.     DCA    IFNAME+1        /STASH IT
  977.     TAD I    (INFILE+3)        /GET THIRD INPUT FILENAME WORD
  978.     DCA    IFNAME+2        /STASH IT
  979.     TAD I    [INFILE+4]        /GET FOURTH INPUT FILENAME WORD
  980.     SNA                /SKIP IF SOMETHING THERE
  981.     TAD    ("S^100+"V-300)        /ELSE USE DEFAULT EXTENSION VALUE
  982.     DCA    IFNAME+3        /STASH IT EITHER WAY
  983.     JMP I    MIFNAME            /RETURN
  984.  
  985. /    TEST IF IMAGE-MODE IS SET.  ASSUME /1 AND /2 ARE NOT SET.
  986.  
  987. IMTEST,    TAD I    (SWAL)            /GET /A-/L SWITCHES
  988.     AND    (10)            /JUST /I BIT
  989.     SZA CLA                /SKIP IF NOT SET
  990.     TAD I    [EQUWRD]        /GET EQUALS PARAMETER
  991.     SNA                /SKIP IF SOMETHING THERE
  992.     JMP I    (INERR)            /ELSE COMPLAIN
  993.     CIA                /INVERT IT
  994.     DCA    INLEN            /USE AS INPUT RECORD COUNT
  995.     DCA    INRECORD        /START AT THE BEGINNING OF THE DEVICE
  996.     ISZ    IMSW            /INDICATE IMAGE-MODE SET
  997.  
  998. /    TEST IF /1 OR /2 IS SET.
  999.  
  1000.     TAD I    [SWY9]            /GET /Y-/9 SWITCHES
  1001.     AND    [600]            /JUST /1, /2 SWITCHES
  1002.     SNA                /SKIP IF EITHER SET
  1003.     JMP    IFNAMOK            /JUMP IF NEITHER SET
  1004.  
  1005. /    TEST IF /1 IS SET.  IF NOT, /2 MUST BE SET.
  1006.  
  1007.     AND    [400]            /JUST /1 SWITCH
  1008.     SNA CLA                /SKIP IF /1 SET
  1009.     JMP    IM2            /JUMP IF /2 SET
  1010.  
  1011. /    FOR A  FIRST HALF, USE THE ROUNDED-DOWN FIRST HALF LENGTH.  THE DATA STARTS AT
  1012. /    RECORD ZERO (ALREADY SET).
  1013.  
  1014.     TAD I    [EQUWRD]        /GET EQUALS PARAMETER
  1015.     CLL RAR                /%2
  1016. IM2ENTR,CIA                /INVERT IT
  1017.     DCA    INLEN            /SET COUNT FOR HALF OF THE DEVICE
  1018.     JMP    IFNAMOK            /KEEP GOING
  1019. /    FOR A SECOND HALF, THE DATA STARTS AT THE HALFWAY POINT (ROUNDED DOWN).
  1020.  
  1021. IM2,    TAD I    [EQUWRD]        /GET EQUALS PARAMETER
  1022.     CLL RAR                /%2
  1023.     DCA    INRECORD        /SETUP STARTING RECORD
  1024.  
  1025. /    FOR A SECOND HALF,  THE  COUNT  IS THE ORIGINAL AMOUNT MINUS THE COUNT FOR THE
  1026. /    FIRST HALF.
  1027.  
  1028.     TAD I    [EQUWRD]        /GET EQUALS PARAMETER
  1029.     CLL RAR                /%2
  1030.     CIA                /INVERT IT
  1031.     TAD I    [EQUWRD]        /SUBTRACT FROM EQUALS PARAMETER
  1032.     JMP    IM2ENTRY        /CONTINUE THERE
  1033.  
  1034. CHKBND,    .-.                /CHECK IF ON GOOD OUTPUT BOUNDARY ROUTINE
  1035.     TAD    OBOUND            /GET BOUNDARY COUNTER
  1036.     TAD    (5)            /COMPARE TO BEGINNING VALUE
  1037.     SNA CLA                /SKIP IF NOT AT BEGINNING
  1038.     ISZ    CHKBND            /SET SKIP RETURN IF AT BEGINNING
  1039.     JMP I    CHKBND            /RETURN EITHER WAY
  1040.  
  1041. OCTOUT,    .-.                /OCTAL OUTPUT ROUTINE
  1042.     DCA    OCTEMP            /SAVE IT
  1043.     TAD    (-4)            /SETUP THE
  1044.     DCA    OCTCNT            /DIGIT COUNTER
  1045. OCTLUP,    TAD    OCTEMP            /GET THE VALUE
  1046.     RTL;RAL                /MOVE UP A DIGIT
  1047.     DCA    OCTEMP            /STORE BACK
  1048.     TAD    OCTEMP            /GET IT AGAIN
  1049.     RAL                /PUT INTO CORRECT BITS
  1050.     AND    [7]            /JUST ONE DIGIT
  1051.     TAD    ["0&177]        /MAKE IT ASCII
  1052.     JMS I    [DOBYTE]        /OUTPUT IT
  1053.     ISZ    OCTCNT            /DONE ENOUGH?
  1054.     JMP    OCTLUP            /NO, GO BACK FOR MORE
  1055.     JMP I    OCTOUT            /YES, RETURN TO CALLER
  1056.  
  1057.     PAGE
  1058. /    FILE TEXT MESSAGES.
  1059.  
  1060. DATMSG,    TEXT    "(^REMARK F^ILE ^D^ATE: "
  1061. EMSG,    TEXT    ")%^"
  1062. ENDMSG,    TEXT    ">%(^END ^"
  1063. EOFMSG,    TEXT    "(^REMARK E^ND OF ^F^ILE)%"
  1064. FILMSG,    TEXT    "(^FILE "
  1065. IFMSG,    TEXT    "^B^LOCK-^I^MAGE-^F^ILE =^"
  1066. MMSG,    TEXT    "-^D^EC-19"
  1067. ONMSG,    TEXT    ": ^"
  1068. PT1MSG,    TEXT    " ^F^IRST ^H^ALF"
  1069. PT2MSG,    TEXT    " ^S^ECOND ^H^ALF^"
  1070. REMMSG,    TEXT    "(^REMARK PDP-8/DEC^MATE ^E^NCODING ^P^ROGRAM ^V^ERSION ^"
  1071.     "0+VERSION^100+".-200;    "0+REVISION^100+" -200
  1072.     TEXT    "     C^HARLES ^L^ASNER)%"
  1073.     TEXT    "(^REMARK I^MAGE ^F^ILE ^C^REATED BY ^PDP^-8"
  1074.  
  1075. /    MONTH TEXT TABLE.
  1076.  
  1077. MONLST,    TEXT    "J^AN"            /JANUARY
  1078.     TEXT    "F^EB"            /FEBRUARY
  1079.     TEXT    "M^AR"            /MARCH
  1080.     TEXT    "A^PR"            /APRIL
  1081.     TEXT    "M^AY"            /MAY
  1082.     TEXT    "J^UN"            /JUNE
  1083.     TEXT    "J^UL"            /JULY
  1084.     TEXT    "A^UG"            /AUGUST
  1085.     TEXT    "S^EP"            /SEPTEMBER
  1086.     TEXT    "O^CT"            /OCTOBER
  1087.     TEXT    "N^OV"            /NOVEMBER
  1088.     TEXT    "D^EC"            /DECEMBER
  1089.     $                /THAT'S ALL FOLK!
  1090.