perm filename RTRAN.SAI[X,AIL] blob
sn#076450 filedate 1973-12-09 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00008 PAGES VERSION 10-4(34)
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 HISTORY
00004 00003 Declarations, Trivial Procedures
00007 00004 Initialization, Getword, Hash, Reserved, Nxtsym, Gensym
00010 00005 Printreserved, Assigned
00012 00006 Macros
00015 00007 Functions
00020 00008 Defin, Main Loop
00022 ENDMK
⊗;
COMMENT ⊗HISTORY
SAIL
004 401200000042 ⊗;
COMMENT ⊗
VERSION 10-4(34) 12-9-73
VERSION 10-4(33) 12-2-73
VERSION 10-4(32) 7-27-73
VERSION 10-4(31) 3-18-73
VERSION 10-4(30) 10-29-72
VERSION 10-4(29) 10-29-72
VERSION 10-4(28) 10-29-72
VERSION 10-4(27) 10-29-72
VERSION 10-4(26) 10-29-72
VERSION 10-4(25) 10-29-72
VERSION 10-4(24) 10-29-72
VERSION 10-4(23) 10-29-72
VERSION 10-4(22) 10-29-72
VERSION 10-4(21) 10-29-72
VERSION 10-4(20) 10-29-72
VERSION 10-4(19) 10-29-72
VERSION 10-4(18) 10-29-72
VERSION 10-4(17) 10-29-72
VERSION 10-4(16) 10-29-72
VERSION 10-4(15) 10-29-72
VERSION 10-4(14) 10-29-72
VERSION 10-4(13) 10-29-72
VERSION 10-4(12) 10-29-72
VERSION 10-4(11) 10-29-72 BY DCS ADD BUILT-IN MACRO CAPABILITY
VERSION 10-4(10) 10-29-72
VERSION 10-4(9) 3-2-72
VERSION 10-4(8) 3-2-72
VERSION 10-4(7) 3-2-72
VERSION 10-4(6) 3-2-72
VERSION 10-4(5) 3-1-72
VERSION 10-4(4) 3-1-72
VERSION 10-4(3) 3-1-72
VERSION 10-4(2) 2-6-72 BY DCS CONVERT TO SLS-COMPATIBLE, CMDSCN→SCNCMD
VERSION 10(1) 1-14-72 BY DCS REPLACE CMDSCN BY SCNCMD
⊗;
COMMENT Declarations, Trivial Procedures;
BEGIN "RTRAN"
DEFINE VERSION_NUMBER = "'401200000042";
LET DEFINE = REDEFINE;
DEFINE VERSION_NUMBER = "'401200000037";
REQUIRE VERSION_NUMBER VERSION;
COMMENT For now we will suppress the SOS type line numbers, if it is
ever desirable to include them later , delete the following
macro definition;
DEFINE LINOUT(X,Y) = "";
COMMENT This is a program to generate the initial symbol table for the
SAIL compiler. The input is in the form of files -- containing data
about the reserved words -- both syntactic and reserved function names.
THE FORMAT IS:
"<RESERVED-WORDS>"
(SYMBOL) (NUMBER) (C OR N)
...C MEANS MEMBER OF A CLASS, N NOT
"<ASSIGN>"
(PASSED RIGHT ON TO FAIL AS SYMBOLIC ASSIGNMENTS FOR
THE ARGUMENTS TO THE FUNCTION PARAMETERS)
"<FUNCTIONS>"
(SYMBOL) (TYPE) (NUMBER OF PARAMETERS)
FOR EACH PARAMTER:
(DESCRIPTOR) (TYPE) (VALUE,REFERENCE)
"<END>"
;
DEFINE RELMODE="0", LSTMODE="0", SRCMODE="0", LSTEXT="NULL", RELEXT="NULL",
SWTSIZ="2", SRCEXT="""QQQ""", PROCESSOR="""RTRAN""", GOODSWT="NULL";
REQUIRE "SCNCMD" SOURCE_FILE;
DEFINE SRC="1",SNK="2",BREAK="SRCBRK",EOF="SRCEOF",
NORSCAN="2",SUPSPC="1",MACSCAN="3", ONESCAN="4", CR="'15",
LF="'12",CRLF="('15&'12)",PRINT="OUTSTR)",
MSG="&CRLF)",FUNCNO="20",
RESNO="210",LINCNT="5",BUCKLEN="13";
INTEGER COMMAND,LINENO,SYMCNT,RESCNT,TYPCNT,TYPARAM;
STRING WORD,CURSYM,ABC,PARM,TEMPSTR;
STRING ARRAY RESPRINT[1:RESNO];
SAFE STRING ARRAY BUCKET[0:BUCKLEN];
INTEGER ARRAY RESNUM[1:RESNO];
SAFE STRING ARRAY PARAMS[1:20];
PROCEDURE PUTOUT(STRING A);
BEGIN
LINOUT(SNK,LINENO);
LINENO←LINENO+LINCNT;
OUT(SNK,A&CRLF);
END;
STRING PROCEDURE PRINTOCT(INTEGER A); RETURN(CVOS(ABS A));
PROCEDURE PRINTROOM;
BEGIN
PUTOUT(NULL);PUTOUT(NULL);
END;
COMMENT Initialization, Getword, Hash, Reserved, Nxtsym, Gensym;
PROCEDURE INITIALIZATION;
BEGIN INTEGER T; STRING TEM;
SETBREAK(NORSCAN," "&LF,'14&CR,"INR");
SETBREAK(SUPSPC," "&CRLF,NULL,"XNR");
SETBREAK(MACSCAN,"¬?"&'15,NULL,"IN");
SETBREAK(ONESCAN,NULL,NULL,"XNA");
NX_TFIL←0; WANTBIN←TRUE;
COMMAND_SCAN;
FOR T←0 STEP 1 UNTIL BUCKLEN DO BUCKET[T]←"0";
TYPCNT←SYMCNT←COMMAND←EOF←0;
LINENO←LINCNT;
END;
RECURSIVE STRING PROCEDURE GETWORD;
BEGIN INTEGER BR;
COMMAND←0;
WORD←INPUT(SRC,SUPSPC);
IF EOF THEN BEGIN
COMMAND_SCAN;
WORD←INPUT(SRC,SUPSPC);
WHILE COMMAND =0 DO WORD ← GETWORD ;
RETURN (WORD);
END;
WORD←INPUT(SRC,NORSCAN);
IF EQU (WORD,"MUMBLE") THEN BEGIN
WHILE WORD≠";" AND WORD[∞ FOR 1]≠";" DO
WORD← GETWORD;
WORD←GETWORD;
END;
IF WORD="<" THEN COMMAND←1;
RETURN (WORD);
END;
PROCEDURE RESERVED;
BEGIN STRING A;
A←GETWORD;
FOR RESCNT←1 STEP 1 WHILE COMMAND=0 DO BEGIN
RESPRINT[RESCNT]←A;
RESNUM[RESCNT]←CVO(GETWORD);
A←GETWORD;
IF A="C" THEN RESNUM[RESCNT]←-RESNUM[RESCNT];
A←GETWORD;
END;
END;
STRING PROCEDURE NXTSYM;
RETURN("SYM"&CVS(SYMCNT+1));
STRING PROCEDURE GENSYM;
BEGIN
SYMCNT←SYMCNT+1;
CURSYM←"SYM"&CVS(SYMCNT);
RETURN(CURSYM);
END;
INTEGER PROCEDURE HASH(STRING A);
BEGIN
INTEGER J,HASS;
HASS←0;
FOR J←1 STEP 1 UNTIL 5 DO BEGIN
IF J>LENGTH(A) THEN HASS←(HASS LSH 7) ELSE
HASS← (HASS LSH 7)+(A[J FOR 1]);
END;
HASS←(HASS LSH 1);
HASS←((HASS XOR LENGTH(A)) MOD BUCKLEN);
IF HASS>0 THEN RETURN(HASS) ELSE RETURN(-HASS);
END;
COMMENT Printreserved, Assigned;
PROCEDURE PRINTRESERVED;
BEGIN INTEGER I,J;
STRING A,OLDRES;
OLDRES←"0";
FOR I ←1 STEP 1 UNTIL RESCNT-1 DO BEGIN
PUTOUT(" ");
J←HASH(RESPRINT[I]);
A←BUCKET[J];
BUCKET[J]←GENSYM;
PUTOUT(CURSYM&": XWD "&OLDRES&","&A);
OLDRES←BUCKET[J];
PUTOUT(" "&PRINTOCT(LENGTH(RESPRINT[I])));
PUTOUT(" POINT 7,.+2");
IF RESNUM[I]<0 THEN BEGIN
PUTOUT(" XWD RES+CLSIDX,"&PRINTOCT(-RESNUM[I]));
END ELSE BEGIN
PUTOUT(" XWD RES,"&PRINTOCT(RESNUM[I]));
END;
PUTOUT(" ASCIZ/"&RESPRINT[I]&"/");
END;
PUTOUT(OLDRES);
PUTOUT("↑RESEND:");
COMMENT PRINT BUCKET;
PRINTROOM; PRINTROOM;
PUTOUT("↑MBUCK: ;INITIALIZED BUCKET");
FOR I←1 STEP 1 UNTIL (BUCKLEN+1)/2 DO BEGIN
PUTOUT(" XWD "&BUCKET[2*I-2]&","&BUCKET[2*I-1]);
END;
END;
PROCEDURE ASSIGN;
BEGIN STRING A,B;
WHILE COMMAND=0 DO BEGIN
A←NULL;
BREAK←0;
WHILE BREAK ≠ LF AND COMMAND=0 DO BEGIN
B←GETWORD;
A←A&B;
END;
IF COMMAND=0 THEN PUTOUT(A);
END;
END;
COMMENT Macros;
PROCEDURE MACROS;
BEGIN "MACROS"
STRING A, B, NPR, BODY, BODADD;
INTEGER J, BRF, NUM;
PROCEDURE OUTBYT(INTEGER BYT);
BEGIN "OUTBYT"
STRING B;
IF NUM=0 THEN B←"BYTE (7) " ELSE B←B&",";
B←B&(IF BYT=0 ∨BYT='177∨BYT='15∨BYT='12 THEN CVOS(BYT) ELSE
""""&BYT&""""); NUM←NUM+1;
IF NUM=15∨BYT=0 THEN BEGIN PUTOUT(B&";"); NUM←0 END
END "OUTBYT";
PUTOUT ("; BUILT-IN MACROS");
WHILE COMMAND = 0 DO BEGIN "A MACRO"
PRINTROOM;
A←GETWORD;
IF COMMAND≠0 THEN DONE;
NPR←GETWORD;
BODY←NULL; NUM←0; INPUT(SRC,ONESCAN);
DO BEGIN "GET BODY"
BODY←BODY&INPUT(SRC,MACSCAN);
BRF←SRCBRK;
INPUT(SRC,ONESCAN);
IF BRF="?" THEN
BODY←BODY&SRCBRK&(IF SRCBRK≠'15 THEN NULL ELSE INPUT(SRC,ONESCAN))
ELSE IF BRF="¬" THEN BODY←BODY&'177&(SRCBRK-"0")
END "GET BODY" UNTIL BRF="¬"∧SRCBRK="0";
BODADD←GENSYM;
PUTOUT(BODADD&": 0 ;MACRO BODY STRING");
PUTOUT(" "&PRINTOCT(LENGTH(BODY)));
PUTOUT(" POINT 7.,.+3");
PUTOUT(" XWD CNST,STRING↔0 ;TBITS,,SBITS");
BRF←LENGTH(BODY);
FOR J←1 STEP 1 UNTIL BRF DO OUTBYT(LOP(BODY));
PRINTROOM;
J←HASH(A);
B←BUCKET[J]; BUCKET[J]←GENSYM;
PUTOUT (CURSYM&": XWD "&BODADD&","&B&" ; HEADER FOR "&A);
PUTOUT (" "&PRINTOCT(LENGTH(A)));
PUTOUT (" POINT 7,.+6");
PUTOUT (" XWD DEFINE,0↔0↔0↔0↔XWD "&NPR&",0");
PUTOUT (" ASCII /"&A&"/")
END "A MACRO"
END "MACROS";
COMMENT Functions;
PROCEDURE FUNCTIONS;
BEGIN
INTEGER J,PAR,I,EXTREF;
STRING FIRVARB,CURVARB,A,C,VARBLOW,PREVARB,B,TYPE,BILTIN,QQ;
STRING XXY;
PUTOUT ("; FUNCTION SYMBOL TABLE ENTRIES");
PUTOUT("↑IPROC:");
PREVARB ← "0";
WHILE COMMAND=0 DO BEGIN "A FUNCTION"
EXTREF←FALSE;
PRINTROOM;
A←GETWORD;
IF COMMAND=0 THEN BEGIN "FUN"
TYPE←GETWORD; BILTIN ← GETWORD;
J←HASH(A);
B←BUCKET[J];
BUCKET[J]←GENSYM;
CURVARB←CURSYM;
IF A="." THEN BEGIN "PROVIDE NAMED ACCESS TO THIS SEMBLK"
PUTOUT("↑"&A&":"); COMMENT FOR .LOP. ETC;
A←A[2 TO ∞];
END;
XXY←GETWORD; IF XXY="X" THEN BEGIN "EXTERN TOO"
PUTOUT("EXTERNAL "&A); EXTREF←TRUE; XXY←XXY[2 TO ∞]
END "EXTERN TOO";
PAR←CVD(XXY);
PUTOUT(CURSYM&": "&B&" ;HEADER FOR "&A);
PUTOUT(" "&PRINTOCT(LENGTH(A)));
PUTOUT(" POINT 7,.+"&
(IF EQU(A,"M") THEN "11" ELSE IF PAR ≤ 10000 THEN "10" ELSE "4"));
IF PAR > 10000 THEN BEGIN "SOME SORT OF SPECIAL GLITCH"
PUTOUT(" XWD "&BILTIN&","&TYPE);
PUTOUT(" 0↔0");
PUTOUT(" ASCII/"&A&"/");
J←(LENGTH(A)+4)%5;
PUTOUT(" BLOCK "&PRINTOCT(3-J));
END ELSE BEGIN "REGULAR FUNCTION"
STRING PARSTR; INTEGER I,ZZ;
PUTOUT(" XWD EXTRNL+"&BILTIN&",PROCED+FORWRD+"
&TYPE);
PUTOUT(" 0");
QQ←NULL;
FOR I←1 STEP 1 UNTIL LENGTH(A) DO
QQ←QQ&(IF (ZZ←A[I FOR 1])=
"_" THEN "." ELSE ZZ);
IF EXTREF THEN
PUTOUT(" XWD 0+"&QQ&",IFN DCS,<0+"&QQ&" ;>0 ")
ELSE
PUTOUT(" IFN DCS,<0+"&QQ&" ;>0 ");
PARSTR←" BYTE (6) ";
FOR I←1 STEP 1 UNTIL PAR DO BEGIN "ONE PARAM"
INTEGER DFVFLG;
DFVFLG←0;
B←GETWORD ; COMMENT SWINEHART'S DUMMY;
B←GETWORD ; COMMENT DESCRIPTOR;
TEMPSTR←GETWORD;
IF TEMPSTR="$" THEN
BEGIN
DFVFLG←'40;
TEMPSTR←GETWORD;
END;
PARM ← GETWORD&","&TEMPSTR;
TYPARAM←0;
FOR J←1 STEP 1 UNTIL TYPCNT DO BEGIN "MATCH TYPES"
IF EQU(PARAMS[J],PARM) THEN BEGIN
TYPARAM←J;DONE;END;
END;
IF ¬ TYPARAM THEN PARAMS[TYPCNT←TYPARAM←TYPCNT+1]←PARM;
PARSTR ← PARSTR&CVOS(TYPARAM+DFVFLG)&",";
END "ONE PARAM";
PUTOUT(PARSTR&"0");
PUTOUT(" BLOCK "&CVS(3-((PAR+6)%6)));
END; "REGULAR FUNCTION";
C ← NXTSYM;
PUTOUT(" XWD "&C&","&PREVARB&"");
IF EQU(A,"M") THEN PUTOUT(" 0");
IF PAR < 10000 THEN
PUTOUT(" ASCII /"&A&"/");
PREVARB ← CURSYM ;
PRINTROOM;
END "FUN"
END "A FUNCTION";
PUTOUT ("↑BLTTBL←.-1");
FOR I←1 STEP 1 UNTIL TYPCNT DO PUTOUT("XWD "&PARAMS[I]);
PUTOUT(NXTSYM&"←0");
C←GENSYM;
END "FUNCTIONS";
COMMENT Defin, Main Loop;
PROCEDURE DEFIN;
BEGIN STRING A,B; INTEGER I; LABEL M;
PRINTROOM;
A←GETWORD;
WHILE COMMAND =0 DO BEGIN
FOR I←1 STEP 1 UNTIL RESCNT-1 DO BEGIN
IF EQU(A,RESPRINT[I]) THEN BEGIN
A←A&" ";
IF RESNUM[I]≥0 THEN B←"OPER" ELSE B←"CLASOP";
PUTOUT("↑R"&A[1 FOR 5]&"←←"&B&"+"&PRINTOCT(RESNUM[I]));
GO TO M;
END; END;
M: A←GETWORD;
END;
END;
ON_ETIME←FALSE;
WHILE TRUE DO BEGIN "EXEC"
STRING A;
INITIALIZATION;
PUTOUT("SUBTTL INITIAL SYMBOL TABLE");
PUTOUT("BEGIN RESTAB");
PUTOUT("IFNDEF DCS,<DCS ←← 0>");
PUTOUT("↑RESYM:");
PUTOUT("LSTON(SMTB)");
WHILE EOF = 0 AND EQU(WORD,"<END>")=0 DO BEGIN
WHILE COMMAND=0 DO BEGIN
A←GETWORD;
END;
COMMAND←0;
IF EQU(WORD,"<RESERVED-WORDS>") THEN RESERVED;
IF EQU(WORD,"<FUNCTIONS>") THEN FUNCTIONS;
IF EQU(WORD,"<MACROS>") THEN MACROS;
IF EQU(WORD,"<DEFINITIONS>") THEN DEFIN;
IF EQU(WORD,"<ASSIGN>") THEN ASSIGN;
END;
PRINTRESERVED;
PUTOUT("BEND RESTAB");
END "EXEC";
END "RTRAN";