16 22FL ...#SEG PERUSFIL6 [M.J.VELLACOTT. 15 22_= #OPT K0PERUSFIL=K0ACCESS>K0FILESTORE>K0ALLGEO 7 23DW #LIS K0PERUSFIL 15 23YG #OPT K6PERUSFIL=K6ACCESS>K6FILESTORE>K6ALLGEO 7 24D6 8HPERUSFIL 11 24XQ SEGENTRY K7PERUSFIL,NGET 11 25CB SEGENTRY K16PERUSFIL,READB 11 25X2 SEGENTRY K27PERUSFIL,ZGET 12 26BL SEGENTRY K30PERUSFIL,REWIND 12 26W= SEGENTRY K31PERUSFIL,ZREWIND 12 27*W SEGENTRY K40PERUSFIL,NBSPACE 12 27TG SEGENTRY K44PERUSFIL,ZBSPACE 12 28*6 SEGENTRY K67PERUSFIL,ZREADB 12 28SQ SEGENTRY K80PERUSFIL,READAGAIN 13 29#B SEGENTRY K81PERUSFIL,ZREADAGAIN 11 29S2 SEGENTRY K82PERUSFIL,RBACK 12 2=?L SEGENTRY K83PERUSFIL,ZRBACK 12 2=HD ... SEGENTRY K84PERUSFIL,ZBSKIP 18 2=R= # IMPLEMENTS MACROS WHOSE ENTRY POINTS ARE AS FOLLOWS :- 9 2?=W # K30 - 'REWIND' 12 2?QG # K31 - ^ (ZERO DEPTH) 10 2#=6 # K40 - 'BACKSPACE' 12 2#PQ # K44 ^ (ZERO DEPTH) 9 2*9B # K16 - 'READB' 13 2*P2 # K67 - . ^ [ZERO DEPTH 10 2B8L # K80 - 'READAGAIN' 13 2BN= # K81 - ^ (ZERO DEPTH) 10 2C7W # K82 - 'READBACK' 13 2CMG # K83 - ^ (ZERO DEPTH) 13 2D76 # K7 - 'GETAFURB' NONZERO DEPTH 13 2DLQ # K27 - [ ZERO DEPTH 4 2F6B # 4 2FL2 # 4 2G5L # 17 2GK= # THE SEGMENT IS IMPLEMENTED USING FILESTORE RINGS 4 2H4W # 20 2HJG # ALL FILES OPEN HAVE AN FCB IN THE FILE CHAIN. NEXT TO THIS FCB 21 2J46 # THERE IS A FILE/FSTACK BLOCK CONTAINING AN ENTRY FOR EACH ACTIVITY 11 2JHQ # THAT HAS THE FILE OPEN. 16 2K3B # THIS ENTRY IS 'FELLEN'(CURRENTLY=7 WDS) LONG 21 2KH2 # EACH ENTRY IN THE STACK IS RINGED TO THE ACTIVITY THAT IT REPRESE 21 2L2L # AND THE NTH ELEMENT ALONG THE RING REPRESENTS THE FILE OPEN AT 7 2LG= # DEPTH N 10 2L_W # THE ENTRY LOOKS LIKE: 17 2MFG # WORD 1 FPTRF :FORWARD POINTER ALONG RING 17 2M_6 # WORD 2 BPTRF :BACKWARD POINTER ALONG RING 21 2NDQ # WORD 3 FBACKPOINT :RELATIVE BACKWARD POINTER TO START OF FSTACK 21 2NYB # WORD 4 FREADBLOCK :POINTER TO NUMBER OF CURRENT BLOCK BEING READ 21 2PD2 # WORD 5 FREADWORD : ^ ^ ^ ^ ^ RECORD ^ ^ 21 2PXL # WORD 6 FGENERAL1 :(OLD FCA5 WORD) ALLPURPOSE WORD,BITS SET HAVE 21 2QC= # WORD 7 FGENERAL2 :SPECIAL MEANINGS FGENERAL2 IS FOR EXPANSION 4 2QWW # 16 2RBG # BITS IN THE FGENERL WORDS MEAN AS FOLLOWS:- 7 2RW6 # A) FGENERAL1 11 2S*Q # B0 : )READ MODE 13 2STB # B1 : )READRANDOM MODE 12 2T*2 # B2 :FILE OPEN IN >APPEND MODE 12 2TSL # B3 : )WRITE MODE 12 2W#= # B4 : )GENERAL MODE 7 2WRW # B5 :UNUSED 11 2X?G # B6 :FILE OPEN IN CLEAN MODE 20 2XR6 # B8 :FILE IS COMPONENT OF STREAM OR S.D.F.OTHER THAN MASTER ONE 17 2Y=Q # B9 :TWO REELS OPEN IN GENERAL MODE,LAST AND ANOTHER 17 2YQB # B10:FILE HAS HAD RECORDS DELETED FROM IT (COMPRESS) 11 2_=2 # B11:OPEN FOR COMMUNICATION 10 2_PL # B12:MAGTAPE BULK FILE 8 329= # B13:DIRECTORY 19 32NW # B14:OPEN IN USERCLEAN MODE(= COMMUNICATION FOR RANDOM FILES) 4 338G # 15 33N6 # BITS 8,9,&12 ARE CURRENTLY(11/9/69) NOT USED 21 347Q # B15-23 USED TO BE USED TO HOLD THE ^HEIGHT^ OF THE FILE. CURRENTLY 7 34MB # DISUSED 9 3572 # BIT 5 UNALLOCATED 20 35LL # B7 USED TO BE THE END-OF-FILE BIT,BUT WE'VE DONE AWAY WITH IT 13 366= # (I HOPE). IT'S NOW UNALLOCATED. 7 36KW # B) FGENERAL2 14 375G # B23:THIS ACTIVITY WAITING FOR THIS BLOCK 15 37K6 # B22:THIS ACTIVITY HAS GONE FOR THIS BLOCK 4 384Q # 10 38JB # THE REST UNALLOCATED 21 3942 # ------------------------------------------------------------------- 4 39HL # 4 3=3= # 5 3=GW MASK2 5 3?2G MCOMUNI 7 3?G6 #17770000 5 3?_Q ZGEOER1 9 3#FB GEOERR 1,READDEEP 5 3#_2 ZGEOER2 9 3*DL GEOERR 1,REC BIT? 5 3*Y= ZGEOER3 9 3BCW GEOERR 1,END FILE 5 3BXG ZGEOER6 10 3CC6 GEOERR 1,CANTBACK 4 3CWQ Z7 5 3DBB ZGEOER7 10 3DW2 GEOERR 1,CANTREAB 5 3F*L ZGEOER8 9 3FT= GEOERR 1,BEG FILE 4 3G#W Z11 5 3GSG ZGEOER11 10 3H#6 GEOERR 1,CANTREWI 4 3HRQ # 10 3J?B # SFUBREAD SUBROUTINE 4 3JR2 # 21 3K=L FILETRAN [SUBROUTINES FOR SPECIAL FILESTORE 18 3KQ= [B.S. TRANSFER ROUTINES. 5 3L9W SFUBREAD 16 3LPG # LOOKS FOR A BLOCK,& READS IT DOWN IF NECESSARY 13 3M96 # ON ENTRY X2=>FSTACK,X3=> F.C.A. 17 3MNQ # ON EXIT X2->FSTACK,X3=> F.C.A. X1-> USAGE BLOCK 15 3N8B BFCBX 1,2 [X1 -> FCB 6 3NN2 SFUBREAD1 19 3P7L JBS WAITDCFX1,1,BFAPPCARE [J IF 'CAREFUL UPDATING' 18 3PM= [BEING DONE BY APPEND 5 3Q6W NOWAITDC 10 3QLG SMO FREADBLOCK(3) 17 3R66 LDX 4 0(1) [X4 = BLOCK NUMBER 11 3RKQ SKIPTRACE 299,4,SFUBREAD 19 3S5B SFUB 2,4,1,READFCB [J IF USAGE BLOCK NOT THERE 7 3SK2 EXIT 5 0 4 3T4L # 20 3TJ= # WE CAN'T GET THE LAST BLOCK IF CAREFUL UPDATING IS BEING DONE 21 3W3W # BY APPEND AS FBLMOD WILL BE INCORRECT & THE BLOCK USUALLY IS FULL 19 3WHG # OF RUBBISH. THIS INTERLOCK SHOULD BE GOT ROUND EVENTUALLY. 6 3X36 WAITDCFX1 17 3XGQ LDX 0 FBLMOD(1) [J IF NOT LAST BLOCK 8 3Y2B ADN 0 A1-1 13 3YG2 BXU 0 FREADBLOCK(3),NOWAITDC 16 3Y_L SBX 5 FX1 [DECREMENT LINK 5 3_F= WAITDC 20 3_YW BS 1,BFCAREW [SET THE 'WAITING FOR APPEND TO 20 42DG [FINISH CAREFUL UPDATING' BIT. 13 42Y6 COOR3 #113 [WAIT 9 43CQ CALL 4 ZEXTRO 9 43XB CALL 4 POINTERS 15 44C2 BC 1,BFCAREW [UNSET BIT 16 44WL ADX 5 FX1 [INCREMENT LINK 15 45B= BRN SFUBREAD1 [TRY AGAIN 9 45TW # READ SUBROUTINE 15 46*G # THIS READS THE NEXT BLOCK OF THE FILE DOWN 10 46T6 # WAITING IF NECESSARY 4 47#Q # 19 47SB # WAITING IS THE COMPLEX PART.WE MUST AVOID,AT ALL COSTS, 21 48#2 # READING THE SAME BLOCK DOWN TWICE,WHILE MAUING SURE THAT ANYONE 11 48RL # WANTING A BLOCK GETS IT. 4 49?= # 11 49QW # THERE ARE TWO MAIN CASES. 10 4==G # (A) NOT LAST BLOCK' CASE 20 4=Q6 # WE TEST TO SEE IF ANY OTHER READER HAS GONE FOR THIS BLOCK. 20 4?9Q # ' IF YES WE SET OURSELVES WAITING IN STYLE 7,SETTING A BIT IN 19 4?PB # FGENERAL2.EVENTUALLY,WHEN WE WAKE UP,THE BLOCK IS THERE. 20 4#92 # 2 IF NO WE GO AND DO A BACKREAD(SETTING GONE FOR THIS BLOCK BIT) 4 4#NL # 9 4*8= # (B) LLAST BLOCK' CASE 20 4*MW # 1 IF SOMEONE HAS GONE FOR LAST BLOCK,WE SET OURSELVES WAITING 20 4B7G # IN STYLE 4,SETTING THE WAITING FOR LAST BLOCK BIT IN THE FCB. 20 4BM6 # 2 IF ANYONE HAS^GONE FOR THIS BLOCK^,WE SET ^WAITING FOR THIS 13 4C6Q # BLOCK(FGEN.1) & WAIT IN STYLE 7 20 4CLB # 3 IF NOONE HAS GONE FOR THIS BLOCK,WE CHECK IF THE ^GONE FOR NEW 21 4D62 # BLOCK^BIT IS SET.IF IT IS NOT WE SET GONE FOR LAST BLOCK BIT ,AND 17 4DKL # WE ALSO SET GONE FOR THIS BLOCK BIT IN EITHER CASE 21 4F5= # THIS IS BECAUSE WE MAY GO TO READ DOWN A LAST BLOCK JUST AFTER 21 4FJW # SOMEONE ELSE HAS GONE TO GET A NEW BLOCK;LATER SOMEONE ELSE MIGHT 21 4G4G # COME FOR A BLOCK,AFTER THE NEW BLOCK HAS BEEN OBTAINED,AND READ 20 4GJ6 # THE SAME BLOCK DOWN,APPEND WILL NOT GET A NEW BLOCK IF ANYONE 11 4H3Q # HAS GONE FOR LAST BLOCK. 16 4HHB READSTACK [ENTRY IF NO POINTERS AT ALL 9 4J32 CALL 4 ZFSTACK 21 4JGL READFCB [ENTRY IF HAVE POINTERS ONLY TO FSTACK & ELEMENT 17 4K2= BFCBX 1,2 [X1 IS POINTER TO FCB 4 4KFW READ 12 4K_G SBX 5 FX1 [ADJUST LINK 10 4LF6 LDX 0 FREADBLOCK(3) 11 4LYQ SKIPTRACE 699,0,READFCB 21 4MDB BPZ 0 R1 [J IF FILE HAS BEEN READ FROM BEFORE 18 4MY2 LDN 0 FBLKS [O/W SET TO INITIAL VALUE 10 4NCL STO 0 FREADBLOCK(3) 4 4NX= R1 13 4PBW LDX 0 FBLMOD(1) [J IF 14 4PWG ADN 0 A1-1 [NOT LAST 17 4QB6 BXU 0 FREADBLOCK(3),NOLBLOK [ BLOCK IN FILE 21 4QTQ JBC SETGONR,1,BFLAST [J IF 'GONE FOR LAST BLOCK' BIT UNSET 21 4R*B BS 1,BFLASTW [SET 'WAITING FOR LAST BLOCK' BIT. 13 4RT2 COOR3 #4 [WAIT 16 4S#L CALL 4 ZEXTRO [ELEMENT POINTER 18 4SS= CALL 4 POINTERS [FSTACK & FCB POINTERS 15 4T?W BC 1,BFLASTW [UNSET BIT. 8 4TRG BRN SFUBR 15 4W?6 SETGONR [^GONE FOR LAST BLOCK^ BIT IS SET 21 4WQQ CALL 4 TESTLOOK [ROUTINE TO TEST IF SOMEONE'S GONE 20 4X=B BRN SETWAITR [FOR THIS BLOCK.JTW^SETWAITR^ IF 15 4XQ2 [SOMEONE IS 15 4Y9L BFCBX 1,2 [X1 -> FCB 21 4YP= JBS RBACKR,1,BFNEW [J IF 'GETTING NEW BLOCK' BIT SET. 20 4_8W BS 1,BFLAST [SET 'GONE FOR LAST BLOCK' BIT. 9 4_NG BRN RBACKR 16 5286 WAITR [SOMEONE(S)WAITING FOR THIS BLOCK 18 52MQ LDX 3 1 [PICK UP FSTACK PTR AGAIN 17 537B FON 7 [FON ALL THE WAITERS 15 53M2 CALL 4 POINTERS [FSTACK & FCB 8 546L BRN NOWO 5 54L= SETWAITR 21 555W BS 3,BAFBLKW [SET 'WAITING FOR THIS BLOCK' BIT. 15 55KG COOR3 #7 [WAIT FOR IT 15 5656 CALL 4 ZEXTRO [ELEMENT PTR 17 56JQ CALL 4 POINTERS [FSTACK & FCB PTR 15 574B BC 3,BAFBLKW [UNSET BIT. 5 57J2 SFUBR 10 583L SMO FREADBLOCK(3) 8 58H= LDX 4 0(1) 20 592W SFUB 2,4,1,SBFCBX [J IF BLOCK NOT THERE TO SFCBX 9 59GG BRN RLINKR 5 5=26 NOLBLOK 7 5=FQ #SKI K6PERUSFIL 12 5=_B BXL 0 FREADBLOCK(3),ZGEOER3 21 5?F2 CALL 4 TESTLOOK [HAS SOMEONE GONE FOR THIS BLOCK ? 14 5?YL BRN SETWAITR [J IF YES 7 5#D= BFCBX 1,2 5 5#XW RBACKR 20 5*CG BS 3,BAFBLK [SET 'GONE FOR THIS BLOCK' BIT. 7 5*X6 LDX 2 1 18 5BBQ ADX 2 FREADBLOCK(3) [GIVES PTR TO BLOCKNUMBER 8 5BWB VARIADNR 1 12 5CB2 SKIPTRACE 299,0(2),BACKREAD 10 5CTL ADDSKIP I516A,ARDRD 7 5D5D ...#SKI JSKI33-1 7 5D*= FILEREAD 7 6 5DGD ...#SKI JSKI33 9 5DML ... FILEREAD 7,FAIL 16 5DSW MHUNTW 1,BSTB,BREAD [FIND BUFFER BLOCK 16 5F#G CALL 4 ZFSTACK [STACK & ELEMENT 9 5FS6 LDX 4 BPTR(2) 21 5G?Q SMO 4 [BS HOME MAY HAVE CHANGED,SO U DATE 15 5GRB LDX 0 BSPRE [USAGE BLOCK 9 5H?2 STO 0 BACK1(1) 15 5HQL ADX 4 FREADBLOCK(3) [BLOCK NO. 7 5J== SMO 4 7 5JPW LDX 0 0 9 5K9G STO 0 BACK2(1) 14 5KP6 NAME 1,FILE,FURB [RE-NAME BLOCK 17 5L8Q CHAIN 1,2 [CHAIN USAGE BLOCK IN 15 5LNB CALL 4 POINTERS [STACK & FCB 15 5M82 BC 3,BAFBLK [UNSET BIT. 9 5MML LDX 0 FBLMOD(1) 16 5N7= ADN 0 A1-1 [IS IT LAST BLOCK 15 5NLW BXU 0 FREADBLOCK(3),NOLO [IF NOT,JUMP 21 5P6G JBC NOFON4,1,BFLASTW [J IF 'WAITING FOR LAST BLOCK' BIT UN 21 5PL6 FON #4 [WAKE UP ANYONE WAITING FOR LAST BLOK 17 5Q5Q CALL 4 POINTERS [X1-> FCB,X2-> FSTACK 5 5QKB NOFON4 20 5R52 MBC 1,BFLAST,BFLASTW [UNSET 'GETTING LAST BLOCK' AND 21 5RJL ['WAITING FOR LAST BLOCK' BITS,IF SET 4 5S4= NOLO 15 5SHW LDX 1 3 [FOR TESTWAIT 21 5T3G TESTWAIT 1,WAITR,2 [J IF ANYONE WAITING FOR THIS BLOCK 18 5TH6 LDX 3 1 [PICK UP PTR TO ELEMENT 4 5W2Q NOWO 17 5WGB LDX 1 FPTR(2) [X1 -> USAGE BLOCK 4 5X22 ) 5 5XFL RLINKR 15 5X_= ADX 5 FX1 [ADJUST LINK 7 5YDW EXIT 5 0 5 5YYG SBFCBX 7 5_D6 BFCBX 1,2 8 5_XQ BRN R1 4 62CB # 4 62X2 # 5 63BL ZDEEP 17 63W= # SPECIAL ROUTINE FOR CHECKING & CONVERTING DEPTH 4 64*W # 10 64TG LDX 7 ACOMMUNE7(2) 8 65*6 SRA 7 15 7 65SQ #SKI K6PERUSFIL 4 66#B ( 18 66S2 FILENUMB 5 [X5 = NO OF FILES OPEN 17 67?L BPZ 7 P1 [J IF DEPTH NOT <0 7 67R= ADX 5 7 9 68=W BNG 5 ZGEOER1 8 68QG BRN P2 4 69=6 P1 9 69PQ BXGE 7 5,ZGEOER1 4 6=9B P2 4 6=P2 ) 7 6?8L EXIT 6 0 5 6?N= POINTERS 19 6#7W # THIS SUBROUTINE ,GIVEN POINTER TO A FILE ELEMENT IN X3 16 6#MG # SETS X2 -> FILE/FSTACK BLOCK & X1 -> FILE/FCB 15 6*76 PSTAC 2,3 [X2 -> FSTACK 15 6*LQ BFCBX 1,2 [X1 -> FCB 7 6B6B EXIT 4 0 4 6BL2 # 4 6C5L # 4 6CK= # 5 6D4W ZFSTACK 21 6DJG # DOES AN SFSTACK ON THE FILE OPEN AT DEPTH [X7] & ALSO GIVESA'POINT 11 6F46 # ER TO THE FSTACK BLOCK 8 6FHQ SFSTACK 7,3,2 7 6G3B EXIT 4 0 4 6GH2 # 5 6H2L ZINTRO 11 6HG= # FIRST ENTRY;TO CHECK DEPTH 18 6H_W CALL 6 ZDEEP [CONVERT & CHECK DEPTH 4 6JFG # 5 6J_6 ZEXTRO 19 6KDQ # THIS ENTRY DOES AN SFSTACK ON THE FILE OPEN AT DEPTH [7] 11 6KYB # & LEAVES THE POINTER IN X3 8 6LD2 SFSTACK 7,3 7 6LXL EXIT 4 0 4 6MC= # 4 6MWW # 10 6NBG # SFUBFREE SUBROUTINE 4 6NW6 # 5 6P*Q SFUBFREE 20 6PTB # THIS SUBROUTINE LOOKS FOR A BLOCK & EXITS IF ITS NOT THERE 17 6Q*2 # IF IT IS PRESENT,IT ENTERS THE VFREE SUBROUTINE 10 6QSL # X1 MUST POINT TO FCB 10 6R#= SMO FREADBLOCK(3) 17 6RRW LDX 4 0(1) [X4 = BLOCK NUMBER 11 6S?G SKIPTRACE 699,4,SFUBFREE 18 6SR6 SFUB 2,4,6,VEXITS [J TO EXIT IF NOT THERE 20 6T=Q # THS BLOCK IS NOT FREED IF THERE IS AN APPENDER & IT'S THE LAST 6 6TQB # BLOCK. 5 6W=2 VFREE2 15 6WPL BFCBX 1,2 [X1 -> FCB 5 6X9= VFREE1 21 6XNW JBS VEXITR,1,BFCORE [J IF 'LEAVE BLOCKS IN CORE' BIT SET. 5 6Y8G VQRST 4 6YN6 # 10 6_7Q # FREES USAGE BLOCK 18 6_MB # UNLESS SOMEONE IS USING IT,IN WHICH CASE IT'S LEFT 13 7272 # IF IT'S A FUWB,IS'S WRITTEN BACK 13 72LL # X6-> USAGE BLOCK (!),CALLED BY X5 4 736= # 5 73KW VFREE 20 745G LDX 1 3 [PRESERVE FROM TSESTUSEJ MACRO 18 74K6 TESTUSEJ 1,VUSIN,2 [JIF ANYONE USING BLOCB 7 754Q LDX 3 1 14 75JB SKIPTRACE 699,FREADBLOCK(3),FREEING 7 7642 SMO 6 17 76HL LDX 0 ATYPE [ATYPE OF USAGE BLOCK 17 773= BXE 0 FFSFURB,VREE [J IF NOT WRITE BLOCK 8 77GW CHAIN 6,FX2 17 782G SBX 5 FX1 [CALLING ACCUMULATOR 6 78G6 #SKI I516A 4 78_Q ( 7 79FB BFCBX 2,2 8 79_2 VARIADNW 2 4 7=DL ) 10 7=Y= ADDSKIP I516A,ARDWR 10 7?CW FILEAUTW 7,FAIL+FREE 14 7?XG CALL 4 ZEXTRO [ELEMENT 8 7#C6 ADX 5 FX1 9 7#WQ BRN VEXITQ 4 7*BB VREE 10 7*W2 ADDSKIP I516A,ARDFR 8 7B*L FREECORE 6 5 7BT= VEXITQ 15 7C#W CALL 4 POINTERS [FSTACK & FCB 7 7CSG EXIT 5 0 5 7D#6 VUSIN 7 7DRQ LDX 3 1 14 7F?B PSTAC 2,3 [RESET X2 5 7FR2 VEXITS 20 7G=L BFCBX 1,2 [KEEP EXIT CONDITION CONSISTENT 5 7GQ= VEXITR 7 7H9W EXIT 5 0 4 7HPG # 20 7J96 # THIS ROUTINE EXITS +1 IF NOONE HAS GONE FOR CURRENT BLOCK 14 7JNQ # NORMALLY IF SOMEONE HAS 14 7K8B # X0,X1 OVERWRITTEN,X2 ON NORMAL EXIT 5 7KN2 TESTLOOK 7 7L7L LDX 1 3 10 7LM= TESTLOOK 1,TESTA1,2 7 7M6W LDX 3 1 7 7MLG EXIT 4 1 5 7N66 TESTA1 7 7NKQ LDX 3 1 14 7P5B PSTAC 2,3 [RESET X2 7 7PK2 EXIT 4 0 4 7Q4L # 4 7QJ= # 21 7R3W # ------------------------------------------------------------------- 4 7RHG # 17 7S36 RBACK [READBACK,N/Z DEPTH. 9 7S=Y ... STOZ AWORK1(2) 18 7SGQ CALL 4 ZINTRO [CHECK EVERYTHING 8 GET PTRS. 8 7T2B BRN RBRA 17 7TG2 ZRBACK [READBACK ZERO DEPTH. 14 7T_L STOZ 7 [DEPTH 9 7W9D ... STOZ AWORK1(2) 9 7WF= CALL 4 ZEXTRO 4 7WYW RBRA 8 7XDG LDCT 0 #20 18 7XY6 STO 0 AWORK4(2) [MARKER TO SHOW READBACK. 10 7YCQ ADDSKIP I516A,IRBCK 16 7YXB BRN RBACP [DO A BACKSPACE 4 7_C2 # 21 7_WL # ------------------------------------------------------------------- 17 82B= REWIND [REWIND N/Z DEPTH. 19 82TW [ENTRY: REWIND NONZERO DEPTH 19 83*G CALL 4 ZINTRO [CHECK DEPTH & SET X3=>FCA 8 83T6 BRN RWIA 17 84#Q ZREWIND [REWIND ZERO DEPTH. 14 84SB STOZ 7 [DEPTH 15 85#2 CALL 4 ZEXTRO [X3 => F.C.A 4 85RL RWIA 10 86?= ADDSKIP I516A,IREWI 18 86QW CALL 4 POINTERS [X1-> F.C.B, X2-> FSTACK BLOCK 7 87=G #SKI K6PERUSFIL 4 87Q6 ( 21 889Q JMBAC Z11,3,BAMREAD,BAMREADR,BAMAPP,BAMWRITE,BAMGEN,BAMCLEAN 21 88PB [CHECK FILE OPEN IN ANY MODE EXCEPT 17 8992 [COPY. ERROR IF NOT. 4 89NL ) 10 8=8= LDX 0 FREADBLOCK(3) 9 8=MW BNG 0 RWIEXIT 21 8?7G SBN 0 FBLKS [DON'T TRY TO FREE 1ST BLOCK , NOR 21 8?M6 BZE 0 RWIEXIT [LOOK FOR IT IF IT'S AN EMPTY FILE. 10 8#6Q ADDSKIP I516A,ARWFR 15 8#LB CALL 5 SFUBFREE [DEAL WITH BLOCK 5 8*62 RWIEXIT 16 8*KL NGS 1 FREADBLOCK(3) [INITIALISE THE 16 8B5= NGS 1 FREADWORD(3) [TWO POINTERS 5 8BJW UP 21 8C4G # ------------------------------------------------------------------- 5 8C7L ...ZBSKIP 10 8C=Q ... LDX 0 ACOMMUNE8(2) 9 8C*W ... STO 0 AWORK1(2) 9 8CF2 ... BRN ZBASKI 17 8CJ6 NBSPACE [BACKSPACE N/Z DEPTH. 18 8D3Q [BACKSPACE :NONZERO DEPTH 9 8D?J ... STOZ AWORK1(2) 17 8DHB CALL 4 ZINTRO [CHECK DEPTH;X3-> FCA 8 8F32 BRN RBAC 18 8FGL ZBSPACE [BACKSPACE ZERO DEPTH. 9 8FMS ... STOZ AWORK1(2) 5 8FT2 ...ZBASKI 19 8G2= LDN 7 0 [BACKSPACE ; ZERO DEPTH 15 8GFW CALL 4 ZEXTRO [X3 -> FCA 4 8G_G RBAC 10 8HF6 ADDSKIP I516A,IBACK 8 8HYQ SMO FX2 17 8JDB STOZ AWORK4 [SET B'SPACE MARKER 5 8JY2 RBACP 17 8KCL CALL 4 POINTERS [X2-> FSTACK X1-> FCB 7 8KX= #SKI K6PERUSFIL 4 8LBW ( 17 8LWG JMBAC ZGEOER6,3,BAMREAD,BAMAPP,BAMGEN,BAMCLEAN 20 8MB6 [CHECK FILE OPEN IN READ,APPEND 21 8MTQ [GENERAL OR CLEAN MODE. ERROR IF NOT. 4 8N*B ) 10 8NT2 LDX 0 FREADBLOCK(3) 20 8P#L BPZ 0 RBACQ [J IF FILE PREVIOUSLY ACCESSED 5 8PS= RBACT 8 8PWF ... LDX 2 FX2 9 8PYN ... LDX 0 AWORK1(2) 8 8Q2X ... BZE 0 NFH 10 8Q56 ... STO 0 ACOMMUNE8(2) 9 8Q7* ... BRN XSETRE 4 8Q9J ...NFH 8 8Q?W LDCT 0 #20 8 8QRG SMO FX2 9 8R?6 ANDX 0 AWORK4 18 8RQQ BZE 0 ZGEOER8 [BEG FILE IF NOT READBACK 5 8S2J ...XSETRE 16 8S=B SETREP BEGFILE [SET REPLY & UP 5 8SQ2 UP 5 8T9L RBACQ 20 8TP= SBX 0 FBLMOD(1) [CHECK IF ABOUT TO,OR HAVE READ 14 8W8W SBN 0 A1 [E.O.F 14 8WNG BPZ 0 RBACM [J IF SO 16 8X86 LDX 0 FREADWORD(3) [RECORD POINTER 19 8XMQ BNG 0 RBACA [J IF BACKSPACED OFF FRONT OF 16 8Y7B [PRESENT BLOCK 8 8YM2 SBN 0 A1 21 8_6L BZE 0 RBACB [J IF READ 1ST RECORD OF THIS BLOCK 17 8_L= CALL 5 SFUBREAD1 [GET X1-> USAGE BLOCK 5 925W RBACNEX 8 92KG LDN 4 A1 5 9356 RBACC 7 93JQ SMO 4 15 944B LDEX 0 FRH(1) [NEXT R.H. 19 94J2 ADX 4 0 [X4 IS FREADWORD-TYPE POINTER 19 953L BXU 4 FREADWORD(3),RBACC [J IF NOT YET UP TO FREADWORD 8 95H= SBN 4 A1 17 962W BNZ 4 NOTST8 [J IF NOT EMPTY BLOCK 5 96GG RSETNG 10 9726 NGS 1 FREADWORD(3) 15 97FQ BRN RBACN [TRY AGAIN 5 97_B NOTST8 18 98F2 SBS 0 FREADWORD(3) [IF WE ARE,GO BACK ONE 10 98YL SMO FREADWORD(3) 9 99D= LDX 0 FRH(1) 16 99XW BPZ 0 RBACN [J IF NOT DUMMY 20 9=CG LDX 0 FREADWORD(3) [J IF NOT DUMMY & FROET OF BCOLK 8 9=X6 SBN 0 A1 9 9?BQ BZE 0 RSETNG 19 9?WB BRN RBACNEX [J BACK & FIND NEXT ONE UP 5 9#B2 RBACN 10 9#TL LDX 0 FREADWORD(3) 8 9**= BPZ 0 YPOS 15 9*SW PSTAC 2,3 [X2->FSTACK 14 9B#G BFCBX 1,2 [X1->FCB 18 9BS6 CALL 5 SFUBFREE [DEAL WITH SPENT BLOCK. 10 9C?Q LDX 0 FREADBLOCK(3) 8 9CRB SBN 0 FBLKS 17 9D?2 BNZ 0 YPOS [J IF NOT 1ST BLOCK. 10 9DQL NGS 2 FREADBLOCK(3) 4 9F== YPOS 8 9FPW LDCT 0 #20 8 9G5K ... SMO FX2 9 9GF# ... ANDX 0 AWORK4 16 9H8Q BNZ 0 RAGA [J IF BACKREAD 8 9H=7 ... SMO FX2 9 9H?J ... LDX 0 AWORK1 9 9H#_ ... BNG 0 ZGEOER2 9 9HBB ... BZE 0 RBACKOUT 7 9HCR ... SBN 0 1 8 9HF8 ... SMO FX2 9 9HGK ... STO 0 AWORK1 8 9HJ2 ... BNZ 0 RBACP 5 9HJN ...RBACKOUT 7 9HKC ... SETREP OK 5 9HNB UP 5 9J82 RBACX 14 9JML LDX 6 1 [-> BLOCK 7 9K7= PSTAC 2,3 15 9KLW CALL 5 VFREE2 [FREE BLOCK 8 9L6G BRN RBACY 5 9LL6 RBACA 10 9M5Q ADDSKIP I516A,ABAFR 18 9MKB CALL 5 SFUBFREE [DEAL WITH SPENT BLOCK 5 9N52 RBACY 15 9NJL #SKI K6PERUSFIL [N/Z DEPTH 4 9P4= ( 17 9PHW LDN 0 FBLKS [ERROR IF 1ST BLOCK 12 9Q3G BXE 0 FREADBLOCK(3),RBACT 4 9QH6 ) 7 9R2Q LDN 0 1 16 9RGB SBS 0 FREADBLOCK(3) [BACK ONE BLOCK 19 9S22 CALL 5 SFUBREAD1 [READ DOWN BLOCK/OR FIND IT 8 9SFL LDN 4 A1 7 9S_= LDX 2 1 5 9TDW RBACD 19 9TYG SMO 4 [X4 CONTAINS THIS REC.HEADER 14 9WD6 LDX 0 FRH(2) [NEXT RH. 19 9WXQ YDUM82A [FX2 CONTAINS LAST POINTER. 17 9XCB BZE 0 RBACH [J IF END OF BLOCK 16 9XX2 BPZ 0 NDUM81 [JIF NOT DUMMY 5 9YBL YDUM81 14 9YW= LDEX 0 0 [9 BITS 7 9_*W #SKI K6PERUSFIL 9 9_TG BZE 0 ZGEOER2 15 =2*6 ADX 4 0 [UPDATE CT. 7 =2SQ SMO 4 15 =3#B LDX 0 FRH(2) [NEXT R.H. 9 =3S2 BRN YDUM82A 5 =4?L NDUM81 7 =4R= STO 4 5 7 =5=W ADX 2 4 15 =5QG LDX 4 0 [UPDATE X4 8 =6=6 BRN RBACD 5 =6PQ RBACH 15 =79B SBX 2 1 [DATUMISE S2 21 =7P2 BZE 2 RBACX [THIS IS A NULL BLOCK(FULL OF DUMMIES 19 =88L LDN 0 A1 [TEST FOR 1 RECORD IN BLOCK 14 =8N= BXE 0 2,RBACRBZ [J IF SO 21 =97W SBX 2 5 [O/W SUBTRACT ^LAST BUT TWO^'TH R.H. 8 =9MG BRN RBACJ 5 ==76 RBACRBZ 16 ==LQ NGX 2 4 [SET F'WORD <0 5 =?6B RBACJ 18 =?L2 STO 2 FREADWORD(3) [UPDATE RECORD POINTER 8 =#5L BRN RBACN 5 =#K= RBACB 20 =*4W LDX 0 FREADBLOCK(3) [CHECK IF 1ST BLOCK (THIS WORKS 20 =*JG SBN 0 FBLKS [EVEN FOR PSEUDO-READ ON EMPTY 16 =B46 BNZ 0 RBACL [FILE).J IF NOT. 8 =BHQ LDCT 0 #20 8 =C3B SMO FX2 17 =CH2 ANDX 0 AWORK4 [J IF NOT READBACK 8 =D2L BZE 0 RBACS 9 =DG= SETREP FIRSTREC 5 =D_W UP 5 =FFG RBACS 5 =F_6 RBACL 18 =GDQ NGS 2 FREADWORD(3) [RANDOM NEGATIVE NUMBER 8 =GYB BRN RBACN 5 =HD2 RBACM 18 =HXL LDX 0 FREADWORD(3) [IF READ E.O.F,SET'ABOUT 15 =JC= BPZ 0 RBACB [TO READ EOF. 8 =JWW BRN RBACY 4 =KBG # 4 =KW6 # 21 =L*Q # ----------------------------------------------------------------- 4 =LTB # 16 =M*2 # GETAFURB,WHICH GETS THE CURRENT USAGE BLOCK 4 =MSL # 4 =N#= # 16 =NRW NGET [N/Z DEPTH ENTRY. 9 =P?G CALL 4 ZINTRO 9 =PR6 BRN RGETAFA 17 =Q=Q ZGET [ZERO DEPTH ENTRY. 7 =QQB STOZ 7 9 =R=2 CALL 4 ZEXTRO 5 =RPL RGETAFA 10 =S9= ADDSKIP I516A,IGETA 9 =SNW CALL 4 POINTERS 16 =T8G LDX 0 FREADBLOCK(3) [BLOCK POINTER 9 =TN6 BPZ 0 RGETAFB 20 =W7Q LDN 0 FBLKS [IF IFLE REWOUND,READ 1ST BLOCK 10 =WMB STO 0 FREADBLOCK(3) 5 =X72 RGETAFB 7 =XLL #SKI K6PERUSFIL 4 =Y6= ( 9 =YKW ... SBX 0 FBLMOD(1) 8 =_5G SBN 0 A1 9 =_K6 BPZ 0 ZGEOER3 4 ?24Q ) 9 ?2JB CALL 5 SFUBREAD 5 ?342 UP 4 ?3HL # 4 ?43= # 21 ?4GW # -------------------------------------------------------------------- 21 ?52G # READB- READS DOWN THE NEXT BLOCK,RECHAINS IT NEXT TO THE ACTIVITY 10 ?5G6 # BLOCK AS A FILE/FRB 4 ?5_Q # 15 ?6FB READB [N/Z DEPTH 18 ?6_2 CALL 4 ZINTRO [CHECK DEPTH;X3 -> FCA 8 ?7DL BRN RBIN 15 ?7Y= ZREADB [ZERO DEPTH. 7 ?8CW STOZ 7 9 ?8XG CALL 4 ZEXTRO 4 ?9C6 RBIN 10 ?9WQ ADDSKIP I516A,IREAB 17 ?=BB CALL 4 POINTERS [X2-> FSTACK X1-> FCB 7 ?=W2 #SKI K6PERUSFIL 4 ??*L ( 20 ??T= JMBAC Z7,3,BAMREAD,BAMREADR,BAMAPP,BAMWRITE,BAMGEN,BAMCLEAN 21 ?##W [CHECK FILE OPEN IN ANY MODE EXCEPT 17 ?#SG [COPY. ERROR IF NOT. 4 ?*#6 ) 17 ?*RQ NGS 4 FREADWORD(3) [INITIALISE F'WORD 16 ?B?B LDX 0 FREADBLOCK(3) [BLOCK POINTER 18 ?BR2 BPZ 0 RBBEG [1 FIRST BLOCK NOT WANTOD 19 ?C=L LDX 0 FBLMOD(1) [POINTS(+A1) TO LAST BLOCK 20 ?CQ= SBN 0 AF2-A1 [IS FILE EMPTY(FBLMOD-> BSPRE)? 15 ?D9W BNZ 0 RBFBLK [J IF NOT SO 8 ?DPG LDN 0 FBLKS 16 ?F96 STO 0 FREADBLOCK(3) [MOVE BLOCK PTR. 5 ?FNQ RBCOR 16 ?G8B SETNCORE 0,1,FILE,FRB [ZERO READ BLOCK 5 ?GN2 UP 5 ?H7L RBFBLK 19 ?HM= LDN 0 FBLKS [SET FREADWORD TO 1ST BLOCK 12 ?J6W STO 0 FREADBLOCK(3) [ 8 ?JLG BRN RBFUB 5 ?K66 RBBEG 20 ?KKQ SBX 0 FBLMOD(1) [TEST IF THERE ARE NO MORE BLOCKS 20 ?L5B SBN 0 A1-1 [I.E.[FREADWORD]=[FBLMOD]+A1-1 14 ?LK2 BZE 0 RBCOR1 [J IF SO 7 ?M4L #SKI K6PERUSFIL 9 ?MJ= BPZ 0 ZGEOER3 7 ?N3W LDN 0 1 21 ?NHG ADS 0 FREADBLOCK(3) [UPDATE F'BLOCK TO POINT TO NEXT BLK. 5 ?P36 RBFUB 15 ?PGQ CALL 5 SFUBREAD1 [GET BLOCK 21 ?Q2B LDX 0 ATYPE(1) [MUSTNT REMOVE IT BEFORE IT HAS BE5N 20 ?QG2 BXE 0 FFSFUWB,RBNEWB [MUSTN'T REMOVE IT BEFORE IT HAS 17 ?Q_L [BEEN BACKWRITTEN. 15 ?RF= NAME 1,FILE,FRB [RENAME IT 15 ?RYW CHAIN 1,FX2 [RECHAIN IT 5 ?SDG UP 5 ?SY6 RBCOR1 14 ?TCQ LDN 0 1 [UPDATE 14 ?TXB ADS 0 FREADBLOCK(3) [FB'LK 8 ?WC2 BRN RBCOR 5 ?WWL RBNEWB 15 ?XB= SETNCORE GSBS,2,FILE,FRB [SET UP FRB 14 ?XTW CALL 4 ZFSTACK [-> FCA 16 ?Y*G CALL 5 SFUBREAD [-> USAGE BLOCK 9 ?YT6 MHUNTW 2,FILE,FRB 17 ?_#Q LDX 0 BACK1(1) [MOVE WEVR B.S.QFME 9 ?_SB STO 0 BACK1(2) 9 #2#2 LDX 0 BACK2(1) 9 #2RL STO 0 BACK2(2) 8 #3?= ADN 1 A1 8 #3QW ADN 2 A1 17 #4=G MOVE 1 0 [MOVE ACROSS DATA. 5 #4Q6 UP 4 #59Q # 4 #5PB # 21 #692 # ----------------------------------------------------------------*--* 4 #6NL # 17 #78= READAGAIN [READAGAIN N/Z DEPTH. 8 #7MW CALL 6 ZDEEP 8 #87G BRN RAGA 18 #8M6 ZREADAGAIN [READAGAIN ZERO DEPTH. 7 #96Q STOZ 7 4 #9LB RAGA 10 #=62 ADDSKIP I516A,IRDAG 7 #=KL LDX 3 7 18 #?5= STEPAGAIN 0(3) [STEP ONTO CURRENT RECORD 4 #?JW RAGB 18 ##4G BZE 3 RAGG [J IF 1 WD FRB + ZERO RH 9 ##J6 LDEX 4 FRH(3) 4 #*3Q RAGE 15 #*HB SETUPCOR 4,2,FILE,FRB [SET UP FRB 7 #B32 LDX 3 7 18 #BGL STEPAGAIN 0(3) [STEP ONTO RECORD AGAIN 19 #C2= BZE 3 RAGF [J IF STILL ZERO I.E,E.O.F 15 #CFW LDEX 0 FRH(3) [PICK UP R.H. 16 #C_G BXU 0 4,RAGC [J IF R.H.CHANGED 9 #DF6 MHUNTW 2,FILE,FRB 7 #DYQ STO 2 4 8 #FDB ADN 4 A1 17 #FY2 SMO FRH(3) [MOVE IN NEW RECORD 7 #GCL MOVE 3 0 4 #GX= SOK 8 #HBW SETREP OK 5 #HWG UP 9 #JB6 RAGC MFREEW FILE,FRB 8 #JTQ BRN RAGB 17 #K*B RAGG LDN 4 1 [1 WD FRB FOR E.O.F. 8 #KT2 BRN RAGE 4 #L#L RAGF 9 #LS= MHUNTW 2,FILE,FRB 15 #M?W STOZ A1(2) [STOZ R.H. 8 #MRG BRN SOK 4 #N?6 # 11 #NQQ MENDAREA 30,K99PERUSFIL 4 #P=B # 4 #PQ2 #END 4 #Q9L # 4 #QP= # 8 ____ ...45170314000300000000