ERASE867
(George Source)
Macros used: ALTLENG, BBS, BS, BXGE, BXL, CLOSE, CLOSETOP, DICTJOB, DOWN, ENDCOM, ERASEND, ERROR, FCJOB, FNORM, FPUT, FREELEX, FREETAB, FSHENTRY, GEOERR, GETACT, GETDIR, HUNT, HUNT2B, JBC, JBS, JMBS, LINKSET, LOCK, MENDAREA, MFREE, MFREEW, MHUNT, MHUNTW, NAME, NAMETOP, OPENDIR, OPENSYS, OUTNUM, PAIR, POP, REPERR2, REWRITE, SEG, SEGENTRY, SETNCORE, SETUPTAB, SPRIVJUMP, SUICIDE, TABSET, TABULATE, TESTERR, TESTREP, TESTREP2, TESTRPN2, TESTTRAP, TOPFCB, TRACE, TREP2, UNIFREE, UNLOCK, UP, USEROPEN, VFREE, VOP
- ERASE867.txt
22FL ... SEG ERASE,860,FILESTORE,USERCOMS 22^= [ 2394 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983 23DW [ 23YG SEGENTRY K1ERASE,ZENTRY 24D6 SEGENTRY K2ERASE,ZERASTREM 24XQ SEGENTRY K3ERASE,ZAUTOENT 254Y ...#UNS EXSEX2 257H ... SEGENTRY K5ERASE,ZCCSECUREX 25=6 ...[ 25#P ... FSHENTRY K7ERASE,ZENTFROMB,,ZENTFROMB 25CB [ 25M8 ... SEGENTRY K11ERASE,XLEXICON 25X2 [ 26BL [THIS SEGMENT IS USED BY THE ERASE COMMAND, ERASTREM MACRO & BSA. 26W= [IT CHECKS FORMAT OF PARAMETERS. IF FILE IS DIRECTORY, WHETHER 27*W [JOBS ARE RUNNING OR THERE ARE INFERIOR NON-PSEUDO USERS (DICTJOB 27TG [MACRO). A MULTIFILE IS ERASED ONLY IF THE MDF IS A PARAMETER OF 28*6 [ THE ERASE COMMAND. 28SQ [USED TO CHECK FOR OWNERSHIP & RECENTLY FOR WRITE TRAP (OPTIONALLY) 29#B [NOW USEROPEN CHECKS FOR ERASE TRAP. OWNERSHIP CHECK WHEN ERASING A DIR 29S2 [THE MAXIMUM NUMBER OF PARAMETERS FOR THE ERASE COMMAND IS 24. 2=?L [IF ALL OK GOES DOWN TO ERASEA TO ERASE THE FILE. 2=R= [ 2?=W [ 2?QG [THIS IS THE COMMAND ENTRY 2#=6 [ 2#PQ [ 2*9B [ THIS SEGMENT CONTAINS THE LESS DUMPER FREEZING ENHANCEMENT 2*P2 [ WHICH OUTPUTS THE NEW MESSAGE OF THE NO. OF UNACCOUNTED JOBS 2B8L ZENTRY 2B*S ...#UNS EXSEX2 2BH2 ...( 2BN8 ... STOZ AWORK3(2) [=0 => NORMAL ERASE 2BTB ...X1X5MERGE [ERASE + CC SECUREX COMMANDS MERGE 2C2J ...) 2C39 ...ZENTFROMB 2C7W STOZ AWORK1(2) [SWITCH FOR NON-1ST PARAMETER 2CMG LDN 0 25 2D76 STO 0 AWORK2(2) [MAXIMUM NUMBER OF PARAMETERS - 1 2DLQ NAGAIN [MULTI-PARAMETER LOOP 2DWJ ... LDN 6 0 [ CLEAR TEMPDIR MARKER 2F6B SPARAPASS 2FL2 HUNT 1,CPB,CUNI 2G5L ... LDX 0 ANUM(1) 2GK= LDX 4 AWORK1(2) 2H4W BPZ 0 NGOING [PARAMETER EXISTS 2HJG BNZ 4 NO [PREVIOUS PARAMETER WAS LAST 2J46 BRN NO1 [NO PREVIOUS PARAMETERS 2JHQ NGOING 2K3B BXL 4 AWORK2(2),NGOES 2KH2 ERROR JTOOMANY [TOO MANY PARAMETERS 2L2L BRN NO 2LG= NGOES 2L^W LDN 3 1 2MFG ADS 3 AWORK1(2) 2M^6 BNZ 0 NGONE [NON-NULL PARAMETER 2NDQ ERROR JPARNULL 2NYB BRN NUNI 2PD2 NGONE 2PXL NAMETOP 1,FILE,FNAME 2Q2Q ...#UNS FTS1 2Q5W ... FNORM 3 2Q92 ...#UNS FTS1 2Q#6 ...#SKI 2QC= FNORM 2 [SET UP A FABSNB FOR FILE 2QWW MHUNT 2,FILE,FNAME 2RBG NAMETOP 2,CPB,CUNI 2RW6 TESTREP NAMEFORM,NUNI [ERROR IN FILENAME 2RY4 ...#UNS EXSEX2 2S22 ...( 2S3Y ... MHUNT 3,FILE,FABSNB 2S5W ... SMO FX2 2S7S ... LDX 0 AWORK3 2S9Q ... ORS 0 ATYPE(3) [IF CC SECUREX COM SET SECUREX BIT 2S?N ...) 2TSL USEROPEN XBRK,GENERAL,DIR,STREAMS,ERASE,TERMDIR 2W#= TESTREP2 NOFILE,PTEMP 2WRW REPERR2 OK 2X?G STUP BRN NFAB 2XR6 [ 2Y=Q OK 2YQB TREP2 MULTFILE,NFAB [IF OK/MULTFILE REPS, MULT IS ERASED 2^=2 MHUNTW 3,FILE,ENT 2^PL JBC TYPEFILE,3,BEMULT [CANT ERASE ELEMENT OF MULTIFILE 329= ERROR ERELEM 32NW BRN UHUH 338G TYPEFILE 33N6 JBC NOTWORK,3,BEWORK [J IF NOT WORKFILE 347Q ERASEWOR 34MB BRN NENT 3572 NOTWORK 35LL LDX 0 EUSE1(3) 366= BZE 0 OKOWN [NO OWNERCHECK IF NOT DIRECTORY 36KW OWNERCHECK [CHECK THAT THE FILE IS OWNED BY 36TN ... MHUNTW 3,FILE,ENT 375G TESTREP2 OK,OKOWN 37K6 ERROR ERNOTOWNER 384Q BRN UHUH 38JB OKOWN 3942 JBC NOTEMP,3,BETEMP [J IF NOT TEMPORARY 39HL LDX 0 EUSE1(3) 3=3= BNZ 0 NOTFILE [J IF NOT TEMP FILE 3=GW #SKI 3?2G ( 3?G6 FCJOB 1,FX2,,CPA 3?^Q SPRIVJUMP JSSTART,1,NOTEMP 3#FB ) 3#^2 ERROR ERTEMPFILE 3*DL BRN UHUH 3*Y= NOTFILE 3BCW LDX 6 GSIGN [TEMPDIR 3BXG NOTEMP 3CC6 #SKI 3CWQ ( 3DBB SEGENTRY K50ERASE 3DW2 BRN K51ERASE 3F*L SETUPTAB 3FT= TABSET [RECALL POSN (AFTER NAME REC) 3G#W CHECKTRAPS [CHECKS FOR WRITE TRAP 3GSG TESTTRAP WRITE 3H#6 TESTREP2 OKAY,OKTRAP 3HRQ ERROR ERNOTRAP 3J?B BRN UHUH 3JR2 OKTRAP 3K=L TABULATE [BACK TO POSN AFTER NAME REC 3KQ= FREETAB 3L9W SEGENTRY K51ERASE 3LPG ) 3M96 NOST 3MNQ MHUNTW 1,FILE,ENT 3N8B LDX 0 EUSE1(1) [TEST IF DIRECTORY IS BEING ERASED 3NN2 BZE 0 NOTDI [J IF NOT 3P7L BNG 6 NOTDI [J IF TEMP DIR, DONT OPEN DICT 3PM= SETNCORE 3,2,FILE,ADICT [SET UP FILE/ADICT 3Q6W ADN 2 A1 3QLG MHUNTW 1,FILE,ENT 3QNP ... JBC NOJL,1,BEJOB4ASTR 3QQY ... ERROR ERJOBL 3QT7 ... BRN UHUH 3QXB ...NOJL 3Q^K ... MHUNTW 1,FILE,ENT 3R3S ... 3R66 ADN 1 EUSE1 3RKQ MOVE 1 3 3S5B DICTJOB 3 [THE OLD JOBQCHEC MACRO 3SK2 TESTREPN INFJOB,NOTINFJOB 3T4L SMO FX2 3TJ= LDX 0 ACOMMUNE1 [ NO. OF OUTSTANDING JOBS 3W3W OUTNUM 0,0 [ OUTPUT AS A DECIMAL CHARACTER 3WHG ERROR ERINFJOB1 [ OUTPUT ERROR MESSAGE 3X36 BRN UHUH [ GO CLEAN UP 3XGQ NOTINFJOB 3Y2B TESTERR TOOHIGH,UHUH 3YG2 NOTDI 3Y^L LDN 7 0 [SO DIR WILL BE CLOSED IN ERASEA 3^F= BPZ 6 NDOWN 3^YW FCJOB 1,FX2,,CPA 42DG LDCT 0 #2 42Y6 ORS 0 JMISC(1) 43CQ ERS 0 JMISC(1) [TAKE OUT BIT 7 43XB [ MEANS TEMPORARY DIRECTORY DOES NOT EXIST-- USED IN USERLIB ALSO 44C2 NDOWN 44WL DOWN ERASEA,3 45B= BRN NFAB 45TW NO1 ERROR JPARMIS 46*G NO 46T6 ENDCOM 47#Q PTEMP 47SB ERROR ERNOFILE 48#2 BRN NFAB 48RL [ 49?= [JOBQCHEC CLOSES DICTIONARY IN ERROR CASES FOR EFFICIENCY 49QW [ 4==G UHUH CLOSETOP [CLOSE DIRECTORY 4=Q6 NENT MFREEW FILE,ENT 4?9Q NFAB MFREE FILE,FABSNB 4?PB NUNI UNIFREE 4?WJ ...#UNS FTS1 4#3Q ... VFREE FILE,ADJUNCTS 4#92 BRN NAGAIN 4#NL XBRK 4*8= GEOERR 1,ERASEBRK [CANT BREAK IN ON ERASE 4*9D ...#UNS EXSEX2 4*=L ...( 4*?S ...[ 4**2 ...[THIS IS THE ENTRY FOR THE CC SECUREX COMMAND. IT IS IDENTICAL TO ERASE 4*B8 ...[EXCEPT THAT B21 IS SET IN THE FABSNB BEFORE USEROPENING TO SHOW THAT 4*CB ...[ONLY SECUREX ENTRANTS ARE ACCEPTABLE 4*DJ ...[ 4*FQ ...ZCCSECUREX 4*GY ... LDN 0 4 4*J6 ... STO 0 AWORK3(2) [SET FLAG 4*K# ... BRN X1X5MERGE 4*LG ...) 4*MW 4B7G 4BM6 [ 4C6Q [THIS IS THE ENTRY FOR ERASTREM MACRO - USED FOR ALL MULTIFILE 4CLB [ERASURES. SETS UP AUTONOMOUS ACTIVITY WHICH ENTERS K3ERASE 4D62 [OHGN = OLD HIGHEST GENERATION NUMBER (TRUE END OF THE MULTIFILE) 4DKL [NHGN = NEW HIGHEST GENERATION NUMBER (CURRENT END OF THE MULTIFILE) 4F5= [ 4FJW [ 4G4G ZERASTREM 4GJ6 LDN 3 0 [N.H.G.N. - 1 4H3Q TOPFCB 2 4HHB [ 4J32 [IF B14=1 WHOLE MULTIFILE IS ERASED; X3 = NHGN, X5 = OHGN 4JGL LDX 5 FSTREND(2) 4K2= SLC 5 9 4KFW ANDN 5 #377 4K^G BBS 14,FSTREND(2),TERB1 4LF6 LDEX 3 FSTREND(2) 4LYQ LDX 0 3 4MDB SRC 0 9 4MY2 ERX 0 FSTREND(2) 4NCL LDCT 1 #377 4NX= ANDX 0 1 4PBW ERS 0 FSTREND(2) [OHGN := NHGN 4PWG BXL 3 5,TERB1 [IF NHGN .GE. OHGN, NO ERASE 4QB6 MFREE FILE,FABSNB 4QTQ CLOSE [MDF 4R*B ... BRN ZERMULTUP 4RT2 [ 4S#L TERB1 4SS= MHUNT 1,FILE,FABSNB 4T?W SMO A1(1) 4TRG STO 5 A1-2(1) [STORE OHGN 4W?6 GETACT BSA,AUTERASE 4WQQ LINKSET BPTR(2),TLINK3(1) 4X=B SMO BPTR(2) 4XQ2 STO 3 ACC3 [SAVE NHGN - 1 4Y9L LOCK BPTR(2) 4YP= LDX 4 BPTR(2) 4^8W CHANGESTR 4 4^NG UNLOCK 4 5286 LDX 2 4 52MQ FPUT 52PF ...ZERMULTUP 537B UP [AUTO-BSA LEFT TO PROCEED 53M2 [ 546L TLINK3 54L= PAIR ERASE,3 555W [ 55KG [ 5656 ZAUTOENT [AUTO-BSA ENTERS HERE 56JQ OPENDIR XBK,GENERAL,QUERY [OPEN DIR OF ELEMENT WITH OHGN 574B TESTREP2 OK,OK1,NOFILE,NOFIL,NAME,NODIR 57J2 [ OK=>GO ERASE ELEM, NOFILE=>TRY NEXT ELEM, NAME=>DIR DOES NOT EXIST 583L XBK 58H= CALL 4 XBRK 592W NOFIL 59GG MHUNT 1,FILE,FABSNB 5=26 SMO A1(1) 5=FQ BXL 3 A1-2(1),NADD [IF OHGN=NHGN, NO MORE ELEMS 5=^B NODIR 5?F2 CLOSETOP [THE MDF 5?YL BRN SUICIDE 5#D= NADD 5#XW LDN 5 1 [DECREASE GEN. N. & TRY 5*CG SMO A1(1) [NEXT ELEMENT 5*X6 SBS 5 A1-2(1) 5BBQ BRN ZAUTOENT 5BWB [ 5CB2 5CTL OK1 [OK TO ERASE THE MULTIFILE 5D*= SETNCORE 6,2,FILE,FLOCNB [A FLOCNB IS REQ'D THE FIRST TIME 5DSW LDN 7 0 [FIRST TIME 5F#G REND 5FS6 MHUNT 2,FILE,FLOCNB 5G?Q MHUNT 1,FILE,FABSNB 5GRB BNZ 7 NOT1 [J UNLESS FIRST TIME 5H?2 SMO A1(1) 5HQL LDN 4 A1-6(1) 5J== LDN 5 A1(2) 5JPW MOVE 4 6 [PUTS NAME FROM FABSNB TO FLOCNB 5K9G [ 5KP6 [X3 HAS NHGN-1 & A1-2 OF FABSNB HAS OHGN 5L8Q [ 5LNB LDN 7 1 5M82 BRN NOT2 5MML NOT1 5N7= SMO A1(1) [DECREASE OHGN 5NLW SBS 7 A1-2(1) 5P6G SBS 7 A1+4(2) 5PL6 NOT2 5Q5Q BXGE 3 A1+4(2),SDX [J IF ALL ELEMS DOWN TO X3 ERASED 5QKB #SKI K6ERASE>599-599 5R52 TRACE A1+4(2),ERASELEM 5RJL LDX 0 A1+4(2) [GET GENERATION NUMBER 5S4= SBN 0 1 5SHW BNZ 0 MULTELEM [J IF NOT MDF 5T3G STOZ A1+4(2) [GET ANY GEN. NO. 5TH6 GETDIR 6 5W2Q [ GETDIR 6 INSTEAD OF GETDIR 3 BECAUSE THE LATTER WILL ALWAYS GET 5WGB [ GEN. NO. = 1 WHEN MULTIFILE CASE 5X22 TESTREP2 OK,TYPENT 5XFL CALL 4 SDV 5X^= TYPENT 5YDW MHUNTW 2,FILE,ENT 5YYG JMBS MULTENT,2,BEMDF,BEMULT [J IF MDF OR MULTEL 5^D6 GEOERR 1,MIXFILES [THERE IS AN ENTRY FOR A SINGLE FILE 5^XQ MULTENT 62CB JBS RAND,2,BEMDF [MDF IS ONLY ENT LEFT, ERASE IT 62X2 MFREEW FILE,ENT [MULTELEM ENT 63BL MHUNT 2,FILE,FLOCNB 63W= STO 7 A1+4(2) [GENERATION NO. = 1 64*W LDX 6 GSIGN [MARK: DO NOT ERASE MDF, JUST MARK IT 64TG MULTELEM 65*6 GETDIR 3 [GET ENTRY WITH OHGN GIVEN 65SQ TESTREP2 OK,RAND 66#B ... BRN REND 67R= SDV 68=W GEOERR 1,MDFENT? 68QG [ 69=6 RAND 69PQ BNG 6 SETMDF 6=9B ERASEND 6=P2 BRN REND 6?8L SETMDF [REWRITE DIR ENT OF MDF 6?N= MHUNTW 2,FILE,ENT [WITH 'TO-BE-ERASED' BIT 6#7W BS 2,BEERASE 6#MG NAME 2,FILE,FWB [SEE ERASEA FOR STORY ON HOW MDF 6*76 REWRITE [GETS ERASED 6*LQ MFREEW FILE,FWB 6B6B [ 6BL2 SDX 6C5L CLOSE [DIRECTORY 6CK= CLOSE [MDF 6D4W MFREE FILE,FLOCNB 6DJG SUICIDE 6F46 SUICIDE 6FHQ [ 6FJ5 ...[ THE FOLLOWING SECTION IS AN OVERFLOW FROM ERASEA SEGMENT. IT 6FJD ...[ CONTAINS THE CODE FOR REMOVING AN ENTRY FROM LEXICON. 6FJR ...[ 6FK6 ...XLEXICON 6FKF ... SETNCORE 4,2,FILE,ASELFLEX [FOR FREELEX 6FKS ... ADN 2 A1 6FL7 ... MHUNTW 1,FILE,ENT 6FLG ... ADN 1 EUSE1 6FLT ... MOVE 1 3 6FM8 ... STOZ 3(2) [WE DO NOT KNOW WHERE ITS SUP. IS 6FMH ... OPENSYS XBRK,LEXICON,WRITE [OPEN THE LEXICON 6FMW ... TESTRPN2 OK,RERR 6FN9 ...XBFERUS 6FNJ ... JBS XFERUSLN,,BFERUS [J IF DUMPER IN PROGRESS 6FNX ...XFREELEX 6FP= ... FREELEX [GET RID OF LEXICON ENTRY 6FPK ... CLOSETOP [LEXICON 6FPY ... UP [BACK UP TO ERASEA 6FQ? ...XFERUSLN 6FQL ... CALL 1 XFNDFERUS [X2 -> FI,FERUS 6FQ^ ... POP XBFERUS,,FERUSALT [TEST IF SEMAPHORE OPEN 6FR# ... LDN 5 FERUSLEN 6FRM ... ADX 5 ALOGLEN(2) [GET NEW LENGTH IN X5 6FS2 ... ALTLENG 2,5,XFNDFERUS [ALTER LENGTH OF FI,FERUS 6FS* ... CALL 1 XFNDFERUS 6FSN ... MHUNTW 1,FILE,ENT 6FT3 ... LDX 3 2 [REMEMBER FERUS POINTER 6FTB ... ADN 1 EUSE1 [X1 -> USERNAME 6FTP ... ADX 2 FERUSRH(2) 6FW4 ... ADN 2 FERUSRH [X2 -> NEW RECORD ADDRESS 6FWC ... MOVE 1 FERUSLEN [MOVE USERNAME INTO NEW RECORD 6FWQ ... LDN 5 FERUSLEN 6FX5 ... ADS 5 FERUSRH(3) [ADD 'FERUSLEN' TO R.H. 6FXD ... LDN 5 1 6FXR ... ADS 5 FERUSNUM(3) [ADD 1 TO NO. OF ENTRIES 6FY6 ... VOP ,FERUSALT [RESET SEMAPHORE 6FYF ... BRN XFREELEX 6FYS ...XFNDFERUS 6F^7 ... LDN 2 BMISC [FIND FI,FERUS 6F^G ... HUNT2B 2,FI,FERUS,2 [IN MISCELLANEOUS CHAIN 6F^T ... EXIT 1 0 6G28 ...[ 6G2H ...RERR GEOERR 1,ERASEREP 6G3B [ 6GH2 [ 6H2L [ 6HG= ... MENDAREA 20,K99ERASE 6JFG #END ^^^^ ...33306414000100000000