
     1  %externalstring(255)%fnspec date
503 @ 4405:         LINE   1 "regression-compile-tmp/vax-pass3.imp"
504 @ 4445:         DEF    DATE (_DATE) p1=V_0081 a/tf=38 b/format=ff c/ostate=3b  type=3 (string) form=8 (function) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=1 unass=1
505 @ 4461:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
506 @ 4462:         FINISH ) {lev=0}

     2  %externalstring(255)%fnspec time
507 @ 4463:         LINE   2 "regression-compile-tmp/vax-pass3.imp"
508 @ 4503:         DEF    TIME (_TIME) p1=V_0082 a/tf=38 b/format=ff c/ostate=3b  type=3 (string) form=8 (function) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=1 unass=1
509 @ 4519:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
510 @ 4520:         FINISH ) {lev=0}

     3  %systemroutinespec exit %alias "exit" (%integer rc)
     4  
511 @ 4521:         LINE   3 "regression-compile-tmp/vax-pass3.imp"
512 @ 4561:         ALIAS  "exit"
513 @ 4567:         DEF    EXIT (_EXIT) p1=V_0083 a/tf=7 b/format=0 c/ostate=2c  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=4 (system) spec=1 indirect=0 unass=1
514 @ 4583:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
515 @ 4584:            DEF    RC p1=V_0084 a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
516 @ 4598:         FINISH ) {lev=0}

     5  %externalintegerfnspec cputime
517 @ 4599:         LINE   5 "regression-compile-tmp/vax-pass3.imp"
518 @ 4639:         DEF    CPUTIME (_CPUTIME) p1=V_0084 a/tf=18 b/format=1 c/ostate=3b  type=1 (integer) form=8 (function) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=1 unass=1
519 @ 4658:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
520 @ 4659:         FINISH ) {lev=0}

     6  %externalroutinespec getblock %alias "GETBLOCK_JSB" (%integer len, %bytename base)
521 @ 4660:         LINE   6 "regression-compile-tmp/vax-pass3.imp"
522 @ 4700:         ALIAS  "GETBLOCK_JSB"
523 @ 4714:         DEF    GETBLOCK (_GETBLOCK) p1=V_0085 a/tf=7 b/format=0 c/ostate=2b  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1
524 @ 4734:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
525 @ 4735:            DEF    LEN p1=V_0086 a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
526 @ 4750:            DEF    BASE p1=V_0087 a/tf=12 b/format=2 c/ostate=0  type=1 (integer) form=2 (name) special=1 (byte-integer) linkage=0 (auto) spec=0 indirect=0 unass=0
527 @ 4766:         FINISH ) {lev=0}

     7  %externalintegerfunctionspec getlong %alias "GETLONG_JSB"
528 @ 4767:         LINE   7 "regression-compile-tmp/vax-pass3.imp"
529 @ 4807:         ALIAS  "GETLONG_JSB"
530 @ 4820:         DEF    GETLONG (_GETLONG) p1=V_0086 a/tf=18 b/format=1 c/ostate=3b  type=1 (integer) form=8 (function) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=1 unass=1
531 @ 4839:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
532 @ 4840:         FINISH ) {lev=0}

     8  %externalintegerfunctionspec getword %alias "GETWORD_JSB"
533 @ 4841:         LINE   8 "regression-compile-tmp/vax-pass3.imp"
534 @ 4881:         ALIAS  "GETWORD_JSB"
535 @ 4894:         DEF    GETWORD (_GETWORD) p1=V_0087 a/tf=18 b/format=1 c/ostate=3b  type=1 (integer) form=8 (function) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=1 unass=1
536 @ 4913:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
537 @ 4914:         FINISH ) {lev=0}

     9     %externalroutinespec get(%integername n)
538 @ 4915:         LINE   9 "regression-compile-tmp/vax-pass3.imp"
539 @ 4955:         DEF    GET (_GET) p1=V_0088 a/tf=7 b/format=0 c/ostate=2b  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1
540 @ 4970:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
541 @ 4971:            DEF    N p1=V_0089 a/tf=12 b/format=1 c/ostate=0  type=1 (integer) form=2 (name) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
542 @ 4984:         FINISH ) {lev=0}

    10     %externalroutinespec put(%integer n)
543 @ 4985:         LINE   10 "regression-compile-tmp/vax-pass3.imp"
544 @ 5025:         DEF    PUT (_PUT) p1=V_0089 a/tf=7 b/format=0 c/ostate=2b  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1
545 @ 5040:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
546 @ 5041:            DEF    N p1=V_008a a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
547 @ 5054:         FINISH ) {lev=0}

    11     %externalroutinespec putword(%integer n)
548 @ 5055:         LINE   11 "regression-compile-tmp/vax-pass3.imp"
549 @ 5095:         DEF    PUTWORD (_PUTWORD) p1=V_008a a/tf=7 b/format=0 c/ostate=2b  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1
550 @ 5114:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
551 @ 5115:            DEF    N p1=V_008b a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
552 @ 5128:         FINISH ) {lev=0}

    12     %externalroutinespec putlong(%integer n)
553 @ 5129:         LINE   12 "regression-compile-tmp/vax-pass3.imp"
554 @ 5169:         DEF    PUTLONG (_PUTLONG) p1=V_008b a/tf=7 b/format=0 c/ostate=2b  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1
555 @ 5188:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
556 @ 5189:            DEF    N p1=V_008c a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
557 @ 5202:         FINISH ) {lev=0}

    13     %externalroutinespec putblock(%integer len, %bytename b)
    14  !   Computer Science IMP77 Compiler   -   Version 8  Third pass
    15  !      23rd March 1981
    16  !      Mods by MT October/November 1981
    17  !
    18  ! Uses common include file defining constants,
    19  ! spec'ing common externals etc.
    20  !
    21  !!%include "control.imp"
    22  
    23  {%systemroutinespec exit %alias "exit" (%integer s)
    24  !%external %routine %spec  PUT (%integer n)
    25  !%external %routine %spec  PUT WORD (%integer n)
    26  !%external %routine %spec  PUT LONG (%integer n)
    27  !%external %routine %spec  PUT BLOCK (%integer n, %bytename b)
558 @ 5203:         LINE   13 "regression-compile-tmp/vax-pass3.imp"
559 @ 5243:         DEF    PUTBLOCK (_PUTBLOCK) p1=V_008c a/tf=7 b/format=0 c/ostate=2b  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1
560 @ 5263:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
561 @ 5264:            DEF    LEN p1=V_008d a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
562 @ 5279:            DEF    B p1=V_008e a/tf=12 b/format=2 c/ostate=0  type=1 (integer) form=2 (name) special=1 (byte-integer) linkage=0 (auto) spec=0 indirect=0 unass=0
563 @ 5292:         FINISH ) {lev=0}

    28  %external %routine %spec  SELECT INPUT TANK (%integer n)
564 @ 5293:         LINE   28 "regression-compile-tmp/vax-pass3.imp"
565 @ 5333:         DEF    SELECTINPUTTANK (_SELECTINPUTTANK) p1=V_008d a/tf=7 b/format=0 c/ostate=2b  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1
566 @ 5360:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
567 @ 5361:            DEF    N p1=V_008e a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
568 @ 5374:         FINISH ) {lev=0}

    29  %external %routine %spec  SELECT OUTPUT TANK (%integer n)
    30  !%external %routine %spec  GET (%integer %name ch)
    31  !%external %routine %spec  GET BLOCK (%integer len, %byte %name b)
569 @ 5375:         LINE   29 "regression-compile-tmp/vax-pass3.imp"
570 @ 5415:         DEF    SELECTOUTPUTTANK (_SELECTOUTPUTTANK) p1=V_008e a/tf=7 b/format=0 c/ostate=2b  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1
571 @ 5443:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
572 @ 5444:            DEF    N p1=V_008f a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
573 @ 5457:         FINISH ) {lev=0}

    32  %external %routine %spec  PRINT RECORD (%integer len, %byte %name buff)
