File MACIO.MA (MACREL macro assembler source file)

Directory of image this file is from
This file as a plain text file

/19 MACREL I/O MODULE	POST FT 1
/	29-AUG-78	IGNORE SOFT ERROR FROM HANDLER
	.INCLUDE MGLOB.MA
	.ASECT MACIOZ
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/

.EXTERNAL ASEMLV,BACKUP,BRANCH,CREF,CRLF,DPRINT,ENTER,EOS,ERROR,EXPR .EXTERNAL FSCHEK,GETCHR,GETKAR,GETSYM,LETTER,LISTER,LOOKUP,ORIG,OUT,PARSYM .EXTERNAL PASS3,POP,PUSH,PUNBIT,PUTBIT,PUTSYM,PUXBIN,READLN,ROTL6,SCAN .EXTERNAL NXTRET,ERROR,CALLIT,GETSYM .EXTERNAL OUTHAN,INHAND .GLOBAL LINBUF,LOOKLN,LOOKU,CLOSO,OPTR1,CHAINI,DVNO,FILENO,FILSAV .GLOBAL IOINIT,IONIT2,KFFILE,LOCOFF,OUTBUF,OUTLOC,QPUT .GLOBAL RBFILE,LISTOR,CLNAME,HOLSIZ,LSTRET,TXTBLK .GLOBAL INHNDL,INLEN,INREC,SPOP,SPUSH,USRSTK,EXPSTK .GLOBAL OUTCNT,OUTDEV,OUTHND,OUTKNT,OUTLST,OUTREC,OUTSIZ .GLOBAL FINIO,ORET,READOS,ZRET,MHIGH,MLOW,STREAM .GLOBAL MARGS,PAGE0,CURPAG .GLOBAL IO1,IO2,IO3,IO4,IO5,IO6,IO8,IO9,IO10 .EXTERNAL AT /CAN'T WIPE OUT PAGE 5400 BY ERROR STUFF /OR OUTPUT BUFFER (3400-3777) / 13-JAN-77 SR MOVED ARGUMENT TABLE TO FIELD 'ATFLD%10' FIELD 1 *20 0/OPTR, 0 /POINTS INTO OUTPUT SPECIFICATION /LIST 0/OUTLEN, 0 OUTDEV, 0 0/OUTEXT, 0 /DEFAULT OUTPUT EXTENSION 0/OUTL, 0 /NEG OF OUTPUT BUFFERLENGTH (IN WDS OR DBL WDS) 0/OUTB, 0 /START OF OUTPUT BUFFER INHNDLR,0 OPTR1, 0 OUTCNT, -OUTPRS /PERMANENT COPY OF INITIAL VALUE OF OUTKNT /IS THIS NEEDED? OUTCNT PROBABLY NOT USED FOR BINARY RBFILE, 0 /STARTING BLOCK OF .RB FILE OUTLOC, 0 /FIRST BLOCK OF OUTPUT FILE OUTKNT, -OUTPRS /NEGATIVE OF COUNT OF /# OF DOUBLE WORDS (FOR ASCII) /NEG OF LENGTH OF BUFFER (FOR BINARY) /OPTR2, 0 OUTHNDLR,0 HOLSIZ, 0 /LENGTH OF HOLE AVAILABLE FOR /OUTPUT FILE (NEGATIVE) OUTSIZ, 0 /LENGTH OF OUTPUT FILE OUTSZ, 1 /LENGTH JUST WRITTEN
OBUFLD=10 *40 / LOCAL VARIABLES TO OGET (CONTEXT BLOCK) /MUST BE KEPT TOGETHER, THE FIRST 11 ITEMS HERE UNIQUELY /DETERMINE THE STATE OF THE INPUT HANDLER /THEY ARE PUSHED AND POPPED BY SWITCH /(THEY ARE USED TO GET BACK BUFFER AND HANDLER AND 'INHNDLR' OLOCAL, -10 /8 LOCAL VARIABLES TO 'OGET' INREC, 0 /INPUT RECORD NUMBER /THIS ITEM MUST BE FIRST BECAUSE IT CAN'T /BE 0 AT THE TIME AN 'INCLUDE' OCCURS BUFKNT, 0 /NEGATIVE OF NUMBER OF DOUBLE /WORDS LEFT /TO BE READ FROM OS/8 INPUT BUFFER INSIZ, 0 /NO. OF BLOCKS JUST READ DVNO, 0 /OS/8 INTERNAL DEVICE # FOR CURRENT INPUT DEVICE OS8WD1, 0 /WORD 1 OF INPUT PAIR OS8WD2, 0 /WORD 2 OF INPUT PAIR INLEN, 0 /NO. OF BLOCKS LEFT TO BE READ /IN CURRENT OS/8 FILE OS8PTR, 0 /POINTS TO INPUT BUFFER DOUBLE-WORD (TRIPLE CHARS) / 4 MORE WORDS MAY GO HERE WHEN WE WANT TO PRESERVE INCLUDED FILENAME /--------------------------------------- / 'OWN' VARIABLES TO OGET FILENO, 0 FILSAV, 0 /----- ORIGSZ, 0 /ORIGINAL SIZE OF INPUT FILE KFFILE, 0 /STARTING BLOCK OF .KF FILE TXTBLK, 0
.ASECT MACIO FIELD 1 *200 MPCUR=0 /"MGET" STREAM COROUTINE HEADER MRET /STANDARD MLOCAL /STANDARD MSTART /STANDARD 0 /NO FIXUP ROUTINE MGET, JMP I MRET /STANDARD MRET, 0 /STANDARD CIF CDF 0 /STANDARD JMP I [NXTRET /STANDARD /LOCAL VARIABLES FOR MGET MLOCAL, -11 /NUMBER OF LOCAL VARS MG1, 0 /INPUT: POINTER TO FIRST CELL; ADDR OF CHAR MG2, 0 /7 DATA WORDS COUNTER MG5, 0 /POINTER TO NEXT CELL MCNTR, 0 /NUMBER OF CHARS RETRIEVED FROM MACRO SPACE MLOW, 0 /IGNORE CHARS BELOW THIS MHIGH, 0 /STOP AFTER THIS CHAR MARGS, 0 /NUMBER OF ARGUMENTS /NOTE: "MG3" IS A SUBROUTINE FOR MGET, BUT ITS FIRST TWO /WORDS ARE ALSO INCLUDED IN MGET'S LOCAL VARIABLES LIST. / M G 3 /READ THE CURRENT CHAR (FULL WORD) FROM MACRO SPACE. MG3, 0 MG4, CDF /THIS IS SET IN "MGS1" BELOW. TAD I MG1 CDF 10 /BACK TO PRESENT FIELD JMP I MG3 /IMPORTANT NOTE: / MG1-3 ARE ALSO USED AS TEMPORARY LOCATIONS BY MGET IN / PROCESSING SPECIAL CHARACTERS (SEE BELOW).
/ M G E T /CHARACTER STREAM COROUTINE TO FETCH CHARS FROM MACRO SPACE /USED FOR GETTING MACRO BODIES, MACRO SUBSTITUTED ARGUMENTS, /AND REPEAT RANGES. /INITIALIZE TO READ CHARS FROM MACRO SPACE MSTART, MGT1, CDF 0 /INCREMENT MACRO SPACE OPERATION LEVEL COUNT ISZ I (MACLEV) CDF 10 /BACK TO PRESENT FIELD DCA MCNTR MGT1A, JMS I (MGS1 /INITIALIZE INPUT CELL FOR STORAGE MGT2, ISZ MG1 /NEXT WORD IN CURRENT CELL JMS MG3 /READ THE CHARACTER MGT2C, SPA /IS IT A SPECIAL (NON-ASCII, INTERNAL) CHAR? JMP MGT3 /YES: PROCESS IT JMP I (CMPARE /CHECK CHARACTER LIMITS MGT2B, JMS MRET /NO: RETURN THE CHAR TO COROUTINE CALLER /NEXT, CONTINUE AT THE NEXT CHAR MGT2A, JMS MGRAB /GET A CHARACTER JMP MGT2C JMPTEM, MGRAB, 0 ISZ MG2 /COUNT UP TO 7 WORDS JMP GRAB2 /OKAY, PROCESS THE CHAR TAD MG5 /GET NEXT CELL POINTER SNA /IS THERE ANOTHER CELL IN THE LIST? /NO: DECLARE INTERNAL (SYSTEM) ERROR, WITH /NO CONTINUATION POSSIBLE. JMP I (FATAL /NOTE: DO NOT CONTINUE PAST ERROR. DCA MG1 /SET TO CONTINUE AT NEXT CELL JMS I (MGS1 /INITIALIZE NEW CELL AND CONTINUE GRAB2, ISZ MG1 /NEXT WORD JMS MG3 /READ IT JMP I MGRAB /SPECIAL CHARACTERS PROCESSING /WHICH CHAR IS IT? MGT3, CLL RAL /BIT 1 TO SIGN SMA JMP ARGN /ARG MARKER 4000+N RAR /OTHER 777N AND (7 /GET N TAD (JMPTAB DCA JMPTEM TAD I JMPTEM DCA JMPTEM JMP I JMPTEM
/NOT ANY OF THESE: IT MUST BE THE "ARG N" CHAR, WHICH INDICATES /SUBSTITUTION OF MACRO ARGUMENT N (CURRENT A.T. LEVEL) AT THIS POINT. /LOOK UP NTH ARGUMENT IN THE CURRENT LEVEL OF A.T. ARGN, CDF MPCUR /NUMBER IS ALREADY TIMES 2 WHICH IS GOOD /BECAUSE A.T. CONSISTS OF PAIRS TAD I (AT1) /ADD IN CURRENT A.T. BASE CDF 10 /BACK TO PRESENT FIELD DCA MG3 /TEMP LOC CDF ATFLD TAD I MG3 /GET NTH ARG FIRST CELL POINTER CDF 10 SNA CLA /TEST FOR NULL /IF NTH ARG IS 0, THERE IS NONE: JUST IGNORE THIS "ARG N" CHAR AND CONTINUE JMP MGT2A /IF THERE IS AN NTH ARG, RECURSIVELY CONTINUE AT THAT ARG, PREVIOUSLY /STORED (AT 2.1 ABOVE) IN MACRO SPACE /SWITCH TO MGET RECURSIVELY TAD (MGT2A) /SET TO CONTINUE THIS SCAN WHEN RECURSIVE DCA MRET /(ACTUAL ARG) INSTANCE OF MGET TERMINATES. JMS I [SWITCH MGET /SET NEW INSTANCE OF MGET TO FIRST CELL POINTER TO ARGUMENT N WHICH /WAS JUST OBTAINED FROM THE A.T. CDF ATFLD TAD I MG3 CDF 10 DCA MG1 /INITIAL CELL /CONTINUE NOW IN THE NEW INSTANCE OF MGET JMS I (FIXCOM /SET LIMITS JMP MGT1
/PROCESS END-OF-MACRO-BODY CHAR /RETURN ALL A.T. ARGS (THIS LEVEL) TO FREE LIST MGT4, CDF MPCUR TAD I (AT1) /GET A.T. BASE CDF 10 /BACK TO PRESENT FIELD DCA MG1 /TEMP LOC TAD (-MAXRGS) /NR OF ARGS DCA MG2 /TEMP LOC MGT5, CDF ATFLD TAD I MG1 /GET FIRST CELL POINTER OF THIS ARG CDF 10 /BACK TO PRESENT FIELD SNA /0 MEANS THAT NO ARG WAS STORED, JMP MGT6 /SO THERE ARE NO MORE ARGS TO RETURN: GO ON. DCA I (DE1) /FIRST CELL ARG FOR "DELETE" ISZ MG1 /2ND WORD OF A.T. ENTRY CDF ATFLD TAD I MG1 /GET LAST CELL POINTER OF THIS ARG CDF 10 ISZ MG1 /NEXT A.T. ENTRY DCA I (DE2) /LAST CELL ARG FOR "DELETE" JMS I [DELETE /DELETE ARG, STORED AS A LIST IN MACRO SPACE ISZ MG2 /ARE THEIR MORE ARGS TO DELETE? JMP MGT5 /YES: CONTINUE MGT6, CDF MPCUR /NO: HAVE WE BEEN OPERATING IN THE TAD I (OV1) /DEGRADED MODE (OV1 NON-ZERO) CAUSED BY TOO SNA /MANY LEVELS OF MACRO NESTING? JMP MGT6A /NO: NORMAL OPERATION. TAD (-1) /YES: DECREMENT COUNT OF SUCH LEVELS DCA I (OV1) /AND LEAVE LEVEL WHERE IT IS (IT IS AT JMP MGT6B /THE MAXIMUM POSSIBLE LEVEL). MGT6A, TAD (-MAXRGS^2) /POP LEVEL OF A.T. TAD I (AT1) /CURRENT A.T. BASE DCA I (AT1) MGT6B, CDF 10 /BACK TO PRESENT FIELD /FALL THROUGH TO EORR PROCESSING /PROCESS END-OF-REPEAT-RANGE CHAR /ALSO PROCESS END-OF-ARGUMENT CHAR MGT7, CDF 0 /DECREMENT MACRO SPACE OPERATION LEVEL COUNT STA TAD I (MACLEV) DCA I (MACLEV) CDF 10 /BACK TO PRESENT FIELD JMS I [SWBACK] /SWITCH BACK TO PREVIOUS STREAM. JMP I [STRJMP] PAGE
/"RGET" STREAM COROUTINE HEADER RRET /STANDARD RLOCAL /STANDARD RSTART /STANDARD 0 /NO FIXUP ROUTINE RGET, JMP I RRET /STANDARD RRET, 0 /SR CIF CDF 0 /STANDARD JMP I [NXTRET /STANDARD /LOCAL DATA FOR "RGET" RLOCAL, -3 /3 VALUES FOLLOW V, 0 /NUMBER OF TIMES TO EXPAND REPEAT RANGE R, 0 /POINTER TO (FIRST CELL OF) REPEAT RANGE IN MACRO SPACE S, 0 /POINTER TO LAST CELL OF REPEAT RANGE / R G E T /CHARACTER STREAM COROUTINE TO TEST AND DECREMENT REPEAT VALUE, /USING "MGET" TO RETRIEVE REPEAT RANGE FOR EACH REPETITION. RSTART, RG1, CLL STA /DECREMENT VALUE TAD V SNL /WAS V=0? JMP RG2 /YES: TERMINATE REPETITION DCA V /NO: STORE NEW REPETITION VALUE JMS I [SWITCH /SWITCH STREAM TO "MGET" TO GET CHARS MGET /FROM THE REPEAT RANGE BEING EXPANDED. TAD R /SET MGET TO START AT FIRST CELL DCA I (MG1) /OF REPEAT RANGE. DCA I (MLOW DCA I (MHIGH JMP I [STRJMP] /CONTINUE IN "MGET" /NO MORE REPETITIONS TO BE EXPANDED RG2, CLA /DELETE REPEAT RANGE FROM MACRO SPACE. TAD R /FIRST CELL FOR DELETION DCA DE1 TAD S /LAST CELL FOR DELETION DCA DE2 JMS I [DELETE /RETURN ALL CELLS TO FREE LIST. JMS I [SWBACK /SWITCH BACK TO PREVIOUS STREAM JMP I [STRJMP /AND CONTINUE THERE.
/ C O N V /CONVERT CELL POINTER TO CDF, ADDRESS PAIR / CALLING SEQUENCE: / JMS CONV / ARG / INPUT: AC=CELL POINTER (DEFINED ABOVE) / ARG=LOCATION FOR CDF INSTRUCTION / OUTPUT: AC=ADDRESS OF 1ST WORD OF CELL / (ARG)=CDF TO 1ST WD OF CELL CONV, 0 DCA CV1 /SAVE AC TAD I CONV /GET ARG ISZ CONV DCA CV2 /SAVE ARG TAD CV1 RTR RTR RTR AND (0070 /IN CORRECT POSITION FOR CDF TAD KCDF /CONSTRUCT CDF DCA I CV2 /STORE IN PROPER PLACE TAD CV1 /GET ADDR OF CELL RTL RAL AND (7770 /ONLY 9 BITS JMP I CONV /DONE /DATA CV1, 0 /AC CV2, 0 /CDF ADDR
/ D E L E T E /DELETE A STRING OF CHARS (WORDS) FROM MACRO SPACE / INPUT: DE1=POINTER TO FIRST CELL IN LIST / DE2=POINTER TO LAST CELL IN LIST DELETE, 0 /CONVERT LAST POINTER TO ADDR, CDF PAIR TAD DE2 /GET LAST POINTER JMS CONV DE3 /LOC FOR CDF DCA DE2 /SAVE ADDR OF LAST CELL'S LINKAGE WORD /HOOK DELETED LIST INTO FREE LIST /FIRST, HOOK PRESENT FREE LIST ONTO TAIL OF GIVEN LIST CDF 0 TAD I (FREEPTR DE3, CDF /THIS IS SET BY CONV ABOVE DCA I DE2 /NOW, HOOK HEAD OF RESULTING LIST INTO THE FREE LIST POINTER TAD DE1 KCDF, CDF 0 DCA I (FREEPTR) CDF 10 JMP I DELETE /DONE /DATA FOR DELETE DE1, 0 /INPUT: FIRST CELL OF LIST DE2, 0 /INPUT: LAST CELL OF LIST; ADDR OF LINKAGE WORD
/****** NOTE: THIS ROUTINE DOES NOT BELONG TO MACRO CODE ZINIT, 0 DCA I (ORET /SET 'RETURN' TO 0 DCA I (ZRET / I N I T M P /INITIALIZE MACRO PROCESSOR AT START OF EACH PASS TAD (AT-MAXRGS-MAXRGS /INITIALIZE ARGUMENT TABLE (A.T.) LEVEL TO 0 CDF 0 DCA I (AT1 /MAIN A.T. POINTER DCA I (OV1 /OVER-NESTED MACRO CALL COUNT CDF 10 DCA I (MRET /MARK MRET 'UNUSED' DCA RRET /MARK RRET 'UNUSED' DCA I (STRSTK+1 JMS I [SWITCH ZGET JMP I ZINIT FATAL, CIF 0 IO5, JMS I [ERROR /FATAL MACRO-PROCESSOR ERROR JMP I [ABORT
/SUBROUTINE FOR "MGET" / M G S 1 /INITIALIZE READING FROM MACRO SPACE MGS1, 0 TAD I (MG1 /FIRST CELL FOR INPUT JMS I (CONV) /CONVERT TO CDF, ADDR FORMAT MG4 /STORE THE CDF IN MG4 DCA I (MG1 /STORE THE ADDR IN MG1 TAD (-7 /7 WORDS OF DATA MAKE A CELL DCA I (MG2 /SO SET UP COUNTER JMS I (MG3 /READ THE LINKAGE WORD DCA I (MG5 /SAVE POINTER TO NEXT CELL. JMP I MGS1 /DONE PAGE
.ASECT MACIO2 FIELD 1 *1200 STRSTK, -120 /STREAM STACK 0 ZBLOCK 120
MF, -1 /-1 MEANS NO STORE YET ML, 0 MH, 0 MVAR, JMS I (MGRAB /GET NEXT CHARACTER CIF 0 JMS I (CALLIT GETSYM CDF 0 TAD I (SYMVAL CDF 10 SKP MEXP, JMS I (MGRAB /READ VALUE OF EXPRESSION ISZ MF JMP MSH DCA ML JMP I (MGT2A MSH, DCA MH JMP I (MGT2A
FIXCOM, 0 TAD MF SNA CLA JMS MLH TAD ML DCA I (MLOW TAD MH DCA I (MHIGH DCA ML DCA MH STA DCA MF JMP I FIXCOM MLH, 0 TAD ML DCA MH JMP I MLH PAGE
/ SWITCH /CALLING SEQUENCE: / / JMS SWITCH / SGET /ADDRESS OF NEW STREAM INPUT ROUTINE / /ALGORITHM (DUE TO R.L., S.R., AND D.S.): /1. PUSH NAME OF CURRENT STREAM ONTO STACK /2. SPECIFIED STREAM BECOMES NEW CURRENT STREAM /3. GET INFORMATION ABOUT NEW STREAM / SGET: CONTAINS ADDRESS OF NEW STREAM / SLOC: CONTAINS ADDRESS OF CONTEXT BLOCK FOR NEW STREAM / SRET: CONTAINS ADDRESS OF PARTNER COROUTINE FOR NEW STREAM (RET) / SSTRT: CONTAINS ADDRESS OF BEGIN OF CODE FOR NEW STREAM (START) / THIS ADDRESS BECOMES THE INITIAL VALUE OF CONTENTS / OF PARTNER COROUTINE ENTRY POINT. /4. IF C(RET) IS NON-0, THEN PUSH ALL LOCAL VARIABLES ONTO STACK /5. PUSH C(RET) ONTO STACK. WE DON'T REALLY CARE ABOUT THESE / CONTENTS, ONLY WHETHER THEY ARE 0 OR NON-0. / IN THAT WAY, WE HAVE A FLAG AT THE END OF THE STACK, / TELLING US WHETHER ANY LOCAL VARIABLES WERE PUT ON THE STACK. /6. INITIALIZE C(RET) TO 'START' / FORMAT OF STREAM INPUT ROUTINE / RETURN /ADDRESS OF COROUTINE PARTNER / LOCAL /ADDRESS OF BEGINNING OF CONTEXT BLOCK / START /ADDRESS OF START OF REAL CODE FOR THIS INPUT ROUTINE / /(THIS IS THE INITIAL VALUE FOR C(RETURN) ) / FIX /ADDRESS OF FIXUP ROUTINE /GET, ... /ENTRANCE PROCESSING FOR THIS STREAM / /'GET' IS THE NAME OF THIS STREAM / JMP I RETURN /REQUIRED COROUTINE LINKAGE /RETURN, 0 /ENTRY POINT FOR PARTNER COROUTINE / /THIS WORD MUST BE SET TO 0 AT THE BEGINNING OF EACH PASS / /IF THIS WORD IS NON-0, THEN THIS MEANS / /THAT THIS COROUTINE IS IN USE / ... /EXIT PROCESSING / CIF CDF 0 /REQUIRED LINKAGE BACK TO FIELD 0 / JMP I (NXTRET /REQUIRED MACREL STREAM RETURN CODE / FORMAT OF THE CONTEXT BLOCK: / -COUNT /NUMBER OF WORDS FOLLOWING IN CONTEXT BLOCK / VAL1 /THESE ARE THE LOCAL VARIABLES THEMSELVES / VAL2 /NOT THEIR ADDRESSES / VAL3 / ... / VAL(COUNT)
STRJMP, JMP I STREAM /CROSS FIELD LINKAGE FOR 'NEXTCHAR' STREAM, 0 /CURRENT STREAM NAME SWITCH, 0 /SWITCH TO NEW INPUT STREAM RDF /SEE WHAT FIELD WE WERE CALLED FROM TAD [CIF CDF /CREATE APPROPRIATE CIF CDF INSTRUCTION DCA SWRET /CALLABLE FROM ANY FIELD TAD I SWITCH /GET ADDRESS OF NEW STREAM INPUT ROUTINE CDF 10 /CHANGE TO CURRENT DATA FIELD ISZ SWITCH /SET UP FOR RETURN JMS SETUP /SET UP 'SGET', 'SLOC', 'SRET', 'SSTRT' AND 'SFIX' TAD STREAM JMS I (SPUSH /PUSH AWAY OLD STREAM NAME STRSTK /ONTO STREAM STACK TAD SGET DCA STREAM /SET NEW STREAM TAD I SRET /LOOK AT CONTENTS OF RETURN SZA CLA /IS IT 0? JMS LOCPSH /NO, RECURSIVE CALL. PUSH LOCAL VARIABLES TAD I SRET /YES, NO NEED TO SAVE CONTEXT JMS I (SPUSH /PUSH AWAY CONTENTS OF RETURN (AS A FLAG) STRSTK TAD SSTRT DCA I SRET /SET NEW INITIAL CONTENTS OF RETURN SWRET, HLT /CHANGE BACK TO OLD IF, DF JMP I SWITCH /EXIT
/ SET UP LOCATIONS SGET, SRET, SLOC, AND SSTRT SETUP, 0 /ADDRESS OF NEW STREAM IN AC TAD (-4 /POINT BACK TO BEGIN OF COROUTINE HEADER DCA SGET /NOW HAVE ADDRESS OF WORD CONTAINING PTR TO 'RETURN' TAD I SGET /GET ADDRESS OF RETURN DCA SRET /SAVE IT ISZ SGET /POINT TO SECOND WORD OF HEADER TAD I SGET /GET ADDRESS OF 'LOCAL' DCA SLOC /SAVE POINTER TO CONTEXT BLOCK ISZ SGET /POINT TO THIRD WORD OF COROUTINE HEADER TAD I SGET /GET ADDRESS OF 'START' DCA SSTRT /SAVE IT FOR FUTURE REFERENCE ISZ SGET /POINT TO ADDRESS OF FIXUP ROUTINE TAD I SGET /GET ITS ADDRESS DCA SFIX /SAVE IT ISZ SGET /POINT TO STREAM ITSELF JMP I SETUP /RETURN
LOCPSH, 0 /PUSH LOCAL VARIABLES ONTO STACK TAD I SLOC /GET (NEGATIVE) COUNT OF NUMBER OF LOCAL VARIABLES DCA SWKNT /SAVE IT TAD SLOC /GET ADDRESS-1 OF START OF LOCAL VARIABLES DCA XR0 /SET UP AUTO-INDEX REGISTER TAD I XR0 /GET NEXT LOCAL VARIABLE JMS I (SPUSH /PUSH IT ONTO STRSTK /STREAM STACK ISZ SWKNT /DONE? JMP .-4 /NO, KEEP PUSHIN' JMP I LOCPSH /YES, RETURN LOCPOP, 0 /POP LOCAL VARIABLES OFF STACK TAD I SLOC /GET (NEGATIVE) COUNT OF NUMBER OF LOCAL VARIABLES DCA SWKNT /SAVE IT TAD SWKNT /GET IT BACK CIA /MAKE POSITIVE TAD SLOC /ADD TO BEGIN OF BLOCK TO GET ADDRESS OF END OF CONTEXT BLOCK DCA CBPTR POP1, JMS I (SPOP /POP AN ITEM OF STRSTK /THE STREAM STACK DCA I CBPTR /STORE IT INTO THE CONTEXT BLOCK STA TAD CBPTR DCA CBPTR /MOVE POINTER BACK ONE ISZ SWKNT /DONE? JMP POP1 /NO, KEEP ON POPPIN' TAD SFIX SZA CLA /IS THERE A FIXUP ROUTINE? JMS I SFIX /YES, CALL IT (IN FIELD 1) JMP I LOCPOP /NO, RETURN SWKNT, 0 /COUNTER CBPTR, 0 /CONTEXT BLOCK POINTER SGET, 0 /POINTER TO NEW STREAM SRET, 0 /POINTER TO 'RETURN' FOR NEW STREAM SLOC, 0 /POINTER TO BEGIN OF CONTEXT BLOCK FOR NEW STREAM SSTRT, 0 /POINTER TO START OF CODE OF NEW STREAM SFIX, 0 /ADDRESS OF FIXUP SUBROUTINE, 0 IF NONE
/ SWITCHBACK /THIS ROUTINE MAY BE CALLED FROM ANY FIELD /IT IS CALLED WHEN ONE STREAM COROUTINE REALIZES THAT IT IS AT THE /END OF ITS STREAM AND WE WISH TO SWITCH BACK TO THE /PREVIOUS INPUT STREAM COROUTINE. /CALLING SEQUENCE: JMS I (SWBACK SWBACK, 0 RDF /SEE WHAT FIELD WE WERE CALLED FROM TAD [CIF CDF /*** MAYBE WE ONLY CALL THIS GUY FROM FIELD 1 DCA SWBRET CDF 10 TAD STREAM /GET CURRENT STREAM INTO AC JMS SETUP /SET UP INFO ABOUT CURRENT STREAM JMS I (SPOP /POP OLD CONTENTS OF RETURN STRSTK /OFF THE STREAM STACK DCA I SRET /STORE IT IN THE PROPER PLACE (RETURN) TAD I SRET /LOOK AT IT AGAIN SZA CLA /WAS IT 0? JMS LOCPOP /NO, RESTORE CONTEXT AND CALL FIXUP ROUTINE JMS I (SPOP /POP PREVIOUS STREAM STRSTK DCA STREAM /RESTORING IT AS THE NEW CURRENT STREAM SWBRET, HLT /RETURN TO ORIGINAL DF, IF JMP I SWBACK /EXIT
JMPTAB, MGT4 /0 EOMB MGT7 /1 EOA PMGT7, MGT7 /2 EORR MEXP /3 ARGEXP MVAR /4 ARGVAR CMPARE, CLA ISZ I (MCNTR /UPDATE CHARACTER COUNT TAD I (MCNTR STL CIA TAD I (MLOW SZA SNL CLA /AC=0 OR L=1 MEANS CHAR .GE. LOW JMP I (MGT2A /AC.NE.0 AND L=0 MEANS SKIP CHARACTER TAD I (MHIGH SNA JMP OKK /UPPER LIMIT OF 0 MEANS DON'T STOP CMA TAD I (MCNTR /STOP AT HIGH+1 SNA CLA JMP I PMGT7 /=HIGH+1, SAME AS EOA OKK, JMS I (MG3 /GET CHARA AGAIN JMP I (MGT2B PAGE
SPUSH, 0 DCA SPOP RDF TAD [CIF CDF DCA S1RET TAD I SPUSH INCR SPUSH CDF 10 DCA ST TAD ST IAC DCA SP /PT TO WD NO. OF NEXT FREE WD TAD I SP /GET WORD # OF NEXT FREE WORD TAD I ST /COMPARE AGAINST MAXIMUM WORD NUMBER SNA CLA JMP OVFLOW /OVERFLOW TAD I SP /GET WD # OF NEXT FREE WD TAD SP IAC DCA SP2 TAD SPOP DCA I SP2 /STORE AWAY INCR I SP /BUMP WD # OF NEXT FREE WD S1RET, HLT JMP I SPUSH ST, 0 /PTS TO STACK SPOP, 0 TAD I SPOP INCR SPOP IAC DCA SP RDF TAD [CIF CDF DCA S2RET CDF 10 STA TAD I SP SPA JMP UNFLOW /UNDERFLOW DCA I SP TAD I SP TAD SP IAC DCA SP2 TAD I SP2 S2RET, HLT JMP I SPOP
OVFLOW, CIF 0 IO3, JMS I [ERROR /STACK OVERFLOW JMP I [ABORT UNFLOW, CIF 0 IO4, JMS I [ERROR JMP I [ABORT /STACK UNDERFLOW SP, 0 /PTS TO WORD # OF NEXT FREE WD SP2, 0 /PTS TO NEXT FREE WORD EXPSTK, -40 0 ZBLOCK 40 USRSTK, -40 0 ZBLOCK 40 PAGE
.ASECT MACIO3 FIELD 1 *2000 INPBUF, ZBLOCK INPLEN^400 .ASECT MACIO4 FIELD 1 *3400 OUTBUF, ZBLOCK OUTLN^400 LINBUF, ZBLOCK 200 CURPAG, -1 ZBLOCK 177 PAGE0, -1 ZBLOCK 177 PAGE
.ASECT MACIO5 FIELD 1 *4600 IFDEF PLM < / 'GETOS8' AND 'GETRET' ARE COROUTINES / /THIS IS THE CODE FOR 'GETOS8' . THIS ROUTINE GETS 7-BIT ASCII /CHARACTERS OUT OF THE OS/8 INPUT BUFFER, ONE AT A TIME /AND SENDS THEM TO THE COROUTINE 'GETRET' BY CALLING 'SEND' /WITH THE CHARACTER IN THE AC. THIS ROUTINE UNPACKS THE CHARACTERS /FROM THE BUFFER WHERE THEY ARE STORED IN THE STANDARD OS/8 PACKING /SCHEME OF 3 CHARACTERS PACKED INTO TWO SUCCESSIVE WORDS. /WE CALL 'SEND' INSTEAD OF 'GETRET' DIRECTLY BECCAUSE 'SEND' /DOES SEVERAL OTHER USEFUL THINGS - IT FORCES THE CHARACTER TO BE /7-BIT AND IT CHECKS TO SEE IF THE CHARACTER IS A CTRL/Z. /IF IT IS A CTRL/Z, THEN CONTROL BRANCHES TO 'EOF' /WHICH WAVES IT'S HANDS IN ORDER TO GET MORE INPUT, AND WHEN /IT DOES, IT SENDS CONTROL BACK TO 'READOS' WHICH CONTINUES THE /PROCESS. IN THE CASE WHERE 'EOF' FINDS WE ARE REALLY AND TRULY /OUT OF INPUT, IT BRANCHES TO 'FIN' WHICH CAUSES ^Z TO /BE SENT TO COROUTINE FOREVER MORE. / / FORMAT OF OS/8 PACKING: / / CHAR 1 IS IN LOW ORDER 8 BITS OF WORD 1 / CHAR 2 IS IN LOW ORDER 8 BITS OF WORD 2 / CHAR 3 IS OBTAINED AS FOLLOWS: / HIGH ORDER 4 BITS IS IN HIGH ORDER 4 BITS OF WORD 1 / LOW ORDER 4 BITS IS IN HIGH ORDER 4 BITS OF WORD 2 >
GETOS, ISZ BUFKNT /ARE WE THROUGH WITH LAST DOUBLE /WORD IN BUFFER? SKP /NO, PROCESS NEXT THREE CHARACTERS OSTRT, JMS READOS /YES, READ A NEW BUFFER'S WORTH OF /CHARACTERS INCR OS8PTR TAD I OS8PTR /GET FIRST WORD OF PAIR DCA OS8WD1 /SAVE IT INCR OS8PTR TAD I OS8PTR /GET 2ND WORD OF PAIR DCA OS8WD2 /SAVE IT TOO TAD OS8WD1 /GET CHAR 1 (IN BITS 4-11) JMS ORET /SEND IT TO CALLING COROUTINE TAD OS8WD2 /GET 2ND CHAR OF TRIPLE (IN BITS /4-11) JMS ORET /SEND IT TOO TO CALLING COROUTINE TAD OS8WD2 /GET BACK WORD 2 AND [7400 /ISOLATE RIGHT HALF OF CHAR 3 CLL RTR /PUT INTO BITS 4-7 RTR DCA OS8WD2 /HOLD TEMPORARILY TAD OS8WD1 /LOOK AGAIN AT WORD 1 OF PAIR AND [7400 /ISOLATE LEFT HALF OF CHARACTER #3 TAD OS8WD2 /COMBINE WITH RIGHT HALF CLL RTR /TO GET CHAR 3 IN BITS 0-7 RTR /NOW ROTATE IT INTO BITS 4-11 JMS ORET /AND SEND IT TO CALLER'S COROUTINE JMP GETOS /NOW REITERATE
IFDEF PLM < /READ A NEW BUFFER'S WORTH OF CHARACTERS FROM OS/8 DEVICE / /THIS ROUTINE IS CALLED WHEN IT IS TIME TO READ A NEW BUFFER'S /WORTH OF CHARACTERS FROM THE CURRENT INPUT DEVICE INTO MACREL'S /OS/8 INPUT BUFFER. THIS INPUT BUFFER BEGINS AT 'INPBUF' IN /FIELD 1 AND IS 'INPLEN' BLOCKS LONG (A BLOCK IS 2 PAGES). / /ALGORITHM: / /1. RESET 'OS8PTR' TO POINT BACK TO BEGINNING OF INPUT BUFFER. / ACTUALLY, 'OS8PTR' ALWAYS POINTS TO THE WORD BEFORE THE / FIRST WORD OF THE NEXT DOUBLE-WORD TO BE READ. /2. THEN WE SEE HOW MANY BLOCKS OF INPUT FILE ARE LEFT. / WE DO THIS SO THAT WE DON'T TRY TO READ MORE BLOCKS FROM / THE INPUT FILE THAN WERE REALLY THERE. (JUST IN CASE / THE INPUT FILE IS NEAR THE END OF A DEVICE, WE WOULDN'T / WANT TO TRY TO READ NON-EXISTENT BLOCKS.) / OF COURSE, WE TRY TO ALWAYS READ 'INPLEN' BLOCKS OF INPUT, / BUT IF THERE ARE LESS THAN 'INPLEN' BLOCKS LEFT, THEN WE / CALL 'READSHORT' WHICH FORCES US TO READ PRECISELY THE / NUMBER OF BLOCKS LEFT IN THE CURRENT INPUT FILE. / IF THE INPUT DEVICE IS NON-FILE-STRUCTURED, THEN WE DON'T / REALLY KNOW HOW MANY INPUT BLOCKS ARE LEFT, SO WE READ / THE MAXIMUM ('INPLEN'). /3. THE NUMBER OF BLOCKS WE ACTUALLY CHOOSE TO READ IS / STORED IN 'INSIZ'. /4. IF THE DEVICE IS NON-FILESTRUCTURED, THEN 'INSIZ' IS / SUBTRACTED FROM 'INLEN', BECAUSE IN THAT CASE 'INLEN' / TELLS US HOW MANY BLOCKS OF INPUT ARE LEFT TO BE READ / FROM THE INPUT DEVICE. /5. 'RDSIZ' AND 'BUFKNT' ARE THEN SET FROM 'INSIZ'. / 'BUFKNT' CONTAINS THE NEGATIVE OF THE NUMBER OF DOUBLE-WORDS / OF ACTUAL DATA IN THE OS/8 INPUT BUFFER. / 'RDSIZ' CONTAINS THE FUNCTION CONTROL WORD PASSED TO THE / INPUT HANDLER. BITS 6-8 CONTAIN A '1' BECAUSE THE / INPUT BUFFER IS IN FIELD 1. BITS 1-5 CONTAIN THE NUMBER / OF PAGES OF DATA TO BE READ. /6. THEN WE CALL THE HANDLER (ADDRESS IS IN 'INHNDLR') / IF WE GET AN ERROR, WE CALL 'INERR' WHCIH CHECKS TO SEE / IF THE ERROR WAS 'END-OF-FILE'. IF IT WAS ONLY END-OF-FILE / THEN WE CONTINUE; NON-FILE-STRUCTURED HANDLERS ARE THE / ONLY KIND THAT CAN GIVE 'END-OF-FILE' ERRORS, AND SUCH / HANDLERS ALWAYS PUT A ^Z IN THE BUFFER AFTER ALL REAL DATA. / FOR OTHER ERRORS, 'INERR' PRODUCES AN ERROR MESSAGE /7. AFTER THE READ, 'INREC' IS BUMPED BY 'INSIZ' BECAUSE / 'INREC' ALWAYS TELLS US THE BLOCK NUMBER OF THE NEXT / BLOCK TO BE READ FROM THE INPUT DEVICE. >
DBLEN=INPLEN^200 /NUMBER OF DOUBLE WORDS /IN OS/8 INPUT BUFFER READOS, 0 TAD (INPBUF-1 DCA OS8PTR /POINT TO BEGIN OF OS/8 BUFFER / TAD (INPLEN STL CLA RTL /TAD (2 DCA INSIZ TAD DVNO SNA /INITIAL TIME THRU 'DVNO' IS NOT SET UP JMP EOF /DIDN'T HAVE TO ZERO 'INLEN' TAD (7757 DCA TEMP TAD I TEMP SMA CLA JMP READB /SKIP STUFF IF DEVICE IS NON-F-S TAD INLEN /GET # OF BLOCKS OF INPUT REMAINING SNA JMP EOF /REACHED END OF FILE CLL TAD (-INPLEN /SUBTRACT NUMBER OF BLOCKS WE WISH /TO READ SNL /TO FIND OUT IF WE CAN READ THAT /MANY JMS I (READSHORT/NO, WE CAN'T READ A FULL /BUFFER'S WORTH DCA INLEN /YES, WE CAN READ A WHOLE BUFFER /LOAD READB, TAD INSIZ /SET UP 'BUFKNT' AND 'RDSIZ' CLL RTR RTR RTR CIA DCA BUFKNT TAD BUFKNT CIA TAD [10 DCA RDSIZ TAD INREC DCA INREK CIF 0 JMS I INHNDLR /PERFORM A READ RDSIZ, 0 /FUNCTION WORD (FIELD 1 & # /OF PAGES TO READ /NO. OF PAGES ACTUALLY READ FROM /FILE (IN BITS 1-5) INPBUF /BUFFER STARTING ADDRESS INREK, 0 /INPUT RECORD NUMBER JMP INERR /INPUT ERROR TAD INREC TAD INSIZ DCA INREC /UPDATE REC NUMBER TO BE READ NEXT JMP I READOS /RETURN
/ OGET ORET /COROUTINE HEADER OLOCAL OSTRT OFIX OGET, JMP I ORET ORET, 0 AND [177 /ISOLATE 7-BIT ASCII CHARACTER SNA JMP I ORET /IGNORE NULLS IN OS/8 TEXT TAD (-32 /^Z SNA /IS IT CTRL/Z? JMP EOF /YES, REACHED LOGICAL END-OF-FILE TAD (32 /RESTORE CHARACTER CIF CDF 0 JMP I [NXTRET
INERR, CIF 0 /GET READY TO GIVE ERROR SPA CLA /POSITIVE AC MEANS SOFT ERROR (END-OF-FILE) IO8, JMS I [ERROR /NEGATIVE AC MEANS HARD ERROR JMP I READOS /IGNORE SOFT ERROR (HOPE TO STILL SEE CTRL/Z) EOF, CIF 10 /NEGATE AFFECT OF PREVIOUS CIF TAD FILENO SPA CLA JMP OEND /AT END OF INCLUDE JMS I (NEWFIL TAD I INPTR /GET NEXT INPUT FILE SNA /BUT IS THERE ONE? JMP OENDY /NO. ALL DONE AND [17 /YES DCA DVNO /GET 4-BIT DEVICE NUMBER INCR FILENO TAD I INPTR AND [7760 /GET NEGATIVE OF FILE LENGTH CIA CLL RTR RTR DCA INLEN TAD INLEN DCA ORIGSZ /SAVE ORIGINAL LENGTH (FOR 0 CASE) /*** BUG IF INCLUDE FILE IS .GT. 255 BLKS INCR INPTR /POINT TO NEXT WORD IN INPUT /SPECIFICATION AREA TAD I INPTR /GET STARTING BLOCK OF FILE DCA INREC INCR INPTR /POINT TO NEXT INPUT FILE /SPECIFICATION PAIR JMS I (FETCHN JMP OSTRT /FORCE NEW FILE TO BE READ INPTR, 7617 OEND, TAD FILENO /BUMP FILENO BY 1 IAC SNA TAD FILSAV /REPLACE BY SAVED VALUE IF NOW 0 DCA FILENO OENDY, JMS I [SWBACK JMP I [STRJMP PAGE
/SAVINC, SAVAREA IOINIT, 0 JMS I (ZINIT JMS I [SWITCH /INITIAL SWITCH TO 'OGET' OGET / STA / DCA BUFKNT DCA DVNO / DCA I (FILSAV / TAD (SAVAREA / DCA I (SAVINC CIF CDF 0 JMP I IOINIT FINIO, 0 TAD OUTLOC DCA I (OUTREC DCA OUTSIZ TAD (OUTBUF+1 DCA OPTR1 DCA HOLSIZ CIF CDF 0 DCA I (HDRWRD DCA I (FLGFLG JMP I FINIO DV2, IONIT2, 0 DCA FILENO TAD (7617 DCA I (INPTR DCA INLEN CIF CDF 0 JMP I IONIT2
CHAINI, 0 /CONTINUATION OF 'INCLUDE' DIRECTIVE JMS I [SWITCH /SWITCH TO NEW OGET OGET KCIDF, CIF CDF 0 JMP I CHAINI /RETURN TO FIELD 0 /MOVE TO CONTEXT AREA IF WANT TO BE ABLE TO PRINT FILENAME N, ZBLOCK 4 /HOLDS FILENAME
LOOKU, 0 DCA DV2 TAD (NAME1-1 /MOVE FILENAME UP DCA XR0 RDF TAD KCIDF DCA RCDF CDF 0 /FILE NAME IS IN FIELD 0 TAD I XR0 DCA N TAD I XR0 DCA N+1 TAD I XR0 DCA N+2 TAD I XR0 SNA TAD (1501 /ASSUME .MA IF NO EXTENSION GIVEN DCA N+3 TAD (N DCA FN /SET UP FOR LOOKUP CDF 10 TAD DV2 /PUT NEW DEVICE NUMBER IN AC JMS I [USR /CALL USER SERVICE ROUTINE 2 /TO DO A LOOKUP FN, XR0 /REPLACED BY STARTING BLOCK LOOKLN, 0 /REPLACED BY LENGTH JMP LOOKER /FILE NOT FOUND (OR WRITE-ONLY) TAD FN RCDF, HLT JMP I LOOKU LOOKER, CIF 0 IO9, JMS I [ERROR /LOOKUP ERROR OR DEVICE WRITE-ONLY JMP I [ABORT
NEWFIL, 0 IAC /MAY BE CALLED WITH -1 IN AC CDF 0 DCA I (NEWTIT /1 MEANS SET NEW TITLE FROM 1ST LINE CLA IAC DCA I (FORM CDF 10 JMP I NEWFIL READSHORT,0 JMS IOPAT TAD INLEN DCA INSIZ JMP I READSHORT
LOCOFF, 0 /INITIAL BLOCK OFFSET CLOSO, 0 TAD OUTSIZ DCA OLEN TAD OUTDEV JMS I [USR 4 CLNAME, 7601 OTEM, OLEN, 1 JMP CLOSER CIF CDF 0 JMP I CLOSO CLOSER, CIF 0 IO6, JMS I [ERROR /CLOSE ERROR JMP I [ABORT
/ ZGET ALWAYS RETURNS CTRL/Z ZRET 0 /NEVER REFERENCE LOCAL VARIABLES GETZ 0 /NO FIXUP ROUTINE ZGET, JMP I ZRET ZRET, 0 CIF CDF 0 JMP I [NXTRET GETZ, TAD (32 /SEND CTRL/Z BACK TO MAINLINE JMS ZRET JMP GETZ IOPAT, 0 CLA TAD ORIGSZ SNA CLA JMP I (READB /FOR 0 LENGTH FILE, KEEP READING JMP I IOPAT PAGE
/***********************/ / / LISTOR, 0 / AND [377 /SAFETY JMP I LSTRET / COROUTINE LINKAGE LSTRET, OUTLST / CIF CDF 0 JMP I LISTOR / / / /***********************/ QPUT, 0 /CALL TO PUTBUF FROM FIELD 0 JMS PUTBUF CIF CDF 0 JMP I QPUT /RETURN FROM WHENCE WE CAME
/THIS IS THE OUTPUT COROUTINE USED FOR OUTPUTTING 8-BIT BYTES. /IT GETS NEXT BYTE (CHARACTER) BY CALLING 'LSTRET'. /'OUTKNT' IS NEG OF NUMBER OF DOUBLE WORDS IN OUTPUT BUFFER. /'OPTR1' AND 'OPTR2' POINT TO CURRENT DOUBLE WORD. /UPON FILLING UP BUFFER, CALL 'PUTBUF' TO WRITE OUT BUFFER. OUTLST, DCA OSAV1 /STORE AWAY FIRST CHAR OF PAIR JMS LSTRET /RETURN TO COROUTINE DCA OSAV2 /STORE AWAY SECOND CHAR OF PAIR JMS LSTRET /RETURN TO COROUTINE DCA LTEMP /SAVE 3RD CHAR TEMPORARILY TAD LTEMP /GET BACK THIRD CHAR CLL RTL RTL AND [7400 /ISOLATE LEFT HALF OF IT IN BITS 0-3 TAD OSAV1 /COMBINE WITH CHAR 1 DCA I OPTR1 /STORE BACK IN BUFFER INCR OPTR1 TAD LTEMP /GET 3RD CHAR ONCE MORE CLL RTR RTR /THIS TIME GET RIGHT HALF RAR AND [7400 /ALSO ISOLATING IN BITS 0-3 TAD OSAV2 /COMBINE WITH CHAR 2 DCA I OPTR1 /AND STORE BACK IN OUTBUT BUFFER INCR OPTR1 ISZ OUTKNT /WAS THIS THE LAST DOUBLE WORD /OF BUFFER? SKP /NO JMS PUTBUF /YES, WRITE OUT LIST BUFFER JMS LSTRET /RETURN TO COROUTINE JMP OUTLST /REITERATE /CAN ALSO SAVE SOME TIME BY CHANGING OPTR1 TO AN AUTO-INDEX REGISTER OSAV1, 0 OSAV2, 0
/OUTPUT OUTPUT BUFFER /*** WE ARE TEMPORARILY RESTRICTING THE OUTPUT /BUFFER TO BE ONE BLOCK LONG. /THIS WILL PROBABLY TURN OUT TO BE A PERMANENT RESTRICTION. LTEMP, PUTBUF, 0 / TAD OPTR1 / TAD (-OUTBUF+377 / AND [7400 / STL RAR / TAD (10 /FIELD 1 / DCA WRSIZ / TAD WRSIZ / AND [3700 / CLL RTL / RTL / RTL / DCA OUTSZ TAD OUTSZ TAD OUTSIZ DCA OUTSIZ TAD OUTSIZ STL TAD HOLSIZ SNL SZA CLA JMP NOROOM /NO ROOM FOR OUTPUT /SEE IF OUT-HANDLER IS RESIDENT JMS OFETCH /IF NOT, FETCH IT CIF 0 JMS I OUTHNDLR 4210 /ALWAYS WRITE 2 PAGES FROM FIELD 1 POUTBUF,OUTBUF OUTREC, 0 JMP OUTERR /OUTPUT ERROR / TAD OUTREC / TAD OUTSZ / DCA OUTREC ISZ OUTREC /BUMP TO NEXT BLOCK TAD OUTCNT DCA OUTKNT TAD POUTBUF DCA OPTR1 / TAD (OUTBUF+1 / DCA OPTR2 JMP I PUTBUF
/ER2, JMS I [ERROR /OUTPUT ERROR / JMP I [7605 OUTERR, CIF 0 IO1, JMS I [ERROR ABORT, CIF CDF 0 JMP I [7605 /OR OUTPUT ERROR NOROOM, CIF 0 IO2, JMS I [ERROR JMP ABORT /NO ROOM FOR OUTPUT IFDEF PLM < /NOTE THAT IF THE COMMAND DECODER LINE HAD THE FORM / / DEV1:,DEV2:_DEV2:,DEV3:,DEV2: / /THEN AT THE START OF PASS 2, INPUT HANDLER DEV2: WOULD STILL /BE AROUND FROM THE END OF PASS 1, SO WE WOULD THINK DEV2 /WAS RESIDENT AND NOT LOAD IT AS OUR OUTPUT HANDLER. BUT THEN /WHEN IT CAME TIME TO SWAP IN DEV3, OUR OUT-HANDLER WOULD /MYSTERIOUSLY GO AWAY AND WE WOULD NEVER KNOW IT! /THIS POTENTIAL BUG IS SOLVED BY THE EXPEDIENCE OF ALWAYS /SEEING IF THE OUTPUT HANDLER IS RESIDENT (WE KNOW ITS DEVICE /NUMBER). WE CAN MAKE THIS CHECK WITHOUT SWAPPING IN THE USR /BY MANUALLY EXAMING THE DEVICE CONTROL WORD TABLE. WE MAKE /SUCH A CHECK BEFORE EVERY CALL TO THE OUTPUT HANDLER; AND IF /WE FIND THAT IT IS NOT RESIDENT, WE LOAD IT. >
OFETCH, 0 TAD OUTDEV TAD (7646 DCA OTEM2 /POINT INTO DHRT TAD I OTEM2 /GET ENTRY POINT SZA JMP OUT2 /OUT-DEVICE HANDLER IS RESIDENT TAD (OUTHAN+1 DCA OUTENT /SETUP FOR FETCH OF DEVICE HANDLER TAD OUTDEV /RETRIEVE OUTPUT DEVICE FILE NUMBER JMS I [USR 1 /FETCH DEVICE HANDLER OUTENT, OUTHAN+1 /LOCATION OF 2-PAGE AREA FOR HANDLER /REPLACED BY HANDLER ENTRY POINT JMP ERRLOD /ERROR LOADING HANDLER TAD OUTENT OUT2, DCA OUTHNDLR JMP I OFETCH ERRLOD, CIF 0 IO10, JMS I [ERROR /ERROR LOADING HANDLER JMP ABORT OTEM2, 0
IFDEF PLM < /ON 'INCLUDE' THINGS WE WANT TO SAVE: / /INREC BLOCK NUMBER OF NEXT BUFFER START /BUFKNT /INSIZ NO. OF BLOCKS IN CURRENT BUFFER /DVNO DEVICE # FOR CURRENT INPUT DEVICE /OS8WD1 /OS8WD2 /INLEN NO. OF INPUT BLOCKS REMAINING (AFTER READING CURRENT BUFFER) /OS8PTR /GETRET COROUTINE LINKAGE WORD / / /ALSO SAVE AND RESTORE 'SEND' / / / INREC-INSIZ TELLS US WHAT BLOCK WE HAVE TO RE-READ /READ BLOCK BACK IN /USE DVNO TO RE-FETCH HANDLER AND RECALCULATE 'INHNDLR' /NOTE THAT 'INREC' CAN NEVER BE 0 AT THIS STAGE OF THE GAME /NOTE MOREOVER THAT WE NO LONGER MAKE USE OF THIS QUIRK >
OFIX, 0 / FILENO STUFF? JMS I (FETCHN /RE-FETCH HANDLER TAD INSIZ CIA TAD INREC DCA INREC2 /RESET 'INREC' TO ITS LAST VALUE TAD INSIZ CLL RTR RTR RTR TAD [10 DCA RDSIZ2 CIF 0 JMS I INHNDLR /REREAD BUFFER RDSIZ2, 0 INPBUF INREC2, 0 JMP I (IO8 /ERROR RE-READING / JMS I [NEWFIL JMP I OFIX
/ FETCHN /FETCH DEVICE HANDLER BY NUMBER /NUMBER IS IN 'DVNO' /THIS FETCHES INTO 2 PAGE AREA KNOWN AS 'INHAND' /LEAVES ENTRY POINT IN 'INHNDLR' FETCHN, 0 /FETCH DEVICE HANDLER BY NUMBER TAD [INHAND+1 DCA INH TAD DVNO JMS I [USR 1 INH, INHAND+1 JMP I [IO10 /ERROR FETCHING HANDLER TAD INH DCA INHNDLR JMP I FETCHN PAGE



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search