perm filename RTRAN.OLD[S,AIL]1 blob sn#076450 filedate 1975-06-03 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";