{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: BMAPDIR865)}}
====== BMAPDIR865 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:ALTLENGD|ALTLENGD]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BLOCKMAP|BLOCKMAP]], [[george:macro:BS|BS]], [[george:macro:BWNZ|BWNZ]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:DOWN|DOWN]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNTMISB|HUNTMISB]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JBC|JBC]], [[george:macro:JBCC|JBCC]], [[george:macro:JBS|JBS]], [[george:macro:JMBAC|JMBAC]], [[george:macro:JMBACC|JMBACC]], [[george:macro:JMBAS|JMBAS]], [[george:macro:MBC|MBC]], [[george:macro:MBS|MBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:MONOUTX|MONOUTX]], [[george:macro:NOBITS|NOBITS]], [[george:macro:NOPARTRES|NOPARTRES]], [[george:macro:OUTBLOCK|OUTBLOCK]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:OUTPACKX|OUTPACKX]], [[george:macro:POP|POP]], [[george:macro:QSTEPC|QSTEPC]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SFCB|SFCB]], [[george:macro:SKIP|SKIP]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:STEPREWRITE|STEPREWRITE]], [[george:macro:TESTNAMX|TESTNAMX]], [[george:macro:TOPFCA|TOPFCA]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:TRACEIF|TRACEIF]], [[george:macro:UP|UP]], [[george:macro:VOP|VOP]]
22FL ... SEG BMAPDIR,864,EDWARD MOON,BMAP
22^= SEGENTRY K1BMAPDIR,Z1BMAPDIR
23?M ... SEGENTRY K2BMAPDIR,XBR
23L4 ...
23YG SEGENTRY K3BMAPDIR,UPJOBCT
24D6 SEGENTRY K4BMAPDIR,SETSAVEBIT
24XQ SLAVEACT
25CB #HAL +BSA+AUTOMAP,0
29S2 RESMESS +BMRESTUSER
2=?L PRMESS +BMPARTRES
2=R= STRINGABAND 16HABANDONED :
2?=W STRNOTDUMP 16HUSER NOT DUMPED
2#PQ NFIVE +5
2B8L NSYS 12HSYSTEM
2BN= [
2C7W [
2CMG [
2D76 [
2DLQ [ THUIS ROUTINE SETS UP A GMON ASET BLOCK FOR MESSAGE PARAMETERS
2F6B [
2FL2 [ ON ENTRY X5=> SIZE OF BLOCK
2G5L [ X7 =>LINK
2GK= [
2H4W OUTBLOCK
2HJG SBX 7 FX1
2J46 OUTBLOCK 5
2JHQ STEPAGAIN
2K3B ADX 7 FX1
2KH2 EXIT 7 0
2L2L [
2LG= [
2L^W [ THIS ROUTINE PACKS A PARAMETER INTO A GMOM ASET BLOCK
2MFG [ ON ENTRY X2 [ ADDRESS OF PARAMATER DATA
2M^6 [ X5 = LENGTH OF DATA
2NDQ [ X6 = LPDC CHARACTER
2NYB [ X7 = LINK
2PD2 OUTPACK
2PXL SBX 7 FX1
2QC= OUTPACKX 2,5,6
2QWW ADX 7 FX1
2RBG EXIT 7 0
2RW6 [
2S*Q MONOUT
2STB SBX 7 FX1
2T*2 MONOUTX 3
2TSL ADX 7 FX1
2W#= EXIT 7 0
2WRW [
2X?G [********************************************: MAPBLOCKS
2XR6 [ SUBROUTINE TO MAP A FILE
2Y=Q [ EXITS +0 IF FILE ON UNAVAILABLE RESIDENCE
2YQB [ +1 IF FILE IS EMPTY
2^=2 [ +2 IF ALL O. K.
2^PL [
329= MAPBLOCKS
32NW SBX 7 FX1
338G STO 7 ACOMMUNE2(2)
33N6 BLOCKMAP MAPLB1,MAPLB2
347Q LDX 7 ACOMMUNE2(2)
34MB BRN MAPXIT
3572 MAPLB1
35LL SBN 7 1 [ IF UNAVAILABLE
366= MAPLB2
36KW SBN 7 1 [ IF EMPTY
36TN ... LDX 2 FX2
375G MAPXIT
37K6 ADN 7 2
384Q ADX 7 FX1
38JB EXIT 7 0 [IF NORMAL EXIT
3942 [
39HL [************************************************** SERCHFENTRY
3=3= [ ROUTINE TO BINARY CHOP A FUSER BLOCK TO FIND A REQUIRED
3=GW [ ENTRY
3?G6 [ X5 => KEY OF ENTRY THAT WE REQUIRE
3?^Q [
3#FB SERCHFENTRY
3#^2 HUNTMISB 3,FI,FUSER
3CWQ STO 4 ACOMMUNE2(2) [WE WISH TO SAVE THIS (BMAPONE)
3DW2 LDX 4 5
3F*L LDX 0 A1(3) [USED DATA 'V'
3FT= LDX 6 3
3G#W ADX 6 0
3GSG ADN 6 A1+1 [DISTANCE MARKER FOR LIMIT OF SEARCH
3H#6 LDN 5 A1+1
3HRQ ADX 5 3 [HOME MARKER FOR START OF SEARCH
3J?B NEXTCHOP
3JR2 SRL 0 1 [DIVIDE V BY 2
3PM= [********************************************
3Q6W [ THIS SECTION ROUNDS DOWN THE NEW 'V' FOR A FUSER BLOCK TO BE
3QLG [ DIVISIBLE BY FIVE,THUS POINTING IT AT WORD 0 OF A FUSER ENTRY
3R66 [
3S5B STO 0 2
3SK2 DVS 1 NFIVE(1)
3T4L SBX 0 1
3TJ= LDX 1 FX1
3WHG STO 0 3 [PUT'V' INTO A MODIFIER
3^YW SMO 5
42DG LDX 2 3(3)
43CQ BXE 2 4,WEHAVEIT [IF THIS IS THE ENTRY WE WANT
43XB BNZ 3 NOCHOPAGAIN
44C2 TRACEIF K6BMAPONE,99,299,4,DIRNDICT
44WL LDN 2 0
45B= BRN WAYOUT
45TW NOCHOPAGAIN
46*G BXL 2 4,MOREBIG
46T6 STO 5 6
47#Q ADX 6 0 [NEW'DISTANCE' = 0D+V
47SB BRN NEXTCHOP [TO CHOP AGAIN
48#2 MOREBIG
48RL ADX 5 0 [NEW 'HOME' = OH +V
49?= LDX 0 6
49QW SBX 0 5
4==G BRN NEXTCHOP [TO CHOP AGAIN
4=Q6 WEHAVEIT
4?9Q [
4?PB [**********************************************:************
4#92 [ WE HAVE CORRECT KEY, BUT
4#NL [ WE MUST NOW LOCATE THE CORRECT USERNAME AS
4*8= [ KEYS ARE NOT NECESSARILY UNIQUE.
4*MW [
4B7G ADX 3 5 [POINTER TO ENTRY IN BLOCK
4C6Q LDX 2 FX2
4CLB TRYBACK
4D62 SBN 3 5
4DKL LDX 0 3(3)
4F5= BXE 0 4,TRYBACK
4FJW ADN 3 5
4G4G NEXTSLOT
4GJ6 LDX 0 3(3)
4H3Q BXU 0 4,NOTFND
4HHB LDN 5 2
4J32 STOZ 1
4JGL NEXTWORD
4K2= LDX 0 0(3)
4KFW SMO ACOMMUNE1(2)
4K^G TXU 0 EUSE1N(1)
4LF6 BCS NOTHIS
4LYQ ADN 3 1
4MDB ADN 1 1
4MY2 SBN 5 1
4NCL BPZ 5 NEXTWORD
4NX= SBN 3 3
4PBW BRN NOWOUT
4PWG NOTHIS
4QB6 ADN 5 3
4QTQ ADS 5 3
4R*B BRN NEXTSLOT
4RT2 NOTFND
4S#L [
4SS= [***************************************************
4T?W [ EXIT +0 IF ENTRY NOT FOUND
4TRG [
4W?6 STOZ 2
4WQQ BRN WAYOUT
4X=B NOWOUT
4XQ2 [
4Y9L [*************************************************************
4YP= [ EXIT +1 IF ENTRY FOUND
4^8W [
4^NG LDN 2 1
5286 WAYOUT
53M2 SMO FX2
546L LDX 4 ACOMMUNE2
54L= ADX 7 2
555W EXIT 7 0
55KG [
5656 [************************************************* STEPAGAIN
56JQ [
574B STEPAGAIN
57J2 SBX 7 FX1
583L STEPAGAIN
58H= ADX 7 FX1
592W EXIT 7 0
59GG [
5=26 [************************************************* STEPREWRITE
5=FQ [
5=^B STEPREWRITE
5?F2 STEPREWRITE
5?YL EXIT 7 0
5#D= [
5#XW [
5*CG [************************************************* SUB1
5*X6 [ SUBROUTINE TO HUNT FTAB BLOCK (FOR ALTLENG)
5BBQ [
5BWB SUB1
5CB2 MHUNTW 2,FILE,FTAB
5CTL EXIT 1 0
5D*= [
5DSW [************************************************ PUTINFLIST
5F#G [ SET 'FLIST ENTRY REQUIRED' BIT
5FS6 [
5G?Q PUTINFLIST
5GRB BS 2,AW2PUTINFL
5H?2 EXIT 7 0
5HQL [
5J== [***************************************************** SFUSER
5JPW [ ROUTINE TO HUNT FUSER BLOCK (FOR ALTLENG)
5K9G [
5KP6 SFUSER
5L8Q CALL 7 TOHUNTFUSER
5LNB LDX 2 3
5M82 EXIT 1 0
5MML [
5N7= [************************************************** TOHUNTFUSER
5NLW [ ROUTINE TO HUNT FUSER BLOCK (GENERAL)
5P6G [
5PL6 TOHUNTFUSER
5Q5Q HUNTMISB 3,FI,FUSER
5QKB EXIT 7 0
5R52 [
5RJL [*********************************************** TOHUNTFLIST
5S4= [
5SHW TOHUNTFLIST
5T3G HUNTMISB 3,FI,FLIST
5TH6 EXIT 7 0
5W2Q [
5WGB [
5WJ# ...[**************************************************************TOHUNTFRE
5WL= ...[
5WN8 ...TOHUNTFREST
5WQ6 ... HUNTMISB 1,FI,FRESTUSER
5WS4 ... EXIT 7 0
5WW2 ...[
5WXY ...[
5X22 [***********************************************************************
5XFL [ ENTRY (ACROSS) FROM BMAPONE TO PROCESS ENTRY FOR A DIRECTORY
5X^= [
5YDW
5YYG Z1BMAPDIR
5^D6 CALL 7 STEPAGAIN
5^XQ TRACEIF K6BMAPONE,99,299,EUSE1N(3),DIRENT
62CB JBCC NOTPROC,3,BNINFPROC
62X2 CALL 7 STEPREWRITE
63BL NOTPROC
63W= JBCC NOALINC,3,BNALLINCS
64*W CALL 7 STEPREWRITE
64TG NOALINC
64TR ... JMBACC NOBITS,3,BNPURE,BNWORK,BNVIRGINDA
64W4 ... CALL 7 STEPREWRITE
64W* ...NOBITS
64WN ...[
64XW ...[***************************************************
64^4 ...[ A DIRECTORY SHOULDNT BE 'FROZEN', BUT, IF IT IS
652= ...[ WE JUST CLEAR THE FREEZECOUNTS.
653D ...[
654L ... LDX 0 EAUTOCOUNTN(3)
655S ... ADX 0 ESAVECOUNTN(3)
6572 ... BZE 0 NOTFROZ [ IF NOT 'FROZEN'
6588 ... STOZ EAUTOCOUNTN(3) [ ELSE
659B ... STOZ ESAVECOUNTN(3) [ ZEROISE BOTH.
65=J ... CALL 7 STEPREWRITE
65?Q ...NOTFROZ
65?S ...#UNS AMTGR
65?W ...(
65?Y ...[
65#2 ...[***********************************************
65#4 ...[ NOW CHECK FOR OFFLINE DIRECTORIES
65#6 ...[
65#8 ... JBS NOTOFF,2,AW2ONLINE [ J. IF NOT OFFLINE
65#= ...[
65## ...[******************************************************
65#B ...[ DIRECTORY OFFLINE - WANT TO
65#D ...[ INITIATE A PARTIAL RESTORE OF IT
65#G ...[
65#J ... DOWN BMQUEST,4 [ TO INITIATE RESTORE
65#L ... BRN PARTREPEAT [ IF INITIATED O.K.
65#N ... BRN NOTPRUSFAIL [ IF FAILED BECAUSE NOT DUMPED
65#Q ...NOTOFF
65#S ...)
65*6 [
65SQ [************************************************************
66#B [ NOW CHECK IF A RESTORE NEEDS TO BE REINITIATED FOR
66S2 [ THIS DIRECTORY,IF WE JUST NEED TO TIDY UP A
67?L [ PREVIOUSLY RESTORED DIRECTORY OR IF ALL IS 'NORMAL'
67R= [ IF MAPPING A RESTORED LIMB, SET PARTIALLY RESTORED
68=W [ BIT TO SHOW THAT DIRECTORY HAS BEEN RESTORED.
68QG [
69=6 JBC NOPARTRES,2,AW2PARTRES
69PQ BS 3,BNPARTRES
6=9B CALL 7 STEPREWRITE
6=P2 BRN PRCLEAR
6?8L NOPARTRES
6?N= [
6#7W [**********************************************************
6#MG [ FAILED IN PREVIOUS RESTORE IF 'BFPARTRES' SET IN
6*76 [ :MASTER'S FCB.
6*LQ [
6B6B LDX 1 BFILE
6BL2 JBC PRCLEAR,1,BFPARTRES
6C5L [
6CK= [*******************************************************
6D4W [ PREVIOUS RESTORE FAILED AFTER FREEING BACKING STORE.
6DJG [ IF 'PARTRES' AND 'TEMP' BITS SET THIS DIRECTORY WAS
6F46 [ BEING RESTORED SO WE NEED TO REINITIATE THE RESTORE.
6FHQ [
6G3B JMBAS PRREINIT,3,BNPARTRES,BNTEMP
6GH2 [
6H2L [********************************************************
6HG= [ IF 'PARTRES' AND 'TEMP' ARE CLEAR, THIS DIRECTORY IS
6H^W [ 'NORMAL' ELSE J. TO GET A FLIST ENTRY MADE AS DIR. WILL
6JFG [ NEED TIDYING UP.
6J^6 [
6KDQ JMBAC NOFLAD,3,BNPARTRES,BNTEMP
6KYB BRN PRCLEAR
6LD2 PRREINIT
6LXL [
6MC= [*******************************************************
6MWW [ RESTORE NEEDS TO BE REINITIATED - CHECK IF 'RESTORES
6NBG [ REINITIATED' MESSAGE HAS ALREADY BEEN OUTPUT (FRNXT < 0)
6NW6 [
6P*Q ... CALL 7 TOHUNTFREST
6PTB LDX 0 FRNXT(1)
6Q*2 BNG 0 MOUTDONE
6QBY ...#UNS AMTGR
6QDW ...(
6QGS ... LDX 0 GSIGN
6QJQ ... ORS 0 FRNXT(1)
6QLN ...)
6QNL ...#UNS AMTGR
6QQJ ...#SKI
6QSL NGS 1 FRNXT(1)
6R#= MONOUT BMPRAGAIN
6RRW MOUTDONE
6S?G [
6SR6 [********************************************************
6T=Q [ GO DOWN TO BMQUEST TO REINITIATE THE RESTORE. IF IT COMES
6TQB [ 'UP' A FRESTUSER ENTRY HAS BEEN MADE. IF 'UP +1'
6W=2 [ RESTORE ABANDONED - USER NOT DUMPED
6WPL [
6X9= DOWN BMQUEST,4
6XNW NGN 2 1 [ IF 'UP'
6Y8G SBN 2 1 [IF 'UP+1' : STILL +VE
6YN6 STO 2 5
6^7Q CALL 7 STEPAGAIN
6^MB BNG 5 PARTREPEAT [ J. IF RESTORE INITIATED
7272 BRN TEMPDIR [ ELSE TREAT AS TEMPORARY
72LL PRCLEAR [ TO GET IT ERASED
736= TOPFCB2 1
73KW JBC NOFLAD,1,BFPARTRES
745G BS 2,AW2PARTRES
74K6 NOFLAD
754Q JBS TEMPDIR,3,BNTEMP [IF TEMPORARY DIRECTORY
75JB PARTREPEAT
75N? ...#UNS AMTGR
75S8 ...#SKI
75Y5 ...(
7642 [
76HL [***********************************************************
773= [ IF DIRECTORY IS OFFLINE (SHOULDN'T HAPPEN)
77GW [ GET IT ERASED
782G [
78G6 JBC SERDIR,2,AW2ONLINE [J IF OFFLINE DIRECTORY
78PY ...)
78^Q [
79FB [*************************************************************
79^2 [ NEXT MARK FUSER ENTRY 'FOUND'. IF IT DOESN'T
7=DL [ EXIST J. TO INSERT NEW ONE AND CREATE SKELETON
7=Y= [ DICTIONARY ENTRY. IF IT IS ALREADY MARKED FOUND
7?CW [ THER IS AN INCONSISTENCY - IF MAPPING A RESTORED
7?XG [ LIMB IT'S THE RESTORED ONE WHICH IS WRONG SO GET IT
7#C6 [ ERASEE, ELSE J. TO DO P. R. OF THIS USER
7#WQ [
7*6J ... CALL 7 STEPAGAIN
7*BB LDX 5 EUSE1N(3)
7*W2 ADX 5 EUSE2N(3)
7B*L ADX 5 EUSE3N(3) [KEY FOR FUSER SEARCH
7BT= STO 3 ACOMMUNE1(2)
7C#W TRACEIF K6BMAPONE,99,299,5,FUSKEY
7D#6 CALL 7 SERCHFENTRY
7DRQ BRN NOTFOUND [EXIT FROM FUSER SEARCH IF NO ENTRY
7F?B NEWENT
7FR2 [
7G=L [***************************************************
7GQ= [ ENTRY LOCATED - NOW CHECK IF MARKED ALREADY
7H9W [
7HPG LDCT 0 #400
7J96 ANDX 0 4(3)
7JNQ BZE 0 NFUSENT [ J. IF NOT MARKED
7K8B LDX 2 FX2
7KN2 [
7L7L [*********************************************************
7LM= [ ENTRY MARKED ALREADY - IF MAPPING RESTORED LIMB GET
7M6W [ RESTORED USER ERASED ELSE INITIATE PART. RES. OF
7MLG [ CURRENT DIRECTORY.
7N66 [
7NKQ JBS SETERASE,2,AW2PARTRES
7P5B BRN XFILEBENT [ REPEATED USERNAME - TREAT AS BENT
7PK2 SETERASE
7Q4L CALL 7 PUTINFLIST
7QJ= CALL 7 STEPAGAIN
7R3W BRN NOTPRUSFAIL [ J. TO GET IT ERASED
7RHG NFUSENT
7S36 [
7SGQ [*********************************************************
7T2B [ NOT ALREADY MARKED - MARK IT 'FOUND' THEN CHECK IF
7TG2 [ USER IS 'FROZEN'. IF SO MARK FUSER ENTRY FOR
7T^L [ LATER CHECKING WITH DICTIONARY.
7WF= [
7WYW LDCT 0 #400
7XDG ORS 0 4(3) [SET USER FOUND IN FUSER ENTRY
7XY6 HUNTMISB 2,FI,FUSER
7YCQ SBX 3 2
7YXB STO 3 6 [REL POS OF NAME IN FUSER FOR TAPES
7^C2 CALL 7 STEPAGAIN
7^WL JBC NOFROZUS,3,BNUSERFREZ [ J. IF NOT FROZENZ
82B= CALL 7 TOHUNTFUSER
82TW ADX 3 6
83*G LDCT 0 #100 [ ELSE MARK AS FROZEN
83T6 ORS 0 4(3) [ IN FUSER ENTRY
84#Q CALL 7 STEPAGAIN
84SB NOFROZUS
85#2 JBCC MAP,3,BNERASE [ CLEAR ERASE BIT IF SET
85RL CALL 7 STEPREWRITE [
86?= MAP
86QW #UNS FPARTRES
87=G (
87Q6 [
889Q [***********************************************************
88PB [ BEFORE MAPPING THE ENTRY WE MUST CHECK IF THE DIRECTORY
8992 [ IS TO BE RESTORED. IF IT IS IT WILL BE OMITTED
89NL [ FROM THIS SEARCH SO IT MUST NOT BE MAPPED.
8=8= [
8=MW ... CALL 7 TOHUNTFREST
8?7G LDX 0 FRCNT(1) [ NO P. R.'S TO DO IF
8?M6 BZE 0 NOPART [ FRESTUSER EMPTY
8#6Q LDX 2 1
8#LB SBN 2 8
8*62 ADX 1 A1(1)
8*KL ADN 1 A1
8B5= [
8BJW [***********************************************************
8C4G [ SEE IF THIS USER IS IN FRESTUSER BLOCK. IF NOT IT'S NOT
8CJ6 [ BEING RESTORED. IF IT IS CHECK IF ENTRY IS FOR
8D3Q [ 'FILEBENT' TYPE CORRUPTION (FRFIL NOT ZERO - CONTAINS
8DHB [ REL. BLOCK NO. THOUGHT CORRUPT).IF SO MAP ENTRY AS
8F32 [ USUAL AND INCLUDE IN SEARCH TO GET SECOND ATTEMPT.
8FGL [
8G2= NEXTUSER
8GFW ADN 2 8
8G^G BXGE 2 1,NOPART
8HF6 TESTNAMX 3,EUSE1N(3),FRUSE(2),NEXTUSER
8HYQ [
8JDB [********************************************************
8JY2 [ ENTRY FOUND - IF FULL ENTRY ALREADY (FRINC +VE.) JUST
8KCL [ OMIT FROM SEARCH.
8KX= [
8LBW LDX 0 FRINC(2)
8LWG BPZ 0 PARTRESUSER
8MB6 [
8MTQ [**************************************************
8N*B [ INCOMPLETE ENTRY - CHECK IF 'FILEBENT'
8NT2 [
8P#L LDX 0 FRFIL(2)
8PS= BZE 0 NOTBENT
8Q?W ORX 0 GSIGN
8QRG STO 0 FRFIL(2)
8R?6 BRN NOPART [ J. IF FILEBENT
8RQQ NOTBENT
8S=B [
8SQ2 [*********************************************************
8T9L [ INCOMPLETE ENTRY - NOT 'FILEBENT' TYPE. SET 'PARTRES'
8TP= [ AND 'TEMP' TO SHOW RESTORE INITIATED AND FILL IN
8W8W [ FRESTUSER ENTRY. IF USER NOT DUMPED JUMP TO
8WNG [ ABANDON THE RESTORE.
8X86 [
8XMQ MBS 3,BNPARTRES,BNTEMP
8Y7B LDX 0 EINCN(3)
8YM2 STO 0 FRINC(2) [ INCR. NO.
8^6L BZE 0 USNODUMP [ J. IF NOT DUMPED
8^L= LDX 0 EFILNUMN(3)
925W STO 0 FRFIL(2) [ FILE NO.
92KG LDN 7 EUSE1N(3) [ USERNAME OF THIS
9356 JBC NOTSUDUSR,3,BNPSEUDO [ USER IF A PROPER USER
93JQ SMO FX2 [ ELSE
944B LDN 7 ASUPUSER [ SUPERIOR PROPER USERNAME
94J2 NOTSUDUSR
953L LDN 0 FRSUP(2)
95H= MOVE 7 3
962W CALL 7 STEPREWRITE
96GG [
9726 [************************************************
97FQ [ IF THE USER TO BE RESTORED IS :SYSTEM WE MUST STILL
97^B [ MAP INCINDEX AND SERIAL AS THEY ARE BEING RETAINED.
98F2 [ THIS IS DONE FROM THEIR FCB'S SINCE THEY ARE OPEN TO
98YL [ THIS ACTIVITY (MUST BE MASTER ACT. IF LOOKING AT ENTRY FOR
99D= [ :SYSTEM) AT DEPTHS -1 AND -3 RESPECTIVELY
99XW [
9=CG LDX 1 FX1
9=X6 TESTNAMX 3,NSYS(1),EUSE1N(3),PARTRESUSER
9?BQ NGN 6 1
9?WB NEXTMAP
9#B2 SFCB 6,3
9#TL LDX 5 FBLMOD(3) [
9**= SBN 5 FCBLEN-2 [ GET PSEUDO POINTERS TO FCB
9*SW LDX 4 5 [ SO IT LOOKS LIKE A
9B#G SBN 4 2 [ BLOCKS RECORD
9BS6 ADN 3 BSPRE-1
9C?Q CALL 7 MAPBLOCKS [ MAP BLOCKS
9CRB BRN XBR [ ALREADY CHECKED FOR UNAVAIL. RES.
9D?2 BRN MPT [ EMPTY - UNLIKELY !
9DQL MPT
9F== ADN 6 1
9FPW BNZ 6 PARTRESUSER [ J. IF MAPPED BOTH
9G9G NGN 6 3 [ ELSE RESET DEPTH FOR NEXT
9GP6 BRN NEXTMAP [ AND MAP THAT
9H8Q USNODUMP
9HNB [
9J82 [*************************************************** USNODUMP
9JML [ USER NOT DUMPED - ZERO ALREADY PUT IN FRINC TO 'DELETE'
9K7= [ ENTRY. NOW REDUCE USED SPACE COUNT BY 8. OUTPUT
9KLW [ 'ABANDONED' MESSAGE TO OPS. AND J. TO OMIT DIR.
9L6G [ FROM SEARCH
9LL6 [
9M5Q ... CALL 7 TOHUNTFREST
9MKB LDN 0 8
9N52 SBS 0 FRCNT(1)
9NJL LDN 2 EUSE1N(3)
9P4= LDN 5 3
9PHW LDN 6 JPDUSERNAME
9Q3G CALL 7 OUTPACK [ USERNAME
9QH6 LDN 2 STRINGABAND(1)
9R2Q LDN 5 4
9RGB LDN 6 JPDVARCHAR
9S22 CALL 7 OUTPACK
9SFL LDN 2 STRNOTDUMP(1)
9S^= LDN 5 4
9TDW LDN 6 JPDVARCHAR
9TYG CALL 7 OUTPACK
9WD6 LDX 3 PRMESS(1)
9WXQ CALL 7 MONOUT
9XCB CALL 7 STEPAGAIN
9XX2 CALL 7 PUTINFLIST
9YBL BRN NOTPRUSFAIL [ J. TO GET IT ERASED
9YW= PARTRESUSER
9^*W [
9^TG [************************************************* PARTRESUSER
=2*6 [ USER BEING RESTORED - MAKE FLIST ENTRY SO BMAPTWO WILL
=2SQ [ CHECK IF LIMB WAS JOINED UP O.K. THEN J. TO OMIT DIR.
=3#B [
=3S2 CALL 7 STEPAGAIN
=4?L BS 2,AW2DIRBELOW
=4R= CALL 7 PUTINFLIST
=5=W BRN SKIPALL
=5QG NOPART
=6=6 [
=6PQ [************************************************ NOPART
=79B [ IF MAPPING RESTORED LIMB - SEND RESTORED
=7P2 [ MESSAGE TO JOURNAL.
=88L [
=8N= LDX 2 FX2
=97W JBC NORESMESS,2,AW2PARTRES
=9*4 ...#UNS AMTGR
=9G= ... BWNZ GINCTSN,NORESMESS [ NO MESS. IF MULTI-TAPE G.R.
=9MG LDN 2 EUSE1N(3)
==76 LDN 5 3
==LQ LDN 6 JPDUSERNAME
=?6B CALL 7 OUTPACK
=?L2 LDX 3 RESMESS(1)
=#5L MONOUTX 3
=#K= NORESMESS
=*4W )
=*JG [
=B46 [***************************************************
=BHQ [ REMEMBER (IN AWORK2) THAT INFERIOR DIRECTORY FOUND
=C3B [
=CH2 MBS 2,AW2DIRBELOW,AW2DIR [ DIRECTORY MARKER
=D2L TRACEIF K6BMAPONE,99,299,AWORK2(2),MAPDIR
=DG= MAPTERMINAL
=D^W [
=FFG [**************************************************
=F^6 [ NOW 'MAP' THE BLOCKS RECORD
=GDQ [
=GYB QSTEPC ,XBACKREAD [ TO BLOCKS RECORD
=HD2 BRN NOBACKREAD [ IF NO BACKREAD NECESSARY
=HXL XBACKREAD [ ELSE
=JC= DOWN BMCNTRL,2 [ TO READ NEXT BLOCK
=JWW BRN MAPTERMINAL [ 'UP' IF O.K.
=KBG BRN XRECHEAD [ 'UP+1' IF CORRUPT REC.HEADDR.
=KW6 STOZ 3 [ 'UP+2' IF END OF FILE
=L*Q BRN NOBACKREAD
=LTB XRECHEAD
=M*2 ACROSS BMAPONE,13 [ TO INITIATE PART. RES.
=MSL NOBACKREAD
=N#= BZE 3 XFILEBENT
=NRW LDEX 5 FRH(3)
=P?G CALL 7 MAPBLOCKS [ MAP BLOCKS
=PR6 BRN NOLF [ UNAVAILABLE
=PTP ... BRN XCHEKPRES [EMPTY DIRECTORY
=PY# ... BRN SETFTAB [NORMAL CASE
=Q2X ...[
=Q5G ...[********************************************************************
=Q85 ...[FOR EMPTY DIRECTORY WHICH IS PART OF PARTIALLY RESTORED LIMB FTAB
=Q=N ...[ENTRY REQUIRED SO THAT BMAPONE WILL PROCESS THIS DIRECTORY AND SET
=Q*? ...[UP FLIST ENTRY
=QCW ...[
=QGF ...XCHEKPRES
=QK4 ... JBS SETFTAB,2,AW2PARTRES
=QMM ... BRN SKIP
=QQB [
=R=2 [********************************************************:
=RKP ...[ A NON-EMPTY DIRECTORY HAS JUST HAD ITS BLOCKS MAPPED
=R^D ...[OR EMPTY DIRECTORY IS BEING PARTIALLY RESTORED.
=S*7 ...[ WE NOW NEED TO MAKE A FTAB BLOCK ENTRY FOR
=SNW [ IT TO ENSURE THAT A SLAVE IS SET UP TO 'MAP' IT.
=T8G [ SET UP FTAB IF ONE DOES NOT ALREADY EXIST AT THIS
=TN6 [ FILESTORE LEVEL.
=W7Q [
=WCJ ...SETFTAB
=WMB BACKSPACE [DIRECTORY TO NAME RECORD
=X72 HUNTW 3,FILE,FTAB
=XLL BNG 3 SETUPTABLK [ J. IF NONE PRESENT
=Y6= LDX 0 A1+1(3)
=YKW BXE 0 AMAPDEPTH(2),TABEXISTS [ J. IF RIGHT DEPTH ELSE
=^5G SETUPTABLK
=^K6 SETNCORE 20,3,FILE,FTAB [ SET ONE UP
?24Q LDN 0 0
?2JB STO 0 A1(3) [INITIALISE USED DATA WORD
?342 LDX 0 AMAPDEPTH(2)
?3HL STO 0 A1+1(3) [DEPTH OF FTAB
?43= TABEXISTS
?4GW LDX 0 A1(3) [USED DATA
?52G LDX 7 ALOGLEN(3)
?5G6 SBN 7 5
?5^Q BXL 0 7,NOFTABLEN [ J. IF LONG ENOUGH
?6FB ADN 7 17
?6^2 ALTLENG 3,7,SUB1 [ ELSE LENGTHEN IT
?7DL NOFTABLEN
?7Y= CALL 7 STEPAGAIN
?8CW STOZ 2 [ X2 = 0 IF PROPER USER
?8XG JBC NOTSUD,3,BNPSEUDO
?9C6 NGN 2 1 [ X2 = -1 IF PSEUDO USER
?9WQ NOTSUD
?=BB LDN 7 EUSE1N(3) [ POINTER TO USERNAME
?=W2 MHUNTW 3,FILE,FTAB
??*L LDX 0 A1(3)
??T= LDN 5 6
?##W ADS 5 A1(3) [UPDATE USED DATA FOR NEW ENTRY
?#SG ADX 3 0
?*#6 ADN 3 A1+2 [X3 POSITION FOR NEW FTAB ENTRY
?*RQ TOPFCA 1
?B?B LDX 0 FREADBLOCK(1)
?BR2 STO 0 0(3) [BLOCK POINTER INTO FTAB
?C=L LDX 0 FREADWORD(1)
?CQ= STO 0 1(3) [RECORD POINTER INTO FTAB
?D9W BPZ 2 PROPUS [ J. IF PROPER USER
?DPG LDX 2 FX2 [ ELSE
?F96 LDN 7 ASUPUSER(2) [ USE SUP. PROPER USER
?FNQ PROPUS
?G8B LDN 0 2(3)
?GN2 MOVE 7 3 [ INTO FTAB
?H7L STEP
?HM= BRN SKIPTRAPS [TO CHECK INDEX AND TRAPS RECORDS
#B32 [
#BGL [****************************************************** SERDIR
#C2= [ WE WANT TO GET DIRECTORY ERASED BY BMAPTWO
#CFW [
#C^G SERDIR
#DF6 BS 3,BNTEMP [SET TEMP BIT TO ENSURE BMAPTWO ERAS
#DYQ CALL 7 STEPREWRITE
#FDB BRN TEMPDIR
#FY2 [
#GCL [******************************************************** NOTFOUND
#GX= [ FUSER ENTRY NOT FOUND - WANT TO INSERT A NEW ONE
#HBW [ AND CREATE A SKELETON DICTIONARY ENTRY FOR LATER
#HWG [ INSERTION BY ADDICT.
#JB6 [ FIRST LOCATE POSITION AT WHICH ENTRY IS TO BE INSERTED
#JTQ [
#K*B NOTFOUND
#KT2 #UNS FPARTRES
#L#L (
#LS= CALL 7 STEPAGAIN
#M?W LDX 4 EUSE1N(3)
#MRG ADX 4 EUSE2N(3)
#N?6 ADX 4 EUSE3N(3) [ REQUIRED KEY
#NQQ CALL 7 TOHUNTFUSER
#P=B LDN 1 A1-1(3) [ => START OF FUSER
#PQ2 LDX 7 A1(3)
#Q9L ADN 7 A1+1(3) [ => END OF FUSER
#QP= NXTKEY
#R8W ADN 1 5 [ => TO NEXT ENTRY
#RNG BXGE 1 7,XATEND [ J. IF PAST END
#S86 LDX 0 0(1)
#SMQ BXL 0 4,NXTKEY [ J. IF KEY < REQUIRED
#T7B XATEND
#TM2 LDX 5 1
#W6L SBN 5 3 [ => TO POSITION FOR ENTRY
#WBD ... SBX 5 3
#WL= WAITLEN
#X5W LDX 2 BSACHAPTR
#XKG POP WAITLEN,2,FTABWAIT [ LOCKOUT OTHER LENGTHENERS
#Y56 CALL 7 TOHUNTFUSER
#^4B LDX 7 ALOGLEN(3)
#^J2 ADN 7 5
*23L ALTLENG 3,7,SFUSER [ LENGTHEN FUSER
*2H= LDX 2 BSACHAPTR
*32W VOP 2,FTABWAIT [ CLEAR LOCKOUT
*3GG CALL 7 TOHUNTFUSER
*426 LDX 6 A1(3)
*4FQ ADN 6 A1+1(3)
*4^B ADX 5 3 [ DATUMISE POINTER
*5F2 BXE 5 6,NOWPUTUSIN [ J. IF INSERT IS AT END OF BLOCK
*5YL [
*6D= [**********************************************************
*6XW [ INSERT IS REQUIRED SOMEWHERE IN MIDDLE OF BLOCK.
*7CG [ MOVE ALL ENTRIES OF KEY > OR = REQUIRED DOWN BLOCK
*7X6 [ TO MAKE ROOM FOR ENTRY ( START WITH LAST ONE IN
*8BQ [ BLOCK FIRST TO AVOID OVERWRITE !).
*8WB [
*9B2 NEXTMOVE
*9TL STO 6 7
*=*= SBN 6 5
*=SW MOVE 6 5
*?#G BXU 5 6,NEXTMOVE
*?S6 NOWPUTUSIN
*#?Q [
*#RB [*****************************************************
**?2 [ THERE IS NOW ROOM FOR THE ENTRY TO BE INSERTED.
**QL [ PUT IN KEY AND USERNAME AND MAKE BIT WORD ZERO.
*B== [
*BPW LDX 1 5
*C9G STO 4 3(1)
*CP6 STOZ 4(1)
*D8Q SBX 5 3
*DNB CALL 7 STEPAGAIN
*F82 LDN 6 EUSE1N(3)
*FML CALL 7 TOHUNTFUSER
*G7= ADX 5 3
*GLW LDX 1 5
*H6G LDN 7 0(1)
*HL6 MOVE 6 3
*J5Q LDN 0 5
*JKB ADS 0 A1(3) [ UPDATE RECORD HEADER
*K52 SBX 5 3 [ SAVE REL. PTR. TO NEW ENTRY IN X5
*KJL [
*L4= [********************************************************
*LHW [ FUSER ENTRY DONE - NOW SET UP FWB TO CONTAIN
*M3G [ SKELETON DICTIONARY ENTRY LONG ENOUGH FOR PROPER USER WITH
*MH6 [ SPACEMT BUDGET).
*N2Q [
*NGB SETNCORE FLOG+4,3,FILE,FWB
*P22 LDN 0 FLOG-1
*PFL STO 0 A1(3)
*P^= STOZ A1+1(3)
*QDW LDN 1 A1+1(3)
*QYG LDN 2 A1+2(3)
*RD6 SMO A1(3)
*RXQ MOVE 1 510 [ ZEROISE BLOCK
*SCB LDN 0 1
*SX2 STO 0 CNEWZ(3) [ DICT. REC. MARKER
*TBL TOPFCB 1
*TW= LDN 6 FME1(1)
*W*W LDN 7 CSUPUSER(3)
*WTG MOVE 6 3 [ SUPERIOR USERNAME
*X*6 CALL 7 STEPAGAIN
*XSQ LDX 4 ECOPSN(3) [ RESET X4 FOR BMAPONE
*Y#B SRL 4 15 [ NO LOMGER NECESSARY !!!
*YS2 MHUNTW 2,FILE,FWB
*^?L LDN 6 ELOC1N(3)
*^R= LDN 7 CLOCN(2)
B2=W MOVE 6 3 [ LOCAL NAME
B2QG LDN 6 EUSE1N(3)
B3=6 LDN 7 CUSER(2)
B3PQ MOVE 6 3 [ USERNAME
B49B JBC NOTSUDO,3,BNPSEUDO [ J. IF PROPER USER
B4P2 LDX 0 GSIGN [ ELSE
B58L ORS 0 CPSEU(2) [ SET PSEUDO BIT
B5N= ALTLENGD 2,FPSEU [ AND SHORTEN FWB TO
B67W MHUNTW 2,FILE,FWB [ LENGTH FOR
B6MG LDN 0 FPSEU [ PSEUDO ENTRY
B776 STO 0 A1(2)
B7LQ NOTSUDO
B86B CHAIN 2,BMISC+1 [ CHAIN IN MISC. CHAIN
B8L2 [
B95L [*******************************************************
B9K= [ FUSER SITUATION IS NOW SAME AS THOUGH ENTRY HAD
B=4W [ ALREADY EXISTED SO J. BACK TO CARRY ON AND MARK
B=JG [ ENTRY AS 'FOUND' ETC.
B?46 [
B?HQ CALL 7 TOHUNTFUSER
B#3B ADX 3 5
B#H2 BRN NEWENT
B*2L )
B*G= TEMPDIR
B*^W [
BBFG [********************************************************* TEMPDIR
BB^6 [ DIRECTORY IS MARKED 'TEMPORARY'. CHECK IF IT NEEDS TO BE
BCDQ [ ERASED. - IF SO SET 'ERASE' BIT TO GET IT ERASED BY BMAPTWO
BCYB [
BDD2 LDX 1 BFILE
BDXL [
BFC= [**********************************************************
BFWW [ IF 'PARTRES' IS CLEAR, THIS IS A NORMAL TEMPORARY
BGBG [ DIRECTORY SO IT NEEDS TO BE ERASED
BGW6 [
BH*Q JBC NOTPRUSFAIL,3,BNPARTRES
BHTB [
BJ*2 [********************************************************
BJSL [ 'PARTRES' AND 'TEMP' SET - IF FAILED IN LAST RESTORE
BK#= [ AFTER FREEING BACKING STORE ( INDICATED BY
BKRW [ 'BFPARTRES' SET IN :MASTER'S FCB) RESTORE HAS BEEN
BL?G [ REINITIATED SO JUST SKIP ENTRY - DONT SET ERASE BIT.
BLR6 [
BM=Q JBS SKIPALL,1,BFPARTRES
BMQB [
BN=2 [********************************************************
BNPL [ 'BFPARTRES' CLEAR SO LAST RESTORE FAILED BEFORE THE
BP9= [ BACKING STORE WAS FREED. - JUST CLEAR 'PARTRES' AND
BPNW [ 'TEMP' AND J. TO TREAT AS NORMAL ENTRY.
BQ8G [
BQN6 MBC 3,BNPARTRES,BNTEMP
BR7Q CALL 7 STEPREWRITE
BRMB BRN PRCLEAR
BS72 NOTPRUSFAIL
BSBS ... CALL 7 STEPAGAIN
BSLL BS 3,BNERASE [SET ERASE BIT
BT6= CALL 7 STEPREWRITE
BW5G BRN SKIPALL [TO DEAL WITH INDEX,BLOCKS AND TRAPS
CY?= [*********************************************** SKIP
CYQW [ RECOVER X6 FROM ACOMMUNE3 - PUT THERE BY 'BLOCKMAP'
C^=G [ MACRO - MAY NO LONGER BE NEEDED !!
C^Q6 [
D29Q SKIP
D2PB LDX 2 FX2
D392 LDX 6 ACOMMUNE3(2)
D3NL SKIPTRAPS
D48= [
D4MW [******************************************************** SKIPTRAPS
D57G [ GO BACK (ACROSS) TO BMAPONE TO CHECK TRAPS AND
D5M6 [ INDEX RECORDS ETC. (HAVING MAPPED BLOCKS REC.)
D66Q [
D6LB ACROSS BMAPONE,4
D762 SKIPALL
D7KL [
D85= [********************************************************** SKIPALL
D8JW [ GO BACK (ACROSS) TO BMAPONE TO SKIP BLOCKS RECORD
D94G [ AND CHECK TRAPS RECORDS ETC.
D9J6 [
D=3Q ACROSS BMAPONE,5
D=HB SETSAVEBIT
D?32 [
D?GL [******************************************************** SETSAVEBIT
D#2= [ ENTRY TO SET 'DIRECTORY CONTAINS SAVING FILE' BIT
D#FW [ IN FUSER ENTRY FOR CORRENT DIRECTORY.
D#^G [
D*F6 NGS 2 AWORK1(2) [ SHOW 'SAVING FILE' ENTRY
D*YQ BRN SAVENTRY
DBDB [
DBY2 [******************************************************* UPJOBCT
DCCL [ ENTRY TO SET 'DIRECTORY CONTAINS USER JOBLIST' BIT
DCX= [ IN FUSER ENTRY FOR CURRENT DIRECTORY
DDBW [
DDWG UPJOBCT
DFB6 STOZ AWORK1(2) [ SHOW 'JOBLIST' ENTRY
DFTQ SAVENTRY
DG*B TOPFCB2 3 [ SET UP PSEUDO
DGT2 LDN 3 ASUPUSER-EUSE1N(2) [ POINTERS TO FCB
DH#L STO 3 ACOMMUNE1(2) [ SO IT LOOKS LIKE
DHS= LDX 5 ASUPUSER(2) [ NAME RECORD
DJ?W ADX 5 ASUPUSER+1(2)
DJRG ADX 5 ASUPUSER+2(2) [ CALC. KEY OF REQUIRED ENTRY AND
DKQQ CALL 7 SERCHFENTRY [ LOCATE IT IN FUSER BLOCK
DL=B BRN XBR
DLQ2 LDX 2 FX2
DM9L LDX 1 AWORK1(2)
DMP= BZE 1 ZJOBBIT [ J. IF JOBLIST
DN8W LDCT 0 #40 [ SET UP 'SAVING FILE' BIT
DNNG BRN ZSAVEBIT
DP86 ZJOBBIT
DPMQ LDCT 0 #200 [ ELSE SET UP 'JOBLIST' BIT
DQ7B ZSAVEBIT
DQM2 ORS 0 4(3) [ PUT IT IN FUSER ENTRY
DR6L UP
DRL= [
DS5W [**************************************************** NOLF
DSKG [ THIS SECTION OF CODE DEALS WITH ENTRANTS FOUND TO BE ON
DT56 [ UNAVAILABLE RESIDENCES.
DTJQ [
DW4B NOLF
DWJ2 LDX 4 1(3) [RESIDENCE NUMBER
DX3L BACKSPACE
DXH= CALL 7 STEPAGAIN
DY2W LDX 0 ECOPSN(3)
DYGG SRL 0 15
D^26 BNZ 0 REQUESTRES [ J. IF NON-EMPTY
D^FQ STEP
D^^B BZE 3 XBR [ ELSE PUT ON RESIDENCE
F2F2 LDN 0 3 [ 3 BY CHANGEING 'ERES'
F2YL STO 0 1(3) [ IN BLOCKS RECORD
F3D= CALL 7 STEPREWRITE
F3XW BACKSPACE
F4CG BRN SKIPALL
F4X6 [
F5BQ [*********************************************************
F5WB [ NON-EMPTY DIRECTORY ON UNAVAILABLE RESIDENCE
F6B2 [ GO DOWN TO ASK FOR RESIDENCE TO BE LOADED AND
F6TL [ GET RESTORE INITIATED IF UNAVAILABILITY
F7*= [ CONFIRMED. COMES 'UP' IF RESTORE INITIATED
F7SW [ COMES 'UP+1' IF ABANDONED - NOT DUMPED
F8#G [
F8S6 REQUESTRES
F9?Q DOWN BMQUEST,3
F9RB BRN SKIPALL
F=?2 BRN NOTPRUSFAIL
F=QL XFILEBENT
F?== ACROSS BMAPONE,12
F#P6 XBR
F#YY ...
F*8Q GEOERR 1,BMAPDIR
F*NB [
FB82 MENDAREA BMAPGAP,K99BMAPDIR
FBML [
FC7= #END
FCLW
^^^^ ...221701250006