mim/development/mim/20c/acvar.mud

   1 <USE "HASH">
   2
   3 <COND (<NOT <GASSIGNED? WIDTH-MUNG>> <FLOAD "MIMOC20DEFS.MUD">)>
   4
   5 <SETG AC-R 10>
   6
   7 <MANIFEST AC-R>
   8
   9 <SETG SETZ-R <CHTYPE <ORB *400000000000* <LSH ,AC-R 18>> FIX>>
  10
  11 <SETG SETZX-R <CHTYPE <ORB -25769803776 <LSH ,AC-R 18>> FIX>>
  12
  13 <SETG SETZQ-R <CHTYPE <ORB *600000000000* <LSH ,AC-R 18>> FIX>>
  14
  15 <SETG SETZ-IND -34355544064>
  16
  17 <SETG SETZ *400000000000*>
  18
  19 <SETG ACS
  20       [O*
  21        0
  22        A1*
  23        1
  24        A2*
  25        2
  26        B1*
  27        3
  28        B2*
  29        4
  30        C1*
  31        5
  32        C2*
  33        6
  34        T*
  35        7
  36        O1*
  37        8
  38        O2*
  39        9
  40        R*
  41        10
  42        M*
  43        11
  44        SP*
  45        12
  46        F*
  47        13
  48        TP*
  49        14
  50        P*
  51        15]>
  52
  53 <REPEAT ((A ,ACS))
  54         <SETG <1 .A> <2 .A>>
  55         <COND (<EMPTY? <SET A <REST .A 2>>> <RETURN>)>>
  56
  57 <SETG ACNAMS [A1 A2 B1 B2 C1 C2 T O1 O2 R M SP F TP P]>
  58
  59 <GDECL (ACNAMS) <VECTOR [REST ATOM]>>
  60
  61 <DEFINE NEXTINS (L)
  62         #DECL ((L) LIST)
  63         <MAPF <>
  64               <FUNCTION (ITM)
  65                    #DECL ((ITM) <OR ATOM FORM>)
  66                    <COND (<TYPE? .ITM FORM> <MAPLEAVE .ITM>)>>
  67               .L>>
  68
  69 <SETG AC-STAMP 0>
  70
  71 <SETG AC-TABLE
  72       '[#AC [O* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
  73         #AC [A1* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
  74         #AC [A2* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
  75         #AC [B1* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
  76         #AC [B2* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
  77         #AC [C1* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
  78         #AC [C2* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
  79         #AC [X* #FALSE () DUMMY 0 #FALSE () #FALSE ()]
  80         #AC [T* #FALSE () DUMMY 34359738367 #FALSE () #FALSE ()]]>
  81
  82 <MAPR <>
  83       <FUNCTION (TBL "AUX" (AC <1 .TBL>))
  84               #DECL ((TBL) <VECTOR [REST AC]> (AC) AC)
  85               <COND (<1? <LENGTH .TBL>>
  86                      <PUTPROP <AC-NAME .AC> AC .AC>
  87                      <MAPLEAVE>)
  88                     (T
  89                      <PUTPROP <AC-NAME .AC>
  90                               NEXTAC
  91                               <COND (<==? <AC-NAME <2 .TBL>> X*> T*)
  92                                     (ELSE <AC-NAME <2 .TBL>>)>>
  93                      <PUTPROP <COND (<==? <AC-NAME <2 .TBL>> X*> T*)
  94                                     (ELSE <AC-NAME <2 .TBL>>)>
  95                               AC-PAIR
  96                               <AC-NAME .AC>>
  97                      <PUTPROP <COND (<==? <AC-NAME <2 .TBL>> X*> <3 .TBL>)
  98                                     (ELSE <2 .TBL>)>
  99                               AC-PAIR
 100                               .AC>
 101                      <PUTPROP .AC
 102                               NEXTAC
 103                               <COND (<==? <AC-NAME <2 .TBL>> X*> T*)
 104                                     (ELSE <AC-NAME <2 .TBL>>)>>
 105                      <PUTPROP <AC-NAME .AC> AC .AC>)>>
 106       ,AC-TABLE>
 107
 108 <SETG AC-PAIR-TABLE
 109       [<2 ,AC-TABLE>
 110        <3 ,AC-TABLE>
 111        <4 ,AC-TABLE>
 112        <5 ,AC-TABLE>
 113        <6 ,AC-TABLE>
 114        <7 ,AC-TABLE>]>
 115
 116 <SETG NULL-STATES
 117       <MAPF ,VECTOR
 118             <FUNCTION (AC) <CHTYPE [.AC <> <> <> DUMMY] ACSTATE>>
 119             ,AC-PAIR-TABLE>>
 120
 121 <DEFINE NEXT-AC (AC)
 122         #DECL ((AC) <OR ATOM AC>)
 123         <COND (<==? .AC STACK> STACK)
 124               (T <GETPROP .AC NEXTAC>)>>
 125
 126 <DEFINE GET-AC (AC)
 127         #DECL ((AC) ATOM (VALUE) AC)
 128         <GETPROP .AC AC>>
 129
 130 <DEFINE IS-AC? (AC) #DECL ((AC) ATOM)
 131         <GETPROP .AC AC>>
 132
 133 <DEFINE PA () <PPRINT ,AC-TABLE>>
 134
 135 <DEFINE ASSIGN-AC (ITM TYP "OPTIONAL" (AC-FORCE <>))
 136         #DECL ((ITM) ANY (TYP) ATOM (AC-FORCE) <OR ATOM FALSE>)
 137         <COND (<AND <==? .ITM STACK> <NOT .AC-FORCE>> STACK)
 138               (T <LOAD-AC .ITM .TYP T T>)>>
 139
 140 <DEFINE IN-AC? (ITM TYP "AUX" (BOTH <==? .TYP BOTH>))
 141         #DECL ((ITM) ANY (TYP) ATOM (BOTH) <OR FALSE ATOM>)
 142         <COND (<TYPE? .ITM ATOM>
 143                <MAPR <>
 144                      <FUNCTION (ACT "AUX" (AC <1 .ACT>) NAC)
 145                           #DECL ((ACT) VECTOR (NAC AC) AC)
 146                           <COND (<==? .TYP FREE> <MAPLEAVE <>>)
 147                                 (<==? <AC-ITEM .AC> .ITM>
 148                                  <COND (.BOTH
 149                                         <COND (<AND <==? <AC-CODE .AC> TYPE>
 150                                                     <SET NAC <2 .ACT>>
 151                                                     <==? <AC-CODE .NAC> VALUE>
 152                                                     <==? <AC-ITEM .NAC> .ITM>>
 153                                                <AC-TIME .AC ,AC-STAMP>
 154                                                <AC-TIME .NAC ,AC-STAMP>
 155                                                <MAPLEAVE <AC-NAME .AC>>)>)
 156                                        (<==? <AC-CODE .AC> .TYP>
 157                                         <AC-TIME .AC ,AC-STAMP>
 158                                         <MAPLEAVE <AC-NAME .AC>>)>)>>
 159                      ,AC-TABLE>)>>
 160
 161 <DEFINE SMASH-AC (NAM ITM TYP "OPTIONAL" (AC? T) "AUX" AC RAC)
 162         #DECL ((NAM TYP) ATOM (RAC) AC (ITM) ANY (AC AC?) <OR FALSE ATOM>)
 163         <COND (<AND .AC? <SET AC <IN-AC? .ITM .TYP>>>
 164                <COND (<==? .TYP BOTH>
 165                       <SET RAC <GET-AC .NAM>>
 166                       <COND (<N==? .NAM .AC>
 167                              <AC-TYPE .RAC <>>
 168                              <OCEMIT DMOVE .NAM .AC>
 169                              <FLUSH-AC .AC T>
 170                              <MUNGED-AC .AC T>)>
 171                       <COND (<TYPE? .ITM ATOM>
 172                              <AC-ITEM .RAC .ITM>
 173                              <AC-CODE .RAC TYPE>
 174                              <AC-ITEM <SET RAC <GET-AC <NEXT-AC .NAM>>> .ITM>
 175                              <AC-CODE .RAC VALUE>)
 176                             (ELSE
 177                              <AC-CODE .RAC DUMMY>
 178                              <AC-CODE <GET-AC <NEXT-AC .NAM>> DUMMY>)>)
 179                      (<==? .NAM .AC>)
 180                      (T
 181                       <AC-TYPE <SET RAC <GET-AC .NAM>> <>>
 182                       <OCEMIT MOVE .NAM .AC>
 183                       <FLUSH-AC .AC>
 184                       <MUNGED-AC .AC>
 185                       <COND (<TYPE? .ITM ATOM>
 186                              <AC-ITEM .RAC .ITM>
 187                              <AC-CODE .RAC .TYP>)
 188                             (ELSE
 189                              <AC-CODE .RAC DUMMY>)>)>
 190                .NAM)
 191               (T
 192                <LOAD-AC .ITM
 193                         .TYP
 194                         <>
 195                         <>
 196                         <GET-AC .NAM>
 197                         <COND (<==? .TYP BOTH> <GET-AC <NEXT-AC .NAM>>)>>)>>
 198
 199 <DEFINE CLEAN-ACS (ITM)
 200         #DECL ((ITM) ANY)
 201         <MAPF <>
 202               <FUNCTION (AC)
 203                    #DECL ((AC) AC)
 204                    <COND (<==? <AC-ITEM .AC> .ITM>
 205                           <AC-ITEM .AC <>>
 206                           <AC-CODE .AC DUMMY>)>>
 207               ,AC-TABLE>>
 208
 209 <DEFINE LOAD-TYPE (AC L "AUX" NUM (OFF 0))
 210    #DECL ((AC) ATOM (L) LIST (NUM) <OR CONSTANT FIX CONST-W-LOCAL>
 211           (OFF) FIX)
 212    <COND
 213     (<1? <LENGTH .L>>
 214      <SET NUM <CHTYPE <ORB 19595788288 ,<1 .L>> CONSTANT>>)
 215     (T
 216      <COND (<==? <LENGTH .L> 3> <SET OFF <1 .L>> <SET L <REST .L>>)>
 217      <SET NUM
 218           <CHTYPE (<1 .L>
 219                    <+ <CHTYPE <ORB 19595788288 <LSH ,<1 <2 .L>> 18>>
 220                               FIX>
 221                       <ANDB .OFF *777777*>>)
 222                   CONST-W-LOCAL>>)>
 223    <CONST-ADD .NUM>
 224    <OCEMIT LDB .AC !<OBJ-VAL .NUM>>>
 225
 226 <DEFINE LOAD-AC (ITM TYP
 227                  "OPTIONAL" (UPDATE <>) (ASSIGN <>) (LAC <>) (NAC <>)
 228                  "AUX" (BOTH <==? .TYP BOTH>) (LOW <CHTYPE <MIN> FIX>) AC TIM
 229                        (FIRST-AC ,FIRST-AC) NUM LCL TAC PT IDX)
 230    #DECL ((ITM) ANY (TYP) ATOM (LOW TIM) FIX (LAC NAC) <OR AC FALSE>
 231           (BOTH UPDATE ASSIGN AC) <OR FALSE ATOM> (NUM) <OR FALSE FIX>
 232           (TAC) AC)
 233    <SETG FIRST-AC <>>
 234    <SETG AC-STAMP <+ ,AC-STAMP 1>>
 235    <COND
 236     (<AND
 237       <NOT .LAC>
 238       <TYPE? .ITM ATOM>
 239       <OR
 240        <AND <SET AC <IN-AC? .ITM .TYP>> <N==? .AC X*>>
 241        <AND
 242         <NOT .AC>
 243         <==? .TYP BOTH>        ;"Check if either type or value already winning"
 244         <OR <AND <SET AC <IN-AC? .ITM TYPE>>
 245                                            ;"Either load value or flush type.."
 246                  <OR <AND <OR <==? .AC A1*>
 247                               <==? .AC B1*>
 248                               <==? .AC B1*>>
 249                           <LOAD-AC .ITM
 250                                    VALUE
 251                                    .UPDATE
 252                                    .ASSIGN
 253                                    <GET-AC <NEXT-AC .AC>>>
 254                                               ;"Undo what CLEAN-ACS does to AC"
 255                           <AC-ITEM <AC-CODE <GET-AC .AC> TYPE> .ITM>>
 256                      <COND (<AC-UPDATE <GET-AC .AC>>
 257                             <UPDATE-AC <GET-AC .AC>>
 258                             <AC-UPDATE <GET-AC .AC> <>>
 259                             <>)>>>
 260             <AND <SET AC <IN-AC? .ITM VALUE>>
 261                                           ;"Either load type or flush value..."
 262                  <OR <AND <OR <==? .AC A2*>
 263                               <==? .AC B2*>
 264                               <==? .AC C2*>>
 265                           <SET AC
 266                                <LOAD-AC .ITM
 267                                         TYPE
 268                                         .UPDATE
 269                                         .ASSIGN
 270                                         <GET-AC <GETPROP .AC AC-PAIR>>>>
 271                                               ;"Undo what CLEAN-ACS does to AC"
 272                           <AC-ITEM <AC-CODE <GET-AC <NEXT-AC .AC>> VALUE>
 273                                    .ITM>>
 274                      <COND (<AC-UPDATE <GET-AC .AC>>
 275                             <UPDATE-AC <GET-AC .AC>>
 276                             <AC-UPDATE <GET-AC .AC> <>>
 277                             <>)>>>>>>>
 278      <COND (.ASSIGN
 279             <AC-UPDATE <SET LAC <GET-AC .AC>> .UPDATE>
 280             <SETG ACA-AC .LAC>
 281             <SETG ACA-ITEM .ITM>
 282             <SETG ACA-BOTH .BOTH>
 283             <COND (.BOTH
 284                    <AC-UPDATE <SET NAC <GET-AC <NEXT-AC .AC>>> .UPDATE>
 285                    <SETG ACA-BOTH .NAC>)>)>
 286      .AC)
 287     (T
 288      <CLEAN-ACS .ITM>
 289      <OR
 290       .LAC
 291       <AND <TYPE? .ITM ATOM>
 292            <SET LAC <LOOK-AHEAD <REST .MIML> .ITM .TYP>>
 293            <OR .FIRST-AC
 294                <AND <NOT <TYPE? <AC-ITEM .LAC> ATOM>>
 295                     <OR <N==? .TYP BOTH>
 296                         <NOT <TYPE? <AC-ITEM <GET-AC <NEXT-AC .LAC>>> ATOM>>>>>>
 297       <REPEAT ((ACT <REST ,AC-TABLE>))
 298         #DECL ((ACT) <VECTOR [REST AC]>)
 299         <COND
 300          (<OR <EMPTY? .ACT> <AND .BOTH <1? <LENGTH .ACT>>>> <RETURN>)
 301          (.BOTH
 302           <COND
 303            (<AND <N==? <AC-NAME <2 .ACT>> X*>
 304                  <N==? <AC-NAME <1 .ACT>> X*>>
 305             <SET TIM <MAX <AC-TIME <1 .ACT>> <AC-TIME <2 .ACT>>>>
 306             <COND (<AND .FIRST-AC
 307                         <OR <NOT .LAC>
 308                             <AND <AC-ITEM .LAC>
 309                                  <OR <NOT <AC-ITEM <1 .ACT>>>
 310                                      <AND <AC-UPDATE .LAC>
 311                                           <NOT <AC-UPDATE <1 .ACT>>>>>>>>
 312                    <SET LOW <MIN .TIM .LOW>>
 313                    <SET LAC <1 .ACT>>
 314                    <SET NAC <2 .ACT>>)
 315                   (<L=? .TIM .LOW>
 316                    <COND (<OR <N==? .LOW .TIM>
 317                               <NOT .LAC>
 318                               <AND <AC-ITEM .LAC>
 319                                    <OR <NOT <AC-ITEM <1 .ACT>>>
 320                                        <AND <AC-UPDATE .LAC>
 321                                             <NOT <AC-UPDATE <1 .ACT>>>>>>>
 322                           <SET LOW .TIM>
 323                           <SET LAC <1 .ACT>>
 324                           <SET NAC <2 .ACT>>)>)>)>)
 325          (<AND <N==? <AC-NAME <1 .ACT>> X*> <N==? <AC-NAME <1 .ACT>> T*>>
 326           <SET TIM <AC-TIME <1 .ACT>>>
 327           <COND (<AND .FIRST-AC
 328                       <OR <NOT .LAC>
 329                           <AND <AC-ITEM .LAC>
 330                                <OR <NOT <AC-ITEM <1 .ACT>>>
 331                                    <AND <AC-UPDATE .LAC>
 332                                         <NOT <AC-UPDATE <1 .ACT>>>>>>>>
 333                  <SET LAC <1 .ACT>>
 334                  <SET LOW .TIM>)
 335                 (<L=? .TIM .LOW>
 336                  <COND (<OR <N==? .LOW .TIM>
 337                             <NOT .LAC>
 338                             <AND <AC-ITEM .LAC>
 339                                  <OR <NOT <AC-ITEM <1 .ACT>>>
 340                                      <AND <AC-UPDATE .LAC>
 341                                           <NOT <AC-UPDATE <1 .ACT>>>>>>>
 342                         <SET LOW .TIM>
 343                         <SET LAC <1 .ACT>>)>)>)>
 344         <COND (.BOTH <SET ACT <REST .ACT 2>>) (T <SET ACT <REST .ACT>>)>>>
 345      <COND (<AND .BOTH <NOT .NAC>> <SET NAC <GET-AC <NEXT-AC .LAC>>>)>
 346      <COND (<AC-UPDATE <CHTYPE .LAC AC>> <UPDATE-AC .LAC>)>
 347      <COND (.ASSIGN
 348             <SETG ACA-AC .LAC>
 349             <SETG ACA-ITEM .ITM>
 350             <SETG ACA-BOTH .BOTH>
 351             <AC-ITEM <CHTYPE .LAC AC> #LOSE *000000000000*>)
 352            (<TYPE? .ITM ATOM> <AC-ITEM <CHTYPE .LAC AC> .ITM>)
 353            (ELSE <AC-ITEM <CHTYPE .LAC AC> <>>)>
 354      <AC-CODE <CHTYPE .LAC AC> <COND (.BOTH TYPE) (.TYP)>>
 355      <OR <==? .LAC <GET-AC T*>> <AC-TIME <CHTYPE .LAC AC> ,AC-STAMP>>
 356      <AC-TYPE <CHTYPE .LAC AC> <>>
 357      <COND (.BOTH
 358             <COND (<AC-UPDATE <CHTYPE .NAC AC>> <UPDATE-AC .NAC>)>
 359             <COND (.ASSIGN
 360                    <SETG ACA-BOTH .NAC>
 361                    <AC-ITEM <CHTYPE .NAC AC> #LOSE *000000000000*>)
 362                   (<TYPE? .ITM ATOM> <AC-ITEM <CHTYPE .NAC AC> .ITM>)
 363                   (ELSE <AC-ITEM <CHTYPE .NAC AC> <>>)>
 364             <AC-CODE <CHTYPE .NAC AC> VALUE>
 365             <AC-TIME <CHTYPE .NAC AC> ,AC-STAMP>
 366             <AC-UPDATE <CHTYPE .NAC AC> .UPDATE>
 367             <AC-TYPE <CHTYPE .NAC AC> <>>)>
 368      <AC-UPDATE <CHTYPE .LAC AC> .UPDATE>
 369      <COND (.ASSIGN)
 370            (<TYPE? .ITM ATOM>
 371             <COND (<OR <SET LCL <LMEMQ .ITM ,LOCALS>>
 372                        <AND ,ICALL-FLAG <SET LCL <LMEMQ .ITM ,ICALL-TEMPS>>>>
 373                    <SET ITM <LNAME <CHTYPE .LCL LOCAL>>>
 374                    <SET IDX <COND (,WINNING-VICTIM '(TP*)) (ELSE '(F*))>>
 375                    <COND (.BOTH
 376                           <OCEMIT DMOVE .LAC <- ,STACK-DEPTH> .ITM .IDX>)
 377                          (<==? .TYP VALUE>
 378                           <OCEMIT MOVE .LAC <- 1 ,STACK-DEPTH> .ITM .IDX>)
 379                          (<==? .TYP LENGTH>
 380                           <OCEMIT HRRZ .LAC <- ,STACK-DEPTH> .ITM .IDX>)
 381                          (<==? .TYP TYPECODE>
 382                           <LOAD-TYPE <AC-NAME <CHTYPE .LAC AC>>
 383                                      (<- ,STACK-DEPTH> .ITM .IDX)>)
 384                          (T <OCEMIT MOVE .LAC <- ,STACK-DEPTH> .ITM .IDX>)>)
 385                   (T <MIMOCERR UNKNOWN-LOCAL!-ERRORS .ITM>)>)
 386            (<AND <OR <AND <OR <==? <SET PT <PRIMTYPE .ITM>> WORD> <==? .PT FIX>>
 387                           <OR <L? <ABS <CHTYPE .ITM FIX>> ,MAX-IMMEDIATE>
 388                               <0? <CHTYPE <ANDB .ITM 262143> FIX>>>>
 389                      <AND <==? <PRIMTYPE .ITM> LIST>
 390                           <EMPTY? <CHTYPE .ITM LIST>>>>
 391                  <OR <OR <==? .TYP FREE> <==? .TYP VALUE>>
 392                      <AND <==? .TYP BOTH> <MEMQ <TYPE .ITM> ,TYPE-WORDS>>>>
 393  ;
 394 "Hacked by TAA to do immediate instructions when possible
 395                even when loading BOTH.  TAC is AC that will have value
 396                word; type word (when BOTH) goes into LAC, TAC becomes NAC.
 397                Otherwise, TAC becomes LAC."
 398             <COND (<==? .TYP BOTH>
 399                    <LOAD-TYPE-IN-AC <AC-NAME .LAC> <TYPE .ITM>>
 400                    <SET TAC .NAC>)
 401                   (<SET TAC .LAC>)>
 402             <COND (<==? <PRIMTYPE .ITM> LIST> <OCEMIT MOVEI .TAC 0>)
 403                   (<0? <CHTYPE <ANDB .ITM 262143> FIX>>
 404                    <OCEMIT MOVSI .TAC <CHTYPE <LSH .ITM -18> FIX>>)
 405                   (T     ;<L? <ABS <SET ITM <CHTYPE .ITM FIX>>> ,MAX-IMMEDIATE
 406 >
 407                    <COND (<L? <SET ITM <CHTYPE .ITM FIX>> 0>
 408                           <OCEMIT MOVNI .TAC <ABS .ITM>>)
 409                          (ELSE <OCEMIT MOVEI .TAC .ITM>)>)>)
 410            (T
 411             <SET NUM <MVADD .ITM>>
 412             <SET NUM <* <+ .NUM 1> 2>>
 413             <COND (.BOTH <OCEMIT DMOVE .LAC .NUM '(M*)>)
 414                   (<==? .TYP VALUE> <OCEMIT MOVE .LAC 1 .NUM '(M*)>)
 415                   (<==? .TYP LENGTH> <OCEMIT HRRZ .LAC .NUM '(M*)>)
 416                   (<==? .TYP TYPECODE>
 417                    <LOAD-TYPE <AC-NAME <CHTYPE .LAC AC>> (.NUM '(M*))>)
 418                   (T <OCEMIT MOVE .LAC .NUM '(M*)>)>)>
 419      <AC-NAME <CHTYPE .LAC AC>>)>>
 420
 421 <DEFINE LABEL-PREF (LBL VAR TYP "AUX" (LB <FIND-LABEL .LBL>) L)
 422    #DECL ((LBL VAR TYP) ATOM (LB) <OR FALSE LAB>)
 423    <COND
 424     (<AND .LB
 425           <N==? .LBL COMPERR>
 426           <OR <SET L <LAB-FINAL-STATE .LB>>
 427               <AND <NOT <EMPTY? <LAB-STATE .LB>>>
 428                    <SET L <1 <LAB-STATE .LB>>>>>>
 429      <MAPR <>
 430       <FUNCTION (ACSP "AUX" (ACS <1 .ACSP>) NXT)
 431               #DECL ((ACS) ACSTATE (NXT) <OR ACSTATE FALSE>)
 432               <COND (<OR <AND <ACS-LOCAL .ACS>
 433                               <==? <LATM <ACS-LOCAL .ACS>> .VAR>
 434                               <OR <==? <ACS-CODE .ACS> .TYP>
 435                                   <AND <==? .TYP BOTH>
 436                                        <==? <ACS-CODE .ACS> TYPE>>>>
 437                          <AND <==? .TYP BOTH>
 438                               <NOT <EMPTY? <REST .ACSP>>>
 439                               <ACS-LOCAL <SET NXT <2 .ACSP>>>
 440                               <==? <LATM <ACS-LOCAL .NXT>> .VAR>
 441                               <==? <ACS-CODE .NXT> VALUE>>>
 442                      <MAPLEAVE <ACS-AC .ACS>>)>>
 443       .L>)>>
 444
 445 <DEFINE LOOK-AHEAD (L ITM TYP)
 446         #DECL ((L) LIST (ITM TYP) ATOM)
 447         <COND (<N==? .ITM STACK>
 448                <REPEAT (IT X Y)
 449                 <COND (<EMPTY? .L> <RETURN <>>)>
 450                 <COND (<TYPE? <SET IT <1 .L>> ATOM>
 451                        <SET X <LABEL-PREF .IT .ITM .TYP>>
 452                        <COND (.X <RETURN .X>) (ELSE <RETURN <>>)>)
 453                       (<AND <TYPE? .IT FORM>
 454                             <NOT <EMPTY? .IT>>>
 455                        <COND (<SET Y <GETPROP <SET X <1 .IT>> LOOKA-AHEAD>>
 456                               <SPECIAL-PREF .Y .IT .ITM .TYP>)
 457                              (<==? .X CONS>
 458                               <COND (<==? .ITM <2 .IT>>
 459                                      <RETURN <COND (<==? .TYP VALUE>
 460                                                     <GET-AC B2*>)
 461                                                    (ELSE
 462                                                     <GET-AC B1*>)>>)
 463                                     (<==? .ITM <3 .IT>>
 464                                      <RETURN <COND (<==? .TYP VALUE>
 465                                                     <GET-AC C2*>)
 466                                                    (ELSE
 467                                                     <GET-AC C1*>)>>)
 468                                     (ELSE <RETURN <>>)>)
 469                              (<SET Y <OR <MEMQ + .IT> <MEMQ - .IT>>>
 470                               <SET Y <LABEL-PREF <2 .Y> .ITM .TYP>>
 471                               <COND (.Y <RETURN .Y>)>)
 472                              (<AND <==? .X SET> <==? <2 .IT> .ITM>>
 473                               <RETURN <>>)
 474                              (<AND <SET Y <MEMQ = .IT>> <==? <2 .Y> .ITM>>
 475                               <RETURN <>>)
 476                              (<AND <==? .X DEAD> <MEMQ .ITM <REST .IT>>>
 477                               <RETURN <>>)
 478                              (<AND <==? .X RETURN> <==? <2 .IT> .ITM>>
 479                               <COND (<==? .TYP VALUE> <RETURN <GET-AC A2*>>)
 480                                     (ELSE <RETURN <GET-AC A1*>>)>)
 481                              (<==? .X RETURN> <RETURN <>>)>)>
 482                 <SET L <REST .L>>>)>>
 483
 484 <DEFINE UPDATE-AC (AC
 485                    "OPT" (SAVE-TIME <>)
 486                    "AUX" (ITM <AC-ITEM .AC>) (TYP <AC-CODE .AC>) NAC NUM LCL
 487                          (T1 <AC-TIME .AC>) T2 (ACSTMP ,AC-STAMP))
 488         #DECL ((NAC AC) AC (ITM) ANY (TYP) ATOM (NUM ACSTMP) FIX
 489                (LCL) <OR ATOM FALSE LOCAL>)
 490         <COND (<AND <TYPE? .ITM ATOM> <N==? .ITM STACK>>
 491                <COND (<SET LCL <LMEMQ .ITM ,LOCALS>>
 492                       <COND (<AND <TYPE? .LCL LOCAL> <NOT <LUPD .LCL>>>
 493                              <LUPD .LCL TEMP>)>)
 494                      (<AND ,ICALL-FLAG <SET LCL <LMEMQ .ITM ,ICALL-TEMPS>>>
 495                       <COND (<AND <TYPE? .LCL LOCAL> <NOT <LUPD .LCL>>>
 496                              <LUPD .LCL TEMP>)>)
 497                      (T <MIMOCERR UNKNOWN-LOCAL!-ERRORS .ITM>)>
 498                <SET ITM <LNAME <CHTYPE .LCL LOCAL>>>
 499                <COND (<OR <AND <==? .TYP TYPE>
 500                                <SET NAC <GET-AC <NEXT-AC .AC>>>
 501                                <==? <AC-CODE .NAC> VALUE>
 502                                <==? <AC-ITEM .NAC> <LATM <CHTYPE .LCL LOCAL>>>
 503                                <AC-UPDATE .NAC>
 504                                <AC-UPDATE .NAC <>>>
 505                           <AND <==? .TYP VALUE>
 506                                <SET NAC <GETPROP .AC AC-PAIR>>
 507                                <==? <AC-CODE .NAC> TYPE>
 508                                <==? <AC-ITEM .NAC> <LATM <CHTYPE .LCL LOCAL>>>
 509                                <SET T2 <AC-TIME .NAC>>
 510                                <AC-UPDATE .NAC>
 511                                <AC-UPDATE .NAC <>>
 512                                <SET T1 <AC-TIME .NAC>>
 513                                <SET AC .NAC>
 514                                <SET NAC <GET-AC <NEXT-AC .AC>>>>>
 515                       <HACK-LAST-ACS .LCL TYPE>
 516                       <HACK-LAST-ACS .LCL VALUE>
 517                       <SET T2 <AC-TIME .NAC>>
 518                       <COND (<AND <MEMQ .LCL ,TYPED-LOCALS>
 519                                   <N==? <LUPD .LCL> OARG>>
 520                              <OCEMIT MOVEM <AC-NAME .NAC> <- 1 ,STACK-DEPTH> .ITM
 521                                      <COND (,WINNING-VICTIM '(TP*)) (ELSE '(F*))>>)
 522                             (T
 523                              <OCEMIT DMOVEM <AC-NAME .AC> <- ,STACK-DEPTH> .ITM
 524                                      <COND (,WINNING-VICTIM '(TP*))
 525                                            (ELSE '(F*))>>)>
 526                       <COND (.SAVE-TIME <AC-TIME .AC .T1> <AC-TIME .NAC .T2>)>
 527                       <AC-UPDATE .NAC <>>)
 528                      (<==? .TYP TYPE>
 529                       <HACK-LAST-ACS .LCL TYPE>
 530                       <COND (<NOT <MEMQ .LCL ,TYPED-LOCALS>>
 531                              <OCEMIT MOVEM <AC-NAME .AC> <- ,STACK-DEPTH> .ITM
 532                                      <COND (,WINNING-VICTIM '(TP*)) (ELSE '(F*))>>
 533                              <COND (.SAVE-TIME <AC-TIME .AC .T1>)>)>)
 534                      (<==? .TYP VALUE>
 535                       <HACK-LAST-ACS .LCL VALUE>
 536                       <OCEMIT MOVEM <AC-NAME .AC> <- 1 ,STACK-DEPTH> .ITM
 537                               <COND (,WINNING-VICTIM '(TP*)) (ELSE '(F*))>>
 538                       <COND (.SAVE-TIME
 539                              <AC-TIME .AC .T1>
 540                              <COND (<ASSIGNED? T2> <AC-TIME .NAC .T2>)>)>)>)>
 541         <COND (.SAVE-TIME <SETG AC-STAMP .ACSTMP>)>>
 542
 543 <DEFINE HACK-LAST-ACS (LCL TYP "AUX" ACS)
 544         #DECL ((LCL) LOCAL (TYP) ATOM (ACS) <OR ACSTATE FALSE>)
 545         <COND (<AND <==? .TYP TYPE>
 546                     <SET ACS <LAST-ACST .LCL>>
 547                     <NOT <ACS-STORED .ACS>>>
 548                <PUT .ACS ,ACS-STORED HACKED>
 549                <PUT .LCL ,LAST-ACST <>>)
 550               (<AND <==? .TYP VALUE>
 551                     <SET ACS <LAST-ACSV .LCL>>
 552                     <NOT <ACS-STORED .ACS>>>
 553                <PUT .ACS ,ACS-STORED HACKED>
 554                <PUT .LCL ,LAST-ACSV <>>)>>
 555
 556 <DEFINE UPDATE-ACS () <LABEL-UPDATE-ACS <> <>>>
 557
 558 <DEFINE LABEL-UPDATE-ACS (TAG UNCND
 559                           "OPT" (NO-TY <>) (A1 <>) (A2 <>)
 560                           "AUX" NXT LB (MIML .MIML))
 561         #DECL ((TAG) <OR ATOM FALSE> (NXT) ANY (MIML) LIST)
 562         <COND (<AND .TAG <SET LB <FIND-LABEL .TAG>>>)>
 563         <COND (<OR <==? .TAG COMPERR> <==? .TAG UNWCONT>>       ;"Don't bother"
 564                <COND (.A1 <COND (.A2 (.A1 .A2)) (ELSE (.A1))>)>)
 565               (T
 566                <COND (<AND .TAG <NOT <LAB-LOOP .LB>> <NOT .UNCND>>
 567                       <PROG ()
 568                             <COND (<NOT <EMPTY? .MIML>>
 569                                    <COND (<AND <TYPE? <SET NXT <2 .MIML>> FORM>
 570                                                <==? <1 .NXT> DEAD>>
 571                                           <DEAD!-MIMOC <REST .NXT> T .NO-TY>
 572                                           <SET MIML <REST .MIML>>
 573                                           <AGAIN>)
 574                                          (<TYPE? .NXT ATOM>
 575                                           <SET MIML <REST .MIML>>
 576                                           <AGAIN>)>)>>
 577                       )>
 578                <COND (<OR <NOT .TAG> ,NO-AC-FUNNYNESS>
 579                       <MAPF <>
 580                             <FUNCTION (AC)
 581                                     #DECL ((AC) AC)
 582                                     <COND (<AC-UPDATE .AC>
 583                                            <UPDATE-AC .AC>
 584                                            <AC-UPDATE .AC <>>)>>
 585                             ,AC-TABLE>
 586                       <COND (.A1 <COND (.A2 (.A1 .A2)) (ELSE (.A1))>)>)
 587                      (,PASS1
 588                       <SAVE-BRANCH-STATE .LB .UNCND>
 589                       <COND (.A1 <COND (.A2 (.A1 .A2)) (ELSE (.A1))>)>)
 590                      (<NOT ,NO-AC-FUNNYNESS>
 591                       <ESTABLISH-BRANCH-STATE .LB .UNCND .A1 .A2>)>)>>
 592
 593 <DEFINE FLUSH-AC (AC "OPTIONAL" (BOTH <>) "AUX" RAC)
 594         #DECL ((AC) ATOM (RAC) AC (BOTH) <OR ATOM FALSE>)
 595         <COND (<AC-UPDATE <SET RAC <GET-AC .AC>>>
 596                <UPDATE-AC .RAC>)>
 597         <COND (<AND .BOTH <AC-UPDATE <SET RAC <GET-AC <NEXT-AC .AC>>>>>
 598                <UPDATE-AC .RAC>)>>
 599
 600 <DEFINE ALTER-AC (AC WHAT "AUX" RAC)
 601         #DECL ((AC WHAT) ATOM (RAC) AC)
 602         <COND (<AC-UPDATE <SET RAC <GET-AC .AC>>> <UPDATE-AC .RAC>)>
 603         <AC-ITEM .RAC .WHAT>
 604         <AC-CODE .RAC TYPE>
 605         <AC-UPDATE .RAC T>
 606         <COND (<AC-UPDATE <SET RAC <GET-AC <NEXT-AC .AC>>>> <UPDATE-AC .RAC>)>
 607         <AC-ITEM .RAC .WHAT>
 608         <AC-CODE .RAC VALUE>
 609         <AC-UPDATE .RAC T>>
 610
 611 <DEFINE FLUSH-ACS ()
 612         <MAPF <>
 613               <FUNCTION (AC)
 614                    #DECL ((AC) AC)
 615                    <AC-ITEM .AC <>>
 616                    <AC-CODE .AC DUMMY>
 617                    <AC-UPDATE .AC <>>
 618                    <AC-TYPE .AC <>>
 619                    <OR <==? <AC-NAME .AC> T*> <AC-TIME .AC 0>>>
 620               ,AC-TABLE>>
 621
 622 <DEFINE REALLY-FREE-AC-PAIR ("AUX" OAC)
 623         <COND (<OR <AND <==? <AC-CODE <GET-AC <SET OAC A1*>>> DUMMY>
 624                         <==? <AC-CODE <GET-AC A2*>> DUMMY>>
 625                    <AND <==? <AC-CODE <GET-AC <SET OAC B1*>>> DUMMY>
 626                         <==? <AC-CODE <GET-AC B2*>> DUMMY>>
 627                    <AND <==? <AC-CODE <GET-AC <SET OAC C1*>>> DUMMY>
 628                         <==? <AC-CODE <GET-AC C2*>> DUMMY>>>
 629                .OAC)>>
 630
 631 <DEFINE MUNGED-AC (NAM "OPTIONAL" (NXT? <>) "AUX" AC)
 632         #DECL ((NAM) ATOM (NXT?) <OR ATOM FALSE> (AC) AC)
 633         <AC-ITEM <SET AC <GET-AC .NAM>> <>>
 634         <AC-CODE .AC DUMMY>
 635         <AC-UPDATE .AC <>>
 636         <AC-TYPE .AC <>>
 637         <COND (.NXT?
 638                <AC-ITEM <SET AC <GET-AC <NEXT-AC .NAM>>> <>>
 639                <AC-CODE .AC DUMMY>
 640                <AC-UPDATE .AC <>>
 641                <AC-TYPE .AC <>>)>>
 642
 643 <DEFINE SAVE-ACS ()
 644         <UPDATE-ACS>
 645         <FLUSH-ACS>>
 646
 647 <DEFINE MVADD (ITM "AUX" P HC:FIX IDX:FIX BK:LIST)
 648         #DECL ((ITM) ANY)
 649         <COND (<REPEAT ((ITM .ITM))
 650                        <COND (<AND <TYPE? .ITM FORM>
 651                                    <==? <LENGTH .ITM> 2>
 652                                    <==? <1 .ITM> QUOTE>>
 653                               <COND (<TYPE? <SET ITM <2 .ITM>> ATOM>
 654                                      <RETURN T>)>)
 655                              (ELSE <RETURN <>>)>>
 656                ; "This will strip off one level of quoting only when the
 657                   thing ultimately quoted is an atom; in other cases, all
 658                   levels need to remain."
 659                <SET ITM <2 .ITM>>)>
 660         <SET BK <NTH ,MV-TABLE
 661                      <SET IDX <+ <MOD <SET HC <HASH .ITM>>
 662                                       ,MV-TABLE-LENGTH>
 663                                  1>>>>
 664         <COND (<MAPF <>
 665                      <FUNCTION (MVB:MBUCK)
 666                           <COND (<AND <==? <MV-HASH .MVB> .HC>
 667                                       <=? <MV-VAL .MVB> .ITM>>
 668                                  <SET FMV .MVB>
 669                                  <MAPLEAVE>)>>
 670                      .BK>)
 671               (ELSE
 672                <PUT ,MV-TABLE
 673                     .IDX
 674                     (<SET FMV <CHTYPE [.ITM .HC <SETG MV-COUNT <+ ,MV-COUNT 1>>]
 675                                       MBUCK>> !.BK)>
 676                <SETG MV <REST <PUTREST ,MV (.ITM)>>>)>
 677         <MV-LOC .FMV>>
 678
 679 <DEFINE POS (ITM LST "AUX" M)
 680         #DECL ((ITM) ANY (LST) LIST (M) <OR FALSE LIST>)
 681         <COND (<AND <TYPE? .ITM FORM>
 682                     <G? <LENGTH .ITM > 1>
 683                     <==? <1 .ITM> QUOTE>
 684                     <TYPE? <2 .ITM> ATOM>>
 685                <SET ITM <2 .ITM>>)>
 686         <COND (<AND ,ICALL-FLAG
 687                     <==? .LST ,LOCALS>
 688                     <SET M <MEMQ .ITM ,ICALL-TEMPS>>>
 689                <2 .M>)
 690               (<SET M <MEMQ .ITM <REST .LST>>>
 691                <- <LENGTH .LST> <LENGTH .M>>)>>
 692
 693 <DEFINE LMEMQ (ATM LST "AUX" ITM)
 694         #DECL ((ATM) ATOM (LST) LIST (ITM) <OR ATOM LOCAL>)
 695         <REPEAT ()
 696                 <COND (<EMPTY? .LST> <RETURN <>>)
 697                       (<AND <TYPE? <SET ITM <1 .LST>> LOCAL>
 698                             <==? <LATM .ITM> .ATM>>
 699                        <RETURN <1 .LST>>)
 700                       (<==? .ITM .ATM> <RETURN .ATM>)>
 701                 <SET LST <REST .LST>>>>
 702
 703 <DEFINE L-N-LMEMQ (LN LST "AUX" ITM)
 704         #DECL ((LN) LOCAL-NAME (LST) LIST (ITM) <OR ATOM LOCAL>)
 705         <REPEAT ()
 706                 <COND (<EMPTY? .LST> <RETURN <>>)
 707                       (<AND <TYPE? <SET ITM <1 .LST>> LOCAL>
 708                             <==? <LNAME .ITM> .LN>>
 709                        <RETURN <1 .LST>>)
 710                       (<==? .ITM .LN> <RETURN .LN>)>
 711                 <SET LST <REST .LST>>>>
 712
 713 <DEFINE LLOOKUP (ATM "AUX" M P)
 714         #DECL ((ATM) ATOM (M) <OR LIST FALSE> (P) <OR FALSE FIX>)
 715         <COND (<SET M <MEMQ .ATM ,ICALL-TEMPS>> <* <CHTYPE <2 .M> FIX> 2>)
 716               (<SET P <POS .ATM ,LOCALS>> <* <CHTYPE .P FIX> 2>)
 717               (<MIMOCERR UNKNOWN-LOCAL!-ERRORS .ATM>)>>
 718
 719 <DEFINE FIXUP-LOCALS (L
 720                       "AUX" (C ,TEMP-CC) (CFLG <>) (CNT 0) (LNUM 0) (TUP <>)
 721                             (FL ()) TMP)
 722         #DECL ((FL L C) LIST (CFLG) <OR ATOM FALSE> (CNT LNUM) FIX
 723                (TUP) <OR FALSE INST>)
 724         <COND (<AND <TYPE? <SET TMP <2 .C>> INST>
 725                     <==? <1 .TMP> MOVE>
 726                     <NOT <EMPTY? .L>>>
 727                <SET TUP <4 .C>>
 728                <SET C <REST .C 5>>)>
 729         <MAPF <>
 730               <FUNCTION (ITM "AUX" LU)
 731                       #DECL ((ITM) LOCAL)
 732                       <COND (<NOT .CFLG> <SET CFLG T>)>
 733                       <COND (<SET LU <LUPD .ITM>>
 734                              <SET FL (<LNAME .ITM> <SET LNUM <+ .LNUM 2>> !.FL)>
 735                              <COND (<AND <N==? .LU ARG> <N==? .LU OARG>>
 736                                     <SET C <REST .C 2>>)>)
 737                             (T
 738                              <COND (,WINNING-VICTIM
 739                                     <SETG WINNING-VICTIM <- ,WINNING-VICTIM 2>>)>
 740                              <SET CNT <+ .CNT 1>>
 741                              <PUTREST .C <REST .C 3>>
 742                              <COND (.TUP
 743                                     <PUT .TUP
 744                                          3
 745                                          <- <CHTYPE <3 .TUP> FIX> 1>>)>)>>
 746               .L>
 747         <COND (,WINNING-VICTIM
 748                <REPEAT ((WV ,WINNING-VICTIM) (L .FL))
 749                         #DECL ((L) <LIST [REST ANY FIX]> (WV) FIX)
 750                         <COND (<EMPTY? .L> <RETURN>)>
 751                         <PUT .L 2 <- <CHTYPE <2 .L> FIX> .WV -1>>
 752                         <SET L <REST .L 2>>>)>
 753         <COND (<NOT <EMPTY? .FL>>
 754                <PUTREST <REST .FL <- <LENGTH .FL> 1>> ,FINAL-LOCALS>
 755                <SETG FINAL-LOCALS .FL>)>
 756         <COND (<AND ,V1 <G? .CNT 0>>
 757                <CRLF>
 758                <PRIN1 .CNT>
 759                <PRINC " flushed temporaries.">
 760                <CRLF>)>>
 761
 762 <DEFINE OCEMIT ("TUPLE" T "AUX" (LABEL <>))
 763    #DECL ((T) TUPLE (LABEL) <OR ATOM FALSE>)
 764    <COND (<AND <1? <LENGTH .T>> <TYPE? <1 .T> ATOM>>
 765           <AND ,V1 <NOT ,PASS1> <INDENT-TO 30>>
 766           <SET LABEL T>)
 767          (<AND ,V1 <NOT ,PASS1>>
 768           <COND (<G? <M-HPOS .OUTCHAN> 45> <CRLF>)>
 769           <INDENT-TO 45>)>
 770    <MAPR <>
 771          <FUNCTION (Y "AUX" (X <1 .Y>) AC FOO AC1)
 772                  #DECL ((X) ANY (AC) <OR FALSE AC> (FOO) <OR FALSE ATOM>)
 773                  <COND (<AND <TYPE? .X LIST> <SET AC <IS-AC? <1 .X>>>>
 774                         <OR <==? .AC <GET-AC T*>>
 775                             <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>>
 776                         <COND (<SET FOO <AC-TYPE .AC>>
 777                                <LOAD-TYPE-IN-AC <AC-NAME .AC> .FOO>
 778                                <AC-TYPE .AC <>>)>
 779                         <COND (<AND <SET AC1 <GETPROP .AC AC-PAIR>>
 780                                     <==? <AC-ITEM .AC1> <AC-ITEM .AC>>>
 781                                <AC-TIME .AC1 ,AC-STAMP>)>)>
 782                  <SET AC <>>
 783                  <COND (<AND <TYPE? .X ATOM>
 784                              <SET AC <IS-AC? .X>>
 785                              <SET FOO <AC-TYPE .AC>>>
 786                         <LOAD-TYPE-IN-AC <AC-NAME .AC> .FOO>
 787                         <AC-TYPE .AC <>>)
 788                        (<TYPE? .X AC>
 789                         <PUT .Y 1 <AC-NAME <SET AC .X>>>
 790                         <COND (<SET FOO <AC-TYPE .X>>
 791                                <LOAD-TYPE-IN-AC <AC-NAME .AC> .FOO>
 792                                <AC-TYPE .X <>>)>)>
 793                  <COND (.AC
 794                         <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>
 795                         <COND (<AND <SET AC1 <GETPROP .AC AC-PAIR>>
 796                                     <==? <AC-ITEM .AC> <AC-ITEM .AC1>>>
 797                                <AC-TIME .AC1 ,AC-STAMP>)>)>>
 798          .T>
 799    <COND (<AND ,V1 <NOT ,PASS1>>
 800           <MAPF <>
 801                 <FUNCTION (ITM)
 802                      <COND (<TYPE? .ITM ATOM> <PRINC .ITM>)
 803                            (<TYPE? .ITM REF>
 804                             <PRINC "#REF [">
 805                             <COND (<TYPE? <1 .ITM> ATOM> <PRINC <1 .ITM>>)
 806                                   (ELSE <PRIN1 <1 .ITM>>)>
 807                             <PRINC "]">)
 808                            (<TYPE? .ITM LIST>
 809                             <PRINC "(">
 810                             <COND (<TYPE? <1 .ITM> ATOM> <PRINC <1 .ITM>>)
 811                                   (ELSE <PRIN1 <1 .ITM>>)>
 812                             <PRINC ")">)
 813                            (ELSE <PRIN1 .ITM>)>
 814                      <PRINC !\ >>
 815                 .T>)>
 816    <COND (.LABEL <AND ,V1 <NOT ,PASS1> <PRINC ":">>)
 817          (<NOT ,PASS1>
 818           <AND ,V1 <CRLF>>
 819           <SETG CC <REST <PUTREST ,CC (<CHTYPE [!.T] INST>)>>>)>>
 820
 821 <DEFINE XEMIT ("TUPLE" T "AUX" M COD)
 822         #DECL ((T) <TUPLE ATOM ATOM <OR FIX XTYPE-C REF>>
 823                (COD) <OR FIX XTYPE-C REF> (M) <OR VECTOR FALSE>)
 824         <COND (<NOT ,PASS1>
 825                <COND (<AND <TYPE? <SET COD <3 .T>> FIX>
 826                            <SET M <MEMQ .COD
 827                                         '[*1502* 10
 828                                           *1602* 10
 829                                           *1302* 12
 830                                           *1402* 16
 831                                           *1702* 10]>>>
 832                       <SETG CC
 833                             <REST <PUTREST
 834                                    ,CC
 835                                    (<CHTYPE [MOVE
 836                                              <2 .T>
 837                                              !<OBJ-VAL
 838                                                <CHTYPE
 839                                                 <ORB <LSH .COD 18>
 840                                                      <2 .M>> FIX>>] INST>)>>>)
 841                      (T <SETG CC <REST <PUTREST ,CC (<CHTYPE [!.T] INST>)>>>)>
 842                <COND (,V1
 843                       <INDENT-TO 40>
 844                       <PRINC "*TRQ*">
 845                       <MAPF <>
 846                             <FUNCTION (ITM)
 847                                  <COND (<TYPE? .ITM ATOM> <PRINC .ITM>)
 848                                        (<TYPE? .ITM REF>
 849                                         <PRINC "#REF [">
 850                                         <COND (<TYPE? <1 .ITM> ATOM>
 851                                                <PRINC <1 .ITM>>)
 852                                               (ELSE <PRIN1 <1 .ITM>>)>
 853                                         <PRINC "]">)
 854                                        (<TYPE? .ITM LIST>
 855                                         <PRINC "(">
 856                                         <COND (<TYPE? <1 .ITM> ATOM>
 857                                                <PRINC <1 .ITM>>)
 858                                               (ELSE <PRIN1 <1 .ITM>>)>
 859                                         <PRINC ")">)
 860                                        (ELSE <PRIN1 .ITM>)>
 861                                  <PRINC !\ >>
 862                             .T>
 863                       <CRLF>
 864                       <INDENT-TO 45>)>)>>
 865
 866 <DEFINE CONST-LOC (ITM TYP "OPT" NEWV)
 867         <COND (<==? .TYP TYPE>
 868                <TYPE-WORD <TYPE .ITM>>)
 869               (ELSE
 870                <COND (<TYPE? .ITM CONST-W-LOCAL>
 871                       <CONST-ADD .ITM>)
 872                      (ELSE
 873                       <CONST-ADD <SET ITM <CHTYPE .ITM CONSTANT>>>)>)>>
 874
 875 <DEFINE CONST-ADD (ITM "AUX" LBL (LS <+ ,CONSTSEQ 1>) HC BUCK INDX FCB)
 876         #DECL ((INDX HC LS) FIX (ITM) <OR CONSTANT CONST-W-LOCAL>
 877                (BUCK) <LIST [REST CONSTANT-BUCKET]> (FCB) CONSTANT-BUCKET)
 878         <COND (<TYPE? .ITM CONSTANT> <SET HC <CHTYPE .ITM FIX>>)
 879               (ELSE <SET HC <XORB <1 .ITM> <2 .ITM>>>)>
 880         <SET BUCK <NTH ,CONSTANT-TABLE
 881                        <SET INDX <+ <MOD <SET HC <XORB .HC 3.141516>>
 882                                          ,CONSTANT-TABLE-LENGTH> 1>>>>
 883         <COND (<MAPF <>
 884                      <FUNCTION (CB:CONSTANT-BUCKET "AUX" TEM)
 885                           <COND (<AND <==? .HC <CB-HASH .CB>>
 886                                       <OR <AND <TYPE? .ITM CONSTANT>
 887                                                <==? .ITM <CB-VAL .CB>>>
 888                                           <AND <TYPE? .ITM CONST-W-LOCAL>
 889                                                <TYPE? <SET TEM <CB-VAL .CB>>
 890                                                       CONST-W-LOCAL>
 891                                                <==? <1 .TEM> <1 .ITM>>
 892                                                <==? <2 .TEM> <2 .ITM>>>>>
 893                                  <SET FCB .CB>
 894                                  <MAPLEAVE T>)>>
 895                      .BUCK>)
 896               (ELSE
 897                <SET FCB <CHTYPE [.ITM .HC <CHTYPE <SETG CONSTSEQ .LS>
 898                                                    CONSTANT-LABEL> 0]
 899                                 CONSTANT-BUCKET>>
 900                <SETG CONSTANT-VECTOR (.FCB !,CONSTANT-VECTOR)>
 901                <PUT ,CONSTANT-TABLE .INDX (.FCB !.BUCK)>)>
 902         (<CHTYPE [.FCB] REF>)>
 903
 904 <DEFINE CONST-ADD-FRM ("AUX" CB)
 905         <SETG CONSTANT-VECTOR (<SET CB
 906                                     <CHTYPE [FREE 0 <CHTYPE <SETG CONSTSEQ
 907                                                                   <+ ,CONSTSEQ 1>>
 908                                                             CONSTANT-LABEL> 0]
 909                                             CONSTANT-BUCKET>>
 910                                !,CONSTANT-VECTOR)>
 911         <SETG FREE-CONSTS (.CB !,FREE-CONSTS)>>
 912
 913 <DEFINE OBJ-LOC (ITM OFF "AUX" IDX NUM LCL)
 914         #DECL ((ITM) ANY (OFF NUM) FIX (IDX) <OR FALSE FIX>)
 915         <COND (<TYPE? .ITM ATOM>
 916                <SET LCL
 917                     <OR <LMEMQ .ITM ,LOCALS>
 918                         <AND ,ICALL-FLAG <LMEMQ .ITM ,ICALL-TEMPS>>>>
 919                (<- .OFF ,STACK-DEPTH> <LNAME <CHTYPE .LCL LOCAL>>
 920                 <COND (,WINNING-VICTIM '(TP*)) (ELSE '(F*))>))
 921               (T
 922                <SET NUM <MVADD .ITM>>
 923                <SET NUM <* <+ .NUM 1> 2>>
 924                (<+ .OFF .NUM> '(M*)))>>
 925
 926 <DEFINE ALLOCATE-CONSTANTS (CV START)
 927         #DECL ((CV CL) LIST (START) FIX)
 928         <MAPF <>
 929               <FUNCTION (CB:CONSTANT-BUCKET)
 930                    <CB-LOC .CB .START>
 931                    <SET START <+ .START 1>>>
 932               .CV>>
 933
 934 <DEFINE FIXUP-CONSTANTS (C "AUX" (N 0))
 935    #DECL ((C CL) LIST)
 936    <MAPR <>
 937          <FUNCTION (CP "AUX" (IT <1 .CP>) R X)
 938                  <COND (<AND <TYPE? .IT INST>
 939                              <SET N <+ .N 1>>
 940                              <TYPE? <SET R <NTH .IT <LENGTH .IT>>> REF>>
 941                         <COND (<NOT <TYPE? <SET X <1 .R>> CONSTANT-BUCKET>>
 942                                <MIMOCERR BAD-REF-IN-CODE!-ERRORS .X>)
 943                               (,MAX-SPACE
 944                                <SETG GREFS ((.N .X) !,GREFS)>
 945                                <PUT .CP 1 <CHTYPE [<1 .IT> <2 .IT> 0 '(R*)] INST>>)
 946                               (ELSE
 947                                <PUT .CP
 948                                     1
 949                                     <CHTYPE [<1 .IT> <2 .IT>
 950                                              <CB-LOC .X>
 951                                              '(R*)] INST>>)>)>>
 952          .C>>
 953
 954 <DEFINE OBJ-VAL (ITM "OPTIONAL" (AC? T) "AUX" AC)
 955         #DECL ((ITM) ANY (AC AC?) <OR FALSE ATOM>)
 956         <COND (<AND .AC? <SET AC <IN-AC? .ITM VALUE>>> (.AC))
 957               (<==? <PRIMTYPE .ITM> FIX>
 958                <CONST-LOC <CHTYPE .ITM CONSTANT> VALUE>)
 959               (<TYPE? .ITM CONST-W-LOCAL> <CONST-LOC .ITM VALUE>)
 960               (T <OBJ-LOC .ITM 1>)>>
 961
 962 <DEFINE OBJ-TYP (ITM "AUX" AC)
 963         #DECL ((ITM) ANY (AC) <OR FALSE ATOM>)
 964         <COND (<SET AC <IN-AC? .ITM TYPE>> (.AC))
 965               (<AND <==? <PRIMTYPE .ITM> FIX>
 966                     <MEMQ <TYPE .ITM> ,TYPE-WORDS>>
 967                <CONST-LOC .ITM TYPE>)
 968               (T <OBJ-LOC .ITM 0>)>>
 969
 970 <DEFINE XJUMP (TAG "AUX" X)
 971         <COND (<AND <N==? <OBLIST? .TAG> ,LABEL-OBLIST>
 972                     <SET X <LOOKUP <SPNAME .TAG> ,LABEL-OBLIST>>>
 973                <SET TAG .X>)>
 974         <CHTYPE [.TAG] REF>>
 975
 976 <DEFINE DEAD!-MIMOC (LCLS "OPTIONAL" (PRED? <>) (NO-TY <>))
 977    #DECL ((LCLS) <LIST [REST ATOM]> (PRED?) <OR FALSE ATOM>)
 978    <COND (<NOT ,DEATH-TRQ> <SET NO-TY T>)>
 979    <MAPF <>
 980     <FUNCTION (AC "AUX" ITM FOO LCL)
 981             #DECL ((AC) AC (FOO) <OR FALSE ATOM> (LCL) LOCAL)
 982             <COND (<MEMQ <SET ITM <AC-ITEM .AC>> .LCLS>
 983                    <SET LCL
 984                         <OR <LMEMQ <AC-ITEM .AC> ,LOCALS>
 985                             <AND ,ICALL-FLAG
 986                                  <LMEMQ <AC-ITEM .AC> ,ICALL-TEMPS>>>>
 987                    <PUT .LCL ,LAST-ACST <>>
 988                    <PUT .LCL ,LAST-ACSV <>>
 989                    <COND (<SET FOO <AC-TYPE .AC>>
 990                           <COND (<NOT .NO-TY>
 991                                  <LOAD-TYPE-IN-AC <AC-NAME .AC> .FOO>
 992                                  <AC-TYPE .AC <>>)>)>
 993                    <AC-UPDATE .AC <>>
 994                    <COND (<NOT .PRED?>
 995                           <AC-CODE .AC DUMMY>
 996                           <AC-ITEM .AC <>>
 997                           <AC-TIME .AC 0>)>)>>
 998     ,AC-TABLE>>
 999
1000 <COND (<NOT <GASSIGNED? LBLSEQ>> <SETG CONSTSEQ <SETG LBLSEQ 0>>)>
1001
1002 <DEFINE GENLBL (STR)
1003         #DECL ((STR) STRING)
1004         <SET STR <STRING .STR <UNPARSE <SETG LBLSEQ <+ ,LBLSEQ 1>>>>>
1005         <OR <LOOKUP .STR ,LABEL-OBLIST> <INSERT .STR ,LABEL-OBLIST>>>
1006
1007 <DEFINE LABEL (NAM "OPT" (IND <>) (CP ()) "AUX" (LB <>))
1008         #DECL ((NAM) ATOM (IND) <OR FALSE FIX>)
1009         <SET LB <FIND-LABEL .NAM>>
1010         <COND (,PASS1
1011                <COND (<NOT .LB>
1012                       <SET LB <MAKE-LABEL .NAM .IND .CP>>)
1013                      (.IND
1014                       <LAB-IND .LB .IND>)>
1015                <PUT .LB ,LAB-LOOP ,NEXT-LOOP>
1016                .LB)
1017               (ELSE <SETG CC <REST <PUTREST ,CC (.NAM)>>> <OCEMIT .NAM> .LB)>>
1018
1019 <DEFINE MAKE-LABEL (NAM IND CP "OPT" (NL <>) "AUX" LB)
1020         <SETG LABELS
1021               (<SET LB <CHTYPE [.NAM .IND .NL () <> 0 .CP ()] LAB>>
1022                !,LABELS)>
1023         <SETG .NAM .LB>>
1024
1025
1026 <DEFINE LONG-FIND-LABEL (NAM LBLS) #DECL ((LBLS) <LIST [REST LAB]>)
1027         <MAPF <>
1028               <FUNCTION (LB) #DECL ((LB) LAB)
1029                    <COND (<==? <LAB-NAM .LB> .NAM> <MAPLEAVE .LB>)>>
1030               .LBLS>>
1031
1032 <DEFINE FIND-LABEL (NAM )
1033         #DECL ((LBLS) LIST)
1034         <COND (<GASSIGNED? .NAM> ,.NAM)>>
1035
1036 <DEFINE TYPE-CODE (TYP "OPT" (LS <>) "AUX" L)
1037         #DECL ((TYP) ATOM (L) <OR FALSE VECTOR>)
1038         <COND (<SET L <MEMQ .TYP ,TYPE-WORDS>>
1039                <COND (.LS (<2 .L>)) (ELSE <2 .L>)>)
1040               (<VALID-TYPE? .TYP>
1041                <COND (.LS (@ !<OBJ-LOC <CHTYPE .TYP XTYPE-C> 1>))
1042                      (ELSE <CHTYPE .TYP XTYPE-C>)>)
1043               (T <MIMOCERR UNDEFINED-TYPE!-ERRORS .TYP>)>>
1044
1045 <DEFINE TYPE-WORD (TYP "AUX" L VAL M)
1046         #DECL ((TYP) ATOM (L M) <OR FALSE VECTOR> (VAL) CONSTANT)
1047         <COND (<SET L <MEMQ .TYP ,TYPE-WORDS>>
1048                <SET VAL <CHTYPE <LSH <2 .L> 18> CONSTANT>>
1049                <COND (<SET M <MEMQ .TYP ,TYPE-LENGTHS>>
1050                       <SET VAL <CHTYPE <ORB .VAL <2 .M>> CONSTANT>>)>
1051                <CONST-ADD .VAL>
1052                <CONST-LOC .VAL VALUE>)
1053               (<VALID-TYPE? .TYP> <OBJ-LOC <CHTYPE .TYP XTYPE-W> 1>)
1054               (T <MIMOCERR CANT-TYPE-WORD!-ERRORS .TYP>)>>
1055
1056 <DEFINE PUSHJ (NAM "OPTIONAL" (VAL <>) (TAG <>) (TYP <>) "AUX" AC
1057                (OC <OPCODE .NAM>))
1058         #DECL ((NAM) ATOM (VAL) <OR ATOM FALSE> (AC) AC (OC) FIX)
1059         <FLUSH-ACS>
1060         <COND (<G? .OC 0>
1061                <OCEMIT PUSHJ P* @ .OC>)
1062               (ELSE
1063                <OCEMIT JSP T* @ <- .OC>>)>
1064         <COND (.TAG <OCEMIT JRST <XJUMP .TAG>>)>
1065         <COND (.TYP <OCEMIT HRLI A1* !<TYPE-CODE .TYP T>>)>
1066         <PUSHJ-VAL .VAL>>
1067
1068 <DEFINE PUSHJ-VAL (VAL "AUX" AC)
1069         #DECL ((VAL) <OR FALSE ATOM> (AC) AC)
1070         <COND (<==? .VAL STACK>
1071                <OCEMIT PUSH TP* A1*>
1072                <OCEMIT PUSH TP* A2*>
1073                <COND (,WINNING-VICTIM <SETG STACK-DEPTH <+ ,STACK-DEPTH 2>>)>)
1074               (.VAL
1075                <SET AC <GET-AC A1*>>
1076                <AC-ITEM .AC .VAL>
1077                <AC-CODE .AC TYPE>
1078                <AC-UPDATE .AC T>
1079                <AC-TIME .AC <SETG AC-STAMP <+ ,AC-STAMP 1>>>
1080                <SET AC <GET-AC A2*>>
1081                <AC-ITEM .AC .VAL>
1082                <AC-CODE .AC VALUE>
1083                <AC-UPDATE .AC T>
1084                <AC-TIME .AC ,AC-STAMP>)>>
1085
1086 ;"Actual code for open-coding specific MIM instructions"
1087
1088 <SETG MIMOC-OBLIST <MOBLIST MIMOC 51>>
1089
1090 <SETG EVALABLES '[TYPE-CODE TYPE-WORD]>
1091
1092 <GDECL (EVALABLES) VECTOR>
1093
1094 <DEFINE OC (FRM OBLIST "AUX" ATM (EVF <>))
1095         #DECL ((FRM) FORM (ATM EVF) <OR FALSE ATOM> (OBLIST) <SPECIAL ANY>)
1096         <AND <NOT ,PASS1> ,V1 <PRINT .FRM>>
1097         <MAPR <>
1098               <FUNCTION (L "AUX" (ITM <1 .L>))
1099                       #DECL ((L) LIST)
1100                       <COND (<AND <TYPE? .ITM FORM>
1101                                   <NOT <EMPTY? .ITM>>
1102                                   <MEMQ <1 .ITM> ,EVALABLES>>
1103                              <PUT .L 1 <EVAL .ITM>>
1104                              <PUTPROP .L EVAL .ITM>
1105                              <SET EVF T>)>>
1106               .FRM>
1107         <COND (<SET ATM <LOOKUP <SPNAME <1 .FRM>> ,MIMOC-OBLIST>>
1108                <APPLY ,.ATM <REST .FRM>>
1109                <COND (<AND .EVF <NOT ,PASS1>>
1110                       <MAPR <> <FUNCTION (L) <PUTPROP .L EVAL>> .FRM>)>)
1111               (T <MIMOCERR CANT-OPEN-COMPILE!-ERRORS .FRM>)>>
1112
1113 ;"Gross and disgusting hack for UNWINDage"
1114
1115 <DEFINE LOCATION!-MIMOC (L "AUX" NAC)
1116         #DECL ((L) LIST (NAC) ATOM)
1117         <SET NAC <ASSIGN-AC <4 .L> BOTH>>
1118         <AC-TYPE <GET-AC .NAC> FIX>
1119         <COND (,GLUE-MODE <OCEMIT MOVEI <NEXT-AC .NAC> 0>)
1120               (ELSE <OCEMIT XMOVEI <NEXT-AC .NAC> 0 '(R*)>)>
1121         <COND (<NOT ,PASS1>
1122                <SETG LOCATIONS (<1 ,CC> <2 .L> !,LOCATIONS)>)>
1123         <COND (<NOT ,GLUE-MODE> <OCEMIT SUB <NEXT-AC .NAC> R*>)>>
1124
1125 <DEFINE LOCATION-CHECK ()
1126         <REPEAT ((O ,LOCATIONS))
1127                 #DECL ((O) <LIST [REST INST ATOM]>)
1128                 <COND (<EMPTY? .O> <RETURN>)
1129                       (T <PUT <1 .O> 3 <LAB-IND <FIND-LABEL <2 .O>>>>)>
1130                 <SET O <REST .O 2>>>>
1131
1132 <DEFINE LOAD-TYPE-IN-AC (ACNAM TYP)
1133         <COND (<MEMQ .TYP ,TYPE-LENGTHS>
1134                <XEMIT MOVE .ACNAM !<TYPE-WORD .TYP>>)
1135               (ELSE
1136                <XEMIT MOVSI .ACNAM !<TYPE-CODE .TYP T>>)>>
1137
1138
1139 <DEFINE SAVE-BRANCH-STATE (LB UNCND "AUX" NS (LS <LAB-STATE .LB>)
1140                                           (LOOP? <LAB-LOOP .LB>))
1141    #DECL ((LB) LAB (LS) LIST)
1142    <SET NS
1143     <CHTYPE
1144      <MAPF ,VECTOR
1145            <FUNCTION (AC NULL-STATE "AUX" LCL ACS)
1146                    #DECL ((AC) AC)
1147                    <COND (<AND <AC-ITEM .AC> <NOT <TYPE? <AC-ITEM .AC> LOSE>>>
1148                           <OR <SET LCL <LMEMQ <AC-ITEM .AC> ,LOCALS>>
1149                               <AND ,ICALL-FLAG
1150                                    <SET LCL
1151                                         <LMEMQ <AC-ITEM .AC> ,ICALL-TEMPS>>>>)
1152                          (ELSE <SET LCL <>>)>
1153                    <COND (<AND <AC-UPDATE .AC>
1154                                <NOT .LOOP?>
1155                                <OR .UNCND <WILL-DIE? <AC-ITEM .AC>>>
1156                                <WILL-DIE? <AC-ITEM .AC> <LAB-CODE-PNTR .LB>>>
1157                           <SET LCL <>>
1158                           <AC-UPDATE .AC <>>
1159                           <AC-ITEM .AC <>>)>
1160                    <COND (.LCL
1161                           <COND (<AND <==? <AC-CODE .AC> TYPE>
1162                                       <SET ACS <LAST-ACST .LCL>>
1163                                       <NOT <ACS-STORED .ACS>>
1164                                       <OR <N==? <ACS-AC .ACS> .AC>
1165                                           <NOT <AC-UPDATE .AC>>>>
1166                                  <PUT .ACS ,ACS-STORED HACKED>)>
1167                           <COND (<AND <==? <AC-CODE .AC> VALUE>
1168                                       <SET ACS <LAST-ACSV .LCL>>
1169                                       <NOT <ACS-STORED .ACS>>
1170                                       <OR <N==? <ACS-AC .ACS> .AC>
1171                                           <NOT <AC-UPDATE .AC>>>>
1172                                  <PUT .ACS ,ACS-STORED HACKED>)>
1173                           <SET ACS <CHTYPE [.AC
1174                                             .LCL
1175                                             <NOT <AC-UPDATE .AC>>
1176                                             <AC-TYPE .AC>
1177                                             <AC-CODE .AC>]
1178                                            ACSTATE>>
1179                           <COND (<==? <AC-CODE .AC> TYPE>
1180                                  <PUT .LCL ,LAST-ACST .ACS>)
1181                                 (ELSE
1182                                  <PUT .LCL ,LAST-ACSV .ACS>)>
1183                           .ACS)
1184                          (ELSE .NULL-STATE)>>
1185            ,AC-PAIR-TABLE
1186            ,NULL-STATES>
1187      LABSTATE>>
1188    <COND (<EMPTY? .LS> <PUT .LB ,LAB-STATE (.NS)>)
1189          (ELSE <PUTREST <REST .LS <- <LENGTH .LS> 1>> (.NS)>)>
1190    <COND (<LAB-LOOP .LB>
1191           <COND (<LAB-FINAL-STATE .LB>
1192                  <MERGE-TWO-FORCE .NS <LAB-FINAL-STATE .LB>>)>
1193           <LOGICAL-ESTABLISH .NS>)
1194          (ELSE
1195           <COND (<LAB-FINAL-STATE .LB>
1196                  <MERGE-TWO .NS <LAB-FINAL-STATE .LB>>)>
1197           <ESTABLISH-UPDATE .NS>)>
1198    <COND (.UNCND <FLUSH-ACS>) (ELSE <MUNGED-AC T*> <MUNGED-AC O*>)>>
1199
1200 <DEFINE SAVE-LABEL-STATE (LB "AUX" NS)
1201    <COND
1202     (<NOT ,LAST-UNCON>
1203      <SET NS
1204       <CHTYPE
1205        <MAPF ,VECTOR
1206              <FUNCTION (AC NULL-STATE "AUX" LCL (ITM <AC-ITEM .AC>) ACS)
1207                      #DECL ((AC) AC)
1208                      <COND (<AND .ITM <NOT <TYPE? .ITM LOSE>>>
1209                             <OR <SET LCL <LMEMQ .ITM ,LOCALS>>
1210                                 <AND ,ICALL-FLAG
1211                                      <SET LCL <LMEMQ .ITM ,ICALL-TEMPS>>>>)
1212                            (ELSE <SET LCL <>>)>
1213                      <COND (.LCL
1214                             <COND (<AND <==? <AC-CODE .AC> TYPE>
1215                                       <SET ACS <LAST-ACST .LCL>>
1216                                       <NOT <ACS-STORED .ACS>>
1217                                       <OR <N==? <ACS-AC .ACS> .AC>
1218                                           <NOT <AC-UPDATE .AC>>>>
1219                                  <PUT .ACS ,ACS-STORED HACKED>)>
1220                           <COND (<AND <==? <AC-CODE .AC> VALUE>
1221                                       <SET ACS <LAST-ACSV .LCL>>
1222                                       <NOT <ACS-STORED .ACS>>
1223                                       <OR <N==? <ACS-AC .ACS> .AC>
1224                                           <NOT <AC-UPDATE .AC>>>>
1225                                  <PUT .ACS ,ACS-STORED HACKED>)>
1226                             <SET ACS <CHTYPE [.AC
1227                                               .LCL
1228                                               <NOT <AC-UPDATE .AC>>
1229                                               <AC-TYPE .AC>
1230                                               <AC-CODE .AC>]
1231                                              ACSTATE>>
1232                             <COND (<==? <AC-CODE .AC> TYPE>
1233                                    <PUT .LCL ,LAST-ACST .ACS>)
1234                                   (ELSE
1235                                    <PUT .LCL ,LAST-ACSV .ACS>)>
1236                             .ACS)
1237                            (ELSE .NULL-STATE)>>
1238              ,AC-PAIR-TABLE
1239              ,NULL-STATES>
1240        LABSTATE>>
1241      <PUT .LB ,LAB-STATE (.NS !<LAB-STATE .LB>)>
1242      <COND (<NOT <LAB-LOOP .LB>> <KILL-DEAD-ACS .LB>)>
1243      <COND (<NOT <LAB-FINAL-STATE .LB>>
1244             <PUT .LB ,LAB-FINAL-STATE .NS>)>
1245      <MERGE-TWO <1 <LAB-STATE .LB>> <LAB-FINAL-STATE .LB>>
1246      <ESTABLISH-LABEL-STATE .LB <1 <LAB-STATE .LB>>>
1247      T)
1248     (ELSE
1249      <COND (<NOT <LAB-LOOP .LB>> <KILL-DEAD-ACS .LB>)>
1250      <COND (<AND <NOT <LAB-FINAL-STATE .LB>> <NOT <EMPTY? <LAB-STATE .LB>>>>
1251             <PUT .LB ,LAB-FINAL-STATE <1 <LAB-STATE .LB>>>)>
1252      <COND (<LAB-FINAL-STATE .LB> <ESTABLISH-LABEL-STATE .LB>)>)>>
1253
1254 <DEFINE KILL-DEAD-ACS (LB)
1255         #DECL ((LB) LAB)
1256         <COND (<LAB-FINAL-STATE .LB> <KILL-ONE-STATE <LAB-FINAL-STATE .LB>>)>
1257         <MAPF <> ,KILL-ONE-STATE <LAB-STATE .LB>>>
1258
1259 <DEFINE KILL-ONE-STATE (LSTATE)
1260         #DECL ((LSTATE) LABSTATE)
1261         <MAPF <>
1262          <FUNCTION (ACST "AUX" LCL)
1263                  #DECL ((ACST) ACSTATE (LCL) LOCAL)
1264                  <COND (<AND <ACS-LOCAL .ACST>
1265                              <WILL-DIE? <LATM <SET LCL <ACS-LOCAL .ACST>>>>>
1266                         <PUT .LCL ,LAST-ACST <>>
1267                         <PUT .LCL ,LAST-ACSV <>>
1268                         <PUT .ACST ,ACS-LOCAL
1269                              <CHTYPE (<ACS-LOCAL .ACST>) FALSE>>
1270                         <PUT .ACST ,ACS-STORED DEAD>)>>
1271          .LSTATE>>
1272
1273 <DEFINE ESTABLISH-BRANCH-STATE (LB UNCND
1274                                 "OPT" (AC-P1 <>) (AC-P2 <>)
1275                                       (LS <LAB-FINAL-STATE .LB>)
1276                                 "AUX" (LOOP? <LAB-LOOP .LB>) (MOVES-TO ())
1277                                       SAVED? (MOVES-FROM ()))
1278    #DECL ((LB) LAB (LS) LABSTATE)
1279    <MAPF <>
1280     <FUNCTION (STAT
1281                "AUX" LCL1 (AC <ACS-AC .STAT>) (LCL2 <AC-ITEM .AC>)
1282                      (NEW-AC? <>))
1283        #DECL ((STAT) ACSTATE (AC) AC)
1284        <COND (<TYPE? .LCL2 LOSE> <SET LCL2 <>>)>
1285        <COND (<AND <AC-UPDATE .AC>
1286                    <NOT .LOOP?>
1287                    .LCL2
1288                    <OR .UNCND <WILL-DIE? .LCL2>>
1289                    <WILL-DIE? .LCL2 <LAB-CODE-PNTR .LB>>
1290                    <COND (<ASSIGNED? DISP-L>
1291                           <MAPF <>
1292                                 <FUNCTION (X)
1293                                      <COND (<WILL-DIE? .LCL2
1294                                                        <LAB-CODE-PNTR
1295                                                         <FIND-LABEL .X>>>
1296                                             T)
1297                                            (ELSE <MAPLEAVE <>>)>>
1298                                 .DISP-L>)
1299                          (ELSE T)>>
1300               <SET LCL2 <>>
1301               <AC-UPDATE .AC <>>
1302               <AC-ITEM .AC <>>)>
1303        <COND
1304         (<OR <AND <SET LCL1 <ACS-LOCAL .STAT>> <==? <LATM .LCL1> .LCL2>>
1305              <AND <NOT .LCL1> <NOT .LOOP?>>>
1306          <COND (<AND <AC-UPDATE .AC>
1307                      <OR <AND <NOT .LCL1> <EMPTY? .LCL1>>
1308                          <AND <ACS-STORED .STAT>
1309                               <OR .LCL1
1310                                   <AND <NOT <EMPTY? .LCL1>>
1311                                        <N==? <LATM <1 .LCL1>> .LCL2>>>>>>
1312                 <UPDATE-AC .AC T>
1313                 <AC-UPDATE .AC <>>)>)
1314         (<AND .LCL1
1315               .LOOP?
1316               <OR <NOT .LCL2> <N==? <LATM .LCL1> .LCL2>>
1317               <SET NEW-AC? <FIND-AC .LCL1 <ACS-CODE .STAT>>>>
1318          <COND (<NOT <AND <ACS-TYPE .STAT>
1319                           <OR <NOT <ACS-STORED .STAT>>
1320                               <LDECL .LCL1>
1321                               <==? <ACS-TYPE .STAT> <AC-TYPE .NEW-AC?>>>>>
1322                 <SET MOVES-TO (.AC !.MOVES-TO)>
1323                 <SET MOVES-FROM (.NEW-AC? !.MOVES-FROM)>)>)
1324         (<AND .LCL1 .LOOP? <NOT .NEW-AC?>> <ERROR AC-SCREW-UP!-ERRORS>)>
1325        <COND (<AND .LOOP?
1326                    .LCL2
1327                    <NOT <FIND-LOCAL .LCL2 <AC-CODE .AC> .LS T>>
1328                    <AC-UPDATE .AC>>
1329               <UPDATE-AC .AC T>
1330               <AC-UPDATE .AC <>>)>>
1331     .LS>
1332    <COND (<AND .AC-P1 <SET AC-P1 <GET-AC .AC-P1>> <MEMQ .AC-P1 .MOVES-TO>>
1333           <COND (<SET SAVED? <MEMQ .AC-P1 .MOVES-FROM>>
1334                  <SET AC-P1
1335                       <NTH .MOVES-TO
1336                            <- <LENGTH .MOVES-FROM> <LENGTH .SAVED?> -1>>>)
1337                 (ELSE
1338                  <SET MOVES-FROM (.AC-P1 !.MOVES-FROM)>
1339                  <SET MOVES-TO
1340                       (<SET AC-P1 <FIND-FREE-TO .MOVES-TO .MOVES-FROM>>
1341                        !.MOVES-TO)>)>)>
1342    <COND (<AND .AC-P2 <SET AC-P2 <GET-AC .AC-P2>> <MEMQ .AC-P2 .MOVES-TO>>
1343           <COND (<SET SAVED? <MEMQ .AC-P2 .MOVES-FROM>>
1344                  <SET AC-P2
1345                       <NTH .MOVES-TO
1346                            <- <LENGTH .MOVES-FROM> <LENGTH .SAVED?> -1>>>)
1347                 (ELSE
1348                  <SET MOVES-FROM (.AC-P2 !.MOVES-FROM)>
1349                  <SET MOVES-TO
1350                       (<SET AC-P2 <FIND-FREE-TO .MOVES-TO .MOVES-FROM>>
1351                        !.MOVES-TO)>)>)>
1352    <COND
1353     (<NOT <EMPTY? .MOVES-FROM>>
1354      <REPEAT ((WIN T) GOT-ONE)
1355        <SET GOT-ONE <>>
1356        <MAPR <>
1357         <FUNCTION (PT PF
1358                    "AUX" (AC-TO? <1 .PT>) PAT1 PAT2 AT1 AT2 AF P-TO? P-FROM)
1359            #DECL ((AT1 AT2 PAT1 PAT2) FIX (AF P-FROM) AC
1360                   (PT PF) <LIST <OR AC FALSE>> (AC-TO? P-TO?) <OR AC FALSE>)
1361            <COND
1362             (<==? .AC-TO? <1 .PF>> <PUT .PF 1 <>> <PUT .PT 1 <>>)
1363             (.AC-TO?
1364              <SET WIN <>>
1365              <COND (<NOT <MEMQ .AC-TO? .MOVES-FROM>>
1366                     <SET AT1 <AC-TIME .AC-TO?>>
1367                     <SET AT2 <AC-TIME <SET AF <1 .PF>>>>
1368                     <SET GOT-ONE T>
1369                     <COND (<AND <NOT <EMPTY? <REST .PT>>>
1370                                 <SET P-TO? <2 .PT>>
1371                                 <==? <NEXT-AC <AC-NAME .P-TO?>>
1372                                      <AC-NAME .AC-TO?>>
1373                                 <SET P-FROM <2 .PF>>
1374                                 <==? <NEXT-AC <AC-NAME .P-FROM>> <AC-NAME .AF>>
1375                                 <NOT <MEMQ .P-TO? .MOVES-FROM>>>
1376                            <SET PAT1 <AC-TIME .P-TO?>>
1377                            <SET PAT2 <AC-TIME .P-FROM>>
1378                            <OCEMIT DMOVE <AC-NAME .P-TO?> <AC-NAME .P-FROM>>
1379                            <AC-TIME .P-TO? .PAT1>
1380                            <AC-TIME .P-FROM .PAT2>
1381                            <PUT .PT 2 <>>
1382                            <PUT .PF 2 <>>)
1383                           (<AC-TYPE .AF>
1384                            <LOAD-TYPE-IN-AC <AC-NAME .AC-TO?> <AC-TYPE .AF>>)
1385                           (ELSE <OCEMIT MOVE <AC-NAME .AC-TO?> <AC-NAME .AF>>)>
1386                     <AC-TIME .AC-TO? .AT1>
1387                     <AC-TIME .AF .AT2>
1388                     <PUT .PT 1 <>>
1389                     <PUT .PF 1 <>>)>)>>
1390         .MOVES-TO
1391         .MOVES-FROM>
1392        <COND (.WIN <RETURN>)>
1393        <COND
1394         (<NOT .GOT-ONE>
1395          <MAPR <>
1396           <FUNCTION (PT PF
1397                      "AUX" (AC-TO? <1 .PT>) (AC-FROM <1 .PF>) PP1 PP2 AT1 AT2)
1398                   #DECL ((AT1 AT2) FIX (PT PF) <LIST <OR AC FALSE>>
1399                          (AC-TO? AC-FROM) <OR AC FALSE>)
1400                   <COND (<AND .AC-TO? .AC-FROM>
1401                          <SET AT1 <AC-TIME .AC-TO?>>
1402                          <SET AT2 <AC-TIME .AC-FROM>>
1403                          <OCEMIT EXCH <AC-NAME .AC-TO?> <AC-NAME .AC-FROM>>
1404                          <AC-TIME .AC-TO? .AT1>
1405                          <AC-TIME .AC-FROM .AT2>
1406                          <PUT .PT 1 <>>
1407                          <PUT .PF 1 <>>
1408                          <COND (<SET PP1 <MEMQ .AC-TO? .MOVES-FROM>>
1409                                 <PUT .PP1 1 .AC-FROM>)>
1410                          <COND (<AND <SET PP2 <MEMQ .AC-FROM .MOVES-FROM>>
1411                                      <N==? .PP1 .PP2>>
1412                                 <PUT .PP2 1 .AC-TO?>)>
1413                          <MAPLEAVE>)>>
1414           .MOVES-TO
1415           .MOVES-FROM>)>
1416        <SET WIN T>>)>
1417    <COND (.UNCND <FLUSH-ACS>) (.LOOP? <LOGICAL-ESTABLISH .LS>)>
1418    <COND (.AC-P1
1419           <COND (.AC-P2 (<AC-NAME .AC-P1> <AC-NAME .AC-P2>))
1420                 (ELSE (<AC-NAME .AC-P1>))>)>>
1421
1422 <DEFINE FIND-FREE-TO (L1 L2 "AUX" (BEST <>))
1423         #DECL ((L1 L2) <LIST [REST AC]>)
1424         <MAPF <>
1425               <FUNCTION (AC) #DECL ((AC) AC)
1426                    <COND (<NOT <MEMQ .AC .L1>>
1427                           <COND (<MEMQ .AC .L2>
1428                                  <SET BEST .AC>
1429                                  <MAPLEAVE>)
1430                                 (<NOT .BEST> <SET BEST .AC>)>)>>
1431               ,AC-PAIR-TABLE>
1432         .BEST>
1433
1434 <DEFINE LOGICAL-ESTABLISH (LS)
1435    #DECL ((LS) LABSTATE)
1436    <MAPF <>
1437     <FUNCTION (STAT "AUX" (AC <ACS-AC .STAT>))
1438             #DECL ((STAT) ACSTATE (AC) AC)
1439             <COND (<ACS-LOCAL .STAT>
1440                    <AC-CODE <AC-ITEM .AC <LATM <ACS-LOCAL .STAT>>>
1441                             <ACS-CODE .STAT>>
1442                    <AC-TYPE <AC-UPDATE .AC <NOT <ACS-STORED .STAT>>>
1443                             <ACS-TYPE .STAT>>)
1444                   (<FIND-LOCAL <AC-ITEM .AC> <AC-CODE .AC> .LS>
1445                    <AC-TIME <AC-ITEM <AC-CODE <AC-TYPE .AC <>> DUMMY> <>> 0>)
1446                   (<OR <==? <AC-CODE .AC> TYPE> <==? <AC-CODE .AC> VALUE>>
1447                    <AC-UPDATE .AC <>>)>>
1448     .LS>>
1449
1450 <DEFINE ESTABLISH-UPDATE (LS)
1451         #DECL ((LS) LABSTATE)
1452         <MAPF <>
1453               <FUNCTION (STAT "AUX" (AC <ACS-AC .STAT>))
1454                       #DECL ((STAT) ACSTATE (AC) AC)
1455                       <COND (<OR <AND <ACS-LOCAL .STAT> <ACS-STORED .STAT>>
1456                                  <NOT <ACS-LOCAL .STAT>>>
1457                              <AC-UPDATE .AC <>>)>>
1458               .LS>>
1459
1460 <DEFINE FIND-LOCAL (ATM COD LS "OPT" (STORE-CHECK <>))
1461         #DECL ((LS) LABSTATE)
1462         <MAPF <>
1463               <FUNCTION (STAT)
1464                       #DECL ((STAT) ACSTATE)
1465                       <COND (<AND <ACS-LOCAL .STAT>
1466                                   <==? <LATM <ACS-LOCAL .STAT>> .ATM>
1467                                   <==? .COD <ACS-CODE .STAT>>
1468                                   <NOT <AND .STORE-CHECK <ACS-STORED .STAT>>>>
1469                              <MAPLEAVE T>)>>
1470               .LS>>
1471
1472 <DEFINE FIND-AC (LCL COD "AUX" (ATM <LATM .LCL>))
1473         #DECL ((LCL) LOCAL)
1474         <MAPF <>
1475               <FUNCTION (AC)
1476                       #DECL ((AC) AC)
1477                       <COND (<AND <==? <AC-ITEM .AC> .ATM>
1478                                   <==? <AC-CODE .AC> .COD>>
1479                              <MAPLEAVE .AC>)>>
1480               ,AC-PAIR-TABLE>>
1481
1482 <DEFINE ESTABLISH-LABEL-STATE (LB "OPT" (LS <LAB-FINAL-STATE .LB>))
1483    #DECL ((LB) LAB (LS) <OR FALSE LABSTATE>)
1484    <COND
1485     (.LS
1486      <MAPF <>
1487            <FUNCTION (STAT "AUX" AC ACL)
1488                    #DECL ((STAT) ACSTATE (AC) AC)
1489                    <SET AC <ACS-AC .STAT>>
1490                    <COND (<AND <NOT ,LAST-UNCON>
1491                                <OR <SET ACL <ACS-LOCAL .STAT>>
1492                                    <EMPTY? .ACL>
1493                                    <N==? <LATM <1 .ACL>> <AC-ITEM .AC>>>
1494                                <OR <NOT .ACL>
1495                                    <AND <ACS-STORED .STAT>
1496                                         <OR <NOT <ACS-TYPE .STAT>>
1497                                             <NOT <LDECL .ACL>>>>>
1498                                <AC-UPDATE .AC>>
1499                           <UPDATE-AC .AC T>)>
1500                    <COND (<NOT <ACS-LOCAL .STAT>>
1501                           <AC-UPDATE .AC <>>
1502                           <AC-ITEM .AC <>>
1503                           <AC-CODE .AC DUMMY>)
1504                          (ELSE
1505                           <AC-CODE .AC <ACS-CODE .STAT>>
1506                           <AC-ITEM .AC <LATM <ACS-LOCAL .STAT>>>
1507                           <AC-UPDATE .AC <NOT <ACS-STORED .STAT>>>
1508                           <AC-TYPE .AC <ACS-TYPE .STAT>>)>>
1509            .LS>
1510      <FLUSH-AC T*>
1511      <MUNGED-AC T*>
1512      <FLUSH-AC O*>
1513      <MUNGED-AC O*>)
1514     (ELSE <FLUSH-ACS>)>
1515    T>
1516
1517 <DEFINE PLS (LAB "AUX" (N 0))
1518         <COND (<TYPE? .LAB ATOM> <SET LAB <FIND-LABEL .LAB>>)>
1519         <CRLF>
1520         <PRINC "States for label: ">
1521         <PRIN1 <LAB-NAM .LAB>>
1522         <COND (<LAB-LOOP .LAB> <PRINC " (loop)">)>
1523         <CRLF>
1524         <CRLF>
1525         <COND (<LAB-FINAL-STATE .LAB>
1526                <PRINC "Current final state">
1527                <CRLF> <CRLF>
1528                <PSTATE <LAB-FINAL-STATE .LAB>>)>
1529         <COND (<NOT <EMPTY? <LAB-STATE .LAB>>>
1530                <MAPF <>
1531                      <FUNCTION (S)
1532                           <PRINC "State ">
1533                           <PRIN1 <SET N <+ .N 1>>>
1534                           <CRLF>
1535                           <CRLF>
1536                           <PSTATE .S>>
1537                      <LAB-STATE .LAB>>)>>
1538
1539 <DEFINE PSTATE (LS) #DECL ((LS) LABSTATE)
1540         <MAPF <>
1541               <FUNCTION (ACS) #DECL ((ACS) ACSTATE)
1542                    <COND (<ACS-LOCAL .ACS>
1543                           <PRIN1 <AC-NAME <ACS-AC .ACS>>>
1544                           <PRINC " ">
1545                           <PRIN1 <LATM <ACS-LOCAL .ACS>>>
1546                           <PRINC <COND (<ACS-STORED .ACS> " stored ")
1547                                        (ELSE " not stored ")>>
1548                           <COND (<ACS-TYPE .ACS>
1549                                  <PRINC "type is ">
1550                                  <PRIN1 <ACS-TYPE .ACS>>)>
1551                           <CRLF>)
1552                          (<==? <ACS-STORED .ACS> DEAD>
1553                           <PRIN1 <AC-NAME <ACS-AC .ACS>>>
1554                           <PRINC " ">
1555                           <PRIN1 <LATM <1 <ACS-LOCAL .ACS>>>>
1556                           <PRINC " dead!">
1557                           <CRLF>)>>
1558               .LS>>
1559
1560 <DEFINE MERGE-LABEL-STATES ()
1561         <MAPF <>
1562               <FUNCTION (LAB "AUX" (LS <LAB-STATE .LAB>) TEM)
1563                       #DECL ((LAB) LAB)
1564                       <COND (<SET TEM <LAB-FINAL-STATE .LAB>>)
1565                             (<NOT <EMPTY? .LS>>
1566                              <SET TEM <1 .LS>>
1567                              <SET LS <REST .LS>>)>
1568                       <COND (<NOT <EMPTY? .LS>> <MERGE-ONE-SET .TEM .LS .LAB>)
1569                             (ELSE
1570                              <PUT .LAB ,LAB-STATE ()>
1571                              <PUT .LAB ,LAB-FINAL-STATE .TEM>)>>
1572               ,LABELS>>
1573
1574 <DEFINE MERGE-ONE-SET (FIRST RESTP LAB)
1575         #DECL ((RESTP) <LIST LABSTATE [REST LABSTATE]> (FIRST) LABSTATE
1576                (LAB) LAB)
1577         <MAPF <>
1578               <FUNCTION (NEXT "AUX" CH)
1579                       #DECL ((NEXT) LABSTATE)
1580                       <SET CH
1581                            <COND (<LAB-LOOP .LAB>
1582                                   <MERGE-TWO-FORCE .FIRST .NEXT>)
1583                                  (ELSE <MERGE-TWO .FIRST .NEXT>)>>
1584                       <COND (.CH <SETG CHANGED .CH>)>>
1585               .RESTP>
1586         <PUT .LAB ,LAB-FINAL-STATE .FIRST>
1587         <PUT .LAB ,LAB-STATE ()>>
1588
1589 <DEFINE MERGE-TWO (ONE TWO "AUX" (CHANGED <>))
1590    #DECL ((ONE TWO) LABSTATE)
1591    <MAPR <>
1592     <FUNCTION (AP1 AP2 NSP
1593                "AUX" (ACST1 <1 .AP1>) (ACST2 <1 .AP2>) (NULL-STATE <1 .NSP>)
1594                      (LD <>))
1595        #DECL ((ACST1 ACST2 NULL-STATE) ACSTATE)
1596        <COND (<AND <ACS-LOCAL .ACST1>
1597                    <ACS-LOCAL .ACST2>
1598                    <==? <LATM <ACS-LOCAL .ACST1>> <LATM <ACS-LOCAL .ACST2>>>
1599                    <==? <ACS-CODE .ACST1> <ACS-CODE .ACST2>>
1600                    <OR <==? <ACS-TYPE .ACST1> <ACS-TYPE .ACST2>>
1601                        <AND <SET LD <LDECL <ACS-LOCAL .ACST1>>>
1602                             <ACS-TYPE <ACS-STORED .ACST1 T> .LD>
1603                             <ACS-TYPE <ACS-STORED .ACST2 T> .LD>
1604                             <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>>>>
1605               <COND (<N==? <NOT <ACS-STORED .ACST2>> <NOT <ACS-STORED .ACST1>>>
1606                      <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1607                      <COND (<AND <ACS-TYPE .ACST1> <LDECL <ACS-LOCAL .ACST1>>>
1608                             <ACS-STORED .ACST1 T>)
1609                            (<OR <==? <ACS-STORED .ACST1> HACKED>
1610                                 <==? <ACS-STORED .ACST2> HACKED>>
1611                             <ACS-STORED .ACST1 HACKED>)
1612                            (ELSE <ACS-STORED .ACST1 <>>)>)>)
1613              (ELSE
1614               <COND (<==? .ACST1 .NULL-STATE>
1615                      <PUT .AP1 1 .ACST2>
1616                      <PUT .AP2 1 <SET ACST2 .ACST1>>
1617                      <SET ACST1 <1 .AP1>>)>
1618               <COND (<AND <ACS-LOCAL .ACST1>
1619                           <OR <ACS-LOCAL .ACST2>
1620                               <EMPTY? <ACS-LOCAL .ACST2>>
1621                               <N==? <LATM <ACS-LOCAL .ACST1>>
1622                                     <LATM <1 <ACS-LOCAL .ACST2>>>>>>
1623                      <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1624                      <LUPD <ACS-LOCAL .ACST1> T>
1625                      <ACS-STORED <ACS-LOCAL .ACST1 <>> <>>)>)>>
1626     .ONE
1627     .TWO
1628     ,NULL-STATES>
1629    .CHANGED>
1630
1631 <DEFINE MERGE-TWO-FORCE (ONE TWO "AUX" (CHANGED <>) (WINNERS 0))
1632    #DECL ((ONE TWO) LABSTATE (WINNERS) FIX)
1633    <MAPF <>
1634     <FUNCTION (ACST1)
1635        #DECL ((ACST1) ACSTATE)
1636        <COND
1637         (<AND
1638           <ACS-LOCAL .ACST1>
1639           <SET WINNERS <+ .WINNERS 1>>
1640           <MAPF <>
1641            <FUNCTION (ACST2 "AUX" LCL)
1642               #DECL ((ACST2) ACSTATE)
1643               <COND
1644                (<AND <SET LCL <ACS-LOCAL .ACST2>>
1645                      <==? <LATM <ACS-LOCAL .ACST1>> <LATM <ACS-LOCAL .ACST2>>>
1646                      <==? <ACS-CODE .ACST1> <ACS-CODE .ACST2>>
1647                      <OR <AND <NOT <ACS-TYPE .ACST1>> <NOT <ACS-TYPE .ACST2>>>
1648                          <AND <==? <ACS-TYPE .ACST1> <ACS-TYPE .ACST2>>
1649                               <OR <==? <NOT <ACS-STORED .ACST1>>
1650                                        <NOT <ACS-STORED .ACST2>>>
1651                                   <AND <LDECL .LCL>
1652                                        <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1653                                        <ACS-STORED .ACST1 T>
1654                                        <ACS-STORED .ACST2 T>>
1655                                   <AND <OR <==? <ACS-STORED .ACST1> HACKED>
1656                                            <==? <ACS-STORED .ACST2> HACKED>>
1657                                        <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1658                                        <ACS-STORED .ACST1 HACKED>
1659                                        <ACS-STORED .ACST2 HACKED>>
1660                                   <AND <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1661                                        <ACS-STORED .ACST1 <>>
1662                                        <ACS-STORED .ACST2 <>>>>>
1663                          <AND <LDECL .LCL>
1664                               <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1665                               <ACS-STORED <ACS-TYPE .ACST1 <LDECL .LCL>> T>
1666                               <ACS-STORED <ACS-TYPE .ACST2 <LDECL .LCL>> T>>>>
1667                 <COND (<N==? <NOT <ACS-STORED .ACST1>>
1668                              <NOT <ACS-STORED .ACST2>>>
1669                        <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1670                        <COND (<OR <==? <ACS-STORED .ACST1> HACKED>
1671                                   <==? <ACS-STORED .ACST2> HACKED>>
1672                               <ACS-STORED .ACST1 HACKED>
1673                               <ACS-STORED .ACST2 HACKED>)
1674                              (ELSE
1675                               <ACS-STORED .ACST1 <>>
1676                               <ACS-STORED .ACST2 <>>)>)>
1677                 <MAPLEAVE>)>>
1678            .TWO>>)
1679         (ELSE
1680          <COND (<ACS-LOCAL .ACST1>
1681                 <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1682                 <LUPD <ACS-LOCAL .ACST1> T>)>
1683          <ACS-STORED <ACS-LOCAL .ACST1 <>> <>>)>>
1684     .ONE>
1685    <MAPF <>
1686          <FUNCTION (ACST1)
1687                  #DECL ((ACST1) ACSTATE)
1688                  <COND (<ACS-LOCAL .ACST1>
1689                         <COND (<L? <SET WINNERS <- .WINNERS 1>> 0>
1690                                <SET CHANGED <LATM <ACS-LOCAL .ACST1>>>
1691                                <MAPLEAVE>)>)>>
1692          .TWO>
1693    .CHANGED>
1694
1695 <DEFINE PLOCAL-NAME (LN "AUX" LCL) #DECL ((LN) LOCAL-NAME)
1696         <OR <SET LCL <L-N-LMEMQ .LN ,LOCALS>>
1697             <AND ,ICALL-FLAG
1698                  <SET LCL
1699                       <L-N-LMEMQ .LN ,ICALL-TEMPS>>>>
1700         <COND (.LCL <PRINC <LATM .LCL>>)
1701               (ELSE <PRINC "#LOC "><PRIN1 <CHTYPE .LN FIX>>)>>
1702
1703
1704 <DEFINE PCONST-LABEL (CL "AUX" TEM)
1705         #DECL ((CL) CONSTANT-LABEL)
1706         <COND (<SET TEM <MEMQ .CL ,CONSTANT-VECTOR>>
1707                <SET TEM <2 .TEM>>
1708                <COND (<TYPE? .TEM CONSTANT> <PRIN1 <CHTYPE .TEM FIX>>)
1709                      (ELSE <PRIN1 <CHTYPE .TEM LIST>>)>)
1710               (ELSE <PRINC "#CL "> <PRIN1 <CHTYPE .CL FIX>>)>>
1711
1712 <DEFINE PCONST-BUCK (CB:CONSTANT-BUCKET "AUX" (TEM <CB-VAL .CB>))
1713         <COND (<TYPE? .TEM CONSTANT> <PRIN1 <CHTYPE .TEM FIX>>)
1714               (ELSE <PRIN1 <CHTYPE .TEM LIST>>)>>
1715
1716 <COND (<GASSIGNED? PCONST-BUCK> <PRINTTYPE CONSTANT-BUCKET ,PCONST-BUCK>)>
1717
1718 <COND (<GASSIGNED? PLOCAL-NAME> <PRINTTYPE LOCAL-NAME ,PLOCAL-NAME>)>
1719
1720 <COND (<GASSIGNED? PCONST-LABEL> <PRINTTYPE CONSTANT-LABEL ,PCONST-LABEL>)>