File: K12ENC.PA of Disk: Disks/PDP8-Net/diag-games-kermit
(Source file text)
/ OS/8 ENCODING PROGRAM
/ LAST EDIT: 08-JUL-1992 22:00:00 CJL
/ MUST BE ASSEMBLED WITH '/F' SWITCH SET.
/ PROGRAM TO ENCODE OS/8 FILES INTO "PRINTABLE" ASCII FORMAT ("ENCODE").
/ DISTRIBUTED BY CUCCA AS "K12ENC.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE.
/ WRITTEN BY:
/ CHARLES LASNER (CJL)
/ CLA SYSTEMS
/ 72-55 METROPOLITAN AVENUE
/ MIDDLE VILLAGE, NEW YORK 11379-2107
/ (718) 894-6499
/ USAGE:
/ .RUN DEV ENCODE INVOKE PROGRAM
/ *OUTPUT<INPUT PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <CR>)
/ *OUTPUT<DEV:=NNNN/I **** SPECIAL IMAGE TRANSFER MODE **** INPUT IS RECORD
/ 0000-[NNNN-1] ON DEVICE DEV:. THE =NNNN VALUE MUST BE
/ STATED PRECISELY TO TRANSFER THE REQUISITE AMOUNT OF
/ THE DEVICE AS REQUIRED. THE VALUE IS GENERALLY THE
/ TOTAL LENGTH OF THE DEVICE, BUT COULD BE LESS AS
/ NECESSARY; LARGER VALUES WILL GENERALLY FAIL. THIS
/ MODE SHOULD ONLY BE USED TO EFFECT TRANSFER OF
/ COMPLETE DEVICE IMAGES WHERE THE NORMAL OS/8 FILE
/ STRUCTURE IS UNSUITABLE. IN THIS MODE, THE OS/8 FILE
/ (POSSIBLY PRESENT) ON THE DEVICE IS IGNORED. ****
/ NOTE **** THIS METHOD VIOLATES ALL OS/8 DEVICE
/ STRUCTURE AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE
/ IMAGES ONLY; USE WITH CARE!
/ *OUTPUT<DEV:=NNNN/I/1 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
/ IMAGE MODE EXCEPT ONLY THE FIRST HALF OF THE DATA IS
/ USED. THE DECODER MUST BE GIVEN THE EQUIVALENT
/ PARAMETERS TO TRANSFER THE FIRST HALF.
/ *OUTPUT<DEV:=NNNN/I/2 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
/ IMAGE MODE EXCEPT ONLY THE SECOND HALF OF THE DATA IS
/ USED. NOTE THAT THERE MUST BE TWO FILES CREATED, ONE
/ USING /I/1 AND THE OTHER USING /I/2 TO COMPLETELY
/ TRANSFER A DEVICE IMAGE UNLESS /I IS USED ALONE!
/ *OUTPUT<INPUT$ PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <ESC>)
/ . PROGRAM EXITS NORMALLY
/ INPUT FILE ASSUMES .SV EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION. IF
/ IMAGE MODE IS USED, THERE IS NO INPUT FILE SPECIFICATION; ONLY A DEVICE IS
/ GIVEN ALONG WITH A LENGTH AND THE MANDATORY /I SWITCH.
/ PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
/ KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC>
/ CHARACTER.
/ THIS PROGRAM SUPPORTS A SUBSET OF THE ASCII FILE ENCODING SCHEME DEVELOPED BY
/ CHARLES LASNER AND FRANK DA CRUZ. THE SCHEME USED IS FIVE-BIT ENCODING WITH
/ COMPRESSION, (AS OPPOSED TO SIX-BIT WITHOUT COMPRESSION AS USED IN PRIOR
/ VERSIONS).
/ RESTRICTIONS:
/ A) NO SUPPORT FOR MULTIPLE DECODABLE FILES PER ENCODED FILE.
/ B) CREATES ENCODED PDP-8 60-BIT CHECKSUM AT END OF FILE.
/ C) CUSTOMIZED (REMARK) COMMANDS MUST BE SEPARATELY ADDED BY THE USER.
/ D) THE FILENAME IN THE (FILE ) AND (END ) COMMANDS WILL BE IDENTICAL TO
/ THE ACTUAL INVOKED INPUT FILE. THE USER MUST SEPARATELY MODIFY THESE
/ COMMANDS WHEN EXPORTING THE ENCODED FILE TO A SYSTEM WITH DIFFERENT
/ NAMING CONVENTIONS.
/ ERROR MESSAGES.
/ ERROR MESSAGES ARE ONE OF TWO VARIETIES: COMMAND DECODER MESSAGES AND USER
/ (PROGRAM-SIGNALLED) MESSAGES.
/ COMMAND DECODER MESSAGES ARE NON-FATAL AND MERELY REQUIRE RETYPING THE
/ COMMAND. ATTEMPTING TO USE MORE THAN ONE OUTPUT FILE WILL YIELD THE COMMAND
/ DECODER MESSAGE "TOO MANY FILES" AND CAUSE A REPEAT OF THE COMMAND DECODER
/ PROMPT REQUIRING USER INPUT. THE USER IS DIRECTED TO OTHER DOCUMENTATION OF
/ THE "SPECIAL" MODE OF THE COMMAND DECODER, AS THAT IS THE ONLY MODE USED BY
/ THIS UTILITY PROGRAM.
/ ANY USER MESSAGE PRINTED IS A FATAL ERROR MESSAGE CAUSED BY A PROBLEM BEYOND
/ THE SCOPE OF THE COMMAND DECODER. ALL USER MESSAGES ARE THE STANDARD OS/8
/ "USER" ERROR MESSAGES OF THE FORM: "USER ERROR X AT AAAAA", WHERE X IS THE
/ ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
/ THE FOLLOWING USER ERRORS ARE DEFINED:
/ ERROR NUMBER PROBABLE CAUSE
/ 0 NO OUTPUT FILE.
/ 1 INPUT FILE ERROR (CAN'T FIND INPUT FILE) OR NO INPUT
/ FILE SPECIFIED OR TOO MANY INPUT FILES SPECIFIED.
/ 2 ILLEGAL OUTPUT FILE NAME (WILD CARDS NOT ALLOWED).
/ 3 NO OUTPUT FILE NAME (DEVICE ONLY IS NOT ALLOWED).
/ 4 ERROR WHILE FETCHING FILE HANDLER.
/ 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
/ 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
/ 7 ERROR WHILE CLOSING THE OUTPUT FILE.
/ 8 I/O ERROR WHILE ENCODING FILE DATA.
/ ASSEMBLY INSTRUCTIONS.
/ IT IS ASSUMED THE SOURCE FILE K12ENC.PAL HAS BEEN MOVED AND RENAMED TO
/ DSK:ENCODE.PA.
/ .PAL ENCODE<ENCODE/E/F ASSEMBLE SOURCE PROGRAM
/ .LOAD ENCODE LOAD THE BINARY FILE
/ .SAVE DEV ENCODE=2001 SAVE THE CORE-IMAGE FILE
/ DEFINITIONS.
AIWCNT=1404 /ADDITIONAL INFORMATION WORDS COUNT HERE
AIWXR=0017 /POINTER TO ADDITIONAL INFORMATION WORDS
CLOSE=4 /CLOSE OUTPUT FILE
DATEXT=7777 /DATE EXTENSION HERE
DATWRD=7666 /OS/8 DATE WORD
DECODE=5 /CALL COMMAND DECODER
ENTER=3 /ENTER TENTATIVE FILE
EQUWRD=7646 /EQUALS PARAMETER HERE IN TABLE FIELD
FETCH=1 /FETCH HANDLER
IHNDBUF=7200 /INPUT HANDLER BUFFER
INBUFFE=6200 /INPUT BUFFER
INFILE=7605 /INPUT FILE INFORMATION HERE
LOOKUP=2 /LOOKUP INPUT FILE
NL0001=CLA IAC /LOAD AC WITH 0001
NL0002=CLA CLL CML RTL /LOAD AC WITH 0002
NL7776=CLA CLL CMA RAL /LOAD AC WITH 7776
NL7777=CLA CMA /LOAD AC WITH 7777
OHNDBUF=6600 /OUTPUT HANDLER BUFFER
OUTBUFF=5600 /OUTPUT BUFFER
OUTFILE=7600 /OUTPUT FILE INFORMATION HERE
PRGFLD=00 /PROGRAM FIELD
RESET=13 /RESET SYSTEM TABLES
REVISIO=1 /PROGRAM REVISION
SBOOT=7600 /MONITOR EXIT
SWAL=7643 /A-/L SWITCHES HERE IN TABLE FIELD
SWY9=7645 /Y-/9 SWITCHES HERE IN TABLE FIELD
TBLFLD=10 /COMMAND DECODER TABLE FIELD
TERMWRD=7642 /TERMINATOR WORD
USERROR=7 /USER SIGNALLED ERROR
USR=0200 /USR ENTRY POINT
USRENT=7700 /USR ENTRY POINT WHEN NON-RESIDENT
USRFLD=10 /USR FIELD
USRIN=10 /LOCK USR IN CORE
VERSION=2 /PROGRAM VERSION
WIDTH=107-2 /69 DATA CHARACTERS PER LINE (TOTAL 71)
WRITE=4000 /I/O WRITE BIT
*0 /START AT THE BEGINNING
*10 /DEFINE AUTO-INDEX AREA
XR1, .-. /AUTO-INDEX NUMBER 1
XR2, .-. /AUTO-INDEX NUMBER 2
*20 /GET PAST AUTO-INDEX AREA
BUFPTR, .-. /OUTPUT BUFFER POINTER
CCNT, .-. /CHECKSUM COUNTER
CHKFLG, .-. /CHECKSUMMING ALLOWED FLAG
CHKSUM, ZBLOCK 5 /CHECKSUM
CMPCNT, .-. /MATCH COUNT FOR COMPRESSION
DANGCNT,.-. /DANGER COUNT
FDATE, .-. /FILE DATE
FILLVAL,.-. /FILL VALUE FOR SPECIAL OUTPUT CHARACTERS
IDNUMBE,.-. /INPUT DEVICE NUMBER
IFNAME, ZBLOCK 4 /INPUT FILENAME
IMSW, .-. /IMAGE-MODE SWITCH
INLEN, .-. /INPUT FILE LENGTH
INPTR, .-. /INPUT BUFFER POINTER
INPUT, .-. /INPUT HANDLER POINTER
INRECOR,.-. /INPUT RECORD
FNAME, ZBLOCK 4 /OUTPUT FILENAME
LATEST, .-. /LATEST OUTPUT CHARACTER
OBOUND, .-. /OUTPUT BOUNDARY COUNTER
OCTCNT, .-. /OCTAL OUTPUT ROUTINE COUNTER
OCTEMP, .-. /OCTAL OUTPUT ROUTINE TEMPORARY
ODNUMBE,.-. /OUTPUT DEVICE NUMBER
OUTPUT, .-. /OUTPUT HANDLER POINTER
OUTRECO,.-. /OUTPUT RECORD
PRTEMP, .-. /DATE OUTPUT TEMPORARY
PUTEMP, .-. /OUTPUT TEMPORARY
PUTLATE,.-. /LATEST 5-BIT CHARACTER
PUTPREV,.-. /PREVIOUS OUTPUT TEMPORARY
QUO, .-. /DIVIDE QUOTIENT
REM, .-. /DIVIDE REMAINDER
SCRCASE,.-. /CURRENT MESSAGE CASE
SCRCHAR,.-. /LATEST MESSAGE CHARACTER
SCRPTR, .-. /MESSAGE POINTER
TDATE, .-. /TODAY'S DATE
TEMP, .-. /TEMPORARY
TEMPTR, .-. /TEMPORARY OUTPUT POINTER
WIDCNT, .-. /LINE WIDTH COUNTER
PAGE /START AT THE USUAL PLACE
BEGIN, NOP /IN CASE WE'RE CHAINED TO
CLA /CLEAN UP
START, CIF USRFLD /GOTO USR FIELD
JMS I (USRENTRY) /CALL USR ROUTINE
USRIN /GET IT LOCKED IN
CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
DECODE /WANT COMMAND DECODER
"*^100 /USING SPECIAL MODE
CDF TBLFLD /GOTO TABLE FIELD
TAD I (TERMWRD) /GET TERMINATOR WORD
SPA CLA /SKIP IF <CR> TERMINATED THE LINE
DCA EXITZAP /ELSE CAUSE EXIT LATER
DCA IMSW /CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH
TAD I (OUTFILE) /GET OUTPUT FILE DEVICE WORD
SNA /SKIP IF OUTPUT FILE PRESENT
JMP TSTMORE /JUMP IF NOT THERE
AND [17] /JUST DEVICE BITS
DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER
TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
SNA /SKIP IF PRESENT
JMP INERR /JUMP IF NOT
AND [17] /JUST DEVICE BITS
DCA IDNUMBER /SAVE INPUT DEVICE NUMBER
TAD I (INFILE+5) /GET SECOND INPUT FILE DEVICE WORD
SZA CLA /SKIP IF ONLY ONE INPUT FILE
JMP INERR /ELSE COMPLAIN
JMS I (MIFNAME) /MOVE INPUT FILENAME WITH ADJUSTED EXTENSION
TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD
SNA CLA /SKIP IF NAME PRESENT
JMP NONAMERROR /JUMP IF DEVICE ONLY
JMS I (MOFNAME) /MOVE OUTPUT FILENAME
CDF PRGFLD /BACK TO OUR FIELD
CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
RESET /RESET SYSTEM TABLES
TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT
DCA OHPTR /STORE IN-LINE
TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
FETCH /FETCH HANDLER
OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
JMP FERROR /FETCH ERROR
TAD OHPTR /GET RETURNED ADDRESS
DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS
TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT
DCA IHPTR /STORE IN-LINE
TAD IDNUMBER /GET INPUT DEVICE NUMBER
CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
FETCH /FETCH HANDLER
IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
JMP FERROR /FETCH ERROR
TAD IHPTR /GET RETURNED ADDRESS
DCA INPUT /STORE AS INPUT HANDLER ADDRESS
TAD IMSW /GET IMAGE-MODE SWITCH
SNA CLA /SKIP IF IMAGE MODE SET
JMS I (GEIFILE) /GO LOOKUP INPUT FILE
TAD (FNAME) /POINT TO
DCA ENTAR1 /STORED FILENAME
DCA ENTAR2 /CLEAR SECOND ARGUMENT
JMS I (INDATE) /GET INPUT FILE'S DATE
TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
ENTER /ENTER TENTATIVE FILENAME
ENTAR1, .-. /WILL POINT TO FILENAME
ENTAR2, .-. /WILL BE ZERO
JMP ENTERR /ENTER ERROR
TAD ENTAR1 /GET RETURNED FIRST RECORD
DCA OUTRECORD /STORE IT
TAD ENTAR2 /GET RETURNED EMPTY LENGTH
IAC /ADD 2-1 FOR OS/278 CRAZINESS
DCA DANGCNT /STORE AS DANGER COUNT
JMS I (CLRCHKSUM) /CLEAR THE CHECKSUM
JMS I (ENCODIT) /GO DO THE ACTUAL ENCODING
JMP PROCERR /ERROR WHILE ENCODING
TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
CLOSE /CLOSE OUTPUT FILE
FNAME /POINTER TO FILENAME
OUTCNT, .-. /WILL BE ACTUAL COUNT
JMP CLSERR /CLOSE ERROR
EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000
JMP I (SBOOT) /EXIT TO MONITOR
/ ERROR WHILE PROCESSING INPUT FILE.
PROCERR,NL0002 /SET INCREMENT
SKP /DON'T USE NEXT
/ ERROR WHILE CLOSING THE OUTPUT FILE.
CLSERR, NL0001 /SET INCREMENT
SKP /DON'T CLEAR IT
/ OUTPUT FILE TOO LARGE ERROR.
SIZERR, CLA /CLEAN UP
TAD [3] /SET INCREMENT
SKP /DON'T USE NEXT
/ ENTER ERROR.
ENTERR, NL0002 /SET INCREMENT
SKP /DON'T USE NEXT
/ HANDLER FETCH ERROR.
FERROR, NL0001 /SET INCREMENT
/ NO OUTPUT FILENAME ERROR.
NONAMER,IAC /SET INCREMENT
/ ILLEGAL OUTPUT FILE NAME ERROR.
BADNAME,IAC /SET INCREMENT
/ INPUT FILESPEC ERROR.
INERR, IAC /SET INCREMENT
/ OUTPUT FILESPEC ERROR.
OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER
CDF PRGFLD /ENSURE OUR FIELD
CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
USERROR /USER ERROR
ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER
/ COMES HERE TO TEST FOR NULL LINE.
TSTMORE,TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
SZA CLA /SKIP NO INPUT OR OUTPUT GIVEN
JMP OUTERR /ELSE COMPLAIN
CDF PRGFLD /BACK TO OUR FIELD
JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST
PAGE
ENCODIT,.-. /ENCODING ROUTINE
TAD INRECORD /GET INPUT FILE STARTING RECORD
DCA INREC /STORE IN-LINE
NL7777 /SETUP INITIALIZE VALUE
JMS I [DOBYTE] /INITIALIZE OUTPUT ROUTINE
JMS I (TDMESSAGE) /OUTPUT TODAY'S DATE MESSAGE
JMS I (FDMESSAGE) /OUTPUT FILE DATE MESSAGE
JMS I [SCRIBE] /OUTPUT THE
FILMSG /(FILE MESSAGE
JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME
JMS I [SCRIBE] /OUTPUT THE
EMSG /LINE ENDING
TAD [-WIDTH] /SETUP THE
DCA WIDCNT /LINE WIDTH COUNTER
JMS I (OUTSETUP) /SETUP PACKING ROUTINE AND CLEAR FILL
TAD [-5] /INITIALIZE
DCA OBOUND /BOUNDARY COUNTER
ENCLOOP,JMS I INPUT /CALL INPUT HANDLER
2^100 /READ TWO PAGES
PINBUFF,INBUFFER /INTO INPUT BUFFER
INREC, .-. /WILL BE LATEST INPUT FILE RECORD
ENCERRO,JMP I ENCODIT /INPUT ERROR, TAKE IMMEDIATE RETURN
ISZ INREC /BUMP TO NEXT RECORD
NOP /JUST IN CASE
TAD PINBUFFER/(INBUFFER) /SETUP THE
DCA INPTR /BUFFER POINTER
LOOP, JMS I (CHKBND) /CHECK IF ON A GOOD BOUNDARY
JMP NOCOMPRESSION /COMPRESS IS NOT ALLOWED AT THIS TIME
TAD INPTR /GET CURRENT POINTER
DCA XR1 /STASH FOR SEARCH
DCA CMPCNT /CLEAR MATCH COUNT
CMPLUP, TAD XR1 /GET INDEX VALUE
TAD (-2^200-INBUFFER+1) /COMPARE TO LIMIT
SNA CLA /SKIP IF NOT AT END OF BUFFER
JMP CMPEND /JUMP IF AT END OF BUFFER
TAD I XR1 /GET A CANDIDATE WORD
CIA /INVERT FOR TEST
TAD I INPTR /COMPARE TO CURRENT TEST VALUE
SZA CLA /SKIP IF IT MATCHES
JMP CMPEND /JUMP IF THIS IS NOT A REPEAT
ISZ CMPCNT /BUMP MATCH COUNT
JMP CMPLUP /TRY TO FIND MORE
/ COMES HERE POSSIBLY WITH SOME COMPRESSED VALUES COUNTED.
CMPEND, NL7776 /-2
TAD CMPCNT /DID WE FIND ENOUGH MATCHES?
SPA CLA /SKIP IF SO
JMP NOCOMPRESSION /FORGET IT
TAD ("X-"0) /SETUP COMPRESSION INDICATOR
JMS I (OUTSETUP) /SETUP SPECIAL MODE
JMS I (PUT5) /OUTPUT "X"
JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE
TAD I INPTR /GET THE VALUE
JMS I [PUTIT] /OUTPUT IT
ISZ CMPCNT /ACCOUNT FOR ORIGINAL
TAD CMPCNT /GET COMPRESSION COUNT
CLL RTL;RTL /*16
JMS I [PUTIT] /OUTPUT BITS[0-7] ONLY
JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE AGAIN
TAD INPTR /GET INPUT POINTER
TAD CMPCNT /UPDATE PAST ALL COMPRESSED VALUES
DCA INPTR /STORE BACK
JMP TEST /CONTINUE THERE
/ COMES HERE IF NO COMPRESSION FOUND (OR NOT ALLOWED).
NOCOMPR,TAD I INPTR /GET LATEST VALUE
JMS I [PUTIT] /OUTPUT IT
ISZ INPTR /BUMP TO NEXT
ISZ OBOUND /BUMP TO NEXT WORD
JMP TEST /KEEP GOING
TAD [-5] /RESET THE
DCA OBOUND /BOUNDARY COUNTER
TEST, TAD INPTR /GET INPUT POINTER
TAD (-2^200-INBUFFER) /COMPARE TO UPPER LIMIT
SZA CLA /SKIP IF AT END OF BUFFER
JMP LOOP /ELSE JUST KEEP GOING
ISZ INLEN /DONE ALL INPUT RECORDS?
JMP ENCLOOP /NO, KEEP GOING
/ WE MUST FINISH THE LAST [5 WORDS => 12 BYTES] SEQUENCE.
ENDLUP, JMS I (CHKBND) /AT A GOOD BOUNDARY?
SKP /SKIP IF NOT
JMP ENDONE /JUMP IF SO
JMS I [PUTIT] /OUTPUT SOME WASTE BYTES
ISZ OBOUND /AT A GOOD BOUNDARY NOW?
JMP ENDLUP /NO, TRY AGAIN
ENDONE, TAD ("Z-"0) /GET END INDICATOR
JMS I (OUTSETUP) /SETUP SPECIAL MODE
JMS I (PUT5) /OUTPUT A "Z"
JMS I (INVCHKSUM) /INVERT THE CHECKSUM
JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE
JMS I (CHKOUT) /OUTPUT THE CHECKSUM
JMS I [SCRIBE] /OUTPUT THE
ENDMSG /END MESSAGE
JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME
JMS I [SCRIBE] /OUTPUT THE
EMSG /LINE ENDING
JMS I [SCRIBE] /OUTPUT THE
EOFMSG /FINAL MESSAGE
TAD ("Z&37) /GET <^Z>
CLOSLUP,JMS I [DOBYTE] /OUTPUT A BYTE (^Z OR NULL)
TAD BUFPTR /GET THE OUTPUT BUFFER POINTER
TAD (-OUTBUFFER) /COMPARE TO RESET VALUE
SZA CLA /SKIP IF IT MATCHES
JMP CLOSLUP /ELSE KEEP GOING
ISZ ENCODIT /NO ERRORS
JMP I ENCODIT /RETURN
PAGE
PUTIT, .-. /WORD OUTPUT ROUTINE
DCA PUTEMP /SAVE PASSED VALUE
JMS I (CALCHKSUM) /UPDATE CHECKSUM
JMP I PUTNXT /GO WHERE YOU SHOULD GO
PUTNXT, PUT0 /OUTPUT EXIT ROUTINE
TAD PUTEMP /GET LATEST VALUE
DCA PUTPREV /SAVE FOR NEXT TIME
JMP I PUTIT /RETURN TO MAIL CALLER
PUTLUP, JMS PUTNXT /GET ANOTHER WORD
PUT0, TAD PUTEMP /GET WORD[0]
RTL;RTL;RTL /BITS[0-4] => AC[7-11]
JMS PUT5 /OUTPUT A CHARACTER
TAD PUTEMP /GET WORD[0] AGAIN
RTR /BITS[5-9] => AC[7-11]
JMS PUT5 /OUTPUT A CHARACTER
JMS PUTNXT /GET ANOTHER WORD
PUT1, TAD PUTPREV /GET WORD[0]
AND [3] /ISOLATE BITS[10-11]
CLL RTL;RAL /BITS[10-11] => AC[7-8]
DCA PUTPREV /SAVE FOR NOW
TAD PUTEMP /GET WORD[1]
RTL;RTL /BITS[0-2] => AC[9-11]
AND [7] /ISOLATE DESIRED BITS
TAD PUTPREV /ADD ON WORD[0] BITS IN AC[7-8]
JMS PUT5 /OUTPUT A CHARACTER
TAD PUTEMP /GET WORD[1]
RTR;RTR /BITS[3-7] => AC[7-11]
JMS PUT5 /OUTPUT A CHARACTER
JMS PUTNXT /GET ANOTHER WORD
PUT2, TAD PUTEMP /GET WORD[2]
RAL /BIT[0] => L
CLA /CLEAN UP
TAD PUTPREV /GET WORD[1]
RAL /BITS[8-11],L => AC[7-11]
JMS PUT5 /OUTPUT A CHARACTER
TAD PUTEMP /GET WORD[2]
RTR;RTR;RTR /BITS[1-5] => AC[7-11]
JMS PUT5 /OUTPUT A CHARACTER
TAD PUTEMP /GET WORD[2]
RAR /BITS[6-10] => AC[7-11]
JMS PUT5 /OUTPUT A CHARACTER
JMS PUTNXT /GET ANOTHER WORD
PUT3, TAD PUTPREV /GET WORD[2]
RAR /BIT[11] => L
CLA /CLEAN UP
TAD PUTEMP /GET WORD[3]
RTL;RTL;RAL /L, BITS[0-3] => AC[7-11]
JMS PUT5 /OUTPUT A CHARACTER
TAD PUTEMP /GET WORD[3]
RTR;RAR /BITS[4-8] => AC[7-11]
JMS PUT5 /OUTPUT A CHARACTER
JMS PUTNXT /GET ANOTHER WORD
PUT4, TAD PUTPREV /GET WORD[3]
AND [7] /ISOLATE BITS[9-11]
CLL RTL /BITS[9-11] => AC[7-9]
DCA PUTPREV /SAVE FOR NOW
TAD PUTEMP /GET WORD[4]
RTL;RAL /BITS[0-1] => AC[10-11]
AND [3] /ISOLATE BITS[10-11]
TAD PUTPREV /ADD ON WORD[3] BITS IN AC[7-9]
JMS PUT5 /OUTPUT A CHARACTER
TAD PUTEMP /GET WORD[4]
RTR;RTR;RAR /BITS[2-6] => AC[7-11]
JMS PUT5 /OUTPUT A CHARACTER
TAD PUTEMP /GET WORD[4] BITS[7-11] IN AC[7-11]
JMS PUT5 /OUTPUT A CHARACTER
JMP PUTLUP /GO DO ANOTHER GROUP OF FIVE WORDS
CHKNL, .-. /CHECK IF AT NEW LINE ROUTINE
TAD WIDCNT /GET LINE WIDTH COUNTER
TAD (WIDTH) /COMPARE TO MAXIMIM VALUE
SZA CLA /SKIP IF AT MAXIMUM
ISZ CHKNL /TAKE SKIP RETURN IF NOT AT MAXIMUM
JMP I CHKNL /RETURN EITHER WAY
OUTSETU,.-. /OUTPUT SETUP ROUTINE
DCA FILLVALUE /STORE PASSED FILL VALUE
TAD (PUT0) /SETUP THE
DCA PUTNXT /OUTPUT CO-ROUTINE
JMP I OUTSETUP /RETURN
PUT5, .-. /FIVE-BIT OUTPUT ROUTINE
AND [37] /JUST 5 BITS
DCA PUTLATEST /SAVE IT
JMS CHKNL /CHECK IF AT BEGINNING OF LINE
SKP /SKIP IF NOT
JMP PUTNORMAL /JUMP IF SO
TAD ("<&177) /GET BEGINNING BRACKET
JMS I [DOBYTE] /OUTPUT IT
PUTNORM,TAD PUTLATEST /GET LATEST VALUE
TAD ("0-"9-1) /COMPARE TO FIRST LIMIT
SMA CLA /SKIP IF LESS
TAD ["A-"9-1] /CONVERT LARGER VALUES TO A-V
TAD PUTLATEST /ADD ON LATEST VALUE
TAD ["0&177] /MAKE IT ASCII
TAD FILLVALUE /ADD ON FILL VALUE FOR SPECIAL MODE
JMS I [DOBYTE] /OUTPUT IT
ISZ WIDCNT /BUMP LINE COUNTER
TAD WIDCNT /GET LINE COUNTER
SZA CLA /SKIP IF AT END OF LINE
JMP I PUT5 /ELSE JUST RETURN
TAD (">&177) /GET DATA CLOSING CHARACTER
JMS I [DOBYTE] /OUTPUT IT
TAD ["M&37] /GET A <CR>
JMS I [DOBYTE] /OUTPUT IT
TAD ["J&37] /GET A <LF>
JMS I [DOBYTE] /OUTPUT IT
TAD [-WIDTH] /RESET THE
DCA WIDCNT /LINE WIDTH COUNTER
JMP I PUT5 /RETURN
PAGE
/ MESSAGE PRINT ROUTINE.
SCRIBE, .-. /MESSAGE PRINT ROUTINE
TAD I SCRIBE /GET IN-LINE POINTER ARGUMENT
DCA SCRPTR /STASH THE POINTER
ISZ SCRIBE /BUMP PAST ARGUMENT
TAD (140) /INITIALIZE TO
DCA SCRCASE /LOWER-CASE
SCRLUP, TAD I SCRPTR /GET LEFT HALF-WORD
RTR;RTR;RTR /MOVE OVER
JMS SCRPRNT /PRINT IT
TAD I SCRPTR /GET RIGHT HALF-WORD
JMS SCRPRNT /PRINT IT
ISZ SCRPTR /BUMP TO NEXT PAIR
JMP SCRLUP /KEEP GOING
SCRPRNT,.-. /CHARACTER PRINT ROUTINE
AND [77] /JUST SIX BITS
SNA /END OF MESSAGE?
JMP I SCRIBE /YES, RETURN TO ORIGINAL CALLER
DCA SCRCHAR /NO, SAVE FOR NOW
TAD SCRCHAR /GET IT BACK
TAD (-"%!200) /IS IT "%"?
SNA /SKIP IF NOT
JMP SCRCRLF /JUMP IF IT MATCHES
TAD (-"^+100+"%) /IS IT "^"
SNA CLA /SKIP IF NOT
JMP SCRFLIP /JUMP IF IT MATCHES
TAD SCRCHAR /GET THE CHARACTER
AND [40] /DOES CASE MATTER?
SNA CLA /SKIP IF NOT
TAD SCRCASE /ELSE GET PREVAILING CASE
TAD SCRCHAR /GET THE CHARACTER
SCRPRLF,JMS I [DOBYTE] /OUTPUT THE CHARACTER
JMP I SCRPRNT /RETURN
SCRCRLF,TAD ["M&37] /GET A <CR>
JMS I [DOBYTE] /OUTPUT IT
TAD ["J&37] /GET A <LF>
JMP SCRPRLF /CONTINUE THERE
SCRFLIP,TAD SCRCASE /GET CURRENT CASE
CIA /INVERT IT
TAD (140+100) /ADD SUM OF POSSIBLE VALUES
DCA SCRCASE /STORE NEW INVERTED CASE
JMP I SCRPRNT /RETURN
PUTBYTE,.-. /OUTPUT A BYTE ROUTINE
SPA /ARE WE INITIALIZING?
JMP PUTINITIALIZE /YES
AND (177) /JUST IN CASE
DCA LATEST /SAVE LATEST CHARACTER
TAD LATEST /GET LATEST CHARACTER
JMP I PUTNEXT /GO WHERE YOU SHOULD GO
PUTNEXT,.-. /EXIT ROUTINE
ISZ PUTBYTE /BUMP TO GOOD RETURN
PUTERRO,CLA CLL /CLEAN UP
JMP I PUTBYTE /RETURN TO MAIN CALLER
PUTINIT,CLA /CLEAN UP
TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE
DCA PUTRECORD /STORE IN-LINE
DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH
PUTNEWR,TAD (OUTBUFFER) /SETUP THE
DCA BUFPTR /BUFFER POINTER
PUTLOOP,JMS PUTNEXT /GET A CHARACTER
DCA I BUFPTR /STORE IT
TAD BUFPTR /GET POINTER VALUE
DCA TEMPTR /SAVE FOR LATER
ISZ BUFPTR /BUMP TO NEXT
JMS PUTNEXT /GET A CHARACTER
DCA I BUFPTR /STORE IT
JMS PUTNEXT /GET A CHARACTER
RTL;RTL /MOVE UP
AND [7400] /ISOLATE HIGH NYBBLE
TAD I TEMPTR /ADD ON FIRST BYTE
DCA I TEMPTR /STORE COMPOSITE
TAD LATEST /GET LATEST CHARACTER
RTR;RTR;RAR /MOVE UP AND
AND [7400] /ISOLATE LOW NYBBLE
TAD I BUFPTR /ADD ON SECOND BYTE
DCA I BUFPTR /STORE COMPOSITE
ISZ BUFPTR /BUMP TO NEXT
TAD BUFPTR /GET LATEST POINTER VALUE
TAD (-2^200-OUTBUFFERR) /COMPARE TO LIMIT
SZA CLA /SKIP IF AT END
JMP PUTLOOP /KEEP GOING
ISZ DANGCNT /TOO MANY RECORDS?
SKP /SKIP IF NOT
JMP I (SIZERR) /JUMP IF SO
JMS I OUTPUT /CALL I/O HANDLER
2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER
OUTBUFFER /BUFFER ADDRESS
PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
JMP PUTERROR /OUTPUT ERROR!
ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
ISZ PUTRECORD /BUMP TO NEXT RECORD
JMP PUTNEWRECORD /KEEP GOING
DOBYTE, .-. /OUTPUT A BYTE ROUTINE
JMS PUTBYTE /OUTPUT PASSED VALUE
JMP I (ENCERROR) /COULDN'T DO IT
JMP I DOBYTE /RETURN
PAGE
/ INPUT FILE ROUTINE.
GEIFILE,.-. /GET INPUT FILE ROUTINE
JMS LUKUP /TRY TO LOOKUP THE FILE
SKP /SKIP IF IT WORKED
JMP TRYNULL /TRY NULL EXTENSION VERSION
NULLOK, TAD LARG2 /GET NEGATED LENGTH
DCA INLEN /STASH IT
TAD LARG1 /GET FIRST INPUT RECORD
DCA INRECORD /STASH IT
JMP I GEIFILE /RETURN
/ COMES HERE IF LOOKUP FAILED.
TRYNULL,CDF TBLFLD /GOTO TABLE FIELD
TAD I [INFILE+4] /GET ORIGINAL FILENAME'S EXTENSION
CDF PRGFLD /BACK TO OUR FIELD
SZA CLA /SKIP IF IT WAS NULL ORIGINALLY
JMP I (INERR) /ELSE COMPLAIN OF EXPLICIT LOOKUP FAILURE
DCA IFNAME+3 /NOW TRY NULL VERSION INSTEAD OF DEFAULT VERSION
JMS LUKUP /TRY TO LOOK IT UP AGAIN
JMP NULLOK /THAT WORKED!
JMP I (INERR) /COMPLAIN OF LOOKUP FAILURE
LUKUP, .-. /LOW-LEVEL LOOKUP ROUTINE
TAD (IFNAME) /GET OUR FILENAME POINTER
DCA LARG1 /STORE IN-LINE
DCA LARG2 /CLEAR SECOND ARGUMENT
TAD IDNUMBER /GET INPUT DEVICE NUMBER
CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
LOOKUP /WANT LOOKUP FUNCTION
LARG1, .-. /WILL BE POINTER TO OUR FILENAME
LARG2, .-. /WILL RETURN FILE LENGTH (HOPEFULLY)
ISZ LUKUP /LOOKUP FAILED, SO BUMP RETURN ADDRESS
JMP I LUKUP /RETURN EITHER WAY
/ INPUT FILENAME PRINT ROUTINE.
PIFNAME,.-. /PRINT INPUT FILENAME ROUTINE
TAD IMSW /GET IMAGE-MODE SWITCH
SNA CLA /SKIP IF SET
JMP DOIFNAME /JUMP IF NOT
JMS I [SCRIBE] /OUTPUT THE
IFMSG /IMAGE MESSAGE
CDF TBLFLD /GOTO TABLE FIELD
TAD I [EQUWRD] /GET EQUALS PARAMETER
CDF PRGFLD /BACK TO OUR FIELD
JMS I (OCTOUT) /OUTPUT IT
CDF TBLFLD /GOTO TABLE FIELD
TAD I [SWY9] /GET /Y-/9 SWITCHES
CDF PRGFLD /BACK TO OUR FIELD
AND [600] /JUST /1, /2 BITS
SNA /SKIP IF SOMETHING SET
JMP I PIFNAME /JUST RETURN IF NOT
AND [400] /JUST /1 BIT
SNA CLA /SKIP IF /1 SET
JMP PIFPT2 /JUMP IF /2 SET
JMS I [SCRIBE] /OUTPUT THE
PT1MSG /PART ONE MESSAGE
JMP I PIFNAME /RETURN
PIFPT2, JMS I [SCRIBE] /OUTPUT THE
PT2MSG /PART TWO MESSAGE
JMP I PIFNAME /RETURN
DOIFNAM,TAD IFNAME /GET FIRST PAIR
JMS PIF2 /PRINT IT
TAD IFNAME+1 /GET SECOND PAIR
JMS PIF2 /PRINT IT
TAD IFNAME+2 /GET THIRD PAIR
JMS PIF2 /PRINT IT
TAD (".&177) /GET SEPARATOR
JMS PIFOUT /PRINT IT
TAD IFNAME+3 /GET FOURTH PAIR
JMS PIF2 /PRINT IT
JMP I PIFNAME /RETURN
PIF2, .-. /PRINT A PAIR ROUTINE
DCA SCRCHAR /SAVE PASSED PAIR
TAD SCRCHAR /GET IT BACK
RTR;RTR;RTR /MOVE DOWN
JMS PIFOUT /PRINT HIGH-ORDER FIRST
TAD SCRCHAR /GET IT AGAIN
JMS PIFOUT /PRINT LOW-ORDER
JMP I PIF2 /RETURN
PIFOUT, .-. /FILENAME CHARACTER OUTPUT ROUTINE
AND [77] /JUST SIXBIT
SNA /SKIP IF SOMETHING THERE
JMP I PIFOUT /ELSE IGNORE IT
TAD [40] /INVERT IT
AND [77] /REMOVE EXCESS
TAD [40] /INVERT IT AGAIN
JMS I [DOBYTE] /OUTPUT IT
JMP I PIFOUT /RETURN
MOFNAME,.-. /MOVE OUTPUT FILENAME ROUTINE
TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD
JMS CHKNAME /CHECK IF LEGAL
DCA FNAME /STASH IT
TAD I (OUTFILE+2) /GET SECOND OUTPUT FILENAME WORD
JMS CHKNAME /CHECK IF LEGAL
DCA FNAME+1 /STASH IT
TAD I (OUTFILE+3) /GET THIRD OUTPUT FILENAME WORD
JMS CHKNAME /CHECK IF LEGAL
DCA FNAME+2 /STASH IT
TAD I (OUTFILE+4) /GET FOURTH OUTPUT FILENAME WORD
JMS CHKNAME /CHECK IF LEGAL
DCA FNAME+3 /STASH IT
JMP I MOFNAME /RETURN
/ OUTPUT NAME CHECK ROUTINE.
CHKNAME,.-. /OUTPUT NAME CHECK ROUTINE
DCA LUKUP /SAVE PASSED VALUE
TAD LUKUP /GET IT BACK
RTR;RTR;RTR /MOVE DOWN
JMS CHKIT /CHECK HIGH-ORDER AND GET IT BACK
JMS CHKIT /CHECK LOW-ORDER AND GET IT BACK
JMP I CHKNAME /RETURN
CHKIT, .-. /ONE CHARACTER CHECK ROUTINE
AND [77] /JUST SIX BITS
TAD (-"?!200) /COMPARE TO "?"
SZA /SKIP IF ALREADY BAD
TAD (-"*+"?) /ELSE COMPARE TO "*"
SNA CLA /SKIP IF NEITHER BAD CASE
JMP I (BADNAME) /COMPLAIN OF WILD CHARACTER
TAD LUKUP /GET THE PAIR BACK FOR NEXT TIME
JMP I CHKIT /RETURN
PAGE
CALCHKS,.-. /CALCULATE CHECKSUM ROUTINE
TAD CHKFLG /SHOULD WE CHECKSUM?
SZA CLA /SKIP IF SO
JMP I CALCHKSUM /JUMP IF NOT
JMS CHKSETUP /SETUP
TAD PUTEMP /GET PASSED VALUE
CLL RAR /CLEAR LINK AND MOVE OVER
ADDLUP, RAL /MOVE OVER CARRY
TAD I XR1 /ADD A WORD
DCA I XR2 /STORE BACK
ISZ CCNT /DONE ENOUGH?
JMP ADDLUP /NO, KEEP GOING
JMP I CALCHKSUM /YES, RETURN
CHKOUT, .-. /OUTPUT THE CHECKSUM ROUTINE
JMS CHKSETUP /SETUP
ISZ CHKFLG /DISABLE CHECKSUMMING
TAD I XR1 /GET A WORD
JMS I [PUTIT] /OUTPUT IT
ISZ CCNT /DONE YET?
JMP .-3 /NO, KEEP GOING
JMP I CHKOUT /YES, WE'RE DONE
CLRCHKS,.-. /CLEAR CHECKSUM ROUTINE
JMS CHKSETUP /SETUP
DCA I XR1 /CLEAR A WORD
ISZ CCNT /DONE YET?
JMP .-2 /NO, DO ANOTHER
DCA CHKFLG /ENABLE CHECKSUMMING
JMP I CLRCHKSUM /RETURN
INVCHKS,.-. /CHECKSUM INVERSION ROUTINE
JMS CHKSETUP /SETUP
STL /FORCE INITIAL CARRY
COMLUP, TAD I XR1 /GET A WORD
CMA /INVERT IT
SZL /SKIP IF NO CARRY
CLL IAC /ELSE ADD ONE AND CLEAR CARRY FOR NEXT TIME
DCA I XR2 /STORE BACK
ISZ CCNT /DONE ALL YET?
JMP COMLUP /NO, KEEP GOING
JMP I INVCHKSUM /YES, RETURN
CHKSETU,.-. /CHECKSUM SETUP ROUTINE
TAD (CHKSUM-1) /POINT TO
DCA XR1 /CHECKSUM AREA
TAD (CHKSUM-1) /POINT TO
DCA XR2 /CHECKSUM AREA
TAD [-5] /SETUP THE
DCA CCNT /CHECKSUM COUNT
JMP I CHKSETUP /RETURN
/ FILE DATE ROUTINE.
FDMESSA,.-. /PUT FILE DATE IN MESSAGE ROUTINE
TAD FDATE /GET INPUT FILE'S DATE
SNA CLA /SKIP IF ANY
JMP I FDMESSAGE /RETURN IF NONE
JMS I [SCRIBE] /PRINT OUT THE
DATMSG /DATE BLURB
TAD FDATE /GET IT BACK
JMS PRDATE /PRINT THE DATE
JMS I [SCRIBE] /PRINT THE
EMSG /END MESSAGE
JMP I FDMESSAGE /RETURN
TDMESSA,.-. /PUT TODAY'S DATE IN MESSAGE ROUTINE
JMS I [SCRIBE] /OUTPUT THE
REMMSG /OPENING REMARKS
CDF TBLFLD /GOTO TABLE FIELD
TAD I (DATWRD) /GET DATE WORD
CDF PRGFLD /BACK TO OUR FIELD
SNA /SKIP IF THERE
JMP NOTDATE /JUMP IF NOT
DCA TDATE /SAVE TODAY'S DATE
JMS I [SCRIBE] /OUTPUT THE
ONMSG /BRIDGING MESSAGE
TAD TDATE /GET TODAY'S DATE
JMS PRDATE /PRINT TODAY'S DATE
NOTDATE,JMS I [SCRIBE] /OUTPUT THE
EMSG /END MESSAGE
JMP I TDMESSAGE /RETURN
PRDATE, .-. /DATE PRINT ROUTINE
DCA PRTEMP /SAVE PASSED VALUE
TAD PRTEMP /GET IT BACK
RTR;RAR /MOVE DOWN
AND [37] /JUST DAY BITS
JMS I (DEC2) /PRINT AS TWO DIGITS
TAD PRTEMP /GET DATE AGAIN
AND [7400] /JUST MONTH BITS
CLL RTL;RTL;RTL /MOVE DOWN
TAD (MONLST-2-1) /POINT TO PROPER ELEMENT
DCA XR1 /STASH THE POINTER
TAD I XR1 /GET FIRST PAIR
DCA I (MMSG+1) /STORE IN MESSAGE
TAD I XR1 /GET SECOND PAIR
DCA I (MMSG+2) /STORE IN MESSAGE
JMS I [SCRIBE] /OUTPUT THE
MMSG /MONTH MESSAGE
TAD PRTEMP /GET DATE AGAIN
AND [7] /JUST YEAR BITS
DCA TEMP /SAVE IT
CDF TBLFLD /GOTO TABLE FIELD
TAD I (DATWRD) /GET CURRENT DATE WORD
CDF PRGFLD /BACK TO OUR FIELD
AND [7] /JUST YEAR BITS
CIA /INVERT FOR TEST
TAD TEMP /COMPARE TO DESIRED YEAR
SMA SZA CLA /SKIP IF THEY MATCH OR ARE EARLIER
TAD (-10) /ELSE BACKUP A GROUP
TAD TEMP /ADD TO YEAR
DCA TEMP /STORE BACK
TAD I (DATEXT) /GET EXTENSION WORD
AND [600] /JUST EXTENSION BITS
CLL RTR;RTR /MAKE IT GROUP COUNT
TAD TEMP /ADD ON RELATIVE YEAR
TAD (106) /MAKE IT ABSOLUTE YEAR (70-99)
JMS I (DEC2) /PRINT AS TWO DIGITS
JMP I PRDATE /RETURN
PAGE
DEC2, .-. /PRINT TWO DIGITS ROUTINE
JMS DIVIDE /DIVIDE
12 /BY 10
TAD ["0&177] /MAKE IT ASCII
JMS I [DOBYTE] /OUTPUT IT
TAD REM /GET SECOND DIGIT
TAD ["0&177] /MAKE IT ASCII
JMS I [DOBYTE] /OUTPUT IT
JMP I DEC2 /RETURN
/ DIVIDE ROUTINE.
DIVIDE, .-. /DIVIDE ROUTINE
DCA REM /SAVE IN REMAINDER
DCA QUO /CLEAR QUOTIENT
TAD REM /GET IT BACK
STL CIA /INVERT
SKP /DON'T FIRST TIME
DVLOOP, ISZ QUO /BUMP UP QUOTIENT
TAD I DIVIDE /ADD ON ARGUMENT
SNA SZL /UNDERFLOW?
JMP DVLOOP /NO, KEEP GOING
CIA /YES, INVERT IT BACK
TAD I DIVIDE /RESTORE LOST VALUE
DCA REM /SAVE AS REMAINDER
TAD QUO /GET THE QUOTIENT
ISZ DIVIDE /BUMP PAST ARGUMENT
JMP I DIVIDE /RETURN
INDATE, .-. /GET INPUT FILE'S DATE WORD
CDF TBLFLD /GOTO TABLE FIELD
TAD IMSW /GET IMAGE-MODE SWITCH
SNA CLA /SKIP IF SET
JMP NOIMG /JUMP IF NOT
TAD I (DATWRD) /USE TODAY'S DATE
JMP NOAIW /CONTINUE THERE
NOIMG, TAD I (AIWCNT) /GET AIW COUNT
SNA /SKIP IF ANY
JMP NOAIW /JUMP IF NOT
TAD I [AIWXR] /GET ENTRY POINTER
DCA TEMP /STASH FIRST AIW POINTER
TAD I TEMP /GET FIRST AIW
NOAIW, DCA FDATE /SAVE AS FILE'S DATE
CDF PRGFLD /BACK TO OUR FIELD
JMP I INDATE /RETURN
/ INPUT FILENAME MOVE ROUTINE; USES DEFAULT EXTENSION IF NONE PROVIDED BY USER.
MIFNAME,.-. /MOVE INPUT FILENAME ROUTINE
TAD I (INFILE+1) /GET FIRST INPUT FILENAME WORD
SNA /SKIP IF SOMETHING THERE
JMP IMTEST /JUMP IF NOT
IFNAMOK,DCA IFNAME /STASH IT
TAD I (INFILE+2) /GET SECOND INPUT FILENAME WORD
DCA IFNAME+1 /STASH IT
TAD I (INFILE+3) /GET THIRD INPUT FILENAME WORD
DCA IFNAME+2 /STASH IT
TAD I [INFILE+4] /GET FOURTH INPUT FILENAME WORD
SNA /SKIP IF SOMETHING THERE
TAD ("S^100+"V-300) /ELSE USE DEFAULT EXTENSION VALUE
DCA IFNAME+3 /STASH IT EITHER WAY
JMP I MIFNAME /RETURN
/ TEST IF IMAGE-MODE IS SET. ASSUME /1 AND /2 ARE NOT SET.
IMTEST, TAD I (SWAL) /GET /A-/L SWITCHES
AND (10) /JUST /I BIT
SZA CLA /SKIP IF NOT SET
TAD I [EQUWRD] /GET EQUALS PARAMETER
SNA /SKIP IF SOMETHING THERE
JMP I (INERR) /ELSE COMPLAIN
CIA /INVERT IT
DCA INLEN /USE AS INPUT RECORD COUNT
DCA INRECORD /START AT THE BEGINNING OF THE DEVICE
ISZ IMSW /INDICATE IMAGE-MODE SET
/ TEST IF /1 OR /2 IS SET.
TAD I [SWY9] /GET /Y-/9 SWITCHES
AND [600] /JUST /1, /2 SWITCHES
SNA /SKIP IF EITHER SET
JMP IFNAMOK /JUMP IF NEITHER SET
/ TEST IF /1 IS SET. IF NOT, /2 MUST BE SET.
AND [400] /JUST /1 SWITCH
SNA CLA /SKIP IF /1 SET
JMP IM2 /JUMP IF /2 SET
/ FOR A FIRST HALF, USE THE ROUNDED-DOWN FIRST HALF LENGTH. THE DATA STARTS AT
/ RECORD ZERO (ALREADY SET).
TAD I [EQUWRD] /GET EQUALS PARAMETER
CLL RAR /%2
IM2ENTR,CIA /INVERT IT
DCA INLEN /SET COUNT FOR HALF OF THE DEVICE
JMP IFNAMOK /KEEP GOING
/ FOR A SECOND HALF, THE DATA STARTS AT THE HALFWAY POINT (ROUNDED DOWN).
IM2, TAD I [EQUWRD] /GET EQUALS PARAMETER
CLL RAR /%2
DCA INRECORD /SETUP STARTING RECORD
/ FOR A SECOND HALF, THE COUNT IS THE ORIGINAL AMOUNT MINUS THE COUNT FOR THE
/ FIRST HALF.
TAD I [EQUWRD] /GET EQUALS PARAMETER
CLL RAR /%2
CIA /INVERT IT
TAD I [EQUWRD] /SUBTRACT FROM EQUALS PARAMETER
JMP IM2ENTRY /CONTINUE THERE
CHKBND, .-. /CHECK IF ON GOOD OUTPUT BOUNDARY ROUTINE
TAD OBOUND /GET BOUNDARY COUNTER
TAD (5) /COMPARE TO BEGINNING VALUE
SNA CLA /SKIP IF NOT AT BEGINNING
ISZ CHKBND /SET SKIP RETURN IF AT BEGINNING
JMP I CHKBND /RETURN EITHER WAY
OCTOUT, .-. /OCTAL OUTPUT ROUTINE
DCA OCTEMP /SAVE IT
TAD (-4) /SETUP THE
DCA OCTCNT /DIGIT COUNTER
OCTLUP, TAD OCTEMP /GET THE VALUE
RTL;RAL /MOVE UP A DIGIT
DCA OCTEMP /STORE BACK
TAD OCTEMP /GET IT AGAIN
RAL /PUT INTO CORRECT BITS
AND [7] /JUST ONE DIGIT
TAD ["0&177] /MAKE IT ASCII
JMS I [DOBYTE] /OUTPUT IT
ISZ OCTCNT /DONE ENOUGH?
JMP OCTLUP /NO, GO BACK FOR MORE
JMP I OCTOUT /YES, RETURN TO CALLER
PAGE
/ FILE TEXT MESSAGES.
DATMSG, TEXT "(^REMARK F^ILE ^D^ATE: "
EMSG, TEXT ")%^"
ENDMSG, TEXT ">%(^END ^"
EOFMSG, TEXT "(^REMARK E^ND OF ^F^ILE)%"
FILMSG, TEXT "(^FILE "
IFMSG, TEXT "^B^LOCK-^I^MAGE-^F^ILE =^"
MMSG, TEXT "-^D^EC-19"
ONMSG, TEXT ": ^"
PT1MSG, TEXT " ^F^IRST ^H^ALF"
PT2MSG, TEXT " ^S^ECOND ^H^ALF^"
REMMSG, TEXT "(^REMARK PDP-8/DEC^MATE ^E^NCODING ^P^ROGRAM ^V^ERSION ^"
"0+VERSION^100+".-200; "0+REVISION^100+" -200
TEXT " C^HARLES ^L^ASNER)%"
TEXT "(^REMARK I^MAGE ^F^ILE ^C^REATED BY ^PDP^-8"
/ MONTH TEXT TABLE.
MONLST, TEXT "J^AN" /JANUARY
TEXT "F^EB" /FEBRUARY
TEXT "M^AR" /MARCH
TEXT "A^PR" /APRIL
TEXT "M^AY" /MAY
TEXT "J^UN" /JUNE
TEXT "J^UL" /JULY
TEXT "A^UG" /AUGUST
TEXT "S^EP" /SEPTEMBER
TEXT "O^CT" /OCTOBER
TEXT "N^OV" /NOVEMBER
TEXT "D^EC" /DECEMBER
$ /THAT'S ALL FOLK!