mim/development/mim/20c/foo.mud

   1
   2 <DEFINE RPUTBITS (L "AUX" (WD <1 .L>) (WL <2 .L>) (SHL <3 .L>) (NEW <4 .L>)
   3                           (DST <6 .L>) (TAC? <>) (AC? <>) AN BP (OL <>) (AC <>)
   4                           (W 0) (SH 0) IX (VT <>) (WAS-TYPED <>))
   5         #DECL ((L) LIST (OL) <OR FALSE LIST>)
   6         <COND (<TYPE? .WL FIX> <SET W .WL>)>
   7         <COND (<TYPE? .SHL FIX> <SET SH .SHL>)>
   8         <COND (<TYPE? .WD ATOM>
   9                <SET OL <OBJ-LOC .WD 1>>
  10                <SET TAC? <IN-AC? .WD BOTH>>
  11                <SET AC? <IN-AC? .WD VALUE>>
  12                <SET VT <VAR-TYPED? .WD>>)>
  13         <SET BP <CHTYPE <ORB <LSH .SH 30> <LSH .W 24>> FIX>>
  14         <COND (<OR <N==? .WD .DST> <AND <NOT .VT> <NOT .AC?>>>
  15                <SET TAC? <LOAD-AC .WD BOTH>>
  16                <SET AC? <NEXT-AC .TAC?>>
  17                <COND (<AND <N==? .WD .DST>
  18                            <NOT <WILL-DIE? .WD>>>
  19                       <FLUSH-AC .TAC? T>)>)>
  20         <COND (<N==? .WD .DST>
  21                <COND (.TAC?
  22                       <SET WAS-TYPED <AC-TYPE <GET-AC .TAC?>>>
  23                       <MUNGED-AC .TAC? T>)
  24                      (.AC? <MUNGED-AC .AC?>)>)>
  25         <COND (.AC? <SET AN <2 <CHTYPE <MEMQ .AC? ,ACS> VECTOR>>>)>
  26         <COND (.AC? <SET BP <CHTYPE <ORB .BP .AN> CONSTANT>>)
  27               (.OL
  28                <SET BP
  29                     <CHTYPE (<2 .OL>
  30                              <+ <CHTYPE <LSH <2 <MEMQ <1 <CHTYPE <3 .OL> LIST>>
  31                                                       ,ACS>>
  32                                              18>
  33                                         FIX>
  34                                 <CHTYPE <1 .OL> FIX>
  35                                 .BP>) CONST-W-LOCAL>>)>
  36         <COND (<AND <TYPE? .WL FIX> <TYPE? .SHL FIX>>
  37                <COND (<OR <NOT <TYPE? .NEW ATOM>>
  38                           <AND <WILL-DIE? .NEW>
  39                                <NOT <SET AC <IN-AC? .NEW VALUE>>>>>
  40                       <GET-INTO-ACS .NEW VALUE <SET AC T*>>)
  41                      (<NOT .AC>
  42                       <SET AC <NEXT-AC <LOAD-AC .NEW BOTH>>>)>
  43                <CONST-LOC .BP VALUE>
  44                <OCEMIT DPB .AC !<OBJ-VAL .BP>>)
  45               (ELSE
  46                <COND (.AC? <OCEMIT MOVEI O* .AC?>)
  47                      (ELSE
  48                       <CONST-LOC .BP VALUE>
  49                       <OCEMIT MOVE O* !<OBJ-VAL .BP>>)>
  50                <COND (<NOT <TYPE? .SHL FIX>>
  51                       <OCEMIT DPB <COND (<IN-AC? .SHL VALUE>)
  52                                         (ELSE <NEXT-AC <LOAD-AC .SHL BOTH>>)>
  53                               !<OBJ-VAL <SET BP <CHTYPE *360600000000*
  54                                                         CONSTANT>>>>
  55                       <CONST-LOC .BP VALUE>)>
  56                <COND (<NOT <TYPE? .WL FIX>>
  57                       <OCEMIT DPB <COND (<IN-AC? .WL VALUE>)
  58                                         (ELSE <NEXT-AC <LOAD-AC .WL BOTH>>)>
  59                               !<OBJ-VAL <SET BP <CHTYPE *300600000000*
  60                                                         CONSTANT>>>>
  61                       <CONST-LOC .BP VALUE>)>
  62                <COND (.AC?
  63                       <AC-TIME <GET-AC .AC?>
  64                                <SETG AC-STAMP <+ ,AC-STAMP 1>>>
  65                       <COND (.TAC? <AC-TIME <GET-AC .TAC?> ,AC-STAMP>)>)>
  66                <SET AC <LOAD-AC .NEW BOTH>>
  67                <OCEMIT DPB <NEXT-AC .AC> O*>)>
  68         <COND (<==? .DST STACK>
  69                <OCEMIT PUSH TP* !<TYPE-WORD FIX>>
  70                <OCEMIT PUSH TP* .AC?>
  71                <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
  72               (<N==? .WD .DST>
  73                <CLEAN-ACS .DST>
  74                <AC-UPDATE <AC-ITEM <AC-CODE <GET-AC .TAC?> TYPE>
  75                                    .DST> T>
  76                <COND (.WAS-TYPED <AC-TYPE <GET-AC .TAC?> FIX>)>
  77                <AC-CODE
  78                 <AC-TYPE
  79                  <AC-ITEM
  80                   <AC-UPDATE <GET-AC <SET AC .AC?>> T> .DST> <>> VALUE>)
  81               (.AC?
  82                <COND (<NOT .TAC?>
  83                       <SET TAC? <GETPROP .AC? AC-PAIR>>
  84                       <AC-UPDATE <AC-ITEM <AC-CODE <GET-AC .TAC?> TYPE>
  85                                           .DST> T>)>
  86                <AC-UPDATE <GET-AC .AC?> T>
  87                <COND (<NOT .VT> <AC-TYPE <GET-AC .TAC?> FIX>)>)>>