From 8ad50fb9be8aaaac4f94b78ea1243fc789ae8e67 Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Sun, 20 May 2018 11:16:43 -0700 Subject: [PATCH] Commit additional proofreading corrections to APL-IMAGE by Paul Kimpel. 1. Apply typographical corrections to the source from APL/L200013 on the 1972 CUBEA13 library tape. 2. Add APLPTCH.19710305.alg_m patch file with differences between the APL-IMAGE.alg_m listing and APL/L200013. 3. Add APLPTCH.L200014 patch file from the CUBEA13 tape with changes to APL/L200013. 4. Update provenance and transcription details in README.txt. --- APL-WU-Kildall/APL-IMAGE-List.lst | 7746 +++++++++++++++++++++++++ APL-WU-Kildall/APL-IMAGE.alg_m | 406 +- APL-WU-Kildall/APLPTCH.19710305.alg_m | 6 + APL-WU-Kildall/APLPTCH.L200014.alg_m | 6 + APL-WU-Kildall/README.txt | 75 +- 5 files changed, 8026 insertions(+), 213 deletions(-) create mode 100644 APL-WU-Kildall/APL-IMAGE-List.lst create mode 100644 APL-WU-Kildall/APLPTCH.19710305.alg_m create mode 100644 APL-WU-Kildall/APLPTCH.L200014.alg_m diff --git a/APL-WU-Kildall/APL-IMAGE-List.lst b/APL-WU-Kildall/APL-IMAGE-List.lst new file mode 100644 index 0000000..d77c682 --- /dev/null +++ b/APL-WU-Kildall/APL-IMAGE-List.lst @@ -0,0 +1,7746 @@ +? LABEL 000000000LINE 00188140?COMPILE 0APL/DISK ALGOL LIBRARY ALGOL /0APL + + + + + +? BURROUGHS B-5700 ALGOL COMPILER MARK XIII.0 THURSDAY, 05/19/88, 11:08 AM. + + + + + + BEGIN 00000490 0000 + START OF SEGMENT ********** 2 + % THIS APL/B5500 PROGRAM WAS DEVELOPED BY THE COMPUTER SCIENCE GROUP 00000500 0000 + % AT THE UNIVERSITY OF WASHINGTON UNDER THE SPONSORSHIP OF PROFESSOR 00000510 0000 + % HELLMUT GOLDE. THE PROGRAM MAY NOT BE OFFERED FOR SALE OR LEASE 00000520 0000 + % IN ITS ORIGINAL OR ANY MODIFIED FORM. ANY PUBLICATION RELATING TO 00000530 0000 + % THIS PROGRAM OR ANY MODIFICATION OF THE PROGRAM MUST EXPLICITLY CREDIT 00000540 0000 + % THE COMPUTER SCIENCE GROUP OF THE UNIVERSITY OF WASHINGTON AND THE 00000550 0000 + % PRINCIPAL IMPLEMENTORS, GARY KILDALL, LEROY SMITH, SALLY SWEDINE, 00000560 0000 + % AND MARY ZOSEL. COMPUTER RESOURCES FOR THE DEVELOPMENT OF THE 00000570 0000 + % PROGRAM WERE MADE AVAILABLE BY THE UNIVERSITY OF WASHINGTON COMPUTER 00000580 0000 + % CENTER. 00000590 0000 + DEFINE VERSIONDATE="1-11-71"# ; 00000600 0000 + %MODIFICATIONS FOR B-5500 TIME-SHARING MCP MADE BY: 00000601 0000 + % JOSE HERNANDEZ, BURROUGHS CORPORATION. 00000602 0000 + BOOLEAN BREAKFLAG; 00000609 0000 + ARRAY GTA[0:1]; 00000610 0000 + LABEL FINIS; %GO THERE WHEN YOU ARE IN TROUBLE (SPOUT A MESSAGE) 00000630 0001 + BOOLEAN PROCEDURE LIBRARIAN(A,B); VALUE A,B; REAL A,B; FORWARD; 00000700 0001 + LABEL FAULTL; %FAULT LABEL 00000800 0001 + MONITOR EXPOVR,INTOVR,INDEX:=INDEXF,FLAG,ZERO; 00000810 0001 + REAL BIGGEST, NULLV; 00000900 0010 + INTEGER STACKSIZE,LIBSIZE; 00001000 0010 + REAL STATUSWORD,CORELOC; 00001100 0010 + BOOLEAN RETURN; 00001110 0010 + BOOLEAN MEMBUG,DEBUG; 00001120 0010 + COMMENT MEMBUG SWITCHES ---------------------- 00001130 0010 + BIT FUNCTION BIT FUNCTION 00001140 0010 + ----------------------------------------------------------------- 00001150 0010 + 1 25 00001160 0010 + 2 26 00001170 0010 + 3 27 00001180 0010 + 4 28 00001190 0010 + 5 DUMP TYPES @ INSERT 30 00001200 0010 + 6 DUMP TYPES @ DELETE 30 00001210 0010 + 7 31 00001220 0010 + 8 32 00001230 0010 + 9 33 00001240 0010 + 10 34 00001250 0010 + 11 35 00001260 0010 + 12 36 00001270 0010 + 13 37 00001280 0010 + 14 38 00001290 0010 + 15 39 00001300 0010 + 16 40 00001310 0010 + 17 41 00001320 0010 + 18 42 00001330 0010 + 19 43 00001340 0010 + 20 DUMP INDEX 44 00001350 0010 + 21 45 00001360 0010 + 22 DUMP TYPES 46 00001370 0010 + 23 CHECK TYPES 47 00001380 0010 + 24 DUMP BUFFER #S 00001390 0010 + ; 00001400 0010 + FILE PRINT 4 "SYSTEMS" " BOX " (1,15); 00001410 0010 + FILE TWXIN 19(2,30),TWXOUT 19(2,10); 00001415 0013 + % 00001416 0020 + DEFINE 00001420 0020 + PAGESIZE=120#, 00001430 0020 + AREASIZE=40#, 00001440 0020 + CF=[26:13]#, COMMENT COUNT FIELD -- NUMBER OF ITEMS ON PAGE; 00001450 0020 + TF=[39:9] #, COMMENT T-FIELD (TYPE FIELD); 00001460 0020 + FF=[9:1]#, COMMENT FULL FIELD FOR SEQUENTIAL STORAGE; 00001465 0020 + AF=[1:23] #, COMMENT A-FIELD; 00001470 0020 + BF=[24:23]#, COMMENT B-FIELD; 00001480 0020 + MF=[1:1]#, COMMENT METHOD OF STORAGE FIELD; 00001490 0020 + SF=[13:13]#, COMMENT SEQUENTIAL STORAGE SIZE FIELD (#CHRS); 00001500 0020 + BOOL=[47:1]#, 00001510 0020 + SKIP=1#, COMMENT --AMOUNT OF SPACE RESERVED AT THE 00001520 0020 + START OF EACH PAGE; 00001530 0020 + ALLOWANCE=10#, COMMENT --DEVIATION FROM THE AVERAGE PAGE SIZE 00001540 0020 + ALLOWED BEFORE CORRECTION; 00001550 0020 + RECSIZE=2#, 00001560 0020 + MAXPAGES=20#, 00001570 0020 + PAGESPACE=20#, 00001580 0020 + NEXTP=[42:6]#, 00001590 0020 + LASTP=[36:6]#, 00001600 0020 + PAGEF=[19:11]#, 00001610 0020 + BUFF=[12:6]#, 00001620 0020 + CHANGEDBIT=[1:1]#, 00001630 0020 + MBUFF=8#, 00001640 0020 + SBUFF=4#, 00001650 0020 + FLAGB=[18:1]#, COMMENT FLAG BIT FOR BUFFER MAINTENANCE; 00001660 0020 + EXTRAROOM=1#, 00001670 0020 + LIBJOB="/APLIBE"#,%MFID FOR APL SYSTEM FILE 00001675 0020 + ENDOFDEFINES=#; 00001680 0020 + REAL PROCEDURE CDR(X); VALUE X; REAL X; CDR:=X.NEXTP; 00001690 0020 + PROCEDURE RPLACD(X,Y); VALUE Y;REAL X,Y; X.NEXTP:=Y; 00001710 0026 + BOOLEAN PROCEDURE NULL(X); VALUE X; REAL X; NULL:=X.NEXTP=0; 00001730 0028 + BOOLEAN STREAM PROCEDURE EOFMARK(SK,RS,A); VALUE SK,RS; 00001740 0034 + BEGIN LABEL NO; SI:=A; SK(SI:=SI+8); 00001750 0034 + RS(8( 2(IF SB THEN JUMP OUT 3 TO NO; SKIP SB); 00001760 0035 + 3(IF SB THEN SKIP SB ELSE JUMP OUT 3 TO NO); IF SB THEN 00001770 0039 + JUMP OUT 2 TO NO; SKIP SB));TALLY:=1;EOFMARK:=TALLY; 00001780 0042 + NO: 00001790 0044 + END; 00001800 0044 + STREAM PROCEDURE MARKEOF(SK,RS,A); VALUE SK,RS; 00001810 0046 + BEGIN DI:=A; 00001820 0046 + SK(DI:=DI+8); 00001830 0046 + RS(8(DS:=2RESET; DS:=3SET; DS:=RESET)); 00001840 0047 + END; 00001850 0050 + SAVE FILE ESTABLISH DISK [MAXPAGES:AREASIZE] 00001860 0050 + (1,PAGESIZE,SAVE 100); 00001870 0051 + FILE NEWDISK DISK (1,PAGESIZE); 00001880 0057 + FILE DISK1 DISK (1,PAGESIZE), 00001890 0060 + DISK2 DISK (1,PAGESIZE), 00001900 0064 + DISK3 DISK (1,PAGESIZE), 00001910 0067 + DISK4 DISK (1,PAGESIZE), 00001920 0071 + DISK5 DISK (1,PAGESIZE), 00001930 0074 + DISK6 DISK (1,PAGESIZE), 00001940 0078 + DISK7 DISK (1,PAGESIZE), 00001950 0081 + DISK8 DISK (1,PAGESIZE); 00001960 0085 + SWITCH FILE POINTERS:=DISK1,DISK1,DISK2,DISK3,DISK4,DISK5,DISK6,DISK7, 00001970 0088 + DISK8; 00001980 0100 + PROCEDURE SETPOINTERNAMES; 00002600 0101 + BEGIN 00002610 0104 + IF NOT LIBRARIAN(LIBJOB,TIME(-1)) THEN 00002650 0104 + BEGIN 00002660 0106 + WRITE(ESTABLISH); 00002670 0106 + MARKEOF(SKIP,RECSIZE,ESTABLISH(0)); 00002680 0110 + WRITE(ESTABLISH[1]); 00002690 0114 + WRITE(ESTABLISH[MAXPAGES×AREASIZE-1]); 00002700 0119 + LOCK(ESTABLISH); 00002710 0125 + CLOSE(ESTABLISH) 00002720 0126 + ;LIBSIZE←-1; 00002721 0127 + END 00002730 0129 + END; 00002740 0129 + DEFINE 00002750 0131 + LIBMAINTENANCE=0#, 00002760 0131 + MESSDUM=#; 00002770 0131 + PROCEDURE MEMORY(MODE,TYPE,A,N,M);VALUE MODE,TYPE; 00002780 0131 + INTEGER MODE,TYPE,N,M; ARRAY A[0]; FORWARD; 00002790 0131 + STREAM PROCEDURE MOVE(A,N,B); VALUE N; 00002792 0131 + BEGIN SI:=A; DI:=B; DS:=N WDS; 00002794 0131 + END; 00002796 0132 + PROCEDURE MESSAGE(I); VALUE I; INTEGER I; 00002800 0132 + BEGIN 00002810 0132 + FORMAT F("MEMORY ERROR",I5); 00002820 0132 + START OF SEGMENT ********** 3 + START OF SEGMENT ********** 4 + 4 IS 6 LONG, NEXT SEG 3 + COMMENT CHANGE LINE 3050 TO WRITE(PRINT,SF[I]) FOR MEMORY ERROR PROBS. 00002825 0000 + THIS FORMAT IS NOW EXCLUDED SINCE MEMORY IS SEEMINGLY WELL DEBUGED 00002826 0000 + SWITCH FORMAT SF:= 00002830 0000 + ("LIBRARY MAINTENANCE IN PROGRESS."), 00002840 0000 + ("SYSTEM ERROR--MEMORY ACCESS WITH EXPRESSION FOR N OR M."), 00002850 0000 + ("SYSTEM ERROR--IMPROPER ARGUMENTS TO FREEPAGE."), 00002860 0000 + ("SYSTEM ERROR--TOO LARGE A SUBSCRIPT FOR TYPE SPECIFIED."), 00002870 0000 + ("SYSTEM ERROR--TYPE CANNOT BE ZERO WHEN INSERTING OR DELETING."), 00002880 0000 + ("SYSTEM ERROR--CHARACTER STRING TOO LONG TO STORE."), 00002890 0000 + ("SYSTEM ERROR--ATTEMPT TO INSERT NON-SEQUENTIAL ELEMENT", 00002900 0000 + "IN TYPE A STORAGE."), 00002910 0000 + ("SYSTEM ERROR--NO BLANKS IN PAGES."), 00002920 0000 + ("SYSTEM ERROR--ATTEMPTED BINARY SEARCH OF UNORDERED DATA."), 00002930 0000 + ("SYSTEM ERROR--BINARY SEARCH OF UNALLOCATED DATA ATTEMPTED."), 00002940 0000 + ("SYSTEM ERROR--BINARY SEARCH FOUND A BLANK PAGE."), 00002950 0000 + ("SYSTEM ERROR--DELETION OF TYPE B STORAGE NOT IMPLEMENTED."), 00002960 0000 + ("SYSTEM ERROR--ATTEMPT TO DELETE FROM NON-EXISTENT STORAGE."), 00002970 0000 + ("SYSTEM ERROR--ATTEMPT TO DELETE RECORD FROM OUTSIDE", 00002980 0000 + " ALLOCATED STORAGE."), 00002990 0000 + ("SYSTEM ERROR--ATTEMPTED MEMORY SEARCH WITH -N- TOO LARGE."), 00003000 0000 + ("SYSTEM ERROR--ATTEMPT TO CHANGE PREVIOUSLY DESIGNATED STORAGE", 00003010 0000 + " KIND"), 00003020 0000 + ("SYSTEM ERROR--POINTERS TO DATA TYPES OVERLAP."), 00003030 0000 + (" "); 00003040 0000 + WRITE(PRINT,F,I); 00003050 0000 + IF I GTR 0 THEN 00003060 0007 + BEGIN 00003070 0008 + INTEGER GT1,GT2,GT3; 00003075 0008 + START OF SEGMENT ********** 5 + MEMORY(10,GT1,GTA,GT2,GT3); 00003082 0000 + GO TO FINIS; 00003084 0002 + END; 00003090 0004 + 5 IS 5 LONG, NEXT SEG 3 + END; 00003100 0009 + 3 IS 13 LONG, NEXT SEG 2 + PROCEDURE MEMORY(MODE,TYPE,A,N,M); VALUE MODE,TYPE; 00003102 0132 + INTEGER MODE,TYPE,N,M; ARRAY A[0]; 00003104 0132 + BEGIN 00003106 0132 + DEFINE T64= DI:=LOC T; DI:=DI+1; DS:=7 CHR#; 00003110 0132 + START OF SEGMENT ********** 6 + STREAM PROCEDURE WRITERECS(PAGE,A,SKP,NB,NR,NS,RL); 00003120 0000 + VALUE SKP,NB,NR,NS,RL; 00003130 0000 + BEGIN 00003140 0000 + COMMENT -- NS IS THE NUMBER OF WORDS TO SAVE (ON THE 00003150 0000 + TAIL OF THE PAGE); 00003160 0000 + LOCAL T,T1,T2,TT; 00003170 0000 + COMMENT -- MOVE TO POSITION FOR WRITE; 00003180 0000 + SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8); 00003190 0000 + T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8)); 00003200 0002 + T1:=SI; COMMENT -- RECORDS WILL BE WRITTEN HERE; 00003210 0009 + COMMENT -- SKIP OVER TO END OF RECORDS TO BE SAVED; 00003220 0009 + DI:=LOC TT; SI:=LOC NS; DI:=DI+1; DS:=7CHR; 00003230 0009 + SI:=T1; COMMENT MOVE TO THE END OF THE FIELD TO BE SAVED; 00003240 0010 + TT(2(32(RL(SI:=SI+8)))); NS(RL(SI:=SI+8)); 00003250 0010 + T2:=SI; COMMENT -- END OF FIELD TO BE SAVED; 00003260 0017 + SI:=LOC NR; T64; DI:=T2; 00003270 0017 + T(2(32(RL(DI:=DI+8)))); NR(RL(DI:=DI+8)); 00003280 0018 + SI:=T2; SI:=SI-8; DI:=DI-8; 00003290 0025 + TT(2(32(RL(DS:=WDS; SI:=SI-16; DI:=DI-16)))); 00003300 0026 + NS(RL(DS:=WDS; SI:=SI-16; DI:=DI-16)); 00003310 0030 + COMMENT -- HAVE ACCOMPLISHED THE "SAVE", NOW DO THE WRITE; 00003320 0033 + SI:=A; DI:=T1; 00003330 0033 + T(2(32(DS:=RL WDS))); NR(DS:=RL WDS) 00003340 0034 + END; 00003350 0038 + STREAM PROCEDURE READRECS(PAGE,A,SKP,NB,NR,NM,RL); 00003360 0038 + VALUE SKP,NB,NR,NM,RL; 00003370 0038 + BEGIN 00003380 0038 + COMMENT 00003390 0039 + SKP = "SKIP" - - THE NUMBER OF WORDS TO JUMP OVER 00003400 0039 + NB = "NUMBER BEFORE" -- " " RECORDS TO SKIP BEFORE 00003410 0039 + READING THE RECORD, 00003420 0039 + NR = "NUMBER OF RECORDS" " " " " READ FROM THE 00003430 0039 + BUFFER, 00003440 0039 + NM ="NUMBER TO MOVE" - - " " " " MOVE OVER TO 00003450 0039 + THE PREVIOUSLY READ AREA, 00003460 0039 + RL ="RECORD LENGTH" - - THE LENGTH OF EACH ITEM 00003470 0039 + ; 00003480 0039 + LOCAL T,T1,T2; 00003490 0039 + SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8); 00003500 0039 + T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8)); 00003510 0041 + T1:=SI; 00003520 0048 + COMMENT - - T1 NOW HAS THE STARTING POSITION FOR THE READ; 00003530 0048 + SI:=LOC NR; T64; SI:=T1; DI:=A; 00003540 0048 + T(2(32(DS:=RL WDS))); NR(DS:=RL WDS); 00003550 0050 + T2:=SI; COMMENT T2 CONTAINS THE END OF THE READ; 00003560 0054 + SI:=LOC NM; T64; SI:=T2; DI:=T1; 00003570 0054 + T(2(32(DS:=RL WDS))); NM(DS:=RL WDS) 00003580 0056 + END READRECS; 00003590 0060 + DEFINE MOVEALONG= 00003600 0061 + DI:=LOC C; DI:=DI+6; DS:=2CHR; DI:=LOC Z; 00003610 0061 + TSI:=SI; TALLY:=TALLY+1; 00003620 0061 + IF TOGGLE THEN 00003630 0061 + BEGIN SI:=LOC C; SI:=SI+6; 00003640 0061 + IF 2 SC NEQ DC THEN 00003650 0061 + BEGIN TAL:=TALLY; SI:=LOC TAL; SI:=SI+7; 00003660 0061 + IF SC="0" THEN 00003670 0061 + BEGIN TALLY:=TMP; TALLY:=TALLY+1; TMP:=TALLY; 00003680 0061 + TALLY:=0; 00003690 0061 + END ELSE 00003700 0061 + BEGIN SI:=LOC Z; IF SC LEQ"9" THEN ; 00003710 0061 + END 00003720 0061 + END ELSE 00003730 0061 + BEGIN DI:=TDI; SI:=LOC SIZE; SI:=SI+6; DS:=2CHR; 00003740 0061 + TDI:=DI; SI:=SI-2; DI:=LOC C64; DI:=DI+7 ; DS:=CHR; 00003750 0061 + SI:=NEW; DI:=TDI; C64(2(DS:=32CHR)); DS:=SIZE CHR; 00003760 0061 + TDI:=DI; SI:=TSI; DI:=LOC C; DI:=DI+6; 00003770 0061 + DS:=2CHR; TSI:=SI; 00003780 0061 + TALLY:=TAL;CHRSTORE:=TALLY; SI:=LOC TMP; SI:=SI+7; 00003790 0061 + DI:=LOC CHRSTORE; DI:=DI+6; DS:=CHR END 00003800 0061 + END; 00003810 0061 + SI:=LOC C; DI:=LOC C64; DI:=DI+1; DS:=7CHR; DI:=TDI; SI:=SI-1; 00003820 0061 + DS:=2CHR; SI:=TSI; 00003830 0061 + C64(2(DS:=32CHR)); DS:=C CHR; TDI:=DI; TSI:=SI#; 00003840 0061 + INTEGER STREAM PROCEDURE CHRSTORE(A,SKP,B,NEW,NB,SIZE,NA,MODE, 00003850 0061 + PAGESIZE); VALUE SKP,NB,SIZE,NA,MODE,PAGESIZE; 00003860 0061 + BEGIN LOCAL T,C,TSI,TDI, 00003870 0061 + Z,C64,TMP,TAL; 00003880 0061 + LABEL DONE; 00003890 0061 + SI:=LOC NB; T64; 00003900 0061 + SI:=LOC MODE; SI:=SI+7; 00003910 0062 + IF SC="0" THEN ; COMMENT SET TOGGLE; 00003920 0062 + SI:=A; DI:=B; SKP(DS:=8CHR); 00003930 0063 + TSI:=SI; TDI:=DI; 00003940 0065 + T(2(32(MOVEALONG))); NB(MOVEALONG); 00003950 0065 + COMMENT NOW HAVE MOVED UP TO NB; 00003960 0114 + IF TOGGLE THEN 00003970 0114 + BEGIN TALLY:=TAL; CHRSTORE:=TALLY; SI:=LOC TMP; SI:=SI+7; 00003980 0114 + DI:=LOC CHRSTORE; DI:=DI+6; DS:=CHR; 00003990 0116 + SI:=LOC SIZE; SI:=SI+6; DI:=TDI; DS:=2CHR; TDI:=DI; 00004000 0117 + SI:=LOC SIZE; DI:=LOC C64; DI:=DI+1; DS:=7CHR; SI:=NEW; 00004010 0118 + DI:=TDI; C64(2(DS:=32CHR)); DS:=SIZE CHR; 00004020 0119 + END ELSE 00004030 0122 + BEGIN TSI:=SI; TDI:=DI; 00004040 0122 + SI:=LOC MODE; SI:=SI+7; 00004050 0123 + IF SC="1" THEN 00004060 0123 + COMMENT REMOVE AN ENTRY HERE; 00004070 0124 + BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR; 00004080 0124 + TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C; 00004090 0125 + DS:=7CHR; SI:=TSI; C64(2(SI:=SI+32)); SI:=SI+C; 00004100 0126 + TSI:=SI; DI:=LOC CHRSTORE; SI:=LOC C; DS:=WDS; 00004110 0129 + DI:=TDI; DS:=2LIT"0"; TDI:=DI; 00004120 0130 + END ELSE 00004130 0131 + IF SC="2" THEN 00004140 0131 + COMMENT READ OUT AN ENTRY; 00004150 0132 + BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR; 00004160 0132 + TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C; 00004170 0133 + DS:=7CHR; SI:=TSI; DI:=NEW; 00004180 0134 + C64(2(DS:=32CHR)); DS:=C CHR; 00004190 0135 + SI:=LOC C; DI:=LOC CHRSTORE; DS:=WDS; GO DONE END; 00004200 0138 + SI:=LOC NA; T64; SI:=TSI; DI:=TDI; 00004210 0139 + T(2(32(TDI:=DI; DI:=LOC C; DI:=DI+6; DS:=2CHR; 00004220 0140 + TSI:=SI; SI:=LOC C; DI:=LOC C64; DI:=DI+1; DS:=7CHR; 00004230 0143 + SI:=SI-1;DI:=TDI;DS:=2CHR;SI:=TSI;C64(2(DS:=32CHR));DS:=C CHR))); 00004240 0144 + NA( TDI:=DI; DI:=LOC C; DI:=DI+6; DS:=2CHR; TSI:=SI; 00004250 0148 + SI:=LOC C;DI:=LOC C64;DI:=DI+1;DS:=7CHR;SI:=SI-1; 00004260 0150 + DI:=TDI;DS:=2CHR;SI:=TSI;C64(2(DS:=32CHR));DS:=C CHR); 00004270 0152 + END; 00004280 0155 + SI:=LOC PAGESIZE; T64; SI:=B; DI:=A; 00004290 0156 + %CARD LIST UNSAFE 00004300 0157 + COMMENT $CARD LIST UNSAFE; 00004310 0157 + T(2(DS:=32WDS)); DS:=PAGESIZE WDS; 00004320 0157 + %CARD LIST SAFE 00004330 0160 + COMMENT $CARD LIST SAFE; 00004340 0160 + DONE: 00004350 0160 + END; 00004360 0160 + STREAM PROCEDURE SETNTH(P,K,N); VALUE K,N; 00004390 0161 + BEGIN DI:=P; SI:=LOC K; N(DI:=DI+8); DS:=WDS END; 00004400 0161 + BOOLEAN STREAM PROCEDURE LESS(A,AN,B,BN,K); VALUE K,AN,BN; 00004410 0163 + BEGIN 00004420 0163 + SI:=A; DI:=B; SI:=SI+AN; DI:=DI+BN; 00004430 0164 + IF K SC LSS DC THEN TALLY:=1; 00004440 0165 + LESS:=TALLY 00004450 0166 + END; 00004460 0166 + REAL STREAM PROCEDURE ADDD(A,B); VALUE A,B; 00004470 0167 + BEGIN SI:=LOC A; DI:=LOC B; DS:=8ADD; SI:=LOC B; 00004480 0167 + DI:=LOC ADDD; DS:=WDS 00004490 0169 + END; 00004500 0169 + INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH); 00004600 0170 + VALUE TYPEZERO,START,FINISH; INTEGER TYPEZERO,START,FINISH; 00004610 0170 + ARRAY INDEX[0,0]; 00004620 0170 + IF START GTR FINISH THEN MESSAGE(2) ELSE 00004630 0170 + BEGIN ARRAY T[0:RECSIZE+EXTRAROOM+SKIP-1],P[0:FINISH-START]; 00004640 0173 + START OF SEGMENT ********** 7 + INTEGER I,J,K,R; 00004650 0007 + R:=RECSIZE+EXTRAROOM+SKIP; 00004660 0007 + J:=START-(FINISH+1); 00004670 0009 + FOR I:=FINISH STEP -1 UNTIL TYPEZERO DO 00004680 0011 + IF K:=(I+J) LSS TYPEZERO THEN 00004690 0012 + BEGIN T[R-1]:=P[TYPEZERO-K-1]; 00004700 0013 + MOVE(T,R,INDEX[I,0]) 00004710 0017 + END ELSE 00004720 0019 + BEGIN IF I GEQ START THEN P[FINISH-I]:=INDEX[I,R-1]; 00004730 0019 + MOVE(INDEX[K,0],R,INDEX[I,0]); 00004740 0024 + END; 00004750 0028 + FREEPAGE:=TYPEZERO-J; 00004760 0030 + END; 00004770 0031 + 7 IS 35 LONG, NEXT SEG 6 + INTEGER PROCEDURE SEARCHL(A,B,N,MIN,MAX,NP); VALUE N,MIN,MAX; 00004780 0178 + INTEGER N,MIN,MAX,NP; 00004790 0178 + ARRAY A[0,0]; REAL B; 00004800 0178 + BEGIN 00004810 0178 + INTEGER I,T; 00004820 0178 + START OF SEGMENT ********** 8 + FOR I:=MIN STEP 1 WHILE T:=T+A[I,0].CF LEQ B AND I LSS MAX-1 DO; 00004830 0000 + IF T LSS B THEN 00004840 0008 + BEGIN MESSAGE(3); SEARCHL:=NP:=0; 00004850 0009 + END ELSE 00004860 0012 + BEGIN SEARCHL:=I; NP:=B-T+A[I,0].CF 00004870 0012 + END 00004880 0015 + END; 00004890 0016 + 8 IS 21 LONG, NEXT SEG 6 + PROCEDURE SORT(A,P,N,C); VALUE P,N,C; INTEGER P,N,C; 00004900 0178 + ARRAY A[0,0]; 00004910 0178 + BEGIN INTEGER R; 00004920 0178 + START OF SEGMENT ********** 9 + BEGIN 00004930 0000 + ARRAY T[0:R:=RECSIZE+EXTRAROOM+SKIP-1]; 00004940 0000 + START OF SEGMENT ********** 10 + LABEL ENDJ; 00004950 0005 + INTEGER I,J,L,K,M,SK; R:=R+1; 00004960 0005 + SK:=SKIP TIMES 8; 00004970 0006 + K:=N-P+1; I:=1; DO UNTIL (I:=I TIMES 2) GTR K; 00004980 0008 + M:=I-1; 00004990 0012 + WHILE (M:=M DIV 2) NEQ 0 DO 00005000 0014 + BEGIN K:=N-M; J:=P; 00005010 0016 + DO BEGIN 00005020 0018 + L:=(I:=J)+M; 00005030 0018 + DO BEGIN 00005040 0020 + IF A[L,0].TF GTR A[I,0].TF THEN GO ENDJ; 00005050 0020 + IF A[L,0].TF EQL A[I,0].TF THEN 00005060 0024 + IF NOT(LESS(A[L,0],SK,A[I,0],SK,C)) THEN 00005070 0028 + GO ENDJ; 00005080 0033 + MOVE(A[L,0],R,T); MOVE(A[I,0],R,A[L,0]); 00005090 0033 + MOVE(T,R,A[I,0]) 00005100 0039 + END UNTIL (I:=(L:=I)-M) LSS P; 00005110 0041 + ENDJ: 00005120 0044 + END UNTIL (J:=J+1) GTR K; 00005130 0045 + END 00005140 0047 + END 00005150 0047 + END SORT; 00005160 0047 + 10 IS 51 LONG, NEXT SEG 9 + 9 IS 6 LONG, NEXT SEG 6 + COMMENT - - - - - - - - - - - - - - - - - - - - - - - - - - 00005280 0178 + MODE MEANING 00005290 0178 + ---- ------- 00005300 0178 + 1 = INTERROGATE TYPE 00005310 0178 + 2 = INSERT RECORD REL ADDRS N 00005320 0178 + (RELATIVE TO START OF LAST PAGE) 00005330 0178 + 3 = RETURN THE NUMBER OF RECORDS (M) 00005340 0178 + 4 = " ITEM AT RECORD # N 00005350 0178 + 5 = INSERT " " " " " 00005360 0178 + 6 = DELETE " " " " " 00005370 0178 + 7 = SEARCH FOR THE RECORD -A- 00005380 0178 + 8 = FILE OVERFLOW, INCREASE BY N 00005390 0178 + 9 = FILE MAINTENANCE 00005400 0178 + 10 = EMERGENCY FILE MAINTENANCE 00005410 0178 + 11 SET STORAGE KIND 00005420 0178 + 12= ALTER STORAGE ALLOCATION RESOURCES 00005430 0178 + 13= RELEASE "TYPE" STORAGE TO SYSTEM 00005440 0178 + 14= CLOSE ALL PAGES FOR AREA TRANSITION 00005450 0178 + NOTE THAT WHEN SEQUENTIAL STORAGE MAINTENANCE IS DONE, N 00005460 0178 + WILL ALWAYS INDICATE THE ADDRESS OF THE STRING RELATIVE TO 00005470 0178 + THE TYPE SPECIFIED, AND M WILL ALWAYS BE THE LENGTH OF THE 00005480 0178 + STRING IN -A- (EITHER AS INPUT OR OUTPUT) 00005490 0178 + ; 00005500 0178 + PROCEDURE UPDATE(T,L,U,D); VALUE L,U,D; INTEGER L,U,D; 00005510 0178 + ARRAY T[0]; 00005520 0178 + BEGIN INTEGER I,J,K; 00005530 0178 + START OF SEGMENT ********** 11 + FOR I:=L STEP 1 UNTIL U DO 00005540 0000 + BEGIN J:=T[I].AF+D; T[I].AF:=J; 00005550 0001 + J:=T[I].BF+D; T[I].BF:=J 00005560 0005 + END 00005570 0008 + END; 00005580 0010 + 11 IS 16 LONG, NEXT SEG 6 + OWN INTEGER CURPAGE,NPAGES,NTYPES,P,PS,U,L; 00005590 0178 + OWN INTEGER FIRST,AVAIL,MAXBUFF,CURBUFF; 00005600 0178 + REAL GT1; 00005605 0178 + LABEL MOREPAGES; 00005610 0178 + COMMENT 00005615 0178 + IF MEMBUG.[21:1] THEN DUMPMEMORY(MODE,TYPE,N,M); 00005620 0178 + IF MODE=8 THEN NPAGES:=NPAGES+N; 00005630 0178 + MOREPAGES: 00005670 0181 + BEGIN 00005680 0182 + OWN BOOLEAN POINTERSET, TYPESET; 00005690 0182 + START OF SEGMENT ********** 12 + INTEGER I, T, NR; 00005693 0000 + OWN ARRAY BUF[0:MBUFF], TYPS[0:511]; 00005697 0000 + OWN ARRAY INDX[0:NPAGES,0:RECSIZE+EXTRAROOM+SKIP-1]; 00005700 0004 + PROCEDURE SETTYPES; 00005702 0012 + BEGIN INTEGER I, T; 00005704 0012 + START OF SEGMENT ********** 13 + FOR I := 0 STEP 1 UNTIL NPAGES DO 00005706 0000 + IF INDX[I,0].TF NEQ T THEN 00005708 0001 + BEGIN 00005710 0003 + TYPS[T].BF := I; TYPS[T:=INDX[I,0].TF].AF := I; 00005712 0003 + TYPS[T].BOOL := INDX[I,0].MF; 00005714 0010 + END; 00005716 0014 + TYPS[T].BF := I; 00005718 0017 + END SETTYPES; 00005720 0019 + 13 IS 23 LONG, NEXT SEG 12 + REAL PROCEDURE BUFFNUMBER(I); VALUE I; INTEGER I; 00005730 0012 + BEGIN INTEGER K,L,M; 00005740 0012 + START OF SEGMENT ********** 14 + LABEL D; 00005750 0000 + DEFINE B=BUF#; 00005760 0000 + IF( IF K:=INDX[I,P].BUFF=0 THEN TRUE ELSE BUF[K].PAGEF 00005770 0000 + NEQ INDX[I,P].PAGEF+1) THEN 00005780 0004 + BEGIN IF NULL(K:=CDR(AVAIL)) THEN 00005790 0007 + BEGIN K:=CDR(FIRST); 00005800 0009 + WHILE M:=CDR(B[K]) NEQ 0 DO 00005810 0011 + BEGIN L:=K; K:=M; END; 00005820 0014 + RPLACD(B[L],0); 00005830 0016 + IF BOOLEAN(B[K].CHANGEDBIT) THEN 00005840 0019 + WRITE(POINTERS[K][B[K].PAGEF-1]); 00005850 0020 + B[K].CHANGEDBIT:=0; 00005860 0027 + END ELSE RPLACD(AVAIL,CDR(B[K])); 00005870 0029 + B[K].PAGEF:=INDX[I,P].PAGEF+1; 00005880 0031 + INDX[I,P].BUFF:=K; 00005890 0036 + READ(POINTERS[K][INDX[I,P].PAGEF]); 00005900 0039 + END ELSE 00005910 0046 + IF CDR(FIRST)=K THEN GO TO D ELSE 00005920 0046 + BEGIN L:=CDR(FIRST); 00005930 0048 + WHILE M:=CDR(B[L]) NEQ K DO L:=M; 00005940 0050 + RPLACD(B[L],CDR(B[M])); 00005950 0053 + END; 00005960 0058 + RPLACD(B[K],CDR(FIRST)); RPLACD(FIRST,K); 00005970 0058 + D: BUFFNUMBER:=K 00005980 0062 + END; 00005990 0063 + 14 IS 68 LONG, NEXT SEG 12 + PROCEDURE MARK(I); VALUE I; INTEGER I; 00006000 0012 + BUF[INDX[I,P].BUFF].CHANGEDBIT:=1; 00006010 0012 + BOOLEAN PROCEDURE WRITEBUFFER; 00006020 0017 + BEGIN INTEGER I; 00006030 0017 + START OF SEGMENT ********** 15 + I:=CDR(FIRST); 00006040 0000 + WHILE NOT NULL(I) DO 00006050 0001 + IF BOOLEAN(BUF[I].CHANGEDBIT) THEN 00006060 0002 + BEGIN WRITEBUFFER:=TRUE; 00006070 0003 + BUF[I].CHANGEDBIT:=0; 00006080 0005 + WRITE(POINTERS[I][BUF[I].PAGEF-1]); 00006090 0007 + RPLACD(I,0); 00006100 0013 + END ELSE I:=CDR(BUF[I]); 00006110 0014 + END; 00006120 0017 + 15 IS 21 LONG, NEXT SEG 12 + IF NOT POINTERSET THEN 00006130 0017 + BEGIN LABEL EOF; 00006140 0018 + START OF SEGMENT ********** 16 + READ(POINTERS[1][NPAGES])[EOF]; 00006150 0000 + IF EOFMARK(SKIP,RECSIZE,POINTERS[1](0))THEN GO TO EOF; 00006160 0007 + MOVE(POINTERS[1](0),1,T); 00006170 0012 + COMMENT -- USE T TO DETERMIN THE VARIABLE REC SIZE LATER; 00006180 0016 + MOVE(POINTERS[1](0),RECSIZE+SKIP,INDX[NPAGES,0]); 00006190 0016 + INDX[NPAGES,RECSIZE+1].PAGEF:=NPAGES; 00006200 0022 + NPAGES:=NPAGES+1; 00006210 0026 + GO TO MOREPAGES; 00006220 0027 + COMMENT - - INTIALIZE VARIABLES; 00006230 0029 + EOF: POINTERSET:=TRUE; 00006240 0029 + U:=PAGESIZE-SKIP-PAGESPACE; 00006250 0030 + L:=(U-ALLOWANCE)/RECSIZE; 00006260 0032 + U:=(U+ALLOWANCE+RECSIZE/2)/RECSIZE; 00006270 0034 + PS:=(U+L)/2; 00006280 0037 + CURPAGE:=NPAGES:=NPAGES-1; 00006290 0038 + CURBUFF:=1; 00006300 0040 + P:=RECSIZE+SKIP; 00006310 0041 + FOR T:=1 STEP 1 UNTIL SBUFF DO RPLACD(BUF[T],T+1); 00006320 0042 + RPLACD(BUF[SBUFF],0); RPLACD(AVAIL,1); 00006330 0050 + MAXBUFF:=SBUFF; 00006340 0052 + T:=0; 00006350 0053 + SORT(INDX,0,NPAGES,RECSIZE TIMES 8); 00006360 0053 + FOR I:=0 STEP 1 UNTIL NPAGES DO 00006370 0056 + IF INDX[I,0].TF GTR T THEN T:=INDX[I,0].TF; 00006380 0058 + NTYPES:=T; 00006390 0065 + END; 00006400 0066 + 16 IS 70 LONG, NEXT SEG 12 + IF TYPE GTR NTYPES THEN NTYPES:=TYPE; 00006410 0020 + IF NOT TYPESET THEN 00006550 0022 + BEGIN TYPESET:=TRUE; SETTYPES; 00006560 0022 + COMMENT 00006565 0024 + IF MEMBUG THEN DUMPINDEX(TYPS,NTYPES,INDX,RECSIZE, 00006570 0024 + P); 00006580 0024 + END; 00006590 0024 + COMMENT --- DECIDE WHETHER TO SAVE CURRENT PAGE BEFORE GOING ON; 00006600 0024 + IF MODE=2 THEN 00006610 0024 + BEGIN MODE:=5; NR:=N 00006620 0025 + END ELSE 00006630 0026 + IF MODE GEQ 4 THEN %MAY BE FILE MAINTENANCE 00006640 0027 + IF MODE GEQ 8 THEN %IS FILE MAINTENANCE 00006650 0028 + ELSE %WE MAY BE GOING TO 00006660 0029 + IF MODE NEQ 7 THEN %ANOTHER PAGE 00006670 0030 + BEGIN 00006680 0031 + IF TYPE=0 THEN BEGIN MESSAGE(4); MODE:=0 END ELSE 00006690 0031 + IF TYPS[TYPE].AF=TYPS[TYPE].BF THEN 00006700 0034 + IF TYPS[0].BF GTR 0 THEN 00006710 0037 + BEGIN INTEGER J,K; REAL PG; 00006720 0039 + START OF SEGMENT ********** 17 + K:=TYPS[0].BF-1; TYPS[0].BF:=K; PG:=INDX[K,P]; 00006730 0000 + FOR I:=1 STEP 1 UNTIL TYPE-1 DO 00006740 0006 + IF (T:=TYPS[I]).AF NEQ T.BF THEN 00006750 0010 + BEGIN FOR K:=T.AF STEP 1 UNTIL T.BF -1 DO 00006760 0013 + MOVE(INDX[K,0],P+EXTRAROOM,INDX[K-1,0]); 00006770 0018 + TYPS[I].AF:=T.AF-1; TYPS[I].BF:=K:=T.BF-1 00006780 0023 + END; 00006790 0028 + IF CURPAGE GTR TYPS[0].BF THEN 00006800 0031 + IF CURPAGE LEQ K THEN CURPAGE:=CURPAGE-1; 00006810 0033 + TYPS[TYPE].BF:=K+1; TYPS[TYPE].AF:=K; 00006820 0036 + INDX[K,P]:=PG; INDX[K,0]:=0; INDX[K,0].TF:=TYPE; 00006830 0041 + IF TYPS[TYPE].BOOL=1 THEN 00006840 0048 + BEGIN SETNTH(INDX[K,0],0,1); INDX[K,0].MF:=1 00006850 0050 + END; 00006860 0054 + COMMENT 00006865 0056 + IF MEMBUG.[22:1] THEN DUMPTYPES(MODE,TYPS,NTYPES); 00006870 0056 + MEMORY(MODE,TYPE,A,N,M); MODE:=0 00006880 0056 + END ELSE 00006890 0059 + 17 IS 61 LONG, NEXT SEG 12 + BEGIN T:=1; MEMORY(8,TYPE,A,T,M); MEMORY(MODE,TYPE,A,N,M); 00006900 0041 + MODE:=0 00006910 0047 + END ELSE 00006920 0047 + IF NOT( BOOLEAN(TYPS[TYPE].BOOL) AND MODE=5) THEN 00006930 0048 + CURBUFF:=BUFFNUMBER(CURPAGE:= 00006940 0051 + SEARCHL(INDX,N,NPAGES,TYPS[TYPE].AF,TYPS[TYPE].BF, 00006950 0051 + NR) ); 00006960 0055 + COMMENT 00006965 0057 + IF MEMBUG.[23:1] THEN CHECKTYPES(TYPS,NTYPES); 00006970 0057 + END; 00006980 0057 + COMMENT 00006985 0057 + IF MEMBUG.[20:1] THEN DUMPINDEX(TYPS,NTYPES,INDX,RECSIZE,P); 00006990 0057 + COMMENT 00006995 0057 + IF MEMBUG.[24:1] THEN DUMPBUFF(BUF,FIRST,AVAIL); 00007000 0057 + CASE MODE OF 00007010 0057 + BEGIN 00007020 0057 + %------- MODE=0 ------- RESERVED --------------- 00007030 0058 + ; 00007040 0058 + %------- MODE=1 ---------------------------------------------------- 00007050 0058 + IF M=0 THEN N:=TYPS[TYPE].BOOL ELSE 00007060 0058 + IF M=1 THEN 00007070 0061 + BEGIN FOR I:=1 STEP 1 UNTIL NTYPES DO 00007080 0062 + IF (T:=TYPS[I]).AF=T.BF THEN 00007090 0064 + BEGIN N:=I; I:=NTYPES+1 00007100 0066 + END; 00007110 0068 + IF I=NTYPES+1 THEN N:=NTYPES+1 00007120 0071 + END; 00007130 0073 + %------- MODE=2 ------- RESERVED --------------- 00007140 0075 + ; 00007150 0075 + %------- MODE=3 ------- RETURN THE NUMBER OF RECORDS---- 00007160 0075 + BEGIN COMMENT IF TYPE LSS 0 THEN THE TOTAL NUMBER 00007170 0075 + OF PAGES IS GIVEN, OTHERWISE THE NUMBER OF "TYPE" PAGES IS 00007180 0075 + GIVEN; 00007190 0075 + FOR I:=0 STEP 1 UNTIL NPAGES DO 00007200 0075 + IF INDX[I,0].TF=TYPE OR TYPE LSS 0 THEN 00007210 0076 + NR:=NR+INDX[I,0].CF; 00007220 0079 + M:=NR 00007230 0084 + END; 00007240 0085 + %------- MODE=4 ------- RETURN ITEM AT SUBSCRIPT N ----- 00007250 0086 + IF NR GEQ INDX[CURPAGE,0].CF THEN MESSAGE(3) ELSE 00007252 0086 + IF BOOLEAN(TYPS[TYPE].BOOL) THEN COMMENT SEQUENTIAL STORAGE; 00007260 0089 + BEGIN ARRAY B[0:PAGESIZE]; 00007270 0091 + START OF SEGMENT ********** 18 + M:=CHRSTORE(POINTERS[CURBUFF](0),2,B,A,NR,0,0,2,0); 00007280 0002 + END ELSE 00007290 0013 + 18 IS 16 LONG, NEXT SEG 12 + BEGIN 00007300 0093 + M:=RECSIZE×8; 00007310 0093 + READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,0,RECSIZE); 00007320 0095 + END; 00007330 0101 + %------- MODE=5 ------- INSERT ITEM AT SUBSCRIPT N; 00007340 0101 + BEGIN INTEGER K,J,S; REAL PG; 00007350 0101 + START OF SEGMENT ********** 19 + IF BOOLEAN(TYPS[TYPE].BOOL) THEN 00007360 0000 + COMMENT FIND A PLACE FOR THE CHARACTER STRING OF LENGTH 00007370 0001 + M; 00007380 0001 + IF M GTR (PAGESIZE-SKIP-1)×8-2 THEN MESSAGE(5) COMMENT 00007390 0001 + THIS CHARACTER STRING IS TOO LONG ; ELSE 00007400 0005 + BEGIN ARRAY C[0:PAGESIZE]; 00007410 0005 + START OF SEGMENT ********** 20 + STREAM PROCEDURE ADDZERO(CHARS,POINTER); VALUE CHARS; 00007411 0002 + BEGIN LOCAL T; 00007412 0002 + SI:=LOC CHARS; DI:=LOC T; DI:=DI+1; DS:=7CHR; 00007413 0003 + DI:=POINTER; T(2(DI:=DI+32)); CHARS(DI:=DI+1); 00007415 0004 + DS:=2LIT"0"; 00007417 0007 + END; 00007419 0008 + BOOLEAN B,NOTLASTPAGE; 00007420 0008 + LABEL TRYITAGAIN; 00007425 0008 + TRYITAGAIN: 00007426 0008 + FOR I:=(T:=TYPS[TYPE]).AF STEP 1 WHILE I LSS T.BF AND 00007430 0009 + NOT B DO 00007440 0014 + IF NOT(B:=((PAGESIZE-SKIP-1)×8-(GT1:=INDX[I,0]).SF)GEQ M+2 00007450 0015 + AND NOT BOOLEAN(GT1.FF)) THEN S:=S+GT1.CF ELSE I:=I-1; 00007460 0020 + NOTLASTPAGE:=B AND I NEQ T.BF-1; 00007465 0027 + COMMENT IF B IS TRUE, THEN A PAGE HAS BEEN FOUND; 00007470 0030 + IF NOT B THEN COMMENT GET A PAGE THAT IS FREE; 00007480 0030 + BEGIN 00007490 0030 + COMMENT 00007495 0031 + IF MEMBUG.[5:1] THEN DUMPTYPES(5.1,TYPS,NTYPES); 00007500 0031 + IF TYPS[0].BF=0 THEN BEGIN K:=CURPAGE; T:=1; 00007510 0031 + MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1 00007520 0034 + END 00007524 0037 + ELSE 00007526 0038 + IF (PAGESIZE-SKIP-1)×8-INDX[(I:=I-1)-1,0].SF GTR 2 THEN 00007528 0038 + BEGIN 00007529 0044 + CURBUFF:=BUFFNUMBER(CURPAGE:=I-1); 00007530 0045 + ADDZERO((GT1:=INDX[CURPAGE,0].SF)+8×(SKIP+1),POINTERS 00007531 0047 + [CURBUFF](0)); 00007532 0051 + INDX[CURPAGE,0].SF:=GT1+2; 00007533 0055 + INDX[CURPAGE,0].CF:=INDX[CURPAGE,0].CF+1; 00007534 0058 + COMMENT SINCE ALLOCATING A NEW PAGE, SET COUNT TO 00007535 0064 + ONE MORE AND FREEZE THE COUNT; 00007536 0064 + S:=S+1; % SINCE THE COUNT INCREASED 00007538 0064 + MOVE(INDX[CURPAGE,0],SKIP+1,POINTERS[CURBUFF](0)); 00007540 0065 + MARK(CURPAGE); 00007542 0071 + END; 00007544 0071 + T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1; 00007546 0071 + COMMENT T IS THE SUBSCRIPT INTO THE NEW PAGE; 00007550 0076 + PG:=INDX[T,P]; COMMENT PG HOLDS THE NEW PAGE #; 00007560 0076 + FOR K:=T+1 STEP 1 UNTIL I DO 00007570 0078 + MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]); 00007580 0082 + T:=TYPS[TYPE].AF; TYPS[TYPE].AF:=T-1; 00007590 0088 + INDX[I,P]:=PG; UPDATE(TYPS,1,TYPE-1,-1); 00007600 0092 + IF CURPAGE GTR TYPS[0].BF THEN IF CURPAGE LEQ 00007610 0097 + I THEN CURPAGE:=CURPAGE-1; 00007620 0099 + INDX[I,0]:=0; INDX[I,0].MF:=1; INDX[I,0].TF:=TYPE; 00007630 0101 + COMMENT MUST ALSO ASSIGN A NUMBER TO THIS PAGE 00007640 0110 + (TO BE STORED IN THE PAGE) TO KEEP IT IN SEQUENCE 00007650 0110 + WITHIN THIS TYPE; 00007660 0110 + IF (T:=TYPS[TYPE]).AF LSS T.BF-1 THEN 00007670 0110 + T:=INDX[T.BF-1,1] ELSE T:=0; 00007680 0113 + SETNTH(INDX[I,0],ADDD(1,T),1); 00007690 0117 + COMMENT END OF THE INITIALIZATION OF THE INDEX ARRAY, 00007700 0121 + WE STILL HAVE TO MAKE SOME ENTRIES INTO THE PAGE 00007710 0121 + WHICH WE WILL DO BELOW; 00007720 0121 + END OF TEST FOR NEW PAGE; 00007730 0121 + COMMENT I IS SET TO THE PROPER SUBSCRIPT FOR THE CHR STORE; 00007740 0121 + CURBUFF:=BUFFNUMBER(CURPAGE:=I); 00007750 0121 + COMMENT NOW THE CORRECT PAGE IS IN CORE. 00007760 0123 + ------------------------------ 00007770 0123 + M= NUMBER OF CHARACTERS IN A (ON INPUT) 00007780 0123 + N= ADDRESS OF A WITHIN THIS TYPE (ON OUTPUT 00007790 0123 + ------------------------------; 00007800 0123 + K:=INDX[I,0]; 00007810 0123 + T:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,C,A,K.CF,M,0,0, 00007820 0124 + PAGESIZE); 00007830 0135 + COMMENT K.CF IS THE NUMBER OF ITEMS ALREADY IN THIS 00007840 0136 + PAGE. IF THERE IS A SEGMENT WHICH IS NULL, IT WILL 00007850 0136 + BE FOUND AND ASSIGNED AS THE SEG NUMBER FOR 00007860 0136 + THIS CHARACTER STRING (T). IF NOT, IT WILL STICK THE 00007870 0136 + STRING ON THE END (WE KNOW THERE IS ENOUGH ROOM 00007880 0136 + SINCE WE CHECKED INDX[I,0].SF -- THE NUMBER OF CHRS USED 00007890 0136 + IN THIS PAGE, OR WE CREATED A NEW PAGE); 00007900 0136 + N:=S+T; S:=K.SF; COMMENT S CONTAINS THE # OF CHRS USED UP; 00007910 0136 + IF T:=T+1 GTR K.CF THEN COMMENT ADDED THE STRING ON THE END; 00007920 0138 + IF NOTLASTPAGE THEN % PAGE ALREADY FULL 00007922 0141 + BEGIN S:=0; B:=FALSE; INDX[I,0].FF:=1; 00007925 0141 + MOVE(INDX[I,0],SKIP+1,POINTERS[CURBUFF](0)); 00007926 0147 + MARK(CURPAGE); GO TRYITAGAIN; END ELSE 00007927 0152 + BEGIN K.CF:=T; S:=S+2; 00007930 0154 + END 00007940 0157 + ELSE IF T=K.CF AND NOTLASTPAGE THEN INDX[I,0].FF:=1; 00007945 0157 + 00007947 0163 + INDX[I,0].CF:=K.CF; INDX[I,0].SF:=S+M; 00007950 0163 + MOVE(INDX[I,0],SKIP+1,POINTERS[CURBUFF](0)); 00007960 0171 + MARK(CURPAGE); 00007970 0176 + COMMENT THE PAGE DESCRIPTOR HAS BEEN UPDATED; 00007980 0177 + COMMENT 00007985 0177 + IF MEMBUG.[5:1] THEN DUMPTYPES(5.2,TYPS,NTYPES); 00007990 0177 + END ELSE COMMENT KIND OF STORAGE IS SORTED; 00008000 0177 + 20 IS 181 LONG, NEXT SEG 19 + IF NR GTR (T:=INDX[CURPAGE,0].CF) THEN 00008010 0007 + COMMENT SUBSCRIPT IS NOT IN THE MIDDLE OF THE PAGE; 00008020 0010 + MESSAGE(6) ELSE 00008030 0010 + BEGIN 00008040 0011 + IF T GEQ U THEN COMMENT WILL EXCEED UPPER PAGE BOUND; 00008050 0012 + BEGIN ARRAY B[0:RECSIZE TIMES 00008060 0012 + START OF SEGMENT ********** 21 + (T-PS+(I:=(IF NR GEQ PS THEN 0 ELSE 1)))-1]; 00008070 0001 + COMMENT B IS JUST BIG ENOUGH TO CARRY THE 00008080 0008 + EXCESS FROM THE OLD PAGE; 00008090 0008 + READRECS(POINTERS[CURBUFF](0),B,SKIP,PS-I, 00008100 0008 + J:=(T-PS+I),0,RECSIZE); 00008110 0013 + COMMENT -- B NOW HAS THE EXCESS; 00008120 0016 + INDX[CURPAGE,0].CF:=T-J; SETNTH(POINTERS[CURBUFF](0), 00008130 0016 + INDX[CURPAGE,0],0); 00008140 0023 + MARK(CURPAGE); 00008150 0025 + IF TYPS[0].BF=0 THEN 00008160 0026 + BEGIN K:=CURPAGE; T:=1; 00008170 0027 + MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1; 00008180 0029 + END; 00008190 0033 + COMMENT -- ASSIGN A FREE PAGE (SUBS T); 00008200 0033 + T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1; 00008210 0033 + 00008220 0038 + PG:=INDX[T,P]; 00008230 0038 + FOR K:=T+1 STEP 1 UNTIL CURPAGE DO 00008240 0040 + MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]); 00008250 0044 + INDX[CURPAGE,P]:=PG; 00008260 0049 + T:=0;T.CF:=J;T.TF:=TYPE; 00008262 0051 + CURBUFF:=BUFFNUMBER(CURPAGE); 00008270 0055 + WRITERECS(POINTERS[CURBUFF](0),B,SKIP,0,J,0,RECSIZE); 00008280 0057 + SETNTH(POINTERS[CURBUFF](0),T,0); 00008290 0063 + MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[CURPAGE,0]); 00008300 0067 + MARK(CURPAGE); 00008310 0073 + T:=TYPS[TYPE].AF; TYPS[TYPE].AF:=T-1; 00008320 0074 + UPDATE(TYPS,1,TYPE-1,-1); 00008330 0078 + IF J=0 THEN MESSAGE(7); 00008340 0081 + IF BOOLEAN (I) THEN 00008350 0083 + COMMENT I=0 IMPLIES THE RECORD GOES TO NEW PAGE, 00008360 0083 + I=1 IMPLIES THE RECORD GOES TO NOOLD PAGE; 00008370 0083 + BEGIN 00008380 0083 + T:=INDX[CURPAGE:=CURPAGE-1,0].CF; 00008390 0084 + CURBUFF:=BUFFNUMBER(CURPAGE); 00008400 0087 + ; COMMENT OLD PAGE IS NOW BACK; 00008410 0088 + END ELSE 00008420 0088 + BEGIN T:=J; NR:=NR-PS 00008430 0088 + END 00008440 0090 + END; 00008450 0091 + 21 IS 95 LONG, NEXT SEG 19 + WRITERECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,T-NR,RECSIZE); 00008460 0014 + T:=INDX[CURPAGE,0].CF; INDX[CURPAGE,0].CF:=T+1; 00008470 0021 + SETNTH(POINTERS[CURBUFF](0),INDX[CURPAGE,0],0); 00008480 0027 + IF NR=0 THEN MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX 00008490 0032 + [CURPAGE,0]); MARK(CURPAGE); 00008500 0037 + END; 00008510 0040 + END; 00008520 0040 + 19 IS 41 LONG, NEXT SEG 12 + %------- MODE=6 ------- DELETE A RECORD FROM THE FILE ---- 00008530 0103 + IF (T:=TYPS[TYPE]).AF=T.BF THEN MESSAGE(12) COMMENT 00008540 0103 + ATTEMPT TO DELETE NON-EXISTENT STORAGE; 00008550 0107 + ELSE 00008560 0107 + IF NR GEQ(I:=INDX[CURPAGE,0].CF) THEN MESSAGE(13) COMMENT 00008570 0107 + ATTEMPT TO DELETE OUTSIDE STORAGE RANGE; ELSE 00008580 0111 + IF BOOLEAN(T.BOOL) THEN COMMENT SEQUENTIAL STORAGE; 00008590 0111 + BEGIN COMMENT NR IS THE RECORD TO DELETE; 00008600 0113 + ARRAY B[0:PAGESIZE-1]; 00008610 0113 + START OF SEGMENT ********** 22 + COMMENT PAGESIZE -1 SHOULD BE COMPUTED TO THE EXACT 00008620 0004 + NUMBER OF WORDS TO MOVE -- IT WOULD SPEED THINGS UP; 00008630 0004 + INTEGER L; 00008640 0004 + T:=INDX[CURPAGE,0]; COMMENT T.CF IS THE NUMBER OF 00008650 0004 + RECORDS ON THIS PAGE, T.SF IS THE NUMBER OF CHRS; 00008660 0005 + L:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,B,A,NR,0,T.CF 00008670 0005 + -NR-1,1,PAGESIZE); 00008680 0015 + COMMENT WE WILL BRING BACK THE NUMBER OF CHRS IN M; 00008690 0018 + M:=L; 00008700 0018 + MARK(CURPAGE); 00008710 0019 + COMMENT MAKE CHANGES TO THE CHARACTER COUNT; 00008720 0019 + INDX[CURPAGE,0].SF:=T.SF-L; 00008730 0019 + INDX[CURPAGE,0].FF:=0; % PAGE IS CERTAINLY NOT FULL NOW 00008737 0024 + COMMENT AND WE ARE DONE WITH THE DELETION; 00008740 0027 + MOVE(INDX[CURPAGE,0],SKIP+1,POINTERS[CURBUFF](0)); 00008745 0027 + END 00008750 0033 + ELSE 00008760 0033 + 22 IS 36 LONG, NEXT SEG 12 + BEGIN ARRAY A[0:RECSIZE-1]; 00008770 0114 + START OF SEGMENT ********** 23 + INDX[CURPAGE,0].CF:=I-1; 00008780 0004 + SETNTH(POINTERS[CURBUFF](0),INDX[CURPAGE,0],0); 00008790 0007 + IF I GTR 1 THEN 00008800 0013 + BEGIN 00008810 0013 + READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,I-NR-1,RECSIZE); 00008820 0014 + MARK(CURPAGE); 00008830 0021 + IF NR=0 THEN 00008840 0022 + MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[CURPAGE,0]) 00008850 0023 + END ELSE COMMENT FREE THE EMPTY PAGE; 00008860 0028 + BEGIN MARK(CURPAGE); 00008870 0029 + ;TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,CURPAGE,CURPAGE); 00008880 0030 + UPDATE(TYPS,1,TYPE-1,1); TYPS[TYPE].AF:=T.AF+1; 00008890 0035 + COMMENT 00008895 0041 + IF MEMBUG.[6:1] THEN DUMPTYPES(MODE,TYPS,NTYPES); 00008900 0041 + END 00008910 0041 + END; 00008920 0041 + 23 IS 45 LONG, NEXT SEG 12 + %------- MODE=7 ------- SEARCH FOR A RECORD FROM THE FILE --- 00008930 0115 + IF N GTR 3 THEN MESSAGE(14) ELSE 00008940 0115 + COMMENT RETURN RECORD CLOSEST (BUT LESS THAN OR EQUAL TO) TO 00008950 0117 + THE CONTENTS OF -A-. A WILL BE REPLACED BY THE RECORD FOUND; 00008960 0117 + IF BOOLEAN((I:=TYPS[TYPE]).BOOL) THEN 00008970 0117 + MESSAGE(8) COMMENT BINARY SEARCH OF NON-SEQUENTIAL DATA; 00008980 0119 + ELSE 00008990 0120 + IF I.AF=I.BF THEN MESSAGE(9) COMMENT --NO STORAGE OF 00009000 0120 + THIS TYPE ALLOCATED AS YET; 00009010 0124 + ELSE BEGIN 00009020 0124 + INTEGER F,U,L; 00009030 0124 + START OF SEGMENT ********** 24 + ARRAY B[0:RECSIZE-1]; 00009040 0000 + U:=TYPS[TYPE].BF; L:=TYPS[TYPE].AF; 00009050 0004 + WHILE U-L GTR 1 DO 00009060 0007 + IF LESS(A,0,INDX[F:=(U+L) DIV 2,0],8,M) THEN U:=F ELSE L:=F; 00009070 0008 + CURBUFF:=BUFFNUMBER(CURPAGE:=L); 00009080 0016 + L:=0; U:=INDX[CURPAGE,0].CF; 00009090 0018 + IF L-U=0 THEN MESSAGE(10) COMMENT BINARY SEARCH FOUND 00009100 0021 + A PAGE WITH NO RECORDS; 00009110 0023 + ELSE BEGIN 00009120 0023 + WHILE U-L GTR 1 DO 00009130 0024 + BEGIN READRECS(POINTERS[CURBUFF](0),B,SKIP, 00009140 0026 + F:=(U+L) DIV 2,1,0,RECSIZE); 00009150 0031 + IF LESS(A,0,B,0,M) THEN U:=F ELSE L:=F 00009160 0034 + END; 00009170 0038 + COMMENT ----------------------------------- 00009180 0039 + ON INPUT: 00009190 0039 + N=0 IMPLIES DO NOT PLACE RECORD INTO FILE 00009200 0039 + IF RECORD IS FOUND. RETURN RELA- 00009210 0039 + TIVE POSITION OF THE CLOSEST RECORD 00009220 0039 + IN THIS PAGE. 00009230 0039 + N=1 " DO NOT PLACE IN FILE. RETURN ABSO- 00009240 0039 + LUTE SUBSCRIPT OF CLOSSEST RECORD. 00009250 0039 + N=2 " PLACE RECORD INTO FILE IF NOT FOUND. 00009260 0039 + RETURN RELATIVE POSITION OF RECORD. 00009270 0039 + N=3 " PLACE RECORD INTO FILE, IF NOT 00009280 0039 + FOUND, RETURN ABS SUBSCRIPT OF 00009290 0039 + THE RECORD. 00009300 0039 + ON OUTPUT: 00009310 0039 + M=0 " RECORD FOUND WAS EQUAL TO RECORD 00009320 0039 + SOUGHT. 00009330 0039 + M=1 " RECORD FOUND WAS GREATER THAN THE 00009340 0039 + SOUGHT. 00009350 0039 + M=2 " RECORD FOUND WAS LESS THAN THE 00009360 0039 + RECORD SOUGHT. 00009370 0039 + ; 00009380 0039 + READRECS(POINTERS[CURBUFF](0),B,SKIP,L,1,0,RECSIZE); 00009390 0039 + IF LESS(A,0,B,0,M) THEN M:=1 ELSE 00009400 0046 + IF LESS(B,0,A,0,M) THEN M:=2 ELSE 00009410 0050 + M:=0; 00009420 0055 + T:=0; IF BOOLEAN(N) THEN 00009430 0056 + FOR I:=TYPS[TYPE].AF STEP 1 UNTIL CURPAGE-1 DO 00009440 0057 + T:=T+INDX[I,0].CF; 00009450 0063 + IF N GTR 1 THEN IF M GEQ 1 THEN 00009460 0066 + MEMORY(2,TYPE,A,L+M-1,NR); 00009470 0068 + MOVE(B,RECSIZE,A); 00009480 0074 + N:=T+L; 00009490 0076 + END 00009500 0078 + END; 00009510 0078 + 24 IS 81 LONG, NEXT SEG 12 + %------- MODE=8 ------- FILE OVERFLOW, FIX ARRAYS AND PAGES 00009520 0126 + BEGIN BOOLEAN TOG; 00009530 0126 + START OF SEGMENT ********** 25 + ARRAY A[0:PAGESIZE-1]; T:=NPAGES-N+1; 00009540 0000 + IF TOG:=(T DIV AREASIZE) LSS (NPAGES DIV AREASIZE ) OR 00009550 0005 + (T=NPAGES AND T MOD AREASIZE =0) THEN 00009560 0007 + MEMORY(14,TYPE,A,N,M); 00009570 0010 + FOR I:=T STEP 1 UNTIL NPAGES DO 00009580 0013 + BEGIN WRITE(NEWDISK[I],PAGESIZE,A[*]);INDX[I,P].PAGEF:=I END; 00009590 0015 + MARKEOF(SKIP,RECSIZE,NEWDISK(0)); 00009600 0025 + WRITE(NEWDISK[I]); 00009610 0029 + TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,T,NPAGES); 00009620 0034 + UPDATE(TYPS,1,NTYPES,NPAGES-T+1); 00009630 0039 + IF TOG THEN CLOSE(NEWDISK); 00009640 0042 + END; 00009650 0045 + 25 IS 48 LONG, NEXT SEG 12 + %------- MODE=9 ------- FILE MAINTENANCE ------------------ 00009660 0127 + BEGIN BOOLEAN ITHPAGEIN; 00009670 0127 + START OF SEGMENT ********** 26 + INTEGER I,J,K,T1,T2,T3,M,W,Q; 00009680 0000 + ARRAY A,B[0:PAGESIZE-1]; 00009690 0000 + COMMENT 00009700 0005 + MONITOR PRINT(Q,W,N, I,J,K,T1,T2,T3,M,A,B); 00009710 0005 + IF I:=TYPS[0].BF LEQ NPAGES THEN 00009720 0005 + DO 00009730 0007 + BEGIN COMMENT OUTER "DO-LOOP" TO FIND TROUBLE WITH 00009740 0007 + THE FILE; 00009750 0007 + IF T1:=(Q:=INDX[I,0]).CF LSS L THEN COMMENT MAY BE CORRECTABLE; 00009760 0007 + IF NOT BOOLEAN((Q:=TYPS[Q.TF]).BOOL) THEN 00009770 0010 + COMMENT -- THIS PAGE IS CORRECTABLE; 00009780 0013 + IF I NEQ NPAGES THEN 00009790 0013 + COMMENT -- THIS IS NOT THE LAST PAGE OF THE FILE; 00009800 0014 + IF (J:=I+1) LSS Q.BF THEN 00009810 0014 + COMMENT -- THIS IS NOT THE LAST PAGE OF THIS TYPE; 00009820 0017 + BEGIN COMMENT -- FIND RECORDS TO MOVE INTO 00009830 0017 + THIS PAGE; 00009840 0018 + DO IF T2:=INDX[J,0].CF GTR 0 THEN 00009850 0018 + COMMENT THIS PAGE HAS RECS TO MOVE; 00009860 0020 + BEGIN COMMENT HOW MANY; 00009870 0020 + IF T2 LSS K:=PS-T1 THEN K:=T2; 00009880 0021 + IF NOT ITHPAGEIN THEN 00009890 0024 + BEGIN COMMENT BRING IN PAGE I; 00009900 0024 + MOVE(POINTERS[BUFFNUMBER(I)](0), 00009910 0025 + PAGESIZE,B); ITHPAGEIN:=TRUE 00009920 0029 + END; 00009930 0030 + COMMENT -- BRING IN PAGE J; 00009940 0031 + CURBUFF:=BUFFNUMBER(CURPAGE:=J); 00009950 0031 + COMMENT -- MOVE SOME INTO A; 00009960 0032 + READRECS(POINTERS[CURBUFF](0),A,SKIP,0,K, 00009970 0032 + T2:=T2-K,RECSIZE); INDX[J,0].CF:=T2; 00009980 0038 + IF T2=0 THEN 00009990 0043 + COMMENT SET THIS PAGE FREE; 00010000 0044 + INDX[J,0]:=0; 00010010 0044 + SETNTH(POINTERS[CURBUFF](0),INDX[J,0],0); 00010020 0046 + MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[J 00010030 0051 + ,0]); MARK(CURPAGE); 00010040 0056 + COMMENT -- PUT THE RECORDS INTO PAGE I; 00010050 0058 + WRITERECS(B,A,SKIP,T1,K,0,RECSIZE); 00010060 0058 + END 00010070 0062 + ELSE K:=0 COMMENT SINCE NO CONTRI- 00010080 0062 + BUTION; 00010090 0062 + UNTIL T1:=T1+K GEQ PS OR J:=J+1 GEQ Q.BF; 00010100 0062 + INDX[I,0].CF:=T1; B[0]:=INDX[I,0]; 00010110 0068 + COMMENT -- PUT THE PAGE BACK OUT ON DISK; 00010120 0073 + MOVE(B,RECSIZE+SKIP,INDX[I,0]); 00010130 0073 + MOVE(B,PAGESIZE,POINTERS[CURBUFF:=BUFFNUMBER 00010140 0076 + (I)](0)); SORT(INDX,0,NPAGES,RECSIZE×8); 00010150 0078 + MARK(CURPAGE:=I); SETTYPES; 00010160 0084 + N:=1; 00010170 0086 + END 00010180 0087 + ELSE N:=0 COMMENT LAST PAGE OF THIS TYPE; 00010190 0087 + ELSE N:=0 COMMENT LAST PAGE OF FILE; 00010200 0088 + ELSE N:=0 COMMENT PAGE CANNOT BE CHANGED; 00010210 0090 + ELSE N:=0 COMMENT THIS PAGE IS NOT TOO SMALL; 00010220 0091 + END UNTIL I:=I+1 GTR NPAGES OR N NEQ 0 ELSE N:=0; 00010230 0093 + IF I GTR NPAGES THEN N:=REAL(WRITEBUFFER); 00010240 0098 + END OF FILE UPDATE; 00010250 0100 + 26 IS 104 LONG, NEXT SEG 12 + %------- MODE=10 ------ EMERGENCY FILE MAINTENANCE -------- 00010260 0128 + DO MEMORY(9,TYPE,A,N,M) UNTIL N NEQ 1 00010270 0128 + %------- MODE=11 ------- SET THE KIND OF STORAGE FOR TYPE ---------- 00010280 0131 + ;COMMENT TYPE "TYPE" STORAGE IS BEING SET TO SEQUENTIAL; 00010290 0131 + IF TYPE=0 THEN MESSAGE(4) ELSE 00010300 0133 + IF (T:=TYPS[TYPE]).AF= T.BF THEN TYPS[TYPE].BOOL:=1 ELSE 00010310 0135 + MESSAGE(15); COMMENT ATTEMPT TO CHANGE KINDS IN MIDSTREAM; 00010320 0141 + %------- MODE=12 ----------- ALTER STORAGE ALLOCATION RESOURCES--- 00010330 0142 + COMMENT N IS THE "FACTOR" (PERCENT OF RESOURCES × 100), 00010340 0142 + AND M IS THE STORAGE "LEVEL" (0 IS THE ONLY ONE THAT 00010350 0142 + DOES ANYTHING ON THE B5500); 00010360 0142 + BEGIN INTEGER J,K; 00010370 0142 + START OF SEGMENT ********** 27 + BOOLEAN TOG; 00010380 0000 + IF T:=N×(MBUFF-1)/100+1 GTR MAXBUFF THEN 00010390 0000 + BEGIN COMMENT ADD TO AVAILABLE LIST; 00010400 0003 + FOR I:=CDR(FIRST),CDR(AVAIL) DO 00010410 0003 + WHILE NOT NULL(I) DO 00010420 0009 + BEGIN BUF[I].FLAGB:=1; I:=CDR(BUF[I]); 00010430 0010 + END; 00010440 0014 + FOR I:=MAXBUFF+1 STEP 1 UNTIL T DO 00010450 0015 + BEGIN WHILE BUF[K:=K+1].FLAGB=1 DO; 00010460 0020 + BUF[K]:=0; RPLACD(BUF[K],CDR(AVAIL)); 00010470 0023 + RPLACD(AVAIL,K) 00010480 0028 + END; 00010490 0029 + MAXBUFF:=T; 00010500 0030 + FOR I:=1 STEP 1 UNTIL MBUFF DO BUF[I].FLAGB:=0; 00010510 0031 + END ELSE 00010520 0036 + IF T LSS MAXBUFF THEN 00010530 0036 + BEGIN COMMENT CUT DOWN ON THE NUMBER OF BUFFERS; 00010540 0038 + I:=CDR(FIRST); 00010550 0038 + FOR J:=1 STEP 1 UNTIL MAXBUFF DO 00010560 0039 + IF TOG THEN 00010570 0041 + IF NOT NULL(I) THEN 00010580 0041 + IF J GEQ T THEN 00010590 0042 + BEGIN K:=CDR(BUF[I]); BUF[I]:=0 00010600 0044 + ; I:=K END 00010610 0046 + ELSE I:=CDR(BUF[I]) 00010620 0048 + ELSE 00010630 0049 + ELSE 00010640 0050 + IF TOG:=NULL(I) THEN 00010650 0050 + BEGIN J:=J-1; I:=CDR(AVAIL) 00010660 0052 + END 00010670 0054 + ELSE 00010680 0055 + IF J EQL T THEN 00010690 0055 + BEGIN K:=CDR(BUF[I]); RPLACD(BUF[I],0); 00010700 0056 + I:=K END ELSE 00010710 0062 + IF J GTR T THEN 00010720 0063 + BEGIN 00010730 0064 + IF BOOLEAN(BUF[I].CHANGEDBIT) THEN 00010740 0064 + WRITE(POINTERS[I][BUF[I].PAGEF-1]); 00010750 0065 + K:=CDR(BUF[I]); 00010760 0072 + CLOSE(POINTERS[I]); 00010770 0074 + BUF[I]:=0; I:=K 00010780 0076 + END ELSE I:=CDR(BUF[I]) 00010790 0078 + ; 00010800 0079 + MAXBUFF:=T 00010810 0083 + END; 00010820 0083 + END; 00010830 0083 + 27 IS 85 LONG, NEXT SEG 12 + %------- MODE=13 ------- RELEASE "TYPE" STORAGE TO SYSTEM ---------- 00010840 0144 + IF (T:=TYPS[TYPE]).BF GTR T.AF THEN 00010850 0144 + BEGIN INTEGER J; 00010860 0147 + START OF SEGMENT ********** 28 + J:=T.BF-1; 00010870 0000 + FOR I:=T.AF STEP 1 UNTIL J DO 00010880 0001 + BEGIN CURBUFF:=BUFFNUMBER(I); 00010890 0006 + SETNTH(POINTERS[CURBUFF](0),0,0); MARK(CURPAGE:=I); 00010900 0007 + END; 00010910 0012 + TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,T.AF,J); 00010920 0013 + UPDATE(TYPS,1,TYPE-1,J-T.AF+1); 00010930 0019 + TYPS[TYPE].BF:=T.AF; TYPS[TYPE].BOOL:=0; 00010940 0023 + END; 00010990 0028 + 28 IS 29 LONG, NEXT SEG 12 + %------- MODE=14 ------ RELEASE ALL PAGES FOR TRANSITION ----------- 00011000 0148 + BEGIN INTEGER K; 00011010 0148 + START OF SEGMENT ********** 29 + I:=CDR(FIRST); 00011020 0000 + WHILE NOT NULL(I) DO 00011030 0001 + BEGIN IF BOOLEAN(BUF[I].CHANGEDBIT ) THEN WRITE(POINTERS[I] 00011040 0002 + [BUF[I].PAGEF-1]); CLOSE(POINTERS[I]); 00011050 0005 + K:=CDR(BUF[I]); BUF[I]:=0; 00011060 0013 + RPLACD(BUF[I],CDR(AVAIL)); RPLACD(AVAIL,I); I:=K 00011070 0016 + END ; CURPAGE:=CURBUFF:=-1; RPLACD(FIRST,0); 00011080 0020 + END; 00011090 0024 + 29 IS 25 LONG, NEXT SEG 12 + END OF CASE STMT; 00011100 0149 + START OF SEGMENT ********** 30 + 30 IS 15 LONG, NEXT SEG 12 + 00011110 0149 + END OF INNER BLOCK; 00011120 0149 + 12 IS 153 LONG, NEXT SEG 6 + END OF PROCEDURE; 00011130 0183 + 6 IS 192 LONG, NEXT SEG 2 + INTEGER QM,QN; 00011330 0132 + ARRAY QA[0:0]; 00011340 0132 + PROCEDURE NAME(MFID,FID); VALUE MFID,FID; REAL MFID,FID; 00011350 0134 + BEGIN INTEGER I; FILL NEWDISK WITH MFID,FID; 00011360 0134 + START OF SEGMENT ********** 31 + FOR I:=0 STEP 1 UNTIL MBUFF DO 00011370 0003 + FILL POINTERS[I] WITH MFID,FID; 00011380 0005 + FILL ESTABLISH WITH MFID,FID; 00011390 0011 + SETPOINTERNAMES 00011400 0015 + END; 00011410 0015 + 31 IS 18 LONG, NEXT SEG 2 + PROCEDURE SEQUENTIAL(UNIT); VALUE UNIT; INTEGER UNIT; 00011420 0134 + MEMORY(11,UNIT,QA,QN,QM); 00011430 0134 + INTEGER PROCEDURE CONTENTS(UNIT,N,AR); VALUE UNIT,N; 00011440 0138 + INTEGER UNIT,N; ARRAY AR[0]; 00011450 0138 + BEGIN 00011460 0138 + MEMORY(4,UNIT,AR,N,QM); CONTENTS:=QM; 00011510 0138 + END; 00011560 0142 + PROCEDURE DELETE1(UNIT,N); VALUE UNIT,N; INTEGER UNIT,N; 00011570 0145 + MEMORY(6,UNIT,QA,N,QM); 00011630 0145 + INTEGER PROCEDURE SEARCHORD(UNIT,REC,LOC,M); VALUE UNIT,M; 00011650 0147 + INTEGER UNIT,LOC,M; ARRAY REC[0]; 00011660 0147 + BEGIN LOC:=1; 00011670 0147 + MEMORY(7,UNIT,REC,LOC,M); 00011730 0149 + SEARCHORD:=M; 00011800 0151 + END; 00011810 0152 + PROCEDURE STOREORD(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT,N; 00011820 0155 + ARRAY REC[0]; 00011830 0155 + MEMORY(5,UNIT,REC,N,QM); 00011900 0155 + PROCEDURE STOREORDR(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT,N; 00011920 0157 + ARRAY REC[0]; 00011930 0157 + MEMORY(2,UNIT,REC,N,QM); 00011940 0157 + BOOLEAN PROCEDURE MAINTENANCE; 00011950 0160 + BEGIN MEMORY(9,0,QA,QN,QM); MAINTENANCE:=QN=1 00011960 0160 + END; 00011970 0163 + PROCEDURE WRAPUP; MEMORY(10,0,QA,QN,QM); 00011980 0167 + INTEGER PROCEDURE STORESEQ(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT, N; 00011990 0169 + ARRAY REC[0]; 00012000 0169 + BEGIN 00012010 0169 + MEMORY(5,UNIT,REC,QN,N); STORESEQ:=QN; 00012070 0169 + END; 00012100 0173 + PROCEDURE DELETEN(UNIT,N,M); VALUE UNIT,N,M; INTEGER UNIT,N,M; 00012110 0176 + BEGIN M:=M-N; 00012120 0176 + DO MEMORY(6,UNIT,QA,N,QM) UNTIL M:=M-1 LSS 0; 00012130 0177 + END; 00012140 0181 + INTEGER PROCEDURE NEXTUNIT; 00012420 0182 + BEGIN MEMORY(1,0,QA,QN,1); NEXTUNIT:=QN 00012430 0182 + END; 00012440 0184 + INTEGER PROCEDURE SIZE(UNIT); VALUE UNIT; INTEGER UNIT; 00012450 0188 + BEGIN MEMORY(3,UNIT,QA,QN,QM); SIZE:=QM 00012460 0188 + END; 00012470 0190 + PROCEDURE ALLOCATE(J,FACTOR); VALUE J,FACTOR; INTEGER J; 00012570 0194 + REAL FACTOR; 00012580 0194 + BEGIN 00012590 0194 + QN:=ENTIER( ABS( (FACTOR × 100) MOD 101)); 00012600 0194 + MEMORY(12,0,QA,QN,J) 00012610 0197 + END; 00012620 0198 + PROCEDURE RELEASEUNIT(UNIT); VALUE UNIT; INTEGER UNIT; 00012630 0201 + MEMORY(13,UNIT,QA,QN,QM); 00012640 0201 + DEFINE 00013000 0203 + ALLOWQUESIZE=4#, 00013010 0203 + ACOUNT=ACCUM[0].[1:11]#, 00013020 0203 + DATADESC=[1:1]#, 00013022 0203 + SCALAR=[4:1]#, 00013030 0203 + NAMED=[3:1]#, 00013040 0203 + CHRMODE=[5:1]#, 00013042 0203 + CHECKT=5#, % NUMBER OF TIMES THRU EXECUTE BEFORE CHECK 00013050 0203 + CCIF=18:36:12#, 00013060 0203 + CDID=1:43:5#, 00013070 0203 + CSPF=30:30:18#, 00013080 0203 + CRF=24:42:6#, 00013090 0203 + CLOCF=6:30:18#, 00013092 0203 + PF=[1:17]#, 00013100 0203 + XEQMODE=1#, 00013110 0203 + FUNCMODE=2#, 00013112 0203 + CALCMODE=0#, 00013114 0203 + INPUTMODE=3#, 00013116 0203 + ERRORMODE=4#, 00013118 0203 + FUNCTION=1#, 00013120 0203 + CURRENTMODE = PSRM[0]#, 00013130 0203 + VARIABLES = PSRM[1]#, 00013140 0203 + VARSIZE = PSRM[2]#, 00013150 0203 + FUNCPOINTER = PSRM[3]#, 00013160 0203 + FUNCSEQ = PSRM[4]#, 00013170 0203 + CURLINE = PSRM[5]#, 00013180 0203 + STACKBASE = PSRM[6]#, 00013182 0203 + INCREMENT=STACKBASE#, %FUNCMODE/CALCMODE 00013183 0203 + SYMBASE = PSRM[7]#, 00013184 0203 + FUNCSIZE=SYMBASE#, %FUNCMODE/CALCMODE 00013185 0203 + USERMASK = PSRM[8]#, 00013186 0203 + SEED = PSRM[10]#, 00013187 0203 + ORIGIN = PSRM[11]#, 00013188 0203 + FUZZ = PSRM[12]#, 00013189 0203 + FSTART=9#, %PSR[9] IS WHERE NAME OF CURRENTLY EDITED FCN GOES 00013190 0203 + PSRSIZE = 13#, 00013200 0203 + PSR = PSRM[*]#, 00013202 0203 + WF=[18:8]#, 00013210 0203 + WDSPERREC=10#, 00013220 0203 + WDSPERBLK=30#, 00013230 0203 + NAREAS=10#, 00013240 0203 + SIZEAREAS=210#, 00013250 0203 + LIBF1=[6:15]#, 00013260 0203 + LIBF2=[22:16]#, 00013270 0203 + LIBF3=[38:10]#, 00013275 0203 + LIBSPACES=1#, 00013280 0203 + IDENT=RESULT=1#, 00014000 0203 + SPECIAL=RESULT=3#, 00015000 0203 + NUMERIC=RESULT=2#, 00016000 0203 + REPLACELOC=0#, 00016050 0203 + REPLACEV=4#, 00017000 0203 + SPF=[30:18]#, 00017100 0203 + RF=[24:6]#, 00017110 0203 + DID=[1:5]#, 00017120 0203 + XRF=[12:18]#, 00017130 0203 + DDPNSW=30#, % DATA DESC PRESENT NAMED SCALAR WORD 00017132 0203 + DDNNVW=20#, %DATA DESC NON-PRES NAMED VECTOR WORD 00017134 0203 + DDNUVW=16#, %DATA DESC NONPRES..(POINTS INTO SYM TAB FOR LOCALS) 00017136 0203 + DDPUVW=24#, % DATA DESC PRESENT UNNAMED VECTOR WORD 00017140 0203 + DDNNSW=22#, % DATA DESC NON-PRES NAMED SCALAR WORD 00017142 0203 + PDC=10#, % PROG DESC CALC MODE 00017144 0203 + INTO=0#, 00017150 0203 + DDPUSW=26#, % DATA DESC PRESENT UNNAMED SCALAR WORD (MODE) 00017152 0203 + DDPUSC=27#, % DATA DESC PRESENT UNNAMED SCALAR CHR 00017154 0203 + DDPUVC=25#, % DATA DESC PRESENT UNNAMED VECTOR CHR 00017156 0203 + DDPNVC=29#, %DATA DESC PRES PERMANENT VECTOR CHAR MODE 00017157 0203 + DDPNVW=28#, %DATA DESC PRES NAMED VEC WORD (NAMED=PERMANENT) 00017158 0203 + OUTOF=1#, 00017160 0203 + NAMEDNULLV=0&7[1:45:3]#, %KLUDGE...NAMED VERSION OF NULLV 00017161 0203 + BACKP=[6:18]#, 00017170 0203 + SCALARDATA=0#, 00017200 0203 + ARRAYDATA=2#, 00017202 0203 + DATATYPE=[4:1]#, 00017204 0203 + ARRAYTYPE=[5:1]#, 00017206 0203 + CHARARRAY=1#, 00017208 0203 + NUMERICARRAY=0#, 00017210 0203 + BLOCKSIZE=30#, %#WORDS OF CONTIGUOUS DATA IN SEQUENTIAL STORE 00017220 0203 + VARTYPE=[42:6]#, 00017222 0203 + WS=WORKSPACE#, 00017224 0203 + DIMPTR=SPF#, 00017226 0203 + INPTR=BACKP#, 00017228 0203 + QUADIN=[18:3]#, 00017230 0203 + QUADINV=18:45:3#, 00017234 0203 + STATEVECTORSIZE=16#, 00017240 0203 + SUSPENDED=[5:1]#, 00017250 0203 + SUSPENDVAR=[2:1]#, 00017252 0203 + CTYPEF=3:45:3#, 00017254 0203 + CSUSVAR=2:47:1#, 00017256 0203 + CNAMED=3:47:1#, 00017258 0203 + MAXWORDSTORE=3960#, %APL PREVENTS CREATION OF ARRAYS BIGGER THAN 00017260 0203 + %3960 ELEMENTS. THIS NUMBER IS THE PRODUCT OF 00017262 0203 + %4,(NUMBER OF POINTERS TO SEQUENTIAL STORE 00017264 0203 + %BLOCKS THAT ARE STORED IN ONE WORD) 00017266 0203 + %30, (BLOCKSIZE), 00017268 0203 + %AND 33, (SIZE OF ARRAY USED TO STORE THESE 00017270 0203 + %POINTERS IN GETARRAY, MOVEARRAY, AND 00017272 0203 + %RELEASEARRAY). SUBSCRIPTS ALLOWS 8×3960 00017274 0203 + %ELEMENTS IF THEY ARE CHARACTERS. 00017276 0203 + %HOWEVER, SP WILL GET FULL BEFORE THAT SINCE 00017278 0203 + %BIGGEST SP SIZE IS CURRENTLY 3584 00017280 0203 + MAXBUFFSIZE=30#, 00018000 0203 + MAXHEADERARGS=30#, 00018100 0203 + BUFFERSIZE=BUFFSIZE#, 00019000 0203 + LINEBUFFER=LINEBUFF#, 00020000 0203 + LINEBUFF = OUTBUFF[*]#, 00020100 0203 + APPENDTOBUFFER=APPENDTOBUFF#, 00021000 0203 + FOUND=TARRAY[0]#, 00022000 0203 + EOB=TARRAY[1]#, 00023000 0203 + MANT=TARRAY[2]#, 00024000 0203 + MANTLEN=TARRAY[3]#, 00025000 0203 + FRAC=TARRAY[4]#, 00026000 0203 + FRACLEN=TARRAY[5]#, 00027000 0203 + POWER=TARRAY[6]#, 00028000 0203 + POWERLEN=TARRAY[7]#, 00029000 0203 + MANTSIGN=TARRAY[8]#, 00029100 0203 + TABSIZE = 43#, 00030000 0203 + LOGINCODES=1#, 00030100 0203 + LOGINPHRASE=2#, 00030200 0203 + LIBRARY=1#, 00030210 0203 + WORKSPACEUNIT=2#, 00030220 0203 + RTPAREN=9#, 00030300 0203 + MASTERMODE=USERMASK.[1:1]#, 00030400 0203 + EDITOG=USERMASK.[2:1]#, 00030401 0203 + POLBUG=USERMASK.[3:1]#, 00030402 0203 + FPTF=9#, % FUNCTION POINTER FIELD (STARTS AT CHR POS 9) 00030403 0203 + FSQF=11#, % FUNCTION SEQNTL FIELD 00030404 0203 + FFL=2#, % FUNCTION FIELD LENGTH (2 CHR POSITIONS) 00030406 0203 + CRETURN=3:47:1#, 00030407 0203 + RETURNVALUE=[3:1]#, 00030408 0203 + CNUMBERARGS=4:46:2#, 00030409 0203 + NUMBERARGS=[4:2]#, 00030410 0203 + RETURNVAL=1#, 00030411 0203 + NOSYNTAX=USERMASK.[4:1]#, 00030412 0203 + LINESIZE=USERMASK.[41:7]#, 00030414 0203 + DIGITS=USERMASK.[37:4]#, 00030416 0203 + SUSPENSION=USERMASK.SUSPENDED#, 00030418 0203 + SAVEDWS=USERMASK.[7:1]#, 00030419 0203 + DELTOG=USERMASK.[6:1]#, 00030420 0203 + DELCHR="$"#, %USED IN DELPRESENT (IN FUNCTIONHANDLER) 00030422 0203 + MAXMESS=27#, 00030500 0203 + USERTOP=21#, 00030510 0203 + MARGINSIZE=6#, 00030600 0203 + LFTBRACKET=SPECIAL AND ACCUM[0]=11#, 00030610 0203 + QUADV=SPECIAL AND ACCUM[0]=10#, 00030620 0203 + QUOTEV=ACCUM[0]=20#, 00030622 0203 + EXPANDV=38#, 00030623 0203 + SLASHV=6#, 00030624 0203 + GOTOV=5#, 00030626 0203 + DOTV=17#, 00030627 0203 + ROTV=37#, 00030628 0203 + RGTBRACKET=SPECIAL AND ACCUM[0]=12#, 00030630 0203 + DELV=SPECIAL AND ACCUM[0]=13#, 00030640 0203 + PLUS = SPECIAL AND ACCUM[0] = 48#, 00030650 0203 + MINUS = SPECIAL AND ACCUM[0] = 49#, 00030660 0203 + NEGATIVE = SPECIAL AND ACCUM[0] = 51#, 00030665 0203 + TIMES = SPECIAL AND ACCUM[0] = 50#, 00030670 0203 + LOGS = SPECIAL AND ACCUM[0] = 54#, 00030672 0203 + SORTUP = SPECIAL AND ACCUM[0] = 55#, 00030674 0203 + SORTDN = SPECIAL AND ACCUM[0] = 56#, 00030675 0203 + NAND = SPECIAL AND ACCUM[0] = 58#, 00030676 0203 + NOR = SPECIAL AND ACCUM[0] = 59#, 00030677 0203 + TAKE = SPECIAL AND ACCUM[0] = 60#, 00030678 0203 + DROPIT = SPECIAL AND ACCUM[0] = 61#, 00030679 0203 + LFTARROW = SPECIAL AND ACCUM[0] = 04#, 00030680 0203 + TRANS = SPECIAL AND ACCUM[0] = 05#, 00030690 0203 + SLASH = SPECIAL AND ACCUM[0] = 06#, 00030700 0203 + INTDIVIDE = SPECIAL AND ACCUM[0] = 07#, 00030710 0203 + LFTPAREN = SPECIAL AND ACCUM[0] = 08#, 00030720 0203 + RGTPAREN = SPECIAL AND ACCUM[0] = 09#, 00030730 0203 + QUOTEQUAD = SPECIAL AND ACCUM[0] = 14#, 00030740 0203 + SEMICOLON = SPECIAL AND ACCUM[0] = 15#, 00030750 0203 + COMMA = SPECIAL AND ACCUM[0] = 16#, 00030760 0203 + DOT = SPECIAL AND ACCUM[0] = 17#, 00030770 0203 + STAR = SPECIAL AND ACCUM[0] = 18#, 00030780 0203 + AT = SPECIAL AND ACCUM[0] = 19#, 00030790 0203 + QUOTE = SPECIAL AND ACCUM[0] = 20#, 00030800 0203 + BOOLAND = SPECIAL AND ACCUM[0] = 21#, 00030810 0203 + BOOLOR = SPECIAL AND ACCUM[0] = 22#, 00030820 0203 + BOOLNOT = SPECIAL AND ACCUM[0] = 23#, 00030830 0203 + LESSTHAN = SPECIAL AND ACCUM[0] = 24#, 00030840 0203 + LESSEQ = SPECIAL AND ACCUM[0] = 25#, 00030860 0203 + EQUAL = SPECIAL AND ACCUM[0] = 26#, 00030870 0203 + GRTEQ = SPECIAL AND ACCUM[0] = 27#, 00030880 0203 + GREATER = SPECIAL AND ACCUM[0] = 28#, 00030890 0203 + NOTEQ = SPECIAL AND ACCUM[0] = 29#, 00030900 0203 + CEILING = SPECIAL AND ACCUM[0] = 30#, 00030910 0203 + FLOOR = SPECIAL AND ACCUM[0] = 31#, 00030920 0203 + STICK = SPECIAL AND ACCUM[0] = 32#, 00030930 0203 + EPSILON = SPECIAL AND ACCUM[0] = 33#, 00030940 0203 + RHO = SPECIAL AND ACCUM[0] = 34#, 00030950 0203 + IOTA = SPECIAL AND ACCUM[0] = 35#, 00030960 0203 + TRACE = SPECIAL AND ACCUM[0] = 36#, 00030970 0203 + PHI = SPECIAL AND ACCUM[0] = 37#, 00030980 0203 + EXPAND = SPECIAL AND ACCUM[0] = 38#, 00030981 0203 + BASVAL = SPECIAL AND ACCUM[0] = 39#, 00030982 0203 + EXCLAMATION = SPECIAL AND ACCUM[0] = 40#, 00030983 0203 + MINUSLASH = SPECIAL AND ACCUM[0] = 41#, 00030984 0203 + QUESTION = SPECIAL AND ACCUM[0] = 42#, 00030985 0203 + OSLASH = SPECIAL AND ACCUM[0] = 43#, 00030986 0203 + TAU = SPECIAL AND ACCUM[0] = 44#, 00030987 0203 + CIRCLE = SPECIAL AND ACCUM[0] = 45#, 00030988 0203 + LOCKIT =IDENT AND ACCUM[0]="4LOCK "#, 00030989 0203 + COLON = SPECIAL AND ACCUM[0] = 47#, 00030990 0203 + QUADLFTARROW=51#, 00030992 0203 + REDUCT=52#, 00030993 0203 + ROTATE=53#, 00030994 0203 + SCANV=57#, 00030995 0203 + LINEBUFFSIZE=17#, 00031000 0203 + MAXPOLISH=100#, MESSIZE=10#, 00031002 0203 + MAXCONSTANT=30#, 00031004 0203 + MAXMEMACCESSES=3584#, %MAXSPROWS × SPRSIZE 00031005 0203 + MAXSYMBOL=30#, 00031006 0203 + MAXSPROWS=28#, 00031007 0203 + TYPEFIELD=[3:3]#, 00031008 0203 + OPTYPE=[1:2]#, 00031009 0203 + LOCFIELD=BACKP#, 00031010 0203 + ADDRFIELD=SPF#, 00031012 0203 + SYMTYPE=[3:3]#, 00031013 0203 + OPERAND=5#, 00031014 0203 + CONSTANT=2#, 00031016 0203 + OPERATOR=3#, 00031018 0203 + LOCALVAR=4#, 00031019 0203 + SYMTABSIZE=1#, 00031020 0203 + LFTPARENV=8#, 00031022 0203 + RGTPARENV=9#, 00031024 0203 + LFTBRACKETV=11#, 00031026 0203 + RGTBRACKETV=12#, 00031028 0203 + SEMICOLONV=15#, 00031030 0203 + QUAD=10#, 00031032 0203 + QQUAD=14#, 00031033 0203 + LFTARROWV=4#, 00031034 0203 + SORTUPV=55#, 00031035 0203 + SORTDNV=56#, 00031036 0203 + ALPHALABEL=1#, 00031040 0203 + NUMERICLABEL=2#, 00031050 0203 + NEXTLINE=0#, 00031060 0203 + ERRORCOND=3#, 00031062 0203 + PRESENCE=[2:1]#, 00031070 0203 + CHANGE=[1:1]#, 00031080 0203 + XEQ=1#, 00031090 0203 + CLEARCORE=2#, 00031092 0203 + WRITECORE=3#, 00031094 0203 + %%% 00031096 0203 + %%% 00031098 0203 + XEQUTE=1#, 00031100 0203 + SLICE=120#, %TIME SLICE IN 60THS OF A SECOND 00031102 0203 + ALLOC=2#, 00031104 0203 + WRITEBACK=3#, 00031106 0203 + LOOKATSTACK=5#, 00031108 0203 + 00031110 0203 + LEN=[1:23]#, 00032000 0203 + NEXT=[24:24]#, 00032002 0203 + LOC=L.[30:11],L.[41:7]#, 00032004 0203 + NOC=N.[30:11],N.[41:7]#, 00032008 0203 + MOC=M.[30:11],M.[41:7]#, 00032010 0203 + SPRSIZE=128#, % SP ROW SIZE 00032015 0203 + NILADIC=0#, 00032020 0203 + MONADIC=1#, 00032030 0203 + DYADIC=2#, 00032040 0203 + TRIADIC=3#, 00032050 0203 + DEPTHERROR=1#, 00032100 0203 + DOMAINERROR=2#, 00032110 0203 + INDEXERROR=4#, 00032120 0203 + LABELERROR=5#, 00032130 0203 + LENGTHERROR=6#, 00032140 0203 + NONCEERROR=7#, 00032150 0203 + RANKERROR=8#, 00032160 0203 + SYNTAXERROR=9#, 00032170 0203 + SYSTEMERROR=10#, 00032180 0203 + VALUEERROR=11#, 00032190 0203 + SPERROR=12#, 00032200 0203 + KITEERROR=13#, 00032201 0203 + STREAMBASE=59823125#, 00032204 0203 + APLOGGED=[10:1]#, 00032230 0203 + APLHEADING=[11:1]#, 00032231 0203 + CSTATION = STATION#, 00032232 0203 + CAPLOGGED=10:47:1#, 00032234 0203 + CAPLHEADING=11:47:1#, 00032236 0203 + APLCODE = STATIONPARAMS#, 00032238 0203 + 00032240 0203 + 00032250 0203 + SPECMODE = BOUNDARY.[1:3]#, 00032260 0203 + DISPLAYING=1#, 00032270 0203 + EDITING=2#, 00032280 0203 + DELETING=3#, 00032290 0203 + RESEQUENCING=4#, 00032291 0203 + LOWER = BOUNDARY.[4:22]#, 00032292 0203 + UPPER = BOUNDARY.[26:22]#, 00032294 0203 + OLDBUFFER = OLDINPBUFFER[*]#, 00032800 0203 + 00032850 0203 + ENDEFINES=#; 00032900 0203 + REAL ADDRESS, ABSOLUTEADDRESS, 00033000 0203 + LADDRESS; 00033100 0203 + BOOLEAN LINETOG; %GO TO NEXT LINE IF TRUE WHEN WRITING OUT 00034000 0203 + INTEGER BUFFSIZE,ITEMCOUNT,RESULT, 00035000 0203 + LOGINSIZE, 00035100 0203 + %%% 00035200 0203 + ERR, 00035300 0203 + NROWS, 00036000 0203 + %%% 00036010 0203 + CUSER; 00036020 0203 + LABEL ENDOFJOB,TRYAGAIN; 00036100 0203 + REAL GT1,GT2,GT3; 00036110 0203 + DEFINE LINE=PRINT#; 00037000 0203 + SAVE ARRAY BUFFER[0:MAXBUFFSIZE]; 00038000 0203 + ARRAY TARRAY[0:8], 00039000 0205 + COMMENT PROGRAM STATE REGISTER; 00039100 0207 + PSRM[0:PSRSIZE], 00039110 0207 + OLDINPBUFFER[0:MAXBUFFSIZE], 00039120 0209 + SP[0:27, 0:SPRSIZE-1], 00039200 0211 + IDTABLE[0:TABSIZE], 00040000 0214 + MESSTAB[0:MAXMESS], 00040100 0216 + JIGGLE[0:0], 00040200 0218 + SCR[0:2], 00041000 0220 + CORRESPONDENCE[0:7], 00041120 0221 + ACCUM[0:MAXBUFFSIZE]; 00042000 0223 + DEFINE OUTBUFFSIZE=29#,CLOGGED=7:47:1#,STU=15:9:9#; 00042715 0225 + ARRAY OUTBUFF[0:OUTBUFFSIZE]; 00042720 0225 + ALPHA STATION, JOBNUM, STATIONPARAMS, BOUNDARY; 00042730 0226 + INTEGER CHRCOUNT, WORKSPACE; 00042740 0226 + 00042910 0226 + STREAM PROCEDURE INITBUFF(B,BUFFSIZE); VALUE BUFFSIZE; 00043000 0226 + BEGIN 00044000 0226 + DI←B; BUFFSIZE(DS←8LIT" "); DS←LIT"←"; 00045000 0228 + END; 00046000 0231 + STREAM PROCEDURE TRANSFER(A,AS,B,BS,L); VALUE AS,BS,L; 00046200 0231 + BEGIN LOCAL T,U,V; 00046210 0231 + SI:=LOC AS; DI:=LOC T; DI:=DI+1; DS:=7CHR; 00046220 0232 + SI:=LOC BS; DI:=LOC U; DI:=DI+1; DS:=7CHR; 00046230 0233 + SI:=LOC L; DI:=LOC V; DI:=DI+1; DS:=7CHR; 00046232 0234 + SI:=A; T(2(SI:=SI+32)); SI:=SI+AS; 00046240 0235 + DI:=B; U(2(DI:=DI+32)); DI:=DI+BS; 00046250 0237 + V(2(DS:=32CHR)); DS:=L CHR; 00046260 0240 + END; 00046270 0243 + REAL PROCEDURE NUMBER; FORWARD; %LINE 111500 00046275 0243 + BOOLEAN PROCEDURE SCAN; 00046280 0243 + BEGIN 00046284 0243 + REAL STREAM PROCEDURE GNC(ADDR,ACC); VALUE ADDR; 00046290 0243 + START OF SEGMENT ********** 32 + BEGIN SI:=ADDR; DI:=ACC; DI:=DI+7; DS:=CHR; GNC:=SI; 00046300 0000 + DI:=ACC; SKIP DB; DS:=SET; END OF GNC; 00046310 0001 + REAL STREAM PROCEDURE RESWD(TAB,BUF,ADDR,EOB,FOUND,K); 00047000 0003 + VALUE ADDR,K; 00048000 0003 + BEGIN 00049000 0003 + LOCAL T,TSI,TDI; 00050000 0003 + LABEL TRY,L,KEEPGOING,FINIS,RESTORE; 00051000 0003 + LABEL NUMBERFOUND; 00051100 0003 + DI:=EOB; DS:=8LIT"0"; DI:=FOUND; DS:=8LIT"0"; 00052000 0003 + SI:=ADDR; 00053000 0006 + L: IF SC NEQ " " THEN GO TO KEEPGOING; 00054000 0006 + SI:=SI+1; 00055000 0007 + GO TO L; 00056000 0008 + KEEPGOING: 00057000 0008 + RESWD:=SI; 00058000 0008 + ADDR:=SI; 00059000 0009 + IF SC GEQ "0" THEN IF SC LEQ "9" THEN GO TO NUMBERFOUND; 00059050 0009 + IF SC="#" THEN GO TO NUMBERFOUND; 00059100 0011 + IF SC="@" THEN GO TO NUMBERFOUND; 00059800 0012 + IF SC="." THEN 00059810 0012 + BEGIN SI:=SI+1; 00059820 0013 + IF SC GEQ "0" THEN IF SC LEQ "9" THEN 00059830 0014 + GO TO NUMBERFOUND; SI:=SI-1; 00059840 0015 + END; 00059900 0016 + DI:=LOC T; DS:=2RESET; DS:=2SET; DS:=2RESET; 00060000 0016 + DI:=LOC T; 00061000 0017 + IF SC=DC THEN 00062000 0017 + BEGIN DI:=EOB; DI:=DI+7; DS:=LIT"1"; 00063000 0017 + GO TO FINIS 00064000 0019 + END; 00065000 0019 + SI:=TAB; TSI:=SI; 00066000 0019 + TRY: 00067000 0020 + IF SC="0" THEN 00068000 0020 + BEGIN SI:=ADDR; 00069000 0020 + IF SC=ALPHA THEN 00070000 0021 + IF SC GEQ"0" THEN 00071000 0021 + IF SC LEQ "9" THEN 00072000 0022 + NUMBERFOUND: 00072100 0023 + TALLY:=2 ELSE TALLY := 0 00072200 0023 + ELSE TALLY:=1 00073000 0025 + ELSE TALLY:=3; 00074000 0026 + T:=TALLY; SI:=LOC T; SI:=SI+7; DI:=FOUND; DI:=DI+7; 00075000 0026 + DS:=CHR; GO FINIS; 00076000 0028 + END; 00077000 0028 + DI:=LOC T; DI:=DI+7; DS:=CHR; 00078000 0028 + DI:=ADDR; 00079000 0029 + IF T SC=DC THEN 00080000 0029 + BEGIN 00081000 0030 + TSI:=SI; TDI:=DI; SI:=SI-1; 00082000 0030 + IF SC=ALPHA THEN 00083000 0031 + BEGIN DI:=DI+16; SI:=TDI; 00084000 0032 + IF SC NEQ " " THEN IF SC =ALPHA THEN ; 00085000 0033 + END; 00086000 0034 + SI:=TSI; 00087000 0034 + END ELSE GO TO RESTORE; 00088000 0034 + IF TOGGLE THEN 00089000 0035 + RESTORE: 00090000 0035 + BEGIN SI:=SI+K; DI:=ADDR; GO TO TRY 00091000 0035 + END; 00092000 0037 + DI:=FOUND; DS:=K OCT; 00093000 0037 + DI:=TDI; RESWD:=DI; 00094000 0037 + FINIS: 00095000 0038 + END; 00095100 0038 + REAL STREAM PROCEDURE ACCUMULATE(ACC,EOB,ADDR); VALUE ADDR; 00095110 0040 + BEGIN LOCAL T; LABEL EOBL,E,ON,L; 00095120 0040 + DI:=ACC; 9(DS:=8LIT" "); 00095130 0040 + DI:=EOB; DS:=8LIT"0"; SI:=ADDR; DI:=LOC T; SKIP 2 DB; 00095140 0042 + DS:=2SET; DI:=LOC T; 00095150 0044 + 63(IF SC=ALPHA THEN TALLY:=TALLY+1 ELSE JUMP OUT TO E; 00095160 0044 + SI:=SI+1); 00095170 0046 + L: IF SC=ALPHA THEN BEGIN SI:=SI+1; GO L END ELSE GO ON; 00095180 0047 + IF SC=" " THEN GO ON; 00095190 0049 + E: IF SC = DC THEN ; 00095200 0049 + SI:=SI-1; IF TOGGLE THEN GO TO EOBL ELSE GO ON; 00095210 0050 + EOBL: DI:=EOB; DI:=DI+7; DS:=LIT"1"; 00095220 0051 + ON: ACCUMULATE:=SI; DI:=ACC; T:=TALLY; SI:=LOC T; SI:=SI+6; 00095230 0053 + DS:=2CHR; SI:=ADDR; DS:=T CHR; 00095240 0054 + END OF ACCUMULATE; 00095250 0055 + BOOLEAN STREAM PROCEDURE ARROW(ADDR,I); VALUE ADDR,I; 00095260 0056 + BEGIN SI:=ADDR; SI:=SI-1; DI:=LOC I; DI:=DI+7; 00095270 0056 + IF SC=DC THEN TALLY:=1; ARROW :=TALLY 00095280 0058 + END OF ARROW; 00095290 0059 + IF NOT BOOLEAN(EOB) THEN BEGIN 00095300 0060 + LADDRESS:=ADDRESS; 00095310 0061 + ADDRESS:=RESWD(IDTABLE,BUFFER,ADDRESS,EOB,FOUND,2); 00095330 0062 + IF RESULT:=FOUND NEQ 0 THEN BEGIN 00095340 0067 + IF RESULT=1 THEN ADDRESS:=ACCUMULATE(ACCUM,EOB,ADDRESS) 00095350 0069 + ELSE IF RESULT=2 THEN ACCUM[0]:=NUMBER 00095360 0072 + ELSE IF RESULT=3 THEN ADDRESS:=GNC(ADDRESS,ACCUM) 00095370 0075 + ELSE BEGIN ACCUM[0]:=RESULT; RESULT:=3 END; 00095380 0079 + ITEMCOUNT:=ITEMCOUNT+1; 00095390 0083 + SCAN:=TRUE; 00095400 0084 + IF ARROW(ADDRESS,31) THEN 00095410 0085 + BEGIN EOB:=1; SCAN:=FALSE END; 00095420 0086 + END ELSE EOB:=1; 00095430 0089 + END; 00095440 0091 + END OF THE SCAN PROCEDURE; 00095450 0091 + 32 IS 94 LONG, NEXT SEG 2 + PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,BL,S,N; 00096000 0243 + INTEGER CC,BL,S,N; ARRAY A[0]; FORWARD 00096100 0243 + ; 00096200 0243 + PROCEDURE INDENT(R); VALUE R; REAL R; FORWARD; 00096300 0243 + PROCEDURE TERPRINT; FORWARD; 00096400 0243 + PROCEDURE PROCESS(MODE);VALUE MODE;INTEGER MODE; FORWARD; 00096500 0243 + REAL STREAM PROCEDURE ABSADDR(A); 00097000 0243 + BEGIN SI:=A; ABSADDR:=SI 00098000 0243 + END; 00099000 0244 + BOOLEAN PROCEDURE LIBRARIAN(MFID,FID); VALUE MFID,FID; 00099100 0245 + REAL MFID,FID; 00099110 0245 + BEGIN 00099120 0245 + REAL ARRAY A[0:6]; FILE DF DISK(1,1); 00099125 0245 + START OF SEGMENT ********** 33 + REAL T; 00099130 0005 + COMMENT LIBRARIAN IS TRUE IF MFID/FID IS PRESENT ON DISK; 00099137 0005 + FILL DF WITH MFID,FID; 00099140 0005 + SEARCH(DF,A[*]); 00099145 0009 + LIBRARIAN:= 00099150 0011 + A[0]≠-1; 00099160 0011 + END; 00099170 0012 + 33 IS 18 LONG, NEXT SEG 2 + FILE SPO 11(1,3); 00099300 0245 + PROCEDURE SPOUT(K); VALUE K; INTEGER K; 00099310 0249 + BEGIN FORMAT ERRF("APL ERROR:",I8,A1); 00099320 0249 + START OF SEGMENT ********** 34 + START OF SEGMENT ********** 35 + 35 IS 7 LONG, NEXT SEG 34 + WRITE(SPO,ERRF,K,31); 00099330 0000 + END; 00099340 0009 + 34 IS 10 LONG, NEXT SEG 2 + PROCEDURE INITIALIZETABLE; 00100000 0249 + BEGIN DEFINE STARTSEGMENT= #; 00101000 0249 + START OF SEGMENT ********** 36 + INTEGER I; 00101005 0000 + LADDRESS:= 00101010 0000 + ABSOLUTEADDRESS:=ABSADDR(BUFFER); 00101100 0000 + BIGGEST := REAL(NOT FALSE) & 0[1:46:2]; 00101200 0002 + NULLV := 0 & 3[1:46:2]; 00101300 0004 + STATUSWORD←REAL(BOOLEAN(STATUSWORD) OR BOOLEAN(1)); 00101400 0006 + JOBNUM←TIME(-1); 00101410 0007 + STATION←0&1[CLOGGED]&STATUSWORD[STU]; 00101420 0009 + FILL JIGGLE[*] WITH OCT5757575757575737;%CARRIAGE RETURNS LEFT ARROW 00101430 0011 + START OF SEGMENT ********** 37 + 37 IS 1 LONG, NEXT SEG 36 + FILL IDTABLE[*] WITH 00102000 0013 + "1+481-49", "1&501%07", "1.171@19", "1#411(08", 00103000 0014 + START OF SEGMENT ********** 38 + "1)091/06", "3XEQ623L", "OG541;15", OCT0333777601040177, 00103100 0015 + %LAST IN ABOVE LINE IS REALLY 3["]141" 00103200 0015 + "202:=042", "[]101[11", "1]123AND", "212OR223", 00103300 0015 + "NOT233LS", "S243LEQ2", "53GEQ273", "GTR283NE", "Q292=:05", 00103350 0015 + "2GO051=2", "63MAX304", "CEIL303F", "LR313MIN", 00103400 0015 + "314RESD3","23ABS323","RHO341*1","84IOTA35", 00103500 0015 + "1×384RND", "M425TRAN", "S431$133", "PHI374FA", 00103600 0015 + "CT404COM", "B406CIRC", "LE456SOR", "TUP556SO", 00103700 0015 + "RTDN561:", "474NAND5", "83NOR594", "TAKE604D", 00103800 0015 + "ROP613RE", "P446BASV", "AL393EPS", "331,1600"; 00103900 0015 + 38 IS 41 LONG, NEXT SEG 36 + COMMENT IDTABLE IS TABLE OF RESERVED WORDS AND SPECIAL SYMBOLS. 00103910 0015 + FORMAT IS NUMBER OF CHARACTERS IN SYMBOL, FOLLOWED BY SYMBOL 00103913 0015 + ITSELF, FOLLOWED BY A TWO-DIGIT DECIMAL CODE WHICH APL USES 00103916 0015 + FOR THE RESERVED WORD--LIKE IN THE EXECUTION CASE STATEMENT AND 00103919 0015 + IN SYNTAX CHECKING. FOR SCAN TO WORK, THE TW0-DIGIT CODE MUST 00103922 0015 + BE GREATER THAN 3 AND IDTABLE MUST HAVE AT LEAST ONE "0" AT THE 00103925 0015 + END TO MARK THE END. TABSIZE IS THE DEFINE (LINE 30000) GIVING 00103928 0015 + THE SIZE OF IDTABLE; 00103931 0015 + IF STACKSIZE=0 THEN STACKSIZE:=100 ELSE 00103940 0015 + IF STACKSIZE GTR 1022 THEN STACKSIZE:=1022; 00103950 0017 + BUFFSIZE:=MAXBUFFSIZE; 00104000 0019 + LINETOG := TRUE; %USUALLY GO TO NEXT LINE WHEN WRITING OUT 00104010 0020 + 00104100 0021 + INITBUFF(OUTBUFF, 10); 00104500 0021 + INITBUFF(BUFFER,BUFFSIZE); 00105000 0022 + NROWS:=-1; 00105010 0023 + NAME(LIBJOB,TIME(-1)); 00105100 0024 + FILL MESSTAB[*] WITH 00105200 0026 + "4SAVE ", 00105210 0027 + START OF SEGMENT ********** 39 + "4LOAD ", 00105220 0028 + "5CLEAR ", 00105230 0028 + "4COPY ", 00105240 0028 + "4VARS ", 00105250 0028 + "3FNS ", 00105260 0028 + "6LOGGED", 00105270 0028 + "3MSG ", 00105280 0028 + "5WIDTH ", 00105290 0028 + "3OPR ", 00105300 0028 + "6DIGITS", 00105310 0028 + "3OFF ", 00105320 0028 + "6ORIGIN", 00105322 0028 + "4SEED ", 00105324 0028 + "4FUZZ ", 00105326 0028 + "3SYN ", 00105328 0028 + "5NOSYN ", 00105330 0028 + "5STORE ", 00105332 0028 + "5ABORT ", 00105340 0028 + "2SI ", 00105350 0028 + "3SIV ", 00105360 0028 + "5ERASE ", 00105370 0028 + %--------------MASTERMODE BELOW HERE...(SEE USERTOP)-------- 00105380 0028 + "6ASSIGN", 00105390 0028 + "6DELETE", 00105400 0028 + "4LIST ", 00105410 0028 + "5DEBUG ", 00105420 0028 + "5FILES "; 00105440 0028 + 39 IS 27 LONG, NEXT SEG 36 + 00106000 0028 + IF LIBSIZE=-1 THEN 00106090 0028 + BEGIN LIBSIZE←1;GTA[0]←" ";STOREORD(LIBRARY,GTA,0);WRAPUP; 00106091 0029 + END ELSE BEGIN LIBSIZE←SIZE(LIBRARY); 00106093 0034 + FOR I←1 STEP 1 UNTIL LIBSIZE-1 DO 00106094 0038 + BEGIN GT1←CONTENTS(LIBRARY,I,ACCUM); 00106095 0042 + IF NOT LIBRARIAN(ACCUM[0],TIME(-1)) THEN 00106096 0044 + BEGIN DELETE1(LIBRARY,I);LIBSIZE←LIBSIZE-1;END; 00106099 0047 + IF (LOGINSIZE:=SIZE(LOGINCODES)=0) THEN 00106100 0049 + END; 00106102 0051 + END; 00106104 0052 + FILL CORRESPONDENCE[*] WITH 00106500 0052 + OCT1111111111110311, 00106510 0053 + START OF SEGMENT ********** 40 + OCT1111111111111111, 00106520 0054 + OCT1104111121221113, 00106530 0054 + OCT2014151617100706, 00106540 0054 + OCT1111111111111112, 00106550 0054 + OCT1111111111111100, 00106560 0054 + OCT0201111111251111, 00106570 0054 + OCT2324111111111111; 00106571 0054 + 40 IS 8 LONG, NEXT SEG 36 + COMMENT CORRESPONDENCE GIVES THE CORRESPONDENCE BETWEEN THE 00106573 0054 + APL CODES FOR DYADIC SCALAR OPERATORS (EXCEPT CIRCLE) AND 00106575 0054 + THEIR POSITIONS IN THE "CASE STATEMENT" IN "OPERATION". 00106577 0054 + E.G. APL CODE 7 IS "OPERATION" CODE 3 IN OCTAL (FOR DIVIDE). 00106579 0054 + IF N-TH CHARACTER IN CORRESPONDENCE IS OCTAL 11, THEN N 00106581 0054 + IS NOT AN APL CODE FOR A DYADIC SCALAR OPERATOR. CHARACTER 00106583 0054 + COUNT STARTS AT 1 FOR FIRST CHARACTER. TO MAKE IT COME OUT 00106584 0054 + RIGHT, STREAM PROCEDURE GETOP IS ACTUALLY CALLED WITH APL 00106586 0054 + OPERATION CODE MINUS 1; 00106588 0054 + END; 00107000 0054 + 36 IS 57 LONG, NEXT SEG 2 + REAL STREAM PROCEDURE CONV(ADDR,N); 00108000 0249 + VALUE N,ADDR; 00108500 0249 + BEGIN SI:=ADDR; 00109000 0249 + DI:=LOC CONV; 00109500 0250 + DS:=N OCT; END; 00110000 0250 + REAL STREAM PROCEDURE BUMP(ADDR,N); VALUE ADDR,N; 00110500 0252 + BEGIN SI:=ADDR; SI:=SI+N; BUMP:=SI; END; 00111000 0252 + REAL PROCEDURE NUMBER; 00111500 0254 + BEGIN REAL NCHR; 00112000 0254 + START OF SEGMENT ********** 41 + LABEL GETFRAC,GETPOWER,QUIT,KITE; 00112500 0000 + MONITOR EXPOVR; 00113000 0000 + REAL PROCEDURE INTCON(COUNT); VALUE COUNT; 00113500 0001 + REAL COUNT; 00114000 0001 + BEGIN REAL TLO,THI,T; INTEGER N; 00114500 0001 + START OF SEGMENT ********** 42 + BOOLEAN DPTOG; DEFINE ADDR=ADDRESS#; 00115000 0000 + COMMENT: VALUE OF INTCON IS THE CONVERSION OF AN INTEGER 00115500 0000 + CONSISTING OF COUNT NUMERICAL CHARACTERS STARTING 00116000 0000 + AT THE CHARACTER ADDRESS. ADDRESS IS SET TO POINT 00116500 0000 + TO THE NEXT CHARACTER DURING INTCON; 00117000 0000 + DPTOG:=COUNT GTR 8; 00117500 0000 + THI:=T:=CONV(ADDR,N:=COUNT MOD 8); 00118000 0001 + ADDR:=BUMP(ADDR,N); 00118500 0004 + COUNT:=COUNT DIV 8; 00119000 0006 + FOR N:=1 STEP 1 UNTIL COUNT DO BEGIN 00119500 0008 + IF DPTOG THEN BEGIN 00120000 0009 + DOUBLE(THI,TLO,100000000.0,0,×,CONV(ADDR,8), 00120500 0009 + 0,+,:=,THI,TLO); 00121000 0012 + T:=THI 00121500 0014 + END ELSE T:=T×100000000 + CONV(ADDR,8); 00122000 0014 + ADDR:=BUMP(ADDR,8); END; 00122500 0020 + INTCON:=T; 00123000 0024 + END OF INTCON; 00123500 0025 + 42 IS 31 LONG, NEXT SEG 41 + INTEGER STREAM PROCEDURE SUBSCAN(ADDR,NEXT); VALUE ADDR; 00124000 0001 + BEGIN SI:=ADDR; 00124500 0001 + 63(IF SC GEQ "0" THEN 00125000 0003 + IF SC LEQ "9" THEN BEGIN SI:=SI+1; TALLY:=TALLY+1; 00125500 0004 + END ELSE JUMP OUT); 00126000 0006 + DI:=NEXT; DI:=DI+7; DS:=1 CHR; SUBSCAN:=TALLY; 00126500 0007 + END; 00127000 0008 + COMMENT--VALUE OF SUBSCAN IS NUMBER OF NUMERIC CHARACTERS 00127500 0009 + FOUND. NEXT CONTAINS THE FIRST NON-NUMERIC CHARACTER; 00128000 0009 + EXPOVR:=KITE; 00128500 0009 + MANTSIGN:=1; 00129000 0010 + MANT:=MANTLEN:=POWER:=POWERLEN:=FRAC:=FRACLEN:=0; 00129500 0012 + MANTLEN:=SUBSCAN(ADDRESS,NCHR); 00130000 0018 + IF MANTLEN=0 AND NCHR="#" THEN BEGIN 00130500 0020 + MANTSIGN:=-1; 00131000 0023 + ADDRESS:=BUMP(ADDRESS,1); 00131500 0024 + MANTLEN:=SUBSCAN(ADDRESS,NCHR); END; 00132000 0026 + IF MANTLEN=0 THEN BEGIN ADDRESS:=BUMP(ADDRESS,1); 00132500 0029 + IF NCHR="." THEN GO TO GETFRAC 00133000 0032 + ELSE IF NCHR="@" OR NCHR="E" THEN GO TO GETPOWER 00133500 0033 + ELSE BEGIN ERR:=SYNTAXERROR; 00134000 0035 + GO TO QUIT; END; END; 00134500 0037 + MANT:=INTCON(MANTLEN); 00135000 0037 + IF NCHR="." THEN BEGIN ADDRESS:=BUMP(ADDRESS,1); GO GETFRAC END; 00135500 0039 + IF NCHR="@" OR NCHR="E" THEN BEGIN 00136000 0043 + ADDRESS:=BUMP(ADDRESS,1); GO TO GETPOWER END; 00136500 0045 + IF NCHR=12 THEN EOB:=1; 00137000 0048 + GO TO QUIT; 00137500 0050 + GETFRAC: FRACLEN:=SUBSCAN(ADDRESS,NCHR); 00138000 0051 + IF FRACLEN=0 THEN BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END; 00138500 0054 + FRAC:=INTCON(FRACLEN); 00139000 0057 + IF NCHR="@" OR NCHR="E" THEN BEGIN 00139500 0059 + ADDRESS:=BUMP(ADDRESS,1); GO TO GETPOWER; END; 00140000 0061 + IF NCHR=12 THEN EOB:=1 ELSE 00140500 0064 + IF NCHR="." OR NCHR="#" THEN ERR:=SYNTAXERROR; 00141000 0066 + GO TO QUIT; 00141500 0070 + GETPOWER: 00142000 0070 + POWERLEN:=SUBSCAN(ADDRESS,NCHR); 00142500 0071 + IF POWERLEN=0 THEN BEGIN 00143000 0073 + IF NCHR="-" OR NCHR="#" THEN POWER:=-1 00143500 0075 + ELSE IF NCHR="+" THEN POWER:=1 00144000 0077 + ELSE BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END; 00144500 0081 + POWERLEN:=SUBSCAN(ADDRESS:=BUMP(ADDRESS,1), NCHR); 00145000 0083 + END ELSE POWER:=1; 00145500 0087 + IF POWERLEN=0 THEN ERR:=SYNTAXERROR 00146000 0089 + ELSE BEGIN 00146500 0091 + POWER:=INTCON(POWERLEN)×POWER; 00147000 0092 + IF NCHR="#" OR NCHR="@" OR NCHR="." 00147500 0095 + THEN ERR:=SYNTAXERROR; END; 00148000 0097 + GO TO QUIT; 00148500 0099 + KITE: ERR:=KITEERROR; 00149000 0099 + QUIT: IF ERR=0 THEN 00149500 0100 + NUMBER:=IF MANTLEN+FRACLEN=0 THEN 00150000 0101 + IF POWERLEN=0 THEN 0 00150500 0104 + ELSE MANTSIGN×10*ENTIER(POWER) 00151000 0105 + ELSE MANTSIGN×(MANT×10*ENTIER(POWER) 00151500 0107 + + FRAC×10*ENTIER(POWER-FRACLEN)) ELSE EOB:=1; 00152000 0113 + END OF NUMBER; 00152500 0125 + 41 IS 131 LONG, NEXT SEG 2 + STREAM PROCEDURE APPENDTOBUFF(BUF,NBUF,NBLANK,A,SA,NA); 00220000 0254 + VALUE NBUF,NBLANK,SA,NA; 00221000 0254 + BEGIN LOCAL T; 00222000 0254 + LOCAL TSI,TDI; 00223000 0254 + SI:=LOC NBUF; DI:=LOC T; DI:=DI+1; DS:=7CHR; 00224000 0254 + DI:=BUF; T(2(DI:=DI+32)); DI:=DI+NBUF; 00225000 0255 + NBLANK(DS:=LIT" "); TDI:=DI; 00226000 0257 + SI:=LOC SA; DI:=LOC T; DI:=DI+1; DS:=7CHR; 00227000 0259 + SI:=A; T(2(SI:=SI+32)); SI:=SI+SA; 00228000 0260 + TSI:=SI; SI:=LOC NA; DI:=LOC T; DI:=DI+1; DS:=7CHR; 00229000 0263 + SI:=TSI; DI:=TDI; T(2(DS:=32CHR)); DS:=NA CHR 00230000 0264 + END; 00231000 0267 + PROCEDURE TERPRINT; 00231030 0268 + BEGIN LABEL BK; 00231040 0268 + START OF SEGMENT ********** 43 + STREAM PROCEDURE FINISHBUFF(BUF,N,TER);VALUE N,TER; 00232000 0000 + BEGIN LOCAL T; 00232100 0000 + SI:=LOC TER;SI:=SI+7;IF SC="1" THEN; 00232200 0000 + SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7 CHR; 00232300 0001 + DI:=BUF; T(2(DI:=DI+32));DI:=DI+N; 00232400 0002 + IF TOGGLE THEN DS:=2 LIT"≤≠"; %CARRIAGE RETURN/LINE FEED 00232500 0004 + DS:=RESET;DS:=5 SET; %END OF MESSAGE LEFT ARROW 00232600 0005 + END OF FINISHBUFF; 00232700 0006 + IF CHRCOUNT NEQ 0 THEN BEGIN 00240000 0006 + FINISHBUFF(OUTBUFF,CHRCOUNT,LINETOG); 00241000 0008 + CHRCOUNT:=0; 00242000 0010 + IF LINETOG THEN 00242500 0010 + WRITE(TWXOUT,9,OUTBUFF[*])[BK:BK] ELSE 00243000 0011 + WRITE(TWXOUT[STOP],9,OUTBUFF[*])[BK:BK]; 00243500 0019 + INITBUFF(OUTBUFF, 10); 00243600 0027 + END; 00243610 0028 + IF FALSE THEN 00244000 0028 + BK: IF CURRENTMODE=XEQMODE THEN BREAKFLAG:=TRUE; 00244100 0028 + END OF TERPRINT; 00245000 0031 + 43 IS 36 LONG, NEXT SEG 2 + PROCEDURE FORMWD(CC,WD); VALUE CC,WD; REAL WD; INTEGER CC; 00253000 0268 + BEGIN 00254000 0268 + INTEGER I,K,L; 00255000 0268 + START OF SEGMENT ********** 44 + COMMENT CC=-1 STAY ON LINE, OUTPUT, DON"T GO TO NEXT LINE 00255090 0000 + COMMENT CC=0 STAY ON THIS LINE, MORE TO COME. 00256000 0000 + CC=1 STAY ON THIS LINE BUT TERMINATE PRINT. 00257000 0000 + CC=2 SKIP TO NEXT LINE - MORE TO COME. 00258000 0000 + CC=3 SKIP TO NEXT LINE - TERMINATE PRINT.; 00259000 0000 + REAL STREAM PROCEDURE OCTAL(I); VALUE I; 00260000 0000 + BEGIN SI:=LOC I; DI:=LOC OCTAL; DS:=8OCT 00261000 0000 + END; 00262000 0000 + IF L:=LINESIZE LEQ 9 OR L GTR 72 THEN L:=72; K:=2; 00263000 0001 + IF CC GTR 1 AND CHRCOUNT GTR 0THEN TERPRINT; 00264000 0007 + IF CHRCOUNT+(I:=OCTAL(WD.[1:11])) GTR L THEN 00265000 0009 + 00266000 0013 + BEGIN APPENDTOBUFF(LINEBUFFER,CHRCOUNT, 00267000 0013 + 0,WD,2,K:=L-CHRCOUNT); 00268000 0015 + CHRCOUNT:=L; TERPRINT; 00269000 0017 + 00270000 0018 + I:=I-K; 00271000 0018 + 00272000 0020 + END; 00273000 0020 + APPENDTOBUFF(LINEBUFFER,CHRCOUNT,0,WD,K,I); 00274000 0020 + 00274900 0023 + CHRCOUNT:=CHRCOUNT+I; 00275000 0023 + IF BOOLEAN(CC) THEN 00276000 0024 + IF CC=-1 THEN BEGIN LINETOG:=FALSE; 00276010 0024 + TERPRINT; LINETOG:=TRUE 00276020 0027 + END ELSE TERPRINT; 00276030 0028 + END; 00277000 0029 + 44 IS 33 LONG, NEXT SEG 2 + BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR); 00277500 0268 + ARRAY SPECS[0]; REAL HADDR; FORWARD; 00277600 0268 + 00278000 0268 + 00279000 0268 + 00280000 0268 + REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R; 00280100 0268 + COMMENT STARTS ON 8030000; 00280110 0268 + FORWARD; 00280120 0268 + 00280130 0268 + PROCEDURE INDENT(R); VALUE R; REAL R; 00281000 0268 + BEGIN 00281100 0268 + INTEGER STREAM PROCEDURE FORM(A,I,K);VALUE K,I; 00281200 0268 + START OF SEGMENT ********** 45 + BEGIN 00281300 0000 + LOCAL T1,T2; 00281400 0000 + LABEL SHORT,L,M,FINIS; 00281500 0000 + TALLY:=K; FORM:=TALLY; 00281600 0000 + SI:=LOC I; DI:=LOC T1; IF 8SC=DC THEN 00281700 0001 + BEGIN DI:=A; K(DS:=LIT" "); GO FINIS 00281800 0002 + END; 00281900 0004 + SI:=LOC I; DI:=A; TALLY:=3; DS:=LIT"["; 00282000 0004 + IF SC GTR "0" THEN IF SC LSS "0" THEN ; 00282100 0006 + 3(TALLY:=TALLY+1; IF TOGGLE THEN DS:=CHR ELSE 00282200 0007 + IF SC NEQ "0" THEN DS:=CHR ELSE 00282300 0008 + BEGIN TALLY:=TALLY+63; SI:=SI+1 00282400 0009 + END ); 00282500 0010 + DS:=CHR; T1:=TALLY; TALLY:=4; SI:=SI+3; 00282600 0010 + 4(IF SC NEQ "0" THEN JUMP OUT TO M; 00282700 0011 + TALLY:=TALLY+63; SI:=SI-1); GO TO L; 00282800 0012 + M: 00282900 0013 + T2:=TALLY; SI:=LOC I; SI:=SI+4; DS:=LIT"."; DS:=T2 CHR; 00283000 0013 + TALLY:=T1; TALLY:=TALLY+T2; TALLY:=TALLY+1; T1:=TALLY; 00283100 0015 + L: 00283200 0017 + DS:=LIT"]"; TALLY:=K; 00283300 0017 + T1(TALLY:=TALLY+63; T2:=TALLY; SI:=LOC T2; SI:=SI+7; 00283400 0019 + IF SC="0" THEN JUMP OUT TO SHORT); 00283500 0021 + T2(DS:=LIT" "); GO FINIS; 00283600 0022 + SHORT: 00283700 0024 + TALLY:=T1; TALLY:=TALLY+1; FORM:=TALLY; DS:=LIT" "; 00283800 0024 + FINIS: 00283900 0026 + DS:=RESET; DS:=5SET; 00284000 0026 + END; 00284100 0027 + IF R LSS 0 THEN R:=LINENUMBER(-R) ELSE R:=ABS(R); % -0 00285000 0028 + CHRCOUNT:=FORM(LINEBUFF,R,MARGINSIZE)+1 00286000 0033 + 00286100 0036 + END; 00287000 0036 + 45 IS 38 LONG, NEXT SEG 2 + INTEGER PROCEDURE HEADER(ADDR1,ADDR2,BUF); VALUE ADDR1,ADDR2; 00287010 0268 + INTEGER ADDR1, ADDR2; ARRAY BUF[0]; 00287020 0268 + BEGIN 00287030 0268 + INTEGER STREAM PROCEDURE HEADRR(ADDR1,ADDR2,BUF); VALUE ADDR1, 00287100 0268 + START OF SEGMENT ********** 46 + ADDR2; 00287110 0000 + BEGIN 00287120 0000 + LOCAL C,T,TDI; 00287130 0000 + LOCAL QM,AR; 00287132 0000 + LABEL L,ENDSCAN,M,N; 00287140 0000 + DI:=LOC QM; DS:=2RESET; DS:=2SET; 00287142 0000 + DI:=LOC AR; DS:=RESET; DS:=5SET; 00287144 0000 + DI:=BUF; 00287180 0001 + SI:=ADDR1; 00287200 0001 + L: T:=SI; TDI:=DI; 00287210 0002 + DI:=LOC QM; IF SC=DC THEN GO TO ENDSCAN; 00287212 0002 + DI:=LOC AR; SI:=SI-1; IF SC=DC THEN GO TO ENDSCAN; 00287214 0003 + SI:=LOC T; DI:=LOC ADDR2; 00287220 0004 + IF 8SC=DC THEN COMMENT END OF SCAN; 00287230 0005 + GO TO ENDSCAN; 00287240 0005 + SI:=T; DI:=TDI; DS:=CHR; 00287250 0006 + GO TO L; 00287260 0006 + ENDSCAN: 00287300 0007 + SI:=TDI; 00287310 0007 + M: SI:=SI-1; 00287320 0007 + IF SC=" " THEN GO TO M; 00287330 0008 + SI:=SI+1; 00287332 0009 + ADDR2:=SI; 00287340 0009 + SI:=BUF; 00287350 0009 + N: T:=SI; DI:=LOC ADDR2; 00287360 0009 + SI:=LOC T; 00287370 0010 + IF 8SC NEQ DC THEN 00287380 0010 + BEGIN 00287390 0011 + TALLY:=TALLY+1; TDI:=TALLY; 00287400 0011 + SI:=LOC TDI; SI:=SI+7; 00287410 0012 + IF SC="0" THEN 00287420 0012 + BEGIN TALLY:=C; TALLY:=TALLY+1; C:=TALLY; 00287430 0013 + TALLY:=0; 00287440 0015 + END; 00287450 0015 + SI:=T; SI:=SI+1; GO TO N; 00287460 0015 + END; 00287470 0016 + HEADRR:=TALLY; SI:=LOC C; DI:=LOC HEADRR; SI:=SI+1; DS:=6 CHR; 00287480 0016 + END; 00287490 0017 + HEADER:=HEADRR(ADDR1,ADDR2,BUF); 00287492 0018 + END OF PHONY HEADER; 00287494 0022 + 46 IS 26 LONG, NEXT SEG 2 + PROCEDURE STARTSCAN; 00299000 0268 + BEGIN 00300000 0268 + 00300100 0268 + 00300600 0268 + 00300700 0268 + LADDRESS:= 00301000 0268 + ADDRESS:=ABSOLUTEADDRESS; 00302000 0268 + BEGIN TERPRINT; 00304000 0269 + END; 00305000 0269 + READ(TWXIN[STOP],29,BUFFER[*]); 00306000 0269 + BUFFER[30]:=0&31[1:43:5]; 00307000 0274 + ITEMCOUNT:=0; 00312000 0276 + EOB:=0 00313000 0277 + END; 00314000 0277 + PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,BL,S,N; INTEGER CC,BL, 00315000 0278 + S,N; ARRAY A[0]; 00316000 0278 + COMMENT: CC--SAME CODE AS IN FORMWD, LINE 253000 00316010 0278 + BL--#BLANKS TO PUT IN FRONT OF IT 00316020 0278 + A--ARRAY WHERE THE STUFF TO PUT ON LINE IS STORED 00316030 0278 + S--#CHARACTERS TO SKIP AT START OF A 00316040 0278 + N--#CHARACTERS TO TAKE FROM A TO PUT ON OUTPUT LINE; 00316050 0278 + BEGIN INTEGER K; 00317000 0278 + START OF SEGMENT ********** 47 + INTEGER T; 00317100 0000 + IF CC GTR 1 AND CHRCOUNT GTR 0 THEN TERPRINT; 00318000 0000 + IF K:=LINESIZE LEQ 9 OR K GTR 72 THEN K:=72; 00319000 0002 + WHILE CHRCOUNT+N+BL GTR K DO 00320000 0007 + BEGIN 00321000 0009 + APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,T:=K-CHRCOUNT-BL); 00322000 0009 + CHRCOUNT:=K; TERPRINT; 00323000 0014 + S:=S+T; N:=N-T; 00324000 0015 + BL:=0; 00325000 0017 + END; 00326000 0018 + APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,N); 00327000 0019 + 00327900 0022 + CHRCOUNT:=CHRCOUNT+N+BL; 00328000 0022 + IF BOOLEAN(CC) THEN 00329000 0024 + IF CC=-1 THEN BEGIN LINETOG:=FALSE; 00329010 0024 + TERPRINT; LINETOG:=TRUE; 00329020 0027 + END ELSE TERPRINT; 00329030 0028 + END; 00330000 0029 + 47 IS 33 LONG, NEXT SEG 2 + PROCEDURE NUMBERCON(R,A); VALUE R; REAL R; ARRAY A[0]; 00331000 0278 + BEGIN FORMAT F(F24.*), G(E24.*); 00332000 0278 + START OF SEGMENT ********** 48 + START OF SEGMENT ********** 49 + 49 IS 8 LONG, NEXT SEG 48 + REAL S; DEFINE MAXIM = 10@9#; 00332010 0000 + 00333000 0000 + STREAM PROCEDURE ADJUST(A,B); 00334000 0000 + BEGIN LOCAL T,FRAC,MANT,T1,TSI,TDI; 00335000 0000 + DI:=LOC T; DI:=DI+1; T1:=DI; 00336000 0000 + SI:=B; DI:=A; DI:=DI+2; 00337000 0000 + 24(IF SC=" " THEN SI:=SI+1 ELSE 00338000 0001 + BEGIN TSI:=SI; SI:=LOC T; 00339000 0002 + IF SC="1" THEN; SI:=TSI; 00340000 0003 + IF TOGGLE THEN 00341000 0004 + IF SC NEQ "0" THEN 00342000 0004 + IF SC="@" THEN BEGIN 00343000 0005 + TSI:=SI; DI:=T1; DS:=LIT"1"; JUMP OUT; 00343010 0006 + END ELSE FRAC:=TALLY 00344000 0008 + ELSE TALLY := TALLY+0 00345000 0008 + ELSE 00346000 0009 + IF SC="." THEN 00347000 0009 + BEGIN MANT:=TALLY; TDI:=DI; DI:=LOC T; DS:= 00348000 0010 + LIT"1"; TALLY:=0;DI:=TDI; 00349000 0011 + END; 00350000 0012 + TALLY:=TALLY+1; DS:=CHR 00351000 0012 + END); 00352000 0012 + SI:=LOC MANT; SI:=SI+7; IF SC="0" THEN MANT:=TALLY; 00353000 0013 + 00354000 0014 + TALLY:=MANT; SI:=LOC FRAC; SI:=SI+7; IF SC GTR "0" 00355000 0014 + THEN TALLY:=TALLY+1; TALLY:=TALLY+FRAC; MANT:=TALLY; 00356000 0015 + SI:=T1; IF SC="1" THEN BEGIN 00356010 0017 + DI:=A; DI:=DI+MANT; DI:=DI+2; 00356020 0017 + SI:=TSI; DS:=4CHR; 00356030 0019 + TALLY:=TALLY+4; MANT:=TALLY; END; 00356040 0019 + SI:=LOC MANT; SI:=SI+6; DI:=A; DS:=2CHR; 00357000 0020 + END; 00358000 0021 + IF S:=ABS(R) GEQ MAXIM OR S LEQ 10*(-DIGITS) AND S NEQ 0 THEN 00358010 0021 + WRITE(SCR[*],G,DIGITS,R) ELSE 00358020 0028 + WRITE(SCR[*],F,DIGITS,R); 00359000 0041 + ADJUST(A,SCR) 00360000 0053 + END; 00361000 0055 + 48 IS 59 LONG, NEXT SEG 2 + PROCEDURE STOREPSR; 00361010 0278 + BEGIN INTEGER I; 00361020 0278 + START OF SEGMENT ********** 50 + DELETE1(WORKSPACE,0); 00361030 0000 + I:=STORESEQ(WORKSPACE,PSR,PSRSIZE×8); 00361040 0001 + COMMENT USED TO CALL WRAPUP; 00361050 0003 + END; 00361060 0003 + 50 IS 6 LONG, NEXT SEG 2 + PROCEDURE RESCANLINE; 00361070 0278 + BEGIN ADDRESS:=ABSOLUTEADDRESS; EOB:=0; END; 00361072 0278 + PROCEDURE PROCESS(MODE);VALUE MODE; INTEGER MODE; FORWARD; 00361100 0281 + PROCEDURE MESSAGEHANDLER; FORWARD; 00362000 0281 + PROCEDURE FUNCTIONHANDLER; FORWARD; 00362100 0281 + PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R; 00362105 0281 + INTEGER N;REAL ADDR;FORWARD; COMMENT LINE 5000000; 00362107 0281 + STREAM PROCEDURE SETFIELD(A,S,L,R); VALUE S,L,R; 00362110 0281 + BEGIN DI:=A; DI:=DI+S; SI:=LOC R; SI:=SI+8; L(SI:=SI-1); 00362120 0281 + DS:=L CHR; 00362130 0284 + END; 00362140 0285 + COMMENT: VALUE OF GETFIELD IS L CHARACTERS, STARTING AT J-TH 00362145 0285 + CHARACTER OF A, RIGHT-ADJUSTED. L MUST BE LEQ 8 AND 00362146 0285 + J MUST BE LESS THAT 64; 00362147 0285 + REAL STREAM PROCEDURE GETFIELD(A,S,L); VALUE S,L; 00362150 0285 + BEGIN SI:=A; SI:=SI+S; DI:=LOC GETFIELD; DI:=DI+8; L(DI:=DI-1); 00362160 0285 + DS:=L CHR; 00362170 0288 + END; 00362180 0289 + REAL PROCEDURE TOPLINE(ORD); VALUE ORD; INTEGER ORD; 00362200 0290 + BEGIN 00362210 0290 + INTEGER STREAM PROCEDURE CON(A); VALUE A; 00362220 0290 + START OF SEGMENT ********** 51 + BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT END; 00362230 0000 + ARRAY A[0:1]; INTEGER I; 00362240 0001 + I:=CONTENTS(ORD,SIZE(ORD)-1,A); 00362250 0003 + TOPLINE:=CON(A[0])/10000 00362260 0007 + END; 00362270 0008 + 51 IS 16 LONG, NEXT SEG 2 + BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR); 00500000 0290 + ARRAY SPECS[0]; REAL HADDR; 00500100 0290 + BEGIN 00500150 0290 + LABEL A,B,C; 00500200 0290 + START OF SEGMENT ********** 52 + INTEGER P; 00500300 0000 + DEFINE NOTE=HADDR.[24:24]:=ADDRESS#,P8=8×P+1#; 00500325 0000 + ERR:=0; 00500350 0000 + SPECS[0]:=SPECS[1]:=SPECS[2]:=SPECS[3]:=0; 00500400 0000 + NOTE; HADDR.[1:23]:=GT1:=ADDRESS; 00500450 0005 + IF SCAN AND IDENT THEN 00500500 0010 + BEGIN 00500600 0011 + TRANSFER(ACCUM,2,SPECS,1,7); 00500700 0012 + NOTE; 00500750 0015 + IF SCAN THEN 00500800 0017 + IF LFTARROW THEN 00500900 0017 + BEGIN 00501000 0020 + SPECS[1]:=1; 00501100 0020 + SPECS[3]:=1; 00501150 0022 + TRANSFER(SPECS,1,SPECS,33,7); 00501200 0023 + GT2:=ADDRESS; 00501250 0026 + IF SCAN AND IDENT THEN 00501300 0027 + BEGIN 00501400 0028 + TRANSFER(ACCUM,2,SPECS,1,7); 00501500 0029 + NOTE; 00501550 0032 + IF SCAN THEN 00501600 0034 + C: IF IDENT THEN 00501700 0034 + BEGIN 00501800 0036 + P:=(SPECS[3]:=SPECS[3]+1)+3; 00501850 0037 + TRANSFER(ACCUM,2,SPECS,P8,7); 00501900 0040 + SPECS[2]:=1; 00502000 0044 + NOTE; 00502050 0045 + IF SCAN THEN IF IDENT THEN 00502100 0047 + BEGIN SPECS[2]:=2; 00502200 0049 + P:=(SPECS[3]:=SPECS[3]+1)+2; 00502250 0051 + TRANSFER(SPECS,1,SPECS,P8+8,7); 00502300 0054 + TRANSFER(SPECS,P8,SPECS,1,7); 00502400 0058 + TRANSFER(ACCUM,2,SPECS,P8,7); 00502500 0062 + 00502550 0066 + B: NOTE; IF SCAN THEN 00502600 0066 + A: IF SEMICOLON THEN IF SCAN THEN 00502610 0069 + IF IDENT THEN 00502620 0074 + BEGIN 00502630 0075 + P:=(SPECS[3]:=SPECS[3]+1)+3; 00502640 0075 + TRANSFER(ACCUM,2,SPECS,P8,7); 00502650 0078 + GO TO B; 00502660 0082 + END ELSE GO TO A 00502670 0083 + ELSE ELSE ELSE 00502680 0083 + END ELSE GO TO A 00502690 0084 + ELSE END 00502700 0084 + ELSE GO TO A ELSE 00502800 0085 + END ELSE ERRORMESS(ERR:=1,GT2,0) 00502900 0085 + END ELSE GO TO C 00503000 0087 + ELSE 00503100 0088 + END ELSE ERRORMESS(ERR:=SYNTAXERROR,GT1,0); 00503200 0088 + FUNCTIONHEADER:=ERR=0; 00504500 0090 + ADDRESS:=HADDR.[24:24]; 00504550 0092 + END FUNCTIONHEADER; 00504600 0093 + 52 IS 97 LONG, NEXT SEG 2 + 00801810 0290 + INTEGER PROCEDURE DAYTIME(B); ARRAY B[0]; FORWARD; 02080000 0290 + COMMENT ON LINE 8014000, ARRAY B MUST HAVE LENGTH 02080010 0290 + AT LEAST 3 WDS; 02080020 0290 + PROCEDURE EDITLINE; FORWARD; 02080030 0290 + INTEGER PROCEDURE LENGTH(A,M);VALUE M; BOOLEAN M; ARRAY A[0]; 02080040 0290 + FORWARD; COMMENT LINE 8007900; 02080050 0290 + BOOLEAN PROCEDURE LABELSCAN(L,K); VALUE K; INTEGER K; 02080060 0290 + ARRAY L[0]; FORWARD; COMMENT LINE 8013910; 02080070 0290 + 02080080 0290 + 02080090 0290 + PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; FORWARD; 02080100 0290 + COMMENT ON LINE 8040000; 02080200 0290 + PROCEDURE RELEASEARRAY(D);VALUE D; REAL D; 03000500 0290 + BEGIN COMMENT RELEASE PERMANENT STORAGE FOR THE ARRAY DESC D; 03000510 0290 + INTEGER K,J,PT; 03000520 0290 + START OF SEGMENT ********** 53 + ARRAY BLOCK[0:32]; %SEE MAXWORDSTORE, LINE 17260 03000530 0000 + ARRAY TEMP[0:1]; 03000535 0001 + IF D.RF NEQ 0 THEN 03000540 0003 + BEGIN DELETE1(WS,D.DIMPTR); 03000550 0004 + K:=CONTENTS(WS,D.INPTR,BLOCK)-1; 03000560 0006 + DELETE1(WS,D.INPTR); 03000570 0010 + FOR J:=0 STEP 2 UNTIL K DO 03000580 0011 + BEGIN TRANSFER(BLOCK,J,TEMP,6,2); 03000585 0013 + PT:=TEMP[0]; DELETE1(WS,PT); END; 03000590 0016 + END; 03000600 0020 + END; 03000610 0020 + 53 IS 25 LONG, NEXT SEG 2 + PROCEDURE TRANSFERSP(DIR,SP,L,B,M,N); VALUE DIR,N,M,L; 03001000 0290 + INTEGER DIR,N,M,L; 03001100 0290 + ARRAY SP[0,0],B[0]; 03001200 0290 + BEGIN COMMENT 03001300 0290 + DIR= INTO: TRANSFER N WORDS FROM B[L] INTO SP[M] 03001400 0290 + (ACTUALLY SP[*,M] SINCE ARRAY ROW IS USUALLY THE ARG) 03001450 0290 + DIR= OUTOF (OPPOSITE); 03001500 0290 + STREAM PROCEDURE MOVER(DIR,SP,M,B,L,N); VALUE DIR, 03001600 0290 + START OF SEGMENT ********** 54 + L,M,N; 03001700 0000 + BEGIN LOCAL T; 03001800 0000 + SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR; 03001900 0000 + SI:=SP; T(16(SI:=SI+32)); L(SI:=SI+8); L:=SI; 03002000 0001 + SI:=LOC M; DI:=LOC T; DI:=DI+1; DS:=7CHR; 03002100 0005 + SI:=B; T(16(SI:=SI+32)); M(SI:=SI+8); M:=SI; 03002110 0006 + SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7CHR; 03002120 0010 + SI:=LOC DIR; SI:=SI+7; 03002130 0011 + IF SC="0" THEN 03002140 0011 + BEGIN SI:=M; DI:=L 03002150 0012 + END ELSE 03002160 0013 + BEGIN SI:=L ; DI:=M 03002170 0013 + END; 03002180 0013 + T(2(DS:=32WDS)); DS:=N WDS; 03002190 0013 + END; 03002200 0016 + INTEGER K; 03002210 0016 + WHILE N:=N-K GTR 0 DO 03002300 0016 + MOVER(DIR,SP[(L:=L+K)DIV SPRSIZE,*], 03002400 0019 + M:=M+K,B,K:=L MOD SPRSIZE, 03002500 0022 + K:=MIN(SPRSIZE-K,N)) 03002600 0025 + END; 03002700 0028 + 54 IS 32 LONG, NEXT SEG 2 + 03002800 0290 + PROCEDURE DUMPOLISH(SP,PD); VALUE PD; REAL PD; ARRAY SP[0,0]; 03008000 0290 + BEGIN INTEGER L; 03008100 0290 + START OF SEGMENT ********** 55 + LABEL SKIPREST; 03008150 0000 + INTEGER I,N,M,U; REAL T; 03008200 0000 + L:=PD.SPF; 03008300 0000 + I:=SP[LOC]+L; 03008400 0001 + FOR L:=L+2 STEP 1 UNTIL I DO 03008500 0004 + IF (T:=SP[LOC]).TYPEFIELD=FUNCTION THEN 03008510 0008 + BEGIN % OUTPUT MESSAGE AND NAME 03008520 0012 + FORMWD(2,"5FUNC: "); 03008530 0013 + N:=T.LOCFIELD; % N HAS LOCATION OF DESCRIPTOR 03008540 0014 + N:=N-1; % BACK UP ONE TO GET NAME 03008550 0015 + GTA[0]:=SP[NOC]; 03008560 0016 + FORMROW(1,1,GTA,1,7); 03008570 0019 + END 03008580 0022 + ELSE % MIGHT BE AN OPERATOR 03008590 0022 + IF T.TYPEFIELD=OPERATOR THEN 03008600 0022 + BEGIN COMMENT OUTPUT MESSAGE AND OP CODE; 03008610 0025 + FORMWD(2,"5ATOR: "); 03008620 0025 + NUMBERCON(T.OPTYPE,ACCUM); 03008623 0026 + FORMROW(0,1,ACCUM,2,ACOUNT); 03008626 0028 + NUMBERCON(T.LOCFIELD,ACCUM); 03008630 0031 + FORMROW(1,1,ACCUM,2,ACOUNT); 03008640 0033 + END ELSE %MAY BE A CONSTANT 03008650 0036 + IF T.TYPEFIELD=CONSTANT THEN 03008660 0036 + BEGIN COMMENT GET DATA DESCRIPTOR; 03008670 0040 + N:=T.LOCFIELD; 03008680 0040 + FORMWD(2,"5CONS: "); 03008690 0042 + T:=SP[NOC]; %T HAS THE DATA DESCRIPTOR 03008700 0043 + IF T.SPF=0 THEN BEGIN % A NULL VECTOR 03008702 0045 + FORMWD(1,"4NULL "); 03008704 0047 + GO TO SKIPREST; END; 03008706 0048 + N:=T.SPF; %N HAS THE SCALAR OR TOP OF VECTOR LOC. 03008710 0051 + IF BOOLEAN(T.SCALAR) THEN M:=U:=N ELSE 03008720 0052 + BEGIN U:=SP[NOC]+N; M:=N+1; %UPPER AND LOWER BOUNDS 03008730 0054 + END; 03008740 0059 + IF BOOLEAN(T.CHRMODE) THEN %CHARACTER FORMAT 03008741 0059 + BEGIN COMMENT SP[NOC] IS NUMBER OF CHRS; 03008742 0060 + TRANSFERSP(OUTOF,SP,M,BUFFER,0,ENTIER(((T:= 03008743 0061 + SP[NOC])-1)DIV 8+1)); 03008744 0063 + FORMROW(1,1,BUFFER,0,T); 03008745 0069 + END ELSE % SHOULD TEST FOR NULL...DO IT LATER. 03008746 0071 + FOR N:=M STEP 1 UNTIL U DO 03008750 0071 + BEGIN NUMBERCON(SP[NOC],ACCUM); 03008760 0074 + FORMROW(0,1,ACCUM,2,ACOUNT); 03008770 0077 + END; 03008780 0080 + TERPRINT; 03008790 0082 + SKIPREST: 03008795 0083 + END ELSE COMMENT MUST BE AN OPERAND; 03008800 0084 + IF T.TYPEFIELD=LOCALVAR THEN 03008810 0084 + BEGIN FORMWD(2,"5LOCL: "); 03008820 0085 + N:=T.SPF; % N HAS LOCATION OF NAME; 03008830 0087 + GTA[0]:=SP[NOC]; % PUT NAME IN GTA 03008840 0088 + FORMROW(1,1,GTA,1,7); 03008850 0091 + END ELSE 03008860 0094 + BEGIN COMMENT TREAT IT AS VARIABLE; 03008870 0094 + N:=T.LOCFIELD; COMMENT N HAS LOC OF DESCRIPTOR; 03008880 0096 + N:=N-1; COMMENT BACK UP OVER THE DESCRIPTOR; 03008890 0097 + GTA[0]:=SP[NOC]; 03008900 0098 + FORMWD(2,"5AND : "); 03008910 0101 + FORMROW(1,1,GTA,1,7); 03008920 0102 + END; 03008930 0105 + END; 03009000 0107 + 55 IS 112 LONG, NEXT SEG 2 + 03023400 0290 + PROCEDURE PROCESS(MODE); VALUE MODE; INTEGER MODE; 03100000 0290 + BEGIN 03100100 0290 + OWN INTEGER J; 03100105 0290 + START OF SEGMENT ********** 56 + OWN REAL RESULTD; 03100110 0000 + LABEL EXPOVRL,INTOVRL,INDEXL,FLAGL,ZEROL; 03100120 0000 + MONITOR EXPOVR,INTOVR,INDEX,FLAG,ZERO; 03100130 0000 + LABEL DEBUGSP; %DEBUGGING PURPOSES ONLY. 03100140 0004 + INTEGER PROCEDURE BUILDCONSTANT(LASTCONSTANT); 03100410 0004 + INTEGER LASTCONSTANT; FORWARD; 03100415 0004 + INTEGER PROCEDURE GETSPACE(LENGTH); VALUE LENGTH; 03100420 0004 + INTEGER LENGTH; FORWARD; 03100430 0004 + PROCEDURE OPERANDTOSYMTAB(L);VALUE L;INTEGER L;FORWARD; 03100432 0004 + REAL PROCEDURE BUILDALPHA(LASTCONSTANT); 03100440 0004 + INTEGER LASTCONSTANT; FORWARD; 03100445 0004 + INTEGER PROCEDURE BUILDNULL(LASTCONSTANT); 03100450 0004 + INTEGER LASTCONSTANT; FORWARD; 03100452 0004 + PROCEDURE SCRATCHDATA(D);VALUE D;REAL D; FORWARD; 03100460 0004 + COMMENT LINE 3121400; 03100462 0004 + PROCEDURE FORGETPROGRAM(U);VALUE U;REAL U; FORWARD; 03100470 0004 + COMMENT ANALYZE IS IN PROCESS BECAUSE OWN ARRAY SP 03100805 0004 + IS ADDRESSED INCORRECTLY OTHERWISE; 03100807 0004 + REAL PROCEDURE ANALYZE(DISPLAYOP); VALUE DISPLAYOP;BOOLEAN DISPLAYOP; 03100810 0004 + BEGIN COMMENT 03100840 0004 + BC= BUILDCONSTANT, 03100850 0004 + GS= GET SPACE PROCEDURE ; 03100860 0004 + ARRAY INFIX[0:MAXPOLISH]; 03100870 0004 + START OF SEGMENT ********** 57 + 03100880 0001 + INTEGER LASTCONSTANT; 03100890 0001 + DEFINE GS=GETSPACE#; 03100900 0001 + BOOLEAN STREAM PROCEDURE EQUAL(A,B); 03100910 0001 + BEGIN SI:=A; SI:=SI+1; DI:=B; DI:=DI+2; 03100920 0001 + IF 7SC=DC THEN TALLY:=1; 03100930 0004 + EQUAL:=TALLY; 03100940 0004 + END; 03100950 0005 + PROCEDURE UNSTACK(DEST,L,ORIG,OTOP,N,CHR1,CHR2); 03100960 0006 + VALUE N,CHR1,CHR2; 03100962 0006 + INTEGER N,CHR1,CHR2,L,OTOP; 03100970 0006 + ARRAY DEST[0,0],ORIG[0]; 03100980 0006 + BEGIN 03100990 0006 + REAL T,U; 03100992 0006 + START OF SEGMENT ********** 58 + WHILE OTOP GTR 0 AND N GTR 0 AND ERR=0 DO 03101000 0000 + IF(IF (T:=ORIG[OTOP]).TYPEFIELD=FUNCTION THEN FALSE ELSE 03101010 0003 + U:=T.LOCFIELD=CHR1 OR U=CHR2) THEN %UNSTACK 03101012 0006 + BEGIN 03101014 0009 + IF N GTR 1 THEN 03101020 0009 + IF U=CHR2 THEN ERR:=SYNTAXERROR ELSE 03101030 0010 + OTOP:=OTOP-1; 03101032 0013 + N:=N-1; 03101040 0015 + END ELSE 03101050 0016 + COMMENT WE ARE LOOKING AT AN OPERATOR OR A FUNCTION; 03101060 0016 + 03101070 0016 + 03101080 0016 + BEGIN 03101090 0016 + IF J NEQ 0 THEN 03101100 0016 + BEGIN L:=L+1; 03101110 0017 + DEST[LOC]:=ORIG[OTOP] 03101120 0019 + END; 03101130 0022 + OTOP:=OTOP-1 03101140 0022 + END; 03101150 0023 + IF N GTR 1 THEN ERR:=SYNTAXERROR; 03101160 0024 + END; 03101170 0026 + 58 IS 30 LONG, NEXT SEG 57 + INTEGER ITOP,K,L,I; 03101180 0006 + INTEGER M,N,FLOC; REAL T; 03101182 0006 + LABEL SKIPSCAN,FILLER; 03101184 0006 + LABEL SPFULLAB; 03101190 0006 + 03101200 0006 + 03101202 0006 + PROCEDURE FORGETSPACE(L,LENGTH,SP); VALUE L,LENGTH; 03101210 0006 + INTEGER L,LENGTH; ARRAY SP[0,0]; 03101220 0006 + BEGIN IF LENGTH GTR 0 THEN 03101222 0006 + BEGIN SP[LOC]:=SP[0,0]; 03101230 0006 + SP[LOC].LEN:=LENGTH; SP[0,0]:=L 03101240 0011 + END; 03101242 0016 + END; 03101250 0017 + 03101251 0017 + IF CURRENTMODE=FUNCMODE OR STACKBASE=0 THEN FLOC:=0 ELSE 03101252 0017 + 03101253 0021 + BEGIN L:=STACKBASE+1;L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L; 03101254 0021 + FLOC:= IF M=L OR BOOLEAN(T:=SP[MOC]).SUSPENDED THEN 0 ELSE T.SPF 03101256 0031 + 03101257 0036 + END; 03101258 0036 + 03101260 0037 + T:=ADDRESS; 03101270 0037 + ITOP:=0; 03101280 0038 + DO 03101290 0039 + SKIPSCAN: 03101300 0039 + IF ITOP LSS MAXPOLISH THEN 03101350 0040 + BEGIN 03101400 0040 + INFIX[ITOP:=ITOP+1].ADDRFIELD:=T; 03101450 0041 + IF SPECIAL THEN 03101500 0044 + IF QUOTEV THEN % CONSTANT VECTOR 03101510 0045 + BEGIN INFIX[ITOP].TYPEFIELD:=CONSTANT; 03101515 0047 + IF T:=BUILDALPHA(LASTCONSTANT) NEQ 0 THEN 03101520 0050 + INFIX[ITOP].LOCFIELD:=T ELSE ERR:=SYNTAXERROR 03101525 0051 + END ELSE % ORDINARY OPERATOR 03101530 0055 + BEGIN INFIX[ITOP].TYPEFIELD:=OPERATOR; 03101550 0056 + INFIX[ITOP].LOCFIELD:=ENTIER(ACCUM[0]); 03101600 0059 + END ELSE 03101650 0062 + IF NUMERIC THEN 03101700 0062 + IF ERR NEQ 0 THEN COMMENT NOTHING; ELSE 03101710 0065 + BEGIN INFIX[ITOP].TYPEFIELD:=CONSTANT; 03101750 0067 + IF CURRENTMODE=FUNCMODE THEN 03101760 0070 + COMMENT DO NOT STORE NUMERIC IN SCRATCH PAD; 03101765 0071 + DO UNTIL NOT SCAN OR NOT NUMERIC %THE NULL STATEMENT 03101770 0071 + ELSE 03101780 0073 + BEGIN 03101790 0074 + T:=BUILDCONSTANT(LASTCONSTANT); 03101800 0074 + IF T=0 THEN ERR:=IF ERR=0 THEN VALUEERROR ELSE ERR ELSE 03101850 0076 + INFIX[ITOP].LOCFIELD:=T; 03101860 0080 + END; 03101870 0083 + IF EOB=0 AND ERR=0 THEN GO TO SKIPSCAN; 03101900 0083 + END ELSE 03101950 0085 + IF IDENT THEN 03102000 0085 + BEGIN INFIX[ITOP].DID:=OPERAND; %SET OPTYPE=NILADIC 03102050 0087 + IF NOT(FUNCMODE EQL CURRENTMODE) THEN 03102100 0090 + BEGIN J:=0; 03102150 0091 + IF FLOC GTR 0 THEN %CHECK LOCAL NAMES 03102200 0092 + BEGIN L:=FLOC+2; 03102250 0093 + K:=SP[LOC]-2;%LAST ALPHA POINTER IN TABLE 03102350 0094 + %SHOULD CONVERT TO BINARY SEARCH 03102390 0098 + T:=L+4; 03102392 0098 + FOR L:=T STEP 2 UNTIL K DO 03102400 0099 + IF EQUAL(SP[LOC],ACCUM) THEN 03102420 0100 + BEGIN J:=L;L:=K;I:=0; 03102430 0103 + INFIX[ITOP].SPF:=J; 03102440 0106 + INFIX[ITOP].RF:=M-FLOC; 03102442 0109 + J:=(J-T+2)/2; 03102450 0112 + END; 03102460 0114 + END; 03102500 0116 + 03102510 0116 + 03102550 0116 + IF J EQL 0 THEN 03102600 0116 + BEGIN COMMENT LOOK IN SP SYMBOL TABLE; 03102650 0117 + IF L:=SYMBASE NEQ 0 THEN COMMENT OK TO LOOK; 03102700 0117 + BEGIN T:=SP[LOC];K:=L+T; 03102750 0119 + COMMENT T=N VARS TIMES 2. K IS TOP LIMIT; 03102800 0123 + FOR L:=L +1 STEP 2 UNTIL K DO 03102850 0123 + IF EQUAL(SP[LOC],ACCUM) THEN 03102900 0128 + BEGIN 03102925 0131 + INFIX[ITOP].TYPEFIELD:=I:=SP[LOC].TYPEFIELD; 03102950 0132 + L:=J:=L+1; 03102960 0137 + IF I=FUNCTION THEN BEGIN 03102961 0139 + INFIX[ITOP].RF:=SP[LOC].RETURNVALUE; 03102962 0140 + INFIX[ITOP].OPTYPE:=SP[LOC].NUMBERARGS;END; 03102965 0145 + L:=K; 03102970 0150 + END; 03102980 0151 + IF J EQL 0 THEN 03103000 0152 + IF T LSS MAXSYMBOL×2 THEN %INSERT ID 03103050 0152 + BEGIN L:=K+1; %NEXT AVAILABLE. 03103100 0154 + FILLER: SETFIELD(GTA,0,1,0); 03103180 0156 + TRANSFER(ACCUM,2,GTA,1,7); 03103200 0158 + SP[LOC]:=GTA[0];%STORE VARIABLE NAME 03103225 0161 + OPERANDTOSYMTAB(L);%SET TYPEFIELD AND DESC. 03103250 0165 + IF GT1=FUNCTION THEN%FUNCTION-FIX INFIX 03103300 0165 + BEGIN 03103325 0166 + INFIX[ITOP].OPTYPE:=GTA[1].NUMBERARGS; 03103326 0167 + INFIX[ITOP].TYPEFIELD:=FUNCTION; 03103330 0170 + INFIX[ITOP].RF:=GTA[1].RETURNVALUE; 03103350 0172 + END; 03103400 0176 + J:=L+1; 03103425 0176 + L:=SYMBASE;SP[LOC]:=T+2;%UPDATE SYM TAB # 03103430 0177 + END ELSE SPFULLAB: ERR:=SPERROR;%TAB FULL 03103450 0181 + END ELSE %CREATE SYMBOL TABLE 03103500 0183 + BEGIN 03103550 0183 + SYMBASE:=L:=GS(MAXSYMBOL×2+1); 03103600 0184 + IF ERR NEQ 0 THEN 03103610 0187 + BEGIN SYMBASE:=0; 03103620 0188 + GO TO SPFULLAB; 03103630 0190 + END; 03103640 0190 + T:=0; L:=L+1; 03103650 0190 + GO TO FILLER; 03103700 0192 + END 03103750 0193 + END ELSE INFIX[ITOP].DID:=LOCALVAR&1[44:47:1]; 03103800 0193 + INFIX[ITOP].LOCFIELD:=J 03103850 0197 + END 03103900 0198 + END ELSE ERR:=SYSTEMERROR; 03103950 0199 + IF ERR EQL 0 THEN T:=ADDRESS 03104000 0200 + END ELSE ERR:=SPERROR 03104050 0202 + UNTIL NOT(SCAN AND ERR=0); %DROP THRU WHEN INPUT FIN OR ERR 03104060 0203 + COMMENT NOW LOOK FOR THE POLISH; 03104100 0206 + IF ERR NEQ 0 THEN 03104150 0206 + BEGIN ERRORMESS(ERR,INFIX[ITOP].ADDRFIELD,0); 03104200 0207 + END ELSE 03104250 0209 + BEGIN COMMENT MAKE UP THE POLISH; 03104300 0209 + ARRAY OPERATORS[0:ITOP]; 03104350 0210 + START OF SEGMENT ********** 59 + BOOLEAN PROCEDURE ANDORATOR (VAR,TYPE); 03104356 0003 + VALUE VAR, TYPE; 03104358 0003 + REAL VAR,TYPE; 03104360 0003 + BEGIN 03104362 0003 + REAL T; 03104363 0003 + START OF SEGMENT ********** 60 + LABEL OPERAN, ATOR; 03104364 0000 + COMMENT PROCEDURE TRUE IF VAR IS OF TYPE SPECIFIED; 03104366 0000 + IF T:=VAR.TYPEFIELD=OPERATOR THEN 03104368 0000 + IF T:=VAR.LOCFIELD NEQ RGTPARENV AND T NEQ 03104370 0001 + QQUAD AND T NEQ QUAD AND T NEQ 03104371 0004 + RGTBRACKETV THEN GO ATOR 03104372 0006 + ELSE GO OPERAN 03104374 0007 + ELSE 03104376 0008 + IF T=FUNCTION THEN 03104378 0008 + IF VAR.OPTYPE GTR NILADIC THEN 03104380 0009 + ATOR: ANDORATOR:=TYPE=OPERATOR 03104382 0011 + ELSE GO OPERAN 03104384 0012 + ELSE 03104386 0013 + OPERAN: ANDORATOR:=TYPE=OPERAND; 03104388 0013 + END OF ANDORATOR; 03104390 0015 + 60 IS 19 LONG, NEXT SEG 59 + BOOLEAN PROCEDURE RGTOPERAND(VAR); VALUE VAR; REAL VAR; 03104391 0003 + BEGIN REAL T; DEFINE RT=RGTOPERAND:=TRUE#; 03104392 0003 + START OF SEGMENT ********** 61 + IF T:=VAR.TYPEFIELD=OPERAND OR T=CONSTANT OR T=LOCALVAR THEN RT 03104393 0000 + ELSE IF T=OPERATOR AND VAR.LOCFIELD=LFTPARENV THEN RT 03104394 0004 + ELSE IF T=FUNCTION AND VAR.OPTYPE LEQ MONADIC THEN RT; 03104395 0008 + END OF RGTOPERAND; 03104396 0013 + 61 IS 17 LONG, NEXT SEG 59 + BOOLEAN VALID; 03104398 0003 + INTEGER OTOP; 03104400 0003 + INTEGER BCT,N; REAL COLONCTR; 03104402 0003 + LABEL STACKOPERAND, STACKFUNCTION; 03104425 0003 + DEFINE PTOP=L#; 03104450 0003 + LABEL AROUND, NOK, OK, LFTARROWL, LFTPARENL, RGTPARENL, 03104455 0003 + SLASHL,EXPL,ROTL,MONADICL,DYADICL,ERRL,SORTL, 03104456 0003 + SEMICOLONL, QUADL, DOTL, RELATIONL, 03104457 0003 + LFTBRACKETL, RGTBRACKETL, QUOTEQUADL; 03104458 0003 + SWITCH OPERATORSWITCH:= % IN GROUPS OF 5, STARTING AT 1 03104459 0003 + NOK, NOK, NOK, LFTARROWL, % 1-4 03104461 0006 + MONADICL, SLASHL, OK, LFTPARENL,RGTPARENL, %5-9 03104463 0006 + QUADL,LFTBRACKETL,RGTBRACKETL,ERRL,QUOTEQUADL, %10-14 03104465 0006 + SEMICOLONL, OK, DOTL, OK, OK, % 15-19 03104467 0006 + OK,DYADICL,DYADICL,MONADICL,RELATIONL, % 20-24 03104469 0006 + RELATIONL, RELATIONL, RELATIONL, RELATIONL, 03104471 0006 + RELATIONL, % 25-29 03104472 0006 + OK, OK, OK, OK, OK, % 30-34 03104473 0006 + OK, OK, ROTL, EXPL, OK, % 35-39 03104475 0006 + OK,OK,OK,OK,DYADICL, % 40-44 03104477 0006 + OK, OK, ERRL, OK, OK, % 45-49 03104479 0006 + OK, NOK, NOK, NOK, OK, % 50-54 03104481 0006 + SORTL,SORTL,OK,OK,OK, % 55-59 03104483 0006 + DYADICL, DYADICL, MONADICL; % 60-62 03104484 0006 + %----------------------------------------------- 03104500 0038 + COMMENT GET AN AREA OF SCRATCH PAD IF WE ARE NOT IN 03104550 0038 + THE SYNTAX CHECKING MODE; 03104600 0038 + J:=(IF CURRENTMODE=FUNCMODE THEN 0 ELSE 03104650 0038 + GS(ITOP+3)); 03104700 0041 + I:=ITOP+1; 03104750 0043 + COMMENT A QUICK SYNTAX CHECK; 03104774 0044 + IF ANDORATOR(INFIX[ITOP],OPERATOR) THEN ERR:=SYNTAXERROR; 03104775 0044 + L:=J+1; COMMENT POLISH WILL START TWO UP IN ARRAY; 03104800 0046 + WHILE ERR=0 AND I GTR 1 DO 03104815 0048 + IF T:=INFIX[I:=I-1].TYPEFIELD=OPERATOR THEN 03104817 0050 + BEGIN 03104818 0053 + GO OPERATORSWITCH[INFIX[I].LOCFIELD]; 03104821 0053 + ROTL: 03104823 0056 + IF I=1 OR NOT ANDORATOR(INFIX[I-1],OPERAND) THEN GO OK; 03104825 0057 + T:=INFIX[I]; 03104826 0060 + T.LOCFIELD:=ROTATE; 03104827 0061 + T.OPTYPE:=IF INFIX[I].OPTYPE NEQ DYADIC THEN MONADIC ELSE DYADIC; 03104828 0063 + INFIX[I]:=T; GO TO STACKFUNCTION; 03104829 0068 + EXPL: 03104830 0069 + SLASHL: BEGIN DEFINE STARTSEGMENT= #; %///////////////////// 03104831 0070 + START OF SEGMENT ********** 62 + IF INFIX[I-1].TYPEFIELD=FUNCTION THEN GO ERRL ELSE 03104832 0000 + IF ANDORATOR(INFIX[I-1],OPERATOR) THEN 03104833 0005 + BEGIN 03104835 0007 + INFIX[I].LOCFIELD:=IF INFIX[I].LOCFIELD=SLASHV THEN 03104837 0008 + REDUCT ELSE SCANV; 03104838 0010 + 03104839 0013 + IF INFIX[I].OPTYPE NEQ DYADIC THEN INFIX[I].OPTYPE:=MONADIC; 03104840 0013 + GO OK; 03104843 0017 + END 03104845 0020 + ELSE 03104847 0020 + 03104849 0020 + IF INFIX[I].OPTYPE NEQ DYADIC THEN INFIX[I].OPTYPE:=MONADIC; 03104851 0020 + IF I=1 THEN 03104857 0025 + 03104859 0026 + BEGIN 03104861 0026 + ERR:=SYNTAXERROR; 03104863 0026 + GO AROUND; 03104865 0027 + END; 03104867 0030 + GO OK; END; 03104869 0030 + 62 IS 34 LONG, NEXT SEG 59 + SORTL: 03104870 0071 + IF I=1 OR ANDORATOR(INFIX[I-1],OPERATOR) THEN GO OK ELSE GO ERRL; 03104871 0071 + LFTPARENL: 03104873 0074 + K:=I; 03104874 0075 + UNSTACK(SP,PTOP,OPERATORS,OTOP,2,RGTPARENV,RGTBRACKETV); 03104875 0075 + GO AROUND; 03104876 0079 + RELATIONL: 03104878 0079 + DYADICL: 03104880 0080 + IF I GTR 1 THEN 03104881 0080 + IF ANDORATOR(INFIX[I-1],OPERAND) THEN 03104882 0080 + BEGIN 03104884 0083 + INFIX[I].OPTYPE:=DYADIC; 03104885 0083 + GO STACKFUNCTION; 03104886 0086 + END; 03104887 0086 + IF (GT3:=(T:=INFIX[I+1]).LOCFIELD=REDUCT OR GT3=SCANV) 03104888 0086 + AND T.TYPEFIELD=OPERATOR THEN GO OK; 03104889 0090 + IF(T:=INFIX[I-1]).LOCFIELD=DOTV AND T.TYPEFIELD=OPERATOR THEN GO OK; 03104890 0092 + GO TO ERRL; 03104891 0096 + MONADICL: 03104892 0098 + IF I=1 OR ANDORATOR(INFIX[I-1],OPERATOR) 03104894 0098 + THEN BEGIN 03104896 0100 + INFIX[I].OPTYPE:=MONADIC; 03104897 0101 + GO TO STACKFUNCTION; 03104900 0103 + END 03104902 0104 + ELSE 03104904 0104 + GO ERRL; 03104906 0104 + LFTBRACKETL: 03104910 0104 + IF BCT:=BCT-1 LSS 0 THEN ERR:=SYNTAXERROR; 03104935 0105 + UNSTACK(SP,PTOP,OPERATORS,OTOP,1,RGTBRACKETV,RGTPARENV); 03104950 0108 + IF OTOP=1 THEN BEGIN 03104981 0111 + ERR:=SYNTAXERROR; GO AROUND; END 03104984 0112 + ELSE IF J NEQ 0 THEN 03104987 0114 + BEGIN 03104990 0115 + IF T:=INFIX[I-1].TYPEFIELD=OPERAND OR T=LOCALVAR THEN 03104995 0115 + BEGIN DEFINE STARTSEGMENT= #; %////////////////////////// 03105000 0119 + START OF SEGMENT ********** 63 + %LFTBRACKET PART OF SUBSCRIPTED VARIABLE 03105001 0000 + IF OPERATORS[OTOP].OPTYPE=0 THEN GO TO ERRL; 03105002 0000 + COMMENT IF ABOVE TRUE THEN THERE WAS AN OPERAND TO THE RITE; 03105003 0004 + L:=L+1; 03105004 0004 + N:=GT1:=GETSPACE(1); 03105006 0006 + SP[NOC]:=COLONCTR+1; % STORE NUMBER OF DIMENSIONS 03105009 0007 + N:=GETSPACE(1); % BUILD A DESCRIPTOR FOR # OF DIMENSIONS 03105012 0011 + T.SPF:=GT1; 03105015 0012 + T.DID:=DDPNSW; 03105018 0014 + T.BACKP:=LASTCONSTANT; 03105021 0016 + SP[NOC]:=T; 03105024 0017 + T:=INFIX[I]; 03105027 0020 + T.LOCFIELD:=LASTCONSTANT:=N; % LINK TO CONSTANT CHAIN 03105030 0021 + T.TYPEFIELD:=CONSTANT; 03105033 0024 + SP[LOC]:=T; % PUT ON POLISH 03105036 0025 + L:=L+1; 03105039 0028 + IF OPERATORS[OTOP].OPTYPE=3 THEN % LEFT SIDE OF REPLACEOP 03105040 0030 + INFIX[I-1].TYPEFIELD:=REPLACELOC; 03105041 0031 + SP[LOC]:=INFIX[I-1]; % PLACE OPERAND ON POLISH 03105042 0035 + L:=L+1; 03105043 0038 + SP[LOC]:=INFIX[I]; % COLLAPSE OPERATOR TO POLISH 03105044 0040 + I:=I-1; 03105045 0043 + END 03105046 0044 + ELSE IF T:=INFIX[I-1].LOCFIELD=SLASHV OR 03105047 0044 + 63 IS 45 LONG, NEXT SEG 59 + T=EXPANDV OR T=ROTV OR T=SORTUPV OR T=SORTDNV THEN 03105048 0124 + IF INFIX[I-1].TYPEFIELD=OPERATOR AND OPERATORS[OTOP] 03105049 0128 + .OPTYPE=0 THEN INFIX[I-1].OPTYPE:=DYADIC 03105050 0130 + ELSE ERR:=SYNTAXERROR 03105051 0134 + ELSE ERR:=SYNTAXERROR; 03105053 0136 + END; 03105054 0138 + COLONCTR:=OPERATORS[OTOP:=OTOP-1]; 03105056 0138 + IF OTOP:=OTOP-1 LSS 0 THEN ERR:=SYNTAXERROR; 03105059 0140 + GO AROUND; 03105070 0143 + RGTPARENL: 03105085 0143 + IF OTOP LSS ITOP DIV 2 THEN ELSE ERR:=SYNTAXERROR; 03105087 0144 + OPERATORS[OTOP:=OTOP+1]:=INFIX[I]; 03105090 0147 + GO AROUND; 03105100 0149 + RGTBRACKETL: BEGIN DEFINE STARTSEGMENT= #; %/////////////////// 03105115 0150 + START OF SEGMENT ********** 64 + BCT:=BCT+1; 03105130 0000 + IF OTOP+2 GEQ ITOP THEN 03105132 0001 + BEGIN 03105134 0002 + ERR:=SYNTAXERROR; 03105136 0003 + GO AROUND; 03105138 0003 + END; 03105140 0006 + OPERATORS[OTOP:=OTOP+1]:=COLONCTR; 03105145 0006 + GT1:=OPERATORS[OTOP:=OTOP+1]:=INFIX[I]; COLONCTR:=0; 03105150 0008 + IF I NEQ ITOP THEN 03105152 0012 + IF GT1.OPTYPE NEQ 3 THEN 03105154 0013 + OPERATORS[OTOP].OPTYPE:=IF RGTOPERAND(INFIX[I+1]) THEN 03105156 0015 + 0 ELSE 2 03105158 0018 + ELSE 03105159 0019 + ELSE OPERATORS[OTOP].OPTYPE:=2; 03105160 0020 + IF J NEQ 0 AND INFIX[I-1].LOCFIELD=SEMICOLONV THEN 03105161 0024 + BEGIN 03105163 0027 + T.LOCFIELD:=BUILDNULL(LASTCONSTANT); 03105165 0027 + T.TYPEFIELD:=CONSTANT; 03105167 0030 + L:=L+1; K:=I; 03105169 0031 + SP[LOC]:=T; 03105171 0033 + END; 03105173 0036 + GO AROUND; END; 03105175 0036 + 64 IS 40 LONG, NEXT SEG 59 + LFTARROWL: 03105178 0151 + IF I=1 THEN ERR:=SYNTAXERROR 03105180 0151 + ELSE 03105182 0152 + IF T:=INFIX[I-1].TYPEFIELD=OPERAND OR T=LOCALVAR THEN 03105184 0153 + INFIX[I-1].TYPEFIELD:=REPLACELOC 03105186 0157 + ELSE 03105188 0159 + IF T=OPERATOR THEN 03105190 0160 + IF T:=INFIX[I-1].LOCFIELD=QUAD OR T=QUADLFTARROW THEN 03105192 0161 + INFIX[I:=I-1].LOCFIELD:=QUADLFTARROW 03105194 0165 + ELSE IF T=RGTBRACKETV THEN INFIX[I-1].OPTYPE:=3 03105195 0168 + %WILL TEST LATER TO INDICATE REPLACEMENT IN MATRIX 3105154 03105196 0173 + ELSE ERR:=SYNTAXERROR 03105197 0173 + ELSE ERR:=SYNTAXERROR; 03105198 0175 + IF ERR=0 THEN GO OK ELSE GO AROUND; 03105200 0177 + QUOTEQUADL: 03105202 0178 + QUADL: 03105204 0179 + COMMENT INPUT IS BEING REQUESTED; 03105205 0179 + GO TO STACKOPERAND; 03105206 0179 + DOTL: BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// 03105207 0179 + START OF SEGMENT ********** 65 + IF I GTR 2 THEN 03105208 0000 + IF (T:=INFIX[I-1]).TYPEFIELD=OPERATOR AND 03105209 0000 + ANDORATOR(T,OPERATOR) THEN 03105211 0003 + IF (T:=INFIX[I+1]).TYPEFIELD=OPERATOR AND 03105213 0005 + ANDORATOR(T,OPERATOR) THEN 03105215 0008 + IF ANDORATOR(INFIX[I-2],OPERAND) THEN 03105216 0009 + COMMENT THEN SYNTAX OK; 03105217 0011 + BEGIN 03105223 0011 + COMMENT STACK OPERATORS SO THAT IF GIVEN A+.XB 03105225 0012 + POLISH IS BA.+X; 03105227 0012 + OPERATORS[OTOP].OPTYPE:=TRIADIC; 03105228 0012 + OPERATORS[OTOP:=OTOP+1]:=INFIX[I-1]; 03105229 0014 + INFIX[I].OPTYPE:=TRIADIC; 03105231 0017 + OPERATORS[OTOP:=OTOP+1]:=INFIX[I]; 03105232 0020 + I:=I-1; 03105233 0022 + VALID:=TRUE; 03105234 0023 + END; 03105235 0024 + IF NOT VALID THEN ERR:=SYNTAXERROR; 03105237 0024 + VALID:=FALSE; 03105239 0026 + GO AROUND; END; 03105241 0027 + 65 IS 31 LONG, NEXT SEG 59 + SEMICOLONL: BEGIN DEFINE STARTSEGMENT=#; %///////////////////// 03105242 0181 + START OF SEGMENT ********** 66 + IF BCT NEQ 0 THEN 03105244 0000 + BEGIN 03105246 0000 + COLONCTR:=COLONCTR+1; 03105248 0001 + IF I-1=0 THEN ERR:=SYNTAXERROR 03105250 0002 + ELSE 03105260 0004 + BEGIN 03105263 0005 + UNSTACK(SP,PTOP,OPERATORS,OTOP,1,RGTBRACKETV,RGTPARENV); 03105265 0005 + IF J NEQ 0 AND (T:=INFIX[I-1].LOCFIELD=SEMICOLONV 03105270 0009 + OR T =LFTBRACKETV) THEN BEGIN 03105280 0012 + T.LOCFIELD:=BUILDNULL(LASTCONSTANT); 03105290 0014 + T.TYPEFIELD:=CONSTANT; 03105300 0016 + L:=L+1; K:=I; 03105310 0018 + SP[LOC]:=T; 03105320 0020 + END; 03105330 0023 + END 03105340 0023 + END 03105350 0023 + ELSE COMMENT MUST BE MIXED MODE EXPRESSION; 03105370 0023 + BEGIN 03105383 0023 + IF ANDORATOR(T:=INFIX[I-1],OPERATOR) THEN 03105385 0023 + IF T.LOCFIELD NEQ SEMICOLONV THEN GO ERRL; 03105390 0025 + UNSTACK(SP,PTOP,OPERATORS,OTOP,1,RGTPARENV,RGTBRACKETV); 03105395 0030 + OPERATORS[OTOP:=OTOP+1]:=INFIX[I]; 03105400 0034 + END; 03105403 0036 + GO AROUND; 03105405 0036 + END; 03105407 0039 + 66 IS 40 LONG, NEXT SEG 59 + NOK: 03105655 0182 + ERR:=SYSTEMERROR; 03105660 0182 + GO AROUND; 03105661 0182 + ERRL: 03105662 0183 + ERR:=SYNTAXERROR; 03105663 0184 + GO AROUND; 03105665 0184 + OK: 03105668 0185 + IF INFIX[I].OPTYPE NEQ 0 THEN GO TO STACKFUNCTION ELSE 03105669 0186 + IF I LSS 2 THEN INFIX[I].OPTYPE:=MONADIC ELSE 03105670 0187 + INFIX[I].OPTYPE:=IF ANDORATOR(INFIX[I-1],OPERATOR) THEN 03105671 0191 + MONADIC ELSE DYADIC; 03105672 0195 + 03105673 0197 + 03105674 0197 + STACKFUNCTION: 03105675 0197 + IF I=K-1 THEN OPERATORS[OTOP:=OTOP+1]:=INFIX[I] 03105677 0198 + ELSE 03105680 0201 + BEGIN 03105682 0202 + UNSTACK(SP,PTOP,OPERATORS,OTOP,1,RGTPARENV,RGTBRACKETV); 03105685 0202 + OPERATORS[OTOP:=OTOP+1]:=INFIX[I]; 03105700 0206 + END; 03105710 0208 + GO AROUND; 03105715 0208 + AROUND: 03105717 0209 + END % OF PROCESSING AN OPERATOR---- 03105720 0210 + ELSE % COULD BE A FUNCTION 03105722 0210 + IF INFIX[I].TYPEFIELD=FUNCTION THEN 03105724 0210 + IF (T:=INFIX[I]).OPTYPE GEQ MONADIC THEN 03105726 0212 + GO TO STACKFUNCTION 03105728 0214 + ELSE 03105730 0214 + IF T.RF=RETURNVAL THEN GO TO STACKOPERAND 03105732 0214 + ELSE % MUST NOT RETURN A VALUE 03105734 0216 + IF I=1 THEN GO TO STACKOPERAND 03105736 0216 + ELSE ERR:=SYNTAXERROR 03105738 0217 + ELSE % MUST BE AN OPERAND, CONSTANT OR LOCAL 03105740 0218 + STACKOPERAND: 03105742 0218 + BEGIN DEFINE STARTSEGMENT=#; %////////////////////////// 03105744 0220 + START OF SEGMENT ********** 67 + IF ITOP=1 THEN ELSE 03105746 0000 + IF I=ITOP AND I NEQ 1 THEN 03105748 0001 + IF ANDORATOR(INFIX[I-1],OPERAND) THEN 03105750 0003 + IF INFIX[I-1].LOCFIELD=RGTBRACKETV THEN 03105751 0005 + ELSE GO ERRL 03105752 0008 + ELSE 03105754 0009 + ELSE 03105758 0012 + IF I=1 AND I NEQ ITOP THEN 03105760 0012 + IF RGTOPERAND(INFIX[I+1]) THEN GO ERRL 03105762 0014 + ELSE 03105764 0017 + ELSE 03105766 0020 + IF ANDORATOR(INFIX[I-1],OPERAND) OR RGTOPERAND(INFIX[I+1]) 03105768 0020 + THEN 03105770 0023 + IF INFIX[I-1].LOCFIELD=RGTBRACKETV THEN 03105772 0024 + ELSE GO ERRL; 03105773 0027 + IF J NEQ 0 THEN 03105774 0030 + BEGIN L:=L+1; 03105775 0031 + SP[LOC]:=INFIX[I]; 03105790 0033 + END; K:=I; 03105800 0036 + UNSTACK(SP,PTOP,OPERATORS,OTOP,1,RGTPARENV,RGTBRACKETV); 03105820 0037 + END; % OF GOING THROUGH INFIX 03105835 0040 + 67 IS 42 LONG, NEXT SEG 59 + IF ERR NEQ 0 THEN ERRORMESS(ERR,INFIX[I].ADDRFIELD,0) ELSE 03105850 0221 + WHILE OTOP GTR 0 AND ERR=0 DO 03105900 0224 + BEGIN IF T:=OPERATORS[OTOP].LOCFIELD=RGTPARENV OR 03105950 0227 + T=RGTBRACKETV THEN 03105952 0229 + IF OPERATORS[OTOP].TYPEFIELD=OPERATOR THEN 03105960 0230 + ERRORMESS(ERR:=SYNTAXERROR,OPERATORS[OTOP].ADDRFIELD 03106000 0232 + ,0); 03106001 0234 + IF J NEQ 0 THEN 03106050 0235 + BEGIN L:=L+1; 03106100 0236 + SP[LOC]:=OPERATORS[OTOP] 03106150 0238 + END; OTOP:=OTOP-1; 03106200 0240 + END; 03106250 0242 + IF J NEQ 0 AND DISPLAYOP THEN 03106252 0243 + IF SP[LOC].TYPEFIELD NEQ OPERATOR OR 03106254 0244 + T:=SP[LOC].LOCFIELD NEQ LFTARROWV 03106255 0248 + AND T NEQ QUADLFTARROW AND T NEQ GOTOV THEN 03106256 0251 + BEGIN COMMENT ADD DISPLAY OPERATOR TO POLISH; 03106258 0254 + L:=L+1; 03106260 0254 + T.TYPEFIELD:=OPERATOR; 03106262 0255 + T.OPTYPE:=MONADIC; 03106263 0257 + T.LOCFIELD:=QUADLFTARROW; 03106264 0259 + SP[LOC]:=T; 03106266 0261 + END; 03106272 0264 + IF J NEQ 0 THEN 03106300 0264 + IF ERR NEQ 0 THEN FORGETSPACE (J,ITOP+3,SP) ELSE 03106350 0264 + COMMENT STORE POLISH AND BUFFER; 03106400 0269 + BEGIN COMMENT SAVE LENGTH OF POLISH; 03106450 0269 + DEFINE STARTSEGMENT=#; %//////////////////////////////////// 03106452 0269 + START OF SEGMENT ********** 68 + T:=L-J; % DELETE ANY EXTRA SPACE ALLOCATED FOR POLISH 03106500 0000 + IF T LSS ITOP+2 THEN FORGETSPACE(L+1,2+ITOP-T,SP); 03106525 0001 + COMMENT THEN GETSPACE FOR BUFFER; 03106535 0006 + L:=GS(((K:=LENGTH(BUFFER, CURRENTMODE= 03106550 0006 + CALCMODE))-1) DIV 8 +2); 03106600 0008 + COMMENT L IS THE ADDRESS OF THE BUFFER; 03106650 0011 + SP[LOC]:=K; %NUMBER OF CHARACTERS IN THE BUFFER 03106700 0011 + TRANSFERSP(INTO,SP,L+1,BUFFER,0,ENTIER((K+7)DIV 8)); 03106750 0014 + COMMENT WE HAVE MOVED IN THE BUFFER; 03106800 0020 + K:=L; %SAVE THE ADDRESS OF THE BUFFER; 03106850 0020 + L:=J+1; % ONE WORD UP INTO THE POLISH 03106900 0021 + SP[LOC].SPF:=K; %STORE ADDRESS OF BUFFER 03106950 0022 + SP[LOC].RF:=1; % SET THE RANK TO 1 03107000 0026 + SP[LOC].DID:=DDPNVC; 03107050 0031 + L:=L-1; %SET THE LENGTH OF POLISH 03107100 0035 + SP[LOC]:=T; %STORE THE LENGTH OF THE POLISH 03107150 0036 + T:=0; T.SPF:=J; T.RF:=1; %SET UP PROG DESC IN T 03107200 0039 + T.BACKP:=LASTCONSTANT; 03107225 0043 + T.DID:=PDC; ANALYZE:=T; 03107250 0045 + COMMENT DEBUG THE POLISH IF NECESSARY; 03107300 0048 + IF POLBUG=1 THEN DUMPOLISH(SP,T); 03107350 0048 + END; 03107400 0051 + 68 IS 54 LONG, NEXT SEG 59 + %-------------------------------------------------- 03107450 0270 + END; 03107500 0270 + 59 IS 273 LONG, NEXT SEG 57 + END; 03107550 0211 + 57 IS 219 LONG, NEXT SEG 56 + PROCEDURE OPERANDTOSYMTAB(L);VALUE L;INTEGER L; 03108000 0004 + BEGIN 03108020 0004 + INTEGER N; 03108030 0004 + START OF SEGMENT ********** 69 + TRANSFER(ACCUM,2,GTA,0,7); 03108040 0000 + IF(IF VARIABLES=0 THEN FALSE ELSE 03108060 0003 + SEARCHORD(VARIABLES,GTA,GT1,7)=0) THEN 03108080 0005 + BEGIN 03108100 0008 + SP[LOC].TYPEFIELD:=GT1:=GETFIELD(GTA,7,1); 03108120 0008 + IF GT1=FUNCTION THEN 03108140 0015 + BEGIN 03108160 0015 + L:=L+1;SP[LOC]:=GTA[1]; 03108200 0016 + END ELSE %MUST BE AN OPERAND 03108220 0020 + BEGIN 03108240 0020 + SP[LOC].TYPEFIELD:=OPERAND; 03108260 0021 + L:=L+1; 03108280 0025 + IF GT1=0 THEN % THIS IS THE SCALAR CASE 03108300 0026 + BEGIN N:=GETSPACE(1); 03108320 0027 + SP[LOC]:=N&DDPNSW[CDID]; 03108340 0029 + SP[NOC]:=GTA[1]; 03108360 0033 + END ELSE %IT MUST BE A VECTOR 03108380 0036 + SP[LOC]:=GTA[1]; 03108400 0036 + END; 03108420 0040 + END ELSE % NOT IN THE SYMBOL TABLE 03108440 0040 + BEGIN 03108460 0040 + SP[LOC].TYPEFIELD:=GT1:=OPERAND; 03108480 0040 + L:=L+1; SP[LOC]:=NAMEDNULLV; 03108500 0045 + % THE UNDEFINED SYMBOL IS A NULL 03108520 0050 + 03108540 0050 + END; 03108560 0050 + END; %OF PROCEDURE OPERANDTOSYMTAB 03108600 0050 + 69 IS 53 LONG, NEXT SEG 56 + INTEGER PROCEDURE GETSPACE(LENGTH); VALUE LENGTH; 03110000 0004 + INTEGER LENGTH; 03110100 0004 + BEGIN 03110200 0004 + LABEL ENDGETSPACE,SPOVERFLOW; 03110210 0004 + START OF SEGMENT ********** 70 + MONITOR INDEX; 03110220 0000 + INTEGER L,NEXTAREA,LASTAREA,OLDROW,K; 03110300 0001 + INTEGER MEMCHECK; 03110310 0001 + REAL LINK; 03110400 0001 + INDEX:=SPOVERFLOW; 03110410 0001 + NEXTAREA:=SP[0,0]; 03110500 0003 + LASTAREA:=0; 03110600 0005 + DO BEGIN COMMENT FIND A LARGE ENOUGH AREA; 03110700 0006 + IF MEMCHECK:=MEMCHECK+1 GTR MAXMEMACCESSES THEN %ERR 03110710 0006 + BEGIN GETSPACE:=-1@10; ERR:=SPERROR; 03110720 0007 + GO TO ENDGETSPACE END; 03110730 0010 + IF NEXTAREA =0 THEN COMMENT END OF STORAGE; 03110800 0013 + BEGIN 03110900 0013 + IF NROWS:=(OLDROW:=NROWS)+K:=ENTIER(LENGTH/ 03110910 0014 + SPRSIZE+1) 03110915 0015 + GTR MAXSPROWS THEN %OFF THE END OF SP 03110920 0016 + BEGIN COMMENT TAKE EASY WAY OUT FOR NOW; 03110930 0019 + GETSPACE:=-1@10; %CAUSES INVALID INDEX 03110940 0019 + NROWS:=OLDROW; ERR:=SPERROR; 03110945 0020 + GO TO ENDGETSPACE 03110950 0022 + END; 03110960 0022 + K:=K×SPRSIZE; 03111000 0025 + 03111100 0026 + L:=LASTAREA; 03111200 0026 + IF OLDROW = -1 THEN COMMENT FIRST ROW OF SP; 03111300 0027 + BEGIN SP[0,0].NEXT:=L:=1; K:=K-1 03111400 0028 + END ELSE 03111500 0032 + BEGIN SP[LOC].NEXT:=(OLDROW+1)×SPRSIZE; 03111600 0033 + L:=(OLDROW+1)×SPRSIZE; 03111700 0039 + END; 03111800 0041 + SP[LOC].LEN:=K; SP[LOC].NEXT:=0; 03111900 0041 + NEXTAREA:=L 03112000 0049 + END ELSE L:=NEXTAREA; 03112100 0049 + LINK:=SP[LOC]; 03112200 0051 + K:=LINK.LEN-LENGTH; 03112300 0054 + IF K LSS 0 THEN COMMENT NOT ENOUGH ROOM; 03112400 0056 + BEGIN L:=LASTAREA:=NEXTAREA; 03112500 0056 + NEXTAREA:=LINK.NEXT 03112600 0058 + END 03112700 0058 + END UNTIL K GEQ 0; 03112800 0059 + IF K GTR 0 THEN 03112900 0061 + BEGIN L:=L+LENGTH; 03113000 0061 + SP[LOC]:=0; 03113010 0063 + SP[LOC].LEN:=K; SP[LOC].NEXT:=LINK.NEXT; 03113100 0066 + END ELSE L:=LINK.NEXT; 03113200 0075 + K:=L; L:=LASTAREA; 03113300 0077 + COMMENT ZERO OUT THE STORAGE BEFORE ALLOCATION; 03113400 0078 + SP[LOC].NEXT:=K; K:=NEXTAREA+LENGTH-1; 03113500 0078 + FOR L:=GETSPACE:=NEXTAREA STEP 1 UNTIL K DO SP[LOC]:=0; 03113600 0084 + IF FALSE THEN SPOVERFLOW: BEGIN 03113603 0092 + GETSPACE:=-1@10;ERR:=SPERROR END; 03113605 0094 + ENDGETSPACE: 03113610 0095 + END OF GETSPACE; 03113700 0096 + 70 IS 103 LONG, NEXT SEG 56 + PROCEDURE FORGETSPACE(LOCATE,LENGTH); VALUE LOCATE,LENGTH; 03113800 0004 + INTEGER LOCATE,LENGTH; 03113900 0004 + BEGIN INTEGER L; 03114000 0004 + START OF SEGMENT ********** 71 + IF LENGTH GTR 0 THEN BEGIN 03114010 0000 + L:=LOCATE; 03114100 0001 + SP[LOC]:=SP[0,0]; 03114200 0002 + SP[LOC].LEN:=LENGTH; 03114300 0006 + SP[0,0]:=L; 03114310 0010 + END; 03114400 0012 + END; 03114500 0012 + 71 IS 15 LONG, NEXT SEG 56 + INTEGER PROCEDURE BUILDNULL(LASTCONSTANT); 03114510 0004 + INTEGER LASTCONSTANT; 03114520 0004 + BEGIN REAL T, N; 03114530 0004 + START OF SEGMENT ********** 72 + IF NOT CURRENTMODE=FUNCMODE THEN 03114535 0000 + BEGIN 03114536 0001 + T:=0; 03114540 0001 + T.DID:=DDPNVW; 03114550 0002 + T.BACKP:=LASTCONSTANT; 03114560 0004 + LASTCONSTANT:=BUILDNULL:=N:=GETSPACE(1); 03114570 0005 + SP[NOC]:=T; 03114580 0008 + END; 03114585 0011 + END OF BUILDNULL; 03114590 0011 + 72 IS 15 LONG, NEXT SEG 56 + 03114600 0004 + INTEGER PROCEDURE BUILDCONSTANT(LASTCONSTANT); 03114610 0004 + INTEGER LASTCONSTANT; 03114620 0004 + BEGIN ARRAY A[0:MAXCONSTANT]; 03114630 0004 + START OF SEGMENT ********** 73 + INTEGER ATOP,L,K; 03114640 0001 + REAL AP; 03114642 0001 + DEFINE GS=GETSPACE#; 03114650 0001 + DO 03114660 0001 + A[ATOP:=ATOP+1]:=ACCUM[0] 03114670 0001 + UNTIL NOT SCAN OR NOT NUMERIC OR ATOP = MAXCONSTANT; 03114680 0003 + IF MAXCONSTANT=ATOP OR ERR NEQ 0 THEN COMMENT AN ERROR; 03114690 0007 + ELSE 03114700 0009 + 03114705 0009 + IF ATOP=1 THEN COMMENT SCALAR FOUND; 03114710 0009 + BEGIN L:=K:=GS(1); 03114720 0011 + SP[LOC]:=A[1]; 03114730 0013 + BUILDCONSTANT:=L:=GETSPACE(1); 03114740 0016 + SP[LOC]:=K&DDPNSW[CDID]&LASTCONSTANT[CLOCF]; 03114750 0018 + LASTCONSTANT:=L; 03114766 0023 + END ELSE COMMENT VECTOR; 03114770 0024 + BEGIN L:=K:=GS(ATOP+1); 03114780 0024 + TRANSFERSP(INTO,SP,L+1,A,1,ATOP); 03114790 0027 + SP[LOC]:=ATOP; 03114800 0030 + BUILDCONSTANT:=L:=GS(1); %VECTOR DESCRIPTOR 03114810 0033 + SP[LOC]:=K&1[CRF]&DDPNVW[CDID]&LASTCONSTANT[CLOCF]; 03114820 0035 + LASTCONSTANT:=L; 03114846 0041 + END 03114850 0042 + 03114855 0042 + END; 03114860 0042 + 73 IS 49 LONG, NEXT SEG 56 + OWN INTEGER OLDDATA, REALLYERROR; 03114900 0004 + INTEGER L,N,M; 03115000 0004 + OWN REAL ST,T,U; 03115100 0004 + LABEL EXECUTION,PROCESSEXIT; 03115200 0004 + DEFINE STLOC=ST.[30:11],ST.[41:7]#, 03115300 0004 + STMINUS=(ST-1).[30:11],(ST-1).[41:7]#, 03115400 0004 + AREG=SP[STLOC]#, 03115500 0004 + BREG=SP[STMINUS]#, 03115600 0004 + BACKPT=6:36:12#, 03115700 0004 + CI=18:36:12#, 03115800 0004 + SPTSP=30:30:18#, 03115900 0004 + PROGMKS=0#, 03115910 0004 + IMKS=2#, 03115920 0004 + FMKS=1#, 03115930 0004 + 03115940 0004 + BACKF=[6:12]#, 03115950 0004 + CIF=[18:12]#, 03115960 0004 + ENDEF=#; 03116000 0004 + PROCEDURE PACK(L,OFFSET,N);VALUE L,OFFSET,N;INTEGER L,OFFSET,N; 03116100 0004 + FORWARD; 03116110 0004 + INTEGER PROCEDURE UNPACK(S,OFFSET,N);VALUE S,OFFSET,N; 03116200 0004 + INTEGER S,OFFSET,N; FORWARD; 03116210 0004 + PROCEDURE PUSH; 03117000 0004 + IF ST LSS STACKSIZE+STACKBASE THEN ST:=ST+1 ELSE 03117100 0004 + ERR:=DEPTHERROR; 03117200 0009 + PROCEDURE POP; 03117300 0010 + BEGIN REAL U; 03117310 0010 + START OF SEGMENT ********** 74 + IF ST GTR STACKBASE THEN 03117400 0000 + IF BOOLEAN((U:=AREG).NAMED)OR NOT BOOLEAN(U.PRESENCE) 03117500 0001 + THEN ST:=ST-1 ELSE 03117510 0004 + BEGIN COMMENT GET RID OF SP STORAGE FOR THIS VARIABLE; 03117600 0007 + IF U.SPF NEQ 0 AND BOOLEAN(U.DATADESC) THEN 03117640 0008 + SCRATCHDATA(U); 03117650 0010 + 03117660 0011 + ST:=ST-1; 03117700 0011 + END 03117800 0013 + ELSE ERR:=SYSTEMERROR; 03117900 0013 + END; 03117910 0014 + 74 IS 17 LONG, NEXT SEG 56 + REAL PROCEDURE GETARRAY(DESCRIPTOR); VALUE DESCRIPTOR; 03118000 0010 + REAL DESCRIPTOR; 03118100 0010 + BEGIN 03118200 0010 + INTEGER R,I,J,K,L,LL,TOTAL,PT; 03118300 0010 + START OF SEGMENT ********** 75 + REAL T; 03118400 0000 + ARRAY BLOCK[0:BLOCKSIZE],DIMVECTOR[0:32]; 03118600 0000 + %SEE MAXWORDSTORE, LINE 17260 03118605 0003 + 03118700 0003 + T:=DESCRIPTOR; 03118750 0003 + IF (R:=DESCRIPTOR.RF=0) THEN T.DIMPTR:=0 03118800 0004 + ELSE BEGIN 03118900 0006 + I:=CONTENTS(WS,DESCRIPTOR.DIMPTR,DIMVECTOR); 03119000 0008 + TOTAL:=1; 03119010 0011 + FOR I:=0 STEP 1 UNTIL R-1 DO 03119100 0012 + TOTAL:=TOTAL×DIMVECTOR[I]; 03119200 0016 + IF DESCRIPTOR.ARRAYTYPE=CHARARRAY THEN 03119300 0018 + TOTAL:=ENTIER((TOTAL+7) DIV 8); 03119400 0019 + TOTAL:=TOTAL+R; 03119500 0023 + LL:=GETSPACE(TOTAL); 03119600 0024 + TRANSFERSP(INTO,SP,LL,DIMVECTOR,0,R); 03119700 0025 + L:=LL+R; 03119800 0028 + J:=CONTENTS(WS,DESCRIPTOR.INPTR,DIMVECTOR)-1; 03119900 0030 + GTA[0]:=0; 03119910 0033 + FOR I:=0 STEP 2 UNTIL J DO 03120000 0034 + BEGIN 03120100 0037 + TRANSFER(DIMVECTOR,I,GTA,6,2); 03120200 0037 + PT:=GTA[0]; 03120210 0040 + K:=CONTENTS(WS,PT,BLOCK); 03120300 0041 + TRANSFERSP(INTO,SP,L,BLOCK,0, 03120400 0043 + (K:=ENTIER((K+7)DIV 8))); 03120500 0046 + L:=L+K; 03120600 0049 + END; 03120700 0050 + T.DIMPTR:=LL; 03120800 0052 + END; 03120900 0054 + T.INPTR:=0; 03121000 0054 + T.PRESENCE:=1; 03121100 0056 + GETARRAY:=T; 03121150 0057 + END; 03121200 0058 + 75 IS 67 LONG, NEXT SEG 56 + INTEGER PROCEDURE FINDSIZE(D);VALUE D; REAL D; 03121250 0010 + BEGIN 03121255 0010 + INTEGER I,J,M,R; 03121260 0010 + START OF SEGMENT ********** 76 + J:=1; I:=D.SPF; R:=D.RF+I-1; 03121265 0000 + IF I NEQ 0 THEN 03121268 0004 + FOR M:=I STEP 1 UNTIL R DO J:=J×SP[MOC]; 03121270 0005 + FINDSIZE:=J; 03121275 0012 + END PROCEDURE FINDSIZE; 03121280 0013 + 76 IS 17 LONG, NEXT SEG 56 + 03121285 0010 + INTEGER PROCEDURE NUMELEMENTS(D); VALUE D; REAL D; 03121300 0010 + BEGIN 03121310 0010 + INTEGER I; 03121320 0010 + START OF SEGMENT ********** 77 + GT1:=I:=FINDSIZE(D); 03121322 0000 + IF D.ARRAYTYPE=CHARARRAY THEN 03121330 0001 + I:=ENTIER((I+7) DIV 8); 03121335 0003 + NUMELEMENTS:=I; 03121337 0006 + END; 03121340 0007 + 77 IS 12 LONG, NEXT SEG 56 + PROCEDURE SCRATCHDATA(D); VALUE D; REAL D; 03121400 0010 + BEGIN 03121410 0010 + INTEGER T,R; 03121420 0010 + START OF SEGMENT ********** 78 + IF BOOLEAN(D.SCALAR) THEN T:=1 ELSE 03121430 0000 + IF R:=D.RF = 0 THEN T:=0 ELSE %BONAFIDE VECTOR 03121440 0002 + BEGIN T:=NUMELEMENTS(D)+R; 03121450 0005 + 03121452 0007 + END; 03121454 0007 + IF T NEQ 0 THEN FORGETSPACE(D.SPF,T); 03121460 0007 + END; 03121470 0010 + 78 IS 14 LONG, NEXT SEG 56 + COMMENT RELEASEARRAY HAS BEEN MOVED OUT OF PROCESS SO THAT IT 03121490 0010 + CAN BE CALLED ELSEWHERE; 03121491 0010 + REAL PROCEDURE MOVEARRAY(SPDESC); VALUE SPDESC; 03122500 0010 + REAL SPDESC; 03122550 0010 + COMMENT MOVE THE ARRAY FROM SCRATCHPAD TO PERMANENT 03122560 0010 + STORAGE AND CONSTRUCT NEW DESCRIPTOR; 03122570 0010 + BEGIN 03122600 0010 + INTEGER TOTAL,R,J,M,K; 03122650 0010 + START OF SEGMENT ********** 79 + REAL T; 03122660 0000 + ARRAY BLOCK[0:BLOCKSIZE],BUFFER[0:32]; %SEE MAXWORDSTORE, LINE 17260 03122700 0000 + T:=SPDESC; 03122710 0003 + TRANSFERSP(OUTOF,SP,SPDESC.SPF,BUFFER,0,R:=SPDESC.RF); 03122750 0004 + T.DIMPTR:=STORESEQ(WS,BUFFER,8×R); 03122800 0009 + TOTAL:=NUMELEMENTS(SPDESC); 03122850 0012 + M:=SPDESC.SPF+R; 03123100 0014 + K:=ENTIER(TOTAL DIV BLOCKSIZE)-1; 03123150 0015 + FOR J:=0 STEP 1 UNTIL K DO BEGIN 03123200 0018 + TRANSFERSP(OUTOF,SP,M,BLOCK,0,BLOCKSIZE); 03123250 0021 + R:=STORESEQ(WS,BLOCK,BLOCKSIZE×8); 03123300 0024 + TRANSFER(R,6,BUFFER,J×2,2); 03123350 0027 + M:=M+BLOCKSIZE; 03123400 0030 + END; 03123450 0031 + IF J:=TOTAL-(K:=K+1)×BLOCKSIZE GTR 0 THEN 03123500 0033 + BEGIN 03123550 0037 + TRANSFERSP(OUTOF,SP,M,BLOCK,0,J); %GET REMAINDER OF MATRIX 03123600 0037 + R:=STORESEQ(WS,BLOCK,J×8); 03123640 0040 + TRANSFER(R,6,BUFFER,K×2,2); 03123650 0043 + K:=K+1; 03123660 0046 + END; 03123700 0048 + T.INPTR:=STORESEQ(WS,BUFFER,K×2); 03123750 0048 + MOVEARRAY:=T; 03123810 0051 + END; 03123850 0052 + 79 IS 59 LONG, NEXT SEG 56 + PROCEDURE WRITEBACK; 03124000 0010 + COMMENT COPY CHANGED VARIABLES INTO PERMANENT STORAGE; 03124010 0010 + BEGIN 03124050 0010 + INTEGER I,J,K,L,M,NUM; 03124100 0010 + START OF SEGMENT ********** 80 + REAL T; 03124110 0000 + ARRAY NEWDESC[0:1],OLDDESC [0:1]; 03124150 0000 + L:=SYMBASE; 03124200 0003 + NUM:=SP[LOC]-1; 03124250 0004 + L:=L-1; 03124300 0007 + FOR I:=1 STEP 2 UNTIL NUM DO BEGIN 03124350 0009 + L:=L+2; 03124400 0010 + IF ((T:=SP[LOC]).TYPEFIELD) NEQ FUNCTION THEN 03124410 0011 + IF BOOLEAN(T.CHANGE) THEN BEGIN 03124450 0015 + IF VARIABLES=0 THEN 03124500 0016 + 03124510 0017 + BEGIN VARIABLES:=NEXTUNIT; 03124520 0017 + T:=CURRENTMODE; 03124525 0019 + VARSIZE:=1; STOREPSR; 03124530 0020 + CURRENTMODE:=T; VARSIZE:=0; 03124535 0022 + END; 03124540 0025 + M:=L+1;WHILE(T:=SP[MOC]).BACKP NEQ 0 AND T.PRESENCE=1 03124550 0025 + AND(GT1:=GT1+1)LSS MAXMEMACCESSES DO M:=T.BACKP;GT1:=0; 03124560 0030 + GTA[0]:=SP[LOC];GTA[1]:=T; 03124570 0037 + TRANSFER(GTA,1,NEWDESC,0,7); 03124600 0042 + 03124610 0045 + SETFIELD(NEWDESC,7,1, IF BOOLEAN(T.SCALAR) 03124650 0045 + THEN SCALARDATA ELSE ARRAYDATA); 03124700 0046 + MOVE(NEWDESC,1,OLDDESC); K:=1; 03124710 0049 + IF (IF VARSIZE=0 THEN FALSE ELSE 03124800 0051 + K:=SEARCHORD(VARIABLES,NEWDESC,J,7)=0) 03124850 0053 + THEN BEGIN 03124900 0056 + K:=CONTENTS(VARIABLES,J,OLDDESC); 03124950 0057 + DELETE1(VARIABLES,J); 03125000 0060 + IF GETFIELD(OLDDESC,7,1)=ARRAYDATA THEN 03125050 0061 + RELEASEARRAY(OLDDESC[1]); 03125100 0063 + END ELSE 03125150 0065 + BEGIN VARSIZE:=VARSIZE+1; J:=J+K-1; 03125160 0065 + MOVE(OLDDESC,1,NEWDESC); 03125170 0069 + END; 03125180 0071 + SETFIELD(NEWDESC,7,1,IF BOOLEAN(T.SCALAR) 03125200 0071 + THEN SCALARDATA ELSE ARRAYDATA); 03125210 0072 + IF BOOLEAN(T.SCALAR) THEN 03125250 0075 + BEGIN M:=T.SPF; 03125300 0075 + NEWDESC[1]:=SP[MOC]; 03125350 0077 + END ELSE %A VECTOR 03125360 0080 + BEGIN T.PRESENCE:=0; 03125370 0080 + NEWDESC[1]:=(IF T.RF NEQ 0 THEN 03125372 0083 + MOVEARRAY(T) ELSE T) 03125374 0084 + END; 03125378 0086 + STOREORD(VARIABLES,NEWDESC,J); 03125400 0087 + 03125405 0089 + END; 03125450 0089 + END; 03125500 0089 + END; 03125550 0091 + 80 IS 98 LONG, NEXT SEG 56 + PROCEDURE SPCOPY(S,D,N);VALUE S,D,N;INTEGER S,D,N; 03130000 0010 + BEGIN 03130100 0010 + INTEGER K; 03130200 0010 + START OF SEGMENT ********** 81 + WHILE (N:=N-K) GTR 0 DO 03130300 0000 + TRANSFERSP(INTO,SP,(D:=D+K),SP[(S:=S+K)DIV SPRSIZE,*], 03130400 0002 + K:=S MOD SPRSIZE,K:=MIN(N,SPRSIZE-K)); 03130500 0007 + END; 03130600 0013 + 81 IS 16 LONG, NEXT SEG 56 + INTEGER PROCEDURE CHAIN(D,CHAINLOC); VALUE D,CHAINLOC; 03131000 0010 + INTEGER CHAINLOC; REAL D; 03131100 0010 + BEGIN 03131200 0010 + INTEGER M; 03131300 0010 + START OF SEGMENT ********** 82 + CHAIN:=M:=GETSPACE(1); 03131400 0000 + D.LOCFIELD:=CHAINLOC; 03131500 0001 + SP[MOC]:=D; 03131600 0003 + END; 03131700 0006 + 82 IS 10 LONG, NEXT SEG 56 + PROCEDURE SCRATCHAIN(L); VALUE L; INTEGER L; 03132000 0010 + BEGIN 03132100 0010 + REAL R; 03132200 0010 + START OF SEGMENT ********** 83 + WHILE L NEQ 0 DO BEGIN 03132300 0000 + SCRATCHDATA(R:=SP[LOC]); 03132400 0001 + FORGETSPACE(L,1); 03132500 0004 + IF L=R.LOCFIELD THEN L:=0 ELSE 03132590 0005 + L:=R.LOCFIELD; 03132600 0008 + END; 03132700 0009 + END; 03132800 0010 + 83 IS 13 LONG, NEXT SEG 56 + PROCEDURE RESTORELOCALS(FPTR);VALUE FPTR;REAL FPTR; 03133000 0010 + BEGIN 03133050 0010 + INTEGER L,M,N,I,K,FLOC; 03133100 0010 + START OF SEGMENT ********** 84 + REAL T; 03133150 0000 + M:=FPTR.LOCFIELD; 03133200 0000 + L:=FPTR.SPF+2;K:=SP[LOC]-2;%LAST ALPHA POINTER 03133300 0001 + T:=L+4; 03133350 0006 + FOR I:=T STEP 2 UNTIL K DO % ONCE FOR EACH LOCAL 03133400 0007 + BEGIN 03133450 0009 + M:=M+1;N:=SP[MOC].SPF; %LOCATION IN SYMBOL TABLE 03133500 0009 + T:=SP[NOC];L:=T.BACKP;T.BACKP:=0;T.NAMED:=0; 03133550 0013 + SP[MOC]:=T;%COPY OF DESCRIPTOR TO STACK 03133600 0021 + IF L=0 THEN 03133650 0024 + BEGIN N:=N-1; GTA[0]:=SP[NOC]; 03133660 0024 + TRANSFER(GTA,1,ACCUM,2,7); OPERANDTOSYMTAB(N); 03133670 0029 + END 03133680 0033 + ELSE BEGIN SP[NOC]:=SP[LOC];FORGETSPACE(L,1);END; 03133700 0033 + END; 03133750 0040 + END; % OF PROCEDURE RESTORELOCALS 03133800 0042 + 84 IS 47 LONG, NEXT SEG 56 + OWN INTEGER FUNCLOC,POLLOC,LASTMKS,POLTOP,CINDEX; 03135000 0010 + PROCEDURE STEPLINE(LABELED); VALUE LABELED; 03140000 0010 + BOOLEAN LABELED; 03140020 0010 + 03140030 0010 + BEGIN 03140040 0010 + LABEL ENDFUNC,TERMINATE,DONE; 03140050 0010 + START OF SEGMENT ********** 85 + LABEL BUMPLINE; 03140052 0000 + LABEL TRYNEXT; 03140054 0000 + REAL STREAM PROCEDURE CON(A); VALUE A; 03140060 0000 + BEGIN SI:= LOC A; DI:=LOC CON; DS:=8DEC; 03140070 0000 + END; 03140080 0000 + INTEGER C; 03140081 0001 + REAL N,T,L,TLAST,M,BASE; 03140090 0001 + COMMENT 03140091 0001 + MONITOR PRINT (FUNCLOC,POLLOC,LASTMKS,POLTOP,CINDEX,N,T,L, 03140092 0001 + TLAST,M,BASE); 03140094 0001 + L:=FUNCLOC;M:=SP[LOC].SPF+L; 03140100 0001 + IF BOOLEAN(SP[MOC].SUSPENDED) THEN 03140105 0006 + BEGIN %RESUME A SUSPENDED FUNCTION 03140110 0009 + SP[MOC].SUSPENDED:=0;%REMOVE SUSPENDED BIT 03140115 0009 + RESTORELOCALS(SP[MOC]); 03140118 0014 + SP[LOC].RF:=N:=SP[LOC].RF-1; 03140120 0016 + IF N LEQ 0 THEN SUSPENSION:=0;% NO MORE SUSPENDED FNS 03140124 0024 + END; 03140126 0028 + IF LABELED THEN %MAKE INTIAL CHECKS AND CHANGES; 03140130 0028 + BEGIN 03140140 0028 + IF NOT BOOLEAN((T:=AREG).PRESENCE) OR L:=T.SPF=0 03140150 0029 + THEN 03140160 0033 + BEGIN LABELED:=FALSE; GO TO BUMPLINE; 03140161 0034 + END; 03140162 0036 + IF BOOLEAN (T.CHRMODE) THEN GO TO TERMINATE; 03140170 0036 + L:=L+T.RF; %PICK UP THE FIRST ELEMENT OF THE ARRAY 03140180 0037 + IF T:=SP[LOC] GTR 9999.99994 OR T LSS 0 THEN 03140190 0039 + T:=0; 03140200 0043 + T:=CON(ENTIER(T×10000+.5)) 03140210 0045 + END; BUMPLINE: 03140212 0047 + L:=LASTMKS; TLAST:=SP[LOC].BACKF; 03140214 0049 + C:=(LASTMKS:=SP[MOC].LOCFIELD)-STACKBASE;%LOC OF FMKS 03140216 0053 + WHILE TLAST GTR C DO %STRIP OFF CURRENT LINE 03140218 0057 + BEGIN L:=TLAST+STACKBASE;TLAST:=(N:=SP[LOC]).BACKF; 03140219 0058 + IF N.DID=IMKS THEN SCRATCHAIN(N.SPF); 03140220 0064 + END; 03140221 0067 + WHILE ST GEQ L AND ERR=0 DO POP; 03140222 0071 + IF ERR NEQ 0 THEN GO TO DONE; 03140224 0074 + M:=BASE:=SP[MOC].SPF;%LOC OF LABEL TABLE 03140230 0075 + TRYNEXT: 03140238 0079 + N:=SP[MOC]+M+1; % N IS ONE BIGGER THAN TOP 03140240 0080 + M:=M+2; M:=SP[MOC]+2; % M IS ON THE FIRST POINTER 03140250 0083 + IF LABELED THEN %BINARY SEARCH FOR THE DESIRED LINE 03140260 0088 + BEGIN 03140270 0088 + IF N-M LSS 2 THEN GO TO ENDFUNC; 03140280 0089 + WHILE N-M GTR 2 AND C LSS 1@8 DO 03140290 0090 + 03140300 0093 + BEGIN L:=M+ENTIER((N-M)DIV 4)×2; C:=C+1; 03140320 0093 + IF T LSS SP[LOC] THEN N:=L ELSE M:=L 03140330 0098 + END; 03140340 0105 + IF C=1@8 THEN GO TERMINATE; 03140342 0106 + IF SP[MOC] NEQ T THEN GO ENDFUNC; T:=M; 03140350 0107 + %T HAS THE SP LOCATION OF THE CORRECT LABEL 03140360 0111 + END ELSE %BUMP THE POINTER 03140370 0111 + IF T:=CURLINE+2+BASE GEQ N OR T LSS M THEN GO ENDFUNC; 03140380 0111 + M:=T+1; CURLINE:=T-BASE; %M IS SET TO PROG DESC 03140390 0117 + IF NOT BOOLEAN((T:=SP[MOC]).PRESENCE) THEN %MAKE POLISH 03140400 0120 + BEGIN N:=BASE+1;N:=SP[NOC].SPF;%SEQ STORAGE UNIT 03140410 0123 + INITBUFF(BUFFER,BUFFSIZE); 03140420 0128 + N:=CONTENTS(N,T,BUFFER); %GET TEXT 03140430 0130 + RESCANLINE; WHILE LABELSCAN(GTA,0) DO; %CLEAR LABELS 03140432 0132 + IF BOOLEAN(EOB) THEN % AN EMPTY LINE--BUMP POINTER 03140434 0135 + BEGIN M:=BASE;LABELED:=FALSE;GO TO TRYNEXT;END ELSE 03140436 0135 + IF T:=ANALYZE(TRUE)=0 THEN % NO GOOD 03140440 0138 + GO TO DONE; 03140450 0140 + SP[MOC]:=T; %SAVE THE POLISH DESCRIPTOR AT M 03140460 0141 + END ; 03140470 0144 + PUSH; IF ERR NEQ 0 THEN GO TO DONE; 03140480 0144 + AREG:=(L:=ENTIER(M))&1[CCIF]&TLAST[BACKPT]; 03140490 0145 + LASTMKS:=ST; 03140491 0152 + POLLOC:=SP[LOC].SPF; 03140492 0153 + L:=T.SPF; POLTOP:=SP[LOC]; CINDEX:=1; 03140500 0156 + GO TO DONE; 03140510 0161 + ENDFUNC: 03140520 0163 + %ARRIVE HERE WHEN FUNCTION IS COMPLETED. 03140530 0163 + %GET RESULT OF FUNCTION 03140540 0163 + M:=FUNCLOC;M:=SP[MOC].SPF+M;N:=TLAST:=SP[MOC].LOCFIELD; 03140550 0163 + M:=SP[NOC].SPF;M:=SP[MOC]; 03140551 0171 + COMMENT I CANNOT CONJURE UP A CASE WHERE A USER RETURNS TO A 03140555 0177 + FUNCTION WHOSE DESCRIPTOR HAS BEEN PUSHED DOWN BY A SUSPENDED 03140556 0177 + VARIABLE.IF THIS HAPPENS-HOPE FOR A GRACEFUL CRASH; 03140557 0177 + %M IS THE DESCRIPTOR FOR THE FUNCTION, TLAST IS BASE ADDRESS 03140560 0177 + 03140562 0177 + IF BOOLEAN(M.RETURNVALUE) THEN %GET THE RESULT 03140570 0177 + BEGIN 03140580 0178 + N:=M.SPF+5;%RELATIVE LOCATION OF RESULT 03140590 0178 + N:=SP[NOC]+TLAST; %LOCATION IN STACK OF RESLULT 03140600 0180 + T:=SP[NOC]; SP[NOC].NAMED:=1; N:=T; 03140610 0183 + END; 03140620 0191 + WHILE ST GEQ TLAST AND ERR=0 DO POP; %GET RID OF TEMPS 03140630 0191 + OLDDATA:=(T:=AREG).SPF; POP;% GET RID OF INTERRUPT MKS 03140635 0194 + IF ERR NEQ 0 THEN GO TO DONE; 03140640 0198 + IF BOOLEAN(M.RETURNVALUE) THEN %REPLACE RESULT 03140650 0200 + BEGIN PUSH; IF ERR NEQ 0 THEN GO TO DONE; 03140660 0200 + AREG:=N; %RESULT OF CALL 03140670 0203 + END; 03140680 0206 + L:=STACKBASE+1;L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L; 03140682 0206 + 03140684 0215 + SP[MOC]:=0;SP[LOC].SPF:=(M:=M-1)-L; 03140686 0215 + COMMENT NOW INITIATE ANY OLD FUNCTIONS, AND GET POLISH 03140690 0223 + GOING; 03140700 0223 + LASTMKS:=N:=T.BACKF+STACKBASE; %LOCATION OF PROGRAM DESC. 03140710 0223 + T:=SP[NOC]; % PICK UP PROGRAM DESCRIPTOR 03140720 0226 + N:=T.SPF; %LOCATION OF POLISH DESCRIPTOR 03140730 0229 + POLLOC:=(N:=SP[NOC].SPF); 03140740 0230 + POLTOP:=SP[NOC]; 03140750 0234 + CINDEX:=T.CIF; 03140760 0236 + IF M NEQ L THEN % GET LAST FUNCTION STARTED 03140770 0238 + BEGIN N:=SP[MOC].LOCFIELD; 03140780 0238 + T:=SP[NOC]; 03140790 0242 + CURLINE:=T.CIF 03140800 0245 + END ELSE CURLINE:=0; 03140810 0245 + GO TO DONE; 03140820 0248 + TERMINATE: 03140830 0249 + ERR:=LABELERROR; 03140840 0250 + DONE: 03140850 0250 + END; 03142000 0251 + 85 IS 256 LONG, NEXT SEG 56 + 03148200 0010 + PROCEDURE FIXTAKEORDROP(LDESC,RDESC,OPT,MAP,SIZEMAP,SIZE); 03148300 0010 + VALUE LDESC,RDESC,OPT; REAL LDESC,RDESC; 03148310 0010 + INTEGER OPT, SIZE; ARRAY MAP, SIZEMAP [1]; 03148320 0010 + BEGIN INTEGER LRANK,LSIZE,L,M,RRANK,N,I,TOP,PUT; 03148330 0010 + START OF SEGMENT ********** 86 + DEFINE TAKE = OPT = 2#; 03148340 0000 + INTEGER LNUM, RNUM; LABEL QUIT; 03148350 0000 + IF LSIZE := FINDSIZE(LDESC) NEQ RRANK := RDESC.RF AND LSIZE NEQ 1 03148360 0000 + OR LRANK:=LDESC.RF GTR 1 AND LSIZE NEQ 1 03148365 0003 + OR L := LDESC.SPF=0 03148370 0005 + OR M := RDESC.SPF = 0 THEN BEGIN 03148380 0008 + ERR:=DOMAINERROR; GO TO QUIT; END; 03148390 0011 + L := L + LRANK; 03148400 0012 + 03148410 0013 + SIZE := 1; 03148420 0013 + FOR I := 1 STEP 1 UNTIL RRANK DO BEGIN 03148430 0014 + RNUM:=SP[MOC]; 03148440 0016 + LNUM:=IF TAKE THEN SP[LOC] ELSE (PUT:=SP[LOC])-SIGN(PUT)×RNUM; 03148450 0018 + IF ABS(LNUM) GTR RNUM THEN BEGIN 03148460 0028 + ERR:=DOMAINERROR; GO TO QUIT; END; 03148470 0030 + IF LNUM = 0 THEN BEGIN 03148480 0031 + SIZE := 0; GO TO QUIT; END; 03148490 0032 + IF LNUM GTR 0 THEN BEGIN 03148500 0034 + SIZEMAP[I] := LNUM; 03148510 0035 + MAP[I] . SPF := 0; 03148520 0037 + MAP[I] . RF := 1; 03148530 0040 + END ELSE BEGIN 03148540 0043 + LNUM:=ABS(LNUM); 03148550 0043 + PUT := RNUM - LNUM + ORIGIN; 03148560 0044 + MAP[I].SPF := N := GETSPACE(LNUM+1); 03148570 0046 + SIZEMAP[I] := SP[NOC] := LNUM; 03148580 0051 + TOP := N + LNUM; 03148590 0055 + FOR N:=N+1 STEP 1 UNTIL TOP DO BEGIN 03148600 0057 + SP[NOC]:=PUT; PUT:=PUT+1; END; 03148610 0061 + MAP[I].RF := 1; 03148620 0066 + MAP[I] := - MAP[I]; 03148630 0069 + END; 03148640 0071 + IF LSIZE NEQ 1 THEN L:=L+1; 03148650 0071 + M:=M+1; 03148660 0074 + SIZE:=SIZE × LNUM; 03148670 0075 + END; 03148680 0077 + QUIT: END PROCEDURE FIXTAKEORDROP; 03148690 0079 + 86 IS 86 LONG, NEXT SEG 56 + REAL PROCEDURE SUBSCRIPTS(DIRECTION,D,RANK); 03150000 0010 + VALUE DIRECTION,D,RANK; REAL D,RANK; INTEGER DIRECTION; 03150010 0010 + BEGIN COMMENT THIS PROCEDURE EVALUATES A SET OF SUBSCRIPTS 03150020 0010 + ,POPS THEM OFF OF THE STACK, AND RETURNS WITH A DESC. 03150030 0010 + FOR THE ITEM REFERENCED; 03150040 0010 + LABEL GOHOME,DONE; 03150050 0010 + START OF SEGMENT ********** 87 + INTEGER SIZE,I,L,M,N,VALUW; 03150060 0000 + INTEGER ADDRESS,NOTSCAL,DIM,LEVEL,TEMP,K,J; 03150070 0000 + REAL SUBDESC,T; 03150080 0000 + BOOLEAN DCHARS; 03150081 0000 + STREAM PROCEDURE TCHAR(A,B,C,D);VALUE B,D; 03150083 0000 + BEGIN SI:=A;SI:=SI+B;DI:=C;DI:=DI+D;DS:=CHR;END; 03150085 0000 + ARRAY MAP[1:RANK],SIZEMAP[1:RANK]; 03150100 0002 + ARRAY BLOCKSIZE[1:RANK],POINTER[0:RANK],PROGRESS[1:RANK]; 03150102 0009 + INTEGER PROCEDURE SUBINDEX(M,S,P);VALUE M,S,P;REAL M,S,P; 03150104 0018 + IF M LSS 0 THEN BEGIN M:=-M; 03150106 0018 + M:=P+M.SPF+M.RF-1;SUBINDEX:=SP[MOC]-ORIGIN;END 03150107 0022 + ELSE SUBINDEX:=(IF S=1 THEN M.SPF ELSE M.SPF+P-1); 03150108 0029 + COMMENT 03150109 0037 + MONITOR PRINT(I,L,M,N,VALUW,ADDRESS,T,ERR,MAP,SIZEMAP, 03150110 0037 + SIZE,D,RANK,DIRECTION); 03150111 0037 + DCHARS:=BOOLEAN(D.CHRMODE); 03150112 0037 + IF DIRECTION GTR 1 THEN % THIS IS TAKE OR DROP 03150116 0038 + BEGIN 03150118 0039 + NOTSCAL:=1; 03150120 0039 + FIXTAKEORDROP(AREG,BREG,DIRECTION,MAP,SIZEMAP,SIZE); 03150124 0040 + IF ERR NEQ 0 THEN GO TO GOHOME; 03150125 0048 + IF SIZE=0 THEN BEGIN D.DID:=DDPUVW; D.RF:=1; 03150126 0049 + D.SPF:=0; SUBSCRIPTS:=D; GO TO GOHOME; END; 03150127 0054 + %IF SIZE=0 AND TAKE OR DROP, RESULT IS A NULL 03150128 0057 + END ELSE BEGIN 03150129 0057 + IF RANK NEQ D.RF THEN BEGIN ERR:=RANKERROR;GO TO GOHOME;END; 03150130 0057 + SIZE:=1; 03150140 0060 + N:=D.SPF-1; 03150150 0061 + L:=ST-1; % LOCATE THE EXECUTION STACK 03150152 0063 + FOR I:=1 STEP 1 UNTIL RANK DO 03150160 0064 + BEGIN 03150170 0066 + L:=L-1; SUBDESC:=SP[LOC]; % WANDER INTO EXEC STACK 03150180 0066 + IF ERR NEQ 0 THEN GO TO GOHOME; 03150190 0070 + N:=N+1; 03150200 0071 + IF BOOLEAN(SUBDESC.SCALAR) THEN 03150210 0072 + BEGIN M:=SUBDESC.SPF; 03150220 0073 + IF (VALUW:=SP[MOC]-ORIGIN) GEQ SP[NOC] 03150230 0075 + OR VALUW LSS 0 THEN BEGIN ERR:=INDEXERROR;GO TO 03150240 0080 + GOHOME; END; 03150242 0083 + MAP[I]:=VALUW; SIZEMAP[I]:=1; 03150250 0083 + END ELSE % CHECK FOR A NULL 03150260 0087 + IF SUBDESC.SPF=0 THEN % THIS IS A NULL 03150270 0087 + BEGIN 03150280 0089 + NOTSCAL:=1; 03150282 0089 + SIZE:=SIZE×(M:=SP[NOC]); 03150290 0090 + MAP[I].RF:=1;SIZEMAP[I]:=M; 03150300 0094 + END ELSE % IT MUST BE A VECTOR 03150310 0098 + BEGIN DEFINE STARTSEGMENT=#; %////////////////////////// 03150320 0098 + START OF SEGMENT ********** 88 + 03150330 0000 + 03150340 0000 + NOTSCAL:= 1; 03150342 0000 + MAP[I]:=-((M:=SUBDESC.SPF)&SUBDESC.RF[CRF]); 03150350 0000 + SIZE:=SIZE×(SIZEMAP[I]:=FINDSIZE(SUBDESC)); 03150360 0005 + J:=SP[NOC]+ORIGIN;M:=M+SUBDESC.RF;T:=SIZEMAP[I]+M 03150362 0008 + -1; 03150363 0014 + FOR M:=M STEP 1 UNTIL T DO 03150364 0016 + IF SP[MOC] GEQ J OR SP[MOC] LSS ORIGIN THEN 03150366 0017 + BEGIN ERR:=INDEXERROR; GO TO GOHOME; END; 03150368 0023 + END; 03150370 0028 + 88 IS 30 LONG, NEXT SEG 87 + END; % OF THE FOR STATEMENT 03150380 0100 + END; 03150390 0102 + IF SIZE LEQ 0 THEN BEGIN ERR:=INDEXERROR;GO TO GOHOME;END; 03150400 0102 + IF SIZE=1 AND NOT BOOLEAN(NOTSCAL) THEN %SCALAR REFERENCED 03150410 0104 + BEGIN 03150420 0106 + DEFINE STARTSEGMENT=#; %//////////////////////////////// 03150430 0106 + START OF SEGMENT ********** 89 + N:=D.SPF; M:=RANK-1; 03150440 0000 + FOR I:=1 STEP 1 UNTIL M DO 03150450 0002 + BEGIN N:= N+1; 03150460 0004 + ADDRESS:=SP[NOC]×(ADDRESS+MAP[I]); 03150470 0005 + END; 03150480 0009 + ADDRESS:=ADDRESS+MAP[RANK] +1; 03150490 0012 + IF DIRECTION=OUTOF THEN 03150500 0014 + IF DCHARS THEN BEGIN 03150502 0015 + N:=(ADDRESS+7)DIV 8+N;J:=(ADDRESS-1)MOD 8; 03150503 0016 + T:=M:=GETSPACE(2);SP[MOC]:=1;M:=M+1; 03150504 0020 + SP[MOC]:=0; TCHAR(SP[NOC],J,SP[MOC],0); 03150506 0026 + SUBSCRIPTS:=T&1[CRF]&DDPUVC[CDID]; 03150508 0035 + END ELSE 03150509 0037 + BEGIN N:= ADDRESS+N; 03150510 0037 + M:=GETSPACE(1);SP[MOC]:=SP[NOC]; 03150520 0039 + T:=M; T.DID:=DDPUSW; 03150550 0045 + SUBSCRIPTS:=T; 03150560 0048 + END ELSE % DIRECTION IS INTO 03150600 0049 + BEGIN 03150610 0049 + L:=L-1;SUBSCRIPTS:=SUBDESC:=SP[LOC]; 03150620 0049 + IF DCHARS AND FINDSIZE(SUBDESC)=1 OR 03150630 0054 + BOOLEAN(SUBDESC.SCALAR) THEN 03150631 0055 + BEGIN 03150640 0056 + L:=GETSPACE(N:=(NUMELEMENTS(D)+D.RF)); 03150650 0057 + SPCOPY(D.SPF,L,N); % MAKE A NEW COPY 03150660 0060 + IF DCHARS THEN BEGIN 03150662 0062 + N:=(ADDRESS+7)DIV 8+L;J:=(ADDRESS-1)MOD 8; 03150663 0063 + M:=SUBDESC.SPF;IF SP[MOC] GTR 1 OR SUBDESC.RF 03150664 0067 + NEQ 1 THEN BEGIN ERR:=DOMAINERROR;GO TO 03150665 0071 + GOHOME;END; 03150666 0073 + M:=M+1;TCHAR(SP[MOC],0,SP[NOC],J); 03150667 0076 + END ELSE BEGIN 03150669 0082 + M:=L+ADDRESS+D.RF-1; 03150670 0083 + N:=SUBDESC.SPF; 03150680 0086 + SP[MOC]:=SP[NOC]; %PERFORM THE REPLACEMENT 03150690 0087 + END; 03150700 0092 + N:=D.LOCFIELD;I:=SP[NOC].BACKP; 03150710 0092 + SP[NOC]:=D&L[CSPF]&I[CLOCF];%STORE NEW DESC 03150712 0096 + OLDDATA:=CHAIN(D,OLDDATA); 03150714 0101 + IF BOOLEAN(D.NAMED) THEN BEGIN 03150720 0103 + N:=N-1;IF I=0 AND SP[NOC].SUSPENDVAR=0 03150730 0104 + THEN SP[NOC].CHANGE:=1%MUST BE A REAL GLOBAL 03150740 0109 + END ELSE %MUST BE A LOCAL VARIABLE 03150750 0113 + AREG.NAMED:=1; %DONT LET IT BE FORGOTTEN 03150760 0114 + END ELSE ERR:=RANKERROR; 03150770 0119 + END; 03150780 0120 + END ELSE % A VECTOR IS REFERENCED 03150800 0120 + 89 IS 122 LONG, NEXT SEG 87 + BEGIN % START WITH INITIALIZATION 03150805 0108 + N:=D.SPF+D.RF;BLOCKSIZE[RANK]:=PROGRESS[RANK]:=J:=1; 03150810 0108 + FOR I:=RANK-1 STEP -1 UNTIL 1 DO 03150815 0114 + BEGIN N:=N-1; 03150820 0118 + J:=BLOCKSIZE[I]:=J×SP[NOC]; 03150825 0120 + PROGRESS[I]:=1; 03150830 0124 + END; 03150835 0126 + K:=POINTER[1]:=SUBINDEX(MAP[1],SIZEMAP[1],PROGRESS[1]) 03150840 0127 + ×BLOCKSIZE[1]; 03150845 0130 + FOR I:=2 STEP 1 UNTIL RANK DO 03150850 0133 + K:=POINTER[I]:=K+SUBINDEX(MAP[I],SIZEMAP[I], 03150855 0134 + PROGRESS[I])×BLOCKSIZE[I]; 03150860 0137 + DIM:=0; 03150865 0143 + FOR I:=1 STEP 1 UNTIL RANK DO 03150870 0143 + IF SIZEMAP[I] GTR 1 THEN DIM:=DIM+MAP[I].RF; 03150875 0145 + IF DCHARS THEN BEGIN TEMP:=D; D.SPF:=UNPACK(D.SPF, 03150876 0151 + RANK,FINDSIZE(D)); IF DIM=0 THEN DIM:=1; END; 03150878 0154 + IF DIRECTION GTR 0 THEN % OUTOF..TAKE.. OR DROP 03150880 0159 + BEGIN DEFINE STARTSEGMENT=#; %////////////////////////// 03150885 0159 + START OF SEGMENT ********** 90 + IF SIZE+DIM GTR MAXWORDSTORE THEN BEGIN ERR:=KITEERROR; GO TO 03150886 0000 + GOHOME END ELSE TEMP:=L:=GETSPACE(SIZE+DIM); %ROOM FOR RESULT 03150887 0002 + IF DIM GTR 0 THEN 03150888 0009 + IF DIM=1 THEN BEGIN SP[LOC]:=SIZE; L:=L+1;END 03150890 0010 + ELSE FOR I:=1 STEP 1 UNTIL RANK DO 03150895 0016 + IF SIZEMAP[I] GTR 1 THEN 03150900 0018 + IF (M:=MAP[I].SPF)=0 THEN BEGIN SP[LOC]:= 03150901 0019 + SIZEMAP[I];L:=L+1;END ELSE 03150902 0025 + BEGIN N:=M+MAP[I].RF-1; 03150904 0028 + 03150905 0031 + FOR M:=M STEP 1 UNTIL N DO BEGIN 03150906 0031 + SP[LOC]:=SP[MOC];L:=L+1;END; 03150908 0033 + END; 03150909 0041 + COMMENT THIS INITIALIZES RESULT DIM VECTOR; 03150910 0043 + ADDRESS:= D.SPF+D.RF; 03150912 0043 + END ELSE % DIRECTION IS INTO 03150915 0046 + 90 IS 47 LONG, NEXT SEG 87 + BEGIN DEFINE STARTSEGMENT=#; %///////////////// 03150920 0161 + START OF SEGMENT ********** 91 + L:=L-1; SUBSCRIPTS:=SUBDESC:=SP[LOC]; 03150925 0000 + IF FINDSIZE(SUBDESC) NEQ SIZE THEN 03150930 0004 + BEGIN ERR:=RANKERROR; GO TO GOHOME;END; 03150932 0005 + N:=SUBDESC.RF; 03150940 0009 + IF BOOLEAN(SUBDESC.CHRMODE) THEN SUBDESC.SPF:= 03150942 0010 + UNPACK(SUBDESC.SPF,N,FINDSIZE(SUBDESC)); 03150944 0012 + IF DCHARS THEN L:= D.SPF ELSE BEGIN 03150946 0015 + L:=GETSPACE(N:=(NUMELEMENTS(D)+D.RF)); 03150950 0018 + SPCOPY(D.SPF,L,N); % MAKE FRESH COPY TO PATCH INTO 03150960 0021 + END; 03150962 0023 + ADDRESS:=L+D.RF; % SP LOCATION TO STORE INTO 03150970 0023 + N:=D.LOCFIELD;I:=SP[NOC].BACKP; 03150971 0024 + SP[NOC]:=D&L[CSPF]&I[CLOCF];%STORE NEW DESC. 03150972 0029 + OLDDATA:=CHAIN(IF DCHARS THEN TEMP ELSE D,OLDDATA); 03150974 0034 + IF BOOLEAN(D.NAMED ) THEN BEGIN 03150980 0037 + N:=N-1;IF I=0 AND SP[NOC].SUSPENDVAR=0 03150990 0038 + THEN SP[NOC].CHANGE:=1%MUST BE A REAL GLOBAL 03151000 0043 + END ELSE %IT MUST BE A LOCAL VARIABLE 03151010 0047 + AREG.NAMED:=1;%DONT LET IT BE FORGOTTEN ON POP 03151020 0048 + L:=SUBDESC.SPF+SUBDESC.RF;%POINT TO SOURCE 03151030 0053 + END; 03151040 0055 + 91 IS 57 LONG, NEXT SEG 87 + 03151300 0162 + 03151305 0162 + WHILE TRUE DO % RECURSIVE EVALUATION LOOP 03151310 0162 + BEGIN N:=POINTER[RANK]+ADDRESS; 03151320 0162 + LEVEL:=RANK; 03151322 0164 + IF DIRECTION GTR 0 THEN %OUTOF..TAKE..DROP 03151330 0165 + BEGIN SP[LOC]:=SP[NOC]; L:=L+1; 03151340 0165 + END ELSE BEGIN % INTO 03151350 0172 + SP[NOC]:= SP[LOC];L:=L+1; END; 03151360 0173 + WHILE PROGRESS[LEVEL]GEQ SIZEMAP[LEVEL] DO 03151420 0179 + BEGIN PROGRESS[LEVEL]:=1 ; %LOOK FOR MORE WORK 03151430 0182 + IF LEVEL:=LEVEL-1 LEQ 0 THEN GO TO DONE; 03151440 0183 + END; 03151450 0186 + COMMENT THERE IS MORE ON THIS LEVEL; 03151460 0186 + PROGRESS[LEVEL]:=PROGRESS[LEVEL]+1; 03151470 0186 + K:=POINTER[LEVEL]:=POINTER[LEVEL-1] +SUBINDEX( 03151480 0189 + MAP[LEVEL],SIZEMAP[LEVEL],PROGRESS[LEVEL])× 03151482 0191 + BLOCKSIZE[LEVEL];%POINTER[0] IS 0 03151484 0194 + FOR I:=LEVEL+1 STEP 1 UNTIL RANK DO 03151490 0197 + K:=POINTER[I]:=K+SUBINDEX(MAP[I],SIZEMAP[I], 03151500 0201 + PROGRESS[I])×BLOCKSIZE[I]; 03151510 0204 + END; % OF RECURSIVE EVALUATION LOOP 03151520 0208 + DONE: IF DIRECTION GTR 0 THEN % OUTOF TAKE OR DROP 03151550 0209 + IF DCHARS THEN BEGIN PACK(TEMP,DIM,SIZE); 03151552 0209 + FORGETSPACE(D.SPF,RANK+FINDSIZE(D)); 03151554 0212 + SUBSCRIPTS:=TEMP&DIM[CRF]&DDPUVC[CDID]; 03151556 0214 + END ELSE % THIS IS A NUMERIC VECTOR 03151557 0217 + IF DIM=0 THEN SUBSCRIPTS:=TEMP&DDPUSW[CDID] ELSE 03151558 0217 + SUBSCRIPTS:=TEMP&DIM[CRF]&DDPUVW[CDID] 03151560 0221 + ELSE % THE DIRECTION IS INTO 03151562 0223 + BEGIN IF BOOLEAN(SUBDESC.CHRMODE) THEN 03151564 0224 + FORGETSPACE(SUBDESC.SPF,FINDSIZE(SUBDESC)+1); 03151566 0225 + IF DCHARS THEN PACK(D.SPF,RANK,FINDSIZE(D)); 03151568 0228 + END; 03151570 0231 + 03151580 0231 + END; 03151800 0231 + GOHOME: IF DIRECTION GTR 1 THEN 03152000 0231 + FOR I:=1 STEP 1 UNTIL RANK DO 03152003 0232 + IF MAP[I] LSS 0 THEN FORGETSPACE(MAP[I].SPF,SIZEMAP[I]+1); 03152006 0234 + END; % OF SUBSCRIPTS PROCEDURE 03152010 0241 + 87 IS 252 LONG, NEXT SEG 56 + PROCEDURE IMS(N); VALUE N; INTEGER N; 03152100 0010 + BEGIN COMMENT N=0 FOR REGULAR INTERRUPT MKS 03152110 0010 + N=1 FOR QQUAD INTERRUPT MKS 03152120 0010 + N=2 FOR QUAD INTERRUPT MKS 03152130 0010 + N=3 FOR EXECUTION LINE FOLLOWING 03152132 0010 + N=4 FOR SUSPENDED FUNCTION; 03152134 0010 + INTEGER L,M; 03152150 0010 + START OF SEGMENT ********** 92 + 03152155 0000 + PUSH;AREG:=OLDDATA&(LASTMKS-STACKBASE) 03152160 0000 + [BACKPT]&N[QUADINV]&IMKS[CDID]; 03152170 0003 + IF N NEQ 4 THEN BEGIN L:=LASTMKS;SP[LOC].CIF:=CINDEX;END; 03152180 0007 + L:=STACKBASE+1;L:=SP[LOC].SPF +1; 03152190 0013 + IF (M:=SP[LOC].SPF) NEQ 0 THEN % SAVE CURLINE 03152195 0018 + BEGIN L:=L+M; L:=SP[LOC].LOCFIELD; 03152200 0022 + SP[LOC].CIF:=CURLINE; 03152210 0027 + END; 03152220 0032 + LASTMKS:=ST; 03152225 0032 + END; 03152230 0032 + 92 IS 36 LONG, NEXT SEG 56 + PROCEDURE DISPLAYCHARV(D); VALUE D; REAL D; 03152500 0010 + BEGIN INTEGER I,J,K,L,M,NWORDS,NJ,T,NMAT,II,JJ,WDLINE,F,CC; 03152510 0010 + START OF SEGMENT ********** 93 + COMMENT WDLINE=#WORDS NEEDED TO FILL A TELETYPE LINE 03152512 0000 + NWORDS=#WORDS NEEDED TO GET F CHARACTERS FOR LAST 03152514 0000 + TELETYPE LINE OF A ROW 03152515 0000 + F=#CHARACTERS IN LAST TELETYPE LINE OF A ROW 03152516 0000 + T=#TELETYPE LINES NEEDED PER ROW BEYOND FIRST LINE 03152517 0000 + NMAT=#MATRICES TO BE PRINTED OUT (1 IF RANK=2); 03152518 0000 + L := (T:=D.SPF) + (NJ:=D.RF) - 1; 03152520 0000 + J := SP[LOC]; %J IS NUMBER OF CHARACTERS PER ROW 03152530 0003 + IF NJ GTR 1 THEN BEGIN 03152540 0006 + L:=L-1; K:=SP[LOC] 03152550 0007 + END ELSE K := 1; %K IS NUMBER OF ROWS PER MATRIX 03152560 0011 + 03152570 0013 + L := T + NJ; 03152580 0013 + NMAT := FINDSIZE(D) DIV (J×K); 03152590 0014 + WDLINE := (LINESIZE+6) DIV 8 + 1; 03152595 0016 + IF II:=J-LINESIZE GTR 0 THEN BEGIN 03152600 0019 + T:=II DIV (I:=LINESIZE-2)+(IF II MOD I=0 THEN 0 ELSE 1); 03152605 0022 + NWORDS:=((F:=II-(T-1)×I)+6) DIV 8 + 1; 03152610 0028 + END ELSE BEGIN NWORDS:=((F:=J)+6)DIV 8 + 1; T:=0; END; 03152615 0032 + FOR II:=1 STEP 1 UNTIL NMAT DO BEGIN 03152620 0036 + FOR I:=1 STEP 1 UNTIL K DO BEGIN 03152625 0038 + CC:=0; 03152630 0039 + FOR JJ:=1 STEP 1 UNTIL T DO BEGIN 03152635 0039 + TRANSFERSP(OUTOF,SP,L+M DIV 8,BUFFER,0,WDLINE); 03152640 0041 + FORMROW(3,CC,BUFFER,ENTIER(M MOD 8),NJ:=LINESIZE-CC); 03152644 0045 + M := M + NJ; CC := 2; END; 03152646 0050 + IF I=K AND II=NMAT THEN IF L+M DIV 8 + NWORDS GTR 03152648 0055 + (1+NROWS)×SPRSIZE THEN NWORDS:=NWORDS-1; 03152650 0059 + %TO TAKE CARE OF BEING AT END OF SP 03152655 0062 + TRANSFERSP(OUTOF,SP,L+M DIV 8, BUFFER,0,NWORDS); 03152660 0062 + FORMROW(3,CC,BUFFER,ENTIER(M MOD 8), F); 03152670 0066 + M := M + F; 03152680 0070 + END; 03152690 0071 + FORMWD(3,"1 "); 03152700 0073 + END; 03152710 0074 + END OF CHARACTER DISPLAY PROCEDURE; 03152720 0077 + 93 IS 86 LONG, NEXT SEG 56 + REAL PROCEDURE SEMICOL; 03153000 0010 + BEGIN COMMENT FORM CHAR STRING FROM TWO DESCRIPTORS; 03153010 0010 + INTEGER J,K,L; 03153020 0010 + START OF SEGMENT ********** 94 + REAL LD, RD; 03153025 0000 + STREAM PROCEDURE BLANKS(B,J,K);VALUE J,K; 03153030 0000 + BEGIN LOCAL T,U; 03153032 0000 + SI:=LOC K; DI:=LOC U; DI:=DI+1; DS:=7 CHR; 03153034 0000 + SI:=LOC J; DI:=LOC T; DI:=DI+1; DS:=7 CHR; 03153036 0001 + DI:=B; U(2(DI:=DI+32));; DI:= DI+K; 03153038 0002 + T(2(DS:=32 LIT " "));J(DS:=1 LIT " "); 03153040 0004 + END; 03153042 0012 + PROCEDURE MOVEC(J,L,K);VALUE J,L,K; INTEGER J,L,K; 03153050 0012 + BEGIN INTEGER I; 03153060 0012 + START OF SEGMENT ********** 95 + IF(J+K+8) GTR MAXBUFFSIZE×8 THEN ERR:=LENGTHERROR ELSE 03153070 0000 + BEGIN TRANSFERSP(OUTOF,SP,L,BUFFER,ENTIER((J+7)DIV 8), 03153080 0003 + ENTIER((K+7) DIV 8)); 03153082 0008 + IF I:=(J MOD 8) NEQ 0 THEN TRANSFER(BUFFER,J+8-I, 03153090 0011 + BUFFER,J,K); END; 03153100 0016 + END; 03153110 0017 + 95 IS 21 LONG, NEXT SEG 94 + INTEGER PROCEDURE MOVEN(J,L,K);VALUE J,L,K;INTEGER J,L,K; 03153150 0012 + BEGIN INTEGER I;K:=K+L-1; I:=MAXBUFFSIZE×8; 03153160 0012 + START OF SEGMENT ********** 96 + BLANKS(BUFFER,I-J,J); 03153161 0003 + FOR L:= L STEP 1 UNTIL K DO 03153162 0005 + BEGIN NUMBERCON(SP[LOC],ACCUM); 03153170 0007 + TRANSFER(ACCUM,2,BUFFER,J:=J+1,ACOUNT); 03153180 0010 + IF (J:=J+ACOUNT)GTR I THEN BEGIN L:=K;ERR:=LENGTHERROR; 03153190 0015 + END;END; 03153200 0019 + MOVEN:=J; 03153210 0022 + END; 03153220 0022 + 96 IS 27 LONG, NEXT SEG 94 + LD := AREG; RD := BREG; 03153225 0012 + IF L:=LD.RF GTR 1 THEN ERR:= RANKERROR ELSE 03153300 0019 + IF LD.SPF NEQ 0 THEN 03153310 0022 + IF BOOLEAN(LD.CHRMODE) THEN MOVEC(0,L+LD.SPF,J:=FINDSIZE 03153320 0024 + (LD))ELSE J:=MOVEN(0,L+LD.SPF,FINDSIZE(LD)); 03153330 0027 + IF L:=RD.RF GTR 1 OR ERR NEQ 0 THEN ERR:=RANKERROR ELSE 03153340 0033 + IF RD.SPF NEQ 0 THEN IF BOOLEAN(RD.CHRMODE) THEN 03153350 0037 + BEGIN MOVEC(J,L+RD.SPF,K:=FINDSIZE(RD));J:=J+K; 03153360 0040 + END ELSE J:=MOVEN(J,L+RD.SPF,FINDSIZE(RD)); 03153370 0045 + IF ERR=0 THEN 03153380 0048 + IF J=0 THEN SEMICOL:=NULLV ELSE 03153381 0049 + BEGIN L:=GETSPACE((K:=ENTIER((J+7)DIV 8))+1); 03153382 0052 + TRANSFERSP(INTO,SP,L+1,BUFFER,0,K); 03153390 0056 + SP[LOC]:=J; SEMICOL:=L&1[CRF]&DDPUVC[CDID]; 03153400 0060 + END; 03153410 0066 + 03153420 0066 + END; 03153430 0066 + 94 IS 72 LONG, NEXT SEG 56 + BOOLEAN PROCEDURE SETUPLINE; 03153500 0010 + BEGIN REAL T;INTEGER M; 03153510 0010 + START OF SEGMENT ********** 97 + IF T:=ANALYZE(FALSE) NEQ 0 THEN % WE HAVE A PROGRAM DESC 03153520 0000 + BEGIN IMS(3); 03153530 0001 + M:=GETSPACE(1); SP[MOC]:=T; 03153540 0003 + LASTMKS:=ST-STACKBASE; 03153550 0007 + PUSH; IF ERR=0 THEN 03153560 0008 + BEGIN AREG:=PROGMKS&LASTMKS[BACKPT]&1[CI]&M[SPTSP]; 03153570 0010 + POLLOC:=M:=T.SPF; POLTOP:=SP[MOC]; 03153580 0016 + LASTMKS:=LASTMKS+1+STACKBASE; CINDEX:=1; 03153590 0021 + END; 03153600 0023 + SETUPLINE:=TRUE; 03153610 0023 + END ELSE SETUPLINE:=FALSE; 03153620 0024 + END; 03153630 0025 + 97 IS 30 LONG, NEXT SEG 56 + BOOLEAN PROCEDURE POPPROGRAM(OLDDATA,LASTMKS); 03154000 0010 + REAL OLDDATA,LASTMKS; 03154100 0010 + BEGIN LABEL EXIT;REAL L,M,N; 03154200 0010 + START OF SEGMENT ********** 98 + WHILE TRUE DO 03154300 0000 + BEGIN 03154400 0000 + WHILE(L:=AREG).DATADESC NEQ 0 AND ERR=0 DO POP; 03154500 0000 + IF L.DID=PROGMKS THEN 03154600 0007 + IF L=0 THEN %SOMETHING IS FUNNY...CONTINUE POPPING 03154700 0008 + POP 03154710 0009 + ELSE BEGIN 03154800 0010 + LASTMKS:=M:=L.BACKF+STACKBASE; 03154850 0011 + IF L.BACKF NEQ 0 AND NOT ((N:=SP[MOC]).DID=IMKS 03154900 0013 + AND N.QUADIN=4) THEN POPPROGRAM:=TRUE; 03155000 0018 + IF N.DID NEQ FMKS THEN 03155090 0022 + FORGETPROGRAM(L);POP;GO TO EXIT; 03155100 0023 + END ELSE %NOT A PROGRAM MKS 03155200 0025 + IF L.DID=FMKS THEN 03155300 0025 + BEGIN % MUST CUT BACK STATE VECTOR 03155400 0027 + M:=STACKBASE+1;M:=SP[MOC].SPF+1;N:=SP[MOC].SPF+M; 03155500 0027 + IF BOOLEAN(SP[NOC].SUSPENDED) THEN BEGIN SP[MOC].RF:=L:= 03155600 0036 + SP[MOC].RF-1;IF L=0 THEN SUSPENSION:=0;END; 03155700 0042 + SP[NOC]:=0;SP[MOC].SPF:=N-M-1;POP; 03155800 0051 + END ELSE % NOT A FMKS EITHER 03155900 0060 + IF L.DID=IMKS THEN 03156000 0060 + BEGIN SCRATCHAIN(OLDDATA);OLDDATA:=L.SPF;POP;END; 03156100 0062 + IF ERR NEQ 0 THEN GO TO EXIT; 03156200 0065 + END; % OF THE DO 03156300 0066 + EXIT: END;%OF PROCEDURE POPPROGRAM 03156400 0067 + 98 IS 71 LONG, NEXT SEG 56 + REAL PROCEDURE BUILDALPHA(LASTCONSTANT); 03210000 0010 + INTEGER LASTCONSTANT; 03210005 0010 + BEGIN 03210010 0010 + ARRAY B[0:BUFFSIZE]; 03210020 0010 + START OF SEGMENT ********** 99 + REAL R; 03210030 0002 + INTEGER L,N; 03210040 0002 + REAL STREAM PROCEDURE GETCHRS(ADDR,B); VALUE ADDR; 03210050 0002 + BEGIN LOCAL C1,C2,TDI,TSI,QM; 03210060 0002 + LOCAL ARROW; 03210065 0004 + LABEL L,DSONE,FINIS,ERR; 03210070 0004 + DI:=LOC QM; DS:=2RESET; DS:=2SET; 03210080 0004 + DI:=LOC ARROW; DS:=RESET; DS:=7SET; 03210085 0004 + DI:=B; DS:=8LIT"0"; 03210090 0005 + SI:=ADDR; 03210100 0007 + L: 03210110 0007 + IF SC=""" THEN % MAY BE A DOUBLE QUOTE 03210120 0007 + BEGIN 03210130 0008 + SI:=SI+1; 03210140 0008 + IF SC=""" THEN % GET RID OF A QUOTE 03210150 0009 + GO TO DSONE; 03210160 0009 + COMMENT ELSE WE ARE LOOKING PAST THE RH QUOTE; 03210170 0010 + GO TO FINIS; 03210180 0010 + END ELSE % LOOK FOR THE QUESTION MARK 03210190 0010 + BEGIN TDI:=DI; DI:=LOC QM; 03210200 0010 + IF SC=DC THEN % END OF BUFFER ENCOUNTERED 03210210 0011 + GO TO ERR; 03210220 0011 + SI:=SI-1; DI:=LOC ARROW; 03210224 0011 + IF SC=DC THEN %FOUND LEFT ARROW 03210226 0012 + GO TO ERR; 03210228 0012 + SI:=SI-1; DI:=TDI; GO TO DSONE 03210230 0013 + END; 03210240 0013 + DSONE: DS:=CHR; TALLY:=TALLY+1; 03210250 0013 + C2:=TALLY; TSI:=SI; SI:=LOC C2; SI:=SI+7; 03210260 0014 + IF SC="0" THEN 03210270 0015 + BEGIN TALLY:=C1; TALLY:=TALLY+1; C1:=TALLY; 03210280 0016 + TALLY:=0; 03210290 0017 + END; 03210300 0018 + SI:=TSI; 03210310 0018 + GO TO L; 03210320 0018 + FINIS: GETCHRS:=SI; 03210330 0018 + DI:=B; SI:=LOC C1; SI:=SI+1; DS:=7CHR; SI:=LOC C2; 03210340 0019 + SI:=SI+7; DS:=CHR; 03210350 0020 + ERR: 03210360 0021 + END; 03210370 0021 + IF R:=GETCHRS(ADDRESS,B) NEQ 0 THEN % GOT A VECTOR 03210380 0022 + IF NOT CURRENTMODE=FUNCMODE THEN 03210385 0026 + BEGIN ADDRESS:=R; 03210390 0027 + COMMENT B[0] HAS THE LENGTH OF THE STRING; 03210400 0029 + IF R:=B[0] GEQ 1 THEN COMMENT A VECTOR; 03210410 0029 + BEGIN 03210420 0030 + L:=GETSPACE(N:=(R-1)DIV 8+2); 03210430 0031 + TRANSFERSP(INTO,SP,L,B,0,N); 03210432 0034 + SP[LOC]:=R; 03210440 0037 + END; 03210450 0040 + N:=GETSPACE(1); 03210460 0040 + R:= L; 03210470 0041 + R.DID:=DDPNVC; 03210480 0042 + R.BACKP:=LASTCONSTANT; 03210482 0044 + LASTCONSTANT:=N; 03210484 0046 + IF B[0]=0 THEN R.DID:=DDPNVW %NULL BECAUSE .SPF=.RF=0 03210490 0047 + %DON"T WANT CHARACTER NULL TO LOOK LIKE CHARS 03210492 0049 + ELSE R.RF:=1; 03210495 0049 + SP[NOC]:=R; 03210497 0052 + COMMENT WE HAVE BUILT THE VECTOR AND DESCRIPTOR; 03210500 0055 + BUILDALPHA:=N 03210510 0055 + END 03210520 0055 + ELSE BEGIN BUILDALPHA:=1;ADDRESS:=R END; 03210521 0056 + %ELSE WE HAVE AN ERROR (MISSING " ETC.) 03210525 0058 + END; % OF THE BUILD ALPHA PROCEDURE 03210530 0058 + 99 IS 64 LONG, NEXT SEG 56 + PROCEDURE PACK(L,OFFSET,N); VALUE L,OFFSET,N; 03210600 0010 + INTEGER L,OFFSET,N; 03210610 0010 + BEGIN 03210620 0010 + LABEL QUIT; 03210625 0010 + START OF SEGMENT ********** 100 + INTEGER M,T,MB,S; 03210630 0000 + STREAM PROCEDURE PACKEM(A,B,N); VALUE N; 03210640 0000 + BEGIN LOCAL T; 03210650 0000 + SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7CHR; 03210660 0000 + SI:=A; DI:=B; 03210670 0001 + T(2(32(SI:=SI+7; DS:=CHR))); N(SI:=SI+7; DS:=CHR); 03210680 0001 + END; 03210690 0006 + IF N = 0 THEN GO TO QUIT; 03210695 0006 + T:=(M:=L:=L+OFFSET)+N; 03210700 0008 + MB:=MAXBUFFSIZE DIV 8 × 8; 03210710 0011 + WHILE M LSS T DO 03210720 0012 + BEGIN 03210730 0014 + TRANSFERSP(OUTOF,SP,M,BUFFER,0,MB:=MIN(MB,T-M)); 03210740 0014 + PACKEM(BUFFER,ACCUM,MB); 03210750 0020 + TRANSFERSP(INTO,SP,L,ACCUM,0,S:=(MB+7)DIV 8); 03210760 0022 + L:=L+S; M:=M+MB 03210770 0027 + END; 03210780 0028 + FORGETSPACE(L,T-L); 03210790 0030 + QUIT: END PROCEDURE PACK; 03210800 0031 + 100 IS 36 LONG, NEXT SEG 56 + INTEGER PROCEDURE UNPACK(S,OFFSET,N); VALUE N,S,OFFSET; 03210810 0010 + INTEGER N,S,OFFSET; 03210820 0010 + BEGIN 03210830 0010 + INTEGER L,M,K,MB,T; 03210840 0010 + START OF SEGMENT ********** 101 + LABEL QUIT; 03210845 0000 + STREAM PROCEDURE UNPACKEM(A,B,N); VALUE N; 03210850 0000 + BEGIN 03210860 0000 + LOCAL T; 03210870 0000 + SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7CHR; 03210880 0000 + SI:=A; DI:=B; 03210890 0001 + T(2(32(DS:=7LIT"0"; DS:=CHR))); 03210900 0001 + N(DS:=7LIT"0"; DS:=CHR); 03210910 0005 + END; 03210920 0008 + IF N = 0 THEN BEGIN UNPACK := S; GO TO QUIT; END; 03210925 0008 + UNPACK:=L:=GETSPACE(OFFSET+N); K:=S+OFFSET-1; 03210930 0011 + FOR M:=S STEP 1 UNTIL K DO 03210940 0015 + BEGIN SP[LOC]:=SP[MOC]; L:=L+1 03210950 0017 + END; 03210960 0022 + K:=L+N; S:=S+OFFSET; 03210970 0025 + MB:=MAXBUFFSIZE DIV 8; 03210980 0028 + N := MB × 8; 03210985 0029 + WHILE L LSS K DO 03210990 0030 + BEGIN 03211000 0031 + TRANSFERSP(OUTOF,SP,S,BUFFER,0,M:=MIN(MB,(K-L+7)DIV 8)); 03211010 0031 + UNPACKEM(BUFFER,ACCUM, M := MIN(K-L, M×8)); 03211020 0039 + TRANSFERSP(INTO,SP,L,ACCUM,0,M); 03211030 0045 + L := L+N; S := S+MB 03211040 0048 + END; 03211050 0049 + QUIT: END PROCEDURE UNPACK; 03211060 0051 + 101 IS 57 LONG, NEXT SEG 56 + PROCEDURE TRANSPOSE; 03220000 0010 + BEGIN INTEGER M,N,L,I,ROW,COL,RANK,OUTER,INNER; REAL NEWDESC; 03220100 0010 + START OF SEGMENT ********** 102 + INTEGER SIZE,J,MAT,TOP,START; BOOLEAN CHARACTER; 03220105 0000 + LABEL QUIT; DEFINE GIVEUP=GO TO QUIT#; 03220110 0000 + REAL NULL, DESC; 03220111 0000 + DEFINE RESULT=RESULTD#; 03220112 0000 + NULL := AREG; DESC := BREG; 03220115 0000 + IF L:=DESC.SPF=0 THEN BEGIN ERR:=DOMAINERROR; GIVEUP; END; 03220200 0006 + RANK := DESC.RF; 03220300 0010 + SIZE := FINDSIZE(DESC); 03220325 0011 + IF RANK LSS 2 THEN BEGIN NEWDESC:=DESC; 03220330 0012 + %THEN THE TRANSPOSE IS THE THING ITSELF 03220332 0014 + NEWDESC.NAMED:=0; 03220333 0014 + NEWDESC.SPF := N:=GETSPACE(RANK+SIZE); 03220335 0016 + SPCOPY(L,N,RANK+SIZE); 03220340 0019 + GO TO QUIT; END; 03220345 0021 + IF DESC.ARRAYTYPE=1 THEN BEGIN 03220350 0021 + L:=UNPACK(L,RANK,SIZE); 03220360 0023 + CHARACTER := TRUE; END; 03220370 0025 + N:=L+RANK-1; COL := SP[NOC]; 03220500 0026 + N:=N-1; ROW := SP[NOC]; 03220600 0030 + TOP := SIZE DIV (MAT:=ROW×COL); 03220650 0034 + NEWDESC := DESC; 03220660 0036 + NEWDESC.SPF := M := GETSPACE(SIZE+RANK); 03220700 0037 + SPCOPY (L,M,RANK-2); 03220800 0040 + N:=M+RANK-1; SP[NOC]:=ROW; 03220900 0042 + N:=N-1; SP[NOC] := COL; 03220950 0047 + J:=0; M:=M+RANK; 03221000 0051 + WHILE J LSS TOP DO BEGIN 03221010 0053 + OUTER:=(START:=L+RANK+J×MAT) + COL - 1; 03221020 0054 + FOR I:=START STEP 1 UNTIL OUTER DO BEGIN INNER:=I+MAT-1; 03221100 0058 + FOR N:=I STEP COL UNTIL INNER DO 03221200 0061 + BEGIN SP[MOC] := SP[NOC]; M:=M+1; END; END; 03221300 0063 + J:=J+1; END; 03221350 0074 + QUIT: IF CHARACTER THEN BEGIN NEWDESC.ARRAYTYPE:=1; 03221400 0076 + FORGETSPACE(L,SIZE+RANK); 03221405 0079 + PACK(NEWDESC.SPF, RANK,SIZE); END; 03221410 0081 + RESULTD := NEWDESC; 03221420 0082 + END PROCEDURE TRANSPOSE; 03221500 0083 + 102 IS 91 LONG, NEXT SEG 56 + BOOLEAN PROCEDURE MATCHDIM(DESC1,DESC2); REAL DESC1,DESC2; 03224000 0010 + BEGIN INTEGER I,L,M,TOP; LABEL DONE; 03225000 0010 + START OF SEGMENT ********** 103 + MATCHDIM:= TRUE; 03225100 0000 + IF DESC1.RF NEQ DESC2.RF THEN BEGIN MATCHDIM:=FALSE; 03225200 0000 + ERR:=RANKERROR; GO TO DONE; END; 03225300 0003 + I:=DESC1.SPF; M:=DESC2.SPF; TOP:=I+DESC1.RF-1; 03225400 0005 + FOR L:=I STEP 1 UNTIL TOP DO BEGIN 03225500 0009 + IF SP[LOC] NEQ SP[MOC] THEN BEGIN MATCHDIM:=FALSE; 03225600 0011 + ERR:=LENGTHERROR; GO TO DONE; END; 03225700 0017 + M:=M+1; END; 03225800 0018 + DONE: END PROCEDURE MATCHDIM; 03225900 0021 + 103 IS 26 LONG, NEXT SEG 56 + INTEGER PROCEDURE RANDINT(A,B,U); VALUE A,B; 03226000 0010 + REAL A,B,U; 03226100 0010 + BEGIN DEFINE QQMODUL = 67108864#, QQMULT = 8189#, 03226200 0010 + START OF SEGMENT ********** 104 + QQRANDOM=(U:=U×QQMULT MOD QQMODUL)/QQMODUL#; 03226300 0000 + RANDINT := (B-A+1)×QQRANDOM+A-.5; 03226400 0000 + END PROCEDURE RANDINT; 03226600 0005 + 104 IS 11 LONG, NEXT SEG 56 + BOOLEAN PROCEDURE BOOLTYPE(A,B); REAL A,B; 03226700 0010 + BEGIN IF ABS(A-1) LEQ FUZZ THEN A:=1; 03226800 0010 + IF ABS(A) LEQ FUZZ THEN A:=0; 03226900 0014 + IF ABS(B-1) LEQ FUZZ THEN B:=1; 03227000 0017 + IF ABS(B) LEQ FUZZ THEN B:=0; 03227100 0020 + BOOLTYPE := (IF A=1 OR A=0 AND B=1 OR B=0 THEN TRUE 03227200 0023 + ELSE FALSE); END PROCEDURE BOOLTYPE; 03227300 0027 + REAL PROCEDURE GAMMA(X); REAL X; 03227305 0032 + COMMENT THIS PROCEDURE WAS TAKEN FROM ACM ALGORITHM 31. 03227310 0032 + THE ONLY DIFFERENCE IS THAT THERE IS NO PROVISION FOR 03227315 0032 + X LEQ 0 SINCE IT WILL NOT BE CALLED IN THAT CASE. IT 03227320 0032 + IS SUPPOSED TO GIVE ACCURACY TO 7 DIGITS; 03227321 0032 + BEGIN REAL H,Y; LABEL A1, A2; 03227325 0032 + START OF SEGMENT ********** 105 + H := 1; Y := X; 03227330 0000 + A1: IF Y = 2 THEN GO TO A2 ELSE IF Y LSS 2 THEN BEGIN 03227335 0001 + H:=H/Y; Y:=Y+1; GO TO A1 END 03227340 0004 + ELSE IF Y GEQ 3 THEN BEGIN 03227345 0007 + Y:=Y-1; H:=H×Y; GO TO A1 END 03227350 0009 + ELSE BEGIN Y := Y - 2; 03227355 0012 + H := (((((((.0016063118 × Y + .0051589951) × Y 03227360 0014 + + .0044511400) × Y + .0721101567) × Y 03227365 0015 + + .0821117404) × Y + .4117741955) × Y 03227367 0017 + + .4227874605) × Y + .9999999758) × H END; 03227370 0019 + A2: GAMMA := H; 03227375 0022 + END OF PROCEDURE GAMMA; 03227380 0023 + 105 IS 36 LONG, NEXT SEG 56 + BOOLEAN PROCEDURE EXCLAM(MARG,NARG,M,ANS); VALUE MARG,NARG,M; 03227800 0032 + REAL MARG,NARG,ANS; INTEGER M; 03227810 0032 + BEGIN INTEGER N,I; REAL DENOM; LABEL PUT; 03227900 0032 + START OF SEGMENT ********** 106 + EXCLAM := TRUE; 03228550 0000 + IF I:=NARG.[1:8] NEQ 0 OR DENOM:=MARG.[1:8] NEQ 0 THEN BEGIN 03228600 0000 + IF MARG LSS 0 OR NARG LSS 0 THEN BEGIN EXCLAM:=FALSE; 03228605 0005 + GO TO PUT; END; 03228607 0008 + IF M=0 THEN ANS:=GAMMA(NARG) ELSE BEGIN 03228610 0008 + IF (NARG-MARG) LEQ 0 THEN BEGIN EXCLAM:=FALSE; GO TO PUT END; 03228615 0011 + ANS := 1; 03228620 0014 + IF I=0 THEN FOR I:=2 STEP 1 UNTIL NARG DO ANS:=ANS×I 03228625 0015 + ELSE ANS:=GAMMA(NARG); 03228630 0018 + IF DENOM=0 THEN BEGIN DENOM:=1; FOR I:=2 STEP 1 UNTIL MARG DO 03228635 0023 + DENOM:=DENOM×I END ELSE DENOM:=GAMMA(MARG); 03228640 0027 + ANS := ANS / (DENOM × GAMMA(NARG-MARG)); 03228645 0032 + END; 03228650 0038 + GO TO PUT; END; 03228655 0038 + IF M=0 THEN BEGIN ANS := 1; 03228700 0038 + FOR I:=1 STEP 1 UNTIL NARG DO ANS:=ANS×I; 03228800 0040 + GO TO PUT; END 03228900 0045 + ELSE BEGIN IF MARG GTR NARG THEN 03229000 0046 + BEGIN ANS:=0; GO TO PUT; END; 03229100 0047 + IF MARG=0 THEN BEGIN ANS:=1; GO TO PUT; END; 03229200 0049 + ANS := NARG - MARG + 1; 03229400 0052 + FOR I:=NARG-MARG+2 STEP 1 UNTIL NARG DO ANS:=ANS×I; 03229500 0054 + DENOM := 1; 03229600 0061 + FOR I:=2 STEP 1 UNTIL MARG DO DENOM:=DENOM×I; 03229700 0061 + ANS := ANS / DENOM; END; 03229800 0066 + PUT: END PROCEDURE EXCLAM; 03229900 0068 + 106 IS 72 LONG, NEXT SEG 56 + BOOLEAN PROCEDURE OPERATION(LEFT,RIGHT,LPTR,OP,ANS); 03230000 0032 + COMMENT: OP DEFINES THE APL OPERATORS AS FOLLOWS: 03230010 0032 + OP APL OPERATOR OP APL OPERATOR 03230015 0032 + 0 + 10 FACT-COMB 03230020 0032 + 1 TIMES 11 LSS 03230025 0032 + 2 - 12 = 03230030 0032 + 3 DIV 13 GEQ 03230035 0032 + 4 * 14 GTR 03230040 0032 + 5 RNDM 15 NEQ 03230045 0032 + 6 RESD-ABS 16 LEQ 03230050 0032 + 7 MIN-FLR 17 AND 03230055 0032 + 8 MAX-CEIL 18 OR 03230060 0032 + 9 NOT 19 NAND 03230061 0032 + 20 NOR 03230062 0032 + 21 LN-LOG 03230063 0032 + THE "CIRCLE" OPERATORS FOLLOW. 03230064 0032 + 22 PI × 30 SQRT(1-B*2) 03230065 0032 + 23 ARCTANH 31 SIN 03230066 0032 + 24 ARCCOSH 32 COS 03230067 0032 + 25 ARCSINH 33 TAN 03230068 0032 + 26 SQRT(B*2-1) 34 SQRT(1+B*2) 03230069 0032 + 27 ARCTAN 35 SINH 03230070 0032 + 28 ARCCOS 36 COSH 03230071 0032 + 29 ARCSIN 37 TANH; 03230072 0032 + 03230073 0032 + COMMENT: LPTR IS LSS 0 IF THE CALL COMES FROM A 03230074 0032 + REDUCTION TYPE PROCEDURE. 03230075 0032 + LPTR = 0 IF OPERATOR IS MONADIC. 03230080 0032 + LPTR GTR 0 IF OPERATOR IS DYADIC. 03230085 0032 + LPTR LSS 0 IF COMES FROM REDUCTION TYPE OPERATION; 03230090 0032 + VALUE LEFT,RIGHT,LPTR,OP; 03230100 0032 + REAL LEFT,RIGHT,LPTR,OP; 03230200 0032 + REAL ANS; 03230210 0032 + BEGIN LABEL PUT,DOMAIN,KITE; DEFINE GIVEUP=GO TO PUT#; 03230300 0032 + START OF SEGMENT ********** 107 + DEFINE MAXEXP=158.037557167#, 03230302 0000 + MINEXP=-103.7216898#; 03230303 0000 + MONITOR INTOVR, ZERO, EXPOVR; 03230305 0000 + OPERATION := TRUE; 03230310 0003 + IF LPTR LSS 0 THEN IF OP GTR 10 AND OP LSS 21 THEN 03230320 0004 + IF NOT BOOLTYPE(LEFT,RIGHT) THEN GO TO DOMAIN; 03230330 0007 + IF OP = 45 THEN IF LPTR=0 THEN OP:=22 03230340 0009 + ELSE IF ABS(LEFT) GTR 7 THEN GO TO DOMAIN 03230345 0011 + ELSE OP := LEFT + 30; 03230350 0013 + IF OP GTR 16 AND OP LSS 21 THEN IF NOT BOOLTYPE(LEFT,RIGHT) 03230355 0015 + THEN GO TO DOMAIN; 03230357 0018 + ZERO:=DOMAIN; INTOVR:=KITE; EXPOVR:=KITE; 03230360 0019 + CASE OP OP BEGIN 03230400 0024 + ANS := LEFT + RIGHT; 03230500 0025 + ANS := IF LPTR=0 THEN SIGN(RIGHT) ELSE LEFT × RIGHT; 03230600 0027 + ANS := LEFT - RIGHT; 03230700 0033 + ANS := LEFT / RIGHT; 03230800 0035 + IF LPTR=0 THEN IF RIGHT GTR MINEXP AND RIGHT LSS MAXEXP 03230900 0037 + THEN ANS:=EXP(RIGHT) ELSE GO TO KITE 03230905 0039 + ELSE IF RIGHT.[3:6]=0 THEN ANS:=LEFT*ENTIER(RIGHT) 03230910 0042 + ELSE IF LEFT GTR 0 THEN IF ANS:=RIGHT×LN(LEFT) GTR MINEXP 03230920 0047 + AND ANS LSS MAXEXP THEN 03230923 0056 + ANS:=EXP(ANS) ELSE GO TO KITE 03230925 0058 + ELSE IF LEFT=0 AND RIGHT GTR 0 THEN ANS:=0 03230930 0060 + ELSE GO TO DOMAIN; 03230935 0065 + IF LPTR NEQ 0 THEN BEGIN ERR:=SYSTEMERROR; GIVEUP; END ELSE 03231000 0066 + IF RIGHT LSS ORIGIN THEN GO TO DOMAIN ELSE 03231010 0069 + ANS := RANDINT(ORIGIN,RIGHT,SEED); 03231100 0070 + IF LPTR=0 THEN ANS := ABS(RIGHT) ELSE 03231200 0074 + BEGIN IF LEFT=0 THEN IF RIGHT GEQ 0 THEN 03231300 0076 + ANS := RIGHT ELSE GO TO DOMAIN 03231400 0079 + ELSE IF (ANS:=RIGHT MOD LEFT) LSS 0 03231500 0080 + THEN ANS:=ANS + ABS(LEFT); END; 03231600 0082 + ANS := (IF LPTR=0 THEN ENTIER(RIGHT+FUZZ) 03231700 0086 + ELSE IF LEFT LEQ RIGHT THEN LEFT ELSE RIGHT); 03231800 0088 + ANS := (IF LPTR=0 THEN -ENTIER(-RIGHT+FUZZ) 03231900 0093 + ELSE IF LEFT GTR RIGHT THEN LEFT ELSE RIGHT); 03232000 0095 + IF LPTR NEQ 0 THEN BEGIN ERR:=SYNTAXERROR; GIVEUP; END 03232100 0101 + ELSE IF NOT BOOLTYPE(0,RIGHT) THEN 03232200 0105 + BEGIN ERR:=DOMAINERROR; GIVEUP; END 03232300 0106 + ELSE ANS := (IF RIGHT=1 THEN 0 ELSE 1); 03232400 0108 + IF NOT EXCLAM(LEFT,RIGHT,LPTR,ANS) THEN GO TO DOMAIN; 03232500 0112 + 03232510 0115 + ANS := (IF RIGHT-LEFT GTR FUZZ×ABS(RIGHT) THEN 1 ELSE 0); 03232600 0115 + ANS:=(IF ABS(LEFT-RIGHT) LEQ FUZZ×ABS(RIGHT) THEN 1 ELSE 0); 03232700 0120 + ANS:=(IF RIGHT-LEFT LEQ FUZZ×ABS(RIGHT) THEN 1 ELSE 0); 03232800 0125 + ANS:=(IF LEFT-RIGHT GTR FUZZ×ABS(RIGHT) THEN 1 ELSE 0); 03232900 0130 + ANS:=(IF ABS(LEFT-RIGHT) GTR FUZZ×ABS(RIGHT) THEN 1 ELSE 0); 03233000 0135 + ANS:=(IF LEFT-RIGHT LEQ FUZZ×ABS(RIGHT) THEN 1 ELSE 0); 03233100 0140 + ANS := RIGHT × LEFT; %AND 03233200 0145 + ANS := IF RIGHT + LEFT = 0 THEN 0 ELSE 1; %OR 03233300 0147 + ANS := IF RIGHT × LEFT = 1 THEN 0 ELSE 1; %NAND 03233400 0151 + ANS := IF RIGHT + LEFT = 0 THEN 1 ELSE 0; %NOR 03233500 0155 + IF RIGHT LEQ 0 THEN GO TO DOMAIN ELSE IF LPTR=0 THEN 03233550 0159 + ANS:=LN(RIGHT) ELSE 03233560 0161 + IF LEFT LEQ 1 THEN GO TO DOMAIN ELSE 03233570 0163 + ANS := LN(RIGHT) / LN(LEFT); %LOGARITHMS 03233600 0165 + ANS := 3.1415926536 × RIGHT; 03233603 0168 + IF ABS(RIGHT) GEQ 1 THEN GO TO DOMAIN ELSE 03233606 0170 + ANS:= .5×LN((1+RIGHT)/(1-RIGHT)); %ARCTANH 03233609 0171 + 03233610 0176 + IF RIGHT LSS 1 THEN GO TO DOMAIN ELSE 03233612 0176 + ANS:=LN(RIGHT+SQRT(RIGHT×RIGHT-1)); %ARCCOSH 03233615 0176 + ANS := LN(RIGHT + SQRT(RIGHT×RIGHT+1)); %ARCSINH 03233618 0181 + 03233620 0185 + IF ABS(RIGHT) LSS 1 THEN GO TO DOMAIN ELSE 03233621 0185 + ANS:=SQRT(RIGHT×RIGHT-1); 03233624 0186 + ANS := ARCTAN(RIGHT); 03233627 0189 + IF ABS(RIGHT) GTR 1 THEN GO TO DOMAIN ELSE 03233630 0191 + IF RIGHT=0 THEN ANS:=1.5707963268 ELSE 03233631 0192 + ANS:=ARCTAN(SQRT(1-RIGHT*2)/RIGHT); %ARCCOS 03233633 0195 + IF ABS(RIGHT) GEQ 1 THEN GO TO DOMAIN ELSE 03233636 0203 + ANS:=ARCTAN(RIGHT/ SQRT(1-RIGHT*2)); %ARCSIN 03233639 0204 + IF ABS(RIGHT) GTR 1 THEN GO TO DOMAIN ELSE 03233642 0208 + ANS := SQRT(1-RIGHT*2); 03233645 0209 + ANS := SIN(RIGHT); 03233648 0213 + ANS := COS(RIGHT); 03233651 0215 + ANS := SIN(RIGHT) / COS(RIGHT); %TAN 03233654 0217 + ANS := SQRT(1+RIGHT×RIGHT); 03233657 0220 + ANS := (EXP(RIGHT) - EXP(-RIGHT))/2; %SINH 03233660 0223 + ANS := (EXP(RIGHT) + EXP(-RIGHT))/2; %COSH 03233663 0226 + ANS := ((OP:=EXP(RIGHT))-(ANS:=EXP(-RIGHT)))/(OP+ANS); %TANH 03233666 0230 + END; 03233669 0236 + START OF SEGMENT ********** 108 + 108 IS 38 LONG, NEXT SEG 107 + GO TO PUT; 03233675 0236 + KITE: ERR:=KITEERROR; GO TO PUT; 03233678 0236 + DOMAIN: ERR:=DOMAINERROR; 03233680 0238 + PUT: IF ERR NEQ 0 THEN OPERATION := FALSE; 03233700 0239 + END PROCEDURE OPERATION; 03233705 0242 + 107 IS 247 LONG, NEXT SEG 56 + PROCEDURE ARITH(OP); VALUE OP; 03233710 0032 + INTEGER OP; 03233715 0032 + COMMENT: ARITH HANDLES ALL APL OPERATORS THAT EMPLOY THE 03233720 0032 + VECTOR-VECTOR, SCALAR-VECTOR, SCALAR-SCALAR, VECTOR-SCALAR 03233725 0032 + FEATURE. DESC1 AND DESC2 ARE THE DESCRIPTORS FOR THE 03233730 0032 + LEFTHAND AND RIGHTHAND OPERANDS, RESPECTIVELY. IF 03233735 0032 + IF DESC1 = 0, THE OPERATOR IS TAKEN TO BE MONADIC. 03233740 0032 + IF DESC.SPF = 0, THE OPERAND IS NULL AND A DOMAIN ERROR 03233745 0032 + RESULTS EXCEPT IN THE CASE OF MULTIPLICATION. 03233750 0032 + OP IS AN INTERNAL OPERATION CODE FOR THE OPERATOR, WHICH 03233755 0032 + DEPENDS ON THE CASE STATEMENT IN THE OPERATION PROCEDURE.; 03233760 0032 + BEGIN INTEGER L,M,I,N,SIZE,RANK1,RANK2,TOP, 03233765 0032 + START OF SEGMENT ********** 109 + FORGETL, FORGETM; 03233770 0000 + REAL DESC,LEFT,RIGHT,ANS,SIZE1,SIZE2,DESC1,DESC2; 03233775 0000 + LABEL DONE, LEFTSCALE, SCALVECT, DOMAIN, VECTSCAL; 03233780 0000 + BOOLEAN CHAR1, CHAR2; 03233785 0000 + DESC1 := AREG; DESC2 := BREG; 03233790 0000 + L:=DESC1.SPF; M:=DESC2.SPF; 03233800 0006 + RANK1:=DESC1.RF; RANK2:=DESC2.RF; 03233850 0009 + SIZE1:=FINDSIZE(DESC1); SIZE2:=FINDSIZE(DESC2); 03233860 0011 + IF(CHAR1:=DESC1.ARRAYTYPE=1) OR (CHAR2:=DESC2.ARRAYTYPE=1) 03233900 0014 + THEN BEGIN IF OP LSS 11 OR OP GTR 16 03233902 0016 + OR NOT(CHAR1 AND CHAR2) AND NOT(OP=12 OR OP=15) 03233903 0019 + THEN BEGIN CHAR1:=CHAR2:=FALSE; GO TO DOMAIN; END; 03233904 0022 + IF CHAR1 THEN 03233906 0025 + FORGETL := L := UNPACK(L,RANK1,SIZE1); 03233908 0026 + IF CHAR2 THEN 03233910 0028 + FORGETM := M := UNPACK(M,RANK2,SIZE2); END; 03234000 0029 + 03234100 0031 + 03234110 0031 + IF M=0 THEN BEGIN IF OP NEQ 1 THEN GO TO DOMAIN 03234200 0031 + ELSE BEGIN DESC := NULLV; 03234230 0033 + GO TO DONE; END; END; 03234240 0035 + IF L=0 THEN BEGIN 03234400 0035 + IF DESC1.DID NEQ 0 THEN 03234410 0036 + IF OP=1 THEN BEGIN DESC:=NULLV; GO TO DONE; END 03234420 0038 + ELSE GO TO DOMAIN; 03234425 0041 + IF OP GTR 10 AND OP LSS 21 THEN GO TO DOMAIN; 03234430 0041 + LEFT := OP MOD 2; GO TO LEFTSCALE; END; 03234440 0043 + IF SIZE1=1 03234500 0045 + THEN BEGIN L:=L+RANK1; LEFT:=SP[LOC]; 03234510 0045 + GO TO LEFTSCALE; END; 03234600 0050 + IF SIZE2=1 THEN BEGIN 03234700 0051 + % DESC1 IS A VECTOR, DESC2 IS A SCALAR; 03234800 0052 + VECTSCAL: M:=M+RANK2; RIGHT:=SP[MOC]; 03234900 0052 + I := GETSPACE( SIZE:=SIZE1+RANK1); 03235000 0057 + DESC.SPF:=I; DESC.DID:=DDPUVW; SPCOPY(L,I,RANK1); 03235100 0059 + L:=L+RANK1; I:=I+RANK1; 03235200 0064 + DESC.RF:=RANK1; TOP:=SIZE1+I-1; 03235300 0066 + FOR N:=I STEP 1 UNTIL TOP DO BEGIN 03235400 0070 + IF OPERATION(SP[LOC],RIGHT,L,OP,ANS) THEN 03235500 0071 + SP[NOC] := ANS ELSE GO TO DONE; 03235510 0074 + L:=L+1; END; 03235600 0078 + GO TO DONE; END; 03235700 0081 + % BOTH DESC1 AND DESC2 ARE ARRAYS; 03235800 0082 + IF NOT MATCHDIM(DESC1,DESC2) THEN GO TO DONE 03235900 0082 + ELSE BEGIN 03236000 0083 + I := GETSPACE( SIZE := SIZE2 + RANK2 ); 03236100 0083 + SPCOPY(M,I,RANK2); DESC.SPF:=I; DESC.DID:=DDPUVW; 03236200 0086 + DESC.RF := RANK2; 03236300 0090 + M:=M+RANK2; I:=I+RANK2; L:=L+RANK2; 03236400 0092 + TOP := I+SIZE2-1; 03236500 0096 + FOR N:=I STEP 1 UNTIL TOP DO BEGIN 03236600 0098 + IF OPERATION(SP[LOC],SP[MOC],L,OP,ANS) THEN 03236700 0099 + SP[NOC] := ANS ELSE GO TO DONE; 03236710 0104 + L:=L+1; M:=M+1; END; 03236800 0108 + GO TO DONE; END; 03236900 0113 + LEFTSCALE: IF SIZE2 = 1 03237000 0113 + THEN BEGIN 03237050 0114 + IF RANK1 NEQ RANK2 THEN BEGIN 03237060 0115 + IF RANK1=0 THEN GO TO SCALVECT; 03237065 0116 + IF RANK2=0 THEN BEGIN L:=L-RANK1; GO TO VECTSCAL; END; 03237068 0117 + IF CHAR1 AND RANK1=1 THEN GO TO SCALVECT; 03237070 0120 + IF CHAR2 AND RANK2=1 THEN GO TO VECTSCAL; 03237075 0122 + ERR:=KITEERROR; GO TO DONE; END 03237080 0124 + ELSE IF RANK1×RANK2 NEQ 0 THEN GO TO SCALVECT; 03237090 0126 + % BOTH OPERANDS ARE SCALAR; 03237100 0128 + M := M + RANK2; 03237150 0128 + N := GETSPACE(SIZE:=1); RIGHT:=SP[MOC]; 03237200 0129 + DESC.SPF := N; DESC.DID := DDPUSW; 03237300 0134 + IF OPERATION(LEFT,RIGHT,L,OP,ANS) THEN 03237400 0137 + SP[NOC] := ANS ELSE GO TO DONE; 03237410 0139 + GO TO DONE; END 03237500 0142 + ELSE BEGIN %DESC1 IS SCALAR, DESC2 IS VECTOR; 03237600 0143 + 03237700 0143 + SCALVECT: I := GETSPACE( SIZE := SIZE2 + RANK2); 03237800 0143 + DESC.SPF := I; DESC.RF := RANK2; DESC.DID:=DDPUVW; 03237900 0146 + SPCOPY(M,I,RANK2); 03238000 0151 + M:=M+RANK2; I:=I+RANK2; TOP:=SIZE2+I-1; 03238100 0152 + FOR N:=I STEP 1 UNTIL TOP DO BEGIN 03238200 0157 + IF OPERATION(LEFT,SP[MOC],L,OP,ANS) 03238290 0158 + THEN SP[NOC] := ANS ELSE GO TO DONE; 03238300 0161 + M := M+1; END; 03238400 0165 + END; 03238450 0168 + GO TO DONE; 03238500 0168 + DOMAIN: ERR := DOMAINERROR; 03238550 0169 + DONE: RESULTD := DESC; 03238560 0170 + IF CHAR1 THEN FORGETSPACE(FORGETL,SIZE1+RANK1); 03238570 0171 + IF CHAR2 THEN FORGETSPACE(FORGETM,SIZE2+RANK2); 03238580 0174 + IF ERR NEQ 0 THEN FORGETSPACE(DESC.SPF, SIZE); 03238590 0176 + END PROCEDURE ARITH; 03238600 0179 + 109 IS 187 LONG, NEXT SEG 56 + PROCEDURE DYADICRNDM; 03238700 0032 + BEGIN INTEGER NUM, KIND; REAL DESC; 03238800 0032 + START OF SEGMENT ********** 110 + REAL DESC1, DESC2; 03238805 0000 + INTEGER L,M,N,T,I,TEMP,OUTTOP,TOP,PICK; LABEL QUIT; 03238810 0000 + INTEGER START; LABEL INSERT; 03238815 0000 + DESC1 := AREG; DESC2 := BREG; 03238820 0000 + IF FINDSIZE(DESC1) NEQ 1 OR FINDSIZE(DESC2) NEQ 1 03238850 0006 + THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END; 03238900 0008 + IF DESC1.SPF=0 OR DESC2.SPF=0 THEN BEGIN 03238910 0011 + ERR:=DOMAINERROR; GO TO QUIT; END; 03238915 0014 + L:=DESC1.SPF+DESC1.RF; M:=DESC2.SPF+DESC2.RF; 03238950 0015 + NUM := SP[LOC]; KIND := SP[MOC]; 03239000 0020 + IF KIND LSS ORIGIN 03239050 0025 + OR NUM GTR PICK := KIND-ORIGIN+1 03239055 0026 + OR DESC1.ARRAYTYPE=1 03239060 0027 + OR DESC2.ARRAYTYPE=1 THEN BEGIN ERR:=DOMAINERROR; 03239070 0030 + GO TO QUIT; END; 03239100 0033 + DESC.DID := DDPUVW; DESC.RF := 1; 03239150 0034 + IF NUM LEQ 0 THEN BEGIN DESC := NULLV; GO TO QUIT; END; 03239200 0037 + IF NUM GTR MAXWORDSTORE THEN BEGIN ERR:=KITEERROR; GO TO QUIT END; 03239210 0040 + DESC.SPF := L := GETSPACE(NUM+1); 03239250 0044 + SP[LOC] := NUM; L := L+1; 03239300 0047 + OUTTOP := L+NUM-1; 03239350 0051 + TEMP := GETSPACE(NUM); 03239355 0053 + START:=ORIGIN; I:=0; 03239360 0054 + FOR L:=L STEP 1 UNTIL OUTTOP DO BEGIN 03239365 0056 + PICK:=RANDINT(START,KIND,SEED); 03239370 0057 + M:=TEMP; 03239375 0059 + IF I = 0 OR PICK LSS SP[MOC] THEN N:=TEMP 03239380 0059 + ELSE BEGIN TOP:=TEMP+I-1; 03239385 0064 + N:=TEMP+T:=I DIV 2; 03239390 0067 + WHILE T GTR 0 DO 03239395 0069 + IF PICK GEQ SP[NOC] THEN N:=N+T:=T DIV 2 03239400 0070 + ELSE N:=N-T:=T DIV 2; 03239405 0074 + 03239410 0079 + FOR N:=MAX(TEMP,N-3) STEP 1 UNTIL TOP DO 03239415 0079 + IF SP[NOC] GTR PICK THEN 03239420 0085 + GO TO INSERT; 03239425 0088 + END; 03239430 0089 + INSERT: IF L LSS OUTTOP THEN BEGIN TOP:=N+1; N:=TEMP+I; 03239435 0089 + FOR M:=N STEP -1 UNTIL TOP DO BEGIN 03239440 0093 + N:=N-1; SP[MOC] := SP[NOC] - 1; END; 03239445 0095 + SP[NOC] := PICK; END; 03239450 0104 + SP[LOC] := N - TEMP + PICK; 03239455 0107 + KIND:=KIND-1; 03239460 0111 + I:=I+1; 03239465 0112 + END; 03239470 0113 + FORGETSPACE(TEMP,NUM); 03239475 0115 + QUIT: RESULTD := DESC; 03239500 0116 + END PROCEDURE DYADICRNDM; 03239550 0117 + 110 IS 124 LONG, NEXT SEG 56 + PROCEDURE RHOP; 03239600 0032 + BEGIN INTEGER RANK,M,POINT; REAL NEWDESC,DESC1,DESC; 03239605 0032 + START OF SEGMENT ********** 111 + LABEL QUIT, WORK; BOOLEAN CHARACTER; 03239610 0000 + DEFINE TOOBIG=BEGIN ERR:=KITEERROR; GO TO QUIT; END#; 03239615 0000 + INTEGER N,TOP,NEWRANK,RANK1, POINT1,SIZE1,L,SIZE2; 03239620 0000 + DESC1 := AREG; DESC := BREG; 03239625 0000 + IF DESC.SPF = 0 THEN BEGIN ERR:=DOMAINERROR; GO TO QUIT; END; 03239630 0006 + IF DESC1.DID NEQ 0 THEN BEGIN %--DYADIC RHO--RESTRUCTURING--------- 03239632 0009 + IF L:=DESC1.SPF = 0 THEN BEGIN %NULL LEFT OP MEANS SCALAR ANS 03239635 0011 + IF DESC.ARRAYTYPE=1 THEN TOOBIG; %NO SCALAR CHARACTERS 03239638 0013 + NEWDESC.SPF:=M:=GETSPACE(1); 03239641 0016 + NEWDESC.DID:=DDPUSW; 03239644 0019 + L:=DESC.SPF+DESC.RF; 03239647 0021 + SP[MOC]:=SP[LOC]; GO TO QUIT; END; 03239650 0023 + IF DESC1.ARRAYTYPE NEQ 0 THEN BEGIN 03239653 0028 + ERR:=DOMAINERROR; GO TO QUIT; END; 03239656 0030 + RANK1:=DESC1.RF; 03239659 0031 + IF FINDSIZE(DESC1)=1 THEN BEGIN 03239662 0033 + N:=L+RANK1; 03239665 0034 + IF SIZE1:=ENTIER(SP[NOC]+.5) LSS 0 THEN BEGIN 03239668 0036 + ERR:=DOMAINERROR; GO TO QUIT; END; 03239671 0041 + NEWRANK:=1; TOP:=N; GO TO WORK; END; 03239674 0044 + IF RANK1 NEQ 1 THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END; 03239677 0046 + IF NEWRANK:=SP[LOC] GTR 31 THEN TOOBIG; 03239725 0048 + SIZE1:=1; TOP := L+NEWRANK+RANK1-1; 03239726 0053 + IF NEWRANK LEQ 0 THEN BEGIN ERR:=SYSTEMERROR; GO TO QUIT; END; 03239727 0056 + FOR N:=L+RANK1 STEP 1 UNTIL TOP DO 03239728 0059 + IF SIZE1:=SIZE1×ENTIER(SP[NOC]+.5) LSS 0 THEN BEGIN 03239730 0063 + ERR:=DOMAINERROR; GO TO QUIT; END; 03239732 0069 + WORK: IF SIZE1=0 THEN BEGIN NEWDESC := NULLV; GO TO QUIT END; 03239734 0072 + IF SIZE1 GTR MAXWORDSTORE THEN TOOBIG; 03239736 0075 + NEWDESC.DID:=DDPUVW; NEWDESC.RF:=NEWRANK; 03239737 0079 + NEWDESC.SPF := M := GETSPACE(SIZE1+NEWRANK); 03239738 0082 + %CANT USE SPCOPY FOR DIM VECTOR AS LEFT OP MAY NOT BE INTEGER 03239739 0085 + FOR L:=L+RANK1 STEP 1 UNTIL TOP DO 03239740 0085 + BEGIN SP[MOC]:=ENTIER(SP[LOC]+.5); M:=M+1; END; 03239742 0090 + SIZE2:=FINDSIZE(DESC); L:=DESC.SPF; RANK:=DESC.RF; 03239743 0100 + IF DESC.ARRAYTYPE=1 THEN BEGIN L:=UNPACK(L,RANK,SIZE2); 03239744 0103 + CHARACTER:=TRUE; END; TOP:=SIZE1 DIV SIZE2; POINT:=L+RANK; 03239745 0107 + FOR N:=1 STEP 1 UNTIL TOP DO BEGIN SPCOPY(POINT,M,SIZE2); 03239746 0110 + M := M+SIZE2; END; 03239748 0113 + TOP := SIZE1 MOD SIZE2; SPCOPY(POINT,M,TOP); 03239750 0116 + GO TO QUIT; END ELSE 03239752 0119 + %--------MONADIC RHO-----DIMENSION VECTOR---------------------- 03239760 0119 + RANK := DESC.RF; POINT := DESC.SPF; 03239800 0119 + NEWDESC.DID := DDPUVW; NEWDESC.RF := 1; 03239850 0122 + IF DESC.DATATYPE = 1 THEN BEGIN 03239900 0126 + NEWDESC := NULLV; GO TO QUIT END; 03239950 0128 + NEWDESC.SPF := M := GETSPACE(RANK+1); 03240000 0129 + SP[MOC] := RANK; 03240050 0132 + SPCOPY(POINT,M+1, RANK); 03240100 0135 + QUIT: IF CHARACTER THEN BEGIN NEWDESC.ARRAYTYPE:=1; 03240150 0137 + FORGETSPACE(L,SIZE2+RANK); 03240152 0140 + PACK(NEWDESC.SPF, NEWRANK,SIZE1); END; 03240155 0142 + RESULTD := NEWDESC; 03240160 0143 + END PROCEDURE RHOP; 03240200 0144 + 111 IS 151 LONG, NEXT SEG 56 + PROCEDURE IOTAP; 03240750 0032 + BEGIN INTEGER I,L,M,TOP; REAL DESC; 03240800 0032 + START OF SEGMENT ********** 112 + REAL LEFTOP, RIGHTOP; 03240802 0000 + INTEGER RSIZE,LSIZE,RRANK,LRANK,N,LL,MM,TIP,NIX; 03240805 0000 + 03240807 0000 + LABEL QUIT, DONE; 03240810 0000 + LEFTOP:=AREG; RIGHTOP:=BREG; 03240812 0000 + IF L:=RIGHTOP.SPF=0 THEN BEGIN ERR:=DOMAINERROR; GO TO QUIT END; 03240813 0006 + RSIZE:=FINDSIZE(RIGHTOP); RRANK:=RIGHTOP.RF; 03240815 0010 + DESC.DID := DDPUVW; DESC.RF := 1; 03240817 0012 + IF LEFTOP.DID NEQ 0 THEN BEGIN %-------DYADIC IOTA------------ 03240820 0016 + IF LRANK := LEFTOP.RF GTR 1 THEN BEGIN ERR:=RANKERROR; 03240825 0017 + GO TO QUIT; END; 03240830 0020 + LSIZE := FINDSIZE(LEFTOP); 03240835 0021 + IF M:=LEFTOP.SPF=0 THEN BEGIN %RESULT IS ORIGIN IF IT WAS NULL 03240840 0022 + DESC.SPF:=M:=GETSPACE(1); DESC.RF:=0; DESC.SCALAR:=1; 03240842 0024 + SP[MOC] := ORIGIN; GO TO QUIT; END; 03240845 0031 + IF LEFTOP.ARRAYTYPE=1 THEN M:=UNPACK(M,LRANK,LSIZE); 03240850 0034 + IF RIGHTOP.ARRAYTYPE=1 THEN L:=UNPACK(L,RRANK,RSIZE); 03240855 0038 + TIP := (NIX:=LSIZE+ORIGIN) - 1; 03240875 0041 + DESC.SPF:=N:=GETSPACE(RSIZE+RRANK); 03240880 0044 + IF RRANK=0 THEN DESC.SCALAR:=1 ; DESC.RF:=RRANK; 03240890 0047 + SPCOPY(L,N,RRANK); 03240895 0052 + MM := M+LRANK; LL:=L:=L+RRANK; 03240900 0053 + TOP:=N+RRANK+RSIZE-1; 03240905 0056 + FOR N:=N+RRANK STEP 1 UNTIL TOP DO BEGIN 03240910 0058 + SP[NOC] := NIX; 03240915 0063 + M := MM; 03240920 0066 + FOR I:=ORIGIN STEP 1 UNTIL TIP DO 03240925 0066 + IF OPERATION(SP[MOC],SP[LOC],1,12,LEFTOP) AND LEFTOP=1 03240930 0070 + THEN BEGIN SP[NOC]:=I; GO TO DONE; 03240935 0076 + END ELSE M:=M+1; 03240940 0081 + DONE: L:=L+1; END; 03240945 0083 + IF LEFTOP.ARRAYTYPE=1 THEN FORGETSPACE(MM-LRANK,LRANK+LSIZE); 03240950 0085 + IF RIGHTOP.ARRAYTYPE=1 THEN FORGETSPACE(LL-RRANK,RRANK+RSIZE); 03240955 0089 + END ELSE BEGIN %-------------MONADIC IOTA------------------- 03240960 0093 + IF RIGHTOP.ARRAYTYPE=1 THEN 03241000 0093 + BEGIN ERR:=DOMAINERROR; GO TO QUIT 03241002 0095 + END; 03241004 0096 + IF RSIZE NEQ 1 THEN BEGIN ERR:=RANKERROR; GO TO QUIT END; 03241025 0096 + 03241030 0099 + L := L + RRANK; 03241040 0099 + IF TOP:=SP[LOC] GTR MAXWORDSTORE THEN 03241050 0100 + BEGIN ERR:=KITEERROR; GO TO QUIT 03241054 0103 + END; 03241056 0105 + 03241075 0107 + IF TOP LSS ORIGIN THEN BEGIN DESC:=NULLV; GO TO QUIT END; 03241080 0107 + DESC.SPF := M := GETSPACE(TOP+1); 03241100 0109 + SP[MOC] := TOP; M := M+1; 03241125 0113 + TOP := TOP + ORIGIN - 1; 03241130 0117 + FOR I := ORIGIN STEP 1 UNTIL TOP DO BEGIN 03241150 0119 + SP[MOC] := I; M := M+1; END; 03241175 0123 + END; 03241180 0128 + QUIT: RESULTD := DESC; 03241200 0128 + END PROCEDURE IOTAP; 03241225 0128 + 112 IS 135 LONG, NEXT SEG 56 + PROCEDURE COMMAP; 03241300 0032 + BEGIN REAL LDESC, RDESC; 03241400 0032 + START OF SEGMENT ********** 113 + INTEGER L,M,N,LRANK,RRANK,LSIZE,RSIZE,SIZE; 03241500 0000 + REAL DESC; LABEL QUIT; BOOLEAN CHARACTER; 03241600 0000 + LDESC := AREG; RDESC := BREG; 03241650 0000 + RRANK := RDESC.RF; LRANK := LDESC.RF; 03241700 0006 + LSIZE := IF (L := LDESC.SPF) = 0 THEN 0 ELSE FINDSIZE(LDESC); 03241800 0009 + RSIZE := IF (M := RDESC.SPF) = 0 THEN 0 ELSE FINDSIZE(RDESC); 03241900 0013 + IF RDESC.ARRAYTYPE = 1 THEN BEGIN 03242000 0017 + M := UNPACK(M,RRANK,RSIZE); 03242100 0019 + CHARACTER := TRUE; END; 03242200 0021 + DESC.DID := DDPUVW; DESC.RF := 1; 03242250 0021 + IF LDESC.DID = 0 THEN BEGIN %-----MONADIC COMMA--RAVEL-------- 03242300 0025 + IF RSIZE=0 THEN BEGIN DESC:=NULLV; GO TO QUIT END; 03242400 0027 + DESC.SPF := L := GETSPACE(RSIZE+1); 03242500 0029 + SP[LOC] := RSIZE; 03242700 0032 + SPCOPY(M+RRANK, L+1, RSIZE); 03242800 0035 + N := L; SIZE := RSIZE; 03242850 0038 + GO TO QUIT; END 03242900 0039 + ELSE BEGIN 03243000 0040 + %HERE IS THE CODE FOR DYADIC COMMA, I.E. CATENATION 03243100 0040 + IF RRANK NEQ 1 AND RSIZE GTR 1 OR 03243200 0040 + LRANK NEQ 1 AND LSIZE GTR 1 THEN BEGIN 03243250 0042 + ERR:= RANKERROR; GO TO QUIT; END; 03243300 0044 + IF SIZE:=LSIZE+RSIZE GTR MAXWORDSTORE THEN BEGIN 03243400 0046 + ERR:=KITEERROR; GO TO QUIT; END; 03243500 0048 + COMMENT CANT MIX NUMBERS AND CHARACTERS. HAVE TO JUGGLE 03243540 0051 + IF LEFT IS NUMBERS AND RIGHT IS CHARACTERS AS RIGHT 03243541 0051 + HAS ALREADY BEEN UNPACKED AND WE DONT WANT TO FORGET 03243542 0051 + LEFT AND WE DONT WANT TO PACK THE NON-RESULT; 03243543 0051 + IF CHARACTER THEN 03243550 0051 + IF LDESC.ARRAYTYPE=1 OR LSIZE=0 THEN L:=UNPACK(L,LRANK,LSIZE) 03243600 0051 + ELSE BEGIN SIZE:=0; LSIZE:=-LRANK; ERR:=DOMAINERROR; 03243700 0055 + GO TO QUIT END 03243705 0059 + ELSE IF LDESC.ARRAYTYPE=1 THEN 03243710 0059 + IF RSIZE NEQ 0 THEN 03243715 0061 + BEGIN ERR:=DOMAINERROR; GO TO QUIT END 03243720 0062 + ELSE BEGIN CHARACTER:=TRUE; 03243725 0064 + L:=UNPACK(L,LRANK,LSIZE); END; 03243730 0065 + IF SIZE=0 THEN BEGIN DESC:=NULLV; GO TO QUIT END; 03243800 0067 + DESC.SPF := N := GETSPACE(SIZE+1); 03243900 0070 + SP[NOC] := SIZE; 03244000 0073 + SPCOPY(L+LRANK, N+1, LSIZE); 03244100 0076 + SPCOPY(M+RRANK, N+LSIZE+1, RSIZE); 03244200 0078 + END; 03244300 0081 + QUIT: 03244400 0081 + IF CHARACTER THEN BEGIN DESC.ARRAYTYPE := 1; 03244500 0082 + PACK(N,1,SIZE); 03244600 0084 + FORGETSPACE(L,LSIZE+LRANK); 03244700 0085 + FORGETSPACE(M,RSIZE+RRANK); 03244800 0087 + END; 03244900 0088 + RESULTD := DESC; 03245000 0088 + END PROCEDURE COMMAP; 03245100 0089 + 113 IS 95 LONG, NEXT SEG 56 + INTEGER STREAM PROCEDURE GETOP(A,N); VALUE N; 03245120 0032 + BEGIN SI := A; SI := SI + N; 03245130 0032 + DI := LOC GETOP; 03245140 0032 + DS := 7 LIT "0"; DS := CHR; 03245150 0033 + END PROCEDURE GETOP; 03245160 0034 + REAL PROCEDURE IDENTITY(OP); VALUE OP; INTEGER OP; 03246200 0035 + BEGIN 03246300 0035 + CASE OP OF BEGIN 03246350 0035 + IDENTITY := 0; %FOR + 03246400 0036 + IDENTITY := 1; %FOR × 03246500 0038 + IDENTITY := 0; %FOR - 03246600 0039 + IDENTITY := 1; %FOR DIV 03246700 0040 + IDENTITY := 1; %FOR * 03246800 0041 + ; %NO REDUCTION ON RNDM 03246900 0043 + IDENTITY := 0; %FOR RESD 03247000 0043 + IDENTITY := BIGGEST; %FOR MIN 03247100 0044 + IDENTITY := -BIGGEST; %FOR MAX 03247200 0045 + ; %NOT ISNT DYADIC 03247300 0047 + IDENTITY := 1; %FOR COMB 03247400 0047 + IDENTITY := 0; %FOR LSS 03247500 0048 + IDENTITY := 1; %FOR = 03247505 0049 + IDENTITY := 1; %FOR GEQ 03247510 0050 + IDENTITY := 0; %FOR GTR 03247515 0052 + IDENTITY := 0; %FOR NEQ 03247520 0053 + IDENTITY := 1; %FOR LEQ 03247525 0054 + IDENTITY := 1; %FOR AND 03247600 0055 + IDENTITY := 0; %FOR OR 03247700 0057 + END; END PROCEDURE IDENTITY; 03247800 0058 + START OF SEGMENT ********** 114 + 114 IS 19 LONG, NEXT SEG 56 + INTEGER PROCEDURE GETT(ALONG,RANK); VALUE ALONG, RANK; 03247810 0061 + INTEGER ALONG, RANK; 03247820 0061 + GETT := IF ALONG=1 THEN 0 ELSE 03247822 0061 + IF ALONG=RANK THEN 2 ELSE 03247825 0063 + IF ALONG=RANK-1 THEN 1 ELSE 0; 03247830 0065 + BOOLEAN PROCEDURE CHECKANDADD(SIZE,L,SUM); 03253305 0071 + VALUE SIZE,L; INTEGER SIZE,L,SUM; 03253310 0071 + BEGIN LABEL QUIT; INTEGER I,TOP,M,S,T; 03253315 0071 + START OF SEGMENT ********** 115 + CHECKANDADD:=TRUE; 03253320 0000 + SUM := 0; 03253325 0000 + TOP := SIZE DIV 2 × 2 - 1 + L; 03253330 0001 + FOR L:=L STEP 2 UNTIL TOP DO BEGIN M:=L+1; 03253335 0004 + IF NOT BOOLTYPE(S:=SP[LOC], T:=SP[MOC]) THEN BEGIN 03253340 0007 + CHECKANDADD:=FALSE; GO TO QUIT; END 03253345 0019 + ELSE SUM := SUM+S+T; END; 03253350 0021 + IF SIZE MOD 2 = 1 THEN BEGIN 03253355 0025 + IF NOT BOOLTYPE(T:=SP[LOC],0) THEN 03253360 0027 + CHECKANDADD := FALSE ELSE SUM := SUM+T; 03253365 0034 + END; 03253367 0037 + QUIT: END PROCEDURE CHECKANDADD; 03253370 0037 + 115 IS 43 LONG, NEXT SEG 56 + PROCEDURE COMPRESS(LDESC, RDESC, DIM); VALUE LDESC,RDESC,DIM; 03253400 0071 + REAL LDESC, RDESC, DIM; 03253500 0071 + BEGIN INTEGER I,J,K,L,M,N,T,RANK,LSIZE,RSIZE,ALONG,TOP, 03253600 0071 + START OF SEGMENT ********** 116 + FACTOR,SUM,DIMMOD,SIZE,LEFT,RIGHT,S; 03253700 0000 + REAL DESC; BOOLEAN CHARACTER; 03253800 0000 + LABEL QUIT,RANKE,DOMAIN,IDENT; 03253900 0000 + DESC.DID := DDPUVW; 03254000 0000 + IF L := LDESC.SPF = 0 THEN GO TO DOMAIN; 03254100 0001 + IF M:=RDESC.SPF=0 THEN BEGIN DESC:=NULLV; GO TO QUIT; END; 03254200 0004 + LSIZE := FINDSIZE(LDESC); RSIZE := FINDSIZE(RDESC); 03254300 0007 + IF RANK:=LDESC.RF NEQ 1 THEN IF LSIZE NEQ 1 03254350 0010 + THEN GO TO DOMAIN; 03254360 0012 + LEFT := L := L+RANK; 03254370 0013 + RANK := RDESC.RF; 03254400 0015 + IF N:=DIM.SPF=0 AND DIM.DID NEQ 0 OR DIM.ARRAYTYPE=1 03254500 0016 + OR LDESC.ARRAYTYPE=1 THEN GO TO DOMAIN; 03254510 0020 + IF J:=DIM.RF NEQ 0 THEN BEGIN 03254600 0023 + IF FINDSIZE(DIM)=1 THEN N:=N+J ELSE GO TO DOMAIN END; 03254700 0025 + IF ALONG:=(IF N=J THEN RANK ELSE SP[NOC]-ORIGIN+1) GTR RANK 03254800 0028 + OR ALONG LSS 1 AND RANK NEQ 0 03254810 0034 + THEN BEGIN ERR:=INDEXERROR; GO TO QUIT; END; 03254900 0036 + IF RANK = 0 THEN 03255200 0039 + IF LSIZE NEQ 1 THEN GO TO DOMAIN ELSE BEGIN 03255300 0039 + IF TOP:=SP[LOC]=0 THEN BEGIN DESC:=NULLV; GO TO QUIT; END; 03255400 0041 + IF TOP = 1 THEN BEGIN DESC.SPF := N := GETSPACE(2); 03255500 0046 + DESC.RF := SP[NOC] := 1; 03255600 0050 + N:=N+1; SP[NOC]:=SP[MOC]; GO TO QUIT; 03255700 0055 + END ELSE GO TO DOMAIN; END; 03255800 0061 + IF LSIZE = 1 THEN BEGIN 03255805 0061 + COMMENT IF LEFT ARG IS SCALAR, ANSWER IS NULL IF 0, 03255810 0063 + RIGHT ARG IF 1; 03255815 0063 + SUM:=SP[LOC]; 03255820 0063 + IF SUM NEQ 0 AND SUM NEQ 1 THEN GO TO DOMAIN 03255825 0065 + 03255830 0067 + ELSE GO TO IDENT; END; 03255835 0067 + N := M+ALONG - 1; 03255850 0068 + IF LSIZE NEQ (T:=SP[NOC]) THEN BEGIN 03255855 0070 + ERR:=LENGTHERROR; GO TO QUIT; END; 03255860 0074 + IF NOT CHECKANDADD(LSIZE,LEFT,SUM) THEN GO TO DOMAIN; 03255900 0075 + IDENT: IF SUM=0 THEN BEGIN DESC:=NULLV; GO TO QUIT END; 03256800 0077 + IF SUM = LSIZE THEN BEGIN 03256900 0079 + IF RDESC.ARRAYTYPE=1 THEN BEGIN 03256910 0080 + RSIZE:=RSIZE DIV 8 + (IF RSIZE MOD 8 NEQ 0 THEN 1 ELSE 0); 03256920 0082 + DESC.CHRMODE:=1; END; 03256930 0086 + DESC.SPF:=N:=GETSPACE(TOP:=RSIZE+RANK); 03257000 0088 + DESC.RF := RANK; SPCOPY(M,N,TOP); GO TO QUIT; END; 03257100 0092 + SIZE := RSIZE DIV T × SUM; 03257120 0095 + DESC.RF:=RANK; 03257130 0097 + IF RDESC.ARRAYTYPE = 1 THEN BEGIN M:=UNPACK(M,RANK,RSIZE); 03257132 0099 + CHARACTER := TRUE; END; 03257133 0102 + RIGHT := M; 03257134 0103 + DESC.SPF := S := GETSPACE(SIZE+RANK); 03257135 0104 + N := S; 03257140 0107 + FOR I:=1 STEP 1 UNTIL RANK DO BEGIN 03257150 0108 + IF I=ALONG THEN SP[NOC]:=SUM ELSE SP[NOC]:=SP[MOC]; 03257160 0109 + N:=N+1; M:=M+1; END; 03257170 0118 + T := GETT(ALONG, RANK); 03257200 0123 + FACTOR := 1; TOP := RIGHT+ALONG; 03257300 0125 + FOR N:=RIGHT+RANK-1 STEP -1 UNTIL TOP DO FACTOR:= 03257400 0127 + FACTOR × SP[NOC]; 03257410 0131 + N:=RIGHT + RANK - 1; DIM := SP[NOC]; 03257500 0135 + N := N+1; M:=S+RANK; I:=0; 03257600 0140 + DIMMOD := DIM-1; 03257650 0143 + WHILE I LSS RSIZE DO BEGIN 03257700 0144 + CASE T OF BEGIN 03257800 0145 + L := I DIV FACTOR MOD LSIZE; 03257900 0146 + L := I DIV FACTOR MOD DIMMOD; 03258000 0148 + L := I MOD DIM; END; 03258100 0151 + START OF SEGMENT ********** 117 + 117 IS 3 LONG, NEXT SEG 116 + L := L+LEFT; 03258150 0152 + IF SP[LOC] = 1 THEN FOR K:=1 STEP 1 UNTIL FACTOR DO BEGIN 03258200 0154 + SP[MOC]:=SP[NOC]; I:=I+1; M:=M+1; N:=N+1; 03258300 0158 + END ELSE BEGIN I:=I+FACTOR; N:=N+FACTOR; END; 03258400 0166 + END; 03258500 0172 + GO TO QUIT; 03259300 0172 + RANKE: ERR:=RANKERROR; GO TO QUIT; 03259500 0173 + DOMAIN: ERR:=DOMAINERROR; GO TO QUIT; 03259600 0174 + QUIT: IF CHARACTER THEN BEGIN PACK(S,RANK,SIZE); 03259900 0176 + DESC.ARRAYTYPE:=1; FORGETSPACE(RIGHT,RSIZE+RANK); END; 03260000 0179 + RESULTD := DESC; 03260100 0182 + POP; 03260150 0183 + END PROCEDURE COMPRESS; 03260200 0183 + 116 IS 191 LONG, NEXT SEG 56 + PROCEDURE EXPAND(LDESC,RDESC,DIM); VALUE LDESC,RDESC,DIM; 03268020 0071 + REAL LDESC, RDESC, DIM; 03268040 0071 + BEGIN INTEGER I,J,K,L,M,N,S,T,RANK,LSIZE,RSIZE,SIZE, 03268060 0071 + START OF SEGMENT ********** 118 + ALONG,TOP,LADDR,MADDR,FACTOR, SUM; 03268080 0000 + REAL DESC, INSERT; 03268100 0000 + LABEL QUIT, DOMAIN; 03268120 0000 + BOOLEAN CHARACTER; 03268140 0000 + LSIZE:=FINDSIZE(LDESC); RSIZE:=FINDSIZE(RDESC); 03268160 0000 + RANK := RDESC.RF; 03268180 0002 + IF M:=RDESC.SPF=0 03268200 0003 + OR L:=LDESC.SPF=0 03268220 0005 + OR I:=LDESC.RF GTR 1 03268224 0006 + 03268226 0008 + OR N:=DIM.SPF=0 AND DIM.DID NEQ 0 03268240 0008 + OR DIM.ARRAYTYPE=1 03268250 0012 + OR FINDSIZE(DIM ) NEQ 1 03268260 0013 + OR LDESC.ARRAYTYPE=1 03268270 0015 + THEN GO TO DOMAIN; 03268280 0016 + N:=N + (T:=DIM.RF); 03268300 0018 + IF ALONG :=(IF N=T THEN RANK ELSE SP[NOC]-ORIGIN+1) GTR RANK 03268320 0020 + OR ALONG LSS 1 AND RANK NEQ 0 03268330 0026 + THEN BEGIN ERR:=INDEXERROR; GO TO QUIT; END; 03268340 0028 + IF RANK=0 THEN DIM:=1 03268350 0030 + ELSE BEGIN N:=M+ALONG-1; DIM:=SP[NOC]; END; 03268360 0032 + IF SIZE:=RSIZE DIV DIM × LSIZE GTR MAXWORDSTORE 03268380 0037 + THEN BEGIN ERR:=KITEERROR; GO TO QUIT; END; 03268400 0039 + IF NOT CHECKANDADD(LSIZE,LADDR:=L+I, SUM) THEN GO TO DOMAIN; 03268420 0043 + IF SUM NEQ DIM THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END; 03268440 0045 + IF RANK=0 THEN BEGIN 03268443 0048 + DIM:=SP[MOC]; DESC.SPF:=N:=GETSPACE(LSIZE+I); 03268445 0049 + DESC.RF:=I; DESC.DID:=(IF I=0 THEN DDPUSW ELSE DDPUVW); 03268447 0055 + SPCOPY(L,N,I); L:=L+I; N:=N+I; TOP:=L+LSIZE-1; 03268449 0061 + FOR L:=L STEP 1 UNTIL TOP DO BEGIN 03268451 0066 + IF SP[LOC]=1 THEN SP[NOC]:=DIM; 03268453 0068 + N:=N+1; END; 03268456 0074 + GO TO QUIT END; 03268458 0077 + IF RDESC.ARRAYTYPE=1 THEN BEGIN CHARACTER:=TRUE; 03268460 0078 + M:=UNPACK(M,RANK,RSIZE); 03268480 0080 + INSERT := " "; END; 03268500 0082 + FACTOR:=1; TOP:=M+ALONG; 03268520 0083 + FOR N:=M+RANK-1 STEP -1 UNTIL TOP DO FACTOR:=FACTOR×SP[NOC]; 03268540 0085 + T := GETT(ALONG, RANK); 03268580 0093 + J:=0; N:=(MADDR:=M) + RANK; 03268600 0095 + DESC.SPF:=M:=GETSPACE(SIZE+RANK); 03268620 0097 + I:=M+RANK; 03268640 0101 + WHILE J LSS SIZE DO BEGIN 03268660 0102 + CASE T OF BEGIN 03268680 0103 + S := J DIV FACTOR MOD LSIZE; 03268700 0104 + S:=J DIV FACTOR MOD LSIZE; 03268720 0106 + S:=J MOD LSIZE; END; 03268740 0108 + START OF SEGMENT ********** 119 + 119 IS 3 LONG, NEXT SEG 118 + L:=S + LADDR; 03268760 0110 + IF SP[LOC]=1 THEN FOR K:=1 STEP 1 UNTIL FACTOR DO 03268780 0111 + BEGIN L:=J+I; SP[LOC] := SP[NOC]; 03268800 0116 + J:=J+1; N:=N+1; 03268820 0122 + END ELSE FOR K:=1 STEP 1 UNTIL FACTOR DO BEGIN 03268840 0124 + L:=J+I; SP[LOC]:=INSERT; J:=J+1; END; 03268860 0129 + END; 03268880 0136 + L := MADDR; 03268900 0137 + FOR I:=1 STEP 1 UNTIL RANK DO BEGIN 03268903 0138 + IF I = ALONG THEN SP[MOC]:=LSIZE ELSE SP[MOC]:=SP[LOC]; 03268906 0139 + M:=M+1; L:=L+1; END; 03268910 0148 + DESC.DID:=DDPUVW; DESC.RF:=RANK; 03268920 0153 + GO TO QUIT; 03268940 0157 + DOMAIN: ERR:=DOMAINERROR; 03268960 0157 + QUIT: IF CHARACTER THEN BEGIN DESC.ARRAYTYPE:=1; 03268980 0158 + FORGETSPACE(MADDR, RSIZE+RANK); 03269000 0161 + PACK(DESC.SPF,RANK,SIZE); END; 03269020 0163 + RESULTD:=DESC; 03269040 0164 + POP; 03269060 0165 + END PROCEDURE EXPAND; 03269080 0166 + 118 IS 174 LONG, NEXT SEG 56 + PROCEDURE MEMBER; 03269100 0071 + BEGIN REAL LDESC, RDESC; 03269120 0071 + START OF SEGMENT ********** 120 + INTEGER L,M,N,I,S,T,LSIZE,RSIZE,LRANK,RRANK,TOP; 03269140 0000 + REAL DESC, TEMP, ANS; 03269160 0000 + LABEL QUIT; 03269180 0000 + LDESC := AREG; RDESC := BREG; 03269190 0000 + LSIZE:=FINDSIZE(LDESC); RSIZE:=FINDSIZE(RDESC); 03269200 0006 + LRANK:=LDESC.RF; RRANK:=RDESC.RF; 03269220 0009 + IF L:=LDESC.SPF=0 OR M:=RDESC.SPF=0 THEN BEGIN 03269240 0011 + ERR:=DOMAINERROR; GO TO QUIT END; 03269250 0015 + IF LDESC.ARRAYTYPE=1 THEN L:=UNPACK(L,LRANK,LSIZE); 03269260 0017 + IF RDESC.ARRAYTYPE=1 THEN M:=UNPACK(M,RRANK,RSIZE); 03269280 0020 + DESC:=LDESC; DESC.NAMED:=0; 03269360 0024 + DESC.ARRAYTYPE:=0; 03269370 0026 + DESC.SPF:=N:=GETSPACE(LSIZE+LRANK); 03269380 0028 + SPCOPY(L,N,LRANK); 03269400 0031 + N:=N+LRANK; L:=(I:=L)+LRANK; M:=(S:=M)+RRANK; 03269420 0032 + T:=M+RSIZE-1; TOP := L+LSIZE-1; 03269440 0037 + FOR L:=L STEP 1 UNTIL TOP DO BEGIN 03269460 0041 + TEMP:=SP[LOC]; M:=S; 03269480 0042 + WHILE M LEQ T DO 03269500 0045 + IF OPERATION(TEMP,SP[MOC],0,12,ANS) AND ANS=1 THEN BEGIN 03269520 0046 + SP[NOC]:=1; M:=M+T; END ELSE M:=M+1; 03269540 0052 + N:=N+1; END; 03269560 0058 + 03269580 0062 + IF RDESC.ARRAYTYPE=1 THEN FORGETSPACE(S,RSIZE+RRANK); 03269600 0062 + IF LDESC.ARRAYTYPE=1 THEN FORGETSPACE(I,LSIZE+LRANK); 03269620 0065 + QUIT: RESULTD:=DESC; 03269640 0068 + END PROCEDURE MEMBER; 03269660 0069 + 120 IS 76 LONG, NEXT SEG 56 + REAL PROCEDURE BASEVALUE; 03269800 0071 + BEGIN 03269860 0071 + COMMENT THIS RETURNS A DESCRIPTOR FOR A SCALAR RESULT; 03269870 0071 + LABEL OUTE,BAD; 03269880 0071 + START OF SEGMENT ********** 121 + REAL E,L,M,LEFT,RIGHT,T,LARG,RARG; 03269900 0000 + LARG := AREG; RARG := BREG; 03269910 0000 + IF M:=RARG.SPF=0 OR LARG.CHRMODE=1 OR RARG.CHRMODE=1 03269920 0006 + OR L:=LARG.SPF=0 AND LARG.DID NEQ 0 03269930 0010 + THEN GO TO BAD; 03269940 0013 + RIGHT:=SP[MOC]; 03269960 0015 + LEFT:=SP[LOC]; 03269980 0018 + IF FINDSIZE(LARG)=1 THEN % A 1 ELEMENT VECTOR 03269982 0021 + BEGIN 03269984 0022 + L:=L+LARG.RF; 03269986 0022 + LARG.SCALAR:=1; 03269987 0024 + LEFT:=SP[LOC]; 03269988 0026 + END; 03269990 0029 + IF FINDSIZE(RARG)=1 THEN % A ONE ELEMENT VECTOR 03269992 0029 + BEGIN 03269994 0030 + M:=M+RARG.RF; 03269996 0030 + RIGHT:=SP[MOC]; 03269998 0032 + RARG.SCALAR:=1; 03269999 0035 + END; 03270000 0037 + IF L=0 THEN 03270002 0037 + BEGIN % BASEVAL MONADIC 03270004 0037 + LEFT:=2; %IF MONADIC, ITS 2 BASVAL X 03270006 0038 + LARG.SCALAR:=1; 03270008 0039 + END; 03270010 0040 + IF BOOLEAN(LARG.SCALAR )THEN %SCALAR 03270018 0040 + IF BOOLEAN(RARG.SCALAR) THEN 03270020 0041 + BEGIN 03270025 0042 + T:=RIGHT; %SCALAR-SCALAR 03270030 0043 + GO OUTE; 03270035 0044 + END 03270037 0044 + ELSE 03270040 0044 + IF RARG.RF=1 THEN 03270060 0044 + BEGIN COMMENT SCALAR-VECTOR--LEFT IS VALUE OF SCALAR, RIGHT 03270080 0046 + IS # OF ELEMENTS; 03270100 0046 + IF LEFT=0 THEN GO OUTE 03270120 0046 + ELSE E:=1/LEFT; 03270140 0047 + FOR L :=M+RIGHT STEP -1 UNTIL M+1 DO 03270160 0049 + T:=T+SP[LOC]×(E:=E×LEFT); 03270180 0054 + GO OUTE; 03270200 0059 + END 03270300 0059 + ELSE BAD: ERR:=DOMAINERROR 03270320 0059 + ELSE 03270340 0061 + IF RARG.SCALAR=0 THEN 03270380 0061 + IF LARG.RF NEQ 1 OR RARG.RF NEQ 1 THEN 03270400 0063 + ERR:=DOMAINERROR 03270420 0066 + ELSE 03270440 0067 + BEGIN 03270460 0068 + GT2:=L; % SAVE FOR LATER TEST 03270480 0068 + GT1:=M+2; % WANT TO STOP 2 UP IN LOOP 03270500 0069 + L:=L+LEFT; % START AT OTHER END 03270520 0070 + E:=1; 03270540 0071 + M:=M+RIGHT; 03270560 0072 + T:=SP[MOC]; % INITIAL VALUE 03270580 0073 + FOR M:=M-1 STEP -1 UNTIL GT1 DO 03270600 0076 + BEGIN 03270620 0080 + IF L:=L-1 LSS GT2 THEN L:=GT2+LEFT; % START OVER 03270640 0080 + E:=E×SP[LOC]; 03270660 0084 + T:=T+SP[MOC]×E; 03270680 0087 + END; 03270700 0091 + OUTE: 03270702 0091 + L:=GETSPACE(1); 03270704 0092 + SP[LOC]:=T; 03270708 0093 + T:=0; 03270710 0096 + T.DID:=DDPUSW; % BUILD DESCRIPTOR 03270712 0097 + T.SPF:=L; 03270716 0098 + BASEVALUE:=T; 03270720 0100 + END 03270740 0101 + ELSE ERR := DOMAINERROR 03270760 0101 + END OF BASEVALUE; 03270800 0102 + 121 IS 107 LONG, NEXT SEG 56 + REAL PROCEDURE REPRESENT; 03270820 0071 + BEGIN 03270880 0071 + COMMENT RETURNS DESCRIPTOR OF VECTOR IF LARG VECTOR AND RARG SCALAR; 03270900 0071 + REAL L,M,LEFT,RIGHT,T,E,LARG,RARG; 03270920 0071 + START OF SEGMENT ********** 122 + LABEL AROUND; 03270925 0000 + LARG := AREG; RARG := BREG; 03270930 0000 + IF (RARG.SCALAR=1 OR FINDSIZE(RARG)=1 AND RARG.CHRMODE=0) 03270940 0006 + AND NOT(LARG.SCALAR=1 OR LARG.CHRMODE=1 OR LARG.RF NEQ 1) THEN 03270950 0010 + BEGIN 03270960 0015 + COMMENT VECTOR-SCALAR; 03270980 0016 + IF L:=LARG.SPF=0 OR M:=RARG.SPF=0 THEN GO AROUND; 03271000 0016 + IF RARG.SCALAR=0 THEN M:=M+RARG.RF; 03271020 0020 + RIGHT:=SP[MOC]; % VALUE OF SCALAR 03271040 0024 + LEFT:=SP[LOC]; % LENGTH OF VECTOR 03271060 0026 + E:=M:=GETSPACE(LEFT+1); % MAKE ROOM FOR ANSWER 03271080 0029 + SP[MOC]:=LEFT; % LENGTH OF ANSWER 03271100 0031 + M:=M+LEFT; 03271120 0034 + GT1:=L+2; 03271140 0036 + FOR L:=L+LEFT STEP -1 UNTIL GT1 DO 03271160 0037 + IF T:=SP[LOC] LEQ 0 THEN 03271180 0041 + IF T LSS 0 THEN ERR := DOMAINERROR 03271200 0044 + ELSE 03271220 0046 + BEGIN 03271240 0047 + L:=GT1-1 ; % STOP THE LOOP 03271260 0047 + M:=M-1; 03271280 0049 + END 03271300 0050 + ELSE 03271320 0050 + BEGIN 03271340 0050 + SP[MOC]:= RIGHT MOD T; 03271360 0050 + RIGHT:=RIGHT DIV T; 03271380 0054 + M:=M-1; 03271400 0055 + IF RIGHT LSS FUZZ THEN L:=GT1-1; % STOP THE LOOP 03271420 0056 + END; 03271440 0059 + SP[MOC]:=RIGHT; % LEFTOVER GOES HERE 03271460 0060 + T.DID:=DDPUVW; 03271480 0063 + T.RF:=1; 03271500 0064 + T.SPF:=E; 03271520 0066 + REPRESENT:=T; 03271540 0068 + END 03271560 0069 + ELSE AROUND: ERR:=DOMAINERROR; 03271580 0069 + END OF REPRESENT; 03271600 0070 + 122 IS 76 LONG, NEXT SEG 56 + PROCEDURE PERIOD(LDESC,RDESC,LOP,ROP); 03271800 0071 + VALUE LDESC,RDESC,LOP,ROP; REAL LDESC,RDESC; INTEGER LOP,ROP; 03271820 0071 + BEGIN INTEGER L,M,N,J,LRANK,RRANK,RANK,LSIZE,RSIZE,SIZE,LL,MM,I, 03271840 0071 + START OF SEGMENT ********** 123 + RROW,RCOL,LROW,LCOL,LJUMP,RJUMP,MSAVE,LSAVE,RSTART; 03271860 0000 + REAL DESC, TEMP; 03271880 0000 + BOOLEAN CHARACTER, FIRST,LSCALAR, RSCALAR; 03271900 0000 + LABEL QUIT, DOMAIN, FORGET, OUTERPROD; 03271920 0000 + IF L:=LDESC.SPF = 0 OR M := RDESC.SPF=0 THEN GO TO DOMAIN; 03271940 0000 + LSIZE := FINDSIZE(LDESC); RSIZE:=FINDSIZE(RDESC); 03271960 0004 + LRANK:=LDESC.RF; RRANK := RDESC.RF; 03271965 0007 + IF LOP NEQ 45 THEN 03271970 0009 + IF LRANK GTR 2 AND LSIZE NEQ 1 OR RRANK GTR 2 AND RSIZE NEQ 1 THEN 03271975 0010 + BEGIN ERR:=KITEERROR; GO TO QUIT; END; 03271980 0014 + IF ROP:=GETOP(CORRESPONDENCE,ROP-1) = 9 THEN BEGIN 03271982 0016 + ERR:=SYNTAXERROR; GO TO QUIT; END; 03271985 0020 + IF LL:=LDESC.ARRAYTYPE=1 OR MM:=RDESC.ARRAYTYPE=1 THEN 03271990 0021 + IF LL × MM NEQ 1 THEN GO TO DOMAIN 03271992 0025 + ELSE BEGIN 03272000 0026 + 03272001 0027 + IF ROP LSS 11 OR ROP GTR 16 THEN GO TO DOMAIN; 03272002 0027 + CHARACTER:=TRUE; 03272003 0029 + M:=UNPACK(M,RRANK,RSIZE); 03272004 0030 + L:=UNPACK(L,LRANK,LSIZE); END; 03272005 0032 + MSAVE := M; LSAVE:=L; IF ROP NEQ 45 THEN 03272006 0034 + IF LOP=45 THEN GO TO OUTERPROD ELSE 03272009 0036 + IF LOP:=GETOP(CORRESPONDENCE,LOP-1)=9 THEN 03272040 0037 + BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END; 03272045 0041 + IF LRANK=2 THEN BEGIN 03272050 0043 + N:=L+LRANK-1; LCOL := SP[NOC]; 03272060 0044 + N:=N-1; LROW:=SP[NOC]; END; 03272070 0048 + IF LRANK=1 THEN BEGIN LROW:=1; LCOL:=SP[LOC]; END; 03272080 0052 + IF RRANK=2 THEN BEGIN 03272100 0057 + N :=M+RRANK-1; RCOL:=SP[NOC]; 03272110 0058 + N:=N-1; RROW:=SP[NOC]; END; 03272120 0063 + IF RRANK=1 THEN BEGIN RROW:=SP[MOC]; RCOL:=1; END; 03272140 0067 + IF LSIZE =1 OR RSIZE=1 THEN BEGIN 03272142 0072 + IF LSIZE = 1 AND RSIZE = 1 THEN LROW:=LCOL:=RROW:=RCOL:=1 03272145 0074 + ELSE IF LSIZE=1 THEN BEGIN LCOL:=RROW; LROW:=1; 03272150 0076 + L:=L+LRANK-1; LRANK:=1; 03272155 0082 + LSCALAR:=TRUE; END 03272160 0084 + ELSE BEGIN RROW := LCOL; RCOL := 1; 03272170 0085 + M:=M+RRANK-1; RRANK:=1; 03272175 0087 + RSCALAR:=TRUE; END; 03272180 0089 + END; 03272185 0090 + IF LCOL NEQ RROW 03272240 0090 + THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END; 03272245 0090 + DESC.SPF:=N:=GETSPACE((RANK:=MAX(0,LRANK+RRANK-2))+ 03272360 0093 + SIZE:=LROW×RCOL); 03272380 0097 + SPCOPY(L,N,LRANK-1); 03272400 0101 + SPCOPY(M+1,N+LRANK-1,RRANK-1); 03272420 0102 + DESC.RF:=RANK; DESC.DID:=(IF RANK=0 THEN DDPUSW ELSE DDPUVW); 03272440 0106 + N:=N+RANK; 03272460 0111 + LL := L + LRANK - 1; 03272480 0112 + MM := M + RRANK - 1; 03272500 0114 + LJUMP := LCOL-1; RJUMP := IF RSCALAR THEN 0 ELSE (RROW-1) × RCOL; 03272520 0116 + FOR J:=1 STEP LCOL UNTIL LSIZE DO 03272540 0120 + FOR RSTART:=1 STEP 1 UNTIL RCOL DO BEGIN 03272560 0122 + FIRST:=TRUE; 03272580 0123 + M := MM + RSTART + RJUMP; RROW := LL+J; 03272600 0123 + FOR I:=LL + LJUMP + J STEP -1 UNTIL RROW DO BEGIN 03272620 0126 + IF LSCALAR THEN L:=LL+1 ELSE L:=I; 03272630 0131 + IF FIRST THEN BEGIN 03272640 0134 + IF NOT OPERATION(SP[LOC],SP[MOC],1,ROP,SP[NOC]) 03272660 0135 + THEN GO TO FORGET ELSE FIRST := FALSE; 03272680 0144 + END ELSE BEGIN 03272700 0147 + IF NOT OPERATION(SP[LOC],SP[MOC],1,ROP,TEMP) 03272720 0147 + THEN GO TO FORGET; 03272740 0152 + IF NOT OPERATION(TEMP,SP[NOC],-1,LOP,SP[NOC]) 03272760 0153 + THEN GO TO FORGET; END; 03272780 0160 + IF NOT RSCALAR THEN M:=M-RCOL; END; 03272800 0162 + N := N+1; 03272820 0165 + END; 03272840 0166 + GO TO QUIT; 03272860 0171 + OUTERPROD: IF SIZE:=LSIZE×RSIZE GTR MAXWORDSTORE 03272880 0172 + OR RANK := LRANK+RRANK GTR 31 THEN BEGIN 03272900 0174 + ERR:=KITEERROR; GO TO QUIT; END; 03272920 0177 + DESC.SPF:=N:=GETSPACE(SIZE+RANK); 03273060 0180 + DESC.DID:=IF RANK=0 THEN DDPUSW ELSE DDPUVW; 03273080 0183 + DESC.RF:=RANK; 03273100 0187 + SPCOPY(L,N,LRANK); 03273120 0188 + SPCOPY(M,N+LRANK,RRANK); 03273140 0190 + N:=N+RANK; 03273160 0191 + I:=L + LRANK + LSIZE - 1; 03273180 0193 + MM := M+RRANK + RSIZE - 1; 03273200 0195 + FOR L:=L+LRANK STEP 1 UNTIL I DO 03273220 0197 + FOR M:=MSAVE+RRANK STEP 1 UNTIL MM DO 03273240 0201 + IF NOT OPERATION(SP[LOC],SP[MOC],1,ROP,SP[NOC]) THEN 03273260 0206 + GO TO FORGET ELSE N:=N+1; 03273280 0216 + GO TO QUIT; 03273285 0218 + FORGET: FORGETSPACE(DESC.SPF,RANK+SIZE); 03273300 0219 + DOMAIN: ERR:=DOMAINERROR; 03273320 0221 + QUIT: IF CHARACTER THEN BEGIN 03273340 0221 + FORGETSPACE(MSAVE , RRANK+RSIZE); 03273380 0222 + FORGETSPACE(LSAVE , LRANK+LSIZE); END; 03273400 0224 + RESULTD := DESC; 03273420 0225 + END PROCEDURE PERIOD; 03273440 0226 + 123 IS 236 LONG, NEXT SEG 56 + PROCEDURE REVERSE(SOURCE,LENGTH,DEST,JUMP); VALUE SOURCE,DEST, 03273442 0071 + LENGTH,JUMP; INTEGER SOURCE,LENGTH,DEST,JUMP; 03273444 0071 + BEGIN INTEGER L,M,TOP; 03273446 0071 + START OF SEGMENT ********** 124 + M:=SOURCE + TOP:=(LENGTH-1) × JUMP; TOP:=DEST+TOP; 03273448 0000 + FOR L:=DEST STEP JUMP UNTIL TOP DO BEGIN 03273450 0004 + SP[LOC] := SP[MOC]; M:=M-JUMP; END; 03273452 0005 + END PROCEDURE REVERSE; 03273454 0014 + 124 IS 18 LONG, NEXT SEG 56 + PROCEDURE ROTATE(SOURCE,LENGTH,DEST,JUMP,ROT); VALUE SOURCE, 03273456 0071 + LENGTH,DEST,JUMP,ROT; INTEGER SOURCE,LENGTH,DEST,JUMP,ROT; 03273458 0071 + BEGIN INTEGER L,M,TOP; 03273460 0071 + START OF SEGMENT ********** 125 + TOP := SOURCE + (LENGTH-1) × JUMP; 03273462 0000 + FOR L:=SOURCE STEP JUMP UNTIL TOP DO BEGIN 03273464 0002 + M:=DEST+(ROT MOD LENGTH)×JUMP; SP[MOC]:=SP[LOC]; 03273466 0003 + ROT := ROT + 1; END; 03273468 0010 + END PROCEDURE ROTATE; 03273470 0014 + 125 IS 18 LONG, NEXT SEG 56 + INTEGER PROCEDURE GETNUM(TIM,L,SIZE,DIM); VALUE TIM,L, 03273472 0071 + SIZE,DIM; INTEGER TIM,L,SIZE,DIM; 03273474 0071 + BEGIN INTEGER NUM; 03273476 0071 + START OF SEGMENT ********** 126 + IF SIZE NEQ 0 THEN L := L + TIM; 03273478 0000 + NUM:=SIGN(NUM:=SP[LOC]) × ENTIER(ABS(NUM)) MOD DIM; 03273482 0002 + IF NUM LSS 0 THEN GETNUM := -NUM %FOR RIGHT ROTATION 03273484 0009 + ELSE GETNUM:=DIM-NUM; %FOR LEFT ROTATION 03273486 0011 + END PROCEDURE GETNUM; 03273489 0015 + 126 IS 19 LONG, NEXT SEG 56 + BOOLEAN PROCEDURE MATCHROT(LDESC,RDESC,ALONG); VALUE LDESC, 03273490 0071 + RDESC,ALONG; INTEGER LDESC,RDESC,ALONG; 03273491 0071 + BEGIN INTEGER I,L,M,R; LABEL QUIT; 03273492 0071 + START OF SEGMENT ********** 127 + MATCHROT:=TRUE; L:=LDESC.SPF; M:=RDESC.SPF; 03273493 0000 + IF R:=LDESC.RF NEQ RDESC.RF-1 THEN BEGIN 03273494 0003 + MATCHROT:=FALSE; GO TO QUIT; END; 03273495 0006 + FOR I:=1 STEP 1 UNTIL R DO BEGIN IF I=ALONG THEN M:=M+1; 03273496 0007 + IF SP[LOC] NEQ SP[MOC] THEN BEGIN MATCHROT:=FALSE; 03273497 0011 + GO TO QUIT; END; M:=M+1; L:=L+1; END; 03273498 0017 + QUIT: END PROCEDURE MATCHROT; 03273499 0022 + 127 IS 27 LONG, NEXT SEG 56 + PROCEDURE REDUCESORTSCAN(LOP,RDESC,DIM,KIND); VALUE LOP,RDESC, 03273500 0071 + DIM,KIND; REAL LOP,RDESC,DIM; INTEGER KIND; 03273520 0071 + BEGIN INTEGER L,M,N,I,J,K,ALONG,FACTOR,T,MSAVE,DIFF,SSIZE, 03273540 0071 + START OF SEGMENT ********** 128 + JUMP,RANK,SIZE,TOP,LASTDIM,INTERVAL,TEMP,HOP; 03273560 0000 + INTEGER REMDIM,LRANK,LSAVE,LSIZE,S; 03273565 0000 + BOOLEAN CHARACTER,REDUCE,SORT,SCAN,REVERSAL,ROTATION; 03273580 0000 + REAL DESC; 03273600 0000 + LABEL QUIT, FORGET, RANKERR; 03273620 0000 + COMMENT: KIND=1 FOR REDUCTION 03273622 0000 + KIND=2 FOR SORTUP OR SORTDN 03273624 0000 + KIND=3 FOR SCAN 03273626 0000 + KIND=4 FOR REVERSAL 03273628 0000 + KIND=5 FOR ROTATION; 03273630 0000 + PROCEDURE SORTIT(L,M,SIZE,JUMP,UP); VALUE L,M,SIZE,JUMP,UP; 03273640 0000 + INTEGER L,M,SIZE,JUMP; BOOLEAN UP; 03273660 0000 + BEGIN INTEGER N,TIP,TOP,LSAVE; 03273680 0000 + START OF SEGMENT ********** 129 + REAL COMPARE,OUTOFIT; 03273700 0000 + OUTOFIT:=IF UP THEN BIGGEST ELSE -BIGGEST; 03273720 0000 + TIP := M + (N:=(SIZE-1)) × JUMP; TOP := L + N; 03273740 0002 + LSAVE := L; 03273760 0006 + FOR M:=M STEP JUMP UNTIL TIP DO BEGIN 03273800 0007 + L := LSAVE; COMPARE := SP[LOC]; N:=L; 03273820 0008 + FOR L:=L+1 STEP 1 UNTIL TOP DO 03273830 0012 + IF UP THEN BEGIN IF SP[LOC] LSS COMPARE THEN BEGIN 03273840 0016 + N:=L; COMPARE:=SP[LOC]; END; 03273860 0020 + END ELSE IF SP[LOC] GTR COMPARE THEN BEGIN 03273880 0024 + N:=L; COMPARE:=SP[LOC]; END; 03273900 0027 + SP[NOC] := OUTOFIT; 03273920 0031 + SP[MOC] := (N-LSAVE) + ORIGIN; 03273940 0034 + END; 03273960 0039 + END PROCEDURE SORTIT; 03273980 0042 + 129 IS 47 LONG, NEXT SEG 128 + CASE KIND OF BEGIN ; REDUCE:=TRUE; SORT:=TRUE; SCAN:=TRUE; 03273990 0000 + REVERSAL:=TRUE; ROTATION:=TRUE; END; 03273995 0004 + START OF SEGMENT ********** 130 + 130 IS 6 LONG, NEXT SEG 128 + IF LOP GTR 64 AND NOT ROTATION THEN BEGIN 03274000 0007 + ERR:=SYSTEMERROR; GO TO QUIT; END; 03274010 0009 + IF REDUCE OR SCAN THEN IF LOP NEQ 45 THEN 03274020 0010 + LOP := GETOP(CORRESPONDENCE,LOP-1); 03274030 0012 + IF M:=RDESC.SPF=0 AND NOT REDUCE 03274040 0015 + OR DIM.DID NEQ 0 AND N:=DIM.SPF=0 OR DIM.ARRAYTYPE=1 03274060 0017 + OR FINDSIZE(DIM) NEQ 1 THEN BEGIN 03274065 0022 + ERR:=DOMAINERROR; GO TO QUIT END; 03274070 0025 + IF (REDUCE OR SCAN) AND LOP=9 THEN BEGIN %OP NOT DYADIC SCALAR 03274080 0026 + ERR:=SYNTAXERROR; GO TO QUIT END; 03274100 0028 + IF M=0 THEN BEGIN 03274102 0029 + %FOR REDUCTION, RESULT OF A NULL IS CORRESPONDING IDENTITY 03274105 0031 + %EXCEPT THAT NAND, NOR, CIRCLE, AND LOG (LOP GTR 18) 03274106 0031 + %HAVE NO IDENTITIES, SO THE RESULT IS A NULL 03274107 0031 + DESC.DID := DDPUSW; 03274108 0031 + IF LOP LEQ 18 THEN BEGIN DESC.SPF:=N:=GETSPACE(1); 03274110 0032 + SP[NOC] := IDENTITY(LOP); END ELSE DESC.RF:=1; 03274111 0036 + GO TO QUIT; END; 03274113 0042 + IF RDESC.ARRAYTYPE=1 AND (REDUCE OR SCAN) THEN 03274115 0043 + BEGIN ERR:=DOMAINERROR; GO TO QUIT; END; 03274117 0045 + SIZE:=FINDSIZE(RDESC); 03274120 0047 + RANK:=RDESC.RF; 03274140 0048 + IF SIZE=1 THEN BEGIN 03274160 0049 + %UNLESS SORT, RESULT OF SINGLE-VALUED ARGUMENT IS THAT ARGUMENT 03274165 0050 + DESC := RDESC; 03274180 0050 + DESC.SPF := N := GETSPACE(RANK+1); 03274200 0051 + SPCOPY(M,N,RANK);M:=M+RANK;N:=N+RANK; 03274220 0054 + IF SORT THEN BEGIN SP[NOC]:=ORIGIN; DESC.ARRAYTYPE:=0; 03274240 0058 + END ELSE SP[NOC]:=SP[MOC]; 03274260 0064 + GO TO QUIT; END; 03274280 0069 + 03274300 0070 + IF RDESC.ARRAYTYPE=1 THEN BEGIN 03274320 0070 + CHARACTER := TRUE; 03274360 0072 + M:=UNPACK(M,RANK,SIZE); END; 03274380 0072 + MSAVE:=M; 03274400 0074 + N:=N+(T:=DIM.RF); 03274420 0075 + IF ALONG:=(IF N=T THEN RANK ELSE SP[NOC]-ORIGIN+1) GTR RANK 03274440 0077 + OR ALONG LSS 1 03274450 0083 + THEN BEGIN ERR:=INDEXERROR; GO TO QUIT; END; 03274460 0084 + IF ROTATION THEN BEGIN 03274462 0086 + IF LSAVE:=LOP.SPF=0 OR LOP.ARRAYTYPE=1 THEN 03274464 0087 + BEGIN ERR:=DOMAINERROR; GO TO QUIT; END; 03274466 0090 + IF LSIZE:=FINDSIZE(LOP) NEQ 1 THEN 03274468 0092 + IF NOT MATCHROT(LOP,RDESC,ALONG) THEN BEGIN 03274470 0094 + ERR:=RANKERROR; GO TO QUIT; END; 03274472 0096 + LSAVE := LSAVE + LRANK := LOP.RF; 03274474 0098 + IF LSIZE = 1 THEN LRANK := 0; END; 03274476 0100 + N:=M+ALONG-1; 03274480 0102 + DIM:=SP[NOC]; 03274500 0104 + JUMP:=1; I:=M+ALONG; 03274520 0106 + FOR L:=M+RANK-1 STEP -1 UNTIL I DO JUMP:=JUMP × SP[LOC]; 03274540 0108 + N:=M+RANK-1; LASTDIM:=SP[NOC]; 03274560 0117 + IF ALONG = RANK-1 THEN BEGIN N:=N-1; 03274580 0121 + FACTOR:=LASTDIM × SP[NOC]; END; 03274600 0124 + T := GETT(ALONG, RANK); 03274620 0128 + J := M + RANK; 03274622 0129 + REMDIM := 1; 03274623 0130 + HOP := (DIM-1) × JUMP; 03274624 0131 + DESC.DID := DDPUVW; 03274625 0133 + IF ALONG GTR 1 AND ALONG LSS RANK-1 THEN BEGIN TOP:=M+ALONG-2; 03274626 0135 + FOR L:=M STEP 1 UNTIL TOP DO REMDIM:=REMDIM×SP[LOC]; END; 03274627 0139 + IF REDUCE THEN BEGIN DESC.SPF:=N:=GETSPACE(SSIZE:=SIZE DIV DIM 03274628 0146 + + RANK - 1); 03274629 0148 + IF RANK=1 THEN DESC.SCALAR:=1 ELSE DESC.RF:=RANK-1; 03274631 0152 + FOR I:=1 STEP 1 UNTIL RANK DO BEGIN 03274634 0157 + IF I NEQ ALONG THEN BEGIN SP[NOC]:=SP[MOC]; N:=N+1; END; 03274637 0159 + M:=M+1; END; 03274640 0166 + JUMP := - JUMP; 03274643 0170 + END ELSE BEGIN DESC.SPF:=N:=GETSPACE(SSIZE:=SIZE+RANK); 03274646 0171 + INTERVAL := (DIFF := N-M) + HOP; 03274648 0175 + SPCOPY(M,N,RANK); DESC.RF:=RANK; END; 03274649 0177 + IF SORT THEN TEMP:= GETSPACE(DIM); 03274720 0180 + TOP := SIZE DIV (DIM × REMDIM) - 1; 03274732 0182 + FOR S:=1 STEP 1 UNTIL REMDIM DO BEGIN 03274735 0184 + FOR I:=0 STEP 1 UNTIL TOP DO BEGIN 03274740 0186 + CASE T OF BEGIN 03274760 0187 + L := I + J; 03274780 0187 + L:=I DIV LASTDIM×FACTOR + I MOD LASTDIM + J; 03274800 0189 + L:=I×LASTDIM + J; END; 03274820 0193 + START OF SEGMENT ********** 131 + 131 IS 3 LONG, NEXT SEG 128 + IF REDUCE THEN BEGIN M:=I+N; L:=HOP + (K:=L); 03274822 0195 + SP[MOC] := SP[LOC]; 03274825 0199 + FOR L:=L+JUMP STEP JUMP UNTIL K DO 03274828 0204 + IF NOT OPERATION(SP[LOC],SP[MOC],-1,LOP,SP[MOC]) 03274831 0209 + THEN GO TO FORGET; 03274834 0218 + END ELSE 03274837 0220 + IF SORT THEN BEGIN K:=L+HOP; N:=TEMP; 03274840 0220 + FOR M:=L STEP JUMP UNTIL K DO BEGIN 03274845 0224 + SP[NOC] := SP[MOC]; N:=N+1; END; 03274850 0225 + IF LOP LSS 0 THEN SORTIT(TEMP,L+DIFF,DIM,JUMP,FALSE) 03274860 0234 + ELSE SORTIT(TEMP,L+DIFF,DIM,JUMP,TRUE); 03274880 0237 + END ELSE IF SCAN THEN BEGIN 03274900 0240 + K:=L+INTERVAL; N:=L+DIFF; SP[NOC] := SP[LOC]; 03274920 0242 + FOR N:=N+JUMP STEP JUMP UNTIL K DO BEGIN 03274940 0249 + M:=N-JUMP; L:=L+JUMP; 03274980 0254 + IF NOT OPERATION(SP[MOC],SP[LOC],-1,LOP,SP[NOC]) 03275000 0257 + THEN GO TO FORGET; END; 03275020 0266 + END ELSE IF REVERSAL THEN REVERSE(L,DIM,L+DIFF,JUMP) 03275040 0268 + ELSE IF ROTATION THEN ROTATE(L,DIM,L+DIFF,JUMP, 03275050 0271 + GETNUM(I,LSAVE,LRANK,DIM)); 03275060 0275 + END; 03275080 0276 + J := J + ABS(JUMP×DIM); 03275085 0279 + N := N + TOP + 1; 03275088 0281 + DIFF := DIFF + TOP + 1; 03275089 0282 + END; 03275090 0284 + GO TO QUIT; 03275100 0286 + RANKERR: ERR:=RANKERROR; FORGETSPACE(DESC.SPF,SSIZE);GO QUIT; 03275110 0287 + FORGET: ERR:=DOMAINERROR; FORGETSPACE(DESC.SPF, SSIZE); 03275120 0290 + QUIT: IF CHARACTER THEN BEGIN 03275140 0293 + FORGETSPACE(MSAVE,SIZE+RANK); 03275142 0294 + IF (REVERSAL OR ROTATION) AND ERR=0 THEN BEGIN 03275144 0296 + DESC.ARRAYTYPE:=1; PACK(DESC.SPF,RANK,SIZE); END; END; 03275146 0298 + IF SORT THEN FORGETSPACE(TEMP,DIM); 03275150 0302 + RESULTD := DESC; 03275160 0303 + IF ROTATION THEN POP; 03275165 0304 + END PROCEDURE REDUCESORTSCAN; 03275180 0305 + 128 IS 316 LONG, NEXT SEG 56 + PROCEDURE DYADICTRANS; 03275200 0071 + BEGIN REAL LDESC,RDESC; 03275300 0071 + START OF SEGMENT ********** 132 + INTEGER L,M,N,RANK,NEWRANK,SIZE,TEMP,I,J; 03275400 0000 + DEFINE SPTOP=RDESC#,MIN=RDESC#,PTR=NEWRANK#,MBASE=LDESC#,TOP=RDESC# 03275500 0000 + ,RESULT=RESULTD#; 03275510 0000 + LABEL QUIT; BOOLEAN CARRY; 03275600 0000 + INTEGER ARRAY RVEC,DEL,SUB,OLDEL[0:31]; 03275700 0000 + LDESC:=AREG; RDESC:=BREG; 03275800 0002 + RESULT:=0; L:=LDESC.SPF; J:=LDESC.RF; RANK:=RDESC.RF; 03275900 0009 + IF M:=RDESC.SPF=0 OR L=0 OR LDESC.ARRAYTYPE=1 THEN BEGIN 03276000 0013 + ERR:=DOMAINERROR; GO TO QUIT END; 03276010 0018 + IF NUMELEMENTS(LDESC)=1 THEN BEGIN N:=L+J; 03276100 0019 + IF SP[NOC] NEQ ORIGIN OR RANK GTR 1 THEN BEGIN 03276200 0022 + ERR:=DOMAINERROR; GO TO QUIT END; 03276300 0027 + %IF WE GET HERE, THE ANSWER IS ITSELF 03276310 0028 + RESULT:=RDESC; I:=NUMELEMENTS(RDESC); 03276400 0028 + RESULT.SPF:=N:=GETSPACE(SIZE:=RANK+I); RESULT.NAMED:=0; 03276410 0030 + SPCOPY(M,N,SIZE); GO TO QUIT; END; 03276420 0035 + IF J GTR 1 THEN BEGIN ERR:=RANKERROR; GO TO QUIT END; 03276430 0037 + IF SP[LOC] NEQ RANK THEN BEGIN ERR:=LENGTHERROR; GO TO QUIT END; 03276440 0040 + % FIND MAX OF LDESC FOR NOW- DO THE REST LATER 03276500 0044 + %LDESC W/R/T/ ORIGIN 0 GETS STORED IN SUB[I] 03276600 0044 + SPTOP:=L+RANK; NEWRANK:=0; I:=0; 03276700 0044 + FOR N:=L+1 STEP 1 UNTIL SPTOP DO BEGIN 03276800 0047 + IF TEMP:=SP[NOC]-ORIGIN+1 GTR NEWRANK THEN NEWRANK:=TEMP; 03276900 0051 + SUB[I]:=TEMP-1; I:=I+1 END; 03277000 0057 + IF NEWRANK GTR RANK THEN BEGIN ERR:=DOMAINERROR;GO TO QUIT END; 03277010 0060 + % CALCULATE THE OLD DEL VECTOR, OLDEL 03277100 0063 + OLDEL[RANK-1]:=1; N:=M+RANK-1; 03277200 0063 + FOR I:=RANK-2 STEP -1 UNTIL 0 DO BEGIN 03277300 0066 + OLDEL[I]:=OLDEL[I+1]×SP[NOC]; N:=N-1 END; 03277400 0071 + MBASE:=M; SIZE:=1; 03277500 0077 + %FIX UP THE NEW RVEC AND DEL 03277700 0078 + FOR I:=NEWRANK-1 STEP -1 UNTIL 0 DO BEGIN 03277800 0078 + % FIND SMALLEST EL. OF RHO RDESC [J] S.T. A[J]=I 03277900 0083 + % AND SUM OF OLDEL[J] S.T. A[J]=I 03278000 0083 + MIN:=31; TEMP:=0; 03278100 0083 + FOR J:=RANK-1 STEP -1 UNTIL 0 DO 03278200 0084 + IF SUB[J]=I THEN BEGIN 03278300 0088 + M:=MBASE+J; 03278400 0090 + IF SP[MOC] LSS MIN THEN MIN:=SP[MOC]; 03278500 0091 + TEMP:=TEMP+OLDEL[J] END; 03278600 0097 + RVEC[I]:=MIN; DEL[I]:=TEMP; SIZE:=SIZE×RVEC[I]; 03278700 0099 + IF TEMP=0 THEN BEGIN %IT DOESN7T EXHAUSE IOTA NEWRANK 03278710 0103 + ERR:=DOMAINERROR; GO TO QUIT END; 03278720 0104 + END; 03278800 0106 + RESULT:=M:=GETSPACE(NEWRANK+SIZE); 03279200 0106 + RESULT.RF:=NEWRANK; RESULT.DID:=DDPUVW; 03279300 0108 + IF BOOLEAN(BREG.ARRAYTYPE) THEN BEGIN 03279310 0112 + RESULT.ARRAYTYPE:=1; N:=MBASE; 03279320 0116 + MBASE:=UNPACK(MBASE,RANK,N:=OLDEL[0]×SP[NOC]); 03279330 0119 + FORGETSPACE(MBASE,N+RANK) END; 03279340 0124 + FOR I:=1 STEP 1 UNTIL NEWRANK DO BEGIN 03279400 0125 + SP[MOC]:=RVEC[I-1]; M:=M+1 END; 03279500 0127 + %INITIALIZE FOR STEPPING THRU NEW ARRAY 03279590 0134 + FOR I:=NEWRANK-1 STEP -1 UNTIL 0 DO BEGIN 03279600 0134 + SUB[I]:=0; OLDEL[I]:=RVEC[I]×DEL[I] END; 03279610 0138 + L:=MBASE+RANK; 03279700 0142 + %STEP THRU THE SUBSCRIPTS OF THE ANSWER TO PICK UP THE ELEMENTS 03279800 0143 + % IN ROW ORDER ACCORDING TO THE MAPPING GIVEN BY DEL 03279900 0143 + PTR:=TOP:=NEWRANK-1; 03280000 0143 + FOR I:=1 STEP 1 UNTIL SIZE DO BEGIN 03280100 0145 + SP[MOC] :=SP[LOC]; 03280200 0147 + M:=M+1; 03280300 0152 + %GET NEXT SUBSCRIPT FOR NEW ARRAY AND SET NEXT L; 03280400 0153 + SUB[PTR]:=SUB[PTR]+1; 03280500 0153 + L:=L+DEL[TOP]; 03280600 0155 + CARRY:=TRUE; 03280700 0156 + WHILE CARRY AND I NEQ SIZE DO 03280800 0157 + IF SUB[PTR] GEQ RVEC[PTR] THEN BEGIN 03280900 0159 + SUB[PTR]:=0; 03280990 0161 + L:=L-OLDEL[PTR]+DEL[PTR:=PTR-1]; 03281000 0162 + SUB[PTR]:=SUB[PTR]+1 03281100 0165 + END ELSE CARRY := FALSE; 03281200 0166 + PTR:=TOP; 03281210 0169 + END; 03281600 0170 + IF BOOLEAN(RESULT.ARRAYTYPE) THEN PACK(RESULT.SPF,TOP+1,SIZE); 03281700 0172 + QUIT: END OF DYADICTRANS; 03281710 0175 + 132 IS 184 LONG, NEXT SEG 56 + INTEGER PROCEDURE LOCATE(L,M); VALUE L,M; REAL L,M; 03490000 0071 + BEGIN 03490100 0071 + COMMENT L IS THE DIMENSION VECTOR(DESCRIPTOR), 03490200 0071 + M IS THE INDEX VECTOR; 03490300 0071 + INTEGER P,I,UB; 03490400 0071 + START OF SEGMENT ********** 133 + L:=I:=L.SPF; M:=I:=M.SPF; 03490500 0000 + UB:=SP[MOC]-1; 03490600 0003 + M:=M+1; 03490700 0006 + FOR I:=1 STEP 1 UNTIL UB DO 03490800 0008 + BEGIN 03490900 0009 + L:=L+1; 03491000 0009 + P:=(P+SP[MOC]-1)×SP[LOC]; 03491100 0010 + M:=M+1 03491200 0016 + END; 03491300 0016 + P:=P+SP[MOC]; 03491400 0020 + LOCATE:=P+L; 03491450 0023 + END; 03491500 0024 + 133 IS 28 LONG, NEXT SEG 56 + PROCEDURE DISPLAY(A,B); VALUE A,B; REAL A,B; 03500000 0071 + BEGIN 03500100 0071 + PROCEDURE PRINTMATRIX(L,ROW,COL);VALUE L,ROW,COL; 03500110 0071 + START OF SEGMENT ********** 134 + INTEGER L,ROW,COL; 03500120 0000 + BEGIN INTEGER I,J,CC,FOLD; DEFINE WIDE=GT2#; 03500130 0000 + START OF SEGMENT ********** 135 + WIDE:=LINESIZE; 03500132 0000 + FOR I:=1 STEP 1 UNTIL ROW DO 03500134 0001 + BEGIN CC:=0; %NO BLANKS AT BEGINNING OF LINE 03500138 0003 + FOLD:=0; 03500139 0003 + FOR J:=1 STEP 1 UNTIL COL DO 03500140 0004 + BEGIN NUMBERCON(SP[LOC],ACCUM); 03500142 0006 + IF FOLD:=FOLD+ACOUNT+CC GTR WIDE AND ACOUNT+CC 03500143 0009 + LEQ WIDE THEN BEGIN TERPRINT; 03500144 0013 + FORMROW(0,2,ACCUM,2,ACOUNT); FOLD:=ACOUNT+2; END ELSE 03500145 0015 + FORMROW(0,CC,ACCUM,2,ACOUNT); L:=L+1; 03500146 0020 + CC:=2; %PUT 2 BLANKS AFTER THE FIRST ITEM. 03500148 0025 + END; 03500150 0026 + TERPRINT; 03500154 0028 + END 03500158 0029 + END; 03500162 0029 + 135 IS 35 LONG, NEXT SEG 134 + INTEGER L,N,M,BOTTOM,ALOC,BLOC; 03500200 0000 + INTEGER ROW,COL; 03500210 0000 + ALOC:=A.SPF; BLOC:= B.SPF-1; 03500300 0000 + L:=(M:=B.RF)+ BLOC; COL:=SP[LOC]; 03500310 0003 + L:=L-1; 03500320 0008 + ROW:=(IF M GTR 1 THEN SP[LOC] ELSE 1); 03500330 0009 + L:=BOTTOM:=M-2; 03500350 0014 + PRINTMATRIX(LOCATE(B,A),ROW,COL); 03500400 0015 + WHILE L GTR 0 DO 03500450 0017 + BEGIN 03500500 0019 + M:=ALOC+L; N:=BLOC+L; 03500550 0019 + IF SP[MOC]:=SP[MOC]+1 GTR SP[NOC] THEN 03500600 0021 + BEGIN SP[MOC]:=1; L:=L-1; END 03500650 0029 + ELSE BEGIN FORMWD(3,"1 "); 03500700 0034 + PRINTMATRIX(LOCATE(B,A),ROW,COL); 03500710 0035 + L:=BOTTOM; 03500750 0037 + END; 03500800 0038 + END; 03500850 0038 + FORMWD(3,"1 "); 03500855 0040 + END; 03500900 0041 + 134 IS 47 LONG, NEXT SEG 56 + PROCEDURE MAKEFUNCTIONPRESENT(L); VALUE L ; REAL L; %LOC DESC 03501100 0071 + BEGIN 03501200 0071 + INTEGER I; 03501300 0071 + START OF SEGMENT ********** 136 + REAL M,N,SEQ,ORD,D; 03501400 0000 + BOOLEAN NUMERIC; 03501600 0000 + REAL STREAM PROCEDURE CON(A); VALUE A; 03501610 0000 + BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT 03501620 0000 + END; 03501630 0000 + D:=SP[LOC]; %DESCRIPTOR FOR FUNCTION IS IN D 03501700 0001 + SEQ:=GETFIELD(D,FSQF-8,FFL); ORD:=GETFIELD(D,FPTF-8,FFL); 03501800 0004 + N:=GETSPACE((M:=SIZE(ORD))×2+6); %GET SPACE FOR TABLE 03501900 0010 + SP[NOC]:=M×2+5; %SIZE OF THE VECTOR WHICH FOLLOWS 03502000 0013 + D:=D&N[CSPF]&1[CRF]&0[BACKPT]; D.PRESENCE:=1; 03502100 0017 + SP[LOC]:=D; %THIS SETS UP THE FUNCTION DESCRIPTOR. 03502200 0023 + N:=N+1; SP[NOC]:=SEQ; 03502300 0026 + COMMENT 03502400 0030 + SP[N] = SIZE OF THE VECTOR 03502500 0030 + SP[N+1] = SEQUENTIAL STORAGE UNIT FOR THE TEXT 03502600 0030 + SP[N+2] = SP LOC OF FIRST NUMERIC POINTER TO TEXT 03502700 0030 + 03502710 0030 + SP[N+3] = REL LOC (TO N+5) OF THE FIRST ARG 03502800 0030 + SP[N+4] = REL LOC OF THE SECOND ARG 03502900 0030 + SP[N+5] = REL LOC OF RESULT . IF ANY ARE ZERO, THEN 03503000 0030 + THEY ARE NOT THERE.; 03503100 0030 + D:=M; M:=(N:=N+4)+1; %D IS #ITEMS, M IS LOC 1ST, N=M-1 03503200 0030 + FOR I:=1 STEP 1 UNTIL D DO %GET LABELS FROM STORAGE 03503300 0033 + BEGIN L:=CONTENTS(ORD,I-1,GTA); 03503400 0034 + IF NOT NUMERIC THEN %RESULT, ARGS, OR LOCALS/LABELS 03503500 0036 + IF NUMERIC:=GTA[0]=0 THEN %FIRST NUMERIC POINTER 03503600 0037 + BEGIN L:=N-3; SP[LOC]:=N+I×2-1; 03503700 0039 + END; 03503800 0045 + SP[MOC]:=GTA[0]; M:=M+1; 03503900 0045 + IF NUMERIC THEN SP[MOC]:=GTA[1] ELSE 03504000 0050 + BEGIN 03504100 0054 + IF SEQ:=GTA[1] LSS 0 THEN %RESULT OR ARG 03504200 0054 + BEGIN L:=N+SEQ+1; SP[LOC]:=I; 03504300 0056 + SEQ:=0; 03504310 0061 + END ELSE SEQ:=CON(SEQ)/10000; 03504400 0062 + SP[MOC]:=SEQ 03504500 0064 + END; 03504600 0067 + M:=M+1 03504700 0067 + END; 03504800 0068 + COMMENT WE HAVE SET UP THE FUNCTION LABEL TABLE, LET 03504900 0071 + SOMEONE ELSE FIGURE OUT HOW TO EXECUTE IT; 03505000 0071 + END; 03505100 0071 + 136 IS 77 LONG, NEXT SEG 56 + PROCEDURE PUSHINTOSYMTAB(FPTR);VALUE FPTR;REAL FPTR; 03506000 0071 + BEGIN COMMENT ...PUT THE LOCAL VARIABLES FROM THIS SUSPENDED 03506100 0071 + FUNCTION INTO THE SYMBOL TABLE TO BE TREATED AS GLOBAL VARIABLES 03506200 0071 + WHILE THE FUNCTION IS SUSPENDED. FPTR IS THE ENTRY FROM THE 03506300 0071 + STATE INDICATOR VECTOR FOR THE FUNCTION.; 03506400 0071 + 03506500 0071 + REAL T,U; 03506600 0071 + START OF SEGMENT ********** 137 + LABEL COPY; 03506700 0000 + INTEGER K,L,M,N; 03506800 0000 + M:=FPTR.LOCFIELD+1;%LOCATE FMKS TO FIND LOCAL VALUES IN STACK 03506900 0000 + N:=FPTR.SPF+2;T:=SP[NOC]-2;%FIND LOCAL NAMES 03507000 0001 + FOR N:=N+4 STEP 2 UNTIL T DO %ONCE FOR EACH LOCAL 03507100 0006 + BEGIN GT1:=SP[NOC].[6:42];%PICK UP THE LOCAL NAME 03507200 0011 + L:=SYMBASE;K:=L+SP[LOC];% LOOK IN SYMBOL TABLE 03507300 0015 + FOR L:=L+1 STEP 2 UNTIL K DO % CHECK EACH NAME 03507400 0019 + IF GT1=SP[LOC].[6:42] THEN % WE FOUND A MATCH 03507500 0023 + BEGIN GT1:=M;K:=M:=GETSPACE(1);L:=L+1; 03507600 0027 + SP[MOC]:=SP[LOC]; %PUSH CURRENT DESCRIPTOR DOWN 03507700 0031 + M:=GT1; GO TO COPY; 03507800 0036 + END; 03507900 0038 + COMMENT GET HERE IF NO MATCH...MUST MAKE A NEW ENTRY IN 03508000 0038 + SYMBOL TABLE; 03508100 0038 + IF K LSS MAXSYMBOL×2 THEN % THERE IS ROOM IN SYMBOL TABLE 03508200 0038 + BEGIN L:=SYMBASE;SP[LOC]:=SP[LOC]+2; L:=K+1; 03508300 0039 + SP[LOC]:=GT1&OPERAND[CTYPEF]&1[CSUSVAR];L:=L+1;K:=0; 03508400 0048 + COPY: COMMENT L IS LOC IN SYMBOL TABLE FOR DESC. K WILL BE 03508500 0055 + CONTENTS OF BACKF. NOW SET UP THE NEW DESCRIPTOR AND 03508600 0055 + SAVE ITS LOCATION IN THE STACK. M IS THE STACK LOCATION 03508700 0055 + OF THE LOCAL; 03508800 0055 + 03508900 0055 + SP[LOC]:=SP[MOC]&K[CLOCF]&1[CNAMED]; 03509000 0055 + SP[MOC]:=L&DDNUVW[CDID];M:=M+1; 03509100 0062 + END ELSE % THERE IS NO ROOM IN THE SYMBOL TABLE 03509200 0067 + BEGIN N:=T;ERR:=SPERROR;END; 03509300 0067 + END;% OF FOR LOOP STEPPING THRU THE LOCALS 03509400 0069 + END; % OF PUSHINTOSYMTAB PROCEDURE 03509500 0069 + 137 IS 74 LONG, NEXT SEG 56 + PROCEDURE FORGETPROGRAM(U);VALUE U; REAL U; 03510000 0071 + BEGIN REAL L,M; 03510100 0071 + START OF SEGMENT ********** 138 + COMMENT U IS A PROGRAMMKS...THE SP STORAGE FOR THIS LINE 03510150 0000 + SHOULD BE RELEASED; 03510151 0000 + M:=U.SPF;SCRATCHAIN(SP[MOC].LOCFIELD);%CONSTANT CHAIN 03510200 0000 + L:=SP[MOC].SPF;FORGETSPACE(M,1);%FORGET PROGRAM DESC. 03510300 0004 + M:=L+1;SCRATCHDATA(SP[MOC]);%FORGET BUFFER 03510400 0008 + FORGETSPACE(L,SP[LOC]+1);%FORGET THE POLISH 03510500 0012 + END; 03510600 0016 + 138 IS 20 LONG, NEXT SEG 56 + EXPOVR:=EXPOVRL; 03609000 0071 + INTOVR:=INTOVRL; 03609100 0072 + INDEX:=INDEXL; 03609200 0074 + FLAG:=FLAGL; 03609300 0076 + ZERO:=ZEROL; 03609400 0078 + CASE MODE OF 03700000 0079 + BEGIN ;%-------------------------------------------------------- 03700100 0080 + %---------------- CASE 1....MODE=XEQUTE------------------------ 03700200 0080 + CASE CURRENTMODE OF 03700300 0080 + BEGIN%----------------------------------------------------- 03700400 0081 + %------------ SUB-CASE 0....CURRENTMODE=CALCMODE----------- 03700500 0081 + IF T:=ANALYZE(TRUE) NEQ 0 THEN % WE HAVE A PROGRAM DESC 03700600 0081 + BEGIN COMMENT SET-UP THE STACK; 03700700 0083 + IF STACKBASE=0 THEN BEGIN 03700710 0083 + STACKBASE:=L:=GETSPACE(STACKSIZE+1); 03700800 0085 + IF ERR NEQ 0 THEN BEGIN STACKBASE:=0; 03700810 0088 + ERRORMESS(ERR,0,0); GO TO PROCESSEXIT;END; 03700820 0090 + SP[LOC]:=2; 03700900 0092 + L:=L+1; 03700910 0095 + M:=GETSPACE(STATEVECTORSIZE+1); 03700912 0096 + SP[LOC]:=M&1[CRF]&DDPNVW[CDID]; 03700920 0098 + SP[MOC]:=STATEVECTORSIZE; 03700930 0103 + M:=M+1; SP[MOC]:=0; % THE STATE VECTOR IS INITIALIZED NOW 03700940 0106 + FUNCLOC:=M; 03700950 0110 + N:=0; 03700960 0111 + L:=L+1; COMMENT READY FOR A PROG MKS; 03701000 0112 + END ELSE % THERE IS ALREADY A STACK...USE IT 03701010 0113 + BEGIN L:=STACKBASE; 03701012 0113 + ST:=SP[LOC]+L; 03701020 0114 + WHILE M:=AREG.DID NEQ IMKS AND M NEQ PROGMKS AND 03701022 0118 + ERR=0 DO POP;%STRIP BACK TO LASTMARKSTACK 03701024 0122 + IF M=IMKS THEN BEGIN N:=ST-STACKBASE;PUSH; 03701026 0125 + END ELSE N:=AREG.BACKF; 03701028 0128 + SP[LOC]:=ST-STACKBASE;L:=ST; 03701030 0132 + END; 03701040 0136 + CURLINE:=0; 03701050 0136 + M:=GETSPACE(1); SP[MOC]:=T; %STORE PROG DESCRIPTOR 03701060 0138 + SP[LOC]:=M&PROGMKS[CDID]&N[BACKPT]&1[CI]; 03701100 0142 + COMMENT JUST BUILT A PROGRAM MARKSTACK; 03701200 0148 + GO TO EXECUTION; 03701300 0148 + END; 03701400 0148 + %------------SUB-CASE 1....CURRENTMODE=XEQMODE--------------- 03701500 0149 + COMMENT RECOVERY FROM A TIME-OUT; 03701600 0149 + GO TO EXECUTION; 03701700 0149 + %----------- SUB-CASE 2....CURRENTMODE=FUNCMODE-------------- 03701800 0149 + COMMENT SYNTAX CHECK ONLY; 03701900 0149 + IF ANALYZE(TRUE)=0 THEN; 03702000 0149 + %----------- END OF SUB CASES------------------------------- 03702100 0152 + END; 03702200 0152 + START OF SEGMENT ********** 139 + 139 IS 3 LONG, NEXT SEG 56 + %----------------- CASE 2.....MODE=ALLOC-------------------------- 03702300 0152 + COMMENT NOTHING TO DO; 03702400 0152 + ; 03702500 0152 + %---------------- CASE 3.... MODE=WRITEBACK--------------------- 03702600 0152 + COMMENT HAVE TO WRITE BACK ALL THE CHANGED VARIABLES; 03702700 0152 + IF SYMBASE NEQ 0 THEN 03702800 0152 + WRITEBACK; 03702900 0153 + 03709000 0155 + %---------------- CASE 4.... MODE=DEALLOC----------------------- 03709100 0155 + ; 03709200 0155 + 03709300 0155 + 03709400 0155 + %---------------- CASE 5 .... MODE=INTERROGATE------------------ 03709500 0155 + COMMENT PRINT OUT THE PROGRAM STATUS VECTOR HERE; 03709600 0155 + IF L:=STACKBASE+1 NEQ 1 THEN 03709700 0155 + BEGIN COMMENT GT1=1 FOR SIV...=0 FOR SI; 03709710 0157 + U:=GT1; 03709715 0157 + L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L; 03709720 0158 + WHILE M GTR L DO 03709730 0165 + BEGIN N:=SP[MOC].LOCFIELD;N:=SP[NOC].SPF-1; 03709740 0167 + % N IS LOCATION OF THE FUNCTION NAME 03709742 0174 + ACCUM[0]:=SP[NOC]; 03709750 0174 + FORMROW(2,6,ACCUM,1,7); 03709760 0177 + IF BOOLEAN(SP[MOC].SUSPENDED) THEN FORMWD(0,"3 S ") 03709770 0179 + ELSE FORMWD(0,"3 "); 03709772 0183 + IF BOOLEAN(U) THEN % PRINT LOCAL VARIABLE NAMES 03709780 0187 + BEGIN 03709790 0187 + N:=SP[MOC].SPF+2;T:=SP[NOC]-2; 03709800 0187 + FOR N:=N+4 STEP 2 UNTIL T DO 03709810 0194 + BEGIN ACCUM[0]:=SP[NOC]; 03709820 0199 + FORMROW(0,1,ACCUM,1,7); 03709830 0202 + END; 03709840 0204 + END; 03709850 0206 + TERPRINT; M:=M-1; 03709860 0206 + END; 03709870 0207 + END; 03709880 0208 + END;% OF THE CASE STATEMENT 03711000 0208 + START OF SEGMENT ********** 140 + 140 IS 6 LONG, NEXT SEG 56 + %--------------END OF CASES--------------------------------------- 03711100 0208 + IF FALSE THEN EXECUTION: 03750000 0208 + BEGIN COMMENT EXECUTION LOOP; 03750100 0210 + INTEGER LOOP; 03750200 0210 + START OF SEGMENT ********** 141 + INTEGER INPUTIMS; 03750202 0000 + LABEL BREAKKEY; 03750204 0000 + LABEL SKIPPOP,XEQEPS; 03750210 0000 + BOOLEAN XIT, JUMP; 03750300 0000 + REAL POLWORD; 03750400 0000 + DEFINE RESULT=RESULTD#; 03750410 0000 + LABEL EXECEXIT, EVALQ, EVALQQ; 03750500 0000 + %%% 03751000 0000 + COMMENT THERE IS A PROGRAM DESCRIPTOR AT THE TOP OF STACK; 03751100 0000 + ERR:=0; 03751200 0000 + L:=STACKBASE; ST:=L+SP[LOC]; 03751300 0000 + L:=L+1;FUNCLOC:=SP[LOC].SPF+1; 03751310 0005 + T:=AREG; 03751350 0010 + IF CURRENTMODE=XEQMODE THEN %AREG IS INTERRUPT MARK STACK 03751400 0012 + BEGIN LASTMKS:=STACKBASE+T.BACKF; 03751500 0013 + OLDDATA:=T.SPF; INPUTIMS:=T.QUADIN; POP; 03751600 0016 + COMMENT MAY BE CURRENTLY EXECUTING A FUNCTION; 03751610 0019 + L:=STACKBASE+1; L:=SP[LOC].SPF+1; 03751620 0019 + IF (M:=SP[LOC].SPF) NEQ 0 THEN 03751630 0024 + BEGIN M:=M+L; L:=SP[MOC].LOCFIELD; 03751640 0028 + CURLINE:=SP[LOC].CIF; 03751650 0033 + 03751660 0037 + END; 03751670 0037 + END 03751680 0037 + ELSE LASTMKS:=ST;%AREG IS PROGRAM MARK STACK 03751700 0037 + CURRENTMODE:=XEQMODE; 03751750 0038 + L:=LASTMKS; T:=SP[LOC]; % T IS PROGRAM MARK STACK 03751800 0039 + CINDEX:=T.CIF; % CONTROL INDEX IN POLISH 03751900 0043 + IF L:=T.SPF =0 THEN %PHONEY PROG DESC FROM FUNCTION CALL 03752000 0044 + N:=POLTOP:=POLLOC:=0 ELSE 03752010 0046 + BEGIN 03752020 0048 + N:=POLLOC:=SP[LOC].SPF; 03752030 0048 + POLTOP:=SP[NOC] 03752040 0052 + END; 03752050 0054 + IF ERR = 0 THEN % POP WORKED 03752100 0055 + IF INPUTIMS=2 THEN BEGIN JUMP:=TRUE; GO TO EVALQ END ELSE 03752110 0056 + IF INPUTIMS=1 THEN BEGIN JUMP:=TRUE; GO TO EVALQQ; END ELSE 03752120 0059 + DO BEGIN COMMENT EXECUTE UNTIL DONE OR TIME-OUT; 03752200 0062 + IF CINDEX LSS POLTOP THEN %MORE TO EXECUTE IN POLISH 03752300 0062 + BEGIN COMMENT GET NEXT POLISH TO EXECUTE; 03752400 0063 + M:=(CINDEX:=CINDEX+1)+POLLOC; 03752500 0063 + POLWORD:=T:=SP[MOC]; 03752600 0066 + CASE T.TYPEFIELD OF 03752700 0069 + BEGIN %-------TF=0 (REPLACEMENT)-------------- 03752800 0070 + BEGIN %MAY BE A LOCAL OR A GLOBAL VARIABLE 03752900 0070 + DEFINE STARTSEGMENT=#; %///////////////////// 03752905 0070 + START OF SEGMENT ********** 142 + PUSH; IF ERR NEQ 0 THEN GO TO SKIPPOP; 03752910 0000 + N:=T.LOCFIELD; 03752912 0004 + IF BOOLEAN(T.OPTYPE) THEN %A LOCAL VARIABLE 03752915 0005 + BEGIN M:=FUNCLOC;%FIND LAST FMKS 03752916 0006 + M:=SP[MOC].SPF+M; 03752917 0007 + N:=SP[MOC].LOCFIELD+N; END; 03752918 0011 + U:=SP[NOC]; U.LOCFIELD:=N; AREG:=U; 03752920 0015 + IF U.DATADESC=0 THEN ERR:=NONCEERROR; 03752922 0022 + COMMENT PROBABLY MIXUP WITH FUNCTION NAMES 03752924 0025 + AND NAMES OF LOCAL SUSPENDED VARIABLES; 03752926 0025 + END; 03752930 0025 + 142 IS 26 LONG, NEXT SEG 141 + %-------------FUNCTION CALL---------------- 03752950 0071 + %&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 03752960 0071 + BEGIN COMMENT SET UP STACK FOR A FUNCTION CALL; 03752970 0071 + REAL U,V,NARGS,D; 03752980 0071 + START OF SEGMENT ********** 143 + INTEGER I,FLOC; 03752982 0000 + LABEL TERMINATE; 03752990 0000 + COMMENT 03752991 0000 + MONITOR PRINT(D,L,M,N,FLOC,SP,LASTMKS);%::::::::::::::::::: 03752992 0000 + FLOC:=N:=T.LOCFIELD; 03753000 0000 + IF BOOLEAN(SP[NOC].DATADESC) THEN BEGIN ERR:=NONCEERROR; 03753005 0001 + GO TO TERMINATE;END;%SUSPENDED VAR CONFUSED WITH FUNCTION 03753007 0005 + IF NOT BOOLEAN(SP[NOC].PRESENCE) THEN MAKEFUNCTIONPRESENT(N); 03753010 0006 + D:=SP[NOC]; L:=LASTMKS; %D IS THE DESC, L IS THE PROG MKS 03753020 0010 + SP[LOC].CIF:=CINDEX; %SAVE CURRENT POLISH LOCATION 03753022 0014 + L:=STACKBASE+1; L:=SP[LOC].SPF+1; 03753030 0018 + M:=SP[LOC].SPF; 03753035 0023 + IF N:=M+L NEQ L THEN %THERE IS A NESTED CALL 03753040 0026 + IF NOT BOOLEAN(SP[NOC].SUSPENDED) THEN 03753045 0028 + BEGIN N:=SP[NOC].LOCFIELD;SP[NOC].CIF:=CURLINE;END; 03753050 0032 + 03753060 0040 + 03753070 0040 + SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); %INITIALIZE GTA 03753080 0040 + NARGS:=D.NUMBERARGS; 03753090 0043 + FOR I:=1 STEP 1 UNTIL NARGS DO 03753100 0045 + IF BOOLEAN((T:=AREG).DATADESC) THEN 03753110 0046 + BEGIN 03753120 0049 + IF BOOLEAN(T.NAMED) THEN %MAKE A COPY 03753130 0049 + COMMENT YOU COULD MAKE A CALL BY NAME HERE; 03753140 0050 + BEGIN U:=GETSPACE(V:=(NUMELEMENTS(T)+T.RF)); 03753150 0050 + SPCOPY(T.SPF,U,V); T.NAMED:=0; T.SPF:=U; 03753160 0054 + T.BACKP:=0; 03753165 0059 + END ELSE %NO NEED TO MAKE A COPY 03753170 0061 + AREG.PRESENCE:=0; 03753180 0061 + POP; GTA[I-1]:=T; %SAVE THE DESCRIPTOR FOR LATER USE 03753190 0066 + END ELSE ERR:=SYSTEMERROR; 03753200 0068 + IF (N:=M+1) GEQ STATEVECTORSIZE THEN ERR:=DEPTHERROR; 03753205 0071 + IF ERR NEQ 0 THEN GO TO TERMINATE; 03753210 0074 + SP[LOC].SPF:=N; 03753211 0076 + PUSH;AREG:=OLDDATA&(LASTMKS-STACKBASE)[BACKPT]&IMKS[CDID]; 03753212 0080 + OLDDATA:=0; %REINITIALIZE OLDDATA CHAIN FOR THIS FUNCTION 03753214 0086 + %NOW SET UP THE FUNCTION MARK STACK. 03753220 0087 + 03753221 0087 + M:=N+L;PUSH;SP[MOC]:=D.SPF&ST[CLOCF]; 03753222 0087 + M:=D.SPF; M:=M+2; % M IS LOC OF LOC OF FIRST LINE 03753230 0093 + AREG:=0&FLOC[CSPF]&((LASTMKS:=ST)-STACKBASE-1)[BACKPT]& 03753240 0096 + (U:=SP[MOC]-D.SPF)[CCIF]&FMKS[CDID]; % FUNCTION MKS 03753242 0102 + CURLINE:=U; 03753244 0108 + 03753250 0109 + U:=(U-6)/2; % U IS THE NUMBER OF LOCALS, LABELS, AND ARGS 03753260 0109 + M:=M+5; % M IS ON THE FIRST DESC OF THE FIRST LAB, LOC,... 03753270 0111 + FOR I:=1 STEP 1 UNTIL U DO % GET DESCRIPTORS INTO THE STACK 03753280 0112 + BEGIN IF SP[MOC] NEQ 0 THEN %MAKE UP THE DESC 03753290 0114 + BEGIN L:=GETSPACE(1); SP[LOC]:=SP[MOC]; 03753300 0116 + T:=L&DDPUSW[CDID]&0[CCIF] 03753310 0123 + END ELSE 03753320 0125 + T:=NULLV; 03753330 0126 + PUSH; M:=M+2; 03753340 0127 + AREG:=T; %A SINGLE LOCAL 03753350 0129 + END; 03753360 0132 + %COPY OVER THE ARGUMENTS 03753370 0134 + FOR I:=1 STEP 1 UNTIL NARGS DO %COPY OVER 03753390 0134 + BEGIN M:=D.SPF; %M IS THE LOCATION OF THE LABEL TABLE. 03753400 0136 + M:=M+2+I; %M IS LOCATION OF REL LOCATION OF VARIABLE 03753410 0137 + M:=SP[MOC]; 03753420 0139 + N:=LASTMKS+M; 03753430 0141 + SP[NOC]:=GTA[I-1] 03753440 0143 + END; 03753450 0146 + %PUT IN A PHONEY PROG DESC TO START THINGS OFF 03753460 0149 + PUSH; IF ERR NEQ 0 THEN GO TO TERMINATE; 03753470 0149 + AREG:=0&4094[CCIF]&(LASTMKS-STACKBASE)[BACKPT]; 03753480 0150 + LASTMKS:=ST; POLTOP:=POLLOC:=0; 03753490 0156 + TERMINATE: 03753500 0158 + END; 03753510 0159 + 143 IS 161 LONG, NEXT SEG 141 + %&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 03753520 0072 + %-------END OF LOAD FUNCTION FOR CALL----- 03753900 0072 + %-------------TF=2 (CONSTANT)--------------------- 03754000 0072 + BEGIN PUSH; IF ERR=0 THEN BEGIN 03754100 0072 + N:=POLWORD.LOCFIELD;AREG:=SP[NOC];END; 03754110 0074 + END; 03754120 0080 + %-------------TF=3 (OPERATOR)----------------- 03755000 0081 + COMMENT SEQUENCE NUMBERS CORRESPOND TO OPERATOR 03755100 0081 + ASSIGNMENT NUMBER; 03755200 0081 + BEGIN IF T.OPTYPE=MONADIC THEN 03755210 0081 + BEGIN PUSH;IF ERR=0 THEN AREG:=0; END; 03755220 0082 + CASE T.LOCFIELD OF 03755300 0087 + BEGIN %--------------- OPERATE ON STACK---------------------- 03755400 0088 + COMMENT EACH EXECUTION PROCEDURE SETS RESULT TO THE 03755500 0088 + DESCRIPTOR OF THE RESULT OF THE OPERATION. 03755510 0088 + AREG AND BREG ARE THE LEFT AND RIGHT-HAND OPERANDS AND 03755520 0088 + ARE ACTUALLY THE TOP TWO DESCRIPTORS ON THE STACK. 03755530 0088 + IF AREG IS ZERO, THE OPERATOR IS TAKEN TO BE MONADIC.; 03755540 0088 + ; 03800000 0088 + ; 03801000 0088 + ; 03802000 0088 + ; 03803000 0088 + %-------------------- REPLACEMENT OPERATOR--------------- 03804000 0088 + BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// 03804100 0088 + START OF SEGMENT ********** 144 + IF NOT BOOLEAN(L:=AREG.NAMED) THEN % SHOULD BE LOCAL VARIABLE 03804110 0000 + AREG.NAMED:=1; % DONT LET IT BE FORGOTTEN. 03804120 0003 + 03804130 0008 + IF BOOLEAN((T:=AREG).PRESENCE) AND T.SPF NEQ 0 THEN 03804200 0008 + OLDDATA:=CHAIN(T,OLDDATA); 03804210 0013 + M:=T.LOCFIELD; 03804300 0015 + 03804310 0016 + IF(RESULT:=BREG).SPF = 0 THEN U:=T:=0 ELSE 03804320 0016 + U:=GETSPACE(T:=NUMELEMENTS(RESULT)+RESULT.RF); 03804400 0022 + SPCOPY(RESULT.SPF,U,T); 03804500 0026 + RESULT.SPF:=U; RESULT.NAMED:=L; %L IS 0 FOR LOCALS 03804510 0028 + GT1:=IF BOOLEAN((U:=SP[MOC]).PRESENCE) THEN U.BACKP ELSE 0; 03804515 0031 + SP[MOC]:=RESULT>1[CLOCF]; 03804520 0037 + IF BOOLEAN(L) AND GT1=0 THEN %CHECK FOR GLOBAL 03804600 0041 + BEGIN M:=M-1;IF(SP[MOC].SUSPENDVAR=0)THEN SP[MOC].CHANGE:=1; 03804610 0042 + 03804620 0052 + END; 03804630 0052 + RESULT.NAMED:=1; %KEEP "PUSH" FROM TOSSING THE DATA 03804640 0052 + END; 03804700 0054 + 144 IS 55 LONG, NEXT SEG 141 + %-------TRANSFER OPERATOR----------------------------- 03805000 0090 + BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// 03805100 0090 + START OF SEGMENT ********** 145 + SCRATCHAIN(OLDDATA);OLDDATA:=0; 03805110 0000 + IF BOOLEAN(T.OPTYPE) THEN ST:=ST-1; %GET RID OF PHONEY TOP 03805200 0001 + L:=FUNCLOC; 03805210 0004 + IF SP[LOC] NEQ 0 THEN STEPLINE(TRUE) ELSE 03805300 0004 + ERR:=SYNTAXERROR; 03805400 0008 + GO TO SKIPPOP; 03805500 0010 + END; 03805600 0012 + 145 IS 14 LONG, NEXT SEG 141 + BEGIN %--------------COMPRESSION------------------------------------ 03806000 0091 + DEFINE STARTSEGMENT=#; %///////////////////////////////////// 03806005 0091 + START OF SEGMENT ********** 146 + L:=ST-2; IF T.OPTYPE=MONADIC THEN COMPRESS(BREG,SP[LOC],AREG) 03806010 0000 + ELSE COMPRESS(AREG,SP[LOC],BREG); COMMENT A/B HAS BEEN 03806020 0010 + STACKED AS B,A,NULL...A/[I] B HAS BEEN STACKED AS B,I,A; 03806030 0020 + END; 03806040 0020 + 146 IS 21 LONG, NEXT SEG 141 + ARITH(3); %OPERATION IS DIVIDE 03807000 0092 + ; 03807999 0093 + ; 03809000 0093 + %-------------QUAD INPUT------------------------------- 03810000 0093 + EVALQ: BEGIN LABEL EVALQUAD; 03810010 0093 + START OF SEGMENT ********** 147 + IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQUAD END; 03810015 0000 + CURRENTMODE:=INPUTMODE; 03810018 0002 + FORMWD(3,"3[]: "); INDENT(0); 03810020 0003 + 03810030 0005 + IMS(2); % SETUP MARKSTACK FOR QUAD EXIT 03810040 0005 + IF ERR NEQ 0 THEN GO TO SKIPPOP; 03810050 0005 + GO TO EXECEXIT; % EXIT TO MONITOR TILL INPUT IS COMPLETE 03810080 0009 + EVALQUAD: %LOOK AT BUFFER TO SEE WHAT CAME IN 03810100 0012 + BEGIN 03810110 0013 + IF NOT SCAN THEN BEGIN CINDEX:=CINDEX-1;GO TO SKIPPOP;END; 03810112 0013 + IF NOT SETUPLINE THEN CINDEX:=CINDEX-1;%MAKE THEM REDO IT 03810120 0018 + GO TO SKIPPOP; 03810200 0020 + END; 03810210 0023 + END; 03810500 0023 + 147 IS 25 LONG, NEXT SEG 141 + BEGIN % -----EVALUATE SUBSCRIPTS--------------- 03811000 0095 + DEFINE STARTSEGMENT=#; %///////////////////////////////////// 03811002 0095 + START OF SEGMENT ********** 148 + T:=AREG; L:=BREG.SPF; 03811010 0000 + IF BOOLEAN(T.SCALAR) THEN BEGIN ERR:=DOMAINERROR;GO TO SKIPPOP;END; 03811011 0007 + U:=SP[LOC]; % GET # OF SUBSCRIPTS 03811012 0011 + IF U GTR 32 THEN ERR:=INDEXERROR ELSE 03811014 0014 + BEGIN 03811015 0016 + IF U GTR 0 THEN BEGIN 03811017 0017 + IF T.PRESENCE NEQ 1 THEN % GET ARRAY INTO SP 03811020 0018 + BEGIN N:=T.LOCFIELD; 03811030 0019 + IF (T:=SP[NOC]).PRESENCE NEQ 1 THEN 03811040 0021 + BEGIN T:=GETARRAY(T); SP[NOC]:=T END; 03811050 0025 + T.LOCFIELD:= N; 03811052 0029 + END; 03811060 0031 + IF ERR=0 THEN % NOW EVALUATE 03811070 0031 + 03811080 0032 + RESULT:=SUBSCRIPTS(L:=(IF T.LOCFIELD=0 THEN OUTOF 03811090 0032 + ELSE INTO),T,U); 03811100 0035 + IF L=INTO THEN BEGIN 03811101 0037 + 03811102 0038 + CINDEX:=CINDEX+1;END; % SKIP OVER REPLACE OP 03811103 0038 + END ELSE % NO SUBSCRIPTS 03811104 0040 + BEGIN BREG:=T; ST:= ST-1; GO TO SKIPPOP; 03811106 0040 + END; % DON≤T LET THE DESC. IN T BE POPPED. 03811108 0048 + U:=U+2; % # OF THINGS TO POP 03811110 0048 + FOR N:=1 STEP 1 UNTIL U DO POP; 03811114 0049 + IF L=OUTOF THEN PUSH; AREG:=RESULT; 03811116 0053 + 03811120 0058 + GO TO SKIPPOP; 03811130 0058 + END; 03811140 0061 + END; 03811200 0061 + 148 IS 62 LONG, NEXT SEG 141 + ; 03812000 0096 + ; 03813000 0096 + %-------------QQUAD INPUT------------------------------ 03814000 0096 + EVALQQ: BEGIN LABEL EVALQQUAD; 03814010 0096 + START OF SEGMENT ********** 149 + IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END; 03814015 0000 + CURRENTMODE:=INPUTMODE; 03814020 0002 + IMS(1); % SETUP MARKSTACKS FOR QQUAD EXIT 03814030 0003 + IF ERR NEQ 0 THEN GO TO SKIPPOP; 03814040 0004 + GO TO EXECEXIT; 03814080 0008 + EVALQQUAD: % BUFFER CONTAINS THE INPUT STRING 03814100 0010 + IF (L:=LENGTH(BUFFER,TRUE))NEQ 0 THEN BEGIN %L IS # CHAR INPUT 03814110 0011 + N:=ENTIER((L+7) DIV 8); % FIND NUMBER OF WORDS 03814120 0014 + M:=GETSPACE(N+1); % GET SPACE FOR THE VECTOR IN SP 03814130 0016 + TRANSFERSP(INTO,SP,M+1,BUFFER,0,N); 03814140 0018 + SP[MOC]:=L; % STORE LENGTH OF VECTOR 03814150 0022 + RESULT:=M&1[CRF]&DDPUVC[CDID]; % SET UP DESCRIPTOR 03814160 0025 + END ELSE RESULT:=NULLV;% NOTHING WAS INPUT 03814162 0028 + PUSH; IF ERR=0 THEN AREG:=RESULT; 03814170 0030 + GO TO SKIPPOP; 03814180 0035 + END; 03814500 0038 + 149 IS 39 LONG, NEXT SEG 141 + RESULTD := SEMICOL; %CONVERSION CONCATENATION 03815000 0098 + COMMAP; %CATENATE 03816000 0100 + BEGIN%----------INNER PRODUCT (PERIOD)--------------------- 03817000 0101 + M:=(CINDEX:=CINDEX+2) + POLLOC; T:=SP[MOC];M:=M-1;U:=SP[MOC]; 03817100 0101 + PERIOD(AREG,BREG,U.LOCFIELD,T.LOCFIELD); 03817200 0110 + END; 03817300 0117 + ARITH(4); %* 03818000 0118 + ; 03819000 0119 + ; 03820000 0119 + ARITH(17); %AND 03821000 0119 + ARITH(18); %OR 03822000 0120 + ARITH(9); %NOT 03823000 0121 + ARITH(11); %LESS:THAN 03824000 0123 + ARITH(16); %LEQ 03825000 0124 + ARITH(12); %= 03826000 0125 + ARITH(13); %GEQ 03827000 0126 + ARITH(14); %GREATER-THAN 03828000 0128 + ARITH(15); %NEQ 03829000 0129 + ARITH(8); %MAX/CEIL 03830000 0130 + ARITH(7); %MIN/FLOOR 03831000 0131 + ARITH(6); %RESD/ABS 03832000 0133 + IF T.OPTYPE=MONADIC THEN GO TO XEQEPS ELSE MEMBER; %MEMBERSHIP 03833000 0134 + RHOP; %RHO 03834000 0137 + IOTAP; %IOTA 03835000 0138 + ; 03836000 0139 + REDUCESORTSCAN(0,BREG,AREG,4); %REVERSAL; 03837000 0139 + BEGIN %-----------EXPANSION-------------------------- 03838000 0146 + DEFINE STARTSEGMENT=#; %//////////////////////////////////// 03838005 0146 + START OF SEGMENT ********** 150 + L:=ST-2; IF T.OPTYPE=MONADIC THEN EXPAND(BREG,SP[LOC],AREG) 03838010 0000 + ELSE EXPAND(AREG,SP[LOC],BREG); COMMENT A EXPN B HAS BEEN 03838020 0010 + STACKED AS B,A,NULL WHILE A EXPN [I] B IS STACKED AS B,I,A; 03838030 0020 + END; 03838040 0020 + 150 IS 21 LONG, NEXT SEG 141 + RESULTD:=BASEVALUE; %BASE VALUE 03839000 0147 + ARITH(10); %COMB/FACT 03840000 0149 + ; 03841000 0150 + IF T.OPTYPE=MONADIC THEN ARITH(5) ELSE 03842000 0150 + DYADICRNDM; %RNDM 03842100 0152 + IF T.OPTYPE=MONADIC THEN TRANSPOSE ELSE DYADICTRANS;%GUESS WHAT 03843000 0154 + RESULTD := REPRESENT; %REPRESENTATION 03844000 0158 + ARITH(45); %CIRCLE--TRIGONOMETRIC FUNCTIONS 03845000 0159 + ; 03846000 0160 + ; 03847000 0160 + ARITH(0); %ADD 03848000 0160 + ARITH(2); %SUBTRACT 03849000 0162 + ARITH(1); %MULTIPLY 03850000 0163 + %-------------------DISPLAY------------------------------------- 03851000 0164 + 03851100 0164 + BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// 03851110 0164 + START OF SEGMENT ********** 151 + IF BREG.SPF=0 THEN FORMROW(3,0,ACCUM,2,0) ELSE %FOR A NULL 03851115 0000 + IF BOOLEAN((RESULT:=BREG).DATADESC)THEN %THIS IS A DATA DESC 03851120 0007 + IF BOOLEAN(RESULT.PRESENCE) AND M:=RESULT.SPF NEQ 0 THEN 03851140 0011 + IF BOOLEAN(RESULT.SCALAR) THEN 03851160 0015 + BEGIN NUMBERCON(SP[MOC],ACCUM); 03851180 0016 + FORMROW(3,0,ACCUM,2,ACOUNT) 03851200 0020 + END 03851220 0022 + ELSE %A VECTOR 03851240 0023 + IF L:=RESULT.RF NEQ 0 THEN % SOMETHING TO PRINT 03851260 0023 + IF BOOLEAN(RESULT.CHRMODE) THEN DISPLAYCHARV(RESULT) 03851300 0025 + ELSE 03851310 0027 + BEGIN RESULT:=M:=GETSPACE(L+1); 03851400 0028 + SP[MOC]:=L; RESULT.RF:=1; RESULT.DID:=DDPUVW; 03851500 0030 + AREG:=RESULT; 03851600 0037 + FOR T:=1 STEP 1 UNTIL L DO 03851610 0040 + BEGIN M:=M+1; SP[MOC]:=1 03851620 0041 + END; 03851630 0044 + DISPLAY(AREG,BREG); 03851700 0047 + RESULT:=BREG; 03851720 0053 + END ELSE TERPRINT 03851760 0057 + ELSE TERPRINT 03851780 0057 + ELSE ; %PROBABLY A FUNCTION....DONT DO ANYTHING 03851880 0058 + IF BREAKFLAG THEN %USER HIT BREAK DURING OUTPUT 03851890 0059 + GO TO BREAKKEY; 03851892 0060 + POP; GO TO SKIPPOP; 03851894 0063 + END; 03851896 0066 + 151 IS 67 LONG, NEXT SEG 141 + BEGIN % ---------------REDUCTION------------------------------------ 03852000 0165 + M:=(CINDEX:= CINDEX+1) + POLLOC; % FIND OPERATION IN POLISH 03852020 0165 + IF (T:=SP[MOC]).TYPEFIELD NEQ 3 THEN ERR:=SYSTEMERROR 03852040 0167 + ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,1); 03852060 0172 + END; 03852080 0180 + BEGIN %--------ROTATION---------------------------- 03853000 0180 + DEFINE STARTSEGMENT=#; %//////////////////////////////////// 03853005 0180 + START OF SEGMENT ********** 152 + L:=ST-2; IF T.OPTYPE=MONADIC THEN 03853010 0000 + REDUCESORTSCAN(BREG,SP[LOC],AREG,5) ELSE 03853015 0002 + REDUCESORTSCAN(AREG,SP[LOC],BREG,5); COMMENT A ROT B IS 03853020 0011 + STACKED AS B,A,NULL WHILE A ROT [I] B IS STACKED AS B,I,A; 03853030 0020 + END; 03853040 0020 + 152 IS 21 LONG, NEXT SEG 141 + ARITH(21); %LOG 03854000 0182 + REDUCESORTSCAN(0,BREG,AREG,2); % SORTUP 03855000 0183 + REDUCESORTSCAN(-1,BREG,AREG,2); %SORTDN 03856000 0190 + BEGIN %-------------SCAN-------LIKE REDUCTION--------------- 03857000 0198 + DEFINE STARTSEGMENT=#; %///////////////////////////////////// 03857010 0198 + START OF SEGMENT ********** 153 + M:=(CINDEX:=CINDEX+1) + POLLOC; %FIND OPERATOR IN POLISH 03857020 0000 + IF (T:=SP[MOC]).TYPEFIELD NEQ 3 THEN ERR:=SYSTEMERROR 03857040 0002 + ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,3); 03857060 0006 + END; 03857080 0014 + 153 IS 16 LONG, NEXT SEG 141 + ARITH(19); %NAND 03858000 0199 + ARITH(20); %NOR 03859000 0200 + IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(2,T,T.RF) 03860000 0202 + ELSE ERR:=RANKERROR; % OPERATION IS TAKE 03860010 0208 + IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T.RF) 03861000 0211 + ELSE ERR:=RANKERROR; % OPERATION IS DROP 03861010 0217 + %-----------------------XEQ----------------------------------- 03862000 0220 + XEQEPS: BEGIN DEFINE STARTSEGMENT=#; %///////////////// 03862005 0220 + START OF SEGMENT ********** 154 + IF AREG NEQ 0 THEN ERR:=SYNTAXERROR %MUST BE MONADIC ONLY 03862010 0000 + ELSE IF (T:=BREG).RF NEQ 1 OR %MUST BE A VECTOR 03862020 0003 + NOT BOOLEAN(T.CHRMODE) THEN ERR:=DOMAINERROR %MUST BE CHAR STRING 03862030 0009 + ELSE IF U:=NUMELEMENTS(T) GTR MAXBUFFSIZE THEN ERR:=LENGTHERROR 03862032 0011 + ELSE BEGIN 03862040 0014 + M:=GT1; % # OF CHARACTERS SET BY NUMELEMENTS 03862042 0015 + INITBUFF(BUFFER,MAXBUFFSIZE);RESCANLINE; 03862048 0016 + TRANSFERSP(OUTOF,SP,T.SPF+1,BUFFER,0,U); 03862050 0018 + IF(U:=U×8-M) GTR 0 THEN SETFIELD(BUFFER,M,U," "); 03862052 0022 + IF T.SPF=0 OR NOT SCAN THEN RESULT:=0&1[CRF]&DDPUVW[CDID]% NULL 03862060 0027 + ELSE BEGIN POP;IF SETUPLINE THEN; GO TO SKIPPOP;END 03862070 0032 + END; END; 03862080 0038 + 154 IS 39 LONG, NEXT SEG 141 + END; %--------------END OF OPERATION ON STACK-------------------- 03869960 0222 + START OF SEGMENT ********** 155 + 155 IS 63 LONG, NEXT SEG 141 + POP;POP;PUSH;IF ERR=0 THEN AREG:=RESULT; 03869970 0222 + SKIPPOP: END OF TYPEFIELD EQUALS OPERATOR; 03869980 0228 + %-------TF=4 (LOCAL VARIABLE)------------ 03870000 0229 + BEGIN COMMENT MOVE DESCRIPTOR UP TO TOP; 03870100 0229 + DEFINE STARTSEGMENT=#; %///////////////// 03870110 0229 + START OF SEGMENT ********** 156 + N:=T.LOCFIELD;M:=FUNCLOC;M:=SP[MOC]+M; 03870200 0000 + 03870210 0005 + N:=SP[MOC].LOCFIELD+N; 03870220 0005 + T:=SP[NOC]; T.NAMED:=1; %KEEP FROM THROWING AWAY 03870300 0009 + PUSH; AREG:=T; 03870400 0013 + END; 03870500 0017 + 156 IS 18 LONG, NEXT SEG 141 + %-------TF=5 (OPERAND)----------------------- 03872000 0230 + BEGIN PUSH; IF ERR=0 THEN BEGIN 03872100 0230 + N:=POLWORD.LOCFIELD; U:=SP[NOC]; 03872200 0232 + IF U.DATADESC=0 THEN ERR:=NONCEERROR ELSE 03872210 0236 + IF U.PRESENCE NEQ 1 THEN BEGIN 03872300 0238 + U:=GETARRAY(U); SP[NOC]:=U END; 03872400 0241 + U.LOCFIELD:=0; 03872410 0245 + AREG:=U; END; 03872500 0247 + END; 03872600 0250 + END; % OF CASE STMT TESTING TYPEFIELD 03900000 0250 + START OF SEGMENT ********** 157 + 157 IS 6 LONG, NEXT SEG 141 + END % OF TEST FOR CINDEX LEQ POLTOP 03901000 0250 + ELSE % WE ARE AT THE END OF THE POLISH 03902000 0250 + BEGIN COMMENT LASTMKS CONTAINS THE LOCATION 03903000 0250 + OF THE LAST MARK STACK. GET MARK STACK AND CONTINUE; 03904000 0251 + 03905000 0251 + SCRATCHAIN(OLDDATA); OLDDATA:=0; 03905010 0251 + L:=LASTMKS;M:=(U:=SP[LOC]).BACKF+STACKBASE;T:=SP[MOC]; 03905020 0252 + IF T.DID=IMKS AND T.QUADIN=3 THEN %SINGLE LINE DONE 03905030 0260 + IF(RESULT:=AREG)=T THEN ERR:=SYNTAXERROR%NO RESULT 03905035 0263 + ELSE BEGIN RESULT.NAMED:=0;%MAKE NEW COPY 03905040 0267 + IF BOOLEAN(RESULT.SCALAR) THEN 03905042 0270 + BEGIN M:=GETSPACE(2);L:=RESULT.SPF; 03905044 0271 + RESULT.SPF:=M+1;SP[MOC]:=RESULT; 03905046 0274 + M:=M+1;SP[MOC]:=SP[LOC]; 03905048 0279 + END ELSE % MAKE COPY OF A VECTOR 03905050 0285 + BEGIN M:=GETSPACE(1+(N:=RESULT.RF+NUMELEMENTS( 03905052 0285 + RESULT))); 03905053 0287 + L:=RESULT.SPF;RESULT.SPF:=M+1; 03905054 0290 + SP[MOC]:=RESULT; SPCOPY(L,M+1,N);END; 03905056 0293 + 03905058 0298 + 03905060 0298 + FORGETPROGRAM(U); 03905070 0298 + 03905080 0299 + DO POP UNTIL ST LSS LASTMKS;%CUT BACK STACK TO IMS 03905082 0299 + OLDDATA:=T.SPF;L:=LASTMKS:=T.BACKF+STACKBASE; 03905084 0300 + AREG:=RESULT; % STORE EXECUTION RESULT OVER IMS 03905086 0304 + CINDEX:=SP[LOC].CIF; M:= SP[LOC].SPF; 03905088 0307 + POLLOC:=M:=SP[MOC].SPF; POLTOP:=SP[MOC]; 03905090 0314 + END ELSE 03905095 0320 + BEGIN L:=FUNCLOC;M:=SP[LOC].SPF+L; 03905100 0320 + IF M NEQ L AND NOT BOOLEAN(SP[MOC].SUSPENDED)THEN 03905200 0325 + BEGIN 03905203 0329 + IF 0=(LOOP:=(LOOP+1) MOD 5) THEN 03905205 0330 + WRITE(TWXOUT,1,JIGGLE[*])[BREAKKEY:BREAKKEY]; 03905206 0332 + %THAT WAS TO CHECK FOR BREAK TO INTERRUPT A PROG 03905207 0341 + STEPLINE(FALSE) 03905210 0341 + END 03905215 0341 + ELSE BEGIN XIT:=TRUE;CURRENTMODE:=CALCMODE; 03905300 0342 + WHILE POPPROGRAM(OLDDATA,LASTMKS) DO; 03905310 0344 + END; 03905400 0346 + END; 03905600 0346 + END; %COMPLETION OF ONE POLISH EVALUATION (1 CELL) 03910000 0346 + IF ERR NEQ 0 THEN % PUT OUT ERROR MESSAGE 03918100 0346 + BEGIN 03918200 0347 + DEFINE STARTSEGMENT=#; %///////////////////////////// 03918201 0347 + START OF SEGMENT ********** 158 + COMMENT 03918209 0000 + MONITOR PRINT(ST,L,M,SP,GTA,T);%:::::::::::::::::::::: 03918210 0000 + XIT:=TRUE;CURRENTMODE:=ERRORMODE; 03918220 0000 + 03918250 0002 + L:=POLLOC+1; 03918300 0002 + TRANSFERSP(OUTOF,SP,(L:=SP[LOC].SPF)+1,BUFFER, 03918400 0003 + 0,MIN(MAXBUFFSIZE,ENTIER((SP[LOC]+7)DIV 8))); 03918450 0009 + L:=FUNCLOC;M:=SP[LOC].SPF+L; 03918455 0016 + GT1:=1;N:=SP[MOC].LOCFIELD;%LOCATION OF FMKS 03918456 0020 + WHILE LASTMKS GTR N AND BOOLEAN (GT1) DO GT1:=IF 03918458 0024 + POPPROGRAM(OLDDATA,LASTMKS)THEN 1 ELSE 0; 03918459 0026 + IF M NEQ L AND NOT BOOLEAN(SP[MOC].SUSPENDED)THEN%GET LINE# 03918460 0031 + BEGIN SP[LOC].RF:=SP[LOC].RF+1;%UP SUSPENDED COUNT 03918462 0035 + L:=SP[NOC].SPF-1;%LOCATION OF FUNCTION NAME 03918464 0042 + SETFIELD(GTA,0,1,0); 03918465 0046 + GTA[0]:=SP[LOC]; 03918467 0048 + FORMROW(3,0,GTA,1,7); 03918470 0051 + L:=SP[MOC].SPF; %BASE OF LABEL TABLE 03918475 0053 + L:=L+CURLINE; 03918480 0057 + T:=SP[LOC]; 03918485 0058 + 03918486 0061 + %ALSO PUT THE FUNCTION INTO SUSPENSION 03918487 0061 + IMS(4);SP[MOC].SUSPENDED:=1;SUSPENSION:=1; 03918488 0061 + PUSHINTOSYMTAB(SP[MOC]); 03918489 0068 + END ELSE T:=0; 03918490 0071 + ERRORMESS(ERR,POLWORD.SPF,T); 03918500 0072 + END; 03918600 0074 + 158 IS 75 LONG, NEXT SEG 141 + END UNTIL XIT; 03919000 0349 + BREAKKEY: BEGIN BREAKFLAG:=FALSE; 03919800 0349 + XIT:=TRUE;CURRENTMODE:=CALCMODE; 03919810 0350 + L:=FUNCLOC;M:=SP[LOC].SPF+L; 03919820 0352 + IF M NEQ L AND NOT BOOLEAN(SP[MOC].SUSPENDED) THEN 03919830 0357 + BEGIN SP[MOC].SUSPENDED:=1;SUSPENSION:=1; 03919840 0361 + PUSHINTOSYMTAB(SP[MOC]);SP[LOC].RF:=SP[LOC].RF+1; 03919850 0368 + M:=SP[MOC].LOCFIELD;%LOCATION OF FMKS IN STACK 03919860 0378 + WHILE LASTMKS GTR M DO IF POPPROGRAM(OLDDATA,LASTMKS) 03919870 0381 + THEN; LASTMKS:=M;IMS(4); 03919880 0383 + END 03919890 0386 + IF FALSE THEN 03919899 0386 + END; 03919900 0386 + EXECEXIT: 03919990 0386 + IF STACKBASE NEQ 0 THEN BEGIN 03919992 0387 + L:=STACKBASE; SP[LOC]:=ST-L; %UPDATE SIZE OF STACK 03920000 0388 + 03920100 0393 + END; 03920200 0393 + END OF EXECUTION LOOP; 03950000 0393 + 141 IS 402 LONG, NEXT SEG 56 + PROCESSEXIT: 03950090 0211 + IF BOOLEAN(POLBUG) THEN % DUMP SP 03950100 0211 + IF MODE=XEQUTE OR MODE=3 OR MODE=6 THEN GO TO DEBUGSP; 03950200 0212 + IF FALSE THEN 03951000 0216 + BEGIN CASE 0 OF BEGIN 03951100 0216 + EXPOVRL: SPOUT(3951200); 03951200 0217 + INTOVRL: SPOUT(3951300); 03951300 0219 + INDEXL: SPOUT(3951400); 03951400 0221 + FLAGL: SPOUT(3951500); 03951500 0223 + ZEROL: SPOUT(3951600); 03951600 0225 + END; 03951700 0227 + START OF SEGMENT ********** 159 + 159 IS 5 LONG, NEXT SEG 56 + REALLYERROR:=1; 03951702 0227 + DEBUGSP: 03951710 0228 + WRITE(PRINT,MIN(15,PSRSIZE),PSR); 03951720 0228 + BEGIN 03951800 0234 + STREAM PROCEDURE FORM(A,B,N); VALUE N; 03951900 0234 + START OF SEGMENT ********** 160 + BEGIN 03952000 0000 + DI:=B; 15(DS:=8LIT" "); 03952100 0000 + SI:=LOC N; DI:=B; DS:=8DEC; DI:=DI+3; 03952200 0002 + SI:=A; 10(DS:=8CHR; DI:=DI+1); 03952300 0003 + END; 03952400 0004 + M:=MIN((NROWS+1)×SPRSIZE-1,MAXMEMACCESSES); 03952500 0004 + FOR N:=0 STEP 10 UNTIL M DO 03952650 0009 + BEGIN TRANSFERSP(OUTOF,SP,N,ACCUM,0,MIN(M-N,10)); 03952700 0012 + FORM(ACCUM,BUFFER,N); 03952800 0018 + WRITE(PRINT,15,BUFFER[*]); 03952900 0019 + END; 03953000 0024 + END; 03953100 0026 + 160 IS 27 LONG, NEXT SEG 56 + IF POLBUG=0 OR BOOLEAN(REALLYERROR) THEN 03953110 0240 + BEGIN 03953120 0242 + ERRORMESS(IF ERR NEQ SPERROR THEN SYSTEMERROR ELSE ERR,0,0); 03953200 0242 + SUSPENSION:=0; 03953210 0245 + CURRENTMODE:=CALCMODE; 03953300 0248 + REALLYERROR:=ERR:=0; 03953301 0249 + END; 03953310 0250 + END; 03953400 0250 + END OF PROCESS PROCEDURE; 03960000 0250 + 56 IS 261 LONG, NEXT SEG 2 + PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R; 05000000 0290 + INTEGER N; REAL ADDR; 05000100 0290 + BEGIN 05000200 0290 + INTEGER STREAM PROCEDURE FORM(A,B); VALUE A; 05000300 0290 + START OF SEGMENT ********** 161 + BEGIN LOCAL T,U; 05000400 0000 + LABEL L,M; 05000500 0000 + SI:=A; 05000600 0000 + L: IF SC=" " THEN 05000700 0000 + BEGIN SI:=SI+1; GO TO L; 05000800 0001 + END; 05000900 0002 + DI:=LOC T; DS:=2RESET; DS:=2SET; 05001000 0002 + DI:=B; MESSIZE(U:=DI; DI:=LOC T; IF SC=DC THEN JUMP OUT TO M; 05001100 0003 + SI:=SI-1; DI:=U; DS:=CHR; TALLY:=TALLY+1); M: 05001200 0005 + FORM:=TALLY; 05001300 0006 + END; 05001400 0007 + ARRAY ERMES[0:13],B[0:MESSIZE/8]; 05001410 0008 + FILL ERMES[*] WITH 05001500 0014 + "1 ", 05001510 0014 + START OF SEGMENT ********** 162 + "5DEPTH ", 05001520 0015 + "6DOMAIN ", 05001530 0015 + "7EDITING", 05001540 0015 + "5INDEX ", 05001600 0015 + "5LABEL ", 05001610 0015 + "6LENGTH ", 05001620 0015 + "5NONCE ", 05001700 0015 + "4RANK ", 05001710 0015 + "6SYNTAX ", 05001720 0015 + "6SYSTEM ", 05001800 0015 + "5VALUE ", 05001810 0015 + "7SP FULL", 05001820 0015 + "7FLYKITE"; 05001830 0015 + 162 IS 14 LONG, NEXT SEG 161 + IF R NEQ 0 THEN 05001900 0015 + BEGIN INDENT(R);CHRCOUNT:=CHRCOUNT-1 05001910 0016 + END; 05002000 0018 + FORMROW((IF R=0 THEN 2 ELSE 0),0,ERMES,N×8+1, 05002010 0019 + ERMES[N].[1:5]); 05002100 0023 + FORMWD(0,"6 ERROR"); 05002110 0025 + IF ADDR.[33:15] GEQ 512 THEN 05002120 0026 + BEGIN 05002130 0027 + FORMWD(0,"4 AT "); 05002200 0027 + FORMROW(1,1,B,0,FORM(ADDR,B)) 05002210 0028 + END; 05002220 0032 + FORMWD(3,"1 "); 05002300 0033 + END; 05002310 0034 + 161 IS 42 LONG, NEXT SEG 2 + PROCEDURE LOADWORKSPACE(JOBNUM,NAME,IDENT); VALUE JOBNUM,NAME; 05002400 0290 + REAL JOBNUM,NAME; ARRAY IDENT[0]; FORWARD; 05002410 0290 + PROCEDURE LOGINAPLUSER; 07001000 0290 + BEGIN 07002000 0290 + COMMENT LOG:IN THE CURRENT USER; 07003000 0290 + COMMENT INPUT LINE IS IS THE BUFFER; 07004000 0290 + LABEL EXEC, GUESS; 07004100 0290 + START OF SEGMENT ********** 163 + DEFINE T=GT1#, J=GT2#,I=GT3#; 07005000 0000 + PROCEDURE INITIALIZEPSR; 07005010 0000 + BEGIN FOR I:=0 STEP 1 UNTIL PSRSIZE-1 DO 07005015 0000 + PSRM[I] := 0; 07005020 0004 + SEED:=STREAMBASE; ORIGIN:=1; 07005025 0006 + FUZZ:=1@-11; 07005030 0008 + LINESIZE:=72; DIGITS:=9; 07005035 0009 + END; 07005040 0014 + LADDRESS := ADDRESS := ABSOLUTEADDRESS; 07006000 0017 + WORKSPACE:=WORKSPACEUNIT; 07007000 0018 + ITEMCOUNT := EOB := 0; 07008000 0019 + IF NEXTUNIT=WORKSPACEUNIT THEN % ESTABLISH A WORKSPACE 07019000 0020 + BEGIN 07020000 0021 + WORKSPACE:=NEXTUNIT; 07021000 0022 + SEQUENTIAL(WORKSPACE); 07022000 0023 + INITIALIZEPSR; 07023000 0024 + I:=STORESEQ(WORKSPACE,PSR,PSRSIZE×8); 07025000 0024 + INITBUFF(OLDBUFFER,BUFFSIZE); 07028000 0027 + 07029000 0028 + END ELSE % WORKSPACE ASSIGNED 07030000 0028 + I:=CONTENTS(WORKSPACE,0,PSR); 07031000 0028 + FILL ACCUM[*] WITH "LOGGED I","N "; 07032000 0031 + START OF SEGMENT ********** 164 + 164 IS 2 LONG, NEXT SEG 163 + FORMROW(0,1,ACCUM,0,9); 07033000 0033 + I:=DAYTIME(ACCUM); 07034000 0035 + FORMROW(1,1,ACCUM,0,I); 07035000 0037 + SYMBASE:=STACKBASE:=0; 07035900 0039 + CSTATION.APLOGGED:=1; 07036000 0041 + CASE CURRENTMODE OF 07036010 0043 + BEGIN %--------CALCMODE-------------- 07036020 0043 + ;COMMENT NOTHING TO DO ANYMORE; 07036030 0044 + %--------------XEQUTEMODE------------ 07036040 0044 + EXEC: 07036042 0044 + BEGIN FILL ACCUM[*] WITH "LAST RUN"," STOPPED"; 07036050 0045 + START OF SEGMENT ********** 165 + 165 IS 2 LONG, NEXT SEG 163 + FORMROW(3,0,ACCUM,0,16); 07036060 0046 + CURRENTMODE:=CALCMODE; 07036070 0049 + END; 07036080 0050 + %-------------FUNCMODE----------------- 07036090 0050 + BEGIN FILL ACCUM[*]WITH "CONTINUE"," DEFINIT", 07036100 0050 + START OF SEGMENT ********** 166 + "ION OF "; 07036110 0052 + 166 IS 3 LONG, NEXT SEG 163 + FORMROW(2,0,ACCUM,0,23); FORMROW(1,0,PSR, 07036120 0052 + FSTART×8,7); 07036130 0056 + CURLINE:=GT3:=TOPLINE(GT1:=FUNCPOINTER); 07036131 0057 + CHECKSEQ(CURLINE,GT3,INCREMENT); %GET INCREMENT 07036132 0060 + CURLINE:=CURLINE+INCREMENT; INDENT(-CURLINE); 07036133 0062 + FUNCSIZE:=SIZE(GT1); 07036134 0065 + END; 07036136 0067 + %------------INPUTMODE--------------ERRORMODE---- 07036140 0068 + GO TO EXEC; GO TO EXEC; 07036150 0068 + END; 07036160 0069 + START OF SEGMENT ********** 167 + 167 IS 5 LONG, NEXT SEG 163 + GUESS: %SHOULD BE BETTER PLACE BUT HERE IS WHERE OTHERS COME OUT 07044001 0069 + STOREPSR; 07044005 0069 + IF CURRENTMODE NEQ FUNCMODE THEN 07044010 0069 + INDENT(0); TERPRINT; 07044100 0070 + VARSIZE:=IF VARIABLES=0 THEN 0 ELSE SIZE(VARIABLES); 07044200 0072 + END; 07045000 0076 + 163 IS 77 LONG, NEXT SEG 2 + PROCEDURE APLMONITOR; 07100000 0290 + BEGIN 07101000 0290 + REAL T; 07102000 0290 + START OF SEGMENT ********** 168 + INTEGER I; 07103000 0000 + BOOLEAN WORK; 07104000 0000 + LABEL AROUND, NEWUSER; 07105000 0000 + LABEL CALCULATE,EXECUTEIT,FUNCTIONSTART,BACKAGAIN; 07106000 0000 + LABEL CALCULATEDIT; 07107000 0000 + I := CUSER := 1; 07107100 0000 + T := STATION; 07115000 0001 + BEGIN FILL ACCUM[*] WITH "APL/B550","0 UW COM" 07115533 0002 + START OF SEGMENT ********** 169 + ,"PUTER SC","IENCE # ",VERSIONDATE; 07115534 0003 + 169 IS 5 LONG, NEXT SEG 168 + WORK:=TRUE; 07115535 0003 + FORMROW(3,MARGINSIZE,ACCUM,0,40); 07115536 0004 + INDENT(0); TERPRINT; CSTATION.APLHEADING:=1 07115538 0006 + ; LOGINAPLUSER; 07115539 0008 + END; 07115540 0010 + AROUND: 07115542 0010 + 07115550 0011 + BEGIN 07115560 0011 + IF MAINTENANCE THEN; 07115570 0011 + CASE CURRENTMODE OF 07115600 0012 + BEGIN %-------CALCMODE-------------------------------- 07115700 0012 + COMMENT HE MUST BE READ READY FOR THE CALCMODE STUFF; 07115800 0013 + 07115900 0013 + GO CALCULATE; 07116000 0013 + %--------XEQUTE MODE-------------------------------- 07116100 0013 + GO TO EXECUTEIT; 07117000 0013 + %----------FUNCMODE----------------------------------- 07117100 0014 + GO TO FUNCTIONSTART; 07117400 0014 + %----------INPUTMODE---------------------------------- 07117500 0014 + COMMENT REQUIRES INPUT; 07117600 0014 + 07117700 0014 + BEGIN COMMENT GET THE LINE AND GO BACK; 07117800 0014 + STARTSCAN; 07117900 0014 + CURRENTMODE:=XEQMODE; 07118000 0015 + GO TO EXECUTEIT; 07118100 0016 + END; 07118200 0016 + %----------ERRORMODE--------------------------------- 07118300 0017 + GO TO BACKAGAIN; 07118400 0017 + 07118410 0017 + END; %OF CASES 07118500 0017 + START OF SEGMENT ********** 170 + 170 IS 5 LONG, NEXT SEG 168 + END; 07118510 0017 + COMMENT GET HERE IF NOTHING TO DO; 07118600 0017 + 07118610 0017 + GO TO AROUND; 07119000 0017 + CALCULATE: 07125000 0018 + STARTSCAN; 07126000 0019 + CALCULATEDIT: 07126010 0019 + ERR:=0; %AND DON"T RESET IT IN SCAN OR IN ANALYZE 07126020 0020 + IF SCAN THEN 07126100 0020 + IF RGTPAREN THEN MESSAGEHANDLER ELSE 07126200 0021 + IF DELV THEN FUNCTIONHANDLER ELSE 07126300 0024 + BEGIN COMMENT PROCESS CALCULATOR MODE REQUEST; 07126310 0028 + MOVE(BUFFER,BUFFSIZE,OLDBUFFER); 07126320 0028 + IF NOT BOOLEAN(SUSPENSION) THEN BEGIN %INITIALIZE USER 07126321 0030 + %%% 07126322 0032 + %%% 07126323 0032 + SYMBASE:=STACKBASE:=0; 07126324 0032 + END; 07126326 0034 + PROCESS(XEQUTE); 07126330 0034 + IF CURRENTMODE=CALCMODE THEN 07126332 0035 + BACKAGAIN: BEGIN INDENT(0); TERPRINT; 07126333 0036 + IF NOT BOOLEAN(SUSPENSION) THEN 07126334 0038 + BEGIN IF CURRENTMODE NEQ ERRORMODE THEN 07126335 0039 + PROCESS(WRITEBACK); 07126336 0041 + SP[0,0]:=0;NROWS:=-1; 07126337 0042 + %%% 07126338 0045 + END; 07126340 0045 + CURRENTMODE:=CALCMODE; 07126341 0045 + END; 07126342 0046 + END; 07126350 0046 + IF EDITOG=1 THEN 07126360 0046 + BEGIN MOVE(OLDBUFFER,BUFFSIZE,BUFFER); 07126370 0048 + RESCANLINE; EDITOG:=0; GO TO CALCULATEDIT; 07126380 0050 + END; 07126390 0053 + I:=0; 07126400 0053 + GO AROUND; 07127000 0054 + EXECUTEIT: 07128000 0055 + PROCESS(XEQUTE); %GO BACK TO PROCESS FOR AWHILE 07129000 0055 + IF CURRENTMODE=CALCMODE THEN GO TO BACKAGAIN; 07129010 0055 + I:=0; 07129100 0057 + GO AROUND; 07130000 0058 + FUNCTIONSTART: 07131000 0058 + IF SPECMODE = 0 THEN 07131010 0059 + BEGIN %SEE IF A SPECIAL FUNCTION. 07131020 0060 + STARTSCAN; 07131024 0060 + IF SCAN AND RGTPAREN THEN MESSAGEHANDLER ELSE 07131030 0061 + FUNCTIONHANDLER 07131040 0065 + END ELSE 07131050 0065 + FUNCTIONHANDLER; 07131100 0066 + I:=0; 07132000 0067 + GO AROUND 07133000 0067 + END; 07134000 0068 + 168 IS 72 LONG, NEXT SEG 2 + INTEGER PROCEDURE LENGTH(A,M);VALUE M; BOOLEAN M; ARRAY A[0]; 08007900 0290 + BEGIN 08007910 0290 + INTEGER STREAM PROCEDURE LENGT(A,M,L); VALUE M,L; 08008000 0290 + START OF SEGMENT ********** 171 + BEGIN LOCAL T; 08008010 0000 + LOCAL C,CC,TSI; LABEL LAB; 08008020 0000 + LOCAL AR; LABEL LAB2; 08008022 0000 + SI:=LOC M; SI:=SI+7; 08008030 0000 + IF SC="1" THEN 08008040 0000 + BEGIN COMMENT LOOK FOR LEFT ARROW.; 08008050 0001 + DI:=LOC AR; DS:=RESET; DS:=5SET; 08008060 0001 + SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR; 08008070 0002 + SI:=A; 08008080 0003 + T(2(32(DI:=LOC AR; IF SC=DC THEN JUMP OUT 3 TO LAB; 08008090 0003 + TALLY:=TALLY+1; 08008100 0006 + C:=TALLY; TSI:=SI; SI:=LOC C; 08008110 0007 + SI:=SI+7; IF SC="0" THEN 08008120 0007 + BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; 08008130 0008 + TALLY:=0; 08008140 0010 + END; SI:=TSI))); 08008150 0010 + L(DI:=LOC AR; IF SC=DC THEN JUMP OUT TO LAB; 08008160 0011 + TALLY:=TALLY+1; C:=TALLY; TSI:=SI; SI:=LOC C; SI:=SI+7; 08008170 0013 + IF SC="0" THEN 08008180 0015 + BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0 08008190 0015 + END; SI:=TSI); 08008200 0017 + LAB: SI:=LOC CC; DI:=LOC LENGT; DI:=DI+6; SI:=SI+7; 08008210 0018 + DS:=CHR; SI:=LOC C; SI:=SI+7; DS:=CHR; 08008220 0019 + END ELSE 08008230 0020 + BEGIN 08008240 0021 + SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR; 08008250 0021 + SI:=A; T(2(SI:=SI+32)); SI:=SI+L; 08008260 0022 + T(2(32(SI:=SI-1; IF SC NEQ " " THEN JUMP OUT 3 TO LAB2; 08008270 0024 + TALLY:=TALLY+1; C:=TALLY; TSI:=SI; SI:=LOC C; SI:=SI+7; 08008280 0028 + IF SC="0" THEN 08008290 0029 + BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0 08008300 0029 + END; SI:=TSI))); 08008310 0031 + L(SI:=SI-1; IF SC NEQ" " THEN JUMP OUT TO LAB2; 08008320 0032 + TALLY:=TALLY+1; C:=TALLY; TSI:=SI; SI:=LOC C; SI:=SI+7; 08008330 0035 + IF SC="0" THEN 08008340 0036 + BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0 08008350 0036 + END; SI:=TSI); 08008360 0038 + LAB2: GO TO LAB 08008370 0039 + END 08008380 0040 + END; 08008390 0040 + INTEGER I; 08008400 0042 + I:=LENGT(A,M,BUFFSIZE×8); 08008410 0042 + LENGTH:=IF M THEN I ELSE BUFFSIZE×8-I 08008420 0047 + END; 08008430 0049 + 171 IS 54 LONG, NEXT SEG 2 + BOOLEAN PROCEDURE LABELSCAN(L,K); VALUE K; INTEGER K; ARRAY L[0]; 08013910 0290 + BEGIN REAL T; 08013912 0290 + START OF SEGMENT ********** 172 + T:=ADDRESS; 08013914 0000 + IF SCAN AND IDENT THEN 08013916 0000 + BEGIN SETFIELD(ACCUM,1,1,0); TRANSFER(ACCUM,1,L,K×8,8); 08013918 0002 + IF NOT(LABELSCAN:=(SCAN AND COLON)) THEN 08013920 0008 + BEGIN ADDRESS:=T; EOB:=0; IF SCAN THEN; 08013922 0011 + END; 08013923 0015 + END 08013924 0015 + END; 08013926 0015 + 172 IS 19 LONG, NEXT SEG 2 + STREAM PROCEDURE MOVEWDS(A,N,B); VALUE N; 08013940 0290 + BEGIN SI:=A; DI:=B; DS:=N WDS END; 08013942 0290 + INTEGER PROCEDURE DAYTIME(B); ARRAY B[0]; 08014000 0292 + BEGIN 08014010 0292 + 08014020 0292 + INTEGER D,H,M,MIN,Q,P,Y,TIME1; 08014040 0292 + START OF SEGMENT ********** 173 + LABEL OWT; 08014050 0000 + STREAM PROCEDURE FORM(A,DAY,MO,DA,YR,HR,MIN,AP); 08014060 0000 + VALUE DAY,MO,DA,YR,HR,MIN,AP; 08014062 0000 + BEGIN DI:=A; 08014064 0000 + SI:=LOC DAY; SI:=SI+7; 08014066 0000 + IF SC="0" THEN DS:=3LIT"SUN" ELSE 08014068 0000 + IF SC="1" THEN DS:=3LIT"MON" ELSE 08014070 0002 + IF SC="2" THEN DS:=4LIT"TUES" ELSE 08014072 0003 + IF SC="3" THEN DS:=6LIT"WEDNES" ELSE 08014074 0005 + IF SC="4" THEN DS:=5LIT"THURS" ELSE 08014076 0007 + IF SC="5" THEN DS:=3LIT"FRI" ELSE DS:=5LIT"SATUR"; 08014078 0008 + DS:=4LIT"DAY "; SI:=LOC MO; DS:=2DEC; 08014080 0011 + DS:=LIT"-"; SI:=LOC DA; DS:=2DEC; DS:=LIT"-"; 08014082 0012 + SI:=LOC YR; DS:=2DEC; DS:=2LIT" "; 08014084 0014 + SI:=LOC HR; DS:=2DEC; DS:=LIT":"; SI:=LOC MIN; 08014086 0015 + SI:=SI+6; DS:=2CHR; SI:=LOC AP; SI:=SI+7; DS:=LIT" "; 08014088 0016 + DS:=CHR; DS:=LIT"M" 08014090 0017 + END; 08014092 0018 + TIME1:=TIME(1); 08014100 0018 + Y:=TIME(0); 08014110 0020 + D:=Y.[30:6]×100+Y.[36:6]×10+Y.[42:6]; 08014120 0021 + Y:=Y.[18:6]×10+Y.[24:6]; 08014130 0025 + FOR H:=31,IF Y MOD 4=0 THEN 29 ELSE 28,31,30, 08014140 0028 + 31,30,31,31,30,31,30 DO 08014150 0039 + IF D LEQ H THEN GO OWT ELSE 08014160 0053 + BEGIN D:=D-H; M:=M+1 08014170 0054 + END; 08014180 0056 + OWT: 08014190 0057 + H:=TIME1 DIV 216000; 08014200 0058 + MIN:=(TIME1 DIV 3600) MOD 60; 08014210 0059 + IF M LSS 2 THEN 08014220 0061 + BEGIN Q:=M+11; P:=Y-1 08014230 0061 + END ELSE 08014240 0063 + BEGIN Q:=M-1; P:=Y 08014250 0064 + END; 08014260 0069 + M:=M+1; 08014270 0070 + FORM(B,TIME1:=((Q×26-2)DIV 10+D+P+P.[36:10]+1)MOD 7, 08014280 0071 + M,D,Y,Q:= H MOD 12, Q:=MIN MOD 10+(MIN DIV 10)×64, 08014282 0077 + IF H GEQ 12 THEN "P" ELSE 17); 08014284 0082 + DAYTIME:=(IF TIME1=6 THEN 5 ELSE 08014286 0084 + IF TIME1=5 THEN 3 ELSE 08014288 0086 + IF TIME1=2 THEN 4 ELSE 3)+22; 08014290 0088 + 08014300 0091 + 08014310 0091 + END; 08014320 0091 + 173 IS 98 LONG, NEXT SEG 2 + PROCEDURE LOADWORKSPACE(NAME1,NAME2,IDENT); VALUE NAME1,NAME2; 08014325 0292 + REAL NAME1,NAME2; ARRAY IDENT[0]; 08014327 0292 + BEGIN 08014329 0292 + FILE DISK DISK(2,WDSPERREC,WDSPERBLK); 08014331 0292 + START OF SEGMENT ********** 174 + INTEGER PROCEDURE RD(D,N,A); 08014333 0003 + VALUE N; INTEGER N; FILE D; ARRAY A[0]; 08014335 0003 + BEGIN READ(D[N],WDSPERREC,A[*]); 08014337 0003 + RD:=N+1; 08014339 0009 + END; 08014341 0010 + PROCEDURE LOADITEM(RD,D,ITEM); 08014343 0013 + INTEGER PROCEDURE RD; FILE D; 08014345 0013 + ARRAY ITEM[0]; 08014347 0013 + BEGIN 08014349 0013 + DEFINE T=ITEM#; 08014351 0013 + START OF SEGMENT ********** 175 + PROCEDURE GETALINE(C,S,L,B,RD,D,LEN); 08014355 0000 + VALUE LEN; INTEGER C,S,L,LEN; 08014359 0000 + ARRAY B[0]; INTEGER PROCEDURE RD; FILE D; 08014363 0000 + BEGIN % GET 2 CHRS GIVING ENSUING CHAR COUNT 08014367 0000 + INTEGER P; 08014369 0000 + START OF SEGMENT ********** 176 + IF C GTR LEN-2 THEN 08014371 0000 + IF C GTR LEN-1 THEN % READ A NEW RECORD AND TAKE 2 CHRS 08014375 0001 + BEGIN 08014379 0003 + S:=RD(D,S,B); 08014383 0003 + C:=2; 08014387 0006 + TRANSFER(B,0,L,6,2); 08014391 0007 + END 08014395 0010 + ELSE % 1 CHR LEFT ON LINE 08014399 0010 + BEGIN 08014403 0010 + TRANSFER(B,C,L,6,1); 08014407 0010 + S:=RD(D,S,B); 08014411 0013 + TRANSFER(B,0,L,7,1); 08014415 0016 + C:=1; 08014419 0018 + END 08014423 0019 + ELSE % AT LEAST 2 CHARS REMAINING ON LINE 08014427 0019 + BEGIN 08014431 0019 + TRANSFER(B,C,L,6,2); 08014435 0020 + C:=C+2; 08014439 0023 + END; 08014443 0024 + P:=0; 08014447 0024 + IF L NEQ 0 THEN % SOMETHING LEFT IN FUNCTION 08014451 0025 + BEGIN 08014455 0026 + WHILE P LSS L DO 08014459 0026 + IF (L-P) GTR (LEN-C) THEN % # OF CHARS IN LINE 08014463 0027 + % EXTENDS INTO NEXT RECORD 08014467 0029 + BEGIN 08014471 0029 + TRANSFER(B,C,BUFFER,P,LEN-C); % FINISH OUT RECORD 08014475 0030 + S:=RD(D,S,B); 08014479 0033 + P:=P+(LEN-C); % AMOUNT READ SO FAR 08014483 0036 + C:=0; 08014487 0038 + END 08014491 0039 + ELSE % ALL ON ONE RECORD 08014495 0039 + BEGIN 08014499 0039 + TRANSFER(B,C,BUFFER,P,L-P); 08014503 0039 + C:=C+L-P; 08014507 0043 + P:=L; % FINISHED 08014511 0045 + END; 08014515 0045 + END; 08014519 0046 + END OF GETALINE; 08014523 0046 + 176 IS 49 LONG, NEXT SEG 175 + INTEGER S,K,L,M,C,LEN,SQ,PT,G,I,SIZE; 08014527 0000 + INTEGER HOLD; 08014529 0000 + LABEL SCALARL; 08014530 0000 + ARRAY U[0:1],B[0:WDSPERREC-1]; 08014531 0000 + BOOLEAN TOG; 08014535 0005 + TRANSFER(T,0,U,0,7); 08014539 0005 + G:=GETFIELD(T,7,1); 08014540 0008 + IF VARSIZE GTR 0 THEN 08014543 0010 + IF K:=SEARCHORD(VARIABLES,U,HOLD,7)=0 THEN 08014547 0011 + IF K:=GETFIELD(U,7,1)=FUNCTION THEN TOG:=TRUE 08014551 0015 + ELSE % NOT A FUNCTION IN THE SYMBOL TABLE 08014555 0019 + IF G=FUNCTION THEN 08014559 0020 + BEGIN 08014565 0021 + DELETE1(VARIABLES,HOLD); 08014567 0021 + IF K=ARRAYDATA THEN RELEASEARRAY(U[1]); 08014569 0023 + END 08014570 0025 + ELSE TOG:=TRUE % DON-T CHANGE 08014571 0025 + ELSE % NOT IN VARIABLES 08014575 0026 + BEGIN 08014579 0026 + VARSIZE:=VARSIZE+1; 08014583 0027 + HOLD:=HOLD+K-1; 08014587 0029 + END 08014591 0030 + ELSE VARSIZE:=1; 08014595 0030 + LEN:=(WDSPERREC-1)×8; 08014597 0032 + IF NOT TOG THEN % OK TO PUT INTO VARIABLES 08014599 0034 + IF G=FUNCTION THEN % READ A FUNCTION INTO VARIABLES 08014603 0034 + BEGIN 08014607 0036 + TRANSFER(T,0,U,0,9); % U HOLDS FUNCTION NAME, 08014619 0036 + %NUMBER OF ARGUMENTS, AND WHETHER FN RETURNS A VALUE 08014620 0039 + S:=T[1].LIBF1; % RECORD NUMBER 08014639 0039 + M:=T[1].LIBF2; % WORD WITHIN RECORD 08014643 0041 + SIZE:=T[1].LIBF3; % SIZE OF POINTERS TABLE 08014647 0042 + PT:=NEXTUNIT; 08014649 0044 + S:=RD(D,S,B); 08014650 0045 + FOR I:=0 STEP 1 UNTIL SIZE-1 DO 08014651 0047 + BEGIN 08014655 0051 + TRANSFER(B,M×8,T,0,16); 08014659 0051 + M:=M+2; 08014663 0055 + IF M GEQ WDSPERREC-1 THEN 08014667 0056 + BEGIN 08014671 0057 + S:=RD(D,S,B); 08014675 0058 + IF M GEQ WDSPERREC THEN 08014679 0060 + BEGIN 08014683 0061 + TRANSFER(B,0,T,8,8); 08014687 0061 + M:=1; 08014691 0064 + END 08014695 0065 + ELSE M:=0; 08014699 0065 + END; 08014703 0066 + STOREORD(PT,T,I); 08014707 0066 + END; % HAVE FINISHED FILLIN G POINTERS TABLE 08014711 0068 + IF VARIABLES=0 THEN BEGIN 08014712 0068 + VARIABLES:=NEXTUNIT; TOG:=TRUE; %KEEP THE UNIT OPEN 08014713 0070 + STOREORD(VARIABLES,U,HOLD); END; 08014714 0072 + SEQUENTIAL (SQ:=NEXTUNIT); 08014715 0074 + SETFIELD(U,FPTF,FFL,PT); 08014716 0076 + SETFIELD(U,FSQF,FFL,SQ); 08014717 0077 + STOREORD(VARIABLES,U,HOLD); 08014718 0079 + IF TOG THEN DELETE1(VARIABLES,HOLD+1);%REMOVE 1 EXTRA 08014719 0081 + COMMENT NOW FILL IN SEQ STORAGE; 08014720 0084 + IF M NEQ 0 THEN BEGIN 08014721 0084 + M:=C:=0; 08014723 0085 + S:=RD(D,S,B); % TEXT STARTS AT BEG. OF NEW RECORD 08014727 0086 + END; 08014731 0088 + L:=1; 08014735 0088 + 08014739 0089 + WHILE L NEQ 0 DO 08014743 0089 + BEGIN 08014747 0090 + GETALINE(C,S,L,B,RD,D,LEN); 08014751 0090 + GT1:=STORESEQ(SQ,BUFFER,L); 08014755 0093 + END 08014759 0096 + END 08014763 0096 + ELSE 08014767 0096 + IF G=ARRAYDATA THEN 08014771 0096 + IF T[1].INPTR=0 THEN % NULL VECTOR 08014772 0097 + GO SCALARL 08014773 0099 + ELSE 08014774 0099 + BEGIN 08014775 0099 + ARRAY DIMVECT[0:MAXBUFFSIZE]; 08014779 0100 + START OF SEGMENT ********** 177 + S:=T[1].INPTR; % RECORD NUMBER 08014783 0002 + M:=T[1].DIMPTR; % LOC WITHIN RECORD 08014787 0004 + C:=M×8; 08014791 0005 + SIZE:=T[1].RF; % RANK 08014795 0006 + S:=RD(D,S,B); 08014799 0008 + GETALINE(C,S,L,B,RD,D,LEN); 08014803 0010 + T[1].DIMPTR:=STORESEQ(WS,BUFFER,L); 08014807 0013 + % PUTS DIMVECT INTO WORKSPACE 08014811 0017 + GETALINE(C,S,L,B,RD,D,LEN); % # BLOCKS 08014815 0017 + SIZE:=L-1; 08014819 0020 + FOR K:=0 STEP 2 UNTIL SIZE DO 08014823 0021 + BEGIN 08014827 0023 + GETALINE(C,S,L,B,RD,D,LEN); 08014831 0023 + SETFIELD(DIMVECT,K,2,STORESEQ(WS,BUFFER,L)); 08014835 0026 + END; COMMENT THIS STORES THE VALUES OF THE 08014839 0029 + ARRAY INTO THE WORKSPACE, AND ALSO RECORDS 08014843 0031 + THE LOCATION WITHIN WS IN DIMVECT,TO BE STORED; 08014847 0031 + T[1].INPTR:=STORESEQ(WS,DIMVECT,SIZE+1); 08014851 0031 + IF VARIABLES=0 THEN VARIABLES:=NEXTUNIT; 08014853 0036 + STOREORD(VARIABLES,T,HOLD); 08014855 0039 + END 08014859 0041 + ELSE % MUST BE A SCALAR 08014863 0041 + 177 IS 44 LONG, NEXT SEG 175 + SCALARL: 08014864 0101 + BEGIN 08014865 0102 + IF VARIABLES=0 THEN VARIABLES:=NEXTUNIT; 08014866 0102 + STOREORD(VARIABLES,T,HOLD); 08014867 0105 + END 08014869 0107 + ELSE % WILL NOT REPLACE IN SYMBOL TABLE 08014871 0107 + BEGIN 08014875 0107 + FILL BUFFER[*] WITH " ","NOT REPL","ACED "; 08014879 0107 + START OF SEGMENT ********** 178 + 178 IS 3 LONG, NEXT SEG 175 + TRANSFER(T,0,BUFFER,0,7); 08014883 0109 + FORMROW(3,0,BUFFER,0,20); 08014887 0112 + END; 08014891 0114 + END LOADITEM; 08014906 0114 + 175 IS 123 LONG, NEXT SEG 174 + BOOLEAN STREAM PROCEDURE EQUAL(A,B); 08014910 0013 + BEGIN SI:=A; DI:=B; SI:=SI+2; IF 7SC=DC THEN TALLY:=1; 08014914 0013 + EQUAL:=TALLY 08014918 0014 + END; 08014922 0014 + INTEGER I,J,L,NDIR,N; 08014926 0015 + LABEL MOVEVAR,SKIP; 08014928 0015 + ARRAY T,U[0:1],D[0:WDSPERREC-1]; 08014930 0015 + FILL DISK WITH NAME1,NAME2; L:=RD(DISK,L,D); 08014933 0021 + IF D[1] NEQ JOBNUM AND D[1] NEQ 0 THEN GO SKIP; % FILE LOCKED 08014940 0027 + FOR I:=2 STEP 1 UNTIL 9 DO IF GETFIELD(D[I],1,7) NEQ 0 THEN GO SKIP; 08014941 0030 + IF NDIR:=D[0] NEQ 0 THEN 08014942 0034 + BEGIN N:=LIBSPACES+ENTIER(NDIR×2/(J:=WDSPERREC-1)); 08014944 0038 + IF(NDIR×2) MOD J NEQ 0 THEN N:=N+1; 08014945 0043 + FOR I:=1 STEP 1 UNTIL NDIR DO 08014946 0047 + BEGIN COMMENT GET FUNCTION OR VARIABLE NAME FROM LIB; 08014948 0049 + IF WDSPERREC-J LSS 3 THEN 08014950 0049 + IF WDSPERREC-J=1 THEN 08014952 0050 + BEGIN L:=RD(DISK,L,D); J:=0; GO MOVEVAR 08014954 0052 + END ELSE 08014956 0056 + BEGIN TRANSFER(D,J×8,T,0,8); L:=RD(DISK,L,D); 08014958 0056 + TRANSFER(D,0,T,8,8); J:=1 08014960 0062 + END ELSE MOVEVAR: 08014962 0065 + BEGIN TRANSFER(D,J×8,T,0,16); J:=J+2 08014964 0067 + END; 08014966 0070 + IF(IF IDENT[0]=0 THEN TRUE ELSE EQUAL(IDENT,T)) THEN 08014968 0071 + BEGIN IF IDENT[0] NEQ 0 THEN I:=NDIR+1; 08014970 0076 + LOADITEM(RD,DISK,T); 08014972 0079 + END 08014974 0083 + END; 08014976 0083 + STOREPSR; % UPDATE SINCE HAVE ADDED TO VARIABLES 08014977 0085 + END; 08014978 0086 + IF FALSE THEN SKIP: FORMWD(1,"6BADFIL"); 08014979 0086 + EOB:=1; 08014980 0088 + END OF LIBRARY LOAD; 08014990 0089 + 174 IS 96 LONG, NEXT SEG 2 + PROCEDURE PURGEWORKSPACE(WS); VALUE WS; INTEGER WS; 08015000 0292 + IF WORKSPACE NEQ 0 THEN 08015005 0292 + BEGIN 08015010 0293 + INTEGER I,J,K,V,L,G; 08015020 0294 + START OF SEGMENT ********** 179 + ARRAY T[0:1]; 08015030 0000 + J:=SIZE(V:=VARIABLES)-1; 08015040 0001 + FOR I:=0 STEP 1 UNTIL J DO 08015050 0004 + BEGIN K:=CONTENTS(V,I,T); 08015060 0005 + IF GETFIELD(T,7,1)=FUNCTION THEN 08015070 0007 + FOR L:=FPTF,FSQF DO % GET RID OF STORAGE 08015080 0009 + IF G:=GETFIELD(T,L,FFL) NEQ 0 THEN RELEASEUNIT(G); 08015090 0014 + END; 08015100 0019 + RELEASEUNIT(V); 08015110 0021 + VARIABLES:=0; VARSIZE:=0; 08015120 0022 + CURRENTMODE:=0; J:=SIZE(WS)-1; 08015122 0025 + FOR I:=1 STEP 1 UNTIL J DO DELETE1(WS,I); 08015124 0028 + STOREPSR; 08015130 0032 + END; 08015140 0032 + 179 IS 36 LONG, NEXT SEG 2 + PROCEDURE ELIMWORKSPACE(WS); VALUE WS; INTEGER WS; 08015150 0299 + BEGIN LABEL QQQ; QQQ: 08015152 0299 + START OF SEGMENT ********** 180 + IF WORKSPACE NEQ 0 THEN 08015155 0000 + BEGIN 08015205 0000 + PURGEWORKSPACE(WS); RELEASEUNIT(WS); 08015210 0001 + % 08015220 0002 + END ELSE SPOUT(8015222); 08015222 0002 + END; 08015223 0004 + 180 IS 6 LONG, NEXT SEG 2 + PROCEDURE SAVEWORKSPACE(NAME1,NAME2,LOCKFILE); 08015300 0299 + VALUE NAME1,NAME2,LOCKFILE; 08015305 0299 + REAL NAME1,NAME2,LOCKFILE; 08015310 0299 + BEGIN 08015320 0299 + SAVE FILE DISK DISK [NAREAS:SIZEAREAS] 08015330 0299 + START OF SEGMENT ********** 181 + (2,WDSPERREC,WDSPERBLK,SAVE 100); 08015340 0000 + INTEGER PROCEDURE WR(D,N,A); VALUE N; INTEGER N; 08015350 0006 + FILE D; ARRAY A[0]; 08015360 0008 + BEGIN REAL STREAM PROCEDURE CON(A); VALUE A; 08015370 0008 + START OF SEGMENT ********** 182 + BEGIN SI:=LOC A; DI:=LOC CON; DS:=8DEC END; 08015380 0000 + STREAM PROCEDURE CLEANER(A); 08015382 0001 + BEGIN DI:=A; WDSPERREC(DS:=8LIT".") END; 08015384 0001 + A[WDSPERREC-1]:=CON(N); 08015390 0004 + WRITE(D[N],WDSPERREC,A[*]); 08015400 0007 + WR:=N+1; CLEANER(A); 08015410 0012 + END; 08015420 0014 + 182 IS 18 LONG, NEXT SEG 181 + PROCEDURE PUTAWAY(C,J,WR,D,N,M,B,L); VALUE L,J; 08015430 0008 + INTEGER L,C,J,N,M; 08015435 0008 + ARRAY B[0]; INTEGER PROCEDURE WR; FILE D; 08015440 0008 + BEGIN INTEGER P,K; 08015450 0008 + START OF SEGMENT ********** 183 + IF C+2 GTR L THEN 08015460 0000 + BEGIN TRANSFER(J,6,B,C,1); N:=WR(D,N,B); C:=1; 08015470 0001 + TRANSFER(J,7,B,0,1); 08015480 0008 + END ELSE 08015490 0011 + BEGIN TRANSFER(J,6,B,C,2); C:=C+2 08015500 0011 + END; 08015510 0014 + WHILE J NEQ 0 DO 08015520 0015 + IF J GTR K:=(L-C) THEN 08015530 0017 + BEGIN TRANSFER(BUFFER,P,B,C,K); 08015540 0018 + N:=WR(D,N,B); J:=J-K; C:=0; P:=P+K 08015550 0022 + END ELSE 08015560 0027 + BEGIN TRANSFER(BUFFER,P,B,C,J); C:=C+J; J:=0 08015570 0028 + END; 08015580 0033 + IF C=L THEN 08015590 0034 + BEGIN N:=WR(D,N,B); C:=0 08015600 0035 + END; 08015606 0039 + END; 08015609 0039 + 183 IS 43 LONG, NEXT SEG 181 + 08015610 0008 + PROCEDURE MOVETWO(U,B,M,WR,L,D); 08015612 0008 + ARRAY U,B[0]; INTEGER M,L; INTEGER PROCEDURE WR; FILE D; 08015615 0008 + BEGIN 08015618 0008 + COMMENT PUTS 2 WORDS OF U IN B AND WRITES ON D IF A FULLRECORD; 08015621 0008 + TRANSFER(U,0,B,M×8,16); % CONTENTS OF U INTO B 08015624 0008 + M:=M+2; 08015627 0011 + IF M GEQ WDSPERREC-1 THEN % FULL RECORD 08015630 0013 + BEGIN 08015633 0014 + L:=WR(D,L,B); 08015636 0014 + IF M GEQ WDSPERREC THEN % 1 OVER FULL RECORD 08015639 0017 + 08015640 0018 + BEGIN 08015642 0018 + TRANSFER(U,8,B,0,8); 08015645 0018 + M:=1; 08015648 0021 + END 08015651 0022 + ELSE M:=0; 08015654 0022 + END; 08015657 0024 + END OF MOVETWO; 08015660 0024 + INTEGER H,Q,M,N,I,L,S,J,K,LINE,MAX,PT,SQ,C,LEN,W; 08015663 0024 + REAL LSD,STP; 08015666 0024 + LABEL SKIP; 08015669 0024 + ARRAY T,U[0:1],DIR,B,SEX[0:WDSPERREC]; 08015672 0024 + N:=LIBSPACES+ENTIER((S:=SIZE(VARIABLES))×2/(WDSPERREC-1)); 08015675 0029 + IF (S×2) MOD (WDSPERREC-1) NEQ 0 THEN N:=N+1; % ADJUST 08015678 0034 + LEN:=(WDSPERREC-1)×8; 08015681 0038 + FILL DISK WITH NAME1,NAME2; 08015684 0040 + DIR[0]:=S; % SIZE OF SYMBOL TABLE 08015687 0043 + IF BOOLEAN (LOCKFILE) THEN DIR[1]:=JOBNUM; 08015688 0045 + S:=S-1; 08015690 0047 + L:=WR(DISK,L,DIR); % FIRST LINE CONTAINS # OF ENTRIES IN 08015693 0048 + COMMENT SYMBOL TABLE AND LOCK INFORMATION; 08015696 0050 + FOR I:=0 STEP 1 UNTIL S DO 08015699 0050 + BEGIN 08015702 0053 + J:=CONTENTS(VARIABLES,I,T); % RETURNS VALUE OF I-TH LOC 08015705 0053 + % IN VARIABLES INTO T 08015708 0055 + IF GT2:=GETFIELD(T,7,1)=FUNCTION THEN 08015711 0055 + BEGIN 08015714 0058 + PT:=GETFIELD(T,FPTF,FFL); % FUNCTION POINTER FIELD 08015717 0059 + SQ:=GETFIELD(T,FSQF,FFL); % FUNCTION SEQUENTIAL FIELD 08015720 0061 + %PT=# OF ORDERED STORAGE UNIT CONTAINING HEADER&POINTE 08015723 0064 + %SQ=# OF SEQ STORAGE UNIT CONTAINING TEXT 08015726 0064 + MAX:=SIZE(PT); 08015729 0064 + T[1].LIBF1:=N; % RECORD # 08015732 0065 + T[1].LIBF2:=M; % LOC WITHIN RECORD 08015735 0067 + T[1].LIBF3:=MAX; % SIZE OF POINTERS TABLE; 08015738 0070 + % SAVE ENOUGH ROOM FOR THE ENTIRE POINTERS TABLE 08015740 0072 + H:=ENTIER(GT1:=(M+MAX×2)/(WDSPERREC-1)); 08015741 0072 + H:=IF GT1 NEQ H THEN H+N+1 ELSE H+N; 08015744 0077 + U[0]:=0; 08015747 0081 + J:=SEARCHORD(PT,U,LINE,8); % LOOK FOR ALL ZEROS 08015750 0082 + IF J=2 THEN GO SKIP; 08015753 0085 + FOR W:=0 STEP 1 UNTIL LINE-1 DO 08015756 0086 + %MOVE LOCALS AND LABELS INTO THE SAVE FILE 08015757 0090 + BEGIN 08015759 0090 + J:=CONTENTS(PT,W,U); 08015762 0090 + MOVETWO(U,B,M,WR,N,DISK); 08015765 0092 + END; 08015768 0100 + FOR LINE:=LINE STEP 1 UNTIL MAX-1 DO 08015771 0100 + BEGIN 08015774 0104 + 08015776 0104 + J:=CONTENTS(PT,LINE,U); 08015777 0104 + GT1:=U[1]; 08015778 0107 + U[1]:=LINE-W; 08015779 0108 + MOVETWO(U,B,M,WR,N,DISK); % POINTERS TABLE 08015780 0109 + J:=CONTENTS(SQ,GT1,BUFFER); 08015783 0116 + PUTAWAY(C,J,WR,DISK,H,Q,SEX,LEN); % TEXT 08015786 0118 + END; 08015789 0124 + PUTAWAY(C,0,WR,DISK,H,Q,SEX,LEN); 08015792 0124 + SKIP: 08015795 0130 + Q:=C DIV 8; 08015798 0131 + IF C MOD 8 NEQ 0 THEN Q:=Q+1; 08015801 0132 + IF Q=WDSPERREC-1 THEN 08015807 0135 + BEGIN 08015810 0136 + H:=WR(DISK,H,SEX); 08015813 0137 + Q:=0; 08015816 0139 + END; 08015819 0140 + IF M GTR 0 THEN N:=WR(DISK,N,B); 08015822 0140 + M:=Q; N:=H; 08015825 0144 + TRANSFER(SEX,0,B,0,C); % MOVE BACK TO B 08015828 0145 + C:=0; 08015830 0148 + END 08015831 0149 + ELSE 08015834 0149 + IF GT2=ARRAYDATA THEN 08015837 0149 + BEGIN 08015840 0150 + ARRAY DIMVECT[0:MAXBUFFSIZE]; 08015843 0151 + START OF SEGMENT ********** 184 + LSD:=T[1]; 08015846 0002 + IF H:=LSD.SPF=0 THEN % NULL VECTOR 08015849 0003 + ELSE 08015855 0005 + BEGIN 08015858 0005 + T[1].INPTR:=N; T[1].DIMPTR:=M; 08015859 0006 + C:=M×8; 08015860 0011 + J:=CONTENTS(WS,LSD.DIMPTR,BUFFER); % DIM VECT 08015861 0012 + PUTAWAY(C,J,WR,DISK,N,M,B,LEN); % STO DIM VECT 08015864 0015 + J:=CONTENTS(WS,LSD.INPTR,DIMVECT); 08015867 0021 + TRANSFER(DIMVECT,0,BUFFER,0,J); 08015868 0024 + PUTAWAY(C,J,WR,DISK,N,M,B,LEN); 08015869 0027 + J:=J-1; 08015870 0033 + FOR LINE:=0 STEP 2 UNTIL J DO 08015871 0034 + BEGIN 08015873 0036 + PT:=GETFIELD(DIMVECT,LINE,2); 08015876 0036 + STP:=CONTENTS(WS,PT,BUFFER); 08015879 0038 + PUTAWAY(C,STP,WR,DISK,N,M,B,LEN); 08015882 0040 + END; 08015885 0046 + M:=C DIV 8; IF C MOD 8 NEQ 0 THEN M:=M+1; C:=0; 08015886 0048 + IF M=WDSPERREC-1 THEN BEGIN N:=WR(DISK,N,B); 08015887 0053 + M:=0; END; 08015888 0057 + END; 08015889 0058 + END; 08015891 0058 + 184 IS 62 LONG, NEXT SEG 181 + MOVETWO(T,DIR,K,WR,L,DISK); 08015892 0152 + END; 08015894 0158 + 08015900 0160 + EOB:=1; 08015920 0160 + IF M GTR 0 THEN N:=WR(DISK,N,B); 08015922 0161 + IF K GTR 0 THEN L:=WR(DISK,L,DIR); 08015930 0165 + LOCK(DISK); 08015940 0169 + END; 08015950 0170 + 181 IS 181 LONG, NEXT SEG 2 + BOOLEAN PROCEDURE LIBNAMES(A,B); REAL A,B; 08015952 0299 + BEGIN REAL T; 08015954 0299 + START OF SEGMENT ********** 185 + A:=B:=GT1:=0; 08015956 0000 + % 08015958 0002 + % 08015959 0002 + IF SCAN AND IDENT THEN 08015960 0002 + BEGIN T←ACCUM[0]; T.[6:6]←"/"; 08015961 0003 + IF SCAN AND LOCKIT THEN GT1←1 ELSE IF IDENT THEN LIBNAMES←TRUE; 08015962 0007 + A←T; B← JOBNUM; 08015963 0015 + END 08015964 0017 + ELSE LIBNAMES← TRUE; 08015966 0017 + END; 08015992 0018 + 185 IS 22 LONG, NEXT SEG 2 + PROCEDURE MESSAGEHANDLER; 08016000 0299 + BEGIN 08016005 0299 + LABEL ERR1; 08016008 0299 + START OF SEGMENT ********** 186 + % 08016009 0000 + IF SCAN THEN IF IDENT THEN 08016010 0000 + BEGIN INTEGER I; REAL R,S; 08016011 0001 + START OF SEGMENT ********** 187 + PROCEDURE NOFILEPRESENT; 08016012 0000 + BEGIN 08016014 0000 + FILL BUFFER[*] WITH "FILE NOT"," ON DISK"; 08016016 0000 + START OF SEGMENT ********** 188 + 188 IS 2 LONG, NEXT SEG 187 + FORMROW(3,0,BUFFER,0,16); 08016018 0001 + END OF NOFILEPRESENT; 08016020 0004 + PROCEDURE PRINTID(VARS); VALUE VARS; BOOLEAN VARS; 08016022 0004 + BEGIN INTEGER I,J,K,L,M; ARRAY T[0:1]; BOOLEAN TOG; 08016024 0004 + START OF SEGMENT ********** 189 + INTEGER NUM; 08016025 0001 + J:=VARSIZE-1; M:=VARIABLES; 08016026 0001 + FOR I:=0 STEP 1 UNTIL J DO 08016028 0004 + BEGIN L:=CONTENTS(M,I,T); TOG:=GETFIELD(T,7,1) 08016030 0005 + =FUNCTION; 08016032 0008 + IF NUM:=3×REAL(TOG AND VARS)+8+NUM GTR LINESIZE 08016033 0010 + THEN BEGIN TERPRINT; NUM:=3×REAL(TOG AND VARS)+8 END; 08016034 0013 + IF VARS THEN 08016035 0017 + BEGIN FORMROW(0,1,T,0,7); L:=L+1; 08016036 0017 + IF TOG THEN FORMWD(0,"3(F) "); 08016038 0021 + END ELSE 08016040 0023 + IF TOG THEN BEGIN L:=L+1; FORMROW(0,1,T,0,7) END; 08016042 0023 + END; 08016044 0029 + IF L=0 THEN FORMWD(3,"6 NULL.") ELSE TERPRINT 08016046 0031 + END; 08016048 0036 + 189 IS 43 LONG, NEXT SEG 187 + R:=ACCUM[0]; 08016050 0004 + FOR I:=0 STEP 1 UNTIL MAXMESS DO 08016052 0006 + IF R=MESSTAB[I] THEN 08016054 0007 + BEGIN R:=I; I:=MAXMESS+1 08016060 0008 + END; 08016070 0009 + IF I=MAXMESS+2 THEN 08016080 0012 + CASE R OF 08016090 0014 + BEGIN 08016100 0014 + % ------- SAVE ------- 08016110 0015 + IF NOT LIBNAMES(R,S) THEN 08016120 0015 + IF NOT LIBRARIAN(R,S) THEN BEGIN 08016125 0016 + SAVEWORKSPACE(R,S,GT1); %GT1 SET IN LIBNAMES 08016130 0018 + GTA[0]←GTA[1]←0;TRANSFER(R,1,GTA,1,7); 08016131 0020 + IF(GT1←SEARCHORD(LIBRARY,GTA, I ,7)) NEQ 0 THEN 08016132 0025 + BEGIN GTA[0]←GTA[1]←0;TRANSFER(R,1,GTA,1,7); 08016133 0028 + STOREORD(LIBRARY,GTA,I+(IF GT1=1 THEN -1 ELSE 1)); 08016134 0033 + END; LIBSIZE←LIBSIZE+1; 08016135 0037 + END 08016138 0039 + ELSE 08016140 0039 + BEGIN 08016150 0039 + FILL BUFFER[*] WITH "FILE ALR","EADY ON ", 08016160 0039 + START OF SEGMENT ********** 190 + "DISK "; 08016165 0041 + 190 IS 3 LONG, NEXT SEG 187 + FORMROW(3,0,BUFFER,0,20); 08016170 0041 + END 08016180 0043 + ELSE GO ERR1; 08016190 0043 + % ------- LOAD ------- 08016200 0047 + IF NOT LIBNAMES(R,S) AND R NEQ 0 THEN 08016205 0047 + IF LIBRARIAN(R,S) THEN 08016210 0049 + BEGIN ARRAY A[0:1]; 08016220 0050 + START OF SEGMENT ********** 191 + LOADWORKSPACE(R,S,A); 08016230 0002 + END 08016240 0004 + ELSE NOFILEPRESENT 08016250 0004 + 191 IS 8 LONG, NEXT SEG 187 + ELSE GO ERR1; 08016260 0052 + % ------- DROP ------- 08016300 0056 + IF CURRENTMODE=CALCMODE THEN 08016305 0056 + IF NOT LIBNAMES(R,S) THEN 08016310 0057 + IF LIBRARIAN(R,S) THEN 08016315 0059 + BEGIN FILE ELIF DISK (1,1); 08016320 0060 + START OF SEGMENT ********** 192 + FILL ELIF WITH R,S; WRITE(ELIF[0]); 08016325 0004 + CLOSE(ELIF,PURGE) 08016330 0012 + ;GTA[0]←GTA[1]←0;TRANSFER(R,1,GTA,1,7); 08016331 0013 + IF SEARCHORD(LIBRARY,GTA,I,7)=0 THEN DELETE1(LIBRARY,I); 08016332 0019 + LIBSIZE←LIBSIZE-1; 08016333 0023 + END 08016335 0024 + ELSE NOFILEPRESENT 08016340 0024 + 192 IS 28 LONG, NEXT SEG 187 + ELSE 08016360 0062 + IF NOT BOOLEAN(SUSPENSION)THEN PURGEWORKSPACE(WORKSPACE) 08016365 0063 + ELSE GO ERR1 ELSE GO ERR1; 08016370 0065 + % ------- COPY ------- 08016400 0072 + IF LIBNAMES(R,S) THEN 08016410 0072 + IF LIBRARIAN(R,S) THEN 08016415 0073 + LOADWORKSPACE(R,S,ACCUM) 08016420 0074 + ELSE NOFILEPRESENT 08016422 0075 + ELSE GO ERR1; 08016425 0077 + 08016430 0081 + % -------- VARS ------- 08016500 0081 + PRINTID(TRUE); 08016510 0081 + 08016520 0082 + %------- FNS ------- 08016600 0082 + PRINTID(FALSE); 08016610 0082 + %-------- LOGGED ---------------- 08016700 0083 + ; 08016746 0083 + %-------- MSG -------- 08016800 0083 + ERRORMESS(SYNTAXERROR,LADDRESS,0); 08016870 0083 + %-----WIDTH (INTEGER) ---------------------------- 08016900 0085 + IF NOT SCAN THEN BEGIN NUMBERCON(LINESIZE, ACCUM); 08016910 0085 + FORMROW(3,0,ACCUM,2,ACOUNT); END 08016915 0088 + ELSE IF NUMERIC AND I:=ACCUM[0] GTR 9 AND I LEQ 72 08016920 0091 + THEN BEGIN TERPRINT; LINESIZE:=I; STOREPSR; 08016925 0095 + END 08016940 0099 + %IF A NUMBER CONVERSION ERROR, RESULT WILL BE ZERO 08016945 0099 + %AND WE"LL GET AN ERROR ANYWAY 08016946 0099 + ELSE GO TO ERR1; 08016950 0099 + %-------- OPR -------- 08017000 0103 + ; 08017010 0103 + %------DIGITS (INTEGER) ------------------------ 08017100 0103 + IF NOT SCAN THEN BEGIN NUMBERCON(DIGITS,ACCUM); 08017110 0103 + FORMROW(3,0,ACCUM,2,ACOUNT); END 08017115 0106 + ELSE IF NUMERIC AND I:=ACCUM[0] GEQ 0 AND I LEQ 12 08017120 0109 + AND ERR=0 THEN BEGIN DIGITS:=I; STOREPSR END 08017125 0112 + ELSE GO TO ERR1; 08017130 0118 + %-------- OFF -------- 08017200 0121 + BEGIN 08017210 0121 + IF SCAN THEN IF ACCUM[0]="7DISCAR" THEN 08017220 0121 + ELIMWORKSPACE(WORKSPACE) ELSE 08017230 0123 + GO TO ERR1; 08017232 0124 + FILL ACCUM[*] WITH "END OF R","UN "; 08017240 0128 + START OF SEGMENT ********** 193 + 193 IS 2 LONG, NEXT SEG 187 + FORMROW(3,MARGINSIZE,ACCUM,0,10); 08017242 0130 + CURRENTMODE:=CALCMODE; 08017243 0132 + GT1:=CSTATION; 08017244 0133 + CSTATION:=GT1&0[CAPLOGGED] 08017245 0134 + ;GO TO FINIS; 08017246 0135 + END; 08017250 0138 + %--------ORIGIN----------------------------------- 08017255 0138 + IF NOT SCAN THEN BEGIN NUMBERCON(ORIGIN,ACCUM); 08017256 0138 + FORMROW(3,0,ACCUM,2,ACOUNT) END 08017257 0141 + ELSE IF NUMERIC AND ERR=0 THEN BEGIN ORIGIN:= 08017258 0144 + I:=ACCUM[0]; STOREPSR END ELSE GO TO ERR1; 08017259 0148 + %--------SEED--------------------------------- 08017260 0153 + IF NOT SCAN THEN BEGIN NUMBERCON(SEED,ACCUM); 08017262 0153 + FORMROW(3,0,ACCUM,2,ACOUNT) END 08017263 0156 + ELSE IF NUMERIC AND ERR=0 THEN BEGIN 08017265 0159 + SEED:=ABS(I:=ACCUM[0]); 08017266 0162 + STOREPSR END ELSE GO TO ERR1; 08017267 0164 + %--------FUZZ----------------------------------- 08017270 0168 + IF NOT SCAN THEN BEGIN 08017272 0168 + NUMBERCON(FUZZ,ACCUM); 08017273 0169 + FORMROW(3,0,ACCUM,2,ACOUNT) END 08017274 0171 + ELSE IF NUMERIC AND ERR=0 THEN BEGIN FUZZ:=ABS(ACCUM[0]); 08017275 0174 + STOREPSR END ELSE GO TO ERR1; 08017277 0178 + %------- SYN, NOSYN------------------------------------- 08017290 0182 + NOSYNTAX:=0; NOSYNTAX:=1; 08017292 0182 + %-----------------STORE------------------------- 08017950 0188 + IF SYMBASE NEQ 0 THEN PROCESS(WRITEBACK); 08017960 0188 + 08017962 0191 + 08017970 0191 + %-----------------ABORT------------------------ 08018000 0191 + BEGIN IF BOOLEAN(SUSPENSION) THEN 08018010 0191 + SP[0,0]:=0; NROWS:=-1; 08018012 0192 + %%% 08018020 0195 + SUSPENSION:=0; 08018022 0195 + STOREPSR 08018023 0198 + END; 08018030 0198 + %-----------------SI-------------------------------- 08018100 0199 + IF BOOLEAN(SUSPENSION) THEN 08018110 0199 + BEGIN GT1:=0; 08018120 0200 + PROCESS(LOOKATSTACK); 08018130 0201 + END ELSE FORMWD(3,"6 NULL."); 08018140 0202 + %------------------SIV------------------------------- 08018150 0204 + IF BOOLEAN(SUSPENSION) THEN 08018160 0204 + BEGIN GT1:=1; 08018170 0205 + PROCESS(LOOKATSTACK); 08018180 0206 + END ELSE FORMWD(3,"6 NULL."); 08018190 0207 + %------------------ERASE------------------------------ 08018200 0210 + IF CURRENTMODE=FUNCMODE OR BOOLEAN(SUSPENSION) THEN GO TO ERR1 08018210 0210 + ELSE WHILE SCAN AND IDENT DO 08018215 0213 + BEGIN % LOOK FOR THE IDENTIFIER NAME IN ACCUM 08018220 0219 + TRANSFER(ACCUM,2,GTA,0,7); 08018225 0219 + IF (IF VARIABLES=0 THEN FALSE ELSE 08018230 0222 + SEARCHORD(VARIABLES,GTA,GT1,7)=0) THEN 08018235 0224 + BEGIN % FOUND A SYMBOL TABLE ENTRY MATCHING NAME 08018240 0227 + DELETE1(VARIABLES,GT1); % REMOVE FROM SYMBOLTABLE 08018241 0227 + IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0; 08018242 0228 + COMMENT IF NOTHING IS IN THE UNIT IT IS DELETED; 08018243 0233 + 08018245 0233 + % CHECK IF THERE IS MORE TO DELETE 08018250 0233 + IF GT1:=GETFIELD(GTA,7,1)=FUNCTION THEN 08018255 0233 + BEGIN 08018260 0236 + RELEASEUNIT(GETFIELD(GTA,FPTF,FFL)); 08018265 0236 + RELEASEUNIT(GETFIELD(GTA,FSQF,FFL)); 08018270 0239 + END 08018275 0241 + ELSE IF GT1 GTR 0 THEN % MUST BE AN ARRAY 08018300 0241 + RELEASEARRAY(GTA[1]); 08018305 0242 + END ELSE % THERE IS NO SUCH VARIABLE 08018310 0244 + ERRORMESS(LABELERROR,LADDRESS,0); 08018315 0244 + END; % OF TAKING CARE OF ERASE 08018320 0246 + %------------ ASSIGN -------------------------------- 08018330 0247 + ; 08018462 0247 + %------------ DELETE --------------------------------- 08018470 0247 + ; 08018577 0247 + %------------- LIST ------------------------------------ 08018580 0247 + ; 08018767 0247 + % -------------DEBUG -------------------------------- 08018770 0247 + IF SCAN AND IDENT THEN 08018780 0247 + IF ACCUM[0]="6POLISH" THEN POLBUG:=ABS(POLBUG-1); 08018930 0248 + 08018942 0255 + %----------------------------- FILES ---------------------- 08018965 0255 + IF LIBSIZE>1 THEN 08018970 0255 + BEGIN FOR I←1 STEP 1 UNTIL LIBSIZE-1 DO 08018975 0255 + BEGIN R←CONTENTS(LIBRARY,I ,ACCUM); 08018980 0260 + FORMROW(0,1,ACCUM,2,6); 08018985 0262 + END; TERPRINT; 08018990 0265 + END ELSE FORMWD(3,"6 NULL."); 08018995 0267 + %------------------------ END OF CASES ---------------------------- 08018999 0269 + END ELSE GO TO ERR1; 08019000 0269 + START OF SEGMENT ********** 194 + 194 IS 27 LONG, NEXT SEG 187 + IF CURRENTMODE=FUNCMODE THEN INDENT(-CURLINE); 08019010 0273 + END ELSE 08019020 0276 + 187 IS 277 LONG, NEXT SEG 186 + IF QUOTE THEN EDITLINE ELSE 08019100 0003 + ERR1: ERRORMESS(SYNTAXERROR,0,0); 08019200 0006 + INDENT(0); 08019210 0008 + TERPRINT; 08019300 0009 + END; 08019400 0009 + 186 IS 15 LONG, NEXT SEG 2 + REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R; 08030000 0299 + BEGIN 08030010 0299 + REAL STREAM PROCEDURE CON(R); VALUE R; 08030020 0299 + START OF SEGMENT ********** 195 + BEGIN SI:=LOC R; DI:=LOC CON; DS:=8DEC 08030030 0000 + END; 08030040 0000 + LINENUMBER:=CON( ENTIER( (R+.00005)×10000)) 08030050 0001 + END; 08030060 0004 + 195 IS 12 LONG, NEXT SEG 2 + DEFINE DELIM="""#, ENDCHR="$"#; 08030080 0299 + BOOLEAN PROCEDURE WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD); 08030082 0299 + VALUE COMMAND,CHAR,WORD; INTEGER COMMAND,CHAR,WORD; 08030084 0299 + ARRAY OLD, NEW[0]; BEGIN 08030086 0299 + BOOLEAN STREAM PROCEDURE WITHINLINE(COMMAND,OLD,NEW,CHAR,WORD); 08030100 0299 + START OF SEGMENT ********** 196 + VALUE COMMAND,CHAR,WORD; 08030102 0000 + BEGIN 08030110 0000 + LOCAL OLDLINE,NEWLINE,F,BCHR; 08030120 0000 + LOCAL N,M,T; 08030130 0000 + LOCAL X,Y,Z; 08030132 0000 + LABEL LOOKING,FOUND,BETWEEN,TAIL,FINISH, 08030140 0000 + OVER; 08030150 0000 + DI:=NEW; WORD(DS:=8LIT" "); 08030160 0000 + SI:=LOC CHAR; DI:=LOC T; DI:=DI+1; DS:=7CHR; 08030162 0002 + SI:=COMMAND; 08030170 0003 + TALLY:=T; X:=TALLY; TALLY:=2; Y:=TALLY; TALLY:=32; Z:=TALLY; 08030180 0004 + TALLY:=0; 08030190 0006 + IF SC≠"←" THEN 08030200 0006 + BEGIN BCHR:=SI; SI:=OLD; OLDLINE:=SI; 08030210 0006 + DI:=NEW; NEWLINE:=DI; SI:=BCHR; 08030220 0008 + 63(IF SC=DELIM THEN JUMP OUT ELSE SI:=SI+1; TALLY 08030230 0008 + :=TALLY+1); N:=TALLY; 08030240 0010 + IF TOGGLE THEN 08030250 0011 + BEGIN 08030260 0011 + SI:=SI+1; TALLY:=0; 08030270 0011 + 63(IF SC=DELIM THEN TALLY:=0 ELSE 08030280 0012 + IF SC="←" THEN JUMP OUT ELSE TALLY:=TALLY+1; SI:=SI+1); 08030290 0013 + IF TOGGLE THEN M:=TALLY; 08030300 0016 + DI:=OLDLINE; SI:=BCHR; 08030310 0016 + 2( X( Y( Z( CI:=CI+F; 08030320 0017 + GO LOOKING; GO FOUND; GO BETWEEN; GO TAIL; GO FINISH; 08030330 0020 + LOOKING: %************ LOOKING FOR THE FIRST UNIQUE STRING************** 08030340 0022 + IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; F:=TALLY ; 08030350 0022 + DI:=NEWLINE; GO BETWEEN END ELSE 08030360 0023 + IF N SC=DC THEN BEGIN SI:=OLDLINE; SI:=SI+N; OLDLINE:=SI; 08030370 0024 + DI:=NEWLINE; SI:=BCHR; TALLY:=1; F:=TALLY; 08030380 0026 + GO FOUND END ELSE 08030382 0027 + BEGIN SI:=OLDLINE; DI:=NEWLINE; DS:=CHR; NEWLINE:=DI; 08030390 0028 + OLDLINE:=SI; SI:=BCHR; DI:=OLDLINE 08030400 0029 + END; GO OVER; 08030410 0030 + FOUND: %**************FOUND THE FIRST UNIQUE STRING ****************** 08030420 0030 + IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; 08030430 0031 + F:=TALLY; GO BETWEEN END ELSE 08030432 0032 + DS:=CHR; GO OVER; 08030440 0033 + BETWEEN: % ********** BETWEEN THE // ********************************** 08030450 0033 + IF SC=DELIM THEN BEGIN SI:=SI+1; NEWLINE:=DI; DI:=OLDLINE; 08030460 0034 + TALLY:=3; F:=TALLY; GO TAIL END ELSE 08030470 0035 + IF SC="←" THEN BEGIN TALLY:=4; F:=TALLY; 08030480 0036 + SI:=OLDLINE; GO FINISH END ELSE 08030482 0038 + DS:=CHR; GO OVER; 08030490 0039 + TAIL: % ******* THE TAIL END OF THE COMMAND *************************** 08030500 0039 + IF M SC=DC THEN BEGIN DI:=NEWLINE; SI:=OLDLINE; TALLY:=4; 08030510 0040 + F:=TALLY; GO FINISH END ELSE 08030520 0042 + BEGIN SI:=SI-M; DI:=DI-M; DI:=DI+1; OLDLINE:=DI; END; 08030530 0042 + GO OVER; 08030540 0044 + FINISH: % ********FINISH UP THE CHR MOVE FROM THE OLD TO NEW********** 08030550 0044 + DS:=CHR; OVER:))); 08030560 0045 + TALLY:=CHAR; X:=TALLY; TALLY:=1; Y:=TALLY; 08030562 0049 + Z:=TALLY); 08030564 0050 + SI:=NEW; DI:=OLD; DS:=WORD WDS; TALLY:=1; 08030570 0051 + WITHINLINE:=TALLY 08030580 0052 + END 08030590 0052 + END 08030600 0052 + END OF WITHINALINE; 08030610 0053 + WITHINALINE := WITHINLINE(COMMAND,OLD,NEW,CHAR,WORD); 08030612 0054 + END OF PHONY WITHINALINE; 08030614 0061 + 196 IS 65 LONG, NEXT SEG 2 + PROCEDURE EDITLINE; 08030621 0299 + BEGIN ARRAY T[0:MAXBUFFSIZE]; 08030622 0299 + START OF SEGMENT ********** 197 + INITBUFF(T,BUFFSIZE); 08030624 0001 + TRANSFER(OLDBUFFER,0,T,0,LENGTH(OLDBUFFER,TRUE)); 08030626 0003 + IF WITHINALINE(ADDRESS,T,OLDBUFFER,BUFFSIZE×8,BUFFSIZE) THEN 08030628 0007 + BEGIN MOVEWDS(OLDBUFFER,BUFFSIZE,BUFFER); 08030630 0010 + 08030631 0012 + IF SCAN AND RGTPAREN THEN 08030632 0012 + ERRORMESS(SYNTAXERROR,LADDRESS,0) ELSE EDITOG:=1; 08030633 0015 + END; 08030634 0020 + 08030636 0020 + 08030638 0020 + FORMROW(3,0,BUFFER,0,LENGTH(BUFFER,FALSE)); 08030640 0020 + END; 08030642 0023 + 197 IS 28 LONG, NEXT SEG 2 + PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; 08040000 0299 + BEGIN 08040100 0299 + INTEGER I,J; 08040200 0299 + START OF SEGMENT ********** 198 + I:=L×10000 MOD 10000; 08040300 0000 + FOR J:=-4 STEP 1 WHILE J LSS 0 AND I MOD 10=0 DO 08040400 0001 + I:=I/10; 08040500 0007 + INC:=10*J; 08040600 0011 + SEQ:=L; 08040700 0014 + END; 08040800 0015 + 198 IS 19 LONG, NEXT SEG 2 + PROCEDURE FUNCTIONHANDLER; 09000000 0299 + BEGIN 09001000 0299 + LABEL ENDHANDLER; 09002000 0299 + START OF SEGMENT ********** 199 + OWN BOOLEAN EDITMODE; 09003000 0000 + DEFINE FPT=FUNCPOINTER#, 09004000 0000 + FSQ=FUNCSEQ#, 09004100 0000 + SEQ=CURLINE#, 09004200 0000 + INC=INCREMENT#, 09004300 0000 + MODE=SPECMODE#, 09004310 0000 + ENDDEFINES=#; 09004400 0000 + INTEGER STREAM PROCEDURE DELPRESENT(ADDR); VALUE ADDR; 09005000 0000 + BEGIN LABEL L,FINIS; 09005100 0000 + LOCAL Q; 09005110 0000 + DI:=LOC Q; DS:=RESET; DS:=5SET; DS:=2RESET; DS:=2SET; 09005120 0000 + % LEFT-ARROW / QUESTION MARK 09005130 0001 + SI:=ADDR; 09005140 0001 + L: DI:=LOC Q; 09005150 0001 + IF SC=DELCHR THEN 09005160 0002 + BEGIN ADDR:=SI; SI:=LOC Q; DI:=ADDR; DS:=LIT" "; 09005170 0002 + TALLY:=1; DELPRESENT:=TALLY; GO TO FINIS; 09005180 0004 + END; 09005200 0005 + IF SC=DC THEN GO TO FINIS; SI:=SI-1; 09005300 0005 + IF SC=DC THEN GO TO FINIS; 09005400 0006 + GO TO L; 09005500 0007 + FINIS: 09005600 0007 + END; 09005700 0007 + INTEGER PROCEDURE OLDLABCONFLICT(PT,S); VALUE PT,S; 09006000 0009 + INTEGER PT; REAL S; 09007000 0009 + IF PT NEQ 0 THEN 09008000 0009 + BEGIN INTEGER K; ARRAY L[0:1]; 09009000 0009 + START OF SEGMENT ********** 200 + ADDRESS:=ABSOLUTEADDRESS; 09010000 0001 + WHILE LABELSCAN(L,0) AND ERR EQL 0 DO 09011000 0002 + IF SEARCHORD(PT,L,K,8)=0 THEN 09012000 0005 + IF L[1] NEQ S THEN ERR:=24; 09013000 0008 + OLDLABCONFLICT:=ERR 09014000 0011 + END; 09015000 0011 + 200 IS 16 LONG, NEXT SEG 199 + INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; INTEGER PT, 09016000 0014 + SQ,L; FORWARD; 09017000 0014 + INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; 09018000 0014 + INTEGER PT,SQ; REAL SEQ; ARRAY B[0]; FORWARD; 09019000 0014 + PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE, 09019100 0014 + ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0]; 09019200 0014 + FORWARD; COMMENT THIS IS A PHONEY DEAL, BUT I CAN"T 09019300 0014 + DECLARE CLEANBUFFER FORWARD (MOVE IT UP HERE LATER); 09019400 0014 + PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K; 09020000 0014 + INTEGER PT,SQ,I,K; 09021000 0014 + BEGIN ARRAY C,LAB[0:1],OLD,NEW[0:MAXBUFFSIZE]; 09022000 0014 + START OF SEGMENT ********** 201 + STREAM PROCEDURE BL(A); 09023000 0004 + BEGIN DI:=A; MAXBUFFSIZE(DS:=8LIT" ") END; 09024000 0004 + DEFINE MOVE=MOVEWDS#; 09025000 0007 + REAL T,SEQ; INTEGER A,B,L,M; 09026000 0007 + T:=ADDRESS; 09027000 0007 + FOR A:=I STEP 1 WHILE A LEQ K AND EDITMODE DO 09028000 0008 + BEGIN B:=CONTENTS(PT,A,C); BL(OLD); 09029000 0013 + SEQ:=C[0]; 09030000 0017 + B:=CONTENTS(SQ,C[1],OLD); 09031000 0018 + IF EDITMODE:=WITHINALINE(T,OLD,NEW,BUFFSIZE×8,BUFFSIZE) 09032000 0020 + THEN BEGIN MOVE(BUFFER,MAXBUFFSIZE+1,NEW); 09033000 0023 + MOVE(OLD,MAXBUFFSIZE,BUFFER); 09034000 0027 + IF EDITMODE:=ERR:=OLDLABCONFLICT(PT,C[0])=0 THEN 09035000 0029 + BEGIN B:=ELIMOLDLINE(PT,SQ,C[1]); 09036000 0032 + DELTOG:=DELPRESENT(ADDRESS); 09036100 0035 + DELETE1(SQ,C[1]); DELETE1(PT,A+B); C[1]:= 09037000 0039 + STORESEQ(SQ,BUFFER,LENGTH(BUFFER,FALSE)); 09038000 0042 + STOREORD(PT,C,A+B); 09039000 0045 + RESCANLINE; L:=0; M:=1; LAB[1]:=C[0]; 09040000 0048 + WHILE LABELSCAN(C,0) DO 09041000 0051 + BEGIN MOVEWDS(C,1,LAB); 09042000 0053 + IF(IF FUNCSIZE=0 THEN TRUE ELSE L:= 09043000 0055 + SEARCHORD(PT,C,M,8)NEQ 0) THEN 09044000 0057 + BEGIN B:=B+1; FUNCSIZE:=FUNCSIZE+1; 09045000 0060 + STOREORD(PT,LAB,L+M-1) 09046000 0064 + END END; 09047000 0066 + A:=A+B; K:=K+B; 09048000 0067 + COMMENT THE NEXT LINE CAUSED A SYSTEM CRASH AFTER THE EDIT 09048500 0070 + IF NOSYNTAX=0 THEN PROCESS(XEQUTE); 09049000 0070 + END END; 09050000 0070 + MOVE(NEW,MAXBUFFSIZE+1,BUFFER) 09051000 0070 + END END; 09052000 0071 + 201 IS 80 LONG, NEXT SEG 199 + PROCEDURE LISTLINE(PT,SQ,I); VALUE PT,SQ,I; INTEGER PT,SQ,I; 09052100 0014 + BEGIN 09052200 0014 + GT1:=CONTENTS(PT,I,GTA); 09052300 0014 + INDENT(GTA[0]); 09052400 0017 + GT1:=CONTENTS(SQ,GTA[1],BUFFER); 09052500 0018 + CHRCOUNT:=CHRCOUNT-1; 09052600 0020 + FORMROW(1,0,BUFFER,0,GT1); 09052700 0022 + END; 09052800 0024 + INTEGER PROCEDURE DISPLAY(A,B,PT,SQ); VALUE A,B,PT,SQ; 09053000 0024 + INTEGER PT,SQ; REAL A,B; 09054000 0024 + IF A LEQ B AND FUNCSIZE NEQ 0 THEN 09055000 0024 + BEGIN 09056000 0027 + ARRAY C[0:1]; 09057000 0027 + START OF SEGMENT ********** 202 + INTEGER I,J,K; 09058000 0001 + DEFINE CLEANBUFFER=BUFFERCLEAN#; 09058100 0001 + A:=LINENUMBER(A); B:=LINENUMBER(B); 09059000 0001 + C[0]:=A; 09060000 0004 + I:=SEARCHORD(PT,C,K,8); 09061000 0005 + I:=(IF I=2 THEN IF K LSS FUNCSIZE-1 THEN K:=K+1 ELSE 09062000 0008 + K ELSE K); 09063000 0013 + IF A NEQ B THEN 09064000 0014 + BEGIN 09065000 0015 + C[0]:=B; B:=SEARCHORD(PT,C,K,8); 09066000 0015 + END; 09067000 0019 + IF EDITMODE THEN % MAY HAVE ONLY ONE LINE TO EDIT 09068000 0019 + IF I=K THEN 09068100 0020 + IF A NEQ 0 THEN %NOT EDITING THE HEADER 09068200 0021 + EDITDRIVER(PT,SQ,I,K) 09068300 0022 + ELSE %EDITING THE FUNCTION HEADER, FIX LATER. 09068400 0024 + ERR:=31 09068500 0024 + ELSE %EDITING MORE THAN ONE LINE 09069000 0025 + BEGIN MODE:=EDITING; 09069100 0026 + IF A=0 THEN I:=I+1; 09069110 0028 + CLEANBUFFER(BUFFER,BUFFSIZE,ADDRESS); 09069112 0030 + MOVE(BUFFER,BUFFSIZE,OLDBUFFER); 09069120 0032 + LOWER:=I; UPPER:=K 09069200 0034 + END 09069300 0036 + ELSE %NOT EDITING, MUST BE A LIST 09069400 0038 + BEGIN 09070000 0038 + FORMWD(3,"1 "); 09071000 0038 + IF K=I THEN % LISTING A SINGLE LINE 09072000 0039 + BEGIN LISTLINE(PT,SQ,I); 09072100 0040 + FORMWD(3,"1 "); 09072200 0042 + END ELSE % LISTING A SET OF LINES 09072300 0043 + BEGIN MODE:=DISPLAYING; 09072400 0043 + LOWER:=I; UPPER:=K 09072500 0046 + END; 09072600 0048 + END; 09081000 0050 + EOB:=1; 09082000 0050 + END ELSE DISPLAY:=20; 09083000 0051 + 202 IS 55 LONG, NEXT SEG 199 + INTEGER PROCEDURE DELETE(A,B,PT,SQ); VALUE A,B; 09084000 0034 + INTEGER PT,SQ; REAL A,B; 09085000 0034 + IF A LEQ B AND FUNCSIZE NEQ 0 AND A NEQ 0 THEN 09086000 0034 + BEGIN 09087000 0037 + INTEGER I,J,K,L; 09088000 0037 + START OF SEGMENT ********** 203 + ARRAY C[0:1]; 09089000 0000 + A:=LINENUMBER(A); 09090000 0001 + B:=LINENUMBER(B); 09091000 0003 + C[0]:=A; 09092000 0004 + IF SEARCHORD(PT,C,K,8)=2 THEN K:=K+1; 09093000 0005 + C[0]:=B; 09094000 0009 + IF SEARCHORD(PT,C,I,8)=1 THEN I:=I-1; 09095000 0011 + IF K GTR I OR I GEQ FUNCSIZE THEN DELETE:=21 ELSE 09096000 0015 + BEGIN 09097000 0018 + FOR J:=K STEP 1 UNTIL I DO 09098000 0019 + BEGIN A:=CONTENTS(PT,J,C); 09099000 0020 + L:=ELIMOLDLINE(PT,SQ,C[1]); 09100000 0022 + FUNCSIZE:=FUNCSIZE+L; I:=I+L; K:=K+L; J:=J+L; 09101000 0024 + DELETE1(SQ,C[1]) 09102000 0030 + END; 09103000 0031 + FUNCSIZE:=FUNCSIZE-(I-K+1) 09104000 0033 + ; EOB:=1; 09105000 0035 + DELETEN(PT,K,I); 09106000 0038 + IF FUNCSIZE=0 THEN 09107000 0039 + BEGIN 09108000 0040 + PT:=0; RELEASEUNIT(SQ); SQ:=0; 09109000 0040 + STOREPSR; 09110000 0043 + END; 09111000 0044 + END; 09112000 0044 + END ELSE DELETE:=22; 09113000 0044 + 203 IS 48 LONG, NEXT SEG 199 + INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; 09114000 0044 + INTEGER PT,SQ,L; 09115000 0044 + BEGIN INTEGER K,J; 09116000 0044 + START OF SEGMENT ********** 204 + REAL AD; 09117000 0000 + ARRAY T[0:MAXBUFFSIZE],LAB[0:1]; 09118000 0000 + AD:=ADDRESS; 09119000 0003 + MOVEWDS(BUFFER,MAXBUFFSIZE+1,T); 09120000 0004 + INITBUFF(BUFFER,BUFFSIZE); 09121000 0006 + K:=CONTENTS(SQ,L,BUFFER); 09122000 0007 + RESCANLINE; 09123000 0010 + WHILE LABELSCAN(LAB,0) DO 09124000 0010 + IF SEARCHORD(PT,LAB,K,8)=0 THEN 09125000 0012 + BEGIN DELETE1(PT,K); J:=J-1 END; 09126000 0015 + ADDRESS:=AD; 09127000 0018 + MOVEWDS(T,MAXBUFFSIZE+1,BUFFER); 09128000 0019 + ELIMOLDLINE:=J 09129000 0021 + END; 09130000 0021 + 204 IS 28 LONG, NEXT SEG 199 + INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; 09131000 0044 + INTEGER PT,SQ; REAL SEQ; ARRAY B[0]; 09132000 0044 + BEGIN DEFINE BUFFER=B#; 09133000 0044 + START OF SEGMENT ********** 205 + ARRAY C,LAB[0:1]; 09134000 0000 + INTEGER I,J,K,L; 09135000 0002 + BOOLEAN TOG; 09136000 0002 + SEQ:=LINENUMBER(SEQ); 09137000 0002 + C[0]:=SEQ; 09138000 0003 + IF TOG:=(PT=0 OR FUNCSIZE=0) THEN 09139000 0004 + BEGIN SEQUENTIAL(SQ:=NEXTUNIT); I:=0 09140000 0007 + END ELSE 09141000 0009 + IF J:=SEARCHORD(PT,C,I,8)=0 THEN 09142000 0010 + BEGIN 09143000 0013 + K:=ELIMOLDLINE(PT,SQ,C[1]); 09144000 0014 + I:=I+K; FUNCSIZE:=FUNCSIZE+K; 09145000 0016 + DELETE1(PT,I); 09146000 0019 + FUNCSIZE:=FUNCSIZE-1; 09147000 0020 + DELETE1(SQ,C[1]); 09148000 0022 + END ELSE 09149000 0023 + I:=I+J-1; 09150000 0023 + RESCANLINE; 09151000 0026 + DELTOG:=DELPRESENT(ADDRESS); 09151100 0026 + K:=STORESEQ(SQ,BUFFER,LENGTH(BUFFER,TRUE)); 09152000 0030 + LAB[1]:=SEQ; L:=0; J:=1; 09153000 0034 + IF TOG THEN PT:=NEXTUNIT; 09154000 0036 + WHILE LABELSCAN(C,0) DO 09155000 0038 + BEGIN 09156000 0040 + MOVEWDS(C,1,LAB); 09157000 0040 + IF (IF FUNCSIZE=0 THEN TRUE ELSE L:= 09158000 0042 + SEARCHORD(PT,C,J,8)NEQ 0 ) THEN 09159000 0044 + BEGIN I:=I+1; FUNCSIZE:=FUNCSIZE+1; 09160000 0047 + STOREORD(PT,LAB,L+J-1); 09161000 0051 + END 09162000 0054 + END; 09163000 0054 + C[1]:=K; 09164000 0054 + C[0]:=SEQ; 09165000 0056 + FUNCSIZE:=FUNCSIZE+1; 09166000 0057 + STOREORD(PT,C,I); 09167000 0059 + IF TOG THEN STOREPSR; 09168000 0061 + EOB:=1; 09169000 0062 + END; 09170000 0063 + 205 IS 70 LONG, NEXT SEG 199 + BOOLEAN PROCEDURE BOUND(PT); VALUE PT; INTEGER PT; 09171000 0044 + IF NOT(BOUND:=NUMERIC) THEN 09172000 0044 + IF IDENT AND FUNCSIZE GTR 0 THEN 09173000 0046 + BEGIN ARRAY L[0:1]; INTEGER K; 09174000 0049 + START OF SEGMENT ********** 206 + REAL T,U; 09175000 0001 + REAL STREAM PROCEDURE CON(A); 09176000 0001 + VALUE A; 09177000 0001 + BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT 09178000 0001 + END; 09179000 0003 + TRANSFER(ACCUM,2,L,1,7); 09180000 0004 + IF BOUND:=SEARCHORD(PT,L,K,8)=0 THEN 09181000 0008 + BEGIN T:=ADDRESS; 09182000 0011 + U:=CON(MAX(L[1],0))/10000; %ARGS AND RESULT ARE NEG 09183000 0012 + IF SCAN AND PLUS OR MINUS THEN 09184000 0017 + BEGIN K:=(IF PLUS THEN 1 ELSE -1); 09185000 0022 + IF SCAN AND NUMERIC THEN 09186000 0027 + ACCUM[0]:=MAX(U+K×ACCUM[0],0) ELSE 09187000 0028 + BEGIN ACCUM[0]:=U; 09188000 0033 + ADDRESS:=T; 09189000 0037 + END; 09190000 0038 + END ELSE BEGIN ACCUM[0]:=U; ADDRESS:=T 09191000 0038 + END; 09192000 0039 + EOB:=0; 09193000 0040 + END 09194000 0041 + END; 09195000 0041 + 206 IS 45 LONG, NEXT SEG 199 + 09196000 0055 + 09197000 0055 + PROCEDURE FINISHUP; 09198000 0055 + BEGIN COMMENT GET HIM BACK TO CALCULATOR MODE; 09198100 0055 + IF FUNCPOINTER=0 THEN % HE DELETED EVERY THING 09198200 0055 + BEGIN TRANSFER(PSR,FSTART×8,GTA,0,8); 09198210 0056 + IF SEARCHORD(VARIABLES,GTA,GT1,7)=0 THEN 09198220 0060 + BEGIN DELETE1(VARIABLES,GT1); 09198230 0062 + IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0; 09198240 0064 + END ELSE SPOUT(9198260); 09198260 0068 + END; 09198270 0070 + DELTOG:=CURRENTMODE:=CURLINE:=INCREMENT:=0; 09198280 0070 + STOREPSR; 09198282 0075 + END; 09198290 0076 + 09199000 0078 + LABEL SHORTCUT; 09200000 0078 + REAL L,U,TADD; 09201000 0078 + STREAM PROCEDURE CLEANBUFFER(BUFFER,BUFFSIZE,ADDR); 09208000 0078 + VALUE BUFFSIZE,ADDR; 09209000 0078 + BEGIN LABEL L; LOCAL T,U,TSI,TDI; 09210000 0078 + SI:=ADDR; SI:=SI-1; L: 09211000 0078 + IF SC NEQ "]" THEN 09212000 0078 + BEGIN SI:=SI-1; GO TO L END; 09213000 0079 + SI:=SI+1; DI:=LOC T; SKIP 2 DB; DS:=2SET; 09214000 0080 + DI:=BUFFER; TDI:=DI; DI:=LOC T; TSI:=SI; 09215000 0081 + BUFFSIZE(8(IF TOGGLE THEN DS:=LIT" " ELSE 09216000 0082 + IF SC=DC THEN 09217000 0084 + BEGIN SI:=LOC U; DI:=TDI; DS:=LIT" " 09218000 0085 + END ELSE 09219000 0086 + BEGIN TSI:=SI; SI:=SI-1; DI:=LOC U; DS:=CHR; 09220000 0087 + DI:=TDI; SI:=LOC U; DS:=CHR; TDI:=DI; DI:=LOC T; 09221000 0088 + SI:=TSI 09222000 0089 + END)) 09223000 0089 + END; 09224000 0089 + PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE, 09224100 0090 + ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0]; 09224200 0090 + CLEANBUFFER(BUFFER,BUFFSIZE,ADDR); 09224300 0090 + COMMENT DETERMINE WHETHER OR NOT WE CAME FROM CALCULATOR MODE; 09225000 0094 + ERR:=0; 09225100 0094 + IF BOOLEAN(SUSPENSION) THEN GO TO ENDHANDLER; 09225110 0094 + BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// 09225115 0096 + START OF SEGMENT ********** 207 + IF GT1:=CURRENTMODE=CALCMODE THEN % TAKE CARE OF HEADER. 09225200 0000 + BEGIN ARRAY A[0:MAXHEADERARGS]; 09225300 0001 + START OF SEGMENT ********** 208 + LABEL HEADERSTORE,FORGETITFELLA; 09225310 0002 + IF FUNCTIONHEADER(A,TADD) THEN %HEADER OK 09225400 0002 + IF VARIABLES NEQ 0 THEN % MAY BE A RE-DEFINITION 09225500 0004 + BEGIN COMMENT GET THE FUNCTION NAME; 09225600 0005 + TRANSFER(A,1,GTA,0,7); 09225700 0006 + IF GT2:=SEARCHORD(VARIABLES,GTA,GT3,7)=0 THEN 09225800 0009 + COMMENT RE-DEFINING A FUNCTION. MAKE SURE NULL ; 09225900 0012 + IF GETFIELD(GTA,7,1)=FUNCTION AND 09226000 0012 + (A[1]+A[2]+A[3])=0 THEN %NULL HEADER--OK 09226100 0015 + %--------------------SET UP FOR CONTINUATION OF DEFINITION------ 09226200 0018 + BEGIN 09226300 0018 + FUNCPOINTER:=GETFIELD(GTA,FPTF,FFL); 09226400 0018 + FUNCSEQ:=GETFIELD(GTA,FSQF,FFL); 09226500 0021 + GT3:=CURLINE:=TOPLINE(FPT); 09226600 0024 + CHECKSEQ(CURLINE,GT3,INC); %SET THE INCREMENT 09226700 0027 + COMMENT THE CURRENTLINE IS SET TO THE LAST LINE OF THE 09226800 0028 + FUNCTION; 09226900 0028 + FUNCSIZE:=SIZE(FPT); 09226910 0028 + CURLINE:=CURLINE+INC; 09226920 0030 + DELTOG:=DELPRESENT(ADDRESS); 09226930 0033 + END ELSE 09227000 0037 + %------------------REDEFINING THE HEADER OF A DEFINED FUNCTION---- 09227100 0037 + GO TO FORGETITFELLA 09227200 0037 + ELSE 09227300 0037 + %--------------------NAME NOT FOUND IN THE DIRECTORY, SET UP 09227400 0037 + HEADERSTORE: 09227410 0037 + BEGIN COMMENT GET THE HEADER TO INSERT AT LINE 0; 09227500 0038 + ARRAY OLDBUFFER[0:MAXBUFFSIZE]; 09227510 0038 + START OF SEGMENT ********** 209 + INTEGER L,U,F,K,J; 09227520 0002 + INTEGER A1,A2; 09227522 0002 + COMMENT FUNCTIONHEADER RETURN AN ARRAY WITH THE 09227530 0002 + FOLLOWING VALUES: 09227534 0002 + A[0] = FUNCTION NAME , I.E., 0AAAAAAA 09227538 0002 + A[1] = 0 IF NO RESULT, 1 IF A RESULT IS RETURNED BY THE 09227542 0002 + FUNCTION. 09227546 0002 + A[2] = NUMBER OF ARGUMENTS TO THE FUNCTION. 09227550 0002 + A[3] = NUMBER OF LOCALS + RESULT +ARGUMENTS. 09227554 0002 + A[4],...A[N] ARE ALL OF THE LOCALS, RESULT, AND ARGUMENTS. 09227558 0002 + THE RESULT IS FIRST, THEN THE SECOND ARGUMENT, THEN 09227562 0002 + THE FIRST ARGUMENT, FOLLOWED BY THE LOCALS. ALL 09227566 0002 + ARE OF THE FORM 0XXXXXXX; 09227570 0002 + U:=(A1:=A[1])+(A2:=A[2])+3; 09227580 0002 + FOR L:=4 STEP 1 UNTIL U DO %LOOK FOR DUPLICATES AMONG 09227584 0005 + FOR K:=L+1 STEP 1 UNTIL U DO %THE RESULT/ARGUMENT SET 09227588 0007 + IF A[L]=A[K] THEN GO TO FORGETITFELLA; 09227592 0011 + SEQUENTIAL(FUNCSEQ:=NEXTUNIT); 09227600 0018 + SETFIELD(GTA,8,8,STORESEQ(FUNCSEQ,OLDBUFFER, 09227700 0020 + HEADER(TADD.[1:23],TADD.[24:24],OLDBUFFER))); 09227800 0023 + SETFIELD(GTA,0,8,0); 09227900 0026 + STOREORD(F:=FUNCPOINTER:=NEXTUNIT,GTA,0); 09228000 0028 + SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); 09228004 0031 + FOR L:=4 STEP 1 UNTIL U DO 09228006 0035 + BEGIN GTA[0]:=A[L]; IF A1 GTR 0 THEN 09228008 0036 + BEGIN A1:=0; GTA[1]:=-1; %"RESULT" SET TO -1 09228010 0038 + STOREORD(F,GTA,0); 09228012 0041 + END ELSE %LOOKING AT THE ARGUMENTS 09228014 0042 + BEGIN K:=SEARCHORD(F,GTA,J,8); 09228016 0042 + GTA[1]:=A2-4; A2:=A2-1; GTA[0]:=A[L]; 09228018 0045 + STOREORD(F,GTA,J+K-1); 09228019 0050 + END END; 09228020 0053 + FUNCSIZE:=U:=U-2; U:=A[3]-U+L; 09228022 0055 + FOR L:=L STEP 1 UNTIL U DO %GET LOCALS INTO THE LABEL TABLE 09228024 0059 + BEGIN GTA[0]:=A[L]; 09228030 0061 + IF K:=SEARCHORD(F,GTA,J,8) NEQ 0 THEN %NOT YET IN TABLE. 09228040 0062 + BEGIN GTA[0]:=A[L]; GTA[1]:=0; 09228050 0065 + STOREORD(F,GTA,J+K-1); 09228052 0068 + FUNCSIZE:=FUNCSIZE+1 09228060 0071 + END; 09228070 0072 + END; 09228080 0073 + GTA[1]:=0&ENTIER(A[1])[CRETURN]&ENTIER(A[2])[CNUMBERARGS]; 09228100 0075 + CURLINE:=INCREMENT:=1; 09228200 0081 + DELTOG:=0; 09228202 0083 + COMMENT GET THE "TYPE" OF THE FUNCTION LATER WHEN THERE 09228210 0086 + IS A PLACE FOR IT. THE TYPE IS EITHER 1 (FUNCTION CALL), OR 09228220 0086 + 0 (SUBROUTINE CALL); 09228230 0086 + END 09228300 0086 + %-------------------------------------------------------- 09228400 0086 + END ELSE % VARAIBLES=0, MAKE UP A DIRECTORY 09228500 0086 + 209 IS 91 LONG, NEXT SEG 208 + BEGIN GT3:=0; GT2:=1; GO TO HEADERSTORE 09228600 0039 + END 09228700 0041 + ELSE % HEADER SYNTAX IS BAD 09228800 0041 + GO TO ENDHANDLER; 09228900 0041 + COMMENT WE MAKE IT TO HERE IF ALL IS WELL ABOVE; 09229000 0044 + IF GT2 NEQ 0 THEN %NAME NOT FOUND IN DIRECTORY; 09229100 0044 + BEGIN 09229200 0045 + TRANSFER(A,1,GTA,0,7); %GET FUNCTION NAME 09229300 0045 + SETFIELD(GTA,7,1,FUNCTION); 09229400 0048 + SETFIELD(GTA,FPTF,FFL,FUNCPOINTER); 09229500 0050 + SETFIELD(GTA,FSQF,FFL,FUNCSEQ); 09229600 0052 + IF VARIABLES=0 THEN 09229700 0054 + VARIABLES:=NEXTUNIT; 09229800 0055 + STOREORD(VARIABLES,GTA,GT3+GT2-1); 09229900 0057 + VARSIZE:=VARSIZE+1; 09230000 0060 + END; 09230010 0062 + CURRENTMODE:=FUNCMODE; 09230100 0062 + TRANSFER(GTA,0,PSR,FSTART×8,8); 09230200 0063 + STOREPSR; 09230300 0067 + IF SCAN THEN GO TO SHORTCUT; 09230305 0067 + IF FALSE THEN 09230310 0070 + FORGETITFELLA: ERRORMESS(ERR:=LABELERROR,TADD.[1:23],0); 09230400 0071 + END ELSE % WE ARE IN FUNCTION DEFINITION MODE 09230500 0074 + 208 IS 78 LONG, NEXT SEG 207 + IF GT1:=MODE NEQ 0 THEN % A SPECIAL FUNCTION SUCH AS DISPLAY OR EDIT 09230600 0003 + BEGIN L:=LOWER; 09230700 0005 + IF GT1=DISPLAYING THEN 09230800 0007 + LISTLINE(FPT,FSQ,L) ELSE 09230900 0007 + IF GT1=EDITING THEN 09231000 0010 + BEGIN INITBUFF(BUFFER,BUFFSIZE); 09231010 0011 + MOVE(OLDBUFFER,BUFFSIZE,BUFFER); 09231020 0013 + EDITMODE:=TRUE; ADDRESS:=ABSOLUTEADDRESS; 09231030 0015 + EDITDRIVER(FPT,FSQ,L,L) 09231100 0016 + ;IF NOT EDITMODE THEN 09231102 0018 + BEGIN MODE:=0; ERR:=30 09231104 0019 + END; 09231106 0022 + END ELSE 09231108 0022 + IF GT1=RESEQUENCING THEN 09231110 0022 + IF GT1:=L LEQ UPPER THEN 09231114 0024 + BEGIN GT2:=CONTENTS(FPT,L,GTA); 09231118 0026 + GT3:=GTA[0]:=LINENUMBER(CURLINE); 09231122 0029 + DELETE1(FPT,L); 09231124 0031 + STOREORD(FPT,GTA,L); 09231126 0033 + CURLINE:=CURLINE+INCREMENT; 09231130 0035 + GT2:=CONTENTS(FSQ,GTA[1],BUFFER); RESCANLINE; 09231134 0037 + WHILE (IF ERR NEQ 0 THEN FALSE ELSE 09231138 0040 + LABELSCAN(GTA,0)) DO 09231142 0042 + IF GT1:=SEARCHORD(FPT,GTA,GT2,8)=0 THEN 09231146 0044 + BEGIN GTA[1]:=GT3; DELETE1(FPT,GT2); 09231150 0047 + STOREORD(FPT,GTA,GT2) 09231154 0050 + END ELSE ERR:=16 09231158 0052 + END 09231162 0053 + ELSE MODE:=0; 09231166 0054 + LOWER:=L+1; 09231170 0056 + IF LOWER GTR UPPER THEN 09231200 0059 + BEGIN IF MODE=DISPLAYING THEN 09231300 0060 + FORMWD(3,"1 "); 09231400 0062 + MODE:=0; 09231500 0064 + END; 09231600 0065 + GO TO ENDHANDLER 09231700 0065 + END; 09231800 0065 + END ; %OF BLOCK STARTED ON LINE 9225115 /////////////////// 09232000 0068 + 207 IS 73 LONG, NEXT SEG 199 + 09233000 0098 + 09234000 0098 + 09235000 0098 + IF ERR=0 AND EOB=0 THEN 09236000 0098 + 09237000 0100 + SHORTCUT: BEGIN LABEL RGTBRACK,DELOPTION; %/////////////////////// 09238000 0100 + START OF SEGMENT ********** 210 + IF DELV THEN FINISHUP ELSE 09239000 0000 + IF LFTBRACKET THEN 09240000 0003 + BEGIN 09241000 0005 + IF SCAN THEN 09242000 0006 + IF BOUND(FPT) THEN 09243000 0006 + BEGIN L:=ACCUM[0]; 09244000 0008 + IF SCAN THEN 09245000 0010 + IF QUADV OR EDITMODE:=(QUOTEQUAD) THEN 09246000 0010 + IF SCAN THEN 09247000 0016 + IF BOUND(FPT) THEN 09248000 0017 + BEGIN U:=ACCUM[0]; 09249000 0018 + RGTBRACK: 09250000 0020 + IF SCAN AND RGTBRACKET THEN 09251000 0021 + IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN 09252000 0023 + IF DELV THEN 09253000 0026 + BEGIN ERR:=DISPLAY(L,U,FPT,FSQ); 09254000 0029 + DELTOG:=1; 09255000 0032 + END 09256000 0034 + ELSE ERR:=1 09257000 0034 + ELSE ERR:=DISPLAY(L,U,FPT,FSQ) 09258000 0035 + ELSE ERR:=2 09259000 0038 + END 09260000 0039 + ELSE 09261000 0040 + IF RGTBRACKET THEN 09262000 0040 + IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN 09263000 0043 + IF DELV THEN 09264000 0045 + BEGIN ERR:=DISPLAY(L,L,FPT,FSQ); 09265000 0048 + DELTOG:=1; 09266000 0051 + END 09267000 0054 + ELSE ERR:=3 09268000 0054 + ELSE ERR:=DISPLAY(L,L,FPT,FSQ) 09269000 0054 + ELSE ERR:=4 09270000 0057 + ELSE ERR:=5 09271000 0059 + ELSE 09272000 0060 + IF RGTBRACKET THEN 09273000 0061 + BEGIN TADD:=ADDRESS; 09274000 0063 + IF SCAN THEN 09275000 0064 + IF IDENT AND ACCUM[0]="6DELETE" THEN 09276000 0065 + IF SCAN THEN 09277000 0067 + IF LFTBRACKET THEN 09278000 0068 + DELOPTION: 09279000 0071 + IF SCAN AND BOUND(FPT) THEN 09280000 0072 + BEGIN U:=ACCUM[0]; 09281000 0074 + IF SCAN AND RGTBRACKET THEN 09282000 0075 + IF SCAN THEN 09283000 0078 + IF DELV THEN 09284000 0079 + BEGIN ERR:=DELETE(L,U,FPT,FSQ); 09285000 0081 + FINISHUP 09286000 0085 + END 09287000 0085 + ELSE ERR:=6 09288000 0085 + ELSE ERR:=DELETE(L,U,FPT,FSQ) 09289000 0088 + ELSE ERR:=7 09290000 0090 + END 09291000 0092 + ELSE ERR:=8 09292000 0093 + ELSE 09293000 0093 + IF DELV THEN 09294000 0094 + BEGIN ERR:=DELETE(L,L,FPT,FSQ); 09295000 0097 + FINISHUP 09296000 0100 + END 09297000 0100 + ELSE ERR:=9 09298000 0101 + ELSE ERR:=DELETE(L,L,FPT,FSQ) 09299000 0101 + ELSE 09300000 0104 + IF LFTBRACKET THEN GO TO DELOPTION ELSE 09301000 0105 + BEGIN CHECKSEQ(SEQ,L,INC); 09302000 0108 + CLEANBUFFER(BUFFER,BUFFSIZE,TADD); 09303000 0110 + ADDRESS:=ABSADDR(BUFFER); ITEMCOUNT:=0; 09304000 0113 + IF SCAN THEN GO TO SHORTCUT 09305000 0116 + END 09306000 0117 + ELSE ERR:=DELETE(L,L,FPT,FSQ) 09307000 0119 + END 09308000 0121 + ELSE ERR:=10 09309000 0122 + ELSE ERR:=11 09310000 0123 + END ELSE 09311000 0124 + IF QUADV OR EDITMODE:=(QUOTEQUAD) THEN 09312000 0125 + BEGIN L:=0; U:=9999.9999; GO TO RGTBRACK 09313000 0130 + END ELSE 09314000 0133 + IF IOTA THEN 09314200 0134 + IF SCAN AND RGTBRACKET AND FPT NEQ 0 THEN 09314300 0136 + BEGIN IF SCAN THEN 09314310 0141 + IF DELV THEN DELTOG:=1 ELSE ERR:=15; 09314330 0142 + IF ERR = 0 THEN 09314340 0148 + BEGIN MODE:=RESEQUENCING; CURLINE:=INCREMENT:=1; 09314350 0149 + SETFIELD(GTA,0,8,0); 09314400 0154 + GT1:=SEARCHORD(FPT,GTA,GT2,8); 09314410 0155 + LOWER:=GT2+1; UPPER:=FUNCSIZE-1 09314420 0158 + END 09314500 0161 + END 09314600 0163 + ELSE ERR:=14 09314700 0163 + ELSE ERR:=12 09315000 0163 + ELSE ERR:=13 09316000 0165 + END 09317000 0166 + ELSE 09318000 0167 + IF CURLINE=0 THEN %CHANGING HEADER 09318100 0167 + ERR:=26 ELSE 09318110 0168 + IF ERR:=OLDLABCONFLICT(FPT,LINENUMBER(SEQ))=0 THEN 09319000 0169 + BEGIN 09320000 0173 + IF NOSYNTAX=0 THEN PROCESS(XEQUTE); 09321000 0174 + IF ERR:=STOREAWAY(FPT,FSQ,BUFFER,SEQ)=0 THEN SEQ:=SEQ+INC; 09322000 0176 + END; 09323000 0183 + IF ERR NEQ 0 THEN 09324000 0183 + BEGIN FORMWD(2,"5ERROR "); 09325000 0184 + NUMBERCON(ERR,ACCUM); ERR:=0; 09326000 0185 + EOB:=1; 09327000 0188 + FORMROW(1,1,ACCUM,2,ACCUM[0].[1:11]); 09328000 0189 + END; 09329000 0192 + END; %OF BLOCK STARTED ON LINE 9238000 ////////////////////// 09330000 0192 + 210 IS 194 LONG, NEXT SEG 199 + ENDHANDLER: 09330100 0102 + IF BOOLEAN(SUSPENSION) THEN BEGIN 09330102 0102 + FILL ACCUM[*] WITH "ABORT SU", "SP. FNS."; 09330104 0103 + START OF SEGMENT ********** 211 + 211 IS 2 LONG, NEXT SEG 199 + FORMROW(3,0,ACCUM,0,16); INDENT(0); TERPRINT; 09330106 0105 + END ELSE 09330108 0108 + IF MODE=0 THEN 09330110 0108 + BEGIN 09330112 0110 + IF BOOLEAN(DELTOG) THEN FINISHUP; 09330120 0111 + INDENT(-CURLINE); TERPRINT; 09330200 0113 + END; 09330210 0115 + 09331000 0115 + END; 09332000 0115 + 199 IS 123 LONG, NEXT SEG 2 + EXPOVR:=FAULTL; INTOVR:=FAULTL; INDEXF:=FAULTL; 09332100 0299 + FLAG:=FAULTL; ZERO:=FAULTL; 09332200 0305 + INITIALIZETABLE; 09333000 0308 + TRYAGAIN: 09334000 0309 + IF FALSE THEN %ENTERS WITH A FAULT. 09334100 0310 + FAULTL: 09334200 0310 + BEGIN SPOUT(09334300); %SEND A MESSAGE TO SPO 09334300 0311 + 09334400 0311 + BEGIN CSTATION.APLOGGED:=0; CSTATION.APLHEADING:=0 09334500 0311 + END 09334600 0313 + END; 09334700 0315 + APLMONITOR; 09335000 0315 + ENDOFJOB: 09336000 0315 + 09337000 0316 + FINIS: 09338000 0316 + WRAPUP; 09339000 0316 + 09340000 0316 + END. 09341000 0316 + 2 IS 322 LONG, NEXT SEG 1 +PRT(550) = ARCTAN INTRINSIC, SEGMENT NUMBER = 212. +PRT(552) = COS INTRINSIC, SEGMENT NUMBER = 213. +PRT(342) = EXP INTRINSIC, SEGMENT NUMBER = 214. +PRT(341) = LN INTRINSIC, SEGMENT NUMBER = 215. +PRT(551) = SIN INTRINSIC, SEGMENT NUMBER = 216. +PRT(547) = SQRT INTRINSIC, SEGMENT NUMBER = 217. +PRT(101) = OUTPUT(W) INTRINSIC, SEGMENT NUMBER = 218. +PRT(5) = BLOCK CONTROL INTRINSIC, SEGMENT NUMBER = 219. +PRT(343) = X TO THE I INTRINSIC, SEGMENT NUMBER = 220. +PRT(104) = GO TO SOLVER INTRINSIC, SEGMENT NUMBER = 221. +PRT(14) = ALGOL WRITE INTRINSIC, SEGMENT NUMBER = 222. +PRT(15) = ALGOL READ INTRINSIC, SEGMENT NUMBER = 223. +PRT(16) = ALGOL SELECT INTRINSIC, SEGMENT NUMBER = 224. +PRT(60) = FILE ATTRBUTS INTRINSIC, SEGMENT NUMBER = 225. + 1 IS 2 LONG, NEXT SEG 0 + 226 IS 69 LONG, NEXT SEG 0 +NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 462 SECONDS. + +PRT SIZE = 548; TOTAL SEGMENT SIZE = 12704 WORDS; DISK SIZE = 720 SEGS; NO. PGM. SEGS = 226 + +ESTIMATED CORE STORAGE REQUIRED = 13638 WORDS. + +ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS. + + + + + + +? LABEL 000000000LINE 00188140?COMPILE 0APL/DISK ALGOL LIBRARY ALGOL /0APL + + + + + +? + + + + + diff --git a/APL-WU-Kildall/APL-IMAGE.alg_m b/APL-WU-Kildall/APL-IMAGE.alg_m index a003b2f..8dbea3f 100644 --- a/APL-WU-Kildall/APL-IMAGE.alg_m +++ b/APL-WU-Kildall/APL-IMAGE.alg_m @@ -1,7 +1,7 @@ BEGIN 00000490 % THIS APL/B5500 PROGRAM WAS DEVELOPED BY THE COMPUTER SCIENCE GROUP 00000500 % AT THE UNIVERSITY OF WASHINGTON UNDER THE SPONSORSHIP OF PROFESSOR 00000510 -% HELLMUT GOLDE. THE PROGRAM MAY BE NOT BE OFFERED FOR SALE OR LEASE 00000520 +% HELLMUT GOLDE. THE PROGRAM MAY NOT BE OFFERED FOR SALE OR LEASE 00000520 % IN ITS ORIGINAL OR ANY MODIFIED FORM. ANY PUBLICATION RELATING TO 00000530 % THIS PROGRAM OR ANY MODIFICATION OF THE PROGRAM MUST EXPLICITLY CREDIT00000540 % THE COMPUTER SCIENCE GROUP OF THE UNIVERSITY OF WASHINGTON AND THE 00000550 @@ -16,7 +16,7 @@ BOOLEAN BREAKFLAG; 00000609 ARRAY GTA[0:1]; 00000610 LABEL FINIS; %GO THERE WHEN YOU ARE IN TROUBLE (SPOUT A MESSAGE) 00000630 BOOLEAN PROCEDURE LIBRARIAN(A,B); VALUE A,B; REAL A,B; FORWARD; 00000700 -LABEL FAULTL; % FAULT LABEL 00000800 +LABEL FAULTL; %FAULT LABEL 00000800 MONITOR EXPOVR,INTOVR,INDEX:=INDEXF,FLAG,ZERO; 00000810 REAL BIGGEST, NULLV; 00000900 INTEGER STACKSIZE,LIBSIZE; 00001000 @@ -143,7 +143,7 @@ COMMENT CHANGE LINE 3050 TO WRITE(PRINT,SF[I]) FOR MEMORY ERROR PROBS. 00002825 ("SYSTEM ERROR--IMPROPER ARGUMENTS TO FREEPAGE."), 00002860 ("SYSTEM ERROR--TOO LARGE A SUBSCRIPT FOR TYPE SPECIFIED."), 00002870 ("SYSTEM ERROR--TYPE CANNOT BE ZERO WHEN INSERTING OR DELETING."), 00002880 - ("SYSTEM ERROR--CHARACTER STTRING TOO LONG TO STORE."), 00002890 + ("SYSTEM ERROR--CHARACTER STRING TOO LONG TO STORE."), 00002890 ("SYSTEM ERROR--ATTEMPT TO INSERT NON-SEQUENTIAL ELEMENT", 00002900 "IN TYPE A STORAGE."), 00002910 ("SYSTEM ERROR--NO BLANKS IN PAGES."), 00002920 @@ -274,7 +274,7 @@ INTEGER STREAM PROCEDURE CHRSTORE(A,SKP,B,NEW,NB,SIZE,NA,MODE, 00003850 DI:=TDI; DS:=2LIT"0"; TDI:=DI; 00004120 END ELSE 00004130 IF SC="2" THEN 00004140 - COMMENT READ OUT AND ENTRY; 00004150 + COMMENT READ OUT AN ENTRY; 00004150 BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR; 00004160 TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C; 00004170 DS:=7CHR; SI:=TSI; DI:=NEW; 00004180 @@ -302,7 +302,7 @@ BOOLEAN STREAM PROCEDURE LESS(A,AN,B,BN,K); VALUE K,AN,BN; 00004410 BEGIN 00004420 SI:=A; DI:=B; SI:=SI+AN; DI:=DI+BN; 00004430 IF K SC LSS DC THEN TALLY:=1; 00004440 - LESS:=TALLY; 00004450 + LESS:=TALLY 00004450 END; 00004460 REAL STREAM PROCEDURE ADDD(A,B); VALUE A,B; 00004470 BEGIN SI:=LOC A; DI:=LOC B; DS:=8ADD; SI:=LOC B; 00004480 @@ -469,7 +469,7 @@ BOOLEAN PROCEDURE WRITEBUFFER; 00006020 INDX[NPAGES,RECSIZE+1].PAGEF:=NPAGES; 00006200 NPAGES:=NPAGES+1; 00006210 GO TO MOREPAGES; 00006220 - COMMENT - - INITIALIZE VARIABLES; 00006230 + COMMENT - - INTIALIZE VARIABLES; 00006230 EOF: POINTERSET:=TRUE; 00006240 U:=PAGESIZE-SKIP-PAGESPACE; 00006250 L:=(U-ALLOWANCE)/RECSIZE; 00006260 @@ -543,7 +543,7 @@ CASE MODE OF 00007010 BEGIN 00007020 %------- MODE=0 ------- RESERVED --------------- 00007030 ; 00007040 - %------- MODE=1 -------------------------------------------------- 00007050 + %------- MODE=1 ----------------------------------------------------00007050 IF M=0 THEN N:=TYPS[TYPE].BOOL ELSE 00007060 IF M=1 THEN 00007070 BEGIN FOR I:=1 STEP 1 UNTIL NTYPES DO 00007080 @@ -565,7 +565,7 @@ CASE MODE OF 00007010 END; 00007240 %------- MODE=4 ------- RETURN ITEM AT SUBSCRIPT N ----- 00007250 IF NR GEQ INDX[CURPAGE,0].CF THEN MESSAGE(3) ELSE 00007252 - IF BOOLEAN (TYPS[TYPE].BOOL) THEN COMMENT SEQUENTIAL STORAGE; 00007260 + IF BOOLEAN(TYPS[TYPE].BOOL) THEN COMMENT SEQUENTIAL STORAGE; 00007260 BEGIN ARRAY B[0:PAGESIZE]; 00007270 M:=CHRSTORE(POINTERS[CURBUFF](0),2,B,A,NR,0,0,2,0); 00007280 END ELSE 00007290 @@ -599,7 +599,7 @@ CASE MODE OF 00007010 IF NOT B THEN COMMENT GET A PAGE THAT IS FREE; 00007480 BEGIN 00007490 COMMENT 00007495 - IF MEMBUG.[5:1] THEN DUMPTYPES(5,1,TYPS,NTYPES); 00007500 + IF MEMBUG.[5:1] THEN DUMPTYPES(5.1,TYPS,NTYPES); 00007500 IF TYPS[0].BF=0 THEN BEGIN K:=CURPAGE; T:=1; 00007510 MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1 00007520 END 00007524 @@ -642,7 +642,7 @@ CASE MODE OF 00007010 COMMENT NOW THE CORRECT PAGE IS IN CORE. 00007760 ------------------------------ 00007770 M= NUMBER OF CHARACTERS IN A (ON INPUT) 00007780 - N= ADDRESS OF A WITHIN IN THIS TYPE (ON OUTPUT 00007790 + N= ADDRESS OF A WITHIN THIS TYPE (ON OUTPUT 00007790 ------------------------------; 00007800 K:=INDX[I,0]; 00007810 T:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,C,A,K.CF,M,0,0, 00007820 @@ -669,7 +669,7 @@ CASE MODE OF 00007010 MARK(CURPAGE); 00007970 COMMENT THE PAGE DESCRIPTOR HAS BEEN UPDATED; 00007980 COMMENT 00007985 - IF MEMBUG.[5:1] THEN DUMPTYPES(5,2,TYPS,NTYPES); 00007990 + IF MEMBUG.[5:1] THEN DUMPTYPES(5.2,TYPS,NTYPES); 00007990 END ELSE COMMENT KIND OF STORAGE IS SORTED; 00008000 IF NR GTR (T:=INDX[CURPAGE,0].CF) THEN 00008010 COMMENT SUBSCRIPT IS NOT IN THE MIDDLE OF THE PAGE; 00008020 @@ -728,7 +728,7 @@ CASE MODE OF 00007010 IF (T:=TYPS[TYPE]).AF=T.BF THEN MESSAGE(12) COMMENT 00008540 ATTEMPT TO DELETE NON-EXISTENT STORAGE; 00008550 ELSE 00008560 - IF NR GEQ(T:=INDX[CURPAGE,0].CF) THEN MESSAGE(13) COMMENT 00008570 + IF NR GEQ(I:=INDX[CURPAGE,0].CF) THEN MESSAGE(13) COMMENT 00008570 ATTEMPT TO DELETE OUTSIDE STORAGE RANGE; ELSE 00008580 IF BOOLEAN(T.BOOL) THEN COMMENT SEQUENTIAL STORAGE; 00008590 BEGIN COMMENT NR IS THE RECORD TO DELETE; 00008600 @@ -770,7 +770,7 @@ CASE MODE OF 00007010 %------- MODE=7 ------- SEARCH FOR A RECORD FROM THE FILE --- 00008930 IF N GTR 3 THEN MESSAGE(14) ELSE 00008940 COMMENT RETURN RECORD CLOSEST (BUT LESS THAN OR EQUAL TO) TO 00008950 - THE CONTENT OF -A-. A WILL BE REPLACED BY THE RECORD FOUND; 00008960 + THE CONTENTS OF -A-. A WILL BE REPLACED BY THE RECORD FOUND; 00008960 IF BOOLEAN((I:=TYPS[TYPE]).BOOL) THEN 00008970 MESSAGE(8) COMMENT BINARY SEARCH OF NON-SEQUENTIAL DATA; 00008980 ELSE 00008990 @@ -798,7 +798,7 @@ COMMENT RETURN RECORD CLOSEST (BUT LESS THAN OR EQUAL TO) TO 00008950 IF RECORD IS FOUND. RETURN RELA- 00009210 TIVE POSITION OF THE CLOSEST RECORD 00009220 IN THIS PAGE. 00009230 - N=1 " DO NO PLACE IN FILE. RETURN ABSO- 00009240 + N=1 " DO NOT PLACE IN FILE. RETURN ABSO- 00009240 LUTE SUBSCRIPT OF CLOSSEST RECORD. 00009250 N=2 " PLACE RECORD INTO FILE IF NOT FOUND. 00009260 RETURN RELATIVE POSITION OF RECORD. 00009270 @@ -896,11 +896,11 @@ COMMENT RETURN RECORD CLOSEST (BUT LESS THAN OR EQUAL TO) TO 00008950 ELSE N:=0 COMMENT LAST PAGE OF THIS TYPE; 00010190 ELSE N:=0 COMMENT LAST PAGE OF FILE; 00010200 ELSE N:=0 COMMENT PAGE CANNOT BE CHANGED; 00010210 - ELSE N:=0 COMMENT THIS PAGE IS NOT TOO SMALL; 00010220 + ELSE N:=0 COMMENT THIS PAGE IS NOT TOO SMALL; 00010220 END UNTIL I:=I+1 GTR NPAGES OR N NEQ 0 ELSE N:=0; 00010230 IF I GTR NPAGES THEN N:=REAL(WRITEBUFFER); 00010240 END OF FILE UPDATE; 00010250 - %------- MODE=10 ------EEMERGENCY FILE MAINTENANCE ------- 00010260 + %------- MODE=10 ------ EMERGENCY FILE MAINTENANCE -------- 00010260 DO MEMORY(9,TYPE,A,N,M) UNTIL N NEQ 1 00010270 %------- MODE=11 ------- SET THE KIND OF STORAGE FOR TYPE ----------00010280 ;COMMENT TYPE "TYPE" STORAGE IS BEING SET TO SEQUENTIAL; 00010290 @@ -1068,14 +1068,14 @@ DEFINE 00013000 FUNCSEQ = PSRM[4]#, 00013170 CURLINE = PSRM[5]#, 00013180 STACKBASE = PSRM[6]#, 00013182 - INCREMENT = STACKBASE#, %FUNCMODE/CALCMODE 00013183 + INCREMENT=STACKBASE#, %FUNCMODE/CALCMODE 00013183 SYMBASE = PSRM[7]#, 00013184 - FUNCSIZE = SYMBASE#, %FUNCMODE/CALCMODE 00013185 + FUNCSIZE=SYMBASE#, %FUNCMODE/CALCMODE 00013185 USERMASK = PSRM[8]#, 00013186 SEED = PSRM[10]#, 00013187 ORIGIN = PSRM[11]#, 00013188 FUZZ = PSRM[12]#, 00013189 - FSTART = 9#, %PSR[9] IS WHERE NAME OF CURRENTLY EDITED FCN GOES 00013190 + FSTART=9#, %PSR[9] IS WHERE NAME OF CURRENTLY EDITED FCN GOES 00013190 PSRSIZE = 13#, 00013200 PSR = PSRM[*]#, 00013202 WF=[18:8]#, 00013210 @@ -1101,15 +1101,15 @@ DEFINE 00013000 DDNUVW=16#, %DATA DESC NONPRES..(POINTS INTO SYM TAB FOR LOCALS) 00017136 DDPUVW=24#, % DATA DESC PRESENT UNNAMED VECTOR WORD 00017140 DDNNSW=22#, % DATA DESC NON-PRES NAMED SCALAR WORD 00017142 - PDC=10#, % DROG DESC CALC MODE 00017144 + PDC=10#, % PROG DESC CALC MODE 00017144 INTO=0#, 00017150 - DDPUSW=26#, % DATA DESC PRESENT UNNAMED SCALAR WORK (MODE) 00017152 + DDPUSW=26#, % DATA DESC PRESENT UNNAMED SCALAR WORD (MODE) 00017152 DDPUSC=27#, % DATA DESC PRESENT UNNAMED SCALAR CHR 00017154 DDPUVC=25#, % DATA DESC PRESENT UNNAMED VECTOR CHR 00017156 DDPNVC=29#, %DATA DESC PRES PERMANENT VECTOR CHAR MODE 00017157 DDPNVW=28#, %DATA DESC PRES NAMED VEC WORD (NAMED=PERMANENT) 00017158 OUTOF=1#, 00017160 - NAMEDNULLV=0&7[1:45:3]#, %DLUDGE...NAMED VERSION OF NULLV 00017161 + NAMEDNULLV=0&7[1:45:3]#, %KLUDGE...NAMED VERSION OF NULLV 00017161 BACKP=[6:18]#, 00017170 SCALARDATA=0#, 00017200 ARRAYDATA=2#, 00017202 @@ -1286,7 +1286,7 @@ DEFINE 00013000 %%% 00031096 %%% 00031098 XEQUTE=1#, 00031100 - SLICE=120#, %TIME SLICE IN 60THS OF A SECOND 00031102 + SLICE=120#, %TIME SLICE IN 60THS OF A SECOND 00031102 ALLOC=2#, 00031104 WRITEBACK=3#, 00031106 LOOKATSTACK=5#, 00031108 @@ -1318,7 +1318,7 @@ DEFINE 00013000 APLHEADING=[11:1]#, 00032231 CSTATION = STATION#, 00032232 CAPLOGGED=10:47:1#, 00032234 - CAPHEADING=11:47:1#, 00032236 + CAPLHEADING=11:47:1#, 00032236 APLCODE = STATIONPARAMS#, 00032238 00032240 00032250 @@ -1515,7 +1515,7 @@ PROCEDURE INITIALIZETABLE; 00100000 FILL IDTABLE[*] WITH 00102000 "1+481-49", "1&501%07", "1.171@19", "1#411(08", 00103000 "1)091/06", "3XEQ623L", "OG541;15", OCT0333777601040177, 00103100 - %CAST IN ABOVE LINE IS REALLY 3["]141" 00103200 + %LAST IN ABOVE LINE IS REALLY 3["]141" 00103200 "202:=042", "[]101[11", "1]123AND", "212OR223", 00103300 "NOT233LS", "S243LEQ2", "53GEQ273", "GTR283NE", "Q292=:05", 00103350 "2GO051=2", "63MAX304", "CEIL303F", "LR313MIN", 00103400 @@ -1528,10 +1528,10 @@ PROCEDURE INITIALIZETABLE; 00100000 FORMAT IS NUMBER OF CHARACTERS IN SYMBOL, FOLLOWED BY SYMBOL 00103913 ITSELF, FOLLOWED BY A TWO-DIGIT DECIMAL CODE WHICH APL USES 00103916 FOR THE RESERVED WORD--LIKE IN THE EXECUTION CASE STATEMENT AND 00103919 - IN SYNTAX CHECKING. FOR SCAN TO WORK, THE TWO-DIGIT CODE MUST 00103922 + IN SYNTAX CHECKING. FOR SCAN TO WORK, THE TW0-DIGIT CODE MUST 00103922 BE GREATER THAN 3 AND IDTABLE MUST HAVE AT LEAST ONE "0" AT THE 00103925 END TO MARK THE END. TABSIZE IS THE DEFINE (LINE 30000) GIVING 00103928 - THE SIZE OF TDTABLE; 00103931 + THE SIZE OF IDTABLE; 00103931 IF STACKSIZE=0 THEN STACKSIZE:=100 ELSE 00103940 IF STACKSIZE GTR 1022 THEN STACKSIZE:=1022; 00103950 BUFFSIZE:=MAXBUFFSIZE; 00104000 @@ -1594,7 +1594,7 @@ PROCEDURE INITIALIZETABLE; 00100000 APL CODES FOR DYADIC SCALAR OPERATORS (EXCEPT CIRCLE) AND 00106575 THEIR POSITIONS IN THE "CASE STATEMENT" IN "OPERATION". 00106577 E.G. APL CODE 7 IS "OPERATION" CODE 3 IN OCTAL (FOR DIVIDE). 00106579 - IF N-TH CHARACTER IN CORRESPONDECE IS OCTAL 11, THEN N 00106581 + IF N-TH CHARACTER IN CORRESPONDENCE IS OCTAL 11, THEN N 00106581 IS NOT AN APL CODE FOR A DYADIC SCALAR OPERATOR. CHARACTER 00106583 COUNT STARTS AT 1 FOR FIRST CHARACTER. TO MAKE IT COME OUT 00106584 RIGHT, STREAM PROCEDURE GETOP IS ACTUALLY CALLED WITH APL 00106586 @@ -2124,7 +2124,7 @@ IF BOOLEAN(T.CHRMODE) THEN %CHARACTER FORMAT 03008741 END ELSE 03008860 BEGIN COMMENT TREAT IT AS VARIABLE; 03008870 N:=T.LOCFIELD; COMMENT N HAS LOC OF DESCRIPTOR; 03008880 - N:=N-1; COMMENT BACKUP OVER THE DESCRIPTOR; 03008890 + N:=N-1; COMMENT BACK UP OVER THE DESCRIPTOR; 03008890 GTA[0]:=SP[NOC]; 03008900 FORMWD(2,"5AND : "); 03008910 FORMROW(1,1,GTA,1,7); 03008920 @@ -2359,10 +2359,10 @@ FILLER: SETFIELD(GTA,0,1,0); 03103180 OK,DYADICL,DYADICL,MONADICL,RELATIONL, % 20-24 03104469 RELATIONL, RELATIONL, RELATIONL, RELATIONL, 03104471 RELATIONL, % 25-29 03104472 - OK, OK, OK, OK, OK, %30-34 03104473 + OK, OK, OK, OK, OK, % 30-34 03104473 OK, OK, ROTL, EXPL, OK, % 35-39 03104475 - OK,OK,OK,OK,DYADICL, %40-44 03104477 - OK, OK, ERRL, OK, OK, %45-49 03104479 + OK,OK,OK,OK,DYADICL, % 40-44 03104477 + OK, OK, ERRL, OK, OK, % 45-49 03104479 OK, NOK, NOK, NOK, OK, % 50-54 03104481 SORTL,SORTL,OK,OK,OK, % 55-59 03104483 DYADICL, DYADICL, MONADICL; % 60-62 03104484 @@ -2439,8 +2439,8 @@ LFTBRACKETL: 03104910 ERR:=SYNTAXERROR; GO AROUND; END 03104984 ELSE IF J NEQ 0 THEN 03104987 BEGIN 03104990 - IF T:=INFIX[I-1].TYPEFIELD=OPERAND OR T=LOCALVAR THEN 03104995 - BEGIN DEFINE STARTSEGMENT= #; %/////////////////////////// 03105000 + IF T:=INFIX[I-1].TYPEFIELD=OPERAND OR T=LOCALVAR THEN 03104995 + BEGIN DEFINE STARTSEGMENT= #; %////////////////////////// 03105000 %LFTBRACKET PART OF SUBSCRIPTED VARIABLE 03105001 IF OPERATORS[OTOP].OPTYPE=0 THEN GO TO ERRL; 03105002 COMMENT IF ABOVE TRUE THEN THERE WAS AN OPERAND TO THE RITE;03105003 @@ -2519,7 +2519,7 @@ QUOTEQUADL: 03105202 QUADL: 03105204 COMMENT INPUT IS BEING REQUESTED; 03105205 GO TO STACKOPERAND; 03105206 -DOTL: BEGIN DEFINE STARTSEGMENT=#; %//////////////////////////// 03105207 +DOTL: BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// 03105207 IF I GTR 2 THEN 03105208 IF (T:=INFIX[I-1]).TYPEFIELD=OPERATOR AND 03105209 ANDORATOR(T,OPERATOR) THEN 03105211 @@ -2540,7 +2540,7 @@ DOTL: BEGIN DEFINE STARTSEGMENT=#; %//////////////////////////// 03105207 IF NOT VALID THEN ERR:=SYNTAXERROR; 03105237 VALID:=FALSE; 03105239 GO AROUND; END; 03105241 -SEMICOLONL: BEGIN DEFINE STARTSEGMENT=#; %////////////////////// 03105242 +SEMICOLONL: BEGIN DEFINE STARTSEGMENT=#; %///////////////////// 03105242 IF BCT NEQ 0 THEN 03105244 BEGIN 03105246 COLONCTR:=COLONCTR+1; 03105248 @@ -2567,7 +2567,7 @@ SEMICOLONL: BEGIN DEFINE STARTSEGMENT=#; %////////////////////// 03105242 GO AROUND; 03105405 END; 03105407 NOK: 03105655 - ERR:=SYNTAXERROR; 03105660 + ERR:=SYSTEMERROR; 03105660 GO AROUND; 03105661 ERRL: 03105662 ERR:=SYNTAXERROR; 03105663 @@ -2600,7 +2600,7 @@ AROUND: 03105717 ELSE ERR:=SYNTAXERROR 03105738 ELSE % MUST BE AN OPERAND, CONSTANT OR LOCAL 03105740 STACKOPERAND: 03105742 - BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// 03105744 + BEGIN DEFINE STARTSEGMENT=#; %////////////////////////// 03105744 IF ITOP=1 THEN ELSE 03105746 IF I=ITOP AND I NEQ 1 THEN 03105748 IF ANDORATOR(INFIX[I-1],OPERAND) THEN 03105750 @@ -2638,7 +2638,7 @@ STACKOPERAND: 03105742 IF SP[LOC].TYPEFIELD NEQ OPERATOR OR 03106254 T:=SP[LOC].LOCFIELD NEQ LFTARROWV 03106255 AND T NEQ QUADLFTARROW AND T NEQ GOTOV THEN 03106256 - BEGIN COMMENT ADD DIISPLAY OPERATOR TO POLISH; 03106258 + BEGIN COMMENT ADD DISPLAY OPERATOR TO POLISH; 03106258 L:=L+1; 03106260 T.TYPEFIELD:=OPERATOR; 03106262 T.OPTYPE:=MONADIC; 03106263 @@ -2656,11 +2656,11 @@ STACKOPERAND: 03105742 L:=GS(((K:=LENGTH(BUFFER, CURRENTMODE= 03106550 CALCMODE))-1) DIV 8 +2); 03106600 COMMENT L IS THE ADDRESS OF THE BUFFER; 03106650 - SP[LOC]:=K; %NUMBER OF CHARACTERS IN THE BUFFER; 03106700 + SP[LOC]:=K; %NUMBER OF CHARACTERS IN THE BUFFER 03106700 TRANSFERSP(INTO,SP,L+1,BUFFER,0,ENTIER((K+7)DIV 8)); 03106750 COMMENT WE HAVE MOVED IN THE BUFFER; 03106800 K:=L; %SAVE THE ADDRESS OF THE BUFFER; 03106850 - L:=J+1; % ONE WORD UP IN THE POLISH 03106900 + L:=J+1; % ONE WORD UP INTO THE POLISH 03106900 SP[LOC].SPF:=K; %STORE ADDRESS OF BUFFER 03106950 SP[LOC].RF:=1; % SET THE RANK TO 1 03107000 SP[LOC].DID:=DDPNVC; 03107050 @@ -2685,7 +2685,7 @@ STACKOPERAND: 03105742 SP[LOC].TYPEFIELD:=GT1:=GETFIELD(GTA,7,1); 03108120 IF GT1=FUNCTION THEN 03108140 BEGIN 03108160 - L:=L+1;SP[LOC]:=GTA[1] 03108200 + L:=L+1;SP[LOC]:=GTA[1]; 03108200 END ELSE %MUST BE AN OPERAND 03108220 BEGIN 03108240 SP[LOC].TYPEFIELD:=OPERAND; 03108260 @@ -2725,10 +2725,10 @@ STACKOPERAND: 03105742 IF NROWS:=(OLDROW:=NROWS)+K:=ENTIER(LENGTH/ 03110910 SPRSIZE+1) 03110915 GTR MAXSPROWS THEN %OFF THE END OF SP 03110920 - BEGIN COMMENT TAKE EASY WAY IOUT FOR NOW; 03110930 - GETSPACE:=-1@10; %CAUSE INVALID INDEX 03110940 + BEGIN COMMENT TAKE EASY WAY OUT FOR NOW; 03110930 + GETSPACE:=-1@10; %CAUSES INVALID INDEX 03110940 NROWS:=OLDROW; ERR:=SPERROR; 03110945 - GO TO ENDGETSPACE; 03110950 + GO TO ENDGETSPACE 03110950 END; 03110960 K:=K|SPRSIZE; 03111000 03111100 @@ -2747,10 +2747,10 @@ STACKOPERAND: 03105742 IF K LSS 0 THEN COMMENT NOT ENOUGH ROOM; 03112400 BEGIN L:=LASTAREA:=NEXTAREA; 03112500 NEXTAREA:=LINK.NEXT 03112600 - END; 03112700 + END 03112700 END UNTIL K GEQ 0; 03112800 IF K GTR 0 THEN 03112900 - BEGIN ;L:=L+LENGTH; 03113000 + BEGIN L:=L+LENGTH; 03113000 SP[LOC]:=0; 03113010 SP[LOC].LEN:=K; SP[LOC].NEXT:=LINK.NEXT; 03113100 END ELSE L:=LINK.NEXT; 03113200 @@ -2813,7 +2813,7 @@ INTEGER LASTCONSTANT; 03114620 END 03114850 03114855 END; 03114860 - OWN INTEGER OLDDATA,REALLYERROR; 03114900 + OWN INTEGER OLDDATA, REALLYERROR; 03114900 INTEGER L,N,M; 03115000 OWN REAL ST,T,U; 03115100 LABEL EXECUTION,PROCESSEXIT; 03115200 @@ -2916,7 +2916,7 @@ INTEGER LASTCONSTANT; 03114620 END; 03121454 IF T NEQ 0 THEN FORGETSPACE(D.SPF,T); 03121460 END; 03121470 - COMMENT RELEASEARRAY HAS BEEN MOVED WOUT OF PROCESS SO THAT IT 03121490 + COMMENT RELEASEARRAY HAS BEEN MOVED OUT OF PROCESS SO THAT IT 03121490 CAN BE CALLED ELSEWHERE; 03121491 REAL PROCEDURE MOVEARRAY(SPDESC); VALUE SPDESC; 03122500 REAL SPDESC; 03122550 @@ -2945,11 +2945,11 @@ INTEGER LASTCONSTANT; 03114620 TRANSFER(R,6,BUFFER,K|2,2); 03123650 K:=K+1; 03123660 END; 03123700 - T.INPTR:=STORESEQ(WS,BUFFER,K|K); 03123750 + T.INPTR:=STORESEQ(WS,BUFFER,K|2); 03123750 MOVEARRAY:=T; 03123810 END; 03123850 PROCEDURE WRITEBACK; 03124000 - COMMENT COPY CHANGED VARIABLES INTO PREMANENT STORAGE; 03124010 + COMMENT COPY CHANGED VARIABLES INTO PERMANENT STORAGE; 03124010 BEGIN 03124050 INTEGER I,J,K,L,M,NUM; 03124100 REAL T; 03124110 @@ -2992,7 +2992,7 @@ INTEGER LASTCONSTANT; 03114620 IF BOOLEAN(T.SCALAR) THEN 03125250 BEGIN M:=T.SPF; 03125300 NEWDESC[1]:=SP[MOC]; 03125350 - END ELSE %A VECTEOR 03125360 + END ELSE %A VECTOR 03125360 BEGIN T.PRESENCE:=0; 03125370 NEWDESC[1]:=(IF T.RF NEQ 0 THEN 03125372 MOVEARRAY(T) ELSE T) 03125374 @@ -3055,8 +3055,8 @@ PROCEDURE RESTORELOCALS(FPTR);VALUE FPTR;REAL FPTR; 03133000 LABEL BUMPLINE; 03140052 LABEL TRYNEXT; 03140054 REAL STREAM PROCEDURE CON(A); VALUE A; 03140060 - BEGIN SI:=LOC A; DI:=LOC CON; DS:=8DEC; 03140070 - END; 03140080 + BEGIN SI:= LOC A; DI:=LOC CON; DS:=8DEC; 03140070 + END; 03140080 INTEGER C; 03140081 REAL N,T,L,TLAST,M,BASE; 03140090 COMMENT 03140091 @@ -3064,13 +3064,13 @@ PROCEDURE RESTORELOCALS(FPTR);VALUE FPTR;REAL FPTR; 03133000 TLAST,M,BASE); 03140094 L:=FUNCLOC;M:=SP[LOC].SPF+L; 03140100 IF BOOLEAN(SP[MOC].SUSPENDED) THEN 03140105 - BEGIN %RESUME A SUSPENDED FUNCTI+ON 03140110 + BEGIN %RESUME A SUSPENDED FUNCTION 03140110 SP[MOC].SUSPENDED:=0;%REMOVE SUSPENDED BIT 03140115 RESTORELOCALS(SP[MOC]); 03140118 SP[LOC].RF:=N:=SP[LOC].RF-1; 03140120 IF N LEQ 0 THEN SUSPENSION:=0;% NO MORE SUSPENDED FNS 03140124 END; 03140126 - IF LABELED THEN %MAKE INITIAL CHECKS AND CHANGES; 03140130 + IF LABELED THEN %MAKE INTIAL CHECKS AND CHANGES; 03140130 BEGIN 03140140 IF NOT BOOLEAN((T:=AREG).PRESENCE) OR L:=T.SPF=0 03140150 THEN 03140160 @@ -3092,7 +3092,7 @@ PROCEDURE RESTORELOCALS(FPTR);VALUE FPTR;REAL FPTR; 03133000 IF ERR NEQ 0 THEN GO TO DONE; 03140224 M:=BASE:=SP[MOC].SPF;%LOC OF LABEL TABLE 03140230 TRYNEXT: 03140238 - N:=SP[MOC]+M+1; % N IS ONE BUIGGER THAN TOP 03140240 + N:=SP[MOC]+M+1; % N IS ONE BIGGER THAN TOP 03140240 M:=M+2; M:=SP[MOC]+2; % M IS ON THE FIRST POINTER 03140250 IF LABELED THEN %BINARY SEARCH FOR THE DESIRED LINE 03140260 BEGIN 03140270 @@ -3102,7 +3102,7 @@ TRYNEXT: 03140238 BEGIN L:=M+ENTIER((N-M)DIV 4)|2; C:=C+1; 03140320 IF T LSS SP[LOC] THEN N:=L ELSE M:=L 03140330 END; 03140340 - IF C=1@8 THEN GO TO TERMINATE; 03140342 + IF C=1@8 THEN GO TERMINATE; 03140342 IF SP[MOC] NEQ T THEN GO ENDFUNC; T:=M; 03140350 %T HAS THE SP LOCATION OF THE CORRECT LABEL 03140360 END ELSE %BUMP THE POINTER 03140370 @@ -3118,7 +3118,7 @@ TRYNEXT: 03140238 IF T:=ANALYZE(TRUE)=0 THEN % NO GOOD 03140440 GO TO DONE; 03140450 SP[MOC]:=T; %SAVE THE POLISH DESCRIPTOR AT M 03140460 - END; 03140470 + END ; 03140470 PUSH; IF ERR NEQ 0 THEN GO TO DONE; 03140480 AREG:=(L:=ENTIER(M))&1[CCIF]&TLAST[BACKPT]; 03140490 LASTMKS:=ST; 03140491 @@ -3148,7 +3148,7 @@ ENDFUNC: 03140520 BEGIN PUSH; IF ERR NEQ 0 THEN GO TO DONE; 03140660 AREG:=N; %RESULT OF CALL 03140670 END; 03140680 - L:=STACKBASE+1;L:=SP[LOC].SPF;M:=SP[LOC].SPF+L; 03140682 + L:=STACKBASE+1;L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L; 03140682 03140684 SP[MOC]:=0;SP[LOC].SPF:=(M:=M-1)-L; 03140686 COMMENT NOW INITIATE ANY OLD FUNCTIONS, AND GET POLISH 03140690 @@ -3172,7 +3172,7 @@ DONE: 03140850 03148200 PROCEDURE FIXTAKEORDROP(LDESC,RDESC,OPT,MAP,SIZEMAP,SIZE); 03148300 VALUE LDESC,RDESC,OPT; REAL LDESC,RDESC; 03148310 - INTEGER OPT, SIZE; ARRAY MAP, SIZEMAP[1]; 03148320 + INTEGER OPT, SIZE; ARRAY MAP, SIZEMAP [1]; 03148320 BEGIN INTEGER LRANK,LSIZE,L,M,RRANK,N,I,TOP,PUT; 03148330 DEFINE TAKE = OPT = 2#; 03148340 INTEGER LNUM, RNUM; LABEL QUIT; 03148350 @@ -3214,7 +3214,7 @@ PROCEDURE FIXTAKEORDROP(LDESC,RDESC,OPT,MAP,SIZEMAP,SIZE); 03148300 REAL PROCEDURE SUBSCRIPTS(DIRECTION,D,RANK); 03150000 VALUE DIRECTION,D,RANK; REAL D,RANK; INTEGER DIRECTION; 03150010 BEGIN COMMENT THIS PROCEDURE EVALUATES A SET OF SUBSCRIPTS 03150020 - ,POPS THEM OFF THE STACK, AND RESTURNS WITH A DESC. 03150030 + ,POPS THEM OFF OF THE STACK, AND RETURNS WITH A DESC. 03150030 FOR THE ITEM REFERENCED; 03150040 LABEL GOHOME,DONE; 03150050 INTEGER SIZE,I,L,M,N,VALUW; 03150060 @@ -3230,10 +3230,10 @@ PROCEDURE FIXTAKEORDROP(LDESC,RDESC,OPT,MAP,SIZEMAP,SIZE); 03148300 M:=P+M.SPF+M.RF-1;SUBINDEX:=SP[MOC]-ORIGIN;END 03150107 ELSE SUBINDEX:=(IF S=1 THEN M.SPF ELSE M.SPF+P-1); 03150108 COMMENT 03150109 - MONITOR PRINT(I,L,M,N,VALUE,ADDRESS,T,ERR,MAP,SIZEMAP, 03150110 + MONITOR PRINT(I,L,M,N,VALUW,ADDRESS,T,ERR,MAP,SIZEMAP, 03150110 SIZE,D,RANK,DIRECTION); 03150111 DCHARS:=BOOLEAN(D.CHRMODE); 03150112 - IF DIRECTION GTR 1 THEN % THIS IS A TAKE OR DROP 03150116 + IF DIRECTION GTR 1 THEN % THIS IS TAKE OR DROP 03150116 BEGIN 03150118 NOTSCAL:=1; 03150120 FIXTAKEORDROP(AREG,BREG,DIRECTION,MAP,SIZEMAP,SIZE); 03150124 @@ -3349,7 +3349,7 @@ PROCEDURE FIXTAKEORDROP(LDESC,RDESC,OPT,MAP,SIZEMAP,SIZE); 03148300 IF DIRECTION GTR 0 THEN % OUTOF..TAKE.. OR DROP 03150880 BEGIN DEFINE STARTSEGMENT=#; %////////////////////////// 03150885 IF SIZE+DIM GTR MAXWORDSTORE THEN BEGIN ERR:=KITEERROR; GO TO 03150886 - GOHOME END ELSE TEMP:=L:=GETSPACE(SIZE+DIM); %RPOOM FOR RESULT 03150887 + GOHOME END ELSE TEMP:=L:=GETSPACE(SIZE+DIM); %ROOM FOR RESULT 03150887 IF DIM GTR 0 THEN 03150888 IF DIM=1 THEN BEGIN SP[LOC]:=SIZE; L:=L+1;END 03150890 ELSE FOR I:=1 STEP 1 UNTIL RANK DO 03150895 @@ -3381,7 +3381,7 @@ PROCEDURE FIXTAKEORDROP(LDESC,RDESC,OPT,MAP,SIZEMAP,SIZE); 03148300 OLDDATA:=CHAIN(IF DCHARS THEN TEMP ELSE D,OLDDATA); 03150974 IF BOOLEAN(D.NAMED ) THEN BEGIN 03150980 N:=N-1;IF I=0 AND SP[NOC].SUSPENDVAR=0 03150990 - THEN SP[NOC].CHANGE:=1%MUST BE A REAL GLOCAL 03151000 + THEN SP[NOC].CHANGE:=1%MUST BE A REAL GLOBAL 03151000 END ELSE %IT MUST BE A LOCAL VARIABLE 03151010 AREG.NAMED:=1;%DONT LET IT BE FORGOTTEN ON POP 03151020 L:=SUBDESC.SPF+SUBDESC.RF;%POINT TO SOURCE 03151030 @@ -3462,7 +3462,7 @@ PROCEDURE DISPLAYCHARV(D); VALUE D; REAL D; 03152500 NMAT := FINDSIZE(D) DIV (J|K); 03152590 WDLINE := (LINESIZE+6) DIV 8 + 1; 03152595 IF II:=J-LINESIZE GTR 0 THEN BEGIN 03152600 - T:= II DIV (I:=LINESIZE-2)+(IF II MOD I=0 THEN 0 ELSE 1); 03152605 + T:=II DIV (I:=LINESIZE-2)+(IF II MOD I=0 THEN 0 ELSE 1); 03152605 NWORDS:=((F:=II-(T-1)|I)+6) DIV 8 + 1; 03152610 END ELSE BEGIN NWORDS:=((F:=J)+6)DIV 8 + 1; T:=0; END; 03152615 FOR II:=1 STEP 1 UNTIL NMAT DO BEGIN 03152620 @@ -3474,7 +3474,7 @@ PROCEDURE DISPLAYCHARV(D); VALUE D; REAL D; 03152500 M := M + NJ; CC := 2; END; 03152646 IF I=K AND II=NMAT THEN IF L+M DIV 8 + NWORDS GTR 03152648 (1+NROWS)|SPRSIZE THEN NWORDS:=NWORDS-1; 03152650 - %TO TAKE CARE OF BEING AT THE END OF SP 03152655 + %TO TAKE CARE OF BEING AT END OF SP 03152655 TRANSFERSP(OUTOF,SP,L+M DIV 8, BUFFER,0,NWORDS); 03152660 FORMROW(3,CC,BUFFER,ENTIER(M MOD 8), F); 03152670 M := M + F; 03152680 @@ -3585,10 +3585,10 @@ INTEGER LASTCONSTANT; 03210005 DI:=B; DS:=8LIT"0"; 03210090 SI:=ADDR; 03210100 L: 03210110 - IF SC=""" THEN % MAY BE DOUBLE QUOTE 03210120 + IF SC=""" THEN % MAY BE A DOUBLE QUOTE 03210120 BEGIN 03210130 SI:=SI+1; 03210140 - IF SC=""" THEN % GET RID OF QUOTE 03210150 + IF SC=""" THEN % GET RID OF A QUOTE 03210150 GO TO DSONE; 03210160 COMMENT ELSE WE ARE LOOKING PAST THE RH QUOTE; 03210170 GO TO FINIS; 03210180 @@ -3638,7 +3638,7 @@ INTEGER LASTCONSTANT; 03210005 END 03210520 ELSE BEGIN BUILDALPHA:=1;ADDRESS:=R END; 03210521 %ELSE WE HAVE AN ERROR (MISSING " ETC.) 03210525 - END; % OF THE BUILD ALPHA PROCEDURE; 03210530 + END; % OF THE BUILD ALPHA PROCEDURE 03210530 PROCEDURE PACK(L,OFFSET,N); VALUE L,OFFSET,N; 03210600 INTEGER L,OFFSET,N; 03210610 BEGIN 03210620 @@ -3658,7 +3658,7 @@ PROCEDURE PACK(L,OFFSET,N); VALUE L,OFFSET,N; 03210600 TRANSFERSP(OUTOF,SP,M,BUFFER,0,MB:=MIN(MB,T-M)); 03210740 PACKEM(BUFFER,ACCUM,MB); 03210750 TRANSFERSP(INTO,SP,L,ACCUM,0,S:=(MB+7)DIV 8); 03210760 - L:=L+S; M:=M+MB; 03210770 + L:=L+S; M:=M+MB 03210770 END; 03210780 FORGETSPACE(L,T-L); 03210790 QUIT: END PROCEDURE PACK; 03210800 @@ -3677,7 +3677,7 @@ INTEGER PROCEDURE UNPACK(S,OFFSET,N); VALUE N,S,OFFSET; 03210810 END; 03210920 IF N = 0 THEN BEGIN UNPACK := S; GO TO QUIT; END; 03210925 UNPACK:=L:=GETSPACE(OFFSET+N); K:=S+OFFSET-1; 03210930 - FOR M:=S STEP 1 UNTIL K DO; 03210940 + FOR M:=S STEP 1 UNTIL K DO 03210940 BEGIN SP[LOC]:=SP[MOC]; L:=L+1 03210950 END; 03210960 K:=L+N; S:=S+OFFSET; 03210970 @@ -3686,9 +3686,9 @@ INTEGER PROCEDURE UNPACK(S,OFFSET,N); VALUE N,S,OFFSET; 03210810 WHILE L LSS K DO 03210990 BEGIN 03211000 TRANSFERSP(OUTOF,SP,S,BUFFER,0,M:=MIN(MB,(K-L+7)DIV 8)); 03211010 - UNPACKEM(BUFFER,ACCUM, M:= MIN(K-L, M|8)); 03211020 + UNPACKEM(BUFFER,ACCUM, M := MIN(K-L, M|8)); 03211020 TRANSFERSP(INTO,SP,L,ACCUM,0,M); 03211030 - L := L+N; S:= S+MB; 03211040 + L := L+N; S := S+MB 03211040 END; 03211050 QUIT: END PROCEDURE UNPACK; 03211060 PROCEDURE TRANSPOSE; 03220000 @@ -3830,7 +3830,7 @@ BOOLEAN PROCEDURE OPERATION(LEFT,RIGHT,LPTR,OP,ANS); 03230000 REDUCTION TYPE PROCEDURE. 03230075 LPTR = 0 IF OPERATOR IS MONADIC. 03230080 LPTR GTR 0 IF OPERATOR IS DYADIC. 03230085 - LPTR LSS 0 IF COMES FORM REDUCTION TYPE OPERATION; 03230090 + LPTR LSS 0 IF COMES FROM REDUCTION TYPE OPERATION; 03230090 VALUE LEFT,RIGHT,LPTR,OP; 03230100 REAL LEFT,RIGHT,LPTR,OP; 03230200 REAL ANS; 03230210 @@ -3838,7 +3838,7 @@ BEGIN LABEL PUT,DOMAIN,KITE; DEFINE GIVEUP=GO TO PUT#; 03230300 DEFINE MAXEXP=158.037557167#, 03230302 MINEXP=-103.7216898#; 03230303 MONITOR INTOVR, ZERO, EXPOVR; 03230305 - OPERATION:=TRUE; 03230310 + OPERATION := TRUE; 03230310 IF LPTR LSS 0 THEN IF OP GTR 10 AND OP LSS 21 THEN 03230320 IF NOT BOOLTYPE(LEFT,RIGHT) THEN GO TO DOMAIN; 03230330 IF OP = 45 THEN IF LPTR=0 THEN OP:=22 03230340 @@ -3847,7 +3847,7 @@ BEGIN LABEL PUT,DOMAIN,KITE; DEFINE GIVEUP=GO TO PUT#; 03230300 IF OP GTR 16 AND OP LSS 21 THEN IF NOT BOOLTYPE(LEFT,RIGHT) 03230355 THEN GO TO DOMAIN; 03230357 ZERO:=DOMAIN; INTOVR:=KITE; EXPOVR:=KITE; 03230360 - CASE OP OF BEGIN 03230400 + CASE OP OP BEGIN 03230400 ANS := LEFT + RIGHT; 03230500 ANS := IF LPTR=0 THEN SIGN(RIGHT) ELSE LEFT | RIGHT; 03230600 ANS := LEFT - RIGHT; 03230700 @@ -3885,7 +3885,7 @@ BEGIN LABEL PUT,DOMAIN,KITE; DEFINE GIVEUP=GO TO PUT#; 03230300 ANS:=(IF ABS(LEFT-RIGHT) GTR FUZZ|ABS(RIGHT) THEN 1 ELSE 0); 03233000 ANS:=(IF LEFT-RIGHT LEQ FUZZ|ABS(RIGHT) THEN 1 ELSE 0); 03233100 ANS := RIGHT | LEFT; %AND 03233200 - ANS := IF RIGHT + LEFT = 0 THEN 0 ELSE 1; %OR 03233300 + ANS := IF RIGHT + LEFT = 0 THEN 0 ELSE 1; %OR 03233300 ANS := IF RIGHT | LEFT = 1 THEN 0 ELSE 1; %NAND 03233400 ANS := IF RIGHT + LEFT = 0 THEN 1 ELSE 0; %NOR 03233500 IF RIGHT LEQ 0 THEN GO TO DOMAIN ELSE IF LPTR=0 THEN 03233550 @@ -3898,7 +3898,7 @@ BEGIN LABEL PUT,DOMAIN,KITE; DEFINE GIVEUP=GO TO PUT#; 03230300 03233610 IF RIGHT LSS 1 THEN GO TO DOMAIN ELSE 03233612 ANS:=LN(RIGHT+SQRT(RIGHT|RIGHT-1)); %ARCCOSH 03233615 - ANS := LN(RIGHT + SQRT(RIGHT|RIGHT+1)); %ACRSINH 03233618 + ANS := LN(RIGHT + SQRT(RIGHT|RIGHT+1)); %ARCSINH 03233618 03233620 IF ABS(RIGHT) LSS 1 THEN GO TO DOMAIN ELSE 03233621 ANS:=SQRT(RIGHT|RIGHT-1); 03233624 @@ -3906,7 +3906,7 @@ BEGIN LABEL PUT,DOMAIN,KITE; DEFINE GIVEUP=GO TO PUT#; 03230300 IF ABS(RIGHT) GTR 1 THEN GO TO DOMAIN ELSE 03233630 IF RIGHT=0 THEN ANS:=1.5707963268 ELSE 03233631 ANS:=ARCTAN(SQRT(1-RIGHT*2)/RIGHT); %ARCCOS 03233633 - IF ABS(RIGHT) GTR 1 THEN GO TO DOMAIN ELSE 03233636 + IF ABS(RIGHT) GEQ 1 THEN GO TO DOMAIN ELSE 03233636 ANS:=ARCTAN(RIGHT/ SQRT(1-RIGHT*2)); %ARCSIN 03233639 IF ABS(RIGHT) GTR 1 THEN GO TO DOMAIN ELSE 03233642 ANS := SQRT(1-RIGHT*2); 03233645 @@ -4018,7 +4018,7 @@ BEGIN INTEGER L,M,I,N,SIZE,RANK1,RANK2,TOP, 03233765 M := M+1; END; 03238400 END; 03238450 GO TO DONE; 03238500 - DOMAIN: ERR:= DOMAINERROR; 03238550 + DOMAIN: ERR := DOMAINERROR; 03238550 DONE: RESULTD := DESC; 03238560 IF CHAR1 THEN FORGETSPACE(FORGETL,SIZE1+RANK1); 03238570 IF CHAR2 THEN FORGETSPACE(FORGETM,SIZE2+RANK2); 03238580 @@ -4043,7 +4043,7 @@ PROCEDURE DYADICRNDM; 03238700 GO TO QUIT; END; 03239100 DESC.DID := DDPUVW; DESC.RF := 1; 03239150 IF NUM LEQ 0 THEN BEGIN DESC := NULLV; GO TO QUIT; END; 03239200 - IF NUM GTR MAXWORDSTORE THEN BEGIN ERR:=KITEERROR; GO TO QUIT; END; 03239210 + IF NUM GTR MAXWORDSTORE THEN BEGIN ERR:=KITEERROR; GO TO QUIT END; 03239210 DESC.SPF := L := GETSPACE(NUM+1); 03239250 SP[LOC] := NUM; L := L+1; 03239300 OUTTOP := L+NUM-1; 03239350 @@ -4108,7 +4108,7 @@ WORK: IF SIZE1=0 THEN BEGIN NEWDESC := NULLV; GO TO QUIT END; 03239734 NEWDESC.DID:=DDPUVW; NEWDESC.RF:=NEWRANK; 03239737 NEWDESC.SPF := M := GETSPACE(SIZE1+NEWRANK); 03239738 %CANT USE SPCOPY FOR DIM VECTOR AS LEFT OP MAY NOT BE INTEGER 03239739 - FOR L:=L+RANK1 STEP 1 UNTIL TOP DO; 03239740 + FOR L:=L+RANK1 STEP 1 UNTIL TOP DO 03239740 BEGIN SP[MOC]:=ENTIER(SP[LOC]+.5); M:=M+1; END; 03239742 SIZE2:=FINDSIZE(DESC); L:=DESC.SPF; RANK:=DESC.RF; 03239743 IF DESC.ARRAYTYPE=1 THEN BEGIN L:=UNPACK(L,RANK,SIZE2); 03239744 @@ -4148,7 +4148,7 @@ PROCEDURE IOTAP; 03240750 DESC.SPF:=M:=GETSPACE(1); DESC.RF:=0; DESC.SCALAR:=1; 03240842 SP[MOC] := ORIGIN; GO TO QUIT; END; 03240845 IF LEFTOP.ARRAYTYPE=1 THEN M:=UNPACK(M,LRANK,LSIZE); 03240850 - IF RIGHTOP.ARRAYTYPE=1 THEN L:=UNPACK(L,RRANK,RSIZE); 03240855 + IF RIGHTOP.ARRAYTYPE=1 THEN L:=UNPACK(L,RRANK,RSIZE); 03240855 TIP := (NIX:=LSIZE+ORIGIN) - 1; 03240875 DESC.SPF:=N:=GETSPACE(RSIZE+RRANK); 03240880 IF RRANK=0 THEN DESC.SCALAR:=1 ; DESC.RF:=RRANK; 03240890 @@ -4165,7 +4165,7 @@ PROCEDURE IOTAP; 03240750 DONE: L:=L+1; END; 03240945 IF LEFTOP.ARRAYTYPE=1 THEN FORGETSPACE(MM-LRANK,LRANK+LSIZE); 03240950 IF RIGHTOP.ARRAYTYPE=1 THEN FORGETSPACE(LL-RRANK,RRANK+RSIZE); 03240955 - END ELSE BEGIN %-------------MONADIC IOTA------------------ 03240960 + END ELSE BEGIN %-------------MONADIC IOTA------------------- 03240960 IF RIGHTOP.ARRAYTYPE=1 THEN 03241000 BEGIN ERR:=DOMAINERROR; GO TO QUIT 03241002 END; 03241004 @@ -4211,10 +4211,10 @@ PROCEDURE COMMAP; 03241300 ERR:= RANKERROR; GO TO QUIT; END; 03243300 IF SIZE:=LSIZE+RSIZE GTR MAXWORDSTORE THEN BEGIN 03243400 ERR:=KITEERROR; GO TO QUIT; END; 03243500 - COMMENT CANT MIX NUMBER AND CHARACTERS. HAVE TO JUGGLE 03243540 + COMMENT CANT MIX NUMBERS AND CHARACTERS. HAVE TO JUGGLE 03243540 IF LEFT IS NUMBERS AND RIGHT IS CHARACTERS AS RIGHT 03243541 HAS ALREADY BEEN UNPACKED AND WE DONT WANT TO FORGET 03243542 - LEFT AND DONT WANT TO PACK THE NON-RESULT; 03243543 + LEFT AND WE DONT WANT TO PACK THE NON-RESULT; 03243543 IF CHARACTER THEN 03243550 IF LDESC.ARRAYTYPE=1 OR LSIZE=0 THEN L:=UNPACK(L,LRANK,LSIZE) 03243600 ELSE BEGIN SIZE:=0; LSIZE:=-LRANK; ERR:=DOMAINERROR; 03243700 @@ -4268,9 +4268,9 @@ INTEGER STREAM PROCEDURE GETOP(A,N); VALUE N; 03245120 END; END PROCEDURE IDENTITY; 03247800 INTEGER PROCEDURE GETT(ALONG,RANK); VALUE ALONG, RANK; 03247810 INTEGER ALONG, RANK; 03247820 - GETT:= IF ALONG=1 THEN 0 ELSE 03247822 - IF ALONG=RANK THEN 2 ELSE 03247825 - IF ALONG=RANK-1 THEN 1 ELSE 0; 03247830 + GETT := IF ALONG=1 THEN 0 ELSE 03247822 + IF ALONG=RANK THEN 2 ELSE 03247825 + IF ALONG=RANK-1 THEN 1 ELSE 0; 03247830 BOOLEAN PROCEDURE CHECKANDADD(SIZE,L,SUM); 03253305 VALUE SIZE,L; INTEGER SIZE,L,SUM; 03253310 BEGIN LABEL QUIT; INTEGER I,TOP,M,S,T; 03253315 @@ -4294,7 +4294,7 @@ PROCEDURE COMPRESS(LDESC, RDESC, DIM); VALUE LDESC,RDESC,DIM; 03253400 LABEL QUIT,RANKE,DOMAIN,IDENT; 03253900 DESC.DID := DDPUVW; 03254000 IF L := LDESC.SPF = 0 THEN GO TO DOMAIN; 03254100 - IF M:=RDESC.SPF = 0 THEN BEGIN DESC:=NULLV; GO TO QUIT; END; 03254200 + IF M:=RDESC.SPF=0 THEN BEGIN DESC:=NULLV; GO TO QUIT; END; 03254200 LSIZE := FINDSIZE(LDESC); RSIZE := FINDSIZE(RDESC); 03254300 IF RANK:=LDESC.RF NEQ 1 THEN IF LSIZE NEQ 1 03254350 THEN GO TO DOMAIN; 03254360 @@ -4368,7 +4368,7 @@ PROCEDURE COMPRESS(LDESC, RDESC, DIM); VALUE LDESC,RDESC,DIM; 03253400 POP; 03260150 END PROCEDURE COMPRESS; 03260200 PROCEDURE EXPAND(LDESC,RDESC,DIM); VALUE LDESC,RDESC,DIM; 03268020 - REAL LDESC,RDESC, DIM; 03268040 + REAL LDESC, RDESC, DIM; 03268040 BEGIN INTEGER I,J,K,L,M,N,S,T,RANK,LSIZE,RSIZE,SIZE, 03268060 ALONG,TOP,LADDR,MADDR,FACTOR, SUM; 03268080 REAL DESC, INSERT; 03268100 @@ -4559,7 +4559,7 @@ REAL PROCEDURE REPRESENT; 03270820 GT1:=L+2; 03271140 FOR L:=L+LEFT STEP -1 UNTIL GT1 DO 03271160 IF T:=SP[LOC] LEQ 0 THEN 03271180 - IF T LSS 0 THEN ERR:= DOMAINERROR 03271200 + IF T LSS 0 THEN ERR := DOMAINERROR 03271200 ELSE 03271220 BEGIN 03271240 L:=GT1-1 ; % STOP THE LOOP 03271260 @@ -4587,9 +4587,9 @@ BEGIN INTEGER L,M,N,J,LRANK,RRANK,RANK,LSIZE,RSIZE,SIZE,LL,MM,I, 03271840 REAL DESC, TEMP; 03271880 BOOLEAN CHARACTER, FIRST,LSCALAR, RSCALAR; 03271900 LABEL QUIT, DOMAIN, FORGET, OUTERPROD; 03271920 - IF L:=LDESC.SPF = 0 OR M:= RDESC.SPF=0 THEN GO TO DOMAIN; 03271940 + IF L:=LDESC.SPF = 0 OR M := RDESC.SPF=0 THEN GO TO DOMAIN; 03271940 LSIZE := FINDSIZE(LDESC); RSIZE:=FINDSIZE(RDESC); 03271960 - LRANK:=LDESC.RF; RRANK := RDESC.RF; 03271965 + LRANK:=LDESC.RF; RRANK := RDESC.RF; 03271965 IF LOP NEQ 45 THEN 03271970 IF LRANK GTR 2 AND LSIZE NEQ 1 OR RRANK GTR 2 AND RSIZE NEQ 1 THEN 03271975 BEGIN ERR:=KITEERROR; GO TO QUIT; END; 03271980 @@ -4648,7 +4648,7 @@ BEGIN INTEGER L,M,N,J,LRANK,RRANK,RANK,LSIZE,RSIZE,SIZE,LL,MM,I, 03271840 IF NOT OPERATION(SP[LOC],SP[MOC],1,ROP,TEMP) 03272720 THEN GO TO FORGET; 03272740 IF NOT OPERATION(TEMP,SP[NOC],-1,LOP,SP[NOC]) 03272760 - THEN GO TO FORGET END; 03272780 + THEN GO TO FORGET; END; 03272780 IF NOT RSCALAR THEN M:=M-RCOL; END; 03272800 N := N+1; 03272820 END; 03272840 @@ -4803,7 +4803,7 @@ PROCEDURE REDUCESORTSCAN(LOP,RDESC,DIM,KIND); VALUE LOP,RDESC, 03273500 DESC.DID := DDPUVW; 03274625 IF ALONG GTR 1 AND ALONG LSS RANK-1 THEN BEGIN TOP:=M+ALONG-2; 03274626 FOR L:=M STEP 1 UNTIL TOP DO REMDIM:=REMDIM|SP[LOC]; END; 03274627 - IF REDUCE THEN BEGIN DESC.SPF:=N:=GETSPACE(SSIZE:=SSIZE DIV DIM 03274628 + IF REDUCE THEN BEGIN DESC.SPF:=N:=GETSPACE(SSIZE:=SIZE DIV DIM 03274628 + RANK - 1); 03274629 IF RANK=1 THEN DESC.SCALAR:=1 ELSE DESC.RF:=RANK-1; 03274631 FOR I:=1 STEP 1 UNTIL RANK DO BEGIN 03274634 @@ -4813,7 +4813,7 @@ PROCEDURE REDUCESORTSCAN(LOP,RDESC,DIM,KIND); VALUE LOP,RDESC, 03273500 END ELSE BEGIN DESC.SPF:=N:=GETSPACE(SSIZE:=SIZE+RANK); 03274646 INTERVAL := (DIFF := N-M) + HOP; 03274648 SPCOPY(M,N,RANK); DESC.RF:=RANK; END; 03274649 - IF SORT THEN TEMP:=GETSPACE(DIM); 03274720 + IF SORT THEN TEMP:= GETSPACE(DIM); 03274720 TOP := SIZE DIV (DIM | REMDIM) - 1; 03274732 FOR S:=1 STEP 1 UNTIL REMDIM DO BEGIN 03274735 FOR I:=0 STEP 1 UNTIL TOP DO BEGIN 03274740 @@ -4863,22 +4863,22 @@ BEGIN REAL LDESC,RDESC; 03275300 DEFINE SPTOP=RDESC#,MIN=RDESC#,PTR=NEWRANK#,MBASE=LDESC#,TOP=RDESC# 03275500 ,RESULT=RESULTD#; 03275510 LABEL QUIT; BOOLEAN CARRY; 03275600 -INTEGER ARRAY RVEC,DEL,SUB,OLDEL[0:3]; 03275700 +INTEGER ARRAY RVEC,DEL,SUB,OLDEL[0:31]; 03275700 LDESC:=AREG; RDESC:=BREG; 03275800 RESULT:=0; L:=LDESC.SPF; J:=LDESC.RF; RANK:=RDESC.RF; 03275900 IF M:=RDESC.SPF=0 OR L=0 OR LDESC.ARRAYTYPE=1 THEN BEGIN 03276000 - ERR:=DOMAINERROR; GO TO QUIT; END; 03276010 + ERR:=DOMAINERROR; GO TO QUIT END; 03276010 IF NUMELEMENTS(LDESC)=1 THEN BEGIN N:=L+J; 03276100 IF SP[NOC] NEQ ORIGIN OR RANK GTR 1 THEN BEGIN 03276200 ERR:=DOMAINERROR; GO TO QUIT END; 03276300 %IF WE GET HERE, THE ANSWER IS ITSELF 03276310 RESULT:=RDESC; I:=NUMELEMENTS(RDESC); 03276400 RESULT.SPF:=N:=GETSPACE(SIZE:=RANK+I); RESULT.NAMED:=0; 03276410 - SPCOPY(M,N,SIZE); GO TO QUIT END; 03276420 + SPCOPY(M,N,SIZE); GO TO QUIT; END; 03276420 IF J GTR 1 THEN BEGIN ERR:=RANKERROR; GO TO QUIT END; 03276430 IF SP[LOC] NEQ RANK THEN BEGIN ERR:=LENGTHERROR; GO TO QUIT END; 03276440 % FIND MAX OF LDESC FOR NOW- DO THE REST LATER 03276500 -%LDESC W/R/T ORIGIN 0 GETS STORED IN SUB[I] 03276600 +%LDESC W/R/T/ ORIGIN 0 GETS STORED IN SUB[I] 03276600 SPTOP:=L+RANK; NEWRANK:=0; I:=0; 03276700 FOR N:=L+1 STEP 1 UNTIL SPTOP DO BEGIN 03276800 IF TEMP:=SP[NOC]-ORIGIN+1 GTR NEWRANK THEN NEWRANK:=TEMP; 03276900 @@ -4889,10 +4889,10 @@ INTEGER ARRAY RVEC,DEL,SUB,OLDEL[0:3]; 03275700 FOR I:=RANK-2 STEP -1 UNTIL 0 DO BEGIN 03277300 OLDEL[I]:=OLDEL[I+1]|SP[NOC]; N:=N-1 END; 03277400 MBASE:=M; SIZE:=1; 03277500 -%FIX UP THE NEW RVAC AND DEL 03277700 +%FIX UP THE NEW RVEC AND DEL 03277700 FOR I:=NEWRANK-1 STEP -1 UNTIL 0 DO BEGIN 03277800 % FIND SMALLEST EL. OF RHO RDESC [J] S.T. A[J]=I 03277900 -% AND SUM OF OLDEL[J] S.T. A[J]=1 03278000 +% AND SUM OF OLDEL[J] S.T. A[J]=I 03278000 MIN:=31; TEMP:=0; 03278100 FOR J:=RANK-1 STEP -1 UNTIL 0 DO 03278200 IF SUB[J]=I THEN BEGIN 03278300 @@ -4911,7 +4911,7 @@ INTEGER ARRAY RVEC,DEL,SUB,OLDEL[0:3]; 03275700 FORGETSPACE(MBASE,N+RANK) END; 03279340 FOR I:=1 STEP 1 UNTIL NEWRANK DO BEGIN 03279400 SP[MOC]:=RVEC[I-1]; M:=M+1 END; 03279500 - %INTIALIZE FOR STEPPING THRU NEW ARRAY 03279590 + %INITIALIZE FOR STEPPING THRU NEW ARRAY 03279590 FOR I:=NEWRANK-1 STEP -1 UNTIL 0 DO BEGIN 03279600 SUB[I]:=0; OLDEL[I]:=RVEC[I]|DEL[I] END; 03279610 L:=MBASE+RANK; 03279700 @@ -4937,7 +4937,7 @@ INTEGER ARRAY RVEC,DEL,SUB,OLDEL[0:3]; 03275700 QUIT: END OF DYADICTRANS; 03281710 INTEGER PROCEDURE LOCATE(L,M); VALUE L,M; REAL L,M; 03490000 BEGIN 03490100 - COMMENT L IS THE DIMENSION OF THE VECTOR(DESCRIPTOR), 03490200 + COMMENT L IS THE DIMENSION VECTOR(DESCRIPTOR), 03490200 M IS THE INDEX VECTOR; 03490300 INTEGER P,I,UB; 03490400 L:=I:=L.SPF; M:=I:=M.SPF; 03490500 @@ -4947,7 +4947,7 @@ QUIT: END OF DYADICTRANS; 03281710 BEGIN 03490900 L:=L+1; 03491000 P:=(P+SP[MOC]-1)|SP[LOC]; 03491100 - M:=M+1; 03491200 + M:=M+1 03491200 END; 03491300 P:=P+SP[MOC]; 03491400 LOCATE:=P+L; 03491450 @@ -4967,14 +4967,14 @@ QUIT: END OF DYADICTRANS; 03281710 LEQ WIDE THEN BEGIN TERPRINT; 03500144 FORMROW(0,2,ACCUM,2,ACOUNT); FOLD:=ACOUNT+2; END ELSE 03500145 FORMROW(0,CC,ACCUM,2,ACOUNT); L:=L+1; 03500146 - CC:=2; %PUT 2 BLANKS AFTER FIRST ITEM. 03500148 + CC:=2; %PUT 2 BLANKS AFTER THE FIRST ITEM. 03500148 END; 03500150 TERPRINT; 03500154 END 03500158 END; 03500162 INTEGER L,N,M,BOTTOM,ALOC,BLOC; 03500200 INTEGER ROW,COL; 03500210 - ALOC:=A.SPF; BLOC:=B.SPF-1; 03500300 + ALOC:=A.SPF; BLOC:= B.SPF-1; 03500300 L:=(M:=B.RF)+ BLOC; COL:=SP[LOC]; 03500310 L:=L-1; 03500320 ROW:=(IF M GTR 1 THEN SP[LOC] ELSE 1); 03500330 @@ -4997,7 +4997,7 @@ QUIT: END OF DYADICTRANS; 03281710 INTEGER I; 03501300 REAL M,N,SEQ,ORD,D; 03501400 BOOLEAN NUMERIC; 03501600 - REAL STREAM PROCEDURE CON(A);VALUE A; 03501610 + REAL STREAM PROCEDURE CON(A); VALUE A; 03501610 BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT 03501620 END; 03501630 D:=SP[LOC]; %DESCRIPTOR FOR FUNCTION IS IN D 03501700 @@ -5013,7 +5013,7 @@ QUIT: END OF DYADICTRANS; 03281710 SP[N+2] = SP LOC OF FIRST NUMERIC POINTER TO TEXT 03502700 03502710 SP[N+3] = REL LOC (TO N+5) OF THE FIRST ARG 03502800 - SP[N+4] = REL LOC TO THE SECOND ARG 03502900 + SP[N+4] = REL LOC OF THE SECOND ARG 03502900 SP[N+5] = REL LOC OF RESULT . IF ANY ARE ZERO, THEN 03503000 THEY ARE NOT THERE.; 03503100 D:=M; M:=(N:=N+4)+1; %D IS #ITEMS, M IS LOC 1ST, N=M-1 03503200 @@ -5034,7 +5034,7 @@ QUIT: END OF DYADICTRANS; 03281710 END; 03504600 M:=M+1 03504700 END; 03504800 - COMMENT WE HAVE TO SET UP THE FUNCTION LABEL TABLE, LET 03504900 + COMMENT WE HAVE SET UP THE FUNCTION LABEL TABLE, LET 03504900 SOMEONE ELSE FIGURE OUT HOW TO EXECUTE IT; 03505000 END; 03505100 PROCEDURE PUSHINTOSYMTAB(FPTR);VALUE FPTR;REAL FPTR; 03506000 @@ -5069,9 +5069,9 @@ COPY: COMMENT L IS LOC IN SYMBOL TABLE FOR DESC. K WILL BE 03508500 03508900 SP[LOC]:=SP[MOC]&K[CLOCF]&1[CNAMED]; 03509000 SP[MOC]:=L&DDNUVW[CDID];M:=M+1; 03509100 - END ELSE % THERE IS NO ROOM IN THE SYMBEOL TABLE 03509200 + END ELSE % THERE IS NO ROOM IN THE SYMBOL TABLE 03509200 BEGIN N:=T;ERR:=SPERROR;END; 03509300 - END;% OF FOR LOOP STEPPING THROGH THE LOCALS 03509400 + END;% OF FOR LOOP STEPPING THRU THE LOCALS 03509400 END; % OF PUSHINTOSYMTAB PROCEDURE 03509500 PROCEDURE FORGETPROGRAM(U);VALUE U; REAL U; 03510000 BEGIN REAL L,M; 03510100 @@ -5092,7 +5092,7 @@ BEGIN ;%-------------------------------------------------------- 03700100 %---------------- CASE 1....MODE=XEQUTE------------------------ 03700200 CASE CURRENTMODE OF 03700300 BEGIN%----------------------------------------------------- 03700400 - %------------- SUB-CASE 0....CURRENTMODE=CALCMODE---------- 03700500 + %------------ SUB-CASE 0....CURRENTMODE=CALCMODE----------- 03700500 IF T:=ANALYZE(TRUE) NEQ 0 THEN % WE HAVE A PROGRAM DESC 03700600 BEGIN COMMENT SET-UP THE STACK; 03700700 IF STACKBASE=0 THEN BEGIN 03700710 @@ -5129,21 +5129,21 @@ BEGIN ;%-------------------------------------------------------- 03700100 %----------- SUB-CASE 2....CURRENTMODE=FUNCMODE-------------- 03701800 COMMENT SYNTAX CHECK ONLY; 03701900 IF ANALYZE(TRUE)=0 THEN; 03702000 - %------- END OF SUB CASES----------------------------------- 03702100 + %----------- END OF SUB CASES------------------------------- 03702100 END; 03702200 -%------------------ CASE 2.....MODE=ALLOC------------------------ 03702300 +%----------------- CASE 2.....MODE=ALLOC-------------------------- 03702300 COMMENT NOTHING TO DO; 03702400 ; 03702500 -%----------------- CASE 3.... MODE=WRITEBACK------------------- 03702600 +%---------------- CASE 3.... MODE=WRITEBACK--------------------- 03702600 COMMENT HAVE TO WRITE BACK ALL THE CHANGED VARIABLES; 03702700 IF SYMBASE NEQ 0 THEN 03702800 WRITEBACK; 03702900 03709000 -%----------------- CASE 4.... MODE=DEALLOC--------------------- 03709100 +%---------------- CASE 4.... MODE=DEALLOC----------------------- 03709100 ; 03709200 03709300 03709400 -%----------------- CASE 5 .... MODE=INTERROGATE---------------- 03709500 +%---------------- CASE 5 .... MODE=INTERROGATE------------------ 03709500 COMMENT PRINT OUT THE PROGRAM STATUS VECTOR HERE; 03709600 IF L:=STACKBASE+1 NEQ 1 THEN 03709700 BEGIN COMMENT GT1=1 FOR SIV...=0 FOR SI; 03709710 @@ -5167,7 +5167,7 @@ BEGIN ;%-------------------------------------------------------- 03700100 TERPRINT; M:=M-1; 03709860 END; 03709870 END; 03709880 - END;% OF THE CASE STATMENT 03711000 + END;% OF THE CASE STATEMENT 03711000 %--------------END OF CASES--------------------------------------- 03711100 IF FALSE THEN EXECUTION: 03750000 BEGIN COMMENT EXECUTION LOOP; 03750100 @@ -5180,7 +5180,7 @@ IF FALSE THEN EXECUTION: 03750000 DEFINE RESULT=RESULTD#; 03750410 LABEL EXECEXIT, EVALQ, EVALQQ; 03750500 %%% 03751000 - COMMENT THERE IS A PROGRAM DESCRIPTOR AT THE TOP OF THE STACK; 03751100 + COMMENT THERE IS A PROGRAM DESCRIPTOR AT THE TOP OF STACK; 03751100 ERR:=0; 03751200 L:=STACKBASE; ST:=L+SP[LOC]; 03751300 L:=L+1;FUNCLOC:=SP[LOC].SPF+1; 03751310 @@ -5221,7 +5221,7 @@ IF FALSE THEN EXECUTION: 03750000 PUSH; IF ERR NEQ 0 THEN GO TO SKIPPOP; 03752910 N:=T.LOCFIELD; 03752912 IF BOOLEAN(T.OPTYPE) THEN %A LOCAL VARIABLE 03752915 - BEGIN M:=FUNCLOC;%FIND LAST MKS 03752916 + BEGIN M:=FUNCLOC;%FIND LAST FMKS 03752916 M:=SP[MOC].SPF+M; 03752917 N:=SP[MOC].LOCFIELD+N; END; 03752918 U:=SP[NOC]; U.LOCFIELD:=N; AREG:=U; 03752920 @@ -5229,19 +5229,19 @@ IF FALSE THEN EXECUTION: 03750000 COMMENT PROBABLY MIXUP WITH FUNCTION NAMES 03752924 AND NAMES OF LOCAL SUSPENDED VARIABLES; 03752926 END; 03752930 - %-------------FUNCTION CALL----------------- 03752950 -%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 03752960 + %-------------FUNCTION CALL---------------- 03752950 +%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 03752960 BEGIN COMMENT SET UP STACK FOR A FUNCTION CALL; 03752970 REAL U,V,NARGS,D; 03752980 INTEGER I,FLOC; 03752982 LABEL TERMINATE; 03752990 COMMENT 03752991 - MONITOR PRINT(D,L,M,N,FLOC,SP,LASTMKS);%:::::::::::::::::::: 03752992 + MONITOR PRINT(D,L,M,N,FLOC,SP,LASTMKS);%::::::::::::::::::: 03752992 FLOC:=N:=T.LOCFIELD; 03753000 IF BOOLEAN(SP[NOC].DATADESC) THEN BEGIN ERR:=NONCEERROR; 03753005 GO TO TERMINATE;END;%SUSPENDED VAR CONFUSED WITH FUNCTION 03753007 IF NOT BOOLEAN(SP[NOC].PRESENCE) THEN MAKEFUNCTIONPRESENT(N); 03753010 - D:=SP[NOC]; L:=LASTMKS; %D IS TEH DESC, L IS THE PROG MKS 03753020 + D:=SP[NOC]; L:=LASTMKS; %D IS THE DESC, L IS THE PROG MKS 03753020 SP[LOC].CIF:=CINDEX; %SAVE CURRENT POLISH LOCATION 03753022 L:=STACKBASE+1; L:=SP[LOC].SPF+1; 03753030 M:=SP[LOC].SPF; 03753035 @@ -5294,7 +5294,7 @@ COMMENT 03752991 M:=M+2+I; %M IS LOCATION OF REL LOCATION OF VARIABLE 03753410 M:=SP[MOC]; 03753420 N:=LASTMKS+M; 03753430 - SP[NOC]:=GTA[I-1]; 03753440 + SP[NOC]:=GTA[I-1] 03753440 END; 03753450 %PUT IN A PHONEY PROG DESC TO START THINGS OFF 03753460 PUSH; IF ERR NEQ 0 THEN GO TO TERMINATE; 03753470 @@ -5314,7 +5314,7 @@ COMMENT 03752991 BEGIN IF T.OPTYPE=MONADIC THEN 03755210 BEGIN PUSH;IF ERR=0 THEN AREG:=0; END; 03755220 CASE T.LOCFIELD OF 03755300 -BEGIN %--------------- OPERATE ON STACK --------------------- 03755400 +BEGIN %--------------- OPERATE ON STACK---------------------- 03755400 COMMENT EACH EXECUTION PROCEDURE SETS RESULT TO THE 03755500 DESCRIPTOR OF THE RESULT OF THE OPERATION. 03755510 AREG AND BREG ARE THE LEFT AND RIGHT-HAND OPERANDS AND 03755520 @@ -5324,7 +5324,7 @@ BEGIN %--------------- OPERATE ON STACK --------------------- 03755400 ; 03801000 ; 03802000 ; 03803000 - %---------------------REPLACEMENT OPERATOR--------------- 03804000 + %-------------------- REPLACEMENT OPERATOR--------------- 03804000 BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// 03804100 IF NOT BOOLEAN(L:=AREG.NAMED) THEN % SHOULD BE LOCAL VARIABLE 03804110 AREG.NAMED:=1; % DONT LET IT BE FORGOTTEN. 03804120 @@ -5346,7 +5346,7 @@ BEGIN %--------------- OPERATE ON STACK --------------------- 03755400 RESULT.NAMED:=1; %KEEP "PUSH" FROM TOSSING THE DATA 03804640 END; 03804700 %-------TRANSFER OPERATOR----------------------------- 03805000 - BEGIN DEFINE STARTSEGMENT=#; %//////////////////////////////// 03805100 + BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// 03805100 SCRATCHAIN(OLDDATA);OLDDATA:=0; 03805110 IF BOOLEAN(T.OPTYPE) THEN ST:=ST-1; %GET RID OF PHONEY TOP 03805200 L:=FUNCLOC; 03805210 @@ -5360,7 +5360,7 @@ BEGIN %--------------- OPERATE ON STACK --------------------- 03755400 ELSE COMPRESS(AREG,SP[LOC],BREG); COMMENT A/B HAS BEEN 03806020 STACKED AS B,A,NULL...A/[I] B HAS BEEN STACKED AS B,I,A; 03806030 END; 03806040 - ARITH(3); %OPERATION IS DIVIDE 03807000 + ARITH(3); %OPERATION IS DIVIDE 03807000 ; 03807999 ; 03809000 %-------------QUAD INPUT------------------------------- 03810000 @@ -5382,7 +5382,7 @@ EVALQUAD: %LOOK AT BUFFER TO SEE WHAT CAME IN 03810100 BEGIN % -----EVALUATE SUBSCRIPTS--------------- 03811000 DEFINE STARTSEGMENT=#; %///////////////////////////////////// 03811002 T:=AREG; L:=BREG.SPF; 03811010 - IF BOOLEAN(T.SCALAR) THEN BEGIN ERR:=DOMAINERROR; GO TO SKIPPOP;END;03811011 + IF BOOLEAN(T.SCALAR) THEN BEGIN ERR:=DOMAINERROR;GO TO SKIPPOP;END; 03811011 U:=SP[LOC]; % GET # OF SUBSCRIPTS 03811012 IF U GTR 32 THEN ERR:=INDEXERROR ELSE 03811014 BEGIN 03811015 @@ -5401,7 +5401,7 @@ EVALQUAD: %LOOK AT BUFFER TO SEE WHAT CAME IN 03810100 03811102 CINDEX:=CINDEX+1;END; % SKIP OVER REPLACE OP 03811103 END ELSE % NO SUBSCRIPTS 03811104 - BEGIN BREG:=T; ST:=ST-1; GO TO SKIPPOP; 03811106 + BEGIN BREG:=T; ST:= ST-1; GO TO SKIPPOP; 03811106 END; % DON{T LET THE DESC. IN T BE POPPED. 03811108 U:=U+2; % # OF THINGS TO POP 03811110 FOR N:=1 STEP 1 UNTIL U DO POP; 03811114 @@ -5412,11 +5412,11 @@ EVALQUAD: %LOOK AT BUFFER TO SEE WHAT CAME IN 03810100 END; 03811200 ; 03812000 ; 03813000 -%-------------QQUAD INPUT------------------------------- 03814000 - EVALQQ: BEGIN LABEL EVALQQUAD; 03814010 +%-------------QQUAD INPUT------------------------------ 03814000 + EVALQQ: BEGIN LABEL EVALQQUAD; 03814010 IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END; 03814015 CURRENTMODE:=INPUTMODE; 03814020 - IMS(1); %SET UP MARKSTACKS FOR QQUAD EXIT 03814030 + IMS(1); % SETUP MARKSTACKS FOR QQUAD EXIT 03814030 IF ERR NEQ 0 THEN GO TO SKIPPOP; 03814040 GO TO EXECEXIT; 03814080 EVALQQUAD: % BUFFER CONTAINS THE INPUT STRING 03814100 @@ -5456,7 +5456,7 @@ EVALQQUAD: % BUFFER CONTAINS THE INPUT STRING 03814100 IOTAP; %IOTA 03835000 ; 03836000 REDUCESORTSCAN(0,BREG,AREG,4); %REVERSAL; 03837000 - BEGIN %-----------EXPANSION------------------------- 03838000 + BEGIN %-----------EXPANSION-------------------------- 03838000 DEFINE STARTSEGMENT=#; %//////////////////////////////////// 03838005 L:=ST-2; IF T.OPTYPE=MONADIC THEN EXPAND(BREG,SP[LOC],AREG) 03838010 ELSE EXPAND(AREG,SP[LOC],BREG); COMMENT A EXPN B HAS BEEN 03838020 @@ -5466,7 +5466,7 @@ EVALQQUAD: % BUFFER CONTAINS THE INPUT STRING 03814100 ARITH(10); %COMB/FACT 03840000 ; 03841000 IF T.OPTYPE=MONADIC THEN ARITH(5) ELSE 03842000 - DYADICRNDM; %RNDM 03842100 + DYADICRNDM; %RNDM 03842100 IF T.OPTYPE=MONADIC THEN TRANSPOSE ELSE DYADICTRANS;%GUESS WHAT 03843000 RESULTD := REPRESENT; %REPRESENTATION 03844000 ARITH(45); %CIRCLE--TRIGONOMETRIC FUNCTIONS 03845000 @@ -5475,9 +5475,9 @@ EVALQQUAD: % BUFFER CONTAINS THE INPUT STRING 03814100 ARITH(0); %ADD 03848000 ARITH(2); %SUBTRACT 03849000 ARITH(1); %MULTIPLY 03850000 - %-------------------DISPLAY--------------------------------------- 03851000 + %-------------------DISPLAY------------------------------------- 03851000 03851100 - BEGIN DEFINE STARTSEGMENT=#; %///////////////////////////////// 03851110 + BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// 03851110 IF BREG.SPF=0 THEN FORMROW(3,0,ACCUM,2,0) ELSE %FOR A NULL 03851115 IF BOOLEAN((RESULT:=BREG).DATADESC)THEN %THIS IS A DATA DESC 03851120 IF BOOLEAN(RESULT.PRESENCE) AND M:=RESULT.SPF NEQ 0 THEN 03851140 @@ -5519,8 +5519,8 @@ EVALQQUAD: % BUFFER CONTAINS THE INPUT STRING 03814100 ARITH(21); %LOG 03854000 REDUCESORTSCAN(0,BREG,AREG,2); % SORTUP 03855000 REDUCESORTSCAN(-1,BREG,AREG,2); %SORTDN 03856000 - BEGIN%--------------SCAN-------LIKE REDUCTION---------------- 03857000 - DEFINE STARTSEGMENT=#; %////////////////////////////////////// 03857010 + BEGIN %-------------SCAN-------LIKE REDUCTION--------------- 03857000 + DEFINE STARTSEGMENT=#; %///////////////////////////////////// 03857010 M:=(CINDEX:=CINDEX+1) + POLLOC; %FIND OPERATOR IN POLISH 03857020 IF (T:=SP[MOC]).TYPEFIELD NEQ 3 THEN ERR:=SYSTEMERROR 03857040 ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,3); 03857060 @@ -5531,10 +5531,10 @@ EVALQQUAD: % BUFFER CONTAINS THE INPUT STRING 03814100 ELSE ERR:=RANKERROR; % OPERATION IS TAKE 03860010 IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T.RF) 03861000 ELSE ERR:=RANKERROR; % OPERATION IS DROP 03861010 - %------------------------XEQ--------------------------------- 03862000 -XEQEPS: BEGIN DEFINE STARTSEGMENT=#; %//////////////// 03862005 + %-----------------------XEQ----------------------------------- 03862000 +XEQEPS: BEGIN DEFINE STARTSEGMENT=#; %///////////////// 03862005 IF AREG NEQ 0 THEN ERR:=SYNTAXERROR %MUST BE MONADIC ONLY 03862010 - ELSE IF (T:=BREG).RF NEQ 1 OR %MUST BE A VECTOR 03862020 + ELSE IF (T:=BREG).RF NEQ 1 OR %MUST BE A VECTOR 03862020 NOT BOOLEAN(T.CHRMODE) THEN ERR:=DOMAINERROR %MUST BE CHAR STRING 03862030 ELSE IF U:=NUMELEMENTS(T) GTR MAXBUFFSIZE THEN ERR:=LENGTHERROR 03862032 ELSE BEGIN 03862040 @@ -5545,7 +5545,7 @@ XEQEPS: BEGIN DEFINE STARTSEGMENT=#; %//////////////// 03862005 IF T.SPF=0 OR NOT SCAN THEN RESULT:=0&1[CRF]&DDPUVW[CDID]% NULL 03862060 ELSE BEGIN POP;IF SETUPLINE THEN; GO TO SKIPPOP;END 03862070 END; END; 03862080 - END; %--------------END OF OPERATION ON STACK--------------------- 03869960 + END; %--------------END OF OPERATION ON STACK-------------------- 03869960 POP;POP;PUSH;IF ERR=0 THEN AREG:=RESULT; 03869970 SKIPPOP: END OF TYPEFIELD EQUALS OPERATOR; 03869980 %-------TF=4 (LOCAL VARIABLE)------------ 03870000 @@ -5566,16 +5566,16 @@ SKIPPOP: END OF TYPEFIELD EQUALS OPERATOR; 03869980 U.LOCFIELD:=0; 03872410 AREG:=U; END; 03872500 END; 03872600 - END; % OF CASE STATEMENT TESTING TYPEFIELD 03900000 + END; % OF CASE STMT TESTING TYPEFIELD 03900000 END % OF TEST FOR CINDEX LEQ POLTOP 03901000 ELSE % WE ARE AT THE END OF THE POLISH 03902000 - BEGIN COMMENT LASKMKS CONTAINS THE LOCATION 03903000 + BEGIN COMMENT LASTMKS CONTAINS THE LOCATION 03903000 OF THE LAST MARK STACK. GET MARK STACK AND CONTINUE; 03904000 03905000 SCRATCHAIN(OLDDATA); OLDDATA:=0; 03905010 L:=LASTMKS;M:=(U:=SP[LOC]).BACKF+STACKBASE;T:=SP[MOC]; 03905020 IF T.DID=IMKS AND T.QUADIN=3 THEN %SINGLE LINE DONE 03905030 - IF (RESULT:=AREG)=T THEN ERR:=SYNTAXERROR%NO RESULT 03905035 + IF(RESULT:=AREG)=T THEN ERR:=SYNTAXERROR%NO RESULT 03905035 ELSE BEGIN RESULT.NAMED:=0;%MAKE NEW COPY 03905040 IF BOOLEAN(RESULT.SCALAR) THEN 03905042 BEGIN M:=GETSPACE(2);L:=RESULT.SPF; 03905044 @@ -5585,7 +5585,7 @@ SKIPPOP: END OF TYPEFIELD EQUALS OPERATOR; 03869980 BEGIN M:=GETSPACE(1+(N:=RESULT.RF+NUMELEMENTS( 03905052 RESULT))); 03905053 L:=RESULT.SPF;RESULT.SPF:=M+1; 03905054 - SP[MOC]:=RESULT; SPCOPY(L,M+1,N); END; 03905056 + SP[MOC]:=RESULT; SPCOPY(L,M+1,N);END; 03905056 03905058 03905060 FORGETPROGRAM(U); 03905070 @@ -5601,7 +5601,7 @@ SKIPPOP: END OF TYPEFIELD EQUALS OPERATOR; 03869980 BEGIN 03905203 IF 0=(LOOP:=(LOOP+1) MOD 5) THEN 03905205 WRITE(TWXOUT,1,JIGGLE[*])[BREAKKEY:BREAKKEY]; 03905206 - %THAT WAS TO CHECK FOR A BREAK TO INTERRUPT A PROG 03905207 + %THAT WAS TO CHECK FOR BREAK TO INTERRUPT A PROG 03905207 STEPLINE(FALSE) 03905210 END 03905215 ELSE BEGIN XIT:=TRUE;CURRENTMODE:=CALCMODE; 03905300 @@ -5664,7 +5664,7 @@ PROCESSEXIT: 03950090 IF FALSE THEN 03951000 BEGIN CASE 0 OF BEGIN 03951100 EXPOVRL: SPOUT(3951200); 03951200 - INTOVRL: SPOUT(3591300); 03951300 + INTOVRL: SPOUT(3951300); 03951300 INDEXL: SPOUT(3951400); 03951400 FLAGL: SPOUT(3951500); 03951500 ZEROL: SPOUT(3951600); 03951600 @@ -5727,7 +5727,7 @@ PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R; 05000000 "7SP FULL", 05001820 "7FLYKITE"; 05001830 IF R NEQ 0 THEN 05001900 - BEGIN INDENT(R);CHRCOUNT:=CHRCOUNT-1; 05001910 + BEGIN INDENT(R);CHRCOUNT:=CHRCOUNT-1 05001910 END; 05002000 FORMROW((IF R=0 THEN 2 ELSE 0),0,ERMES,N|8+1, 05002010 ERMES[N].[1:5]); 05002100 @@ -5767,7 +5767,7 @@ PROCEDURE LOGINAPLUSER; 07001000 07029000 END ELSE % WORKSPACE ASSIGNED 07030000 I:=CONTENTS(WORKSPACE,0,PSR); 07031000 - FILL ACCUM[*] WITH "LOGGED I", "N "; 07032000 + FILL ACCUM[*] WITH "LOGGED I","N "; 07032000 FORMROW(0,1,ACCUM,0,9); 07033000 I:=DAYTIME(ACCUM); 07034000 FORMROW(1,1,ACCUM,0,I); 07035000 @@ -5776,7 +5776,7 @@ PROCEDURE LOGINAPLUSER; 07001000 CASE CURRENTMODE OF 07036010 BEGIN %--------CALCMODE-------------- 07036020 ;COMMENT NOTHING TO DO ANYMORE; 07036030 - %--------------XEQUTEMODE---------------------- 07036040 + %--------------XEQUTEMODE------------ 07036040 EXEC: 07036042 BEGIN FILL ACCUM[*] WITH "LAST RUN"," STOPPED"; 07036050 FORMROW(3,0,ACCUM,0,16); 07036060 @@ -5831,7 +5831,7 @@ PROCEDURE APLMONITOR; 07100000 GO TO EXECUTEIT; 07117000 %----------FUNCMODE----------------------------------- 07117100 GO TO FUNCTIONSTART; 07117400 - %-----------INPUTMODE--------------------------------- 07117500 + %----------INPUTMODE---------------------------------- 07117500 COMMENT REQUIRES INPUT; 07117600 07117700 BEGIN COMMENT GET THE LINE AND GO BACK; 07117800 @@ -5855,7 +5855,7 @@ CALCULATEDIT: 07126010 IF RGTPAREN THEN MESSAGEHANDLER ELSE 07126200 IF DELV THEN FUNCTIONHANDLER ELSE 07126300 BEGIN COMMENT PROCESS CALCULATOR MODE REQUEST; 07126310 - MOVE(BUFFER,BUFFERSIZE,OLDBUFFER); 07126320 + MOVE(BUFFER,BUFFSIZE,OLDBUFFER); 07126320 IF NOT BOOLEAN(SUSPENSION) THEN BEGIN %INITIALIZE USER 07126321 %%% 07126322 %%% 07126323 @@ -5874,7 +5874,7 @@ BACKAGAIN: BEGIN INDENT(0); TERPRINT; 07126333 END; 07126342 END; 07126350 IF EDITOG=1 THEN 07126360 - BEGIN MOVE(OLDBUFFER,BUFFERSIZE,BUFFER); 07126370 + BEGIN MOVE(OLDBUFFER,BUFFSIZE,BUFFER); 07126370 RESCANLINE; EDITOG:=0; GO TO CALCULATEDIT; 07126380 END; 07126390 I:=0; 07126400 @@ -5978,18 +5978,18 @@ INTEGER PROCEDURE DAYTIME(B); ARRAY B[0]; 08014000 END; 08014092 TIME1:=TIME(1); 08014100 Y:=TIME(0); 08014110 - D:=Y.[30:1]|100+Y.[36:6]|10+Y.[42:6]; 08014120 + D:=Y.[30:6]|100+Y.[36:6]|10+Y.[42:6]; 08014120 Y:=Y.[18:6]|10+Y.[24:6]; 08014130 FOR H:=31,IF Y MOD 4=0 THEN 29 ELSE 28,31,30, 08014140 31,30,31,31,30,31,30 DO 08014150 IF D LEQ H THEN GO OWT ELSE 08014160 - BEGIN D:=D-H; M:=M+1; 08014170 + BEGIN D:=D-H; M:=M+1 08014170 END; 08014180 OWT: 08014190 H:=TIME1 DIV 216000; 08014200 MIN:=(TIME1 DIV 3600) MOD 60; 08014210 IF M LSS 2 THEN 08014220 - BEGIN Q:=M+11; P:=Y-1; 08014230 + BEGIN Q:=M+11; P:=Y-1 08014230 END ELSE 08014240 BEGIN Q:=M-1; P:=Y 08014250 END; 08014260 @@ -6086,7 +6086,7 @@ PROCEDURE LOADWORKSPACE(NAME1,NAME2,IDENT); VALUE NAME1,NAME2; 08014325 ELSE VARSIZE:=1; 08014595 LEN:=(WDSPERREC-1)|8; 08014597 IF NOT TOG THEN % OK TO PUT INTO VARIABLES 08014599 - IF G=FUNCTION THEN % READ A FUNCTION INTO VARIABLES 08014603 + IF G=FUNCTION THEN % READ A FUNCTION INTO VARIABLES 08014603 BEGIN 08014607 TRANSFER(T,0,U,0,9); % U HOLDS FUNCTION NAME, 08014619 %NUMBER OF ARGUMENTS, AND WHETHER FN RETURNS A VALUE 08014620 @@ -6097,7 +6097,7 @@ PROCEDURE LOADWORKSPACE(NAME1,NAME2,IDENT); VALUE NAME1,NAME2; 08014325 S:=RD(D,S,B); 08014650 FOR I:=0 STEP 1 UNTIL SIZE-1 DO 08014651 BEGIN 08014655 - TRANSFER(M,M|8,T,0,16); 08014659 + TRANSFER(B,M|8,T,0,16); 08014659 M:=M+2; 08014663 IF M GEQ WDSPERREC-1 THEN 08014667 BEGIN 08014671 @@ -6135,7 +6135,7 @@ PROCEDURE LOADWORKSPACE(NAME1,NAME2,IDENT); VALUE NAME1,NAME2; 08014325 ELSE 08014767 IF G=ARRAYDATA THEN 08014771 IF T[1].INPTR=0 THEN % NULL VECTOR 08014772 - GO TO SCALARL 08014773 + GO SCALARL 08014773 ELSE 08014774 BEGIN 08014775 ARRAY DIMVECT[0:MAXBUFFSIZE]; 08014779 @@ -6257,7 +6257,7 @@ PROCEDURE SAVEWORKSPACE(NAME1,NAME2,LOCKFILE); 08015300 BEGIN TRANSFER(J,6,B,C,1); N:=WR(D,N,B); C:=1; 08015470 TRANSFER(J,7,B,0,1); 08015480 END ELSE 08015490 - BEGIN TRANSFER(J,6,B,C,2); C:=C+2; 08015500 + BEGIN TRANSFER(J,6,B,C,2); C:=C+2 08015500 END; 08015510 WHILE J NEQ 0 DO 08015520 IF J GTR K:=(L-C) THEN 08015530 @@ -6311,7 +6311,7 @@ PROCEDURE SAVEWORKSPACE(NAME1,NAME2,LOCKFILE); 08015300 PT:=GETFIELD(T,FPTF,FFL); % FUNCTION POINTER FIELD 08015717 SQ:=GETFIELD(T,FSQF,FFL); % FUNCTION SEQUENTIAL FIELD 08015720 %PT=# OF ORDERED STORAGE UNIT CONTAINING HEADER&POINTE 08015723 - %SQ=# OF SEQ STORAGE UNIT CPONTAINING TEXT 08015726 + %SQ=# OF SEQ STORAGE UNIT CONTAINING TEXT 08015726 MAX:=SIZE(PT); 08015729 T[1].LIBF1:=N; % RECORD # 08015732 T[1].LIBF2:=M; % LOC WITHIN RECORD 08015735 @@ -6363,7 +6363,7 @@ PROCEDURE SAVEWORKSPACE(NAME1,NAME2,LOCKFILE); 08015300 T[1].INPTR:=N; T[1].DIMPTR:=M; 08015859 C:=M|8; 08015860 J:=CONTENTS(WS,LSD.DIMPTR,BUFFER); % DIM VECT 08015861 - PUTAWAY(C,J,WR,DISK,N,M,B,LEN); % STD DIM VECT 08015864 + PUTAWAY(C,J,WR,DISK,N,M,B,LEN); % STO DIM VECT 08015864 J:=CONTENTS(WS,LSD.INPTR,DIMVECT); 08015867 TRANSFER(DIMVECT,0,BUFFER,0,J); 08015868 PUTAWAY(C,J,WR,DISK,N,M,B,LEN); 08015869 @@ -6440,7 +6440,7 @@ PROCEDURE MESSAGEHANDLER; 08016000 IF NOT LIBRARIAN(R,S) THEN BEGIN 08016125 SAVEWORKSPACE(R,S,GT1); %GT1 SET IN LIBNAMES 08016130 GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7); 08016131 - IF(GT1~SEARCHORD(LIBRARY,GTA, I, 7)) NEQ 0 THEN 08016132 + IF(GT1~SEARCHORD(LIBRARY,GTA, I ,7)) NEQ 0 THEN 08016132 BEGIN GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7); 08016133 STOREORD(LIBRARY,GTA,I+(IF GT1=1 THEN -1 ELSE 1));08016134 END; LIBSIZE~LIBSIZE+1; 08016135 @@ -6475,7 +6475,7 @@ PROCEDURE MESSAGEHANDLER; 08016000 ELSE 08016360 IF NOT BOOLEAN(SUSPENSION)THEN PURGEWORKSPACE(WORKSPACE) 08016365 ELSE GO ERR1 ELSE GO ERR1; 08016370 - % ------- COPY ------- 08016400 + % ------- COPY ------- 08016400 IF LIBNAMES(R,S) THEN 08016410 IF LIBRARIAN(R,S) THEN 08016415 LOADWORKSPACE(R,S,ACCUM) 08016420 @@ -6491,7 +6491,7 @@ PROCEDURE MESSAGEHANDLER; 08016000 ; 08016746 %-------- MSG -------- 08016800 ERRORMESS(SYNTAXERROR,LADDRESS,0); 08016870 - %-----WIDTH (INTEGER) --------------------------- 08016900 + %-----WIDTH (INTEGER) ---------------------------- 08016900 IF NOT SCAN THEN BEGIN NUMBERCON(LINESIZE, ACCUM); 08016910 FORMROW(3,0,ACCUM,2,ACOUNT); END 08016915 ELSE IF NUMERIC AND I:=ACCUM[0] GTR 9 AND I LEQ 72 08016920 @@ -6520,7 +6520,7 @@ PROCEDURE MESSAGEHANDLER; 08016000 CSTATION:=GT1&0[CAPLOGGED] 08017245 ;GO TO FINIS; 08017246 END; 08017250 - %--------ORIGIN---------------------------------- 08017255 + %--------ORIGIN----------------------------------- 08017255 IF NOT SCAN THEN BEGIN NUMBERCON(ORIGIN,ACCUM); 08017256 FORMROW(3,0,ACCUM,2,ACOUNT) END 08017257 ELSE IF NUMERIC AND ERR=0 THEN BEGIN ORIGIN:= 08017258 @@ -6531,7 +6531,7 @@ PROCEDURE MESSAGEHANDLER; 08016000 ELSE IF NUMERIC AND ERR=0 THEN BEGIN 08017265 SEED:=ABS(I:=ACCUM[0]); 08017266 STOREPSR END ELSE GO TO ERR1; 08017267 - %--------FUZZ------------------------------------ 08017270 + %--------FUZZ----------------------------------- 08017270 IF NOT SCAN THEN BEGIN 08017272 NUMBERCON(FUZZ,ACCUM); 08017273 FORMROW(3,0,ACCUM,2,ACOUNT) END 08017274 @@ -6543,19 +6543,19 @@ PROCEDURE MESSAGEHANDLER; 08016000 IF SYMBASE NEQ 0 THEN PROCESS(WRITEBACK); 08017960 08017962 08017970 - %-----------------ABORT------------------------- 08018000 + %-----------------ABORT------------------------ 08018000 BEGIN IF BOOLEAN(SUSPENSION) THEN 08018010 SP[0,0]:=0; NROWS:=-1; 08018012 %%% 08018020 SUSPENSION:=0; 08018022 - STOREPSR; 08018023 + STOREPSR 08018023 END; 08018030 - %-----------------SI--------------------------------- 08018100 + %-----------------SI-------------------------------- 08018100 IF BOOLEAN(SUSPENSION) THEN 08018110 BEGIN GT1:=0; 08018120 PROCESS(LOOKATSTACK); 08018130 END ELSE FORMWD(3,"6 NULL."); 08018140 - %------------------SIV------------------------------ 08018150 + %------------------SIV------------------------------- 08018150 IF BOOLEAN(SUSPENSION) THEN 08018160 BEGIN GT1:=1; 08018170 PROCESS(LOOKATSTACK); 08018180 @@ -6563,7 +6563,7 @@ PROCEDURE MESSAGEHANDLER; 08016000 %------------------ERASE------------------------------ 08018200 IF CURRENTMODE=FUNCMODE OR BOOLEAN(SUSPENSION) THEN GO TO ERR1 08018210 ELSE WHILE SCAN AND IDENT DO 08018215 - BEGIN % LOOK FOR THE INDENTIFIER NAME IN ACCUM 08018220 + BEGIN % LOOK FOR THE IDENTIFIER NAME IN ACCUM 08018220 TRANSFER(ACCUM,2,GTA,0,7); 08018225 IF (IF VARIABLES=0 THEN FALSE ELSE 08018230 SEARCHORD(VARIABLES,GTA,GT1,7)=0) THEN 08018235 @@ -6600,7 +6600,7 @@ PROCEDURE MESSAGEHANDLER; 08016000 FORMROW(0,1,ACCUM,2,6); 08018985 END; TERPRINT; 08018990 END ELSE FORMWD(3,"6 NULL."); 08018995 - %------------------------ END OF CASES --------------------------- 08018999 + %------------------------ END OF CASES ---------------------------- 08018999 END ELSE GO TO ERR1; 08019000 IF CURRENTMODE=FUNCMODE THEN INDENT(-CURLINE); 08019010 END ELSE 08019020 @@ -6648,19 +6648,19 @@ BOOLEAN STREAM PROCEDURE WITHINLINE(COMMAND,OLD,NEW,CHAR,WORD); 08030100 2( X( Y( Z( CI:=CI+F; 08030320 GO LOOKING; GO FOUND; GO BETWEEN; GO TAIL; GO FINISH; 08030330 LOOKING: %************ LOOKING FOR THE FIRST UNIQUE STRING**************08030340 - IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; F:= TALLY ; 08030350 + IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; F:=TALLY ; 08030350 DI:=NEWLINE; GO BETWEEN END ELSE 08030360 IF N SC=DC THEN BEGIN SI:=OLDLINE; SI:=SI+N; OLDLINE:=SI; 08030370 DI:=NEWLINE; SI:=BCHR; TALLY:=1; F:=TALLY; 08030380 GO FOUND END ELSE 08030382 BEGIN SI:=OLDLINE; DI:=NEWLINE; DS:=CHR; NEWLINE:=DI; 08030390 - OLDLINE:=SI; SI:=BCHR; DI:=OLDLINE; 08030400 + OLDLINE:=SI; SI:=BCHR; DI:=OLDLINE 08030400 END; GO OVER; 08030410 FOUND: %**************FOUND THE FIRST UNIQUE STRING ******************08030420 IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; 08030430 F:=TALLY; GO BETWEEN END ELSE 08030432 DS:=CHR; GO OVER; 08030440 -BETWEEN: % ********** BETWEEN THEN // *********************************08030450 +BETWEEN: % ********** BETWEEN THE // **********************************08030450 IF SC=DELIM THEN BEGIN SI:=SI+1; NEWLINE:=DI; DI:=OLDLINE; 08030460 TALLY:=3; F:=TALLY; GO TAIL END ELSE 08030470 IF SC="~" THEN BEGIN TALLY:=4; F:=TALLY; 08030480 @@ -6671,12 +6671,12 @@ TAIL: % ******* THE TAIL END OF THE COMMAND ***************************08030500 F:=TALLY; GO FINISH END ELSE 08030520 BEGIN SI:=SI-M; DI:=DI-M; DI:=DI+1; OLDLINE:=DI; END; 08030530 GO OVER; 08030540 -FINISH: % ********FINISH UP THE CHAR MOVE FROM OLD TO NEW*************08030550 +FINISH: % ********FINISH UP THE CHR MOVE FROM THE OLD TO NEW**********08030550 DS:=CHR; OVER:))); 08030560 TALLY:=CHAR; X:=TALLY; TALLY:=1; Y:=TALLY; 08030562 Z:=TALLY); 08030564 SI:=NEW; DI:=OLD; DS:=WORD WDS; TALLY:=1; 08030570 - WITHINLINE:=TALLY; 08030580 + WITHINLINE:=TALLY 08030580 END 08030590 END 08030600 END OF WITHINALINE; 08030610 @@ -6746,9 +6746,9 @@ INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; INTEGER PT, 09016000 INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; 09018000 INTEGER PT,SQ; REAL SEQ; ARRAY B[0]; FORWARD; 09019000 PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE, 09019100 - ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0]; 09019200 - FORWARD; COMMENT THIS IS A PHONEY DEAL, BUT I CAN"T 09019300 - DECLARE CLEANBUFFER FORWARD (MOVE IT UP HERE LATER); 09019400 + ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0]; 09019200 + FORWARD; COMMENT THIS IS A PHONEY DEAL, BUT I CAN"T 09019300 + DECLARE CLEANBUFFER FORWARD (MOVE IT UP HERE LATER); 09019400 PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K; 09020000 INTEGER PT,SQ,I,K; 09021000 BEGIN ARRAY C,LAB[0:1],OLD,NEW[0:MAXBUFFSIZE]; 09022000 @@ -6779,7 +6779,7 @@ PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K; 09020000 STOREORD(PT,LAB,L+M-1) 09046000 END END; 09047000 A:=A+B; K:=K+B; 09048000 - COMMENT THE NEXT LINE CAUSE A SYSTEM CRASH AFTER THE EDIT; 09048500 + COMMENT THE NEXT LINE CAUSED A SYSTEM CRASH AFTER THE EDIT 09048500 IF NOSYNTAX=0 THEN PROCESS(XEQUTE); 09049000 END END; 09050000 MOVE(NEW,MAXBUFFSIZE+1,BUFFER) 09051000 @@ -6829,7 +6829,7 @@ INTEGER PROCEDURE DISPLAY(A,B,PT,SQ); VALUE A,B,PT,SQ; 09053000 FORMWD(3,"1 "); 09072200 END ELSE % LISTING A SET OF LINES 09072300 BEGIN MODE:=DISPLAYING; 09072400 - LOWER:=I; UPPER:=K; 09072500 + LOWER:=I; UPPER:=K 09072500 END; 09072600 END; 09081000 EOB:=1; 09082000 @@ -6840,7 +6840,7 @@ INTEGER PROCEDURE DELETE(A,B,PT,SQ); VALUE A,B; 09084000 BEGIN 09087000 INTEGER I,J,K,L; 09088000 ARRAY C[0:1]; 09089000 - A:=LINENUMBER(B); 09090000 + A:=LINENUMBER(A); 09090000 B:=LINENUMBER(B); 09091000 C[0]:=A; 09092000 IF SEARCHORD(PT,C,K,8)=2 THEN K:=K+1; 09093000 @@ -6913,7 +6913,7 @@ INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; 09131000 SEARCHORD(PT,C,J,8)NEQ 0 ) THEN 09159000 BEGIN I:=I+1; FUNCSIZE:=FUNCSIZE+1; 09160000 STOREORD(PT,LAB,L+J-1); 09161000 - END; 09162000 + END 09162000 END; 09163000 C[1]:=K; 09164000 C[0]:=SEQ; 09165000 @@ -6942,7 +6942,7 @@ INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; 09131000 BEGIN ACCUM[0]:=U; 09188000 ADDRESS:=T; 09189000 END; 09190000 - END ELSE BEGIN ACCUM[0]:=U; ADDRESS:=T; 09191000 + END ELSE BEGIN ACCUM[0]:=U; ADDRESS:=T 09191000 END; 09192000 EOB:=0; 09193000 END 09194000 @@ -6978,7 +6978,7 @@ INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; 09131000 END ELSE 09219000 BEGIN TSI:=SI; SI:=SI-1; DI:=LOC U; DS:=CHR; 09220000 DI:=TDI; SI:=LOC U; DS:=CHR; TDI:=DI; DI:=LOC T; 09221000 - SI:=TSI; 09222000 + SI:=TSI 09222000 END)) 09223000 END; 09224000 PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE, 09224100 @@ -7005,7 +7005,7 @@ COMMENT DETERMINE WHETHER OR NOT WE CAME FROM CALCULATOR MODE; 09225000 FUNCSEQ:=GETFIELD(GTA,FSQF,FFL); 09226500 GT3:=CURLINE:=TOPLINE(FPT); 09226600 CHECKSEQ(CURLINE,GT3,INC); %SET THE INCREMENT 09226700 - COMMENT THE CURRENT LINE IS SET TO THE LAST LINE OF THE 09226800 + COMMENT THE CURRENTLINE IS SET TO THE LAST LINE OF THE 09226800 FUNCTION; 09226900 FUNCSIZE:=SIZE(FPT); 09226910 CURLINE:=CURLINE+INC; 09226920 @@ -7014,7 +7014,7 @@ COMMENT DETERMINE WHETHER OR NOT WE CAME FROM CALCULATOR MODE; 09225000 %------------------REDEFINING THE HEADER OF A DEFINED FUNCTION---- 09227100 GO TO FORGETITFELLA 09227200 ELSE 09227300 -%--------------------NAME NOT FOUND IN DIRECTORY, SET UP 09227400 +%--------------------NAME NOT FOUND IN THE DIRECTORY, SET UP 09227400 HEADERSTORE: 09227410 BEGIN COMMENT GET THE HEADER TO INSERT AT LINE 0; 09227500 ARRAY OLDBUFFER[0:MAXBUFFSIZE]; 09227510 @@ -7027,7 +7027,7 @@ HEADERSTORE: 09227410 FUNCTION. 09227546 A[2] = NUMBER OF ARGUMENTS TO THE FUNCTION. 09227550 A[3] = NUMBER OF LOCALS + RESULT +ARGUMENTS. 09227554 - A[4]....A[N] ARE ALL OF THE LOCALS, RESULT, AND ARGUMENTS. 09227558 + A[4],...A[N] ARE ALL OF THE LOCALS, RESULT, AND ARGUMENTS. 09227558 THE RESULT IS FIRST, THEN THE SECOND ARGUMENT, THEN 09227562 THE FIRST ARGUMENT, FOLLOWED BY THE LOCALS. ALL 09227566 ARE OF THE FORM 0XXXXXXX; 09227570 @@ -7065,7 +7065,7 @@ HEADERSTORE: 09227410 COMMENT GET THE "TYPE" OF THE FUNCTION LATER WHEN THERE 09228210 IS A PLACE FOR IT. THE TYPE IS EITHER 1 (FUNCTION CALL), OR 09228220 0 (SUBROUTINE CALL); 09228230 - END; 09228300 + END 09228300 %-------------------------------------------------------- 09228400 END ELSE % VARAIBLES=0, MAKE UP A DIRECTORY 09228500 BEGIN GT3:=0; GT2:=1; GO TO HEADERSTORE 09228600 @@ -7128,13 +7128,13 @@ HEADERSTORE: 09227410 END; 09231600 GO TO ENDHANDLER 09231700 END; 09231800 - END ; % OF BLOCK STARTED ON LINE 9225115 ////////////////// 09232000 + END ; %OF BLOCK STARTED ON LINE 9225115 /////////////////// 09232000 09233000 09234000 09235000 IF ERR=0 AND EOB=0 THEN 09236000 09237000 -SHORTCUT: BEGIN LABEL RGTBRACK,DELOPTION; %////////////////////////// 09238000 +SHORTCUT: BEGIN LABEL RGTBRACK,DELOPTION; %/////////////////////// 09238000 IF DELV THEN FINISHUP ELSE 09239000 IF LFTBRACKET THEN 09240000 BEGIN 09241000 @@ -7219,7 +7219,7 @@ DELOPTION: 09279000 BEGIN MODE:=RESEQUENCING; CURLINE:=INCREMENT:=1; 09314350 SETFIELD(GTA,0,8,0); 09314400 GT1:=SEARCHORD(FPT,GTA,GT2,8); 09314410 - LOWER:=GT2+1; UPPER:=FUNCSIZE-1; 09314420 + LOWER:=GT2+1; UPPER:=FUNCSIZE-1 09314420 END 09314500 END 09314600 ELSE ERR:=14 09314700 @@ -7259,7 +7259,7 @@ INITIALIZETABLE; 09333000 TRYAGAIN: 09334000 IF FALSE THEN %ENTERS WITH A FAULT. 09334100 FAULTL: 09334200 - BEGIN SPOUT(09334300); %SEND MESSAGE TO SPO 09334300 + BEGIN SPOUT(09334300); %SEND A MESSAGE TO SPO 09334300 09334400 BEGIN CSTATION.APLOGGED:=0; CSTATION.APLHEADING:=0 09334500 END 09334600 @@ -7271,4 +7271,4 @@ ENDOFJOB: 09336000 WRAPUP; 09339000 09340000 END. 09341000 -END;END. LAST CARD ON 0CRDING TAPE 99999999 +END;END. LAST CARD ON 0CRDING TAPE 99999999 diff --git a/APL-WU-Kildall/APLPTCH.19710305.alg_m b/APL-WU-Kildall/APLPTCH.19710305.alg_m new file mode 100644 index 0000000..aa94b6f --- /dev/null +++ b/APL-WU-Kildall/APLPTCH.19710305.alg_m @@ -0,0 +1,6 @@ +DEFINE VERSIONDATE="3-05-71 "#; 00000600 +FILE TWXIN 19(2,30),TWXOUT 19(2,9); 00001415 + FILL JIGGLE[*] WITH OCT3636363636363636; %RUB OUTS 00101430 +$ 00106100 + WRITE(TWXOUT[STOP],1,JIGGLE[*])[BREAKKEY:BREAKKEY]; 03905206 + GO TO ERR1 ELSE; 08017232 diff --git a/APL-WU-Kildall/APLPTCH.L200014.alg_m b/APL-WU-Kildall/APLPTCH.L200014.alg_m new file mode 100644 index 0000000..227d600 --- /dev/null +++ b/APL-WU-Kildall/APLPTCH.L200014.alg_m @@ -0,0 +1,6 @@ +$VOID 00040201 00040200 +$VOID 00101431 00101430 +$VOID 00232701 00232000 +$VOID 00241001 00241000 + ;LINETOG:=FALSE;TERPRINT;LINETOG:=TRUE; 00286100 +$VOID 03905208 03905216 diff --git a/APL-WU-Kildall/README.txt b/APL-WU-Kildall/README.txt index ca2e1ff..d7f8e75 100644 --- a/APL-WU-Kildall/README.txt +++ b/APL-WU-Kildall/README.txt @@ -1,21 +1,76 @@ APL\B5500 APL interpreter for the Burroughs B5500, written by Gary Kildall (of -CP/M fame), Leroy Smith, Sally Swedine, and Mary Zosel at Washington -University (Seattle, Washington, US) in the early 1970s. This version +CP/M fame), Leroy Smith, Sally Swedine, and Mary Zosel at the University +of Washington (Seattle, Washington US) in the early 1970s. This version was modified by Jose Hernandez of Burroughs Corporation for operation -under the Timesharing MCP. +under the standard Burroughs Timesharing MCP (TSSMCP). APL-IMAGE.alg_m - The source of the APL interpreter. This was transcribed from a - photocopy of a listing donated by Ed Vandergriff of Chaska, - Minnesota, US. According to Ed, this listing probably originated - from the Georgia Institute of Technology (Georgia Tech) in Atlanta, - Georgia, US. + The source of the APL interpreter, written in Burroughs B5500 + Extended Algol, dated "1-11-71" (1971-01-11) in the source. This was + transcribed from a photocopy of a listing sent to Paul Kimpel by Ed + Vandergriff of Chaska, Minnesota US. According to Ed: + + "Originally this came from a long-ago colleague, George P. + Williams (then of Huntsville, AL [Alabama US]) who shared my + interests in computer architecture and language implementation; + if I recall correctly he encountered it as a student at Georgia + Tech." + + A scan of that listing is available from: + http://bitsavers.trailing-edge.com/pdf/georgiaTech/APL-B5500-Listing + -19710111.pdf Transcription was performed jointly by Hans Pufal of Angouleme, France and Fausto Saporito of Naples, Italy during August-September 2013. Proofreading, corrections, and application of original - sequence numbers was done in late 2016 by Richard Cornwell of - Durham, North Carolina US. + sequence numbers (the last digits of which are often obscured on the + listing) was done in late 2016 by Richard Cornwell of Durham, North + Carolina US. + + In May 2018, three CUBE (Burroughs user organization) Library tapes + were successfully read by the Computer History Museum in Mountain + View, California US, and made available to a few B5500 enthusiasts. + On the CUBEA13 tape is the file APL/L200013 (creation date + 1971-03-08), which appears to be a slightly later version of the + program, dated 1971-03-05 in the source. Paul Kimpel of San Diego, + California US used this machine-readable version to correct left- + margin indentation, last digits of sequence numbers, and numerous + typographical errors that had escaped detection during proofreading. + +APL-IMAGE-List.lst + Compilation listing of APL-IMAGE.alg_m. This was compiled using Mark + XIII Algol using the following deck: + + ?COMPILE 0APL/DISK ALGOL LIBRARY + ?ALGOL STACK=1000 + ?ALGOL FILE NEWTAPE=NEWSYM/APL SERIAL + ?DATA CARD + $CARD LIST SINGLE NEW +