{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: ERASEA867)}}
====== ERASEA867 ======
(George Source)
**Macros used:** [[george:macro:ADDMODE|ADDMODE]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BBS|BBS]], [[george:macro:BC|BC]], [[george:macro:BS|BS]], [[george:macro:BUDGERASE|BUDGERASE]], [[george:macro:BWNZ|BWNZ]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:CLOSESHORT|CLOSESHORT]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:DELETE|DELETE]], [[george:macro:DOWN|DOWN]], [[george:macro:FCBFIND|FCBFIND]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETDIR|GETDIR]], [[george:macro:HUNT|HUNT]], [[george:macro:INHIBITBRK|INHIBITBRK]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBS|JMBS]], [[george:macro:JOBLOCK|JOBLOCK]], [[george:macro:LOGACCESS|LOGACCESS]], [[george:macro:LONGON|LONGON]], [[george:macro:MBS|MBS]], [[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:OPENDIR|OPENDIR]], [[george:macro:OPENENDX|OPENENDX]], [[george:macro:OPENRELD|OPENRELD]], [[george:macro:OPENSYS|OPENSYS]], [[george:macro:PERMITBRK|PERMITBRK]], [[george:macro:QKTABSET|QKTABSET]], [[george:macro:QKTABULATE|QKTABULATE]], [[george:macro:READ|READ]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:READDICT|READDICT]], [[george:macro:REPLACE|REPLACE]], [[george:macro:RETURNB|RETURNB]], [[george:macro:REWIND|REWIND]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETREP2|SETREP2]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTINBRK|TESTINBRK]], [[george:macro:TESTNAMX|TESTNAMX]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TOPFCA2|TOPFCA2]], [[george:macro:TOPFCAB2|TOPFCAB2]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]]
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