DIRENT867

(George Source)

Macros used: ASSMESS, BITDEFS, BRUSEN, BXE, CLOSETOP, ERROR, FINDNAME, FNORM, JANAL, JBS, MFREE, MHUNT, NAMETOP, NEXTENT3, OPENDIR, OPENSYS, OUTMESS, OUTPACKX, PARALYSE, READ, REPALLER, SEGENTRY, SETNCORE, SETREP, SETUPTAB, SPARAPAS, SSEARCH, STEP, STEPAGAIN, TABRESET, TABSET, TABULATE, TESTHKN, TESTHOOK, TESTREP, TESTREP2, TRACE, TRAPOPEN, UP, UPPLUS, USEROPEN, VFREE

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