Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0002/ptran.sai
There is 1 other file named ptran.sai in the archive. Click here to see a list.
00100	COMMENT HISTORY
00200	AUTHOR,SAIL,REASON
00300	025  401200000070  ;
00400	
00500	
00600	COMMENT 
00700	VERSION 10-4(56) 1-11-74 BY RHT INCREASE EXNO FROM 400 TO 450
00800	VERSION 10-4(55) 12-9-73 BY RHT REQUIRE SCNCMD W/O A PPN
00900	VERSION 10-4(54) 12-2-73 BY JRL SUPPRESS LINOUTS VIA A MACRO HACK
01000	VERSION 10-4(53) 9-23-73 BY HJS ALLOW SPACES AFTER 
01100	VERSION 10-4(52) 8-17-73 BY JRL REMOVE DUPLICATE DEFINITION OF SRC
01200	VERSION 10-4(51) 7-27-73 BY JRL TEMPORARILY LET DEFINE=REDEFINE TO AVOID ERRMSGS
01300	VERSION 10-4(50) 7-15-73 BY JRL INCREASE EXNO TO 400
01400	VERSION 10-4(49) 11-3-72 BY JRL GIVE CLASS TABLE OVERFLOW ERROR MESSAGE
01500	VERSION 10-4(48) 7-31-72 BY DCS SLS CHANGE
01600	VERSION 10-4(47) 7-18-72 BY KUT VANLEHN IS TO INCREASE EXNO
01700	VERSION 10-4(46) 7-18-72 BY KURT VANLEHN IS AS BEFORE SYMNO _ 1290
01800	VERSION 10-4(45) 7-18-72 BY KURT VANLEHN IS THE SAME AS LAST TIME: SYMNO _ 1258
01900	VERSION 10-4(44) 7-18-72 BY KURT VANLEHN TO TRY A DIFFERENT SYMNO
02000	VERSION 10-4(43) 7-18-72 BY KVL INCREASE SYMNO FROM 1200 TO 1282 (1283-1)
02100	VERSION 10-4(42) 7-17-72 BY DCS SYMNO, EXNO GET LARGER
02200	VERSION 10-4(41) 7-8-72 
02300	VERSION 10-4(40) 7-8-72 BY DCS FIX AN SLS THINGIE -- NUMTERM
02400	VERSION 10-4(39) 5-23-72 BY DCS MODIFICATIONS TO SLS BASE STUFF
02500	VERSION 10-4(33-38) 4-27-72 ALL SORTS OF THINGS
02600	VERSION 10-4(28-33) 3-4-72 
02700	VERSION 10-4(8-27) 3-2-72 BY DCS EXEC @n ROUTINE
02800	VERSION 10-4(7) 2-27-72 BY DCS ADD CLASSESCLASSES SPECS, @TERMINAL@RESERVED
02900	VERSION 10-4(6) 2-3-72 BY DCS MERGE WITH SLS VERSION, ADD SLS CONDITIONAL
03000	VERSION 10(5) 1-24-72 BY DCS REMOVE SAILRUN FEATURE
03100	VERSION 10(4) 1-14-72 BY DCS REPLACE CMDSCN.REL WITH SCNCMD.SAI
03200	VERSION 10(3) 12-6-71 NON-TERMINALS INCLUDED IN ITEM DECLARATIONS
03300	VERSION 10(2) 12-5-71 FIX BUG IN CLASS TABLES
03400	VERSION 10(2) 12-5-71 
03500	VERSION 10(1) 12-5-71 PTRAN ISSUES ITEM DEFINITIONS FOR SSAIL
03600	
03700	;
03800	
     
00100	COMMENT Declarations;
00200	
00300	BEGIN "PTRAN"
00400	  DEFINE VERSIONNUMBER = "'401200000070";
00500	  LET DEFINE = REDEFINE;
00600	  DEFINE VERSIONNUMBER = "'401200000062";
00700	 REQUIRE VERSIONNUMBER VERSION;
00800	Comment The Production Translator -- builds tables for the SAIL parser
00900	 to use.  The tables are claimed to be a correct reflection of the input
01000	 file's requests, but no consistency or error checking is done;
01100	
01200	DEFINE SRCEXT="""PTR""", RELEXT="NULL", LSTEXT="NULL",GOODSWT="NULL",
01300		PROCESSOR="""PTRAN""", SRCMODE="0", RELMODE="0", LSTMODE="0";
01400	DEFINE SWTSIZ="2";
01500	REQUIRE "WNTSLS" SOURCEFILE;
01600	REQUIRE "SCNCMD.SAI" SOURCEFILE ;
01700	REQUIRE 7000 STRINGSPACE;
01800	DEFINE
01900	="COMMENT",    SNK="2",      SUB="3",     BREAK="SRCBRK",  SAI="11",
02000	 EOF="SRCEOF",  THROW="1",   NORSCAN="2",  SUPSPC="3",  THROW2="4",
02100	 CR="'15",	TAB = "'11", 
02200	 LF="'12",      CRLF="('15&'12)",	   DELIMNO="10",EXNO="450",
02300	 RESERVED="1",  NONTERM="2", TERMINAL="3", CLASSID="4", EXROT="5",
02400	 ASSGN="6",     BYTLEN="12", BYTENO="3",   PRINTOCT="CVOS",
02500	 ARROW="1",	GOTO="2",   ELSEGO="3",  EXEC="4",   SCAN="5",
02600	 PUSHJ="6",    POPJ="7",   NOTREALLY="8",BASE="9",  OLDBASE="10", NODE="11",
02700	 PRESUME="12",
02800	 SAFER="SAFE ", MAPNO="127", LININC="5",   SYMNO="1290", CLSNO="72", PDNO="30",
02900	 NULSTR(A)="LENGTH(A)=0",    PRINT="OUTSTR(",MSG="&CRLF)",
03000	 ERRIT(X)="BEGIN USERERR(0,1, ""PSEUDO OP ""&""X""&"" MISSING "");GO ERROREND END";
03100	
03200	 This macro decides whether numeric (fast) or symbolic (readable)
03300	 versions of things will be given to FAIL. Use MAKSYM for symbolic;
03400	DEFINE PRINTSYMBOL(X)="CVOS(NUMBER[X])";
03500	
03600	 Currently (11-73) SOS style line numbers are not desired. If in the
03700	  future they are once again desired, remove the following macro definition;
03800	
03900	DEFINE LINOUT(A,B)="";
04000	
04100	
04200	INTEGER CURDELIM,DELIMSTACK,ON,LABCNT,ERRFLAG,COWNT,SUBCNT,SCANE,COMMAND,
04300	 CLASSTYPE,SYMBOL,NEXTFREE,FOUND,LINENO,BYTE,EXCNT,CLASSNO,Z,DPUSHJ,DPOPJ,DPRESUME,
04400	 COWNTC,R,II,OLDBASEFLAG, WHATKIND, NUMTERM;
04500	STRING ALAB,LAB,WORD,HALSTR,TS,SYMMM,SAISTR;
04600	
04700	SAFER INTEGER ARRAY FIRCLS[1:CLSNO],   NUMCLS[1:CLSNO], NUMSYM[1:SYMNO],
04800		NUMEX[1:EXNO],  SYMD[0:MAPNO], DELIMS[1:DELIMNO],
04900		PRODI[1:PDNO],  TYPE,  CLASS,  CLASS2,  NUMBER[-1:SYMNO];
05000	
05100	SAFER STRING ARRAY PROD[1:PDNO],SYM[-1:SYMNO];
05200	
     
