File: K12DEC.PA of Disk: Disks/PDP8-Net/diag-games-kermit
(Source file text)
/ OS/8 DECODING PROGRAM
/ LAST EDIT: 08-JUL-1992 22:00:00 CJL
/ PROGRAM TO DECODE OS/8 FILES FROM "PRINTABLE" ASCII FORMAT TO BINARY-IMAGE
/ FORMAT. INTERMEDIATE "ASCII" CONVERSION SHOULD BE HARMLESS AS LONG AS ALL
/ PRINTING DATA CHARACTERS ARE NOT MODIFIED.
/ DISTRIBUTED BY CUCCA AS "K12DEC.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:
/ THIS PROGRAM OPERATES ON "PRINTABLE" ASCII FILES WHICH HAVE BEEN CREATED BY
/ ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES. THE ENCODING FORMAT ALLOWS
/ FOR SOME INNOCUOUS CONTENT MODIFICATION SUCH AS EXTRANEOUS WHITE SPACE AND
/ EXTRA <CR>/<LF> PAIRS, BUT RIGOROUSLY VALIDATES CERTAIN ASPECTS OF THE FORMAT,
/ SUCH AS A TRAILING CHECKSUM.
/ CERTAIN IMBEDDED COMMANDS ARE USED SUCH AS (REMARK .........) WHICH ALLOWS FOR
/ COMMENTARY LINES WITHIN THE FILE FOR IDENTIFICATION PURPOSES. THE (FILE ) AND
/ (END ) COMMANDS CONTAIN THE SUGGESTED FILENAME FOR THE DESCENDANT DECODED
/ FILE.
/ WHEN CREATING THE DESCENDANT DECODED FILE, THE USER MAY SPECIFY EITHER THE
/ IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE
/ OR A SPECIFIED DEVICE:
/ .RUN DEV DECODE INVOKE PROGRAM.
/ *INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT).
/ *DEV:OUTPUT.EX<INPUT INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:.
/ *DEV:<INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:.
/ *DEV:<INPUT=NNNN/I **** SPECIAL IMAGE TRANSFER MODE **** INPUT IS DECODED
/ INTO RECORD 0000-[NNNN-1] ON DEVICE DEV:. THE =NNNN
/ VALUE SHOULD BE CAREFULLY CHOSEN LARGE ENOUGH TO WRITE
/ ALL DATA RECORDS, BUT NEED NOT BE STATED EXACTLY.
/ (THE ENCODE PROGRAM REQUIRES PRECISE STATEMENT OF THE
/ LENGTH IN IMAGE TRANSFER ENCODING MODE. **** NOTE
/ **** THIS METHOD VIOLATES ALL OS/8 DEVICE STRUCTURE
/ AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE IMAGES
/ ONLY; USE WITH CARE!
/ *DEV:<INPUT=NNNN/I/1 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
/ IMAGE MODE EXCEPT ONLY THE FIRST HALF OF THE DATA IS
/ USED. NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY
/ BECAUSE IT IS USED TO CALCULATE THE APPROX. 1/2 VALUE
/ ACTUALLY USED IN THIS HALF OF THE OVERALL TRANSFER.
/ THIS MODE SHOULD BE USED WITH FILES CREATED FOR THE
/ EXPRESS PURPOSE OF TRANSMISSION BY HALVES ONLY; USE
/ WITH CARE!
/ *DEV:<INPUT=NNNN/I/2 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
/ IMAGE MODE EXCEPT ONLY THE SECOND HALF OF THE DATA IS
/ USED. NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY
/ BECAUSE IT IS USED TO CALCULATE THE STARTING RECORD OF
/ THE APPROX. 1/2 VALUE ACTUALLY USED IN THIS HALF OF
/ THE OVERALL TRANSFER. THIS MODE SHOULD BE USED WITH
/ FILES CREATED FOR THE EXPRESS PURPOSE OF TRANSMISSION
/ BY HALVES ONLY; USE WITH CARE! 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.EX<INPUT$ INPUT IS DECODED INTO OUTPUT.EX ON DSK: (DEFAULT).
/ THE <ESC> CHARACTER WAS USED TO TERMINATE THE LINE
/ (THIS IS SIGNIFIED BY $). THIS CAUSES PROGRAM EXIT.
/ . PROGRAM EXITS NORMALLY.
/ INPUT FILE ASSUMES .EN EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION.
/ IMAGE TRANSFER MODE DOESN'T USE OUTPUT FILENAMES, AS THE TRANSFER DESTROYS THE
/ OS/8 FILE STRUCTURE (POSSIBLY PRESENT) ON THE DEVICE.
/ 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 PROPER SUBSET OF THE ASCII ENCODING SCHEME DISCUSSED
/ 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) SUPPORTS ONLY ONE DECODABLE FILE PER ENCODED FILE.
/ B) IGNORES ALL (END ) COMMANDS.
/ C) <CR> <LF> < ALWAYS INDICATES ENCODED DATA LINES; NO CHECK IS MADE FOR
/ WHETHER THE > IS ON THE SAME LINE AS THE <.
/ D) PDP-8 GENERATED CHECKSUM DATA MUST BE THE FINAL DATA IN THE FILE IN
/ THE PROPER FORMAT: ZCCCCCCCCCCCC WHERE CCCCCCCCCCCC IS THE
/ TWELVE-CHARACTER PDP-8 CHECKSUM DATA.
/ IF THE ENCODED FILE IS PASSED THROUGH ANY INTERMEDIARY PROCESS THAT MODIFIES
/ THE CONTENTS IN A WAY THAT INTERFERES WITH ANY OF THE ABOVE, THIS DECODING
/ PROGRAM WILL FAIL. IT IS THE USER'S RESPONSIBILITY TO EDIT OUT UNWANTED
/ CHANGES TO THE ENCODED FILE. ALL OTHER ASPECTS OF THE PROTOCOL ARE OBEYED,
/ SUCH AS IMBEDDED <FF>, EXTRA <CR> <LF>, OR TRAILING SPACES HAVE NO EFFECT ON
/ THE RELIABILITY OF THE DECODING PROCESS, ETC.
/ ERROR MESSAGES.
/ ANY MESSAGE PRINTED IS A FATAL ERROR MESSAGE. ALL 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 TOO MANY OUTPUT FILES.
/ 1 NO INPUT FILE OR TOO MANY INPUT FILES.
/ 2 IMBEDDED OUTPUT FILENAME FORMAT ERROR.
/ 3 I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME.
/ 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 DECODING FILE DATA OR BAD DATA.
/ ASSEMBLY INSTRUCTIONS.
/ IT IS ASSUMED THE SOURCE FILE K12DEC.PAL HAS BEEN MOVED AND RENAMED TO
/ DSK:DECODE.PA.
/ .PAL DECODE<DECODE ASSEMBLE SOURCE PROGRAM
/ .LOAD DECODE LOAD THE BINARY FILE
/ .SAVE DEV DECODE=0 SAVE THE CORE-IMAGE FILE
/ DEFINITIONS.
CLOSE=4 /CLOSE OUTPUT FILE
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=7617 /INPUT FILE INFORMATION HERE
INQUIRE=12 /INQUIRE ABOUT HANDLER
NL0001=CLA IAC /LOAD AC WITH 0001
NL0002=CLA CLL CML RTL /LOAD AC WITH 0002
NL4000=CLA CLL CML RAR /LOAD AC WITH 4000
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
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=7700 /USR ENTRY POINT
USRFLD=10 /USR FIELD
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
CHKSUM, ZBLOCK 5 /CHECKSUM TEMPORARY
CHRCNT, .-. /CHARACTER COUNTER
CSUMTMP,.-. /CHECKSUM TEMPORARY
DANGCNT,.-. /DANGER COUNT
DATCNT, .-. /DATA COUNTER
DSTATE, .-. /DATA STATE VARIABLE
IDNUMBE,.-. /INPUT DEVICE NUMBER
IMSW, .-. /IMAGE-MODE SWITCH
INITFLA,.-. /INITIALIZE INPUT FLAG
INPUT, .-. /INPUT HANDLER POINTER
INRECOR,.-. /INPUT RECORD
FCHKSUM,ZBLOCK 5 /FILE CHECKSUM
FNAME, ZBLOCK 4 /OUTPUT FILENAME
GWTMP1, .-. /GETWORD TEMPORARY
GWTMP2, .-. /GETWORD TEMPORARY
GWVALUE,.-. /LATEST WORD VALUE
ODNUMBE,.-. /OUTPUT DEVICE NUMBER
OUTPUT, .-. /OUTPUT HANDLER POINTER
OUTRECO,.-. /OUTPUT RECORD
PUTEMP, .-. /OUTPUT TEMPORARY
PUTPTR, .-. /OUTPUT POINTER
THIRD, .-. /THIRD BYTE TEMPORARY
/ STATE TABLE.
P, SCANIT /0000 LOOKING FOR "(" OR "<"
FNDCOMMAND /0001 FOUND "(" AND NOW LOOKING FOR ")"
FNDCEND /0002 FOUND ")" AND NOW LOOKING FOR <CR>
FNDCR /0003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET
STORDATA /4000 FOUND "<" AND PROCESSING 69 DATA BYTES
ENDATA /4001 FOUND 69 DATA BYTES AND NOW LOOKING FOR ">"
ENDCR /4002 FOUND ">" AND NOW LOOKING FOR <CR>
FNDCR/ENDLF /4003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET
PAGE /START AT THE USUAL PLACE
BEGIN, NOP /HERE IN CASE WE'RE CHAINED TO
CLA /CLEAN UP
START, CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
DECODE /WANT COMMAND DECODER
"E^100+"N-300 /.EN IS DEFAULT EXTENSION
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 FIRST OUTPUT FILE DEVICE WORD
SNA /SKIP IF FIRST OUTPUT FILE PRESENT
JMP TSTMORE /JUMP IF NOT THERE
AND [17] /JUST DEVICE BITS
ODNULL, DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER
TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD
SNA /SKIP IF THERE
TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD
SZA CLA /SKIP IF BOTH NOT PRESENT
JMP I (OUTERR) /ELSE COMPLAIN
TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
SNA /SKIP IF PRESENT
JMP I (INERR) /JUMP IF NOT
AND [17] /JUST DEVICE BITS
DCA IDNUMBER /SAVE INPUT DEVICE NUMBER
TAD I (INFILE+2) /GET SECOND INPUT FILE DEVICE WORD
SZA CLA /SKIP IF ONLY ONE INPUT FILE
JMP I (INERR) /ELSE COMPLAIN
TAD I (INFILE+1) /GET FIRST INPUT FILE STARTING RECORD
DCA INRECORD /SET IT UP
CDF PRGFLD /BACK TO OUR FIELD
CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
RESET /RESET SYSTEM TABLES
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 I (FERROR) /FETCH ERROR
TAD IHPTR /GET RETURNED ADDRESS
DCA INPUT /STORE AS INPUT HANDLER ADDRESS
JMS I (GEOFILE) /GET OUTPUT FILE INFORMATION
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 I (FERROR) /FETCH ERROR
TAD OHPTR /GET RETURNED ADDRESS
DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS
TAD IMSW /GET IMAGE-MODE SWITCH
SNA CLA /SKIP IF SET
JMP NOIMAGE /JUMP IF NOT
/ IF /2 IS SET, THE DATA STARTS HALF-WAY INTO THE IMAGE. OTHER IMAGE MODES
/ START AT RECORD 0000.
CDF TBLFLD /GOTO TABLE FIELD
TAD I [SWY9] /GET /Y-/9 SWITCHES
AND (200) /JUST /2 SWITCH
SNA CLA /SKIP IF SET
JMP IMAGE1 /JUMP IF /1 OR NEITHER /1, /2 SET
TAD I [EQUWRD] /GET EQUALS PARAMETER
CLL RAR /%2
IMAGE1, DCA OUTRECORD /STORE STARTING OUTPUT RECORD
CDF PRGFLD /BACK TO OUR FIELD
SKP /DON'T ENTER FILE NAME
NOIMAGE,JMS I (FENTER) /ENTER THE TENTATIVE FILE NAME
DCA DSTATE /SET INITIAL DATA STATE
JMS I (CLRCHKSUM) /CLEAR OUT CHECKSUM
JMS I (DECODIT) /GO DO THE ACTUAL DECODING
JMP I (PROCERR) /ERROR WHILE DECODING
TAD IMSW /GET IMAGE-MODE SWITCH
SZA CLA /SKIP IF CLEAR
JMP EXITZAP /JUMP IF SET
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 I (CLSERR) /CLOSE ERROR
EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000
JMP I (SBOOT) /EXIT TO MONITOR
/ COMES HERE TO TEST FOR NULL LINE.
TSTMORE,TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD
SNA /SKIP IF PRESENT
TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD
SZA CLA /SKIP IF NO OUTPUT FILES
JMP I (OUTERR) /ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT
TAD I (INFILE) /GET FIRST OUTPUT FILE DEVICE WORD
SZA CLA /SKIP IF NO INPUT FILES
JMP ODNULL /JUMP IF INPUT WITHOUT OUTPUT
CDF PRGFLD /BACK TO OUR FIELD
JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST
PAGE
/ 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
/ I/O ERROR WHILE PROCESSING (FILE ) COMMAND.
NIOERR, IAC /SET INCREMENT
/ FORMAT ERROR WHILE PROCESSING (FILE ) COMMAND.
CHARERR,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
DECODIT,.-. /DECODING ROUTINE
TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE
DCA PUTRECORD /STORE IN-LINE
DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH
NL7777 /SETUP THE
DCA INITFLAG /INITIALIZE FLAG
TAD (GWLOOP) /INITIALIZE THE
DCA I (GWNEXT) /DECODE PACK ROUTINE
PUTNEWR,TAD POUTBUFFER/(OUTBUFFER) /SETUP THE
DCA PUTPTR /OUTPUT BUFFER POINTER
PUTLOOP,JMS I (GETWORD) /GET A WORD
DCA I PUTPTR /STORE IT
ISZ PUTPTR /BUMP TO NEXT
TAD PUTPTR /GET THE POINTER
TAD (-2^200-OUTBUFFER) /COMPARE TO LIMIT
SZA CLA /SKIP IF AT END
JMP PUTLOOP /KEEP GOING
ISZ DANGCNT /TOO MANY RECORDS?
SKP /SKIP IF NOT
JMP I (SIZERROR) /NOT ENOUGH SPACE AVAILABLE
JMS I OUTPUT /CALL OUTPUT HANDLER
2^100+WRITE /WRITE LATEST RECORD
POUTBUF,OUTBUFFER /OUTPUT BUFFER ADDRESS
PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
DECERR, JMP I DECODIT /I/O ERROR
ISZ PUTRECORD /BUMP TO NEXT RECORD
NOP /JUST IN CASE
ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
JMP PUTNEWRECORD /GO DO ANOTHER ONE
/ GOOD RETURN HERE.
DECBMP, ISZ DECODIT /BUMP TO GOOD RETURN
JMP I DECODIT /RETURN
/ OS/8 FILE UNPACK ROUTINE.
GETBYTE,.-. /GET A BYTE ROUTINE
SNA CLA /INITIALIZING?
JMP I PUTC /NO, GO GET NEXT BYTE
TAD INRECORD /GET STARTING RECORD OF INPUT FILE
DCA GETRECORD /STORE IN-LINE
GETNEWR,JMS I INPUT /CALL I/O HANDLER
2^100 /READ TWO PAGES INTO BUFFER
INBUFFER /BUFFER ADDRESS
GETRECO,.-. /WILL BE LATEST RECORD NUMBER
JMP I GETBYTE /INPUT ERROR!
TAD (INBUFFER) /SETUP THE
DCA BUFPTR /BUFFER POINTER
GETLOOP,DCA THIRD /CLEAR THIRD BYTE NOW
JMS PUTONE /OBTAIN AND SEND BACK FIRST BYTE
JMS PUTONE /OBTAIN AND SEND BACK SECOND BYTE
TAD THIRD /GET THIRD BYTE
JMS PUTC /SEND IT BACK
TAD BUFPTR /GET THE POINTER
TAD (-2^200-INBUFFER) /COMPARE TO LIMIT
SZA CLA /SKIP IF AT END
JMP GETLOOP /KEEP GOING
ISZ GETRECORD /BUMP TO NEXT RECORD
JMP GETNEWRECORD /GO DO ANOTHER ONE
PUTONE, .-. /SEND BACK A BYTE ROUTINE
TAD I BUFPTR /GET LATEST WORD
AND (7400) /JUST THIRD-BYTE NYBBLE
CLL RAL /MOVE UP
TAD THIRD /GET OLD NYBBLE (IF ANY)
RTL;RTL /MOVE UP NYBBLE BITS
DCA THIRD /SAVE FOR NEXT TIME
TAD I BUFPTR /GET LATEST WORD AGAIN
JMS PUTC /SEND BACK CURRENT BYTE
ISZ BUFPTR /BUMP TO NEXT WORD
JMP I PUTONE /RETURN
PUTC, .-. /SEND BACK LATEST BYTE ROUTINE
AND (177) /KEEP ONLY GOOD BITS
TAD (-"Z!300) /COMPARE TO <^Z>
SNA /SKIP IF NOT ASCII <EOF>
JMP GETEOF /JUMP IF ASCII MODE <EOF>
TAD ("Z&37) /RESTORE THE CHARACTER
ISZ GETBYTE /BUMP PAST <EOF> RETURN
GETEOF, ISZ GETBYTE /BUMP PAST I/O ERROR RETURN
JMP I GETBYTE /RETURN TO MAIN CALLER
PAGE
/ GET A DECODED WORD ROUTINE.
GETWORD,.-. /GET A WORD ROUTINE
JMP I GWNEXT /GO WHERE YOU SHOULD GO
GWNEXT, .-. /EXIT ROUTINE
SNL /SKIP IF CHECKSUM PREVENTED
JMS I (DOCHECK) /ELSE DO CHECKSUM
JMP I GETWORD /RETURN TO MAIN CALLER
/ COMES HERE TO PROCESSED COMPRESSED DATA.
GWX, JMS I (GETCHR) /GET NEXT CHARACTER
JMS I (GWORD0) /GET 12-BIT WORD
JMS I (DOCHECK) /INCLUDE IN CHECKSUM
DCA GWVALUE /SAVE AS COMPRESSED VALUE
TAD GWTMP2 /GET LATEST CHARACTER
AND [7] /ISOLATE BITS[9-11]
CLL RTR;RTR /BITS[9-11] => AC[0-2]
DCA GWTMP1 /SAVE FOR NOW
JMS GBIHEXBINARY /GET A CHARACTER
CLL RTL;RTL /BITS[7-11] => AC[3-7]
TAD GWTMP1 /ADD ON BITS[0-2]
JMS I (DOCHECK) /INCLUDE IN CHECKSUM
CLL RTR;RTR /BITS[0-7] => AC[4-11]
SNA /SKIP IF NOT 256
TAD [400] /000 => 256
CIA /INVERT FOR COUNTING
DCA GWTMP1 /SAVE AS REPEAT COUNTER
GWXLUP, TAD GWVALUE /GET THE VALUE
STL /PREVENT CHECKSUMMING IT
JMS GWNEXT /RETURN IT TO THEM
ISZ GWTMP1 /DONE ENOUGH?
JMP GWXLUP /NO, KEEP GOING
/ COMES HERE TO INITIATE ANOTHER DATA GROUP.
GWLOOP, JMS I (GETCHR) /GET LATEST FILE CHARACTER
TAD (-"Z!200) /COMPARE TO EOF INDICATOR
SNA /SKIP IF OTHER
JMP GWZ /JUMP IF IT MATCHES
TAD (-"X+"Z) /COMPARE TO COMPRESSION INDICATOR
SNA CLA /SKIP IF OTHER
JMP GWX /JUMP IF IT MATCHES
TAD PUTEMP /GET THE CHARACTER BACK
JMS I (GWORD0) /GET A 12-BIT WORD
JMS GWNEXT /RETURN IT
JMS I (GWORD1) /GET NEXT 12-BIT WORD
JMS GWNEXT /RETURN IT
JMS I (GWORD2) /GET NEXT 12-BIT WORD
JMS GWNEXT /RETURN IT
JMS I (GWORD3) /GET NEXT 12-BIT WORD
JMS GWNEXT /RETURN IT
JMS I (GWORD4) /GET NEXT 12-BIT WORD
JMS GWNEXT /RETURN IT
JMP GWLOOP /KEEP GOING
/ COMES HERE WHEN EOF INDICATOR FOUND.
GWZ, TAD (FCHKSUM-1) /SETUP THE
DCA XR1 /CHECKSUM POINTER
JMS I (GETCHR) /GET NEXT CHARACTER
JMS I (GWORD0) /GET A 12-BIT WORD
DCA I XR1 /STORE IT
JMS I (GWORD1) /GET NEXT WORD
DCA I XR1 /STORE IT
JMS I (GWORD2) /GET NEXT WORD
DCA I XR1 /STORE IT
JMS I (GWORD3) /GET NEXT WORD
DCA I XR1 /STORE IT
JMS I (GWORD4) /GET NEXT WORD
DCA I XR1 /STORE IT
TAD (CHKSUM-1) /POINT TO
DCA XR1 /CALCULATED CHECKSUM
TAD (FCHKSUM-1) /POINT TO
DCA XR2 /FILE CHECKSUM
TAD [-5] /SETUP THE
DCA CCNT /COMPARE COUNT
CLL /CLEAR LINK FOR TEST
GWCMPLP,RAL /GET CARRY
TAD I XR1 /GET A CALCULATED WORD
TAD I XR2 /COMPARE TO FILE WORD
SZA CLA /SKIP IF OK
JMP I (DECERR) /ELSE COMPLAIN
ISZ CCNT /DONE ALL?
JMP GWCMPLP /NO, KEEP GOING
/ THE CHECKSUM IS OK, CHECK IF FILE ENDED IN A PLAUSIBLE PLACE.
TAD PUTPTR /GET OUTPUT POINTER
TAD (-OUTBUFFER-4) /COMPARE TO LIMIT
SMA SZA CLA /SKIP IF GOOD VALUE
JMP I (DECERROR) /JUMP IF NOT
/ THE FILE ENDED OK, THERE WERE POSSIBLY A FEW CHARACTERS LEFTOVER BECAUSE OF
/ ALIGNMENT CONSIDERATIONS. THEY SHOULD BE IGNORED SINCE OS/8 FILES ARE
/ MULTIPLES OF WHOLE RECORDS.
JMP I (DECBMP) /RETURN WITH ALL OK
GBIHEXB,.-. /GET BINARY VALUE OF BIHEXADECIMAL CHARACTER
CLA /CLEAN UP
TAD GBIHEXBINARY /GET OUR CALLER
DCA BIHEXBINARY /MAKE IT THEIRS
JMS I (GETCHR) /GET A CHARACTER
SKP /DON'T EXECUTE HEADER!
BIHEXBI,.-. /CONVERT BIHEXADECIMAL TO BINARY
TAD (-"A!200) /COMPARE TO ALPHABETIC LIMIT
SMA /SKIP IF LESS
TAD ("9+1-"A) /ELSE ADD ON ALPHABETIC OFFSET
TAD (-"0+"A) /MAKE IT BINARY, NOT ASCII
DCA GWTMP2 /SAVE IT
TAD GWTMP2 /GET IT BACK
JMP I BIHEXBINARY /RETURN
PAGE
/ GET WORD[0] ROUTINE. AC MUST ALREADY CONTAIN THE FIRST BI-HEXADECIMAL
/ CHARACTER.
GWORD0, .-. /GET 12-BIT WORD[0]
JMS I (BIHEXBINARY) /CONVERT PASSED VALUE TO BINARY
CLL RTR;RTR;RTR /BITS[7-11] => AC[0-4]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
CLL RTL /BITS[7-11] => AC[5-9]
TAD GWTMP1 /ADD ON BITS[0-4]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
RTR;RAR /BITS[7-8] => AC[10-11]
AND [3] /ISOLATE BITS[10-11]
TAD GWTMP1 /ADD ON BITS[0-9]
CLL /CLEAR LINK
JMP I GWORD0 /RETURN
/ GET WORD[1] ROUTINE. GWORD0 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
/ THE PREVIOUS CHARACTER.
GWORD1, .-. /GET 12-BIT WORD[1]
TAD GWTMP2 /GET PREVIOUS CHARACTER
AND [7] /ISOLATE BITS[9-11]
CLL RTR;RTR /BITS[9-11] => AC[0-2]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
CLL RTL;RTL /BITS[7-11] => AC[3-7]
TAD GWTMP1 /ADD ON BITS[0-2]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
CLL RAR /BITS[7-10] => AC[8-11]
TAD GWTMP1 /ADD ON BITS[0-7]
CLL /CLEAR LINK
JMP I GWORD1 /RETURN
/ GET WORD[2] ROUTINE. GWORD1 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
/ THE PREVIOUS CHARACTER.
GWORD2, .-. /GET 12-BIT WORD[2]
TAD GWTMP2 /GET PREVIOUS CHARACTER
RAR;CLA RAR /BIT[11] => AC[0]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
CLL RTL;RTL;RTL /BITS[7-11] => AC[1-5]
TAD GWTMP1 /ADD ON BIT[0]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
CLL RAL /BITS[7-11] => AC[6-10]
TAD GWTMP1 /ADD ON BITS[0-5]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
AND (20) /ISOLATE BIT[7]
CLL RTR;RTR /BIT[7] => AC[11]
TAD GWTMP1 /ADD ON BITS[0-10]
CLL /CLEAR LINK
JMP I GWORD2 /RETURN
/ GET WORD[3] ROUTINE. GWORD2 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
/ THE PREVIOUS CHARACTER.
GWORD3, .-. /GET 12-BIT WORD[3]
TAD GWTMP2 /GET PREVIOUS CHARACTER
CLL RTR;RTR;RAR /BITS[8-11] => AC[0-3]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
CLL RTL;RAL /BITS[7-11] => AC[4-8]
TAD GWTMP1 /ADD ON BITS[0-3]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
RTR /BITS[7-9] => AC[9-11]
AND [7] /ISOLATE BITS[9-11]
TAD GWTMP1 /ADD ON BITS[0-8]
CLL /CLEAR LINK
JMP I GWORD3 /RETURN
/ GET WORD[4] ROUTINE. GWORD3 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
/ THE PREVIOUS CHARACTER.
GWORD4, .-. /GET 12-BIT WORD[4]
TAD GWTMP2 /GET PREVIOUS CHARACTER
AND [3] /ISOLATE BITS[10-11]
CLL RTR;RAR /BITS[10-11] => AC[0-1]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
CLL RTL;RTL;RAL /BITS[7-11] => AC[2-6]
TAD GWTMP1 /ADD ON BITS[0-1]
DCA GWTMP1 /SAVE FOR NOW
JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
TAD GWTMP1 /ADD ON BITS[0-6] TO BITS[7-11]
CLL /CLEAR LINK
JMP I GWORD4 /RETURN
DOCHECK,.-. /CHECKSUM ROUTINE
DCA CSUMTMP /SAVE PASSED VALUE
TAD (CHKSUM-1) /SETUP THE
DCA XR1 /INPUT POINTER
TAD (CHKSUM-1) /SETUP THE
DCA XR2 /OUTPUT POINTER
TAD [-5] /SETUP THE
DCA CCNT /SUM COUNT
TAD CSUMTMP /GET THE VALUE
CLL RAR /ADJUST FOR OPENING ITERATION
CSUMLUP,RAL /GET CARRY
TAD I XR1 /ADD ON A WORD
DCA I XR2 /STORE BACK
ISZ CCNT /DONE ALL YET?
JMP CSUMLUP /NO, KEEP GOING
TAD CSUMTMP /GET LATEST VALUE
JMP I DOCHECK /RETURN
PAGE
GETCHR, .-. /GET A VALID CHARACTER ROUTINE
GETMORE,TAD INITFLAG /GET INITIALIZE FLAG
JMS I [GETBYTE] /GET A CHARACTER
JMP I (DECERR) /I/O ERROR
JMP I (DECERR) /<EOF>
DCA PUTEMP /SAVE THE CHARACTER
DCA INITFLAG /CLEAR INITIALIZE FLAG
TAD DSTATE /GET DATA STATE
SPA /SKIP IF NOT ONE OF THE DATA-ORIENTED STATES
TAD (4004) /ADD ON DATA-ORIENTED STATES OFFSET
TAD (JMP I P) /SETUP JUMP INSTRUCTION
DCA .+1 /STORE IN-LINE
.-. /AND EXECUTE IT
/ LOOKING FOR OPENING CHARACTER.
SCANIT, TAD PUTEMP /GET THE CHARACTER
TAD (-"<!200) /COMPARE TO OPENING DATA CHARACTER
SNA /SKIP IF NO MATCH
JMP FNDATA /JUMP IF IT MATCHES
TAD (-"(+"<) /COMPARE TO OPENING COMMAND CHARACTER
SNA CLA /SKIP IF NO MATCH
ISZ DSTATE /INDICATE LOOKING FOR END OF COMMAND
JMP GETMORE /KEEP GOING
/ FOUND OPENING COMMAND CHARACTER.
FNDCOMM,TAD PUTEMP /GET THE CHARACTER
TAD (-")!200) /COMPARE TO CLOSING COMMAND CHARACTER
SNA CLA /SKIP IF NO MATCH
ISZ DSTATE /INDICATE LOOKING FOR <CR>
JMP GETMORE /KEEP GOING
/ FOUND CLOSING COMMAND CHARACTER.
FNDCEND,TAD PUTEMP /GET THE CHARACTER
TAD (-"M!300) /COMPARE TO <CR>
SNA CLA /SKIP IF NO MATCH
ISZ DSTATE /INDICATE LOOKING FOR <LF>
JMP GETMORE /KEEP GOING
/ FOUND <CR> AFTER COMMAND.
FNDCR, TAD PUTEMP /GET THE CHARACTER
TAD (-"J!300) /COMPARE TO <LF>
SNA CLA /SKIP IF NO MATCH
DCA DSTATE /RESET TO SCANNING STATE
JMP GETMORE /KEEP GOING
/ FOUND OPENING DATA CHARACTER.
FNDATA, TAD (-WIDTH) /SETUP THE
DCA DATCNT /DATA COUNTER
NL4000 /SETUP THE
DCA DSTATE /NEW STATE
JMP GETMORE /KEEP GOING
/ PROCESSING ONE OF 69 DATA CHARACTERS.
STORDAT,TAD PUTEMP /GET THE CHARACTER
TAD [-140] /SUBTRACT UPPER-CASE LIMIT
SPA /SKIP IF LOWER-CASE
TAD [40] /RESTORE UPPER-CASE
TAD (100) /RESTORE THE CHARACTER
DCA PUTEMP /SAVE IT BACK
TAD PUTEMP /GET IT AGAIN
TAD (-"Z!200-1) /SUBTRACT UPPER LIMIT
CLL /CLEAR LINK FOR TEST
TAD ("Z-"A+1) /ADD ON RANGE
SZL CLA /SKIP IF NOT ALPHABETIC
JMP ALPHAOK /JUMP IF ALPHABETIC
TAD PUTEMP /GET THE CHARACTER
TAD (-"9!200-1) /ADD ON UPPER LIMIT
CLL /CLEAR LINK FOR TEST
TAD ("9-"0+1) /ADD ON RANGE
SNL CLA /SKIP IF OK
JMP GETMORE /IGNORE IF NOT
ALPHAOK,TAD PUTEMP /GET THE CHARACTER
ISZ DATCNT /DONE 69 CHARACTERS?
SKP /SKIP IF NOT
ISZ DSTATE /ADVANCE TO NEXT STATE
JMP I GETCHR /RETURN
/ PROCESSED 69 DATA CHARACTERS; NOW LOOKING FOR ENDING DATA CHARACTER.
ENDATA, TAD PUTEMP /GET THE CHARACTER
TAD (-">!200) /COMPARE TO ENDING DATA VALUE
SNA CLA /SKIP IF NO MATCH
ISZ DSTATE /ELSE ADVANCE TO NEXT STATE
JMP GETMORE /KEEP GOING
/ FOUND ENDING DATA CHARACTER; NOW LOOKING FOR <CR>.
ENDCR, TAD PUTEMP /GET THE CHARACTER
TAD (-"M!300) /COMPARE TO <CR>
SNA CLA /SKIP IF NO MATCH
ISZ DSTATE /ELSE ADVANCE TO NEXT STATE
JMP GETMORE /KEEP GOING
/ FOUND ENDING DATA CHARACTER AND <CR>; NOW LOOKING FOR <LF>.
/ENDLF, TAD PUTEMP /GET THE CHARACTER
/ TAD (-"J!300) /COMPARE TO <LF>
/ SNA CLA /SKIP IF NO MATCH
/ DCA DSTATE /RESET TO SCANNING STATE
/ JMP GETMORE /KEEP GOING
CLRCHKS,.-. /CLEAR CALCULATED CHECKSUM ROUTINE
DCA CHKSUM+0 /CLEAR LOW-ORDER
DCA CHKSUM+1 /CLEAR NEXT
DCA CHKSUM+2 /CLEAR NEXT
DCA CHKSUM+3 /CLEAR NEXT
DCA CHKSUM+4 /CLEAR HIGH-ORDER
JMP I CLRCHKSUM /RETURN
PAGE
GEOFILE,.-. /GET OUTPUT FILE ROUTINE
TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
SZA CLA /SKIP IF NOT ESTABLISHED YET
JMP GOTOD /JUMP IF DETERMINED ALREADY
TAD ("D^100+"S-300) /GET BEGINNING OF "DSK"
DCA DEVNAME /STORE IN-LINE
TAD ("K^100) /GET REST OF "DSK"
DCA DEVNAME+1 /STORE IN-LINE
DCA RETVAL /CLEAR HANDLER ENTRY WORD
CDF PRGFLD /INDICATE OUR FIELD
CIF USRFLD /GOTO USR FIELD
JMS I [USR] /CALL USR ROUTINE
INQUIRE /INQUIRE ABOUT HANDLER
DEVNAME,ZBLOCK 2 /WILL BE DEVICE DSK
RETVAL, .-. /BECOMES HANDLER ENTRY POINT WORD
HLT /DSK: NOT IN SYSTEM IS IMPOSSIBLE!
TAD DEVNAME+1 /GET DEVICE NUMBER FOR DSK:
AND [17] /JUST DEVICE BITS
DCA ODNUMBER /STORE OUTPUT DEVICE
GOTOD, CDF TBLFLD /BACK TO TABLE FIELD
TAD I (OUTFILE+1) /GET OUTPUT FILE FIRST NAME WORD
SNA /SKIP IF PRESENT
JMP GFLNAME /JUMP IF NOT
DCA FNAME /MOVE TO OUR AREA
TAD I (OUTFILE+2) /GET SECOND NAME WORD
DCA FNAME+1 /MOVE IT
TAD I (OUTFILE+3) /GET THIRD NAME WORD
DCA FNAME+2 /MOVE IT
TAD I (OUTFILE+4) /GET EXTENSION WORD
DCA FNAME+3 /MOVE IT
GEOFXIT,CDF PRGFLD /BACK TO OUR FIELD
JMP I GEOFILE /RETURN
/ WE MUST TAKE THE FILENAME FROM THE IMBEDDED (FILE ) COMMAND. THE ONLY
/ EXCEPTION IS IF WE ARE DOING AN IMAGE TRANSFER.
GFLNAME,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 SET TO SOMETHING
JMP DOFLNAME /JUMP IF PARAMETERS NOT SET
CMA /INVERT IT
DCA DANGCNT /STORE AS DANGER COUNT
ISZ IMSW /SET IMAGE-MODE SWITCH
TAD I [SWY9] /GET /Y-/9 SWITCHES
AND (600) /JUST /1, /2 SWITCHES
SNA /SKIP IF EITHER SET
JMP GEOFXIT /JUMP IF NEITHER SET
AND [400] /JUST /1 SWITCH
SNA CLA /SKIP IF /1 SET
JMP IM2 /JUMP IF /2 SET
TAD I [EQUWRD] /GET EQUALS PARAMETER
CLL RAR /%2
JMP IMCOMMON /CONTINUE THERE
IM2, TAD I [EQUWRD] /GET EQUALS PARAMETER
CLL RAR /%2
CIA /SUBTRACT PART 1 VALUE
TAD I [EQUWRD] /FROM EQUALS PARAMETER
IMCOMMO,CMA /INVERT IT
DCA DANGCNT /STORE AS DANGER COUNT
JMP GEOFXIT /EXIT THERE
DOFLNAM,CDF PRGFLD /BACK TO OUR FIELD
NL7777 /SETUP THE
DCA INITFLAG /INPUT FILE INITIALIZATION
JMS I (SCNFILE) /SCAN OFF "(FILE"
/ HAVING FOUND THE (FILE ) COMMAND, WE MUST FIND THE FILENAME.
/ ZERO OUT THE FILENAME AREA.
TAD (-10) /SETUP THE
DCA CHRCNT /CLEAR COUNTER
TAD (ONAME-1) /SETUP THE
DCA XR1 /POINTER
JMS I (CLRNAME) /CLEAR THE NAME BUFFER
/ SETUP FOR SCANNING THE NAME PORTION.
TAD (-6) /SETUP THE
DCA CHRCNT /SCAN COUNT
TAD (ONAME-1) /SETUP THE
DCA XR1 /POINTER
FNCAGN, JMS I (GETAN) /GET A CHARACTER
JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD
DCA I XR1 /STASH THE CHARACTER
ISZ CHRCNT /DONE ALL YET?
JMP FNCAGN /NO, KEEP GOING
/ THROW AWAY EXTRA NAME CHARACTERS.
TOSSNAM,JMS I (GETAN) /GET A CHARACTER
JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD
JMP TOSSNAME /KEEP GOING
/ COMES HERE AFTER "." FOUND.
GOTSEPA,JMS I (CLRNAME) /CLEAR OUT THE REMAINING NAME FIELD
NL7776 /SETUP THE
DCA CHRCNT /SCAN COUNT
EXCAGN, JMS I (GETAN) /GET A CHARACTER
JMP I [CHARERROR] /GOT "."; COMPLAIN
DCA I XR1 /STASH THE CHARACTER
ISZ CHRCNT /DONE ENOUGH YET?
JMP EXCAGN /NO, KEEP GOING
/ TOSS ANY EXTRA EXTENSION CHARACTERS.
TOSSEXT,JMS I (GETAN) /GET A CHARACTER
JMP I [CHARERROR] /GOT "."; COMPLAIN
JMP TOSSEXTENSION /KEEP GOING
/ COMES HERE WHEN TRAILING ")" IS FOUND.
GOTRPAR,JMS I (CLRNAME) /CLEAR ANY REMAINING EXTENSION CHARACTERS
TAD I (ONAME) /GET THE FIRST CHARACTER
SNA CLA /SKIP IF SOMETHING THERE
JMP I [CHARERROR] /COMPLAIN IF NONE THERE
TAD (ONAME-1) /SETUP POINTER
DCA XR1 /TO NAME CHARACTERS
TAD (FNAME-1) /SETUP POINTER
DCA XR2 /TO PACKED NAME AREA
TAD (-4) /SETUP THE
DCA CHRCNT /MOVE COUNT
CHRLOOP,TAD I XR1 /GET FIRST CHARACTER
CLL RTL;RTL;RTL /MOVE UP
TAD I XR1 /ADD ON SECOND CHARACTER
DCA I XR2 /STORE THE PAIR
ISZ CHRCNT /DONE YET?
JMP CHRLOOP /NO, KEEP GOING
JMP I GEOFILE /YES, RETURN
PAGE
SCNFILE,.-. /SCAN "(FILE" ROUTINE
MATAGN, JMS GETNSPC /GET A CHARACTER
TAD (-"(!200) /COMPARE TO "("
SZA CLA /SKIP IF IT MATCHES
JMP MATAGN /JUMP IF NOT
JMS GETNSPC /GET NEXT CHARACTER
TAD (-"F!300) /COMPARE TO "F"
SZA CLA /SKIP IF IT MATCHES
JMP MATAGN /JUMP IF NOT
JMS GETNSPC /GET NEXT CHARACTER
TAD (-"I!300) /COMPARE TO "I"
SZA CLA /SKIP IF IT MATCHES
JMP MATAGN /JUMP IF NOT
JMS GETNSPC /GET NEXT CHARACTER
TAD (-"L!300) /COMPARE TO "L"
SZA CLA /SKIP IF IT MATCHES
JMP MATAGN /JUMP IF NOT
JMS GETNSPC /GET NEXT CHARACTER
TAD (-"E!300) /COMPARE TO "E"
SZA CLA /SKIP IF IT MATCHES
JMP MATAGN /JUMP IF NOT
JMP I SCNFILE /RETURN
CLRNAME,.-. /NAME FIELD CLEARING ROUTINE
TAD CHRCNT /GET CHARACTER COUNTER
SNA CLA /SKIP IF ANY TO CLEAR
JMP I CLRNAME /ELSE JUST RETURN
DCA I XR1 /CLEAR A NAME WORD
ISZ CHRCNT /COUNT IT
JMP .-2 /KEEP GOING
JMP I CLRNAME /RETURN
GETNSPC,.-. /GET NON-<SPACE> CHARACTER
GETNAGN,JMS GETCHAR /GET A CHARACTER
TAD (-" !200) /COMPARE TO <SPACE>
SNA CLA /SKIP IF OTHER
JMP GETNAGN /JUMP IF IT MATCHES
TAD PUTEMP /GET THE CHARACTER BACK
JMP I GETNSPC /RETURN
GETCHAR,.-. /GET A CHARACTER ROUTINE
CLA /CLEAN UP
TAD INITFLAG /GET INITIALIZE FLAG
JMS I [GETBYTE] /GET A CHARACTER
JMP I (NIOERROR) /COMPLAIN IF AN ERROR
JMP I [CHARERROR] /COMPLAIN IF <EOF> REACHED
TAD [-140] /COMPARE TO LOWER-CASE LIMIT
SPA /SKIP IF LOWER-CASE
TAD [40] /RESTORE ORIGINAL IF UPPER-CASE
AND (77) /JUST SIX-BIT
DCA PUTEMP /SAVE IN CASE WE NEED IT
DCA INITFLAG /CLEAR INITIALIZE FLAG
TAD PUTEMP /GET IT BACK
JMP I GETCHAR /RETURN
GETAN, .-. /GET ALPHANUMERIC ROUTINE
JMS GETNSPC /GET A NON-<SPACE> CHARACTER
TAD (-".!200) /COMPARE TO "."
SNA /SKIP IF OTHER
JMP I GETAN /TAKE FIRST RETURN IF IT MATCHES
TAD (-")+".) /COMPARE TO ")"
SNA /SKIP IF OTHER
JMP I (GOTRPAREN) /TAKE DEDICATED RETURN IF IT MATCHES
TAD (-":+")) /SUBTRACT UPPER LIMIT
CLL /CLEAR LINK FOR TEST
TAD (":-"0) /ADD ON RANGE
SZL CLA /SKIP IF NOT NUMERIC
JMP GETANOK /JUMP IF NUMERIC
TAD PUTEMP /GET THE CHARACTER BACK
TAD (-"[!300) /SUBTRACT UPPER LIMIT
CLL /CLEAR LINK FOR TEST
TAD ("[-"A) /ADD ON RANGE
SNL CLA /SKIP IF ALPHABETIC
JMP I [CHARERROR] /ELSE COMPLAIN
GETANOK,TAD PUTEMP /GET GOOD ALPHANUMERIC CHARACTER
ISZ GETAN /BUMP TO SKIP RETURN
JMP I GETAN /RETURN
ONAME, ZBLOCK 10 /OUTPUT NAME FIELD
FENTER, .-. /FILE ENTER ROUTINE
TAD (FNAME) /POINT TO
DCA ENTAR1 /STORED FILENAME
DCA ENTAR2 /CLEAR SECOND ARGUMENT
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 I (ENTERR) /ENTER ERROR
TAD ENTAR2 /GET RETURNED EMPTY LENGTH
IAC /ADD 2-1 FOR OS/278 CRAZINESS
DCA DANGCNT /STORE AS DANGER COUNT
TAD ENTAR1 /GET RETURNED FIRST RECORD
DCA OUTRECORD /SETUP OUTPUT RECORD
JMP I FENTER /RETURN
PAGE
$ /THAT'S ALL FOLK!