4 <ENTRY GC-GROUP-LOAD GC-GROUP-DUMP>
8 <COND (<G? ,MUDDLE 100> <SETG TNM1 "ETMP"> <SETG TNM2 "MUDT">)
9 (ELSE <SETG TNM1 "_ETMP_"> <SETG TNM2 ">">)>
13 (<FORM N==? ,MUDDLE <FORM GVAL MUDDLE>>
14 <FORM ERROR RSUBR-CANT-RUN-IN-THIS-VERSION-OF-MUDDLE!-ERRORS>)>>
16 <DEFINE GC-GROUP-LOAD (STR
18 "AUX" (CHN <OPEN "READB" .STR>) FSP (REDEFINE T))
19 #DECL ((REDEFINE) <SPECIAL ANY>)
21 <COND (<NOT <TYPE? .CHN CHANNEL>> <RETURN .CHN>)>
22 <COND (<NOT <ASSIGNED? NAM>>
25 <FUNCTION (C) <MAPRET !"\\ .C>>
27 ;"To hack ugly file names. (TT, 75/10/07)"
30 <SET FSP <LIST <7 .CHN> <8 .CHN> <9 .CHN> <10 .CHN>>>>
35 <DEFINE GC-GROUP-DUMP (STR
36 "OPTIONAL" NM (BKILLER T)
37 "AUX" (CHN <CHANNEL "PRINTB" .STR>)
39 <COND (<ASSIGNED? NM> .NM)
40 (ELSE <PARSE <7 .CHN>>)>)
42 <OPEN "PRINTB" ,TNM1 ,TNM2 <9 .CHN> <10 .CHN>>)
43 (FIXERS ()) FUNC BKS TEM TT HOLDANY GRP FIXES)
44 #DECL ((CHN) CHANNEL (NAM) ATOM (OC) <OR CHANNEL FALSE> (FIXERS) LIST)
46 <COND (<NOT .OC> <RETURN .OC>)>
47 <COND (<OR <NOT <ASSIGNED? .NAM>> <NOT <TYPE? ..NAM LIST>>>
49 <RETURN #FALSE ("Not a valid group name")>)>
52 (<FORM PUT .NAM BLOCK <FORM UNGET <UNGET <GET .NAM BLOCK '.OBLIST>>>>
55 <FUNCTION (OBP "AUX" (OB <1 .OBP>))
56 <COND (<SET TEM <GET <FORM QUOTE .OBP> COMMENT>>
58 (<FORM PUT <FORM QUOTE .OBP> COMMENT .TEM> !.FIXERS)>)>
59 <COND (<SET TEM <GET .OBP BLOCK>>
64 <FORM UNGET <UNGET .TEM>>>
67 (<AND <TYPE? .OB FORM> <NOT <EMPTY? .OB>>>
69 (<OR <==? <SET TEM <1 .OB>> DEFINE> <==? .TEM DEFMAC>>
72 .BKILLER ;"Breakpoint killer"
76 <AND <GASSIGNED? <SET FUNC <GET <2 .OB> VALUE '<2
80 <PUTPROP <GLOC .FUNC> BREAKS>
82 <COND (<EMPTY? .BKS> <RETURN>)>
83 <COND (<TYPE? <SET HOLDANY <IN <1 .BKS>>> BREAK>
84 <SETLOC <1 .BKS> <2 .HOLDANY>>)>
85 <SET BKS <REST .BKS>>>)>
86 <SET TEM <COMMENT-ON .OB>>
87 <COND (<NOT <EMPTY? .TEM>>
88 <PUTREST <REST .TEM <- <LENGTH .TEM> 1>> .FIXERS>
92 <TYPE? <SET NM <GET <2 .OB> VALUE '<2 .OB>>> ATOM>
93 <OR <TYPE? <SET TEM <3 .OB>> RSUBR>
94 <AND <GASSIGNED? .NM> <TYPE? <SET TEM ,.NM> RSUBR>>>
96 <COND (<AND <TYPE? <1 .TEM> CODE> <SET FIXES <GET .TEM RSUBR>>>
98 (<FORM FIXIT <FORM QUOTE .TEM> .FIXES> !.FIXERS)>)
99 (<TYPE? <1 .TEM> CODE>
101 "Warning: RSUBR lacks fixups, only use in same MUDDLE version. ">
104 <SET FIXERS (,VCOMP !.FIXERS)>)>
105 <COND (<NOT <EMPTY? <SET TT <ANON-SRCH .TEM>>>>
106 <PUTREST <REST .TT <- <LENGTH .TT> 1>> .FIXERS>
108 <COND (<TYPE? <SET TT <1 .TEM>> PCODE>
113 <PARSE <REST <UNPARSE .TT>>>>
119 <FORM SET .NAM <FORM QUOTE .GRP>>>
126 <DEFINE COMMENT-ON (OB "AUX" (L ()) TEM TT)
131 <COND (<SET TEM <GET .OBP COMMENT>>
133 (<FORM PUT <FORM QUOTE .OBP> COMMENT .TEM>
135 <COND (<NOT <EMPTY? <SET TEM <COMMENT-ON <1 .OBP>>>>>
136 <PUTREST <REST .TEM <- <LENGTH .TEM> 1>> .L>
139 <COND (<SET TEM <GET <1 .OB> COMMENT>>
140 <SET L (<FORM PUT <FORM QUOTE <1 .OB>> COMMENT .TEM> !.L)>)>
141 <COND (<OR <SET TEM <GET <SET TT .OB> COMMENT>>
142 <SET TEM <GET <SET TT <REST .OB 0>> COMMENT>>>
143 <SET L (<FORM PUT <FORM QUOTE .TT> COMMENT .TEM> !.L)>)>)
144 (<SET TEM <GET .OB COMMENT>> <SET L (.TEM)>)>
147 <DEFINE ANON-SRCH (R "AUX" (L ()) TEM)
148 #DECL ((R) <PRIMTYPE VECTOR> (L) LIST)
150 <FUNCTION (THP "AUX" (THING <1 .THP>))
151 <COND (<AND <TYPE? .THING RSUBR>
152 <G? <LENGTH .THING> 1>
153 <TYPE? <SET TEM <2 .THING>> ATOM>
154 <OR <NOT <GASSIGNED? .TEM>> <N==? ,.TEM .THING>>>
155 <COND (<AND <TYPE? <1 .THING> CODE>
156 <SET TEM <GET .THING RSUBR>>>
157 <SET L (<FORM FIXIT <FORM QUOTE .THING> .TEM> !.L)>)
158 (<TYPE? <1 .THING> CODE>
160 "Warning: RSUBR lacks fixups, only use in same MUDDLE version. ">
163 <COND (<AND <TYPE? .THING RSUBR> <TYPE? <1 .THING> PCODE>>
168 <PARSE <REST <UNPARSE <1 .THING>>>>>
170 <COND (<TYPE? .THING LOCD LOCR TYPE-W TYPE-C>
175 <PARSE <REST <UNPARSE .THING>>>>
177 <COND (<TYPE? .THING LOCD>
178 <PUT .THP 1 LOCD>)>)>>
183 <MAPF ,LIST <FUNCTION (X) <GET .X OBLIST>> .O>>