<mdl.comp>/notgen.mud.119

   1 <PACKAGE "NOTGEN">
   2
   3 <ENTRY NOT-GEN TYPE?-GEN ==-GEN>
   4
   5 <USE "CODGEN" "COMCOD" "CHKDCL" "CACS" "COMPDEC">
   6
   7
   8 " Generate NOT code.  This is done in a variety of ways.
   9         1) If NOTs arg is a predicate itself and this is a predicate usage
  10             (flagged by BRANCH arg), just pass through setting the NOTF arg.
  11         2) If NOTs arg is a predicate but a value is needed,
  12             set up a predicate like situation and return NOT of the normal
  13             value.
  14         3) Else just compile and complement result."
  15
  16 <DEFINE NOT-GEN (NOD WHERE
  17                  "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR T)
  18                  "AUX" (P <1 <KIDS .NOD>>) (RW .WHERE)
  19                        (PF <PRED? <NODE-TYPE .P>>) T1 T2 TT (FLG <>))
  20         #DECL ((NOD P) NODE (TT) DATUM)
  21         <SET WHERE <GOODACS .NOD .WHERE>>
  22         <SET NOTF <NOT .NOTF>>
  23         <COND (<AND .BRANCH .PF>
  24                <SET WHERE
  25                     <APPLY <NTH ,GENERATORS <NODE-TYPE .P>>
  26                            .P
  27                            <COND (<==? .RW FLUSHED> FLUSHED) (ELSE .WHERE)>
  28                            .NOTF
  29                            .BRANCH
  30                            .DIR>>)
  31               (<AND .BRANCH <==? .RW FLUSHED>>
  32                <AND .NOTF <SET DIR <NOT .DIR>>>
  33                <SET WHERE <GEN .P .WHERE>>
  34                <VAR-STORE <>>
  35                <D:B:TAG .BRANCH .WHERE .DIR <RESULT-TYPE .P>>)
  36               (.BRANCH
  37                <SET TT <GEN .P DONT-CARE>>
  38                <VAR-STORE <>>
  39                <SET T1 <MAKE:TAG>>
  40                <D:B:TAG .T1 .TT .DIR <RESULT-TYPE .P>>
  41                <RET-TMP-AC .TT>
  42                <SET WHERE <MOVE:ARG <REFERENCE .DIR> .WHERE>>
  43                <BRANCH:TAG .BRANCH>
  44                <LABEL:TAG .T1>)
  45               (<==? .RW FLUSHED> <SET WHERE <GEN .P FLUSHED>>)
  46               (<OR <SET FLG <==? <ISTYPE? <RESULT-TYPE .NOD>> FALSE>>
  47                    <NOT <TYPE-OK? <RESULT-TYPE .NOD> FALSE>>>
  48                <GEN .P FLUSHED>
  49                <SET WHERE <MOVE:ARG <REFERENCE <NOT .FLG>> .WHERE>>)
  50               (.PF
  51                <SET T1 <MAKE:TAG>>
  52                <SET T2 <MAKE:TAG>>
  53                <APPLY <NTH ,GENERATORS <NODE-TYPE .P>>
  54                       .P
  55                       FLUSHED
  56                       .NOTF
  57                       .T1
  58                       .DIR>
  59                <MOVE:ARG <REFERENCE <>> .WHERE>
  60                <BRANCH:TAG .T2>
  61                <LABEL:TAG .T1>
  62                <RET-TMP-AC .WHERE>
  63                <MOVE:ARG <REFERENCE T> .WHERE>
  64                <LABEL:TAG .T2>)
  65               (ELSE
  66                <SET T1 <MAKE:TAG>>
  67                <SET T2 <MAKE:TAG>>
  68                <SET TT <GEN .P DONT-CARE>>
  69                <VAR-STORE <>>
  70                <D:B:TAG .T1 .TT T <RESULT-TYPE .P>>
  71                <RET-TMP-AC .TT>
  72                <MOVE:ARG <REFERENCE T> .WHERE>
  73                <BRANCH:TAG .T2>
  74                <LABEL:TAG .T1>
  75                <RET-TMP-AC .WHERE>
  76                <MOVE:ARG <REFERENCE <>> .WHERE>
  77                <LABEL:TAG .T2>)>
  78         <MOVE:ARG .WHERE .RW>>
  79
  80 <DEFINE PRED? (N) #DECL ((N) FIX) <1? <NTH ,PREDV .N>>>
  81
  82 " Generate code for ==?.  If types are the same then just compare values,
  83 otherwise generate a full comparison."
  84
  85 <DEFINE ==-GEN (NOD WHERE
  86                 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
  87                 "AUX" (K <KIDS .NOD>) REG REG2 B2 T2OK T2 T1
  88                       (T1OK <ISTYPE? <RESULT-TYPE <1 .K>>>)
  89                       (TYPSAM
  90                        <AND <==? .T1OK
  91                                  <SET T2OK <ISTYPE? <RESULT-TYPE <2 .K>>>>>
  92                             .T1OK>) (RW .WHERE) (SDIR .DIR)
  93                       (FLS <==? .RW FLUSHED>) INA)
  94         #DECL ((NOD) NODE (K) <LIST [REST NODE]>)
  95         <COND (<==? <NODE-SUBR .NOD> ,N==?> <SET NOTF <NOT .NOTF>>)>
  96         <AND <NOT .TYPSAM>
  97              .T1OK
  98              .T2OK
  99              <MESSAGE WARNING
 100                       " ARGS CAN NEVER BE EQUAL "
 101                       <NODE-NAME .NOD>
 102                       " "
 103                       .NOD>>
 104         <COND (<OR <==? <NODE-TYPE <SET T1 <1 .K>>> ,QUOTE-CODE>
 105                    <AND <NOT <SIDE-EFFECTS .NOD>>
 106                         <N==? <NODE-TYPE <SET T2 <2 .K>>> ,QUOTE-CODE>
 107                         <MEMQ <NODE-TYPE .T1> ,SNODES>
 108                         <OR <N==? <NODE-TYPE .T2> ,LVAL-CODE>
 109                             <AND <==? <NODE-TYPE .T1> ,LVAL-CODE>
 110                                  <SET INA <INACS <NODE-NAME .T2>>>
 111                                  <TYPE? <DATVAL .INA> AC>>>>>
 112                <PUT .K 1 <2 .K>>
 113                <PUT .K 2 .T1>
 114                <SET T1 .T1OK>
 115                <SET T1OK .T2OK>
 116                <SET T2OK .T1>)>
 117         <SET WHERE <UPDATE-WHERE .NOD .WHERE>>
 118         <SET REG
 119              <COND (<ISTYPE-GOOD? .T1OK> <DATUM .T1OK ANY-AC>)
 120                    (ELSE <DATUM ANY-AC ANY-AC>)>>
 121         <SET REG2 DONT-CARE>
 122         <COND (.BRANCH
 123                <AND .NOTF <SET DIR <NOT .DIR>>>
 124                <GEN-EQTST .REG
 125                           .REG2
 126                           <1 .K>
 127                           <2 .K>
 128                           .T1OK
 129                           .T2OK
 130                           <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
 131                           .TYPSAM
 132                           <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE:TAG>>)>>
 133                <COND (<NOT .FLS>
 134                       <SET RW
 135                            <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
 136                       <BRANCH:TAG .BRANCH>
 137                       <LABEL:TAG .B2>
 138                       .RW)>)
 139               (ELSE
 140                <SET BRANCH <MAKE:TAG>>
 141                <GEN-EQTST .REG
 142                           .REG2
 143                           <1 .K>
 144                           <2 .K>
 145                           .T1OK
 146                           .T2OK
 147                           .NOTF
 148                           .TYPSAM
 149                           .BRANCH>
 150                <MOVE:ARG <REFERENCE T> .WHERE>
 151                <RET-TMP-AC .WHERE>
 152                <BRANCH:TAG <SET B2 <MAKE:TAG>>>
 153                <LABEL:TAG .BRANCH>
 154                <MOVE:ARG <REFERENCE <>> .WHERE>
 155                <LABEL:TAG .B2>
 156                <MOVE:ARG .WHERE .RW>)>>
 157
 158 <DEFINE GEN-EQTST (R11 R21 N1 N2 T1 T2 DIR TYPS BR "AUX" (TMP <>) AC R1 R2)
 159    #DECL ((N1 N2) NODE (R1 R2) DATUM (AC) AC)
 160    <SET R1 <GEN .N1 .R11>>
 161    <SET R2 <GEN .N2 .R21>>
 162    <VAR-STORE <>>
 163    <COND (<TYPE? <DATVAL .R1> AC>)
 164          (<TYPE? <DATVAL .R2> AC>
 165           <SET R11 .R1>
 166           <SET R1 .R2>
 167           <SET R2 .R11>
 168           <SET R11 .T1>
 169           <SET T1 .T2>
 170           <SET T2 .R11>)>
 171    <TOACV .R1>
 172    <AND <TYPE? <DATVAL .R2> AC>
 173         <PUT <SET TMP <DATVAL .R2>> ,ACPROT T>>
 174    <PUT <DATVAL .R1> ,ACPROT T>
 175    <COND (.TYPS
 176           <IMCHK <COND (.DIR '(`CAMN  `CAIN )) (ELSE '(`CAME  `CAIE ))>
 177                  <ACSYM <DATVAL .R1>>
 178                  <DATVAL .R2>>)
 179          (ELSE
 180           <COND (.T2
 181                  <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O  !<ADDR:TYPE .R1>>>)
 182                 (.T1
 183                  <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O  !<ADDR:TYPE .R2>>>)
 184                 (ELSE
 185                  <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O  !<ADDR:TYPE .R2>>>
 186                  <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
 187                                     <ACSYM <SET AC <GETREG <>>>>
 188                                     !<ADDR:TYPE .R1>>>)>
 189           <IMCHK '(`CAMN  `CAIN ) <ACSYM <DATVAL .R1>> <DATVAL .R2>>
 190           <EMIT <INSTRUCTION
 191                  `CAIE
 192                  `O
 193                  <COND (.T1 <FORM TYPE-CODE!-OP!-PACKAGE .T1>)
 194                        (.T2 <FORM TYPE-CODE!-OP!-PACKAGE .T2>)
 195                        (ELSE (<ADDRSYM .AC>))>>>
 196           <AND .DIR <EMIT '<`SKIPA >>>)>
 197    <BRANCH:TAG .BR>
 198    <RET-TMP-AC .R1>
 199    <RET-TMP-AC .R2>
 200    <AND <TYPE? .TMP AC> <PUT .TMP ,ACPROT <>>>>
 201
 202 "       Generate TYPE? code for all various cases."
 203
 204 <DEFINE TYPE?-GEN (NOD WHERE
 205                    "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
 206                    "AUX" B2 REG (RW .WHERE) (K <KIDS .NOD>) (SDIR .DIR)
 207                          (FLS <==? .RW FLUSHED>) B3 (TEST? T))
 208    #DECL ((NOD) NODE (K) <LIST [REST NODE]> (REG) DATUM
 209           (WHERE BRANCH B2 B3) ANY)
 210    <COND (<==? <RESULT-TYPE .NOD> FALSE>
 211           <MESSAGE WARNING "TYPE? NEVER TRUE " .NOD>
 212           <SET TEST? #FALSE (1)>)
 213          (<NOT <TYPE-OK? <RESULT-TYPE .NOD> FALSE>>
 214           <MESSAGE WARNING "TYPE? ALWAYS TRUE " .NOD>
 215           <SET TEST? #FALSE (2)>)>
 216                                 ;"Type of false indicates always true or false"
 217    <SET REG
 218         <GEN <1 .K> <COND (<AND <NOT .TEST?> .FLS> FLUSHED) (ELSE DONT-CARE)>>>
 219    <AND .NOTF <SET DIR <NOT .DIR>>>
 220    <SET K <REST .K>>
 221    <VAR-STORE <>>
 222    <COND (<OR .TEST?
 223               <AND <NOT .FLS> <NOT <EMPTY? <REST .K>>> <==? <1 .TEST?> 2>>>
 224           <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O*  !<ADDR:TYPE .REG>>>)>
 225    <RET-TMP-AC .REG>
 226    <COND
 227     (<AND .BRANCH .FLS>                                ;"In a COND, OR or AND?"
 228      <AND <NOT <EMPTY? <REST .K>>> <NOT .DIR> <SET B2 <MAKE:TAG>>>
 229      <REPEAT ()
 230              <COND
 231               (<EMPTY? <REST .K>>
 232                <COND (.TEST? <TYPINS .DIR <1 .K>>)>
 233                <COND (<OR .TEST?
 234                           <AND .DIR <==? <1 .TEST?> 2>>
 235                           <AND <NOT .DIR> <==? <1 .TEST?> 1>>>
 236                       <BRANCH:TAG .BRANCH>)>
 237                <AND <ASSIGNED? B2> <LABEL:TAG .B2>>
 238                <RETURN>)
 239               (ELSE
 240                <COND (.TEST?
 241                       <TYPINS <> <1 .K>>
 242                       <TYPINS T <2 .K>>
 243                       <BRANCH:TAG <COND (.DIR .BRANCH) (ELSE .B2)>>)>
 244                <COND (<EMPTY? <SET K <REST .K 2>>>
 245                       <COND (<OR <AND <NOT .DIR> .TEST?>
 246                                  <AND <NOT .TEST?>
 247                                       <OR <AND .DIR <==? <1 .TEST?> 2>>
 248                                           <AND <NOT .DIR>
 249                                                <==? <1 .TEST?> 1>>>>>
 250                              <BRANCH:TAG .BRANCH>
 251                              <LABEL:TAG .B2>)>
 252                       <RETURN>)>)>>)
 253     (<AND .FLS <NOT .TEST?> <NOT .BRANCH>>)
 254     (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
 255      <SET WHERE <GOODACS .NOD .WHERE>>
 256      <SET B2 <MAKE:TAG>>
 257      <SET B3 <MAKE:TAG>>
 258      <COND (.TEST?
 259             <REPEAT ()
 260                     <COND (<EMPTY? <REST .K>>
 261                            <TYPINS <COND (.BRANCH <NOT .DIR>) (ELSE .DIR)>
 262                                    <1 .K>>
 263                            <RETURN>)
 264                           (ELSE
 265                            <TYPINS <> <1 .K>>
 266                            <TYPINS T <2 .K>>
 267                            <COND (<EMPTY? <SET K <REST .K 2>>>
 268                                   <AND <N==? <NOT .BRANCH> .DIR>
 269                                        <EMIT '<`SKIPA >>>
 270                                   <RETURN>)>)>
 271                     <BRANCH:TAG <OR <AND .BRANCH .NOTF .B3> .B2>>>
 272             <BRANCH:TAG .B2>
 273             <LABEL:TAG .B3>
 274             <COND (.BRANCH
 275                    <MOVE:ARG <REFERENCE .SDIR> .WHERE>
 276                    <BRANCH:TAG .BRANCH>
 277                    <LABEL:TAG .B2>)
 278                   (ELSE <TRUE-FALSE .NOD .BRANCH .WHERE>)>)
 279            (ELSE
 280             <COND (.BRANCH
 281                    <COND (<OR <AND .DIR <==? <1 .TEST?> 2>>
 282                               <AND <NOT .DIR> <==? <1 .TEST?> 1>>>
 283                           <MOVE:ARG <REFERENCE .SDIR> .WHERE>
 284                           <BRANCH:TAG .BRANCH>)>)
 285                   (ELSE <MOVE:ARG <==? <1 .TEST?> 2> .WHERE>)>)>)
 286     (ELSE
 287      <SET WHERE <GOODACS .NOD .WHERE>>
 288      <SET B2 <MAKE:TAG>>
 289      <SET REG <REG? ATOM .WHERE>>
 290      <COND
 291       (<OR .TEST? <AND <G=? <LENGTH .K> 2> <==? <1 .TEST?> 2>>>
 292        <MAPR <>
 293              <FUNCTION (TYL "AUX" (TY <1 .TYL>))
 294                      <COND (<NOT <AND <NOT .TEST?> <EMPTY? <REST .TYL>>>>
 295                             <TYPINS <> .TY>
 296                             <BRANCH:TAG <SET B3 <MAKE:TAG>>>)>
 297                      <MOVE:ARG <REFERENCE <NODE-NAME .TY>> .REG>
 298                      <COND (<EMPTY? <REST .TYL>>
 299                             <LABEL:TAG .B2>
 300                             <RET-TMP-AC <MOVE:ARG .REG .WHERE>>
 301                             <COND (.BRANCH
 302                                    <BRANCH:TAG .BRANCH>
 303                                    <LABEL:TAG .B3>)
 304                                   (ELSE
 305                                    <BRANCH:TAG <SET B2 <MAKE:TAG>>>
 306                                    <LABEL:TAG .B3>
 307                                    <MOVE:ARG <REFERENCE <>> .WHERE>
 308                                    <LABEL:TAG .B2>)>)
 309                            (ELSE
 310                             <RET-TMP-AC .REG>
 311                             <BRANCH:TAG .B2>
 312                             <LABEL:TAG .B3>)>>
 313              .K>)
 314       (ELSE
 315        <COND
 316         (.BRANCH
 317          <COND (<OR <AND .DIR <==? <1 .TEST?> 2>>
 318                     <AND <NOT .DIR> <==? <1 .TEST?> 1>>>
 319                 <MOVE:ARG <REFERENCE <AND .DIR <NODE-NAME <1 .K>>>> .WHERE>
 320                 <BRANCH:TAG .BRANCH>)>)
 321         (ELSE <MOVE:ARG <REFERENCE <AND .DIR <NODE-NAME <1 .K>>>> .WHERE>)>)>)>
 322    <MOVE:ARG .WHERE .RW>>
 323
 324 <DEFINE TYPINS (DIR N)
 325         #DECL ((N) NODE)
 326         <EMIT <INSTRUCTION <COND (.DIR `CAIN ) (ELSE `CAIE )>
 327                            <FORM TYPE-CODE!-OP!-PACKAGE <NODE-NAME .N>>>>>
 328 \f
 329 <ENDPACKAGE>
 330 \ 3\ 3