File: KERMIT.PA of Tape: Various/Decus/decus-5
(Source file text)
/ KER8.PA KERMIT FOR PDP8
/ 30-JUL-84 JERRY SANDS
/ 18-JUL-85 RANDY HIPPE
/ 04-MAR-86 MICHAEL STEPHAN BSW-->JMS SWAP
/ PROGRAM TO DO FILE TRANSFERS USING THE "KERMIT" PROTOCOL
/
/ IMPLEMENTS THE FOLLOWING COMMANDS:
/
/ 1. CONNECT
/ 2. BYE
/ 3. EXIT
/ 4. SEND
/ 5. GET
/ 6. RECEIVE
/
/ SUPPORTS WILDCARDING FOR "SEND" ONLY.
/ DEFINITIONS
TKSF= 6031 /CONSOLE KEYBOARD FLAG
TKRB= 6036 /CONSOLE KEYBOARD BUFFER
TTSF= 6041 /CONSOLE TELEPRINTER FLAG
TTLS= 6046 /CONSOLE TELEPRINTER BUFFER
/ CHANGE THE FOLLOWING TWO DEFINITIONS AND REASSEMBLE
/
RKIOT= 40 /DEFINE REMOTE RECEIVE IOT
RTIOT= 41 /DEFINE REMOTE TRANSMIT IOT
/
RKSF= RKIOT^10+6001 /DEFINE REMOTE INPUT IOT
RKRB= RKIOT^10+6006 /
RTSF= RTIOT^10+6001 /DEFINE REMOTE OUTPUT IOT
RTLS= RTIOT^10+6006 /
SOH= 1 /START OF PACKET CHAR
CONX1= "\-100 /DEFINE FIRST "CONNECT" EXIT CHAR
CONX2= "C /DEFINE SECOND "CONNECT" EXIT CHAR
CR= 215
SPACE= 240
DELETE= 377
LINSIZ= 40 /KEYBOARD LINE BUFFER SIZE
/ STATE DEFINITIONS
STDAT= "D&137 /DATA
STACK= "Y&137 /ACK
STNAK= "N&137 /NAK
STSIN= "S&137 /SEND INIT
STBRK= "B&137 /BREAK LINK
STFIL= "F&137 /FILENAME HEADER
STEOF= "Z&137 /END OF FILE OR REPLY
STERR= "E&137 /ERROR PACKET
STATT= "A&137 /FILE ATTRIBUTES
STRIN= "R&137 /RECEIVE INIT
STEOT= "B&137 /BREAK TRANSMISSION
STGEN= "G&137 /KERMIT GENERIC COMMAND
DEFCK= "1&177 /DEFAULT 1 CHAR CHECKSUM
DEFEOL= 15+40 /CR IS DEFAULT EOL
DEFQCTL= "#&177 /"#" IS DEFAULT QCTL
DECIMAL
DEFMAXL= 94 /DEFAULT MAX SIZE
OCTAL
/ PAGE ZERO REGISTERS
/ AUTO INDEX
*10
X10, 0 /GENERAL AUTO INDEX 10
X11, 0 /GENERAL AUTO INDEX 11
X12, 0 /GENERAL AUTO INDEX 12
X13, 0 /GENERAL AUTO INDEX 13
X14, 0 /GENERAL AUTO INDEX 14
X15, 0 /GENERAL AUTO INDEX 15
X16, 0 /GENERAL AUTO INDEX 16
X17, 0 /GENERAL AUTO INDEX 17
/ REGULAR PAGE ZERO REGISTERS
TEMP, 0
RCHAR, 0 /REMOTE LINE CURRENT INPUT CHAR
TCHAR, 0 /TERMINAL LINE CURRENT INPUT CHAR
SCAN1, 0 /
SCAN2, 0 /
KEYDSP, 0 /DISPATCH ADDRESS FOR KEYWORD MATCH
BININP, 0 /BINARY REGISTER FOR DECIMAL INPUT
PTABLE, 0 /
LPTR, 0 /HOLDS LINE POINTER
CONFLG, 0 /FLAG FOR EXIT CONNECT
STATE, 0 /CURRENT STATE
RETRY, -10 /NUMBER OF RE-TRYS
RTRYC, 0 /USE THIS FOR ACTUAL COUNTER
CCFLAG, 0 /FLAG FOR ^C TYPED
/ CURRENT PACKET I/O DATA
PAKPTR, 0 /POINTER TO OUTPUT PACKET POINTER
PAKCKS, 0 /HOLDS CURRENT OUTPUT PACKET CHECKSUM TOTAL
CURSEQ, 0 /CURRENT SEQ NUMBER
QFLAG, 0 /NON-ZERO WHEN NO CONTROL QUOTING
/ KERMIT MODE FLAG
MLINE= 1 /KERMIT IS ON-LINE
MSEND= 2 /KERMIT IS IN SEND MODE
MREC= 3 /KERMIT IS IN RECEIVE MODE
KMODE, 0 /CURRENT MODE OF KERMIT
/ RECEIVE "INIT" REGISTERS
RMAXL, DEFMAXL+40 /MAX LENGTH FOR DATA PACKET (DEFAULT)
RTIME, 0 /TIME-OUT VALUE
RNPAD, 0 /NUMBER OF PADDING CHARS
RPADC, 0 /CHAR USED FOR PADDING
REOL, DEFEOL /TERMINATOR CHAR USED FOR END OF PACKET
RQCTL, DEFQCTL /CONTROL CHAR PREFIX CHAR
RQBIN, 0 /PARITY CHAR PREFIX CHAR (CHARS GT 177)
RCHKT, DEFCK /CHECKSUM TYPE (DEFAULT TYPE 1)
RREPT, 0 /PREFIX CHAR FOR REPEATED CHARS
RCAPAS, 0 /EXTRA CAPABILITY BIT MASK
USR, 7700 /POINTER TO USER SERVICE ROUTINES
HNDADR, 0 /FILE DEVICE HANDLER ADDRESS
FORCEP, 0 /FLAG FOR FORCED OUTPUT OF PACKET WHEN THERE IS
/ NO DATA (JUST SOH, LEN, SEQ, AND CHECKSUM)
PRSERR, 0 /HOLDS PARSE POSITION FOR REPORTING ERRORS
PACK6P, 0 /POINTER TO STORAGE OF 6 BIT CHARS
PACK6F, 0 /FLAG FOR WHICH BYTE TO STORE
GET6P, 0 /POINTER USED IN THE GET6 ROUTINE
GET6F, 0 /FLAG USED IN THE GET6 ROUTINE
MOVE4, 0 /COUNTER FOR "MOVE"
INIFLG, 0 /INIT DONE FLAG
/ FILE NAME PARSE REGISTERS
FNPTR, 0 /POINTER TO WHERE TO PUT A PARSED FILE NAME
WILDF, 0 /WILD CARD IN FILE NAME FLAG
/ FILE INFORMATION
FSBLK, 0 /FILE START BLOCK
FLEN, 0 /FILE LENGTH
DEVNUM, 0 /PARSED DEVICE NUMBER HERE
OFFLG, 0 /OUTPUT FILE OPEN FLAG
ODNAME, 0 /POINTER TO USER SPECIFIED DEVICE FOR OUTPUT
ODNUMB, 0 /OUTPUT DEVICE NUMBER
DIRBLK, 0 /CURRENT DIRECTORY BLOCK IN CORE
DWORD, 0 /POINTER TO NEXT ENTRY TO TRY
DPTR, 0 /POINTER TO FILE ENTRYS
/ OFTEN USED CONSTANTS
C77, 0077
C177, 0177
C377, 377
C7400, 7400
MCTRLZ, -232
UPTEMP, 0 /TEMP FOR OS/8 UNPACK ROUTINE
/ POINTER FOR THE PACKET INPUT AND OUTPUT ROUTINES
SPACK= JMS I . /SEND A PACKET TO REMOTE
SPACK0 /PUT IN A POINTER
FPACK= JMS I . /FORMAT PACKET
FPACK0 /PUT IN THE POINTER
RPACK= JMS I . /RECEIVE A PACKET FROM REMOTE
ILINK /PUT IN A POINTER
/ POINTERS FOR OUTPUT ROUTINES
TTYOUT= JMS I . /PRINT ONE CHAR ON TTY
OTTY
PRI8B= JMS I . /PRINT 8 BIT STRING ON TTY
PRI8B0 /PUT IN THE POINTER
PRI6B= JMS I . /PRINT 6 BIT STRING ON TTY
PRI6B0 /PUT IN THE POINTER
REMOUT= JMS I . /SEND ONE CHAR DOWN REMOTE LINE
OREM /PUT IN THE POINTER
REM8B= JMS I . /SEND 8 BIT STRING DOWN REMOTE LINE
REM8B0 /PUT IN THE POINTER
REM6B= JMS I . /SEND 6 BIT STRING DOWN REMOTE LINE
REM6B0 /PUT IN THE POINTER
/ MISC.
RTDISP= JMS I . /ROUTINE TO DISPATCH BASED ON "RRTYP"
DISPA0 /POINTER TO ROUTINE
PACK6= JMS I . /DEFINE CALL TO ROUTINE
PACK60 /POINTER TO ROUTINE
SCANC= JMS I . /SCAN FOR CHAR COMMAND
SCANC0 /PUT IN THE POINTER
GET6= JMS I . /DEFINE THE INSTRUCTION
GET60 /PUT IN THE POINTER
MOVE= JMS I . /DEFINE CALL TO MOVE ROUTINE
MOVE0 /POINTER
CLEAR= JMS I . /DEFINE CALL FOR "CLEAR" ROUTINE
CLEAR0 /POINTER
SWAP, 0
DCA AC
RAR
DCA LINK
TAD (-6
DCA RCOUNT
TAD AC
RLOOP, CLL
SPA
STL
RAL
ISZ RCOUNT
JMP RLOOP
DCA AC
CLL
TAD LINK
RAL
TAD AC
JMP I SWAP
AC, 0
LINK, 0
RCOUNT, 0
/BEGINNING OF PROGRAM
*200
START, CLA CLL
TTLS /INIT PRINTER OUTPUT LINE
RTLS /INIT REMOTE OUTPUT LINE
CLOOP, CLA CLL
DCA CCFLAG /CLEAR THE ^C FLAG
DCA KMODE /CLEAR THE MODE FLAG
PRI6B; PROMPT /DISPLAY THE USER PROMPT
JMS LININP /GET INPUT LINE FROM USER
TAD (TMPTBL /GET ADDRESS OF PARSE TABLE
DCA PTABLE /STORE FOR PARSER
TAD (LINBUF /GET ADDRESS OF INPUT LINE BUFFER
CLOOP1, JMS KEYPRS /PARSE OFF A KEYWORD
JMP CLOOP9 /NO MATCH ON KEYWORD
JMP CLOOP /END OF LINE DETECTED
DCA LPTR /STORE POINTER TO NEXT POS ON LINE
JMS I KEYDSP /DISPATCH TO SERVICE
JMP CLOOP7 /ERROR RETURN FROM SERVICE DISPATCH
TAD LPTR /RE-GET COMMAND LINE POINTER
JMP CLOOP1 /CONTINUE LINE PARSE
CLOOP7, SZA /SKIP IF NO RETURNING MESSAGE
PRI6B /AND DISPLAY IT
JMP CLOOP /BACK TO COMMAND LOOP
CLOOP9, CLA CLL
PRI6B; ERRMSG /DISPLAY ERROR MESSAGE
JMP CLOOP /GO AGAIN
/ COMMAND TABLE LOOKUP
/ ROUTINE TO LOOK THRU A TABLE OF SINGLE CHAR COMMANDS FOR A MATCH
/ AND RETURN THE DISPATCH ADDRESS FOR A MATCH IN THE AC. IF NO MATCH
/ IS FOUND IN THE TABLE (THE TABLE ENDS WITH A COMMAND OF ZERO) A
/ RETURN + 2 IS TAKEN, ELSE A RETURN + 3 IS TAKEN.
/ ENTER: AC = COMMAND TO FIND
/ CALL + 2 = ADDRESS OF DISPATCH TABLE
/ EXIT: DISPATCH ADDRESS IN THE AC
/ RETURN + 3
SCANC0, 0
CIA /NEGATE THE COMMAND
DCA SCANC8 /STORE LOCALLY
TAD I SCANC0 /GET ADDRESS OF DISPATCH TABLE
ISZ SCANC0 /BUMP RETURN POINTER
DCA SCANC9 /STORE POINTER LOCALLY
SKP /SKIP INTO LOOP BELOW
SCANC1, ISZ SCANC9 /BUMP THE POINTER
TAD I SCANC9 /GET A COMMAND FROM THE TABLE
SNA /SKIP IF NOT END OF TABLE
JMP I SCANC0 /END OF TABLE, RETURN +2 FOR ERROR
ISZ SCANC9 /BUMP POINTER
TAD SCANC8 /COMPARE WITH COMMAND WE ARE LOOKING FOR
SZA CLA /SKIP IF IS A MATCH
JMP SCANC1 /NO MATCH, TRY AGAIN
TAD I SCANC9 /GET DISPATCH ADDRESS
ISZ SCANC0 /BUMP RETURN FOR MATCH
JMP I SCANC0 /AND RETURN IN AC
SCANC8, 0 /LOCAL STORAGE FOR COMMAND TO LOOK FOR
SCANC9, 0 /LOCAL POINTER FOR COMMAND TABLE
/ ROUTINE TO FORMAT A PACKET OF DATA
/ CALL: FPACK
/ DATA ADDRESS (DATA MUST ALREADY BE CONTROL/QUOTED AND MUST
/ NOT BE LONGER THAN THE LARGEST PACKET)
/ PACKET TYPE
FPACK0, 0
CLA CLL /INSURE CLEAR AC
TAD I FPACK0 /GET THE DATA ADDRESS
DCA FP1 /STORE IN SOURCE POINTER
ISZ FPACK0 /BUMP ARGUMENT POINTER
TAD I FPACK0 /NOW GET TYPE
DCA RSTYP /STORE
ISZ FPACK0 /BUMP ARGUMENT POINTER
TAD (RSDTA /GET ADDRESS OF DATA BUFFER
DCA FP2 /STORE IN DESTINATION POINTER
TAD (40+3 /SET FOR LENGTH COUNTER
DCA RSLEN /STORE IN PACKET
DCA FP3 /INIT CHECKSUM
TAD CURSEQ /GET CURRENT SEQ NUMBER
AND C77 /MOD 64
TAD (40 /CHAR IT
DCA RSSEQ /PUT INTO PACKET
FPACK2, TAD I FP1 /GET A CHAR FROM SOURCE
SPA /SKIP IF NOT END
JMP FPACK3 /END
TAD FP3 /COMBINE WITH CHECKSUM
DCA FP3 /AND RETURN
TAD I FP1 /GET CHAR BACK AGAIN
DCA I FP2 /NOW PUT INTO DESTINATION
ISZ RSLEN /BUMP THE LENGTH
ISZ FP1 /BUMP THE SOURCE POINTER
ISZ FP2 /BUMP THE DESTINATION POINTER
JMP FPACK2 /LOOP
FPACK3, CLA CLL /CLEAR THE AC
TAD FP3 /GET CACULATED CHECKSUM
TAD RSLEN /INCLUDE THE LENGTH
TAD RSSEQ /AND THE SEQUENCE
TAD RSTYP /AND THE TYPE
JMS CKSUM /GET IT CORRECT
DCA I FP2 /STORE WITH PACKET
ISZ FP2 /BUMP PACKET POINTER
TAD REOL /GET ANY END OF LINE TO INCLUDE
TAD (-40 /MAKE IT A REAL CHAR
SNA /SKIP IF EOL CHAR REQUIRED
JMP FPACK4 /NO EOL CHAR
DCA I FP2 /STORE EOL CHAR WITH PACKET
ISZ FP2 /BUMP POINTER
FPACK4, STA /AC = -1
DCA I FP2 /PACKET NOW COMPLETE
TAD RETRY /SET UP RE-TRY COUNTER
DCA RTRYC
ISZ CURSEQ /BUMP SEQUENCE NUMBER FOR NEXT TIME
NOP /PROTECT ISZ
JMP I FPACK0 /RETURN
FP1, 0 /POINTER TO SOURCE DATA
FP2, 0 /POINTER TO PACKET BUFFER
FP3, 0 /RUNNING CHECKSUM
PAGE
/ ROUTINE TO SEND THE FORMATTED PACKET
/ ARGUMENTS: CALL + 1 NON-ZERO = AWAIT RESPONSE
/ ZERO = DO NOT AWAIT RESPONSE
/ CALL + 2 DISPATCH TABLE
SPACK0, 0
REM8B; RSBUF /SEND PACKET JUST COMPLETED
TAD I SPACK0 /DO WE GET A RESPONSE?
ISZ SPACK0 /BUMP POINTER PAST ARGUMENT
SNA CLA /SKIP IF YES
JMP I SPACK0 /ALL DONE HERE
RPACK /GET PACKET BACK FROM REMOTE
TAD I SPACK0 /DID WE WANT A DISPATCH?
ISZ SPACK0 /BUMP PAST ARGUMENT
SNA /SKIP IF YES
JMP I SPACK0 /EXIT IF NO
RTDISP /DISPATCH
JMP I SPACK0 /NOT FOUND, GOTTA RETURN
/ ROUTINE TO CLEAR WORDS OF MEMORY
/ ENTER WITH: AC = MINUS NUMBER OF WORDS TO CLEAR
/ MQ = ADDRESS OF WHERE TO START THE CLEAR
CLEAR0, 0
DCA CLEAR5 /STORE COUNT OF WORDS
MQA /GET ADDRESS OF CLEAR
DCA CLEAR6 /STORE IN POINTER
DCA I CLEAR6 /ZERO A WORD
ISZ CLEAR6 /BUMP POINTER
ISZ CLEAR5 /BUMP COUNTER
JMP .-3 /LOOP
JMP I CLEAR0 /DONE
CLEAR5, 0 /TEMP FOR "CLEAR" ROUTINE
CLEAR6, 0 /TEMP FOR "CLEAR" ROUTINE
/ ROUTINE TO DISPATCH TO ROUTINE BASED ON VALUE OF "RRTYP"
/ ADDRESS OF DISPATCH TABLE CAN BE IN THE AC OR AT CALL + 1. RETURN
/ IF NO MATCH FOUND, DISPATCH IF MATCH FOUND
DISPA0, 0
SZA /SKIP IF DISPATCH TABLE NOT IN AC
JMP DISPA1 /USE VALUE IN AC
TAD I DISPA0 /GET VALUE FROM CALL + 1
ISZ DISPA0 /BUMP RETURN PAST ARGUMENT
DISPA1, DCA DISPA2 /STORE ADDRESS
TAD RRTYP /GET VALUE OF "RRTYP"
SCANC /FIND MATCH IN TABLE
DISPA2, 0 /ADDRESS OF TABLE HERE
JMP I DISPA0 /NOT FOUND IN TABLE, RETURN
DCA DISPA2 /PUT DISPATCH ADDRESS INTO A POINTER
JMP I DISPA2 /AND DISPATCH TO IT
/ ROUTINE TO PUT CHARS INTO A BUFFER TO GET READY TO FORMAT A PACKET.
/ ENTER WITH CHAR IN THE AC
/ IF THE CHAR NEEDS CONTROL QUOTING, IT WILL BE ADDED
/ EXIT + 2 IF EVERYTHING IS OK
/ EXIT + 1 IF BUFFER IS FULL
OPBUF, 0
JMS OPRE /CHECK FOR PREFIX
JMP OPBUF1 /NO PREFIX
DCA OP1 /SAVE CONVERTED CHAR
TAD RQCTL /GET QUOTE CHAR TO USE
DCA I OP2 /PUT RETURNED PREFIX INTO BUFFER
ISZ OP2 /BUMP POINTER
TAD OP1 /GET BACK CONVERTED CHAR
OPBUF1, DCA I OP2 /PUT INTO BUFFER
ISZ OP2 /BUMP POINTER
STA /AC = -1
DCA I OP2 /ALWAYS TERMINATE BUFFER
TAD RMAXL /GET MAX BUFFER LENGTH
TAD (-40+HOLDBF-4 /
CIA
TAD OP2 /COMPARE WITH WHAT WE HAVE
SPA CLA /SKIP IF NO ROOM
JMP OPBUF2 /HAVE ROOM
JMS INIOPB /RESET BUFFER
JMP I OPBUF /TAKE RETURN + 1
OPBUF2, ISZ OPBUF /BUMP RETURN FOR BUFFER NOT FULL
JMP I OPBUF /DONE
OP1, 0 /TEMP LOCATION
OP2, HOLDBF /POINTER FOR HOLD BUFFER
/ ROUTINE TO RE-SET THE HOLD BUFFER
INIOPB, 0
TAD (HOLDBF /RE-SET BUFFER POINTER
DCA OP2
JMP I INIOPB
/ ROUTINE TO CACULATE A 1 BYTE CHECKSUM
CKSUM, 0
DCA CKSUM1 /STORE TEMP
TAD CKSUM1 /GET BACK
JMS SWAP /GET BITS 6-7 INTO BITS 0-1
AND (3 /KEEP ONLY BITS 0-1
TAD CKSUM1 /GET ORIGINAL
AND C77 /KEEP ONLY BITS 0-5
TAD (40 /MAKE A CHAR(CHECKSUM)
JMP I CKSUM /DONE, RETURN IN AC
CKSUM1, 0 /TEMP FOR "CKSUM"
/ ROUTINE TO CHECK FOR A CONTROL C
/ SET FLAG "CCFLAG" IF ^C IS TYPED
CCCK, 0
CLA CLL /INSURE CLEAR AC
TAD KMODE /GET KERMITS MODE
TAD (-MLINE /CHECK FOR ON-LINE
SNA CLA /SKIP IF NOT ON-LINE
JMP CCCK2 /NO CTRL/C CHECK IF ON-LINE
JMS ITTY /CHECK FOR INPUT FROM CONSOLE
SKP /GOT SOMETHING FROM CONSOLE
JMP CCCK2 /NO INPUT FROM CONSOLE
AND C177 /CLEAR TOP BITS
TAD (-3 /CHECK FOR CTRL/C
SZA CLA /SKIP IF CTRL/C
JMP CCCK2 /^C NOT TYPED
IAC
DCA CCFLAG /SET ^C FLAG
CCCK2, JMP I CCCK /RETURN
PAGE
/ ROUTINE TO INPUT CHARS FROM REMOTE UNTIL A "SOH" CHAR IS FOUND
GETSOH, 0
JMS IREMW /GET A CHAR FROM REMOTE
JMP I GETSOH /TIME-OUT
TAD (-SOH /COMPARE WITH "SOH"
SZA CLA /SKIP IF SAME
JMP GETSOH+1 /LOOP TILL WE GET ONE
ISZ GETSOH /BUMP FOR GOOD RETURN
JMP I GETSOH /GOT ONE, DONE
/ ROUTINE TO GET A CHAR FROM THE REMOTE LINE AND UPDATE CHECKSUM
GETIR, 0
JMS IREMW /GET A CHAR FROM REMOTE
JMP I GETIR /TIME-OUT RETURN
DCA GETIR1 /STORE TEMP
TAD GETIR1 /GET CHAR BACK
TAD ILINK9 /ADD CHECKSUM
DCA ILINK9 /RETURN UPDATED CHECKSUM
TAD GETIR1 /RE-GET CURRENT INPUT CHAR
TAD (-15 /CHECK FOR A RETURN
SNA CLA /SKIP IF NOT A RETURN
JMP I GETIR /WAS A RETURN, TAKE EXIT + 1
TAD GETIR1 /RE-GET CHAR FOR RETURN
ISZ GETIR /BUMP FOR GOOD RETURN
JMP I GETIR /AND RETURN IN THE AC
GETIR1, 0 /TEMP LOCAL TO "GETIR"
/ LOW LEVEL PROGRAMMED I/O THRU TERMINAL LINES
/ ROUTINE TO GET INPUT FROM THE REMOTE INPUT LINE
/ RETURN + 1 IF INPUT FOUND
/ RETURN + 2 IF NO INPUT FOUND
IREM, 0
CLA CLL /INSURE CLEAR AC
RKSF /CHECK FOR INPUT
JMP IREM1 /NO INPUT, RETURN + 2
RKRB /READ ANY INPUT
DCA RCHAR /STORE REMOTE CHAR
TAD RCHAR /RE-GET THE CHAR
JMP I IREM /DONE
IREM1, ISZ IREM /NO INPUT, BUMP RETURN
JMP I IREM
/ ROUTINE TO WAIT FOR A CHAR FROM THE REMOTE LINE
/ RETURN + 2 WITH CHAR INPUT IN THE AC
/ RETURN + 1 IF TIME-OUT WAITING FOR CHAR
IREMW, 0
CLA CLL /INSURE CLEAR AC
DCA IREMW9 /RE-SET TIMER COUNTER
TAD (-1000 /SET HIGH ORDER
DCA IREMW8
IREMW1, JMS IREM /CALL INPUT REMOTE ROUTINE
JMP IREMW2 /RETURN HERE IF CHAR WAS INPUT
JMS CCCK /CHECK FOR A CONTROL/C
ISZ IREMW9 /BUMP TIMER-COUNTER
JMP IREMW1 /NO TIME-OUT YET
ISZ IREMW8 /BUMP HIGH ORDER
JMP IREMW1 /NO TIME-OUT YET
JMP I IREMW /TIME-OUT
IREMW2, ISZ IREMW /BUMP RETURN FOR NO TIME-OUT
JMP I IREMW /AND EXIT
IREMW8, 0
IREMW9, 0
/ ROUTINE TO GET INPUT FROM THE CONSOLE TERMINAL
/ RETURN + 1 IF INPUT FOUND WITH THE INPUT BYTE IN THE AC
/ RETURN + 2 IF NO INPUT FOUND WITH GARBAGE IN THE AC
ITTY, 0
TKSF /CHECK FOR INPUT
JMP ITTY1 /NO INPUT, RETURN BELOW
TKRB /READ THE INPUT
AND C177 /FORCE THE PARITY BIT ON
TAD (200
DCA TCHAR /STORE AS CURRENT TERMINAL CHAR
TAD TCHAR /RE-GET
JMP I ITTY /RETURN
ITTY1, ISZ ITTY /BUMP RETURN FOR NO INPUT
JMP I ITTY /AND RETURN
/ INPUT FROM CONSOLE TTY WITH WAIT
ITTYW, 0
JMS ITTY /GO FETCH A CHAR FROM CONSOLE
JMP I ITTYW /RETURN HERE IF CHAR INPUT
JMP ITTYW+1 /ELSE WAIT FOR INPUT
/ ROUTINE TO INPUT AND ECHO CHARS FROM THE KEYBOARD
INECO, 0
JMS ITTYW /GET A CHAR FROM THE KEYBOARD
TTYOUT /DISPLAY THE CHAR ON THE SCREEN
JMP I INECO /DONE
/ REMOTE OUTPUT ROUTINE - OUTPUT THE BYTE IN THE AC
OREM, 0
RTSF /CHECK OUTPUT FLAG
JMP .-1 /WAIT UNTIL READY
RTLS /SEND THE CHAR
CLA CLL /RETURN CLEAR AC AND LINK
JMP I OREM /DONE
/ CONSOLE OUTPUT ROUTINE - OUTPUT THE BYTE IN THE AC
OTTY, 0
TTSF /CHECK OUTPUT FLAG
JMP .-1 /WAIT TILL READY
TTLS /SEND THE CHAR
JMP I OTTY /DONE
PAGE
/ HOLD BUFFER FOR CHAR OUTPUT
DECIMAL
HOLDBF, ZBLOCK 92
OCTAL
/ ROUTINE TO CHECK FOR CONTROL PREFIX
/ ENTER WITH CHAR TO CHECK IN THE AC
/ EXIT + 1 WITH CHAR IN THE AC IF NO PREFIX QUOTING
/ EXIT + 2 WITH PROPER CHAR IN THE AC AND QUOTING IS REQUIRED
OPRE, 0
MQL /SAVE CHAR
TAD QFLAG /CHECK FOR IN CTRL QUOTE MODE
SZA CLA /SKIP IF YES
JMP OPRE1 /NO QUOTE PREFIX
MQA /GET CHAR
AND (7740 /QUICK CHECK FOR LT 40
SNA CLA /SKIP IF NOT CONTROL
JMP OPRE2 /PREFIX QUOTE
MQA /GET CHAR
TAD (-177 /CHECK FOR "DELETE"
SNA CLA /SKIP IF NOT
JMP OPRE2 /PREFIX QUOTE
MQA /GET CHAR
CIA /NEGATE FOR COMPARE
TAD RQCTL /SEE IF SAME AS QUOTE CHAR
SZA CLA /SKIP IF PREFIX QUOTE
JMP OPRE1 /NO PREFIX QUOTE
TAD RQCTL /PREFIX WITH PREFIX
JMP OPRE3 /PREFIX WITH THE PREFIX
OPRE1, MQA /GET CHAR
JMP I OPRE /DONE
OPRE2, MQA /GET CHAR
TAD (100 /MAKE IT PRINTABLE
AND C177 /IN CASE WAS 177
OPRE3, ISZ OPRE /BUMP FOR PREFIX RETURN
JMP I OPRE /DONE
PAGE
/ ROUTINE TO SCAN A TEXT LINE FOR KEYWORD DELIMITERS. ROUTINE EXPECTS
/ THE AC TO POINT TO A TEXT LINE TO SCAN AND FINDS THE FIRST NON-SPACE,
/ NON-END OF LINE CHAR IN THE LINE AND SETS "SCAN1" TO POINT TO IT.
/ NEXT WE FIND THE LAST CHAR IN THE LINE THAT IS A NON-SPACE, NON-END
/ OF LINE AND STORE A POINTER TO IT IN "SCAN2". KEYWORDS ARE DELIMITED
/ BY A BEGINNING OF LINE OR SPACE AT THE BEGINNING AND AN END OF LINE
/ OR A SPACE AT THE END
/ ENTER: AC = POINTER TO COMMAND LINE
/ EXIT: (SUCCESS) SCAN1 = POINTER TO FIRST CHAR OF KEYWORD
/ SCAN2 = POINTER TO LAST CHAR OF KEYWORD
/ RETURN = RETURN + 2 (NO WORDS LEFT IN LINE)
/ EXIT: (FAIL) RETURN = RETURN + 1
SCNEL, 0
JMS NOSP /FIND FIRST NON-SPACE
JMP I SCNEL /END OF LINE RETURN
DCA SCAN1 /RETURN SCAN LINE POINTER
TAD SCAN1 /RE-GET SCAN LINE POINTER
JMS SP /FIND FIRST SPACE OR EOL
NOP /RETURN HERE ON EOL
TAD (-1 /BACK UP TO PREVIOUS CHAR
DCA SCAN2 /SET END ELEMENT POINTER
ISZ SCNEL /TAKE SUCCESS RETURN
JMP I SCNEL /DONE
/ ROUTINE TO SCAN THRU A TEXT LINE LOOKING FOR THE NEXT SPACE
/ ENTER ROUTINE WITH THE LINE POINTER IN THE AC
/ EXIT: RETURN + 2 WITH AC = POINTER TO SPACE
/ RETURN + 1 WITH AC = POINTER TO END OF LINE
SP, 0
DCA SCANTP /USE A TEMP POINTER
SKP /SKIP INTO LOOP BELOW
SP1, ISZ SCANTP /BUMP LINE POINTER
TAD I SCANTP /GET A CHAR
SPA /SKIP IF NOT END OF LINE
JMP SP3 /GOT AN END OF LINE
TAD (-SPACE /COMPARE WITH A SPACE
SZA CLA /SKIP IF IS A SPACE
JMP SP1 /LOOP TILL SPACE OR EOL
ISZ SP /BUMP RETURN FOR SPACE FOUND
SP3, CLA CLL /INSURE A CLEAR AC
TAD SCANTP /GET POINTER VALUE
JMP I SP /RETURN IN AC
/ ROUTINE TO SCAN THRU A TEXT LINE FOR THE FIRST NON-SPACE
/ ENTER ROUTINE WITH POINTER TO THE LINE IN THE AC
/ EXIT: RETURN + 2 WITH AC = POINTER TO NON-SPACE
/ RETURN + 1 WITH AC = POINTER TO END OF LINE
NOSP, 0
DCA SCANTP /USE A TEMP POINTER
SKP /SKIP INTO LOOP BELOW
NOSP1, ISZ SCANTP /BUMP THE LINE POINTER
TAD I SCANTP /GET A CHAR FROM THE LINE
SPA /SKIP IF NOT EOL
JMP NOSP3 /EXIT IF EOL
TAD (-SPACE /COMPARE WITH A SPACE
SNA CLA /SKIP IF NOT SPACE
JMP NOSP1 /LOOP TILL SPACE OR EOL
ISZ NOSP /BUMP RETURN FOR SPACE FOUND
NOSP3, CLA CLL /INSURE CLEAR AC
TAD SCANTP /GET POINTER
JMP I NOSP /RETURN IN AC
/ ROUTINE TO FIND AN END CHAR IN A STRING
/ ENTER ROUTINE WITH POINTER TO THE STRING IN THE AC
/ EXIT WITH THE POINTER TO THE FIRST MINUS CHAR IN THE AC
FNDEND, 0
DCA SCANTP /PUT POINTER IN SCANTP
FEND1, TAD I SCANTP /GET A CHAR FROM THE STRING
SPA CLA /SKIP IF NOT END
JMP FEND2 /EXIT IF END OF STRING
ISZ SCANTP /BUMP THE POINTER
JMP FEND1 /LOOP TILL NON-END OF STRING
FEND2, TAD SCANTP /GET POINTER TO NON-END OF STRING
JMP I FNDEND /EXIT WITH POINTER IN AC
SCANTP, 0 /USED IN THE SCAN ROUTINES "SP", "NOSP", "FNDNUL"
/ ROUTINE TO LOOKUP THE KEY WORD POINTED TO BY THE AC IN THE TABLE POINTED
/ TO BY PTABLE.
/ RETURN + 1 IF NO MATCH IS FOUND WITH AC = ENTRY VALUE
/ RETURN + 2 IF NO KEYWORD IS FOUND (EOL DETECTED)
/ RETURN + 3 IF MATCH IS FOUND WITH THE NEXT PARSE POSITION IN THE LINE
/ IN THE AC AND THE DISPATCH ADDRESS FROM THE TABLE IN "KEYDSP"
KEYPRS, 0
DCA LOOK3 /SAVE IN CASE OF FAIL
TAD LOOK3 /RE-GET
JMS SCNEL /TRY TO SCAN OFF A KEYWORD
JMP KP45 /END OF LINE ENCOUNTERED
TAD PTABLE /GET ADDRESS OF TABLE
DCA LOOK2 /STORE IN LOCAL POINTER
KP10, TAD SCAN1 /GET ADDRESS OF SCAN ELEMENT
DCA LOOK1 /INTO LOCAL POINTER
KP20, TAD I LOOK1 /GET A CHAR FROM THE SCAN ELEMENT
CIA /NEGATE FOR COMPARE
TAD I LOOK2 /GET A CHAR FROM THE TABLE ELEMENT
SZA CLA /SKIP IF MATCH
JMP KP90 /NO MATCH, SET TO LOOK AT NEXT TABLE ENTRY
TAD LOOK1 /CHECK IF ALL ENTERED CHARS MATCH
CIA /NEGATE TO COMPARE
TAD SCAN2 /HAVE WE MATCHED TO THE TERMINATOR?
SNA CLA /SKIP IF NO
JMP KP40 /YES, GOT ENOUGH TO MATCH
ISZ LOOK1 /MORE TO MATCH, BUMP SCAN ELEMENT POINTER
ISZ LOOK2 /BUMP TABLE ELEMENT POINTER
JMP KP20 /CONTINUE MATCH LOOP
KP40, TAD LOOK2 /GET CURRENT TABLE POINTER
JMS FNDEND /FIND A NULL MARK
IAC /BUMP BY 1
DCA LOOK1 /STORE IN A POINTER
TAD I LOOK1 /GET DISPATCH ADDRESS
DCA KEYDSP /PUT INTO DISPATCH ADDRESS
ISZ KEYPRS /BUMP RETURN
ISZ KEYPRS /BUMP AGAIN
CLA CLL IAC /AC = 1
TAD SCAN2 /GET POINTER TO END OF CURRENT KEY
JMP I KEYPRS /RETURN
/ END OF LINE ENCOUNTERED ON PARSE
KP45, ISZ KEYPRS /BUMP RETURN ONCE FOR EOL
/ NO MATCHES IN THE TABLE HERE
KP50, TAD LOOK3 /GET ORIGINAL AC
JMP I KEYPRS /RETURN
/ FAILURE ON CURRENT TABLE ENTRY, SET FOR NEXT ENTRY (IF THERE IS ONE) AND
/ TRY AGAIN
KP90, TAD LOOK2 /GET TABLE POINTER
JMS FNDEND /FIND NEXT TABLE ENTRY
IAC /NEXT ENTRY IS 2 PAST THE NULL
IAC
DCA LOOK2 /RE-SET LOCAL TABLE POINTER
TAD I LOOK2 /CHECK END OF TABLE
SNA CLA /SKIP IF NOT END OF THE TABLE
JMP KP50 /TAKE NOT FOUND EXIT
JMP KP10 /TRY MATCH ON THIS ENTRY
LOOK1, 0
LOOK2, 0
LOOK3, 0
/ ROUTINE TO MOVE WORDS OF MEMORY
/ ENTER WITH: "MOVE1" = MINUS THE NUMBER OF WORDS TO MOVE
/ AC = SOURCE ADDRESS
/ MQ = DESTINATION ADDRESS
MOVE0, 0
DCA MOVE5 /STORE SOURCE ADDRESS IN LOCAL POINTER
MQA /GET DESTINATION ADDRESS
DCA MOVE6 /STORE IN LOCAL POINTER
MOVE1, TAD I MOVE5 /GET A WORD FROM THE SOURCE
DCA I MOVE6 /MOVE TO DESTINATION
ISZ MOVE5 /BUMP SOURCE POINTER
ISZ MOVE6 /BUMP DESTINATION COUNTER
ISZ MOVE4 /BUMP COUNTER
JMP MOVE1 /LOOP
JMP I MOVE0 /DONE
MOVE5, 0 /SOURCE POINTER FOR "MOVE"
MOVE6, 0 /DESTINATION POINTER FOR "MOVE"
PAGE
/ ROUTINE TO PARSE OFF A DEVICE NAME FROM THE COMMAND LINE.
/ ENTER WITH: POINTER TO COMMAND LINE IN THE AC
/ NON-ERROR EXIT: RETURN + 2
/ POINTER TO REMAINDER OF LINE IN THE AC
/ DEVNUM = DEVICE NUMBER TO USE
/ ERROR EXIT: RETURN + 1
/ ORIGINAL AC
DPARS, 0
DCA DPAR10 /SAVE INITIAL POINTER TO LINE
TAD DPAR10 /GET POINTER
JMS NOSP /GET PAST ANY LEADING SPACES
JMP DFDEV /GOT END OF LINE, USE DEFAULT DEVICE
DCA DPAR11 /SAVE POINTER TO LINE
DCA DEVNAM /INIT DEVICE NAME FOR "INQUIRE"
DCA DEVNAM+1
DCA DEVNUM /INIT DEVICE NUMBER
TAD (DEVNAM /GET ADDRESS OF WHERE TO PUT DEV NAME
DCA PACK6P /STORE IN PACK6 POINTER
DCA PACK6F /INIT PACK6 FLAG FOR LOW BYTE
TAD (-4 /SET UP A COUNTER
DCA DPAR13 /FOR NO MORE THAN 4 CHARS
DPAR1, TAD I DPAR11 /GET A CHAR FROM THE LINE
SNA /SKIP IF NOT EOL
JMP DFDEV /GOT AN EOL, USE DEFAULT DEVICE
TAD (-": /CHECK FOR END OF DEVICE NAME
SNA CLA /SKIP IF NOT END OF DEVICE NAME
JMP DPAR2 /DEVICE NAME SET UP
TAD I DPAR11 /RE-GET CHAR
ISZ DPAR11 /BUMP LINE POINTER
PACK6 /PACK 6 BIT
ISZ DPAR13 /BUMP CHAR COUNTER
JMP DPAR1 /CAN CONTINUE
SKP /DO NOT BUMP POINTER AGAIN
ISZ DPAR11 /BUMP TO NEXT CHAR
TAD I DPAR11 /GET CHAR AFTER THE 4TH
TAD (-": /THIS MUST BE A ":"
SZA CLA /SKIP IF YES, ALL IS OK
JMP DFDEV /USE THE DEFAULT DEVICE
DPAR2, ISZ DPAR11 /BUMP POINTER PAST ":"
TAD (DEVNAM /GET PARSED DEVICE NAME ADDRESS
JMP DPAR4 /DO AN OS/8 "INQUIRE"
DFDEV, TAD DPAR10 /GET ORIGINAL AC FOR
DCA DPAR11 /RETURN POINTER
DPAR4, JMS DVNUM /GET DEVICE NUMBER
JMP DPAR8 /DEVICE NAME ERROR
DCA DEVNUM /RETURN FOR CALLING PROGRAM
TAD DPAR11 /GET CURRENT POINTER
ISZ DPARS /BUMP RETURN
JMP I DPARS
DPAR8, CLA CLL /INSURE CLEAR AC
TAD DPAR10 /GET ORIGINAL AC
JMP I DPARS /TAKE ERROR EXIT
DPAR10, 0 /TEMP FOR DPARS
DPAR11, 0 /TEMP FOR DPARS
DPAR13, 0 /TEMP FOR DPARS
DEFDEV, DEVICE DSK /DEFAULT DEVICE
DEVNAM, FILENAME ZZZZZZ.ZZ
/ ROUTINE TO RETURN A DEVICE NUMBER FOR A DEVICE NAME
/ ENTER AC = ADDRESS OF DEVICE NAME
/ OR
/ ENTER AC = 0 IF DEFAULT "DSK" IS TO BE USED
/ EXIT + 2 WITH DEVICE NUMBER IN AC IF ALL OK
/ EXIT + 1 IF INVALID DEVICE
DVNUM, 0
SNA /SKIP IF DEVICE NAME SPECIFIED
TAD (DEFDEV /ELSE USE DEFAULT
DCA DVNUM9 /SAVE IN LOCAL POINTER
TAD I DVNUM9 /GET FIRST 2 CHARS OF NAME
DCA DVNUM5 /PUT INTO CALL
ISZ DVNUM9 /BUMP POINTER
TAD I DVNUM9 /GET LAST 2 CHARS OF NAME
DCA DVNUM5+1 /PUT INTO CALL
CIF 10 /CALL USER SERVICE FOR "INQUIRE"
JMS I USR
12 /FUNCTION CODE 12
DVNUM5, 0 /FIRST 2 BYTES OF DEVICE NAME
0 /LAST 2 BYTES OF DEVICE NAME
0 /ENTRY POINT OF HANDLER RETURNED HERE
JMP I DVNUM /ERROR, TAKE ERROR EXIT
TAD DVNUM5+1 /DEVICE NUMBER
ISZ DVNUM /BUMP RETURN FOR NO ERROR
JMP I DVNUM /RETURN
DVNUM9, 0 /LOCAL FOR "DVNUM"
/ ROUTINE TO CONVERT A STRING OF BYTES INTO PDP8 CHARS WHICH HAVE
/ THE TOP BIT (BIT 7) SET.
/ ENTER: AC = ADDRESS OF STRING
/ OR
/ CALL + 1 = ADDRESS OF STRING
/ EXIT: STRING HAS TOP BYTE SET
/ STRING IS TERMINATED ON A MINUS WORD
XLATE8, 0
SZA /SKIP IF ADDRESS AT CALL + 1
JMP XLAT81 /ADDRESS IN AC
TAD I XLATE8 /GET ADDRESS FROM CALL + 1
ISZ XLATE8 /BUMP RETURN PAST ADDRESS
XLAT81, DCA XLAT89 /STORE IN LOCAL POINTER
XLAT82, TAD I XLAT89 /GET A BYTE FROM STRING
SPA /SKIP IF NOT TERMINATOR
JMP XLAT83 /CLEAR AC AND EXIT
AND C177 /STRIP OFF ANY BIT 7
TAD (200 /NOW INSURE IT IS SET
DCA I XLAT89 /RETURN IT
ISZ XLAT89 /BUMP THE POINTER
JMP XLAT82 /LOOP
XLAT83, CLA CLL /INSURE CLEAR AC
JMP I XLATE8 /DONE WITH THIS STRING
XLAT89, 0 /LOCAL POINTER FOR "XLATE8"
/ ROUTINE TO GO THRU A STRING OF BYTES AND INSURE THE TOP BIT
/ (BIT 7) IS CLEAR.
/ ENTER WITH ADDRESS OF STRING IN AC OR AT CALL + 1
/ THE STRING TERMINATES ON A MINUS WORD
XLATE7, 0
SZA /SKIP IF ADDRESS NOT IN AC
JMP XLAT71 /ADDRESS IN AC
TAD I XLATE7 /GET ADDRESS FROM CALL + 1
ISZ XLATE7 /BUMP RETURN
XLAT71, DCA XLAT79 /STORE ADDRESS IN POINTER
XLAT72, TAD I XLAT79 /GET A CHAR FROM STRING
SPA /SKIP IF NOT END OF STRING
JMP XLAT73 /END OF STRING, TERMINATE
AND C177 /KEEP ONLY LOW 7 BITS
DCA I XLAT79 /RETURN
ISZ XLAT79 /BUMP POINTER
JMP XLAT72 /LOOP
XLAT73, CLA CLL /INSURE CLEAR AC
JMP I XLATE7 /RETURN
XLAT79, 0 /POINTER FOR "XLATE7"
PAGE
/ ROUTINE TO PARSE OFF A FILE NAME
/ FILE NAME TO BE PARSED MUST BE LETTERS OR DIGITS AND BE NO MORE THAN
/ SIX CHARS FOR THE NAME AND TWO CHARS FOR THE EXTENSION.
/ ENTER WITH: AC = POINTER TO FILE NAME TO PARSE
/ FNPTR = POINTER TO WHERE TO PUT THE PARSED FILE NAME
/ NON-ERROR EXIT: AC = POINTER TO REMAINDER OF COMMAND LINE
/ RETURN THE CALL + 2
/ ERROR EXIT: AC = ORIGINAL POINTER
/ RETURN THE CALL + 1
PFNAM, 0
DCA PFN10 /SAVE POINTER TO FILE NAME STRING
TAD PFN10 /GET POINTER TO NAME
JMS XLATE8 /INSURE PARITY BIT SET
TAD FNPTR /GET POINTER TO FILE NAME BLOCK
MQL /SET FOR "CLEAR" ROUTINE
TAD (-4 /FOUR WORDS TO CLEAR OUT
CLEAR /INIT THE FILE NAME BLOCK
TAD PFN10 /GET THE STRING POINTER
JMS NOSP /GET PAST ANY LEADING SPACES
JMP PFNAM9 /GOT EOL, NO FILE NAME
DCA PFN11 /SAVE POINTER
TAD FNPTR /GET FILE NAME BLOCK POINTER
DCA PACK6P /SET UP THE "PACK6" POINTER
DCA PACK6F /INIT THE "PACK6" FLAG
TAD (-6 /MAX OF 6 CHARS FOR FILE NAME
DCA PFN15 /PUT INTO COUNTER
DCA WILDF /INIT THE WILD CARD FLAG
JMS NAM /MOVE AND PACK FILE NAME
TAD I PFN11 /GET THE TERM CHAR
SPA /SKIP IF NOT EOL
JMP PFNAM7 /EOL MEANS END OF FILE NAME
TAD (-". /WAS IT A "."?
SNA /SKIP IF NO
JMP PFNAM3 /GO HANDLE EXTENSION
TAD (".-" /CHECK FOR A SPACE
SZA CLA /SKIP IF WAS A SPACE
JMP PFNAM9 /NOT A SPACE, GOT AN ERROR
JMP PFNAM7 /IS A SPACE, END OF FILE NAME
PFNAM3, ISZ PFN11 /BUMP PAST THE "."
CLA CLL CML IAC RAL /AC = 3
TAD FNPTR /GET FILE NAME BLOCK POINTER
DCA PACK6P /SET "PACK6" POINTER
DCA PACK6F /INIT "PACK6" FLAG
CLA CLL CMA RAL /AC = -2
DCA PFN15 /COUNTER FOR 2 EXT CHARS
JMS NAM /NOW DO THE EXTENSION
TAD I PFN11 /GET THE TERM CHAR
SPA /SKIP IF NOT EOL
JMP PFNAM7 /GOT COMPLETE FILE NAME HERE
TAD (-" /CAN BE A SPACE
SZA CLA /SKIP IF IT WAS
JMP PFNAM9 /GOT A FILE NAME ERROR
PFNAM7, ISZ PFNAM /BUMP RETURN FOR GOOD FILE NAME
CLA CLL /INSURE CLEAR AC
TAD PFN11 /GET CURRENT STRING POINTER
JMP I PFNAM /AND RETURN
PFNAM9, CLA CLL /INSURE CLEAR AC
TAD PFN10 /GET ORIGINAL STRING POINTER
JMP I PFNAM /TAKE ERROR RETURN
PFN10, 0 /TEMP FOR PFNAM ROUTINE
PFN11, 0 /TEMP FOR PFNAM ROUTINE
PFN15, 0 /TEMP FOR PFNAM ROUTINE
/ LOCAL ROUTINE TO "PFNAM" TO MOVE IN THE FILE NAME OR FILE EXTENSION
/ ENTER WITH "PFN11" POINTING TO WHERE TO GET THE NAME OR EXTENSION
/ AND "PFN15" EQUAL TO THE MAX NUMBER OF CHARS (6 FOR NAME, 2 FOR EXT)
/ THIS ROUTINE CHECKS FOR WILD CARD CHARS "*" AND "?" AND PUTS THE
/ "?" CHAR IN FOR ANY CHARS IN THE NAME THAT ARE WILD. ALSO IF ANY
/ WILD CARD CHARS ARE FOUND THE FLAG "WILDC" IS SET SO BEFORE PARSING
/ ANY FILE NAME THE "WILDC" FLAG SHOULD BE INITIALIZED.
NAM, 0
NAM0, TAD I PFN11 /GET A CHAR FROM THE STRING
JMS ALPNUM /MUST BE ALPHA OR NUMBER
SKP /NOT A ALPHA NUMERIC
JMP NAM3 /IS ALPHA NUMERIC
TAD (-"? /IS IT A SINGLE WILD CARD CHAR
SNA /SKIP IF NO
JMP NAM2 /YES, JUST PUT IT IN
TAD ("?-"* /IS IT A MULTIPLE WILD CARD CHAR?
SZA CLA /SKIP IF YES
JMP I NAM /TAKE THE FILE NAME ERROR EXIT
ISZ WILDF /SET FLAG FOR WILD CARD FOUND
NAM1, TAD ("? /FILL REMAINING WITH WILD CARD CHAR
PACK6 /PUT IN NAME BLOCK
ISZ PFN15 /BUMP CHAR COUNTER
JMP NAM1 /LOOP TILL ALL FILLED
ISZ PFN11 /BUMP THE STRING POINTER
JMP NAM9 /EXIT WITH "PFN11" POINTING TO NEXT CHAR
NAM2, ISZ WILDF /SET FLAG FOR WILD CARD FOUND
TAD ("? /GET THE WILD CHAR
NAM3, PACK6 /PUT THE CHAR INTO THE FILE NAME BLOCK
ISZ PFN11 /BUMP THE STRING POINTER
ISZ PFN15 /BUMP THE CHAR COUNTER
JMP NAM0 /LOOP
NAM4, TAD I PFN11 /NOW GET TO A TERMINATOR CHAR
JMS ALPNUM /BY FINDING FIRST NON-ALPHNUMERIC
JMP NAM9 /NOW WE CAN QUIT
CLA CLL /IGNORE EXCESS CHARS
ISZ PFN11 /BUMP THE STRING POINTER
JMP NAM4 /LOOP
NAM9, CLA CLL /LEAVE WITH A CLEAR AC
JMP I NAM /RETURN
/ ROUTINE TO SEND A PACKET
/ ENTER WITH ADDRESS OF PACKET DATA IN CALL + 1
/ AND TYPE OF PACKET IN CALL + 2
/ EXIT CALL + 4 IF ACK RETURNED
/ EXIT CALL + 3 IF NAK OR OTHER PACKET TYPE RETURNED
SNDP, 0
TAD I SNDP /GET DATA ADDRESS
DCA SNDP1 /STORE IN CALL
ISZ SNDP /BUMP POINTER
TAD I SNDP /GET PACKET TYPE
DCA SNDP2 /STORE IN CALL
ISZ SNDP /BUMP
FPACK /FORMAT A PACKET
SNDP1, 0 /DATA ADDRESS GOES HERE
SNDP2, 0 /PACKET TYPE GOES HERE
SNDP3, SPACK /SEND A DATA PACKET
1 /GET RESPONSE
SNDP9 /RESPONSE DISPATCH TABLE ADDRESS
/ HERE ON NOT "NAK" OR "ACK" RESPONSE
SKP
/ HERE ON "ACK"
SNDP5, ISZ SNDP /BUMP RETURN
ISZ SNDP /BUMP RETURN
JMP I SNDP /EXIT
/ HERE ON NAK
SNDP4, ISZ RTRYC /BUMP THE RE-TRY COUNTER
JMP SNDP3 /RE-TRY
JMP I SNDP /TAKE RETURN + 3
SNDP9, STACK; SNDP5 /ACK
STACK; SNDP4 /NAK
0
PAGE
/ ROUTINE TO PARSE OFF A DECIMAL NUMBER
/ ENTER ROUTINE WITH A POINTER TO THE PARSE LINE IN THE AC
/ EXIT: RETURN + 1 FOR NO NUMBER
/ RETURN + 2 FOR INVALID NUMBER
/ RETURN + 3 FOR VALID NUMBER
/ IN ALL CASES ON RETURN THE AC WILL CONTAIN A POINTER TO THE NEXT
/ CHAR TO PARSE IN THE LINE. ANY NUMBER PARSED WILL BE CONVERTED
/ TO BINARY AND PUT INTO THE REGISTER "BININP".
DECPRS, 0
JMS NOSP /GET PAST ANY LEADING SPACES
JMP I DECPRS /GOT AN END OF LINE, AC POINTS TO IT
DCA DP10 /SAVE POINTER TO LINE
TAD DP10 /RE-GET POINTER TO LINE
DCA DP11 /STORE IN OUR LINE POINTER
DCA BININP /INIT BINARY REGISTER
DCA DP13 /INIT PARSED NUMBER FLAG
SKP /SKIP INTO LOOP BELOW
DP1, ISZ DP11 /BUMP THE LINE POINTER
TAD I DP11 /GET A CHAR FROM THE LINE
JMS DECCK /CHECK FOR PROPER ASCII DECIMAL
JMP DP5 /NOT PROPER ASCII DECIMAL
ISZ DP13 /FLAG NUMBER INPUT
TAD (-"0 /MAKE BINARY
DCA DP12 /AND STORE
TAD BININP /GET PREVIOUS INPUT
JMS MUL10 /AND MULTIPLY TIMES 10
SZL /SKIP IF NO OVERFLOW ENCOUNTERED
JMP DP6 /GOT AN OVERFLOW ERROR
TAD DP12 /COMBINE WITH CURRENT INPUT
SZL /SKIP IF NO OVERFLOW ERROR
JMP DP6 /GOT AN OVERFLOW ERROR
DCA BININP /RETURN ACCUMULATED SUM
JMP DP1 /LOOP
DP5, CLA CLL /AC MAY NOT BE CLEAR
TAD DP13 /ANY NUMBERS INPUT YET?
SNA CLA /SKIP IF YES
JMP DP6 /TAKE THE NO NUMBER INPUT RETURN
ISZ DECPRS /BUMP THE RETURN
ISZ DECPRS /TWICE FOR GOOD NUMBER INPUT RETURN
TAD DP11 /GET POINTER TO LINE
JMP I DECPRS /AND RETURN
DP6, CLA CLL /AC MAY NOT BE CLEAR
TAD DP10 /GET ORIGINAL LINE POINTER
ISZ DECPRS /BUMP THE RETURN
JMP I DECPRS /TAKE THE INVALID NUMBER RETURN
DP10, 0 /TEMP FOR DECPRS
DP11, 0 /TEMP FOR DECPRS
DP12, 0 /TEMP FOR DECPRS
DP13, 0 /TEMP FOR DECPRS
/ ROUTINE TO MULTIPLY THE VALUE OF THE AC TIMES 10
/ VALUE IN THE AC IS ASSUMED BINARY
/ THE NUMBER IS RETURNED IN THE AC. IF THE LINK IS SET THE MULTIPLY
/ OVERFLOWED 12 BITS.
MUL10, 0
DCA MULTMP /SAVE THE NUMBER
TAD MULTMP /GET THE NUMBER BACK
CLL RTL /MULTIPLY TIMES 4
TAD MULTMP /TIMES 5
SZL /SKIP IF NO OVERFLOW
SKP /GOT OVERFLOW
RAL /TIMES 10
JMP I MUL10 /RETURN NUMBER IN AC
/THE LINK HAS ANY OVERFLOW
MULTMP, 0 /TEMP STORAGE FOR MUL10 ROUTINE
/ ROUTINE TO CHECK FOR A VALID ASCII DECIMAL VALUE
/ ENTER WITH ASCII CHAR IN THE AC
/ EXIT RETURN + 1 IF NON-VALID ASCII DECIMAL WITH CHAR IN AC
/ EXIT RETURN + 2 IF VALID ASCII DECIMAL WITH CHAR IN AC
DECCK, 0
DCA DECCK5 /STORE THE CHAR TO CHECK
TAD DECCK5 /GET THE CHAR
TAD (-"0 /CHECK FOR LESS THAN 0
SPA /SKIP IF NOT LESS THAN 0
JMP DECCK1 /NON-ASCII DECIMAL
TAD ("0-"9-1 /CHECK GREATER THAN 9
SMA CLA /SKIP IF LE 9
JMP DECCK1 /INVALID ASCII DECIMAL
ISZ DECCK /BUMP RETURN FOR VALID ASCII DECIMAL
DECCK1, TAD DECCK5 /RE-GET ORIGINAL CHAR IN AC
JMP I DECCK /RETURN
DECCK5, 0 /TEMP FOR "DECCK" ROUTINE
/ ROUTINE TO INPUT A LINE FROM THE KEYBOARD
LININP, 0
TAD (LINBUF /GET ADDRESS OF LINE BUFFER
DCA LIN50 /STORE IN A POINTER
LIN1, JMS ITTYW /INPUT A CHAR
TAD (-CR /CHECK FOR A RETURN TYPED
SNA /SKIP IF NOT A RETURN
JMP LIN2 /LINE IS INPUT
TAD (CR-DELETE /CHECK FOR A DELETE CHAR
SNA CLA /SKIP IF NOT A DELETE
JMP LIN5 /OFF TO HANDLE A DELETE
TAD LIN50 /GET VALUE OF LINE POINTER
TAD (-LINBUF-LINSIZ /COMPARE WITH END OF LINE BUFFER
SMA CLA /SKIP IF ROOM IN LINE BUFFER
JMP LIN10 /BEEP FOR FULL BUFFER
TAD TCHAR /RE-GET CHAR JUST INPUT
TTYOUT /DISPLAY ON THE SCREEN
DCA I LIN50 /STORE IN THE LINE BUFFER
ISZ LIN50 /BUMP THE LINE BUFFER POINTER
STA /AC = -1
DCA I LIN50 /TERMINATE THE LINE
JMP LIN1 /LOOP TILL A RETURN TYPED
LIN2, STA /AC = -1
DCA I LIN50 /INSURE STRING TERMINATED
PRI6B; CRLF /SEND A CR/LF
JMP I LININP /DONE
/ HANDLE A DELETE TYPED IN
LIN5, TAD LIN50 /FIND OUT FIRST IF...
TAD (-LINBUF /WE ARE AT THE BEGINNING OF THE LINE
SNA CLA /SKIP IF NO
JMP LIN1 /JUST IGNORE THE DELETE
STA /AC = -1
TAD LIN50 /GET THE LINE POINTER
DCA LIN50 /RETURN BACKED UP
DCA I LIN50 /ZERO THE CHAR
PRI6B; RUBOUT /ERASE THE CHAR FROM THE SCREEN
JMP LIN1 /BACK TO INPUT
/ HANDLE FULL LINE BUFFER HERE
LIN10, CLA CLL /INSURE CLEAR AC
PRI6B; BEEP /SEND OUT A BEEP WARNING
JMP LIN1 /BACK TO MAIN LOOP TO WAIT FOR A
/ RETURN OR DELETE KEY
LIN50, 0 /TEMP POINTER FOR "LININP" ROUTINE
/ ROUTINE TO PRINT THE DATA IN THE RECEIVED PACKET
PRIPAK, 0
PRI8B; RRDTA /PRINT THE DATA
PRI6B; CRLF /ADD IN A CR/LF
JMP I PRIPAK /DONE
PAGE
/ ROUTINE TO HANDLE THE "CONNECT" COMMAND
CONSRV, 0
ISZ CONSRV /ALWAYS NON-ERROR RETURN
PRI6B; CONMSG /TELL THEM WE ARE CONNECTING
TAD (MLINE /SET MODE ONLINE
DCA KMODE
DCA CONFLG /RE-SET CONNECT FLAG
CONSR1, JMS IREM /GET ANY INPUT FROM REMOTE COMPUTER
TTYOUT /RETURN HERE ON INPUT FROM REMOTE, SEND
/ TO THE TELEPRINTER DEVICE
JMS ITTY /GET ANY INPUT FROM KEYBOARD
SKP /RETURN HERE ON INPUT FROM KEYBOARD
JMP CONSR1 /NO KEYBOARD INUPUT, CONTINUE POLL
TAD (-CONX1 /CHECK FOR FIRST EXIT CHAR
SZA /SKIP IF IS FIRST EXIT CHAR
JMP CONSR5 /NOT FIRST EXIT CHAR
STA /SET AC = -1
DCA CONFLG /MAKE FLAG = -1
JMP CONSR1 /CONTINUE POLL
CONSR5, TAD (CONX1-CONX2 /CHECK FOR SECOND EXIT CHAR
SZA CLA /SKIP IF IT IS
JMP CONSR9 /JUST ECHO AND EXIT
ISZ CONFLG /WE SKIP IF FIRST CHAR CAME BEFORE
JMP CONSR9 /FIRST CHAR DID NOT COME IN
PRI6B; CONEXT /TELL THEM WE ARE EXITING THE CONNECT
JMP I CONSRV /DONE WITH CONNECT SERVICE
CONSR9, DCA CONFLG /RE-SET THE CONNECT FLAG
TAD TCHAR /GET CHAR JUST ENTERED
JMS OREM /DISPLAY ON THE TERMINAL
CLA CLL /INSURE CLEAR AC
JMP CONSR1 /CONTINUE POLL LOOP
/ ROUTINE TO HANDLE THE "BYE" COMMAND
BYESRV, 0
FPACK /FORMAT A PACKET
SRVBYE /PACKET DATA ADDRESS
STGEN /PACKET TYPE
BYE2, SPACK /SEND PACKET
1 /AWAIT RESPONSE
BYE20 /DISPATCH LIST FOR RESPONSE
/ NAK OR UNDEFINED RESPONSE HERE
BYE5, ISZ RTRYC /BUMP RE-TRY COUNTER
JMP BYE2 /GET RESPONSE AND TRY AGAIN
TAD (NOBYE /FAILED, RETURN MESSAGE
JMP I BYESRV
/ ACK HERE
BYE10, ISZ BYESRV /BUMP FOR NON-ERROR EXIT
JMP I BYESRV /DONE
BYE20, STACK; BYE10 /ACK
STNAK; BYE5 /NAK
0
SRVBYE, "F&137 /SERVER KERMIT COMMAND TO SHUT DOWN
-1 /END OF DATA
/ EXIT OS/8 KERMIT
OS8, 0
PRI6B; EXTXT /DISPLAY WE ARE EXITING
CLA CLL
JMP I (7600 /BACK TO OS8
/ REMOTE LINK INPUT ROUTINE
/ CALL = RPACK
ILINK, 0
TAD RETRY /SET UP A RE-TRY COUNT
DCA ILINK6 /RE-TRY COUNT FOR INPUT ERRORS
ILINK0, JMS GETSOH /FIRST GET THE "SOH" BYTE
JMP ILINK2 /RETURN HERE ON TIME-OUT
DCA ILINK9 /INIT CHECKSUM REGISTER
TAD (RRLEN /GET REMOTE RECEIVE BUFFER ADDRESS
DCA ILINK8 /STORE IN LOCAL POINTER
JMS GETIR /GET A CHAR
JMP ILINK2 /GOT A RETURN OR TIME-OUT
DCA I ILINK8 /STORE LENGTH IN BUFFER
TAD I ILINK8 /GET LENGTH CHAR BACK
TAD (-40-1 /CHAR FUNCTION - LENGTH BYTE
CIA /NEGATE FOR COUNTER
DCA ILINK7 /STORE IN LOCAL COUNTER
ILINK1, ISZ ILINK8 /BUMP POINTER
JMS GETIR /GET NEXT CHAR
JMP ILINK2 /GOT A RETURN
DCA I ILINK8 /STORE IN BUFFER
ISZ ILINK7 /BUMP COUNTER
JMP ILINK1 /LOOP
ISZ ILINK8
STA
DCA I ILINK8
TAD ILINK9 /GET CACULATED CHECKSUM
JMS CKSUM /CACULATE 1 BYTE CHECKSUM
CIA /NEGATE FOR COMPARE
DCA ILINK7 /STORE TEMP
JMS GETIR /NOW GET CHECKSUM
JMP ILINK2 /GOT A RETURN
TAD ILINK7 /COMPARE WITH CACULATED CHECKSUM
SNA CLA /SKIP IF NOT SAME
JMP ILINK4 /ARE SAME
ILINK2, CLA CLL /INSURE CLEAR AC
ISZ ILINK6 /BUMP RE-TRY COUNTER
JMP ILINK3 /CAN RE-TRY
TAD (FPERR /GET MESSAGE FOR FATAL PACKET ERROR
JMP CLOOP7 /AND ABORT THE MESS
ILINK3, TAD CCFLAG /CHECK IF ^C TYPED
SZA CLA /SKIP IF NO
JMP ABORT /ABORT THIS
JMS SNDNAK /SEND BACK A "NAK"
JMP ILINK0 /AND TRY AGAIN
ILINK4, TAD CCFLAG /WAS A ^C TYPED?
SNA CLA /SKIP IF YES
JMP I ILINK /NOPE, RETURN
JMP ABORT
ILINK6, 0 /LOCAL TO "ILINK"
ILINK7, 0 /LOCAL TO "ILINK"
ILINK8, 0 /LOCAL TO "ILINK"
ILINK9, 0 /LOCAL TO "ILINK"
PAGE
/ ROUTINE TO SERVICE A SEND REQUEST
SNDSRV, 0
TAD (MSEND /FIRST SET MODE TO SEND
DCA KMODE /PUT INTO MODE FLAG
TAD LPTR /GET CURRENT LINE POINTER
DCA PRSERR /SAVE LINE POSITION
TAD PRSERR /GET LINE POSITION
JMS DPARS /TRY TO PARSE OFF A DEVICE NAME
JMP S50 /RETURN A DEVICE NAME ERROR
DCA PRSERR /SAVE LINE POINTER
TAD (FNBLK /GET FILE NAME BLOCK ADDRESS
DCA FNPTR /STORE IN POINTER
TAD PRSERR /GET STRING POINTER
JMS PFNAM /PARSE OFF THE FILE NAME
JMP S52 /FILE NAME PARSE ERROR
DCA PRSERR /SAVE THE STRING POINTER
TAD PRSERR /GET THE STRING POINTER
JMS NOSP /FIND THE END OF STRING
SKP /GOT END OF STRING HERE
JMP S50 /SYNTAX ERROR
DCA PRSERR /RETURN POINTER
TAD DEVNUM /GET THE DEVICE NUMBER PARSED
JMS HFETCH /FETCH A HANDLER FOR THIS
JMP S54 /HANDLER FETCH ERROR
DCA DIRBLK /INIT FOR DIRECTORY SEARCH
DCA FILFND /INIT FILE FOUND FLAG
DCA INIFLG /CLEAR THE INIT DONE FLAG
SNDSV1, TAD (FNBLK /GET FILE NAME BLOCK ADDRESS
DCA FCMP1 /SET FOR FILE TO FINE
JMS LOOKUP /FIND A MATCH FOR THIS FILE
JMP S56 /DIRECTORY I/O ERROR
JMP S00 /FILE NOT FOUND
ISZ FILFND /BUMP FILE FOUND COUNT
JMS SNDPRO /PROCESS THIS FILE FOR SEND
JMP S60 /ERROR IN FILE SEND PROCESS
TAD WILDF /WAS WILD CARD FILE SPEC?
SZA CLA /SKIP IF NO
JMP SNDSV1 /GOT WILD CARD, TRY FOR NEXT
S00, TAD FILFND /CHECK FOR ANY FILES FOUND
SNA CLA /SKIP IF YES
JMP S58 /RETURN FILE NOT FOUND ERROR
JMS BRKXMT /BREAK THE SEND
TAD PRSERR /GET CURRENT CURSOR POSITION
DCA LPTR /UPDATE
ISZ SNDSRV /BUMP RETURN
JMP I SNDSRV /AND DONE
/ ERROR HANDLING FOR SEND PROCESS
S50, CLA CLL /INSURE CLEAR AC
TAD (DEVERR /GET DEVICE SPECIFICATION ERROR
JMP I SNDSRV /TAKE THE ERROR EXIT
S52, CLA CLL /INSURE CLEAR AC
TAD (STXERR /GET SYNTAX ERROR MESSAGE
JMP I SNDSRV /TAKE ERROR EXIT
S54, CLA CLL /INSURE CLEAR AC
TAD (HFERR /GET HANDLER FETCH ERROR MESSAGE
JMP I SNDSRV /TAKE ERROR EXIT
/ RETURN A DIRECTORY I/O ERROR MESSAGE
S56, CLA CLL /INSURE CLEAR AC
TAD (DIOERR /GET DIRECTORY I/O ERROR MESSAGE
JMP I SNDSRV /TAKE THE ERROR EXIT
/ RETURN A FILE NOT FOUND ERROR
S58, TAD (NOFND /GET ADDRESS OF MESSAGE
JMP I SNDSRV /RETURN VIA ERROR RETURN
/ RETURN A SEND PROCESS ERROR
S60, TAD (SPERR /GET A SEND PROCESS ERROR MESSAGE
JMP I SNDSRV /TAKE THE ERROR EXIT
FILFND, 0 /HOLDS COUNT OF # OF FILES FOUND
FNBLK, 0
0
0
0
/ ROUTINE TO RE-SET THE SEND
BRKXMT, 0
CLA CLL /INSURE CLEAR AC
DCA INIFLG /CLEAR THE INIT SEND FLAG
FPACK /FORMAT A PACKET
NODATA /NO DATA FOR THIS PACKET
STEOT /"EOT" PACKET TYPE
SPACK /SEND THE PACKET
0 /NO RESPONSE
JMP I BRKXMT /DONE
/ ROUTINE TO SEND OUT A NAK WITHOUT DISTURBING THE NORMAL PACKET BUFFER
SNDNAK, 0
TAD CURSEQ /GET CURRENT SEQ NUMBER
TAD (40-1 /CHAR IT AND SUB 1
AND C77 /MOD 64
DCA NAKPAK+2 /PUT IN NAK PACKET BUFFER
TAD NAKPAK+1 /GET LENGTH
TAD NAKPAK+2 /GET SEQ
TAD NAKPAK+3 /GET TYPE
JMS CKSUM /CACULATE CHECKSUM
DCA NAKPAK+4 /PUT IN CHECKSUM
TAD REOL /GET ANY EOL REQUIRED
TAD (-40 /UN-CHAR IT
SNA /SKIP IF USING
STA /NO EOL, PUT IN -1 INSTEAD
DCA NAKPAK+5 /PUT EOL IN
REM8B; NAKPAK /SEND NAK TO REMOTE
JMP I SNDNAK /DONE
NAKPAK, 0
43 /LENGTH OF NAK PACKET
0 /SEQ NUMBER GOES HERE
STNAK /DATA TYPE
0 /CHECKSUM
0 /EOL IF USED
-1 /TERMINATE
PAGE
/ ROUTINE TO SERVICE A "GET" COMMAND
GETSRV, 0
TAD LPTR /GET CURRENT LINE POINTER
DCA PRSERR /SAVE
TAD PRSERR /RE-GET IT
JMS NOSP /FIND BEGINNING OF A FILE NAME
JMP GSRV21 /GOT EOL, NO FILE NAME
DCA GSRV90 /STORE BEGINNING ADDRESS
TAD GSRV90 /NOW WE LOOK FOR
JMS SP /THE END OF THE LINE
SKP /GOT THE END OF THE LINE HERE
JMP .-2 /NOT END YET, CONTINUE
DCA PRSERR /STORE POINTER TO EOL
STA /AC = -1
DCA I PRSERR /TERMINATE FILE NAME WITH -1
DCA CURSEQ /RE-SET THE SEQUENCE
TAD GSRV90 /GET ADDRESS OF FILE NAME
JMS XLATE7 /INSURE 7 BIT ASCII FILE NAME
GSRV10, FPACK /FORMAT THE PACKET
GSRV90, 0 /DATA ADDRESS HERE
STRIN /RECIEVE INIT PACKET
GSRV12, SPACK /SEND THE PACKET
1 /GET RESPONSE
GSRV80 /DISPATCH TABLE
/ SERVICE A NAK OR UNDEFINED
GSRV15, ISZ RTRYC /BUMP THE RE-TRY COUNTER
JMP GSRV12 /TRY AGAIN
JMP I GETSRV /GIVE UP
/ SERVICE A SEND/INIT FROM THE REMOTE
GSRV20, JMS INPSRV /HANDLE JUST LIKE A RECEIVE
JMP GSRV21 /ERROR RETURN FROM "INPSRV"
ISZ GETSRV /BUMP RETURN FOR NO ERROR
TAD PRSERR /UPDATE THE CURRENT LINE POINTER
DCA LPTR
GSRV21, JMP I GETSRV
/ GOT AN ERROR PACKET, DISPLAY ERROR AND ABORT
GSRV40, JMS PRIPAK /PRINT OUT THE ERROR PACKET
JMP I GETSRV /TAKE THE ERROR EXIT
/ DISPATCH TABLE
GSRV80, STERR; GSRV40 /ERROR PACKET RETURNED
STSIN; GSRV20 /SEND INIT PACKET RETURNED
STNAK; GSRV15 /NAK PACKET RETURNED
0 /TERMINATE TABLE
/ROUTINE TO SERVICE A "RECEIVE" COMMAND
RECSRV, 0
TAD LPTR /GET CURRENT LINE POINTER
DCA PRSERR /SAVE IT
TAD PRSERR /GET IT BACK
JMS NOSP /GO FIND END OF LINE
SKP /GOT END OF LINE HERE
JMP RECS60 /SOMETHING ELSE ON LINE, ERROR
RPACK /GET SEND/INIT PACKET FROM REMOTE
RTDISP; RECS80 /DISPATCH BASED ON "RRTYP"
JMP RECS60 /DON'T KNOW WHAT IT IS
/ GOT A SEND INIT PACKET
RECS10, JMS INPSRV /OFF TO HANDLE INPUT
JMP RECS60 /ERROR RETURN
/ TAKE THE NON-ERROR RETURN
RECS20, ISZ RECSRV /BUMP FOR NON-ERROR RETURN
JMP I RECSRV
/ TAKE THE ERROR RETURN
RECS60, CLA
JMP I RECSRV /TAKE ERROR EXIT
/ DISPATCH TABLE
RECS80, STSIN; RECS10 /SEND INIT PACKET DISPATCH
STEOT; RECS60 /END OF CONNECTION
STBRK; RECS20 /BREAK TRANSMISSION
0
RECS90, 0 /TEMP FOR "RECSRV"
PAGE
/ ROUTINE TO SERVICE INPUT OF A FILE
INPSRV, 0
TAD (MREC /SET UP CURRENT MODE
DCA KMODE /FOR RECEIVE
JMS SETINI /SET UP INIT REGISTERS
DCA CURSEQ /RE-SET THE SEQUENCE NUMBER
FPACK /FORMAT A PACKET
INIDAT /PACKET DATA ADDRESS
STACK /"ACK" PACKET TYPE
INPS01, SPACK /SEND A PACKET
1 /AWAIT RESPONSE
INPS91 /DISPATCH TABLE ADDRESS
/ NAK OR UNDEFINED RESPONSE HERE
INPS02, ISZ RTRYC /GOT A NAK, CHECK RE-TRY COUNT
JMP INPS01 /RE-TRY THE INIT
JMP INPS60 /GIVE UP
INPS03, FPACK /FORMAT A PACKET
NODATA /NO DATA
STACK /"ACK" PACKET TYPE
INPS05, SPACK /SEND A PACKET
1 /AWAIT RESPONSE
INPS90 /DISPATCH TABLE ADDRESS
JMP INPS60 /UNDEFINED RESPONSE
/ GOT A DATA PACKET, WRITE TO OUTPUT FILE
INPS10, TAD OFFLG /CHECK THE OUTPUT FILE FLAG
SNA CLA /SKIP IF OUTPUT FILE OPEN
JMP INPS60 /ABORT AND EXIT
JMS WRIPAK /WRITE THE PACKET TO THE FILE
JMP INPS60 /ERROR WRITING PACKET
JMP INPS03 /LOOP
/ GOT A FILE HEADER PACKET, OPEN FILE
INPS20, TAD OFFLG /CHECK IF OUTPUT FILE OPEN
SZA CLA /SKIP IF NO
JMP INPS60 /ABORT IF FILE ALREADY OPEN
TAD RRLEN /GET CURRENT PACKET LENGTH
TAD (-40-3 /CACULATE LENGTH OF DATA
SPA /SKIP IF DATA IN THE PACKET
JMP INPS60 /ELSE AN ERROR
TAD (RRDTA /CACULATE LAST BYTE IN DATA
DCA INPS81 /STORE IN POINTER
STA /AC = -1
DCA I INPS81 /TERMINATE NAME WITH A MINUS WORD
TAD (FNBLK /GET ADDRESS OF FILE NAME BLOCK
DCA FNPTR /SAVE FOR NAME PARSE
TAD (RRDTA /GET ADDRESS OF DATA IN PACKET
JMS PFNAM /PARSE OFF THE FILE NAME
JMP INPS60 /ERROR IN FILE NAME
/ GET TARGET DEVICE
CLA CLL /CLEAR AC FROM FILE NAME PARSE
TAD ODNAME /GET TARGET DEVICE NAME
JMS DVNUM /GET DEVICE NUMBER
JMP INPS60 /ERROR
DCA ODNUMB /SAVE OUTPUT DEVICE NUMBER
TAD ODNUMB /GET NUMBER BACK
JMS HFETCH /FETCH HANDLER FOR THIS DEVICE
JMP INPS60 /HANDLER FETCH ERROR
TAD (FNBLK /GET ADDRESS OF FILE NAME BLOCK
DCA INPS22 /PUT IN CALL
TAD ODNUMB /GET DEVICE NUMBER
CIF 10 /IF = 1
JMS I USR /CALL USER SERVICE ROUTINE
3 /ENTER
INPS22, 0 /
0 /
JMP INPS60 /ERROR
TAD INPS22 /GET NEW FILE START BLOCK
DCA FSBLK /SAVE
TAD INPS22+1 /GET NEW FILE SIZE
DCA FLEN /SAVE
ISZ OFFLG /SET FLAG FOR OUTPUT FILE OPEN
JMS INIOUT /INIT FOR OUTPUT
TAD FNPTR /GET POINTER TO 6 BIT FILE NAME
JMS FILN8 /MAKE 8 BIT FORMATTED STRING
PRI6B; FRMSG /LET USER KNOW
PRI8B; NAMBUF /WHICH FILE WE ARE RECEIVING
PRI6B; CRLF
JMP INPS03 /LOOP
/ GOT AN END OF FILE PACKET
INPS30, TAD OFFLG /ANY OUTPUT FILE OPEN?
SNA CLA /SKIP IF YES
JMP INPS60 /ERROR
JMS CLOSEF /CLOSE THE FILE
JMP INPS60 /ERROR CLOSING THE FILE
DCA OFFLG /RE-SET FILE OPEN FLAG
JMP INPS03 /CONTINUE
/ GOT AN END OF TRANSMISSION PACKET
INPS40, TAD OFFLG /WAS A FILE OPEN?
SZA CLA /SKIP IF NO
JMS CLOSEF /CLOSE ANY OPEN FILE
FPACK /FORMAT A PACKET
NODATA /NO DATA IN PACKET
STACK /"ACK" PACKET TYPE
SPACK /SEND THE PACKET
0 /NO RESPONSE
ISZ INPSRV /BUMP RETURN FOR NO ERROR
JMP I INPSRV /TAKE NON-ERROR EXIT
/ GOT AN ERROR PACKET
INPS50, JMS PRIPAK /PRINT THE PACKET DATA
JMP I INPSRV /AND TAKE THE ERROR EXIT
/ HANDLE ERRORS HERE
INPS60, CLA CLL /INSURE CLEAR AC
FPACK /FORMAT A PACKET
NODATA /NO DATA
STNAK /"NAK" PACKET TYPE
SPACK /SEND THE PACKET
0 /NO RESPONSE
TAD (RECERR /GET ERROR MESSAGE
JMP I INPSRV /TAKE THE ERROR RETURN
/ TEMPS FOR "INPSRV"
INPS80, 0
INPS81, 0
PAGE
/ DISPATCH TABLES FOR "INPSRV"
INPS90, STDAT; INPS10 /HANDLE DATA PACKETS
STEOF; INPS30 /HANDLE EOF PACKET
STEOT; INPS40 /HANDLE END OF TRANSMISSION PACKET
STFIL; INPS20 /HANDLE FILE NAME PACKET
STERR; INPS50 /HANDLE ERROR PACKET
0 /TERMINATE TABLE
INPS91, STNAK; INPS02 /HANDLE A NAK PACKET
STFIL; INPS20 /HANDLE FILE NAME PACKET
STERR; INPS50 /HANDLE ERROR PACKET
0 /TERMINATE TABLE
/ ROUTINE TO CHECK FOR AN ALPHABETIC OR NUMERIC CHAR
/ ENTER WITH THE CHAR IN THE AC
/ EXIT + 2 IF ALPHABETIC OR NUMERIC WITH CHAR IN THE AC
/ EXIT + 1 IF NON-ALPHABETIC OR NUMERIC WITH CHAR IN THE AC
ALPNUM, 0
JMS ALPHA /CHECK FOR ALPHA FIRST
SKP /NON-ALPHA RETURN, MUST CHECK NUMERIC
JMP ALPNM1 /IS ALPHA, TAKE RETURN + 2
JMS NUMRC /CHECK IF NUMERIC
SKP /NOT NUMERIC
ALPNM1, ISZ ALPNUM /BUMP RETURN FOR ALPHA-NUMERIC
JMP I ALPNUM /DONE
/ ROUTINE TO CHECK FOR AN ALPHABETIC CHARACTOR
/ ROUTINE ASSUMES UPPER CASE
/ ENTER ROUTINE WITH CHAR IN THE AC
/ EXIT + 2 IF THE CHAR IS ALPHABETIC WITH THE CHAR IN THE AC
/ EXIT + 1 IF THE CHAR IS NOT ALPHABETIC WITH THE CHAR IN THE AC
ALPHA, 0
DCA ALPHA1 /STORE THE CHAR FOR RETURN
TAD ALPHA1 /GET THE CHAR
TAD (-"Z-1 /TESTING FOR LETTER A-Z
CLL /INIT LINK FOR A FLAG
TAD ("Z-"A+1
SZL /SKIP IF NOT A LETTER
ISZ ALPHA /IS A LETTER, BUMP RETURN
CLA CLL /CLEAR AC
TAD ALPHA1 /RESTORE CHAR IN THE AC
JMP I ALPHA /TAKE PROPER RETURN
ALPHA1, 0 /TEMP FOR ALPHA ROUTINE
/ ROUTINE TO CHECK FOR A NUMERIC CHARACTOR
/ ENTER WITH THE CHAR TO CHECK IN THE AC
/ EXIT + 2 IF NUMERIC WITH THE CHAR IN THE AC
/ EXIT + 1 IF NON-NUMERIC WITH THE CHAR IN THE AC
NUMRC, 0
DCA NUMRC1 /SAVE THE CHAR FOR RETURN
TAD NUMRC1 /GET THE CHAR BACK
TAD (-"9-1 /TESTING FOR 0-9
CLL /INIT LINK FOR A FLAG
TAD ("9-"0+1
SZL /SKIP IF NOT A DIGIT
ISZ NUMRC /BUMP RETURN FOR NUMERIC
CLA CLL /CLEAR AC
TAD NUMRC1 /RESTORE CHAR IN THE AC
JMP I NUMRC /DONE
NUMRC1, 0 /TEMP FOR NUMRC CHECK ROUTINE
PAGE
/ ROUTINE TO PACK TWO 6 BIT CHARS IN A 12 BIT WORD
/ ROUTINE EXPECTS POINTER AT "PACK6P" TO BE POINTING TO WHERE TO PUT
/ THE CHARS AND THE FLAG "PACK6F" TO FLAG HIGH BYTE OR LOW BYTE FOR
/ PACKING (4000 = HIGH BYTE, 0 = LOW BYTE)
/ CALL: PACK6
PACK60, 0
AND C77 /STRIP TO 6 BITS
DCA PACK6T /STORE TEMP
CLA CLL CML RAR /SET LINK=0, AC = 4000
TAD PACK6F /GET CURRENT FLAG
DCA PACK6F /RETURN, LINK NOW CONTAINS FLAG
SZL /SKIP IF LINK IS ZERO (ON FIRST BYTE)
TAD I PACK6P /GET FIRST BYTE
TAD PACK6T /COMBINE WITH SECOND BYTE
SNL /SKIP IF ON SECOND BYTE
JMS SWAP /SWAP AROUND
DCA I PACK6P /RETURN
SZL /SKIP IF FIRST BYTE
ISZ PACK6P /BUMP POINTER TO NEXT
JMP I PACK60 /DONE
PACK6T, 0 /TEMP FOR "PACK6" ROUTINE
/ ROUTINE TO FETCH A DEVICE HANDLER BY HANDLER NUMBER
/ ENTER WITH NUMBER IN AC
/ EXIT WITH "HNDADR" POINTING TO ENTRY TO THE HANDLER AND RETURN
/ PLUS 2 IF SUCCESSFUL, AND RETURN + 1 IF ERROR
HFETCH, 0
DCA HNUM /STORE HANDLER NUMBER
TAD (HNDLR /GET THE HANDLER LOAD ADDRESS
DCA HADR /STORE IN CALL
TAD HNUM /GET HANDLER NUMBER BACK
CIF 10 /USER IN FIELD 1
JMS I USR /CALL USER SERVICE
0001 /FETCH IS FUNCTION 1
HADR, 0 /PUT WERE TO LOAD HANDLER HERE
SKP /ERROR LOADING HANDLER HERE
ISZ HFETCH /BUMP FOR NO ERROR
CLA CLL /INSURE CLEAR AC
TAD HADR /GET RETURNED HANDLER ADDRESS
DCA HNDADR /PUT WHERE ALL CAN ACCESS
JMP I HFETCH /RETURN
HNUM, 0 /LOCAL TEMP FOR "HFETCH"
/ ROUTINE TO INPUT A BLOCK FROM DISK
/ ENTER WITH BLOCK NUMBER IN THE AC, AND THE BUFFER ADDRESS IN THE MQ
/ EXIT + 1 IF ERROR ON INPUT
/ EXIT + 2 IF SUCCESSFUL
BLKIN, 0
DCA BLKIN1 /STORE BLOCK NUMBER IN CALL
MQA /GET THE BUFFER ADDRESS
DCA BLKIN0 /PUT INTO THE CALL
JMS I HNDADR /CALL THE HANDLER FOR SERVICE
0200 /INPUT 2 128 WORD RECORDS
BLKIN0, 0 /TO THE I/O BUFFER
BLKIN1, 0 /BLOCK NUMBER HERE
SKP /ERROR RETURN
ISZ BLKIN /BUMP FOR SUCCESS RETURN
CLA CLL /RETURN AC = 0
JMP I BLKIN
/ ROUTINE TO WRITE A BLOCK TO THE DISK
/ ENTER: AC = BLOCK NUMBER TO WRITE
/ EXIT: RETURN + 2 = WRITE SUCCESSFUL
/ RETURN + 1 = WRITE FAILED
BLKOUT, 0
DCA BLKOU1 /PUT BLOCK NUMBER IN CALL
JMS I HNDADR /CALL THE HANDLER
4200 /WRITE 1 BLOCK
IOBUF /OUTPUT BUFFER ADDRESS
BLKOU1, 0 /BLOCK NUMBER GOES HERE
SKP /ERROR ON THE WRITE
ISZ BLKOUT /BUMP RETURN FOR NO ERROR
CLA CLL /RETURN AC = 0
JMP I BLKOUT /EXIT
/ ROUTINE TO LOOKUP A FILE IN THE DIRECTORY
/ RETURN + 1 ON DIRECTORY I/O ERROR
/ RETURN + 2 IF FILE NOT FOUND
/ RETURN + 3 IF FILE FOUND
/ INITIALIZE DIRBLK TO ZERO IF DIRECTORY SEARCH FROM BEGINNING,
/ ELSE THE DIRECTORY SEARCH BEGINS WITH THE LAST MATCH.
LOOKUP, 0
TAD DIRBLK /CHECK IF START FROM BEGINNING
SNA CLA /SKIP IF NO
JMP LUP1 /MUST READ IN BEGINNING OF DIRECTORY
JMP LUP25 /CONTINUE SEARCH LOOP
LUP0, TAD SLINK /GET NEXT ENTRY NUMBER
SNA CLA /SKIP IF IS A NEXT ENTRY
JMP LUP30 /NO NEXT ENTRY
LUP1, TAD (DIRBUF /GET THE DIRECTORY BUFFER ADDRESS
MQL /PUT INTO MQ REGISTER
ISZ DIRBLK /BUMP THE BLOCK NUMBER
TAD DIRBLK /GET THE BLOCK NUMBER IN THE AC
JMS BLKIN /INPUT A DIRECTORY BLOCK
JMP I LOOKUP /DIRECTORY I/O ERROR
TAD SBLOCK /GET STARTING BLOCK FOR THIS SEGMENT
DCA FSBLK /SAVE TO KEEP TRACK OF FILE POSITIONS
TAD (SFILS /GET POINTER TO FILE ENTRY BEGINNING
DCA DPTR /STORE IN A POINTER
LUP20, TAD DPTR /GET POINTER TO ENTRY
IAC /ADD 1
DCA DWORD /DWORD POINTS TO LENGTH OF EMPTY
TAD I DPTR /GET FIRST WORD FROM ENTRY
SNA CLA /SKIP IF IS A FILE NAME
JMP LUP25 /NOT FILE, HANDLE EMPTY
TAD SADDNL /GET NUMBER OF ADDITIONAL INFO WORDS
CIA /GOTTA MAKE IT POSITIVE
TAD DPTR /ADD CURRENT POINTER
TAD (5-1 /POINT TO LENGTH OF FILE
DCA DWORD /SAVE FOR NEXT TRY
TAD I DWORD /CHECK FOR TENTATIVE FILE
SNA CLA /GOOD FILE HAS SOME LENGTH
JMP LUP25 /TENTATIVE FILE, SKIP IT
TAD DPTR /NOW GET THIS TRY
JMS FMATCH /TRY TO MATCH
JMP LUP25 /NO MATCH
TAD DPTR /GET POINTER TO NAME
JMS FILN8 /GET FILE NAME INTO A BUFFER
TAD SADDNL /GET NUMBER OF ADDITIONAL WORDS
SNA CLA /SKIP IF DATE IS PRESENT
JMP LUP22 /NO DATE IN THIS DIRECTORY
TAD DPTR /GET POINTER TO FILE NAME
TAD (4 /GET PAST THE NAME
DCA DPTR /STORE IN POINTER
TAD I DPTR /GET THE DATE WORD
LUP22, JMS FILD8 /AND CONVERT
TAD I DWORD /GET FILE LENGTH
DCA FLEN /STORE LENGTH OF FILE
TAD DWORD /GET POINTER TO NEXT ENTRY
IAC /BUMP AHEAD TO NEXT ENTRY
DCA DPTR /SET FOR POSSIBLE NEXT SEARCH
ISZ LOOKUP /BUMP FOR FILE FOUND
LUP30, ISZ LOOKUP /JUMP HERE FOR FILE NOT FOUND
JMP I LOOKUP
LUP25, TAD I DWORD /GET PREVIOUS SIZE
CIA /MAKE IT POSITIVE
TAD FSBLK /GET CURRENT START BLOCK
DCA FSBLK /UPDATE CURRENT START BLOCK
TAD DWORD /GET POINTER TO PREVIOUS
IAC /POINT TO CURRENT
DCA DPTR /RETURN TO POINTER
ISZ SENTRY /BUMP ENTRY COUNTER
JMP LUP20 /CONTINUE LOOP
JMP LUP0 /GO TRY NEXT DIRECTORY SEGMENT
PAGE
/ DIRECTORY BLOCK BUFFER
DIRBUF= . /DEFINE BEGINNING OF BUFFER
SENTRY, 0 /# OF ENTRYS IN SEGMENT
SBLOCK, 0 /STARTING BLOCK NUMBER OF FIRST FILE
SLINK, 0 /LINK TO NEXT DIRECTORY SEGMENT
STENT, 0 /POINTER TO LAST WORD OF TENTATIVE ENTRY
SADDNL, 0 /# OF ADDITIONAL INFO WORDS
SFILS, 0 /BEGINNING OF FILE ENTRYS
*DIRBUF
ZBLOCK 400 /RESERVE SPACE FOR DIRECTORY SEGMENT
PAGE
HNDLR=. /DEFINE HANDLER LOAD LOCATION
*HNDLR+400 /RESERVE SPACE FOR 2 PAGE HANDLER
IOSIZ= 400
IOBUF, ZBLOCK IOSIZ
/ ROUTINE TO COMPARE TWO FILE NAMES FOR EQUALITY
/ THE ROUTINE WILL CHECK EACH OF THE 8 FILE NAME CHARS AND IF A
/ CHAR IN THE FIRST FILE NAME (THE ONE WE ARE LOOKING FOR) CONTAINS
/ A "?" IT WILL MATCH ON THE SECOND FILE NAME CHAR.
/ ENTER WITH "FCMP1" POINTING TO THE FILE NAME TO FIND, AND "FCMP2"
/ POINTING TO THE FILE NAME TO TRY AND MATCH. EXIT + 1 IF NO MATCH
/ AND EXIT + 2 IF MATCH. (IF NON-ZERO AC ON ENTRY, THE AC IS ASSUMED
/ TO HAVE THE VALUE FOR "FCMP2")
FMATCH, 0
SZA /SKIP IF NO ARGUMENT IN AC
DCA FCMP2 /THIS ARGUMENT CAME IN THE AC
TAD FCMP1 /GET ADDRESS OF FIRST FILE NAME BLOCK
DCA GET6P /STORE IN A POINTER
DCA GET6F /INIT FLAG FOR "GET6" ROUTINE
TAD FCMP2 /GET ADDRESS OF SECOND FILE NAME BLOCK
DCA FMATP /STORE IN A LOCAL POINTER
DCA FMATF /INIT LOCAL FLAG
TAD (-10 /8 CHARS TO DO
DCA FMATC /STORE IN LOCAL COUNTER
FMAT1, CLA CLL CML RAR /AC=4000, LINK=0
TAD FMATF /GET FLAG
DCA FMATF /RETURN FLAG, LINK CONTAINS STATUS
TAD I FMATP /GET A WORD FROM THE SECOND NAME
SZL /SKIP IF ON THE TOP BYTE
ISZ FMATP /GOTTA BUMP THE POINTER
SNL /SKIP IF ON THE BOTTOM BYTE
JMS SWAP /SWAP TOP BYTE TO BOTTOM
AND C77 /KEEP ONLY BOTTOM 6 BITS
DCA FMATT /STORE IN A TEMP
GET6 /NOW GET A CHAR FROM FIRST NAME
TAD (-77 /CHECK IF WILD
SNA /SKIP IF NO
JMP FMAT2 /NO MATCH CHECK ON A WILD CARD
TAD C77 /RESTORE THE CHAR
CIA /NEGATE FOR COMPARE
TAD FMATT /COMPARE WITH SECOND FILE NAME
SZA CLA /SKIP IF IS A MATCH
JMP I FMATCH /THIS IS NOT A MATCH
FMAT2, ISZ FMATC /BUMP COUNTER
JMP FMAT1 /LOOP, MORE TO CHECK
ISZ FMATCH /BUMP RETURN FOR MATCH
JMP I FMATCH /GOT A MATCH
FMATP, 0 /POINTER FOR "FMATCH"
FMATC, 0 /COUNTER FOR "FMATCH"
FMATF, 0 /FLAG FOR "FMATCH"
FMATT, 0 /TEMP FOR "FMATCH"
FCMP1, 0 /POINTER FOR FIRST FILE NAME BLOCK
FCMP2, 0 /POINTER FOR SECOND FILE NAME BLOCK
/ OS8 DIRECTORY FILE DATA SETUP
/ ENTER WITH THE DIRECTORY DATE WORD IN THE AC
/ EXIT WITH THE DATE IN THE BUFFER "DATBUF"
FILD8, 0
DCA FILD89 /SAVE THE DATE WORD
TAD FILD89 /GET DATA WORD
AND (7 /KEEP ONLY YEAR BITS
TAD (116 /ADD 78 YEARS
MQL /PUT INTO MQ REGISTER
TAD (DATEYR /GET POINTER TO YEAR
JMS DECCON /CONVERT TO ASCII DATE
TAD FILD89 /GET DATE WORD BACK
CLL RTR /SHIFT DAY DOWN
RAR
AND (37 /KEEP ONLY DAY BITS
MQL /PUT IN MQ REGISTER
TAD (DATEDA /GET POINTER TO DAY
JMS DECCON /CONVERT TO ASCII DAY
TAD FILD89 /GET DATE WORD BACK
JMS SWAP /GET MONTH
CLL RTR /DOWN
AND (17 /KEEP ONLY MONTH BITS
MQL /INTO MQ REGISTER
TAD (DATEMO /GET ADDRESS OF WHERE TO PUT MONTH
JMS DECCON /CONVERT
JMP I FILD8 /ALL DONE
FILD89, 0 /TEMP FOR "FILD8"
/ ROUTINE TO CONVERT A BINARY VALUE INTO A TWO DIGIT ASCII DECIMAL
/ NUMBER. ENTER WITH WHERE TO STORE THE CONVERTED NUMBER IN THE
/ AC AND THE NUMBER IN THE MQ REGISTER.
DECCON, 0
DCA DECC20 /STORE THE POINTER
TAD ("0&177-1 /GET AN ASCII ZERO
DCA I DECC20 /START OUT WITH A ZERO
MQA /GET THE BINARY VALUE
DECC01, ISZ I DECC20 /BUMP
TAD (-12 /SUB 10
SMA /SKIP IF NO MORE DIVISION
JMP DECC01 /ELSE KEEP GOING
TAD (12+"0&177 /CONVERT REMAINDER TO ASCII
ISZ DECC20 /BUMP POINTER
DCA I DECC20 /STORE
JMS FMTDAT /FORMAT FOR PRINTING
JMP I DECCON /DONE
DECC20, 0 /LOCAL POINTER TO DECCON
/ ROUTINE TO SET UP THE DATE IN A MM-DD-YY FORMAT TO PUT IN FRONT
/ OF A FILE TO PASS THE FILES DATE (TEMPORY AND NOT PART OF THE
/ KERMIT PROTOCAL)
FMTDAT, 0
TAD DATEMO /GET FIRST CHAR OF DATE
DCA FDATE /MOVE IT
TAD DATEMO+1
DCA FDATE+1
TAD DATEDA
DCA FDATE+3
TAD DATEDA+1
DCA FDATE+4
TAD DATEYR
DCA FDATE+6
TAD DATEYR+1
DCA FDATE+7
JMP I FMTDAT /QUICK AND DIRTY
DATBUF, "#&177 /FILE CREATION DATE ATTRIBUTE
6+40 /LENGTH OF DATE (CHAR(X))
DATEYR, 0 /ASCII YEAR GOES HERE
0
DATEMO, 0 /ASCII MONTH GOES HERE
0
DATEDA, 0 /ASCII DAY GOES HERE
0
-1 /TERMINATE
/ FORMATED DATE GOES HERE
SETDAT, "<&177 /COMMENT SIGN
FDATE, 0
0
"-&177
0
0
"-&177
0
0
12
15
-1
PAGE
/ ROUTINE TO INPUT BYTES FROM THE LOOKED UP INPUT FILE
/ ROUTINE EXPECTS THE DEVICE NUMBER IN "DEVNUM", THE FILES START
/ BLOCK NUMBER IN "FSBLK", AND THE FILES LENGTH IN "FLEN"
/ ENTER: "DEVNUM", "FSBLK", AND "FLEN" ARE PROPERLY INITIALIZED
/ EXIT: RETURN + 3 WITH THE CHAR IN THE AC IF SUCCESSFUL
/ RETURN + 2 IF END OF FILE
/ RETURN + 1 IF FATAL I/O ERROR
UNPACK, 0
JMP I .+1 /DISPATCH TO PROPER CO-ROUTINE
UNPEXT, 0 /EXIT POINT FOR UNPACK
AND C377 /KEEP ONLY CHAR BITS
DCA UPTEMP /SAVE THE CHAR
TAD UPTEMP /GET BACK
TAD MCTRLZ /CHECK FOR EOF
SZA CLA /SKIP IF EOF
ISZ UNPACK /BUMP FOR SUCCESSFUL RETURN
TAD UPTEMP /GET CHAR BACK
UNPEOF, ISZ UNPACK /RETURN HERE IF EOF
UNPERR, JMP I UNPACK /RETURN HERE IF FATAL I/O ERROR
/ HERE FOR CHAR 1
UNPAK1, TAD I UNPAKP /GET A WORD FROM THE BUFFER
ISZ UNPAKP /BUMP POINTER FOR CHAR 2
JMS UNPEXT /SET CO-ROUTINE POINTER AND EXIT
/ HERE FOR CHAR 2
TAD I UNPAKP /GET CHAR 2
JMS UNPEXT /SET CO-ROUTINE POINTER AND EXIT
/ HERE FOR CHAR 3
STA /SET AC = -1
TAD UNPAKP /AC = POINTER - 1
DCA UNPAKT /STORE IN TEMP
TAD I UNPAKT /GET PREVIOUS CHAR
AND C7400 /KEEP ONLY BITS 0-3
CLL RTR /SHIFT DOWN TO BITS 4-7
RTR /GOTIT
DCA UNPAKT /SAVE IT
TAD I UNPAKP /GET THE NEXT HALF
AND C7400 /KEEP ONLY BITS 0-3
CLL RTL /GET DOWN TO BITS 8-11
RTL /
RAL /GOTIT
TAD UNPAKT /COMBINE
JMS UNPEXT /EXIT
/ HERE TO CHECK FOR BUFFER EMPTY AND READ IN NEXT BLOCK IF NEEDED
CLA CLL /INSURE CLEAR LINK
ISZ UNPAKP /BUMP BUFFER POINTER
TAD UNPAKP /GET OUR CURRENT POINTER
TAD (-IOBUF-IOSIZ /COMPARE WITH THE END OF BUFFER
CLA /CLEAR JUST THE AC
SNL /IF LINK SET WE ARE PAST END OF BUFFER
JMP UNPAK1 /CONTINUE UNPACKING
ISZ FCBLK /BUMP THE CURRENT BLOCK
ISZ FLEN /BUMP THE FILE LENGTH COUNTER
SKP /NOT END OF FILE
JMP UNPEOF /RETURN END OF FILE HERE
/ ENTER HERE ON FIRST READ CALL FOR FILE INPUT
UNPAK5, TAD [IOBUF /GET ADDRESS OF INPUT BUFFER
MQL /PUT INTO MQ
TAD FCBLK /GET THE FILES CURRENT BLOCK
JMS BLKIN /AND READ IN THE NEXT BLOCK
JMP UNPERR /TAKE I/O ERROR RETURN
TAD [IOBUF /GET ADDRESS OF BEGINNING OF BUFFER
DCA UNPAKP /SET UP POINTER
JMP UNPAK1 /NOW START UNPACKING THIS BUFFER
UNPAKP, 0 /POINTER FOR UNPACK ROUTINE
UNPAKT, 0 /TEMP FOR UNPACK ROUTINE
FCBLK, 0 /FILE CURRENT BLOCK
/ ROUTINE TO INITIALIZE FOR FILE INPUT. THIS ROUTINE SETS UP THE
/ CURRENT BLOCK TO BE READ FROM THE FILE AND SETS THE CO-ROUTINE
/ DISPATCH ADDRESS TO BEGIN READING BYTES FROM THE FILE. CALL THIS
/ ROUTINE AFTER SETTING UP THE FOLLOWING:
/ DEVNUM = OS/8 DEVICE NUMBER
/ FSBLK = STARTING BLOCK NUMBER
/ FLEN = FILE SIZE
INPINT, 0
TAD FSBLK /GET FILES STARTING BLOCK
DCA FCBLK /STORE LOCAL FOR INPUT ROUTINE
TAD (UNPAK5 /GET ADDRESS OF FIRST CO-ROUTINE
DCA UNPEXT /STORE FOR FIRST DISPATCH
JMP I INPINT /INPUT IS INITIALIZED
/ ROUTINE TO WRITE A BYTE TO THE OUTPUT FILE
/ ENTER: AC = BYTE TO WRITE
/ EXIT: + 2 = WRITE SUCCESSFUL
/ + 1 = WRITE NOT SUCCESSFUL
WRIBYT, 0
AND [177 /KILL ANY PARITY BIT
TAD [200 /SET PARITY BIT
JMP I WRIB01 /JUMP INTO CO-ROUTINE
WRIB01, 0 /CO-ROUTINE ADDRESS HERE
ISZ WRIBYT /BUMP RETURN FOR SUCCESS
WRIB02, JMP I WRIBYT /EXIT
WRIB10, JMS WRIB01 /JUMP HERE TO START BYTE 1 NEXT
/ HERE TO WRITE BYTE 1
WRIB11, DCA I WRIBP /STORE BYTE IN BUFFER
ISZ WRIBP /BUMP POINTER
JMS WRIB01 /DONE WITH FIRST
/ HERE TO WRITE BYTE 2
DCA I WRIBP /STORE BYTE IN BUFFER
JMS WRIB01 /DONE WITH SECOND
/ HERE TO WRITE BYTE 3
DCA WRIBT /STORE THE CHAR TEMP
STA /AC = -1
TAD WRIBP /GET BUFFER POINTER
DCA WRIBP /BACK UP POINTER BY 1
TAD WRIBT /GET CHAR BACK
RTL; RTL /SHIFT HIGH BITS OF BYTE UP IN THE WORD
AND C7400 /KEEP ONLY TOP 4 BITS
TAD I WRIBP /COMBINE WITH BYTE IN THE BUFFER
DCA I WRIBP /AND RETURN
ISZ WRIBP /BUMP POINTER
TAD WRIBT /GET CHAR BACK
JMS SWAP
RTL /GET LOW 4 BITS UP
AND C7400 /KEEP ONLY THOSE BITS
TAD I WRIBP /COMBINE
DCA I WRIBP /AND RETURN
ISZ WRIBP /BUMP POINTER AHEAD
CLA CLL /INSURE LINK IS CLEAR
TAD WRIBP /GET CURRENT BUFFER POINTER
TAD (-IOBUF-IOSIZ /CHECK FOR BUFFER FULL
CLA /CLEAR AC, LINK HAS STATUS
SNL /SKIP IF BUFFER FULL
JMP WRIB10 /BUFFER NOT FULL, LEAVE
TAD FCBLK /GET CURRENT BLOCK TO WRITE
JMS BLKOUT /AND WRITE IT
JMP WRIB02 /ERROR WRITING
ISZ OFLEN /BUMP FILE SIZE COUNTER
ISZ FCBLK /BUMP CURRENT BLOCK NUMBER
ISZ FLEN /BUMP DISK ROOM COUNT
SKP /HERE IF MORE ROOM ON DISK
JMP WRIB02 /NO MORE ROOM, ERROR
TAD [IOBUF /GET BUFFER ADDRESS
DCA WRIBP /RE-SET BUFFER POINTER
JMP WRIB10 /BACK TO START OVER
WRIBP, 0 /POINTER FOR FILE WRITE ROUTINES
WRIBT, 0 /TEMP FOR FILE WRITE ROUTINES
OFLEN, 0 /COUNTER FOR OUTPUT FILE LENGTH
/ FILE OUTPUT ROUTINES
/ ROUTINE TO INITIALIZE FOR OUTPUT
/ ENTER: FSBLK = STARTING BLOCK FOR OUTPUT FILE
/ FLEN = MAX SIZE FOR FILE
/ EXIT: NOTHING
INIOUT, 0
TAD [IOBUF /GET BUFFER ADDRESS
DCA WRIBP /PUT INTO POINTER
TAD FSBLK /GET FILE START BLOCK
DCA FCBLK /PUT INTO FILE CURRENT BLOCK
STA /AC = -1
TAD FLEN /GET FILE LENGTH
DCA FLEN /STORE AS -FILE LENGTH -1
DCA OFLEN /INIT ACTUAL FILE LENGTH COUNTER
TAD (WRIB11 /INSURE CO-ROUTINE LINK SET
DCA WRIB01
JMP I INIOUT
PAGE
/ ROUTINE TO FLUSH THE BUFFER AND CLOSE THE OUTPUT FILE
/ ENTER: NOTHING
/ EXIT: + 2 = FILE CLOSE SUCCESSFUL
/ + 1 = FILE CLOSE NOT SUCCESSFUL
CLOSEF, 0
TAD (32 /PUT IN AN EOF
JMP CLO15 /SEND IT FIRST
CLO10, TAD WRIBP /GET CURRENT BUFFER POINTER
TAD (-IOBUF /COMPARE WITH BEGINNING
SNA CLA /SKIP IF BUFFER NOT EMPTY
JMP CLO20 /BUFFER EMPTY, QUIT
CLO15, JMS WRIBYT /WRITE OUT A ZERO
JMP I CLOSEF /ERROR IN WRITING
JMP CLO10 /GO AGAIN
CLO20, TAD OFLEN /GET OUTPUT FILE LENGTH
DCA CLOF1 /PUT INTO CALL
TAD ODNUMB /GET OUTPUT DEVICE NUMBER
CIF 10 /USR IN FIELD 1
JMS I USR /CALL USR
4 /CLOSE FUNCTION
FNBLK /ADDRESS OF FILE NAME BLOCK
CLOF1, 0 /FILE LENGTH HERE
SKP /ERROR HERE
ISZ CLOSEF /BUMP RETURN FOR NO ERROR
CLA CLL /ALWAYS RETURN AC = 0
JMP I CLOSEF
/ ROUTINE TO WRITE THE CURRENT INPUT PACKET TO THE OUTPUT FILE
/ ENTER: NOTHING
/ EXIT: + 2 = WRITE SUCCESSFUL
/ + 1 = WRITE NOT SUCCESSFUL
WRIPAK, 0
TAD RRLEN /GET LENGTH OF PACKET
TAD (RRDTA-40-3 /CACULATE END OF BUFFER
DCA W90 /PUT INTO POINTER
DCA I W90 /ZERO AFTER END OF BUFFER
TAD (RRDTA /GET ADDRESS OF DATA
DCA W90 /PUT INTO POINTER
W10, TAD I W90 /GET A CHAR FROM PACKET
SNA /SKIP IF NOT END
JMP W60 /END, EXIT
CIA /NEGATE FOR COMPARE
TAD RQCTL /COMPARE WITH CURRENT QUOTE CHAR
SNA CLA /SKIP IF NOT QUOTE CHAR
JMP W20 /IS QUOTE, HANDLE SPECIAL
TAD W92 /WAS LAST CHAR A QUOTE?
SZA CLA /SKIP IF NO
TAD (-100 /IT WAS, FIX UP THIS CHAR
JMP W25 /HANDLE REST BELOW
W20, TAD W92 /CURRENT CHAR A QUOTE, CHECK PREVIOUS
SNA CLA /SKIP IF YES
JMP W30 /JUST THIS CHAR IS QUOTE, SET FLAG
W25, TAD I W90 /GET CHAR FROM BUFFER
JMS WRIBYT /SEND TO OUTPUT
JMS I WRIPAK /ERROR IN OUTPUT
JMP W35 /FINISH BELOW
W30, CLA CLL IAC /GOTA SET FLAG FOR QUOTE CHAR
W35, DCA W92 /SET UP QUOTE FLAG
ISZ W90 /BUMP POINTER
JMP W10 /LOOP
W60, ISZ WRIPAK /BUMP RETURN FOR OK
JMP I WRIPAK /DONE
W90, 0 /POINTER FOR "WRIPAK"
W92, 0 /TEMP FOR "WRIPAK"
PAGE
/ SEND PROCESSING
SNDPRO, 0
TAD INIFLG /CHECK IF SEND/INIT HAS BEEN DONE
SZA CLA /SKIP IF NO
JMP SNDP10 /RIGHT INTO FILE TRANSFER
TAD (DEFCK /SET UP DEFAULT CHECKSUM
DCA RCHKT
TAD (DEFEOL /GET DEFAULT EOL
DCA REOL /AND SET IT
TAD (DEFQCTL /GET DEFAULT QUOTE CONTROL CHAR
DCA RQCTL /AND SET IT UP
TAD (DEFMAXL+40 /GET DEFAULT MAX BUFFER SIZE
DCA RMAXL /SET IT UP
DCA CURSEQ /RE-SET SEQUENCE NUMBER
JMS SNDI00 /HANDLE "SEND-INIT"
JMP SNDP80 /ERROR IN "SEND-INIT"
/ SEND FILE HEADER DISPATCH ROUTINE
SNDP10, FPACK /FORMAT A PACKET
NAMBUF /ADDRESS OF FILE HEADER FOR DATA
STFIL /"FIL" PACKET TYPE
SNDP11, SPACK /SEND A PACKET
1 /AWAIT RESPONSE
SNDP96 /DISPATCH TABLE ADDRESS
/ GOT A NAK OR UNDEFINED HERE
SNDP12, ISZ RTRYC /BUMP THE COUNTER
JMP SNDP11 /TRY AGAIN
JMP SNDP80 /ERROR
/ FILE CREATION DATE HANDLING
SNDP15, TAD RCAPAS /CHECK IF REMOTE SUPPORTS FILE
AND (10 / ATTRIBUTES
SNA CLA /SKIP IF YES
JMP SNDP20 /SKIP IF NO
FPACK /FORMAT PACKET
DATBUF /DATE DATA
STATT /"ATT" PACKET TYPE
SNDP16, SPACK /SEND THE PACKET
1 /AWAIT RESPONSE
SNDP98 /DISPATCH TABLE ADDRESS
JMP SNDP80 /NONE OF THE TYPES IN OUR TABLE
/ GOT ACK HERE
SNDP20, CLA CLL
PRI6B; FSMSG /TELL USER WE ARE SENDING A FILE
PRI8B; NAMBUF /TELL THEM THE NAME OF THE FILE
PRI6B; FDAT /TELL THEM THE FILES DATE
PRI8B; FDATE /
JMS DATOUT /OUTPUT THE DATE ON THE FIRST LINE
JMP SNDP80 /ERROR SENDING THE DATE
JMS SLOOP
SKP /ERROR RETURN
ISZ SNDPRO /BUMP FOR NON-ERROR EXIT
JMP I SNDPRO
SNDP80, TAD (SPERR /GET ERROR MESSAGE
JMP I SNDPRO /TAKE ERROR EXIT
/ DATA SEND LOOP
/ ROUTINE TO GET CHARS FROM THE INPUT BUFFER AND SEND THEM TO REMOTE
/ VIA PACKET TRANSFERS. RETURN + 1 IF ERROR, + 2 IF DONE.
SLOOP, 0
JMS INIOPB /INIT OUTPUT PACKET HOLD BUFFER
JMS INPINT /INIT INPUT FILE
SLOP01, JMS UNPACK /UNPACK A CHAR FROM THE BUFFER
JMP SLOP75 /HERE ON FATAL I/O ERROR
JMP SLOP15 /HERE ON EOF
AND C177 /STRIP OFF PARITY BIT FOR NOW
JMS OPBUF /PUT INTO PACKET BUFFER
SKP /RETURN HERE ON BUFFER FULL
JMP SLOP01 /RETURN HERE IF STILL ROOM
/ PACKET IS FULL HERE, WE MUST SEND IT
FPACK /FORMAT A PACKET
HOLDBF /DATA ADDRESS
STDAT /"DAT" PACKET TYPE
SLOP05, SPACK /SEND PACKET
1 /AWAIT RESPONSE
SLOP90 /RESPONSE TABLE ADDRESS
/ HERE ON NAK OR FALL THRU ON UNDEFINED RESPONSE ABOVE
SLOP10, ISZ RTRYC /BUMP THE RE-TRY COUNTER
JMP SLOP05 /TRY AGAIN
JMP SLOP75 /GIVE UP
/ HERE ON END OF FILE -- SEND THEM WHAT WE HAVE
SLOP15, FPACK /FORMAT A PACKET
HOLDBF /ADDRESS OF DATA
STDAT /"DAT" PACKET TYPE
SLOP20, SPACK /SEND A PACKET
1 /AWAIT RESPONSE
SLOP92 /DISPATCH TABLE ADDRESS
/ NAK FOR LAST PACKET
SLOP25, ISZ RTRYC /BUMP RE-TRY COUNTER
JMP SLOP20 /TRY AGAIN
JMP SLOP75 /GIVE UP
/ ACK FOR FINAL PACKET, SEND AN EOF PACKET
SLOP35, JMS SNDP /SEND A PACKET
NODATA /NO DATA
STEOF /MAKE IT AN EOF PACKET
JMP SLOP75 /NAK
JMP SLOP75 /NOT NAK OR ACK
ISZ SLOOP /EOF ACCEPTED, BUMP FOR GOOD RETURN
JMP I SLOOP /TAKE GOOD RETURN
/ JUMP HERE FOR ERROR EXIT
SLOP75, TAD (SPERR /GET ADDRESS OF ERROR MESSAGE
JMP I SLOOP /EXIT
SLOP90, STACK; SLOP01 /ACK, CONTINUE
STNAK; SLOP10 /NAK, HANDLE
0
SLOP92, STACK; SLOP35 /ACK, CONTINUE
STNAK; SLOP25 /NAK, HANDLE
0
PAGE
/ COMMAND DISPATCH TABLE FOR SEND SERVICE
SNDP96, STACK; SNDP15 /FILE HEADER ACKNOWLEDGED
STNAK; SNDP12 /NAK RETURNED, RE-TRY
0 /END OF TABLE
SNDP98, STACK; SNDP20 /DATE ATTRIBUTE ACKNOWLEDGED
0 /END OF TABLE
/ ROUTINE TO HANDLE A "SEND-INIT" COMMAND
/ RETURN + 1 IF ERROR
/ RETURN + 2 IF SUCCESSFUL
SNDI00, 0
FPACK /FORMAT A PACKET
INIDAT /ADDRESS OF DATA FOR PACKET
STSIN /"SIN" PACKET TYPE
SNDI02, SPACK /SEND A PACKET
1 /AWAIT RESPONSE
SNDI80 /RESPONSE TABLE TYPE
/ HERE ON NAK OR UNDEFINED
SNDI05, ISZ RTRYC /BUMP RE-TRY COUNTER
JMP SNDI02 /TRY AGAIN
JMP I SNDI00 /TAKE ERROR EXIT
/ HERE ON ACK
SNDI10, JMS SETINI /SET UP THE INIT REGISTERS
CLA CLL IAC /NOW FLAG THE SEND/INIT DONE
DCA INIFLG /BY MAKING THIS NON-ZERO
ISZ SNDI00 /BUMP FOR NON-ERROR RETURN
JMP I SNDI00 /BACK TO MAIN SEND PROCESSING
SNDI80, STACK; SNDI10 /GOT AN ACK
STNAK; SNDI05 /NAK
0 /END OF TABLE
/ ROUTINE TO MOVE THE SEND/INIT OR RECEIVE/INIT PACKET INTO THE
/ INIT REGISTERS
SETINI, 0
TAD (RMAXL /GET ADDRESS OF RECEIVE INIT REGISTERS
MQL /SAVE FOR "CLEAR" ROUTINE
TAD (RMAXL-RCAPAS-1 /GET MINUS LENGTH OF # OF REGISTERS
CLEAR /CLEAR OUT
TAD (RMAXL /GET ADDRESS OF RECEIVE INIT REGISTERS
MQL /SAVE FOR "MOVE" ROUTINE
TAD RRLEN /GET LENGTH OF PACKET JUST INPUT
TAD (-40-4 /COUNT OF DATA RECEIVED
CIA /MAKE IT NEGATIVE
DCA MOVE4 /SAVE FOR "MOVE" ROUTINE
TAD (RRDTA /ADDRESS OF DATA IN PACKET
MOVE /MOVE THE INIT REGISTERS
JMP I SETINI /DONE
/ ROUTINE TO SEND THE DATE IN A DATA PACKET
/ RETURN + 1 IF ERROR, + 2 IF SUCCESSFUL
DATOUT, 0
JMS INIOPB /INSURE PACKET HOLD BUFFER INITIALIZED
TAD (SETDAT /GET ADDRESS OF DATE
DCA DATOU9 /PUT INTO POINTER
DATOU1, TAD I DATOU9 /GET A CHAR
ISZ DATOU9 /BUMP POINTER
SPA /SKIP IF NOT ENT
JMP DATOU2 /DONE
JMS OPBUF /PUT INTO HOLD BUFFER
SKP /HOLD FULL, SEND IT
JMP DATOU1 /LOOP
DATOU2, CLA CLL /INSURE CLEAR AC
FPACK /FORMAT A PACKET
HOLDBF /DATA ADDRESS
STDAT /DATA PACKET
DATOU3, SPACK /SEND THE PACKET
1 /GET RESPONSE
DATOU7 /DISPATCH TABLE ADDRESS
/ HERE ON NAK OR UNDEFINED RESPONSE
DATOU4, ISZ RTRYC /BUMP RE-TRY COUNTER
JMP DATOU3 /TRY AGAIN
JMP I DATOUT /ABORT
/ HERE ON ACK
DATOU5, ISZ DATOUT /BUMP FOR GOOD RETURN
JMP I DATOUT /EXIT
DATOU7, STACK; DATOU5 /ACK
STNAK; DATOU4 /NAK
0
DATOU9, 0 /TEMP POINTER FOR DATOUT
/ HANDLE AN ABORT REQUEST
ABORT, CLA CLL /INSURE CLEAR AC
DCA CCFLAG /RE-SET THIS FLAG
TAD KMODE /GET CURRENT MODE
TAD (-MSEND /IS IT A SEND?
SZA /SKIP IF YES
JMP ABORT2 /NOT SEND
JMS SNDP /SEND OUT A PACKET
ABORT9 /WHICH HAS A "D" IN THE DATA
STEOF /AND IS AN EOF PACKET
NOP /WE GOT NAK BACK HERE
NOP /WE GOT NEITHER NAK OR ACK HERE
JMS BRKXMT /BREAK THE SEND
JMP ABORT3 /FINISH THE ABORT
ABORT2, TAD (MSEND-MREC /CHECK IF IN RECEIVE MODE
SZA CLA /SKIP IF YES
JMP ABORT3 /JUST BACK TO COMMAND LOOP
JMS SNDP /SEND A PACKET BACK FOR AN ABORT
ABORT8 /WHICH HAS AN "X" IN THE DATA
STACK /MAKE IT AN ACK PACKET
NOP /NAK HERE
NOP /NOT NAK OR ACK HERE
ABORT3, TAD (CCABRT /GET ADDRESS OF ERROR MESSAGE
JMP CLOOP7 /DISPLAY THE ABORT
ABORT8, "Z&137 /DATA PACKET FOR RECEIVE ABORT
-1
ABORT9, "D&137 /DATA PACKET FOR SEND ABORT
-1
CCABRT, TEXT "CONTROL/C ABORT@M@J@"
PAGE
/ ROUTINE TO PRINT 6 BIT BYTES ON THE TTY. ENTER WITH THE ADDRESS OF
/ THE TEXT IN THE AC OR IN THE CALL + 1.
PRI6B0, 0
SZA /SKIP IF TEXT ADDRESS AT CALL + 1
JMP PRI6B1 /ADDRESS IN THE AC
TAD I PRI6B0 /GET THE ADDRESS
ISZ PRI6B0 /BUMP THE RETURN
PRI6B1, MQL /SAVE IN THE MQ REGISTER
TAD (OTTY /GET ADDRESS OF THE TTY OUTPUT ROUTINE
JMS SIXB /DO THE PRINT
JMP I PRI6B0 /DONE
/ SIX BIT TEXT REMOTE OUTPUT ROUTINE
/ ROUTINE TO OUTPUT FROM 6 BIT STORAGE TO THE REMOTE LINE. ENTER WITH
/ THE ADDRESS OF THE TEXT IN THE AC OR WITH A CLEAR AC THE ADDRESS IS
/ AT THE CALL + 1
REM6B0, 0
SZA /SKIP IF ADDRESS AT CALL + 1
JMP REM6B1 /ADDRESS IN THE AC
TAD I REM6B0 /GET ADDRESS AT CALL + 1
ISZ REM6B0 /BUMP THE RETURN
REM6B1, MQL /PUT ADDRESS IN MQ REGISTER
TAD (OREM /GET ADDRESS OF REMOTE OUTPUT ROUTINE
JMS SIXB /DO THE OUTPUT
JMP I REM6B0 /DONE
/ SIX BIT TEXT PRINT ROUTINE
/ ENTER WITH ADDRESS OF TEXT IN AC AND THE ADDRESS OF THE OUTPUT
/ ROUTINE TO USE IN THE MQ REGISTER
/ A NULL BYTE SIGNALS A CONTROL CHAR IS NEXT
/ TWO NULL BYTES SIGNAL END OF TEXT
SIXB, 0
DCA SIXBP /AND STORE IN A LOCAL POINTER
MQA /GET THE OUTPUT ROUTINE ADDRESS
DCA GET6P /STORE ADDRESS IN POINTER
DCA GET6F /INIT BYTE FLAG
SIXB1, GET6 /GET A BYTE FROM THE STRING
SNA /SKIP IF NOT NULL
JMP SIXB3 /HANDLE CONTROL CHAR
TAD (240 /CONSTRUCT PROPER ASCII
AND C77
TAD (240
SIXB2, JMS I SIXBP /AND SEND
CLA CLL /INSURE CLEAR AC
JMP SIXB1 /LOOP
SIXB3, GET6 /GET BYTE FOLLOWING NULL BYTE
SNA /SKIP IF IS A CONTROL BYTE
JMP I SIXB /GOT END OF STRING
TAD (200 /CONSTRUCT A CONTROL CHAR
JMP SIXB2 /AND GO PRINT
SIXBP, 0 /POINTER USED IN THE "SIXB" ROUTINE
/ ROUTINE TO PRINT 8 BIT CHARS ON THE TTY. ENTER ROUTINE WITH THE
/ ADDRESS OF THE TEXT IN THE AC OR IF AC IS ZERO THE ADDRESS IS IN
/ THE CALL + 1. TEXT TERMINATES ON A MINUS WORD.
PRI8B0, 0
SZA /SKIP IF ADDRESS NOT IN AC
JMP PRI8B1 /ADDRESS IS IN THE AC
TAD I PRI8B0 /GET ADDRESS FROM CALL + 1
ISZ PRI8B0 /BUMP RETURN POINTER
PRI8B1, MQL /SAVE ADDRESS IN MQ
TAD (OTTY /GET ADDRESS OF TTY OUTPUT ROUTINE
JMS EIGHTB /AND SEND IT
JMP I PRI8B0 /ALL DONE
/ ROUTINE TO SEND 8 BIT CHARS DOWN THE REMOTE LINE. ENTER ROUTINE WITH
/ THE ADDRESS OF THE TEXT IN THE AC OR IF AC IS ZERO THE ADDRESS IS IN
/ THE CALL + 1. TEXT TERMINATES ON A MINUS WORD.
REM8B0, 0
SZA /SKIP IF ADDRESS NOT IN AC
JMP REM8B1 /ADDRESS IN AC
TAD I REM8B0 /GET ADDRESS FROM CALL + 1
ISZ REM8B0 /BUMP RETURN
REM8B1, MQL /PUT ADDRESS IN MQ
TAD (OREM /GET ADDRESS OF REMOTE OUTPUT ROUTINE
JMS EIGHTB /AND SEND THE STRING
JMP I REM8B0 /DONE
/ ROUTINE TO SEND 8 BIT DATA
/ ENTER WITH ADDRESS OF DATA IN THE MQ AND THE ADDRESS OF THE ROUTINE
/ TO TAKE EACH BYTE IN THE AC. TEXT TERMINATES ON A MINUS WORD.
EIGHTB, 0
DCA EIGHT5 /STORE POINTER TO ROUTINE
MQA /GET THE POINTER TO THE TEXT
DCA EIGHT6 /STORE IN LOCAL POINTER
EIGHT1, TAD I EIGHT6 /GET A CHAR
ISZ EIGHT6 /BUMP THE POINTER
SPA /SKIP IF NOT EOL
JMP EIGHT2 /GOT EOL
JMS I EIGHT5 /CALL OUTPUT ROUTINE
CLA CLL /INSURE CLEAR AC
JMP EIGHT1 /LOOP
EIGHT2, CLA CLL /CLEAR THE AC
JMP I EIGHTB /DONE
EIGHT5, 0 /POINTER TO ROUTINE TO DO OUTPUT
EIGHT6, 0 /POINTER TO TEXT TO OUTPUT
/ ROUTINE TO UNPACK 6 BIT CHARS FROM MEMORY
/ BEFORE CALLING INIT "GET6P" AS A POINTER TO THE STRING LOCATION
/ AND "GET6F" SHOULD BE ZEROED TO START WITH THE TOP BYTE OF THE
/ FIRST MEMORY LOCATION.
GET60, 0
CLA CLL CML RAR /SET AC=4000, LINK=0
TAD GET6F /GET THE FLAG
DCA GET6F /RETURN THE FLAG
TAD I GET6P /GET TWO BYTES
SZL /SKIP IF TOP BYTE
ISZ GET6P /BOTTOM BYTE, PREPARE FOR NEXT TOP
SNL /SKIP IF BOTTOM BYTE
JMS SWAP /GET TOP BYTE INTO BOTTOM
AND C77 /STRIP UNUSED BITS
JMP I GET60 /DONE
/ LOCAL ROUTINE TO "FILN8" TO MAKE THE 6 BIT CHAR IN THE AC INTO
/ 8 BITS AND STORE IN A STRING
MOV8, 0
SNA /SKIP IF NOT A NULL CHAR
TAD (" &77 /PUT IN A SPACE IF NULL
TAD (240 /CONVERT BACK TO 8 BIT
AND C77
TAD (240
AND C177 /CLEAR BIT 7
DCA I MOV8P /PUT IN THE LINE
ISZ MOV8P /BUMP POINTER
JMP I MOV8 /DONE
MOV8P, 0 /POINTER FOR "MOV8" ROUTINE
/ ROUTINE TO PULL A FILE NAME IN 6 BIT POINTED TO BY THE
/ AC AND PLACE IN THE FILE NAME BUFFER IN 8 BIT ADDING IN
/ THE "." TO SEPERATE FILE NAME AND EXTENSION. A MINUS WORD
/ WILL FOLLOW THE NAME
FILN8, 0
DCA GET6P /SET POINTER FOR "GET6"
DCA GET6F /SET FLAG FOR "GET6"
TAD (NAMBUF /GET ADDRESS OF THE NAME BUFFER
DCA MOV8P /SET IN A POINTER
TAD (-6 /6 NAME CHARS TO DO
DCA FILN8C /SAVE IN COUNTER
GET6 /PULL A CHAR
SZA /SKIP IF A SPACE
JMS MOV8 /PUT INTO THE BUFFER
ISZ FILN8C /BUMP COUNTER
JMP .-4 /LOOP TILL ALL 6 DONE
TAD (".&77 /GET A PERIOD
JMS MOV8 /PUT WITH FILE NAME
CLA CLL CMA RAL /AC = -2
DCA FILN8C /2 EXTENSION CHARS
GET6 /GET NEXT CHAR
SZA /SKIP IF A SPACE
JMS MOV8 /PUT WITH NAME
ISZ FILN8C /BUMP COUNTER
JMP .-4 /LOOP
STA /AC = -1
DCA I MOV8P /TERMINATE THE STRING
JMP I FILN8 /AND RETURN
FILN8C, 0 /COUNTER FOR "FILN8"
PAGE
/ PARSE TABLES
TMPTBL,
"C; "O; "N; "N; "E; "C; "T
-1 /MARK END OF THIS ENTRY
CONSRV /SERVICE DISPATCH ADDRESS
"B; "Y; "E
-1 /MARK END OF THIS ENTRY
BYESRV /SERVICE DISPATCH ADDRESS
"E; "X; "I; "T
-1 /MARK END OF THIS ENTRY
OS8 /SERVICE DISPATCH ADDRESS
"S; "E; "N; "D
-1 /END OF THIS ENTRY
SNDSRV /SERVICE ADDRESS
"G; "E; "T
-1 /END OF THIS ENTRY
GETSRV /SERVICE ADDRESS
"R; "E; "C; "E; "I; "V; "E
-1 /MARK END OF THIS ENTRY
RECSRV /SERVICE ADDRESS
-1 /MARK END OF THE TABLE
/ KEYBOARD LINE BUFFER
LINBUF, ZBLOCK LINSIZ /LINE BUFFER
/ REMOTE PACKET INPUT BUFFER
RRBUF, 0 /MARK
RRLEN, 0 /PACKET LENGTH
RRSEQ, 0 /PACKET SEQ
RRTYP, 0 /PACKET TYPE
DECIMAL
RRDTA, ZBLOCK 91 /DATA GOES HERE
OCTAL
/ REMOTE PACKET OUTPUT BUFFER
RSBUF, SOH /PACKET BUFFER (BEGINS WITH "SOH")
RSLEN, 0 /PACKET LENGTH GOES HERE
RSSEQ, 0 /PACKET SEQUENCE GOES HERE
RSTYP, 0 /PACKET TYPE GOES HERE
DECIMAL
RSDTA, ZBLOCK 91 /DATA GOES HERE
0 /CHECKSUM HERE ON MAX PACKET
0 /EOL (IF USED HERE ON MAX PACKET)
0 /INTERNAL TERMINATOR HERE ON MAX PACKET
OCTAL
/ FILE NAME BUFFER
NAMBUF, ZBLOCK 12 /ROOM FOR FILE NAME, EXTENSION AND TERMINATOR
/ SEND-INIT PACKET DEFINITION
INIDAT, DECIMAL
94+32 /94 CHARS MAX
OCTAL
" &177 /NO TIME-OUT
" &177 /NO PADDING
0+100&177 /NO PADDING CHAR
" &177+15 /CR FOR EOL
"#&177 /QUOTE CHAR
"N&137 /NO 8TH BIT QUOTING
"1&177 /CHECK TYPE 1
" &177 /NO REPEAT CHAR
" &177+0 /NO EXTRA CAPABILITY
NODATA, -1 /END OF DATA (USE THIS FOR SENDING NO-DATA)
/ TEXT STORAGE
PROMPT, TEXT "@M@JKERMIT-8>@"
ERRMSG, TEXT "COMMAND ERROR@M@J@"
CRLF, TEXT "@M@J@"
FDAT, TEXT " CREATED ON @"
FSMSG, TEXT "SENDING FILE @"
FRMSG, TEXT "RECEIVING FILE @"
CONMSG, TEXT "@M@J[CONNECTING TO HOST, TYPE ^\C TO RETURN TO PDP8]@M@J@"
CONEXT, TEXT "@M@J[BACK AT PDP8]@M@J@"
NOBYE, TEXT "KERMIT SERVER BYE FAILURE@M@J@"
EXTXT, TEXT "KERMIT EXIT@M@J@"
RUBOUT, TEXT "@H @H@"
BEEP, TEXT "@G@"
DEVERR, TEXT "DEVICE NAME ERROR@M@J@"
NOFND, TEXT "FILE NOT FOUND@M@J@"
RECERR, TEXT "RECEIVE FAILED@M@J@"
DIOERR, TEXT "DIRECTORY I/O ERROR@M@J@"
HFERR, TEXT "HANDLER FETCH ERROR@M@J@"
STXERR, TEXT "COMMAND SYNTAX ERROR@M@J@"
SPERR, TEXT "SEND PROCESS ERROR@M@J@"
FPERR, TEXT "FATAL PACKET ERROR@M@J@"
$$$$$$$$$$