File SNOP51.PA (PAL assembler source file)

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

/SNOBOL-8.2 RUN TIME SYSTEM.   AUGUST 29, 1976




/   THIS IS THE BACKBONE OF THE SNOBOL-8.2 LANGUAGE. ALL USER
/COMMANDS ARE TURNED INTO CALLS TO THIS PROGRAM USING SUB-
/SEQUENT WORDS TO PASS ARGUMENTS.
/
/
/   THIS LANGUAGE IS DESIGNED TO RUN UNDER AN 8K OS/8 SYSTEM.
/IT UTILIZES THE FILE STRUCTURE FOR DATA FILES (EDITOR FORMAT
/AND COMPATABLE).  SNOBOL-8.2 IS DESIGNED TO BE AS CLOSE TO
/SNOBOL-3 (BELL TELL) AS POSSIBLE.  THE MAJOR DIFFERENCES
/OCCUR WITH THE I/O COMMANDS.  FOR EXAMPLE:   THE COMMAND
/SEQUENCE:  ".LOOKUP FILENAME";  WHERE 'FILENAME' IS THE NAME
/OF A FILE ON DEVICE 'DSK'; WILL PEPARE THAT FILE FOR 'READ'
/OPERATIONS.
/
/    THE SECOND MAJOR DIFFERENCE IS THE ABSENCE OF COMPLEX ARITH-
/METIC STATEMENTS FROM THE LANGUAGE.  THIS IS PARTIALLY OFFSET BY
/THE ABILITY TO USE STANDARD PAL-8 CODE ANYWHERE IN THE SNOBOL
/PROGRAM.  BECAUSE STRINGS CAN CONTAIN NUMERALS, THS PROGRAM
/SUPPLIES ROUTINES TO CONVERT VARIABLES TO BINARY NUMBERS AND
/VICE-VERSA (IN BASE 'BASE').
/
/     FOR A FULL DESCRIPTION, PLEASE SEE THE SNOBOL-8.2 USER'S
/MANUAL, CONTAINED IN THE NETWORK PROGRAM SNOUSER.DC.



*0
	DECIMAL
	51		/VERSION NUMBER
	OCTAL

