mim/development/mim/mimc/notgen.mud

   1
   2 <PACKAGE "NOTGEN">
   3
   4 <ENTRY NOT-GEN
   5        TYPE?-GEN
   6        ==-GEN
   7        PRED-BRANCH-GEN
   8        TYPE-C-GEN
   9        VALID-TYPE?-GEN
  10        =?-STRING-GEN
  11        ATOM-PART-GEN
  12        OFFSET-PART-GEN
  13        PUT-GET-DECL-GEN
  14        SUBSTRUC-GEN>
  15
  16 <USE "COMPDEC"
  17      "MIMGEN"
  18      "CODGEN"
  19      "CHKDCL"
  20      "CARGEN"
  21      "STRGEN"
  22      "ADVMESS"
  23      "LNQGEN"
  24      "MMQGEN"
  25      "MAPGEN"
  26      "NEWREP">
  27
  28 " Generate NOT code.  This is done in a variety of ways.
  29         1) If NOTs arg is a predicate itself and this is a predicate usage
  30             (flagged by BRANCH arg), just pass through setting the NOTF arg.
  31         2) If NOTs arg is a predicate but a value is needed,
  32             set up a predicate like situation and return NOT of the normal
  33             value.
  34         3) Else just compile and complement result."
  35
  36 <DEFINE NOT-GEN (NOD WHERE
  37                  "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR T) (SETF <>)
  38                  "AUX" (P <1 <KIDS .NOD>>) (RW .WHERE)
  39                        (PF <PRED-CHECK? .P .DIR .WHERE>) T1 T2 TT (FLG <>))
  40         #DECL ((NOD P) NODE)
  41         <SET NOTF <NOT .NOTF>>
  42         <COND (<AND .BRANCH .PF>
  43                <SET WHERE
  44                     <PGEN-DISPATCH .P
  45                                    <COND (<==? .RW FLUSHED> FLUSHED)
  46                                          (ELSE .WHERE)>
  47                                    .NOTF
  48                                    .BRANCH
  49                                    .DIR
  50                                    .SETF>>)
  51               (<AND .BRANCH <==? .RW FLUSHED>>
  52                <AND .NOTF <SET DIR <NOT .DIR>>>
  53                <SET WHERE <GEN .P DONT-CARE>>
  54                <D-B-TAG .BRANCH .WHERE .DIR <RESULT-TYPE .P>>)
  55               (.BRANCH
  56                <SET TT <GEN .P DONT-CARE>>
  57                <SET T1 <MAKE-TAG>>
  58                <D-B-TAG .T1 .TT .DIR <RESULT-TYPE .P>>
  59                <FREE-TEMP .TT>
  60                <SET WHERE <MOVE-ARG <REFERENCE .DIR> .WHERE>>
  61                <BRANCH-TAG .BRANCH>
  62                <LABEL-TAG .T1>
  63                <COND (.SETF
  64                       <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .DIR>> .WHERE>>)>)
  65               (<==? .RW FLUSHED> <SET WHERE <GEN .P FLUSHED>>)
  66               (<OR <SET FLG <==? <ISTYPE? <RESULT-TYPE .NOD>> FALSE>>
  67                    <NOT <TYPE-OK? <RESULT-TYPE .NOD> FALSE>>>
  68                <GEN .P FLUSHED>
  69                <SET WHERE <MOVE-ARG <REFERENCE <NOT .FLG>> .WHERE>>)
  70               (.PF
  71                <SET T1 <MAKE-TAG>>
  72                <SET T2 <MAKE-TAG>>
  73                <PGEN-DISPATCH .P FLUSHED .NOTF .T1 .DIR .SETF>
  74                <COND (<NOT <TYPE? .WHERE TEMP>> <SET WHERE <GEN-TEMP <>>>)>
  75                <MOVE-ARG <REFERENCE <>> .WHERE>
  76                <BRANCH-TAG .T2>
  77                <LABEL-TAG .T1>
  78                <DEALLOCATE-TEMP .WHERE>
  79                <MOVE-ARG <REFERENCE T> .WHERE>
  80                <LABEL-TAG .T2>)
  81               (ELSE
  82                <SET T1 <MAKE-TAG>>
  83                <SET T2 <MAKE-TAG>>
  84                <SET TT <GEN .P DONT-CARE>>
  85                <D-B-TAG .T1 .TT T <RESULT-TYPE .P>>
  86                <FREE-TEMP .TT>
  87                <COND (<NOT <TYPE? .WHERE TEMP>> <SET WHERE <GEN-TEMP <>>>)>
  88                <MOVE-ARG <REFERENCE T> .WHERE>
  89                <BRANCH-TAG .T2>
  90                <LABEL-TAG .T1>
  91                <DEALLOCATE-TEMP .WHERE>
  92                <MOVE-ARG <REFERENCE <>> .WHERE>
  93                <LABEL-TAG .T2>)>
  94         <MOVE-ARG .WHERE .RW>>
  95
  96 <DEFINE PRED? (N) #DECL ((N) FIX) <N==? <NTH ,PREDV .N> 0>>
  97
  98 <DEFINE PRED-CHECK? (N TF W "AUX" SY K NN NT)
  99    #DECL ((N) NODE (SY) SYMTAB)
 100    <OR
 101     <N==? <NTH ,PREDV <NODE-TYPE .N>> 0>
 102     <AND <==? <SET NT <NODE-TYPE .N>> ,CALL-CODE>
 103          <G=? <LENGTH <SET K <KIDS .N>>> 2>
 104          <OR <AND <OR .TF <==? .W FLUSHED>> <==? <NODE-NAME <1 .K>> `SYSOP>>
 105              <=? <SPNAME <NODE-NAME <1 .K>>> "STRING-EQUAL?">>>
 106     <AND <==? .NT ,SET-CODE>
 107          <==? .W FLUSHED>
 108          <NOT <SPEC-SYM <SET SY <NODE-NAME .N>>>>
 109          <==? <NTH ,PREDV <NODE-TYPE <2 <KIDS .N>>>> 1>>
 110     <AND
 111      <OR
 112       <==? .NT ,PROG-CODE>
 113       <AND <==? .NT ,MAP-CODE>
 114            <==? <NODE-TYPE <SET NN <1 <SET K <KIDS .N>>>>> ,QUOTE-CODE>
 115            <NOT <NODE-NAME .NN>>
 116            <==? <NODE-TYPE <SET N <2 .K>>> ,MFCN-CODE>
 117            <OR <==? <ISTYPE? <SET NT <RESULT-TYPE .N>>> FALSE>
 118                <NOT <TYPE-AND .NT FALSE>>>
 119            <NOT <MAPF <>
 120                  <FUNCTION (X:NODE)
 121                          <COND (<OR <==? <SET NT <NODE-TYPE .X>> ,SEGMENT-CODE>
 122                                     <==? .NT ,SEG-CODE>>
 123                                 <MAPLEAVE T>)>>
 124                  <REST .K 2>>>>>
 125      <NOT <ACTIVATED .N>>
 126      <NOT <ACTIV? <BINDING-STRUCTURE .N>>>
 127      <==? .W FLUSHED>
 128      <NOT
 129       <MAPF <>
 130        <FUNCTION (SYM:SYMTAB "AUX" NN)
 131                <COND (<OR <SPEC-SYM .SYM>
 132                           <AND <SET NN <INIT-SYM .SYM>>
 133                                <OR <==? <SET NT <NODE-TYPE .NN>> ,STACK-CODE>
 134                                    <AND <==? .NT ,COPY-CODE>
 135                                         <==? <NODE-NAME .NN> TUPLE>>
 136                                    <AND <OR <==? .NT ,ISTRUC-CODE>
 137                                             <==? .NT ,ISTRUC2-CODE>>
 138                                         <==? <NODE-NAME .NN> ITUPLE>>>>>
 139                       <MAPLEAVE T>)>>
 140        <BINDING-STRUCTURE .N>>>>>>
 141
 142 " Generate code for ==?.  If types are the same then just compare values,
 143 otherwise generate a full comparison."
 144
 145 <DEFINE ==-GEN (NOD WHERE
 146                 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
 147                 "AUX" (K <KIDS .NOD>) REG REG2 B2 T2OK T2 T1
 148                       (TY1 <RESULT-TYPE <1 .K>>) (TY2 <RESULT-TYPE <2 .K>>)
 149                       (T1OK <ISTYPE? .TY1>)
 150                       (TYPSAM
 151                        <AND
 152                         <OR <==? .T1OK <SET T2OK <ISTYPE? .TY2>>>
 153                             <==? <GETPROP .T1OK ALT-DECL '.T1OK>
 154                                  <GETPROP .T2OK ALT-DECL '.T2OK>>>
 155                         .T1OK>) (RW .WHERE) (SDIR .DIR) (FLS <==? .RW FLUSHED>)
 156                       INA)
 157         #DECL ((NOD) NODE (K) <LIST [REST NODE]>)
 158         <COND (<AND <NOT .TYPSAM>
 159                     <NOT <TYPE-OK? .TY1 '<PRIMTYPE FIX>>>
 160                     <NOT <TYPE-OK? .TY2 '<PRIMTYPE FIX>>>
 161                     <NOT <POINTER-OVERLAP? .TY1 .TY2>>>
 162                <SET TYPSAM T>)>
 163         <COND (<==? <NODE-SUBR .NOD> ,N==?> <SET NOTF <NOT .NOTF>>)>
 164         <AND <NOT .TYPSAM>
 165              <NOT <TYPE-OK? .TY1 .TY2>>
 166              <COMPILE-WARNING "Arguments can never be ==? "
 167                               <NODE-NAME .NOD>
 168                               .NOD>>
 169         <COND (<OR <==? <NODE-TYPE <SET T1 <1 .K>>> ,QUOTE-CODE>
 170                    <AND <NOT <SIDE-EFFECTS .NOD>>
 171                         <N==? <NODE-TYPE <SET T2 <2 .K>>> ,QUOTE-CODE>
 172                         <MEMQ <NODE-TYPE .T1> ,SNODES>
 173                         <N==? <NODE-TYPE .T2> ,LVAL-CODE>>>
 174                <PUT .K 1 <2 .K>>
 175                <PUT .K 2 .T1>
 176                <SET T1 .T1OK>
 177                <SET T1OK .T2OK>
 178                <SET T2OK .T1>)>
 179         <COND (.BRANCH
 180                <AND .NOTF <SET DIR <NOT .DIR>>>
 181                <COND (.SETF
 182                       <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
 183                <GEN-EQTST <1 .K>
 184                           <2 .K>
 185                           .T1OK
 186                           .T2OK
 187                           <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
 188                           .TYPSAM
 189                           <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE-TAG>>)>>
 190                <COND (<NOT .FLS>
 191                       <SET RW
 192                            <MOVE-ARG <MOVE-ARG <REFERENCE .SDIR> .WHERE> .RW>>
 193                       <BRANCH-TAG .BRANCH>
 194                       <LABEL-TAG .B2>
 195                       .RW)>)
 196               (ELSE
 197                <SET BRANCH <MAKE-TAG>>
 198                <GEN-EQTST <1 .K> <2 .K> .T1OK .T2OK .NOTF .TYPSAM .BRANCH>
 199                <COND (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP <>>>)>
 200                <MOVE-ARG <REFERENCE T> .WHERE>
 201                <DEALLOCATE-TEMP .WHERE>
 202                <BRANCH-TAG <SET B2 <MAKE-TAG>>>
 203                <LABEL-TAG .BRANCH>
 204                <MOVE-ARG <REFERENCE <>> .WHERE>
 205                <LABEL-TAG .B2>
 206                <MOVE-ARG .WHERE .RW>)>>
 207
 208 <DEFINE GEN-EQTST (N1 N2 T1 T2 DIR TYPS BR "AUX" (TMP <>) R1 R2)
 209         #DECL ((N1 N2) NODE)
 210         <SET R1 <GEN .N1>>
 211         <SET R2 <GEN .N2>>
 212         <COND (.TYPS <GEN-VAL-==? .R1 .R2 .DIR .BR>)
 213               (ELSE <GEN-==? .R1 .R2 .DIR .BR>)>
 214         <FREE-TEMP .R1>
 215         <FREE-TEMP .R2>>
 216
 217 <DEFINE POINTER-OVERLAP? (TY1 TY2 "AUX" TEM)
 218         <COND (<AND <TYPE? .TY1 FORM SEGMENT>
 219                     <NOT <EMPTY? .TY1>>
 220                     <==? <1 .TY1> OR>>
 221                <MAPF <>
 222                      <FUNCTION (EL)
 223                           <COND (<POINTER-OVERLAP? .TY2 .EL>
 224                                  <MAPLEAVE T>)>>
 225                      <REST .TY1>>)
 226               (<AND <TYPE? .TY2 FORM SEGMENT>
 227                     <NOT <EMPTY? .TY2>>
 228                     <==? <1 .TY2> OR>>
 229                <MAPF <>
 230                      <FUNCTION (EL)
 231                           <COND (<POINTER-OVERLAP? .TY1 .EL>
 232                                  <MAPLEAVE T>)>>
 233                      <REST .TY2>>)
 234               (<OR <AND <TYPE? .TY1 FORM SEGMENT> <NOT <EMPTY? .TY1>>>
 235                    <AND <TYPE? .TY2 FORM SEGMENT>
 236                         <NOT <EMPTY? .TY2>>
 237                         <SET TEM .TY1>
 238                         <SET TY1 .TY2>
 239                         <SET TY2 .TEM>>>
 240                <COND (<OR <==? <1 .TY1> PRIMTYPE>
 241                           <AND <TYPE? <SET TEM <1 .TY1>> FORM SEGMENT>
 242                                <NOT <EMPTY? .TEM>>
 243                                <==? <1 .TEM> PRIMTYPE>
 244                                <SET TY1 .TEM>>>
 245                       <COND (<==? <STRUCTYP .TY2> <2 .TY1>> T)
 246                             (ELSE <>)>)
 247                      (ELSE
 248                       <POINTER-OVERLAP? <1 .TY1> .TY2>)>)
 249               (<==? .TY1 .TY2> <>)
 250               (<OR <NOT <STRUCTYP .TY1>>
 251                    <NOT <STRUCTYP .TY2>>
 252                    <==? <STRUCTYP .TY1> <STRUCTYP .TY2>>>
 253                T)
 254               (ELSE <>)>>
 255
 256
 257 "       Generate TYPE? code for all various cases."
 258
 259 <DEFINE TYPE?-GEN (NOD WHERE
 260                    "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
 261                    "AUX" B2 REG (RW .WHERE) (K <KIDS .NOD>) (SDIR .DIR)
 262                          (FLS <==? .RW FLUSHED>) B3 (TEST? T) (FIRST T))
 263    #DECL ((NOD) NODE (K) <LIST [REST NODE]> (WHERE BRANCH B2 B3) ANY)
 264    <COND (<==? <RESULT-TYPE .NOD> FALSE>
 265           <COMPILE-WARNING "TYPE? never true: " .NOD>
 266           <SET TEST? #FALSE (1)>)
 267          (<NOT <TYPE-OK? <RESULT-TYPE .NOD> FALSE>>
 268           <COMPILE-WARNING "TYPE? always true: " .NOD>
 269           <SET TEST? #FALSE (2)>)>
 270    <SET REG <GEN <1 .K> DONT-CARE>>
 271    <AND .NOTF <SET DIR <NOT .DIR>>>
 272    <SET K <REST .K>>
 273    <COND
 274     (<AND .BRANCH .FLS>
 275      <AND <NOT <EMPTY? <REST .K>>> <NOT .DIR> <SET B2 <MAKE-TAG>>>
 276      <REPEAT ()
 277              <COND
 278               (<EMPTY? <REST .K>>
 279                <FREE-TEMP .REG <>>
 280                <COND (.TEST? <GEN-TYPE? .REG <NODE-NAME <1 .K>> .BRANCH .DIR>)>
 281                <COND (<OR <AND <NOT .TEST?> .DIR <==? <1 .TEST?> 2>>
 282                           <AND <NOT .TEST?> <NOT .DIR> <==? <1 .TEST?> 1>>>
 283                       <BRANCH-TAG .BRANCH>)>
 284                <AND <ASSIGNED? B2> <LABEL-TAG .B2>>
 285                <RETURN>)
 286               (ELSE
 287                <COND (.TEST?
 288                       <GEN-TYPE? .REG
 289                                  <NODE-NAME <1 .K>>
 290                                  <COND (.DIR .BRANCH) (ELSE .B2)>
 291                                  T>
 292                       <GEN-TYPE? .REG
 293                                  <NODE-NAME <2 .K>>
 294                                  <COND (.DIR .BRANCH) (ELSE .B2)>
 295                                  T>)>
 296                <COND (<EMPTY? <SET K <REST .K 2>>>
 297                       <COND (<OR <AND <NOT .DIR> .TEST?>
 298                                  <AND <NOT .TEST?>
 299                                       <OR <AND .DIR <==? <1 .TEST?> 2>>
 300                                           <AND <NOT .DIR>
 301                                                <==? <1 .TEST?> 1>>>>>
 302                              <BRANCH-TAG .BRANCH>
 303                              <LABEL-TAG .B2>)>
 304                       <RETURN>)>)>>)
 305     (<AND .FLS <NOT .TEST?> <NOT .BRANCH>>)
 306     (<OR .NOTF <AND <NOT <==? <NOT .BRANCH> <NOT .DIR>>> <NOT .SETF>>>
 307      <SET B2 <MAKE-TAG>>
 308      <SET B3 <MAKE-TAG>>
 309      <COND
 310       (.TEST?
 311        <COND (.SETF
 312               <COND (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP <>>>)>
 313               <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .WHERE>>)>
 314        <REPEAT ()
 315                <COND (<EMPTY? <REST .K>>
 316                       <FREE-TEMP .REG <>>
 317                       <GEN-TYPE? .REG
 318                                  <NODE-NAME <1 .K>>
 319                                  .B2
 320                                  <COND (.BRANCH <NOT .DIR>) (ELSE .DIR)>>
 321                       <RETURN>)
 322                      (ELSE
 323                       <GEN-TYPE? .REG
 324                                  <NODE-NAME <1 .K>>
 325                                  <COND (<COND (.BRANCH <NOT .DIR>) (ELSE .DIR)>
 326                                         .B2)
 327                                        (ELSE .B3)>
 328                                  T>
 329                       <GEN-TYPE? .REG
 330                                  <NODE-NAME <2 .K>>
 331                                  <COND (<COND (.BRANCH <NOT .DIR>) (ELSE .DIR)>
 332                                         .B2)
 333                                        (ELSE .B3)>
 334                                  T>
 335                       <COND (<EMPTY? <SET K <REST .K 2>>>
 336                              <COND (<COND (.BRANCH .DIR) (ELSE <NOT .DIR>)>
 337                                     <BRANCH-TAG .B2>)>
 338                              <RETURN>)>)>>
 339        <LABEL-TAG .B3>
 340        <COND (<==? .WHERE DONT-CARE> <SET WHERE <GEN-TEMP <>>>)>
 341        <COND (.BRANCH
 342               <SET WHERE <MOVE-ARG <REFERENCE .SDIR> .WHERE>>
 343               <BRANCH-TAG .BRANCH>
 344               <LABEL-TAG .B2>)
 345              (ELSE <TRUE-FALSE .NOD .B2 .WHERE>)>)
 346       (ELSE
 347        <COND (.BRANCH
 348               <COND (<OR <AND .DIR <==? <1 .TEST?> 2>>
 349                          <AND <NOT .DIR> <==? <1 .TEST?> 1>>>
 350                      <SET WHERE <MOVE-ARG <REFERENCE .SDIR> .WHERE>>
 351                      <BRANCH-TAG .BRANCH>)>)
 352              (ELSE <SET WHERE <MOVE-ARG <==? <1 .TEST?> 2> .WHERE>>)>)>)
 353     (ELSE
 354      <COND (<NOT <TYPE? .WHERE TEMP>>
 355             <COND (<AND <TYPE? .REG TEMP>
 356                         <==? <LENGTH .K> 1>
 357                         <L=? <TEMP-REFS .REG> 1>>
 358                    <SET WHERE .REG>)
 359                   (ELSE <SET WHERE <GEN-TEMP <>>>)>)>
 360      <SET B2 <MAKE-TAG>>
 361      <COND
 362       (<OR .TEST? <AND <G=? <LENGTH .K> 2> <==? <1 .TEST?> 2>>>
 363        <COND (.SETF
 364               <DEALLOCATE-TEMP <SET WHERE <MOVE-ARG <REFERENCE <>> .WHERE>>>)>
 365        <MAPR <>
 366         <FUNCTION (TYL "AUX" (TY <1 .TYL>))
 367            <COND (<NOT <AND <NOT .TEST?> <EMPTY? <REST .TYL>>>>
 368                   <GEN-TYPE?
 369                    .REG
 370                    <NODE-NAME .TY>
 371                    <COND (<OR <NOT .BRANCH> .DIR <NOT <EMPTY? <REST .TYL>>>>
 372                           <SET B3 <MAKE-TAG>>)
 373                          (ELSE .BRANCH)>
 374                    <>>)>
 375            <SET WHERE <MOVE-ARG <REFERENCE <NODE-NAME .TY>> .WHERE>>
 376            <COND (<NOT .FIRST> <DEALLOCATE-TEMP .WHERE>) (ELSE <SET FIRST <>>)>
 377            <COND
 378             (<EMPTY? <REST .TYL>>
 379              <LABEL-TAG .B2>
 380              <COND (<AND .BRANCH .DIR> <BRANCH-TAG .BRANCH> <LABEL-TAG .B3>)
 381                    (<NOT .BRANCH>
 382                     <BRANCH-TAG <SET B2 <MAKE-TAG>>>
 383                     <LABEL-TAG .B3>
 384                     <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <>> .WHERE>>
 385                     <LABEL-TAG .B2>)>
 386              <FREE-TEMP .REG <>>)
 387             (ELSE <BRANCH-TAG .B2> <LABEL-TAG .B3>)>>
 388         .K>)
 389       (ELSE
 390        <COND
 391         (.BRANCH
 392          <COND (<OR <AND .DIR <==? <1 .TEST?> 2>>
 393                     <AND <NOT .DIR> <==? <1 .TEST?> 1>>>
 394                 <SET WHERE
 395                      <MOVE-ARG <REFERENCE <AND .DIR <NODE-NAME <1 .K>>>>
 396                                .WHERE>>
 397                 <BRANCH-TAG .BRANCH>)>)
 398         (ELSE
 399          <SET WHERE
 400               <MOVE-ARG <REFERENCE <AND .DIR <NODE-NAME <1 .K>>>>
 401                         .WHERE>>)>)>)>
 402    <MOVE-ARG .WHERE .RW>>
 403
 404 <DEFINE PGEN-DISPATCH (N W NF B D SF)
 405         <CASE ,==?
 406               <NODE-TYPE .N>
 407               (,CALL-CODE <CALL-GEN .N .W .NF .B .D>)
 408               (,COND-CODE <COND-GEN .N .W .NF .B .D>)
 409               (,OR-CODE <OR-GEN .N .W .NF .B .D>)
 410               (,AND-CODE <AND-GEN .N .W .NF .B .D>)
 411               (,0-TST-CODE <0-TEST .N .W .NF .B .D .SF>)
 412               (,NOT-CODE <NOT-GEN .N .W .NF .B .D .SF>)
 413               (,1?-CODE <1?-GEN .N .W .NF .B .D .SF>)
 414               (,TEST-CODE <TEST-GEN .N .W .NF .B .D .SF>)
 415               (,EQ-CODE <==-GEN .N .W .NF .B .D .SF>)
 416               (,TY?-CODE <TYPE?-GEN .N .W .NF .B .D .SF>)
 417               (,MT-CODE <MT-GEN .N .W .NF .B .D .SF>)
 418               (,MONAD-CODE <MT-GEN .N .W .NF .B .D .SF>)
 419               (,ASSIGNED?-CODE <ASSIGNED?-GEN .N .W .NF .B .D .SF>)
 420               (,GET-CODE <GET-GEN .N .W .NF .B .D .SF>)
 421               (,GET2-CODE <GET2-GEN .N .W .NF .B .D .SF>)
 422               (,MEMQ-CODE <MEMQ-GEN .N .W .NF .B .D .SF>)
 423               (,LENGTH?-CODE <LENGTH?-GEN .N .W .NF .B .D .SF>)
 424               (,GASSIGNED?-CODE <GASSIGNED?-GEN .N .W .NF .B .D .SF>)
 425               (,VALID-CODE <VALID-TYPE?-GEN .N .W .NF .B .D .SF>)
 426               (,=?-STRING-CODE <=?-STRING-GEN .N .W .NF .B .D .SF>)
 427               (,SET-CODE <SET-GEN .N .W .NF .B .D>)
 428               (,MAP-CODE <MAPFR-GEN .N .W .NF .B .D>)
 429               (,PROG-CODE <PROG-REP-GEN .N .W .NF .B .D>)
 430               DEFAULT
 431               (<COMPILE-LOSSAGE "Inconsisent use of predicate internally:  "
 432                                 .N>)>>
 433
 434 <DEFINE PRED-BRANCH-GEN (TAG NOD TF
 435                          "OPTIONAL" (WHERE FLUSHED) (NF <>) (SETF <>)
 436                          "AUX" (W2
 437                                 <COND (<==? .WHERE FLUSHED> DONT-CARE)
 438                                       (ELSE .WHERE)>) TT TAG2)
 439         #DECL ((NOD) NODE)
 440         <COND (<==? <RESULT-TYPE .NOD> NO-RETURN> <GEN .NOD FLUSHED> ,NO-DATUM)
 441               (<PRED-CHECK? .NOD .TF .WHERE>
 442                <PGEN-DISPATCH .NOD .WHERE .NF .TAG .TF .SETF>)
 443               (.NF
 444                <SET TT <GEN .NOD DONT-CARE>>
 445                <COND (<==? .WHERE FLUSHED>
 446                       <D-B-TAG .TAG .TT <NOT .TF> <RESULT-TYPE .NOD>>)
 447                      (ELSE
 448                       <D-B-TAG <SET TAG2 <MAKE-TAG>>
 449                                .TT
 450                                .TF
 451                                <RESULT-TYPE .NOD>>
 452                       <FREE-TEMP .TT>
 453                       <SET TT <MOVE-ARG <REFERENCE .TF> .WHERE>>
 454                       <BRANCH-TAG .TAG>
 455                       <LABEL-TAG .TAG2>
 456                       .TT)>)
 457               (ELSE
 458                <SET TT <GEN .NOD .W2>>
 459                <D-B-TAG .TAG .TT .TF <RESULT-TYPE .NOD>>
 460                <MOVE-ARG .TT .WHERE>)>>
 461
 462 <DEFINE VALID-TYPE?-GEN (N W
 463                          "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
 464                          "AUX" (NN <1 <KIDS .N>>) (SDIR .DIR) (RW .W)
 465                                (FLS <==? .RW FLUSHED>) B2 B3 DATA)
 466         #DECL ((N NN) NODE)
 467         <COND (.NOTF <SET DIR <NOT .DIR>>)>
 468         <SET DATA <GEN .NN>>
 469         <COND (<AND .BRANCH .FLS>
 470                <GEN-VT .DATA .BRANCH .DIR>
 471                <FREE-TEMP .DATA>
 472                ,NO-DATUM)
 473               (<AND .FLS <NOT .BRANCH>>)
 474               (<OR .NOTF <AND <NOT <==? <NOT .BRANCH> <NOT .DIR>>> <NOT .SETF>>>
 475                <SET B2 <MAKE-TAG>>
 476                <SET B3 <MAKE-TAG>>
 477                <GEN-VT .DATA .B2 <COND (.BRANCH <NOT .DIR>) (ELSE .DIR)>>
 478                <FREE-TEMP .DATA>
 479                <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
 480                <COND (.BRANCH
 481                       <SET W <MOVE-ARG <REFERENCE .SDIR> .W>>
 482                       <BRANCH-TAG .BRANCH>
 483                       <LABEL-TAG .B2>
 484                       <COND (.SETF
 485                              <DEALLOCATE-TEMP .W>
 486                              <MOVE-ARG <REFERENCE <NOT .SDIR>> .W>)>)
 487                      (ELSE <TRUE-FALSE .N .B2 .W>)>
 488                <MOVE-ARG .W .RW>)
 489               (ELSE
 490                <SET B2 <MAKE-TAG>>
 491                <SET B3 <MAKE-TAG>>
 492                <COND (<NOT <TYPE? .W TEMP>>
 493                       <COND (<AND <TYPE? .DATA TEMP> <L=? <TEMP-REFS .DATA> 1>>
 494                              <SET W .DATA>)
 495                             (ELSE <SET W <GEN-TEMP <>>>)>)>
 496                <COND (.SETF
 497                       <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <>> .W>>)>
 498                <GEN-VT .DATA
 499                        <COND (.BRANCH) (ELSE .B3)>
 500                        .DIR .W>
 501                <FREE-TEMP .DATA>
 502                <COND (<NOT .BRANCH>
 503                       <BRANCH-TAG .B2>
 504                       <LABEL-TAG .B3>
 505                       <MOVE-ARG <REFERENCE <>> .W>
 506                       <LABEL-TAG .B2>)>
 507                <MOVE-ARG .W .RW>)>>
 508
 509 <DEFINE TYPE-C-GEN (N W "AUX" (DATA <GEN <1 <KIDS .N>>>) (RW .W))
 510         <COND (<NOT <TYPE? .W TEMP>>
 511                <COND (<AND <TYPE? .DATA TEMP> <L=? <TEMP-REFS .DATA> 1>>
 512                       <SET W .DATA>)
 513                      (ELSE <SET W <GEN-TEMP <>>>)>)>
 514         <GEN-TC .DATA .W>
 515         <FREE-TEMP .DATA>
 516         <MOVE-ARG .W .RW>>
 517
 518 <DEFINE =?-STRING-GEN (N W
 519                        "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
 520                        "AUX" (N1 <1 <KIDS .N>>) (N2 <2 <KIDS .N>>) (SDIR .DIR)
 521                              (RW .W) (FLS <==? .RW FLUSHED>) B2 B3 L1 L2)
 522         #DECL ((N N1 N2) NODE)
 523         <COND (<==? <NODE-NAME .N> N=?> <SET NOTF <NOT .NOTF>>)>
 524         <COND (.BRANCH
 525                <COND (.NOTF <SET DIR <NOT .DIR>>)>
 526                <DO-STR-EQ .N1
 527                           .N2
 528                           <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
 529                           <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE-TAG>>)>
 530                           <NODE-NAME .N>>
 531                <COND (<NOT .FLS>
 532                       <COND (.SETF
 533                              <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>)>
 534                       <SET RW <MOVE-ARG <MOVE-ARG <REFERENCE .SDIR> .W> .RW>>
 535                       <BRANCH-TAG .BRANCH>
 536                       <LABEL-TAG .B2>
 537                       <COND (.SETF
 538                              <DEALLOCATE-TEMP .RW>
 539                              <MOVE-ARG <REFERENCE <NOT .SDIR>> .RW>)>
 540                       .RW)>)
 541               (<==? <NODE-NAME .N> STRCOMP>
 542                <DO-STR-EQ .N1 .N2 <> <> STRCOMP .W>)
 543               (ELSE
 544                <SET BRANCH <MAKE-TAG>>
 545                <DO-STR-EQ .N1 .N2 .NOTF .BRANCH <NODE-NAME .N>>
 546                <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
 547                <MOVE-ARG <REFERENCE T> .W>
 548                <DEALLOCATE-TEMP .W>
 549                <BRANCH-TAG <SET B2 <MAKE-TAG>>>
 550                <LABEL-TAG .BRANCH>
 551                <MOVE-ARG <REFERENCE <>> .W>
 552                <LABEL-TAG .B2>
 553                <MOVE-ARG .W .RW>)>>
 554
 555 <DEFINE DO-STR-EQ (N1 N2 DIR BR NM
 556                    "OPT" W
 557                    "AUX" L1 L2 D1 D2 T1 T2 INS TG1 TG2 TG4 TG3 TG5)
 558    #DECL ((N1 N2) NODE)
 559    <COND (.DIR <SET TG1 <MAKE-TAG>>)>
 560    <SET D1 <GEN .N1>>
 561    <SET D2 <GEN .N2>>
 562    <COND (<AND <N==? .NM STRCOMP>
 563                <N==? .NM S=?>
 564                <N==? <ISTYPE? <RESULT-TYPE .N1>> STRING>>
 565           <GEN-TYPE? .D1 STRING <COND (.DIR .TG1) (ELSE .BR)> <>>)
 566          (<AND <N==? .NM S=?>
 567                <N==? .NM STRCOMP>
 568                <N==? <ISTYPE? <RESULT-TYPE .N2>> STRING>>
 569           <GEN-TYPE? .D2 STRING <COND (.DIR .TG1) (ELSE .BR)> <>>)>
 570    <COND (<==? .NM STRCOMP>
 571           <SET D1 <FIX-STR-TYP <RESULT-TYPE .N1> .D1>>
 572           <SET D2 <FIX-STR-TYP <RESULT-TYPE .N2> .D2>>)>
 573    <IEMIT `IFCAN
 574           <SET INS
 575                <COND (<==? .NM STRCOMP> "STRCOMP") (ELSE "STRING-EQUAL?")>>>
 576    <COND (<==? .NM STRCOMP>
 577           <SET BR <MAKE-TAG>>
 578           <IEMIT `STRCOMP
 579                  .D1
 580                  .D2
 581                  =
 582                  <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP>>)
 583                        (<TYPE? .W TEMP> <USE-TEMP .W> .W)
 584                        (ELSE .W)>>)
 585          (ELSE <IEMIT `STRING-EQUAL? .D1 .D2 <COND (.DIR +) (ELSE -)> .BR>)>
 586    <IEMIT `ENDIF .INS>
 587    <IEMIT `IFCANNOT .INS>
 588    <COND (<OR <TYPE? .D1 STRING> <AND <TYPE? .D1 TEMP> <G? <TEMP-REFS .D1> 1>>>
 589           <SET D1 <MOVE-ARG .D1 <GEN-TEMP <>>>>)>
 590    <COND (<OR <TYPE? .D2 STRING> <AND <TYPE? .D2 TEMP> <G? <TEMP-REFS .D2> 1>>>
 591           <SET D2 <MOVE-ARG .D2 <GEN-TEMP <>>>>)>
 592    <LENGTH-STRING .D1 <SET L1 <GEN-TEMP>>>
 593    <COND (<==? .NM STRCOMP> <LENGTH-STRING .D2 <SET L2 <GEN-TEMP FIX>>>)
 594          (ELSE
 595           <GEN-VAL-==?
 596            .L1
 597            <COND (<==? <NODE-TYPE .N2> ,QUOTE-CODE>
 598                   <LENGTH <CHTYPE <NODE-NAME .N2> STRING>>)
 599                  (ELSE
 600                   <LENGTH-STRING .D2 <SET L2 <GEN-TEMP FIX>>>
 601                   <FREE-TEMP .L2 <>>
 602                   .L2)>
 603            <>
 604            <COND (.DIR .TG1) (ELSE .BR)>>)>
 605    <SET T1 <GEN-TEMP>>
 606    <SET T2 <GEN-TEMP>>
 607    <IEMIT `LOOP
 608           (<TEMP-NAME .D1> VALUE LENGTH)
 609           (<TEMP-NAME .D2> VALUE LENGTH)
 610           (<TEMP-NAME .L1> VALUE)
 611           !<COND (<==? .NM STRCOMP> ((<TEMP-NAME .L2> VALUE))) (ELSE ())>>
 612    <LABEL-TAG <SET TG2 <MAKE-TAG>>>
 613    <NTH-STRING .D1 .T1 1>
 614    <NTH-STRING .D2 .T2 1>
 615    <GEN-VAL-==? .T1 .T2 <> <COND (.DIR .TG1) (ELSE .BR)>>
 616    <COND (<N==? .NM STRCOMP> <FREE-TEMP .T1> <FREE-TEMP .T2>)>
 617    <REST-STRING .D1 .D1 1>
 618    <REST-STRING .D2 .D2 1>
 619    <COND (<==? .NM STRCOMP>
 620           <IEMIT `SUB .L2 1 = .L2 '(`TYPE FIX)>
 621           <IEMIT `GRTR? .L2 0 - <SET TG3 <MAKE-TAG>> '(`TYPE FIX)>)>
 622    <IEMIT `SUB .L1 1 = .L1 '(`TYPE FIX)>
 623    <IEMIT `GRTR? .L1 0 + .TG2 '(`TYPE FIX)>
 624    <COND (<==? .NM STRCOMP>
 625           <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP FIX>>)>
 626           <MOVE-ARG 1 .W>
 627           <BRANCH-TAG <SET TG4 <MAKE-TAG>>>
 628           <LABEL-TAG .TG3>
 629           <IEMIT `SUB .L1 1 = .L1 '(`TYPE FIX)>
 630           <IEMIT `VEQUAL .L1 0 - <SET TG5 <MAKE-TAG>>>
 631           <MOVE-ARG 0 .W>
 632           <BRANCH-TAG .TG4>
 633           <LABEL-TAG .TG5>
 634           <MOVE-ARG -1 .W>
 635           <BRANCH-TAG .TG4>
 636           <LABEL-TAG .BR>
 637           <IEMIT `GRTR? .T1 .T2 - .TG5>
 638           <FREE-TEMP .T1>
 639           <FREE-TEMP .T2>
 640           <MOVE-ARG 1 .W>
 641           <LABEL-TAG .TG4>)>
 642    <COND (.DIR <BRANCH-TAG .BR>)>
 643    <FREE-TEMP .D1>
 644    <FREE-TEMP .D2>
 645    <IEMIT `ENDIF .INS>
 646    <COND (.DIR <LABEL-TAG .TG1>)>
 647    <COND (<ASSIGNED? W> .W)>>
 648
 649 <DEFINE FIX-STR-TYP (TYP D "AUX" B)
 650         <COND (<TYPE? .TYP FORM>
 651                <COND (<AND <TYPE? .D TEMP> <G? <TEMP-REFS .D> 1>>
 652                       <SET D <MOVE-ARG .D <GEN-TEMP <>>>>)>
 653                <GEN-TYPE? .D STRING <SET B <MAKE-TAG>> T>
 654                <IEMIT `NTHR .D 3 = .D>
 655                <LABEL-TAG .B>)>
 656         .D>
 657
 658 <DEFINE ATOM-PART-GEN (N W
 659                        "AUX" D (NM <NODE-NAME .N>) (RW .W)
 660                              (CARE
 661                               <AND .CAREFUL
 662                                    <OR <==? .NM LBIND> <==? .NM GBIND>>>))
 663         #DECL ((N) NODE)
 664         <SET D <GEN <1 <KIDS .N>>>>
 665         <FREE-TEMP .D <>>
 666         <IEMIT
 667          `NTHR
 668          .D
 669          <COND (<==? .NM GBIND> 1)
 670                (<==? .NM LBIND> 2)
 671                (<==? .NM SPNAME> 3)
 672                (ELSE 4)>
 673          =
 674          <COND (<TYPE? .W TEMP> <USE-TEMP .W <ISTYPE? <RESULT-TYPE .N>>>)
 675                (<OR <==? .W DONT-CARE> .CARE>
 676                 <SET W <GEN-TEMP <OR <ISTYPE? <RESULT-TYPE .N>> T>>>)
 677                (ELSE .W)>
 678          '(`RECORD-TYPE ATOM)
 679          !<COND (.CARE ('(`BRANCH-FALSE + `COMPERR))) (ELSE ())>>
 680         <COND (.CARE <SPEC-IEMIT `TYPE? .W '<`TYPE-CODE FALSE> + `COMPERR>)>
 681         <MOVE-ARG .W .RW>>
 682
 683 <DEFINE OFFSET-PART-GEN (N W
 684                          "AUX" D (NM <NODE-NAME .N>) (K <KIDS .N>)
 685                                E (RT <ISTYPE? <RESULT-TYPE .N>>))
 686         #DECL ((N) NODE (K) <LIST [REST NODE]>)
 687         <SET D <GEN <1 .K>>>
 688         <COND (<EMPTY? <SET K <REST .K>>>
 689                <FREE-TEMP .D <>>
 690                <IEMIT `NTHUV
 691                       .D
 692                       <COND (<==? .NM INDEX> 1) (ELSE 3)>
 693                       =
 694                       <COND (<TYPE? .W TEMP> <USE-TEMP .W <OR .RT T>>)
 695                             (<==? .W DONT-CARE> <SET W <GEN-TEMP <OR .RT T>>>)
 696                             (ELSE .W)>>)
 697               (ELSE
 698                <SET E <GEN <1 .K>>>
 699                <IEMIT `PUTUV .D 3 .E>
 700                <FREE-TEMP .E>
 701                <SET W <MOVE-ARG .D .W>>)>
 702         .W>
 703
 704 <DEFINE PUT-GET-DECL-GEN (N W
 705                           "AUX" D D1 (NM <NODE-NAME .N>) (NN <1 <KIDS .N>>)
 706                                 (ST <RESULT-TYPE .NN>) (RW .W))
 707         #DECL ((N) NODE)
 708         <COND (<==? .NM GET-DECL>
 709                <SET D <GEN .NN>>
 710                <FREE-TEMP .D <>>
 711                <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP T>>)
 712                      (<TYPE? .W TEMP> <USE-TEMP .W>)>
 713                <COND (<==? .ST OFFSET> <IEMIT `NTHUV .D 2 = .W>)
 714                      (ELSE
 715                       <IEMIT `NTHR .D 3 = .W (`RECORD-TYPE <ISTYPE? .ST>)>)>
 716                .W)
 717               (ELSE
 718                <COND (<TYPE? .W TEMP> <SET D <GEN .NN .W>>)
 719                      (ELSE <SET D <GEN .NN>>)>
 720                <SET D1 <GEN <2 <KIDS .N>>>>
 721                <COND (<==? .W FLUSHED> <FREE-TEMP .D <>>)>
 722                <FREE-TEMP .D1 <>>
 723                <COND (<==? .ST OFFSET> <IEMIT `PUTUV .D 2 .D1>)
 724                      (ELSE
 725                       <IEMIT `PUTR .D 3 .D1 (`RECORD-TYPE <ISTYPE? .ST>)>)>
 726                <COND (<N==? .W FLUSHED> <SET W <MOVE-ARG .D .W>>)>
 727                .W)>>
 728
 729
 730 <DEFINE SUBSTRUC-GEN (N W
 731                       "AUX" (K <KIDS .N>) (PT <STRUCTYP <RESULT-TYPE .N>>)
 732                             (LN <LENGTH .K>) (OVERLAP T) (DIR <>) TMP1 TMP2
 733                             (RSTN <>) (LNTN <>) (STRN <1 .K>) (RESN <>) AMT NT
 734                             (THE-SYM <>) RSTK NN (SRC-REST 0) (DEST-REST 0)
 735                             RSTINS LNTINS)
 736    #DECL ((STRN NN N) NODE (LN) FIX (RSTK K) <LIST [REST NODE]>
 737           (RSTN LNTN RESN) <OR FALSE NODE> (SRC-REST DEST-REST) FIX)
 738    <COND (<G? .LN 1>
 739           <SET RSTN <2 .K>>
 740           <COND (<G? .LN 2>
 741                  <SET LNTN <3 .K>>
 742                  <COND (<G? .LN 3> <SET RESN <4 .K>>)>)>)>
 743    <COND (<AND .RSTN
 744                <==? <NODE-TYPE .RSTN> ,QUOTE-CODE>>
 745           <SET SRC-REST <+ <NODE-NAME .RSTN> .SRC-REST>>)>
 746    <COND (<AND <OR <AND <==? <SET NT <NODE-TYPE .STRN>> ,LVAL-CODE>
 747                         <SET THE-SYM <NODE-NAME .STRN>>>
 748                    <AND <==? .NT ,REST-CODE>
 749                         <==? <NODE-TYPE <SET NN <2 <SET RSTK <KIDS .STRN>>>>>
 750                              ,QUOTE-CODE>
 751                         <SET SRC-REST <+ <NODE-NAME .NN> .SRC-REST>>
 752                         <==? <NODE-TYPE <SET NN <1 .RSTK>>> ,LVAL-CODE>
 753                         <SET THE-SYM <NODE-NAME .NN>>>>
 754                .RSTN
 755                <==? <NODE-TYPE .RSTN> ,QUOTE-CODE>
 756                .LNTN
 757                <OR <L? <LENGTH .LNTN> <CHTYPE <INDEX ,SIDE-EFFECTS> FIX>>
 758                    <NOT <SIDE-EFFECTS .LNTN>>>
 759                .RESN
 760                <OR <AND <==? <SET NT <NODE-TYPE .RESN>> ,LVAL-CODE>
 761                         <==? <NODE-NAME .RESN> .THE-SYM>>
 762                    <AND <==? .NT ,REST-CODE>
 763                         <==? <NODE-TYPE <SET NN <2 <SET RSTK <KIDS .RESN>>>>>
 764                              ,QUOTE-CODE>
 765                         <SET DEST-REST <NODE-NAME .NN>>
 766                         <==? <NODE-TYPE <SET NN <1 .RSTK>>> ,LVAL-CODE>
 767                         <==? <NODE-NAME .NN> .THE-SYM>>>>
 768           <COND (<G? .SRC-REST .DEST-REST> <SET DIR `FORWARD>)
 769                 (<L? .SRC-REST .DEST-REST> <SET DIR `BACKWARD>)
 770                 ; "taa 5/26/88:  Swapped the two directions, for the
 771                    sake of mnemonicity.  When SRC-REST is greater than
 772                    DEST-REST, we can use what's conventionally known
 773                    as a FORWARD BLT, since the first word transferred
 774                    is not in the area being read, etc.  When SRC-REST
 775                    is LESS than DEST-REST, we're potentially transferring
 776                    into the area that will later be read, and therefore
 777                    need to do it backwards.  MIMOC20 in fact used to do
 778                    backwards blts with dir FORWARD, and vice versa..."
 779                 (ELSE <COMPILE-ERROR "Bogus SUBSTRUC turkey" .N>)>)
 780          (<N==? .LN 4> <SET OVERLAP <>> <SET DIR `FORWARD>)>
 781    <COND (<AND .THE-SYM
 782                <NOT <MAPF <>
 783                           <FUNCTION (NN:NODE)
 784                                <COND (<INTERFERE? <TEMP-NAME-SYM .THE-SYM> .NN>
 785                                       <MAPLEAVE T>)>>
 786                           <REST .K>>>>
 787           <USE-TEMP <SET THE-SYM <TEMP-NAME-SYM .THE-SYM>>>)
 788          (ELSE <SET THE-SYM <GEN .STRN <GEN-TEMP <>>>>)>
 789    <COND (<==? .PT VECTOR> <SET RSTINS `RESTUV> <SET LNTINS `LENUV>)
 790          (<==? .PT UVECTOR> <SET RSTINS `RESTUU> <SET LNTINS `LENUU>)
 791          (<==? .PT STRING> <SET RSTINS `RESTUS> <SET LNTINS `LENUS>)
 792          (ELSE <SET RSTINS `RESTUB> <SET LNTINS `LENUB>)>
 793    <COND (<AND .RSTN <N==? <NODE-TYPE .RSTN> ,QUOTE-CODE>>
 794           <SET TMP1 <GEN .RSTN>>
 795           <IEMIT .RSTINS
 796                  .THE-SYM
 797                  .TMP1
 798                  =
 799                  <COND (<L=? <TEMP-REFS .THE-SYM> 1> .THE-SYM)
 800                        (ELSE
 801                         <FREE-TEMP .THE-SYM>
 802                         <SET THE-SYM <GEN-TEMP .PT>>)>>
 803           <FREE-TEMP .TMP1>)
 804          (<AND .RSTN <N==? .SRC-REST 0>>
 805           <IEMIT .RSTINS
 806                  .THE-SYM
 807                  .SRC-REST
 808                  =
 809                  <COND (<L=? <TEMP-REFS .THE-SYM> 1> .THE-SYM)
 810                        (ELSE
 811                         <FREE-TEMP .THE-SYM>
 812                         <SET THE-SYM <GEN-TEMP .PT>>)>>)>
 813    <COND (.LNTN <SET TMP2 <GEN .LNTN>>)
 814          (ELSE <IEMIT .LNTINS .THE-SYM = <SET TMP2 <GEN-TEMP FIX>>>)>
 815    <COND (.RESN
 816           <SET TMP1 <GEN .RESN <COND (<AND <TYPE? .W TEMP> <N==? .W .THE-SYM>> .W)
 817                                      (ELSE DONT-CARE)>>>
 818           <COND (<OR <==? .PT VECTOR> <==? .PT UVECTOR>>
 819                  <IEMIT `MOVE-WORDS
 820                         .THE-SYM
 821                         .TMP1
 822                         .TMP2
 823                         (`TYPE .PT)
 824                         (`DIRECTION .DIR)>)
 825                 (ELSE
 826                  <IEMIT `MOVE-STRING
 827                         .THE-SYM
 828                         .TMP1
 829                         .TMP2
 830                         (`NO-OVERLAP <NOT .OVERLAP>)>)>)
 831          (ELSE
 832           <IEMIT `UUBLOCK
 833                  <FORM `TYPE-CODE .PT>
 834                  .TMP2
 835                  =
 836                  <COND (<AND <TYPE? .W TEMP> <N==? .W .THE-SYM>>
 837                         <USE-TEMP .W>
 838                         <SET TMP1 .W>)
 839                        (ELSE <SET TMP1 <GEN-TEMP .PT>>)>
 840                  (`TYPE .PT)>
 841           <COND (<OR <==? .PT VECTOR> <==? .PT UVECTOR>>
 842                  <IEMIT `MOVE-WORDS
 843                         .THE-SYM
 844                         .TMP1
 845                         .TMP2
 846                         (`TYPE .PT)
 847                         (`DIRECTION .DIR)>)
 848                 (ELSE
 849                  <IEMIT `MOVE-STRING
 850                         .THE-SYM
 851                         .TMP1
 852                         .TMP2
 853                         (`NO-OVERLAP <NOT .OVERLAP>)>)>)>
 854    <FREE-TEMP .THE-SYM>
 855    <FREE-TEMP .TMP2>
 856    <MOVE-ARG .TMP1 .W>>
 857
 858 <ENDPACKAGE>