1 <DEFINE T$HANG ("OPTIONAL" (PRED <>))
3 <COND (<SET VAL <T$EVAL .PRED>>
5 <ISYSCALL SIGPAUSE 0>>>
7 <DEFINE T$JNAME ("OPT" IGN
8 "AUX" (JCL:<OR FALSE <VECTOR [REST STRING]>> <CALL GETS ARGV>))
10 <REPEAT ((ST <1 .JCL>) TS)
11 <COND (<SET TS <MEMQ !\/ .ST>>
14 <COND (<SET TS <MEMQ !\. .ST>>
15 <RETURN <I$STD-STRING .ST T .TS>>)
17 <RETURN <I$STD-STRING .ST T>>)>)>>)
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>
24 <SET RTM2 <FIX <* 1000000.0 <- .TM .RTM1>>>>)
27 <COND (<NOT <GASSIGNED? UV-2>>
28 <SETG UV-X <IUVECTOR 4 0>>
29 <SETG UV-2 <IUVECTOR 2 0>>)>
32 <REPEAT (VAL STIME1 STIME2)
34 <COND (<L=? .TM 0> <RETURN T>)>
35 <COND (<SET VAL <T$EVAL .PRED>>
37 <CALL SYSCALL GETTIMEOFDAY .UV .UVX>
38 ; "Get seconds and microseconds of current time; will discard time zone"
41 ; "Set up seconds and microseconds of interval"
46 <CALL SYSCALL SETITIMER ,ITIMER-REAL .UVX 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>>)>
57 <SET TM <+ <FLOAT .RTM1> </ <FLOAT .RTM2> 1000000.0>>>>>
59 <DEFINE T$STANDARD-NAME (STR "AUX" (NOCONV? <>) (QUOTE? <>) (QUOTER !\^))
61 <COND (<EMPTY? .STR> <STRING <ASCII 0>>)
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>
70 <G=? <ASCII <2 .S>> <ASCII !\A>>
71 <L=? <ASCII <2 .S>> <ASCII !\Z>>>
75 (<OR .NOCONV? .QUOTE?>
78 (<AND <G=? <ASCII .C> <ASCII !\A>>
79 <L=? <ASCII .C> <ASCII !\Z>>>
81 <ASCII <+ <- <ASCII .C> <ASCII !\A>>
83 (<==? .C <ASCII 0>> <SET VAL <>>)
85 <COND (<==? <LENGTH .S> 1>
86 <COND (.VAL <MAPRET .VAL <ASCII 0>>)
87 (<MAPRET <ASCII 0>>)>)
88 (T <COND (.VAL <MAPRET .VAL>) (T <MAPRET>)>)>>
91 <DEFINE I$BMEMQ (CHR STR "OPTIONAL" (NS <REST .STR <LENGTH .STR>>))
92 #DECL ((CHR) CHARACTER (STR NS) STRING)
94 <COND (<==? .NS .STR> <RETURN <>>)>
96 <COND (<==? <1 .NS> .CHR>
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>
106 <COND (<TYPE? <SET TNM1 <X$VALUE? %<P-R "NM1">>>
112 <SET TNM1 <I$NEW-STRING .STR .TS>>)>)
116 <COND (<TYPE? <SET TNM1 <X$VALUE? %<P-R "NM1">>> FIX>
119 (<SET TNM1 <STRING .STR>>)>
121 <COND (<TYPE? <SET TNM2 <X$VALUE? %<P-R "NM2">>> FIX>
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>>)
132 <SET NS <ISTRING <- <LENGTH .STR1> <LENGTH .STR2>>>>)>
135 #DECL ((S1 S2) STRING)
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>)>
164 <DEFINE T$GET-ENV-STR (STR "OPTIONAL" (ENV ,I$ENVVEC))
165 #DECL ((STR) STRING (ENV) <VECTOR [REST STRING]>)
167 <COND (<EMPTY? .ENV> <RETURN <>>)>
169 <COND (<REPEAT ((NS .STR) (NNS .TS))
170 <COND (<EMPTY? .NNS> <RETURN <>>)>
172 <COND (<==? <1 .NNS> !\=>
176 <COND (<N==? <1 .NS> <1 .NNS>>
179 <SET NNS <REST .NNS>>>
181 (<SET ENV <REST .ENV>>)>>>
186 ; "Makes sure connected directory is known, then returns snm part and dev
188 <DEFINE T$GET-CONNECTED-DIR GCD ()
189 <I$GET-CONNECTED-DIR>
190 <MULTI-RETURN .GCD ,I$CDIR ,I$CDEV>>
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>>>
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>>
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>
218 <I$STILL-CONNECTED?>>
219 <COND (<OR <NOT <GASSIGNED? I$CDIR>>
221 <I$SET-CONNECTED-DIR !<I$CANONICAL-DIR ,I$CONNECTED-DIR T>>)>)
223 <I$SET-CONNECTED-DIR !<I$CANONICAL-DIR "." <>>>)>>
228 <DEFINE X$VALUE? (ATM "AUX" TS)
229 #DECL ((ATM) ATOM (TS) <OR FALSE FIX STRING>)
230 <SET TS <COND (<ASSIGNED? .ATM>
234 <COND (<OR <NOT .TS> <TYPE? .TS FIX> <EMPTY? .TS>> 0)
237 <DEFINE T$GEN-OPEN (NAME "OPTIONAL" (MODE "READ") (BSZ "ASCII")
238 (DEVNAM <>) "AUX" (NEW? <>) VAL STDNAM (DEVTYP ,DEV-DISK)
240 #DECL ((NAME MODE BSZ) STRING (DEVNAM) <OR ATOM FALSE VECTOR>
241 (NEW?) <OR ATOM FALSE>)
242 <COND (<=? .MODE "CREATE">
244 <COND (<SET STDNAM <T$PARSE-FILE-NAME .NAME T T>>
245 <SET NAME <I$STD-STRING .STDNAM T>>
247 <COND (<OR <SET DEVTYP <T$GET-DEVICE-TYPE .STDNAM T>>
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)
255 <COND (<TYPE? .DEVNAM ATOM>
256 <T$CHANNEL-OPEN .DEVNAM .NAME
258 (<TYPE? .DEVNAM VECTOR>
260 <1 .DEVNAM> .NAME .MODE
261 .BSZ !<REST .DEVNAM>>)>>>
262 <I$STD-ERROR .NAME .VAL>)
264 (<I$STD-ERROR .NAME .STDNAM>)>>
267 <SETG T$MUDDLE-SYSTEM "U">
268 <SETG CRLF-STRING <STRING <ASCII 10>>>
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
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
307 T$READ-BUFFER X$DISK-READ-BUFFER
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>
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"
329 "Interrupted system call"
331 "No such device or address"
332 "Arg list too long to EXEC"
334 "Bad file number or wrong mode"
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"
342 "File already exists"
348 "System file table overflow"
349 "Too many open files in process"
353 "No space left on device"
355 "Read-only file system"
356 "Too many links to file"
358 "Math argument out of range"
360 "Operation would block"
361 "Operation now in progress"
362 "Operation already in progress"
363 "Socket operation on non-socket"
364 "Destination address required"
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"
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"
385 "Connection timed out"
387 "Too many levels of symbolic links"
389 "Directory not empty">>T>
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">
396 <X$RESET <CHTYPE [I$FLATSIZE <> <> T 0 <>] T$CHANNEL>>>
397 <SETG M$$INTCHAN <X$RESET <CHTYPE [I$UNPARSE <> <> T "" <>] T$CHANNEL>>>
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
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?>>
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>>
414 <DEFINE I$STD-ERROR (NAME ERR "OPTIONAL" (NAME? T)
416 #DECL ((ES NAME) STRING (ERR) <FALSE FIX> (NAME?) <OR ATOM FALSE>)
417 <SET ES <T$TRANSLATE-ERROR .ERR>>
419 <SET NAME <I$STD-STRING <T$PARSE-FILE-NAME .NAME T T> T>>)>
420 <CHTYPE (.ES .NAME !.ERR) FALSE>>
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>)
427 <CALL SYSCALL FSTAT .FIL .SST>)>
430 <DEFINE T$STAT-FIELD (STR OFFS SIZE)
431 #DECL ((STR) STRING (OFFS SIZE) FIX)
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>>)
438 <ORB <NTH .STR .OFFS>
439 <LSH <NTH .STR <+ .OFFS 1>> 8>>)
441 <CHTYPE <NTH .STR .OFFS> FIX>)>>
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>>)
449 <ORB <T$STAT-FIELD .SST ,MAJOR-DEV-OFFS ,MAJOR-DEV-SIZE>
450 <ANDB <T$STAT-FIELD .SST ,MODE-OFFS ,MODE-SIZE> ,FMT-MASK>>)>>
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>>
458 </ <+ .BC <- ,BYTES/WORD 1>> ,BYTES/WORD>)
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>>
468 <SET TS <T$STANDARD-NAME .STR>>
469 <COND (<AND <N==? <SET DT <T$GET-DEVICE-TYPE .TS T>> ,DEV-DISK>
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>>
486 <COND (<SET TS <I$BMEMQ !\/ .STR>>
488 (<SET TS .STR>)> ; "Extract non-directory component"
489 <COND (<AND <NOT <EMPTY? .STR>>
490 <==? .TS <REST .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>>
498 <COND (<OR <NOT .DEFAULTS?>
499 <TYPE? <SET TSNM <X$VALUE? %<P-R "SNM">>> FALSE FIX>>
501 ; "Fill in device and directory from arg, directory, dev, snm."
502 <COND (<T$PARSE-DIR .STR .TS .STOR .TDEV .TSNM>
504 <T$STANDARD-NAME <I$UNPARSE-SPEC .STOR>>)
505 (<I$UNPARSE-SPEC .STOR>)>)>)>>
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"
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*>>>
526 <COND (<OR <TYPE? <SET TS <2 .STOR>> ATOM FALSE>
527 <0? <ANDB .BITS *10*>>
529 <AND <NOT <EMPTY? .TS>> <==? <1 .TS> !\/>>>
532 <COND (<AND <TYPE? .TS STRING>
534 <NOT <0? <ANDB .BITS *10*>>>>
537 <COND (<AND <OR <3 .STOR> <4 .STOR>>
538 <NOT <0? <ANDB .BITS 6>>>
539 <NOT <0? <ANDB .BITS *30*>>>>
542 <COND (<OR <NOT <3 .STOR>>
543 <0? <ANDB .BITS 4>>> "")
545 <COND (<AND <4 .STOR>
546 <NOT <0? <ANDB .BITS 2>>>> ".")
548 <COND (<OR <NOT <4 .STOR>>
549 <0? <ANDB .BITS 2>>> "")
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>)
562 <COND (<AND <==? <LENGTH .STR> 1>
564 ; "Allow opening of /"
565 <SET TS <REST .STR <LENGTH .STR>>>)
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>>>)
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>
587 <COND (<NOT <OR .TDEV .TSNM>>
588 <5 .STOR ,I$CONNECTED-DIR>)>)>
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>>)
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>
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>>
615 <NOT <SET TEMP <MEMQ !\. .RSTR>>>
617 ; "No other funniness, just return. Break down later,
623 <I$SET-STUFF .STOR !<I$CANONICAL-DIR .RSTR T>>)>)>>
625 <DEFINE I$SET-STUFF (STOR SNM DEV STR)
626 #DECL ((STOR) <PRIMTYPE VECTOR>)
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>)
637 <COND (<OR <MEMQ !\. .STR>
638 <N==? <1 .STR> !\/>> ; "Hair required"
639 <COND (<SET TS <I$CANONICAL-NAME .STR .STANDARD?>>
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>>
654 <SET TDEV <T$STAT-FIELD <T$FILE-STAT .STR> ,DEV-OFFS ,DEV-SIZE>>
656 <COND (<N==? .TDEV .CDEV>
659 <SET DIR <I$STD-STRING <REST .STR> T <- <LENGTH .STR> 2>>>)
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>>>)>
667 ; "Handle /usr/taa, where /usr and /usr/taa are on same device,
668 but /usr is root of a filesystem"
671 <SET DIR <I$STD-STRING <REST .STR> T
672 <- <LENGTH .STR> 2>>>)
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>>>)>
680 <SET DIR <I$STD-STRING <REST .STR> T <- <LENGTH .STR> 2>>>
682 <MULTI-RETURN .CD .DIR .DEV .STR>>
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
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 ".">
694 <COND (<NOT .STANDARD?>
695 <SET STR <T$STANDARD-NAME .STR>>)>
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>
711 ; "Return immediately if looking at root"
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>
728 ; "Grovel through superior, looking for inferior's name"
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>
737 #FALSE ("Directory has no superior?")>)>
739 ; "Compare inodes, possibly devices. In 4.2, probably more
740 than one file in directory block."
742 (<REPEAT ((DDB .DB) TINO NAMLEN RECLEN NNM)
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?>
759 ; "NAME IS NULL-TERMINATED"
761 ,INODE-OFFS ,INODE-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>
772 <COND (<EMPTY? <SET DDB <REST .DDB .RECLEN>>>
773 ; "Are we through with this block?"
775 ; "Now looking at superior"
776 <COND (<AND <==? .NINO .RINO>
778 ; "Superior is root, no need to look further"
779 <RETURN T .OUTLOOP>)>
786 <SET STR <T$STRING !.L <ASCII 0>>>)>
788 <CALL SYSCALL CHDIR .STR>)
789 (<CALL SYSCALL CHDIR ,I$CONNECTED-DIR>)>
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?>>)>
798 <FUNCTION (SS "AUX" (C <1 .SS>) (A <ASCII .C>))
799 #DECL ((C) CHARACTER (A) FIX)
800 <COND (<OR <0? .A> <==? .ES? .SS>> <MAPSTOP>)
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>>>
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>)
819 <I$STD-ERROR .OLD .VAL>)>>
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>>
828 (<I$STD-ERROR .NM .VAL>)>)
829 (<I$STD-ERROR .NM .NAME>)>>
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>>
839 <I$STD-ERROR .NAME .FID>)>)
840 (<I$STD-ERROR .NAME .NN>)>>