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 % 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]); WRITE(ESTABLISH[MAXPAGES|AREASIZE-1]); 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 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=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 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; 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 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 IF (PAGESIZE-SKIP-1)|8-INDX[(I:=I-1)-1,0].SF GTR 2 THEN 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 %------- 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; %------- 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; %------- 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 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 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:= 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]; 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, %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 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 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 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 DOUBLE(THI,TLO,100000000.0,0,|,CONV(ADDR,8), 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 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 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); 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; 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; 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; 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); 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 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; 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; 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; 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, 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; 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 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); 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; 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; 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 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 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 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 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 BEGIN TRANSFER(D,J|8,T,08); L:=RD(DISK,L,D); 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; 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 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 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; 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 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) ;GTA[0]~GTA[1]~0;TRANSFER(R,1,GTA,1,7); 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 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; 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; 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)); 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; 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); 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 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 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; 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 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.