574 @ 5458:         LINE   32 "regression-compile-tmp/vax-pass3.imp"
575 @ 5498:         DEF    PRINTRECORD (_PRINTRECORD) p1=V_008f a/tf=7 b/format=0 c/ostate=2b  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1
576 @ 5521:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
577 @ 5522:            DEF    LEN p1=V_0090 a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
578 @ 5537:            DEF    BUFF p1=V_0091 a/tf=12 b/format=2 c/ostate=0  type=1 (integer) form=2 (name) special=1 (byte-integer) linkage=0 (auto) spec=0 indirect=0 unass=0
579 @ 5553:         FINISH ) {lev=0}

    33  %external %integer %function %spec  LOOK
    34  !%external %integer %function %spec  GETWORD
    35  !%external %integer %function %spec  GETLONG
580 @ 5554:         LINE   33 "regression-compile-tmp/vax-pass3.imp"
581 @ 5594:         DEF    LOOK (_LOOK) p1=V_0090 a/tf=18 b/format=1 c/ostate=3b  type=1 (integer) form=8 (function) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=1 unass=1
582 @ 5610:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
583 @ 5611:         FINISH ) {lev=0}

    36  %external %integer %function %spec  TAG %alias "GETLONG";  ! For pass 2
584 @ 5612:         LINE   36 "regression-compile-tmp/vax-pass3.imp"
585 @ 5652:         ALIAS  "GETLONG"
586 @ 5661:         DEF    TAG (_TAG) p1=V_0091 a/tf=18 b/format=1 c/ostate=3b  type=1 (integer) form=8 (function) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=1 unass=1
587 @ 5676:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
588 @ 5677:         FINISH ) {lev=0}

    37  %external %string(63) %function %spec  ITOS (%integer n, p)
    38  
    39  ! streams
589 @ 5678:         LINE   37 "regression-compile-tmp/vax-pass3.imp"
590 @ 5718:         DEF    ITOS (_ITOS) p1=V_0092 a/tf=38 b/format=3f c/ostate=3b  type=3 (string) form=8 (function) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=1 unass=1
591 @ 5734:         START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
592 @ 5735:            DEF    N p1=V_0093 a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
593 @ 5748:            DEF    P p1=V_0094 a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
594 @ 5761:         FINISH ) {lev=0}

    40  %const %integer  report      = 0
595 @ 5762:         LINE   40 "regression-compile-tmp/vax-pass3.imp"

    41  %const %integer  object file = 1
596 @ 5802:         LINE   41 "regression-compile-tmp/vax-pass3.imp"

    42  %const %integer  listing     = 2
597 @ 5842:         LINE   42 "regression-compile-tmp/vax-pass3.imp"

    43  %const %integer  diag stream = listing
    44  
    45  ! miscellaneous
598 @ 5882:         LINE   43 "regression-compile-tmp/vax-pass3.imp"

    46  %const %integer  max ident = 31;        ! Length for external linkage
599 @ 5922:         LINE   46 "regression-compile-tmp/vax-pass3.imp"

    47  %const %integer  fatal = 16_1000002C;   ! Error exit code to VMS
    48  
    49  
    50  ! external data (defined in driver)
600 @ 5962:         LINE   47 "regression-compile-tmp/vax-pass3.imp"

    51  %external %string(6) %spec  version;    ! Compiler version string
601 @ 6002:         LINE   51 "regression-compile-tmp/vax-pass3.imp"
602 @ 6042:         DEF    VERSION p1=V_0093 a/tf=31 b/format=6 c/ostate=2b  type=3 (string) form=1 (simple) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1

    52  %external %integer %spec  command
603 @ 6061:         LINE   52 "regression-compile-tmp/vax-pass3.imp"
604 @ 6101:         DEF    COMMAND p1=V_0094 a/tf=11 b/format=1 c/ostate=2b  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1

    53  %external %integer %spec  control
    54  
    55  ! command bit meanings (set by command line)
605 @ 6120:         LINE   53 "regression-compile-tmp/vax-pass3.imp"
606 @ 6160:         DEF    CONTROL p1=V_0095 a/tf=11 b/format=1 c/ostate=2b  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=3 (external) spec=1 indirect=0 unass=1

    56  %const %integer  diag bit  = 8_00004
607 @ 6179:         LINE   56 "regression-compile-tmp/vax-pass3.imp"

    57  %const %integer  line bit  = 8_00010
608 @ 6219:         LINE   57 "regression-compile-tmp/vax-pass3.imp"

    58  %const %integer  log bit   = 8_00020
609 @ 6259:         LINE   58 "regression-compile-tmp/vax-pass3.imp"

    59  %const %integer  time bit  = 8_01000
610 @ 6299:         LINE   59 "regression-compile-tmp/vax-pass3.imp"

    60  %const %integer  entry bit = 8_02000
611 @ 6339:         LINE   60 "regression-compile-tmp/vax-pass3.imp"

    61  %const %integer  init bit  = 8_04000
612 @ 6379:         LINE   61 "regression-compile-tmp/vax-pass3.imp"

    62  %const %integer  pic bit   = 8_10000
    63  
    64  ! control bit meanings  (%control n, or set by driver (/check= etc))
    65  ! bit set => check on
    66  
613 @ 6419:         LINE   62 "regression-compile-tmp/vax-pass3.imp"

    67  %const %integer  ass check  =   1;      ! unassigned checking
614 @ 6459:         LINE   67 "regression-compile-tmp/vax-pass3.imp"

    68  %const %integer  str check  =   2;      ! string capacity checking
615 @ 6499:         LINE   68 "regression-compile-tmp/vax-pass3.imp"

    69  %const %integer  for check  =   4;      ! %for checking
616 @ 6539:         LINE   69 "regression-compile-tmp/vax-pass3.imp"

    70  %const %integer  arr check  =   8;      ! array bound checking
617 @ 6579:         LINE   70 "regression-compile-tmp/vax-pass3.imp"

    71  %const %integer  ovf check  =  16;      ! integer overflow checking
618 @ 6619:         LINE   71 "regression-compile-tmp/vax-pass3.imp"

    72  %const %integer  rec round  = 128;      ! rounding in records (turns it on)
619 @ 6659:         LINE   72 "regression-compile-tmp/vax-pass3.imp"

    73  %const %integer  profiling  = 256;      ! call TRACE (line no) at bounds
    74  
    75  ! object file commands  Pass2 => Pass3
    76  
620 @ 6699:         LINE   73 "regression-compile-tmp/vax-pass3.imp"

    77  %const %integer  obj extern    = 1;     ! insert external entry
621 @ 6739:         LINE   77 "regression-compile-tmp/vax-pass3.imp"

    78  %const %integer  obj code      = 2;     ! code block
622 @ 6779:         LINE   78 "regression-compile-tmp/vax-pass3.imp"

    79  %const %integer  obj gla       = 3;     ! gla  block
623 @ 6819:         LINE   79 "regression-compile-tmp/vax-pass3.imp"

    80  %const %integer  obj pdef      = 4;     ! external proc definition
624 @ 6859:         LINE   80 "regression-compile-tmp/vax-pass3.imp"

    81  %const %integer  obj pspec     = 5;     ! external proc specification
625 @ 6899:         LINE   81 "regression-compile-tmp/vax-pass3.imp"

    82  %const %integer  obj ddef      = 6;     ! external data definition
626 @ 6939:         LINE   82 "regression-compile-tmp/vax-pass3.imp"

    83  %const %integer  obj dspec     = 7;     ! external data specification
627 @ 6979:         LINE   83 "regression-compile-tmp/vax-pass3.imp"

    84  %const %integer  obj reloc     = 8;     ! relocate gla
628 @ 7019:         LINE   84 "regression-compile-tmp/vax-pass3.imp"

    85  %const %integer  obj set       = 9;     ! set gla to tag address
629 @ 7059:         LINE   85 "regression-compile-tmp/vax-pass3.imp"

    86  %const %integer  obj header    = 10;    ! start of procedure
630 @ 7099:         LINE   86 "regression-compile-tmp/vax-pass3.imp"

    87  %const %integer  obj call      = 11;    ! procedure call
