Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0002/rtran.sai
There is 1 other file named rtran.sai in the archive. Click here to see a list.
COMMENT    VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	HISTORY
C00004 00003	Declarations, Trivial Procedures
C00009 00004	Initialization, Getword, Hash, Reserved, Nxtsym, Gensym, Ison
C00019 00005	Printreserved, Assigned
C00021 00006	Macros, Cond
C00024 00007	Functions
C00030 00008	Defin, Main Loop
C00037 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, CMDSCNSCNCMD
VERSION 10(1) 1-14-72 BY DCS REPLACE CMDSCN BY SCNCMD

;
COMMENT Declarations, Trivial Procedures;

BEGIN "RTRAN" 
  DEFINE VERSIONNUMBER = "'401200000042";
  LET DEFINE = REDEFINE;
  DEFINE VERSIONNUMBER = "'401200000037";
 REQUIRE VERSIONNUMBER 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
IFC EQU(COMPILER!BANNER[LENGTH(SCANC(COMPILER!BANNER,"-",NULL,
	"IA"))+1 FOR 8],"TYMSHARE") THENC
   DEFINE TYMSW(A)=<A>,NOTYMSW(A)=<>; ELSEC
   DEFINE TYMSW(A)=<>,NOTYMSW(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=<"X">;
REQUIRE "SCNCMD.SAI" SOURCEFILE;

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=<220>,LINCNT=<5>,BUCKLEN=<13>;

EXTERNAL INTEGER $OS;
INTEGER OSTYP;

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");

	NXTFIL_0; WANTBIN_TRUE; NCOND_1;
	TYMSW (<CONDWORD[1]_"TYMSHARE";>)
	NOTYMSW (<CONDWORD[1]_"NOTYMSHARE";>)
	COMMANDSCAN;

	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,"
ITMVAR_ITMVAR+UNTYPE	;TYPE KLUGE
");

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+[OBUF1OBUF2OBUF3OBUF4OBUF5](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
PDL:	BLOCK 20	;[clh]
^^START: RESET
A_4
B_5
C_6
D_7
F_11			;[clh]
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	1,JFN-1(D)	;[clh]
	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(2)	;[clh] NUMBER OF ADDITIONAL DATA WORDS
	BOUT
	ILDB	2,A
	BOUT
	SOJG	D,.-2
	JRST	NEXT

FIN:	MOVEI	D,5
FLOOP:	MOVE	1,JFN-1(D)	;[clh]
	MOVE	2,[-1]		;END-OF-FILE FLAG
	BOUT
	CLOSF
	 PUSHJ	P,ERR
	SOJG	D,FLOOP		;[clh] 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
		COMMANDSCAN;
		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='177BYT='15BYT='12 THEN CVOS(BYT) ELSE
         """"&BYT&""""); NUM_NUM+1;
      IF NUM=15BYT=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 COMMAND0 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,STRING0	;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,0000XWD	"&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("	00");
	    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+$DFLT$+" & 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;
ONETIME_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
$DFLT$:	0

	0
	LINK	BALNK,.-1
	XWD	$BEGIN,$BEGIN
";

	TEM2_"
	-1
	END
";
BEGIN "UGHFAIL"
SIMPLE STRING PROCEDURE F(STRING A); RETURN("
IFNDEF GTJFN,<
	1,,1
	SIXBIT	/"&A&"/
>;IFNDEF GTJFN
"&(if OSTYP
     then
"IFDEF GTJFN,<
	1,,3
	ASCIZ	/SAI:"
      else
"IFDEF GTJFN,<
	1,,4
	ASCII	/<SAIL>")
&A&".SM1/
>;IFDEF GTJFN
");
	IF SWTVAL[1]   COMMENT if user typed /nnX;
	  THEN IF SWTVAL[1] = 10  COMMENT /10X is Tenex;
		 THEN OSTYP _ 0
		 ELSE OSTYP _ 2   COMMENT else T20;
 	  ELSE IF ($OS LAND '770000) = '030000  COMMENT TENEX IF ON IT;
		 THEN OSTYP _ 0
		 ELSE OSTYP _ 2;	COMMENT ELSE USE T20;
outstr("BAIL files for Tops-10 and "&(IF OSTYP THEN "Tops-20" else "Tenex")&" being produced"&'15&'12);
	CPRINT(BCHPD[1],TEM1,F("BAICLC"),TEM2);
	CPRINT(BCHPD[2],TEM1,F("BAIIO1"),TEM2);
	CPRINT(BCHPD[3],TEM1,F("BAIIO2"),TEM2);
	CPRINT(BCHPD[4],TEM1,F("BAIMSC"),TEM2);
	CPRINT(BCHPD[5],TEM1,F("BAIPRC"),TEM2);
END "UGHFAIL";

	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";