ERASEA867
(George Source)
Macros used: ADDMODE, ALTLENG, BACKSPACE, BBS, BC, BS, BUDGERASE, BWNZ, BXGE, BXL, CLOSESHORT, CLOSETOP, DELETE, DOWN, FCBFIND, FREECORE, GEOERR, GETDIR, HUNT, INHIBITBRK, JBC, JBS, JMBS, JOBLOCK, LOGACCESS, LONGON, MBS, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, NAME, OPENDIR, OPENENDX, OPENRELD, OPENSYS, PERMITBRK, QKTABSET, QKTABULATE, READ, READAGAIN, READDICT, REPLACE, RETURNB, REWIND, REWRITE, SEG, SEGENTRY, SETMODE, SETNCORE, SETREP, SETREP2, STEP, STEPAGAIN, TESTINBRK, TESTNAMX, TESTREP, TESTREP2, TESTRPN2, TOPFCA2, TOPFCAB2, TOPFCB, TOPFCB2, TRACE, UP
- ERASEA867.txt
225X ... SEG ERASEA,8,C DONG,USERCOMS,G400 229S ...[ 22*P ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22FL ...[ 22KH ... 22PD ...#UNS G400 22T* ...[ THIS CHAPTER MODIFIED FOR G3PLUS-IH MK2 22^= [ 23DW [ 23YG SEGENTRY K1ERASEA,ZERASEND 24D6 SEGENTRY K2ERASEA,ZERASEMAC 24XQ SEGENTRY K3ERASEA,ZERASESEG 26BL [ 26W= [ THIS SEGMENT IS USED BY THE ERASE COMMAND, ERASE MACRO AND 27*W [ ERASEND MACRO. 27TG [ 28*6 [ CHECKS IF THE USER IS PERMITTED TO WRITE TO THE FILE AND IF SO, 28SQ [ THE FILE IS REMOVED FROM THE FILESTORE. WHEN THE FILE TO BE 29#B [ ERASED IS IN USE, THE TO-BE-ERASED BIT IS SET IN ITS DIRECTORY 29S2 [ ENTRY. IF IT IS A DIRECTORY, THE TO-BE-ERASED BIT IS ALSO 2=?L [ SET IN ITS ENTRY IN THE DICTIONARY. 2=R= [ IF A DIRECTORY IS TO BE ERASED, ALL THE FILES INFERIOR TO IT 2?=W [ ARE ERASED. 2?QG [ 2*9B [ AWORK2 IS AMOUNT OF ADDITIONAL WORDS FOR GLIST 2*P2 [ AWORK3 INDICATES THAT A FILE IS MARKED T.B.E. 2*YS ...[ AND MARKS COMMAND ENTRY 2B8L [ AWORK4 CONTAINS NO. OF FROZEN MULTELS UNDER A DIR. TO BE ERASED 2BN= [ 2C7W [ 2CMG MGERASE +GERASE [TO BE ERASED BIT IN DICT ENT 2D76 NC1 4HC1 2DLQ [ 2F6B [ 2FL2 [ ENTRY FOR ERASEND MACRO 2G5L [ A FABSNB NAMES THE FILE TO BE ERASED AND ITS DIRECTORY IS OPEN 2GK= [ 2H4W ZERASEND 2HJG STOZ AWORK3(2) 2J46 STOZ AWORK1(2) [NON-AUTONOMOUS 2JHQ STOZ AWORK2(2) 2K3B LDCT 7 #400 [REMEMBER TO LEAVE DIRECTORY OPEN 2KH2 MHUNTW 1,FILE,ENT 2L2L JBC SETBIT1,1,BEERASE [J IF MARKED T.B.E. 2LG= LDX 0 GSIGN 2L^W STO 0 AWORK3(2) [ALREADY MARKED T.B.E. 2MFG SETBIT1 2M^6 LDX 0 EUSE1(1) 2NDQ BZE 0 STM [TERMINAL FILE 2NYB [ 2PD2 [ TEMP DIR HAS NO DICT ENTRY, ONLY LEXICON ENTRY; SO J BIT SETTING 2PXL JBS TEMPUS,1,BETEMP [J IF TMEPORARY 2QC= LDX 0 AWORK3(2) 2QWW BNG 0 TORY [IF ALREADY MARKED NO DICT OPEN 2RBG CALL 5 OPDCT [OPEN DICT TO SET TO-BE-ERASED BIT 2RW6 BRN TORY [J TO MAIN PATH 32NW [ 338G [ THIS IS THE ENTRY FOR ERASE MACRO 33N6 [ A FABSNB NAMES THE FILE TO BE ERASED; HAVE TO OPEN DIRECTORY 347Q [ 34MB [ 3572 ZERASEMAC 35LL STOZ AWORK1(2) 366= QMERGE 36KW STOZ AWORK3(2) 375G STOZ AWORK2(2) 37K6 OPENDIR XBRK,GENERAL,QUERY,ERASING 384Q TESTRPN2 OK,XITB 38JB LDN 7 0 [DIR TO BE CLOSED IN ERASEA 3942 MHUNTW 1,FILE,ENT 39HL LDN 3 0 [TO BACKSPACE AT DEPTH 0,IF TERMINAL 3=3= JBC SETBIT2,1,BEERASE [J IF NOT MARKED T.B.E. 3=GW LDX 0 GSIGN 3?2G STO 0 AWORK3(2) 3?G6 BRN NTERM 3?^Q SETBIT2 3#FB LDX 0 EUSE1(1) 3#^2 BZE 0 NTERM [J IF TERMINAL FILE ERASURE 3*DL JBS NTERM,1,BETEMP [J IF TEMPORARY 3*Y= CALL 5 OPDCT [OPEN DICTIONARY FOR DIRECTORY ERASUR 3BCW MHUNTW 1,FILE,ENT 3BXG MAINST 3CC6 LDN 3 1 [TO BACKSPACE AT DEPTH 1,WHEN DICT OP 3CWQ NTERM LDEX 6 ECOPS(1) [GET NO OF COPIES 3DBB BZE 6 USER1 3DW2 SPABA 3F*L BACKSPACE 0(3) [ & USE IT TO RE-POSITION DIRECTORY 3FT= BCT 6 SPABA [ JUST AFTER 1ST RECORD 3G#W USER 3GSG MHUNTW 1,FILE,ENT 3H#6 USER1 3HRQ LDX 0 EUSE1(1) 3J?B BZE 0 STM [J IF TERMINAL FILE 3JR2 JBC TORY,1,BETEMP [J IF NOT TEMPORARY 3K=L BRN TEMPUS 3KQ= 3L9W 3LPG [ ENTRY FROM ERASE SEGMENT. DIRECTORY, DICTIONARY ARE OPEN. 3M96 [ 3MNQ ZERASESEG 3N8B STOZ AWORK1(2) 3NN2 STOZ AWORK2(2) 3NPY ...#UNS ILOGACC 3NRW ...( 3NTS ... LDN 0 1 3NXQ ... STO 0 AWORK3(2) [COMMAND ENTRY 3N^N ...) 3P3L ...#UNS ILOGACC 3P5J ...#SKI 3P7L STOZ AWORK3(2) 3PM= MHUNTW 1,FILE,ENT 3Q6W ... JBC USER1,1,BEERASE [J IF NOT MARKED T.B.E. 3RKQ LDX 0 GSIGN 3RNW ...#UNS ILOGACC 3RS2 ... ORS 0 AWORK3(2) [ALREADY MARKED T.B.E 3RX6 ...#UNS ILOGACC 3S2= ...#SKI 3S5B STO 0 AWORK3(2) [ALREADY MARKED T.B.E. 3SK2 LDX 0 EUSE1(1) 3T4L BZE 0 STM [J IF TERMINAL FILE 3TJ= JBS TEMPUS,1,BETEMP [J IF TMEPORARY 3W3W CLOSETOP [DICTIONARY--NO BIT-SETTING 3WHG BRN TORY 3X36 3XGQ 3Y2B TEMPUS 3YG2 ORX 7 0 [SET BIT TO REMIND US OF TEMP DIR 3Y^L ... CALL 5 TESTBRK [TEST FOR INHIBIT BREAKIN 3^F= ... BRN TOR1A [BREAKIN 45TW BRN SETLEV 46*G STM 46T6 NGN 6 1 [X6 IS -VE FOR TERMINAL FILE ERASE 46T^ ...# ************************************************** 46WS ...# THE FOLLOWING IS A FRIG TO TRAP SOMEONE OR 46XM ...# SOMETHING WHO IS ERASING :SYSTEM.INCINDEX ON THE 46YG ...# A-SERVICE 46^* ...# 4728 ... LDX 3 1 4733 ... LDX 1 FX1 473W ... TESTNAMX 3,SYSINC+3(1),ELOC1(3),NOTINC,5 [J IF NOT INCINDEX 4743 ... LDX 5 EGEN(3) 4748 ... SBN 5 1 474* ... BNZ 5 NOTINC [J IF NOT GEN 1 474G ... TESTNAMX 1,SYSINC+6(1),ELAN(3),NOTINC,5 [J IF NOT LANG B1 474P ... TOPFCB 3 475J ... TESTNAMX 3,SYSINC(1),FME1(3),NOTINC,5 [J IF NOT :SYSTEM 476C ... GEOERR BRIEFPM,INCINDER 477= ...SYSINC 28HSYSTEM INCINDEX B1 4785 ...NOTINC 478Y ... MHUNTW 1,FILE,ENT 479R ...# 47=L ...# END OF FRIG 47?F ...# ************************************************** 47?W ...#UNS ILOGACC 47?Y ...( 47#2 ... LDX 0 AWORK3(2) 47#4 ... ANDN 0 1 47#6 ... BZE 0 NOLOG 47#? ... CALL 5 XLOGAC 47#D ...NOLOG 47#K ...) 47#Q LDX 0 EAUTOCOUNT(1) 47JJ ... ORX 0 ESAVECOUNT(1) 47SB BNZ 0 SERB [J IF FILE FROZEN 48#2 LDX 0 ESER(1) 48RL BNZ 0 MAGTA [J IF A MAG TAPE ENTRY 48YS ...#UNS EXSEX2 4962 ... JBS SECUREXER,1,BEEXO [DONT OPENEMPTY SECUREXS 496W ... JBC NOTINDEXED,1,BEINDEX 497Q ... FREECORE 1 498L ... SETMODE 1,GENERAL,REPLY,LEAVE [OTHER MODES INAPPROP 499G ... BRN YINDEXED 49=B ...NOTINDEXED 49?= LDCT 3 #40 49QW ANDX 3 EINF1(1) [MDF BIT 4==G FREECORE 1 4=Q6 BZE 3 TERF [J IF NOT MDF 4?9Q CALL 5 ONLYMDF 4?PB BRN NEG [J IF MDF NOT ONLY ENT LEFT 4#92 VFRENT 4#NL FREECORE 1 [ENT 4*8= TERF 4*MW SETMODE 1,WRITE,EMPTY,REPLY,LEAVE 4*XN ...YINDEXED 4B7G ADDMODE 1,DIROPEN,ERASING,DIREPLY 4C6Q [TO LEAVE DIRENT & OPEN IN SPITE OF 4CLB [TO-BE-ERASED BIT BEING SET 4D62 [& NOT CLOSE DIRECTORY 4DKL [I DONT KNOW WHY NOWAIT; EMPTY NEVER 4DMT ...#UNS G400 4DQ4 ...( 4DS? ... ADDMODE 1,ERASE [ADDITIONAL MODE TO SET FCB 4DWG ... [TO BE ERASED BIT FOR CLOSETOP 4DYP ... [AND HOOK CODE 4F2Y ...) 4F5= OPENENDX XBRK,1 [OPEN AND EMPTY THE FILE 4FJW MFREE FILE,FLOCNB 4G4G REPS 4GJ6 TESTREP CANT,SERB [J IF ALREADY OPEN 4H3Q TESTREPN OK,RERR [GEOERR IF OTHER REPLY 4HHB CLOSESHORT 4HR8 ...SECUREXER 4J32 LDN 3 0 [ACCESS FILE AT DEPTH 0 IN NTRYD 4JGL CALL 5 NTRYD [DELETE ENTRIES IN ITS DIRECTORY 4K2= MHUNTW 1,FILE,ENT [CHEK IF MULTEL WAS JUST DELETED 4KFW BPZ 6 NEG4 [J IF NOT TERMINAL FILE ERASURE 4K^G JBC NEG4,1,BEMULT [J IF NOT MULTELEM 4LF6 [CHEK IF MULTEL JUST DELETED WAS PREVIOUSLY MARKED T.B.E.. IF NOT 4LYQ [THE MDF WILL BE ERASED BY THE ERASE SEGMENT COMING DOWN AGAIN OR 4MDB [DIRECTORY ERASURE PATH COMING THRU AGAIN. SO NO CHEK TO SEE IF 4MY2 [MDF IS LAST FILE OF SAME NAME/LANG LEFT. 4NCL JBC NEG4,1,BEERASE [J IF NOT MARKED T.B.E. 4NX= FREECORE 1 4PBW CALL 5 ONLYMDF 4PWG BRN NEG [J IF MDF NOT ONLY ENT LEFT 4QB6 [ORIGINALLY THE MDF WAS ERASED IF IT WAS THE ONLY ENTRY LEFT 4QTQ [BUT SEE USERSTRM FOR BUG 9884 NOTES--SOLO MDF'S MAY BE LEFT. 4R*B JBS ONLYENT,1,BEERASE [J IF MARKED T.B.E. 4RT2 CALL 5 XMDF 4S#L BRN NEG 4SS= ONLYENT 4T?W MHUNT 2,FILE,FABSNB 4TRG LDN 0 1 4W?6 SMO A1(2) 4WQQ STO 0 A1-2(2) [SET GEN. NO. = 1 FOR OPENENDX 4X=B BRN VFRENT [NOT TO STM--MDF NEVER FROZEN 4XQ2 NEG4 4Y9L FREECORE 1 4YP= NEG 4^8W BPZ 6 READ 4^NG XITT 5286 BNG 7 XITA [J IF ERASEND ENTRY 52MQ CLOSETOP [CLOSE SUPERIOR DIRECTORY 537B XITA 53M2 SETREP OK 574B UP 5=26 SERB 5=FQ LDX 0 AWORK3(2) 5=^B BPZ 0 TSER [J IF NOT MARKED T.B.E. 5?F2 MFREEW FILE,ENT 5?YL BRN NEG 5#D= TSER 5#XW CALL 5 TOBEB 5*CG BRN NEG 5*X6 MAGTA 5BBQ GEOERR 1,ERAS XMT 5BWB NTRYD 5CB2 SBX 5 FX1 [ROUTINE TO DELETE ALL RECORDS OF A 5CTL [ENTRY IN THE FILE OPEN AT LEVEL 0(3) 5D*= [POSITIONED ON FIRST BLOCKS REC OF TH 5DSW ADX 7 3 [PRESERVE X3 IN L.S. END OF X7 5F#G MHUNTW 1,FILE,ENT 5FS6 LDEX 4 ECOPS(1) 5G?Q ... JBC NCOPS,1,BEINDEX [ J IF NOT INDEXED 5HQL ADN 4 1 5J== NCOPS 5JPW #SKI K6ERASE>99-99 5K9G TRACE ELOC1(1),ERASE 5KP6 ADX 4 ENUSE(1) [X4 = COUNT OF RECORDS IN THIS DIRENT 5L29 ... ADN 4 1 [ ADD 1 FOR NAME RECORD 5L?# ...XSTEP 5LJC ... LDEX 3 7 [ RESTORE FILE DEPTH 5LTG ... STEP 0(3) [ STEP TO E-O-F OR NEXT NAME RECORD 5M6K ... BZE 3 XENDFILE [ J IF END OF FILE 5MCN ... LDX 0 EDESCRIBE(3) 5MNR ... BZE 0 XENDFILE [ J IF NEXT NAME RECORD 5M^W ... BRN XSTEP 5N=^ ...XENDFILE 5NJ4 ... LDEX 3 7 [ RESTORE FILE DEPTH 5NT7 ... BACKSPACE 0(3) [ THIS POINTS US TO VERY LAST RECORD 5P6G XDEL 5PL6 DELETE 0(3) 5Q5Q BCT 4 XDEL 5QKB MHUNTW 1,FILE,ENT 5R52 LDX 0 EUSE1(1) 5RJL BZE 0 TLON1 [J. IF NOT DIR 5S4= JBC TLON1,1,BETEMP [J UNLESS TEMPORARY 5SHW LDX 2 JOBNO(2) 5T3G BZE 2 TLON1 [ ENTERED AFTER EJ 5TH6 LDX 3 1 5W2Q JOBLOCK 2,0 5WGB BNG 0 TLON1 [ENTERED AFTER EJ 5X22 LDX 1 0 5XFL LDX 0 ALOGLEN(1) 5X^= SBN 0 ASTJOB 5YDW BZE 0 TLON [J IF NO USER 5YYG LDX 0 ELOC1(3) 5^D6 LDX 2 ELOC2(3) 5^XQ LDX 4 ELOC3(3) 62CB TXU 0 JNAME(1) 62X2 TXU 2 JNAME+1(1) 63BL TXU 4 JNAME+2(1) 63W= BCS TLON [J. IF NOT THE TEMPDIR. 64*W LDCT 0 #002 64TG ANDX 0 JMISC(1) 65*6 ERS 0 JMISC(1) [UNSET TD BIT IF SET 65SQ TLON 66#B LDX 1 3 [RESET X1 66S2 LDEX 3 7 [& X3 67?L TLON1 67R= LDCT 0 #700 68=W ANDX 7 0 [& X7 68QG LONGON #12,ELOC1(1) 69=6 ADX 5 FX1 69PQ EXIT 5 0 6=9B TOR1 6=P2 LDX 0 AWORK3(2) [IF T.B.E. BIT ALREADY SET 6?8L BNG 0 TOR1A [DICTIONARY NOT OPEN 6?N= CLOSETOP [CLOSE DICTIONARY 6#7W TOR1A 6#MG BNG 7 TOR2 [J IF ERASEND 6*76 CLOSETOP [CLOSE DIRECTORY 6*LQ TOR2 6F46 UP 6HG= TORY 6H^W ... CALL 5 TESTBRK [TEST FOR INHIBIT BREAKIN 6JFG ... BRN TOR1 [BREAKIN 6MC= LDX 0 AWORK3(2) 6MWW BNG 0 SETLEV [SKIP NEXT IF ALREADY MARKED T.B.E. 6NBG ... CALL 5 RDICT [READ DICTIONARY ENTRY 6Q*2 LDX 0 MGERASE(1) [SET TO-BE-ERASED BIT 6QSL ORS 0 CERASE(2) [IN THE DICTIONARY 6R#= NAME 2,FILE,FWB 6RRW REWRITE 6S?G MFREEW FILE,FWB 6SR6 CLOSETOP [CLOSE DICTIONARY 6T=Q SETLEV 6TQB LDN 6 0 [SET LEVEL=0 6W=2 MHUNTW 1,FILE,ENT 6W?Y ...#UNS ILOGACC 6W*W ...( 6WCS ... LDX 0 AWORK3(2) 6WFQ ... BNG 0 NLOGACC [J IF ALREADY TBE 6WHN ... CALL 5 XLOGAC [LOG ACCESS 6WKL ...NLOGACC 6WMJ ...) 6WPL LDX 0 EAUTOCOUNT(1) [IF FILE IS FROZEN 6W^D ... ORX 0 ESAVECOUNT(1) 6X9= BNZ 0 NOPE [DON'T TRY TO OPEN IT 6XNW SETNCORE 6,2,FILE,FLOCNB [GET LOCAL NAME OF DIRECTORY TO-BE-ER 6Y8G MHUNT 1,FILE,FABSNB 6YN6 ADX 1 HDREC(1) 6^7Q ADN 1 A1-6 6^MB ADN 2 A1 7272 MOVE 1 6 [ & MOVE IT TO FLOCNB 72LL MFREEW FILE,ENT [FREE ENT BLOCK-OPENREL (LEAVE) GETS 736= OREL 73KW SETMODE 1,GENERAL,REPLY,LEAVE,DIROPEN 745G ADDMODE 1,ERASING,QUERY,DIREPLY,ERASE 74K6 [TO LEAVE DIRENT AND MUST OPEN 754Q [AND NOT CLOSE DIRECTORY 75JB OPENRELD XBRK,1 [OPEN NEXT DIRECTORY 7642 TESTREP2 CANT,NOPE [J IF IT CANT BE OPENED 76HL TESTRPN2 OK,RERR [GEOERR IF OTHER REPLY 773= STOZ AWORK4(2) [NO FROZEN MULTELS 77GW BACKSPACE 1 [REPOSITION DIRECTORY ABOVE TO JUST A 782G [1ST RECORD (OPENREL-LEAVE MOVED IT) 78G6 READ STEP 78^Q BZE 3 TRICY [J WHEN END OF FILE 79FB LDX 0 ERES-A1(3) 79^2 BNZ 0 READ [J IF NOT A 1ST RECORD 7=DL LDN 4 0 7=Y= STOZ AWORK3(2) [FREE TO MARK INFERIORS 7?CW ... JBC NOWLAC,3,BNERASE [J IF NOT ALREADY MARKED T.B.E. 7?XG LDX 4 GSIGN 7#C6 STO 4 AWORK3(2) 7#WQ SETBIT4 7*6J ... JBS TAPE,3,BNLIB [J IF TAPE ENTRANT 7*BB LDX 0 EAUTOCOUNT-A1(3) [TEST IF FROZEN 7*L8 ... ORX 0 ESAVECOUNT-A1(3) 7*W2 BZE 0 TFTST [J IF NOT 7B*L JBC READAGAIN,3,BNMULT [J IF NOT MULTELEM 7BT= LDN 0 1 7C#W ADS 0 AWORK4(2) [ANOTHER MULTEL FROZEN 7CSG READAGAIN 7D#6 BNG 4 READ [J IF ALREADY MARKED T.B.E. 7DRQ READAGAIN 7F?B MHUNTW 1,FILE,FRB 7FR2 NAME 1,FILE,ENT 7G=L MARKMDF 7GQ= CALL 5 TOBEB [SET TO-BE-ERASED BIT IN DIRECTORY 7H9W BRN READ [J TO GET NEXT DIRENT 7H?4 ...NOWLAC 7H#= ...#UNS ILOGACC 7H*D ...( 7HBL ... JBS SETBIT4,3,BNMULT [DONT LOG MULTIFILE ELEMENTS 7HCS ... READAGAIN [NOT MULT ELEM - WANT PROPER ENT 7HF2 ... MHUNTW 1,FILE,FRB 7HG8 ... NAME 1,FILE,ENT 7HHB ... CALL 5 XLOGAC [BEFORE LOGACCESS IF APPLIC 7HJJ ... MFREEW FILE,ENT 7HKQ ... STEPAGAIN [RESET POINTER 7HLY ...) 7HN6 ... BRN SETBIT4 7HPG TFTST 7J96 HUNT 2,FILE,FLOCNB [MOVE LOCALNAME OF THE NEXT DIRECTORY 7JNQ LDX 0 ELAN-A1(3) [ INCLUDING LANG WORD 7K8B STO 0 A1+5(2) 7KN2 LDN 1 ELOC1-A1(3) [ DOWN THE TREE INTO THE FLOCNB 7L7L ADN 2 A1 7LM= MOVE 1 5 7M6W LDX 0 EUSE1-A1(3) 7MLG BZE 0 TERMF [TERMINAL FILE 7N66 ADN 6 1 [ADD 1 TO LEVEL 7NKQ BRN OREL [J TO OPEN NEXT DIRECTORY 7P5B NOPE 7PK2 LDX 0 AWORK3(2) 7Q4L BPZ 0 TOB [J IF NOT MARKED T.B.E. 7QJ= MFREEW FILE,ENT 7R3W BRN VELEV 7RHG TOB 7S36 CALL 5 TOBEB 7SGQ VELEV BNZ 6 VCONT 7SQJ ... MFREE FILE,FLOCNB 7T2B BBS 2,7,XITT [J IF WE HAVE NOT INHIBITED BRK-IN 7TG2 PERMITBRK [MK2**** ALLOW FOR BREAK IN 7T^L BRN XITT 7WF= VCONT SBN 6 1 [SUBTRACT 1 FROM LEVEL 7WYW BRN READ [READ NEXT DIRENT 7XDG TERMF 7XY6 ...#UNS EXSEX2 7YCQ ... JBS SECUREX1,3,BNEXO [DONT OPENEMPTY SECUREXS 7YXB JBC TERM1,3,BNMDF [J IF NOT MDF 7^C2 LDX 2 FX2 7^WL LDX 0 AWORK4(2) 82B= BZE 0 TERM1 [J IF NO PREVIOUS FROZEN MULTELS 82TW CALL 5 ONLYMDF 83*G BRN MDFMARK [J IF MDF NOT ONLY ENTRY LEFT 83T6 FREECORE 1 [ENT 84#Q BRN TERM1 [J TO ERASE/DELETE MDF 84SB MDFMARK 85#2 GETDIR 3 [RE-POSITIONS READING POINTERS 85RL [ AT HAVING JUST READ NAME RECORD OF THE MDF. ALSO GIVES ENT 86?= BRN MARKMDF [USE THIS ENT FOR REWRITE 86#^ ...#UNS EXSEX2 86BN ...( 86DC ...SECUREX1 86G6 ... READAGAIN 86HT ... MHUNTW 3,FILE,FRB 86KJ ... NAME 3,FILE,ENT 86M? ... BRN SECUREXER 86P2 ...) 86QW TAPE 87=G [ 87Q6 [ IF TAPE ALREADY MARKED TO BE RETURNED,DONT RETURN AGAIN-BUG 6418 889Q [ 88PB JBS READ,3,BNERASE [J IF MARKED T.B.E. 8992 MHUNTW 1,FILE,ENT 89NL JBS READ,1,BEINFPROC [J IF INFERIORS BEING PROCESSED 8=8= [MEANS MAG TAPES BEING RETURNED OR DIRECTORY WITH MAG TAPES BEING 8=MW [RETURNED. RETURNB GOES AUTONOMOUS AND MAY NOT MARK TO-BE-RETURNED BIT 8?7G [BEFORE ERASEND MACRO DONE AGAIN BY CLOSE. 8?C# ... LDX 5 ESERN(3) 8?M6 LDX 0 ESER(1) [PICK UP MAGTAPE MARKER FROM DIRENT 8#6Q BNZ 0 XFIRST [J UNLESS FIRST MAG. TAPE IN THIS DIR 8#LB STO 5 ESER(1) 8*62 SETNCORE 4,2,FILE,FABSNB 8*KL LDN 0 4 8B5= STO 0 A1(2) 8BJW MHUNTW 1,FILE,ENT [FOR SUPERIOR DIR 8C4G ADN 1 EUSE1 8CJ6 ADN 2 A1+1 8D3Q MOVE 1 3 [FABSNB NAMES DIRECTORY FOR RETURN 8DHB SETNCORE 5,3,AONBS,GLIST 8F32 LDN 0 1 [MAY AS WELL USE THE 3 EXTRA 8FGL STO 0 A1(3) [WORDS - LEST THERE BE MORE MTS. 8G2= STOZ A1+2(3) 8GFW STOZ A1+3(3) 8G^G STOZ A1+4(3) 8HF6 SERIN 8HYQ SMO A1(3) 8JDB STO 5 A1(3) [INSERT SERIAL NUMBER 8JY2 BRN READ 8KCL XFIRST 8KX= MHUNTW 3,AONBS,GLIST 8LBW LDN 0 1 8LWG ADX 0 A1(3) 8MB6 STO 0 A1(3) [INCREMENT REC. HEADER 8MTQ BXL 0 ALOGLEN(3),SERIN [J IF NO ALTLEN NEEDED 8N*B LDX 2 FX2 8NT2 LDN 1 16 8P#L ADS 1 AWORK2(2) 8PS= ADX 0 AWORK2(2) 8Q?W STO 0 ACOMMUNE1(2) 8QRG ALTLENG 3,ACOMMUNE1(2),REALTGLIST 8R?6 MHUNTW 3,AONBS,GLIST 8RQQ BRN SERIN 8S=B TERM1 8S#^ ... JBC SETMODES,3,BNINDEX [ J IF NOT INDEXED 8SCJ ... LDCT 1 #777 8SG7 ... ANDX 1 ECOPS-A1(3) [ IF INDEXED SHOULD BE EMPTY 8SJQ ... BZE 1 XNOBLOX [ J IF FILE EMPTY 8SM* ... GEOERR 1,INDEXED 8SPY ...XNOBLOX 8SSH ... SETMODE 1,DIROPEN,ERASING,GENERAL,REPLY,LEAVE 8SX6 ... BRN OPENEMPTY 8S^P ...SETMODES 8T4# ... SETMODE 1,DIROPEN,ERASING,WRITE,REPLY,EMPTY,LEAVE 8T6X ...OPENEMPTY 8T9L OPENRELD XBRK,1 [OPEN AND EMPTY THE FILE 8TP= BRN REPS 8W8W TRICY REWIND 8WNG MHUNTW 1,FILE,ENT [FOR DIR 8X86 LDX 0 ESER(1) 8XMQ BZE 0 NOMTS [J IF NONE 8Y7B STOZ ESER(1) 8YM2 RETURNB 8^6L NOMTS 8^L= STEP 925W BZE 3 MPTY [J IF TOP DIRECTORY IS NOW EMPTY 92KG MHUNTW 1,FILE,ENT [REWRITE DIRECTORY ENTRY WITH 9356 MBS 1,BEERASE,BEINFPROC [T.B.E. & INFERIORS BEING PROCESSED 93JQ NAME 1,FILE,FWB 944B [ CLOSE WILL UPDATE BLOCKS/INDEX RECORDS 94J2 #SKI 953L LDN 4 0 95H= REWRITE 1 962W #SKI 96GG ( 9726 BZE 4 NOCOP [J IF NO BLOCKS RECORD 97FQ STEP 1 [THE BLOCKS RECORD MUST BE UPDATED 97^B TOPFCB2 2 [FROM THE FCB 98F2 MHUNTW 3,FILE,FWB 98YL LDX 4 HDREC(2) 99D= SBN 4 FBLKS-A1-2 99XW STO 4 A1(3) [SET RECORD HEADER 9=CG LDX 0 ALOGLEN(3) 9=X6 BXGE 0 4,OKLN 9?BQ ALTLENG 3,4,REALTFWB 9?WB TOPFCB2 2 9#B2 MHUNTW 3,FILE,FWB 9#TL OKLN 9**= LDX 1 A1(3) 9*SW ADN 2 BSPRE 9B#G ADN 3 A1+1 9BS6 MOVE 2 511(1) [MOVE BLOCK NOS ACROSS 9C?Q REPLACE 1 9CRB NOCOP 9D?2 ) 9DQL CLOSETOP [DIR--CAREFUL UPDATING FOR CLOSE 9F== MFREEW FILE,FWB 9FPW BRN VELEV 9G9G MPTY CLOSESHORT 9GP6 BBS 1,7,ONLYLEX [NO DICT.ENTRY FOR A TEMP.DIR 9H8Q CALL 5 OPDCT 9J82 ONLYLEX 9JML ... DOWN ERASE,11 [REMOVE LEXICON ENTRY 9TDW BBS 1,7,NODENT [J IF TEMP.DIR 9TYG ... CALL 5 RDICT [READ DICTIONARY ENTRY 9WD6 ... LDX 0 CPSEU(2) 9XX2 BNG 0 PSEU1 [J IF PSEUDO USER 9YBL BUDGERASE 9YW= MFREEW FILE,ADICTENT 9^*W ... CALL 5 RDICT =3#B PSEU1 =3S2 ... FREECORE 2 [FREE ADICTENT =4?L DELETE [DELETE THIS USER'S ENTRY IN DICT =4R= CLOSETOP [CLOSE DICTIONARY =5=W NODENT =5QG LDN 3 0 [ACCESS FILE AT DEPTH 0 IN NTRYD =6=6 CALL 5 NTRYD [DELETE FILE'S ENTRIES IN ITS DIRECTO =6=P ...#UNS FNSAD =6?# ...( =6?X ... BNZ 6 TEMPDIRECT [J IF NOT TOP LEVEL OF ERASE JUST DON =6#G ... BBS 1,7,TEMPDIRECT [AND IF TEMPORARY DIR =6*5 ... TOPFCA2 3 [X3-> FCA OF SUP DIR =6*N ... QKTABSET 3,AWORK2(2),AWORK3(2) [SAVE DIR POSN IN CASE ERASE MACRO =6B? ... REWIND =6BW ...SCANDIR =6CF ... STEP =6D4 ... BZE 3 SCANEND [J IF REACHED END OF SUP DIR =6DM ... BWNZ ERESN(3),SCANDIR =6F= ... BWNZ EUSE1N(3),YDIRIN [J IF STILL AN INFERIOR =6FT ... BRN SCANDIR =6GD ...SCANEND =6H3 ... TOPFCAB2 3,2 =6HL ... BS 2,BFDIRUPDATE [SINCE NO LONGER AN INFERIOR TAKE =6J9 ... BC 2,BFDIRBELOW [OUT INFERIOR BIT =6JS ... BRN SCANFIN =6KC ...YDIRIN =6L2 ... TOPFCA2 3 =6LK ...SCANFIN =6M8 ... LDX 2 FX2 =6MR ... QKTABULATE 3,AWORK2(2),AWORK3(2) =6NB ...TEMPDIRECT =6N^ ...) =6PQ MFREEW FILE,ENT =79B BRN VELEV =7P2 [ =88L [ =8N= [ V A R I O U S R O U T I N E S =97W [ =9MG [ ==76 [ CHECKS IF THE MDF ENTRY IN A DIRECTORY IS THE ONLY FILE ==LQ [ OF A MULTIFILE LEFT =?6B ONLYMDF =?L2 SBX 5 FX1 =#5L MHUNT 1,FILE,FLOCNB =#K= LDX 4 A1+4(1) [SAVE ORIGINAL GENERATION NO. =*4W STOZ A1+4(1) [ASK FOR ANY GENERATION =*JG [ INSTEAD OF GET HIGHEST GEN. NO.. THE FORMER WILL GET THE FIRST =B46 [ GEN. NO. FOUND OF THE GIVEN NAME/LANG. CODE. BUT WITH PRESENT =BHQ [ INDEXING THE FIRST GEN. NO. WILL BE THE HIGHEST =C3B [ GET HIGHEST GEN. NO. WILL FIND THE HIGHEST GEN. NO. OF GIVEN NAME =CH2 [ AND THEN SEARCH FOR LANGUAGE CODE GIVEN. =D2L GETDIR 6 [LIKE GETDIR 3 BUT FOR MULTIFILES =DG= TESTREP2 OK,XENTOK =D^W GEOERR 1,MDFENT? =FFG XENTOK =F^6 MHUNTW 1,FILE,ENT =GDQ JMBS MULTI,1,BEMDF,BEMULT [J IF MULTIFILE =GYB GEOERR 1,FILEMIXD [SINGLE/MULTIFILE OF SAME NAME/LANG. =HD2 MULTI =HXL SLL 0 3 [MDF BIT =JC= ADX 5 FX1 =JWW BPZ 0 XMDF [J IF NOT MDF =KBG [USE THIS FLOCNB SINCE IT ALREADY HAS GEN. NO. = 1 =KW6 EXIT 5 1 =L*Q XMDF =LTB FREECORE 1 [ENT =M*2 MHUNT 1,FILE,FLOCNB =MSL STO 4 A1+4(1) [RESTORE ORIGINAL GEN. NO. GIVEN =N#= EXIT 5 0 =NRW [ =P?G [ =PR6 OPDCT SBX 5 FX1 [ROUTINE FOR OPENING DICTIONARY =Q=Q ... OPENSYS XBRK,DICTIONARY,GENERAL [OPEN DICTIONARY =SNW TESTRPN2 OK,RERR =TN6 ADX 5 FX1 =W7Q EXIT 5 0 =WMB ...[ ROUTINE TO SET UP FILE/ADICT BLOCK AND READ DICTIONARY ENTRY =X72 ...RDICT SBX 5 FX1 =XLL SETNCORE 3,2,FILE,ADICT =Y6= ADN 2 A1 =YKW MHUNTW 1,FILE,ENT [MOVE USERNAME TO ADICT BLOCK =^5G ADN 1 EUSE1 =^K6 MOVE 1 3 =^P3 ... READDICT =^SY ... TESTRPN2 OK,RERR =^YT ... MHUNTW 2,FILE,ADICTENT ?24Q ADX 5 FX1 ?2JB EXIT 5 0 ?342 [ ?3HL [ ?43= TOBEB SBX 5 FX1 [ROUTINE TO SET TO-BE-ERASED BIT IN ?477 ... FCBFIND 2,NOTFCB ?4?4 ... BS 2,BFERASE ?4B^ ...NOTFCB ?4GW MHUNTW 1,FILE,ENT [TOP FILE WHICH HAS JUST READ DIRENT ?52G BS 1,BEERASE [SET T.B.E. BIT ?5G6 NAME 1,FILE,FWB ?5^Q REWRITE ?6FB MFREEW FILE,FWB ?6^2 ADX 5 FX1 ?7DL EXIT 5 0 ?7Y= XITB ?8CW SETREP2 NOFILE ?8XG #SKI ?9C6 ( ?9WQ LDX 0 AWORK1(2) ?=BB BNG 0 QSUICIDE [J.IF SUICIDE BIT SET ?=W2 ) ??*L UP ??BH ...TESTBRK ??CD ... LDX 2 FX2 ??D* ... LDCH 0 ATYPE(2) ??F= ... SBN 0 CPAT/64 ??G7 ... BNZ 0 NCPAT ??H4 ... TESTINBRK NCPAT ??H^ ... INHIBITBRK YBRK ??JW ... BRN YEXIT ??KR ...NCPAT ??LN ... LDCT 0 #100 ??MK ... ORX 7 0 ??NG ...YEXIT ??PC ... EXIT 5 1 ??Q# ...YBRK ??R9 ... EXIT 5 0 ??S6 ... ??T= XBRK GEOERR 1,ERASEBRK [BREAKIN NOT ALLOWED ?##W RERR GEOERR 1,ERASEREP ?DPG REALTGLIST ?F96 MHUNTW 2,AONBS,GLIST ?FNQ EXIT 1 0 ?G8B REALTFWB ?GN2 MHUNTW 2,FILE,FWB ?H7L EXIT 1 0 ?WCN ...#UNS ILOGACC ?WDB ...( ?WF4 ...[ ?WFQ ...[ THIS ROUTINE CONTAINS THE LOGACCESS MACRO. ON ENTRY ?WGD ...[ X1 POINTS TO FILE/ENT AND X5 IS LINK ACCUMULATOR. ON EXIT ?WH6 ...[ X0 IS DESTROYED, X1 STILL POINTS TO ENT, X2 = FX2 ?WHS ...[ X3 - X7 UNCHANGED. ACCESS WILL HAVE BEEN LOGGED IF APPROP. ?WJG ...[ ?WK8 ...XLOGAC ?WKW ... JBS XLAEXIT,1,BETEMP [DONT LOG TEMPORARY FILES ?WLJ ... LDN 2 4 [ERASE = CODE 4 ?WM= ... JBC XDOLA,1,BEEXO ?WMY ... LDN 2 5 [CC SX = CODE 5 ?WNL ...XDOLA ?WP# ... SBX 5 FX1 ?WQ2 ... LOGACCESS 0(2) [LOG THIS ACCESS IF APPLIC ?WQN ... ADX 5 FX1 ?WRB ... MHUNTW 1,FILE,ENT ?WS4 ...XLAEXIT ?WSQ ... EXIT 5 0 ?WTD ...) ?WWL [ ?XB= [ ?XTW ... MENDAREA 20,K99ERASEA ?YT6 #END ^^^^ ...06430711000200000000