1 ! GCOLL3 V4 C. HORNIG/RSL 8 DECEMBER 1976 2 ! V4: 1977.01.27/RSL INCORPORATE LRU PAGING INTO P$ USAGE. ! V3: 1976.12.8/RSL CHECK FOR PRESERVED FILES IN GCOLL.DAT 3 ! ! REQUIRES THE LEADS FUNCTION PACKAGE 'FNA' ! DOES NOT USE: FNP$, FNG2$, FNO2%, FNS1$, FNS3$, ! 5 ! A SOFTWARE PRODUCT OF: ! PROJECT LEADS AND THE LEXINGTON PUBLIC SCHOOLS ! 8 PRINT 'GCOLL3 V4 '; : T1 = TIME (1%) : T0 = TIME (0%) 1226 L8% = 0% : GO TO 1330 ! PRESERVE US FROM BASIC-PLUS 10000 DIM G1%(128%), G2%(128%) , G3%(128%), G0%(128%) 10001 I8$ = SYS (CHR$ (6%) + CHR$ (-7%)) 10010 DIM #12%, F1%(32767%,7%) : OPEN 'FIELDS.TMP' FOR INPUT AS FILE 12% 10020 DIM #10%, F2%(32767%,7%) : OPEN 'FILES.TMP' FOR INPUT AS FILE 10% 10030 DIM #11%, P$(16383%,127%)=4% : OPEN 'DATA.TMP' FOR INPUT AS FILE 11% 10035 ! ! MARK REFERENCES FOR ALL ISAMED FILES ! 10040 GOSUB 20000 : F0%=F2%(0%,1%) : F3%=F1%(0%,1%) : F2%(F1%(F%,1%),0%)=F2%(F1%(F%,1%),0%) OR 16384% IF F1%(F%,3%) FOR F%=1% TO F3% : GOSUB 11000 IF F2%(C1%,0%)=16384% FOR C1%=1% TO F0% 10080 ! ! MARK REFERENCES FOR RECORDS REFERRED TO IN PREVIOUS PASSES ! 10090 GOSUB 12000 IF F2%(C1%,0%)=8192% FOR C1%=1% TO F0% : IF NOT W% THEN 19000 ELSE W%=0% : GOTO 10090 10995 ! ! ** PROCESS AN ISAMED FILE ** ! 11000 GOSUB 13000 11035 ! ! PROCESS EACH UNDELETED RECORD IN FILE ! 11040 UNTIL P1%=P3% AND P2%=P4% : GOSUB 15000 : GOSUB 14000 UNLESS ASCII(FNP9$(P1%,P2%)) : NEXT : G3%=FNC2%(0%) : RETURN 11995 ! ! ** PROCESS FILE REFERENCED IN PREVIOUS PASS ** ! 12000 W%=-1% : GOSUB 13000 12010 ! ! PROCESS EACH MARKED RECORD IN FILE ! 12020 UNTIL P1%=P3% AND P2%=P4% : GOSUB 15000 : GOSUB 14000 IF ASCII(FNP9$(P1%,P2%))=1% : NEXT : G3%=FNC2%(0%) : RETURN 12995 ! ! ** OPEN A FILE ** ! 13000 F2%(C1%,0%)=F2%(C1%,0%) AND -8193% : C%=FNO1%(0%,C1%,'',-8%) : P5%,P6%=1% 13040 ! ! SET UP POINTERS ! 13050 P1%=F2%(C1%,3%) : P2%=F2%(C1%,4%) : P3%=F2%(C1%,5%) : P4%=F2%(C1%,6%) : R3%=F2%(C1%,1%) 13070 G1%,G2%=0% 13075 ! ! GET ALL THE POINTER FIELDS ! 13080 FOR I%=1% TO F3% : IF F1%(I%,1%)=C1% AND F1%(I%,2%) THEN G1%=G1%+1% : G1%(G1%)=I% 13095 ! ! AND ALL THE ASSOCIATOR TYPES ! 13100 NEXT I% : G3%=F2%(C1%,2%) : RETURN UNLESS G3% : G3%=FNO1%(0%,G3%,'',-8%) : R1%=1% : R2%=2% 13140 FIELD #G3%, FNG1%(G3%,R1%,R2%)+1% AS I8$, 2% AS R1$, 1% AS R2$, 2% AS I8$(0%), 26% AS I8$, 2% AS I9$(0%), 2% AS I8$(1%), 26% AS I8$, 2% AS I9$(1%) 13150 FOR I%=0% TO 1% : I8%=CVT$%(I8$(I%)) : I9%=CVT$%(I9$(I%)) : IF I8% AND I9%<>0% THEN G2%=G2%+1% : G2%(G2%)=I8% : G3%(G2%)=I9% 13170 NEXT I% : R1%=CVT$%(R1$) : R2%=ASCII(R2$) : IF R1% THEN 13140 ELSE RETURN 13995 ! ! ** PROCESS A RECORD ** ! 14000 I8$=FNP8$(CHR$(2%),P1%,P2%) : I8%=FNG1%(C%,P5%,P6%) IF G1% OR G2% 14030 ! ! MARK EACH RECORD REFERENCED IN A POINTER FIELD ! 14040 FOR J%=1% TO G1% : G0%=G1%(J%) : FIELD #C%, B9%(6%,C%)+F1%(G0%,7%)-1% AS I8$, 3% AS I8$ : I8$=FNK1$(I8$,-F1%(G0%,7%)) IF B9%(10%,C%) : X2%=CVT$%(I8$) : IF X2% THEN X1%=F1%(G0%,2%) : X3%=ASCII(RIGHT(I8$,3%)) : GOSUB 16000 14070 NEXT J% : RETURN UNLESS G2% 14085 ! ! MARK EACH RECORD REFERENCED IN AN ASSOCIATION ! 14087 FIELD #C%, B9%(6%,C%)+1% AS I8$, 2% AS R1$, 1% AS R2$ 14088 WHILE ASCII(R2$)<>0% : R1%=CVT$%(R1$) : R2%=ASCII(R2$) : I8%=FNG1%(G3%,R1%,R2%) 14090 FOR J%=B9%(6%,G3%)+4% TO B9%(6%,G3%)+63% STEP 5% : FIELD #G3%, J% AS I8$, 2% AS I8$, 2% AS J8$, 1% AS K8$ 14110 I8%=CVT$%(I8$) : IF I8%=0% THEN 14120 ELSE GOTO 14115 IF G2%(I9%)=I8% FOR I9%=1% TO G2% : GOTO 14120 14115 X1%=G3%(I9%) : X2%=CVT$%(J8$) : X3%=ASCII(K8$) : GOSUB 16000 14120 NEXT J% : FIELD #G3%, B9%(6%,G3%)+1% AS I8$, 2% AS R1$, 1% AS R2$ : NEXT 14140 RETURN 14995 ! ! ** GET NEXT RECORD ** ! 15000 P6%=P6%+1% : IF P6%>512%/R3% THEN P6%=1% : P5%=P5%+1% 15030 P2%=P2%+1% : IF P2%=128% THEN P2%=0% : P1%=P1%+1% 15050 RETURN 15995 ! ! ** MARK A RECORD ** ! 16000 I8%=F2%(X1%,1%) : X4%=F2%(X1%,3%)+(4%*(X2%-1%))/I8% : X5%=F2%(X1%,4%)+((512%/I8%)*(X2%-1%)+X3%-1% AND 127%) : X4%=X4%+X5%/128% : X5%=X5% AND 127% 16030 ! ! CALCULATE ADDRESS AND MARK THE RECORD IN P$ ! 16040 IF (F2%(X1%,0%) AND -16384%)=0% AND F2%(X1%,1%)<>-1% THEN F2%(X1%,0%)=8192% : I8$=FNP8$(CHR$(1%),X4%,X5%) UNLESS ASCII(FNP9$(X4%,X5%)) 16050 RETURN 18995 ! ! WE ARE DONE WITH THIS PHASE ! 19000 I8%=FNC2%(0%) : GOSUB 25200 : CLOSE #11%, #10%, #12% : GOSUB 28000 : CHAIN '$GCOLL4' 20000 OPEN 'GCOLL.DAT' FOR INPUT AS FILE 9% : GOSUB 21000 WHILE BUFSIZ(9%) 20010 RETURN 21000 INPUT #9%, F$ : I% = FNO1% (0%, 0%, F$, -8%) : IF I% THEN F2% (B9% (9%, I%), 0%) = 16384% : I% = FNC2% (I%) 21010 RETURN 25000 DEF FNP8$ (P$, P8%, P9%) : GOSUB 25100 : P0$ (P0%, P9%), FNP8$ = P$ : P2% (P0%) = -1% : FN END 25010 DEF FNP9$ (P8%, P9%) : GOSUB 25100 : FNP9$ = P0$ (P0%, P9%) : FN END 25099 DIM P0$ (7%, 127%), P0% (7%), P1% (7%), P2% (7%) 25100 GO TO 25120 IF P0% (P0%) = P8% FOR P0% = 0% TO 7% : GO TO 25110 IF P1% (P0%) <= 0% FOR P0% = 0% TO 7% : I8$ = FNE2$ ('PAGE CONTROL ERROR') 25110 GOSUB 25210 IF P2% (P0%) : P2% (P0%) = 0% : P0% (P0%) = P8% : P0$ (P0%, Z2%) = P$ (P8%, Z2%) FOR Z2% = 0% TO 127% 25120 Z2% = P1% (P0%) : P1% (P0%) = 8% : P1% (Z1%) = P1% (Z1%) - 1% IF P1% (Z1%) > Z2% FOR Z1% = 0% TO 7% : RETURN 25200 GOSUB 25210 IF P2% (P0%) FOR P0% = 0% TO 7% : RETURN 25210 Z1% = P0% (P0%) : P$ (Z1%, Z2%) = P0$ (P0%, Z2%) FOR Z2% = 0% TO 127% : RETURN 28000 T1 = .1 * ( TIME (1%) - T1 ) : T0 = TIME (0%) - T0 : PRINT TAB (20%); : PRINT USING 'CPU TIME: ####.#, REAL TIME #####', T1, T0 : RETURN 29010 IF ERR = 5% AND ERL = 20000% THEN RESUME 20010 29020 IF ERR = 11% AND ERL = 21000% THEN CLOSE 9% : RESUME 21010 29910 IF E8$ = '9860' THEN PRINT "FILE "F$" NOT FOUND. CANNOT BE PRESERVED." : E8% = E8% + 1% : L8% = 0% : GO TO 1330 ! CATCH ATTEMPTS TO PRESERVE FILES NOT IN EXISTENCE. 29960 PRINT 'GARBAGE COLLECTION BOMBS OUT. CLEAN-UP IN PROGRESS.' : CLOSE 6% : OPEN 'LEA1.DAT' FOR INPUT AS FILE 6% : DIM #6%, I9% (1%) : I9% (0%) = 1% : CLOSE 6% : PRINT 'CLEAN-UP COMPLETE. GOOD LUCK.' 32767 I8%=FNC2%(0%) : END