%ROUTINE  CSS
%ROUTINE %SPEC  CCOND
%ROUTINE %SPEC  CUI
%ROUTINE %SPEC  CSEXP (%INTEGER  Z)
%ROUTINE %SPEC MOVEM(%INTEGER Q,N)
%ROUTINE %SPEC  CNAME (%INTEGER  Z)
%ROUTINE %SPEC  FIND LABEL
%ROUTINE %SPEC  PUSHDOWN 2 (%INTEGER %NAME  CELL,%INTEGER  S1,S2)
%ROUTINE %SPEC  STORE TAG (%INTEGER  KK)
%ROUTINE %SPEC  COPY TAG (%INTEGER  KK)
%ROUTINE %SPEC  FROM LIST 2 (%INTEGER %NAME  CELL,S1,S2)
%ROUTINE %SPEC  POPUP 2 (%INTEGER %NAME  CELL,S1,S2)
%ROUTINE %SPEC  NEWCELL (%INTEGER %NAME  STAD)
%ROUTINE %SPEC  INSERT AFTER 2 (%INTEGER %NAME  STAD, %INTEGER  S1,S2)
%ROUTINE %SPEC  REPLACE TAG (%INTEGER  KK)
%ROUTINE %SPEC  LINK (%INTEGER %NAME  STAD)
%ROUTINE %SPEC  RETURN CELL (%INTEGER %NAME  STAD)
%ROUTINE %SPEC  MORE SPACE
%ROUTINE %SPEC  STORE JUMP
%ROUTINE %SPEC  STORE NAME

%ROUTINE %SPEC  TESTNST
%ROUTINE %SPEC  FAULT (%INTEGER  N)
%ROUTINE %SPEC  CMOD (%INTEGER  N,Z)
%ROUTINE %SPEC  CUCI
%ROUTINE %SPEC  PPJ(%INTEGER I,J,K)
%ROUTINE %SPEC  PJ(%INTEGER  A,S,B)
%ROUTINE %SPEC  PSET(%INTEGER  N)
%ROUTINE %SPEC  PQ(%INTEGER  A,Q,QQ)
%ROUTINE %SPEC  PSH (%INTEGER  A,N)
%ROUTINE %SPEC  PN (%INTEGER  A)
%ROUTINE %SPEC  PMS(%INTEGER  A,M,Q)
%ROUTINE %SPEC  FILL LABEL (%INTEGER  AT, EQUALS)
%ROUTINE %SPEC  FILL SET (%INTEGER  AT, EQUALS)
%ROUTINE %SPEC  PRINT NAME (%INTEGER  I)
%ROUTINE %SPEC  SKIP EXP

%SWITCH  SW(1:34), RFPD (1:8), RT(6:10),END(0:10)
%INTEGER  I,J,K,P,TYPE,Q,KK,KKK,QQ,JJ,JJJ,TYPE',F NAME
%ROUTINE %SPEC  CRSPEC (%INTEGER  M)
-> SW(A(1))

SW(1):  %COMMENT  [UI] [S]
        *JS3
        %IF  A(MARKER 2) = 2 %THEN  -> 90
        P = 2
        CUI
        ->1

3:      %IF  OVERFLAG = 0 %OR LFLAG=1  %THEN  -> 6
                PSET(LINE)
                PQ(120,2,4)

6:      *EXIT 1

SW(2):  %COMMENT  [%CYCLE ]
        *JS3
        P = 2
        CNAME(3)
        %UNLESS  TYPE = 2 %THEN  FAULT (25)
        PMS(1,N,LEVEL)
        CSEXP(2); ->5145 %UNLESS  MC SWITCH =0
        PN(34)
5145:   CSEXP(2)
        PN(34)
        PMS(1,N+1,LEVEL);->5146 %UNLESS MC SWITCH =0
        PN(34)
5146:   CSEXP(2); ->5147 %UNLESS MC SWITCH =0
        PN(34)
        PN(54)
5147:   PN(46)
        PMS(1,N+2,LEVEL)
        ->5148 %UNLESS MC SWITCH=0
        PJ(8,SL(5),13)
5148:   PMS(0,N,LEVEL)
        PQ(120,13,2)
        PUSHDOWN 2(CYCLE(LEVEL),CA,N)
                PQ(65,13,0)
        N = N + 3; M10=0; M13=0
        -> 1

SW(3):  %COMMENT  [%REPEAT ] [S]
        POPUP 2 (CYCLE(LEVEL),J,K)
        %IF  J = -1 %THEN  FAULT(1)
                PMS(0,K,LEVEL)
                PQ(120,13,2)
                PQ(64,13,0)
                PMS(0,K+1,LEVEL)
                PN(46)
                PMS(0,K+2,LEVEL)
                PJ(8,J,1)
                PN(42); M13=0
        -> 1

SW(4):  %COMMENT  [N] [:]
        K = A(2); M10=0; M13=0
        FIND LABEL
        %IF  J = -1 %THEN  -> 2
        FAULT (2)
        -> 1
2:      PUSHDOWN 2(LABEL(LEVEL),CA,K)
        -> 1

SW(5):  %COMMENT  [%IU ] [SC][REST OF COND] [%THEN ] [UI] [S]
        *JS3
        Q = 2
        -> 4

SW(6):  %COMMENT [!][TEXT][S]
        -> 1