/ PAGE LAYOUT - FIELD 0 /PAGE NAME AND COMMENTS TOTAL SIZE /==== ==== === ======== ===== ==== /2600 INIT (3) 60 / PAT-PATDT (2) 113 (0) /3000 PAT10-PAT28 (7) 171 (0) /3200 PAT30 - PAT44 (10) 166 (2) /3400 PAT46 - PAT66, PATSER (12) 161 (5) /3600 PATSR - UPDBAS 63 / XL1: INDRCT (2) 111 (2) /4000 OPIN, OPOUT (15) 160 (3) /4200 PUSH(J), POP(J), CLOUT (6) 126 / XL2: FNDSP 43 (1) /4400 CLIN, ACCEPT (13) 162 (3) /4600 READH, WRITH (4) 172 (2) /5000 WRCHR & GTCHR (1) 173 (4) /5200 PUTVR - PUT12 (4) 174 (0) /5400 PUT10, LNKVAR, CLVAR, CLRVAR (1) 161 (16) /5600 UPDPTR, FILEDC (5) 152 / XL3: RETLFX, GPTRX (1) 14 (4) /6000 ASC, INT (3) 173 (2) /6200 UPDFUN, PRN, INTTST, CLPRN, RJST / LJST, USRLOK, USRDIS, RTSER (6) 167 (3) /6400 PUTSPF, UPDIFN, STORAGE 173 (5) IDVHAN=6600 /INPUT HANDLER ODVHAN=7200 /OUTPUT HANDLER BUFLEN=400 /FIELD 1 BUFFERS IBUF=200 OBUF=IBUF+BUFLEN
*10 INDEX0, 0 INDEX1, 0 INDEX2, 0 INDEX3, 0 INDEX4, 0 INDEX5, 0 INDEX6, 0 INDEX7, 0 *30 ARGCNT, 0 OCNT, 0 PATBAS, 0 PATSTS, 0 PDL, 0 TOPP, 0 TOPX, 0 INDR, 0 /ADDRESS OF INDIRECT TABLE IN FIELD 1 P1, 0 /PATTBL POINTER FOR PAT H1, 0 /HOLD VALUE THROUGH SPFUN CALLS T2, 0;0 /TEMPORARY STORAGE T3, 0 T4, 0;0 TX, 0 /EXTREMELY TEMPORARY STORAGE TXX, 0 SERX3, 0 /FOR PATSER SERX4, 0 PXT1, 0 /FOR pUTVAR PXT4, 0 XPTR, 0;0 IPTR, 0;0 OPTR, 0;0 INBLK, 0 INLEN, 0 IOFLG, 0 IHAN, 0 OHAN, 0 OUTBLK, 0 OUTLEN, 0 OUTLN, 0 ODEVNM, 0 RDFLG, 0 /READING FROM FILE FLAG (READH)
/ NEGATIVE CONSTANTS NONE= CLA CLL CMA NTWO= CLA CLL CMA RAL NTHREE= CLA CLL CMA RTL NC1, -1 NC3, -3 NC4, -4 NC5, -5 NC7, -7 NC10, -10 NC20, -20 NC215, -215 / POSITIVE CONSTANTS NOP= 7000 ZERO= CLA CLL ONE= CLA CLL IAC TWO= CLA CLL IAC RAL THREE= CLA CLL IAC CML RAL FOUR= CLA CLL IAC RTL SIX= CLA CLL CML IAC RTL C1, 1 C3, 3 C4, 4 C5, 5 C7, 7 C77, 77 C212, CLF, 212 C215, 215 C240, 240 C377, 377 C3777, 3777 C4000, ANCH, 4000 C5777, 5777 C7400, 7400
/ ROUTINE CALLING LINKS GPTR, GPTRX INTST, INTTST /TEST FOR <CTRL>C INTFIN, INTFN /ADDRESS TO RETURN FROM INTST LJUST, LJST /LEFT JUSTIFY ROUTINE LNKVAR, LNKVR /CREATE A LINK FOR VARIABLE STORAGE LUSR, 200 /USR ADDRESS WHEN LOCKED OUTBUF, OBUF /ADDRESS OF OUTPUT BUFFER PATSER, PATSR /SEARCH ROUTINE FOR PAT PATTBL, PATBL /PATTERN MATCHING TABLE PDLIST, PDLST /PUSHDOWN LIST RETLF, RETLFX RJUST, RJST UPDSPF, UPDFUN /UPDATE THE SPECIFIED INPUT FUNCTION USR, 7700 /NORMAL ADDRESS OF THE USR VARTBL, VARTB /PATTERN MATCHING TABLE / INTERNAL CALLING TABLE (ACCESSIBLE TO USER PROGRAMS) ICLTAB, CLRVAR, CLRVR /CLEAR VARIABLE ROUTINE CLVAR, CLVR /CLOSE VARIABLE ROUTINE FNDSPC, FNDSP /FIND SPACE IN VAR AREA ROUTINE GETCHR, GETCH /GET A CHAR ROUTINE PUTLST, PLST /ARGUMENT LIST FOR PUTVAR PUTVAR, PUTVR /HANDLE STRING ASSIGNMENT TO VARIABLES T1, 0 /(XXPVR) TEMP AND PUTVAR NAME PARAM SVSPCH, 0 /SAVE SPECIAL CHARACTERS ON INPUT IF -1 TOP, 0 WRCHAR, WRCHR /WRITE A CHARACTER TO OUTPUT
*154 /LOCATION TO CONTINUE PROGRAM AFTER A CONTROL C TLS /SET PRINTER FLAG JMP I INTFIN /RETURN FROM INTST *156 /CALLING TABLE INIT PUSHJ POPJ PUSH POP OPIN OPOUT CLIN CLOUT PAT ASC INT BASE, 12 /IS 10 (10) INDRCT ICLTAB DEVI FILSIZ, 0 / SPECIAL FUNCTION DEFINITIONS INPUT= 20 READ= 21 OUTPUT= 22 OUTHOL= 23 WRITE= 24 WRITEH= 25 POSR= 26 *177 / SUCCESS-FAIL FLAG SUCCES, 0
*2600 INIT, 0 ZERO TAD I INIT /GET LOC OF INDIRECT TABLE DCA INDR ISZ INIT TAD I INIT /GET FIRST VARIABLE PTR LOC DCA T1 ISZ INIT TAD I INIT /GET LENGTH OF PTR TABLE DCA T2 ISZ INIT TAD I INIT /GET TOP IN FIELD 1. DCA TOP TAD TOP DCA TOPP DCA SUCCES DCA RTSERR DCA SVSPCH /CLEAR SAVE SPECIAL CHARACTER FLAG DCA RDFLG /CLEAR READING FROM FILE FLAG DCA IOFLG /CLEAR FILES FLAG DCA PDL /CLEAR PDP TAD (17 DCA INDEX1 TAD NC10 DCA TX DCA I INDEX1 /CLEAR FUNCTION VARIABLES ISZ TX JMP .-2 NONE DCA POSR /SET POSR TAD T2 SNA /ANY VARIABLES? JMP INIT1 CMA IAC DCA T3 NONE TAD T1 DCA INDEX1 INITL1, DCA I INDEX1 /CLEAR VARIABLE POINTERS ISZ T3 /ARE WE DONE? JMP INITL1 /NO, GO AGAIN INIT1, DCA OCNT TLS /SET PRINTER FLAG. CIF 10 JMS I USR 13 /RESET ISZ INIT /SKIP RETURN JMP I INIT /AND DONE
/ THIS IS THE PATTERN MATCHING ROUTINE. PAT, 0 ZERO JMS I INTST /TEST FOR INTERRUPT TAD I PAT AND ANCH DCA PATSTS /SAVE STATUS BIT TAD I PAT AND C3777 CMA IAC DCA ARGCNT /NEG NUMBER OF WDS TAD ARGCNT DCA P1 ISZ PAT TAD I PAT /GET BASE STRING DCA H1 TAD H1 JMS I UPDSPF /UPDATE POSSIBLE SPECIAL FUNCTION JMP PATFL /FUNCTION FAILED TAD I H1 /GET THE VARIABLE POINTER DCA PATBAS DCA TOPX /USED WITH DEL NTWO TAD PATTBL DCA INDEX0 DCA I INDEX0 /CLEAR PATTBL-1 DCA I PATTBL /CLEAR FIRST LOC OF PATTBL TAD PATTBL /PTR TO MAIN TABLE DCA INDEX0 TAD PAT DCA INDEX5 /PTR TO ARG LIST
PAT0, TAD I INDEX5 /LOOP TO SETUP PATTBL - GET ARG DCA TX TAD TX AND NC10 SZA CLA /VARIABLE? JMP PAT4 /YES PAT2, TAD TX /GET BACK ARG DCA I INDEX0 /AND SAVE IN TABLE TAD TX /GET WHAT WE JUST COPIED TAD NC4 SNA CLA /NEWVAR? JMP PAT6 /YES, THEN IGNORE LENGTH WD ISZ P1 /DONE? JMP PAT0 /NO JMP PAT8 PAT4, TAD TX JMS I UPDSPF /POSSIBLY UPDATE INPUT FUNCTION JMP PATFL /FUNCTION FAILED TAD C5 /CODE FOR VAR DCA TX JMP PAT2 PAT6, TAD I INDEX5 /GET THE LENGTH WORD DCA TX /SAVE IT ISZ P1 /FOR NEWVAR WD JMP PAT2 PAT8, DCA I INDEX0 /LAST LOC IN PATTBL MUST BE ZERO
/ ENTER WITH PATSTS, PATTBL, AND ARGCNT SET. NONE TAD VARTBL /PTR FOR BACKUP TABLE DCA INDEX3 ISZ P1 /DISP FOR PATTBL (T1 WAS ZERO) TAD PATBAS DCA T2 /BASPTR ONE DCA T2+1 /CHAR 1 TAD PATDT /FOR DISP IN DISPATCH TABLE JMP PAT14 / DISPATCH TABLE PATDT, .+1 PAT44 /(1) DELETE CODE ("=") RTSER3 /(2) OR CODE ("!") PAT12 /(3) NO BACKSPACE ("<") PAT12+1 /(4) NEW VAR ("*---*") PAT16 /(5) VARIABLE RTSER3 /(6) UNASSIGNED RTSER3 /(7) UNASSIGNED RTSER3 /(0) UNASSIGNED (ALWAYS SHOULD BE) PAGE
/ HERE FOR "NO BACKSPACE" - JUST RESET THE VARTBL PTR BACK / TO THE BEGINNING. PAT10, NONE TAD VARTBL DCA INDEX3 /POINT TO THE START. / HERE FOR THE REGULAR MATCHING LOOP. PAT12, ISZ P1 /INC DISP FOR PATTBL /*** THIS SHOULD BE KEPT FIRST ZERO TAD PATDT2 PAT14, DCA TXX TAD P1 TAD PATTBL DCA TX NONE TAD I TX AND C7 /GET CODE (MINUS 1 WITH WRAPAROUND) TAD TXX /DISPATCH TABLE DCA TX TAD I TX DCA TX /GET ADDRESS OF HANDLER JMP I TX PATDT2, .+1 PAT20 /(1) DELETE PAT28 /(2) OR PAT10 /(3) NO BACKUP PAT34 /(4) NEW VAR PAT18 /(5) VAR RTSER4 /(6) UNASSIGNED RTSER4 /(7) UNASSIGNED PATSCS /(0) SPECIAL - END OF ARG LIST PAT16, TAD PATSTS SNA CLA /ANCHOR MODE? JMP PAT32 /NO - MUST FAKE "**" AT BEGINNING
/ HERE FOR THE VARIABLE SEARCH. PAT18, TAD T2 DCA T4 TAD T2+1 DCA T4+1 TAD P1 /GET PATTBL DISP TAD PAT /FIND REAL LIST JMS I GPTR /GET PTR TO DATA SNA JMP PAT12 DCA T3 JMS I PATSER /CALL SEARCH ROUTINE T2 /BASE STRING T3 /STRING TO CHECK FOR JMP PAT46 /ERROR RETURN - BACKUP OR CHECK OR JMS I LJUST /LEFT JUSTIFY # OF CHARS TAD C5 /CODE FOR VAR DCA T3 TAD P1 /GET DISP TAD PATTBL DCA TX TAD T3 DCA I TX JMP PAT12 /MATCHED - ALL'S WELL / HERE FOR DEL - DELETE MATCHING AREA FROM STRING AND /DO REPLACEMENT. PAT20, TAD T2 DCA PAT20X /SAVE BASPTR TAD T2+1 DCA PAT20X+1 TAD P1 DCA PAT20Y /SAVE DISP ISZ TOPX /FLAG JMP PATSCS /OTHERWISE, SUCCESS
/RETURN HERE ON SUCCESS TO HANDLE DELETE PAT22, TAD PAT20X DCA T2 /REPLACE BASPTR TAD PAT20X+1 DCA T2+1 TAD PAT20Y DCA P1 /AND DISP NONE TAD PUTLST DCA INDEX1 NONE TAD PATTBL /PTR TO OUR TABLE DCA T3 TAD I T3 /GET FIRST ELEMENT / (NEWVAR FROM NON-ANCH) SNA /ANYTHING THERE? JMP PAT24 /NO - DELETE FROM BEGINNING JMS I RJUST /RIGHT JUSTIFY CMA IAC /TWO'S COMPLEMENT THE # OF CHARS CLL RTL /B0 WILL BE 0, B1 WILL BE 1 / ROTATED: -LEN; CHAR 1 ISZ INDEX1 DCA I INDEX1 /AND -LENGTH (CHAR 1) TAD PATBAS /AND GET BASPTR TOO DCA I PUTLST PAT24, ISZ P1 /TO LOOK AT THE NEXT ARG TAD PATTBL TAD P1 DCA TXX TAD I TXX SNA CLA JMP PAT26 /ALMOST ALL DONE TAD PAT /GET REAL ARG LIST TAD P1 /GET DISP JMS I GPTR /GET REAL PTR DCA I INDEX1 ONE DCA I INDEX1 /ALL OF IT JMP PAT24
PAT26, TAD T2 DCA I INDEX1 /REST OF BASSTR TAD T2+1 DCA I INDEX1 /REST. NONE DCA I INDEX1 /END OF LIST TAD PAT DCA TXX TAD I TXX DCA T1 /VARPTR JMS I PUTVAR JMP PATFL /ERROR WRITiNG VARIABLE - FAIL JMP PAT60 /DONE - SUCCESS PAT20X, 0;0 /FOR BASPTR PAT20Y, 0 /FOR DISP / HERE ON "!" (OR). SET VARTBL AND SET T1 TO AFTER OR'S PAT28, ONE TAD P1 /DISP + 1 FOR VARTBL (VAR) DCA I INDEX3 TAD T2 DCA I INDEX3 /SAVE BASPTR TOO TAD T2+1 DCA I INDEX3 /CHAR CNT TOO JMP I (.&7600+200 /***PAGE BOUNDS PAGE
PAT30, ISZ P1 /UPDATE TAD P1 TAD PATTBL DCA INDEX1 NTWO TAD I INDEX1 /GET THIS WD SZA CLA /OR? JMP PAT12 /NO, CONTINUE ISZ P1 /REALLY UPDATE /(PAT5 INC'S T1) JMP PAT30 /YES, TRY NEXT /HERE IF NON-ANCH MODE AND VAR STARTS (FAKE ** AT BEGINNING) PAT32, NONE DCA P1 /POINT TO PATTBL-1 / HERE FOR *---*. MUST BE FOLLOWED BY VAR OR POSR UNLESS AT END. PAT34, ISZ P1 /POINT TO LENGTH WD SKP JMP PAT36 /P1:=0 I.E. FAKING ** TAD P1 TAD I (PAT DCA TXX TAD I TXX /GET LENGTH FROM ARG LIST SZA /TEST FOR */##* JMP PAT64 /YES ISZ P1 /POINT TO NEWVAR NAME PAT36, TAD P1 DCA INDEX4 /SAVE PTR TO NEWVAR DCA INDEX7 /CNT PAT37, ONE TAD INDEX4 TAD PATTBL DCA TXX TAD I TXX /GET NEWVAR CODE + 3 AND C7 /GET CODE TAD NC5 SZA /VAR CODE? JMP PAT40
/LOOP TO FIND A MATCH IN THE BASE STRING fOR THE VARIABLE FOLLoWING THE /NEWVAR IN THE PAtTERN (I.E. THE LIMIT OF THE FILLER). PAT38, ONE TAD INDEX4 TAD PAT /GET REAL VARPTR JMS I GPTR DCA T3 /PTR FOR SEARCH TAD T2 DCA T4 /SAVE BASPTR TAD T2+1 DCA T4+1 JMS I PATSER /MATCH? T4 T3 SKP /NO MATCH JMP PAT42 /MATCH - DONE TWO TAD INDEX4 TAD PATTBL DCA TXX NTWO TAD I TXX /GET VAR+1 SZA CLA /OR? JMP PAT62 /NO ISZ INDEX4 ISZ INDEX4 /UPDATE LIST PTR JMP PAT38 /TRY AGAIN
/ HERE TO BACKTRACK / /THE TABLE IS MADE UP OF THREE WORD BLOCKS: / 1. THE FIRST IS THE DISPLACEMENT AT WHICH THE OR OCCURRED (+1) / I.E. IT POINTS TO THE VAR AFTER THE OR. / 2. THE SECOND IS BASPTR (AS IT WAS THEN). / 3. THE THIRD IS THE CHAR COUNT OF BASPTR PATBAK, ZERO TAD INDEX3 CMA TAD VARTBL SNA CLA /TBL EMPTY? JMP PATFL /YES - FAIL UTTERLY NTHREE TAD INDEX3 DCA INDEX3 /DECREMENT PTR TAD INDEX3 DCA INDEX1 TAD I INDEX1 /GET OLD DISP DCA P1 TAD I INDEX1 /AND BASPTR DCA T2 TAD I INDEX1 DCA T2+1 NTHREE TAD P1 TAD PATTBL DCA INDEX1 TAD I INDEX1 /LOOK AT (PTR)-2 TAD NC4 SNA CLA /NEWVAR? JMP PATB1 /YES NTWO TAD P1 DCA TXX TAD I TXX /GET VAR BEFORE THE OR AND C7 /MASK OFF LENGTH DCA I TXX /AND REPLACE JMP PAT18 /AND GO PATB1, TAD I INDEX1 /GET LENGTH WD JMS I RJUST DCA INDEX7 /SAVE JMP PAT62 /AND GO
PAT40, TAD C3 /HERE WHEN FILLER NOT TERmINATED BY A VAR SPA CLA /EQUAL CODE OR END Of LIST? JMP PAT66 /YES - MATcH ALL THEN, eLSE MATCH NONE PAT42, ZERO /HERE ON ALMOST DONE WITH NEWVAR TAD P1 /GET DISP DCA I INDEX3 /FOR BACKUP TAD T2 /AND BASPTR DCA I INDEX3 / TAD T2+1 DCA I INDEX3 NONE /POINT TO LENGTH WD TAD P1 TAD PATTBL DCA TX TAD INDEX7 /GET CNT JMS I LJUST /LEFT JUSTIFY DCA I TX JMP PAT12 PAT44, NONE / HERE FOR DEL FIRST TAD PUTLST DCA INDEX1 DCA T2 /DON'T COPY BASPTR JMP PAT24 /GO PAGE PAT46, ONE / HERE IF VAR MATCH OR POSR MISSED TAD P1 TAD PATTBL DCA TX NTWO TAD I TX /GET (VAR)+1 SZA /TEST OR JMP PATBAK /NO GOOD - DO BACKUP ISZ P1 ISZ P1 /OR IS NEXT, POINT PAST IT TAD T4 DCA T2 /REPLACE BASPTR TAD T4+1 DCA T2+1 JMP PAT12+1 /GO
/ SUCCESS!! SET FLAG, SET RETURN LOC, SET NEWVARS, / AND DO REPLACEMENT. PATSCS, TAD PATBAS DCA T2 /RESET BASPTR ONE DCA T2+1 NONE TAD PATTBL DCA TX TAD I TX /GET NON-ANCH VAR NEWVAR WD SNA JMP PAT48 JMS I RJUST /RIGHT JUSTIFY JMS UPDBAS /UPDATE BASPTR JMP RTSER5 /SHOULDN'T FAIL PAT48, DCA P1 /POINT TO FIRST REAL ENTRY (-1) PAT50, ISZ P1 TAD P1 TAD PATTBL DCA TX TAD I TX AND C7 /GET CODE SNA /DONE? JMP PAT58 TAD NC4 /TEST NEWVAR SNA /? JMP PAT54 /YES TAD NC1 /TEST VAR (CODE 5) SZA CLA /? JMP PAT50 /NO, GO AGAIN PAT52, TAD I TX /GET WD AGAIN JMS I RJUST /RIGHT JUSTIFY SNA /ANY UPD? JMP PAT50 /NO JMS UPDBAS /YES, UPDATE BASPTR JMP RTSER6 /MUST JMP PAT50
PAT54, ISZ P1 /POINT TO LENGTH WD ISZ P1 /POINT TO NEWVAR NAME ISZ TX TAD PAT TAD P1 DCA TXX TAD I TXX /GET PTR SNA CLA /NULL? JMP PAT52 TAD PUTLST DCA INDEX1 TAD I TX /GET BACK WD JMS I RJUST /RIGHT JUSTIFY # OF CHARS DCA T3 /SAVE FOR UPD LATER TAD T3 SNA /ANY LENGTH? JMP PAT56 CMA IAC CLL RAL CLL RAL TAD T2+1 DCA I INDEX1 /SAVE -LENGTH TAD T2 /BUFADR JMP .+2 PAT56, DCA I INDEX1 DCA I PUTLST NONE DCA I INDEX1 /END. TAD I TXX /GET VARPTR DCA T1 JMS I PUTVAR JMP PATFL /ERROR REtURN FOR WRITE TAD T3 /GET LENGTH JMP PAT52+2 /UPD BASPTR
PAT58, TAD TOPX SZA CLA /DELETE SEEN? JMP PAT22 /YES - DO IT PAT60, SKP CLA /SET FOR SUCCESS PATFL, NONE /SET FOR FAIL DCA SUCCES TAD ARGCNT CMA IAC /COMPUTE DISP FOR RETURN TAD PAT DCA INDEX1 JMP I INDEX1 /DONE. PAT62, JMS I GETCHR /UPD BASPTR T2 JMP PATBAK /CAN'T - BACKUP ISZ INDEX7 /INC CNT ZERO TAD P1 DCA INDEX4 /RESET PTR JMP PAT37 /TRY AGAIN PAT64, JMS I RJUST /HERE ON *---/##* JMS UPDBAS /UPDATE BASPTR JMP PATBAK /NO GOOD ISZ P1 JMP PAT12 /DONE (PATTBL SHOULD BE SET) PAT66, JMS I GETCHR /hERE FOR FILLeR TO MATCH ALL T2 JMP PAT42 ISZ INDEX7 /INC COUNT JMP PAT66 PAGE
/ SEARCH ROUTINE. SEARCH (CALL)+1 FOR (CALL)+2 BEGINNING / IMMEADIATLY. THE PTR REFERRED TO BY (CALL)+1 IS UPDATED, / AND THE LENGTH OF (CALL)+2 IS RETURNED IN AC ON SUCCESS. PATSR, 0 TAD I PATSR /GET LOC OF BASPTR DCA SERX1 ISZ PATSR TAD PATSR /GET LOC OF MATCH PTR JMS I GPTR /GET MATCH PTR IAC SNA /POSR? (HAS POINTER OF NEGATIVE ONE) JMP SER4 TAD NC1 /NO - RESTORE DCA SERX2 ONE DCA SERX2+1 DCA SERX3 /CHAR CNT SER1, JMS I GETCHR /GET NEXT MATCH CHAR SERX2 JMP SER2 /ERROR RETURN - SUCCESS CMA IAC DCA SERX4 /SAVE (NEG) CHAR JMS I GETCHR /GET NEXT BASE CHAR SERX1, 0 JMP SER3 /ERROR RETURN - FAIL TAD SERX4 SZA CLA /MATCH? JMP SER3 /NO - FAIL ISZ SERX3 /YES - INC CNT JMP SER1 /TRY NEXT SER2, TAD SERX3 /GET CHAR CNT ISZ PATSR /TO SKIP SER3, ISZ PATSR /HERE TO FAIL JMP I PATSR SER4, TAD SERX1 /HERE ON POSR DCA SERX5 JMS I GETCHR /TRY TO GET BASE CHAR SERX5, 0 JMP SER2+1 /SUCCEED IF CANNOT ZERO JMP SER3 /OTHERWISE FAIL SERX2, 0;0
/ ROUTINE TO INCREMENT BASPTR BY C(AC). UPDBAS, 0 CMA IAC DCA UPDX /NEG CNT UPDB1, JMS I GETCHR T2 /BASPTR JMP I UPDBAS /FAIL - NON-SKIP RETURN ISZ UPDX /DONE? JMP UPDB1 /NO - GO AGAIN ISZ UPDBAS /YES - SET TO SKIP ZERO JMP I UPDBAS /AND RETURN UPDX, 0 XL1=. /PAGE ADDRESS LINK FOR INDRCT PAGE
/THIS ROUTINE OPENS THE SPECIFIED FILE ON DEVICE IDEV FOR INPUT. / CALL: JMS OPIN; VAR OPIN, 0 ZERO TAD (IFILNM-1 DCA INDEX0 TAD I OPIN /PTR TO VAR JMS FILEDC /DECODE NAME JMP OPINFL+1 /BAD NAME TAD DEVI DCA OPIH1 TAD DEVI+1 /GET 2ND WORD OF DEVICE NAME DCA OPIH1+1 /SAVE IT TAD (IDVHAN IAC /ALLOW TWO PAGE HANDLERS DCA OPIH2 JMS USRLOK /LOCK THE USR IN CORE CIF 10 JMS I LUSR 1 /FETCH THE HANDLER OPIH1, DEVICE XXXX OPIH2, 0 /HANDLER ADDRESS JMP OPINFL /FAIL TAD OPIH2 /GET ST ADR OF HANDLER DCA IHAN TAD (IFILNM DCA OPIL1 TAD OPIH1+1 /GET DEVICE NUMBER CIF 10 JMS I LUSR 2 /LOOKUP THE FILE OPIL1, 0 /FILENAME OPIL2, 0 /LENGTH GOES HERE JMP OPINFL /FAIL - FILE NOT FOUND
JMS USRDIS /DISMISS THE USR TAD OPIL1 /GET STARTING BLK NUMBER DCA INBLK TAD OPIL2 /GET LENGTH SNA /ANY LENGTH? ONE /NO - ASSUME NON-DIR DEVICE TAD NC1 DCA INLEN /CONTAINS -LEN - 1 TAD . />1200 - CAUSES READ TO GET A BUFFER DCA IPTR /PTR TO INPUT BUFFER TAD IOFLG AND C1 TAD C4000 /INPUT FILE FLAG DCA IOFLG /INPUT FILE READY OPIN1, DCA SUCCES /SET SUCCESS FLAG ISZ OPIN /SKIP JMP I OPIN /AND DONE OPINFL, JMS USRDIS NONE /HERE ON LOOKUP ERROR JMP OPIN1 /FAIL AND BACK
/THIS ROUTINE OPENS THE SPECIFIED FILE FOR OUTPUT ON DEVICE ODEV. / CALL: JMS OPOUT; VAR OPOUT, 0 ZERO TAD (OFILNM-1 DCA INDEX0 TAD I OPOUT JMS FILEDC /DECODE NAME JMP OUTFL+1 /BAD NAME TAD DEVO DCA OPOH1 TAD DEVO+1 DCA OPOH1+1 /SAVE WD TAD (ODVHAN IAC /ALLOW TWO PAGE HANDLERS DCA OPOH2 JMS USRLOK /GET THE USR CIF 10 JMS I LUSR 1 /GET THE HANDLER OPOH1, DEVICE XXXX OPOH2, 0 /HANDLER ADDRESS JMP OUTFL TAD OPOH1+1 /GET DEVICE NUMBER DCA ODEVNM TAD OPOH2 DCA OHAN /ST ADR OF HANDLER TAD (OFILNM DCA OPOO1 TAD FILSIZ /GET SIZE (0 IF UNDEF) JMS I LJUST TAD ODEVNM CIF 10 JMS I LUSR 3 /OPEN AN OUTPUT FILE OPOO1, 0 /FILENAME OPOO2, 0 /AVAILABLE LENGTH JMP OUTFL
JMS USRDIS /DISMISS USR TAD OPOO1 DCA OUTBLK /STARTING BLOCK NUMBER TAD OPOO2 SNA /ANY AVAIL? ONE /NO - ASSUME NON-DIR DEVICE DCA OUTLEN DCA OUTLN /CNT OF HOW MANY BLKS ARE USED TAD OUTBUF DCA OPTR /FOR PTR ONE DCA OPTR+1 TAD IOFLG AND C4000 TAD C1 /OUTPUT FILE FLAG DCA IOFLG OUT1, DCA SUCCES /SET SUCCES FLAG ISZ OPOUT JMP I OPOUT OUTFL, JMS USRDIS NONE /FAIL JMP OUT1 PAGE
/ PUSHDOWN LIST ROUTINES. THESE ROUTINES PERFORM MANIPULATION OF AN INTERNAL /STACK VIA THE LANGUAGE CONSTRUCTS PUSH, PUSHJ, POP AND POPJ. PUSHJ AND POPJ /ARE CONTROL CONSTRUCTS, AND PUSH AND POP ARE CONSTRUCTS THAT MAY BE USED TO /PRESERVE VARIABLES ON THE STACK. PUSH, 0 CLA CLL CML /MARK VARIABLE STORE ENTRY JMP .+3 PUSHJ, 0 CLA CLL TAD PDL TAD (-41 SMA CLA /SPACE LEFT? JMP RTSER0 /NO - OVERFLOW TAD PDLIST TAD PDL DCA TX ISZ PDL /UPDATE PDP SZL /PUSH? JMP PUSH1 /YES ONE TAD PUSHJ /GET WHERE TO RETURN TO DCA I TX /SAVE IN PDLIST TAD I PUSHJ /GET WHERE WE'RE GOING DCA TX JMP I TX /AND GO. PUSH1, TAD PUSH JMS I GPTR /GET THE VARIABLE POINTER DCA I TX /SAVE IT DCA I TXX /CLEAR THE VARIABLE (GPTR SETS TXX) ISZ PUSH JMP I PUSH /DONE
/ POPJ RETURNS CONTROL TO THE POINT IMMEDIATELY FOLLOWING THE PREVIOUS /PUSHJ. POP NAME GIVES NAME THE VALUE CONTAINED BY THE TOP ELEMENT OF THE /STACK. NOTE THAT NO TESTS ARE MADE - IF THE TOP ELEMENT IS NOT A VARIABLE /POINTER, UNDETERMINED RESULTS WILL OCCUR. POP, 0 CLA CMA CLL CML JMP .+3 POPJ, 0 CLA CMA CLL TAD PDL /(LINK NOW COMPLEMENT) SPA /ANYTHING IN LIST? JMP RTSER1 /NO DCA PDL /YES, DECREMENT PDP TAD PDL TAD PDLIST JMS I GPTR /SAVE WHERE TO GO IN TXX SZL CLA /POP OR POPJ? JMP I TXX /POPJ - JUMP TO THE ADDRESS TAD I POP /GET THE VARIABLE DCA TX TAD TXX /GET THE POINTER DCA I TX /PUT IN THE VARIABLE ISZ POP JMP I POP /GO BACK
/ ROUTINE TO CLOSE THE OUTPUT FILE. THIS CONSISTS OF /CLEARING THE FLAG, WRITING THE (PARTIAL) OUTPUT BUFFER /AS THE LAST BLOCK, AND THEN CALLING THE USR TO DO FINAL /DIRECTORY CLEANUP. CLOUT, 0 ZERO TAD IOFLG RAR SNL CLA /OUTPUT FILE OPEN? JMP CLOUTFL /NO - FAIL TAD (232 /CONTROL Z - END OF FILE JMS WRITH /WRITE IT JMP CLOUTFL TAD IOFLG AND C4000 /SAVE INPUT FILE FLAG DCA IOFLG /UPDATE TAD OPTR TAD (-OBUF SNA CLA /ANYTHING IN BUFFER? JMP CLOUT1 TAD OUTLN TAD OUTLEN SNA CLA /ROOM? JMP CLOUTFL /NO TAD OUTBLK DCA CLOUTX JMS I OHAN /WRITE OUT THE PARTIAL BUFFER 4210 /2 PAGES FROM FIELD 1 OBUF CLOUTX, 0 JMP CLOUTFL /FAIL ISZ OUTLN CLOUT1, TAD OUTLN /GET LENGTH DCA CLOC1 TAD ODEVNM /GET DEV NUMBER FOR CLOSE CIF 10 JMS I USR 4 /CLOSE OUTPUT FILE OFILNM CLOC1, 0 /LENGTH CLOUTFL, NONE /ERROR RETURN DCA SUCCES JMP I CLOUT /AND BACK XL2=. /PAGE ADDRESS LINK FOR FNDSP PAGE
/ ROUTINE TO CLOSE INPUT FILE. THIS CONSISTS ONLY / OF CLEARING THE FLAG FOR THE AVAILABILITY OF THE / INPUT FILE. CLIN, 0 ZERO TAD IOFLG AND C1 /CLOSE IT DCA IOFLG /UPDATE DCA SUCCES /SUCCESS JMP I CLIN
/THIS ROUTINE ACCEPTS A LINE FROM THE TELETYPE AND SETS THE VALUE OF /THE FUNCTION IDENTIFIER 'INPUT' TO ITS VALUE. ACCEPT, 0 TWO TAD TOP DCA XPTR ONE DCA XPTR+1 TAD PUTLST DCA INDEX6 TAD XPTR DCA I PUTLST /FOR PUTVAR ONE DCA I INDEX6 /ANY LENGTH - CHAR 1. NONE DCA I INDEX6 /ONLY ARG ACC0, KSF /GET CHAR FROM TELETYPE JMP .-1 KRB DCA T2 TAD T2 TAD (-203 /CODE FOR ^C SNA JMP ACC8 /TYPE ^C AND GO TO MONITOR TAD NC7 /(-212) SPA /AT OR ABOVE LINEFEED? JMP ACC1 /NO TAD NC3 /(-215) SPA /LINE MOVEMENT CHARACTER? JMP ACC11 SNA /NO - RETURN? JMP ACC3 /YES TAD NC10 SNA /^U (225) ? JMP ACC9 TAD (-152 SNA CLA /RUBOUT (377) ? JMP ACC6 ACC1, ZERO TAD T2 /GET BACK THE CHARACTER JMS CLPRN /TYPE IT JMP ACC5 /
ACC5, TAD T2 /GET BACK CHAR JMS I WRCHAR XPTR JMP ACC0 /Go AGAIN ACC3, TAD C215 JMS CLPRN / TAD C212 JMS CLPRN /PRINT LINEFEED FOR RETURN JMS I CLVAR /HERE TO FINISH VARIABLE STORAGE XPTR TAD (INPUT /GET INPUT VARIABLE HEADER DCA T1 JMS I PUTVAR /DO IT HLT /NO FAIL ISZ ACCEPT JMP I ACCEPT /AND BACK ACC6, TAD XPTR /HERE FOR RUBOUT CMA IAC TAD I PUTLST SZA CLA /CHARS IN? JMP ACC7 /YES NONE TAD XPTR+1 SZA CLA JMP ACC7 JMS I RETLF /NO - MUST TYPE RET-LF JMP ACC0 /AND BACK ACC7, TAD (334 /TYPE BACKSLASH JMS CLPRN NONE TAD XPTR+1 /DEC CHAR CNT DCA XPTR+1 TAD XPTR+1 SZA /PAST ONE? TAD (-2 SZA CLA /OR 3? JMP ACC0 /NO - OK NONE TAD XPTR DCA XPTR /YES - DEC WD PTR TAD XPTR+1 SZA CLA JMP ACC0 THREE DCA XPTR+1 JMP ACC0
ACC8, TAD (303 /"C" JMS ACC10 TAD (ACC0 DCA I INTST /SAVE THE CONTINUATION ADDRESS JMP I (7600 /GO TO OS/8 ACC9, TAD (325 /"U" JMS ACC10 JMP ACCEPT+1 ACC10, 0 DCA T3 TAD (336 JMS CLPRN TAD T3 JMS CLPRN JMS I RETLF JMP I ACC10 ACC11, ZERO TAD SVSPCH SNA CLA /SAVE SPECIAL CHARACTERS? JMP ACC0 /NO - IGNORE JMP ACC5 /YES - USE IT PAGE
/ ROUTINE TO READ A LINE FROM THE INPUT FILE. READH, 0 TAD IOFLG RAL SNL CLA /INPUT FILE AVAILABLE? JMP I READH /NO TWO TAD TOP DCA XPTR TAD XPTR DCA I PUTLST /FOR PUTVAR ONE DCA XPTR+1 READ1, TAD IPTR /GET PTR WD TAD (-IBUF-BUFLEN SPA CLA /OVER TOP? JMP READ2 /NO ISZ INLEN /ANY MORE IN FILE? SKP JMP I READH /NO - FAIL TAD INBLK /WHICH BLK TO READ DCA STBLK JMS I IHAN /CALL THE HANDLER 0210 /READ 2 PAGES TO FIELD 1 IBUF STBLK, 0 /BLOCK TO READ SMA CLA /ERROR RETURN - HARD OR SOFT? SKP JMP I READH /HARd ERROR - FAIL ISZ INBLK /GET NEXT ONE NEXT TIME TAD (IBUF DCA IPTR ONE DCA IPTR+1 READ2, ISZ RDFLG /SET READ FLAG JMS I GETCHR IPTR /GET NEXT CHAR JMP READ1 /NULL - TRY AGAIN TAD NC215 /RETURN? SNA JMP READ6 SMA /BELOW RETURN? JMP READ3 /NO - USE THE CHARACTER TAD C3 /YES - RESTORE IT
SMA /LINE MOVEMENT CHARACTER? JMP READ8 /YES TAD NC3 /NO - USE IT READ3, TAD C215 /RESTORE CHARACTER JMS I WRCHAR /AND WRITE IT XPTR JMP READ1 READ8, ISZ SVSPCH /SAVE THIS CHARACTER? JMP READ4 /NO TAD C212 /YES - RESTORE JMS I WRCHAR /WRITE IT XPTR NONE JMP .+2 READ4, ZERO DCA SVSPCH /FIX FLAG JMP READ1 /AND GO AGAIN READ6, JMS I CLVAR /RETURN - CLOSE VARIABLE XPTR TAD PUTLST DCA INDEX1 ONE DCA I INDEX1 /ALL NONE DCA I INDEX1 /AND THAT'S ALL TAD (READ DCA T1 JMS I PUTVAR HLT /NO FAIL ISZ READH JMP I READH
/THIS ROUTINE WRITES A SINGLE CHARACTER TO THE OUTPUT FILE. IT IS CALLED /(VIA FUNCTIONS 'WRITE' OR 'WRITEH') BY PUTVAR. WRITH, 0 DCA T4 /SAVE THE CHARACTER TAD IOFLG RAR SNL CLA /IS THE OUTPUT FILE AVAILABLE? JMP I WRITH /NO - FAIL TAD OPTR /GET THE OUTPUT POINTER TAD (-OBUF-BUFLEN SZA CLA /OVER THE TOP? JMP WR1 /NO TAD OUTLN TAD OUTLEN SNA CLA /ROOM LEFT IN THE FILE? JMP WRFL /NO - FAIL TAD OUTBLK /WHERE THE FULL BLOCK GOES DCA WRXX1
JMS I OHAN 4210 /WRITE TWO PAGES FROM FIELD 1 OBUF WRXX1, 0 JMP WRFL /OUTPUT ERROR ISZ OUTBLK ISZ OUTLN /UPDATE TAD OUTBUF DCA OPTR /NEW POINTER VALUE ONE DCA OPTR+1 NONE TAD OUTBUF DCA INDEX5 TAD C7400 /(-BUFLEN) DCA TX CDF 10 DCA I INDEX5 /CLEAR THE OUTPUT BUFFER ISZ TX JMP .-2 CDF 0 WR1, TAD T4 /GET THE CHARACTER JMS I WRCHAR /WRITE IT OPTR ISZ WRITH /SKIP ON SUCCESS JMP WR2 WRFL, TAD IOFLG /HERE ON FILE ERROR AND C4000 DCA IOFLG /CLEAR OUTPUT FILE BIT NONE WR2, DCA SUCCES JMP I WRITH /AND DONE PAGE
/ GET (OR WRITE) CHARACTER ACCORDING TO THE PTR IN (CALL+1). WRCHR, 0 DCA WRCX /SAVE CHAR DCA GWFLG /FLAG WRCHR TAD I WRCHR /GET POINTER JMP GET0 GETCH, 0 NONE DCA GWFLG TAD I GETCH /GET POINTER GET0, DCA GWPTR DCA GETX /BECAUSE GETCH MIGHT FAIL TAD I GWPTR /GET PTR SNA CLA /NULL? JMP GETRET /YES - RETURN TAD GWPTR DCA INDEX2 /TO CHAR # NONE TAD I INDEX2 SNA /1ST? JMP GET1 /YES TAD NC1 /NO, 2ND? SZA CLA JMP GET2 /NO - 3RD ONE /YES - 2ND GET1, TAD I GWPTR /GET PTR DCA TX CDF 10 ISZ GWFLG JMP WRC1 TAD I TX /GET CHAR AND C377 JMP GET3 GET2, NONE TAD I GWPTR DCA TX CDF 10 ISZ GWFLG JMP WRC2 TAD I TX AND C7400 /SAVE TOP BITS CLL RTR RTR DCA TXX ISZ TX TAD I TX AND C7400 CLL RTL RTL RAL TAD TXX
GET3, CDF 0 SNA /NULL CHAR? JMP GET4 /YES DCA GETX TAD GWPTR JMS UPDPTR /UPDATE PTR ISZ GETCH /SKIP FOR GETCH (SUCCESS) GETRET, CDF 0 ISZ GETCH ISZ WRCHR TAD GWFLG SMA SZA CLA /WRITE OR GET? JMP I WRCHR TAD GETX /CHAR JMP I GETCH /AND GO GET4, TAD RDFLG SZA CLA /READING FROM A FILE? JMP GET5 TAD GWFLG SZA CLA /GET OR WRITE? JMP GET3+4 /WRITE ONE TAD GWPTR DCA TX NTHREE TAD I TX SZA CLA /3RD? ONE /NO TAD I GWPTR /GET ADR OF SPECIAL CODE DCA INDEX2 CDF 10 TAD I INDEX2 /GET IT SNA /ZERO? JMP GETRET /YES - END OF STR (READ) IAC SNA CLA /END CODE? JMP GETRET TAD I INDEX2 /NO (ASSUME LINK) - GET CONT ADR CDF 0 DCA I GWPTR /UPD PTR ISZ GWPTR ONE DCA I GWPTR /CHAR 1 JMP GETCH+1 /GO AGAIN GET5, TAD GWPTR /NULL ON FILE READ JMS UPDPTR /UPDATE INPUT POINTER JMP GETRET /FAIL AND LET READH TRY AGAIN
WRC1, TAD WRCX /GET CHAR DCA I TX /SAVE JMP GET3 /FINISH WRC2, TAD WRCX /GET CHAR RTL RTL JMS WRC3 TAD WRCX RTR RTR RAR ISZ TX JMS WRC3 JMP GET3 /DONE WRC3, 0 AND C7400 /SAVE TOP DCA TXX TAD I TX /GET PRESENT WD AND C377 /SAVE THE LOW ORDER CHAR TAD TXX /ADD IN THE TOP ORDER 3RD CHAR DCA I TX /SAVE WHOLE WD JMP I WRC3 / GWFLG, 0 GWPTR, 0 WRCX, 0 GETX, 0 PAGE
/ ENTER WITH VARPTR IN T1. THE SHOULD BE A LIST IN / 'PLST' CONTAINING INFORMATION FOR PUTVAR IN THE / FOLLOWING FORMAT: / / WD 1/ LOCATION WHERE DATA STARTS. / WD 2/ -LENGTH OF STRING (B0-9); CHAR # (B10-11) / / THE LENGTH SPEC HAS PRECEDENCE ONLY IF THE STRING IS / AT LEAST THAT LENGTH. THE TABLE IS ENDED BY AN / ENTRY OF NEGATIVE ONE. PUTVR, 0 TAD T1 /GET VARPTR TAD NC20 SPA /IS IT A SPECIAL FUNCTION? JMP PUT0 TAD NC10 SMA JMP PUT0 /NO TAD (PUTSPF+10 DCA TX TAD I TX /GET THE HANDLING ROUTINE SNA /OUTPUT FUNCTION? JMP PUT0 /NO - IT'S A VARIABLE DCA PXT6 /SET THE FUNCTION FLAG JMP PUT1 PUT0, ZERO DCA PXT6 /CLEAR SPECIAL FUNCTION FLAG JMS I FNDSPC /GET SPACE FOR NON-VAR DCA PXT1 /AND PUT THERE TAD PXT1 DCA PXT2 ONE DCA PXT2+1 PUT1, DCA INDEX7 /CHAR CNT NONE TAD PUTLST DCA INDEX1
PUT2, ONE TAD I INDEX1 /GET NEXT VARPTR SNA JMP PUT7 /DONE TAD NC1 DCA PXT5 TAD I INDEX1 DCA TX TAD TX AND C3 DCA PXT5+1 TAD TX CLL RAR CLL RAR /V41 SZA /IF ZERO - LEAVE AS IS TAD C5777 /TO GIVE -LEN - 1 DCA PXT4 PUT3, TAD PXT6 SZA CLA /SPECIAL FUNCTION? JMP PUT4 /YES - DON'T WRITE INTO MEMORY THREE JMS PUT10 /<AT OR ABOVE> THE TOP SKP /NO JMP PUT4 /YES THREE /NO TAD PXT2 DCA TX CDF 10 TAD I TX CDF 0 TAD C7 SZA CLA /ROOM LEFT? JMP PUT6 /NO - LINK PUT4, ISZ PXT4 /GET NEXT CHAR - STR DONE? SKP JMP PUT2 /YES - TRY NEXT STR JMS I GETCHR /NO - GET CHAR PXT5 JMP PUT2 /GUESS IT'S DONE DCA TX TAD PXT6 SNA CLA /SPECIAL FUNCTION? JMP PUT5 TAD TX /YES - GET THE CHARACTER JMS I PXT6 /HANDLE IT JMP I PUTVR /fAIL JMP PUT4
PUT5, TAD TX JMS I WRCHAR PXT2 ISZ INDEX7 /INC CHAR CNT NTHREE TAD PXT2+1 SZA CLA /3RD? JMP PUT4 /NO - DON'T CHECK SIZE JMP PUT3 PUT6, JMS I LNKVAR PXT2 DCA PXT2 ONE DCA PXT2+1 JMP PUT3 PUT7, TAD PXT6 /GET THE SPECIAL FUNCTION CODE SZA CLA JMP PUT12 /IF SET - FINISH FUNCTION TAD INDEX7 SNA CLA /ANYTHING? JMP PUT9 /NO JMS I CLVAR PXT2 JMS PUT10 /OVER THE TOP? JMP PUT8 /NO TWO TAD PXT2 DCA TOP /YES - UPDATE TOP PUT8, TAD I T1 /GET VARPTR SZA / JMS I CLRVAR /CLEAR WHAT IT WAS TAD PXT1 DCA I T1 /UPD VARPTR JMP PUTS /AND DONE PUT9, DCA PXT1 /HERE ON NOTHING JMP PUT8 /JUST NO NEW PTR
PUT12, TAD T1 /GET THE SPECIAL FUNCTION CODE RAR SZL CLA /LOW ORDER BIT SET? JMP PUTS TAD C215 JMS I PXT6 /NO - PUT A RETURN OUT JMP I PUTVR /FAIL RETURN TAD C212 JMS I PXT6 JMP I PUTVR PUTS, ISZ PUTVR JMP I PUTVR /AND DONE PXT5, 0; 1 PXT6, 0 /SPECIAL FUNCTION FLAG AND POINTER PAGE
PUT10, 0 TAD PXT2 CMA IAC TAD TOP SMA SZA CLA /OVER THE TOP? JMP I PUT10 /NO TAD TOP /NO - POSSIBLE WRAPAROUND? SMA CLA JMP PUT11 /NO THREE /IN CASE WE'RE AT THE TOP TAD PXT2 SPA CLA /YES - IF POS. PUT11, ISZ PUT10 JMP I PUT10 PXT2, 0;1
/ THESE ARE THE ROUTINES TO EITHER CLOSE A VARIABLE /OR TO LINK IT. IN EITHER CASE, ZERO CHARS ARE WRITTEN /UP THROUGH THE NEXT 3RD CHAR, AND THEN THE NEXT WD IS /EITHER -1 OR -10 (END OR LINK, RESPECTIVELY). FOR END, /THE NEXT IS -1; AND FOR LINK, THE NEXT IS THE CONT ADR /(WHICH IS ALSO RETURNED IN THE AC). FOR CLOSE, THE AC /IS RETURNED AS ZERO. LNKVR, 0 NONE JMP .+3 CLVR, 0 ZERO DCA CLX1 TAD CLX1 SNA CLA /HOW CALLED? JMP .+3 TAD I LNKVR /LINK - GET ARG SKP TAD I CLVR /CLOSE - GET THAT ONE DCA CLX2 TAD CLX2 DCA CL1+1
CL1, JMS I WRCHAR /WRITE A ZERO 0 TAD .-1 /GET LOC OF PTR DCA INDEX2 TAD I INDEX2 TAD NC1 SZA CLA /BACK TO CHAR 1? JMP CL1 /NO - GO AGAIN NONE TAD I CLX2 DCA INDEX2 CDF 10 ISZ CLX1 /LINK OR CL? JMP CL2 /CLOSE - GO TAD NC10 /LINK - PUT -10 DCA I INDEX2 CDF 0 JMS I FNDSPC /FIND SPACE FOR CONT DCA CLX2 TAD CLX2 CDF 10 DCA I INDEX2 /SAVE LINK ADR CLRET, CDF 0 TAD CLX1 ISZ CLVR SZA CLA /CL OR LNK? JMP I CLVR /CLOSE - DONE ISZ LNKVR /SKIP OVER ARG TAD CLX2 /GET CONT JMP I LNKVR /DONE CL2, NONE DCA I INDEX2 NONE /2 END CODES DCA I INDEX2 JMP CLRET /AND DONE CLX1, 0 CLX2, 0
/ THIS ROUTINE LOADS -7'S OVER ALL THE SPACE USED BY / THE VARIABLE POINTED TO BY THE AC. CLRVR, 0 DCA TXX CDF 10 CLR0, TAD TXX DCA TX TAD I TX /GET TOP 4 BITS AND C7400 SZA CLA /ZERO THERE? JMP CLR2 ISZ TX TAD I TX /GET BOTTOM AND C7400 SZA CLA /TOTAL ZERO? JMP CLR2 /NO JMS CLRZ /YES - ZERO 1ST AND 2ND WD ONE TAD I TXX /GET SPECIAL CODE SZA /END? JMP CLR1 /NO JMS CLRZ CDF 0 JMP I CLRVR /DONE CLR1, TAD C7 SZA /LINK? JMP RTSER7 /NO - FATAL TAD NC7 /UNUSED DCA I TXX ISZ TXX TAD TXX DCA TX TAD I TXX /YES - GET CONT LOC DCA TXX TAD NC7 DCA I TX /ZERO LAST OF BLOCK JMP CLR0 /AND GO AGAIN CLR2, JMS CLRZ /HERE ON THIRD AND NOT ZERO JMP CLR0 CLRZ, 0 TAD NC7 DCA I TXX ISZ TXX TAD NC7 DCA I TXX ISZ TXX JMP I CLRZ /DONE XT2=.&7600+200 *XL2 /PAGE ADDRESS LINK FROM POPJ
/ ROUTINE TO FIND SPACE IN VAR STORAGE AREA FNDSP, 0 ZERO TAD TOPP DCA TX /TX IS WHERE WE LOOK FND0, TAD FNDSPS /# OF LOCS NEEDED CMA IAC /-# DCA TXX /TXX IS THE FREE LOC CNT CDF 10 SKP /DON'T INC LOC THE FIRST TIME /LOOP TO FIND (FNDSPS) FREE LOCS IN A ROW. FND1, ISZ TX TAD TX CMA IAC TAD TOP SNA CLA /ARE WE UP TO THE TOP? JMP FND4 /YES TAD I TX /NO - GET THE NEXT LOC TAD C7 SZA CLA /LOCATION USED? JMP FND5 /YES ISZ TXX /NO, INC CNT - DONE? JMP FND1 /NO TAD FNDSPS CMA IAC IAC /-# + 1 TAD TX /YES, GET PTR TO FREE SPACE FND2, CDF 0 JMP I FNDSP /DONE FND4, TAD FNDSPS /# NEEDED TAD TXX /AT THE TOP CMA IAC /TWO'S COMPLEMENT TAD TOP /CALCULATE FIRST FREE LOC JMP FND2 /AND DONE FND5, ISZ TX /LOCATION USED - CHECK NEXT JMP FND0 /TRY AGAIN FNDSPS, 16 /THIS VALUE IS ADJUSTABLE. *XT2
/ THE AC CONTAINS THE LOCATION OF THE PTR. UPDPTR, 0 DCA TX ONE TAD TX DCA TXX ISZ I TXX /ISZ CHAR NUM NTHREE TAD I TXX SPA /3RD OR 4TH? JMP UPD1 /NO - DONE ISZ I TX /YES - UPD WD PTR SZA /4TH? DCA I TXX /YES - ACTUALLY 1ST UPD1, ZERO JMP I UPDPTR /DONE.
/ THIS ROUTINE DECODES THE FILENAME POINTED TO (TO SOME /EXTENT) BY THE AC. INDEX0 SHOULD BE POINTING TO THE /FILENAME BLOCK. FILEDC, 0 DCA H1 TAD H1 /GET THE VARPTR JMS I UPDSPF /UPDATE IF SPECIAL FUNCTION JMP I FILEDC /FAIL TAD I H1 DCA XPTR ONE DCA XPTR+1 NTHREE /# OF WDS FOR NAME DCA T3 FILL1, JMS FILCH /GET AND FIX CHAR JMP FIL3 /PERIOD OR NOT THERE JMS I LJUST JMS I LJUST /LEFT JUSTIFY DCA T2 JMS FILCH /NEXT JMP FIL5 TAD T2 /GET REST OF WD DCA I INDEX0 /SAVE ISZ T3 /DONE WITH NAME? JMP FILL1 /NO - CONTINUE FILL2, JMS FILCH /YES - LOOK FOR END OR PERIOD SKP JMP FILL2 /GOT CHAR - TRY NEXT SNA /PERIOD? JMP FIL2-1 /NO - DONE FIL1, JMS FILCH /GET 1ST CHAR OF EXT JMP FIL6 /HERE ON DOT OR END JMS I LJUST JMS I LJUST DCA T2 JMS FILCH /GET 2ND CHAR JMP FIL7 FIL1A, TAD T2 /GET FULL EXT DCA I INDEX0 /SAVE FIL2, ISZ FILEDC /SKIP RETURN JMP I FILEDC /AND DONE
FIL3, SZA CLA /ODD CHAR DOT OR END? JMP FIL8 /DOT DCA I INDEX0 /ZERO REST OF BLK FIL4, ISZ T3 JMP .-2 JMP FIL2-1 /AND DONE FIL5, DCA TX /SAVE FLG TAD T2 /GET ODD CHAR DCA I INDEX0 ISZ TX /DOT OR END? JMP FIL4 /END SKP /DOT DCA I INDEX0 /ZER REST OF FILENAME BLK ISZ T3 /DONE? JMP .-2 /NO JMP FIL1 /AND DO NEXT FIL6, SZA /DOT OR END? JMP I FILEDC /DOT - ERROR JMP FIL2-1 /END - ZERO LAST AND DONE FIL7, SZA /DOT OR END? JMP I FILEDC /DOT - ERROR JMP FIL1A /END - SAVE ODD CHAR AND DONE FIL8, DCA I INDEX0 /HERE ON (1ST CHAR) DOT ISZ T3 /DONE? JMP .-2 /NO JMP FIL1 /YES
/ ROUTINE TO GET, CHECK AND CLEAN CHARACTER. FILCH, 0 JMS I GETCHR /GET CHARACTER XPTR JMP I FILCH /FAIL - CAN'T GET IT DCA TX TAD TX TAD (-256 SZA /TEST PERIOD JMP FILC1 /NO NONE /YES - AC TO -1 JMP I FILCH /AND DONE FILC1, TAD (-54 /ADD -Z SMA SZA /MUST BE <=0 JMP I FILEDC /IT ISN'T - FAIL COMPLETELY TAD (32 SPA SNA /NOW MUST BE >0 JMP FILC2 /NO - TEST NUMBER FILCOK, ISZ FILCH /YES - SKIP JMP I FILCH /AND DONE FILC2, TAD C7 SMA SZA /MUST BE <=0 JMP I FILEDC /NO - FAIL TAD (11 SPA /NOW MUST BE >=0 JMP I FILEDC /FAIL TAD (60 JMP FILCOK XL3=. /PAGE LINK ADDRESS FOR RETLFX, GPTRX PAGE
/ THESE ARE THE ROUTINES TO HANDLE ALL OF SNOBOL'S NUMBER /FACILITIES (AT THIS TIME). ONLY INTEGERS UP TO + OR -2048 /ARE ALLOWED. THE USER MUST DO ALL OPERATIONS. ASC, 0 ZERO /STRING TO NUMBER TAD I ASC DCA H1 TAD H1 JMS I UPDSPF /UPDATE IF FUNCTION JMP ASCFL TAD I H1 /GET VARPTR DCA T2 /SAVE IT ONE DCA T2+1 DCA T3 /TOTALS NONE DCA T4 /SIGN FLAG ASC1, JMS I GETCHR /GET THE NEXT CHAR T2 JMP ASC4 /ERROR RETURN -- DONE DCA TX /SAVE IT TAD BASE CMA IAC /-BASE TAD (-260 /-260 TAD TX /+NUM (260 AND UP) SMA /ONLY NEG HERE LEGAL JMP ASCFL TAD BASE /NOW POS WILL BE LEGAL NUM SMA /IS IT POS OR ZERO? JMP ASC2 /YES TAD C3 SZA /TEST MINUS SIGN JMP ASCFL /NO DCA T4 JMP ASC1 ASC2, DCA TX /SAVE DIGIT TAD BASE CMA IAC DCA TXX
ASC3, TAD T3 /MULT (BASE) * (TOTAL) ISZ TXX JMP ASC3 TAD TX /ADD NET DIGIT DCA T3 /SAVE NEW TOTAL JMP ASC1 /GO AGAIN ASC4, DCA SUCCES TAD T3 ISZ T4 /GET SIGN FLAG CMA IAC /GET NEG TOTAL JMP ASC6 /AND GO ASCFL, NONE DCA SUCCES /SET FOR FAIL ASC6, ISZ ASC JMP I ASC /AND DONE
INT, 0 DCA T1 /SAVE AC TAD TOP CDF 10 DCA T4 DCA I T4 TAD T4 DCA INDEX1 /JUNK STORAGE DCA I INDEX1 /NULL AT BEGINNING TAD T1 SMA CLA /NEGATIVE? JMP INT1 ISZ I T4 /SET SIGN FLAG TAD T1 CMA IAC /AND PRETEND IT'S POSITIVE DCA T1 INT1, DCA T2 /COUNT INT2, TAD BASE CMA IAC TAD T1 /TEST SIZE OF REMAINDER SPA /SMALL ENOUGH? JMP INT3 /YES DCA T1 /SUBTRACT BASE FROM ATOM ISZ T2 /INC CNT JMP INT2 /AND AGAIN INT3, TAD BASE /GET ATOM TAD (260 /MAKE ASCII DCA I INDEX1 /SAVE TAD T2 /GET CNT SZA /DONE? JMP INT1-1 /NO - CNT IS NEW #
TAD I T4 /SIGN SNA CLA JMP .+3 TAD (255 /MINUS SIGN DCA I INDEX1 /SAVE ONE TAD INDEX1 /PTR TO END OF # DCA XPTR ONE DCA XPTR+1 TAD INDEX1 DCA T1 INT5, TAD I T1 SNA JMP INT7 CDF 0 JMS I WRCHAR XPTR CDF 10 NONE TAD T1 DCA T1 JMP INT5 INT7, CDF 0 JMS I CLVAR /CLOSE VARIABLE XPTR ONE TAD INDEX1 DCA I PUTLST TAD PUTLST DCA INDEX1 ONE DCA I INDEX1 /ALL NONE DCA I INDEX1 TAD I INT /GET VARPTR DCA T1 JMS I PUTVAR HLT /NO FAIL ISZ INT JMP I INT /GO BACK XT1=.&7600+200 *XL1 /PAGE ADDRESS LINK FROM UPDBAS
/ THIS ROUTINE HANDLES ALL INDIRECT VARIABLES AND LABELS. IT /RETURNS WITH THE SUCCESS FLAG SET AND THE AC CONTAINING /THE VALUE FOR THE NAME. INDRCT, 0 ZERO TAD I INDRCT DCA TXX TAD TXX JMS I UPDSPF /UPDATE IF SPECIAL FUNCTION JMP RTSER2 TAD I TXX /GE THE VALUE SNA /NULL? JMP RTSER2 /YES - FAIL DCA T2 ONE DCA T2+1 TAD TOP /USE TOP FOR JUNK STORAGE DCA INDEX1 THREE /-# OF WDS DCA T1 IND0, JMS I GETCHR /GET THE NEXT CHAR T2 JMP IND1 /FAIL AND C77 /MAKE INTO SIXBIT JMS I LJUST JMS I LJUST /LEFT JUSTIFY DCA T3 JMS I GETCHR /GET THE NEXT CHAR T2 JMP INDA AND C77 INDA, TAD T3 /GET THE FULL WD CDF 10 DCA I INDEX1 /SAVE CDF 0 ISZ T1 /DONE? JMP IND0 /NO IND1, CDF 10 DCA I INDEX1 /ZERO AT THE END NONE TAD INDR /PTR TO TABLE DCA INDEX1
IND2, TAD TOP DCA T4 /PTR TO OUR NAME IND3, TAD I INDEX1 /GET NET WD FROM TABLE CMA IAC ISZ T4 TAD I T4 /AND WHAT WE'RE SEARCHING FOR SNA CLA /MATCH? JMP IND6 /YES TAD INDEX1 DCA TX IND4, TAD I TX /GET BACK WD FROM TABLE AND C77 ISZ TX SZA CLA /END OF ARG? JMP IND4 /NO TAD TX DCA INDEX1 /UPD PTR ISZ TX TAD I TX /GET 1ST WD OF NEXT ENTRY SZA CLA /EXIST? JMP IND2 /YES - TRY AGAIN JMP RTSER2 /ERROR IND6, TAD INDEX1 /HERE ON MATCH DCA TX TAD I TX AND C77 SZA CLA /DONE WITH TEST? JMP IND3 /NO - TRY NET WD TAD I T4 AND C77 SZA CLA JMP IND3 TAD I INDEX1 /GET VALUE CDF 0 ISZ INDRCT JMP I INDRCT /RETURN *XT1
/UPDFUN DETERMINES WHETHER THE AC CONTAINS A SPECIAL FUNCTION /IDENTIFIER. IF SO, IT UPDATES THE VALUE OF THAT FUNCTION. I.E. /IT CALLS EITHER ACCEPT OR READ FOR NEW INPUT. UPDFUN, 0 DCA TX TAD TX TAD NC20 SPA /IS THIS A SPECIAL FUNCTION? JMP UPDRET TAD NC10 SMA JMP UPDRET TAD (UPDIFN+10 /YES - GET THE ADDRESS OF THE FUNCTION DCA TX TAD I TX SNA /AN INPUT ROUTINE? JMP UPDRET DCA TX JMS I TX /YES - CALL IT SKP UPDRET, ISZ UPDFUN /SKIP ON SUCCESS ZERO DCA RDFLG /CLEAR READING FLAG JMP I UPDFUN
PRN, 0 DCA TX ISZ PRN /ALWAYS SUCCeEDs JMS I INTST /<CTRL>C TYPED? TAD TX TAD NC215 /RETURN? SNA DCA OCNT /YES - CNT BACK TO BEG TAD C4 /TAB? SNA CLA JMP PRN1 TAD TX JMS PRX JMP I PRN PRN1, TAD C240 /SPACE UNTIL RIGHT JMS PRX TAD OCNT AND C7 SZA CLA /POSITIONED RIGHT? JMP PRN1 JMP I PRN /YES - DONE PRX, 0 DCA TXX TAD TOP /KEEP TOP IN THE LIGHTS TSF JMP .-1 ZERO TAD TXX TLS TAD (-232 SMA SZA CLA /IS THIS A PRINTING CHARACTER? ISZ OCNT /YES - INC POS CNT JMP I PRX INTTST, 0 KSF /ANYTHING TYPED? INTFN, JMP I INTTST KRS /YES - GET IT TAD (-203 SZA CLA /CONTROL C? JMP I INTTST KCC /YES - ZERO FLAG JMP ACC8 /AND RETURN TO MONITOR XT3=. *XL3 /PAGE LINK ADDRESS FROM FILEDC
RETLFX, 0 TAD C215 JMS CLPRN TAD CLF JMS CLPRN JMP I RETLFX GPTRX, 0 DCA TXX TAD I TXX DCA TXX TAD I TXX JMP I GPTRX *XT3 CLPRN, 0 /CALL PRN WITHOuT a SKIP RETURN JMS PRN HLT JMP I CLPRN RJST, 0 CLL RAR CLL RAR CLL RAR JMP I RJST LJST, 0 CLL RAL CLL RAL CLL RAL JMP I LJST USRLOK, 0 CIF 10 JMS I USR 10 /LOCK THE USR IN CORE JMP I USRLOK USRDIS, 0 CIF 10 JMS I LUSR 11 /DISMISS THE USR FROM CORE JMP I USRDIS
/THIS ROUTINE HANDLES FATAL RUNTIME SYSTEM ERRORS. SOME ARE PROGRAMMER /INDUCED, SOME INDICATE FLAWS IN THE RUN TIME SYSTEM. RTSER7, ISZ RTSERR RTSER6, ISZ RTSERR RTSER5, ISZ RTSERR RTSER4, ISZ RTSERR RTSER3, ISZ RTSERR RTSER2, ISZ RTSERR RTSER1, ISZ RTSERR RTSER0, CDF 0 /PROTECT ZERO TAD ERRMSG DCA INDEX0 /POINTER TO FAILURE MESSGE RTSER, TAD I INDEX0 /GET THE NEXT CHAR FROM THE MESSAGE SNA JMP .+3 JMS CLPRN /TYPE IT JMP RTSER TAD RTSERR /GET THE ERROR CODE TAD (260 JMS CLPRN /GIVE IT JMP I (7600 /AND GO TO OS/8 RTSERR, 0 ERRMSG, .;215;212;"?;"S;"N;"O;"R;"T;"S;240;0 PAGE
/THIS PAGE CONTAINS TABLES USED FOR HANDLING THE SPECIAL FUNCTIONS /INPUT, OUTPUT, READ, WRITE, OUTHOLD, AND WRITEH / THIS TABLE IS FOR PUTVAR PUTSPF, 0 0 PRN /OUTPUT PRN /OUTHOLD WRITH /WRITE WRITH /WRITEH 0;0 / THIS TABLE IS FOR UPDFUN UPDIFN, ACCEPT /INPUT READH /READ 0;0;0;0;0;0
/ BLOCK DATA STORAGE. DEVI, DEVICE DSK DEVO, DEVICE DSK 4;0 / PATTBL-1, 2 -- FOR NON-ANCH VAR PATBL, ZBLOCK 30 IFILNM, ZBLOCK 4 OFILNM, ZBLOCK 4 VARTB, ZBLOCK 14 PLST, ZBLOCK 30 PDLST, ZBLOCK 40 / PUSHDOWN LIST. $$$$$$$$$$$$$$$$$$$



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