{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: INSERTFR6)}}
====== INSERTFR6 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BLOCK|BLOCK]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:DOWN|DOWN]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:PSTAC|PSTAC]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]]
22FL #SEG INSERTFR6 [ TONY HAMILTON
22^= #OPT K0INSERTFR=K0INSERT>K0ACCESS>K0FILESTORE>K0ALLGEO
23DW #LIS K0INSERTFR
23YG 8HINSERTFR
24D6 [
24XQ SEGENTRY K1INSERTFR,X1INSERTFR
25CB SEGENTRY K2INSERTFR,SFULL
25X2 [
26BL # ERRORS
26W= ZGEOER6
27*W GEOERR 1,MOVEZERO [UNEXPECTED ZERO MOVE IN INSERT
27TG ZGEOER7
28*6 GEOERR 1,STO ZERO [MOVE OR LESS AS ABOVE
28SQ ZGEOER8
29#B GEOERR 1,NO BLOCK [INSERT BLOCK MISSING
29S2 ZGEOER11
2=?L GEOERR 1,ENDBLOCK [INSERT REACHED E.O.B. UNEXPECTEDLY.
2=R= ZGEOER12
2?=W GEOERR 1,V SET! [CMOD UPDATED INCORRECTLY
2?QG #
2#=6 SFI1
2#PQ #HAL FI+INSERT1,0
2*9B SFI2
2*P2 #HAL FI+INSERT2,0
2B8L SFI3
2BN= #HAL FI+INSERT3,0
2C7W SFI4
2CMG #HAL FI+INSERT4,0
2D76 SFI5
2DLQ #HAL FI+INSERT5,0
2F6B #
2FL2 # SUBROUTINES
2G5L #
2GK= SFCB3 [SET X3-> FCB
2H4W SMO FX2
2HJG LDX 0 AWORK2
2J46 SFSTACK 0,3 [X3 -> FCA
2JHQ SMO FX2
2K3B STO 3 ACOMMUNE5 [STORE
2KH2 PSTAC 3,3
2L2L BFCBX 3,3 [X3 -> FCB
2LG= EXIT 6 0
2L^W #
2MFG #
2M^6 SFURB
2NDQ SMO FX2
2NYB LDX 0 AWORK2 [SET X2 - > FSTACK
2PD2 SFSTACK 0,2 [X2 -> FCA
2PXL SMO FX2
2QC= STO 2 ACOMMUNE5
2QWW SFFURB
2RBG PSTAC 2,2
2RW6 BFCBX 2,2
2S*Q BRN SFFULP
2STB SFINDFURB
2T*2 # CALLED BY X1.THE WORD AFTER THE CALL CONTAINS THE TYPE/SUBTYPE
2TSL # WANTED.X3 ->FCB,X2 WILL POINT ON EXIT TO THE BLOCK REQUIRED.
2W#= LDX 2 FPTR(3) [J OVER FSTACK BLOCK
2WRW SFFULP
2X?G LDX 2 FPTR(2) [NEXT BLOCK
2XR6 LDX 0 ATYPE(2)
2Y=Q #SKI K6INSERT
2YQB BXE 0 FILEPLUSFCB,ZGEOER8 [ERROR IF NOT FOUND
2^=2 BXU 0 0(1),SFFULP [J IF WRONG TYPE
2^PL EXIT 1 1 [EXIT ROUND TYPE-WORD
329= #
32NW #
338G #
33N6 SFCA2
347Q SMO FX2
34MB LDX 0 AWORK2 [DEPTH
3572 SFSTACK 0,2 [X2 -> FCA
35LL SMO FX2
366= STO 2 ACOMMUNE5
36KW EXIT 6 0
375G #
37K6 #
384Q # THIS S/R DOES THE CAREFUL UPDATING FOR A NEW BLOCK; A BIT HAS TO
38JB # BE INSERTED IN THE FMAP BLOCK,AND A BLOCK NO. INSERTED IN THE
3942 # FCB
39HL #
3=3= # OVERWRITES X1,X2,X3,X6,X5; X4 POINTS TO BLOCK NO. BEFORE WHICH THE
3=GW # BLOCK IS TO BE INSERTED. IN THE CASE OF NON-CAREFUL FILES,WE
3?2G # CAN USE AN UNUSED BL.NO., IF ANY;O/W WE MUST GET A NEW ONE.
3?G6 # X2 ON EXIT -> USAGE BLOCK
3?^Q SINSERT
3#FB SINSERT1
3#^2 SBX 7 FX1
3*DL DOWN INSERTBL,2
3*Y= TESTREP FILEFULL,SFULL
3BCW ADX 7 FX1
3BXG CALL 1 SFURB
3CC6 #HAL FI+INSERT3,0
3CWQ EXIT 7 0
3DBB #
3DW2 #
3F*L # THIS SEGMENT COPES WITH A RECORD WHICH INVOLVES 2 BLOX OF OVERFLOW
3FT= #
3G#W X1INSERTFR
3GSG NGN 5 1 [SET X5 -VE IF BACKWARD
3H#6 LDCT 0 #40
3HRQ ANDX 0 AWORK1(2)
3J?B BZE 0 NOTFOR [SET X5 +VE IF FORWARD
3JR2 LDN 5 1
3K=L NOTFOR
3KQ= LDCT 0 #14 [IF "EMPTY BLOCK " BITS SET WE DON'T
3L9W ANDX 0 AWORK1(2) [NEED TO SET UP AN INSERT3 BLOCK
3LPG BZE 0 NOTEMPT [THERE IS ALREADY ONE THERE
3M96 CALL 1 SFURB
3MNQ #HAL FI+INSERT3,0
3N8B LDX 3 2 [SET X3 -> INSERT3 BLOCK
3NN2 LDX 2 FX2
3P7L SMO ACOMMUNE5(2)
3PM= LDX 4 FREADBLOCK [PICK UP F'BLOCK
3Q6W BRN MHUNTW
3QLG NOTEMPT
3R66 SETNCORE GSBS,3,FI,INSERT3 [SET UP INSERT2 BLOCK.
3RKQ CALL 6 SFCA2 [X2->FCA
3S5B LDX 4 FREADBLOCK(2)
3SK2 PSTAC 2,2 [RECHA&N NEW BLOCK
3T4L CHAIN 3,2
3TJ= MHUNTW
3W3W MHUNTW 2,FILE,FWB [NEW RECO-D
3WHG LDEX 1 A1+FRH(2) [SI0E OF MOVE
3X36 ADN 2 A1
3XGQ ADN 3 A1
3Y2B #SKI K6INSERT
3YG2 TRACE 1,INTO I3
3Y^L #
3^F= MOVE 2 0(1) [MOVE IN NEW RECORD
3^YW SMO 1
42DG STOZ 0(3) [ZEROISE LAST WORD
42Y6 BNG 5 NFOR1 [WISH TO INSERT A NEW ONE
43CQ ADN 4 1 [=F'WO-D +1 IF FORWARD
43XB NFOR1
44C2 LDCT 0 #14
44WL SMO FX2
45B= ANDX 0 AWORK1 [IF"EMPTY BLOCK" BITS SET,NO NEED TO
45TW BZE 0 NEMPT [INSERT BL.NO.AS ONE ALREADY ALLOCATE
46*G LDX 2 3 [X2 -> INSERT2
46T6 SBN 2 A1
47#Q BRN NAME
47SB NEMPT
47Y? ... LDX 0 BIT9
4848 ... SMO FX2 [SET BIT TO INDICATE TWO NEW BLOCKS
4885 ... ORS 0 AWORK1 [WILL BE NEEDED TO COMPLETE INSERT.
48#2 CALL 7 SINSERT [INSERT BL.NO.
48CX ... LDX 0 BIT9
48HS ... SMO FX2 [CLEAR BIT AS ONLY ONE MORE BLOCK
48MP ... ERS 0 AWORK1 [NEEDED NOW.
48RL NAME
49?= SETNCORE GSBS,3,FI,INSERT3 [SET UP INSERT5 BLOCK
49QW CALL 6 SFCA2 [X2 -> FCA
4==G PSTAC 2,2
4=Q6 CHAIN 3,2 [CHAIN NEW LOCK IN
4?9Q BNG 5 NFOR2 [SIDE OF THE INSERT2 BLOCK FROM THE
4?PB ADN 4 1 [CURRENT BLOCK
4#92 NFOR2
4#NL CALL 7 SINSERT [INSE-T BLOCK NUMBER.
4*8= NAME 2,FI,INSERT5 [RENAME BLOCK.
4*MW STO 2 4 [X4 -> INSERT5
4B7G CALL 6 SFCA2 [X3 -> FCA
4BM6 STO 2 3
4C6Q #SKI INSB
4CLB BNG 5 MOVETOPH [J IF BACKWARDS
4D62 CALL 1 SFURB [X2 -> INERT1
4DKL #HAL FI+INSERT1,0
4F5= SMO FX2
4FJW LDEX 1 AWORK3 [AMT.USED IN INSERT1 BLOCK
4G4G SBX 1 FREADWORD(3) [AMOUNT TO BE MOVED
4GJ6 STOZ 6
4H3Q ADX 2 FREADWORD(3) [X2 -> CURRENT RECORD
4HHB SMO FX2
4J32 LDX 0 AWORK1
4JGL BPZ 0 NREP1 [J IF &NSERT
4K2= LDEX 6 FRH(2) [STEP OVER REPLACEE
4KFW ADX 2 6 [BUT -EMEMBER R.H.
4K^G SBX 1 6 [DOWNDATE AMOUNT TO BE MOVED
4LF6 #SKI K6INSERT
4LYQ BZE 1 ZGEOER6
4MDB NREP1
4MY2 LDX 3 4
4NCL ADN 3 A1 [X3 -> BEGINNING OF DATA IN INSERT5 B
4NX= #SKI K6INSERT
4PBW TRACE 1,INTO I5
4PWG MOVE 2 1(1) [MOVE ACROSS DATA+ZERO WORD
4QB6 SBX 2 6 [DEDUCT SIZE OF REPLACEE(ZERO FOR
4QTQ STOZ 0(2) [INSE-T).NEW E.O.B. ZERO WORD.
4R*B SMO FX2 [X1 -> FCA
4RT2 LDX 1 ACOMMUNE5
4S#L SBX 2 FREADWORD(1) [X2 -> INSERT1 BLOCK
4SS= SBN 3 A1
4T?W UPDATERD
4TRG LDN 0 2 [STEP ON F'BLOCK TO POINT
4W?6 ADS 0 FREADBLOCK(1) [TO INSERTS BBLOCK
4WQQ SMO FX2
4X=B LDX 0 AWORK1 [READ--ECORD PTR FCB
5=FQ CALL 1 SFFULP [GET & RENAME OTHER BLOCK
5=^B #HAL FI+INSERT3,0
5?F2 NAME 2,FILE,FUWB
5?YL UP
5#D= #SKI INSB
5#XW (
5*CG MOVETOPH
5*X6 #SKI K6INSERT>99-99
5BBQ TRACE 4,MOVETOPH
5BWB LDX 1 FREADWORD(3) [PICK UP FREADWORD
5CB2 STO 2 3 [X3 -> INSERT5 BLOCK
5CTL CALL 1 SFURB [SET X2 -> FI/INSERT1 BLOCK
5D*= #HAL FI+INSERT1,0
5DSW [X5 -> INSERT1
5F#G SBN 1 A1 [X1 = NO OF WORDS TO MOVE
5FS6 #SKI K6INSERT
5G?Q BZE 1 ZGEOER7 [ERROR IF NOTHING GOES TO INSERTS BL.
5GRB ADN 2 A1
5H?2 ADN 3 A1
5HQL MOVE 2 0(1) [MOVE ACROSS TOP HALF OF INSERT1 BL.
5J== SMO 1
5JPW STOZ 0(3) [SET ZERO WORD @ END
5K9G SBN 3 A1
5KP6 NAME 3,FILE,FUWB [RENAME & FORGET INSERTS BLOCK
5L8Q STOZ 4 [SIZE OF REPLA EE,ZERO FOR INSERT,
5LNB [NEE4ED FOR RE ALCULATION OF CMOD,&AL
5M82 LDX 3 2 ["TO " PTR FOR MOVE UP BLOCK
5MML ADX 2 1 ["FROM" PTR FOR INSERT
5N7= SMO FX2
5NLW LDX 0 AWORK1 [FOR REPLACE ADD IN NEXT R.H.
5P6G BPZ 0 SCHENEXRH [J IF &NSERT
5PL6 LDEX 4 FRH(2) [NEXT -.H.
5Q5Q #SKI K6INSERT
5QKB BZE 4 ZGEOER11 [!
5R52 ADX 2 4
5RJL SCHENEXRH
5S4= LDEX 0 FRH(2) [NEXT -.H
5SHW #SKI K6INSERT
5T3G BZE 0 ZGEOER11 [!
5TH6 ADX 4 1
5W2Q SMO FX2
5WGB LDEX 1 AWORK3 [AMT USED IN INSERT1 BLOCK
5X22 SBX 1 4
5XFL SBN 1 A1 [MINUS A1,GIVES AMOUNT LEFT TO MOVE U
5X^= #SKI K6INSERT
5YDW BZE 1 ZGEOER6
5YYG MOVE 2 1(1) [+1 FOR ZERO WORD
5^D6 LDN 0 A1
5^XQ LDX 2 FX2
62CB SMO ACOMMUNE5(2)
62X2 STO 0 FREADWORD
63BL SBN 3 1
63W= NAME 3,FILE,FUWB
64*W LDX 3 ACOMMUNE5(2)
64TG LDX 6 FREADBLOCK(3) [PICK UP 6'WORD
65*6 PSTAC 1,3
65SQ BFCBX 1,1 [X1 -> FCB
66#B SBX 6 FBLMOD(1)
66S2 SBN 6 A1-1 [LAST BLOCK £
67?L BNZ 6 NOLBLO [J IF NOT
67R= SBS 4 CMOD(1) [XPDATE COMD.
68=W #SKI K6INSERT
68QG BVS ZGEOER12 [?!!
69=6 NOLBLO
69PQ UP
6=9B )
6=P2 #
6?8L #
6?N= SFULL
6#7W #
6#MG # FILEFULL ENTRY
6*76 #
6*LQ CALL 6 SFCA2
6B6B PSTAC 3,2
6B8^ ... BFCBX 2,3 [X2->FCB
6B?J ... LDX 0 FINFC(2)
6BB7 ... ANDN 0 #77
6BDQ ... BZE 0 SLPP [J IF NOT INDEXED
6BH* ... GEOERR 1,INDXFULL
6BL2 SLPP
6C5L LDX 3 FPTR(3)
6CK= BXE 3 CXFI,SLPN
6D4W LDX 0 ATYPE(3)
6DJG BXE 0 FILEPLUSFCB,SLPN
6F46 ... BXE 0 SFI1(1),RNFUWB
6FHQ BXE 0 SFI2(1),RN
6G3B BXE 0 SFI3(1),RN
6GH2 BXE 0 SFI4(1),RN
6H2L BXE 0 SFI5(1),RN
6HG= BXE 0 FFSFURB,RN
6H^W BXE 0 FFSFUWB,SLPP
6JFG #SKI K6INSERT>199-199
6J^6 TRACE 0,ODD BLOC
6KDQ BRN SLPP
6KG# ...RNFUWB
6KHW ... LDCT 0 #100
6KKD ... SMO FX2
6KM2 ... ANDX 0 AWORK1
6KNJ ... BZE 0 RN [J IF NOT A CAREFUL FILE
6KQ6 ... NAME 3,FILE,FUWB [CAREFUL UPDATING DONE ON INSERT1 IN
6KRN ... [INSERT SEGMENT SO MUST BE WRITTEN
6KT= ... BRN SLPP [AWAY TO NEW B.S. HOME EVEN THOUGH
6KWS ... [CONTENTS UNCHANGED.
6KYB RN
6LD2 FREECORE 3
6LXL BRN SFULL
6MC= SLPN
6MWW SETREP FILEFULL
6NBG #SKI K6INSERT>99-99
6NW6 TRACE FX2,FILEFULL
6P*Q UP
6PTB #
6Q*2 MENDAREA K6INSERT/5<100>30,K99INSERTFR
6QSL #
6R#= #END
^^^^ ...73202637000400000000