90: %COMMENT  [UI][SET MARKER 2][REST OF SS1][%IU ][SC][REST OF COND] [S]
        Q = MARKER 2 + 1
4:      P = Q+1
        CCOND
        %IF A(1)=1 %THEN P=2
        ->1234 %UNLESS A(P)=2
        K = A(P+1)
        STORE JUMP
                PJ(10-A(Q),0,6)
        ->1
1234:   PLABEL = PLABEL -1
        K = PLABEL
        STORE JUMP
                PJ(7+A(Q),0,6)
        Q = PLABEL
        CUI; M10=0; M13=0
        PUSHDOWN 2(LABEL(LEVEL),CA,Q)
        -> 1

SW(7):  %COMMENT  [TYPE] [NAME] [REST OF NAME LIST] [S]
        TYPE = 3-A(2)
        J = 0
        P = 2
        PN(33) %IF DIAGS=1
5:      K = A(P+1)
        TESTNST
        STORE TAG (K)
        STORE NAME
        PN(34)%IF DIAGS=1
        PMS(1,N,LE VEL) %IF DIAGS=1
        N = N+1
        P = P+2
        %IF  A(P) = 1 %THEN  -> 5
        PN(42) %IF DIAGS=1
        -> 1

SW(8):  %COMMENT  [%END ] [S]
        *JS3;M10=0; M13=0
        KKK = FLAG(LEVEL)
8401:   POPUP2(ARRDIM(LEVEL),JJ,KK)
        ->50 %IF JJ=-1
        COPYTAG(KK)
        FILL SET(JJ,J);   ! FILL IN ARRAY DIM
         ->8401
50:     %COMMENT  COMPLETE LABELS JUMPS
        *JS2701
        *ZERO; *NOT; **=A(2)
        **L(LEVEL); **=A(3)
        A(4)=M(LEVEL); A(5)=LEVEL; KK=5
56:     %COMMENT  CLEAR THE DECS
        POPUP 2(NAME(LEVEL),J,K)
        %IF  J = -1 %THEN  -> 857
        JJ = K; FNAME = JJ
        COPYTAG (K)
        POPUP 2(TAGS(JJ),I,I)
        %IF TYPE=2 %THEN ->811
        %IF TYPE =1 %THEN ->810
        %IF  J = 15 %AND LEVEL #1 %THEN  FAULT(28)
        -> 56 %UNLESS  6 <= TYPE <= 10
        JJ = K
58:     POPUP 2 (ST(JJ),J,K)
        %IF  J # -1 %THEN  -> 58
        RETURN CELL (JJ)
        -> 56

810:    *ZERO; *NOT; *SHL32; ->812
811:    *ZERO
812:    **JJ; *SHL16; **K; *OR; *OR
        KK=KK+1; **=A(KK); ->56
820:    KK=2; A(2)=-1
857:    ->838 %IF DIAGS=0 %OR FAULTY=1
        A(KK+1)=-1
        *E419; *=C15; **@A(2)
        *DUP; *=I15; *SET99; *+
        *=M15; *POAQ15
838:    %IF KK=2 %THEN ->1
        %COMMENT  CHECK %CYCLE  - %REPEAT 
        POPUP 2(CYCLE(LEVEL),J,K)
        %IF  J = -1 %THEN  -> 59
        FAULT(13)
        -> 857

59:     %COMMENT  PLANT ALLOCATION NEST UP INSTRUCTIONS
        %IF  KKK = 1 %THEN          PJ(8,SL(6),11)
        %IF  10 >= KKK>= 7 %THEN      PJ(8,SL(11),11)
        FILL SET (SET(LEVEL),N)
        %IF  0#KKK#6 %THEN  -> 60
                PQ(105,LEVEL,12)
                PQ(64,12,0)
                PQ(120,LEVEL,2)
                PPJ(8,67,13) %IF DIAGS=1
        %IF  KKK =6 %THEN           PJ(8,SL(4),11)
60:     %IF  KKK = 2 %THEN  ->820
        %IF LFLAG=1 %THEN ->4011
        %IF LISTFLAG = 1 %THEN ->401
         WRITE (LINE,5); SPACES (3*LEVEL-3)
        %CAPTION END _ OF _ ; ->END(KKK)

END(0): %CAPTION BLOCK; ->401
END(1): %CAPTION PROGRAM; ->401
END(6): %CAPTION ROUTINE; ->401
END(7): %CAPTION REAL_FN; ->401
END(8): %CAPTION INTEGER _ FN; ->401
END(9): %CAPTION REAL _ MAP; ->401
END(10):%CAPTION INTEGER _ MAP;
401:    %IF MC  SWITCH = 1 %THEN DPCA
        NEWLINE
4011:   %IF  LEVEL > 2 %OR  PERM = 1 %OR LFLAG = 1  %THEN  -> 61
      %IF  KKK = 1 %THEN  -> 62
        FAULT(14)
        A(1) = 15
        -> 1

61:     %IF  KKK # 1 %THEN  -> 63
        FAULT(15)
        -> 1
62:      %IF FAULTY # 0 %THEN ->64
        %BEGIN
        %INTEGER P,Q,R
        %CYCLE P=2,1,NLIB
        ->1 %IF RA(P)=1
        %REPEAT
        **COMPILER; *J9#Z
        *E418; *=RC15;   *E444;  *=M15;  *PMEQ15
        *ZERO;  *=E444

        %IF LFLAG= 0%THEN ->9
