mim/development/mim/20c/movers.mud

   1
   2
   3 <DEFINE MOVE-STRING!-MIMOC (L "AUX" (FROM <1 .L>) (TO <2 .L>) (CNT <3 .L>)
   4                                     (NO-OVERLAP? <EXTRAMEM NO-OVERLAP .L>))
   5         #DECL ((L) LIST)
   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>)>
  10         <UPDATE-ACS>
  11         <COND (.NO-OVERLAP?
  12                <GET-INTO-ACS .CNT VALUE A1* .FROM VALUE A2*
  13                              .TO VALUE C1*>
  14                <OCEMIT SETZB B1* C2*>
  15                <OCEMIT MOVEI B2* '(A1*)>
  16                <OCEMIT XBLT A1* !<OBJ-VAL *016000000000*>>
  17                <OCEMIT JRST <XJUMP IOERR>>
  18                <FLUSH-ACS>)
  19               (ELSE
  20                <GET-INTO-ACS .FROM VALUE O1* .TO VALUE O2* .CNT VALUE O*>
  21                <FLUSH-ACS>
  22                <PUSHJ MOVSTR>)>>
  23
  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>))
  27         #DECL ((L) LIST)
  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>>
  35                       <OCEMIT ASH T* 1>)>
  36                <OCEMIT CAMG O2* O1*>
  37                <OCEMIT JRST <XJUMP .TG>>
  38                <OCEMIT ADD O1* T*>
  39                <OCEMIT ADD O2* T*>
  40                <OCEMIT MOVNS O* T*>
  41                <LABEL .TG>)
  42               (<==? .DIRECTION BACKWARD>
  43                <COND (<TYPE? .CNT FIX>
  44                       <OCEMIT MOVNI T* .CNT>
  45                       <OCEMIT ADDI O1* .CNT>
  46                       <OCEMIT ADDI O2* .CNT>)
  47                      (ELSE
  48                       <OCEMIT MOVN T* !<OBJ-VAL .CNT>>
  49                       <COND (<==? .TY VECTOR> <OCEMIT ASH T* 1>)>
  50                       <OCEMIT SUB O1* T*>
  51                       <OCEMIT SUB O2* T*>)>)
  52               (ELSE
  53                <GET-INTO-ACS .CNT VALUE T*>
  54                <COND (<AND <NOT <TYPE? .CNT FIX>> <==? .TY VECTOR>>
  55                       <OCEMIT ASH T* 1>)>)>
  56         <OCEMIT XBLT T* !<OBJ-VAL *020000000000*>>>
  57
  58 <DEFINE STRING-EQUAL?!-MIMOC (L "AUX" (S1 <1 .L>) (S2 <2 .L>) (DIR <3 .L>)
  59                                      (LBL <4 .L>) (LBL2 <GENLBL "SE">))
  60         #DECL ((L) LIST)
  61         <COND (<OR <TYPE? .S2 STRING>
  62                    <==? <IN-AC? .S2 VALUE> A2*>
  63                    <AND <IN-AC? .S2 VALUE> <NOT <IN-AC? .S1 VALUE>>>>
  64                <SET S1 .S2>
  65                <SET S2 <1 .L>>)>
  66         <COND (<AND <TYPE? .S1 ATOM>
  67                     <WILL-DIE? .S1>
  68                     <LAB-WILL-DIE <FIND-LABEL .LBL> .S1
  69                                   <SETG VISIT-COUNT <+ ,VISIT-COUNT 1>>
  70                                   <>>>
  71                <DEAD!-MIMOC (.S1) T>)>
  72         <COND (<AND <TYPE? .S2 ATOM>
  73                     <WILL-DIE? .S2>
  74                     <LAB-WILL-DIE <FIND-LABEL .LBL> .S2
  75                                   <SETG VISIT-COUNT <+ ,VISIT-COUNT 1>>
  76                                   <>>>
  77                <DEAD!-MIMOC (.S2) T>)>
  78         <UPDATE-ACS>
  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>>)
  87               (ELSE
  88                <OCEMIT HRRZ A1* !<OBJ-TYP .S1>>
  89                <COND (<AND <==? <IN-AC? .S1 VALUE> A2*>
  90                            <==? <IN-AC? .S2 VALUE> B2*>>
  91                       <OCEMIT MOVE C1* B2*>
  92                       <OCEMIT HRRZ B2* !<OBJ-TYP .S2>>)
  93                      (<==? <IN-AC? .S1 VALUE> B2*>
  94                       <OCEMIT MOVE A2* B2*>
  95                       <OCEMIT HRRZ B2* !<OBJ-TYP .S2>>
  96                       <OCEMIT MOVE C1* !<OBJ-VAL .S2>>)
  97                      (<==? <IN-AC? .S2 VALUE> B2*>
  98                       <OCEMIT MOVE C1* B2*>
  99                       <OCEMIT HRRZ B2* !<OBJ-TYP .S2>>
 100                       <COND (<N==? <IN-AC? .S1 VALUE> A2*>
 101                              <OCEMIT MOVE A2* !<OBJ-VAL .S1>>)>)
 102                      (ELSE
 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)>>>)>
 109         <FLUSH-ACS>
 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>)>>
 116
 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)
 120         #DECL ((L) LIST)
 121         <COND (<TYPE? .S2 STRING>
 122                <SET S1 .S2>
 123                <SET S2 <1 .L>>)>
 124         <COND (<WILL-DIE? .S1> <DEAD!-MIMOC (.S1) T>)>
 125         <COND (<WILL-DIE? .S2> <DEAD!-MIMOC (.S2) T>)>
 126         <UPDATE-ACS>
 127         <OCEMIT HRRZ O* !<OBJ-TYP .S1>>
 128         <OCEMIT HRRZ B1* !<OBJ-TYP .S2>>
 129         <GET-INTO-ACS .S1 VALUE A1* .S2 VALUE B2*>
 130         <FLUSH-ACS>
 131         <OCEMIT MOVEI C2* 1>
 132         <OCEMIT CAMN O* B1*>
 133         <OCEMIT SOJA C2* <XJUMP .T2>>
 134         <OCEMIT CAML O* B1*>
 135         <OCEMIT JRST <XJUMP .T3>>
 136         <OCEMIT MOVNI C2* 1>
 137         <OCEMIT SKIPA B1* O*>
 138         <LABEL .T3>
 139         <OCEMIT MOVE O* B1*>
 140         <LABEL .T2>
 141         <OCEMIT SETZB A2* C1*>
 142         <OCEMIT XBLT O* !<OBJ-VAL *006000000000*>>
 143         <OCEMIT JRST <XJUMP .T1>>
 144         <OCEMIT LDB O* A1*>
 145         <OCEMIT LDB B1* B2*>
 146         <OCEMIT MOVEI C2* 1>
 147         <OCEMIT CAMG O* B1*>
 148         <OCEMIT MOVNI C2* 1>
 149         <LABEL .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>>)>)
 154               (.VAL
 155                <SET AC <GET-AC C1*>>
 156                <AC-ITEM .AC .VAL>
 157                <AC-CODE .AC TYPE>
 158                <AC-UPDATE .AC T>
 159                <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>
 160                <AC-TYPE .AC FIX>
 161                <SET AC <GET-AC C2*>>
 162                <AC-ITEM .AC .VAL>
 163                <AC-CODE .AC VALUE>
 164                <AC-UPDATE .AC T>
 165                <AC-TIME .AC ,AC-STAMP>)>>