3 <DEFINE MOVE-STRING!-MIMOC (L "AUX" (FROM <1 .L>) (TO <2 .L>) (CNT <3 .L>)
4 (NO-OVERLAP? <EXTRAMEM NO-OVERLAP .L>))
6 <COND (.NO-OVERLAP? <SET NO-OVERLAP? <2 .NO-OVERLAP?:LIST>>)>
7 <COND (<WILL-DIE? .FROM> <DEAD!-MIMOC (.FROM) T>)>
8 <COND (<WILL-DIE? .TO> <DEAD!-MIMOC (.TO) T>)>
9 <COND (<WILL-DIE? .CNT> <DEAD!-MIMOC (.CNT) T>)>
12 <GET-INTO-ACS .CNT VALUE A1* .FROM VALUE A2*
14 <OCEMIT SETZB B1* C2*>
15 <OCEMIT MOVEI B2* '(A1*)>
16 <OCEMIT XBLT A1* !<OBJ-VAL *016000000000*>>
17 <OCEMIT JRST <XJUMP IOERR>>
20 <GET-INTO-ACS .FROM VALUE O1* .TO VALUE O2* .CNT VALUE O*>
24 <DEFINE MOVE-WORDS!-MIMOC (L "AUX" (FROM <1 .L>) (TO <2 .L>) (CNT <3 .L>)
25 (TY <EXTRAMEM TYPE .L>) (TG <GENLBL "BLT">)
26 (DIRECTION <EXTRAMEM DIRECTION .L>))
28 <COND (.TY <SET TY <2 .TY:LIST>>)>
29 <COND (.DIRECTION <SET DIRECTION <2 .DIRECTION:LIST>>)>
30 <COND (<AND <TYPE? .CNT FIX> <==? .TY VECTOR>> <SET CNT <* .CNT 2>>)>
31 <GET-INTO-ACS .FROM VALUE O1* .TO VALUE O2*>
32 <COND (<NOT .DIRECTION>
33 <GET-INTO-ACS .CNT VALUE T*>
34 <COND (<AND <NOT <TYPE? .CNT FIX>> <==? .TY VECTOR>>
37 <OCEMIT JRST <XJUMP .TG>>
42 (<==? .DIRECTION BACKWARD>
43 <COND (<TYPE? .CNT FIX>
44 <OCEMIT MOVNI T* .CNT>
45 <OCEMIT ADDI O1* .CNT>
46 <OCEMIT ADDI O2* .CNT>)
48 <OCEMIT MOVN T* !<OBJ-VAL .CNT>>
49 <COND (<==? .TY VECTOR> <OCEMIT ASH T* 1>)>
51 <OCEMIT SUB O2* T*>)>)
53 <GET-INTO-ACS .CNT VALUE T*>
54 <COND (<AND <NOT <TYPE? .CNT FIX>> <==? .TY VECTOR>>
56 <OCEMIT XBLT T* !<OBJ-VAL *020000000000*>>>
58 <DEFINE STRING-EQUAL?!-MIMOC (L "AUX" (S1 <1 .L>) (S2 <2 .L>) (DIR <3 .L>)
59 (LBL <4 .L>) (LBL2 <GENLBL "SE">))
61 <COND (<OR <TYPE? .S2 STRING>
62 <==? <IN-AC? .S2 VALUE> A2*>
63 <AND <IN-AC? .S2 VALUE> <NOT <IN-AC? .S1 VALUE>>>>
66 <COND (<AND <TYPE? .S1 ATOM>
68 <LAB-WILL-DIE <FIND-LABEL .LBL> .S1
69 <SETG VISIT-COUNT <+ ,VISIT-COUNT 1>>
71 <DEAD!-MIMOC (.S1) T>)>
72 <COND (<AND <TYPE? .S2 ATOM>
74 <LAB-WILL-DIE <FIND-LABEL .LBL> .S2
75 <SETG VISIT-COUNT <+ ,VISIT-COUNT 1>>
77 <DEAD!-MIMOC (.S2) T>)>
79 <COND (<TYPE? .S1 STRING>
80 <OCEMIT HRRZ A1* !<OBJ-TYP .S2>>
81 <OCEMIT CAIE A1* <LENGTH .S1>>
82 <OCEMIT JRST <XJUMP <COND (<==? .DIR +> .LBL2) (ELSE .LBL)>>>
83 <COND (<N==? <IN-AC? .S2 VALUE> A2*>
84 <OCEMIT MOVE A2* !<OBJ-VAL .S2>>)>
85 <OCEMIT MOVE C1* !<OBJ-VAL .S1>>
86 <OCEMIT MOVEI B2* <LENGTH .S1>>)
88 <OCEMIT HRRZ A1* !<OBJ-TYP .S1>>
89 <COND (<AND <==? <IN-AC? .S1 VALUE> A2*>
90 <==? <IN-AC? .S2 VALUE> B2*>>
92 <OCEMIT HRRZ B2* !<OBJ-TYP .S2>>)
93 (<==? <IN-AC? .S1 VALUE> B2*>
95 <OCEMIT HRRZ B2* !<OBJ-TYP .S2>>
96 <OCEMIT MOVE C1* !<OBJ-VAL .S2>>)
97 (<==? <IN-AC? .S2 VALUE> B2*>
99 <OCEMIT HRRZ B2* !<OBJ-TYP .S2>>
100 <COND (<N==? <IN-AC? .S1 VALUE> A2*>
101 <OCEMIT MOVE A2* !<OBJ-VAL .S1>>)>)
103 <OCEMIT HRRZ B2* !<OBJ-TYP .S2>>
104 <COND (<N==? <IN-AC? .S1 VALUE> A2*>
105 <OCEMIT MOVE A2* !<OBJ-VAL .S1>>)>
106 <OCEMIT MOVE C1* !<OBJ-VAL .S2>>)>
107 <OCEMIT CAIE A1* '(B2*)>
108 <OCEMIT JRST <XJUMP <COND (<==? .DIR +> .LBL2) (ELSE .LBL)>>>)>
110 <LABEL-UPDATE-ACS .LBL <>>
111 <OCEMIT SETZB B1* C2*>
112 <OCEMIT XBLT A1* !<OBJ-VAL <COND (<==? .DIR +> *006000000000*)
113 (ELSE *002000000000*)>>>
114 <OCEMIT JRST <XJUMP .LBL>>
115 <COND (<==? .DIR +> <LABEL .LBL2>)>>
117 <DEFINE STRCOMP!-MIMOC (L "AUX" (S1 <1 .L>) (S2 <2 .L>) (VAL <4 .L>)
118 (T1 <GENLBL "TG">) (T2 <GENLBL "TG">)
119 (T3 <GENLBL "TG">) AC)
121 <COND (<TYPE? .S2 STRING>
124 <COND (<WILL-DIE? .S1> <DEAD!-MIMOC (.S1) T>)>
125 <COND (<WILL-DIE? .S2> <DEAD!-MIMOC (.S2) T>)>
127 <OCEMIT HRRZ O* !<OBJ-TYP .S1>>
128 <OCEMIT HRRZ B1* !<OBJ-TYP .S2>>
129 <GET-INTO-ACS .S1 VALUE A1* .S2 VALUE B2*>
133 <OCEMIT SOJA C2* <XJUMP .T2>>
135 <OCEMIT JRST <XJUMP .T3>>
137 <OCEMIT SKIPA B1* O*>
141 <OCEMIT SETZB A2* C1*>
142 <OCEMIT XBLT O* !<OBJ-VAL *006000000000*>>
143 <OCEMIT JRST <XJUMP .T1>>
150 <COND (<==? .VAL STACK>
151 <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
152 <OCEMIT PUSH TP* C2*>
153 <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
155 <SET AC <GET-AC C1*>>
159 <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>
161 <SET AC <GET-AC C2*>>
165 <AC-TIME .AC ,AC-STAMP>)>>