<mdl.comp>/terst.gen.1

   1 <PACKAGE "CARGEN">
   2
   3 <ENTRY ARITH-GEN ABS-GEN FLOAT-GEN FIX-GEN MOD-GEN ROT-GEN LSH-GEN 1?-GEN
   4        GEN-FLOAT GENFLOAT MIN-MAX PRED:BRANCH:GEN 0-TEST FLIP TEST-GEN>
   5
   6 <USE "CACS" "CODGEN" "CHKDCL" "COMCOD" "COMPDEC" "CONFOR" "STRGEN"><DEFINE TEST-GEN (NOD WHERE
   7                   "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
   8                   "AUX" (K <1 <KIDS .NOD>>) (K2 <2 <KIDS .NOD>>) REGT REGT2
   9                         (S <SW? <NODE-NAME .NOD>>) TRANSFORM ATYP ATYP2 B2
  10                         (SDIR .DIR) (RW .WHERE) TRANS1 (FLS <==? .RW FLUSHED>)
  11                         TEM (ONO .NO-KILL) (NO-KILL .ONO)
  12                   "ACT" TA)
  13    #DECL ((NOD K K2) NODE (REGT) DATUM (TRANSFORM) <SPECIAL TRANS>
  14           (TRANS1) TRANS (NO-KILL) <SPECIAL LIST>)
  15    <SET WHERE
  16         <COND (<==? .WHERE FLUSHED> FLUSHED)
  17               (ELSE <UPDATE-WHERE .NOD .WHERE>)>>
  18    <COND (<OR <==? <NODE-TYPE .K2> ,QUOTE-CODE>
  19               <AND <NOT <MEMQ <NODE-TYPE .K> ,SNODES>>
  20                    <NOT <SIDE-EFFECTS .NOD>>
  21                    <MEMQ <NODE-TYPE .K2> ,SNODES>>>
  22           <COND (<AND <==? <NODE-TYPE .K> ,LVAL-CODE>
  23                       <COND (<==? <LENGTH <SET TEM <TYPE-INFO .K>>> 2> <2 .TEM>)
  24                             (ELSE T)>
  25                       <SET TEM <NODE-NAME .K>>
  26                       <NOT <MAPF <>
  27                                  <FUNCTION (LL)
  28                                          <AND <==? <1 .LL> .TEM> <MAPLEAVE>>>
  29                                  .NO-KILL>>>
  30                  <SET NO-KILL ((<NODE-NAME .K> <>) !.NO-KILL)>)>
  31           <SET K .K2>
  32           <SET K2 <1 <KIDS .NOD>>>
  33           <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>)>
  34    <SET ATYP <ISTYPE? <RESULT-TYPE .K2>>>
  35    <SET ATYP2 <ISTYPE-GOOD? <RESULT-TYPE .K>>>
  36    <SET REGT
  37         <DATUM <COND (.ATYP .ATYP) (ELSE ANY-AC)> ANY-AC>>
  38    <SET REGT2
  39         <COND (<OR <==? <NODE-TYPE .K> ,QUOTE-CODE>
  40                    <NOT <SIDE-EFFECTS .K2>>>
  41                DONT-CARE)
  42               (.ATYP2 <DATUM .ATYP2 ANY-AC>)
  43               (ELSE <DATUM ANY-AC ANY-AC>)>>
  44    <COND (<N==? <NODE-TYPE .K> ,QUOTE-CODE>
  45           <COND (<OR <==? .ATYP FLOAT> <==? .ATYP2 FLOAT>>)
  46                 (ELSE
  47                  <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>
  48                  <PUT <2 .TRANSFORM> 6 1>
  49                  <PUT <2 .TRANSFORM> 7 0>)>
  50           <SET REGT2 <GEN .K .REGT2>>
  51           <COND (<ASSIGNED? TRANSFORM>
  52                  <SET TRANS1 .TRANSFORM>
  53                  <SET TRANSFORM <UPDATE-TRANS .NOD .TRANS1>>)>
  54           <COND (<TYPE? <DATVAL .REGT2> AC>
  55                  <SET REGT <GEN .K2 DONT-CARE>>
  56                  <COND (<TYPE? <DATVAL .REGT2> AC>
  57                         <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>
  58                         <SET TEM .REGT>
  59                         <SET REGT .REGT2>
  60                         <SET REGT2 .TEM>
  61                         <COND (<ASSIGNED? TRANSFORM>
  62                                <SET TEM .TRANS1>
  63                                <SET TRANS1 .TRANSFORM>
  64                                <SET TRANSFORM .TEM>)>
  65                         <SET TEM .ATYP>
  66                         <SET ATYP .ATYP2>
  67                         <SET ATYP2 .TEM>)
  68                        (ELSE <TOACV .REGT>)>)
  69                 (ELSE <SET REGT <GEN .K2 .REGT>>)>)
  70          (ELSE
  71           <COND (<OR <==? .ATYP FIX>
  72                      <0? <NODE-NAME .K>>
  73                      <1? <NODE-NAME .K>>>
  74                  <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>)>
  75           <COND (<==? .ATYP FIX>
  76                  <PUT <PUT <2 .TRANSFORM> 2 1> 3 <FIX <NODE-NAME .K>>>)>
  77           <COND (<LN-LST .K2> <SET REGT ,NO-DATUM>)
  78                 (ELSE
  79                  <SET REGT <GEN .K2 .REGT>>
  80                  <DATTYP-FLUSH .REGT>
  81                  <PUT .REGT ,DATTYP .ATYP>)>
  82           <RETURN
  83            <TEST-DISP .NOD
  84                       .WHERE
  85                       .NOTF
  86                       .BRANCH
  87                       .DIR
  88                       .REGT
  89                       <COND (<ASSIGNED? TRANSFORM>
  90                              <DO-TRANS <FIX <NODE-NAME .K>> .TRANSFORM>)
  91                             (ELSE <NODE-NAME .K>)>
  92                       <AND <ASSIGNED? TRANSFORM> <NOT <0? <1 <3 .TRANSFORM>>>>>>
  93            .TA>)>
  94    <DELAY-KILL .NO-KILL .ONO>
  95    <AND <ASSIGNED? TRANSFORM>
  96         <CONFORM .REGT .REGT2 .TRANSFORM .TRANS1>
  97         <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>>
  98    <COND (.BRANCH
  99           <AND .NOTF <SET DIR <NOT .DIR>>>
 100           <VAR-STORE <>>
 101           <GEN-COMP2 <NODE-NAME .NOD>
 102                      .ATYP2
 103                      .ATYP
 104                      .REGT2
 105                      .REGT
 106                      <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
 107                      <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE:TAG>>)>>
 108           <COND (<NOT .FLS>
 109                  <SET RW <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
 110                  <BRANCH:TAG .BRANCH>
 111                  <LABEL:TAG .B2>
 112                  .RW)>)
 113          (ELSE
 114           <VAR-STORE <>>
 115           <GEN-COMP2 <NODE-NAME .NOD>
 116                      .ATYP2
 117                      .ATYP
 118                      .REGT2
 119                      .REGT
 120                      .NOTF
 121                      <SET BRANCH <MAKE:TAG>>>
 122           <MOVE:ARG <REFERENCE T> .WHERE>
 123           <RET-TMP-AC .WHERE>
 124           <BRANCH:TAG <SET B2 <MAKE:TAG>>>
 125           <LABEL:TAG .BRANCH>
 126           <MOVE:ARG <REFERENCE <>> .WHERE>
 127           <LABEL:TAG .B2>
 128           <MOVE:ARG .WHERE .RW>)>>
 129 <ENDPACKAGE>