From cd52c25aa3e967acfe87fdbc45ee41a4418d9597 Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Mon, 14 Oct 2013 14:53:37 +0000 Subject: [PATCH] Commit additional transcription for B5500 APL by Hans Pufal as of 2013-10-13. --- source/APL/IMAGE.alg_m | 9655 ++++++++++++++++++++++------------------ 1 file changed, 5404 insertions(+), 4251 deletions(-) diff --git a/source/APL/IMAGE.alg_m b/source/APL/IMAGE.alg_m index 9728913..d26fef2 100644 --- a/source/APL/IMAGE.alg_m +++ b/source/APL/IMAGE.alg_m @@ -1,4334 +1,5487 @@ -BEGIN 00000490 -% THIS APL/B5500 PROGRAM WAS DEVELOPED BY THE COMPUTER SCIENCE GROUP -% AT THE UNIVERSITY OF WASHINGTON UNDER THE SPONSORSHIP OF PROFESSOR -% HELLMUT GOLDE. THE PROGRAM MAY BE NOT BE OFFERED FOR SALE OR LEASE -% IN ITS ORIGINAL OR ANY MODIFIED FORM. ANY PUBLICATION RELATING TO +BEGIN 00000490P01 +% THIS APL/B5500 PROGRAM WAS DEVELOPED BY THE COMPUTER SCIENCE GROUP +% AT THE UNIVERSITY OF WASHINGTON UNDER THE SPONSORSHIP OF PROFESSOR +% HELLMUT GOLDE. THE PROGRAM MAY BE NOT BE OFFERED FOR SALE OR LEASE +% IN ITS ORIGINAL OR ANY MODIFIED FORM. ANY PUBLICATION RELATING TO % THIS PROGRAM OR ANY MODIFICATION OF THE PROGRAM MUST EXPLICITLY CREDIT -% THE COMPUTER SCIENCE GROUP OF THE UNIVERSITY OF WASHINGTON AND THE -% PRINCIPAL IMPLEMENTORS, GARY KILDALL, LEROY SMITH, SALLY SWEDINE, -% AND MARY ZOSEL. COMPUTER RESOURCES FOR THE DEVELOPMENT OF THE -% PROGRAM WERE MADE AVAILABLE BY THE UNIVERSITY OF WASHINGTON COMPUTER -% CENTER. -DEFINE VERSIONDATE="1-11-71"# ; -%MODIFICATIONS FOR B-5500 TIME-SHARING MCP MADE BY: -% JOSE HERNANDEZ, BURROUGHS CORPORATION. -BOOLEAN BREAKFLAG; -ARRAY GIA[0:1]; -LABEL FINIS; %GO THERE WHEN YOU ARE IN TROUBLE (SPOUT A MESSAGE) -BOOLEAN PROCEDURE LIBRARIAN(A,B); VALUE A,B: REAL A,B; FORWARD; -LABEL FAULTL; % FAULT LABEL -MONITOR EXPOVR,INTOVR,INDEX:=INDEXF,FLAG,ZERO; -REAL BIGGEST, NULLV; -INTEGER STACKSIZE,LIBSIZE; - REAL STATUSWORD,CORELOC; - BOOLEAN RETURN; -BOOLEAN MEMBUG,DEBUG; -COMMENT MEMBUG SWITCHES ---------------------- - BIT FUNCTION BIT FUNCTION ------------------------------------------------------------------ - 1 25 - 2 26 - 3 27 - 4 28 - 5 DUMP TYPES @ INSERT 30 - 6 DUMP TYPES @ DELETE 30 - 7 31 - 8 32 - 9 33 - 10 34 - 11 35 - 12 36 - 13 37 - 14 38 - 15 39 - 16 40 - 17 41 - 18 42 - 19 43 - 20 DUMP INDEX 44 - 21 45 - 22 DUMP TYPES 46 - 23 CHECK TYPES 47 - 24 DUMP BUFFER #S - ; -FILE PRINT 4 "SYSTEMS" " BOX " (1,15); -FILE TWXIN 19(2,30),TWXOUT 19(2,10); -% -DEFINE - PAGESIZE=120#, - AREASIZE=40#, - CF=[26:13]#, COMMENT COUNT FIELD -- NUMBER OF ITEMS ON PAGE; - TF=[39:9] #, COMMENT T-FIELD (TYPE FIELD); - FF=[9:1]#, COMMENT FULL FIELD FOR SEQUENTIAL STORAGE; - AF=[1:23] #, COMMENT A-FIELD; - BF=[24:23]#, COMMENT B-FIELD; - MF=[1:1]#, COMMENT METHOD OF STORAGE FIELD; - SF=[13:13]#, COMMENT SEQUENTIAL STORAGE SIZE FIELD (#CHRS); - BOOL=[47:1]#, - SKIP=1#, COMMENT --AMOUNT OF SPACE RESERVED AT THE - START OF EACH PAGE; - ALLOWANCE=10#, COMMENT --DEVIATION FROM THE AVERAGE PAGE SIZE - ALLOWED BEFORE CORRECTION; 00001550 - RECSIZE=2#, - MAXPAGES=20#, - PAGESPACE=20#, - NEXTP=[42:6]#, - LASTP=[36:6]#, - PAGEF=[19:11]#, - BUFF=[12:6]#, - CHANGEDBIT=[1:1]#, - MBUFF=8#, - SBUFF=4#, - FLAGB=[18:1]#, COMMENT FLAG BIT FOR BUFFER MAINTENANCE; - EXTRAROOM=1#, - LIBJOB="/APLIBE"#,%MFID FOR APL SYSTEM FILE - ENDOFDEFINES=#; -REAL PROCEDURE CDR(X); VALUE X; REAL X; CDR:=X.NEXTP; -PROCEDURE RPLACD(X,Y); VALUE Y;REAL X,Y; X.NEXTP:=Y; -BOOLEAN PROCEDURE NULL(X); VALUE X; REAL X; NULL:=X.NEXTP=0; -BOOLEAN STREAM PROCEDURE EOFMARK(SK,RS,A); VALUE SK,RS; - BEGIN LABEL NO; SI:=A; SK(SI:=SI+8); - RS(8( 2(IF SB THEN JUMP OUT 3 TO NO; SKIP SB); - 3(IF SB THEN SKIP SB ELSE JUMP OUT 3 TO NO); IF SB THEN - JUMP OUT 2 TO NO; SKIP SB));TALLY:=1;EOFMARK:=TALLY; - NO: - END; -STREAM PROCEDURE MARKEOF(SK,RS,A); VALUE SK,RS; - BEGIN DI:=A; - SK(DI:=DI+8); - RS(8(DS:=2RESET; DS:=3SET; DS:=RESET)); - END; -SAVE FILE ESTABLISH DISK [MAXPAGES:AREASIZE] - (1,PAGESIZE,SAVE 100); -FILE NEWDISK DISK (1,PAGESIZE); -FILE DISK1 DISK (1,PAGESIZE), - DISK2 DISK (1,PAGESIZE), - DISK3 DISK (1,PAGESIZE), - DISK4 DISK (1,PAGESIZE), - DISK5 DISK (1,PAGESIZE), - DISK6 DISK (1,PAGESIZE), - DISK7 DISK (1,PAGESIZE), - DISK8 DISK (1,PAGESIZE); -SWITCH FILE POINTERS:=DISK1,DISK1,DISK2,DISK3,DISK4,DISK5,DISK6,DISK7, - DISK8; -PROCEDURE SETPOINTERNAMES; - BEGIN - IF NOT LIBRARIAN(LIBJOB,TIME(-1)) THEN - BEGIN - WRITE(ESTABLISH); - MARKEOF(SKIP,RECSIZE,ESTABLISH(0)); - WRITE(ESTABLISH[1]); +% THE COMPUTER SCIENCE GROUP OF THE UNIVERSITY OF WASHINGTON AND THE +% PRINCIPAL IMPLEMENTORS, GARY KILDALL, LEROY SMITH, SALLY SWEDINE, +% AND MARY ZOSEL. COMPUTER RESOURCES FOR THE DEVELOPMENT OF THE +% PROGRAM WERE MADE AVAILABLE BY THE UNIVERSITY OF WASHINGTON COMPUTER +% CENTER. +DEFINE VERSIONDATE="1-11-71"# ; +%MODIFICATIONS FOR B-5500 TIME-SHARING MCP MADE BY: +% JOSE HERNANDEZ, BURROUGHS CORPORATION. +BOOLEAN BREAKFLAG; +ARRAY GIA[0:1]; +LABEL FINIS; %GO THERE WHEN YOU ARE IN TROUBLE (SPOUT A MESSAGE) +BOOLEAN PROCEDURE LIBRARIAN(A,B); VALUE A,B: REAL A,B; FORWARD; +LABEL FAULTL; % FAULT LABEL +MONITOR EXPOVR,INTOVR,INDEX:=INDEXF,FLAG,ZERO; +REAL BIGGEST, NULLV; +INTEGER STACKSIZE,LIBSIZE; + REAL STATUSWORD,CORELOC; + BOOLEAN RETURN; +BOOLEAN MEMBUG,DEBUG; +COMMENT MEMBUG SWITCHES ---------------------- + BIT FUNCTION BIT FUNCTION +----------------------------------------------------------------- + 1 25 + 2 26 + 3 27 + 4 28 + 5 DUMP TYPES @ INSERT 30 + 6 DUMP TYPES @ DELETE 30 + 7 31 + 8 32 + 9 33 + 10 34 + 11 35 + 12 36 + 13 37 + 14 38 + 15 39 + 16 40 + 17 41 + 18 42 + 19 43 + 20 DUMP INDEX 44 + 21 45 + 22 DUMP TYPES 46 + 23 CHECK TYPES 47 + 24 DUMP BUFFER #S + ; +FILE PRINT 4 "SYSTEMS" " BOX " (1,15); +FILE TWXIN 19(2,30),TWXOUT 19(2,10); +% +DEFINE + PAGESIZE=120#, + AREASIZE=40#, + CF=[26:13]#, COMMENT COUNT FIELD -- NUMBER OF ITEMS ON PAGE; + TF=[39:9] #, COMMENT T-FIELD (TYPE FIELD); + FF=[9:1]#, COMMENT FULL FIELD FOR SEQUENTIAL STORAGE; + AF=[1:23] #, COMMENT A-FIELD; + BF=[24:23]#, COMMENT B-FIELD; + MF=[1:1]#, COMMENT METHOD OF STORAGE FIELD; + SF=[13:13]#, COMMENT SEQUENTIAL STORAGE SIZE FIELD (#CHRS); + BOOL=[47:1]#, + SKIP=1#, COMMENT --AMOUNT OF SPACE RESERVED AT THE + START OF EACH PAGE; + ALLOWANCE=10#, COMMENT --DEVIATION FROM THE AVERAGE PAGE SIZE + ALLOWED BEFORE CORRECTION; 00001550P02 + RECSIZE=2#, + MAXPAGES=20#, + PAGESPACE=20#, + NEXTP=[42:6]#, + LASTP=[36:6]#, + PAGEF=[19:11]#, + BUFF=[12:6]#, + CHANGEDBIT=[1:1]#, + MBUFF=8#, + SBUFF=4#, + FLAGB=[18:1]#, COMMENT FLAG BIT FOR BUFFER MAINTENANCE; + EXTRAROOM=1#, + LIBJOB="/APLIBE"#,%MFID FOR APL SYSTEM FILE + ENDOFDEFINES=#; +REAL PROCEDURE CDR(X); VALUE X; REAL X; CDR:=X.NEXTP; +PROCEDURE RPLACD(X,Y); VALUE Y;REAL X,Y; X.NEXTP:=Y; +BOOLEAN PROCEDURE NULL(X); VALUE X; REAL X; NULL:=X.NEXTP=0; +BOOLEAN STREAM PROCEDURE EOFMARK(SK,RS,A); VALUE SK,RS; + BEGIN LABEL NO; SI:=A; SK(SI:=SI+8); + RS(8( 2(IF SB THEN JUMP OUT 3 TO NO; SKIP SB); + 3(IF SB THEN SKIP SB ELSE JUMP OUT 3 TO NO); IF SB THEN + JUMP OUT 2 TO NO; SKIP SB));TALLY:=1;EOFMARK:=TALLY; + NO: + END; +STREAM PROCEDURE MARKEOF(SK,RS,A); VALUE SK,RS; + BEGIN DI:=A; + SK(DI:=DI+8); + RS(8(DS:=2RESET; DS:=3SET; DS:=RESET)); + END; +SAVE FILE ESTABLISH DISK [MAXPAGES:AREASIZE] + (1,PAGESIZE,SAVE 100); +FILE NEWDISK DISK (1,PAGESIZE); +FILE DISK1 DISK (1,PAGESIZE), + DISK2 DISK (1,PAGESIZE), + DISK3 DISK (1,PAGESIZE), + DISK4 DISK (1,PAGESIZE), + DISK5 DISK (1,PAGESIZE), + DISK6 DISK (1,PAGESIZE), + DISK7 DISK (1,PAGESIZE), + DISK8 DISK (1,PAGESIZE); +SWITCH FILE POINTERS:=DISK1,DISK1,DISK2,DISK3,DISK4,DISK5,DISK6,DISK7, + DISK8; +PROCEDURE SETPOINTERNAMES; + BEGIN + IF NOT LIBRARIAN(LIBJOB,TIME(-1)) THEN + BEGIN + WRITE(ESTABLISH); + MARKEOF(SKIP,RECSIZE,ESTABLISH(0)); + WRITE(ESTABLISH[1]); WRITE(ESTABLISH[MAXPAGES|AREASIZE-1]); - LOCK(ESTABLISH); - CLOSE(ESTABLISH) + LOCK(ESTABLISH); + CLOSE(ESTABLISH) ;LIBSIZE~-1; - END - END; -DEFINE - LIBMAINTENANCE=0#, - MESSDUM=#; - PROCEDURE MEMORY(MODE,TYPE,A,N,M);VALUE MODE,TYPE; - INTEGER MODE,TYPE,N,M; ARRAY A[0]; FORWARD; -STREAM PROCEDURE MOVE(A,N,B); VALUE N; - BEGIN SI:=A; DI:=B; DS:=N WDS; - END; -PROCEDURE MESSAGE(I); VALUE I; INTEGER I; - BEGIN - FORMAT F("MEMORY ERROR",I5); -COMMENT CHANGE LINE 3050 TO WRITE(PRINT,SF[I]) FOR MEMORY ERROR PROBS. - THIS FORMAT IS NOW EXCLUDED SINCE MEMORY IS SEEMINGLY WELL DEBUGED - SWITCH FORMAT SF:= - ("LIBRARY MAINTENANCE IN PROGRESS."), - ("SYSTEM ERROR--MEMORY ACCESS WITH EXPRESSION FOR N OR M."), - ("SYSTEM ERROR--IMPROPER ARGUMENTS TO FREEPAGE."), - ("SYSTEM ERROR--TOO LARGE A SUBSCRIPT FOR TYPE SPECIFIED."), - ("SYSTEM ERROR--TYPE CANNOT BE ZERO WHEN INSERTING OR DELETING."), - ("SYSTEM ERROR--CHARACTER STTRING TOO LONG TO STORE."), - ("SYSTEM ERROR--ATTEMPT TO INSERT NON-SEQUENTIAL ELEMENT", - "IN TYPE A STORAGE."), - ("SYSTEM ERROR--NO BLANKS IN PAGES."), - ("SYSTEM ERROR--ATTEMPTED BINARY SEARCH OF UNORDERED DATA."), - ("SYSTEM ERROR--BINARY SEARCH OF UNALLOCATED DATA ATTEMPTED."), - ("SYSTEM ERROR--BINARY SEARCH FOUND A BLANK PAGE."), - ("SYSTEM ERROR--DELETION OF TYPE B STORAGE NOT IMPLEMENTED."), - ("SYSTEM ERROR--ATTEMPT TO DELETE FROM NON-EXISTENT STORAGE."), 00002970 - ("SYSTEM ERROR--ATTEMPT TO DELETE RECORD FROM OUTSIDE", - " ALLOCATED STORAGE."), - ("SYSTEM ERROR--ATTEMPTED MEMORY SEARCH WITH -N- TOO LARGE."), - ("SYSTEM ERROR--ATTEMPT TO CHANGE PREVIOUSLY DEIGNATED STORAGE", - " KIND"), - ("SYSTEM ERROR--POINTERS TO DATA TYPES OVERLAP."), - (" "); - WRITE(PRINT,F,I); - IF I GTR 0 THEN - BEGIN - INTEGER GT1,GT2,GT3; - MEMORY(10,GT1,GIA,GT2,GT3); - GO TO FINIS; - END; - END; -PROCEDURE MEMORY(MODE,TYPE,A,N,M); VALUE MODE,TYPE; - INTEGER MODE,TYPE,N,M; ARRAY A[0]; - BEGIN -DEFINE T64= DI:=LOC T; DI:=DI+1; DS:=7 CHR#; -STREAM PROCEDURE WRITERECS(PAGE,A,SKP,NB,NR,NS,RL); - VALUE SKP,NB,NR,NS,RL; - BEGIN - COMMENT -- NS IS THE NUMBER OF WORDS TO SAVE (ON THE - TAIL OF THE PAGE); - LOCAL T,T1,T2,TT; - COMMENT -- MOVE TO POSITION FOR WRITE; - SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8); - T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8)); - T1:=SI; COMMENT -- RECORDS WILL BE WRITTEN HERE; - DI:=LOC TT; SI:=LOC NS; DI:=DI+1; DS:=7CHR; - SI:=T1; COMMENT MOVE TO THE END OF THE FIELD TO BE SAVED; - TT(2(32(RL(SI:=SI+8)))); NS(RL(SI:=SI+8)); - T2:=SI; COMMENT -- END OF FIELD TO BE SAVED; - SI:=LOC NR; T64; DI:=T2; - T(2(32(RL(DI:=DI+8)))); NR(RL(DI:=DI+8)); - SI:=T2; SI:=SI-8; DI:=DI-8; - TT(2(32(RL(DS:=WDS; SI:=SI-16); DI:=DI-16)))); - NS(RL(DS:=WDS; SI:=SI-16; DI:=DI-16)); - COMMENT -- HAVE ACCOMPLISHED THE "SAVE", NOW DO THE WRITE; - SI:=A; DI:=T1; - T(2(32(DS:=RL WDS))); NR(DS:=RL WDS) - END; -STREAM PROCEDURE READRECS(PAGE,A,SKP,NB,NR,NM,RL); - VALUE SKP,NB,NR,NM,RL; - BEGIN - COMMENT - SKP = "SKIP" - - THE NUMBER OF WORDS TO JUMP OVER - NB = "NUMBER BEFORE" -- " " RECORDS TO SKIP BEFORE - READING THE RECORD, - NR = "NUMBER OF RECORDS" " " " " READ FROM THE - BUFFER, - NM ="NUMBER TO MOVE" - - " " " " MOVE OVER TO - THE PREVIOUSLY READ AREA, - RL ="RECORD LENGTH" - - THE LENGTH OF EACH ITEM - ; - LOCAL T,T1,T2; - SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8); - T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8)); - T1:=SI; - COMMENT - - T1 NOW HAS THE STARTING POSITION FOR THE READ; - SI:=LOC NR; T64; SI:=T1; DI:=A; - T(2(32(DS:=RL WDS))); NR(DS:=RL WDS); - T2:=SI; COMMENT T2 CONTAINS THE END OF THE READ; - SI:=LOC NM; T64; SI:=T2; DI:=T1; - T(2(32(DS:=RL WDS))); NM(DS:=RL WDS) - END READRECS; -DEFINE MOVEALOG= - DI:=LOC C; DI:=DI+6; DS:=2CHR; DI:=LOC Z; - TSI:=SI; TALLY:=TALLY+1; - IF TOGGLE THEN - BEGIN SI:=LOC C; SI:=SI+6; - IF 2 SC NEQ DC THEN - BEGIN TAL:=TALLY; SI:=LOC TAL; SI:=SI+7; - IF SC="0" THEN - BEGIN TALLY:=TMP; TALLY:=TALLY+1; TMP:=TALLY; - TALLY:=0; - END ELSE - BEGIN SI:=LOC Z; IF SC LEQ"9" THEN ; - END - END ELSE - BEGIN DI:=TDI; SI:=LOC SIZE; SI:=SI+6; DS:=2CHR; - TDI:=DI; SI:=SI-2; DI:=LOC C64; DI:=DI+7 ; DS:=CHR; 00003750 - SI:=NEW; DI:=TDI; C64(2(DS:=32CHR)); DS:=SIZE CHR; - TDI:=DI; SI:=TSI; DI:=LOC C; DI:=DI+6; - DS:=2CHR; TSI:=SI; - TALLY:=TAL;CHRSTORE:=TALLY; SI:=LOC TMP; SI:=SI+7; - DI:=LOC CHRSTORE; DI:=DI+6; DS:=CHR END - END; - SI:=LOC C; DI:=LOC C64; DI:=DI+1; DS:=7CHR; DI:=TDI; SI:=SI-1; - DS:=2CHR; SI:=TSI; - C64(2(DS:=32CHR)); DS:=C CHR; TDI:=DI; TSI:=SI#; -INTEGER STREAM PROCEDURE CHRSTORE(A,SKP,B,NEW,NB,SIZE,NA,MODE, - PAGESIZE); VALUE SKP,NB,SIZE,NA,MODE,PAGESIZE; - BEGIN LOCAL T,C,TSI,TDI, - Z,C64,TMP,TAL; - LABEL DONE; - SI:=LOC NB; T64; - SI:=LOC MODE; SI:=SI+7; - IF SC="0" THEN ; COMMENT SET TOGGLE; - SI:=A; DI:=B; SKP(DS:=8CHR); - TSI:=SI; TDI:=DI; - T(2(32(MOVEALONG))); NB(MOVEALONG); - COMMENT NOW HAVE MOVED UP TO NB; - IF TOGGLE THEN - BEGIN TALLY:=TAL; CHRSTORE:=TALLY; SI:=LOC TMP; SI:=SI+7; - DI:=LOC CHRSTORE; DI:=DI+6; DS:=CHR; - SI:=LOC SIZE; SI:=SI+6; DI:=TDI; DS:=2CHR; TDI:=DI; - SI:=LOC SIZE; DI:=LOC C64; DI:=DI+1; DS:=7CHR; SI:=NEW; - DI:=TDI; C64(2(DS:=32CHR)); DS:=SIZE CHR; - END ELSE - BEGIN TSI:=SI; TDI:=DI; - SI:=LOC MODE; SI:=SI+7; - IF SC="1" THEN - COMMENT REMOVE AN ENTRY HERE; - BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR; - TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C; - DS:=7CHR; SI:=TSI; C64(2(SI:=SI+32)); SI:=SI+C; - TSI:=SI; DI:=LOC CHRSTORE; SI:=LOC C; DS:=WDS; - DI:=TDI; DS:=2LIT"0"; TDI:=DI; - END ELSE - IF SC="2" THEN - COMMENT READ OUT AND ENTRY - BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR; - TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C; - DS:=7CHR; SI:=TSI; DI:=NEW; - C64(2(DS:=32CHR)); DS:=C CHR; - SI:=LOC C; DI:=LOC CHRSTORE; DS:=WDS; GO DONE END; - SI:=LOC NA; T64; SI:=TSI; DI:=TDI; - T(2(32(TDI:=DI; DI:=LOC C; DI:=DI+6; DS:=2CHR; - TSI:=SI; SI:=LOC C; DI:=LOC C64; DI:=DI+1; DS:=7CHR; - SI:=SI-1;DT:=TDI;DS:=2CHR;SI:=TSI;C64(2(DS:=32CHR));DS:=C CHR))); - NA( TDI:=DI; DI:=LOC C; DI:=DI+6; DS:=2CHR; TSI:=SI; - SI:=LOC C;DI:=LOC C64;DI:=DI+1;DS:=7CHR;SI:=SI-1; - DI:=TDI;DS:=2CHR;SI:=TSI;C64(2(DS:=32CHR));DS:=C CHR); - END; - SI:=LOC PAGESIZE; T64; SI:=B; DI:=A; -%CARD LIST UNSAFE -COMMENT $CARD LIST UNSAFE; - T(2(DS:=32WDS)); DS:=PAGESIZE WDS; -%CARD LIST SAFE -COMMENT $CARD LIST SAFE; - DONE: - END; -STREAM PROCEDURE SETNTH(P,K,N); VALUE K,N; - BEGIN DI:=P; SI:=LOC K; N(DI:=DI+8); DS:=WDS END; -BOOLEAN STREAM PROCEDURE LESS(A,AN,B,BN,K); VALUE K,AN,BN; - BEGIN - SI:=A; DI:=B; SI:=SI+AN; DI:=DI+BN; - IF K SC LSS DC THEN TALLY:=1; - LESS:=TALLY; - END; -REAL STREAM PROCEDURE ADDD(A,B); VALUE A,B; - BEGIN SI:=LOC A; DI:=LOC B; DS:=8ADD; SI:=LOC B; - DI:=LOC ADDD; DS:=WDS - END; -INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH); - VALUE TYPEZERO,START,FINISH; INTEGER TYPEZERO,START,FINISH; - ARRAY INDEX[0,0]; - IF START GTR FINISH THEN MESSAGE(2) ELSE - BEGIN ARRAY T[0:RECSIZE+EXTRAROOM+SKIP-1],P[0:FINISH-START]; - INTEGER T,J,K,R; - R:=RECSIZE+EXTRAROOM+SKIP; - J:=START-(FINISH+1); - FOR I:=FINISH STEP -1 UNTIL TYPEZERO DO - IF K:=(I+J) LESS TYPEZERO THEN 00004690 - BEGIN T[R-1]:=P[TYPEZERO-K-1]; - MOVE(T,R,INDEX[I,0]) - END ELSE - BEGIN IF I GEQ START THEN P[FINISH-I]:=INDEX[I,R-1]; - MOVE(INDEX[K,0],R,INDEX[I,0]); - END; - FREEPAGE:=TYPEZERO-J; - END; - INTEGER PROCEDURE SEARCH(A,B,N,MIN,MAX,NP); VALUE N,MIN,MAX; - INTEGER N,MIN,MAX,NP; - ARRAY A[0,0]; REAL B; - BEGIN - INTEGER I,T; - FOR I:=MIN STEP 1 WHILE T:=T+A[I,0].CF LEQ B AND I LESS MAX-1 DO; - IF T LSS B THEN - BEGIN MESSAGE(3); SEARCHL:=NP:=0; - END ELSE - BEGIN SEARCHL:=I; NP:=B-T+A[I,0].CF - END - END; - PROCEDURE SORT(A,P,N,C); VALUE P,N,C; INTEGER P,N,C; - ARRAY A[0,0]; - BEGIN INTEGER R; - BEGIN - ARRAY T[0:R:=RECSIZE+EXTRAROOM+SKIP-1]; - LABEL ENDJ; - INTEGER I,J,L,K,M,SK; R:=R+1; - SK:=SKIP TIMES 8; - K:=N-P+1; I:=1; DO UNTIL (I:=I TIMES 2) GTR K; - M:=I-1; - WHILE (M:=M DIV 2) NEQ 0 DO - BEGIN K:=N-M; J:=P; - DO BEGIN - L:=(I:=J)+M; - DO BEGIN - IF A[L,0].TF GTR A[I,0].TF THEN GO ENDJ; - IF A[L,0].TF EQL A[I,0].TF THEN - IF NOT(LESS(A[L,0],SK,A[I,0],SK,C)) THEN - GO ENDJ; - MOVE(A[L,0],R,T); MOVE(A[I,0],R,A[L,0]); - MOVE(T,R,A[I,0]) - END UNTIL (I:=(L:=I)-M) LSS P; - ENDJ: - END UNTIL (J:=J+1) GTR K; - END - END - END SORT; - COMMENT - - - - - - - - - - - - - - - - - - - - - - - - - - - MODE MEANING - ---- ------- - 1 = INTERROGATE TYPE - 2 = INSERT RECORD REL ADDRS N - (RELATIVE TO START OF LAST PAGE) - 3 = RETURN THE NUMBER OF RECORDS (M) - 4 = " ITEM AT RECORD # N - 5 = INSERT " " " " " - 6 = DELETE " " " " " - 7 = SEARCH FOR THE RECORD -A- - 8 = FILE OVERFLOW, INCREASE BY N - 9 = FILE MAINTENANCE - 10 = EMERGENCY FILE MAINTENANCE - 11 SET STORAGE KIND - 12= ALTER STORAGE ALLOCATION RESOURCES - 13= RELEASE "TYPE" STORAGE TO SYSTEM - 14= CLOSE ALL PAGES FOR AREA TRANSITION - NOTE THAT WHEN SEQUENTIAL STORAGE MAINTENANCE IS DONE, N - WILL ALWAYS INDICATE THE ADDRESS OF THE STRING RELATIVE TO - THE TYPE SPECIFIED, AND M WILL ALWAYS BE THE LENGTH OF THE - STRING IN -A- (EITHER AS INPUT OR OUTPUT) - ; - PROCEDURE UPDATE(T,L,U,D); VALUE L,U,D; INTEGER L,U,D; - ARRAY T[0]; - BEGIN INTEGER I,J,K; - FOR I:=L STEP 1 UNTIL U DO - BEGIN J:=T[I].AF+D; T[I].AF:=J; - J:=T[I].BF+D; T[I].BF:=J - END - END; - OWN INTEGER CURPAGE,NPAGES,NTYPES,P,PS,U,L; - OWN INTEGER FIRST,AVAIL,MAXBUFF,CURBUFF; - REAL GT1; - LABEL MOREPAGES; - COMMENT - IF MEMBUG.[21:1] THEN DUMPMEMORY(MODE,TYPE,N,M); 00005620 - IF MODE=8 THEN NPAGES:=NPAGES+N; - MOREPAGES: - BEGIN - OWN BOOLEAN POINTERSET, TYPESET; - INTEGER I, T, NR; - OWN ARRAY BUF[0:MBUFF], TYPS[0:511]; - OWN ARRAY INDX[0:NPAGES,0:RECSIZE+EXTRAROOM+SKIP-1]; - PROCEDURE SETTYPES; - BEGIN INTEGER I, T; - FOR I := 0 STEP 1 UNTIL NPAGES DO - IF INDX[I,0].TF NEQ T THEN - BEGIN - TYPS[T].BF := I; TYPS[T:=INDX[I,0].TF].AF := I; - TYPS[T].BOOL := INDX[I,0].MF; - END; - TYPS[T].BF := I; - END SETTYPES; - REAL PROCEDURE BUFFNUMBER(I); VALUE I; INTEGER I; - BEGIN INTEGER K,L,M; - LABEL D; - DEFINE B=BUF#; - IF( IF K:=INDX[I,P].BUFF=0 THEN TRUE ELSE BUF[K].PAGEF - NEQ INDX[I,P].PAGEF+1) THEN - BEGIN IF NULL(K:=CDR(AVAIL)) THEN - BEGIN K:=CDR(FIRST); - WHILE M:=CDR(B[K]) NEQ 0 DO - BEGIN L:=K; K:=M; END; - RPLACD(B[L],0); - IF BOOLEAN(B[K].CHANGEDBIT) THEN - WRITE(POINTERS[K][B[K].PAGEF-1]); - B[K].CHANGEDBIT:=0; - END ELSE RPLACD(AVAIL,CDR(B[K])); - B[K].PAGEF:=INDX[I,P].PAGEF+1; - INDX[I,P].BUFF:=K; - READ(POINTERS[K][INDX[I,P].PAGEF]); - END ELSE - IF CDR(FIRST)=K THEN GO TO D ELSE - BEGIN L:=CDR(FIRST); - WHILE M:=CDR(B[L]) NEQ K DO L:=M; - RPLACD(B[L],CDR(B[M])); - END; - RPLACD(B[K],CDR(FIRST)); RPLACD(FIRST,K); - B: BUFFNUMBER:=K - END; - PROCEDURE MARK(I); VALUE I; INTEGER I; - BUF[INDX[I,P].BUFF].CHANGEDBIT:=1; - BOOLEAN PROCEDURE WRITEBUFFER; - BEGIN INTEGER I; - I:=CDR(FIRST); - WHILE NOT NULL(I) DO - IF BOOLEAN(BUF[I].CHANGEDBIT) THEN - BEGIN WRITEBUFFER:=TRUE; - BUF[I].CHANGEDBIT:=0; - WRITE(POINTERS[I][BUF[I].PAGEF-1]); - RPLACD(I,0); - END ELSE I:=CDR(BUF[I]); - END; - IF NOT POINTERSET THEN - BEGIN LABEL EOF; - READ(POINTERS[1][NPAGES])[EOF]; - IF EOFMARK(SKIP,RECSIZE,POINTERS[1](0))THEN GO TO EOF; - MOVE(POINTERS[1](0),1,T); - COMMENT -- USE T TO DETERMIN THE VARIABLE REC SIZE LATER; - MOVE(POINTERS[1](0),RECSIZE+SKIP,INDX[NPAGES,0]); - INDX[NPAGES,RECSIZE+1].PAGEF:=NPAGES; - NPAGES:=NPAGES+1; - GO TO MOREPAGES; - COMMENT - - INITIALIZE VARIABLES; - EOF: POINTERSET:=TRUE; - U:=PAGESIZE-SKIP-PAGESPACE; - L:=(U-ALLOWANCE)/RECSIZE; - U:=(U+ALLOWANCE+RECSIZE/2)/RECSIZE; - PS:=(U+L)/2; - CURPAGE:=NPAGES:=NPAGES-1; - CURBUFF:=1; - P:=RECSIZE+SKIP; - FOR T:=1 STEP 1 UNTIL SBUFF DO RPLACD(BUF[T],T+1); - RPLACD(BUF[SBUFF],0); RPLACD(AVAIL,1); - MAXBUFF:=SBUFF; - T:=0; - SORT(INDX,0,NPAGES,RECSIZE TIMES 8); - FOR I:=0 STEP 1 UNTIL NPAGES DO 00006370 - IF INDX[I,0].TF GTR T THEN T:=INDX[I,0].TF; - NTYPES:=T; - END; - IF TYPE GTR NTYPES THEN NTYPES:=TYPE; - IF NOT TYPESET THEN - BEGIN TYPESET:=TRUE; SETTYPES; - COMMENT - IF MEMBUG THEN DUMPINDEX(TYPS,NTYPES,INDX,RECSIZE, - P); - END; - COMMENT --- DECIDE WHETHER TO SAVE CURRENT PAGE BEFORE GOING ON; - IF MODE=2 THEN - BEGIN MODE:=5; NR:=N - END ELSE - IF MODE GEQ 4 THEN %MAY BE FILE MAINTENANCE - IF MODE GEQ 8 THEN %IS FILE MAINTENANCE - ELSE %WE MAY BE GOING TO - IF MODE NEQ 7 THEN %ANOTHER PAGE - BEGIN - IF TYPE=0 THEN BEGIN MESSAGE(4); MODE:=0 END ELSE - IF TYPS[TYPE].AF=TYPS[TYPE].BF THEN - IF TYPS[0].BF GTR 0 THEN - BEGIN INTEGER J,K; REAL PG; - K:=TYPS[0].BF-1; TYPS[0].BF:=K; PG:=INDX[K,P]; - FOR I:=1 STEP 1 UNTIL TYPE-1 DO - IF (T:=TYPS[I]).AF NEQ T.BF THEN - BEGIN FOR K:=T.AF STEP 1 UNTIL T.BF -1 DO - MOVE(INDX[K,0]),P+EXTRAROOM,INDX[K-1,0]); - TYPS[I].AF:=T.AF-1; TYPS[I].BF:=K:=T.BF-1 - END; - IF CURPAGE GTR TYPS[0].BF THEN - IF CURPAGE LEQ K THEN CURPAGE:=CURPAGE-1; - TYPS[TYPE].BF:=K+1; TYPS[TYPE].AF:=K; - INDX[K,P]:=PG; INDX[K,0]:=0; INDX[K,0].TF:=TYPE; - IF TYPS[TYPE].BOOL=1 THEN - BEGIN SETNTH(INDX[K,0],0,1); INDX[K,0].MF:=1 - END; - COMMENT - IF MEMBUG.[22:1] THEN DUMPTYPES(MODE,TYPS,NTYPES); - MEMORY(MODE,TYPE,A,N,M); MODE:=0 - END ELSE + END + END; +DEFINE + LIBMAINTENANCE=0#, + MESSDUM=#; + PROCEDURE MEMORY(MODE,TYPE,A,N,M);VALUE MODE,TYPE; + INTEGER MODE,TYPE,N,M; ARRAY A[0]; FORWARD; +STREAM PROCEDURE MOVE(A,N,B); VALUE N; + BEGIN SI:=A; DI:=B; DS:=N WDS; + END; +PROCEDURE MESSAGE(I); VALUE I; INTEGER I; + BEGIN + FORMAT F("MEMORY ERROR",I5); +COMMENT CHANGE LINE 3050 TO WRITE(PRINT,SF[I]) FOR MEMORY ERROR PROBS. + THIS FORMAT IS NOW EXCLUDED SINCE MEMORY IS SEEMINGLY WELL DEBUGED + SWITCH FORMAT SF:= + ("LIBRARY MAINTENANCE IN PROGRESS."), + ("SYSTEM ERROR--MEMORY ACCESS WITH EXPRESSION FOR N OR M."), + ("SYSTEM ERROR--IMPROPER ARGUMENTS TO FREEPAGE."), + ("SYSTEM ERROR--TOO LARGE A SUBSCRIPT FOR TYPE SPECIFIED."), + ("SYSTEM ERROR--TYPE CANNOT BE ZERO WHEN INSERTING OR DELETING."), + ("SYSTEM ERROR--CHARACTER STTRING TOO LONG TO STORE."), + ("SYSTEM ERROR--ATTEMPT TO INSERT NON-SEQUENTIAL ELEMENT", + "IN TYPE A STORAGE."), + ("SYSTEM ERROR--NO BLANKS IN PAGES."), + ("SYSTEM ERROR--ATTEMPTED BINARY SEARCH OF UNORDERED DATA."), + ("SYSTEM ERROR--BINARY SEARCH OF UNALLOCATED DATA ATTEMPTED."), + ("SYSTEM ERROR--BINARY SEARCH FOUND A BLANK PAGE."), + ("SYSTEM ERROR--DELETION OF TYPE B STORAGE NOT IMPLEMENTED."), + ("SYSTEM ERROR--ATTEMPT TO DELETE FROM NON-EXISTENT STORAGE."), 00002970P03 + ("SYSTEM ERROR--ATTEMPT TO DELETE RECORD FROM OUTSIDE", + " ALLOCATED STORAGE."), + ("SYSTEM ERROR--ATTEMPTED MEMORY SEARCH WITH -N- TOO LARGE."), + ("SYSTEM ERROR--ATTEMPT TO CHANGE PREVIOUSLY DESIGNATED STORAGE", + " KIND"), + ("SYSTEM ERROR--POINTERS TO DATA TYPES OVERLAP."), + (" "); + WRITE(PRINT,F,I); + IF I GTR 0 THEN + BEGIN + INTEGER GT1,GT2,GT3; + MEMORY(10,GT1,GIA,GT2,GT3); + GO TO FINIS; + END; + END; +PROCEDURE MEMORY(MODE,TYPE,A,N,M); VALUE MODE,TYPE; + INTEGER MODE,TYPE,N,M; ARRAY A[0]; + BEGIN +DEFINE T64= DI:=LOC T; DI:=DI+1; DS:=7 CHR#; +STREAM PROCEDURE WRITERECS(PAGE,A,SKP,NB,NR,NS,RL); + VALUE SKP,NB,NR,NS,RL; + BEGIN + COMMENT -- NS IS THE NUMBER OF WORDS TO SAVE (ON THE + TAIL OF THE PAGE); + LOCAL T,T1,T2,TT; + COMMENT -- MOVE TO POSITION FOR WRITE; + SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8); + T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8)); + T1:=SI; COMMENT -- RECORDS WILL BE WRITTEN HERE; + DI:=LOC TT; SI:=LOC NS; DI:=DI+1; DS:=7CHR; + SI:=T1; COMMENT MOVE TO THE END OF THE FIELD TO BE SAVED; + TT(2(32(RL(SI:=SI+8)))); NS(RL(SI:=SI+8)); + T2:=SI; COMMENT -- END OF FIELD TO BE SAVED; + SI:=LOC NR; T64; DI:=T2; + T(2(32(RL(DI:=DI+8)))); NR(RL(DI:=DI+8)); + SI:=T2; SI:=SI-8; DI:=DI-8; + TT(2(32(RL(DS:=WDS; SI:=SI-16); DI:=DI-16)))); + NS(RL(DS:=WDS; SI:=SI-16; DI:=DI-16)); + COMMENT -- HAVE ACCOMPLISHED THE "SAVE", NOW DO THE WRITE; + SI:=A; DI:=T1; + T(2(32(DS:=RL WDS))); NR(DS:=RL WDS) + END; +STREAM PROCEDURE READRECS(PAGE,A,SKP,NB,NR,NM,RL); + VALUE SKP,NB,NR,NM,RL; + BEGIN + COMMENT + SKP = "SKIP" - - THE NUMBER OF WORDS TO JUMP OVER + NB = "NUMBER BEFORE" -- " " RECORDS TO SKIP BEFORE + READING THE RECORD, + NR = "NUMBER OF RECORDS" " " " " READ FROM THE + BUFFER, + NM ="NUMBER TO MOVE" - - " " " " MOVE OVER TO + THE PREVIOUSLY READ AREA, + RL ="RECORD LENGTH" - - THE LENGTH OF EACH ITEM + ; + LOCAL T,T1,T2; + SI:=LOC NB; T64; SI:=PAGE; SKP(SI:=SI+8); + T(2(32(RL(SI:=SI+8)))); NB(RL(SI:=SI+8)); + T1:=SI; + COMMENT - - T1 NOW HAS THE STARTING POSITION FOR THE READ; + SI:=LOC NR; T64; SI:=T1; DI:=A; + T(2(32(DS:=RL WDS))); NR(DS:=RL WDS); + T2:=SI; COMMENT T2 CONTAINS THE END OF THE READ; + SI:=LOC NM; T64; SI:=T2; DI:=T1; + T(2(32(DS:=RL WDS))); NM(DS:=RL WDS) + END READRECS; +DEFINE MOVEALOG= + DI:=LOC C; DI:=DI+6; DS:=2CHR; DI:=LOC Z; + TSI:=SI; TALLY:=TALLY+1; + IF TOGGLE THEN + BEGIN SI:=LOC C; SI:=SI+6; + IF 2 SC NEQ DC THEN + BEGIN TAL:=TALLY; SI:=LOC TAL; SI:=SI+7; + IF SC="0" THEN + BEGIN TALLY:=TMP; TALLY:=TALLY+1; TMP:=TALLY; + TALLY:=0; + END ELSE + BEGIN SI:=LOC Z; IF SC LEQ"9" THEN ; + END + END ELSE + BEGIN DI:=TDI; SI:=LOC SIZE; SI:=SI+6; DS:=2CHR; + TDI:=DI; SI:=SI-2; DI:=LOC C64; DI:=DI+7 ; DS:=CHR; 00003750P04 + SI:=NEW; DI:=TDI; C64(2(DS:=32CHR)); DS:=SIZE CHR; + TDI:=DI; SI:=TSI; DI:=LOC C; DI:=DI+6; + DS:=2CHR; TSI:=SI; + TALLY:=TAL;CHRSTORE:=TALLY; SI:=LOC TMP; SI:=SI+7; + DI:=LOC CHRSTORE; DI:=DI+6; DS:=CHR END + END; + SI:=LOC C; DI:=LOC C64; DI:=DI+1; DS:=7CHR; DI:=TDI; SI:=SI-1; + DS:=2CHR; SI:=TSI; + C64(2(DS:=32CHR)); DS:=C CHR; TDI:=DI; TSI:=SI#; +INTEGER STREAM PROCEDURE CHRSTORE(A,SKP,B,NEW,NB,SIZE,NA,MODE, + PAGESIZE); VALUE SKP,NB,SIZE,NA,MODE,PAGESIZE; + BEGIN LOCAL T,C,TSI,TDI, + Z,C64,TMP,TAL; + LABEL DONE; + SI:=LOC NB; T64; + SI:=LOC MODE; SI:=SI+7; + IF SC="0" THEN ; COMMENT SET TOGGLE; + SI:=A; DI:=B; SKP(DS:=8CHR); + TSI:=SI; TDI:=DI; + T(2(32(MOVEALONG))); NB(MOVEALONG); + COMMENT NOW HAVE MOVED UP TO NB; + IF TOGGLE THEN + BEGIN TALLY:=TAL; CHRSTORE:=TALLY; SI:=LOC TMP; SI:=SI+7; + DI:=LOC CHRSTORE; DI:=DI+6; DS:=CHR; + SI:=LOC SIZE; SI:=SI+6; DI:=TDI; DS:=2CHR; TDI:=DI; + SI:=LOC SIZE; DI:=LOC C64; DI:=DI+1; DS:=7CHR; SI:=NEW; + DI:=TDI; C64(2(DS:=32CHR)); DS:=SIZE CHR; + END ELSE + BEGIN TSI:=SI; TDI:=DI; + SI:=LOC MODE; SI:=SI+7; + IF SC="1" THEN + COMMENT REMOVE AN ENTRY HERE; + BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR; + TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C; + DS:=7CHR; SI:=TSI; C64(2(SI:=SI+32)); SI:=SI+C; + TSI:=SI; DI:=LOC CHRSTORE; SI:=LOC C; DS:=WDS; + DI:=TDI; DS:=2LIT"0"; TDI:=DI; + END ELSE + IF SC="2" THEN + COMMENT READ OUT AND ENTRY + BEGIN DI:=LOC C; DI:=DI+6; SI:=TSI; DS:=2CHR; + TSI:=SI; DI:=LOC C64; DI:=DI+1; SI:=LOC C; + DS:=7CHR; SI:=TSI; DI:=NEW; + C64(2(DS:=32CHR)); DS:=C CHR; + SI:=LOC C; DI:=LOC CHRSTORE; DS:=WDS; GO DONE END; + SI:=LOC NA; T64; SI:=TSI; DI:=TDI; + T(2(32(TDI:=DI; DI:=LOC C; DI:=DI+6; DS:=2CHR; + TSI:=SI; SI:=LOC C; DI:=LOC C64; DI:=DI+1; DS:=7CHR; + SI:=SI-1;DT:=TDI;DS:=2CHR;SI:=TSI;C64(2(DS:=32CHR));DS:=C CHR))); + NA( TDI:=DI; DI:=LOC C; DI:=DI+6; DS:=2CHR; TSI:=SI; + SI:=LOC C;DI:=LOC C64;DI:=DI+1;DS:=7CHR;SI:=SI-1; + DI:=TDI;DS:=2CHR;SI:=TSI;C64(2(DS:=32CHR));DS:=C CHR); + END; + SI:=LOC PAGESIZE; T64; SI:=B; DI:=A; +%CARD LIST UNSAFE +COMMENT $CARD LIST UNSAFE; + T(2(DS:=32WDS)); DS:=PAGESIZE WDS; +%CARD LIST SAFE +COMMENT $CARD LIST SAFE; + DONE: + END; +STREAM PROCEDURE SETNTH(P,K,N); VALUE K,N; + BEGIN DI:=P; SI:=LOC K; N(DI:=DI+8); DS:=WDS END; +BOOLEAN STREAM PROCEDURE LESS(A,AN,B,BN,K); VALUE K,AN,BN; + BEGIN + SI:=A; DI:=B; SI:=SI+AN; DI:=DI+BN; + IF K SC LSS DC THEN TALLY:=1; + LESS:=TALLY; + END; +REAL STREAM PROCEDURE ADDD(A,B); VALUE A,B; + BEGIN SI:=LOC A; DI:=LOC B; DS:=8ADD; SI:=LOC B; + DI:=LOC ADDD; DS:=WDS + END; +INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH); + VALUE TYPEZERO,START,FINISH; INTEGER TYPEZERO,START,FINISH; + ARRAY INDEX[0,0]; + IF START GTR FINISH THEN MESSAGE(2) ELSE + BEGIN ARRAY T[0:RECSIZE+EXTRAROOM+SKIP-1],P[0:FINISH-START]; + INTEGER T,J,K,R; + R:=RECSIZE+EXTRAROOM+SKIP; + J:=START-(FINISH+1); + FOR I:=FINISH STEP -1 UNTIL TYPEZERO DO + IF K:=(I+J) LESS TYPEZERO THEN 00004690P05 + BEGIN T[R-1]:=P[TYPEZERO-K-1]; + MOVE(T,R,INDEX[I,0]) + END ELSE + BEGIN IF I GEQ START THEN P[FINISH-I]:=INDEX[I,R-1]; + MOVE(INDEX[K,0],R,INDEX[I,0]); + END; + FREEPAGE:=TYPEZERO-J; + END; +INTEGER PROCEDURE SEARCH(A,B,N,MIN,MAX,NP); VALUE N,MIN,MAX; + INTEGER N,MIN,MAX,NP; + ARRAY A[0,0]; REAL B; + BEGIN + INTEGER I,T; + FOR I:=MIN STEP 1 WHILE T:=T+A[I,0].CF LEQ B AND I LESS MAX-1 DO; + IF T LSS B THEN + BEGIN MESSAGE(3); SEARCHL:=NP:=0; + END ELSE + BEGIN SEARCHL:=I; NP:=B-T+A[I,0].CF + END + END; +PROCEDURE SORT(A,P,N,C); VALUE P,N,C; INTEGER P,N,C; + ARRAY A[0,0]; + BEGIN INTEGER R; + BEGIN + ARRAY T[0:R:=RECSIZE+EXTRAROOM+SKIP-1]; + LABEL ENDJ; + INTEGER I,J,L,K,M,SK; R:=R+1; + SK:=SKIP TIMES 8; + K:=N-P+1; I:=1; DO UNTIL (I:=I TIMES 2) GTR K; + M:=I-1; + WHILE (M:=M DIV 2) NEQ 0 DO + BEGIN K:=N-M; J:=P; + DO BEGIN + L:=(I:=J)+M; + DO BEGIN + IF A[L,0].TF GTR A[I,0].TF THEN GO ENDJ; + IF A[L,0].TF EQL A[I,0].TF THEN + IF NOT(LESS(A[L,0],SK,A[I,0],SK,C)) THEN + GO ENDJ; + MOVE(A[L,0],R,T); MOVE(A[I,0],R,A[L,0]); + MOVE(T,R,A[I,0]) + END UNTIL (I:=(L:=I)-M) LSS P; + ENDJ: + END UNTIL (J:=J+1) GTR K; + END + END + END SORT; + COMMENT - - - - - - - - - - - - - - - - - - - - - - - - - - + MODE MEANING + ---- ------- + 1 = INTERROGATE TYPE + 2 = INSERT RECORD REL ADDRS N + (RELATIVE TO START OF LAST PAGE) + 3 = RETURN THE NUMBER OF RECORDS (M) + 4 = " ITEM AT RECORD # N + 5 = INSERT " " " " " + 6 = DELETE " " " " " + 7 = SEARCH FOR THE RECORD -A- + 8 = FILE OVERFLOW, INCREASE BY N + 9 = FILE MAINTENANCE + 10 = EMERGENCY FILE MAINTENANCE + 11 SET STORAGE KIND + 12= ALTER STORAGE ALLOCATION RESOURCES + 13= RELEASE "TYPE" STORAGE TO SYSTEM + 14= CLOSE ALL PAGES FOR AREA TRANSITION + NOTE THAT WHEN SEQUENTIAL STORAGE MAINTENANCE IS DONE, N + WILL ALWAYS INDICATE THE ADDRESS OF THE STRING RELATIVE TO + THE TYPE SPECIFIED, AND M WILL ALWAYS BE THE LENGTH OF THE + STRING IN -A- (EITHER AS INPUT OR OUTPUT) + ; + PROCEDURE UPDATE(T,L,U,D); VALUE L,U,D; INTEGER L,U,D; + ARRAY T[0]; + BEGIN INTEGER I,J,K; + FOR I:=L STEP 1 UNTIL U DO + BEGIN J:=T[I].AF+D; T[I].AF:=J; + J:=T[I].BF+D; T[I].BF:=J + END + END; + OWN INTEGER CURPAGE,NPAGES,NTYPES,P,PS,U,L; + OWN INTEGER FIRST,AVAIL,MAXBUFF,CURBUFF; +REAL GT1; +LABEL MOREPAGES; +COMMENT 00005615P06 +IF MEMBUG.[21:1] THEN DUMPMEMORY(MODE,TYPE,N,M); +IF MODE=8 THEN NPAGES:=NPAGES+N; +MOREPAGES: + BEGIN + OWN BOOLEAN POINTERSET, TYPESET; + INTEGER I, T, NR; + OWN ARRAY BUF[0:MBUFF], TYPS[0:511]; + OWN ARRAY INDX[0:NPAGES,0:RECSIZE+EXTRAROOM+SKIP-1]; + PROCEDURE SETTYPES; + BEGIN INTEGER I, T; + FOR I := 0 STEP 1 UNTIL NPAGES DO + IF INDX[I,0].TF NEQ T THEN + BEGIN + TYPS[T].BF := I; TYPS[T:=INDX[I,0].TF].AF := I; + TYPS[T].BOOL := INDX[I,0].MF; + END; + TYPS[T].BF := I; + END SETTYPES; + REAL PROCEDURE BUFFNUMBER(I); VALUE I; INTEGER I; + BEGIN INTEGER K,L,M; + LABEL D; + DEFINE B=BUF#; + IF( IF K:=INDX[I,P].BUFF=0 THEN TRUE ELSE BUF[K].PAGEF + NEQ INDX[I,P].PAGEF+1) THEN + BEGIN IF NULL(K:=CDR(AVAIL)) THEN + BEGIN K:=CDR(FIRST); + WHILE M:=CDR(B[K]) NEQ 0 DO + BEGIN L:=K; K:=M; END; + RPLACD(B[L],0); + IF BOOLEAN(B[K].CHANGEDBIT) THEN + WRITE(POINTERS[K][B[K].PAGEF-1]); + B[K].CHANGEDBIT:=0; + END ELSE RPLACD(AVAIL,CDR(B[K])); + B[K].PAGEF:=INDX[I,P].PAGEF+1; + INDX[I,P].BUFF:=K; + READ(POINTERS[K][INDX[I,P].PAGEF]); + END ELSE + IF CDR(FIRST)=K THEN GO TO D ELSE + BEGIN L:=CDR(FIRST); + WHILE M:=CDR(B[L]) NEQ K DO L:=M; + RPLACD(B[L],CDR(B[M])); + END; + RPLACD(B[K],CDR(FIRST)); RPLACD(FIRST,K); + B: BUFFNUMBER:=K + END; + PROCEDURE MARK(I); VALUE I; INTEGER I; + BUF[INDX[I,P].BUFF].CHANGEDBIT:=1; +BOOLEAN PROCEDURE WRITEBUFFER; + BEGIN INTEGER I; + I:=CDR(FIRST); + WHILE NOT NULL(I) DO + IF BOOLEAN(BUF[I].CHANGEDBIT) THEN + BEGIN WRITEBUFFER:=TRUE; + BUF[I].CHANGEDBIT:=0; + WRITE(POINTERS[I][BUF[I].PAGEF-1]); + RPLACD(I,0); + END ELSE I:=CDR(BUF[I]); + END; + IF NOT POINTERSET THEN + BEGIN LABEL EOF; + READ(POINTERS[1][NPAGES])[EOF]; + IF EOFMARK(SKIP,RECSIZE,POINTERS[1](0))THEN GO TO EOF; + MOVE(POINTERS[1](0),1,T); + COMMENT -- USE T TO DETERMIN THE VARIABLE REC SIZE LATER; + MOVE(POINTERS[1](0),RECSIZE+SKIP,INDX[NPAGES,0]); + INDX[NPAGES,RECSIZE+1].PAGEF:=NPAGES; + NPAGES:=NPAGES+1; + GO TO MOREPAGES; + COMMENT - - INITIALIZE VARIABLES; + EOF: POINTERSET:=TRUE; + U:=PAGESIZE-SKIP-PAGESPACE; + L:=(U-ALLOWANCE)/RECSIZE; + U:=(U+ALLOWANCE+RECSIZE/2)/RECSIZE; + PS:=(U+L)/2; + CURPAGE:=NPAGES:=NPAGES-1; + CURBUFF:=1; + P:=RECSIZE+SKIP; + FOR T:=1 STEP 1 UNTIL SBUFF DO RPLACD(BUF[T],T+1); + RPLACD(BUF[SBUFF],0); RPLACD(AVAIL,1); + MAXBUFF:=SBUFF; + T:=0; + SORT(INDX,0,NPAGES,RECSIZE TIMES 8); + FOR I:=0 STEP 1 UNTIL NPAGES DO 00006370P07 + IF INDX[I,0].TF GTR T THEN T:=INDX[I,0].TF; + NTYPES:=T; + END; + IF TYPE GTR NTYPES THEN NTYPES:=TYPE; + IF NOT TYPESET THEN + BEGIN TYPESET:=TRUE; SETTYPES; + COMMENT + IF MEMBUG THEN DUMPINDEX(TYPS,NTYPES,INDX,RECSIZE, + P); + END; + COMMENT --- DECIDE WHETHER TO SAVE CURRENT PAGE BEFORE GOING ON; + IF MODE=2 THEN + BEGIN MODE:=5; NR:=N + END ELSE + IF MODE GEQ 4 THEN %MAY BE FILE MAINTENANCE + IF MODE GEQ 8 THEN %IS FILE MAINTENANCE + ELSE %WE MAY BE GOING TO + IF MODE NEQ 7 THEN %ANOTHER PAGE + BEGIN + IF TYPE=0 THEN BEGIN MESSAGE(4); MODE:=0 END ELSE + IF TYPS[TYPE].AF=TYPS[TYPE].BF THEN + IF TYPS[0].BF GTR 0 THEN + BEGIN INTEGER J,K; REAL PG; + K:=TYPS[0].BF-1; TYPS[0].BF:=K; PG:=INDX[K,P]; + FOR I:=1 STEP 1 UNTIL TYPE-1 DO + IF (T:=TYPS[I]).AF NEQ T.BF THEN + BEGIN FOR K:=T.AF STEP 1 UNTIL T.BF -1 DO + MOVE(INDX[K,0]),P+EXTRAROOM,INDX[K-1,0]); + TYPS[I].AF:=T.AF-1; TYPS[I].BF:=K:=T.BF-1 + END; + IF CURPAGE GTR TYPS[0].BF THEN + IF CURPAGE LEQ K THEN CURPAGE:=CURPAGE-1; + TYPS[TYPE].BF:=K+1; TYPS[TYPE].AF:=K; + INDX[K,P]:=PG; INDX[K,0]:=0; INDX[K,0].TF:=TYPE; + IF TYPS[TYPE].BOOL=1 THEN + BEGIN SETNTH(INDX[K,0],0,1); INDX[K,0].MF:=1 + END; + COMMENT + IF MEMBUG.[22:1] THEN DUMPTYPES(MODE,TYPS,NTYPES); + MEMORY(MODE,TYPE,A,N,M); MODE:=0 + END ELSE BEGIN T:=1; MEMORY(8,TYPE,A,T,M); MEMORY(MODE,TYPE,A,N,M); - MODE:=0 - END ELSE - IF NOT( BOOLEAN(TYPS[TYPE].BOOL) AND MODE=5) THEN - CURBUFF:=BUFFNUMBER(CURPAGE:= - SEARCHL(INDX,N,NPAGES,TYPS[TYPE].AF,TYPS[TYPE].BF, - NR) ); - COMMENT - IF MEMBUG.[23:1] THEN CHECKTYPES(TYPS,NTYPES); - END; - COMMENT - IF MEMBUG.[20:1] THEN DUMPINDEX(TYPS,NTYPES,INDX,RECSIZE,P); - COMMENT - IF MEMBUG.[24:1] THEN DUMPBUFF(BUF,FIRST,AVAIL); - CASE MODE OF - BEGIN - %------- MODE=0 ------- RESERVED --------------- - ; + MODE:=0 + END ELSE + IF NOT( BOOLEAN(TYPS[TYPE].BOOL) AND MODE=5) THEN + CURBUFF:=BUFFNUMBER(CURPAGE:= + SEARCHL(INDX,N,NPAGES,TYPS[TYPE].AF,TYPS[TYPE].BF, + NR) ); + COMMENT + IF MEMBUG.[23:1] THEN CHECKTYPES(TYPS,NTYPES); + END; + COMMENT + IF MEMBUG.[20:1] THEN DUMPINDEX(TYPS,NTYPES,INDX,RECSIZE,P); + COMMENT + IF MEMBUG.[24:1] THEN DUMPBUFF(BUF,FIRST,AVAIL); + CASE MODE OF + BEGIN + %------- MODE=0 ------- RESERVED --------------- + ; %------- MODE=1 -------------------------------------------------- - IF M=0 THEN N:=TYPS[TYPE].BOOL ELSE - IF M=1 THEN - BEGIN FOR I:=1 STEP 1 UNTIL NTYPES DO - IF (T:=TYPS[I].AF=T.BF THEN - BEGIN N:=I; I:=NTYPES+1 - END; - IF I=NTYPES+1 THEN N:=NTYPES+1 - END; - %------- MODE=2 ------- RESERVED --------------- - ; - %------- MODE=3 ------- RETURN THE NUMBER OF RECORDS---- - BEGIN COMMENT IF TYPE LSS 0 THEN THE TOTAL NUMBER - OF PAGES IS GIVEN, OTHERWISE THE NUMBER OF "TYPE" PAGES IS - GIVEN; - FOR I:=0 STEP 1 UNTIL NPAGES DO - IF INDX[I,0].TF=TYPE OR TYPE LSS 0 THEN - NR:=NR+INDX[I,0].CF; - M:=NR - END; - %------- MODE=4 ------- RETURN ITEM AT SUBSCRIPT N ----- - IF NR GEQ INDX[CURPAGE,0].CF THEN MESSAGE(3) ELSE - IF BOOLEAN (TYPS[TYPE].BOOL) THEN COMMENT SEQUENTIAL STORAGE; - BEGIN ARRAY B[0:PAGESIZE]; 00007270 - M:=CHRSTORE(POINTERS[CURBUFF](0),2,B,A,NR,0,0,2,0); - END ELSE - BEGIN + IF M=0 THEN N:=TYPS[TYPE].BOOL ELSE + IF M=1 THEN + BEGIN FOR I:=1 STEP 1 UNTIL NTYPES DO + IF (T:=TYPS[I].AF=T.BF THEN + BEGIN N:=I; I:=NTYPES+1 + END; + IF I=NTYPES+1 THEN N:=NTYPES+1 + END; + %------- MODE=2 ------- RESERVED --------------- + ; + %------- MODE=3 ------- RETURN THE NUMBER OF RECORDS---- + BEGIN COMMENT IF TYPE LSS 0 THEN THE TOTAL NUMBER + OF PAGES IS GIVEN, OTHERWISE THE NUMBER OF "TYPE" PAGES IS + GIVEN; + FOR I:=0 STEP 1 UNTIL NPAGES DO + IF INDX[I,0].TF=TYPE OR TYPE LSS 0 THEN + NR:=NR+INDX[I,0].CF; + M:=NR + END; + %------- MODE=4 ------- RETURN ITEM AT SUBSCRIPT N ----- + IF NR GEQ INDX[CURPAGE,0].CF THEN MESSAGE(3) ELSE + IF BOOLEAN (TYPS[TYPE].BOOL) THEN COMMENT SEQUENTIAL STORAGE; + BEGIN ARRAY B[0:PAGESIZE]; 00007270P08 + M:=CHRSTORE(POINTERS[CURBUFF](0),2,B,A,NR,0,0,2,0); + END ELSE + BEGIN M:=RECSIZE|8; - READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,0,RECSIZE); - END; - %------- MODE=5 ------- INSERT ITEM AT SUBSCRIPT N; - BEGIN INTEGER K,J,S; REAL PG; - IF BOOLEAN(TYPS[TYPE].BOOL) THEN - COMMENT FIND A PLACE FOR THE CHARACTER STRING OF LENGTH - M; + READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,0,RECSIZE); + END; + %------- MODE=5 ------- INSERT ITEM AT SUBSCRIPT N; + BEGIN INTEGER K,J,S; REAL PG; + IF BOOLEAN(TYPS[TYPE].BOOL) THEN + COMMENT FIND A PLACE FOR THE CHARACTER STRING OF LENGTH + M; IF M GTR (PAGESIZE-SKIP-1)|8-2 THEN MESSAGE(5) COMMENT - THIS CHARACTER STRING IS TOO LONG ; ELSE - BEGIN ARRAY C[0:PAGESIZE]; - STREAM PROCEDURE ADDZERO(CHARS,POINTER); VALUE CHARS; - BEGIN LOCAL T; - SI:=LOC CHARS; DI:=LOC T; DI:=DI+1; DS:=7CHR; - DI:=POINTER; T(2(DI:=DI+32)); CHARS(DI:=DI+1); - DS:=2LIT"0"; - END; - BOOLEAN B,NOTLASTPAGE; - LABEL TRYITAGAIN; - TRYITAGAIN: - FOR I:=(T:=TYPS[TYPE]).AF STEP 1 WHILE I LSS T.BF AND - NOT B DO + THIS CHARACTER STRING IS TOO LONG ; ELSE + BEGIN ARRAY C[0:PAGESIZE]; + STREAM PROCEDURE ADDZERO(CHARS,POINTER); VALUE CHARS; + BEGIN LOCAL T; + SI:=LOC CHARS; DI:=LOC T; DI:=DI+1; DS:=7CHR; + DI:=POINTER; T(2(DI:=DI+32)); CHARS(DI:=DI+1); + DS:=2LIT"0"; + END; + BOOLEAN B,NOTLASTPAGE; + LABEL TRYITAGAIN; + TRYITAGAIN: + FOR I:=(T:=TYPS[TYPE]).AF STEP 1 WHILE I LSS T.BF AND + NOT B DO IF NOT(B:=((PAGESIZE-SKIP-1)|8-(GT1:=INDX[I,0]).SF)GEQ M+2 - AND NOT BOOLEAN(GT1.FF)) THEN S:=S+GT1.CF ELSE I:=I-1; - NOTLASTPAGE:=B AND I NEQ T.BF-1; - COMMENT IF B IS TRUE, THEN A PAGE HAS BEEN FOUND; - IF NOT B THEN COMMENT GET A PAGE THAT IS FREE; - BEGIN - COMMENT - IF MEMBUG.[5:1] THEN DUMPTYPES(5,1,TYPS,NTYPES); - IF TYPS[0].BF=0 THEN BEGIN K:=CURPAGE; T:=1; - MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1 - END - ELSE + AND NOT BOOLEAN(GT1.FF)) THEN S:=S+GT1.CF ELSE I:=I-1; + NOTLASTPAGE:=B AND I NEQ T.BF-1; + COMMENT IF B IS TRUE, THEN A PAGE HAS BEEN FOUND; + IF NOT B THEN COMMENT GET A PAGE THAT IS FREE; + BEGIN + COMMENT + IF MEMBUG.[5:1] THEN DUMPTYPES(5,1,TYPS,NTYPES); + IF TYPS[0].BF=0 THEN BEGIN K:=CURPAGE; T:=1; + MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1 + END + ELSE IF (PAGESIZE-SKIP-1)|8-INDX[(I:=I-1)-1,0].SF GTR 2 THEN - BEGIN - CURBUFF:=BUFFNUMBER(CURPAGE:=I-1); + BEGIN + CURBUFF:=BUFFNUMBER(CURPAGE:=I-1); ADDZERO((GT1:INDX[CURPAGE,0].SF)+8|(SKIP+1),POINTERS - [CURBUFF](0)); - INDX[CURPAGE,0].SF:=GT1+2; - INDX[CURPAGE,0].CF:=INDX[CURPAGE,0].CF+1; - COMMENT SINCE ALLOCATING A NEW PAGE, SET COUNT TO - ONE MORE AND FREEZE THE COUNT; - S:=S+1; % SINCE THE COUNT INCREASED - MOVE(INDX[CURPAGE,0],SKIP+1,POINTERS[CURBUFF](0)); - MARK(CURPAGE); - END; - T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1; - COMMENT T IS THE SUBSCRIPT INTO THE NEW PAGE; - PG:=INDX[T,P]; COMMENT PG HOLDS THE NEW PAGE #; - FOR K:=T+1 STEP 1 UNTIL I DO - MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]); - T:=TYPS[TYPE].AF; UPDATE(TYPS,1,TYPE-1,-1); - IF CURPAGE GTR TYPS[0].BF THEN IF CURPAGE LEQ - I THEN CURPAGE:=CURPAGE-1; - INDX[I,0]:=0; INDX[I,0].MF:=1; INDX[I,0].TF:=TYPE; - COMMENT MUST ALSO ASSIGN A NUMBER TO THIS PAGE - (TO BE STORED IN THE PAGE) TO KEEP IT IN SEQUENCE - WITHIN THIS TYPE; - IF (T:=TYPS[TYPE]).AF LSS T.BF-1 THEN - T:=INDX[T.BF-1,1] ELSE T:=0; - SETNTH(INDX[I,0],ADDD(1,T),1); - COMMENT END OF THE INITIALIZATION OF THE INDEX ARRAY, - WE STILL HAVE TO MAKE SOME ENTRIES INTO THE PAGE - WHICH WE WILL DO BELOW; - END OF TEST FOR NEW PAGE; - COMMENT I IS SET TO THE PROPER SUBSCRIPT FOR THE CHR STORE; - CURBUFF:=BUFFNUMBER(CURPAGE:=I); - COMMENT NOW THE CORRECT PAGE IS IN CORE. - ------------------------------ - M= NUMBER OF CHARACTERS IN A (ON INPUT) - N= ADDRESS OF A WITHIN IN THIS TYPE (ON OUTPUT - ------------------------------; - K:=INDX[I,0]; - T:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,C,A,K,CF,M,0,0, - PAGESIZE); - COMMENT K.CF IS THE NUMBER OF ITEMS ALREADY IN THIS - PAGE. IF THERE IS A SEGMENT WHICH IS NULL, IT WILL - BE FOUND AND ASSIGNED AS THE SEG NUMBER FOR 00007860 - THIS CHARACTER STRING (T). IF NOT, IT WILL STICK THE - STRING ON THE END (WE KNOW THERE IS ENOUGH ROOM - SINCE WE CHECKED INDX[I,0].SF -- THE NUMBER OF CHRS USED - IN THIS PAGE, OR WE CREATED A NEW PAGE); - N:=S+T; S:=K.SF; COMMENT S CONTAINS THE # OF CHRS USED UP; - IF T:=T+1 GTR K.CF THEN COMMENT ADDED THE STRING ON THE END; - IF NOTLASTPAGE THEN % PAGE ALREADY FULL - BEGIN S:=0; B:=FALSE; INDX[I,0].FF:=1; - MOVE(INDX[I,0],SKIP+1,POINTERS[CURBUFF](0)); - MARK(CURPAGE); GO TRYITAGAIN; END ELSE - BEGIN K.CF:=T; S:=S+2; - END - ELSE IF T=K.CF AND NOTLASTPAGE THEN INDX[I,0].FF:=1; - INDX[I,0].CF:=K.CF; INDX[I,0].SF:=S+M; - MOVE(INDX[I,0],SKIP+1,POINTERS[CURBUFF](0)); - MARK(CURPAGE); - COMMENT THE PAGE DESCRIPTOR HAS BEEN UPDATED; - COMMENT - IF MEMBUG.[5:1] THEN DUMPTYPES(5,2,TYPS,NTYPES); - END ELSE COMMENT KIND OF STORAGE IS SORTED; - IF NR GTR (T:=INDX[CURPAGE,0].CF) THEN - COMMENT SUBSCRIPT IS NOT IN THE MIDDLE OF THE PAGE; - MESSAGE(6) ELSE - BEGIN - IF T GEQ U THEN COMMENT WILL EXCEED UPPER PAGE BOUND; - BEGIN ARRAY B[0:RECSIZE TIMES - (T-PS+(I:=(IF NR GEQ PS THEN 0 ELSE 1)))-1]; - COMMENT B IS JUST BIG ENOUGH TO CARRY THE - EXCESS FROM THE OLD PAGE; - READRECS(POINTERS[CURBUFF](0),B,SKIP,PS-I, - J:=(T-PS+I),0,RECSIZE); - COMMENT -- B NOW HAS THE EXCESS; - INDX[CURPAGE,0].CF:=T-J; SETNTH(POINTERS[CURBUFF](0), - INDX[CURPAGE,0],0); - MARK(CURPAGE); - IF TYPS[0].BF=0 THEN - BEGIN K:=CURPAGE; T:=1; - MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1; - END; - COMMENT -- ASSIGN A FREE PAGE (SUBS T); - T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1; - - PG:=INDX[T,P]; - FOR K:=T+1 STEP 1 UNTIL CURPAGE DO - MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]); - INDX[CURPAGE,P]:=PG; - T:=0;T.CF:=J;T.TF:=TYPE; - CURBUFF:=BUFFNUMBER(CURPAGE); - WRITERECS(POINTERS[CURBUFF](0),B,SKIP,0,J,0,RECSIZE); - SETNTH(POINTERS[CURBUFF](0),T,0); - MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[CURPAGE,0]); - MARK(CURPAGE); - T:=TYPS[TYPE].AF; TYPS[TYPE].AF:=T-1; - UPDATE(TYPS,1,TYPE-1,-1); - IF J=0 THEN MESSAGE(7); - IF BOOLEAN (I) THEN - COMMENT I=0 IMPLIES THE RECORD GOES TO NEW PAGE, - I=1 IMPLIES THE RECORD GOES TO NOOLD PAGE; - BEGIN - T:=INDX[CURPAGE:=CURPAGE-1,0].CF; - CURBUFF:=BUFFNUMBER(CURPAGE); - ; COMMENT OLD PAGE IS NOW BACK; - END ELSE - BEGIN T:=J; NR:=NR-PS - END - END; - WRITERECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,T-NR,RECSIZE); - T:=INDX[CURPAGE,0].CF; INDX[CURPAGE,0].CF:=T+1; - SETNTH(POINTERS[CURBUFF](0),INDX[CURPAGE,0],0); - IF NR=0 THEN MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX - [CURPAGE,0]); MARK(CURPAGE); - END; - END; - %------- MODE=6 ------- DELETE A RECORD FROM THE FILE ---- - IF (T:=TYPS[TYPE].AF=T.BF THEN MESSAGE(12) COMMENT - ATTEMPT TO DELETE NON-EXISTENT STORAGE; - ELSE - IF NR GEQ(T:=INDX[CURPAGE,0].CF) THEN MESSAGE(13) COMMENT - ATTEMPT TO DELETE OUTSIDE STORAGE RANGE; ELSE - IF BOOLEAN(T.BOOL) THEN COMMENT SEQUENTIAL STORAGE; - BEGIN COMMENT NR IS THE RECORD TO DELETE; - ARRAY B[0:PAGESIZE-1]; 00008610 - COMMENT PAGESIZE -1 SHOULD BE COMPUTED TO THE EXACT - NUMBER OF WORDS TO MOVE -- IT WOULD SPEED THINGS UP; - INTEGER L; - T:=INDX[CURPAGE,0]; COMMENT T.CF IS THE NUMBER OF - RECORDS ON THIS PAGE, T.SF IS THE NUMBER OF CHRS; - L:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,B,A,NR,0,T.CF - -NR-1,1,PAGESIZE); - COMMENT WE WILL BRING BACK THE NUMBER OF CHRS IN M; - M:=L; - MARK(CURPAGE); - COMMENT MAKE CHANGES TO THE CHARACTER COUNT; - INDX[CURPAGE,0].SF:=T.SF-L; - INDX[CURPAGE,0].FF:=0; % PAGE IS CERTAINLY NOT FULL NOW - COMMENT AND WE ARE DONE WITH THE DELETION; - MOVE(INDX[CURPAGE,0],SKIP+1,POINTERS[CURBUFF](0)); - END - ELSE - BEGIN ARRAY A[0:RECSIZE-1]; - INDX[CURPAGE,0].CF:=I-1; - SETNTH(POINTERS[CURBUFF](0),INDX[CURPAGE,0],0); - IF I GTR 1 THEN - BEGIN - READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,I-NR-1,RECSIZE); - MARK(CURPAGE); - IF NR=0 THEN - MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[CURPAGE,0]) - END ELSE COMMENT FREE THE EMPTY PAGE; - BEGIN MARK(CURPAGE); - ;TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,CURPAGE,CURPAGE); - UPDATE(TYPS,1,TYPE-1,1); TYPS[TYPE].AF:=T.AF+1; - COMMENT - IF MEMBUG.[6:1] THEN DUMPTYPES(MODE,TYPS,NTYPES); - END - END; - %------- MODE=7 ------- SEARCH FOR A RECORD FROM THE FILE --- - IF N GTR 3 THEN MESSAGE(14) ELSE - COMMENT RETURN RECORD CLOSEST (BUT LESS THAN OR EQUAL TO) TO - THE CONTENT OF -A-. A WILL BE REPLACED BY THE RECORD FOUND; - IF BOOLEAN((I:=TYPS[TYPE].BOOL) THEN - MESSAGE(8) COMMENT BINARY SEARCH OF NON-SEQUENTIAL DATA; - ELSE - IF I.AF=I.BF THEN MESSAGE(9) COMMENT --NO STORAGE OF - THIS TYPE ALLOCATED AS YET; - ELSE BEGIN - INTEGER F,U,L; - ARRAY B[0:RECSIZE-1]; - U:=TYPS[TYPE].BF; L:=TYPS[TYPE].AF; - WHILE U-L GTR 1 DO - IF LESS(A,0,INDX[F:=(U+L) DIV 2,0],8,M) THEN U:=F ELSE L:=F; - CURBUFF:=BUFFNUMBER(CURPAGE:=L); - L:=0; U:=INDX[CURPAGE,0].CF; - IF L-U=0 THEN MESSAGE(10) COMMENT BINARY SEARCH FOUND - A PAGE WITH NO RECORDS; - ELSE BEGIN - WHILE U-L GTR 1 DO - BEGIN READRECS(POINTERS[CURBUFF](0),B,SKIP, - F:=(U+L) DIV 2,1,0,RECSIZE); - IF LESS(A,0,B,0,M) THEN U:=F ELSE L:=F - END; - COMMENT ----------------------------------- - ON INPUT: - N=0 IMPLIES DO NOT PLACE RECORD INTO FILE - IF RECORD IS FOUND. RETURN RELA- - TIVE POSITION OF THE CLOSEST RECORD - IN THIS PAGE. - N=1 " DO NO PLACE IN FILE. RETURN ABSO- - LUTE SUBSCRIPT OF CLOSSEST RECORD. - N=2 " PLACE RECORD INTO FILE IF NOT FOUND. - RETURN RELATIVE POSITION OF RECORD. - N=3 " PLACE RECORD INTO FILE, IF NOT - FOUND, RETURN ABS SUBSCRIPT OF - THE RECORD. - ON OUTPUT: - M=0 " RECORD FOUND WAS EQUAL TO RECORD - SOUGHT. - M=1 " RECORD FOUND WAS GREATER THAN THE - SOUGHT. - M=2 " RECORD FOUND WAS LESS THAN THE - RECORD SOUGHT. -; - READRECS(POINTERS[CURBUFF](0),B,SKIP,L,1,0,RECSIZE); - IF LESS(A,0,B,0,M) THEN M:=1 ELSE - IF LESS(B,0,A,0,M) THEN M:=2 ELSE 00009410 - M:=0; - T:=0; IF BOOLEAN(N) THEN - FOR I:=TYPS[TYPE].AF STEP 1 UNTIL CURPAGE-1 DO - T:=T+INDX[I,0].CF; - IF N GTR 1 THEN IF M GEQ 1 THEN - MEMORY(2,TYPE,A,L+M-1,NR); - MOVE(B,RECSIZE,A); - N:=T+L; - END - END; - %------- MODE=8 ------- FILE OVERFLOW, FIX ARRAYS AND PAGES - BEGIN BOOLEAN TOG; - ARRAY A[0:PAGESIZE-1]; T:=NPAGES-N+1; - IF TOG:=(T DIV AREASIZE) LSS (NPAGES DIV AREASIZE ) OR - (T=NPAGES AND T MOD AREASIZE =0) THEN - MEMORY(14,TYPE,A,N,M); - FOR I:=T STEP 1 UNTIL NPAGES DO - BEGIN WRITE(NEWDISK[I],PAGESIZE,A[*]);INDX[I,P].PAGEF:=I END; - MARKEOF(SKIP,RECSIZE,NEWDISK(0)); - WRITE(NEWDISK[I]); - TYPS[0].BF:=FREEPAGE(INDX,TYPS[0]).BF,T,NPAGES); - UPDATE(TYPS,1,NTYPES,NPAGES-T+1); - IF TOG THEN CLOSE(NEWDISK); - END; - %------- MODE=9 ------- FILE MAINTENANCE ------------------ - BEGIN BOOLEAN ITHPAGEIN; - INTEGER I,J,K,T1,T2,T3,M,W,Q; - ARRAY A,B[0:PAGESIZE-1]; - COMMENT - MONITOR PRINT(Q,W,N, I,J,K,T1,T2,T3,M,A,B); - IF I:=TYPS[0].BF LEQ NPAGES THEN - DO - BEGIN COMMENT OUTER "DO-LOOP" TO FIND TROUBLE WITH - THE FILE; - IF T1:=(Q:=INDX[I,0]).CF LSS L THEN COMMENT MAY BE CORRECTABLE; - IF NOT BOOLEAN((Q:=TYPS[Q.TF]).BOOL) THEN - COMMENT -- THIS PAGE IS CORRECTABLE; - IF I NEQ NPAGES THEN - COMMENT -- THIS IS NOT THE LAST PAGE OF THE FILE; - IF (J:=I+1) LSS Q.BF THEN - COMMENT -- THIS IS NOT THE LAST PAGE OF THIS TYPE; - BEGIN COMMENT -- FIND RECORDS TO MOVE INTO - THIS PAGE; - DO IF T2:=INDX[J,0].CF GTR 0 THEN - COMMENT THIS PAGE HAS RECS TO MOVE; - BEGIN COMMENT HOW MANY; - IF T2 LSS K:=PS-T1 THEN K:=T2; - IF NOT ITHPAGEIN THEN - BEGIN COMMENT BRING IN PAGE I; - MOVE(POINTERS[BUFFNUMBER(I)](0), - PAGESIZE,B); ITHPAGEIN:=TRUE - END; - COMMENT -- BRING IN PAGE J; - CURBUFF:=BUFFNUMBER(CURPAGE:=J); - COMMENT -- MOVE SOME INTO A; - READRECS(POINTERS[CURBUFF](0),A,SKIP,0,K, - T2:=T2-K,RECSIZE); INDX[J,0].CF:=T2; - IF T2=0 THEN - COMMENT SET THIS PAGE FREE; - INDX[J,0]:=0; - SETNTH(POINTERS[CURBUFF](0),INDX[J,0],0); - MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[J - ,0]); MARK(CURPAGE); - COMMENT -- PUT THE RECORDS INTO PAGE I; - WRITERECS(B,A,SKIP,T1,K,0,RECSIZE); - END - ELSE K:=0 COMMENT SINCE NO CONTRI- - BUTION; - UNTIL T1:=T1+K GEQ PS OR J:=J+1 GEQ Q.BF; - INDX[I,0].CF:=T1; B[0]:=INDX[I,0]; - COMMENT -- PUT THE PAGE BACK OUT ON DISK; - MOVE(B,RECSIZE+SKIP,INDX[I,0]); - MOVE(B,PAGESIZE,POINTERS[CURBUFF:=BUFFNUMBER - (I)](0)); SORT(INDX,0,NPAGES,RECSIZE|8); - MARK(CURPAGE:=I); SETTYPES; - N:=1; - END - ELSE N:=0 COMMENT LAST PAGE OF THIS TYPE; - ELSE N:=0 COMMENT LAST PAGE OF FILE; - ELSE N:=0 COMMENT PAGE CANNOT BE CHANGED; - ELSE N:=0 COMMENT THIS PAGE IS NOT TOO SMALL; - END UNTIL I:=I+1 GTR NPAGES OR N NEQ 0 ELSE N:=0; - IF I GTR NPAGES THEN N:=REAL(WRITEBUFFER); 00010240 - END OF FILE UPDATE; - %------- MODE=10 ------ EMERGENCY FILE MAINTENANCE ------- - DO MEMORY(9,TYPE,A,N,M) UNTIL N NEQ 1 + [CURBUFF](0)); + INDX[CURPAGE,0].SF:=GT1+2; + INDX[CURPAGE,0].CF:=INDX[CURPAGE,0].CF+1; + COMMENT SINCE ALLOCATING A NEW PAGE, SET COUNT TO + ONE MORE AND FREEZE THE COUNT; + S:=S+1; % SINCE THE COUNT INCREASED + MOVE(INDX[CURPAGE,0],SKIP+1,POINTERS[CURBUFF](0)); + MARK(CURPAGE); + END; + T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1; + COMMENT T IS THE SUBSCRIPT INTO THE NEW PAGE; + PG:=INDX[T,P]; COMMENT PG HOLDS THE NEW PAGE #; + FOR K:=T+1 STEP 1 UNTIL I DO + MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]); + T:=TYPS[TYPE].AF; UPDATE(TYPS,1,TYPE-1,-1); + IF CURPAGE GTR TYPS[0].BF THEN IF CURPAGE LEQ + I THEN CURPAGE:=CURPAGE-1; + INDX[I,0]:=0; INDX[I,0].MF:=1; INDX[I,0].TF:=TYPE; + COMMENT MUST ALSO ASSIGN A NUMBER TO THIS PAGE + (TO BE STORED IN THE PAGE) TO KEEP IT IN SEQUENCE + WITHIN THIS TYPE; + IF (T:=TYPS[TYPE]).AF LSS T.BF-1 THEN + T:=INDX[T.BF-1,1] ELSE T:=0; + SETNTH(INDX[I,0],ADDD(1,T),1); + COMMENT END OF THE INITIALIZATION OF THE INDEX ARRAY, + WE STILL HAVE TO MAKE SOME ENTRIES INTO THE PAGE + WHICH WE WILL DO BELOW; + END OF TEST FOR NEW PAGE; + COMMENT I IS SET TO THE PROPER SUBSCRIPT FOR THE CHR STORE; + CURBUFF:=BUFFNUMBER(CURPAGE:=I); + COMMENT NOW THE CORRECT PAGE IS IN CORE. + ------------------------------ + M= NUMBER OF CHARACTERS IN A (ON INPUT) + N= ADDRESS OF A WITHIN IN THIS TYPE (ON OUTPUT + ------------------------------; + K:=INDX[I,0]; + T:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,C,A,K,CF,M,0,0, + PAGESIZE); + COMMENT K.CF IS THE NUMBER OF ITEMS ALREADY IN THIS + PAGE. IF THERE IS A SEGMENT WHICH IS NULL, IT WILL + BE FOUND AND ASSIGNED AS THE SEG NUMBER FOR 00007860P09 + THIS CHARACTER STRING (T). IF NOT, IT WILL STICK THE + STRING ON THE END (WE KNOW THERE IS ENOUGH ROOM + SINCE WE CHECKED INDX[I,0].SF -- THE NUMBER OF CHRS USED + IN THIS PAGE, OR WE CREATED A NEW PAGE); + N:=S+T; S:=K.SF; COMMENT S CONTAINS THE # OF CHRS USED UP; + IF T:=T+1 GTR K.CF THEN COMMENT ADDED THE STRING ON THE END; + IF NOTLASTPAGE THEN % PAGE ALREADY FULL + BEGIN S:=0; B:=FALSE; INDX[I,0].FF:=1; + MOVE(INDX[I,0],SKIP+1,POINTERS[CURBUFF](0)); + MARK(CURPAGE); GO TRYITAGAIN; END ELSE + BEGIN K.CF:=T; S:=S+2; + END + ELSE IF T=K.CF AND NOTLASTPAGE THEN INDX[I,0].FF:=1; + INDX[I,0].CF:=K.CF; INDX[I,0].SF:=S+M; + MOVE(INDX[I,0],SKIP+1,POINTERS[CURBUFF](0)); + MARK(CURPAGE); + COMMENT THE PAGE DESCRIPTOR HAS BEEN UPDATED; + COMMENT + IF MEMBUG.[5:1] THEN DUMPTYPES(5,2,TYPS,NTYPES); + END ELSE COMMENT KIND OF STORAGE IS SORTED; + IF NR GTR (T:=INDX[CURPAGE,0].CF) THEN + COMMENT SUBSCRIPT IS NOT IN THE MIDDLE OF THE PAGE; + MESSAGE(6) ELSE + BEGIN + IF T GEQ U THEN COMMENT WILL EXCEED UPPER PAGE BOUND; + BEGIN ARRAY B[0:RECSIZE TIMES + (T-PS+(I:=(IF NR GEQ PS THEN 0 ELSE 1)))-1]; + COMMENT B IS JUST BIG ENOUGH TO CARRY THE + EXCESS FROM THE OLD PAGE; + READRECS(POINTERS[CURBUFF](0),B,SKIP,PS-I, + J:=(T-PS+I),0,RECSIZE); + COMMENT -- B NOW HAS THE EXCESS; + INDX[CURPAGE,0].CF:=T-J; SETNTH(POINTERS[CURBUFF](0), + INDX[CURPAGE,0],0); + MARK(CURPAGE); + IF TYPS[0].BF=0 THEN + BEGIN K:=CURPAGE; T:=1; + MEMORY(8,TYPE,A,T,M); CURPAGE:=K+1; + END; + COMMENT -- ASSIGN A FREE PAGE (SUBS T); + T:=TYPS[0].BF; TYPS[0].BF:=T:=T-1; + + PG:=INDX[T,P]; + FOR K:=T+1 STEP 1 UNTIL CURPAGE DO + MOVE(INDX[K,0],RECSIZE+SKIP+EXTRAROOM,INDX[K-1,0]); + INDX[CURPAGE,P]:=PG; + T:=0;T.CF:=J;T.TF:=TYPE; + CURBUFF:=BUFFNUMBER(CURPAGE); + WRITERECS(POINTERS[CURBUFF](0),B,SKIP,0,J,0,RECSIZE); + SETNTH(POINTERS[CURBUFF](0),T,0); + MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[CURPAGE,0]); + MARK(CURPAGE); + T:=TYPS[TYPE].AF; TYPS[TYPE].AF:=T-1; + UPDATE(TYPS,1,TYPE-1,-1); + IF J=0 THEN MESSAGE(7); + IF BOOLEAN (I) THEN + COMMENT I=0 IMPLIES THE RECORD GOES TO NEW PAGE, + I=1 IMPLIES THE RECORD GOES TO NOOLD PAGE; + BEGIN + T:=INDX[CURPAGE:=CURPAGE-1,0].CF; + CURBUFF:=BUFFNUMBER(CURPAGE); + ; COMMENT OLD PAGE IS NOW BACK; + END ELSE + BEGIN T:=J; NR:=NR-PS + END + END; + WRITERECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,T-NR,RECSIZE); + T:=INDX[CURPAGE,0].CF; INDX[CURPAGE,0].CF:=T+1; + SETNTH(POINTERS[CURBUFF](0),INDX[CURPAGE,0],0); + IF NR=0 THEN MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX + [CURPAGE,0]); MARK(CURPAGE); + END; + END; + %------- MODE=6 ------- DELETE A RECORD FROM THE FILE ---- + IF (T:=TYPS[TYPE].AF=T.BF THEN MESSAGE(12) COMMENT + ATTEMPT TO DELETE NON-EXISTENT STORAGE; + ELSE + IF NR GEQ(T:=INDX[CURPAGE,0].CF) THEN MESSAGE(13) COMMENT + ATTEMPT TO DELETE OUTSIDE STORAGE RANGE; ELSE + IF BOOLEAN(T.BOOL) THEN COMMENT SEQUENTIAL STORAGE; + BEGIN COMMENT NR IS THE RECORD TO DELETE; + ARRAY B[0:PAGESIZE-1]; 00008610P10 + COMMENT PAGESIZE -1 SHOULD BE COMPUTED TO THE EXACT + NUMBER OF WORDS TO MOVE -- IT WOULD SPEED THINGS UP; + INTEGER L; + T:=INDX[CURPAGE,0]; COMMENT T.CF IS THE NUMBER OF + RECORDS ON THIS PAGE, T.SF IS THE NUMBER OF CHRS; + L:=CHRSTORE(POINTERS[CURBUFF](0),SKIP+1,B,A,NR,0,T.CF + -NR-1,1,PAGESIZE); + COMMENT WE WILL BRING BACK THE NUMBER OF CHRS IN M; + M:=L; + MARK(CURPAGE); + COMMENT MAKE CHANGES TO THE CHARACTER COUNT; + INDX[CURPAGE,0].SF:=T.SF-L; + INDX[CURPAGE,0].FF:=0; % PAGE IS CERTAINLY NOT FULL NOW + COMMENT AND WE ARE DONE WITH THE DELETION; + MOVE(INDX[CURPAGE,0],SKIP+1,POINTERS[CURBUFF](0)); + END + ELSE + BEGIN ARRAY A[0:RECSIZE-1]; + INDX[CURPAGE,0].CF:=I-1; + SETNTH(POINTERS[CURBUFF](0),INDX[CURPAGE,0],0); + IF I GTR 1 THEN + BEGIN + READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,I-NR-1,RECSIZE); + MARK(CURPAGE); + IF NR=0 THEN + MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[CURPAGE,0]) + END ELSE COMMENT FREE THE EMPTY PAGE; + BEGIN MARK(CURPAGE); + ;TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,CURPAGE,CURPAGE); + UPDATE(TYPS,1,TYPE-1,1); TYPS[TYPE].AF:=T.AF+1; + COMMENT + IF MEMBUG.[6:1] THEN DUMPTYPES(MODE,TYPS,NTYPES); + END + END; + %------- MODE=7 ------- SEARCH FOR A RECORD FROM THE FILE --- + IF N GTR 3 THEN MESSAGE(14) ELSE + COMMENT RETURN RECORD CLOSEST (BUT LESS THAN OR EQUAL TO) TO + THE CONTENT OF -A-. A WILL BE REPLACED BY THE RECORD FOUND; + IF BOOLEAN((I:=TYPS[TYPE].BOOL) THEN + MESSAGE(8) COMMENT BINARY SEARCH OF NON-SEQUENTIAL DATA; + ELSE + IF I.AF=I.BF THEN MESSAGE(9) COMMENT --NO STORAGE OF + THIS TYPE ALLOCATED AS YET; + ELSE BEGIN + INTEGER F,U,L; + ARRAY B[0:RECSIZE-1]; + U:=TYPS[TYPE].BF; L:=TYPS[TYPE].AF; + WHILE U-L GTR 1 DO + IF LESS(A,0,INDX[F:=(U+L) DIV 2,0],8,M) THEN U:=F ELSE L:=F; + CURBUFF:=BUFFNUMBER(CURPAGE:=L); + L:=0; U:=INDX[CURPAGE,0].CF; + IF L-U=0 THEN MESSAGE(10) COMMENT BINARY SEARCH FOUND + A PAGE WITH NO RECORDS; + ELSE BEGIN + WHILE U-L GTR 1 DO + BEGIN READRECS(POINTERS[CURBUFF](0),B,SKIP, + F:=(U+L) DIV 2,1,0,RECSIZE); + IF LESS(A,0,B,0,M) THEN U:=F ELSE L:=F + END; + COMMENT ----------------------------------- + ON INPUT: + N=0 IMPLIES DO NOT PLACE RECORD INTO FILE + IF RECORD IS FOUND. RETURN RELA- + TIVE POSITION OF THE CLOSEST RECORD + IN THIS PAGE. + N=1 " DO NO PLACE IN FILE. RETURN ABSO- + LUTE SUBSCRIPT OF CLOSSEST RECORD. + N=2 " PLACE RECORD INTO FILE IF NOT FOUND. + RETURN RELATIVE POSITION OF RECORD. + N=3 " PLACE RECORD INTO FILE, IF NOT + FOUND, RETURN ABS SUBSCRIPT OF + THE RECORD. + ON OUTPUT: + M=0 " RECORD FOUND WAS EQUAL TO RECORD + SOUGHT. + M=1 " RECORD FOUND WAS GREATER THAN THE + SOUGHT. + M=2 " RECORD FOUND WAS LESS THAN THE + RECORD SOUGHT. +; + READRECS(POINTERS[CURBUFF](0),B,SKIP,L,1,0,RECSIZE); + IF LESS(A,0,B,0,M) THEN M:=1 ELSE + IF LESS(B,0,A,0,M) THEN M:=2 ELSE 00009410P11 + M:=0; + T:=0; IF BOOLEAN(N) THEN + FOR I:=TYPS[TYPE].AF STEP 1 UNTIL CURPAGE-1 DO + T:=T+INDX[I,0].CF; + IF N GTR 1 THEN IF M GEQ 1 THEN + MEMORY(2,TYPE,A,L+M-1,NR); + MOVE(B,RECSIZE,A); + N:=T+L; + END + END; + %------- MODE=8 ------- FILE OVERFLOW, FIX ARRAYS AND PAGES + BEGIN BOOLEAN TOG; + ARRAY A[0:PAGESIZE-1]; T:=NPAGES-N+1; + IF TOG:=(T DIV AREASIZE) LSS (NPAGES DIV AREASIZE ) OR + (T=NPAGES AND T MOD AREASIZE =0) THEN + MEMORY(14,TYPE,A,N,M); + FOR I:=T STEP 1 UNTIL NPAGES DO + BEGIN WRITE(NEWDISK[I],PAGESIZE,A[*]);INDX[I,P].PAGEF:=I END; + MARKEOF(SKIP,RECSIZE,NEWDISK(0)); + WRITE(NEWDISK[I]); + TYPS[0].BF:=FREEPAGE(INDX,TYPS[0]).BF,T,NPAGES); + UPDATE(TYPS,1,NTYPES,NPAGES-T+1); + IF TOG THEN CLOSE(NEWDISK); + END; + %------- MODE=9 ------- FILE MAINTENANCE ------------------ + BEGIN BOOLEAN ITHPAGEIN; + INTEGER I,J,K,T1,T2,T3,M,W,Q; + ARRAY A,B[0:PAGESIZE-1]; + COMMENT + MONITOR PRINT(Q,W,N, I,J,K,T1,T2,T3,M,A,B); + IF I:=TYPS[0].BF LEQ NPAGES THEN + DO + BEGIN COMMENT OUTER "DO-LOOP" TO FIND TROUBLE WITH + THE FILE; + IF T1:=(Q:=INDX[I,0]).CF LSS L THEN COMMENT MAY BE CORRECTABLE; + IF NOT BOOLEAN((Q:=TYPS[Q.TF]).BOOL) THEN + COMMENT -- THIS PAGE IS CORRECTABLE; + IF I NEQ NPAGES THEN + COMMENT -- THIS IS NOT THE LAST PAGE OF THE FILE; + IF (J:=I+1) LSS Q.BF THEN + COMMENT -- THIS IS NOT THE LAST PAGE OF THIS TYPE; + BEGIN COMMENT -- FIND RECORDS TO MOVE INTO + THIS PAGE; + DO IF T2:=INDX[J,0].CF GTR 0 THEN + COMMENT THIS PAGE HAS RECS TO MOVE; + BEGIN COMMENT HOW MANY; + IF T2 LSS K:=PS-T1 THEN K:=T2; + IF NOT ITHPAGEIN THEN + BEGIN COMMENT BRING IN PAGE I; + MOVE(POINTERS[BUFFNUMBER(I)](0), + PAGESIZE,B); ITHPAGEIN:=TRUE + END; + COMMENT -- BRING IN PAGE J; + CURBUFF:=BUFFNUMBER(CURPAGE:=J); + COMMENT -- MOVE SOME INTO A; + READRECS(POINTERS[CURBUFF](0),A,SKIP,0,K, + T2:=T2-K,RECSIZE); INDX[J,0].CF:=T2; + IF T2=0 THEN + COMMENT SET THIS PAGE FREE; + INDX[J,0]:=0; + SETNTH(POINTERS[CURBUFF](0),INDX[J,0],0); + MOVE(POINTERS[CURBUFF](0),RECSIZE+SKIP,INDX[J + ,0]); MARK(CURPAGE); + COMMENT -- PUT THE RECORDS INTO PAGE I; + WRITERECS(B,A,SKIP,T1,K,0,RECSIZE); + END + ELSE K:=0 COMMENT SINCE NO CONTRI- + BUTION; + UNTIL T1:=T1+K GEQ PS OR J:=J+1 GEQ Q.BF; + INDX[I,0].CF:=T1; B[0]:=INDX[I,0]; + COMMENT -- PUT THE PAGE BACK OUT ON DISK; + MOVE(B,RECSIZE+SKIP,INDX[I,0]); + MOVE(B,PAGESIZE,POINTERS[CURBUFF:=BUFFNUMBER + (I)](0)); SORT(INDX,0,NPAGES,RECSIZE|8); + MARK(CURPAGE:=I); SETTYPES; + N:=1; + END + ELSE N:=0 COMMENT LAST PAGE OF THIS TYPE; + ELSE N:=0 COMMENT LAST PAGE OF FILE; + ELSE N:=0 COMMENT PAGE CANNOT BE CHANGED; + ELSE N:=0 COMMENT THIS PAGE IS NOT TOO SMALL; + END UNTIL I:=I+1 GTR NPAGES OR N NEQ 0 ELSE N:=0; + IF I GTR NPAGES THEN N:=REAL(WRITEBUFFER); 00010240P12 + END OF FILE UPDATE; + %------- MODE=10 ------EEMERGENCY FILE MAINTENANCE ------- + DO MEMORY(9,TYPE,A,N,M) UNTIL N NEQ 1 %------- MODE=11 ------- SET THE KIND OF STORAGE FOR TYPE ---------- - ;COMMENT TYPE "TYPE" STORAGE IS BEING SET TO SEQUENTIAL; - IF TYPE=0 THEN MESSAGE(4) ELSE - IF (T:=TYPS[TYPE]).AF= T.BF THEN TYPS[TYPE].BOOL:=1 ELSE - MESSAGE(15); COMMENT ATTEMPT TO CHANGE KINDS IN MIDSTREAM; -%------- MODE=12 ----------- ALTER STORAGE ALLOCATION RESOURCES--- - COMMENT N IS THE "FACTOR" (PERCENT OF RESOURCES | 100), - AND M IS THE STORAGE "LEVEL" (0 IS THE ONLY ONE THAT - DOES ANYTHING ON THE B5500); - BEGIN INTEGER J,K; - BOOLEAN TOG; - IF T:=N|(MBUFF-1)/100+1 GTR MAXBUFF THEN - BEGIN COMMENT ADD TO AVAILABLE LIST; - FOR I:=CDR(FIRST),CDR(AVAIL) DO - WHILE NOT NULL(I) DO - BEGIN BUF[I].FLAGB:=1; I:=CDR(BUF[I]); - END; - FOR I:=MAXBUFF+1 STEP 1 UNTIL T DO - BEGIN WHILE BUF[K:=K+1].FLAGB=1 DO; - BUF[K]:=0; RPLACD(BUF[K],CDR(AVAIL)); - RPLACD(AVAIL,K) - END; - MAXBUFF:=T; - FOR I:=1 STEP 1 UNTIL MBUFF DO BUF[I].FLAGB:=0; - END ELSE - IF T LSS MAXBUFF THEN - BEGIN COMMENT CUT DOWN ON THE NUMBER OF BUFFERS; - I:=CDR(FIRST); - FOR J:=1 STEP 1 UNTIL MAXBUFF DO - IF TOG THEN - IF NOT NULL(I) THEN - IF J GEQ T THEN - BEGIN K:=CDR(BUF[I]); BUF[I]:=0 - ; I:=K END - ELSE I:=CDR(BUF[I]) - ELSE - ELSE - IF TOG:=NULL(I) THEN - BEGIN J:=J-1; I:=CDR(AVAIL) - END - ELSE - IF J EQL T THEN - BEGIN K:=CDR(BUF[I]); RPLACD(BUF[I],0); - I:=K END ELSE - IF J GTR T THEN - BEGIN - IF BOOLEAN(BUF[I].CHANGEDBIT) THEN - WRITE(POINTERS[I][BUF[I].PAGEF-1); - K:=CDR(BUF[I]); - CLOSE(POINTERS[I]); - BUF[I]:=0; I:=K - END ELSE I:=CDR(BUF[I]) - ; - MAXBUFF:=T - END; - END; + ;COMMENT TYPE "TYPE" STORAGE IS BEING SET TO SEQUENTIAL; + IF TYPE=0 THEN MESSAGE(4) ELSE + IF (T:=TYPS[TYPE]).AF= T.BF THEN TYPS[TYPE].BOOL:=1 ELSE + MESSAGE(15); COMMENT ATTEMPT TO CHANGE KINDS IN MIDSTREAM; +%------- MODE=12 ----------- ALTER STORAGE ALLOCATION RESOURCES--- + COMMENT N IS THE "FACTOR" (PERCENT OF RESOURCES | 100), + AND M IS THE STORAGE "LEVEL" (0 IS THE ONLY ONE THAT + DOES ANYTHING ON THE B5500); + BEGIN INTEGER J,K; + BOOLEAN TOG; + IF T:=N|(MBUFF-1)/100+1 GTR MAXBUFF THEN + BEGIN COMMENT ADD TO AVAILABLE LIST; + FOR I:=CDR(FIRST),CDR(AVAIL) DO + WHILE NOT NULL(I) DO + BEGIN BUF[I].FLAGB:=1; I:=CDR(BUF[I]); + END; + FOR I:=MAXBUFF+1 STEP 1 UNTIL T DO + BEGIN WHILE BUF[K:=K+1].FLAGB=1 DO; + BUF[K]:=0; RPLACD(BUF[K],CDR(AVAIL)); + RPLACD(AVAIL,K) + END; + MAXBUFF:=T; + FOR I:=1 STEP 1 UNTIL MBUFF DO BUF[I].FLAGB:=0; + END ELSE + IF T LSS MAXBUFF THEN + BEGIN COMMENT CUT DOWN ON THE NUMBER OF BUFFERS; + I:=CDR(FIRST); + FOR J:=1 STEP 1 UNTIL MAXBUFF DO + IF TOG THEN + IF NOT NULL(I) THEN + IF J GEQ T THEN + BEGIN K:=CDR(BUF[I]); BUF[I]:=0 + ; I:=K END + ELSE I:=CDR(BUF[I]) + ELSE + ELSE + IF TOG:=NULL(I) THEN + BEGIN J:=J-1; I:=CDR(AVAIL) + END + ELSE + IF J EQL T THEN + BEGIN K:=CDR(BUF[I]); RPLACD(BUF[I],0); + I:=K END ELSE + IF J GTR T THEN + BEGIN + IF BOOLEAN(BUF[I].CHANGEDBIT) THEN + WRITE(POINTERS[I][BUF[I].PAGEF-1); + K:=CDR(BUF[I]); + CLOSE(POINTERS[I]); + BUF[I]:=0; I:=K + END ELSE I:=CDR(BUF[I]) + ; + MAXBUFF:=T + END; + END; %------- MODE=13 ------- RELEASE "TYPE" STORAGE TO SYSTEM ---------- - IF (T:=TYPS[TYPE]).BF GTR T.AF THEN - BEGIN INTEGER J; - J:=T.BF-1; - FOR I:=T.AF STEP 1 UNTIL J DO - BEGIN CURBUFF:=BUFFNUMBER(I); - SETNTH(POINTERS[CURBUFF](0),0,0); MARK(CURPAGE:=I); - END; - TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,T,AF,J); - UPDATE(TYPS,1,TYPE-1,J-T.AF+1); - TYPS[TYPE].BF:=T.AF; TYPS[TYPE].BOOL:=0; - END; + IF (T:=TYPS[TYPE]).BF GTR T.AF THEN + BEGIN INTEGER J; + J:=T.BF-1; + FOR I:=T.AF STEP 1 UNTIL J DO + BEGIN CURBUFF:=BUFFNUMBER(I); + SETNTH(POINTERS[CURBUFF](0),0,0); MARK(CURPAGE:=I); + END; + TYPS[0].BF:=FREEPAGE(INDX,TYPS[0].BF,T,AF,J); + UPDATE(TYPS,1,TYPE-1,J-T.AF+1); + TYPS[TYPE].BF:=T.AF; TYPS[TYPE].BOOL:=0; + END; %------- MODE=14 ------ RELEASE ALL PAGES FOR TRANSITION ----------- - BEGIN INTEGER K; - I:=CDR(FIRST); - WHILE NOT NULL(I) DO - BEGIN IF BOOLEAN(BUF[I].CHANGEDBIT ) THEN WRITE(POINTERS[I] - [BUF[I].PAGEF-1]); CLOSE(POINTERS[I]); - K:=CDR(BUF[I]); BUF[I]:=0; - RPLACD(BUF[I],CDR(AVAIL)); RPLACD(AVAIL,I); I:=K - END ; CURPAGE:=CURBUFF:=-1; RPLACD(FIRST,0); - END; - END OF CASE STMT; -END OF INNER BLOCK; 00011110 -END OF PROCEDURE; -INTEGER QM,QN; -ARRAY QA[0:0]; -PROCEDURE NAME(MFID,FID); VALUE MFID,FID; REAL MFID,FID; - BEGIN INTEGER I; FILL NEWDISK WITH MFID,FID; - FOR I:=0 STEP 1 UNTIL MBUFF DO - FILL POINTERS[I] WITH MFID,FID; - FILL ESTABLISH WITH MFID,FID; - SETPOINTERNAMES - END; -PROCEDURE SEQUENTIAL(UNIT); VALUE UNIT; INTEGER UNIT; - MEMORY(11,UNIT,QA,QN,QM); -INTEGER PROCEDURE CONTENTS(UNIT,N,AR); VALUE UNIT,N; - INTEGER UNIT,N; ARRAY AR[0]; - BEGIN - MEMORY(4,UNIT,AR,N,QM); CONTENTS:=QM; - END; -PROCEDURE DELETE1(UNIT,N); VALUE UNIT,N; INTEGER UNIT,N; - MEMORY(6,UNIT,QA,N,QM); -INTEGER PROCEDURE SEARCHORD(UNIT,REC,LOC,M); VALUE UNIT,M; - INTEGER UNIT,LOC,M; ARRAY REC[0]; - BEGIN LOC:=1; - MEMORY(7,UNIT,REC,LOC,M); - SEARCHORD:=M; - END; -PROCEDURE STOREORD(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT,N; - ARRAY REC[0]; - MEMORY(5,UNIT,REC,N,QM); -PROCEDURE STOREORDR(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT,N; - ARRAY REC[0]; - MEMORY(2,UNIT,REC,N,QM); -BOOLEAN PROCEDURE MAINTENANCE; - BEGIN MEMORY(9,0,QA,QN,QM); MAINTENANCE:=QN:=1 - END; -PROCEDURE WRAPUP; MEMORY(10,0,QA,QN,QM); -INTEGER PROCEDURE STORESEQ(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT, N; - ARRAY REC[0]; - BEGIN - MEMORY(5,UNIT,REC,QN,N); STORESEQ:=QN; - END; -PROCEDURE DELETEN(UNIT,N,M); VALUE UNIT,N,M; INTEGER UNIT,N,M; - BEGIN M:=M-N; - DO MEMORY(6,UNIT,QA,N,QM) UNTIL M:=M-1 LSS 0; - END; -INTEGER PROCEDURE NEXTUNIT; - BEGIN MEMORY(1,0,QA,QN,1); NEXTUNIT:=QN - END; -INTEGER PROCEDURE SIZE(UNIT); VALUE UNIT; INTEGER UNIT; - BEGIN MEMORY(3,UNIT,QA,QN,QM); SIZE:=QM - END; -PROCEDURE ALLOCATE(J,FACTOR); VALUE J,FACTOR; INTEGER J; - REAL FACTOR; - BEGIN + BEGIN INTEGER K; + I:=CDR(FIRST); + WHILE NOT NULL(I) DO + BEGIN IF BOOLEAN(BUF[I].CHANGEDBIT ) THEN WRITE(POINTERS[I] + [BUF[I].PAGEF-1]); CLOSE(POINTERS[I]); + K:=CDR(BUF[I]); BUF[I]:=0; + RPLACD(BUF[I],CDR(AVAIL)); RPLACD(AVAIL,I); I:=K + END ; CURPAGE:=CURBUFF:=-1; RPLACD(FIRST,0); + END; + END OF CASE STMT; +END OF INNER BLOCK; 00011110P13 +END OF PROCEDURE; +INTEGER QM,QN; +ARRAY QA[0:0]; +PROCEDURE NAME(MFID,FID); VALUE MFID,FID; REAL MFID,FID; + BEGIN INTEGER I; FILL NEWDISK WITH MFID,FID; + FOR I:=0 STEP 1 UNTIL MBUFF DO + FILL POINTERS[I] WITH MFID,FID; + FILL ESTABLISH WITH MFID,FID; + SETPOINTERNAMES + END; +PROCEDURE SEQUENTIAL(UNIT); VALUE UNIT; INTEGER UNIT; + MEMORY(11,UNIT,QA,QN,QM); +INTEGER PROCEDURE CONTENTS(UNIT,N,AR); VALUE UNIT,N; + INTEGER UNIT,N; ARRAY AR[0]; + BEGIN + MEMORY(4,UNIT,AR,N,QM); CONTENTS:=QM; + END; +PROCEDURE DELETE1(UNIT,N); VALUE UNIT,N; INTEGER UNIT,N; + MEMORY(6,UNIT,QA,N,QM); +INTEGER PROCEDURE SEARCHORD(UNIT,REC,LOC,M); VALUE UNIT,M; + INTEGER UNIT,LOC,M; ARRAY REC[0]; + BEGIN LOC:=1; + MEMORY(7,UNIT,REC,LOC,M); + SEARCHORD:=M; + END; +PROCEDURE STOREORD(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT,N; + ARRAY REC[0]; + MEMORY(5,UNIT,REC,N,QM); +PROCEDURE STOREORDR(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT,N; + ARRAY REC[0]; + MEMORY(2,UNIT,REC,N,QM); +BOOLEAN PROCEDURE MAINTENANCE; + BEGIN MEMORY(9,0,QA,QN,QM); MAINTENANCE:=QN:=1 + END; +PROCEDURE WRAPUP; MEMORY(10,0,QA,QN,QM); +INTEGER PROCEDURE STORESEQ(UNIT,REC,N); VALUE UNIT,N; INTEGER UNIT, N; + ARRAY REC[0]; + BEGIN + MEMORY(5,UNIT,REC,QN,N); STORESEQ:=QN; + END; +PROCEDURE DELETEN(UNIT,N,M); VALUE UNIT,N,M; INTEGER UNIT,N,M; + BEGIN M:=M-N; + DO MEMORY(6,UNIT,QA,N,QM) UNTIL M:=M-1 LSS 0; + END; +INTEGER PROCEDURE NEXTUNIT; + BEGIN MEMORY(1,0,QA,QN,1); NEXTUNIT:=QN + END; +INTEGER PROCEDURE SIZE(UNIT); VALUE UNIT; INTEGER UNIT; + BEGIN MEMORY(3,UNIT,QA,QN,QM); SIZE:=QM + END; +PROCEDURE ALLOCATE(J,FACTOR); VALUE J,FACTOR; INTEGER J; + REAL FACTOR; + BEGIN QN:=ENTIER( ABS( (FACTOR | 100) MOD 101)); - MEMORY(12,0,QA,QN,J) - END; -PROCEDURE RELEASEUNIT(UNIT); VALUE UNIT; INTEGER UNIT; - MEMORY(13,UNIT,QA,QN,QM); -DEFINE - ALLOWQUESIZE=4#, - ACOUNT=ACCUM[0].[1:11]#, - DATADESC=[1:1]#, - SCALAR=[4:1]#, - NAMED=[3:1]#, - CHRMODE=[5:1]#, - CHECKT=5#, % NUMBER OF TIMES THRU EXECUTE BEFORE CHECK - CCIF=18:36:12#, - CDID=1:43:5#, - CSPF=30:30:18#, - CRF=24:42:6#, - CLOCF=6:30:18#, - PF=[1:17]#, - XEQMODE=1#, - FUNCMODE=2#, - CALCMODE=0#, - INPUTMODE=3#, - ERRORMODE=4#, - FUNCTION=1#, - CURRENTMODE = PSRM[0]#, - VARIABLES = PSRM[1]#, - VARSIZE = PSRM[2]#, - FUNCPOINTER = PSRM[3]#, 00013160 - FUNCSEQ = PSRM[4]#, - CURLINE = PSRM[5]#, - STACKBASE = PSRM[6]#, - INCREMENT = STACKBASE#, %FUNCMODE/CALCMODE - SYMBASE = PSRM[7]#, - FUNCSIZE = SYMBASE#, %FUNCMODE/CALCMODE - USERMASK = PSRM[8]#, - SEED = PSRM[10]#, - ORIGIN = PSRM[11]#, - FUZZ = PSRM[12]#, - FSTART = 9#, %PSR[9] IS WHERE NAME OF CURRENTLY EDITED FCN GOES - PSRSIZE = 13#, - PSR = PSRM[*]#, - WF=[18:8]#, - WDSPERREC=10#, - WDSPERBLK=30#, - NAREAS=10#, - SIZEAREAS=210#, - LIBF1=[6:15]#, - LIBF2=[22:16]#, - LIBF3=[38:10]#, - LIBSPACES=1#, - IDENT=RESULT=1#, - SPECIAL=RESULT=3#, - NUMERIC=RESULT=2#, - REPLACELOC=0#, - REPLACEV=4#, - SPF=[30:18]#, - RF=[24:6]#, - DID=[1:5]#, - XRF=[12:18]#, - DDPNSW=30#, % DATA DESC PRESENT NAMED SCALAR WORD - DDNNVW=20#, %DATA DESC NON-PRES NAMED VECTOR WORD - DDNUVW=16#, %DATA DESC NONPRES..(POINTS INTO SYM TAB FOR LOCALS) - DDPUVW=24#, % DATA DESC PRESENT UNNAMED VECTOR WORD - DDNNSW=22#, % DATA DESC NON-PRES NAMED SCALAR WORD - PDC=10#, % DROG DESC CALC MODE - INTO=0#, - DDPUSW=26#, % DATA DESC PRESENT UNNAMED SCALAR WORK (MODE) - DDPUSC=27#, % DATA DESC PRESENT UNNAMED SCALAR CHR - DDPUVC=25#, % DATA DESC PRESENT UNNAMED VECTOR CHR - DDPNVC=29#, %DATA DESC PRES PERMANENT VECTOR CHAR MODE - DDPNVW=28#, %DATA DESC PRES NAMED VEC WORD (NAMED=PERMANENT) - OUTOF=1#, - NAMEDNULLV=0&7[1:45:3]#, %DLUDGE...NAMED VERSION OF NULLV - BACKP=[6:18]#, - SCALARDATA=0#, - ARRAYDATA=2#, - DATATYPE=[4:1]#, - ARRAYTYPE=[5:1]#, - CHARARRAY=1#, - NUMERICARRAY=0#, - BLOCKSIZE=30#, %#WORDS OF CONTIGUOUS DATA IN SEQUENTIAL STORE - VARTYPE=[42:6]#, - WS=WORKSPACE#, - DIMPTR=SPF#, - INPTR=BACKP#, - QUADIN=[18:3]#, - QUADINV=18:45:3#, - STATEVECTORSIZE=16#, - SUSPENDED=[5:1]#, - SUSPENDVAR=[2:1]#, - CTYPEF=3:45:3#, - CSUSVAR=2:47:1#, - CNAMED=3:47:1#, - MAXWORDSTORE=3960#, %APL PREVENTS CREATION OF ARRAYS BIGGER THAN - %3960 ELEMENTS. THIS NUMBER IS THE PRODUCT OF - %4,(NUMBER OF POINTERS TO SEQUENTIAL STORE - %BLOCKS THAT ARE STORED IN ONE WORD) - %30, (BLOCKSIZE), - %AND 33, (SIZE OF ARRAY USED TO STORE THESE - %POINTERS IN GETARRAY, MOVEARRAY, AND - %RELEASEARRAY). SUBSCRIPTS ALLOWS 8|3960 - %ELEMENTS IF THEY ARE CHARACTERS. - %HOWEVER, SP WILL GET FULL BEFORE THAT SINCE - %BIGGEST SP SIZE IS CURRENTLY 3584 - MAXBUFFSIZE=30#, - MAXHEADERARGS=30#, - BUFFERSIZE=BUFFSIZE#, - LINEBUFFER=LINEBUFF#, - LINEBUFF = OUTBUFF[*]#, - APPENDTOBUFFER=APPENDTOBUFF#, - FOUND=TARRAY[0]#, 00022000 - EOB=TARRAY[1]#, - MANT=TARRAY[2]#, - MANTLEN=TARRAY[3]#, - FRAC=TARRAY[4]#, - FRACLEN=TARRAY[5]#, - POWER=TARRAY[6]#, - POWERLEN=TARRAY[7]#, - MANTSIGN=TARRAY[8]#, - TABSIZE = 43#, - LOGINCODES=1#, - LOGINPHRASE=2#, - LIBRARY=1#, - WORKSPACEUNIT=2#, - RTPAREN=9#, - MASTERMODE=USERMASK.[1:1]#, - EDITOG=USERMASK.[2:1]#, - POLBUG=USERMASK.[3:1]#, - FPTF=9#, % FUNCTION POINTER FIELD (STARTS AT CHR POS 9) - FSQF=11#, % FUNCTION SEQNTL FIELD - FFL=2#, % FUNCTION FIELD LENGTH (2 CHR POSITIONS) - CRETURN=3:47:1#, - RETURNVALUE=[3:1]#, - CNUMBERARGS=4:46:2#, - NUMBERARGS=[4:2]#, - RETURNVAL=1#, - NOSYNTAX=USERMASK.[4:1]#, - LINESIZE=USERMASK.[41:7]#, - DIGITS=USERMASK.[37:4]#, - SUSPENSION=USERMASK.SUSPENDED#, - SAVEDWS=USERMASK.[7:1]#, - DELTOG=USERMASK.[6:1]#, - DELCHR="$"#, %USED IN DELPRESENT (IN FUNCTIONHANDLER) - MAXMESS=27#, - USERTOP=21#, - MARGINSIZE=6#, - LFTBRACKET=SPECIAL AND ACCUM[0]=11#, - QUADV=SPECIAL AND ACCUM[0]=10#, - QUOTEV=ACCUM[0]=20#, - EXPANDV=38#, - SLASHV=6#, - GOTOV=5#, - DOTV=17#, - ROTV=37#, - RGTBRACKET=SPECIAL AND ACCUM[0]=12#, - DELV=SPECIAL AND ACCUM[0]=13#, - PLUS = SPECIAL AND ACCUM[0] = 48#, - MINUS = SPECIAL AND ACCUM[0] = 49#, - NEGATIVE = SPECIAL AND ACCUM[0] = 51#, - TIMES = SPECIAL AND ACCUM[0] = 50#, - LOGS = SPECIAL AND ACCUM[0] = 54#, - SORTUP = SPECIAL AND ACCUM[0] = 55#, - SORTDN = SPECIAL AND ACCUM[0] = 56#, - NAND = SPECIAL AND ACCUM[0] = 58#, - NOR = SPECIAL AND ACCUM[0] = 59#, - TAKE = SPECIAL AND ACCUM[0] = 60#, - DROPIT = SPECIAL AND ACCUM[0] = 61#, - LFTARROW = SPECIAL AND ACCUM[0] = 04#, - TRANS = SPECIAL AND ACCUM[0] = 05#, - SLASH = SPECIAL AND ACCUM[0] = 06#, - INTDIVIDE = SPECIAL AND ACCUM[0] = 07#, - LFTPAREN = SPECIAL AND ACCUM[0] = 08#, - RGTPAREN = SPECIAL AND ACCUM[0] = 09#, - QUOTEQUAD = SPECIAL AND ACCUM[0] = 14#, - SEMICOLON = SPECIAL AND ACCUM[0] = 15#, - COMMA = SPECIAL AND ACCUM[0] = 16#, - DOT = SPECIAL AND ACCUM[0] = 17#, - STAR = SPECIAL AND ACCUM[0] = 18#, - AT = SPECIAL AND ACCUM[0] = 19#, - QUOTE = SPECIAL AND ACCUM[0] = 20#, - BOOLAND = SPECIAL AND ACCUM[0] = 21#, - BOOLOR = SPECIAL AND ACCUM[0] = 22#, - BOOLNOT = SPECIAL AND ACCUM[0] = 23#, - LESSTHAN = SPECIAL AND ACCUM[0] = 24#, - LESSEQ = SPECIAL AND ACCUM[0] = 25#, - EQUAL = SPECIAL AND ACCUM[0] = 26#, - GRTEQ = SPECIAL AND ACCUM[0] = 27#, - GREATER = SPECIAL AND ACCUM[0] = 28#, - NOTEQ = SPECIAL AND ACCUM[0] = 29#, - CEILING = SPECIAL AND ACCUM[0] = 30#, - FLOOR = SPECIAL AND ACCUM[0] = 31#, - STICK = SPECIAL AND ACCUM[0] = 32#, - EPSILON = SPECIAL AND ACCUM[0] = 33#, - RHO = SPECIAL AND ACCUM[0] = 34#, 00030950 - IOTA = SPECIAL AND ACCUM[0] = 35#, - TRACE = SPECIAL AND ACCUM[0] = 36#, - PHI = SPECIAL AND ACCUM[0] = 37#, - EXPAND = SPECIAL AND ACCUM[0] = 38#, - BASVAL = SPECIAL AND ACCUM[0] = 39#, - EXCLAMATION = SPECIAL AND ACCUM[0] = 40#, - MINUSLASH = SPECIAL AND ACCUM[0] = 41#, - QUESTION = SPECIAL AND ACCUM[0] = 42#, - OSLASH = SPECIAL AND ACCUM[0] = 43#, - TAU = SPECIAL AND ACCUM[0] = 44#, - CIRCLE = SPECIAL AND ACCUM[0] = 45#, - LOCKIT =IDENT AND ACCUM[0]="4LOCK "#, - COLON = SPECIAL AND ACCUM[0] = 47#, - QUADLFTARROW=51#, - REDUCT=52#, - ROTATE=53#, - SCANV=57#, - LINEBUFFSIZE=17#, - MAXPOLISH=100#, MESSIZE=10#, - MAXCONSTANT=30#, - MAXMEMACCESSES=3584#, %MAXSPROWS | SPRSIZE - MAXSYMBOL=30#, - MAXSPROWS=28#, - TYPEFIELD=[3:3]#, - OPTYPE=[1:2]#, - LOCFIELD=BACKP#, - ADDRFIELD=SPF#, - SYMTYPE=[3:3]#, - OPERAND=5#, - CONSTANT=2#, - OPERATOR=3#, - LOCALVAR=4#, - SYMTABSIZE=1#, - LFTPARENV=8#, - RGTPARENV=9#, - LFTBRACKETV=11#, - RGTBRACKETV=12#, - SEMICOLONV=15#, - QUAD=10#, - QQUAD=14#, - LFTARROWV=4#, - SORTUPV=55#, - SORTDNV=56#, - ALPHALABEL=1#, - NUMERICLABEL=2#, - NEXTLINE=0#, - ERRORCOND=3#, - PRESENCE=[2:1]#, - CHANGE=[1:1]#, - XEQ=1#, - CLEARCORE=2#, - WRITECORE=3#, - %%% - %%% - XEQUTE=1#, - SLICE=120#, %TIME SLICE IN 60THS OF A SECOND - ALLOC=2#, - WRITEBACK=3#, - LOOKATSTACK=5#, - - LEN=[1:23]#, - NEXT=[24:24]#, - LOC=L.[30:11],L.[41:7]#, - NOC=N.[30:11],N.[41:7]#, - MOC=M.[30:11],M.[41:7]#, - SPRSIZE=128#, % SP ROW SIZE - NILADIC=0#, - MONADIC=1#, - DYADIC=2#, - TRIADIC=3#, - DEPTHERROR=1#, - DOMAINERROR=2#, - INDEXERROR=4#, - LABELERROR=5#, - LENGTHERROR=6#, - NONCEERROR=7#, - RANKERROR=8#, - SYNTAXERROR=9#, - SYSTEMERROR=10#, - VALUEERROR=11#, - SPERROR=12#, - KITEERROR=13#, - STREAMBASE=59823125#, 00032200 - APLOGGED=[10:1]#, - APLHEADING=[11:1]#, - CSTATION = STATION#, - CAPLOGGED=10:47:1#, - CAPHEADING=11:47:1#, - APLCODE = STATIONPARAMS#, - - - SPECMODE = BOUNDARY.[1:3]#, - DISPLAYIMG=1#, - EDITING=2#, - DELETING=3#, - RESEQUECING=4#, - LOWER = BOUNDARY.[4:22]#, - UPPER = BOUNDARY.[26:22]#, - OLDBUFFER = OLDINPBUFFER[*]#, - - ENDEFINES=#; - REAL ADDRESS, ABSOLUTEADDRESS, - LADDRESS; - BOOLEAN LINETOG; %GO TO NEXT LINE IF TRUE WHEN WRITING OUT - INTEGER BUFFSIZE,ITEMCOUNT,RESULT, - LOGINSIZE, - %%% - ERR, - NROWS, - %%% - CUSER; - LABEL ENDOFJOB,TRYAGAIN; - REAL GT1,GT2,GT3; - DEFINE LINE=PRINT#; - SAVE ARRAY BUFFER[0:MAXBUFFSIZE]; - ARRAY TARRAY[0:8], - COMMENT PROGRAM STATE REGISTER; - PSRM[0:PSRSIZE], - OLDINPBUFFER[0:MAXBUFFSIZE], - SP[0:27, 0:SPRSIZE-1], - IDTABLE[0:TABSIZE], - MESSTAB[0:MAXMESS], - JIGGLE[0:0], - SCR[0:2], - CORRESPONDENCE[0:7], - ACCUM[0:MAXBUFFSIZE]; - DEFINE OUTBUFFSIZE=29#,CLOGGED=7:47:1#,STU=15:9:9#; - ARRAY OUTBUFF[0:OUTBUFFSIZE]; - ALPHA STATION, JOBNUM, STATIONPARAMS, BOUNDARY; - INTEGER CHRCOUNT, WORKSPACE; - - STREAM PROCEDURE INITBUFF(B,BUFFSIZE); VALUE BUFFSIZE; - BEGIN + MEMORY(12,0,QA,QN,J) + END; +PROCEDURE RELEASEUNIT(UNIT); VALUE UNIT; INTEGER UNIT; + MEMORY(13,UNIT,QA,QN,QM); +DEFINE + ALLOWQUESIZE=4#, + ACOUNT=ACCUM[0].[1:11]#, + DATADESC=[1:1]#, + SCALAR=[4:1]#, + NAMED=[3:1]#, + CHRMODE=[5:1]#, + CHECKT=5#, % NUMBER OF TIMES THRU EXECUTE BEFORE CHECK + CCIF=18:36:12#, + CDID=1:43:5#, + CSPF=30:30:18#, + CRF=24:42:6#, + CLOCF=6:30:18#, + PF=[1:17]#, + XEQMODE=1#, + FUNCMODE=2#, + CALCMODE=0#, + INPUTMODE=3#, + ERRORMODE=4#, + FUNCTION=1#, + CURRENTMODE = PSRM[0]#, + VARIABLES = PSRM[1]#, + VARSIZE = PSRM[2]#, + FUNCPOINTER = PSRM[3]#, 00013160P14 + FUNCSEQ = PSRM[4]#, + CURLINE = PSRM[5]#, + STACKBASE = PSRM[6]#, + INCREMENT = STACKBASE#, %FUNCMODE/CALCMODE + SYMBASE = PSRM[7]#, + FUNCSIZE = SYMBASE#, %FUNCMODE/CALCMODE + USERMASK = PSRM[8]#, + SEED = PSRM[10]#, + ORIGIN = PSRM[11]#, + FUZZ = PSRM[12]#, + FSTART = 9#, %PSR[9] IS WHERE NAME OF CURRENTLY EDITED FCN GOES + PSRSIZE = 13#, + PSR = PSRM[*]#, + WF=[18:8]#, + WDSPERREC=10#, + WDSPERBLK=30#, + NAREAS=10#, + SIZEAREAS=210#, + LIBF1=[6:15]#, + LIBF2=[22:16]#, + LIBF3=[38:10]#, + LIBSPACES=1#, + IDENT=RESULT=1#, + SPECIAL=RESULT=3#, + NUMERIC=RESULT=2#, + REPLACELOC=0#, + REPLACEV=4#, + SPF=[30:18]#, + RF=[24:6]#, + DID=[1:5]#, + XRF=[12:18]#, + DDPNSW=30#, % DATA DESC PRESENT NAMED SCALAR WORD + DDNNVW=20#, %DATA DESC NON-PRES NAMED VECTOR WORD + DDNUVW=16#, %DATA DESC NONPRES..(POINTS INTO SYM TAB FOR LOCALS) + DDPUVW=24#, % DATA DESC PRESENT UNNAMED VECTOR WORD + DDNNSW=22#, % DATA DESC NON-PRES NAMED SCALAR WORD + PDC=10#, % DROG DESC CALC MODE + INTO=0#, + DDPUSW=26#, % DATA DESC PRESENT UNNAMED SCALAR WORK (MODE) + DDPUSC=27#, % DATA DESC PRESENT UNNAMED SCALAR CHR + DDPUVC=25#, % DATA DESC PRESENT UNNAMED VECTOR CHR + DDPNVC=29#, %DATA DESC PRES PERMANENT VECTOR CHAR MODE + DDPNVW=28#, %DATA DESC PRES NAMED VEC WORD (NAMED=PERMANENT) + OUTOF=1#, + NAMEDNULLV=0&7[1:45:3]#, %DLUDGE...NAMED VERSION OF NULLV + BACKP=[6:18]#, + SCALARDATA=0#, + ARRAYDATA=2#, + DATATYPE=[4:1]#, + ARRAYTYPE=[5:1]#, + CHARARRAY=1#, + NUMERICARRAY=0#, + BLOCKSIZE=30#, %#WORDS OF CONTIGUOUS DATA IN SEQUENTIAL STORE + VARTYPE=[42:6]#, + WS=WORKSPACE#, + DIMPTR=SPF#, + INPTR=BACKP#, + QUADIN=[18:3]#, + QUADINV=18:45:3#, + STATEVECTORSIZE=16#, + SUSPENDED=[5:1]#, + SUSPENDVAR=[2:1]#, + CTYPEF=3:45:3#, + CSUSVAR=2:47:1#, + CNAMED=3:47:1#, + MAXWORDSTORE=3960#, %APL PREVENTS CREATION OF ARRAYS BIGGER THAN + %3960 ELEMENTS. THIS NUMBER IS THE PRODUCT OF + %4,(NUMBER OF POINTERS TO SEQUENTIAL STORE + %BLOCKS THAT ARE STORED IN ONE WORD) + %30, (BLOCKSIZE), + %AND 33, (SIZE OF ARRAY USED TO STORE THESE + %POINTERS IN GETARRAY, MOVEARRAY, AND + %RELEASEARRAY). SUBSCRIPTS ALLOWS 8|3960 + %ELEMENTS IF THEY ARE CHARACTERS. + %HOWEVER, SP WILL GET FULL BEFORE THAT SINCE + %BIGGEST SP SIZE IS CURRENTLY 3584 + MAXBUFFSIZE=30#, + MAXHEADERARGS=30#, + BUFFERSIZE=BUFFSIZE#, + LINEBUFFER=LINEBUFF#, + LINEBUFF = OUTBUFF[*]#, + APPENDTOBUFFER=APPENDTOBUFF#, + FOUND=TARRAY[0]#, 00022000P15 + EOB=TARRAY[1]#, + MANT=TARRAY[2]#, + MANTLEN=TARRAY[3]#, + FRAC=TARRAY[4]#, + FRACLEN=TARRAY[5]#, + POWER=TARRAY[6]#, + POWERLEN=TARRAY[7]#, + MANTSIGN=TARRAY[8]#, + TABSIZE = 43#, + LOGINCODES=1#, + LOGINPHRASE=2#, + LIBRARY=1#, + WORKSPACEUNIT=2#, + RTPAREN=9#, + MASTERMODE=USERMASK.[1:1]#, + EDITOG=USERMASK.[2:1]#, + POLBUG=USERMASK.[3:1]#, + FPTF=9#, % FUNCTION POINTER FIELD (STARTS AT CHR POS 9) + FSQF=11#, % FUNCTION SEQNTL FIELD + FFL=2#, % FUNCTION FIELD LENGTH (2 CHR POSITIONS) + CRETURN=3:47:1#, + RETURNVALUE=[3:1]#, + CNUMBERARGS=4:46:2#, + NUMBERARGS=[4:2]#, + RETURNVAL=1#, + NOSYNTAX=USERMASK.[4:1]#, + LINESIZE=USERMASK.[41:7]#, + DIGITS=USERMASK.[37:4]#, + SUSPENSION=USERMASK.SUSPENDED#, + SAVEDWS=USERMASK.[7:1]#, + DELTOG=USERMASK.[6:1]#, + DELCHR="$"#, %USED IN DELPRESENT (IN FUNCTIONHANDLER) + MAXMESS=27#, + USERTOP=21#, + MARGINSIZE=6#, + LFTBRACKET=SPECIAL AND ACCUM[0]=11#, + QUADV=SPECIAL AND ACCUM[0]=10#, + QUOTEV=ACCUM[0]=20#, + EXPANDV=38#, + SLASHV=6#, + GOTOV=5#, + DOTV=17#, + ROTV=37#, + RGTBRACKET=SPECIAL AND ACCUM[0]=12#, + DELV=SPECIAL AND ACCUM[0]=13#, + PLUS = SPECIAL AND ACCUM[0] = 48#, + MINUS = SPECIAL AND ACCUM[0] = 49#, + NEGATIVE = SPECIAL AND ACCUM[0] = 51#, + TIMES = SPECIAL AND ACCUM[0] = 50#, + LOGS = SPECIAL AND ACCUM[0] = 54#, + SORTUP = SPECIAL AND ACCUM[0] = 55#, + SORTDN = SPECIAL AND ACCUM[0] = 56#, + NAND = SPECIAL AND ACCUM[0] = 58#, + NOR = SPECIAL AND ACCUM[0] = 59#, + TAKE = SPECIAL AND ACCUM[0] = 60#, + DROPIT = SPECIAL AND ACCUM[0] = 61#, + LFTARROW = SPECIAL AND ACCUM[0] = 04#, + TRANS = SPECIAL AND ACCUM[0] = 05#, + SLASH = SPECIAL AND ACCUM[0] = 06#, + INTDIVIDE = SPECIAL AND ACCUM[0] = 07#, + LFTPAREN = SPECIAL AND ACCUM[0] = 08#, + RGTPAREN = SPECIAL AND ACCUM[0] = 09#, + QUOTEQUAD = SPECIAL AND ACCUM[0] = 14#, + SEMICOLON = SPECIAL AND ACCUM[0] = 15#, + COMMA = SPECIAL AND ACCUM[0] = 16#, + DOT = SPECIAL AND ACCUM[0] = 17#, + STAR = SPECIAL AND ACCUM[0] = 18#, + AT = SPECIAL AND ACCUM[0] = 19#, + QUOTE = SPECIAL AND ACCUM[0] = 20#, + BOOLAND = SPECIAL AND ACCUM[0] = 21#, + BOOLOR = SPECIAL AND ACCUM[0] = 22#, + BOOLNOT = SPECIAL AND ACCUM[0] = 23#, + LESSTHAN = SPECIAL AND ACCUM[0] = 24#, + LESSEQ = SPECIAL AND ACCUM[0] = 25#, + EQUAL = SPECIAL AND ACCUM[0] = 26#, + GRTEQ = SPECIAL AND ACCUM[0] = 27#, + GREATER = SPECIAL AND ACCUM[0] = 28#, + NOTEQ = SPECIAL AND ACCUM[0] = 29#, + CEILING = SPECIAL AND ACCUM[0] = 30#, + FLOOR = SPECIAL AND ACCUM[0] = 31#, + STICK = SPECIAL AND ACCUM[0] = 32#, + EPSILON = SPECIAL AND ACCUM[0] = 33#, + RHO = SPECIAL AND ACCUM[0] = 34#, 00030950P16 + IOTA = SPECIAL AND ACCUM[0] = 35#, + TRACE = SPECIAL AND ACCUM[0] = 36#, + PHI = SPECIAL AND ACCUM[0] = 37#, + EXPAND = SPECIAL AND ACCUM[0] = 38#, + BASVAL = SPECIAL AND ACCUM[0] = 39#, + EXCLAMATION = SPECIAL AND ACCUM[0] = 40#, + MINUSLASH = SPECIAL AND ACCUM[0] = 41#, + QUESTION = SPECIAL AND ACCUM[0] = 42#, + OSLASH = SPECIAL AND ACCUM[0] = 43#, + TAU = SPECIAL AND ACCUM[0] = 44#, + CIRCLE = SPECIAL AND ACCUM[0] = 45#, + LOCKIT =IDENT AND ACCUM[0]="4LOCK "#, + COLON = SPECIAL AND ACCUM[0] = 47#, + QUADLFTARROW=51#, + REDUCT=52#, + ROTATE=53#, + SCANV=57#, + LINEBUFFSIZE=17#, + MAXPOLISH=100#, MESSIZE=10#, + MAXCONSTANT=30#, + MAXMEMACCESSES=3584#, %MAXSPROWS | SPRSIZE + MAXSYMBOL=30#, + MAXSPROWS=28#, + TYPEFIELD=[3:3]#, + OPTYPE=[1:2]#, + LOCFIELD=BACKP#, + ADDRFIELD=SPF#, + SYMTYPE=[3:3]#, + OPERAND=5#, + CONSTANT=2#, + OPERATOR=3#, + LOCALVAR=4#, + SYMTABSIZE=1#, + LFTPARENV=8#, + RGTPARENV=9#, + LFTBRACKETV=11#, + RGTBRACKETV=12#, + SEMICOLONV=15#, + QUAD=10#, + QQUAD=14#, + LFTARROWV=4#, + SORTUPV=55#, + SORTDNV=56#, + ALPHALABEL=1#, + NUMERICLABEL=2#, + NEXTLINE=0#, + ERRORCOND=3#, + PRESENCE=[2:1]#, + CHANGE=[1:1]#, + XEQ=1#, + CLEARCORE=2#, + WRITECORE=3#, + %%% + %%% + XEQUTE=1#, + SLICE=120#, %TIME SLICE IN 60THS OF A SECOND + ALLOC=2#, + WRITEBACK=3#, + LOOKATSTACK=5#, + + LEN=[1:23]#, + NEXT=[24:24]#, + LOC=L.[30:11],L.[41:7]#, + NOC=N.[30:11],N.[41:7]#, + MOC=M.[30:11],M.[41:7]#, + SPRSIZE=128#, % SP ROW SIZE + NILADIC=0#, + MONADIC=1#, + DYADIC=2#, + TRIADIC=3#, + DEPTHERROR=1#, + DOMAINERROR=2#, + INDEXERROR=4#, + LABELERROR=5#, + LENGTHERROR=6#, + NONCEERROR=7#, + RANKERROR=8#, + SYNTAXERROR=9#, + SYSTEMERROR=10#, + VALUEERROR=11#, + SPERROR=12#, + KITEERROR=13#, + STREAMBASE=59823125#, 00032200P17 + APLOGGED=[10:1]#, + APLHEADING=[11:1]#, + CSTATION = STATION#, + CAPLOGGED=10:47:1#, + CAPHEADING=11:47:1#, + APLCODE = STATIONPARAMS#, + + + SPECMODE = BOUNDARY.[1:3]#, + DISPLAYIMG=1#, + EDITING=2#, + DELETING=3#, + RESEQUECING=4#, + LOWER = BOUNDARY.[4:22]#, + UPPER = BOUNDARY.[26:22]#, + OLDBUFFER = OLDINPBUFFER[*]#, + + ENDEFINES=#; + REAL ADDRESS, ABSOLUTEADDRESS, + LADDRESS; + BOOLEAN LINETOG; %GO TO NEXT LINE IF TRUE WHEN WRITING OUT + INTEGER BUFFSIZE,ITEMCOUNT,RESULT, + LOGINSIZE, + %%% + ERR, + NROWS, + %%% + CUSER; + LABEL ENDOFJOB,TRYAGAIN; + REAL GT1,GT2,GT3; + DEFINE LINE=PRINT#; + SAVE ARRAY BUFFER[0:MAXBUFFSIZE]; + ARRAY TARRAY[0:8], + COMMENT PROGRAM STATE REGISTER; + PSRM[0:PSRSIZE], + OLDINPBUFFER[0:MAXBUFFSIZE], + SP[0:27, 0:SPRSIZE-1], + IDTABLE[0:TABSIZE], + MESSTAB[0:MAXMESS], + JIGGLE[0:0], + SCR[0:2], + CORRESPONDENCE[0:7], + ACCUM[0:MAXBUFFSIZE]; + DEFINE OUTBUFFSIZE=29#,CLOGGED=7:47:1#,STU=15:9:9#; + ARRAY OUTBUFF[0:OUTBUFFSIZE]; + ALPHA STATION, JOBNUM, STATIONPARAMS, BOUNDARY; + INTEGER CHRCOUNT, WORKSPACE; + + STREAM PROCEDURE INITBUFF(B,BUFFSIZE); VALUE BUFFSIZE; + BEGIN DI~B; BUFFSIZE(DS~8LIT" "); DS~LIT"~"; - END; - STREAM PROCEDURE TRANSFER(A,AS,B,BS,L); VALUE AS,BS,L; - BEGIN LOCAL T,U,V; - SI:=LOC AS; DI:=LOC T; DI:=DI+1; DS:=7CHR; - SI:=LOC BS; DI:=LOC U; DI:=DI+1; DS:=7CHR; - SI:=LOC L; DI:=LOC V; DI:=DI+1; DS:=7CHR; - SI:=A; T(2(SI:=SI+32)); SI:=SI+AS; - DI:=B; U(2(DI:=DI+32)); DI:=DI+BS; - V(2(DS:=32CHR)); DS:=L CHR; - END; - REAL PROCEDURE NUMBER; FORWARD; %LINE 111500 - BOOLEAN PROCEDURE SCAN; - BEGIN - REAL STREAM PROCEDURE GNC(ADDR,ACC); VALUE ADDR; - BEGIN SI:=ADDR; DI:=ACC; DI:=DI+7; DS:=CHR; GNC:=SI; - DI:=ACC; SKIP DB; DS:=SET; END OF GNC; - REAL STREAM PROCEDURE RESWD(TAB,BUF,ADDR,EOB,FOUND,K); - VALUE ADDR,K; - BEGIN - LOCAL T,TSI,TDI; - LABEL TRY,L,KEEPGOING,FINIS,RESTORE; - LABEL NUMBERFOUND; - DI:=EOB; DS:=8LIT"0"; DI:=FOUND; DS:=8LIT"0"; - SI:=ADDR; - L: IF SC NEQ " " THEN GO TO KEEPGOING; - SI:=SI+1; - GO TO L; - KEEPGOING: - RESWD:=SI; - ADDR:=SI; - IF SC GEQ "0" THEN IF SC LEQ "9" THEN GO TO NUMBERFOUND; - IF SC="#" THEN GO TO NUMBERFOUND; 00059100 - IF SC="@" THEN GO TO NUMBERFOUND; - IF SC="." THEN - BEGIN SI:=SI+1; - IF SC GEQ "0" THEN IF SC LEQ "9" THEN - GO TO NUMBERFOUND; SI:=SI-1; - END; - DI:=LOC T; DS:=2RESET; DS:=2SET; DS:=2RESET; - DI:=LOC T; - IF SC=DC THEN - BEGIN DI:=EOB; DI:=DI+7; DS:=LIT"1"; - GO TO FINIS - END; - SI:=TAB; TSI:=SI; - TRY: - IF SC="0" THEN - BEGIN SI:=ADDR; - IF SC=ALPHA THEN - IF SC GEQ"0" THEN - IF SC LEQ "9" THEN -NUMBERFOUND: - TALLY:=2 ELSE TALLY := 0 - ELSE TALLY:=1 - ELSE TALLY:=3; - T:=TALLY; SI:=LOC T; SI:=SI+7; DI:=FOUND; DI:=DI+7; - DS:=CHR; GO FINIS; - END; - DI:=LOC T; DI:=DI+7; DS:=CHR; - DI:=ADDR; - IF T SC=DC THEN - BEGIN - TSI:=SI; TDI:=DI; SI:=SI-1; - IF SC=ALPHA THEN - BEGIN DI:=DI+16; SI:=TDI; - IF SC NEQ " " THEN IF SC =ALPHA THEN ; - END; - SI:=TSI; - END ELSE GO TO RESTORE; - IF TOGGLE THEN - RESTORE: - BEGIN SI:=SI+K; DI:=ADDR; GO TO TRY - END; - DI:=FOUND; DS:=K OCT; - DI:=TDI; RESWD:=DI; - FINIS: - END; -REAL STREAM PROCEDURE ACCUMULATE(ACC,EDB,ADDR); VALUE ADDR; - BEGIN LOCAL T; LABEL EOBL,E,ON,L; - DI:=ACC; 9(DS:=8LIT" "); - DI:=EOB; DS:=8LIT"0"; SI:=ADDR; DI:=LOC T; SKIP 2 DB; - DS:=2SET; DI:=LOC T; - 63(IF SC=ALPHA THEN TALLY:=TALLY+1 ELSE JUMP OUT TO E; - SI:=SI+1); - L: IF SC=ALPHA THEN BEGIN SI:=SI+1; GO L END ELSE GO ON; - IF SC=" " THEN GO ON; - E: IF SC = DC THEN ; - SI:=SI-1; IF TOOGLE THEN GO TO EOBL ELSE GO ON; - EOBL: DI:=EOB; DI:=DI+7; DS:=LIT"1"; - ON: ACCUMULATE:=SI; DI:=ACC; T:=TALLY; SI:=LOC T; SI:=SI+6; - DS:=2CHR; SI:=ADDR; DS:=T CHR; - END OF ACCUMULATE; -BOOLEAN STREAM PROCEDURE ARROW(ADDR,I); VALUE ADDR,I; - BEGIN SI:=ADDR; SI:=SI-1; DI:=LOC I; DI:=DI+7; - IF SC=DC THEN TALLY:=1; ARROW :=TALLY - END OF ARROW; - IF NOT BOOLEAN(EOB) THEN BEGIN - LADDRESS:=ADDRESS; - ADDRESS:=RESWD(IDTABLE,BUFFER,ADDRESS,EOB,FOUND,2); - IF RESULT:=FOUND NEQ 0 THEN BEGIN - IF RESULT=1 THEN ADDRESS:=ACCUMULATE(ACCUM,EOB,ADDRESS) - ELSE IF RESULT=2 THEN ACCUM[0]:=NUMBER - ELSE IF RESULT=3 THEN ADDRESS:=GNC(ADDRESS,ACCUM) - ELSE BEGIN ACCUM[0]:=RESULT; RESULT:=3 END; - ITEMCOUNT:=ITEMCOUNT+1; - SCAN:=TRUE; - IF ARROW(ADDRESS,31) THEN - BEGIN EOB:=1; SCAN:=FALSE END; - END ELSE EOB:=1; - END; - END OF THE SCAN PROCEDURE; -PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,RL,S,N; - INTEGER CC,BL,S,N; ARRAY A[0]; FORWARD - ; -PROCEDURE INDENT(R); VALUE R; REAL R; FORWARD; 00096300 -PROCEDURE TERPRINT; FORWARD; -PROCEDURE PROCESS(MODE);VALUE MODE;INTEGER MODE; FORWARD; -REAL STREAM PROCEDURE ABSADDR(A); - BEGIN SI:=A; ABSADDR:=SI - END; -BOOLEAN PROCEDURE LIBRARIAN(MFID,FID); VALUE MFID,FID; - REAL MFID,FID; - BEGIN - REAL ARRAY A[0:6]; FILE DF DISK(1,1); - REAL T; - COMMENT LIBRARIAN IS TRUE IF MFID/FID IS PRESENT ON DISK; - FILL DF WITH MFID,FID; - SEARCH(DF,A[*]); - LIBRARIAN:= + END; + STREAM PROCEDURE TRANSFER(A,AS,B,BS,L); VALUE AS,BS,L; + BEGIN LOCAL T,U,V; + SI:=LOC AS; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=LOC BS; DI:=LOC U; DI:=DI+1; DS:=7CHR; + SI:=LOC L; DI:=LOC V; DI:=DI+1; DS:=7CHR; + SI:=A; T(2(SI:=SI+32)); SI:=SI+AS; + DI:=B; U(2(DI:=DI+32)); DI:=DI+BS; + V(2(DS:=32CHR)); DS:=L CHR; + END; + REAL PROCEDURE NUMBER; FORWARD; %LINE 111500 + BOOLEAN PROCEDURE SCAN; + BEGIN + REAL STREAM PROCEDURE GNC(ADDR,ACC); VALUE ADDR; + BEGIN SI:=ADDR; DI:=ACC; DI:=DI+7; DS:=CHR; GNC:=SI; + DI:=ACC; SKIP DB; DS:=SET; END OF GNC; + REAL STREAM PROCEDURE RESWD(TAB,BUF,ADDR,EOB,FOUND,K); + VALUE ADDR,K; + BEGIN + LOCAL T,TSI,TDI; + LABEL TRY,L,KEEPGOING,FINIS,RESTORE; + LABEL NUMBERFOUND; + DI:=EOB; DS:=8LIT"0"; DI:=FOUND; DS:=8LIT"0"; + SI:=ADDR; + L: IF SC NEQ " " THEN GO TO KEEPGOING; + SI:=SI+1; + GO TO L; + KEEPGOING: + RESWD:=SI; + ADDR:=SI; + IF SC GEQ "0" THEN IF SC LEQ "9" THEN GO TO NUMBERFOUND; + IF SC="#" THEN GO TO NUMBERFOUND; 00059100P18 + IF SC="@" THEN GO TO NUMBERFOUND; + IF SC="." THEN + BEGIN SI:=SI+1; + IF SC GEQ "0" THEN IF SC LEQ "9" THEN + GO TO NUMBERFOUND; SI:=SI-1; + END; + DI:=LOC T; DS:=2RESET; DS:=2SET; DS:=2RESET; + DI:=LOC T; + IF SC=DC THEN + BEGIN DI:=EOB; DI:=DI+7; DS:=LIT"1"; + GO TO FINIS + END; + SI:=TAB; TSI:=SI; + TRY: + IF SC="0" THEN + BEGIN SI:=ADDR; + IF SC=ALPHA THEN + IF SC GEQ"0" THEN + IF SC LEQ "9" THEN +NUMBERFOUND: + TALLY:=2 ELSE TALLY := 0 + ELSE TALLY:=1 + ELSE TALLY:=3; + T:=TALLY; SI:=LOC T; SI:=SI+7; DI:=FOUND; DI:=DI+7; + DS:=CHR; GO FINIS; + END; + DI:=LOC T; DI:=DI+7; DS:=CHR; + DI:=ADDR; + IF T SC=DC THEN + BEGIN + TSI:=SI; TDI:=DI; SI:=SI-1; + IF SC=ALPHA THEN + BEGIN DI:=DI+16; SI:=TDI; + IF SC NEQ " " THEN IF SC =ALPHA THEN ; + END; + SI:=TSI; + END ELSE GO TO RESTORE; + IF TOGGLE THEN + RESTORE: + BEGIN SI:=SI+K; DI:=ADDR; GO TO TRY + END; + DI:=FOUND; DS:=K OCT; + DI:=TDI; RESWD:=DI; + FINIS: + END; +REAL STREAM PROCEDURE ACCUMULATE(ACC,EDB,ADDR); VALUE ADDR; + BEGIN LOCAL T; LABEL EOBL,E,ON,L; + DI:=ACC; 9(DS:=8LIT" "); + DI:=EOB; DS:=8LIT"0"; SI:=ADDR; DI:=LOC T; SKIP 2 DB; + DS:=2SET; DI:=LOC T; + 63(IF SC=ALPHA THEN TALLY:=TALLY+1 ELSE JUMP OUT TO E; + SI:=SI+1); + L: IF SC=ALPHA THEN BEGIN SI:=SI+1; GO L END ELSE GO ON; + IF SC=" " THEN GO ON; + E: IF SC = DC THEN ; + SI:=SI-1; IF TOOGLE THEN GO TO EOBL ELSE GO ON; + EOBL: DI:=EOB; DI:=DI+7; DS:=LIT"1"; + ON: ACCUMULATE:=SI; DI:=ACC; T:=TALLY; SI:=LOC T; SI:=SI+6; + DS:=2CHR; SI:=ADDR; DS:=T CHR; + END OF ACCUMULATE; +BOOLEAN STREAM PROCEDURE ARROW(ADDR,I); VALUE ADDR,I; + BEGIN SI:=ADDR; SI:=SI-1; DI:=LOC I; DI:=DI+7; + IF SC=DC THEN TALLY:=1; ARROW :=TALLY + END OF ARROW; + IF NOT BOOLEAN(EOB) THEN BEGIN + LADDRESS:=ADDRESS; + ADDRESS:=RESWD(IDTABLE,BUFFER,ADDRESS,EOB,FOUND,2); + IF RESULT:=FOUND NEQ 0 THEN BEGIN + IF RESULT=1 THEN ADDRESS:=ACCUMULATE(ACCUM,EOB,ADDRESS) + ELSE IF RESULT=2 THEN ACCUM[0]:=NUMBER + ELSE IF RESULT=3 THEN ADDRESS:=GNC(ADDRESS,ACCUM) + ELSE BEGIN ACCUM[0]:=RESULT; RESULT:=3 END; + ITEMCOUNT:=ITEMCOUNT+1; + SCAN:=TRUE; + IF ARROW(ADDRESS,31) THEN + BEGIN EOB:=1; SCAN:=FALSE END; + END ELSE EOB:=1; + END; + END OF THE SCAN PROCEDURE; +PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,RL,S,N; + INTEGER CC,BL,S,N; ARRAY A[0]; FORWARD + ; +PROCEDURE INDENT(R); VALUE R; REAL R; FORWARD; 00096300P19 +PROCEDURE TERPRINT; FORWARD; +PROCEDURE PROCESS(MODE);VALUE MODE;INTEGER MODE; FORWARD; +REAL STREAM PROCEDURE ABSADDR(A); + BEGIN SI:=A; ABSADDR:=SI + END; +BOOLEAN PROCEDURE LIBRARIAN(MFID,FID); VALUE MFID,FID; + REAL MFID,FID; + BEGIN + REAL ARRAY A[0:6]; FILE DF DISK(1,1); + REAL T; + COMMENT LIBRARIAN IS TRUE IF MFID/FID IS PRESENT ON DISK; + FILL DF WITH MFID,FID; + SEARCH(DF,A[*]); + LIBRARIAN:= A[0]!-1; - END; -FILE SPO 11(1,3); -PROCEDURE SPOUT(K); VALUE K; INTEGER K; - BEGIN FORMAT ERRF("APL ERROR:",I8,A1); - WRITE(SPO,ERRF,K,31); - END; -PROCEDURE INITIALIZETABLE; - BEGIN DEFINE STARTSEGMENT= #; - INTEGER I; - LADDRESS:= - ABSOLUTEADDRESS:=ABSADDR(BUFFER); - BIGGEST := REAL(NOT FALSE) & 0[1:46:2]; - NULLV := 0 & 3[1:46:2]; + END; +FILE SPO 11(1,3); +PROCEDURE SPOUT(K); VALUE K; INTEGER K; + BEGIN FORMAT ERRF("APL ERROR:",I8,A1); + WRITE(SPO,ERRF,K,31); + END; +PROCEDURE INITIALIZETABLE; + BEGIN DEFINE STARTSEGMENT= #; + INTEGER I; + LADDRESS:= + ABSOLUTEADDRESS:=ABSADDR(BUFFER); + BIGGEST := REAL(NOT FALSE) & 0[1:46:2]; + NULLV := 0 & 3[1:46:2]; STATUSWORD~REAL(BOOLEAN(STATUSWORD) OR BOOLEAN(1)); JOBNUM~TIME(-1); STATION~0&1[CLOGGED]&STATUSWORD[STU]; FILL JIGGLE[*] WITH OCT5757575757575737;%CARRIAGE RETURNS LEFT ARROW - FILL IDTABLE[*] WITH - "1+481-49", "1&501%07", "1.171@19", "1#411(08", - "1)091/06", "3XEQ623L", "OG541;15", OCT0333777601040177, + FILL IDTABLE[*] WITH + "1+481-49", "1&501%07", "1.171@19", "1#411(08", + "1)091/06", "3XEQ623L", "OG541;15", OCT0333777601040177, %LAST IN ABOVE LINE IS REALLY 3["]141" - "202:=042", "[]101[11", "1]123AND", "212OR223", - "NOT233LS", "S243LEQ2", "53GEQ273", "GTR283NE", "Q292=:05", - "2GO051=2", "63MAX304", "CEIL303F", "LR313MIN", - "314RESD3","23ABS323","RHO341*1","84IOTA35", - "1|384RND", "M425TRAN", "S431$133", "PHI374FA", - "CT404COM", "B406CIRC", "LE456SOR", "TUP556SO", - "RTDN561:", "474NAND5", "83NOR594", "TAKE604D", - "ROP613RE", "P446BASV", "AL393EPS", "331,1600"; - COMMENT IDTABLE IS TABLE OF RESERVED WORDS AND SPECIAL SYMBOLS. - FORMAT IS NUMBER OF CHARACTERS IN SYMBOL, FOLLOWED BY SYMBOL - ITSELF, FOLLOWED BY A TWO-DIGIT DECIMAL CODE WHICH APL USES - FOR THE RESERVED WORD--LIKE IN THE EXECUTION CASE STATEMENT AND - IN SYNTAX CHECKING. FOR SCAN TO WORK, THE TWO-DIGIT CODE MUST - BE GREATER THAN 3 AND IDTABLE MUST HAVE AT LEAST ONE "0" AT THE - END TO MARK THE END. TABSIZE IS THE DEFINE (LINE 30000) GIVING + "202:=042", "[]101[11", "1]123AND", "212OR223", + "NOT233LS", "S243LEQ2", "53GEQ273", "GTR283NE", "Q292=:05", + "2GO051=2", "63MAX304", "CEIL303F", "LR313MIN", + "314RESD3","23ABS323","RHO341*1","84IOTA35", + "1|384RND", "M425TRAN", "S431$133", "PHI374FA", + "CT404COM", "B406CIRC", "LE456SOR", "TUP556SO", + "RTDN561:", "474NAND5", "83NOR594", "TAKE604D", + "ROP613RE", "P446BASV", "AL393EPS", "331,1600"; + COMMENT IDTABLE IS TABLE OF RESERVED WORDS AND SPECIAL SYMBOLS. + FORMAT IS NUMBER OF CHARACTERS IN SYMBOL, FOLLOWED BY SYMBOL + ITSELF, FOLLOWED BY A TWO-DIGIT DECIMAL CODE WHICH APL USES + FOR THE RESERVED WORD--LIKE IN THE EXECUTION CASE STATEMENT AND + IN SYNTAX CHECKING. FOR SCAN TO WORK, THE TWO-DIGIT CODE MUST + BE GREATER THAN 3 AND IDTABLE MUST HAVE AT LEAST ONE "0" AT THE + END TO MARK THE END. TABSIZE IS THE DEFINE (LINE 30000) GIVING THE SIZE OF IDTABLE; - IF STACKSIZE=0 THEN STACKSIZE:=100 ELSE - IF STACKSIZE GTR 1022 THEN STACKSIZE:=1022; - BUFFSIZE:=MAXBUFFSIZE; - LINETOG := TRUE; %USUALLY GO TO NEXT LINE WHEN WRITING OUT - - INITBUFF(OUTBUFF, 10); - INITBUFF(BUFFER,BUFFSIZE); - NROWS:=-1; - NAME(LIBJOB,TIME(-1)); - FILL MESSTAB[*] WITH - "4SAVE ", - "4LOAD ", - "5CLEAR ", - "4COPY ", - "4VARS ", - "3FNS ", - "6LOGGED", - "3MSG ", - "5WIDTH ", - "3OPR ", - "6DIGITS", - "3OFF ", - "6ORIGIN", - "4SEED ", - "4FUZZ ", - "3SYN ", - "5NOSYN ", - "5STORE ", - "5ABORT ", - "2SI ", - "3SIV ", 00105360 - "5ERASE ", - %--------------MASTERMODE BELOW HERE...(SEE USERTOP)-------- - "6ASSIGN", - "6DELETE", - "4LIST ", - "5DEBUG ", - "5FILES "; - - IF LIBSIZE=-1 THEN + IF STACKSIZE=0 THEN STACKSIZE:=100 ELSE + IF STACKSIZE GTR 1022 THEN STACKSIZE:=1022; + BUFFSIZE:=MAXBUFFSIZE; + LINETOG := TRUE; %USUALLY GO TO NEXT LINE WHEN WRITING OUT + + INITBUFF(OUTBUFF, 10); + INITBUFF(BUFFER,BUFFSIZE); + NROWS:=-1; + NAME(LIBJOB,TIME(-1)); + FILL MESSTAB[*] WITH + "4SAVE ", + "4LOAD ", + "5CLEAR ", + "4COPY ", + "4VARS ", + "3FNS ", + "6LOGGED", + "3MSG ", + "5WIDTH ", + "3OPR ", + "6DIGITS", + "3OFF ", + "6ORIGIN", + "4SEED ", + "4FUZZ ", + "3SYN ", + "5NOSYN ", + "5STORE ", + "5ABORT ", + "2SI ", + "3SIV ", 00105360P20 + "5ERASE ", + %--------------MASTERMODE BELOW HERE...(SEE USERTOP)-------- + "6ASSIGN", + "6DELETE", + "4LIST ", + "5DEBUG ", + "5FILES "; + + IF LIBSIZE=-1 THEN BEGIN LIBSIZE~1;GTA[0]~" ";STOREORD(LIBRARY,GTA,0);WRAPUP; END ELSE BEGIN LIBSIZE~SIZE(LIBRARY); FOR I~1 STEP 1 UNTIL LIBSIZE-1 DO BEGIN GT1~CONTENTS(LIBRARY,I,ACCUM); - IF NOT LIBRARIAN(ACCUM[0],TIME(-1)) THEN + IF NOT LIBRARIAN(ACCUM[0],TIME(-1)) THEN BEGIN DELETE1(LIBRARY,I);LIBSIZE~LIBSIZE-1;END; - IF (LOGINSIZE:=SIZE(LOGINCODES)=0) THEN - END; - END; - FILL CORRESPONDENCE[*] WITH - OCT1111111111110311, - OCT1111111111111111, - OCT1104111121221113, - OCT2014151617100706, - OCT1111111111111112, - OCT1111111111111100, - OCT0201111111251111, - OCT2324111111111111; - COMMENT CORRESPONDENCE GIVES THE CORRESPONDENCE BETWEEN THE - APL CODES FOR DYADIC SCALAR OPERATORS (EXCEPT CIRCLE) AND - THEIR POSITIONS IN THE "CASE STATEMENT" IN "OPERATION". - E.G. APL CODE 7 IS "OPERATION" CODE 3 IN OCTAL (FOR DIVIDE). - IF N-TH CHARACTER IN CORRESPONDECE IS OCTAL 11, THEN N - IS NOT AN APL CODE FOR A DYADIC SCALAR OPERATOR. CHARACTER - COUNT STARTS AT 1 FOR FIRST CHARACTER. TO MAKE IT COME OUT - RIGHT, STREAM PROCEDURE GETOP IS ACTUALLY CALLED WITH APL - OPERATION CODE MINUS 1; - END; -REAL STREAM PROCEDURE CONV(ADDR,N); - VALUE N,ADDR; - BEGIN SI:=ADDR; - DI:=LOC CONV; - DS:=N OCT; END; -REAL STREAM PROCEDURE BUMP(ADDR,N); VALUE ADDR,N; - BEGIN SI:=ADDR; SI:=SI+N; BUMP:=SI; END; -REAL PROCEDURE NUMBER; - BEGIN REAL NCHR; - LABEL GETFRAC,GETPOWER,QUIT,KITE; - MONITOR EXPOVR; - REAL PROCEDURE INTCON(COUNT); VALUE COUNT; - REAL COUNT; - BEGIN REAL TLO,THI,T; INTEGER N; - BOOLEAN DPTOG; DEFINE ADDR=ADDRESS#; - COMMENT: VALUE OF INTCON IS THE CONVERSION OF AN INTEGER - CONSISTING OF COUNT NUMERICAL CHARACTERS STARTING - AT THE CHARACTER ADDRESS. ADDRESS IS SET TO POINT - TO THE NEXT CHARACTER DURING INTCON; - DPTOG:=COUNT GTR 8; - THI:=T:=CONV(ADDR,N:=COUNT MOD 8); - ADDR:=BUMP(ADDR,N); - COUNT:=COUNT DIV 8; - FOR N:=1 STEP 1 UNTIL COUNT DO BEGIN - IF DPTOG THEN BEGIN + IF (LOGINSIZE:=SIZE(LOGINCODES)=0) THEN + END; + END; + FILL CORRESPONDENCE[*] WITH + OCT1111111111110311, + OCT1111111111111111, + OCT1104111121221113, + OCT2014151617100706, + OCT1111111111111112, + OCT1111111111111100, + OCT0201111111251111, + OCT2324111111111111; + COMMENT CORRESPONDENCE GIVES THE CORRESPONDENCE BETWEEN THE + APL CODES FOR DYADIC SCALAR OPERATORS (EXCEPT CIRCLE) AND + THEIR POSITIONS IN THE "CASE STATEMENT" IN "OPERATION". + E.G. APL CODE 7 IS "OPERATION" CODE 3 IN OCTAL (FOR DIVIDE). + IF N-TH CHARACTER IN CORRESPONDECE IS OCTAL 11, THEN N + IS NOT AN APL CODE FOR A DYADIC SCALAR OPERATOR. CHARACTER + COUNT STARTS AT 1 FOR FIRST CHARACTER. TO MAKE IT COME OUT + RIGHT, STREAM PROCEDURE GETOP IS ACTUALLY CALLED WITH APL + OPERATION CODE MINUS 1; + END; +REAL STREAM PROCEDURE CONV(ADDR,N); + VALUE N,ADDR; + BEGIN SI:=ADDR; + DI:=LOC CONV; + DS:=N OCT; END; +REAL STREAM PROCEDURE BUMP(ADDR,N); VALUE ADDR,N; + BEGIN SI:=ADDR; SI:=SI+N; BUMP:=SI; END; +REAL PROCEDURE NUMBER; + BEGIN REAL NCHR; + LABEL GETFRAC,GETPOWER,QUIT,KITE; + MONITOR EXPOVR; + REAL PROCEDURE INTCON(COUNT); VALUE COUNT; + REAL COUNT; + BEGIN REAL TLO,THI,T; INTEGER N; + BOOLEAN DPTOG; DEFINE ADDR=ADDRESS#; + COMMENT: VALUE OF INTCON IS THE CONVERSION OF AN INTEGER + CONSISTING OF COUNT NUMERICAL CHARACTERS STARTING + AT THE CHARACTER ADDRESS. ADDRESS IS SET TO POINT + TO THE NEXT CHARACTER DURING INTCON; + DPTOG:=COUNT GTR 8; + THI:=T:=CONV(ADDR,N:=COUNT MOD 8); + ADDR:=BUMP(ADDR,N); + COUNT:=COUNT DIV 8; + FOR N:=1 STEP 1 UNTIL COUNT DO BEGIN + IF DPTOG THEN BEGIN DOUBLE(THI,TLO,100000000.0,0,|,CONV(ADDR,8), - 0,+,:=,THI,TLO); - T:=THI + 0,+,:=,THI,TLO); + T:=THI END ELSE T:=T|100000000 + CONV(ADDR,8); - ADDR:=BUMP(ADDR,8); END; - INTCON:=T; - END OF INTCON; - INTEGER STREAM PROCEDURE SUBSCAN(ADDR,NEXT); VALUE ADDR; - BEGIN SI:=ADDR; - 63(IF SC GEQ "0" THEN - IF SC LEQ "9" THEN BEGIN SI:=SI+1; TALLY:=TALLY+1; - END ELSE JUMP OUT); - DI:=NEXT; DI:=DI+7; DS:=1 CHR; SUBSCAN:=TALLY; - END; - COMMENT--VALUE OF SUBSCAN IS NUMBER OF NUMERIC CHARACTERS - FOUND. NEXT CONTAINS THE FIRST NON-NUMERIC CHARACTER; - EXPOVR:=KITE; - MANTSIGN:=1; - MANT:=MANTLEN:=POWER:=POWERLEN:=FRAC:=FRACLEN:=0; - MANLEN:=SUBSCAN(ADDRESS,NCHR); - IF MANTLEN=0 AND NCHR="#" THEN BEGIN 00130500 - MANTSIGN:=-1; - ADDRESS:=BUMP(ADDRESS,1); - MANTLEN:=SUBSCAN(ADDRESS,NCHR); END; - IF MANTLEN=0 THEN BEGIN ADDRESS:=BUMP(ADDRESS,1); - IF NCHR="." THEN GO TO GETFRAC - ELSE IF NCHR="@" OR NCHR="E" THEN GO TO GETPOWER - ELSE BEGIN ERR:=SYNTAXERROR; - GO TO QUIT; END; END; - MANT:=INTCON(MANTLEN); - IF NCHR="." THEN BEGIN ADDRESS:=BUMP(ADDRESS,1); GO GETFRAC END; - IF NCHR="@" OR NCHR="E" THEN BEGIN - ADDRESS:=BUMP(ADDRESS,1); GO TO GETPOWER END; - IF NCHR=12 THEN EOB:=1; - GO TO QUIT; - GETFRAC: FRACLEN:=SUBSCAN(ADDRESS,NCHR); - IF FRACLEN=0 THEN BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END; - FRAC:=INTCON(FRACLEN); - IF NCHR="@" OR NCHR="E" THEN BEGIN - ADDRESS:=BUMP(ADDRESS,1); GO TO GETPOWER; END; - IF NCHR=12 THEN EOB:=1 ELSE - IF NCHR="." OR NCHR="#" THEN ERR:=SYNTAXERROR; - GO TO QUIT; - GETPOWER: - POWERLEN:=SUBSCAN(ADDRESS,NCHR); - IF POWERLEN=0 THEN BEGIN - IF NCHR="-" OR NCHR="#" THEN POWER:=-1 - ELSE IF NCHR="+" THEN POWER:=1 - ELSE BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END; - POWERLEN:=SUBSCAN(ADDRESS:=BUMP(ADDRESS,1), NCHR); - END ELSE POWER:=1; - IF POWERLEN=0 THEN ERR:=SYNTAXERROR - ELSE BEGIN + ADDR:=BUMP(ADDR,8); END; + INTCON:=T; + END OF INTCON; + INTEGER STREAM PROCEDURE SUBSCAN(ADDR,NEXT); VALUE ADDR; + BEGIN SI:=ADDR; + 63(IF SC GEQ "0" THEN + IF SC LEQ "9" THEN BEGIN SI:=SI+1; TALLY:=TALLY+1; + END ELSE JUMP OUT); + DI:=NEXT; DI:=DI+7; DS:=1 CHR; SUBSCAN:=TALLY; + END; + COMMENT--VALUE OF SUBSCAN IS NUMBER OF NUMERIC CHARACTERS + FOUND. NEXT CONTAINS THE FIRST NON-NUMERIC CHARACTER; + EXPOVR:=KITE; + MANTSIGN:=1; + MANT:=MANTLEN:=POWER:=POWERLEN:=FRAC:=FRACLEN:=0; + MANLEN:=SUBSCAN(ADDRESS,NCHR); + IF MANTLEN=0 AND NCHR="#" THEN BEGIN 00130500P21 + MANTSIGN:=-1; + ADDRESS:=BUMP(ADDRESS,1); + MANTLEN:=SUBSCAN(ADDRESS,NCHR); END; + IF MANTLEN=0 THEN BEGIN ADDRESS:=BUMP(ADDRESS,1); + IF NCHR="." THEN GO TO GETFRAC + ELSE IF NCHR="@" OR NCHR="E" THEN GO TO GETPOWER + ELSE BEGIN ERR:=SYNTAXERROR; + GO TO QUIT; END; END; + MANT:=INTCON(MANTLEN); + IF NCHR="." THEN BEGIN ADDRESS:=BUMP(ADDRESS,1); GO GETFRAC END; + IF NCHR="@" OR NCHR="E" THEN BEGIN + ADDRESS:=BUMP(ADDRESS,1); GO TO GETPOWER END; + IF NCHR=12 THEN EOB:=1; + GO TO QUIT; + GETFRAC: FRACLEN:=SUBSCAN(ADDRESS,NCHR); + IF FRACLEN=0 THEN BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END; + FRAC:=INTCON(FRACLEN); + IF NCHR="@" OR NCHR="E" THEN BEGIN + ADDRESS:=BUMP(ADDRESS,1); GO TO GETPOWER; END; + IF NCHR=12 THEN EOB:=1 ELSE + IF NCHR="." OR NCHR="#" THEN ERR:=SYNTAXERROR; + GO TO QUIT; + GETPOWER: + POWERLEN:=SUBSCAN(ADDRESS,NCHR); + IF POWERLEN=0 THEN BEGIN + IF NCHR="-" OR NCHR="#" THEN POWER:=-1 + ELSE IF NCHR="+" THEN POWER:=1 + ELSE BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END; + POWERLEN:=SUBSCAN(ADDRESS:=BUMP(ADDRESS,1), NCHR); + END ELSE POWER:=1; + IF POWERLEN=0 THEN ERR:=SYNTAXERROR + ELSE BEGIN POWER:=INTCON(POWERLEN)|POWER; - IF NCHR="#" OR NCHR="@" OR NCHR="." - THEN ERR:=SYNTAXERROR; END; - GO TO QUIT; - KITE: ERR:=KITEERROR; - QUIT: IF ERR=0 THEN - NUMBER:=IF MANTLEN+FRACLEN=0 THEN - IF POWERLEN=0 THEN 0 + IF NCHR="#" OR NCHR="@" OR NCHR="." + THEN ERR:=SYNTAXERROR; END; + GO TO QUIT; + KITE: ERR:=KITEERROR; + QUIT: IF ERR=0 THEN + NUMBER:=IF MANTLEN+FRACLEN=0 THEN + IF POWERLEN=0 THEN 0 ELSE MANTSIGN|10*ENTIER(POWER) ELSE MANTSIGN|(MANT|10*ENTIER(POWER) + FRAC|10*ENTIER(POWER-FRACLEN)) ELSE EOB:=1; - END OF NUMBER; -STREAM PROCEDURE APPENDTOBUFF(BUF,NBUF,NBLANK,A,SA,NA); - VALUE NBUF,NBLANK,SA,NA; - BEGIN LOCAL T; - LOCAL TSI,TDI; - SI:=LOC NBUF; DI:=LOC T; DI:=DI+1; DS:=7CHR; - DI:=BUF; T(2(DI:=DI+32)); DI:=DI+NBUF; - NBLANK(DS:=LIT" "); TDI:=DI; - SI:=LOC SA; DI:=LOC T; DI:=DI+1; DS:=7CHR; - SI:=A; T(2(SI:=SI+32)); SI:=SI+SA; - TSI:=SI; SI:=LOC NA; DI:=LOC T; DI:=DI+1; DS:=7CHR; - SI:=TSI; DI:=TDI; T(2(DS:=32CHR)); DS:=NA CHR - END; -PROCEDURE TERPRINT; - BEGIN LABEL BK; -STREAM PROCEDURE FINISHBUFF(BUF,N,TER);VALUE N,TER; - BEGIN LOCAL T; - SI:=LOC TER;SI:=SI+7;IF SC="1" THEN; - SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7 CHR; - DI:=BUF; T(2(DI:=DI+32));DI:=DI+N; - IF TOOGLE THEN DS:=2 LIT"{!"; %CARRIAGE RETURN/LINE FEED - DS:=RESET;DS:=5 SET; %END OF MESSAGE LEFT ARROW - END OF FINISHBUFF; - IF CHRCOUNT NEQ 0 THEN BEGIN - FINISHBUFF(OUTBUFF,CHRCOUNT,LINETOG); - CHRCOUNT:=0; - IF LINETOG THEN - WRITE(TWXOUT,9,OUTBUFF[*])[BK:BK] ELSE - WRITE(TWXOUT[STOP],9,OUTBUFF[*])[BK:BK]; - INITBUFF(OUTBUFF, 10); - END; - IF FALSE THEN -OK: IF CURRENTMODE=XEQMODE THEN BREAKFLAG:=TRUE; - END OF TERPRINT; -PROCEDURE FORMWD(CC,WD); VALUE CC,WD; REAL WD; INTEGER CC; - BEGIN - INTEGER I,K,L; - COMMENT CC=-1 STAY ON LINE, OUTPUT, DON"T GO TO NEXT LINE - COMMENT CC=0 STAY ON THIS LINE, MORE TO COME. - CC=1 STAY ON THIS LINE BUT TERMINATE PRINT. 00257000 - CC=2 SKIP TO NEXT LINE - MORE TO COME. - CC=3 SKIP TO NEXT LINE - TERMINATE PRINT.; - REAL STREAM PROCEDURE OCTAL(I); VALUE I; - BEGIN SI:=LOC I; DI:=LOC OCTAL; DS:=8OCT - END; - IF L:=LINESIZE LEQ 9 OR L GTR 72 THEN L:=72; K:=2; - IF CC GTR 1 AND CHRCOUNT GTR OTHEN TERPRINT; - IF CHRCOUNT+(I:=OCTAL(WD.[1:11])) GTR L THEN - - BEGIN APPENDTOBUFF(LINEBUFFER,CHRCOUNT, - 0,WD,2,K:=L-CHRCOUNT); - CHRCOUNT:=L; TERPRINT; - - I:=I-K; - - END; - APPENDTOBUFF(LINEBUFFER,CHRCOUNT,0,WD,K,I); - - CHRCOUNT:=CHRCOUNT+I; - IF BOOLEAN(CC) THEN - IF CC=-1 THEN BEGIN LINETOG:=FALSE; - TERPRINT; LINETOG:=TRUE - END ELSE TERPRINT; - END; -BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR); - ARRAY SPECS[0]; REAL HADDR; FORWARD; - - - -REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R; - COMMENT STARTS ON 8030000; - FORWARD; - -PROCEDURE INDENT(R); VALUE R; REAL R; - BEGIN - INTEGER STREAM PROCEDURE FORM(A,I,K);VALUE K,I; - BEGIN - LOCAL T1,T2; - LABEL SHORT,L,M,FINIS; - TALLY:=K; FORM:=TALLY; - SI:=LOC I; DI:=LOC T1; IF 8SC=DC THEN - BEGIN DI:=A; K(DS:=LIT" "); GO FINIS - END; - SI:=LOC I; DI:=A; TALLY:=3; DS:=LIT"["; - IF SC GTR "0" THEN IF SC LSS "0" THEN ; - 3(TALLY:=TALLY+1; IF TOGGLE THEN DS:=CHR ELSE - IF SC NEQ "0" THEN DS:=CHR ELSE - BEGIN TALLY:=TALLY+63; SI:=SI+1 - END ); - DS:=CHR; T1:=TALLY; TALLY:=4; SI:=SI+3; - 4(IF SC NEQ "0" THEN JUMP OUT TO M; - TALLY:=TALLY+63; SI:=SI-1); GO TO L; - M: - T2:=TALLY; SI:=LOC I; SI:=SI+4; DS:=LIT"."; DS:=T2 CHR; - TALLY:=T1; TALLY:=TALLY+T2; TALLY:=TALLY+1; T1:=TALLY; - L: - DS:=LIT"]"; TALLY:=K; - T1(TALLY:=TALLY+63; T2:=TALLY; SI:=LOC T2; SI:=SI+7; - IF SC="0" THEN JUMP OUT TO SHORT); - T2(DS:=LIT" "); GO FINIS; - SHORT: - TALLY:=T1; TALLY:=TALLY+1; FORM:=TALLY; DS:=LIT" "; - FINIS: - DS:=RESET; DS:=5SET; - END; - IF R LSS 0 THEN R:=LINENUMBER(-R) ELSE R:=ABS(R); % -0 - CHRCOUNT:=FORM(LINEBUFF,R,MARGINSIZE)+1 - - END; -INTEGER PROCEDURE HEADER(ADDR1,ADDR2,BUF); VALUE ADDR1,ADDR2; - INTEGER ADDR1, ADDR2; ARRAY BUF[0]; - BEGIN - INTEGER STREAM PROCEDURE HEADRR(ADDR1,ADDR2,BUF); VALUE ADDR1, - ADDR2; - BEGIN - LOCAL C,T,TDI; - LOCAL QM,AR; - LABEL L,ENDSCAN,M,N; - DI:=LOC QM; DS:=2RESET; DS:=2SET; - DI:=LOC AR; DS:=RESET; DS:=5SET; - DI:=BUF; - SI:=ADDR1; - L: T:=SI; TDI:=DI 00287210 - DI:=LOC QM; IF SC=DC THEN GO TO ENDSCAN; - DI:=LOC AR; SI:=SI-1; IF SC=DC THEN GO TO ENDSCAN; - SI:=LOC T; DI:=LOC ADDR2; - IF 8SC=DC THEN COMMENT END OF SCAN; - GO TO ENDSCAN; - SI:=T; DI:=TDI; DS:=CHR; - GO TO L; - ENDSCAN: - SI:=TDI; - M: SI:=SI-1; - IF SC=" " THEN GO TO M; - SI:=SI+1; - ADDR2:=SI; - SI:=BUF; - N: T:=SI; DI:=LOC ADDR2; - SI:=LOC T; - IF 8SC NEQ DC THEN - BEGIN - TALLY:=TALLY+1; TDI:=TALLY; - SI:=LOC TDI; SI:=SI+7; - IF SC="0" THEN - BEGIN TALLY:=C; TALLY:=TALLY+1; C:=TALLY; - TALLY:=0; - END; - SI:=T; SI:=SI+1; GO TO N; - END; - HEADRR:=TALLY; SI:=LOC C; DI:=LOC HEADRR; SI:=SI+1; DS:=6 CHR; - END; - HEADER:=HEADRR(ADDR1,ADDR2,BUF); - END OF PHONY HEADER; -PROCEDURE STARTSCAN; - BEGIN - - - - LADDRESS:= - ADDRESS:=ABSOLUTEADDRESS; - BEGIN TERPRINT; - END; - READ(TWXIN[STOP],29,BUFFER[*]); - BUFFER[30]:=0&31[1:43:5]; - ITEMCOUNT:=0; - EOB:=0 - END; -PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,BL,S,N; INTEGER CC,BL, - S,N; ARRAY A[0]; - COMMENT: CC--SAME CODE AS IN FORMWD, LINE 253000 - BL--#BLANKS TO PUT IN FRONT OF IT - A--ARRAY WHERE THE STUFF TO PUT ON LINE IS STORED - S--#CHARACTERS TO SKIP AT START OF A - N--#CHARACTERS TO TAKE FROM A TO PUT ON OUTPUT LINE; - BEGIN INTEGER K; - INTEGER T; - IF CC GTR 1 AND CHRCOUNT GTR 0 THEN TERPRINT; - IF K:=LINESIZE LEQ 9 OR K GTR 72 THEN K:=72; - WHILE CHRCOUNT+N+BL GTR K DO - BEGIN - APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,T:=K-CHRCOUNT-BL); - CHRCOUNT:=K; TERPRINT; - S:=S+T; N:=N-T; - BL:=0; - END; - APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,N); - - CHRCOUNT:=CHRCOUNT+N+BL; - IF BOOLEAN(CC) THEN - IF CC=-1 THEN BEGIN LINETOG:=FALSE; - TERPRINT; LINETOG:=TRUE; - END ELSE TERPRINT; - END; -PROCEDURE NUMBERCON(R,A); VALUE R; REAL R; ARRAY A[0]; - BEGIN FORMAT F(F24.*), G(E24.*); - REAL S; DEFINE MAXIM = 10@9#; - - STREAM PROCEDURE ADJUST(A,B); - BEGIN LOCAL T,FRAC,MANT,T1,TSI,TDI; - DI:=LOC T; DI:=DI+1; T1:=DI; - SI:=B; DI:=A; DI:=DI+2; - 24(IF SC=" " THEN SI:=SI+1 ELSE - BEGIN TSI:=SI; SI:=LOC T; - IF SC="1" THEN; SI:=TSI; - IF TOGGLE THEN - IF SC NEQ "0" THEN 00342000 P24 - IF SC="@" THEN BEGIN - TSI:=SI; DI:=T1; DS:=LIT"1"; JUMP OUT; - END ELSE FRAC:=TALLY - ELSE TALLY := TALLY+0 - ELSE - IF SC="." THEN - BEGIN MANT:=TALLY; TDI:=DI; DI:=LOC T; DS:= - LIT"1"; TALLY:=0;DI:=TDI; - END; - TALLY:=TALLY+1; DS:=CHR - END); - SI:=LOC MANT; SI:=SI+7; IF SC="0" THEN MANT:=TALLY; - - TALLY:=MANT; SI:=LOC FRAC; SI:=SI+7; IF SC GTR "0" - THEN TALLY:=TALLY+1; TALLY:=TALLY+FRAC; MANT:=TALLY; - SI:=T1; IF SC="1" THEN BEGIN - DI:=A; DI:=DI+MANT; DI:=DI+2; - SI:=TSI; DS:=4CHR; - TALLY:=TALLY+4; MANT:=TALLY; END; - SI:=LOC MANT; SI:=SI+6; DI:=A; DS:=2CHR; - END; - IF S:=ABS(R) GEQ MAXIM OR S LEQ 10*(-DIGITS) AND S NEQ 0 THEN - WRITE(SCR[*],G,DIGITS,R) ELSE - WRITE(SCR[*],F,DIGITS,R); - ADJUST(A,SCR) - END; -PROCEDURE STOREPSR; - BEGIN INTEGER I; - DELETE1(WORKSPACE,0); + END OF NUMBER; +STREAM PROCEDURE APPENDTOBUFF(BUF,NBUF,NBLANK,A,SA,NA); + VALUE NBUF,NBLANK,SA,NA; + BEGIN LOCAL T; + LOCAL TSI,TDI; + SI:=LOC NBUF; DI:=LOC T; DI:=DI+1; DS:=7CHR; + DI:=BUF; T(2(DI:=DI+32)); DI:=DI+NBUF; + NBLANK(DS:=LIT" "); TDI:=DI; + SI:=LOC SA; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=A; T(2(SI:=SI+32)); SI:=SI+SA; + TSI:=SI; SI:=LOC NA; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=TSI; DI:=TDI; T(2(DS:=32CHR)); DS:=NA CHR + END; +PROCEDURE TERPRINT; + BEGIN LABEL BK; +STREAM PROCEDURE FINISHBUFF(BUF,N,TER);VALUE N,TER; + BEGIN LOCAL T; + SI:=LOC TER;SI:=SI+7;IF SC="1" THEN; + SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7 CHR; + DI:=BUF; T(2(DI:=DI+32));DI:=DI+N; + IF TOOGLE THEN DS:=2 LIT"{!"; %CARRIAGE RETURN/LINE FEED + DS:=RESET;DS:=5 SET; %END OF MESSAGE LEFT ARROW + END OF FINISHBUFF; + IF CHRCOUNT NEQ 0 THEN BEGIN + FINISHBUFF(OUTBUFF,CHRCOUNT,LINETOG); + CHRCOUNT:=0; + IF LINETOG THEN + WRITE(TWXOUT,9,OUTBUFF[*])[BK:BK] ELSE + WRITE(TWXOUT[STOP],9,OUTBUFF[*])[BK:BK]; + INITBUFF(OUTBUFF, 10); + END; + IF FALSE THEN +OK: IF CURRENTMODE=XEQMODE THEN BREAKFLAG:=TRUE; + END OF TERPRINT; +PROCEDURE FORMWD(CC,WD); VALUE CC,WD; REAL WD; INTEGER CC; + BEGIN + INTEGER I,K,L; + COMMENT CC=-1 STAY ON LINE, OUTPUT, DON"T GO TO NEXT LINE + COMMENT CC=0 STAY ON THIS LINE, MORE TO COME. + CC=1 STAY ON THIS LINE BUT TERMINATE PRINT. 00257000P22 + CC=2 SKIP TO NEXT LINE - MORE TO COME. + CC=3 SKIP TO NEXT LINE - TERMINATE PRINT.; + REAL STREAM PROCEDURE OCTAL(I); VALUE I; + BEGIN SI:=LOC I; DI:=LOC OCTAL; DS:=8OCT + END; + IF L:=LINESIZE LEQ 9 OR L GTR 72 THEN L:=72; K:=2; + IF CC GTR 1 AND CHRCOUNT GTR OTHEN TERPRINT; + IF CHRCOUNT+(I:=OCTAL(WD.[1:11])) GTR L THEN + + BEGIN APPENDTOBUFF(LINEBUFFER,CHRCOUNT, + 0,WD,2,K:=L-CHRCOUNT); + CHRCOUNT:=L; TERPRINT; + + I:=I-K; + + END; + APPENDTOBUFF(LINEBUFFER,CHRCOUNT,0,WD,K,I); + + CHRCOUNT:=CHRCOUNT+I; + IF BOOLEAN(CC) THEN + IF CC=-1 THEN BEGIN LINETOG:=FALSE; + TERPRINT; LINETOG:=TRUE + END ELSE TERPRINT; + END; +BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR); + ARRAY SPECS[0]; REAL HADDR; FORWARD; + + + +REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R; + COMMENT STARTS ON 8030000; + FORWARD; + +PROCEDURE INDENT(R); VALUE R; REAL R; + BEGIN + INTEGER STREAM PROCEDURE FORM(A,I,K);VALUE K,I; + BEGIN + LOCAL T1,T2; + LABEL SHORT,L,M,FINIS; + TALLY:=K; FORM:=TALLY; + SI:=LOC I; DI:=LOC T1; IF 8SC=DC THEN + BEGIN DI:=A; K(DS:=LIT" "); GO FINIS + END; + SI:=LOC I; DI:=A; TALLY:=3; DS:=LIT"["; + IF SC GTR "0" THEN IF SC LSS "0" THEN ; + 3(TALLY:=TALLY+1; IF TOGGLE THEN DS:=CHR ELSE + IF SC NEQ "0" THEN DS:=CHR ELSE + BEGIN TALLY:=TALLY+63; SI:=SI+1 + END ); + DS:=CHR; T1:=TALLY; TALLY:=4; SI:=SI+3; + 4(IF SC NEQ "0" THEN JUMP OUT TO M; + TALLY:=TALLY+63; SI:=SI-1); GO TO L; + M: + T2:=TALLY; SI:=LOC I; SI:=SI+4; DS:=LIT"."; DS:=T2 CHR; + TALLY:=T1; TALLY:=TALLY+T2; TALLY:=TALLY+1; T1:=TALLY; + L: + DS:=LIT"]"; TALLY:=K; + T1(TALLY:=TALLY+63; T2:=TALLY; SI:=LOC T2; SI:=SI+7; + IF SC="0" THEN JUMP OUT TO SHORT); + T2(DS:=LIT" "); GO FINIS; + SHORT: + TALLY:=T1; TALLY:=TALLY+1; FORM:=TALLY; DS:=LIT" "; + FINIS: + DS:=RESET; DS:=5SET; + END; + IF R LSS 0 THEN R:=LINENUMBER(-R) ELSE R:=ABS(R); % -0 + CHRCOUNT:=FORM(LINEBUFF,R,MARGINSIZE)+1 + + END; +INTEGER PROCEDURE HEADER(ADDR1,ADDR2,BUF); VALUE ADDR1,ADDR2; + INTEGER ADDR1, ADDR2; ARRAY BUF[0]; + BEGIN + INTEGER STREAM PROCEDURE HEADRR(ADDR1,ADDR2,BUF); VALUE ADDR1, + ADDR2; + BEGIN + LOCAL C,T,TDI; + LOCAL QM,AR; + LABEL L,ENDSCAN,M,N; + DI:=LOC QM; DS:=2RESET; DS:=2SET; + DI:=LOC AR; DS:=RESET; DS:=5SET; + DI:=BUF; + SI:=ADDR1; + L: T:=SI; TDI:=DI 00287210P23 + DI:=LOC QM; IF SC=DC THEN GO TO ENDSCAN; + DI:=LOC AR; SI:=SI-1; IF SC=DC THEN GO TO ENDSCAN; + SI:=LOC T; DI:=LOC ADDR2; + IF 8SC=DC THEN COMMENT END OF SCAN; + GO TO ENDSCAN; + SI:=T; DI:=TDI; DS:=CHR; + GO TO L; + ENDSCAN: + SI:=TDI; + M: SI:=SI-1; + IF SC=" " THEN GO TO M; + SI:=SI+1; + ADDR2:=SI; + SI:=BUF; + N: T:=SI; DI:=LOC ADDR2; + SI:=LOC T; + IF 8SC NEQ DC THEN + BEGIN + TALLY:=TALLY+1; TDI:=TALLY; + SI:=LOC TDI; SI:=SI+7; + IF SC="0" THEN + BEGIN TALLY:=C; TALLY:=TALLY+1; C:=TALLY; + TALLY:=0; + END; + SI:=T; SI:=SI+1; GO TO N; + END; + HEADRR:=TALLY; SI:=LOC C; DI:=LOC HEADRR; SI:=SI+1; DS:=6 CHR; + END; + HEADER:=HEADRR(ADDR1,ADDR2,BUF); + END OF PHONY HEADER; +PROCEDURE STARTSCAN; + BEGIN + + + + LADDRESS:= + ADDRESS:=ABSOLUTEADDRESS; + BEGIN TERPRINT; + END; + READ(TWXIN[STOP],29,BUFFER[*]); + BUFFER[30]:=0&31[1:43:5]; + ITEMCOUNT:=0; + EOB:=0 + END; +PROCEDURE FORMROW(CC,BL,A,S,N); VALUE CC,BL,S,N; INTEGER CC,BL, + S,N; ARRAY A[0]; + COMMENT: CC--SAME CODE AS IN FORMWD, LINE 253000 + BL--#BLANKS TO PUT IN FRONT OF IT + A--ARRAY WHERE THE STUFF TO PUT ON LINE IS STORED + S--#CHARACTERS TO SKIP AT START OF A + N--#CHARACTERS TO TAKE FROM A TO PUT ON OUTPUT LINE; + BEGIN INTEGER K; + INTEGER T; + IF CC GTR 1 AND CHRCOUNT GTR 0 THEN TERPRINT; + IF K:=LINESIZE LEQ 9 OR K GTR 72 THEN K:=72; + WHILE CHRCOUNT+N+BL GTR K DO + BEGIN + APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,T:=K-CHRCOUNT-BL); + CHRCOUNT:=K; TERPRINT; + S:=S+T; N:=N-T; + BL:=0; + END; + APPENDTOBUFFER(LINEBUFFER,CHRCOUNT,BL,A,S,N); + + CHRCOUNT:=CHRCOUNT+N+BL; + IF BOOLEAN(CC) THEN + IF CC=-1 THEN BEGIN LINETOG:=FALSE; + TERPRINT; LINETOG:=TRUE; + END ELSE TERPRINT; + END; +PROCEDURE NUMBERCON(R,A); VALUE R; REAL R; ARRAY A[0]; + BEGIN FORMAT F(F24.*), G(E24.*); + REAL S; DEFINE MAXIM = 10@9#; + + STREAM PROCEDURE ADJUST(A,B); + BEGIN LOCAL T,FRAC,MANT,T1,TSI,TDI; + DI:=LOC T; DI:=DI+1; T1:=DI; + SI:=B; DI:=A; DI:=DI+2; + 24(IF SC=" " THEN SI:=SI+1 ELSE + BEGIN TSI:=SI; SI:=LOC T; + IF SC="1" THEN; SI:=TSI; + IF TOGGLE THEN + IF SC NEQ "0" THEN 00342000P24 + IF SC="@" THEN BEGIN + TSI:=SI; DI:=T1; DS:=LIT"1"; JUMP OUT; + END ELSE FRAC:=TALLY + ELSE TALLY := TALLY+0 + ELSE + IF SC="." THEN + BEGIN MANT:=TALLY; TDI:=DI; DI:=LOC T; DS:= + LIT"1"; TALLY:=0;DI:=TDI; + END; + TALLY:=TALLY+1; DS:=CHR + END); + SI:=LOC MANT; SI:=SI+7; IF SC="0" THEN MANT:=TALLY; + + TALLY:=MANT; SI:=LOC FRAC; SI:=SI+7; IF SC GTR "0" + THEN TALLY:=TALLY+1; TALLY:=TALLY+FRAC; MANT:=TALLY; + SI:=T1; IF SC="1" THEN BEGIN + DI:=A; DI:=DI+MANT; DI:=DI+2; + SI:=TSI; DS:=4CHR; + TALLY:=TALLY+4; MANT:=TALLY; END; + SI:=LOC MANT; SI:=SI+6; DI:=A; DS:=2CHR; + END; + IF S:=ABS(R) GEQ MAXIM OR S LEQ 10*(-DIGITS) AND S NEQ 0 THEN + WRITE(SCR[*],G,DIGITS,R) ELSE + WRITE(SCR[*],F,DIGITS,R); + ADJUST(A,SCR) + END; +PROCEDURE STOREPSR; + BEGIN INTEGER I; + DELETE1(WORKSPACE,0); I:=STORESEQ(WORKSPACE,PSR,PSRSIZE|8); - COMMENT USED TO CALL WRAPUP; - END; -PROCEDURE RESCANLINE; - BEGIN ADDRESS:=ABSOLUTEADDRESS; EOB:=0; END; -PROCEDURE PROCESS(MODE);VALUE MODE; INTEGER MODE; FORWARD; -PROCEDURE MESSAGEHANDLER; FORWARD; -PROCEDURE FUNCTIONHANDLER; FORWARD; -PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R; - INTEGER N;REAL ADDR;FORWARD; COMMENT LINE 5000000; -STREAM PROCEDURE SETFIELD(A,S,L,R); VALUE S,L,R; - BEGIN DI:=A; DI:=DI+S; SI:=LOC R; SI:=SI+8; L(SI:=SI-1); - DS:=L CHR; - END; -COMMENT: VALUE OF GETFIELD IS L CHARACTERS, STARTING AT J-TH - CHARACTER OF A, RIGHT-ADJUSTED. L MUST BE LEQ 8 AND - J MUST BE LESS THAT 64; -REAL STREAM PROCEDURE GETFIELD(A,S,L); VALUE S,L; - BEGIN SI:=A; SI:=SI+S; DI:=LOC GETFIELD; DI:=DI+8; L(DI:=DI-1); - DS:=L CHR; - END; -REAL PROCEDURE TOPLINE(ORD); VALUE ORD; INTEGER ORD; - BEGIN - INTEGER STREAM PROCEDURE CON(A); VALUE A; - BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT END; - ARRAY A[0:1]; INTEGER I; - I:=CONTENTS(ORD,SIZE(ORD)-1,A); - TOPLINE:=CON(A[0])/10000 - END; -BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR); -ARRAY SPECS[0]; REAL HADDR; -BEGIN -LABEL A,B,C; -INTEGER P; + COMMENT USED TO CALL WRAPUP; + END; +PROCEDURE RESCANLINE; + BEGIN ADDRESS:=ABSOLUTEADDRESS; EOB:=0; END; +PROCEDURE PROCESS(MODE);VALUE MODE; INTEGER MODE; FORWARD; +PROCEDURE MESSAGEHANDLER; FORWARD; +PROCEDURE FUNCTIONHANDLER; FORWARD; +PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R; + INTEGER N;REAL ADDR;FORWARD; COMMENT LINE 5000000; +STREAM PROCEDURE SETFIELD(A,S,L,R); VALUE S,L,R; + BEGIN DI:=A; DI:=DI+S; SI:=LOC R; SI:=SI+8; L(SI:=SI-1); + DS:=L CHR; + END; +COMMENT: VALUE OF GETFIELD IS L CHARACTERS, STARTING AT J-TH + CHARACTER OF A, RIGHT-ADJUSTED. L MUST BE LEQ 8 AND + J MUST BE LESS THAT 64; +REAL STREAM PROCEDURE GETFIELD(A,S,L); VALUE S,L; + BEGIN SI:=A; SI:=SI+S; DI:=LOC GETFIELD; DI:=DI+8; L(DI:=DI-1); + DS:=L CHR; + END; +REAL PROCEDURE TOPLINE(ORD); VALUE ORD; INTEGER ORD; + BEGIN + INTEGER STREAM PROCEDURE CON(A); VALUE A; + BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT END; + ARRAY A[0:1]; INTEGER I; + I:=CONTENTS(ORD,SIZE(ORD)-1,A); + TOPLINE:=CON(A[0])/10000 + END; +BOOLEAN PROCEDURE FUNCTIONHEADER(SPECS,HADDR); +ARRAY SPECS[0]; REAL HADDR; +BEGIN +LABEL A,B,C; +INTEGER P; DEFINE NOTE=HADDR.[24:24]:=ADDRESS#,P8=8|P+1#; -ERR:=0; -SPECS[0]:=SPECS[1]:=SPECS[2]:=SPECS[3]:=0; -NOTE; HADDR.[1:23]:=GT1:=ADDRESS; -IF SCAN AND IDENT THEN - BEGIN - TRANSFER(ACCUM,2,SPECS,1,7); - NOTE; - IF SCAN THEN - IF LFTARROW THEN - BEGIN - SPECS[1]:=1; - SPECS[3]:=1; - TRANSFER(SPECS,1,SPECS,33,7); - GT2:=ADDRESS; - IF SCAN AND IDENT THEN - BEGIN - TRANSFER(ACCUM,2,SPECS,1,7); - NOTE; - IF SCAN THEN 00501600 - C: IF IDENT THEN - BEGIN - P:=(SPECS[3]:=SPECS[3]+1)+3; - TRANSFER(ACCUM,2,SPECS,P8,7); - SPECS[2]:=1; - NOTE; - IF SCAN THEN IF IDENT THEN - BEGIN SPECS[2]:=2; - P:=(SPECS[3]:=SPECS[3]+1)+2; - TRANSFER(SPECS,1,SPECS,P8+8,7); - TRANSFER(SPECS,P8,SPECS,1,7); - TRANSFER(ACCUM,2,SPECS,P8,7); - - B: NOTE; IF SCAN THEN - A: IF SEMICOLON THEN IF SCAN THEN - IF IDENT THEN - BEGIN - P:=(SPECS[3]:=SPECS[3]+1)+3; - TRANSFER(ACCUM,2,SPECS,P8,7); - GO TO B; - END ELSE GO TO A - ELSE ELSE ELSE - END ELSE GO TO A - ELSE END - ELSE GO TO A ELSE - END ELSE ERRORMESS(ERR:=1,GT2,0) - END ELSE GO TO C - ELSE - END ELSE ERRORMESS(ERR:=SYNTAXERROR,GT1,0); - FUNCTIONHEADER:=ERR=0; - ADDRESS:=HADDR.[24:24]; - END FUNCTIONHEADER; - - INTEGER PROCEDURE DAYTIME(B); ARRAY B[0]; FORWARD; - COMMENT ON LINE 8014000, ARRAY B MUST HAVE LENGTH - AT LEAST 3 WDS; - PROCEDURE EDITLINE; FORWARD; - INTEGER PROCEDURE LENGTH(A,M);VALUE M; BOOLEAN M; ARRAY A[0]; - FORWARD; COMMENT LINE 8007900; - BOOLEAN PROCEDURE LABELSCAN(L,K); VALUE K; INTEGER K; - ARRAY L[0]; FORWARD; COMMENT LINE 8013910; - - - PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; FORWARD; - COMMENT ON LINE 8040000; - PROCEDURE RELEASEARRAY(D);VALUE D; REAL D; - BEGIN COMMENT RELEASE PERMANENT STORAGE FOR THE ARRAY DESC D; - INTEGER K,J,PT; - ARRAY BLOCK[0:32]; %SEE MAXWORDSTORE, LINE 17260 - ARRAY TEMP[0:1]; - IF D.RF NEQ 0 THEN - BEGIN DELETE1(WS,D.DIMPTR); - K:=CONTENTS(WS,D.INPTR,BLOCK)-1; - DELETE1(WS,D,INPTR); - FOR J:=0 STEP 2 UNTIL K DO - BEGIN TRANSFER(BLOCK,J,TEMP,6,2); - PT:=TEMP[0]; DELETE1(WS,PT); END; - END; - END; - PROCEDURE TRANSFERSP(DIR,SP,L,B,M,N); VALUE DIR,N,M,L; - INTEGER DIR,N,M,L; - ARRAY SP[0,0],B[0]; - BEGIN COMMENT - DIR= INTO: TRANSFER N WORDS FROM B[L] INTO SP[M] - (ACTUALLY SP[*,M] SINCE ARRAY ROW IS USUALLY THE ARG) - DIR= OUTOF (OPPOSITE); - STREAM PROCEDURE MOVER(DIR,SP,M,B,L,N); VALUE DIR, - L,M,N; - BEGIN LOCAL T; - SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR; - SI:=SP; T(16(SI:=SI+32)); L(SI:=SI+8); L:=SI; - SI:=LOC M; DI:=LOC T; DI:=DI+1; DS:=7CHR; - SI:=B; T(16(SI:=SI+32)); M(SI:=SI+8); M:=SI; - SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7CHR; - SI:=LOC DIR; SI:=SI+7; - IF SC="0" THEN - BEGIN SI:=M; DI:=L - END ELSE - BEGIN SI:=L ; DI:=M - END; - T(2(DS:=32WDS)); DS:=N WDS; - END; - INTEGER K; 03002210 - WHILE N:=N-K GTR 0 DO - MOVER(DIR,SP[(L:=L+K)DIV SPRSIZE,*], - M:=M+K,B,K:=L MOD SPRSIZE, - K:=MIN(SPRSIZE-K,N)) - END; - - PROCEDURE DUMPOLISH(SP,PD); VALUE PD; REAL PD; ARRAY SP[0,0]; - BEGIN INTEGER L; - LABEL SKIPREST; - INTEGER I,N,M,U; REAL T; - L:=PD.SPF; - I:=SP[LOC]+L; - FOR L:=L+2 STEP 1 UNTIL I DO - IF (T:=SP[LOC]).TYPEFIELD=FUNCTION THEN - BEGIN % OUTPUT MESSAGE AND NAME - FORMWD(2,"5FUNC: "); - N:=T.LOCFIELD; % N HAS LOCATION OF DESCRIPTOR - N:=N-1; % BACK UP ONE TO GET NAME - GTA[0]:=SP[NOC]; - FORMROW(1,1,GTA,1,7); - END - ELSE % MIGHT BE AN OPERATOR - IF T.TYPEFIELD=OPERATOR THEN - BEGIN COMMENT OUTPUT MESSAGE AND OP CODE; - FORMWD(2,"5ATOR: "); - NUMBERCON(T.OPTYPE,ACCUM); - FORMROW(0,1,ACCUM,2,ACOUNT); - NUMBERCON(T.LOCFIELD,ACCUM); - FORMROW(1,1,ACCUM,2,ACOUNT); - END ELSE %MAY BE A CONSTANT - IF T.TYPEFIELD=CONSTANT THEN - BEGIN COMMENT GET DATA DESCRIPTOR; - N:=T.LOCFIELD; - FORMWD(2,"5CONS: "); - T:=SP[NOC]; %T HAS THE DATA DESCRIPTOR - IF T.SPF=0 THEN BEGIN % A NULL VECTOR - FORMWD(1,"4NULL "); - GO TO SKIPREST; END; - N:=T.SPF; %N HAS THE SCALAR OR TOP OF VECTOR LOC. - IF BOOLEAN(T.SCALAR) THEN M:=U:=N ELSE - BEGIN U:=SP[NOC]+N; M:=N+1; %UPPER AND LOWER BOUNDS - END; - IF BOOLEAN(T.CHRMODE) THEN %CHARACTER FORMAT - BEGIN COMMENT SP[NOC] IS NUMBER OF CHRS; - TRANSFERSP(OUTOF,SP,M,BUFFER,0,ENTIER(((T:= - SP[NOC])-1)DIV 8+1)); - FORMROW(1,1,BUFFER,0,T); - END ELSE % SHOULD TEST FOR NULL...DO IT LATER. - FOR N:=M STEP 1 UNTIL U DO - BEGIN NUMBERCON(SP[NOC],ACCUM); - FORMROW(0,1,ACCUM,2,ACOUNT); - END; - TERPRINT; - SKIPREST: - END ELSE COMMENT MUST BE AN OPERAND; - IF T.TYPEFIELD=LOCALVAR THEN - BEGIN FORMWD(2,"5LOCL: "); - N:=T.SPF; % N HAS LOCATION OF NAME; - GTA[0]:=SP[NOC]; % PUT NAME IN GTA - FORMROW(1,1,GTA,1,7); - END ELSE - BEGIN COMMENT TREAT IT AS VARIABLE; - N:=T.LOCFIELD; COMMENT N HAS LOC OF DESCRIPTOR; - N:=N-1; COMMENT BACKUP OVER THE DESCRIPTOR; - GTA[0]:=SP[NOC]; - FORMWD(2,"5AND : "); - FORMROW(1,1,GTA,1,7); - END; - END; - - PROCEDURE PROCESS(MODE); VALUE MODE; INTEGER MODE; - BEGIN - OWN INTEGER J; - OWN REAL RESULTD; - LABEL EXPOVRL,INTOVRL,INDEXL,FLAGL,ZEROL; - MONITOR EXPOVR,INTOVR,INDEX,FLAG,ZERO; - LABEL DEBUGSP; %DEBUGGING PURPOSES ONLY. - INTEGER PROCEDURE BUILDCONSTANT(LASTCONSTANT); - INTEGER LASTCONSTANT; FORWARD; - INTEGER PROCEDURE GETSPACE(LENGTH); VALUE LENGTH; - INTEGER LENGTH; FORWARD; - PROCEDURE OPERANDTOSYMTAB(L);VALUE L;INTEGER L;FORWARD; - REAL PROCEDURE BUILDALPHA(LASTCONSTANT); 03100440 - INTEGER LASTCONSTANT; FORWARD; - INTEGER PROCEDURE BUILDNULL(LASTCONSTANT); - INTEGER LASTCONSTANT; FORWARD; - PROCEDURE SCRATCHDATA(D);VALUE D;REAL D; FORWARD; - COMMENT LINE 3121400; - PROCEDURE FORGETPROGRAM(U);VALUE U;REAL U; FORWARD; - COMMENT ANALYZE IS IN PROCESS BECAUSE OWN ARRAY SP - IS ADDRESSED INCORRECTLY OTHERWISE; - REAL PROCEDURE ANALYZE(DISPLAYOP); VALUE DISPLAYOP;BOOLEAN DISPLAYOP; - BEGIN COMMENT - BC= BUILDCONSTANT, - GS= GET SPACE PROCEDURE ; - ARRAY INFIX[0:MAXPOLISH]; - - INTEGER LASTCONSTANT; - DEFINE GS=GETSPACE#; - BOOLEAN STREAM PROCEDURE EQUAL(A,B); - BEGIN SI:=A; SI:=SI+1; DI:=B; DI:=DI+2; - IF 7SC=DC THEN TALLY:=1; - EQUAL:=TALLY; - END; - PROCEDURE UNSTACK(DEST,L,ORIG,OTOP,N,CHR1,CHR2); - VALUE N,CHR1,CHR2; - INTEGER N,CHR1,CHR2,L,OTOP; - ARRAY DEST[0,0],ORIG[0]; - BEGIN - REAL T,U; - WHILE OTOP GTR 0 AND N GTR 0 AND ERR=0 DO - IF(IF (T:=ORIG[OTOP]).TYPEFIELD=FUNCTION THEN FALSE ELSE - U:=T.LOCFIELD=CHR1 OR U=CHR2) THEN %UNSTACK - BEGIN - IF N GTR 1 THEN - IF U=CHR2 THEN ERR:=SYNTAXERROR ELSE - OTOP:=OTOP-1; - N:=N-1; - END ELSE - COMMENT WE ARE LOOKING AT AN OPERATOR OR A FUNCTION; - - - BEGIN - IF J NEQ 0 THEN - BEGIN L:=L+1; - DEST[LOC]:=ORIG[OTOP] - END; - OTOP:OTOP-1 - END; - IF N GTR 1 THEN ERR:=SYNTAXERROR; - END; - INTEGER ITOP,K,L,I; - INTEGER M,N,FLOC; REAL T; - LABEL SKIPSCAN,FILLER; - LABEL SPFULLAB; - - - PROCEDURE FORGETSPACE(L,LENGTH,SP); VALUE L,LENGTH; - INTEGER L,LENGTH; ARRAY SP[0,0]; - BEGIN IF LENGTH GTR 0 THEN - BEGIN SP[LOC]:=SP[0,0]; - SP[LOC].LEN:=LENGTH; SP[0,0]:=L - END; - END; - - IF CURRENTMODE=FUNCMODE OR STACKBASE=0 THEN FLOC:=0 ELSE - - BEGIN L:=STACKBASE+1;L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L; - FLOC:= IF M=L OR BOOLEAN(T:=SP[MOC]).SUSPENDED THEN 0 ELSE T.SPF - - END; - - T:=ADDRESS; - ITOP:=0; - DO - SKIPSCAN: - IF ITOP LSS MAXPOLISH THEN - BEGIN - INFIX[ITOP:=ITOP+1].ADDRFIELD:=T; - IF SPECIAL THEN - IF QUOTEV THEN % CONSTANT VECTOR - BEGIN INFIX[ITOP].TYPEFIELD:=CONSTANT; - IF T:=BUILDALPHA(LASTCONSTANT) NEQ 0 THEN - INFIX[ITOP].LOCFIELD:=T ELSE ERR:=SYNTAXERROR - END ELSE % ORDINARY OPERATOR - BEGIN INFIX[ITOP].TYPEFIELD:=OPERATOR; 03101550 -... - UNTIL NOT(SCAN AND ERR=0); %DROP THRU WHEN INPUT FIN OR ERR 03104040 P29 -... - IF INFIX[I].OPTPE NEQ DYADIC THEN SINFIX[I].OPTYPE:=MONADIC; 03104840 P30 -... - IF OTOP LSS ITOP DIV 2 THEN ELSE ERR:=SYNTAXERROR; 03105087 P31 -... - BEGIN 03105383 P32 -... - T.OPTYPE:=MONADIC; 03106260 P33 -... - GTR MAXPROGS THEN %OFF THE END OF SP 03110920 P34 -... - BUILDCONSTANT:=L:=GS(1); %VECTOR DESCRIPTOR 03114800 P35 -... - BEGIN 03121255 P36 -... - SETFIELD(NEWDESC,7,1, IF BIOOLEAN(T.SCALAR) 03124650 P37 -... - END; 03140080 P38 - INTEGER C; -... - T:=SP[NOC]; SP[NOC.NAMED:=1; N:=T; 03140600 P39 -... - BEGIN SI:=A;SI:=SI+B;DI:=C;DI:=DI+D;DS:=CHR;END; 03150085 P40 -... - L:=GETSPACE(N:=(NUMELEMENTS(D)+D,RF)); 03150650 P41 -... - WHILE TRUE DO % RECURSIVE EVALUATION LOOP 03151310 P42 -... - M := M + NJ; CC := 2; END; 03152646 P43 -... - AND N.QUADIN=4) THEN POPPROGRAM:=TRUE; 03155000 P44 -... - %ESE WE HAVE AN ERROR (MISSING " ETC) 03210520 P45 -... - OUTER:=(START:=L+RANK+J|MAT) + COL - 1; 03221020 P46 -... - OP APL OPERATOR OP APL OPERATOR 03230015 P47 -... - ANS := IF RIGHT | LEFT = 1 THEN 0 ELSE 1; %NAND 03233400 P48 -... - DESC.SPF:=I; DESC.DID:=DDPUVW; SPCOPY(L,I,RANK1); 03235100 P49 -... - IF I = 0 OR PICK LSS SP[MOC] THEN N:=TEMP 03239380 P50 -... - LABEL QUIT, DONE; 03240800 P51 -... - GO TO QUIT END 03243705 P52 -... - OR LDESC.ARRAYTYPE=1 THEN GO TO DOMAIN; 03254510 P53 -... - THEN GO TO DOMAIN; 03268280 P54 -... - BEGIN 03269860 P55 -... - 03271000 P56 -... - MM := M + RRANK - 1; 03272500 P57 -... - LABEL QUIT, FORGET, RANKERR; 03273620 P58 -... - HOP := (DIM-1) | JUMP; 03274600 P59 -... - SUB[I]:=TEMP-1; I:=I+1 END; 03277000 P60 -... - FORMROW(0,2,ACCUM,2,ACOUNT); FOLD:=ACOUNT+2; END ELSE 03500140 P61 -... - FOR N:=N+4 STEP 2 UNTIL T DO %ONCE FOR EACH LOCAL 03507100 P62 -... -%------------------ CASE 2.....MODE=ALLOC------------------------ 03702300 P63 -... - CASE T.TYPEFIELD OF 03752700 P64 - BEGIN %-------TF=0 (REPLACEMENT)-------------- - BEGIN %MAY BE A LOCAL OR A GLOBAL VARIABLE - DEFINE STARTSEGMENT=#; %///////////////////// - PUSH; IF ERR NEQ 0 THEN GO TO SKIPPOP; - N:=T.LOCFIELD; - IF BOOLEAN(T.OPTYPE) THEN %A LOCAL VARIABLE - BEGIN M:=FUNCLOC;%FIND LAST MKS - M:=SP[MOC].SPF+M; - N:=SP[MOC].LOCFIELD+N; END; - U:=SP[NOC]; U.LOCFIELD:=N; AREG:=U; - IF U.DATADES=0 THEN ERR:=NONCEERROR; - COMMENT PROBABLY MIXUP WITH FUNCTION NAMES - AND NAMES OF LOCAL SUSPENDED VARIABLES; - END; - %-------------FUNCTION CALL----------------- -%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& -BEGIN COMMENT SET UP STACK FOR A FUNCTION CALLL; -EAL U,V,NARGS,D; -INTEGER I,FLOC; -LABEL TERMINATE; -COMMENT - MONITOR PRINT(D,L,M,N,FLOC,SP,LASTMKS);%:::::::::::::::::::: - FLOC:=N:=T.LOCFIELD; - IF BOOLEAN(SP[NOC].DATADESC) THEN BEGIN ERR:=NONCEERROR; - FO TO TERMINATE;END;%SUSPENDED VAR CONFUSED WITH FUNCTION - IF NOT BOOLEAN(SP[NOC].PRESENCE) THEN MAKEFUNCTIONPRESENT(N); - D:=SP[NOC]; L:=LASTMKS; %D IS TEH DESC, L IS THE PROG MKS - SP[LUOC].CIF:=CINDEX; %SAVE CURRENT POLISH LOCATION - L:=STACKBASE+1; L:=SP[LOC].SPF+1; - M:=SP[LOC].SPF; - IF N:=M+L NEQ L THEN %THERE IS A NESTED CALL - IF NOT BOOLEAN(SP[NOC].SUSPENDED) THEN - BEGIN N:=SP[NOC].LOCFIELD;SP[NOC].CIF:=CURLINE;END; - - - SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); %INITIALIZE GTA - NARGS:=D.NUMBERARGS; - FOR I:=1 STEP 1 UNTIL NARGS DO - IF BOOLEAN((T:=AREG).DATADESC) THEN - BEGIN - IF BOOLEAN(T.NAMED) THEN %MAKE A COPY - COMMENT YOU COULD MAKE A CALL BY NAME HERE; - BEGIN U:=GETSPACE(V:=(NUMELEMENTS(T)+1,RF)); - SPCOPY(T,SPF,U,V); T.NAMED:=0; T.SPF:=U; - T.BACKP:=0; - END ELSE %NO NEED TO MAKE A COPY - AREG.PRESENCE:=0; - POP; GTA[I-1]:=T; %SAVE THE DESCRIPTOR FOR LATER USE - END ELSE ERR:=SYSTEMERROR; - IF (N:=M+1) GEQ STATEVECTORSIZE THEN ERR:=DEPTHERROR; - IF ERR NEQ 0 THEN GO TO TERMINATE; - SP[LOC].SPF:=N; - PUSH;AREG:=OLDDATA&(LASTMKS-STACKBASE)[BACKPT]&IMKS[CDID]; - OLDDATA:=0; %REINITIALIZE OLDDATA CHAIN FOR THIS FUNCTION - %NOW SET UP THE FUNCTION MARK STACK. - - M:=N+L;PUSH;SP[MOC]:=D.SPF&ST[CLOCF]; - M:=D.SPF; M:=M+2; % M IS LOC OF LOC OF FIRST LINE - AREG:=0&FLOC[CSPF]&((LASTMKS:=ST)-STACKBASE-1)[BACKPT]& - (U:=SP[MOC]-D.SPF)[CCIF]&FMKS[CDID]; % FUNCTION MKS - CURLINE:=U; - - U:=(U-6)/2; % U IS THE NUMBER OF LOCALS, LABELS, AND ARGS - M:=M+5; % M IS ON TEH FIRST DESC IOF THE FIRST LAB, LOC,... - FOR I:=1 STEP 1 UNTIL U DO % GET DESCRIPTORS INTO THE STACK - BEGIN IF SP[MOC] NNEQ 0 THEN %MAKE UP THE DESC - BEGIN L:=GETSPACE(1); SP[LOC]:=SP[MOC]; - T:=L&DDPUSW[CDID]&0[CCIF] - END ELSE - T:=NULLV; - PUSH; M:=M+2; - AREG:=T; %A SINGLE LOCAL - END; - %COPY OVER THE ARGUMENTS - FOR I:=1 STEP 1 UNTIL NARGS DO %COPY OVER - BEGIN M:=D.SPF; %M IS THE LOACTION OF THE LABEL TABLE. - M:=M+2+I; %M IS LOCATION OF REL LOCATION OF VARIABLE - M:=SP[MOC]; - N:=LASTMKS+MM; - SP[NOC]:=GTA[I-1]; - END; - %PUT IN A PHONEY PROG DESC TO START THINGS OFF - PUSH; IF ERR NEQ 0 THEN GO TO TERMINATE; 03753400 P65 - ARFG:=0&4094[CCIF]&(LASKMKS-STACKBASE)[BACKU[]; - LASTMKS:=ST; POLTOP:=POLLOC:=0; - TERMINATE: - END; -%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& - %-------END OF LOAD FUNCTION FOR CALL----- - %-------------TF=2 (CONSTANT)--------------------- - BEGIN PUSH; IF ERR=0 THEN BEGIN - N:=POLWORD.LOCFIELD;AREG:=SP[NOC];END; - END; - %-------------TF=3 (OPERATOR)----------------- - COMMENT SEQUENCE NUMBERS CORRESPOND TO OPERATOR - ASSIGNMENT NUMBER; - BEGIN IF T.OPTYPE=MONADIC THEN - BEGIN PUSH;IF ERR=0 THEN AREG:=0; END; - CASE T.LOCFIELD OF -BEGIN %--------------- OPERATE ON STACK --------------------- - COMMENT EACH EXECUTION PROCEDURE SETS RESULT TO THE - DESCRIPTOR OF THE RESULT OF THE OPERATION. - AREG AND BREG ARE THE LEFT AND RIGHT-HAND OPERANDS AND - ARE ACTUALLY THE TOP TWO DESCRIPTORS ON THE STACK. - IF AREG IS ZERO, THE OPERATOR IS TAKEN TO BE MONADIC.; -; -; -; -; - %---------------------REPLACEMENT OPERATOR--------------- - BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// - IF NOT BOOLEAN(L:=AREG.NAMED) THEN % SHOULD BE LOCAL VARIABLE - AREG.NAMED:=1; % DONT LET IT BE FORGOTTEN. - - IF BOOLAN(T:=AREG).PRESENCE) AND T.SPF NEQ 0 THEN - OLDDATA:=CHAIN(T,OLDATA); - M:=T.LOCFIELD; - - IF(RESUT:=BREG).SPF = 0 THEN U:=T:=0 ELSE - U:=GETSPACE(T:=NUMELEMENTS(RESULT)+RESULT.RF); - SPCOPY(RESULT,SPF,U,T); - RESULT.SPF:=U; RESULT.NAMED:=L; %L IS 0 FOR LOCJLS - GT1:=IF BOOLEAN(U:=SP[MOC]).PRESENCE) THEN U.BACKP ELSE 0; - SP[MOC]:=RESULT>1[CLOCF]; - IF BOOLEAN(L) AND GT1=0 THEN %CHECK FOR GLOBAL - BEGIN M:=M-1;IFSP[MOC].SUSPENDVAR=0)THEN SP[MOC].CHANGE:=1; - - END; - RESULT.NAMED:=1; %KEEP "PUSH" FROM TOSSING THE DATA - END - %-------TRANSFER OPERATOR--------------------------------- - BEGIN DEFINE STARTSEGMENT=#; %//////////////////////////////// - SCRATCHAIN(OLDDATA);ODDATA:=0; - IF BOOLEAN(D.DPTYPE) THEN ST:=ST-1; %GET RID OF PH7ONEY TOP - L:=FUNCLOC; - IF SP[LOC] NEQ 0 THEN STEPLINE(TRUE) ELSE - ERR:=SYNTAXERROR; - GO TO SKIPPOP; - END; +ERR:=0; +SPECS[0]:=SPECS[1]:=SPECS[2]:=SPECS[3]:=0; +NOTE; HADDR.[1:23]:=GT1:=ADDRESS; +IF SCAN AND IDENT THEN + BEGIN + TRANSFER(ACCUM,2,SPECS,1,7); + NOTE; + IF SCAN THEN + IF LFTARROW THEN + BEGIN + SPECS[1]:=1; + SPECS[3]:=1; + TRANSFER(SPECS,1,SPECS,33,7); + GT2:=ADDRESS; + IF SCAN AND IDENT THEN + BEGIN + TRANSFER(ACCUM,2,SPECS,1,7); + NOTE; + IF SCAN THEN 00501600P25 + C: IF IDENT THEN + BEGIN + P:=(SPECS[3]:=SPECS[3]+1)+3; + TRANSFER(ACCUM,2,SPECS,P8,7); + SPECS[2]:=1; + NOTE; + IF SCAN THEN IF IDENT THEN + BEGIN SPECS[2]:=2; + P:=(SPECS[3]:=SPECS[3]+1)+2; + TRANSFER(SPECS,1,SPECS,P8+8,7); + TRANSFER(SPECS,P8,SPECS,1,7); + TRANSFER(ACCUM,2,SPECS,P8,7); + + B: NOTE; IF SCAN THEN + A: IF SEMICOLON THEN IF SCAN THEN + IF IDENT THEN + BEGIN + P:=(SPECS[3]:=SPECS[3]+1)+3; + TRANSFER(ACCUM,2,SPECS,P8,7); + GO TO B; + END ELSE GO TO A + ELSE ELSE ELSE + END ELSE GO TO A + ELSE END + ELSE GO TO A ELSE + END ELSE ERRORMESS(ERR:=1,GT2,0) + END ELSE GO TO C + ELSE + END ELSE ERRORMESS(ERR:=SYNTAXERROR,GT1,0); +FUNCTIONHEADER:=ERR=0; +ADDRESS:=HADDR.[24:24]; +END FUNCTIONHEADER; + +INTEGER PROCEDURE DAYTIME(B); ARRAY B[0]; FORWARD; + COMMENT ON LINE 8014000, ARRAY B MUST HAVE LENGTH + AT LEAST 3 WDS; +PROCEDURE EDITLINE; FORWARD; +INTEGER PROCEDURE LENGTH(A,M);VALUE M; BOOLEAN M; ARRAY A[0]; + FORWARD; COMMENT LINE 8007900; +BOOLEAN PROCEDURE LABELSCAN(L,K); VALUE K; INTEGER K; + ARRAY L[0]; FORWARD; COMMENT LINE 8013910; + + +PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; FORWARD; + COMMENT ON LINE 8040000; +PROCEDURE RELEASEARRAY(D);VALUE D; REAL D; + BEGIN COMMENT RELEASE PERMANENT STORAGE FOR THE ARRAY DESC D; + INTEGER K,J,PT; + ARRAY BLOCK[0:32]; %SEE MAXWORDSTORE, LINE 17260 + ARRAY TEMP[0:1]; + IF D.RF NEQ 0 THEN + BEGIN DELETE1(WS,D.DIMPTR); + K:=CONTENTS(WS,D.INPTR,BLOCK)-1; + DELETE1(WS,D,INPTR); + FOR J:=0 STEP 2 UNTIL K DO + BEGIN TRANSFER(BLOCK,J,TEMP,6,2); + PT:=TEMP[0]; DELETE1(WS,PT); END; + END; + END; +PROCEDURE TRANSFERSP(DIR,SP,L,B,M,N); VALUE DIR,N,M,L; + INTEGER DIR,N,M,L; + ARRAY SP[0,0],B[0]; + BEGIN COMMENT + DIR= INTO: TRANSFER N WORDS FROM B[L] INTO SP[M] + (ACTUALLY SP[*,M] SINCE ARRAY ROW IS USUALLY THE ARG) + DIR= OUTOF (OPPOSITE); + STREAM PROCEDURE MOVER(DIR,SP,M,B,L,N); VALUE DIR, + L,M,N; + BEGIN LOCAL T; + SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=SP; T(16(SI:=SI+32)); L(SI:=SI+8); L:=SI; + SI:=LOC M; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=B; T(16(SI:=SI+32)); M(SI:=SI+8); M:=SI; + SI:=LOC N; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=LOC DIR; SI:=SI+7; + IF SC="0" THEN + BEGIN SI:=M; DI:=L + END ELSE + BEGIN SI:=L ; DI:=M + END; + T(2(DS:=32WDS)); DS:=N WDS; + END; + INTEGER K; 03002210P26 + WHILE N:=N-K GTR 0 DO + MOVER(DIR,SP[(L:=L+K)DIV SPRSIZE,*], + M:=M+K,B,K:=L MOD SPRSIZE, + K:=MIN(SPRSIZE-K,N)) + END; + +PROCEDURE DUMPOLISH(SP,PD); VALUE PD; REAL PD; ARRAY SP[0,0]; + BEGIN INTEGER L; + LABEL SKIPREST; + INTEGER I,N,M,U; REAL T; + L:=PD.SPF; + I:=SP[LOC]+L; + FOR L:=L+2 STEP 1 UNTIL I DO +IF (T:=SP[LOC]).TYPEFIELD=FUNCTION THEN + BEGIN % OUTPUT MESSAGE AND NAME + FORMWD(2,"5FUNC: "); + N:=T.LOCFIELD; % N HAS LOCATION OF DESCRIPTOR + N:=N-1; % BACK UP ONE TO GET NAME + GTA[0]:=SP[NOC]; + FORMROW(1,1,GTA,1,7); + END +ELSE % MIGHT BE AN OPERATOR +IF T.TYPEFIELD=OPERATOR THEN + BEGIN COMMENT OUTPUT MESSAGE AND OP CODE; + FORMWD(2,"5ATOR: "); + NUMBERCON(T.OPTYPE,ACCUM); + FORMROW(0,1,ACCUM,2,ACOUNT); + NUMBERCON(T.LOCFIELD,ACCUM); + FORMROW(1,1,ACCUM,2,ACOUNT); + END ELSE %MAY BE A CONSTANT + IF T.TYPEFIELD=CONSTANT THEN + BEGIN COMMENT GET DATA DESCRIPTOR; + N:=T.LOCFIELD; + FORMWD(2,"5CONS: "); + T:=SP[NOC]; %T HAS THE DATA DESCRIPTOR + IF T.SPF=0 THEN BEGIN % A NULL VECTOR + FORMWD(1,"4NULL "); + GO TO SKIPREST; END; + N:=T.SPF; %N HAS THE SCALAR OR TOP OF VECTOR LOC. + IF BOOLEAN(T.SCALAR) THEN M:=U:=N ELSE + BEGIN U:=SP[NOC]+N; M:=N+1; %UPPER AND LOWER BOUNDS + END; +IF BOOLEAN(T.CHRMODE) THEN %CHARACTER FORMAT + BEGIN COMMENT SP[NOC] IS NUMBER OF CHRS; + TRANSFERSP(OUTOF,SP,M,BUFFER,0,ENTIER(((T:= + SP[NOC])-1)DIV 8+1)); + FORMROW(1,1,BUFFER,0,T); + END ELSE % SHOULD TEST FOR NULL...DO IT LATER. + FOR N:=M STEP 1 UNTIL U DO + BEGIN NUMBERCON(SP[NOC],ACCUM); + FORMROW(0,1,ACCUM,2,ACOUNT); + END; + TERPRINT; + SKIPREST: + END ELSE COMMENT MUST BE AN OPERAND; + IF T.TYPEFIELD=LOCALVAR THEN + BEGIN FORMWD(2,"5LOCL: "); + N:=T.SPF; % N HAS LOCATION OF NAME; + GTA[0]:=SP[NOC]; % PUT NAME IN GTA + FORMROW(1,1,GTA,1,7); + END ELSE + BEGIN COMMENT TREAT IT AS VARIABLE; + N:=T.LOCFIELD; COMMENT N HAS LOC OF DESCRIPTOR; + N:=N-1; COMMENT BACKUP OVER THE DESCRIPTOR; + GTA[0]:=SP[NOC]; + FORMWD(2,"5AND : "); + FORMROW(1,1,GTA,1,7); + END; + END; + +PROCEDURE PROCESS(MODE); VALUE MODE; INTEGER MODE; + BEGIN + OWN INTEGER J; + OWN REAL RESULTD; + LABEL EXPOVRL,INTOVRL,INDEXL,FLAGL,ZEROL; + MONITOR EXPOVR,INTOVR,INDEX,FLAG,ZERO; + LABEL DEBUGSP; %DEBUGGING PURPOSES ONLY. + INTEGER PROCEDURE BUILDCONSTANT(LASTCONSTANT); + INTEGER LASTCONSTANT; FORWARD; + INTEGER PROCEDURE GETSPACE(LENGTH); VALUE LENGTH; + INTEGER LENGTH; FORWARD; + PROCEDURE OPERANDTOSYMTAB(L);VALUE L;INTEGER L;FORWARD; + REAL PROCEDURE BUILDALPHA(LASTCONSTANT); 03100440P27 + INTEGER LASTCONSTANT; FORWARD; +INTEGER PROCEDURE BUILDNULL(LASTCONSTANT); + INTEGER LASTCONSTANT; FORWARD; + PROCEDURE SCRATCHDATA(D);VALUE D;REAL D; FORWARD; + COMMENT LINE 3121400; +PROCEDURE FORGETPROGRAM(U);VALUE U;REAL U; FORWARD; + COMMENT ANALYZE IS IN PROCESS BECAUSE OWN ARRAY SP + IS ADDRESSED INCORRECTLY OTHERWISE; +REAL PROCEDURE ANALYZE(DISPLAYOP); VALUE DISPLAYOP;BOOLEAN DISPLAYOP; + BEGIN COMMENT + BC= BUILDCONSTANT, + GS= GET SPACE PROCEDURE ; + ARRAY INFIX[0:MAXPOLISH]; + + INTEGER LASTCONSTANT; + DEFINE GS=GETSPACE#; + BOOLEAN STREAM PROCEDURE EQUAL(A,B); + BEGIN SI:=A; SI:=SI+1; DI:=B; DI:=DI+2; + IF 7SC=DC THEN TALLY:=1; + EQUAL:=TALLY; + END; +PROCEDURE UNSTACK(DEST,L,ORIG,OTOP,N,CHR1,CHR2); + VALUE N,CHR1,CHR2; + INTEGER N,CHR1,CHR2,L,OTOP; + ARRAY DEST[0,0],ORIG[0]; + BEGIN + REAL T,U; + WHILE OTOP GTR 0 AND N GTR 0 AND ERR=0 DO + IF(IF (T:=ORIG[OTOP]).TYPEFIELD=FUNCTION THEN FALSE ELSE + U:=T.LOCFIELD=CHR1 OR U=CHR2) THEN %UNSTACK + BEGIN + IF N GTR 1 THEN + IF U=CHR2 THEN ERR:=SYNTAXERROR ELSE + OTOP:=OTOP-1; + N:=N-1; + END ELSE + COMMENT WE ARE LOOKING AT AN OPERATOR OR A FUNCTION; + + + BEGIN + IF J NEQ 0 THEN + BEGIN L:=L+1; + DEST[LOC]:=ORIG[OTOP] + END; + OTOP:OTOP-1 + END; + IF N GTR 1 THEN ERR:=SYNTAXERROR; + END; + INTEGER ITOP,K,L,I; + INTEGER M,N,FLOC; REAL T; + LABEL SKIPSCAN,FILLER; + LABEL SPFULLAB; + + PROCEDURE FORGETSPACE(L,LENGTH,SP); VALUE L,LENGTH; + INTEGER L,LENGTH; ARRAY SP[0,0]; + BEGIN IF LENGTH GTR 0 THEN + BEGIN SP[LOC]:=SP[0,0]; + SP[LOC].LEN:=LENGTH; SP[0,0]:=L + END; + END; + + IF CURRENTMODE=FUNCMODE OR STACKBASE=0 THEN FLOC:=0 ELSE + + BEGIN L:=STACKBASE+1;L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L; + FLOC:= IF M=L OR BOOLEAN(T:=SP[MOC]).SUSPENDED THEN 0 ELSE T.SPF + + END; + + T:=ADDRESS; + ITOP:=0; + DO + SKIPSCAN: + IF ITOP LSS MAXPOLISH THEN + BEGIN + INFIX[ITOP:=ITOP+1].ADDRFIELD:=T; + IF SPECIAL THEN + IF QUOTEV THEN % CONSTANT VECTOR + BEGIN INFIX[ITOP].TYPEFIELD:=CONSTANT; + IF T:=BUILDALPHA(LASTCONSTANT) NEQ 0 THEN + INFIX[ITOP].LOCFIELD:=T ELSE ERR:=SYNTAXERROR + END ELSE % ORDINARY OPERATOR + BEGIN INFIX[ITOP].TYPEFIELD:=OPERATOR; 03101550P28 +... + UNTIL NOT(SCAN AND ERR=0); %DROP THRU WHEN INPUT FIN OR ERR 03104040P29 +... + IF INFIX[I].OPTPE NEQ DYADIC THEN SINFIX[I].OPTYPE:=MONADIC; 03104840P30 +... + IF OTOP LSS ITOP DIV 2 THEN ELSE ERR:=SYNTAXERROR; 03105087P31 +... + BEGIN 03105383P32 +... + T.OPTYPE:=MONADIC; 03106260P33 +... + GTR MAXPROGS THEN %OFF THE END OF SP 03110920P34 +... + BUILDCONSTANT:=L:=GS(1); %VECTOR DESCRIPTOR 03114800P35 +... + BEGIN 03121255P36 +... + SETFIELD(NEWDESC,7,1, IF BOOLEAN(T.SCALAR) 03124650P37 +... + END; 03140080P38 + INTEGER C; +... + T:=SP[NOC]; SP[NOC.NAMED:=1; N:=T; 03140600P39 +... + BEGIN SI:=A;SI:=SI+B;DI:=C;DI:=DI+D;DS:=CHR;END; 03150085P40 +... + L:=GETSPACE(N:=(NUMELEMENTS(D)+D,RF)); 03150650P41 +... + WHILE TRUE DO % RECURSIVE EVALUATION LOOP 03151310P42 +... + M := M + NJ; CC := 2; END; 03152646P43 +... + AND N.QUADIN=4) THEN POPPROGRAM:=TRUE; 03155000P44 +... + %ELSE WE HAVE AN ERROR (MISSING " ETC) 03210520P45 +... + OUTER:=(START:=L+RANK+J|MAT) + COL - 1; 03221020P46 +... + OP APL OPERATOR OP APL OPERATOR 03230015P47 +... + ANS := IF RIGHT | LEFT = 1 THEN 0 ELSE 1; %NAND 03233400P48 +... + DESC.SPF:=I; DESC.DID:=DDPUVW; SPCOPY(L,I,RANK1); 03235100P49 +... +PROCEDURE DYADICRNDM; + BEGIN INTEGER NUM, KIND; REAL DESC; + REAL DESC1, DESC2; + INTEGER START; LABEL INSERT; + DESC1 := AREG; DESC2 := BREG; + IF FINDSIZE(DESC1) NEQ 1 OR FINDSIZE(DESC2) NEQ 1; + THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END; + IF DESC1.SPF=0 OR DESC2.SPF=0 THEN BEGIN + ERR:=DOMAINERROR; GO TO QUIT; END; + L:=DESC1.SPF+DESC1.RF; M:=DESC2.SPF+DESC2.RF; + NUM := SP[LOC]; KIND := SP[MOC]; + IF KIND LSS ORIGIN + OR NUM GTR PICK := KIND-ORIGIN+1 + OR DESC1.ARRAYTYPE=1 + OR DESC2.ARRAYTYPE=1 THEN BEGIN ERR:=DOMAINERROR; + GO TO QUIT; END; + IF NUM LEQ 0 THEN BEGIN DESC := NULLV; GO TO QUIT; END; + IF NUM GTR MAXWORDSIZE THEN BEGIN ERR:=KITEERROR; GO TO QUIT; END; + DESC.SPF := L := GETSPACE(NUM+1); + SP[LOC] := NUM; L := L+1; + OUTTOP := L+NUM-1; + TEMP := GETSPACE(NUM); + START:=ORIGIN; I:=0; + FOR L:=L STEP 1 UNTIL OUTTOP DO BEGIN + PICK:=RANDINT(START,KIND,SEED); + M:=TEMP; + IF I = 0 OR PICK LSS SP[MOC] THEN N:=TEMP 03239380P50 + ELSE BEGIN TOP:=TEMP+I-1; + N:=TEMP+T:=I DIV 2; + WHILE T GTR 0 DO + IF PICK GEQ SP[NOC] THEN N:=N+T:=T DIV 2 + ELSE N:=N-T:=T DIV 2; + + FOR N:=MAX(TEMP,N-1) STEP 1 UNTIL TOP DO + IF SP[NOC] GTR PICK THEN + GO TO INSERT; + END; + INSERT: IF L LSS OUTTOP THEN BEGIN TOP:=N+1; N:=TEMP+I; + FOR M:=N STEP -1 UNTIL TOP DO BEGIN + N:=N-1; SP[MOC] := SP[NOC] - 1; END; + SP[NOC] := PICK; END; + SP[LOC] := N - TEMP + PICK; + KIND:=KIND-1; + I:=I+1; + END; + FORGETSPACE(TEMP,NUM); + QUIT: RESULTD := DESC; + END PROCEDURE DYADICRNDM; +PROCEDURE RHOP; + BEGIN INTEGER RANK,M,POINT; REAL NEWDESC,DESC1,DESC; + LABEL QUIT,WORK; BOOLEAN CHARACTER; + DEFINE TOOBIG=BEGIN ERR:=KITEERROR; GO TO QUIT; END#; + INTEGER N,TOP,NEWRANK,RANK1, POINT1,SIZE1,L,SIZE2; + DESC1 := AREG; DESC := BREG; + IF DESC.SPF = 0 THEN BEGIN ERR:=DOMAINERROR; GO TO QUIT; END; + IF DESC1.DIF NEQ 0 THEN BEGIN %--DYADIC RHO--RESTRUCTURING--------- + IF L:=DESC1.SPF = 0 THEN BEGIN %NULL LEFT OP MEANS SCA;LAR ANS + IF DESC.ARRAYTYPE=1 THEN TOOBIG; %NO SCALAR CHARACTERS + NEWDESC.SPF:=M:=GETSPACE(1); + NEWDESC.DID:=DDPUSW; + L:=DESC.SPF+DESC.RF; + SP[MOC]:=SM[LOC]; GO TO QUIT; END; + IF DESC1.ARRAYTYPE NEQ 0 THEN BEGIN + ERR:=DOMAINERROR; GO TO QUIT; END; + RANK1:=DESC1.RF; + IF FINDSIZE(DESC1)=1 THEN BEGIN + N:=L+RANK1; + IF SIZE1:=ENTIER(SP[NOC]+.5) LSS 0 THEN BEGIN + ERR:=DOMAINERROR; GO TO QUIT; END; + NEWRANK:=1; TOP:=N; GO TO WORK; END; + IF RANK1 NEQ 1 THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END; + FOR N:=L+RANK1 STEP 1 UNTIL TOP DO + IF SIZE1:=SIZE1?ENTIER(SP[NOC]+.5) LSS 0 THEN BEGIN + ERR:=DOMAINERRPOR; GO TO QUIT; END; +WORK: IF SIZE1=0 THEN BEGIN NEWDESC := NULLV; GO TO QUIT END; + IF SIZE1 GTR MAXWORDSTORE THEN TOOBIG; + NEWDESC.SPF := M := GETSPACE(SIZE1+NEWRANK); + %CANT USE SPCOPY FOR DIM VECTOR AS LEFT OP MAY NOT BE INTEGER + FOR L:=L+RANK1 STEP 1 UNTIL TOP DO; + BEGIN SP[NOC]:=ENTIER(SP[LOC]+.5); M:=M+1; END; + SIZE2:=FINDSIZE(DESC); L:=DESC.SPF; RANK:=DESC.RF; + IF DESC.ARRAYTYPE=1 THEN BEGIN L:=UNPACK(L,RANK,SIZE2); + CHARACTER:=TRUE; END; TOP:=SIZE1 DIV SIZE2; POINT:=L+RANK; + FOR N:=1 STEP 1 UNTIL TOP DO BEGIN SPCOPY(POINT,M,SIZE2); + M := M+SIZE2; END; + TOP := SRIZE1 MOD SIZE2; SPCOPY(POINT,M,TOP); + GO TO QUIT; END ELSE +%--------MONADIC RHO-----DIMENSION VECTOR---------------------- + RANK := DESC.RG; POINT := DESC.SPF; + NEWDESC.DID := DDPUVW; NEWDESC.RF := 1; + IF DESC.DATATYPE = 1 THEN BEGIN + NEWDESC := NULLV; GO TO QUIT END; + NEWDESC.SPF := M := GETSPACE(RANK+1); + SP[MOC] := RANK; + SPCOPY(POINT,M+1, RANK); + QUIT: IF CHARACTER THEN BEGIN NEWDESC.ARRAYTYPE:=1; + FORGETSPACE(L,SIZE2+RANK); + PACK(NEWDESC.SPF, NEWRANK,SIZE1); END; + RESULTD := NEWDESC; + END PROCEDURE RHOP; +PROCEDURE IOTAP; + BEGIN INTEGER I,L,M,TOP; REAL DESC; + REAL LEFTOP, RIGHTOP; + INTEGER RSIZE,LSIZE,RRANK,LRANK,N,LL,MM,TIP,NIX; + LABEL QUIT, DONE; 03240800P51 + LEFTOP:=AREG; RIGHTOP:=BREG + IF L:=RIGHTOP.SPF=0 THEN BEGIN ERR:=DOMAINERROR; GO TO QUIT END; + RSIZE:=FINDSIZE(RIGHTOP); RRANK:=RIGHTOP.RF; + DESC.DEIC := DDPUVW; DESC.RF := 1; + IF LEFTOP.DID NEQ 0 THEN BEGIN %-------DYADIC IOTA------------ + IF LRANK := LEFTOP.RF GTR 1 THEN BEGIN ERR:=RANKERROR; + GO TO QUIT; END; + LSIZE := FINDSIZE(LEFTOP); + IF M:=ALEFTOP.SPF=0 THEN BEGIN %RESULT IS ORIGIN IF IT WAS NULL + DESC.SPF:=M:=GETSPACE(1); DESC.RF:=0; DESC.SCALAR:=1; + SP[MOC] := ORIGIN; GO TO QUIT; END; + IF LEFTOP.ARRAYTYPE=1 THEN M:=UNPACK(M,LRANK,LSIZE); + IF RIGHTOP.ARRAYTYPE=1 THEN L:=UNPACK(L,RRANK,RSIZE); + TIP := (NTX:=LSIZE+ORIGIN) - 1; + DESC.SPF:=N:=GETSPACE(RSIZE+RRANK); + IF RRANK=0 THEN DESC.SCALAR:=1 ; DESC.RF:=RRANK; + SPCOPY(L,N,RRANK); + MM := M+LRANK; LL:=L:=L+RRANK; + TOP:=N+RRANK+RSIZE-1; + FOR N:=N+RRANK STEP 1 UNTIAL TOP DO BEGIN + SP[NOC] := NIX; + M := MM; + FOR I:=ORIGIN STEP 1 UNTIL TOP DO BEGIN + IF OPERATION(SP[MOC],SP[LOC],1,12,LEFTOP) AND LEFTOP=1 + THEN BEGIN SP[NOC]:=I; GO TO DONE; + END ELSE M:=M+1; + DONE: L:=L+1; END; + IF LEFTOP.ARRAYTYPE=1 THEN FORGETSPAZE(MM-LRANK,LRANK+LSIZE); + IF RIGHTOP.ARRAYTYPE=1 THEN FORGETSPZE(LL-RRANK,RRANK+RSIZE); + END ELSE BEGIN %-------------MONADIC IOTA------------------ + IF RIGHTOP.ARRAYTYPE=1 THEN + BEGIN ERR:=DOMAINERROR; GO TO QUIT + END; + IF RSIZE NEQ 1 THEN BEGIN ERR:=RANKERROR; GO TO QUIT END; + + L := L + RRANK; + IF TOP:=SP[LOC] GTR MAXWORDTORE THEN + BEGIN ERR:=KITEERROR; GO TO QUIT + END; + + IF TOP LSS ORIGIN THEN BEGIN DESC:=NULLV; GO TO QUIT END; + DESC.SPF := M := GETSPACE(TOP+1); + SP[MOC] := TOP; M := M+1; + TOP := TOP _ ORIGIN - 1; + FOR I := ORIGIN STEP 1 UNTIL TOP DO BEGIN + SP[MOC] := I; M := M+1; END; + END; +QUIT: RESULTD := DESC; + END PROCEDURE IOTAP; +PROCEDURE COMMAP; + BEGIN REAL LDESC, RDESC; + INTEGER L,M,N,LRANK,RRANK,LSIZE,RSIZE,SIZE; + REAL DESC; LABEL QUIT; BOOLEAN CHARACTER; + LDESC := AREG; RDESC := BREAG; + RRANK := RDESC.RF; LRANK := LDESC.RF; + LSIZE := IF (L := LDESC.SPF) = 0 THEN 0 ELSE FINDSIZE(LDESC); + RSIZE := IF (M := RDESC.SPF) = 0 THEN 0 ELSE FINDSIZE(RDESC); + IF RDESC.ARRAYTYPE = 1 THEN BEGIN + M := UNPACK(M,RRANK,RSIZE); + CHARACTER := TRUE; END; + DESC.DID := DDPUVW; DESC.RF := 1; + IF LDESC.DID = 0 THEN BEGIN %-----MONADIC COMMA--RAVEL-------- + IF RSIZE=0 THEN BEGIN DESC:=NULLV; GO TO QUIT END; + DESC.SPF := L := GETSPACE(RSIZE+1); + SP[LOC] := RSIZE; + SPCOPY(M+RRANK, L+1, RSIZE); + N := L; SIZE := RSIZE; + GO TO QUIT; END + ELSE BEGIN + %HERE IS THE CODE FOR DYADIC COMMA, I.E. CATNETATION + IF RRANK NEQ 1 AND RSIZE GTR 1 OR + LRANK NEQ 1 AND LSIZE GTR 1 THEN BEGIN + ERR:= RANKERROR; GO TO QUIT; END; + IF SIZE:=LSIZE+RSIZE GTR MAXWORDSTORE THEN BEGIN + ERR:=KITEERROR; GO TO QUIT; END; + COMMENT CANT MIX NUMBER AND CHARACTERS, HAVE TO JUGGLE + IF LEFT IS NUMBERS AND RIGHT IS CHARACTERS AS RIGHT + HAS ALREADY BEEN UNPACKED AND WE DONT WANT TO FORGET + LEFT AND DONT WANT TO PACK THE NON-RESULT; + IF CHARACTER THEN + IF LDESC.ARRAYTYPE=1 OR LSIZE=0 THEN L:=UNPACK(L,LRANK,LSIZE) + ELSE BEGIN SIZE:=0; LSIZE:=-LRANK; ERR:=DOMAINERROR; + GO TO QUIT END 03243705P52 + ELSE IF LDESC.ARRAYTYPE=1 THEN + IF RSIZE NEQ 0 THEN + BEGIN ERR:=DOMAINERROR; GO TO QUIT END + ELSE BEGIN CHARACTER:=TRUE; + L:=UNPACK(L,LRANK,LSIZE); END; + IF SIZE=0 THEN BEGIN DESC:=NULLV; GO TO QUIT END; + DESC.SPF := N := GETSPACE(SIZE=1); + SP[NOC] := SIZE; + SPCOPY(L+LRANK, N+1, LSIZE); + SPCOPY(M+RRANK, N+LSIZE+1, RSIZE); + END; + QUIT: + IF CHARACTER THEN BEGIN DESC.ARRAYTYPE := 1; + PACK(N,1,SIZE); + FORGETSPACE(L,LSIZE+LRANK); + FORGETSPACE(M,RSIZE+RRANK); + END; + RESULTD := DESC; + END PROCEDURE COMMAP; +INTEGER STREAM PROCEDURE GETOP(A,N); VALUE N; + BEGIN SI := A; SI := SI + N; + DI := LOC GETOP; + DS := 7 LIT "0"; DS := CHR; + END PROCEDURE GETOP; + REAL PROCEDURE IDENTITY(OP); VALUE OP; INNTEGER DP; + BEGIN + CASE OP OF BEGIN + IDENTITY := 0; %FOR + + IDENTITY := 1; %FOR | + IDENTITY := 0; %FOR - + IDENTITY := 1; %FOR DIV + IDENTITY := 1; %FOR * + ; %NO REDUCTION ON RNDM + IDENTITY := 0; %FOR RESQ + IDENTITY := BIGGEST; %FOR MIN + IDENTITY := -BIGGEST; %FOR MAX + ; %NOT ISNT DYADIC + IDENTITY := 1; %FOR COMB + IDENTITY := 0; %FOR LSS + IDENTITY := 1; %FOR = + IDENTITY := 1; %FOR GEQ + IDENTITY := 0; %FOR GTR + IDENTITY := 0; %FOR NEQ + IDENTITY := 1; %FOR LEQ + IDENTITY := 1; %FOR AND + IDENTITY := 0; %FOR OR + END; END PROCEDURE IDENTITY; +INTEGER PROCEDURE GETT(ALLONG,RANK); VALUE ALONG, RANK; + INTEGER ALONG, RANK; + GETT:= IF ALONG=1 THEN 0 ELSE + IF ALONG=RANK THEN 2 ELSE + IF ALONG=RANK-1 THEN 1 ELSE 0; +BOOLEAN PROCEDURE CHECKANDADD(SIZE,L,SUM); + VALUE SIZE,L; INTEGER SIZE,L,SUM; + BEGIN LABEL QUIT; INTEGER I,TOP,M,S,T; + CHECKANDADD:=TRUE; + SUM := 0; + TOP := SIZE DIV 2 ? 2 - 1 + L; + FOR L:=L STEP 2 UNTIL TOP DO BEGIN M:=L+1; + IF NOT BOOLTYPE(S:=SP[LOC], T:=SP[MOC]) THEN BEGIN + CHECKANDADD:=FALSE; GO TRO QUIT; END + ELSE SUM := SUM+S+T; END; + IF SIZE MOD 2 = 1 THEN BEGIN + IF NOT BOOLTYPE(T:=SP[LOC],0) THEN + CHECKANDADD := FALSE ELSE SUM := SUM+T; + END; + QUIT: END PROCEDURE CHECKANDADD; +PROCEDURE COMPRESS(LDESC, RDESC, DIM); VALUE LDESC,RDESC,DIM; + REAL LDESC, RDESC, DIM; + BEGIN INTEGER I,J,K,L,M,N,T,RANK,LSIZE,RSIZE,ALONG,TOP, + FACTOR,SUM,DIMMOD,SIZE,LEFT,RIGHT,S; + REAL DESC; BOOLEAN CHARACTER; + LABEL QUIT,RANKE,DOMAIN,IDENT; + DESC.ID := DDPUVW; + IF L := LDESC.SPF = 0 THEN GO TO DOMAIN; + IF M:=RDESC.SPF = 0 THEN BEGIN DESC:=NULLV; GO TO QUIT; END; + LSIZE := FINDSIZE(LDESC) RSIZE := FINDSIZE(RDESC); + IF RANK:=LDESC.RF NEQ 1 THEN IF LSIZE NEQ 1 + THEN GO TO DOMAIN; + LEFT := L := L+RANK; + RANK := RDESC.RF; + IF N:=DIM.SPF=0 AND DIM.DID NEQ 0 OR DIM.ARRAYTYPE=1 + OR LDESC.ARRAYTYPE=1 THEN GO TO DOMAIN; 03254510P53 + IF J:=DIM.RF NEQ 0 THEN BEGIN + IF DINDSIZE(DIM)=1 THEN N:=N+J ELSE GO TO DOMAIN END; + IF ALONG:=(IF N=J THEN RANK ELSE SP[NOC]-ORIGIN+1) GTR RANK + OR ALONG LSS 1 AND RANK NEQ 0 + THEN BEGIN ERR:=INDEXERROR; GO TO QUIT; END; + IF RANK = 0 THEN + IF LSIZE NEQ 1 THEN GO TO DOAMIN ELSE BEGIN + IF TOP:=SP[LOC]=0 THEN BEGIN DESC:=NULLV; GO TO QUIT; END; + IF TOP = 1 THEN BEGIN DESC.SPF := N := GESTAPCES(2); + DESC.RF := SP[NOC] := 1; + N:=N+1; SP[NOC]:=SP[MOC]; GO TO QUIT; + END ELSE GO TO DOMAIN; END; + IF LSIZE = 1 THEN BEGIN + COMMENT IF LEFT ARG IS SCALAR, ANSWER IS NULL IF 0, + RIGHT ARG IF 1; + SUN:=SP[LOC]; + IF SUM NEQ 0 AND SUM NEQ 1 THEN GO TO DOMAIN + + ELSE GO TO INDENT; END; + N := M+ALONG - 1; + IF LSIZE NEQ (T:=SP[NOC]) THEN BEGIN + ERR:=LENGTHERROR; GO TO QUIT; END; + IF NOT CHECKAND ADD(LSIZE,LEFT,SUM) THEN GRO TO DOMAIN; + IDENT: IF SUM=0 THEN BEGIN DESC:=NULLV; GO TO QUIT END; + IF SUM = LSIZE THEN BEGIN + RSIZE:=RSIZE DIV 8 + (IF RSIZE MOD 8 NEQ 0 THEN 1 ELSE 0); + DESC.CHRMODE:=1; END; + DESC.SPF:=N:=GETSPACE(TOP:=RSIZE+RANK); + DESC.RF := RANK; SPCOPY(M,N,TOP); GO TO QUIT; END; + SIZE := RSIZE DIV T ? SUM; + DESC.RF:=RANK; + IF RDESC.ARRAYTYPE = 1 THEN BEGIN M:=UNPACK(M,RANK,RSIZE); + CHARACTER := TRUE; END; + RIGHT := M; + DESC.SPF := S := GESTAPE(SIZE+RANK); + N := S; + FOR I:=1 STEP 1 UNTIL RANK DO BEGIN + IF I=ALONG THEN SP[NOC]:=SUM ELSE SP[NOC]:=SP[MOC]; + N:=N+1; M:=M+1; END; + T := GETT(ALONG, RANK); + FACTOR := 1; TOP := RIGHT+ALONG; + FOR N:=RIGHT+RANK-1 STEP -1 UNTIL TOP DO FACTOR:= + FACTOR ? SP[NOC]; + N:=RIGHT + RANK - 1; DIM := SP[NOC]; + N := N+1; M:=S+RANK; I:=0; + DIMMOD := DIM-1; + WHILE I LSS RSIZE DO BEGIN + CASE T OF BEGIN + L := I DIV FACTOR MOD LSIZE; + L := I DIV FACTOR MOD DIMMOD; + L := I MODE DIM; END; + L := L+LEFT; + IF SP[LOC] = 1 THEN FOR K:=1 STEP 1 UNTIL FACTOR DO BEGIN + SP[MOC]:=SP[NOC]; I:=I+1; M:=M=1; N:=N+1; + END ELSE BEGIN I:=I+FACTOR; N:=N+FACTOR; END; + END; + GO TO QUIT; + RANKE: ERR:=RANKERROR; GO TO QUIT; + DOMAIN: ERR:=DOMAINERROR; GO TO QUIT; + QUIT: IF CHARACTER THEN BEGIN PACK(S,RANK,SIZE); + DESC.ARRAYTYPE:=1; FORGETSPACE(RIGHT,RSIZE+RANK); END; + RESULTD := DESC; + POP; + END PROCEDURE COMPRESS; +PROCEDURE EXPAND(LDESC,RDESC,DIM); VALUE LDESC,RDESC,DIM; + REAL LDESC,RDESC, DIM; + BEGIN INTEGER I,J,K,L,M,N,S,T,RANK,LSIZE,RSIZE,SIZE, + ALONG,TOP,LADDR,MADDR,FACTOR, SUM; + REAL DESC, INSERT; + LABEL QUIT, DOMAIN; + BOOLEAN CHARACTER; + LSIZE:=FINDSIZE(LDESC); RSIZE:=FINDSIZE(RDESC); + RANK := RDESC.RF; + IF M:=RDESC.SPF=0 + OR L:=LDESC.SPF=0 + OR I:=LDESC.RF GTR 1 + + OR N:=DIM.SPF=0 AND DIM.DID NEQ 0 + OR DIM.ARRAYTYPE=1 + OR FINDSIZE(DIM ) NEQ 1 + OR LDESC.ARRAYTYPE=1 + THEN GO TO DOMAIN; 03268280P54 + N:=N + (T:=DIM.RF); + IF ALONG :=(IF N=T THEN RANK ELSE SP[NOC]-ORIGIN+1) GTR RANK + OR ALOG LSS 1 AND RANK NEQ 0 + THEN BEGIN ERR:=INDEXERROR; GO TO QUIT; END; + IF RANK=0 THEN DIM:=1 + ELSE BEGIN N:=M+ALONG-1; DIM:=SP[NOC]; END; + IF SIZE:=RSIZE DIV DIM ? LSIZE GTR MAXWORDSTORE + THEN BEGIN ERR:=KITEERROR; GO TO QUIT; END; + IF NOT CHECKANDADD(LSIZE,LADDR:=L+I, SUM) THEN GO TO DOMAIN; + IF SUM NEQ DIM THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END; + IF RANK=0 THEN BEGIN + DIM:=SP[MOC]; DESC.SPF:=N:=GETSPACE(LSIZE+1); + DESC.RF:=I; DESC.DIS:=(IF I=0 THEN DDPUSW ELSE DDPUVW); + SPCOPY(L,N,I); L:=L+I; N:=N+I; TOP:=L+LSIZE-1; + FOR L:=L STEP 1 UNTIL TOP DO BEGIN + IF SP[LOC]=1 THEN SP[NOC]:=DIM; + N:=N+1; END; + GO TO QUIT END; + IF RDESC.ARRAYTYPE=1 THEN BEGIN CHARACTER:=TRUE; + M:=UNPACK(M,RANK,RSIZE); + INSERT := " "; END; + FACTOR:=1; TOP:=M+ALONG; + FOR N:=M+RANK-1 STEP -1 UNTIL TOP DO FACTOR:=FACTOR?SP[NOC]; + T := GETT(ALONG, RANK); + J:=0; N:=(MADDR:=M) + RANK; + DESC.SPF:=M:=GETSAPCE(SIZE+RANK); + I:=M+RANK; + WHILE J LSS SIZE DO BEGIN + CASE T OF BEGIN + S := J DIV FACTOR MOD LSIZE; + S:=J DIV FACTOR MOD LSIZE; + S:=J MODE LSIZE; END; + L:=S + LADDR; + IF SP[LOC]=1 THEN FOR K:=1 STEP 1 UNTIL FACTOR DO + BEGIN L:=K+I; SP[LOC] := SP[NOC]; + J:=J+1; N:=N+1; + END ELSE FOR K:=1 STEP 1 UNTIL FACTOR DO BEGIN + L:=J+I; SP[LOC]:=INSERT; J:=J+I; END; + END; + L := MADDR; + FOR I:=1 STEP 1 UNTIL RANK DO BEGIN + IF I = ALONG THEN SP[MOC]:=LSIZE ELSE SP[MOC]:=SP[LOC]; + M:=M+1; L:=L+1; END; + DESC.DID:=DDPUVW; DESC.RF:=RANK; + GO TO QUIT; + DOMAIN: ERR:=DOMAINERROR; + QUIT: IF CHARACTER THEN BEGIN DESC.ARRAYTYPE:=1; + FORGETSPACE(MADDR, RSIZE+RANK); + PACK(DESC.SPF,RANK,SIZE); END; + RESULTD:=DESC; + POP; + END PROCEDURE EXPAND; +PROCEDURE MEMBER; + BEGIN REALLDESC, RDESC; + INTEGER L,M,N,I,S,T,LSIZE,RSIZE,LRANK,RRANK,TOP; + REAL DESC, TEMP, ANS; + LABEL QUIT; + LDESC := AREG; RDESC := BREG; + LSIZE:=FINDSIZE(LDESC); RSIZE:=FINDSIZE(RDESC); + LRANK:=LDESC.FR; RRANK:=RDESC.RF; + IF L:=LDESC.SPF=0 OR M:=RDESC.SPF=0 THEN BEGIN + ERR:=DOMAINERROR; GO TO QUIT END; + IF LDESC.ARRAYTYPE=1 THEN L:=UNPACK(L,LRANK,LSIZE); + IF RDESC.ARRAYTYPE=1 THEN M:=UNPACK(M,RRANK,RSIZE); + DESC:=LDESC; DESC.NAMED:=0; + DESC.ARRAYTYPE:=0; + DESC.SPF:=N:=GETSAPCE(LSIZE+LRANK); + SPCOPY(L,N,LRANK); + N:=N+LRANK; L:=(T:=L)+LRANK; M:=(S:=M)+RRANK; + T:=M+RSIZE-1; TOP := L+LSIZE-1; + FOR L:=L STEP 1 UNTIL TOP DO BEGIN + TEMP:=SP[LOC]; M:=S; + WHILE M LEQ T DO + IF OPERATION(TEMP,SP[MOC],0,12,ANS) AND ANS=1 THEN BEGIN + SP[NOC]:=1; M:=M+T; END ELSE M:=M+1; + N:=N+1; END; + + IF RDESC.ARRAYTYPE=1 THEN FORGETSPACE(S,RSIZE+RRANK); + IF LDESC.ARRAYTYPE=1 THEN FORGETSPACE(I,LSIZE+LRANK); + QUIT: RESULTD:=DESC; + END PROCEDURE MEMBER; +REAL PROCEDURE BASEVALUE; + BEGIN 03269860P55 + COMMENT THIS RETURNS A DESCRIPTOR FOR A SCALAR RESULT; + LABEL OUTE,BAD; + REAL E,L,M,LEFT,RIGHT,T,LARG,RARG; + LARG := AREG; RARG := BREG; + IF M:=RARG.SPF=0 LARG.CHRMODE=1 OR RARG.CHRMODE=1 + OR L:=LARG.SPF=0 AND LARG.DID NEQ 0 + THEN GO TO BAD; + RIGHT:=SP[MOC]; + LEFT:=SP[LOC]; + IF FINDSIZE(LARG)=1 THEN % A 1 ELEMENT VECTOR + BEGIN + L:=L+LARG.RF; + LARG.SCALAR:=1; + LEFT:=SP[LOC]; + END; + IF FINDSIZE(RARG)=1 THEN % A ONE ELEMENT VECTOR + BEGIN + M:=M+RARG.RF; + RIGHT:=SP[MOC]; + RARG.SCALAR:=1; + END; + IF L=0 THEN + BEGIN % BASEVAL MONADIC + LEFT:=2; %IF MONADIC, ITS 2 BASVAL X + LARG.SCALAR:=1; + END; + IF BOOLEAN(LARG.SCALAR )THEN %SCALAR + IF BOOLEN(RARG.SCALAR) THEN + BEGIN + T:=RIGHT; %SCALAR-SCALAR + GO OUTE; + END + ELSE + IF RARG.RF=1 THEN + BEGIN COMMENT SCALAR-VECTIOR--LEFT IS VALUE OF SCALAR, RIGHT + IS # OF ELEMENTS; + IF LEFT=0 THEN GO OUTE + ELSE E:=1/LEFT; + FOR L :=M+RIGHT STEP -1 UNTIL M+1 DO + T:=T+SP[LOC]\(E:=E\LEFT); + GO OUTE; + END + ELSE BAD: ERR:=BOMAINERROR + ELSE + IF RARG.SCALAR=0 THEN + IF LARG.RF NQ 1 OR RARG.RF NEQ 1 THEN + ERR:=DOMAINERROR + ELSE + BEGIN + GT2:=L; % SAVE FOR LATER TEST + GT1:=M+2; % WANT TO STOP 2 UP IN LOOP + L:=L+LEFT; % START AT OTHER END + E:=1; + M:=M+RIGHT; + T:=SP[MOC]; % INITIAL VALUE + FOR M:=M-1 STEP -1 UNTIL GT1 DO + BEGIN + IF L:=L-1 LSS GT2 THEN L:=GT2+LEFT; % START OVER + E:=E?SP[LOC]; + T:=T+SP[MOC]?E; + END; +OUTE: + L:=GETSPACE(1); + SP[LOC]:=T; + T:=0; + T.DID:=DDPUSW; % BUILD DESCRIPTOR + T.SPF:=L; + BASEVALUE:=T; + END + ELSE ERR := DOMAINERROR + END OF BASEVALUE; +REAL PROCEDURE REPRESENT; + BEGIN + COMMENT RETURNS DESCRIPTOR OF VECTOR IF LARG VECTOR AND RARG SCALAR; + REAL L,M,LEFT,RIGHT,T,E,LARG,RARG; + LABEL AROUND + LARG := AREG; RARG := BREG; + IF (RARG.SCALAR=1 OR FINDSIZE(RARG)=1 AND RARG.CHRMODE=0) + AND NOT(LARG.SCALAR=1 OR LARG.CHRMODE=1 OR LARG.RF NEQ 1) THEN + BEGIN + COMMENT VECTOR-SCALAR; + IF L:=LARG.SPF=0 OR M:=RARG.SPF=0 THEN GO AROUND; + IF RARG.SCALAR=0 THEN M:=M+RARG.RF; 03271020P56 + RIGHT:=SP[MOC]; % VALUE OF SCALAR + LEFT:=SP[LOC]; % LENGTH OF VECTOR + E:=M:=GETSPACE(LEFT+1); % MAKE ROOM FOR ANSWER + SP[MOC]:=LEFT; % LENGTH OF ANSWER + M:=M+LEFT; + GT1:=L+2; + FOR L:=L+LEFT STEP -1 UNTIL GT1 DO + IF T:=SP[LOC] LEQ 0 THEN + IF T LSS 0 THEN ERR:= DOMAINERROR + ELSE + BEGIN + L:=GT1-1 ; % STOP THE LOOP + M:=M-1; + END + ELSE + BEGIN + SP[MOC]:= RIGHT MOD T; + RIGHT:=RIGHT DIV T; + M:=M-1; + IF RIGHT LSS FUZZ THEN L:=GT1-1; % STOP THE LOOP + END; + SP[MOC]:=RIGHT; % LEFTOVER GOES HERE + T.DID:=DDPUVW; + T.RF:=1; + T.SPF:=E; + REPRESENT:=T; + END; + ELSE AROUND: ERR:=DOMAINERROR; + END OF REPRESENT; +PROCEDURE PERIOD(LDESC,RDESC,LOP,ROP); + VALUE LDESC,RDESC,LOP,ROP; REAL LDESC,RDESC; INTEGER LOP,ROP; +BEGIN INTEGER L,M,N,J,LRANK,RRANK,RANK,LSIZE,RSIZE,SIZE,LL,MM,I, + RROW,RCOL,LROW,LCOL,LJUMP,RJUMP,MSAVE,LSAVE,RSTART; + REAL DESC, TEMP; + BOOLEAN CHARACTER, FIRST,LSCALAR, RSCALAR; + LABEL QUIT, DOMAIN, FORGET, OUTERPROD; + IF L:=LDESC.SPF = 0 OR M:= RDESC.SPF=0 THEN GO TO DOMAIN; + LSIZE := FINDSIZE(LDESC); RSIZE:=FINDSIZE(RDESC); + LRANK:=LDESC.RF; RRANK := RDESC.RF; + IF LOP NEQ 45 THEN + IF LRANK GTR 2 AND LSIZE NEQ 1 OR RRANK GTR 2 AND RSIZE NEQ 1 THEN + BEGIN ERR:=KITEERROR; GO TO QUIT; END; + IF ROP:=GETOP(CORRESPONDENCE,ROP-1) = 9 THEN BEGIN + ERR:=SYNTAXERROR; GO TO QUIT; END; + IF LL:=LDESC.ARRAYTYPE=1 OR MM:=RDESC.ARRAYTYPE=1 THEN + IF LL ? MM NEQ 1 THEN GO TO DOMAIN + ELSE BEGIN + + IF ROP LSS 11 OR ROP GTR 16 THEN GO TO DOMAIN; + CHARACTER:=TRUE; + M:=UNPACK(M.RRANK,RSIZE); + L:=UNPACK(L,LRANK,LSIZE); END; + MSAVE := M; LSAVE:=L; IF ROP NEQ 45 THEN + IF LOP=45 THEN GO TO OUTERPROD ELSE + IF LOP:=GETOP(CORRESPONDENCE,LOP-1)=9 THEN + BEGIN ERR:=SYNTAXERROR; GO TO QUIT; END; + IF LRANK=2 THEN BEGIN + N:=L+LRANK-1; LCOL := SP[NOC]; + N:=N-1; RROW:=SP[NOC]; END; + IF LRANK=1 THEN BEGIN LROW:=1; LCOL:=SP[LOC]; END; + IF RRANK=2 THEN BEGIN + N :=M+RRANK-1; RCOL:=SP[NOC]; + N:=N-1; RROW:=SP[NOC]; END; + IF RRANK=1 THEN BEGIN RROW:=SP[MOC]; RCOL:=1; END; + IF LSIZE =1 OR RSIZE=1 THEN BEGIN + IF LSIZE = 1 AND RSIZE = 1 THEN LROW:=LCOL:=RROW:=RCOL:=1 + ELSE IF LSIZE=1 THEN BEGIN LCOL:=RROW; LRUOW:=1; + L:=L+LRANK-1; LRANK:=1; + LSCALAR:=TRUE; END; + ELSE BEGIN RRROW := LCOL; RCOL := 1; + M:=M+RRANK-1; RRANK:=1; + RSCALAR:=TRUE; END; + END; + IF LCOL NEQ RROW + THEN BEGIN ERR:=RANKERROR; GO TO QUIT; END; + DESC.SPF:=N:=GETSPACE((RANK:=MAX(0,LRANK+RRANK-1))+ + SIZE:=LROW?RCOL); + SPCOPY(L,N,LRANK-1); + SPCOPY(M+1,N+LRANK-1,RRANK-1); + DESC.RF:=RANK; DESC.DID:=(IF RANK=0 THEN DDPUSW ELSE DDPUVW); + N:=N+RANK; + LL := L + LRANK - 1; + MM := M + RRANK - 1; 03272500P57 + LJUMP := LCOL-1; RJUMP := IF RSCALAR THEN 0 ELSE (RROW-1) ? RCO + FOR J:=1 STEP LCOL UNTIL LSIZE DO + FOR RSTART:=1 STEP 1 UNTIL RCOL DO BEGIN + FIRST:=TRUE; + M := MM + RSTART + RJUMP; RROW := LL + J; + FOR I:=LL +LJUMP + J STEP -1 UNTIL RROW DO BEGIN + IF LSCALR THEN L:=LL+1 ELSE L:=I; + IF FIRST THEN BEGIN + IF NOT OPERATION(SP[LOC],SP[MOC],1ROP,SP[NOC]) + THEN GO TO FORGET ELSE FIRST := FALSE; + END ELSE BEGIN + IF NOT OPERATION(SP[LOC],SP[MOC],1,ROP,TEMP) + THEN GO TO FORGET; + IF NOT OPERATION(TEMP,SP[NOC],-1,LOP,SP[NOC]) + THEN GO TO FORGET END; + IF NOT RSCALAR THEN M:=M-RCOL; END; + N := N+1; + END; + GO TO QUIT; +OUTERPROD: IF SIZE:=LSIZE?RSIZE GTR MAXWORDSTORE + OR RANK := LRANK+RRANK GTR 31 THEN BEGIN + ERR:=KITEERROR; GO TO QUIT; END; + DESC.SPF:=N:=GETSPACE(SIZE+RANK); + DESC.DID:=IF RANK=0 THEN DDPUSW ELSE DDPUVW; + DESC.RF:=RANK; + SPCOPY(L,N,LRANK); + SPCOPY(M,N+LRANK,RRANK); + N:=N+RANK; + I:=L + LRANK + RSIZE - 1; + MM := M+RRANK + RSIZE - 1; + FOR L:=L+LRANK STEP 1 UNTIL I DO + FOR M:=MSAVE+RRANK STEP 1 UNTIL MM DO + IF NOT OPERATION(SP[LOC],SP[MOC],1,ROP,SP[NOC]) THEN + GO TO FORGET ELSE N:=N+1; + GO TO QUIT; + FORGET: FORGETSPACE(DESC,SPF,RANK+SIZE); + DOMAIN: ERR:=DOMAINERROR; + QUIT: IF CHARACTER THEN BEGIN + FORGETSPACE(MSAVE , RRANK+RSIZE); + FORGETSPACE(LSAVE , LRANK+LSIZE); END; + RESULTD := DESC; + END PROCEDURE PERIOD; +PROCEDURE REVERSE(SOURCE,LENGTH,DEST,JUMP); VALUE SOURCE,DEST, + LENGTH,JUMP; INTEGER SOURCE,LENGTH,DEST,JUMP; + BEGIN INTEGER L,M,TOP; + M:=SOURCE + TOP:=(LENGTH-1) ? JUMP; TOP:=DEST+TOP; + FOR L:=DEST STEP JUMP UNTIL TOP DO BEGIN + SP[LOC] := SP[MOC]; M:=M-JUMP; END; + END PROCEDURE REVERSE; +PROCEDURE ROTATE(SOURCE,LENGTH,DEST,JUMP,ROT); VALUE SOURCE, + LENGTH,DEST,JUMP,ROT; INTEGER SOURCE,LENGTH,DEST,JUMP,ROT; + BEGIN INTEGER L,M,TOP; + TOP := SOURCE + (LENGTH-1) ? JUMP; + FOR L:=SOURCE STEP JUMP UNTIL TOP DO BEGIN + M:=DEST+(ROT MOD LENGTH)?JUMP; SP[MOC]:=SP[LOC]; + ROT := ROT + 1; END; + END PROCEDURE ROTATE; +INTEGER PROCEDURE GETNUM(TIM,L,SIZE,DIM); VALUE TIM,L, + SIZE,DIM; INTEGER TIM,L,SIZE,DIM; + BEGIN INTEGER NUM; + IF SIZE NEQ 0 THEN L := L + TIM; + NUM:=SIGN(NUM:=SP[LOC]) ? ENTIER(ABS(NUM)) MOD DIM; + IF NUM LSS 0 THEN GETNUM := -NUM %FOR RIGHT ROTATION + ELSE GETNUM:=DIM-NUM; %FOR LEFT ROTATION + END PROCEDURE GETNUM; +BOOLEAN PROCEDURE MATCHROT(LDESC,RDESC,ALONG); VALUE LDESC, + RDESC,ALONG; INTEGER LDESC,RDESC,ALONG; + BEGIN INTEGER I,L,M,R; LABEL QUIT; + MATCHROT:=TRUE; L:=DESC.SPF; M:=RDESC.SPF; + IF R:=LDESC.RF NEQ RDESC.RF-1 THEN BEGIN + MATCHROT:=FALSE; GO TO QUIT; END; + FOR I:=1 STEP 1 UNTIL R DO BEGIN IF I=ALONG THNE M:=M+1; + IF SP[LOC] NEQ SP[MOC] THEN BEGIN MATCHROT:=FALSE; + GO TO QUIT; END; M:=M+1; L:=L+1; END; + QUIT: END PROCEDURE MATCHROT; +PROCEDURE REDUCESORTSCAN(LOP,REDESC,DIM,KIND); VALUE LOP,RDESC, + DIM,KIND; REAL LOP,RDESC,DIM; INTEGER KIND; + BEGIN INTEGER L,M,N,I,J,K,ALONG,FACTOR,T,MSAVE,DIFF,SSIZE, + JUMP,RANK,SIZE,TOP,LASTDIM,INTERVAL,TEMP,HOP; + INTEGER REMDIM,LRANK,LSAVE,LSIZE,S; + BOOLEAN CHARACTER,REDUCE,SORT,SCAN,REVERSAL,ROTATION; + REAL DESC; + LABEL QUIT, FORGET, RANKERR; 03273620P58 + COMMENT: KIND=1 FOR REDUCTION + KIND=2 FOR SORTUP OR SORTDN + KIND=3 FOR SCAN + KIND=4 FOR REVERSAL + KIND=5 FOR ROTATION; + PROCEDURE SORTIT(L,M,SIZE,JUMP,UP); VALUE L,M,SIZE,JUMP,UP; + INTEGER L,M,SIZE,JUMP; BOOLEAN UP; + BEGIN INTEGER N.TIP,TOP,LSAVE; + REAL COMPARE,OUTOFIT; + OUTOFIT:=IF UP THEN BIGGEST ELSE -BIGGEST; + TIP := M + (N:=(SIZE-1) ? JUMP); TOP := L + N; + LSAVE := L; + FOR M:=M STEP JUMP UNTIL TIP FO BEGIN + L := LSAVE; COMPARE := SP[LOC]; N:=L; + FOR L:=L+1 STEP 1 UNTIL TOP DO + IF UP THEN BEGIN IF SP[LOC] LSS COMPARE THEN BEGIN + N:=L; COMPARE:=SP[LOC]; END; + END ELSE IF SP[LOC] GTR COMPARE THEN + N:=L; COMPARE:=SP[LOC]; END; + SP[NOC] := OUTOFIT; + SP[MOC] := (N-LSAVE) + ORIGIN; + END; + END PROCEDURE SORTIT; + CASE KIND OF BEGIN ; REDUCE:=TRUE; SORT:=TRUE; SCAN:=TRUE; + REVERSAL:=TRUE; ROTATION:=TRUE; END; + IF LOP GTR 64 AND NOT ROTATION THEN BEGIN + ERR:=SYSTEMERROR; GO TO QUIT; END; + IF REDUCE OR SCAN THEN IF LOP NEQ 45 THEN + LOP := GETOP(CORRESPONDENCE,LOP-1); + IF M:=RDESC.SPF=0 AND NOT REDUCE + OR DIM.DID NEQ 0 AND N:=DIM.SPF=0 OR DIM.ARRAYTYPE=1 + OR FINDSIZE(DIM) NEQ 1 THEN BEGIN + ERR:=DOMAINERROR; GO TO QUIT END; + IF (REDUCE OR SCAN) AND LOP=9 THEN BEGIN %OP NOT DYADIC SCALAR + ERR:=SYNTAXERROR; GO TO QUIT END; + IF M=0 THEN BEGIN + %FOR REDUCTION, RESULT OF A NULL IS CORRESPONDING IDENTITY + %EXCEPT THAT NAND, NOR, CIRCLE, AND LOG (LOP GTR 18) + %HAVE NO IDENTITIES, SO THE RESULT IS A NULL + DESC.DID := DDPUSW; + IF LOP LEQ 18 THEN BEGIN DESC.SPF:=N:=GETSPACE(1); + SP[NOC] := IDENTITY(LOP); END ELSE DESC.RF:=1; + GO TO QUIT; END; + IF RDESC.ARRAYTYPE=1 AND (REDUCE OR SCAN) THEN + BEGIN ARR:=DOMAINERROR; GO TO QUIT; END; + SIZE:=FINDSIZE(RDESC); + RANK:=RDESC.RF; + IF SIZE=1 THEN BEGIN + %UNLESS SORT, RESULT OF SINGLE-VALUED ARGUMENT IS THAT ARGUMENT + DESC := RDESC; + DESC.SPF := N := GETSPACE(RANK+1); + SPCOPY(M,N,RANK);M:=M+RANK;N:=N+RANK; + IF SORT THEN BEGIN SP[NOC]:=ORIGIN; DESC.ARRAYTYPE:=0; + END ELSE SP[NOC]:=SP[MOC]; + GO TO QUIT; END; + + IF RDESC.ARRAYTYPE=1 THEN BEGIN + CHARACTER := TRUE; + M:=UNPACK(M,RANK,SIZE); END; + MSAVE:=M; + N:=N+(T:=DIM.RF); + IF ALONG:=(IF N=T THEN RANK ELSE SP[NOC]-ORIGIN+1) GTR RANK + OR ALONG LSS 1 + THEN BEGINERR:=INDEXERROR; GO TO QUIT; END; + IF ROTATION THEN BEGIN + IF LSAVE:=LOP.SPF=0 OR LOP.ARRAYTYPE=1 THEN + BEGIN ERR:=DOMAINERROR; GO TO QUIT; END; + IF LSIZE:=FINDSIZE(LOP) NEQ 1 THEN + IF NOT MATCHROT(LOP,RDESC,ALONG) THEN BEGIN + ERR:=RANKERROR; GO TO QUIT; END; + LSAVE := LSAVE + LRANK := LOP.RF; + IF LSIZE = 1 THEN LRANK := 0; END; + N:=M+ALONG-1; + DIM:=SP[NOC]; + JUMP:=1; I:=M+ALONG; + FOR L:=M+RANK-1 STEP -1 UNTIL I DO JUMP:=JUMP ? SP[LOC]; + N:=M+RANK-1; LASTDIM:=SP[NOC]; + IF ALONG = RANK-1 THEN BEGIN N:=N-1; + FACTOR:=LASTDIM ? SP[NOC]; END; + T := GETT(ALONG, RANK); + J := M + RANK; + REMDIM := 1; + HOP := (DIM-1) | JUMP; 03274600P59 + DESC.DIF := DDPUVW; + IF ALONG GTR 1 AND ALONG LSS RANK-1 THEN BEGIN TOP:=M+ALONG-2; + FOR L:=M STEP 1 UNTIL TOP DO REMDIM:=REMDIM?SP[LOC]; END; + IF REDUCE THEN BEGIN DESC.SPF:=N:=GETSPACE(SSIZE:=SSIZE DIV DIM + + RANK - 1); + IF RANK=1 THEN DESC.SCALER:=1 ELSE DESC.RF:=RANK-1; + FOR I:=1 STEP 1 UNTIL RANK DO BEGIN + IF I NEQ ALONG THEN BEGIN SP[NOC]:=SP[MOC]; N:=N+1; END; + M:=M+1; END; + JUMP := -JUMP; + END ELSE BEGIN DESC.SPF:=N:=GETSPACE(SSIZE:=SIZE+RANK); + INTERVAL := (DIFF := N-M) + HOP; + SPCOPY(M,N,RANK); DESC.RF:=RANK; END + IF SORT THEN TEMP:=GETSPACE(DIM); + TOP := SIZE DIV (DIM ? REMDIM) - 1; + FOR S:=1 STEP 1 UNTIL REMDIM DO BEGIN + FOR T:=0 STEP 1 UNTIL TOP DO BEGIN + CASE T OF BEGIN + L := I + J; + L:=I DIV LASTDIM?FACTOR + I MOD LASTDIM + J; + L:=I?LASTDIM + J; END; + IF REDUC THEN BEGIN M:=I+N; L:=HOP + (K:=L); + SP[MOC] := SP[LOC]; + FOR L:=L+JUMP SETP JUMP UNTIL K DO + IF NOT OPERATION(SP[LOC],SP[MOC],-1,LOP,SP[MOC]) + THEN GO TO FORGET; + END ELSE + IF SORT THEN BEGIN K:=L+HOP; N:=TEMP; + FOR M:=L STEP JUMP UNTIL K DO BEGIN + SP[NOC] := SP[MOC]; N:=N+1; END; + IF LOP LSS 0 THEN SORTIT(TEMP,L+DIFF,DIM,JUMP,FALSE) + ELSE SORTIT(TEMP,L+DIFF,DIM,JUMP,TRUE); + END ELSE IF SCAN THEN BEGIN + K:=L+INTERVAL; N:=L+DIFF; SP[NOC] := SP[LOC]; + FOR N:=N+JUMP STEP JUMP UNTIL K DO BEGIN + M:=N-JUMP; L:=L+JUMP; + IF NOT OPERATION(SP[MOC],SP[;QOC],-1,LOP,SP[NOC]) + THEN GO TO FORGET; END; + END ELSE IF REVERSAL THEN REVERSE(L,DIM,L+DIFF,JUMP) + ELSE IF ROTATION THEN ROTATE(L,DIM,L+DIFF,JUMP, + GETNUM(I,LSAVE,LRANK,DIM)); + END; + J := J + ABS(JUMP?DIM); + N := N + TOP + 1; + DIFF := DIFF + TOP + 1; + END; + GO TO QUIT; + RANKERR: ERR:=RANKERROR; FORGETSPACE(DESC.SPF,SSIZE);GO QUIT; + FORGET: ERR:=DOMAINERROR; FORGETSPACE(DESC.SPF, SSIZE); +QUIT: IF CHARACTER THEN BEGIN + FORGETSPACE(MSAVE,SIZE+RANK); + IF (REVERSAL OR ROTATION) AND ERR=0 THEN BEGIN + DEX.ARRAYTYPE:=1; PACK(DESC.SPF,RANK,SIZE); END; END; + IF SORT THEN FORGETSPACE(TEMP,DIM); + RESULTD := DESC; + IF ROTATION THEN POP; + END PROCEDURE REDUCESORTSCAN; +PROCEDURE DYADICTRANS; +BEGIN REAL LDESC,RDESC; + INTEGER L,M,N,RANK,NEWRANK,SIZE,TEMP,I,J; + DEFINE SPTOP=RDESC#,MIN=RDESC#,PTR=REWRANK#,MBASE=LDESC#,TOP=RDESC# + ,RESULT=RESULTD#; + LABEL QUIT; BOOLEAN CARRY; +INTEGER ARRAY RVEC,DEL,SUB,OLDEL[0:3]; + LDESC:=AREG; RDESC:=BREG; + RESULT:=0; L:=LDESC.SPF; J:=LDESC.RF; RANK:=RDESC.RF; + IF M:=RDESC.SPF=0 OR L=0 OR LDESC.ARRAYTYPE=1 THEN BEGIN + ERR:=DOMAINERROR; GO TO QUIT; END; + IF NUMELEMENTS(LDESC)=1 THEN BEGIN N:=L+J; + IF SP[NOC] NEQ ORIGIN OR RANK GTR 1 THEN BEGIN + ERR:=DOMAINERROR; GO TO QUIT END; + %IF WE GET HERE, THE ANSWER IS ITSELF + RESULT:=RDESC; I:=NUMELEMENTS(RDESC); + RESULT..SPF:=N:=GETSPACE(SIZE:=RANK+1); RESULT.NAMED:=0; + SPCOPY(M,N,SIZE); GO TO QUIT END; + IF J GTR 1 THEN BEGIN ERR:=RANKERROR; GO TO QUIT END; + IF SP[LOC] NEQ RANK THEN BEGIN ERR:=LENGTHERROR; GO TO QUIT END; +% FIND MAX OF LDESC FOR NOW- DO THE REST LATER +%LDESC W/R/T ORIGIN 0 GETS STORED IN SUB[I] + SPTOP:=L+RANK; NEWRANK:=0; I:=0; + FOR N:=1 STEP 1 UNTIL SPTOP DO BEGIN + IF TEMP:=SP[NOC]-ORIGIN+1 GTR NEWRANK THEN NEWRANK:=TEMP; + SUB[I]:=TEMP-1; I:=I+1 END; 03277000P60 + IF NEWRANK GTR TANK THEN BEGIN ERR:=DOMAINERROR;GO TO QUIT END; +% CALCULATE THE OLD DEL VECTOR, OLDEL + PLDEL[RANK-1]:=1; N:=M+RANK-1; + FOR I:=RANK-2 STEP -1 UNTIL 0 DO BEGIN + OLDEL[I]:=OLDEL[I+1]?SP[NOC]; N:=N-1 END; + MBASE:=M; SIZE:=1; +%FIX UP THE NEW RVAC AND DEL + FOR I:=NEWRANK-1 STEP -1 UNTIL 0 FO BEGIN +% FIND SMALLEST EL. OF RHO RDESC [J] S.T. A[J]=I +% AND SUM OF OLDEL[J] S.T. A[J]=1 + MIN:=31; TEMP:=0; + FOR J:=RANK-1 STEP -1 UNTIL 0 DO + IF SUB[J]=1 THEN BEGIN + M:=MBASE+J; + IF SP[MOC] LSS MIN THEN MIN:=SP[MOC]; + TEMP:=TEMP+OLDEAL[J] END; + RVEC[I]:=MIN; DEL[I]:=TEMP; SIZE:=SIZE?RVEC[I]; + IF TEMP=0 THEN BEGIN %IT DOESN7T EXHAUSE IOTA NEWRANK + ERR:=DOMAINERROR; GO TO QUIT END; + END; + RESULT:=M:=GETSPACE(NEWRANK+SIZE); + RESULT.RF:=NEWRANK; RESULT.DID:=DDPUVW; + IF BOOLEAN(BREG.ARRAY) THEN BEGIN + RESULT.ARRAYTYPE:=1; N:=MBASE; + MBASE:=UNPACK(MBASE,RANK,N:=OLDEL[0]?SP[NOC]); + FORGETSPACE(MBASE,N+RANK) END; + FOR I:=1 STEP 1 UNTILNEWRANK DO BEGIN + SUB[I]:=0; OLDEL[I]:=RVEC[I]?DEL[I] END; + %INTIALIZE FOR STEPPING THRU NEW ARRAY + FOR I:=NEWRANK-1 STEP -1 UNTIL 0 DO BEGIN + SUB[I]:=0; OLDEL[I]:=RVEC[I]?DEL[I] ENND; + L:=MBASE+RANK; +%STEP THRU THE SUBSCRIPTS OF THE ANSWER TO PICK UP THE ELEMENTS +% IN ROW ORDER ACCORDING TO THE MAPPING GIVEN BY DEL + PTR:=TOP:=NEWRANK-1; + FOR I:=1 STEP 1 UNTIL SIZE DO BEGIN + SP[MOC] :=SP[LOC]; + M:=M+1; +%GET NEXT SUBSCRIPT FOR NEW ARRAY AND SET NEXT L; + SUB[PTR]:=SUB[PTR]+1; + L:=L+DEL[TOP]; + CARRY:=TRUE; + WHILE CARRY AND I NEQ SIZE DO + IF SUB[PTR] GEQ RVEC[PTR] THEN BEGIN + SUB[PTR]:=0; + L:=L-OLDEL[PTR]+DEL[PTR:=PTR-1]; + SUB[PTR]:=SUB[PTR]+1 + END ELSE CARRY:=FALSE; + PTR:=TUOP; + END; + IF BOOLEAN(RESULT.ARRAYTYPE) THEN PACK(RESULT.SPF,TOP+1,SIZE); +QUIT: END OF DYADICTRANS; + INTEGER PROCEDURE LOCATE(L,M); VALUE L,M; REAL L,M; + BEGIN + COMMENT L IS THE DIMENSION OF THE VECTOR(DESCRIPTOR), + M IS THE INDEX VECTOR; + INTEGER P,I,UB; + L:=I:=L.SPF; M:=I:=M.SPF; + UB:=SP[MOC]-1; + M:=M+1; + FOR I:=1 STEP 1 UNTIL UB DO + BEGIN + L:=L+1; + P:=(P+SP[MOC]-1)?SP[LOC]; + M:=M+1; + END; + P:=P+SP[MOC]; + LOCATE:=P+L; + END; + PROCEDURE DISPLAY(A,B); VALUE A,B; REAL A,B; + BEGIN + PROCEDURE PRINTMATRIX(L,ROW,COL);VALUE L,ROW,COL; + INTEGER L,ROW,COL; + BEGIN INTEGER I,J,CC,FOLD; DEFINE WIDE=GT2#; + WIDE:=LINESIZE; + FOR I:=1 STEP 1 UNTIL ROW DO + BEGIN CC:=0; %NO BLANKS AT BEGINNING OF LINE + FOLD:=0; + FOR J:=1 STEP 1 UNTIL COL DO + BEGIN NUMBERCON(SP[LOC],ACCUM); + IF FOLD:=FOL+ACOUNT+CC GTR WIDE AND ACOUNT+CC + LEQ WIDE THEN BEGIN TERPRINT; + FORMROW(0,2,ACCUM,2,ACOUNT); FOLD:=ACOUNT+2; END ELSE 03500140P61 + FORMROW(0,CC,ACCUM,2,ACOUNT); L:=L+1; + CC:=2; %PUT 2 BLANKS AFTER FIRST ITEM. + END; + TERPRINT; + END; + END; + INTEGER L,M,N,BOTTOM,ALOC,BLOC; + INTEGER ROW,COL; + ALOC:=A.SPF; BLOC:=B.SPF-1; + L:=(M:=B.RF)+ BLIOC; COL:=SP[LOC]; + L:=L-1; + ROW:=(IF M GTR 1 THEN SP[LOC] ELSE 1); + L:=BOTTOM:=M-2; + PRINTMATRIX(LOCATE(B,A),ROW,COL); + WHILE L GTR 0 DO + BEGIN + M:=ALOC+L; N:=BLOC+1; + IF SP[MOC]:=SP[MOC]+1 GTR SP[NOC] THEN + BEGIN SP[MOC]:=1; L:=L-1; END + ELSE BEGIN FORMWD(3,"1 "); + PRINTMATRIX(LOCATE(B,A),ROW,COL); + L:=BOTTOM; + END; + END; + FORMWD(3,"1 "); + END; + PROCEDURE MAKEFUNCTIONPRESENT(L); VALUE L ; REAL L; %LOC DESC + BEGIN + INTEGER I; + REAL M,N,SEQ,ORD,D; + BOOLEAN NUMERIC; + REAL STREAM PROCEDURE CON(A);VALUE A; + BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT + END; + D:=SP[LOC]; %DESCRIPTOR FOR FUNCTION IS IN D + SEQ:=GETFIELD(D,FSQF-8,FFL); ORD:=GETFIELD(D,FPTF-8,FFL); + N:=GETSPACE(M:=SIZE(ORD)?2+6); %GET SPACE FOR TABLE + SP[NOC]:=M?2+5; %SIZE OF THE VECTOR WHICH FQOLLOWS + D:=D&N[CSPF]&1[CRF]&0[BACKUP]; S.PRESENCE:=1; + SP[LOC]:=D; %THIS SETS UP THE FUNCTION DESCRIPTOR. + N:=N+1; SP[NOC]:=SEQ; + COMMENT + SP[N] = SIZE OF THE VECTOR + SP[N+1] = SEQUENTIAL STORAGE UNIT FOR THE TEXT + SP[N+2] = SP LOC OF FIRST NUMERIC POINTER TO TEXT + + SP[N+3] = REL LOC (TO N+5) OF THE FIRST ARG + SP[N+4] = REL LOC TO THE SECOND ARG + SP[N+5] = REL LOC OF RESULT . IF ANY ARE ZERO, THEN + THEY ARE NOT THERE.; + D:=M; M:=N:=N+4)+1; %D IS #ITEMS, M IS LOC 1ST., N=M-1 + FOR I:=1 STEP 1 UNTIL D DO %GET LABELS FORM STORAGE + BEGIN L:=CONTENTS(ORD,I-1,GTA); + IF NOT NUMERIC THEN %RESULT, ARGS, OR LOCALS/LABELS + IF NUMERIC:=GTA[0]=0 THEN %FIRST NUMERIC POINTER + BEGIN L:=N-3; SP[LOC]:=N+I?2-1; + END; + SP[MOC]:=GTA[0]; M:=M+1; + IF NUMERIC THEN SP[MOC]:=GTA[1] ELSE + BEGIN + IF SEQ:=GTA[1] LSS 0 THEN %RESULT OR OARG + BEGIN DL:=N+SEQ+1; SP[LOC]:=I; + SEQ:=0; + END ELSE SEQ:=CDN(SEQ)/10000; + SP[MOC]:=SEQ + END + M:=M+1; + END; + COMMENT WE HAVE TO SET UP THE FUNCTION LABEL TABLE, LET + SOMEONE ELSE FIGURE OUT HOW TO EXECUTE IT; + END; +PROCEDURE PUSHINTOSYMTAB(FPTR);VALUE FPTR;REAL FPTR; + BEGIN COMMENT ...PUT THE LOCAL VARIABLES FORM THIS SUSPENDED + FUNCTION INTO THE SYMBOL TABLE TO BE TREATED AS GLOBAL VARIABLES + WHILE THE FUNCTION IS SUSPENDED. FPTR IS THE ENTRY FROM THE + STATE INDICATOR VECTOR FOR TEH FUNCTION.; + + REAL T,U; + LABEL COPY; + INTEGER K,L,M,N; + M:=FPTR.LOCFIELD+1;%LOCATE FMKS TO FIND LOCAL VALUES IN STACK + N:=FPTR.SPF+2;T:=SP[NOC]-2;%FIND LOCAL NAMES + FOR N:=N+4 STEP 2 UNTIL T DO %ONCE FOR EACH LOCAL 03507100P62 + BEGIN GT1:=SP[NOC] .[6:42];%PICK UP THE LOCAL NAME + L:=SYMBASE;K:=L+SP[LOC];% LOOK IN SYMBOL TABLE + FOR L:=L+1 STEP 2 UNTIL K DO % CHECK EACH NAME + IF GT1=SP[LOC].[6:42] THEN % WE FOUND A MATCH + BEGIN GT1:=M;K:=M:=GETSPACE(1);L:=L+1; + SP[MOC]:=SP[ALOC]; %PUSH CURRENT DESCRIPTOR DOWN + M:=GT1; GO TO COPY; + END; + COMMENT GET HERE IF NO MATCH...MUST MAKE A NEW ENTRY IN + SYMBOL TABLE; + IF K LSS MAXSYMBOL?2 THEN % THERE IS ROOM IN SYMBOL TABLE + BEGIN L:=SYMBASE;SP[LOC]:=SP[LOC]+2; L:=K+1; + SP[LOC]:=GT1&OPERAND[CTYPE]&1[CSUSVAR];L:=L+1;K:=0; +COPY: COMMENT L IS LOC IN SYMBOL TABLE FOR DESC. K WILL BE + CONTENTS OF BACKF. NOW SET UP THE NEW DESCRIPTOR AND + SAVE ITS LOCATION IN THE STACK. M IS THE STACK LOCATION + OF THE LOCAL; + + SP[LOC]:=SP[MOC]&K[CLOCP]&1[CNAMED]; + SP[MOC]:=L&DDNUVW[CDID];M:=M+1; + END ELSE % THERE IS NO ROOM IN THE SYMBEOL TABLE + BEGIN N:=T;ERR:=SPERROR;END; + END;% OF FOR LOOP STEPPING THROGH THE LOCALS + END; % OF PUSHINTOSYMTAB PROCEDURE +PROCEDURE FORGETPROGRAM(U);VALUE U; REAL U; + BEGIN REAL L,M; + COMMENT U IS A PROGRAMMKS...THE SP STORAGE FPOR THIS LINE + SHOULD BE RELEASED; + M:=U.SPF;SCRATCHAIN(SP[MROC].LOCFIELD);%CONSTANT CHAIN + L:=SP[MOC].SPF;FORGETSPACE(M,1);%FORGET PROGRAM DESC. + M:=FL+1;SCRATCHDATA(SP[MOC]);%FORGET BUFFER + FORGETSPACE(L,SP[LOC]+1);%FORGET THE POLISH + END; + EXPOVR:=EXPOVRL; + UINTOVR:=INTOVRL; + INDEX:=INDEXL; + FLAG:=FLAGL; + ZERO:=ZEROL; +CASE MODE OF +BEGIN ;%-------------------------------------------------------- +%---------------- CASE 1....MODE=XEQUTE------------------------ + CASE CURRENTMODE OF + BEGIN%----------------------------------------------------- + %------------- SUB-CASE 0....CURRENTMODE=CALCMODE---------- + IF T:=ANALYZE(TRUE) NEQ 0 THEN % WE HAVE A PROGRAM DESC + BEGIN COMMENT SET-UP THE STACK; + IF STACKBASE=0 THEN BEGIN + STACKBASE:=L:=GETSPACE(STACKSIZE+1); + IF ERR NEQ 0 THEN BEGIN STACKBASE:=0; + ERRORMESS(ERR,0,0); GO TO PROCESSEXIT;END; + SP[LOC]:=2; + L:=L+1; + M:=GETSPACE(STATEVECTORSIZE+1); + SP[LOC]:=M&1[CRF]&DDPNVW[CDID]; + SP[MOC]:=STATEVECTORSIZE; + M:=M+1; SP[MOC]:=0; % THE STATE VECTOR IS INITIALIZED NOW + FUNCLOC:=M; + N:=0; + L:=L+1; COMMENT READY FOR A PROG MKS; + END ELSE % THERE IS ALREADY A STACK...USE IT + BEGIN L:=STACKBASE; + ST:=SP[LOC]+L; + WHILE M:=AREG.DID NEQ IMKS AND M NEQ PROGMKS AND + ERR=0 DO POP;%STRIP BACK TO LASTMARKSTACK + IF M=IMKS THEN BEGIN N:=ST-STACKBASE;PUSH; + END ELSE N:=AREG.BACKF; + SP[LOC]:=ST-STACKBASE;L:=ST; + END; + CURLINE:=0; + M:=GETSPACE(1); SP[MOC]:=T; %STORE PROG DESCRIPTOR + SP[LOC]:=M&PROGMKS[CDID]&N[BACKPT]&1[CI]; + COMMENT JUST BUILT A PROGRAM MARKSTACK; + GO TO EXECUTION; + END; + %------------SUB-CASE 1....CURRENTMODE=XEQMODE--------------- + COMMENT RECOVERY FORM A TIME-OUT; + GO TO EXECUTION; + %----------- SUB-CASE 2....CURRENTMODE=FUNCMODE-------------- + COMMENT SYNTAX CHECK ONLY; + IF ANALYZE(TRUE)=0 THEN; + %------- END OF SUB CASES----------------------------------- + END; +%------------------ CASE 2.....MODE=ALLOC------------------------ 03702300P63 + COMMENT NOTHING TO DO; + ; +%----------------- CASE 3.... MODE=WRITEBACK------------------- + COMMENT HAVE TO WRITE BACK ALL THE NAMED VARIABLES; + IF SYMBASE NEW 0 THEN + WRITEBACK; + +%----------------- CASE 4.... MODE=DEALLOC--------------------- + ; + +%----------------- CASE 5 .... MODE=INTERROGATE---------------- + COMMENT PRINT OUT THE PROGRAM STATUS VECTOR HERE; + IF L:=STACKBASE+1 NEW 1 THEN + BEGIN COMMENT GT1=1 FOR SIV...=0 FOR SI; + U:=GT1; + L:=SP[LOC].SPF+1;M:=SP[LOC].SPF+L; + WHILE M GTR L DO + BEGIN N:=SP[MOC].LOCFIELD;N:=SP[NOC].SPF-1; + % N IS LOCATION OF THE FUNCTION NAME + ACCUM[0]:=SP[NOC]; + FORMRIOW(2,6,ACCUM,1,7); + IF BOOLEAN(SP[MOC].SUSPENDED) THEN FORMWD(0,"3 S ") + ELSE FORMWD(0,"3 "); + IF BOOLEAN(U) THEN % PRINT LOCAL VARIABLE NAMES + BEGIN + N:=SP[MOC].SPF+2;T:=SP[NOC]-2; + FOR N:=N+4 STEP 2 UNTIL T DO + BEGIN ACUM[0]:=SP[NOC]; + FORMROW(0,1,ACCUM,1,7); + END; + END; + TERPRINT; M:=M-1; + END; + END; + END;% OF THE CASE STATMENT +%--------------END OF CASES--------------------------------------- +IF FALSE THEN EXECUTION: + BEGIN COMMENT EXECUTION LOOP; + INTEGER LO+OP; + INTEGER INPUTIMS; + LABEL BREAKKEY; + LABEL SKIPPOP,XEQPS; + BOOLEAN XIT, JUMP; + REAL POLWORD; + DEFINE RESULT=RESULTD#; + LABEL EXECEXIT, EVALQ, EVALQQ; +%%% + COMMENT THERE IS A PROGRAM DESCRIPTOR AT THE TOP OF THE STACK; + ERR:=0; + L:=STACKBASE; ST:=L+SP[LOC]; + L:=L+1;FUNCLOC:=SP[LOC]SPF+1; + T:=AREG; + IF CURRENTMODE=XEQMODE THEN %AREG IS INTERRUPT MARK STACK + BEGIN LASKMKS:=STACKBASE+T.BACKF; + OLDDATA:=T.SPF; INPUTIMS:=T.QUADIN; POP; + COMMENT MAY BE CURRENTLY EXECUTING A FUNCTION; + L:=STACKBASE+1; L:=SP[LOC].SPF+1; + IF (M:=SP[LOC].SPF) NEQ 0 THEN + BEGIN ML=M+L; L:=SP[MOC].LOCFIELD; + CURLINE:=SP[LOC].CIF; + + END; + END + EDLSE LASTMKS:=ST;%AREG IS PROGRAM MARK STACK + CURRENTMODE:=XEQMODE; + L:=LASTMKS; T:=SP[LOC]; % T IS PROGRAM MARK STACK + CINDEX:=T.CIF; % CONTROL INDEX IN POLISH + IF L:=T.SPF =0 THEN %PHONEY PROG DESC FROM FUNCTION CALL + N:=POLTOP:=POLLOC:=0 ELSE + BEGIN + N:=POLLOC:=SP[LOC].SPF; + POLTOP:=SP[NOC] + END; + IF ERR = 0 THEN % POP WORKED + IF INPUTIMS=2 THEN BEGIN JUMP:=TRUE; GO TO EVALQ END ELSE + IF INPUTIMS = 1 THEN BEGIN JUMP:=TRUE; GO TO EVALQQ; END ELSE + DO BEGIN COMMENT EXECUTE UNTIL DONE OR TIME-OUT; + BEGIN COMMENT GET NEXT POLISH TO EXECUTE; + M:=(CINDEX:=CINDEX+1)+POLLOC; + POLWORD:=T:=SP[MOC]; + CASE T.TYPEFIELD OF 03752700P64 + BEGIN %-------TF=0 (REPLACEMENT)-------------- + BEGIN %MAY BE A LOCAL OR A GLOBAL VARIABLE + DEFINE STARTSEGMENT=#; %///////////////////// + PUSH; IF ERR NEQ 0 THEN GO TO SKIPPOP; + N:=T.LOCFIELD; + IF BOOLEAN(T.OPTYPE) THEN %A LOCAL VARIABLE + BEGIN M:=FUNCLOC;%FIND LAST MKS + M:=SP[MOC].SPF+M; + N:=SP[MOC].LOCFIELD+N; END; + U:=SP[NOC]; U.LOCFIELD:=N; AREG:=U; + IF U.DATADES=0 THEN ERR:=NONCEERROR; + COMMENT PROBABLY MIXUP WITH FUNCTION NAMES + AND NAMES OF LOCAL SUSPENDED VARIABLES; + END; + %-------------FUNCTION CALL----------------- +%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& +BEGIN COMMENT SET UP STACK FOR A FUNCTION CALLL; +EAL U,V,NARGS,D; +INTEGER I,FLOC; +LABEL TERMINATE; +COMMENT + MONITOR PRINT(D,L,M,N,FLOC,SP,LASTMKS);%:::::::::::::::::::: + FLOC:=N:=T.LOCFIELD; + IF BOOLEAN(SP[NOC].DATADESC) THEN BEGIN ERR:=NONCEERROR; + FO TO TERMINATE;END;%SUSPENDED VAR CONFUSED WITH FUNCTION + IF NOT BOOLEAN(SP[NOC].PRESENCE) THEN MAKEFUNCTIONPRESENT(N); + D:=SP[NOC]; L:=LASTMKS; %D IS TEH DESC, L IS THE PROG MKS + SP[LUOC].CIF:=CINDEX; %SAVE CURRENT POLISH LOCATION + L:=STACKBASE+1; L:=SP[LOC].SPF+1; + M:=SP[LOC].SPF; + IF N:=M+L NEQ L THEN %THERE IS A NESTED CALL + IF NOT BOOLEAN(SP[NOC].SUSPENDED) THEN + BEGIN N:=SP[NOC].LOCFIELD;SP[NOC].CIF:=CURLINE;END; + + + SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); %INITIALIZE GTA + NARGS:=D.NUMBERARGS; + FOR I:=1 STEP 1 UNTIL NARGS DO + IF BOOLEAN((T:=AREG).DATADESC) THEN + BEGIN + IF BOOLEAN(T.NAMED) THEN %MAKE A COPY + COMMENT YOU COULD MAKE A CALL BY NAME HERE; + BEGIN U:=GETSPACE(V:=(NUMELEMENTS(T)+1,RF)); + SPCOPY(T,SPF,U,V); T.NAMED:=0; T.SPF:=U; + T.BACKP:=0; + END ELSE %NO NEED TO MAKE A COPY + AREG.PRESENCE:=0; + POP; GTA[I-1]:=T; %SAVE THE DESCRIPTOR FOR LATER USE + END ELSE ERR:=SYSTEMERROR; + IF (N:=M+1) GEQ STATEVECTORSIZE THEN ERR:=DEPTHERROR; + IF ERR NEQ 0 THEN GO TO TERMINATE; + SP[LOC].SPF:=N; + PUSH;AREG:=OLDDATA&(LASTMKS-STACKBASE)[BACKPT]&IMKS[CDID]; + OLDDATA:=0; %REINITIALIZE OLDDATA CHAIN FOR THIS FUNCTION + %NOW SET UP THE FUNCTION MARK STACK. + + M:=N+L;PUSH;SP[MOC]:=D.SPF&ST[CLOCF]; + M:=D.SPF; M:=M+2; % M IS LOC OF LOC OF FIRST LINE + AREG:=0&FLOC[CSPF]&((LASTMKS:=ST)-STACKBASE-1)[BACKPT]& + (U:=SP[MOC]-D.SPF)[CCIF]&FMKS[CDID]; % FUNCTION MKS + CURLINE:=U; + + U:=(U-6)/2; % U IS THE NUMBER OF LOCALS, LABELS, AND ARGS + M:=M+5; % M IS ON TEH FIRST DESC IOF THE FIRST LAB, LOC,... + FOR I:=1 STEP 1 UNTIL U DO % GET DESCRIPTORS INTO THE STACK + BEGIN IF SP[MOC] NNEQ 0 THEN %MAKE UP THE DESC + BEGIN L:=GETSPACE(1); SP[LOC]:=SP[MOC]; + T:=L&DDPUSW[CDID]&0[CCIF] + END ELSE + T:=NULLV; + PUSH; M:=M+2; + AREG:=T; %A SINGLE LOCAL + END; + %COPY OVER THE ARGUMENTS + FOR I:=1 STEP 1 UNTIL NARGS DO %COPY OVER + BEGIN M:=D.SPF; %M IS THE LOACTION OF THE LABEL TABLE. + M:=M+2+I; %M IS LOCATION OF REL LOCATION OF VARIABLE + M:=SP[MOC]; + N:=LASTMKS+MM; + SP[NOC]:=GTA[I-1]; + END; + %PUT IN A PHONEY PROG DESC TO START THINGS OFF + PUSH; IF ERR NEQ 0 THEN GO TO TERMINATE; 03753400P65 + ARFG:=0&4094[CCIF]&(LASKMKS-STACKBASE)[BACKU[]; + LASTMKS:=ST; POLTOP:=POLLOC:=0; + TERMINATE: + END; +%&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& + %-------END OF LOAD FUNCTION FOR CALL----- + %-------------TF=2 (CONSTANT)--------------------- + BEGIN PUSH; IF ERR=0 THEN BEGIN + N:=POLWORD.LOCFIELD;AREG:=SP[NOC];END; + END; + %-------------TF=3 (OPERATOR)----------------- + COMMENT SEQUENCE NUMBERS CORRESPOND TO OPERATOR + ASSIGNMENT NUMBER; + BEGIN IF T.OPTYPE=MONADIC THEN + BEGIN PUSH;IF ERR=0 THEN AREG:=0; END; + CASE T.LOCFIELD OF +BEGIN %--------------- OPERATE ON STACK --------------------- + COMMENT EACH EXECUTION PROCEDURE SETS RESULT TO THE + DESCRIPTOR OF THE RESULT OF THE OPERATION. + AREG AND BREG ARE THE LEFT AND RIGHT-HAND OPERANDS AND + ARE ACTUALLY THE TOP TWO DESCRIPTORS ON THE STACK. + IF AREG IS ZERO, THE OPERATOR IS TAKEN TO BE MONADIC.; +; +; +; +; + %---------------------REPLACEMENT OPERATOR--------------- + BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// + IF NOT BOOLEAN(L:=AREG.NAMED) THEN % SHOULD BE LOCAL VARIABLE + AREG.NAMED:=1; % DONT LET IT BE FORGOTTEN. + + IF BOOLAN(T:=AREG).PRESENCE) AND T.SPF NEQ 0 THEN + OLDDATA:=CHAIN(T,OLDATA); + M:=T.LOCFIELD; + + IF(RESUT:=BREG).SPF = 0 THEN U:=T:=0 ELSE + U:=GETSPACE(T:=NUMELEMENTS(RESULT)+RESULT.RF); + SPCOPY(RESULT,SPF,U,T); + RESULT.SPF:=U; RESULT.NAMED:=L; %L IS 0 FOR LOCJLS + GT1:=IF BOOLEAN(U:=SP[MOC]).PRESENCE) THEN U.BACKP ELSE 0; + SP[MOC]:=RESULT>1[CLOCF]; + IF BOOLEAN(L) AND GT1=0 THEN %CHECK FOR GLOBAL + BEGIN M:=M-1;IF(SP[MOC].SUSPENDVAR=0)THEN SP[MOC].CHANGE:=1; + + END; + RESULT.NAMED:=1; %KEEP "PUSH" FROM TOSSING THE DATA + END + %-------TRANSFER OPERATOR--------------------------------- + BEGIN DEFINE STARTSEGMENT=#; %//////////////////////////////// + SCRATCHAIN(OLDDATA);ODDATA:=0; + IF BOOLEAN(D.DPTYPE) THEN ST:=ST-1; %GET RID OF PH7ONEY TOP + L:=FUNCLOC; + IF SP[LOC] NEQ 0 THEN STEPLINE(TRUE) ELSE + ERR:=SYNTAXERROR; + GO TO SKIPPOP; + END; BEGIN %--------------COMPRESSION------------------------------------ - DEFINE STARTSEGMENT=#; %///////////////////////////////////// - L:=ST-2; IF T.OPTYPE=MONADIC THEN COMPRESS(BREG,SP[LOC],AREG) - ELSE COMPRESS(AREG,S[]LOC],BREG); COMMENT A/B HAS BEEN - STACKAED AS B,A,NULL...A/[I] B HAS BEEN STACKED AS B,I,A; - END; - ARITH(3); %OPERATION IS DIVIDE - ; -; -%-------------QUAD INPUT-------------------------------- - EVALQ: BEGIN LABEL EVALQUAD; - IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END; - CURRENTMODE:=INPUTMODE; - FORMWD(3,"3[]: "); INDENT(0); - - IMS(2); % SETUP MARKSTACK FOR QUAD EXIT - IF ERR NEQ 0 THEN GOTO SKIPPOP; - GO TO EXECEXIT; % EXIT TO MONITOR TILL INPUT IS COMPLETE -EVALQUAD: %LO7OK AT BUFFER TO SEE WHAT CAME IN - BEGIN - IF NOT SCAN THEN BEGIN CINDEX:=CINDEX-1;GO TO SKIPPOP;END; - IF NOT SETUPLINE THEN CINDEX:=CINDEX-1;%MAKE THEM REDO IT - GO TO SKIPPOP; - END; - END; - BEGIN % -----EVALUATE SUBSCRIPTS--------------- - DEFINE STARTSEGMENT=#; %///////////////////////////////////// 03811002 P66 - T:=AREG; L:=BREG.SPPF; + DEFINE STARTSEGMENT=#; %///////////////////////////////////// + L:=ST-2; IF T.OPTYPE=MONADIC THEN COMPRESS(BREG,SP[LOC],AREG) + ELSE COMPRESS(AREG,S[]LOC],BREG); COMMENT A/B HAS BEEN + STACKAED AS B,A,NULL...A/[I] B HAS BEEN STACKED AS B,I,A; + END; + ARITH(3); %OPERATION IS DIVIDE + ; +; +%-------------QUAD INPUT-------------------------------- + EVALQ: BEGIN LABEL EVALQUAD; + IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END; + CURRENTMODE:=INPUTMODE; + FORMWD(3,"3[]: "); INDENT(0); + + IMS(2); % SETUP MARKSTACK FOR QUAD EXIT + IF ERR NEQ 0 THEN GOTO SKIPPOP; + GO TO EXECEXIT; % EXIT TO MONITOR TILL INPUT IS COMPLETE +EVALQUAD: %LO7OK AT BUFFER TO SEE WHAT CAME IN + BEGIN + IF NOT SCAN THEN BEGIN CINDEX:=CINDEX-1;GO TO SKIPPOP;END; + IF NOT SETUPLINE THEN CINDEX:=CINDEX-1;%MAKE THEM REDO IT + GO TO SKIPPOP; + END; + END; + BEGIN % -----EVALUATE SUBSCRIPTS--------------- + DEFINE STARTSEGMENT=#; %///////////////////////////////////// 03811002P66 + T:=AREG; L:=BREG.SPPF; IF BOOLEAN(T.SCALAR) THEN BEGIN ERR:=DOMAINERROR; GO TO SKIPPOP;END; - U:=SP[LOC]; % GET # OF SUBSCRIPTS - IF U GTR 32 THEN ERR:=INDEXERROR ELSE - BEGIN - IF U GTR 0 THEN BEGIN - IF T.PRESENCE NQ 1 THEN % GET ARRAY INTO SP - BEGIN N:=T.LOCFIELD; - IF (T:=SP[NOC]).PRESENCE NEQ 1 THEN - BEGIN T:=GETARRAY(T); SP[NOC]:=T END; - T.LOCFIELD:= N; - END; - IF ERR=0 THEN % NOW EVAVLUATE - - RESULT:=SUBSCRIPTS(L:=(IF T.LOCFIELD=0 THEN OUTOF - ELSE INTO),T,U); - IF L=INTO THEN BEGIN - - CINDEX:=CINDEX+1;END; % SKIP OVER REPLACE OP - END ELSE % NO SUBSCRIPTS - BEGIN BREG:=T; ST:=ST-1; GO TO SKIPPOP; - END; % DON{T LET TEH DESC. IN T BE POPPED. - U:=U+2; % # OF THINGS TO POP - FOR N:=1 STEP 1 UNTIKL U DO POP; - IF L=OUTOF THEN PUSH; AREG:=RESULT; - - GO TO SKIPPOP; - END; - END; -; -; -%-------------QQUAD INPUT------------------------------- - EVALQQ: BEGIN LABEL EVALQQUAD; - IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END; - CURRENTMODE:=INPUTMODE; - IMS(1); %SET UP MARKSTACKS FOR QQUAD EXIT - IF ERR NEQ 0 THEN GO TO SKIPPOP; - GO TO EXECEXIT; -EVALQQUAD: % BUFFER CONTAINS THE INPUT STRING - IF (L:=LENGTH(BUFFER,TRUE))NEQ 0 THEN BEGIN %L IS # CHAR INPUT - N:=ENTIER((3L+7) DIV 8); % FIND NUMBER OF WORDS - M:=GETSPACE(N+1); % GET SPACE FOR EACH VECTOR IN SP - TRANSFERSP(INTO,SP,M+1,BUFFER,0,N); - SP[MOC]:=L; % STORE LENGTH OF VECTOR - RESULT:=M&1[CRF]&DDPUVC[CDID]; % SET UP DESCRIPTOR - END ELSE RESULT:=NULLV;% NOTHING WAS INPUT - PUSH; IF ERR=0 THEN AREG:=RESULT; - GO TO SKIPPOP; - END; - RESULTD := SEMICOL; %CONVERSIEON CONCATENATION - COMMAP; %CATENATE - BEGIN%----------INNER PRODUCR (PERIOD)--------------------- - M:=(CINDEX:=CINDEX+2) + POLLOC; T:=SP[MOC];M:=M-1;U:=SP[MOC]; - PERIOD(AREG,BREG,U.LOCFIELD,T.LOCFIELD); - END; - ARITH(4); %* -; -; - ARITH(17); %AND - ARITH(18); %OR - ARITH(9); %NOT - ARITH(11); %LESS:THAN - ARITH(16); %LEQ - ARITH(13); %= - ARITH(14); %GREATER-THAN - ARITH(15); %NEQ - ARITH(8); %MAX/CEIL - ARITH(7); %MIN/FLOOR - ARITH(6); %RESD/AAAABS - IF T.OPTYPE=MONADIC THEN GO TO XEQEPS ELSE MEMBER; %MEMBERSHIP - RHOP; %RHO - IOTAP; %IOTA -; - REDUCESORTSCAN(0,BREG,AREG,4); %REVERSAL; - BEGIN %-----------EXPANSION------------------------- - DEFINE STARTSEGMENT=#; %/////////////////////////////////// - L:=ST-2; IF T.OPTYPE=MONADIC THEN EXPAND(BREG,SP[LOC],AREG) - ELSE EXPAND(REG,SP[LOC],BREG); COMMENTS A EXPN B HAS BEEN - STACKED AS B,A,NULL WHILE A EXPN [I] B IS STACKED AS B,I,A; - END; - RESULTD:=BASEVALUE; %BASE VALUE - ARITH(10); %COMB/FACT 03840000 P67 -; - IF T.EOPTYPE=MONADIC THEN ARITH(5) ELSE - DYADICRNDM; %RNDM - IF T.OPTYPE=MONADIC THEN TRANSPOSE ELSE DYADICTRANS;%GUESS WHAT - RESULTID := REPRESENT; %REPRESENTATION - ARITH(45); %CIRCLE--TRIGONOMETRIC FUNCTIONS -; -; - ARITH(0); %ADD - ARITH(2); %SUBTRACT - ARITH(1); %MULTIPLY - %-------------------DISPLAY--------------------------------------- - - BEFIN DEFINE STRATSEGMENT=#; %///////////////////////////////// - IF BREG.SPF=0 THEN FORMROW(3,0,ACCUM,2,0) ELSE %FOR A NULL - IF BOOLEAN((RESULT:=BREG).DATADESC)THEN %THIS IS A DATA DESC - IF BOOLEAN(RESULT,PRESENCE) AND M:=RESULT.SPF NEQ 0 THEN - IF BOOLEAN(RESULT.SCALAR) THEN - BEGIN NUMBERCON(SP[MOC],ACCUM); - FORMROW(3,0,ACCUM,2,ACOUNT) - END - ELSE %A VECTOR - IF L:=RESULT.RF NEQ 0 THEN % SOMETHING TO PRINT - IF BOOLEAN(RESULT.CHRMEODE) THEN DISPLAYCHARV(RESULT) - ELSE - BEGIN RESULT:=M:=GETSPACE(L+1); - SP[MOC]:=L; RESULT.DF:=1; RESULT.DIS:=DDPUVW; - AREG:=RESULT; - FOR T:=1 STEP 1 UNTIL 1L DO - BEGIN M:=M+1; SP[MEOC]:=1 - END; - DISPLAY(AREG,BREG); - RESULT:=BREG; - END ELSE TERPRQINT - ENS TERPRINT - ELSE ; %PROBABLY AN FUNCTION....DONT DO ANYTHING - IF BREAKFLAG THEN %USER HIT BREAK DURING OUTPUT - GO TO BREAKKEY; - POP; GO TO SKIPPOP; - END; - BEGIN % ---------------REDUCTION--------------------------------------- - M:=(CINDEX:= CINDEX+1) + POLLOC; % FIND OPERATION IN POLISH - IF (T:=SP[MOC]).TYPEFIELD NEQ 3 THEN ERR:=SYSTEMERROR - ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,1); - END; - BEGIN %--------ROTATION---------------------------- - DEFINE STARTSEGMENT=#; %//////////////////////////////////// - L:=ST-2; IF T.OPTYPE=MONADIC THEN - REDUCESORTSCAN(BREG,SP[LOC],AREG,5) ELSE - REDUCESORTSCAN(AREG,SP[LOC],BREG,5); COMMENT A ROT B IS - STACKED AS R,A,NULL WHILE A ROT [I] B IS STACKED AS B,I,A; - END; - ARITH(21); %LOG - REDUCESORTSCAN(0,BREG,AREG,2); % SORTUP - REDUCESORTSCAN(-1,BREG,AREG,2); %SORTDN - BEGIN%--------------SCAN-------LIKE REDUCTION---------------- - DEFINE STARTSEGMENT=#; %////////////////////////////////////// - M:=(CINDEX:=CINDEX+1) + POLLOC; %FIND OPERATOR IN POLISH - IF (T:=SP[MOC]).TYPEFIELD NEW 3 THEN ERR:=SYSTEMERROR - ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,3); - END; - ARITH(19); %NAND - RITH(20) %NOR - IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T,RF) - ELSE ERR:=RANKERROR; % OPERATION IS TAKE - IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T,RF) - ELSE ERR:=RANKERROR; % OPERATION IS DROP - %------------------------XEQ--------------------------------- -XEQEPS: BEGIN DEFINE STARTSEGMENT=#; %//////////////// - IF AREG NEQ 0 THEN ERR:=SYNTAXERROR %MUST BE MONADIC ONLY - EFLSE IF (T:=BREG).RF NEQ 1 OR %MUST BE A VECTOR - NOT BOOLEAN(T.CHRMODE) THEN ERR:=DOMAINERROR %MUST BE CHAR STRING - ELSE IF U:=NUMELEMENTS(T) GTR MAXBUFFSIZE THEN ERR:=LENGTHERROR - ELSE BEGIN - M:=GT1; % # OF CHARCATERS SET BY NUMELEMENTS - INITBUFF(BUFFER.MAXBUFFSIZE);RESCANLINE; - TRANSFERSP(QUTOF,SP,T,SPF+1,BUFFER,0,U); + U:=SP[LOC]; % GET # OF SUBSCRIPTS + IF U GTR 32 THEN ERR:=INDEXERROR ELSE + BEGIN + IF U GTR 0 THEN BEGIN + IF T.PRESENCE NQ 1 THEN % GET ARRAY INTO SP + BEGIN N:=T.LOCFIELD; + IF (T:=SP[NOC]).PRESENCE NEQ 1 THEN + BEGIN T:=GETARRAY(T); SP[NOC]:=T END; + T.LOCFIELD:= N; + END; + IF ERR=0 THEN % NOW EVAVLUATE + + RESULT:=SUBSCRIPTS(L:=(IF T.LOCFIELD=0 THEN OUTOF + ELSE INTO),T,U); + IF L=INTO THEN BEGIN + + CINDEX:=CINDEX+1;END; % SKIP OVER REPLACE OP + END ELSE % NO SUBSCRIPTS + BEGIN BREG:=T; ST:=ST-1; GO TO SKIPPOP; + END; % DON{T LET TEH DESC. IN T BE POPPED. + U:=U+2; % # OF THINGS TO POP + FOR N:=1 STEP 1 UNTIKL U DO POP; + IF L=OUTOF THEN PUSH; AREG:=RESULT; + + GO TO SKIPPOP; + END; + END; +; +; +%-------------QQUAD INPUT------------------------------- + EVALQQ: BEGIN LABEL EVALQQUAD; + IF JUMP THEN BEGIN JUMP:=FALSE; GO TO EVALQQUAD END; + CURRENTMODE:=INPUTMODE; + IMS(1); %SET UP MARKSTACKS FOR QQUAD EXIT + IF ERR NEQ 0 THEN GO TO SKIPPOP; + GO TO EXECEXIT; +EVALQQUAD: % BUFFER CONTAINS THE INPUT STRING + IF (L:=LENGTH(BUFFER,TRUE))NEQ 0 THEN BEGIN %L IS # CHAR INPUT + N:=ENTIER((3L+7) DIV 8); % FIND NUMBER OF WORDS + M:=GETSPACE(N+1); % GET SPACE FOR EACH VECTOR IN SP + TRANSFERSP(INTO,SP,M+1,BUFFER,0,N); + SP[MOC]:=L; % STORE LENGTH OF VECTOR + RESULT:=M&1[CRF]&DDPUVC[CDID]; % SET UP DESCRIPTOR + END ELSE RESULT:=NULLV;% NOTHING WAS INPUT + PUSH; IF ERR=0 THEN AREG:=RESULT; + GO TO SKIPPOP; + END; + RESULTD := SEMICOL; %CONVERSIEON CONCATENATION + COMMAP; %CATENATE + BEGIN%----------INNER PRODUCR (PERIOD)--------------------- + M:=(CINDEX:=CINDEX+2) + POLLOC; T:=SP[MOC];M:=M-1;U:=SP[MOC]; + PERIOD(AREG,BREG,U.LOCFIELD,T.LOCFIELD); + END; + ARITH(4); %* +; +; + ARITH(17); %AND + ARITH(18); %OR + ARITH(9); %NOT + ARITH(11); %LESS:THAN + ARITH(16); %LEQ + ARITH(13); %= + ARITH(14); %GREATER-THAN + ARITH(15); %NEQ + ARITH(8); %MAX/CEIL + ARITH(7); %MIN/FLOOR + ARITH(6); %RESD/AAAABS + IF T.OPTYPE=MONADIC THEN GO TO XEQEPS ELSE MEMBER; %MEMBERSHIP + RHOP; %RHO + IOTAP; %IOTA +; + REDUCESORTSCAN(0,BREG,AREG,4); %REVERSAL; + BEGIN %-----------EXPANSION------------------------- + DEFINE STARTSEGMENT=#; %/////////////////////////////////// + L:=ST-2; IF T.OPTYPE=MONADIC THEN EXPAND(BREG,SP[LOC],AREG) + ELSE EXPAND(REG,SP[LOC],BREG); COMMENTS A EXPN B HAS BEEN + STACKED AS B,A,NULL WHILE A EXPN [I] B IS STACKED AS B,I,A; + END; + RESULTD:=BASEVALUE; %BASE VALUE + ARITH(10); %COMB/FACT 03840000P67 +; + IF T.EOPTYPE=MONADIC THEN ARITH(5) ELSE + DYADICRNDM; %RNDM + IF T.OPTYPE=MONADIC THEN TRANSPOSE ELSE DYADICTRANS;%GUESS WHAT + RESULTID := REPRESENT; %REPRESENTATION + ARITH(45); %CIRCLE--TRIGONOMETRIC FUNCTIONS +; +; + ARITH(0); %ADD + ARITH(2); %SUBTRACT + ARITH(1); %MULTIPLY + %-------------------DISPLAY--------------------------------------- + + BEFIN DEFINE STRATSEGMENT=#; %///////////////////////////////// + IF BREG.SPF=0 THEN FORMROW(3,0,ACCUM,2,0) ELSE %FOR A NULL + IF BOOLEAN((RESULT:=BREG).DATADESC)THEN %THIS IS A DATA DESC + IF BOOLEAN(RESULT,PRESENCE) AND M:=RESULT.SPF NEQ 0 THEN + IF BOOLEAN(RESULT.SCALAR) THEN + BEGIN NUMBERCON(SP[MOC],ACCUM); + FORMROW(3,0,ACCUM,2,ACOUNT) + END + ELSE %A VECTOR + IF L:=RESULT.RF NEQ 0 THEN % SOMETHING TO PRINT + IF BOOLEAN(RESULT.CHRMEODE) THEN DISPLAYCHARV(RESULT) + ELSE + BEGIN RESULT:=M:=GETSPACE(L+1); + SP[MOC]:=L; RESULT.DF:=1; RESULT.DIS:=DDPUVW; + AREG:=RESULT; + FOR T:=1 STEP 1 UNTIL 1L DO + BEGIN M:=M+1; SP[MEOC]:=1 + END; + DISPLAY(AREG,BREG); + RESULT:=BREG; + END ELSE TERPRQINT + ENS TERPRINT + ELSE ; %PROBABLY AN FUNCTION....DONT DO ANYTHING + IF BREAKFLAG THEN %USER HIT BREAK DURING OUTPUT + GO TO BREAKKEY; + POP; GO TO SKIPPOP; + END; + BEGIN % ---------------REDUCTION------------------------------------ + M:=(CINDEX:= CINDEX+1) + POLLOC; % FIND OPERATION IN POLISH + IF (T:=SP[MOC]).TYPEFIELD NEQ 3 THEN ERR:=SYSTEMERROR + ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,1); + END; + BEGIN %--------ROTATION---------------------------- + DEFINE STARTSEGMENT=#; %//////////////////////////////////// + L:=ST-2; IF T.OPTYPE=MONADIC THEN + REDUCESORTSCAN(BREG,SP[LOC],AREG,5) ELSE + REDUCESORTSCAN(AREG,SP[LOC],BREG,5); COMMENT A ROT B IS + STACKED AS R,A,NULL WHILE A ROT [I] B IS STACKED AS B,I,A; + END; + ARITH(21); %LOG + REDUCESORTSCAN(0,BREG,AREG,2); % SORTUP + REDUCESORTSCAN(-1,BREG,AREG,2); %SORTDN + BEGIN%--------------SCAN-------LIKE REDUCTION---------------- + DEFINE STARTSEGMENT=#; %////////////////////////////////////// + M:=(CINDEX:=CINDEX+1) + POLLOC; %FIND OPERATOR IN POLISH + IF (T:=SP[MOC]).TYPEFIELD NEW 3 THEN ERR:=SYSTEMERROR + ELSE REDUCESORTSCAN(T.LOCFIELD,BREG,AREG,3); + END; + ARITH(19); %NAND + RITH(20) %NOR + IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T,RF) + ELSE ERR:=RANKERROR; % OPERATION IS TAKE + IF (T:=BREG).RF NEQ 0 THEN RESULT:=SUBSCRIPTS(3,T,T,RF) + ELSE ERR:=RANKERROR; % OPERATION IS DROP + %------------------------XEQ--------------------------------- +XEQEPS: BEGIN DEFINE STARTSEGMENT=#; %//////////////// + IF AREG NEQ 0 THEN ERR:=SYNTAXERROR %MUST BE MONADIC ONLY + EFLSE IF (T:=BREG).RF NEQ 1 OR %MUST BE A VECTOR + NOT BOOLEAN(T.CHRMODE) THEN ERR:=DOMAINERROR %MUST BE CHAR STRING + ELSE IF U:=NUMELEMENTS(T) GTR MAXBUFFSIZE THEN ERR:=LENGTHERROR + ELSE BEGIN + M:=GT1; % # OF CHARACTERS SET BY NUMELEMENTS + INITBUFF(BUFFER.MAXBUFFSIZE);RESCANLINE; + TRANSFERSP(QUTOF,SP,T,SPF+1,BUFFER,0,U); IF(U:=U|8-M) GTR 0 THEN SETFIELD(BUFFER,M,U," "); - IF T.SPF=0 OR NOT SCAN THEN RESULT:=0&1[CRF]&DDPUVW[CDID]% NULL - ELSE BEGIN POP;IF SETUPLINE THEN; GO TO SKIPPOP;END - END; END; - END; %--------------EN OF OPERATION ON STACK--------------------- - POP;POP;PUSH;IF ERR=0 THEN AREG:=RESULT; 03869970 P68 -SKIPPOP: END OF TYPEFIELD EQUALS OPERATOR; - %-------TF=4 (LOCAL VARIABLE)------------ - BEGIN COMMENT MOVE DESCRIPTOR UP TO TOP; - DEFINE STARTSEGMENT=#; %///////////////// - N:=T.LOCFIELD;M:=FUNCLOC;M:=SP[MOC]+M; - - N:=SP[MOC].LOCFIELD+N; - T:=SP[NOC]; T.NAMED:=1; %KEEP FROM THROWING AWAY - PUSH; AREG:=T; - END; - %-------TF=5 (OPERAND)----------------------- - BEGIN PUSH; IF ERR=0 THEN BEGIN - N:=POLWORD.LOCFIELD; U:=SP[NOC]; - IF U.DATADESC=0 THEN ERR:=NONCEERROR ELSE - IF U.PRESENCE NEQ 1 THEN BEGIN - U:=GETARRAY(U); SP[NOC]:=U END; - U.LOCFIELD:=0; - AREG:=U; END; - END; - END; % OF CASE STATEMENT TESTING TYPEFILED - END % OF TEST FOR CINDEX LEQ POLTOP - ELSE % WE ARE AT THE END OF THE POLISH - BEGIN COMMENT LASKMKS CONTAINS THE LOCATION - OF THE LAST WARK STACK. GET MARK STACK AND CONTINUE; - - SCRATCHCHAIN(OLDDDATA); OLDDATE:=0; - L:=LASTMKS;M:=(U:=SP[LOC]).BACKF+STACKBASE;T:=SP[MOC]; - IF T.DIF=IMKS AND T.QUADIN=3 THEN %SINGLE LINE DONE - IF (RESULT:=AREG)=T THEN ERR:=SYNTAXERROR%NIO RESULT - ELSE BEGIN RESULT.NAMED:=0;%MAKE NEW COPY - IF BOOLEAN(RESULT.SCALAR) THEN - BEGIN M:=GETSPACE(2);L:=RESULT.SPF; - RESULT.SPF:=M+1;SP[MOC]:=RESULT; - M:=M+1;SP[MOC]:=SP[LOC]; - END ELSE % MAKE COPY OF A VECTOR - BEGIN M:=GETSPACE(1+(N:=RESULT.RF+NUMELEMENTS( - RESULT))); - L:=RESULT.SPF;RESULT.SPF:=M+1; - SP[MOC]:=RESULT; SPCOPY(L,M+1,N); END; - - - FORGETPROGRAM(U); - - DO POP UNTIL ST LSS 2LASTMKS;%CUT BACK STACK TO IMS - OLDDATA:=T.SPF;L:=LASTMKS:=T.BACKF+STACKBASE; - AREG:=RESULT; % STORE EXECUTION RESULT OVER IMS - CINDEX:=SP[LOC].CIF; M:= SP[LOC].SPF; - POLLOC:=M:=SP[MOC].SPF; POLTOP:=SP[MOC]; - END ELSE - BEGIN L:=FUNCLOC;M:=SP[LOC.SPF+L; - IF M NEQ L AND NOT BOOLEAN(SP[MOC].SUSPENDED)THEN - BEGIN - IF O=(LOOP:=LOOP+1) MOD 5) THEN - WRITE(TWXOUT,1,JIGG1LE[*])[BREAKKEY:BREAKKEY]; - %THAT WAS TO CHECK FOR A BREAK TO INTERRUT A PROG - STEPLINE(FALSE); - END; - ELSE BEGIN XIT:=TRUE;CURRENTMODE:=CALCMODE; - WHILE POPROGRAM(OLDDATA,LASTMKS) DO; - END; - END; - END; %COMPLETION OF ONE POLISH EVALUATION (1 CELL) - IF ERR NEQ 0 THEN % PUT OUT ERROR MESSAGE - BEGIN - DEFINE STARTSEGMENT=#; %///////////////////////////// - COMMENT - MONITOR PRINT(ST,L,M,SP,GTA,T);%:::::::::::::::::::::: - XIT:=TRUE;CURRENTMODE:=ERRORMODE; - - L:=POLLOC+1; - TRANSFERSP(OUTOF,SP,(L:=SP[LOC],SPF)+1,BUFFER, - 0,MIN(MAXBUFFSIZE,ENTIER((SP[LOC]+7)DIV 8))); - L:=FUNCLWOC;M:=SP[LOC].SPF+1; - GT1:=1;N:=SP[MOC].LOCFIELD;%LOCATION OF FMKS - WHILE LASTMKS GTR N AND BOOLEAN (GT1) DO GT1:=IF - POPPROGRAM(OLDDATA.LASTMKS)THEN 1 ELSE 0; + IF T.SPF=0 OR NOT SCAN THEN RESULT:=0&1[CRF]&DDPUVW[CDID]% NULL + ELSE BEGIN POP;IF SETUPLINE THEN; GO TO SKIPPOP;END + END; END; + END; %--------------EN OF OPERATION ON STACK--------------------- + POP;POP;PUSH;IF ERR=0 THEN AREG:=RESULT; 03869970P68 +SKIPPOP: END OF TYPEFIELD EQUALS OPERATOR; + %-------TF=4 (LOCAL VARIABLE)------------ + BEGIN COMMENT MOVE DESCRIPTOR UP TO TOP; + DEFINE STARTSEGMENT=#; %///////////////// + N:=T.LOCFIELD;M:=FUNCLOC;M:=SP[MOC]+M; + + N:=SP[MOC].LOCFIELD+N; + T:=SP[NOC]; T.NAMED:=1; %KEEP FROM THROWING AWAY + PUSH; AREG:=T; + END; + %-------TF=5 (OPERAND)----------------------- + BEGIN PUSH; IF ERR=0 THEN BEGIN + N:=POLWORD.LOCFIELD; U:=SP[NOC]; + IF U.DATADESC=0 THEN ERR:=NONCEERROR ELSE + IF U.PRESENCE NEQ 1 THEN BEGIN + U:=GETARRAY(U); SP[NOC]:=U END; + U.LOCFIELD:=0; + AREG:=U; END; + END; + END; % OF CASE STATEMENT TESTING TYPEFILED + END % OF TEST FOR CINDEX LEQ POLTOP + ELSE % WE ARE AT THE END OF THE POLISH + BEGIN COMMENT LASKMKS CONTAINS THE LOCATION + OF THE LAST WARK STACK. GET MARK STACK AND CONTINUE; + + SCRATCHCHAIN(OLDDDATA); OLDDATE:=0; + L:=LASTMKS;M:=(U:=SP[LOC]).BACKF+STACKBASE;T:=SP[MOC]; + IF T.DIF=IMKS AND T.QUADIN=3 THEN %SINGLE LINE DONE + IF (RESULT:=AREG)=T THEN ERR:=SYNTAXERROR%NIO RESULT + ELSE BEGIN RESULT.NAMED:=0;%MAKE NEW COPY + IF BOOLEAN(RESULT.SCALAR) THEN + BEGIN M:=GETSPACE(2);L:=RESULT.SPF; + RESULT.SPF:=M+1;SP[MOC]:=RESULT; + M:=M+1;SP[MOC]:=SP[LOC]; + END ELSE % MAKE COPY OF A VECTOR + BEGIN M:=GETSPACE(1+(N:=RESULT.RF+NUMELEMENTS( + RESULT))); + L:=RESULT.SPF;RESULT.SPF:=M+1; + SP[MOC]:=RESULT; SPCOPY(L,M+1,N); END; + + + FORGETPROGRAM(U); + + DO POP UNTIL ST LSS 2LASTMKS;%CUT BACK STACK TO IMS + OLDDATA:=T.SPF;L:=LASTMKS:=T.BACKF+STACKBASE; + AREG:=RESULT; % STORE EXECUTION RESULT OVER IMS + CINDEX:=SP[LOC].CIF; M:= SP[LOC].SPF; + POLLOC:=M:=SP[MOC].SPF; POLTOP:=SP[MOC]; + END ELSE + BEGIN L:=FUNCLOC;M:=SP[LOC.SPF+L; + IF M NEQ L AND NOT BOOLEAN(SP[MOC].SUSPENDED)THEN + BEGIN + IF O=(LOOP:=LOOP+1) MOD 5) THEN + WRITE(TWXOUT,1,JIGG1LE[*])[BREAKKEY:BREAKKEY]; + %THAT WAS TO CHECK FOR A BREAK TO INTERRUT A PROG + STEPLINE(FALSE); + END; + ELSE BEGIN XIT:=TRUE;CURRENTMODE:=CALCMODE; + WHILE POPROGRAM(OLDDATA,LASTMKS) DO; + END; + END; + END; %COMPLETION OF ONE POLISH EVALUATION (1 CELL) + IF ERR NEQ 0 THEN % PUT OUT ERROR MESSAGE + BEGIN + DEFINE STARTSEGMENT=#; %///////////////////////////// + COMMENT + MONITOR PRINT(ST,L,M,SP,GTA,T);%:::::::::::::::::::::: + XIT:=TRUE;CURRENTMODE:=ERRORMODE; + + L:=POLLOC+1; + TRANSFERSP(OUTOF,SP,(L:=SP[LOC],SPF)+1,BUFFER, + 0,MIN(MAXBUFFSIZE,ENTIER((SP[LOC]+7)DIV 8))); + L:=FUNCLWOC;M:=SP[LOC].SPF+1; + GT1:=1;N:=SP[MOC].LOCFIELD;%LOCATION OF FMKS + WHILE LASTMKS GTR N AND BOOLEAN (GT1) DO GT1:=IF + POPPROGRAM(OLDDATA.LASTMKS)THEN 1 ELSE 0; IF M NEQ L AND NOT BOOLEAN(SP[MOC]).SUSPENDED)THEN%GET LINE# - BEGIN SP[LOC].RF:=SP[LOC].RF+1;%UP SUSPENDED COUNT - L:=SP[NOC].SPF-1;%LOCATION WOF FUNCTION NAME - SETFIELD(GTA,0,1,0); - GTA(0):=SP(LOC); - FORMROW(3,0,GTA,1,7); - L:=SP[MOC].SPF; %BASE OF LABEL TABLE 03918475 P69 - L:=L+CURLINE; - T:=SP[LOC]; - - %ALSO PUT THE FUNCTION INTO SUSPENSION - IMS(4);SP[MOC].SUSPENDED:=1;SUSPENSION:=1; - PUSHINTOSYMTAB(SP[MOC]); - END ELSE T:=0; - ERRORMESS(ERR,POLWORD,SPF,T); - END; - END UNTIL XIT; -BREAKKEY: BEGIN BREAKFLAG:=FALSE; - XIT:=TRUE;CURRENTMODE:=CASLCMODE; - L:=FUNCJLOC;M:=SP[LOC].SPF+L; - IF M NEW L AND NOT BOOLEAN(SP[MOC].SUSPENDED) THEN - BEGIN SP[MOC].SUSPENDED:=1;SUSPENSION:=1; - PUSHINTOSYMTAB(SP[MOC]);SP[KLOC].RG:=SP[LOC].RF+1; - M:=SP[MOC].LOCFIELD;%LOCATION OF FMKS IN STACK - WHILE LASTMKS GTR M DO IF POPPROGRAM(OLDDATA,LASTMKS) - THEN; LASTMKS:=M;IMS(4); - END - IF FALSE THEN - END; -EXECEXIT: - IF STACKBASE NEQ 0 THEN BEGIN - L:=STACKBASE; SP[LOC]:=ST-L; %UPDATE SIZE OF STACK - - END; - END OF EXECUTION LOOP; -PROCESSEXIT: - IF BOOLEAN(POLBUG) THEN % DUMP SP - IF MODE=EQUTE OR MODE=3 OR MODE=6 THEN GO TO DEBUGSP; - IF FALSE THEN - BEGIN CASE O OF BEGIN - EXPOVRL: SPOUT(3951200); - INTOVRL: SPOUT(3591300); - INDEXL: SPOUT(3951500); - ZEROL: SPOUT(3951600); - END; - REALLYERROR:=1; - DEBUGSP: - WRITE(PRINT,MIN(15,PSRSIZE),PSR); - BEGIN - STREAM PROCEDURE FORM(A,B,N); VALUE N; - BEGIN - DI:=B; 15(DS:=BLIT(" "); - SI:=LOC N; DI:=B; DS:=8DEC; DI:=DI+3; - SI:=A; 10(DS:=8CHR; DI:=DI+1); - END; + BEGIN SP[LOC].RF:=SP[LOC].RF+1;%UP SUSPENDED COUNT + L:=SP[NOC].SPF-1;%LOCATION WOF FUNCTION NAME + SETFIELD(GTA,0,1,0); + GTA(0):=SP(LOC); + FORMROW(3,0,GTA,1,7); + L:=SP[MOC].SPF; %BASE OF LABEL TABLE 03918475P69 + L:=L+CURLINE; + T:=SP[LOC]; + + %ALSO PUT THE FUNCTION INTO SUSPENSION + IMS(4);SP[MOC].SUSPENDED:=1;SUSPENSION:=1; + PUSHINTOSYMTAB(SP[MOC]); + END ELSE T:=0; + ERRORMESS(ERR,POLWORD,SPF,T); + END; + END UNTIL XIT; +BREAKKEY: BEGIN BREAKFLAG:=FALSE; + XIT:=TRUE;CURRENTMODE:=CASLCMODE; + L:=FUNCJLOC;M:=SP[LOC].SPF+L; + IF M NEW L AND NOT BOOLEAN(SP[MOC].SUSPENDED) THEN + BEGIN SP[MOC].SUSPENDED:=1;SUSPENSION:=1; + PUSHINTOSYMTAB(SP[MOC]);SP[KLOC].RG:=SP[LOC].RF+1; + M:=SP[MOC].LOCFIELD;%LOCATION OF FMKS IN STACK + WHILE LASTMKS GTR M DO IF POPPROGRAM(OLDDATA,LASTMKS) + THEN; LASTMKS:=M;IMS(4); + END + IF FALSE THEN + END; +EXECEXIT: + IF STACKBASE NEQ 0 THEN BEGIN + L:=STACKBASE; SP[LOC]:=ST-L; %UPDATE SIZE OF STACK + + END; + END OF EXECUTION LOOP; +PROCESSEXIT: + IF BOOLEAN(POLBUG) THEN % DUMP SP + IF MODE=EQUTE OR MODE=3 OR MODE=6 THEN GO TO DEBUGSP; + IF FALSE THEN + BEGIN CASE O OF BEGIN + EXPOVRL: SPOUT(3951200); + INTOVRL: SPOUT(3591300); + INDEXL: SPOUT(3951500); + ZEROL: SPOUT(3951600); + END; + REALLYERROR:=1; + DEBUGSP: + WRITE(PRINT,MIN(15,PSRSIZE),PSR); + BEGIN + STREAM PROCEDURE FORM(A,B,N); VALUE N; + BEGIN + DI:=B; 15(DS:=BLIT(" "); + SI:=LOC N; DI:=B; DS:=8DEC; DI:=DI+3; + SI:=A; 10(DS:=8CHR; DI:=DI+1); + END; M:=MIN(NROWS+1|SPRSIZE-1,MAXMEMACCESSES); - FOR N:=0 STEP 10 UNTIL M DO - BEGIN TRANSFERSP(OUTOF,SP,N,ACCUM,0,MIN(M*N,10)); - FORM(ACCUM,BUFFER,N); - WRITE(PRINT,15,BUFFER[*]); - END; - END; - IF POLBUG=0 OR BOOLEAN(REALLYERROR) THEN - BEGIN - ERRORMESS(IF ERR NEQ SPERROR THEN SYSTEMERROR ELSE ERR,0,0); - SUSPENSION:=0; - CURRENTMODE:=CALCMODE; - REALLYERROR:=ERR:=0; - END; - END; - END OF PROCESS PROCEDURE; -PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R; - INTEGER N; REAL ADDR; - BEGIN - INTEGER STREAM PROCEDURE FORM(A,B); VALUE A; - BEGIN LOCAL T,U; - LABEL L,M; - SI:=A; - L: IF SC=" " THEN - BEGIN SI:=SI+1; GO TO L; - END; - DI:=LOC I; DS:=2RESET; DS:=2SET; - DI:=8; MESSIZEU:=DI; DI:=LOC T; IF SC=DC THEN JUMP OUT TO M; - SI:=SI-1; DI:=U; DS:=CHR; TALLY:=TALLY+1); M: - FORM:=TALLY; - END; - ARRAY ERMES[0:13],B[0:MESSIZE/8]; - FILL ERMES[*] WITH - "1 ", 05001510 P70 - "5DEPTH ", - "6DOMAIN ", - "7EDITING", - "5INDEX ", - "5LABEL ", - "6LENGTH ", - "5NONCE ", - "4RANK ", - "6SYNTAX ", - "6SYSTEM ", - "5VALUE ", - "7SP FULL", - "7FLYKITE"; - IF R NEQ 0 THEN - BEGIN INDENT(R);CHRCOUNT:=CHRCOUNT-1; - END; + FOR N:=0 STEP 10 UNTIL M DO + BEGIN TRANSFERSP(OUTOF,SP,N,ACCUM,0,MIN(M*N,10)); + FORM(ACCUM,BUFFER,N); + WRITE(PRINT,15,BUFFER[*]); + END; + END; + IF POLBUG=0 OR BOOLEAN(REALLYERROR) THEN + BEGIN + ERRORMESS(IF ERR NEQ SPERROR THEN SYSTEMERROR ELSE ERR,0,0); + SUSPENSION:=0; + CURRENTMODE:=CALCMODE; + REALLYERROR:=ERR:=0; + END; + END; + END OF PROCESS PROCEDURE; +PROCEDURE ERRORMESS(N,ADDR,R); VALUE N,ADDR,R; REAL R; + INTEGER N; REAL ADDR; + BEGIN + INTEGER STREAM PROCEDURE FORM(A,B); VALUE A; + BEGIN LOCAL T,U; + LABEL L,M; + SI:=A; + L: IF SC=" " THEN + BEGIN SI:=SI+1; GO TO L; + END; + DI:=LOC I; DS:=2RESET; DS:=2SET; + DI:=8; MESSIZEU:=DI; DI:=LOC T; IF SC=DC THEN JUMP OUT TO M; + SI:=SI-1; DI:=U; DS:=CHR; TALLY:=TALLY+1); M: + FORM:=TALLY; + END; + ARRAY ERMES[0:13],B[0:MESSIZE/8]; + FILL ERMES[*] WITH + "1 ", 05001510P70 + "5DEPTH ", + "6DOMAIN ", + "7EDITING", + "5INDEX ", + "5LABEL ", + "6LENGTH ", + "5NONCE ", + "4RANK ", + "6SYNTAX ", + "6SYSTEM ", + "5VALUE ", + "7SP FULL", + "7FLYKITE"; + IF R NEQ 0 THEN + BEGIN INDENT(R);CHRCOUNT:=CHRCOUNT-1; + END; FORMROW((IF R=0 THEN 2 ELSE 0),0,ERMES,N|8+1, - ERMES[N].[1:5]); - FORMWORD(0,"6 ERROR"); - IF ADDR.[33:15] GEQ 512 THEN - BEGIN - FORMD(D,"4 AT "); - FORMROW(1,1,B,0,FORM(ADDR,B)) - END; - FORMWD(3,"1 "); - END; -PROCEDURE LOADWORKSPACE(JOBNUM,NAME,IDENT); VALUE JOBNUM,NAME; - REAL JOBNUM,NAME; ARRAY IDENT[0]; FORWARD; -PROCEDURE LOGINAPLUSER; - BEGIN - COMMENT LOG:IN THE CURRENT USER; - COMMENT INPUT LINE IS THE BUFFER; - LABEL EXEC, GUESS; - DEFINE T=GT1#, J=GT2#,I=GT3#; - PROCEDURE INITIALIZEPSR; - BEGIN FOR I:=0 STEP 1 UNTIL PSRSIZE-1 DO - PSRM[I] := 0; - SEED:=STREAMBASE; ORIGIN:=1; - FUZZ:-1@-11; - LINESIZE:=72; DIGITS:=9; - END; - LADDRESS := ADDRESS := ABSOLUTEADDRESS; - WORKSPACE:=WORKSPACEUNIT; - ITEMCOUNT := EOB := 0; - IF NEXTUNIT=WORKSPACEUNIT THEN % ESTABLISH A WORKSPACE - BEGIN - WORKSPACE:=NEXTUNIT; - SEQUENTIAL(WORKSPACE); - INITIALIZEPSR; + ERMES[N].[1:5]); + FORMWORD(0,"6 ERROR"); + IF ADDR.[33:15] GEQ 512 THEN + BEGIN + FORMD(D,"4 AT "); + FORMROW(1,1,B,0,FORM(ADDR,B)) + END; + FORMWD(3,"1 "); + END; +PROCEDURE LOADWORKSPACE(JOBNUM,NAME,IDENT); VALUE JOBNUM,NAME; + REAL JOBNUM,NAME; ARRAY IDENT[0]; FORWARD; +PROCEDURE LOGINAPLUSER; + BEGIN + COMMENT LOG:IN THE CURRENT USER; + COMMENT INPUT LINE IS THE BUFFER; + LABEL EXEC, GUESS; + DEFINE T=GT1#, J=GT2#,I=GT3#; + PROCEDURE INITIALIZEPSR; + BEGIN FOR I:=0 STEP 1 UNTIL PSRSIZE-1 DO + PSRM[I] := 0; + SEED:=STREAMBASE; ORIGIN:=1; + FUZZ:-1@-11; + LINESIZE:=72; DIGITS:=9; + END; + LADDRESS := ADDRESS := ABSOLUTEADDRESS; + WORKSPACE:=WORKSPACEUNIT; + ITEMCOUNT := EOB := 0; + IF NEXTUNIT=WORKSPACEUNIT THEN % ESTABLISH A WORKSPACE + BEGIN + WORKSPACE:=NEXTUNIT; + SEQUENTIAL(WORKSPACE); + INITIALIZEPSR; I=STORESEQ(WORKSPACE,PSR,PSRSIZE|8); - INITBUFF(OLDBUFFER,BUFFSIZE); - - END ELSE % WORKSPACE ASSIGNED - I:=CONTENTS(WORKSPACE,0,PSR); - FILL ACCUM[*] WITH "LOGGED 1", "N "; - FORMROW(0,1,ACCUM,0,RI); - SYMBASE:=STAKCBASE:=0; - CSTATION.APLOGGED:=1; - CASE CURRENTMODE OF - BEGIN %--------CALCMODE-------------- - ;COMMENT NOTHING TO DO ANYMORE; - %--------------XEQUTEMODE---------------------- -EXEC: - BEGIN F9ILL ACCUM[*] WITH "LAST RUN"," STOPPED"; - FORMROW(3,0,ACCUM,0,16); - CURRENTMODE:=CALCMODE; - END; - %-------------FUNCMODE----------------- - BEGIN FILL ACCUM[*]WITH "CONTINUE"," DEFINIT", - "ION OF "; - FORMROW(2,0,ACCUM,0,23); FORMROW(1,0,PSR, + INITBUFF(OLDBUFFER,BUFFSIZE); + + END ELSE % WORKSPACE ASSIGNED + I:=CONTENTS(WORKSPACE,0,PSR); + FILL ACCUM[*] WITH "LOGGED 1", "N "; + FORMROW(0,1,ACCUM,0,RI); + SYMBASE:=STAKCBASE:=0; + CSTATION.APLOGGED:=1; + CASE CURRENTMODE OF + BEGIN %--------CALCMODE-------------- + ;COMMENT NOTHING TO DO ANYMORE; + %--------------XEQUTEMODE---------------------- +EXEC: + BEGIN F9ILL ACCUM[*] WITH "LAST RUN"," STOPPED"; + FORMROW(3,0,ACCUM,0,16); + CURRENTMODE:=CALCMODE; + END; + %-------------FUNCMODE----------------- + BEGIN FILL ACCUM[*]WITH "CONTINUE"," DEFINIT", + "ION OF "; + FORMROW(2,0,ACCUM,0,23); FORMROW(1,0,PSR, FSTART|8,7); - CURLINE:=GT3:=TOPLINE(GT1:=FUNCPOINTER); - CHECKSEQ(CURLINE,GT3,INCREMENT); %GET INCREMENT - CURLINE:=CURLINE+INCRMENT; INDENT(-CURLINE); - FUNCSIZE:=SIZE(GT1); - END; - %------------INPUTMODE-------------ERRORMODE---- - GOTOEXEC; GO TO EXEC; - END; - GUESS: %SHOULD BE BETTER PLACE BUT HERE IS WHERE OTHERS COME OUT 07044001 P71 - STOREPSR; - IF CURRENTMODE NEQ FUNCMODE THEN - INDENT(0); TERPRINT; - VARSIE:=IF VARPIABLES=0 THEN 0 ELSE SIZE(VARIABLES); - END; -PROCEDURE APLMONITOR; - BEGIN - REAL T; - INTEGER I; - BOOLEAN WORK; - LABEL AROUND, NEWUSER; - LABEL CALULATE,EXECITEIT,FUNCTIONSTART,BACKAGAIN; - LABEL CALCULATEDIT; - I := CUSER := 1; - T := STATION; - BEGIN FILL ACCUM[*] WITH "APL/B550","0 UW COM" - ,"PUTER SC","IENCE #",VERSIONDATE; - WORK:=TRUE; - FORMROW(3,MARGINSIZE,ACCUM,0,40); - INDENT(0); TERPRINT; CSTATION.APLHEADING:=1 - ; LOGINAPLUSER; - END; - AROUND: - BEGIN - IF MAINTENANCE THEN; - CASE CURRENTMODE OF - BEGIN %-------CALCMODE-------------------------------- - COMMENT HE MUST BE READ READY FOR THE CALCMODE STUFF; - - GO CALCULATE; - %--------XEQUTE MODE-------------------------------- - GO TO EXECUTEIT; - %----------FUNCMODE----------------------------------- - GO TO FUNCTIONSTART; - %-----------INPUTMODE--------------------------------- - COMMENT REQUIRES INPUT; - - BEGIN COMMENT GET HT ELINE AND GO BACK; - STARTSCAN; - CURRENTMODE:=XEQM+ODE; - GO TO EXECUTEIT; - END; - %----------ERRORMODE--------------------------------- - GO TO BACKAGAIN; - - END; %OF CASES - END; - COMMENT GET HERE IF NOTHING TO DO; - - GO TO AROUND; - CALCULATE: - STARTSCAN; -CALCULATEDIT: - ERR:=0; %AND DON"T RESET IT IN SCAN OR IN ANALYZE - IF SCAN THEN - IF RGTPAREN THEN MESSAGEHANDLER EALSE - IF DELV THEN FUNCTIONHANDLER ELSE - BEGIN COMMENT PROCESS CAJLCULATOR MODE REQUEST; - MOVE(OLDBUFFER,BUFFERSIZE,BUFFER); - IF NOT BOOLEAN(SUSPENSION) THEN BEGIN %INITIALIZE USER -%%% -%%% - SYMBASE:=STACKBASE:=0; - END; - PROCESS(XEQUTE); - IF CURRENTMODE=CALCMODE THEN -BACKAGAIN: BEGIN INDENT(0); TERPRINT; - IF NOT BOOLEAN(SUSPENSION) THEN - BEGIN IF CURRENTMODE NEQ ERRORMODE THEN - PROCESS(WRITEBACK); - SP[0,0]:=0;NROWS:=-1; -%%% - END; - CURRENTMODE:=CALCMODE; - END; - IF EDITOG=1 THEN - BEGIN MOVE(OLDBUFFER,BUFFERSIZE,BUFFER); - RESCANLINE; EDITOG:=0; GO TO CALCULATEDIT; - END; - I:=0; - GO AROUND; 07127000 P72 - EXECUTEIT: - POECESS(XEQUTE); %GO BACK TO PROCESS FOR AWHILE - IF CURRENTMODE=CALCMODE THEN GO TO BACKAGAIN; - I:=0; - GO AROUND; - FUNCTIONSTART: - IF SPECMODE = 0 THEN - BEGIN %SEE IF A SPECIAL FUNCTION. - STARTSCAN; - IF SCAN AND RGTPAREN THEN MESSAGEHANDLER ELSE - FUNCTIONHANDLER - END ELSE - FUNCTIONHANDLER; - I:=0; - GO AROUND - END; -INTEGER PROCEDURE LENGTH(A,M);VLUE M; BOOLEAN M; ARRAY A[0]; - BEGIN -INTEGER STREAM PROCEDURE LENGT(A,M,L); VALUE M,L; - BEGIN LOCAL T; - LOCAL C,CC,TST; LABEL LAB; - LOCAL AR; LABEL LAB2; - SI:=LOC M; SI:=SI+7; - IF SC'"1" THEN - BEGIN COMMENT LOOK FOR LEFT ARROW.; - DI:=LOC AR; DS:=RESET; DS:=5SET; - SI:=LOCL; DI:=LOC T; DI:=DI+1; DS:=7CHR; - SI:=A; - T(2(32(DI:=LOC AR; IF SC=DC THEN JUMP OUT 3 TO LAB; - TALLY:=TALLY+1; - C:=TALLY; TSI:=SI; SI:=L9OC C; - SI:=SI+7; IF SI="0" THEN - BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; - TALLY:=0; - END; SI:=TSI))); - L(DI:=LOC AR; IF SC=DC THEN JUMP OUT TO LAB; - TALLY:=TALLY+1; C:=TALLY; TSI:=SI; SI:=LOC C; SI:=SI+7; - IF SC="0" THEN - BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0; - END; SI:=TSI); - LAB: SI:=LOC CC; DI:=LOC LENGT; DI:=DI+6; SI:=SI+7; - DS:=CHR; SI:=LOC C; SI:=SI+7; DS:=CHR; - END ELSE - BEGIN - SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR; - SI:=A; T(2(SI:=SI+32)); SI:=SI+L; - T(2(32(SI:=SI-1; IF SC NEQ " " THEN JUMP OUT 3 TO LAB2; - TALLY:=TALLY+1; C:=TALLY; SI:=SI; SI:=LOC C; SI:=SI+7; - IF SC="0" THEN - BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0 - END; SI:=TSI))); - LAB2: GO TO LAB - END - END; -INTEGER I; + CURLINE:=GT3:=TOPLINE(GT1:=FUNCPOINTER); + CHECKSEQ(CURLINE,GT3,INCREMENT); %GET INCREMENT + CURLINE:=CURLINE+INCRMENT; INDENT(-CURLINE); + FUNCSIZE:=SIZE(GT1); + END; + %------------INPUTMODE-------------ERRORMODE---- + GOTOEXEC; GO TO EXEC; + END; + GUESS: %SHOULD BE BETTER PLACE BUT HERE IS WHERE OTHERS COME OUT 07044001P71 + STOREPSR; + IF CURRENTMODE NEQ FUNCMODE THEN + INDENT(0); TERPRINT; + VARSIE:=IF VARPIABLES=0 THEN 0 ELSE SIZE(VARIABLES); + END; +PROCEDURE APLMONITOR; + BEGIN + REAL T; + INTEGER I; + BOOLEAN WORK; + LABEL AROUND, NEWUSER; + LABEL CALULATE,EXECITEIT,FUNCTIONSTART,BACKAGAIN; + LABEL CALCULATEDIT; + I := CUSER := 1; + T := STATION; + BEGIN FILL ACCUM[*] WITH "APL/B550","0 UW COM" + ,"PUTER SC","IENCE #",VERSIONDATE; + WORK:=TRUE; + FORMROW(3,MARGINSIZE,ACCUM,0,40); + INDENT(0); TERPRINT; CSTATION.APLHEADING:=1 + ; LOGINAPLUSER; + END; + AROUND: + BEGIN + IF MAINTENANCE THEN; + CASE CURRENTMODE OF + BEGIN %-------CALCMODE-------------------------------- + COMMENT HE MUST BE READ READY FOR THE CALCMODE STUFF; + + GO CALCULATE; + %--------XEQUTE MODE-------------------------------- + GO TO EXECUTEIT; + %----------FUNCMODE----------------------------------- + GO TO FUNCTIONSTART; + %-----------INPUTMODE--------------------------------- + COMMENT REQUIRES INPUT; + + BEGIN COMMENT GET HT ELINE AND GO BACK; + STARTSCAN; + CURRENTMODE:=XEQM+ODE; + GO TO EXECUTEIT; + END; + %----------ERRORMODE--------------------------------- + GO TO BACKAGAIN; + + END; %OF CASES + END; + COMMENT GET HERE IF NOTHING TO DO; + + GO TO AROUND; + CALCULATE: + STARTSCAN; +CALCULATEDIT: + ERR:=0; %AND DON"T RESET IT IN SCAN OR IN ANALYZE + IF SCAN THEN + IF RGTPAREN THEN MESSAGEHANDLER EALSE + IF DELV THEN FUNCTIONHANDLER ELSE + BEGIN COMMENT PROCESS CAJLCULATOR MODE REQUEST; + MOVE(OLDBUFFER,BUFFERSIZE,BUFFER); + IF NOT BOOLEAN(SUSPENSION) THEN BEGIN %INITIALIZE USER +%%% +%%% + SYMBASE:=STACKBASE:=0; + END; + PROCESS(XEQUTE); + IF CURRENTMODE=CALCMODE THEN +BACKAGAIN: BEGIN INDENT(0); TERPRINT; + IF NOT BOOLEAN(SUSPENSION) THEN + BEGIN IF CURRENTMODE NEQ ERRORMODE THEN + PROCESS(WRITEBACK); + SP[0,0]:=0;NROWS:=-1; +%%% + END; + CURRENTMODE:=CALCMODE; + END; + IF EDITOG=1 THEN + BEGIN MOVE(OLDBUFFER,BUFFERSIZE,BUFFER); + RESCANLINE; EDITOG:=0; GO TO CALCULATEDIT; + END; + I:=0; + GO AROUND; 07127000P72 + EXECUTEIT: + POECESS(XEQUTE); %GO BACK TO PROCESS FOR AWHILE + IF CURRENTMODE=CALCMODE THEN GO TO BACKAGAIN; + I:=0; + GO AROUND; + FUNCTIONSTART: + IF SPECMODE = 0 THEN + BEGIN %SEE IF A SPECIAL FUNCTION. + STARTSCAN; + IF SCAN AND RGTPAREN THEN MESSAGEHANDLER ELSE + FUNCTIONHANDLER + END ELSE + FUNCTIONHANDLER; + I:=0; + GO AROUND + END; +INTEGER PROCEDURE LENGTH(A,M);VLUE M; BOOLEAN M; ARRAY A[0]; + BEGIN +INTEGER STREAM PROCEDURE LENGT(A,M,L); VALUE M,L; + BEGIN LOCAL T; + LOCAL C,CC,TST; LABEL LAB; + LOCAL AR; LABEL LAB2; + SI:=LOC M; SI:=SI+7; + IF SC'"1" THEN + BEGIN COMMENT LOOK FOR LEFT ARROW.; + DI:=LOC AR; DS:=RESET; DS:=5SET; + SI:=LOCL; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=A; + T(2(32(DI:=LOC AR; IF SC=DC THEN JUMP OUT 3 TO LAB; + TALLY:=TALLY+1; + C:=TALLY; TSI:=SI; SI:=L9OC C; + SI:=SI+7; IF SI="0" THEN + BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; + TALLY:=0; + END; SI:=TSI))); + L(DI:=LOC AR; IF SC=DC THEN JUMP OUT TO LAB; + TALLY:=TALLY+1; C:=TALLY; TSI:=SI; SI:=LOC C; SI:=SI+7; + IF SC="0" THEN + BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0; + END; SI:=TSI); + LAB: SI:=LOC CC; DI:=LOC LENGT; DI:=DI+6; SI:=SI+7; + DS:=CHR; SI:=LOC C; SI:=SI+7; DS:=CHR; + END ELSE + BEGIN + SI:=LOC L; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=A; T(2(SI:=SI+32)); SI:=SI+L; + T(2(32(SI:=SI-1; IF SC NEQ " " THEN JUMP OUT 3 TO LAB2; + TALLY:=TALLY+1; C:=TALLY; SI:=SI; SI:=LOC C; SI:=SI+7; + IF SC="0" THEN + BEGIN TALLY:=CC; TALLY:=TALLY+1; CC:=TALLY; TALLY:=0 + END; SI:=TSI))); + LAB2: GO TO LAB + END + END; +INTEGER I; I:=LENGT(A,M,BUFFSIZE|8); LENGTH:=IF M THEN I ELSE BUFFSIZE|8-I - END -BOOLEAN PRUOCEDURE LABELSCAN(L,K); VALUE K; INTEGER K; ARRAY L[0]; - BEGIN REAL T; - T:=ADDRSS; - IF SCAN AND IDENT THEN + END +BOOLEAN PRUOCEDURE LABELSCAN(L,K); VALUE K; INTEGER K; ARRAY L[0]; + BEGIN REAL T; + T:=ADDRSS; + IF SCAN AND IDENT THEN BEGIN SETFIELD(ACCUM,1,1,0); TRANSFER(ACCUM,1,L,K|8,8); - IF NOT(LABELSCAN:=(SCAN AND COLON)) THEN - BEGIN ADDRESS:=T; EOB:=0; IF SCAN THEN; - END; - END - END; -STREAM PROCEDURE MOVEWDS(A,N,B); VALUE N; - BEGIN SI:=A; DT:=8; DS:=N WDS END; -INTEGER PROCEURE DAYTIME(B); ARRAY B[0]; - BEGIN - - INTEGER D,H,M,MIN,Q,P,Y,TIME1; - LABEL OWT; - STREAM PROCEDURE FORM(A,DAY,MD,DA,YR,HR,MIN,AP); - VALUE DAY,MD,DA,YR,HR,MIN,AP; - BEGIN DI:=A; 08014064 P73 - SI:=LOC DAY; SI:=SI+7; - IF SC="0" THEN DS:=3LIT"SUN" ELSE - IF SC="1" THEN DS:=3LIT"MON" ELSE - IF SC="2" THEN DS:=4LIT"TUES" ELSE - IF SC="3" THEN DS:=6LIT"WEDNES" ELSE - IF SC="4" THEN DS:=5LIT"THURS" ELSE - IF SC="5" THEN DS:=3LIT"FRI" ELSE DS:=5LIT"SATUR"; - DS:=4LIT"DAY "; SI:=LOC MO; DS:=2DEC; - DS:=LIT"-"; SI:=LOC DA; DS:=2DEC; DS:=LIT"-"; - SI:=LOC YR; DS:=2DEC; DS:=2LIT" "; - SI:=LOC HR; DS:=2DEC; DS:=LIT":"; SI:=LOC MIN; - SI:=SI+6; DS:=2CHR; SI:=LOC AP; SI:=SI+7; DS:=LIT" "; - DS:=CHR; DS:=LIT"M" - END; - TIME1:=TIME(1); - Y:=TIME(0); + IF NOT(LABELSCAN:=(SCAN AND COLON)) THEN + BEGIN ADDRESS:=T; EOB:=0; IF SCAN THEN; + END; + END + END; +STREAM PROCEDURE MOVEWDS(A,N,B); VALUE N; + BEGIN SI:=A; DT:=8; DS:=N WDS END; +INTEGER PROCEURE DAYTIME(B); ARRAY B[0]; + BEGIN + + INTEGER D,H,M,MIN,Q,P,Y,TIME1; + LABEL OWT; + STREAM PROCEDURE FORM(A,DAY,MD,DA,YR,HR,MIN,AP); + VALUE DAY,MD,DA,YR,HR,MIN,AP; + BEGIN DI:=A; 08014064P73 + SI:=LOC DAY; SI:=SI+7; + IF SC="0" THEN DS:=3LIT"SUN" ELSE + IF SC="1" THEN DS:=3LIT"MON" ELSE + IF SC="2" THEN DS:=4LIT"TUES" ELSE + IF SC="3" THEN DS:=6LIT"WEDNES" ELSE + IF SC="4" THEN DS:=5LIT"THURS" ELSE + IF SC="5" THEN DS:=3LIT"FRI" ELSE DS:=5LIT"SATUR"; + DS:=4LIT"DAY "; SI:=LOC MO; DS:=2DEC; + DS:=LIT"-"; SI:=LOC DA; DS:=2DEC; DS:=LIT"-"; + SI:=LOC YR; DS:=2DEC; DS:=2LIT" "; + SI:=LOC HR; DS:=2DEC; DS:=LIT":"; SI:=LOC MIN; + SI:=SI+6; DS:=2CHR; SI:=LOC AP; SI:=SI+7; DS:=LIT" "; + DS:=CHR; DS:=LIT"M" + END; + TIME1:=TIME(1); + Y:=TIME(0); D:=Y.[30:1]|100+Y.[36:6]|10+Y.[42:6]; Y:=Y.[18:6]|10+Y.[24:6]; - FOR H:=31,IF Y MOD 4=0 THEN 29 ELSE 28,31,30, - 31,30,31,31,30,31,30 DO - IF D LEQ H THEN GO OWT ELSE - BEGIN D:=D-H; M:=M+1; - END; - OWT: - H:=TIME1 DIV 216000; - MIN:=(TIME1 DIV 3600) MOD 60; - IF M LSS 2 THEN - BEGIN Q:=M+11; P:=Y-1; - END ELSE - BEGIN Q:=M-1; P:=Y - END; - M:=M+1; + FOR H:=31,IF Y MOD 4=0 THEN 29 ELSE 28,31,30, + 31,30,31,31,30,31,30 DO + IF D LEQ H THEN GO OWT ELSE + BEGIN D:=D-H; M:=M+1; + END; + OWT: + H:=TIME1 DIV 216000; + MIN:=(TIME1 DIV 3600) MOD 60; + IF M LSS 2 THEN + BEGIN Q:=M+11; P:=Y-1; + END ELSE + BEGIN Q:=M-1; P:=Y + END; + M:=M+1; FORM(B,TIME1:=((Q|26-2)DIV 10+D+P+P.[36:10]+1)MOD 7, M,D,Y,Q:= H MOD 12, Q:=MIN MOD 10+(MIN DIV 10)|64, - IF H GEQ 12 THEN "P" ELSE 17); - DAYTIME:=(IF TIME1=6 THEN 5 ELSE - IF TIME1=5 THEN 3 ELSE - IF TIME2=2 THEN 4 ELSE 3)+22; - - - END; -PROCEDURE LOADWORKSPACE(NAME1,NAME2,IDENT); VALUE NAME1,NAME2; - REAL NAME1,NAME2; ARRAY IDENT[0]; - BEGIN - FILE DISK DISK(2,WDSPERREC,WDSPERBLK); - INTEGER PROCEDURE RD(D,N,A); - VALUE N; INTEGER N; FILE D; ARRAY A[0]; - BEGIN READ(D[N],WDSPERREC,A[*]); - RD:=N+1; - END; - PROCEDURE LOADITEM(RD,D,ITEM); - INTEGER PR+OCEDURE RD; FILE D; - ARRAY ITEM[0]; - BEGIN - DEFINE T=ITEM#; - PROCEDURE GETALINE(C,S,L,R,RD,D,LEN); - VALUE LEN; INTEGER C,S,L,LEN; - ARRAY A[0]; INTEGER PROCEDURE RD; FILE D; - BEGIN % GET 2 CHRS GIVING ENSUING CHAR COUNT - INTEGER P; - IF C GTR LEN-2 THEN - IF C GTR LEN-1 THEN % READ A NEW RECORD AND TAKE 2 CHRS - BEGIN - S:=RD(D,S,R); - C:=2; - TRANSFER(B,0,L,6,2); - END - ELSE % 1 CHR LEFT ON LINE - BEGIN - TRANSFER(B,C,L,6,1); - S:=RD(D,S,B); - TRANSFER(B,0,L,7,1); - C:=1; - END - ELSE % AT LEAST 2 CHARS REMAINING ON LINE - BEGIN - TRANSFER(B,C,L,6,2); - C:=C+2; - END; - P:=0; - +IF L NEQ 0 THEN % SOMETHING LEFT IN FUNCTION - BEGIN - WHILE P LSS L DO 08014459 P74 - IF (L-P) GTR (LEN-C) THEN % # OF CHARS IN LINE - % EXTENDS INTO NEXT RECORD - BEGIN - TRANSFER(B,C,BUFFER,P,LEN-C); % FINISH OUT RECORD - S:=RD(D,S,R); - P:=P+(LEN-C); % AMOUNT READ SO FAR - C:=0; - END - ELSE % ALL ON ONE RECORD - BEGIN - TRANSFER(B,C,BUFFER,P,L-P); - C:=C_L-P; - P:=L; % FINISHED - END; - END; - END OF GETALINE; - INTEGER S,K,L,M,C,LEN,SQ,PT,G,I,SIZE; - INTEGER HOLD; - LABEL SCALARL; - ARRAY U[0:1],B[0:WDSPERREC-1]; - BOOLEAN TOG; - TRANSFER(T,0,U,0,7); - G:=GETFIELD(T,7,1); - IF VARSRSIZE GTR 0 THEN - IF K+;SEARCHORD(VARIABLES,U,HOLD,7)=0 THEN - IF K:=GETFIELD(U,7,1)=FUNCTION THEN TOG:=TRUE - ELSE % NOT A FUNCTION IN THE SYMBOL TABLE - IF G=FUNCTION THEN - BEGIN - DELETE1(VARIABLES,HOLD); - IF K=ARRAYDATA THEN RELEASEARRAY(U[1]); - END; - ELSE TOG:=TRUE % DON-T CHANGE - ELSE % NOT IN VARIABLES - BEGIN - VARSIZE:=VARSIZE+1; - HOLD:=HOLD+K-1; - END; - ELSE VARSIZE:=1; + IF H GEQ 12 THEN "P" ELSE 17); + DAYTIME:=(IF TIME1=6 THEN 5 ELSE + IF TIME1=5 THEN 3 ELSE + IF TIME2=2 THEN 4 ELSE 3)+22; + + + END; +PROCEDURE LOADWORKSPACE(NAME1,NAME2,IDENT); VALUE NAME1,NAME2; + REAL NAME1,NAME2; ARRAY IDENT[0]; + BEGIN + FILE DISK DISK(2,WDSPERREC,WDSPERBLK); + INTEGER PROCEDURE RD(D,N,A); + VALUE N; INTEGER N; FILE D; ARRAY A[0]; + BEGIN READ(D[N],WDSPERREC,A[*]); + RD:=N+1; + END; + PROCEDURE LOADITEM(RD,D,ITEM); + INTEGER PR+OCEDURE RD; FILE D; + ARRAY ITEM[0]; + BEGIN + DEFINE T=ITEM#; + PROCEDURE GETALINE(C,S,L,R,RD,D,LEN); + VALUE LEN; INTEGER C,S,L,LEN; + ARRAY A[0]; INTEGER PROCEDURE RD; FILE D; + BEGIN % GET 2 CHRS GIVING ENSUING CHAR COUNT + INTEGER P; + IF C GTR LEN-2 THEN + IF C GTR LEN-1 THEN % READ A NEW RECORD AND TAKE 2 CHRS + BEGIN + S:=RD(D,S,R); + C:=2; + TRANSFER(B,0,L,6,2); + END + ELSE % 1 CHR LEFT ON LINE + BEGIN + TRANSFER(B,C,L,6,1); + S:=RD(D,S,B); + TRANSFER(B,0,L,7,1); + C:=1; + END + ELSE % AT LEAST 2 CHARS REMAINING ON LINE + BEGIN + TRANSFER(B,C,L,6,2); + C:=C+2; + END; + P:=0; + +IF L NEQ 0 THEN % SOMETHING LEFT IN FUNCTION + BEGIN + WHILE P LSS L DO 08014459P74 + IF (L-P) GTR (LEN-C) THEN % # OF CHARS IN LINE + % EXTENDS INTO NEXT RECORD + BEGIN + TRANSFER(B,C,BUFFER,P,LEN-C); % FINISH OUT RECORD + S:=RD(D,S,R); + P:=P+(LEN-C); % AMOUNT READ SO FAR + C:=0; + END + ELSE % ALL ON ONE RECORD + BEGIN + TRANSFER(B,C,BUFFER,P,L-P); + C:=C_L-P; + P:=L; % FINISHED + END; + END; + END OF GETALINE; + INTEGER S,K,L,M,C,LEN,SQ,PT,G,I,SIZE; + INTEGER HOLD; + LABEL SCALARL; + ARRAY U[0:1],B[0:WDSPERREC-1]; + BOOLEAN TOG; + TRANSFER(T,0,U,0,7); + G:=GETFIELD(T,7,1); + IF VARSRSIZE GTR 0 THEN + IF K+;SEARCHORD(VARIABLES,U,HOLD,7)=0 THEN + IF K:=GETFIELD(U,7,1)=FUNCTION THEN TOG:=TRUE + ELSE % NOT A FUNCTION IN THE SYMBOL TABLE + IF G=FUNCTION THEN + BEGIN + DELETE1(VARIABLES,HOLD); + IF K=ARRAYDATA THEN RELEASEARRAY(U[1]); + END; + ELSE TOG:=TRUE % DON-T CHANGE + ELSE % NOT IN VARIABLES + BEGIN + VARSIZE:=VARSIZE+1; + HOLD:=HOLD+K-1; + END; + ELSE VARSIZE:=1; LEN:=(WDSPERREC-1)|8; - IF NOT TOG THEN % OK TO PUT INTO VARIABLES - IF G=FUNCTION THEN % READ A FUNCTION INTO VARIABLES - BEGIN - TRANSFER(T,0,U,0,9); % U HOLDS FUNCTION NAME, - %NUMBER OF ARGUMENTS, AND WHETHER FN RETURNS A VALUE - S:=T[1].LIBF1; % RECORD NUMBER - M:=T[1].LIBF2; % WORD WITHIN RECORD - SIZE:=T[1].LIBF3; % SIZE OF POINTERS TABLE - PR:=NEXTUNIT; - S:=RD(D,S,B); - FOR I:=0 STEP 1 UNTIL SIZE-1 DO - BEGIN + IF NOT TOG THEN % OK TO PUT INTO VARIABLES + IF G=FUNCTION THEN % READ A FUNCTION INTO VARIABLES + BEGIN + TRANSFER(T,0,U,0,9); % U HOLDS FUNCTION NAME, + %NUMBER OF ARGUMENTS, AND WHETHER FN RETURNS A VALUE + S:=T[1].LIBF1; % RECORD NUMBER + M:=T[1].LIBF2; % WORD WITHIN RECORD + SIZE:=T[1].LIBF3; % SIZE OF POINTERS TABLE + PR:=NEXTUNIT; + S:=RD(D,S,B); + FOR I:=0 STEP 1 UNTIL SIZE-1 DO + BEGIN TRANSFER(M,M|8,T,0,16); - M:=M+2; - IF M GEQ WDSPERREC-1 THEN - BEGIN - S:=RD(D,S,R); - IF M GEQ WDSPERREC THEN - BEGIN - TRANSFER(B,0,T,8,8); - M:=1; - END - ELSE M:=0; - END; - STOREORD(PT,T,I); - END; % HAV FINISHED FILLIN G POINTERS TABLE - IF VARIABLES=0 THEN BEGIN - VARIABLES:=NEXTUNIT; TOG:=TRUE; %KEEP THE UNIT OPEN - STOREORD(VARIABLES,U,HOLD); END; - SEQUENTIAL (SQ:=MEXTUNIT); - SETFIELD(U,FPTF,FFL,PT); - SETFIELD(U,FSQF,FFL,SQ); - STOREORD(VARIABLES,U,HOLD); - IF TOC THEN DELETE1(VARIABLES,HOSLD+1);%REMOVE 1 EXTRA - COMMENT NOW FILL IN SEQ STORAGE; - IF M NEQ 0 THEN BEGIN - M:=C:=0; - S:=RD(D,S,B); % TEXT STARTS AT BEG. OF NEW RECORD - END; - L:=1; - - WHILE L NEQ 0 DO - BEGIN 08014747 P75 - GETALINE(C,S,L,B,RD,D,LEN); - GT1:=STORESEQ(SQ,BUFFER,L); - END - END - ELSE - IF G=ARRAYDATA THEN - IF T[1].INTPTR=0 THEN % NULL VECTOR - GOTO SCALARL - ELSE - BEGIN - ARRAY DIMVECT[0,MAXBUFFSIZE]; - S:=T[1].INPTR; % RECORD NUMBER - M:=T[1].DIMPTR; % LOC WITHIN RECORD + M:=M+2; + IF M GEQ WDSPERREC-1 THEN + BEGIN + S:=RD(D,S,R); + IF M GEQ WDSPERREC THEN + BEGIN + TRANSFER(B,0,T,8,8); + M:=1; + END + ELSE M:=0; + END; + STOREORD(PT,T,I); + END; % HAV FINISHED FILLIN G POINTERS TABLE + IF VARIABLES=0 THEN BEGIN + VARIABLES:=NEXTUNIT; TOG:=TRUE; %KEEP THE UNIT OPEN + STOREORD(VARIABLES,U,HOLD); END; + SEQUENTIAL (SQ:=MEXTUNIT); + SETFIELD(U,FPTF,FFL,PT); + SETFIELD(U,FSQF,FFL,SQ); + STOREORD(VARIABLES,U,HOLD); + IF TOC THEN DELETE1(VARIABLES,HOSLD+1);%REMOVE 1 EXTRA + COMMENT NOW FILL IN SEQ STORAGE; + IF M NEQ 0 THEN BEGIN + M:=C:=0; + S:=RD(D,S,B); % TEXT STARTS AT BEG. OF NEW RECORD + END; + L:=1; + + WHILE L NEQ 0 DO + BEGIN 08014747P75 + GETALINE(C,S,L,B,RD,D,LEN); + GT1:=STORESEQ(SQ,BUFFER,L); + END + END + ELSE + IF G=ARRAYDATA THEN + IF T[1].INTPTR=0 THEN % NULL VECTOR + GOTO SCALARL + ELSE + BEGIN + ARRAY DIMVECT[0,MAXBUFFSIZE]; + S:=T[1].INPTR; % RECORD NUMBER + M:=T[1].DIMPTR; % LOC WITHIN RECORD C:=M|8; - SIZE:=RD(D,S,B); - GETALINE(C,S,L,B,RD,D,LEN); - T[1].DIMPTR:=STORESEQ(WS,BUFFER,L); - % PUTS DIMVECT INTO WORKSPACE - GETALINE(C,S,L,B,RD,D,LEN); % # BLOCKS - SIZE:=L-1; - FOR K:=0 STEP 2 UNTIL SIZE DO - BEGIN - GETALINE(C,S,L,B,RD,D,LEN); - SETFIELD(DIMVECT,K,S,STORESEQ(WS,BUFFER,L)); - END; COMMENT THIS STORES THE VALUES OF THE - ARRAY INTO THE W+ORKSPACE, AND ALSO RECORDS + SIZE:=RD(D,S,B); + GETALINE(C,S,L,B,RD,D,LEN); + T[1].DIMPTR:=STORESEQ(WS,BUFFER,L); + % PUTS DIMVECT INTO WORKSPACE + GETALINE(C,S,L,B,RD,D,LEN); % # BLOCKS + SIZE:=L-1; + FOR K:=0 STEP 2 UNTIL SIZE DO + BEGIN + GETALINE(C,S,L,B,RD,D,LEN); + SETFIELD(DIMVECT,K,S,STORESEQ(WS,BUFFER,L)); + END; COMMENT THIS STORES THE VALUES OF THE + ARRAY INTO THE W+ORKSPACE, AND ALSO RECORDS THE LOCATION WITHIN WS IN DIMVECT,TO BE STORED; - T[1].INPTR:=STORESEQ(WS,DIMVECT,SIZE+1); - IF VARIABLES=0 THEN VARIABLES:=NECTUNIT; - STOREORD(VARIABLES,T,HOLD); - END - ELSE % MUST BE A SCALER - SCALARL: - BEGIN - IF VARIABLES=0 THEN VARIABLES:=NEXTUNIT; - STOREORD(VARIABLES,T,HOLD); - END - ELSE % WILL NOT REPLACE IN SYMBOL TABLE - BEGIN - FILL BUFFER[*] WITH " ","NOT REPL","ACED "; - TRANSFER(T,0,BUFFER,0,7); - FORMROW(3,0,BUFFER,0,20); - END; - END LOADITEM; - BOOLEAN STREAM PROCEDURE EQUAL(A,B); - BEGIN SI:=A; DI:=B; SI:=SI+2; IF 7SC=DC THEN TALLY:=1; - EQUAL:=TALLY - END; - INTEGER I,J,L,NDIR,N; - LABEL MOVEVAR,SKIP; - ARRAY T,U[0:1],D[0:WDSPERREC-1]; - FILL DISK WITH NAME1,NAME2; L:=RD(DISK,L,D); - IF D[1] NEQ JOBNUM AND D[1] NEQ 0 THEN GO SKIP; % FILE LOCKED - FOR I:=2 STEP 1 UNTQIL 9 DO IF GETFIELD(D[I],1,7) NEQ C THEN GO SKIP; - IF NDIR:=D[0] NEQ 0 THEN + T[1].INPTR:=STORESEQ(WS,DIMVECT,SIZE+1); + IF VARIABLES=0 THEN VARIABLES:=NECTUNIT; + STOREORD(VARIABLES,T,HOLD); + END + ELSE % MUST BE A SCALER + SCALARL: + BEGIN + IF VARIABLES=0 THEN VARIABLES:=NEXTUNIT; + STOREORD(VARIABLES,T,HOLD); + END + ELSE % WILL NOT REPLACE IN SYMBOL TABLE + BEGIN + FILL BUFFER[*] WITH " ","NOT REPL","ACED "; + TRANSFER(T,0,BUFFER,0,7); + FORMROW(3,0,BUFFER,0,20); + END; + END LOADITEM; + BOOLEAN STREAM PROCEDURE EQUAL(A,B); + BEGIN SI:=A; DI:=B; SI:=SI+2; IF 7SC=DC THEN TALLY:=1; + EQUAL:=TALLY + END; + INTEGER I,J,L,NDIR,N; + LABEL MOVEVAR,SKIP; + ARRAY T,U[0:1],D[0:WDSPERREC-1]; + FILL DISK WITH NAME1,NAME2; L:=RD(DISK,L,D); + IF D[1] NEQ JOBNUM AND D[1] NEQ 0 THEN GO SKIP; % FILE LOCKED + FOR I:=2 STEP 1 UNTIL 9 DO IF GETFIELD(D[I],1,7) NEQ C THEN GO SKIP; + IF NDIR:=D[0] NEQ 0 THEN BEGIN N:=LIBSPACES+ENTIER(NDIR|2/(J:=WDSPERREC-1)); IF(NDIR|2) MOD J NEQ 0 THEN N:=N+1; - FOR I:=1 STEP 1 UNTIL NDIR DO - BEGIN COMMENT GET FUNCTION OR VARIABLE NAME FROM LIB; - IF WDSPERREC-J LSS 3 THEN - IF WDSPERREC-J=1 THEN - BEGIN L:=RD(DISK,L,D); J:=0; GO MOVEVAR - END ELSE + FOR I:=1 STEP 1 UNTIL NDIR DO + BEGIN COMMENT GET FUNCTION OR VARIABLE NAME FROM LIB; + IF WDSPERREC-J LSS 3 THEN + IF WDSPERREC-J=1 THEN + BEGIN L:=RD(DISK,L,D); J:=0; GO MOVEVAR + END ELSE BEGIN TRANSFER(D,J|8,T,08); L:=RD(DISK,L,D); - TRANSFER(D,0,T,8,8); J:=1 - END ELSE MOVEVAR: + TRANSFER(D,0,T,8,8); J:=1 + END ELSE MOVEVAR: BEGIN TRANSFER(D,J|8,T,0,16); J:=J+2 - END; - IF(IF IDENT[0]=0 THEN TRUE ELSE EQUAL(IDENT,T)) THEN - BEGIN IF IDENT[0] NEQ 0 THEN I:=NDIR+1; - LOADITEM(RD,DISK,T); - END - END; - STOREPSR; % UPDATE SINCE HAVE ADDED TO VARIABLES - END; - IF FALS THEN SKIP; FORMWD(1,"6BADFIL"); - EOB:=1; - END OF LIBRARY LOAD; -PROCEDURE PURGEWORKSPACE(WS); VALUE WS; INTEGER WS; - IF WORKSPACE NEQ 0 THEN - BEGIN - INTEGER I,J,K,V,L,G; 08015020 P76 - ARRAY T[0,1]; - J:=SIZE(V:=VARIABLES)-1; - FOR I:=0 STEP 1 UNTIL J DO - BEGIN K:=CONTENTS(V,I,T); - IF GETFIELD(T,7,1)=FUNCTION THEN - FOR L:=FPTF,FSQF DO % GET RID OF STORAGE - IF G:=GETFIELD(T,L,FFL) NEQ 0 THEN RELEASEUNIT(G); - END; - RELEASEUNIT(V); - VARIABLES:=0; VARSIZE:=0; - CURRENTMODE:=0; J:=SIZE(WS)-1; - FOR I:=1 STEP 1 UNTIL J DO DELETE1(WS,I); - STORESPR; - END; -PROCEDURE ELIMWORKSPACE(WS); VALUE WS; INTEGER WS; - BEGIN LABEL QQQ; QQQ: - IF WORKSPACE NEQ 0 THEN - BEGIN - PURGEWORKSPACE(WS); RELEASEUNIT(WS); -% - END ELSE SPOUT(8015222); - END; -PROCEDURE SAVEWORKSPACE(NAME1,NAME2,LOCKFILE); - VALUE NAME1,NAME2,LOCKFILE; - REAL NAME1,NAME2,LOCKFILE; - BEGIN - SAVE FILE DISK [NAREAS:SIZEAREAS] - (2,WDSPERREC,WDSPERBLK,SAVE 100); - INTEGER PROCEDURE WR(D,N,A); VALUE N; INTEGER N; - F+ILE D; ARRAY A[0]; - BEGIN REAL STREAM PROCEDURE CON(A); VALUE A; - BEGIN SI:=LOCA; DI:=LOC C9ON; DS:=8DEC END; - STREAM PROCEDURE CLEANER(A); - BEGIN DI:=A; WDSPERREC(DS:=BLIT".") END; - A[WDSPERREC-1]:=CON(N); - WRITE(D[N],WDSPERREC,A[*]); - WR:=N+1; CLEANER(A); - END; - PROCEDURE PUTAWAY(C,J,WR,D,N,M,B,L); VALUE L,J; - INTEGER L,C,J,N,M; - ARRAY B[0]; INTEGER PROCEDURE WR; FILE D; - BEGIN INTEGER P,K; - IF C+2 GTR L THEN - BEGIN TRANSFER(J,6,B,C,1); N:=WR(D,N,B); C:=1; - TRANSFER(J,7,B,0,1); - END ELSE - BEGIN TRANSFER(J,6,B,C,2); C:=C+2; - END; - WHILE J NEW 0 DO - IF J GTR K:=(L-C) THEN - BEGIN TRANSFER(BUFFER,P,B,C,K); - N:=WR(D.N.B); J:=J-K; C:=0; P:=P+K - END ELSE - BEGIN TRANSFER(BUFFER,P,B,C,J); C:=C+J; J:=0 - END; - IF C=L THEN - BEGIN N:=WR(D,N,B); C:=0 - END; - END; - - PROCEDURE MOVETWO(U,B,M,WR,L,D); - ARRAY U,B[0]; INTEGER M,L; INTEGER PROCEDURE WR; FILE D; - BEGIN - COMMENT PUTS 2 WORDS OF U IN B AND WRITES ON D IF A FULLRECORD; + END; + IF(IF IDENT[0]=0 THEN TRUE ELSE EQUAL(IDENT,T)) THEN + BEGIN IF IDENT[0] NEQ 0 THEN I:=NDIR+1; + LOADITEM(RD,DISK,T); + END + END; + STOREPSR; % UPDATE SINCE HAVE ADDED TO VARIABLES + END; + IF FALS THEN SKIP; FORMWD(1,"6BADFIL"); + EOB:=1; + END OF LIBRARY LOAD; +PROCEDURE PURGEWORKSPACE(WS); VALUE WS; INTEGER WS; + IF WORKSPACE NEQ 0 THEN + BEGIN + INTEGER I,J,K,V,L,G; 08015020P76 + ARRAY T[0,1]; + J:=SIZE(V:=VARIABLES)-1; + FOR I:=0 STEP 1 UNTIL J DO + BEGIN K:=CONTENTS(V,I,T); + IF GETFIELD(T,7,1)=FUNCTION THEN + FOR L:=FPTF,FSQF DO % GET RID OF STORAGE + IF G:=GETFIELD(T,L,FFL) NEQ 0 THEN RELEASEUNIT(G); + END; + RELEASEUNIT(V); + VARIABLES:=0; VARSIZE:=0; + CURRENTMODE:=0; J:=SIZE(WS)-1; + FOR I:=1 STEP 1 UNTIL J DO DELETE1(WS,I); + STORESPR; + END; +PROCEDURE ELIMWORKSPACE(WS); VALUE WS; INTEGER WS; + BEGIN LABEL QQQ; QQQ: + IF WORKSPACE NEQ 0 THEN + BEGIN + PURGEWORKSPACE(WS); RELEASEUNIT(WS); +% + END ELSE SPOUT(8015222); + END; +PROCEDURE SAVEWORKSPACE(NAME1,NAME2,LOCKFILE); + VALUE NAME1,NAME2,LOCKFILE; + REAL NAME1,NAME2,LOCKFILE; + BEGIN + SAVE FILE DISK [NAREAS:SIZEAREAS] + (2,WDSPERREC,WDSPERBLK,SAVE 100); + INTEGER PROCEDURE WR(D,N,A); VALUE N; INTEGER N; + F+ILE D; ARRAY A[0]; + BEGIN REAL STREAM PROCEDURE CON(A); VALUE A; + BEGIN SI:=LOCA; DI:=LOC C9ON; DS:=8DEC END; + STREAM PROCEDURE CLEANER(A); + BEGIN DI:=A; WDSPERREC(DS:=BLIT".") END; + A[WDSPERREC-1]:=CON(N); + WRITE(D[N],WDSPERREC,A[*]); + WR:=N+1; CLEANER(A); + END; + PROCEDURE PUTAWAY(C,J,WR,D,N,M,B,L); VALUE L,J; + INTEGER L,C,J,N,M; + ARRAY B[0]; INTEGER PROCEDURE WR; FILE D; + BEGIN INTEGER P,K; + IF C+2 GTR L THEN + BEGIN TRANSFER(J,6,B,C,1); N:=WR(D,N,B); C:=1; + TRANSFER(J,7,B,0,1); + END ELSE + BEGIN TRANSFER(J,6,B,C,2); C:=C+2; + END; + WHILE J NEW 0 DO + IF J GTR K:=(L-C) THEN + BEGIN TRANSFER(BUFFER,P,B,C,K); + N:=WR(D.N.B); J:=J-K; C:=0; P:=P+K + END ELSE + BEGIN TRANSFER(BUFFER,P,B,C,J); C:=C+J; J:=0 + END; + IF C=L THEN + BEGIN N:=WR(D,N,B); C:=0 + END; + END; + + PROCEDURE MOVETWO(U,B,M,WR,L,D); + ARRAY U,B[0]; INTEGER M,L; INTEGER PROCEDURE WR; FILE D; + BEGIN + COMMENT PUTS 2 WORDS OF U IN B AND WRITES ON D IF A FULLRECORD; TRANSFER(U,0,B,M|8,16); % CONTENTS OF U INTO B - M:=M+2; - IF M GEQ WDSPERREC-1 THEN % FULL RECORD - BEGIN - L:=WR(D,L,B); - IF M GEQ WDSPERREC THEN % 1 OVER FULL RECORD - - BEGIN - TRANSFER(U,8,B,0,8); - M:=1; - END - ELSE M:=D; - END; - END OF MOVETWO; - INTEGER H,Q,M,N,I,L,S,J,K,LINE,MAX,PT,SQ,C,LEN,W; - REAL LSD,STP; - LABEL SKIP; - ARRAY T,U[0:1],DIR,B,SEX[0:WDSPERREC]; - N:=LIBSPACES+ENTIER((S:=SIZE(VARIABLES))|2/(WDSPERREC-1)); 08015575 P77 - IF (S|) MOD (WDSPERREC-1) NEQ 0 THEN N:=N+1; % ADJUST - LEN:=(WDSPERREC-1)|8; - FILLS DISK WITH NAME1,NAME2; - DIR[0]:=S; % SIZE OF SYMBOL TABLE - IF BOOLEAN (LOCKFILE) THEN DIR[1]:=JOBNUM; - S:=S-1; - L:=WR(DISK,L,DIR); % FIRST LINE CPONTAINS # OF ENTRIES IN - COMMENT SYMBOL TABLE AND LOCK INFORMATION; - FOR I:=0 STEP 1 UNTIL 5 DO - BEGIN - J:=CONTENTS(VARIABLES,T,T); % RETURNS VALUE OF I-TH LOC - % IN VARIABLES INTO T - IF GT2:=GETFIELD(T,7,1)=FUNCTION THEN - BEGIN - PT:=GETFIELD(T,FPTF,FFL); % FUNCTION POINTER FIELD - SQ:=GETFIELD(T,FSQF,FFL); % FUNCTION SEQUENTIAL FIELD - %PT=# OF ORDERED STORAGE UNIT CONTAINING HEADER AND POINTE - %SQ=# OF SEQ STORAGE UNIT CPONTAINING TEXT - MAX:=SIZE(PT); - T[1].LIBF1:=N; % RECORD # - T[1].LIBF2:=M; % LOC WITHIN RECORD - T[1].LIBF3:=MAX; % SIZE OF POINTERS TABLE; - % SAVE ENOUGH ROOM FOR THE ENTIRE POINTERS TABLE - H:=ENTIER(GT1:=(M+MAX|2)/(WDSPERREC-1)); - H:=IF GT1 NEQ H THEN H+N+1 ELSE H+N; - U[0]:=0; - J:=SEARCHORD(PT,U,LINE,8); % LOOK FOR ALL ZEROS - IF J=2 THEN GO SKIP; - FOR W:=0 STEP 1 UNTIL LINE-1 DO - %MOVE LOCALS AND LABELS INTO THE SAVE FILE - BEGIN - J:=CONTENTS(PT,W,U); - MOVETWO(U,B,M,WR,N,DISK); - END; - FOR LINE:=LINE STEP 1 UNTIL MAX-1 DO - BEGIN - - J:=CONTENTS(PT,LINE,U); - GT1:=U[1]; - U[1]:=LINE-W; - MOVETWO(U,B,M,WR,N,DISK); % POINTERS TABLE - J:=CONTENTS(SQ,GT1,BUFFER); - PUTAWAY(C,J,WR,DISK,H,Q,SEX,LEN); % TEXT - END; - PUTAWAY(C,0,WR,DISK,H,Q,SEX,LEN); - SKIP: - Q:=C DIV 8; - IF C MOD 8 NEQ 0 THEN Q:=Q+1; - IF Q=WDSPERREC-1 THEN - BEGIN - H:=WR(DISK,H,SEX); - Q:=0; - END; - IF M GTR 0 THEN N:=WR(DISK,N,B); - M:=Q; N:=H; - TRANSFER(SEX,0,B,0,C); % MOVE BACK TO B - C:=0; - END - ELSE - BEGIN - T[1].INPTR:=N; T[1].DIMPTR:=M; - C:=M|8; - J:=CONTENTS(WS,LSD,DIMPTR,BUFFER); % DIM VECT - PUTAWAY(C,J,WR,DISK,N,M,B,LEN); % STD DIM VECT - J:=CONTENTS(WS,LSD,INPTR,DIMVECT); - TRANSFER(DIMVECT,0,BUFFER,0,J); - PUTAWAY(C,J,WR,DISK,N,M,B,LEN); - J:=J-1; - FOR LINE:=0 STEP 2 UNTIL J DO - BEGIN - PT:=GETFIELD(DIMVECT,LINE,2); - STP:=CONTENTS(WS,PT,BUFFER); - PUTAWAY(C,STP,WR,DISK,N,M,B,LEN); - END; - M:=C DIV A; IF C MOD A NEQ 0 THEN M:=M+1; C:=0; - IF M=WDSPERREC-1 THEN BEGIN N:=WR(DISK,N,8); - M:=0; END; 08015888 P78 - END; - END; - MOVETWO(T,DIR,K,WR,L,DISK); - END; - EOB:=1; - IF M GTR 0 THEN N:=WR(DISK,N,B); - IF K GTR 0 THEN L:=WR(DISK,L,DIR); - LOCK(DISK); - END; -BOOLEAN PROCEDURE LIBNAMES(A,B); REAL A,B; -BEGIN REAL T; - A:=B:=GT1:=0; -% -% - IF SCAN AND IDENT THEN + M:=M+2; + IF M GEQ WDSPERREC-1 THEN % FULL RECORD + BEGIN + L:=WR(D,L,B); + IF M GEQ WDSPERREC THEN % 1 OVER FULL RECORD + + BEGIN + TRANSFER(U,8,B,0,8); + M:=1; + END + ELSE M:=D; + END; + END OF MOVETWO; + INTEGER H,Q,M,N,I,L,S,J,K,LINE,MAX,PT,SQ,C,LEN,W; + REAL LSD,STP; + LABEL SKIP; + ARRAY T,U[0:1],DIR,B,SEX[0:WDSPERREC]; + N:=LIBSPACES+ENTIER((S:=SIZE(VARIABLES))|2/(WDSPERREC-1)); 08015575P77 + IF (S|) MOD (WDSPERREC-1) NEQ 0 THEN N:=N+1; % ADJUST + LEN:=(WDSPERREC-1)|8; + FILLS DISK WITH NAME1,NAME2; + DIR[0]:=S; % SIZE OF SYMBOL TABLE + IF BOOLEAN (LOCKFILE) THEN DIR[1]:=JOBNUM; + S:=S-1; + L:=WR(DISK,L,DIR); % FIRST LINE CONTAINS # OF ENTRIES IN + COMMENT SYMBOL TABLE AND LOCK INFORMATION; + FOR I:=0 STEP 1 UNTIL 5 DO + BEGIN + J:=CONTENTS(VARIABLES,T,T); % RETURNS VALUE OF I-TH LOC + % IN VARIABLES INTO T + IF GT2:=GETFIELD(T,7,1)=FUNCTION THEN + BEGIN + PT:=GETFIELD(T,FPTF,FFL); % FUNCTION POINTER FIELD + SQ:=GETFIELD(T,FSQF,FFL); % FUNCTION SEQUENTIAL FIELD + %PT=# OF ORDERED STORAGE UNIT CONTAINING HEADER&POINTE + %SQ=# OF SEQ STORAGE UNIT CPONTAINING TEXT + MAX:=SIZE(PT); + T[1].LIBF1:=N; % RECORD # + T[1].LIBF2:=M; % LOC WITHIN RECORD + T[1].LIBF3:=MAX; % SIZE OF POINTERS TABLE; + % SAVE ENOUGH ROOM FOR THE ENTIRE POINTERS TABLE + H:=ENTIER(GT1:=(M+MAX|2)/(WDSPERREC-1)); + H:=IF GT1 NEQ H THEN H+N+1 ELSE H+N; + U[0]:=0; + J:=SEARCHORD(PT,U,LINE,8); % LOOK FOR ALL ZEROS + IF J=2 THEN GO SKIP; + FOR W:=0 STEP 1 UNTIL LINE-1 DO + %MOVE LOCALS AND LABELS INTO THE SAVE FILE + BEGIN + J:=CONTENTS(PT,W,U); + MOVETWO(U,B,M,WR,N,DISK); + END; + FOR LINE:=LINE STEP 1 UNTIL MAX-1 DO + BEGIN + + J:=CONTENTS(PT,LINE,U); + GT1:=U[1]; + U[1]:=LINE-W; + MOVETWO(U,B,M,WR,N,DISK); % POINTERS TABLE + J:=CONTENTS(SQ,GT1,BUFFER); + PUTAWAY(C,J,WR,DISK,H,Q,SEX,LEN); % TEXT + END; + PUTAWAY(C,0,WR,DISK,H,Q,SEX,LEN); + SKIP: + Q:=C DIV 8; + IF C MOD 8 NEQ 0 THEN Q:=Q+1; + IF Q=WDSPERREC-1 THEN + BEGIN + H:=WR(DISK,H,SEX); + Q:=0; + END; + IF M GTR 0 THEN N:=WR(DISK,N,B); + M:=Q; N:=H; + TRANSFER(SEX,0,B,0,C); % MOVE BACK TO B + C:=0; + END + ELSE + BEGIN + T[1].INPTR:=N; T[1].DIMPTR:=M; + C:=M|8; + J:=CONTENTS(WS,LSD,DIMPTR,BUFFER); % DIM VECT + PUTAWAY(C,J,WR,DISK,N,M,B,LEN); % STD DIM VECT + J:=CONTENTS(WS,LSD,INPTR,DIMVECT); + TRANSFER(DIMVECT,0,BUFFER,0,J); + PUTAWAY(C,J,WR,DISK,N,M,B,LEN); + J:=J-1; + FOR LINE:=0 STEP 2 UNTIL J DO + BEGIN + PT:=GETFIELD(DIMVECT,LINE,2); + STP:=CONTENTS(WS,PT,BUFFER); + PUTAWAY(C,STP,WR,DISK,N,M,B,LEN); + END; + M:=C DIV A; IF C MOD A NEQ 0 THEN M:=M+1; C:=0; + IF M=WDSPERREC-1 THEN BEGIN N:=WR(DISK,N,8); + M:=0; END; 08015888P78 + END; + END; + MOVETWO(T,DIR,K,WR,L,DISK); + END; + + EOB:=1; + IF M GTR 0 THEN N:=WR(DISK,N,B); + IF K GTR 0 THEN L:=WR(DISK,L,DIR); + LOCK(DISK); + END; +BOOLEAN PROCEDURE LIBNAMES(A,B); REAL A,B; +BEGIN REAL T; + A:=B:=GT1:=0; +% +% + IF SCAN AND IDENT THEN BEGIN T~ACCUM[0]; T.[6:6]~"/"; IF SCAN AND LOCKIT THEN GT1~1 ELSE IF IDENT THEN LIBNAMES~TRUE; A~T; B~ JOBNUM; - END + END ELSE LIBNAMES~ TRUE; - END; -PROCEDURE MESSAGEHANDLER; - BEGIN - LABEL ERR1; -% - IF SCAN THEN IF IDENT THEN - BEGIN INTEGER I; REAL R,S; - PROCEDURE NOFILEPRESENT; - BEGIN - FILL BUFFER[*] WITH "FILE NOT", " ON DISK"; - FORMROW(3,0,BUFFER,0,16); - END OF NOFILEPRESENT; - PROCEDURE PRINTF(VARS); VALUE VARS; BOOLEAN VARS; - BEGIN INTEGER I,J,K,L,M; ARRAY T[0:1]; BOOLEAN TOG; - INTEGER NUM; - J:=VARSIZE-1; M:=VARIABLES; - FOR I:=0 STEP 1 UNTIL N DO - BEGIN L:=CONTENTS(M,I,T); TOG:=GETFIELD(T,7,1) - =FUNCTION; + END; +PROCEDURE MESSAGEHANDLER; + BEGIN + LABEL ERR1; +% + IF SCAN THEN IF IDENT THEN + BEGIN INTEGER I; REAL R,S; + PROCEDURE NOFILEPRESENT; + BEGIN + FILL BUFFER[*] WITH "FILE NOT", " ON DISK"; + FORMROW(3,0,BUFFER,0,16); + END OF NOFILEPRESENT; + PROCEDURE PRINTF(VARS); VALUE VARS; BOOLEAN VARS; + BEGIN INTEGER I,J,K,L,M; ARRAY T[0:1]; BOOLEAN TOG; + INTEGER NUM; + J:=VARSIZE-1; M:=VARIABLES; + FOR I:=0 STEP 1 UNTIL N DO + BEGIN L:=CONTENTS(M,I,T); TOG:=GETFIELD(T,7,1) + =FUNCTION; IF NUM:=3|REAL(TOG AND VARS)+8+NUM GTR LINESIZE THEN BEGIN TERPRINT; NUM:=8|READL(TOG AND VARS)+8 END; - IF VARS THEN - BEGIN FORMROW(0,1,T,0,7); L:=L+1; - IF TOG THEN FORMWRD(0,"3(F) "); - END ELSE - IF TOG THEN BEGIN L:=L+1; FORMROW(0,1,T,0,7) END; - END; - IF L=0 THEN FORMWD(3,"6 NULL.") ELSE TERPRINT - END; - R:=ACCUM[0]; - FOR I:=0 STEP 1 UNTIL MAXMESS DO - IF R=MESSTAB[I] THEN - BEGIN R:=I; I:=MAXMESS+1 - END; - IF I=MAXMESS+2 THEN - CASE R OF - BEGIN - % ------- SAVE ------- - IF NOT LIBNAMES(R,S) THEN - IF NOT LIBRARIAN(R,S) THEN BEGIN - SAVEWORKSPACE(R,S,GT1); %GT1 SET IN LIBNAMES + IF VARS THEN + BEGIN FORMROW(0,1,T,0,7); L:=L+1; + IF TOG THEN FORMWRD(0,"3(F) "); + END ELSE + IF TOG THEN BEGIN L:=L+1; FORMROW(0,1,T,0,7) END; + END; + IF L=0 THEN FORMWD(3,"6 NULL.") ELSE TERPRINT + END; + R:=ACCUM[0]; + FOR I:=0 STEP 1 UNTIL MAXMESS DO + IF R=MESSTAB[I] THEN + BEGIN R:=I; I:=MAXMESS+1 + END; + IF I=MAXMESS+2 THEN + CASE R OF + BEGIN + % ------- SAVE ------- + IF NOT LIBNAMES(R,S) THEN + IF NOT LIBRARIAN(R,S) THEN BEGIN + SAVEWORKSPACE(R,S,GT1); %GT1 SET IN LIBNAMES GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7); IF(GT1~SEARCHORD(LIBRARY,GTA, I, 7)) NEQ 0 THEN BEGIN GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7); STOREORD(LIBRARY,GTA,I+(IF GT1=1 THEN -1 ELSE 1)); END; LIBSIZE~LIBSIZE+1; - END - ELSE - BEGIN - FILL BUFFER[*] WITH "FILE ALR","EADY ON ", - "DISK "; - FORMROW(3,0,BUFFER,0,20); - END - ELSE GO ERR1; - % ------- LOAD ------- - IF NOT LIBNAMES(R,S) AND R NEQ 0 THEN - IF LIBRARIAN(R,S) THEN - BEGIN ARRAYA[0:1]; - LOADWORKSPACE(R,S,A); - END - ELSE NOFILEPRESENT - ELSE GO ERR1; 0801626? P79 - % ------- DROP ------- - IF CURRENTMODE=CALCMODE THEN - IF NOT LIBNAME(R,S) THEN - IF LIBRARIAN(R,S) THEN - BEGIN FILE ELIF DISK (1,1); - FILL ELIF WITH R,S; WRITE(ELIF[0]); - CLOSE(ELIF,PURGE) + END + ELSE + BEGIN + FILL BUFFER[*] WITH "FILE ALR","EADY ON ", + "DISK "; + FORMROW(3,0,BUFFER,0,20); + END + ELSE GO ERR1; + % ------- LOAD ------- + IF NOT LIBNAMES(R,S) AND R NEQ 0 THEN + IF LIBRARIAN(R,S) THEN + BEGIN ARRAYA[0:1]; + LOADWORKSPACE(R,S,A); + END + ELSE NOFILEPRESENT + ELSE GO ERR1; 0801626?P79 + % ------- DROP ------- + IF CURRENTMODE=CALCMODE THEN + IF NOT LIBNAME(R,S) THEN + IF LIBRARIAN(R,S) THEN + BEGIN FILE ELIF DISK (1,1); + FILL ELIF WITH R,S; WRITE(ELIF[0]); + CLOSE(ELIF,PURGE) ;GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7); - IF SEARCHORD(LIBRARY,GTA,I,7)=0 THEN DELETE1(LIBRARY,I); + IF SEARCHORD(LIBRARY,GTA,I,7)=0 THEN DELETE1(LIBRARY,I); LIBSIZE~LIBSIZE-1; - END - ELSE NOFILEPRESENT - ELSE - IF NOT BOOLEAN(SUSPENSION)THEN PURGEWORKSPACE(WORKSPACE) - ELSE GO ERR1 ELSE GO ERR1; - % ------- COPY ------- - IF LIBNAMES(R,S) THEN - IF LIBRARIAN(R,S) THEN - LOADWORKSPCE(R,S,ACCUM) - ELSE NOFILEPRESENT - ELSE GO ERR1; - - % -------- VARS ------- - PRINTID(TRUE); - %------- FNS ------- - PRINTID(FALSE); - %-------- LOGGED ---------------- -; - %-------- MSG -------- - ERRORMESS(SYNTAXERROR,LADDRESS,0); - %-----WIDTH (INTEGER) --------------------------- - IF NOT SCAN THEN BEGIN NUMBERCON(LINSIZE, ACCUM); - FORMROW(3,0,ACCUM,2,ACOUNT); END - ELSE IF NUMERIC AND I:=ACCUM[0] GTR 9 AND I LEQ 72 - THEN BEGIN TERPRINT; LINESIZE:=I; STOREPSR; - END - %IF A NUMBER CONVERSION ERROR, RESULT WILL BE ZERO - %AND WE"LL GET AN ERROR ANYWAY - ELSE GO TO ERR1; - %-------- OPR -------- - ; - %------DIGITS (INTEGER) ------------------------ - IF NOT SCAN THEN BEGIN NUMBERCON(DIGITS,ACCUM); - FORMROW(3,0,ACCUM,2,ACOUNT); END - ELSE IF NUMERIC AND I:=ACCUM[0] GEQ 0 AND I LEQ 12 - AND ERR=0 THEN BEGIN DIGITS:=I; STOREPSR END - ELSE GO TO ERR1; - %-------- OFF -------- - BEGIN - IF SCAN THEN IF ACCUM[0]="7DISCAR" THEN - ELTMWORKSPACE(WORKSPACE) ELSE - GO TO ERR1; - FILL ACCUM[*] WITH "END OF R","UN "; - FORMROW(3,MARGINSIZE,ACCUM,0,10); - CURRENTMODE=CALCMODE; - GT1:=CSTATION; - CSTATION:=GT1&0[CAPLOGGED] - ;GO TO FINIS; - END; - %--------ORIGIN---------------------------------- - IF NO SCAN THEN BEGIN NUMBERCON(ORIGIN,ACCUM); - FORMROW(3,0,ACCUM,2,ACOUNT) END - ELSE IF NUMERIC AND ERR=0 THEN BEGIN ORIGIN:= - I:=ACCUM[0]; STOREPSR END ELSE GO TO ERR1; - %--------SEED--------------------------------- - IF NOT SCAN THEN BEGIN NUMBERCON(SEED,ACCUM); - FORMROW(3,0,ACCUM,2,ACOUNT) END - ELSE IF NUMERIC AND ERR=0 THEN BEGIN - SEED:=ABS(I:=ACCUM[0]); - STOREPSR END ELSE GO TO ERR1; - %--------FUZZ------------------------------------ - IF NOT SCAN THEN BEGIN - NUMBERCRON(FUZZ,ACCUM); - FORMROW(3,0,ACCUM,2,ACOUNT) END - ELSE IF NUMERIC AND ERR=0 THEN BEGIN FUZZ:=ABS(ACCUM[0]); - SIDREPSR END ELSE GO TO ERR1; - %------- SYN, NOSYN------------------------------------- - NOSYNTAX:=0; NOSYNTAX:=1; - %-----------------STORE------------------------- - IF SYMBASE NEQ 0 THEN PROCESS(WRITEBACK); - 08017970 P80 - %-----------------ABORT------------------------- - BEGIN IF BOOLEAN(SUSPENSION) THEN - SP[0,0]:=0; NROWS:=-1; -%%% - SUSPENSION:=0; - STOREPSR; - END; - %-----------------SI------------------------------ - IF BOOLEAN(SUSPENSION) THEN - BEGIN GT1:=0; - PROCESS(LOOKATSTACK); - END ELSE FORMWD(3,"6 NULL."); - %------------------SIV------------------------------ - IF BOOLEAN(SUSPENSION) THEN - BEGIN GIT1:=1; - PROCESS(LOOKATSTACK); - END ELSE FORMWD(3,"6 NULL."); - %------------------ERASE------------------------------ - IF CURRENTMODE=FUNCMODE OR BOOLEAN(SUSPENSION) THEN GO TO ERR1; - ELSE WHILE SCAN AND IDENT DO - BEGIN % LOOK FOR THE INDENTIFIER NAME IN ACCUM - TRANSFER(ACCUM,2,GTA,0,7); - IF (IF VARIABLES=0 THEN FALSE ELSE - SEARCHWORD(VARIABLES,GTA,GT1,7)=0) THEN - BEGIN % FOUND SYMBOL TABLE ENTRY MATCHING NAME - DELETE1(VARIABLES,GT1); % REMOVE FROM SYMBOL TABLE - IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0; - COMMENT IF NOTHING IS IN THE UNIT IT IS DELETED; - - % CHECK IF THERE ARE MORE TO DELETE - IF GT1:=GETFIELD(GTA,7,1)=FUNCTION THEN - BEGIN - RELEASEUNIT(GETFIELD(GTA,FPTF,FFL)); - RELEASEUNIT(GETFIELD(GTA,FSQF,FFL)); - END - ELSE IF GT1 GTR 0 THEN % MUST BE AN ARRAY - RELEASEARRAY(GTA[1]); - END ELSE % THERE IS NO SUCH VARIABLE - ERRORMESS(LABELERROR,LADDRESS,0); - END; % OF TAKING CARE OF ERASE - %------------ ASSIGN -------------------------------- -; - %------------ DELETE --------------------------------- -; - %------------- LIST ------------------------------------ -; - % -------------DEGUG -------------------------------- - IF SCAN AND IDENT THEN - IF ACCUM[0]="6POLISH" THEN POLBUG:=ABS(POLBUG-1); - - %----------------------------- FILES ---------------------- - IF LIBSIZE>1 THEN + END + ELSE NOFILEPRESENT + ELSE + IF NOT BOOLEAN(SUSPENSION)THEN PURGEWORKSPACE(WORKSPACE) + ELSE GO ERR1 ELSE GO ERR1; + % ------- COPY ------- + IF LIBNAMES(R,S) THEN + IF LIBRARIAN(R,S) THEN + LOADWORKSPCE(R,S,ACCUM) + ELSE NOFILEPRESENT + ELSE GO ERR1; + + % -------- VARS ------- + PRINTID(TRUE); + %------- FNS ------- + PRINTID(FALSE); + %-------- LOGGED ---------------- +; + %-------- MSG -------- + ERRORMESS(SYNTAXERROR,LADDRESS,0); + %-----WIDTH (INTEGER) --------------------------- + IF NOT SCAN THEN BEGIN NUMBERCON(LINSIZE, ACCUM); + FORMROW(3,0,ACCUM,2,ACOUNT); END + ELSE IF NUMERIC AND I:=ACCUM[0] GTR 9 AND I LEQ 72 + THEN BEGIN TERPRINT; LINESIZE:=I; STOREPSR; + END + %IF A NUMBER CONVERSION ERROR, RESULT WILL BE ZERO + %AND WE"LL GET AN ERROR ANYWAY + ELSE GO TO ERR1; + %-------- OPR -------- + ; + %------DIGITS (INTEGER) ------------------------ + IF NOT SCAN THEN BEGIN NUMBERCON(DIGITS,ACCUM); + FORMROW(3,0,ACCUM,2,ACOUNT); END + ELSE IF NUMERIC AND I:=ACCUM[0] GEQ 0 AND I LEQ 12 + AND ERR=0 THEN BEGIN DIGITS:=I; STOREPSR END + ELSE GO TO ERR1; + %-------- OFF -------- + BEGIN + IF SCAN THEN IF ACCUM[0]="7DISCAR" THEN + ELTMWORKSPACE(WORKSPACE) ELSE + GO TO ERR1; + FILL ACCUM[*] WITH "END OF R","UN "; + FORMROW(3,MARGINSIZE,ACCUM,0,10); + CURRENTMODE=CALCMODE; + GT1:=CSTATION; + CSTATION:=GT1&0[CAPLOGGED] + ;GO TO FINIS; + END; + %--------ORIGIN---------------------------------- + IF NO SCAN THEN BEGIN NUMBERCON(ORIGIN,ACCUM); + FORMROW(3,0,ACCUM,2,ACOUNT) END + ELSE IF NUMERIC AND ERR=0 THEN BEGIN ORIGIN:= + I:=ACCUM[0]; STOREPSR END ELSE GO TO ERR1; + %--------SEED--------------------------------- + IF NOT SCAN THEN BEGIN NUMBERCON(SEED,ACCUM); + FORMROW(3,0,ACCUM,2,ACOUNT) END + ELSE IF NUMERIC AND ERR=0 THEN BEGIN + SEED:=ABS(I:=ACCUM[0]); + STOREPSR END ELSE GO TO ERR1; + %--------FUZZ------------------------------------ + IF NOT SCAN THEN BEGIN + NUMBERCRON(FUZZ,ACCUM); + FORMROW(3,0,ACCUM,2,ACOUNT) END + ELSE IF NUMERIC AND ERR=0 THEN BEGIN FUZZ:=ABS(ACCUM[0]); + SIDREPSR END ELSE GO TO ERR1; + %------- SYN, NOSYN------------------------------------- + NOSYNTAX:=0; NOSYNTAX:=1; + %-----------------STORE------------------------- + IF SYMBASE NEQ 0 THEN PROCESS(WRITEBACK); + 08017970P80 + %-----------------ABORT------------------------- + BEGIN IF BOOLEAN(SUSPENSION) THEN + SP[0,0]:=0; NROWS:=-1; +%%% + SUSPENSION:=0; + STOREPSR; + END; + %-----------------SI------------------------------ + IF BOOLEAN(SUSPENSION) THEN + BEGIN GT1:=0; + PROCESS(LOOKATSTACK); + END ELSE FORMWD(3,"6 NULL."); + %------------------SIV------------------------------ + IF BOOLEAN(SUSPENSION) THEN + BEGIN GIT1:=1; + PROCESS(LOOKATSTACK); + END ELSE FORMWD(3,"6 NULL."); + %------------------ERASE------------------------------ + IF CURRENTMODE=FUNCMODE OR BOOLEAN(SUSPENSION) THEN GO TO ERR1 + ELSE WHILE SCAN AND IDENT DO + BEGIN % LOOK FOR THE INDENTIFIER NAME IN ACCUM + TRANSFER(ACCUM,2,GTA,0,7); + IF (IF VARIABLES=0 THEN FALSE ELSE + SEARCHWORD(VARIABLES,GTA,GT1,7)=0) THEN + BEGIN % FOUND SYMBOL TABLE ENTRY MATCHING NAME + DELETE1(VARIABLES,GT1); % REMOVE FROM SYMBOL TABLE + IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0; + COMMENT IF NOTHING IS IN THE UNIT IT IS DELETED; + + % CHECK IF THERE ARE MORE TO DELETE + IF GT1:=GETFIELD(GTA,7,1)=FUNCTION THEN + BEGIN + RELEASEUNIT(GETFIELD(GTA,FPTF,FFL)); + RELEASEUNIT(GETFIELD(GTA,FSQF,FFL)); + END + ELSE IF GT1 GTR 0 THEN % MUST BE AN ARRAY + RELEASEARRAY(GTA[1]); + END ELSE % THERE IS NO SUCH VARIABLE + ERRORMESS(LABELERROR,LADDRESS,0); + END; % OF TAKING CARE OF ERASE + %------------ ASSIGN -------------------------------- +; + %------------ DELETE --------------------------------- +; + %------------- LIST ------------------------------------ +; + % -------------DEGUG -------------------------------- + IF SCAN AND IDENT THEN + IF ACCUM[0]="6POLISH" THEN POLBUG:=ABS(POLBUG-1); + + %----------------------------- FILES ---------------------- + IF LIBSIZE>1 THEN BEGIN FOR I~1 STEP 1 UNTIL LINSIZE-1 DO BEGIN R~CONTENTS(LIBRARY,I ,ACCUM); - FORMROW(0,1,ACCUM,2,6); - END; TERPRINT; - END ELSE FORMWD(3,"6 NULL."); - %------------------------ END OF CASES ----------------------- - END ELSE GO TO ERR1; - IF CURRENTMODE=FUNCMODE THEN INDENT(-CURLINE); - END ELSE - IF QUOTE THEN EDITLINE ELSE - ERR1: ERRORMESS(SYNTAXERROR,0,0); - INDENT(0); - TERPRINT; - END; -REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R; - BEGIN - REAL STREAM PROCEDURE CON(R); VALUE R; - BEGIN SI:=LOC R; DI:=LOC CON; DS:=DEC - END; + FORMROW(0,1,ACCUM,2,6); + END; TERPRINT; + END ELSE FORMWD(3,"6 NULL."); + %------------------------ END OF CASES ----------------------- + END ELSE GO TO ERR1; + IF CURRENTMODE=FUNCMODE THEN INDENT(-CURLINE); + END ELSE + IF QUOTE THEN EDITLINE ELSE + ERR1: ERRORMESS(SYNTAXERROR,0,0); + INDENT(0); + TERPRINT; + END; +REAL PROCEDURE LINENUMBER(R); VALUE R; REAL R; + BEGIN + REAL STREAM PROCEDURE CON(R); VALUE R; + BEGIN SI:=LOC R; DI:=LOC CON; DS:=DEC + END; LINENUMBER:=CON(ENTIER(R+.00005)|10000)) - END; -DEFINE DELIM="""#, ENDCHR="$"#; -BOOLEAN PROCEDURE WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD); - VALUE COMMAND,CHAR,WORD; INTEGER COMMAND,CHAR,WORD; - ARRAY OLD, NEWEDIT; BEGIN -BOOLEAN STREAM PROCEDURE WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD); - VALUE COMMAND,CHAR.WORD; - BEGIN - LOCAL OLDLINE,NEWLINE,F,BCHR; - LOCAL N,M,T; - LOCAL X,Y,Z; 080301?? P81 - LABEL LOOKING,FOUND,BETWEEN,TAIL,FINISH, - OVER; - DI:=NEW; WORD(DS:=BLIT" "); - SI:=LOC CHAR; DI:=LOC T; DI:=DI+1; DS:=7CHR; - SI:=COMMAND; - TALLY:=T; X:=TALLY; TALLY:=2; Y:=TALLY; TALLY:=32; Z:=TALLY; - TALLY:=0; + END; +DEFINE DELIM="""#, ENDCHR="$"#; +BOOLEAN PROCEDURE WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD); + VALUE COMMAND,CHAR,WORD; INTEGER COMMAND,CHAR,WORD; + ARRAY OLD, NEWEDIT; BEGIN +BOOLEAN STREAM PROCEDURE WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD); + VALUE COMMAND,CHAR.WORD; + BEGIN + LOCAL OLDLINE,NEWLINE,F,BCHR; + LOCAL N,M,T; + LOCAL X,Y,Z; 080301??P81 + LABEL LOOKING,FOUND,BETWEEN,TAIL,FINISH, + OVER; + DI:=NEW; WORD(DS:=BLIT" "); + SI:=LOC CHAR; DI:=LOC T; DI:=DI+1; DS:=7CHR; + SI:=COMMAND; + TALLY:=T; X:=TALLY; TALLY:=2; Y:=TALLY; TALLY:=32; Z:=TALLY; + TALLY:=0; IF SC!"~" THEN - BEGIN RCHR:=SI; SI:=OLD; OLDLINE:=SI; - DI:=NEW; NEWLINE:=DI; SI:=RCHR; - 63(IF SC=DELIM THEN JUMP OUT ELSE SI:=SI+1; TALLY - :=TALLY+1); N:=TALLY; - IF TOGGLE THEN - BEGIN - SI:=SI+1; TALLY:=0; - 63(IF SC=DELIM THEN TALLY:=0 ELSE - IF SC="~" THEN JUMP OUT ELSE TALLY:=TALLY+1; SI:=SI+1); - IF TOGGLE THEN M:=TALLY;; - DI:=OLDLINE; SI:=RCHR; - 2( X( Y( Z( CI:=CI+F; - GO LOOKING; GO FOUND; GO BETWEEN; GO TAIL; GO FINISH; -LOOKING: %************ LOOKING FOR THE FIRST UNIQUE STRING************* - IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; F:= TALLY ; - DI:=NEWLINE; GO BETWEEN END ELSE - IF N SC=DC THEN BEGIN SI:=OLDLINE; SI:=SI+N; OLDLINE:=SI; - DI:=NELINE; SI:=BCHR; TALLY:=1; F:=TALLY; - GO FOUND END ELSE - BEGIN SI:=OLDLINE; DI:=NEWLINE; DS:=CHR; NEWJLINE:=DI; - OLDLINE:=SI; SI:=BCHR; DI:=OLDLINE; - END; GO OVER; -FOUND: %**************FOUND THE FIRST UNIQUE STRING ***************** - IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; - F:=TALLY; GO BETWEEN END ELSE - DS:=CHR; GO OVER; -BETWEEN: % ********** BETWEEN THEN // ******************************** - IF SC=DELIM THEN BEGIN SI:=SI+1; NEWLINE:=DI; DI:=OLDLINE; - TALLY:=3; F:=TALLY; GO TAIL END ELSE - IF SC="~" THEN BEGIN TALLY:=4; F:=TALLY; - SI:=OLDLINE; GO FINWISH END ELSE - DS:=CHR; GO OVER; -TAIL: % ******* THE TAIL END OF THE COMMAND ************************** - IF M SC=DC THEN BEGIN DI:=NEWLINE; SI:=OLDLINE; TALLY:=4; - F:=TALLY; GO FINISH END ELSE - BEGIN SI:=SI-M; DI:=DI-M; DI:=DI+1; OLDLINE:=DI; END; - GO OVER; -FINISH: % ********FINISH UP THE CHAR MOVE FROM OLD TO NEW************ - DS:=CHR; OVER:))); - TALLY:=CHAR; X:=TALLY; TALLY:=1; Y:=TALLY; - Z:=TALLY); - SI:=NEW; DI:=OLD; DS:=WORD WDS; TALLY:=1; - WITHINLINE:=TALLY; - END - END - END OF WITHINALINE; - WITHINALINE := WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD); - END OF PHONY WITHINALINE; -PROCEDURE EDITLINE; - BEGIN ARRAY T[0:MAXBUFFSIZE]; - INITBUFF(T,BUFFSIZE); - TRANSFER(OLDBUFFER,0,T,0,LENGTH(OLDBUFFER,TRUE)); + BEGIN RCHR:=SI; SI:=OLD; OLDLINE:=SI; + DI:=NEW; NEWLINE:=DI; SI:=RCHR; + 63(IF SC=DELIM THEN JUMP OUT ELSE SI:=SI+1; TALLY + :=TALLY+1); N:=TALLY; + IF TOGGLE THEN + BEGIN + SI:=SI+1; TALLY:=0; + 63(IF SC=DELIM THEN TALLY:=0 ELSE + IF SC="~" THEN JUMP OUT ELSE TALLY:=TALLY+1; SI:=SI+1); + IF TOGGLE THEN M:=TALLY;; + DI:=OLDLINE; SI:=RCHR; + 2( X( Y( Z( CI:=CI+F; + GO LOOKING; GO FOUND; GO BETWEEN; GO TAIL; GO FINISH; +LOOKING: %************ LOOKING FOR THE FIRST UNIQUE STRING************** + IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; F:= TALLY ; + DI:=NEWLINE; GO BETWEEN END ELSE + IF N SC=DC THEN BEGIN SI:=OLDLINE; SI:=SI+N; OLDLINE:=SI; + DI:=NELINE; SI:=BCHR; TALLY:=1; F:=TALLY; + GO FOUND END ELSE + BEGIN SI:=OLDLINE; DI:=NEWLINE; DS:=CHR; NEWLINE:=DI; + OLDLINE:=SI; SI:=BCHR; DI:=OLDLINE; + END; GO OVER; +FOUND: %**************FOUND THE FIRST UNIQUE STRING ****************** + IF SC=DELIM THEN BEGIN SI:=SI+1; TALLY:=2; + F:=TALLY; GO BETWEEN END ELSE + DS:=CHR; GO OVER; +BETWEEN: % ********** BETWEEN THEN // ********************************* + IF SC=DELIM THEN BEGIN SI:=SI+1; NEWLINE:=DI; DI:=OLDLINE; + TALLY:=3; F:=TALLY; GO TAIL END ELSE + IF SC="~" THEN BEGIN TALLY:=4; F:=TALLY; + SI:=OLDLINE; GO FINWISH END ELSE + DS:=CHR; GO OVER; +TAIL: % ******* THE TAIL END OF THE COMMAND *************************** + IF M SC=DC THEN BEGIN DI:=NEWLINE; SI:=OLDLINE; TALLY:=4; + F:=TALLY; GO FINISH END ELSE + BEGIN SI:=SI-M; DI:=DI-M; DI:=DI+1; OLDLINE:=DI; END; + GO OVER; +FINISH: % ********FINISH UP THE CHAR MOVE FROM OLD TO NEW************* + DS:=CHR; OVER:))); + TALLY:=CHAR; X:=TALLY; TALLY:=1; Y:=TALLY; + Z:=TALLY); + SI:=NEW; DI:=OLD; DS:=WORD WDS; TALLY:=1; + WITHINLINE:=TALLY; + END + END + END OF WITHINALINE; + WITHINALINE := WITHINALINE(COMMAND,OLD,NEW,CHAR,WORD); + END OF PHONY WITHINALINE; +PROCEDURE EDITLINE; + BEGIN ARRAY T[0:MAXBUFFSIZE]; + INITBUFF(T,BUFFSIZE); + TRANSFER(OLDBUFFER,0,T,0,LENGTH(OLDBUFFER,TRUE)); IF WITHINALINE(ADDRESS,T,OLDBUFFER,BUFFSIZE|8,BUFFSIZE) THEN - BEGIN MOVEWDS(OLDBUFFER,BUFFSIZE,BUFFER); - - IF SCAN AND RGTPAREN THEN - ERRORMESS(SYNTAXERROR,LADDRESS,0) ELSE EDITOG:=1; - END; - - FORMROW(3,0,BUFFER,0,LENGTH(BUFFER,FALSE)); - END; -PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; - BEGIN - INTEGER I,J; + BEGIN MOVEWDS(OLDBUFFER,BUFFSIZE,BUFFER); + + IF SCAN AND RGTPAREN THEN + ERRORMESS(SYNTAXERROR,LADDRESS,0) ELSE EDITOG:=1; + END; + + FORMROW(3,0,BUFFER,0,LENGTH(BUFFER,FALSE)); + END; +PROCEDURE CHECKSEQ(SEQ,L,INC); REAL SEQ,L,INC; + BEGIN + INTEGER I,J; I:=L|10000 MOD 10000; - FOR J:=-4 STEP 1 WHILE J LSS 0 AND I MOD 10=0 DO - I:=I/10; - INC:=10*J; - SEQ:=L; - END; -PROCEDURE FUNCTIONHANDLER; - BEGIN - LABEL ENDHANDLER; - OWN BOOLEAN EDITMODE; 09003000 P82 - DEFINE FPT=FUNCPOINTER@, - FSQ=FUNCSEQ#, - SEQ=CURLINE#, - INC=INCREMENT#, - MODE=SPECMODE#, - ENDDEFINES=#; - INTEGER STREAM PROCEDURE DELPRESENT(ADDR); VALUE ADDR; - BEGIN LABEL L,FINIS; - LOCAL Q; - DI:=LOC Q; DS:=RESET; DS:=5SET; DS:=2RESET; DS:=2SET; - % LEFT-ARROW / QUESTION MARK - SI:=ADDR; - L: DI:=LOCQ; - IF SC=DELCHR THEN - BEGIN ADDR:=SI; SI:=LOC; DS:=ADDR; DS:=LIT" "; - TALLY:=1; DELPRESENT:=TALLY; GO TO FINIS; - END; - IF SC=DC THEN GO TO FINIS; SI:=SI-1; - IF SC=DC THEN GO TO FINIS; - GO TO SL; - FINIS: - END; -INTEGER PROCEDURE OLDLABCONFLICT(PT,S); VALUE PT,S; - INTEGER PT, REAL S; - IF PT NEQ 0 THEN - BEGIN INTEGER K; ARRAY L[0:1]; - ADDRESS:=ABSOLUTEADDRESS; - WHILE LABELSCAN(L,0) AND ERR EQL 0 DO - IF SEARCHORD(PT,L,K,8)=0 THEN - IF L[1] NEQ S THEN ERR:=24; - OLDLABELCONFLICT:=ERR - END; -INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; INTEGER PT, - SQ,L; FORWARD; -INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; - INTEGER PT,SQ; REAL SEQ; ARRAY B[0]; FORWARD; - PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE, - ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0]; - FORWARD; COMMENT THIS IS A PHONEY DEAL, BUT I CAN"T - DECLARE CLEANBUFFER FORWARD (MOVE IT UP HERE LATER); -PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K; - INTEGER PT,SQ,I,K; - BEGIN ARRAY C,LAB[0:1],OLD,NEW[0:MAXBUFFSIZE]; - STREAM PROCEDURE BL(A); - BEGIN DI:=A; MAXBUFFSIZE(DS:=8LIT" ") END; - DEFINE MOVE=MOVEWDS#; - REAL T,SEQ; INTEGER A,B,L,H; - T:=ADDRESS; - FOR A:=I STEP 1 WHILE A LEQ K AND EDITMODE DO - BEGIN B:=CONTENTS(PT,A,C); BL(OLD); - SEQ:=C[0]; - B:=CONTENTS(SQ,C[1],OLD); + FOR J:=-4 STEP 1 WHILE J LSS 0 AND I MOD 10=0 DO + I:=I/10; + INC:=10*J; + SEQ:=L; + END; +PROCEDURE FUNCTIONHANDLER; + BEGIN + LABEL ENDHANDLER; + OWN BOOLEAN EDITMODE; 09003000P82 + DEFINE FPT=FUNCPOINTER@, + FSQ=FUNCSEQ#, + SEQ=CURLINE#, + INC=INCREMENT#, + MODE=SPECMODE#, + ENDDEFINES=#; + INTEGER STREAM PROCEDURE DELPRESENT(ADDR); VALUE ADDR; + BEGIN LABEL L,FINIS; + LOCAL Q; + DI:=LOC Q; DS:=RESET; DS:=5SET; DS:=2RESET; DS:=2SET; + % LEFT-ARROW / QUESTION MARK + SI:=ADDR; + L: DI:=LOCQ; + IF SC=DELCHR THEN + BEGIN ADDR:=SI; SI:=LOC; DS:=ADDR; DS:=LIT" "; + TALLY:=1; DELPRESENT:=TALLY; GO TO FINIS; + END; + IF SC=DC THEN GO TO FINIS; SI:=SI-1; + IF SC=DC THEN GO TO FINIS; + GO TO SL; + FINIS: + END; +INTEGER PROCEDURE OLDLABCONFLICT(PT,S); VALUE PT,S; + INTEGER PT, REAL S; + IF PT NEQ 0 THEN + BEGIN INTEGER K; ARRAY L[0:1]; + ADDRESS:=ABSOLUTEADDRESS; + WHILE LABELSCAN(L,0) AND ERR EQL 0 DO + IF SEARCHORD(PT,L,K,8)=0 THEN + IF L[1] NEQ S THEN ERR:=24; + OLDLABELCONFLICT:=ERR + END; +INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; INTEGER PT, + SQ,L; FORWARD; +INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; + INTEGER PT,SQ; REAL SEQ; ARRAY B[0]; FORWARD; + PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE, + ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0]; + FORWARD; COMMENT THIS IS A PHONEY DEAL, BUT I CAN"T + DECLARE CLEANBUFFER FORWARD (MOVE IT UP HERE LATER); +PROCEDURE EDITDRIVER(PT,SQ,I,K); VALUE PT,SQ,I,K; + INTEGER PT,SQ,I,K; + BEGIN ARRAY C,LAB[0:1],OLD,NEW[0:MAXBUFFSIZE]; + STREAM PROCEDURE BL(A); + BEGIN DI:=A; MAXBUFFSIZE(DS:=8LIT" ") END; + DEFINE MOVE=MOVEWDS#; + REAL T,SEQ; INTEGER A,B,L,H; + T:=ADDRESS; + FOR A:=I STEP 1 WHILE A LEQ K AND EDITMODE DO + BEGIN B:=CONTENTS(PT,A,C); BL(OLD); + SEQ:=C[0]; + B:=CONTENTS(SQ,C[1],OLD); IF EDITMODE:=WITHINALINE(T,OLD,NEW,BUFFSIZE|8,BUFFSIZE) - THEN BEGIN MOVE(BUFFER,MAXBUFFSIZE+1,NEW); - MOVE(OLD,MAXBUFFSIZE,BUFFER); - IF EDITMODE:=ERR:=OLDLABELCONFICT(PT,C[0])=0 THEN - BEGIN B:=ELIMOLDLINE(PT,SQ,C[1]); - DELTOG:=DELPRESENT(ADDRESS); - DELETE1(SQ,C[1]); DELET1(PT,A+B); C[1]:= - STORESEQ(SQ,BUFFER,LENGTH(BUFFER,FALSE)); - STOREORD(PT,C,A+B); - RESCANLINE; L:=0; M:=1; LAB[1]L=C[0]; - WHILE LABELSCAN(C,0) DO - BEGIN MOVEWDS(C,1,LAB); - IF (IF FUNCSSIZE=0 THEN TRUE ELSE L:= - SEARCHWROD(PT,C,M,B)NEQ 0) THEN - BEGIN B:=B+1; FUNCSIZE:=FUNCSIZE+1; - STOREORD(PT,ALAR,L+M-1); - END END; - A:=A+B; K:=K+B; - COMMENT THE NEXT LINE CAUSE A SYSTEM CRASH AFTER THE EDIT - IF NOSYNTAX=0 THEN PROCESS(XEQUTE); - END END; - MOVE(NEW,MAXBUFFSIZE+1,BUFFER) - END END; - PROCEDURE LISTLINE(PT,SQ,I); VALUE PT,SQ,I; INTEGER PT,SQ,I; - BEGIN - GT1:=CONTENTS(PT,I,GTA); - INDENT(GTA[0]); - GT1:=CONTENTS(SQ,GTA[1],BUFFER); - CHRCOUNT:=CHRCOUNT-1; - FORMROW(1,0,BUFFER,0,GT1); - END; 090528?? P83 -INTEGER PROCEDURE DISPLAY(A,B,PT,SQ); VALUE A,B,PT,SQ; - INTEGER PT,SQ; REAL A,B; - IF A LEQ B AND FUNCSIZE NEQ 0 THEN - BEGIN - ARRAY C[0:1]; - INTEGER I,J,K; - DEFINE CLEANBUFFER=BUFFERCLEAN#; - A:=LINENUMBER(A); B:=LINENUMBER(B); - C[0]:=A; - I:=SEARCHORD(PT,C,K,8); - I:=( IF I=2 THEN IF K LSS FUNCSIZE-1 THEN K:=K+1 ELSE - K ELSE K); - IF A NEQ B THEN - BEGIN - C[0]:=B; B:=SEARCHORD(PT,C,K,8); - END; - IF EDITMODE THEN % MAY HAVE ONLY ONE LINE TO EDIT - IF I=K THEN - IF A NEQ 0 THEN %NOT EDITING THE HEADER - EDITDRIVER(PT,SQ,I,K); - ELSE %EDITING THE FUNCTION HEADER, FIX LATER. - ERR:=3; - ELSE %EDITING MORE THAN ONE LINE - BEGIN MODE:=EDITING; - IF A=0 THEN I:=I+1; - CLEANBUFFER(BUFFER,BUFFSIZE,ADDRESS); - MOVE(BUFFER,BUFFSIZE,OLDBUFFER); - LOWER:=I; UPPER:=K - END - ELSE %NOT EDITING, MUST BE A LIST - BEGIN - FORMWD(3,"1 "); - IF K=I THEN % LISTING A SINGLE LINE - BEGIN LISTLINE(PT,SQ,I); - FORMWD(3,"1 "); - END ELSE % LISTING A SET OF LINES - BEGIN MODE:=DISPLAYING; - LOWER:=I; UPPER:=K; - END; - END; - EOB:=1; - END ELSE DISPLAY:=20; -INTEGER PROCEDURE DELETE(A,B,PT,SQ); VALUE A,B; - INTEGER PT,SQ; REAL A,B; - IF A LEQ B AND FUNCSIZE NEQ 0 AND A NEQ Q THEN - BEGIN - INTEGER I,J,K,L; - ARRAY C[0:1]; - A:=LINENUMBER(B); - B:=LINENUMBER(B); - C[0]:=A; - IF SEARCHOR(PT,C,I,8)=1 THEN I:=I-1; - IF K GTR I OR I GEQ FUNCSIZE THEN DELETE:=21 ELSE - BEGIN - FOR J:=K STEP 1 UNTIL I DO - BEGIN A:=CONTENTS(PT,J,C); - L:=ELIMOLDLINE(PT,SQ,C[1]); - FUNCSIZE:=FUNCSIZE+L; I:=I+L; K:=K+L; J:=J+L; - DELETE1(SQ,C[1]) - END; - FUNCSIZE:=FUNCSIZE-(I-K+1) - ; EOF:=1; - DELETEN(PT,K,I); - IF FUNCSIZE=0 THEN - BEGIN - PT:=0; RESEASEUNIT(SQ); SQ:=0; - STOREPSR; - END; - END; - END ELSE DELETE:=22; - INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; - INTEGER PT,SQ,L; - BEGIN INTEGER K,J; - REAL AD; - ARRAY T[0:MAXBUFFERSIZE],LAB[0:1]; - AD:=ADDRESS; - MOVEWDS(BUFFER,MAXBUFFSIZE+1,T); - INITBUFF(BUFFER,BUFFSIZE); - K:=CONTENTS(SQ,L,BUFFER); - RESCANLINE; - WHILE LABELSCAN(LAB,0) DO 091240?? P84 - IF SEARCHORD(PT,LAB,K,8)=0 THEN - BEGIN DELETE1(PT,K); J:=J-1 END; - ADDRESS:=AD; - MOVEWDS(T,MAXBUFFSIZE+1,BUFFER); - ELIMOLDLINE:=J - END; -INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; - INTEGER PT,SQ; REAL SEQ; ARRAY B[0] - BEGIN DEFINE BUFFER=B#; - ARRAY C,LAB[0:1]; - INTEGER I,J,K,L; - BOOLEAN TOG; - SEQ:=LINENUMBER(SEQ); - C[0]:=SEQ; - IF TOG:=(PT=0 OR FUNCSIZE=0) THEN - BEGIN SEQUENTIAL(SQ:=NEXTUNIT); I:=0 - END ELSE - IF J:=SEARCHORD(PT,C,I,8)=0 THEN - BEGIN - K:=ELIMOLDLINE(PT,SQ,C[1]); - I:=J+K; FUNCSIZE:=FUNCSIZE+K; - DELETE1(PT,T); - FUNCSIZE:=FUNCSIZE-1; - DELETE1(SQ,C[1]); - END ELSE - I:=I+J-1; - RESCANLINE; - DELTOG:=DELPRESENT(ADDRESS); - K:=STORESEQ(SQ,BUFFER,LENGTH(BUFFER,TRUE)); - LAB[1]:=SEQ; L:=0; J:=1; - IF TOG THEN PT:=NEXTUNIT; - WHILE LABELSCAN(C,0) DO - BEGIN - MOVEWDS(C,1,LAB); - IF (IF FUNCSIZE=0 THEN TRUE ELSE L:= - SEARCHORD(PT,C,J,8)NEQ 0 ) THEN - BEGIN I:=I+1; FUNCSIZE:=FUNCSIZE+1; - STOREORD(PT,LAB,L+J-1); - END; - END; - C[1]:=K; - C[0]:=SEQ; - FUNCSIZE:=FUNCSIZE+1; - STQOREORD(PT,C,I); - IF TOG THEN STOREPSR; - EOD:=1; - END; - BOOLEAN PROCEDURE BOUND(PT); VALUE PT; INTEGER PT; - IF NOT(BOUND:=NUMERIC) THEN - IF INDENT AND FUNCSIZE GTR 0 THEN - BEGIN ARRAY L[0:1]; INTEGER K; - REAL T,U; - REAL STREAM PROCEDURE CON(A); - VALUE A; - BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT - END; - TRANSFER(ACCUM,2,L,1,7); - IF BOUND:=SEARCHORD(PT,L,K,8)=0 THEN - BEGIN T:=ADDRESS; - U:=CON(MAX(L[1],0))/10000; %ARGS AND RESULT ARE NEG - IF SCAN AND PLUS OR MINUS THEN - BEGIN K:=(IF PLUS THEN 1 ELSE -1); - IF SCAN AND NUMERIC THEN + THEN BEGIN MOVE(BUFFER,MAXBUFFSIZE+1,NEW); + MOVE(OLD,MAXBUFFSIZE,BUFFER); + IF EDITMODE:=ERR:=OLDLABELCONFICT(PT,C[0])=0 THEN + BEGIN B:=ELIMOLDLINE(PT,SQ,C[1]); + DELTOG:=DELPRESENT(ADDRESS); + DELETE1(SQ,C[1]); DELET1(PT,A+B); C[1]:= + STORESEQ(SQ,BUFFER,LENGTH(BUFFER,FALSE)); + STOREORD(PT,C,A+B); + RESCANLINE; L:=0; M:=1; LAB[1]L=C[0]; + WHILE LABELSCAN(C,0) DO + BEGIN MOVEWDS(C,1,LAB); + IF (IF FUNCSSIZE=0 THEN TRUE ELSE L:= + SEARCHWROD(PT,C,M,B)NEQ 0) THEN + BEGIN B:=B+1; FUNCSIZE:=FUNCSIZE+1; + STOREORD(PT,ALAR,L+M-1); + END END; + A:=A+B; K:=K+B; + COMMENT THE NEXT LINE CAUSE A SYSTEM CRASH AFTER THE EDIT + IF NOSYNTAX=0 THEN PROCESS(XEQUTE); + END END; + MOVE(NEW,MAXBUFFSIZE+1,BUFFER) + END END; + PROCEDURE LISTLINE(PT,SQ,I); VALUE PT,SQ,I; INTEGER PT,SQ,I; + BEGIN + GT1:=CONTENTS(PT,I,GTA); + INDENT(GTA[0]); + GT1:=CONTENTS(SQ,GTA[1],BUFFER); + CHRCOUNT:=CHRCOUNT-1; + FORMROW(1,0,BUFFER,0,GT1); + END; 090528??P83 +INTEGER PROCEDURE DISPLAY(A,B,PT,SQ); VALUE A,B,PT,SQ; + INTEGER PT,SQ; REAL A,B; + IF A LEQ B AND FUNCSIZE NEQ 0 THEN + BEGIN + ARRAY C[0:1]; + INTEGER I,J,K; + DEFINE CLEANBUFFER=BUFFERCLEAN#; + A:=LINENUMBER(A); B:=LINENUMBER(B); + C[0]:=A; + I:=SEARCHORD(PT,C,K,8); + I:=( IF I=2 THEN IF K LSS FUNCSIZE-1 THEN K:=K+1 ELSE + K ELSE K); + IF A NEQ B THEN + BEGIN + C[0]:=B; B:=SEARCHORD(PT,C,K,8); + END; + IF EDITMODE THEN % MAY HAVE ONLY ONE LINE TO EDIT + IF I=K THEN + IF A NEQ 0 THEN %NOT EDITING THE HEADER + EDITDRIVER(PT,SQ,I,K); + ELSE %EDITING THE FUNCTION HEADER, FIX LATER. + ERR:=3; + ELSE %EDITING MORE THAN ONE LINE + BEGIN MODE:=EDITING; + IF A=0 THEN I:=I+1; + CLEANBUFFER(BUFFER,BUFFSIZE,ADDRESS); + MOVE(BUFFER,BUFFSIZE,OLDBUFFER); + LOWER:=I; UPPER:=K + END + ELSE %NOT EDITING, MUST BE A LIST + BEGIN + FORMWD(3,"1 "); + IF K=I THEN % LISTING A SINGLE LINE + BEGIN LISTLINE(PT,SQ,I); + FORMWD(3,"1 "); + END ELSE % LISTING A SET OF LINES + BEGIN MODE:=DISPLAYING; + LOWER:=I; UPPER:=K; + END; + END; + EOB:=1; + END ELSE DISPLAY:=20; +INTEGER PROCEDURE DELETE(A,B,PT,SQ); VALUE A,B; + INTEGER PT,SQ; REAL A,B; + IF A LEQ B AND FUNCSIZE NEQ 0 AND A NEQ Q THEN + BEGIN + INTEGER I,J,K,L; + ARRAY C[0:1]; + A:=LINENUMBER(B); + B:=LINENUMBER(B); + C[0]:=A; + IF SEARCHOR(PT,C,I,8)=1 THEN I:=I-1; + IF K GTR I OR I GEQ FUNCSIZE THEN DELETE:=21 ELSE + BEGIN + FOR J:=K STEP 1 UNTIL I DO + BEGIN A:=CONTENTS(PT,J,C); + L:=ELIMOLDLINE(PT,SQ,C[1]); + FUNCSIZE:=FUNCSIZE+L; I:=I+L; K:=K+L; J:=J+L; + DELETE1(SQ,C[1]) + END; + FUNCSIZE:=FUNCSIZE-(I-K+1) + ; EOF:=1; + DELETEN(PT,K,I); + IF FUNCSIZE=0 THEN + BEGIN + PT:=0; RESEASEUNIT(SQ); SQ:=0; + STOREPSR; + END; + END; + END ELSE DELETE:=22; + INTEGER PROCEDURE ELIMOLDLINE(PT,SQ,L); VALUE PT,SQ,L; + INTEGER PT,SQ,L; + BEGIN INTEGER K,J; + REAL AD; + ARRAY T[0:MAXBUFFERSIZE],LAB[0:1]; + AD:=ADDRESS; + MOVEWDS(BUFFER,MAXBUFFSIZE+1,T); + INITBUFF(BUFFER,BUFFSIZE); + K:=CONTENTS(SQ,L,BUFFER); + RESCANLINE; + WHILE LABELSCAN(LAB,0) DO 091240??P84 + IF SEARCHORD(PT,LAB,K,8)=0 THEN + BEGIN DELETE1(PT,K); J:=J-1 END; + ADDRESS:=AD; + MOVEWDS(T,MAXBUFFSIZE+1,BUFFER); + ELIMOLDLINE:=J + END; +INTEGER PROCEDURE STOREAWAY(PT,SQ,B,SEQ); VALUE SEQ; + INTEGER PT,SQ; REAL SEQ; ARRAY B[0] + BEGIN DEFINE BUFFER=B#; + ARRAY C,LAB[0:1]; + INTEGER I,J,K,L; + BOOLEAN TOG; + SEQ:=LINENUMBER(SEQ); + C[0]:=SEQ; + IF TOG:=(PT=0 OR FUNCSIZE=0) THEN + BEGIN SEQUENTIAL(SQ:=NEXTUNIT); I:=0 + END ELSE + IF J:=SEARCHORD(PT,C,I,8)=0 THEN + BEGIN + K:=ELIMOLDLINE(PT,SQ,C[1]); + I:=J+K; FUNCSIZE:=FUNCSIZE+K; + DELETE1(PT,T); + FUNCSIZE:=FUNCSIZE-1; + DELETE1(SQ,C[1]); + END ELSE + I:=I+J-1; + RESCANLINE; + DELTOG:=DELPRESENT(ADDRESS); + K:=STORESEQ(SQ,BUFFER,LENGTH(BUFFER,TRUE)); + LAB[1]:=SEQ; L:=0; J:=1; + IF TOG THEN PT:=NEXTUNIT; + WHILE LABELSCAN(C,0) DO + BEGIN + MOVEWDS(C,1,LAB); + IF (IF FUNCSIZE=0 THEN TRUE ELSE L:= + SEARCHORD(PT,C,J,8)NEQ 0 ) THEN + BEGIN I:=I+1; FUNCSIZE:=FUNCSIZE+1; + STOREORD(PT,LAB,L+J-1); + END; + END; + C[1]:=K; + C[0]:=SEQ; + FUNCSIZE:=FUNCSIZE+1; + STQOREORD(PT,C,I); + IF TOG THEN STOREPSR; + EOD:=1; + END; + BOOLEAN PROCEDURE BOUND(PT); VALUE PT; INTEGER PT; + IF NOT(BOUND:=NUMERIC) THEN + IF INDENT AND FUNCSIZE GTR 0 THEN + BEGIN ARRAY L[0:1]; INTEGER K; + REAL T,U; + REAL STREAM PROCEDURE CON(A); + VALUE A; + BEGIN SI:=LOC A; DI:=LOC CON; DS:=8OCT + END; + TRANSFER(ACCUM,2,L,1,7); + IF BOUND:=SEARCHORD(PT,L,K,8)=0 THEN + BEGIN T:=ADDRESS; + U:=CON(MAX(L[1],0))/10000; %ARGS AND RESULT ARE NEG + IF SCAN AND PLUS OR MINUS THEN + BEGIN K:=(IF PLUS THEN 1 ELSE -1); + IF SCAN AND NUMERIC THEN ACCUM[0]:=MAX(U+K|ACCUM[0],0) ELSE - BEGIN ACCUM[0]:=U; - ADDRESS:=T; - END; - END ELSE BEGIN ACCUM[0]:=U; ADDRESS:=T; - END; - EOB:=0; - END; - END; - - - PROCEDURE FINISHUP; - BEGIN COMMENT GET HIM BACK TO CALCULATOR MODE; - IF FUNCPOINTER=0 THEN % HE DELETED EVERYTHING + BEGIN ACCUM[0]:=U; + ADDRESS:=T; + END; + END ELSE BEGIN ACCUM[0]:=U; ADDRESS:=T; + END; + EOB:=0; + END; + END; + + + PROCEDURE FINISHUP; + BEGIN COMMENT GET HIM BACK TO CALCULATOR MODE; + IF FUNCPOINTER=0 THEN % HE DELETED EVERYTHING BEGIN TRANSFER(PSR,FSTART|8,GTA,0,8); - IF SEARCHORD(VARIABLES,GTA,GT1,7)=0 THEN - BEGIN DELETE1(VARIABLES,GT1); - IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0; - END ELSE SPOUT(9198260); - END; 09198270 P85 - DELTOG:=CURRENTMODE:=CURLINE:=INCREMENT:=0; - STOREPSR; - END; - - LABEL SHORTCUT; - REAL L,U,TADD; - STREAM PROCEDURE CLEANBUFFER(BUFFER,BUFFSIZE,ADDR); - VALUE BUFFSIZE,ADDR; - BEGIN LABEL L; LOCAL T,U,TSI,TDI; - SI:=ADDR; SI:=SI-1; L: - IF SC NEQ "]" THEN - BEGIN SI:=SI-1; GO TO L END; - SI:=SI+1; DI:=LOC T; SKIP 2 DB; DS:=2SET; - DI:=BUFFER; TDI:=DI; DI:=LOC T; TSI:=SI; - BUFFSIZE(8(IF TOGGLE THEN DS:=LIT" " ELSE - IF SC=DC THEN - BEGIN SI:=LOC U; DI:=TDI; DS:=LIT" " - END ELSE - BEGIN TSI:=SI; SI:=SI-1; DI:=LOC U; DS:=CHR; - DI:=TDI; SI:=LOC U; DS:=CHR; TDI:=DI; DI:=LOC T; - SI:=TSI; - END)) - END; - PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE, - ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0]; - CLEANBUFFER(BUFFER,BUFFSIZE,ADDR); -COMMENT DETERMINE WHETHER OR NOT WE CAME FROM CALCULATOR MODE; - ERR:=0; - IF BOOLEAN(SUSPENSION) THEN GO TO ENDHANDLER; - BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// - IF GT1:=CURRENTMODE=CALCMODE THEN % TAKE CARE OF HEADER. - BEGIN ARRAY A[0:MAXHEADERSARGS]; - LABEL HEADERSTORE,FORGETITFELLA; - IF FUNCTIONHEADER(A,TADD) THEN %HEADER OK - IF VARIABLES NEQ 0 THEN % MAY BE A RE-DEFINITION - BEGIN COMMENT GET THE FUNCTION NAME; - TRANSFER(A,1,GTA,0,7); - IF GT2:=SEARCHORD(VARIABLES,GTA,GT3,7)=0 THEN - COMMENT RE-DEFINING A FUNCTION. MAKE SURE NULL ; - IF GETFIELD(GTA,7,1)=FUNCTIUON AND - (A[1]+A[2]+A[3])=0 THEN %NULL HEADER--OK -%--------------------SET UP FOR CONTINUATION OF DEFINITION------ - BEGIN - FUNCPOINTER:=GETFIELD(GTA,FPTF,FFL); - FUNCSEQ:=GETFIELD(GTA,FSQF,FFL); - GT3:=CURLINE:=TOPLINE(FPT); - CHECKSEQ(CURLINE,GT3,INC); %SET THE INCREMENT - COMMENT THE CURRENT LINE IS SET TO THE LAST LINE OF THE - FUNCTION; - FUNCSIZE:=SIZE(FPT); - CURLINE:=CURLINE+INC; - DELTOG:=DELPRESENT(ADDRESS); - END ELSE -%------------------REDEFINING THE HEADER OF A DEFINED FUNCTION---- - GO TO FORGETITFELLA - ELSE -%--------------------NAME NOT FOUND IN DIRECTWORY, SET UP -HEADERSTORE: - BEGIN COMMENT GET THE HEADER TO INSERT AT LINE 0; - ARRAY OLDBUFFER[0:MAXBUFFSIZE]; - INTEGER L,U,F,K,J; - INTEGER A1,A2; - COMMENT FUNCTIONHEADER RETURN AN ARRAY WITH THE - FOLLOWING VALUES: - A[0] = FUNCTION NAME , I.E., 0AAAAAAA - A[1] = 0 IF NO RESULT, 1 IF A RESULT IS RETURNED BY THE - FUNCTION. - A[2] = NUMBER OF ARGUMENTS TO THE FUNCTION. - A[3] = NUMBER OF LOCALS + RESULT +ARGUMENTS. - A[4]....A[N] ARE ALL OF THE LOCALS, RESULT, AND ARGUMENTS. - THE RESULT IS FIRST, THEN THE SECOND ARGUMENT, THEN - THE FIRST ARGUMENT, FOLL7OWED BY THE LOCALS. ALL - ARE OF THE FORM 0XXXXXXX; - U:=(A1:=A[1])+(A2:=A[2])+3; - FOR L:=4 STEP 1 UNTIL 0 DO %LOOK FOR DUPLICATES AMONG - FOR K:=L+1 STEP 1 UNTIL 0 DO %THE RESULT/ARGUMENT SET - IF A[L]=A[K] THEN GO TO FORGETITFELLA; - SEQUENTIAL(FUNCSEQ:=NEXTUNIT); - SETFIELD(GTA,8,8,STORESEQ(FUNCSEQ,OLDBUFFER, - HEADER(TADD.[1:23],TADD.[24:24],OLDBUFFER))); - SETFIELD(GTA,0,8,0); - STOREORD(F:=FUNCPOINTER:=NEXTUNIT,GTA,0); - SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); 09229004 P86 - FOR L:=4 STEP 1 UNTIL U DO - BEGIN GTA[0]:=A[L]; IF A1 GTR 0 THEN - BEGIN A1:=0; GTA[1]:=-1; %"RESULT" SET TO -1 - STOREORD(F,GTA,0); - END ELSE %LOOKING AT THE ARGUMENTS - BEGIN K:=SEARCHORD(F,GTA,J,8); - GTA[1]:=A2-4; A2:=A2-1; GTA[0]:=A[L]; - STOREORD(F,GTA,J+K-1); - END END; - FUNCSIZE:=U:=U-2; U:=A[3]-U+L; - FOR L:=L STEP 1 UNTIL U DO %GET LOCALS INTO THE LABEL TABLE - BEGIN GTA[0]:=A[L]; - IF K:=SEARCHORD(F,GTA,J,8) NEQ 0 THEN %NOT YET IN TABLE. - BEGIN GTA[0]:=A[L]; GTA[1]:=0; - STOREORD(F,GTA,J+K-1); - FUNCSIZE:=FUNCSIZE+1 - END; - END; - GTA[1]:=0&ENTIER(A[1])[CRETURN]&ENTIER(A[2])[CNUMBERARGS]; - CURLINE:=INCREMENT:=1; - DELTOG:=0; - COMMENT GET THE "TYPE" OF THE FUNCTION LATER WHEN THERE - IS A PLACE FOR IT. THE TYPE IS EITHER 1 (FUNCTION CALL), OR - 0 (SUBROUTINE CALL); - END; -%-------------------------------------------------------- - END ELSE % VARIABLES=0, MAKE UP A DIRECTORY - BEGIN GT3:=0; GT2:=1; GO TO HEADERSTORE - END - ELSE % HEADER SYNTAX IS BAD - GO TO ENDHANDLER; - COMMENT WE MAKE IT TO HERE IF ALL IS WELL ABOVE; - IF GT2 NEQ 0 THEN %NME NOT FOUND IN DIRECTORY; - BEGIN - TRANSFER(A,1,GTA,0,7); %GET FUNCTION NAME - SETFIELD(GTA,7,1,FUNCTION); - SETFIELD(GTA,FPTF,FFL,FUNCPOINTER); - SETFIELD(GTA,FSQF,FFL,FUNCSEQ); - IF VARIABLES=0 THEN - VARIABLE:=NEXTUNIT; - STOREORD(VARIABLES,GTA,GT3+GT2-1); - VARSIZE:=VARSIZE+1; - END; - CURRENTMODE:=FUNCMODE; + IF SEARCHORD(VARIABLES,GTA,GT1,7)=0 THEN + BEGIN DELETE1(VARIABLES,GT1); + IF VARSIZE:=VARSIZE-1=0 THEN VARIABLES:=0; + END ELSE SPOUT(9198260); + END; 09198270P85 + DELTOG:=CURRENTMODE:=CURLINE:=INCREMENT:=0; + STOREPSR; + END; + + LABEL SHORTCUT; + REAL L,U,TADD; + STREAM PROCEDURE CLEANBUFFER(BUFFER,BUFFSIZE,ADDR); + VALUE BUFFSIZE,ADDR; + BEGIN LABEL L; LOCAL T,U,TSI,TDI; + SI:=ADDR; SI:=SI-1; L: + IF SC NEQ "]" THEN + BEGIN SI:=SI-1; GO TO L END; + SI:=SI+1; DI:=LOC T; SKIP 2 DB; DS:=2SET; + DI:=BUFFER; TDI:=DI; DI:=LOC T; TSI:=SI; + BUFFSIZE(8(IF TOGGLE THEN DS:=LIT" " ELSE + IF SC=DC THEN + BEGIN SI:=LOC U; DI:=TDI; DS:=LIT" " + END ELSE + BEGIN TSI:=SI; SI:=SI-1; DI:=LOC U; DS:=CHR; + DI:=TDI; SI:=LOC U; DS:=CHR; TDI:=DI; DI:=LOC T; + SI:=TSI; + END)) + END; + PROCEDURE BUFFERCLEAN(BUFFER,BUFFSIZE,ADDR); VALUE BUFFSIZE, + ADDR; REAL ADDR; INTEGER BUFFSIZE; ARRAY BUFFER[0]; + CLEANBUFFER(BUFFER,BUFFSIZE,ADDR); +COMMENT DETERMINE WHETHER OR NOT WE CAME FROM CALCULATOR MODE; + ERR:=0; + IF BOOLEAN(SUSPENSION) THEN GO TO ENDHANDLER; + BEGIN DEFINE STARTSEGMENT=#; %/////////////////////////////// + IF GT1:=CURRENTMODE=CALCMODE THEN % TAKE CARE OF HEADER. + BEGIN ARRAY A[0:MAXHEADERSARGS]; + LABEL HEADERSTORE,FORGETITFELLA; + IF FUNCTIONHEADER(A,TADD) THEN %HEADER OK + IF VARIABLES NEQ 0 THEN % MAY BE A RE-DEFINITION + BEGIN COMMENT GET THE FUNCTION NAME; + TRANSFER(A,1,GTA,0,7); + IF GT2:=SEARCHORD(VARIABLES,GTA,GT3,7)=0 THEN + COMMENT RE-DEFINING A FUNCTION. MAKE SURE NULL ; + IF GETFIELD(GTA,7,1)=FUNCTIUON AND + (A[1]+A[2]+A[3])=0 THEN %NULL HEADER--OK +%--------------------SET UP FOR CONTINUATION OF DEFINITION------ + BEGIN + FUNCPOINTER:=GETFIELD(GTA,FPTF,FFL); + FUNCSEQ:=GETFIELD(GTA,FSQF,FFL); + GT3:=CURLINE:=TOPLINE(FPT); + CHECKSEQ(CURLINE,GT3,INC); %SET THE INCREMENT + COMMENT THE CURRENT LINE IS SET TO THE LAST LINE OF THE + FUNCTION; + FUNCSIZE:=SIZE(FPT); + CURLINE:=CURLINE+INC; + DELTOG:=DELPRESENT(ADDRESS); + END ELSE +%------------------REDEFINING THE HEADER OF A DEFINED FUNCTION---- + GO TO FORGETITFELLA + ELSE +%--------------------NAME NOT FOUND IN DIRECTORY, SET UP +HEADERSTORE: + BEGIN COMMENT GET THE HEADER TO INSERT AT LINE 0; + ARRAY OLDBUFFER[0:MAXBUFFSIZE]; + INTEGER L,U,F,K,J; + INTEGER A1,A2; + COMMENT FUNCTIONHEADER RETURN AN ARRAY WITH THE + FOLLOWING VALUES: + A[0] = FUNCTION NAME , I.E., 0AAAAAAA + A[1] = 0 IF NO RESULT, 1 IF A RESULT IS RETURNED BY THE + FUNCTION. + A[2] = NUMBER OF ARGUMENTS TO THE FUNCTION. + A[3] = NUMBER OF LOCALS + RESULT +ARGUMENTS. + A[4]....A[N] ARE ALL OF THE LOCALS, RESULT, AND ARGUMENTS. + THE RESULT IS FIRST, THEN THE SECOND ARGUMENT, THEN + THE FIRST ARGUMENT, FOLLOWED BY THE LOCALS. ALL + ARE OF THE FORM 0XXXXXXX; + U:=(A1:=A[1])+(A2:=A[2])+3; + FOR L:=4 STEP 1 UNTIL 0 DO %LOOK FOR DUPLICATES AMONG + FOR K:=L+1 STEP 1 UNTIL 0 DO %THE RESULT/ARGUMENT SET + IF A[L]=A[K] THEN GO TO FORGETITFELLA; + SEQUENTIAL(FUNCSEQ:=NEXTUNIT); + SETFIELD(GTA,8,8,STORESEQ(FUNCSEQ,OLDBUFFER, + HEADER(TADD.[1:23],TADD.[24:24],OLDBUFFER))); + SETFIELD(GTA,0,8,0); + STOREORD(F:=FUNCPOINTER:=NEXTUNIT,GTA,0); + SETFIELD(GTA,0,8,0); SETFIELD(GTA,8,8,0); 09229004P86 + FOR L:=4 STEP 1 UNTIL U DO + BEGIN GTA[0]:=A[L]; IF A1 GTR 0 THEN + BEGIN A1:=0; GTA[1]:=-1; %"RESULT" SET TO -1 + STOREORD(F,GTA,0); + END ELSE %LOOKING AT THE ARGUMENTS + BEGIN K:=SEARCHORD(F,GTA,J,8); + GTA[1]:=A2-4; A2:=A2-1; GTA[0]:=A[L]; + STOREORD(F,GTA,J+K-1); + END END; + FUNCSIZE:=U:=U-2; U:=A[3]-U+L; + FOR L:=L STEP 1 UNTIL U DO %GET LOCALS INTO THE LABEL TABLE + BEGIN GTA[0]:=A[L]; + IF K:=SEARCHORD(F,GTA,J,8) NEQ 0 THEN %NOT YET IN TABLE. + BEGIN GTA[0]:=A[L]; GTA[1]:=0; + STOREORD(F,GTA,J+K-1); + FUNCSIZE:=FUNCSIZE+1 + END; + END; + GTA[1]:=0&ENTIER(A[1])[CRETURN]&ENTIER(A[2])[CNUMBERARGS]; + CURLINE:=INCREMENT:=1; + DELTOG:=0; + COMMENT GET THE "TYPE" OF THE FUNCTION LATER WHEN THERE + IS A PLACE FOR IT. THE TYPE IS EITHER 1 (FUNCTION CALL), OR + 0 (SUBROUTINE CALL); + END; +%-------------------------------------------------------- + END ELSE % VARIABLES=0, MAKE UP A DIRECTORY + BEGIN GT3:=0; GT2:=1; GO TO HEADERSTORE + END + ELSE % HEADER SYNTAX IS BAD + GO TO ENDHANDLER; + COMMENT WE MAKE IT TO HERE IF ALL IS WELL ABOVE; + IF GT2 NEQ 0 THEN %NME NOT FOUND IN DIRECTORY; + BEGIN + TRANSFER(A,1,GTA,0,7); %GET FUNCTION NAME + SETFIELD(GTA,7,1,FUNCTION); + SETFIELD(GTA,FPTF,FFL,FUNCPOINTER); + SETFIELD(GTA,FSQF,FFL,FUNCSEQ); + IF VARIABLES=0 THEN + VARIABLE:=NEXTUNIT; + STOREORD(VARIABLES,GTA,GT3+GT2-1); + VARSIZE:=VARSIZE+1; + END; + CURRENTMODE:=FUNCMODE; TRANSFER(GTA,0,PSR,FSTART|8,8); - STOREPSR; - IF SCAN THEN GO TO SHORTCUT; - IF FALSE THEN - FORGETITFELLA: ERRORMESS(ERR:=LABELERROR,TADD.[1:23],0); - END ELSE % WE ARE IN FUNCTION DEFINITION MODE + STOREPSR; + IF SCAN THEN GO TO SHORTCUT; + IF FALSE THEN + FORGETITFELLA: ERRORMESS(ERR:=LABELERROR,TADD.[1:23],0); + END ELSE % WE ARE IN FUNCTION DEFINITION MODE IF GT1:=MODE NEQ 0 THEN % A SPECIAL FUNCTION SUCH AS DISPLAY OR EDIT - BEGIN L:=LOWER; - IF GT1=DISPLAYING THEN - LISTLINE(FPT,FSQ,L) ELSE - IF GT1=EDITING THEN - BEGIN INITBUFF(BUFFER,BUFFSIZE); - MOVE(OLDBUFFER,BUFFSIZE,BUFFER); - EDITMODE:=TRUE; ADDRESS:=ABSOLUTEADDRESS; - EDITDRIVER(FP1,FSQ,L,L) - ;IF NOT EDITMODE THEN - BEGIN MODE:=0; ERR:=30 - END; - END ELSE - IF GT1=RESEQUENCING THEN - IF GT1:=L LEQ UPPER THEN - BEGIN GT2:=CONTENTS(FPT,L,GTA); - GT3:=GTA[0]:=LINENUMBER(CURLINE); - DELETE1(FPT,L); - STOREORD(FPT,GTA,L); - CURLINE:=CURLINE+INCREMENT; - GT2:=CONTENTS(FSQ,GTA[1],BUFFER); RESCANLINE; - WHILE (IF ERR NEQ 0 THEN FALSE ELSE - LABELSCAN(GTA,0)) FO - IF GT1:=SEARCHORD(FPT,GTA,GT2,8)=0 THEN - BEGIN GTA[1]:=GT3; DELETE1(FPT,GT2); - STOREORD(FPT,GTA,GT2) - END ELSE ERR:=16 - END - ELSE MODE:=0; - LOWER:=L+1; - IF LOWER GTR UPPER THEN - BEGIN IF MODE=DISPLAYING THEN - FORMWD(3,"1 "); 092314?? P87 - MODE:=0; - END; - GO TO ENDHANDLER - END; - END ; % OF BLOCK STARTED EON LINE 9225115 ////////////////// - - - IF ERR=0 AND EOB=0 THEN - -SHORTCUT: BEGIN LABEL RGTBRACK,DELOPTION; %////////////////////////// - IF DEDLV THEN FINISHUP ELSE - IF LFTBRACKET THEN - BEGIN - IF SCAN THEN - IF DOUND(FPT) THEN - BEGIN L:=ACCUM[0]; - IF SCAN THEN - IF QUDV OR EDITMWODE:=(QUOTEQUAD) THEN - IF SCAN THEN - IF BOUND(FPT) THEN - BEGIN U:=ACCUM[0]; -RGTBRACK: - IF SCAN AND RGTBRACKET THEN - IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN - IF DELV THEN - BEGIN ERR:=DISPLAY(L,U,FPT,FSQ); - DELTOG:=1; - END - ELSEERR:=1; - ELSE ERR:=DISPLAY(L,U,FPT,FSQ) - ELSE ERR:=2 - END - ELSE - IF RGTBRACKT THEN - IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN - IF DELV THEN - BEGIN ERR:=DISPLAY(L,L,FPT,FSQ); - DELTOG:=1; - END - ELSE ERR:=3 - ELSE ERR:=DISPLAY(L,L,FPT,FSQ) - ELSE ERR:=4 - ELSE ERR:=5 - ELSE - IF RGTBRACKET THEN - BEGIN TADD:=ADDRESS; - IF SCAN THEN - IF IDENT AND ACCUM[0]="ADELETE" THEN - IF SCAN THEN - IF LFTBRACKET THEN -DELOPTION: - IF SCAN AND BOUND(FPT) THEN - BEGIN U:=ACCUM[0]; - IF SCAN AND RGTBRACKET THEN - IF SCAN THEN - IF DELV THEN - BEGIN ERR:=DELETE(L,U,FPT,FSQ); - FINISHUP - END - ELSE ERR:=6 - ELSE ERR:=DELETE(L,U.FPT,FSQ) - ELSE ERR:=7 - END - ELSE ERR:=8 - ELSE - IF DELV THEN - BEGIN ERR:=DELETE(L,L,FPT,FSQ); - FINISHUP - END - ELSE ERR:=9 - ELSE ERR:=DELETE(L,L,FPT,FSQ) - ELSE - IF LFTBRACKET TEHN GO TO DESLOPTION ELSE - BEGIN CHECKSEQ(SEQ,L,INC); - CLEANBUFFER(BUFFER,BUFFSIZE,TADD); - ADDRESS:=ABSADDR(BUFFER); ITEMCOUNT:=0; - IF SCAN THEN GO TO SHORTCUT - END - ELSE ERR:=DELETE(L,L,FPT,FSQ) - END - ELSE ERR:=10 - ELSE ERR:=11 09310000 P88 - END ELSE - IF QUADV OR EDITMODE:=(QUOTEQUAD) THEN - BEGIN L:=0; U:=9999.9999; GO TO RGTBRACK - END ELSE - IF IOTA THEN - IF SCAN AND RGTBRACKET AND FPT NEQ 0 THEN - BEGIN IF SCAN THEN - IF DELV THEN DELTOG:=1; ELSE ERR:=15; - IF ERR == 0 THEN - BEGIN MODE:=RFSEQUENCING; CURLINE:=INCREMENT:=1; - SETFIELD(GTA,0,8,0); - GT1:=SEARCHORD(FPT,GTA,GT2,8); - LOWER:=GTT2+1; UPPER:=FUNCSIZE-1; - END - END - ELSE ERR:=14; - ELSE ERR:=12 - ELSE ERR:=13 - END - ELSE - IF CURLINE=0 THEN %CHANGING HEADER - ERR:=26 ELSE - IF ERR:=OLDLABCONFLICT(FPT,LINENUMBER(SEQ))=0 THEN - BEGIN - IF NOSYNTAX=0 THEN PROCESS(XEQUTE); - IF ERR:=STOREAWAY(FPT,FSQ,BUFFER,SEQ)=0 THEN SEQ:=SEQ+INC; - END; - IF ERR NEQ 0 TEHN - BEGIN FORMWD(2,"5ERROR "); - EOD:=1; - FORMROW(1,1,ACCUM,2,ACCUM[0].[1:11]); - END; - END; %OF BLOCK STARTED ON LINE 9238000 ////////////////////// - ENDHANDLER: - IF BOOLEAN(SUSPENSION) THEN BEGIN - FILL ACCUM[*] WITH "ABORT SU", "SP. FNS."; - FORMROW(3,0,ACCUM,0,16); INDENT(0); TERPRINT; - END ELSE - IF MODE=0 THEN - BEGIN - IF BOOLEAN(DELTOG) THEN FINISHUP; - INDENT(-CURLINE); TERPRINT; - END; - - END; - EXPOVR:=FAULTL; INTOVR:=FAULTL; INDEXF:=FAULTL; - FLAG:=FAULTL; ZERO:=FAULTL; -INITIALIZETABLE; -TRYAGAIN: - IF FALSE THEN %ENTERS WITH A FAULT. - FAULTL: - BEGIN SPOUT(09334300); %SEND MESSAGE TO SPO - - BEGIN CSTATION.APLOGGED:=0; CSTATION.APLHEADING:=0 - END - END; - APLMONITOR; -ENDOFJOB: - - FINIS: - WRAPUP; - -END. - END;END. LAST CARD ON OCRDING TAPE - - - - TOTAL LOGICAL RECORDS= 7273 - END OF JOB. + BEGIN L:=LOWER; + IF GT1=DISPLAYING THEN + LISTLINE(FPT,FSQ,L) ELSE + IF GT1=EDITING THEN + BEGIN INITBUFF(BUFFER,BUFFSIZE); + MOVE(OLDBUFFER,BUFFSIZE,BUFFER); + EDITMODE:=TRUE; ADDRESS:=ABSOLUTEADDRESS; + EDITDRIVER(FP1,FSQ,L,L) + ;IF NOT EDITMODE THEN + BEGIN MODE:=0; ERR:=30 + END; + END ELSE + IF GT1=RESEQUENCING THEN + IF GT1:=L LEQ UPPER THEN + BEGIN GT2:=CONTENTS(FPT,L,GTA); + GT3:=GTA[0]:=LINENUMBER(CURLINE); + DELETE1(FPT,L); + STOREORD(FPT,GTA,L); + CURLINE:=CURLINE+INCREMENT; + GT2:=CONTENTS(FSQ,GTA[1],BUFFER); RESCANLINE; + WHILE (IF ERR NEQ 0 THEN FALSE ELSE + LABELSCAN(GTA,0)) FO + IF GT1:=SEARCHORD(FPT,GTA,GT2,8)=0 THEN + BEGIN GTA[1]:=GT3; DELETE1(FPT,GT2); + STOREORD(FPT,GTA,GT2) + END ELSE ERR:=16 + END + ELSE MODE:=0; + LOWER:=L+1; + IF LOWER GTR UPPER THEN + BEGIN IF MODE=DISPLAYING THEN + FORMWD(3,"1 "); 092314??P87 + MODE:=0; + END; + GO TO ENDHANDLER + END; + END ; % OF BLOCK STARTED EON LINE 9225115 ////////////////// + + + IF ERR=0 AND EOB=0 THEN + +SHORTCUT: BEGIN LABEL RGTBRACK,DELOPTION; %////////////////////////// + IF DEDLV THEN FINISHUP ELSE + IF LFTBRACKET THEN + BEGIN + IF SCAN THEN + IF DOUND(FPT) THEN + BEGIN L:=ACCUM[0]; + IF SCAN THEN + IF QUDV OR EDITMWODE:=(QUOTEQUAD) THEN + IF SCAN THEN + IF BOUND(FPT) THEN + BEGIN U:=ACCUM[0]; +RGTBRACK: + IF SCAN AND RGTBRACKET THEN + IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN + IF DELV THEN + BEGIN ERR:=DISPLAY(L,U,FPT,FSQ); + DELTOG:=1; + END + ELSEERR:=1; + ELSE ERR:=DISPLAY(L,U,FPT,FSQ) + ELSE ERR:=2 + END + ELSE + IF RGTBRACKT THEN + IF(IF EDITMODE THEN FALSE ELSE SCAN) THEN + IF DELV THEN + BEGIN ERR:=DISPLAY(L,L,FPT,FSQ); + DELTOG:=1; + END + ELSE ERR:=3 + ELSE ERR:=DISPLAY(L,L,FPT,FSQ) + ELSE ERR:=4 + ELSE ERR:=5 + ELSE + IF RGTBRACKET THEN + BEGIN TADD:=ADDRESS; + IF SCAN THEN + IF IDENT AND ACCUM[0]="ADELETE" THEN + IF SCAN THEN + IF LFTBRACKET THEN +DELOPTION: + IF SCAN AND BOUND(FPT) THEN + BEGIN U:=ACCUM[0]; + IF SCAN AND RGTBRACKET THEN + IF SCAN THEN + IF DELV THEN + BEGIN ERR:=DELETE(L,U,FPT,FSQ); + FINISHUP + END + ELSE ERR:=6 + ELSE ERR:=DELETE(L,U.FPT,FSQ) + ELSE ERR:=7 + END + ELSE ERR:=8 + ELSE + IF DELV THEN + BEGIN ERR:=DELETE(L,L,FPT,FSQ); + FINISHUP + END + ELSE ERR:=9 + ELSE ERR:=DELETE(L,L,FPT,FSQ) + ELSE + IF LFTBRACKET THEN GO TO DESLOPTION ELSE + BEGIN CHECKSEQ(SEQ,L,INC); + CLEANBUFFER(BUFFER,BUFFSIZE,TADD); + ADDRESS:=ABSADDR(BUFFER); ITEMCOUNT:=0; + IF SCAN THEN GO TO SHORTCUT + END + ELSE ERR:=DELETE(L,L,FPT,FSQ) + END + ELSE ERR:=10 + ELSE ERR:=11 09310000P88 + END ELSE + IF QUADV OR EDITMODE:=(QUOTEQUAD) THEN + BEGIN L:=0; U:=9999.9999; GO TO RGTBRACK + END ELSE + IF IOTA THEN + IF SCAN AND RGTBRACKET AND FPT NEQ 0 THEN + BEGIN IF SCAN THEN + IF DELV THEN DELTOG:=1; ELSE ERR:=15; + IF ERR == 0 THEN + BEGIN MODE:=RFSEQUENCING; CURLINE:=INCREMENT:=1; + SETFIELD(GTA,0,8,0); + GT1:=SEARCHORD(FPT,GTA,GT2,8); + LOWER:=GTT2+1; UPPER:=FUNCSIZE-1; + END + END + ELSE ERR:=14; + ELSE ERR:=12 + ELSE ERR:=13 + END + ELSE + IF CURLINE=0 THEN %CHANGING HEADER + ERR:=26 ELSE + IF ERR:=OLDLABCONFLICT(FPT,LINENUMBER(SEQ))=0 THEN + BEGIN + IF NOSYNTAX=0 THEN PROCESS(XEQUTE); + IF ERR:=STOREAWAY(FPT,FSQ,BUFFER,SEQ)=0 THEN SEQ:=SEQ+INC; + END; + IF ERR NEQ 0 THEN + BEGIN FORMWD(2,"5ERROR "); + EOD:=1; + FORMROW(1,1,ACCUM,2,ACCUM[0].[1:11]); + END; + END; %OF BLOCK STARTED ON LINE 9238000 ////////////////////// + ENDHANDLER: + IF BOOLEAN(SUSPENSION) THEN BEGIN + FILL ACCUM[*] WITH "ABORT SU", "SP. FNS."; + FORMROW(3,0,ACCUM,0,16); INDENT(0); TERPRINT; + END ELSE + IF MODE=0 THEN + BEGIN + IF BOOLEAN(DELTOG) THEN FINISHUP; + INDENT(-CURLINE); TERPRINT; + END; + + END; + EXPOVR:=FAULTL; INTOVR:=FAULTL; INDEXF:=FAULTL; + FLAG:=FAULTL; ZERO:=FAULTL; +INITIALIZETABLE; +TRYAGAIN: + IF FALSE THEN %ENTERS WITH A FAULT. + FAULTL: + BEGIN SPOUT(09334300); %SEND MESSAGE TO SPO + + BEGIN CSTATION.APLOGGED:=0; CSTATION.APLHEADING:=0 + END + END; + APLMONITOR; +ENDOFJOB: + + FINIS: + WRAPUP; + +END. + END;END. LAST CARD ON OCRDING TAPE + + + + TOTAL LOGICAL RECORDS= 7273 + END OF JOB. + \ No newline at end of file