perm filename BUG2.SAI[CMU,AIL] blob
sn#087602 filedate 1974-02-20 generic text, type T, neo UTF8
00050 BEGIN "ALL"
00100 PRELOAD_WITH '46,'57,'45,'53,'55,'73,'44,'137,'54,'56,'72,'50,'51,'74,'76,'0,'41,'52;
00150 INTEGER ARRAY OPVAL[1:18];
00200 INTEGER ARRAY STAK[0:100],SYWHAT[0:1023],SYTYPE[0:1023],SYVAL[0:1023],
00250 SYTRACE[0:1023], SYPART[0:1023],R[0:23],MM[0:512],ESTAK[0:15];
00300
00350 PRELOAD_WITH "BA","D","B","S","IR","@TIME@","PS","SP";
00400 STRING ARRAY SREGS[1:8];
00410
00450
00500 STRING ARRAY PROG[0:1024],STR[0:100],SYNAME[0:1023];
00550
00600
00650 INTEGER NUMOP,DEFCT,PROGCT,CHFIN,TABFIN,TOS,TABTTY,SYSIZE;
00700 INTEGER I,T,NTIME,TTIME,JMP,PC,A,B,TSUB,NSUB,BBR,EOL;
00750 INTEGER DREG,BAREG,BREG,SREG,IRREG,TREG,SFPTR,DFPTR,BAPTR,SPREG;
00800 INTEGER SORD,SHIGH,SLOW,SSHFT,NOTBREAK,SBEG,RDCLR;
00850 INTEGER CHFOUT,TABFOUT,EOF,FLAG,CGD,BRCHAR,FBUS,VBUS,XBUS,MFLAG;
00900 INTEGER VRD,VDMUX,VFBA,BDAT,ALUOD,SDMUX,CS,CIR,CD,CBA,CB,CPS,CG,GPART,RIU;
00950 INTEGER USD,USSP,USBA,USB,USS,USIR,USCG,FAZE,EMUSED,EMV,LEL,LEH,LPLUS,NOTEND;
01000 INTEGER NULST,GOCT,SNGL,VSTAT,TSTAT,SOPA,SOPB,SRES,PSREG,USPS;
01050 INTEGER D16PTR,CVALC,CVALD7C,CVALD15,NPOS,ZPOS,VPOS,CPOS,DOFC;
01060 INTEGER PUSED,SETUSED,SPREAD,CCOUT,TSTUSED,RETUSED,NPOP,NPUSH,PSHV,IE;
01100 INTEGER PSREAD,TXPSU,XPSU,FORV,FORR,MMOC;
01150
01200 STRING CM,CMA,TS,FIN,FOUT,CRLF,BLANKS;
01250
01300 LABEL RESTART,DIL,LJMP,FINE,BP,PRGN;
01350
01500
01525 FORWARD INTEGER PROCEDURE RELSTR(STRING S);
01550 FORWARD PROCEDURE NAM(REFERENCE INTEGER SBEG);
01600 FORWARD STRING PROCEDURE TRIM(STRING S);
01650 FORWARD INTEGER PROCEDURE XTN(INTEGER V,B);
01700 PROCEDURE ERR(INTEGER N);
01750 BEGIN "ERR"
01800 COMMENT THIS PROCEDURE REPORTS AN ERROR AND THEN ABORTS EXAMINATION
01850 OF THE INSTRUCTION;
01900 IF FAZE=3 THEN OUTSTR(TRIM(PROG[PC])&CRLF) ELSE IF FAZE=2 THEN OUTSTR(TRIM(PROG[PROGCT])&CRLF);
01950 IF N<0 OR N>52 THEN OUTSTR("ERROR #"&CVS(N)) ELSE CASE N OF
02000 BEGIN
02050 [0] OUTSTR("UNRECOGNIZABLE STATEMENT");
02100 [1] OUTSTR("ILLEGAL OPERATOR");
02150 [2] OUTSTR("TOO MANY ENTRIES IN SYMBOL TABLE");
02200 [3] OUTSTR("ATTEMPT TO REDEFINE NAME");
02250 [4] OUTSTR("NUMBER REQUIRED BUT NOT PRESENT");
02300 [5] OUTSTR("ILLEGAL NUMBER FOR A REGISTER");
02350 [6] OUTSTR("CONDITIONAL JUMP LONGER THAN SPECIFIED");
02400 [7] OUTSTR("UNRECOGNIZABLE STATEMENT");
02450 [8] OUTSTR("ILLEGAL COMMAND LINE");
02500 [9] OUTSTR("SOMETHING OTHER THAN LABEL WHERE LABEL REQUIRED");
02550 [10] OUTSTR("BAD SYNTAX IN CASE STATEMENT");
02600 [11] OUTSTR("ATTEMPT TO USE UNEMPLEMENTED BUT");
02650 [12] OUTSTR("ATTEMPT TO SHIFT AN ILLEGAL AMOUNT");
02700 [13] OUTSTR("UNDEFINED SYMBOL");
02750 [14] OUTSTR("PROBLEM IN OPENING A FILE");
02800 [15] OUTSTR("ILLEGAL NUMBER")COMMENT IN COMS;;
02850 [16] OUTSTR("ILLEGAL USE OF UNIBUS");
02900 [17] OUTSTR("BAD SYNTAX IN DMUX ASSIGNMENT STATEMENT");
02950 [18] OUTSTR("ILLEGAL NAME IN DMUX ASSIGNMENT STATEMENT");
03000 [19] OUTSTR("TWO GENERAL REGISTERS OR S AND GENERAL REGISTER USED IN ILLEGAL COMBINATION");
03050 [20] OUTSTR("SHIFT/MASK USED WITH DIFFERENT SPECIFICATIONS");
03100 [21] OUTSTR("BAD SYNTAX IN RD ASSIGNMENT STATEMENT");
03150 [22] OUTSTR("ILLEGAL NAME IN RD ASSIGNMENT STATEMENT");
03200 [23] OUTSTR("ATTEMPT TO USE ALU TWICE");
03250 [24] OUTSTR("NO END STATEMENT");
03300 [25] OUTSTR("EMIT FIELD USED WITH GENERAL OR S REGISTER");
03350 [26] OUTSTR("CONSTANT TOO BIG FOR EMIT FIELD");
03400 [27] OUTSTR("DIFFERENT VALUES USED FOR EMIT");
03450 [28] OUTSTR("UNEXPECTED END OF PROGRAM");
03500 [29] OUTSTR("ATTEMPT TO USE ALU TWICE");
03550 [30] OUTSTR("COMPLEMENTING IN ILLEGAL PLACE");
03600 [31] OUTSTR("BAD SYNTAX IN FIELD SPECIFICATION");
03650 [32] OUTSTR("PLUS OPERATOR IN WRONG CONTEXT");
03700 [33] OUTSTR("MAIN MEMORY ADDRESS OUT OF BOUNDS");
03750 [34] OUTSTR("LABEL RANGE OR SPACING NOT POSSIBLE");
03800 [35] OUTSTR("ILLEGAL REGISTER SPECIFICATION");
03850 [36] OUTSTR("TWO BRANCHES IN INSTRUCTION");
03900 [37] OUTSTR("NONEXISTANT STATUS BIT");
03950 [38] OUTSTR("ILLEGAL COMBINATION OF STATUS BITS");
04000 [39] OUTSTR("ILLEGAL USE OF D(C)");
04050 [40] OUTSTR("NONEXISTANT OPERATION");
04100 [41] OUTSTR("PS REGISTER USED IN MORE THAN ONE WAY");
04150 [42] OUTSTR("PS PUT ON BUS RD WITH OTHER REGISTERS");
04153 [43] OUTSTR("BAD SYNTAX IN RETURN STATEMENT");
04156 [44] OUTSTR("BAD SYNTAX IN PUSH STATEMENT");
04159 [45] OUTSTR("ILLEGAL COMBINATION OF PUSHES AND POPS");
04162 [46] OUTSTR("STACK UNDERFLOW");
04165 [47] OUTSTR("STACK OVERFLOW");
04168 [48] OUTSTR("ILLEGAL COMBINATION OF OPERATIONS IN EXTENSIONS");
04184 [49] OUTSTR("SP PUT ON RD WITH OTHER REGISTERS");
04189 [50] OUTSTR("CARRYOUT CONTROL USED WITH EMIT");
04194 [51] OUTSTR("SYNTAX ERROR IN DATA STATEMENT");
04199 [52] OUTSTR("MAIN MEMORY EXHAUSTED")
04200 END;
04250 OUTSTR(CRLF);
04300 GOTO RESTART;
04350 END "ERR";
04400
04450 PROCEDURE ERS(INTEGER N; STRING S);
04500 BEGIN "ERS"
04550 COMMENT THIS PROCEDURE PRINTS THE STRING BEING EXAMINED AND THEN CALLS ERR;
04600 OUTSTR("NEAR '" & TRIM(S) & "'"&CRLF);
04650 ERR(N);
04700 END "ERS";
04750
04800 PROCEDURE ERU(INTEGER N,U);
04850 BEGIN "ERU"
04900 COMMENT THIS PROCEDURE PRINTS THE SYMBOL BEING EXAMINED AND THEN CALLS ERR;
04950 INTEGER X;
05000 STRING S;
05050 X←U;
05100 IF X<1000000 THEN X←STAK[X];
05150 IF X<2000000 THEN S←OPVAL[X-1000000]
05200 ELSE IF X<3000000 THEN S←STR[X-2000000]
05250 ELSE IF X<4000000 THEN S←SYNAME[X-3000000];
05300 OUTSTR("NEAR '" & TRIM(S) & "'"&CRLF);
05350 ERR(N);
05400 END "ERU";
05450
05500 INTEGER PROCEDURE VAL(STRING S);
05550 BEGIN "VAL"
05600 STRING ST; INTEGER V,Y,VO,BT7,OF,R;
05650 COMMENT THIS PROCEDURE CONVERTS STRING S TO AN INTEGER;
05700 ST←TRIM(S);
05705 Y←ST[1 FOR 1];
05710 IF Y>'57 AND Y<'72 THEN
05715 BEGIN
05750 BT7←OF←VO←V←0;
05800 WHILE LENGTH(ST)>0 DO
05850 BEGIN
05900 Y←LOP(ST);
05950 IF Y='47 THEN BEGIN OF←1; DONE END;
06000 IF Y<'60 OR Y>'71 THEN ERR(4);
06050 IF Y-48>7 THEN BT7←1;
06100 V←V*10+Y-48;
06150 VO←VO*8+Y-48;
06200 END;
06250 IF LENGTH(ST)>0 THEN ERR(15);
06300 R← IF OF THEN VO ELSE V;
06305 END
06310 ELSE
06315 BEGIN
06320 COMMENT THIS IS A CHARACTER STRING EQUATED WITH A CONSTANT;
06325 Y←RELSTR(ST)-3000000;
06330 IF SYWHAT[Y]<6 OR SYWHAT[Y]>8 THEN ERR(4);
06335 R←SYVAL[Y];
06340 END;
06350 R←XTN(R,15);
06400 IF R<-32768 OR R>32767 THEN ERR(15);
06450 IF OF AND BT7 THEN ERR(15);
06500 RETURN(R);
06550 END "VAL";
06600
06650 INTEGER PROCEDURE STOI(INTEGER S);
06700 BEGIN "STOI"
06750 INTEGER X;
06800 COMMENT THIS PROCEDURE CONVERTS THE STRING POINTED TO BY UNIFORM SYMBOL S TO A NUMBER;
06850 X←S;
06900 IF X<1000000 THEN X←STAK[X];
06950 IF X<2000000 OR X>2999999 THEN ERR(0);
07000 RETURN (VAL(STR[X-2000000]));
07050 END "STOI";
07100
07150 STRING PROCEDURE TRIM(STRING S);
07200 BEGIN "TRIM"
07250 INTEGER I;
07300 COMMENT THIS PROCEDURE TRIMS TRAILING BLANKS FROM STRINGS;
07350 FOR I←LENGTH(S) STEP -1 UNTIL 1 DO IF NOT EQU(S[I FOR 1]," ") THEN DONE;
07400 RETURN (S[1 TO I]);
07450 END "TRIM";
07500
07550 INTEGER PROCEDURE MATCH(INTEGER I;STRING S);
07600 BEGIN "MATCH"
07650 INTEGER J,X;
07700 STRING T;
07750 COMMENT THIS PROCEDURE EXAMINES THE UNIFORM SYMBOL REPRESENTED BY I AND
07800 RETURNS TRUE IF IT REPRESENTS A STRING WHICH BEGINS WITH THE SUBSTRING S;
07850 J←I;
07900 IF J<1000000 THEN J←STAK[J];
07950 IF J<2000000 OR J>2999999 THEN RETURN (0);
08000 T←STR[J-2000000];
08050 X←LENGTH(S);
08100 IF LENGTH(T)<X THEN RETURN (0);
08150 T←T[1 FOR X];
08200 RETURN (EQU(T,S));
08250 END "MATCH";
08300
08350 INTEGER PROCEDURE ROP(INTEGER Y);
08400 BEGIN "ROP"
08450 INTEGER I;
08500 LABEL LA;
08550 COMMENT THIS PROCEDURE TRANSLATES OPERATORS TO UNIFORM SYMBOLS;
08600 FOR I←1 STEP 1 UNTIL NUMOP DO IF Y=OPVAL[I] THEN GOTO LA;
08650 ERS(1,Y);
08700 LA: RETURN (I+1000000);
08750 END "ROP";
08800
08850 INTEGER PROCEDURE RELSTR(STRING S);
08900 BEGIN "RELSTR"
08950 INTEGER H,HA,RSEED,X;
09000 STRING S2;
09050 LABEL FOUN;
09100 COMMENT THIS PROCEDURE ENTERS A STRING INTO THE SYMBOL TABLE AND
09150 RETURNS A UNIFORM SYMBOL REPRESENTING IT;
09200 X←LENGTH(S);
09250 S2←IF X<10 THEN S&BLANKS[1 FOR 10-X] ELSE S[1 TO 10];
09300 HA←H←ABS CVSIX(S2[1 TO 6]) MOD 1021; COMMENT 1021 IS THE LARGEST PRIME
09350 INTEGER SMALLER THAN 1024. THREE LOCATIONS CANNOT BE REACHED ON THE
09400 FIRST TRY. THIS IS A SMALLL PROBLEM;
09450 RSEED←1;
09500 WHILE SYWHAT[H] DO
09550 BEGIN
09600 IF EQU(SYNAME[H],S2) THEN GOTO FOUN;
09650 RSEED←RSEED*5 LAND (SYSIZE*4+3);
09700 H←(RSEED DIV 4 +HA) LAND SYSIZE;
09750 END;
09800 SYWHAT[H]←1;
09850 SYNAME[H]←S2;
09855 SYVAL[H]←0;
09860 SYTRACE[H]←0;
09865 SYPART[H]←0;
09900 IF SYSIZE*0.95<DEFCT←DEFCT+1 THEN ERR (2);
09950 FOUN: RETURN (H+3000000);
10000 END "RELSTR";
10050
10100 INTEGER PROCEDURE RELNAM(INTEGER PTR);
10150 BEGIN "RELNAM"
10200 COMMENT THIS PROCEDURE ENTERS NAMES INTO THE SYMBOL TABLE AND RETURNS UNIFORM SYMBOLS;
10250 T←PTR;
10300 IF T≥0 AND T<1000000 THEN T←STAK[T];
10350 IF T<2000000 OR T>2999999 THEN ERR(-1);
10400 RETURN (RELSTR(STR[T-2000000][1 FOR 10]));
10450 END "RELNAM";
10500
10550 PROCEDURE LEX(INTEGER PTR);
10600 BEGIN "LEX"
10650 INTEGER TI,CHLAST,X,Y,OPL,I,NSTR;
10700 STRING T,ST,SA;
10750 COMMENT THIS PROCEDURE TAKES A POINTER INTO PROG AND CONVERTS THAT ENTIRE
10800 STATEMENT INTO UNIFORM SYMBOLS;
10850 ST←PROG[PTR];
10900 CHLAST←0;
10950 TOS←NSTR←-1;
11000 OPL←0;
11050 SA←NULL;
11100 WHILE LENGTH(ST)>0 DO
11150 BEGIN
11200 TI←LOP(ST);
11250 IF TI NEQ "'" AND (TI ≤'57 OR (TI ≥ '72 AND TI≤'77) OR TI≥'133 ) THEN
11300 BEGIN
11350 COMMENT HANDLE OPERATORS;
11400 X←ROP(TI);
11450 IF CHLAST THEN
11500 BEGIN
11550 COMMENT CLEAN UP PREVIOUS SYMBOL;
11600 Y←LENGTH(SA);
11650 IF Y<10 THEN SA←SA&BLANKS[1 FOR 10-Y];
11700 TOS←TOS+1;
11750 NSTR←NSTR+1;
11800 STR[NSTR]←SA;
11850 SA←NULL;
11900 STAK[TOS]←NSTR+2000000;
11950 CHLAST←0;
12000 END;
12050 IF OPL=1000005 AND X=1000005 THEN
12100 BEGIN
12150 COMMENT HANDLE TWO CHARACTER UNARY MINUS;
12200 OPL←0;
12250 STAK[TOS]←1000016;
12300 END
12350 ELSE IF OPL=1000017 AND X=1000017 THEN
12400 BEGIN
12450 COMMENT HANDLE COMMENTS;
12500 OPL←0;
12550 I←1;
12600 WHILE NOT EQU(ST[I FOR 2],"!!") DO I←I+1;
12650 ST←ST[I+2 TO INF];
12700 TOS←TOS-1;
12750 IF TOS>-1 THEN
12800 BEGIN
12850 IF STAK[TOS]=NSTR+2000000 THEN
12900 BEGIN
12950 COMMENT THE COMMENT WAS IN THE MIDDLE OF AN IDENTIFIER;
13000 SA←TRIM(STR[NSTR]);
13050 NSTR←NSTR-1;
13100 TOS←TOS-1;
13150 CHLAST←1;
13200 END
13250 ELSE IF STAK[TOS]>999999 AND STAK[TOS]<2000000 THEN OPL←STAK[TOS] ELSE OPL←0;
13300 END;
13350 END
13400 ELSE
13450 BEGIN
13500 COMMENT HANDLE REGULAR OPERATORS;
13550 TOS←TOS+1;
13600 STAK[TOS]←X;
13650 OPL←X;
13700 END;
13750 END
13800 ELSE
13850 BEGIN
13900 COMMENT HANDLE CHARACTER STRING;
13950 COMMENT SINGLE QUOTE IS TREATED AS AN ALPHABETIC;
14000 SA←SA&TI;
14050 CHLAST←1;
14100 OPL←0;
14150 END;
14200 END;
14250 END "LEX";
14253
14256 PROCEDURE DAT(REFERENCE INTEGER SBEG);
14259 BEGIN "DAT"
14262 INTEGER A,B,Z,F,C,D;
14265 STRING S;
14268 COMMENT THIS PROCEDURE HANDLES DEFINING DATA IN CORE STORAGE;
14271 S←STR[STAK[SBEG]-2000000][5 TO INF];
14274 B←RELSTR(S)-3000000;
14277 IF SYWHAT[B]>1 THEN ERS(3,S);
14280 SYWHAT[B]←7;
14281 SYVAL[B]←MMOC;
14283 SBEG←SBEG+1;
14286 IF STAK[SBEG] NEQ 1000006 THEN ERR(51);
14289 SBEG←SBEG+1;
14292 F←1;
14295 WHILE F DO
14298 BEGIN
14301 C←STOI(SBEG);
14304 D←1;
14307 SBEG←SBEG+1;
14310 IF STAK[SBEG]=1000018 THEN
14313 BEGIN
14316 COMMENT A REPITETION FACTOR WAS USED;
14319 D←C;
14322 SBEG←SBEG+1;
14325 C←STOI(SBEG);
14328 SBEG←SBEG+1;
14331 END;
14334 FOR I←1 STEP 1 UNTIL D DO
14337 BEGIN
14340 MMOC←MMOC+2;
14343 IF MMOC>1023 THEN ERR(52);
14346 MM[MMOC DIV 2]←C;
14349 END;
14352 IF STAK[SBEG]=1000006 OR STAK[SBEG]=1000007 THEN F←0
14355 ELSE IF STAK[SBEG] NEQ 1000009 THEN ERR(51);
14358 END;
14361 SBEG←SBEG+1;
14364 END "DAT";
14367
14370 PROCEDURE LABDEF(REFERENCE INTEGER SBEG);
14400 BEGIN "LABDEF"
14450 INTEGER X,T,Z;
14500 COMMENT THIS PROCEDURE DEFINES LABELS;
14550 X←STAK[SBEG];
14600 IF X<2000000 OR X>2999999 THEN ERR(0);
14650 T←RELNAM(X)-3000000;
14700 IF SYWHAT[T]>1 THEN ERS(3,SYNAME[T]);
14750 SYWHAT[T]←5;
14800 SYVAL[T]←PROGCT;
14850 SYTRACE[T]←0;
14900 SYPART[T]←1;
14950 IF STAK[SBEG+1]=1000012 THEN
15000 BEGIN
15050 COMMENT NUMBER OF CONTIGUOUS LOCATIONS NEEDED IS INDICATED;
15100 SYPART[T]←Z←STOI(STAK[SBEG+2]);
15150 IF Z<1 OR Z>32 THEN ERR(34);
15200 IF STAK[SBEG+3] =1000009 THEN
15250 BEGIN
15300 COMMENT SPACING OF INSTRUCTIONS IS INDICATED;
15350 Z←STOI(STAK[SBEG+4]);
15400 IF Z NEQ 1 AND Z NEQ 2 THEN ERR(34);
15450 SBEG←SBEG+2;
15500 END;
15550 IF STAK[SBEG+3] NEQ 1000013 THEN ERR(0);
15600 SBEG←SBEG+3;
15650 END;
15700 SBEG←SBEG+2;
15705 RETURN;
15710 END "LABDEF";
15715
15720 PROCEDURE SYNO(REFERENCE INTEGER SBEG);
15725 BEGIN
15730 INTEGER T,N,X,SN,FNI;
15735 STRING S,SA;
15737 COMMENT THIS PROCEDURE HANDLES SYNONYM STATEMENTS;
15739 SN←0;
15741 IF STAK[SBEG+1]=1000005 THEN BEGIN FNI←1; SN←1; END
15743 ELSE IF STAK[SBEG+1]=1000016 THEN BEGIN FNI←1; SN←2; END
15744 ELSE BEGIN FNI←4; SBEG←SBEG+2;END;
15745 T←STAK[SBEG]-2000000;
15750 S←STR[T][FNI TO INF];
15755 X←LOP(S);
15760 SA←NULL;
15765 WHILE (X<'72 AND X>'57) OR X="'" DO
15770 BEGIN
15775 SA←SA&X;
15780 X←LOP(S);
15785 END;
15790 S←X&S;
15795 N←VAL(SA);
15797 IF SN=1 THEN N←-N
15799 ELSE IF SN=2 THEN N← LNOT N;
15800 T←RELSTR(S)-3000000;
15805 IF SYWHAT[T]>1 THEN ERS(3,S);
15810 SYWHAT[T]←6;
15815 SYVAL[T]←XTN(N,15);
15820 SBEG←SBEG+1;
15825 IF STAK[SBEG] NEQ 1000006 AND STAK[SBEG] NEQ 1000007 THEN ERR(53);
15830 SBEG←SBEG+1;
15835 END "SYNO";
15840
15900 PROCEDURE PROGIN;
15950 BEGIN "PROGIN"
16000 LABEL LEC;
16050 STRING S,T;
16100 INTEGER A,B,I,L,J,SBEG;
16150 COMMENT READS IN THE PROGRAM AND CALLS ROUTINES TO DEFINE NAMES AND LABELS;
16200 WHILE NOTEND DO
16250 BEGIN
16300 PROGCT←PROGCT+1;
16350 S←INPUT(CHFIN,TABFIN);
16400 IF EOF THEN BEGIN NOTEND←0; ERR(28); END;
16450 L←LENGTH(S)-1;
16500 FOR I←1 STEP 1 UNTIL L DO
16550 BEGIN
16600 IF EQU(S[I FOR 2],"!!") THEN
16650 BEGIN
16700 WHILE 1 DO
16750 BEGIN
16800 FOR J←I+2 STEP 1 UNTIL L DO IF EQU(S[J FOR 2],"!!") THEN GOTO LEC;
16850 COMMENT THE COMMENT CONTAINS A "$" SO THE ENTIRE
16900 INTRUCTION HAS NOT YET BEEN READ IN;
16950 S←S&INPUT(CHFIN,TABFIN);
17000 IF EOF THEN BEGIN NOTEND←0; ERR(28); END;
17050 L←LENGTH(S)-1;
17100 END;
17150 LEC:I←J+1;COMMENT THE END OF THE COMMENT HAS BEEN FOUND;
17200 END;
17250 END;
17300 PROG[PROGCT]←S;
17350 LEX(PROGCT);
17400 SBEG←0;
17450 WHILE SBEG<TOS DO
17500 BEGIN
17550 A←STAK[SBEG];
17600 B←STAK[SBEG+1];
17650 IF B=1000011 OR B=1000012 THEN LABDEF(SBEG)
17705 ELSE IF B=1000006 OR B=1000007 THEN
17710 BEGIN
17715 IF MATCH(A,"SYN") THEN SYNO(SBEG)
17720 ELSE IF MATCH(A,"DATA") THEN DAT(SBEG)
17722 ELSE IF MATCH(A,"NAME") THEN NAM(SBEG)
17725 ELSE DONE;
17730 END
17735 ELSE IF (STAK[SBEG+3]=1000006 OR STAK[SBEG+3]=1000007) AND
17740 (B=1000005 OR B=1000016) AND
17745 MATCH(A,"SYN") THEN SYNO(SBEG)
17750 ELSE DONE;
17800 END;
17850 IF (MATCH(A,"END") OR MATCH(A,"DONE")) AND B=1000007 THEN DONE;
17900 END;
17950 OUTSTR("PROGRAM IN"&CRLF);
18000 END "PROGIN";
18050
18100 INTEGER PROCEDURE XTN(INTEGER V,B);
18150 BEGIN "XTN"
18200 INTEGER O,N,X,Z;
18250 COMMENT THIS PROCEDURE TAKES BIT B FROM WORD V AND EXTENDS IT
18300 TO THE HIGH ORDER BIT OF THE WORD AND RETURNS THIS RESULT;
18350 O←'777777777777;
18400 O←O LSH B;
18450 Z←LNOT O;
18500 N←V LSH -B LAND '1;
18550 IF N=0 THEN X←V LAND Z
18600 ELSE X←V LOR O;
18650 RETURN (X);
18700 END "XTN";
18750
18800 INTEGER PROCEDURE XTR;
18850 BEGIN "XTR"
18900 INTEGER X,Y,Z,M,A,B,C,T;
18950 COMMENT THIS PROCEDURE EXTRACTS PARTICULAR FIELDS FROM THE S REGISTER;
18955 X←R[SREG];
19000 X←Y←X LAND '177777;
19025 A←SHIGH; B←SLOW; C←SSHFT;
19050 IF A<0 OR A>15 OR B<0 OR B>15 THEN ERR(12);
19075 IF C<0 AND -C>B THEN ERR(12);
19080 IF C>0 AND C>15-A THEN ERR(12);
19100 IF B>A THEN
19150 BEGIN
19200 X←X LSH (16-B);
19250 Y←Y LSH -B;
19300 Z←X LOR Y;
19350 M←A-B+16;
19400 END
19450 ELSE
19500 BEGIN
19550 COMMENT TAKE THE FIELD FROM THE MIDDLE OF THE WORD;
19600 Z←X LSH -B;
19650 M←A-B;
19700 END;
19712 T←(1 LSH (M+1))-1;
19725 Z←Z LAND T;
19730 Z←Z LSH (C+B);
19750 RETURN (XTN(Z,15));
19800 END "XTR";
19805
19810 INTEGER PROCEDURE NUMEQV(INTEGER A);
19815 BEGIN "NUMEQV"
19820 COMMENT THIS PROCEDURE RETURNS 1 IF THE UNIFORM SYMBOL A POINTS
19825 TO A NAME WHICH IS EQUIVALENT TO AN INTEGER I.E., SYWHAT OF THIS
19830 SYMBOL EQUAL 6, 7, OR 8. IT RETURNS 0 OTHERWISE;
19835 IF A<0 OR A>3999999 THEN ERR(-1);
19840 IF A<1000000 THEN A←STAK[A];
19845 IF A<2000000 THEN RETURN (0);
19850 IF A<3000000 THEN A←RELNAM(A);
19855 A←A-3000000;
19860 IF SYWHAT[A]<9 AND SYWHAT[A]>5 THEN RETURN (1)
19865 ELSE RETURN (0);
19870 END "NUMEQV";
19875
19900 PROCEDURE TRAC(INTEGER U);
19950 BEGIN "TRAC"
20000 INTEGER X;
20050 COMMENT THIS PROCEDURE HANDLES TRACING;
20100 IF U<3000000 OR U>3999999 THEN ERR(-1);
20150 X←U-3000000;
20200 IF SYTRACE [X]=0 THEN RETURN;
20250 IF SYTRACE[X]=2 THEN BEGIN OUTSTR("BREAKPOINT "); NOTBREAK←0; END;
20300 IF SYWHAT[X]=5 THEN OUTSTR(TRIM(SYNAME[X])&CRLF)
20350 ELSE OUTSTR(TRIM(SYNAME[X])&": "&CVS(R[SYVAL[X]])&" = "&CVOS(R[SYVAL[X]] LAND '177777)&"'"&CRLF);
20400 END "TRAC";
20450
20500 PROCEDURE MULTR(REFERENCE INTEGER SBEG);
20550 BEGIN "MULTR"
20600 INTEGER A,B,X,NUM,NA,FC,RIFCT;
20650 STRING S;
20700 IF STAK[SBEG] NEQ 1000012 THEN ERU(-1,SBEG);
20750 RIFCT←0;
20800 NA←0;
20850 SBEG←SBEG+1;
20900 A←STAK[SBEG];
20950 B←STAK[SBEG+1];
21000 WHILE B=1000002 OR B=1000013 DO
21050 BEGIN
21100 IF A<2000000 OR A>2999999 THEN ERU(35,A);
21150 S←TRIM(STR[A-2000000]);
21200 FC←S[1 FOR 1];
21250 IF EQU(S,"SF") THEN NUM←LDB(SFPTR)
21300 ELSE IF EQU(S,"DF") THEN NUM←LDB(DFPTR)
21350 ELSE IF EQU(S,"BA") THEN NUM←LDB(BAPTR)
21400 ELSE IF FC GEQ '60 AND FC LEQ '71 THEN
21450 BEGIN
21500 COMMENT A CONSTANT IS BEING USED;
21550 NUM←VAL(S);
21600 RIFCT←RIFCT+1;
21650 END
21700 ELSE
21750 BEGIN
21800 COMMENT A USER DEFINED NAME IS BEING USED;
21850 RIFCT←RIFCT+1;
21900 NUM←RELSTR(S)-3000000;
21950 IF SYWHAT[NUM] NEQ 2 THEN ERU(35,A);
22000 NUM←SYVAL[NUM];
22050 END;
22100 SBEG←SBEG+2;
22150 NA←NA LOR NUM;
22200 IF B=1000013 THEN DONE;
22250 A←STAK[SBEG];
22300 B←STAK[SBEG+1];
22350 END;
22400 IF NA<0 OR NA>15 THEN ERR(5);
22450 IF RIU>-1 AND RIU NEQ NA THEN ERR(19);
22500 RIU←NA;
22550 IF SORD THEN ERR(19);
22600 IF EMUSED THEN ERR(25);
22650 IF RIFCT >1 THEN ERR(35);
22700 END "MULTR";
22705
22750 PROCEDURE NAM(REFERENCE INTEGER SBEG);
22800 BEGIN "NAM"
22850 STRING S,SA;
22900 INTEGER T,X,PT,N;
22950 COMMENT THIS PROCEDURE DEFINES NAMES;
23000 T←STAK[SBEG];
23050 S←STR[T-2000000] [5 TO INF];
23150 PT←0;
23200 SA←NULL;
23210 X←LOP(S);
23250 WHILE (X<'72 AND X>'57) OR X="'" DO
23300 BEGIN
23350 SA←SA&X;
23360 X←LOP(S);
23450 END;
23460 N←VAL(SA);
23500 S←X&S;
23550 IF N<0 OR N>15 THEN ERR(5);
23600 IF EQU(S[1 TO 4],"HIGH") THEN
23650 BEGIN
23700 PT←1;
23750 S←S[5 TO INF];
23800 END
23850 ELSE IF EQU(S[1 TO 3],"LOW") THEN
23900 BEGIN
23950 PT←2;
24000 S←S[4 TO INF];
24050 END;
24100 T←RELSTR(S)-3000000;
24150 IF SYWHAT[T]>1 THEN ERS(3,S);
24200 SYWHAT[T]←2;
24250 SYVAL[T]←N;
24300 SYTRACE[T]←0;
24350 SYPART[T]←PT;
24400 SBEG←SBEG+2;
24450 END "NAM";
24500
24550 PROCEDURE DPOP;
24600 BEGIN "DPOP"
24650 COMMENT THIS PROCEDURE PERFORMS POPS;
24700 R[SPREG]←R[SPREG]-1;
24750 IF R[SPREG]<0 THEN
24800 BEGIN
24850 R[SPREG]←15;
24900 R[SREG]←ESTAK[R[SPREG]];
24950 ERR(46);
25000 END;
25050 R[SREG]←ESTAK[R[SPREG]];
25100 END "DPOP";
25150
25200 PROCEDURE DPUSH;
25250 BEGIN "DPUSH"
25300 COMMENT THIS PROCEDURE PERFORMS PUSHES;
25325 ESTAK[R[SPREG]]←R[SREG];
25350 R[SPREG]←R[SPREG]+1;
25400 IF R[SPREG]>15 THEN
25450 BEGIN
25500 R[SPREG]←0;
25550 ERR(47);
25600 END;
25650 END "DPUSH";
25700
25750 PROCEDURE TOPOP(INTEGER W);
25800 BEGIN "TOPOP"
25850 COMMENT THIS PROCEDURE DETERMINES WHETHER TO POP THE STACK;
25900 IF NPOP NEQ 0 AND NPOP NEQ W THEN ERR(45);
25950 NPOP←W;
26000 IF NPOP+NPUSH=3 THEN ERR(45);
26050 END "TOPOP";
26100
26150 PROCEDURE TOPUSH(INTEGER W);
26200 BEGIN "TOPUSH"
26250 COMMENT THIS PROCEDURE DETERMINES WHETHER TO PUSH THE STACK;
26300 IF NPUSH NEQ 0 AND NPUSH NEQ W THEN ERR(45);
26350 NPUSH←W;
26400 IF NPUSH+NPOP=3 THEN ERR(45);
26450 END "TOPUSH";
26500
26550 PROCEDURE BARS(REFERENCE INTEGER SBEG);
26600 BEGIN "BARS"
26650 COMMENT THIS PROCEDURE INTERPRETS FIELD SPECIFICATIONS FOR THE SHIFT MASK UNIT;
26700 INTEGER A,B,C,X,SN;
26750 A←15; B←C←0;
26800 IF STAK[SBEG]=1000014 THEN
26850 BEGIN
26900 COMMENT IF THIS SECTION IS NOT USED THEN NO FIELD SPECIFICATION
26950 WAS PRESENT. DEFAULTS ARE USED THEN;
27000 SBEG←SBEG+1;
27050 A←STOI(SBEG);
27100 SBEG←SBEG+1;
27150 IF STAK[SBEG] NEQ 1000011 THEN ERR(31);
27200 SBEG←SBEG+1;
27250 B←STOI(SBEG);
27300 C←-B; COMMENT DEFAULT FOR C IF NOT PRESENT;
27350 SBEG←SBEG+1;
27400 IF STAK[SBEG]=1000009 THEN
27450 BEGIN
27500 COMMENT C IS SPECIFIED;
27550 SBEG←SBEG+1;
27552 SN←0;
27555 IF STAK[SBEG]=1000005 THEN
27560 BEGIN
27565 SN←1; SBEG←SBEG+1;
27570 END
27575 ELSE IF STAK[SBEG]=1000016 THEN
27580 BEGIN
27585 SN←2; SBEG←SBEG+1;
27590 END;
27600 C←STOI(SBEG);
27605 IF SN=1 THEN C←-C
27610 ELSE IF SN=2 THEN C←LNOT C;
27650 SBEG←SBEG+1;
27700 END;
27750 IF STAK[SBEG] NEQ 1000015 THEN ERR(31);
27800 SBEG←SBEG+1;
27850 END;
27900 IF SHIGH>-1 AND SHIGH NEQ A THEN ERR(20) ELSE SHIGH←A;
27950 IF SLOW>-1 AND SLOW NEQ B THEN ERR(20) ELSE SLOW←B;
28000 IF SSHFT>-999 AND SSHFT NEQ C THEN ERR(20) ELSE SSHFT←C;
28050 END "BARS";
24550 PROCEDURE XNAM(REFERENCE INTEGER SBEG);
24600 BEGIN "XNAM"
24650 COMMENT THIS PROCEDURE HANDLES NAME STATEMENTS DURING EXECUTION;
24700 SBEG←SBEG+2;
24750 NULST←1;
24800 END "XNAM";
24850
24900 PROCEDURE CMNT(REFERENCE INTEGER SBEG);
24950 BEGIN "CMNT"
25000 COMMENT THIS PROCEDURE CAUSES THE INTERPRETER TO SKIP OVER THE REST
25050 OF THIS PHRASE OF THE INSTRUCTION;
25100 WHILE STAK[SBEG] NEQ 1000006 AND STAK[SBEG] NEQ 1000007 DO
25150 SBEG←SBEG+1;
25200 SBEG←SBEG+1;
25250 END "CMNT";
25300
25350 PROCEDURE GOT(REFERENCE INTEGER SBEG);
25400 BEGIN "GOT"
25450 STRING S;
25500 INTEGER X,T,SUM;
25550 COMMENT THIS PROCEDURE PROCESSES GOTO STATEMENTS;
25600 GOCT←GOCT+1;
25650 IF GOCT>1 THEN ERR(36);
25700 S←STR[STAK[SBEG]-2000000] [5 TO INF];
25750 T←S[1 TO 1];
25800 IF T>'57 AND T<'72 THEN
25850 BEGIN
25900 COMMENT GOTO ABSOLUTE LOCATION;
25950 SUM←0;
26000 WHILE LENGTH(S)>0 DO
26050 BEGIN
26100 T←LOP(S);
26150 IF T='40 THEN DONE;
26200 IF T<'60 OR T>'71 THEN ERR(4);
26250 SUM←SUM*10-48+T;
26300 END;
26350
26400 JMP←SUM;
26450 END
26500 ELSE
26550 BEGIN
26600 COMMENT GOTO LABEL;
26650 X←RELSTR(S)-3000000;
26700 IF SYWHAT[X] NEQ 5 THEN ERS(9,S);
26750 JMP←SYVAL[X];
26800 END;
26850 SBEG←SBEG+2;
26900 END "GOT";
26950
27300
27350 PROCEDURE RETU(REFERENCE INTEGER SBEG);
27400 BEGIN "RETU"
27425 STRING S;
27450 COMMENT THIS PROCEDURE PROCESSES RETURN STATEMENTS;
27475 RETUSED←RETUSED+1;
27500 NSUB←1;
27550 NTIME←R[SREG];
27560 S←TRIM(STR[STAK[SBEG]-2000000][7 TO INF]);
27570 IF EQU(S,"S") THEN TOPOP(1) ELSE IF EQU(S,"TOS") THEN TOPOP(2) ELSE ERU(43,SBEG);
27600 SBEG←SBEG+2;
27650 END "RETU";
27700
27750 PROCEDURE TST(REFERENCE INTEGER SBEG);
27800 BEGIN "TST"
27850 STRING S,SA,SB;
27900 INTEGER X,A,B,X1;
27950 COMMENT THIS PROCEDURE PROCESSES CASE STATEMENTS;
28000 X←STAK[SBEG];
28050 IF X<2000000 OR X>2999999 THEN ERU(0,X);
28100 S←TRIM(STR[X-2000000]);
28103 IF LENGTH(S)<5 THEN ERR(10);
28106 SA←S[1 TO 4];
28109 SB←S[5 TO INF];
28112 X1←SB[1 FOR 1];
28115 IF X1>'57 AND X1<'72 THEN
28118 BEGIN
28121 COMMENT ABSOLUTE NUMBER USED IN CASE STATEMENT;
28124 NTIME←VAL(SB);
28127 SBEG←SBEG+2;
28130 END
28133 ELSE
28136 BEGIN
28139 COMMENT CASE OF STACK CONTENTS;
28150 IF EQU(S,"CASES") THEN TOPOP(1) ELSE IF EQU(S,"CASETOS") THEN TOPOP(2)
28175 ELSE ERR(10);
28200 SBEG←SBEG+1;
28250 BARS(SBEG);
28300 NTIME←XTR;
28503 END;
28510 TSTUSED←TSTUSED+1;
28550 END "TST";
28600
28650 PROCEDURE BUTS(REFERENCE INTEGER SBEG);
28700 BEGIN "BUTS"
28750 STRING S;
28800 COMMENT THIS PROCEDURE HANDLES BUT STATEMENTS;
28850 S←STR[STAK[SBEG]-2000000] [4 TO INF];
28900 IF NOT EQU(TRIM(S),"10") THEN ERR(11);
28950 IF R[DREG] LAND '177777 =0 THEN NTIME←1 ELSE NTIME←0;
29000 SBEG←SBEG+2;
29050 END "BUTS";
29100
29150 PROCEDURE LABUSE(REFERENCE INTEGER SBEG);
29200 BEGIN "LABUSE"
29250 INTEGER X,Y;
29300 COMMENT THIS PROCEDURE TESTS LABELS FOR TRACE AND BREAKPOINTS;
29350 X←RELNAM(SBEG)-3000000;
29400 IF SYWHAT[X] NEQ 5 THEN ERU(9,SBEG);
29450 IF SYTRACE[X] THEN TRAC(X+3000000);
29500 Y←STAK[SBEG+1];
29550 SBEG←IF Y=1000011 THEN SBEG+2 ELSE IF STAK[SBEG+3] =1000013 THEN SBEG+5 ELSE SBEG+7;
29600 END "LABUSE";
29650
29700 PROCEDURE NOP(REFERENCE INTEGER SBEG);
29750 BEGIN "NOP"
29800 STRING S;
29850 S←TRIM(STR[STAK[SBEG]-2000000]);
29900 IF NOT EQU(S,"NOOP") THEN ERU(0,SBEG);
29950 SBEG←SBEG+2;
30000 END "NOP";
30050
30100 PROCEDURE CLOK(REFERENCE INTEGER SBEG);
30150 BEGIN "CLOK"
30200 COMMENT THIS PROCEDURE HANDLES CLOCK USE. ITS ONLY EFFECT IS TO
30250 ADVANCE TIME BY 1 MICROSECOND;
30300 MFLAG←1;
30350 SBEG←SBEG+2;
30400 END "CLOK";
30450
30500 PROCEDURE UBUS(REFERENCE INTEGER SBEG);
30550 BEGIN "UBUS"
30600 STRING CBUS;
30650 COMMENT THIS PROCEDURE HANDLES USE OF THE UNIBUS;
30700 CBUS←TRIM(STR[STAK[SBEG]-2000000]);
30750 IF EQU(CBUS,"DATI") THEN XBUS←1
30800 ELSE IF EQU(CBUS,"DATIP") THEN XBUS←2
30850 ELSE IF EQU(CBUS,"DATO") THEN XBUS←3
30900 ELSE IF EQU(CBUS,"DATOB") THEN XBUS←4
30950 ELSE ERR(16);
31000 FBUS←1;
31050 SBEG←SBEG+2;
31100 END "UBUS";
31150
31200 PROCEDURE DUN(REFERENCE INTEGER SBEG);
31250 BEGIN "DUN"
31300 STRING S;
31350 COMMENT THIS PROCEDURE HALTS THE INTERPRETER ON ENCOUNTERING AN END STATEMENT;
31400 S←STR[STAK[SBEG]-2000000];
31450 IF NOT (EQU(TRIM(S),"END") OR EQU(TRIM(S),"DONE")) THEN ERR(7);
31500 SBEG←SBEG+2;
31550 OUTSTR("END OF PROGRAM"&CRLF);
31600 NULST←1;
31650 NOTBREAK←0;
31700 END "DUN";
31750
31800 PROCEDURE PSH(REFERENCE INTEGER SBEG);
31850 BEGIN "PSH"
31900 STRING S1,S2,S3;
31950 INTEGER V,T;
32000 COMMENT THIS PROCEDURE PROCESSES PUSH STATEMENTS;
32050 PUSED←PUSED+1;
32100 S1←TRIM(STR[STAK[SBEG]-2000000][5 TO INF]);
32150 S2←S1[INF-1 TO INF];
32200 S3←S1[1 TO INF-2];
32250 T←S1[1 FOR 1];
32300 IF T<'72 AND T>'57 THEN
32350 BEGIN
32400 COMMENT PUSH A CONSTANT;
32450 TOPUSH(1);
32500 PSHV←VAL(S1);
32550 END
33200 ELSE
33250 BEGIN
33300 COMMENT A LABLE IS BEING PUSHED;
33350 T←RELSTR(S1)-3000000;
33400 IF SYWHAT[T] NEQ 5 THEN ERR(44);
33450 PSHV←SYVAL[T];
33500 TOPUSH(1);
33550 END;
33600 SBEG←SBEG+2;
33650 END "PSH";
33700
33750 PROCEDURE SETT(REFERENCE INTEGER SBEG);
33800 BEGIN "SETT"
33825 STRING S1;
33850 COMMENT THIS PROCEDURE PERFORMS SETS TO THE SP REGISTER;
33900 S1←TRIM(STR[STAK[SBEG]-2000000])[8 TO INF];
33950 FORV←VAL(S1);
34000 IF FORV<0 OR FORV>15 THEN ERR(49);
34050 FORR←1;
34055 SBEG←SBEG+2;
34060 SETUSED←SETUSED+1;
34100 END "SETT";
31800 PROCEDURE GRITE(REFERENCE INTEGER SBEG);
31850 BEGIN "GRITE"
31900 INTEGER A,B,K,N,X,P,Q,E,F,SYN2;
31950 STRING S,SS;
32000 COMMENT THIS PROCEDURE HANDLES WRITING OF REGISTERS ON THE DMUX BUS;
32050 SYN2←0;
32100 K←1;
32150 WHILE K DO
32200 BEGIN
32250 A←STAK[SBEG];
32300 IF A NEQ 1000012 THEN
32350 BEGIN
32400 B←STAK[SBEG+1];
32450 IF B NEQ 1000009 AND B NEQ 1000008 THEN ERU(17,B);
32500 IF A<2000000 OR A>2999999 THEN ERU(17,A);
32550 N←RELNAM(A)-3000000;
32600 IF SYWHAT[N] NEQ 2 AND SYWHAT[N] NEQ 3 THEN ERU(18,A);
32650 X←SYVAL[N];
32700 COMMENT DETERMINE WHICH REGISTERS ARE TO BE WRITTEN;
32750 IF X≥0 AND X<16 THEN
32800 BEGIN
32850 COMMENT WRITE INTO A GENERAL REGISTER;
32900 IF RIU>-1 AND RIU NEQ X THEN ERR(19);
32950 IF SORD THEN ERR(19);
33000 IF EMUSED THEN ERR(25);
33050 RIU←X;
33100 CG←1;
33150 GPART←SYPART[N];
33200 USCG←N+3000000;
33250 END
33300 ELSE IF X=BREG THEN CB←1
33350 ELSE IF X=SREG THEN
33355 BEGIN
33360 CS←1;
33365 SS←TRIM(STR[A-2000000]);
33370 IF EQU(SS,"S") THEN TOPUSH(1)
33375 ELSE IF EQU(SS,"TOS") THEN TOPUSH(2)
33380 ELSE ERU(18,A);
33385 END
33400 ELSE IF X=IRREG THEN CIR←1
33450 ELSE IF X=PSREG THEN BEGIN CPS←1; XPSU←XPSU+1; END
33500 ELSE ERU(18,A);
33550 COMMENT STORING INTO S REGISTER MIGHT NOT BE POSSIBLE WITH CERTAIN OTHER ACTIONS **;
33600 SBEG←SBEG+2;
33650 END
33700 ELSE
33750 BEGIN
33800 COMMENT MULTIPLE SPECIFICATIONS ARE BEING USED;
33850 MULTR(SBEG);
33900 CG←1;
33950 GPART←0;
34000 USCG←-1;
34050 B←STAK[SBEG];
34100 SBEG←SBEG+1;
34150 IF B NEQ 1000009 AND B NEQ 1000008 THEN ERU(17,B);
34200 END;
34250 IF B=1000008 THEN K←0;
34300 END;
34350 COMMENT DETERMINE WHAT IS TO BE PUT ONTO THE BUS;
34400 A←STAK[SBEG];
34450 IF A=1000005 OR A=1000016 THEN
34500 BEGIN
34550 COMMENT PUT THE SIGN IN SYN2;
34600 SYN2←A;
34650 SBEG←SBEG+1;
34700 A←STAK[SBEG];
34750 END;
34800 IF A NEQ 1000012 THEN
34850 BEGIN
34900 B←STAK[SBEG+1];
34950 IF A<2000000 OR A>2999999 THEN ERU(17,A);
35000 S←STR[A-2000000];
35050 F←S[1 FOR 1];
35100 IF EQU(TRIM(S),"D") THEN SDMUX←1
35150 ELSE IF EQU(TRIM(S),"BUS") THEN SDMUX←3
35200 ELSE IF (F>'47 AND F<'73) OR NUMEQV(A) THEN
35250 BEGIN
35300 COMMENT THE EMIT IS BEING USED;
35350 E←STOI(A);
35400 IF SYN2=1000005 THEN E←-E
35450 ELSE IF SYN2=1000016 THEN E←LNOT E;
35500 IF EMUSED AND EMV NEQ E THEN ERR(27);
35550 IF SORD NEQ 0 OR RIU>-1 THEN ERR(25);
35600 EMUSED←1;
35650 EMV←E;
35700 SDMUX←4;
35750 IF EMV<LEL OR EMV>LEH THEN ERR(26);
35800 END
35850 ELSE
35900 BEGIN
35950 COMMENT THE CONTENTS OF THE RD BUS ARE TO BE USED;
36000 N←RELNAM(A)-3000000;
36050 IF SYWHAT[N] NEQ 2 AND SYWHAT[N] NEQ 3 THEN ERU(18,A);
36100 X←SYVAL[N];
36150 IF X<16 AND X≥0 THEN
36200 BEGIN
36250 COMMENT ATTEMPT TO READ A GENERAL REGISTER;
36300 IF SYN2 THEN ERU(30,A);
36350 IF SORD THEN ERR(19);
36400 IF EMUSED THEN ERR(25);
36450 IF RIU>-1 AND RIU NEQ X THEN ERR(19);
36500 RIU←X;
36550 SDMUX←4;
36600 COMMENT RIU INDICATES PUT R[RIU] ON VRD;
36650 END
36700 ELSE IF X=SREG THEN
36750 BEGIN
36800 COMMENT ATTEMPT TO READ THE S REGISTER;
36850 IF SYN2 THEN ERU(30,A);
36900 IF RIU>-1 THEN ERR(19);
36950 IF EMUSED THEN ERR(25);
36955 SS←TRIM(S);
36960 IF EQU(SS,"S") THEN TOPOP(1) ELSE TOPOP(2);
37000 SORD←1;
37050 SDMUX←4;
37100 SBEG←SBEG+1;
37150 BARS(SBEG);
37200 B←STAK[SBEG];
37250 SBEG←SBEG-1; COMMENT SBEG OUT OF NORMAL PHASE IN THIS PROCEDURE;
37600 COMMENT SORD INDICATES TO PUT S REGISTER ON THE RD BUS;
37650 END
37655 ELSE IF X=PSREG THEN
37660 BEGIN
37665 COMMENT THE PS REGISTER IS BEING READ;
37670 TXPSU←1;
37675 SDMUX←4;
37680 PSREAD←1;
37685 END
37700 ELSE IF X=SPREG THEN
37703 BEGIN
37706 COMMENT THE STACK POINTER REGISTER IS BEING USED;
37709 SPREAD←1;
37712 SDMUX←4;
37715 END
37718 ELSE ERU(18,A);
37750 END;
37800 IF SDMUX=1 THEN
37850 BEGIN
37900 COMMENT CHECK FOR DIVISION BY 2 BEFORE PUTTING D REGISTER ON THE D BUS;
37950 IF B=1000002 THEN
38000 BEGIN
38050 P←STAK[SBEG+2];
38100 IF P<2000000 OR P>2999999 THEN ERU(17,P);
38150 S←STR[P-2000000];
38200 IF NOT EQU(TRIM(S),"2") THEN ERU(17,P);
38250 SDMUX←2;
38300 SBEG←SBEG+2;
38350 B←STAK[SBEG+1];
38400 END;
38450 END;
38500 SBEG←SBEG+2;
38550 END
38600 ELSE
38650 BEGIN
38700 COMMENT MULTIPLE REGISTER SPECIFICATIONS ARE BEING USED;
38750 MULTR(SBEG);
38800 SDMUX←4;
38850 IF SYN2 THEN ERR(30);
38900 B←STAK[SBEG];
38950 SBEG←SBEG+1;
39000 END;
39050 IF B NEQ 1000007 AND B NEQ 1000006 THEN ERU(17,B);
39100 END "GRITE";
39150
39200 PROCEDURE BADASN(REFERENCE INTEGER SBEG;INTEGER TCBA,SYN);
39250 BEGIN "BADASN"
39300 STRING S,SS;
39350 INTEGER A,B,N,SA,W,P,Q,OPA,ACT,OPB,X,T,BCONU,OPBN,TB;
39400 COMMENT THIS PROCEDURE HANDLES WRITING THE REGISTERS ON
39450 THE OUTPUT OF THE ALU;
39500 IF BDAT>0 THEN ERR(23);
39550 BDAT←1; COMMENT BADASN MAY BE CALLED FROM TWO DIFFERENT PLACES
39600 BUT ONLY ONCE PER INSTRUCTION;
39650 BCONU←0;
39700 CVALD7C←0;
39750 COMMENT GET THE FIRST OPERAND;
39800 A←STAK[SBEG];
39850 B←STAK[SBEG+1];
39900 IF A NEQ 1000012 THEN
39950 BEGIN
40000 IF A<2000000 OR A>2999999 THEN ERU(21,A);
40050 COMMENT CHECK FOR USE OF THE EMIT FIELD;
40100 S←STR[A-2000000];
40150 T←LOP(S);
40200 IF (T>'57 AND T<'72) OR NUMEQV(A) THEN
40250 BEGIN
40300 COMMENT A CONSTANT IS BEING USED;
40350 OPA←STOI(A);
40400 IF SYN=0 AND (OPA=0 OR OPA=1 OR OPA=2) AND (B=1000006 OR B=1000007) THEN
40450 BEGIN
40500 COMMENT IF THE VALUE IS 0 IT CAN COME FROM THE ALU.
40550 IF IT IS 1 OR 2 IT CAN COME FROM THE B CONSTANTS;
40600 RDCLR←1;
40650 OPB←OPA;
40700 BCONU←1;
40750 END
40800 ELSE
40850 BEGIN
40900 COMMENT THE CONSTANT COMES FROM THE EMIT FIELD;
40950 IF EMUSED NEQ 0 AND OPA NEQ EMV THEN ERR(27);
41000 IF SYN=1000005 THEN OPA←-OPA
41050 ELSE IF SYN=1000016 THEN OPA←LNOT OPA;
41100 SYN←0; COMMENT SYN INDICATED A SIGN, NOT AN OPERATION;
41150 IF OPA>LEH OR OPA<LEL THEN ERR(26);
41200 EMUSED←1;
41250 EMV←OPA;
41300 IF SORD NEQ 0 OR RIU>-1 THEN ERR(25);
41350 COMMENT EMIT PROBABLY CANNOT BE USED WITH THE S REGISTER OR A GENERAL REGISTER **;
41400 END;
41450 END
41500 ELSE
41550 BEGIN
41600 COMMENT A REGISTER IS BEING USED;
41650 N←RELNAM(A)-3000000;
41700 IF SYWHAT[N] NEQ 2 AND SYWHAT[N] NEQ 3 THEN ERU(22,A);
41750 W←SYVAL[N];
41800 IF W=SREG THEN
41850 BEGIN
41900 COMMENT THE S REGISTER IS BEING USED;
41950 IF RIU>-1 THEN ERR(19);
42000 IF EMUSED THEN ERR(25);
42050 SORD←1;
42052 SS←TRIM(SYNAME[N]);
42055 IF EQU(SS,"S") THEN TOPOP(1) ELSE TOPOP(2);
42100 SBEG←SBEG+1;
42150 BARS(SBEG);
42200 B←STAK[SBEG];
42250 SBEG←SBEG-1; COMMENT SBEG OUT OF NORMAL PHASE IN THIS ROUTINE;
42600 OPA←XTR;
42650 END
42700 ELSE IF W=PSREG THEN
42750 BEGIN
42800 COMMENT THE PS REGISTER IS BEING USED;
42850 PSREAD←1;
42900 TXPSU←1;
42950 OPA←R[W];
43000 END
43005 ELSE IF W=SPREG THEN
43010 BEGIN
43015 COMMENT THE SPREG IS BEING USED;
43020 SPREAD←1;
43025 OPA←R[W];
43030 END
43050 ELSE IF W≥0 AND W≤15 THEN
43100 BEGIN
43150 COMMENT A GENERAL REGISTER IS BEING USED;
43200 IF SORD THEN ERR(19);
43250 IF EMUSED THEN ERR(25);
43300 IF RIU>-1 AND RIU NEQ W THEN ERR(19);
43350 RIU←W;
43400 OPA←R[W];
43450 END
43500 ELSE IF W=BREG THEN
43550 BEGIN
43600 COMMENT ONLY THE B INPUT TO THE ALU IS USED;
43650 RDCLR←1;
43700 END
43750 ELSE ERR(22);
43800 END;
43850 END
43900 ELSE
43950 BEGIN
44000 COMMENT MULTIPLE REGISTER SPECIFICATIONS BEING USED;
44050 MULTR(SBEG);
44100 OPA←R[RIU];
44150 B←STAK[SBEG];
44200 SBEG←SBEG-1;
44250 END;
44300
44350 IF (B=1000006 OR B=1000007) AND NOT RDCLR THEN
44400 BEGIN
44450 COMMENT THERE IS NO OPERATION TO PERFORM;
44500 SBEG←SBEG+2;
44550 OPA←OPA LAND '177777;
44600 IF SYN=1000005 THEN ERU(40,SYN)
44650 ELSE IF SYN=1000016 THEN OPA←(LNOT OPA) LAND '177777;
44700 ALUOD←XTN(OPA,16);
44750 IF TCBA THEN VFBA←XTN(OPA,15);
44800 SOPA←SOPB←OPA;
44850 END
44900 ELSE IF NOT RDCLR THEN
44950 BEGIN
45000 COMMENT DETERMINE WHICH OPERATOR;
45050 IF SYN THEN ERR(29);
45100 IF (B<1000001 OR B>1000005) AND B NEQ 1000018 THEN ERU(21,B);
45150 ACT←B-1000000;
45200 TB←B;
45250 SBEG←SBEG+2;
45300
45350 COMMENT GET THE SECOND OPERAND;
45400 A←STAK[SBEG];
45450 B←STAK[SBEG+1];
45500 IF A<2000000 OR A>2999999 THEN ERU(21,A);
45550 S←STR[A-2000000];
45600 IF TB=1000018 THEN
45650 BEGIN
45700 COMMENT THE FIRST OPERAND IS TO BE DOUBLED;
45750 IF NOT EQU(TRIM(S),"2") THEN ERU(21,A);
45800 OPB←OPA;
45850 ACT←4;
45900 SBEG←SBEG+2;
45950 END
46000 ELSE IF EQU(TRIM(S),"1") OR EQU(TRIM(S),"2") THEN
46050 BEGIN
46100 COMMENT CONSTANT OPERAND;
46150 OPB←STOI(A);
46200 SBEG←SBEG+2;
46250 END
46300 ELSE IF EQU(TRIM(S),"B") THEN
46350 BEGIN
46400 COMMENT REGISTER B USED AS THE SECOND OPERAND;
46450 SBEG←SBEG+2;
46500 IF B=1000010 THEN
46550 BEGIN
46600 COMMENT INDIVIDUAL BYTES OF B ARE TO BE USED;
46650 SBEG←SBEG+2;
46700 B←STAK[SBEG-1];
46750 X←STAK[SBEG-2];
46800 IF X<2000000 OR X>2999999 THEN ERU(21,X);
46850 S←STR[X-2000000];
46900 SA←LOP(S);
46950 IF SA="H" THEN OPB←R[BREG] LAND '777777777400
47000 ELSE IF SA="L" THEN OPB←XTN(R[BREG]*256,15) LAND '777777777400
47050 ELSE IF SA="E" THEN OPB←XTN(R[BREG],7) LAND '777777777400
47100 ELSE ERU(21,X);
47150 SA←LOP(S);
47200 IF SA="L" THEN OPB←OPB+(R[BREG] LAND '377)
47250 ELSE IF SA="H" THEN OPB←OPB+(R[BREG] DIV 256 LAND '377)
47300 ELSE ERU(21,X);
47350 END;
47400 OPB←R[BREG];
47450 END
47500 ELSE ERU(21,X);
47550
47600 COMMENT PERFORM THE OPERATION;
47650 OPBN←(-OPB) LAND '177777;
47700 OPA←OPA LAND '177777;
47750 OPB←OPB LAND '177777;
47800 IF ((OPA LAND '377)+(OPB LAND '377) > '377 AND ACT=4) OR
47850 ((OPA LAND '377)+(OPBN LAND '377) > '377 AND ACT=5) THEN CVALD7C←1;
47900 SOPA←OPA;
47950 SOPB←IF ACT=5 THEN OPBN ELSE OPB;
48000 CASE ACT OF
48050 BEGIN
48100 [1] X←OPA LAND OPB;
48150 [2] X←OPA LOR OPB;
48200 [3] X←OPA XOR OPB;
48250 [4] X←OPA + OPB;
48300 [5] X←OPA + OPBN
48350 END;
48400
48450 X←X LAND '377777;
48500 COMMENT EXTEND THE SIGN BIT AND PUT THE RESULT ON THE BUSSES;
48550 X←XTN(X,16);
48600 ALUOD←X;
48650 IF TCBA THEN VFBA←XTN(X,15);
48700 END
48750 ELSE
48800 BEGIN
48850 COMMENT THE OUTPUT OF THE ALU IS JUST B;
48900 SBEG←SBEG+2;
48950 IF NOT BCONU THEN OPB←R[BREG] LAND '177777;
49000 IF SYN=1000005 THEN ERU(40,SYN)
49050 ELSE IF SYN=1000016 THEN OPB←(LNOT OPB) LAND '177777;
49100 ALUOD←XTN(OPB,16);
49150 IF TCBA THEN VFBA←XTN(OPB,15);
49200 SOPA←SOPB←OPB;
49250 END;
49300 IF STAK[SBEG-1] NEQ 1000006 AND STAK[SBEG-1] NEQ 1000007 THEN ERR(21);
49350 CVALD15←IF ALUOD LAND '100000 THEN 1 ELSE 0;
49400 SRES←ALUOD;
49450 END "BADASN";
49500
49550 PROCEDURE BAOASN (REFERENCE INTEGER SBEG; INTEGER SYN);
49600 BEGIN "BAOASN"
49650 INTEGER T,P,Q,A,N,X,F,Z,ZV;
49700 STRING S,SS;
49750 COMMENT THIS PROCEDURE HANDLES ASSIGNMENT OT THE BA REGISTER;
49800 Z←0;
49850 COMMENT LOOK FOR AN INDIRECT REGISTER SPECIFICATION;
49900 ZV←STAK[SBEG];
49950 IF ZV=1000012 THEN
50000 WHILE ZV NEQ 1000013 DO
50050 BEGIN
50100 Z←Z+1;
50150 IF ZV=1000006 OR ZV=1000007 THEN ERR(35);
50200 ZV←STAK[SBEG+Z];
50250 END;
50300 T←STAK[SBEG+Z+1];
50350 IF T NEQ 1000007 AND T NEQ 1000006 AND (T NEQ 1000014 OR (STAK[SBEG+6] NEQ 1000007
50400 AND STAK[SBEG+6] NEQ 1000006 AND (STAK[SBEG+8] NEQ 1000015
50425 OR (STAK[SBEG+9] NEQ 1000006 AND STAK[SBEG+9] NEQ 1000007)))) THEN
50450 BEGIN
50500 BADASN(SBEG,1,SYN);
50550 RETURN;
50600 END;
50650 A←STAK[SBEG];
50700 IF A NEQ 1000012 THEN
50750 BEGIN
50800 IF A<2000000 OR A>2999999 THEN ERU(21,A);
50850 S←STR[A-2000000];
50900 F←S[1 FOR 1];
51850 IF (F<'72 AND F>'47) OR NUMEQV(A) THEN
51900 BEGIN
51950 COMMENT THE EMIT FIELD IS BEING USED;
52000 N←STOI(A);
52050 IF SORD NEQ 0 OR RIU>-1 THEN ERR(25);
52100 IF SYN=1000005 THEN N←-N
52150 ELSE IF SYN=1000016 THEN N←LNOT N;
52200 IF EMUSED AND EMV NEQ N THEN ERR(27);
52250 EMV←N;
52300 IF EMV<LEL OR EMV>LEH THEN ERR(26);
52350 EMUSED←1;
52400 END
52450 ELSE
52500 BEGIN
52550 COMMENT A REGISTER IS BEING READ;
52600 N←RELSTR(S)-3000000;
52650 X←SYVAL[N];
52700 IF X=PSREG THEN
52750 BEGIN
52800 COMMENT THE PS REGISTER IS BEING USED;
52850 TXPSU←1;
52900 PSREAD←1;
52950 END
52955 ELSE IF X=SPREG THEN
52960 BEGIN
52965 COMMENT THE SP REGISTER IS USED;
52970 SPREAD←1;
52975 END
53002 ELSE IF X=SREG THEN
53005 BEGIN
53007 COMMENT BA GETS THE OUTPUT OF THE S REGISTER;
53009 IF SYN THEN ERU(-1,SBEG);
53011 IF RIU>-1 THEN ERR(19);
53013 IF EMUSED THEN ERR(25);
53015 SORD←1;
53017 SS←TRIM(S);
53019 IF EQU(SS,"S") THEN TOPOP(1) ELSE TOPOP(2);
53025 SBEG←SBEG+1;
53030 BARS(SBEG);
53035 SBEG←SBEG←1; COMMENT SBEG IS OUT OF NORMAL PHASE IN THIS ROUTINE;
53041 END
53045 ELSE
53050 BEGIN
53100 COMMENT A GENERAL REGISTER IS BEING USED;
53150 IF SYWHAT[N] NEQ 2 THEN ERU(22,A);
53200 IF SYN THEN ERU(-1,SBEG);
53250 IF SORD THEN ERR(19);
53300 IF EMUSED THEN ERR(25);
53350 IF X<0 OR X>15 THEN ERU(22,A);
53400 IF RIU>-1 AND RIU NEQ X THEN ERR(25);
53450 RIU←X;
53500 END;
53550 END;
53600 SBEG←SBEG+2;
53650 END
53700 ELSE
53750 BEGIN
53800 COMMENT MULTIPLE REGISTER SPECIFICATIONS BEING USED;
53850 IF SYN THEN ERU(-1,SBEG);
53900 MULTR(SBEG);
53950 SBEG←SBEG+1;
54000 END;
54050 IF SORD THEN VFBA←XTR
54100 ELSE IF EMUSED THEN VFBA←EMV
54150 ELSE IF PSREAD THEN VFBA←R[PSREG]
54155 ELSE IF SPREAD THEN VFBA←R[SPREG]
54200 ELSE IF RIU>-1 THEN VFBA←R[RIU];
54250 IF STAK[SBEG-1] NEQ 1000006 AND STAK[SBEG-1] NEQ 1000007 THEN ERR(21);
54300 END "BAOASN";
54350
54400 PROCEDURE DBARITE(REFERENCE INTEGER SBEG);
54450 BEGIN "DBARITE"
54500 STRING S;
54550 INTEGER K,A,B,TCBA,TCD,SYN,OPF;
54600 COMMENT THIS PROCEDURE HANDLES WRITING TO THE REGISTERS LOCATED ON THE
54650 RD BUS;
54700 SYN←0;
54750 OPF←0;
54800 K←1;
54850 TCD←TCBA←0;
54900 WHILE K DO
54950 BEGIN
55000 COMMENT DETERMINE WHICH REGISTERS TO WRITE;
55050 A←STAK[SBEG];
55100 B←STAK[SBEG+1];
55150 IF B NEQ 1000009 AND B NEQ 1000008 THEN ERU(21,B);
55200 IF A<2000000 OR A>2999999 THEN ERU(21,A);
55250 S←STR[A-2000000];
55300 IF EQU(TRIM(S),"D")THEN TCD←CD←1
55350 ELSE IF EQU(TRIM(S),"BA") THEN TCBA←CBA←1
55400 ELSE ERU(22,A);
55450 IF B=1000008 THEN K←0;
55500 SBEG←SBEG+2;
55550 END;
55600 IF STAK[SBEG]=1000005 OR STAK[SBEG]=1000016 THEN
55650 BEGIN
55700 COMMENT SYN INDICATES TO COMPLEMENT THE FIRST OPERAND OF THE ALU
55750 EXCEPT WHEN THE EMIT FIELD IS USED. IN THAT CASE, IT IS TAKEN AS THE
55800 SIGN OF THE EMIT FIELD. THIS DISTINCTION IS IMPORTANT BECAUSE
55850 NO OTHER OPERATION CAN OCCUR IN THE ALU WHEN IT COMPLEMENTS THE FIRST
55900 OPERAND;
55950 SYN←STAK[SBEG];
56000 SBEG←SBEG+1;
56050 COMMENT FIND OUT WHETHER SYN IS THE SIGN OF A CONSTANT, OR AN OPERATION;
56100 A←STAK[SBEG];
56150 IF A=1000012 THEN OPF←1 ELSE
56200 BEGIN
56250 IF A<2000000 OR A>2999999 THEN ERU(21,A);
56300 B←STR[A-2000000];
56350 IF B<'60 OR B>'71 THEN OPF←1; COMMENT IT IS AN OPERATION;
56400 END;
56450 END;
56500 IF TCD OR OPF THEN BADASN(SBEG,TCBA,SYN) ELSE BAOASN(SBEG,SYN);
56550 COMMENT TCBA INDICATES THAT BA WAS MENTIONED IN THIS STATEMENT, NOT
56600 ANOTHER STATEMENT THAT JUST HAPPENED TO BE PROCESSED FIRST. TCD INDICATES
56650 THE SAME FOR D;
56700 END "DBARITE";
56750
56800 PROCEDURE STAT(REFERENCE INTEGER SBEG);
56850 BEGIN "STAT"
56900 STRING S;
56950 INTEGER B,X,F,T;
57000 COMMENT THIS PROCEDURE DETERMINES WHICH STATUS BITS TO CLOCK;
57050 XPSU←XPSU+1;
57100 F←B←1;
57150 WHILE B DO
57200 BEGIN
57250 X←STAK[SBEG];
57300 SBEG←SBEG+1;
57350 IF X<2000000 OR X>2999999 THEN ERU(7,X);
57400 S←TRIM(STR[X-2000000]);
57450 IF F THEN S←S[7 TO INF];
57500 F←0; COMMENT THE FIRST TIME THROUGH, 'STATUS' WILL PROCEED THE BIT NAME;
57550 IF EQU(S,"C") THEN VSTAT←VSTAT+1
57600 ELSE IF EQU(S,"N") THEN VSTAT←VSTAT+8
57650 ELSE IF EQU(S,"Z") THEN VSTAT←VSTAT+4
57700 ELSE IF EQU(S,"V") THEN VSTAT←VSTAT+2
57750 ELSE ERS(36,S);
57800 IF STAK[SBEG]=1000006 OR STAK[SBEG]=1000007 THEN B←0
57850 ELSE IF STAK[SBEG] NEQ 1000009 THEN ERR(7);
57900 SBEG←SBEG+1;
57950 END;
58000 IF VSTAT NEQ 1 AND VSTAT NEQ 14 AND VSTAT NEQ 15 THEN ERR(38);
58050 END "STAT";
58100
58150 PROCEDURE SSTAT;
58200 BEGIN "SSTAT"
58250 INTEGER L,M,N,SN,SV,SC,SZ;
58300 COMMENT THIS PROCEDURE CLOCKS THE STATUS BITS;
58350 TSTAT←R[PSREG];
58400 IF VSTAT=14 OR VSTAT=15 THEN
58450 BEGIN
58500 COMMENT CLOCK N,Z,V;
58550 L←SOPA LAND '100000;
58600 M←SOPB LAND '100000;
58650 N←SRES LAND '100000;
58700 IF L=M AND L NEQ N THEN SV←1 ELSE SV←0;
58750 IF SRES LAND '177777=0 THEN SZ←1 ELSE SZ←0;
58800 IF N=0 THEN SN←0 ELSE SN←1;
58850 DPB(SN,NPOS);
58900 DPB(SZ,ZPOS);
58950 DPB(SV,VPOS);
59000 END;
59050 IF VSTAT=1 OR VSTAT=15 THEN
59100 BEGIN
59150 COMMENT CLOCK C;
59200 IF SRES LAND '200000=0 THEN SC←0 ELSE SC←1;
59250 DPB(SC,CPOS);
59350 END;
59400 R[PSREG]←TSTAT;
59450 END "SSTAT";
59500
59550 PROCEDURE DHI(REFERENCE INTEGER SBEG);
59600 BEGIN "DHI"
59650 STRING S;
59700 INTEGER A;
59750 COMMENT THIS PROCEDURE DETERMINES HOW TO SET D(C);
59800 A←STAK[SBEG];
59850 SBEG←SBEG+2;
59900 S←TRIM(STR[A-2000000][6 TO INF]);
59950 IF EQU(S,"C") THEN DOFC←1
60000 ELSE IF EQU(S,"CARRYOUT7") THEN DOFC←2
60050 ELSE IF EQU(S,"15") THEN DOFC←3
60100 ELSE IF EQU(S,"CARRYOUT15") THEN DOFC←0
60150 ELSE ERU(39,A);
60175 CVALC←R[PSREG] LAND '1;
60180 CCOUT←1;
60200 END "DHI";
00050 STRING PROCEDURE PICK(INTEGER F,F2);
00100 BEGIN "PICK"
00150 STRING R,S;
00200 COMMENT THIS PROCEDURE PICKS NAMES OUT OF THE COMMAND LINE;
00250 COMMENT F=TRUE INDICATES "=" IS A VALID TERMINATOR. F2=TRUE
00300 INDICATES "+" IS A VALID TERMINATOR;
00350 R←NULL;
00400 LPLUS←0;
00450 S←LOP(CM);
00500 WHILE NOT (EQU(S,",") OR EQU(S,"$") OR EQU(S,"=") OR EQU(S,"+")) DO
00550 BEGIN
00600 R←R&S;
00650 S←LOP(CM);
00700 END;
00750 IF EQU(S,"$") THEN EOL←1;
00800 IF EQU(S,"+") THEN LPLUS←1;
00850 IF LPLUS AND NOT F2 THEN ERR(32);
00900 IF (F AND NOT (EQU(S,"=") OR EQU(S,"+"))) OR (EQU(S,"=") AND NOT F) THEN ERR(8);
00950 RETURN (R);
01000 END "PICK";
01050
01100 PROCEDURE COMP;
01150 BEGIN "COMP"
01200 STRING B,B8;
01250 INTEGER X,A,N,OFF,PR,P,Q;
01300 COMMENT THIS PROCEDURE PRINTS THE VALUE OF REQUESTED REGISTERS
01350 AND INSTRUCTIONS;
01400 WHILE NOT EOL DO
01450 BEGIN
01500 A←RELSTR(PICK(0,1))-3000000;
01550 X←SYWHAT[A];
01600 OFF←PR←0;
01650 IF X=5 THEN
01655 COMMENT PRINT AN INSTRUCTION;
01700 BEGIN
01750 N←SYVAL[A];
01800 IF LPLUS THEN N←N+(OFF←VAL(PICK(0,0)));
01850 B←PROG[N];
01855 PR←1;
01860 END
01865 ELSE IF X=6 THEN
01870 BEGIN
01872 COMMENT PRINT THE NUMBER SYNONYM OF THIS NAME;
01875 IF LPLUS THEN ERR(32);
01880 B←CVS(SYVAL[A]);
01885 B8←CVOS(SYVAL[A]);
01890 END
01895 ELSE IF X=7 THEN
01900 BEGIN
01905 COMMENT CHECK MAIN MEMORY;
01910 N←SYVAL[A];
01915 IF LPLUS THEN N←N+(OFF←VAL(PICK(0,0)));
01917 IF N<0 OR N>1023 THEN ERR(33);
01920 B←CVS(MM[N DIV 2]);
01925 B8←CVOS(MM[N DIV 2]);
01930 END
01950 ELSE IF X>1 AND X<5 THEN
02000 BEGIN
02050 IF LPLUS THEN ERR(32);
02100 B←CVS(R[SYVAL[A]] );
02150 B8←CVOS(R[SYVAL[A]] LAND '177777);
02200 END
02250 ELSE ERR(13);
02300 IF PR THEN OUTSTR(TRIM(SYNAME[A])&"+"&CVS(OFF)&": "&B&CRLF)
02305 ELSE IF OFF>0 THEN OUTSTR(TRIM(SYNAME[A])&"+"&CVS(OFF)&": "&B&" = "&
02310 B8&"'" &CRLF)
02350 ELSE OUTSTR(TRIM(SYNAME[A])&": "&B&" = "&B8&"'"&CRLF);
02400 END;
02450 END "COMP";
02500
02550 PROCEDURE COMTB(INTEGER V);
02600 BEGIN "COMTB"
02650 INTEGER A;
02700 COMMENT THIS PROCEDURE SETS TRACE AND BREAKPOINT FLAGS;
02750 WHILE NOT EOL DO
02800 BEGIN
02850 A←RELSTR(PICK(0,0))-3000000;
02900 IF SYWHAT[A]=1 THEN ERR(13);
02950 SYTRACE[A]←V;
03000 END;
03050 END "COMTB";
03100
03150 PROCEDURE COMR;
03200 BEGIN "COMR"
03250 INTEGER I;
03300 COMMENT THIS PROCEDURE RESETS ALL TRACE AND BREAKPOINT INFORMATION;
03350 COMMENT A NULL ARGUMENT FIELD MEANS RESET EVERYTHING;
03400 IF EQU(CM,"$") THEN BEGIN FOR I←0 STEP 1 UNTIL SYSIZE DO SYTRACE[I]←0; END
03450 ELSE COMTB(0);
03500 END "COMR";
03550
03600 PROCEDURE COMS;
03650 BEGIN "COMS"
03700 STRING S;
03750 INTEGER X,Y,B,P,N,A,C,V;
03800 COMMENT THIS PROCEDURE ALLOWS THE USER TO SET THE VALUE OF REGISTERS AND
03850 CHANGE THE PROGRAM;
03900 S←PICK(1,1);
03950 X←RELSTR(S)-3000000;
04000 Y←SYWHAT[X];
04050 IF Y=2 OR Y=3 THEN
04100 BEGIN
04150 COMMENT A REGISTER IS TO BE SET;
04200 IF LPLUS THEN ERR(32);
04250 B←SYVAL[X];
04300 P←SYPART[X];
04350 C←0;
04400 IF CM[1 FOR 1] = '55 THEN
04450 BEGIN
04500 C←1;
04550 IF CM[2 FOR 1] = '55 THEN C←2;
04600 CM←CM[C+1 TO INF];
04650 END;
04700 S←PICK(0,0);
04750 A←VAL(S);
04800 IF C=1 THEN A←-A ELSE IF C=2 THEN A← LNOT A;
04850 IF P=1 THEN
04900 BEGIN
04950 COMMENT SET ONLY THE LEFT HALF;
05000 IF A<0 OR A>255 THEN ERR(15);
05050 V←R[B] LAND '377;
05100 IF A>127 THEN A←A LOR '777777777400;
05150 R[B]←V+A*256;
05200 END
05250 ELSE IF P=2 THEN
05300 BEGIN
05350 COMMENT SET ONLY THE RIGHT HALF;
05400 IF A<0 OR A >255 THEN ERR(15);
05450 V←R[B] LAND '777777777400;
05500 R[B]←V+A;
05550 END
05600 ELSE
05650 BEGIN
05700 COMMENT SET THE WHOLE WORD;
05750 IF A<-(2↑15) OR A>2↑15-1 THEN ERR(15);
05800 R[B]←A;
05850 END;
05900 END
05950 ELSE OUTSTR("UNEMPLEMENTED"&CRLF);
06000 END "COMS";
06050
06100 PROCEDURE COME;
06150 BEGIN "COME"
06200 STRING S;
06250 INTEGER I,J;
06300 COMMENT THIS PROCEDURE EXITS THE PROGRAM AND STORES THE FINAL VERSION OF THE PROGRAM IF REQUESTED;
06350 IF CGD THEN
06400 BEGIN
06450 OUTSTR("DO YOU WISH TO SAVE THE FINAL VERSION OF THE PROGRAM (N OR CR)>");
06500 S←INCHWL;
06550 IF NOT EQU(S,"N") THEN
06600 BEGIN
06650 OUTSTR("OUTPUT FILE NAME>");
06700 S←INCHWL;
06750 EOF←FLAG←0;
06800 OPEN(CHFOUT,"DSK",0,0,4,1023,BRCHAR,EOF);
06850 IF EOF THEN ERR(14);
06900 ENTER(CHFOUT,S,FLAG);
06950 IF FLAG THEN ERR(14);
07000 J←100;
07050 FOR I←0 STEP 1 UNTIL PROGCT DO
07100 BEGIN
07150 LINOUT(CHFOUT,J);
07200 OUT(CHFOUT,PROG[I]&CRLF);
07250 J←J+100;
07300 END;
07350 CLOSO(CHFOUT);
07400 END;
07450 END;
07500 FOR I←0 STEP 1 UNTIL PROGCT DO PROG[I]←NULL;
07550 GOTO BP;
07600 END "COME";
07650
07700 PROCEDURE COMG;
07750 BEGIN "COMG"
07800 STRING S; INTEGER GA,GB;
07850 COMMENT THIS PROCEDURE CAUSES THE PROGRAM TO CONTINUE INITIALIZING,
07900 VARIABLES, READING IN THE PROGRAM, OR EXECUTING THE PROGRAM, WHICHEVER IT
07950 WAS DOING WHEN LAST INTERRUPTED;
08000 COMMENT CHECK FOR LABEL;
08050 S←PICK(0,1);
08100 IF NOT EQU(S,NULL) THEN
08150 BEGIN
08200 NULST←1;
08250 NTIME←TTIME←0;
08300 NSUB←TSUB←0;
08350 JMP←-1;
08400 GA←RELSTR(S)-3000000;
08450 IF SYWHAT[GA] NEQ 5 THEN ERR(9);
08500 PC←SYVAL[GA]-1;
08550 IF LPLUS THEN
08600 BEGIN
08650 COMMENT OFFSET SPECIFIED;
08700 S←PICK(0,0);
08750 PC←PC+VAL(S);
08800 END;
08850 END;
08900 IF FAZE>100 THEN FAZE←FAZE-100;
08950 IF FAZE=1 THEN GOTO BP;
09000 IF FAZE=2 THEN GOTO PRGN;
09050 GOTO DIL;
09100 END "COMG";
09150
09200 PROCEDURE COMI;
09250 BEGIN "COMI"
09300 COMMENT THIS PROCEDURE CAUSES THE PROGRAM TO EXECUTE ONE INSTRUCTION
09350 AND THEN HALT;
09400 SNGL←1;
09450 COMG;
09500 END "COMI";
09550
09600 PROCEDURE COMA;
09650 BEGIN "COMA"
09700 COMMENT THIS PROCEDURE CAUSES THE EXECUTION OF THE PROGRAM TO BE
09750 STARTED FROM THE BEGINNING AGAIN;
09800 R[TREG]←0;
09850 PC←-1;
09900 NTIME←TTIME←0;
09950 NSUB←TSUB←0;
10000 NULST←1;
10050 JMP←-1;
10100 COMG;
10150 END "COMA";
00050 COMMENT INITIALIZATION;
00100 BLANKS←" ";
00150 NUMOP←18;
00200 CHFIN←1;
00250 CHFOUT←2;
00300 TABTTY←2;
00350 TABFIN←1;
00400 TABFOUT←3;
00450 SETBREAK(TABFIN,"$",'15&'12&'40&'11&'14,"IAN");
00500 SETBREAK(TABTTY,'12,'15&'40&'11&'14,"INS");
00550 SETBREAK(TABFOUT,NULL,NULL,NULL);
00600 CRLF←'15&'12;
00650 SYSIZE←1023;
00700 NPOS←POINT(1,TSTAT,32);
00750 ZPOS←POINT(1,TSTAT,33);
00800 VPOS←POINT(1,TSTAT,34);
00850 CPOS←POINT(1,TSTAT,35);
00900
00950
01000
01050
01100 BP:FAZE←1;
01150 FOR I←0 STEP 1 UNTIL SYSIZE DO
01200 BEGIN
01250 SYNAME[I]←NULL;
01300 SYWHAT[I]←SYVAL[I]←SYTRACE[I]←SYPART[I]←0;
01350 END;
01400 MMOC←0;
01450 PROGCT←-1;
01500 PC←-1;
01550 NTIME←TTIME←0;
01600 NSUB←TSUB←0;
01650 NULST←1;
01700 JMP←-1;
01750 CGD←0;
01800 DEFCT←0;
01850 LEL←-32768;
01900 LEH←32767;
01950 FOR I←1 STEP 1 UNTIL 8 DO
02000 BEGIN
02050 TS←SREGS[I];
02100 T←RELSTR(TS)-3000000;
02150 SYWHAT[T]←3;
02200 SYVAL[T]←I+15;
02250 IF EQU(TS,"D") THEN BEGIN DREG←I+15; USD←T+3000000 END
02300 ELSE IF EQU(TS,"BA") THEN BEGIN BAREG←I+15; USBA←T+3000000 END
02350 ELSE IF EQU(TS,"B") THEN BEGIN BREG←I+15; USB←T+3000000 END
02400 ELSE IF EQU(TS,"S") THEN BEGIN SREG←I+15; USS←T+3000000 END
02450 ELSE IF EQU(TS,"IR") THEN BEGIN IRREG←I+15; USIR←T+3000000 END
02500 ELSE IF EQU(TS,"PS") THEN BEGIN PSREG←I+15; USPS←T+3000000 END
02525 ELSE IF EQU(TS,"SP") THEN BEGIN SPREG←I+15; USSP←T+3000000 END
02550 ELSE IF EQU(TS,"@TIME@") THEN TREG←I+15;
02600 END;
02601
02603 COMMENT STACK HAS TWO NAMES;
02612 T←RELSTR("TOS")-3000000;
02615 SYWHAT[T]←3;
02618 SYVAL[T]←SREG;
02621
02624
02650 R[TREG]←0;
02675 R[SPREG]←0;
02700 SFPTR←POINT(3,R[IRREG],29);
02750 DFPTR←POINT(3,R[IRREG],35);
02800 BAPTR←POINT(4,R[BAREG],35);
02850 D16PTR←POINT(1,R[DREG],19);
02900
02950 OUTSTR("INPUT FILE NAME=");
03000 FIN←INCHWL;
03050 NOTEND←1;
03100 EOF←FLAG←0;
03150 OPEN(CHFIN,"DSK",0,4,0,1023,BRCHAR,EOF);
03200 IF EOF THEN ERR(14);
03250 LOOKUP(CHFIN,FIN,FLAG);
03300 IF FLAG THEN ERR(14);
03350 FAZE←2;
03400
03450 PRGN:PROGIN;
03500 FAZE←3;
03550 NOTBREAK←0;
03600 SNGL←0;
00050
00100 COMMENT THIS IS THE MAIN INTERPRETIVE LOOP;
00150
00200 DIL:WHILE NOTBREAK DO
00250 BEGIN "DIL"
00300 COMMENT CHECK FOR AN UNCONDITIONAL BRANCH;
00350 IF JMP≥0 THEN PC←JMP ELSE PC←PC+1;
00400 JMP←-1;
00450 COMMENT CHECK FOR A CONDITIONAL BRANCH;
00500 IF TTIME>0 AND NOT TSUB AND NOT NULST THEN
00550 BEGIN
00600 FOR I←0 STEP 1 UNTIL SYSIZE DO IF SYWHAT[I]=5 AND SYVAL[I]=PC
00650 AND SYPART[I]>TTIME THEN GOTO LJMP;
00675 TTIME←0;
00700 ERR(6);
00750 END;
00800 LJMP:PC←PC+TTIME;
00850 IF PC>PROGCT THEN ERR(24);
00900 IF NOT NULST THEN
00950 BEGIN
01000 TTIME←NTIME;
01050 TSUB←NSUB;
01100 NTIME←NSUB←0;
01150 END;
01200
01250 VSTAT←DOFC←XPSU←TXPSU←PSREAD←0;
01300 BDAT←CPS←CG←CD←CBA←CB←CS←CIR←SORD←EMUSED←RDCLR←0;
01350 SDMUX←VDMUX←GPART←ALUOD←VRD←MFLAG←FBUS←NULST←GOCT←0;
01353 PUSED←SETUSED←TSTUSED←FORR←FORV←RETUSED←CCOUT←SPREAD←0;
01356 NPUSH←NPOP←0;
01400 RIU←SHIGH←SLOW←-1;
01425 SSHFT←-999;
01450
01500
01550 IF SNGL THEN OUTSTR("-------- "&PROG[PC]&CRLF);
01600 LEX(PC);
01650 SBEG←0;
01700 WHILE SBEG<TOS DO
01750 BEGIN
01800 A←STAK[SBEG];
01850 B←STAK[SBEG+1];
01900 IF B=1000011 OR B=1000012 THEN LABUSE(SBEG)
01950 ELSE IF A=1000012 THEN GRITE(SBEG)
02000 ELSE IF B=1000009 AND MATCH(A,"STATUS") THEN STAT(SBEG)
02050 ELSE IF B=1000008 OR B=1000009 THEN
02100 BEGIN
02150 IF A<2000000 OR A>2999999 THEN ERR(7);
02200 I←RELNAM(A)-3000000;
02250 IF SYWHAT[I]=3 AND ( SYVAL[I]=DREG OR SYVAL[I]=BAREG) THEN DBARITE(SBEG) ELSE GRITE(SBEG);
02300 END
02350 ELSE IF MATCH(A,"COMMENT") THEN CMNT(SBEG)
02400 ELSE IF B=1000014 THEN TST(SBEG)
02450 ELSE IF B=1000006 OR B=1000007 THEN
02500 BEGIN
02550 IF MATCH(A,"GOTO") THEN GOT(SBEG)
02600 ELSE IF MATCH(A,"PUSH") THEN PSH(SBEG)
02650 ELSE IF MATCH(A,"RETURN") THEN RETU(SBEG)
02700 ELSE IF MATCH(A,"BUT") THEN BUTS(SBEG)
02750 ELSE IF MATCH(A,"CLOCKOFF") THEN CLOK(SBEG)
02800 ELSE IF MATCH(A,"DAT") THEN UBUS(SBEG)
02850 ELSE IF MATCH(A,"NAME") THEN XNAM(SBEG)
02900 ELSE IF MATCH(A,"END") OR MATCH(A,"DONE") THEN DUN(SBEG)
02950 ELSE IF MATCH(A,"NOOP") THEN NOP(SBEG)
03000 ELSE IF MATCH(A,"STATUS") THEN STAT(SBEG)
03050 ELSE IF MATCH(A,"DHIGH") THEN DHI(SBEG)
03055 ELSE IF MATCH(A,"SETSPTO") THEN SETT(SBEG)
03075 ELSE IF MATCH(A,"CASE") THEN TST(SBEG)
03100 ELSE ERR(7);
03150 END
03200 ELSE ERR(7);
03250 END;
03300
03350 COMMENT CHECK FOR ILLEGAL USE OF PS REGISTER;
03400 XPSU←XPSU+TXPSU;
03450 IF XPSU>1 THEN ERR(41);
03500 IF PSREAD AND (SORD OR EMUSED OR RIU>-1) THEN ERR(42);
03505
03510 COMMENT CHECK FOR ILLEGAL USE OF EXTENSIONS;
03515 IF RETUSED>1 OR (RETUSED AND SORD) THEN ERR(48);
03520 IE←IF CS OR SORD OR RETUSED THEN 1 ELSE 0;
03525 IF IE+EMUSED+PUSED+SETUSED+TSTUSED+SPREAD>1 THEN ERR(48);
03530 IF SPREAD AND (SORD OR EMUSED OR RIU>-1 OR PSREAD) THEN ERR(49);
03535 IF CCOUT AND EMUSED THEN ERR(50);
03550
03600 COMMENT WRITE INTO THE REGISTERS;
03650 IF CBA THEN BEGIN R[BAREG]←VFBA; TRAC(USBA) END;
03700
03750 COMMENT D IS A 17 BIT REGISTER AND MUST BE TREATED DIFFERENTLY;
03800 IF CD THEN
03850 BEGIN
03900 R[DREG]←ALUOD;
03950 COMMENT CHECK FOR A SPECIAL USE OF D(C). DEFAULT IS CARRYOUT FROM D15;
04000 IF DOFC THEN CASE DOFC OF
04050 BEGIN
04100 [1] DPB(CVALC,D16PTR);
04150 [2] DPB(CVALD7C,D16PTR);
04200 [3] DPB(CVALD15,D16PTR)
04250 END;
04300 R[DREG]←XTN(R[DREG],16);
04350 TRAC(USD);
04400 END;
04450
04500 IF FBUS THEN
04550 BEGIN
04600 COMMENT PERFORM THE BUS OPERATION;
04650 IF R[BAREG]<0 OR R[BAREG]>1023 THEN ERR(33);
04700 CASE XBUS OF
04750 BEGIN
04800 [1] VBUS←MM[R[BAREG] DIV 2];
04850 [2] VBUS←MM[R[BAREG] DIV 2];
04900 [3] MM[R[BAREG] DIV 2]←XTN(R[DREG],15);
04950 [4] IF R[BAREG] MOD 2 THEN MM[R[BAREG] DIV 2]←(XTN(R[DREG],15) LAND '777777777400)
05000 + (MM[R[BAREG] DIV 2] LAND '377)
05050 ELSE MM[R[BAREG] DIV 2]←(MM[R[BAREG] DIV 2] LAND '777777777400) + (R[DREG] LAND '377)
05100 END;
05150 END;
05200 VRD←IF SORD THEN XTR ELSE IF RIU>-1 THEN R[RIU] ELSE IF
05250 EMUSED THEN EMV ELSE IF PSREAD THEN R[PSREG] ELSE IF SPREAD THEN R[SPREG] ELSE 0;
05255 IF FORR THEN BEGIN R[SPREG]←FORV; R[SREG]←ESTAK[FORV]; TRAC(USSP) END;
05260 COMMENT PERFORM PUSHES OR POPS;
05265 IF NPOP=1 THEN BEGIN DPOP; TRAC(USSP) END;
05270 IF NPUSH=1 THEN BEGIN DPUSH; TRAC(USSP) END;
05300 CASE SDMUX OF
05350 BEGIN
05400 [1] VDMUX←XTN(R[DREG],15);
05450 [2] VDMUX←R[DREG]/2;
05500 [3] VDMUX←VBUS;
05550 [4] VDMUX←VRD
05600 END;
05650 IF CB THEN BEGIN R[BREG]←VDMUX; TRAC(USB) END;
05700 IF CS THEN BEGIN R[SREG]←VDMUX; TRAC(USS) END;
05750 IF CIR THEN BEGIN R[IRREG]←VDMUX; TRAC(USIR) END;
05800 IF CG THEN
05850 BEGIN
05900 COMMENT WRITE INTO A GENERAL REGISTER;
05950 IF GPART=0 THEN R[RIU]←VDMUX
06000 ELSE IF GPART=1 THEN
06050 BEGIN
06100 COMMENT WRITE ONLY THE LEFT HALF;
06150 R[RIU]←(R[RIU] LAND '377) + (VDMUX LAND '777777777400);
06200 END
06250 ELSE
06300 BEGIN
06350 COMMENT WRITE ONLY THE RIGHT HALF;
06400 R[RIU]←(R[RIU] LAND '777777777400) + (VDMUX LAND '377);
06450 END;
06500 IF USCG>-1 THEN TRAC(USCG);
06550 END;
06555
06560 COMMENT PERFORM PUSHES;
06605 IF PUSED THEN
06610 BEGIN
06615 COMMENT CHANGE TOP OF STACK;
06620 R[SREG]←PSHV;
06625 TRAC(USS);
06630 END;
06635
06650 COMMENT CLOCK CONDITION CODES;
06700 IF VSTAT THEN BEGIN SSTAT; TRAC(USPS) END;
06750 IF CPS THEN BEGIN R[PSREG]←VDMUX LAND '357; TRAC(USPS) END;
06800 COMMENT THE T BIT CANNOT BE LOADED FROM THE DMUX. HENCE THE "'357";
06850
06900 COMMENT UPDATE TIME;
06950 IF NOT NULST THEN
07000 BEGIN
07050 IF MFLAG THEN R[TREG]←R[TREG]+1000
07100 ELSE IF CD THEN
07150 BEGIN
07200 IF CB OR CG OR CIR THEN R[TREG]←R[TREG]+300
07250 ELSE R[TREG]←R[TREG]+200
07300 END
07350 ELSE R[TREG]←R[TREG]+140;
07400 END;
07450 COMMENT CHECK FOR SINGLE STEP;
07500 IF SNGL THEN NOTBREAK←0;
07550 COMMENT CHECK FOR HALT COMMAND FROM TTY;
07600 I←INCHRS;
07650 IF I='110 THEN NOTBREAK←0;
07700 END "DIL";
07750
07800
07850
07900 COMMENT THIS SECTION INTERPRETS THE USER'S COMMANDS;
07950 RESTART:NOTBREAK←1;
08000 SNGL←0;
08050 IF FAZE<100 THEN FAZE←FAZE+100;
08100 WHILE 1 DO
08150 BEGIN
08200 OUTSTR(">");
08250 CM←TTYINL(TABTTY,BRCHAR)&"$";
08300 CMA←LOP(CM);
08350 EOL←0;
08400 IF EQU(CMA,"G") THEN COMG
08450 ELSE IF EQU(CMA,"A") THEN COMA
08500 ELSE IF EQU(CMA,"P") THEN COMP
08550 ELSE IF EQU(CMA,"S") THEN COMS
08600 ELSE IF EQU(CMA,"T") THEN COMTB(1)
08650 ELSE IF EQU(CMA,"B") THEN COMTB(2)
08700 ELSE IF EQU(CMA,"E") THEN COME
08750 ELSE IF EQU(CMA,"R") THEN COMR
08800 ELSE IF EQU(CMA,"I") THEN COMI
08850 ELSE ERR(8);
08900 END;
08950 FINE:END "ALL";