{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CLOSEAB863)}}
====== CLOSEAB863 ======
(George Source)
**Macros used:** [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BC|BC]], [[george:macro:BITDEFS|BITDEFS]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COOR3|COOR3]], [[george:macro:DELETE|DELETE]], [[george:macro:ERASEMULT|ERASEMULT]], [[george:macro:FCBFIND|FCBFIND]], [[george:macro:FREEBAX|FREEBAX]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FULLBPAS|FULLBPAS]], [[george:macro:GEOERR|GEOERR]], [[george:macro:JBC|JBC]], [[george:macro:JBCC|JBCC]], [[george:macro:JBS|JBS]], [[george:macro:JMBS|JMBS]], [[george:macro:MBS|MBS]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:OPENREL|OPENREL]], [[george:macro:RERING|RERING]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETBIT|SETBIT]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SFCAB|SFCAB]], [[george:macro:STEP|STEP]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TRACEIF|TRACEIF]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]]
22FL ... SEG CLOSEAB,863,SECTION FILE,CLOSE
24XQ #
25CB SEGENTRY K1CLOSEAB,XENT1
25X2 #
25YW ...#
262Q ... BITDEFS 7,20,XBCOPY [CLOSING FROM COPY MODE
264L ...#
266G ...#
26L6 ...# THIS SEGMENT IS ENTERED FROM CLOSEND AFTER A CLOSEABANDON.
275Q ...# IF THE FILE IS OPEN TO OTHERS,
27KB ...# THEN JUST MARK THE FILE "TO-BE-CLOSEABANDONED".
2852 ...# IF THE FILE IS OPEN CAREFULLY, THE DIRECTORY WILL NOT NORMALLY BE
28JL ...# ANY NEW BACKING STORE BLOCKS INDICATED BY THE FMAPP ARE FREE
294= ...# IF NOT CAREFUL, THE BACKING STORE IS FREED AND THE FILE IS PUT OFF
29HW ...# OR IF THE FILE HAS NOT BEEN DUMPED, ERASED.
2#=6 #
2#PQ MCOM #57777777
2*9B ...#
2*BJ ...# SUBROUTINES
2*HQ ...# -----------
2*P2 ...#
2B8L ...#
2BN= ...TB
2C7W ... TOPFCB 2 [X2-> FCB AT DEPTH 0
2CMG ... EXIT 6 0
2D76 ...#
2DLQ ...# LOCATE THE FCB AT DEPTH 1 (TERMINAL FILE TO BE ABANDONED)
2FL2 OLDFCB
2G5L LDN 0 1
2GK= ... SFCAB 0,2,2 [X2-> FCB AT DEPTH 1
2H4W EXIT 6 0
2KH2 #
2KL6 ...# GIVEN A POINTER TO AN FCB, LOCATES THE CORRESPONDING FMAPP BLOCK (
2KP= ...# BE ONE, BUT DOESN'T CHECK).
2KSB ...# ON ENTRY, X2->FCB. X6 IS LINK.
2KXG ...# ON EXIT, X2->FCB, X3->FMAPP. USES X0.
2L2L SFMAPP
2L7S ... LDX 3 2
2L*2 ...NEXTBL
2LG= LDX 3 FPTR(3)
2L^W LDX 0 ATYPE(3)
2MFG ... BXU 0 FFSFMAPP,NEXTBL [J IF NOT FMAPP
2NYB EXIT 6 0
2PD2 #
2PXL ...SETFAB
2QC= ... SBX 5 FX1
2QWW ... SETNCORE 10,3,FILE,FABSNB
2RBG ... LDN 0 10
2RW6 ... STO 0 A1(3) [RECORD HEADER
2S*Q ... CALL 6 TB [X2-> FCB
2STB ... ADN 2 FUSER1
2T*2 ... ADN 3 A1+1
2TSL ... MOVE 2 9 [MOVE TERMINAL FILE NAME FROM FCB TO
2W#= ... ADX 5 FX1
2WRW ... EXIT 5 0
2X?G ...#
2XR6 ...# SUBROUTINE TO CHECK IF FILE CAN BE ABANDONED YET.
32S2 ...# IF NOT, THEN SET ABANDON MARKER IN FCB.
32S# ...# ON ENTRY, X1=FX1, X2-> FCB OF FILE BEING ABANDONED. X5 IS LINK.
32SL ...# ON EXIT, X1=FX1, X2->FCB,. USES X0.
32SY ...# EXITS +0 IF FILE WILL STILL BE OPEN, +1 IF NOT.
32T= ...TESTAB
32Y? ... LDX 0 CTOPEN(2)
333# ... ANDX 0 MCOM(1)
336* ... SBX 0 4
339B ... BNZ 0 SETAB [J IF SOMEONE ELSE HAS FILE OPEN
33#C ... JBS XCOPIER,,XBCOPY [J IF CLOSING FROM COPY
33CD ... JBS SETAB,2,BFMCOP [J IF FILE OPEN (IN COPY MODE)
33GF ...XCOPIER
33KG ... TRACEIF K6CLOSEAB,99,299,FLOC1(2),CLOSAB1 [ONLY ONE OPENER SO CA
33NH ... EXIT 5 1
33RJ ...SETAB
33WK ... BS 2,BFCLOSEAB
33^L ... TRACEIF K6CLOSEAB,99,299,FLOC1(2),CLOSAB>1 [>1 OPENER SO JUST SE
344M ... EXIT 5 0
347Q #
34MB #
34R? ...# MAIN PATH
34X8 ...# ---- ----
3535 ...#
3572 # ENTRY FROM CLOSEND
35LL [
366= XENT1
36KW ... CALL 6 TB [X2-> FCB
375G ... CALL 5 TESTAB [TEST IF SOMEONE ELSE HAS FILE OPEN
37K6 ... BRN UP [SOMEONE ELSE HAS FILE ACTUALLY OPEN
384Q ... [SOLE OPENER AT THIS POINT (MAY BE WA
38JB ... LDX 0 FINFC(2)
3942 ... ANDN 0 #77
39HL ... BNZ 0 YINDEX [GEOERR IF INDEXED
3=3= ... CALL 5 SETFAB [SET UP FABSNB FOR TOP FILE OPEN
3=GW ... OPENDIR XBRK,GENERAL,ERASING [DIR. ENTRY MUST BE THERE
3?2G ... MFREEW FILE,FABSNB
3?G6 ...#
3?^Q ...# NOW WE HAVE THE DIRECTORY OPEN, NO ONE ELSE CAN OPEN THE FILE
3#FB ...#
3#^2 ... CALL 6 OLDFCB [X2-> FCB OF FILE BEING ABANDONED
3*DL ... CALL 5 TESTAB [SEE IF ANYONE HAS OPENED FILE
3*Y= ... BRN OTHEROPE [OTHER OPENER NOW
3BCW ... LDN 5 0 [INITIALISE COUNT OF FULLBS
3BXG ... JBC NOTCAREFUL,2,BFCARE [J IF FILE NOT BEING CAREFULLY UPDATE
3CC6 ... CALL 6 SFMAPP [X3-> FMAPP
3CWQ ... JMBS OFFLINE,2,BFUWB,BFCLOSEABOF [J IF OPEN UNCLEANLY (BFUWB +
3DBB ... [UPDATE FOLLOWED IMMEDIATELY BY CAREF
3DW2 ... [HAS NOT UPDATED DIR.). J ALSO IF CLO
3F*L ... MHUNTW 1,FILE,ENT
3FT= ... JBC NERASE,1,BEERASE [J IF NOT TO-BE-ERASED
3G#W ... LDEX 0 EAUTOCOUNT(1)
3GSG ... ADX 0 ESVCT(1)
3H#6 ... BZE 0 OFFLINE [J IF FILE NOT FROZEN
3HRQ ...NERASE
3J?B ...#
3JR2 ...# NOW CREATE FULLB BIG ENOUGH TO CONTAIN COMPLETE LIST OF NEW BLOCK
3K=L ...# - FULLB MAY BE MUCH BIGGER THAN REQUIRED.
3KQ= ...#
3L9W ... LDX 4 FUSEBL(2)
3LPG ... SBN 4 FBLKS-A1-2 [MAX. SIZE OF FULLB REQUIRED
3M96 ... SETUPCORE 4,1,BSTB,FULLB [X1-> FULLB
3MNQ ... LDN 0 2
3N8B ... STO 0 A1(1) [INITIALISE NO. OF BLOCKS
3NN2 ... CALL 6 OLDFCB [X2-> FCB AT LEVEL 1
3P7L ... LDX 0 BSPRE(2)
3PM= ... STO 0 A1+1(1) [STORE RESIDENCE NO. IN FULLB
3Q6W ... CALL 6 SFMAPP [X3-> FMAPP
3QLG ... LDN 4 0 [INITIALISE FBITS WORD MODIFIER
3R66 ... NGNC 0 1 [CLEAR BIT 0
3RFT ... ANDS 0 FBITS(3) [OF FBITS TO MAKE CODE IN FOLLOWING L
3RTJ ... NGN 6 1 [INITIALISE COUNT OF TOTAL FBITS BITS
3S9? ... [(ALLOW FOR NON-USE OF B0)
3SK2 ...NEXTFBITS
3T4L ... SMO 4
3TJ= ... LDX 0 FBITS(3) [X0= NEW WORD OF BIT MAP
3W3W ... LDN 5 24 [INITIALISE BIT COUNT
3WHG ...NEXTBIT
3X36 ... ADN 6 1 [UPDATE TOTAL BIT COUNT
3XGQ ... BPZ 0 NSWAP [J IF BLOCK NO. NOT SWAPPED
3Y2B ... SMO 6
3YG2 ... LDX 7 FBLKS-1(2) [X7= NEW BLOCK FROM FCB
3Y^L ... SMO A1(1)
3^F= ... STO 7 A1(1) [TRANSFER BLOCK NO. TO FULLB
3^YW ... LDN 0 1
42DG ... ADS 0 A1(1) [UPDATE FULLB RECORD HEADER
42Y6 ...NSWAP
43CQ ... BXE 6 FBITMOD(3),NOMOREFBITS [J IF LOOKED AT ALL BITS
43XB ... SLL 0 1
44C2 ... BCT 5 NEXTBIT [J IF MORE BITS TO LOOK AT IN THIS WO
44WL ... BUX 4 NEXTFBITS [UPDATE FBITS WORD POINTER (ALWAYS BR
45B= ...NOMOREFBITS
45TW ... LDX 3 FPTR(3) [LOOK AT BLOCK AFTER FMAPP
46*G ... BXE 3 CXFI,NOFULLB2 [J IF BASE OF FILE CHAIN
46T6 ... LDX 0 ATYPE(3)
47#Q ... BXU 0 FFSFULLB,NOFULLB2 [J IF NOT FULLB
47SB ... LDX 0 A1+1(3)
48#2 ... BXU 0 BSPRE(2),RESWRONG [GEOERR IF RES. NO. IN FULLB & FCB DI
48RL ... FREECORE 3 [FREE FULLB - DO NOT FREE BS
49?= ...NOFULLB2
4#92 ... FREEBAX [FREE BS (NO NEED TO BE CAREFUL)
4#NL ... MFREEW BSTB,EMPTYB
4*8= ... MHUNTW 1,FILE,ENT
4*MW ... BRN NERASEMULT
4B7G ...#
4BM6 ...#
4C6Q ...#
4CLB ...#
4D62 ...OFFLINE
4DKL ... LDX 2 FPTR(3)
4F5= ... LDX 0 ATYPE(2)
4FJW ... BXU 0 FFSFULLB,NOFULLB [J IF NEXT BLOCK NOT A FULLB
4G4G ... CHAIN 2,FX2
4GJ6 ... ADN 5 1 [UPDATE COUNT OF FULLBS
4H3Q ...NOFULLB
4HHB ... CALL 6 OLDFCB [X2-> FCB AT LEVEL 1
4J32 ...NOTCAREFUL
4JGL ... LDX 3 FUSEBL(2)
4K2= ... SBN 3 FBLKS-A1
4KFW ... BZE 3 YEMPTY [J IF FILE EMPTY
4K^G ... ADN 3 2
4LF6 ... SETUPCORE 3,1,BSTB,FULLB [
4LYQ ... STO 3 A1(1)
4MDB ... CALL 6 OLDFCB [X2-> FCB OF TERMINAL FILE
4MY2 ... LDN 0 BSPRE(2)
4NCL ... ADN 1 A1+1
4NX= ... MOVE 0 511(3) [MOVE RES. NO. & BLOCK NOS. FROM FCB
4PBW ... ADN 5 1 [UPDATE COUNT OF FULLBS
4PWG ...YEMPTY
4QB6 ... MHUNTW 1,FILE,ENT
4QTQ ... LDEX 7 ECOPS(1)
4R*B ... BZE 7 OFFLIN [J IF FILE OFFLINE
4RT2 ... BACKSPACE [TO NAME RECORD
4S#L ... MHUNTW 1,FILE,ENT
4SS= ...OFFLIN
4T?W ... NAME 1,FILE,FWB
4THN ... LDEX 0 EAUTOCOUNT(1)
4TRG ... ADX 0 ESVCT(1)
4W3# ... LDX 4 EINC(1)
4W?6 ... BNZ 4 YDUMPED [J IF FILE DUMPED
4WGY ... BZE 0 NOTDUMPED [J TO ERASE FILE IF NOT FROZEN
4WQQ ... LDN 4 1
4X2J ... BS 1,BECLOSEAB [MARK FILE TO BE CLOSEABANDONED
4X=B ... STOZ ECOPS(1) [WHEN NO LONGER FROZEN
4XG8 ... BRN NOTREDUMP
4XQ2 ...YDUMPED
4X^S ... BNZ 0 SFROZEN [J IF FROZEN
4Y9L ... JBS MULT1,1,BEERASE [J IF FILE T0-BE-ERASED (ERASE IT!!)
4YP= ...SFROZEN
4^8W ... LDCT 0 1 [MAKE FILE LOOK OFFLINE WITH 1 BLOCK
4^NG ... STO 0 ECOPS(1) [OFFLINE COPY MIGHT NOT BE (OPENREL D
5286 ... JBCC NOTREDUMP,1,BEDUMP
52MQ ... JBS MULT1,1,BEMULT [J IF MULTFILE ELEMENT (ERASE IT)
537B ... MBS 1,BELOSE,BEREVERT [SET 'COPY OF FILE LOST' MARKER
53M2 ... LDX 0 EDLD(1)
546L ... STO 0 EWRITDAY(1)
54L= ... LDX 0 ETLD(1) [RESET DATE/TIME LAST WRITTEN TO DATE
555W ... STO 0 EWRITTIME(1) [ LAST DUMPED (SINCE DON'T KNOW REAL
55KG ... TRACEIF K6CLOSEAB,99,299,ELOC1(1),CLOSABLO [LOSE COPY OF FILE
5656 ...NOTREDUMP
56JQ ... BC 1,BEUWB
574B ... REWRITE [REWRITE NAME RECORD
57J2 ...TOFFLIN
583L ... BZE 7 OFFLIN1
58H= ... STEP
592W ... DELETE [DELETE BLOCKS RECORD
59GG ...OFFLIN1
5=26 ... BNZ 4 NOERASE [J IF NOT ERASING FILE
5=FQ ... MHUNTW 1,FILE,FWB
5=^B ... LDX 7 ENUSE(1) [X7= NO. OF USER TRAPS
5?F2 ... BZE 7 NOERASE [J IF NO TRAPS
5?YL ...TRAPER
5#D= ... STEP
5#XW ... DELETE
5*CG ... BCT 7 TRAPER [J IF MORE TRAPS TO DELETE
5*X6 ...NOERASE
5BBQ ... BZE 5 NOFULLB1 [J IF NO FULLBS
5BWB ...NEXTFULLB
5CB2 ... MHUNTW 1,BSTB,FULLB
5DSW ... FULLBPAS 1,2 [CHAIN BS FOR FREEING WHEN DIR. UPDAT
5F#G ... BCT 5 NEXTFULLB
5FS6 ...NOFULLB1
5G?Q ... MHUNTW 1,FILE,FWB
5GRB ... BNZ 4 NERASEMULT [J IF NOT ERASING FILE
5H?2 ... JBS MULTERASE,1,BEMULT [J IF MULTIFILE
5HQL ...NERASEMULT
5J== ... FREECORE 1 [FREE FWB
5JPW ... LDX 3 FILERING(2)
5K9G ... LDX 3 FPTR(3) [X3-> FCA AT LEVEL 1
5KP6 ... ADN 2 FILERING [X2-> BASE OF FILE RING
5L8Q ... RERING 3,2 [MOVE TERMINAL FILE TO LEVEL 0 (DIR.
5LNB ... UPPLUS 1 [NORMAL EXIT
5M82 ...#
5MML ...#
5N7= ...MULT1
5NLW ... LDN 4 0 [INDICATE TO ERASE THIS FILE (ELEMENT
5P6G ...NOTDUMPED
5PL6 ... TRACEIF K6CLOSEAB,99,299,ELOC1(1),CLOSABER [ERASE FILE
5Q5Q ... DELETE [DELETE NAME RECORD
5QKB ... BRN TOFFLIN
5R52 ...#
5RJL ...#
5S4= ...OTHEROPE
5SHW ... CLOSETOP [CLOSE DIRECTORY
5T3G ...UP
5TH6 ... UP [SOMEONE ELSE HAS FILE OPEN
6J28 ...#
6J2G ...# THE FOLLOWING CODE ERASES THE WHOLE OF THE MULTIFILE TO WHICH
6J2S ...# THE CLOSEABANDONED ELEMENT BELONGS. ANY QUESTIONS REGARDING IT
6J36 ...# SHOULD BE DIRECTED TO THE OWNER OF THE USEROPEN SUBSYSTEM.
6J3D ...#
6J3Q ...MULTERASE
6J44 ... JBS NERASEMULT,1,BEERASE [IF ELEM T-B-E NO NEED TO ERASE WHOL
6J4B ... NAME 1,FILE,ENT
6J4N ... LDN 0 1
6J52 ... STO 0 EGEN(1) [OTHERWISE TURN THE ENT INTO ONE
6J5# ... [FOR THE MDF, FOR FCBFIND TO USE.
6J5L ...MDF FCBFIND 3,NOTOPEN [J IF MDF NOT OPEN TO SOMEBODY
6J5Y ... JBC WAIT,3,BFMDFOP [J IF SOMEONE OPENING OR CLOSING
6J6= ... [THE MDF
6J6C ... TRACEIF K6CLOSEAB,99,299,FLOC1(3),CLOSABMO [MULTIFILE - MDF OPEN
6J6J ... SETBIT 14,FSTREND(3) [SET THE 'ERASE MULT' BIT IN FCB.
6J6W ...#
6J78 ...# WHEN THE OPENER OF THE MDF CLOSES IT CLOSEMULT WILL INITIATE
6J7G ...# AN AUOTERASE.
6J7S ...#
6J8Q ...MULTEND2
6J97 ... MHUNTW 1,FILE,ENT
6J9J ... BRN NERASEMULT
6J=2 ...#
6J=# ...# IF THE MDF IS IN THE PROCESS OF BEING OPENED OR CLOSED,WAIT
6J=L ...# AND TRY AGAIN.
6J=Y ...#
6J?6 ...WAIT
6J?# ... COOR3 #41
6J?J ... BRN MDF
6J?W ...#
6J#8 ...# NO-ONE HAS THE MDF OPEN, SO WE OPEN IT OURSELVES, SET THE BIT,
6J#G ...# AND ISSUE AN ERASEMULT, WHICH SETS UP AN AUTERASE ACT WHICH DOES
6J#S ...# IT ALL FOR US.
6J*6 ...#
6J*D ...NOTOPEN
6J*H ... SETNCORE 6,3,FILE,FLOCNB [SET UP FLOCNB FOR MDF FROM ENT BLOCK
6J*L ... MHUNTW 2,FILE,ENT
6J*P ... LDX 0 ELAN(2)
6J*S ... STO 0 A1+5(3)
6JB5 ... TRACEIF K6CLOSEAB,99,299,ELOC1(2),CLOSABMU [MULTIFILE - MDF NOT
6JB8 ... ADN 2 ELOC1
6JB? ... ADN 3 A1
6JBK ... MOVE 2 5
6JBX ... OPENREL XBRK,GENERAL,DIROPEN [OPEN MDF - WE MUST BE ABLE TO OPEN
6JC9 ... CALL 6 TB [X2-> FCB
6JCD ... SETBIT 14,FSTREND(2) [SET THE 'ERASE WHOLE MULTIFILE' BIT
6JCM ... CALL 5 SETFAB [SET UP FABSNB FOR MDF
6JCY ... ERASEMULT [GETS RID OF MDF AND FABSNB
6JD5 ... MFREE FILE,FLOCNB
6JD= ... BRN MULTEND2 [FINISH TIDYING UP
6JG6 ...#
6JJ2 ...#
6JKW ...YINDEX
6JMQ ... GEOERR BRIEFPM,AB INDEX [ABANDON ON INDEXED FILE
6JPL ...XBRK
6JRG ... GEOERR BRIEFPM,AB BRK [BREAK-IN ON OPENDIR OR OPENREL
6JTB ...RESWRONG
6JX= ... GEOERR BRIEFPM,AB RES? [RES. NO. IN FULLB IN FILE CHAIN & FC
6J^6 #END
^^^^ ...01435657000600000000