631 @ 7139:         LINE   87 "regression-compile-tmp/vax-pass3.imp"

    88  %const %integer  obj jump      = 12;    ! jump
632 @ 7179:         LINE   88 "regression-compile-tmp/vax-pass3.imp"

    89  %const %integer  obj prim spec = 13;    ! prim definition
633 @ 7219:         LINE   89 "regression-compile-tmp/vax-pass3.imp"

    90  %const %integer  obj end       = 14;    ! end of object file
634 @ 7259:         LINE   90 "regression-compile-tmp/vax-pass3.imp"

    91  %const %integer  obj line      = 15;    ! line number
635 @ 7299:         LINE   91 "regression-compile-tmp/vax-pass3.imp"

    92  %const %integer  obj term      = 16;    ! end of block
636 @ 7339:         LINE   92 "regression-compile-tmp/vax-pass3.imp"

    93  %const %integer  obj diag p    = 17;    ! diags for proc header
637 @ 7379:         LINE   93 "regression-compile-tmp/vax-pass3.imp"

    94  %const %integer  obj diag v    = 18;    ! diags for variable
638 @ 7419:         LINE   94 "regression-compile-tmp/vax-pass3.imp"

    95  %const %integer  obj weak      = 19
639 @ 7459:         LINE   95 "regression-compile-tmp/vax-pass3.imp"

    96  %const %integer  obj b lab     = 20;    ! bxxb in m/code
640 @ 7499:         LINE   96 "regression-compile-tmp/vax-pass3.imp"

    97  %const %integer  obj w lab     = 21;    ! bxxw in m/code
641 @ 7539:         LINE   97 "regression-compile-tmp/vax-pass3.imp"

    98  %const %integer  obj glam      = 22;    ! initialise n items in GLA
642 @ 7579:         LINE   98 "regression-compile-tmp/vax-pass3.imp"

    99  %const %integer  obj modd      = 23;    ! modify displacement
643 @ 7619:         LINE   99 "regression-compile-tmp/vax-pass3.imp"

   100  %const %integer  obj prim ref  = 24;    ! call to prim
644 @ 7659:         LINE   100 "regression-compile-tmp/vax-pass3.imp"

   101  %const %integer  obj ext ref   = 25;    ! call to external procedure
645 @ 7699:         LINE   101 "regression-compile-tmp/vax-pass3.imp"

   102  %const %integer  last obj code = 25
   103  
   104  ! directive file commands  Pass2 => Pass3
   105  
646 @ 7739:         LINE   102 "regression-compile-tmp/vax-pass3.imp"

   106  %const %integer  dir used      = 1;     ! external used
647 @ 7779:         LINE   106 "regression-compile-tmp/vax-pass3.imp"

   107  %const %integer  dir ldef      = 2;     ! label definition
648 @ 7819:         LINE   107 "regression-compile-tmp/vax-pass3.imp"

   108  %const %integer  dir pref      = 3;     ! procedure reference
649 @ 7859:         LINE   108 "regression-compile-tmp/vax-pass3.imp"

   109  %const %integer  dir cref      = 4;     ! conditional label reference
650 @ 7899:         LINE   109 "regression-compile-tmp/vax-pass3.imp"

   110  %const %integer  dir uref      = 5;     ! unconditional label reference
651 @ 7939:         LINE   110 "regression-compile-tmp/vax-pass3.imp"

   111  %const %integer  dir end       = 6;     ! end of procedure
652 @ 7979:         LINE   111 "regression-compile-tmp/vax-pass3.imp"

   112  %const %integer  dir sizes     = 7;     ! end of directives+sizes
653 @ 8019:         LINE   112 "regression-compile-tmp/vax-pass3.imp"

   113  %const %integer  dir x end     = 8;     ! end of external entry
654 @ 8059:         LINE   113 "regression-compile-tmp/vax-pass3.imp"

   114  %const %integer  dir header    = 9;     ! start of procedure
655 @ 8099:         LINE   114 "regression-compile-tmp/vax-pass3.imp"

   115  %const %integer  dir entry     = 10;    ! define entry label
656 @ 8139:         LINE   115 "regression-compile-tmp/vax-pass3.imp"

   116  %const %integer  last dir code = 10
   117  
