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