<mdl.comp>/compdec.mud.1

   1
   2 <PACKAGE "COMPDEC">
   3
   4 <ENTRY FCNS
   5        TMPS
   6        IDT
   7        STYPES
   8        PLUSINF
   9        MINUSINF
  10        IPUT
  11        TEMPV
  12        DEBUGSW
  13        INSTRUCTION
  14        INTH
  15        FCN
  16        IRSUBR
  17        STACK
  18        SNODES
  19        PSTACK
  20        ANY-AC
  21        DUMMY-MAPF
  22        INCONSISTENCY
  23        SEGS
  24        SPEC
  25        CODVEC
  26        QUOTE-CODE
  27        RETURN-CODE
  28        IPUT-CODE
  29        SEG-CODE
  30        PREDV
  31        ACAGE
  32        NUMACS
  33        SYM-SLOT
  34        SAVED-STK
  35        PARENT
  36        TYPE-INFO
  37        PROG-VARS
  38        CURRENT-TYPE
  39        NODE1
  40        PUTR-CODE
  41        ISUBR-CODE
  42        EOF-CODE
  43        IREMAS-CODE
  44        GVAL-CODE
  45        SPARE4-CODE
  46        ACRESIDUE
  47        AC-F
  48        LOOPVARS-LENGTH
  49        ADDVAR
  50        FSET-CODE
  51        OFFPTR
  52        CSYMT-SLOT
  53        CPOTLV-SLOT
  54        PROG-CODE
  55        COMP-TYPES
  56        INACS-SLOT
  57        SAVED-STACK-STATE
  58        NODE-NAME
  59        AGND
  60        REQARGS
  61        LOOP-VARS
  62        DECL-SYM
  63        PUT-CODE
  64        FLVAL-CODE
  65        SETG-CODE
  66        BACK-CODE
  67        PUT-SAME-CODE
  68        AC-E
  69        SS-POTENT-SLOT
  70        NUM-SYM-SLOT
  71        RSUBR-DECLS
  72        NODEF
  73        AND-CODE
  74        MT-CODE
  75        BITS-CODE
  76        PUTBITS-CODE
  77        COPY-LIST-CODE
  78        SPARE1-CODE
  79        ACLINK
  80        LINKED
  81        SS-SYM-SLOT
  82        ATAG
  83        ASSUM
  84        RETURN-STATES
  85        PURE-SYM
  86        NUM-SYM
  87        KID
  88        GNAME-SYM
  89        CHTYPE-CODE
  90        SAVED-NUM-SYM-SLOT
  91        NODE
  92        SYMTAB
  93        INACS
  94        USAGE-SYM
  95        GDECL-SYM
  96        MAP-CODE
  97        MARGS-CODE
  98        DATVAL
  99        ALLACS
 100        AC-D
 101        SAVED-AC-STATE
 102        NODE-SUBR
 103        LIVE-VARS
 104        SPEC-SYM
 105        AS-NXT-CODE
 106        SUBSTRUC-CODE
 107        BIT-TEST-CODE
 108        SPARE3-CODE
 109        TMPAC
 110        NO-RESIDUE
 111        NOT-PREF
 112        P-N-STO-RES
 113        P-N-NO-STO-RES
 114        FRMNO
 115        NOT-CODE
 116        TEST-CODE
 117        MIN-MAX-CODE
 118        READ-EOF2-CODE
 119        TAG-CODE
 120        LENGTH-CONTROL-STATE
 121        SAVED-NTSLOTS
 122        KIDS
 123        PREDIC
 124        MAKE:TAG
 125        NODEPR
 126        NODEFM
 127        GNEXT-SYM
 128        FIX-CODE
 129        MFCN-CODE
 130        IRSUBR-CODE
 131        CASE-CODE
 132        SCL
 133        ACSYM
 134        ACNUM
 135        AC-C
 136        P-N-CLEAN
 137        CINACS-SLOT
 138        NODE-TYPE
 139        USLOTS
 140        DEAD-VARS
 141        DEATH-LIST
 142        COMPOSIT-TYPE
 143        PROG-AC
 144        PRED
 145        COPY-CODE
 146        LENGTH?-CODE
 147        AC
 148        LINACS-SLOT
 149        TMPLS
 150        INIT-DECL-TYPE
 151        NODECOND
 152        FUNCTION-CODE
 153        AGAIN-CODE
 154        0-TST-CODE
 155        GETBITS-CODE
 156        MAPRET-STOP-CODE
 157        LSH-CODE
 158        SYMBOL
 159        SAVED-STATE
 160        ACO
 161        LENGTH-PROG-VARS
 162        CSTORED-SLOT
 163        NODEB
 164        SET-CODE
 165        ROT-CODE
 166        AC-B
 167        REGS
 168        PROG-SLOT
 169        SAVED-BSTB
 170        BINDING-STRUCTURE
 171        CDST
 172        VSPCD
 173        NAME-SYM
 174        INIT-SYM
 175        EQ-CODE
 176        ALL-REST-CODE
 177        DISPATCH
 178        TMPNO
 179        AC1SYM
 180        REACS
 181        LSYM-SLOT
 182        DST
 183        RTAG
 184        ACCUM-TYPE
 185        DATUM
 186        ARGNUM-SYM
 187        ADDR-SYM
 188        STORED
 189        USED-AT-ALL
 190        POTLV
 191        NAME
 192        ARGNUM
 193        FGVAL-CODE
 194        ID-CODE
 195        FORM-F-CODE
 196        INFO-CODE
 197        TEMP
 198        STORED-RESIDUE
 199        SAVED-POTLV-SLOT
 200        SAVED-CODE:PTR
 201        CLAUSES
 202        TRG
 203        VARTBL
 204        LVARTBL
 205        SUBR-CODE
 206        LNTH-CODE
 207        STACKFORM-CODE
 208        ASSIGNED?-CODE
 209        GET2-CODE
 210        AS-IT-IND-VAL-CODE
 211        COMMON
 212        DATTYP
 213        AC-A
 214        ACS
 215        RET-AGAIN-ONLY
 216        SEGMENT-CODE
 217        FSETG-CODE
 218        ISTRUC-CODE
 219        MFIRST-CODE
 220        ACPREF
 221        SS-STORED-SLOT
 222        STORED-SLOT
 223        STK-B
 224        AGAIN-STATES
 225        CODE-SYM
 226        BST
 227        RSUBR-CODE
 228        1?-CODE
 229        REST-CODE
 230        ABS-CODE
 231        MPSBR-CODE
 232        UNWIND-CODE
 233        PRINT-CODE
 234        OBLIST?-CODE
 235        ADDRSYM
 236        AC-H
 237        LAST-AC-1
 238        NOT-STORED-RESIDUE
 239        P-N-LINKED
 240        SAVED-RET-FLAG
 241        SAVED-FRMS
 242        STACKS
 243        ASS?
 244        BRANCH-CODE
 245        LVAL-CODE
 246        OR-CODE
 247        ISTRUC2-CODE
 248        READ-EOF-CODE
 249        MAPLEAVE-CODE
 250        MEMQ-CODE
 251        REP-STATE
 252        SS-DAT-SLOT
 253        SAVED-PROG-AC-SLOT
 254        LENGTH-CSTATE
 255        RESULT-TYPE
 256        SIDE-EFFECTS
 257        SSLOTS
 258        PRE-ALLOC
 259        NEXT-SYM
 260        FORM-CODE
 261        TY?-CODE
 262        FLOAT-CODE
 263        GET-CODE
 264        SPECS-START
 265        BTP-B
 266        SPCS-X
 267        RES-TYP
 268        GO-CODE
 269        BITL-CODE
 270        TOP-CODE
 271        SPARE2-CODE
 272        AC-G
 273        LAST-AC
 274        ATIME
 275        ACTIVATED
 276        TOTARGS
 277        VTB
 278        RQRG
 279        COND-CODE
 280        ARITH-CODE
 281        NTH-CODE
 282        MOD-CODE
 283        ACPROT
 284        IND
 285        ALL
 286        NOTE
 287        WARNING
 288        PRIM-CODE
 289        DONT-CARE
 290        FLUSHED
 291        NO-RETURN
 292        NO-DATUM
 293        MESSAGE
 294        GROUP-NAME
 295        FUZZ
 296        COMMON-TYPE
 297        COMMON-SYMTAB
 298        COMMON-ITEM
 299        COMMON-PRIMTYPE
 300        COMMON-DATUM
 301        COMMON-SYMT
 302        TRANSFORM
 303        TRANS
 304        N0?
 305        POPWR2
 306        DEALLOCATE
 307        TOKEN
 308        ERRS
 309        WARNS
 310        NOTES
 311        DEBUG-COMPILE
 312        REASONABLE
 313        CAREFUL
 314        PRECOMPILED
 315        HAIRY-ANALYSIS
 316        SRC-FLG
 317        BIN-FLG
 318        GLOSP
 319        ANALY-OK
 320        VERBOSE
 321        COMPILER
 322        IND
 323        ADDRESS:C>
 324
 325
 326 <SETG PLUSINF <CHTYPE <MIN> FIX>>
 327
 328 <SETG MINUSINF <CHTYPE <MAX> FIX>>
 329
 330 "Type specification for NODE."
 331
 332 <NEWTYPE NODE
 333          VECTOR
 334          '<VECTOR FIX
 335                   ANY
 336                   ANY
 337                   ANY
 338                   <LIST [REST NODE]>
 339                   FIX
 340                   <OR FALSE ATOM>
 341                   [REST
 342                    LIST
 343                    ANY
 344                    ANY
 345                    LIST
 346                    FIX
 347                    SYMTAB
 348                    FIX
 349                    FIX
 350                    <OR FALSE ATOM>
 351                    ATOM
 352                    ANY
 353                    LIST
 354                    LIST
 355                    ANY
 356                    ANY
 357                    ANY
 358                    ANY
 359                    ANY
 360                    ANY
 361                    ANY
 362                    <PRIMTYPE LIST>
 363                    FIX
 364                    FIX
 365                    LIST
 366                    LIST
 367                    LIST
 368                    LIST
 369                    LIST]>>
 370
 371 "Offsets into pass 1 structure entities and functions to create same."
 372
 373 <SETG NODE-TYPE <OFFSET 1 NODE>>
 374
 375 ;"Code specifying the node type."
 376
 377 <SETG PARENT <OFFSET 2 NODE>>
 378
 379 ;"Pointer to parent node."
 380
 381 <SETG RESULT-TYPE <OFFSET 3 NODE>>
 382
 383 ;"Type expression for result returned by code
 384                                    generated by this node."
 385
 386 <SETG NODE-NAME <OFFSET 4 NODE>>
 387
 388 ;"Usually name of SUBR associated with  this node."
 389
 390 <SETG KIDS <OFFSET 5 NODE>>
 391
 392 ;"List of sub-nodes for this node."
 393
 394 <SETG STACKS <OFFSET 6 NODE>>
 395
 396 ;"Amount of stack needed by this node."
 397
 398 <SETG SEGS <OFFSET 7 NODE>>
 399
 400 ;"Predicate:  any segments among kids?"
 401
 402 <SETG TYPE-INFO <OFFSET 8 NODE>>
 403
 404 ;"Points to transient type info for this node."
 405
 406 <SETG SIDE-EFFECTS <OFFSET 9 NODE>>
 407
 408 ;"General info about side effects (format not yet firm.)"
 409
 410 <SETG RSUBR-DECLS <OFFSET 10 NODE>>
 411
 412 ;"Function only: final rsubr decls."
 413
 414 <SETG BINDING-STRUCTURE <OFFSET 11 NODE>>
 415
 416 ;"Partially compiled arg list."
 417
 418 <SETG SPECS-START <OFFSET 12 NODE>>
 419
 420 ;"Offset to 1st special."
 421
 422 <SETG SYMTAB <OFFSET 13 NODE>>
 423
 424 ;"Pointer to local symbol table."
 425
 426 <SETG SSLOTS <OFFSET 14 NODE>>
 427
 428 ;"Number of specials."
 429
 430 <SETG USLOTS <OFFSET 15 NODE>>
 431
 432 ;"Number of unspecials."
 433
 434 <SETG ACTIVATED <OFFSET 16 NODE>>
 435
 436 ;"Predicate: any named activation?"
 437
 438 <SETG TMPLS <OFFSET 17 NODE>>
 439
 440 ;"Offset to unamed temps."
 441
 442 <SETG PRE-ALLOC <OFFSET 18 NODE>>
 443
 444 ;"Variable slots allocated in advance."
 445
 446 <SETG STK-B <OFFSET 19 NODE>>
 447
 448 ;"Base of stack at entry."
 449
 450 <SETG BTP-B <OFFSET 20 NODE>>
 451
 452 ;"Base of stack after bindings."
 453
 454 <SETG SPCS-X <OFFSET 21 NODE>>
 455
 456 ;"Predicate:  any specials bound?"
 457
 458 <SETG DST <OFFSET 22 NODE>>
 459
 460 ;"Destination spec for value of node."
 461
 462 <SETG CDST <OFFSET 23 NODE>>
 463
 464 ;"Current destination used."
 465
 466 <SETG ATAG <OFFSET 24 NODE>>
 467
 468 ;"Label for local againing."
 469
 470 <SETG RTAG <OFFSET 25 NODE>>
 471
 472 ;"Label for local Returning."
 473
 474 <SETG ASSUM <OFFSET 26 NODE>>
 475
 476 ;"Node type assumptions."
 477
 478 <SETG AGND <OFFSET 27 NODE>>
 479
 480 ;"Predicate:  Again possible?"
 481
 482 <SETG ACS <OFFSET 28 NODE>>
 483
 484 ;"Predicate:  AC call possible? (if not false
 485                                    ac structure)"
 486
 487 <SETG TOTARGS <OFFSET 29 NODE>>
 488
 489 ;"Total number of args (including optional)."
 490
 491 <SETG REQARGS <OFFSET 30 NODE>>
 492
 493 ;"Required arguemnts."
 494
 495 <SETG LOOP-VARS <OFFSET 31 NODE>>
 496
 497 "Variables kept in acs thru loop."
 498
 499 <SETG AGAIN-STATES <OFFSET 32 NODE>>
 500
 501 "States at agains"
 502
 503 <SETG RETURN-STATES <OFFSET 33 NODE>>
 504
 505 "States at repeats."
 506
 507 <SETG PROG-VARS <OFFSET 34 NODE>>
 508
 509 "Vars handled in this prog/repeat."
 510
 511 ;"Information used for merging states with prog-nodes"
 512
 513 <SETG CLAUSES <OFFSET <INDEX ,KIDS> NODE>>
 514
 515 ;"For COND clauses."
 516
 517 <SETG NODE-SUBR <OFFSET <INDEX ,RSUBR-DECLS> NODE>>
 518
 519 ;"For many nodes, the SUBR (not its name)."
 520
 521 <SETG PREDIC <OFFSET <INDEX ,NODE-NAME> NODE>>
 522
 523 ;"For cond clause nodes, the predicate."
 524
 525 <SETG ACCUM-TYPE <OFFSET <INDEX ,DST> NODE>>
 526
 527 ;"Accumulated type from all returns etc."
 528
 529 <SETG DEAD-VARS <OFFSET <INDEX ,CDST> NODE>>
 530
 531 <SETG LIVE-VARS <OFFSET <INDEX ,TYPE-INFO> NODE>>
 532
 533 <SETG VSPCD <OFFSET <INDEX ,ATAG> NODE>>
 534
 535 <SETG INIT-DECL-TYPE <OFFSET <INDEX ,RTAG> NODE>>
 536
 537 "       Definitions associated with compiler symbol tables."
 538
 539 "Offsets for variable description blocks"
 540
 541 <NEWTYPE SYMTAB
 542          VECTOR
 543          '<VECTOR <PRIMTYPE VECTOR>
 544                   ATOM
 545                   <OR FALSE ATOM>
 546                   FIX
 547                   <OR ATOM FIX>
 548                   <OR FALSE ATOM>
 549                   LIST
 550                   ANY
 551                   ANY
 552                   FIX
 553                   <OR FALSE NODE>
 554                   <OR FALSE 'T>
 555                   <OR FALSE DATUM LIST>
 556                   <OR FALSE 'T>
 557                   <OR FALSE 'T>
 558                   LIST
 559                   ANY
 560                   ANY
 561                   <OR FALSE FIX>>>
 562
 563 <SETG NEXT-SYM <OFFSET 1 SYMTAB>>
 564
 565 ;"Pointer to next symbol table entry."
 566
 567 <SETG NAME-SYM <OFFSET 2 SYMTAB>>
 568
 569 ;"Name of variable."
 570
 571 <SETG SPEC-SYM <OFFSET 3 SYMTAB>>
 572
 573 ;"Predicate:  special?"
 574
 575 <SETG CODE-SYM <OFFSET 4 SYMTAB>>
 576
 577 ;"Code specifying whether AUX, OPTIONAL etc."
 578
 579 <SETG ARGNUM-SYM <OFFSET 5 SYMTAB>>
 580
 581 ;"If an argument, which one."
 582
 583 <SETG PURE-SYM <OFFSET 6 SYMTAB>>
 584
 585 ;"Predicate:  unchanged in function?"
 586
 587 <SETG DECL-SYM <OFFSET 7 SYMTAB>>
 588
 589 ;"Decl for this variable."
 590
 591 <SETG ADDR-SYM <OFFSET 8 SYMTAB>>
 592
 593 ;"Where do I live?"
 594
 595 <SETG INIT-SYM <OFFSET 9 SYMTAB>>
 596
 597 ;"Predicate:  initial value? if so what."
 598
 599 <SETG FRMNO <OFFSET 10 SYMTAB>>
 600
 601 ;"ID of my frame."
 602
 603 <SETG RET-AGAIN-ONLY <OFFSET 11 SYMTAB>>
 604
 605 ;"Predicate:  used only in AGAIN/RETURN?"
 606
 607 <SETG ASS? <OFFSET 12 SYMTAB>>
 608
 609 ;"Predicate:  used in ASSIGNED?"
 610
 611 <SETG INACS <OFFSET 13 SYMTAB>>
 612
 613 ;"Predicate:  currently in some AC?"
 614
 615 <SETG STORED <OFFSET 14 SYMTAB>>
 616
 617 ;"Predicate:  stored in slot?"
 618
 619 <SETG USED-AT-ALL <OFFSET 15 SYMTAB>>
 620
 621 ;"Predicate:  symbolused at all."
 622
 623 <SETG DEATH-LIST <OFFSET 16 SYMTAB>>
 624
 625 ;"List of info associated with life time."
 626
 627 <SETG CURRENT-TYPE <OFFSET 17 SYMTAB>>
 628
 629 ;"Current decl determined by analysis"
 630
 631 <SETG COMPOSIT-TYPE <OFFSET 18 SYMTAB>>
 632
 633 <SETG USAGE-SYM <OFFSET 19 SYMTAB>>
 634
 635 "How a variable is used in a loop."
 636
 637 <SETG PROG-AC <OFFSET <INDEX ,CURRENT-TYPE> SYMTAB>>
 638
 639 <SETG NUM-SYM <OFFSET <INDEX ,COMPOSIT-TYPE> SYMTAB>>
 640
 641 <SETG POTLV <OFFSET <INDEX ,USED-AT-ALL> SYMTAB>>
 642
 643
 644 "Slot used to store information for variables in loops."
 645
 646 ;"Type as figured out by all uses of symbol."
 647
 648 <DEFINE NODE1 (TYP PAR RES-TYP NAME KID)
 649         <CHTYPE [.TYP .PAR .RES-TYP .NAME .KID 0 <>] NODE>>
 650
 651 "Create a function node with all its hair."
 652
 653 <DEFINE NODEF (TYP PAR RES-TYP NAME KID RSD BST HAT VTB ACS? TRG RQRG)
 654         <CHTYPE [.TYP .PAR .RES-TYP .NAME .KID 0 <> () <> .RSD .BST 0 .VTB 0
 655                  0 <> <MAKE:TAG "FRM"> <> () () <> <> <> <> .RES-TYP <> <>
 656                  .ACS? .TRG .RQRG] NODE>>
 657
 658 "Create a PROG/REPEAT node with nearly as much hair."
 659
 660 <DEFINE NODEPR (TYP PAR RES-TYP NAME KID VL BST HAT VTB)
 661         <CHTYPE [.TYP
 662                  .PAR
 663                  .RES-TYP
 664                  .NAME
 665                  .KID
 666                  0
 667                  <>
 668                  ()
 669                  <>
 670                  .VL
 671                  .BST
 672                  0
 673                  .VTB
 674                  0
 675                  0
 676                  <>
 677                  <MAKE:TAG "FRM">
 678                  <>
 679                  ()
 680                  ()
 681                  <>
 682                  <>
 683                  <>
 684                  <>
 685                  .RES-TYP
 686                  <>
 687                  <>
 688                  <>
 689                  0
 690                  0
 691                  ()
 692                  ()
 693                  ()
 694                  ()]
 695                 NODE>>
 696
 697 "Create a COND node."
 698
 699 <DEFINE NODECOND (TYP PAR RES-TYP NAME CLAU)
 700         <CHTYPE [.TYP .PAR .RES-TYP .NAME .CLAU 0 <> () <>] NODE>>
 701
 702 "Create a node for a COND clause."
 703
 704 <DEFINE NODEB (TYP PAR RES-TYP PRED CLAU)
 705         <CHTYPE [.TYP .PAR .RES-TYP .PRED .CLAU 0 <> () <>] NODE>>
 706
 707 "Create a node for a SUBR call etc."
 708
 709 <DEFINE NODEFM (TYP PAR RES-TYP NAME KID SUB)
 710         <CHTYPE [.TYP .PAR .RES-TYP .NAME .KID 0 <> () <> .SUB] NODE>>
 711 \f
 712
 713 <DEFINE ADDVAR (NAM SPEC CODE ARGNUM PURE DCL ADDR INIT)
 714         <SET VARTBL <CHTYPE [.VARTBL .NAM .SPEC .CODE .ARGNUM .PURE .DCL .ADDR .INIT 0 <>
 715                              <> <> T <> () <> ANY 0] SYMTAB>>>
 716
 717
 718 "Some specialized decl stuff."
 719
 720 <SETG LVARTBL
 721       <PROG ((VARTBL []))
 722             #DECL ((VARTBL) <SPECIAL ANY>)
 723             <ADDVAR OBLIST T -1 0 T '(<OR LIST OBLIST>) <> <>>
 724             <ADDVAR OUTCHAN T -1 0 T '(CHANNEL) <> <>>
 725             <ADDVAR INCHAN T -1 0 T '(CHANNEL) <> <>>
 726             .VARTBL>>
 727
 728 <PUT CHANNEL DECL '<CHANNEL FIX [11 ANY] [5 FIX]>>
 729
 730 <PUT STRING DECL '<STRING [REST CHARACTER]>>
 731
 732 <PUT OBLIST DECL '<UVECTOR [REST <LIST [REST <OR ATOM LINK>]>]>>
 733
 734 "Codes for the node types in the tree built by pass1 and modified by
 735 other passes."
 736
 737 "Give symbolic codes arbitrary increasing values."
 738
 739 <PROG ((N 1))
 740       <SETG CODVEC
 741             <MAPF ,UVECTOR
 742                   <FUNCTION (ATM) <SETG .ATM .N> <SET N <+ .N 1>> .ATM>
 743                   ![FUNCTION-CODE
 744                     QUOTE-CODE
 745                     SEGMENT-CODE
 746                     FORM-CODE
 747                     PROG-CODE
 748                     SUBR-CODE
 749                     COND-CODE
 750                     BRANCH-CODE
 751                     RSUBR-CODE
 752                     LVAL-CODE
 753                     SET-CODE
 754                     OR-CODE
 755                     AND-CODE
 756                     RETURN-CODE
 757                     COPY-CODE
 758                     GO-CODE
 759                     AGAIN-CODE
 760                     ARITH-CODE
 761                     0-TST-CODE
 762                     NOT-CODE
 763                     1?-CODE
 764                     TEST-CODE
 765                     EQ-CODE
 766                     TY?-CODE
 767                     LNTH-CODE
 768                     MT-CODE
 769                     NTH-CODE
 770                     REST-CODE
 771                     PUT-CODE
 772                     PUTR-CODE
 773                     FLVAL-CODE
 774                     FSET-CODE
 775                     FGVAL-CODE
 776                     FSETG-CODE
 777                     MIN-MAX-CODE
 778                     STACKFORM-CODE
 779                     CHTYPE-CODE
 780                     ABS-CODE
 781                     FIX-CODE
 782                     FLOAT-CODE
 783                     MOD-CODE
 784                     ID-CODE
 785                     ASSIGNED?-CODE
 786                     ISTRUC-CODE
 787                     ISTRUC2-CODE
 788                     BITS-CODE
 789                     BITL-CODE
 790                     GETBITS-CODE
 791                     PUTBITS-CODE
 792                     MAP-CODE
 793                     MFCN-CODE
 794                     ISUBR-CODE
 795                     READ-EOF-CODE
 796                     READ-EOF2-CODE
 797                     EOF-CODE
 798                     GET-CODE
 799                     GET2-CODE
 800                     IPUT-CODE
 801                     IREMAS-CODE
 802                     IRSUBR-CODE
 803                     MARGS-CODE
 804                     MPSBR-CODE
 805                     MAPLEAVE-CODE
 806                     MAPRET-STOP-CODE
 807                     UNWIND-CODE
 808                     GVAL-CODE
 809                     SETG-CODE
 810                     SEG-CODE
 811                     LENGTH?-CODE
 812                     TAG-CODE
 813                     MFIRST-CODE
 814                     PRINT-CODE
 815                     MEMQ-CODE
 816                     FORM-F-CODE
 817                     INFO-CODE
 818                     OBLIST?-CODE
 819                     AS-NXT-CODE
 820                     AS-IT-IND-VAL-CODE
 821                     ALL-REST-CODE
 822                     CASE-CODE
 823                     SUBSTRUC-CODE
 824                     BACK-CODE
 825                     TOP-CODE
 826                     COPY-LIST-CODE
 827                     PUT-SAME-CODE
 828                     ROT-CODE
 829                     LSH-CODE
 830                     BIT-TEST-CODE
 831                     SPARE1-CODE
 832                     SPARE2-CODE
 833                     SPARE3-CODE
 834                     SPARE4-CODE!]>>
 835       <SETG COMP-TYPES .N>>
 836
 837
 838 <USE "NPRINT">
 839
 840 "Build a dispatch table based on node types."
 841
 842 <DEFINE DISPATCH (DEFAULT "TUPLE" PAIRS
 843                   "AUX" (TT <IVECTOR ,COMP-TYPES '.DEFAULT>))
 844         #DECL ((PAIRS) <TUPLE [REST <LIST FIX ANY>]>
 845                (TT) VECTOR)
 846         <REPEAT ((PAIR '(1 1))) #DECL ((PAIR) <LIST FIX ANY>)
 847                 <COND (<EMPTY? .PAIRS><RETURN .TT>)>
 848                 <PUT .TT <1 <SET PAIR <1 .PAIRS>>> <2 .PAIR>>
 849                 <SET PAIRS <REST .PAIRS>>>>
 850
 851 <SETG PREDV <IUVECTOR ,COMP-TYPES 0>>
 852
 853 <MAPF <>
 854       <FUNCTION (N) <PUT ,PREDV .N 1>>
 855       ![,0-TST-CODE
 856         ,1?-CODE
 857         ,NOT-CODE
 858         ,TEST-CODE
 859         ,EQ-CODE
 860         ,TY?-CODE
 861         ,MT-CODE
 862         ,OR-CODE
 863         ,AND-CODE
 864         ,ASSIGNED?-CODE
 865         ,ISUBR-CODE
 866         ,NTH-CODE
 867         ,MEMQ-CODE
 868         ,LENGTH?-CODE
 869         ,OBLIST?-CODE
 870         ,AS-NXT-CODE
 871         ,COND-CODE
 872         ,BIT-TEST-CODE!]>
 873
 874 "Predicate:  does this type have special predicate code?"
 875
 876 <PUT REP-STATE
 877      DECL
 878      '<LIST [5 <LIST [REST SYMTAB DATUM <OR FALSE ATOM> <OR ATOM FALSE>]>]>>
 879
 880 <PUT SYMBOL DECL '<OR SYMTAB TEMP COMMON>>
 881
 882 <NEWTYPE TEMP VECTOR '<VECTOR SCL <OR FALSE DATUM>>>
 883
 884 <NEWTYPE SAVED-STATE
 885          LIST
 886          '<LIST [REST
 887                  <LIST AC
 888                        <OR FALSE <LIST [REST SYMBOL]>>
 889                        [REST <LIST SYMBOL [3 ANY]>]>]>>
 890
 891 <SETG TMPNO <OFFSET 1 TEMP>>
 892
 893 <SETG TMPAC <OFFSET 2 TEMP>>
 894
 895 <SETG DATTYP <OFFSET 1 DATUM>>
 896
 897 <SETG DATVAL <OFFSET 2 DATUM>>
 898
 899 <SETG ADDRSYM <OFFSET 1 AC>>
 900
 901 <SETG ACSYM <OFFSET 2 AC>>
 902
 903 <SETG ACLINK <OFFSET 3 AC>>
 904
 905 <SETG ACAGE <OFFSET 4 AC>>
 906
 907 <SETG ACNUM <OFFSET 5 AC>>
 908
 909 <SETG ACPROT <OFFSET 6 AC>>
 910
 911 <SETG AC1SYM <OFFSET 7 AC>>
 912
 913 <SETG ACRESIDUE <OFFSET 8 AC>>
 914
 915 <SETG ACPREF <OFFSET 9 AC>>
 916
 917 <NEWTYPE AC
 918          VECTOR
 919          '<<PRIMTYPE VECTOR> <PRIMTYPE WORD>
 920                              <PRIMTYPE WORD>
 921                              <OR <LIST [REST DATUM]> FALSE>
 922                              FIX
 923                              FIX
 924                              <OR FALSE ATOM>
 925                              <PRIMTYPE WORD>
 926                              <OR FALSE LIST>
 927                              <OR FALSE ATOM>>>
 928
 929 <NEWTYPE DATUM
 930          LIST
 931          '<<PRIMTYPE LIST> <OR ATOM <PRIMTYPE LIST> <PRIMTYPE VECTOR>>
 932                            <OR ATOM <PRIMTYPE LIST> <PRIMTYPE VECTOR>>>>
 933
 934 <NEWTYPE OFFPTR LIST '<<PRIMTYPE LIST> FIX DATUM ATOM>>
 935
 936 <NEWTYPE TEMPV LIST>
 937
 938 <NEWTYPE IRSUBR LIST>
 939
 940 "A TOKEN GIVES INFORMATION TO CUP"
 941
 942 <NEWTYPE TOKEN VECTOR '<<PRIMTYPE VECTOR> FIX>>
 943
 944 <NEWTYPE ADDRESS:PAIR LIST>
 945
 946 <NEWTYPE ADDRESS:C LIST>
 947
 948 <SETG ALLACS
 949       <MAPF ,UVECTOR
 950             <FUNCTION (N1 N2 N N+1 NAME "AUX"  THISAC)
 951                     <SETG .NAME <SET THISAC <CHTYPE [.N1 .N2 <> 0 .N <> .N+1 <> <>] AC>>>
 952                     <EVAL <FORM GDECL (.NAME) AC>> .THISAC>
 953             ![`A `B `C `D `E `F `TVP `SP!]
 954             ![`A* `B* `C* `D* `E* `F* `TVP* `SP*!]
 955             ![1 2 3 4 5 6 7 8!]
 956             ![`B* `C* `D* `E* `F* `TVP* `SP* `AB*!]
 957             ![AC-A AC-B AC-C AC-D AC-E AC-F AC-G AC-H!]>>
 958
 959 <SETG NUMACS <LENGTH ,ALLACS>>
 960
 961 <SETG LAST-AC ,AC-H>
 962
 963 <SETG LAST-AC-1 ,AC-G>
 964
 965 <DEFINE REACS ()
 966         <MAPF <>
 967               <FUNCTION (AC)
 968                       #DECL ((AC) AC)
 969                       <PUT .AC ,ACLINK <>>
 970                       <PUT .AC ,ACPROT <>>
 971                       <PUT .AC ,ACAGE 0>
 972                       <PUT .AC ,ACRESIDUE <>>
 973                       <PUT .AC ,ACPREF <>>>
 974               ,ALLACS>
 975         <SETG REGS 8>
 976         <SETG ATIME 0>>
 977
 978 <GDECL (ALLACS) !<UVECTOR [8 AC]> (ATIME REGS) FIX (LAST-AC LAST-AC-1 AC0) AC>
 979
 980 <MANIFEST SS-SYM-SLOT SS-DAT-SLOT SS-STORED-SLOT SS-POTENT-SLOT>
 981
 982 <MANIFEST TMPFRM TMPNO THOME TUSERS DATTYP DATVAL  ADDRSYM ACSYM ACLINK ACAGE
 983           ACNUM ACPROT AC1SYM ACRESIDUE ACPREF ACINUSE TMPAC COMMON-DATUM
 984           NUMACS POTLV>
 985
 986 <MAPF <> ,MANIFEST ,CODVEC>
 987
 988 <MANIFEST TOT-MODES RESTS RMODES COMP-TYPES
 989 GDECL-SYM GNAME-SYM GNEXT-SYM FRMNO INIT-SYM ADDR-SYM TOTARGS REQARGS
 990 DECL-SYM PURE-SYM ARGNUM-SYM CODE-SYM SPEC-SYM NAME-SYM NEXT-SYM PREDIC
 991 NODE-SUBR CLAUSES ACS TMPLS ACTIVATED USLOTS SSLOTS SYMTAB SPECS-START
 992 BINDING-STRUCTURE RSUBR-DECLS SEGS STACKS KIDS NODE-NAME RESULT-TYPE PARENT
 993 NODE-TYPE SIDE-EFFECTS RET-AGAIN-ONLY ASS? INACS STORED DST CDST ACCUM-TYPE
 994 INIT-DECL-TYPE VSPCD AGND ASSUM RTAG ATAG SPCS-X BTP-B STK-B PRE-ALLOC
 995 USED-AT-ALL CURRENT-TYPE DEATH-LIST COMPOSIT-TYPE AGAIN-STATES RETURN-STATES
 996 PROG-VARS LOOP-VARS PROG-AC NUM-SYM  TYPE-INFO USAGE-SYM LIVE-VARS
 997 DEAD-VARS>
 998
 999 <REACS>
1000
1001 <SETG LINKED 1>
1002
1003 <SETG NO-RESIDUE 10000000>
1004
1005 <SETG STORED-RESIDUE 1000000>
1006
1007 <SETG NOT-STORED-RESIDUE 100000>
1008
1009 <SETG NOT-PREF 10000>
1010
1011 <SETG P-N-CLEAN 1000>
1012
1013 <SETG P-N-STO-RES 100>
1014
1015 <SETG P-N-NO-STO-RES 10>
1016
1017 <SETG P-N-LINKED 1>
1018
1019 <MANIFEST LINKED
1020           NO-RESIDUE
1021           STORED-RESIDUE
1022           NOT-STORED-RESIDUE
1023           NOT-PREF
1024           P-N-LINKED
1025           P-N-CLEAN
1026           P-N-STO-RES
1027           P-N-NO-STO-RES>
1028
1029 <SETG ACO <CHTYPE [`O* `O* <> 0 0 <> `A* <> <>] AC>>
1030
1031 <SETG SS-SYM-SLOT 1>
1032
1033 "POINTER TO SYMBOL"
1034
1035 <SETG SS-DAT-SLOT 2>
1036
1037 "DATUM OF THE SYMBOL"
1038
1039 <SETG SS-STORED-SLOT 3>
1040
1041 "IS THE SYMBOL STORED"
1042
1043 <SETG SS-POTENT-SLOT 4>
1044
1045 "IS THE SYMBOL POTENTIAL"
1046
1047 <MANIFEST SS-SYM-SLOT SS-DAT-SLOT SS-STORED-SLOT SS-POTENT-SLOT>
1048
1049 "MANIFESTS FOR PROG-AC"
1050
1051 <SETG PROG-SLOT 1>
1052
1053 <SETG NUM-SYM-SLOT 2>
1054
1055 <SETG STORED-SLOT 3>
1056
1057 <SETG INACS-SLOT 4>
1058
1059 "MANIFESTED VARIABLES FOR SLOT STORE IN PROG-VARS"
1060
1061 <SETG SYM-SLOT 1>
1062
1063 <SETG SAVED-NUM-SYM-SLOT 2>
1064
1065 <SETG SAVED-PROG-AC-SLOT 3>
1066
1067 <SETG SAVED-POTLV-SLOT 4>
1068
1069 <SETG LENGTH-PROG-VARS 4>
1070
1071 "MANIFESTS FOR AGAIN AND RETURN STATES"
1072
1073 <SETG SAVED-AC-STATE 1>
1074
1075 <SETG SAVED-CODE:PTR 2>
1076
1077 <SETG SAVED-STACK-STATE 3>
1078
1079 <SETG SAVED-RET-FLAG 4>
1080
1081 <SETG LENGTH-CONTROL-STATE 4>
1082
1083 "OFFSETS FOR STACK:INFO"
1084
1085 <SETG SAVED-FRMS 1>
1086
1087 <SETG SAVED-BSTB 2>
1088
1089 <SETG SAVED-NTSLOTS 3>
1090
1091 <SETG SAVED-STK 4>
1092
1093 "SLOTS FOR SAVED-AC-SLOT"
1094
1095 <SETG CSYMT-SLOT 1>
1096
1097 <SETG CINACS-SLOT 2>
1098
1099 <SETG CSTORED-SLOT 3>
1100
1101 <SETG CPOTLV-SLOT 4>
1102
1103 <SETG LENGTH-CSTATE 4>
1104
1105 "SLOTS FOR LOOP-VARS"
1106
1107 <SETG LSYM-SLOT 1>
1108
1109 <SETG LINACS-SLOT 2>
1110
1111 <SETG LOOPVARS-LENGTH 2>
1112
1113 <MANIFEST NUM-SYM-SLOT
1114           LSYM-SLOT
1115           LOOPVARS-LENGTH
1116           LINACS-SLOT
1117           SAVED-FRMS
1118           CSYMT-SLOT
1119           CINACS-SLOT
1120           CSTORED-SLOT
1121           CPOTLV-SLOT
1122           LENGTH-CSTATE
1123           SAVED-BSTB
1124           SAVED-NTSLOTS
1125           SAVED-STK
1126           STORED-SLOT
1127           INACS-SLOT
1128           PROG-SLOT
1129           SYM-SLOT
1130           SAVED-NUM-SYM-SLOT
1131           SAVED-POTLV-SLOT
1132           SAVED-PROG-AC-SLOT
1133           LENGTH-PROG-VARS
1134           LENGTH-CONTROL-STATE
1135           SAVED-AC-STATE
1136           SAVED-CODE:PTR
1137           SAVED-STACK-STATE
1138           SAVED-RET-FLAG>
1139
1140 <NEWTYPE COMMON
1141          VECTOR
1142          '<<PRIMTYPE VECTOR> ATOM <OR COMMON SYMTAB> FIX ANY <PRIMTYPE LIST>>>
1143
1144 <SETG COMMON-TYPE <OFFSET 1 COMMON>>
1145
1146 "TYPE OF COMMON (ATOM)"
1147
1148 <SETG COMMON-SYMT <OFFSET 2 COMMON>>
1149
1150 "POINTER TO OR COMMON SYMTAB"
1151
1152 <SETG COMMON-ITEM <OFFSET 3 COMMON>>
1153
1154 "3RD ARGUMENT TO NTH,REST,PUT ETC."
1155
1156 <SETG COMMON-PRIMTYPE <OFFSET 4 COMMON>>
1157
1158 "PRIMTYPE OF OBJECT IN COMMON"
1159
1160 <SETG COMMON-DATUM <OFFSET 5 COMMON>>
1161
1162 "DATUM FOR THIS COMMON"
1163
1164 <MANIFEST COMMON-TYPE COMMON-SYMTAB COMMON-ITEM COMMON-PRIMTYPE COMMON-DATUM>
1165
1166 <NEWTYPE TRANS
1167          VECTOR
1168          '<<PRIMTYPE VECTOR> NODE <UVECTOR [7 FIX]> <UVECTOR [7 FIX]>>>
1169
1170 <DEFINE MESSAGE (SEVERITY STR "TUPLE" TEXT)
1171         <AND <GASSIGNED? DEBUGSW> <ERROR .SEVERITY .STR>>
1172         <MAPF <>
1173               <FUNCTION (SEV ATM)
1174                       #DECL ((ATM SEV) ATOM)
1175                       <COND (<==? .SEV .SEVERITY>
1176                              <AND <ASSIGNED? .ATM> <SET .ATM T>>
1177                              <MAPLEAVE>)>>
1178               '(ERROR NOTE WARNING INCONSISTANCY INCONSISTENCY)
1179               '(ERRS NOTES WARNS INCONS INCONS)>
1180         <PRINC "*** ">
1181         <PRINC .SEVERITY>    ;"Typically NOTE, WARNING, ERROR, or INCONSISTANCY"
1182         <PRINC "        ">
1183         <PRINC .STR>
1184         <REPEAT ()
1185                 <COND (<EMPTY? .TEXT> <RETURN 0>)
1186                       (<==? <TYPE <1 .TEXT>> ATOM> <PRINC <1 .TEXT>>)
1187                       (<TYPE? <1 .TEXT> NODE>
1188                        <COND (<GASSIGNED? NODE-COMPLAIN>
1189                               <TERPRI>
1190                               <NODE-COMPLAIN <1 .TEXT>>
1191                               <TERPRI>)>)
1192                       (ELSE <PRIN1 <1 .TEXT>>)>
1193                 <PRINC " ">                                             ;"Space"
1194                 <SET TEXT <REST .TEXT>>>
1195         <TERPRI>
1196         <COND (<==? .SEVERITY ERROR> <RETURN " COMPILATION ABORTED " .COMPILER>)
1197               (<OR <==? .SEVERITY INCONSISTANCY> <==? .SEVERITY INCONSISTENCY>>
1198                <RETURN " INFORM  BKD; OR CLR; " .COMPILER>)>
1199         T>
1200
1201 <SETG INSTRUCTION ,FORM>
1202
1203 <ENDPACKAGE>
1204 \ 3