6:      **DEVNO; *E440; *=E420; *=E440
        LFLAG = 0; A(1) = 15; *E9; *=E439; *E10; *=E443
        *JS11
        *
     5: *M0M15Q
        *
        *=M0M14Q; *J5C14NZS ;!RESTORE BUFFERS
        %CAPTION \ ALL_LIBRARY_ITEMS_INSERTED
        RAL(LEVEL)=N;LEVEL =LEVEL + 1; ->9
2:      *SET 35P:
        *=M14; *M0M14; *=Q15; *=C15;*SETB242; *DUP; *JS13
        *SETB 302; *DUP; *=M0M14N; *SET 44P:
        *=M14; *M0M14; *=Q15; *PERM; *=M0M14N;  *=C15
13:     *=I15; *Q15; *=M0M14; *EXIT 1

12:    *M+I15; *M15; *SETB37; *AND; *J12#Z; *EXIT 1
11:    *SET 42P: ; *=RM14; *SET 68; *=C14; *SET 11; *=RM15; *EXIT 1
1:      %IF LFLAG=1 %THEN ->3
        LFLAG=1; A(1) =8; LISTFLAG = 0; LEVEL = LEVEL - 1
        N=RAL(LEVEL)
        *E439; *=E9; *ZERO; *=E439; *E443; *=E10
        *JS11
        *
    4:  *M0M14Q
        *
        *=M0M15Q; *J4C14NZS;!DUMP BUFFERS IN PTFC
        *ZERO; *NOT; *=E443
        *E420; *E440; **=DEVNO; *=E440
        *E418; *DUP; *DUP
        *=E420; *JS2

8:      *SET30P:
        *=Q14; *M0M14; *=Q15; *JS12; *JS7; ->110
7:      *M0M15; *=Q13; *ZERO; *=TR
        *PARQ13; *J105TR;  *PIAQ13
        *E444;  *NOT;  *NEG;  *=E444
        *M0M15N; *=M15; *EXIT1 
110:    *JS12;  *M-I15; *M-I15; *Q15; *=M0M14

3: 
101:    *E226; *=Q15
102:    *JS12; *JS7; *M0M15; *M+I15
        *J102>=Z; *Q15; *=E226; ->21

105:    *E437; *E436; *SET2
        *=C15; *JS25P; *ZERO; *OUT; ! PARITY

21:      *JS49P; **=Q; ->21 %IF Q=10 %OR Q=32
       R=Q-48;
23:     *JS49P; **=Q
      ->22 %UNLESS '0'<=Q<='9'
       R=10R+Q-'0'
      ->23
22:     ->101 %IF P>R
       ->9 %IF P=R
        *E418;*=RC15;*E444; *SET 5; *-;*DUP; *=M15; *J101<=Z
        *PMEQ15;  *SET5;  *=E444;  ->101

9:      %IF FAULTY#0 %AND LFLAG = 1 %THEN ->6

        %END
        %IF LFLAG#0 %THEN ->1
64:     KKK=2

63:     LEVEL = LEVEL -1
        %STOP  %IF  LEVEL <= 0
        N = RAL(LEVEL)
        %IF  KKK = 0 %THEN  -> 1
        %IF  KKK = 2 %THEN  -> 50
        FROM LIST 2(JUMP(LEVEL),J,K)
        PUSHDOWN 2(LABEL(LEVEL),CA,K)
        -> 1

