perm filename RTRAN.SAI[S,AIL]2 blob
sn#027431 filedate 1973-03-06 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00008 PAGES VERSION 10-4(30)
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00002 00002 HISTORY
00500 00004 00003 Declarations, Trivial Procedures
00600 00007 00004 Initialization, Getword, Hash, Reserved, Nxtsym, Gensym
00700 00010 00005 Printreserved, Assigned
00800 00012 00006 Macros
00900 00015 00007 Functions
01000 00020 00008 Defin, Main Loop
01100 00022 ENDMK
01200 ⊗;
00100 COMMENT ⊗HISTORY
00200 SAIL
00300 004 401200000036 ⊗;
00400
00500
00600 COMMENT ⊗
00700 VERSION 10-4(30) 10-29-72
00800 VERSION 10-4(29) 10-29-72
00900 VERSION 10-4(28) 10-29-72
01000 VERSION 10-4(27) 10-29-72
01100 VERSION 10-4(26) 10-29-72
01200 VERSION 10-4(25) 10-29-72
01300 VERSION 10-4(24) 10-29-72
01400 VERSION 10-4(23) 10-29-72
01500 VERSION 10-4(22) 10-29-72
01600 VERSION 10-4(21) 10-29-72
01700 VERSION 10-4(20) 10-29-72
01800 VERSION 10-4(19) 10-29-72
01900 VERSION 10-4(18) 10-29-72
02000 VERSION 10-4(17) 10-29-72
02100 VERSION 10-4(16) 10-29-72
02200 VERSION 10-4(15) 10-29-72
02300 VERSION 10-4(14) 10-29-72
02400 VERSION 10-4(13) 10-29-72
02500 VERSION 10-4(12) 10-29-72
02600 VERSION 10-4(11) 10-29-72 BY DCS ADD BUILT-IN MACRO CAPABILITY
02700 VERSION 10-4(10) 10-29-72
02800 VERSION 10-4(9) 3-2-72
02900 VERSION 10-4(8) 3-2-72
03000 VERSION 10-4(7) 3-2-72
03100 VERSION 10-4(6) 3-2-72
03200 VERSION 10-4(5) 3-1-72
03300 VERSION 10-4(4) 3-1-72
03400 VERSION 10-4(3) 3-1-72
03500 VERSION 10-4(2) 2-6-72 BY DCS CONVERT TO SLS-COMPATIBLE, CMDSCN→SCNCMD
03600 VERSION 10(1) 1-14-72 BY DCS REPLACE CMDSCN BY SCNCMD
03700
03800 ⊗;
00100 COMMENT Declarations, Trivial Procedures;
00200
00300 BEGIN "RTRAN"
00400 DEFINE VERSION_NUMBER = "'401200000036";
00500 REQUIRE VERSION_NUMBER VERSION;
00600
00700
00800 COMMENT This is a program to generate the initial symbol table for the
00900 SAIL compiler. The input is in the form of files -- containing data
01000 about the reserved words -- both syntactic and reserved function names.
01100
01200 THE FORMAT IS:
01300
01400 "<RESERVED-WORDS>"
01500
01600 (SYMBOL) (NUMBER) (C OR N)
01700 ...C MEANS MEMBER OF A CLASS, N NOT
01800
01900 "<ASSIGN>"
02000 (PASSED RIGHT ON TO FAIL AS SYMBOLIC ASSIGNMENTS FOR
02100 THE ARGUMENTS TO THE FUNCTION PARAMETERS)
02200
02300 "<FUNCTIONS>"
02400
02500 (SYMBOL) (TYPE) (NUMBER OF PARAMETERS)
02600
02700 FOR EACH PARAMTER:
02800 (DESCRIPTOR) (TYPE) (VALUE,REFERENCE)
02900
03000 "<END>"
03100 ;
03200
03300 DEFINE RELMODE="0", LSTMODE="0", SRCMODE="0", LSTEXT="NULL", RELEXT="NULL",
03400 SWTSIZ="2", SRCEXT="""QQQ""", PROCESSOR="""RTRAN""", GOODSWT="NULL";
03500 REQUIRE "SCNCMD[1,DCS]" SOURCE_FILE;
03600
03700 DEFINE SRC="1",SNK="2",BREAK="SRCBRK",EOF="SRCEOF",
03800 NORSCAN="2",SUPSPC="1",MACSCAN="3", ONESCAN="4", CR="'15",
03900 LF="'12",CRLF="('15&'12)",PRINT="OUTSTR)",
04000 MSG="&CRLF)",FUNCNO="20",
04100 RESNO="210",LINCNT="5",BUCKLEN="13";
04200
04300 INTEGER COMMAND,LINENO,SYMCNT,RESCNT,TYPCNT,TYPARAM;
04400 STRING WORD,CURSYM,ABC,PARM,TEMPSTR;
04500
04600 STRING ARRAY RESPRINT[1:RESNO];
04700 SAFE STRING ARRAY BUCKET[0:BUCKLEN];
04800 INTEGER ARRAY RESNUM[1:RESNO];
04900 SAFE STRING ARRAY PARAMS[1:20];
05000
05100 PROCEDURE PUTOUT(STRING A);
05200 BEGIN
05300 LINOUT(SNK,LINENO);
05400 LINENO←LINENO+LINCNT;
05500 OUT(SNK,A&CRLF);
05600 END;
05700
05800 STRING PROCEDURE PRINTOCT(INTEGER A); RETURN(CVOS(ABS A));
05900
06000 PROCEDURE PRINTROOM;
06100 BEGIN
06200 PUTOUT(NULL);PUTOUT(NULL);
06300 END;
00100 COMMENT Initialization, Getword, Hash, Reserved, Nxtsym, Gensym;
00200
00300 PROCEDURE INITIALIZATION;
00400 BEGIN INTEGER T; STRING TEM;
00500 SETBREAK(NORSCAN," "&LF,'14&CR,"INR");
00600 SETBREAK(SUPSPC," "&CRLF,NULL,"XNR");
00700 SETBREAK(MACSCAN,"¬?"&'15,NULL,"IN");
00800 SETBREAK(ONESCAN,NULL,NULL,"XNA");
00900
01000 NX_TFIL←0; WANTBIN←TRUE;
01100 COMMAND_SCAN;
01200
01300 FOR T←0 STEP 1 UNTIL BUCKLEN DO BUCKET[T]←"0";
01400
01500 TYPCNT←SYMCNT←COMMAND←EOF←0;
01600 LINENO←LINCNT;
01700 END;
01800
01900 RECURSIVE STRING PROCEDURE GETWORD;
02000 BEGIN INTEGER BR;
02100 COMMAND←0;
02200 WORD←INPUT(SRC,SUPSPC);
02300 IF EOF THEN BEGIN
02400 COMMAND_SCAN;
02500 WORD←INPUT(SRC,SUPSPC);
02600 WHILE COMMAND =0 DO WORD ← GETWORD ;
02700 RETURN (WORD);
02800 END;
02900 WORD←INPUT(SRC,NORSCAN);
03000 IF EQU (WORD,"MUMBLE") THEN BEGIN
03100 WHILE WORD≠";" AND WORD[∞ FOR 1]≠";" DO
03200 WORD← GETWORD;
03300 WORD←GETWORD;
03400 END;
03500 IF WORD="<" THEN COMMAND←1;
03600 RETURN (WORD);
03700 END;
03800
03900
04000 PROCEDURE RESERVED;
04100 BEGIN STRING A;
04200 A←GETWORD;
04300
04400 FOR RESCNT←1 STEP 1 WHILE COMMAND=0 DO BEGIN
04500 RESPRINT[RESCNT]←A;
04600 RESNUM[RESCNT]←CVO(GETWORD);
04700 A←GETWORD;
04800 IF A="C" THEN RESNUM[RESCNT]←-RESNUM[RESCNT];
04900 A←GETWORD;
05000 END;
05100 END;
05200
05300 STRING PROCEDURE NXTSYM;
05400 RETURN("SYM"&CVS(SYMCNT+1));
05500
05600 STRING PROCEDURE GENSYM;
05700 BEGIN
05800 SYMCNT←SYMCNT+1;
05900 CURSYM←"SYM"&CVS(SYMCNT);
06000 RETURN(CURSYM);
06100 END;
06200
06300
06400 INTEGER PROCEDURE HASH(STRING A);
06500 BEGIN
06600 INTEGER J,HASS;
06700 HASS←0;
06800 FOR J←1 STEP 1 UNTIL 5 DO BEGIN
06900 IF J>LENGTH(A) THEN HASS←(HASS LSH 7) ELSE
07000 HASS← (HASS LSH 7)+(A[J FOR 1]);
07100 END;
07200 HASS←(HASS LSH 1);
07300 HASS←((HASS XOR LENGTH(A)) MOD BUCKLEN);
07400 IF HASS>0 THEN RETURN(HASS) ELSE RETURN(-HASS);
07500 END;
00100 COMMENT Printreserved, Assigned;
00200
00300 PROCEDURE PRINTRESERVED;
00400 BEGIN INTEGER I,J;
00500 STRING A,OLDRES;
00600 OLDRES←"0";
00700 FOR I ←1 STEP 1 UNTIL RESCNT-1 DO BEGIN
00800
00900 PUTOUT(" ");
01000 J←HASH(RESPRINT[I]);
01100 A←BUCKET[J];
01200 BUCKET[J]←GENSYM;
01300 PUTOUT(CURSYM&": XWD "&OLDRES&","&A);
01400 OLDRES←BUCKET[J];
01500 PUTOUT(" "&PRINTOCT(LENGTH(RESPRINT[I])));
01600 PUTOUT(" POINT 7,.+2");
01700 IF RESNUM[I]<0 THEN BEGIN
01800 PUTOUT(" XWD RES+CLSIDX,"&PRINTOCT(-RESNUM[I]));
01900 END ELSE BEGIN
02000 PUTOUT(" XWD RES,"&PRINTOCT(RESNUM[I]));
02100 END;
02200 PUTOUT(" ASCIZ/"&RESPRINT[I]&"/");
02300 END;
02400 PUTOUT(OLDRES);
02500 PUTOUT("↑RESEND:");
02600 COMMENT PRINT BUCKET;
02700
02800 PRINTROOM; PRINTROOM;
02900 PUTOUT("↑MBUCK: ;INITIALIZED BUCKET");
03000 FOR I←1 STEP 1 UNTIL (BUCKLEN+1)/2 DO BEGIN
03100 PUTOUT(" XWD "&BUCKET[2*I-2]&","&BUCKET[2*I-1]);
03200 END;
03300 END;
03400
03500
03600 PROCEDURE ASSIGN;
03700 BEGIN STRING A,B;
03800 WHILE COMMAND=0 DO BEGIN
03900 A←NULL;
04000 BREAK←0;
04100 WHILE BREAK ≠ LF AND COMMAND=0 DO BEGIN
04200 B←GETWORD;
04300 A←A&B;
04400 END;
04500 IF COMMAND=0 THEN PUTOUT(A);
04600 END;
04700 END;
00100 COMMENT Macros;
00200
00300 PROCEDURE MACROS;
00400 BEGIN "MACROS"
00500 STRING A, B, NPR, BODY, BODADD;
00600 INTEGER J, BRF, NUM;
00700
00800 PROCEDURE OUTBYT(INTEGER BYT);
00900 BEGIN "OUTBYT"
01000 STRING B;
01100 IF NUM=0 THEN B←"BYTE (7) " ELSE B←B&",";
01200 B←B&(IF BYT=0 ∨BYT='177∨BYT='15∨BYT='12 THEN CVOS(BYT) ELSE
01300 """"&BYT&""""); NUM←NUM+1;
01400 IF NUM=15∨BYT=0 THEN BEGIN PUTOUT(B&";"); NUM←0 END
01500 END "OUTBYT";
01600
01700 PUTOUT ("; BUILT-IN MACROS");
01800 WHILE COMMAND = 0 DO BEGIN "A MACRO"
01900 PRINTROOM;
02000 A←GETWORD;
02100 IF COMMAND≠0 THEN DONE;
02200 NPR←GETWORD;
02300 BODY←NULL; NUM←0; INPUT(SRC,ONESCAN);
02400 DO BEGIN "GET BODY"
02500 BODY←BODY&INPUT(SRC,MACSCAN);
02600 BRF←SRCBRK;
02700 INPUT(SRC,ONESCAN);
02800 IF BRF="?" THEN
02900 BODY←BODY&SRCBRK&(IF SRCBRK≠'15 THEN NULL ELSE INPUT(SRC,ONESCAN))
03000 ELSE IF BRF="¬" THEN BODY←BODY&'177&(SRCBRK-"0")
03100 END "GET BODY" UNTIL BRF="¬"∧SRCBRK="0";
03200 BODADD←GENSYM;
03300 PUTOUT(BODADD&": 0 ;MACRO BODY STRING");
03400 PUTOUT(" "&PRINTOCT(LENGTH(BODY)));
03500 PUTOUT(" POINT 7.,.+3");
03600 PUTOUT(" XWD CNST,STRING↔0 ;TBITS,,SBITS");
03700 BRF←LENGTH(BODY);
03800 FOR J←1 STEP 1 UNTIL BRF DO OUTBYT(LOP(BODY));
03900 PRINTROOM;
04000
04100 J←HASH(A);
04200 B←BUCKET[J]; BUCKET[J]←GENSYM;
04300 PUTOUT (CURSYM&": XWD "&BODADD&","&B&" ; HEADER FOR "&A);
04400 PUTOUT (" "&PRINTOCT(LENGTH(A)));
04500 PUTOUT (" POINT 7,.+6");
04600 PUTOUT (" XWD DEFINE,0↔0↔0↔0↔XWD "&NPR&",0");
04700 PUTOUT (" ASCII /"&A&"/")
04800 END "A MACRO"
04900 END "MACROS";
00100 COMMENT Functions;
00200
00300 PROCEDURE FUNCTIONS;
00400 BEGIN
00500 INTEGER J,PAR,I,EXTREF;
00600 STRING FIRVARB,CURVARB,A,C,VARBLOW,PREVARB,B,TYPE,BILTIN,QQ;
00700 STRING XXY;
00800 PUTOUT ("; FUNCTION SYMBOL TABLE ENTRIES");
00900 PUTOUT("↑IPROC:");
01000 PREVARB ← "0";
01100 WHILE COMMAND=0 DO BEGIN "A FUNCTION"
01200 EXTREF←FALSE;
01300 PRINTROOM;
01400 A←GETWORD;
01500 IF COMMAND=0 THEN BEGIN "FUN"
01600 TYPE←GETWORD; BILTIN ← GETWORD;
01700 J←HASH(A);
01800 B←BUCKET[J];
01900 BUCKET[J]←GENSYM;
02000 CURVARB←CURSYM;
02100 IF A="." THEN BEGIN "PROVIDE NAMED ACCESS TO THIS SEMBLK"
02200 PUTOUT("↑"&A&":"); COMMENT FOR .LOP. ETC;
02300 A←A[2 TO ∞];
02400 END;
02500 XXY←GETWORD; IF XXY="X" THEN BEGIN "EXTERN TOO"
02600 PUTOUT("EXTERNAL "&A); EXTREF←TRUE; XXY←XXY[2 TO ∞]
02700 END "EXTERN TOO";
02800 PAR←CVD(XXY);
02900 PUTOUT(CURSYM&": "&B&" ;HEADER FOR "&A);
03000 PUTOUT(" "&PRINTOCT(LENGTH(A)));
03100 PUTOUT(" POINT 7,.+"&
03200 (IF EQU(A,"M") THEN "11" ELSE IF PAR ≤ 10000 THEN "10" ELSE "4"));
03300 IF PAR > 10000 THEN BEGIN "SOME SORT OF SPECIAL GLITCH"
03400 PUTOUT(" XWD "&BILTIN&","&TYPE);
03500 PUTOUT(" 0↔0");
03600 PUTOUT(" ASCII/"&A&"/");
03700 J←(LENGTH(A)+4)%5;
03800 PUTOUT(" BLOCK "&PRINTOCT(3-J));
03900 END ELSE BEGIN "REGULAR FUNCTION"
04000 STRING PARSTR; INTEGER I,ZZ;
04100 PUTOUT(" XWD EXTRNL+"&BILTIN&",PROCED+FORWRD+"
04200 &TYPE);
04300 PUTOUT(" 0");
04400 QQ←NULL;
04500 FOR I←1 STEP 1 UNTIL LENGTH(A) DO
04600 QQ←QQ&(IF (ZZ←A[I FOR 1])=
04700 "_" THEN "." ELSE ZZ);
04800 IF EXTREF THEN
04900 PUTOUT(" XWD 0+"&QQ&",IFN DCS,<0+"&QQ&" ;>0 ")
05000 ELSE
05100 PUTOUT(" IFN DCS,<0+"&QQ&" ;>0 ");
05200 PARSTR←" BYTE (6) ";
05300 FOR I←1 STEP 1 UNTIL PAR DO BEGIN "ONE PARAM"
05400 B←GETWORD ; COMMENT SWINEHART'S DUMMY;
05500 B←GETWORD ; COMMENT DESCRIPTOR;
05600 TEMPSTR←GETWORD; PARM ← GETWORD&","&TEMPSTR;
05700 TYPARAM←0;
05800 FOR J←1 STEP 1 UNTIL TYPCNT DO BEGIN "MATCH TYPES"
05900 IF EQU(PARAMS[J],PARM) THEN BEGIN
06000 TYPARAM←J;DONE;END;
06100 END;
06200 IF ¬ TYPARAM THEN PARAMS[TYPCNT←TYPARAM←TYPCNT+1]←PARM;
06300 PARSTR ← PARSTR&CVOS(TYPARAM)&",";
06400 END "ONE PARAM";
06500 PUTOUT(PARSTR&"0");
06600 PUTOUT(" BLOCK "&CVS(3-((PAR+6)%6)));
06700 END; "REGULAR FUNCTION";
06800 C ← NXTSYM;
06900 PUTOUT(" XWD "&C&","&PREVARB&"");
07000 IF EQU(A,"M") THEN PUTOUT(" 0");
07100 IF PAR < 10000 THEN
07200 PUTOUT(" ASCII /"&A&"/");
07300 PREVARB ← CURSYM ;
07400 PRINTROOM;
07500 END "FUN"
07600 END "A FUNCTION";
07700 PUTOUT ("↑BLTTBL←.-1");
07800 FOR I←1 STEP 1 UNTIL TYPCNT DO PUTOUT("XWD "&PARAMS[I]);
07900 PUTOUT(NXTSYM&"←0");
08000 C←GENSYM;
08100 END "FUNCTIONS";
00100 COMMENT Defin, Main Loop;
00200
00300 PROCEDURE DEFIN;
00400 BEGIN STRING A,B; INTEGER I; LABEL M;
00500 PRINTROOM;
00600 A←GETWORD;
00700 WHILE COMMAND =0 DO BEGIN
00800 FOR I←1 STEP 1 UNTIL RESCNT-1 DO BEGIN
00900 IF EQU(A,RESPRINT[I]) THEN BEGIN
01000 A←A&" ";
01100 IF RESNUM[I]≥0 THEN B←"OPER" ELSE B←"CLASOP";
01200 PUTOUT("↑R"&A[1 FOR 5]&"←←"&B&"+"&PRINTOCT(RESNUM[I]));
01300 GO TO M;
01400 END; END;
01500 M: A←GETWORD;
01600 END;
01700 END;
01800
01900
02000 ON_ETIME←FALSE;
02100 WHILE TRUE DO BEGIN "EXEC"
02200 STRING A;
02300
02400 INITIALIZATION;
02500 PUTOUT("SUBTTL INITIAL SYMBOL TABLE");
02600 PUTOUT("BEGIN RESTAB");
02700 PUTOUT("IFNDEF DCS,<DCS ←← 0>");
02800 PUTOUT("↑RESYM:");
02900 PUTOUT("LSTON(SMTB)");
03000 WHILE EOF = 0 AND EQU(WORD,"<END>")=0 DO BEGIN
03100 WHILE COMMAND=0 DO BEGIN
03200 A←GETWORD;
03300 END;
03400 COMMAND←0;
03500 IF EQU(WORD,"<RESERVED-WORDS>") THEN RESERVED;
03600 IF EQU(WORD,"<FUNCTIONS>") THEN FUNCTIONS;
03700 IF EQU(WORD,"<MACROS>") THEN MACROS;
03800 IF EQU(WORD,"<DEFINITIONS>") THEN DEFIN;
03900 IF EQU(WORD,"<ASSIGN>") THEN ASSIGN;
04000 END;
04100 PRINTRESERVED;
04200 PUTOUT("BEND RESTAB");
04300 END "EXEC";
04400
04500 END "RTRAN";