<mdl.comp>/cargen.mud.31

   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">
   7
   8
   9 "       This file contains analyzers and code generators for arithmetic
  10  SUBRs and predicates.  For convenience many of the SUBRs that are
  11 similar are combined into one analyzer/generator.  For more info
  12 on analyzers see SYMANA and on generators see CODGEN.
  13 "
  14
  15 "A type TRANS specifies to an inferior node what arithmetic transforms are
  16 prohibited, permitted or desired.  A transform consists of 3 main elements:
  17 a NODE, an input, an output.  The input and output are UVECTORS of 7 fixes:
  18
  19 1)      negative ok     0-no, 1-ok, 2-pref
  20 2)      + or - const ok 0-no, 1-ok, 2-pref
  21 3)      const for + or -
  22 4)      * or / const ok 0-no, 1-* ok, 2-* pref, 3-/ ok, 4-/ pref
  23 5)      hw ok           0-no, 1-ok, 2-pref
  24 6)      hw swapped also 0-no, 1-ok, 2-pref
  25 "
  26
  27 <SETG SNODES ![,QUOTE-CODE ,LVAL-CODE ,GVAL-CODE!]>
  28
  29 <SETG SNODES1 <REST ,SNODES>>
  30
  31 <DEFINE COMMUTE (K OP L "AUX" TT FK KK TYP NN N CD CD1)
  32    #DECL ((K KK FK) <LIST [REST NODE]> (N NN) NODE (CD1 CD) FIX (L) LIST)
  33    <PROG ((REDO <>))
  34      <COND (<EMPTY? <SET KK <REST <SET FK .K>>>> <RETURN>)>
  35      <SET TYP <ISTYPE? <RESULT-TYPE <1 .KK>>>>
  36      <REPEAT ()
  37        <AND <EMPTY? .KK> <RETURN>>
  38        <COND
  39         (<==? .TYP
  40               <SET TYP <ISTYPE? <RESULT-TYPE <SET NN <1 .KK>>>>>>
  41          <SET CD1 <NODE-TYPE .NN>>
  42          <COND
  43           (<AND <==? <SET CD <NODE-TYPE <SET N <1 .FK>>>> ,QUOTE-CODE>
  44                 <==? .CD1 ,QUOTE-CODE>>
  45            <PUT .N
  46                 ,NODE-NAME
  47                 <APPLY ,.OP <NODE-NAME .N> <NODE-NAME .NN>>>
  48            <PUTREST .FK <SET KK <REST .KK>>>
  49            <SET REDO T>
  50            <AGAIN>)
  51           (<==? .CD ,QUOTE-CODE>
  52            <PUT .KK 1 .N>
  53            <PUT .FK 1 .NN>
  54            <SET REDO T>)
  55           (<AND <NOT <MEMQ .CD1 ,SNODES>>
  56                 <MEMQ .CD ,SNODES>
  57                 <NOT <SIDE-EFFECTS .NN>>>
  58            <COND (<AND <==? .CD ,LVAL-CODE>
  59                        <COND (<==? <LENGTH <SET TT <TYPE-INFO .N>>> 2> <2 .TT>)
  60                              (ELSE T)>
  61                        <SET TT <NODE-NAME .N>>
  62                        <NOT <MAPF <>
  63                                   <FUNCTION (LL)
  64                                           <AND <==? <1 .LL> .TT> <MAPLEAVE>>>
  65                                   .L>>>
  66                   <SET L ((<NODE-NAME .N> <>) !.L)>)>
  67            <PUT .KK 1 .N>
  68            <PUT .FK 1 .NN>
  69            <SET REDO T>)>)>
  70        <SET KK <REST <SET FK .KK>>>>
  71      <COND (.REDO <SET REDO <>> <AGAIN>)>
  72      .K>
  73    .L>
  74
  75 " Generate code for +,-,* and /.  Note sexy AOS and SOS generator. Also
  76 note bug causing result to be left in AC even if not wanted."
  77
  78 <DEFINE ARITH-GEN AG (NOD WHERE
  79                       "AUX" REG (K <KIDS .NOD>) REG1 T1
  80                             (ATYP
  81                              <LENGTH <MEMQ <NODE-NAME .NOD> '![/ * - +!]>>) TT
  82                             (MODE 1) (TEM <1 .K>) SEGF SHFT TRIN
  83                             (COM <OR <==? .ATYP 1> <==? .ATYP 3>>) INA
  84                             (DONE <>) (NEGF <>) (ONO .NO-KILL)
  85                             (NO-KILL .NO-KILL))
  86    #DECL ((NOD TEM TT) NODE (K) <LIST [REST NODE]> (ATYP MODE) FIX
  87           (REG1 REG) DATUM (WHERE COM) ANY (NO-KILL) <SPECIAL LIST>)
  88    <SET REG <GOODACS .NOD .WHERE>>
  89    <SET NO-KILL
  90         <COMMUTE <REST .K <NTH '![0 1 0 1!] .ATYP>>
  91                  <NTH '![+ + * *!] .ATYP>
  92                  .NO-KILL>>
  93    <COND
  94     (<AND <==? <RESULT-TYPE .NOD> FIX>  ;"All this hair to try for AOS or SOS."
  95           <OR <==? .ATYP 1> <==? .ATYP 2>>                      ;"+ or - only."
  96           <==? <LENGTH .K> 2>
  97           <==? <NODE-TYPE <SET TEM <1 .K>>> ,LVAL-CODE>
  98           <==? <NODE-TYPE <SET TT <2 .K>>> ,QUOTE-CODE>
  99           <==? <NODE-NAME .TT> 1>
 100           <NOT <EMPTY? <SET T1 <PARENT .NOD>>>>
 101           <==? <NODE-TYPE <SET TT .T1>> ,SET-CODE>
 102           <==? <NODE-NAME .TEM> <NODE-NAME .TT>>
 103           <STORED <NODE-NAME .TEM>>
 104           <OR <NOT <SET INA <INACS <NODE-NAME .TEM>>>>
 105               <NOT <PROG-AC <NODE-NAME .TEM>>>>>
 106      <COND (<SET INA <INACS <NODE-NAME .TEM>>>
 107             <AND <TYPE? <DATTYP .INA> AC> <MUNG-AC <DATTYP .INA> .INA>>
 108             <AND <TYPE? <DATVAL .INA> AC> <MUNG-AC <DATVAL .INA> .INA>>)>
 109      <PUT <NODE-NAME .TEM> ,INACS <>>
 110      <EMIT <INSTRUCTION <NTH '![`AOS  `SOS !] .ATYP>
 111                         !<COND (<TYPE? <DATVAL .REG> AC>
 112                                 <SGETREG <DATVAL .REG> .REG>
 113                                 (<ACSYM <DATVAL .REG>>))
 114                                (<==? <DATVAL .REG> ANY-AC>
 115                                 <PUT .REG ,DATVAL <GETREG .REG>>
 116                                 (<ACSYM <DATVAL .REG>>))
 117                                (ELSE
 118                                 <SET REG <DATUM <1 .WHERE> <2 .WHERE>>>
 119                                 ())>
 120                         !<ADDR:VALUE <LADDR <NODE-NAME .TEM>
 121                                             <>
 122                                             <1 <TYPE-INFO .TT>>>>>>
 123      <PUT <NODE-NAME .TEM> ,INACS .REG>
 124      <SET STORE-SET T>
 125      <RETURN <COND (<G? <LENGTH .WHERE> 2>
 126                     <MOVE:ARG .REG <CHTYPE <REST .WHERE 2> DATUM>>)
 127                    (ELSE .REG)>
 128              .AG>)
 129     (<AND <==? <RESULT-TYPE .NOD> FIX>
 130           <==? <LENGTH .K> 2>
 131           <==? <NODE-TYPE <2 .K>> ,QUOTE-CODE>>
 132      <COND
 133       (<AND <ASSIGNED? TRANSFORM>
 134             <==? <PARENT .NOD> <1 .TRANSFORM>>
 135             <SET TRIN <2 .TRANSFORM>>
 136             <COND
 137              (<AND <L=? .ATYP 2>
 138                    <OR <1? <2 .TRIN>>
 139                        <AND <==? <2 .TRIN> 2>
 140                             <==? <3 .TRIN>
 141                                  <COND (<1? .ATYP> <- <NODE-NAME <2 .K>>>)
 142                                        (ELSE <NODE-NAME <2 .K>>)>>>>>
 143               <PUT <PUT <3 .TRANSFORM> 2 1>
 144                    3
 145                    <COND (<1? .ATYP> <- <NODE-NAME <2 .K>>>)
 146                          (ELSE <NODE-NAME <2 .K>>)>>)
 147              (<AND <==? .ATYP 3>
 148                    <OR <1? <4 .TRIN>>
 149                        <AND <==? <4 .TRIN> 4>
 150                             <==? <5 .TRIN> <NODE-NAME <2 .K>>>>>>
 151               <PUT <PUT <3 .TRANSFORM> 4 4> 5 <NODE-NAME <2 .K>>>)
 152              (ELSE <>)>>
 153        <RETURN <GEN <1 .K> .WHERE> .AG>)
 154       (<N==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
 155        <PROG ((TRANSFORM
 156                <MAKE-TRANS .NOD
 157                            0
 158                            <COND (<L? .ATYP 3> 2) (ELSE 0)>
 159                            <COND (<1? .ATYP> <NODE-NAME <2 .K>>)
 160                                  (<==? .ATYP 2> <- <NODE-NAME <2 .K>>>)
 161                                  (ELSE 0)>
 162                            <COND (<G? .ATYP 2>
 163                                   <COND (<==? .ATYP 3> 2) (ELSE 4)>)
 164                                  (ELSE 0)>
 165                            <COND (<G? .ATYP 2> <NODE-NAME <2 .K>>) (ELSE 1)>
 166                            0
 167                            0>))
 168              #DECL ((TRANSFORM) <SPECIAL TRANS>)
 169              <SET REG
 170                   <GEN .TEM
 171                        <COND (<AND <TYPE? <DATVAL .REG> AC>
 172                                    <ACLINK <DATVAL .REG>>>
 173                               <DATUM <DATTYP .REG> ANY-AC>)
 174                              (ELSE .REG)>>>
 175              <SET DONE T>
 176              <MAPF <>
 177                    <FUNCTION (NN)
 178                            #DECL ((NN) FIX)
 179                            <COND (<NOT <0? .NN>>
 180                                   <RETURN <MOVE:ARG .REG .WHERE> .AG>)>>
 181                    <3 .TRANSFORM>>>)>)>
 182    <COND (.DONE)
 183          (<==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
 184           <SET REG1
 185                <GEN <SET TEM <1 <KIDS .TEM>>>
 186                     <DATUM <STRUCTYP <RESULT-TYPE .TEM>> ANY-AC>>>
 187           <SET MODE
 188                <SEGINS .ATYP T .TEM .REG .REG1 1 <GET-DF <NODE-NAME .NOD>>>>)
 189          (ELSE
 190           <SET REG
 191                <GEN .TEM
 192                     <COND (<AND <TYPE? <DATVAL .REG> AC>
 193                                 <ACLINK <DATVAL .REG>>>
 194                            <DATUM <DATTYP .REG> ANY-AC>)
 195                           (ELSE .REG)>>>
 196           <AND <==? <RESULT-TYPE .TEM> FLOAT> <SET MODE 2>>)>
 197    <AND <TYPE? <DATTYP .REG> ATOM>
 198        <PUT .REG ,DATTYP <NTH '![FIX FLOAT!] .MODE>>>
 199    <MAPR <>
 200     <FUNCTION (N
 201                "AUX" NN TEM TRANSFORM
 202                      (NXT
 203                       <COND
 204                        (<==? <NODE-TYPE <SET NN <1 .N>>> ,SEG-CODE>
 205                         <SET SEGF T>
 206                         <GEN <SET NN <1 <KIDS .NN>>>
 207                              <DATUM <STRUCTYP <RESULT-TYPE .NN>> ANY-AC>>)
 208                        (ELSE
 209                         <SET SEGF <>>
 210                         <SET TRANSFORM
 211                              <MAKE-TRANS .NOD
 212                                          <COND (<AND .NEGF <G? .ATYP 2>> 2)
 213                                                (ELSE 1)>
 214                                          0
 215                                          0
 216                                          0
 217                                          0
 218                                          0
 219                                          0>>
 220                         <GEN .NN DONT-CARE>)>) (COM .COM))
 221        #DECL ((N) <LIST NODE> (NXT REG) DATUM (MODE) FIX (NN) NODE
 222               (TRANSFORM) <SPECIAL TRANS>)
 223        <COND
 224         (.SEGF
 225          <SET MODE <SEGINS .ATYP <> .NN .REG .NXT .MODE 0>>
 226          <RET-TMP-AC .NXT>)
 227         (ELSE
 228          <AND <ASSIGNED? TRANSFORM>
 229               <NOT <0? <1 <3 .TRANSFORM>>>>
 230               <PROG ()
 231                     <SET COM <NOT .COM>>
 232                     <SET NEGF <NOT .NEGF>>>>
 233          <COND (<==? .MODE 2>
 234                 <COND (<==? <ISTYPE? <RESULT-TYPE .NN>> FIX>
 235                        <TOACV .NXT>
 236                        <DATTYP-FLUSH <SET NXT <GEN-FLOAT .NXT>>>
 237                        <PUT .NXT ,DATTYP FLOAT>)>)
 238                (<==? <ISTYPE? <RESULT-TYPE .NN>> FLOAT>
 239                 <TOACV .REG>
 240                 <DATTYP-FLUSH <SET REG <GEN-FLOAT .REG>>>
 241                 <PUT .REG ,DATTYP FLOAT>
 242                 <SET MODE 2>)>
 243          <COND (<AND .COM
 244                      <NOT <TYPE? <DATVAL .REG> AC>>
 245                      <TYPE? <DATVAL .NXT> AC>>
 246                 <SET TEM .NXT>
 247                 <SET NXT .REG>
 248                 <SET REG .TEM>)>
 249          <SET NXT <SAME-AC-FIX .REG .NXT>>
 250          <COND (<AND <==? .ATYP 3>
 251                      <==? .MODE 1>
 252                      <==? <NODE-TYPE .NN> ,QUOTE-CODE>
 253                      <SET SHFT <POPWR2 <NODE-NAME .NN>>>>
 254                 <SHIFT-INS .REG .SHFT .ATYP>)
 255                (ELSE
 256                 <SET REG
 257                      <ARITH-INS <COND (<AND .NEGF <L? .ATYP 3>>
 258                                        <SET NEGF <>>
 259                                        <- 3 .ATYP>)
 260                                       (ELSE .ATYP)>
 261                                 .REG
 262                                 .NXT
 263                                 <AND <EMPTY? <REST .N>>
 264                                      <TYPE? .WHERE DATUM>
 265                                      <==? <DATVAL .WHERE> <DATVAL .NXT>>>
 266                                 .MODE>>)>)>>
 267     <REST .K>>
 268    <COND (.NEGF
 269           <COND (<AND <ASSIGNED? TRANSFORM>
 270                       <==? <1 .TRANSFORM> <PARENT .NOD>>
 271                       <NOT <0? <1 <2 .TRANSFORM>>>>>
 272                  <PUT <3 .TRANSFORM> 1 1>)
 273                 (ELSE <EMIT <INSTRUCTION `MOVNS  !<ADDR:VALUE .REG>>>)>)>
 274    <DELAY-KILL .NO-KILL .ONO>
 275    <MOVE:ARG .REG .WHERE>>
 276
 277 <DEFINE SAME-AC-FIX (D1 D2 "AUX" (ACQ <DATVAL .D1>))
 278    #DECL ((D1 D2) DATUM)
 279    <COND
 280     (<AND <TYPE? .ACQ AC> <==? .ACQ <DATVAL .D2>>>
 281      <COND
 282       (<ACRESIDUE .ACQ>
 283        <MAPF <>
 284         <FUNCTION (SYM)
 285                 #DECL ((SYM) SYMTAB)
 286                 <COND (<STORED .SYM>
 287                        <PUT .SYM ,INACS <>>
 288                        <RET-TMP-AC .D2>
 289                        <FLUSH-RESIDUE .ACQ .SYM>
 290                        <SET D2 <LADDR .SYM <> <ISTYPE-GOOD? <DATTYP .D2>>>>
 291                        <MAPLEAVE>)>>
 292         <ACRESIDUE .ACQ>>)
 293       (ELSE <RET-TMP-AC .D2>)>)>
 294    .D2>
 295
 296 <DEFINE SHIFT-INS (REG SHFT ATYP)
 297         #DECL ((REG) DATUM (SHFT ATYP) FIX)
 298         <TOACV .REG>
 299         <MUNG-AC <DATVAL .REG> .REG>
 300         <EMIT <INSTRUCTION `ASH
 301                            <ACSYM <DATVAL .REG>>
 302                            <COND (<==? .ATYP 3> .SHFT) (ELSE <- .SHFT>)>>>>
 303
 304 <DEFINE SEGINS (ATYP FD N REG REG2 MD DEFLT
 305                 "AUX" SAC SL TYP (STYP <RESULT-TYPE .N>) (TG <MAKE:TAG>)
 306                       (LOOP <MAKE:TAG>) RAC)
 307         #DECL ((N) NODE (ATYP SL MD) FIX (REG REG2) DATUM (RAC SAC) AC)
 308         <SET TYP
 309              <COND (<==? <GET-ELE-TYPE .STYP ALL> FIX> 1) (ELSE 2)>>
 310         <SET STYP <STRUCTYP .STYP>>
 311         <SET SL <MINL <RESULT-TYPE .N>>>
 312         <COND (.FD
 313                <COND (<TYPE? <DATVAL .REG> AC>
 314                       <SGETREG <SET RAC <DATVAL .REG>> .REG>)
 315                      (ELSE <SET RAC <GETREG .REG>> <PUT .REG ,DATVAL .RAC>)>
 316                <PUT .RAC ,ACPROT T>
 317                <MUNG-AC .RAC .REG>
 318                <SET SAC <DATVAL <TOACV .REG2>>>
 319                <MUNG-AC .SAC .REG2>
 320                <PUT .RAC ,ACPROT <>>
 321                <SET MD .TYP>
 322                <AND <==? .TYP 2> <==? .DEFLT 1> <SET DEFLT 1.0>>
 323                <IMCHK '(`MOVE  `MOVEI  `MOVNI )
 324                       <ACSYM .RAC>
 325                       <REFERENCE:ADR .DEFLT>>
 326                <COND (<L? .SL 1>
 327                       <EMPTY-JUMP .STYP .SAC .TG>)>
 328                <COND (<OR <==? .ATYP 2> <==? .ATYP 4>>
 329                       <GETEL .RAC .SAC .STYP>
 330                       <ADVANCE .STYP .SAC>
 331                       <SET SL <- .SL 1>>)
 332                      (ELSE <SET SL 1>)>)
 333               (ELSE
 334                <TOACV .REG>
 335                <AND <1? .MD>
 336                     <==? .TYP 2>
 337                     <DATTYP-FLUSH <SET REG <GEN-FLOAT .REG>>>
 338                     <PUT .REG ,DATTYP FLOAT>>
 339                <SET RAC <DATVAL .REG>>
 340                <PUT .RAC ,ACPROT T>
 341                <MUNG-AC .RAC .REG>
 342                <SET SAC <DATVAL <TOACV .REG2>>>
 343                <MUNG-AC .SAC .REG2>
 344                <PUT .RAC ,ACPROT <>>)>
 345         <COND (<L? .SL 1> <EMPTY-JUMP .STYP .SAC .TG>)>
 346         <LABEL:TAG .LOOP>
 347         <EMITSEG .RAC .SAC .STYP .ATYP .TYP .MD>
 348         <ADVANCE-AND-CHECK .STYP .SAC .LOOP>
 349         <LABEL:TAG .TG>
 350         <RET-TMP-AC .REG2>
 351         .MD>
 352
 353 <DEFINE ADVANCE (STYP SAC "AUX" AMT)
 354         #DECL ((STYP) ATOM (SAC) AC (AMT) FIX)
 355         <SET AMT <COND (<==? .STYP UVECTOR> 1) (ELSE 2)>>
 356         <COND (<==? .STYP LIST>
 357                <EMIT <INSTRUCTION `HRRZ  <ACSYM .SAC> (<ADDRSYM .SAC>)>>)
 358               (ELSE
 359                <EMIT <INSTRUCTION `ADD  <ACSYM .SAC> [<FORM .AMT (.AMT)>]>>)>>
 360
 361 <DEFINE ADVANCE-AND-CHECK (STYP SAC TG)
 362         #DECL ((SAC) AC (STYP) ATOM)
 363         <COND (<==? .STYP UVECTOR>
 364                <EMIT <INSTRUCTION `AOBJN  <ACSYM .SAC> .TG>>)
 365               (<==? .STYP LIST>
 366                <EMIT <INSTRUCTION `HRRZ  <ACSYM .SAC> (<ADDRSYM .SAC>)>>
 367                <EMIT <INSTRUCTION `JUMPN  <ACSYM .SAC> .TG>>)
 368               (ELSE
 369                <EMIT <INSTRUCTION `ADD  <ACSYM .SAC> '[<2 (2)>]>>
 370                <EMIT <INSTRUCTION `JUMPL  <ACSYM .SAC> .TG>>)>>
 371
 372 <DEFINE EMPTY-JUMP (STYP SAC TG)
 373         #DECL ((SAC) AC (STYP TG) ATOM)
 374         <COND (<==? .STYP LIST>
 375                <EMIT <INSTRUCTION `JUMPE  <ACSYM .SAC> .TG>>)
 376               (ELSE <EMIT <INSTRUCTION `JUMPGE  <ACSYM .SAC> .TG>>)>>
 377
 378 <DEFINE EMITSEG (RAC SAC STYP ATYP TYP MD "AUX" DAT)
 379         #DECL ((SAC RAC) AC (TYP MD ATYP) FIX (DAT) DATUM)
 380         <COND (<AND <==? .MD 2> <==? .TYP 1>>
 381                <SET DAT <DATUM FIX ANY-AC>>
 382                <PUT .DAT ,DATVAL <GETREG .DAT>>
 383                <GETEL <DATVAL .DAT> .SAC .STYP>
 384                <DATTYP-FLUSH <SET DAT <GEN-FLOAT .DAT>>>
 385                <PUT .DAT ,DATTYP FLOAT>
 386                <GENINS .ATYP .MD .RAC 0 <ADDRSYM <DATVAL .DAT>>>
 387                <RET-TMP-AC .DAT>)
 388               (ELSE
 389                <GENINS .ATYP
 390                        .MD
 391                        .RAC
 392                        <COND (<==? .STYP UVECTOR> 0) (ELSE 1)>
 393                        (<ADDRSYM .SAC>)>)>>
 394
 395 <DEFINE GENINS (ATYP MD RAC OFFS ADD "AUX" INS)
 396         #DECL ((MD ATYP OFFS) FIX (RAC) AC)
 397         <COND (<G? .ATYP 4>
 398                <EMIT <INSTRUCTION <NTH '![`CAMG `CAML!] <- .ATYP 4>>
 399                                   <ACSYM .RAC>
 400                                   .OFFS
 401                                   .ADD>>
 402                <EMIT <INSTRUCTION `MOVE  <ACSYM .RAC> .OFFS .ADD>>)
 403               (ELSE
 404                <SET INS <NTH <NTH <2 ,INS1> .MD> .ATYP>>
 405                <AND <TYPE? .INS LIST> <SET INS <1 .INS>>>
 406                <EMIT <INSTRUCTION .INS <ACSYM .RAC> .OFFS .ADD>>)>>
 407
 408 <DEFINE GETEL (RAC SAC STYP)
 409         <EMIT <INSTRUCTION `MOVE
 410                            <ACSYM .RAC>
 411                            <COND (<==? .STYP UVECTOR> 0) (ELSE 1)>
 412                            (<ADDRSYM .SAC>)>>>
 413
 414 <SETG INS1
 415       ![![![`ADDM  `SUBM  `IMULM  `IDIVM !]
 416           ![`FADRM  `FSBRM  `FMPRM  `FDVRM !]!]
 417         ![![(`ADD  `ADDI  `SUBI )
 418             (`SUB  `SUBI  `ADDI )
 419             (`IMUL  `IMULI )
 420             (`IDIV  `IDIVI )!]
 421           ![(`FADR  () () `FADRI )
 422             (`FSBR  () () `FSBRI )
 423             (`FMPR  () () `FMPRI )
 424             (`FDVR  () () `FDVRI )!]!]!]>
 425
 426 " Do the actual arithmetic code generation here with all args set up."
 427
 428 <DEFINE ARITH-INS (ATYP REG REG2 MEM MODE "AUX" RTM INS T TT REG+1)
 429    #DECL ((ATYP MODE) FIX (REG REG2) DATUM (T) AC)
 430    <PROG ()
 431      <COND
 432       (<==? .ATYP 4>
 433        <COND (<AND <TYPE? <DATVAL .REG> AC>
 434                    <OR <AC+1OK? <DATVAL .REG>>
 435                        <AND <N==? <DATVAL .REG> ,LAST-AC>
 436                             <==? <NTH ,ALLACS <+ <ACNUM <DATVAL .REG>> 1>>
 437                                  <DATVAL .REG2>>>>>)
 438              (<SET TT <GET2REG>>
 439               <SET REG <MOVE:ARG .REG <DATUM <DATTYP .REG> .TT>>>)
 440              (<TYPE? <DATVAL .REG> AC>
 441               <COND (<AND <NOT .MEM>
 442                           <OR <==? <DATVAL .REG> ,LAST-AC>
 443                               <N==? <NTH ,ALLACS <+ 1 <ACNUM <DATVAL .REG>>>>
 444                                     <DATVAL .REG2>>>>
 445                      <EMIT <INSTRUCTION `PUSH  `P*  <ADDRSYM <DATVAL .REG>> 1>>
 446                      <SET RTM T>)>)
 447              (ELSE <TOACV .REG> <AGAIN>)>
 448        <AND <NOT <ASSIGNED? RTM>>
 449             <NOT .MEM>
 450             <MUNG-AC <SET REG+1 <NTH ,ALLACS <+ 1 <ACNUM <DATVAL .REG>>>>>>
 451             <PUT .REG+1 ,ACPROT T>>)
 452       (<NOT <TYPE? <DATVAL .REG> AC>> <TOACV .REG>)>
 453      <PUT <DATVAL .REG> ,ACPROT T>
 454      <SET INS <NTH <NTH <NTH ,INS1 <COND (.MEM 1) (ELSE 2)>> .MODE> .ATYP>>
 455      <OR .MEM <MUNG-AC <DATVAL .REG> .REG>>
 456      <COND (<TYPE? .INS LIST>
 457             <IMCHK .INS <ACSYM <DATVAL .REG>> <DATVAL .REG2>>)
 458            (ELSE
 459             <EMIT <INSTRUCTION .INS
 460                                <ACSYM <DATVAL .REG>>
 461                                !<ADDR:VALUE .REG2>>>)>
 462      <AND <ASSIGNED? REG+1> <PUT .REG+1 ,ACPROT <>>>
 463      <PUT <DATVAL .REG> ,ACPROT <>>
 464      <AND <ASSIGNED? RTM>
 465          <EMIT <INSTRUCTION `POP  `P*  <ADDRSYM <DATVAL .REG>> 1>>>
 466      <COND (.MEM <RET-TMP-AC .REG> .REG2) (ELSE <RET-TMP-AC .REG2> .REG)>>>
 467
 468 <DEFINE MIN-MAX (NOD WHERE
 469                  "AUX" (MAX? <==? MAX <NODE-NAME .NOD>>) (K <KIDS .NOD>) REG
 470                        (MODE 1) REG1 SEGF (C <OR <AND .MAX? 5> 6>) TEM
 471                        (ONO .NO-KILL) (NO-KILL .ONO))
 472    #DECL ((NOD) NODE (MODE C) FIX (MAX?) ANY (REG) DATUM (K) <LIST [REST NODE]>
 473           (NO-KILL) <SPECIAL LIST>)
 474    <SET NO-KILL <COMMUTE .K <NODE-NAME .NOD> .NO-KILL>>
 475    <SET REG <REG? <RESULT-TYPE .NOD> .WHERE>>
 476    <COND (<==? <NODE-TYPE <SET TEM <1 .K>>> ,SEG-CODE>
 477           <SET REG1
 478                <GEN <SET TEM <1 <KIDS .TEM>>>
 479                     <DATUM <STRUCTYP <RESULT-TYPE .TEM>> ANY-AC>>>
 480           <SET MODE
 481                <SEGINS .C
 482                        T
 483                        .TEM
 484                        .REG
 485                        .REG1
 486                        1
 487                        <OR <AND .MAX? <MAX>> <MIN>>>>)
 488          (ELSE
 489           <SET REG <GEN .TEM .REG>>
 490           <AND <==? <RESULT-TYPE .TEM> FLOAT> <SET MODE 2>>)>
 491    <MAPF <>
 492     <FUNCTION (N
 493                "AUX" (NXT
 494                       <COND
 495                        (<==? <NODE-TYPE .N> ,SEG-CODE>
 496                         <SET SEGF T>
 497                         <GEN <SET N <1 <KIDS .N>>>
 498                              <DATUM <STRUCTYP <RESULT-TYPE .N>> ANY-AC>>)
 499                        (ELSE <SET SEGF <>> <GEN .N DONT-CARE>)>))
 500        #DECL ((NXT REG) DATUM (N) NODE (MODE) FIX)
 501        <COND (.SEGF
 502               <SET MODE <SEGINS .C <> .N .REG .NXT .MODE 0>>
 503               <RET-TMP-AC .NXT>)
 504              (ELSE
 505               <COND (<==? .MODE 2>
 506                      <COND (<==? <ISTYPE? <RESULT-TYPE .N>> FIX>
 507                             <DATTYP-FLUSH <SET NXT <GEN-FLOAT .NXT>>>
 508                             <PUT .NXT ,DATTYP FLOAT>)>)
 509                     (<==? <ISTYPE? <RESULT-TYPE .N>> FLOAT>
 510                      <DATTYP-FLUSH <SET REG <GEN-FLOAT .REG>>>
 511                      <PUT .REG ,DATTYP FLOAT>
 512                      <SET MODE 2>)>
 513               <COND (<AND <NOT <TYPE? <DATVAL .REG> AC>>
 514                           <TYPE? <DATVAL .NXT> AC>>
 515                      <SET TEM .NXT>
 516                      <SET NXT .REG>
 517                      <SET REG .TEM>)>
 518               <COND (<TYPE? <DATVAL .REG> AC>
 519                      <MUNG-AC <DATVAL .REG> .REG>)>
 520               <TOACV .REG>                                    ;"Make sure in AC"
 521               <PUT <DATVAL .REG> ,ACPROT T>
 522               <IMCHK <COND (.MAX? '(`CAMG  `CAIG )) (ELSE '(`CAML  `CAIL ))>
 523                      <ACSYM <DATVAL .REG>>
 524                      <DATVAL .NXT>>
 525               <MOVE:VALUE <DATVAL .NXT> <DATVAL .REG>>
 526               <PUT <DATVAL .REG> ,ACPROT <>>
 527               <RET-TMP-AC .NXT>)>>
 528     <REST .K>>
 529    <DELAY-KILL .NO-KILL .ONO>
 530    <MOVE:ARG .REG .WHERE>>
 531
 532 <DEFINE ABS-GEN ACT (N W
 533                      "AUX" (K1 <1 <KIDS .N>>) NUM (TRIN <>)
 534                            (ABSFLG <==? <NODE-NAME .N> ABS>) TEM T2 (DONE <>))
 535    #DECL ((N K1) NODE (NUM) DATUM (TEM) <DATUM ANY AC> (TRANSFORM) TRANS)
 536    <PROG ((TRANSFORM <MAKE-TRANS .N 2 0 0 0 1 0 0>))
 537          #DECL ((TRANSFORM) <SPECIAL TRANS>)
 538          <SET NUM
 539               <GEN .K1
 540                    <COND (<AND <==? <NODE-TYPE .K1> ,LNTH-CODE>
 541                                <TYPE? .W DATUM>>
 542                           <DATUM !.W>)
 543                          (ELSE DONT-CARE)>>>
 544          <COND (<NOT <0? <1 <3 .TRANSFORM>>>>
 545                 <RETURN <MOVE:ARG .NUM .W> .ACT>)>>
 546    <COND (<AND <ASSIGNED? TRANSFORM>
 547                <==? <1 .TRANSFORM> <PARENT .N>>
 548                <NOT .ABSFLG>>
 549           <SET TRIN <2 .TRANSFORM>>)>
 550    <COND
 551     (<AND <TYPE? .W DATUM>
 552           <REPEAT ((W <CHTYPE .W LIST>))
 553                   #DECL ((W) LIST)
 554                   <COND (<EMPTY? .W> <RETURN <>>)
 555                         (<OR <=? <DATVAL .W> <DATVAL .NUM>>
 556                              <AND <TYPE? <DATVAL .NUM> AC>
 557                                   <==? <DATVAL .W> ANY-AC>>>
 558                          <RETURN T>)
 559                         (ELSE <SET W <REST .W 2>>)>>>
 560      <COND (<NOT <AND .TRIN <NOT <0? <1 .TRIN>>>>>
 561             <AND <TYPE? <DATVAL .NUM> AC> <MUNG-AC <DATVAL .NUM> .NUM>>
 562             <EMIT <INSTRUCTION <COND (.ABSFLG `MOVMS ) (ELSE `MOVNS )>
 563                                !<ADDR:VALUE .NUM>>>)
 564            (ELSE <PUT <3 .TRANSFORM> 1 1>)>
 565      <MOVE:ARG .NUM .W>)
 566     (<AND <==? .W DONT-CARE> <TYPE? <DATVAL .NUM> AC>>
 567      <COND (<NOT <AND .TRIN <NOT <0? <1 .TRIN>>>>>
 568             <AND <TYPE? <DATVAL .NUM> AC> <MUNG-AC <DATVAL .NUM> .NUM>>
 569             <EMIT <INSTRUCTION <COND (.ABSFLG `MOVMS ) (ELSE `MOVNS )>
 570                                !<ADDR:VALUE .NUM>>>)
 571            (ELSE <PUT <3 .TRANSFORM> 1 1>)>
 572      <MOVE:ARG .NUM .W>)
 573     (<AND .TRIN <NOT <0? <1 .TRIN>>>>
 574      <PUT <3 .TRANSFORM> 1 1>
 575      <MOVE:ARG .NUM .W>)
 576     (ELSE
 577      <COND (<SET T2
 578                  <OR <ISTYPE? <DATTYP .NUM>> <ISTYPE? <RESULT-TYPE .K1>>>>
 579             <SET TEM <REG? .T2 .W T>>)
 580            (ELSE
 581             <SET TEM <REG? TUPLE .W T>>
 582             <COND (<AND <NOT <==? <DATVAL .TEM> <DATTYP .NUM>>>
 583                         <==? <DATVAL .NUM> <DATTYP .TEM>>>
 584                    <MUNG-AC <DATVAL .TEM> .TEM>
 585                    <EMIT <INSTRUCTION <COND (.ABSFLG `MOVM ) (ELSE `MOVN )>
 586                                       <ACSYM <DATVAL .TEM>>
 587                                       !<ADDR:VALUE .NUM>>>
 588                    <RET-TMP-AC <DATVAL .NUM> .NUM>
 589                    <SET DONE T>)>
 590             <COND (<==? <DATTYP .TEM> ANY-AC>
 591                    <PUT .TEM ,DATTYP <GETREG .TEM>>)
 592                   (<TYPE? <DATTYP .TEM> AC> <SGETREG <DATTYP .TEM> .TEM>)>
 593             <MOVE:TYP <DATTYP .NUM> <DATTYP .TEM>>)>
 594      <RET-TMP-AC .NUM>
 595      <PUT <DATVAL .TEM> ,ACLINK (.TEM !<ACLINK <DATVAL .TEM>>)>
 596      <COND (<NOT .DONE>
 597             <MUNG-AC <DATVAL .TEM> .TEM>
 598             <EMIT <INSTRUCTION <COND (.ABSFLG `MOVM ) (ELSE `MOVN )>
 599                                <ACSYM <DATVAL .TEM>>
 600                                !<ADDR:VALUE .NUM>>>)>
 601      <MOVE:ARG .TEM .W>)>>
 602
 603 <DEFINE MOD-GEN (N W
 604                  "AUX" (N1 <GEN <1 <KIDS .N>> DONT-CARE>) NN
 605                        (N2 <GEN <SET NN <2 <KIDS .N>>> DONT-CARE>) TEM T1 TT
 606                        (ACE ,LAST-AC) (ACD ,LAST-AC-1))
 607    #DECL ((N) NODE (N1 N2) DATUM (ACE ACD TT T1) AC)
 608    <COND
 609     (<AND <==? <NODE-TYPE .NN> ,QUOTE-CODE>
 610           <POPWR2 <NODE-NAME .NN>>>
 611      <SET N1 <MOVE:ARG .N1 <REG? FIX .W>>>
 612      <MUNG-AC <DATVAL .N1> .N1>
 613      <IMCHK '(`AND  `ANDI )
 614             <ACSYM <DATVAL .N1>>
 615             <REFERENCE:ADR <- <NODE-NAME .NN> 1>>>)
 616     (ELSE
 617      <PROG ()
 618            <COND (<AC+1OK? <SET TEM <DATVAL .N1>>> <SET T1 .TEM>)
 619                  (<SET TEM <GET2REG>>
 620                   <SET N1 <MOVE:ARG .N1 <DATUM FIX <SET T1 .TEM>>>>)
 621                  (<TYPE? <SET TEM <DATVAL .N1>> AC>
 622                   <COND (<==? <SET T1 .TEM> .ACE>
 623                          <SET N1 <MOVE:ARG .N1 <DATUM FIX <SGETREG .ACD <>>>>>
 624                          <SET T1 .ACD>)
 625                         (ELSE <SGETREG <NTH ,ALLACS <+ <ACNUM .T1> 1>> <>>)>)
 626                  (ELSE
 627                   <SET TEM <ACPROT .ACE>>
 628                   <PUT .ACE ,ACPROT T>
 629                   <TOACV .N1>
 630                   <PUT .ACE ,ACPROT .TEM>
 631                   <AGAIN>)>
 632            <PUT <SET TT <NTH ,ALLACS <+ <ACNUM .T1> 1>>> ,ACPROT T>
 633            <MUNG-AC .T1 .N1>
 634            <PUT .TT ,ACPROT <>>
 635            <AND <ACLINK .T1> <RET-TMP-AC .T1 .N1>>
 636            <RET-TMP-AC <DATTYP .N1> .N1>
 637            <PUT .N1 ,DATTYP FIX>
 638            <PUT .N1 ,DATVAL <SET TT <NTH ,ALLACS <+ <ACNUM .T1> 1>>>>
 639            <MUNG-AC <PUT .TT ,ACLINK (.N1 !<ACLINK .TT>)> .N1>
 640            <PUT .T1 ,ACPROT T>
 641            <IMCHK '(`IDIV  `IDIVI ) <ACSYM .T1> <DATVAL .N2>>
 642            <EMIT <INSTRUCTION `SKIPGE  <ADDRSYM .TT>>>
 643            <IMCHK '(`ADD  `ADDI ) <ACSYM .TT> <DATVAL .N2>>
 644            <RET-TMP-AC .N2>
 645            <PUT .T1 ,ACPROT <>>>)>
 646    <MOVE:ARG .N1 .W>>
 647
 648 <DEFINE ROT-GEN (N W) <ROT-LSH-GEN .N .W `ROT>>
 649
 650 <DEFINE LSH-GEN (N W) <ROT-LSH-GEN .N .W `LSH>>
 651
 652 <DEFINE ROT-LSH-GEN (N W INS
 653                      "AUX" (K <KIDS .N>) (A1 <1 .K>) (A2 <2 .K>) W1 W2 AC1)
 654         #DECL ((N A1 A2) NODE (K) <LIST [2 NODE]> (W1 W2) DATUM (AC1) AC)
 655         <COND (<==? <NODE-TYPE .A2> ,QUOTE-CODE>     ;" LSH-ROT by fixed amount"
 656                <SET W1 <GEN .A1 DONT-CARE>>
 657                <TOACV .W1>
 658                <RET-TMP-AC <DATTYP .W1> .W1>
 659                <PUT .W1 ,DATTYP WORD>
 660                <MUNG-AC <DATVAL .W1> .W1>
 661                <EMIT <INSTRUCTION .INS <ACSYM <DATVAL .W1>> <NODE-NAME .A2>>>)
 662               (ELSE
 663                <COND (<AND <MEMQ <NODE-TYPE .A1> ,SNODES>
 664                            <NOT <MEMQ <NODE-TYPE .A2> ,SNODES>>
 665                            <NOT <SIDE-EFFECTS .A2>>>
 666                       <SET W2 <GEN .A2 DONT-CARE>>
 667                       <SET W1 <GEN .A1 DONT-CARE>>)
 668                      (ELSE
 669                       <SET W1 <GEN .A1 DONT-CARE>>
 670                       <SET W2 <GEN .A2 DONT-CARE>>)>
 671                <TOACV .W1>
 672                <RET-TMP-AC <DATTYP .W1> .W1>
 673                <PUT .W1 ,DATTYP WORD>
 674                <SET AC1 <DATVAL .W1>>
 675                <PUT .AC1 ,ACPROT T>
 676                <TOACV .W2>
 677                <PUT .AC1 ,ACPROT <>>
 678                <MUNG-AC .AC1 .W1>
 679                <EMIT <INSTRUCTION .INS
 680                                   <ACSYM <DATVAL .W1>>
 681                                   (<ADDRSYM <CHTYPE <DATVAL .W2> AC>>)>>
 682                <RET-TMP-AC .W2>)>
 683         <MOVE:ARG .W1 .W>>
 684
 685 <DEFINE FLOAT-GEN (N W
 686                    "AUX" (NUM <1 <KIDS .N>>) TEM1 (RT <RESULT-TYPE .NUM>) BR
 687                          TEM)
 688         #DECL ((N NUM) NODE (TEM TEM1) DATUM (BR) ATOM)
 689         <COND (<==? .RT FLOAT>
 690                <MESSAGE WARNING "UNECESSARY FLOAT ">
 691                <GEN .NUM .W>)
 692               (<==? <ISTYPE? .RT> FIX>
 693                <SET TEM <GEN-FLOAT <GEN .NUM <GOODACS .N .W>>>>
 694                <RET-TMP-AC <DATTYP .TEM> .TEM>
 695                <PUT .TEM ,DATTYP FLOAT>
 696                <MOVE:ARG .TEM .W>)
 697               (ELSE
 698                <SET TEM <GEN .NUM DONT-CARE>>
 699                <EMIT <INSTRUCTION GETYP!-OP `O*  !<ADDR:TYPE .TEM>>>
 700                <RET-TMP-AC <DATTYP <SET TEM <MOVE:ARG .TEM <REG? FLOAT .W>>>>
 701                            .TEM>
 702                <PUT .TEM ,DATTYP FLOAT>
 703                <SET TEM1 <DATUM !.TEM>>
 704                <MOVE:ARG <GEN-FLOAT .TEM <SET BR <MAKE:TAG>>> .TEM1>
 705                <LABEL:TAG .BR>
 706                <MOVE:ARG .TEM1 .W>)>>
 707
 708 <DEFINE FIX-GEN (N W
 709                  "AUX" (NUM <1 <KIDS .N>>) (RT <RESULT-TYPE .NUM>) TEM TEM1 BR)
 710         #DECL ((N NUM) NODE (TEM TEM1) DATUM (BR) ATOM)
 711         <COND (<==? <ISTYPE? .RT> FIX>
 712                <MESSAGE WARNING "UNECESSARY FIX ">
 713                <GEN .NUM .W>)
 714               (<==? .RT FLOAT>
 715                <SET TEM <GEN-FIX <GEN .NUM DONT-CARE>>>
 716                <RET-TMP-AC <DATTYP .TEM> .TEM>
 717                <PUT .TEM ,DATTYP FIX>
 718                <MOVE:ARG .TEM .W>)
 719               (ELSE
 720                <SET TEM <GEN .NUM DONT-CARE>>
 721                <EMIT <INSTRUCTION GETYP!-OP `O*  !<ADDR:TYPE .TEM>>>
 722                <RET-TMP-AC <DATTYP <SET TEM <MOVE:ARG .TEM <REG? FIX .W>>>>
 723                            .TEM>
 724                <PUT .TEM ,DATTYP FIX>
 725                <SET TEM1 <DATUM !.TEM>>
 726                <MOVE:ARG <GEN-FIX .TEM <SET BR <MAKE:TAG>>> .TEM1>
 727                <LABEL:TAG .BR>
 728                <MOVE:ARG .TEM1 .W>)>>
 729
 730 <DEFINE GEN-FLOAT (DAT "OPTIONAL" (BR <>) "AUX" TT T RTM)
 731         #DECL ((DAT) DATUM (T) AC)
 732         <PROG ()
 733               <COND (<AC+1OK? <DATVAL .DAT>>)
 734                     (<SET TT <GET2REG>>
 735                      <SET DAT <MOVE:ARG .DAT <DATUM <DATTYP .DAT> .TT>>>)
 736                     (<TYPE? <DATVAL .DAT> AC>
 737                      <EMIT <INSTRUCTION `PUSH  `P*  <ADDRSYM <DATVAL .DAT>> 1>>
 738                      <SET RTM T>)
 739                     (ELSE <TOACV .DAT> <AGAIN>)>
 740               <SET T <DATVAL .DAT>>
 741               <OR <ASSIGNED? RTM>
 742                   <PUT <NTH ,ALLACS <+ <ACNUM .T> 1>> ,ACPROT T>>
 743               <MUNG-AC .T .DAT>
 744               <AND <NOT <ASSIGNED? RTM>>
 745                    <PUT <NTH ,ALLACS <+ <ACNUM .T> 1>> ,ACPROT <>>
 746                    <MUNG-AC <NTH ,ALLACS <+ <ACNUM .T> 1>>>>
 747               <COND (.BR
 748                      <EMIT <INSTRUCTION `CAIE  `O*  '<TYPE-CODE!-OP!-PACKAGE FIX>>>
 749                      <BRANCH:TAG .BR>)>
 750               <EMIT <INSTRUCTION `IDIVI  <ACSYM .T> 131072>>
 751               <EMIT <INSTRUCTION `FSC  <ACSYM .T> 172>>
 752               <EMIT <INSTRUCTION `FSC  <AC1SYM .T> 155>>
 753               <EMIT <INSTRUCTION `FADR  <ACSYM .T> <ACNUM .T> 1>>
 754               <AND <ASSIGNED? RTM>
 755                   <EMIT <INSTRUCTION `POP  `P*  <ADDRSYM .T> 1>>>
 756               .DAT>>
 757
 758 <DEFINE GEN-FIX (DAT "OPTIONAL" (BR <>) "AUX" TEM TT (ACE ,LAST-AC)
 759                                               (ACD ,LAST-AC-1) T1 NXTAC)
 760         #DECL ((DAT) DATUM (ACE ACD TT TEM) AC)
 761         <PROG ()
 762               <COND (<AC+1OK? <SET T1 <DATVAL .DAT>>> <SET TEM .T1>)
 763                     (<SET T1 <GET2REG>>
 764                      <SET DAT <MOVE:ARG .DAT <DATUM FIX <SET TEM .T1>>>>)
 765                     (<TYPE? <SET T1 <DATVAL .DAT>> AC>
 766                      <COND (<==? <SET TEM .T1> .ACE>
 767                             <MOVE:ARG .DAT
 768                                       <DATUM FIX <SET TEM <SGETREG .ACD <>>>>>)
 769                            (ELSE
 770                             <SGETREG <NTH ,ALLACS <+ <ACNUM .TEM> 1>> <>>)>)
 771                     (ELSE
 772                      <SET T1 <ACPROT .ACE>>
 773                      <PUT .ACE ,ACPROT T>
 774                      <TOACV .DAT>
 775                      <PUT .ACE ,ACPROT .T1>
 776                      <AGAIN>)>
 777               <PUT <SET NXTAC <NTH ,ALLACS <+ <ACNUM .TEM> 1>>>
 778                    ,ACPROT
 779                    T>
 780               <MUNG-AC .TEM .DAT>
 781               <PUT .NXTAC ,ACPROT <>>
 782               <AND <ACLINK .TEM> <RET-TMP-AC .TEM .DAT>>
 783               <RET-TMP-AC <DATTYP .DAT> .DAT>
 784               <PUT .DAT ,DATTYP FIX>
 785               <PUT .DAT ,DATVAL <SET TT .NXTAC>>
 786               <MUNG-AC <PUT .TT ,ACLINK (.DAT !<ACLINK .TT>)> .DAT>
 787               <COND (.BR
 788                      <EMIT '<`CAIE 0 <TYPE-CODE!-OP!-PACKAGE FLOAT>>>
 789                      <BRANCH:TAG .BR>)>
 790               <EMIT <INSTRUCTION `MULI  <ACSYM .TEM> 256>>
 791               <EMIT <INSTRUCTION `TSC  <ACSYM .TEM> <ADDRSYM .TEM>>>
 792               <EMIT <INSTRUCTION `ASH  <ACSYM .TT> (<ADDRSYM .TEM>) -163>>
 793               .DAT>>
 794
 795 <DEFINE FLOP (SUBR)
 796         #DECL ((SUBR VALUE) ATOM)
 797         <1 <REST <MEMQ .SUBR
 798                        '![G? L? G? G=? L=? G=? ==? ==? N==? N==? 1? -1? 1? 0?
 799                           0?!]>>>>
 800
 801 <DEFINE FLIP (SUBR "AUX" N)
 802         #DECL ((N) FIX (SUBR VALUE) ATOM)
 803         <NTH ,0SUBRS
 804              <- 13
 805                 <SET N <LENGTH <MEMQ .SUBR ,0SUBRS>>>
 806                 <COND (<0? <MOD .N 2>> -1) (ELSE 1)>>>>
 807
 808 <SETG 0SUBRS ![1? N1? -1? N-1? 0? N0? G? L=? L? G=? ==? N==?!]>
 809
 810 <DEFINE PRED? (N) #DECL ((N) FIX) <1? <NTH ,PREDV .N>>>
 811
 812 <DEFINE PRED:BRANCH:GEN (TAG NOD TF
 813                          "OPTIONAL" (WHERE FLUSHED) (NF <>)
 814                          "AUX" TT
 815                                (W2
 816                                 <COND (<==? .WHERE FLUSHED> DONT-CARE)
 817                                       (<AND <TYPE? .WHERE DATUM>
 818                                             <ISTYPE? <DATTYP .WHERE>>>
 819                                        <DATUM ANY-AC <DATVAL .WHERE>>)
 820                                       (ELSE .WHERE)>) TAG2)
 821         #DECL ((NOD) NODE (TT) DATUM)
 822         <COND (<==? <RESULT-TYPE .NOD> NO-RETURN>
 823                <GEN .NOD FLUSHED>
 824                ,NO-DATUM)
 825               (<PRED? <NODE-TYPE .NOD>>
 826                <APPLY <NTH ,GENERATORS <NODE-TYPE .NOD>>
 827                       .NOD
 828                       .WHERE
 829                       .NF
 830                       .TAG
 831                       .TF>)
 832               (.NF
 833                <SET TT <GEN .NOD DONT-CARE>>
 834                <VAR-STORE <>>
 835                <COND (<==? .WHERE FLUSHED>
 836                       <D:B:TAG .TAG .TT <NOT .TF> <RESULT-TYPE .NOD>>
 837                       <RET-TMP-AC .TT>)
 838                      (<D:B:TAG <SET TAG2 <MAKE:TAG>> .TT .TF <RESULT-TYPE .NOD>>
 839                       <RET-TMP-AC .TT>
 840                       <SET TT <MOVE:ARG <REFERENCE .TF> .WHERE>>
 841                       <BRANCH:TAG .TAG>
 842                       <LABEL:TAG .TAG2>
 843                       .TT)>)
 844               (ELSE
 845                <SET TT <GEN .NOD .W2>>
 846                <VAR-STORE <>>
 847                <D:B:TAG .TAG .TT .TF <RESULT-TYPE .NOD>>
 848                <MOVE:ARG .TT .WHERE>)>>
 849
 850 <DEFINE LN-LST (N)
 851         #DECL ((N) NODE)
 852         <AND <==? <NODE-TYPE .N> ,LNTH-CODE>
 853              <==? <STRUCTYP <RESULT-TYPE <1 <KIDS .N>>>> LIST>>>
 854
 855 <DEFINE 0-TEST (NOD WHERE
 856                 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
 857                 "AUX" (REG ,NO-DATUM) (NN <1 <KIDS .NOD>>)
 858                       (TRANSFORM
 859                        <MAKE-TRANS .NOD 1 1 0 1 1 1 <SW? <NODE-NAME .NOD>>>))
 860         #DECL ((TRANSFORM) <SPECIAL TRANS> (NOD NN) NODE (REG) DATUM)
 861         <OR <LN-LST .NN> <SET REG <GEN .NN DONT-CARE>>>
 862         <TEST-DISP .NOD
 863                    .WHERE
 864                    .NOTF
 865                    .BRANCH
 866                    .DIR
 867                    .REG
 868                    <DO-TRANS 0 .TRANSFORM>
 869                    <NOT <0? <1 <3 .TRANSFORM>>>>>>
 870
 871 <DEFINE SW? (SBR)
 872         #DECL ((SBR) ATOM)
 873         <COND (<MEMQ .SBR '![0? N0? 1? -1? N1? N-1? ==? N==?!]> 0)
 874               (ELSE 1)>>
 875
 876 <DEFINE MAKE-TRANS (N NEG +- +-V */ */V HW SW)
 877         #DECL ((N) NODE (NEG +- +-V */ */V HW SW) FIX)
 878         <CHTYPE [.N ![.NEG .+- .+-V .*/ .*/V .HW .SW!] <IUVECTOR 7 0>]
 879                 TRANS>>
 880
 881 <DEFINE DO-TRANS (N TR "AUX" (X <3 .TR>) (NN <NODE-NAME <1 .TR>>))
 882         #DECL ((TR) TRANS (N) FIX (X) <UVECTOR [7 FIX]>)
 883         <COND (<AND <NOT <0? .N>> <NOT <0? <6 .X>>> <NOT <0? <7 .X>>>>
 884                <COND (<==? .NN G?> <SET N <- .N 1>>)
 885                      (<==? .NN L=?> <SET N <- .N 1>>)>)>
 886         <COND (<NOT <0? <1 .X>>> <SET N <- .N>>)>
 887         <COND (<NOT <0? <2 .X>>> <SET N <+ .N <3 .X>>>)>
 888         <COND (<G? <4 .X> 2> <SET N </ .N <5 .X>>>)
 889               (<NOT <0? <4 .X>>> <SET N <* .N <5 .X>>>)>
 890         <COND (<NOT <0? <6 .X>>>
 891                <SET N <CHTYPE <ANDB .N 262143> FIX>>
 892                <COND (<NOT <0? <7 .X>>>
 893                       <SET N <CHTYPE <PUTBITS 0 <BITS 18 18> .N> FIX>>)>)>
 894         .N>
 895
 896 <DEFINE UPDATE-TRANS (NOD TR "AUX" (X <3 .TR>) FLG)
 897         #DECL ((TR) TRANS)
 898         <MAKE-TRANS .NOD
 899                     <COND (<NOT <0? <1 .X>>> 2) (ELSE 0)>
 900                     <COND (<SET FLG <NOT <0? <2 .X>>>> 2) (ELSE 0)>
 901                     <COND (.FLG <3 .X>) (ELSE 0)>
 902                     <COND (<SET FLG <G? <4 .X> 2>> 4)
 903                           (<SET FLG <NOT <0? <4 .X>>>> 2)
 904                           (ELSE 0)>
 905                     <COND (.FLG <5 .X>) (ELSE 1)>
 906                     <COND (<NOT <0? <6 .X>>> 2) (ELSE 0)>
 907                     <COND (<NOT <0? <7 .X>>> 2) (ELSE 0)>>>
 908
 909 <DEFINE TEST-DISP (N W NF BR DI REG NUM NEG)
 910         #DECL ((NUM) <OR FIX FLOAT> (N) NODE)
 911         <COND (<==? .REG ,NO-DATUM>
 912                <LIST-LNT-SPEC .N .W .NF .BR .DI .NUM>)
 913               (<0? .NUM> <0-TEST1 .N .W .NF .BR .DI .REG .NEG>)
 914               (<AND <OR <1? .NUM> <==? .NUM -1>>
 915                     <OR <==? <NODE-NAME .N> 1?>
 916                         <==? <ISTYPE? <RESULT-TYPE <1 <KIDS .N>>>> FIX>>>
 917                <COND (<==? .NUM -1> <SET NEG T>)>
 918                <1?-TEST .N .W .NF .BR .DI .REG .NEG>)
 919               (ELSE <TEST-GEN2 .N .W .NF .BR .DI .REG .NUM .NEG>)>>
 920
 921 <DEFINE 0-TEST1 (NOD WHERE NOTF BRANCH DIR REG NEG
 922                  "AUX" (SBR <NODE-NAME .NOD>) B2 (RW .WHERE)
 923                        (ARG <1 <KIDS .NOD>>) (SDIR .DIR)
 924                        (ATYP <ISTYPE? <RESULT-TYPE .ARG>>) (LDAT <>) S TT)
 925         #DECL ((NOD ARG) NODE (REG) DATUM (LDAT) <OR FALSE DATUM> (S) SYMTAB)
 926         <SET WHERE <UPDATE-WHERE .NOD .WHERE>>
 927         <COND (.NEG
 928                <COND (<==? <NODE-TYPE .NOD> ,0-TST-CODE> <SET SBR <FLOP .SBR>>)
 929                      (ELSE
 930                       <COND (<SET TT <MEMQ .SBR '![G? G=? G? L? L=? L?!]>>
 931                              <SET SBR <2 .TT>>)>)>)>
 932         <COND (<AND <NOT <TYPE? <DATVAL .REG> AC>>
 933                     .ATYP
 934                     <==? <NODE-TYPE .ARG> ,LVAL-CODE>
 935                     <STORED <SET S <NODE-NAME .ARG>>>
 936                     <NOT <INACS .S>>
 937                     <OR <SPEC-SYM .S> <2 <TYPE-INFO .ARG>>>
 938                     <G? <FREE-ACS T> 0>>
 939                <SET LDAT <DATUM .ATYP <GETREG <>>>>
 940                <PUT .S ,INACS .LDAT>
 941                <PUT <DATVAL .LDAT> ,ACRESIDUE (.S)>)>
 942         <COND (.BRANCH
 943                <AND .NOTF <SET DIR <NOT .DIR>>>
 944                <AND .DIR <SET SBR <FLIP .SBR>>>
 945                <VAR-STORE <>>
 946                <COND (<==? .RW FLUSHED>
 947                       <ZER-JMP .SBR .REG .BRANCH .LDAT>
 948                       <RET-TMP-AC .REG>)
 949                      (ELSE
 950                       <SET B2 <MAKE:TAG>>
 951                       <SET SBR <FLIP .SBR>>
 952                       <ZER-JMP .SBR .REG .B2 .LDAT>
 953                       <RET-TMP-AC .REG>
 954                       <SET RW
 955                            <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
 956                       <BRANCH:TAG .BRANCH>
 957                       <LABEL:TAG .B2>
 958                       .RW)>)
 959               (ELSE
 960                <AND .NOTF <SET SBR <FLIP .SBR>>>
 961                <VAR-STORE <>>
 962                <AND <TYPE? .WHERE ATOM> <SET WHERE <ANY2ACS>>>
 963                <ZER-JMP .SBR .REG <SET BRANCH <MAKE:TAG>> .LDAT>
 964                <RET-TMP-AC .REG>
 965                <MOVE:ARG <REFERENCE T> .WHERE>
 966                <RET-TMP-AC .WHERE>
 967                <BRANCH:TAG <SET B2 <MAKE:TAG>>>
 968                <LABEL:TAG .BRANCH>
 969                <MOVE:ARG <REFERENCE <>> .WHERE>
 970                <LABEL:TAG .B2>
 971                <MOVE:ARG .WHERE .RW>)>>
 972
 973 <DEFINE ZER-JMP (SBR REG BR LDAT "AUX" TEM)
 974         #DECL ((REG) DATUM (LDAT) <OR FALSE DATUM>)
 975         <COND (<TYPE? <SET TEM <DATVAL .REG>> AC>
 976                <EMIT <INSTRUCTION <NTH ,0JMPS <LENGTH <MEMQ .SBR ,0SUBRS>>>
 977                                   <ACSYM .TEM>
 978                                   .BR>>)
 979               (ELSE
 980                <EMIT <INSTRUCTION <NTH ,0SKPS <LENGTH <MEMQ .SBR ,0SUBRS>>>
 981                                   <COND (.LDAT <ACSYM <DATVAL .LDAT>>) (ELSE 0)>
 982                                   !<ADDR:VALUE .REG>>>
 983                <BRANCH:TAG .BR>)>>
 984
 985 <SETG 0SKPS
 986       ![`SKIPN  `SKIPE  `SKIPGE  `SKIPL  `SKIPLE  `SKIPG  `SKIPN  `SKIPE !]>
 987
 988 <SETG 0JMPS
 989       ![`JUMPE  `JUMPN  `JUMPL  `JUMPGE  `JUMPG  `JUMPLE  `JUMPE  `JUMPN !]>
 990
 991 <DEFINE 1?-GEN (NOD WHERE
 992                 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
 993                 "AUX" (REG ,NO-DATUM) (NN <1 <KIDS .NOD>>)
 994                       (TRANSFORM
 995                        <MAKE-TRANS .NOD 1 2 -1 1 1 1 <SW? <NODE-NAME .NOD>>>))
 996         #DECL ((NOD NN) NODE (REG) DATUM (TRANSFORM) <SPECIAL TRANS>)
 997         <OR <LN-LST .NN> <SET REG <GEN .NN DONT-CARE>>>
 998         <TEST-DISP .NOD
 999                    .WHERE
1000                    .NOTF
1001                    .BRANCH
1002                    .DIR
1003                    .REG
1004                    <DO-TRANS 1 .TRANSFORM>
1005                    <NOT <0? <1 <3 .TRANSFORM>>>>>>
1006
1007 <DEFINE 1?-TEST (NOD WHERE NOTF BRANCH DIR REG NEG
1008                  "AUX" (SBR <NODE-NAME .NOD>) B2 (RW .WHERE) (K <1 <KIDS .NOD>>)
1009                        (SDIR .DIR) (NM <>) (ATYP <ISTYPE? <RESULT-TYPE .K>>)
1010                        (RFLG <MEMQ .ATYP ![FIX FLOAT!]>) (SDIR .DIR))
1011         #DECL ((NOD K) NODE (REG) DATUM)
1012         <SET REG
1013              <MOVE:ARG .REG <DATUM <COND (.ATYP) (ELSE ANY-AC)> ANY-AC>>>
1014         <SET NM <ACRESIDUE <DATVAL .REG>>>
1015         <SET WHERE <UPDATE-WHERE .NOD .WHERE>>
1016         <COND (.BRANCH
1017                <AND .NOTF <SET DIR <NOT .DIR>>>
1018                <COND (<AND .CAREFUL <NOT .RFLG>> <CFFLARG .REG>)>
1019                <VAR-STORE <>>
1020                <COND (<==? .RW FLUSHED>
1021                       <COND (.RFLG
1022                              <GEN-COMP .ATYP
1023                                        .REG
1024                                        .DIR
1025                                        .BRANCH
1026                                        .SBR
1027                                        .NEG
1028                                        .NM>)
1029                             (ELSE
1030                              <GENFLOAT .REG .DIR .BRANCH .NEG>
1031                              <GEN-COMP FIX .REG .DIR .BRANCH .SBR .NEG .NM>)>
1032                       <RET-TMP-AC .REG>)
1033                      (ELSE
1034                       <SET B2 <MAKE:TAG>>
1035                       <COND (.RFLG
1036                              <GEN-COMP .ATYP
1037                                        .REG
1038                                        <NOT .DIR>
1039                                        .B2
1040                                        .SBR
1041                                        .NEG
1042                                        .NM>)
1043                             (ELSE
1044                              <GENFLOAT .REG <NOT .DIR> .B2 .NEG>
1045                              <GEN-COMP FIX .REG <NOT .DIR> .B2 .SBR .NEG .NM>)>
1046                       <RET-TMP-AC .REG>
1047                       <SET RW
1048                            <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
1049                       <BRANCH:TAG .BRANCH>
1050                       <LABEL:TAG .B2>
1051                       .RW)>)
1052               (ELSE
1053                <COND (<AND .CAREFUL <NOT .RFLG>> <CFFLARG .REG>)>
1054                <VAR-STORE <>>
1055                <AND <TYPE? .WHERE ATOM> <SET WHERE <ANY2ACS>>>
1056                <COND (.RFLG
1057                       <GEN-COMP .ATYP
1058                                 .REG
1059                                 .NOTF
1060                                 <SET BRANCH <MAKE:TAG>>
1061                                 .SBR
1062                                 .NEG
1063                                 .NM>)
1064                      (ELSE
1065                       <GENFLOAT .REG .NOTF <SET BRANCH <MAKE:TAG>> .NEG>
1066                       <GEN-COMP FIX .REG .NOTF .BRANCH .SBR .NEG .NM>)>
1067                <RET-TMP-AC .REG>
1068                <MOVE:ARG <REFERENCE T> .WHERE>
1069                <RET-TMP-AC .WHERE>
1070                <BRANCH:TAG <SET B2 <MAKE:TAG>>>
1071                <LABEL:TAG .BRANCH>
1072                <MOVE:ARG <REFERENCE <>> .WHERE>
1073                <LABEL:TAG .B2>
1074                <MOVE:ARG .WHERE .RW>)>>
1075
1076 <SETG AOJS
1077       ![`AOJL  `AOJLE  `AOJG  `AOJGE  `AOJE  `AOJN  `AOJE  `AOJN  `AOJE
1078 `AOJN  `AOJE  `AOJN !]>
1079
1080 <SETG SOJS
1081       ![`SOJL  `SOJLE  `SOJG  `SOJGE  `SOJE  `SOJN  `SOJE  `SOJN  `SOJE
1082 `SOJN  `SOJE  `SOJN !]>
1083
1084 <DEFINE GEN-COMP (TYP REG DIR BR SBR NEG NM)
1085    #DECL ((REG) <DATUM ANY AC> (TYP BR) ATOM)
1086    <COND
1087     (<==? <ISTYPE? .TYP> FIX>
1088      <AND .DIR <SET SBR <FLIP .SBR>>>
1089      <COND (.NM
1090             <EMIT <INSTRUCTION
1091                    <NTH <NTH ,SKIPS <LENGTH <MEMQ .SBR ,CMSUBRS>>>
1092                         <COND (.NEG 1) (ELSE 2)>>
1093                    <ACSYM <DATVAL .REG>>
1094                    <COND (.NEG '[-1]) (ELSE 1)>>>
1095             <BRANCH:TAG .BR>)
1096            (ELSE
1097             <MUNG-AC <DATVAL .REG> .REG>
1098             <EMIT <INSTRUCTION <NTH <COND (.NEG ,AOJS) (ELSE ,SOJS)>
1099                                     <LENGTH <MEMQ .SBR ,CMSUBRS>>>
1100                                <ACSYM <DATVAL .REG>>
1101                                .BR>>)>)
1102     (ELSE
1103      <EMIT <INSTRUCTION <COND (.DIR `CAMN ) (ELSE `CAME )>
1104                         <ACSYM <DATVAL .REG>>
1105                         <COND (.NEG '[-1.0]) (ELSE '[1.0])>>>
1106      <BRANCH:TAG .BR>)>>
1107
1108 <DEFINE GENFLOAT (REG DIR BR NEG)
1109         <EMIT <INSTRUCTION <COND (<NOT .DIR> `CAME ) (ELSE `CAMN )>
1110                            <ACSYM <DATVAL .REG>>
1111                            <COND (.NEG '[-1.0]) (ELSE '[1.0])>>>
1112         <COND (.DIR <BRANCH:TAG .BR>)>>
1113
1114 <DEFINE CFFLARG (DAT "AUX" (LABGOOD <MAKE:TAG>))
1115         #DECL ((DAT) DATUM (LABGOOD) ATOM)
1116         <EMIT <INSTRUCTION GETYP!-OP `O* !<ADDR:TYPE .DAT>>>
1117         <EMIT <INSTRUCTION `CAIE `O* '<TYPE-CODE!-OP!-PACKAGE FLOAT>>>
1118         <EMIT <INSTRUCTION `CAIN `O* '<TYPE-CODE!-OP!-PACKAGE FIX>>>
1119         <DATTYP-FLUSH .DAT>
1120         <BRANCH:TAG .LABGOOD>
1121         <BRANCH:TAG |COMPERR>
1122         <LABEL:TAG .LABGOOD>>
1123
1124 <DEFINE TEST-GEN (NOD WHERE
1125                   "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
1126                   "AUX" (K <1 <KIDS .NOD>>) (K2 <2 <KIDS .NOD>>) REGT REGT2
1127                         (S <SW? <NODE-NAME .NOD>>) TRANSFORM ATYP ATYP2 B2
1128                         (SDIR .DIR) (RW .WHERE) TRANS1 (FLS <==? .RW FLUSHED>)
1129                         TEM (ONO .NO-KILL) (NO-KILL .ONO)
1130                   "ACT" TA)
1131    #DECL ((NOD K K2) NODE (REGT) DATUM (TRANSFORM) <SPECIAL TRANS>
1132           (TRANS1) TRANS (NO-KILL) <SPECIAL LIST>)
1133    <SET WHERE
1134         <COND (<==? .WHERE FLUSHED> FLUSHED)
1135               (ELSE <UPDATE-WHERE .NOD .WHERE>)>>
1136    <COND (<OR <==? <NODE-TYPE .K2> ,QUOTE-CODE>
1137               <AND <NOT <MEMQ <NODE-TYPE .K> ,SNODES>>
1138                    <NOT <SIDE-EFFECTS .NOD>>
1139                    <MEMQ <NODE-TYPE .K2> ,SNODES>>>
1140           <COND (<AND <==? <NODE-TYPE .K> ,LVAL-CODE>
1141                       <COND (<==? <LENGTH <SET TEM <TYPE-INFO .K>>> 2> <2 .TEM>)
1142                             (ELSE T)>
1143                       <SET TEM <NODE-NAME .K>>
1144                       <NOT <MAPF <>
1145                                  <FUNCTION (LL)
1146                                          <AND <==? <1 .LL> .TEM> <MAPLEAVE>>>
1147                                  .NO-KILL>>>
1148                  <SET NO-KILL ((<NODE-NAME .K> <>) !.NO-KILL)>)>
1149           <SET K .K2>
1150           <SET K2 <1 <KIDS .NOD>>>
1151           <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>)>
1152    <SET ATYP <ISTYPE? <RESULT-TYPE .K2>>>
1153    <SET ATYP2 <ISTYPE-GOOD? <RESULT-TYPE .K>>>
1154    <SET REGT
1155         <DATUM <COND (.ATYP .ATYP) (ELSE ANY-AC)> ANY-AC>>
1156    <SET REGT2
1157         <COND (<OR <==? <NODE-TYPE .K> ,QUOTE-CODE>
1158                    <NOT <SIDE-EFFECTS .K2>>>
1159                DONT-CARE)
1160               (.ATYP2 <DATUM .ATYP2 ANY-AC>)
1161               (ELSE <DATUM ANY-AC ANY-AC>)>>
1162    <COND (<N==? <NODE-TYPE .K> ,QUOTE-CODE>
1163           <COND (<OR <==? .ATYP FLOAT> <==? .ATYP2 FLOAT>>)
1164                 (ELSE
1165                  <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>
1166                  <PUT <2 .TRANSFORM> 6 1>
1167                  <PUT <2 .TRANSFORM> 7 0>)>
1168           <SET REGT2 <GEN .K .REGT2>>
1169           <COND (<ASSIGNED? TRANSFORM>
1170                  <SET TRANS1 .TRANSFORM>
1171                  <SET TRANSFORM <UPDATE-TRANS .NOD .TRANS1>>)>
1172           <COND (<TYPE? <DATVAL .REGT2> AC>
1173                  <SET REGT <GEN .K2 DONT-CARE>>
1174                  <COND (<TYPE? <DATVAL .REGT2> AC>
1175                         <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>
1176                         <SET TEM .REGT>
1177                         <SET REGT .REGT2>
1178                         <SET REGT2 .TEM>
1179                         <COND (<ASSIGNED? TRANSFORM>
1180                                <SET TEM .TRANS1>
1181                                <SET TRANS1 .TRANSFORM>
1182                                <SET TRANSFORM .TEM>)>
1183                         <SET TEM .ATYP>
1184                         <SET ATYP .ATYP2>
1185                         <SET ATYP2 .TEM>)
1186                        (ELSE <TOACV .REGT>)>)
1187                 (ELSE <SET REGT <GEN .K2 .REGT>>)>)
1188          (ELSE
1189           <COND (<OR <==? .ATYP FIX>
1190                      <0? <NODE-NAME .K>>
1191                      <1? <NODE-NAME .K>>>
1192                  <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>)>
1193           <COND (<==? .ATYP FIX>
1194                  <PUT <PUT <2 .TRANSFORM> 2 1> 3 <FIX <NODE-NAME .K>>>)>
1195           <COND (<LN-LST .K2> <SET REGT ,NO-DATUM>)
1196                 (ELSE
1197                  <SET REGT <GEN .K2 .REGT>>
1198                  <DATTYP-FLUSH .REGT>
1199                  <PUT .REGT ,DATTYP .ATYP>)>
1200           <RETURN
1201            <TEST-DISP .NOD
1202                       .WHERE
1203                       .NOTF
1204                       .BRANCH
1205                       .DIR
1206                       .REGT
1207                       <COND (<ASSIGNED? TRANSFORM>
1208                              <DO-TRANS <FIX <NODE-NAME .K>> .TRANSFORM>)
1209                             (ELSE <NODE-NAME .K>)>
1210                       <AND <ASSIGNED? TRANSFORM> <NOT <0? <1 <3 .TRANSFORM>>>>>>
1211            .TA>)>
1212    <DELAY-KILL .NO-KILL .ONO>
1213    <AND <ASSIGNED? TRANSFORM>
1214         <CONFORM .REGT .REGT2 .TRANSFORM .TRANS1>
1215         <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>>
1216    <COND (.BRANCH
1217           <AND .NOTF <SET DIR <NOT .DIR>>>
1218           <VAR-STORE <>>
1219           <GEN-COMP2 <NODE-NAME .NOD>
1220                      .ATYP2
1221                      .ATYP
1222                      .REGT2
1223                      .REGT
1224                      <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
1225                      <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE:TAG>>)>>
1226           <COND (<NOT .FLS>
1227                  <SET RW <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
1228                  <BRANCH:TAG .BRANCH>
1229                  <LABEL:TAG .B2>
1230                  .RW)>)
1231          (ELSE
1232           <VAR-STORE <>>
1233           <GEN-COMP2 <NODE-NAME .NOD>
1234                      .ATYP2
1235                      .ATYP
1236                      .REGT2
1237                      .REGT
1238                      .NOTF
1239                      <SET BRANCH <MAKE:TAG>>>
1240           <MOVE:ARG <REFERENCE T> .WHERE>
1241           <RET-TMP-AC .WHERE>
1242           <BRANCH:TAG <SET B2 <MAKE:TAG>>>
1243           <LABEL:TAG .BRANCH>
1244           <MOVE:ARG <REFERENCE <>> .WHERE>
1245           <LABEL:TAG .B2>
1246           <MOVE:ARG .WHERE .RW>)>>
1247
1248 <DEFINE TEST-GEN2 (NOD WHERE NOTF BRANCH DIR REG NUM NEG
1249                    "AUX" (SDIR .DIR) (RW .WHERE) (FLS <==? .RW FLUSHED>) B2
1250                          (SBR <NODE-NAME .NOD>))
1251         #DECL ((NOD) NODE (REG) DATUM (NUM) <OR FIX FLOAT>)
1252         <SET WHERE
1253              <COND (<==? .WHERE FLUSHED> FLUSHED)
1254                    (ELSE <UPDATE-WHERE .NOD .WHERE>)>>
1255         <TOACV .REG>
1256         <COND (.BRANCH
1257                <COND (.NEG <SET SBR <FLOP .SBR>>)>
1258                <AND .NOTF <SET DIR <NOT .DIR>>>
1259                <VAR-STORE <>>
1260                <GEN-COMP2 .SBR
1261                           <TYPE .NUM>
1262                           <ISTYPE? <DATTYP .REG>>
1263                           <REFERENCE .NUM>
1264                           .REG
1265                           <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
1266                           <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE:TAG>>)>>
1267                <COND (<NOT .FLS>
1268                       <SET RW
1269                            <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
1270                       <BRANCH:TAG .BRANCH>
1271                       <LABEL:TAG .B2>
1272                       .RW)>)
1273               (ELSE
1274                <VAR-STORE <>>
1275                <AND .NOTF <SET DIR <NOT .DIR>>>
1276                <COND (.NEG <SET SBR <FLOP .SBR>>)>
1277                <GEN-COMP2 .SBR
1278                           <TYPE .NUM>
1279                           <ISTYPE? <DATTYP .REG>>
1280                           <REFERENCE .NUM>
1281                           .REG
1282                           .NOTF
1283                           <SET BRANCH <MAKE:TAG>>>
1284                <MOVE:ARG <REFERENCE T> .WHERE>
1285                <RET-TMP-AC .WHERE>
1286                <BRANCH:TAG <SET B2 <MAKE:TAG>>>
1287                <LABEL:TAG .BRANCH>
1288                <MOVE:ARG <REFERENCE <>> .WHERE>
1289                <LABEL:TAG .B2>
1290                <MOVE:ARG .WHERE .RW>)>>
1291
1292 <DEFINE GEN-COMP2 (SB T1 T2 R1 R2 D BR)
1293         #DECL ((R1) DATUM (R2) <DATUM ANY AC> (SB T1 T2 BR) ATOM)
1294         <AND .D <SET SB <FLIP .SB>>>
1295         <COND (<==? .T1 .T2>)
1296               (<==? <ISTYPE? .T1> FIX>
1297                <DATTYP-FLUSH <SET R1 <GEN-FLOAT .R1>>>
1298                <PUT .R1 ,DATTYP FLOAT>)
1299               (ELSE
1300                <DATTYP-FLUSH <GEN-FLOAT .R2>>
1301                <PUT .R2 ,DATTYP FLOAT>)>
1302         <OR <TYPE? <DATVAL .R2> AC> <TOACV .R2>>
1303         <PUT <DATVAL .R2> ,ACPROT T>
1304         <IMCHK <NTH ,SKIPS <LENGTH <MEMQ .SB ,CMSUBRS>>>
1305                <ACSYM <DATVAL .R2>>
1306                <DATVAL .R1>>
1307         <RET-TMP-AC .R1>
1308         <RET-TMP-AC .R2>
1309         <BRANCH:TAG .BR>>
1310
1311 <DEFINE GET-DF (S)
1312         #DECL ((S) ATOM)
1313         <NTH '[0 0 1 1 1.7014117E+38 -1.7014117E+38]
1314              <LENGTH <MEMQ .S '![MAX MIN * / - +!]>>>>
1315
1316 <SETG CMSUBRS '![0? N0? 1? N1? -1? N-1? ==? N==? G? G=? L? L=?!]>
1317
1318 <SETG SKIPS
1319       '![(`CAMGE  `CAIGE )
1320          (`CAMG  `CAIG )
1321          (`CAMLE  `CAILE )
1322          (`CAML  `CAIL )
1323          (`CAMN  `CAIN )
1324          (`CAME  `CAIE )
1325          (`CAMN  `CAIN )
1326          (`CAME  `CAIE )
1327          (`CAMN  `CAIN )
1328          (`CAME  `CAIE )
1329          (`CAMN  `CAIN )
1330          (`CAME  `CAIE )!]>
1331
1332 <ENDPACKAGE>