1 <FLOAD "MICROM" ">" "DSK" >
8 <BLOCK (<MOBLIST MM!- 13> <ROOT>)>
11 S -S I C R L K U D UR DL WR WL B F
17 <BLOCK (<MOBLIST IMM!-MM 23> <GET MM OBLIST> <ROOT>)>
19 <NEWTYPE OBANDCURS LIST>
21 <SETG INITOB ("NOTHING OPEN")>
23 <DEFINE MMED MMEDACT ("AUX" (CI!-M 1) (CO!-M ,INITOB)
24 (CL+1!-M 2) (LST!-M ())
25 (LOC!-M <GLOC INITOB>)
26 (CLLN <- <13 .OUTCHAN> 4>)
31 <RDBRAK (<GET MM!- OBLIST><GET M!- OBLIST>)>>
33 <SETG MEDDLE <SETG XMED ,MMED>>
35 <DEFINE O (IT "AUX" (HOW <GET <TYPE .IT> O>))
37 <COND (<SET HOW <EVAL .HOW>>
38 <OR <==? <TYPE .IT> OBANDCURS> <==? <TYPE .IT> CURSOR> <D>>)
40 (ELSE #FALSE ("BAD TYPE"))>>
42 <PUT LOCD O '<O!-M .IT>>
44 <PUT CURSOR O '<NC!-M .IT>>
46 <PUT OBANDCURS O '<PROG ((LOBS ()) (NOBPDL <1 .IT>))
48 <SET OBPDL <REST .NOBPDL>>
50 <REPEAT () <AND <EMPTY? <REST .NOBPDL>> <RETURN T>>
51 <SET LOBS (<1 .NOBPDL> !.LOBS)>
52 <SET NOBPDL <REST .NOBPDL 4>>>
53 <REPEAT () <AND <EMPTY? .LOBS> <RETURN T>>
55 <SET LOBS <REST .LOBS>>>
58 <SET ROB (.UTOP !.NOB)>> >
60 <PUT ATOM O '<COND (<GASSIGNED? .IT> <O!-M <GLOC .IT>>)
61 (<ASSIGNED? .IT> <O!-M <LLOC .IT>>)
62 (ELSE '#FALSE ("UNASSIGNED"))>>
65 <DEFINE UT () <O!-M .LOC!-M> <D>>
66 \f<DEFINE PT () <PRIMP <IN .LOC!-M>> <AGAIN .RDBRAKEXIT>>
68 <DEFINE PA ("OPTIONAL" (N 0) "AUX" (QUICKPRINT!- #FALSE ()) (RI <- <* .N 3> 2>))
70 <PRIMP <COND (<L? .RI 0> <COND (<EMPTY? .LST!-M> <1 .CO!-M>) (T .CO!-M)>)
71 (<G? .RI <- <LENGTH .LST!-M> 3>> <IN .LOC!-M>)
72 (ELSE <.RI .LST!-M>)>>
77 <PRIMP <COND (<==? .CI!-M .CL+1!-M> '#FALSE ("RIGHT-EDGE")) (ELSE <.CI!-M .CO!-M>)>>
81 <COND (<GASSIGNED? EPRINT!->
82 <COND (<LOOKUP "MEDSW" <GET PP!- OBLIST>>)
83 (T <FLOAD "MEDPP" ">" "DSK" "MUDDLE">)>
85 <SETG PRIMP ,EPRINT!->)
88 <SET MEDDLE_CURSOR!- "/\\">
91 <COND (<==? .CI!-M .CL+1!-M> <SET SPECAFT!- <REST .CO!-M <- .CI!-M 2>>>)
92 (ELSE <SET SPECBEF!- <REST .CO!-M <- .CI!-M 1>>>)>>
94 <DEFINE REMCURS () <SET SPECBEF <SET SPECAFT 0>>>
96 <DEFINE Q () <UNOB> <EXIT .MMEDACT "muddle">>
99 <REPEAT () <AND <EMPTY? .OBPDL> <RETURN T>>
101 <SET OBPDL <REST .OBPDL 4>> >>
104 <VALRET <COND (<==? <TYPE .ARG> STRING> .ARG) (ELSE <UNPARSE .ARG>)>>>
106 <DEFINE ? ("AUX" (FIL <OPEN "READ" "MEDCOM" ">" "DSK" "MUDDLE">))
108 <REPEAT () <PRINC <READCHR '<RETURN T> .FIL>>>
111 (ELSE #FALSE("Where's my file???"))>>
114 <COND (<==? <TYPE .ATM> ATOM>
115 <SET .ATM <CHTYPE ((.OBLIST !.OBPDL) <GETC!-M>) OBANDCURS>>)
116 (ELSE #FALSE ("ARG NOT ATOM"))>>
118 <DEFINE OB EOB ("TUPLE" BLOK)
119 <REPEAT ((BLK .BLOK))
120 <AND <EMPTY? .BLK> <RETURN T>>
121 <PUT .BLK 1 <COND (<==? <TYPE <1 .BLK>> OBLIST> <1 .BLK>)
122 (<GET <1 .BLK> OBLIST>)
123 (ELSE <EXIT .EOB #FALSE ("ARG NOT OBLIST OR OBLIST NAME")>)>>
124 <SET BLK <REST .BLK>> >
125 <SET OBPDL (.NOB .UTOP .ROB .OBLIST !.OBPDL)>
126 <SET NOB (!.BLOK !<COND (<MEMQ <ROOT> .BLOK> '()) (ELSE (<ROOT>))>)>
129 <SET ROB (.TOB !.NOB)>
133 <COND (<EMPTY? .OBPDL> #FALSE ("NO MORE BLOCKS"))
136 <SET UTOP <2 .OBPDL>>
138 <SET OBPDL <REST .OBPDL 4>>
140 <AGAIN .RDBRAKEXIT>)>>
143 <REPEAT ((FOB .OBLIST))
144 <AND <EMPTY? .FOB> <AGAIN .RDBRAKEXIT>>
146 <PRIN1 <GET <1 .FOB> OBLIST>>
147 <SET FOB <REST .FOB>> >>
148 \f<DEFINE V () <SET VERBSW <NOT .VERBSW>> T>
150 <DEFINE & () <AMPERSAND> <AGAIN .RDBRAKEXIT>>
152 <SETG CLOBOT <REST <IVECTOR 5 '(1)> 5>>
153 <SETG FSLBOT <REST <IUVECTOR 5 -1> 5>>
156 <COND (<FLATSIZE .CO!-M .CLLN> <TERPRI>
157 <BRACK OPENBRAK .CO!-M>
159 <AND <==? <SET IX <+ .IX 1>> .CI!-M>
161 <AND <==? .IX .CL+1!-M> <RETURN T>>
164 <BRACK CLOSEBRAK .CO!-M>)
166 <PROG ((CLOB ,CLOBOT) (FSL ,FSLBOT) FS BEGIN STOP
167 (LLN <COND (<GET OPENBRAK <TYPE .CO!-M>> .CLLN)
168 (ELSE <- .CLLN 2 <FLATSIZE <TYPE .CO!-M> .CLLN>>)>))
169 <COND (<G? .CL+1!-M 5>
170 <COND (<L? .CI!-M 4> <SET BEGIN .CO!-M> <SET LLN <- .LLN 1>>)
171 (<L? <- .CL+1!-M .CI!-M> 4> <SET BEGIN <REST .CO!-M <- .CL+1!-M 5>>>
172 <SET LLN <- .LLN 4>>)
173 (ELSE <SET BEGIN <REST .CO!-M <- .CI!-M 3>>>
174 <SET LLN <- .LLN 9>>)>
175 <SET STOP <REST .BEGIN <MIN 4 <LENGTH .BEGIN>>>>
176 <AND <L? <FSZ> .LLN> <RETURN <EP1>>>)
177 (ELSE <SET BEGIN .CO!-M>
178 <SET STOP <REST .CO!-M <- .CL+1!-M 1>>>
179 <AND <L? <FSZ> .LLN> <RETURN <EP1>>>)>
181 <REPEAT ((FL <REST .FSL>) (VIC .FSL))
182 <COND (<G? <1 .FL> <1 .VIC>> <SET VIC .FL>)
183 (<EMPTY? <SET FL <REST .FL>>>
184 <SET CLOB <PUT <BACK .CLOB> 1
185 <REST .BEGIN <- <LENGTH .VIC> 1>>>>
186 <SET FS <- .FS <1 .VIC> -4>>
189 <AND <L? .FS .LLN> <EP1> <RETURN T>>>>)>>
192 <REPEAT ((OBJ <REST .BEGIN 0>))
193 <SET FSL <PUT <BACK .FSL> 1
194 <COND (<FLATSIZE <1 .OBJ> .LLN>)
195 (ELSE <SET CLOB <PUT <BACK .CLOB> 1 .OBJ>> 4)>>>
196 <AND <==? <SET OBJ <REST .OBJ>> .STOP> <RETURN <SET FS <+ !.FSL>>>>>>
200 <BRACK OPENBRAK .CO!-M>
201 <OR <==? .BEGIN .CO!-M> <PRINC "...& ">>
202 <SET BEGIN <REST .BEGIN 0>>
203 <REPEAT ((CP <REST .CO!-M <- .CI!-M 1>>))
204 <AND <==? .BEGIN .CP> <PRINC "/\\">>
205 <COND (<==? .BEGIN .STOP> <RETURN T>)
206 (<MEMQ .BEGIN .CLOB> <BRACK OPENBRAK <1 .BEGIN>>
208 <BRACK CLOSEBRAK <1 .BEGIN>>)
209 (ELSE <PRIN1 <1 .BEGIN>>)>
211 <SET BEGIN <REST .BEGIN>>>
212 <OR <EMPTY? .STOP> <PRINC "&...">>
213 <BRACK CLOSEBRAK .CO!-M>>
215 <DEFINE BRACK (WHICH WHAT "AUX" (BK <GET .WHICH <TYPE .WHAT>>))
216 <COND (.BK <PRINC .BK>)
217 (<MEMQ <TYPE .WHAT> '![ATOM FIX FLOAT]>)
218 (<==? .WHICH CLOSEBRAK> <PRINC <GET CLOSEBRAK <PRIMTYPE .WHAT> !"?>>)
223 <PRINC <GET OPENBRAK <PRIMTYPE .WHAT> !"?>>)>>
225 <PUT OPENBRAK LIST !"(> <PUT CLOSEBRAK LIST !")>
226 <PUT OPENBRAK FORM !"<> <PUT CLOSEBRAK FORM !">>
227 <PUT OPENBRAK VECTOR !"[> <PUT CLOSEBRAK VECTOR !"]>
228 <PUT OPENBRAK UVECTOR "!["> <PUT CLOSEBRAK UVECTOR "!]">
229 <PUT OPENBRAK STRING !""> <PUT CLOSEBRAK STRING !"">
230 <PUT OPENBRAK TUPLE !"[> <PUT CLOSEBRAK TUPLE !"]>
231 <PUT OPENBRAK SEGMENT "!<"> <PUT CLOSEBRAK SEGMENT "!>">
232 \f<DEFINE I ("ARGS" L) <I!-M .L>>
233 <DEFINE C ('IT) <C!-M .IT> T>
234 <DEFINE R ("OPTIONAL" (N 1) "AUX" (OCI .CI!-M))
235 <COND (<R!-M .N>) (T <SET CI!-M .OCI> #FALSE ("RIGHT-EDGE"))>>
236 <DEFINE L ("OPTIONAL" (N 1) "AUX" (OCI .CI!-M))
237 <COND (<L!-M .N>) (T <SET CI!-M .OCI> #FALSE ("LEFT-EDGE"))>>
238 <DEFINE B () <SET CI!-M .CL+1!-M>>
239 <DEFINE F () <SET CI!-M 1>>
240 <DEFINE K ("OPTIONAL" (N 1) "AUX" (OCI .CI!-M))
241 <COND (<L? .N 0> <L!-M <- .N>> <SET N <- .OCI .CI!-M>>)>
243 <DEFINE U ("OPTIONAL" (N 1)) <PRIMREP ,UL!-M .N>>
244 <DEFINE D ("OPTIONAL" (N 1)) <PRIMREP ,DR!-M .N>>
245 <DEFINE UR ("OPTIONAL" (N 1)) <PRIMREP ,UR!-M .N>>
246 <DEFINE DL ("OPTIONAL" (N 1)) <PRIMREP ,DL!-M .N>>
247 <DEFINE WR ("OPTIONAL" (N 1)) <PRIMREP ,WR!-M .N>>
248 <DEFINE WL ("OPTIONAL" (N 1)) <PRIMREP ,WL!-M .N>>
250 <DEFINE PRIMREP (WHAT MANY "AUX" (OLDC <GETC!-M>))
252 <COND (<L? .MANY 1> <RETURN T>)
254 (ELSE <NC!-M .OLDC> <RETURN .T1>)>
255 <SET MANY <- .MANY 1>> >>
257 <DEFINE S ('IT) <AND <PS .IT ,SR!-M> <R!-M 1>>>
258 <DEFINE -S ('IT)<AND <PS .IT ,SL!-M>>>
260 <DEFINE PS (WHAT HOW "AUX" (T <GETC!-M>))
262 (ELSE <NC!-M .T> #FALSE ("NOT-FOUND"))>>
264 <DEFINE C: (NTYP) <C!-M <SETYPE <.CI!-M .CO!-M> .NTYP>> T>
266 <DEFINE I: (NTYP "OPTIONAL" (N 1) "AUX" (T <G!-M .N>))
268 <I!-M (<SETYPE .T .NTYP>)>
271 <DEFINE K: ("AUX" (T <G!-M 1>) LINS)
272 <COND (<MONAD? <1 .T>> #FALSE ("NOT-STRUCTURED"))
273 (ELSE <SET LINS <LENGTH <1 .T>>> <K!-M 1> <I!-M <1 .T>> <L!-M .LINS>)>>
275 <DEFINE SETYPE (OBJ NTYPE)
276 <COND (<MONAD? .OBJ> <SET OBJ (.OBJ)>)>
277 <CHTYPE <APPLY ,<TYPEPRIM .NTYPE> !.OBJ> .NTYPE>>
279 <DEFINE SC ("OPTIONAL" COMM)
280 <COND (<==? .CL+1!-M .CI!-M> #FALSE ("RIGHT-EDGE"))
281 (<ASSIGNED? COMM> <PUT <REST .CO!-M <- .CI!-M 1>> COMMENT .COMM> "put.")
282 (T <PUT <REST .CO!-M <- .CI!-M 1>> COMMENT> "Removed.")>>
283 \f<DEFINE BK ("ARGS" L)
284 <COND (<==? .CI!-M .CL+1!-M> '#FALSE ("RIGHT-EDGE"))
285 (ELSE <C!-M <CHTYPE (M_B .L <.CI!-M .CO!-M>) FORM>>
291 <COND (<SR!-M M_B> <SET SV <3 .CO!-M>>
297 <DEFINE M_B ("BIND" CENV 'DOLIST 'SAVE
298 "AUX" (OUTCHAN ,OUTCHAN)
302 <REPEAT () <COND (<EMPTY? .DOLIST> <RETURN T>)
306 <PRIN1 <EVAL <1 .DOLIST> .CENV>>
307 <SET DOLIST <REST .DOLIST>>)>>
312 <DEFINE OMERDE () <COND (<ASSIGNED? RDBRAKEXIT> <AGAIN .RDBRAKEXIT>) ("Not in MEDDLE.")>>
314 <SETG GOFORM '<EXIT .RDBRAKEXIT "out of reader">>
325 <SETG ALTGETTER <MEMQ !"
\e ,SPECS>>
327 <DEFINE RDBRAK ("BIND" UENV COB "OPTIONAL" (NOB .OBLIST)
328 "AUX" (TOB <MOBLIST TOB 1>)
331 FRST CMND FLIST EFLIST)
332 <READCHR> ;"FLUSH THE CRETINOUS INITIAL ALTMODE."
333 <REPEAT RDBRAKEXIT ()
334 <SET MERDE <CLOSURE ,OMERDE RDBRAKEXIT>>
337 P1GO <COND (<==? <NEXTCHR> <1 ,ALTGETTER>>
341 <COND (<NOT <==? ATOM <TYPE <SET FRST <READ ,GOFORM .INCHAN .ROB>>>>>
342 <REPEAT ((TTOB <1 .TOB>))
343 <AND <EMPTY? .TTOB> <RETURN T>>
344 <INTERN <REMOVE <1 .TTOB>> .UTOP>
345 <SET TTOB <REST .TTOB>>>
346 <PRINT <EVAL .FRST .UENV>>
347 <AND <==? <NEXTCHR> !"
\e> <READCHR>>
349 (<NOT <SET CMND <OR <LOOKUP <SET FLIST <PNAME .FRST>> <1 .COB>>
350 <LOOKUP .FLIST <2 .COB>>>>>
351 <AND <==? <OBLIST? .FRST> .TOB> <INTERN <REMOVE .FRST> .UTOP>>
354 <AND <==? <OBLIST? .FRST> .TOB> <REMOVE .FRST>>
355 <SET FLIST <SET EFLIST <FORM .CMND>>>
357 <COND (<SET TEM <MEMQ <NEXTCHR ,GOFORM> ,SPECS>>
359 <AND <==? .TEM ,ALTGETTER> <RETURN T>>)
360 (ELSE <SET EFLIST <REST <PUTREST .EFLIST (<READ ,GOFORM>)>>>)>>
361 <COND (<SET FLIST <EVAL .FLIST>>)
362 (ELSE <PRIN1 .FLIST>)>
363 <AND .VERBSW <GO P1GO>>
369 <COND (<LOOKUP "XMED" <1 .OBLIST>> <SETG <LOOKUP "XMED" <1 .OBLIST>> ,XMED!-> <REMOVE XMED>)>