657 @ 8179:         LINE   116 "regression-compile-tmp/vax-pass3.imp"

   118  %end %of %file
   119  
   120  ! Size constants
   121  %const %integer  max tag       = 4000;        ! total tags in use
   122  %const %integer  max ref       = 6000;        ! references to tags
   123  %const %integer  max procs     =  600;        ! procedures in module
   124  %const %integer  max externals =  400;        ! external defs/refs
   125  %const %integer  max rec       =  512;        ! object record size
   126  
   127  %external %routine  PASS3 (%string(63) module, %integer object, directives)
   128     %integer  check ass = control&ass check;      ! unassigned checking on
   129     %integer  diags     = command&diag bit;       ! dump diag psect
   130     %integer  ldump     = command&line bit;       ! dump lines (trace) psect
   131     %integer  pic       = command&pic bit;        ! PIC for gla
   132     %integer  init      = command&init bit;       ! initialisation needed
   133     %integer  timing    = command&time bit;       ! full timing report
   134     %integer  clog      = command&log bit;        ! summary to console
   135  
   136     %const %integer  proc enter prim = 13;        ! = "$_M"
   137  
   138     %const %integer  non zero = 1;                ! boolean
   139  
   140     ! Op-codes
   141     %const %integer  brb    = 16_11;              ! +127/-128
   142     %const %integer  brw    = 16_31;              ! +32767/-32768
   143     %const %integer  jmp    = 16_17;              ! anywhere...
   144     %const %integer  bneq   = 16_12, bnequ = 16_12
   145     %const %integer  beql   = 16_13, beqlu = 16_13
   146     %const %integer  bgtr   = 16_14
   147     %const %integer  bleq   = 16_15
   148     %const %integer  bgeq   = 16_18
   149     %const %integer  blss   = 16_19
   150     %const %integer  bgtru  = 16_1A
   151     %const %integer  blequ  = 16_1B
   152     %const %integer  bgequ  = 16_1E
   153     %const %integer  blssu  = 16_1F
   154     %const %integer  jsb    = 16_16
   155     %const %integer  calls  = 16_FB
   156     %const %integer  movl   = 16_D0
   157     %const %integer  moval  = 16_DE
   158     %const %integer  movab  = 16_9E
   159     %const %integer  subl2  = 16_C2
   160     %const %integer  movc5  = 16_2C
   161  
   162     ! Branch table - invert (branch (b)) = branch(b!!7)
   163     %const %byte %array  branch (0 : 15) =
   164        brb,   beql,  blss,  bleq,  bgtr,  bgeq,  bneq,   0,      {signed}
   165      { u/c     =      <      <=     >      >=      #   never }
   166        brb,   beqlu, blssu, blequ, bgtru, bgequ, bnequ,  0       {unsigned}
   167  
   168  
   169     %const %integer  margin   = 800;              ! stretch margin for jumps
   170     %const %integer  safe low = 16_ffff8001+margin
   171     %const %integer  safe high= 16_00008000-margin
   172  
   173     %const %integer  middling = 16_1000;          ! word disp ref
   174  
   175     ! Object record constants
   176  
   177     %const %integer  obj hdr = 0
   178     %const %integer      hdr mhd = 0;             ! module header
   179     %const %integer      hdr lng = 1;             ! language sub-header
   180  
   181     %const %integer  obj gsd = 1
   182     %const %integer      gsd psc = 0;             ! P-sect def
   183     %const %integer      gsd sym = 1;             ! Symbol (def/ref)
   184     %const %integer      gsd epm = 2;             ! Ext def + mask
   185  
   186     %const %integer  obj tir = 2
   187     %const %integer      tir stag    = 0;         ! Stack global symbol
   188     %const %integer      tir stasb   = 1;         ! Stack signed byte
   189     %const %integer      tir stasw   = 2
   190     %const %integer      tir stal    = 3
   191     %const %integer      tir stpbb   = 4
   192     %const %integer      tir stpbw   = 5
   193     %const %integer      tir stpbl   = 6
   194     %const %integer      tir staub   = 7;         ! Stack unsigned byte
   195     %const %integer      tir stob    = 20;        ! Store signed byte
   196     %const %integer      tir stow    = 21;        ! Store signed word
   197     %const %integer      tir stol    = 22;        ! Store longword
   198     %const %integer      tir stold   = 25;        ! Store longword
   199     %const %integer      tir stopidr = 27;        ! Store PIC data reference
   200     %const %integer      tir stopicr = 28;        ! Store PIC reference
   201     %const %integer      tir sto rl  = 31;        ! Store repeated long
   202     %const %integer      tir stoub   = 33;        ! Store unsigned byte
   203     %const %integer      tir stogb   = 37;        ! Store general byte
   204     %const %integer      tir sto rb  = 39;        ! Store repeated byte
   205     %const %integer      tir sto rw  = 40;        ! Store repeated word
   206     %const %integer      tir add     = 51
   207     %const %integer      tir setrb   = 80
   208     %const %integer      tir augrb   = 81
   209  
   210     %const %integer  obj eom = 3
   211     %const %integer  obj dbg = 4
   212  
   213     !P-sect info
   214  
   215     %const %integer  quad = 3;                    ! 8(=2**3)-byte alignment
   216  
   217     %const %integer  ps pic = 1<<0
   218     %const %integer  ps rel = 1<<3
   219     %const %integer  ps shr = 1<<5
   220     %const %integer  ps exe = 1<<6
   221     %const %integer  ps rd  = 1<<7
   222     %const %integer  ps wrt = 1<<8
   223  
   224     %own %integer %name  ca
   225     %own %integer %name  ga
   226     %own %integer  base        =  0
   227     %own %short    ref head    =  0
   228     %own %short %name  ref chain;   ref chain == ref head
   229     %own %short    def list    =  0;      !ordered list of labels
   230     %own %integer  this line   =  0
   231     %own %integer  entry tag   = -1
   232  
   233     %const %integer  code flags = ps pic ! ps rel ! ps rd  ! ps exe ! ps shr
   234     %own   %integer  glap flags = ps rd  ! ps wrt ! ps rel ! ps pic
   235  !                    glap flags = glap flags ! ps pic %if pic # 0
   236     %const %integer  diag flags = ps pic ! ps rel ! ps rd  ! ps shr
   237     %const %integer  line flags = ps pic ! ps rel ! ps rd  ! ps shr
   238  
   239     %const %string(10)  code name = "$_CODEAREA"
   240     %own   %string(10)  glap name = "$_GLAPAREA"
   241  !                       glap name = "$_GLAPPIC"
   242     %const %string(10)  diag name = "$_DIAGAREA"
   243     %const %string(10)  line name = "$_CODELINE"
   244     %const %string(10)  init proc = "IMP$_INIT"
   245  
   246     %integer  refs, last tag
   247     %integer  code size, glap size, diag size, line size
   248     %integer  procs, events, event base, evp, specs
   249     %own %string(max ident)  text
   250  
   251     %record %format  psect fm (%integer bp, pa, dump, bs, lr, lrp,
   252                                %integer index, lbs, bb, be, max,
   253                                (%byte type %or
   254                                 %byte %array b (1 : maxrec)))
   255     %own %record(psect fm)  codep, glapp, workp, diagp, linep
   256     %own %record(psect fm) %name  buff;     ! Points at one of above
   257  
   258     %record %format  ref fm (%integer ca, tag, %short flag, link)
   259     %record %format  def fm (%integer ca, %short uses, link)
   260     %record(def fm) %array  def (0 : max tag)
   261     %record(ref fm) %array  ref (1 : max ref)
   262  
   263     %record %format  proc fm (%integer frame,
   264                               %short type, mask, diag, diag ep, line ep)
   265     %record(proc fm) %array  proc tab (1 : max procs)
   266  
   267     %byte              %array  ext used (1 : max externals)
   268     %string(max ident) %array  ext text (1 : max externals)
   269  
   270  
   271     %routine  ERROR (%string(31) text, %integer extra)
   272        select output (report)
   273        newline
   274        print string ("***Pass3 fails """);  print string (text)
   275        print string (""" (");  write (extra, 0);  print symbol (')')
   276        newline
   277        %monitor
   278        exit (16_1000002c)     {1000002c is SS$_ABORT with the inhibit message bit set - could just use EXIT_FAILURE}
   279     %end
   280  
   281     %routine  GET STRING (%string(*) %name  t)
   282        %integer  len, file len
   283        get (len)
   284        file len = len
   285        error ("external size?", len) %unless 0 < len <= max ident
   286        len = len - 1 %if len = max ident {make room for '_' in Gla name}
   287        length(t) = len
   288        getblock (file len, charno(t,1))
   289     %end
   290  
   291     %routine %spec  STPB (%record(psect fm) %name p, %integer d)
   292     %routine %spec  ADD (%integer b)
   293     %routine  FLUSH BUFF
   294        %integer %name  bp
   295        bp == buff_bp
   296        %if bp > max rec %start
   297           ! over the limits!
   298           error ("buffer error - seek help!!", bp-maxrec)
   299        %finish
   300        %if buff_dump # 0 %start
   301           error ("buffer error", 1) %if buff_bs > 0;  ! Still in IMMED mode
   302           %if bp > 1 %start
   303              print record (bp, buff_b(1))
   304           %finish
   305        %finish
   306        buff_bs = 0;  buff_be = 0;  buff_lbs = 0;  buff_lr = 0
   307        bp = 1;                   ! leave type field
   308        %if buff_type = obj tir %and buff_dump # 0 %start
   309           ! fill in reloc command
   310           stpb (buff, buff_pa);  add (tir setrb)
   311           buff_lr = buff_bp;  buff_lrp = 1
   312        %finish
   313     %end
   314  
   315     %routine  NEED (%integer  b)
   316        ! ensure there are at least b bytes free in current buffer
   317        flush buff %if buff_bp + b > max rec
   318     %end
   319  
   320     %routine  SET WORK (%integer type)
   321        buff == workp;  flush buff
   322        workp = 0;  workp_dump = 1
   323        workp_type = type;  workp_bp = 1
   324     %end
   325  
   326     %routine  ADD (%integer b)
   327        %return %if buff_dump = 0
   328        buff_bp = buff_bp + 1;  buff_b(buff_bp) = b&255
   329     %end
   330  
   331     %routine  ADDW (%integer n)
   332        %return %if buff_dump = 0
   333        shortinteger(addr(buff_b(buff_bp+1))) = n
   334        buff_bp = buff_bp + 2
   335     %end
   336  
   337     %routine  ADDL (%integer n)
   338        %return %if buff_dump = 0
   339        integer(addr(buff_b(buff_bp+1))) = n
   340        buff_bp = buff_bp + 4
   341     %end
   342  
   343     %routine  ADD STRING (%integer from, %string(63) s)
   344        %integer b, l
   345        %return %if buff_dump = 0
   346        l = length(s)
   347        %if from = 0 %start
   348           string(addr(buff_b(buff_bp+1))) = s
   349           buff_bp = buff_bp + 1
   350        %else
   351           b = buff_b(buff_bp)
   352           string(addr(buff_b(buff_bp))) = s
   353           buff_b(buff_bp) = b
   354        %finish
   355        buff_bp = buff_bp + l
   356     %end
   357  
   358     %routine  ADD TEXT (%integer data)
   359        %string(max ident) t = text
   360        %return %if buff_dump = 0
   361        t = t . "_" %if data # 0
   362        add string (0, t)
   363     %end
   364  
   365     %integer %function  RANGE (%integer disp, extra)
   366        %result = 1 %if -128 <= disp <= 127
   367        %result = 2 %if 16_FFFF8000 <= disp-extra <= 16_7FFF
   368        %result = 4
   369     %end
   370  
   371     %routine  STAG (%string(max ident+3) S)
   372        need (1+1+length(S))
   373        add (tir stag);   add string (0, S)
   374     %end
   375  
   376     %routine  TIR COMMAND (%integername value, %integer param,
   377                            %byte %array %name  clist)
   378        %integer  size
   379        size = range (value, 0)
   380        need (2+size)
   381        add (clist(size))
   382        add (param) %if param >= 0
   383        %if size = 1 %start
   384           add (value)
   385        %else %if size = 2
   386           addw (value)
   387        %else
   388           addl (value)
   389        %finish
   390        value = size
   391     %end
   392  
   393     %routine  STPB (%record(psect fm) %name p, %integer offset)
   394        %own %byte %array  stpbc (1 : 4) =
   395           tir stpbb, tir stpbw, 0, tir stpbl
   396        tir command (offset, p_index, stpbc)
   397     %end
   398  
   399     %routine  STAK (%integer  value)
   400        %own %byte %array  stac (1 : 4) =
   401           tir stasb,  tir stasw, 0, tir stal
   402        tir command (value, -1, stac)
   403     %end
   404  
   405     %routine  SELECT (%integer disp)
   406        %return %if buff_dump = 0
   407        need (7);                 ! Sequence must be in one record!
   408        error ("psect overflow", disp) %if disp > buff_max
   409        %if buff_lr = buff_bp %start
   410           ! Have not planted anything since last 'select'
   411           buff_bp = buff_lrp;    ! Forget last select
   412           buff_pa = -20;         ! Ensure this one planted!
   413        %finish
   414        %if buff_pa # disp %start
   415           buff_lrp = buff_bp
   416           stpb (buff, disp)
   417           add (tir setrb)
   418           buff_lr = buff_bp
   419           buff_pa = disp
   420        %finish
   421     %end
   422  
   423     %routine  START IMMED (%integer max)
   424        %return %if buff_dump = 0
   425        error ("buffer in use", 0) %if buff_bs # 0
   426        error ("immediate size error", max) %if max > 128
   427        need (max+1)
   428        %if buff_be = buff_bp %and
   429            max + (buff_bp - buff_lbs) <= 128 %start
   430           ! Can concatenate buffers
   431           buff_bs = buff_lbs
   432        %else
   433           add (0);                            ! Length byte
   434           buff_bs = buff_bp
   435        %finish
   436        buff_bb = buff_bp;                     ! Where this block started
   437     %end
   438  
   439     %routine  END IMMED
   440        %integer  size
   441        %return %if buff_dump = 0
   442        error ("buffer not in use", 0) %if buff_bs = 0
   443        size = buff_bp - buff_bs
   444        %if size # 0 %start
   445           error ("buffer overflow", size) %if size > 128
   446           buff_b(buff_bs) = -size
   447           buff_lbs = buff_bs
   448           buff_be = buff_bp
   449        %else
   450           buff_bp = buff_bp - 1
   451        %finish
   452        buff_pa = buff_pa + buff_bp - buff_bb; ! Update psect disp.
   453        error ("Psect immediate overflow", 0) %if buff_pa > buff_max
   454        buff_bs = 0;                           ! Not buffering now
   455     %end
   456  
   457     %routine  SPEC (%integer flags, data, value, mask)
   458        %integer  def, len, psect
   459        psect = |data|
   460        data = 0 %if data < 0;                  ! no '_' for ext data def
   461        def = flags&2
   462        len = (1+1)+(data+length(text))
   463        len = len + 7 %if def # 0
   464        set work (obj gsd)
   465        %if def = 0 %start
   466           add (gsd sym)
   467        %else
   468           add (gsd epm)
   469        %finish
   470        add (0);                               ! data type - unknown
   471        addw (flags);                          ! symbol flags
   472        %if def # 0 %start;                    ! definition
   473           add (psect)
   474           addl (value)
   475           addw (mask)
   476        %finish
   477        add text (data)
   478     %end
   479  
   480     %routine  INPUT DIRECTIVES
   481        %switch  d (1 : last dir code)
   482        %short  first = 0, list = 0
   483        %short %name  ref list == first, end
   484        %record(proc fm) %name  proc
   485        %record(ref fm)  %name  r
   486        %record(def fm)  %name  t
   487        %integer %name  q
   488        %integer  proc head, n, frame, ldiag
   489        %integer  ecode, unass code, size
   490        %integer  rp, tag, block tag, dcode
   491        %own %integer  dap = 0, lap = 2
   492  
   493        procs = procs + 1
   494        proc == proc tab(procs)
   495        proc_diag ep = 0
   496        proc_line ep = 0
   497  
   498        %cycle
   499           get (dcode)
   500           -> d(dcode) %if 1 <= dcode <= last dir code
   501           error ("spurious directive", dcode)
   502  
   503     d(dir used):
   504           ext used(getword) = non zero
   505           %continue
   506  
   507     d(dir ldef):
   508           tag = getword
   509           error ("too many labels", tag) %unless 0 < tag <= max tag
   510           t == def(tag)
   511           t_ca = getlong;    ! ca
   512           end == t_link %if list = 0
   513           t_link = list;  list = tag
   514           %continue
   515  
   516     d(dir pref):
   517     d(dir cref):
   518     d(dir uref):
   519           tag = getword
   520           error ("too many labels", n) %unless 0 < tag <= max tag
   521           error ("too many references", refs) %if refs = max ref
   522           refs = refs + 1;  r == ref(refs)
   523           r_tag = tag
   524           r_ca = getlong;                     ! ca
   525           r_flag = dcode - 3
   526           ref list = refs
   527           ref list == r_link
   528           %continue
   529  
   530     d(dir entry): ! define ep
   531           entry tag = getword
   532           %continue
   533  
   534     d(dir header):
   535           input directives
   536        %repeat
   537  
   538     d(dir end):
   539        proc_type = getlong
   540        proc_mask = getword&16_CFFC
   541        frame = -getlong
   542        proc_frame = frame;               ! frame size
   543        ldiag = getword
   544        proc_diag = ldiag
   545        error ("corrupt diags", diags) %if ldiag = 0 %and diags # 0
   546        proc_diag ep = dap;  dap = dap + ldiag
   547        proc_line ep = lap;  lap = lap + getword
   548        block tag = getword
   549        ! compute length of entry code sequence
   550        ecode = 2;                             ! for entry mask
   551        %if block tag = entry tag %and init # 0 %start
   552           ecode = ecode + 7;                  ! calls #0,l^init proc
   553        %finish
   554        %if proc_type # 0 %start
   555           ecode = ecode + 7;                  ! moval l^ep_,gla
   556        %finish
   557        ecode = ecode + 3;                     ! movl fp, base
   558        %if frame # 0 %start
   559           ! locals - needs frame + unass code
   560           unass code = 8;                     ! movc5 #0,(fp),(gla),s^#f,(sp)
   561           %if frame <= 63 %start
   562              !short lit - byte's worth
   563              ecode = ecode + 3;               ! subl2 i^#f, sp
   564              unass code = 6;                  ! movc5 #0,(fp),(gla),i^#f,(sp)
   565           %else %if frame <= 16_7fff
   566              !word's worth (sheer poetry)
   567              ecode = ecode + 5;               ! moval w^-f(sp), sp
   568           %else
   569              ecode = ecode + 7;               ! subl2 s^#f, sp
   570           %finish
   571           %if check ass # 0 %start
   572              ecode = ecode + unass code
   573              proc_mask = proc_mask ! 16_003C; ! r0-r5 corrupted by MOVC5!!!
   574           %finish
   575        %finish
   576        t == def(block tag)
   577        t_ca = t_ca - ecode
   578        base = base + ecode
   579  
   580     d(dir xend):  ! end of external proc
   581  
   582        tag = list
   583        %while tag # 0 %cycle
   584           t == def(tag)
   585           t_ca = t_ca + base
   586           tag = t_link
   587        %repeat
   588        %if list # 0 %start;                   ! add labels to def list
   589           end = def list
   590           def list = list
   591        %finish
   592        ref list = 0;                          ! mark the end
   593        rp = first
   594        %while rp # 0 %cycle
   595           r == ref(rp)
   596           r_ca = r_ca + base
   597           rp = r_link
   598        %repeat
   599        size = getlong;                        ! total size
   600        base = base + size
   601        %if first # 0 %start
   602           ref chain = first
   603           ref chain == ref list
   604           ref chain = 0
   605        %finish
   606        %return
   607  
   608     d(dir sizes):   ! end of directives, totals follow
   609        glap size  = getlong
   610        last tag   = getword
   611        specs      = getword
   612        diag size  = getword
   613        events     = getword
   614        proc tab(1)_diag ep = dap
   615        line size  = lap
   616     %end
   617  
   618     %routine  STRETCH JUMPS
   619        %integer  extra, here, there, disp, mod, tag
   620        %integer %name  pt
   621        %short %name  last, next
   622        %record(ref fm) %name  r
   623        %record(def fm) %name  t
   624        %cycle
   625           extra = 0
   626           last == ref head
   627           %while last # 0 %cycle
   628              r == ref(last)
   629              next == r_link
   630              r_ca = r_ca + extra
   631              here = r_ca + 2
   632              there = def(r_tag)_ca
   633              disp = there - here
   634              mod = 0
   635              %if r_flag&middling = 0 %and
   636                  %not -128 <= disp <= 127 %start
   637                 r_flag = r_flag!middling
   638  !********               %if safelow <= disp <= safe high %start
   639  !********                  ! will not stretch again
   640  !********                  last = next
   641  !********                  next == last
   642  !********               %finish
   643                 mod = 1;                      ! 1-byte -> 2-byte disp
   644                 mod = 3 %if r_flag&1 # 0;     ! conditional -> skip+brw
   645              %else %unless 16_FFFF8001 <= disp <= 16_8000
   646                 ! cannot get bigger
   647                 last = next
   648                 next == last
   649                 mod = 2;                      ! word disp -> longword disp
   650                 mod = 3 %if r_flag&3 # 0;     ! brw -> jmp
   651              %finish
   652              %if mod # 0 %start
   653                 tag = def list
   654                 %while tag # 0 %cycle
   655                    t == def(tag)
   656                    pt == t_ca
   657                    %exit %if pt < here
   658                    pt = pt + mod
   659                    tag = t_link
   660                 %repeat
   661                 extra = extra + mod
   662              %finish
   663              last == next
   664           %repeat
   665           base = base + extra
   666        %repeat %until extra = 0
   667        event base = (base+7)&(\7)
   668        evp = event base
   669        code size = event base + events*16 + 4
   670     %end
   671  
   672     %routine  DUMP CODE (%integer base, btag, limit)
   673        %switch  c (1 : last obj code)
   674        %own %byte %array  base mod (5 : 15)
   675        ! Code type enables pre-selection of the appropriate
   676        ! output buffer for each command code byte from Pass 2.
   677        %const %byte %array  code type (1 : last obj code) =
   678           0, 0, 1, 0, 0,
   679           1, 1, 1, 1, 0,
   680           0, 0, 0, 0, 3,
   681           0, 2, 2, 0, 0,
   682           0, 1, 0, 0, 0
   683        %own %record(psect fm) %name %array  buff for (0 : 3)
   684        %own %integer  called = 0
   685  
   686        %integer  disp, cond
   687        %integer  ldiag, value
   688        %integer  ocode, type
   689        %integer  gb, gx, cx, xno, pno
   690        %integer  old ca, old la, old da
   691        %integer  count, size, n, save
   692        %integer  reg, specifier, mode
   693        %integer  evlow, evep, evword
   694        %integer  tag, lim, nbase
   695        %record(proc fm) %name  proc
   696  
   697        %routine  DUMP LINE
   698           buff == linep
   699           start immed (6)
   700           addl (ca);  addw (this line)
   701           end immed
   702        %end
   703  
   704        %routine  LOAD BLOCK
   705           %integer  n
   706           get (n);  start immed (n)
   707           get block (n, buff_b(buff_bp+1))
   708           buff_bp = buff_bp + n
   709           end immed
   710        %end
   711  
   712        %routine  SET PRIM TEXT (%integer  pno)
   713           text = "$_"
   714           text = text . "_" %and pno = pno - 26 %while pno > 26
   715           text = text . tostring ('A'-1+pno)
   716        %end
   717  
   718        %routine  PLUG GLAP (%record(psect fm) %name with,
   719                             %integer with disp, where, inst)
   720           %integer  old ga = ga
   721           %unless 0 < where < glap size %start
   722              error ("faulty glap relocation", where)
   723           %finish
   724           buff == glapp;  select (where)
   725           need (7);                   ! Must have following in one record..
   726           stpb (with, with disp)
   727           add (inst)
   728           select (old ga)
   729        %end
   730  
   731        %routine  BSEL (%integername old, %record(psect fm) %name p,
   732                        %integer  new)
   733           buff == p
   734           old = p_pa
   735           select (new)
   736        %end
   737  
   738        %routine  INITIALISE BUFFERS
   739           buff for(0) == codep
   740           buff for(1) == glapp
   741           buff for(2) == diagp
   742           buff for(3) == linep
   743           called = non zero
   744        %end
   745  
   746        %routine  HANDLE BLOCK ENTRY
   747           %integer  mask, unsaved, reg
   748           %integer  frame
   749           base = 13 %if base = 12;            ! bottom 2 levels
   750           dump line %if ldump # 0
   751           buff == codep
   752           ! Calculate true offset from FP of args to this proc
   753           ! for benefit of inner procs referencing them.  This
   754           ! is affected by the number of regs saved on the stack
   755           ! on proc call.  Pass 2 assumes all regs saved, we now
   756           ! calculate how many aren't, and subtract this*4 from
   757           ! displacement used by pass 2.
   758           mask = proc_mask;  unsaved = 0
   759           %for reg = 2, 1, 11 %cycle
   760              unsaved = unsaved + 1 %if mask & (1<<reg) = 0
   761           %repeat
   762           base mod(base) = unsaved*4;         ! to subtract off
   763           frame = proc_frame;                 ! frame size
   764           start immed (50);                   ! For entry sequence
   765           addw (mask);                        ! entry mask
   766           %if proc_type # 0 %start
   767              ! %external entry
   768              get string (text);               ! name
   769              %if entry tag = btag %and init # 0   %start
   770                 add (calls);  add (0);        ! calls  #0,init proc
   771                 end immed
   772                 stag (init proc);             ! spec reference
   773                 add (tir stopicr);            ! store it
   774                 ca = ca + 5
   775                 start immed (1)
   776              %finish
   777              add (moval);   end immed;        ! moval
   778              need (1+1+length(text)+1+1);
   779              stag (text."_");
   780              add (tir stopicr);               !        ep_,
   781              ca = ca + 5
   782              start immed (50);  add (16_5B);  !            gla
   783           %finish
   784           add (movl);                         ! movl
   785           add (16_5D);  add (16_50+base);     !        fp, base
   786           %if frame # 0 %start
   787              %if frame <= 63 %start
   788                 add (subl2);                  ! subl2
   789                 add (frame);                  !        S^#frame
   790              %else %if frame <= 16_7fff
   791                 add (movab);                  ! movab
   792                 add (16_CE);  addw (-frame);  !        W^-frame(sp)
   793              %else
   794                 add (subl2);                  ! subl2
   795                 add (16_8F);  addl (frame);   !        I^#frame
   796              %finish
   797              add (16_5E);                     !                    , SP
   798              %if check ass # 0 %start
   799                 add (movc5);  add (0);  add (16_6D);  add (16_6B)
   800                 %if frame <= 63 %start
   801                    add (frame)
   802                 %else
   803                    add (16_8F);  addw (frame&16_7FFF)
   804                 %finish
   805                 add (16_6E)
   806                 !movc5_#0,(fp),(gla), #N, (sp)
   807              %finish
   808           %finish
   809           end immed
   810        %end
   811  
   812        initialise buffers %if called = 0
   813        procs = procs + 1
   814        proc == proc tab(procs)
   815        bsel (old da, diagp, proc_diag ep)
   816        bsel (old la, linep, proc_line ep)
   817        bsel (old ca, codep, def(btag)_ca)
   818        handle block entry %if base # 0
   819  
   820        %cycle
   821           get (ocode)
   822           buff == buff for(code type(ocode))
   823           -> c(ocode) %if 0 < ocode <= 25
   824     c(*): error ("spurious object", ocode)
   825  
   826     c(obj diag p):
   827           n = getword
   828           get string (text)
   829           ldiag = proc_diag
   830           error ("corrupt diags", 0) %if ldiag = 0
   831           start immed (50)
   832           addw (ldiag);  addw (n);  addl (limit);  add text (0)
   833           end immed
   834           %continue
   835     c(obj diag v):
   836           start immed (50)
   837           addw (getword);  addl (getlong)
   838           get string (text);  add text (0)
   839           end immed
   840           %continue
   841     c(obj code):
   842           load block
   843           %continue
   844     c(obj modd):
   845           get (ocode);  error ("faulty mod", ocode) %if ocode # 2
   846           get (n);                            ! # bytes following
   847           start immed (n)
   848           get (specifier);   n = n - 1
   849           reg = specifier & 15
   850           add (specifier)
   851           %if n = 1 %start
   852              get (disp)
   853           %else %if n = 2
   854              disp = getword
   855           %else %if n = 4
   856              disp = getlong
   857           %else
   858              error ("faulty disp in mod", n)
   859           %finish
   860           disp = disp - base mod(reg)
   861           add (disp)
   862           add (disp>>8) %if n > 1
   863           addw (disp>>16) %if n = 4
   864           end immed
   865           %continue
   866     c(obj gla):
   867           gb = getlong
   868           error ("gla pos error", gb-ga) %if gb # ga
   869           load block
   870           %continue
   871     c(obj glam):
   872           gb = getlong
   873           error ("glam pos error", gb-ga) %if gb # ga
   874           value = getlong;                    ! value
   875           count = getlong;                    ! repeat count
   876           size  = getlong;                    ! bytes in object
   877           %if count*size > 15 %start
   878              ! Worth doing as 'store repeated' type
   879              stak (value)
   880              stak (count)
   881              need (1)
   882              %if size = 1 %start
   883                 add (tir sto rb)
   884              %else %if size = 2
   885                 add (tir sto rw)
   886              %else %if size = 4
   887                 add (tir sto rl)
   888              %else
   889                 error ("Faulty glam size", size)
   890              %finish
   891              ga = ga + count*size
   892           %else
   893              start immed (count*size)
   894              %for n = 1, 1, count %cycle
   895                 %if size = 1 %start
   896                    add (value)
   897                 %else %if size = 2
   898                    addw (value)
   899                 %else %if size = 4
   900                    addl (value)
   901                 %else
   902                    error ("Faulty glam size", size)
   903                 %finish
   904              %repeat
   905              end immed
   906           %finish
   907           %continue
   908     c(obj pdef): ! proc def
   909           tag = getlong
   910           get string (text)
   911           spec (2_1010, 0,
   912                 def(tag)_ca, proc_mask);      ! ep
   913           spec (2_1010, 1, 0, 0);             ! gla (ep_)
   914           %continue
   915     c(obj pspec): ! proc spec
   916           xno = getword
   917           get string (text)
   918           %if ext used(xno) # 0 %start;         ! strong code
   919              spec (2_1000, 0, 0, 0)
   920              ext text(xno) = text
   921           %finish
   922           %continue
   923     c(obj ddef): ! data def
   924           gx = getlong
   925           get string (text)
   926           spec (2_1010, -1, gx, 0);           ! Note -1 => special
   927           %continue
   928     c(obj weak):  ! weak ref
   929     c(obj dspec): ! data ref
   930           xno = getword
   931           get string (text)
   932           ext text(xno) = text
   933           mode = 2_1000;  mode = 2_1001 %if ocode = obj weak
   934           spec (mode, 0, 0, 0)
   935           %continue
   936     c(obj ext ref):
   937           xno = getword;                      ! External number
   938           disp = getlong;                     ! Offset
   939           get (reg);                          ! Base reg (+ indirect bit)?
   940           stag (ext text(xno));               ! External address
   941           %if disp # 0 %start
   942              stak (disp);   need (1);  add (tir add)
   943           %finish
   944           need (1);   add (tir stopicr);   ca = ca + 5
   945           %if reg&16 # 0 %start
   946              !indirect ref - won't work if absolute!!
   947              need (16)
   948              add (tir augrb);   addl (-5);    ! Go back to specifier byte
   949              add (tir staub);   add (16_FF);  ! stack byte 16_FF = @L^X(PC)
   950              add (tir stoub);                 ! store byte
   951              add (tir augrb);   addl (4);     ! return to correct ca
   952           %finish
   953           %continue
   954     c(obj reloc): ! relocate gla
   955  !         error ("Not PIC", 0) %if pic # 0
   956           gb = getlong;   gx = getlong
   957           plug glap (glapp, gx, gb, tir stopidr)
   958           %continue
   959     c(obj set): !set gla
   960           cx = def(getlong)_ca;           ! Switch label address
   961           gb = getlong;                       ! Gla address to plug
   962           plug glap (codep, cx+4, gb, tir stold)
   963           %continue
   964     c(obj header):
   965           get (nbase);                        ! base
   966           tag = getword;                      ! tag
   967           lim = getword
   968           this line = getword
   969           dump code (nbase, tag, def(lim)_ca)
   970           %continue
   971     c(obj call):
   972           tag = getlong
   973           disp = def(tag)_ca-ca-2
   974           start immed (5)
   975           n = range (disp, 1)
   976           %if n = 1 %start;
   977              add (16_AF);  add (disp)
   978           %else %if n = 2
   979              add (16_CF);  addw (disp-1)
   980           %else
   981              add (16_EF);  addl (disp-3)
   982           %finish
   983           end immed
   984           %continue
   985     c(obj jump): ! jump <cond> <tag>
   986           get (cond);  tag = getword
   987           cond = cond&15
   988           disp = def(tag)_ca-ca-2
   989           size = range (disp, 1)
   990           start immed (8)
   991           %if cond = 0 %start;          !unconditional
   992              %if size = 1 %start
   993                 add (brb);  add (disp)
   994              %else %if size = 2
   995                 add (brw);  addw (disp-1)
   996              %else
   997                 add (jmp);  add (16_EF);  addl (disp-4)
   998              %finish
   999           %else;                        !conditional
  1000              %if size = 1 %start
  1001                 add (branch(cond));   add (disp)
  1002              %else %if size = 2
  1003                 add (branch(cond!!7));  add (3)
  1004                 add (brw);  addw (disp-3)
  1005              %else
  1006                 add (branch(cond!!7));  add (6)
  1007                 add (jmp);  add (16_EF);  addl (disp-6)
  1008              %finish
  1009           %finish
  1010           end immed
  1011           %continue
  1012     c(obj b lab):  ! m/code byte label reference
  1013     c(obj w lab):  !  " " " word  " "  " " " "
  1014           disp = def(getword)_ca-ca-1
  1015           start immed (2)
  1016           %if ocode = obj w lab %start;          !word
  1017              addw (disp-1)
  1018           %else;                                 !byte
  1019              error ("branch overflow", disp) %unless -128 <= disp <= 127
  1020              add (disp)
  1021           %finish
  1022           end immed
  1023           %continue
  1024     c(obj prim spec):
  1025           get (pno);  set prim text (pno)
  1026           spec (2_1000, 0, 0, 0)
  1027           %continue
  1028     c(obj prim ref):
  1029           get (pno);  set prim text (pno)
  1030           %if pno # proc enter prim %start
  1031              start immed (1);  add (jsb);   end immed
  1032           %finish
  1033           stag (text)
  1034           need (1);  add (tir stopicr);  ca = ca + 5
  1035           %continue
  1036     c(obj line): ! line number
  1037           this line = getword
  1038           dump line %if ldump # 0
  1039        %repeat
  1040  
  1041     c(obj term):!block end
  1042        %if diagp_pa # 0 %start
  1043           buff == diagp
  1044           start immed (1);  add (0);  end immed
  1045        %finish
  1046        evword = getword;                        !events
  1047        %if evword # 0 %start;                   !events trapped
  1048           evlow = getword;                      !evlow
  1049           evep  = getword;                      !evep
  1050           buff == codep;  save = ca
  1051           select (evp)
  1052           start immed (16)
  1053           addl (evword);                        !ev list
  1054           addl (def(evlow)_ca);                 !from
  1055           addl (save);                          !to (ca)
  1056           addl (def(evep)_ca);                  !entry point
  1057           end immed
  1058           evp = evp + 16
  1059        %finish
  1060  
  1061     c(obj end):
  1062        bsel (n, diagp, old da)
  1063        bsel (n, linep, old la)
  1064        bsel (n, codep, old ca)
  1065     %end
  1066  
  1067     %routine  DUMP ALL CODE
  1068        select input tank (object)
  1069        procs = 0
  1070        dump code (0, 0, 0)
  1071     %end
  1072  
  1073     %routine  DEFINE PSECT (%record(psect fm) %name ps,
  1074                             %integer  align, flags, size,
  1075                             %string(31) name)
  1076        %own %integer  psect no = 0
  1077        set work (obj gsd)
  1078        add (gsd psc);            ! P-sect def field
  1079        add (align);              ! Align (as power of 2)
  1080        addw (flags);             ! P-sect flags (rd,wrt,exe etc)
  1081        addl (size);              ! Allocation in bytes
  1082        add string (0, name);     ! Ident
  1083        ps = 0
  1084        ps_dump = 1;  ps_type = obj tir;  ps_bp = 1
  1085        ps_max = size
  1086        ps_index = psect no
  1087        psect no = psect no + 1
  1088        flush buff
  1089        buff == ps;  ps_pa = -999;  ! ensure SELECT happens...
  1090        select (0)
  1091     %end
  1092  
  1093     %routine  DUMP MODULE HEADER
  1094        %string(31) temp
  1095        select output (object file)
  1096        set work (obj hdr);                   !header
  1097        add (hdr mhd);                        !module header record
  1098        add (0);                              !structure level
  1099        addw (max rec);                       !max record length
  1100        add string (0, module);               !module name
  1101        add string (0, "V01.00");             !module version
  1102        temp = date . " " . time
  1103        length(temp) = length(temp) - 3;      !remove milliseconds
  1104        add string (1, temp);                 !creation date
  1105        add string (1, "IMP is wonderful!");  !last patch!!
  1106        set work (obj hdr)
  1107        add (hdr lng);                        !language sub-header
  1108        add string (1, "VAX-11 Imp77 ".version)
  1109     %end
  1110  
  1111     %routine  DEFINE PSECTS
  1112        define psect (codep, quad, code flags, code size, code name)
  1113        define psect (glapp, quad, glap flags, glap size, glap name)
  1114        %if diags # 0 %start
  1115           define psect (diagp, quad, diag flags, diag size+2, diag name)
  1116           ! add 2 to ensure 0 word at end...
  1117        %else
  1118           diagp_dump = 0
  1119        %finish
  1120        %if ldump # 0 %start
  1121           define psect (linep, quad, line flags, line size, line name)
  1122           !fill in length word
  1123           buff == linep;  select (0)
  1124           start immed (2);  addw (line size);  end immed
  1125        %else
  1126           linep_dump = 0
  1127        %finish
  1128     %end
  1129  
  1130     %routine  INITIALISE
  1131        %integer  j
  1132        ext used(j) = 0 %for j = 1, 1, max externals
  1133        select input tank (directives)
  1134        refs = 0;  procs = 0;  def(0) = 0
  1135        ca == codep_pa;  ga == glapp_pa
  1136     %end
  1137  
  1138     %routine  SPEC INIT PROC
  1139        %return %if entry tag < 0 %or init = 0
  1140        set work (obj gsd)
  1141        add (gsd sym);             ! symbol entry
  1142        add (0);                   ! unknown data type
  1143        addw (2_1000);             ! flags
  1144        add string (0, init proc); ! name
  1145        flush buff
  1146     %end
  1147  
  1148     %routine  PLUG PSECTS
  1149        buff == glapp;  select (12);       ! plug things into gla
  1150        ! code psect base
  1151        need (50)
  1152        stpb (codep, 4);     add (tir stold)
  1153        ga = ga + 4
  1154        ! diags psect base
  1155        %if diags # 0 %start
  1156           stpb (diagp, 4)
  1157        %else
  1158           stak (4)
  1159        %finish
  1160        add (tir stold)
  1161        ga = ga + 4
  1162        ! lines psect base
  1163        %if ldump # 0 %start
  1164           stpb (linep, 4)
  1165        %else
  1166           stak (4)
  1167        %finish
  1168        add (tir stold)
  1169        ga = ga + 4
  1170        start immed (10)
  1171        addw (0);                         ! null string
  1172        addl (proc tab(1)_diag ep)
  1173        addl (event base)
  1174        end immed
  1175        buff == codep;  select (evp)
  1176        stak (0);  add (tir stol)
  1177        %if diags # 0 %start
  1178           buff == diagp;  select (diag size)
  1179           start immed (2);  addw (0);  end immed
  1180        %finish
  1181     %end
  1182  
  1183     %routine  DUMP EOM
  1184        set work (obj eom)
  1185        add (0);                            ! Successful compilation
  1186        %if entry tag >= 0 %start
  1187           add (0)
  1188           addl (def(entry tag)_ca)
  1189        %finish
  1190        flush buff
  1191     %end
  1192  
  1193     %routine  FLUSH BUFFERS
  1194        buff == codep;  flush buff
  1195        buff == glapp;  flush buff
  1196        buff == diagp;  flush buff
  1197        buff == linep;  flush buff
  1198        buff == workp;  flush buff
  1199     %end
  1200  
  1201     %routine  REPORT INFO
  1202        %integer  stream
  1203        %for stream = report, listing-report, listing %cycle
  1204           %continue %if clog = 0 %and stream = report
  1205           select output (stream)
  1206           print string ("Code");            write (codep_max-4, 1)
  1207           print string (" bytes  Glap");    write (glapp_max, 1)
  1208           print string (" bytes  Diags");   write (diagp_max+linep_max, 1)
  1209           print string (" bytes   Total size")
  1210           write (codep_max-4+glapp_max+diagp_max+linep_max, 1)
  1211           print string (" bytes");  newline
  1212        %repeat
  1213     %end
  1214  
  1215     %routine  TIME (%routine  R, %string(15) name)
  1216        %external %integer %function %spec  PAGEFAULTS
  1217        %integer  t, p
  1218        %own %integer  called = 0
  1219        p = page faults;   t = cputime
  1220        R
  1221        t = cputime - t;   p = pagefaults - p
  1222        %return %if timing = 0
  1223        select output (report)
  1224        print string ("Pass 3 breakdown:") %and newline %if called = 0
  1225        called = 1
  1226        spaces (3)
  1227        print string (name);  print symbol (':')
  1228        spaces (15-length(name));  space
  1229        %if t >= 20 %start
  1230           write (t, -5);  print string ("ms,    ")
  1231        %else
  1232           print string ("negligible, ")
  1233        %finish
  1234        write (p, -3);  print string (" page fault")
  1235        print symbol ('s') %if p # 1
  1236        newline
  1237        select output (object file)
  1238     %end
  1239  
  1240     ! MAIN CODE
  1241  
  1242     initialise
  1243     time (input directives, "Directive input")
  1244     time (stretch jumps, "Jump stretching")
  1245     dump module header
  1246     define psects
  1247     spec init proc
  1248     time (dump all code, "Code dumping")
  1249     plug psects
  1250     flush buffers
  1251     dump eom
  1252     report info
  1253  
  1254  %end
  1255  
  1256  %BEGIN
  1257  %END
  1258  
  1259  %end %of %file
658 @ 8219:         LINE   118 "regression-compile-tmp/vax-pass3.imp"
659 @ 8259:         END     {lev=0 --> -1}
660 @ 8260: 