00100	COMMENT Initialization,  Lookup, Entersym, Subequ;
00200	
00300	BOOLEAN PROCEDURE SUBEQU(STRING I,O);
00400	   RETURN(LENGTH(O)LENGTH(I)  EQU(I,O[1 FOR LENGTH(I)]));
00500	
00600	 INITIALIZATION OF THE WORLD, BREAK TABLES,
00700		I/O DEVICES, CONSTANTS.;
00800	
00900	PROCEDURE INITIALIZATION;
01000	BEGIN  INTEGER T3;
01100		SETBREAK(NORSCAN," "&TAB&LF,CR&'14,"IRN");
01200		SETBREAK(SUPSPC," "&TAB,CR&'14,"XRN");
01300		SETBREAK(THROW,LF&'14,NULL,"IN");
01400		SETBREAK(THROW2,LF&'14,NULL,"IRN");
01500	
01600		NXTFIL_FALSE;	WANTBIN_TRUE;
01700		COMMANDSCAN;
01800		OPEN(SUB,"DSK",0,0,2,0,T3,T3);
01900		WHILE T3 ":" DO T3_LOP(BINFIL);
02000		ENTER(SUB,BINFIL&"QQQ",T3);
02100		IF (NOT WANTBIN) OR T3 THEN USERERR(0,0,"OUTPUT ENTRY ERROR");
02200	        IF SLS THEN BEGIN
02300		  OPEN(SAI,"DSK",0,0,2,0,T3,T3);
02400		  ENTER(SAI,BINFIL&"SAI",T3);
02500		  IF T3 THEN USERERR(0,0,"OUTPUT ENTRY ERROR");
02600		  OUT(SAI,"INTEGER ITEM "&CRLF);
02700		  SAISTR_ "DEFINE "&CRLF
02800		END;
02900		TS_INPUT(SRC,THROW);
03000		IF SUBEQU("COMMENT ",TS) THEN
03100		  WHILE SRCBRK'14 DO TS_INPUT(SRC,THROW);
03200	
03300	
03400	ON_EXCNT_BYTE_1;
03500	ERRFLAG_DELIMSTACK_CURDELIM_COMMAND_EOF_0;
03600	COWNT_IF SLS THEN 8 ELSE 0;
03700			 "START TOKEN NUMBERING AT FIRST ITEM NUMBER"
03800	NEXTFREE_SYMNO;
03900	SUBCNT_LINENO_LININC;
04000	SYM[0]_"                 ";
04100	 HALSTR_"	BYTE ("&CVS(BYTLEN)&") ";
04200	
04300	END ;
04400	
04500	
04600	INTEGER PROCEDURE LOOKUP(STRING A);
04700	BEGIN "LOOKUP"
04800	Comment uses Quadratic Search Algorithm as described in CACM ------;
04900	 INTEGER H,Q;
05000	 DEFINE SCON="10";
05100	
05200	 H_CVASC(A) +LENGTH(A) LSH 6;
05300	 R_SYMBOL_(H_ABS(H(H LSH 2))) MOD (SYMNO+1);
05400	
05500	 IF EQU(SYM[SYMBOL],A) THEN RETURN(-1);
05600	 IF NULSTR(SYM[SYMBOL]) THEN  RETURN(0); 
05700	
05800	 Q_H%(SYMNO+1) MOD (SYMNO+1);
05900	 IF (H_Q+SCON)SYMNO THEN H_H-SYMNO;
06000	
06100	 WHILE (IF (SYMBOL_SYMBOL+H)>SYMNO
06200	     THEN SYMBOL_SYMBOL-(SYMNO+1) ELSE SYMBOL)	R   DO
06300	     BEGIN "LK1"
06400		IF EQU(SYM[SYMBOL],A) THEN RETURN(-1);
06500		IF NULSTR(SYM[SYMBOL]) THEN RETURN(0);
06600		IF (H_H+Q)>SYMNO THEN H_H-(SYMNO+1);
06700	     END "LK1";
06800	 SYMBOL_-1; RETURN(0);
06900	END "LOOKUP";
07000	
07100	
07200	 Enter symbol in table.  Always enters the word previously scanned by 
07300	 GETWORD. "SYMBOL" is the index (from LOOKUP) into SYM, NUMBER, TYPE;
07400	
07500	PROCEDURE ENTERSYM;
07600	BEGIN "ENTERSYM"
07700		IF LENGTH(SYM[SYMBOL])SYMBOL<0 THEN
07800		BEGIN
07900		  ERRFLAG_1;
08000		  IF SYMBOL0 THEN PRINT "DUPLICATE SYMBOL "&WORD MSG
08100			ELSE PRINT "SYMBOL TABLE FULL" MSG
08200		END;
08300		SYM[SYMBOL]_WORD;
08400	END "ENTERSYM";
08500	
08600	
     
00100	COMMENT Pton, Printroom, Halword, Maksym;
00200	
00300	 Routines to write line of code to output file.  Generates SOS line
00400	 numbers. REALOUTPUT=0 disables them.  Many routines are used in place
00500	 of concatenation for speed;
00600	
00700	PROCEDURE PTO(STRING A);
00800	BEGIN 	LINOUT(SNK,LINENO);LINENO_LINENO+1;OUT(SNK,A) END "PTO";
00900	PROCEDURE PTO1(STRING A);
01000	BEGIN OUT(SNK,A);OUT(SNK,CRLF);END "PTO1";
01100	PROCEDURE PTO2(STRING A,B);
01200	BEGIN OUT(SNK,A);PTO1(B) END "PTO2";
01300	PROCEDURE PTO3(STRING A,B,C);
01400	BEGIN OUT(SNK,A); PTO2(B,C) END "PTO3";
01500	PROCEDURE PTO4(STRING A,B,C,D);
01600	BEGIN OUT(SNK,A); PTO3(B,C,D) END "PTO4";
01700	PROCEDURE PUTOUT(STRING A);
01800	BEGIN PTO(A); OUT(SNK,CRLF) END "PUTOUT";
01900	PROCEDURE PTO2(STRING A,B);
02000	BEGIN PTO(A); PTO1(B) END "PTO2";
02100	PROCEDURE PTO3(STRING A,B,C);
02200	BEGIN PTO(A); PTO2(B,C) END "PTO3";
02300	PROCEDURE PTO4(STRING A,B,C,D);
02400	BEGIN PTO(A); PTO3(B,C,D) END "PTO4";
02500	
02600	
02700	PROCEDURE PRINTROOM;
02800	BEGIN PUTOUT(NULL); PUTOUT(NULL) END;
02900	
03000	PROCEDURE HALWORD(STRING A);
03100	BEGIN "HALWORD"
03200	  IF BYTE=1 THEN PTO(HALSTR);
03300	  OUT(SNK,A);
03400	  IF (BYTE_BYTE+1)BYTENO THEN
03500		OUT(SNK,", ") ELSE 
03600	  BEGIN OUT(SNK,CRLF); BYTE_1 END
03700	END "HALWORD";
03800	
03900	 This procedure transforms an internal symbol into a symbolic one 
04000	 for FAIL.  It assures the symbols are 6 characters long, and that
04100	 they have the appropriate type (R, N, T) prefix;
04200	
04300	PROCEDURE MAKSYM (INTEGER I);
04400	BEGIN "MAKSYM"
04500		STRING A; INTEGER T;
04600		IF (A_SYM[I])="@" THEN T_LOP(A);
04700		OUT(SNK,I_CASE TYPE[I] OF ("","R","N","T","C"));
04800		OUT(SNK,A[1 TO 5]);
04900		SYMMM_I&A;
05000	END "MAKSYM";
05100	
     
00100	COMMENT Assign, Classout;
00200	
00300	 Assign gives internal numbers to all symbols.  It first assigns symbols
00400	 which are members of classes, so that the class-indexing EXEC stuff works.
00500	 Then it assigns numbers to all others.  Finally it puts out "XXX__nnnn" for
00600	 each symbol, telling FAIL what the values are;
00700	
00800	PROCEDURE ASSIGN;
00900	BEGIN "ASSIGN" INTEGER I,B;
01000	  STRING A;
01100	
01200	  PROCEDURE CLASSOUT (INTEGER Z);
01300	  FOR B_(IF SLS THEN 9 ELSE 1) STEP 1 UNTIL COWNT DO BEGIN "CLASSOUT"
01400	    I_NUMSYM[B];
01500	       PTO4("	",PRINTOCT(IF Z THEN CLASS[I] ELSE CLASS2[I]),
01600		"	;",SYM[I])
01700	  END "CLASSOUT";
01800	
01900	  PUTOUT (";CLASSES, BITS");
02000	  FOR B_1 STEP 1 UNTIL COWNTC DO
02100		PUTOUT("; "&CVS(B)&"	"&SYM[NUMCLS[B]]&"	"&CVOS(
02200			1 LSH (B-(IF B36 THEN 1 ELSE 37))));
02300	  PRINTROOM;
02400	  PRINTROOM;
02500	  
02600	  PUTOUT (";	CLASS INDEX TABLE" );
02700	  PUTOUT ("CLSTAB:	0");
02800	  IF SLS THEN PUTOUT ("00000000"); COMMENT NO TOKENS UNTIL 9;
02900	  CLASSOUT (TRUE);
03000	  PUTOUT((IF SLS THEN "^" ELSE NULL)&"CLASSNO _ .-CLSTAB");
03100	  IF COWNTC>36 THEN BEGIN "ASG1"
03200	    PUTOUT("CLSTA2:	0");
03300	    CLASSOUT(FALSE);
03400	  END "ASG1";
03500	
03600	 NOW ASSIGN ALL OTHERS;
03700	
03800	  FOR I _ 1 STEP 1 UNTIL SYMNO DO BEGIN "ALLOTH" 
03900	    IF LENGTH(SYM[I])NUMBER[I]=00<TYPE[I]<ASSGN THEN BEGIN
04000	      COWNT _ COWNT + 1;
04100	      NUMBER [I] _ COWNT;
04200	      NUMSYM[COWNT]_I
04300	    END; 
04400	  END "ALLOTH";
04500	
04600	 NOW OUTPUT SYMBOLIC ASSIGNMENTS;
04700	
04800	  PUTOUT (";	SYMBOLIC ASSIGNMENTS");
04900	  FOR B_(IF SLS THEN 9 ELSE 1) STEP 1 UNTIL COWNT DO 
05000	  IF TYPE[I_NUMSYM[B]]=TERMINAL THEN
05100	  BEGIN
05200	     NUMTERM_NUMBER[I];
05300	     PTO("^");
05400	     MAKSYM(I);
05500	     PTO4("__",IF CLASS[I]CLASS2[I] THEN "CLASOP" ELSE "OPER",
05600		     "+",PRINTOCT(NUMBER[I]));
05700	    IF SLS THEN BEGIN
05800		OUT(SAI,"   "&SYMMM&","&CRLF);
05900		SAISTR_SAISTR&"  OP"&SYMMM[2 TO ]&" = ""'"&PRINTOCT(NUMBER[I])&
06000		   ""","&CRLF
06100	    END
06200	  END
06300	  ELSE BEGIN
06400	      NUMTERM_NUMBER[I];
06500	      PTO(IF SLS THEN "^" ELSE NULL);
06600	      MAKSYM(I);
06700	      PTO2("__",PRINTOCT(NUMBER[I]));
06800	      IF SLS THEN BEGIN
06900		OUT(SAI,"   "&SYMMM&","&CRLF);
07000		SAISTR_SAISTR&"  OP"&SYMMM[2 TO ]&" = ""'"&PRINTOCT(NUMBER[I])&
07100		    ""","&CRLF
07200	      END
07300	  END;
07400	
07500	  PRINTROOM;
07600	
07700	  LINOUT(SUB,SUBCNT_SUBCNT+LININC);
07800	  OUT(SUB,"	<SCAN TABLE>"&CRLF);
07900	  FOR B_1 STEP 1 UNTIL MAPNO DO
08000	    IF (I_SYMD[B])TYPE[I]=TERMINAL THEN BEGIN "TOUT2"
08100	      LINOUT(SUB,SUBCNT_SUBCNT+LININC);
08200	      OUT(SUB,CVS(B)&"  "&CVS(NUMBER[I]));
08300	      OUT(SUB,(IF CLASS[I]  CLASS2[I] THEN "  C" ELSE "  N")&CRLF);
08400	    END "TOUT2"; 
08500	
08600	 SYMBOL TABLE ENTRIES FOR ALL RESERVEDS;
08700	
08800	  LINOUT(SUB,SUBCNT_SUBCNT+LININC);
08900	  OUT(SUB,"	<RESERVED-WORDS>"&CRLF);
09000	  PUTOUT(";	SYMBOL TABLE ENTRIES");
09100	
09200	  FOR I _ 1 STEP 1 UNTIL SYMNO DO
09300	    IF TYPE[I]=RESERVED THEN BEGIN "RES2" 
09400	      PTO(";	");
09500	      MAKSYM(I);
09600	      PTO4("  ",PRINTOCT(NUMBER[I]),"	",SYM[I]);
09700	      LINOUT(SUB,SUBCNT_SUBCNT+LININC);
09800	      OUT(SUB,SYM[I]&"	"&PRINTOCT(NUMBER[I])&
09900		"	"&(IF CLASS[I]  CLASS2[I] THEN "C" ELSE "N")&CRLF);
10000	    END "RES2"; 
10100	  PUTOUT("	LSTON(PRODS)");
10200	  RELEASE (SUB);
10300	END "ASSIGN";
10400	
     
00100	COMMENT Searchit, Gword;
00200	
00300	 Searchit Checks its argument for special features (EXEC, SCAN, , etc.)
00400	  then looks it up if not special.  FOUND, CLASSTYPE, and COMMAND are 
00500	  set to reflect the result;
00600	
00700	PROCEDURE SEARCHIT(STRING A);
00800	BEGIN "SEARCHIT"
00900	   INTEGER CHAR,L,I;
01000	   COMMAND_CLASSTYPE_FOUND_0;   CHAR_A;
01100	   IF (L_LENGTH(A))=1  (I_SYMD[CHAR]) THEN BEGIN "SRCH1"
01200	     SYMBOL_I;  A_WORD_SYM[I];    FOUND_-1;
01300	     RETURN
01400	   END "SRCH1";
01500	   IF (L_LENGTH(A)>1) THEN 
01600	     IF CHAR="@" THEN CLASSTYPE_1  ELSE
01700	     IF CHAR="" THEN FOUND_ARROW ELSE
01800	     IF CHAR="" THEN FOUND_GOTO ELSE
01900	     IF CHAR="#" THEN FOUND_ELSEGO ELSE
02000	     IF EQU(A,"EXEC") THEN FOUND_EXEC ELSE
02100	     IF EQU(A,"SCAN") THEN FOUND_SCAN ELSE
02200	     IF EQU(A,"PRESUME") THEN FOUND_PRESUME ELSE
02300	     IF CHAR="^" THEN FOUND_PUSHJ ELSE
02400	     IF CHAR="" THEN FOUND_POPJ ELSE
02500	     IF CHAR="<" THEN COMMAND_1 ELSE
02600	     IF CHAR="*"  CHAR="" THEN FOUND_NOTREALLY ELSE
02700	   IF SLS THEN 
02800	     IF SUBEQU("BASE",A) THEN FOUND_BASE ELSE
02900	     IF EQU(A,"OLDBASE") THEN FOUND_OLDBASE ELSE
03000	     IF EQU(A,"NODES") THEN FOUND_NODE
03100	   ;
03200	   IF (FOUND  COMMAND) THEN BEGIN "SRCH3" 
03300	      IF L>1EQU(A[1 FOR 2],"SG") THEN RETURN;
03400	      FOUND_LOOKUP(A);
03500	   END "SRCH3";
03600	END "SEARCHIT";
03700	
03800	 This is the procedure which looks at the source file, returning one
03900	 word at a time, using standard delimiters.  It tries to type the word 
04000	 as "COMMAND", "JUMPTYPE", "LABELTYPE", or "CLASSTYPE".  The prefixes
04100	 expected for these types are <  : @.  At the end of a line, GETWORD
04200	 returns NULL.  It does a symbol LOOKUP.  If FOUND is nonzero, the symbol
04300	 was found or represents a special kind of thing (SCAN, EXEC, etc.) Symbol
04400	 contains the appropriate symbol table index if FOUND<0;
04500	
04600	RECURSIVE STRING PROCEDURE GWORD;
04700	BEGIN	"GWORD"STRING A;
04800	
04900	   PROCEDURE PROCESS(INTEGER I);
05000	   BEGIN "PROCESS" 
05100	     SEARCHIT(GWORD);	 GET AN IDENTIFIER;
05200	     IF FOUND  TYPE[SYMBOL]  ASSGN THEN BEGIN
05300	       PRINT "INVALID CONDITIONAL SWITCH" MSG;
05400	       Z_0
05500	     END ELSE Z_NUMBER[SYMBOL];
05600	     DELIMS[DELIMSTACK_DELIMSTACK+1]_CURDELIM;
05700	     CURDELIM_GWORD;	 DELIMITER ;
05800	     ON_(IF (IZON)  (IZON) THEN 1 ELSE 0);
05900	     IF ON THEN BEGIN
06000	       DO BEGIN "GW1" A_GWORD END UNTIL LENGTH(A)=1 AND A=CURDELIM ;
06100	       CURDELIM_DELIMS[DELIMSTACK];DELIMSTACK_DELIMSTACK-1;
06200	       ON _ 1;
06300	     END
06400	   END "PROCESS";
06500	
06600		WORD _ INPUT(SRC,SUPSPC);
06700		IF BREAK=LF THEN BEGIN
06800		  WORD_INPUT(SRC,THROW);
06900		  RETURN(NULL);
07000		END;
07100		A_WORD _ INPUT(SRC,NORSCAN);
07200	
07300		IF LENGTH(WORD)=6 AND EQU(WORD,"MUMBLE") THEN BEGIN
07400		  WHILE WORD";"  EQU(WORD[ FOR 1],";")=0 DO
07500		     DO A_GWORD UNTIL LENGTH(A);
07600		     A_GWORD
07700		END;
07800	
07900		IF WORD="" THEN BEGIN
08000			IF EQU(A,"") THEN BEGIN  LINE CONTINUATION;
08100				INPUT(SRC,THROW2);
08200				A_GWORD;
08300				RETURN(GWORD);
08400			END ELSE
08500			IF EQU(A,"ASG") THEN BEGIN  ASSIGN A COMPILATION VARB ;
08600				SEARCHIT(GWORD);  IDENTIFIER ;
08700				IF  FOUND THEN BEGIN
08800					ENTERSYM;
08900					TYPE[SYMBOL]_ASSGN;
09000				END;
09100				IF TYPE[SYMBOL]ASSGN THEN PRINT "INVALID CONDITIONAL VARIABLE" MSG;
09200				NUMBER[SYMBOL]_CVD(GWORD);
09300			END ELSE
09400			IF EQU(A,"IFE") THEN BEGIN
09500				PROCESS (0);
09600				RETURN (GWORD);
09700			END ELSE 
09800			IF EQU(A,"IFN") THEN BEGIN
09900				PROCESS (1);
10000				RETURN (GWORD);
10100			END;
10200		END;
10300		IF ON AND LENGTH(WORD)=1  WORD=CURDELIM THEN BEGIN "GW4" 
10400			CURDELIM_DELIMS[DELIMSTACK];DELIMSTACK_DELIMSTACK-1;
10500			RETURN (GWORD);
10600		END "GW4";
10700		IF LENGTH(WORD)>1  WORD[LENGTH(WORD) FOR 1]=":" THEN BEGIN "GW5" 
10800			PTO2((LAB_WORD[1 FOR LENGTH(WORD)-1]),"_.+FTDEBUG");
10900			LABCNT_0;ALAB_NULL;
11000			RETURN(GWORD);
11100		END "GW5";
11200		RETURN (WORD);
11300	END;
11400	
     
00100	COMMENT Getword, GetGoodWord, Compile, Map;
00200	
00300	 NOW FOR THE PROCEDURES WHICH ARE ACTUALLY USED BY THE POOR USERS;
00400	
00500	STRING PROCEDURE GETWORD;
00600	BEGIN "GETWORD" 
00700		WORD_GWORD;
00800		IF LENGTH(WORD) THEN SEARCHIT(WORD);
00900		RETURN (WORD);
01000	END "GETWORD";
01100	
01200	STRING PROCEDURE GETGOODWORD;
01300	BEGIN "GETGOODWORD" 
01400	 DO WORD_GETWORD UNTIL LENGTH(WORD);
01500	 RETURN(WORD);
01600	END "GETGOODWORD";
01700	
01800	
01900	 This makes (internal PTRAN) symbol tables of the simple variety;
02000	
02100	PROCEDURE COMPILE (INTEGER A);
02200	BEGIN "COMPILE"
02300		STRING AA;
02400		DO BEGIN "CMP1" 
02500		AA_GETGOODWORD;
02600		IF COMMAND=0 THEN BEGIN "CMP2" 
02700		IF FOUND<0TYPE[SYMBOL]0 THEN PRINT "DUPLICATE SYMBOL "&AA MSG;
02800		IF FOUND>0 THEN PRINT "IMMORAL SYMBOL "&AA MSG;
02900		IF FOUND THEN ENTERSYM;
03000		TYPE[SYMBOL]_A;
03100		END; END UNTIL COMMAND;
03200	END "COMPILE";
03300	
03400	 MAP inputs the symbol mapping information.  Symbols like +, -, etc. are
03500	 given names which FAIL will accept;
03600	
03700	PROCEDURE MAP;
03800	BEGIN "MAP" STRING A; 
03900		DO BEGIN "MP1" 
04000		A_GETGOODWORD;
04100		IF COMMAND=0 THEN BEGIN "MP2" 
04200			GETGOODWORD;
04300			ENTERSYM;
04400			SYMD[A]_SYMBOL
04500		END "MP2"; 
04600	     END "MP1" UNTIL COMMAND;
04700	END "MAP";
04800	
04900	PROCEDURE LISTR(INTEGER ARRAY AA;INTEGER BB;STRING CC; INTEGER DD);
05000	BEGIN "LISTR"
05100	  INTEGER I,J;
05200	  FOR J_1 STEP 1 UNTIL BB DO BEGIN "LS1"
05300	    I_AA[J];
05400	     PTO(CC);
05500	     IF DD=1 THEN MAKSYM(I) ELSE
05600	     IF DD=2 THEN OUT(SNK,(SYM[I]&"      ")[1 FOR 6]) ELSE
05700	     OUT(SNK,SYM[I]);
05800	     IF DD=0 THEN OUT(SNK,CRLF) ELSE PTO1("/");
05900	  END "LS1"
06000	END "LISTR";
06100	
     
00100	COMMENT Prodscan, Endcheck;
00200	
00300	 PRODSCAN
00400	This procedure scans the productions and creates the byte tables.  It is
00500	   called with a valid "WORD".  For each line, it:
00600	 1. Assembles all the words (and symbol entry #s) into "PROD" AND "PRODI"
00700	     keeping track of words like "EXEC", "SCAN"	etc.
00800	 2. Puts out (right to left) code for the compare portion of the production.
00900	 3. Issues tree node descriptions based on BASE and NODE specs (SLS only).
01000	 4. Puts out calls to the executive routines.
01100	 5. Tries to match right with left parts and put out correct stack-restoring code.
01200	 6. Specifies number of SCANNER calls.
01300	;
01400	
01500	PROCEDURE PRODSCAN;
01600	BEGIN "PRODSCAN" INTEGER FAILFLG,LEFTEND,RIGHTEND,EXECEND,SUCCEED,I,J,K,C,D,B,EXF;
01700	STRING A;  INTEGER EXTRA,ARSEEN,BASELOC,NODEND;
01800	
01900	   PROCEDURE ENDCHECK(INTEGER ILEV);
02000	   BEGIN "ENDCHECK"
02100	     This procedure sets the pointers to interesting places in the PROD list.
02200		LEFTEND (last left side token) and RIGHTEND (last right side token)
02300		 are always set. Then if LEFTEND=RIGHTEND (no right part), the right
02400		 part is copied from the left part (no reduction occurs).  Finally,
02500		NODEND and/or EXECEND are set if requested and necessary;
02600	
02700	      IF LEFTEND THEN LEFTEND_K; IF RIGHTEND THEN RIGHTEND_K;
02800	      IF ARSEENLEFTEND=RIGHTEND THEN
02900	        FOR II _ 1 STEP 1 UNTIL LEFTEND DO BEGIN "CHECKARROW"
03000		   PROD[RIGHTEND_K_K+1] _ PROD[II];
03100		   PRODI[K] _ PRODI[II]
03200	        END "CHECKARROW";
03300	   
03400	      IF ILEV>0NODEND THEN NODEND_K;
03500	      IF ILEV>1EXECEND THEN EXECEND_K
03600	   END "ENDCHECK";
03700	
     
00100	COMMENT Prodscan, Assemble;
00200	
00300	PROCEDURE ASSEMBLE;
00400	BEGIN "ASSEMBLE"
00500	   LABEL MORE,BLAB;
00600	   EXF_1;  A _ WORD;
00700	   DPUSHJ_DPOPJ_K_EXTRA_ARSEEN_FAILFLG_LEFTEND_RIGHTEND_EXECEND_SUCCEED_SCANE
00800	    _BASELOC_NODEND_OLDBASEFLAG_DPRESUME_0;
00900	   WHILE NULSTR(A) DO BEGIN "ASS1" 
01000	
01100	   IF FOUND>0 THEN CASE FOUND OF BEGIN "LOOK FOR SPECIALS"
01200	[ARROW]BEGIN "RIGHT ARROW"
01300			ARSEEN_1;
01400			LEFTEND_K; 
01500			GO MORE 
01600		END;
01700	[EXEC]	BEGIN  "EXEC SEEN" 
01800			EXF_0;
01900			ENDCHECK(1); "SET {LEFT-,RIGHT-,NOD-}END IF NECESSARY"
02000			GO MORE
02100		END;
02200	[SCAN]	BEGIN  "SCAN SEEN" 
02300			EXF_SCANE_1;
02400			ENDCHECK(2); "SET ALL IF NECESSARY"
02500			GO MORE
02600		END;
02700	[GOTO]	BEGIN  " SEEN" 
02800			EXF_1;
02900			ENDCHECK(2);
03000			SUCCEED_K+1;
03100		END;
03200	[ELSEGO]FAILFLG_K+1;  "FAIL ADDRESS SEEN"
03300	[PUSHJ]BEGIN "^ SEEN FOR A PRODUCTION PUSHJ" 
03400			ENDCHECK(2);
03500			DPUSHJ _ K+1;
03600			EXTRA_EXTRA+BYTENO;
03700		END;
03800	[POPJ]	BEGIN " SEEN FOR A POPJ" 
03900			ENDCHECK(2);
04000			DPOPJ _ 1;
04100		END;
04200	[NOTREALLY]EXTRA_EXTRA-1;
04300	[BASE]	BEGIN "BASE SEEN"
04500		  OLDBASEFLAG_FALSE;
04600	BLAB:	  ENDCHECK(0); "SET LEFTEND, RIGHTEND IF NECESSARY"
04700		  BASELOC_K+1;
04750	          BEGIN
04755	             COMMENT DUMMY BLOCK TO HAVE VARIABLE I. NEEDED NOW
04760	                THAT WE CHECK LABEL DEFINITIONS IN TERMS OF BLOCKS;
04765	             INTEGER I;
04800	      	     WHATKIND_ IF (I_A[5 FOR 1]) THEN 0 ELSE
04900	   	       (IF I="B" THEN '20 ELSE 1) LSH 7;
04905	          END;
05000		  A_GETWORD;   "THE BASE NODE NAME"
05100		  EXTRA_EXTRA+1
05200		END;
05300	[OLDBASE] BEGIN "EXTEND OLD BASE"
05400		  OLDBASEFLAG_TRUE;
05500		  GO BLAB
05600		END;
05700	[NODE]	GO TO MORE;
05800	[PRESUME] BEGIN "PRESUME SEEN"
05900	        	  EXF_1;
06000	        	  ENDCHECK(2);
06100	        	  DPRESUME_1;
06200		   END
06300	   END "LOOK FOR SPECIALS";
06400	
06500		K_K+1;
06600		IF EXF=0 AND CLASSTYPE THEN EXTRA_EXTRA+1;
06700		IF EXF  FOUND  CLASSTYPE THEN BEGIN "ASS2" 
06800			ENTERSYM;
06900			TYPE[SYMBOL]_EXROT;
07000			NUMBER[SYMBOL]_EXCNT;
07100			NUMEX[EXCNT]_SYMBOL;
07200			EXCNT_EXCNT+1;
07300		END "ASS2" ELSE
07400		IF FOUND AND (CLASSTYPE"0"A[2 FOR 1]"9"(EXTRA_EXTRA-1)+10000) AND
07500		              EXECEND=0  (LENGTH(A)2  EQU(A[1 FOR 2],"SG")) 
07600		THEN BEGIN "ASS3" 
07700			SYMBOL_1;
07800			PRINT "UNDEFINED SYMBOL ? "&A MSG;
07900			ERRFLAG_1;
08000		END;
08100		PROD[K]_A;
08200		PRODI[K]_SYMBOL;
08300	
08400	MORE:	A_GETWORD;
08500	
08600	END
08700	END "ASSEMBLE";
08800	
08900	
09000	INTEGER PROCEDURE INDEX(STRING S;INTEGER LIM);
09100	BEGIN "INDEX"
09200	 INTEGER I;
09300	 FOR I_1 STEP 1 UNTIL LIM DO IF EQU(S,PROD[I]) THEN RETURN(I);
09400	 RETURN(0)
09500	END "INDEX";
09600	
     
00100	COMMENT Prodscan;
00200	
00300	COMMENT MAIN BODY OF PRODSCAN; DEFINE B!="LEFTEND-B+1";
00400		ASSEMBLE;
00500		IF FALSE THEN BEGIN "HOOK" OUTSTR(LAB&ALAB) END "HOOK";
00600		PRINTROOM;
00700		IF LEFTEND=0 THEN BEGIN LEFTEND_1; PRINT "NO LEFT PART "&LAB  MSG;ERRFLAG_1;END;
00800		IF (DPUSHJ OR DPOPJ) THEN
00900		IF SUCCEED=0 THEN BEGIN SUCCEED_1; PRINT"NO SUCCESS LOCATION "&LAB MSG;ERRFLAG_1;END;
01000	
01100		PTO3 ("IFN FTDEBUG <	SIXBIT/",(LAB&ALAB)[1 TO 6],"/>");
01200		ALAB_("A"-1)+(LABCNT_LABCNT+1);
01300		PTO("	XWD ");
01400		IF FAILFLG THEN
01500		  OUT(SNK,PROD[FAILFLG][2 TO ]) ELSE
01600		  BEGIN
01700		   OUT(SNK,".+FTDEBUG+");
01800		   OUT(SNK,PRINTOCT((EXTRA+EXECEND+(1+2*BYTENO)) DIV BYTENO));
01900		  END;
02000		PTO2(", ",IF SUCCEED THEN PROD[SUCCEED][2 TO ] ELSE "0");
02100	
02200	 Now we process the left-half compares against the stack.  These
02300	 are simply put out in reverse order of the scan order -- top seen first;
02400	
02500		FOR J _LEFTEND STEP -1 UNTIL 1 DO BEGIN "ASS4" 
02600		   A_PROD[J]; C_PRODI[J];
02700		   IF LENGTH(A)2  EQU(A[1 FOR 2],"SG") THEN HALWORD("0") ELSE 
02800		   BEGIN
02900		       A_PRINTSYMBOL(C)&
03000			(IF CLASS[C]+CLASS2[C] THEN "+BCARE" ELSE
03100			 IF TYPE[C] = CLASSID THEN 
03200			   ("+BCLASS"&(IF NUMBER[C]>36 THEN "+334" ELSE NULL))ELSE NULL);
03300		       IF J>1SUBEQU("",PROD[J-1]) THEN BEGIN
03400			   A_A&"+BINF"; J_J-1
03500		       END;
03600		       HALWORD(A)
03700		   END
03800		END "ASS4";
03900	
04000	 Finish up the left half, specify # of right-half temporaries;
04100		HALWORD(PRINTOCT(RIGHTEND-LEFTEND)&"+BDONE");
04200	
04300	 Specify the right-half -- index+BTEMP for matches, tokens for others;
04400	
04500	
04600		FOR J_LEFTEND+1 STEP 1 UNTIL RIGHTEND DO
04700		 IF (B_INDEX(PROD[J],LEFTEND))  (B1PROD[B-1]"")
04800		    THEN HALWORD(PRINTOCT(B!)&"+BTEMP") ELSE
04900		   HALWORD(PRINTSYMBOL(PRODI[J]));
05000	
05100	 Process tree-building specifications.  The word BASE (BASELOC in PROD array)
05200	  causes the next token to be used as the name of a new parse tree node (the
05300	  name is augmented by a code to distinguish it from, say, terminal symbols
05400	  with the same designations.  The node name will more often be derived from
05500	  a terminal than from a non-terminal, but each terminal so used falls into
05600	  an equivalence class represented by a non-terminal (+, *, -, LAND all belong
05700	  in this sense to the non-terminal class Expression).  The base node will be
05800	  represented in the output by BINF + (either the token number or BTEMP+index).
05900	  Then NODES appear (the actual word in the production line is ignored). Each
06000	  is represented by BTEMP+index, since all will be fetched from the left side.
06100	  BINF on will represent a variable number of actual results pointed to by the
06200	  parse entry for that index: the actual number will  be calculated by the 
06300	  parser.  The nodes are represented in the output file by the file location
06400	  pointers found in the LPSAV stack.  (NB all this is SLS stuff).  There will
06500	  be one extra byte containing only BDONE to finish the node specifiers.  Then
06600	  come the EXECS or whatever;
06700	 
06800		IF BASELOC THEN BEGIN "TREE PROCESS"
06900		  TS_IF OLDBASEFLAG THEN "BCLASS" ELSE "0";
07000		  IF B_INDEX(PROD[BASELOC],LEFTEND) THEN HALWORD(TS&"+BINF+BTEMP+"
07100		     &PRINTOCT(B!)) ELSE
07200			HALWORD(TS&"+BINF+"&PRINTSYMBOL(PRODI[BASELOC]));
07300		  A_NULL; I_0;
07400		  FOR J_BASELOC+1 STEP 1 UNTIL NODEND DO
07500		    IF SUBEQU("",PROD[J]) THEN A_"+BINF" ELSE BEGIN
07600			B_INDEX(PROD[J],LEFTEND);
07700		 	PROD[J]_PRINTOCT(B!)&A;
07800			I_I+1;
07900			A_NULL
08000		    END;
08100		    HALWORD(PRINTOCT(I LOR WHATKIND));
08200	 	    FOR J_BASELOC+1 STEP 1 UNTIL NODEND DO
08300			IF (A_PROD[J])"" THEN HALWORD(A);
08400		END "TREE PROCESS";
08500	
08600	 Process EXEC routine calls.  If the EXEC routine is typed according to some
08700	   class of tokens, search left hand side until the matching token is found.
08800	   Then put out the index of that token, then the base number of the class. 
08900	   This base number is subtracted (by parser) from the token number and the 
09000	   result passed to the EXEC.  Then, no matter what, put out the EXEC routine
09100	   index number.  If the ** (dispatch via parser) feature was used, the BCLASS
09200	   bit is turned on in the class number byte, indicating that the parser should
09300	   use the index to select one of the following EXECS.  The BTEMP bit will appear
09400	   in the last indexed exec (followed by another ** in productions).
09500	  On 3-1-72 the syntax was extended by DCS to allow EXEC @4 ROUT, which means
09600	   that the explicit index 4 will be sent directly to the exec routine.  In this
09700	   case, BTEMP is turned on in the byte with 4 in it -- the next byte is the
09800	   EXEC routine byte;
09900	
10000		FOR J _ NODEND+1 STEP 1 UNTIL EXECEND DO 
10100		IF PROD[J]="@" THEN IF "0"PROD[J][2 FOR 1]"9" THEN
10200		   HALWORD(PROD[J][2 TO ]&"+BTEMP")
10300		ELSE BEGIN "ASS10"
10400		    HALWORD(PRINTOCT(LEFTEND-INDEX(PROD[J],LEFTEND)+1)&"+BCLASS");
10500		    IF PROD[J+1] = "*" THEN BEGIN "ASS12" 
10600			    HALWORD(PRINTOCT(FIRCLS[NUMBER[PRODI[J]]])&"+BCLASS");
10700			    FOR J_J+2 STEP 1 WHILE PROD[J+1]"*" DO 
10800			      HALWORD(PRINTOCT(NUMBER[PRODI[J]]));
10900			    HALWORD(PRINTOCT(NUMBER[PRODI[J]])&"+BTEMP");
11000			    J _ J +1;
11100		    END "ASS12" ELSE HALWORD(PRINTOCT(FIRCLS[NUMBER[PRODI[J]]]))
11200		END "ASS10" ELSE HALWORD(PRINTOCT(NUMBER[PRODI[J]]));
11300	
11400	
11500	 Issue SCANNER calls, then quit.  If there is a PUSHJ to be done, include
11600	   BCLASS in the BDONE/SCANNER word.  If a POPJ, include BTEMP;
11700		HALWORD(
11800		  PRINTOCT(IF SCANE THEN 1 MAX CVD(PROD[EXECEND+1]) ELSE 0)
11900		        &"+BDONE"&(IF DPUSHJ THEN "+BCLASS" ELSE "")&
12000			(IF DPOPJ THEN "+BTEMP" ELSE "")
12100			&(IF DPRESUME THEN "+BPRESUME" ELSE ""));
12200		WHILE BYTE  1 DO BEGIN "ASS15"  HALWORD("0");END "ASS15";
12300		IF DPUSHJ THEN PTO2("	",(PROD[DPUSHJ][2 TO ]));
12400		PRINTROOM;
12500	
12600	END "PRODSCAN";
12700	
     
00100	COMMENT Ptran;
00200	
00300	 THIS IS THE MAIN EXECUTION BLOCK;
00400	
00500	ONETIME_FALSE;  SET UP TO OPEN COMMAND FILE;
00600	WHILE TRUE DO BEGIN "EXECUTE"
00700	LABEL PROGEND,ERROREND;
00800		INTEGER I,CURCLS,FIRFLG;STRING A;
00900	
01000		INITIALIZATION;
01100		PUTOUT("LSTON(PDEFS)");
01200		COWNTC_0;
01300		WHILE COMMAND=0 DO A_GETWORD;
01400	
01500		IF EQU(WORD,"<SYMBOLS>") THEN MAP;
01600		IF EQU(WORD,"<TERMINALS>")=0 THEN ERRIT(<TERMINALS>)
01700		   ELSE COMPILE(TERMINAL);
01800		IF EQU(WORD,"<RESERVED-WORDS>")=0 THEN ERRIT(<RESERVED-WORDS>)
01900		   ELSE  COMPILE (RESERVED);
02000		IF EQU(WORD,"<NON-TERMINAL-SYMBOLS>")=0 THEN ERRIT(<NON-TERMINAL-SYMBOLS>)
02100		   ELSE COMPILE(NONTERM);
02200	
     
00100	
00200	IF EQU(WORD,"<CLASSES>") THEN
00300	DO BEGIN "MAIN1" 
00400	A_GETGOODWORD;
00500	IF COMMAND = 0  THEN BEGIN "MAIN2" 
00600	 INTEGER CBIT,OLDC,OLDCBIT,I,J,CTYPE;
00700	 PROCEDURE CLSIDASSIGN;
00800	 BEGIN "CLSIDASSIGN"
00900	    IF NUMBER [SYMBOL]=0 THEN BEGIN
01000	       NUMBER[SYMBOL]_COWNT_COWNT+1;
01100	       NUMSYM[COWNT]_SYMBOL
01200	    END;
01300	    IF FIRFLG THEN BEGIN
01400	       FIRCLS[COWNTC]_NUMBER[SYMBOL];
01500	       FIRFLG_0;
01600	    END;
01700	    IF COWNTC > 36 THEN
01800	     IF COWNTC > CLSNO THEN USERERR(0,0,"CLASS TABLE OVERFLOW") 
01900	     ELSE
02000	      CLASS2[SYMBOL]_CLASS2[SYMBOL]LOR CBIT
02100	     ELSE
02200	      CLASS[SYMBOL]_CLASS[SYMBOL]LOR CBIT;
02300	 END "CLSIDASSIGN";
02400	
02500	 IF CLASSTYPE AND FOUND THEN BEGIN "MAIN3" 
02600	    ENTERSYM;
02700	    TYPE[SYMBOL]_CLASSID;
02800	    COWNTC_COWNTC+1; CBIT_1 LSH (COWNTC-(IF COWNTC36 THEN 1 ELSE 37));
02900	    FIRFLG_1;
03000	    NUMBER[SYMBOL]_COWNTC;
03100	    NUMCLS[COWNTC]_SYMBOL;
03200	    IF EQU(SYM[SYMBOL],"@RESERVED")(CTYPE_RESERVED)
03300	      EQU(SYM[SYMBOL],"@TERMINAL")(CTYPE_TERMINAL)
03400	    THEN BEGIN "RESTER"
03500	       FOR SYMBOL_1 STEP 1 UNTIL SYMNO DO
03600		IF TYPE[SYMBOL]=CTYPE THEN BEGIN
03700		  CLSIDASSIGN
03800		END
03900	    END "RESTER"
04000	 END "MAIN3" ELSE IF CLASSTYPE  FOUND; THEN BEGIN "MAIN35"
04100	    COMMENT CLASSCLASS -- WHAT CLASS!;
04200	    OLDC_NUMBER[SYMBOL];
04300	    OLDCBIT_1 LSH (IF OLDC>36 THEN OLDC-37 ELSE OLDC-1);
04400					    
04500	    "PUT ALL MEMBERS OF OLD CLASS INTO NEW CLASS TOO"
04600	    FOR I_1 STEP 1 UNTIL COWNT DO BEGIN
04700	     SYMBOL_NUMSYM[I];
04800	     IF OLDC36CLASS[SYMBOL]LAND OLDCBITOLDC>36CLASS2[SYMBOL]LAND OLDCBIT
04900		THEN IF COWNTC36 THEN CLASS[SYMBOL]_CLASS[SYMBOL] LOR CBIT
05000			ELSE CLASS2[SYMBOL]_CLASS2[SYMBOL] LOR CBIT
05100	    END;
05200				 
05300	 END "MAIN35"
05400	 ELSE IF FOUND THEN CLSIDASSIGN
05500	  ELSE BEGIN ERRFLAG_1;PRINT "UNDECLARED SYMBOL "&WORD MSG ;END;
05600	END "MAIN2"
05700	END "MAIN1" UNTIL COMMAND;
05800	
     
00100	
00200		PRINTROOM;
00300		ASSIGN;
00400		PUTOUT ("PRBG%:");
00500					
00600		IF EQU(WORD,"<PRODUCTIONS>")=0 THEN ERRIT(<PRODUCTIONS>) ELSE  BEGIN
00700			DO BEGIN "MAIN6" 
00800			A_GETGOODWORD;
00900			IF COMMAND=0 THEN PRODSCAN;
01000			END UNTIL COMMAND;
01100		END;
01200		PRINTROOM;
01300		PUTOUT("LSTON(SUBRS)");
01400		PUTOUT("EXCTAB:	");
01500		LISTR(NUMEX,EXCNT-1,"	SUBR ",0);
01600		PUTOUT("	IFN FTDEBUG {");
01700		PUTOUT("EXCNAM:	SIXBIT/EXCNM/");
01800		LISTR(NUMEX,EXCNT-1,"	SIXBIT/",2);
01900		PUTOUT("SYMNAM:	SIXBIT/SYMNM/");
02000		LISTR(NUMSYM,COWNT,"	SIXBIT/",1);
02100		PUTOUT("SYMNO_ .-SYMNAM");
02200		PUTOUT("	}");
02300		PUTOUT("BEND PARSE");
02400		IF ERRFLAG THEN  
02500	ERROREND: BEGIN
02600		   ERRFLAG_1; PRINT "ERROR RETURN" MSG END;
02700	PROGEND:
02800		IF ERRFLAG THEN DONE;
02900		RELEASE(SUB);
03000		IF SLS THEN BEGIN
03100	          OUT(SAI,"NOTANITEMATALL;"&CRLF&CRLF&SAISTR&CRLF&
03200		   "ENOUGH=""ENOUGH"";"&CRLF&
03300		   "DEFINE NUMTRM=""'"&CVOS(NUMTERM)&""";"&CRLF); RELEASE(SAI)
03400		END;
03500	END "EXECUTE";
03600	END "PTRAN";