home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / d / k10wld.mac < prev    next >
Text File  |  2020-01-01  |  36KB  |  1,069 lines
  1.     TITLE    KERWLD - Wild card processing for KERMIT-10 under TOPS-10
  2.     SUBTTL    Robert C McQueen        22-June-1983
  3.  
  4. ; Universals
  5.  
  6.     SEARCH    GLXMAC            ; Galaxy library
  7.     SEARCH    KERUNV            ; Kermit definitions
  8.  
  9. ; Directives
  10.  
  11.     .DIRECT    FLBLST            ; List first line of binary only
  12.     SALL                ; Suppress macro expansions
  13.     PROLOG    (KERWLD)        ; Generate the prologue
  14.  
  15.   ; Version number
  16.  
  17.     WLDVER==3            ; Major version number
  18.     WLDMIN==0            ; Minor version number
  19.     WLDEDT==124            ; Edit level
  20.     WLDWHO==0            ; Customer edit
  21.  
  22. TOPS20<    END>                ; Quick end for the -20
  23.  
  24.     TWOSEG    400K            ; Two segment code
  25.     SUBTTL    Table of Contents
  26.  
  27. ;+
  28. ;.pag.lit
  29. ;                          Table of Contents of KERWLD
  30. ;
  31. ;
  32. ;                                    Section                             Page
  33. ;   1.   Table of Contents. . . . . . . . . . . . . . . . . . . . . . . .   2
  34. ;   2.   Revision History . . . . . . . . . . . . . . . . . . . . . . . .   3
  35. ;   3.   Main routine . . . . . . . . . . . . . . . . . . . . . . . . . .   4
  36. ;   4.   File found - Fill in the user data . . . . . . . . . . . . . . .   9
  37. ;   5.   OPNDIR - Open the current directory if needed. . . . . . . . . .  10
  38. ;   6.   NXTBLK - Routine to advance to the next block of the directory .  11
  39. ;   7.   REREAD - Reread the current directory block. . . . . . . . . . .  12
  40. ;   8.   RDBLK - Routine to read a directory block. . . . . . . . . . . .  13
  41. ;   9.   Initialization routine . . . . . . . . . . . . . . . . . . . . .  14
  42. ;   10.  DIRECTORY SUBROUTINES. . . . . . . . . . . . . . . . . . . . . .  15
  43. ;   11.  STRUCTURE SUBROUTINES. . . . . . . . . . . . . . . . . . . . . .  17
  44. ;   12.  Logical Name Subroutines
  45. ;      12.1.   .INILN - Initialize logical name . . . . . . . . . . . . .  22
  46. ;      12.2.   .NXTLN - Set up for the next name. . . . . . . . . . . . .  23
  47. ;   13.  USEFUL SUBROUTINES . . . . . . . . . . . . . . . . . . . . . . .  24
  48. ;   14.  TOPS-10 error codes. . . . . . . . . . . . . . . . . . . . . . .  27
  49. ;   15.  End of KERWLD. . . . . . . . . . . . . . . . . . . . . . . . . .  29
  50. ;
  51. ;.end lit.pag
  52. ;-
  53.     SUBTTL    Revision History
  54.  
  55. COMMENT    |
  56.  
  57.  
  58. 116    By: Nick Bush        On: 14-March-1984
  59.     Add parsing for all REMOTE commands.
  60.     Add support for some generic and local commands.
  61.     Fix wild card processing to handle pathological names correctly.
  62.     Modules: KERMIT,KERSYS,KERWLD
  63.  
  64. 120    By: Robert C. McQueen        On: 28-March-1984
  65.     Add bug fixes from WMU.  Many thanks to the people out in Kalamazoo.
  66.     Modules: KERMIT,KERWLD
  67.  
  68. 121    By: Robert C. McQueen        On: 28-March-1984
  69.     Add SET PROMPT command.  Start adding support for generic COPY and
  70.     RENAME commands.
  71.     Modules: KERUNV,KERMIT,KERWLD
  72.  
  73. 124    By: Robert C. McQueen        On: 8-May-1984
  74.     Fix KERMIT-10's handling of remote directories
  75.     Modules: KERWLD
  76.  
  77. Start of Version 3(124)
  78. |
  79.     SUBTTL    Secondary wildcard routine
  80.  
  81. ;+
  82. ;.hl1 SECWLD
  83. ;This routine is used to fill wild card information into a secondary
  84. ;file specification.
  85. ;.literal
  86. ;
  87. ; Usage:
  88. ;    MOVEI    S1,Length
  89. ;    MOVEI    S2,Address of argument block
  90. ;    PUSHJ    P,SECWLD
  91. ;    (Return)
  92. ;
  93. ;--
  94.  
  95.     ENTRY    SECWLD
  96.  
  97. SECWLD:    $SAVE    <S1,S2>            ; Save the arguments
  98.     $SAVE    <P1>            ; Save this register also
  99.  
  100. ; First check and copy the arguments
  101.  
  102.     CAIE    S1,$LKLEN        ; Correct size?
  103.      $RETF                ; No, incorrect size
  104.     MOVEM    S2,SECBLK        ; Save address of argument
  105.     LOAD    S1,$LKFLP(S2),LK$FLP    ; Get the FILOP. block address
  106.     MOVEM    S1,SECFLP        ; Store it
  107.     LOAD    S1,$LKFLP(S2),LK$FLN    ; Get the length
  108.     MOVEM    S1,SECFLN        ; Store it too
  109.     MOVE    S1,$LKFLG(S2)        ; Get the flags
  110.     MOVEM    S1,SECFLG        ; Store the flags
  111.     LOAD    S1,$LKFDB(S2)        ; Get the .FD block address
  112.     LOAD    S2,.FDLEN(S1),FD.LEN    ; Get the length of the .FD block
  113.     CAIE    S2,.FDSIZ        ; Right size?
  114.       $RETF                ; No, error return
  115.     LOAD    S2,.FDLEN(S1),FD.TYP    ; Get the type
  116.     CAIE    S2,.FDNAT        ; Native file specification?
  117.       $RETF                ; No, error
  118.  
  119. ; At this point the arguments have been validated.
  120.  
  121.     $RETF                ; For now
  122.     SUBTTL    Main routine
  123.  
  124. ;+
  125. ;.hl1 LOKWLD
  126. ;This routine will look for a wild carded file specification on the
  127. ;specified directory.
  128. ;.literal
  129. ;
  130. ; Usage:
  131. ;    MOVEI    S1,Length
  132. ;    MOVEI    S2,Address of argument block
  133. ;    PUSHJ    P,LOKWLD
  134. ;    (Return)
  135. ;
  136. ; On a true return:
  137. ;    - Found file, information stored
  138. ;
  139. ; On a false return:
  140. ;    - File not found.  Error text in low segment area.
  141. ;
  142. ;
  143. ;.end literal
  144. ;-
  145.  
  146.     ENTRY    LOKWLD            ; Entry point into this module
  147.  
  148. LOKWLD:    $SAVE    <S1,S2>            ; Save the arguments
  149.     $SAVE    <P1>            ; Save P1 also
  150.  
  151. ; First check and copy the arguments
  152.  
  153.     CAIE    S1,$LKLEN        ; Correct size?
  154.      $RETF                ; No, incorrect size
  155.     MOVEM    S2,ARGBLK        ; Save address of argument
  156.     LOAD    S1,$LKFLP(S2),LK$FLP    ; Get the FILOP. block address
  157.     MOVEM    S1,ARGFLP        ; Store it
  158.     LOAD    S1,$LKFLP(S2),LK$FLN    ; Get the length
  159.     MOVEM    S1,ARGFLN        ; Store it too
  160.     MOVE    S1,$LKFLG(S2)        ; Get the flags
  161.     MOVEM    S1,ARGFLG        ; Store the flags
  162.     LOAD    S1,$LKFDB(S2)        ; Get the .FD block address
  163.     LOAD    S2,.FDLEN(S1),FD.LEN    ; Get the length of the .FD block
  164.     CAIE    S2,.FDSIZ        ; Right size?
  165.       $RETF                ; No, error return
  166.     LOAD    S2,.FDLEN(S1),FD.TYP    ; Get the type
  167.     CAIE    S2,.FDNAT        ; Native file specification?
  168.       $RETF                ; No, error
  169.     HRLI    S1,FDB            ; Place to store the information
  170.     MOVSS    S1            ; Move to correct places
  171.     BLT    S1,FDB+.FDSIZ-1        ; Move all the information
  172.  
  173. ; Now set up the initial depth and other information
  174.  
  175.     MOVX    S1,LK$FRS        ; First time?
  176.     TDNN    S1,ARGFLG        ; . . .
  177.       JRST    RESTART            ; Continue processing
  178.     MOVEI    S1,ZERLEN        ; Get the length
  179.     MOVEI    S2,ZERBEG        ; Start of the area to clear
  180.     $CALL    .ZCHNK            ; Clear it
  181.     $CALL    LOKINI            ; Initialize the data base
  182.     $CALL    .INILN            ; Initialize the logical name processing
  183.  
  184.     MOVE    T1,FDB+.FDSTR        ; Get the structure
  185.     SETZ    T2,            ; Clear this
  186.     $CALL    .INIST            ; Initialize the structure scanning
  187.     $CALL    .NXSTR            ; Set up the first structure
  188. ; Here to set the initial path that will be looked at in this
  189. ; structure.  This is done after each scan of a structure.
  190.  
  191. LOKW.0:    XMOVEI    P1,FDB            ; Point to the structure
  192.     $CALL    SETDIR            ; Set up the directory defaults
  193.     MOVSI    S1,-<D$MSFD+1>        ; Build the AOBJx pointer
  194.     SETZ    T1,            ; Clear the counter
  195. LOKW.1:    MOVE    S2,FDB+.FDPPN(S1)    ; Get the PPN
  196.     JUMPE    S2,LOKW.2        ; Finished?
  197.     AND    S2,FDB+.FDDIM(S1)    ; Mask it
  198.     CAME    S2,FDB+.FDPPN(S1)    ; Same?
  199.      JRST    LOKW.2            ; No, finished
  200.     MOVEM    S2,DPTH+.PTPPN(S1)    ; Store the device
  201.     AOJ    T1,            ; Count the levels
  202.     AOBJN    S1,LOKW.1        ; Loop for all levels
  203. LOKW.2:    SUBI    T1,1            ; Decrement the index
  204.     MOVEM    T1,TOP            ; Get the current level    
  205.     MOVEM    T1,DEPTH        ; Store the depth we are at
  206.     JRST    REST.1            ; Start up again
  207.  
  208.  
  209. ; Now open the directory and set up the pointers correctly
  210. ;
  211. ; Register usage:
  212. ;
  213. ;    T1 - AOBJx pointer into the data block
  214.  
  215. RESTART:
  216.     MOVE    T1,DEPTH        ; Get the depth we are working at
  217.     SKIPN    DIRCHN(T1)        ; Have a channel open?
  218.       $RETF                ; No, give a failure return
  219.                     ;  This catches the case of calling
  220.                     ;  LOKWLD after we have processed
  221.                     ;  the last block of the UFD
  222.     JRST    REST.2            ; Continue processing
  223.  
  224. REST.1:    SKIPN    DIRCHN(T1)        ; Have a channel for this level?
  225.       JRST    REST.0            ; Have to open the directory
  226.  
  227. REST.2:    MOVE    T1,DIRIDX(T1)        ; Reset the index into the block
  228.     MOVX    S1,LK$SFD        ; Ignoring directories?
  229.     TDNE    S1,ARGFLG        ; . . .
  230.       JRST    NXTFIL            ; Advance to the next file
  231.     JRST    TRYDIR            ; Check to make sure we don't skip
  232.                     ;  the directory we may have passed back
  233. REST.0:    $CALL    OPNDIR            ; Open the current level and set up
  234.                     ;  pointers
  235.     JUMPF    NXTDIR            ; Try for the level above this one
  236.                     ;  if there is one
  237.  
  238. FILELP:    SKIPN    S1,(T1)            ; Get the file name
  239.       JRST    NXTFIL            ; No entry, skip it then
  240.     XOR    S1,FDB+.FDNAM        ; XOR with the name
  241.     TDNE    S1,FDB+.FDNMM        ; Is this it?
  242.       JRST    NXTFIL            ; No, advance to the next entry
  243.     HLLZ    S1,1(T1)        ; Get the extension
  244.     XOR    S1,FDB+.FDEXT        ; XOR with what was given
  245.     TDNE    S1,FDB+.FDEXM        ; Is this ok?
  246.       JRST    NXTFIL            ; No, try for the next
  247.  
  248. ; We now have a file that we are going to pass back.  Check to see if this is
  249. ; a directory and if we are allowed to pass it back.
  250.  
  251.     HLRZ    S1,1(T1)        ; Get the extension
  252.     MOVX    S2,LK$SFD        ; Allowed to pass it back?
  253.     CAIE    S1,'UFD'        ; UFD?
  254.      CAIN    S1,'SFD'        ; Or Sub File Directory?
  255.       TDNE    S1,ARGFLG        ; Directory, allowed to pass back?
  256.     JRST    FOUND            ; Not directory or allowed to pass back
  257.  
  258. ; Now check to see if it is directory and if we must search it also
  259.  
  260. TRYDIR:    HLRZ    S2,1(T1)        ; Get the extension
  261.     CAIE    S2,'UFD'        ; Is this a UFD?
  262.      CAIN    S2,'SFD'        ;  Or subfile directory?
  263.       JRST    FNDDIR            ; Found a directory
  264. ; Here to advance to the next entry in a directory
  265.  
  266. NXTFIL:    AOJ    T1,            ; Point past the file name
  267.     AOBJN    T1,FILELP        ; Loop for all files in the directory
  268.     $CALL    NXTBLK            ; Get the next directory block
  269.     JUMPT    FILELP            ; Loop for the file
  270.  
  271. ; Here if there are no more files in the correct directory, attempt to
  272. ; go up a level
  273.  
  274. NXTDIR:    MOVE    T1,DEPTH        ; Get the current depth
  275.     CAMN    T1,TOP            ; At the top?
  276.       JRST    STRLOP            ; Yes, try the next structure
  277.  
  278.     SOS    DEPTH            ; Decrement the depth
  279.     $CALL    REREAD            ; Reread the directory block
  280.     JRST    NXTFIL            ; And continue in the file processing
  281.  
  282. STRLOP:    $CALL    .NXSTR            ; Advance to the next structure
  283.     JUMPT    LOKW.0            ; Open the directory and go
  284.  
  285. ; Here if we have run out of structures, attempt the next logical name if we
  286. ; are doing logical name processing
  287.  
  288.     SKIPN    LNMFLG            ; Doing logical names?
  289.       JRST    DONE            ; No, finished
  290.     $CALL    .NXTLN            ; Advance to the next
  291.     JUMPT    LOKW.0            ; Set up to open the directory
  292.  
  293. ; Here if no more structures or logical names and we have finished reading the
  294. ; directory.
  295.  
  296. DONE:    $RETF                ; Give a a failure return to the caller
  297. ; Here if we have found a file directory in the directory we are currently
  298. ; scanning.  We must determine if we are allowed to go into this directory
  299. ; to look for files or it we must just skip it and do the normal file checks.
  300.  
  301.  
  302. FNDDIR:    MOVE    S1,DEPTH        ; Get the level we are at
  303.     SKIPN    S2,FDB+.FDPAT(S1)    ; Get the directory the user supplied
  304.       JRST    NXTFIL            ; Doesn't want this level
  305.     XOR    S2,(T1)            ; XOR with the given name
  306.     TDNE    S2,FDB+.FDSFM(S1)    ; Ok?
  307.       JRST    NXTFIL            ; No, advance to the next directory entry
  308.  
  309. ; Here if we must advance to the next level in the directory
  310. ; processing.
  311.  
  312.     MOVEM    T1,DIRIDX(S1)        ; Save for later
  313.     MOVE    S2,(T1)            ; Get the name again
  314.     MOVEM    S2,DPTH+.PTSFD(S1)    ; Store the information
  315.     AOS    DEPTH            ; One lower in the tree
  316.     $CALL    OPNDIR            ; Open the directory
  317.     JUMPT    FILELP            ; Got the directory
  318.     SOS    T1,DEPTH        ; Back out the depth we are at
  319.     SETZM    DPTH+.PTSFD(S1)        ; Clear what we just stored
  320.     MOVE    T1,DIRIDX(T1)        ; Get the index we stored
  321.     JRST    NXTFIL            ; And advance to the next file
  322.     SUBTTL    File found - Fill in the user data
  323.  
  324. ; Enter here with:
  325. ;
  326. ;    T1 - Address of the entry in the directory of the file
  327.  
  328. FOUND:    MOVE    S2,DEPTH        ; Get the depth we are at
  329.     MOVEM    T1,DIRIDX(S2)        ; Store the index
  330.     MOVE    T2,ARGFLP        ; Get the FILOP. block address
  331.     MOVE    T3,.FOLEB(T2)        ; Get the address of the LOOKUP block
  332.     DMOVE    S1,(T1)            ; Get the file information
  333.     MOVEM    S1,.RBNAM(T3)        ; Store the name
  334.     HLLZM    S2,.RBEXT(T3)        ; Store the extension
  335.     SKIPN    S1,LASSTR        ; Get the last structure name
  336.      MOVE    S1,FDB+.FDSTR        ; Get the device
  337.     MOVEM    S1,.FODEV(T2)        ; Store the device name
  338.     MOVE    S2,.RBPPN(T3)        ; Get the address of the PATH. block
  339.     MOVEI    S2,.PTPPN(S2)        ; Point to the first place
  340.     HRLI    S2,DPTH+.PTPPN        ; Point to the PPN we are using
  341.     HRRI    S1,.PTMAX-.PTSFD(S2)    ; End point
  342.     BLT    S2,(S1)            ; Move the data
  343.     MOVE    S1,ARGBLK        ; Point at original argument block
  344.     LOAD    S1,$LKFDB(S1)        ; Get FDB address we were called with
  345.     HRLI    S1,FDB            ; Set up to copy current data back
  346.     MOVEI    S2,(S1)            ; Get copy of destination address
  347.     BLT    S1,.FDSIZ-1(S2)        ; Copy entire FDB back to user
  348.     $RETT                ; Give a good return
  349.     SUBTTL    OPNDIR - Open the current directory if needed
  350.  
  351. ; OPNDIR - This routine will open the current directory to read information
  352. ; if needed.  It will return with the pointer to the current block set up
  353. ; in T1 and the channel stored into the DIRCHN block indexed by the
  354. ; depth we are currently at.  The current block we are reading will be stored
  355. ; in DIRBLK.
  356.  
  357.  
  358. OPNDIR:    $CALL    SETOPN            ; Set up the FILOP. block
  359.     MOVE    T1,DEPTH        ; Get the depth we are working at
  360.     MOVX    S1,FO.ASC!FO.PRV!.FORED    ; Get the function and other bits
  361.     MOVEM    S1,DFLP+.FOFNC        ; Store the function info
  362.     MOVEI    S1,DLEB            ; Point to the LOOKUP/ENTER block
  363.     MOVEM    S1,DFLP+.FOLEB        ; Store it
  364.     SETZM    DFLP+.FOBRH        ; No buffer headers
  365.     SETZM    DFLP+.FONBF        ; No buffers
  366.     MOVE    S2,DPTH+.PTPPN(T1)    ; Get the thing
  367.     MOVEM    S2,DLEB+.RBNAM        ; Store as the name
  368.     SETZM    DPTH+.PTPPN(T1)        ; Clear this
  369.     JUMPN    T1,OPND.0        ; What we are looking for ?
  370.     MOVE    S1,MFDPPN        ; Get the MFD PPN
  371.     MOVEM    S1,DPTH+.PTPPN        ; Store as the PPN
  372.     SETZM    S1,DPTH+.PTSFD        ; Clear the first SFD
  373.     SKIPA    S1,[SIXBIT /UFD/]    ; Get the other directory
  374. OPND.0:    MOVX    S1,<SIXBIT /SFD/>    ; SFDs
  375.     MOVEM    S1,DLEB+.RBEXT        ; Store in the extension
  376.     MOVEI    S1,DPTH            ; Get the path
  377.     MOVEM    S1,DLEB+.RBPPN        ; Store it
  378.     MOVX    S1,.RBMAX        ; Get the length
  379.     MOVEM    S1,DLEB+.RBCNT        ; Store it
  380.     MOVE    S1,[XWD .FOMAX,DFLP]    ; Point to the argument block
  381.     FILOP.    S1,            ; Do it
  382.       JRST    OPND.1            ; Failed, determine why
  383.     MOVEM    S2,DPTH+.PTPPN(T1)    ; Store the depth back
  384.     LOAD    S1,DFLP+.FOFNC,FO.CHN    ; Get the channel number
  385.     MOVEM    S1,DIRCHN(T1)        ; Store the channel number
  386.     SETZM    DIRBLK(T1)        ; Clear the block we are processing
  387.     $CALL    NXTBLK            ; Read a block
  388.     $RETIT                ; Return if this worked
  389.  
  390. ; Now to back out of opening the directory
  391.  
  392.     MOVE    T1,DEPTH        ; Get the current depth
  393.     SETZ    S1,            ; Clear this
  394.     EXCH    S1,DIRCHN(T1)        ; Get the channel we just opened
  395.     RESDV.    S1,            ; Make this go away
  396.     $RET                ; Pass back the false return
  397.  
  398. ; Here if there was an error attempting to open the directory.
  399.  
  400. OPND.1:    MOVEM    S2,DPTH+.PTPPN(T1)    ; Store the thing we just opened back
  401.     LOAD    S2,DFLP+.FOFNC,FO.CHN    ; Get the channel if one was assigned
  402.     RESDV.    S2,            ; Get rid of it
  403.       JFCL                ; Don't care about error returns
  404.     $RETF                ; Give a failure return
  405.     SUBTTL    NXTBLK - Routine to advance to the next block of the directory
  406.  
  407. ; NXTBLK - This routine will advance to the next block of the directory.  It
  408. ; will return false when the end of the current directory is reached.  It will
  409. ; release the channel for the directory and clear any other directory 
  410. ; information.
  411.  
  412.  
  413. NXTBLK:    MOVE    S1,DEPTH        ; Get the depth
  414.     AOS    S1,DIRBLK(S1)        ; Increment the block
  415.     $CALL    RDBLK            ; Read the specified block
  416.     $RETIF                ; Return if that fails
  417.     MOVX    T1,<XWD -<D$BLKS/2>,DIR> ; Point to the information
  418.     $RETT                ; Give a good return to the caller
  419.     SUBTTL    REREAD - Reread the current directory block
  420.  
  421. ; This routine is used when the directory scanning is backing out of a
  422. ; lower level directory to this level.  We have to reread the current block
  423. ; so that we can pick up where we were scanning.
  424.  
  425. REREAD:    MOVE    S1,DEPTH        ; Get the current depth
  426.     MOVE    S1,DIRBLK(S1)        ; Get the directory block
  427.     $CALL    RDBLK            ; Read the directory block
  428.     $RETIF                ; Pass back errors
  429.     MOVE    S1,DEPTH        ; Get the depth again
  430.     MOVE    T1,DIRIDX(S1)        ; Get the index
  431.     $RETT                ; Give a good return
  432.     SUBTTL    RDBLK - Routine to read a directory block
  433. ;
  434. ; This routine will read a block from the current directory.  This routine
  435. ; assumes that the directory will already be open.
  436. ;
  437. ; Usage:
  438. ;    S1/ Block number to read
  439. ;    $CALL    RDBLK
  440. ;    (Return)
  441. ;
  442. ; On a false return:
  443. ;    EOF or reading error
  444. ;
  445. ; On a true return:
  446. ;    Directory block read
  447.  
  448. RDBLK:    MOVEM    S1,DFLP+.FOFNC+1    ; Store the block number
  449.     MOVE    S1,DEPTH        ; Get the depth that we are at
  450.     ZERO    DFLP+.FOFNC        ; Clear the function word
  451.     MOVE    S2,DIRCHN(S1)        ; Get the channel we are using
  452.     STORE    S2,DFLP+.FOFNC,FO.CHN    ; Store the channel number
  453.     MOVX    S2,.FOUSI        ; Do a USETI
  454.     STORE    S2,DFLP+.FOFNC,FO.FNC    ; Store the function
  455.     MOVE    S2,[XWD .FOFNC+2,DFLP]    ; Point to the arguments
  456.     FILOP.    S2,            ; Point to the block
  457.       JRST    RDBL.0            ; Failed, see if EOF
  458.     MOVX    S2,.FOINP        ; Get the function
  459.     STORE    S2,DFLP+.FOFNC,FO.FNC    ; Store the function
  460.     MOVEI    S2,T1            ; Point to the IOWD list
  461.     MOVEM    S2,DFLP+.FOFNC+1    ; Store it
  462.     MOVX    T1,<IOWD D$BLKS,DIR>    ; Point to the block
  463.     SETZ    T2,            ; Clear the next word
  464.     MOVE    S2,[XWD .FOFNC+2,DFLP]    ; Point to the arguments
  465.     FILOP.    S2,            ; Get the block
  466.       SKIPA                ; Skip if failure
  467.     $RETT                ; Give a good return
  468.  
  469. ; Here if the FILOP. failed, see why.
  470.  
  471. RDBL.0:    TXNN    S2,IO.EOF        ; End of file?
  472.      JRST    RDBL.1            ; No, problem
  473. RDBL.2:    SETZM    DIRBLK(S1)        ; Clear the block number
  474.     MOVE    S2,DIRCHN(S1)        ; Get the channel
  475.     RESDV.    S2,            ; Make it go away
  476.      JFCL                ; Shouldn't fail
  477.     SETZM    DIRCHN(S1)        ; This channel not used any more
  478.     SETZM    DPTH+.PTSFD(S1)        ; Clear this so not to get confused.
  479.     $RETF                ; Give a failure return
  480.  
  481. RDBL.1:    KERERR    (<Error reading directory for ^F/FDB/>)
  482.     JRST    RDBL.2            ; And return
  483.     SUBTTL    Initialization routine
  484.  
  485. ; This routine will initialize some system constants.
  486.  
  487. LOKINI::MOVX    S1,-1            ; Use this job number
  488.     MOVX    S2,JI.USR        ; Get my user id
  489.     $CALL    I%JINF            ; From the system
  490.     $RETIF                ; Return if that failed
  491.     MOVEM    S2,MYPPN        ; Store my PPN
  492.     MOVX    S1,%LDMFD        ; Get the MFD PPN
  493.     GETTAB    S1,            ; From the system
  494.      MOVX    S1,<XWD 1,1>        ; Use this as default
  495.     MOVEM    S1,MFDPPN        ; Store it
  496.  
  497.     MOVX    S1,%LDSYS        ; Get the location of SYS:
  498.     GETTAB    S1,            ; From the monitor
  499.       MOVX    S1,<XWD 1,4>        ; Get the default
  500.     MOVEM    S1,SYSPPN        ; Store for later
  501.  
  502.     MOVX    S1,.PTFRD        ; Read user's default path
  503.     STORE    S1,PTH+.PTFCN,PT.FCN    ; Store the information
  504.     ZERO    PTH+.PTFCN,PT.JBN    ; Use my job number
  505.     MOVX    S1,<XWD .PTMAX,PTH>    ; Point to the path block
  506.     PATH.    S1,            ; Do it
  507.       $RETF                ; Failed?
  508.     $RETT                ; Give a good return to the caller
  509.     SUBTTL    DIRECTORY SUBROUTINES
  510.  
  511. ;SUBROUTINE TO SUPPLY DEFAULTS FOR DIRECTORIES
  512. ;CALL:    MOVEI    P1,POINTER TO SPECIFICATION
  513. ;    PUSHJ    P,SETDIR
  514. ;USES T1-4
  515. ;
  516. ;HANDLES [,] (IE, DEFAULT PROJECT, DEFAULT PROGRAMMER),
  517. ;HANDLES [-] (IE, DEFAULT TO DEFAULT DIRECTORY)
  518. ;HANDLES .UFD (IE, DIRECTORY IS REALLY FILE NAME)
  519.  
  520. SETDIR:    MOVX    T1,FD.DFX    ;GET FLAG
  521.     TDNE    T1,.FDMOD(P1)    ;SEE IF HERE ALREADY
  522.     POPJ    P,        ;YES--RETURN
  523.     IORM    T1,.FDMOD(P1)    ;NO--SET FLAG FOR LATER
  524.     MOVX    T1,FD.DIR    ;SEE IF DIRECTORY
  525.     SKIPN    FRCPPN        ; PPN forced by something?
  526.      TDNE    T1,.FDMOD(P1)    ;  SPECIFIED
  527.       JRST    SETDR2        ;YES--GO HANDLE IT
  528.  
  529.     MOVE    T1,[-D$MSFD+1,,PTH+.PTPPN]
  530.     MOVEI    T2,.FDPPN(P1)    ;NO--COPY DEFAULT DIRECTORY
  531. SETDR1:    SKIPN    T3,(T1)        ;GET NEXT LEVEL
  532.     SOS    T1        ;BLANK--HOLD POINTER
  533.     MOVEM    T3,(T2)        ;STORE IN ARGUMENT AREA
  534.     SKIPE    T3        ;SEE IF BLANK
  535.     SETOM    T3        ;NO--FULL MATCH
  536.     MOVEM    T3,.FDD2M(T2)    ;STORE AWAY
  537.     AOJ    T2,        ; Advance to the next word
  538.     AOBJN    T1,SETDR1    ;LOOP UNTIL DONE
  539.     JRST    SETDR3        ;AND PROCEED BELOW
  540. SETDR2:    MOVE    T1,.FDPPN(P1)    ;GET DIRECTORY
  541.     MOVE    T2,MYPPN    ;DEFAULT PPN--GET USER
  542.     TLNN    T1,-1        ;SEE IF PROJECT PRESENT
  543.     HLLM    T2,.FDPPN(P1)    ;NO--FILL IN MY PROJECT
  544.     TLNN    T1,-1        ; ..
  545.     HRROS    .FDDIM(P1)    ; AND NO WILDCARD
  546.     TRNN    T1,-1        ;SEE IF PROGRAMMER PRESENT
  547.     HRRM    T2,.FDPPN(P1)    ;NO--FILL IN MY PROGRAMMER
  548.     TRNN    T1,-1        ; ..
  549.     HLLOS    .FDDIM(P1)    ; AND NO WILDCARD
  550. SETDR3:
  551. SETDR4:    HLRZ    T1,.FDEXT(P1)    ;GET EXTENSION
  552.     CAIE    T1,'UFD'    ;SEE IF .UFD
  553.     POPJ    P,        ;NO--ALREADY SETUP CORRECTLY
  554.     MOVE    T1,MFDPPN    ;YES--GET CORRECT DIRECTORY
  555.     EXCH    T1,.FDPPN(P1)    ;STORE (MFD)
  556.     SETO    T2,        ;CLEAR WILDCARDS
  557.     EXCH    T2,.FDDIM(P1)    ;SET INTO DIRECTORY
  558.     MOVEM    T1,.FDNAM(P1)    ;MOVE DIRECTORY TO NAME
  559.     MOVEM    T2,.FDNMM(P1)    ;MOVE DIRECTORY TO NAME
  560.     SETZM    .FDPAT(P1)    ;CLEAR SUB DIRECTORY
  561.     SETZM    .FDSFM(P1)    ; ..
  562.     POPJ    P,        ;RETURN
  563.     SUBTTL    STRUCTURE SUBROUTINES
  564.  
  565. ;.INSTR -- ROUTINE TO INITIALIZE STRUCTURE SEARCH LOOP
  566. ;.INIST -- SAME AS .INSTR BUT ALSO CAUSES FRCPPN TO BE SET.
  567. ;CALL:    MOVE    T1,DEVICE
  568. ;    MOVE    T2,1B0 IF /PHYSICAL
  569. ;    PUSHJ    P,.INSTR
  570. ;NON-SKIP IF NOT A DISK
  571. ;SKIP WITH CODES PRESET FOR .NXSTR
  572. ;  AND T1=0 IF NO SCANNING, =1B0 IF SCANNING
  573.  
  574. .INIST:    SETZM    SUBSTR        ;INDICATE .INIST CALL
  575.     SKIPA            ;
  576. .INSTR:    SETOM    SUBSTR        ;INDICATE .INSTR CALL
  577.     $SAVE    <P1>        ; Save P1
  578.     MOVSI    T3,'SYS'    ;SEE IF
  579.     DEVCHR    T3,UU.PHY    ; PHYSICAL
  580.     TRNN    T3,-1        ; POSSIBLE
  581.     TXZ    T2,UU.PHS    ;NO--CLEAR ARGUMENT
  582.     LSH    T2,-^D35    ;POSITION TO BIT 35
  583.     MOVEM    T2,PHYS        ;STORE FOR UUO
  584.     SETOM    SY2RCH        ;ASSUME AT LEAST 5.02
  585.     MOVEM    T1,FDB+.FDSTR        ;SAVE DEVICE
  586.     SETZM    SYSRCH        ;CLEAR
  587.     SETZM    STRMSK        ; FLAGS
  588.     SETZM    STRMTH        ; FOR .NXSTR
  589.     SETZM    SRCH        ;CLEAR SEARCH MODE
  590.     MOVE    T2,T1        ;COPY ARGUMENT DEVICE
  591.     PUSHJ    P,DOPHYS    ;GET
  592.       DEVCHR T2,        ; ITS CHARACTERISTICS
  593.     MOVS    T1,FDB+.FDSTR        ;GET NAME AGAIN
  594.     CAIN    T1,'NUL'    ;SEE IF NUL:
  595.     TLO    T2,-1-<(DV.TTA)> ;YES--FAKE DEVCHR FOR OLD MONITORS
  596.     TLC    T2,-1-<(DV.TTA)> ;SEE IF NUL:
  597.     TLCE    T2,-1-<(DV.TTA)> ; ..
  598.     TXNN    T2,DV.DSK    ;OR NOT DISK
  599.      $RETF            ; Failure return
  600.                 ;FALL INTO INSTR
  601.                 ;FALL HERE FROM ABOVE
  602. ;INSTR -- INTERNAL ROUTINE TO INITIALIZE .NXSTR
  603.  
  604. INSTR:    SKIPN    LNMFLG        ; Processing a logical name ?
  605.      SETZM    FRCPPN        ;INDICATE NOT OVERRIDING PPN
  606.     MOVE    T3,FDB+.FDSTR        ;GET STRUCTURE
  607.     MOVEI    T4,0        ;CLEAR ANSWER
  608.     MOVE    T2,[3,,T3]    ;SETUP CODE
  609.     PUSHJ    P,DOPHYS    ;ASK MONITOR FOR
  610.       PATH.    T2,        ;  SYS IDENT.
  611.         JRST INSTR3        ;NOT IMPLEMENTED--TRY OLD WAY
  612.     MOVE    T1,P1        ;SAVE DEVICE PPN
  613.     HLRZ    T2,T3        ;GET GENERIC STR NAME
  614.     CAIE    T2,'SYS'    ;LOOK FOR SYS:
  615.     TXNE    T4,PT.IPP    ;NO--SEE IF IGNORE DIRECTORY ARGS
  616.     JRST    .+2        ;YES--CLOBBER ARGUMENT
  617.     JRST    INSTR2        ;NO--PROCEED
  618.     CAIN    T2,'SYS'    ;IF SYS,
  619.     HRLI    T3,'DSK'    ;SWITCH TO DSK TO GET RIGHT SUBSET
  620.     MOVEM    T3,FDB+.FDSTR        ;  LIKE "SYSA:", ETC.
  621.     SKIPN    SUBSTR        ;IF INTERNAL CALL,
  622.     PUSHJ    P,SETPPN    ;  SET REQUESTED PPN
  623.     TXNN    T4,PT.IPP    ;SEE IF IGNORE PPN
  624.     SETOM    SYSRCH        ;NO--SET SYS FLAG
  625.  
  626. ;HERE TO SEE IF SPECIAL SEARCH LIST NEEDED
  627.  
  628. INSTR2:    LDB    T1,[POINTR (T4,PT.SLT)]  ;GET S/L CODE
  629.     JUMPE    T1,INSTR3        ;PROCEED IF NOTHING SPECIAL
  630.     SETZM    SY2RCH        ;EXPLICIT INFO, SO CLEAR FLAGS
  631.     SETZM    SYSRCH        ; ..
  632.     CAIE    T1,.PTSLA    ;SEE IF ALL S/L
  633.     CAIN    T1,.PTSLS    ;OR SYS S/L
  634.     SETOM    SYSRCH        ;YES--FLAG FOR ALL OR SYS
  635.     CAIN    T1,.PTSLS    ;SEE IF SYS S/L
  636.     SETOM    SY2RCH        ;YES--FLAG FOR SYS
  637.     JRST    INSTR7        ;AND SKIP AD HOC KLUDGERY
  638. INSTR3:    MOVE    T2,FDB+.FDSTR        ;GET DEVICE NAME
  639.     MOVE    T3,[1,,T2]    ;SET FOR DSKCHR
  640.     PUSHJ    P,DOPHYS    ;DO PHYS I/O CALL
  641.       DSKCHR T3,        ;SEE IF SYS OR GENERIC
  642.         JRST INSTR5        ;FAILED--MUST BE SYS:
  643.     LDB    T1,[POINTR (T3,DC.TYP)]  ;GET NAME CLASS
  644.     JUMPE    T1,INSTR7        ;JUMP IF DSK:
  645.     CAIN    T1,.DCTAB    ;IF STR ABBR. (SE:)
  646.     JRST    INSTM1        ;  GO SET MASK
  647.     CAIN    T1,.DCTCN    ;IF CONTROLLER CLASS (DP:)
  648.     JRST    INSTM4        ;  GO SET DSKCHR MASK
  649.     CAIN    T1,.DCTCC    ;IF CONTROLLER (DPA:)
  650.     JRST    INSTM5        ;  GO SET IT
  651.     JRST    INSTRX        ;NOTHING SPECIAL--USE USER'S DEVICE
  652. ;HERE WHEN STR ABBREVIATION FOUND (LIKE SE: FOR SEFI: AND SEMA:)
  653.  
  654. INSTM1:    MOVE    T3,FDB+.FDSTR        ;GET ABBREVIATION
  655.     DEVNAM    T3,        ;CONVERT TO PHYSICAL IF WE CAN
  656.       MOVE    T3,FDB+.FDSTR        ;IF NOT DO THE BEST WE CAN
  657.     PUSHJ    P,.MKMSK    ;GET MASK OF SIZE
  658.     JRST    INSTM8        ;AND GO STORE
  659.  
  660. ;HERE WHEN CONTROLLER CLASS (DP:)
  661.  
  662. INSTM4:    MOVX    T1,DC.CNT    ;SET MASK FOR TYPE OF CONTROLLER
  663.     JRST    INSTM8        ;AND GO STORE
  664.  
  665. ;HERE WHEN CONTROLLER (DPA:)
  666.  
  667. INSTM5:    MOVX    T1,<DC.CNT!DC.CNN>    ;SET MASK FOR TYPE AND NUMBER OF CONTROLLER
  668.  
  669. ;HERE WITH T1=MASK, T3=MATCH
  670.  
  671. INSTM8:    MOVEM    T1,STRMSK    ;STORE MASK
  672.     MOVEM    T3,STRMTH    ;STORE MATCH
  673.     JRST    INSTR6        ;AND FLAG FOR SYSSTR TYPE SEARCHING
  674.  
  675. ;HERE WHEN SYS SEARCH LIST IS SELECTED
  676.  
  677. INSTR5:    SKIPN    SYSRCH        ;SEE IF ALREADY SETUP
  678.     PUSHJ    P,SETSYS    ;SETUP DIRECTORY FOR SYS:
  679. INSTR6:    SETOM    SYSRCH        ;FLAG FOR SYSTEM SEARCH LIST (F/S LIST)
  680.  
  681. ;HERE WHEN ANY SEARCH LIST IS SELECTED
  682.  
  683. INSTR7:    SETOM    SRCH        ;FLAG TO USE A SEARCH LIST
  684. INSTRX:    SETZM    LASSTR        ;CLEAR STRUCTURE TO START
  685.     SKIPE    T1,SRCH        ;SEE IF SEARCHING
  686.     MOVX    T1,UU.PHS    ;YES--RETURN /PHYSICAL
  687.     $RETT            ; And give a good return
  688. ; .NXSTR - Routine to get the next structure
  689. ;
  690. ; This routine will return the next structure in the search list in
  691. ; FDB+.FDDEV.  It will give a true return if there was a next structure
  692. ; and a false return if none.
  693.  
  694. .NXSTR:    SKIPN    SRCH            ;HERE FOR NEXT--SEE IF SEARCHING
  695.       $RETF                ; No more structures, return false
  696. NXSTR2:    MOVE    T1,LASSTR    ;GET F/S NAME FOR LIST
  697.     SKIPE    SYSRCH        ;NEED A NEW F/S
  698.     JRST    NXSTR3        ;FROM SYSTEM F/S LIST
  699.     SKIPN    T1        ;SEE IF FIRST PASS
  700.     SETOM    T1        ;YES--BLANKETY-BLANK UUO
  701.     MOVE    T2,[1,,T1]    ;SETUP POINTER
  702.     JOBSTR    T2,        ;FROM JOB'S SEARCH LIST
  703.       HALT    .RETF
  704.     JRST    NXSTR5        ;GOT IT
  705.  
  706. NXSTR3:    SKIPE    SY2RCH        ;NEEDS SYS: S.L.
  707.     SKIPE    STRMSK        ;IF MASK, NEEDS ALL STR LIST
  708.     JRST    .+2        ;YES--USE IT
  709.     JRST    NXSTR4        ;GO USE REAL SYS: SEARCH LIST
  710.     SYSSTR    T1,        ;CAN'T--USE ALL STRS IN SYSTEM
  711.       HALT    .RETF
  712.     JRST    NXSTR5        ;GOT IT--GO PROCESS
  713.  
  714. NXSTR4:    SKIPN    T1        ;SEE IF AT START
  715.     SETOM    T1        ;YES--FOOLISH UUO
  716.     MOVEM    T1,GOBST+.DFGNM    ;STORE STR IN GOBSTR'S ARG LIST
  717.     SETZM    GOBST+.DFGJN    ;SPECIFY JOB 0
  718.     MOVE    T1,SYSPPN    ; Get the PPN for SYS:
  719.     MOVEM    T1,GOBST+.DFGPP    ;STORE IN ARGUMENT
  720.     MOVEI    T1,GOBST    ;SETUP SHORT BLOCK
  721.     GOBSTR    T1,        ;ASK MONITOR
  722.       HALT    .RETF        ;GIVE UP IF ERROR
  723.     MOVE    T1,GOBST+.DFGNM    ;GET ANSWER
  724. ;HERE WITH RESULT FROM S/L IN T1
  725.  
  726. NXSTR5:    CAMN    T1,[-1]        ;LOOK FOR END
  727.       $RETF            ; Done, return false
  728.     JUMPE    T1,.RETF    ;IF ZERO, ALL DONE
  729.     MOVEM    T1,FDB+.FDSTR
  730.     MOVEM    T1,LASSTR    ;SAVE FOR SEARCH
  731.  
  732.     MOVEM    T1,DSKBUF    ;DO A DSKCHR
  733.     MOVE    T3,[.DCMAX,,DSKBUF]
  734.     $CALL    DOPHYS        ; TO HANDLE
  735.       DSKCHR T3,        ; SINGLE ACCESS
  736.         HALT .RETF        ; ..
  737.     TXNE    T3,DC.SAF    ;SEE IF SINGLE ACCESS
  738.       JRST    [PJOB    T2,        ;YES--GET OUR JOB
  739.         XOR    T2,DSKBUF+.DCSAJ ;COMPARE TO S.A. USER
  740.         TRNE    T2,-1        ;SEE IF MATCH
  741.         JRST    NXSTR2        ;NO--IGNORE STRUCTURE
  742.         JRST    .+1]        ;YES--OK TO TRY IT
  743.     SKIPN    T2,STRMSK    ;SEE IF MASKING RESULTS
  744.       $RETT            ; No, give a good return
  745.     SKIPL    T2        ;SKIP IF NAME MASKING
  746.      SKIPA    T1,T3        ;POSITION DSKCHR FOR MATCH
  747.     MOVE    T1,FDB+.FDSTR        ;YES--GET BACK NAME
  748.     XOR    T1,STRMTH    ;SEE IF MATCHES
  749.     TDNE    T1,STRMSK    ;WHERE IMPORTANT
  750.      JRST    NXSTR2        ;NO--GO GET NEXT STR
  751.     $RETT            ; Give a good return
  752.     SUBTTL    Logical Name Subroutines -- .INILN - Initialize logical name
  753.  
  754. ;.INILN - This routine will initialize the logical name searching.  It will
  755. ;      do a PATH. to determine if the device name that was specified in
  756. ;      the device name is a logical name.  If it is it will set FRCPPN to
  757. ;      denote that there is a forced PPN, and set up FDB+.FDPPN to be correct.
  758. ;
  759. ; Usage:
  760. ;    $CALL    .INILN
  761. ;    (Return)
  762.  
  763. .INILN:    MOVX    S1,.PTLLB        ; Get the length
  764.     MOVEI    S2,LNMBLK        ; Get the block address
  765.     $CALL    .ZCHNK            ; Clear the block
  766.     MOVX    T1,.PTFRN        ; Get the read function
  767.     STORE    T1,LNMBLK+.PTFCN,PT.FCN    ; Store the function
  768.     MOVX    T1,PT.RCN        ; Get the read name bit
  769.     MOVEM    T1,LNMBLK+.PTLNF    ; Store the flag
  770.     MOVE    T1,FDB+.FDSTR        ; Get the structure we are processing
  771.     MOVEM    T1,LNMBLK+.PTLNM    ; Store the name
  772.     MOVE    T1,[XWD .PTLLB,LNMBLK]    ; Get the length,,address
  773.     PATH.    T1,            ; Is this a path
  774.       JRST    NOTLNM            ; Not a logical name
  775.     MOVEI    T3,LNMBLK+.PTLSB    ; Get the start of the sub-block
  776.     MOVEM    T3,FRCPPN        ; Store the address of the block
  777.     MOVEM    T3,LNMPTR        ; Save as the pointer to the next
  778.     MOVE    T1,.PTLSL(T3)        ; Get the device of the first logical name
  779.     MOVEM    T1,FDB+.FDSTR            ; Store the name
  780.  
  781.     MOVE    T1,.PTLPP(T3)        ; Get the PPN
  782.     SETZ    T2,            ; Initialize the counter
  783. .INIL0:    MOVEM    T1,FDB+.FDPPN(T2)    ; Store the item
  784.     SETOM    FDB+.FDDIM(T2)        ; Flag that the item is not wild
  785.     ADDI    T2,1            ; POint to the next entry
  786.     ADDI    T3,1            ; For both items
  787.     SKIPE    T1,.PTLSF-1(T3)        ; Get the first of the SFDs
  788.       JRST    .INIL0            ; Loop for all of them
  789.     SETZM    FDB+.FDPPN(T2)        ; Clear to mark the end of the list
  790.     SETZM    FDB+.FDDIM(T2)        ; . . .
  791.     MOVEM    T2,LNMDEP        ; . . .
  792.     SETOM    LNMFLG            ; Logical name processing
  793.     MOVX    T1,FD.DIR        ; Get the directory flag
  794.     ANDCAM    T1,FDB+.FDMOD        ; Clear it
  795.     SKIPE    FDB+.FDPPN        ; Have a PPN?
  796.      IORM    T1,FDB+.FDMOD        ; Yes, then set the flag
  797.     $RETT                ; Give a good return
  798.  
  799. ; Here if the device is not a logical name
  800.  
  801. NOTLNM:    SETZM    LNMFLG            ; No logical name processing
  802.     SETZM    FRCPPN            ; Clear the forced ppn
  803.     $RETF                ; Return false
  804.     SUBTTL    Logical Name Subroutines -- .NXTLN - Set up for the next name
  805.  
  806. ;.NXTLN - This routine will set up for the next logical name.  It will
  807. ;      give a non-skip return if there is another name and a skip return
  808. ;      if the list has been expired.
  809. ;
  810. ; Usage:
  811. ;    $CALL    .INILN
  812. ;        .
  813. ;        .
  814. ;        .
  815. ;    $CALL    .NXTLN
  816. ;    (Another name all set to go)
  817. ;    (No more names)
  818.  
  819. .NXTLN:    SKIPN    LNMFLG        ; Processing a logical name
  820.       $RETF            ; No logical name
  821.     MOVE    T1,LNMPTR    ; Get the current pointer
  822.     MOVEI    T1,.PTLSF(T1)    ; Point to the first of the SFDs
  823.     SKIPE    (T1)        ; If this is zero then skip
  824.      AOJA    T1,.-1        ; Find the end of the SFD list
  825.     ADDI    T1,1        ; Point one more down the road
  826.  
  827.     SKIPN    (T1)        ; End of the logical name ?
  828.      SKIPE    1(T1)        ; . . .
  829.       JRST    .NXTL0        ; No, finish up
  830.     $RETF            ; No more
  831.  
  832. ; Here if we have another logical name
  833.  
  834. .NXTL0:    MOVEM    T1,FRCPPN        ; Store the updated pointer
  835.     MOVEM    T1,LNMPTR        ; Store as the pointer for the logical names
  836.     MOVE    T2,.PTLSL(T1)        ; Get the device name
  837.     MOVEM    T2,FDB+.FDSTR        ; Store the structure name
  838.     SETZB    T3,T4            ; Clear the counters
  839.  
  840.     MOVE    T2,.PTLPP(T1)        ; Get the PPN
  841. .NXTL1:    MOVEM    T2,FDB+.FDPPN(T3)    ; Store into the two places
  842.     SETOM    FDB+.FDDIM(T3)        ; Make this not wild
  843.     ADDI    T3,1            ; Point to the next entry
  844.     ADDI    T1,1            ; . . .
  845.     SKIPE    T2,.PTLSF-1(T1)        ; End of the SFD list ?
  846.      AOJA    T4,.NXTL1        ; No, keep looping
  847.     ADDI    T4,1            ; Increment the depth
  848.     MOVEM    T4,LNMDEP        ; Store it
  849.     SETZM    FDB+.FDPPN(T3)        ; Clear to mark the end
  850.     SETZM    FDB+.FDDIM(T3)        ; . . .
  851.     MOVX    T1,FD.DIR        ; Get the directory flag
  852.     ANDCAM    T1,FDB+.FDMOD        ; Clear it
  853.     SKIPE    FDB+.FDPPN        ; Is there a PPN?
  854.     IORM    T1,FDB+.FDMOD        ; Yes, set the flag
  855.     $CALL    INSTR            ; Initialize the structure search
  856.     $RET                ; Pass the information back
  857.     SUBTTL    USEFUL SUBROUTINES
  858.  
  859. ;SETSYS -- SETUP DIRECTORY FOR SYS:
  860. ;CALL:    PUSHJ    P,SETSYS
  861. ;USES T1, T2
  862.  
  863. SETSYS:    MOVE    T1,SYSPPN    ; Get the SYS: PPN
  864. SETPPN:    CAMN    T1,MFDPPN    ;IF MFD:,
  865.     JRST    [MOVE    T2,FDB+.FDPPN    ;GET DIRECTORY
  866.         CAMN    T2,MFDPPN    ;UNLESS MFD,
  867.         POPJ    P,        ;(YES--RETURN)
  868.         MOVEM    T2,FDB+.FDNAM    ; STORE AS NAME
  869.         MOVE    T2,FDB+.FDDIM    ; Get the directory mask
  870.         MOVEM    T2,FDB+.FDNMM    ; Store the mask also
  871.         JRST  .+1]        ;PROCEED
  872.     MOVEM    T1,FRCPPN        ;OVERRIDE DIRECTORY
  873.     MOVE    T2,MFDPPN        ;GET MFD
  874.     CAMN    T2,FDB+.FDPPN        ;SEE IF SAME
  875.     JRST    SETPP1            ;YES--GO DIDDLE NAME
  876.     MOVEM    T1,FDB+.FDPPN        ;AND OVERSTORE REQUEST
  877.     SETOM    FDB+.FDDIM        ; Set the directory mask
  878.     SETZM    FDB+.FDPAT        ; No path
  879.     SETZM    FDB+.FDSFM        ; No mask for it either
  880.     MOVX    T1,FD.DIR        ; Directory seen flag
  881.     IORM    T1,FDB+.FDMOD        ; Light it
  882.     POPJ    P,            ;RETURN
  883. SETPP1:    MOVEM    T1,FDB+.FDNAM        ;STORE OVER NAME
  884.     SETOM    FDB+.FDNMM        ; Clear wildcards in the mask
  885.     POPJ    P,            ;RETURN
  886. ;DOPHYS -- PERFORM A LOGICAL OR PHYSICAL CALLI AS NEEDED
  887. ;CALL:    PUSHJ    P,DOPHYS
  888. ;    CALLI TO BE EXECUTED
  889. ;    CPOPJ RETURN POINT
  890. ;    SKIP RETURN POINT
  891. ;USES T1
  892.  
  893. DOPHYS:    MOVE    T1,(P)            ;FETCH CALLI
  894.     MOVE    T1,(T1)            ; ..
  895.     AOS    (P)            ;ADVANCE RETURN POINT
  896.     SKIPE    PHYS            ;SEE IF PHYS I/O REQUESTED
  897.     TRO    T1,UU.PHY        ;YES--TURN ON PHYSICAL BIT
  898.     XCT    T1            ;DO THE CALLI
  899.     POPJ    P,            ;OK RETURN
  900. CPOPJ1:    AOS    (P)            ;SKIP
  901. CPOPJ:    POPJ    P,            ;RETURN
  902.  
  903.  
  904.  
  905. ;SETOPN -- SETUP OPEN BLOCK WORD 1 AND 2
  906. ;CALL:    PUSHJ    P,SETOPN
  907. ;RETURNS WITH T1, T2 SETUP, T3=0
  908. ;USES NO ACS
  909.  
  910. SETOPN:    MOVX    S1,.IODMP        ; Get the mode
  911.     SKIPN    PHYS            ;SEE IF PHYS I/O REQUESTED
  912.      SKIPE    SRCH            ;OR IF USING A SEARCH LIST
  913.       TLO    S1,(UU.PHS)        ;YES--SET FOR PHYS OPEN
  914.     MOVEM    S1,DFLP+.FOIOS        ; Store the status
  915.     SKIPN    S2,LASSTR        ;GET STRUCTURE OR
  916.      MOVE    S2,FDB+.FDSTR        ;GET ARGUMENT DEVICE
  917.     MOVEM    S2,DFLP+.FODEV        ; Store the device name
  918.     POPJ    P,            ;RETURN
  919. ;.MKMSK -- MAKE MASK CORRESPONDING TO NON-BLANKS IN SIXBIT WORD
  920. ;CALL:    MOVE    T3,WORD
  921. ;    PUSHJ    P,.MKMSK
  922. ;RETURN WITH MASK IN T1
  923. ;USES T2
  924.  
  925. .MKMSK:    MOVEI    T1,0        ;CLEAR MASK
  926.     MOVSI    T2,(77B5)    ;START AT LEFT END
  927. MAKMS1:    TDNE    T3,T2        ;SEE IF SPACE HERE
  928.     IOR    T1,T2        ;NO--IMPROVE MASK
  929.     LSH    T2,-6        ;MOVE RIGHT ONE CHAR
  930.     JUMPN    T2,MAKMS1    ;LOOP UNTIL DONE
  931.     POPJ    P,        ;RETURN
  932.     SUBTTL    TOPS-10 error codes
  933.  
  934. TOPS10<
  935.  
  936.     DEFINE ENTERR<
  937. ERR$(ERFNF%,FNF,<File not found>)
  938. ERR$(ERIPP%,IPP,<No UFD for Project-Programmer Number>)
  939. ERR$(ERPRT%,PRT,<Protection Failure>)
  940. ERR$(ERFBM%,FBM,<File being modified>)
  941. ERR$(ERAEF%,AEF,<File already exists>)
  942. ERR$(ERISU%,ISU,<Illegal sequence of UUO's>)
  943. ERR$(ERTRN%,TRN,<Transmission error>)
  944. ERR$(ERNSF%,NSF,<Not a SAVE file>)
  945. ERR$(ERNEC%,NEC,<Not enough core>)
  946. ERR$(ERDNA%,DNA,<Device not available>)
  947. ERR$(ERNSD%,NSD,<No such device>)
  948. ERR$(ERILU%,ILU,<Illegal UUO.  No two-register relocation>)
  949. ERR$(ERNRM%,NRM,<No room or quota exceeded on this file structure>)
  950. ERR$(ERWLK%,WLK,<File structure is write-locked>)
  951. ERR$(ERNET%,NET,<Not enough monitor table space>)
  952. ERR$(ERPOA%,POA,<Partial allocation>)
  953. ERR$(ERBNF%,BNF,<Block not free>)
  954. ERR$(ERCSD%,CSD,<Cannot supersede a directory>)
  955. ERR$(ERDNE%,DNE,<Cannot delete a non-empty directory>)
  956. ERR$(ERSNF%,SNF,<SFD not found>)
  957. ERR$(ERSLE%,SLE,<Search list empty>)
  958. ERR$(ERLVL%,LVL,<SFD nested too deeply>)
  959. ERR$(ERNCE%,NCE,<No create bit on on all structures>)
  960. ERR$(ERSNS%,SNS,<Segment not on swapping space>)
  961. ERR$(ERFCU%,FCU,<Cannot update file>)
  962. ERR$(ERLOH%,LOH,<Low segment overlaps high segment>)
  963. ERR$(ERNLI%,NLI,<Cannot run program when not logged in>)
  964. ERR$(ERENQ%,ENQ,<File still has outstanding locks set>)
  965. ERR$(ERBED%,BED,<Bad .EXE directory>)
  966. ERR$(ERBEE%,BEE,<Bad extension for .EXE file>)
  967. ERR$(ERDTB%,DTB,<Directory too big for .EXE file>)
  968. ERR$(ERENC%,ENC,<TSK - Exceeded network capacity>)
  969. ERR$(ERTNA%,TNA,<TSK - Task not available>)
  970. ERR$(ERUNN%,UNN,<TSK - Undefined network node>)
  971. ERR$(ERSIU%,SIU,<SFD is in use, cannot be renamed>)
  972. ERR$(ERNDR%,NDR,<File has an NDR lock, cannot delete>)
  973. ERR$(ERJCH%,JCH,<Job count too high (Access Table read count overflow)>)
  974. ERR$(ERSSL%,SSL,<Cannot rename SFD to a lower level>)
  975. ERR$(ERCNO%,CNO,<Channel not opened (FILOP.)>)
  976. ERR$(ERDDU%,DDU,<Device "Down" and unuseable>)
  977. ERR$(ERDRS%,DRS,<Device is restricted>)
  978. ERR$(ERDCM%,DCM,<Device controlled by MDA>)
  979. ERR$(ERDAJ%,DAJ,<Device allocated to another job>)
  980. ERR$(ERIDM%,IDM,<Illegal I/O data mode>)
  981. ERR$(ERUOB%,UOB,<Unknown/Undefined open bits set>)
  982. ERR$(ERDUM%,DUM,<Device in use on an MPX channel>)
  983. ERR$(ERNPC%,NPC,<No per-process space for extended I/O channel table>)
  984. ERR$(ERNFC%,NFC,<No free channels available>)
  985. ERR$(ERUFF%,UFF,<Unknown FILOP. function>)
  986. ERR$(ERCTB%,CTB,<Channel too big>)
  987. ERR$(ERCIF%,CIF,<Channel illegal for specified function>)
  988.  
  989. >;end of enterr macro
  990.  
  991. DEFINE    ERR$(CODE,PREFIX,TEXT)<XWD CODE,[ASCIZ |TEXT|]>
  992. FILERR::ENTERR
  993.  FILELN==.-FILERR
  994. >; End of TOPS10 conditional
  995.  
  996.     XLIST    ;LITERALS
  997.     LIT
  998.     LIST
  999.     RELOC    0
  1000.  
  1001. .WILDZ:!        ;START OF LOW CORE AREA
  1002.  
  1003. ; User arguments
  1004.  
  1005. SECBLK:    BLOCK    1            ; Secondary Argument block
  1006. SECFLP:    BLOCK    1            ; Secondary FILOP block address
  1007. SECFLN:    BLOCK    1            ; Secondary FILOP block length
  1008. SECFLG:    BLOCK    1            ; Secondary Flags
  1009.  
  1010. ARGFLN:    BLOCK    1            ; Length of user supplied FILOP. block
  1011. ARGFLP:    BLOCK    1            ; FILOP. block address
  1012. ARGFLG:    BLOCK    1            ; Flags given
  1013. ARGBLK:    BLOCK    1            ; Address of argument block
  1014.  
  1015. FDB:    BLOCK    .FDSIZ            ; User given specification
  1016.  
  1017. ZERBEG:!
  1018.  
  1019. ; Directory processing information
  1020.  
  1021. DEPTH:    BLOCK    1            ; Current SFD/UFD depth
  1022. TOP:    BLOCK    1            ; Top of the depth
  1023.  
  1024. DIRCHN:    BLOCK    D$MSFD+1        ; Directory channels we are using
  1025. DIRBLK:    BLOCK    D$MSFD+1        ; Current block we are processing
  1026. DIRIDX:    BLOCK    D$MSFD+1        ; Index into DIR
  1027.  
  1028. DFLP:    BLOCK    .FOMAX            ; Directory FILOP. block
  1029. DLEB:    BLOCK    .RBMAX            ; LOOKUP/ENTER block for dik for directories
  1030. DPTH:    BLOCK    .PTMAX            ; Path block for LOOKUP of directories
  1031.  
  1032. DIR:    BLOCK    D$BLKS            ; UFD data block
  1033.  
  1034. ; INISTR/NXTSTR information
  1035.  
  1036. SUBSTR:    BLOCK    1        ;FLAG CALL TO SUBROUTINE .NXSTR
  1037. LASSTR:    BLOCK    1        ;LAST STR FROM SEARCH UUOS
  1038. FRCPPN:    BLOCK    1        ;PPN TO OVERRIDE WITH
  1039. STRMSK:    BLOCK    1        ;MASK FOR MATCHING STRS
  1040.                 ;  BY NAME IF LT 0, BY DSKCHR IF GT 0
  1041. STRMTH:    BLOCK    1        ;MATCH FOR ABOVE
  1042. PHYS:    BLOCK    1        ;FLAG TO FORCE PHYSICAL I/O
  1043. SRCH:    BLOCK    1        ;FLAG FOR SEARCH LIST IN USE
  1044. SYSRCH:    BLOCK    1        ;FLAG FOR SYSTEM SEARCH LIST IN USE
  1045. SY2RCH:    BLOCK    1        ;FLAG FOR REAL SYS: SEARCH LIST
  1046.  
  1047. DSKBUF:    BLOCK    .DCMAX        ; DSKCHR block
  1048. GOBST:    BLOCK    5        ;GOBSTR PARAMETER AREA
  1049.  
  1050.  
  1051. SYSPPN:    BLOCK    1            ; PPN of SYS:
  1052. MFDPPN::BLOCK    1            ; MFD directory
  1053. MYPPN::    BLOCK    1            ; User's PPN
  1054. PTH:    BLOCK    .PTMAX            ; Default user's path
  1055.  
  1056. LNMPTR:    BLOCK    1            ; Pointer to the current logical name
  1057. LNMDEP:    BLOCK    1            ; Depth of the logical name
  1058. LNMFLG:    BLOCK    1            ; Flag for logical name processing
  1059. LNMBLK:    BLOCK    .PTLLB            ; Length of the logical name block
  1060.  
  1061. FLP:    BLOCK    .FOMAX            ; FILOP. block
  1062. FPTH:    BLOCK    .PTMAX            ; File found in block
  1063. FLKP:    BLOCK    .RBMAX            ; LOOKUP block
  1064.  
  1065. ZERLEN==.-ZERBEG    ; Length of the area to clear
  1066.     SUBTTL    End of KERWLD
  1067.  
  1068.     END