1 <USE "JCL" "TTY" "COMFIL" "ITIME" "CDRIVE" "HASH">
2 <SETG BUFSTR <ISTRING 100>>
4 <DEFINE SAV ("OPT" (NAM "MIMC") "AUX" (S <SNAME>))
6 <COND (<=? <SAVE .NAM> "SAVED">
12 <DEFINE START-MIMC ("AUX" FIL FILLEN INFIL OUTFIL NM1 NM2 SNM RSNM TCH
13 (JCL-STR <>) REM-STR (JCL-VEC <>) REM-VEC A1 A2
14 (PREC <>) (CT <>) CHR (CARE T) (MF <>) (MC T) (REC T)
15 (KILL T) (AUTO-PREC <>) (STAT <>) WDATE REAL-NM2
16 (CPU <FIX <+ <TIME> 0.5>>) (REAL <QTIME <ITIME>>))
17 #DECL ((NM1 NM2 SNM) <SPECIAL STRING>
18 (REM-STR JCL-STR) <OR STRING FALSE>
19 (JCL-VEC REM-VEC) <OR VECTOR FALSE>)
21 <SETG ERRORS-OCCURED <>>
22 <IFSYS ("TOPS20" <SET JCL-STR <READJCL>>)
23 ("UNIX" <SET JCL-VEC <READARGS>>)>
25 <COND (<OR .JCL-VEC .JCL-STR>
29 (<SET REM-STR <OR <MEMQ !\/ .JCL-STR> <MEMQ !\< .JCL-STR>>>
30 <SET FIL <LEX <SUBSTRUC .JCL-STR 0 <- <LENGTH .JCL-STR>
32 <SET REM-STR <LPARSE <REST .REM-STR>>>
35 <COND (<TYPE? .TOKEN ATOM>
36 <COND (<MEMQ .TOKEN '[C /C]>
38 (<MEMQ .TOKEN '[NC /NC]>
40 (<MEMQ .TOKEN '[XM /XM]>
42 (<MEMQ .TOKEN '[NXM /NXM]>
43 <SETG EXPAND-FLAG <>>)
44 (<MEMQ .TOKEN '[R /R]>
46 (<MEMQ .TOKEN '[NR /NR]>
48 (<MEMQ .TOKEN '[MF /MF]>
50 (<MEMQ .TOKEN '[MC /MC]>
52 (<MEMQ .TOKEN '[NMF /NMF]>
54 (<MEMQ .TOKEN '[NMC /NMC]>
56 (<MEMQ .TOKEN '[P /P]>
58 (<MEMQ .TOKEN '[PA /PA]>
61 (<MEMQ .TOKEN '[SL /SL]>
63 <UPDATE-STATUS "Start" "None" <> <> .CPU
65 (<MEMQ .TOKEN '[T /T]>
67 (<MEMQ .TOKEN '[NK /NK]>
71 <ERROR BAD-TOKEN!-ERRORS .TOKEN .REM-STR>)>)
73 <COND (<TYPE? <SET A2 <2 .TOKEN>> STRING>)
74 (<TYPE? .A2 ATOM> <SET A2 <SPNAME .A2>>)>
75 <COND (<MEMQ <SET A1 <1 .TOKEN>> '[P /P PA /PA]>
76 <COND (<NOT <TYPE? .A2 STRING>>
77 <ERROR PRECOMPILE-NOT-STRING!-ERRORS
79 <COND (<MEMQ .A1 '[PA /PA]>
83 <COND (<NOT <TYPE? .A2 STRING>>
84 <ERROR COMPILER-TYPE-NOT-STRING!-ERRORS
88 <COND (<NOT <TYPE? .A2 STRING>>
89 <ERROR PACKAGE-MODE-NOT-STRING!-ERRORS
91 <SET PACKAGE-MODE .A2>)
93 <COND (<OR <NOT <TYPE? .A2 LIST>>
98 (<NOT <TYPE? .X ATOM>>
101 <ERROR REDO-LIST-MALFORMED!-ERRORS
103 (ELSE <SET REDO .A2>)>)
105 <ERROR BAD-TOKEN!-ERRORS .TOKEN .REM-STR>)>)
109 (<SET FIL <LEX .JCL-STR <LENGTH .JCL-STR>>>)>
114 <FUNCTION (VV "AUX" (ST <1 .VV>))
115 #DECL ((VV) <VECTOR [REST STRING]>)
116 <COND (<AND <NOT <EMPTY? .ST>>
117 <OR <==? <1 .ST> !\->
119 <COND (<==? <LENGTH .ST> 1>
120 <SET REM-VEC <REST .VV>>)
121 (ELSE <SET REM-VEC .VV>)>
126 <SET FIL <SUBSTRUC .JCL-VEC 0
131 <COND (<MEMBER .TOKEN '["C" "-C"]>
133 (<MEMBER .TOKEN '["NC" "-NC"]>
135 (<MEMBER .TOKEN '["R" "-R"]>
137 (<MEMBER .TOKEN '["NR" "-NR"]>
139 (<MEMBER .TOKEN '["MF" "-MF"]>
141 (<MEMBER .TOKEN '["MC" "-MC"]>
143 (<MEMBER .TOKEN '["NMF" "-NMF"]>
145 (<MEMBER .TOKEN '["NMC" "-NMC"]>
147 (<MEMBER .TOKEN '["P" "-P"]>
149 (<MEMBER .TOKEN '["PA" "-PA"]>
152 (<MEMBER .TOKEN '["SL" "-SL"]>
154 <UPDATE-STATUS "Start" "None" <> <> .CPU
156 (<MEMBER .TOKEN '["T" "-T"]>
158 (<MEMBER .TOKEN '["NK" "-NK"]>
160 (<OR <EMPTY? <SET TOKEN
161 <CHTYPE <LPARSE .TOKEN> LIST>>>
162 <TYPE? <1 .TOKEN> ATOM>>
163 <ERROR BAD-TOKEN!-ERRORS <1 .TOKEN> .REM-VEC>)
164 (<TYPE? <1 <CHTYPE .TOKEN LIST>> ADECL>
165 <SET TOKEN <1 <CHTYPE .TOKEN LIST>>>
166 <COND (<TYPE? <SET A2 <2 .TOKEN>> STRING>)
167 (<TYPE? .A2 ATOM> <SET A2 <SPNAME .A2>>)>
168 <COND (<MEMQ <SET A1 <1 .TOKEN>> '[P -P
170 <COND (<NOT <TYPE? .A2 STRING>>
171 <ERROR PRECOMPILE-NOT-STRING!-ERRORS
174 <COND (<MEMQ .A1 '[PA -PA]>
177 <COND (<NOT <TYPE? .A2 STRING>>
178 <ERROR COMPILER-TYPE-NOT-STRING!-ERRORS
181 (<MEMQ .A1 '[PM -PM]>
182 <COND (<NOT <TYPE? .A2 STRING>>
183 <ERROR PACKAGE-MODE-NOT-STRING!-ERRORS
185 <SET PACKAGE-MODE .A2>)
186 (<MEMQ .A1 '[RD -RD]>
187 <COND (<OR <NOT <TYPE? .A2 LIST>>
192 (<NOT <TYPE? .X ATOM>>
195 <ERROR REDO-LIST-MALFORMED!-ERRORS
197 (ELSE <SET REDO .A2>)>)
199 <ERROR BAD-TOKEN!-ERRORS .TOKEN .REM-STR>)>)
203 (<SET FIL .JCL-VEC>)>
204 <SET FIL <1 .FIL>>)>)
206 <PROG QL ((Q1 <>) (Q2 <>) (Q3 <>) (Q4 <>) (Q5 <>) (Q6 <>)
207 (READ-PROMPT <>) (READ-BREAKS <>))
210 <SET READ-PROMPT "File: ">
211 <SET FILLEN <READSTRING ,BUFSTR .INCHAN "
\e">>
212 <SET FIL <SUBSTRUC ,BUFSTR 0 <- .FILLEN 1>>>
215 <SET READ-BREAKS <STRING <ASCII 2> <ASCII 27>>>
217 <COND (<==? <SET CHR <TYI-PROMPT "Record?: ">>
223 <SET REC <MEMQ .CHR "Yy Tt">>
226 <COND (<==? <SET CHR <TYI-PROMPT "Precompilation?: ">>
232 <SET PREC <COND (<MEMQ .CHR "Yy Tt"> T)>>
233 <COND (<==? .CHR !\ >
234 <SET READ-PROMPT "(file) ">
235 <COND (<==? <SET CHR <NEXTCHR>>
237 <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
238 <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
244 <READSTRING ,BUFSTR .INCHAN "
\e">>
245 <SET PREC <SUBSTRUC ,BUFSTR 0 <- .FILLEN 1>>>)>
247 <COND (<AND <N==? .CHR !\
\e> <NOT .Q4>>
248 <COND (<==? <SET CHR <TYI-PROMPT "Careful?: ">>
253 <SET CARE <MEMQ .CHR "Yy Tt">>
256 <COND (<AND <N==? .CHR !\
\e> <NOT .Q5>>
257 <COND (<==? <SET CHR <TYI-PROMPT "Flush macros? ">>
262 <SET MF <MEMQ .CHR "Yy Tt">>
265 <COND (<AND <N=? .CHR !\
\e> <NOT .Q6>>
266 <COND (<==? <SET CHR <TYI-PROMPT "Compile macros? ">>
271 <SET MC <MEMQ .CHR "Yy tT">>
274 <SET READ-PROMPT "Things to do: ">
275 <SET READ-BREAKS <STRING <ASCII 2> <ASCII 27>
277 <COND (<==? <SET CHR <NEXTCHR>>
279 <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
280 <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
281 <COND (.Q6 <SET Q6 <>>)
289 <COND (<==? .CHR !\?>
292 <COND (<==? <SET CHR <TYI-PROMPT "Save? ">> <ASCII 2>>
293 <COND (.Q6 <SET Q6 <>>)
300 <COND (<MEMQ .CHR "Tt yY">
301 <ERROR NOT-IMPLEMENTED!-ERRORS>
305 <SET READ-PROMPT "Redo list? ">
307 <STRING <ASCII 2> <ASCII 27>
308 <ASCII 127> <ASCII 13>>>
309 <COND (<==? <SET CHR <NEXTCHR>>
312 <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
313 <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
314 <COND (.Q6 <SET Q6 <>>)
321 <COND (<AND <N==? .CHR <ASCII 27>>
322 <N==? .CHR <ASCII 127>>
323 <N==? .CHR <ASCII 13>>>
331 "Must enter a list: ">>)
334 <SET READ-PROMPT "Package mode: ">
335 <COND (<==? <SET CHR <NEXTCHR>> <ASCII 2>>
337 <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
338 <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
339 <COND (.Q6 <SET Q6 <>>)
346 <COND (<AND <N==? .CHR <ASCII 27>>
347 <N==? .CHR <ASCII 127>>
348 <N==? .CHR <ASCII 13>>>
350 <READSTRING ,BUFSTR .INCHAN "
\e">>
356 <SET READ-PROMPT "Things to do: ">
357 <COND (<==? <SET CHR <NEXTCHR>> <ASCII 2>>
359 <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
360 <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
361 <COND (.Q6 <SET Q6 <>>)
369 <COND (<==? <SET CHR <NEXTCHR>> <ASCII *33*>>
375 (<==? .CHR <ASCII 2>> <READCHR> <AGAIN .QL>)>
377 <COND (<==? .FIL "BOOT">
378 <SET INDIR <SET OUTDIR "<MIM.BOOT>">>)>
380 ; "Allow compilation of .ZIL files"
381 <PROG ((NMVEC:VECTOR '["ZIL"]) (OTCH T))
382 <COND (<SET TCH <OPEN "READ" .FIL>>
383 <SET NM1 <CHANNEL-OP .TCH NM1>>
384 <SET NM2 <SET REAL-NM2 <CHANNEL-OP .TCH NM2>>>
385 <COND (<NOT <ASSIGNED? PACKAGE-MODE>>
386 <SET PACKAGE-MODE .NM1>)>
388 <SET WDATE <CHANNEL-OP .TCH WRITE-DATE>>)>
391 <COND (.OTCH <SET OTCH .TCH>)>
392 <COND (<EMPTY? .NMVEC>
393 <ERROR FILE-NOT-FOUND!-ERRORS .TCH>)
396 <SET NMVEC <REST .NMVEC>>
399 <SET PRECOMPILED <STRING .FIL ".MIMA">>
400 <COND (<NOT <FILE-EXISTS? .PRECOMPILED>> <SET PRECOMPILED <>>)>)
401 (.PREC <SET PRECOMPILED .PREC>)>
402 <COND (<AND .PREC .AUTO-PREC <SET TCH <OPEN "READ" .PRECOMPILED>>>
403 <COND (<G? <CHANNEL-OP .TCH WRITE-DATE> .WDATE>
404 <PRINC "Precompiled is more recent than source.">
408 <SET CAREFUL!-COMPDEC!-PACKAGE .CARE>
409 <SET MACRO-FLUSH .MF>
410 <SET MACRO-COMPILE .MC>
414 <PROG ((SNM .RSNM) (NM2 "RECORD")
415 (OUTCHAN <OPEN "PRINT" "">))
416 #DECL ((SNM NM2) <SPECIAL STRING>
417 (OUTCHAN) <SPECIAL CHANNEL>)
418 <FILE-COMPILE .INFIL "" .REAL-NM2>
420 (T <FILE-COMPILE .INFIL "" .REAL-NM2>)>
421 <COND (,ERRORS-OCCURED
422 <PRINC "Warning: Compiler errors occured!" ,DEBUG-CHANNEL>
423 <CRLF ,DEBUG-CHANNEL>)>
424 <COND (.KILL <EXIT <COND (,ERRORS-OCCURED 1) (ELSE 0)>>) (ELSE <QUIT>)>>
426 <DEFINE LEX (BUF "OPTIONAL" (LEN <LENGTH .BUF>))
427 #DECL ((BUF) STRING (LEN) FIX)
428 <SET BUF <SUBSTRUC .BUF 0 .LEN <REST .BUF <- <LENGTH .BUF> .LEN>>>>
429 <REPEAT ((L ("")) CHR (LS <>))
432 <PUTREST <REST .L <- <LENGTH .L> 1>> (<STRING .LS>)>)>
434 <COND (<MEMQ <SET CHR <1 .BUF>> " ,
437 <SET LS <SUBSTRUC .LS 0 <- <LENGTH .LS><LENGTH .BUF>>>>
438 <PUTREST <REST .L <- <LENGTH .L> 1>> (.LS)>
442 <SET BUF <REST .BUF>>>>
444 <DEFINE TYI-PROMPT (P "AUX" (CH .INCHAN) CHR)
446 <CHANNEL-OP .CH SET-ECHO-MODE <>>
448 <COND (<==? <SET CHR <TYI>> !\
\12>
449 <CHANNEL-OP .CH HOR-POS-CURSOR 0>
450 <CHANNEL-OP .CH FRESH-LINE>
454 <CHANNEL-OP .CH CLEAR-SCREEN>
457 (<N==? <ASCII .CHR> 2>
459 <CHANNEL-OP .CH SET-ECHO-MODE T>>