perm filename RTRAN.SAI[S,AIL]8 blob sn#198154 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 P∃TOUT(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";