SW(9):  %COMMENT  [RT] [%SPEC '] [NAME] [FPP] [S]
        %IF  A(3) = 2 %THEN  -> 41
        CRSPEC (0)
        -> 1
41:     KKK = A(2) + 5
        KK = A(4)
        COPY TAG(KK)
        -> 39 %UNLESS  I = LEVEL
        -> 40 %IF  J = 15 %AND  TYPE = KKK
        F NAME = KK
        FAULT(7) %UNLESS  TYPE = 0

39:     CRSPEC(0)
        -> 41
40:     J = 0;M10=0; M13=0
        REPLACE TAG(KK)
        JJ = K
        P LABEL = P LABEL -1
        K= P LABEL
        STORE JUMP
                PJ(8,0,11)
        RAL(LEVEL)=N
        %IF LISTFLAG = 1 %THEN ->4001
        WRITE(LINE,5) ; SPACES(3*LEVEL)
        -> RT(TYPE)
RT(6):  %CAPTION ROUTINE _; ->400
RT(7):  %CAPTION REAL _ FN _; ->400
RT(8):  %CAPTION INTEGER _ FN _; ->400
RT(9):  %CAPTION REAL _ MAP_; ->400
RT(10): %CAPTION INTEGER _MAP _
400:     SPACE ; PRINT NAME (KK)
4001:   %IF MC SWITCH = 1 %THEN DPCA
        NEWLINE
        %IF  LEVEL = 9 %THEN  FAULT(34)
        %IF  LEVEL < 10 %THEN  -> 411
        FAULT(35) ; %STOP 
411:    LEVEL = LEVEL +1
        R = CA
                PQ(121,LEVEL,2)
                PQ(65,12,0)
                PQ(105,12,LEVEL)

        L(LEVEL)=LINE; M(LEVEL)=KK
        N=3; ->407 %IF DIAGS =0
        *JS415
407:    FLAG(LEVEL) = TYPE
        SET(LEVEL)=CA
                PSET(0)
                PQ(122,12,2)
        PPJ(8,95,13) %UNLESS MCSWITCH=1
        FROM LIST 2 (ST(JJ),J,K)
        
        RA(J) = R
        %IF  A(5) = 2 %THEN  -> 42
        P = 4
43:     P = P+2
        -> RFPD(A(P))
        RFPD(1)  :  TYPE = A(P+1)+5; P = P+1; -> 44
        RFPD(2)  :  TYPE = 4; -> 44
        RFPD(3)  :  TYPE = 12; -> 44
        RFPD(4)  :  TYPE = 2; -> 44
        RFPD(5)  :  TYPE = 3; P = P+1; -> 44
        RFPD(6)  :  TYPE = 11; -> 44
        RFPD(7)  :  TYPE = 1; -> 44
        RFPD(8)  :  TYPE=14
44:     P = P + 1
        LINK(JJ)
        %IF  JJ # 0 %THEN  -> 45
        FAULT(8)
        -> 46
45:     FROM LIST 2 (ST(JJ),J,JJJ)
        %IF  J # TYPE %THEN  FAULT (9)

        ->46 %IF 3#TYPE#4
         PUSHDOWN2(ARRDIM(LEVEL),CA,A(P))
         PSET(0)
         PMS(0,N,LEVEL)
         PPJ(8,66,13)

46:     K = A(P)
        TESTNST
        %IF  6 <= TYPE <= 10 %THEN  -> 47
        J = 0
        TYPE'=TYPE
        %IF  TYPE=14 %THEN  TYPE=2
        STORE TAG(K)
        TYPE=TYPE'
        N = N+1
        STORE NAME
        -> 99
47:     NEWCELL(KK)
        J=0
        R = N
        N = KK
        STORE TAG(K)
        STORE NAME
        N = R
        PUSHDOWN 2(ST(KK),JJJ,1000)
99:     P = P+1
        %IF  A(P) = 1 %THEN  -> 44
        P = P +1
        %IF  A(P) = 1 %THEN  -> 43
42:     LINK(JJ)
        %IF  JJ # 0 %THEN  FAULT(10)
        ->1

SW(10):         %COMMENT  [%SPEC ] [NAME] [FPP] [S]
        CRSPEC(2)
        ->1

SW(11):         %COMMENT  [%COMMENT ] [TEXT] [S]
        ->1

SW(12):         %COMMENT  [TYPE'] [%ARRAY ] [ARRAY LIST] [S]
        *JS3

        TYPE' = 4
        %IF  A(2) # 1 %THEN  TYPE' = 3
        Q = 2
15:     P = Q +2
10:     %IF  A(P) = 2 %THEN  -> 9
        P = P+2
        -> 10
9:      KK = 0

1201:   PQ(121,12,2) ;     ! *M12
        PQ(96,12,0);       ! *M+I12

1202:   P=P+1; PQ(96,12,0); ! *M+I12
        CSEXP(2); PQ(67,12,0);! =M0M12Q
        CSEXP(2); PQ(67,12,0)
        KK=KK+1
        %IF A(P)=1 %THEN ->1202
        PSET(1); PQ(67,12,0)
        PN(34);        ! DUP
        PQ(120,13,2);  ! *=M13
        PSET(KK)
        PQ(65,13,0);   ! *=M0M13
   M13=0;M10=0; QQ=Q+1

1205:   K=A(QQ); PPJ(8,61,13)
    TESTNST;TYPE=TYPE'
        J=KK
        STORETAG(K); STORENAME
        PMS(1,N,LEVEL);        ! =E(N)M(LEVEL) STORE ARRAYWORD

        N=N+1
        %IF A(QQ+1)=2 %THEN ->1206
        QQ=QQ+2; ->1205

1206:   PN(42);         ! ERASE
        Q=P+1; %IF A(Q)=1 %THEN ->15; ->1

SW(14):         %COMMENT  [%BEGIN ] [S]
        %IF LISTFLAG = 1 %OR LFLAG=1 %THEN ->4111
         WRITE(LINE,5); SPACES(3*LEVEL)
        %CAPTION BEGIN
4111:    %IF MC SWITCH = 1 %THEN DPCA
        NEWLINE
        RAL(LEVEL)=N
        LEVEL = LEVEL +1
        %IF  LEVEL = 10 %THEN  FAULT(34)
        %IF  LEVEL < 11 %THEN  -> 412
        FAULT(35) ; %STOP 
412:            PQ(121,LEVEL,2)
                PQ(65,12,0)
                PQ(105,12,LEVEL)
        L(LEVEL)=LINE; M(LEVEL)=0
        N=2; ->413 %IF DIAGS=0
        *JS415
413:    FLAG(LEVEL) = 0
        SET(LEVEL) = CA

                PSET(0)
                PQ(122,12,2)
               PPJ(8,95,13) %UNLESS MCSWITCH=1
        ;M10=0; M13=0
        ->1

415:    PSET(LINE)
        PSET(LEVEL)
       PPJ(8,68,13)
        N=3; *EXIT1

SW(15): *JS3     ;! END OF PRGAM
        PERM = 0
        KKK = 1
        -> 50

SW(16): *SET 38P: ;!LIST
        *=Q14; *M0M14; *=Q15; *C15; *E421; *-
        *J1=Z; LISTFLAG = 1; ->1

SW(17): COPY TAG(A(2))  ;![NAME][+'] [CONST] [)] [:]
        %IF  TYPE = 5 %AND  I = LEVEL %THEN  -> 29
        FAULT(4)
        ->1
29:     KK = K;M10=0; M13=0
        KKK = A(5)
        %IF  A(3) = 2 %THEN  KKK = -KKK
        %IF  ST(KK) <=KKK <= ST(KK+1) %AND A(4)=1 %THEN  -> 30
        FAULT(5)
        ->1
30:     **CA; **@ST(KK+2)
        **KKK; **ST(KK); *-; *=M15
        *=M14; *SHL24; *M14M15H
        *J31=Z; FAULT(6); *ERASE; ->1

31:     *=M14M15H; ->1

SW(18): Q = 1;  ![%SWITCH] [SWITCH LIST] [S]
28:     P = Q +2
25:     %IF  A(P) = 2 %THEN  -> 24
        P = P +2
        -> 25
24:     P = P +1
        %IF A(P+1)#1 %OR A(P+4)#1 %THEN ->1811
        KKK=A(P+2)
        %IF A(P)=2 %THEN KKK=-KKK
        KK=A(P+5)
        %IF A(P+3)=2 %THEN KK=-KK
        ->1807 %IF KK<KKK
        **N0; **KK; **KKK; *-
        *SHL-1; *NOT; *NEG; *+; **=JJ
        *I9; **JJ; *-;*J1807<Z
        -> 35
1807:   FAULT(27)
        KK = KKK; JJ=N0+2
35:     QQ = Q +1
27:     K = A(QQ)
        TESTNST
        R=N
        TYPE = 5
        J = 0
        N = N0
        STORE TAG(K)
        STORE NAME
        N = R
        %CYCLE  I = N0 + 2,1,JJ+2
        ST(I) = 0
        %REPEAT 
        ST(N0) = KKK
        ST(N0+1) = KK

        R=JJ-N0; N0 =JJ+2; JJ=N0+R
        %IF  A(QQ+1) = 2 %THEN  -> 26
      QQ= QQ +2
        -> 27
26:     Q = P +6
        %IF  A(Q) = 2 %THEN  -> 1
        -> 28
1811:    FAULT (18)
        KK=0
        JJ=N0+2
        KKK=0
        -> 35

SW(19): QU = 1     ;![COMPILE QUERIES] [S]
        ->1

SW(20): QU = 0     ;! [IGNORE QUERIES] [S]
        ->1

SW(21): MC SWITCH =1    ;! [%MCODE]
        OVERFLAG =0
        PERM =1
        ->1

SW(28): MC SWITCH = 0   ;! [%END %OF %MCODE]
        OVERFLAG = 1
        PERM = 0
        -> 1

SW(22):         %COMMENT  [N][P][:]
        %IF  MC SWITCH = 0 %THEN  FAULT (32)
        %IF  SL(A(2)) # 0 %THEN  FAULT (33)
        SL(A(2)) = CA; M10=0; M13=0
       %IF LFLAG = 1 %THEN ->1
         WRITE (LINE,5); SPACES (3*LEVEL)
        WRITE (A(2),2)
        PRINT SYMBOL ('P')
        PRINT SYMBOL (':')
        DPCA; NEWLINE;    ->1

SW(23): P = 2     ;![*] [UCI] [S]
        %IF  MC SWITCH = 0 %THEN  FAULT (32)
        MC SWITCH = 1
        CUCI; M10=0; M13=0
        ->1

SW(24):         %COMMENT  "%FAULT" [FAULT LIST]
        %IF LEVEL=2 %THEN -> 2401
        FAULT(26)
        -> 1

2401:   P=2; Q=P+1
2402:   %IF A(Q)=2 %THEN ->2403
        Q=Q+2; ->2402
2403:   K=A(Q+1); PSET(A(P))
        PPJ(8,84,13)

        STORE JUMP
        PJ(8,0,11); M13=0
        P=P+2; ->2403 %IF A(P-1)=1
        ->1 %IF A(P+1)=2
        P=P+2; Q=P+1; ->2402
SW(25): LISTFLAG = 0   ;![%ENDOFLIST]
        ->1
SW(26): *DC3           ;![STRINGS]
        ->1

SW(27): NEWLINES(2)    ;![%ENDOFPERM]
         LINE =-1
       *JS2701; ->SW(28)
2701:   POPUP2(JUMP(LEVEL),J,K)
        %IF J=-1 %THEN->2702
        I=J; FIND LABEL
        %IF J#-1 %THEN ->2703
         FAULT(11); WRITE(K,1);NEWLINE; ->2701
2703:   FILL LABEL(I,J); ->2701
2702:   POPUP2(LABEL(LEVEL),J,K)
        %IF J#-1 %THEN ->2702; *EXIT1
    

SW(29): %COMMENT  [%DEFINE %COMPILER ][S]
        LINE=-1; COMPILER =0
        *ZERO; *=E445

     *SET5;  *=E444
        *  JS 70
        *  JS 46 P
        INITIALISE
        *E425; *=M0M0H
        ** PP CURR
        *  = Q13
        *  M13
        *  = +I 13
        *  M0 TO Q13
        *  Q13
        ** = PP CURR
         *E419;  *E441;  *-;  *J1=Z
        *SET1; *=C15; *E446; *JS25P
        *ZERO; *OUT

70:     *SET 94P: ; *= RM13; *E7 ; *=M0M13 ;! DATE
        *M0 TO Q13 ; *J71EN
72:     * = E102 M13 Q ; * J72 NEN
71:     *C13; *NEG; *=E101; *ZERO; *=RM13 
        *J73EJ
74:     *LINK ; * = E119 M13 Q ; *J74NEJ
73:     *C13; *NEG; *=E118; *SET 15; *=RC14
        *Q15 ; *Q14 ; *Q13 ; *Q12 ; *Q11
        *Q10 ; *Q9  ; *Q8 ;  *Q7  ; *Q6

        *Q5  ; *Q4  ; *Q3  ; *Q2  ; *Q1
75:     *=E135M14Q; *J75C14NZ; *ZERO; NEWLINE
        %CYCLE  I = 1, 1, 8 ; *SHL 6
79:     READ SYMBOL(J); ->79 %IF J=10 %OR J=32 
        PRINT SYMBOL (J)
        **J; *SET 32; *-; *SET 63; *AND; *OR
        %REPEAT ;        ! TAPE IDENTIFIER NOW IN NS
        
80:      *E384; *=Q15; *BUSYQ15; *J80TR
         NEWLINE
        *SET101; *DUP; *=M13 
         *DUP ; *M12 ; *REV 
        * -
        * = RC14 ; *ZERO ; * ZERO
        *
76:     *M13M14Q ; *; *STR; *+D; *J76C14 NZS
        *=M13M14Q; *=M13M14; *M+I12; *=I12
        *SET 4; *DUP ; *=M15; *OUT;  ! PICK UP TAPE
        *DUP ; * = C15 ; * = C12
        *PMDQ15;*PMAQ15;*POAQ12;*I12=+1;! DUMP 101 TO WS + 1

        *PMEQ15 ; *PARQ15 ; *J77NTR
        %CAPTION \PARITY _ FAILURE ; ->78
77:     *C15;*SET 6;*OUT;! DEALLOCATE NEW COMPILER
        %CAPTION \ COMPILER _ DEFINED \
78:     WRITE (NUM,4)
        WRITE (NEXT,4)
        WRITE (N0,4)
        *I9
        **=I
        WRITE (I,4)
        *M12
        **=I
        WRITE (I,4)
        NEWPAGE
        *SET 38P:; *=M13; *M0M13
        *SHL-32; *SET 6; *OUT
        *ZERO; *OUT

SW(31):  ABC=1; ->1;   ! [COMPILE ARRAY BOUND CHECKS]

SW(32):  ABC=0; ->1;    ! IGNORE ARRAY BOUND CHECKS
SW(33):  ->1;   ! [S]

SW(30): ->62; ! END OF PACK

SW(13): M10=0; M13=0; ![*][*][*][A][S] 10/12/65 FOR ISO VERSION
        %BEGIN 
        %INTEGER I,J,K,N,N0',TAPE,ZEROTAPE, N',FLAG,PFLAG
        %REAL  TL,A'
        
        %SWITCH  S(0:10)
        %ROUTINE %SPEC  READ KEY WORD
        %ROUTINE %SPEC  READ SYM
        %ROUTINE %SPEC INITIAL OUTPUT

        ->77;*;
62P:    *165134/127722/16045;  !ZEROTAPE
        *2701/43532/22756;     !KEYWORDS IN
        *10014/101322/150262;  !FIVE BIT CODE
        *1573/60226/13101;     !A=1 B=2 ETC
        *5170/100000/0
        *12014/5000/0
        *7655/20532/0
        *10014/5440/0;   ! PAPER
        *11673/160000/0
        *10010/153122/0
        *1414/104000/0;   ! CARD
77:     *SET 62P:; *=M15; *M0M15; **=ZEROTAPE

        *E423; **=FLAG; PFLAG=0
        * SET +1; *SET 89P:; * =M10              

         * SET +18 ; * =RC13
        *
4:      * NEG ; * DUP ; * =M10M13Q    
        * ; * J4C13NZS
        * ERASE ; * ZERO ; * =M0M10
        ->2

1:      ->2 %IF  LINE<20 ; INITIAL OUTPUT
        %CAPTION \\ FAULTY _ JOB _ HEAD ; %STOP

2:      READ KEY WORD

        ->S(K)

S(9):   PFLAG = 1; ->3

S(0):   %COMMENT  KEY WORD UNKNOWN

3:      ->1 %IF  I=10 ; READ SYMBOL(I) ; ->3

S(1):   %COMMENT  EXECUTION
        READ(TL)
        READ SYM
        ->3 %UNLESS  I=77 %OR  I=83
        %IF  I=77 %THEN  TL=60*TL
        TIME LIMIT=INT(TL)
        ->3

S(2):   %COMMENT  PARAMETER
        READ SYM
        ->3 %UNLESS  I=42
        N=0 ; N'=0
        %CYCLE  J=1,1,4; ! UNSCRAMBLE PARAMETER
        READ SYM
        ->3 %UNLESS  48<=I<=55
        -> 21 %IF  J=4
        N=8N+I-48 ; N'=N'+I ; -> 22
21:     ** I; **N'; *-; *SHL+45; *J3#Z
22:     ** I; READ SYM; ** I; * NEV  
        ** J; *-; *J3#Z
        %REPEAT 
        ** N
        * SET 89P:
        * =M13
        * =M0M13
        ->3

S(7):   %COMMENT PAPER
        *E420; *J7001>Z; *ZERO; *OUT
7001:   *E438; *J7002<=Z
        *E438; *SET6; *OUT; *SET-2; *=E438
7002:   *ZERO; *=E439
7003:   *JS46P; INITIALISE; ->99

S(10):  *E438; *J10001>Z
        *SET4; *SET5; *OUT; *=E438
10001:  *SET1; *=E439; ->7003

S(8):   %COMMENT SWOP
        %BEGIN
        
        *E420; *SET7; *-; *J2>=Z
        *E420; *SET6; *OUT
        *SET2; *SET5; *OUT
        *DUP; *=E420
        *DUP; *SET 35P:
        *JS 1; *SET 44P:
        *JS 1
        ->2

1:      *=M14; *M0M14; *=Q15
        *=C15; *Q15; *=M0M14; *EXIT 1
2:      %END
        ->99

S(3):   ! COMPILER AA OR AB
        READSYM;->3001 %IF I=66
         ->3 %UNLESS  I=65 %OR  I=76
3002:   READSYM; ->3003 %UNLESS  I=10
        LINE=-1; INITIAL OUTPUT
        ->99   ; ! TO END OF JOB HEAD BLOCK

3001:   READSYM; ->3003 %UNLESS I=67
        ABC=1;DIAGS=1; ->3002
3003:   LINE=21; ->3

S(4):   %COMMENT  JOB
43:     READSYM; ->43 %UNLESS I=10 %AND NEXTSYMBOL# 10
        * SET 92P:  ;  *DUP  ;  *DUP
        %CYCLE  J = 1,1,10
        * NOT  ;  *NEG  ;  *DUP
        * ZERO
        %CYCLE  K=40,-8,0
        READ SYMBOL(I)
        ->41 %UNLESS  I=10   ; J=10  ;  ->42
41:     **I
        **K
        * =C13
        * SHLC13
        * OR
        %REPEAT 

42:     * REV  ;  * = M13  ;* = M0M13
        %REPEAT 
        *PERM  ;  * = M13  ;  * -  ;
        *DUP; *NOT; *NEG; *SHL40; *OR;   * = M0M13
        -> 3

S(5):   %COMMENT  TAPE
        TAPE=1
51:     READ KEY WORD
        ->S(K) %UNLESS  TAPE=1
        * ZERO

        %CYCLE  J=42,-6,0
        READSYM;I=I-32;!REDUCES TO KDF9 EQUIVALENT
        ->3 %UNLESS  16<=I<=58
        **I; **J; *=C13; *SHLC13  
        * OR
        %REPEAT 

        ** ZEROTAPE; * J54#;* ERASE 
        * ZERO
54:     READ SYM
        * SET 89P:; ** N; * DUP
        *+; *+; *=M13;   *=M0M13
        * SET +1
        -> 52 %UNLESS  I=42;!WRITE PERMIT
        *NEG
52:     *=M0M13N
53:     ->51 %IF  I=10 ; READ SYMBOL(I) ; ->53
S(6):   %COMMENT OUTPUT
61:     READ SYM; ->61 %IF I =10
        -> 3 %UNLESS 48<=I<=57 %OR I=79;    ! ZERO OR LETTER O

        READ SYM
        %IF I='7' %OR I='E' %OR I='8' %THEN I='S'
        J=I
        %IF FLAG =1 %THEN J='L'
        %IF FLAG =-1 %THEN J='S'
        FLAG =FLAG -1 %IF I='S'
63:     K=NEXT SYMBOL
        %IF '0'<=K<='9' %THEN ->62
        SKIP SYMBOL
        %IF K='\' %THEN ->1
        ->63
62:     READ (A'); N=INT(A')
        READ SYM
        %IF I='B' %AND J='S' %THEN N=N*4096
        %IF I='B' %AND J='L' %THEN N=N*200
        %IF I='L' %AND J='S' %THEN N=N*60
        %IF J='S' %AND N<4096 %THEN N=4096
        %IF J='L' %AND N<200  %THEN N=200
        **N
        *=E434
        ->3

        %ROUTINE  READ SYM
1:      READ SYMBOL(I) ; ->1 %IF  I=32
        %END 

%ROUTINE  READ KEY WORD
1:      READ SYM ; ->1 %IF  I=10
        LINE=LINE+1
        ->8 %IF  49<=I<=56
        TAPE=0

2:      * ZERO
        %CYCLE  J=40,-5,0
        **I
        * SET 64
        * -
        * DUP
        * SHL-5
        * J4#Z

        **J
        * =C13
        * SHLC13
        * OR
        *SET62P:; *= RM15
        %CYCLE  K=1,1,10
        *M0M15QN
        *J6=
        %REPEAT 
        READ SYM
        %REPEAT 
        * ZERO
4:      * ERASE
        K=0
6:      * ERASE
        ->10

8:      N=I-48
9:      K=0
10:     %END 

%ROUTINE INITIAL OUTPUT
        ->1 %IF FLAG<0
        *JS98P; ->2
1:      *E421; *J3>Z;
        *SET1; *SET5; *OUT
        *=E421
3:      *JS99P

2:      *SET 92P: ; *I11 ; *- ; *JS3P
        ->4 %IF DIAGS =1
        %CAPTION_____COMPILED_IN _OPTIMISING_MODE
        ->5
4:      %CAPTION_____COMPILED_IN_DIAGNOSTIC_MODE
5:      NEWLINES(2)
        %END

99:     **PFLAG; *NEG; *=E443;
        %END  ;!  END OF JOB HEAD BLOCK

        ->1

%ROUTINE  CRSPEC (%INTEGER  M)
        %INTEGER  KK,JJ,Q,JJJ,KKK
        %SWITCH  FPD(1:8)
        P = A(2) +5
        KK = A(4-M)
        COPY TAG(KK)
        %IF  M#2 %THEN  ->11
        %IF  I=LEVEL %AND  6<=TYPE<=10 %THEN  ->33
        FAULT(3)
        ->1
11:     -> 32 %IF  I # LEVEL
        -> 33 %IF  TYPE = P
34:     F NAME = KK
        FAULT(7) %UNLESS  TYPE = 0
        ->32
33:     FROM LIST 2(ST(K),JJ,Q)
        %IF  Q # 1000 %THEN  -> 34
        POPUP 2 (ST(K),JJ,Q)
        -> 35
32:     JJ = NR
        NR = NR +1
        NEWCELL(K)
        J = 15
        TYPE = P
        R = N
        N = K
        STORE TAG(KK)
        N = R
        R = K

        K = KK
        STORE NAME
        K = R
35:     JJJ = K
        Q = 0
        %IF  A(5-M) = 2 %THEN  -> 36
        P = 4-M
37:     P = P+2
        -> FPD(A(P))
        FPD(1)  :  TYPE = A(P+1)+5; P = P+1; -> 38
        FPD(2)  :  TYPE = 4; -> 38
        FPD(3)  :  TYPE = 12; -> 38
        FPD(4)  :  TYPE = 2; -> 38
        FPD(5)  :  TYPE = 3; P = P+1; -> 38
        FPD(6)  :  TYPE = 11; -> 38
        FPD(7)  :  TYPE = 1; -> 38
        FPD(8)  :  TYPE = 14
38:     P = P +2
        %IF  6 <= TYPE <= 10 %THEN  -> 101
        INSERT AFTER 2 (K,TYPE,0)
102:    Q = Q+1
        %IF  A(P) = 1 %THEN  -> 38
        P = P +1
        %IF  A(P) = 1 %THEN  -> 37
36:     PUSHDOWN 2 (ST(JJJ),JJ,Q)
        ->1
101:    INSERT AFTER 2 (K,TYPE,NR)
        NR = NR +1
        -> 102
        1:%END 

%ROUTINE  CUI
%INTEGER  KK,Q
        %SWITCH  SW(1:10)
        -> SW(A(P))

SW(1):  %COMMENT  [NAME] [APP] [SET MARKER 1] [REST OF UI]
        %IF  A(MARKER 1) = 1 %THEN  -> 3
        P = P +1
        CNAME(0)
        P = P +1
        -> 1
3:      Q = P +1
        COPY TAG (A(Q))
        P = MARKER 1 +1
       KK = PARITY (TYPE)
        ->20 %UNLESS  TYPE=0 %OR  KK=-1
        CSEXP(1)
        ->21
20:     CSEXP(2)
21:     %UNLESS  A(P) = 1 = QU %THEN  -> 2
        %IF  KK = 1 %THEN   PJ(8,SL(20),13)
        %IF  KK = -1 %THEN          PJ(8,SL(21),13)
        M13=0
2:      KK = P
        P = Q
        CNAME(1)
        P = KK +1
        -> 1

SW(2):  %COMMENT  [->] [N]
        K = A(P+1)
        STORE JUMP
                PJ(8,0,11)
        P = P +2
        -> 1

SW(3):  %COMMENT  [%CAPTION ] [CAPTION TEXT]
                PSET(A(P+1))
                PPJ(8,3,13)

        M13=0
        P = P +2
        -> 1

SW(4):  %COMMENT  [%RETURN ]
        %UNLESS  FLAG(LEVEL) = 6 %OR  PERM = 1 %THEN  FAULT(30)
        P = P +1
6:              PQ(105,LEVEL,12)
                PQ(64,12,0)
                PQ(120,LEVEL,2)
                PPJ(8,67,13) %IF DIAGS=1
                PJ(8,SL(4),11)
        ->1

SW(5):  %COMMENT  [%RESULT  = ] [+'] [OPERAND] [REST OF EXPR]
        %UNLESS  7<= FLAG(LEVEL)<=10 %THEN  FAULT(31)
        P = P +1
        %IF  FLAG(LEVEL) = 7 %THEN  -> 5
        CSEXP(2)
        ->6
5:      CSEXP(1)
        ->6

SW(6):  %COMMENT  [%STOP ]
                PJ(8,SL(6),11)
        P = P +1
        -> 1

SW(7):  %COMMENT  [->] [NAME] [(] [+'] [OPERAND] [REST OF EXPR] [)]
        COPY TAG(A(P+1))
        KK = K
        %UNLESS  TYPE = 5 %AND  I = LEVEL %THEN  FAULT(4)
        P = P +2
        CSEXP(2)
                PSET(KK)
                PPJ(8,7,11)  
        ->1

SW(8):  %COMMENT "%MONITOR " [N]
                PSET(A(P+1))
                PJ(8,SL(90),13)
        P=P+2;M10=0; M13=0;->1

SW(9):  ->SW(6) %IF DIAGS=0;    ! MONITORSTOP
        PPJ(8,24,11); P=P+1

1:      %END

* * * A
SWOP