(George Source)
Macros used: ADDSKIP, ALTLEN, BFCBX, BLOCK, BXE, BXGE, BXL, BXU, CHAIN, FREEBACK, GEOERR, GETBACK, INCRECUBS, JBC, JBS, MAPBIN, MAPBSECH, MBS, MENDAREA, SEGENTRY, SETNCORE, SETREP, SFSTACK, TRACE, UP
22FL #SEG INSERTBL6 [ TONY HAMILTON 22^= #OPT K0INSERTBL=K0INSERT>K0ACCESS>K0FILESTORE>K0ALLGEO 23DW #LIS K0INSERTBL 23YG 8HINSERTBL 24D6 #SKI 24XQ SEGENTRY K1INSERTBL,SCAREFULA 25CB SEGENTRY K2INSERTBL,SINSERT 25X2 [ 26BL # 26W= # THIS SEGMENT IMPLEMENTS THE FOLLOWING PARTS OF THE INSERT & REPLAC 27*W # MACROS. 27TG # 28*6 # 28SQ # A) K1 ENTRY : THIS PART DOES THE CAREFUL UPDATING FOR THE BLOCK N 29#B # POINTED TO BY THE "FREADBLOCK-TYPE" POINTER IN X4 29S2 # IN THE FCB FOR THE FILE OPEN AT DEPTH [AWORK2]. 2=?L # (N.B.IT ASSUMES THE BLOCK BIT IS NOT SET.) 2=R= # 2?=W # B) K2 ENTRY : THIS INSERTS A BLOCK NUMBER BEFORE THE BLOCK NO. IN 2?QG # FCB OF THE FILE OPEN AT DEPTH [AWORK2] WHICH IS POI 2#=6 # TO BY THE"FREADBLOCK-TYPE"POINTER IN X4. 2#PQ # 2*9B # ERRORS 2*P2 ZGEOER1 2B8L GEOERR 1,MAPBCH! [BLOCK BIT SET ON ENTRY. 2BN= ZGEOER2 2C7W GEOERR 1,CAREFUL? [BLOCK POSITION INCORRECT 2CMG ZGEOER5 2D76 GEOERR 1,FULLBGON [FULLB GONE.OUGHT TO BE PRESENT 2DLQ ZGEOER9 2F6B GEOERR 1,NO BLOCK [ERROR IN SFINDFURB S/R. 2FL2 # 2FTS ...MXINS +FILESIZE+FBLKS+1 2G5L SFULLB 2GK= #HAL BSTB+FULLB,0 2H4W # 2HJG # 2J46 # SUBROUTINES 2JHQ # 2K3B # 2KH2 # 2L2L SFCB3 [SET X3-> FCB 2LG= SMO FX2 2L^W LDX 0 AWORK2 2MFG SFSTACK 0,3,3 [X3 -> FSTACK 2M^6 BFCBX 3,3 [X3 -> FCB 2NDQ EXIT 6 0 2NYB # 2PD2 SFINDFURB 2PXL # CALLED BY X1.THE WORD AFTER THE CALL CONTAINS THE TYPE/SUBTYPE 2QC= # WANTED.X3 ->FCB,X2 WILL POINT ON EXIT TO THE BLOCK REQUIRED. 2QWW LDX 2 FPTR(3) [J OVER FSTACK BLOCK 2RBG BXE 2 CXFI,ZGEOER9 [ERROR IF END OF FILE CHAIN. 2RW6 SFFULP 2S*Q LDX 2 FPTR(2) [NEXT BLOCK 2STB BXE 2 CXFI,ZGEOER9 [ERROR IF END OF FILE CHAIN. 2T*2 LDX 0 ATYPE(2) 2TSL #SKI K6INSERT 2W#= BXE 0 FILEPLUSFCB,ZGEOER9 [ERROR IF END OF FILE CHAIN. 2WRW BXU 0 0(1),SFFULP [J IF WRONG TYPE 2X?G EXIT 1 1 [EXIT ROUND TYPE-WORD 2XR6 # 2Y=Q # 2YQB SFINDFULLB [SET X3 ->FCB,X2-> APPROPRIATE FULLB 2^=2 # CALLED BY X6,OVERWRITES X2,WHICH POINTS TO AN APPROPRIATE FULLB 2^PL # FOR THIS FILE ON SUCCESSFUL EXIT (+1) 329= # EXIT +0 => NO FULLB 32NW # X3 POINTS TO FCB. 338G SMO FX2 33N6 LDX 0 AWORK2 347Q SFSTACK 0,2,2 [FIND X2 -> FSTACK 34MB BFCBX 3,2 [X3 -> FCB 3572 SFLP 35LL LDX 2 FPTR(2) [NEXT BLOCK. 366= BXE 2 CXFI,(6) [J IF END OF FILE CHAIN 36KW LDX 0 ATYPE(2) [TYPE 375G BXE 0 FILEPLUSFCB,(6) [EXIT FCB, SEARCH UNSUCCESSFUL 37K6 SMO FX1 384Q BXU 0 SFULLB,SFLP [J IF NOT BSTB/FULLB 38JB LDX 0 A1+1(2) 3942 BXU 0 BSPRE(3),SFLP [J IF WRONG B.S.PREFIX. 39HL EXIT 6 1 3=3= # 3=GW #SKI 3?2G ( 3?G6 # 3?^Q # THIS ENTRY POINT DOES THE "CAREFUL"UPDATING FOR THE BLOCK WHOSE 3#FB # NUMBER IN THE FCB BLOCKLIST IS POINTED TO BY THE FREADBLOCK-TYPE 3#^2 # POINTER IN X4.THE APPROPRIATE USAGE BLOCK MUST BE THE FIRST FI/ 3*DL # INSERT4 BLOCK IN THE FILE CHAIN. 3*Y= # 3BCW SCAREFULA 3BXG # 3CC6 CALL 6 SFCB3 [X3 -> FCB 3CWQ #SKI K6INSERT>299-299 3DBB TRACE 4,CAREFUL 3DW2 #SKI K6INSERT 3F*L ( 3FT= JBC ZGEOER1,3,BFCARE [ERROR IF NOT CAREFUL FILE 3G#W BXGE 4 BSBS,ZGEOER2 3GSG LDN 0 FBLKS 3H#6 BXL 4 0,ZGEOER2 3HRQ ) 3J?B JBC NEWFULLB,3,BFALTR [IF FILE NOT ALTERED,SET UP A FULLB 3JR2 CALL 6 SFINDFULLB [X2-> FULLB,X3-> FCB 3K=L BRN NEWFULLB [J IF FULLB NOT PRESENT 3KQ= LDX 6 ALOGLEN(2) [NOW ALTLEN FULLB 3L9W ADN 6 1 3LPG LDX 3 2 3M96 ALTLEN 3,6 [BY ONE WORD 3MNQ CALL 6 SFCB3 [X3/> FCB 3N8B BRN SFULONG [WHENCE WE CAME FOR GEOERR. 3NN2 NEWFULLB 3P7L SETNCORE 3,1,BSTB,FULLB [SET UP FUUB,X1 -> IF 3PM= CALL 6 SFCB3 [X3 ->FCB 3Q6W LDX 2 3 [X1 -> FCB 3QLG XLPA 3R66 LDX 2 FPTR(2) [NEXT BLOCK IN FILE CHAIN. 3RKQ BXE 2 CXFI,SCHAIN [J IF END OF FILE CHAIN. 3S5B LDX 0 ATYPE(2) 3SK2 BXE 0 FILEPLUSFCB,SCHAIN [J IF WE'VE REACHED FCB 3T4L SMO FX1 [O/W SEARCH FOR FULLB. 3TJ= BXU 0 SFULLB,XLPA 3W3W SCHAIN 3WHG STO 1 6 [PRESERVE FULLB PTR 3X36 CHAIN 1,BPTR(2) [CHAI> IN FRONT OF NEXT FCB 3XGQ LDX 2 6 [PICK UP FULLB PTR. 3Y2B LDX 0 BSPRE(3) [B.S. PREFIX OF FULLB 3YG2 STO 0 A1+1(2) 3Y^L LDN 0 2 [R.H 3^F= STO 0 A1(2) 3^YW SFULONG 42DG SGETBAC 42Y6 LDX 3 BSPRE(3) 43CQ GETBACK 3 [GET NEW BLOCK NO. 43XB ADDSKIP I516A,BSGET 44C2 LDX 1 3 [SAVE OVER NEXT S/R 44WL LDX 7 ACOMMUNE7(2) [NEW BLOCK 45B= CALL 6 SFCB3 [X3 -> FCB 45TW BXE 1 BSPRE(3),SBLOKOK [JIF BSPRE HASN'T CHANGED OVER COOR 46*G FREEBACK 1,7 [FREE BLOCK 46T6 ADDSKIP I516A,ADLFBL 47#Q CALL 6 SFCB3 47SB BRN SGETBAC 48#2 SBLOKOK 48RL LDX 2 FPTR(3) [-> FSTACK 49?= CALL 6 SFLP [S&T X2-> FU-LB 49QW CALL 0 ZGEOER5 [ERROR IF ABSENT 4==G SMO 4 4=Q6 LDX 0 0(3) [BLOCK NUMBER IN FCB 4?9Q SMO A1(2) 4?PB STO 0 A1(2) [PUT IN FULLB 4#92 LDN 0 1 [UPDATE RECORD HEADER. 4#NL ADS 0 A1(2) 4*8= #SKI CLSTATS 4*MW ADS 0 CLBS 4B7G SMO 4 [IN NEW 4BM6 STO 7 0(3) [BLOCK NUMBER INTO FCB. 4C6Q CALL 1 SFINDFURB [FIND USAGE BLOCK 4CLB #HAL FI+INSERT4,0 4D62 STO 6 BACK2(2) [BLOCK NUMBER 4DKL LDX 0 BSPRE(3) [ 4F5= STO 0 BACK1(2) [B.S.PREFIX. 4FJW MBS 3,BFALTR,BFALTB [INDICATE FILE & BLOCK NOS. ALTERED 4G4G SBN 4 FBLKS-1 4GJ6 MAPBSECH 4,3 [SET BIT IN FMAPP BLOCK. 4H3Q #SKI K6INSERT 4HHB BNZ 0 ZGEOER1 4J32 STEND 4JGL UP 4K2= # 4KFW ) 4K^G # 4LF6 # 4LYQ # THIS ENTRY INSERTS A BLOCK NUMBER IN THE FCB BLOCKLIST BEFORE THE 4MDB # BLOCK WHOSE NUMBER IN THE LIST IS GIVEN BY THE FREADBLOCK-TYPE 4MY2 # POINTER IN X4.THE USAGE BLOCK IS THE 1ST FI/INSERT3 BLOCK IN THE 4NCL # FILE CHAIN 4NX= # 4PBW SINSERT 4PWG CALL 6 SFCB3 [X3 -> FCB 4QB6 #SKI K6INSERT>299-299 4QTQ TRACE 4,INSERTS 4R*B #SKI K6INSERT 4RT2 ( 4S7C ... SMO FX1 4SFS ... BXGE 4 MXINS,ZGEOER2 4SS= LDN 0 FBLKS 4T?W BXL 4 0,ZGEOER2 4TRG ) 4W?6 MBS 3,BFALTR,BFALTB [INDICATE FILE & BLOCK NOS. ALTERED 4WK4 ... LDX 0 FBLMOD(3) 4WX2 ... SBX 0 FUSEBL(3) [GET NO. OF SPARE BLOCKS 4X8Y ... BZE 0 NOTSPAR [J IF NONE 4XGW ... SBN 0 2 4XSS ... BPZ 0 PLENTY [J IF TWO OR MORE SPARE BLOCKS 4Y6Q ... LDX 0 BIT9 4YDN ... ANDX 0 AWORK1(2) 4YQL ... BNZ 0 NOTSPAR [J IF TWO NEW BLOCKS WILL BE NEEDED 4^4J ... [TO COMPLETE INSERT. 4^BG ...PLENTY 4^NG JBS NOTSPAR,3,BFCARE [JIF CAREFUL FILE 5286 ... SMO FUSEBL(3) 52MQ LDX 7 A1-1(3) [[X7] = NEW BL. NO. 537B CALL 6 SINBLOC [MOVE BLOX DOWN 53M2 BRN SQUEXIT 546L NOTSPAR 54L= #SKI K6INSERT>399-399 555W TRACE 2,NOTSPAR 557D ... LDX 0 FUSEBL(3) 5592 ... SBN 0 FBLKS-A1 [NO OF BLOCKS +1 55=J ... LDX 6 BIT9 55#6 ... ANDX 6 AWORK1(2) 55*N ... BZE 6 TFULL [J IF ONLY ONE BLOCK NEEDED 55C= ... [TO COMPLETE INSERT. 55DS ... ADN 0 1 [ENSURE ROOM FOR 2 BLOX IF NECESSARY 55GB ...TFULL 55HY ... BXGE 0 FSIZE(3),SFULL 55KG LDX 6 ALOGLEN(3) 5656 ADN 6 1 [ADD 1 TO LENGTH 56JQ ALTLEN 3,6 [OF FCB 574B SGETBAK 57J2 CALL 6 SFCB3 [X3 ->FCB 583L LDX 3 BSPRE(3) 58H= GETBACK 3 [GET NEW BLOCK NO. 592W ADDSKIP I516A,BSGET 59GG #SKI K6INSERT>399-399 5=26 TRACE ACOMMUNE7(2),NEWBLOK 5=FQ LDX 1 3 5=^B LDX 7 ACOMMUNE7(2) 5?F2 CALL 6 SFCB3 [X3 -> FCB 5?YL BXE 1 BSPRE(3),TBLOKOK 5#D= FREEBACK 1,7 [FREE BLOCK 5#XW ADDSKIP I516A,ADLFBL 5*CG BRN SGETBAK 5*X6 TBLOKOK 5B4# ... LDN 0 1 5B9H ... ADS 0 FUSEBL(3) [UPDATE FUSEBL BY ONE BLOCK 5BBQ CALL 6 SINBLOC [MOVE DOWN BLOX 5CB2 JBC SQUEXIT,3,BFCARE [EXIT IF NOT CAREFUL 5CTL SBN 4 FBLKS-1 [DATUMISE 5D*= LDX 2 FX2 5DSW MAPBIN 4,AWORK2(2) [ZNSERT BIT 5F#G #SKI K6INSERT>199-199 5FS6 TRACE 4,MAPINS 5G?Q CALL 6 SFCB3 [X3 ->FCB 5GRB ADN 4 FBLKS-1 5H?2 SQUEXIT 5HQL CALL 1 SFINDFURB [X2->FURB 5J== #HAL FI+INSERT3,0 5JPW SMO 4 [PICK UP NEW KCOLB NO. 5K9G LDX 0 0(3) [FROM FCB(AS WE MAY HAVE COORED) 5KP6 STO 0 BACK2(2) 5L8Q LDX 0 BSPRE(3) [& B.S. PREFIX 5LNB STO 0 BACK1(2) 5M82 #SKI K6INSERT>399-399 5MML SETREP OK 5N7= TRACE 4,SINSERTD 5NLW UP 5P6G # 5PL6 SINBLOC 5Q5Q #SKI K6INSERT>499-499 5QKB TRACE FBLMOD(3),SINBLOC 5QM^ ... LDN 0 1 5QQJ ... SMO FX2 5QT7 ... LDX 1 AWORK2 5QXQ ... INCRECUBS FORCED,1,0 [ADJUST ONLINE BS COUNT - SHOULDN'T R 5R2* ... [ COMPLICATED & TOO UNIMPORTANT TO AL 5R52 LDX 2 FUSEBL(3) 5RJL SBX 2 4 [X2 CONTAINS THE NUMBER OF 5S4= ... ADN 2 A1-1 [BLOCKS TO MOVE DOWN 5SHW ... LDN 1 A1-2(3) [X1 -> LAST BUT ONE ALLOCATED 5T3G ADX 1 FUSEBL(3) 5TH6 BZE 2 NOBLKS [J IF NO BLOCKS TO MOVE,I.E.APPENDING 5W2Q SINLP 5WGB #SKI K6INSERT>599-599 5X22 TRACE 0(1),SINLP 5XFL LDX 0 0(1) [MOVE A BLOCK DOWN 1 5X^= STO 0 1(1) 5YDW SBN 1 1 [DECREMENT PTR. 5YYG BCT 2 SINLP 5^D6 NOBLKS 5^XQ STO 7 1(1) [STORN NOW BLOCK NO$ IN FCB 62CB #SKI K6INSERT>199-199 62X2 TRACE 7,SINBLOC 63BL LDN 0 1 [INCREMENT 63W= ADS 0 FBLMOD(3) [FBLMOD 64*W EXIT 6 0 64TG # 65*6 SFULL 65SQ # FILEFULL 66#B SETREP FILEFULL 66S2 #SKI K6INSERT>99$99 67?L TRACE FX2,FILEFULL 67R= UP 68=W [ 68QG MENDAREA K6INSERT/5<100>30,K99INSERTBL 69=6 #END ^^^^ ...15525433001200000000