File SNOP51.LS (listing file)

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


/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 1 /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. 0000 *0 DECIMAL 000000 0063 51 /VERSION NUMBER OCTAL
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 2 / 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) 6600 IDVHAN=6600 /INPUT HANDLER 7200 ODVHAN=7200 /OUTPUT HANDLER 0400 BUFLEN=400 /FIELD 1 BUFFERS 0200 IBUF=200 0600 OBUF=IBUF+BUFLEN
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 3 0010 *10 000010 0000 INDEX0, 0 000011 0000 INDEX1, 0 000012 0000 INDEX2, 0 000013 0000 INDEX3, 0 000014 0000 INDEX4, 0 000015 0000 INDEX5, 0 000016 0000 INDEX6, 0 000017 0000 INDEX7, 0 0030 *30 000030 0000 ARGCNT, 0 000031 0000 OCNT, 0 000032 0000 PATBAS, 0 000033 0000 PATSTS, 0 000034 0000 PDL, 0 000035 0000 TOPP, 0 000036 0000 TOPX, 0 000037 0000 INDR, 0 /ADDRESS OF INDIRECT TABLE IN FIELD 1 000040 0000 P1, 0 /PATTBL POINTER FOR PAT 000041 0000 H1, 0 /HOLD VALUE THROUGH SPFUN CALLS 000042 0000 T2, 0;0 /TEMPORARY STORAGE 000043 0000 000044 0000 T3, 0 000045 0000 T4, 0;0 000046 0000 000047 0000 TX, 0 /EXTREMELY TEMPORARY STORAGE 000050 0000 TXX, 0 000051 0000 SERX3, 0 /FOR PATSER 000052 0000 SERX4, 0 000053 0000 PXT1, 0 /FOR pUTVAR 000054 0000 PXT4, 0 000055 0000 XPTR, 0;0 000056 0000 000057 0000 IPTR, 0;0 000060 0000 000061 0000 OPTR, 0;0 000062 0000 000063 0000 INBLK, 0 000064 0000 INLEN, 0 000065 0000 IOFLG, 0 000066 0000 IHAN, 0 000067 0000 OHAN, 0 000070 0000 OUTBLK, 0 000071 0000 OUTLEN, 0 000072 0000 OUTLN, 0 000073 0000 ODEVNM, 0 000074 0000 RDFLG, 0 /READING FROM FILE FLAG (READH)
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 4 / NEGATIVE CONSTANTS 7340 NONE= CLA CLL CMA 7344 NTWO= CLA CLL CMA RAL 7346 NTHREE= CLA CLL CMA RTL 000075 7777 NC1, -1 000076 7775 NC3, -3 000077 7774 NC4, -4 000100 7773 NC5, -5 000101 7771 NC7, -7 000102 7770 NC10, -10 000103 7760 NC20, -20 000104 7563 NC215, -215 / POSITIVE CONSTANTS 7000 NOP= 7000 7300 ZERO= CLA CLL 7301 ONE= CLA CLL IAC 7305 TWO= CLA CLL IAC RAL 7325 THREE= CLA CLL IAC CML RAL 7307 FOUR= CLA CLL IAC RTL 7327 SIX= CLA CLL CML IAC RTL 000105 0001 C1, 1 000106 0003 C3, 3 000107 0004 C4, 4 000110 0005 C5, 5 000111 0007 C7, 7 000112 0077 C77, 77 C212, 000113 0212 CLF, 212 000114 0215 C215, 215 000115 0240 C240, 240 000116 0377 C377, 377 000117 3777 C3777, 3777 C4000, 000120 4000 ANCH, 4000 000121 5777 C5777, 5777 000122 7400 C7400, 7400
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 5 / ROUTINE CALLING LINKS 000123 5760 GPTR, GPTRX 000124 6266 INTST, INTTST /TEST FOR <CTRL>C 000125 6270 INTFIN, INTFN /ADDRESS TO RETURN FROM INTST 000126 6310 LJUST, LJST /LEFT JUSTIFY ROUTINE 000127 5420 LNKVAR, LNKVR /CREATE A LINK FOR VARIABLE STORAGE 000130 0200 LUSR, 200 /USR ADDRESS WHEN LOCKED 000131 0600 OUTBUF, OBUF /ADDRESS OF OUTPUT BUFFER 000132 3600 PATSER, PATSR /SEARCH ROUTINE FOR PAT 000133 6426 PATTBL, PATBL /PATTERN MATCHING TABLE 000134 6532 PDLIST, PDLST /PUSHDOWN LIST 000135 5752 RETLF, RETLFX 000136 6303 RJUST, RJST 000137 6200 UPDSPF, UPDFUN /UPDATE THE SPECIFIED INPUT FUNCTION 000140 7700 USR, 7700 /NORMAL ADDRESS OF THE USR 000141 6466 VARTBL, VARTB /PATTERN MATCHING TABLE / INTERNAL CALLING TABLE (ACCESSIBLE TO USER PROGRAMS) ICLTAB, 000142 5504 CLRVAR, CLRVR /CLEAR VARIABLE ROUTINE 000143 5423 CLVAR, CLVR /CLOSE VARIABLE ROUTINE 000144 4326 FNDSPC, FNDSP /FIND SPACE IN VAR AREA ROUTINE 000145 5005 GETCHR, GETCH /GET A CHAR ROUTINE 000146 6502 PUTLST, PLST /ARGUMENT LIST FOR PUTVAR 000147 5200 PUTVAR, PUTVR /HANDLE STRING ASSIGNMENT TO VARIABLES 000150 0000 T1, 0 /(XXPVR) TEMP AND PUTVAR NAME PARAM 000151 0000 SVSPCH, 0 /SAVE SPECIAL CHARACTERS ON INPUT IF -1 000152 0000 TOP, 0 000153 5000 WRCHAR, WRCHR /WRITE A CHARACTER TO OUTPUT
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 6 0154 *154 /LOCATION TO CONTINUE PROGRAM AFTER A CONTROL C 000154 6046 TLS /SET PRINTER FLAG 000155 5525 JMP I INTFIN /RETURN FROM INTST 0156 *156 /CALLING TABLE 000156 2600 INIT 000157 4203 PUSHJ 000160 4236 POPJ 000161 4200 PUSH 000162 4233 POP 000163 4000 OPIN 000164 4065 OPOUT 000165 4400 CLIN 000166 4257 CLOUT 000167 2660 PAT 000170 6000 ASC 000171 6063 INT 000172 0012 BASE, 12 /IS 10 (10) 000173 3664 INDRCT 000174 0142 ICLTAB 000175 6420 DEVI 000176 0000 FILSIZ, 0 / SPECIAL FUNCTION DEFINITIONS 0020 INPUT= 20 0021 READ= 21 0022 OUTPUT= 22 0023 OUTHOL= 23 0024 WRITE= 24 0025 WRITEH= 25 0026 POSR= 26 0177 *177 / SUCCESS-FAIL FLAG 000177 0000 SUCCES, 0
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 7 2600 *2600 002600 0000 INIT, 0 002601 7300 ZERO 002602 1600 TAD I INIT /GET LOC OF INDIRECT TABLE 002603 3037 DCA INDR 002604 2200 ISZ INIT 002605 1600 TAD I INIT /GET FIRST VARIABLE PTR LOC 002606 3150 DCA T1 002607 2200 ISZ INIT 002610 1600 TAD I INIT /GET LENGTH OF PTR TABLE 002611 3042 DCA T2 002612 2200 ISZ INIT 002613 1600 TAD I INIT /GET TOP IN FIELD 1. 002614 3152 DCA TOP 002615 1152 TAD TOP 002616 3035 DCA TOPP 002617 3177 DCA SUCCES 002620 3777' DCA RTSERR 002621 3151 DCA SVSPCH /CLEAR SAVE SPECIAL CHARACTER FLAG 002622 3074 DCA RDFLG /CLEAR READING FROM FILE FLAG 002623 3065 DCA IOFLG /CLEAR FILES FLAG 002624 3034 DCA PDL /CLEAR PDP 002625 1376 TAD (17 002626 3011 DCA INDEX1 002627 1102 TAD NC10 002630 3047 DCA TX 002631 3411 DCA I INDEX1 /CLEAR FUNCTION VARIABLES 002632 2047 ISZ TX 002633 5231 JMP .-2 002634 7340 NONE 002635 3026 DCA POSR /SET POSR 002636 1042 TAD T2 002637 7450 SNA /ANY VARIABLES? 002640 5251 JMP INIT1 002641 7041 CMA IAC 002642 3044 DCA T3 002643 7340 NONE 002644 1150 TAD T1 002645 3011 DCA INDEX1 002646 3411 INITL1, DCA I INDEX1 /CLEAR VARIABLE POINTERS 002647 2044 ISZ T3 /ARE WE DONE? 002650 5246 JMP INITL1 /NO, GO AGAIN 002651 3031 INIT1, DCA OCNT 002652 6046 TLS /SET PRINTER FLAG. 002653 6212 CIF 10 002654 4540 JMS I USR 002655 0013 13 /RESET 002656 2200 ISZ INIT /SKIP RETURN 002657 5600 JMP I INIT /AND DONE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 8 / THIS IS THE PATTERN MATCHING ROUTINE. 002660 0000 PAT, 0 002661 7300 ZERO 002662 4524 JMS I INTST /TEST FOR INTERRUPT 002663 1660 TAD I PAT 002664 0120 AND ANCH 002665 3033 DCA PATSTS /SAVE STATUS BIT 002666 1660 TAD I PAT 002667 0117 AND C3777 002670 7041 CMA IAC 002671 3030 DCA ARGCNT /NEG NUMBER OF WDS 002672 1030 TAD ARGCNT 002673 3040 DCA P1 002674 2260 ISZ PAT 002675 1660 TAD I PAT /GET BASE STRING 002676 3041 DCA H1 002677 1041 TAD H1 002700 4537 JMS I UPDSPF /UPDATE POSSIBLE SPECIAL FUNCTION 002701 5775' JMP PATFL /FUNCTION FAILED 002702 1441 TAD I H1 /GET THE VARIABLE POINTER 002703 3032 DCA PATBAS 002704 3036 DCA TOPX /USED WITH DEL 002705 7344 NTWO 002706 1133 TAD PATTBL 002707 3010 DCA INDEX0 002710 3410 DCA I INDEX0 /CLEAR PATTBL-1 002711 3533 DCA I PATTBL /CLEAR FIRST LOC OF PATTBL 002712 1133 TAD PATTBL /PTR TO MAIN TABLE 002713 3010 DCA INDEX0 002714 1260 TAD PAT 002715 3015 DCA INDEX5 /PTR TO ARG LIST
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 9 002716 1415 PAT0, TAD I INDEX5 /LOOP TO SETUP PATTBL - GET ARG 002717 3047 DCA TX 002720 1047 TAD TX 002721 0102 AND NC10 002722 7640 SZA CLA /VARIABLE? 002723 5335 JMP PAT4 /YES 002724 1047 PAT2, TAD TX /GET BACK ARG 002725 3410 DCA I INDEX0 /AND SAVE IN TABLE 002726 1047 TAD TX /GET WHAT WE JUST COPIED 002727 1077 TAD NC4 002730 7650 SNA CLA /NEWVAR? 002731 5343 JMP PAT6 /YES, THEN IGNORE LENGTH WD 002732 2040 ISZ P1 /DONE? 002733 5316 JMP PAT0 /NO 002734 5347 JMP PAT8 002735 1047 PAT4, TAD TX 002736 4537 JMS I UPDSPF /POSSIBLY UPDATE INPUT FUNCTION 002737 5775' JMP PATFL /FUNCTION FAILED 002740 1110 TAD C5 /CODE FOR VAR 002741 3047 DCA TX 002742 5324 JMP PAT2 002743 1415 PAT6, TAD I INDEX5 /GET THE LENGTH WORD 002744 3047 DCA TX /SAVE IT 002745 2040 ISZ P1 /FOR NEWVAR WD 002746 5324 JMP PAT2 002747 3410 PAT8, DCA I INDEX0 /LAST LOC IN PATTBL MUST BE ZERO
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 10 / ENTER WITH PATSTS, PATTBL, AND ARGCNT SET. 002750 7340 NONE 002751 1141 TAD VARTBL /PTR FOR BACKUP TABLE 002752 3013 DCA INDEX3 002753 2040 ISZ P1 /DISP FOR PATTBL (T1 WAS ZERO) 002754 1032 TAD PATBAS 002755 3042 DCA T2 /BASPTR 002756 7301 ONE 002757 3043 DCA T2+1 /CHAR 1 002760 1362 TAD PATDT /FOR DISP IN DISPATCH TABLE 002761 5774' JMP PAT14 / DISPATCH TABLE 002762 2763 PATDT, .+1 002763 3361 PAT44 /(1) DELETE CODE ("=") 002764 6333 RTSER3 /(2) OR CODE ("!") 002765 3003 PAT12 /(3) NO BACKSPACE ("<") 002766 3004 PAT12+1 /(4) NEW VAR ("*---*") 002767 3033 PAT16 /(5) VARIABLE 002770 6333 RTSER3 /(6) UNASSIGNED 002771 6333 RTSER3 /(7) UNASSIGNED 002772 6333 RTSER3 /(0) UNASSIGNED (ALWAYS SHOULD BE) 002774 3006 002775 3530 002776 0017 002777 6353 3000 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 11 / HERE FOR "NO BACKSPACE" - JUST RESET THE VARTBL PTR BACK / TO THE BEGINNING. 003000 7340 PAT10, NONE 003001 1141 TAD VARTBL 003002 3013 DCA INDEX3 /POINT TO THE START. / HERE FOR THE REGULAR MATCHING LOOP. 003003 2040 PAT12, ISZ P1 /INC DISP FOR PATTBL /*** THIS SHOULD BE KEPT FIRST 003004 7300 ZERO 003005 1222 TAD PATDT2 003006 3050 PAT14, DCA TXX 003007 1040 TAD P1 003010 1133 TAD PATTBL 003011 3047 DCA TX 003012 7340 NONE 003013 1447 TAD I TX 003014 0111 AND C7 /GET CODE (MINUS 1 WITH WRAPAROUND) 003015 1050 TAD TXX /DISPATCH TABLE 003016 3047 DCA TX 003017 1447 TAD I TX 003020 3047 DCA TX /GET ADDRESS OF HANDLER 003021 5447 JMP I TX 003022 3023 PATDT2, .+1 003023 3065 PAT20 /(1) DELETE 003024 3161 PAT28 /(2) OR 003025 3000 PAT10 /(3) NO BACKUP 003026 3214 PAT34 /(4) NEW VAR 003027 3036 PAT18 /(5) VAR 003030 6332 RTSER4 /(6) UNASSIGNED 003031 6332 RTSER4 /(7) UNASSIGNED 003032 3417 PATSCS /(0) SPECIAL - END OF ARG LIST 003033 1033 PAT16, TAD PATSTS 003034 7650 SNA CLA /ANCHOR MODE? 003035 5777' JMP PAT32 /NO - MUST FAKE "**" AT BEGINNING
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 12 / HERE FOR THE VARIABLE SEARCH. 003036 1042 PAT18, TAD T2 003037 3045 DCA T4 003040 1043 TAD T2+1 003041 3046 DCA T4+1 003042 1040 TAD P1 /GET PATTBL DISP 003043 1776' TAD PAT /FIND REAL LIST 003044 4523 JMS I GPTR /GET PTR TO DATA 003045 7450 SNA 003046 5203 JMP PAT12 003047 3044 DCA T3 003050 4532 JMS I PATSER /CALL SEARCH ROUTINE 003051 0042 T2 /BASE STRING 003052 0044 T3 /STRING TO CHECK FOR 003053 5775' JMP PAT46 /ERROR RETURN - BACKUP OR CHECK OR 003054 4526 JMS I LJUST /LEFT JUSTIFY # OF CHARS 003055 1110 TAD C5 /CODE FOR VAR 003056 3044 DCA T3 003057 1040 TAD P1 /GET DISP 003060 1133 TAD PATTBL 003061 3047 DCA TX 003062 1044 TAD T3 003063 3447 DCA I TX 003064 5203 JMP PAT12 /MATCHED - ALL'S WELL / HERE FOR DEL - DELETE MATCHING AREA FROM STRING AND /DO REPLACEMENT. 003065 1042 PAT20, TAD T2 003066 3356 DCA PAT20X /SAVE BASPTR 003067 1043 TAD T2+1 003070 3357 DCA PAT20X+1 003071 1040 TAD P1 003072 3360 DCA PAT20Y /SAVE DISP 003073 2036 ISZ TOPX /FLAG 003074 5774' JMP PATSCS /OTHERWISE, SUCCESS
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 13 /RETURN HERE ON SUCCESS TO HANDLE DELETE 003075 1356 PAT22, TAD PAT20X 003076 3042 DCA T2 /REPLACE BASPTR 003077 1357 TAD PAT20X+1 003100 3043 DCA T2+1 003101 1360 TAD PAT20Y 003102 3040 DCA P1 /AND DISP 003103 7340 NONE 003104 1146 TAD PUTLST 003105 3011 DCA INDEX1 003106 7340 NONE 003107 1133 TAD PATTBL /PTR TO OUR TABLE 003110 3044 DCA T3 003111 1444 TAD I T3 /GET FIRST ELEMENT / (NEWVAR FROM NON-ANCH) 003112 7450 SNA /ANYTHING THERE? 003113 5323 JMP PAT24 /NO - DELETE FROM BEGINNING 003114 4536 JMS I RJUST /RIGHT JUSTIFY 003115 7041 CMA IAC /TWO'S COMPLEMENT THE # OF CHARS 003116 7106 CLL RTL /B0 WILL BE 0, B1 WILL BE 1 / ROTATED: -LEN; CHAR 1 003117 2011 ISZ INDEX1 003120 3411 DCA I INDEX1 /AND -LENGTH (CHAR 1) 003121 1032 TAD PATBAS /AND GET BASPTR TOO 003122 3546 DCA I PUTLST 003123 2040 PAT24, ISZ P1 /TO LOOK AT THE NEXT ARG 003124 1133 TAD PATTBL 003125 1040 TAD P1 003126 3050 DCA TXX 003127 1450 TAD I TXX 003130 7650 SNA CLA 003131 5341 JMP PAT26 /ALMOST ALL DONE 003132 1776' TAD PAT /GET REAL ARG LIST 003133 1040 TAD P1 /GET DISP 003134 4523 JMS I GPTR /GET REAL PTR 003135 3411 DCA I INDEX1 003136 7301 ONE 003137 3411 DCA I INDEX1 /ALL OF IT 003140 5323 JMP PAT24
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 14 003141 1042 PAT26, TAD T2 003142 3411 DCA I INDEX1 /REST OF BASSTR 003143 1043 TAD T2+1 003144 3411 DCA I INDEX1 /REST. 003145 7340 NONE 003146 3411 DCA I INDEX1 /END OF LIST 003147 1776' TAD PAT 003150 3050 DCA TXX 003151 1450 TAD I TXX 003152 3150 DCA T1 /VARPTR 003153 4547 JMS I PUTVAR 003154 5773' JMP PATFL /ERROR WRITiNG VARIABLE - FAIL 003155 5772' JMP PAT60 /DONE - SUCCESS 003156 0000 PAT20X, 0;0 /FOR BASPTR 003157 0000 003160 0000 PAT20Y, 0 /FOR DISP / HERE ON "!" (OR). SET VARTBL AND SET T1 TO AFTER OR'S 003161 7301 PAT28, ONE 003162 1040 TAD P1 /DISP + 1 FOR VARTBL (VAR) 003163 3413 DCA I INDEX3 003164 1042 TAD T2 003165 3413 DCA I INDEX3 /SAVE BASPTR TOO 003166 1043 TAD T2+1 003167 3413 DCA I INDEX3 /CHAR CNT TOO 003170 5771 JMP I (.&7600+200 /***PAGE BOUNDS 003171 3200 003172 3527 003173 3530 003174 3417 003175 3400 003176 2660 003177 3212 3200 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 15 003200 2040 PAT30, ISZ P1 /UPDATE 003201 1040 TAD P1 003202 1133 TAD PATTBL 003203 3011 DCA INDEX1 003204 7344 NTWO 003205 1411 TAD I INDEX1 /GET THIS WD 003206 7640 SZA CLA /OR? 003207 5777' JMP PAT12 /NO, CONTINUE 003210 2040 ISZ P1 /REALLY UPDATE /(PAT5 INC'S T1) 003211 5200 JMP PAT30 /YES, TRY NEXT /HERE IF NON-ANCH MODE AND VAR STARTS (FAKE ** AT BEGINNING) 003212 7340 PAT32, NONE 003213 3040 DCA P1 /POINT TO PATTBL-1 / HERE FOR *---*. MUST BE FOLLOWED BY VAR OR POSR UNLESS AT END. 003214 2040 PAT34, ISZ P1 /POINT TO LENGTH WD 003215 7410 SKP 003216 5226 JMP PAT36 /P1:=0 I.E. FAKING ** 003217 1040 TAD P1 003220 1776 TAD I (PAT 003221 3050 DCA TXX 003222 1450 TAD I TXX /GET LENGTH FROM ARG LIST 003223 7440 SZA /TEST FOR */##* 003224 5775' JMP PAT64 /YES 003225 2040 ISZ P1 /POINT TO NEWVAR NAME 003226 1040 PAT36, TAD P1 003227 3014 DCA INDEX4 /SAVE PTR TO NEWVAR 003230 3017 DCA INDEX7 /CNT 003231 7301 PAT37, ONE 003232 1014 TAD INDEX4 003233 1133 TAD PATTBL 003234 3050 DCA TXX 003235 1450 TAD I TXX /GET NEWVAR CODE + 3 003236 0111 AND C7 /GET CODE 003237 1100 TAD NC5 003240 7440 SZA /VAR CODE? 003241 5337 JMP PAT40
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 16 /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). 003242 7301 PAT38, ONE 003243 1014 TAD INDEX4 003244 1776' TAD PAT /GET REAL VARPTR 003245 4523 JMS I GPTR 003246 3044 DCA T3 /PTR FOR SEARCH 003247 1042 TAD T2 003250 3045 DCA T4 /SAVE BASPTR 003251 1043 TAD T2+1 003252 3046 DCA T4+1 003253 4532 JMS I PATSER /MATCH? 003254 0045 T4 003255 0044 T3 003256 7410 SKP /NO MATCH 003257 5342 JMP PAT42 /MATCH - DONE 003260 7305 TWO 003261 1014 TAD INDEX4 003262 1133 TAD PATTBL 003263 3050 DCA TXX 003264 7344 NTWO 003265 1450 TAD I TXX /GET VAR+1 003266 7640 SZA CLA /OR? 003267 5774' JMP PAT62 /NO 003270 2014 ISZ INDEX4 003271 2014 ISZ INDEX4 /UPDATE LIST PTR 003272 5242 JMP PAT38 /TRY AGAIN
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 17 / 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 003273 7300 PATBAK, ZERO 003274 1013 TAD INDEX3 003275 7040 CMA 003276 1141 TAD VARTBL 003277 7650 SNA CLA /TBL EMPTY? 003300 5773' JMP PATFL /YES - FAIL UTTERLY 003301 7346 NTHREE 003302 1013 TAD INDEX3 003303 3013 DCA INDEX3 /DECREMENT PTR 003304 1013 TAD INDEX3 003305 3011 DCA INDEX1 003306 1411 TAD I INDEX1 /GET OLD DISP 003307 3040 DCA P1 003310 1411 TAD I INDEX1 /AND BASPTR 003311 3042 DCA T2 003312 1411 TAD I INDEX1 003313 3043 DCA T2+1 003314 7346 NTHREE 003315 1040 TAD P1 003316 1133 TAD PATTBL 003317 3011 DCA INDEX1 003320 1411 TAD I INDEX1 /LOOK AT (PTR)-2 003321 1077 TAD NC4 003322 7650 SNA CLA /NEWVAR? 003323 5333 JMP PATB1 /YES 003324 7344 NTWO 003325 1040 TAD P1 003326 3050 DCA TXX 003327 1450 TAD I TXX /GET VAR BEFORE THE OR 003330 0111 AND C7 /MASK OFF LENGTH 003331 3450 DCA I TXX /AND REPLACE 003332 5772' JMP PAT18 /AND GO 003333 1411 PATB1, TAD I INDEX1 /GET LENGTH WD 003334 4536 JMS I RJUST 003335 3017 DCA INDEX7 /SAVE 003336 5774' JMP PAT62 /AND GO
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 18 003337 1106 PAT40, TAD C3 /HERE WHEN FILLER NOT TERmINATED BY A VAR 003340 7710 SPA CLA /EQUAL CODE OR END Of LIST? 003341 5771' JMP PAT66 /YES - MATcH ALL THEN, eLSE MATCH NONE 003342 7300 PAT42, ZERO /HERE ON ALMOST DONE WITH NEWVAR 003343 1040 TAD P1 /GET DISP 003344 3413 DCA I INDEX3 /FOR BACKUP 003345 1042 TAD T2 /AND BASPTR 003346 3413 DCA I INDEX3 / 003347 1043 TAD T2+1 003350 3413 DCA I INDEX3 003351 7340 NONE /POINT TO LENGTH WD 003352 1040 TAD P1 003353 1133 TAD PATTBL 003354 3047 DCA TX 003355 1017 TAD INDEX7 /GET CNT 003356 4526 JMS I LJUST /LEFT JUSTIFY 003357 3447 DCA I TX 003360 5777' JMP PAT12 003361 7340 PAT44, NONE / HERE FOR DEL FIRST 003362 1146 TAD PUTLST 003363 3011 DCA INDEX1 003364 3042 DCA T2 /DON'T COPY BASPTR 003365 5770' JMP PAT24 /GO 003370 3123 003371 3554 003372 3036 003373 3530 003374 3537 003375 3547 003376 2660 003377 3003 3400 PAGE 003400 7301 PAT46, ONE / HERE IF VAR MATCH OR POSR MISSED 003401 1040 TAD P1 003402 1133 TAD PATTBL 003403 3047 DCA TX 003404 7344 NTWO 003405 1447 TAD I TX /GET (VAR)+1 003406 7440 SZA /TEST OR 003407 5777' JMP PATBAK /NO GOOD - DO BACKUP 003410 2040 ISZ P1 003411 2040 ISZ P1 /OR IS NEXT, POINT PAST IT 003412 1045 TAD T4 003413 3042 DCA T2 /REPLACE BASPTR 003414 1046 TAD T4+1 003415 3043 DCA T2+1 003416 5776' JMP PAT12+1 /GO
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 19 / SUCCESS!! SET FLAG, SET RETURN LOC, SET NEWVARS, / AND DO REPLACEMENT. 003417 1032 PATSCS, TAD PATBAS 003420 3042 DCA T2 /RESET BASPTR 003421 7301 ONE 003422 3043 DCA T2+1 003423 7340 NONE 003424 1133 TAD PATTBL 003425 3047 DCA TX 003426 1447 TAD I TX /GET NON-ANCH VAR NEWVAR WD 003427 7450 SNA 003430 5234 JMP PAT48 003431 4536 JMS I RJUST /RIGHT JUSTIFY 003432 4775' JMS UPDBAS /UPDATE BASPTR 003433 5774' JMP RTSER5 /SHOULDN'T FAIL 003434 3040 PAT48, DCA P1 /POINT TO FIRST REAL ENTRY (-1) 003435 2040 PAT50, ISZ P1 003436 1040 TAD P1 003437 1133 TAD PATTBL 003440 3047 DCA TX 003441 1447 TAD I TX 003442 0111 AND C7 /GET CODE 003443 7450 SNA /DONE? 003444 5324 JMP PAT58 003445 1077 TAD NC4 /TEST NEWVAR 003446 7450 SNA /? 003447 5262 JMP PAT54 /YES 003450 1075 TAD NC1 /TEST VAR (CODE 5) 003451 7640 SZA CLA /? 003452 5235 JMP PAT50 /NO, GO AGAIN 003453 1447 PAT52, TAD I TX /GET WD AGAIN 003454 4536 JMS I RJUST /RIGHT JUSTIFY 003455 7450 SNA /ANY UPD? 003456 5235 JMP PAT50 /NO 003457 4775' JMS UPDBAS /YES, UPDATE BASPTR 003460 5773' JMP RTSER6 /MUST 003461 5235 JMP PAT50
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 20 003462 2040 PAT54, ISZ P1 /POINT TO LENGTH WD 003463 2040 ISZ P1 /POINT TO NEWVAR NAME 003464 2047 ISZ TX 003465 1772' TAD PAT 003466 1040 TAD P1 003467 3050 DCA TXX 003470 1450 TAD I TXX /GET PTR 003471 7650 SNA CLA /NULL? 003472 5253 JMP PAT52 003473 1146 TAD PUTLST 003474 3011 DCA INDEX1 003475 1447 TAD I TX /GET BACK WD 003476 4536 JMS I RJUST /RIGHT JUSTIFY # OF CHARS 003477 3044 DCA T3 /SAVE FOR UPD LATER 003500 1044 TAD T3 003501 7450 SNA /ANY LENGTH? 003502 5312 JMP PAT56 003503 7041 CMA IAC 003504 7104 CLL RAL 003505 7104 CLL RAL 003506 1043 TAD T2+1 003507 3411 DCA I INDEX1 /SAVE -LENGTH 003510 1042 TAD T2 /BUFADR 003511 5313 JMP .+2 003512 3411 PAT56, DCA I INDEX1 003513 3546 DCA I PUTLST 003514 7340 NONE 003515 3411 DCA I INDEX1 /END. 003516 1450 TAD I TXX /GET VARPTR 003517 3150 DCA T1 003520 4547 JMS I PUTVAR 003521 5330 JMP PATFL /ERROR REtURN FOR WRITE 003522 1044 TAD T3 /GET LENGTH 003523 5255 JMP PAT52+2 /UPD BASPTR
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 21 003524 1036 PAT58, TAD TOPX 003525 7640 SZA CLA /DELETE SEEN? 003526 5771' JMP PAT22 /YES - DO IT 003527 7610 PAT60, SKP CLA /SET FOR SUCCESS 003530 7340 PATFL, NONE /SET FOR FAIL 003531 3177 DCA SUCCES 003532 1030 TAD ARGCNT 003533 7041 CMA IAC /COMPUTE DISP FOR RETURN 003534 1772' TAD PAT 003535 3011 DCA INDEX1 003536 5411 JMP I INDEX1 /DONE. 003537 4545 PAT62, JMS I GETCHR /UPD BASPTR 003540 0042 T2 003541 5777' JMP PATBAK /CAN'T - BACKUP 003542 2017 ISZ INDEX7 /INC CNT 003543 7300 ZERO 003544 1040 TAD P1 003545 3014 DCA INDEX4 /RESET PTR 003546 5770' JMP PAT37 /TRY AGAIN 003547 4536 PAT64, JMS I RJUST /HERE ON *---/##* 003550 4775' JMS UPDBAS /UPDATE BASPTR 003551 5777' JMP PATBAK /NO GOOD 003552 2040 ISZ P1 003553 5767' JMP PAT12 /DONE (PATTBL SHOULD BE SET) 003554 4545 PAT66, JMS I GETCHR /hERE FOR FILLeR TO MATCH ALL 003555 0042 T2 003556 5766' JMP PAT42 003557 2017 ISZ INDEX7 /INC COUNT 003560 5354 JMP PAT66 003566 3342 003567 3003 003570 3231 003571 3075 003572 2660 003573 6330 003574 6331 003575 3650 003576 3004 003577 3273 3600 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 22 / 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. 003600 0000 PATSR, 0 003601 1600 TAD I PATSR /GET LOC OF BASPTR 003602 3224 DCA SERX1 003603 2200 ISZ PATSR 003604 1200 TAD PATSR /GET LOC OF MATCH PTR 003605 4523 JMS I GPTR /GET MATCH PTR 003606 7001 IAC 003607 7450 SNA /POSR? (HAS POINTER OF NEGATIVE ONE) 003610 5237 JMP SER4 003611 1075 TAD NC1 /NO - RESTORE 003612 3246 DCA SERX2 003613 7301 ONE 003614 3247 DCA SERX2+1 003615 3051 DCA SERX3 /CHAR CNT 003616 4545 SER1, JMS I GETCHR /GET NEXT MATCH CHAR 003617 3646 SERX2 003620 5233 JMP SER2 /ERROR RETURN - SUCCESS 003621 7041 CMA IAC 003622 3052 DCA SERX4 /SAVE (NEG) CHAR 003623 4545 JMS I GETCHR /GET NEXT BASE CHAR 003624 0000 SERX1, 0 003625 5235 JMP SER3 /ERROR RETURN - FAIL 003626 1052 TAD SERX4 003627 7640 SZA CLA /MATCH? 003630 5235 JMP SER3 /NO - FAIL 003631 2051 ISZ SERX3 /YES - INC CNT 003632 5216 JMP SER1 /TRY NEXT 003633 1051 SER2, TAD SERX3 /GET CHAR CNT 003634 2200 ISZ PATSR /TO SKIP 003635 2200 SER3, ISZ PATSR /HERE TO FAIL 003636 5600 JMP I PATSR 003637 1224 SER4, TAD SERX1 /HERE ON POSR 003640 3242 DCA SERX5 003641 4545 JMS I GETCHR /TRY TO GET BASE CHAR 003642 0000 SERX5, 0 003643 5234 JMP SER2+1 /SUCCEED IF CANNOT 003644 7300 ZERO 003645 5235 JMP SER3 /OTHERWISE FAIL 003646 0000 SERX2, 0;0 003647 0000
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 23 / ROUTINE TO INCREMENT BASPTR BY C(AC). 003650 0000 UPDBAS, 0 003651 7041 CMA IAC 003652 3263 DCA UPDX /NEG CNT 003653 4545 UPDB1, JMS I GETCHR 003654 0042 T2 /BASPTR 003655 5650 JMP I UPDBAS /FAIL - NON-SKIP RETURN 003656 2263 ISZ UPDX /DONE? 003657 5253 JMP UPDB1 /NO - GO AGAIN 003660 2250 ISZ UPDBAS /YES - SET TO SKIP 003661 7300 ZERO 003662 5650 JMP I UPDBAS /AND RETURN 003663 0000 UPDX, 0 3664 XL1=. /PAGE ADDRESS LINK FOR INDRCT 4000 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 24 /THIS ROUTINE OPENS THE SPECIFIED FILE ON DEVICE IDEV FOR INPUT. / CALL: JMS OPIN; VAR 004000 0000 OPIN, 0 004001 7300 ZERO 004002 1377 TAD (IFILNM-1 004003 3010 DCA INDEX0 004004 1600 TAD I OPIN /PTR TO VAR 004005 4776' JMS FILEDC /DECODE NAME 004006 5263 JMP OPINFL+1 /BAD NAME 004007 1775' TAD DEVI 004010 3222 DCA OPIH1 004011 1774' TAD DEVI+1 /GET 2ND WORD OF DEVICE NAME 004012 3223 DCA OPIH1+1 /SAVE IT 004013 1373 TAD (IDVHAN 004014 7001 IAC /ALLOW TWO PAGE HANDLERS 004015 3224 DCA OPIH2 004016 4772' JMS USRLOK /LOCK THE USR IN CORE 004017 6212 CIF 10 004020 4530 JMS I LUSR 004021 0001 1 /FETCH THE HANDLER 004022 3030 OPIH1, DEVICE XXXX 004023 3030 004024 0000 OPIH2, 0 /HANDLER ADDRESS 004025 5262 JMP OPINFL /FAIL 004026 1224 TAD OPIH2 /GET ST ADR OF HANDLER 004027 3066 DCA IHAN 004030 1371 TAD (IFILNM 004031 3236 DCA OPIL1 004032 1223 TAD OPIH1+1 /GET DEVICE NUMBER 004033 6212 CIF 10 004034 4530 JMS I LUSR 004035 0002 2 /LOOKUP THE FILE 004036 0000 OPIL1, 0 /FILENAME 004037 0000 OPIL2, 0 /LENGTH GOES HERE 004040 5262 JMP OPINFL /FAIL - FILE NOT FOUND
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 25 004041 4770' JMS USRDIS /DISMISS THE USR 004042 1236 TAD OPIL1 /GET STARTING BLK NUMBER 004043 3063 DCA INBLK 004044 1237 TAD OPIL2 /GET LENGTH 004045 7450 SNA /ANY LENGTH? 004046 7301 ONE /NO - ASSUME NON-DIR DEVICE 004047 1075 TAD NC1 004050 3064 DCA INLEN /CONTAINS -LEN - 1 004051 1251 TAD . />1200 - CAUSES READ TO GET A BUFFER 004052 3057 DCA IPTR /PTR TO INPUT BUFFER 004053 1065 TAD IOFLG 004054 0105 AND C1 004055 1120 TAD C4000 /INPUT FILE FLAG 004056 3065 DCA IOFLG /INPUT FILE READY 004057 3177 OPIN1, DCA SUCCES /SET SUCCESS FLAG 004060 2200 ISZ OPIN /SKIP 004061 5600 JMP I OPIN /AND DONE 004062 4770' OPINFL, JMS USRDIS 004063 7340 NONE /HERE ON LOOKUP ERROR 004064 5257 JMP OPIN1 /FAIL AND BACK
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 26 /THIS ROUTINE OPENS THE SPECIFIED FILE FOR OUTPUT ON DEVICE ODEV. / CALL: JMS OPOUT; VAR 004065 0000 OPOUT, 0 004066 7300 ZERO 004067 1367 TAD (OFILNM-1 004070 3010 DCA INDEX0 004071 1665 TAD I OPOUT 004072 4776' JMS FILEDC /DECODE NAME 004073 5356 JMP OUTFL+1 /BAD NAME 004074 1766' TAD DEVO 004075 3307 DCA OPOH1 004076 1765' TAD DEVO+1 004077 3310 DCA OPOH1+1 /SAVE WD 004100 1364 TAD (ODVHAN 004101 7001 IAC /ALLOW TWO PAGE HANDLERS 004102 3311 DCA OPOH2 004103 4772' JMS USRLOK /GET THE USR 004104 6212 CIF 10 004105 4530 JMS I LUSR 004106 0001 1 /GET THE HANDLER 004107 3030 OPOH1, DEVICE XXXX 004110 3030 004111 0000 OPOH2, 0 /HANDLER ADDRESS 004112 5355 JMP OUTFL 004113 1310 TAD OPOH1+1 /GET DEVICE NUMBER 004114 3073 DCA ODEVNM 004115 1311 TAD OPOH2 004116 3067 DCA OHAN /ST ADR OF HANDLER 004117 1363 TAD (OFILNM 004120 3327 DCA OPOO1 004121 1176 TAD FILSIZ /GET SIZE (0 IF UNDEF) 004122 4526 JMS I LJUST 004123 1073 TAD ODEVNM 004124 6212 CIF 10 004125 4530 JMS I LUSR 004126 0003 3 /OPEN AN OUTPUT FILE 004127 0000 OPOO1, 0 /FILENAME 004130 0000 OPOO2, 0 /AVAILABLE LENGTH 004131 5355 JMP OUTFL
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 27 004132 4770' JMS USRDIS /DISMISS USR 004133 1327 TAD OPOO1 004134 3070 DCA OUTBLK /STARTING BLOCK NUMBER 004135 1330 TAD OPOO2 004136 7450 SNA /ANY AVAIL? 004137 7301 ONE /NO - ASSUME NON-DIR DEVICE 004140 3071 DCA OUTLEN 004141 3072 DCA OUTLN /CNT OF HOW MANY BLKS ARE USED 004142 1131 TAD OUTBUF 004143 3061 DCA OPTR /FOR PTR 004144 7301 ONE 004145 3062 DCA OPTR+1 004146 1065 TAD IOFLG 004147 0120 AND C4000 004150 1105 TAD C1 /OUTPUT FILE FLAG 004151 3065 DCA IOFLG 004152 3177 OUT1, DCA SUCCES /SET SUCCES FLAG 004153 2265 ISZ OPOUT 004154 5665 JMP I OPOUT 004155 4770' OUTFL, JMS USRDIS 004156 7340 NONE /FAIL 004157 5352 JMP OUT1 004163 6462 004164 7200 004165 6423 004166 6422 004167 6461 004170 6322 004171 6456 004172 6315 004173 6600 004174 6421 004175 6420 004176 5617 004177 6455 4200 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 28 / 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. 004200 0000 PUSH, 0 004201 7320 CLA CLL CML /MARK VARIABLE STORE ENTRY 004202 5205 JMP .+3 004203 0000 PUSHJ, 0 004204 7300 CLA CLL 004205 1034 TAD PDL 004206 1377 TAD (-41 004207 7700 SMA CLA /SPACE LEFT? 004210 5776' JMP RTSER0 /NO - OVERFLOW 004211 1134 TAD PDLIST 004212 1034 TAD PDL 004213 3047 DCA TX 004214 2034 ISZ PDL /UPDATE PDP 004215 7430 SZL /PUSH? 004216 5225 JMP PUSH1 /YES 004217 7301 ONE 004220 1203 TAD PUSHJ /GET WHERE TO RETURN TO 004221 3447 DCA I TX /SAVE IN PDLIST 004222 1603 TAD I PUSHJ /GET WHERE WE'RE GOING 004223 3047 DCA TX 004224 5447 JMP I TX /AND GO. 004225 1200 PUSH1, TAD PUSH 004226 4523 JMS I GPTR /GET THE VARIABLE POINTER 004227 3447 DCA I TX /SAVE IT 004230 3450 DCA I TXX /CLEAR THE VARIABLE (GPTR SETS TXX) 004231 2200 ISZ PUSH 004232 5600 JMP I PUSH /DONE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 29 / 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. 004233 0000 POP, 0 004234 7360 CLA CMA CLL CML 004235 5240 JMP .+3 004236 0000 POPJ, 0 004237 7340 CLA CMA CLL 004240 1034 TAD PDL /(LINK NOW COMPLEMENT) 004241 7510 SPA /ANYTHING IN LIST? 004242 5775' JMP RTSER1 /NO 004243 3034 DCA PDL /YES, DECREMENT PDP 004244 1034 TAD PDL 004245 1134 TAD PDLIST 004246 4523 JMS I GPTR /SAVE WHERE TO GO IN TXX 004247 7630 SZL CLA /POP OR POPJ? 004250 5450 JMP I TXX /POPJ - JUMP TO THE ADDRESS 004251 1633 TAD I POP /GET THE VARIABLE 004252 3047 DCA TX 004253 1050 TAD TXX /GET THE POINTER 004254 3447 DCA I TX /PUT IN THE VARIABLE 004255 2233 ISZ POP 004256 5633 JMP I POP /GO BACK
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 30 / 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. 004257 0000 CLOUT, 0 004260 7300 ZERO 004261 1065 TAD IOFLG 004262 7010 RAR 004263 7620 SNL CLA /OUTPUT FILE OPEN? 004264 5323 JMP CLOUTFL /NO - FAIL 004265 1374 TAD (232 /CONTROL Z - END OF FILE 004266 4773' JMS WRITH /WRITE IT 004267 5323 JMP CLOUTFL 004270 1065 TAD IOFLG 004271 0120 AND C4000 /SAVE INPUT FILE FLAG 004272 3065 DCA IOFLG /UPDATE 004273 1061 TAD OPTR 004274 1372 TAD (-OBUF 004275 7650 SNA CLA /ANYTHING IN BUFFER? 004276 5313 JMP CLOUT1 004277 1072 TAD OUTLN 004300 1071 TAD OUTLEN 004301 7650 SNA CLA /ROOM? 004302 5323 JMP CLOUTFL /NO 004303 1070 TAD OUTBLK 004304 3310 DCA CLOUTX 004305 4467 JMS I OHAN /WRITE OUT THE PARTIAL BUFFER 004306 4210 4210 /2 PAGES FROM FIELD 1 004307 0600 OBUF 004310 0000 CLOUTX, 0 004311 5323 JMP CLOUTFL /FAIL 004312 2072 ISZ OUTLN 004313 1072 CLOUT1, TAD OUTLN /GET LENGTH 004314 3322 DCA CLOC1 004315 1073 TAD ODEVNM /GET DEV NUMBER FOR CLOSE 004316 6212 CIF 10 004317 4540 JMS I USR 004320 0004 4 /CLOSE OUTPUT FILE 004321 6462 OFILNM 004322 0000 CLOC1, 0 /LENGTH 004323 7340 CLOUTFL, NONE /ERROR RETURN 004324 3177 DCA SUCCES 004325 5657 JMP I CLOUT /AND BACK 4326 XL2=. /PAGE ADDRESS LINK FOR FNDSP 004372 7200 004373 4712 004374 0232 004375 6335 004376 6336 004377 7737 4400 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 31 / ROUTINE TO CLOSE INPUT FILE. THIS CONSISTS ONLY / OF CLEARING THE FLAG FOR THE AVAILABILITY OF THE / INPUT FILE. 004400 0000 CLIN, 0 004401 7300 ZERO 004402 1065 TAD IOFLG 004403 0105 AND C1 /CLOSE IT 004404 3065 DCA IOFLG /UPDATE 004405 3177 DCA SUCCES /SUCCESS 004406 5600 JMP I CLIN
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 32 /THIS ROUTINE ACCEPTS A LINE FROM THE TELETYPE AND SETS THE VALUE OF /THE FUNCTION IDENTIFIER 'INPUT' TO ITS VALUE. 004407 0000 ACCEPT, 0 004410 7305 TWO 004411 1152 TAD TOP 004412 3055 DCA XPTR 004413 7301 ONE 004414 3056 DCA XPTR+1 004415 1146 TAD PUTLST 004416 3016 DCA INDEX6 004417 1055 TAD XPTR 004420 3546 DCA I PUTLST /FOR PUTVAR 004421 7301 ONE 004422 3416 DCA I INDEX6 /ANY LENGTH - CHAR 1. 004423 7340 NONE 004424 3416 DCA I INDEX6 /ONLY ARG 004425 6031 ACC0, KSF /GET CHAR FROM TELETYPE 004426 5225 JMP .-1 004427 6036 KRB 004430 3042 DCA T2 004431 1042 TAD T2 004432 1377 TAD (-203 /CODE FOR ^C 004433 7450 SNA 004434 5335 JMP ACC8 /TYPE ^C AND GO TO MONITOR 004435 1101 TAD NC7 /(-212) 004436 7510 SPA /AT OR ABOVE LINEFEED? 004437 5253 JMP ACC1 /NO 004440 1076 TAD NC3 /(-215) 004441 7510 SPA /LINE MOVEMENT CHARACTER? 004442 5355 JMP ACC11 004443 7450 SNA /NO - RETURN? 004444 5263 JMP ACC3 /YES 004445 1102 TAD NC10 004446 7450 SNA /^U (225) ? 004447 5342 JMP ACC9 004450 1376 TAD (-152 004451 7650 SNA CLA /RUBOUT (377) ? 004452 5277 JMP ACC6 004453 7300 ACC1, ZERO 004454 1042 TAD T2 /GET BACK THE CHARACTER 004455 4775' JMS CLPRN /TYPE IT 004456 5257 JMP ACC5 /
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 33 004457 1042 ACC5, TAD T2 /GET BACK CHAR 004460 4553 JMS I WRCHAR 004461 0055 XPTR 004462 5225 JMP ACC0 /Go AGAIN 004463 1114 ACC3, TAD C215 004464 4775' JMS CLPRN / 004465 1113 TAD C212 004466 4775' JMS CLPRN /PRINT LINEFEED FOR RETURN 004467 4543 JMS I CLVAR /HERE TO FINISH VARIABLE STORAGE 004470 0055 XPTR 004471 1374 TAD (INPUT /GET INPUT VARIABLE HEADER 004472 3150 DCA T1 004473 4547 JMS I PUTVAR /DO IT 004474 7402 HLT /NO FAIL 004475 2207 ISZ ACCEPT 004476 5607 JMP I ACCEPT /AND BACK 004477 1055 ACC6, TAD XPTR /HERE FOR RUBOUT 004500 7041 CMA IAC 004501 1546 TAD I PUTLST 004502 7640 SZA CLA /CHARS IN? 004503 5312 JMP ACC7 /YES 004504 7340 NONE 004505 1056 TAD XPTR+1 004506 7640 SZA CLA 004507 5312 JMP ACC7 004510 4535 JMS I RETLF /NO - MUST TYPE RET-LF 004511 5225 JMP ACC0 /AND BACK 004512 1373 ACC7, TAD (334 /TYPE BACKSLASH 004513 4775' JMS CLPRN 004514 7340 NONE 004515 1056 TAD XPTR+1 /DEC CHAR CNT 004516 3056 DCA XPTR+1 004517 1056 TAD XPTR+1 004520 7440 SZA /PAST ONE? 004521 1372 TAD (-2 004522 7640 SZA CLA /OR 3? 004523 5225 JMP ACC0 /NO - OK 004524 7340 NONE 004525 1055 TAD XPTR 004526 3055 DCA XPTR /YES - DEC WD PTR 004527 1056 TAD XPTR+1 004530 7640 SZA CLA 004531 5225 JMP ACC0 004532 7325 THREE 004533 3056 DCA XPTR+1 004534 5225 JMP ACC0
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 34 004535 1371 ACC8, TAD (303 /"C" 004536 4345 JMS ACC10 004537 1370 TAD (ACC0 004540 3524 DCA I INTST /SAVE THE CONTINUATION ADDRESS 004541 5767 JMP I (7600 /GO TO OS/8 004542 1366 ACC9, TAD (325 /"U" 004543 4345 JMS ACC10 004544 5210 JMP ACCEPT+1 004545 0000 ACC10, 0 004546 3044 DCA T3 004547 1365 TAD (336 004550 4775' JMS CLPRN 004551 1044 TAD T3 004552 4775' JMS CLPRN 004553 4535 JMS I RETLF 004554 5745 JMP I ACC10 004555 7300 ACC11, ZERO 004556 1151 TAD SVSPCH 004557 7650 SNA CLA /SAVE SPECIAL CHARACTERS? 004560 5225 JMP ACC0 /NO - IGNORE 004561 5257 JMP ACC5 /YES - USE IT 004565 0336 004566 0325 004567 7600 004570 4425 004571 0303 004572 7776 004573 0334 004574 0020 004575 6277 004576 7626 004577 7575 4600 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 35 / ROUTINE TO READ A LINE FROM THE INPUT FILE. 004600 0000 READH, 0 004601 1065 TAD IOFLG 004602 7004 RAL 004603 7620 SNL CLA /INPUT FILE AVAILABLE? 004604 5600 JMP I READH /NO 004605 7305 TWO 004606 1152 TAD TOP 004607 3055 DCA XPTR 004610 1055 TAD XPTR 004611 3546 DCA I PUTLST /FOR PUTVAR 004612 7301 ONE 004613 3056 DCA XPTR+1 004614 1057 READ1, TAD IPTR /GET PTR WD 004615 1377 TAD (-IBUF-BUFLEN 004616 7710 SPA CLA /OVER TOP? 004617 5241 JMP READ2 /NO 004620 2064 ISZ INLEN /ANY MORE IN FILE? 004621 7410 SKP 004622 5600 JMP I READH /NO - FAIL 004623 1063 TAD INBLK /WHICH BLK TO READ 004624 3230 DCA STBLK 004625 4466 JMS I IHAN /CALL THE HANDLER 004626 0210 0210 /READ 2 PAGES TO FIELD 1 004627 0200 IBUF 004630 0000 STBLK, 0 /BLOCK TO READ 004631 7700 SMA CLA /ERROR RETURN - HARD OR SOFT? 004632 7410 SKP 004633 5600 JMP I READH /HARd ERROR - FAIL 004634 2063 ISZ INBLK /GET NEXT ONE NEXT TIME 004635 1376 TAD (IBUF 004636 3057 DCA IPTR 004637 7301 ONE 004640 3060 DCA IPTR+1 004641 2074 READ2, ISZ RDFLG /SET READ FLAG 004642 4545 JMS I GETCHR 004643 0057 IPTR /GET NEXT CHAR 004644 5214 JMP READ1 /NULL - TRY AGAIN 004645 1104 TAD NC215 /RETURN? 004646 7450 SNA 004647 5274 JMP READ6 004650 7500 SMA /BELOW RETURN? 004651 5256 JMP READ3 /NO - USE THE CHARACTER 004652 1106 TAD C3 /YES - RESTORE IT
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 36 004653 7500 SMA /LINE MOVEMENT CHARACTER? 004654 5262 JMP READ8 /YES 004655 1076 TAD NC3 /NO - USE IT 004656 1114 READ3, TAD C215 /RESTORE CHARACTER 004657 4553 JMS I WRCHAR /AND WRITE IT 004660 0055 XPTR 004661 5214 JMP READ1 004662 2151 READ8, ISZ SVSPCH /SAVE THIS CHARACTER? 004663 5271 JMP READ4 /NO 004664 1113 TAD C212 /YES - RESTORE 004665 4553 JMS I WRCHAR /WRITE IT 004666 0055 XPTR 004667 7340 NONE 004670 5272 JMP .+2 004671 7300 READ4, ZERO 004672 3151 DCA SVSPCH /FIX FLAG 004673 5214 JMP READ1 /AND GO AGAIN 004674 4543 READ6, JMS I CLVAR /RETURN - CLOSE VARIABLE 004675 0055 XPTR 004676 1146 TAD PUTLST 004677 3011 DCA INDEX1 004700 7301 ONE 004701 3411 DCA I INDEX1 /ALL 004702 7340 NONE 004703 3411 DCA I INDEX1 /AND THAT'S ALL 004704 1375 TAD (READ 004705 3150 DCA T1 004706 4547 JMS I PUTVAR 004707 7402 HLT /NO FAIL 004710 2200 ISZ READH 004711 5600 JMP I READH
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 37 /THIS ROUTINE WRITES A SINGLE CHARACTER TO THE OUTPUT FILE. IT IS CALLED /(VIA FUNCTIONS 'WRITE' OR 'WRITEH') BY PUTVAR. 004712 0000 WRITH, 0 004713 3045 DCA T4 /SAVE THE CHARACTER 004714 1065 TAD IOFLG 004715 7010 RAR 004716 7620 SNL CLA /IS THE OUTPUT FILE AVAILABLE? 004717 5712 JMP I WRITH /NO - FAIL 004720 1061 TAD OPTR /GET THE OUTPUT POINTER 004721 1374 TAD (-OBUF-BUFLEN 004722 7640 SZA CLA /OVER THE TOP? 004723 5357 JMP WR1 /NO 004724 1072 TAD OUTLN 004725 1071 TAD OUTLEN 004726 7650 SNA CLA /ROOM LEFT IN THE FILE? 004727 5364 JMP WRFL /NO - FAIL 004730 1070 TAD OUTBLK /WHERE THE FULL BLOCK GOES 004731 3335 DCA WRXX1
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 38 004732 4467 JMS I OHAN 004733 4210 4210 /WRITE TWO PAGES FROM FIELD 1 004734 0600 OBUF 004735 0000 WRXX1, 0 004736 5364 JMP WRFL /OUTPUT ERROR 004737 2070 ISZ OUTBLK 004740 2072 ISZ OUTLN /UPDATE 004741 1131 TAD OUTBUF 004742 3061 DCA OPTR /NEW POINTER VALUE 004743 7301 ONE 004744 3062 DCA OPTR+1 004745 7340 NONE 004746 1131 TAD OUTBUF 004747 3015 DCA INDEX5 004750 1122 TAD C7400 /(-BUFLEN) 004751 3047 DCA TX 004752 6211 CDF 10 004753 3415 DCA I INDEX5 /CLEAR THE OUTPUT BUFFER 004754 2047 ISZ TX 004755 5353 JMP .-2 004756 6201 CDF 0 004757 1045 WR1, TAD T4 /GET THE CHARACTER 004760 4553 JMS I WRCHAR /WRITE IT 004761 0061 OPTR 004762 2312 ISZ WRITH /SKIP ON SUCCESS 004763 5370 JMP WR2 004764 1065 WRFL, TAD IOFLG /HERE ON FILE ERROR 004765 0120 AND C4000 004766 3065 DCA IOFLG /CLEAR OUTPUT FILE BIT 004767 7340 NONE 004770 3177 WR2, DCA SUCCES 004771 5712 JMP I WRITH /AND DONE 004774 6600 004775 0021 004776 0200 004777 7200 5000 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 39 / GET (OR WRITE) CHARACTER ACCORDING TO THE PTR IN (CALL+1). 005000 0000 WRCHR, 0 005001 3371 DCA WRCX /SAVE CHAR 005002 3367 DCA GWFLG /FLAG WRCHR 005003 1600 TAD I WRCHR /GET POINTER 005004 5211 JMP GET0 005005 0000 GETCH, 0 005006 7340 NONE 005007 3367 DCA GWFLG 005010 1605 TAD I GETCH /GET POINTER 005011 3370 GET0, DCA GWPTR 005012 3372 DCA GETX /BECAUSE GETCH MIGHT FAIL 005013 1770 TAD I GWPTR /GET PTR 005014 7650 SNA CLA /NULL? 005015 5271 JMP GETRET /YES - RETURN 005016 1370 TAD GWPTR 005017 3012 DCA INDEX2 /TO CHAR # 005020 7340 NONE 005021 1412 TAD I INDEX2 005022 7450 SNA /1ST? 005023 5230 JMP GET1 /YES 005024 1075 TAD NC1 /NO, 2ND? 005025 7640 SZA CLA 005026 5240 JMP GET2 /NO - 3RD 005027 7301 ONE /YES - 2ND 005030 1770 GET1, TAD I GWPTR /GET PTR 005031 3047 DCA TX 005032 6211 CDF 10 005033 2367 ISZ GWFLG 005034 5341 JMP WRC1 005035 1447 TAD I TX /GET CHAR 005036 0116 AND C377 005037 5262 JMP GET3 005040 7340 GET2, NONE 005041 1770 TAD I GWPTR 005042 3047 DCA TX 005043 6211 CDF 10 005044 2367 ISZ GWFLG 005045 5344 JMP WRC2 005046 1447 TAD I TX 005047 0122 AND C7400 /SAVE TOP BITS 005050 7112 CLL RTR 005051 7012 RTR 005052 3050 DCA TXX 005053 2047 ISZ TX 005054 1447 TAD I TX 005055 0122 AND C7400 005056 7106 CLL RTL 005057 7006 RTL 005060 7004 RAL 005061 1050 TAD TXX
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 40 005062 6201 GET3, CDF 0 005063 7450 SNA /NULL CHAR? 005064 5301 JMP GET4 /YES 005065 3372 DCA GETX 005066 1370 TAD GWPTR 005067 4777' JMS UPDPTR /UPDATE PTR 005070 2205 ISZ GETCH /SKIP FOR GETCH (SUCCESS) 005071 6201 GETRET, CDF 0 005072 2205 ISZ GETCH 005073 2200 ISZ WRCHR 005074 1367 TAD GWFLG 005075 7740 SMA SZA CLA /WRITE OR GET? 005076 5600 JMP I WRCHR 005077 1372 TAD GETX /CHAR 005100 5605 JMP I GETCH /AND GO 005101 1074 GET4, TAD RDFLG 005102 7640 SZA CLA /READING FROM A FILE? 005103 5336 JMP GET5 005104 1367 TAD GWFLG 005105 7640 SZA CLA /GET OR WRITE? 005106 5266 JMP GET3+4 /WRITE 005107 7301 ONE 005110 1370 TAD GWPTR 005111 3047 DCA TX 005112 7346 NTHREE 005113 1447 TAD I TX 005114 7640 SZA CLA /3RD? 005115 7301 ONE /NO 005116 1770 TAD I GWPTR /GET ADR OF SPECIAL CODE 005117 3012 DCA INDEX2 005120 6211 CDF 10 005121 1412 TAD I INDEX2 /GET IT 005122 7450 SNA /ZERO? 005123 5271 JMP GETRET /YES - END OF STR (READ) 005124 7001 IAC 005125 7650 SNA CLA /END CODE? 005126 5271 JMP GETRET 005127 1412 TAD I INDEX2 /NO (ASSUME LINK) - GET CONT ADR 005130 6201 CDF 0 005131 3770 DCA I GWPTR /UPD PTR 005132 2370 ISZ GWPTR 005133 7301 ONE 005134 3770 DCA I GWPTR /CHAR 1 005135 5206 JMP GETCH+1 /GO AGAIN 005136 1370 GET5, TAD GWPTR /NULL ON FILE READ 005137 4777' JMS UPDPTR /UPDATE INPUT POINTER 005140 5271 JMP GETRET /FAIL AND LET READH TRY AGAIN
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 41 005141 1371 WRC1, TAD WRCX /GET CHAR 005142 3447 DCA I TX /SAVE 005143 5262 JMP GET3 /FINISH 005144 1371 WRC2, TAD WRCX /GET CHAR 005145 7006 RTL 005146 7006 RTL 005147 4357 JMS WRC3 005150 1371 TAD WRCX 005151 7012 RTR 005152 7012 RTR 005153 7010 RAR 005154 2047 ISZ TX 005155 4357 JMS WRC3 005156 5262 JMP GET3 /DONE 005157 0000 WRC3, 0 005160 0122 AND C7400 /SAVE TOP 005161 3050 DCA TXX 005162 1447 TAD I TX /GET PRESENT WD 005163 0116 AND C377 /SAVE THE LOW ORDER CHAR 005164 1050 TAD TXX /ADD IN THE TOP ORDER 3RD CHAR 005165 3447 DCA I TX /SAVE WHOLE WD 005166 5757 JMP I WRC3 / 005167 0000 GWFLG, 0 005170 0000 GWPTR, 0 005171 0000 WRCX, 0 005172 0000 GETX, 0 005177 5600 5200 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 42 / 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. 005200 0000 PUTVR, 0 005201 1150 TAD T1 /GET VARPTR 005202 1103 TAD NC20 005203 7510 SPA /IS IT A SPECIAL FUNCTION? 005204 5217 JMP PUT0 005205 1102 TAD NC10 005206 7500 SMA 005207 5217 JMP PUT0 /NO 005210 1377 TAD (PUTSPF+10 005211 3047 DCA TX 005212 1447 TAD I TX /GET THE HANDLING ROUTINE 005213 7450 SNA /OUTPUT FUNCTION? 005214 5217 JMP PUT0 /NO - IT'S A VARIABLE 005215 3373 DCA PXT6 /SET THE FUNCTION FLAG 005216 5227 JMP PUT1 005217 7300 PUT0, ZERO 005220 3373 DCA PXT6 /CLEAR SPECIAL FUNCTION FLAG 005221 4544 JMS I FNDSPC /GET SPACE FOR NON-VAR 005222 3053 DCA PXT1 /AND PUT THERE 005223 1053 TAD PXT1 005224 3776' DCA PXT2 005225 7301 ONE 005226 3775' DCA PXT2+1 005227 3017 PUT1, DCA INDEX7 /CHAR CNT 005230 7340 NONE 005231 1146 TAD PUTLST 005232 3011 DCA INDEX1
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 43 005233 7301 PUT2, ONE 005234 1411 TAD I INDEX1 /GET NEXT VARPTR 005235 7450 SNA 005236 5330 JMP PUT7 /DONE 005237 1075 TAD NC1 005240 3371 DCA PXT5 005241 1411 TAD I INDEX1 005242 3047 DCA TX 005243 1047 TAD TX 005244 0106 AND C3 005245 3372 DCA PXT5+1 005246 1047 TAD TX 005247 7110 CLL RAR 005250 7110 CLL RAR /V41 SZA /IF ZERO - LEAVE AS IS 005251 1121 TAD C5777 /TO GIVE -LEN - 1 005252 3054 DCA PXT4 005253 1373 PUT3, TAD PXT6 005254 7640 SZA CLA /SPECIAL FUNCTION? 005255 5273 JMP PUT4 /YES - DON'T WRITE INTO MEMORY 005256 7325 THREE 005257 4774' JMS PUT10 /<AT OR ABOVE> THE TOP 005260 7410 SKP /NO 005261 5273 JMP PUT4 /YES 005262 7325 THREE /NO 005263 1776' TAD PXT2 005264 3047 DCA TX 005265 6211 CDF 10 005266 1447 TAD I TX 005267 6201 CDF 0 005270 1111 TAD C7 005271 7640 SZA CLA /ROOM LEFT? 005272 5322 JMP PUT6 /NO - LINK 005273 2054 PUT4, ISZ PXT4 /GET NEXT CHAR - STR DONE? 005274 7410 SKP 005275 5233 JMP PUT2 /YES - TRY NEXT STR 005276 4545 JMS I GETCHR /NO - GET CHAR 005277 5371 PXT5 005300 5233 JMP PUT2 /GUESS IT'S DONE 005301 3047 DCA TX 005302 1373 TAD PXT6 005303 7650 SNA CLA /SPECIAL FUNCTION? 005304 5311 JMP PUT5 005305 1047 TAD TX /YES - GET THE CHARACTER 005306 4773 JMS I PXT6 /HANDLE IT 005307 5600 JMP I PUTVR /fAIL 005310 5273 JMP PUT4
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 44 005311 1047 PUT5, TAD TX 005312 4553 JMS I WRCHAR 005313 5416 PXT2 005314 2017 ISZ INDEX7 /INC CHAR CNT 005315 7346 NTHREE 005316 1775' TAD PXT2+1 005317 7640 SZA CLA /3RD? 005320 5273 JMP PUT4 /NO - DON'T CHECK SIZE 005321 5253 JMP PUT3 005322 4527 PUT6, JMS I LNKVAR 005323 5416 PXT2 005324 3776' DCA PXT2 005325 7301 ONE 005326 3775' DCA PXT2+1 005327 5253 JMP PUT3 005330 1373 PUT7, TAD PXT6 /GET THE SPECIAL FUNCTION CODE 005331 7640 SZA CLA 005332 5355 JMP PUT12 /IF SET - FINISH FUNCTION 005333 1017 TAD INDEX7 005334 7650 SNA CLA /ANYTHING? 005335 5353 JMP PUT9 /NO 005336 4543 JMS I CLVAR 005337 5416 PXT2 005340 4774' JMS PUT10 /OVER THE TOP? 005341 5345 JMP PUT8 /NO 005342 7305 TWO 005343 1776' TAD PXT2 005344 3152 DCA TOP /YES - UPDATE TOP 005345 1550 PUT8, TAD I T1 /GET VARPTR 005346 7440 SZA / 005347 4542 JMS I CLRVAR /CLEAR WHAT IT WAS 005350 1053 TAD PXT1 005351 3550 DCA I T1 /UPD VARPTR 005352 5367 JMP PUTS /AND DONE 005353 3053 PUT9, DCA PXT1 /HERE ON NOTHING 005354 5345 JMP PUT8 /JUST NO NEW PTR
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 45 005355 1150 PUT12, TAD T1 /GET THE SPECIAL FUNCTION CODE 005356 7010 RAR 005357 7630 SZL CLA /LOW ORDER BIT SET? 005360 5367 JMP PUTS 005361 1114 TAD C215 005362 4773 JMS I PXT6 /NO - PUT A RETURN OUT 005363 5600 JMP I PUTVR /FAIL RETURN 005364 1113 TAD C212 005365 4773 JMS I PXT6 005366 5600 JMP I PUTVR 005367 2200 PUTS, ISZ PUTVR 005370 5600 JMP I PUTVR /AND DONE 005371 0000 PXT5, 0; 1 005372 0001 005373 0000 PXT6, 0 /SPECIAL FUNCTION FLAG AND POINTER 005374 5400 005375 5417 005376 5416 005377 6410 5400 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 46 005400 0000 PUT10, 0 005401 1216 TAD PXT2 005402 7041 CMA IAC 005403 1152 TAD TOP 005404 7740 SMA SZA CLA /OVER THE TOP? 005405 5600 JMP I PUT10 /NO 005406 1152 TAD TOP /NO - POSSIBLE WRAPAROUND? 005407 7700 SMA CLA 005410 5214 JMP PUT11 /NO 005411 7325 THREE /IN CASE WE'RE AT THE TOP 005412 1216 TAD PXT2 005413 7710 SPA CLA /YES - IF POS. 005414 2200 PUT11, ISZ PUT10 005415 5600 JMP I PUT10 005416 0000 PXT2, 0;1 005417 0001
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 47 / 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. 005420 0000 LNKVR, 0 005421 7340 NONE 005422 5225 JMP .+3 005423 0000 CLVR, 0 005424 7300 ZERO 005425 3302 DCA CLX1 005426 1302 TAD CLX1 005427 7650 SNA CLA /HOW CALLED? 005430 5233 JMP .+3 005431 1620 TAD I LNKVR /LINK - GET ARG 005432 7410 SKP 005433 1623 TAD I CLVR /CLOSE - GET THAT ONE 005434 3303 DCA CLX2 005435 1303 TAD CLX2 005436 3240 DCA CL1+1
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 48 005437 4553 CL1, JMS I WRCHAR /WRITE A ZERO 005440 0000 0 005441 1240 TAD .-1 /GET LOC OF PTR 005442 3012 DCA INDEX2 005443 1412 TAD I INDEX2 005444 1075 TAD NC1 005445 7640 SZA CLA /BACK TO CHAR 1? 005446 5237 JMP CL1 /NO - GO AGAIN 005447 7340 NONE 005450 1703 TAD I CLX2 005451 3012 DCA INDEX2 005452 6211 CDF 10 005453 2302 ISZ CLX1 /LINK OR CL? 005454 5275 JMP CL2 /CLOSE - GO 005455 1102 TAD NC10 /LINK - PUT -10 005456 3412 DCA I INDEX2 005457 6201 CDF 0 005460 4544 JMS I FNDSPC /FIND SPACE FOR CONT 005461 3303 DCA CLX2 005462 1303 TAD CLX2 005463 6211 CDF 10 005464 3412 DCA I INDEX2 /SAVE LINK ADR 005465 6201 CLRET, CDF 0 005466 1302 TAD CLX1 005467 2223 ISZ CLVR 005470 7640 SZA CLA /CL OR LNK? 005471 5623 JMP I CLVR /CLOSE - DONE 005472 2220 ISZ LNKVR /SKIP OVER ARG 005473 1303 TAD CLX2 /GET CONT 005474 5620 JMP I LNKVR /DONE 005475 7340 CL2, NONE 005476 3412 DCA I INDEX2 005477 7340 NONE /2 END CODES 005500 3412 DCA I INDEX2 005501 5265 JMP CLRET /AND DONE 005502 0000 CLX1, 0 005503 0000 CLX2, 0
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 49 / THIS ROUTINE LOADS -7'S OVER ALL THE SPACE USED BY / THE VARIABLE POINTED TO BY THE AC. 005504 0000 CLRVR, 0 005505 3050 DCA TXX 005506 6211 CDF 10 005507 1050 CLR0, TAD TXX 005510 3047 DCA TX 005511 1447 TAD I TX /GET TOP 4 BITS 005512 0122 AND C7400 005513 7640 SZA CLA /ZERO THERE? 005514 5347 JMP CLR2 005515 2047 ISZ TX 005516 1447 TAD I TX /GET BOTTOM 005517 0122 AND C7400 005520 7640 SZA CLA /TOTAL ZERO? 005521 5347 JMP CLR2 /NO 005522 4351 JMS CLRZ /YES - ZERO 1ST AND 2ND WD 005523 7301 ONE 005524 1450 TAD I TXX /GET SPECIAL CODE 005525 7440 SZA /END? 005526 5332 JMP CLR1 /NO 005527 4351 JMS CLRZ 005530 6201 CDF 0 005531 5704 JMP I CLRVR /DONE 005532 1111 CLR1, TAD C7 005533 7440 SZA /LINK? 005534 5777' JMP RTSER7 /NO - FATAL 005535 1101 TAD NC7 /UNUSED 005536 3450 DCA I TXX 005537 2050 ISZ TXX 005540 1050 TAD TXX 005541 3047 DCA TX 005542 1450 TAD I TXX /YES - GET CONT LOC 005543 3050 DCA TXX 005544 1101 TAD NC7 005545 3447 DCA I TX /ZERO LAST OF BLOCK 005546 5307 JMP CLR0 /AND GO AGAIN 005547 4351 CLR2, JMS CLRZ /HERE ON THIRD AND NOT ZERO 005550 5307 JMP CLR0 005551 0000 CLRZ, 0 005552 1101 TAD NC7 005553 3450 DCA I TXX 005554 2050 ISZ TXX 005555 1101 TAD NC7 005556 3450 DCA I TXX 005557 2050 ISZ TXX 005560 5751 JMP I CLRZ /DONE 5600 XT2=.&7600+200 005577 6327 4326 *XL2 /PAGE ADDRESS LINK FROM POPJ
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 50 / ROUTINE TO FIND SPACE IN VAR STORAGE AREA 004326 0000 FNDSP, 0 004327 7300 ZERO 004330 1035 TAD TOPP 004331 3047 DCA TX /TX IS WHERE WE LOOK 004332 1370 FND0, TAD FNDSPS /# OF LOCS NEEDED 004333 7041 CMA IAC /-# 004334 3050 DCA TXX /TXX IS THE FREE LOC CNT 004335 6211 CDF 10 004336 7410 SKP /DON'T INC LOC THE FIRST TIME /LOOP TO FIND (FNDSPS) FREE LOCS IN A ROW. 004337 2047 FND1, ISZ TX 004340 1047 TAD TX 004341 7041 CMA IAC 004342 1152 TAD TOP 004343 7650 SNA CLA /ARE WE UP TO THE TOP? 004344 5361 JMP FND4 /YES 004345 1447 TAD I TX /NO - GET THE NEXT LOC 004346 1111 TAD C7 004347 7640 SZA CLA /LOCATION USED? 004350 5366 JMP FND5 /YES 004351 2050 ISZ TXX /NO, INC CNT - DONE? 004352 5337 JMP FND1 /NO 004353 1370 TAD FNDSPS 004354 7041 CMA IAC 004355 7001 IAC /-# + 1 004356 1047 TAD TX /YES, GET PTR TO FREE SPACE 004357 6201 FND2, CDF 0 004360 5726 JMP I FNDSP /DONE 004361 1370 FND4, TAD FNDSPS /# NEEDED 004362 1050 TAD TXX /AT THE TOP 004363 7041 CMA IAC /TWO'S COMPLEMENT 004364 1152 TAD TOP /CALCULATE FIRST FREE LOC 004365 5357 JMP FND2 /AND DONE 004366 2047 FND5, ISZ TX /LOCATION USED - CHECK NEXT 004367 5332 JMP FND0 /TRY AGAIN 004370 0016 FNDSPS, 16 /THIS VALUE IS ADJUSTABLE. 5600 *XT2
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 51 / THE AC CONTAINS THE LOCATION OF THE PTR. 005600 0000 UPDPTR, 0 005601 3047 DCA TX 005602 7301 ONE 005603 1047 TAD TX 005604 3050 DCA TXX 005605 2450 ISZ I TXX /ISZ CHAR NUM 005606 7346 NTHREE 005607 1450 TAD I TXX 005610 7510 SPA /3RD OR 4TH? 005611 5215 JMP UPD1 /NO - DONE 005612 2447 ISZ I TX /YES - UPD WD PTR 005613 7440 SZA /4TH? 005614 3450 DCA I TXX /YES - ACTUALLY 1ST 005615 7300 UPD1, ZERO 005616 5600 JMP I UPDPTR /DONE.
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 52 / THIS ROUTINE DECODES THE FILENAME POINTED TO (TO SOME /EXTENT) BY THE AC. INDEX0 SHOULD BE POINTING TO THE /FILENAME BLOCK. 005617 0000 FILEDC, 0 005620 3041 DCA H1 005621 1041 TAD H1 /GET THE VARPTR 005622 4537 JMS I UPDSPF /UPDATE IF SPECIAL FUNCTION 005623 5617 JMP I FILEDC /FAIL 005624 1441 TAD I H1 005625 3055 DCA XPTR 005626 7301 ONE 005627 3056 DCA XPTR+1 005630 7346 NTHREE /# OF WDS FOR NAME 005631 3044 DCA T3 005632 4317 FILL1, JMS FILCH /GET AND FIX CHAR 005633 5265 JMP FIL3 /PERIOD OR NOT THERE 005634 4526 JMS I LJUST 005635 4526 JMS I LJUST /LEFT JUSTIFY 005636 3042 DCA T2 005637 4317 JMS FILCH /NEXT 005640 5273 JMP FIL5 005641 1042 TAD T2 /GET REST OF WD 005642 3410 DCA I INDEX0 /SAVE 005643 2044 ISZ T3 /DONE WITH NAME? 005644 5232 JMP FILL1 /NO - CONTINUE 005645 4317 FILL2, JMS FILCH /YES - LOOK FOR END OR PERIOD 005646 7410 SKP 005647 5245 JMP FILL2 /GOT CHAR - TRY NEXT 005650 7450 SNA /PERIOD? 005651 5262 JMP FIL2-1 /NO - DONE 005652 4317 FIL1, JMS FILCH /GET 1ST CHAR OF EXT 005653 5305 JMP FIL6 /HERE ON DOT OR END 005654 4526 JMS I LJUST 005655 4526 JMS I LJUST 005656 3042 DCA T2 005657 4317 JMS FILCH /GET 2ND CHAR 005660 5310 JMP FIL7 005661 1042 FIL1A, TAD T2 /GET FULL EXT 005662 3410 DCA I INDEX0 /SAVE 005663 2217 FIL2, ISZ FILEDC /SKIP RETURN 005664 5617 JMP I FILEDC /AND DONE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 53 005665 7640 FIL3, SZA CLA /ODD CHAR DOT OR END? 005666 5313 JMP FIL8 /DOT 005667 3410 DCA I INDEX0 /ZERO REST OF BLK 005670 2044 FIL4, ISZ T3 005671 5267 JMP .-2 005672 5262 JMP FIL2-1 /AND DONE 005673 3047 FIL5, DCA TX /SAVE FLG 005674 1042 TAD T2 /GET ODD CHAR 005675 3410 DCA I INDEX0 005676 2047 ISZ TX /DOT OR END? 005677 5270 JMP FIL4 /END 005700 7410 SKP /DOT 005701 3410 DCA I INDEX0 /ZER REST OF FILENAME BLK 005702 2044 ISZ T3 /DONE? 005703 5301 JMP .-2 /NO 005704 5252 JMP FIL1 /AND DO NEXT 005705 7440 FIL6, SZA /DOT OR END? 005706 5617 JMP I FILEDC /DOT - ERROR 005707 5262 JMP FIL2-1 /END - ZERO LAST AND DONE 005710 7440 FIL7, SZA /DOT OR END? 005711 5617 JMP I FILEDC /DOT - ERROR 005712 5261 JMP FIL1A /END - SAVE ODD CHAR AND DONE 005713 3410 FIL8, DCA I INDEX0 /HERE ON (1ST CHAR) DOT 005714 2044 ISZ T3 /DONE? 005715 5313 JMP .-2 /NO 005716 5252 JMP FIL1 /YES
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 54 / ROUTINE TO GET, CHECK AND CLEAN CHARACTER. 005717 0000 FILCH, 0 005720 4545 JMS I GETCHR /GET CHARACTER 005721 0055 XPTR 005722 5717 JMP I FILCH /FAIL - CAN'T GET IT 005723 3047 DCA TX 005724 1047 TAD TX 005725 1377 TAD (-256 005726 7440 SZA /TEST PERIOD 005727 5332 JMP FILC1 /NO 005730 7340 NONE /YES - AC TO -1 005731 5717 JMP I FILCH /AND DONE 005732 1376 FILC1, TAD (-54 /ADD -Z 005733 7540 SMA SZA /MUST BE <=0 005734 5617 JMP I FILEDC /IT ISN'T - FAIL COMPLETELY 005735 1375 TAD (32 005736 7550 SPA SNA /NOW MUST BE >0 005737 5342 JMP FILC2 /NO - TEST NUMBER 005740 2317 FILCOK, ISZ FILCH /YES - SKIP 005741 5717 JMP I FILCH /AND DONE 005742 1111 FILC2, TAD C7 005743 7540 SMA SZA /MUST BE <=0 005744 5617 JMP I FILEDC /NO - FAIL 005745 1374 TAD (11 005746 7510 SPA /NOW MUST BE >=0 005747 5617 JMP I FILEDC /FAIL 005750 1373 TAD (60 005751 5340 JMP FILCOK 5752 XL3=. /PAGE LINK ADDRESS FOR RETLFX, GPTRX 005773 0060 005774 0011 005775 0032 005776 7724 005777 7522 6000 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 55 / 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. 006000 0000 ASC, 0 006001 7300 ZERO /STRING TO NUMBER 006002 1600 TAD I ASC 006003 3041 DCA H1 006004 1041 TAD H1 006005 4537 JMS I UPDSPF /UPDATE IF FUNCTION 006006 5257 JMP ASCFL 006007 1441 TAD I H1 /GET VARPTR 006010 3042 DCA T2 /SAVE IT 006011 7301 ONE 006012 3043 DCA T2+1 006013 3044 DCA T3 /TOTALS 006014 7340 NONE 006015 3045 DCA T4 /SIGN FLAG 006016 4545 ASC1, JMS I GETCHR /GET THE NEXT CHAR 006017 0042 T2 006020 5252 JMP ASC4 /ERROR RETURN -- DONE 006021 3047 DCA TX /SAVE IT 006022 1172 TAD BASE 006023 7041 CMA IAC /-BASE 006024 1377 TAD (-260 /-260 006025 1047 TAD TX /+NUM (260 AND UP) 006026 7500 SMA /ONLY NEG HERE LEGAL 006027 5257 JMP ASCFL 006030 1172 TAD BASE /NOW POS WILL BE LEGAL NUM 006031 7500 SMA /IS IT POS OR ZERO? 006032 5240 JMP ASC2 /YES 006033 1106 TAD C3 006034 7440 SZA /TEST MINUS SIGN 006035 5257 JMP ASCFL /NO 006036 3045 DCA T4 006037 5216 JMP ASC1 006040 3047 ASC2, DCA TX /SAVE DIGIT 006041 1172 TAD BASE 006042 7041 CMA IAC 006043 3050 DCA TXX
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 56 006044 1044 ASC3, TAD T3 /MULT (BASE) * (TOTAL) 006045 2050 ISZ TXX 006046 5244 JMP ASC3 006047 1047 TAD TX /ADD NET DIGIT 006050 3044 DCA T3 /SAVE NEW TOTAL 006051 5216 JMP ASC1 /GO AGAIN 006052 3177 ASC4, DCA SUCCES 006053 1044 TAD T3 006054 2045 ISZ T4 /GET SIGN FLAG 006055 7041 CMA IAC /GET NEG TOTAL 006056 5261 JMP ASC6 /AND GO 006057 7340 ASCFL, NONE 006060 3177 DCA SUCCES /SET FOR FAIL 006061 2200 ASC6, ISZ ASC 006062 5600 JMP I ASC /AND DONE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 57 006063 0000 INT, 0 006064 3150 DCA T1 /SAVE AC 006065 1152 TAD TOP 006066 6211 CDF 10 006067 3045 DCA T4 006070 3445 DCA I T4 006071 1045 TAD T4 006072 3011 DCA INDEX1 /JUNK STORAGE 006073 3411 DCA I INDEX1 /NULL AT BEGINNING 006074 1150 TAD T1 006075 7700 SMA CLA /NEGATIVE? 006076 5303 JMP INT1 006077 2445 ISZ I T4 /SET SIGN FLAG 006100 1150 TAD T1 006101 7041 CMA IAC /AND PRETEND IT'S POSITIVE 006102 3150 DCA T1 006103 3042 INT1, DCA T2 /COUNT 006104 1172 INT2, TAD BASE 006105 7041 CMA IAC 006106 1150 TAD T1 /TEST SIZE OF REMAINDER 006107 7510 SPA /SMALL ENOUGH? 006110 5314 JMP INT3 /YES 006111 3150 DCA T1 /SUBTRACT BASE FROM ATOM 006112 2042 ISZ T2 /INC CNT 006113 5304 JMP INT2 /AND AGAIN 006114 1172 INT3, TAD BASE /GET ATOM 006115 1376 TAD (260 /MAKE ASCII 006116 3411 DCA I INDEX1 /SAVE 006117 1042 TAD T2 /GET CNT 006120 7440 SZA /DONE? 006121 5302 JMP INT1-1 /NO - CNT IS NEW #
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 58 006122 1445 TAD I T4 /SIGN 006123 7650 SNA CLA 006124 5327 JMP .+3 006125 1375 TAD (255 /MINUS SIGN 006126 3411 DCA I INDEX1 /SAVE 006127 7301 ONE 006130 1011 TAD INDEX1 /PTR TO END OF # 006131 3055 DCA XPTR 006132 7301 ONE 006133 3056 DCA XPTR+1 006134 1011 TAD INDEX1 006135 3150 DCA T1 006136 1550 INT5, TAD I T1 006137 7450 SNA 006140 5351 JMP INT7 006141 6201 CDF 0 006142 4553 JMS I WRCHAR 006143 0055 XPTR 006144 6211 CDF 10 006145 7340 NONE 006146 1150 TAD T1 006147 3150 DCA T1 006150 5336 JMP INT5 006151 6201 INT7, CDF 0 006152 4543 JMS I CLVAR /CLOSE VARIABLE 006153 0055 XPTR 006154 7301 ONE 006155 1011 TAD INDEX1 006156 3546 DCA I PUTLST 006157 1146 TAD PUTLST 006160 3011 DCA INDEX1 006161 7301 ONE 006162 3411 DCA I INDEX1 /ALL 006163 7340 NONE 006164 3411 DCA I INDEX1 006165 1663 TAD I INT /GET VARPTR 006166 3150 DCA T1 006167 4547 JMS I PUTVAR 006170 7402 HLT /NO FAIL 006171 2263 ISZ INT 006172 5663 JMP I INT /GO BACK 6200 XT1=.&7600+200 006175 0255 006176 0260 006177 7520 3664 *XL1 /PAGE ADDRESS LINK FROM UPDBAS
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 59 / THIS ROUTINE HANDLES ALL INDIRECT VARIABLES AND LABELS. IT /RETURNS WITH THE SUCCESS FLAG SET AND THE AC CONTAINING /THE VALUE FOR THE NAME. 003664 0000 INDRCT, 0 003665 7300 ZERO 003666 1664 TAD I INDRCT 003667 3050 DCA TXX 003670 1050 TAD TXX 003671 4537 JMS I UPDSPF /UPDATE IF SPECIAL FUNCTION 003672 5777' JMP RTSER2 003673 1450 TAD I TXX /GE THE VALUE 003674 7450 SNA /NULL? 003675 5777' JMP RTSER2 /YES - FAIL 003676 3042 DCA T2 003677 7301 ONE 003700 3043 DCA T2+1 003701 1152 TAD TOP /USE TOP FOR JUNK STORAGE 003702 3011 DCA INDEX1 003703 7325 THREE /-# OF WDS 003704 3150 DCA T1 003705 4545 IND0, JMS I GETCHR /GET THE NEXT CHAR 003706 0042 T2 003707 5326 JMP IND1 /FAIL 003710 0112 AND C77 /MAKE INTO SIXBIT 003711 4526 JMS I LJUST 003712 4526 JMS I LJUST /LEFT JUSTIFY 003713 3044 DCA T3 003714 4545 JMS I GETCHR /GET THE NEXT CHAR 003715 0042 T2 003716 5320 JMP INDA 003717 0112 AND C77 003720 1044 INDA, TAD T3 /GET THE FULL WD 003721 6211 CDF 10 003722 3411 DCA I INDEX1 /SAVE 003723 6201 CDF 0 003724 2150 ISZ T1 /DONE? 003725 5305 JMP IND0 /NO 003726 6211 IND1, CDF 10 003727 3411 DCA I INDEX1 /ZERO AT THE END 003730 7340 NONE 003731 1037 TAD INDR /PTR TO TABLE 003732 3011 DCA INDEX1
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 60 003733 1152 IND2, TAD TOP 003734 3045 DCA T4 /PTR TO OUR NAME 003735 1411 IND3, TAD I INDEX1 /GET NET WD FROM TABLE 003736 7041 CMA IAC 003737 2045 ISZ T4 003740 1445 TAD I T4 /AND WHAT WE'RE SEARCHING FOR 003741 7650 SNA CLA /MATCH? 003742 5361 JMP IND6 /YES 003743 1011 TAD INDEX1 003744 3047 DCA TX 003745 1447 IND4, TAD I TX /GET BACK WD FROM TABLE 003746 0112 AND C77 003747 2047 ISZ TX 003750 7640 SZA CLA /END OF ARG? 003751 5345 JMP IND4 /NO 003752 1047 TAD TX 003753 3011 DCA INDEX1 /UPD PTR 003754 2047 ISZ TX 003755 1447 TAD I TX /GET 1ST WD OF NEXT ENTRY 003756 7640 SZA CLA /EXIST? 003757 5333 JMP IND2 /YES - TRY AGAIN 003760 5777' JMP RTSER2 /ERROR 003761 1011 IND6, TAD INDEX1 /HERE ON MATCH 003762 3047 DCA TX 003763 1447 TAD I TX 003764 0112 AND C77 003765 7640 SZA CLA /DONE WITH TEST? 003766 5335 JMP IND3 /NO - TRY NET WD 003767 1445 TAD I T4 003770 0112 AND C77 003771 7640 SZA CLA 003772 5335 JMP IND3 003773 1411 TAD I INDEX1 /GET VALUE 003774 6201 CDF 0 003775 2264 ISZ INDRCT 003776 5664 JMP I INDRCT /RETURN 003777 6334 6200 *XT1
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 61 /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. 006200 0000 UPDFUN, 0 006201 3047 DCA TX 006202 1047 TAD TX 006203 1103 TAD NC20 006204 7510 SPA /IS THIS A SPECIAL FUNCTION? 006205 5221 JMP UPDRET 006206 1102 TAD NC10 006207 7500 SMA 006210 5221 JMP UPDRET 006211 1377 TAD (UPDIFN+10 /YES - GET THE ADDRESS OF THE FUNCTION 006212 3047 DCA TX 006213 1447 TAD I TX 006214 7450 SNA /AN INPUT ROUTINE? 006215 5221 JMP UPDRET 006216 3047 DCA TX 006217 4447 JMS I TX /YES - CALL IT 006220 7410 SKP 006221 2200 UPDRET, ISZ UPDFUN /SKIP ON SUCCESS 006222 7300 ZERO 006223 3074 DCA RDFLG /CLEAR READING FLAG 006224 5600 JMP I UPDFUN
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 62 006225 0000 PRN, 0 006226 3047 DCA TX 006227 2225 ISZ PRN /ALWAYS SUCCeEDs 006230 4524 JMS I INTST /<CTRL>C TYPED? 006231 1047 TAD TX 006232 1104 TAD NC215 /RETURN? 006233 7450 SNA 006234 3031 DCA OCNT /YES - CNT BACK TO BEG 006235 1107 TAD C4 /TAB? 006236 7650 SNA CLA 006237 5243 JMP PRN1 006240 1047 TAD TX 006241 4252 JMS PRX 006242 5625 JMP I PRN 006243 1115 PRN1, TAD C240 /SPACE UNTIL RIGHT 006244 4252 JMS PRX 006245 1031 TAD OCNT 006246 0111 AND C7 006247 7640 SZA CLA /POSITIONED RIGHT? 006250 5243 JMP PRN1 006251 5625 JMP I PRN /YES - DONE 006252 0000 PRX, 0 006253 3050 DCA TXX 006254 1152 TAD TOP /KEEP TOP IN THE LIGHTS 006255 6041 TSF 006256 5255 JMP .-1 006257 7300 ZERO 006260 1050 TAD TXX 006261 6046 TLS 006262 1376 TAD (-232 006263 7740 SMA SZA CLA /IS THIS A PRINTING CHARACTER? 006264 2031 ISZ OCNT /YES - INC POS CNT 006265 5652 JMP I PRX 006266 0000 INTTST, 0 006267 6031 KSF /ANYTHING TYPED? 006270 5666 INTFN, JMP I INTTST 006271 6034 KRS /YES - GET IT 006272 1375 TAD (-203 006273 7640 SZA CLA /CONTROL C? 006274 5666 JMP I INTTST 006275 6032 KCC /YES - ZERO FLAG 006276 5774' JMP ACC8 /AND RETURN TO MONITOR 6277 XT3=. 006374 4535 006375 7575 006376 7546 006377 6420 5752 *XL3 /PAGE LINK ADDRESS FROM FILEDC
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 63 005752 0000 RETLFX, 0 005753 1114 TAD C215 005754 4772' JMS CLPRN 005755 1113 TAD CLF 005756 4772' JMS CLPRN 005757 5752 JMP I RETLFX 005760 0000 GPTRX, 0 005761 3050 DCA TXX 005762 1450 TAD I TXX 005763 3050 DCA TXX 005764 1450 TAD I TXX 005765 5760 JMP I GPTRX 005772 6277 6277 *XT3 006277 0000 CLPRN, 0 /CALL PRN WITHOuT a SKIP RETURN 006300 4225 JMS PRN 006301 7402 HLT 006302 5677 JMP I CLPRN 006303 0000 RJST, 0 006304 7110 CLL RAR 006305 7110 CLL RAR 006306 7110 CLL RAR 006307 5703 JMP I RJST 006310 0000 LJST, 0 006311 7104 CLL RAL 006312 7104 CLL RAL 006313 7104 CLL RAL 006314 5710 JMP I LJST 006315 0000 USRLOK, 0 006316 6212 CIF 10 006317 4540 JMS I USR 006320 0010 10 /LOCK THE USR IN CORE 006321 5715 JMP I USRLOK 006322 0000 USRDIS, 0 006323 6212 CIF 10 006324 4530 JMS I LUSR 006325 0011 11 /DISMISS THE USR FROM CORE 006326 5722 JMP I USRDIS
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 64 /THIS ROUTINE HANDLES FATAL RUNTIME SYSTEM ERRORS. SOME ARE PROGRAMMER /INDUCED, SOME INDICATE FLAWS IN THE RUN TIME SYSTEM. 006327 2353 RTSER7, ISZ RTSERR 006330 2353 RTSER6, ISZ RTSERR 006331 2353 RTSER5, ISZ RTSERR 006332 2353 RTSER4, ISZ RTSERR 006333 2353 RTSER3, ISZ RTSERR 006334 2353 RTSER2, ISZ RTSERR 006335 2353 RTSER1, ISZ RTSERR 006336 6201 RTSER0, CDF 0 /PROTECT 006337 7300 ZERO 006340 1354 TAD ERRMSG 006341 3010 DCA INDEX0 /POINTER TO FAILURE MESSGE 006342 1410 RTSER, TAD I INDEX0 /GET THE NEXT CHAR FROM THE MESSAGE 006343 7450 SNA 006344 5347 JMP .+3 006345 4277 JMS CLPRN /TYPE IT 006346 5342 JMP RTSER 006347 1353 TAD RTSERR /GET THE ERROR CODE 006350 1373 TAD (260 006351 4277 JMS CLPRN /GIVE IT 006352 5772 JMP I (7600 /AND GO TO OS/8 006353 0000 RTSERR, 0 006354 6354 ERRMSG, .;215;212;"?;"S;"N;"O;"R;"T;"S;240;0 006355 0215 006356 0212 006357 0277 006360 0323 006361 0316 006362 0317 006363 0322 006364 0324 006365 0323 006366 0240 006367 0000 006372 7600 006373 0260 6400 PAGE
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 65 /THIS PAGE CONTAINS TABLES USED FOR HANDLING THE SPECIAL FUNCTIONS /INPUT, OUTPUT, READ, WRITE, OUTHOLD, AND WRITEH / THIS TABLE IS FOR PUTVAR 006400 0000 PUTSPF, 0 006401 0000 0 006402 6225 PRN /OUTPUT 006403 6225 PRN /OUTHOLD 006404 4712 WRITH /WRITE 006405 4712 WRITH /WRITEH 006406 0000 0;0 006407 0000 / THIS TABLE IS FOR UPDFUN 006410 4407 UPDIFN, ACCEPT /INPUT 006411 4600 READH /READ 006412 0000 0;0;0;0;0;0 006413 0000 006414 0000 006415 0000 006416 0000 006417 0000
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 66 / BLOCK DATA STORAGE. 006420 0423 DEVI, DEVICE DSK 006421 1300 006422 0423 DEVO, DEVICE DSK 006423 1300 006424 0004 4;0 / PATTBL-1, 2 -- FOR NON-ANCH VAR 006425 0000 006426 0000 PATBL, ZBLOCK 30 006456 0000 IFILNM, ZBLOCK 4 006462 0000 OFILNM, ZBLOCK 4 006466 0000 VARTB, ZBLOCK 14 006502 0000 PLST, ZBLOCK 30 006532 0000 PDLST, ZBLOCK 40 / PUSHDOWN LIST. $$$$$$$$$$$$$$$$$$$
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 67 ACCEPT 4407 C7400 0122 INDEX2 0012 OPIH2 4024 ACC0 4425 C77 0112 INDEX3 0013 OPIL1 4036 ACC1 4453 DEVI 6420 INDEX4 0014 OPIL2 4037 ACC10 4545 DEVO 6422 INDEX5 0015 OPIN 4000 ACC11 4555 ERRMSG 6354 INDEX6 0016 OPINFL 4062 ACC3 4463 FILCH 5717 INDEX7 0017 OPIN1 4057 ACC5 4457 FILCOK 5740 INDR 0037 OPOH1 4107 ACC6 4477 FILC1 5732 INDRCT 3664 OPOH2 4111 ACC7 4512 FILC2 5742 IND0 3705 OPOO1 4127 ACC8 4535 FILEDC 5617 IND1 3726 OPOO2 4130 ACC9 4542 FILL1 5632 IND2 3733 OPOUT 4065 ANCH 0120 FILL2 5645 IND3 3735 OPTR 0061 ARGCNT 0030 FILSIZ 0176 IND4 3745 OUTBLK 0070 ASC 6000 FIL1 5652 IND6 3761 OUTBUF 0131 ASCFL 6057 FIL1A 5661 INIT 2600 OUTFL 4155 ASC1 6016 FIL2 5663 INITL1 2646 OUTHOL 0023 ASC2 6040 FIL3 5665 INIT1 2651 OUTLEN 0071 ASC3 6044 FIL4 5670 INLEN 0064 OUTLN 0072 ASC4 6052 FIL5 5673 INPUT 0020 OUTPUT 0022 ASC6 6061 FIL6 5705 INT 6063 OUT1 4152 BASE 0172 FIL7 5710 INTFIN 0125 PAT 2660 BUFLEN 0400 FIL8 5713 INTFN 6270 PATBAK 3273 CLF 0113 FNDSP 4326 INTST 0124 PATBAS 0032 CLIN 4400 FNDSPC 0144 INTTST 6266 PATBL 6426 CLOC1 4322 FNDSPS 4370 INT1 6103 PATB1 3333 CLOUT 4257 FND0 4332 INT2 6104 PATDT 2762 CLOUTF 4323 FND1 4337 INT3 6114 PATDT2 3022 CLOUTX 4310 FND2 4357 INT5 6136 PATFL 3530 CLOUT1 4313 FND4 4361 INT7 6151 PATSCS 3417 CLPRN 6277 FND5 4366 IOFLG 0065 PATSER 0132 CLRET 5465 FOUR 7307 IPTR 0057 PATSR 3600 CLRVAR 0142 GETCH 5005 LJST 6310 PATSTS 0033 CLRVR 5504 GETCHR 0145 LJUST 0126 PATTBL 0133 CLRZ 5551 GETRET 5071 LNKVAR 0127 PAT0 2716 CLR0 5507 GETX 5172 LNKVR 5420 PAT10 3000 CLR1 5532 GET0 5011 LUSR 0130 PAT12 3003 CLR2 5547 GET1 5030 NC1 0075 PAT14 3006 CLVAR 0143 GET2 5040 NC10 0102 PAT16 3033 CLVR 5423 GET3 5062 NC20 0103 PAT18 3036 CLX1 5502 GET4 5101 NC215 0104 PAT2 2724 CLX2 5503 GET5 5136 NC3 0076 PAT20 3065 CL1 5437 GPTR 0123 NC4 0077 PAT20X 3156 CL2 5475 GPTRX 5760 NC5 0100 PAT20Y 3160 C1 0105 GWFLG 5167 NC7 0101 PAT22 3075 C212 0113 GWPTR 5170 NONE 7340 PAT24 3123 C215 0114 H1 0041 NTHREE 7346 PAT26 3141 C240 0115 IBUF 0200 NTWO 7344 PAT28 3161 C3 0106 ICLTAB 0142 OBUF 0600 PAT30 3200 C377 0116 IDVHAN 6600 OCNT 0031 PAT32 3212 C3777 0117 IFILNM 6456 ODEVNM 0073 PAT34 3214 C4 0107 IHAN 0066 ODVHAN 7200 PAT36 3226 C4000 0120 INBLK 0063 OFILNM 6462 PAT37 3231 C5 0110 INDA 3720 OHAN 0067 PAT38 3242 C5777 0121 INDEX0 0010 ONE 7301 PAT4 2735 C7 0111 INDEX1 0011 OPIH1 4022 PAT40 3337
/SNOBOL-8.2 RUN TIME SYSTEM. AUGUST 2 PAL8-VB0 NO DATE PAGE 67-1 PAT42 3342 READ1 4614 USRLOK 6315 PAT44 3361 READ2 4641 VARTB 6466 PAT46 3400 READ3 4656 VARTBL 0141 PAT48 3434 READ4 4671 WRCHAR 0153 PAT50 3435 READ6 4674 WRCHR 5000 PAT52 3453 READ8 4662 WRCX 5171 PAT54 3462 RETLF 0135 WRC1 5141 PAT56 3512 RETLFX 5752 WRC2 5144 PAT58 3524 RJST 6303 WRC3 5157 PAT6 2743 RJUST 0136 WRFL 4764 PAT60 3527 RTSER 6342 WRITE 0024 PAT62 3537 RTSERR 6353 WRITEH 0025 PAT64 3547 RTSER0 6336 WRITH 4712 PAT66 3554 RTSER1 6335 WRXX1 4735 PAT8 2747 RTSER2 6334 WR1 4757 PDL 0034 RTSER3 6333 WR2 4770 PDLIST 0134 RTSER4 6332 XL1 3664 PDLST 6532 RTSER5 6331 XL2 4326 PLST 6502 RTSER6 6330 XL3 5752 POP 4233 RTSER7 6327 XPTR 0055 POPJ 4236 SERX1 3624 XT1 6200 POSR 0026 SERX2 3646 XT2 5600 PRN 6225 SERX3 0051 XT3 6277 PRN1 6243 SERX4 0052 ZERO 7300 PRX 6252 SERX5 3642 PUSH 4200 SER1 3616 PUSHJ 4203 SER2 3633 PUSH1 4225 SER3 3635 PUTLST 0146 SER4 3637 PUTS 5367 SIX 7327 PUTSPF 6400 STBLK 4630 PUTVAR 0147 SUCCES 0177 PUTVR 5200 SVSPCH 0151 PUT0 5217 THREE 7325 PUT1 5227 TOP 0152 PUT10 5400 TOPP 0035 PUT11 5414 TOPX 0036 PUT12 5355 TWO 7305 PUT2 5233 TX 0047 PUT3 5253 TXX 0050 PUT4 5273 T1 0150 PUT5 5311 T2 0042 PUT6 5322 T3 0044 PUT7 5330 T4 0045 PUT8 5345 UPDBAS 3650 PUT9 5353 UPDB1 3653 PXT1 0053 UPDFUN 6200 PXT2 5416 UPDIFN 6410 PXT4 0054 UPDPTR 5600 PXT5 5371 UPDRET 6221 PXT6 5373 UPDSPF 0137 P1 0040 UPDX 3663 RDFLG 0074 UPD1 5615 READ 0021 USR 0140 READH 4600 USRDIS 6322
ERRORS DETECTED: 0 LINKS GENERATED: 76



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