mim/development/mim/mimc/mmqgen.mud

   1
   2 <PACKAGE "MMQGEN">
   3
   4 <ENTRY MEMQ-GEN>
   5
   6 <USE "COMPDEC" "CODGEN" "CHKDCL" "MIMGEN" "ADVMESS" "STRGEN">
   7
   8 <DEFINE MEMQ-GEN (N W
   9                   "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
  10                   "AUX" (STR <2 <KIDS .N>>) (THING <1 <KIDS .N>>)
  11                         (TYP <RESULT-TYPE .STR>) (TPS <STRUCTYP .TYP>)
  12                         (FLS <==? .W FLUSHED>) (SDIR .DIR)
  13                         (TTYP <RESULT-TYPE .THING>) TYPTMP VAL-TEMP
  14                         (ETY <GET-ELE-TYPE .TYP ALL>)
  15                         (TWIN <TYPESAME .ETY .TTYP>)
  16                         (B2
  17                          <COND (<AND .FLS .BRANCH> .BRANCH) (ELSE <MAKE-TAG>)>)
  18                         STRD NUMD TEM TY (B3 <MAKE-TAG>) (RW .W)
  19                         (FC <0? <CHTYPE <MINL .TYP> FIX>>) (LP <MAKE-TAG>) B4
  20                         (NXT-TAG <MAKE-TAG>))
  21    #DECL ((N STR THING) NODE (DCOD) FIX (B2 B3 B4) ATOM (TPS) <OR ATOM FALSE>
  22           (DEAD) <PRIMTYPE LIST> (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
  23    <AND .NOTF <SET DIR <NOT .DIR>>>
  24    <SET TEM <COND (<AND <TYPE? .W TEMP> <L=? <TEMP-REFS .W> 0>> .W)
  25                   (ELSE DONT-CARE)>>
  26    <COND (<AND <NOT <SIDE-EFFECTS .N>>
  27                <NOT <MEMQ <NODE-TYPE .STR> ,SNODES>>
  28                <MEMQ <NODE-TYPE .THING> ,SNODES>>
  29           <SET STRD <GEN .STR .TEM>>
  30           <SET NUMD <GEN .THING DONT-CARE>>)
  31          (ELSE
  32           <SET NUMD <GEN .THING DONT-CARE>>
  33           <SET NUMD <INTERF-CHANGE .NUMD .STR>>
  34           <SET STRD <GEN .STR .TEM>>)>
  35    <COND (<OR <NOT <TYPE? .STRD TEMP>> <G? <TEMP-REFS .STRD> 1>>
  36           <COND (<AND <NOT .FLS> <NOT .NOTF> .TPS <N==? .TPS <ISTYPE? .TYP>>>
  37                  <FREE-TEMP .STRD <>>
  38                  <IEMIT `CHTYPE .STRD <FORM `TYPE-CODE .TPS> =
  39                         <SET STRD <GEN-TEMP .TPS>>>)
  40                 (ELSE
  41                  <SET STRD <MOVE-ARG .STRD <GEN-TEMP <>>>>)>)
  42          (<AND <NOT .FLS> <NOT .NOTF> .TPS <N==? .TPS <ISTYPE? .TYP>>>
  43           <IEMIT `CHTYPE .STRD <FORM `TYPE-CODE .TPS> = .STRD>)>
  44    <COND (<AND <NOT .TWIN> <SET TY <ISTYPE? .ETY>>>
  45           <GEN-TYPE? .NUMD .TY <COND (.DIR .B3) (ELSE .B2)> <>>
  46           <SET TWIN T>)>
  47    <COND (<AND <NOT <SET TTYP <ISTYPE? .TTYP>>> <NOT .TY>>
  48           <IEMIT `TYPE .NUMD = <SET TYPTMP <GEN-TEMP>>>)>
  49    <COND (<AND .BRANCH <NOT .FLS> .DIR <NOT .NOTF> <=? .W .STRD> <NOT .SETF>>
  50           <SET B2 .BRANCH>)>
  51    <COND (.FC
  52           <COND (.TPS
  53                  <EMPTY-CHECK .TPS .STRD .TPS T <COND (.DIR .B3) (ELSE .B2)>>)
  54                 (ELSE <IEMIT `EMPTY? .STRD + <COND (.DIR .B3) (ELSE .B2)>>)>)>
  55    <IEMIT `LOOP !<COND (<TYPE? .NUMD TEMP>
  56                         <COND (<ASSIGNED? TYPTMP>
  57                                ((<TEMP-NAME .NUMD> VALUE)
  58                                 (<TEMP-NAME .TYPTMP> VALUE)))
  59                               (ELSE ((<TEMP-NAME .NUMD> VALUE)))>)
  60                        (<ASSIGNED? TYPTMP> ((<TEMP-NAME .TYPTMP> VALUE)))
  61                        (ELSE ())>
  62           <COND (<NOT .TPS> (<TEMP-NAME .STRD> LENGTH VALUE TYPE))
  63                 (<==? .TPS LIST> (<TEMP-NAME .STRD> VALUE))
  64                 (ELSE (<TEMP-NAME .STRD> LENGTH VALUE))>>
  65    <LABEL-TAG .LP>
  66    <COND (.TPS <NTH-DO .TPS .STRD <SET VAL-TEMP <GEN-TEMP>> 1>)
  67          (ELSE <IEMIT `NTH1 .STRD = <SET VAL-TEMP <GEN-TEMP>>>)>
  68    <COND (<ASSIGNED? TYPTMP> <GEN-TYPE? .VAL-TEMP .TYPTMP .NXT-TAG <>>)
  69          (<NOT .TWIN> <GEN-TYPE? .VAL-TEMP .TTYP .NXT-TAG <>>)>
  70    <IEMIT `VEQUAL? .VAL-TEMP <ATOMCHK .NUMD> + <COND (.DIR .B2) (ELSE .B3)>>
  71    <FREE-TEMP .VAL-TEMP>
  72    <LABEL-TAG .NXT-TAG>
  73    <COND (.TPS <REST-DO .TPS .STRD .STRD 1>)
  74          (ELSE <IEMIT `REST1 .STRD = .STRD>)>
  75    <COND (.TPS <EMPTY-CHECK .TPS .STRD .TPS <> .LP>)
  76          (ELSE <IEMIT `EMPTY? .STRD - .LP>)>
  77    <FREE-TEMP .NUMD>
  78    <COND (<ASSIGNED? TYPTMP> <FREE-TEMP .TYPTMP>)>
  79    <COND (<AND .BRANCH .FLS>
  80           <COND (<NOT .DIR> <BRANCH-TAG .B2> <LABEL-TAG .B3>)
  81                 (ELSE <LABEL-TAG .B3>)>
  82           <FREE-TEMP .STRD>)
  83          (<OR .NOTF <AND <NOT .SETF> <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>>
  84           <COND (<==? .STRD .W> <DEALLOCATE-TEMP .STRD>)
  85                 (ELSE <FREE-TEMP .STRD>)>
  86           <COND (<AND .NOTF .DIR> <BRANCH-TAG .B3>)>
  87           <LABEL-TAG .B2>
  88           <MOVE-ARG <REFERENCE .SDIR>
  89                     <SET W
  90                          <COND (<==? .W DONT-CARE> <GEN-TEMP <>>) (ELSE .W)>>>
  91           <BRANCH-TAG .BRANCH>
  92           <COND (.SETF
  93                  <DEALLOCATE-TEMP .W>
  94                  <MOVE-ARG <REFERENCE <NOT .SDIR>> .W>)>
  95           <LABEL-TAG .B3>)
  96          (ELSE
  97           <COND (.BRANCH
  98                  <COND (<==? .B2 .BRANCH>
  99                         <LABEL-TAG .B3>
 100                         <SET W <MOVE-ARG .STRD .W>>)
 101                        (<NOT .DIR>
 102                         <LABEL-TAG .B2>
 103                         <COND (.SETF
 104                                <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <>> .W>>)>
 105                         <BRANCH-TAG .BRANCH>
 106                         <LABEL-TAG .B3>
 107                         <SET W <MOVE-ARG .STRD .W>>)
 108                        (ELSE
 109                         <BRANCH-TAG .B3>
 110                         <LABEL-TAG .B2>
 111                         <SET W <MOVE-ARG .STRD .W>>
 112                         <BRANCH-TAG .BRANCH>
 113                         <LABEL-TAG .B3>
 114                         <COND (.SETF
 115                                <DEALLOCATE-TEMP .W>
 116                                <MOVE-ARG <REFERENCE <>> .W>)>)>)
 117                 (ELSE
 118                  <DEALLOCATE-TEMP .STRD>
 119                  <LABEL-TAG .B2>
 120                  <SET W
 121                       <MOVE-ARG <REFERENCE <>>
 122                                 <COND (<==? .W DONT-CARE> .STRD)
 123                                       (ELSE .W)>>>
 124                  <COND (<==? .W .STRD>
 125                         <LABEL-TAG .B3>
 126                         .W)
 127                        (ELSE
 128                         <DEALLOCATE-TEMP .W>
 129                         <BRANCH-TAG <SET B4 <MAKE-TAG>>>
 130                         <LABEL-TAG .B3>
 131                         <SET W <MOVE-ARG .STRD .W>>
 132                         <LABEL-TAG .B4>)>)>)>
 133    <MOVE-ARG .W .RW>>
 134
 135 <ENDPACKAGE>