perm filename FQCRED.SIM[SIM,SYS] blob sn#460070 filedate 1979-07-20 generic text, type T, neo UTF8
        COMMENT
        THIS IS THE FIRST PROGRAM (FQCRED) IN A SIMULA SOURCE PROGRAM
        MEASUREMENT SYSTEM. FOR PROGRAM DOCUMENTATION AND
        OPERATING INSTRUCTIONS ON IBM 360/370 SEE
        FOA P RAPPORT C 8350-M3(E5): PROGRAMVARA FOR PROGRAMOPTIMERING.
        FOR OPERATING INSTRUCTIONS ON DEC 10 SEE
        DEC SYSTEM 10 SIMULA LANGUAGE HANDBOOK PART II, APPENDIX J
	PLEASE PRESERVE IBM/360 AND DEC 10 COMPATIBILITY OF THIS PROGRAM!!!!!

	AUTHOR:		STEFAN ARNBORG DEC 11 1974

        INPUTS:         SIMULA SOURCE PROGRAM ON SYSIN

        OUTPUTS:        MODIFIED EXECUTABLE SIMULA PROGRAM ON PUNCH
                        LISTING  TEMPLATE ON D
                        DIAGNOSTICS ON SYSOUT

        ;
SIMSET
BEGIN

    LINK CLASS BUFFER(T);TEXT T;T.SETPOS(1);
    BOOLEAN IBM,DEC; COMMENT TARGET SYSTEM CODES;
    BOOLEAN LOWERCASE;
    BOOLEAN SEQNO; COMMENT SET IF DEC-10 LINED FILE;
    CHARACTER NOTSG,CBAR;
    INTEGER MAXCHAR; COMMENT MAX NO CHARACTERS, 255 ON IBM, 127 ON DEC;
    INTEGER IMLEN; COMMENT LENGTH OF IMAGE ON INPUT FILE;
    INTEGER CASECON; COMMENT USED TO CONVERT TO UPPER CASE ON DEC 10;
    IF RANK(''')=16R7D THEN IBM:=TRUE ELSE DEC:=TRUE;
    IF IBM THEN
    BEGIN COMMENT RUN ON IBM 360/370 SIMULA;
        NOTSG:='↑';
        MAXCHAR:=255;
        CBAR:='!';
        IMLEN:=80;
    END;
    IF DEC THEN
    BEGIN COMMENT RUN ON DEC SYSTEM 10 SIMULA;
        NOTSG:='\';
        MAXCHAR:=127;
        CBAR:='|';
        LOWERCASE:=TRUE;
        IMLEN:=135;
        CASECON:=RANK('A')-RANK('a');
    END;
    INSPECT NEW OUTFILE("D")DO
    BEGIN
        CHARACTER WINDOW,CH;
        BOOLEAN TRACEFLAG,MOREINP,SWITC;
        INTEGER LEV;

        TEXT TT1,TT2;
        CHARACTER CC1; COMMENT ONLY USED IN INP BELOW;
        PROCEDURE INP ;
        BEGIN COMMENT READ A BASIC SYMBOL AND PUT ITS TEXT IN
            SYMBUF AND ITS INTERNAL VALUE IN SCLASS . THE POSITION
            INDICATOR AND WINDOW SYMBOL SHOW THE CHARACTER FOLLOWING THE SYMBOL
            ;
            SWITCH CSE:= LETTERS,NUMBER,SINGLE,ASTERIKS,SLASH,NOTSIGN,EQUALSIGN,
            LESSORGREATER,COLON,SINGLEQUOTE,DOUBLEQUOTE ;
            MOREINP:=TRUE;
            IF SCLASS=IEPR THEN
            BEGIN COMMENT END OF FILE;
                IF L1=IEPR THEN
                BEGIN WARNING("END OF FILE");GOTO XIT; END;
                GOTO EXIT3;
            END;
            START:
            LB:
            IF SYSIN.POS>MP THEN BEGIN INIMAGE;WINDOW:=INCHAR;END;
            IF SCLASS=IEND THEN
            BEGIN
                SWITC:=FALSE;
                L:IF WINDOW=';'THEN GOTO  Q;
                IF SWITC OR NOT LETTER(WINDOW) THEN GOTO SK;
            IF LOWERCASE THEN
            BEGIN COMMENT CONVERT TO UPPER CASE;
                TT1:-TT2:-SYSIN.IMAGE.SUB(SYSIN.POS-1,MP-SYSIN.POS+2);
                CC1:=WINDOW; TT1.GETCHAR;
                WHILE TT1.MORE AND (LETTER(CC1) OR DIGIT(CC1)) DO
                BEGIN IF LETTER(CC1) AND
                    RANK(CC1)>RANK('Z') THEN CC1:=CHAR(RANK(CC1)+CASECON);
                    TT2.PUTCHAR(CC1);
                CC1:=TT1.GETCHAR;
                END;
                IF RANK(WINDOW)>RANK('Z') THEN WINDOW:=CHAR(RANK(WINDOW)+CASECON);
            END;
                IF WINDOW = 'E' THEN
                BEGIN IF (IF SYSIN.POS=2 THEN TRUE ELSE  NOT LETTER(SYSIN.IMAGE
                    .SUB(SYSIN.POS-2,1).GETCHAR))THEN
                    BEGIN IF SYSIN.IMAGE.SUB(SYSIN.POS,2)="ND" THEN GOTO Q;
                        IF SYSIN.IMAGE.SUB(SYSIN.POS,3)="LSE" THEN GOTO Q;
                    END
                END ELSE IF WINDOW='O' OR WINDOW='W' THEN
                BEGIN IF SYSIN.IMAGE.SUB(SYSIN.POS-1,9)="OTHERWISE" THEN GOTO Q;
                          IF SYSIN.IMAGE.SUB(SYSIN.POS-1,4)="WHEN" THEN GOTO Q;
                END;
                SK: SWITC:=LETTER(WINDOW) OR DIGIT(WINDOW);
                IF SYSIN.POS>MP THEN INIMAGE;
                WINDOW:=INCHAR;
                GOTO L;
                Q:
            END;
            SYMBUF:-SYMBUF.MAIN;SCLASS:=0;
            WHILE WINDOW=' 'DO
            BEGIN IF SYSIN.POS>MP THEN INIMAGE;
                WINDOW:= INCHAR ;
            END SCAN OF BLANKS ;  CH:= WINDOW ;
            IF KLASS(RANK(WINDOW))=LETTERKLASS THEN
            BEGIN LETTERS: COMMENT FIND KEYWORD OR ID;
                WHILE KLASS(RANK(WINDOW))=LETTERKLASS OR DIGIT(WINDOW) DO
                BEGIN IF SYMBUF.MORE THEN SYMBUF.PUTCHAR(WINDOW) ;
                    WINDOW:=INCHAR ;
                END ;
                SYMBUF:-SYMBUF.SUB(1,SYMBUF.POS-1);
                SCLASS:= INSERT ; GOTO EXIT ;
            END ELSE IF KLASS(RANK(WINDOW))=SINGLEKLASS THEN
            BEGIN
                SINGLE: COMMENT BASIC SYMBOL IS SINGLE CHARACTER ;
                SCLASS:= SCLASSES(RANK(CH));
                IF KLASS(RANK(CH))=SINGLEKLASS THEN
                BEGIN SYMBUF.PUTCHAR(WINDOW)  ; WINDOW:=INCHAR END ;
                GOTO EXIT ;
            END;
            GOTO CSE(KLASS(RANK(WINDOW)));
            COMMENT END OF FILE? ;
            IF ENDFILE THEN GOTO SLASH;
            IF SYSIN.POS NE 2 OR WINDOW NE '%' THEN GOTO NOCO;
            COMMENT CHECK FOR CONTROL CARD;
            IF SYSIN.IMAGE.SUB(2,5)="TRACE" THEN TRACEFLAG:=TRUE ELSE
            IF SYSIN.IMAGE.SUB(2,7)="NOTRACE" THEN TRACEFLAG:=FALSE ELSE
            IF SYSIN.IMAGE.SUB(2,6)="LEVEL=" THEN
            BEGIN SYSIN.SETPOS(8);LEV:=ININT;END ELSE
            IF SYSIN.IMAGE.SUB(2,7)="INDENT=" THEN
            BEGIN SYSIN.SETPOS(9);INDE:=ININT END ELSE
            IF SYSIN.IMAGE.SUB(2,5)="NOLOW" THEN LOWERCASE:=FALSE;

            NOCO:
            SYSOUT.OUTTEXT(SYSIN.IMAGE.STRIP); SYSOUT.OUTIMAGE;
            INIMAGE; WINDOW:=INCHAR; GOTO START;
            NUMBER: COMMENT NUMERIC ITEM;
            WHILE KLASS(RANK(WINDOW))=NUMKLASS OR WINDOW='.' DO
            BEGIN IF SYMBUF.MORE THEN SYMBUF.PUTCHAR(WINDOW) ELSE
                              WARNING("NUMBER SPILLED");WINDOW:=INCHAR;
                IF SYSIN.POS>MP THEN INIMAGE;
            END;
            SCLASS := NUMCLASS; GOTO EXIT;
            ASTERIKS:   COMMENT * OR **  ;
            WINDOW:=INCHAR ; SYMBUF.PUTCHAR(CH) ;
            IF WINDOW='*' THEN
            BEGIN SCLASS:= IEX ; GOTO EXIT1 END;
            GOTO SINGLE;
            SLASH:  COMMENT /OR // OR /* (END OF FILE) ** IMPLEMENTATION DEPEND.**;
            IF ENDFILE THEN
            BEGIN SCLASS:=IEPR; SYMBUF:=NOTEXT;GOTO EXIT;END;
            WINDOW:=INCHAR; SYMBUF.PUTCHAR(CH) ;
            IF WINDOW ='/' THEN BEGIN SCLASS:=IID ; GOTO EXIT1 END ;
            GOTO SINGLE;
            NOTSIGN:  COMMENT  NOT  OR  NE  ;
            WINDOW:=INCHAR; SYMBUF.PUTCHAR(CH) ;
            IF WINDOW='=' THEN
            BEGIN SCLASS:= INE ; GOTO EXIT1 END ;
            GOTO SINGLE ;
            EQUALSIGN:  COMMENT = OR == OR =/= ;
            WINDOW:= INCHAR ; SYMBUF.PUTCHAR(CH) ;
            IF WINDOW='=' THEN
            BEGIN SCLASS:= IED ; GOTO EXIT1 END;
            IF WINDOW='/' THEN
            BEGIN SYMBUF.PUTCHAR(WINDOW);WINDOW:=INCHAR;
                IF WINDOW='=' THEN
                BEGIN SCLASS:= IND ; GOTO EXIT1 END ;
                WARNING("ILLEGAL BASIC SYMBOL =/") ; GOTO EXIT ;
            END ;
            GOTO SINGLE ;
            LESSORGREATER:  COMMENT > OR< OR >= OR <= ;
            WINDOW:= INCHAR; SYMBUF.PUTCHAR(CH);
            IF WINDOW='=' THEN
            BEGIN SCLASS:=(IF CH='>' THEN IGE ELSE ILE) ; GOTO EXIT1 END ;
            GOTO SINGLE ;
            COLON: COMMENT : OR := OR :- ;
            WINDOW:= INCHAR ; SYMBUF.PUTCHAR(CH) ;
            IF WINDOW='=' THEN
            BEGIN SCLASS:= IBC ; GOTO EXIT1 END ;
            IF WINDOW='-' THEN
            BEGIN SCLASS:= IDN ; GOTO EXIT1 END ;
            GOTO SINGLE ;
            SINGLEQUOTE: COMMENT CHARACTER CONSTANT ;
            WINDOW:=INCHAR ; SYMBUF.PUTCHAR(CH); SYMBUF.PUTCHAR(WINDOW);
            WINDOW:=INCHAR ; SYMBUF.PUTCHAR(WINDOW) ; SCLASS:= ICC   ;
            IF WINDOW NE ''' THEN WARNING("CHARACTER CONSTANT") ;
            WINDOW:=INCHAR;
            SYMBUF:-SYMBUF.SUB(1,SYMBUF.POS-1);
            GOTO EXIT3;
            DOUBLEQUOTE: COMMENT TEXT STRING ;
            SCLASS:= ITC ;
            TC:-TC.MAIN;TC:=NOTEXT;
            DBDB:
            TC.PUTCHAR('"');
            WINDOW:=INCHAR;WHILE WINDOW NE '"'DO
            BEGIN IF  NOT TC.MORE THEN
                BEGIN WARNING("TEXT SPILLED"); WHILE WINDOW NE '"' DO WINDOW:=INCHAR;
                    TC.SETPOS(TC.LENGTH);
                END ELSE
                BEGIN TC.PUTCHAR(WINDOW);IF SYSIN.POS>MP THEN INIMAGE;
                    WINDOW:=INCHAR;
                END;
            END;
            IF  NOT TC.MORE THEN TC.SETPOS(TC.POS-1);
            TC.PUTCHAR('"');
            WINDOW:=INCHAR;
            IF WINDOW='"' THEN GOTO DBDB;
            GOTO EXIT3;
            EXIT1:
            SYMBUF.PUTCHAR(WINDOW); WINDOW:=INCHAR ;
            EXIT: IF SCLASS<IEND THEN SYMBUF:-SYMBUF.SUB(1,SYMBUF.POS-1);
            EXIT3:
            IF SCLASS = ICOMMENT THEN
            BEGIN
                WHILE WINDOW NE ';' DO
                BEGIN IF SYSIN.POS>MP+1 THEN INIMAGE;WINDOW:=INCHAR;
                END;
                WINDOW:=INCHAR;
                GOTO LB;
            END;
        END INP ;
        COMMENT INPUT INTERPRETATION CONSTANTS ;
        SHORT INTEGER
        IPL,IMI,ITI,IDI,IID,IEX,IGT,IGE,ILT,ILE,IEQ,INE,IED,IND,IDT,  COMMENT
          +   -   *   /  //  **  >   >=   <  <=   =   ↑=   == =/=   .   ;
        ICM,ICL,ISC,IPT,ILP,IRP,IBC,IDN,INT,ICC,ITC,                  COMMENT
          ,   :  .,   &  [(  ])  :=  :-    ↑  ' ' " "                   ;
        NUMCLASS,IEND,IDO,IELSE,IOTHERWISE,ICOMMENT,IBEGIN,IEPR
        ,IIF,IPROC,ICLASS,IEXTERN,ITHEN
        ,IWHEN,IINSPECT
        ;
        SHORT INTEGER ARRAY KLASS,SCLASSES(0:MAXCHAR) ;
        SHORT INTEGER NUMKLASS,SINGLEKLASS,LETTERKLASS,ASTERKLASS,SLASHKLASS,
        NOTKLASS,EQKLASS,LESSGREATERKLASS,COLONKLASS,SQKLASS,DQKLASS ;
        SHORT INTEGER I ;
        SHORT INTEGER MP;

        COMMENT UTILITY PROCEDURES;
        PROCEDURE SET(J); NAME J; SHORT INTEGER J ;
        BEGIN I:= I+1; J:=I ; END SET ;

        PROCEDURE IC(C,V); CHARACTER C ; INTEGER V ;
        SCLASSES(RANK(C)):= V ;

        INTEGER PROCEDURE INSERT ;
        BEGIN REF(NOD)TP;
            TEXT TTEMP; CHARACTER CTEMP;

            IF LOWERCASE THEN
            BEGIN COMMENT CONVERT TO UPPER CASE;
                SYMBUF.SETPOS(1);TTEMP:-SYMBUF;
                WHILE SYMBUF.MORE DO
                BEGIN CTEMP:=SYMBUF.GETCHAR;
                    IF LETTER(CTEMP) AND RANK(CTEMP)>RANK('Z') THEN
                    CTEMP:=CHAR(RANK(CTEMP)+RANK('A')-RANK('a'));
                    TTEMP.PUTCHAR(CTEMP);
                END;
                SYMBUF.SETPOS(1);
            END;
            TP:-ROOT;
            IF ROOT==NONE THEN ROOT:-TP:-NEW NOD ELSE

            BEGIN L:
                IF TP.T<SYMBUF THEN
                BEGIN IF TP.R==NONE THEN TP.R:-TP:-NEW NOD ELSE
                    BEGIN TP:-TP.R;GOTO L; END;
                END ELSE IF TP.T>SYMBUF THEN
                BEGIN IF TP.L==NONE THEN TP:-TP.L:-NEW NOD ELSE
                    BEGIN TP:-TP.L; GOTO L END;
                END;
            END;
            INSERT:=TP.N;TP.C:=TP.C+1;
        END ;

        CLASS NOD  ;
        BEGIN TEXT  T ;
            REF(NOD) L,R ; SHORT INTEGER N,C;
            INTEGER PROCEDURE INSERT ;
            BEGIN IF SYMBUF=T THEN
                BEGIN C:=C+1 ; INSERT:=N END ELSE
                IF SYMBUF<T THEN
                BEGIN IF L==NONE THEN L:- NEW NOD ;
                    INSERT:= L.INSERT ;
                END ELSE
                BEGIN IF R==NONE THEN R :-NEW NOD ;
                    INSERT:=R.INSERT ;
                END
            END INSERT ;

            T:- COPY(SYMBUF) ;
            N:=NEXTID;NEXTID:=NEXTID+1;
        END NOD ;

        REF(NOD) ROOT ;
        SHORT INTEGER NEXTID,FIRSTID ;
        SHORT INTEGER DECST,DECLT,SPECLT;
        PROCEDURE INIT ;
        BEGIN
            I:=0 ;
            SET(LETTERKLASS);SET(NUMKLASS);SET(SINGLEKLASS);SET(ASTERKLASS);
            SET(SLASHKLASS);SET(NOTKLASS);SET(EQKLASS);SET(LESSGREATERKLASS);
            SET(COLONKLASS); SET(SQKLASS) ; SET(DQKLASS);
            I:=0 ; SET(IEPR) ;
            SET(IPL);SET(IMI);SET(ITI);SET(IDI);SET(IID);SET(IEX);SET(IGT);SET(IGE);
            SET(ILT);SET(ILE);SET(IEQ);SET(INE);SET(IED);SET(IND);SET(IDT);SET(ICM);
            SET(ICL);SET(ISC);SET(IPT);SET(ILP);SET(IRP);SET(IBC);SET(IDN);SET(INT);
            SET(ICC);SET(ITC);SET(NUMCLASS); SET(NEXTID);
            FOR I:=0 STEP 1 UNTIL MAXCHAR DO
            BEGIN IF LETTER(CHAR(I))THEN KLASS(I):= LETTERKLASS ELSE
                IF DIGIT(CHAR(I)) THEN KLASS(I):= NUMKLASS ;
            END ;
            KLASS(RANK('+')):=KLASS(RANK('-')):=KLASS(RANK('.')):=SINGLEKLASS ;
            KLASS(RANK(',')):=KLASS(RANK(';')):=KLASS(RANK('(')):=SINGLEKLASS ;
            KLASS(RANK(')')):=SINGLEKLASS;
            IF DEC THEN
            BEGIN KLASS(RANK('[')):=KLASS(RANK(']')):=SINGLEKLASS;
                KLASS(RANK('@')):=KLASS(RANK('$')):=KLASS(RANK('#')):=LETTERKLASS;
            END;
            KLASS(RANK('←')):=KLASS(RANK('#')):=KLASS(RANK('@')):=LETTERKLASS ;
            KLASS(RANK('>')):=KLASS(RANK('<')):=LESSGREATERKLASS;
            KLASS(RANK('*')):=ASTERKLASS;
            KLASS(RANK('/')):=SLASHKLASS;
            KLASS(RANK(NOTSG)):=NOTKLASS;
            KLASS(RANK('=')):=EQKLASS;
            KLASS(RANK(':')):=COLONKLASS;
            KLASS(RANK(''')):=SQKLASS;
            KLASS(RANK('"')):=DQKLASS;
            KLASS(RANK('&')):=NUMKLASS;
            IC('+',IPL);IC('-',IMI);IC('*',ITI);IC('/',IDI);IC('>',IGT);IC('<',ILT);
            IC('=',IEQ);IC('.',IDT);IC(',',ICM);IC(':',ICL);IC(';',ISC);IC('&',IPT);
            IC('(',ILP);IC(')',IRP);IC('↑',INT);IC(''',ICC);IC('"',ITC);
            IF DEC THEN BEGIN IC('[',ILP);IC(']',IRP);END;
            SYMBUF:- COPY("END") ; IEND:=INSERT ; TEND:-SYMBUF;
            SYMBUF:-COPY("THEN");ITHEN:=INSERT;
            SYMBUF:- COPY("ELSE");IELSE:=INSERT;
            SYMBUF:- COPY("DO"); IDO:=INSERT ;
            SYMBUF:- COPY("OTHERWISE"); IOTHERWISE:=INSERT ;
            SYMBUF:- COPY("COMMENT");  ICOMMENT:=INSERT ;
            SYMBUF:- COPY("BEGIN");   IBEGIN:= INSERT ;  TBEGIN:-SYMBUF ;
            SYMBUF:-COPY("IF");IIF:=INSERT;
            SYMBUF:-COPY("WHEN");IWHEN:=INSERT;
            SYMBUF:-COPY("INSPECT");IINSPECT:=INSERT;
            DECST:=NEXTID;
            SYMBUF:-COPY("PROCEDURE");IPROC:=INSERT;
            SYMBUF:-COPY("CLASS");ICLASS:=INSERT;
            SYMBUF:-COPY("EXTERNAL");IEXTERN:=INSERT;
            SYMBUF:-COPY("BOOLEAN"); INSERT;
            SYMBUF:-COPY("ARRAY");INSERT;
            SYMBUF:-COPY("CHARACTER");INSERT;
            SYMBUF:-COPY("INTEGER");INSERT;
            SYMBUF:-COPY("LONG");INSERT;
            SYMBUF:-COPY("REAL");INSERT;
            SYMBUF:-COPY("REF");INSERT;
            SYMBUF:-COPY("SHORT");INSERT;
            SYMBUF:-COPY("SWITCH");INSERT;
            SYMBUF:-COPY("TEXT");INSERT;
            DECLT:=NEXTID;
            SYMBUF:-COPY("LABEL");INSERT;
            SYMBUF:-COPY("NAME");INSERT;
            SYMBUF:-COPY("VALUE");INSERT;
            SPECLT:=NEXTID;
            SYMBUF:-COPY("VIRTUAL");INSERT;
            IF DEC THEN
            BEGIN COMMENT DEC COMMENTS;
                KLASS(RANK('!')):=SINGLEKLASS;
                SCLASSES(RANK('!')):=ICOMMENT;
            END;
            FIRSTID:= NEXTID ; SYMBUF:- BLANKS(12) ;
            TPL:-BLANKS(IMLEN);
            I3:-BLANKS(IMLEN);
            SYMBUF:-BLANKS(12);
            TC:-BLANKS(IMLEN-8);
            IF SYSIN.POS NE 1 THEN INIMAGE ELSE MP:=72;
            IF DEC THEN
            BEGIN IF DIGIT(INCHAR) THEN
                BEGIN SEQNO:=TRUE; SYSIN.SETPOS(6); END ELSE
                SYSIN.SETPOS(1);
            END;
            WINDOW:=INCHAR;
            TRACEFLAG:=TRUE;
            LEV:=3;
        END INIT ;

        COMMENT LEXICAL SCAN INTERFACE ;
        SHORT INTEGER
        TRNO,
        SCLASS,S1,S2,L1,P1,P2;
        TEXT SYMBUF,T1,TBEGIN,TTRC,TEND,T2,TC,TX ;
        TEXT I1,I2,I3,I4;
        TEXT TPL;
        INTEGER IND1,INDE,INDEN;
        BOOLEAN BEND,BBEG;

        PROCEDURE RW;
        BEGIN
            PUNCH.OUTTEXT(T1);IF T1 >= "A" THEN PUNCH.OUTCHAR(' ');
            IF I1 =/= I2 THEN
            BEGIN IF BEND THEN IND1:=IND1-1;
                IF LENGTH LT IND1*INDE+I1.LENGTH THEN
                    IMAGE:-BLANKS(IND1*INDE+I1.LENGTH);
                SETPOS(IND1*INDE+1); OUTTEXT(I1);OUTIMAGE;
                IF TRACEFLAG THEN
                BEGIN SETPOS(IND1*INDE+1); OUTTEXT(TPL.STRIP);OUTIMAGE;END;
                IND1:=INDEN;
                BBEG:=BEND:=FALSE;
                I1:-I2;
                TPL:=NOTEXT;
                INSPECT BQ.FIRST DO OUT;
                NB:
                INSPECT  BQ.FIRST WHEN BUFFER DO
                BEGIN
                    IF T=/=I1 THEN
                    BEGIN OUT; SETPOS(IND1*INDE+1); OUTTEXT(T.STRIP);OUTIMAGE;
                        GOTO NB;
                    END;
                END;
            END;
            L1:=S1;S1:=S2;
            P1:=P2;T1:-T2;
            IF S1=IBEGIN THEN
            BEGIN IF NOT BEND THEN BBEG:=TRUE; INDEN:=INDEN+1 END  ELSE
            IF S1=IEND THEN
            BEGIN IF NOT BBEG THEN BEND:=TRUE;  INDEN:=INDEN-1 END;
            INP;
            S2:=SCLASS;I2:-SYSIN.IMAGE;T2:-COPY(SYMBUF);
            IF SCLASS=ITC THEN T2:-TC.STRIP;
            I2.SETPOS(1);
            P2:=SYSIN.POS-2;
        END RW;

        PROCEDURE INIMAGE;
        BEGIN IF WINDOW NE '%' THEN

            NEW BUFFER(SYSIN.IMAGE).INTO(BQ);
            SYSIN.IMAGE:-BLANKS(IMLEN);
            IF  NOT SYSIN.ENDFILE THEN SYSIN.INIMAGE ELSE
            BEGIN IF L1=IEPR THEN GOTO XIT ELSE  SYSIN.IMAGE:="/* ; " ;
            END;
            IF IBM THEN
                MP:=SYSIN.IMAGE.SUB(1,72).STRIP.LENGTH+1;
            IF DEC THEN
                MP:=SYSIN.IMAGE.STRIP.LENGTH+1;
        END INIMAGE;

        PROCEDURE TRACE(L); INTEGER L;
        IF TRACEFLAG THEN BEGIN
            IF L<=LEV THEN
            BEGIN
                IF P1 NE 0 AND MOREINP THEN
                BEGIN TPL.SETPOS(P1);TPL.PUTCHAR(CBAR);
                    PUNCH.OUTTEXT("Z←Y←Q(");TRNO:=TRNO+1;PUNCH.OUTINT(TRNO,5);
                    PUNCH.OUTTEXT("):=Z←Y←Q(");
                    PUNCH.OUTINT(TRNO,5);PUNCH.OUTTEXT(")+1;");
                END;
            END;
            MOREINP:=FALSE;
        END TRACE;

        PROCEDURE PB;PUNCH.OUTTEXT("BEGIN ");

        PROCEDURE PE;PUNCH.OUTTEXT("END ");

        PROCEDURE PS;PUNCH.OUTCHAR(';');

        PROCEDURE WARNING(T);NAME T;TEXT T;
        BEGIN OUTIMAGE ;
            OUTTEXT("**** "); OUTTEXT(T); OUTTEXT(" ****");
            INSPECT SYSOUT DO
            BEGIN REF(BUFFER) S;
                OUTTEXT(T);OUTIMAGE;
                OUTTEXT(SYSIN.IMAGE.STRIP);OUTIMAGE;
                OUTTEXT(TPL.STRIP);OUTIMAGE;
                S:-BQ.FIRST;
                WHILE S=/=NONE DO
                BEGIN OUTTEXT(S.T.STRIP);OUTIMAGE; S:-S.SUC; END;
            END;
            OUTINT(P1,3);
            PUNCH.OUTTEXT("COMMENT ");
            PUNCH.OUTTEXT(T);
            PUNCH.OUTCHAR(';');
            OUTIMAGE ;
            TPL.SETPOS(P1);TPL.PUTCHAR('&');
        END ;

                COMMENT *** TRANSITION DIAGRAMMES ***
                ;
        PROCEDURE PROGRAM;
        BEGIN WHILE NOT BLOCK(LEV>=2) DO RW;
            IF S1 NE IEPR AND S2 NE IEPR THEN
            BEGIN WARNING("TERMINATION"); WHILE NOT ENDFILE DO RW;
            END;
            OUTTEXT(I1); OUTIMAGE;
        END;

        BOOLEAN PROCEDURE BLOCK(FLAG); BOOLEAN FLAG;
        IF S1=IBEGIN THEN
        BEGIN BLOCK:=TRUE;
            RW;
            D;
            IF FLAG THEN TRACE(1);
            ST:
            WHILE S DO
            BEGIN IF S1=ISC THEN BEGIN RW;TRACE(3) END;
            END;
            IF S1 NE IEND THEN
            BEGIN WARNING("BLOCK STRUCTURE");RW; GOTO ST END;
            RW;
        END BLOCK;

        BOOLEAN PROCEDURE D;
        BEGIN
            L:IF S1=IEXTERN THEN
            BEGIN D:=TRUE; WHILE S1 NE ISC DO RW END ELSE
            IF S1>=FIRSTID AND S2=ICLASS THEN  ELSE
            IF S1>=DECST AND S1<=DECLT THEN BEGIN WHILE S1 NE ISC DO
                BEGIN D:=TRUE;IF S1=ICLASS OR S1=IPROC THEN BODY ELSE RW;
                END END ELSE GOTO E;
            RW;
            GOTO L;
            E:
        END D ;

        BOOLEAN PROCEDURE S;
        BEGIN INTEGER STACK;
            IF S1=ISC THEN BEGIN S:=TRUE;RW;GOTO E;
            END;
            L:IF L1=ICL THEN TRACE(2);IF S1=IIF THEN
            BEGIN IF L1=ISC OR L1=IDO OR L1=IOTHERWISE OR L1=IBEGIN OR L1=ICL THEN
                IFST ELSE IFEX;
            END ELSE
            IF S1=IDO AND S2 NE IBEGIN THEN
            BEGIN RW;PB;TRACE(1);STACK:=STACK+1;END ELSE
            IF S1=IINSPECT THEN II ELSE
            IF S1=IBEGIN THEN BLOCK(LEV>=3) ELSE
            IF S1=ISC THEN GOTO E ELSE IF S1=IEND THEN GOTO E ELSE IF S1=IELSE
            THEN GOTO E ELSE IF S1=ITHEN THEN GOTO E ELSE IF S1=IWHEN THEN GOTO E
            ELSE IF S1=IOTHERWISE THEN GOTO E ELSE
            BEGIN RW; S:=TRUE; GOTO L; END;
            S:=TRUE; GOTO L;
            E: WHILE STACK>0 DO BEGIN STACK:=STACK-1;PE; END;
        END S;

        PROCEDURE IFEX;
        BEGIN RW; WHILE S1 NE ITHEN DO BEGIN IF S1=IIF THEN IFEX ELSE RW;END;
            RW;S;
            IF S1=IELSE THEN
            BEGIN RW; IF S1=IIF THEN IFEX ELSE S END;
        END IFEX;

        PROCEDURE IFST;
        BEGIN RW;WHILE S1 NE ITHEN DO
            BEGIN IF S1=IIF THEN IFEX ELSE RW;END;
            RW;
            IF S1 NE IBEGIN THEN
            BEGIN
                PB;TRACE(1);S;PE;
            END ELSE BLOCK(TRUE);
            IF S1=IELSE THEN
            BEGIN RW; IF S1 NE IBEGIN AND S1 NE IIF THEN
                BEGIN PB;TRACE(3);S;PE;END ELSE
                BEGIN IF S1=IIF THEN IFST ELSE BLOCK(FALSE) END;
            END
        END IFST;

        PROCEDURE II;
        BEGIN RW;S;
            WHILE S1=IWHEN DO BEGIN RW;S END;
            IF S1=IOTHERWISE THEN BEGIN RW;
                IF S1=IBEGIN THEN BLOCK(LEV>=3) ELSE BEGIN PB;TRACE(3);S;PE END;
            END;
        END II;

        PROCEDURE BODY;
        BEGIN
            WHILE S1 NE ISC DO RW;RW;
            WHILE S1>=DECST AND S1<=SPECLT DO
            BEGIN WHILE S1 NE ISC DO RW;RW;END;
            IF S1=ISC THEN COMMENT EMPTY BODY;
            BEGIN PB; TRACE(2); PE; END  ELSE
            IF S1=IBEGIN  THEN BLOCK(LEV>=2) ELSE
            BEGIN PB;TRACE(2);S;PE;END;
        END BODY;

        REF(OUTFILE)PUNCH;
        REF(HEAD)BQ;

        OPEN(BLANKS(IMLEN));
        BQ:-NEW HEAD;
        PUNCH:-NEW OUTFILE("PUNCH");
        PUNCH.OPEN(BLANKS(72));
        INIT;
        PUNCH.OUTTEXT("BEGIN INTEGER I;PROCEDURE PROGRAM;BEGIN ");
        PROGRAM;
        XIT:
        PUNCH.OUTTEXT(";END;INTEGER ARRAY Z←Y←Q(1:");
        PUNCH.OUTINT(TRNO,6);
        PUNCH.OUTTEXT(");PROGRAM;");
        PUNCH.OUTTEXT("INSPECT NEW OUTFILE(");PUNCH.OUTCHAR('"');
        PUNCH.OUTTEXT("SYSTAT");PUNCH.OUTCHAR('"');
        PUNCH.OUTTEXT(")DO BEGIN OPEN(BLANKS(80));");
        PUNCH.OUTTEXT("FOR  I:=1 STEP 1 UNTIL  ");
        PUNCH.OUTINT(TRNO,6);
        PUNCH.OUTTEXT("DO OUTINT(Z←Y←Q(I),7);CLOSE;END;END; ");
        PUNCH.CLOSE;
        CLOSE;
    END;
END;