{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: INSERTBL6)}}
====== INSERTBL6 ======
(George Source)
**Macros used:** [[george:macro:ADDSKIP|ADDSKIP]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BLOCK|BLOCK]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:FREEBACK|FREEBACK]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETBACK|GETBACK]], [[george:macro:INCRECUBS|INCRECUBS]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:MAPBIN|MAPBIN]], [[george:macro:MAPBSECH|MAPBSECH]], [[george:macro:MBS|MBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|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