CLOSEAB863
(George Source)
Macros used: BACKSPACE, BC, BITDEFS, BS, BXE, BXU, CHAIN, CLOSETOP, COOR3, DELETE, ERASEMULT, FCBFIND, FREEBAX, FREECORE, FULLBPAS, GEOERR, JBC, JBCC, JBS, JMBS, MBS, MFREE, MFREEW, MHUNTW, NAME, OPENDIR, OPENREL, RERING, REWRITE, SEG, SEGENTRY, SETBIT, SETNCORE, SETUPCORE, SFCAB, STEP, TOPFCB, TRACEIF, UP, UPPLUS
- CLOSEAB863.txt
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