<mdl.comp>/test.gen.3

   1 <PACKAGE "STRGEN">
   2
   3 <ENTRY NTH-GEN REST-GEN PUT-GEN LNTH-GEN MT-GEN PUTREST-GEN IPUT-GEN
   4         IREMAS-GEN FLUSH-COMMON-SYMT COMMUTE-STRUC DEFER-IT PUT-COMMON-DAT
   5         LIST-LNT-SPEC RCHK>
   6
   7 <USE "CODGEN" "CACS" "COMCOD" "CHKDCL" "COMPDEC" "SPCGEN" "COMTEM" "CARGEN">
   8 <DEFINE PUTREST-GEN (NOD WHERE
   9                      "AUX" ST1 ST2 (K <KIDS .NOD>) (FLG T) N CD (ONO .NO-KILL)
  10                            (NO-KILL .ONO) (2RET <>))
  11         #DECL ((NOD N) NODE (K) <LIST NODE NODE> (ST1 ST2) DATUM
  12                (NO-KILL) <SPECIAL LIST> (ONO) LIST)
  13         <COND (<==? <NODE-SUBR .NOD> ,REST>
  14                <SET NOD <1 .K>>
  15                <SET K <KIDS .NOD>>
  16                <SET 2RET T>)>                      ;"Really <REST <PUTREST ...."
  17         <COND (<AND <==? <NODE-TYPE <2 .K>> ,QUOTE-CODE>
  18                     <==? <NODE-NAME <2 .K>> ()>>
  19                <SET ST1 <GEN <1 .K> <UPDATE-WHERE .NOD .WHERE>>>)
  20               (<AND <NOT <SIDE-EFFECTS? <1 .K>>>
  21                     <NOT <SIDE-EFFECTS? <2 .K>>>
  22                     <MEMQ <NODE-TYPE <1 .K>> ,SNODES>>
  23                <AND <==? <NODE-TYPE <SET N <1 .K>>> ,LVAL-CODE>
  24                     <COND (<==? <LENGTH <SET CD <TYPE-INFO .N>>> 2> <2 .CD>)
  25                           (ELSE T)>
  26                     <SET CD <NODE-NAME .N>>
  27                     <NOT <MAPF <>
  28                                <FUNCTION (LL)
  29                                        #DECL ((LL) <LIST SYMTAB ANY>)
  30                                        <AND <==? .CD <1 .LL>> <MAPLEAVE>>>
  31                                .NO-KILL>>
  32                     <SET NO-KILL ((.CD <>) !.NO-KILL)>>
  33                <SET ST2
  34                     <GEN <2 .K>
  35                          <COND (.2RET <GOODACS <2 .K> .WHERE>)
  36                                (ELSE <DATUM LIST ANY-AC>)>>>
  37                <SET ST1
  38                     <GEN <1 .K>
  39                          <COND (.2RET DONT-CARE)
  40                                (ELSE <UPDATE-WHERE .NOD .WHERE>)>>>
  41                <DELAY-KILL .NO-KILL .ONO>)
  42               (ELSE
  43                <SET ST1
  44                     <GEN <1 .K>
  45                          <GOODACS .NOD
  46                                   <COND (<OR <==? .WHERE FLUSHED> .2RET>
  47                                          DONT-CARE)
  48                                         (ELSE .WHERE)>>>>
  49                <SET ST2 <GEN <2 .K> <DATUM LIST ANY-AC>>>)>
  50         <KILL-COMMON LIST>
  51         <AND .CAREFUL
  52              <G? 1 <MINL <RESULT-TYPE <1 .K>>>>
  53              <COND (<TYPE? <DATVAL .ST1> AC>
  54                     <EMIT <INSTRUCTION `JUMPE  <ACSYM <DATVAL .ST1>> |CERR2 >>)
  55                    (ELSE
  56                     <EMIT <INSTRUCTION `SKIPN  !<ADDR:VALUE .ST1>>>
  57                     <BRANCH:TAG |CERR2 >)>>
  58         <AND <ASSIGNED? ST2> <TOACV .ST2>>
  59         <OR <TYPE? <DATVAL .ST1> AC> <SET FLG <>>>
  60         <COND (<ASSIGNED? ST2>
  61                <COND (.FLG
  62                       <EMIT <INSTRUCTION `HRRM
  63                                          <ACSYM <CHTYPE <DATVAL .ST2> AC>>
  64                                          (<ADDRSYM <CHTYPE <DATVAL .ST1> AC>>)>>)
  65                      (ELSE
  66                       <EMIT <INSTRUCTION `HRRM
  67                                          <ACSYM <CHTYPE <DATVAL .ST2> AC>>
  68                                          `@
  69                                          !<ADDR:VALUE .ST1>>>)>
  70                <RET-TMP-AC <COND (.2RET .ST1) (ELSE .ST2)>>)
  71               (ELSE
  72                <COND (.FLG
  73                       <EMIT <INSTRUCTION `HLLZS  (<ADDRSYM <CHTYPE <DATVAL .ST1> AC>>)>>)
  74                      (ELSE
  75                       <EMIT <INSTRUCTION `HLLZS  `@  !<ADDR:VALUE .ST1>>>)>)>
  76         <MOVE:ARG <COND (.2RET .ST2) (ELSE .ST1)> .WHERE>>
  77
  78 <PUT ,GENERATORS ,PUTREST-CODE ,PUTREST-GEN>
  79 <DEFINE FLUSH-COMMON-SYMT (SYMT)
  80    #DECL ((SYMT) SYMTAB)
  81    <MAPF <>
  82     <FUNCTION (AC "AUX" ACR)
  83             #DECL ((AC) AC)
  84             <SET ACR
  85                  <COND (<SET ACR <ACRESIDUE .AC>>
  86                         <COND (<EQSYMT <1 .ACR> .SYMT> <REST .ACR>)
  87                               (<REPEAT ((PTR <REST .ACR>) (SACR .ACR))
  88                                        <COND (<EMPTY? .PTR> <RETURN .SACR>)>
  89                                        <COND (<EQSYMT <1 .PTR> .SYMT>
  90                                               <PUTREST .ACR <REST .PTR>>
  91                                               <RETURN .SACR>)>
  92                                        <SET PTR <REST .PTR>>
  93                                        <SET ACR <REST .ACR>>>)>)>>
  94             <PUT .AC ,ACRESIDUE <COND (<EMPTY? .ACR> <>) (ELSE .ACR)>>>
  95     ,ALLACS>>
  96
  97 <ENDPACKAGE>
  98 <PACKAGE "CARGEN">
  99
 100 <ENTRY ARITH-GEN ABS-GEN FLOAT-GEN FIX-GEN MOD-GEN ROT-GEN LSH-GEN 1?-GEN
 101        GEN-FLOAT GENFLOAT MIN-MAX PRED:BRANCH:GEN 0-TEST FLIP TEST-GEN>
 102
 103 <USE "CACS" "CODGEN" "CHKDCL" "COMCOD" "COMPDEC" "CONFOR" "STRGEN">
 104
 105 <DEFINE TEST-GEN (NOD WHERE
 106                   "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
 107                   "AUX" (K <1 <KIDS .NOD>>) (K2 <2 <KIDS .NOD>>) REGT REGT2
 108                         (S <SW? <NODE-NAME .NOD>>) TRANSFORM ATYP ATYP2 B2
 109                         (SDIR .DIR) (RW .WHERE) TRANS1 (FLS <==? .RW FLUSHED>)
 110                         TEM (ONO .NO-KILL) (NO-KILL .ONO)
 111                   "ACT" TA)
 112    #DECL ((NOD K K2) NODE (REGT) DATUM (TRANSFORM) <SPECIAL TRANS>
 113           (TRANS1) TRANS (NO-KILL) <SPECIAL LIST>)
 114    <SET WHERE
 115         <COND (<==? .WHERE FLUSHED> FLUSHED)
 116               (ELSE <UPDATE-WHERE .NOD .WHERE>)>>
 117    <COND (<OR <==? <NODE-TYPE .K2> ,QUOTE-CODE>
 118               <AND <NOT <MEMQ <NODE-TYPE .K> ,SNODES>>
 119                    <NOT <SIDE-EFFECTS .NOD>>
 120                    <MEMQ <NODE-TYPE .K2> ,SNODES>>>
 121           <COND (<AND <==? <NODE-TYPE .K> ,LVAL-CODE>
 122                       <COND (<==? <LENGTH <SET TEM <TYPE-INFO .K>>> 2> <2 .TEM>)
 123                             (ELSE T)>
 124                       <SET TEM <NODE-NAME .K>>
 125                       <NOT <MAPF <>
 126                                  <FUNCTION (LL)
 127                                          <AND <==? <1 .LL> .TEM> <MAPLEAVE>>>
 128                                  .NO-KILL>>>
 129                  <SET NO-KILL ((<NODE-NAME .K> <>) !.NO-KILL)>)>
 130           <SET K .K2>
 131           <SET K2 <1 <KIDS .NOD>>>
 132           <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>)>
 133    <SET ATYP <ISTYPE? <RESULT-TYPE .K2>>>
 134    <SET ATYP2 <ISTYPE-GOOD? <RESULT-TYPE .K>>>
 135    <SET REGT
 136         <DATUM <COND (.ATYP .ATYP) (ELSE ANY-AC)> ANY-AC>>
 137    <SET REGT2
 138         <COND (<OR <==? <NODE-TYPE .K> ,QUOTE-CODE>
 139                    <NOT <SIDE-EFFECTS .K2>>>
 140                DONT-CARE)
 141               (.ATYP2 <DATUM .ATYP2 ANY-AC>)
 142               (ELSE <DATUM ANY-AC ANY-AC>)>>
 143    <COND (<N==? <NODE-TYPE .K> ,QUOTE-CODE>
 144           <COND (<OR <==? .ATYP FLOAT> <==? .ATYP2 FLOAT>>)
 145                 (ELSE
 146                  <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>
 147                  <PUT <2 .TRANSFORM> 6 1>
 148                  <PUT <2 .TRANSFORM> 7 0>)>
 149           <SET REGT2 <GEN .K .REGT2>>
 150           <COND (<ASSIGNED? TRANSFORM>
 151                  <SET TRANS1 .TRANSFORM>
 152                  <SET TRANSFORM <UPDATE-TRANS .NOD .TRANS1>>)>
 153           <COND (<TYPE? <DATVAL .REGT2> AC>
 154                  <SET REGT <GEN .K2 DONT-CARE>>
 155                  <COND (<TYPE? <DATVAL .REGT2> AC>
 156                         <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>
 157                         <SET TEM .REGT>
 158                         <SET REGT .REGT2>
 159                         <SET REGT2 .TEM>
 160                         <COND (<ASSIGNED? TRANSFORM>
 161                                <SET TEM .TRANS1>
 162                                <SET TRANS1 .TRANSFORM>
 163                                <SET TRANSFORM .TEM>)>
 164                         <SET TEM .ATYP>
 165                         <SET ATYP .ATYP2>
 166                         <SET ATYP2 .TEM>)
 167                        (ELSE <TOACV .REGT>)>)
 168                 (ELSE <SET REGT <GEN .K2 .REGT>>)>)
 169          (ELSE
 170           <COND (<OR <==? .ATYP FIX>
 171                      <0? <NODE-NAME .K>>
 172                      <1? <NODE-NAME .K>>>
 173                  <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>)>
 174           <COND (<==? .ATYP FIX>
 175                  <PUT <PUT <2 .TRANSFORM> 2 1> 3 <FIX <NODE-NAME .K>>>)>
 176           <COND (<LN-LST .K2> <SET REGT ,NO-DATUM>)
 177                 (ELSE
 178                  <SET REGT <GEN .K2 .REGT>>
 179                  <DATTYP-FLUSH .REGT>
 180                  <PUT .REGT ,DATTYP .ATYP>)>
 181           <RETURN
 182            <TEST-DISP .NOD
 183                       .WHERE
 184                       .NOTF
 185                       .BRANCH
 186                       .DIR
 187                       .REGT
 188                       <COND (<ASSIGNED? TRANSFORM>
 189                              <DO-TRANS <FIX <NODE-NAME .K>> .TRANSFORM>)
 190                             (ELSE <NODE-NAME .K>)>
 191                       <AND <ASSIGNED? TRANSFORM> <NOT <0? <1 <3 .TRANSFORM>>>>>>
 192            .TA>)>
 193    <DELAY-KILL .NO-KILL .ONO>
 194    <AND <ASSIGNED? TRANSFORM>
 195         <CONFORM .REGT .REGT2 .TRANSFORM .TRANS1>
 196         <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>>
 197    <COND (.BRANCH
 198           <AND .NOTF <SET DIR <NOT .DIR>>>
 199           <VAR-STORE <>>
 200           <GEN-COMP2 <NODE-NAME .NOD>
 201                      .ATYP2
 202                      .ATYP
 203                      .REGT2
 204                      .REGT
 205                      <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
 206                      <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE:TAG>>)>>
 207           <COND (<NOT .FLS>
 208                  <SET RW <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
 209                  <BRANCH:TAG .BRANCH>
 210                  <LABEL:TAG .B2>
 211                  .RW)>)
 212          (ELSE
 213           <VAR-STORE <>>
 214           <GEN-COMP2 <NODE-NAME .NOD>
 215                      .ATYP2
 216                      .ATYP
 217                      .REGT2
 218                      .REGT
 219                      .NOTF
 220                      <SET BRANCH <MAKE:TAG>>>
 221           <MOVE:ARG <REFERENCE T> .WHERE>
 222           <RET-TMP-AC .WHERE>
 223           <BRANCH:TAG <SET B2 <MAKE:TAG>>>
 224           <LABEL:TAG .BRANCH>
 225           <MOVE:ARG <REFERENCE <>> .WHERE>
 226           <LABEL:TAG .B2>
 227           <MOVE:ARG .WHERE .RW>)>>
 228
 229 <PUT ,GENERATORS ,TEST-CODE ,TEST-GEN>
 230 <ENDPACKAGE>