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 KINDALL, 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 WRITTER 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 ; 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; 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; 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 MASSAGEHANDLER; 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:=GETFILED(GTA,7,1)=FUNCTION THEN BEGIN RELEASEUNIT(GETFIELD(GTA,FPTF,FFL)); RELEASEUNIT(GETFILED(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 COMAMND,CHAR,WORD; INTEGER COMMAND,CHAR,WORD; ARRAY OLD, NEWEDIT; BEGIN BOOLEAN STREAM PROCEDURE WITHINLINE(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; OLLABELCONFLICT:=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 NOSYTNATX=0 THE 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(VARIABSLES,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 TOGGKLE 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))); SETFILED(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; O 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); FINSIHUP 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 LOGIICAL RECORDS= 7273 END OF JOB.