15 22FL #SEG DIRENT84 [M.C.D. MANN 4 22KH ...[ 15 22PD ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 4 22T* ...[ 7 22_= #OPT K0DIRENT=0 9 23DW #LIS K0DIRENT>K0ALLGEO 4 23YG # 6 245N ...#UNS G400 16 24=W ...# THIS CHAPTER IS MODIFIED FOR G3PLUS-IH MK2 21 24D6 # THIS SEGMENT IMPLEMENTS THE ^DIRENT^ FORM OF THE SETPARAM COMMAND 4 24XQ # 9 25CB 8HDIRENT 4 25F# ...# 18 25H= ...#SKI G3ISSUE/10-4<1$1 [SKIP IF NOT MARK 8.40 4 25K8 ...( 21 25M6 ...#UNS BFABTSN [DEFINE BFABTSN IF NOT ALREADY DEFINE 4 25P4 ...#SKI 20 25R2 ... BITDEFS ATYPE,13,BFABTSN [BFABTSN ISN'T DEFINED IN 8.40 4 25SY ...) 12 25X2 SEGENTRY K1DIRENT,XK1DIRENT 14 26BL XSTAR #32 [ASTERISK 17 26W= XDIRENTSP +HDIRENTSP [MESSAGE IDENTIFIER 6 26XS ...#UNS G400 4 26_B ...( 10 272Y ...SMASK #77777700 10 274G ...XDIRENTMSP +HDIRENTMSP 10 2764 ...TWOBITS #60000000 9 277L ...XPOOL 12H*POOL 9 2798 ...XWORK 12H*WORK 13 27=Q ...XPWLOC 24HTAPE 00000000 4 27## ...) 6 27*W XK1DIRENT 6 27DF ...#UNS G400 4 27H4 ...( 9 27KM ... SEGENTRY G400DIRA 9 27N= ... TESTHOOK XDSK1 4 27QT ...) 20 27TG BRUSEN NOTUSER [J IF COMMAND IN NO-USER CONTEXT 4 28*6 # 21 28SQ # CHECK WHETHER THE CURRENT USER HAS READ TRAPS FOR THE DIRECTORY 21 29#B # (SPECIFIED OR IMPLIED) WHICH CONTAINS THE ENTRY FOR THE ENTRANT 13 29S2 # SPECIFIED IN THE CPB/CUNI BLOCK 4 2=?L # 18 2=R= MHUNT 3,CPB,CUNI [FIND OUR CPB/CUNI BLOCK 8 2?=W LDX 1 FX1 21 2?QG LDCH 4 APARA(3) [PICK UP FIRST CHARACTER OF PARAMETER 21 2#=6 SBN 4 #21 [IS IT ^!^ ? (WORKFILE NOT ALLOWED) 14 2#PQ BNZ 4 S1A [J IF NOT 6 2#S* ...#UNS G400 5 2#WY ...XDSK2 20 2#_J ... JANAL OPENERR [J IF STILL PROCESSING COMMAND 18 2*9B ERROR JDNOWORK [REPORT THE COMMAND ERROR 15 2*P2 BRN OPENERR [AND GIVE UP 20 2B8L ...S1A SMO FX2 [ASSUME THAT THE LAST CHARACTER 20 2BN= STOZ AWORK1 [OF THE PARAMETER IS NOT AN ^*^ 19 2C7W LDX 2 ANUM(3) [PICK UP THE TYPE/SIZE WORD 21 2CMG BZE 2 STERR [COMMAND ERROR ^EXPRESSION INVALID^ 20 2D76 BNG 2 STERR [ ... IF NULL OR NON-EXISTENT 20 2DLQ ANDN 2 #7777 [ISOLATE SIZE OF THE PARAMETER 7 2F6B SBN 2 1 21 2FL2 SRC 2 2 [CONVERT SIZE TO CHARACTER POINTER 7 2G5L SMO 3 21 2GK= LDCH 4 APARA(2) [PICK UP LAST CHARACTER OF PARAMETER 21 2H4W TXU 4 XSTAR(1) [IS IT ^*^ (MEANING ^LAST VERSION^) ? 21 2HJG BCS S1 [J IF NOT: LATEST VERSION NOT WANTED 4 2HL9 ...# 19 2HMY ...# THE FOLLOWING WORD IS NULLED BY THE ^DIRENT ON^ RESTORE 19 2HPM ...# TIME MACRO TO ALLOW THE USE OF AN ^*^ TERMINATOR AND IS 18 2HRB ...# RE-INSTATED BY ^DIRENT OFF^ WHICH SWITCHES OFF THIS 9 2HT5 ...# INTERNAL FACILITY 4 2HWS ...# 9 2HYH ...#ALT K90DIRENT=0?+37? 18 2J2= ... BRN S1 [J IF ^*^ IS NOT ALLOWED 20 2J46 LDCT 4 #400 [REMEMBER THAT THE LAST CHARACTER 21 2JHQ SMO FX2 [IS AN ^*^ AND THAT WE MUST SEARCH 21 2K3B STO 4 AWORK1 [THE DIRECTORY FOR ^HIGHEST VERSION^ 21 2KH2 LDEX 4 ATYPE(3) [GET PARAMETER NUMBER FROM CPB/CUNI 21 2L2L PARALYSE #32,,4 [FORM A CPB/CMULTI WITHOUT THE ^*^ 21 2LG= SPARAPAS [AND PUT PARAMETER IN NEW CPB/CUNI 19 2L_W MHUNT 3,CPB,CUNI [FIND THE NEW CPB/CUNI BLOCK 19 2MFG LDX 4 ANUM(3) [PICK UP THE PARAMETER SIZE 21 2M_6 BZE 4 STERR [COMMAND ERROR ^EXPRESSION INVALID^ 20 2NDQ BNG 4 STERR [ ... IF NULL OR NON-EXISTENT 20 2NNJ ...#ALT K91DIRENT=0?+37? [LABEL USED BY THE ^DIRENT^ MACRO 21 2NYB S1 NAMETOP 3,FILE,FNAME [RENAME THE CPB/CUNI TO FILE/FNAME 20 2PD2 ... FNORM 1 [CONVERT TO ABSOLUTE FILE NAME 18 2PXL TESTREP NAMEFORM,OPENERR [J IF FORMAT INCORRECT 20 2QC= FINDNAME [EXPAND THE ABSOLUTE FILE NAME 19 2QWW TESTREP OK,S2 [J IF DIRECTORY NAME EXISTS 20 2R6N ... JANAL OPENERR [J IF STILL PROCESSING COMMAND 18 2RBG REPALLER [REPORT THE COMMAND ERROR 15 2RW6 BRN OPENERR [AND GIVE UP 19 2S*Q S2 MHUNT 3,FILE,FABSNB [FIND THE FILE/FABSNB BLOCK 20 2SKJ ... JBS MAGTAPE,3,BFABTSN [COMMAND ERROR IF MT SPECIFIED 8 2STB SMO FX2 9 2T*2 LDX 4 AWORK1 19 2TSL BNG 4 STAR [J IF HIGHEST VERSION WANTED 18 2W#= LDX 7 HDREC(3) [PICK UP THE BLOCK LENGTH 21 2WRW SBN 7 11 [IF IT'S LESS THAN 10 : TOP OF TREE 21 2X?G BNG 7 S4 [J IF TOP OF FILESTORE TREE REACHED 7 2XR6 NGN 4 6 20 2Y=Q ADS 4 HDREC(3) [REDUCE BLOCK LENGTH BY 6 WORDS 21 2YQB OPENDIR ZBREAKIN,READ,QUERY [OPEN CURRENT DIRECTORY'S DIRECTORY 18 2_=2 TESTREP OK,S2A [J IF DIRECTORY OPENED OK 20 2_FS ... JANAL OPENERR [J IF STILL PROCESSING COMMAND 18 2_PL REPALLER [REPORT THE COMMAND ERROR 15 329= BRN OPENERR [AND GIVE UP 17 32NW S2A TRAPOPEN READ [ARE READ TRAPS OPEN? 14 338G TESTREP OKAY,S3 [J IF SO 20 33N6 LDCT 4 #400 [REMEMBER THAT READ TRAPS TO THE 20 347Q SMO FX2 [DIRECTORY ARE CLOSED AND WE MUST 20 34MB STO 4 AWORK1 [CHECK TRAPS ON THE FILE ITSELF 17 3572 S3 CLOSETOP [CLOSE THE DIRECTORY 9 35BS ... MFREE FILE,ENT 19 35LL MHUNT 3,FILE,FABSNB [FIND THE FILE/FABSNB BLOCK 21 366= LDN 4 6 [INCREMENT RECORD HEADER BY 6 WORDS 20 36KW ADS 4 HDREC(3) [BLOCK NOW REFERS TO THE ENTRANT 20 375G S4 MHUNT 3,FILE,FNAME [FIND OUR FILE/FNAME BLOCK AGAIN 18 37K6 NAMETOP 3,CPB,CUNI [AND RENAME IT CPB/CUNI 21 3=#L ...S5 USEROPEN ZBREAKIN,READR,DIR,UNTRAP,TERMDIR,NOERREP [OPEN DIRECTORY 19 3=L2 ...S6 TESTREP2 OK,S7 [J IF THE OPEN WAS SUCCESSFUL 4 3=QN ...S6A 20 3?2G ... JANAL OPENERR [J IF STILL PROCESSING COMMAND 18 3?=# ...S6B REPALLER [REPORT THE COMMAND ERROR 21 3?G6 OPENERR [COMMAND ERROR HAS BEEN DETECTED AND 10 3?PY ... VFREE FILE,ADJUNCTS 21 3?_Q UPPLUS 1 [REPORTED SO TERMINATE THE COMMAND 7 3#2K ...S6C CLOSETOP 9 3#3D ... BRN OPENERR 4 3#4* ...S7 8 3#6Y ... LDX 2 FX2 9 3#9H ... LDX 4 AWORK1(2) 21 3##6 ... BPZ 4 S7A [J IF NO MORE TRAP CHECKING NEEDED 7 3#BP ... CHECKTRAPS 10 3#F# ... LDX 0 ACOMMUNE7(2) 8 3#HX ... BNZ 0 S7A 9 3#LG ... SETREP NOTRAP 8 3#N9 ... JANAL S6C 8 3#PY ... BRN S6B 4 3#RN ...S7A 19 3#W? ... SETNCORE 12,4,ADATA,CREADL [CREATE AN ADATA/CREADL BLOCK 8 3#_2 LDN 5 40 7 3*DL SMO 4 20 3*Y= STO 5 A1 [SET THE BLOCK LENGTH TO 40 WORDS 19 3BCW MHUNT 3,FILE,FABSNB [FIND THE FILE/FABSNB BLOCK 21 3BXG STO 4 7 [REMEMBER ADDRESS OF THE ADATA/CREADL 21 3CC6 LDX 6 HDREC(3) [PICK UP FILE/FABSNB RECORD HEADER 20 3CWQ SBN 6 12 [RELATIVE PTR TO FINAL USER NAME 21 3DBB BPZ 6 S8 [J IF AT LEAST 1 USER NAME IN BLOCK 20 3DW2 LDN 6 0 [OTHERWISE POINT TO TOP USER NAME 7 3F*L S8 SMO 6 20 3FT= LDN 4 A1+1(3) [POINT TO USER NAME IN CORE BLOCK 7 3G#W SMO 7 21 3GSG LDN 5 A1+2 [AND ITS DESTINATION IN ADATA/CREADL 20 3H#6 MOVE 4 3 [MOVE USER NAME INTO THE BLOCK 21 3HRQ ADN 4 5 [POINT TO LOCAL NAME IN CORE BLOCK 8 3J?B BNZ 6 S9 21 3JR2 SBN 4 2 [CORRECT POINTER IF USING TOP NAME 7 3K=L S9 SMO 7 21 3KQ= LDN 5 A1+5 [AND ITS DESTINATION IN ADATA/CREADL 20 3L9W MOVE 4 6 [INSERT LOCAL NAME IN THE BLOCK 8 3LPG SMO FX2 20 3M96 STOZ AWORK2 [REMEMBER ^*^ WASN'T SPECIFIED 9 3MDY ... MFREE FILE,ENT 20 3MNQ BRN OUTMESS [AND ASSEMBLE THE MESSAGE BLOCK 4 3N8B # 18 3NN2 # IF THE ENTRANT DESCRIPTION IS TERMINATED WITH AN ^*^, 19 3P7L # THE RELEVANT DIRECTORY IS NOW SEARCHED FOR THE ^HIGHEST 12 3PM= # VERSION^ OF THE SPECIFIED FILE 4 3Q6W # 4 3QLG STAR 18 3R66 SETNCORE 12,7,ADATA,CREADL [CREATE AN OUTPUT BLOCK 8 3RKQ LDN 4 40 7 3S5B SMO 7 20 3SK2 STO 4 A1 [SET THE BLOCK SIZE TO 40 WORDS 19 3SSS ... MHUNT 3,FILE,FABSNB [FIND OUR FILE/FABSNB AGAIN 21 3T4L LDX 6 HDREC(3) [PICK UP FILE/FABSNB RECORD HEADER 20 3TJ= SBN 6 12 [RELATIVE PTR TO FINAL USER NAME 21 3TS4 ... BNG 6 NOTLIKELY [J IF TOP OF FILESTORE TREE REACHED 7 3W3W SMO 6 20 3WHG LDN 4 A1+1(3) [POINT TO USER NAME IN CORE BLOCK 7 3X36 SMO 7 20 3XGQ LDN 5 A1+2 [AND DESTINATION IN ADATA/CREADL 20 3Y2B MOVE 4 3 [MOVE USER NAME INTO ADATA/CREADL 21 3YG2 ADN 4 5 [POINT TO LOCAL NAME IN CORE BLOCK 18 3Y_L SMO FX2 [AND SAVE THE LOCAL NAME 17 3_F= LDN 5 AWORK2 [ (WITHOUT THE ^*^) 19 3_YW MOVE 4 3 [IN AWORK2, AWORK3 AND AWORK4 21 42DG ADN 6 6 [REMOVE FINAL LOCAL NAME FROM BLOCK 21 42Y6 STO 6 HDREC(3) [SO THAT IT REFERS TO THE DIRECTORY 21 439G ...ST11 USEROPEN ZBREAKIN,READ,DIRONLY,UNTRAP,TERMDIR,NOERREP [OPEN DIRECT 19 43GW ... TESTREP2 OK,ST12 [J IF THE OPEN WAS SUCCESSFUL 20 43S= ... JANAL OPENERR [J IF STILL PROCESSING COMMAND 18 445L ... REPALLER [REPORT THE COMMAND ERROR 19 44C2 BRN OPENERR [J IF USEROPEN DETECTED ERROR 21 44WL ST12 SETUPTAB [INITIALIZE TAB SYSTEM FOR CREEPING 19 456D ... TABSET [EXTEND FILE/FTAB BY 2 WORDS 7 45B= NGN 6 1 21 45TW STO 6 AWORK1(2) [INITIALIZE HIGHEST VERSION NUMBER 18 46*G STEP [TO POINT TO FIRST RECORD 12 46T6 ST13 TRACE ELOC1-A1(3),DIRENTRY 18 47#Q BZE 3 ST25 [J IF DIRECTORY EXHAUSTED 20 47SB LDN 6 0 [INITIALIZE VERSION NUMBER BED 18 48#2 LDN 7 12 [12 CHARACTER LOCAL NAME 20 48RL LDN 1 0 [INITIALISE CHARACTER POINTER TO 20 49?= ST14 SMO 3 [THE LOCAL NAME IN AWORK1 ONWARDS 21 49QW LDCH 4 ELOC1-A1(1) [PICK UP CHARACTER FROM ENTRANT NAME 8 4==G SMO FX2 20 4=Q6 LDCH 5 AWORK2(1) [AND FROM THE STORED LOCAL NAME 17 4?9Q TXU 4 5 [ARE THEY THE SAME? 21 4?PB BCS ST15 [J IF NOT TO CHECK FOR VERSION NUMBER 20 4*MW BCHX 1 / [CHARACTERS ARE IDENTICAL SO FAR 20 4B7G BCT 7 ST14 [J IF MORE CHARACTERS TO COMPARE 19 4BC# ... SBN 4 #20 [IF LAST CHARACTER IS A SPACE 19 4BM6 ... BZE 4 ST21 [THE VERSION NUMBER IS ^ZERO^ 21 4BWY ... BRN ST27 [ELSE ALL 12 CHARACTERS ARE IDENTICAL 19 4C6Q ST15 SBN 5 #20 [END OF LOCAL NAME REACHED? 21 4CLB BZE 5 ST17 [J IF SO: CHECK FOR VERSION NUMBER 19 4D62 ST16 NEXTENT3 [GET THE NEXT DIRECTORY ENTRY 18 4DKL BRN ST13 [AND CARRY ON SEARCHING 21 4F5= ST17 SBN 4 10 [IS THE DIRECTORY CHARACTER NUMERIC? 19 4FJW BPZ 4 ST16 [J IF NOT : GET NEXT ENTRY 8 4G4G ADN 4 10 21 4GJ6 LDN 5 4 [COMPARE 4 VERSION CHARACTERS ONLY 21 4H3Q ... LDN 2 0 [INITIALISE CHARACTER POINTER TO X6 8 4HHB BRN ST19 7 4J32 ST18 SMO 3 20 4JGL LDCH 4 ELOC1-A1(1) [PICK UP NEXT VERSION CHARACTER 8 4K2= SBN 4 10 21 4KFW ... BPZ 4 ST21 [J IF END OF VERSION NUMBER REACHED 8 4K_G ADN 4 10 19 4LF6 ST19 DCH 4 6(2) [DEPOSIT THE CHARACTER IN X6 19 4LYQ ... BCT 7 ST20 [J IF MORE CHARACTERS IN NAME 19 4MDB ... BRN ST21 [END OF LOCAL NAME REACHED 20 4MY2 ...ST20 BCHX 2 / [INCREMENT X6 CHARACTER POINTER 18 4PBW BCHX 1 / [INCREMENT RECORD POINTER 21 4PWG ... BCT 5 ST18 [J IF < 4 VERSION CHARACTERS SCANNED 20 4QB6 ...ST21 LDX 2 FX2 [END OF VERSION NUMBER REACHED 15 4TRG LDX 1 GMINUS1 [^MINUS 1^ 21 4W?6 TXU 1 AWORK1(2) [IS THIS FIRST ACCEPTABLE FILE FOUND? 21 4WQQ BCC ST24 [J IF SO: THIS VERSION HIGHEST SO FAR 21 4X=B TXL 6 AWORK1(2) [COMPARE VERSION NUMBER WITH HIGHEST 21 4XQ2 BCS ST16 [NOT HIGHEST SO FAR SO TRY NEXT ENTRY 9 4Y9L TXU 6 AWORK1(2) 19 4YP= BCC ST16 [EQUAL TO HIGHEST, BUT HIGHER 21 4_8W [GENERATION NUMBER TAKES PRECEDENCE 21 4_NG [AND THAT WILL APPEAR FIRST IN DIR 20 5286 ST24 STO 6 AWORK1(2) [STORE NEW HIGHEST VERSION NUMBER 20 52MQ TABRESET [RESET TAB TO POINT TO THIS ENTRY 20 537B BRN ST16 [READ NEXT ENTRY IN THE DIRECTORY 4 53M2 # 19 546L # THE END OF THE DIRECTORY HAS BEEN REACHED: IF THE REQUIRED 20 54L= # ENTRANT HAS BEEN FOUND, IT IS PICKED UP FROM THE TAB SYSTEM 4 555W # 4 55KG ST25 9 5656 LDX 4 AWORK1(2) 19 56JQ BPZ 4 ST26 [J IF REQUIRED ENTRY FOUND 21 574B CLOSETOP [THE REQUIRED ENTRANT DOESN'T EXIST 20 57J2 MFREE ADATA,CREADL [SO FREE THE ADATA/CREADL BLOCK 18 583L MFREE CPB,CMULTI [AND THE NEW CPB/CMULTI 20 58?D ... JANAL OPENERR [J IF STILL PROCESSING COMMAND 21 58H= ERROR JDNODIR [REPORT ^DIRECTORY ENTRANT NOT FOUND^ 15 592W BRN OPENERR [AND GIVE UP 20 59GG ST26 TABULATE [SET READING POINTER TO DIR ENTRY 19 5=26 STEPAGAIN [TO GET THAT POINTER IN X3 8 5=FQ ST27 SBN 3 A1 19 5=_B MHUNT 1,ADATA,CREADL [FIND THE ADATA/CREADL BLOCK 9 5?F2 LDN 4 ELOC1(3) 9 5?YL LDN 5 A1+5(1) 19 5#D= MOVE 4 3 [LOCAL NAME INTO BUFFER BLOCK 9 5#XW LDX 4 EGEN(3) 17 5*CG STO 4 A1+9(1) [GENERATION NUMBER 9 5*X6 LDX 4 ELAN(3) 16 5BBQ STO 4 A1+10(1) [LANGUAGE CODE 4 5BWB # 17 5CB2 # NOW THAT THE INFORMATION TO BE OUTPUT HAS BEEN SET 17 5CTL # UP IN AN ADATA/CREADL BLOCK A COMMON ROUTINE MAY 13 5D*= # BE USED TO ASSEMBLE THE MESSAGE 4 5DSW # 5 5F#G OUTMESS 7 5FS6 CLOSETOP 11 5G?Q MHUNT 3,ADATA,CREADL 14 5GRB LDN 4 A1+2(3) [USERNAME 14 5H?2 LDN 5 3 [LENGTH 13 5HQL LDN 6 JPDUSERNAME [PDC 19 5J== CALL 7 XOUTPACK [SET UP ELEMENT IN GMON/ASET 11 5JPW MHUNT 3,ADATA,CREADL 15 5K9G LDN 4 A1+5(3) [LOCAL NAME 13 5KP6 LDN 6 JPDLOCNAME [PDC 19 5L8Q CALL 7 XOUTPACK [SET UP LOCAL NAME ELEMENT 11 5LNB MHUNT 3,ADATA,CREADL 15 5M82 LDN 4 A1+9(3) [GENERATION 7 5MML LDN 5 1 13 5N7= LDN 6 JPDGENNUM [PDC 18 5NLW CALL 7 XOUTPACK [SET UP GEN NO ELEMENT 11 5P6G MHUNT 3,ADATA,CREADL 16 5PL6 LDN 4 A1+10(3) [LANGUAGE CODE 13 5Q5Q LDN 6 JPDLANGUAGE [PDC 9 5QKB CALL 7 XOUTPACK 8 5R52 LDX 1 FX1 21 5RJL ASSMESS XDIRENTSP(1) [ASSEMBLE MESSAGE IN GMON/AOUT BLOCK 19 5S4= MFREE ADATA,CREADL [FREE THE ADATA/CREADL BLOCK 8 5SHW SMO FX2 18 5T3G LDX 7 AWORK2 [WAS AN ^*^ SPECIFIED? 14 5TH6 BZE 7 UP [J IF NOT 17 5W2Q MFREE CPB,CMULTI [THE NEW CPB/CMULTI 4 5W=J ...UP 10 5WGB ... VFREE FILE,ADJUNCTS 20 5WQ8 ... UPPLUS 3 [SUCCESSFUL RETURN TO SETPARAM 4 5X22 # 20 5XFL # SUBROUTINE TO SET UP A MESSAGE ELEMENT IN A GMON/ASET BLOCK 4 5X_= # 5 5YDW XOUTPACK 8 5YYG SBX 7 FX1 8 5_D6 OUTPACKX 4,5,6 8 5_XQ ADX 7 FX1 7 62CB EXIT 7 0 4 62X2 # 6 6348 ...NOTLIKELY 19 639B ... MFREE ADATA,CREADL [FREE THE ADATA/CREADL BLOCK 5 63BL STERR 10 63LD ... VFREE FILE,ADJUNCTS 21 63W= UP [COMMAND ERROR: ^EXPRESSION INVALID^ 4 64*W # 5 64TG ZBREAKIN 20 65*6 UPPLUS 2 [BREAK IN DETECTED BY FS ROUTINES 4 65SQ # 9 664J ... SEGENTRY G400DIRD 21 66#B NOTUSER [REPORT COMMAND ERROR: ^'DIRENT' NOT 9 66J8 ... JANAL OPENERR 19 66S2 ERROR JDWRONGUSER [ALLOWED IN NO-USER CONTEXT^ 15 67?L BRN OPENERR [AND GIVE UP 4 67R= # 20 67WB ...MAGTAPE [REPORT ^ENTIRELY THE WRONG TYPE^ 9 67XY ... JANAL OPENERR 20 67_G ... ERROR ERVRYWRONG [IF A MAGNETIC TAPE WAS SPECIFIED 15 684L ... BRN OPENERR [AND GIVE UP 4 687Q ...# 6 68MB ...#UNS G400 4 6972 ...( 4 69LL ...# 14 6=6= ...# THIS CODE IMPLEMENTS THE HOOK VERSION 4 6=KW ...# 9 6?5G ... SEGENTRY G400DIRB 5 6?K6 ...XDSK1 15 6#4Q ... MHUNT 3,CPB,CUNI [PARAMETER BLOCK 9 6#JB ... LDX 0 ANUM(3) 15 6*42 ... BZE 0 STERR [ERROR,NULL PARAM 17 6*HL ... BNG 0 STERR [ERROR,NONEXISTENT PARAM 9 6B3= ... LDCH 0 APARA(3) 8 6BGW ... SBN 0 #21 15 6C2G ... BZE 0 XDSK2 [ERROR-WORKFILE 16 6CG6 ... BRUSEN XDSKF [JIF NO-USER CONTEXT 13 6C_Q ... BRN XDSK3 [J ROUND 5 6DFB ...XDSKF 21 6DK? ... TESTHKN NOTUSER [MUST BE HOOKED FOR NO USER CONTEXT 9 6DP8 ... SEGENTRY G400DIRC 21 6DT5 ... NULL [BRN NOTUSER IF IHSPNOUSER OFF 10 6D_2 ... STOZ CPREFIX(2) 16 6FDL ... STOZ CPREFIX+1(2) [CLEAR CPREFIX AREA 10 6FY= ... STOZ CPREFIX+2(2) 5 6GCW ...XDSK3 10 6GXG ... NAMETOP 3,FILE,FNAME 13 6HC6 ... FNORM [NORMALISE 15 6HWQ ... TESTREPN OK,OPENERR [J IF FORMAT ERROR 10 6JBB ... MHUNT 3,FILE,FNAME 10 6JW2 ... NAMETOP 3,CPB,CUNI 15 6K*L ... STOZ AWORK1(2) [CLEAR MARKER WD 15 6KT= ... STOZ AWORK2(2) [CLEAR FOR OUTMESS 10 6L#W ... MHUNT 3,FILE,FABSNB 9 6LSG ... LDX 0 ATYPE(3) 7 6M#6 ... ADN 0 2 9 6MRQ ... STO 0 ATYPE(3) 8 6N?B ... ANDN 0 #1000 18 6NR2 ... SLL 0 13 [MOVE TO B1=NO USER SPECIFIED 17 6P=L ... ORS 0 AWORK1(2) [SAVE LOCAL NAME ONLY BIT 10 6PQ= ... LDX 0 ALOGLEN(3) 9 6Q9W ... SBX 0 HDREC(3) 7 6QPG ... SBN 0 2 13 6R96 ... BNG 0 XDSK4B [J NO TSN 10 6RNQ ... SMO ALOGLEN(3) 9 6S8B ... LDX 0 A1-1(3) 9 6SN2 ... BPZ 0 XDSK16 9 6T7L ... JANAL OPENERR 9 6TM= ... ERROR ERXENOSER 9 6W6W ... BRN OPENERR 5 6WLG ...XDSK16 8 6X66 ... LDX 0 GSIGN 16 6XKQ ... ORS 0 AWORK1(2) [SAVE TSN SPEC'D BIT 10 6Y5B ... SMO ALOGLEN(3) 9 6YK2 ... LDX 0 A1-8(3) 8 6_4L ... BNZ 0 XDSK4 10 6_J= ... LDX 0 TWOBITS(1) 9 723W ... ORS 0 AWORK1(2) 8 72HG ... BRN XDSK4 5 7336 ...XDSK4B 9 73GQ ... LDX 0 A1+1(3) 8 742B ... BZE 0 STERR 5 74G2 ...XDSK4 9 74_L ... LDX 0 AWORK1(2) 7 75F= ... SLC 0 1 8 75YW ... BNG 0 XDSK5 7 76DG ... FINDNAME 9 76Y6 ... TESTREP OK,XDSK4A 9 77CQ ... JANAL OPENERR 7 77XB ... REPALLER 9 78C2 ... BRN OPENERR 5 78WL ...XDSK4A 10 79B= ... MHUNT 3,FILE,FABSNB 5 79TW ...XDSK5 14 7=*G ... BRUSEN XDSK6 [J IF NOUSER 8 7=T6 ... BRN XDSK7 5 7?#Q ...XDSK6 9 7?SB ... LDX 0 AWORK1(2) 8 7##2 ... BNG 0 XDSK7 7 7#RL ... SLC 0 1 14 7*?= ... BNG 0 STERR [FORMAT ERROR 5 7*QW ...XDSK7 9 7B=G ... LDX 0 AWORK1(2) 15 7BQ6 ... BPZ 0 XDSK8 [NOT MT WITH TSN 10 7C9Q ... SMO ALOGLEN(3) 13 7CPB ... LDX 4 A1-1(3) [LOAD TSN 12 7D92 ... OPENSYS ZBREAKIN,SERIAL,READ 16 7DNL ... SSEARCH XDSK9,4 [FIND RECORD IN SERIAL 8 7F8= ... LDX 6 5(3) 7 7FMW ... SLC 6 3 17 7G7G ... BNG 6 XDSK10 [ERROR = NAMED WORKE TAPE 16 7GM6 ... LDX 5 2(3) [FIRST WD OF USERNAME 15 7H6Q ... BZE 5 XDSK11 [POOL OR WORK TAPE 14 7HLB ... LDX 6 3(3) [REST OF ... 13 7J62 ... LDX 7 4(3) [USERNAME 10 7JKL ... MHUNT 3,FILE,FABSNB 9 7K5= ... LDX 0 AWORK1(2) 7 7KJW ... SLC 0 1 16 7L4G ... BNG 0 XDSK12 [USER NAME NOT GIVEN 9 7LJ6 ... LDX 0 HDREC(3) 8 7M3Q ... SBN 0 12 9 7MHB ... BPZ 0 XDSK15 7 7N32 ... LDN 0 0 5 7NGL ...XDSK15 7 7P2= ... ADX 3 0 18 7PFW ... TXU 5 A1+1(3) [COMPARE SERIAL AND SPECIFIED 14 7P_G ... TXU 6 A1+2(3) [USER NAMES 9 7QF6 ... TXU 7 A1+3(3) 15 7QYQ ... BCC XDSK8 [J IF NAMES AGREE 7 7RDB ... CLOSETOP 9 7RY2 ... JANAL OPENERR 14 7SCL ... ERROR ERDISAGREE [REPORT ERROR 9 7SX= ... BRN OPENERR 5 7TBW ...XDSK12 16 7TWG ... STO 5 HDREC+1(3) [REPLACE USER NAME 10 7WB6 ... STO 6 HDREC+2(3) 10 7WTQ ... STO 7 HDREC+3(3) 5 7X*B ...XDSK8 21 7XT2 ... BRUSEN XDSK8A [NO TRAP CHECKING IF NO USER CONTEXT 10 7_RG ... MHUNT 3,FILE,FABSNB 18 82?6 ... LDX 7 HDREC(3) [PICK UP THE BLOCK LENGTH 21 82QQ ... SBN 7 11 [IF IT'S LESS THAN 10 : TOP OF TREE 21 83=B ... BNG 7 XDTC4 [J IF TOP OF FILESTORE TREE REACHED 7 83Q2 ... NGN 4 6 20 849L ... ADS 4 HDREC(3) [REDUCE BLOCK LENGTH BY 6 WORDS 20 84P= ... LDX 4 ATYPE(3) [RESET ATYPE WORD SO THAT GETDIR 19 858W ... DSA 4 AWORK1(2) [DOSN'T GET CONFUSED THINKING 19 85NG ... ANDN 4 #5700 [IT SHOULD BE LOOKING FOR A 16 8686 ... DSA 4 ATYPE(3) [MAGNETIC TAPE 21 86MQ ... OPENDIR ZBREAKIN,READ,QUERY [OPEN CURRENT DIRECTORY'S DIRECTORY 18 877B ... TESTREP OK,XDTC2 [J IF DIRECTORY OPENED OK 9 87M2 ... JANAL OPENERR 18 886L ... REPALLER [REPORT THE COMMAND ERROR 15 88L= ... BRN OPENERR [AND GIVE UP 5 895W ...XDTC2 17 89KG ... TRAPOPEN READ [ARE READ TRAPS OPEN? 14 8=56 ... TESTREP OKAY,XDTC3 [J IF SO 20 8=JQ ... LDCT 4 #100 [REMEMBER THAT READ TRAPS TO THE 20 8?4B ... SMO FX2 [DIRECTORY ARE CLOSED AND WE MUST 20 8?J2 ... ORS 4 AWORK1 [CHECK TRAPS ON THE FILE ITSELF 5 8#3L ...XDTC3 17 8#H= ... CLOSETOP [CLOSE THE DIRECTORY 19 8*2W ... MHUNT 3,FILE,FABSNB [FIND THE FILE/FABSNB BLOCK 21 8*GG ... LDN 4 6 [INCREMENT RECORD HEADER BY 6 WORDS 20 8B26 ... ADS 4 HDREC(3) [BLOCK NOW REFERS TO THE ENTRANT 20 8BFQ ... LDX 4 AWORK1(2) [REINSTATE ORIGINAL ATYPE SETTING 19 8B_B ... DSA 4 ATYPE(3) [TO ALLOW FOR MAGNETIC TAPES 5 8CF2 ...XDTC4 5 8CYL ...XDSK8A 16 8DD= ... OPENDIR ZBREAKIN,READ,QUERY [ GET DIR ENTRY 9 8DXW ... TESTREPN OK,XDTC6 5 8FCG ...XDTC7 21 8FX6 ... BRUSEN XDSK14 [NO TRAP CHECKING IF NO USER CONTEXT 9 8GBQ ... LDX 4 AWORK1(2) 7 8GWB ... SLL 4 2 21 8HB2 ... BPZ 4 XDSK14 [J IF NO MORE TRAP CHECKING NEEDED 7 8HTL ... CHECKTRAPS 10 8J*= ... LDX 0 ACOMMUNE7(2) 9 8JSW ... BNZ 0 XDSK14 9 8K#G ... SETREP NOTRAP 9 8KC5 ... JANAL XDSK17A 9 8KFN ... BRN XDTC6A 5 8KJ? ...XDSK17A 7 8KLW ... CLOSETOP 9 8KPF ... BRN XDSK17 5 8KS6 ...XDTC6 9 8L?Q ... JANAL XDSK17 5 8LHJ ...XDTC6A 15 8LRB ... REPALLER [REPORT ERRORS 5 8M?2 ...XDSK17 9 8N== ... LDX 0 AWORK1(2) 9 8NPW ... BPZ 0 OPENERR 7 8P9G ... CLOSETOP 9 8PP6 ... BRN OPENERR 5 8Q8Q ...XDSK14 11 8QNB ... SETNCORE 13,4,ADATA,CREADL 10 8R82 ... MHUNT 3,FILE,FABSNB 8 8RML ... LDN 0 40 7 8S7= ... SMO 4 16 8SLW ... STO 0 A1 [CHAR CT FOR FILES 9 8T6G ... LDX 6 HDREC(3) 8 8TL6 ... SBN 6 12 9 8W5Q ... BPZ 6 XDSK13 7 8WKB ... LDN 6 0 5 8X52 ...XDSK13 7 8XJL ... SMO 6 17 8Y4= ... LDN 6 A1+1(3) [POINTER TO USER NAME 7 8YHW ... LDX 7 4 8 8_3G ... ADN 7 A1+2 16 8_H6 ... MOVE 6 3 [MOVE IN USER NAME 15 922Q ... ADN 7 3 [UPDATE POINTER 10 92GB ... MHUNT 3,FILE,ENT 9 9322 ... LDN 6 ELOC1(3) 15 93FL ... MOVE 6 5 [MOVE LOCAL NAME 9 93_= ... LDX 0 ELAN(3) 7 94DW ... SMO 7 7 94YG ... STO 0 5 9 95D6 ... LDX 0 ESER(3) 15 95XQ ... BZE 0 OUTMESS [ASSEMBLE O/P 7 96CB ... SMO 7 14 96X2 ... STO 0 6 [STORE TSN 7 97BL ... LDN 0 4 7 97W= ... SMO 4 15 98*W ... ADS 0 A1 [UPDATE COUNT 5 98TG ...OUTMESST 14 99*6 ... CLOSETOP [DIRECTORY 9 99SQ ... LDX 0 AWORK1(2) 9 9=#B ... BPZ 0 OUTMST1 6 9=S2 ...OUTMESSTA 13 9??L ... CLOSETOP [SERIAL 5 9?R= ...OUTMST1 11 9#=W ... MHUNT 3,ADATA,CREADL 14 9#QG ... LDN 4 A1+2(3) [USERNAME 14 9*=6 ... LDN 5 3 [LENGTH 13 9*PQ ... LDN 6 JPDUSERNAME [PDC 19 9B9B ... CALL 7 XOUTPACK [SET UP ELEMENT IN GMON/ASET 11 9BP2 ... MHUNT 3,ADATA,CREADL 15 9C8L ... LDN 4 A1+5(3) [LOCAL NAME 13 9CN= ... LDN 6 JPDLOCNAME [PDC 19 9D7W ... CALL 7 XOUTPACK [SET UP LOCAL NAME ELEMENT 11 9DMG ... MHUNT 3,ADATA,CREADL 15 9F76 ... LDN 4 A1+9(3) [GENERATION 7 9FLQ ... LDN 5 1 13 9G6B ... LDN 6 JPDGENNUM [PDC 18 9GL2 ... CALL 7 XOUTPACK [SET UP GEN NO ELEMENT 11 9H5L ... MHUNT 3,ADATA,CREADL 13 9HK= ... LDN 4 A1+8(3) [REEL 7 9J4W ... LDN 5 1 14 9JJG ... LDN 6 JPDREELNUM [PDC NAME 9 9K46 ... CALL 7 XOUTPACK 11 9KHQ ... MHUNT 3,ADATA,CREADL 9 9L3B ... LDN 4 A1+11(3) 7 9LH2 ... LDN 5 2 9 9M2L ... LDN 6 JPDTSN 9 9MG= ... CALL 7 XOUTPACK 8 9M_W ... LDX 1 FX1 10 9NFG ... ASSMESS XDIRENTMSP(1) 10 9N_6 ... MFREE ADATA,CREADL 8 9PDQ ... BRN UP 4 9PYB ...# 10 9QD2 ...# VARIOUS SPECIAL CASES 5 9QXL ...XDSK9 13 9RC= ... CLOSETOP [SERIAL 9 9RWW ... JANAL OPENERR 9 9SBG ... ERROR ERUNKNOWN 13 9SW6 ... BRN OPENERR [EXIT 5 9T*Q ...XDSK10 15 9TTB ... CLOSETOP [NAMED WORKTAPE 8 9W*2 ... BRN XDSK2 5 9WSL ...XDSK11 16 9X#= ... CLOSETOP [POOL OR WORK TAPE 11 9XRW ... SETNCORE 13,7,ADATA,CREADL 8 9Y?G ... LDN 0 44 7 9YR6 ... SMO 7 8 9_=Q ... STO 0 A1 7 9_QB ... SRC 6 2 14 =2=2 ... BNG 6 WORK [WORK TAPE 9 =2PL ... LDN 6 XPOOL(1) 5 =39= ...XDSK11A 13 =3NW ... ADN 7 A1+2 [POINTER 7 =48G ... MOVE 6 3 7 =4N6 ... ADN 7 3 17 =57Q ... LDN 6 XPWLOC(1) [PSEUDO=LOCAL NAME 7 =5MB ... MOVE 6 6 7 =672 ... SMO 7 13 =6LL ... STO 4 6 [TSN 9 =76= ... BRN OUTMST1 4 =7KW ...WORK 9 =85G ... LDN 6 XWORK(1) 9 =8K6 ... BRN XDSK11A 4 =94Q ...) 4 =9JB ...#END 6 ____ ...666167440003