(George Source)
Macros used: ADDSKIP, ANSOK, BFCBX, BS, BXE, BXGE, BXU, FDRMCHECK, FILENUMB, FIXTRA, FREECORE, GEOERR, JBC, JBS, LABFIX, LONGON, MAPBCH, PSTAC, SETREP, SFUB, SKIPTRACE, STEP, TESTUSEJ, TOPFCA2
22FL ...#SEG STEP [M.J.VELLACOTT 22^= ...#OPT K0STEP=0 23DW ...#LIS K0STEP>K0ACCESS>K0FILE>K0KERNEL>K0ALLGEO 23YG ...#OPT K6STEP=K6ACCESS>K6FILESTORE>K6KERNEL>K6ALLGEO 24D6 # 24XQ # THIS FIXED CORE SEGMENT IMPLEMENTS THE "STEP" MACROS 25CB # IN THE "READ" CASE IT SETS A POINTER IN X3 TO THE NEXT RECORD IN 25X2 # THE FILE OPEN AT DEPTH %A (0 IF %A MISSING).X3=0 IF WE STEP OFF 26BL # THE END OF FILE. THE STEP(APPEND)CASE INVOLVES MAKING SURE THE 26W= # LAST BLOCK OF THE FILE IS IN CORE,OR A NEW ONE,IF NEEDED.AS WE 27*W # GIVE THE CALLING ROUTINE A PTR. TO WHERE HE CAN APPEND A RECORD 27TG # OF LENGTH %B. IF WE HAVE TO READ A BLOCK DOWN, IN THE"READ"CASE 28*6 # WE GO TO 'READFILE', IN THE"APPEND"CASE TO 'APPEND'. 28SQ # 29#B # ON ENTRY IN X3,B0-8=DEPTH,B9-23=0 IN READ CASE 29S2 # =LENGTH OF RECORD TO BE APPENDED 2=?L # IN APPEND CASE 2=R= # THE ROUTINE USES X0,X1,X2,X3 ONLY. ON EXIT X1=FX1,X2=FX2 2?=W # 2?QG #DEF MCOMCOM=COMCOM [#01000100 2#=6 #DEF MCOMUNI=COMUNI [#17770000 2#PQ ZGEOER1B 2*9B LDN 0 1 2*P2 ADS 0 FFX3 2B8L ZGEOER1A 2BN= LDX 0 HVSKIP [J TO GEOERR IF NOT VSKIP 2C7W BPZ 0 ZGEOER1 2CMG LDN 3 -1 2D76 ANDX 3 FFX3 [SET X3 = UNEXPIRED COUNT OF RECORDS 2DLQ SETREP ENDFILE [TO BE SKIPPED 2F6B BRN TIDYUP [GO TO END 2FL2 ZGEOER1 2G5L GEOERR 0,ENDFILE 2GK= ZGEOER2 2H4W GEOERR 0,REC BIT 2HJG ZGEOER3 2J46 GEOERR 0,SKIPZERO 2JHQ ZGEOER5 2K3B GEOERR 0,STEPDEEP 2KH2 ZGEOER6 2L2L GEOERR 0,BEG FILE 2LG= ZGEOER7 2L^W GEOERR 0,APP REC! 2MFG ZGEOER8 2M^6 GEOERR 0,RECHD! 2NDQ # 2NF8 ...# THIS CHECKS A BLOCK OF A SERIAL FILE FOR CORRUPTNESS 2NFL ...# ON ENTRY X1->FCB ,X2->USAGE BLOCK 2NG4 ...XACHBL 2NGG ... LABFIX ACHBL 2NGY ... FIXTRA K1STEP 2NHB ... STO 0 GEN0 2NHS ... BRN XACHBLMERGE 2NJ= ... NULL 2NJN ... NULL 2NK6 ... BRN XACHBLMERGE 2NKJ ...XACHBLW 2NL2 ... LABFIX ACHBLW 2NLD ... FIXTRA K2STEP 2NLW ... STO 0 GEN0 2NM# ...XACHBLMERGE 2NMQ ... JBC (GEN0),1,BFSER [J IF NON-SERIAL FILE 2NN8 ... LDN 1 0 2NNL ...XGETNXT 2NP4 ... SMO 2 2NPG ... LDXC 0 A1(1) 2NPY ... BCC RHADD [J IFNOT DUMMY 2NQB ... ANDX 0 BRHMASK 2NQS ... BNZ 0 XITA [ILLEGAL BITS SET 2NR= ... SMO 2 2NRN ... LDEX 0 A1(1) 2NS6 ... BZE 0 XITA [J IF B0 ONLY SET 2NSJ ...RHADD 2NT2 ... BZE 0 (GEN0) [J ,OK AT END OF BLOCK 2NTD ... ADX 1 0 2NTW ... BXGE 1 BSBS,XITA [J IF X1 +512 2NW# ... BRN XGETNXT 2NWQ ...XITA 2NX8 ... LDX 0 GEN0 2NXL ... EXIT 0 1 2NYB # SUBROUTINE TO SEARCH FORWARD ALONG THE RING 2PD2 # DEPTH IN X3 2PXL SFFORWARD 2QC= LABFIX ASFSTACKF 2QWW LDX 2 FILERING(2) [PICK UP PTR. IN ACT. BLK. 2RBG BZE 3 SFEXIT1 [J IF ZERO DEPTH 2RW6 SFFORLP 2S*Q LDX 2 FPTRF(2) [PICK UP NEX POINTER IN RING 2STB BCT 3 SFFORLP [AND LOP FOR NEXT PTR 2T*2 SFEXIT1 2TSL EXIT 0 1 [EXIT ROUND OTHER CALL 2W#= # SUBROUTINE TO SEARCH BACKWARD DOWN RING 2WRW # 2X?G SFBAKWARD 2XR6 LABFIX ASFSTACKB 2Y=Q LDX 2 FILERING+1(2) [PICK UP BPTR.OF FILERING IN ACT.BLK. 2YQB SFBAKLP 2^=2 ADN 3 1 [NEG. LOOPING 2^PL BZE 3 SFEXIT2 [EXIT IF FOUND RIGHT ELEMENT 329= LDX 2 BPTRF(2) [LOAD BACK. PTR. 32NW BRN SFBAKLP 338G SFEXIT2 33N6 EXIT 0 0 347Q # 34MB # CHECKS DEPTH IS OK 3572 # 35LL #SKI K6STEP 366= ( 36KW SCHEEP 375G STO 1 GEN0 [STORE LINK 37K6 STO 3 GEN6 384Q BPZ 3 NONG 38JB NGX 3 3 3942 BRN NONG1 39HL NONG 3=3= ADN 3 1 3=GW NONG1 3?2G FILENUMB 0 [X0 = NO OF FILES OPEN 3?G6 SBX 0 3 3?^Q BNG 0 ZGEOER5 3#FB LDX 3 GEN6 3#^2 BRN (GEN0) 3*DL ) 3*Y= # 3BCW # 3BXG QLASTBL 3CC6 # EXITS NORMALLY IF FREADBLOCK -> LAST BLOCK 3CWQ # EXITS +1 O/W. 3DBB # ON ENTRY X3 -> FCB,X2->FCA 3DW2 LDN 0 A1-1 3F*L ADX 0 FBLMOD(3) 3FT= SBX 0 FREADBLOCK(2) 3G#W BZE 0 (1) 3GSG EXIT 1 1 3H#6 # 3HRQ PSTFCB 3J?B # SETS X1-> FSTACK;X3 ->FCB. 3JR2 # ON ENTRY X2 -> FCA 3K=L PSTAC 1,2 3KQ= BFCBX 3,1 3L9W EXIT 0 0 3LPG # USE OF GEN WORDS 3M96 # 3MNQ # ALL MACROS 3N8B # GEN0 - OVERWRITTEN BY SCHEEP S/R. 3NN2 # 3P7L # STEP 3PM= # 3Q6W # GEN0 - POINTER TO USAGE BLOCK 3QLG # GEN2 - SAVES X2 OVER TESTUSEJ MACRO 3R66 # GEN3 - R.H. OF RECORD LAST READ 3RKQ # 3S5B # STEP (APPEND) 3SK2 # 3T4L # GEN0 - POINTER TO USAGE BLOCK 3TJ= # GEN1 - POINTER TO FCB 3W3W # GEN2 - IF CMOD<0 ON ENTRY,THE LOOP THAT CALCULATES IT OVER- 3WHG # - WRITES IT 3X36 # GEN3 - PRESERVES PTR TO FCA OVER LONGON. NB - LONGON USES GEN6 3XGQ # GEN4 - THE VALUE OF CMOD ON ENTRY. 3Y2B # GEN6 - PRESERVES THE POINTER TO THE FCA OVER THE MAPBCH MACRO. 3YG2 # 3Y^L # STEPAGAIN 3^F= # 3^YW # GEN0 - POINTER TO USAGE BLOCK 42DG # 42Y6 # VSKIP PRE & POST COORDINATION ENTRIES 43CQ LABFIX AVSKIP1 43XB # BEFORE COORDINATINO 44C2 NGS 1 HVSKIP [SET HVSKIP MARKER 44WL BRN SKIPMERJ 45B= LABFIX AVSKIP2 45TW # AFTER COORDINATINO 46*G NGS 1 HVSKIP 46T6 BRN VSKRED 47#Q # 47SB # SKIP MACRO ENTRIES.POST COORDINATION ENTRIES MADE AT ASTEP2&4 48#2 LABFIX ASKIP1 48RL # ENTRY - ANY DEPTH,NOT YET COORDINATED 49?= STOZ HVSKIP [UNSET MARKER 49QW SKIPMERJ 4==G LDX 3 0 4=Q6 #SKI K6STEP 4?9Q ( 4?PB ANDN 0 -1 4#92 BZE 0 ZGEOER3 4#NL ADDSKIP I516A,ISKIP 4*8= ) 4*MW ANSOK [SET OK REPLY 4B7G ADN 1 ASTEPQ [STEP ON LINK 4BM6 LDX 2 FX2 4C6Q VSKJN 4CLB SBN 3 1 [DOWNDATE COUNT OF 4D62 BRN VSKRED 4DKL # 4F5= # 4FJW LABFIX AREAD3 4G4G # ENTRY: DEPTH %A;NOT YET COORDINATED. 4GJ6 ANSOK 4H3Q ADN 1 ASTEPQ [LINK TO JUMP OVER REST OF MACRO 4HHB LDX 2 FX2 4J32 LABFIX AREAD4 4JGL # ENTRY: DEPTH %A;JUST READ A BLOCK DOWN. 4K2= STOZ HVSKIP [UNSET MARKER 4KFW VSKRED 4K^G STO 3 FFX3 [PRESERVE DEPTH 4LF6 STO 1 FFWORKLINK [PRESERVE LINK 4LYQ SRA 3 15 [CONVERT DEPTH 4MDB BZE 3 STNZZER [J IF SKIP 0,1 OR STEP 0 4MY2 #SKI K6STEP 4NCL CALL 1 SCHEEP [CHECK DEPTH 4NX= BNG 3 SHUNTBACK [J IF DEPTH NEGATIVE 4PBW CALL 0 SFFORWARD [HUNT FORWARD IF POS 4PWG SHUNTBACK 4QB6 CALL 0 SFBAKWARD [HUNT BACKWARD IF NEG 4QTQ BRN STEPTOGETHR 4R*B LABFIX AREAD1 4RT2 # ENTRY %A MISSING;NOT YET COORDINATED 4S#L ANSOK [REPLY OK 4SS= ADN 1 ASTEPQ [ADJUST LINK 4T?W LDX 2 FX2 4TRG LABFIX AREAD2 4W?6 # ENTRY %A MISSING;JUST READ BLOCK DOWN 4WQQ STO 1 FFWORKLINK [STORE LINK 4X=B STOZ FFX3 [ZEROISE DEPTH 4XQ2 STOZ HVSKIP 4Y9L STNZZER 4YP= TOPFCA2 2 [X2 -> FCA 4^8W STEPTOGETHR 4^NG ADDSKIP I516A,ISTEP 5286 PSTAC 1,2 [X1-> FSTACK 52MQ PIKFUBNO 537B LDX 3 FREADBLOCK(2) [BLOCK POINTER 53M2 BPZ 3 T59 [J IF READ FROM FILE BEFORE 546L # THIS LAST LINE WORKS FOR A "STEPPED ON" EMPTY FILE,FOR EITHER 54L= # THE FILE'S LAST RECORD HAS JUST BEEN DELETED(IN WHICH CASE THERE 555W # WILL BE NO USAGE BLOCK) OR THE BLOCK DOESN'T BELONG TO THE FILE,OR 55KG # ISN'T A LEGAL BLOCK NUMBER 5656 LDN 3 FBLKS [SET EQUAL TO FBLKS 56JQ STO 3 FREADBLOCK(2) 574B T59 57J2 # ! ASSUMES FSTACK BEHIND FCB 583L ADX 3 BPTR(1) [ADD POINTER TO FCB X3-> BLOCK NUM. 58H= SKIPTRACE 699 ,FREADBLOCK(2),THISBLK 592W PIKF 59GG SFUB 1,0(3),1,MUSTCOOR [FIND USAGE BLOCK,JUMP TO"MUSTCOOR" IF ABSE 5=26 # X1 -> USAGE BLOCK 5=FQ # X2 => ELEMENT 5=^B # 5?F2 STO 1 GEN0 [PRESERVE 5?YL LDX 3 FREADWORD(2) 5#D= BPZ 3 STEPPED [CANNOT BE ZERO-J IF HAVE ALREADY READ FR 5#XW LDN 3 A1 [THIS BLOCK. OTHERWISE SET FREADWORD & X3 5*CG STO 3 FREADWORD(2) [TO 1ST RECORD IN BLOCK 5*X6 ADX 3 1 [-> 1ST RECORD IN BLOCK 5BBQ STO 3 GEN3 5BWB BRN ZEMPTYBL 5CB2 STEPPED 5CTL ADX 3 1 [X3 -> LAST RECORD READ. 5D*= SKIPSTEP 5DSW LDXC 0 FRH(3) 5F#G BCC NDUM9 [J IF NOT DUMMY 5FS6 YDUM9 5G?Q ANDX 0 BRHMASK 5GRB BNZ 0 ZGEOER8 [OR T99 IF FDUD. 5H?2 LDEX 0 FRH(3) 5HQL #SKI K6STEP [FIRST NON-DUMMY RECORD 5J== BZE 0 ZGEOER2 5JPW ADS 0 FREADWORD(2) [INCREMENT FREADWORD MEANWHILE. 5K9G ADX 3 0 [STEP ON CORE PTR 5KP6 LDXC 0 FRH(3) 5L8Q BCS YDUM9 [J IF DUMMY 5LNB NDUM9 5M82 BZE 0 QGEOBL 5MML ADS 0 FREADWORD(2) [UPDATE FREADWORD 5N7= STO 0 GEN3 [PRESERVE IN CASE NEXT R.H.IS ZERO 5NLW [(SO WE CAN DOWNDATE FREADWORD) 5P6G ADX 3 0 [X3=> NEXT RECORD 5PL6 ZEMPTYBL 5Q5Q YDUM8 5QKB LDXC 0 FRH(3) [IF NEXT RECORD IS A DUMMY,CHUG 5R52 BCC NDUM8 [ON LOOKING FOR NEXT NON-DUMMY 5RJL ANDX 0 BRHMASK 5S4= BNZ 0 ZGEOER8 [OR T97 IF FDUD. 5SHW LDEX 0 FRH(3) 5T3G #SKI K6STEP 5TH6 BZE 0 ZGEOER2 [ERROR IF 0 5W2Q ADS 0 FREADWORD(2) [INCREMENT FREADWORD 5WGB ADS 0 GEN3 [& GEN3,FOR THERE MAY BE ONLY DUMMY 5X22 ADX 3 0 [RECORDS LEFT IN THE FILE. 5XFL BRN YDUM8 [STEP ON PTR & GO BACK. 5X^= NDUM8 5YDW SKIPTRACE 199,0,NEXTREC 5YYG BNZ 0 TIDYUP1 [J TO END IF NOT E.O.BLOCK 5^D6 # THIS SECTION FREES THE USAGE BLOCK IF NOT USED BY ANYONE ELSE 5^XQ # & IS A FURB. IF A FUWB, GOES DOWN TO READFILE. 62CB CALL 0 PSTFCB [X3 ->FCB 62X2 CALL 1 QLASTBL [LAST BLOCK ? 63BL BRN SENDFILE [YES 63W= LDX 1 FPTR(3) [X1-> FSTACK 64*W # NB.DESTRUCTIVE COMMUNICATION -> LEAVE BIT SET !! 64TG JBS STEPDC,3,BFCORE [J IF 'LEAVE BLKS IN CORE' BIT SET. 65*6 JBS YENDBLK,3,BFGDR [J IF A GDR FILE 65SQ STO 2 GEN2 [ 66#B TESTUSEJ 2,WAITING,1 [J IF SOMEONE WAITING FOR THIS BLOCK 66S2 # UNFORTUNATELY WE HAVE TO FREE BLOCKS WHEN THEY'RE NO LONGER 67?L # USEFUL-OTHERWISE CORE GETS CLOGGED UP & USEFUL BLOCKS AEE THROWN 67R= # AWAY,WE CAN FREE READ BLOCKS EASILY BUT WRITE BLOCKS HAVE TO 68=W # WRITTEN BACK BY READFILE(WE CAN'T ISSUE EVEN AN AUTONOMOUS 68QG # BACKWRITE,ELSE THE FILE MAY BE CLOSED BEFORE ALL ITS BLOCKS 69=6 # ARE WRITTEN AWAY. 69PQ LDX 0 FFSFUWB [= #HAL +FILE+FUWB,0 6=9B SMO GEN0 [GEN0 => USAGE BLOCK 6=P2 BXE 0 ATYPE,YENDBLK [J IF FUWB 6?8L FREECORE GEN0 [FREE USAGE BLOCK 6?N= ADDSKIP I516A,ARDFR 6#7W LDX 2 GEN2 [ PICK 6#MG WAITING [ UP 6*76 PSTAC 1,2 [ PTRS AGAIN 6*LQ NOFRBLK 6B6B NGS 1 FREADWORD(2) [UPDATE RECORD PTR. 6BL2 UPDATEBL 6C5L LDN 0 1 6CK= ADS 0 FREADBLOCK(2) [UPADTE BLOCK PTR 6D4W BRN PIKFUBNO 6DJG QGEOBL 6F46 CALL 0 PSTFCB [X1 -> FSTACK,X3 ->FCB 6FHQ #SKI K6STEP 6G3B ( 6GH2 CALL 1 QLASTBL [LAST BLOCK ? 6H2L BRN ZGEOER1B [YES 6HG= ) 6H^W LDN 0 A1 6JFG STO 0 FREADWORD(2) 6J^6 PSTAC 1,2 6KDQ BRN UPDATEBL 6KYB SENDFILE [E.O.FILE 6LD2 ... LDX 0 FCOMMCT(3) 6LXL ... BZE 0 SENDFIS [J IF NOT COMMUNALLY OPEN 6MJD ... LDX 0 HVSKIP 6MPL ... BNG 0 SENDFIS [DONT WAIT FOR APPENDERIF VSKIP 6MWW JBS T97,3,BFDCF [J IF A DC FILE. 6NBG LDX 0 CTOPEN(3) [J IF NO APPNDERS 6NW6 ANDX 0 MCOMUNI 6P*Q BZE 0 SENDFIS 6PTB SRL 0 1 6Q*2 SBN 0 #4000 [J FI MORE THAN 1 APPENDER 6QSL BNZ 0 T97 6R#= JBS SENDFIS,2,BAMAPP [J IF ONLY ONE APPENDER & IT'S ME. 6RRW T97 6S?G LDX 0 GEN3 6SR6 SBS 0 FREADWORD(2) [DOWNDATE FREADWORD 6T=Q BRN T99 6TQB TIDYUP1 6W=2 #SKI I516A 6WPL ( 6X9= ILSTA [REENTRY IF OVERFLOW OCCURS 6XNW PSTAC 1,2 [THIS SECTION OF CODE TRIES TO 6Y8G BFCBX 1,1 [GIVE STATISTICS ON THE AVEIAGE 6YN6 LDXC 1 COMM(1) [SIZE OF RECORDS IN (A) SYSTEM 6^7Q BCS YDIR 6^MB ANDN 1 1 [FILES & (B) USER FILES. WE USE 7272 [THE DIRECTORY BIT AND 72LL BNZ 1 YDIR [THE L/WT BRT IN THE FCB TO DISTINGUI 736= ADS 0 IUSER [WE MAY BE ADVISED TO CHANGE THIS TO 73KW BVSR ISTRU [J TO STEPSTAT IF OVERFLOW 745G LDN 0 1 [DOUBLE LENGTH WORKING. 74K6 ADS 0 IUSEN 754Q BRN NDIR 75JB YDIR 7642 ADS 0 IDIRR 76HL BVSR ISTRD [J TO STEPSTAT IF OVERFLOW 773= LDN 1 1 77GW ADS 1 IDIRN 782G NDIR 78G6 INDIR 78^Q ) 79FB #SKI K6STEP 79^2 ( 7=DL LDX 0 FREADWORD(2) 7=Y= BXGE 0 BSBSA1,T97 [J IF FREADWORD CORRUPT. 7?CW ) 7?XG LDN 0 -1 [J IF NOT 7#C6 ANDX 0 FFX3 [YET FINISHED 7#WQ BNZ 0 SKIPCT [SKIPPING 7*BB TIDYUP 7*W2 LDX 2 FX2 [RESET X1 & X2 7B*L LDX 1 FX1 7BT= BRN (FFWORKLINK) [EXIT 7C#W SKIPCT 7CSG LDN 0 1 [DECREMENT COUNT 7D#6 SBS 0 FFX3 [OF STEPS YET TO BE 7DRQ BRN SKIPSTEP [DONE 7F?B STEPDC 7FR2 JBC NOFRBLK,3,BFDCF [J IF NOT A D.C.F. IF IT IS ,MUST EN 7G=L [READFILE TO RESHUFFLE BLOCK NUMBERS. 7GQ= YENDBLK 7H9W LDX 0 GEN3 [R.H.OF LAST REC READ 7HPG SBS 0 FREADWORD(2) [DOWNDATE FREADWORD 7J96 MUSTCOOR 7JNQ CALL 0 PSTFCB [X3 -> FCB 7K8B LDX 0 FBLMOD(3) 7KN2 SBX 0 FREADBLOCK(2) [TEST IF BL.NUM IS "NON-EXISTENT" 7L7L ADN 0 A1 [I E OFF END OF BLOCKLIST 7LM= BNZ 0 T99 [JIF 'LEGAL' BLOCK NO. 7M6W #SKI K6STEP 7MLG ( 7N66 LDX 0 FREADWORD(2) [ERROR IF ILLEGAL BL.NO. & READ E.O.F 7NKQ BPZ 0 ZGEOER1B 7P5B ) 7PK2 ... LDX 0 FCOMMCT(3) 7Q4L ... BZE 0 SENDFIS1 [J IF NOT COMMUNALLY OPEN 7QPD ... LDX 0 HVSKIP 7QWL ... BNG 0 SENDFIS1 [DONT WAIT FOR APPENDER IF VSKIP 7R3W JBS T99,3,BFDCF [J IF A DC FILE 7RHG LDX 0 CTOPEN(3) 7S36 ANDX 0 MCOMUNI 7SGQ BZE 0 SENDFIS1 [ J IF NO APPENDERS 7T2B SRL 0 1 7TG2 SBN 0 #4000 7T^L BNZ 0 T99 [J IF MORE THAN ONE APPENDER 7WF= JBC T99,2,BAMAPP [J IF APPENDER NOT ME 7WYW SENDFIS1 7XDG LDN 0 A1 [AS F'WORD INDICATED"ABOUT TO READ 7XY6 STO 0 FREADWORD(2) [E.O.F",DO SO 7YCQ SENDFIS 7YXB LDN 3 0 [END OF FILE , X3=0 7^C2 LDN 0 -1 7^WL ANDX 0 FFX3 [ERROR IF NOT YET FINISHED SKIPPING 82B= BNZ 0 ZGEOER1A 82TW BRN TIDYUP 83*G T99A 83T6 NGN 1 ASTEPR [ADJUST LINK TO GO 84#Q BRN T99B [DOWN TO APPEND. 84SB T99 85#2 NGN 1 ASTEPQ [ADJUST LINK FOR READFILE. 85RL T99B 86?= ADX 1 FFWORKLINK [ADJUST LINK 86QW LDX 3 FFX3 [PRESERVE DEPTH 87=G EXIT 1 0 87Q6 # 889Q # STEP "APPEND" CASE,HERE WE HAVE 2 PARAMS TO THE MACRO,THE DEPTH 88PB # IN THE TOP 9 BITS & THE LENGTH OF RECORD TO BE APPENDED IN THE 8992 # BOTTOM 9 BITS[N.B. MAX LENGTH OF RECORD =511 WDS & EVERY BLOCK 89NL # ENDS IN A ZERO RECORD. ] 8=8= # 8=MW LABFIX ASAPP4 8?7G TESTREPN FILEFULL,SAPSTOR1 [J IF REPLY NOT "FILE FULL" 8?M6 SAPEX 8#6Q STO 1 FFWORKLINK [SET LINK FOR QUICK GETAWAY 8#LB BRN TIDYUP [END & EXIT 8*62 LABFIX ASAPP3 8*KL LDX 2 FX2 8B5= ANSOK [FAT CHANCE ! 8BJW ADN 1 ASTEPR [SET LINK TO BYPASS APPEND ENTRY. 8C4G SAPSTOR1 8CJ6 STO 3 FFX3 [STORE PARAMS 8D3Q STO 1 FFWORKLINK [& LINK 8DHB SRA 3 15 [CONVERT DEPTH 8F32 BZE 3 SAPPZ3 [J IF ZERO 8FGL #SKI K6STEP 8G2= CALL 1 SCHEEP [CHECK DEPTH 8GFW BNG 3 SAPBAK [DEPTH NEG-BACKWARD HUNT FOR ELEMENT 8G^G CALL 0 SFFORWARD [SEARCH FORWARD DOWN RING 8HF6 SAPBAK 8HYQ CALL 0 SFBAKWARD [JUMPED OVER BY OTHER S/R. 8JDB BRN SAPMERJ [X2 -> ELEMENT 8JY2 LABFIX ASAPP2 8KCL TESTREPN FILEFULL,SAPSTOR2 [J IF FILE NOT FULL 8KX= BRN SAPEX [O/W EXIT 8LBW LABFIX ASAPP1 8LWG LDX 2 FX2 8MB6 ADN 1 ASTEPR [SET LINK ON. 8MTQ ANSOK (HUNH! 8N*B SAPSTOR2 8NT2 STO 1 FFWORKLINK [STORE LINK 8P#L STO 3 FFX3 [& LENGTH OF RECORD 8PS= SAPPZ3 8Q?W TOPFCA2 2 [X2 -> FCA 8QRG SAPMERJ [ALL TOGETHER NOW ! 8R?6 ADDSKIP I516A,ISTAP 8RQQ CALL 0 PSTFCB [X1 -> FSTACK,X3 -> FCB 8S=B STO 3 GEN1 [GEN1 -> FCB 8SQ2 FDRMCHECK 3,T99A 8T9L LDX 0 FBLMOD(3) 8TP= SBN 0 FBLKS-A1 8W8W BZE 0 T99A [J IF EMPTY FILE. 8WNG ADX 3 FBLMOD(3) [X3 -> BLOCK NUMBER(ALMOST) 8X86 SFUB 1,A1-1(3),1,T99A [X1->USAGE BLK,UNLESS NOT THERE 8XMQ [WHEN WE BRANCH TO"MUSTCOOR" 8Y7B LDX 3 GEN1 8YM2 STO 1 GEN0 [PTR TO USAPE BLOCK 8^6L JBC NOCAR,3,BFCARE [J IF NOT A 'CAREFUL'FILE. 8^L= JBS NOCAR,2,BAAPP [J IF APPEND ALREADY BEEN DONE ON FIL 925W [AS BIT IN FMAPP BLOCK WILL BE SET. 92KG LDX 0 FBLMOD(3) [BIT FOR THIS BLOCK IN THE FMAP BLOCK 9356 STO 2 GEN6 [PRESERVE 93JQ SBN 0 FBLKS-A1 944B MAPBCH 0,3 94J2 BZE 0 T99A [J IF BIT NOT SET,TO SET IT IN APPEND 953L LDX 2 GEN6 95H= LDX 1 GEN0 962W NOCAR 96GG LDX 0 CMOD(3) [J IF APPEND ALREADY 9726 BPZ 0 SAPPSCHON [DONE ON FILE 97FQ ADN 1 A1 [PTRS REL TO START OF BLOCK 97^B LDX 0 FRH(1) [NEXT R.H. 98F2 BZE 0 NDUM52 [J IF END 98YL BPZ 0 SMOR [J IF NOT DUMMY 99D= LDCT 0 #100 99XW ANDX 0 FRH(1) [J IF "UNAPPENDED RECORD";WHICH IS 9=CG BNZ 0 NDUM52 [EQUIVALENT TO END OF FILE. 9=X6 LDEX 0 FRH(1) [BOTTOM 9 BITS OF R.H. 9?BQ BRN SMOR 9?WB NDUM52 9#B2 LDN 1 A1 [X1 IS RELATIVE PTR TO AREA IN BLOCK 9#TL [WHERE WE CAN APPEND RECORD. 9**= NGS 1 GEN4 9*SW BRN QFIT [IN THIS CASE :- AT START OF FUWB 9B#G SMOR 9BS6 STO 0 GEN2 [TEMP.WORK WORD,CONTAINS R.H OF LAST 9C?Q ADX 1 0 [RECORD 9CRB LDX 0 FRH(1) [NEXT R.H. 9D?2 BZE 0 NDUM55 [J IF END OF BLOCK 9DQL BPZ 0 SMOR [J IF NOT DUMMY. 9F== LDCT 0 #100 [J IF "NOT YET APPENDED RECORD" 9FPW ANDX 0 FRH(1) [THIS IS EQUIVALENT TO END OF BLOCK 9G9G BNZ 0 NDUM55 9GP6 LDEX 0 FRH(1) [BOTTOM 9 BITS 9H8Q BRN SMOR 9HNB NDUM55 9J82 SBX 1 GEN0 [RELATIVISE RECORD POINTER 9JML LDX 0 1 [CALCULATE "OLD" CMOD IN CASE WE NEED 9K7= SBX 0 GEN2 [IT TO UPDATE READ PTRS. 9KLW STO 0 GEN4 [STORE'OLD' CMOD 9L6G BRN QFIT 9LL6 SAPPSCHON 9M5Q STO 0 GEN4 [STORE'OLD' CMOD 9MKB ADX 1 0 [ADD IN APPEND PTR 9N52 LDCT 0 #100 [J IF "UNAPPENDED RECORD" WHICH IS 9NJL ANDX 0 FRH(1) [EQUIVALENT TO END OF FILE. 9P4= BNZ 0 QFIT1 9PHW LDEX 0 FRH(1) [BOTTOM 9 BITS 9Q3G ADX 1 0 9QH6 QFIT1 9R2Q SBX 1 GEN0 [RELATIVISE 9RGB QFIT [NOW CHECK IF RECORD WILL FIT 9S22 SKIPTRACE 199,GEN4,OLD CMOD 9SFL LDEX 0 FFX3 [X0 CONTAINS LENGTH OF RECORD 9S^= ADX 0 1 [ADD PTR.TO ZERO REC [LAST IN BLOCK] 9TDW [(N.B.RELATIVE PTR 9TYG BXGE 0 BSBSA1,T99A [J IF RECORD WON'T FIT. 9WD6 STO 1 CMOD(3) [CMOD 9WXQ ADX 1 GEN0 [NOW IS OF POINTER 9XCB ADX 0 GEN0 [POINTS TO R.H.OF NEXT RECORD 9XX2 SMO 0 [STOZ IT 9YBL STOZ 0 [NOW HAVE"HOLE"WITH ZERO R.H.& ZERO 9YW= [RECORD AFTER LAST WORD WHICH 9^*W [IS BIG ENOUGH FOR RECORD REQUESTED 9^TG BS 3,BFALTR [SET 'REEL ALTERED' BIT IN COMM =2*6 LDX 0 MCOMCOM [WAITING BITS FOR COMMUNICATION =2SQ ANDX 0 COMM(3) [IF THEY ARE SET,SONEONE(PROBABLY A =3#B BZE 0 NOWAIT [READER)IS WAITING FOR US TO APPEND =3S2 ERS 0 COMM(3) [TO THIS FILE =4?L [ WE UNSET THE BIT(5) THAT WERE SET & WAKE UP WAITERS IN STYLE #5 =4R= STO 2 GEN3 =5=W LDX 2 3 =5QG LDX 3 1 [X3 ^ RECORD POSITION =6=6 LONGON 5,BACK2(2) [RELEASE WAITERS =6PQ LDX 2 GEN3 =79B BRN R209 =7P2 NOWAIT =88L LDX 3 1 [X3 ^ RECORD POSITION =8N= R209 =97W BS 2,BAAPP [SET 'APPEND BEEN DONE' BIT. =9MG LDX 1 GEN0 [USAGE BLOCK ==76 LDX 0 FFSFUWB [MAKE USAGE BLOCK ==LQ STO 0 ATYPE(1) [A WRITE BLOCK =?6B LDX 1 GEN1 [X1 & GEN1 -> FCB =?L2 LDX 0 FREADBLOCK(2) =#5L SBX 0 FBLMOD(1) [DOES F'BLOCK ->'UNUSED' BLOCK NO? =#K= SBN 0 A1 =*4W BNG 0 TIDYUPA =*JG LDX 0 FREADWORD(2) =B46 BNG 0 STOGEN4 [J IF WAS"ABOUT TO READ EOF" =BHQ LDX 0 CMOD(1) [RECORD PTR = NEW CMOD =C3B STONUPT =CH2 STO 0 FREADWORD(2) [STORE APPROPRIATE RECORD PTR. =D2L LDX 0 FBLMOD(1) [BLOCK PTR = FBLMOD =DG= ADN 0 A1-1 =D^W STO 0 FREADBLOCK(2) =FFG TIDYUPA =F^6 LDEX 1 FFX3 [R.H. =GDQ LDCT 0 #500 [DUMMY & UNAPPENDED RECORD BITS. =GYB ADX 1 0 =HD2 STO 1 FRH(3) [STORE IN R.H. =HXL BRN TIDYUP =JC= STOGEN4 =JWW LDX 0 GEN4 [RECORD PTR = OLD CMOD,PRESERVED IN =KBG BRN STONUPT [GEN4 FOR THIS VERY EVENTUALITY =KW6 # =L*Q # ENTRIES FOR STEPAGAIN =LTB # =M*2 LABFIX ASTAG3 =MSL ANSOK =N#= ADN 1 ASTEPQ [TO STEP OVER READFILE ENTRY =NRW LDX 2 FX2 =P?G LABFIX ASTAG4 =PR6 STO 3 FFX3 =Q=Q STO 1 FFWORKLINK =QQB SRA 3 15 [CONVERT DEPTH =R=2 BZE 3 STAGZ3 [J IF ZERO =RPL #SKI K6STEP =S9= CALL 1 SCHEEP [CHECK DEPTH =SNW BNG 3 SGBAK [J IF DEPTH RELATIVE TO BOTTOM =T8G CALL 0 SFFORWARD [FSTACK OTRS FORWARD SEARCH =TN6 SGBAK =W7Q CALL 0 SFBAKWARD [FSTACK POINTERS:BACKWARD SEARCH =WMB BRN SGETHR =X72 LABFIX ASTAG1 =XLL ANSOK =Y6= LDX 2 FX2 =YKW ADN 1 ASTEPQ [TO JUMP OVER READFILE REENTRY =^5G LABFIX ASTAG2 =^K6 STO 1 FFWORKLINK ?24Q STOZ FFX3 ?2JB STAGZ3 ?342 TOPFCA2 2 [X2 -> FCA AT TOP LEVEL ?3HL SGETHR ?43= ADDSKIP I516A,ISTAG ?4GW STNOK1 ?52G PSTAC 1,2 [X1 -> FSTACK ?5G6 LDX 3 FREADBLOCK(2) ?5^Q #SKI K6STEP ?6FB BNG 3 ZGEOER6 [MUSTN'T BE AT BEGINNING OF FILE ?6^2 LDX 0 FREADWORD(2) [FWORD ?7DL BPZ 0 STOK1 [J IF NONNEGATIVE ?7Y= #SKI K6STEP ?8CW ( ?8XG SBN 3 FBLKS [IS IT 1ST BLOCK ? ?9C6 BZE 3 ZGEOER6 ?9WQ LDX 3 FREADBLOCK(2) ?=BB ) ?=W2 LDX 0 BSBSA1 [RECORD PTR GIVEN SPECIAL SETTING ??*L STO 0 FREADWORD(2) [(=GSBS+A1) AS A SPECIAL SETTING ??T= SBN 3 1 [BACK ONE BLOCK ?##W STO 3 FREADBLOCK(2) [STORE NEW BLOCK POINTER ?#SG STOK1 ?*#6 # ! ASSUMES FSTACK BEHIND FCB ?*RQ SMO BPTR(1) ?B?B LDX 0 FBLMOD [J TO GIVE EOF REPLY ?BR2 SBN 0 FBLKS-A1 [IF EMPTY ?C=L BZE 0 SENDFIS [FILE ?CQ= SMO BPTR(1) ?D9W LDX 0 FBLMOD ?DPG ADN 0 A1 ?F96 SBX 0 3 ?FNQ BZE 0 SENDFIS [J IF PTS TO UNUSED BLOCK NO ?G8B ADX 3 BPTR(1) [POINTS TO BLOCK NUMBER ?GN2 SFUB 1,0(3),3,MUSTCOOR [SE3 X3->FURB,J TO MUSTCOOR WHEN ?H7L [ABSENT ?HM= LDX 0 FREADWORD(2) [RECORD PTR ?J6W BXU 0 BSBSA1,STOK2 [JFI NOT SPECIAL SETTING ?JLG STOK4 ?K66 STO 1 GEN0 [PRESERVEPTO ?KKQ LDN 1 A1 [INITIALISE ?L5B STO 1 GEN5 [GEN5 CONTAINS"LAST R.H.",IN THIS CAS ?LK2 STOK3 ?M4L ADX 3 GEN5 [ADD IN LAST R.H. ?MJ= LDXC 0 FRH(3) [NEXT R.H. ?N3W BCC NDUM36 [J IF NOT DUMMY ?NHG LDN 1 0 [INITIALISE X1-COUNT OF RECORD ?P36 YDUM36 [HEADERS OF DUMMY RECORDS ?PGQ LDEX 0 0 [BOTTOM 9 BITS ?Q2B ADX 1 0 [CT. OF DUMMY R.H.'S ?QG2 ADX 3 0 [UPDATE PTR ?Q^L LDX 0 FRH(3) [NEXT REC.HDR. ?RF= BZE 0 STAGSUBDUM [J IF END OF BLOCK ?RYW BNG 0 YDUM36 [BACK IF DUMMY ?SDG NDUM36 ?SY6 BZE 0 STAGSUB [J IF E.O. BLOCK ?TCQ STO 0 GEN5 [PRESERVE LAST R.H. ?TXB BRN STOK3 ?WC2 STAGSUBDUM ?WWL SBX 3 1 [SUB CT. OF DUMMY R.H'S. ?XB= STAGSUB ?XTW SBX 3 GEN5 [SUB R.H.AGAIN ?Y*G LDX 0 3 [FREADWORD ?YT6 SBX 0 GEN0 [ ?^#Q STO 0 FREADWORD(2) [J IF NOT EMPTY BLOCK OR ONLY ?^SB BNZ 0 TIDYUP [DUMMY RECORDS @ BEGINNING #2#2 STOK6 #2RL NGS 3 FREADWORD(2) [PTRS TO END OF PREVIOUS BLOCK #3?= BRN STNOK1 [BACK & TRY AGAIN #3QW STOK2 #4=G ADX 3 0 [ADD IN F'WORD #4Q6 YDUM48 [J IF NOT EOF #59Q LDXC 0 FRH(3) [NEXT R.H. #5PB BCC NDUM48 [IGNORE IF DUMMY #692 LDEX 0 0 [9 BITS #6NL ADX 3 0 [LOOP DOWN TO NEXT NONZERO #78= ADS 0 FREADWORD(2) [R.H. #7MW BRN YDUM48 #87G NDUM48 #8M6 BNZ 0 TIDYUP #96Q CALL 0 PSTFCB [X3 -> FCB #9LB CALL 1 QLASTBL [LAST BLOCK ? #=62 BRN SENDFIS [YES #=KL LDN 0 1 [MOVE READ PTRS TO "HAVE READ" #?5= ADS 0 FREADBLOCK(2) [1ST RECORD IN NEXT BLOCK #?JW LDN 0 A1 [ ##4G STO 0 FREADWORD(2) [NO NEED TO TIDY UP USAGE BLOCK, ##J6 BRN SGETHR [AS THIS PATH IS INFREQUENT #*3Q #END ^^^^ ...06762233000100000000