(George Source)
Macros used: ADDSKIP, ALTLEN, APPCUBS, BFCBX, BS, BXE, BXGE, BXU, CHAIN, FILEAUTW, FILENUMB, FILEREAD, FILETRAN, FREEBACK, FREECORE, FSHSKIP, GEOERR, GETBACK, JBC, JBS, JMBS, KEYREC, MAPBCH, MAPBIN, MAPBSE, MBS, MENDAREA, MHUNT, MHUNTW, NAME, OFF, PSTAC, REWRITE, SEGENTRY, SETBIT, SETNCORE, SETREP, SFMAP, SFSTACK, SFUB, SKIPTRACE, TOPFCA, TRACE, UP, UPPLUS, VARIADNR, VARIADNW, VFREE, WIND, WRITEB
22FL #SEG REWRITE 22^= #OPT K0REWRITE=K0ACCESS>K0FILESTORE>K0ALLGEO 23DW #LIS K0REWRITE 23YG #OPT K6REWRITE=K6DELETE 24D6 8HREWRITE 24XQ # 25CB SEGENTRY K3REWRITE,REWRITE 25X2 SEGENTRY K4REWRITE,WIND 26BL SEGENTRY K5REWRITE,WRITEB 26W= SEGENTRY K7REWRITE,SUBS 27*W SEGENTRY K33REWRITE,ZREWRITE 27TG SEGENTRY K44REWRITE,ZWIND 28*6 SEGENTRY K51REWRITE,WRITBREAK 28SQ SEGENTRY K52REWRITE,WRITANS 29#B SEGENTRY K53REWRITE,WRITFORCE 29S2 SEGENTRY K55REWRITE,ZWRITEB 2=?L SEGENTRY K56REWRITE,ZWRITBREAK 2=R= SEGENTRY K57REWRITE,ZWRITANS 2?=W SEGENTRY K58REWRITE,ZWRITFORCE 2?QG SEGENTRY K77REWRITE,ZSUBS 2#=6 # 2#PQ ZGEOER1 2*9B GEOERR 1,FULLBGON [NO FULLB IN FILE CHAIN 2*P2 ZEN 2B8L GEOERR 1,ENDFILE 2BN= ZGEOER3 2C7W GEOERR 1,RECORD? [SOMETHING ODD ABOUT READ PTRS 2CMG ZGEOER6 2D76 GEOERR 1,ALTERED? 2DLQ # 2F6B # THIS SEGMENT IMPLEMENTS THE ACCESS MACROS:- 2FL2 # REWRITE (ENTRY POINTS K3 AND K33) 2G5L # WIND (ENTRY POINTS K4 AND K44) 2GK= # WRITEB (ENTRY POINTS K5 AND K55) 2H4W # STEPWRITE (ENTRY POINTS K7 AND K77) 2HJG # IN CONJUCTION WITH THE FILESTORE RING SYSTEM 2J46 # 2JHQ # 2JNY ...#SKI IFS<1$1 2JW6 ...( 2K3B SFULLB 2KH2 #HAL BSTB+FULLB,0 2L2L SFMAP 2LG= #HAL FILE+FMAPP,0 2LQ4 ...) 2L^W # 2MFG FILETRAN [SUBROUTINES FOR SPECAIL FILESTORE 2M^6 [B.S. TRANFER ROUTINES. 2N2# ...# THIS READS CURRENT BLOCK OF FILE INTO BSTB-BREAD 2N3G ...# IN CORE 2N4N ...SFREAD 2N5W ... SBX 6 FX1 2N74 ... LDX 2 FX2 2N8= ... LDX 7 AWORK4(2) 2N9D ...#SKI JSKI33<1$1 2N=L ... FILEREAD 7 2N?S ...#SKI JSKI33 2N*2 ... FILEREAD 7,FAIL 2NB8 ... ADX 6 FX1 2NCB ... EXIT 6 0 2NDQ PARAPOINT 2NYB [THIS SUBROUTINE VALIDATES THE FILE LEVEL PARAMETER AND MAKES POSITIVE 2PD2 [IF NECESSARY AND GIVES POINTERS:- 2PXL [ X1-> TO TOP OF FSTACK BLOCK OF THIS FILE 2QC= [ X2-> FCB OF THIS FILE 2QWW [ X3-> TO RING ELEMENT OF FCA OF FILE OPEN AT LEVEL IN X6 2RBG LDX 6 ACOMMUNE7(2) [DEPTH 2RW6 SRA 6 15 [CONVERT 2S*Q FILENUMB 4 [X4= NO FILES OPEN 2STB TOPFCA 3 [X3 -> FCA OF TOP FILE 2T*2 BPZ 6 POSLV [J IF DEPTH POSITIVE 2TSL ADX 6 4 [IF NEGATIVE ADD NUMBER OF FILES OPEN 2W#= #SKI K6REWRITE 2WRW ( 2X?G BPZ 6 NOWP1 [ERROR IF STILL <0 2XR6 NOTENUF 2Y=Q GEOERR 1,NOPENDEL 2YQB ) 2^=2 POSLV 2^PL #SKI K6REWRITE 329= BXGE 6 4,NOTENUF 32NW NOWP1 338G STO 6 AWORK4(2) [STORE DEPTH 33N6 NOWP 347Q LDX 2 FX2 34MB SFSTACK AWORK4(2),3,1 [GET X3 -> FCA 3572 [AND -> IN X1 TO TOP OF FSTACK BLOCK 35LL BFCBX 2,1 366= EXIT 7 0 36KW # 375G SFSTACK 37K6 LDX 3 FX2 384Q SFSTACK AWORK4(3),3 [X3 -> FCA 38JB EXIT 7 0 3942 # 39HL XKEYREC 3=3= # THIS ROUTINE CALCULATES THE KEY OF THE REC. POINTED TO BY X4 AND 3=GW # STORES IT IN X7,THEN EXITS NORMALLY. IF FILE NOT INDEXED OR REC. 3?2G # HAS NO KEY IT EXITS PLUS 1. ON ENTRY X2-> FCB. 3?G6 KEYREC 2,,1,NOKEY,7 3?^Q EXIT 6 0 3#FB NOKEY 3#^2 EXIT 6 1 3*DL # 3*Y= SWITCHBLOCK 3BCW # THIS ROUTINE DOES ALL THE NORMAL'CAREFUL'UPDATING. 3BXG # 3CC6 JBS (7),3,BAMCLEAN [J IF FILE OPEN IN CLEAN MODE. 3CWQ JBC (7),2,BFCARE [J IF FILE NOT CAREFUL 3DBB SMO FX2 3DW2 STO 1 ACOMMUNE1 [STORE PTR TO USAGEB. 3F*L LDX 0 FREADBLOCK(3) [CALCULATE APPROPRIATE BIT 3FT= SBN 0 FBLKS-1 3G#W MAPBCH 0,2 [WAS BIT SET 3GSG BNZ 0 YSET [J IF BIT SET 3H#6 SBX 7 FX1 3HRQ STO 7 AWORK1(2) [PRESERVE LINK 3J?B PSTAC 1,3 [X1 -> FSTACK BLOCK 3JR2 BFCBX 2,1 [X2 -> FCB 3K=L JBC NEWFULLB,2,BFALTB [DON'T LOOK FOR FULLB,SET ONE UP,IF 3KQ= ['BLOCK NOS. ALTERED' BIT UNSET. 3L9W CALL 7 SEEKFULLB [X1-> FULLB 3LPG BRN NEWFULLB [J IF NOT THERE 3M96 LDX 7 ALOGLEN(1) 3MNQ ADN 7 1 3N8B LDX 3 1 3NN2 ALTLEN 3,7 [ALTLEN BLOCK 3P7L CALL 6 SGETBACK [GET A B.S.BLOCK ON RIGHT RESIDENCE 3PM= BRN SGOT 3Q6W NEWFULLB 3QLG SETNCORE 3,1,BSTB,FULLB 3R66 LDN 0 2 3RKQ STO 0 A1(1) [R.H 3S5B LDN 0 63 3SK2 STO 0 A1+1(1) [RANDOM B.S.PREFIX 3T4L CALL 6 SGETBACK [GET B.S. 3TJ= NOFULLB 3TMB ...#SKI IFS 3TQG ... SFMAPP 2,2,ZGEOER1 3TTL ...#SKI IFS<1$1 3TYQ ...( 3W3W LDX 2 FPTR(2) [JOVER FSTACK 3WHG SLZ 3X36 LDX 2 FPTR(2) [NEXT BLOCK 3XGQ LDX 0 ATYPE(2) 3Y2B SMO FX1 3YG2 BXU 0 SFMAP,SLZ 3YPS ...) 3Y^L LDX 2 FPTR(2) 3^F= MHUNTW 1,BSTB,FULLB 3^YW LDX 7 1 42DG CHAIN 7,BPTR(2) [CHAIN FULLB IN 42Y6 LDX 1 7 43CQ PSTAC 2,3 43XB BFCBX 2,2 [X2 -> FCB 44C2 LDX 0 BSPRE(2) [RIGHT B.S.PREFIX 44WL STO 0 A1+1(1) 45B= LDX 1 FPTR(2) [->FSTBLK 45TW SGOT 46*G SMO FREADBLOCK(3) 46T6 LDX 6 0(2) [OLD B.N. 47#Q SFUB 1,6,1,NOTFURBA [J IF FURB NOT AROUND 47SB YGOTFURB 48#2 STO 4 BACK1(1) [UPDATE B.S.HOME 48RL STO 5 BACK2(1) 49?= NAME 1,FILE,FUWB [SO IT GOES TO B.S. 49QW STO 1 4 [-> USAGE BLOCK 4==G SMO FREADBLOCK(3) [STORE IN FCB 4=Q6 STO 5 0(2) 4?9Q CALL 7 SEEKFULLB [X1 -> FU-LB 4?PB BRN ZGEOER1 4#92 SMO A1(1) 4#NL STO 6 A1(1) [STORE OLD B.N. 4*8= LDN 0 1 4*MW ADS 0 A1(1) [UPDATE BLOCK COUNT 4B7G LDX 0 FREADBLOCK(3) 4BM6 SBN 0 FBLKS-1 [SET BIT FOR THIS BLOCK 4C6Q MAPBSE 0,2 [SET BIT 4CLB PSTAC 2,3 4D62 BFCBX 2,2 [X2 -> FCB 4DKL MBS 2,BFALTB,BFALTR [SET FILE AND BLOCK NOS ALTERED BITS. 4F5= LDX 1 4 [-> USAGE BLOCK 4FJW LDX 7 FX1 4G4G SMO FX2 4GJ6 ADX 7 AWORK1 [X7 = EXIT 4H3Q EXIT 7 0 4HHB YSET 4J32 LDX 1 ACOMMUNE1(2) [X1 -> USAGE BLOCK 4JGL PSTAC 2,3 4K2= BFCBX 2,2 [RESET X2 ->FCB 4K=4 ... FSHSKIP B,YB1 4KFW JBC ZGEOER6,2,BFALTB [ERROR IF 'BLOCK NOS. ALTERED' BIT UN 4KKR ...YB1 [OMIT CHECK ON 'B' MACHINE SINCE BFAL 4KPN ... [ CLEARED WHEN FCB TAKEN TO 'B' & WHO 4KTK ... [ (WITH BITS SET) MAY BE TAKEN TO 'B' 4K^G EXIT 7 0 4LF6 # 4LYQ # 4MDB NOTFURBA 4MY2 VARIADNR 2 4NCL ... CALL 6 SFREAD 4PWG CALL 6 SCHBSP [CHECK B.S.PREFIX 4QB6 ADDSKIP I516A,ADLRD 4QTQ MHUNTW 1,BSTB,BREAD [BUFFER BLOCK 4R*B NAME 1,FILE,FUWB 4RT2 CHAIN 1,FPTR(2) [CHAIN AFTER FSTACK 4S#L PSTAC 1,3 [X1 -> FSTACK 4SS= BFCBX 2,1 [X2 -> FCB 4T?W LDX 1 FPTR(1) [X1 -> USAGE BLOCK 4TRG SMO FREADBLOCK(3) 4W?6 LDX 6 0(2) [OLD B.S.NUMBER 4WQQ BRN YGOTFURB 4X=B # 4XQ2 # TWO SUBROUTINES, 4Y9L # 1)SCHBSP:CHECKS B.N. IN X5 IS STILL OK,IF NOT,GETS RID OF IT & GETS 4YP= # A NEW ONE.B.S.P AT TIME OF 1ST GETBAX IN X4 . 4^8W # 2)SGETBAC: GETS B.S, CHECKS B.S.P. STILL OK, IF NOT AS ABOVE 4^NG # 5286 SCHBSP 52MQ SBX 6 FX1 537B CALL 7 NOWP [PTRS. 53M2 BRN PREFCH 546L SGETBACK 54L= SGETBAC 555W CALL 7 NOWP 55KG SBX 6 FX1 5656 SGBACK 56JQ LDX 4 BSPRE(2) [B.S.PREFIY CURRENTLY 574B RGBACK 57J2 GETBACK 4 [GET B.S. 583L ADDSKIP I516A,BSGET 58H= LDX 5 EXEC1(2) [PRESERVE B.N. 592W CALL 7 NOWP [PTRS 59GG PREFCH 5=26 BXE 4 BSPRE(2),OKBSHO [J IF B.S.PREFIX UNCHANGED 5=FQ LDX 7 4 [OLD B.S.P. 5=^B LDX 4 BSPRE(2) [NEXT ONE TO TRY 5?F2 ADDSKIP I516A,ADLFBL 5?YL FREEBACK 7,5 [FREE OLD BLOCK 5#D= BRN RGBACK 5#XW OKBSHO 5*CG ADX 6 FX1 5*X6 EXIT 6 0 5BBQ # 5BWB # 5CB2 # S/R TO SEEK FULLB. ON EXIT X2 -> FCB 5CTL # 5D*= SEEKFULLB 5DDB ...#SKI IFS 5DHG ... SFULLB 2,1,(7) 5DLL ...#SKI IFS<1$1 5DPQ ...( 5DSW LDX 1 FPTR(2) 5F#G SKFULLB 5FS6 LDX 1 FPTR(1) 5G?Q BXE 1 CXFI,(7) 5GRB LDX 0 ATYPE(1) 5H?2 BXE 0 FILEPLUSFCB,(7) 5HQL SMO FX1 5J== BXU 0 SFULLB,SKFULLB 5JPW LDX 0 A1+1(1) 5K9G BXU 0 BSPRE(2),SKFULLB 5KF# ...) 5KP6 EXIT 7 1 5L8Q # 5LNB SEEKBLOCK 5M82 [THIS SUBROUTINE WILL GIVE A POINTER IN X1 TO THE USAGE BLOCK OF B.S. 5MML [BLOCK CURRENTLY BEING READ AND READ IT DOWN FROM B.S. IF NECESSARY 5N7= [IT ALSO CHECKS THAT THE FILE HAS BEEN READ 5NLW SBX 7 FX1 5P6G SMO FX2 5PL6 STO 7 AWORK1 [STORE LINK. 5Q5Q LDX 4 FREADBLOCK(3) 5QKB #SKI K6REWRITE 5R52 BNG 4 OFF [ERROR IF NOT READ ANY OF FILE 5RJL LDX 5 FREADWORD(3) 5S4= BPZ 5 SAMBL [J IF -> NOT TO END OF PREVIOUS BLOCK 5SHW #SKI K6REWRITE 5T3G ( 5TH6 LDN 0 FBLKS+1 [CHECK NOT MOVING BACK BEYOND START 5W2Q BXGE 4 0,NOTSTART [OF FILE 5WGB OFF GEOERR 1,BEG FILE 5X22 ) 5XFL NOTSTART 5X^= SMO 4 5YDW LDX 4 0(2) [PIC- UP BLOCK NUMBER 5YYG SFUB 1,4,1,NOLDFUB [1 J IF USAGE BLOCK NOT IN CASE 5^D6 YFRENULB 5^XQ CALL 4 VFREE [DEAL WITH SPENT BLOCK 62CB NOLFU 62X2 LDX 4 FREADBLOCK(3) [X4 CORRUPTED BY CALL 63BL SBN 4 1 [MOVE BLOCK -> BACK BY ONE 63W= STO 4 FREADBLOCK(3) 64*W SAMBL 64TG SMO 4 65*6 LDX 4 0(2) [PICK UP BLOCK NO OF REQUIRED BLOCK 65SQ SFUB 1,4,1,NOFUB [FIND ITS USAGE BLOCK IF IN CORE 66#B YFUB 66S2 BPZ 5 NONUFUB [J IF NO NEED TO RESET READ POINTER 67?L LDN 4 A1 67R= SBLMD 68=W SMO 4 [BLOCK 68QG LDX 0 FRH(1) [NEXT R.H. 69=6 BZE 0 YZE [J IF END OF BLOCK 69PQ BPZ 0 YPOS [J IF NOT DUMMY 6=9B LDEX 0 0 [9 BITS 6=P2 ADX 4 0 [STEP ON PTR. 6?8L BRN SBLMD [J BACK TO PICK UP R.H. 6?N= YPOS [STEP ON PTR & J BACK TO STEP ON PTR. 6#7W LDX 5 4 6#MG ADX 4 0 [TO PREVIOUS REC. & TO PICK UP NEXT. 6*76 BRN SBLMD 6*LQ YZE 6B6B BNG 5 YFRENULB [GO & FREE BLOCK IF NULL(FULL OF DUMM 6BL2 STO 5 FREADWORD(3) 6C5L NONUFUB 6CK= SMO FX2 6D4W LDX 7 AWORK1 [PICK UP LINK. 6DJG ADX 7 FX1 6F46 EXIT 7 0 6FHQ NOLDFUB 6G3B CALL 4 VEXITA 6GH2 BRN NOLFU 6H2L NOFUB 6HG= VARIADNR 2 6H^W ADDSKIP I516A,ADLRD 6JFG ... CALL 6 SFREAD 6KYB #SKI K6REWRITE<99$99 6LD2 TRACE 4,DINFUB 6LXL MHUNT 1,BSTB,BREAD 6MC= NAME 1,FILE,FURB [RENAME AS A USAGE BLOCK 6MWW CALL 7 SFSTACK [X3->FCA 6NBG PSTAC 2,3 6NW6 LDX 4 2 [X4->FSTACK. 6P*Q CHAIN 1,4 6PTB SMO 4 6Q*2 LDX 1 FPTR [X1-> TO USAGE BLOCK AGAIN 6QSL SMO 4 6R#= LDX 2 BPTR [X2-> TO FCB AGAIN 6RRW LDX 0 BSPRE(2) [SWAP ROUND B.S. 6S?G STO 0 BACK1(1) [HOME OF BLOCK 6SR6 SMO FREADBLOCK(3) [IN CASE IT HAS 6T=Q LDX 0 0(2) [CHANGED 6TQB STO 0 BACK2(1) 6W=2 BRN YFUB 6WPL # 6X9= # 6XNW # 6Y8G # THIS ROUTINE DEALS WITH BLOCK POINTED TO BY X1 6YN6 # CALLED BY X4,ON EXIT X3-> FCA,X2->FCB,X1-> FSTACK 6^7Q VFREE 72LL JBS VEXITA,2,BFCORE [EXIT IF 'LEAVE BLOCKS IN CORE' BIT S 736= LDX 0 ATYPE(1) 73KW BXE 0 FFSFUWB,UWRITE [J IF WRITE BLOCK 745G FREECORE 1 [FREE 74K6 ADDSKIP I516A,ADLFR 754Q BRN VEXITA 75JB UWRITE 7642 VARIADNW 2 76HL SBX 4 FX1 773= CHAIN 1,FX2 [CHAIN NEXT TO ACT BLK. 77GW LDX 2 FX2 782G LDX 6 AWORK4(2) 78G6 FILEAUTW 6,FAIL+FREE 78^Q ADDSKIP I516A,ADLWR 79FB #SKI K6REWRITE<99$99 79^2 TRACE 4,D WRITE 7=DL ADX 4 FX1 7=Y= VFREA 7?CW CALL 7 SFSTACK [X3->FCA 7?XG VEXITA 7#C6 PSTAC 1,3 7#WQ BFCBX 2,1 7*BB EXIT 4 0 7*W2 UP 7B*L UP 7BT= # 7C#W # 7CSG [ 7D#6 REWRITE [REWRITE ENTRY,N/Z DEPTH. 7DRQ [ 7F?B CALL 7 PARAPOINT [X6=DEPTH,X3->FCA,X2->FCB,X1->FSTACK 7FR2 BRN MERGERWR 7G=L [ 7GQ= ZREWRITE [REWRITE ENTRY,ZERO DEPTH 7H9W [ 7HPG LDN 6 0 [DEPTH 7J96 CALL 7 NOWP1 [X3 -> FCA,X2->FCB,X1->FSTACK 7JNQ MERGERWR 7K8B #SKI K6REWRITE 7KN2 ( 7L7L JMBS SREW,3,BAMGEN,BAMCLEAN [CHECK FILE OPEN IN GENERAL 7LM= [OR CLEAN MODE. 7M6W GEOERR 1,CANTREWR 7MLG SREW 7N66 LDX 0 FBLMOD(2) 7NKQ SBN 0 FBLKS-A1 [GEOERR IF EMPTY FILE. 7P5B BZE 0 ZEN 7PK2 ) 7Q4L ADDSKIP I516A,IREWR 7QJ= CALL 7 SEEKBLOCK [SET X1 ->USAGE BLOCK 7R3W SCHLP 7RHG SMO 5 [J IF R.H OF RECORD TO BE REWRITTEN 7S36 LDX 0 FRH(1) [NEXT RECORD 7SGQ BZE 0 YENDB1 [J IF END. 7T2B BPZ 0 REN [J FI NOT DUMMY 7TG2 LDEX 0 0 [BOTTOM 9 BITS 7T^L #SKI K6REWRITE 7WF= BZE 0 ZGEOER3 7WYW ADX 5 0 [ADD TO PTR 7XDG BRN SCHLP 7XY6 YENDB1 7YCQ #SKI K6REWRITE 7YXB ( 7^C2 LDX 0 FREADBLOCK(3) [LAST BLOCK 7^WL SBX 0 FBLMOD(2) [OF FILE 82B= SBN 0 A1-1 [IF SO 82TW BZE 0 ZEN [GEOERR ENDFILE 83*G ) 83T6 LDN 0 1 [WE MAY HAVE STEPPED TO E.O.F & 84#Q ADS 0 FREADBLOCK(3) [THEN APPENDED, SO DO A "PSEUDO" STEP 84SB LDN 0 A1 [TO THE NEXT BLOCK & GO & 85#2 STO 0 FREADWORD(3) [GET IT 85RL ADDSKIP I516A,ARWFR 86?= CALL 4 VFREE [DEAL WITH SPENT BLOCK 86QW CALL 7 SEEKBLOCK 87=G REN 87Q6 STO 5 FREADWORD(3) [STORE REC PTR. 889Q CALL 7 SWITCHBLOCK [DO 'CAREFUL' UPDATING 88PB LDX 5 FREADWORD(3) 8992 MHUNTW 3,FILE,FWB [FIND FWB 89NL #SKI K6REWRITE 8=8= ( 8=MW LDX 0 A1+FRH(3) 8?7G ANDX 0 BRHMASK 8?M6 BNZ 0 WRHD 8#6Q LDEX 0 A1+FRH(3) 8#LB SMO 5 8*62 LDX 7 FRH(1) 8*KL LDEX 4 7 8B5= ANDX 7 BRHMASK 8BJW BNZ 7 WRHD 8C4G BXE 4 0,SAMEHD 8CJ6 WRHD 8D3Q GEOERR 1,FWBRECHD [OLD ONE 8DHB ) 8F32 SAMEHD 8FGL STO 1 GEN6 [STORE USAGE BLK POINTER. 8G2= ADX 1 5 [X1->CURRENT REC 8GFW NGS 2 GEN4 [NITIALIZE KEY LOCATION. 8G^G CALL 6 XKEYREC 8HF6 STO 7 GEN4 [STORE KEY 8HYQ LDX 1 3 [X1->FWB 8JDB ADN 1 A1 [X1->REC IN FWB 8JY2 CALL 6 XKEYREC 8KCL BRN TESTKEY [X7 CONTAINS KEY 8KX= NGS 2 7 [INDICATES NO KEY 8LBW TESTKEY 8LWG BXE 7 GEN4,YKEYSOK [J IF BOTH RECS HAVE SAME KEY 8MB6 GEOERR 1,ALTKEY 8MTQ YKEYSOK 8N*B LDX 1 GEN6 8NT2 NAME 1,FILE,FUWB 8P#L LDN 4 A1(3) [MOVING RECORD FROM 8PS= ADX 5 1 [MOVING RECORD TO 8Q?W SMO A1(3) [MOVE NUMBER OF WORDS IN RECORD 8QRG MOVE 4 0 8R?6 BS 2,BFALTR [SET 'REEL ALTERED' BIT. 8RQQ UP 8S=B # 8SQ2 # 8T9L [ 8TP= WIND [WIND ENTRY,N/Z DEPTH 8W8W [ 8WNG CALL 7 PARAPOINT [X6=DEPTH,X3->FCA,X2->FCBYX1->FSTACK 8X86 BRN MERGEWIND 8XMQ [ 8Y7B ZWIND [WIND ENTRY,ZERO DEPTH 8YM2 [ 8^6L LDN 6 0 8^L= CALL 7 NOWP1 [X3->FCA,X2->FCB,X1->FSTACK. 925W MERGEWIND 92KG #SKI K6REWRITE 9356 ( 93JQ JMBS SWIND,3,BAMREAD,BAMAPP,BAMGEN,BAMCLEAN [CHECK FILE OPEN 944B [IN READ,APPEND,GENERAL OR CLEAN MODE. 94J2 GEOERR 1,CANTWIND [ERROR IF NOT 953L ) 95H= SWIND 962W LDX 4 FBLMOD(2) [PICK UP -> TO LAST BLOCK OF FILE 96GG ADN 4 A1-1 9726 LDN 0 BSPRE 97FQ BXE 4 0,UPGO [J IF FILE IS EMPTY 97^B STO 4 FREADBLOCK(3) [TO POINT TO LAST BLOCK 98F2 LDX 0 CMOD(2) [IF APPEND -> IS POSITIVE JUST USE 98YL BNG 0 MUSTLOOK [THIS AS END OF FILE POINTER 99D= STO 0 FREADWORD(3) 99XW UP 9=CG MUSTLOOK 9=X6 LDN 0 1 [STEP O FBLOCK TW POINT TW 9?BQ ADS 0 FREADBLOCK(3) [AN "UNUSED" BL. NO. 9?WB NGS 0 FREADWORD(3) [END OF FILE" 9#B2 UP 9#TL UPGO 9**= NGS 2 FREADWORD(3) 9*SW UP 9B#G # 9BS6 # 9C?Q [ 9CRB WRITBREAK [WRITEB. N/Z DEPTH PLUS BREAKIN PARAM 9D?2 [ 9DQL LDCT 0 #400 9F== BRN XLOBS1 9FPW [ 9G9G WRITANS [WRITEB. N/Z DEPTH PLUS ANSWER PARAME 9GP6 [ 9H8Q LDCT 0 #200 9HNB BRN XLOBS1 9J82 [ 9JML WRITFORCE [WRITEB. N/Z DEPTH PLUS FORCED PARAME 9K7= [ 9KLW LDCT 0 #100 9L6G BRN XLOBS1 9LL6 [ 9M5Q WRITEB [WRITEB. N/Z DEPTH 9MKB [ 9N52 LDN 0 0 9NJL XLOBS1 9P4= STO 0 ACOMMUNE1(2) 9PHW CALL 7 PARAPOINT [X6=DEPTH,X3->FCA,X2->FCB,X1->FSTACK 9Q3G BRN MERGEWRB 9QH6 [ 9R2Q ZWRITBREAK [WRITEB. ZERO DEPTH PLUS BREAKIN PARA 9RGB [ 9S22 LDCT 0 #400 9SFL BRN XLOBS2 9S^= [ 9TDW ZWRITANS [WRITEB. ZERO DEPTH PLUS ANSWER PARAM 9TYG [ 9WD6 LDCT 0 #200 9WXQ BRN XLOBS2 9XCB [ 9XX2 ZWRITFORCE [WRITEB. ZERO DEPTH PLUS FORCED PARAM 9YBL [ 9YW= LDCT 0 #100 9^*W BRN XLOBS2 9^TG [ =2*6 ZWRITEB [WRITEB. ZERO DEPTH. =2SQ [ =3#B LDN 0 0 =3S2 XLOBS2 =4?L STO 0 ACOMMUNE1(2) =4R= LDN 6 0 [ZERO DEPTH =5=W CALL 7 NOWP1 [X3 ->FCA,X-->FCB,X1->FSTACK. =5QG MERGEWRB =6=6 #SKI K6REWRITE =6PQ ( =747 ... JMBS SWRITE,3,BAMWRITE,BAMGEN,BAMAPP [CHECK FILE OPEN IN WR =7BJ ... =7P2 [OR GENERAL MODE. =88L WRAP =8N= GEOERR 1,CAN'TAPP [ERROR IF NOT =97W SWRITE =9MG ) =9RC ... JBS WRAP,3,BACOMM =9X# ...[ ERROR IF FILE OPEN IN COMMUNE MODE ==39 ...[ N.B. THIS CAN ONLY HAPPEN WITH *FH PERIS ==76 LDN 0 #77 [B18-23 OF FINFC NON-ZERO, ==LQ ANDX 0 FINFC(2) [IMPLIES INDEXED FILE. =?6B BZE 0 NOTINDEX [ERROR IF SO. =?L2 GEOERR 1,INDEXED! =#5L NOTINDEX =#K= LDN 0 2 =*4W NGS 0 CMOD(2) =*JG ADDSKIP I516A,IWRIT =B46 LDX 5 FBLMOD(2) [LENGTH OF FCB BEING USED =BHQ LDX 0 5 =C3B SBN 0 FBLKS-A1 [NUMBER OF BLOCKS IN FILE BEING USED =CH2 BXU 0 FSIZE(2),NOTFULL [J IF FILE NOT FULL =D2L [THIS SECTION DEALS WITH PROCEEDURE WHEN FILE IS FULL =DG= #SKI K6REWRITE>99-99 =D^W TRACE FLOC1(2),FILEFULL =FFG SETREP FILEFULL =F^6 UPPLUS =GDQ UPPLUS 1 =GYB XBRK =HD2 UP =HXL NOTFULL =JC= LDX 2 FX2 =JWW LDX 6 AWORK4(2) [DEPTH =KBG APPCUBS XBRK,3 [ARE WE ALLOWED ANY MORE BLOCKS? =KW6 TESTREPN OK,UPPLUS [J IF NOT =L*Q CALL 7 NOWP =LTB BXGE 5 FUSEBL(2),NEWFCB =M*2 STOZ 7 [INDICATES NOT LENGTHENING FCB. =MSL ADN 5 1 [ADD ONE TO LENGTH OF FCB USED =N#= BRN UPFCB =NRW NEWFCB =P?G LDX 5 ALOGLEN(2) =PR6 ADN 5 1 =Q=Q LDX 3 2 =QQB ALTLEN 3,5 [ALTLEN FCB =R=2 CALL 6 SGETBACK [GET A B.S.BLOCK(IN ACC 5) =RPL SMO FBLMOD(2) =S9= STO 5 A1(2) [STORE NEW BLOCK IN FCB =SNW ... LDX 7 6 [SET 'LENGTHENING FCB' SWITCH =T8G LDN 5 1 =TN6 ADS 5 FUSEBL(2) =W7Q ADX 5 FBLMOD(2) =WMB UPFCB =X72 MBS 2,BFALTB,BFALTR [SET BITS FOR BLOCKS AND FILE ALTERED =XLL MHUNT 3,FILE,FWB [FIND THE FWB =Y6= #SKI K6REWRITE =YKW ( =^5G LDX 0 ALOGLEN(3) =^K6 BXGE 0 BSBS,NOTSHORT [J IF FWB LONG ENOUGH ?24Q WRITERR ?2JB GEOERR 1,FWBSHORT ?342 ) ?3HL NOTSHORT ?43= SMO FX2 ?4GW LDX 6 AWORK4 ?52G JBC NOTCARE,2,BFCARE [J IF NOT A 'CAREFUL' FILE. ?5G6 BZE 7 SETBIT [J IF FCB NOT LENGTHENED. ?5^Q LDX 0 FBLMOD(2) ?6FB SBN 0 FBLKS-A1-1 ?6^2 MAPBIN 0,6 [INSERT BIT AT END(I.E APPEND BIT ?7DL BRN XPOINT ?7Y= SETBIT ?8CW LDX 0 FBLMOD(2) ?8XG SBN 0 FBLKS-A1-1 ?9C6 MAPBSE 0,2 ?9WQ XPOINT ?=BB CALL 7 NOWP [PTRS. ?=W2 MHUNT 3,FILE,FWB ??*L NOTCARE ??T= STO 5 FBLMOD(2) [WE CANT UPDATE FBLMOD UNTIL NOW ?##W [BECAUSE OF COPYFILE(MAPBIN &GETBAX ?#SG [COORDINATE). WE MUST ALSO RENAME WRI ?*#6 [BLOCK A FILE/FUWB WHEN WE B/WRITE IT ?*RQ SMO FBLMOD(2) ?B?B LDX 7 A1-1(2) [PICK UP BLOCK NO.(WHICH MAX HAVE CHA ?BR2 STO 7 BACK2(3) [OVER THE COORDINATION ) ?C=L #SKI K6REWRITE ?CQ= ( ?D9W BPZ 7 OKBSA ?DPG GEOERR 1,BACKADDR ?F96 OKBSA ?FNQ ) ?G8B LDX 0 BSPRE(2) [OTHER GALF OF B.S.HOME PAIR ?GN2 STO 0 BACK1(3) ?H7L LDX 7 FBLMOD(2) ?HM= SBX 7 FSIZE(2) ?J6W VARIADNW 2 ?JLG LDX 4 FBLMOD(2) ?K66 ADN 4 A1-1 ?KKQ CHAIN 3,FX2 ?L5B NAME 3,FILE,FUWB ?LK2 FILEAUTW 6,FAIL+FREE,,4 ?M4L SBN 7 AF2-A1+FNEARLY ?MJ= BPZ 7 SETFNRP ?N3W SETREP OK ?NHG BRN UPPLUS ?P36 SETFNRP ?PGQ SKIPTRACE 99,7,FNEARLY ?Q2B SETREP FNEARLY ?QG2 BRN UPPLUS ?Q^L # ?RF= # ?RYW [ ?SDG SUBS [SUBSTITUTE ENTRY,N/Z DEPTH ?SY6 [ ?TCQ CALL 7 PARAPOINT [X6=DEPTH,X3->FCA,X2->FCB,X1->FSTACK ?TXB BRN MERGESTW ?WC2 [ ?WWL ZSUBS [SUBSTITUTE ENTRY,ZERO DEPTH. ?XB= [ ?XTW LDN 6 0 [DEPTH ?Y*G CALL 7 NOWP1 [X3 ->FCA,X2 ->FCB,X1 ->FSTACK ?YT6 MERGESTW ?^#Q #SKI K6REWRITE ?^SB ( #2#2 JMBS STWOK,3,BAMREAD,BAMAPP,BAMWRITE,BAMGEN [CHECK FILE OPEN #2RL [IN READ,APPEND,WRITE OR GENERAL MODE #3?= GEOERR 1,CANTSUBS #3QW STWOK #4=G ) #4Q6 ADDSKIP I516A,ISTPW #59Q CALL 7 SEEKBLOCK [X1->USAGE BLOCK. #5PB CALL 7 SWITCHBLOCK [CAREFUL UPDATING #692 UP #6NL # #78= MENDAREA 50,K99REWRITE #7MW #END ^^^^ ...00021622000100000000