1 <DEFINE DISPATCH!-MIMOC (L
2 "AUX" (VAR <1 .L>) (BASE <2 .L>) DELBL AC (DF <>)
3 (DLBL <GENLBL "DISP">) RLBLS (LL .MIML) NEW AC-T
4 TAC (NV <- <LENGTH .L> 2>) (DISP-L ()))
5 #DECL ((LL MIML L) LIST (BASE NV) FIX (DISP-L) <SPECIAL LIST>)
8 <FUNCTION (LBL "AUX" LB LBX)
9 <COND (<AND <SET LB <FIND-LABEL .LBL>>
11 <COND (<NOT <FIND-LABEL
12 <SET LBX <GENLBL "LOOPD">>>>
13 <MAKE-LABEL .LBX <> ()>)>
17 <SET DISP-L <MAPF ,LIST <FUNCTION (L:LIST) <2 .L>> .RLBLS>>
19 <COND (<OR <EMPTY? <SET LL <REST .LL>>>
20 <AND <TYPE? <SET ITM <1 .LL>> FORM>
21 <OR <EMPTY? .ITM> <N==? <1 .ITM> DEAD>>>>
27 <COND (<SET AC <IN-AC? .VAR BOTH>> <SET AC <NEXT-AC <SET TAC .AC>>>)
28 (<SET AC <IN-AC? .VAR VALUE>>)
29 (ELSE <SET AC <NEXT-AC <SET TAC <LOAD-AC .VAR BOTH>>>>)>
31 <SET DELBL <GENLBL "DEFAULT">>
32 <COND (<NOT <FIND-LABEL .DELBL>>
33 <MAKE-LABEL .DELBL <> ()>)>)>
34 <LABEL-UPDATE-ACS .DELBL <>>
35 <COND (<AND <G=? .BASE 0> <L=? .BASE 1>>
36 <OCEMIT <COND (<==? .BASE 0> JUMPL) (ELSE JUMPLE)>
39 <OCEMIT CAILE .AC <+ .NV .BASE -1>>
40 <OCEMIT JRST O* <XJUMP .DELBL>>)
42 <COND (<G? .BASE 0> <OCEMIT CAIL .AC .BASE>)
43 (ELSE <OCEMIT CAML .AC !<OBJ-VAL .BASE>>)>
44 <COND (<G? <SET NV <+ .NV .BASE -1>> 0> <OCEMIT CAILE .AC .NV>)
45 (ELSE <OCEMIT CAMLE .AC !<OBJ-CAL .NV>>)>
46 <OCEMIT JRST O* <XJUMP .DELBL>>)>
47 <OCEMIT XMOVEI O1* <XJUMP .DLBL>>
49 <MAPF <> <FUNCTION (LBL) <LABEL-UPDATE-ACS <2 .LBL> <>>> .RLBLS>
51 <OCEMIT JRST @ <- .BASE> '(O1*)>
53 <MAPF <> <FUNCTION (LBL) <OCEMIT SETZ O* <XJUMP <2 .LBL>>>> .RLBLS>
56 <COND (<N==? <1 .LBL> <2 .LBL>>
58 <JUMP!-MIMOC <1 .LBL>>)>>
61 <COND (,PASS1 <SET LB <LABEL .DELBL>> <SAVE-LABEL-STATE .LB>)
62 (,NO-AC-FUNNYNESS <SAVE-ACS> <SET LB <LABEL .DELBL>>)
64 <SET LB <FIND-LABEL .DELBL>>
65 <ESTABLISH-LABEL-STATE .LB>