From 7abb0cf5926a1748c78c77effd40db0e4c58961d Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Thu, 10 Oct 2013 14:44:51 +0000 Subject: [PATCH] Commit additional transcription for B5500 APL source by Fausto Saporito of Naples, Italy, as of 2013-10-07. --- source/APL/IMAGE.alg_m | 1349 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 1347 insertions(+), 2 deletions(-) diff --git a/source/APL/IMAGE.alg_m b/source/APL/IMAGE.alg_m index 0ab46dc..c2a14e1 100644 --- a/source/APL/IMAGE.alg_m +++ b/source/APL/IMAGE.alg_m @@ -121,7 +121,7 @@ PROCEDURE SETPOINTERNAMES; WRITE(ESTABLISH[MAXPAGES|AREASIZE-1]); LOCK(ESTABLISH); CLOSE(ESTABLISH) - ;LIBSIZE§-1; + ;LIBSIZE~-1; END END; DEFINE @@ -570,7 +570,1352 @@ INTEGER PROCEDURE FREEPAGE(INDEX,TYPEZERO,START,FINISH); M:=RECSIZE|8; READRECS(POINTERS[CURBUFF](0),A,SKIP,NR,1,0,RECSIZE); END; - M:=0; END; 08015888 P78 + %------- 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 TOOL 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#, % PROG 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]#, %KLUDGE...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 CHARACTERS ADDRESS. ADDRESS IS SE 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 + 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; + M:=0; END; 08015888 P78 END; END; MOVETWO(T,DIR,K,WR,L,DISK);