mim/development/mim/mimc/cargen.mud

   1
   2 <PACKAGE "CARGEN">
   3
   4 <ENTRY ARITH-GEN
   5        ABS-GEN
   6        FLOAT-GEN
   7        FIX-GEN
   8        MOD-GEN
   9        ROT-GEN
  10        LSH-GEN
  11        1?-GEN
  12        GEN-FLOAT
  13        GENFLOAT
  14        MIN-MAX
  15        0-TEST
  16        FLIP
  17        TEST-GEN>
  18
  19 <USE "COMPDEC" "CODGEN" "CHKDCL" "STRGEN" "MIMGEN" "ADVMESS">
  20
  21 "       This file contains analyzers and code generators for arithmetic
  22  SUBRs and predicates.  For convenience many of the SUBRs that are
  23 similar are combined into one analyzer/generator.  For more info
  24 on analyzers see SYMANA and on generators see CODGEN.
  25 "
  26
  27 "A type TRANS specifies to an inferior node what arithmetic transforms are
  28 prohibited, permitted or desired.  A transform consists of 3 main elements:
  29 a NODE, an input, an output.  The input and output are UVECTORS of 7 fixes:
  30
  31 1)      negative ok     0-no, 1-ok, 2-pref
  32 2)      + or - const ok 0-no, 1-ok, 2-pref
  33 3)      const for + or -
  34 4)      * or / const ok 0-no, 1-* ok, 2-* pref, 3-/ ok, 4-/ pref
  35 5)      hw ok           0-no, 1-ok, 2-pref
  36 6)      hw swapped also 0-no, 1-ok, 2-pref
  37 "
  38
  39 <SETG SNODES <UVECTOR ,QUOTE-CODE ,LVAL-CODE ,GVAL-CODE>>
  40
  41 <SETG SNODES1 <REST ,SNODES>>
  42
  43 <GDECL (SNODES SNODES1) <UVECTOR [REST FIX]>>
  44
  45 <DEFINE COMMUTE (K OP L "AUX" TT FK KK TYP NN N CD CD1)
  46    #DECL ((K KK FK) <LIST [REST NODE]> (N NN) NODE (CD1 CD) FIX (L) LIST)
  47    <PROG ((REDO <>))
  48      <COND (<EMPTY? .K> <RETURN>)>
  49      <COND (<EMPTY? <SET KK <REST <SET FK .K>>>> <RETURN>)>
  50      <SET TYP <ISTYPE? <RESULT-TYPE <1 .KK>>>>
  51      <REPEAT ()
  52        <AND <EMPTY? .KK> <RETURN>>
  53        <COND
  54         (<==? .TYP <SET TYP <ISTYPE? <RESULT-TYPE <SET NN <1 .KK>>>>>>
  55          <SET CD1 <NODE-TYPE .NN>>
  56          <COND
  57           (<AND <==? <SET CD <NODE-TYPE <SET N <1 .FK>>>> ,QUOTE-CODE>
  58                 <==? .CD1 ,QUOTE-CODE>>
  59            <PUT .N ,NODE-NAME <APPLY ,.OP <NODE-NAME .N> <NODE-NAME .NN>>>
  60            <PUTREST .FK <SET KK <REST .KK>>>
  61            <SET REDO T>
  62            <AGAIN>)
  63           (<==? .CD ,QUOTE-CODE> <PUT .KK 1 .N> <PUT .FK 1 .NN> <SET REDO T>)
  64           (<AND <NOT <MEMQ .CD1 ,SNODES>>
  65                 <MEMQ .CD ,SNODES>
  66                 <N==? .CD1 ,SEG-CODE>
  67                 <NOT <SIDE-EFFECTS .NN>>>
  68            <COND (<AND <==? .CD ,LVAL-CODE>
  69                        <COND (<==? <LENGTH <SET TT <TYPE-INFO .N>>> 2> <2 .TT>)
  70                              (ELSE T)>
  71                        <SET TT <NODE-NAME .N>>
  72                        <NOT <MAPF <>
  73                                   <FUNCTION (LL)
  74                                           <AND <==? <1 .LL> .TT> <MAPLEAVE>>>
  75                                   .L>>>
  76                   <SET L ((<NODE-NAME .N> <>) !.L)>)>
  77            <PUT .KK 1 .N>
  78            <PUT .FK 1 .NN>
  79            <SET REDO T>)>)>
  80        <SET KK <REST <SET FK .KK>>>>
  81      <COND (.REDO <SET REDO <>> <AGAIN>)>
  82      .K>
  83    .L>
  84
  85 " Generate code for +,-,* and /."
  86
  87 <DEFINE ARITH-GEN AG (NOD WHERE
  88                       "AUX" REG (K <KIDS .NOD>) REG1 T1
  89                             (ATYP <LENGTH <CHTYPE <MEMQ <NODE-NAME .NOD>
  90                                                         '[/ * - +]>
  91                                                   VECTOR>>)
  92                             TT (MODE 1) (TEM <1 .K>) SEGF SHFT TRIN
  93                             (COM <OR <==? .ATYP 1> <==? .ATYP 3>>) INA
  94                             (DONE <>) (NEGF <>) (ONO .NO-KILL)
  95                             (NO-KILL .NO-KILL) TRAN)
  96    #DECL ((NOD TEM TT) NODE (K) <LIST [REST NODE]> (ATYP MODE) FIX
  97           (WHERE COM) ANY (NO-KILL) <SPECIAL LIST>
  98           (TRANSFORM TRAN) TRANS)
  99    <SET NO-KILL
 100         <COMMUTE <REST .K <NTH '![0 1 0 1!] .ATYP>>
 101                  <NTH '[+ + * *] .ATYP>
 102                  .NO-KILL>>
 103    <COND
 104     (<AND <==? <RESULT-TYPE .NOD> FIX>
 105           <==? <LENGTH .K> 2>
 106           <==? <NODE-TYPE <2 .K>> ,QUOTE-CODE>>
 107      <COND
 108       (<AND <ASSIGNED? TRANSFORM>
 109             <==? <PARENT .NOD> <1 <SET TRAN .TRANSFORM>>>
 110             <SET TRIN <2 .TRAN>>
 111             <COND
 112              (<AND <L=? .ATYP 2>
 113                    <OR <1? <2 .TRIN>>
 114                        <AND <==? <2 .TRIN> 2>
 115                             <==? <3 .TRIN>
 116                                  <COND (<1? .ATYP>
 117                                         <- <CHTYPE <NODE-NAME <2 .K>> FIX>>)
 118                                        (ELSE <NODE-NAME <2 .K>>)>>>>>
 119               <PUT <PUT <3 .TRAN> 2 1>
 120                    3
 121                    <COND (<1? .ATYP> <- <CHTYPE <NODE-NAME <2 .K>> FIX>>)
 122                          (ELSE <NODE-NAME <2 .K>>)>>)
 123              (<AND <==? .ATYP 3>
 124                    <OR <1? <4 .TRIN>>
 125                        <AND <==? <4 .TRIN> 4>
 126                             <==? <5 .TRIN> <NODE-NAME <2 .K>>>>>>
 127               <PUT <PUT <3 .TRAN> 4 4> 5 <NODE-NAME <2 .K>>>)
 128              (ELSE <>)>>
 129        <RETURN <GEN <1 .K> .WHERE> .AG>)
 130       (<N==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
 131        <PROG ((TRANSFORM
 132                <MAKE-TRANS .NOD
 133                            0
 134                            <COND (<L? .ATYP 3> 2) (ELSE 0)>
 135                            <COND (<1? .ATYP> <NODE-NAME <2 .K>>)
 136                                  (<==? .ATYP 2> <- <CHTYPE <NODE-NAME <2 .K>>
 137                                                            FIX>>)
 138                                  (ELSE 0)>
 139                            <COND (<G? .ATYP 2>
 140                                   <COND (<==? .ATYP 3> 2) (ELSE 4)>)
 141                                  (ELSE 0)>
 142                            <COND (<G? .ATYP 2> <NODE-NAME <2 .K>>) (ELSE 1)>
 143                            0
 144                            0>))
 145              #DECL ((TRANSFORM) <SPECIAL TRANS>)
 146              <SET REG <GEN .TEM DONT-CARE>>
 147              <SET DONE T>
 148              <MAPF <>
 149                    <FUNCTION (NN)
 150                            #DECL ((NN) FIX)
 151                            <COND (<NOT <0? .NN>>
 152                                   <RETURN <MOVE-ARG .REG .WHERE> .AG>)>>
 153                    <3 .TRANSFORM>>>)>)>
 154    <COND (.DONE)
 155          (<==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
 156           <SET REG1 <GEN <SET TEM <1 <KIDS .TEM>>> <GEN-TEMP <>>>>
 157           <SET MODE
 158                <SEGINS .ATYP
 159                        T
 160                        .TEM
 161                        <SET REG
 162                             <COND (<==? .WHERE DONT-CARE>
 163                                    <SET WHERE <GEN-TEMP <>>>)
 164                                   (<OR <NOT <TYPE? .WHERE TEMP>>
 165                                        <G? <TEMP-REFS .WHERE> 0>>
 166                                    <GEN-TEMP <>>)
 167                                   (ELSE .WHERE)>>
 168                        .REG1
 169                        1
 170                        <GET-DF <NODE-NAME .NOD>>>>)
 171          (ELSE
 172           <SET REG <GEN .TEM>>
 173           <COND (<AND <==? .WHERE DONT-CARE>
 174                       <TYPE? .REG TEMP>
 175                       <L? <TEMP-REFS .REG> 2>>
 176                  <SET WHERE .REG>)
 177                 (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP <>>>)>
 178           <COND (<AND <TYPE? .REG TEMP> <NOT <EMPTY? <REST .K>>>>
 179                  <SET REG <INTERF-CHANGE .REG <2 .K>>>)>
 180           <COND (<==? <RESULT-TYPE .TEM> FLOAT> <SET MODE 2>)>)>
 181    <MAPR <>
 182     <FUNCTION (N
 183                "AUX" NN TEM TRANSFORM
 184                      (NXT
 185                       <COND
 186                        (<==? <NODE-TYPE <SET NN <1 .N>>> ,SEG-CODE>
 187                         <SET SEGF T>
 188                         <GEN <SET NN <1 <KIDS .NN>>>>)
 189                        (ELSE
 190                         <SET SEGF <>>
 191                         <SET TRANSFORM
 192                              <MAKE-TRANS .NOD
 193                                          <COND (<AND .NEGF <G? .ATYP 2>> 2)
 194                                                (ELSE 1)>
 195                                          0
 196                                          0
 197                                          0
 198                                          0
 199                                          0
 200                                          0>>
 201                         <GEN .NN DONT-CARE>)>) (COM .COM)
 202                      (LAST <EMPTY? <REST .N>>))
 203             #DECL ((N) <LIST NODE> (MODE) FIX (NN) NODE
 204                    (TRANSFORM) <SPECIAL TRANS>)
 205             <COND (.SEGF
 206                    <COND (<OR <NOT <TYPE? .NXT TEMP>> <G? <TEMP-REFS .NXT> 1>>
 207                           <SET NXT <MOVE-ARG .NXT <GEN-TEMP <>>>>)>
 208                    <SET MODE <SEGINS .ATYP <> .NN .REG .NXT .MODE 0>>
 209                    <FREE-TEMP .NXT>)
 210                   (ELSE
 211                    <AND <ASSIGNED? TRANSFORM>
 212                         <NOT <0? <1 <3 .TRANSFORM>>>>
 213                         <PROG ()
 214                               <SET COM <NOT .COM>>
 215                               <SET NEGF <NOT .NEGF>>>>
 216                    <COND (<==? .MODE 2>
 217                           <COND (<==? <ISTYPE? <RESULT-TYPE .NN>> FIX>
 218                                  <SET NXT
 219                                       <GEN-FLOAT .NXT <PROT .NXT FLOAT>>>)>)
 220                          (<==? <ISTYPE? <RESULT-TYPE .NN>> FLOAT>
 221                           <SET REG <GEN-FLOAT .REG <PROT .REG FLOAT>>>
 222                           <SET MODE 2>)>
 223                    <COND (<AND <==? .ATYP 3>
 224                                <==? .MODE 1>
 225                                <==? <NODE-TYPE .NN> ,QUOTE-CODE>
 226                                <SET SHFT <POPWR2 <NODE-NAME .NN>>>>
 227                           <SET REG <SHIFT-INS .REG .SHFT .ATYP .LAST .WHERE>>)
 228                          (ELSE
 229                           <SET REG
 230                                <ARITH-INS <COND (<AND .NEGF <L? .ATYP 3>>
 231                                                  <SET NEGF <>>
 232                                                  <- 3 .ATYP>)
 233                                                 (ELSE .ATYP)>
 234                                           .REG
 235                                           .NXT
 236                                           .MODE
 237                                           .LAST
 238                                           .WHERE>>)>
 239                    <FREE-TEMP .NXT>)>>
 240     <REST .K>>
 241    <COND (.NEGF
 242           <COND (<AND <ASSIGNED? TRANSFORM>
 243                       <==? <1 <SET TRAN .TRANSFORM>> <PARENT .NOD>>
 244                       <NOT <0? <1 <2 .TRAN>>>>>
 245                  <PUT <3 .TRAN> 1 1>)
 246                 (ELSE <GEN-NEGATE .REG>)>)>
 247    <DELAY-KILL .NO-KILL .ONO>
 248    <MOVE-ARG .REG .WHERE>>
 249
 250 <DEFINE PROT (DAT TYP)
 251         <COND (<TYPE? .DAT TEMP> <DEALLOCATE-TEMP .DAT>)>
 252         <COND (<AND <TYPE? .DAT TEMP> <L=? <TEMP-REFS .DAT> 0>>
 253                <USE-TEMP .DAT .TYP>
 254                .DAT)
 255               (<TYPE? .DAT TEMP> <GEN-TEMP .TYP>)
 256               (ELSE .DAT)>>
 257
 258 <DEFINE SHIFT-INS (REG SHFT ATYP LAST W)
 259         #DECL ((SHFT ATYP) FIX)
 260         <GEN-SHIFT .REG
 261                    <COND (<==? .ATYP 3> .SHFT) (ELSE <- .SHFT>)>
 262                    <SET REG <COND (<AND .LAST <N==? .REG .W>>
 263                                    <FREE-TEMP .REG <>>
 264                                    <COND (<==? .W DONT-CARE>
 265                                           <GEN-TEMP FIX>)
 266                                          (<TYPE? .W TEMP> <USE-TEMP .W FIX> .W)
 267                                          (ELSE .W)>)
 268                                   (<TYPE? .REG TEMP> .REG)
 269                                   (ELSE <GEN-TEMP <>>)>>>
 270         .REG>
 271
 272 <DEFINE SEGINS (ATYP FD N REG REG2 MD DEFLT
 273                 "AUX" SAC SL TYP (STYP <RESULT-TYPE .N>) (TG <MAKE-TAG>)
 274                       (LOOP <MAKE-TAG>) RAC)
 275         #DECL ((N) NODE (ATYP SL MD) FIX)
 276         <SET TYP <COND (<==? <GET-ELE-TYPE .STYP ALL> FIX> 1) (ELSE 2)>>
 277         <SET STYP <STRUCTYP .STYP>>
 278         <SET SL <MINL <RESULT-TYPE .N>>>
 279         <COND (.FD
 280                <SET MD .TYP>
 281                <AND <==? .TYP 2> <==? .DEFLT 1> <SET DEFLT 1.0>>
 282                <COND (<L? .SL 1>
 283                       <SET-TEMP .REG
 284                                 .DEFLT
 285                                 (`TYPE <COND (<==? .TYP 1> FIX) (ELSE FLOAT)>)>
 286                       <EMPTY-JUMP .STYP .REG2 .TG>)>
 287                <COND (<OR <==? .ATYP 2> <==? .ATYP 4>>
 288                       <SET REG <GETEL .REG .REG2 .STYP>>
 289                       <ADVANCE .STYP .REG2>
 290                       <SET SL <- .SL 1>>)
 291                      (ELSE <SET SL 1>)>)
 292               (<AND <1? .MD> <==? .TYP 2>>
 293                <SET REG <GEN-FLOAT .REG <PROT .REG FLOAT>>>)>
 294         <COND (<L? .SL 1> <EMPTY-JUMP .STYP .REG2 .TG>)>
 295         <LABEL-TAG .LOOP>
 296         <EMITSEG .REG .REG2 .STYP .ATYP .TYP .MD>
 297         <ADVANCE-AND-CHECK .STYP .REG2 .LOOP>
 298         <LABEL-TAG .TG>
 299         .MD>
 300
 301 <DEFINE ADVANCE (STYP SAC "AUX" AMT)
 302         #DECL ((STYP) ATOM (AMT) FIX)
 303         <SET AMT <COND (<==? .STYP UVECTOR> 1) (ELSE 2)>>
 304         <COND (<==? .STYP LIST>
 305                <NTH-LIST .SAC 1 .SAC>)
 306               (<==? .STYP UVECTOR>
 307                <NTH-UVECTOR .SAC .SAC 1>)
 308               (ELSE
 309                <NTH-VECTOR .SAC .SAC 1>)>>
 310
 311 <DEFINE ADVANCE-AND-CHECK (STYP SAC TG)
 312         #DECL ((STYP) ATOM)
 313         <COND (<==? .STYP LIST>
 314                <REST-LIST .SAC .SAC 1>
 315                <EMPTY-LIST .SAC .TG <>>)
 316               (<==? .STYP VECTOR>
 317                <REST-VECTOR .SAC .SAC 1>
 318                <EMPTY-VECTOR .SAC .TG <>>)
 319               (ELSE
 320                <REST-UVECTOR .SAC .SAC 1>
 321                <EMPTY-UVECTOR .SAC .TG <>>)>>
 322
 323 <DEFINE EMPTY-JUMP (STYP SAC TG)
 324         #DECL ((STYP TG) ATOM)
 325         <COND (<==? .STYP LIST>
 326                <EMPTY-LIST .SAC .TG T>)
 327               (<==? .STYP VECTOR>
 328                <EMPTY-VECTOR .SAC .TG T>)
 329               (ELSE
 330                <EMPTY-UVECTOR .SAC .TG T>)>>
 331
 332 <DEFINE EMITSEG (RAC SAC STYP ATYP TYP MD "AUX" DAT (TMP <GEN-TEMP>))
 333         #DECL ((TYP MD ATYP) FIX)
 334         <COND (<AND <==? .MD 2> <==? .TYP 1>>
 335                <GETEL .TMP .SAC .STYP>
 336                <GEN-FLOAT .TMP .TMP>
 337                <GENINS .ATYP .MD .RAC .TMP>)
 338               (ELSE <GETEL .TMP .SAC .STYP> <GENINS .ATYP .MD .RAC .TMP>)>
 339         <FREE-TEMP .TMP>>
 340
 341 <DEFINE GENINS (ATYP MD RAC ADD "AUX" INS (TG <MAKE-TAG>))
 342         #DECL ((MD ATYP) FIX)
 343         <COND (<G? .ATYP 4>
 344                <IEMIT <NTH '[`GRTR? `LESS?] <- .ATYP 4>> .RAC .ADD + .TG>
 345                <IEMIT `SET .RAC .ADD>
 346                <LABEL-TAG .TG>)
 347               (ELSE
 348                <SET INS <NTH <NTH ,INS1 .MD> .ATYP>>
 349                <IEMIT .INS
 350                       .RAC
 351                       .ADD
 352                       =
 353                       .RAC
 354                       (`TYPE <COND (<==? .MD 1> FIX) (ELSE FLOAT)>)>)>>
 355
 356 <DEFINE GETEL (RAC SAC STYP)
 357         <COND (<==? .RAC DONT-CARE> <SET RAC <GEN-TEMP>>)>
 358         <COND (<==? .STYP LIST> <NTH-LIST .SAC .RAC 1>)
 359               (<==? .STYP VECTOR> <NTH-VECTOR .SAC .RAC 1>)
 360               (ELSE <NTH-UVECTOR .SAC .RAC 1>)>
 361         .RAC>
 362
 363 <SETG INS1 [[`ADD `SUB `MUL `DIV] [`ADDF `SUBF `MULF `DIVF]]>
 364
 365 <GDECL (INS1) !<VECTOR [2 !<VECTOR [4 ANY]>]>>
 366
 367 " Do the actual arithmetic code generation here with all args set up."
 368
 369 <DEFINE ARITH-INS (ATYP REG REG2 MODE LAST W "AUX" INS)
 370         #DECL ((ATYP MODE REFS) FIX)
 371         <SET INS <NTH <NTH ,INS1 .MODE> .ATYP>>
 372         <IEMIT .INS
 373                .REG
 374                .REG2
 375                =
 376                <SET REG
 377                     <COND (<AND .LAST <N==? .REG .W>>
 378                            <FREE-TEMP .REG <>>
 379                            <COND (<==? .W DONT-CARE>
 380                                   <GEN-TEMP <COND (<==? .MODE 1> FIX)
 381                                                   (ELSE FLOAT)>>)
 382                                  (<TYPE? .W TEMP>
 383                                   <USE-TEMP .W <COND (<==? .MODE 1> FIX)
 384                                                      (ELSE FLOAT)>> .W)
 385                                  (ELSE .W)>)
 386                           (<AND .LAST <==? .REG .W>> .REG)
 387                           (<AND <TYPE? .REG TEMP> <L=? <TEMP-REFS .REG> 1>>
 388                            .REG)
 389                           (<AND <TYPE? .W TEMP> <L? <TEMP-REFS .W> 1>>
 390                            <USE-TEMP .W <COND (<==? .MODE 1> FIX)
 391                                               (ELSE FLOAT)>>
 392                            .W)
 393                           (ELSE
 394                            <FREE-TEMP .REG>
 395                            <GEN-TEMP <COND (<==? .MODE 1> FIX)
 396                                            (ELSE FLOAT)>>)>>
 397                <COND (<==? .MODE 2> '(`TYPE FLOAT))(ELSE '(`TYPE FIX))>>
 398         .REG>
 399
 400 <DEFINE MIN-MAX (NOD WHERE
 401                  "AUX" (MAX? <==? MAX <NODE-NAME .NOD>>) (K <KIDS .NOD>) REG
 402                        (MODE 1) REG1 SEGF (C <OR <AND .MAX? 5> 6>) TEM
 403                        (ONO .NO-KILL) (NO-KILL .ONO))
 404    #DECL ((NOD) NODE (MODE C) FIX (MAX?) ANY  (K) <LIST [REST NODE]>
 405           (NO-KILL) <SPECIAL LIST>)
 406    <SET NO-KILL <COMMUTE .K <NODE-NAME .NOD> .NO-KILL>>
 407    <SET REG <GEN-TEMP <>>>
 408    <COND (<==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
 409           <SET REG1
 410                <GEN <SET TEM <1 <KIDS .TEM>>> <GEN-TEMP <>>>>
 411           <SET MODE
 412                <SEGINS .C
 413                        T
 414                        .TEM
 415                        .REG
 416                        .REG1
 417                        1
 418                        <CHTYPE <OR <AND .MAX? <MAX>> <MIN>>
 419                                <RESULT-TYPE .NOD>>>>
 420           <FREE-TEMP .REG1>)
 421          (ELSE
 422           <SET REG <GEN .TEM .REG>>
 423           <AND <==? <RESULT-TYPE .TEM> FLOAT> <SET MODE 2>>)>
 424    <MAPF <>
 425     <FUNCTION (N
 426                "AUX" (NXT
 427                       <COND
 428                        (<==? <NODE-TYPE .N> ,SEG-CODE>
 429                         <SET SEGF T>
 430                         <GEN <SET N <1 <KIDS .N>>> <GEN-TEMP <>>>)
 431                        (ELSE <SET SEGF <>> <GEN .N DONT-CARE>)>) TG)
 432        #DECL ((N) NODE (MODE) FIX)
 433        <COND (.SEGF
 434               <SET MODE <SEGINS .C <> .N .REG .NXT .MODE 0>>)
 435              (ELSE
 436               <COND (<==? .MODE 2>
 437                      <COND (<==? <ISTYPE? <RESULT-TYPE .N>> FIX>
 438                             <SET NXT <GEN-FLOAT .NXT <PROT .NXT FLOAT>>>)>)
 439                     (<==? <ISTYPE? <RESULT-TYPE .N>> FLOAT>
 440                      <SET REG <GEN-FLOAT .REG <PROT .REG FLOAT>>>
 441                      <SET MODE 2>)>
 442               <IEMIT <COND (.MAX? `LESS?) (ELSE `GRTR?)> .REG .NXT -
 443                      <SET TG <MAKE-TAG>>>
 444               <SET-TEMP .REG .NXT (`TYPE <COND (<==? .MODE 2> FLOAT)
 445                                                (ELSE FIX)>)>
 446               <FREE-TEMP .NXT>
 447               <LABEL-TAG .TG>)>>
 448     <REST .K>>
 449    <DELAY-KILL .NO-KILL .ONO>
 450    <MOVE-ARG .REG .WHERE>>
 451
 452 <DEFINE ABS-GEN ACT (N W
 453                      "AUX" (K1 <1 <KIDS .N>>) NUM (TRIN <>)
 454                            (ABSFLG <==? <NODE-NAME .N> ABS>) (DONE <>) W1
 455                            TG (RT <RESULT-TYPE .N>))
 456    #DECL ((N K1) NODE (TRANSFORM) TRANS)
 457    <PROG ((TRANSFORM <MAKE-TRANS .N 2 0 0 0 1 0 0>))
 458          #DECL ((TRANSFORM) <SPECIAL TRANS>)
 459          <SET NUM <GEN .K1 <COND (<==? .W ,POP-STACK> DONT-CARE) (ELSE .W)>>>
 460          <COND (<NOT <0? <1 <3 .TRANSFORM>>>>
 461                 <RETURN <MOVE-ARG .NUM .W> .ACT>)>>
 462    <COND (<AND <ASSIGNED? TRANSFORM>
 463                <==? <1 .TRANSFORM> <PARENT .N>>
 464                <NOT .ABSFLG>>
 465           <SET TRIN <2 .TRANSFORM>>)>
 466    <COND (<AND .TRIN <NOT <0? <1 .TRIN>>>>
 467           <PUT <3 .TRANSFORM> 1 1>
 468           <MOVE-ARG .NUM .W>)
 469          (ELSE
 470           <COND (.ABSFLG
 471                  <COND (<TYPE? .W TEMP> <USE-TEMP <SET W1 .W> .RT>)
 472                        (<AND <TYPE? .NUM TEMP> <L=? <TEMP-REFS .NUM> 1>>
 473                         <SET W1 .NUM>)
 474                        (ELSE <SET W1 <GEN-TEMP .RT>>)>
 475                  <COND (<N==? .NUM .W1>
 476                         <DEALLOCATE-TEMP <SET NUM <MOVE-ARG .NUM .W1>>>)>
 477                  <DO-LESS? .NUM <SET TG <MAKE-TAG>> .RT>
 478                  <DO-SUB .NUM .W1 .RT>
 479                  <LABEL-TAG .TG>
 480                  <SET W <MOVE-ARG .W1 .W>>)
 481                 (ELSE
 482                  <COND (<AND <==? .W DONT-CARE>
 483                              <TYPE? .NUM TEMP>
 484                              <L=? <TEMP-REFS .NUM> 1>>
 485                         <SET W .NUM>)
 486                        (<==? .W DONT-CARE> <SET W <GEN-TEMP .RT>>)>
 487                  <DO-SUB .NUM .W .RT>
 488                  <COND (<N==? .W .NUM> <FREE-TEMP .NUM>)>)>
 489           .W)>>
 490
 491 <DEFINE DO-SUB (NUM W TY "AUX" TG1 TG2)
 492         #DECL ((TG1 TG2) ATOM)
 493         <COND (<==? <ISTYPE? .TY> FIX> <IEMIT `SUB 0 .NUM = .W '(`TYPE FIX)>)
 494               (<==? <ISTYPE? .TY> FLOAT>
 495                <IEMIT `SUBF 0 .NUM = .W '(`TYPE FLOAT)>)
 496               (ELSE
 497                <SET TG1 <MAKE-TAG>>
 498                <SET TG2 <MAKE-TAG>>
 499                <GEN-TYPE? .NUM FIX .TG1 <>>
 500                <IEMIT `SUB 0 .NUM = .W '(`TYPE FIX)>
 501                <BRANCH-TAG .TG2>
 502                <LABEL-TAG .TG1>
 503                <COND (<TYPE-OK? .TY '<NOT <OR FIX FLOAT>>>
 504                       <GEN-TYPE? .NUM FLOAT `COMPERR <>>)>
 505                <IEMIT `SUBF 0.0000000 .NUM = .W '(`TYPE FLOAT)>
 506                <LABEL-TAG .TG2>)>>
 507
 508
 509 <DEFINE DO-LESS? (NUM TG TY "AUX" TG1 TG2)
 510         #DECL ((TG1 TG2) ATOM)
 511         <COND (<==? <ISTYPE? .TY> FIX>
 512                <IEMIT `LESS? .NUM 0 - .TG '(`TYPE FIX)>)
 513               (<==? <ISTYPE? .TY> FLOAT>
 514                <IEMIT `LESS? .NUM 0.0 - .TG '(`TYPE FLOAT)>)
 515               (ELSE
 516                <SET TG1 <MAKE-TAG>>
 517                <SET TG2 <MAKE-TAG>>
 518                <GEN-TYPE? .NUM FIX .TG1 <>>
 519                <IEMIT `LESS? .NUM 0 - .TG '(`TYPE FIX)>
 520                <BRANCH-TAG .TG2>
 521                <LABEL-TAG .TG1>
 522                <COND (<AND .CAREFUL <TYPE-OK? .TY '<NOT <OR FIX FLOAT>>>>
 523                       <GEN-TYPE? .NUM FLOAT `COMPERR <>>)>
 524                <IEMIT `LESS? .NUM 0.0 - .TG '(`TYPE FLOAT)>
 525                <LABEL-TAG .TG2>)>>
 526
 527 <DEFINE MOD-GEN (N W
 528                  "AUX" (N1 <1 <KIDS .N>>) (N2 <2 <KIDS .N>>)
 529                        W1 W2)
 530    #DECL ((N) NODE)
 531    <COND
 532     (<AND <==? <NODE-TYPE .N2> ,QUOTE-CODE>
 533           <POPWR2 <NODE-NAME .N2>>>
 534      <FREE-TEMP <SET W1 <GEN .N1 DONT-CARE>>>
 535      <IEMIT `AND .W1 <- <CHTYPE <NODE-NAME .N2> FIX> 1> =
 536                        <COND (<TYPE? .W TEMP>
 537                               <USE-TEMP .W FIX>
 538                               .W)
 539                              (<==? .W DONT-CARE>
 540                               <SET W <GEN-TEMP FIX>>)
 541                              (ELSE .W)>>)
 542     (ELSE
 543      <COND (<AND <MEMQ <NODE-TYPE .N1> ,SNODES>
 544                  <NOT <MEMQ <NODE-TYPE .N2> ,SNODES>>
 545                  <NOT <SIDE-EFFECTS .N2>>>
 546             <SET W2 <GEN .N2 DONT-CARE>>
 547             <SET W2 <INTERF-CHANGE .W2 .N1>>
 548             <SET W1 <GEN .N1 DONT-CARE>>)
 549            (ELSE
 550             <SET W1 <GEN .N1 DONT-CARE>>
 551             <SET W1 <INTERF-CHANGE .W1 .N2>>
 552             <SET W2 <GEN .N2 DONT-CARE>>)>
 553      <FREE-TEMP .W1 <>>
 554      <FREE-TEMP .W2 <>>
 555      <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FIX>>)
 556            (<TYPE? .W TEMP> <USE-TEMP .W FIX>)>
 557      <IEMIT `MOD .W1 .W2 = .W '(`TYPE FIX)>)>
 558    .W>
 559
 560 <DEFINE ROT-GEN (N W) <ROT-LSH-GEN .N .W `ROT>>
 561
 562 <DEFINE LSH-GEN (N W) <ROT-LSH-GEN .N .W `LSH>>
 563
 564 <DEFINE ROT-LSH-GEN (N W INS
 565                      "AUX" (K <KIDS .N>) (A1 <1 .K>) (A2 <2 .K>) W1 W2)
 566         #DECL ((N A1 A2) NODE (K) <LIST [2 NODE]>)
 567         <COND (<==? <NODE-TYPE .A2> ,QUOTE-CODE>
 568                                  ;" LSH-ROT by fixed amount"
 569                <SET W1 <GEN .A1 DONT-CARE>>
 570                <FREE-TEMP .W1 <>>
 571                <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FIX>>)
 572                      (<TYPE? .W TEMP> <USE-TEMP .W FIX>)>
 573                <IEMIT .INS .W1 <NODE-NAME .A2> = .W '(`TYPE FIX)>)
 574               (ELSE
 575                <COND (<AND <MEMQ <NODE-TYPE .A1> ,SNODES>
 576                            <NOT <MEMQ <NODE-TYPE .A2> ,SNODES>>
 577                            <NOT <SIDE-EFFECTS .A2>>>
 578                       <SET W2 <GEN .A2 DONT-CARE>>
 579                       <SET W2 <INTERF-CHANGE .W2 .A1>>
 580                       <SET W1 <GEN .A1 DONT-CARE>>)
 581                      (ELSE
 582                       <SET W1 <GEN .A1 DONT-CARE>>
 583                       <SET W1 <INTERF-CHANGE .W1 .A2>>
 584                       <SET W2 <GEN .A2 DONT-CARE>>)>
 585                <FREE-TEMP .W1 <>>
 586                <FREE-TEMP .W2 <>>
 587                <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FIX>>)
 588                      (<TYPE? .W TEMP> <USE-TEMP .W FIX>)>
 589                <IEMIT .INS .W1 .W2 = .W '(`TYPE FIX)>)>
 590         .W>
 591
 592 <DEFINE FLOAT-GEN (N W
 593                    "AUX" (NUM <1 <KIDS .N>>) TEM1 (RT <RESULT-TYPE .NUM>) TG
 594                          TEM)
 595         #DECL ((N NUM) NODE (TG) ATOM)
 596         <COND (<==? .RT FLOAT>
 597                <COMPILE-WARNING "Unnecessary FLOAT: " .N>
 598                <GEN .NUM .W>)
 599               (<==? <ISTYPE? .RT> FIX>
 600                <SET TEM <GEN .NUM>>
 601                <FREE-TEMP .TEM <>>
 602                <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FLOAT>>)
 603                      (<TYPE? .W TEMP> <USE-TEMP .W FLOAT>)>
 604                <GEN-FLOAT .TEM .W>
 605                .W)
 606               (ELSE
 607                <COND (<OR <NOT <TYPE? .W TEMP>>
 608                           <NOT <TEMP-NO-RECYCLE .W>>
 609                           <N==? <TEMP-NO-RECYCLE .W> ANY>>
 610                         <SET TEM <GEN-TEMP <>>>)
 611                      (ELSE <SET TEM .W>)>
 612                <SET TEM <GEN .NUM .TEM>>
 613                <SET TG <MAKE-TAG>>
 614                <GEN-TYPE? .TEM FLOAT .TG T>
 615                <GEN-FLOAT .TEM .TEM>
 616                <LABEL-TAG .TG>
 617                <COND (<N==? .TEM .W> <MOVE-ARG .TEM .W>)
 618                      (ELSE .W)>)>>
 619
 620 <DEFINE FIX-GEN (N W
 621                  "AUX" (NUM <1 <KIDS .N>>) (RT <RESULT-TYPE .NUM>) TEM TEM1
 622                        BR)
 623         #DECL ((N NUM) NODE (BR) ATOM)
 624         <COND (<==? <ISTYPE? .RT> FIX>
 625                <COMPILE-WARNING "Unnecessary  FIX: " .N>
 626                <GEN .NUM .W>)
 627               (<==? .RT FLOAT>
 628                <SET TEM <GEN .NUM>>
 629                <FREE-TEMP .TEM <>>
 630                <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FIX>>)
 631                      (<TYPE? .W TEMP> <USE-TEMP .W FIX>)>
 632                <GEN-FIX .TEM .W>
 633                .W)
 634               (ELSE
 635                <COND (<OR <NOT <TYPE? .W TEMP>>
 636                           <NOT <TEMP-NO-RECYCLE .W>>
 637                           <N==? <TEMP-NO-RECYCLE .W> ANY>>
 638                         <SET TEM <GEN-TEMP <>>>)
 639                      (ELSE <SET TEM .W>)>
 640                <SET TEM <GEN .NUM .TEM>>
 641                <GEN-TYPE? .TEM FIX <SET BR <MAKE-TAG>> T>
 642                <GEN-FIX .TEM .TEM>
 643                <LABEL-TAG .BR>
 644                <COND (<N==? .TEM .W> <MOVE-ARG .TEM .W>)
 645                      (ELSE .W)>)>>
 646
 647 <DEFINE GEN-FLOAT (DAT W)
 648         <COND (<TYPE? .DAT FIX> <FLOAT .DAT>)
 649               (ELSE
 650                <IEMIT `FLOAT .DAT = .W '(`TYPE FLOAT)>
 651                .W)>>
 652
 653 <DEFINE GEN-FIX (DAT "OPTIONAL" (W <GEN-TEMP <>>))
 654         <COND (<TYPE? .DAT FLOAT> <FIX .DAT>)
 655               (ELSE
 656                <IEMIT `FIX .DAT = .W '(`TYPE FIX)>
 657                .W)>>
 658
 659 <DEFINE FLOP (SUBR)
 660         #DECL ((SUBR VALUE) ATOM)
 661         <1 <REST <MEMQ .SUBR
 662                        '[G? L? G? G=? L=? G=? ==? ==? N==? N==? 1? -1? 1? 0?
 663                          0?]>>>>
 664
 665 <DEFINE FLIP (SUBR "AUX" N)
 666         #DECL ((N) FIX (SUBR VALUE) ATOM)
 667         <NTH ,0SUBRS
 668              <- 13
 669                 <SET N <LENGTH <CHTYPE <MEMQ .SUBR ,0SUBRS> VECTOR>>>
 670                 <COND (<0? <MOD .N 2>> -1) (ELSE 1)>>>>
 671
 672
 673
 674 <DEFINE PRED? (N) #DECL ((N) FIX) <N==? <NTH ,PREDV .N> 0>>
 675
 676 <DEFINE LN-LST (N)
 677         #DECL ((N) NODE)
 678         <AND <==? <NODE-TYPE .N> ,LNTH-CODE>
 679              <==? <STRUCTYP <RESULT-TYPE <1 <KIDS .N>>>> LIST>>>
 680
 681 <DEFINE 0-TEST (NOD WHERE
 682                 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
 683                 "AUX" (REG ,NO-DATUM) (NN <1 <KIDS .NOD>>)
 684                       (TRANSFORM
 685                        <MAKE-TRANS .NOD 1 1 0 1 1 1 <SW? <NODE-NAME .NOD>>>))
 686         #DECL ((TRANSFORM) <SPECIAL TRANS> (NOD NN) NODE)
 687         <COND (<NOT <LN-LST .NN>>
 688                <SET REG <GEN .NN DONT-CARE>>)>
 689         <TEST-DISP .NOD
 690                    .WHERE
 691                    .NOTF
 692                    .BRANCH
 693                    .DIR
 694                    .REG
 695                    <DO-A-TRANS 0 .TRANSFORM>
 696                    <NOT <0? <1 <3 .TRANSFORM>>>>
 697                    .SETF>>
 698
 699 <DEFINE SW? (SBR)
 700         #DECL ((SBR) ATOM)
 701         <COND (<MEMQ .SBR '[0? N0? 1? -1? N1? N-1? ==? N==?]> 0)
 702               (ELSE 1)>>
 703
 704 <DEFINE MAKE-TRANS (N NEG +- +-V */ */V HW SW)
 705         #DECL ((N) NODE (NEG +- +-V */ */V HW SW) FIX)
 706         <CHTYPE [.N <UVECTOR .NEG .+- .+-V .*/ .*/V .HW .SW> <IUVECTOR 7 0>]
 707                 TRANS>>
 708
 709 <DEFINE DO-A-TRANS (N TR "AUX" (X <3 .TR>) (NN <NODE-NAME <1 .TR>>))
 710         #DECL ((TR) TRANS (N) FIX (X) <UVECTOR [7 FIX]>)
 711         <COND (<AND <NOT <0? .N>> <NOT <0? <6 .X>>> <NOT <0? <7 .X>>>>
 712                <COND (<==? .NN G?> <SET N <- .N 1>>)
 713                      (<==? .NN L=?> <SET N <- .N 1>>)>)>
 714         <COND (<NOT <0? <1 .X>>> <SET N <- .N>>)>
 715         <COND (<NOT <0? <2 .X>>> <SET N <+ .N <3 .X>>>)>
 716         <COND (<G? <4 .X> 2> <SET N </ .N <5 .X>>>)
 717               (<NOT <0? <4 .X>>> <SET N <* .N <5 .X>>>)>
 718         <COND (<NOT <0? <6 .X>>>
 719                <SET N <CHTYPE <ANDB .N 262143> FIX>>
 720                <COND (<NOT <0? <7 .X>>>
 721                       <SET N <CHTYPE <PUTBITS 0 <BITS 18 18> .N> FIX>>)>)>
 722         .N>
 723
 724 <DEFINE UPDATE-TRANS (NOD TR "AUX" (X <3 .TR>) FLG)
 725         #DECL ((TR) TRANS)
 726         <MAKE-TRANS .NOD
 727                     <COND (<NOT <0? <1 .X>>> 2) (ELSE 0)>
 728                     <COND (<SET FLG <NOT <0? <2 .X>>>> 2) (ELSE 0)>
 729                     <COND (.FLG <3 .X>) (ELSE 0)>
 730                     <COND (<SET FLG <G? <4 .X> 2>> 4)
 731                           (<SET FLG <NOT <0? <4 .X>>>> 2)
 732                           (ELSE 0)>
 733                     <COND (.FLG <5 .X>) (ELSE 1)>
 734                     <COND (<NOT <0? <6 .X>>> 2) (ELSE 0)>
 735                     <COND (<NOT <0? <7 .X>>> 2) (ELSE 0)>>>
 736
 737 <DEFINE TEST-DISP (N W NF BR DI REG NUM NEG SF)
 738         #DECL ((NUM) <OR FIX FLOAT> (N) NODE)
 739         <COND (<==? .REG ,NO-DATUM> <LIST-LNT-SPEC .N .W .NF .BR .DI .NUM .SF>)
 740               (<0? .NUM> <0-TEST1 .N .W .NF .BR .DI .REG .NEG .SF>)
 741               (<AND <OR <==? .NUM 1> <==? .NUM 1.0> <==? .NUM -1>>
 742                     <OR <==? <NODE-NAME .N> 1?>
 743                         <==? <ISTYPE? <RESULT-TYPE <1 <KIDS .N>>>> FIX>>>
 744                <COND (<==? .NUM -1> <SET NEG T>)>
 745                <1?-TEST .N .W .NF .BR .DI .REG .NEG .SF>)
 746               (ELSE <TEST-GEN2 .N .W .NF .BR .DI .REG .NUM .NEG .SF>)>>
 747
 748 <DEFINE 0-TEST1 (NOD WHERE NOTF BRANCH DIR REG NEG SF
 749                  "AUX" (SBR <NODE-NAME .NOD>) B2 (RW .WHERE)
 750                        (ARG <1 <KIDS .NOD>>) (SDIR .DIR)
 751                        (ATYP <ISTYPE? <RESULT-TYPE .ARG>>) (LDAT <>) S TT)
 752         #DECL ((NOD ARG) NODE (S) SYMTAB)
 753         <SET WHERE <COND (<==? .WHERE DONT-CARE> <GEN-TEMP <>>) (ELSE .WHERE)>>
 754         <COND (.NEG
 755                <COND (<==? <NODE-TYPE .NOD> ,0-TST-CODE> <SET SBR <FLOP .SBR>>)
 756                      (ELSE
 757                       <COND (<SET TT <MEMQ .SBR '[G? G=? G? L? L=? L?]>>
 758                              <SET SBR <2 .TT>>)>)>)>
 759         <COND (.BRANCH
 760                <AND .NOTF <SET DIR <NOT .DIR>>>
 761                <AND .DIR <SET SBR <FLIP .SBR>>>
 762                <COND (.SF
 763                       <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
 764                <COND (<==? .RW FLUSHED>
 765                       <ZER-JMP .SBR .REG .BRANCH .ATYP>
 766                       ,NO-DATUM)
 767                      (ELSE
 768                       <SET B2 <MAKE-TAG>>
 769                       <SET SBR <FLIP .SBR>>
 770                       <ZER-JMP .SBR .REG .B2 .ATYP>
 771                       <SET RW
 772                            <MOVE-ARG <REFERENCE .SDIR>
 773                                      <COND (<==? .RW DONT-CARE> <GEN-TEMP <>>)
 774                                            (ELSE .RW)>>>
 775                       <BRANCH-TAG .BRANCH>
 776                       <LABEL-TAG .B2>
 777                       .RW)>)
 778               (ELSE
 779                <AND .NOTF <SET SBR <FLIP .SBR>>>
 780                <ZER-JMP .SBR .REG <SET BRANCH <MAKE-TAG>> .ATYP>
 781                <MOVE-ARG <REFERENCE T> .WHERE>
 782                <BRANCH-TAG <SET B2 <MAKE-TAG>>>
 783                <LABEL-TAG .BRANCH>
 784                <MOVE-ARG <REFERENCE <>> .WHERE>
 785                <LABEL-TAG .B2>
 786                <MOVE-ARG .WHERE .RW>)>>
 787
 788 <DEFINE ZER-JMP (SBR REG BR ATYP "AUX" (TEM <LENGTH <CHTYPE <MEMQ .SBR ,0SUBRS>
 789                                                             VECTOR>>)
 790                                        (B1 <MAKE-TAG>) (B2 <MAKE-TAG>))
 791         <COND (.ATYP
 792                <IEMIT <NTH ,0SKPS .TEM> .REG
 793                       <COND (<==? .ATYP FIX> 0)
 794                             (ELSE 0.0)> <NTH ,0JSENS .TEM> .BR
 795                       (`TYPE .ATYP)>
 796                <FREE-TEMP .REG>)
 797               (<==? <NTH ,0SKPS .TEM> `VEQUAL?>
 798                <IEMIT `VEQUAL? .REG 0 <NTH ,0JSENS .TEM> .BR '(`TYPE FIX)>
 799                <FREE-TEMP .REG>)
 800               (ELSE
 801                <IEMIT <NTH ,0SKPS .TEM> .REG 0 <NTH ,0JSENS .TEM> .BR>
 802                <FREE-TEMP .REG>)>>
 803
 804 <SETG 0SKPS [`VEQUAL? `VEQUAL? `LESS? `LESS? `GRTR? `GRTR? `VEQUAL? `VEQUAL?]>
 805
 806 <SETG 0JSENS [+ - + - + - + -]>
 807
 808 <SETG 0SUBRS [1? N1? -1? N-1? 0? N0? G? L=? L? G=? ==? N==?]>
 809
 810 <DEFINE 1?-GEN (NOD WHERE
 811                 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
 812                 "AUX" (REG ,NO-DATUM) (NN <1 <KIDS .NOD>>)
 813                       (TRANSFORM
 814                        <MAKE-TRANS .NOD 1 2 -1 1 1 1 <SW? <NODE-NAME .NOD>>>))
 815         #DECL ((NOD NN) NODE (TRANSFORM) <SPECIAL TRANS>)
 816         <COND (<NOT <LN-LST .NN>>
 817                <SET REG <GEN .NN DONT-CARE>>)>
 818         <TEST-DISP .NOD
 819                    .WHERE
 820                    .NOTF
 821                    .BRANCH
 822                    .DIR
 823                    .REG
 824                    <DO-A-TRANS 1 .TRANSFORM>
 825                    <NOT <0? <1 <3 .TRANSFORM>>>>
 826                    .SETF>>
 827
 828 <DEFINE 1?-TEST (NOD WHERE NOTF BRANCH DIR REG NEG SF
 829                  "AUX" (SBR <NODE-NAME .NOD>) B2 (RW .WHERE)
 830                        (K <1 <KIDS .NOD>>) (SDIR .DIR) (NM <>)
 831                        (ATYP <ISTYPE? <RESULT-TYPE .K>>))
 832         #DECL ((NOD K) NODE)
 833         <SET WHERE <COND (<==? .WHERE DONT-CARE> <GEN-TEMP <>>) (ELSE .WHERE)>>
 834         <COND (.BRANCH
 835                <AND .NOTF <SET DIR <NOT .DIR>>>
 836                <COND (.SF
 837                       <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
 838                <COND (<==? .RW FLUSHED>
 839                       <GEN-COMP .ATYP .REG .DIR .BRANCH .SBR .NEG .NM>
 840                       ,NO-DATUM)
 841                      (ELSE
 842                       <SET B2 <MAKE-TAG>>
 843                       <GEN-COMP .ATYP .REG <NOT .DIR> .B2 .SBR .NEG .NM>
 844                       <SET RW
 845                            <MOVE-ARG <MOVE-ARG <REFERENCE .SDIR> .WHERE> .RW>>
 846                       <BRANCH-TAG .BRANCH>
 847                       <LABEL-TAG .B2>
 848                       .RW)>)
 849               (ELSE
 850                <SET WHERE
 851                     <COND (<==? .WHERE DONT-CARE> <GEN-TEMP <>>)
 852                           (ELSE .WHERE)>>
 853                <GEN-COMP .ATYP
 854                          .REG
 855                          .NOTF
 856                          <SET BRANCH <MAKE-TAG>>
 857                          .SBR
 858                          .NEG
 859                          .NM>
 860                <MOVE-ARG <REFERENCE T> .WHERE>
 861                <BRANCH-TAG <SET B2 <MAKE-TAG>>>
 862                <LABEL-TAG .BRANCH>
 863                <MOVE-ARG <REFERENCE <>> .WHERE>
 864                <LABEL-TAG .B2>
 865                <MOVE-ARG .WHERE .RW>)>>
 866
 867 <DEFINE GEN-COMP (TYP REG DIR BR SBR NEG NM
 868                   "AUX" TEM (LBL <MAKE-TAG>) (LBL2 <MAKE-TAG>))
 869         #DECL ((BR) ATOM)
 870         <COND (<OR <==? .TYP FIX> <==? .TYP FLOAT>>
 871                <COND (.DIR <SET SBR <FLIP .SBR>>)>
 872                <IEMIT <1 <SET TEM <NTH ,SKIPS <LENGTH <CHTYPE <MEMQ .SBR ,CMSUBRS>
 873                                                               VECTOR>>>>>
 874                       .REG
 875                       <COND (<==? .TYP FIX> <COND (.NEG -1) (ELSE 1)>)
 876                             (ELSE <COND (.NEG -1.0) (ELSE 1.0)>)>
 877                       <2 .TEM>
 878                       .BR
 879                       (`TYPE .TYP)>
 880                <FREE-TEMP .REG>)
 881               (ELSE
 882                <GEN-TYPE? .REG FLOAT .LBL <>>
 883                <IEMIT `VEQUAL?
 884                       .REG
 885                       <COND (.NEG -1.0) (ELSE 1.0)>
 886                       +
 887                       <COND (.DIR .BR) (ELSE .LBL2)>
 888                       '(`TYPE FLOAT)>
 889                <COND (<NOT .DIR> <BRANCH-TAG .BR>)
 890                      (ELSE <BRANCH-TAG .LBL2>)>
 891                <LABEL-TAG .LBL>
 892                <GEN-TYPE? .REG FIX `COMPERR <>>
 893                <IEMIT `VEQUAL?
 894                       .REG
 895                       <COND (.NEG -1) (ELSE 1)>
 896                       <COND (.DIR +) (ELSE -)>
 897                       .BR
 898                       '(`TYPE FIX)>
 899                <LABEL-TAG .LBL2>
 900                <FREE-TEMP .REG>)>>
 901
 902 <DEFINE TEST-GEN (NOD WHERE
 903                   "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
 904                   "AUX" (K <1 <KIDS .NOD>>) (K2 <2 <KIDS .NOD>>) REGT REGT2
 905                         (S <SW? <NODE-NAME .NOD>>) TRANSFORM ATYP ATYP2 B2
 906                         (SDIR .DIR) (RW .WHERE) TRANS1 (FLS <==? .RW FLUSHED>)
 907                         TEM (ONO .NO-KILL) (NO-KILL .ONO)
 908                   "ACT" TA)
 909    #DECL ((NOD K K2) NODE (TRANSFORM) <SPECIAL TRANS> (TRANS1) TRANS
 910           (NO-KILL) <SPECIAL LIST>)
 911    <SET WHERE
 912         <COND (<==? .WHERE FLUSHED> FLUSHED)
 913               (<==? .WHERE DONT-CARE> <GEN-TEMP <>>)
 914               (ELSE .WHERE)>>
 915    <COND (<OR <==? <NODE-TYPE .K2> ,QUOTE-CODE>
 916               <AND <NOT <MEMQ <NODE-TYPE .K> ,SNODES>>
 917                    <NOT <SIDE-EFFECTS .NOD>>
 918                    <MEMQ <NODE-TYPE .K2> ,SNODES>>>
 919           <COND (<AND <==? <NODE-TYPE .K> ,LVAL-CODE>
 920                       <COND (<==? <LENGTH <SET TEM <TYPE-INFO .K>>> 2>
 921                              <2 .TEM>)
 922                             (ELSE T)>
 923                       <SET TEM <NODE-NAME .K>>
 924                       <NOT <MAPF <>
 925                                  <FUNCTION (LL)
 926                                          <AND <==? <1 .LL> .TEM> <MAPLEAVE>>>
 927                                  .NO-KILL>>>
 928                  <SET NO-KILL ((<NODE-NAME .K> <>) !.NO-KILL)>)>
 929           <SET K .K2>
 930           <SET K2 <1 <KIDS .NOD>>>
 931           <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>)>
 932    <SET ATYP <ISTYPE? <RESULT-TYPE .K2>>>
 933    <SET ATYP2 <ISTYPE-GOOD? <RESULT-TYPE .K>>>
 934    <COND
 935     (<N==? <NODE-TYPE .K> ,QUOTE-CODE>
 936      <SET REGT2
 937           <GEN .K
 938                <COND (<AND <N==? .ATYP .ATYP2> <==? .ATYP2 FIX>> <GEN-TEMP <>>)
 939                      (ELSE DONT-CARE)>>>
 940      <COND (<ASSIGNED? TRANSFORM>
 941             <SET TRANS1 .TRANSFORM>
 942             <SET TRANSFORM <UPDATE-TRANS .NOD .TRANS1>>)>
 943      <SET REGT2 <INTERF-CHANGE .REGT2 .K2>>
 944      <SET REGT
 945           <GEN .K2
 946                <COND (<AND <N==? .ATYP .ATYP2> <==? .ATYP FIX>> <GEN-TEMP <>>)
 947                      (ELSE DONT-CARE)>>>)
 948     (ELSE
 949      <COND (<OR <==? .ATYP FIX> <==? <NODE-NAME .K> 0>>
 950             <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>)>
 951      <COND (<==? .ATYP FIX>
 952             <PUT <PUT <2 .TRANSFORM> 2 1> 3 <FIX <NODE-NAME .K>>>)>
 953      <COND (<LN-LST .K2> <SET REGT ,NO-DATUM>) (ELSE <SET REGT <GEN .K2>>)>
 954      <RETURN <TEST-DISP .NOD
 955                         .WHERE
 956                         .NOTF
 957                         .BRANCH
 958                         .DIR
 959                         .REGT
 960                         <COND (<ASSIGNED? TRANSFORM>
 961                                <DO-A-TRANS <FIX <NODE-NAME .K>> .TRANSFORM>)
 962                               (ELSE <NODE-NAME .K>)>
 963                         <AND <ASSIGNED? TRANSFORM>
 964                              <NOT <0? <1 <3 .TRANSFORM>>>>>
 965                         .SETF>
 966              .TA>)>
 967    <DELAY-KILL .NO-KILL .ONO>
 968    <AND <ASSIGNED? TRANSFORM>
 969         '<CONFORM .REGT .REGT2 .TRANSFORM .TRANS1>
 970         '<PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>>
 971    <COND (.BRANCH
 972           <AND .NOTF <SET DIR <NOT .DIR>>>
 973           <COND (.SETF
 974                  <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
 975           <GEN-COMP2 <FLOP <NODE-NAME .NOD>>
 976                      .ATYP2
 977                      .ATYP
 978                      .REGT
 979                      .REGT2
 980                      <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
 981                      <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE-TAG>>)>>
 982           <COND (<NOT .FLS>
 983                  <SET RW <MOVE-ARG <MOVE-ARG <REFERENCE .SDIR> .WHERE> .RW>>
 984                  <BRANCH-TAG .BRANCH>
 985                  <LABEL-TAG .B2>
 986                  .RW)>)
 987          (ELSE
 988           <GEN-COMP2 <FLOP <NODE-NAME .NOD>>
 989                      .ATYP2
 990                      .ATYP
 991                      .REGT
 992                      .REGT2
 993                      .NOTF
 994                      <SET BRANCH <MAKE-TAG>>>
 995           <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE T> .WHERE>>
 996           <BRANCH-TAG <SET B2 <MAKE-TAG>>>
 997           <LABEL-TAG .BRANCH>
 998           <MOVE-ARG <REFERENCE <>> .WHERE>
 999           <LABEL-TAG .B2>
1000           <MOVE-ARG .WHERE .RW>)>>
1001
1002 <DEFINE TEST-GEN2 (NOD WHERE NOTF BRANCH DIR REG NUM NEG SF
1003                    "AUX" (SDIR .DIR) (RW .WHERE) (FLS <==? .RW FLUSHED>) B2
1004                          (SBR <NODE-NAME .NOD>))
1005         #DECL ((NOD) NODE (NUM) <OR FIX FLOAT>)
1006         <SET WHERE
1007              <COND (<==? .WHERE FLUSHED> FLUSHED)
1008                    (<==? .WHERE DONT-CARE> <GEN-TEMP <>>)
1009                    (ELSE .WHERE)>>
1010         <COND (.BRANCH
1011                <COND (.NEG <SET SBR <FLOP .SBR>>)>
1012                <AND .NOTF <SET DIR <NOT .DIR>>>
1013                <COND (.SF
1014                       <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
1015                <GEN-COMP2 .SBR
1016                           <TYPE .NUM>
1017                           <>
1018                           <REFERENCE .NUM>
1019                           .REG
1020                           <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
1021                           <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE-TAG>>)>>
1022                <COND (<NOT .FLS>
1023                       <SET RW
1024                            <MOVE-ARG <MOVE-ARG <REFERENCE .SDIR> .WHERE> .RW>>
1025                       <BRANCH-TAG .BRANCH>
1026                       <LABEL-TAG .B2>
1027                       .RW)>)
1028               (ELSE
1029                <AND .NOTF <SET DIR <NOT .DIR>>>
1030                <COND (.NEG <SET SBR <FLOP .SBR>>)>
1031                <GEN-COMP2 .SBR
1032                           <TYPE .NUM>
1033                           <>
1034                           <REFERENCE .NUM>
1035                           .REG
1036                           .NOTF
1037                           <SET BRANCH <MAKE-TAG>>>
1038                <MOVE-ARG <REFERENCE T> .WHERE>
1039                <BRANCH-TAG <SET B2 <MAKE-TAG>>>
1040                <LABEL-TAG .BRANCH>
1041                <MOVE-ARG <REFERENCE <>> .WHERE>
1042                <LABEL-TAG .B2>
1043                <MOVE-ARG .WHERE .RW>)>>
1044
1045 <DEFINE GEN-COMP2 (SB T1 T2 R1 R2 D BR "AUX" TEM)
1046         #DECL ((SB BR) ATOM)
1047         <AND .D <SET SB <FLIP .SB>>>
1048         <COND (<AND .T1 .T2 <N==? .T1 .T2> <TYPE? .R1 TEMP> <TYPE? .R2 TEMP>>
1049                <COND (<==? .T1 FIX>
1050                       <SET T1 FLOAT>
1051                       <SET R2 <GEN-FLOAT .R2 .R2>>)>
1052                <COND (<==? .T2 FIX>
1053                       <SET T2 FLOAT>
1054                       <SET R1 <GEN-FLOAT .R1 .R1>>)>)>
1055         <COND (<TYPE? .R1 TEMP> <FREE-TEMP .R1 <>>)>
1056         <COND (<TYPE? .R2 TEMP> <FREE-TEMP .R2 <>>)>
1057         <IEMIT <1 <SET TEM <NTH ,SKIPS <LENGTH <CHTYPE <MEMQ .SB ,CMSUBRS>
1058                                                        VECTOR>>>>>
1059                .R2
1060                .R1
1061                <2 .TEM>
1062                .BR
1063                (`TYPE <OR .T1 .T2>)>>
1064
1065 <DEFINE GET-DF (S)
1066         #DECL ((S) ATOM)
1067         <NTH ,DF-VALS
1068              <LENGTH <CHTYPE <MEMQ .S '[MAX MIN * / - +]> VECTOR>>>>
1069
1070 <DEFINE POPWR2 (X) #DECL ((X) FIX)
1071         <COND (<==? .X 0> <>)
1072               (<==? <CHTYPE <ANDB <- .X> .X> FIX> .X>
1073                <REPEAT ((Y 0)) #DECL ((Y) FIX)
1074                        <COND (<==? .X 1> <RETURN .Y>)>
1075                        <SET X <CHTYPE <LSH .X -1> FIX>>
1076                        <SET Y <+ .Y 1>>>)>>
1077
1078 <SETG DF-VALS [0 0 1 1 <MIN> <MAX>]>
1079
1080 <GDECL (SKIPS)
1081        <VECTOR [REST <LIST ATOM ATOM>]>
1082        (0SUBRS 0SKPS 0JSENS CMSUBRS)
1083        <VECTOR [REST ATOM]>
1084        (DF-VALS)
1085        VECTOR>
1086
1087 <SETG CMSUBRS '[0? N0? 1? N1? -1? N-1? ==? N==? G? G=? L? L=?]>
1088
1089 <SETG SKIPS
1090       '[(`LESS? +)
1091         (`GRTR? -)
1092         (`GRTR? +)
1093         (`LESS? -)
1094         (`VEQUAL? +)
1095         (`VEQUAL? -)
1096         (`EQUAL? +)
1097         (`VEQUAL? -)
1098         (`VEQUAL? +)
1099         (`VEQUAL? -)
1100         (`VEQUAL? +)
1101         (`VEQUAL? -)]>
1102
1103 <ENDPACKAGE>