         Edinburgh IMP77 Compiler - Version 8.4

    1  %BEGIN;                               !HAL-7502
    2  !    INPUT/OUTPUT STREAMS
    3  %OWNINTEGER MAIN=1, PRE=2;            !INPUT
    4  %OWNINTEGER BIN=1, LIS=2;             !OUTPUT
    5  !    OPERAND TYPES
    6  %OWNINTEGER OPMASK=16_F000;           !MACHINE INSTRUCTION OR MACRO
    7  %OWNINTEGER MACRO=16_A000
    8  %OWNINTEGER FMASK=16_0800;            !FORWARD REF
    9  %OWNINTEGER UMASK=16_0200;            !UNDEF (FORWARD REF)
   10  %OWNINTEGER REG=16_0080;              !REGISTER
   11  %OWNINTEGER MEMMASK=16_0040;          !MEM REF
   12  %OWNINTEGER RELMASK=16_0020;          !RELOCATABLE
   13  %OWNINTEGER XMASK=16_0010;            !INDEXED
   14  %OWNINTEGER REGXMASK=16_0090;         !=REG+XMASK
   15  %OWNINTEGER RELUXMASK=16_0230;        !=RELMASK+UMASK+XMASK
   16  !    TEXT POINTERS (BYTE ADDRESSES)
   17  %OWNINTEGER CODEPOS;                  !(NOT ACTUALLY BYTE)
   18  %OWNINTEGER STARTPOS;                 !START OF CURRENT LINE
   19  %OWNINTEGER GETPOS;                   !INPUT POINTER (NEXT)
   20  %OWNINTEGER PUTPOS
   21  %OWNINTEGER PSEUDOLIM
   22  %OWNINTEGER PRINTPOS;                 !START OF PRINT LINE
   23  %OWNINTEGER FAULTPOS
   24  %OWNINTEGER MACLIM;                   !MACRO DEF LIMIT
   25  !    OTHER POINTERS (WORD ADDRESSES)
   26  %OWNINTEGER MP;                       !MACRO-CALL PARAMETERS
   27  %OWNINTEGER QBASE,QSTART,QLIM,TRANSF; !OPERAND QUEUE
   28  %OWNINTEGER DEFMIN;                   !TAG MIN (DOWN - RESET)
   29  %OWNINTEGER DEFLIM;                   !TAG LIM (FIXED)
   30  %OWNINTEGER ALMAX;                    !ASSEMBLER LAB MAX (UP - RESET)
   31  %OWNINTEGER LABMIN;                   !USER LAB MIN (DOWN - RESET)
   32  %OWNINTEGER LABLIM;                   !USER LAB LIM (FIXED)
   33  %OWNINTEGER BP;                       !BLOCK POINTER (UP - DOWN)
   34  %OWNINTEGER NP;                       !NEST POINTER (DOWN - UP)
   35  %OWNINTEGER STORELIM;                 !(FIXED)
   36  
   37  %INTEGER SYM;                         !CURRENT SYMBOL
   38  %INTEGER TERM;                        !TAG TERMINATOR
   39  %INTEGER FSYM;                        !FAULT FLAG SYMBOL
   40  %OWNINTEGER CHARS=0;                  !PRINT CHAR COUNT
   41  %OWNINTEGER LINES=0;                  !PRINT LINE COUNT
   42  %OWNINTEGER PASS=-1;                  !CURRENT PASS (-1,0,1)
   43  %OWNINTEGER LIST=-1;                  !LISTING CONTROL
   44  %INTEGER ASSCOND,SKIP;                !ASSEMBLY CONDITIONS (BIT NEST)
   45  %OWNINTEGER SAVE=1;                   !REG SAVE DISPLACEMENT
   46  %OWNINTEGER TEMPS=12;                 !TEMPORARY REGISTER SET
   47  %OWNINTEGER CONTROL=16_40;            !OBJECT CODE CONTROL FIELD
   48  %OWNINTEGER CHECK=0;  !BINARY CHECKSUM
   49  %INTEGER LOCTYPE,LOC;                 !LOCATION COUNTER
   50  %INTEGER ACC,ATYPE,AVAL;              !MAIN TEMP REGISTER
   51  %INTEGER CREG;                        !CONDITION CODE
   52  %INTEGER COND;                        !CONDITION CODE MASK
   53  %INTEGER DREG,DUSE;                   !DESTINATION REGISTER
   54  %INTEGER TYPE,VAL;                    !CURRENT TYPE,VALUE
   55  %INTEGER TAG1,TAG2;                   !TAG (CHARS 1:3, 4:6)
   56  %INTEGER MODE;                        !ASSEMBLY MODE
   57  %INTEGER PEND;                        !TAG ALREADY RECOGNISED
   58  %INTEGER FLAG;                        !JUMPS
   59  
   60  
   61  %INTEGER SBOUND
   62      SBOUND = FREESTORE-260;           !ALLOW FOR INPUT BUFFER
   63      SBOUND = SBOUND-256 %IF OUTDEV = 2
   64      SELECT OUTPUT(LIS)
   65      SBOUND = SBOUND-256 %IF OUTDEV = 2
   66  %INTEGERARRAY STORE(1:SBOUND)
   67  
   68  %INTEGERFN CHAR(%INTEGER P)
   69  !BYTE FETCH
   70    %result = byteinteger(P)
   71  %END
   72  
   73  %ROUTINE PUT CHAR(%INTEGER K)
   74  !AT PUTPOS WITH POST-INCREMENT
   75     byteinteger(putpos) = k
   76     putpos = putpos + 1
   77  %END
   78  
   79  %ROUTINE FAULT(%INTEGER K)
   80  !RECORD (FIRST) FAULT
   81  !NOT NECESSARILY CULPABLE IN PASS 0
   82      FSYM = K %IF FSYM = ' '
   83  %END
   84  
   85  %ROUTINE PRINT(%INTEGER K)
   86      INTEGER(CODEPOS+CHARS) = K
   87      CHARS = CHARS+1
   88  %END
   89  
   90  %ROUTINE PRINT WORD(%INTEGER V)
   91      %ROUTINE PRINT HIT(%INTEGER V)
   92      V = V&15+'0';  V = V+7 %IF V > '9'
   93      PRINT(V)
   94      %END
   95      %ROUTINE PRINT1(%INTEGER V)
   96      PRINT HIT(V>>4);  PRINT HIT(V)
   97      %END
   98      PRINT1(V>>8);  PRINT1(V)
   99  %END
  100  
  101  %ROUTINE PRINT LOC
  102      PRINT WORD(LOC)
  103      %IF LOCTYPE&RELMASK # 0 %THEN PRINT('''') %ELSE PRINT(' ')
  104      PRINT(' ')
  105  %END
  106  
  107  %ROUTINE DO NEWLINE
  108      NEWLINE;  LINES = LINES+1
  109      NEWLINES(2) %AND LINES = 0 %IF LINES = 61
  110  %END
  111  
  112  %ROUTINE PRINT LINE
  113      %ROUTINE PRINTIT(%INTEGER SUB)
  114      %OWNINTEGER MARKER=124;            !VERTICAL BAR
  115      %INTEGER P,Q,K
  116      %RETURN %IF CHARS = 0 %AND CHAR(PRINTPOS) = NL
  117      PRINT SYMBOL(FSYM);  SPACE
  118      P = CODEPOS;  Q = P+CHARS
  119      PRINT SYMBOL(INTEGER(P)) %AND P=P+1 %WHILE P # Q
  120      %RETURN %IF PRINTPOS = 0
  121      SPACES(17-CHARS)
  122      P = PRINTPOS;  Q = 0
  123      %CYCLE
  124      PRINT SYMBOL(MARKER) %IF P = FAULTPOS
  125      K = CHAR(P);  K = SUB %IF P = PSEUDOLIM
  126      PRINT SYMBOL('''') %IF (K!!Q)&128 # 0
  127      %RETURN %IF K = NL
  128      PRINT SYMBOL(K&127)
  129      P = P+1;  Q = K
  130      %REPEAT
  131      %END
  132      %RETURN %IF PASS = 0
  133      %UNLESS LIST < 0 %OR (PRINTPOS=0 %AND FSYM=' ' %AND LIST&1=0) %START
  134      NEWLINES(3) %IF LINES = 0
  135      PRINTIT(' ')
  136      DO NEWLINE
  137      %FINISH
  138      %IF FSYM # ' ' %AND OUTDEV # 1 %START
  139      SELECT OUTPUT(0)
  140      PRINTPOS = STARTPOS %IF PRINTPOS = 0
  141      PRINT LOC %IF CHARS = 0
  142      PRINTIT(NL)
  143      NEWLINE
  144      SELECT OUTPUT(LIS)
  145      %FINISH
  146      FSYM = ' ';  PRINTPOS = 0;  CHARS = 0
  147  %END
  148  
  149  %ROUTINE PUT WORD(%INTEGER V)
  150      CHECK = CHECK!!V
  151      SELECT OUTPUT(BIN)
  152      PRINT CH(V>>12&15+CONTROL)
  153      PRINT CH(V>>8&15+16_40)
  154      PRINT CH(V>>4&15+16_40)
  155      PRINT CH(V&15+16_40)
  156      CONTROL = 16_50
  157      SELECT OUTPUT(LIS)
  158  %END
  159  
  160  %ROUTINE PLANT VAL
  161      %IF PASS > 0 %START
  162      %IF CHARS = 0 %START
  163      %IF PRINTPOS#0 %THEN PRINT LOC %ELSE %START
  164      PRINT(' '); PRINT(' '); PRINT(' ')
  165      PRINT(' '); PRINT(' '); PRINT(' ')
  166      %FINISH
  167      %FINISH
  168      PRINT(' ') %IF CHARS = 10
  169      PRINT WORD(VAL); PUT WORD(VAL)
  170      PRINT('''') %IF TYPE&RELMASK # 0
  171      PRINT LINE %IF CHARS >= 15
  172      %FINISH
  173      LOC = LOC+1
  174  %END
  175  
  176  %ROUTINE PLANT(%INTEGER V)
  177  %INTEGER THOLD,VHOLD
  178      THOLD = TYPE;  VHOLD = VAL
  179      TYPE = 0;  VAL = V
  180      PLANT VAL
  181      TYPE = THOLD;  VAL = THOLD
  182  %END
  183  
  184  %ROUTINE NEST(%INTEGER K)
  185      NP = NP-1;  !!%MONITOR 23 %IF NP = BP
  186      INTEGER(NP) = K
  187  %END
  188  
  189  %ROUTINE SET LAB(%INTEGER DEST)
  190  %INTEGER P,Q
  191      Q = 0
  192      %CYCLE
  193      TYPE = INTEGER(NP);  P = TYPE&16_3FF+DEFLIM; !DEST SLOT
  194      NP = NP+1
  195      VAL = INTEGER(NP);             !LOC OF JUMP
  196      NP = NP+1
  197      ATYPE = -1;  CREG = -1
  198      FLAG = 0;
  199      %IF TYPE&16_800 = 0 %START
  200      FLAG = 1 %IF DEST-VAL+PASS <= 128
  201      %finish %ELSE %IF TYPE&16_400 # 0 %START
  202      FLAG = 2 %IF DEST-VAL+PASS+PASS = 1
  203      %FINISH
  204      %IF PASS = 0 %START
  205      DEST = DEST-FLAG;  INTEGER(P) = DEST
  206      %IF FLAG # 0 %START
  207      LOC = LOC-FLAG
  208      %WHILE P # ALMAX %CYCLE
  209      P = P+1;  INTEGER(P) = INTEGER(P)-FLAG
  210      %REPEAT
  211      %FINISH
  212      %finish %ELSE %START
  213      FAULT('P') %IF INTEGER(P) # DEST
  214      %FINISH
  215      %RETURN %IF INTEGER(NP)&16_1000 = 0
  216      %IF INTEGER(NP)&16_2000 # 0 %AND Q = 0 %START; !OR
  217      DEST = VAL+1
  218      DEST = VAL+2-FLAG %UNLESS TYPE&16_C00 = 16_C00
  219      Q = 1
  220      %FINISH
  221      %REPEAT
  222  %END
  223  
  224  %ROUTINE ASSEMBLE
  225  !   7502 OP-CODES
  226  %OWNINTEGER ADD=16_F400, SUB=16_F500, AND=16_F100
  227  %OWNINTEGER OR=16_F000, XOR=16_F700, COMP=16_F200
  228  %OWNINTEGER COPY=16_F300
  229  %OWNINTEGER LOADI=16_6000, SKIDI=16_7000, ADDI=16_8000
  230  %OWNINTEGER ANDI=16_9000
  231  %OWNINTEGER BOC=16_5800, BOCR=16_5000, JUM=16_4000
  232  %OWNINTEGER SKIP=16_4002, LOADC=16_20F2, ROT=16_3000
  233  %OWNINTEGER LOAD=16_2000, STORE=16_2008
  234  
  235  %INTEGER Q,NQ,OP,K,LITVAL,TYPE1,VAL1,FREE
  236  %SWITCH ASS(-30:-1)
  237  
  238  %ROUTINE COMBINE
  239  %INTEGER I,J,K
  240      I = 11; K = 2048
  241      I=I-1 %AND K=K>>1 %WHILE K&TYPE1 = 0 %AND I # 0
  242      J = K
  243      I =I-1 %AND J=J>>1 %WHILE J&VAL1 = 0 %AND I # 0
  244      VAL = VAL<<I & (K<<1-1)
  245      TYPE = TYPE1-K
  246      VAL = VAL1-J+VAL
  247  %END
  248  
  249  %ROUTINE PLANT JUMP
  250  %INTEGER I,V
  251      I = VAL-LOC
  252      %IF COND&6 = 0 %START
  253      %IF COND = 8 %START
  254      %RETURN %IF I=1
  255      PLANT(SKIP)
  256      %FINISH
  257      %finish %ELSE %START
  258      FAULT('J') %AND I=0 %IF FLAG # 0 %AND |I| > 127
  259      %IF |I| <= 127 %START
  260      %IF TYPE&UMASK = 0 %OR FLAG # 0 %START
  261      PLANT(BOC+(COND!!1)<<8+I&255)
  262      %RETURN
  263      %FINISH
  264      FAULT('S') %IF LIST >= 0 %AND LIST&8 # 0
  265      %FINISH
  266      PLANT(BOC+COND<<8+2)
  267      %FINISH
  268      PLANT(JUM+(VAL-LOC)&4095)
  269  %END
?V unused
  270  
  271  %ROUTINE SET JUMP(%INTEGER CASE)
  272  %INTEGER THOLD,VHOLD,FHOLD
  273      CASE = CASE+16_0800 %IF COND&6 = 0
  274      CASE = CASE+16_0400 %IF COND&1 # 0
  275      ALMAX = ALMAX+1;  !!%MONITOR 22 %IF ALMAX = LABMIN
  276      NEST(LOC);  NEST(ALMAX-DEFLIM+CASE)
  277      THOLD = TYPE;  VHOLD = VAL;  FHOLD = FLAG
  278      TYPE = LOCTYPE;  VAL = INTEGER(ALMAX);  FLAG = 0
  279      TYPE = TYPE+UMASK %IF PASS = 0
  280      COND = COND!!1
  281      PLANT JUMP;  COND = 0
  282      TYPE = THOLD;  VAL = VHOLD;  FLAG = FHOLD
  283  %END
  284  
  285  %ROUTINE PLANT INST(%INTEGER CODE)
  286      SET JUMP(16_1000) %IF COND # 0
  287      PLANT(CODE)
  288  %END
  289  
  290  %ROUTINE RELEASE
  291  %INTEGER I
  292      %RETURN %IF TYPE&REGXMASK = 0
  293      I = TYPE&15;  I = VAL %IF TYPE = REG
  294      %IF I = DREG %START
  295      DUSE = DUSE-1
  296      %finish %ELSE %START
  297      I = 1<<I
  298      FREE = FREE!I %IF TEMPS&I # 0
  299      %FINISH
  300  %END
  301  
  302  %INTEGERFN TREG
  303  %INTEGER I,J
  304      %IF DREG >= 0 %AND DUSE = 0 %START
  305      DUSE = 1
  306      %RESULT = DREG
  307      %FINISH
  308      J = 1
  309      %CYCLE I = 0,1,15
  310      ->OK %IF FREE&J # 0 %AND I # DREG
  311      J = J<<1
  312      %REPEAT
  313      FAULT('R')
  314  OK: FREE = FREE-J
  315      %RESULT = I
  316  %END
  317  
  318  %ROUTINE LOAD CONST(%INTEGER R)
  319  %INTEGER I,J
  320      I = LOADI+R<<8
  321      %IF VAL&(\255) = 0 %AND TYPE&UMASK = 0 %START
  322      PLANT INST(I+VAL)
  323      %finish %ELSE %IF \VAL&(\255) = 0 %AND TYPE&UMASK = 0 %START
  324      PLANT INST(I+(\VAL))
  325      PLANT INST(COMP+R<<4+R)
  326      CREG = R
  327      %finish %ELSE %START
  328  !       PLANT INST(LOADC+R<<8)
  329  !       PLANT INST(SKIP)
  330  !       PLANT VAL
  331      J = VAL>>8&255
  332      J = J+1 %IF VAL&128 # 0
  333      PLANT INST(I+J)
  334      PLANT INST(ROT+R<<8+7<<4+R)
  335      PLANT INST(ADDI+R<<8+VAL&255) %IF VAL&255 # 0
  336      %FINISH
  337  %END
  338  
  339  %ROUTINE LOAD REG(%INTEGER R)
  340  %INTEGER OP
  341      %IF ATYPE = TYPE %AND AVAL = VAL %START
  342      TYPE = REG;  VAL = ACC
  343      %RETURN %IF R = ACC
  344      %FINISH
  345      ATYPE = TYPE %AND AVAL = VAL %IF R = ACC
  346      ATYPE = -1 %IF (ATYPE=REG %AND AVAL=R)
  347      ATYPE = -1 %IF ATYPE&XMASK # 0 %AND ATYPE&15 = R
  348      %IF TYPE = REG %START
  349      PLANT INST(COPY+R<<4+VAL)
  350      CREG = R
  351      %finish %ELSE %IF TYPE&XMASK = 0 %START
  352      LOAD CONST(R)
  353         PLANT INST(LOAD+R<<8+R<<4) %IF TYPE&MEMMASK # 0
  354      %finish %ELSE %START
  355         %IF VAL&(\3) # 0 %OR TYPE&MEMMASK = 0 %START
  356            %IF TYPE&15 # R %START
  357               %IF |VAL| <= 127 %START
  358                  PLANT INST(COPY+R<<4+TYPE&15)
  359                  PLANT INST(ADDI+R<<8+VAL&255) %IF VAL # 0
  360               %finish %ELSE %START
  361                  LOAD CONST(R)
  362                  PLANT INST(ADD+R<<4+TYPE&15)
  363               %FINISH
  364               CREG = R
  365            %finish %ELSE %START
  366               %IF |VAL| <= 127 %START
  367                  %IF VAL # 0 %START
  368                     PLANT INST(ADDI+R<<8+VAL&255)
  369                     CREG = R
  370                  %FINISH
  371                  %finish %ELSE %START
  372                  OP = TREG
  373                  LOAD CONST(OP)
  374                  TYPE = REG;  VAL = OP
  375                  RELEASE
  376                  PLANT INST(ADD+R<<4+OP)
  377                  CREG = R
  378                  %FINISH
  379                  %FINISH
  380                  TYPE = TYPE&MEMMASK+XMASK+R;  VAL = 0
  381                  %FINISH
  382      %IF TYPE&MEMMASK # 0 %START
  383      PLANT INST(LOAD+R<<8+(TYPE&15)<<4+VAL)
  384      CREG = -1
  385  !   %FINISH  -- commenting out this line allows the program to compile
  386      %finish %ELSE %START
  387      LOAD CONST(R)
  388      PLANT INST(LOAD+R<<8+R<<4)
  389      %FINISH
  390      %FINISH
  391      TYPE = REG;  VAL = R
  392  %END
  393  
  394  %ROUTINE LOAD TEMP
  395      RELEASE
  396      LOAD REG(TREG)
  397  %END
  398  
  399  %ROUTINE SWOP
  400  %INTEGER K
  401      K = TYPE1;  TYPE1 = TYPE;  TYPE = K
  402      K = VAL1;  VAL1 = VAL;  VAL = K
  403  %END
  404  
  405      Q = QSTART
  406  NEW:NQ = QSTART;  FREE = TEMPS
  407      TYPE = INTEGER(Q);  Q = Q+1
  408      VAL = INTEGER(Q);  Q = Q+1
  409  
  410  GET:%CYCLE
  411        %RETURN %IF Q = QLIM
  412         K = INTEGER(Q);  Q = Q+1
  413         ->ASS(K) %IF K < 0
  414         INTEGER(NQ) = TYPE1;  INTEGER(NQ+1) = VAL1
  415         NQ = NQ+2
  416         TYPE1 = TYPE;  VAL1 = VAL
  417         TYPE = K;  VAL = INTEGER(Q);  Q = Q+1
  418      %REPEAT
  419  
  420  %PREDICATE TEMP
  421      %FALSE %IF TYPE1 # REG
  422      %IF VAL1 = DREG %START
  423      %FALSE %IF DUSE # 1
  424      %finish %ELSE %START
  425      %FALSE %IF 1<<VAL1&TEMPS = 0
  426      %FINISH
  427      %TRUE
  428  %END
  429  
  430  NOP: K = 0;                           !NOT SYMMETRIC
  431  BOP:%IF MODE <= 0 %OR (TYPE = 0 %AND TYPE1 = 0) %START
  432      FAULT('A') %IF TYPE # 0
  433      TYPE = TYPE1;  VAL = LITVAL
  434      %finish %ELSE %START
  435      %IF %NOT TEMP %OR (TYPE=REG %AND VAL=DREG %AND DUSE=1 %AND K#0) %START
  436      SWOP
  437      %IF K = 0 %OR %NOT TEMP %START
  438      LOAD TEMP;  SWOP
  439      %FINISH
  440      %FINISH
  441      %IF OP = AND %AND TYPE = 0 %AND VAL&(\255) = 0 %START
  442      PLANT INST(ANDI+VAL1<<8+VAL)
  443      %finish %ELSE %START
  444      LOAD TEMP %IF TYPE # REG
  445      RELEASE
  446      PLANT INST(OP+VAL1<<4+VAL)
  447      %FINISH
  448      TYPE = REG;  VAL = VAL1
  449      CREG = VAL
  450      ATYPE = -1 %IF ACC = VAL
  451      ATYPE = -1 %IF ATYPE&XMASK # 0 %AND ATYPE&15 = VAL
  452      ATYPE = -1 %IF ATYPE = REG %AND AVAL = VAL
  453      %FINISH
  454  
  455  POP:NQ = NQ-2
  456      TYPE1 = INTEGER(NQ);  VAL1 = INTEGER(NQ+1)
  457      ->GET
  458  
  459  ASS(-2):
  460      OP = SUB
  461      ->NOP %IF MODE > 0 %AND TYPE # 0
  462      TYPE1 = 0 %AND TYPE = 0 %IF MODE <= 0 %AND TYPE1 = TYPE
  463      VAL = -VAL
  464  ASS(-1):
  465      OP = ADD;  LITVAL = VAL1+VAL
  466      ->BOP %UNLESS TYPE = 0
  467      %IF TYPE1&MEMMASK # 0 %AND MODE > 0 %START
  468      SWOP;  LOAD TEMP;  SWOP
  469      %FINISH
  470      %IF TYPE1 = REG %AND %NOT TYPE=VAL=0 %START
  471      TYPE1 = XMASK+VAL1;  LITVAL = VAL
  472      %FINISH
  473      TYPE = TYPE1;  VAL = LITVAL
  474      ->POP
  475  ASS(-6):
  476      LITVAL = VAL1<<VAL;  K = (-1)<<VAL
  477      VAL = 16-VAL
  478      ->AS7
  479  ASS(-7):
  480      LITVAL = VAL1>>VAL;  K = (16_FFFF)>>VAL
  481  AS7:K=0 %AND ->BOP %IF MODE <= 0
  482      FAULT('I') %IF TYPE # 0 %OR VAL&(\15) # 0
  483      %IF %NOT TEMP %START
  484      SWOP;  LOAD TEMP;  SWOP
  485      %FINISH
  486      OP = ROT+VAL1<<8+VAL1
  487      PLANT INST(OP+16_0070) %IF VAL > 8
  488      PLANT INST(OP+(VAL-1)<<4) %IF VAL # 0
  489      TYPE = 0;  VAL = K;  K = -3
  490  ASS(-3):
  491      OP = AND;  LITVAL = VAL1&VAL
  492      ->BOP
  493  ASS(-4):
  494      OP = OR;  LITVAL = VAL1!VAL
  495      ->BOP
  496  ASS(-5):
  497      OP = XOR;  LITVAL = VAL1!!VAL
  498      ->BOP
  499  
  500  ASS(-8):                              !TYPE_VAL
  501      TYPE = VAL1
  502      TYPE = 0 %IF TYPE&OPMASK = MACRO; !SAFETY
  503      TYPE = 0 %IF TYPE&(OPMASK+FMASK) = FMASK
  504      ->POP
  505  
  506  ASS(-11):                             !COMPARE
  507      K = INTEGER(Q);  Q = Q+1
  508      %IF MODE <= 0 %START
  509      LITVAL = 2_01011000
  510      LITVAL = 2_01100100 %IF VAL < 0
  511      LITVAL = 2_10101000 %IF VAL1 > VAL
  512      K = LITVAL>>K&1;
  513      %finish %ELSE  %START
  514      %UNLESS K&6=4 %AND -256<VAL<0 %AND TYPE&XMASK#0 %START
  515      LOAD TEMP %IF TYPE # REG
  516      PLANT INST(COPY+VAL<<4+VAL) %IF CREG # VAL
  517      CREG = VAL
  518      %finish %ELSE  %START
  519      PLANT INST(SKIDI+(TYPE&15)<<8-VAL)
  520      K = K+4;                    !8,9
  521      %FINISH
  522      %FINISH
  523      COND = K
  524      ->GET
  525  
  526  ASS(-12):                             !TEST CC
  527      COND = VAL!!1
  528      ->GET
  529  
  530  ASS(-13):                             !AND
  531      %IF MODE > 0 %START
  532      SET JUMP(16_1000)
  533      %finish %ELSE  %START
  534      %RETURN %IF COND = 0
  535      %FINISH
  536      %RETURN %IF Q = QLIM
  537      ->NEW
  538  
  539  ASS(-14):                             !OR
  540      %IF MODE > 0 %START
  541      COND = COND!!1
  542      SET JUMP(16_3000)
  543      %finish %ELSE  %START
  544      %RETURN %IF COND # 0
  545      %FINISH
  546      ->NEW
  547  
  548  ASS(-15):                             !IF
  549      SET JUMP(16_2000)
  550      %RETURN
  551  
  552  ASS(-16):                             !ELSE
  553      COND = 1
  554      SET JUMP(16_4000)
  555      %RETURN
  556  
  557  ASS(-17):                             !IF AFTER ELSE
  558      SET JUMP(16_6000)
  559      %RETURN
  560  
  561  ASS(-18):                             !MACCALL IF
  562      SET JUMP(16_8000)
  563      %RETURN
  564  
  565  ASS(-20):                             !HASH
  566      TYPE = TYPE&(UMASK+63)
  567      ->GET
  568  
  569  ASS(-21):                             !INDEX
  570      FAULT('I') %IF TYPE1&REGXMASK # 0
  571      %IF TYPE&MEMMASK # 0 %START
  572      %IF MODE > 0 %THEN LOAD TEMP %ELSE FAULT('A')
  573      %FINISH
  574      %IF TYPE = REG %START
  575      TYPE = XMASK+VAL;  VAL = 0
  576      %FINISH
  577      FAULT('I') %IF TYPE1&TYPE&RELMASK # 0
  578      TYPE = TYPE1!TYPE!MEMMASK;  VAL = VAL1+VAL
  579      ->POP
  580  
  581  ASS(-22):                             !MINST SEPARATOR
  582      COMBINE
  583      ->POP
  584  
  585  ASS(-23):                             !PLANT INST
  586      MODE = 1
  587      PLANT INST(VAL)
  588      CREG = -1;  ATYPE = -1
  589      %RETURN
  590  
  591  ASS(-24):                             !LOAD
  592      LOAD TEMP %IF TYPE # REG
  593      Q = QBASE
  594      ->GET
  595  
  596  ASS(-25):                             !STORE (TYPE1,VAL1 -> TYPE,VAL)
  597      %IF TYPE = REG %START
  598      SWOP %AND LOAD REG(VAL1) %IF VAL1 # VAL
  599      %finish %ELSE  %START
  600      ATYPE = -1 %IF ATYPE&MEMMASK # 0
  601      %IF VAL1 = ACC %AND ATYPE < 0 %START
  602      K = TYPE&15
  603      ATYPE = TYPE %AND AVAL = VAL %IF TYPE&XMASK = 0 %OR 1<<K&TEMPS = 0
  604      %FINISH
  605      %IF TYPE&XMASK = 0 %OR VAL&(\3) # 0 %START
  606      TYPE = TYPE&(\MEMMASK)
  607      LOAD TEMP
  608      TYPE = MEMMASK+XMASK+VAL;  VAL = 0
  609      %FINISH
  610      PLANT INST(STORE+VAL1<<8+(TYPE&15)<<4+VAL)
  611      %FINISH
  612      %RETURN
  613  
  614  ASS(-26):                             !JUMP
  615      SET JUMP(16_1000) %IF INTEGER(NP)&16_F000 = 16_3000; !OR
  616      TYPE = TYPE!MEMMASK %IF TYPE # REG
  617      %IF TYPE&(\UMASK) = LOCTYPE %START
  618         PLANT JUMP
  619      %finish %ELSE  %START
  620      TYPE = XMASK+VAL %AND VAL=0 %IF TYPE = REG
  621      FAULT('I') %IF TYPE&XMASK = 0 %OR VAL&(\15) # 0
  622      %IF COND&8 # 0 %START
  623      PLANT(SKIP) %IF COND = 8
  624      COND = 1
  625      %FINISH
  626      PLANT(BOCR+COND<<8+(TYPE&15)<<4+VAL)
  627      %FINISH
  628      COND = 0
  629      %RETURN
  630  %END
?LOADC unused
  631  
  632  %ROUTINE GET SYM
  633      %CYCLE
  634      SYM = CHAR(GETPOS);  GETPOS = GETPOS+1
  635      %RETURN %IF SYM # ' '
  636      %REPEAT
  637  %END
  638  
  639  %PREDICATE S(%INTEGER K)
  640      %FALSE %UNLESS K = SYM
  641      GET SYM
  642      %TRUE
  643  %END
  644  
  645  %PREDICATE SS(%INTEGER K)
  646      %FALSE %UNLESS K = SYM = CHAR(GETPOS)
  647      GETPOS = GETPOS+1
  648      GET SYM
  649      %TRUE
  650  %END
  651  
  652  %PREDICATE TAG
  653  %INTEGER J,K
  654      %ROUTINE CODE SYM
  655      SYM = CHAR(GETPOS);  GETPOS = GETPOS+1
  656      K = SYM-'0'
  657      %IF K >= 0 %START
  658      TERM = -1 %AND %RETURN %IF K < 10
  659      K = SYM-'A'
  660      %RETURN %IF K >= 0 %AND K < 26 %AND TERM = 0
  661      %FINISH
  662      TERM = SYM
  663      %END
  664      %ROUTINE PACK TRIPLE
  665      ->T1 %IF TERM < 0
  666      J = ((K<<5+K)<<1+K)<<4+K+1111; !K*1073+1111
  667      CODE SYM
  668      ->T2 %IF TERM # 0
  669      J = (K<<3+K)<<2+K+111+J;       !J+K*37+111
  670      CODE SYM
  671      ->T3 %IF TERM # 0
  672      J = J+K+11
  673      CODE SYM
  674      %RETURN
  675  T1: J = ((K<<1+K)<<1+K)<<4-K+1;    !K*111+1
  676      CODE SYM
  677  T2: %RETURN %IF TERM > 0
  678      J = (K<<2+K)<<1+K+1+J;         !J+K*11+1
  679      CODE SYM
  680  T3: %RETURN %IF TERM > 0
  681      J = J+K+1
  682      CODE SYM
  683      %END
  684      K = SYM-'A'
  685      %FALSE %UNLESS K >= 0 %AND K < 26
  686      %FALSE %IF SYM = 'X' %AND CHAR(GETPOS)&128 # 0
  687      TERM = 0
  688      PACK TRIPLE
  689      TAG1 = J;  J = 0
  690      PACK TRIPLE %IF TERM <= 0
  691      TAG2 = J
  692      CODE SYM %WHILE TERM <= 0
  693      GET SYM %IF TERM = ' '
  694      %TRUE
  695  %END
  696  
  697  %PREDICATE TAGIF
  698      %FALSE %UNLESS SYM='I' %AND CHAR(GETPOS)='F' %AND CHAR(GETPOS+1)=' '
  699      GETPOS = GETPOS+2
  700      GET SYM
  701      %TRUE
  702  %END
  703  
  704  %ROUTINE LOOKUP(%INTEGER CONTROL)
  705  !ALL DICT OPERATIONS LOCALISED HERE
  706  !CONTROL = 0 (LOOKUP ONLY), 1 (FORWARD OK),
  707  !          2 (REDEF), 3 (DEF),
  708  !          4 (MACPARM), 7 (LABEL)
  709  %INTEGER DP
  710      DP = DEFMIN;  DP = MP+5 %IF CONTROL = 4
  711      %WHILE INTEGER(DP) # 0 %CYCLE
  712         ->YES %IF INTEGER(DP) = TAG1 %AND INTEGER(DP+1) = TAG2
  713         DP = DP+4
  714      %REPEAT
  715  !!%OWNINTEGER P
  716  !!    DP = DP-4
  717  !!REP:DP = DP+4
  718  !!    %LAC* DP; %OPR 640;!SNA; %JMP NO
  719  !!    %SAD TAG1; %OPR 512; %JMP REP
  720  !!    %LAC DP; %TAD #1; %DAC P
  721  !!    %LAC* P; %SAD TAG2; %JMP YES
  722  !!    ->REP
  723  NO:
  724      %RETURN %IF CONTROL&1 = 0;        !NO CREATION
  725  NEW:DEFMIN = DEFMIN-4;  DP = DEFMIN
  726      !!%MONITOR 21 %IF DP-QLIM <= 0
  727      INTEGER(DP) = TAG1;  INTEGER(DP+1) = TAG2
  728  SET:INTEGER(DP+2) = TYPE;  INTEGER(DP+3) = VAL
  729      %RETURN
  730  YES:->NEW %IF CONTROL = 3 %AND DP-INTEGER(BP) >= 0
  731      %IF CONTROL&2 = 0 %START;         !NOT DEF CLASS
  732      TYPE = INTEGER(DP+2);  VAL = INTEGER(DP+3)
  733      %RETURN %UNLESS TYPE&OPMASK = MACRO %AND CONTROL = 0
  734      %IF TYPE&31#25 %THEN INTEGER(DP+2)=TYPE+1 %ELSE INTEGER(DP+2) = TYPE+7
  735      %RETURN
  736      %FINISH
  737      FAULT('D') %IF CONTROL = 3
  738      ->SET %IF CONTROL # 7
  739      %IF INTEGER(DP+2)&(OPMASK+FMASK) = FMASK %START
  740      VAL = INTEGER(DP+3)
  741      %IF PASS = 0 %START
  742      INTEGER(VAL) = LOC
  743      %finish %ELSE  %START
  744      FAULT('P') %AND LOC=INTEGER(VAL) %IF INTEGER(VAL) # LOC
  745      %FINISH
  746      VAL = LOC
  747      %finish %ELSE  %START
  748      ->NEW %IF DP-INTEGER(BP) >= 0
  749      FAULT('D')
  750      %FINISH
  751      ->SET
  752  %END
?NO unused
  753  
  754  %ROUTINE QUEUE(%INTEGER K)
  755      INTEGER(QLIM) = K
  756      QLIM = QLIM+1;  !!%MONITOR 21 %IF QLIM = DEFMIN
  757  %END
  758  
  759  %ROUTINE GET EXP
  760  %OWNINTEGER W=24717
  761  %INTEGER I,NBASE
  762  
  763      NBASE = NP
  764      ->E3 %IF PEND # 0
  765  E1: NEST(0) %WHILE S('(')
  766      NEST(-20) %IF S('#')
  767      %IF TAG %START
  768  E3: %IF TAG1 = W %START;          !W
  769      TYPE = 0;  VAL = 0
  770      %finish %ELSE  %START
  771      %IF PEND >= 0 %START
  772      TYPE = LOCTYPE+FMASK+UMASK;  VAL = LABMIN-1
  773      LOOKUP(1)
  774      %IF TYPE&(OPMASK+FMASK) = FMASK %START
  775      %IF VAL = LABMIN-1 %START
  776      LABMIN = VAL;  !!%MONITOR 22 %IF LABMIN = ALMAX
  777      %FINISH
  778      VAL = INTEGER(VAL)
  779      FAULT('U') %IF VAL = 0
  780      TYPE = TYPE-FMASK
  781      %FINISH
  782      %FINISH
  783      %FINISH
  784      PEND = 0
  785      %IF TYPE = REG %AND TERM = '(' %START
  786      TYPE = 0 %IF SAVE&1 = 0;  VAL = VAL+SAVE;   !?
  787      %FINISH
  788      %IF MODE # 0 %START
  789      FAULT('I') %AND TYPE=0 %IF TYPE&OPMASK # 0
  790      %IF TYPE&REGXMASK # 0 %START
  791      I = TYPE&15;  I = VAL %IF I = 0
  792      DUSE = DUSE+1 %IF I = DREG
  793      %FINISH
  794      %FINISH
  795      %IF TERM = '(' %START
  796      GET SYM
  797      I = TYPE&31
  798      QUEUE(TYPE-I);  QUEUE(VAL)
  799      NEST(-21);  NEST(0)
  800      %IF I # 0 %START
  801      QUEUE(REG);  QUEUE(I&15)
  802      NEST(-1)
  803      %FINISH
  804      ->E1
  805      %FINISH
  806      %finish %ELSE  %IF '0' <= SYM <= '9' %START
  807      TYPE = 0;  VAL = SYM-'0'
  808      %CYCLE
  809      SYM = CHAR(GETPOS)-'0'
  810      %EXIT %UNLESS 0 <= SYM <= 9
  811      VAL = (VAL<<2+VAL)<<1+SYM
  812      GETPOS = GETPOS+1
  813      %REPEAT
  814      GET SYM
  815      %finish %ELSE  %IF SYM = 'X' %START
  816      TYPE = 0;  VAL = 0
  817      %CYCLE
  818      SYM = CHAR(GETPOS)-128
  819      %EXIT %IF SYM < 0
  820      SYM = SYM-32 %IF SYM >= 96; !ENSURE UPPER-CASE
  821      %IF '0' <= SYM <= '9' %OR 'A' <= SYM <= 'F' %START
  822      VAL = VAL<<4+SYM-'0'
  823      VAL = VAL-7 %IF SYM >= 'A'
  824      %finish %ELSE  FAULT('H')
  825      GETPOS = GETPOS+1
  826      %REPEAT
  827      GET SYM
  828      %finish %ELSE  %IF SYM&128 # 0 %START
  829      TYPE = 0;  VAL = SYM-128
  830      GET SYM
  831      %IF MODE >= 0 %AND SYM&128 # 0 %START
  832      VAL = VAL<<8+SYM-128;  GET SYM
  833      %FINISH
  834      %finish %ELSE  %IF S('.') %START
  835      ->ERR %IF %NOT TAG
  836      TYPE = 0;  VAL = TAG1
  837      %finish %ELSE  %IF S('*') %START
  838      TYPE = LOCTYPE&63;  VAL = LOC
  839      %IF SYM = 'L' %START;          !FOR NOW
  840      TYPE = 0;  VAL = LIST %IF TAG
  841      %FINISH
  842      %finish %ELSE  %IF SYM = '-' %START
  843      TYPE = 0;  VAL = 0
  844      %finish %ELSE  %IF SYM = '\' %START
  845      TYPE = 0;  VAL = \0
  846      %finish %ELSE  ->ERR
  847      QUEUE(TYPE);  QUEUE(VAL)
  848  
  849      %WHILE NP # NBASE %CYCLE
  850      %IF INTEGER(NP) < 0 %START
  851      QUEUE(INTEGER(NP))
  852      %finish %ELSE  %START
  853      %EXIT %IF %NOT S(')')
  854      %FINISH
  855      NP = NP+1
  856      %REPEAT
  857  
  858      NEST(-1) %AND ->E1 %IF S('+')
  859      NEST(-2) %AND ->E1 %IF S('-')
  860      NEST(-3) %AND ->E1 %IF S('&')
  861      NEST(-4) %AND ->E1 %IF S('!')
  862      NEST(-5) %AND ->E1 %IF S('\')
  863      NEST(-6) %AND ->E1 %IF SS('<')
  864      NEST(-7) %AND ->E1 %IF SS('>')
  865      NEST(-8) %AND ->E1 %IF S('_')
  866      %RETURN %IF NP = NBASE
  867  ERR:NP = NBASE
  868      !!%MONITOR 19
  869  %END
  870  
  871  %ROUTINE GET COND
  872  %OWNINTEGER AND=1717, OR=16873
  873  %INTEGER J,K
  874      TRANSF = QSTART;  QSTART = QLIM
  875      J = 0
  876      %CYCLE
  877      GET EXP
  878      %IF S('=') %START
  879      K = 5
  880      %finish %ELSE  %IF S('#') %START
  881      K = 4
  882      %finish %ELSE  %IF S('<') %START
  883      K = 3;  K = 7 %IF S('=')
  884      %finish %ELSE  %IF S('>') %START
  885      K = 6;  K = 2 %IF S('=')
  886      %finish %ELSE  %START
  887      QUEUE(-12)
  888      %RETURN
  889      %FINISH
  890      GET EXP
  891      QUEUE(-2);  !SUBTRACT
  892      QUEUE(-11);  QUEUE(K)
  893      %RETURN %IF %NOT TAG
  894      %IF TAG1 = AND %AND TAG2 = 0 %START
  895      !!%MONITOR 19 %IF J < 0
  896      J = 1;  QUEUE(-13)
  897      %finish %ELSE  %START
  898      !!%MONITOR 19 %IF TAG1 # OR %OR J > 0
  899      J = -1;  QUEUE(-14)
  900      %FINISH
  901      %REPEAT
  902  %END
?OR unused
  903  
  904  %ROUTINE GET INST
  905  %INTEGER I
  906      QUEUE(TYPE);  QUEUE(VAL)
  907      %RETURN %IF TERM # ' ';           !NO OPERAND FOLLOWING =>
  908      %CYCLE
  909      GET EXP
  910      QUEUE(-22)
  911      %RETURN %IF %NOT S(',')
  912      %REPEAT
  913  %END
?I unused
  914  
  915  %ROUTINE READ LINE
  916  %INTEGER Q
  917      PUTPOS = STARTPOS
  918      %IF MP = 0 %START
  919      Q = 0;  PSEUDOLIM = 0
  920      %CYCLE
  921      READ SYMBOL(SYM)
  922      READ SYMBOL(SYM) %AND Q=Q!!128 %IF SYM = ''''
  923      %EXIT %IF SYM = NL
  924      SYM = SYM-32 %IF SYM-Q >= 96; !LOWER-CASE -> UPPER-CASE
  925      SYM = SYM+Q
  926      %EXIT %IF SYM = '/' %AND PSEUDOLIM # 0
  927      %IF SYM = ' ' %START
  928      PSEUDOLIM = PUTPOS %IF PSEUDOLIM = 0
  929      %finish %ELSE  PSEUDOLIM = 0
  930      PUT CHAR(SYM)
  931      %REPEAT
  932      %IF PSEUDOLIM # 0 %START
  933      Q = PUTPOS;  PUTPOS = PSEUDOLIM
  934      PUT CHAR(NL)
  935      PUTPOS = Q
  936      %FINISH
  937      %CYCLE
  938      PUT CHAR(SYM)
  939      %EXIT %IF SYM = NL
  940      READ SYMBOL(SYM)
  941      %REPEAT
  942      PRINTPOS = STARTPOS
  943      %finish %ELSE  %START
  944      GETPOS = INTEGER(MP)
  945      %IF CHAR(GETPOS) = 0 %START
  946      QBASE = MP
  947      %IF INTEGER(MP+1)&16_8000 # 0 %START
  948      %WHILE INTEGER(NP)&16_8000 = 0 %CYCLE
  949      FAULT('C');  NP = NP+2
  950      %REPEAT
  951      SET LAB(LOC)
  952      %FINISH
  953      GETPOS = INTEGER(MP+2)
  954      STARTPOS = INTEGER(MP+3)
  955      MP = INTEGER(MP+4)
  956      PRINTPOS = 0 %IF LIST&2 # 0
  957      GET SYM;                    !TERMINATOR
  958      GET SYM %IF SYM = ';'
  959      %RETURN
  960      %FINISH
  961      PRINTPOS = STARTPOS %IF LIST&2 # 0
  962      %CYCLE
  963      SYM = CHAR(GETPOS);  GETPOS = GETPOS+1
  964      %IF TAG %START
  965      SYM=TERM %AND GETPOS=GETPOS-1 %IF TERM = ' '
  966      TYPE = INTEGER(MP);  VAL = GETPOS-1
  967      LOOKUP(4)
  968      %WHILE TYPE # VAL %CYCLE
  969      PUT CHAR(CHAR(TYPE))
  970      TYPE = TYPE+1
  971      %REPEAT
  972      %FINISH
  973      %IF SYM = '?' %START
  974      PUT CHAR(INTEGER(MP+1)>>5&31+'A')
  975      SYM = INTEGER(MP+1)&31+'A'
  976      %FINISH
  977      PUT CHAR(SYM)
  978      INTEGER(MP) = GETPOS
  979      %EXIT %IF SYM = NL
  980      %REPEAT
  981      %FINISH
  982      QBASE = (PUTPOS+1)>>1
  983      GETPOS = STARTPOS;  GET SYM
  984  %END
  985  
  986  %ROUTINE SCAN ARG
  987  !    SET TYPE,VAL TO START,LIM OF ARG IF NOT NULL
  988  %INTEGER I,J
  989      %RETURN %IF SYM='I' %AND CHAR(GETPOS)='F' %AND CHAR(GETPOS+1)=' '
  990      I = GETPOS-1;  I = GETPOS %IF SYM = '['
  991      J = 0
  992      %CYCLE
  993      %EXIT %IF SYM = NL
  994      %EXIT %IF (SYM=' ' %OR SYM=',' %OR SYM=';') %AND J<=0
  995      J = J+1 %IF SYM = '['
  996      %IF SYM = ']' %START
  997      J = J-1;  %EXIT %IF J = 0
  998      %FINISH
  999      SYM = CHAR(GETPOS);  GETPOS = GETPOS+1
 1000      %REPEAT
 1001      %IF GETPOS-1 # I %START
 1002      TYPE = I;  VAL = GETPOS-1
 1003      %FINISH
 1004      GET SYM %IF SYM = ']'
 1005  %END
 1006  
 1007  %ROUTINE SET ACC
 1008  %INTEGER I
 1009      ACC = -1;  ATYPE = -1;  CREG = -1
 1010      I = TEMPS
 1011      %RETURN %IF I = 0
 1012      %CYCLE
 1013      ACC = ACC+1
 1014      %RETURN %IF I&1 # 0
 1015      I = I>>1
 1016      %REPEAT
 1017  %END
 1018  
 1019  !MAIN PROGRAM
 1020  
 1021  !RADIX 36 CONSTANTS
 1022  %OWNINTEGER B=2184, IF=9991, ELS=5950, E=5403, FIN=6907, ISH=10490
 1023  %OWNINTEGER JUM=11642, P=17206, PS=17983, DEF=4605, END=6009
 1024  
 1025  %INTEGER I,J,K
 1026  !!%FAULT 19 ->ERR;                      !RECOGNITION ERROR
 1027  !!%FAULT 9 ->BEND;                      !INPUT ENDED
 1028  
 1029      %CYCLE I = 1,1,SBOUND
 1030      STORE(I) = 0
 1031      %REPEAT
 1032      CODEPOS = ADDR(STORE(1))
 1033      MACLIM = (CODEPOS+20)<<1
 1034      STORELIM = ADDR(STORE(SBOUND))
 1035      NP = STORELIM
 1036      LABLIM = NP-60
 1037      BP = LABLIM
 1038      DEFLIM = STORELIM-(SBOUND>>2)
 1039      DEFMIN = DEFLIM
 1040      INTEGER(BP) = DEFLIM
 1041      SELECT INPUT(PRE)
 1042  DO PASS:
 1043      PUT WORD(0) %AND CONTROL=16_20 %IF PASS > 0
 1044      STARTPOS = MACLIM
 1045      MP = 0
 1046      ALMAX = DEFLIM
 1047      LABMIN = LABLIM
 1048      ASSCOND = 1;  SKIP = 0
 1049      LOCTYPE = MEMMASK+RELMASK;  LOC = 0
 1050      SET ACC
 1051  READ: FSYM = ' ';  FAULTPOS = 0
 1052      READ LINE
 1053  NEXT:
 1054      DREG = -1
 1055      MODE = 0
 1056      PEND = 0;  COND = 0
 1057      QSTART = QBASE;  QLIM = QSTART
 1058      FLAG = 0
 1059      %IF S('$') %START
 1060      ->NEWPAGE %IF SYM = '/'
 1061      ->ERR %IF %NOT TAG
 1062      ->ASSIF %IF TAG1 = IF
 1063      ->ASSELSE %IF TAG1 = ELS
 1064      ->ASSFIN %IF TAG1 = FIN
 1065      ->LEND %IF SKIP # 0
 1066      ->DEFINE %IF TAG1 = DEF
 1067      ->DEFINE %IF TAG1 = 19625;     !RED
 1068      ->LISTC %IF TAG1 = 13350;      !LIS
 1069      ->TEMP %IF TAG1 = 21780;       !TEM
 1070      ->LOCC %IF TAG1 = 13556;       !LOC
 1071      ->LOCC %IF TAG1 = 1917;        !ASS
 1072      ->SAVC %IF TAG1 = 20568;       !SAV
 1073      ->MACDEF %IF TAG1 = 14111;     !MAC
 1074      ->BEGIN %IF TAG1 = 2460;       !BEG
 1075      ->BEND %IF TAG1 = END
 1076      FAULT('U')
 1077      ->LEND
 1078      %FINISH
 1079      ->LEND %IF SKIP # 0 %OR SYM = '/'
 1080      %IF SYM = NL %START
 1081      ->LEND %IF LINES < 54
 1082      DO NEWLINE %WHILE LINES # 0
 1083      ->READ
 1084      %FINISH
 1085      %IF TAG %START
 1086      ->LABDEF %IF TERM = ':'
 1087      MODE = 1
 1088      ->ASSIGN %IF TERM = '(' %OR SYM = '='
 1089      ->JUMP %IF TAG1 = JUM %AND (TAG2=P %OR TAG2=PS)
 1090      ->IFC %IF TAG1 = IF
 1091      ->ELSE %IF TAG1 = ELS %AND TAG2 = E
 1092      ->FINISH %IF TAG1 = FIN %AND TAG2 = ISH
 1093      ->WHILE %IF TAG1 = 25106 %AND TAG2 = 13173
 1094      ->CYCLE %IF TAG1 = 4269 %AND TAG2 = 13173
 1095      ->REPEAT %IF TAG1 = 19637 %AND TAG2 = 5544
 1096      MODE=-2 %AND ->DATA %IF TAG1 = B
 1097      TYPE = UMASK;  LOOKUP(0)
 1098      ->MACCALL %IF TYPE&OPMASK = MACRO
 1099      ->MINST %IF TYPE&OPMASK # 0
 1100      FAULT('U') %AND ->LEND %IF TYPE&UMASK # 0
 1101      PEND = -1
 1102      %FINISH
 1103      MODE = -1
 1104  DATA:
 1105      %CYCLE
 1106      GET EXP;  ASSEMBLE
 1107      FAULT('I') %IF TYPE&REGXMASK # 0
 1108      I = 1
 1109      %IF S('$') %START
 1110      I = VAL %IF VAL < 1000
 1111      QLIM = QSTART
 1112      GET EXP;  ASSEMBLE
 1113      %FINISH
 1114      %WHILE I > 0 %CYCLE
 1115      %IF MODE # -1 %START
 1116      FAULT('T') %IF VAL&16_FF00 # 0
 1117      %IF MODE = -2 %START
 1118      J = VAL<<8;  MODE = -3
 1119      %finish %ELSE  %START
 1120      VAL = VAL+J;  MODE = -2
 1121      PLANT VAL
 1122      %FINISH
 1123      %finish %ELSE  %START
 1124      PLANT VAL;  VAL = VAL&255
 1125      %FINISH
 1126      I = I-1
 1127      %REPEAT
 1128      %EXIT %UNLESS S(',') %OR SYM&128 # 0
 1129      %IF SYM = NL %START
 1130      PRINT LINE %IF PRINTPOS # 0;  READ LINE
 1131      QSTART = QBASE
 1132      %FINISH
 1133      QLIM = QSTART
 1134      %REPEAT
 1135      VAL=J %AND PLANT VAL %IF MODE = -3
 1136      ->SEND
 1137  
 1138  LABDEF:
 1139      CREG = -1;  ATYPE = -1
 1140      GET SYM
 1141      FAULT('C') %AND NP=STORELIM %IF NP # STORELIM
 1142      TYPE = LOCTYPE;  VAL = LOC
 1143      LOOKUP(7)
 1144      ->NEXT
 1145  
 1146  ASSIGN:
 1147      PEND = 1
 1148      GET EXP
 1149      ->ERR %IF %NOT S('=')
 1150      QUEUE(-25);                       !'STORE'
 1151      %IF INTEGER(QBASE) = REG %START
 1152      DREG = INTEGER(QBASE+1)
 1153      DUSE = 0
 1154      %FINISH
 1155      QSTART = QLIM;  MODE = 2
 1156      GET EXP
 1157      QUEUE(-24);                       !'LOAD'
 1158  
 1159  CONDQ:
 1160      %IF TAGIF %START
 1161      MODE = MODE+4;  DREG = DREG-16; !SCARIFY
 1162      GET COND;  ASSEMBLE
 1163      MODE = MODE-4;  DREG = DREG+16; !RESTORE
 1164      QLIM = QSTART;  QSTART = TRANSF
 1165      %FINISH
 1166      ASSEMBLE
 1167      ->SEND
 1168  
 1169  JUMP:
 1170      FLAG = TAG2-P;                    !POSITIVE IF SHORT
 1171      GET EXP
 1172      QUEUE(-26);                       !'JUMP'
 1173      ->CONDQ
 1174  
 1175  MINST:
 1176      MODE = -1
 1177      GET INST
 1178      QUEUE(-23);                       !'PLANT'
 1179      ->CONDQ
 1180  
 1181  MACCALL:
 1182      QUEUE(VAL);                       !DEFPOS
 1183      QUEUE(TYPE&1023);                 !JOKER
 1184      QUEUE(0);                         !(CALLPOS)
 1185      QUEUE(STARTPOS)
 1186      QUEUE(MP)
 1187      %CYCLE
 1188      %EXIT %IF CHAR(INTEGER(QBASE)) = NL; !END OF MAC DEF
 1189      I = GETPOS-1;                  !SAVE CALLPOS
 1190      GETPOS = INTEGER(QBASE);  GET SYM
 1191      !!%MONITOR 24 %IF %NOT TAG
 1192      TYPE = 0;  VAL = 0
 1193      SCAN ARG
 1194      GET SYM %IF SYM = ','
 1195      INTEGER(QBASE) = GETPOS-1;        !UPDATE DEFPOS
 1196      GETPOS = I;  GET SYM;             !RESTORE CALLPOS
 1197      SCAN ARG
 1198      GET SYM %IF SYM = ','
 1199      QUEUE(TAG1);  QUEUE(TAG2)
 1200      QUEUE(TYPE);  QUEUE(VAL)
 1201      %REPEAT
 1202      GET SYM %IF SYM = ' '
 1203      %IF TAGIF %START
 1204      GET COND; QUEUE(-18); ASSEMBLE
 1205      QLIM = QSTART
 1206      INTEGER(QBASE+1) = INTEGER(QBASE+1)+16_8000
 1207      %FINISH
 1208      QUEUE(0)
 1209      MP = QBASE; STARTPOS = QLIM<<1
 1210      INTEGER(MP) = INTEGER(MP)+1
 1211      INTEGER(MP+2) = GETPOS-1
 1212      PRINT LINE %IF PRINTPOS # 0 %AND LIST&2 # 0
 1213      ->READ
 1214  
 1215  !CODING OF JUMPS: 1000 (SINGLE INST), 2000 (MAIN IF)
 1216  !                 4000 (ELSE), 6000 (IF AFTER ELSE)
 1217  
 1218  IFC:
 1219      GET COND;  QUEUE(-15);  ASSEMBLE
 1220      ->SEND
 1221  
 1222  ELSE:
 1223      ->CERR %IF INTEGER(NP)&16_2000 = 0
 1224      QUEUE(0);  QUEUE(0)
 1225      QUEUE(-16);  ASSEMBLE
 1226      ATYPE = -1; CREG = -1
 1227      %IF TAGIF %START
 1228      GET COND;  QUEUE(-17);  ASSEMBLE
 1229      %FINISH
 1230      ->SEND
 1231  
 1232  FINISH:
 1233      ->CERR %IF INTEGER(NP)&16_6000 = 0
 1234      I = LOC
 1235      %WHILE INTEGER(NP)&16_4000 # 0 %CYCLE
 1236      %IF INTEGER(NP)&16_2000 # 0 %START; !IF AFTER ELSE
 1237      SET LAB(I)
 1238      %finish %ELSE  %START
 1239      SET LAB(LOC)
 1240      I = VAL+1
 1241      %FINISH
 1242      %REPEAT
 1243      SET LAB(I)
 1244      ->SEND
 1245  
 1246  WHILE:
 1247      I = LOC;  ATYPE = -1;  CREG = -1
 1248      GET COND;  QUEUE(-13); ASSEMBLE
 1249      NEST(I);  NEST(1)
 1250      ->SEND
 1251  
 1252  CYCLE:
 1253      NEST(LOC);  NEST(1)
 1254      ->SEND
 1255  
 1256  REPEAT:
 1257      ->CERR %IF INTEGER(NP) # 1
 1258      QUEUE(LOCTYPE);  QUEUE(INTEGER(NP+1))
 1259      NP = NP+2
 1260      QUEUE(-26);                       !'JUMP'
 1261      FLAG = -1
 1262      ->CONDQ
 1263  
 1264  CERR:
 1265      FAULT('C')
 1266      ->LEND
 1267  
 1268  SEND:
 1269      SET LAB(LOC) %IF INTEGER(NP)&16_1000 # 0
 1270      ->LEND %IF SYM = NL
 1271      ->NEXT %IF S(';')
 1272  
 1273  ERR:FSYM = 'F';  FAULTPOS = GETPOS-1
 1274      PRINTPOS = STARTPOS
 1275  
 1276  LEND:
 1277      ->READ %IF SKIP # 0 %AND LIST&4 = 0
 1278      ->READ %IF FSYM = ' ' %AND CHARS = 0 %AND %C
 1279+      (PRINTPOS = 0 %OR (MP#0 %AND LIST&2=0))
 1280      PRINT LINE
 1281      ->READ
 1282  
 1283  ASSIF:
 1284      ASSCOND = ASSCOND<<1
 1285      ->LEND %IF SKIP # 0
 1286  A1: GET COND; ASSEMBLE
 1287      SKIP = ASSCOND %IF COND # 0
 1288      PRINT LINE %IF PRINTPOS # 0
 1289      ->LEND
 1290  
 1291  ASSELSE:
 1292      %IF SKIP = 0 %START
 1293      ->CERR %IF ASSCOND&1 # 0
 1294      SKIP = ASSCOND
 1295      %finish %ELSE  %START
 1296      ->LEND %IF SKIP # ASSCOND
 1297      SKIP = 0
 1298      ->A1 %IF TAGIF
 1299      %FINISH
 1300      ASSCOND = ASSCOND+1
 1301      ->LEND
 1302  
 1303  ASSFIN:
 1304      ->CERR %IF ASSCOND = 1
 1305      ASSCOND = ASSCOND>>1
 1306      SKIP = 0 %IF SKIP>>1 = ASSCOND
 1307      ->LEND
 1308  
 1309  DEFINE:
 1310      FAULT('C') %IF NP # STORELIM
 1311      I = TAG1
 1312      %CYCLE
 1313      ->ERR %IF %NOT (TAG %AND S('='))
 1314      J = TAG1;  K = TAG2
 1315      %IF TAG %START
 1316      TYPE = UMASK;  LOOKUP(0)
 1317      %IF TYPE&OPMASK # 0 %START
 1318      GET INST
 1319      %finish %ELSE  %START
 1320      PEND = -1;  GET EXP
 1321      %FINISH
 1322      %finish %ELSE  GET EXP
 1323      ASSEMBLE
 1324      TAG1 = J;  TAG2 = K
 1325      %IF I=DEF %THEN LOOKUP(3) %ELSE LOOKUP(2)
 1326      %EXIT %UNLESS S(',')
 1327      QLIM = QSTART
 1328      %REPEAT
 1329      ->SEND
 1330  
 1331  NEWPAGE:
 1332      DO NEWLINE %WHILE LINES # 0
 1333      ->LEND
 1334  
 1335  LISTC:
 1336      GET EXP;  ASSEMBLE
 1337      LIST = VAL
 1338      ->SEND
 1339  
 1340  TEMP:
 1341      I = 0
 1342      %IF SYM # NL %START
 1343      %CYCLE
 1344      GET EXP
 1345      FAULT('I') %IF TYPE # REG
 1346      I = I!1<<VAL
 1347      %EXIT %UNLESS S(',')
 1348      %REPEAT
 1349      %FINISH
 1350      TEMPS = I
 1351      SET ACC
 1352      ->SEND
 1353  
 1354  LOCC:
 1355      I = TAG1
 1356      GET EXP;  ASSEMBLE
 1357      %IF TYPE&16_FF9F = 0 %START
 1358      LOCTYPE = TYPE&RELMASK+MEMMASK;  LOC = VAL
 1359      PUT WORD(VAL-1) %AND CONTROL=16_30 %IF PASS > 0
 1360      %finish %ELSE  FAULT('I')
 1361      ->SEND
 1362  
 1363  SAVC:
 1364      GET EXP;  ASSEMBLE
 1365      SAVE = VAL
 1366      ->SEND
 1367  
 1368  MACDEF:
 1369      ->CERR %IF MP # 0
 1370      ->ERR %IF %NOT TAG
 1371      J = TAG1;  K = TAG2
 1372      I = GETPOS-1
 1373      %IF SYM # NL %START
 1374      %CYCLE
 1375      ->ERR %IF %NOT TAG
 1376      SCAN ARG
 1377      %EXIT %IF %NOT S(',')
 1378      %REPEAT
 1379      %FINISH
 1380      ->ERR %IF SYM # NL
 1381      TAG1 = J;  TAG2 = K
 1382      TYPE = MACRO;  VAL = I
 1383      LOOKUP(3)
 1384      %CYCLE
 1385      PRINT LINE
 1386      %EXIT %IF S('$') %AND TAG %AND TAG1 = END
 1387      STARTPOS = PUTPOS
 1388      STARTPOS = PSEUDOLIM+1 %IF PSEUDOLIM # 0
 1389      READ LINE
 1390      %REPEAT
 1391      PUTPOS = STARTPOS;  PUT CHAR(0)
 1392      STARTPOS = PUTPOS
 1393      MACLIM = STARTPOS
 1394      ->LEND
 1395  
 1396  %ROUTINE BNEST
 1397      BP = BP+4;  !!%MONITOR 23 %IF BP-NP >= 0
 1398      INTEGER(BP-3) = SAVE;  INTEGER(BP-2) = TEMPS
 1399      INTEGER(BP-1) = MACLIM;  INTEGER(BP) = DEFMIN
 1400  %END
 1401  
 1402  BEGIN:
 1403      BNEST
 1404      ->NEWPAGE %IF SYM # NL
 1405      ->LEND
 1406  
 1407  BEND:
 1408      FAULT('C') %IF NP # STORELIM %OR MP # 0
 1409      MP = 0;  NP = STORELIM
 1410      %IF BP # LABLIM %START
 1411      SAVE = INTEGER(BP-3);  TEMPS = INTEGER(BP-2)
 1412      MACLIM = INTEGER(BP-1);  STARTPOS = MACLIM
 1413      DEFMIN = INTEGER(BP)
 1414      SET ACC
 1415      BP = BP-4
 1416      ->LEND %IF BP # LABLIM
 1417      %FINISH
 1418      CLOSE INPUT;  SELECT INPUT(MAIN)
 1419      BNEST
 1420      LIST = 5
 1421      PASS = PASS+1
 1422      ->DO PASS %IF PASS # 2
 1423  
 1424      PUT WORD(CHECK!!16_0100);  CONTROL = 16_30
 1425      PUT WORD(16_0100)
 1426      SELECT OUTPUT(BIN);  PRINT CH(16_60);  SELECT OUTPUT(LIS)
 1427      FAULT('$')
 1428      PRINT LOC;  PRINT LINE
 1429      LINES = 60 %IF OUTDEV = 1
 1430      DO NEWLINE %WHILE LINES # 0
 1431  
 1432  %ENDOFPROGRAM
?RELUXMASK unused

 1419 Statements compiled
