perm filename PTRAN.SAI[X,AIL]1 blob
sn#000877 filedate 1972-10-15 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00014 PAGES
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00003 00002 HISTORY
00500 00006 00003 Declarations
00600 00010 00004 Initialization, Lookup, Entersym, Subequ
00700 00014 00005 Pton, Printroom, Halword, Maksym
00800 00017 00006 Assign, Classout
00900 00022 00007 Searchit, Gword
01000 00028 00008 Getword, Get_Good_Word, Compile, Map
01100 00031 00009 Prodscan, Endcheck
01200 00034 00010 Prodscan, Assemble
01300 00038 00011 Prodscan
01400 00047 00012 Ptran
01500 00048 00013
01600 00051 00014
01700 00053 ENDMK
01800 ⊗;
00100 COMMENT ⊗HISTORY
00200 AUTHOR,SAIL,REASON
00300 025 401200000060 ⊗;
00400
00500
00600 COMMENT ⊗
00700 VERSION 10-4(48) 7-31-72 BY DCS SLS CHANGE
00800 VERSION 10-4(47) 7-18-72 BY KUT VANLEHN IS TO INCREASE EXNO
00900 VERSION 10-4(46) 7-18-72 BY KURT VANLEHN IS AS BEFORE SYMNO ← 1290
01000 VERSION 10-4(45) 7-18-72 BY KURT VANLEHN IS THE SAME AS LAST TIME: SYMNO ← 1258
01100 VERSION 10-4(44) 7-18-72 BY KURT VANLEHN TO TRY A DIFFERENT SYMNO
01200 VERSION 10-4(43) 7-18-72 BY KVL INCREASE SYMNO FROM 1200 TO 1282 (1283-1)
01300 VERSION 10-4(42) 7-17-72 BY DCS SYMNO, EXNO GET LARGER
01400 VERSION 10-4(41) 7-8-72
01500 VERSION 10-4(40) 7-8-72 BY DCS FIX AN SLS THINGIE -- NUMTERM
01600 VERSION 10-4(39) 5-23-72 BY DCS MODIFICATIONS TO SLS BASE STUFF
01700 VERSION 10-4(33-38) 4-27-72 ALL SORTS OF THINGS
01800 VERSION 10-4(28-33) 3-4-72
01900 VERSION 10-4(8-27) 3-2-72 BY DCS EXEC @n ROUTINE
02000 VERSION 10-4(7) 2-27-72 BY DCS ADD CLASSES⊂CLASSES SPECS, @TERMINAL∧@RESERVED
02100 VERSION 10-4(6) 2-3-72 BY DCS MERGE WITH SLS VERSION, ADD SLS CONDITIONAL
02200 VERSION 10(5) 1-24-72 BY DCS REMOVE SAILRUN FEATURE
02300 VERSION 10(4) 1-14-72 BY DCS REPLACE CMDSCN.REL WITH SCNCMD.SAI
02400 VERSION 10(3) 12-6-71 NON-TERMINALS INCLUDED IN ITEM DECLARATIONS
02500 VERSION 10(2) 12-5-71 FIX BUG IN CLASS TABLES
02600 VERSION 10(2) 12-5-71
02700 VERSION 10(1) 12-5-71 PTRAN ISSUES ITEM DEFINITIONS FOR SSAIL
02800
02900 ⊗;
00100 COMMENT Declarations;
00200
00300 BEGIN "PTRAN"
00400 DEFINE VERSION_NUMBER = "'401200000060";
00500 REQUIRE VERSION_NUMBER VERSION;
00600 Comment The Production Translator -- builds tables for the SAIL parser
00700 to use. The tables are claimed to be a correct reflection of the input
00800 file's requests, but no consistency or error checking is done;
00900
01000 DEFINE SRCEXT="NULL", RELEXT="NULL", LSTEXT="NULL",GOODSWT="NULL",
01100 PROCESSOR="""PTRAN""", SRCMODE="0", RELMODE="0", LSTMODE="0";
01200 DEFINE SWTSIZ="2";
01300 REQUIRE "WNTSLS" SOURCE_FILE;
01400 REQUIRE "SCNCMD" SOURCE_FILE ;
01500 REQUIRE 7000 STRING_SPACE;
01600 DEFINE
01700 ⊃="COMMENT", SRC="1", SNK="2", SUB="3", BREAK="SRCBRK",
01800 SAI="11",
01900 EOF="SRCEOF", THROW="1", NORSCAN="2", SUPSPC="3", CR="'15",
02000 LF="'12", CRLF="('15&'12)", DELIMNO="10",EXNO="385",
02100 RESERVED="1", NONTERM="2", TERMINAL="3", CLASSID="4", EXROT="5",
02200 ASSGN="6", BYTLEN="12", BYTENO="3", PRINTOCT="CVOS",
02300 _ARROW="1", _GOTO="2", _ELSEGO="3", _EXEC="4", _SCAN="5",
02400 _PUSHJ="6", _POPJ="7", _NOTREALLY="8",_BASE="9", _OLDBASE="10", _NODE="11",
02500 _PRESUME="12",
02600 SAFER="SAFE ", MAPNO="127", LININC="5", SYMNO="1290", CLSNO="72", PDNO="30",
02700 NULSTR(A)="LENGTH(A)=0", PRINT="OUTSTR(",MSG="&CRLF)",
02800 ERRIT(X)="BEGIN USERERR(0,1, ""PSEUDO OP ""&""X""&"" MISSING "");GO ERROREND END";
02900
03000 ⊃ This macro decides whether numeric (fast) or symbolic (readable)
03100 versions of things will be given to FAIL. Use MAKSYM for symbolic;
03200 DEFINE PRINT_SYMBOL(X)="CVOS(NUMBER[X])";
03300
03400 INTEGER CURDELIM,DELIMSTACK,ON,LABCNT,ERRFLAG,COWNT,SUBCNT,SCANE,COMMAND,
03500 CLASSTYPE,SYMBOL,NEXTFREE,FOUND,LINENO,BYTE,EXCNT,CLASSNO,Z,DPUSHJ,DPOPJ,DPRESUME,
03600 COWNTC,R,II,OLDBASEFLAG, WHATKIND, NUMTERM;
03700 STRING ALAB,LAB,WORD,HALSTR,TS,SYMMM,SAISTR;
03800
03900 SAFER INTEGER ARRAY FIRCLS[1:CLSNO], NUMCLS[1:CLSNO], NUMSYM[1:SYMNO],
04000 NUMEX[1:EXNO], SYMD[0:MAPNO], DELIMS[1:DELIMNO],
04100 PRODI[1:PDNO], TYPE, CLASS, CLASS2, NUMBER[-1:SYMNO];
04200
04300 SAFER STRING ARRAY PROD[1:PDNO],SYM[-1:SYMNO];
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," "&LF,CR&'14,"IRN");
01200 SETBREAK(SUPSPC," ",CR&'14,"XRN");
01300 SETBREAK(THROW,LF&'14,NULL,"I");
01400
01500 NX_TFIL←FALSE; WANTBIN←TRUE;
01600 COMMAND_SCAN;
01700 OPEN(SUB,"DSKC",0,0,2,0,T3,T3);
01800 WHILE T3≠ ":" DO T3←LOP(BINFIL);
01900 ENTER(SUB,BINFIL&"QQQ",T3);
02000 IF (NOT WANTBIN) OR T3 THEN USERERR(0,0,"OUTPUT ENTRY ERROR");
02100 IF SLS THEN BEGIN
02200 OPEN(SAI,"DSKC",0,0,2,0,T3,T3);
02300 ENTER(SAI,BINFIL&"SAI",T3);
02400 IF T3 THEN USERERR(0,0,"OUTPUT ENTRY ERROR");
02500 OUT(SAI,"INTEGER ITEM "&CRLF);
02600 SAISTR← "DEFINE "&CRLF
02700 END;
02800 TS←INPUT(SRC,THROW);
02900 IF SUBEQU("COMMENT ⊗",TS) THEN
03000 WHILE SRCBRK≠'14 DO TS←INPUT(SRC,THROW);
03100
03200
03300 ON←EXCNT←BYTE←1;
03400 ERRFLAG←DELIMSTACK←CURDELIM←COMMAND←EOF←0;
03500 COWNT←IF SLS THEN 8 ELSE 0;
03600 "START TOKEN NUMBERING AT FIRST ITEM NUMBER"
03700 NEXTFREE←SYMNO;
03800 SUBCNT←LINENO←LININC;
03900 SYM[0]←" ";
04000 HALSTR←" BYTE ("&CVS(BYTLEN)&") ";
04100
04200 END ;
04300
04400
04500 INTEGER PROCEDURE LOOKUP(STRING A);
04600 BEGIN "LOOKUP"
04700 Comment uses Quadratic Search Algorithm as described in CACM ------;
04800 INTEGER H,Q;
04900 DEFINE SCON="10";
05000
05100 H←CVASC(A) +LENGTH(A) LSH 6;
05200 R←SYMBOL←(H←ABS(H⊗(H LSH 2))) MOD (SYMNO+1);
05300
05400 IF EQU(SYM[SYMBOL],A) THEN RETURN(-1);
05500 IF NULSTR(SYM[SYMBOL]) THEN RETURN(0);
05600
05700 Q←H%(SYMNO+1) MOD (SYMNO+1);
05800 IF (H←Q+SCON)≥SYMNO THEN H←H-SYMNO;
05900
06000 WHILE (IF (SYMBOL←SYMBOL+H)>SYMNO
06100 THEN SYMBOL←SYMBOL-(SYMNO+1) ELSE SYMBOL) ≠R DO
06200 BEGIN "LK1"
06300 IF EQU(SYM[SYMBOL],A) THEN RETURN(-1);
06400 IF NULSTR(SYM[SYMBOL]) THEN RETURN(0);
06500 IF (H←H+Q)>SYMNO THEN H←H-(SYMNO+1);
06600 END "LK1";
06700 SYMBOL←-1; RETURN(0);
06800 END "LOOKUP";
06900
07000
07100 ⊃ Enter symbol in table. Always enters the word previously scanned by
07200 GETWORD. "SYMBOL" is the index (from LOOKUP) into SYM, NUMBER, TYPE;
07300
07400 PROCEDURE ENTERSYM;
07500 BEGIN "ENTERSYM"
07600 IF LENGTH(SYM[SYMBOL])∨SYMBOL<0 THEN
07700 BEGIN
07800 ERRFLAG←1;
07900 IF SYMBOL≥0 THEN PRINT "DUPLICATE SYMBOL "&WORD MSG
08000 ELSE PRINT "SYMBOL TABLE FULL" MSG
08100 END;
08200 SYM[SYMBOL]←WORD;
08300 END "ENTERSYM";
08400
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";
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 B≤36 THEN 1 ELSE 37))));
02300 PRINTROOM;
02400 PRINTROOM;
02500
02600 PUTOUT ("; CLASS INDEX TABLE" );
02700 PUTOUT ("CLSTAB: 0");
02800 IF SLS THEN PUTOUT ("0↔0↔0↔0↔0↔0↔0↔0"); 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]=0∧0<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";
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>1∧EQU(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 (I∧Z∧ON) ∨ (¬I∧¬Z∧ON) 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 A←GWORD;
08200 RETURN(GWORD);
08300 END ELSE
08400 IF EQU(A,"∞ASG") THEN BEGIN ⊃ ASSIGN A COMPILATION VARB ;
08500 SEARCHIT(GWORD); ⊃ IDENTIFIER ;
08600 IF ¬ FOUND THEN BEGIN
08700 ENTERSYM;
08800 TYPE[SYMBOL]←ASSGN;
08900 END;
09000 IF TYPE[SYMBOL]≠ASSGN THEN PRINT "INVALID CONDITIONAL VARIABLE" MSG;
09100 NUMBER[SYMBOL]←CVD(GWORD);
09200 END ELSE
09300 IF EQU(A,"∞IFE") THEN BEGIN
09400 PROCESS (0);
09500 RETURN (GWORD);
09600 END ELSE
09700 IF EQU(A,"∞IFN") THEN BEGIN
09800 PROCESS (1);
09900 RETURN (GWORD);
10000 END;
10100 END;
10200 IF ON AND LENGTH(WORD)=1 ∧ WORD=CURDELIM THEN BEGIN "GW4"
10300 CURDELIM←DELIMS[DELIMSTACK];DELIMSTACK←DELIMSTACK-1;
10400 RETURN (GWORD);
10500 END "GW4";
10600 IF LENGTH(WORD)>1 ∧ WORD[LENGTH(WORD) FOR 1]=":" THEN BEGIN "GW5"
10700 PTO2((LAB←WORD[1 FOR LENGTH(WORD)-1]),"←.+FTDEBUG");
10800 LABCNT←0;ALAB←NULL;
10900 RETURN(GWORD);
11000 END "GW5";
11100 RETURN (WORD);
11200 END;
00100 COMMENT Getword, Get_Good_Word, 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 GET_GOOD_WORD;
01300 BEGIN "GET_GOOD_WORD"
01400 DO WORD←GETWORD UNTIL LENGTH(WORD);
01500 RETURN(WORD);
01600 END "GET_GOOD_WORD";
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←GET_GOOD_WORD;
02600 IF COMMAND=0 THEN BEGIN "CMP2"
02700 IF FOUND<0∧TYPE[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←GET_GOOD_WORD;
04100 IF COMMAND=0 THEN BEGIN "MP2"
04200 GET_GOOD_WORD;
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";
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 ¬ARSEEN∧LEFTEND=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>0∧¬NODEND THEN NODEND←K;
03500 IF ILEV>1∧¬EXECEND THEN EXECEND←K
03600 END "ENDCHECK";
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"
04400 INTEGER I;
04500 OLDBASEFLAG←FALSE;
04600 BLAB: ENDCHECK(0); "SET LEFTEND, RIGHTEND IF NECESSARY"
04700 BASELOC←K+1;
04800 WHATKIND← IF ¬(I←A[5 FOR 1]) THEN 0 ELSE
04900 (IF I="B" THEN '20 ELSE 1) LSH 7;
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";
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←PRINT_SYMBOL(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>1∧SUBEQU("⊗⊗",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)) ∧ (B≤1∨PROD[B-1]≠"⊗")
04800 THEN HALWORD(PRINTOCT(B!)&"+BTEMP") ELSE
04900 HALWORD(PRINT_SYMBOL(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+"&PRINT_SYMBOL(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";
00100 COMMENT Ptran;
00200
00300 ⊃ THIS IS THE MAIN EXECUTION BLOCK;
00400
00500 ON_ETIME←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);
00100
00200 IF EQU(WORD,"<CLASSES>") THEN
00300 DO BEGIN "MAIN1"
00400 A←GET_GOOD_WORD;
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 CLASS2[SYMBOL]←CLASS2[SYMBOL]LOR CBIT
01900 ELSE
02000 CLASS[SYMBOL]←CLASS[SYMBOL]LOR CBIT;
02100 END "CLSIDASSIGN";
02200
02300 IF CLASSTYPE AND ¬FOUND THEN BEGIN "MAIN3"
02400 ENTERSYM;
02500 TYPE[SYMBOL]←CLASSID;
02600 COWNTC←COWNTC+1; CBIT←1 LSH (COWNTC-(IF COWNTC≤36 THEN 1 ELSE 37));
02700 FIRFLG←1;
02800 NUMBER[SYMBOL]←COWNTC;
02900 NUMCLS[COWNTC]←SYMBOL;
03000 IF EQU(SYM[SYMBOL],"@RESERVED")∧(CTYPE←RESERVED)
03100 ∨ EQU(SYM[SYMBOL],"@TERMINAL")∧(CTYPE←TERMINAL)
03200 THEN BEGIN "RESTER"
03300 FOR SYMBOL←1 STEP 1 UNTIL SYMNO DO
03400 IF TYPE[SYMBOL]=CTYPE THEN BEGIN
03500 CLSIDASSIGN
03600 END
03700 END "RESTER"
03800 END "MAIN3" ELSE IF CLASSTYPE ⊃ ∧FOUND; THEN BEGIN "MAIN35"
03900 COMMENT CLASS⊂CLASS -- WHAT CLASS!;
04000 OLDC←NUMBER[SYMBOL];
04100 OLDCBIT←1 LSH (IF OLDC>36 THEN OLDC-37 ELSE OLDC-1);
04200
04300 "PUT ALL MEMBERS OF OLD CLASS INTO NEW CLASS TOO"
04400 FOR I←1 STEP 1 UNTIL COWNT DO BEGIN
04500 SYMBOL←NUMSYM[I];
04600 IF OLDC≤36∧CLASS[SYMBOL]LAND OLDCBIT∨OLDC>36∧CLASS2[SYMBOL]LAND OLDCBIT
04700 THEN IF COWNTC≤36 THEN CLASS[SYMBOL]←CLASS[SYMBOL] LOR CBIT
04800 ELSE CLASS2[SYMBOL]←CLASS2[SYMBOL] LOR CBIT
04900 END;
05000
05100 END "MAIN35"
05200 ELSE IF FOUND THEN CLSIDASSIGN
05300 ELSE BEGIN ERRFLAG←1;PRINT "UNDECLARED SYMBOL "&WORD MSG ;END;
05400 END "MAIN2"
05500 END "MAIN1" UNTIL COMMAND;
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←GET_GOOD_WORD;
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";