1 <DEFINE T$HANG ("OPTIONAL" (PRED <>))
3 <COND (<SET VAL <T$EVAL .PRED>>
7 <DEFINE T$JNAME ("OPT" NEW:STRING "AUX" WD:FIX (TS <STACK <ISTRING 6>>) CT)
8 <COND (<NOT <ASSIGNED? NEW>>
9 <SET WD <CALL SYSOP GETNM '(RETURN 1)>>
11 <COND (<0? .WD> <RETURN>)>
13 <SET CHR <ASCII <+ <ANDB .WD 63> 32>>>
14 <SET WD <ANDB .WD -64>>
17 <SUBSTRUC <TOP .TS> 0 <- 6 <LENGTH .TS>>>)
23 <SET WD <ORB <LSH .WD 6> <ANDB <- <ASCII .CHR> 32> 63>>>
24 <COND (<G=? <SET CT <+ .CT 1>> 6>
27 <CALL SYSOP SETNM .WD>
30 <DEFINE T$SLEEP (TM "OPTIONAL" (PRED <>) "AUX" RTM)
31 #DECL ((TM) <OR FIX FLOAT> (RTM) FIX)
32 <COND (<TYPE? .TM FLOAT>
33 <SET RTM <FIX <* .TM 1000.0>>>)
34 (<SET RTM <* .TM 1000>>)>
37 <COND (<SET VAL <T$EVAL .PRED>>
39 <SET STIME <CALL SYSOP TIME-JSYS '(RETURN 1)>>
41 <COND (<L=? <SET RTM <- .RTM
42 <- <CHTYPE <CALL SYSOP TIME-JSYS '(RETURN 1)> FIX>
48 ; "System initialization--none needed for 20x"
49 <COND (<NOT <GASSIGNED? T$HOME-STRUC>><SETG T$HOME-STRUC "MIM">)>
52 <DEFINE T$SYS-ERR (NAME ERR "OPTIONAL" (NAME? T))
53 #DECL ((NAME) STRING (ERR) <FALSE FIX> (NAME?) <OR ATOM FALSE>)
54 <I$STD-ERROR .NAME .ERR .NAME?>>
56 <DEFINE T$TRANSLATE-ERROR (ERR:<FALSE FIX> "AUX" CT ES (NS:STRING ,I$NAMSTR))
57 <SET CT <CALL SYSOP ERSTR
59 <PUTLHW <1 .ERR> ,/FHSLF>
60 <PUTLHW 0 <- <LENGTH .NS>>>>>
61 <SET ES <ISTRING .CT>>
62 <SUBSTRUC .NS 0 .CT .ES>>
64 <DEFINE I$STD-ERROR (NAME ERR "OPTIONAL" (NAME? T) "AUX"
65 (NS <STACK <ISTRING 500>>) CT ES)
66 #DECL ((ES NS NAME) STRING (ERR) <FALSE FIX>)
67 <SET ES <T$TRANSLATE-ERROR .ERR>>
69 <PROG (JFN (NM1 <X$VALUE? NM1>) (NM2 <X$VALUE? NM2>)
70 (DEV <X$VALUE? DEV>) (SNM <X$VALUE? SNM>) FNL)
71 #DECL ((JFN) <OR FIX FALSE> (NM1 NM2 DEV SNM) <OR FIX STRING>)
72 <COND (<SET JFN <CALL SYSOP GTJFN-L
75 %<CHTYPE <ORB ,/NULIO <LSH ,/NULIO 18>> FIX>
83 <SET FNL <CALL SYSOP JFNS .NS .JFN 0 0>>
84 <CALL SYSOP RLJFN .JFN>
85 <SET NAME <SUBSTRUC .NS 0 .FNL>>)>>)>
86 <CHTYPE (.ES .NAME !.ERR) FALSE>>
88 <DEFINE T$GET-JFN (NAME MODE BSZ NEW? "AUX" JFN ERR)
89 #DECL ((NAME) STRING (MODE BSZ) FIX (NEW?) <OR ATOM FALSE>
90 (JFN ERR) <OR FIX FALSE>)
92 <SET JFN <CALL SYSOP GTJFN-S-S
93 %<CHTYPE <ORB ,GJ-FOU ,GJ-SHT> FIX>
96 <SET JFN <CALL SYSOP GTJFN-S-S
97 %<CHTYPE <ORB ,GJ-OLD ,GJ-SHT> FIX>
100 <COND (<SET ERR <CALL SYSOP OPENF
106 <CALL SYSOP RLJFN .JFN>
109 <DEFINE T$GET-BYTE-COUNT (JFN BSZ "AUX" OBC OBS FC)
110 #DECL ((FC JFN BSZ OBC OBS) FIX)
111 <SET OBC <CALL SYSOP SIZEF .JFN '(RETURN 2)>>
112 <SET OBS <LSH <ANDB <CALL SYSOP GTFDB
114 %<CHTYPE <ORB ,/FBBYV <LSH 1 18>>
118 <COND (<0? .OBS> <SET OBS 36>)>
119 <COND (<==? .OBS .BSZ> .OBC)
121 <* </ <+ .OBC <- <SET FC </ 36 .OBS>> 1>> .FC>
124 <DEFINE T$CLOSE-OPEN (JFN MODE BSZ)
125 #DECL ((JFN MODE BSZ) FIX)
126 <AND <CALL SYSOP CLOSF <ORB ,CO-NRJ .JFN>>
127 <CALL SYSOP OPENF .JFN
131 <DEFINE T$GET-DEVICE-TYPE (JFN "AUX" VAL)
133 <COND (<SET VAL <CALL SYSOP DVCHR .JFN '(RETURN 2)>>
134 <ANDB <LSH .VAL -18> *777*>)>>
138 <SETG T$MUDDLE-SYSTEM "T">
139 <SETG CRLF-STRING <STRING <ASCII 13> <ASCII 10>>>
141 <SETG TABSTR <ISTRING 10 <ASCII 9>>>
142 <SETG SPACESTR <ISTRING 7 <ASCII 32>>>
143 <SETG I$RDBLEN <* 5 256>>
144 <SETG %<P-R "NM2"> "MUD">
145 <SETG %<P-R "DEVVEC"> [,/DVDSK %<P-R "DISK">
146 ,/DVMTA %<P-R "TWAY">
147 ,/DVLPT %<P-R "TWAY">
148 ,/DVCDR %<P-R "TWAY">
150 ,/DVTTY [%<P-R "TTY"> T T]
151 ,/DVPTY [%<P-R "TTY"> T T]
152 ,/DVNUL [%<P-R "TWAY"> <> <>]
153 ,/DVNET [%<P-R "TWAY"> T T]]>
154 <SETG I$NAMSTR <T$ISTRING 100>>
155 <SETG I$CHANNEL-TYPES ()>
156 <T$NEW-CHANNEL-TYPE %<P-R "DEFAULT"> <>
157 %<P-R "NAME"> X$DEF-NAME
158 %<P-R "NM1"> X$DEF-NM1
159 %<P-R "NM2"> X$DEF-NM2
160 %<P-R "DEV"> X$DEF-DEV
161 %<P-R "SNM"> X$DEF-SNM
162 %<P-R "SHORT-NAME"> X$DEF-SHORT-NAME
163 %<P-R "FLUSH"> X$DEF-FLUSH
164 %<P-R "READ-DATE"> X$DEF-HACK-DATE
165 %<P-R "WRITE-DATE"> X$DEF-HACK-DATE
166 %<P-R "GET-MODE"> X$DEF-GET-MODE
167 %<P-R "GET-BYTE-SIZE"> X$DEF-GET-BYTE-SIZE>
168 <T$NEW-CHANNEL-TYPE %<P-R "DISK"> %<P-R "DEFAULT">
169 %<P-R "FILE-HANDLE"> X$DISK-FILE-HANDLE
170 %<P-R "QUERY"> X$DISK-QUERY
171 %<P-R "OPEN"> X$DISK-OPEN
172 %<P-R "CLOSE"> X$DISK-CLOSE
173 %<P-R "FLUSH"> X$DISK-FLUSH
174 %<P-R "READ-BYTE"> X$DISK-READ-BYTE
175 %<P-R "WRITE-BYTE"> X$DISK-WRITE-BYTE
176 %<P-R "READ-BUFFER"> X$DISK-READ-BUFFER
177 %<P-R "WRITE-BUFFER"> X$DISK-WRITE-BUFFER
178 %<P-R "ACCESS"> X$DISK-ACCESS
179 %<P-R "BUFOUT"> X$DISK-BUFOUT
180 %<P-R "FILE-LENGTH"> X$DISK-FILE-LENGTH
181 %<P-R "PRINT-DATA"> X$DISK-PRINT-DATA>
182 <T$NEW-CHANNEL-TYPE I$UNPARSE <>
183 %<P-R "WRITE-BUFFER"> X$UP-WRITE-BUF
184 %<P-R "WRITE-BYTE"> X$UP-WRITE-BYTE
185 %<P-R "READ-BYTE"> X$UP-READ-BYTE>>
187 <DEFINE X$IO-LOAD (BOOTYP)
190 <X$RESET <CHTYPE [I$FLATSIZE <> <> T 0 <>] T$CHANNEL>>>
191 <SETG M$$INTCHAN <X$RESET <CHTYPE [I$UNPARSE <> <> T "" <>] T$CHANNEL>>>
192 <COND (<AND <G=? .BOOTYP 0>
193 <T$FILE-EXISTS? "<MIM.20>CHANNEL-OPERATION.MBIN">>
194 <T$FLOAD "<MIM.20>CHANNEL-OPERATION.MBIN">)
195 (<T$FLOAD "<MIM.20>CHANNEL-OPERATION.MSUBR">)>
196 <COND (<AND <G=? .BOOTYP 0>
197 <T$FILE-EXISTS? "<MIM.20>TWAY.MBIN">>
198 <T$FLOAD "<MIM.20>TWAY.MBIN">)
199 (<T$FLOAD "<MIM.20>TWAY.MSUBR">)>
200 <COND (<AND <G=? .BOOTYP 0>
201 <T$FILE-EXISTS? "<MIM.20>TTY.MBIN">>
202 <T$FLOAD "<MIM.20>TTY.MBIN">)
203 (<T$FLOAD "<MIM.20>TTY.MSUBR">)>>
205 <DEFINE T$RENAME (OLD NEW "AUX" (NM1 <X$VALUE? T$NM1>) (NM2 <X$VALUE? T$NM2>)
206 (DEV <X$VALUE? T$DEV>) (SNM <X$VALUE? T$SNM>) (FOLD <>)
207 (FNEW <>) VAL FNL (NS <STACK <ISTRING 500>>))
208 #DECL ((OLD NEW) STRING (NM1 NM2 DEV SNM) <OR STRING FIX>
209 (FOLD FNEW) <OR FIX FALSE> (FNL) FIX (NS) STRING)
211 <AND <SET FOLD <I$DO-OPEN ,GJ-OLD .OLD .DEV .SNM .NM1 .NM2>>
212 <SET FNEW <I$DO-OPEN ,GJ-FOU .NEW .DEV .SNM .NM1 .NM2>>>>
213 <COND (<SET VAL <CALL SYSOP RNAMF .FOLD .FNEW>>
214 <SET FNL <CALL SYSOP JFNS .NS .FNEW 0 0>>
215 <CALL SYSOP RLJFN .FNEW>
216 <SET NEW <SUBSTRUC .NS 0 .FNL>>
220 <CALL SYSOP RLJFN .FOLD>)>
222 <CALL SYSOP RLJFN .FNEW>)>
223 <I$STD-ERROR .OLD .VAL>)
226 <DEFINE T$DELFILE (NM "OPTIONAL" (NM1 <X$VALUE? T$NM1>) (NM2 <X$VALUE? T$NM2>)
227 (DEV <X$VALUE? T$DEV>) (SNM <X$VALUE? T$SNM>) "AUX" FID VAL)
228 #DECL ((NM) STRING (NM1 NM2 DEV SNM) <OR STRING FIX> (FID) <OR FIX FALSE>)
230 <COND (<SET FID <I$DO-OPEN ,GJ-OLD .NM .DEV .SNM .NM1 .NM2>>
231 <CALL SYSOP DELF .FID>)>>
233 <COND (.FID <CALL SYSOP RLJFN .FID>)>
234 <I$STD-ERROR .NM .VAL>)
237 <DEFINE T$FILE-EXISTS? (NAME "OPTIONAL" (NM1 <X$VALUE? T$NM1>)
238 (NM2 <X$VALUE? T$NM2>)(DEV <X$VALUE? T$DEV>)
239 (SNM <X$VALUE? T$SNM>) "AUX" FID)
240 #DECL ((NAME) STRING (NM1 NM2 DEV SNM) <OR STRING FIX>
241 (FID) <OR FIX FALSE>)
242 <COND (<SET FID <I$DO-OPEN ,GJ-OLD .NAME .DEV .SNM .NM1 .NM2>>
243 <CALL SYSOP RLJFN .FID>
245 (<I$STD-ERROR .NAME .FID>)>>
247 <DEFINE I$DO-OPEN (MODE NAME DEV SNM NM1 NM2)
248 #DECL ((MODE) FIX (NAME) STRING (DEV SNM NM1 NM2) <OR STRING FIX>)
252 %<CHTYPE <ORB ,/NULIO <LSH ,/NULIO 18>> FIX>
253 .DEV ; "Default device"
254 .SNM ; "Default directory"
255 .NM1 ; "Default first name"
256 .NM2 ; "Default second name"
261 <DEFINE T$GEN-OPEN GO (NAME "OPTIONAL" (MODE "READ")
262 (BSZ "ASCII") (DEVNAM <>) "AUX" (NEW? <>) JFN DEVTYP VEC
263 (DEV <X$VALUE? DEV>) (SNM <X$VALUE? SNM>)
264 (NM1 <X$VALUE? NM1>) (NM2 <X$VALUE? NM2>)
265 (NS <STACK <ISTRING 500>>) NNS FNL VAL)
266 #DECL ((NNS NS NAME MODE BSZ) STRING (JFN) <OR FALSE FIX> (FNL DEVTYP) FIX
267 (DEV SNM NM1 NM2) <OR STRING FIX> (DEVNAM) <OR ATOM FALSE VECTOR>)
268 <COND (<=? .MODE "CREATE"> <SET NEW? T>)>
269 <COND (<SET JFN <I$DO-OPEN <COND (.NEW? ,GJ-FOU)
271 .NAME .DEV .SNM .NM1 .NM2>>
272 <SET FNL <CALL SYSOP JFNS .NS .JFN 0 0>>
273 <SET NNS <SUBSTRUC .NS 0 .FNL>>
275 <SET DEVTYP <T$GET-DEVICE-TYPE .JFN>>
276 <COND (<SET VEC <MEMQ .DEVTYP ,T$DEVVEC>>
277 <SET DEVNAM <2 .VEC>>)
278 (<SET DEVNAM %<P-R "TWAY">>)>)>
279 <CALL SYSOP RLJFN .JFN>
282 <COND (<TYPE? .DEVNAM ATOM>
283 <T$CHANNEL-OPEN .DEVNAM .NNS .MODE .BSZ>)
284 (<TYPE? .DEVNAM VECTOR>
285 <T$CHANNEL-OPEN <1 .DEVNAM>
286 .NNS .MODE .BSZ !<REST .DEVNAM>>)>>>
287 <I$STD-ERROR .NAME .VAL>)
289 (<I$STD-ERROR .NAME .JFN>)>>
291 <DEFINE X$VALUE? (ATM "AUX" TS)
292 #DECL ((ATM) ATOM (TS) <OR FALSE FIX STRING>)
293 <SET TS <COND (<ASSIGNED? .ATM>
297 <COND (<OR <NOT .TS> <TYPE? .TS FIX> <EMPTY? .TS>> 0)
300 <DEFINE T$UNAME ("AUX" UNUM (ST ,I$NAMSTR))
301 #DECL ((UNUM) FIX (ST) STRING)
302 <SET UNUM <CALL SYSOP GJINF '(RETURN 1)>>
303 <CALL SYSOP DIRST .ST .UNUM>
304 <I$GET-STRING ,I$NAMSTR>>
306 <DEFINE T$GET-CONNECTED-DIR GCD ("AUX" DIRNUM (ST ,I$NAMSTR) NST DIRST DEVST)
307 #DECL ((DIRNUM) FIX (DIRST DEVST ST NST) STRING)
308 <SET DIRNUM <CALL SYSOP GJINF '(RETURN 2)>>
309 <CALL SYSOP DIRST .ST .DIRNUM>
310 <SET ST <I$GET-STRING ,I$NAMSTR>>
311 <SET NST <MEMQ !\: .ST>>
312 <PUT .ST <LENGTH .ST> <ASCII 0>>
313 <SET DIRST <I$GET-STRING <REST .NST 2>>>
314 <PUT .NST 1 <ASCII 0>>
315 <SET DEVST <I$GET-STRING .ST>>
316 <MULTI-RETURN .GCD .DIRST .DEVST>>
318 <DEFINE I$GET-STRING (ST "AUX" NST RST)
319 #DECL ((ST RST) STRING (NST) <OR STRING FALSE>)
320 <COND (<SET NST <MEMQ <ASCII 0> .ST>>
321 <SUBSTRUC .ST 0 <- <LENGTH .ST> <LENGTH .NST>>>)