{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: ERASE867)}}
====== ERASE867 ======
(George Source)
**Macros used:** [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BBS|BBS]], [[george:macro:BS|BS]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:DICTJOB|DICTJOB]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERASEND|ERASEND]], [[george:macro:ERROR|ERROR]], [[george:macro:FCJOB|FCJOB]], [[george:macro:FNORM|FNORM]], [[george:macro:FPUT|FPUT]], [[george:macro:FREELEX|FREELEX]], [[george:macro:FREETAB|FREETAB]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETACT|GETACT]], [[george:macro:GETDIR|GETDIR]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2B|HUNT2B]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBS|JMBS]], [[george:macro:LINKSET|LINKSET]], [[george:macro:LOCK|LOCK]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:PAIR|PAIR]], [[george:macro:POP|POP]], [[george:macro:REPERR2|REPERR2]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPTAB|SETUPTAB]], [[george:macro:SPRIVJUMP|SPRIVJUMP]], [[george:macro:SUICIDE|SUICIDE]], [[george:macro:TABSET|TABSET]], [[george:macro:TABULATE|TABULATE]], [[george:macro:TESTERR|TESTERR]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TESTTRAP|TESTTRAP]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TRACE|TRACE]], [[george:macro:TREP2|TREP2]], [[george:macro:UNIFREE|UNIFREE]], [[george:macro:UNLOCK|UNLOCK]], [[george:macro:UP|UP]], [[george:macro:USEROPEN|USEROPEN]], [[george:macro:VFREE|VFREE]], [[george:macro:VOP|VOP]]
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