perm filename RTRAN.SAI[S,AIL]6 blob
sn#158512 filedate 1975-06-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00008 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 COMMENT HISTORY
C00004 00003 COMMENT Declarations, Trivial Procedures
C00008 00004 COMMENT Initialization, Getword, Hash, Reserved, Nxtsym, Gensym
C00016 00005 COMMENT Printreserved, Assigned
C00018 00006 COMMENT Macros
C00021 00007 COMMENT Functions
C00027 00008 COMMENT Defin, Main Loop
C00030 ENDMK
C⊗;
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;
REQUIRE "<><>" DELIMITERS;
REQUIRE 5000 STRING!SPACE;
IFC DECLARATION(GTJFN) THENC DEFINE TENX(A)=<A>, NOTENX(A)=<>;
ELSEC DEFINE TENX(A)=<>,NOTENX(A)=<A>; ENDC
DEFINE SUPERCOMMENT(A)=<>;
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.SAI[S,AIL]" SOURCE_FILE;
DEFINE SRC=<1>,SNK=<2>,BREAK=<SRCBRK>,EOF=<SRCEOF>,
NORSCAN=<2>,SUPSPC=<1>,MACSCAN=<3>, ONESCAN=<4>, FBRK=<5>, 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 BAITSTR;
INTEGER BAICH1,BAICH2,BAIORG,BAIDUM;
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");
SETBREAK(FBRK,"!_",NULL,"INS");
NX_TFIL←0; WANTBIN←TRUE;
COMMAND_SCAN;
OPEN(BAICH1←GETCHAN,"DSK",0,0,5,BAIDUM,BAIDUM,BAIDUM);
ENTER(BAICH1,"BAIPD8.FAI",BAIDUM);
OPEN(BAICH2←GETCHAN,"DSK",0,0,5,BAIDUM,BAIDUM,BAIDUM);
ENTER(BAICH2,"BAISM1.FAI",BAIDUM);
OUT(BAICH1," TITLE BAIPD8
BEGIN BAIPD8
$BEGIN←←.+1
");
SUPERCOMMENT(< ;SOME FAKE RUNTIMES TO HANDLE IN-LINE FUNCTIONS
P←←17
TEMP←←14
EXTERNAL X22,X33
INTERNAL ..LDB,..ILDB,..IBP,..DPB,..IDPB
..LDB: LDB 1,-1(P)
..RET2: SUB P,X22
JRST @2(P)
..ILDB: ILDB 1,@-1(P)
JRST ..RET2
..IBP: IBP 1,@-1(P)
JRST ..RET2
..DPB: MOVE TEMP,-2(P)
DPB TEMP,-1(P)
..RET3: SUB P,X33
JRST @3(P)
..IDPB: MOVE TEMP,-2(P)
IDPB TEMP,@-1(P)
JRST ..RET3
;AND NOW THE PROCEDURE DESCRIPTORS FOR THEM
ASCII /LDB/ ;CHARACTERS FOR NAME
0 ;WORD FOR PROCEDURE DESCRIPTOR LINK
LINK PDLNK,.-1
,..LDB ;ENTRY ADDRESS
3 ;SAIL STRING DESCRIPTOR FOR NAME
POINT 7,.-4
REFB+PROCB+INTEGR ;TYPE OF PROCEDURE
XWD 0,2 ;STRING PARAMS*2,,ARITH PARAMS+1
0 ;SS DISPL,,AS DISPL
0 ;LEX LEV,,LOCAL VAR INFO
XWD 0,.+4 ;DISPL LEV,,PNTR TO PARAM INFO
XWD .-10,0 ;PDA,,0
XWD ..LDB,0 ;PCNT AT END OF MKSEMT,,PARENTS PDA
XWD ..LDB,0 ;PCNT AT PRDEC,,LOC FOR JRST EXIT
0+INTEGR+VALUE ;TYPE BITS FOR PARAMETER
ASCII /ILDB/
0
LINK PDLNK,.-1
,..ILDB
4
POINT 7,.-4
REFB+PROCB+INTEGR
XWD 0,2
0
0
XWD 0,.+4
XWD .-10,0
XWD ..ILDB,0
XWD ..ILDB,0
0+INTEGR+REFRNC
ASCII /IBP/
0
LINK PDLNK,.-1
,..IBP
3
POINT 7,.-4
REFB+PROCB
XWD 0,2
0
0
XWD 0,.+4
XWD .-10,0
XWD ..IBP,0
XWD ..IBP,0
0+INTEGR+REFRNC
ASCII /DBP/
0
LINK PDLNK,.-1
,..DPB
3
POINT 7,.-4
REFB+PROCB
XWD 0,3
0
0
XWD 0,.+4
XWD .-10,0
XWD ..DPB,0
XWD ..DPB,0
0+INTEGR+VALUE
0+INTEGR+REFRNC
ASCII /IDBP/
0
LINK PDLNK,.-1
,..IDPB
4
POINT 7,.-4
REFB+PROCB
XWD 0,3
0
0
XWD 0,.+4
XWD .-10,0
XWD ..IDPB,0
XWD ..IDPB,0
0+INTEGR+VALUE
0+INTEGR+REFRNC
");
BAIORG←86;>) COMMENT END OF SUPERCOMMENT;
BAIORG←0;
NOTENX(<OUT(BAICH2," TITLE PD8SM1
BEGIN PD8SM1
↑↑START: RESET
OPEN 0,FDB
HALT
ENTER 0,ENTADR
HALT
OUT 0,DMPADR
JRST .+2
HALT
RELEASE 0,0
EXIT
FDB: 17 ;DUMP MODE
SIXBIT /DSK/
0 ;NO BUFFERS
ENTADR: SIXBIT /BAIPD8/
SIXBIT /SM1/
0
0
DMPADR: IOWD $END-$BEGIN+1,$BEGIN
0
$BEGIN:
");>) COMMENT NOTENX;
TENX(< OUT(BAICH2," TITLE PD8SM1
BEGIN PD8SM1
↑↑START: RESET
MOVSI 1,1
HRROI 2,[ASCIZ /BAIPD8.SM1/]
GTJFN
JRST ERR
MOVE 2,[440000100000]
OPENF
JRST ERR
MOVE 2,[XWD 444400,$BEGIN]
MOVNI 3,$END-$BEGIN+1
SOUT
CLOSF
JRST ERR
HALTF
ERR: HRROI 1,[ASCIZ /ERROR!/]
PSOUT
JRST ERR-1
$BEGIN:
");>) COMMENT TENX;
SUPERCOMMENT(<
OUT(BAICH2,"
;FIRST FOR THE FAKE RUNTIMES
4 ;PROCEDURE INFO COMING
400000+1 ;FLAG+ NUMBER OF WORDS IN NAME
EXTERNAL ..LDB
XWD 777777,..LDB ;LAST WORD OF CODE,,PCNT AT PRDEC
XWD BXPROC+INTEGR,=16 ;TYPE BITS,,ADDR OF PDA IN BAIPDn FILE
ASCII /LDB/ ;NAME
0
4
400000+1
EXTERNAL ..ILDB
XWD 777777,..ILDB
XWD BXPROC+INTEGR,=30
ASCII /ILDB/
0
4
400000+1
EXTERNAL ..IBP
XWD 777777,..IBP
XWD BXPROC,=44
ASCII /IBP/
0
4
400000+1
EXTERNAL ..DPB
XWD 777777,..DPB
XWD BXPROC,=58
ASCII /DPB/
0
4
400000+1
EXTERNAL ..IDPB
XWD 777777,..IDPB
XWD BXPROC,=73
ASCII /IDPB/
0 ;END OF FAKIRS
");
>) COMMENT END OF SUPERCOMMENT;
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; INTEGER NVSTRPAR,NPDA,BRCHAR;
STRING FIRVARB,CURVARB,A,C,VARBLOW,PREVARB,B,TYPE,BILTIN,QQ,D,E;
STRING XXY; STRING BTSTR;
PUTOUT ("; FUNCTION SYMBOL TABLE ENTRIES");
PUTOUT("↑IPROC:");
PREVARB ← "0";
WHILE COMMAND=0 DO BEGIN "A FUNCTION"
EXTREF←FALSE;
PRINTROOM;
E←A←GETWORD;
IF COMMAND=0 THEN BEGIN "FUN"
TYPE←GETWORD; BILTIN ← GETWORD; IF EQU(BILTIN[INF-5 FOR 6],"FNYNAM") THEN E←E&"$";
D←NULL; WHILE LENGTH(E) DO BEGIN
D←D&SCAN(E,FBRK,BRCHAR); IF BRCHAR="!" OR BRCHAR="_" THEN D←D&"." END;
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); NVSTRPAR←CVD(GETWORD);
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"));
OUT(BAICH1,"
ASCII /"&A&"/"&"
0
LINK PDLNK,.-1
EXTERNAL "&D&"
,"&D&"
"&CVOS(LENGTH(A))&"
POINT 7,.-"&CVOS((LENGTH(A)+4)%5+3)&"
REFB+PROCB+"&TYPE&"
XWD 2*"&CVOS(NVSTRPAR)&","&CVOS(PAR-NVSTRPAR+1)&"
0
0
XWD 0,.+4
XWD .-10,0
XWD "&D&",0
XWD "&D&",0");
BAIORG←BAIORG+1+(LENGTH(A)+4)%5;
OUT(BAICH2,"
4
400000+"&CVOS((LENGTH(A)+4)%5)&"
EXTERNAL "&D&"
XWD 777777,"&D&"
XWD BXPROC+"&TYPE&","&CVOS(BAIORG)&"
ASCII /"&A&"/
0");
BAIORG←BAIORG+11+PAR;
IF NOT (NPDA MOD 10) THEN OUT(BAICH2,'014);
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) "; BAITSTR←NULL;
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←(BTSTR←GETWORD) &","& TEMPSTR;
IF LENGTH(TEMPSTR)>6 THEN TEMPSTR←"UNTYPE";
IF DFVFLG THEN TEMPSTR←"DEFLT+" & TEMPSTR;
OUT(BAICH1,"
0+"&TEMPSTR&"+"&BTSTR);
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";
IF NOT ((NPDA←NPDA+1) MOD 5) THEN OUT(BAICH1,'014);
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;
OUT(BAICH1,"
0
LINK BALNK,.-1
XWD $BEGIN,$BEGIN" & NOTENX(<"
1
SIXBIT /BAIPD8/">) TENX(<"
4
ASCII /<SAIL>BAIPD8.SM1/">) &"
-1
BEND BAIPD8
END
");
CLOSE(BAICH1);
OUT(BAICH2,"
-1
$END: 0 ;FUCK THE STANFORD PETIT CHANNEL!!!!!
BEND PD8SM1
END START
");
CLOSE(BAICH2);
PUTOUT("BEND RESTAB");
END "EXEC";
END "RTRAN";