perm filename RTRAN.SAI[S,AIL]7 blob
sn#197151 filedate 1976-01-16 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 Initialization, Getword, Hash, Reserved, Nxtsym, Gensym, Ison
C00017 00005 COMMENT Printreserved, Assigned
C00019 00006 Macros, Cond
C00022 00007 COMMENT Functions
C00028 00008 COMMENT Defin, Main Loop
C00035 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:
"<TRUECONDITIONALS>"
a list of all conditional compilation flags which are "on".
Conditional compilation uses "[]" for brackets, and
the left bracket must immediately follow the flag word, i.e.,
TENX[ ... ]
"<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>, CBRK=<6>,
FF=<'14>, 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 BAICH2,BAIDUM; INTEGER ARRAY BCHPD[1:5];
INTEGER NCOND; STRING ARRAY CONDWORD[1:12];
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, Ison;
PROCEDURE INITIALIZATION;
BEGIN INTEGER T; STRING TEM;
SIMPLE PROCEDURE OPENFILE(STRING NAME; REFERENCE INTEGER CHAN); BEGIN
INTEGER D; D←0;
OPEN(CHAN←GETCHAN,"DSK",0,0,5,D,D,D);
ENTER(CHAN,NAME,D) END;
SETBREAK(NORSCAN," ["&LF&FF,CR&"]","INR");
SETBREAK(SUPSPC," "&CRLF&FF&"]",NULL,"XNR");
SETBREAK(MACSCAN,"¬?"&'15,NULL,"IN");
SETBREAK(ONESCAN,NULL,NULL,"XNA");
SETBREAK(FBRK,"!_",NULL,"INS");
SETBREAK(CBRK,"[]",NULL,"INS");
NX_TFIL←0; WANTBIN←TRUE; NCOND←0;
COMMAND_SCAN;
OPENFILE("BAISM1.FAI",BAICH2);
OPENFILE("BAICLC.FAI",BCHPD[1]);
OPENFILE("BAIIO1.FAI",BCHPD[2]);
OPENFILE("BAIIO2.FAI",BCHPD[3]);
OPENFILE("BAIMSC.FAI",BCHPD[4]);
OPENFILE("BAIPRC.FAI",BCHPD[5]);
TEM←"
$BEGIN←←.+1
";
CPRINT(BCHPD[1]," TITLE BAICLC",TEM);
CPRINT(BCHPD[2]," TITLE BAIIO1",TEM);
CPRINT(BCHPD[3]," TITLE BAIIO2",TEM);
CPRINT(BCHPD[4]," TITLE BAIMSC",TEM);
CPRINT(BCHPD[5]," TITLE BAIPRC",TEM);
NOTENX(<OUT(BAICH2," TITLE PD8SM1
↑↑START: RESET
OPEN 1,FDB1
HALT .
ENTER 1,ENT1
HALT .
OPEN 2,FDB2
HALT .
ENTER 2,ENT2
HALT .
OPEN 3,FDB3
HALT .
ENTER 3,ENT3
HALT .
OPEN 4,FDB4
HALT .
ENTER 4,ENT4
HALT .
OPEN 5,FDB5
HALT .
ENTER 5,ENT5
HALT .
A←1
B←2
C←3
D←4
F←6
P←17
MOVE P,[IOWD 10,PDL]
MOVE A,[POINT 36,$BEGIN]
NEXT: ILDB F,A ;WHICH FILE IT GOES TO
CAMN F,[-1]
JRST FIN
MOVE F,-1+[ OBUF1
OBUF2
OBUF3
OBUF4
OBUF5](F) ;ADDR OF BUFFER RING
ILDB B,A ;FIRST DATA WORD
PUSHJ P,WORD
ILDB B,A ;SECOND DATA WORD
PUSHJ P,WORD
MOVEI D,-400000+3(B) ;NUMBER OF ADDITIONAL DATA WORDS
ILDB B,A
PUSHJ P,WORD
SOJG D,.-2
JRST NEXT
FIN: MOVEI D,5
MOVE F,-1+[OBUF1↔OBUF2↔OBUF3↔OBUF4↔OBUF5](D)
MOVE B,[-1] ;END-OF-FILE FLAG
PUSHJ P,WORD
SOJG D,FIN+1 ;FOR EACH FILE
RELEASE 1,
RELEASE 2,
RELEASE 3,
RELEASE 4,
RELEASE 5,
EXIT
WORD: SOSG 2(F) ;DECR CHR COUNT
XCT 3(F) ;NO ROOM. DO OUT
JRST WORD1
HALT .
WORD1: IDPB B,1(F)
POPJ P,
FDB1: 14 ;IMAGE MODE
SIXBIT /DSK/
.+1,,0 ;OUTPUT BUFFER RING
OBUF1: BLOCK 3
OUT 1, ;XCT'ED TO WRITE BUFFER
FDB2: 14 ;IMAGE MODE
SIXBIT /DSK/
.+1,,0 ;OUTPUT BUFFER RING
OBUF2: BLOCK 3
OUT 2, ;XCT'ED TO WRITE BUFFER
FDB3: 14 ;IMAGE MODE
SIXBIT /DSK/
.+1,,0 ;OUTPUT BUFFER RING
OBUF3: BLOCK 3
OUT 3, ;XCT'ED TO WRITE BUFFER
FDB4: 14 ;IMAGE MODE
SIXBIT /DSK/
.+1,,0 ;OUTPUT BUFFER RING
OBUF4: BLOCK 3
OUT 4, ;XCT'ED TO WRITE BUFFER
FDB5: 14 ;IMAGE MODE
SIXBIT /DSK/
.+1,,0 ;OUTPUT BUFFER RING
OBUF5: BLOCK 3
OUT 5, ;XCT'ED TO WRITE BUFFER
ENT1: SIXBIT /BAICLC/
SIXBIT /SM1/
0
0
ENT2: SIXBIT /BAIIO1/
SIXBIT /SM1/
0
0
ENT3: SIXBIT /BAIIO2/
SIXBIT /SM1/
0
0
ENT4: SIXBIT /BAIMSC/
SIXBIT /SM1/
0
0
ENT5: SIXBIT /BAIPRC/
SIXBIT /SM1/
0
0
PDL: BLOCK 10
$BEGIN:
PDA1←←PDA2←←PDA3←←PDA4←←PDA5←←1
");>) COMMENT NOTENX;
TENX(< OUT(BAICH2," TITLE PD8SM1
↑↑START: RESET
A←4
B←5
C←6
D←7
P←17
MOVE P,[IOWD 10,PDL]
MOVEI D,5
GTNEXT: MOVSI 1,1
HRRO 2,-1+[ [ASCIZ/BAICLC.SM1/]
[ASCIZ/BAIIO1.SM1/]
[ASCIZ/BAIIO2.SM1/]
[ASCIZ/BAIMSC.SM1/]
[ASCIZ/BAIPRC.SM1/] ](D)
GTJFN
PUSHJ P,ERR
MOVEM 2,JFN-1(D)
MOVE 2,[440000100000]
OPENF
PUSHJ P,ERR
SOJG, D,GTNEXT
MOVE A,[POINT 36,$BEGIN]
NEXT: ILDB F,A ;WHICH FILE IT GOES TO
CAMN F,[-1]
JRST FIN
MOVE 1,JFN-1(F) ;WHICH JFN
ILDB 2,A ;FIRST DATA WORD
BOUT
ILDB 2,A ;SECOND DATA WORD
MOVEI D,-400000+3(B) ;NUMBER OF ADDITIONAL DATA WORDS
BOUT
ILDB 2,A
BOUT
SOJG D,.-2
JRST NEXT
FIN: MOVEI D,5
MOVE 1,JFN-1(D)
MOVE 2,[-1] ;END-OF-FILE FLAG
BOUT
CLOSF
PUSHJ P,ERR
SOJG D,FIN ;FOR EACH FILE
HALTF
ERR: HRROI 1,[ASCIZ /ERROR!/]
PSOUT
JRST ERR-1
JFN: BLOCK 5
$BEGIN:
PDA1←←PDA2←←PDA3←←PDA4←←PDA5←←1
");>) COMMENT TENX;
FOR T←0 STEP 1 UNTIL BUCKLEN DO BUCKET[T]←"0";
TYPCNT←SYMCNT←COMMAND←EOF←0;
LINENO←LINCNT;
END;
SIMPLE BOOLEAN PROCEDURE ISON(STRING A);
BEGIN INTEGER I;
FOR I←1 STEP 1 UNTIL NCOND DO IF EQU(A,CONDWORD[I]) THEN RETURN(TRUE);
RETURN(FALSE) 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 SRCBRK="[" THEN BEGIN COMMENT CONDITIONAL COMPILTION;
INPUT(SRC,ONESCAN);
IF ISON(WORD) THEN WORD←GETWORD
ELSE BEGIN INTEGER CCNT;
CCNT←1;
DO BEGIN
INPUT(SRC,CBRK);
IF SRCBRK="[" THEN CCNT←CCNT+1;
IF SRCBRK="]" THEN CCNT←CCNT-1 END
UNTIL CCNT=0;
WORD←GETWORD
END
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, Cond;
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";
PROCEDURE COND;
BEGIN STRING A;
WHILE COMMAND =0 DO BEGIN
A←GETWORD; IF COMMAND NEQ 0 THEN DONE;
CONDWORD[NCOND←NCOND+1]←A END
END;
COMMENT Functions;
PROCEDURE FUNCTIONS;
BEGIN
INTEGER J,PAR,I,EXTREF; INTEGER NVSTRPAR,NPDA,BRCHAR,BCH;
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); BCH←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"));
IF BCH NEQ 0 THEN CPRINT(BCHPD[BCH],"
EXTERNAL ",D,"
0
LINK PDLNK,.-1
,",D,"
",CVOS(LENGTH(A)),"
POINT 7,[ASCII/",A,"/]
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");
IF BCH NEQ 0 THEN CPRINT(BAICH2,"
",BCH,"
4
400000+",CVOS((LENGTH(A)+4)%5),"
XWD 777777,0
XWD BBLTPRC+",TYPE,",PDA",BCH,"
ASCII /",A,"/
PDA",BCH,"←←PDA",BCH,"+14+",CVOS(PAR),"
0");
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;
IF BCH NEQ 0 THEN CPRINT(BCHPD[BCH],"
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";
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;
STRING TEM1,TEM2;
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,"<TRUECONDITIONALS>") THEN COND;
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;
CPRINT(BCHPD[2],";SOME PROCEDURES NOMRALLY COMPILED INLINE
0 ;WORD FOR PROCEDURE DESCRIPTOR LINK
LINK PDLNK,.-1
..LDB ;ENTRY ADDRESS
3 ;SAIL STRING DESCRIPTOR FOR NAME
POINT 7,[ASCII/LDB/]
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
0
LINK PDLNK,.-1
..ILDB
4
POINT 7,[ASCII/ILDB/]
REFB+PROCB+INTEGR
XWD 0,2
0
0
XWD 0,.+4
XWD .-10,0
XWD ..ILDB,0
XWD ..ILDB,0
0+INTEGR+REFRNC
0
LINK PDLNK,.-1
..IBP
3
POINT 7,[ASCII/IBP/]
REFB+PROCB
XWD 0,2
0
0
XWD 0,.+4
XWD .-10,0
XWD ..IBP,0
XWD ..IBP,0
0+INTEGR+REFRNC
0
LINK PDLNK,.-1
..DPB
3
POINT 7,[ASCII/DPB/]
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
0
LINK PDLNK,.-1
..IDPB
4
POINT 7,[ASCII/IDPB/]
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
P←←17
TEMP←←14
INTERNAL ..LDB,..ILDB,..DPB,..IDPB,..IBP
EXTERNAL X22,X33
..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
");
OUT(BAICH2,"
;FOR THE FAKE RUNTIMES
2 ;'MAJOR IO' FILE
4 ;PROCEDURE INFO COMING
400000+1 ;FLAG+ NUMBER OF WORDS IN NAME
XWD 777777,0 ;THIS WORD IGNORED BY BAIL'S LOADER
XWD BBLTPRC+INTEGR,PDA2 ;TYPE BITS,,ADDR OF PDA IN BAIPDn FILE
ASCII /LDB/ ;NAME
0
PDA2←←PDA2+14+1
2
4
400000+1
XWD 777777,0
XWD BBLTPRC+INTEGR,PDA2
ASCII /ILDB/
0
PDA2←←PDA2+14+1
2
4
400000+1
XWD 777777,0
XWD BBLTPRC,PDA2
ASCII /IBP/
0
PDA2←PDA2+14+1
2
4
400000+1
XWD 777777,0
XWD BBLTPRC,PDA2
ASCII /DPB/
0
PDA2←←PDA2+14+2
2
4
400000+1
XWD 777777,0
XWD BBLTPRC,PDA2
ASCII /IDPB/
0 ;END OF FAKIRS
PDA2←←PDA2+14+2
");
TEM1←"
0
LINK BALNK,.-1
XWD $BEGIN,$BEGIN" & NOTENX(<"
1,,1
SIXBIT /">); TENX(<"
1,,4
ASCII /<SAIL>">);
TEM2←TENX(<".SM1"&>) "/
-1
END
";
CPRINT(BCHPD[1],TEM1,"BAICLC",TEM2);
CPRINT(BCHPD[2],TEM1,"BAIIO1",TEM2);
CPRINT(BCHPD[3],TEM1,"BAIIO2",TEM2);
CPRINT(BCHPD[4],TEM1,"BAIMSC",TEM2);
CPRINT(BCHPD[5],TEM1,"BAIPRC",TEM2);
RELEASE(BCHPD[1]); RELEASE(BCHPD[2]); RELEASE(BCHPD[3]);
RELEASE(BCHPD[4]); RELEASE(BCHPD[5]);
OUT(BAICH2,"
-1
END START
");
RELEASE(BAICH2);
PUTOUT("BEND RESTAB");
END "EXEC";
END "RTRAN";