mim/development/mim/vax/vax-utils.mud

   1 <DEFINE T$HANG ("OPTIONAL" (PRED <>))
   2   <REPEAT (VAL)
   3     <COND (<SET VAL <T$EVAL .PRED>>
   4            <RETURN .VAL>)>
   5     <ISYSCALL SIGPAUSE 0>>>
   6
   7 <DEFINE T$JNAME ("OPT" IGN
   8                  "AUX" (JCL:<OR FALSE <VECTOR [REST STRING]>> <CALL GETS ARGV>))
   9    <COND (.JCL
  10           <REPEAT ((ST <1 .JCL>) TS)
  11              <COND (<SET TS <MEMQ !\/ .ST>>
  12                     <SET ST <REST .TS>>)
  13                    (T
  14                     <COND (<SET TS <MEMQ !\. .ST>>
  15                            <RETURN <I$STD-STRING .ST T .TS>>)
  16                           (T
  17                            <RETURN <I$STD-STRING .ST T>>)>)>>)
  18          (T "XMDL")>>
  19
  20 <DEFINE T$SLEEP (TM "OPTIONAL" (PRED <>) "AUX" RTM1 RTM2 UV UVX)
  21   #DECL ((TM) <OR FIX FLOAT> (RTM1 RTM2) FIX (UVX UV) <UVECTOR [2 FIX]>)
  22   <COND (<TYPE? .TM FLOAT>
  23          <SET RTM1 <FIX .TM>>
  24          <SET RTM2 <FIX <* 1000000.0 <- .TM .RTM1>>>>)
  25         (<SET RTM1 .TM>
  26          <SET RTM2 0>)>
  27   <COND (<NOT <GASSIGNED? UV-2>>
  28          <SETG UV-X <IUVECTOR 4 0>>
  29          <SETG UV-2 <IUVECTOR 2 0>>)>
  30   <SET UV ,UV-2>
  31   <SET UVX ,UV-X>
  32   <REPEAT (VAL STIME1 STIME2)
  33     #DECL ((STIME) FIX)
  34     <COND (<L=? .TM 0> <RETURN T>)>
  35     <COND (<SET VAL <T$EVAL .PRED>>
  36            <RETURN .VAL>)>
  37     <CALL SYSCALL GETTIMEOFDAY .UV .UVX>
  38     ; "Get seconds and microseconds of current time; will discard time zone"
  39     <SET STIME1 <1 .UV>>
  40     <SET STIME2 <2 .UV>>
  41     ; "Set up seconds and microseconds of interval"
  42     <1 .UVX 0>
  43     <2 .UVX 0>
  44     <3 .UVX .RTM1>
  45     <4 .UVX .RTM2>
  46     <CALL SYSCALL SETITIMER ,ITIMER-REAL .UVX 0>
  47     <ISYSCALL SIGPAUSE 0>
  48     <CALL SYSCALL GETTIMEOFDAY .UV .UVX>
  49     ; "How many seconds left?"
  50     <SET RTM1 <- .RTM1 <- <1 .UV> .STIME1>>>
  51     ; "How many microseconds left?"
  52     <COND (<L? <SET RTM2 <- .RTM2 <- <2 .UV> .STIME2>>> 0>
  53            <SET RTM2 <+ .RTM2 1000000>>
  54            <SET RTM1 <- .RTM1 1>>)>
  55     <SET STIME1 <1 .UV>>
  56     <SET STIME2 <2 .UV>>
  57     <SET TM <+ <FLOAT .RTM1> </ <FLOAT .RTM2> 1000000.0>>>>>
  58
  59 <DEFINE T$STANDARD-NAME (STR "AUX" (NOCONV? <>) (QUOTE? <>) (QUOTER !\^))
  60    #DECL ((STR) STRING)
  61    <COND (<EMPTY? .STR> <STRING <ASCII 0>>)
  62          (T
  63           <MAPR ,STRING
  64                 <FUNCTION (S "AUX" (C <1 .S>) VAL)
  65                    #DECL ((S) STRING (C) CHARACTER
  66                           (VAL) <OR CHARACTER FALSE>)
  67                    <COND (<==? .C .QUOTER>
  68                           <COND (<AND <==? .S .STR>
  69                                       <G? <LENGTH .S> 1>
  70                                       <G=? <ASCII <2 .S>> <ASCII !\A>>
  71                                       <L=? <ASCII <2 .S>> <ASCII !\Z>>>
  72                                  <SET NOCONV? T>)
  73                                 (<SET QUOTE? T>)>
  74                           <SET VAL <>>)
  75                          (<OR .NOCONV? .QUOTE?>
  76                           <SET QUOTE? <>>
  77                           <SET VAL .C>)
  78                          (<AND <G=? <ASCII .C> <ASCII !\A>>
  79                                <L=? <ASCII .C> <ASCII !\Z>>>
  80                           <SET VAL
  81                                <ASCII <+ <- <ASCII .C> <ASCII !\A>>
  82                                          <ASCII !\a>>>>)
  83                          (<==? .C <ASCII 0>> <SET VAL <>>)
  84                          (<SET VAL .C>)>
  85                    <COND (<==? <LENGTH .S> 1>
  86                           <COND (.VAL <MAPRET .VAL <ASCII 0>>)
  87                                 (<MAPRET <ASCII 0>>)>)
  88                          (T <COND (.VAL <MAPRET .VAL>) (T <MAPRET>)>)>>
  89                 .STR>)>>
  90
  91 <DEFINE I$BMEMQ (CHR STR "OPTIONAL" (NS <REST .STR <LENGTH .STR>>))
  92   #DECL ((CHR) CHARACTER (STR NS) STRING)
  93   <REPEAT ()
  94     <COND (<==? .NS .STR> <RETURN <>>)>
  95     <SET NS <BACK .NS>>
  96     <COND (<==? <1 .NS> .CHR>
  97            <RETURN .NS>)>>>
  98
  99 <DEFINE I$COMPONENTS (STR STOR DEFAULTS? "AUX" TS TNM1 TNM2)
 100   #DECL ((STR) STRING (STOR) <PRIMTYPE VECTOR> (DEFAULTS?) <OR ATOM FALSE>
 101          (TS TNM1 TNM2) <OR STRING FIX FALSE>)
 102   <COND (<SET TS <MEMQ !\. .STR>>       ; "Has nm1.nm2"
 103          <SET TNM2 <STRING <REST .TS>>> ; "Get nm2, whatever it is"
 104          <COND (<==? .TS .STR>
 105                 <COND (.DEFAULTS?
 106                        <COND (<TYPE? <SET TNM1 <X$VALUE? %<P-R "NM1">>>
 107                                      FIX>
 108                               <SET TNM1 <>>)>)
 109                       (T
 110                        <SET TNM1 <>>)>)
 111                (T
 112                 <SET TNM1 <I$NEW-STRING .STR .TS>>)>)
 113         (T
 114          <COND (<EMPTY? .STR>
 115                 <COND (.DEFAULTS?
 116                        <COND (<TYPE? <SET TNM1 <X$VALUE? %<P-R "NM1">>> FIX>
 117                               <SET TNM1 <>>)>)
 118                       (<SET TNM1 <>>)>)
 119                (<SET TNM1 <STRING .STR>>)>
 120          <COND (.DEFAULTS?
 121                 <COND (<TYPE? <SET TNM2 <X$VALUE? %<P-R "NM2">>> FIX>
 122                        <SET TNM2 <>>)>)
 123                (<SET TNM2 <>>)>)>
 124   <1 .STOR .TNM1>
 125   <2 .STOR .TNM2>>
 126
 127 <DEFINE I$NEW-STRING (STR1 STR2 "AUX" NS)
 128   #DECL ((STR1 NS) STRING (STR2) <OR STRING FIX>)
 129   <COND (<TYPE? .STR2 FIX>
 130          <SET NS <ISTRING .STR2>>)
 131         (T
 132          <SET NS <ISTRING <- <LENGTH .STR1> <LENGTH .STR2>>>>)>
 133   <MAPR <>
 134     <FUNCTION (S1 S2)
 135       #DECL ((S1 S2) STRING)
 136       <1 .S1 <1 .S2>>>
 137     .NS .STR1>
 138   .NS>
 139
 140 <DEFINE X$INIT-ENV ("AUX" VEC TMP (TUV <STACK <IUVECTOR 2>>))
 141   #DECL ((VEC) <VECTOR [REST STRING]> (TMP) <OR STRING FALSE>
 142          (TUV) <UVECTOR [REST FIX]>)
 143   <CALL SYSCALL GETRLIMIT 3 .TUV>
 144   <SETG I$P1-SIZE <1 .TUV>>
 145   ; "Get current size of P1, so we can grow it when needed"
 146   <SETG T$HOME-STRUC <CALL GETS HOMSTR>>
 147   ; "Structure to look on for TTY descriptors, fbins, etc."
 148   <SET VEC <CALL GETS ENVIR>>
 149   <SETG I$ENVVEC .VEC>                 ;"Save vector for later use"
 150   ; "Sigh.  Dream on..."
 151   <COND (<SET TMP <T$GET-ENV-STR "CWD" .VEC>>
 152          <I$SET-CONNECTED-DIR !<I$CANONICAL-DIR .TMP <>>>)
 153         (<SETG I$CONNECTED-DIR <>>)>
 154   <COND (<SET TMP <T$GET-ENV-STR "USER" .VEC>>
 155          <SETG I$USER-NAME <I$STD-STRING .TMP <>>>)
 156         (<SETG I$USER-NAME <>>)>
 157   <COND (<SET TMP <T$GET-ENV-STR "TERM" .VEC>>
 158          <SETG T$TERMNAME <I$STD-STRING .TMP T>>)
 159         (<SETG T$TERMNAME <>>)>
 160   <COND (<SET TMP <T$GET-ENV-STR "HOME" .VEC>>
 161          <SETG T$HOME-DIR .TMP>)>
 162   T>
 163
 164 <DEFINE T$GET-ENV-STR (STR "OPTIONAL" (ENV ,I$ENVVEC))
 165   #DECL ((STR) STRING (ENV) <VECTOR [REST STRING]>)
 166   <REPEAT (TS)
 167     <COND (<EMPTY? .ENV> <RETURN <>>)>
 168     <SET TS <1 .ENV>>
 169     <COND (<REPEAT ((NS .STR) (NNS .TS))
 170              <COND (<EMPTY? .NNS> <RETURN <>>)>
 171              <COND (<EMPTY? .NS>
 172                     <COND (<==? <1 .NNS> !\=>
 173                            <SET TS <REST .NNS>>
 174                            <RETURN T>)
 175                           (<RETURN <>>)>)>
 176              <COND (<N==? <1 .NS> <1 .NNS>>
 177                     <RETURN <>>)>
 178              <SET NS <REST .NS>>
 179              <SET NNS <REST .NNS>>>
 180            <RETURN .TS>)
 181           (<SET ENV <REST .ENV>>)>>>
 182
 183 <DEFINE T$UNAME ()
 184   ,I$USER-NAME>
 185
 186 ; "Makes sure connected directory is known, then returns snm part and dev
 187    part."
 188 <DEFINE T$GET-CONNECTED-DIR GCD ()
 189   <I$GET-CONNECTED-DIR>
 190   <MULTI-RETURN .GCD ,I$CDIR ,I$CDEV>>
 191
 192 ; "Returns T if still connected to directory we used to be connected to."
 193 <DEFINE I$STILL-CONNECTED? ("AUX" ST INODE DEV)
 194   #DECL ((ST) STRING (INODE DEV) FIX)
 195   <SET ST <T$FILE-STAT ".\0">>
 196   <SET INODE <T$STAT-FIELD .ST ,INODE-OFFS ,INODE-SIZE>>
 197   <SET DEV <T$STAT-FIELD .ST ,DEV-OFFS ,DEV-SIZE>>
 198   <AND <==? .INODE ,I$CONNECTED-INODE>
 199        <==? .DEV ,I$CONNECTED-DEV>>>
 200
 201 ; "Sets I$CONNECTED-DIR (full directory name), I$CDIR (snm part), I$CDEV
 202    (dev part), I$CONNECTED-INODE, I$CONNECTED-DEV"
 203 <DEFINE I$SET-CONNECTED-DIR (DIR DEV NAME "AUX" ST)
 204   <SETG I$CONNECTED-DIR .NAME>
 205   <SETG I$CONNECTED-INODE
 206         <T$STAT-FIELD <SET ST <T$FILE-STAT ,I$CONNECTED-DIR>>
 207                       ,INODE-OFFS, INODE-SIZE>>
 208   <SETG I$CONNECTED-DEV
 209         <T$STAT-FIELD .ST ,DEV-OFFS ,DEV-SIZE>>
 210   <SETG I$CDIR .DIR>
 211   <SETG I$CDEV .DEV>>
 212
 213 ; "Gets actual connected directory, properly split up and such.  Calls
 214    I$SET-CONNECTED-DIR when done.  If still connected, doesn't do anything."
 215 <DEFINE I$GET-CONNECTED-DIR ()
 216   <COND (<AND <GASSIGNED? I$CONNECTED-DIR>
 217               ,I$CONNECTED-DIR
 218               <I$STILL-CONNECTED?>>
 219          <COND (<OR <NOT <GASSIGNED? I$CDIR>>
 220                     <NOT ,I$CDIR>>
 221                 <I$SET-CONNECTED-DIR !<I$CANONICAL-DIR ,I$CONNECTED-DIR T>>)>)
 222         (T
 223          <I$SET-CONNECTED-DIR !<I$CANONICAL-DIR "." <>>>)>>
 224
 225 <DEFINE X$PURCLN ()
 226   T>
 227
 228 <DEFINE X$VALUE? (ATM "AUX" TS)
 229   #DECL ((ATM) ATOM (TS) <OR FALSE FIX STRING>)
 230   <SET TS <COND (<ASSIGNED? .ATM>
 231                  ..ATM)
 232                 (<GASSIGNED? .ATM>
 233                  ,.ATM)>>
 234   <COND (<OR <NOT .TS> <TYPE? .TS FIX> <EMPTY? .TS>> 0)
 235         (.TS)>>
 236
 237 <DEFINE T$GEN-OPEN (NAME "OPTIONAL" (MODE "READ") (BSZ "ASCII")
 238                     (DEVNAM <>) "AUX" (NEW? <>) VAL STDNAM (DEVTYP ,DEV-DISK)
 239                     VEC RES)
 240   #DECL ((NAME MODE BSZ) STRING (DEVNAM) <OR ATOM FALSE VECTOR>
 241          (NEW?) <OR ATOM FALSE>)
 242   <COND (<=? .MODE "CREATE">
 243          <SET NEW? T>)>
 244   <COND (<SET STDNAM <T$PARSE-FILE-NAME .NAME T T>>
 245          <SET NAME <I$STD-STRING .STDNAM T>>
 246          <COND (<NOT .DEVNAM>
 247                 <COND (<OR <SET DEVTYP <T$GET-DEVICE-TYPE .STDNAM T>>
 248                            .NEW?>
 249                        <COND (<SET VEC <MEMQ .DEVTYP ,T$DEVVEC>>
 250                               <SET DEVNAM <2 .VEC>>)
 251                              (<SET DEVNAM %<P-R "DISK">>)>)
 252                       (<SET RES <I$STD-ERROR .NAME .DEVTYP>>)>)>
 253          <COND (<NOT .DEVNAM> .RES)
 254                (<NOT <SET VAL
 255                           <COND (<TYPE? .DEVNAM ATOM>
 256                                  <T$CHANNEL-OPEN .DEVNAM .NAME
 257                                                  .MODE .BSZ>)
 258                                 (<TYPE? .DEVNAM VECTOR>
 259                                  <T$CHANNEL-OPEN
 260                                   <1 .DEVNAM> .NAME .MODE
 261                                   .BSZ !<REST .DEVNAM>>)>>>
 262                 <I$STD-ERROR .NAME .VAL>)
 263                (.VAL)>)
 264         (<I$STD-ERROR .NAME .STDNAM>)>>
 265
 266 <DEFINE X$IO-INIT ()
 267   <SETG T$MUDDLE-SYSTEM "U">
 268   <SETG CRLF-STRING <STRING <ASCII 10>>>
 269   <SETG CRLF-LENGTH 1>
 270   <SETG I$RDBLEN <* 4 256>>
 271   <SETG %<P-R "NM2"> "MUD">
 272   <SETG %<P-R "DEVVEC"> [,DEV-DISK %<P-R "DISK">
 273                          ,DEV-BDISK %<P-R "DISK">
 274                          ,DEV-VDISK %<P-R "DISK">
 275                          ,DEV-OTHER-DISK %<P-R "DISK">
 276                          ,DEV-OVDISK %<P-R "DISK">
 277                          ,DEV-CONSOLE %<P-R "TTY">
 278                          ,DEV-PTY %<P-R "TTY">
 279                          ,DEV-TTY %<P-R "TTY">
 280                          ,DEV-TTYN %<P-R "TTY">
 281                          ,DEV-NETTTY %<P-R "TTY">
 282                          ,DEV-DMFTTY %<P-R "TTY">]>
 283   <SETG I$CHANNEL-TYPES ()>
 284   ; "Try to fool everybody into thinking ttys exist"
 285   <T$NEW-CHANNEL-TYPE %<P-R "DEFAULT"> <>
 286                       T$FILE-HANDLE I$DEF-FILE-HANDLE
 287                       T$DEV I$DEF-DEV
 288                       T$SNM I$DEF-SNM
 289                       T$NM1 I$DEF-NM1
 290                       T$NM2 I$DEF-NM2
 291                       T$NAME I$DEF-NAME
 292                       T$SHORT-NAME I$DEF-SHORT-NAME
 293                       T$READ-DATE X$DEF-HACK-DATE
 294                       T$WRITE-DATE X$DEF-HACK-DATE
 295                       T$GET-MODE X$DEF-GET-MODE
 296                       T$GET-BYTE-SIZE X$DEF-GET-BYTE-SIZE>
 297   <SETG I$SBUF1 <ISTRING 1>>
 298   <SETG %<P-R "DD-DEV"> 2>
 299   <SETG %<P-R "DD-SNM"> 3>
 300   <SETG %<P-R "DD-NM1"> 4>
 301   <SETG %<P-R "DD-NM2"> 5>
 302   <SETG %<P-R "DD-DSN"> 6>
 303   <T$NEW-CHANNEL-TYPE T$DISK T$DEFAULT
 304                       T$OPEN X$DISK-OPEN
 305                       T$CLOSE X$DISK-CLOSE
 306                       T$FLUSH X$DISK-FLUSH
 307                       T$READ-BUFFER X$DISK-READ-BUFFER
 308                       T$QUERY X$DISK-QUERY
 309                       T$ACCESS X$DISK-ACCESS
 310                       T$READ-BYTE X$DISK-READ-BYTE
 311                       T$BUFOUT X$DISK-BUFOUT
 312                       T$WRITE-BUFFER X$DISK-WRITE-BUFFER
 313                       T$WRITE-BYTE X$DISK-WRITE-BYTE
 314                       T$FILE-LENGTH X$DISK-FILE-LENGTH
 315                       T$FILE-HANDLE X$DISK-FILE-HANDLE
 316                       T$PRINT-DATA X$DISK-PRINT-DATA>
 317   <T$NEW-CHANNEL-TYPE I$UNPARSE <>
 318                  %<P-R "WRITE-BUFFER"> X$UP-WRITE-BUF
 319                  %<P-R "WRITE-BYTE"> X$UP-WRITE-BYTE
 320                  %<P-R "READ-BYTE"> X$UP-READ-BYTE>
 321   <T$SETG BYTES/WORD 4>
 322   <SETG BUFLEN 80>
 323   <SETG SBUFLEN <* ,BYTES/WORD ,BUFLEN>>
 324   <SETG I$UBUF1 <IUVECTOR 1>>
 325   <SETG I$STAT-STRING <ISTRING ,STAT-LEN>>
 326   <SETG I$ERROR-STRINGS <VECTOR "Not file owner or super-user"
 327                                 "No such file or directory"
 328                                 "No such process"
 329                                 "Interrupted system call"
 330                                 "Physical I/O error"
 331                                 "No such device or address"
 332                                 "Arg list too long to EXEC"
 333                                 "EXEC format error"
 334                                 "Bad file number or wrong mode"
 335                                 "No children"
 336                                 "No more processes in system"
 337                                 "Not enough core in system"
 338                                 "File protection violation"
 339                                 "Bad address to system call"
 340                                 "Block device required"
 341                                 "Mount device busy"
 342                                 "File already exists"
 343                                 "Cross-device link"
 344                                 "No such device"
 345                                 "Not a directory"
 346                                 "Is a directory"
 347                                 "Invalid argument"
 348                                 "System file table overflow"
 349                                 "Too many open files in process"
 350                                 "Not a typewriter"
 351                                 "Text file busy"
 352                                 "File too large"
 353                                 "No space left on device"
 354                                 "Illegal seek"
 355                                 "Read-only file system"
 356                                 "Too many links to file"
 357                                 "Broken pipe"
 358                                 "Math argument out of range"
 359                                 "Result too large"
 360                                 "Operation would block"
 361                                 "Operation now in progress"
 362                                 "Operation already in progress"
 363                                 "Socket operation on non-socket"
 364                                 "Destination address required"
 365                                 "Message too long"
 366                                 "Protocol wrong type for socket"
 367                                 "Bad protocol option"
 368                                 "Protocol not supported"
 369                                 "Socket type not supported"
 370                                 "Operation not suported on socket"
 371                                 "Protocol family not supported"
 372                                 "Address family not supported by protocol family"
 373                                 "Address already in use"
 374                                 "Can't assign requested address"
 375                                 "Network is down"
 376                                 "Network is unreachable"
 377                                 "Network dropped connection on reset"
 378                                 "Software caused connection abort"
 379                                 "Connection reset by peer"
 380                                 "No buffer space available"
 381                                 "Socket is already connected"
 382                                 "Socket is not connected"
 383                                 "Can't send after socket shutdown"
 384                                 "unused"
 385                                 "Connection timed out"
 386                                 "Connection refused"
 387                                 "Too many levels of symbolic links"
 388                                 "File name too long"
 389                                 "Directory not empty">>T>
 390
 391 <DEFINE X$IO-LOAD (BOOTYP)
 392    <T$FLOAD "/USR/MIM/CHANNEL-OPERATION.MSUBR">
 393    <T$FLOAD "/USR/MIM/HOMEDIR.MSUBR">
 394    <T$FLOAD "/USR/MIM/TTY.MSUBR">
 395    <SETG M$$FLATCHAN
 396                 <X$RESET <CHTYPE [I$FLATSIZE <> <> T 0 <>] T$CHANNEL>>>
 397    <SETG M$$INTCHAN <X$RESET <CHTYPE [I$UNPARSE <> <> T "" <>] T$CHANNEL>>>
 398    T>
 399
 400 ; "Eventually this needs to do something about the name (if that's
 401    possible).  Note that cretinous UNIX doesn't provide an error-name
 402    system call."
 403 <DEFINE T$SYS-ERR (NAME ERR "OPTIONAL" (NAME? T))
 404   #DECL ((NAME) STRING (ERR) <FALSE FIX> (NAME?) <OR ATOM FALSE>)
 405   <I$STD-ERROR .NAME .ERR .NAME?>>
 406
 407 <DEFINE T$TRANSLATE-ERROR (ERR:<FALSE FIX> "AUX" (EC:FIX <1 .ERR>)
 408                            (ERRS:VECTOR ,I$ERROR-STRINGS))
 409    <COND (<G? .EC <LENGTH .ERRS>>
 410           "Unknown error")
 411          (T
 412           <NTH .ERRS .EC>)>>
 413
 414 <DEFINE I$STD-ERROR (NAME ERR "OPTIONAL" (NAME? T)
 415                      "AUX" ES)
 416   #DECL ((ES NAME) STRING (ERR) <FALSE FIX> (NAME?) <OR ATOM FALSE>)
 417   <SET ES <T$TRANSLATE-ERROR .ERR>>
 418   <COND (.NAME?
 419          <SET NAME <I$STD-STRING <T$PARSE-FILE-NAME .NAME T T> T>>)>
 420   <CHTYPE (.ES .NAME !.ERR) FALSE>>
 421
 422 <DEFINE T$FILE-STAT (FIL "OPTIONAL" (SST ,I$STAT-STRING))
 423   #DECL ((FIL) <OR STRING FIX> (SST) STRING)
 424   <COND (<COND (<TYPE? .FIL STRING>
 425                 <CALL SYSCALL STAT .FIL .SST>)
 426                (T
 427                 <CALL SYSCALL FSTAT .FIL .SST>)>
 428          .SST)>>
 429
 430 <DEFINE T$STAT-FIELD (STR OFFS SIZE)
 431   #DECL ((STR) STRING (OFFS SIZE) FIX)
 432   <COND (<==? .SIZE 4>
 433          <ORB <NTH .STR .OFFS>
 434               <LSH <NTH .STR <+ .OFFS 1>> 8>
 435               <LSH <NTH .STR <+ .OFFS 2>> 16>
 436               <LSH <NTH .STR <+ .OFFS 3>> 24>>)
 437         (<==? .SIZE 2>
 438          <ORB <NTH .STR .OFFS>
 439               <LSH <NTH .STR <+ .OFFS 1>> 8>>)
 440         (<1? .SIZE>
 441          <CHTYPE <NTH .STR .OFFS> FIX>)>>
 442
 443 <DEFINE T$GET-DEVICE-TYPE (FIL "OPTIONAL" (NAME? <>) "AUX" SST)
 444   #DECL ((FIL) <OR STRING FIX> (NAME?) <OR ATOM FALSE> (SST) <OR FALSE STRING>)
 445   <COND (<OR <TYPE? .FIL FIX> .NAME?>
 446          <SET SST <T$FILE-STAT .FIL>>)
 447         (<SET SST .FIL>)>
 448   <COND (.SST
 449          <ORB <T$STAT-FIELD .SST ,MAJOR-DEV-OFFS ,MAJOR-DEV-SIZE>
 450               <ANDB <T$STAT-FIELD .SST ,MODE-OFFS ,MODE-SIZE> ,FMT-MASK>>)>>
 451
 452 <DEFINE T$GET-BYTE-COUNT (FIL BINARY? "AUX" BC ST)
 453   #DECL ((FIL) <OR STRING FIX> (BC) FIX (ST) <OR STRING FALSE>
 454          (BINARY?) <OR ATOM FALSE>)
 455   <COND (<SET ST <T$FILE-STAT .FIL>>
 456          <SET BC <T$STAT-FIELD .ST ,SIZE-OFFS ,SIZE-SIZE>>
 457          <COND (.BINARY?
 458                 </ <+ .BC <- ,BYTES/WORD 1>> ,BYTES/WORD>)
 459                (.BC)>)>>
 460 \\f
 461 <DEFINE T$PARSE-FILE-NAME (STR "OPTIONAL" (DEFAULTS? T) (STD? <>) STOR
 462                          "AUX" (NS <STACK <IVECTOR 5>>) TS
 463                          (TDEV <>) (TSNM <>) DT)
 464   #DECL ((STR) STRING (DEFAULTS?) <OR ATOM FALSE> (STOR NS) <PRIMTYPE VECTOR>
 465          (TS) <OR STRING FALSE> (TDEV TSNM) <OR FIX FALSE STRING>)
 466   <COND (<NOT <ASSIGNED? STOR>>
 467          <SET STOR .NS>)>
 468   <SET TS <T$STANDARD-NAME .STR>>
 469   <COND (<AND <N==? <SET DT <T$GET-DEVICE-TYPE .TS T>> ,DEV-DISK>
 470               .DT
 471               <N==? .DT ,DEV-OTHER-DISK>
 472               <N==? .DT ,DEV-BDISK>
 473               <N==? .DT ,DEV-VDISK>
 474               <N==? .DT ,DEV-OVDISK>
 475               <N==? .DT %<CHTYPE <ORB ,FMT-IFDIR 3> FIX>>
 476               <N==? .DT %<CHTYPE ,FMT-IFDIR FIX>>
 477               <N==? .DT %<CHTYPE <ORB ,FMT-IFDIR 7> FIX>>
 478               <N==? .DT %<CHTYPE <ORB ,FMT-IFDIR 9> FIX>>
 479               <N==? .DT %<CHTYPE <ORB ,FMT-IFDIR 15> FIX>>>
 480          <1 .STOR <I$STD-STRING .TS T>>
 481          <2 .STOR <>>
 482          <3 .STOR <>>
 483          <4 .STOR <>>
 484          .TS)
 485         (T
 486          <COND (<SET TS <I$BMEMQ !\/ .STR>>
 487                 <SET TS <REST .TS>>)
 488                (<SET TS .STR>)> ; "Extract non-directory component"
 489          <COND (<AND <NOT <EMPTY? .STR>>
 490                      <==? .TS <REST .STR>>
 491                      <==? <1 .STR> !\/>>
 492                 ; "Don't have any file name part"
 493                 <SET TS <REST .TS <LENGTH .TS>>>)>
 494          <I$COMPONENTS .TS <REST .STOR 2> .DEFAULTS?>   ; "Make nm1 and nm2"
 495          <COND (<OR <NOT .DEFAULTS?>
 496                     <TYPE? <SET TDEV <X$VALUE? %<P-R "DEV">>> FALSE FIX>>
 497                 <SET TDEV <>>)>
 498          <COND (<OR <NOT .DEFAULTS?>
 499                     <TYPE? <SET TSNM <X$VALUE? %<P-R "SNM">>> FALSE FIX>>
 500                 <SET TSNM <>>)>
 501          ; "Fill in device and directory from arg, directory, dev, snm."
 502          <COND (<T$PARSE-DIR .STR .TS .STOR .TDEV .TSNM>
 503                 <COND (.STD?
 504                        <T$STANDARD-NAME <I$UNPARSE-SPEC .STOR>>)
 505                       (<I$UNPARSE-SPEC .STOR>)>)>)>>
 506
 507 <DEFINE I$UNPARSE-SPEC (STOR "OPT" (BITS *37*) "AUX" TS)
 508   #DECL ((STOR) <<PRIMTYPE VECTOR> <OR T$ATOM STRING> <OR T$ATOM STRING FALSE>
 509                         <OR STRING FALSE> <OR STRING FALSE> <OR STRING FALSE>>
 510          (TS) <OR T$ATOM STRING FALSE>)
 511   <STRING <COND (<OR <TYPE? <SET TS <1 .STOR>> T$ATOM>
 512                      <0? <ANDB .BITS *20*>>>
 513                  ; "Don't include leading / if device not requested"
 514                  "")
 515                 (<OR <EMPTY? .TS>
 516                      <N==? <1 .TS> !\/>>
 517                  !\/)
 518                 (T
 519                  "")>
 520           <COND (<AND <TYPE? .TS T$ATOM>
 521                       <NOT <0? <ANDB .BITS *30*>>>>
 522                  <I$STD-STRING <5 .STOR> T>)
 523                 (<NOT <0? <ANDB .BITS *20*>>>
 524                  .TS)
 525                 ("")>
 526           <COND (<OR <TYPE? <SET TS <2 .STOR>> ATOM FALSE>
 527                      <0? <ANDB .BITS *10*>>
 528                      <EMPTY? <1 .STOR>>
 529                      <AND <NOT <EMPTY? .TS>> <==? <1 .TS> !\/>>>
 530                  "")
 531                 (!\/)>
 532           <COND (<AND <TYPE? .TS STRING>
 533                       <NOT <EMPTY? .TS>>
 534                       <NOT <0? <ANDB .BITS *10*>>>>
 535                  .TS)
 536                 ("")>
 537           <COND (<AND <OR <3 .STOR> <4 .STOR>>
 538                       <NOT <0? <ANDB .BITS 6>>>
 539                       <NOT <0? <ANDB .BITS *30*>>>>
 540                  "/")
 541                 ("")>
 542           <COND (<OR <NOT <3 .STOR>>
 543                      <0? <ANDB .BITS 4>>> "")
 544                 (<3 .STOR>)>
 545           <COND (<AND <4 .STOR>
 546                       <NOT <0? <ANDB .BITS 2>>>> ".")
 547                 ("")>
 548           <COND (<OR <NOT <4 .STOR>>
 549                      <0? <ANDB .BITS 2>>> "")
 550                 (<4 .STOR>)>>>
 551
 552 ; "Called with beginning of name string, name string rested to just
 553    past last /, 5-tuple, default dev and snm.  Maybe return <>, sometimes.
 554    Call with <> <> .STOR <> <> to force breakup of directory name into
 555    components; name is <5 .STOR>."
 556 <DEFINE T$PARSE-DIR I$DIRACT (STR TS STOR TDEV TSNM "AUX" (FORCE? <>)
 557                         RSNM RDEV TEMP TEMP2 USER DT RSTR FOO)
 558   #DECL ((STR TS) <OR STRING FALSE> (STOR) <PRIMTYPE VECTOR> (FOO RSTR) STRING
 559          (TEMP2 TEMP TDEV TSNM) <OR STRING FALSE> (I$DIRACT) <SPECIAL FRAME>
 560          (DT) <OR FIX FALSE> (FORCE?) <OR ATOM FALSE>)
 561   <COND (.STR
 562          <COND (<AND <==? <LENGTH .STR> 1>
 563                      <==? <1 .STR> !\/>>
 564                 ; "Allow opening of /"
 565                 <SET TS <REST .STR <LENGTH .STR>>>)
 566                (<AND <==? .STR .TS>
 567                      <NOT <EMPTY? .TS>>
 568                      <==? <1 .TS> !\/>>
 569                 <SET TS <REST .TS>>)
 570                (<AND <N==? .STR .TS>
 571                      <==? <1 <SET FOO <BACK .TS>>> !\/>>
 572                 <SET TS <BACK .TS>>)>
 573          <SET RSTR <T$STANDARD-NAME <I$NEW-STRING .STR .TS>>>)
 574         (T
 575          <SET RSTR <5 .STOR>>
 576          <SET FORCE? T>)>
 577   <COND (<OR <EMPTY? .RSTR>
 578              <AND <==? <LENGTH .RSTR> 1>
 579                   <==? <1 .RSTR> <ASCII 0>>>>
 580          ; "User didn't supply directory, use default"
 581          <COND (<OR <NOT .TDEV> <NOT .TSNM>>
 582                 <I$GET-CONNECTED-DIR>
 583                 <COND (<NOT .TDEV>
 584                        <SET TDEV ,I$CDEV>)>
 585                 <COND (<NOT .TSNM>
 586                        <SET TSNM ,I$CDIR>)>
 587                 <COND (<NOT <OR .TDEV .TSNM>>
 588                        <5 .STOR ,I$CONNECTED-DIR>)>)>
 589          <1 .STOR .TDEV>
 590          <2 .STOR .TSNM>)
 591         (T
 592          <COND (<==? <1 .RSTR> !\~>     ; "Home directory hack?"
 593                 <SET RSTR <REST .RSTR>>
 594                 <SET TEMP <MEMQ !\/ .RSTR>>
 595                 <SET USER <I$NEW-STRING .RSTR .TEMP>>
 596                 <COND (<SET TEMP2 <T$GET-HOME-DIR .USER T>>
 597                        <SET RSTR <STRING .TEMP2 .TEMP>>)
 598                       (T
 599                        ; "Couldn't find home directory"
 600                        <RETURN .TEMP2 .I$DIRACT>)>)>
 601          <COND (<AND <N==? <SET DT <T$GET-DEVICE-TYPE .RSTR T>> ,DEV-DISK>
 602                      .DT
 603                      <N==? .DT ,DEV-OTHER-DISK>
 604                      <N==? .DT ,DEV-BDISK>
 605                      <N==? .DT ,DEV-OVDISK>
 606                      <N==? .DT ,DEV-VDISK>
 607                      <N==? .DT %<CHTYPE <ORB ,FMT-IFDIR 3> FIX>>
 608                      <N==? .DT %<CHTYPE ,FMT-IFDIR FIX>>
 609                      <N==? .DT %<CHTYPE <ORB ,FMT-IFDIR 7> FIX>>
 610                      <N==? .DT %<CHTYPE <ORB ,FMT-IFDIR 9> FIX>>
 611                      <N==? .DT %<CHTYPE <ORB ,FMT-IFDIR 15> FIX>>>
 612                 <1 .STOR <I$STD-STRING .RSTR T>>
 613                 <2 .STOR <>>)
 614                (<AND <NOT .FORCE?>
 615                      <NOT <SET TEMP <MEMQ !\. .RSTR>>>
 616                      <==? <1 .RSTR> !\/>>
 617                 ; "No other funniness, just return.  Break down later,
 618                    if requested."
 619                 <5 .STOR .RSTR>
 620                 <1 .STOR T>
 621                 <2 .STOR T>)
 622                (T
 623                 <I$SET-STUFF .STOR !<I$CANONICAL-DIR .RSTR T>>)>)>>
 624
 625 <DEFINE I$SET-STUFF (STOR SNM DEV STR)
 626   #DECL ((STOR) <PRIMTYPE VECTOR>)
 627   <5 .STOR .STR>
 628   <1 .STOR .DEV>
 629   <2 .STOR .SNM>>
 630
 631 <DEFINE I$CANONICAL-DIR CD (STR STANDARD? "AUX" DEV DIR TS)
 632   #DECL ((DEV DIR STR) STRING (STANDARD?) <OR ATOM FALSE>
 633          (TS) <OR STRING FALSE>)
 634   <COND (<EMPTY? .STR>
 635          <SET STR ".\0">
 636          <SET STANDARD? T>)>
 637   <COND (<OR <MEMQ !\. .STR>
 638              <N==? <1 .STR> !\/>>       ; "Hair required"
 639          <COND (<SET TS <I$CANONICAL-NAME .STR .STANDARD?>>
 640                 <SET STANDARD? T>
 641                 <SET STR .TS>)
 642                (<ASSIGNED? I$DIRACT>
 643                 <RETURN .TS .I$DIRACT>)
 644                (<RETURN .TS .CD>)>)>
 645   <COND (<NOT .STANDARD?>
 646          <SET STR <T$STANDARD-NAME .STR>>)>
 647   <REPEAT ((CDEV <T$STAT-FIELD <T$FILE-STAT .STR> ,DEV-OFFS ,DEV-SIZE>)
 648            (RDEV <T$STAT-FIELD <T$FILE-STAT "/\0"> ,DEV-OFFS ,DEV-SIZE>)
 649            TS (TDEV -1) (RS <REST .STR <LENGTH .STR>>))
 650     #DECL ((TDEV CDEV RDEV) FIX (TS) <OR FALSE STRING>)
 651     <COND (<AND <SET TS <I$BMEMQ !\/ .STR .RS>>
 652                 <N==? .TS .STR>>
 653            <1 .TS <ASCII 0>>
 654            <SET TDEV <T$STAT-FIELD <T$FILE-STAT .STR> ,DEV-OFFS ,DEV-SIZE>>
 655            <1 .TS !\/>
 656            <COND (<N==? .TDEV .CDEV>
 657                   <COND (<EMPTY? .RS>
 658                          <SET DEV "">
 659                          <SET DIR <I$STD-STRING <REST .STR> T <- <LENGTH .STR> 2>>>)
 660                         (T
 661                          <SET DIR <I$STD-STRING <REST .RS> T <- <LENGTH .RS> 2>>>
 662                          <SET DEV <I$STD-STRING <REST .STR> T
 663                                                 <- <LENGTH .STR> <LENGTH .RS> 1>>>)>
 664                   <RETURN>)>
 665            <SET RS .TS>)
 666           (<N==? .RDEV .TDEV>
 667            ; "Handle /usr/taa, where /usr and /usr/taa are on same device,
 668               but /usr is root of a filesystem"
 669            <COND (<EMPTY? .RS>
 670                   <SET DEV "">
 671                   <SET DIR <I$STD-STRING <REST .STR> T
 672                                          <- <LENGTH .STR> 2>>>)
 673                  (T
 674                   <SET DIR <I$STD-STRING <REST .RS> T <- <LENGTH .RS> 2>>>
 675                   <SET DEV <I$STD-STRING <REST .STR> T
 676                                          <- <LENGTH .STR> <LENGTH .RS> 1>>>)>
 677            <RETURN>)
 678           (T
 679            <SET DEV "">
 680            <SET DIR <I$STD-STRING <REST .STR> T <- <LENGTH .STR> 2>>>
 681            <RETURN>)>>
 682   <MULTI-RETURN .CD .DIR .DEV .STR>>
 683
 684 <DEFINE I$CANONICAL-NAME CN (STR STANDARD? "AUX" SINODE (CURR? <>)
 685                              TEMP (DOT ".\0") (DOTDOT "..\0") (RNAM "/\0")
 686                              (L ()) STAT RINO RDEV INO DDEV
 687                              (ERR? T))
 688   #DECL ((STAT STR) STRING (STANDARD?) <OR ATOM FALSE>
 689          (SINODE INO DDEV RINO RDEV) FIX
 690          (L) <LIST [REST <OR STRING CHARACTER>]> (ERR?) <OR ATOM FALSE>)
 691   <COND (<OR <=? .STR ".">
 692              <=? .STR .DOT>>
 693          <SET CURR? T>)>
 694   <COND (<NOT .STANDARD?>
 695          <SET STR <T$STANDARD-NAME .STR>>)>
 696   <COND (<NOT .CURR?>
 697          <I$GET-CONNECTED-DIR>          ; "Make sure we have it"
 698          <COND (<NOT <SET TEMP <CALL SYSCALL CHDIR .STR>>>
 699                 <RETURN .TEMP .CN>)>)>
 700   <COND (<NOT <GASSIGNED? I$DIR-BLOCK>>
 701          <SETG I$DIR-BLOCK <ISTRING ,DIRBLKSIZ <ASCII 0>>>
 702          <SETG I$NAM-BLOCK <ISTRING ,MAXNAMLEN <ASCII 0>>>)>
 703   <SET STAT <T$FILE-STAT .RNAM>>
 704   <SET RINO <T$STAT-FIELD .STAT ,INODE-OFFS ,INODE-SIZE>>
 705   <SET RDEV <T$STAT-FIELD .STAT ,DEV-OFFS ,DEV-SIZE>>
 706   <SET STAT <T$FILE-STAT .DOT>>
 707   <SET INO <T$STAT-FIELD .STAT ,INODE-OFFS ,INODE-SIZE>>
 708   <SET DDEV <T$STAT-FIELD .STAT ,DEV-OFFS ,DEV-SIZE>>
 709   <COND (<AND <==? .RINO .INO>
 710               <==? .RDEV .DDEV>>
 711          ; "Return immediately if looking at root"
 712          <SET STR .RNAM>)
 713         (T
 714          <REPEAT OUTLOOP (CH NINO NDDEV (DB ,I$DIR-BLOCK) DIFF?)
 715            #DECL ((DDEV NINO) FIX (CH) <OR FIX FALSE> (DB STAT) STRING
 716                   (DIFF?) <OR ATOM FALSE>)
 717            <COND (<SET CH <CALL SYSCALL OPEN .DOTDOT ,O-RDONLY 0>>
 718                   ; "Read the inode and device for the superior directory"
 719                   <SET NINO <T$STAT-FIELD <SET STAT <T$FILE-STAT .CH>>
 720                                           ,INODE-OFFS ,INODE-SIZE>>
 721                   <SET NDDEV <T$STAT-FIELD .STAT ,DEV-OFFS ,DEV-SIZE>>
 722                   ; "And connect to it"
 723                   <CALL SYSCALL CHDIR .DOTDOT>
 724                   ; "If just changed devices, extra hair needed."
 725                   <COND (<==? .NDDEV .DDEV>
 726                          <SET DIFF? <>>)
 727                         (<SET DIFF? T>)>
 728                   ; "Grovel through superior, looking for inferior's name"
 729                   <REPEAT (TS CT)
 730                     #DECL ((CT) <OR FIX FALSE>)
 731                     ; "Read a directory block"
 732                     <SET CT <CALL SYSCALL READ .CH .DB ,DIRBLKSIZ>>
 733                     <COND (<OR <NOT .CT> <L? .CT ,DIRBLKSIZ>>
 734                            <CALL SYSCALL CLOSE .CH>
 735                            <COND (.CT
 736                                   <SET CT
 737                                        #FALSE ("Directory has no superior?")>)>
 738                            <RETURN .CT .CN>)>
 739                     ; "Compare inodes, possibly devices.  In 4.2, probably more
 740                        than one file in directory block."
 741                     <COND
 742                      (<REPEAT ((DDB .DB) TINO NAMLEN RECLEN NNM)
 743                         #DECL ((DDB) STRING)
 744                         <COND (<EMPTY? .DDB> <RETURN>)>
 745                         <SET TINO <T$STAT-FIELD .DDB ,INODE-START ,INODE-LEN>>
 746                         ; "Pick up first inode #"
 747                         <SET RECLEN <T$STAT-FIELD .DDB ,RECLEN-START ,RECLEN-LEN>>
 748                         ; "Length of this entry"
 749                         <SET NAMLEN <T$STAT-FIELD .DDB ,NAMLEN-START ,NAMLEN-LEN>>
 750                         ; "Length of name in this entry"
 751                         <SET NNM <REST .DDB ,NAME-START>>
 752                         <COND (<COND (<NOT .DIFF?>
 753                                       <==? .TINO .INO>)
 754                                      (T
 755                                       <AND <==? .INO
 756                                                 <T$STAT-FIELD
 757                                                  <SET STAT
 758                                                       <T$FILE-STAT
 759                                                        ; "NAME IS NULL-TERMINATED"
 760                                                        .NNM>>
 761                                                  ,INODE-OFFS ,INODE-SIZE>>
 762                                            <==? .DDEV
 763                                                 <T$STAT-FIELD .STAT
 764                                                               ,DEV-OFFS
 765                                                               ,DEV-SIZE>>>)>
 766                                ; "Have name from superior"
 767                                <SET TS <MEMQ <ASCII 0> .NNM>>
 768                                ; "Cons onto list, close directory, return."
 769                                <SET L (!\/ <I$NEW-STRING .NNM .TS> !.L)>
 770                                <CALL SYSCALL CLOSE .CH>
 771                                <RETURN T>)>
 772                         <COND (<EMPTY? <SET DDB <REST .DDB .RECLEN>>>
 773                                ; "Are we through with this block?"
 774                                <RETURN <>>)>>
 775                       ; "Now looking at superior"
 776                       <COND (<AND <==? .NINO .RINO>
 777                                   <==? .NDDEV .RDEV>>
 778                              ; "Superior is root, no need to look further"
 779                              <RETURN T .OUTLOOP>)>
 780                       <SET INO .NINO>
 781                       <SET DDEV .NDDEV>
 782                       <RETURN>)>>)
 783                  (T
 784                   <SET ERR? .CH>
 785                   <RETURN>)>>
 786          <SET STR <T$STRING !.L <ASCII 0>>>)>
 787   <COND (.CURR?
 788          <CALL SYSCALL CHDIR .STR>)
 789         (<CALL SYSCALL CHDIR ,I$CONNECTED-DIR>)>
 790   <COND (.ERR?
 791          .STR)>>
 792
 793 <DEFINE I$STD-STRING (STR RAISE? "OPTIONAL" (ES? <REST .STR <LENGTH .STR>>))
 794   #DECL ((STR) STRING (RAISE?) <OR ATOM FALSE> (ES?) <OR STRING FIX>)
 795   <COND (<TYPE? .ES? FIX>
 796          <SET ES? <REST .STR .ES?>>)>
 797   <MAPR ,STRING
 798     <FUNCTION (SS "AUX" (C <1 .SS>) (A <ASCII .C>))
 799       #DECL ((C) CHARACTER (A) FIX)
 800       <COND (<OR <0? .A> <==? .ES? .SS>> <MAPSTOP>)
 801             (.RAISE?
 802              <COND (<AND <G=? .A <ASCII !\a>>
 803                          <L=? .A <ASCII !\z>>>
 804                     <ASCII <+ .A <- <ASCII !\A> <ASCII !\a>>>>)
 805                    (<AND <G=? .A <ASCII !\A>>
 806                          <L=? .A <ASCII !\Z>>>
 807                     <MAPRET !\^ .C>)
 808                    (.C)>)
 809             (.C)>>
 810     .STR>>
 811
 812 <DEFINE T$RENAME (OLD NEW "AUX" ONAME NNAME VAL)
 813   #DECL ((OLD NEW) STRING (ONAME NNAME) <OR STRING FALSE>)
 814   <COND (<AND <SET VAL <SET ONAME <T$PARSE-FILE-NAME .OLD T T>>>
 815               <SET VAL <SET NNAME <T$PARSE-FILE-NAME .NEW T T>>>
 816               <SET VAL <CALL SYSCALL RENAME .ONAME .NNAME>>>
 817          <I$STD-STRING .NNAME T>)
 818         (T
 819          <I$STD-ERROR .OLD .VAL>)>>
 820
 821 <DEFINE T$DELFILE (NM "OPTIONAL" (T$NM1 <X$VALUE? T$NM1>)
 822                    (T$NM2 <X$VALUE? T$NM2>) (T$DEV <X$VALUE? T$DEV>)
 823                    (T$SNM <X$VALUE? T$SNM>) "AUX" NAME VAL)
 824   #DECL ((NM) STRING (T$NM1 T$NM2 T$DEV T$SNM) <SPECIAL <OR STRING FIX>>)
 825   <COND (<SET NAME <T$PARSE-FILE-NAME .NM T T>>
 826          <COND (<SET VAL <CALL SYSCALL UNLINK .NAME>>
 827                 .NM)
 828                (<I$STD-ERROR .NM .VAL>)>)
 829         (<I$STD-ERROR .NM .NAME>)>>
 830
 831 <DEFINE T$FILE-EXISTS? (NAME "OPTIONAL" (T$NM1 <X$VALUE? T$NM1>)
 832                         (T$NM2 <X$VALUE? T$NM2>)(T$DEV <X$VALUE? T$DEV>)
 833                         (T$SNM <X$VALUE? T$SNM>) "AUX" FID NN)
 834   #DECL ((NAME) STRING (T$NM1 T$NM2 T$DEV T$SNM) <SPECIAL <OR STRING FIX>>)
 835   <COND (<SET NN <T$PARSE-FILE-NAME .NAME T T>>
 836          <COND (<SET FID <CALL SYSCALL ACCESS .NN ,F-OK>>
 837                 T)
 838                (T
 839                 <I$STD-ERROR .NAME .FID>)>)
 840         (<I$STD-ERROR .NAME .NN>)>>