/*
**	Code derived from program rpc_compiler
*/
extern void	exit();
/*
**	Definitions for i/o
*/
# include <stdio.h>
typedef struct {
	FILE	*fp;
	unsigned short	eoln:1,
			eof:1,
			out:1,
			init:1,
			:12;
	char	buf;
} 	text;
text	input = { stdin, 0, 0 };
text	output = { stdout, 0, 0 };
# define Fread(x, f) fread((char *)&x, sizeof(x), 1, f)
# define Get(f) Fread((f).buf, (f).fp)
# define Getx(f) (f).init = 1, (f).eoln = (((f).buf = fgetc((f).fp)) == '\n') ? (((f).buf = ' '), 1) : 0
# define Getchr(f) (f).buf, Getx(f)
static FILE	*Tmpfil;
static long	Tmplng;
static double	Tmpdbl;
# define Fscan(f) (f).init ? ungetc((f).buf, (f).fp) : 0, Tmpfil = (f).fp
# define Scan(p, a) Scanck(fscanf(Tmpfil, p, a))
void	Scanck();
void	Getl();
# define Eoln(f) ((f).eoln ? true : false)
# define Eof(f) ((((f).init == 0) ? (Get(f)) : 0, ((f).eof ? 1 : feof((f).fp))) ? true : false)
# define Eofx(f) ((((f).init == 0) ? (Getx(f)) : 0, ((f).eof ? 1 : feof((f).fp))) ? true : false)
# define Fwrite(x, f) fwrite((char *)&x, sizeof(x), 1, f)
# define Put(f) Fwrite((f).buf, (f).fp)
# define Putx(f) (f).eoln = ((f).buf == '\n'), (void)fputc((f).buf, (f).fp)
# define Putchr(c, f) (f).buf = (c), Putx(f)
# define Putl(f, v) (f).eoln = v
# define Finish(f) ((f).out && !(f).eoln) ? (Putchr('\n', f), 0) : 0, !fseek((f).fp, 0L, 0)
extern int	fseek();
# ifdef READONLY
static char	Rmode[] = "r";
# else
static char	Rmode[] = "r+";
# endif
# define Reset(f, n, l) (f).init = (f).init ? !fseek((f).fp, 0L, 0) : (((f).fp = Fopen(n, l, Rmode)), 1), (f).eof = (f).out = 0, Get(f)
# define Resetx(f, n, l) (f).init = (f).init ? (Finish(f)) : (((f).fp = Fopen(n, l, Rmode)), 1), (f).eof = (f).out = 0, Getx(f)
# ifdef WRITEONLY
static char	Wmode[] = "w";
# else
static char	Wmode[] = "w+";
# endif
# define Rewrite(f, n, l) (f).init = (f).init ? !fseek((f).fp, 0L, 0) : (((f).fp = Fopen(n, l, Wmode)), 1), (f).out = (f).eof = 1
# define Rewritex(f, n, l) (f).init = (f).init ? (Finish(f)) : (((f).fp = Fopen(n, l, Wmode)), 1), (f).out = (f).eof = (f).eoln = 1
FILE	*Fopen();
# ifndef MAXFILENAME
# define MAXFILENAME 128
# endif
/*
**	Definitions for case-statements
**	and for non-local gotos
*/
# define Line __LINE__
void	Caseerror();
/*
**	Definitions for standard types
*/
extern int strncmp();
# define Cmpstr(x, y) strncmp((x), (y), sizeof(x))
typedef char	boolean;
# define false (boolean)0
# define true (boolean)1
extern char	*Bools[];
typedef int	integer;
# define maxint	2147483647
extern void abort();
/*
**	Definitions for pointers
*/
# ifndef Unionoffs
# define Unionoffs(p, m) (((long)(&(p)->m))-((long)(p)))
# endif
# define NIL 0
extern char *malloc();
extern void free();
/*
**	Definitions for set-operations
*/
# define Claimset() (void)Currset(0, (setptr)0)
# define Newset() Currset(1, (setptr)0)
# define Saveset(s) Currset(2, s)
# define setbits 15
typedef unsigned short	setword;
typedef setword *	setptr;
boolean	Member(), Le(), Ge(), Eq(), Ne();
setptr	Union(), Diff();
setptr	Insmem(), Mksubr();
setptr	Currset(), Inter();
static setptr	Tmpset;
extern setptr	Conset[];
void	Setncpy();
# ifndef SETALIGN
# define SETALIGN(x) Alignset(x)
struct Set { unsigned short	S[15+1]; } *Alignset();
# endif
# ifndef STRALIGN
# define STRALIGN(x) Alignstr(x)
struct String { char   A[127+1]; } *Alignstr();
# endif
extern char *strncpy();
/*
**	Definitions for argv-operations
*/
int	argc;
char	**argv;
 void
Argvgt(n, cp, l)
int	n;
register int	l;
register char	*cp;
{
	register char	*sp;

	for (sp = argv[n]; l > 0 && *sp; l--)
		*cp++ = *sp++;
	while (l-- > 0)
		*cp++ = ' ';
}
/*
**	Start of program definitions
*/
# define rpc_name_length 40
# define maxstring 255
# define expression_length 80
# define template_length 10
# define error_length 48
# define maxidlen 25
# define numkeyword 27
# define numomodes 11
# define maxdim 9
# define non_fragmentation_limit 1488
# define fragmentation_threshold 150
# define rpc_default_timeout -1
# define commandline true
typedef struct { char	A[maxstring - 1 + 1]; }	longstring;
typedef struct { char	A[maxidlen - 1 + 1]; }	char_name;
typedef struct { char	A[3 - 1 + 1]; }	char3;
typedef struct { char	A[10 - 1 + 1]; }	opt_name;
typedef struct { char	A[template_length - 1 + 1]; }	template_type;
typedef struct { char	A[error_length - 1 + 1]; }	error_string;
typedef struct S103 {
	struct { char	A[maxstring - 1 + 1]; }	str;
	integer	len;
}	astring;
typedef struct S104 {
	struct { char	A[maxstring - 1 + 1]; }	str;
	integer	start, len;
}	pilstring;
typedef struct S102 {
	char_name	str;
	integer	len;
}	id_name;
typedef struct S106 {
	struct { char	A[expression_length - 1 + 1]; }	str;
	integer	len;
}	expression;
typedef enum { chartok, bytetok, shortok, integertok,
	real32tok, real48tok, real64tok, real128tok,
	longtok, arraytok, recordtok, accesstok,
	sequence, stringtok, substring, package,
	semicolon, istok, typetok, endtok,
	colon, comma, opnround, clsround,
	oftok, intok, outok, inoutok,
	dot, ident, number, proctok,
	functok, E1_C33_return, pragmatok, nultok } 	type_token;
typedef struct S105 {
	type_token	kind;
	union {
		struct  {
			id_name	name;
		} V2;
		struct  {
			integer	value;
		} V3;
	} U;
}	token_descriptor;
typedef type_token	courier_type;
typedef type_token	simple_type;
typedef type_token	block_type;
typedef type_token	attr_type;
typedef struct S75 *	ptr_defined_type;
typedef struct S76 *	ptr_named_type;
typedef struct S77 *	ptr_idlist;
typedef struct S78 *	ptr_block_table;
typedef struct S75 {
	ptr_named_type	typ_name;
	integer	typ_min_size;
	integer	typ_max_size;
	integer	typ_nesting;
	ptr_defined_type	typ_subtype;
	boolean	typ_external;
	courier_type	typ_basic_type;
	union {
		struct  {
			integer	typ_low, typ_high;
		} V4;
		struct  {
			ptr_named_type	typ_fields;
		} V5;
	} U;
}	defined_type;
typedef struct S76 {
	ptr_named_type	nty_next;
	id_name	nty_name;
	ptr_defined_type	nty_type;
}	named_type;
typedef struct S77 {
	ptr_idlist	next;
	id_name	name;
	attr_type	attr;
	ptr_defined_type	id_type;
}	id_list;
typedef struct S78 {
	ptr_block_table	next;
	id_name	name;
	block_type	b_type;
	simple_type	C33_return;
	ptr_idlist	list;
	boolean	in_only;
	integer	blk_nesting;
	integer	blk_min_in, blk_max_in;
	integer	blk_min_out, blk_max_out;
	integer	blk_timeout;
	ptr_idlist	blk_status_param;
	boolean	blk_concurrent, blk_cast;
}	block_table;
typedef enum { ill_basic_type, number_req, oftok_miss, simtype_req,
	blocks_req, ident_req, twice_declared, semicol_miss,
	var_attr_req, colon_miss, id_not_declared, clsround_miss,
	opnround_miss, package_miss, endtok_miss, char_ignored,
	params_miss, input_miss, comma_miss, semic_round_miss,
	toomany_dim, toomany_dig, proc_exp, cant_opn_input,
	cant_opn_client, cant_opn_server, cant_cls_client, cant_cls_server,
	dot_miss, positive_req, cant_cls_input, ident_reserved,
	istok_miss, record_miss, invalid_range, bad_proc_decl,
	bad_name, type_miss, return_miss, cant_opn_ext,
	internal_error, bad_input_name, cant_cls_ext, unexp_eof } 	err_type;
typedef struct { setword	S[4]; }	set_of_token;
typedef enum { rewriting, resetting } 	open_mode;
typedef enum { cerncross, m6809, monolith, vaxvms,
	vaxpas, unixbsd, pcturbo, macturbo,
	pils, vaxfor, genericc } 	output_mode;
typedef enum { ccerncross, cm6809, cmonolith, cvaxvms,
	cvaxpas, cunixbsd, cpcturbo, cmacturbo,
	cpils, cvaxfor, cgenericc, scerncross,
	sm6809, smonolith, svaxvms, svaxpas,
	sunixbsd, spcturbo, smacturbo, spils,
	svaxfor, sgenericc, dlex, dlexhot,
	dtree, shortint, stdescr, concurrent,
	noautoinit, byvalue, timeout, version,
	types, invalid } 	options;
typedef options	rangeoptions;
typedef struct { struct  {
	char_name	name;
	type_token	symbol;
}	A[numkeyword - 1 + 1]; }	T79;
typedef struct { struct { char	A[3 - 1 + 1]; }	A[2]; }	T80;
typedef struct { ptr_defined_type	A[(int)(longtok) + 1]; }	T81;
typedef struct { struct  {
	opt_name	name;
	boolean	value;
}	A[(int)(invalid) + 1]; }	T82;
ptr_block_table	*G141_scan;
ptr_idlist	*G139_scanlist;
integer	*G137_proc_number;
text	*G135_where;
boolean	*G133_doing_externals;
text	*G131_where;
boolean	*G129_check_subtypes;
integer	*G127_original_size;
boolean	*G125_check_size;
boolean	*G123_topack;
integer	*G121_level;
text	*G119_where;
ptr_block_table	*G117_scan;
integer	*G115_proc_number;
ptr_block_table	*G113_scan;
integer	*G111_proc_number;
integer	*G109_col;
ptr_idlist	*G107_headlist;
ptr_named_type	typeptr;
ptr_block_table	blockptr;
id_name	unitname;
integer	checksum;
boolean	is_blank;
char	ch_there;
char	lastcar;
char	oldchar;
boolean	char_ready;
boolean	incomment;
integer	lastindex;
token_descriptor	token, lastoken;
boolean	tok_present;
integer	lineread;
integer	maxkeyword;
T79	keyword;
T80	upkpck;
T81	simple_descriptor;
boolean	external_marshalling;
integer	number_of_invented_types;
integer	errorfound;
text	inp_file;
astring	inp_name;
pilstring	inp_line;
text	op_file;
astring	cli_name;
astring	ser_name;
astring	ext_name;
integer	next_label;
integer	size_so_far;
boolean	fragmentation_used;
boolean	deref, dr_tmp;
boolean	cli_spec, ser_spec;
output_mode	omode, ser_mode, cli_mode;
boolean	client;
struct { setword	S[2]; }	cmode;
integer	timeout_val;
integer	version_num;
T82	runoptions;

void getoken();

void backtoken();

 void
error(which)
	err_type	which;
{
	(void)fprintf(output.fp, "ERROR: "), Putl(output, 0);
	errorfound = errorfound + 1;
	if (!(Member((unsigned)(which), Conset[0])))
		(void)fprintf(output.fp, "RPCC: Panic: compiler internal error, notify the compiler's Administrator.\n"), Putl(output, 1);
	else
		switch ((int)(which)) {
		  case ill_basic_type:
			(void)fprintf(output.fp, "Illegal basic type.\n"), Putl(output, 1);
			break ;
		  case invalid_range:
			(void)fprintf(output.fp, "Upper bound must be greater then lower.\n"), Putl(output, 1);
			break ;
		  case number_req:
			(void)fprintf(output.fp, "Number requested.\n"), Putl(output, 1);
			break ;
		  case oftok_miss:
			(void)fprintf(output.fp, "Keyword \"of\" missing.\n"), Putl(output, 1);
			break ;
		  case simtype_req:
			(void)fprintf(output.fp, "Simple type requested.\n"), Putl(output, 1);
			break ;
		  case positive_req:
			(void)fprintf(output.fp, "Index must be positive.\n"), Putl(output, 1);
			break ;
		  case ident_req:
			(void)fprintf(output.fp, "Identifier requested.\n"), Putl(output, 1);
			break ;
		  case blocks_req:
			(void)fprintf(output.fp, "At least a procedure/function declaration requested.\n"), Putl(output, 1);
			break ;
		  case bad_proc_decl:
			(void)fprintf(output.fp, "Parameter must be simple or already declared in type section.\n"), Putl(output, 1);
			break ;
		  case twice_declared:
			(void)fprintf(output.fp, "Identifier already declared.\n"), Putl(output, 1);
			break ;
		  case semicol_miss:
			(void)fprintf(output.fp, "Semicolon \";\" missing.\n"), Putl(output, 1);
			break ;
		  case semic_round_miss:
			(void)fprintf(output.fp, "Semicolon \";\" or round bracket \")\" missing.\n"), Putl(output, 1);
			break ;
		  case comma_miss:
			(void)fprintf(output.fp, "Comma \",\" missing.\n"), Putl(output, 1);
			break ;
		  case var_attr_req:
			(void)fprintf(output.fp, "\"in\",\"out\" or \"in out\" required.\n"), Putl(output, 1);
			break ;
		  case colon_miss:
			(void)fprintf(output.fp, "Colon \":\" missing.\n"), Putl(output, 1);
			break ;
		  case dot_miss:
			(void)fprintf(output.fp, "Dot \".\" missing.\n"), Putl(output, 1);
			break ;
		  case id_not_declared:
			(void)fprintf(output.fp, "Identifier not declared.\n"), Putl(output, 1);
			break ;
		  case clsround_miss:
			(void)fprintf(output.fp, "Round bracket \")\" missing.\n"), Putl(output, 1);
			break ;
		  case opnround_miss:
			(void)fprintf(output.fp, "Round bracket \"(\" missing.\n"), Putl(output, 1);
			break ;
		  case package_miss:
			(void)fprintf(output.fp, "Keyword \"package\" missing.\n"), Putl(output, 1);
			break ;
		  case record_miss:
			(void)fprintf(output.fp, "Keyword \"record\" missing.\n"), Putl(output, 1);
			break ;
		  case return_miss:
			(void)fprintf(output.fp, "Keyword \"return\" missing.\n"), Putl(output, 1);
			break ;
		  case istok_miss:
			(void)fprintf(output.fp, "Keyword \"is\" missing.\n"), Putl(output, 1);
			break ;
		  case endtok_miss:
			(void)fprintf(output.fp, "Keyword \"end\" missing.\n"), Putl(output, 1);
			break ;
		  case type_miss:
			(void)fprintf(output.fp, "Keyword \"type\", \"procedure\" or \"function\" missing.\n"), Putl(output, 1);
			break ;
		  case char_ignored:
			(void)fprintf(output.fp, "Illegal character:\"%c\", ignored.\n", lastcar), Putl(output, 1);
			break ;
		  case toomany_dig:
			(void)fprintf(output.fp, "Too many digits in this number.\n"), Putl(output, 1);
			break ;
		  case toomany_dim:
			(void)fprintf(output.fp, "Too many dimensions in this array.\n"), Putl(output, 1);
			break ;
		  case ident_reserved:
			(void)fprintf(output.fp, "Identifier reserved for compiler use.\n"), Putl(output, 1);
			break ;
		  case bad_name:
			(void)fprintf(output.fp, "Identifier does not match already declared package name.\n"), Putl(output, 1);
			break ;
		  case proc_exp:
			(void)fprintf(output.fp, "Keyword \"procedure\" or \"function\" expected.\n"), Putl(output, 1);
			break ;
		  case params_miss:
			(void)fprintf(output.fp, "Parameters missing.\n"), Putl(output, 1);
			break ;
		  case input_miss:
			(void)fprintf(output.fp, "Input file missing, can't go on.\n"), Putl(output, 1);
			break ;
		  case bad_input_name:
			(void)fprintf(output.fp, "Bad input file name: \".ext\" extension reserved.\n"), Putl(output, 1);
			break ;
		  case cant_opn_input:
			(void)fprintf(output.fp, "Can't open input file.\n"), Putl(output, 1);
			break ;
		  case cant_opn_ext:
			(void)fprintf(output.fp, "Can't open \".ext\" file.\n"), Putl(output, 1);
			break ;
		  case cant_opn_client:
			(void)fprintf(output.fp, "Can't open client file.\n"), Putl(output, 1);
			break ;
		  case cant_opn_server:
			(void)fprintf(output.fp, "Can't open server file.\n"), Putl(output, 1);
			break ;
		  case cant_cls_input:
			(void)fprintf(output.fp, "Can't close input file.\n"), Putl(output, 1);
			break ;
		  case cant_cls_client:
			(void)fprintf(output.fp, "Can't close client file.\n"), Putl(output, 1);
			break ;
		  case cant_cls_server:
			(void)fprintf(output.fp, "Can't close server file.\n"), Putl(output, 1);
			break ;
		  case cant_cls_ext:
			(void)fprintf(output.fp, "Can't close \".ext\" file.\n"), Putl(output, 1);
			break ;
		  case internal_error:
			(void)fprintf(output.fp, "Sorry - Unexpected internal condition in compiler.\n"), Putl(output, 1);
			break ;
		  case unexp_eof:
			(void)fprintf(output.fp, "Unexpected end of input file.\n"), Putl(output, 1);
			break ;
		  default:
			Caseerror(Line);
		}
}

 void
write_token(what)
	type_token	what;
{
	if (!(Member((unsigned)(what), Conset[1])))
		(void)fprintf(output.fp, "(Unknown token!)"), Putl(output, 0);
	else
		switch ((int)(what)) {
		  case chartok:
			(void)fprintf(output.fp, "RPC_CHAR"), Putl(output, 0);
			break ;
		  case bytetok:
			(void)fprintf(output.fp, "RPC_BYTE"), Putl(output, 0);
			break ;
		  case shortok:
			(void)fprintf(output.fp, "RPC_SHORT"), Putl(output, 0);
			break ;
		  case integertok:
			(void)fprintf(output.fp, "RPC_INTEGER"), Putl(output, 0);
			break ;
		  case real32tok:
			(void)fprintf(output.fp, "RPC_REAL32"), Putl(output, 0);
			break ;
		  case real48tok:
			(void)fprintf(output.fp, "RPC_REAL48"), Putl(output, 0);
			break ;
		  case real64tok:
			(void)fprintf(output.fp, "RPC_REAL64"), Putl(output, 0);
			break ;
		  case real128tok:
			(void)fprintf(output.fp, "RPC_REAL128"), Putl(output, 0);
			break ;
		  case longtok:
			(void)fprintf(output.fp, "RPC_LONG"), Putl(output, 0);
			break ;
		  case arraytok:
			(void)fprintf(output.fp, "ARRAY"), Putl(output, 0);
			break ;
		  case sequence:
			(void)fprintf(output.fp, "SEQUENCE"), Putl(output, 0);
			break ;
		  case stringtok:
			(void)fprintf(output.fp, "STRING"), Putl(output, 0);
			break ;
		  case substring:
			(void)fprintf(output.fp, "SUBSTRING"), Putl(output, 0);
			break ;
		  case package:
			(void)fprintf(output.fp, "PACKAGE"), Putl(output, 0);
			break ;
		  case semicolon:
			(void)fprintf(output.fp, "SEMICOLON"), Putl(output, 0);
			break ;
		  case typetok:
			(void)fprintf(output.fp, "TYPE"), Putl(output, 0);
			break ;
		  case endtok:
			(void)fprintf(output.fp, "END"), Putl(output, 0);
			break ;
		  case colon:
			(void)fprintf(output.fp, "colon \":\""), Putl(output, 0);
			break ;
		  case comma:
			(void)fprintf(output.fp, "comma \",\""), Putl(output, 0);
			break ;
		  case opnround:
			(void)fprintf(output.fp, "\"(\""), Putl(output, 0);
			break ;
		  case clsround:
			(void)fprintf(output.fp, "\")\""), Putl(output, 0);
			break ;
		  case oftok:
			(void)fprintf(output.fp, "OF"), Putl(output, 0);
			break ;
		  case intok:
			(void)fprintf(output.fp, "IN"), Putl(output, 0);
			break ;
		  case outok:
			(void)fprintf(output.fp, "OUT"), Putl(output, 0);
			break ;
		  case inoutok:
			(void)fprintf(output.fp, "INOUT"), Putl(output, 0);
			break ;
		  case istok:
			(void)fprintf(output.fp, "IS"), Putl(output, 0);
			break ;
		  case E1_C33_return:
			(void)fprintf(output.fp, "RETURN"), Putl(output, 0);
			break ;
		  case dot:
			(void)fprintf(output.fp, "\".\""), Putl(output, 0);
			break ;
		  case ident:
			(void)fprintf(output.fp, "identifier"), Putl(output, 0);
			break ;
		  case number:
			(void)fprintf(output.fp, "number"), Putl(output, 0);
			break ;
		  case proctok:
			(void)fprintf(output.fp, "PROCEDURE"), Putl(output, 0);
			break ;
		  case functok:
			(void)fprintf(output.fp, "FUNCTION "), Putl(output, 0);
			break ;
		  case nultok:
			(void)fprintf(output.fp, "(Null Token!)"), Putl(output, 0);
			break ;
		  default:
			Caseerror(Line);
		}
}

 void
print_last_line()
{
	register integer	a;

	(void)fprintf(output.fp, "INPUT:"), Putl(output, 0);
	{
		integer	B6 = 1,
			B7 = inp_line.len;

		if (B6 <= B7)
			for (a = B6; ; a++) {
				Putchr(inp_line.str.A[a - 1], output);
				if (a == B7) break;
			}
	}
	Putchr('\n', output);
	{
		integer	B8 = 1,
			B9 = lastindex + 4;

		if (B8 <= B9)
			for (a = B8; ; a++) {
				Putchr('-', output);
				if (a == B9) break;
			}
	}
	Putchr('^', output);
	Putchr('\n', output);
}

 void
linerror(which)
	err_type	which;
{
	(void)fprintf(output.fp, "RPCC: Error found on line %3d:\n", lineread), Putl(output, 1);
	print_last_line();
	error(which);
	Putchr('\n', output);
}

 void
find_tok(kind)
	set_of_token	kind;
{
	while (!(Member((unsigned)(token.kind), kind.S)))
		getoken();
}

 void
errfind(which, kind)
	err_type	which;
	set_of_token	kind;
{
	linerror(which);
	find_tok(kind);
}

 void
abort_pgm(which)
	err_type	which;
{
	error(which);
	(void)fprintf(output.fp, "Fatal error, program aborted.\n"), Putl(output, 1);
	abort();
}

 void
debug_print_name(where, name)
	text	*where;
	id_name	name;
{
	register integer	i;

	{
		register struct S102 *W10 = &name;

		{
			integer	B11 = 1,
				B12 = W10->len;

			if (B11 <= B12)
				for (i = B11; ; i++) {
					Putchr(W10->str.A[i - 1], (*where));
					if (i == B12) break;
				}
		}
	}
}

 void
printok(what)
	type_token	what;
{
	if (!(Member((unsigned)(what), Conset[2])))
		(void)fprintf(output.fp, "?????? (bad type token) ???"), Putl(output, 0);
	else
		switch ((int)(what)) {
		  case chartok:
			(void)fprintf(output.fp, "RPC_CHAR"), Putl(output, 0);
			break ;
		  case bytetok:
			(void)fprintf(output.fp, "RPC_BYTE"), Putl(output, 0);
			break ;
		  case shortok:
			(void)fprintf(output.fp, "RPC_SHORT"), Putl(output, 0);
			break ;
		  case integertok:
			(void)fprintf(output.fp, "RPC_INTEGER"), Putl(output, 0);
			break ;
		  case real32tok:
			(void)fprintf(output.fp, "RPC_REAL32"), Putl(output, 0);
			break ;
		  case real48tok:
			(void)fprintf(output.fp, "RPC_REAL48"), Putl(output, 0);
			break ;
		  case real64tok:
			(void)fprintf(output.fp, "RPC_REAL64"), Putl(output, 0);
			break ;
		  case real128tok:
			(void)fprintf(output.fp, "RPC_REAL128"), Putl(output, 0);
			break ;
		  case longtok:
			(void)fprintf(output.fp, "RPC_LONG"), Putl(output, 0);
			break ;
		  case arraytok:
			(void)fprintf(output.fp, "ARRAY"), Putl(output, 0);
			break ;
		  case sequence:
			(void)fprintf(output.fp, "SEQUENCE"), Putl(output, 0);
			break ;
		  case stringtok:
			(void)fprintf(output.fp, "STRING"), Putl(output, 0);
			break ;
		  case substring:
			(void)fprintf(output.fp, "SUBSTRING"), Putl(output, 0);
			break ;
		  case package:
			(void)fprintf(output.fp, "PACKAGE"), Putl(output, 0);
			break ;
		  case semicolon:
			(void)fprintf(output.fp, "SEMICOLON"), Putl(output, 0);
			break ;
		  case typetok:
			(void)fprintf(output.fp, "TYPE"), Putl(output, 0);
			break ;
		  case endtok:
			(void)fprintf(output.fp, "END"), Putl(output, 0);
			break ;
		  case colon:
			(void)fprintf(output.fp, "COLON"), Putl(output, 0);
			break ;
		  case comma:
			(void)fprintf(output.fp, "COMMA"), Putl(output, 0);
			break ;
		  case opnround:
			(void)fprintf(output.fp, "OPNROUND"), Putl(output, 0);
			break ;
		  case clsround:
			(void)fprintf(output.fp, "CLSROUND"), Putl(output, 0);
			break ;
		  case oftok:
			(void)fprintf(output.fp, "OF"), Putl(output, 0);
			break ;
		  case intok:
			(void)fprintf(output.fp, "IN     "), Putl(output, 0);
			break ;
		  case outok:
			(void)fprintf(output.fp, "OUT    "), Putl(output, 0);
			break ;
		  case inoutok:
			(void)fprintf(output.fp, "IN OUT "), Putl(output, 0);
			break ;
		  case istok:
			(void)fprintf(output.fp, "IS"), Putl(output, 0);
			break ;
		  case E1_C33_return:
			(void)fprintf(output.fp, "RETURN"), Putl(output, 0);
			break ;
		  case dot:
			(void)fprintf(output.fp, "DOT"), Putl(output, 0);
			break ;
		  case ident:
			(void)fprintf(output.fp, "IDENT"), Putl(output, 0);
			break ;
		  case number:
			(void)fprintf(output.fp, "NUMBER"), Putl(output, 0);
			break ;
		  case proctok:
			(void)fprintf(output.fp, "PROCEDURE"), Putl(output, 0);
			break ;
		  case functok:
			(void)fprintf(output.fp, "FUNCTION "), Putl(output, 0);
			break ;
		  case nultok:
			(void)fprintf(output.fp, "NULTOKEN"), Putl(output, 0);
			break ;
		  default:
			Caseerror(Line);
		}
}

 integer
indent(level)
	integer	level;
{
	register integer	R84;

	R84 = level * 4 + 16;
	return R84;
}

 void
print_def_type(ptr, level)
	ptr_defined_type	ptr;
	integer	level;
{
	integer	a;
	ptr_named_type	scan;

	if (ptr == (struct S75 *)NIL)
		(void)fprintf(output.fp, "???? NIL pointer ????"), Putl(output, 0);
	else
		if (!(Member((unsigned)(ptr->typ_basic_type), Conset[3])))
			(void)fprintf(output.fp, "???? Bad basic type ????"), Putl(output, 0);
		else
			{
				register struct S75 *W13 = &(*ptr);

				if (((level > 1) || (Member((unsigned)(W13->typ_basic_type), Conset[4]))) && (W13->typ_name != (struct S76 *)NIL)) {
					(void)fprintf(output.fp, "%*c", indent(level), ' '), Putl(output, 0);
					debug_print_name(&output, W13->typ_name->nty_name);
					Putchr(';', output),Putchr('\n', output);
				} else
					switch ((int)(W13->typ_basic_type)) {
					  case chartok:  case bytetok:  case shortok:  case integertok:
					  case real32tok:  case real48tok:  case real64tok:  case real128tok:
					  case longtok:
						(void)fprintf(output.fp, "%*c", indent(level), ' '), Putl(output, 0);
						printok(W13->typ_basic_type);
						(void)fprintf(output.fp, "; -- ??? unnamed basic type ???\n"), Putl(output, 1);
						break ;
					  case stringtok:
						(void)fprintf(output.fp, "%*cSTRING (%1d);\n", indent(level), ' ', W13->U.V4.typ_high), Putl(output, 1);
						break ;
					  case arraytok:
						(void)fprintf(output.fp, "%*cARRAY (%1d..%1d) OF\n", indent(level), ' ', W13->U.V4.typ_low, W13->U.V4.typ_high), Putl(output, 1);
						print_def_type(W13->typ_subtype, level + 1);
						break ;
					  case accesstok:
						(void)fprintf(output.fp, "%*cACCESS\n", indent(level), ' '), Putl(output, 1);
						print_def_type(W13->typ_subtype, level + 1);
						break ;
					  case recordtok:
						(void)fprintf(output.fp, "%*cRECORD\n", indent(level), ' '), Putl(output, 1);
						scan = W13->U.V5.typ_fields;
						while (scan != (struct S76 *)NIL)
							{
								register struct S76 *W14 = &(*scan);

								(void)fprintf(output.fp, "%*c", indent(level + 1), ' '), Putl(output, 0);
								debug_print_name(&output, W14->nty_name);
								(void)fprintf(output.fp, ": \n"), Putl(output, 1);
								print_def_type(W14->nty_type, level + 2);
								scan = scan->nty_next;
							}
						(void)fprintf(output.fp, "%*cEND RECORD;\n", indent(level), ' '), Putl(output, 1);
						break ;
					  case sequence:
						(void)fprintf(output.fp, "%*cSEQUENCE (%1d) OF \n", indent(level), ' ', W13->U.V4.typ_high), Putl(output, 1);
						print_def_type(W13->typ_subtype, level + 1);
						break ;
					  case substring:
						(void)fprintf(output.fp, "%*cSUBSTRING (%1d);\n", indent(level), ' ', W13->U.V4.typ_high), Putl(output, 1);
						break ;
					  default:
						Caseerror(Line);
					}
			}
}

 void
print_tab_types()
{
	ptr_named_type	scan;
	register options	a;

	Putchr('\n', output);
	(void)fprintf(output.fp, "--     Compiler options requested:\n"), Putl(output, 1);
	Putchr('\n', output);
	{
		options	B15 = ccerncross,
			B16 = invalid;

		if ((int)(B15) <= (int)(B16))
			for (a = B15; ; a = (options)((int)(a)+1)) {
				if (runoptions.A[(int)(a)].value)
					(void)fprintf(output.fp, "-- Option %.10s is set.\n", runoptions.A[(int)(a)].name.A), Putl(output, 1);
				if (a == B16) break;
			}
	}
	Putchr('\n', output);
	Putchr('\n', output);
	(void)fprintf(output.fp, "--     Tree of types (alphabetical order)\n"), Putl(output, 1);
	Putchr('\n', output);
	scan = typeptr;
	while (scan != (struct S76 *)NIL) {
		(void)fprintf(output.fp, "TYPE "), Putl(output, 0);
		debug_print_name(&output, scan->nty_name);
		(void)fprintf(output.fp, " IS \n"), Putl(output, 1);
		print_def_type(scan->nty_type, 1);
		{
			register struct S75 *W17 = &(*scan->nty_type);

			if (W17->typ_max_size == W17->typ_min_size)
				(void)fprintf(output.fp, " -- Representation: %1d bytes.\n", W17->typ_max_size), Putl(output, 1);
			else
				(void)fprintf(output.fp, " -- Representation: %1d bytes minimum, %1d bytes maximum.\n", W17->typ_min_size, W17->typ_max_size), Putl(output, 1);
		}
		Putchr('\n', output);
		scan = scan->nty_next;
	}
}

void print_tab_blocks();

 void
print_list(ptr)
	ptr_idlist	ptr;
{
	(void)fprintf(output.fp, "with parameters:\n"), Putl(output, 1);
	do {
		(void)fprintf(output.fp, "    %.25s : ", ptr->name.str.A), Putl(output, 0);
		printok(ptr->attr);
		if (ptr->id_type->typ_name != (struct S76 *)NIL)
			(void)fprintf(output.fp, "%.25s", ptr->id_type->typ_name->nty_name.str.A), Putl(output, 0);
		else
			print_def_type(ptr->id_type, 1);
		Putchr('\n', output);
		ptr = ptr->next;
	} while (!(ptr == (struct S77 *)NIL));
	(void)fprintf(output.fp, "(end of parameters)"), Putl(output, 0);
}

 void
print_tab_blocks()
{
	ptr_block_table	scan;

	Putchr('\n', output);
	(void)fprintf(output.fp, "################## TREE OF BLOCKS #######################\n"), Putl(output, 1);
	Putchr('\n', output);
	(void)fprintf(output.fp, "PACKAGE %.25s IS\n", unitname.str.A), Putl(output, 1);
	scan = blockptr;
	while (scan != (struct S78 *)NIL) {
		Putchr('\n', output);
		printok(scan->b_type);
		(void)fprintf(output.fp, " %.25s", scan->name.str.A), Putl(output, 0);
		if (scan->list != (struct S77 *)NIL)
			print_list(scan->list);
		if (scan->b_type == functok) {
			(void)fprintf(output.fp, " RETURN "), Putl(output, 0);
			printok(scan->C33_return);
		}
		Putchr('\n', output);
		(void)fprintf(output.fp, "--  Minimum %1d bytes in, %1d out.\n", scan->blk_min_in, scan->blk_min_out), Putl(output, 1);
		(void)fprintf(output.fp, "--  Maximum %1d bytes in, %1d out.\n", scan->blk_max_in, scan->blk_max_out), Putl(output, 1);
		(void)fprintf(output.fp, "-- _______________________________________________________\n"), Putl(output, 1);
		scan = scan->next;
	}
	(void)fprintf(output.fp, "END %.25s;\n", unitname.str.A), Putl(output, 1);
	Putchr('\n', output);
}

 void
print_token()
{
	(void)fprintf(output.fp, "     Token read: "), Putl(output, 0);
	if (token.kind == ident)
		(void)fprintf(output.fp, "IDENT:\"%.25s\"", token.U.V2.name.str.A), Putl(output, 0);
	else
		if (token.kind == number)
			(void)fprintf(output.fp, "NUMBER: %10d", token.U.V3.value), Putl(output, 0);
		else
			printok(token.kind);
	Putchr('\n', output);
}

void getoken_init();

 void
put_keyword(name, tok)
	char_name	name;
	type_token	tok;
{
	maxkeyword = maxkeyword + 1;
	keyword.A[maxkeyword - 1].name = name;
	keyword.A[maxkeyword - 1].symbol = tok;
}

 void
getoken_init()
{
	inp_line.len = 0;
	inp_line.start = 0;
	lastindex = 1;
	lineread = 0;
	tok_present = false;
	lastcar = ' ';
	char_ready = false;
	incomment = false;
	maxkeyword = 0;
	put_keyword(*((char_name *)STRALIGN("access                   ")), accesstok);
	put_keyword(*((char_name *)STRALIGN("array                    ")), arraytok);
	put_keyword(*((char_name *)STRALIGN("end                      ")), endtok);
	put_keyword(*((char_name *)STRALIGN("function                 ")), functok);
	put_keyword(*((char_name *)STRALIGN("in                       ")), intok);
	put_keyword(*((char_name *)STRALIGN("inout                    ")), inoutok);
	put_keyword(*((char_name *)STRALIGN("is                       ")), istok);
	put_keyword(*((char_name *)STRALIGN("of                       ")), oftok);
	put_keyword(*((char_name *)STRALIGN("out                      ")), outok);
	put_keyword(*((char_name *)STRALIGN("package                  ")), package);
	put_keyword(*((char_name *)STRALIGN("pragma                   ")), pragmatok);
	put_keyword(*((char_name *)STRALIGN("procedure                ")), proctok);
	put_keyword(*((char_name *)STRALIGN("record                   ")), recordtok);
	put_keyword(*((char_name *)STRALIGN("return                   ")), E1_C33_return);
	put_keyword(*((char_name *)STRALIGN("rpc_byte                 ")), bytetok);
	put_keyword(*((char_name *)STRALIGN("rpc_char                 ")), chartok);
	put_keyword(*((char_name *)STRALIGN("rpc_integer              ")), integertok);
	put_keyword(*((char_name *)STRALIGN("rpc_long                 ")), longtok);
	put_keyword(*((char_name *)STRALIGN("rpc_real128              ")), real128tok);
	put_keyword(*((char_name *)STRALIGN("rpc_real32               ")), real32tok);
	put_keyword(*((char_name *)STRALIGN("rpc_real48               ")), real48tok);
	put_keyword(*((char_name *)STRALIGN("rpc_real64               ")), real64tok);
	put_keyword(*((char_name *)STRALIGN("rpc_short                ")), shortok);
	put_keyword(*((char_name *)STRALIGN("sequence                 ")), sequence);
	put_keyword(*((char_name *)STRALIGN("string                   ")), stringtok);
	put_keyword(*((char_name *)STRALIGN("substring                ")), substring);
	put_keyword(*((char_name *)STRALIGN("type                     ")), typetok);
	(void)strncpy(upkpck.A[(int)(false)].A, "upk", sizeof(upkpck.A[(int)(false)].A));
	(void)strncpy(upkpck.A[(int)(true)].A, "pck", sizeof(upkpck.A[(int)(true)].A));
}

 void
inp_options()
{
	register options	opt;

	{
		options	B18 = ccerncross,
			B19 = invalid;

		if ((int)(B18) <= (int)(B19))
			for (opt = B18; ; opt = (options)((int)(opt)+1)) {
				runoptions.A[(int)(opt)].value = false;
				if (opt == B19) break;
			}
	}
	(void)strncpy(runoptions.A[(int)(cmonolith)].name.A, "cmonolith ", sizeof(runoptions.A[(int)(cmonolith)].name.A));
	(void)strncpy(runoptions.A[(int)(ccerncross)].name.A, "ccerncross", sizeof(runoptions.A[(int)(ccerncross)].name.A));
	(void)strncpy(runoptions.A[(int)(cm6809)].name.A, "cm6809    ", sizeof(runoptions.A[(int)(cm6809)].name.A));
	(void)strncpy(runoptions.A[(int)(cvaxvms)].name.A, "cvaxvms   ", sizeof(runoptions.A[(int)(cvaxvms)].name.A));
	(void)strncpy(runoptions.A[(int)(cvaxpas)].name.A, "cvaxpas   ", sizeof(runoptions.A[(int)(cvaxpas)].name.A));
	(void)strncpy(runoptions.A[(int)(cunixbsd)].name.A, "cunixbsd  ", sizeof(runoptions.A[(int)(cunixbsd)].name.A));
	(void)strncpy(runoptions.A[(int)(cpcturbo)].name.A, "cpcturbo  ", sizeof(runoptions.A[(int)(cpcturbo)].name.A));
	(void)strncpy(runoptions.A[(int)(cmacturbo)].name.A, "cmacturbo ", sizeof(runoptions.A[(int)(cmacturbo)].name.A));
	(void)strncpy(runoptions.A[(int)(cpils)].name.A, "cpils     ", sizeof(runoptions.A[(int)(cpils)].name.A));
	(void)strncpy(runoptions.A[(int)(cvaxfor)].name.A, "cfortran  ", sizeof(runoptions.A[(int)(cvaxfor)].name.A));
	(void)strncpy(runoptions.A[(int)(cgenericc)].name.A, "cgenericc ", sizeof(runoptions.A[(int)(cgenericc)].name.A));
	(void)strncpy(runoptions.A[(int)(smonolith)].name.A, "smonolith ", sizeof(runoptions.A[(int)(smonolith)].name.A));
	(void)strncpy(runoptions.A[(int)(scerncross)].name.A, "scerncross", sizeof(runoptions.A[(int)(scerncross)].name.A));
	(void)strncpy(runoptions.A[(int)(sm6809)].name.A, "sm6809    ", sizeof(runoptions.A[(int)(sm6809)].name.A));
	(void)strncpy(runoptions.A[(int)(svaxvms)].name.A, "svaxvms   ", sizeof(runoptions.A[(int)(svaxvms)].name.A));
	(void)strncpy(runoptions.A[(int)(svaxpas)].name.A, "svaxpas   ", sizeof(runoptions.A[(int)(svaxpas)].name.A));
	(void)strncpy(runoptions.A[(int)(sunixbsd)].name.A, "sunixbsd  ", sizeof(runoptions.A[(int)(sunixbsd)].name.A));
	(void)strncpy(runoptions.A[(int)(spcturbo)].name.A, "spcturbo  ", sizeof(runoptions.A[(int)(spcturbo)].name.A));
	(void)strncpy(runoptions.A[(int)(smacturbo)].name.A, "smacturbo ", sizeof(runoptions.A[(int)(smacturbo)].name.A));
	(void)strncpy(runoptions.A[(int)(spils)].name.A, "spils     ", sizeof(runoptions.A[(int)(spils)].name.A));
	(void)strncpy(runoptions.A[(int)(svaxfor)].name.A, "sfortran  ", sizeof(runoptions.A[(int)(svaxfor)].name.A));
	(void)strncpy(runoptions.A[(int)(sgenericc)].name.A, "sgenericc ", sizeof(runoptions.A[(int)(sgenericc)].name.A));
	(void)strncpy(runoptions.A[(int)(dlex)].name.A, "dlex      ", sizeof(runoptions.A[(int)(dlex)].name.A));
	(void)strncpy(runoptions.A[(int)(dlexhot)].name.A, "dlexhot   ", sizeof(runoptions.A[(int)(dlexhot)].name.A));
	(void)strncpy(runoptions.A[(int)(dtree)].name.A, "dtree     ", sizeof(runoptions.A[(int)(dtree)].name.A));
	(void)strncpy(runoptions.A[(int)(shortint)].name.A, "shortint  ", sizeof(runoptions.A[(int)(shortint)].name.A));
	(void)strncpy(runoptions.A[(int)(stdescr)].name.A, "stdescr   ", sizeof(runoptions.A[(int)(stdescr)].name.A));
	(void)strncpy(runoptions.A[(int)(concurrent)].name.A, "concurrent", sizeof(runoptions.A[(int)(concurrent)].name.A));
	(void)strncpy(runoptions.A[(int)(noautoinit)].name.A, "noautoinit", sizeof(runoptions.A[(int)(noautoinit)].name.A));
	(void)strncpy(runoptions.A[(int)(byvalue)].name.A, "byvalue   ", sizeof(runoptions.A[(int)(byvalue)].name.A));
	(void)strncpy(runoptions.A[(int)(timeout)].name.A, "timeout   ", sizeof(runoptions.A[(int)(timeout)].name.A));
	(void)strncpy(runoptions.A[(int)(version)].name.A, "version   ", sizeof(runoptions.A[(int)(version)].name.A));
	(void)strncpy(runoptions.A[(int)(types)].name.A, "types     ", sizeof(runoptions.A[(int)(types)].name.A));
	Setncpy(cmode.S, Conset[5], sizeof(cmode.S));
	ser_name.len = 0;
	ser_mode = cerncross;
	ser_spec = false;
	cli_name.len = 0;
	cli_mode = cerncross;
	cli_spec = false;
	checksum = 0;
	ch_there = ' ';
	is_blank = true;
}

 void
pointers_init()
{
	typeptr = (struct S76 *)NIL;
	blockptr = (struct S78 *)NIL;
}

 void
init_global()
{
	getoken_init();
	inp_options();
	pointers_init();
	errorfound = 0;
}

 void
get_argc(count)
	integer	*count;
{
	(*count) = argc - 1;
}

 void
get_argv(what, towhere, len)
	integer	what;
	longstring	*towhere;
	integer	*len;
{
	boolean	loop;

	Argvgt(what, (*towhere).A, sizeof((*towhere).A));
	(*len) = 0;
	loop = true;
	while ((loop) && ((*len) <= maxstring))
		if (towhere->A[(*len) + 1 - 1] != ' ')
			(*len) = (*len) + 1;
		else
			loop = false;
}

 boolean
file_open(file_des, name, mode)
	text	*file_des;
	astring	*name;
	open_mode	mode;
{
	register boolean	R85;
	register integer	a;
	longstring	str;

	{
		integer	B20 = 1,
			B21 = name->len;

		if (B20 <= B21)
			for (a = B20; ; a++) {
				str.A[a - 1] = name->str.A[a - 1];
				if (a == B21) break;
			}
	}
	a = name->len;
	if (a < maxstring)
		a = a + 1;
	str.A[a - 1] = 0;
	if (mode == rewriting)
		Rewritex((*file_des), str.A, sizeof(str.A));
	else
		Resetx((*file_des), str.A, sizeof(str.A));
	R85 = true;
	return R85;
}

 boolean
file_close(file_des)
	text	*file_des;
{
	register boolean	R86;

	fflush((*file_des).fp);
	R86 = true;
	return R86;
}

 void
analize(arg, len, interactive)
	longstring	*arg;
	integer	len;
	boolean	interactive;
{
# define magic1 '-'
# define magic2 '-'
	opt_name	loc_arg;
	register integer	i;
	register integer	a;
	boolean	found;
	options	scan;
	boolean	present;

	if ((arg->A[1 - 1] == magic1) || (arg->A[1 - 1] == magic2) || (interactive)) {
		(void)strncpy(loc_arg.A, "          ", sizeof(loc_arg.A));
		a = 1;
		present = false;
		while ((a <= 11) && (a < len) && !present) {
			if (arg->A[a + 1 - 1] == '=')
				present = true;
			else
				if (a <= 10) {
					if (Member((unsigned)(arg->A[a + 1 - 1]), Conset[6]))
						loc_arg.A[a - 1] = (unsigned)('a') + (unsigned)(arg->A[a + 1 - 1]) - (unsigned)('A');
					else
						loc_arg.A[a - 1] = arg->A[a + 1 - 1];
				}
			a = a + 1;
		}
		scan = ccerncross;
		found = false;
		do {
			if (Cmpstr(loc_arg.A, runoptions.A[(int)(scan)].name.A) == 0) {
				found = true;
				if ((unsigned)(scan) < numomodes) {
					if (cli_spec) {
						(void)fprintf(output.fp, "RPCC: "), Putl(output, 0);
						{
							integer	B22 = 1,
								B23 = len;

							if (B22 <= B23)
								for (a = B22; ; a++) {
									Putchr(arg->A[a - 1], output);
									if (a == B23) break;
								}
						}
						(void)fprintf(output.fp, ": client already specified - option ignored.\n"), Putl(output, 1);
					} else {
						cli_spec = true;
						{
							integer	B24 = 1,
								B25 = (unsigned)(scan);

							if (B24 <= B25)
								for (i = B24; ; i++) {
									cli_mode = ((output_mode)((int)(cli_mode)+1));
									if (i == B25) break;
								}
						}
						if (present) {
							cli_name.len = len - a;
							{
								integer	B26 = 1,
									B27 = len - a;

								if (B26 <= B27)
									for (i = B26; ; i++) {
										cli_name.str.A[i - 1] = arg->A[a + i - 1];
										if (i == B27) break;
									}
							}
						}
					}
				} else
					if ((unsigned)(scan) < 2 * numomodes) {
						if (ser_spec) {
							(void)fprintf(output.fp, "RPCC: "), Putl(output, 0);
							{
								integer	B28 = 1,
									B29 = len;

								if (B28 <= B29)
									for (a = B28; ; a++) {
										Putchr(arg->A[a - 1], output);
										if (a == B29) break;
									}
							}
							(void)fprintf(output.fp, ": server already specified - option ignored.\n"), Putl(output, 1);
						} else {
							ser_spec = true;
							{
								integer	B30 = 1,
									B31 = (unsigned)(scan) - numomodes;

								if (B30 <= B31)
									for (i = B30; ; i++) {
										ser_mode = ((output_mode)((int)(ser_mode)+1));
										if (i == B31) break;
									}
							}
							if (present) {
								ser_name.len = len - a;
								{
									integer	B32 = 1,
										B33 = len - a;

									if (B32 <= B33)
										for (i = B32; ; i++) {
											ser_name.str.A[i - 1] = arg->A[a + i - 1];
											if (i == B33) break;
										}
								}
							}
						}
					} else {
						runoptions.A[(int)(scan)].value = true;
						if (scan == timeout) {
							if (a >= len) {
								(void)fprintf(output.fp, "RPCC: timeout value missing, default will be used.\n"), Putl(output, 1);
								runoptions.A[(int)(timeout)].value = false;
							} else {
								timeout_val = 0;
								{
									integer	B34 = 1,
										B35 = len - a;

									if (B34 <= B35)
										for (i = B34; ; i++) {
											if (Member((unsigned)(arg->A[a + i - 1]), Conset[7]))
												timeout_val = 10 * timeout_val + (unsigned)(arg->A[a + i - 1]) - (unsigned)('0');
											else {
												(void)fprintf(output.fp, "RPCC timeout option: "), Putl(output, 0);
												abort_pgm(number_req);
											}
											if (i == B35) break;
										}
								}
								if (timeout_val == 0)
									(void)fprintf(output.fp, "RPCC: timeout is zero, hope that's okay.\n"), Putl(output, 1);
							}
						} else
							if (scan == version) {
								if (a >= len) {
									(void)fprintf(output.fp, "RPCC: supplying missing version number.\n"), Putl(output, 1);
									runoptions.A[(int)(version)].value = false;
								} else {
									version_num = 0;
									{
										integer	B36 = 1,
											B37 = len - a;

										if (B36 <= B37)
											for (i = B36; ; i++) {
												if (Member((unsigned)(arg->A[a + i - 1]), Conset[8]))
													version_num = 10 * version_num + (unsigned)(arg->A[a + i - 1]) - (unsigned)('0');
												else {
													(void)fprintf(output.fp, "RPCC version option: "), Putl(output, 0);
													abort_pgm(number_req);
												}
												if (i == B37) break;
											}
									}
									if (version_num == 0)
										(void)fprintf(output.fp, "RPCC: stub version check disabled.\n"), Putl(output, 1);
								}
							}
					}
			} else
				scan = ((options)((int)(scan)+1));
		} while (!(found || (scan == invalid)));
		if (scan == invalid) {
			(void)fprintf(output.fp, "RPCC: "), Putl(output, 0);
			{
				integer	B38 = 1,
					B39 = len;

				if (B38 <= B39)
					for (a = B38; ; a++) {
						Putchr(arg->A[a - 1], output);
						if (a == B39) break;
					}
			}
			(void)fprintf(output.fp, ": unrecognized option, ignored.\n"), Putl(output, 1);
		}
	} else {
		inp_name.len = len;
		{
			integer	B40 = 1,
				B41 = len;

			if (B40 <= B41)
				for (a = B40; ; a++) {
					inp_name.str.A[a - 1] = arg->A[a - 1];
					if (a == B41) break;
				}
		}
	}
# undef magic1
# undef magic2
}

 void
make_filename(filename, prefix)
	astring	*filename;
	char3	prefix;
{
	integer	rdp;
	register integer	i;
	boolean	done;

	rdp = inp_name.len;
	done = false;
	do {
		if ((rdp >= 1)) {
			if ((Member((unsigned)(inp_name.str.A[rdp - 1]), Conset[9])))
				rdp = rdp - 1;
			else
				done = true;
		} else
			done = true;
	} while (!(done));
	filename->len = 0;
	{
		integer	B42 = 1,
			B43 = rdp;

		if (B42 <= B43)
			for (i = B42; ; i++) {
				filename->len = filename->len + 1;
				filename->str.A[filename->len - 1] = inp_name.str.A[i - 1];
				if (i == B43) break;
			}
	}
	{
		integer	B44 = 1,
			B45 = 3;

		if (B44 <= B45)
			for (i = B44; ; i++) {
				filename->len = filename->len + 1;
				filename->str.A[filename->len - 1] = prefix.A[i - 1];
				if (i == B45) break;
			}
	}
	{
		integer	B46 = rdp + 1,
			B47 = inp_name.len;

		if (B46 <= B47)
			for (i = B46; ; i++) {
				filename->len = filename->len + 1;
				filename->str.A[filename->len - 1] = inp_name.str.A[i - 1];
				if (i == B47) break;
			}
	}
}

 void
get_parameters()
{
	typedef struct { char	A[3 - 1 + 1]; }	T83;
	integer	b, count, p_argc, p_len;
	register integer	a;
	longstring	p_argv;
	T83	ext;

	inp_name.len = 0;
	if (commandline) {
		count = 1;
		get_argc(&p_argc);
		while (count <= p_argc) {
			get_argv(count, &p_argv, &p_len);
			count = count + 1;
			analize(&p_argv, p_len, false);
		}
	} else {
		(void)fprintf(output.fp, "Input file name: "), Putl(output, 0);
		{
			register struct S103 *W48 = &inp_name;

			W48->len = 0;
			while (!(Eoln(input)) && (W48->len <= maxstring)) {
				W48->len = W48->len + 1;
				W48->str.A[W48->len - 1] = Getchr(input);
			}
			Getl(&input);
		}
		do {
			(void)fprintf(output.fp, "Debugging options: "), Putl(output, 0);
			count = 1;
			while (!(Eoln(input)) && (count < maxstring)) {
				count = count + 1;
				p_argv.A[count - 1] = Getchr(input);
			}
			Getl(&input);
			if (count > 1)
				analize(&p_argv, count, true);
		} while (!(count == 1));
	}
	if (inp_name.len == 0) {
		(void)fprintf(output.fp, "RPCC: usage: source_file [options]\n"), Putl(output, 1);
		abort_pgm(input_miss);
	}
	if (!(file_open(&inp_file, &inp_name, resetting)))
		abort_pgm(cant_opn_input);
	if (cli_name.len == 0)
		make_filename(&cli_name, *((char3 *)STRALIGN("cli")));
	if (ser_name.len == 0)
		make_filename(&ser_name, *((char3 *)STRALIGN("ser")));
	b = inp_name.len;
	while ((b >= 1) && (Member((unsigned)(inp_name.str.A[b - 1]), Conset[10])))
		b = b - 1;
	if (b == 0)
		b = inp_name.len;
	if (inp_name.str.A[b - 1] != '.')
		b = inp_name.len;
	{
		integer	B49 = 1,
			B50 = b;

		if (B49 <= B50)
			for (a = B49; ; a++) {
				if (a <= maxstring - 3)
					ext_name.str.A[a - 1] = inp_name.str.A[a - 1];
				if (a == B50) break;
			}
	}
	if ((b <= inp_name.len - 3)) {
		ext.A[1 - 1] = inp_name.str.A[b + 1 - 1];
		ext.A[2 - 1] = inp_name.str.A[b + 2 - 1];
		ext.A[3 - 1] = inp_name.str.A[b + 3 - 1];
		if ((Cmpstr(ext.A, "ext") == 0) || (Cmpstr(ext.A, "EXT") == 0))
			abort_pgm(bad_input_name);
	} else {
		b = b + 1;
		ext_name.str.A[b - 1] = '.';
	}
	ext_name.str.A[b + 1 - 1] = 'e';
	ext_name.str.A[b + 2 - 1] = 'x';
	ext_name.str.A[b + 3 - 1] = 't';
	ext_name.len = b + 3;
}

void getoken();

 char
ap_getchar()
{
# define tab 9
	register char	R87;
	register integer	a;
	char	localcar;

	if (char_ready) {
		R87 = oldchar;
		char_ready = false;
	} else {
		{
			register struct S104 *W51 = &inp_line;

			while ((W51->start > W51->len) || (W51->len == 0)) {
				W51->len = 0;
				W51->start = 1;
				lastindex = 1;
				if (Eofx(inp_file))
					abort_pgm(unexp_eof);
				else {
					while (!(Eoln(inp_file))) {
						W51->len = W51->len + 1;
						W51->str.A[W51->len - 1] = Getchr(inp_file);
						if ((unsigned)(W51->str.A[W51->len - 1]) == tab)
							W51->str.A[W51->len - 1] = ' ';
						else
							if ((unsigned)(W51->str.A[W51->len - 1]) < 32)
								W51->len = W51->len - 1;
					}
					W51->len = W51->len + 1;
					W51->str.A[W51->len - 1] = ' ';
					Getl(&inp_file);
					lineread = lineread + 1;
					if (runoptions.A[(int)(dlex)].value) {
						(void)fprintf(output.fp, "LINE READ: "), Putl(output, 0);
						{
							integer	B52 = 1,
								B53 = W51->len;

							if (B52 <= B53)
								for (a = B52; ; a++) {
									Putchr(W51->str.A[a - 1], output);
									if (a == B53) break;
								}
						}
						Putchr('\n', output);
					}
				}
			}
			localcar = W51->str.A[W51->start - 1];
			W51->start = W51->start + 1;
		}
		if (Member((unsigned)(localcar), Conset[11]))
			localcar = (unsigned)('a') + (unsigned)(localcar) - (unsigned)('A');
		R87 = localcar;
		if ((localcar == '-') && !(incomment)) {
			incomment = true;
			oldchar = ap_getchar();
			incomment = false;
			if (oldchar == '-') {
				inp_line.len = 0;
				R87 = ' ';
			} else {
				R87 = localcar;
				char_ready = true;
			}
		}
	}
	return R87;
# undef tab
}

 char
C58_getchar()
{
	register char	R88;
	char	ch;

	if (ch_there != ' ') {
		ch = ch_there;
		ch_there = ' ';
	} else {
		ch = ap_getchar();
		if (ch == ' ') {
			if (!Eofx(inp_file))
				do {
					ch = ap_getchar();
				} while (!(ch != ' '));
			if (!((Member((unsigned)(ch), Conset[12])) || is_blank)) {
				ch_there = ch;
				ch = ' ';
			}
		}
	}
	is_blank = (boolean)(Member((unsigned)(ch), Conset[13]));
	checksum = (3 * checksum + (unsigned)(ch) - (unsigned)(' ')) % 8999;
	if (runoptions.A[(int)(dlexhot)].value)
		if (ch == ' ')
			Putchr(ch, output),Putchr('\n', output);
		else
			Putchr(ch, output);
	R88 = ch;
	return R88;
}

 void
getoken()
{
	integer	j, k, sign;
	register integer	i;

	if (tok_present) {
		token = lastoken;
		tok_present = false;
	} else {
		{
			register struct S105 *W54 = &token;

			do {
				if (lastcar == ' ')
					lastcar = C58_getchar();
				lastindex = inp_line.start;
				if (Member((unsigned)(lastcar), Conset[14])) {
					W54->kind = ident;
					W54->U.V2.name.len = 0;
					do {
						if (W54->U.V2.name.len < maxidlen) {
							W54->U.V2.name.len = W54->U.V2.name.len + 1;
							W54->U.V2.name.str.A[W54->U.V2.name.len - 1] = lastcar;
						}
						lastcar = C58_getchar();
					} while (!(!(Member((unsigned)(lastcar), Conset[15]))));
					{
						integer	B55 = W54->U.V2.name.len + 1,
							B56 = maxidlen;

						if (B55 <= B56)
							for (i = B55; ; i++) {
								W54->U.V2.name.str.A[i - 1] = ' ';
								if (i == B56) break;
							}
					}
					i = 1;
					j = maxkeyword;
					do {
						k = (i + j) / 2;
						if (Cmpstr(W54->U.V2.name.str.A, keyword.A[k - 1].name.A) <= 0)
							j = k - 1;
						if (Cmpstr(W54->U.V2.name.str.A, keyword.A[k - 1].name.A) >= 0)
							i = k + 1;
					} while (!(i > j));
					if (i - 1 > j) {
						W54->kind = keyword.A[k - 1].symbol;
					} else {
						{
							register struct S102 *W57 = &W54->U.V2.name;

							if (((W57->str.A[1 - 1] == 'r') && (W57->str.A[2 - 1] == 'p') && (W57->str.A[3 - 1] == 'c') && (W57->str.A[4 - 1] == '_')) || (Cmpstr(W54->U.V2.name.str.A, "b                        ") == 0) || (Cmpstr(W54->U.V2.name.str.A, "header                   ") == 0) || (Cmpstr(W54->U.V2.name.str.A, "ret                      ") == 0))
								linerror(ident_reserved);
						}
						W54->kind = ident;
					}
				} else
					if (Member((unsigned)(lastcar), Conset[16])) {
						W54->kind = number;
						W54->U.V3.value = 0;
						if (lastcar == '-') {
							sign = -1;
							lastcar = C58_getchar();
						} else
							sign = 1;
						do {
							if (W54->U.V3.value < (maxint / 10) - ((unsigned)(lastcar) - (unsigned)('0')))
								W54->U.V3.value = W54->U.V3.value * 10 + (unsigned)(lastcar) - (unsigned)('0');
							else {
								error(toomany_dig);
								W54->U.V3.value = maxint;
							}
							lastcar = C58_getchar();
						} while (!(!(Member((unsigned)(lastcar), Conset[17]))));
						W54->U.V3.value = W54->U.V3.value * sign;
					} else {
						if (!(Member((unsigned)(lastcar), Conset[18]))) {
							W54->kind = nultok;
							error(char_ignored);
						} else {
							switch ((int)(lastcar)) {
							  case ':':
								W54->kind = colon;
								break ;
							  case ';':
								W54->kind = semicolon;
								break ;
							  case ',':
								W54->kind = comma;
								break ;
							  case '(':
								W54->kind = opnround;
								break ;
							  case ')':
								W54->kind = clsround;
								break ;
							  case '.':
								W54->kind = dot;
								break ;
							  default:
								Caseerror(Line);
							}
						}
						lastcar = C58_getchar();
					}
			} while (!(W54->kind != nultok));
		}
	}
	if (runoptions.A[(int)(dlex)].value)
		print_token();
}

 void
backtoken()
{
	lastoken = token;
	tok_present = true;
}

 boolean
expected(what, skip_until)
	type_token	what;
	set_of_token	skip_until;
{
	register boolean	R89;

	getoken();
	if (token.kind == what)
		R89 = true;
	else {
		R89 = false;
		(void)fprintf(output.fp, "RPCC: Error: Found "), Putl(output, 0);
		write_token(token.kind);
		(void)fprintf(output.fp, " where "), Putl(output, 0);
		write_token(what);
		(void)fprintf(output.fp, " was expected on line %1d:\n", lineread), Putl(output, 1);
		print_last_line();
		Putchr('\n', output);
		find_tok(skip_until);
	}
	return R89;
}

 void
append_1(expr, ch)
	expression	*expr;
	char	ch;
{
	{
		register struct S106 *W58 = &(*expr);

		W58->len = W58->len + 1;
		W58->str.A[W58->len - 1] = ch;
	}
}

 void
format(final, template)
	expression	*final;
	template_type	template;
{
	expression	initial;
	integer	e;
	register integer	j;
	register integer	i;

	initial = (*final);
	final->len = 0;
	e = template_length;
	while (template.A[e - 1] == ' ')
		e = e - 1;
	{
		integer	B59 = 1,
			B60 = e;

		if (B59 <= B60)
			for (i = B59; ; i++) {
				if (template.A[i - 1] == '$')
					{
						integer	B61 = 1,
							B62 = initial.len;

						if (B61 <= B62)
							for (j = B61; ; j++) {
								append_1(&(*final), initial.str.A[j - 1]);
								if (j == B62) break;
							}
					}
				else
					append_1(&(*final), template.A[i - 1]);
				if (i == B60) break;
			}
	}
}

 void
prepend_1(expr, ch)
	expression	*expr;
	char	ch;
{
	register integer	a;

	{
		register struct S106 *W63 = &(*expr);

		{
			integer	B64 = W63->len,
				B65 = 1;

			if (B64 >= B65)
				for (a = B64; ; a--) {
					W63->str.A[a + 1 - 1] = W63->str.A[a - 1];
					if (a == B65) break;
				}
		}
		W63->str.A[1 - 1] = ch;
		W63->len = W63->len + 1;
	}
}

 void
append_name(expr, name)
	expression	*expr;
	id_name	name;
{
	register integer	a;

	{
		register struct S102 *W66 = &name;

		{
			integer	B67 = 1,
				B68 = W66->len;

			if (B67 <= B68)
				for (a = B67; ; a++) {
					append_1(&(*expr), W66->str.A[a - 1]);
					if (a == B68) break;
				}
		}
	}
}

 void
append_index(expr, level)
	expression	*expr;
	integer	level;
{
	char	ch;

	format(&(*expr), *((template_type *)STRALIGN("$[rpc_    ")));
	append_1(&(*expr), (unsigned)('a') + level - 1);
	append_1(&(*expr), ']');
}

 void
append_decimal(expr, x)
	expression	*expr;
	integer	x;
{
	integer	t, y, weight;

	if (x < 0) {
		append_1(&(*expr), '-');
		t = -x;
	} else
		t = x;
	weight = 1;
	while (weight * 10 <= t)
		weight = weight * 10;
	while (weight > 0) {
		append_1(&(*expr), (unsigned)('0') + t / weight);
		t = t % weight;
		weight = weight / 10;
	}
}

 boolean
find_type(head, name, father, son)
	ptr_named_type	head;
	id_name	*name;
	ptr_named_type	*father;
	ptr_named_type	*son;
{
	register boolean	R90;
	boolean	found, doexit;

	found = false;
	(*son) = head;
	(*father) = (*son);
	while (((*son) != (struct S76 *)NIL) && !(found)) {
		if (Cmpstr((*son)->nty_name.str.A, name->str.A) == 0)
			found = true;
		else {
			(*father) = (*son);
			(*son) = (*son)->nty_next;
		}
	}
	R90 = found;
	return R90;
}

 void
insert_named_type(ptr, head)
	ptr_named_type	ptr;
	ptr_named_type	*head;
{
	ptr_named_type	son, father;

	if (find_type((*head), &ptr->nty_name, &father, &son)) {
		linerror(twice_declared);
	} else {
		if ((*head) == (struct S76 *)NIL) {
			(*head) = ptr;
			ptr->nty_next = (struct S76 *)NIL;
		} else
			if ((*head) == son) {
				(*head) = ptr;
				ptr->nty_next = son;
			} else {
				father->nty_next = ptr;
				ptr->nty_next = son;
			}
	}
}

 boolean
find_block(name, father, son)
	id_name	*name;
	ptr_block_table	*father;
	ptr_block_table	*son;
{
	register boolean	R91;
	boolean	found;

	found = false;
	(*son) = blockptr;
	(*father) = (*son);
	while (((*son) != (struct S78 *)NIL) && !(found)) {
		if (Cmpstr((*son)->name.str.A, name->str.A) == 0)
			found = true;
		else {
			(*father) = (*son);
			(*son) = (*son)->next;
		}
	}
	R91 = found;
	return R91;
}

 boolean
find_param(name, head, son)
	id_name	*name;
	ptr_idlist	head;
	ptr_idlist	*son;
{
	register boolean	R92;
	boolean	found;

	(*son) = head;
	found = false;
	while (((*son) != (struct S77 *)NIL) && !found) {
		if (Cmpstr((*son)->name.str.A, name->str.A) == 0)
			found = true;
		else
			(*son) = (*son)->next;
	}
	R92 = found;
	return R92;
}

 void
ensure_type_named(pt)
	ptr_defined_type	pt;
{
	register integer	i;
	expression	expr;
	ptr_named_type	pnt;

	if (pt != (struct S75 *)NIL)
		{
			register struct S75 *W69 = &(*pt);

			if (W69->typ_name == (struct S76 *)NIL) {
				pnt = (struct S76 *)malloc((unsigned)(sizeof(*pnt)));
				{
					register struct S76 *W70 = &(*pnt);

					format(&expr, *((template_type *)STRALIGN("rpc_stype_")));
					append_decimal(&expr, number_of_invented_types);
					number_of_invented_types = number_of_invented_types + 1;
					{
						integer	B71 = 1,
							B72 = expr.len;

						if (B71 <= B72)
							for (i = B71; ; i++) {
								W70->nty_name.str.A[i - 1] = expr.str.A[i - 1];
								if (i == B72) break;
							}
					}
					W70->nty_name.len = expr.len;
					W70->nty_type = pt;
					W69->typ_name = pnt;
					insert_named_type(pnt, &typeptr);
				}
			}
		}
}

ptr_defined_type parse_type();

 void
get_size(pt)
	ptr_defined_type	pt;
{
	{
		register struct S75 *W73 = &(*pt);

		getoken();
		if (token.kind != opnround)
			linerror(opnround_miss);
		else
			getoken();
		W73->U.V4.typ_low = 1;
		if (token.kind != number) {
			linerror(number_req);
			W73->U.V4.typ_high = 0;
		} else {
			W73->U.V4.typ_high = token.U.V3.value;
			getoken();
		}
		if (token.kind != clsround) {
			errfind(clsround_miss, *((set_of_token *)SETALIGN(Conset[19])));
			backtoken();
		}
		if (W73->U.V4.typ_high < 0)
			linerror(positive_req);
	}
}

 ptr_defined_type
parse_subarray()
{
	register ptr_defined_type	R94;
	ptr_defined_type	pt;

	pt = (struct S75 *)malloc((unsigned)(sizeof(*pt)));
	{
		register struct S75 *W74 = &(*pt);

		W74->typ_name = (struct S76 *)NIL;
		W74->typ_external = false;
		W74->typ_subtype = (struct S75 *)NIL;
		W74->typ_basic_type = arraytok;
		getoken();
		if (token.kind != number) {
			linerror(number_req);
			W74->U.V4.typ_low = 0;
		} else {
			W74->U.V4.typ_low = token.U.V3.value;
			getoken();
		}
		if (token.kind == dot) {
			getoken();
			if (token.kind != dot)
				linerror(dot_miss);
			else
				getoken();
		} else
			linerror(dot_miss);
		if (token.kind != number) {
			linerror(number_req);
			W74->U.V4.typ_high = W74->U.V4.typ_low + 1;
		} else {
			W74->U.V4.typ_high = token.U.V3.value;
			getoken();
		}
		if (W74->U.V4.typ_high <= W74->U.V4.typ_low)
			linerror(invalid_range);
		if (token.kind == comma) {
			W74->typ_subtype = parse_subarray();
		} else
			if (token.kind == clsround) {
				getoken();
				if (token.kind == oftok) {
					getoken();
					W74->typ_subtype = parse_type();
				} else {
					errfind(clsround_miss, *((set_of_token *)SETALIGN(Conset[20])));
					backtoken();
				}
			} else {
				errfind(clsround_miss, *((set_of_token *)SETALIGN(Conset[21])));
				backtoken();
			}
		if (W74->typ_subtype == (struct S75 *)NIL) {
			free(pt);
			R94 = (struct S75 *)NIL;
		} else {
			W74->typ_min_size = (W74->U.V4.typ_high - W74->U.V4.typ_low + 1) * W74->typ_subtype->typ_min_size;
			W74->typ_max_size = (W74->U.V4.typ_high - W74->U.V4.typ_low + 1) * W74->typ_subtype->typ_max_size;
			W74->typ_nesting = W74->typ_subtype->typ_nesting + 1;
			R94 = pt;
		}
	}
	return R94;
}

 ptr_defined_type
parse_type()
{
	register ptr_defined_type	R93;
	ptr_defined_type	pt;
	ptr_named_type	pnt;
	boolean	loc_err;
	ptr_named_type	father, son;

	if (token.kind == ident) {
		if (find_type(typeptr, &token.U.V2.name, &father, &son))
			R93 = son->nty_type;
		else
			linerror(id_not_declared);
	} else
		if (Member((unsigned)(token.kind), Conset[22])) {
			R93 = simple_descriptor.A[(int)(token.kind)];
		} else
			if (token.kind == arraytok) {
				getoken();
				if (token.kind != opnround) {
					linerror(opnround_miss);
					backtoken();
					R93 = (struct S75 *)NIL;
				} else
					R93 = parse_subarray();
			} else
				if (token.kind == accesstok) {
					pt = (struct S75 *)malloc((unsigned)(sizeof(*pt)));
					{
						register struct S75 *W75 = &(*pt);

						W75->typ_basic_type = token.kind;
						W75->typ_external = false;
						getoken();
						W75->typ_subtype = parse_type();
						ensure_type_named(W75->typ_subtype);
						if (W75->typ_subtype != (struct S75 *)NIL) {
							W75->typ_nesting = W75->typ_subtype->typ_nesting;
							W75->typ_min_size = 4;
							W75->typ_max_size = W75->typ_subtype->typ_max_size + 4;
						}
					}
					R93 = pt;
				} else
					if (token.kind == recordtok) {
						pt = (struct S75 *)malloc((unsigned)(sizeof(*pt)));
						R93 = pt;
						{
							register struct S75 *W76 = &(*pt);

							W76->typ_basic_type = token.kind;
							W76->typ_external = false;
							W76->typ_subtype = (struct S75 *)NIL;
							W76->U.V5.typ_fields = (struct S76 *)NIL;
							W76->typ_nesting = 0;
							W76->typ_min_size = 0;
							W76->typ_max_size = 0;
							getoken();
							while (token.kind == ident) {
								pnt = (struct S76 *)malloc((unsigned)(sizeof(*pnt)));
								pnt->nty_name = token.U.V2.name;
								getoken();
								if (token.kind != colon)
									linerror(colon_miss);
								else
									getoken();
								pnt->nty_type = parse_type();
								if (pnt->nty_type != (struct S75 *)NIL) {
									if (pnt->nty_type->typ_nesting > W76->typ_nesting)
										W76->typ_nesting = pnt->nty_type->typ_nesting;
									W76->typ_min_size = W76->typ_min_size + pnt->nty_type->typ_min_size;
									W76->typ_max_size = W76->typ_max_size + pnt->nty_type->typ_max_size;
									insert_named_type(pnt, &W76->U.V5.typ_fields);
									ensure_type_named(pnt->nty_type);
								}
								getoken();
								if (token.kind != semicolon) {
									errfind(semicol_miss, *((set_of_token *)SETALIGN(Conset[23])));
									if (token.kind == semicolon)
										getoken();
								} else
									getoken();
							}
						}
						if (token.kind != endtok)
							errfind(endtok_miss, *((set_of_token *)SETALIGN(Conset[24])));
						getoken();
						if (token.kind != recordtok) {
							linerror(record_miss);
							if (token.kind == semicolon)
								backtoken();
						}
					} else
						if (token.kind == sequence) {
							pt = (struct S75 *)malloc((unsigned)(sizeof(*pt)));
							pt->typ_basic_type = token.kind;
							R93 = pt;
							get_size(pt);
							getoken();
							if (token.kind != oftok)
								linerror(oftok_miss);
							else
								{
									register struct S75 *W77 = &(*pt);

									getoken();
									W77->typ_external = false;
									W77->typ_subtype = parse_type();
									W77->typ_nesting = W77->typ_subtype->typ_nesting + 1;
									W77->typ_min_size = 2;
									W77->typ_max_size = (W77->typ_subtype->typ_max_size * (W77->U.V4.typ_high - W77->U.V4.typ_low + 1)) + 2;
								}
						} else
							if (Member((unsigned)(token.kind), Conset[25])) {
								pt = (struct S75 *)malloc((unsigned)(sizeof(*pt)));
								R93 = pt;
								{
									register struct S75 *W78 = &(*pt);

									W78->typ_basic_type = token.kind;
									get_size(pt);
									W78->typ_subtype = simple_descriptor.A[(int)(chartok)];
									W78->typ_external = false;
									if (W78->typ_basic_type == stringtok) {
										W78->typ_nesting = 2;
										W78->typ_max_size = W78->U.V4.typ_high + 2;
										W78->typ_min_size = 2;
									} else {
										W78->typ_nesting = 1;
										W78->typ_max_size = W78->U.V4.typ_high + 4;
										W78->typ_min_size = 4;
									}
								}
							} else {
								linerror(ill_basic_type);
								loc_err = true;
								backtoken();
								R93 = (struct S75 *)NIL;
							}
	return R93;
}

 void
parse_pragma()
{
	id_name	pragma_name;
	ptr_block_table	blk, block_father;
	ptr_named_type	nty, type_father;
	register integer	i;
	ptr_defined_type	typ;
	ptr_idlist	param;

	if (expected(ident, *((set_of_token *)SETALIGN(Conset[26])))) {
		pragma_name = token.U.V2.name;
		if (expected(opnround, *((set_of_token *)SETALIGN(Conset[27]))))
			if (expected(ident, *((set_of_token *)SETALIGN(Conset[28]))))
				if (Cmpstr(pragma_name.str.A, "timeout                  ") == 0) {
					if (find_block(&token.U.V2.name, &block_father, &blk))
						if (expected(comma, *((set_of_token *)SETALIGN(Conset[29]))))
							if (expected(number, *((set_of_token *)SETALIGN(Conset[30])))) {
								blk->blk_timeout = token.U.V3.value;
								if (expected(clsround, *((set_of_token *)SETALIGN(Conset[31]))))
									if (expected(semicolon, *((set_of_token *)SETALIGN(Conset[32]))))
										;
							}
				} else
					if ((Cmpstr(pragma_name.str.A, "concurrent               ") == 0) || (Cmpstr(pragma_name.str.A, "cast                     ") == 0)) {
						while (token.kind == ident) {
							if (find_block(&token.U.V2.name, &block_father, &blk)) {
								if (pragma_name.str.A[2 - 1] == 'o')
									blk->blk_concurrent = true;
								else
									blk->blk_cast = true;
							} else {
								(void)fprintf(output.fp, "RPCC: PRAGMA CAST or CONCURRENT must refer to previously defined procedure\n"), Putl(output, 1);
								linerror(id_not_declared);
							}
							getoken();
							if (token.kind == comma)
								if (expected(ident, *((set_of_token *)SETALIGN(Conset[33]))))
									;
						}
						if (token.kind == clsround) {
							if (expected(semicolon, *((set_of_token *)SETALIGN(Conset[34]))))
								;
						} else {
							linerror(clsround_miss);
							if (token.kind != semicolon)
								if (expected(semicolon, *((set_of_token *)SETALIGN(Conset[35]))))
									;
						}
					} else
						if (Cmpstr(pragma_name.str.A, "external_marshalling     ") == 0) {
							if (find_type(typeptr, &token.U.V2.name, &type_father, &nty)) {
								if (nty->nty_type->typ_name != nty) {
									typ = (struct S75 *)malloc((unsigned)(sizeof(*typ)));
									(*typ) = (*nty->nty_type);
									typ->typ_name = nty;
									nty->nty_type = typ;
								}
								nty->nty_type->typ_external = true;
								nty->nty_type->typ_nesting = 0;
								external_marshalling = true;
							} else {
								(void)fprintf(output.fp, "RPCC: PRAGMA EXTERNAL_MARSHALLING must refer to previously defined type\n"), Putl(output, 1);
								linerror(id_not_declared);
							}
							if (expected(clsround, *((set_of_token *)SETALIGN(Conset[36]))))
								if (expected(semicolon, *((set_of_token *)SETALIGN(Conset[37]))))
									;
						} else
							if (Cmpstr(pragma_name.str.A, "call_status              ") == 0) {
								if (!find_block(&token.U.V2.name, &block_father, &blk)) {
									(void)fprintf(output.fp, "RPCC: PRAGMA CALL_STATUS: First arg (proc/func name) not (yet) declared\n"), Putl(output, 1);
									linerror(id_not_declared);
								} else
									if (expected(comma, *((set_of_token *)SETALIGN(Conset[38]))))
										if (expected(ident, *((set_of_token *)SETALIGN(Conset[39]))))
											if (!find_param(&token.U.V2.name, blk->list, &param)) {
												(void)fprintf(output.fp, " RPCC: PRAGMA CALL_STATUS:\n"), Putl(output, 1);
												(void)fprintf(output.fp, " Second argument must be formal param. of proc/func\n"), Putl(output, 1);
												linerror(id_not_declared);
											} else {
												if (blk->blk_status_param != (struct S77 *)NIL) {
													(void)fprintf(output.fp, "RPCC: Proc/func already has a CALL_STATUS parameter\n"), Putl(output, 1);
													linerror(twice_declared);
												} else
													blk->blk_status_param = param;
											}
								if (expected(clsround, *((set_of_token *)SETALIGN(Conset[40]))))
									if (expected(semicolon, *((set_of_token *)SETALIGN(Conset[41]))))
										;
							} else {
								(void)fprintf(output.fp, "RPCC: Ignoring unknown pragma \""), Putl(output, 0);
								{
									register struct S102 *W79 = &pragma_name;

									{
										integer	B80 = 1,
											B81 = W79->len;

										if (B80 <= B81)
											for (i = B80; ; i++) {
												Putchr(W79->str.A[i - 1], output);
												if (i == B81) break;
											}
									}
								}
								Putchr('"', output),Putchr('\n', output);
								find_tok(*((set_of_token *)SETALIGN(Conset[42])));
							}
	}
	getoken();
}

 void
type_declare()
{
	named_type	elem;
	ptr_named_type	pnt;

	while (!(Member((unsigned)(token.kind), Conset[43]))) {
		if (token.kind == pragmatok)
			parse_pragma();
		else
			if (token.kind != typetok) {
				errfind(type_miss, *((set_of_token *)SETALIGN(Conset[44])));
			} else {
				getoken();
				if (token.kind != ident) {
					errfind(ident_req, *((set_of_token *)SETALIGN(Conset[45])));
				} else {
					pnt = (struct S76 *)malloc((unsigned)(sizeof(*pnt)));
					pnt->nty_name = token.U.V2.name;
					getoken();
					if (token.kind != istok)
						linerror(istok_miss);
					else
						getoken();
					pnt->nty_type = parse_type();
					if (pnt->nty_type != (struct S75 *)NIL) {
						insert_named_type(pnt, &typeptr);
						if (pnt->nty_type->typ_name == (struct S76 *)NIL)
							pnt->nty_type->typ_name = pnt;
					}
					getoken();
					if (token.kind != semicolon) {
						errfind(semicol_miss, *((set_of_token *)SETALIGN(Conset[46])));
						if (token.kind == semicolon)
							getoken();
					} else
						getoken();
				}
			}
	}
}

void parse_parameter_list();

 ptr_idlist
fnd_idlist(name, last, head)
	id_name	*name;
	ptr_idlist	*last;
	ptr_idlist	head;
{
	register ptr_idlist	R95;
	ptr_idlist	scan;
	boolean	found;

	scan = head;
	(*last) = head;
	found = false;
	while ((scan != (struct S77 *)NIL) && !(found))
		if (Cmpstr(scan->name.str.A, name->str.A) == 0)
			found = true;
		else {
			(*last) = scan;
			scan = scan->next;
		}
	R95 = scan;
	return R95;
}

 ptr_idlist
get_idlist()
{
	register ptr_idlist	R96;
	ptr_idlist	localist, last, scan;
	ptr_named_type	junk1, junk2;

	localist = (struct S77 *)NIL;
	do {
		getoken();
		if (token.kind != ident)
			errfind(ident_req, *((set_of_token *)SETALIGN(Conset[47])));
		if (token.kind == ident) {
			if (find_type(typeptr, &token.U.V2.name, &junk1, &junk2) || (fnd_idlist(&token.U.V2.name, &scan, (*G107_headlist)) != (struct S77 *)NIL) || (fnd_idlist(&token.U.V2.name, &last, localist) != (struct S77 *)NIL))
				linerror(twice_declared);
			else {
				scan = (struct S77 *)malloc((unsigned)(sizeof(*scan)));
				scan->name = token.U.V2.name;
				scan->next = (struct S77 *)NIL;
				if (last == (struct S77 *)NIL)
					localist = scan;
				else
					last->next = scan;
			}
			getoken();
		}
	} while (!(token.kind != comma));
	R96 = localist;
	return R96;
}

 void
parse_parameter_list(block)
	block_table	*block;
{
	ptr_idlist	identlist, headlist, tailist, last;
	ptr_named_type	scan2type, junk;
	ptr_defined_type	ptr2type;
	attr_type	direction;
	boolean	got_error;
	ptr_idlist	*F108;

	F108 = G107_headlist;
	G107_headlist = &headlist;
	got_error = false;
	(*G107_headlist) = (struct S77 *)NIL;
	do {
		identlist = get_idlist();
		if (token.kind != colon)
			linerror(colon_miss);
		else
			getoken();
		if (!(Member((unsigned)(token.kind), Conset[48]))) {
			direction = intok;
		} else {
			direction = token.kind;
			getoken();
			if ((direction == intok) && (token.kind == outok)) {
				direction = inoutok;
				getoken();
			}
		}
		ptr2type = parse_type();
		ensure_type_named(ptr2type);
		if ((identlist != (struct S77 *)NIL) && (ptr2type != (struct S75 *)NIL))
			{
				register struct S78 *W82 = &(*block);

				if (ptr2type->typ_nesting > W82->blk_nesting)
					W82->blk_nesting = ptr2type->typ_nesting;
				if ((*G107_headlist) == (struct S77 *)NIL)
					(*G107_headlist) = identlist;
				else
					tailist->next = identlist;
				tailist = identlist;
				do {
					tailist->attr = direction;
					tailist->id_type = ptr2type;
					last = tailist;
					tailist = tailist->next;
					if (Member((unsigned)(direction), Conset[49])) {
						W82->blk_max_in = W82->blk_max_in + ptr2type->typ_max_size;
						W82->blk_min_in = W82->blk_min_in + ptr2type->typ_min_size;
					}
					if (Member((unsigned)(direction), Conset[50])) {
						W82->blk_max_out = W82->blk_max_out + ptr2type->typ_max_size;
						W82->blk_min_out = W82->blk_min_out + ptr2type->typ_min_size;
					}
				} while (!(tailist == (struct S77 *)NIL));
				tailist = last;
			}
		getoken();
		if (!(Member((unsigned)(token.kind), Conset[51]))) {
			errfind(semic_round_miss, *((set_of_token *)SETALIGN(Conset[52])));
			switch ((int)(token.kind)) {
			  case semicolon:  case clsround:
				break ;
			  case ident:
				backtoken();
				break ;
			  case colon:  case functok:  case proctok:
				got_error = true;
				backtoken();
				break ;
			  default:
				Caseerror(Line);
			}
		}
	} while (!((token.kind == clsround) || (got_error)));
	block->list = (*G107_headlist);
	G107_headlist = F108;
}

 void
block_declare()
{
	block_table	block;
	ptr_named_type	junk1, scan;
	ptr_block_table	blk, junk2, lastblock;
	boolean	localerr;
	ptr_idlist	ascan;

	do {
		localerr = false;
		{
			register struct S78 *W83 = &block;

			W83->blk_nesting = 0;
			W83->blk_min_in = 0;
			W83->blk_min_out = 0;
			W83->blk_max_in = 0;
			W83->blk_max_out = 0;
		}
		if (!(Member((unsigned)(token.kind), Conset[53])))
			errfind(proc_exp, *((set_of_token *)SETALIGN(Conset[54])));
		if (token.kind == pragmatok)
			parse_pragma();
		else
			if (token.kind != endtok) {
				block.b_type = token.kind;
				block.in_only = (boolean)(token.kind == proctok);
				getoken();
				if (token.kind != ident) {
					linerror(ident_req);
					localerr = true;
				} else {
					block.name = token.U.V2.name;
					if (find_type(typeptr, &token.U.V2.name, &junk1, &scan) || find_block(&token.U.V2.name, &lastblock, &junk2)) {
						linerror(twice_declared);
						localerr = true;
					}
				}
				getoken();
				if (token.kind == opnround) {
					parse_parameter_list(&block);
					getoken();
				} else
					if (Member((unsigned)(token.kind), Conset[55])) {
						linerror(opnround_miss);
						backtoken();
						parse_parameter_list(&block);
						getoken();
					} else
						block.list = (struct S77 *)NIL;
				if (block.b_type == functok) {
					if (token.kind != E1_C33_return)
						linerror(return_miss);
					else
						getoken();
					if (token.kind == ident) {
						if (find_type(typeptr, &token.U.V2.name, &junk1, &scan))
							block.C33_return = scan->nty_type->typ_basic_type;
						else {
							linerror(id_not_declared);
							localerr = true;
						}
					} else
						block.C33_return = token.kind;
					if (Member((unsigned)(block.C33_return), Conset[56])) {
						getoken();
						block.blk_max_out = block.blk_max_out + simple_descriptor.A[(int)(block.C33_return)]->typ_max_size;
						block.blk_min_out = block.blk_min_out + simple_descriptor.A[(int)(block.C33_return)]->typ_min_size;
					} else {
						localerr = true;
						linerror(simtype_req);
					}
				} else {
					ascan = block.list;
					while (ascan != (struct S77 *)NIL) {
						if (ascan->attr != intok)
							block.in_only = false;
						ascan = ascan->next;
					}
				}
				if (token.kind != semicolon) {
					errfind(semicol_miss, *((set_of_token *)SETALIGN(Conset[57])));
					if (token.kind == semicolon)
						getoken();
				} else
					getoken();
				if (!localerr) {
					blk = (struct S78 *)malloc((unsigned)(sizeof(*blk)));
					(*blk) = block;
					blk->next = (struct S78 *)NIL;
					blk->blk_status_param = (struct S77 *)NIL;
					blk->blk_cast = false;
					blk->blk_concurrent = false;
					if (runoptions.A[(int)(timeout)].value)
						blk->blk_timeout = timeout_val;
					else
						blk->blk_timeout = rpc_default_timeout;
					if (lastblock == (struct S78 *)NIL)
						blockptr = blk;
					else
						lastblock->next = blk;
				}
			}
	} while (!(token.kind == endtok));
}

 void
initialise_parser()
{
	register type_token	t;

	{
		type_token	B84 = chartok,
			B85 = longtok;

		if ((int)(B84) <= (int)(B85))
			for (t = B84; ; t = (type_token)((int)(t)+1)) {
				simple_descriptor.A[(int)(t)] = (struct S75 *)malloc((unsigned)(sizeof(*simple_descriptor.A[(int)(t)])));
				{
					register struct S75 *W86 = &(*simple_descriptor.A[(int)(t)]);

					W86->typ_basic_type = t;
					W86->typ_nesting = 0;
					W86->typ_subtype = (struct S75 *)NIL;
					W86->typ_name = (struct S76 *)malloc((unsigned)(sizeof(*W86->typ_name)));
					{
						register struct S76 *W87 = &(*W86->typ_name);

						W87->nty_name.len = maxidlen;
						W87->nty_type = simple_descriptor.A[(int)(t)];
						W87->nty_next = (struct S76 *)NIL;
					}
					switch ((int)(t)) {
					  case chartok:  case bytetok:
						W86->typ_max_size = 1;
						break ;
					  case shortok:  case integertok:
						W86->typ_max_size = 2;
						break ;
					  case real32tok:  case longtok:
						W86->typ_max_size = 4;
						break ;
					  case real48tok:  case real64tok:
						W86->typ_max_size = 8;
						break ;
					  case real128tok:
						W86->typ_max_size = 16;
						break ;
					  default:
						Caseerror(Line);
					}
					W86->typ_min_size = W86->typ_max_size;
				}
				if (t == B85) break;
			}
	}
	(void)strncpy(simple_descriptor.A[(int)(chartok)]->typ_name->nty_name.str.A, "rpc_char                 ", sizeof(simple_descriptor.A[(int)(chartok)]->typ_name->nty_name.str.A));
	(void)strncpy(simple_descriptor.A[(int)(bytetok)]->typ_name->nty_name.str.A, "rpc_byte                 ", sizeof(simple_descriptor.A[(int)(bytetok)]->typ_name->nty_name.str.A));
	(void)strncpy(simple_descriptor.A[(int)(shortok)]->typ_name->nty_name.str.A, "rpc_short                ", sizeof(simple_descriptor.A[(int)(shortok)]->typ_name->nty_name.str.A));
	(void)strncpy(simple_descriptor.A[(int)(integertok)]->typ_name->nty_name.str.A, "rpc_integer              ", sizeof(simple_descriptor.A[(int)(integertok)]->typ_name->nty_name.str.A));
	(void)strncpy(simple_descriptor.A[(int)(real32tok)]->typ_name->nty_name.str.A, "rpc_real32               ", sizeof(simple_descriptor.A[(int)(real32tok)]->typ_name->nty_name.str.A));
	(void)strncpy(simple_descriptor.A[(int)(longtok)]->typ_name->nty_name.str.A, "rpc_long                 ", sizeof(simple_descriptor.A[(int)(longtok)]->typ_name->nty_name.str.A));
	(void)strncpy(simple_descriptor.A[(int)(real48tok)]->typ_name->nty_name.str.A, "rpc_real48               ", sizeof(simple_descriptor.A[(int)(real48tok)]->typ_name->nty_name.str.A));
	(void)strncpy(simple_descriptor.A[(int)(real64tok)]->typ_name->nty_name.str.A, "rpc_real64               ", sizeof(simple_descriptor.A[(int)(real64tok)]->typ_name->nty_name.str.A));
	(void)strncpy(simple_descriptor.A[(int)(real128tok)]->typ_name->nty_name.str.A, "rpc_real128              ", sizeof(simple_descriptor.A[(int)(real128tok)]->typ_name->nty_name.str.A));
	{
		type_token	B88 = chartok,
			B89 = longtok;

		if ((int)(B88) <= (int)(B89))
			for (t = B88; ; t = (type_token)((int)(t)+1)) {
				{
					register struct S75 *W90 = &(*simple_descriptor.A[(int)(t)]);
					register struct S76 *W91 = &(*W90->typ_name);
					register struct S102 *W92 = &W91->nty_name;

					while (W92->str.A[W92->len - 1] == ' ')
						W92->len = W92->len - 1;
				}
				if (t == B89) break;
			}
	}
	number_of_invented_types = 0;
	external_marshalling = false;
}

 void
parser()
{
	initialise_parser();
	getoken();
	if (token.kind != package)
		linerror(package_miss);
	else
		getoken();
	if (token.kind != ident)
		linerror(ident_req);
	else {
		unitname = token.U.V2.name;
		getoken();
	}
	if (token.kind != istok)
		linerror(istok_miss);
	else
		getoken();
	type_declare();
	if (token.kind == endtok)
		linerror(blocks_req);
	else {
		block_declare();
		if (token.kind != endtok)
			linerror(endtok_miss);
		else
			getoken();
		if (token.kind != ident)
			linerror(ident_req);
		else
			if (Cmpstr(token.U.V2.name.str.A, unitname.str.A) != 0)
				linerror(bad_name);
		getoken();
		if (token.kind != semicolon)
			linerror(semicol_miss);
	}
}

 char
upper_case(ch)
	char	ch;
{
	register char	R97;

	if ((ch >= 'a') && (ch <= 'z'))
		R97 = (unsigned)(ch) - (unsigned)('a') + (unsigned)('A');
	else
		R97 = ch;
	return R97;
}

 void
write_name(where, name)
	text	*where;
	id_name	*name;
{
	register integer	a;

	{
		register struct S102 *W93 = &(*name);

		{
			integer	B94 = 1,
				B95 = W93->len;

			if (B94 <= B95)
				for (a = B94; ; a++) {
					if (omode == vaxfor)
						Putchr(upper_case(W93->str.A[a - 1]), (*where));
					else
						Putchr(W93->str.A[a - 1], (*where));
					if (a == B95) break;
				}
		}
	}
}

 void
write_exp(where, expr)
	text	*where;
	expression	*expr;
{
	register integer	a;

	{
		register struct S106 *W96 = &(*expr);

		{
			integer	B97 = 1,
				B98 = W96->len;

			if (B97 <= B98)
				for (a = B97; ; a++) {
					if (omode == vaxfor)
						Putchr(upper_case(W96->str.A[a - 1]), (*where));
					else
						Putchr(W96->str.A[a - 1], (*where));
					if (a == B98) break;
				}
		}
	}
}

 void
write_name_padded(op_file, name, ch)
	text	*op_file;
	id_name	name;
	char	ch;
{
	Putchr(ch, (*op_file));
	write_name(&(*op_file), &name);
	(void)fprintf((*op_file).fp, "%*c", rpc_name_length + 1 - name.len, ch), Putl((*op_file), 0);
}

 void
codefor_error(why)
	error_string	why;
{
	(void)fprintf(output.fp, " RPCC: **** Error: %.48s\n", why.A), Putl(output, 1);
	(void)fprintf(output.fp, "       (Error detected at FORTRAN code generator stage.)\n"), Putl(output, 1);
	abort();
}

 integer
indfor(level)
	integer	level;
{
	register integer	R98;

	R98 = 3 + level * 3;
	return R98;
}

 void
continuation()
{
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "     +"), Putl(op_file, 0);
}

 void
append_index_for(expr, level)
	expression	*expr;
	integer	level;
{
	char	ch;

	format(&(*expr), *((template_type *)STRALIGN("$(RPC_    ")));
	append_1(&(*expr), (unsigned)('A') + level - 1);
	append_1(&(*expr), ')');
}

 void
pack_simple_for(where, what, topack)
	text	*where;
	type_token	what;
	boolean	topack;
{
	(void)fprintf((*where).fp, "      CALL "), Putl((*where), 0);
	if (topack)
		(void)fprintf((*where).fp, "PCK_"), Putl((*where), 0);
	else
		(void)fprintf((*where).fp, "UPK_"), Putl((*where), 0);
	switch ((int)(what)) {
	  case chartok:
		(void)fprintf((*where).fp, "CHAR"), Putl((*where), 0);
		break ;
	  case bytetok:
		(void)fprintf((*where).fp, "BYTE"), Putl((*where), 0);
		break ;
	  case shortok:
		(void)fprintf((*where).fp, "SHORT"), Putl((*where), 0);
		break ;
	  case integertok:
		(void)fprintf((*where).fp, "INTEGER"), Putl((*where), 0);
		break ;
	  case real32tok:
		(void)fprintf((*where).fp, "REAL32"), Putl((*where), 0);
		break ;
	  case real48tok:
		(void)fprintf((*where).fp, "REAL48"), Putl((*where), 0);
		break ;
	  case real64tok:
		(void)fprintf((*where).fp, "REAL64"), Putl((*where), 0);
		break ;
	  case real128tok:
		(void)fprintf((*where).fp, "REAL128"), Putl((*where), 0);
		break ;
	  case longtok:
		(void)fprintf((*where).fp, "LONG"), Putl((*where), 0);
		break ;
	  default:
		Caseerror(Line);
	}
	(void)fprintf((*where).fp, "_FOR(RPC_P_BUF,"), Putl((*where), 0);
}

 void
gen_align_for(power, level)
	integer	power;
	integer	level;
{
	(void)fprintf(op_file.fp, "%*cCALL RPC_ALIGN(RPC_P_BUF,%1d)\n", indfor(level), ' ', power), Putl(op_file, 1);
}

 void
gen_pack_type_for(where, expr, typ, level, topack)
	text	*where;
	expression	expr;
	ptr_defined_type	typ;
	integer	level;
	boolean	topack;
{
	char	ch;
	ptr_named_type	scan;
	ptr_defined_type	element;
	integer	depth;
	expression	exp2;
	expression	l_expr, s_expr;
	register integer	i;
	integer	local_label;

	ch = (unsigned)('A') + level - 1;
	l_expr = expr;
	prepend_1(&l_expr, '_');
	s_expr = l_expr;
	prepend_1(&l_expr, 'L');
	prepend_1(&s_expr, 'S');
	{
		register struct S75 *W99 = &(*typ);

		if (W99->typ_external) {
			(void)fprintf((*where).fp, "%*cCALL ", indfor(level), ' '), Putl((*where), 0);
			if (topack)
				(void)fprintf((*where).fp, "PCK_"), Putl((*where), 0);
			else
				(void)fprintf((*where).fp, "UPK_"), Putl((*where), 0);
			write_name(&op_file, &W99->typ_name->nty_name);
			(void)fprintf((*where).fp, "_FOR(RPC_P_BUF,"), Putl((*where), 0);
			write_exp(&(*where), &expr);
			Putchr(')', (*where)),Putchr('\n', (*where));
		} else
			switch ((int)(W99->typ_basic_type)) {
			  case chartok:
				(void)fprintf((*where).fp, "%*cCALL ", indfor(level), ' '), Putl((*where), 0);
				if (topack)
					(void)fprintf((*where).fp, "PCK"), Putl((*where), 0);
				else
					(void)fprintf((*where).fp, "UPK"), Putl((*where), 0);
				(void)fprintf((*where).fp, "_CHAR_FOR(RPC_P_BUF,"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr(')', (*where)),Putchr('\n', (*where));
				break ;
			  case bytetok:  case shortok:  case integertok:  case real32tok:
			  case real48tok:  case real64tok:  case real128tok:  case longtok:
				(void)fprintf((*where).fp, "%*cCALL ", indfor(level), ' '), Putl((*where), 0);
				if (topack)
					(void)fprintf((*where).fp, "PCK"), Putl((*where), 0);
				else
					(void)fprintf((*where).fp, "UPK"), Putl((*where), 0);
				{
					register struct S102 *W100 = &W99->typ_name->nty_name;

					{
						integer	B101 = 4,
							B102 = W100->len;

						if (B101 <= B102)
							for (i = B101; ; i++) {
								Putchr(upper_case(W100->str.A[i - 1]), (*where));
								if (i == B102) break;
							}
					}
				}
				(void)fprintf((*where).fp, "_FOR(RPC_P_BUF,"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr(')', (*where)),Putchr('\n', (*where));
				break ;
			  case arraytok:
				exp2 = expr;
				depth = level;
				ch = (unsigned)('A') + depth - 1;
				element = W99->typ_subtype;
				format(&exp2, *((template_type *)STRALIGN("$(RPC_    ")));
				append_1(&exp2, ch);
				(void)fprintf((*where).fp, "%*cDO %1d, RPC_%c=1,%1d\n", indfor(depth), ' ', next_label, ch, W99->U.V4.typ_high - W99->U.V4.typ_low + 1), Putl((*where), 1);
				next_label = next_label + 1;
				while (element->typ_basic_type == arraytok)
					{
						register struct S75 *W103 = &(*element);

						depth = depth + 1;
						ch = (unsigned)('A') + depth - 1;
						(void)fprintf((*where).fp, "%*cDO %1d, RPC_%c=1,%1d\n", indfor(depth), ' ', next_label, ch, W103->U.V4.typ_high - W103->U.V4.typ_low + 1), Putl((*where), 1);
						next_label = next_label + 1;
						format(&exp2, *((template_type *)STRALIGN("$,RPC_    ")));
						append_1(&exp2, ch);
						element = element->typ_subtype;
					}
				append_1(&exp2, ')');
				local_label = next_label;
				gen_pack_type_for(&(*where), exp2, element, depth + 1, topack);
				while (depth >= level) {
					local_label = local_label - 1;
					(void)fprintf((*where).fp, "%4d%*cCONTINUE\n", local_label, indfor(depth) - 4, ' '), Putl((*where), 1);
					depth = depth - 1;
				}
				break ;
			  case recordtok:
				scan = W99->U.V5.typ_fields;
				while (scan != (struct S76 *)NIL)
					{
						register struct S76 *W104 = &(*scan);

						exp2 = expr;
						append_1(&exp2, '.');
						append_name(&exp2, W104->nty_name);
						gen_pack_type_for(&(*where), exp2, W104->nty_type, level, topack);
						scan = W104->nty_next;
					}
				break ;
			  case accesstok:
				codefor_error(*((error_string *)STRALIGN("No ACCESS (POINTER) type exists in FORTRAN!     ")));
				break ;
			  case sequence:
				if (level > 1)
					codefor_error(*((error_string *)STRALIGN("SEQUENCE type not allowed within composite type.")));
				gen_pack_type_for(&(*where), l_expr, simple_descriptor.A[(int)(integertok)], level, topack);
				exp2 = expr;
				format(&exp2, *((template_type *)STRALIGN("A_$       ")));
				append_index_for(&exp2, level);
				(void)fprintf((*where).fp, "%*c", indfor(level), ' '), Putl((*where), 0);
				(void)fprintf((*where).fp, "DO %1d, RPC_%c=1, L_", next_label, ch), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr('\n', (*where));
				local_label = next_label;
				next_label = next_label + 1;
				gen_pack_type_for(&(*where), exp2, W99->typ_subtype, level + 1, topack);
				(void)fprintf((*where).fp, "%4d%*cCONTINUE\n", local_label, indfor(level) - 4, ' '), Putl((*where), 1);
				break ;
			  case stringtok:
				(void)fprintf((*where).fp, "%*c", indfor(level), ' '), Putl((*where), 0);
				if (topack)
					(void)fprintf((*where).fp, "CALL PCK_STRING_FOR"), Putl((*where), 0);
				else
					if (client)
						(void)fprintf((*where).fp, "CALL UPK_STRING_FOR"), Putl((*where), 0);
					else
						(void)fprintf((*where).fp, "CALL UPK_VSTRING_FOR"), Putl((*where), 0);
				(void)fprintf((*where).fp, "(RPC_P_BUF,"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				if (!topack && !client)
					(void)fprintf((*where).fp, ",%1d", W99->U.V4.typ_high), Putl((*where), 0);
				Putchr(')', (*where)),Putchr('\n', (*where));
				break ;
			  case substring:
				(void)fprintf((*where).fp, "%*c", indfor(level), ' '), Putl((*where), 0);
				if (topack)
					(void)fprintf((*where).fp, "CALL PCK_SUBSTRING_FOR"), Putl((*where), 0);
				else
					(void)fprintf((*where).fp, "CALL UPK_SUBSTRING_FOR"), Putl((*where), 0);
				(void)fprintf((*where).fp, "(RPC_P_BUF,A_"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr(',', (*where));
				continuation();
				(void)fprintf((*where).fp, "S_"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				(void)fprintf((*where).fp, ",L_"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr(')', (*where)),Putchr('\n', (*where));
				break ;
			  default:
				Caseerror(Line);
			}
	}
}

 void
gen_pack_for(where, head, dirn, topack)
	text	*where;
	ptr_idlist	head;
	attr_type	dirn;
	boolean	topack;
{
	expression	expr;

	do {
		{
			register struct S77 *W105 = &(*head);
			register struct S75 *W106 = &(*W105->id_type);

			expr.len = 0;
			append_name(&expr, head->name);
			if ((W105->attr == inoutok) || (W105->attr == dirn)) {
				deref = (boolean)(client && !(runoptions.A[(int)(byvalue)].value && (W105->attr == intok)));
				gen_pack_type_for(&(*where), expr, W105->id_type, 1, topack);
			}
		}
		head = head->next;
	} while (!(head == (struct S77 *)NIL));
}

 void
gen_type_decl_for(expr, pt, level)
	expression	expr;
	ptr_defined_type	pt;
	integer	level;
{
	ptr_defined_type	scan;
	expression	exp2;

	{
		register struct S75 *W107 = &(*pt);

		switch ((int)(W107->typ_basic_type)) {
		  case chartok:  case bytetok:  case shortok:  case integertok:
		  case real32tok:  case real48tok:  case real64tok:  case real128tok:
		  case longtok:
			(void)fprintf(op_file.fp, "%*c", indfor(level), ' '), Putl(op_file, 0);
			switch ((int)(W107->typ_basic_type)) {
			  case chartok:
				(void)fprintf(op_file.fp, "CHARACTER*1"), Putl(op_file, 0);
				break ;
			  case bytetok:
				(void)fprintf(op_file.fp, "BYTE"), Putl(op_file, 0);
				break ;
			  case integertok:
				(void)fprintf(op_file.fp, "INTEGER"), Putl(op_file, 0);
				break ;
			  case real32tok:
				(void)fprintf(op_file.fp, "REAL"), Putl(op_file, 0);
				break ;
			  case real48tok:
				(void)fprintf(op_file.fp, "DOUBLE"), Putl(op_file, 0);
				break ;
			  case real64tok:
				(void)fprintf(op_file.fp, "DOUBLE"), Putl(op_file, 0);
				break ;
			  case real128tok:
				(void)fprintf(op_file.fp, "DOUBLE"), Putl(op_file, 0);
				break ;
			  case shortok:
				(void)fprintf(op_file.fp, "INTEGER*2"), Putl(op_file, 0);
				break ;
			  case longtok:
				(void)fprintf(op_file.fp, "INTEGER*4"), Putl(op_file, 0);
				break ;
			  default:
				Caseerror(Line);
			}
			Putchr(' ', op_file);
			write_exp(&op_file, &expr);
			Putchr('\n', op_file);
			break ;
		  case substring:  case stringtok:
			(void)fprintf(op_file.fp, "%*c", indfor(level), ' '), Putl(op_file, 0);
			if (client && (level == 1))
				(void)fprintf(op_file.fp, "CHARACTER*(*) "), Putl(op_file, 0);
			else
				(void)fprintf(op_file.fp, "CHARACTER*%1d ", (W107->U.V4.typ_high)), Putl(op_file, 0);
			write_exp(&op_file, &expr);
			Putchr('\n', op_file);
			break ;
		  case sequence:  case arraytok:
			exp2 = expr;
			append_1(&exp2, '(');
			append_decimal(&exp2, W107->U.V4.typ_high - W107->U.V4.typ_low + 1);
			scan = W107->typ_subtype;
			while (scan->typ_basic_type == arraytok) {
				append_1(&exp2, ',');
				append_decimal(&exp2, scan->U.V4.typ_high - scan->U.V4.typ_low + 1);
				scan = scan->typ_subtype;
			}
			append_1(&exp2, ')');
			gen_type_decl_for(exp2, scan, level);
			break ;
		  case accesstok:
			codefor_error(*((error_string *)STRALIGN("Package has pointers: Can't make FORTRAN stubs. ")));
			break ;
		  case recordtok:
			(void)fprintf(op_file.fp, "%*cRECORD ", indfor(level), ' '), Putl(op_file, 0);
			if (W107->typ_name == (struct S76 *)NIL)
				codefor_error(*((error_string *)STRALIGN("Every structure must be named for VAX/FORTRAN.  ")));
			else {
				Putchr('/', op_file);
				write_name(&op_file, &W107->typ_name->nty_name);
				(void)fprintf(op_file.fp, "/ "), Putl(op_file, 0);
			}
			write_exp(&op_file, &expr);
			Putchr('\n', op_file);
			break ;
		  default:
			Caseerror(Line);
		}
	}
}

 void
gen_client_common()
{
	(void)fprintf(op_file.fp, "      COMMON /C_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, "/ H_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      INTEGER H_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
}

 void
gen_server_common()
{
	(void)fprintf(op_file.fp, "      COMMON /S_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, "/ P_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      INTEGER P_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
}

void gen_dummies();

 void
comma_cont(name)
	id_name	name;
{
	Putchr(',', op_file);
	(*G109_col) = (*G109_col) + 1;
	if ((*G109_col) + name.len > 65) {
		continuation();
		(*G109_col) = 6;
	}
}

 void
gen_dummies(head)
	ptr_idlist	head;
{
	integer	col;
	ptr_idlist	scan;
	integer	*F110;

	F110 = G109_col;
	G109_col = &col;
	if (head != (struct S77 *)NIL) {
		scan = head;
		Putchr('(', op_file);
		(*G109_col) = 40;
		while (scan != (struct S77 *)NIL) {
			if (Member((unsigned)(scan->id_type->typ_basic_type), Conset[58]))
				(void)fprintf(op_file.fp, "A_"), Putl(op_file, 0);
			write_name(&op_file, &scan->name);
			(*G109_col) = (*G109_col) + scan->name.len + 2;
			if (scan->id_type->typ_basic_type == substring) {
				comma_cont(scan->name);
				(void)fprintf(op_file.fp, "S_"), Putl(op_file, 0);
				write_name(&op_file, &scan->name);
				(*G109_col) = (*G109_col) + scan->name.len + 2;
			}
			if (Member((unsigned)(scan->id_type->typ_basic_type), Conset[59])) {
				comma_cont(scan->name);
				(void)fprintf(op_file.fp, "L_"), Putl(op_file, 0);
				write_name(&op_file, &scan->name);
				(*G109_col) = (*G109_col) + scan->name.len + 2;
			}
			scan = scan->next;
			if ((scan != (struct S77 *)NIL))
				comma_cont(scan->name);
		}
		Putchr(')', op_file);
	}
	G109_col = F110;
}

 void
gen_params_for(head)
	ptr_idlist	head;
{
	expression	a_expr, l_expr, s_expr, expr;
	integer	a;
	ptr_idlist	scan;
	char	ch;
	boolean	simple_ref;
	boolean	composite_ref;

	scan = head;
	while (scan != (struct S77 *)NIL) {
		{
			register struct S75 *W108 = &(*scan->id_type);

			expr.len = 0;
			append_name(&expr, scan->name);
			l_expr = expr;
			prepend_1(&l_expr, '_');
			s_expr = l_expr;
			a_expr = l_expr;
			prepend_1(&l_expr, 'L');
			prepend_1(&s_expr, 'S');
			prepend_1(&a_expr, 'A');
			switch ((int)(W108->typ_basic_type)) {
			  case chartok:  case bytetok:  case shortok:  case integertok:
			  case real32tok:  case real48tok:  case real64tok:  case real128tok:
			  case longtok:  case stringtok:  case recordtok:  case arraytok:
				gen_type_decl_for(expr, scan->id_type, 1);
				break ;
			  case sequence:
				gen_type_decl_for(a_expr, scan->id_type, 1);
				gen_type_decl_for(l_expr, simple_descriptor.A[(int)(integertok)], 1);
				break ;
			  case substring:
				gen_type_decl_for(a_expr, scan->id_type, 1);
				gen_type_decl_for(s_expr, simple_descriptor.A[(int)(integertok)], 1);
				gen_type_decl_for(l_expr, simple_descriptor.A[(int)(integertok)], 1);
				break ;
			  default:
				Caseerror(Line);
			}
		}
		scan = scan->next;
	}
}

 void
gen_struct_for(pt, level)
	ptr_defined_type	pt;
	integer	level;
{
	ptr_named_type	scan;
	expression	exp2;

	{
		register struct S75 *W109 = &(*pt);

		if (W109->typ_basic_type == recordtok) {
			(void)fprintf(op_file.fp, "%*cSTRUCTURE ", indfor(level), ' '), Putl(op_file, 0);
			if (W109->typ_name == (struct S76 *)NIL)
				codefor_error(*((error_string *)STRALIGN("Every structure must be named for VAX/FORTRAN.  ")));
			else {
				Putchr('/', op_file);
				write_name(&op_file, &W109->typ_name->nty_name);
				(void)fprintf(op_file.fp, "/ "), Putl(op_file, 0);
			}
			Putchr('\n', op_file);
			scan = W109->U.V5.typ_fields;
			while (scan != (struct S76 *)NIL) {
				exp2.len = 0;
				append_name(&exp2, scan->nty_name);
				gen_type_decl_for(exp2, scan->nty_type, level + 1);
				scan = scan->nty_next;
			}
			(void)fprintf(op_file.fp, "%*cEND STRUCTURE\n", indfor(level), ' '), Putl(op_file, 1);
		}
	}
}

 void
generate_types_for()
{
	ptr_named_type	scan;
	expression	expr;

	scan = typeptr;
	while (scan != (struct S76 *)NIL)
		{
			register struct S76 *W110 = &(*scan);
			register struct S75 *W111 = &(*W110->nty_type);

			if (W111->typ_basic_type == recordtok) {
				gen_struct_for(W110->nty_type, 1);
				Putchr('\n', op_file);
			}
			scan = W110->nty_next;
		}
}

void client_gen_for();

 void
P62_gen_client_block(ptr)
	ptr_block_table	ptr;
{
	register integer	a;
	expression	expr;

	{
		register struct S78 *W112 = &(*ptr);

		(void)fprintf(op_file.fp, "%*c", indfor(1), ' '), Putl(op_file, 0);
		if (W112->b_type == functok) {
			switch ((int)(W112->C33_return)) {
			  case chartok:
				(void)fprintf(op_file.fp, "CHARACTER*1"), Putl(op_file, 0);
				break ;
			  case bytetok:  case shortok:  case longtok:  case integertok:
				(void)fprintf(op_file.fp, "INTEGER"), Putl(op_file, 0);
				break ;
			  case real32tok:
				(void)fprintf(op_file.fp, "REAL"), Putl(op_file, 0);
				break ;
			  case real48tok:  case real64tok:  case real128tok:
				(void)fprintf(op_file.fp, "DOUBLE"), Putl(op_file, 0);
				break ;
			  default:
				Caseerror(Line);
			}
			(void)fprintf(op_file.fp, " FUNCTION "), Putl(op_file, 0);
			write_name(&op_file, &W112->name);
			switch ((int)(W112->C33_return)) {
			  case chartok:
				break ;
			  case bytetok:
				(void)fprintf(op_file.fp, "*1"), Putl(op_file, 0);
				break ;
			  case integertok:  case real32tok:  case real48tok:  case real64tok:
			  case real128tok:
				break ;
			  case shortok:
				(void)fprintf(op_file.fp, "*2"), Putl(op_file, 0);
				break ;
			  case longtok:
				(void)fprintf(op_file.fp, "*4"), Putl(op_file, 0);
				break ;
			  default:
				Caseerror(Line);
			}
		} else {
			(void)fprintf(op_file.fp, "SUBROUTINE "), Putl(op_file, 0);
			write_name(&op_file, &W112->name);
		}
		gen_dummies(W112->list);
		Putchr('\n', op_file);
		gen_client_common();
		generate_types_for();
		gen_params_for(W112->list);
		(void)fprintf(op_file.fp, "      INTEGER RPC_P_BUF"), Putl(op_file, 0);
		{
			integer	B113 = 1,
				B114 = W112->blk_nesting;

			if (B113 <= B114)
				for (a = B113; ; a++) {
					(void)fprintf(op_file.fp, ",RPC_%c", (unsigned)('A') - 1 + a), Putl(op_file, 0);
					if (a == B114) break;
				}
		}
		Putchr('\n', op_file);
		if (W112->b_type == functok) {
			format(&expr, *((template_type *)STRALIGN("RPC_RET   ")));
			gen_type_decl_for(expr, simple_descriptor.A[(int)(W112->C33_return)], 1);
		}
		if (W112->blk_status_param != (struct S77 *)NIL) {
			(void)fprintf(op_file.fp, "      INTEGER*4 RPC_CALL_STATUS\n"), Putl(op_file, 1);
			Putchr('\n', op_file);
		}
		(void)fprintf(op_file.fp, "      CALL RPC_BEGIN_CALL_FOR(RPC_P_BUF, H_"), Putl(op_file, 0);
		write_name(&op_file, &unitname);
		(void)fprintf(op_file.fp, ",%1d,%1d,%1d,%1d)\n", W112->blk_max_in, W112->blk_max_out, version_num, (*G111_proc_number)), Putl(op_file, 1);
		if (W112->list != (struct S77 *)NIL)
			gen_pack_for(&op_file, W112->list, intok, true);
		if (W112->blk_status_param != (struct S77 *)NIL) {
			(void)fprintf(op_file.fp, "      "), Putl(op_file, 0);
			write_name(&op_file, &W112->blk_status_param->name);
			(void)fprintf(op_file.fp, "=RPC_CALL_STATUS(H_"), Putl(op_file, 0);
		} else
			if (W112->blk_cast) {
				(void)fprintf(op_file.fp, "      CALL RPC_CAST(H_"), Putl(op_file, 0);
			} else {
				(void)fprintf(op_file.fp, "      CALL RPC_CALL(H_"), Putl(op_file, 0);
			}
		write_name(&op_file, &unitname);
		(void)fprintf(op_file.fp, ",RPC_P_BUF"), Putl(op_file, 0);
		if (!W112->blk_cast)
			(void)fprintf(op_file.fp, ",%1d", W112->blk_timeout), Putl(op_file, 0);
		Putchr(')', op_file),Putchr('\n', op_file);
		if (W112->blk_status_param != (struct S77 *)NIL) {
			(void)fprintf(op_file.fp, "      IF (MOD("), Putl(op_file, 0);
			write_name(&op_file, &W112->blk_status_param->name);
			(void)fprintf(op_file.fp, ",2).NE.0) THEN\n"), Putl(op_file, 1);
		}
		if (W112->b_type == functok) {
			pack_simple_for(&op_file, W112->C33_return, false);
			(void)fprintf(op_file.fp, "RPC_RET)\n"), Putl(op_file, 1);
		}
		if (W112->list != (struct S77 *)NIL)
			gen_pack_for(&op_file, W112->list, outok, false);
		if (W112->blk_status_param != (struct S77 *)NIL)
			(void)fprintf(op_file.fp, "      END IF\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "      CALL RPC_END_CALL_FOR(RPC_P_BUF)\n"), Putl(op_file, 1);
		if (W112->b_type == functok) {
			(void)fprintf(op_file.fp, "      "), Putl(op_file, 0);
			write_name(&op_file, &W112->name);
			(void)fprintf(op_file.fp, "=RPC_RET\n"), Putl(op_file, 1);
		}
		(void)fprintf(op_file.fp, "      RETURN\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "      END\n"), Putl(op_file, 1);
		Putchr('\n', op_file);
	}
}

 void
P63_gen_open()
{
	if (!runoptions.A[(int)(noautoinit)].value)
		(void)fprintf(op_file.fp, "C     Call this procedure at initialisation time ***\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      SUBROUTINE OPEN_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	gen_client_common();
	(void)fprintf(op_file.fp, "      INTEGER STATUS\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      CALL RPC_OPEN_FOR(STATUS,H_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr(',', op_file);
	continuation();
	write_name_padded(&op_file, unitname, '\'');
	Putchr(')', op_file),Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      CALL RPC_REPORT_ERROR(STATUS)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      END\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
}

 void
P64_gen_close()
{
	(void)fprintf(op_file.fp, "      SUBROUTINE CLOSE_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	gen_client_common();
	(void)fprintf(op_file.fp, "      INTEGER STATUS\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      CALL RPC_CLOSE_FOR(STATUS,H_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr(')', op_file),Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      CALL RPC_REPORT_ERROR(STATUS)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      END\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
}

 void
client_gen_for()
{
	ptr_block_table	scan;
	integer	proc_number;
	integer	*F112;

	F112 = G111_proc_number;
	G111_proc_number = &proc_number;
	next_label = 100;
	(void)fprintf(op_file.fp, "C     CLIENT STUB routines for package "), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "C     ====================\n"), Putl(op_file, 1);
	Putchr('C', op_file),Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "C     Generated automatically by the RPC Compiler\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "C     \n"), Putl(op_file, 1);
	(*G111_proc_number) = 1;
	scan = blockptr;
	while (scan != (struct S78 *)NIL) {
		P62_gen_client_block(scan);
		(*G111_proc_number) = (*G111_proc_number) + 1;
		scan = scan->next;
	}
	P63_gen_open();
	P64_gen_close();
	G111_proc_number = F112;
}

void server_gen_for();

 void
P65_gen_r_routine()
{
	register integer	a;
	expression	expr;

	(void)fprintf(op_file.fp, "      SUBROUTINE R_"), Putl(op_file, 0);
	write_name(&op_file, &(*G113_scan)->name);
	(void)fprintf(op_file.fp, "(RPC_P_BUF)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      INTEGER RPC_P_BUF"), Putl(op_file, 0);
	if ((*G113_scan)->b_type == functok) {
		Putchr('\n', op_file);
		expr.len = 0;
		append_name(&expr, (*G113_scan)->name);
		gen_type_decl_for(expr, simple_descriptor.A[(int)((*G113_scan)->C33_return)], 1);
	}
	{
		integer	B115 = 1,
			B116 = (*G113_scan)->blk_nesting;

		if (B115 <= B116)
			for (a = B115; ; a++) {
				(void)fprintf(op_file.fp, ",RPC_%c", (unsigned)('A') - 1 + a), Putl(op_file, 0);
				if (a == B116) break;
			}
	}
	Putchr('\n', op_file);
	generate_types_for();
	gen_params_for((*G113_scan)->list);
	if ((*G113_scan)->list != (struct S77 *)NIL)
		gen_pack_for(&op_file, (*G113_scan)->list, intok, false);
	(void)fprintf(op_file.fp, "      CALL RPC_INIT_RETURN_FOR(RPC_P_BUF)\n"), Putl(op_file, 1);
	if (((*G113_scan)->b_type == proctok) && (*G113_scan)->in_only)
		if ((runoptions.A[(int)(concurrent)].value || (*G113_scan)->blk_concurrent))
			(void)fprintf(op_file.fp, "      CALL RPC_EARLY_RETURN(RPC_P_BUF)\n"), Putl(op_file, 1);
		else
			if ((*G113_scan)->blk_cast)
				(void)fprintf(op_file.fp, "      CALL RPC_NO_RETURN(RPC_P_BUF)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      "), Putl(op_file, 0);
	if ((*G113_scan)->b_type == functok)
		pack_simple_for(&op_file, (*G113_scan)->C33_return, true);
	else
		(void)fprintf(op_file.fp, "CALL "), Putl(op_file, 0);
	write_name(&op_file, &(*G113_scan)->name);
	gen_dummies((*G113_scan)->list);
	if ((*G113_scan)->b_type == functok) {
		if (((*G113_scan)->list == (struct S77 *)NIL))
			(void)fprintf(op_file.fp, "()"), Putl(op_file, 0);
		Putchr(')', op_file);
	}
	Putchr('\n', op_file);
	if ((*G113_scan)->list != (struct S77 *)NIL)
		gen_pack_for(&op_file, (*G113_scan)->list, outok, true);
	(void)fprintf(op_file.fp, "      END\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
}

 void
server_gen_for()
{
	integer	proc_num;
	register integer	i;
	ptr_block_table	scan;
	ptr_block_table	*F114;

	F114 = G113_scan;
	G113_scan = &scan;
	next_label = 100;
	(void)fprintf(op_file.fp, "C     SERVER STUB routines for package "), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "C     ====================\n"), Putl(op_file, 1);
	Putchr('C', op_file),Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "C     Generated automatically by the RPC Compiler\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "C     \n"), Putl(op_file, 1);
	(*G113_scan) = blockptr;
	proc_num = 0;
	while ((*G113_scan) != (struct S78 *)NIL) {
		proc_num = proc_num + 1;
		P65_gen_r_routine();
		(*G113_scan) = (*G113_scan)->next;
	}
	Putchr('C', op_file),Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "C                         Main stub entry point\n"), Putl(op_file, 1);
	Putchr('C', op_file),Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      SUBROUTINE R_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, "(RPC_P_BUF)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      INTEGER RPC_P_BUF\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      INTEGER*2 RPC_REQUEST\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      INTEGER*4 STATUS\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      INTEGER RPC_S_UNSUPPORTED_VERSION\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      PARAMETER(RPC_S_UNSUPPORTED_VERSION=139624458)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      INTEGER RPC_S_BAD_PROCEDURE_NUMBER\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      PARAMETER(RPC_S_BAD_PROCEDURE_NUMBER=139624466)\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      CALL UPK_SHORT_FOR(RPC_P_BUF, RPC_REQUEST)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      IF ((RPC_REQUEST.NE.0).AND.(RPC_REQUEST.NE.%1d)) THEN\n", version_num), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      CALL RPC_SET_ERROR(RPC_P_BUF,RPC_S_UNSUPPORTED_VERSION)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      ELSE\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "         CALL UPK_SHORT_FOR(RPC_P_BUF, RPC_REQUEST)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "         IF ((RPC_REQUEST.LE.0).OR.(RPC_REQUEST.GT.%1d)) THEN\n", proc_num), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "            CALL RPC_SET_ERROR(RPC_P_BUF,RPC_S_BAD_PROCEDURE_NUMBER)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "         ELSE\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "            GOTO(10"), Putl(op_file, 0);
	{
		integer	B117 = 2,
			B118 = proc_num;

		if (B117 <= B118)
			for (i = B117; ; i++) {
				if ((i % 10) == 0) {
					Putchr('\n', op_file);
					(void)fprintf(op_file.fp, "     + "), Putl(op_file, 0);
				}
				(void)fprintf(op_file.fp, ",%1d", i * 10), Putl(op_file, 0);
				if (i == B118) break;
			}
	}
	(void)fprintf(op_file.fp, "),RPC_REQUEST\n"), Putl(op_file, 1);
	(*G113_scan) = blockptr;
	{
		integer	B119 = 1,
			B120 = proc_num;

		if (B119 <= B120)
			for (i = B119; ; i++) {
				Putchr('\n', op_file);
				(void)fprintf(op_file.fp, "%5d       CALL R_", i * 10), Putl(op_file, 0);
				write_name(&op_file, &(*G113_scan)->name);
				(void)fprintf(op_file.fp, "(RPC_P_BUF)\n"), Putl(op_file, 1);
				(void)fprintf(op_file.fp, "            GOTO 888\n"), Putl(op_file, 1);
				(*G113_scan) = (*G113_scan)->next;
				if (i == B120) break;
			}
	}
	(void)fprintf(op_file.fp, "  888       CONTINUE\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "         END IF\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      END IF\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      END\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	if (!runoptions.A[(int)(noautoinit)].value)
		(void)fprintf(op_file.fp, "C     Call this procedure at initialisation time ***\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      SUBROUTINE ATTACH_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	gen_server_common();
	(void)fprintf(op_file.fp, "      EXTERNAL R_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      INTEGER STATUS\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      CALL RPC_ATTACH_STUB_FOR(STATUS,R_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr(',', op_file);
	continuation();
	write_name_padded(&op_file, unitname, '\'');
	(void)fprintf(op_file.fp, ",P_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr(')', op_file),Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      CALL RPC_REPORT_ERROR(STATUS)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      END\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      SUBROUTINE DETACH_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	gen_server_common();
	(void)fprintf(op_file.fp, "      CALL RPC_DETACH_STUB_FOR(P_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr(')', op_file),Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "      END\n"), Putl(op_file, 1);
	G113_scan = F114;
}

 void
write_name_pils(where, name)
	text	*where;
	id_name	*name;
{
	register integer	a;

	{
		register struct S102 *W121 = &(*name);

		{
			integer	B122 = 1,
				B123 = W121->len;

			if (B122 <= B123)
				for (a = B122; ; a++) {
					Putchr(W121->str.A[a - 1], (*where));
					if (a == B123) break;
				}
		}
	}
}

 void
write_exp_pils(where, expr)
	text	*where;
	expression	*expr;
{
	register integer	a;

	{
		register struct S106 *W124 = &(*expr);

		{
			integer	B125 = 1,
				B126 = W124->len;

			if (B125 <= B126)
				for (a = B125; ; a++) {
					Putchr(W124->str.A[a - 1], (*where));
					if (a == B126) break;
				}
		}
	}
}

 void
write_name_padded_pils(op_file, name, ch)
	text	*op_file;
	id_name	name;
	char	ch;
{
	Putchr(ch, (*op_file));
	write_name(&(*op_file), &name);
	(void)fprintf((*op_file).fp, "%*c", rpc_name_length + 1 - name.len, ch), Putl((*op_file), 0);
}

 void
code_error_pils(why)
	error_string	why;
{
	(void)fprintf(output.fp, " RPCC: **** Error: %.48s\n", why.A), Putl(output, 1);
	(void)fprintf(output.fp, "       (Error detected at PILS code generator stage.)\n"), Putl(output, 1);
	abort();
}

 integer
ind_pils(level)
	integer	level;
{
	register integer	R99;

	R99 = (level) * 3;
	return R99;
}

 void
append_index_pils(expr, level)
	expression	*expr;
	integer	level;
{
	char	ch;

	format(&(*expr), *((template_type *)STRALIGN("$(rpc_    ")));
	append_1(&(*expr), (unsigned)('a') + level - 1);
	append_1(&(*expr), ')');
}

 void
pack_simple_pils(where, what, topack)
	text	*where;
	type_token	what;
	boolean	topack;
{
	if (topack)
		(void)fprintf((*where).fp, "pck_"), Putl((*where), 0);
	else
		(void)fprintf((*where).fp, "upk_"), Putl((*where), 0);
	switch ((int)(what)) {
	  case chartok:
		(void)fprintf((*where).fp, "char"), Putl((*where), 0);
		break ;
	  case bytetok:
		(void)fprintf((*where).fp, "byte"), Putl((*where), 0);
		break ;
	  case shortok:
		(void)fprintf((*where).fp, "short"), Putl((*where), 0);
		break ;
	  case integertok:
		(void)fprintf((*where).fp, "integer"), Putl((*where), 0);
		break ;
	  case real32tok:
		(void)fprintf((*where).fp, "real32"), Putl((*where), 0);
		break ;
	  case real48tok:
		(void)fprintf((*where).fp, "real48"), Putl((*where), 0);
		break ;
	  case real64tok:
		(void)fprintf((*where).fp, "real64"), Putl((*where), 0);
		break ;
	  case real128tok:
		(void)fprintf((*where).fp, "real128"), Putl((*where), 0);
		break ;
	  case longtok:
		(void)fprintf((*where).fp, "long"), Putl((*where), 0);
		break ;
	  default:
		Caseerror(Line);
	}
	(void)fprintf((*where).fp, "(rpc_p_buf,"), Putl((*where), 0);
}

 void
gen_align_pils(power, level)
	integer	power;
	integer	level;
{
	(void)fprintf(op_file.fp, "%*crpc_align(rpc_p_buf,%1d)\n", ind_pils(level), ' ', power), Putl(op_file, 1);
}

 void
gen_pack_type_pils(where, expr, typ, level, topack)
	text	*where;
	expression	expr;
	ptr_defined_type	typ;
	integer	level;
	boolean	topack;
{
	char	ch;
	ptr_named_type	scan;
	ptr_defined_type	element;
	integer	depth;
	expression	exp2;
	expression	l_expr, s_expr;
	register integer	i;

	ch = (unsigned)('a') + level - 1;
	l_expr = expr;
	prepend_1(&l_expr, '_');
	s_expr = l_expr;
	prepend_1(&l_expr, 'L');
	prepend_1(&s_expr, 'S');
	{
		register struct S75 *W127 = &(*typ);

		if (W127->typ_external) {
			(void)fprintf((*where).fp, "%*c", ind_pils(level), ' '), Putl((*where), 0);
			if (topack)
				(void)fprintf((*where).fp, "pck_"), Putl((*where), 0);
			else
				(void)fprintf((*where).fp, "upk_"), Putl((*where), 0);
			write_name(&op_file, &W127->typ_name->nty_name);
			(void)fprintf((*where).fp, "(rpc_p_buf,"), Putl((*where), 0);
			write_exp(&(*where), &expr);
			Putchr(')', (*where)),Putchr('\n', (*where));
		} else
			switch ((int)(W127->typ_basic_type)) {
			  case chartok:
				(void)fprintf((*where).fp, "%*c", ind_pils(level), ' '), Putl((*where), 0);
				if (topack)
					(void)fprintf((*where).fp, "pck"), Putl((*where), 0);
				else
					(void)fprintf((*where).fp, "upk"), Putl((*where), 0);
				(void)fprintf((*where).fp, "_char_PILS(rpc_p_buf,"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr(')', (*where)),Putchr('\n', (*where));
				break ;
			  case bytetok:
				(void)fprintf((*where).fp, "%*c", ind_pils(level), ' '), Putl((*where), 0);
				if (topack)
					(void)fprintf((*where).fp, "pck"), Putl((*where), 0);
				else
					(void)fprintf((*where).fp, "upk"), Putl((*where), 0);
				(void)fprintf((*where).fp, "_byte_PILS(rpc_p_buf,"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr(')', (*where)),Putchr('\n', (*where));
				break ;
			  case shortok:  case integertok:  case real32tok:  case real48tok:
			  case real64tok:  case real128tok:  case longtok:
				(void)fprintf((*where).fp, "%*c", ind_pils(level), ' '), Putl((*where), 0);
				if (topack)
					(void)fprintf((*where).fp, "pck"), Putl((*where), 0);
				else
					(void)fprintf((*where).fp, "upk"), Putl((*where), 0);
				{
					register struct S102 *W128 = &W127->typ_name->nty_name;

					{
						integer	B129 = 4,
							B130 = W128->len;

						if (B129 <= B130)
							for (i = B129; ; i++) {
								Putchr(W128->str.A[i - 1], (*where));
								if (i == B130) break;
							}
					}
				}
				(void)fprintf((*where).fp, "(rpc_p_buf,"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr(')', (*where)),Putchr('\n', (*where));
				break ;
			  case arraytok:
				exp2 = expr;
				depth = level;
				ch = (unsigned)('a') + depth - 1;
				element = W127->typ_subtype;
				format(&exp2, *((template_type *)STRALIGN("$(rpc_    ")));
				append_1(&exp2, ch);
				(void)fprintf((*where).fp, "%*c", ind_pils(depth), ' '), Putl((*where), 0);
				(void)fprintf((*where).fp, "FOR rpc_%c=1 TO %1d\n", ch, W127->U.V4.typ_high - W127->U.V4.typ_low + 1), Putl((*where), 1);
				while (element->typ_basic_type == arraytok)
					{
						register struct S75 *W131 = &(*element);

						depth = depth + 1;
						ch = (unsigned)('a') + depth - 1;
						(void)fprintf((*where).fp, "%*c", ind_pils(depth), ' '), Putl((*where), 0);
						(void)fprintf((*where).fp, "FOR rpc_%c=1 TO %1d\n", ch, W131->U.V4.typ_high - W131->U.V4.typ_low + 1), Putl((*where), 1);
						format(&exp2, *((template_type *)STRALIGN("$,rpc_    ")));
						append_1(&exp2, ch);
						element = element->typ_subtype;
					}
				append_1(&exp2, ')');
				gen_pack_type_pils(&(*where), exp2, element, depth + 1, topack);
				while (depth >= level) {
					(void)fprintf((*where).fp, "%*cENDFOR\n", ind_pils(depth), ' '), Putl((*where), 1);
					depth = depth - 1;
				}
				break ;
			  case recordtok:
				code_error_pils(*((error_string *)STRALIGN("No RECORD (STRUCTURE) type exists in PILS!      ")));
				break ;
			  case accesstok:
				code_error_pils(*((error_string *)STRALIGN("No ACCESS (POINTER) type exists in PILS!        ")));
				break ;
			  case sequence:
				if (level > 1)
					code_error_pils(*((error_string *)STRALIGN("SEQUENCE type not allowed within composite type.")));
				gen_pack_type_pils(&(*where), l_expr, simple_descriptor.A[(int)(integertok)], level, topack);
				exp2 = expr;
				format(&exp2, *((template_type *)STRALIGN("A_$       ")));
				append_index_pils(&exp2, level);
				(void)fprintf((*where).fp, "%*c", ind_pils(level), ' '), Putl((*where), 0);
				(void)fprintf((*where).fp, "FOR rpc_%c=1 TO L_", ch), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr('\n', (*where));
				gen_pack_type_pils(&(*where), exp2, W127->typ_subtype, level + 1, topack);
				(void)fprintf((*where).fp, "%*cENDFOR\n", ind_pils(level), ' '), Putl((*where), 1);
				break ;
			  case stringtok:
				(void)fprintf((*where).fp, "%*c", ind_pils(level), ' '), Putl((*where), 0);
				if (topack)
					(void)fprintf((*where).fp, "pck_string"), Putl((*where), 0);
				else
					(void)fprintf((*where).fp, "upk_string"), Putl((*where), 0);
				(void)fprintf((*where).fp, "(rpc_p_buf,"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr(')', (*where)),Putchr('\n', (*where));
				break ;
			  case substring:
				(void)fprintf((*where).fp, "%*c", ind_pils(level), ' '), Putl((*where), 0);
				if (topack)
					(void)fprintf((*where).fp, "pck_substring"), Putl((*where), 0);
				else
					(void)fprintf((*where).fp, "upk_substring"), Putl((*where), 0);
				(void)fprintf((*where).fp, "(rpc_p_buf,A_"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr(',', (*where));
				(void)fprintf((*where).fp, "S_"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				(void)fprintf((*where).fp, ",L_"), Putl((*where), 0);
				write_exp(&(*where), &expr);
				Putchr(')', (*where)),Putchr('\n', (*where));
				break ;
			  default:
				Caseerror(Line);
			}
	}
}

 void
gen_pack_pils(where, head, dirn, topack)
	text	*where;
	ptr_idlist	head;
	attr_type	dirn;
	boolean	topack;
{
	expression	expr;

	do {
		{
			register struct S77 *W132 = &(*head);
			register struct S75 *W133 = &(*W132->id_type);

			expr.len = 0;
			append_name(&expr, head->name);
			if ((W132->attr == inoutok) || (W132->attr == dirn)) {
				deref = (boolean)(client && !(runoptions.A[(int)(byvalue)].value && (W132->attr == intok)));
				gen_pack_type_pils(&(*where), expr, W132->id_type, 1, topack);
			}
		}
		head = head->next;
	} while (!(head == (struct S77 *)NIL));
}

 void
gen_type_decl_pils(expr, pt, level)
	expression	expr;
	ptr_defined_type	pt;
	integer	level;
{
	ptr_defined_type	scan;
	expression	exp2;

	{
		register struct S75 *W134 = &(*pt);

		switch ((int)(W134->typ_basic_type)) {
		  case chartok:  case bytetok:  case shortok:  case integertok:
		  case real32tok:  case real48tok:  case real64tok:  case real128tok:
		  case longtok:
			switch ((int)(W134->typ_basic_type)) {
			  case chartok:
				(void)fprintf(op_file.fp, "int16"), Putl(op_file, 0);
				break ;
			  case bytetok:
				(void)fprintf(op_file.fp, "int16"), Putl(op_file, 0);
				break ;
			  case integertok:
				(void)fprintf(op_file.fp, "INT"), Putl(op_file, 0);
				break ;
			  case real32tok:
				(void)fprintf(op_file.fp, "REAL"), Putl(op_file, 0);
				break ;
			  case real48tok:
				(void)fprintf(op_file.fp, "REAL"), Putl(op_file, 0);
				break ;
			  case real64tok:
				(void)fprintf(op_file.fp, "REAL"), Putl(op_file, 0);
				break ;
			  case real128tok:
				(void)fprintf(op_file.fp, "REAL"), Putl(op_file, 0);
				break ;
			  case shortok:
				(void)fprintf(op_file.fp, "INT16"), Putl(op_file, 0);
				break ;
			  case longtok:
				(void)fprintf(op_file.fp, "INT32"), Putl(op_file, 0);
				break ;
			  default:
				Caseerror(Line);
			}
			Putchr(' ', op_file);
			write_exp(&op_file, &expr);
			break ;
		  case substring:  case stringtok:
			(void)fprintf(op_file.fp, "CHAR "), Putl(op_file, 0);
			write_exp(&op_file, &expr);
			break ;
		  case sequence:  case arraytok:
			exp2 = expr;
			append_1(&exp2, '(');
			append_decimal(&exp2, W134->U.V4.typ_high - W134->U.V4.typ_low + 1);
			scan = W134->typ_subtype;
			while (scan->typ_basic_type == arraytok) {
				append_1(&exp2, ',');
				append_decimal(&exp2, scan->U.V4.typ_high - W134->U.V4.typ_low + 1);
				scan = scan->typ_subtype;
			}
			append_1(&exp2, ')');
			gen_type_decl_pils(exp2, scan, level);
			break ;
		  case accesstok:
			code_error_pils(*((error_string *)STRALIGN("Package has pointers: Can't make PILS stubs.    ")));
			break ;
		  case recordtok:
			code_error_pils(*((error_string *)STRALIGN("Package has records:  Can't make PILS stubs.    ")));
			break ;
		  default:
			Caseerror(Line);
		}
	}
}

 void
gen_params_pils(head)
	ptr_idlist	head;
{
	expression	a_expr, l_expr, s_expr, expr;
	integer	a;
	ptr_idlist	scan;
	char	ch;
	boolean	simple_ref;
	boolean	composite_ref;

	scan = head;
	if (client)
		Putchr('(', op_file);
	while (scan != (struct S77 *)NIL) {
		if (client)
			switch ((int)(scan->attr)) {
			  case intok:
				(void)fprintf(op_file.fp, "IN "), Putl(op_file, 0);
				break ;
			  case outok:
				(void)fprintf(op_file.fp, "OUT "), Putl(op_file, 0);
				break ;
			  case inoutok:
				(void)fprintf(op_file.fp, "INOUT "), Putl(op_file, 0);
				break ;
			  default:
				Caseerror(Line);
			}
		{
			register struct S75 *W135 = &(*scan->id_type);

			expr.len = 0;
			append_name(&expr, scan->name);
			l_expr = expr;
			prepend_1(&l_expr, '_');
			s_expr = l_expr;
			a_expr = l_expr;
			prepend_1(&l_expr, 'L');
			prepend_1(&s_expr, 'S');
			prepend_1(&a_expr, 'A');
			switch ((int)(W135->typ_basic_type)) {
			  case chartok:  case bytetok:  case shortok:  case integertok:
			  case real32tok:  case real48tok:  case real64tok:  case real128tok:
			  case longtok:  case stringtok:  case recordtok:  case arraytok:
				gen_type_decl_pils(expr, scan->id_type, 1);
				break ;
			  case sequence:
				gen_type_decl_pils(a_expr, scan->id_type, 1);
				if (client)
					Putchr(',', op_file);
				else
					Putchr(';', op_file);
				gen_type_decl_pils(l_expr, simple_descriptor.A[(int)(integertok)], 1);
				break ;
			  case substring:
				gen_type_decl_pils(a_expr, scan->id_type, 1);
				if (client)
					Putchr(',', op_file);
				else
					Putchr(';', op_file);
				gen_type_decl_pils(s_expr, simple_descriptor.A[(int)(integertok)], 1);
				if (client)
					Putchr(',', op_file);
				else
					Putchr(';', op_file);
				gen_type_decl_pils(l_expr, simple_descriptor.A[(int)(integertok)], 1);
				break ;
			  default:
				Caseerror(Line);
			}
		}
		scan = scan->next;
		if (scan != (struct S77 *)NIL)
			if (client)
				Putchr(',', op_file);
			else
				Putchr(';', op_file);
	}
	if (client)
		Putchr(')', op_file);
	Putchr('\n', op_file);
}

 void
gen_formals(head)
	ptr_idlist	head;
{
	ptr_idlist	scan;

	if (head != (struct S77 *)NIL) {
		scan = head;
		Putchr('(', op_file);
		while (scan != (struct S77 *)NIL) {
			if (Member((unsigned)(scan->id_type->typ_basic_type), Conset[60]))
				(void)fprintf(op_file.fp, "A_"), Putl(op_file, 0);
			write_name(&op_file, &scan->name);
			if (scan->id_type->typ_basic_type == substring) {
				(void)fprintf(op_file.fp, ", S_"), Putl(op_file, 0);
				write_name(&op_file, &scan->name);
			}
			if (Member((unsigned)(scan->id_type->typ_basic_type), Conset[61])) {
				(void)fprintf(op_file.fp, ", L_"), Putl(op_file, 0);
				write_name(&op_file, &scan->name);
			}
			scan = scan->next;
			if (scan != (struct S77 *)NIL)
				Putchr(',', op_file);
		}
		Putchr(')', op_file);
	}
}

 void
gen_struct_pils(pt, level)
	ptr_defined_type	pt;
	integer	level;
{
	ptr_named_type	scan;
	expression	exp2;

}

 void
generate_types_pils()
{
}

void client_generator_pils();

 void
P66_gen_client_block(ptr)
	ptr_block_table	ptr;
{
	register integer	a;
	expression	expr;

	{
		register struct S78 *W136 = &(*ptr);

		if (W136->b_type == functok) {
			(void)fprintf(op_file.fp, "DEF "), Putl(op_file, 0);
			switch ((int)(W136->C33_return)) {
			  case chartok:
				(void)fprintf(op_file.fp, "int16"), Putl(op_file, 0);
				break ;
			  case bytetok:
				(void)fprintf(op_file.fp, "int16"), Putl(op_file, 0);
				break ;
			  case shortok:  case integertok:
				(void)fprintf(op_file.fp, "INT16"), Putl(op_file, 0);
				break ;
			  case longtok:
				(void)fprintf(op_file.fp, "INT32"), Putl(op_file, 0);
				break ;
			  case real32tok:  case real48tok:  case real64tok:  case real128tok:
				(void)fprintf(op_file.fp, "REAL"), Putl(op_file, 0);
				break ;
			  default:
				Caseerror(Line);
			}
			Putchr(' ', op_file);
			write_name(&op_file, &W136->name);
		} else {
			(void)fprintf(op_file.fp, "SUB "), Putl(op_file, 0);
			write_name(&op_file, &W136->name);
		}
		gen_params_pils(W136->list);
		Putchr('\n', op_file);
		(void)fprintf(op_file.fp, "   INT rpc_p_buf"), Putl(op_file, 0);
		{
			integer	B137 = 1,
				B138 = W136->blk_nesting;

			if (B137 <= B138)
				for (a = B137; ; a++) {
					(void)fprintf(op_file.fp, ",rpc_%c", (unsigned)('a') - 1 + a), Putl(op_file, 0);
					if (a == B138) break;
				}
		}
		Putchr('\n', op_file);
		if (W136->b_type == functok) {
			(void)fprintf(op_file.fp, "   INT rpc_ret\n"), Putl(op_file, 1);
		}
		Putchr('\n', op_file);
		(void)fprintf(op_file.fp, "   rpc_begin_call(rpc_p_buf,h_"), Putl(op_file, 0);
		write_name(&op_file, &unitname);
		(void)fprintf(op_file.fp, ",%1d,%1d,%1d,%1d)\n", W136->blk_max_in, W136->blk_max_out, version_num, (*G115_proc_number)), Putl(op_file, 1);
		if (W136->list != (struct S77 *)NIL)
			gen_pack_pils(&op_file, W136->list, intok, true);
		if (W136->blk_cast)
			(void)fprintf(op_file.fp, "   rpc_cast(h_"), Putl(op_file, 0);
		else
			(void)fprintf(op_file.fp, "   rpc_call(h_"), Putl(op_file, 0);
		write_name(&op_file, &unitname);
		(void)fprintf(op_file.fp, ",rpc_p_buf"), Putl(op_file, 0);
		if (!W136->blk_cast)
			(void)fprintf(op_file.fp, ",%1d", W136->blk_timeout), Putl(op_file, 0);
		Putchr(')', op_file),Putchr('\n', op_file);
		if (W136->b_type == functok) {
			(void)fprintf(op_file.fp, "   "), Putl(op_file, 0);
			pack_simple_pils(&op_file, W136->C33_return, false);
			(void)fprintf(op_file.fp, "rpc_ret)\n"), Putl(op_file, 1);
		}
		if (W136->list != (struct S77 *)NIL)
			gen_pack_pils(&op_file, W136->list, outok, false);
		(void)fprintf(op_file.fp, "   rpc_end_call(rpc_p_buf)\n"), Putl(op_file, 1);
		if (W136->b_type == functok) {
			(void)fprintf(op_file.fp, "   "), Putl(op_file, 0);
			write_name(&op_file, &W136->name);
			(void)fprintf(op_file.fp, "=rpc_ret\n"), Putl(op_file, 1);
		}
		(void)fprintf(op_file.fp, "END"), Putl(op_file, 0);
		if (W136->b_type == functok)
			(void)fprintf(op_file.fp, "DEF"), Putl(op_file, 0);
		else
			(void)fprintf(op_file.fp, "SUB"), Putl(op_file, 0);
		Putchr('\n', op_file);
		Putchr('\n', op_file);
	}
}

 void
gen_client_header()
{
	(void)fprintf(op_file.fp, "!---\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "!---  CLIENT STUB routines for package "), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "!---\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "!---  Generated automatically by the RPC Compiler\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "!---\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "OPTION IMPLICIT OFF\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "OPTION BASE 1\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "MODULE CLI"), Putl(op_file, 0);
	write_name_pils(&op_file, &unitname);
	Putchr('\n', op_file);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "GLOBAL INT h_"), Putl(op_file, 0);
	write_name_pils(&op_file, &unitname);
	Putchr('\n', op_file);
	Putchr('\n', op_file);
}

 void
P67_gen_open()
{
	(void)fprintf(op_file.fp, "SUB open_"), Putl(op_file, 0);
	write_name_pils(&op_file, &unitname);
	(void)fprintf(op_file.fp, "()\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "   INT status\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "   CHAR service\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "   service = "), Putl(op_file, 0);
	write_name_padded_pils(&op_file, unitname, '"');
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "   rpc_open(status,h_"), Putl(op_file, 0);
	write_name_pils(&op_file, &unitname);
	(void)fprintf(op_file.fp, ",service)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "   rpc_report_error(status)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "ENDSUB\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	if (!runoptions.A[(int)(noautoinit)].value) {
		(void)fprintf(op_file.fp, "!---  This procedure will be called at initialisation time ***\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "open_"), Putl(op_file, 0);
		write_name_pils(&op_file, &unitname);
		(void)fprintf(op_file.fp, "()\n"), Putl(op_file, 1);
		Putchr('\n', op_file);
	}
}

 void
client_generator_pils()
{
	ptr_block_table	scan;
	integer	proc_number;
	integer	*F116;

	F116 = G115_proc_number;
	G115_proc_number = &proc_number;
	gen_client_header();
	(*G115_proc_number) = 1;
	scan = blockptr;
	while (scan != (struct S78 *)NIL) {
		P66_gen_client_block(scan);
		(*G115_proc_number) = (*G115_proc_number) + 1;
		scan = scan->next;
	}
	P67_gen_open();
	(void)fprintf(op_file.fp, "ENDMODULE\n"), Putl(op_file, 1);
	G115_proc_number = F116;
}

void server_generator_pils();

 void
P68_gen_r_routine()
{
	integer	b;
	register integer	a;

	(void)fprintf(op_file.fp, "SUB r_"), Putl(op_file, 0);
	write_name(&op_file, &(*G117_scan)->name);
	(void)fprintf(op_file.fp, "(INOUT INT rpc_p_buf)\n"), Putl(op_file, 1);
	generate_types_pils();
	gen_params_pils((*G117_scan)->list);
	Putchr('\n', op_file);
	b = (*G117_scan)->blk_nesting;
	if (b > 0)
		(void)fprintf(op_file.fp, "   INT rpc_a"), Putl(op_file, 0);
	{
		integer	B139 = 2,
			B140 = b;

		if (B139 <= B140)
			for (a = B139; ; a++) {
				(void)fprintf(op_file.fp, ",rpc_%c", (unsigned)('a') - 1 + a), Putl(op_file, 0);
				if (a == B140) break;
			}
	}
	Putchr('\n', op_file);
	Putchr('\n', op_file);
	if ((*G117_scan)->list != (struct S77 *)NIL)
		gen_pack_pils(&op_file, (*G117_scan)->list, intok, false);
	(void)fprintf(op_file.fp, "   rpc_init_return(rpc_p_buf)\n"), Putl(op_file, 1);
	if (((*G117_scan)->b_type == proctok) && (*G117_scan)->in_only)
		if (((runoptions.A[(int)(concurrent)].value) || (*G117_scan)->blk_concurrent))
			(void)fprintf(op_file.fp, "   rpc_early_return(rpc_p_buf)\n"), Putl(op_file, 1);
		else
			if ((*G117_scan)->blk_cast)
				(void)fprintf(op_file.fp, "   rpc_no_return(rpc_p_buf)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "   "), Putl(op_file, 0);
	if ((*G117_scan)->b_type == functok)
		pack_simple_pils(&op_file, (*G117_scan)->C33_return, true);
	write_name(&op_file, &(*G117_scan)->name);
	gen_formals((*G117_scan)->list);
	if ((*G117_scan)->b_type == functok)
		Putchr(')', op_file);
	Putchr('\n', op_file);
	if ((*G117_scan)->list != (struct S77 *)NIL)
		gen_pack_pils(&op_file, (*G117_scan)->list, outok, true);
	(void)fprintf(op_file.fp, "ENDSUB\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
}

 void
P69_gen_attach()
{
	if (!runoptions.A[(int)(noautoinit)].value)
		(void)fprintf(op_file.fp, "!---  Call this procedure at initialisation time ***\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "SUB attach_"), Putl(op_file, 0);
	write_name_pils(&op_file, &unitname);
	(void)fprintf(op_file.fp, "()\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "   INT status\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "   CHAR service\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "   service = "), Putl(op_file, 0);
	write_name_padded_pils(&op_file, unitname, '"');
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "   rpc_attach_stub(status,address(r_"), Putl(op_file, 0);
	write_name_pils(&op_file, &unitname);
	(void)fprintf(op_file.fp, "),service,program_number)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "   rpc_report_error(status);\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "ENDSUB\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
}

 void
P70_gen_detach()
{
	if (!runoptions.A[(int)(noautoinit)].value)
		(void)fprintf(op_file.fp, "!---  Call this procedure at exit time ***\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "SUB detach_"), Putl(op_file, 0);
	write_name_pils(&op_file, &unitname);
	(void)fprintf(op_file.fp, "()\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "   rpc_detach_stub(program_number)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "ENDSUB\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
}

 void
server_generator_pils()
{
	integer	i, proc_num;
	ptr_block_table	scan;
	ptr_block_table	*F118;

	F118 = G117_scan;
	G117_scan = &scan;
	(void)fprintf(op_file.fp, "!---\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "!---  SERVER STUB routines for package "), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "!---\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "!---  Generated automatically by the RPC Compiler\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "!---\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "OPTION IMPLICIT OFF\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "OPTION BASE 1\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "MODULE SER"), Putl(op_file, 0);
	write_name_pils(&op_file, &unitname);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "HIDDEN INT program_number\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(*G117_scan) = blockptr;
	proc_num = 0;
	while ((*G117_scan) != (struct S78 *)NIL) {
		proc_num = proc_num + 1;
		P68_gen_r_routine();
		(*G117_scan) = (*G117_scan)->next;
	}
	(void)fprintf(op_file.fp, "!---\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "!---        Main stub entry point\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "!---\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "SUB r_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, "(INOUT INT rpc_p_buf)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "   INT16 rpc_request\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "   upk_short(rpc_p_buf,rpc_request)\n"), Putl(op_file, 1);
	if (version_num != 0) {
		(void)fprintf(op_file.fp, "   IF (rpc_request # 0) AND (rpc_request # %1d) THEN\n", version_num), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "      rpc_set_error(rpc_p_buf,rpc_s_unsupported_version)\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "   ELSE\n"), Putl(op_file, 1);
	}
	(void)fprintf(op_file.fp, "      upk_short(rpc_p_buf,rpc_request)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      SELECT rpc_request\n"), Putl(op_file, 1);
	(*G117_scan) = blockptr;
	proc_num = 1;
	while ((*G117_scan) != (struct S78 *)NIL) {
		(void)fprintf(op_file.fp, "      CASE %2d\n", proc_num), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "         r_"), Putl(op_file, 0);
		write_name_pils(&op_file, &(*G117_scan)->name);
		(void)fprintf(op_file.fp, "(rpc_p_buf)\n"), Putl(op_file, 1);
		proc_num = proc_num + 1;
		(*G117_scan) = (*G117_scan)->next;
	}
	(void)fprintf(op_file.fp, "      CASE ELSE \n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "         "), Putl(op_file, 0);
	(void)fprintf(op_file.fp, "rpc_set_error(rpc_p_buf,rpc_s_bad_procedure_number)\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "      ENDSELECT\n"), Putl(op_file, 1);
	if (version_num != 0)
		(void)fprintf(op_file.fp, "   ENDIF\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "ENDSUB\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
	P69_gen_attach();
	P70_gen_detach();
	(void)fprintf(op_file.fp, "ENDMODULE\n"), Putl(op_file, 1);
	G117_scan = F118;
}

 void
codegen_error(why)
	error_string	why;
{
	(void)fprintf(output.fp, " RPCC: **** Error: %.48s\n", why.A), Putl(output, 1);
	(void)fprintf(output.fp, "       (Error detected at code generator stage.)\n"), Putl(output, 1);
	abort();
}

 void
writok(where, what)
	text	*where;
	type_token	what;
{
	switch ((int)(what)) {
	  case chartok:
		(void)fprintf((*where).fp, "rpc_char"), Putl((*where), 0);
		break ;
	  case bytetok:
		(void)fprintf((*where).fp, "rpc_byte"), Putl((*where), 0);
		break ;
	  case shortok:
		(void)fprintf((*where).fp, "rpc_short"), Putl((*where), 0);
		break ;
	  case integertok:
		(void)fprintf((*where).fp, "rpc_integer"), Putl((*where), 0);
		break ;
	  case real32tok:
		(void)fprintf((*where).fp, "rpc_real32"), Putl((*where), 0);
		break ;
	  case real48tok:
		(void)fprintf((*where).fp, "rpc_real48"), Putl((*where), 0);
		break ;
	  case real64tok:
		(void)fprintf((*where).fp, "rpc_real64"), Putl((*where), 0);
		break ;
	  case real128tok:
		(void)fprintf((*where).fp, "rpc_real128"), Putl((*where), 0);
		break ;
	  case longtok:
		(void)fprintf((*where).fp, "rpc_long"), Putl((*where), 0);
		break ;
	  case arraytok:  case sequence:  case stringtok:  case substring:
		if (Member((unsigned)(omode), cmode.S))
			Putchr('[', (*where));
		else
			(void)fprintf((*where).fp, "ARRAY [1.."), Putl((*where), 0);
		break ;
	  case proctok:
		if (!(Member((unsigned)(omode), cmode.S)))
			(void)fprintf((*where).fp, "PROCEDURE "), Putl((*where), 0);
		break ;
	  case functok:
		if (!(Member((unsigned)(omode), cmode.S)))
			(void)fprintf((*where).fp, "FUNCTION "), Putl((*where), 0);
		break ;
	  default:
		Caseerror(Line);
	}
}

 integer
leftin(level)
	integer	level;
{
	register integer	R100;

	R100 = level * 3;
	return R100;
}

 void
write_declaration(where, prefix, ptr, ref)
	text	*where;
	char	prefix;
	ptr_idlist	ptr;
	boolean	ref;
{
	{
		register struct S77 *W141 = &(*ptr);

		if (!(Member((unsigned)(omode), cmode.S))) {
			if (ref)
				(void)fprintf((*where).fp, "VAR "), Putl((*where), 0);
			if (prefix != ' ')
				(void)fprintf((*where).fp, "%c_", prefix), Putl((*where), 0);
			write_name(&(*where), &W141->name);
			(void)fprintf((*where).fp, ": "), Putl((*where), 0);
		}
		{
			register struct S75 *W142 = &(*W141->id_type);

			if (W142->typ_name != (struct S76 *)NIL)
				write_name(&(*where), &W142->typ_name->nty_name);
			else
				codegen_error(*((error_string *)STRALIGN("Internal error: Unnamed type when name needed!  ")));
		}
		if (Member((unsigned)(omode), cmode.S)) {
			Putchr(' ', (*where));
			if (ref)
				Putchr('*', (*where));
			if (prefix != ' ')
				(void)fprintf((*where).fp, "%c_", prefix), Putl((*where), 0);
			write_name(&(*where), &W141->name);
		}
	}
}

 void
write_integer(where, prefix, name, ref)
	text	*where;
	char	prefix;
	id_name	*name;
	boolean	ref;
{
	(void)fprintf((*where).fp, "    "), Putl((*where), 0);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf((*where).fp, "rpc_integer "), Putl((*where), 0);
	if (ref)
		if (Member((unsigned)(omode), cmode.S))
			Putchr('*', (*where));
		else
			(void)fprintf((*where).fp, "VAR "), Putl((*where), 0);
	if (prefix != ' ')
		(void)fprintf((*where).fp, "%c_", prefix), Putl((*where), 0);
	write_name(&(*where), &(*name));
	if (!(Member((unsigned)(omode), cmode.S)))
		(void)fprintf((*where).fp, " : rpc_integer"), Putl((*where), 0);
}

 boolean
contains(pt, typeset)
	ptr_defined_type	pt;
	set_of_token	typeset;
{
	register boolean	R101;
	ptr_named_type	scan;

	{
		register struct S75 *W143 = &(*pt);

		R101 = (boolean)(Member((unsigned)(W143->typ_basic_type), typeset.S));
		switch ((int)(W143->typ_basic_type)) {
		  case chartok:  case bytetok:  case shortok:  case integertok:
		  case real32tok:  case real48tok:  case real64tok:  case real128tok:
		  case longtok:  case substring:  case sequence:  case stringtok:
			break ;
		  case accesstok:  case arraytok:
			if (contains(W143->typ_subtype, typeset))
				R101 = true;
			break ;
		  case recordtok:
			scan = W143->U.V5.typ_fields;
			while (scan != (struct S76 *)NIL)
				{
					register struct S76 *W144 = &(*scan);

					if (contains(W144->nty_type, typeset))
						R101 = true;
					scan = W144->nty_next;
				}
			break ;
		  default:
			Caseerror(Line);
		}
	}
	return R101;
}

 void
decl_ext_marshal()
{
	ptr_named_type	pnt;
	register boolean	topack;

	pnt = typeptr;
	while (pnt != (struct S76 *)NIL) {
		if (pnt->nty_type->typ_external)
			{
				boolean	B145 = false,
					B146 = true;

				if ((int)(B145) <= (int)(B146))
					for (topack = B145; ; topack = (boolean)((int)(topack)+1)) {
						if (Member((unsigned)(omode), cmode.S)) {
							(void)fprintf(op_file.fp, "extern %.3s_", upkpck.A[(int)(topack)].A), Putl(op_file, 0);
							write_name(&op_file, &pnt->nty_name);
							(void)fprintf(op_file.fp, "();\n"), Putl(op_file, 1);
						} else {
							(void)fprintf(op_file.fp, "procedure %.3s_", upkpck.A[(int)(topack)].A), Putl(op_file, 0);
							write_name(&op_file, &pnt->nty_name);
							(void)fprintf(op_file.fp, "(var rpc_p_buf: rpc_message_pointer;\n"), Putl(op_file, 1);
							(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
							if (!topack)
								(void)fprintf(op_file.fp, "var "), Putl(op_file, 0);
							(void)fprintf(op_file.fp, "param: "), Putl(op_file, 0);
							write_name(&op_file, &pnt->nty_name);
							if ((Member((unsigned)(omode), Conset[62])))
								(void)fprintf(op_file.fp, "); EXTERNAL; \n"), Putl(op_file, 1);
							else
								(void)fprintf(op_file.fp, "); EXTERN; \n"), Putl(op_file, 1);
						}
						if (topack == B146) break;
					}
			}
		pnt = pnt->nty_next;
	}
}

 void
gen_allocate(where, expr, pt, level, do_alloc, typeset)
	text	*where;
	expression	expr;
	ptr_defined_type	pt;
	integer	level;
	boolean	do_alloc;
	set_of_token	typeset;
{
	ptr_named_type	scan;
	expression	exp2;
	char	ch;

	ch = (unsigned)('a') + level - 1;
	{
		register struct S75 *W147 = &(*pt);

		switch ((int)(W147->typ_basic_type)) {
		  case chartok:  case bytetok:  case shortok:  case integertok:
		  case real32tok:  case real48tok:  case real64tok:  case real128tok:
		  case longtok:  case substring:
			break ;
		  case accesstok:
			if (Member((unsigned)(W147->typ_basic_type), typeset.S)) {
				if (do_alloc)
					codegen_error(*((error_string *)STRALIGN("Internal:  Call GEN_ALLOCATE to allocate pointer")));
				exp2 = expr;
				if (Member((unsigned)(omode), cmode.S)) {
					(void)fprintf((*where).fp, "%*cif (", leftin(level), ' '), Putl((*where), 0);
					write_exp(&(*where), &expr);
					(void)fprintf((*where).fp, ") {"), Putl((*where), 0);
					format(&exp2, *((template_type *)STRALIGN("(*$)      ")));
					gen_allocate(&(*where), exp2, W147->typ_subtype, level + 1, do_alloc, typeset);
					(void)fprintf((*where).fp, "%*cfree(", leftin(level + 1), ' '), Putl((*where), 0);
					write_exp(&(*where), &expr);
					(void)fprintf((*where).fp, ");\n"), Putl((*where), 1);
					(void)fprintf((*where).fp, "%*c} /* end if */\n", leftin(level), ' '), Putl((*where), 1);
				} else {
					(void)fprintf((*where).fp, "%*cif ", leftin(level), ' '), Putl((*where), 0);
					write_exp(&(*where), &expr);
					(void)fprintf((*where).fp, " <> NIL then begin\n"), Putl((*where), 1);
					format(&exp2, *((template_type *)STRALIGN("$^        ")));
					gen_allocate(&(*where), exp2, W147->typ_subtype, level + 1, do_alloc, typeset);
					(void)fprintf((*where).fp, "%*cdispose(", leftin(level + 1), ' '), Putl((*where), 0);
					write_exp(&(*where), &expr);
					(void)fprintf((*where).fp, "%*c);\n", leftin(level + 1), ' '), Putl((*where), 1);
					(void)fprintf((*where).fp, "%*cend {if};\n", leftin(level), ' '), Putl((*where), 1);
				}
			}
			break ;
		  case stringtok:
			if ((omode == vaxvms) && (Member((unsigned)(stringtok), typeset.S))) {
				if (do_alloc) {
					(void)fprintf((*where).fp, "   with "), Putl((*where), 0);
					write_exp(&(*where), &expr);
					(void)fprintf((*where).fp, " do begin new(StrAdr); strlen :=%1d; { Init. string descriptor }\n", W147->U.V4.typ_high), Putl((*where), 1);
					(void)fprintf((*where).fp, "     DType := 0; Cont := 0; end;\n"), Putl((*where), 1);
				} else {
					(void)fprintf((*where).fp, "%*cdispose(", leftin(level), ' '), Putl((*where), 0);
					write_exp(&(*where), &expr);
					(void)fprintf((*where).fp, ".StrAdr);\n"), Putl((*where), 1);
				}
			}
			break ;
		  case arraytok:
			if (contains(W147->typ_subtype, typeset)) {
				exp2 = expr;
				append_index(&exp2, level);
				(void)fprintf((*where).fp, "%*c", leftin(level), ' '), Putl((*where), 0);
				if (!(Member((unsigned)(omode), cmode.S))) {
					(void)fprintf((*where).fp, "FOR rpc_%c := %1d TO %1d DO BEGIN\n", ch, W147->U.V4.typ_low, W147->U.V4.typ_high), Putl((*where), 1);
				} else {
					(void)fprintf((*where).fp, "for (rpc_%c = 0; rpc_%c<%1d; rpc_%c++) {", ch, ch, W147->U.V4.typ_high - W147->U.V4.typ_low + 1, ch), Putl((*where), 0);
				}
				gen_allocate(&(*where), exp2, W147->typ_subtype, level + 1, do_alloc, typeset);
				if (Member((unsigned)(omode), cmode.S))
					(void)fprintf((*where).fp, "%*c      }\n", leftin(level), ' '), Putl((*where), 1);
				else
					(void)fprintf((*where).fp, "%*cEND {FOR};\n", leftin(level), ' '), Putl((*where), 1);
			}
			break ;
		  case recordtok:
			scan = W147->U.V5.typ_fields;
			while (scan != (struct S76 *)NIL)
				{
					register struct S76 *W148 = &(*scan);

					exp2 = expr;
					append_1(&exp2, '.');
					append_name(&exp2, W148->nty_name);
					gen_allocate(&(*where), exp2, W148->nty_type, level, do_alloc, typeset);
					scan = W148->nty_next;
				}
			break ;
		  default:
			Caseerror(Line);
		}
	}
}

 void
dopack_simple(where, what, topack)
	text	*where;
	type_token	what;
	boolean	topack;
{
	(void)fprintf((*where).fp, "%.3s_", upkpck.A[(int)(topack)].A), Putl((*where), 0);
	switch ((int)(what)) {
	  case chartok:
		(void)fprintf((*where).fp, "char("), Putl((*where), 0);
		break ;
	  case bytetok:
		(void)fprintf((*where).fp, "byte("), Putl((*where), 0);
		break ;
	  case shortok:
		(void)fprintf((*where).fp, "short("), Putl((*where), 0);
		break ;
	  case integertok:
		(void)fprintf((*where).fp, "integer("), Putl((*where), 0);
		break ;
	  case real32tok:
		(void)fprintf((*where).fp, "real32("), Putl((*where), 0);
		break ;
	  case real48tok:
		(void)fprintf((*where).fp, "real48("), Putl((*where), 0);
		break ;
	  case real64tok:
		(void)fprintf((*where).fp, "real64("), Putl((*where), 0);
		break ;
	  case real128tok:
		(void)fprintf((*where).fp, "real128("), Putl((*where), 0);
		break ;
	  case longtok:
		(void)fprintf((*where).fp, "long("), Putl((*where), 0);
		break ;
	  default:
		Caseerror(Line);
	}
	(void)fprintf((*where).fp, "rpc_p_buf, "), Putl((*where), 0);
}

 void
gen_align(where, power)
	text	*where;
	integer	power;
{
	if (power != 1)
		codegen_error(*((error_string *)STRALIGN("Internal error: Gen_align on non-word boundary! ")));
	if ((boolean)((size_so_far) & 1))
		size_so_far = size_so_far + 1;
	if (!(Member((unsigned)(omode), cmode.S))) {
		(void)fprintf((*where).fp, "    IF ODD(m_index) THEN m_index:=m_index+1;\n"), Putl((*where), 1);
	} else {
		(void)fprintf((*where).fp, "    if (rpc_p_buf->m_index%%2) rpc_p_buf->m_index++;\n"), Putl((*where), 1);
	}
}

void gen_pack_type();

 void
gen_pack_string(where, expr, pt, level, topack)
	text	*where;
	expression	expr;
	ptr_defined_type	pt;
	integer	level;
	boolean	topack;
{
	char	index_a, index_b;
	expression	a_expr, i_expr, l_expr;

	index_a = (unsigned)('a') + level - 1;
	index_b = (unsigned)('a') + level;
	{
		register struct S75 *W149 = &(*pt);

		if (Member((unsigned)(omode), cmode.S)) {
			a_expr = expr;
			append_index(&a_expr, level);
			format(&l_expr, *((template_type *)STRALIGN("rpc_      ")));
			append_1(&l_expr, index_b);
			if (topack) {
				(void)fprintf((*where).fp, "%*cfor (rpc_%c = 0; rpc_%c <= %1d; rpc_%c++)\n", leftin(level), ' ', index_b, index_b, W149->U.V4.typ_high, index_b), Putl((*where), 1);
				(void)fprintf((*where).fp, "%*cif (", leftin(level), ' '), Putl((*where), 0);
				write_exp(&(*where), &expr);
				(void)fprintf((*where).fp, "[rpc_%c] == '\\0') break;\n", index_b), Putl((*where), 1);
			}
			gen_pack_type(&(*where), l_expr, simple_descriptor.A[(int)(integertok)], level, false, topack, (*G129_check_subtypes));
			(void)fprintf((*where).fp, "%*cfor (rpc_%c = 0; rpc_%c < rpc_%c; rpc_%c++) {\n", leftin(level), ' ', index_a, index_a, index_b, index_a), Putl((*where), 1);
			gen_pack_type(&(*where), a_expr, simple_descriptor.A[(int)(chartok)], level, false, topack, (*G129_check_subtypes));
			(void)fprintf((*where).fp, "%*c}\n", leftin(level), ' '), Putl((*where), 1);
			if (!topack) {
				(void)fprintf((*where).fp, "%*c", leftin(level), ' '), Putl((*where), 0);
				write_exp(&(*where), &expr);
				(void)fprintf((*where).fp, "[rpc_%c] = '\\0';\n", index_b), Putl((*where), 1);
			}
			size_so_far = (*G127_original_size) + W149->typ_max_size;
		} else {
			if (omode == vaxvms) {
				(void)fprintf((*where).fp, "%*c%.3s", leftin(level), ' ', upkpck.A[(int)(topack)].A), Putl((*where), 0);
				if ((!client && !topack))
					(void)fprintf((*where).fp, "_Vstring_for(rpc_p_buf, "), Putl((*where), 0);
				else
					(void)fprintf((*where).fp, "_string_for(rpc_p_buf, "), Putl((*where), 0);
				write_exp(&(*where), &expr);
				(void)fprintf((*where).fp, "::rpc_string_descriptor"), Putl((*where), 0);
				if ((!client && !topack))
					(void)fprintf((*where).fp, ", %1d", W149->U.V4.typ_high), Putl((*where), 0);
				(void)fprintf((*where).fp, ");\n"), Putl((*where), 1);
			} else {
				l_expr = expr;
				i_expr = expr;
				a_expr = expr;
				if (Member((unsigned)(omode), Conset[63])) {
					format(&l_expr, *((template_type *)STRALIGN("$[0]      ")));
					format(&i_expr, *((template_type *)STRALIGN("ord($[0]) ")));
				} else
					if (omode == vaxpas) {
						format(&l_expr, *((template_type *)STRALIGN("$.length  ")));
						i_expr = l_expr;
					} else {
						format(&l_expr, *((template_type *)STRALIGN("l_$       ")));
						format(&a_expr, *((template_type *)STRALIGN("a_$       ")));
						i_expr = l_expr;
						if (level != 1)
							codegen_error(*((error_string *)STRALIGN("String in composite type illegal for this target")));
					}
				append_index(&a_expr, level);
				(void)fprintf((*where).fp, "    "), Putl((*where), 0);
				if (Member((unsigned)(omode), Conset[64]))
					if (topack) {
						gen_pack_type(&(*where), i_expr, simple_descriptor.A[(int)(integertok)], level + 2, false, topack, (*G129_check_subtypes));
					} else {
						(void)fprintf((*where).fp, "%*c", leftin(level), ' '), Putl((*where), 0);
						write_exp(&(*where), &l_expr);
						(void)fprintf((*where).fp, " := rpc_ch[m_index + 1];\n"), Putl((*where), 1);
						(void)fprintf((*where).fp, "%*c", leftin(level), ' '), Putl((*where), 0);
						(void)fprintf((*where).fp, "m_index := (m_index + 2);"), Putl((*where), 0);
					}
				else {
					if ((omode == vaxpas))
						gen_pack_type(&(*where), l_expr, simple_descriptor.A[(int)(shortok)], level + 2, false, topack, (*G129_check_subtypes));
					else
						gen_pack_type(&(*where), l_expr, simple_descriptor.A[(int)(integertok)], level + 2, false, topack, (*G129_check_subtypes));
				}
				(void)fprintf((*where).fp, "%*cFOR rpc_%c := 1 TO ", leftin(level), ' ', index_a), Putl((*where), 0);
				write_exp(&(*where), &i_expr);
				(void)fprintf((*where).fp, " DO BEGIN\n"), Putl((*where), 1);
				gen_pack_type(&(*where), a_expr, simple_descriptor.A[(int)(chartok)], level + 2, false, topack, (*G129_check_subtypes));
				(void)fprintf((*where).fp, "%*cEND {for \n", leftin(level), ' '), Putl((*where), 1);
				write_exp(&(*where), &i_expr);
				(void)fprintf((*where).fp, "};\n"), Putl((*where), 1);
			}
			size_so_far = (*G127_original_size) + W149->typ_max_size;
		}
	}
}

 void
check_buffer_overflow(allowance)
	integer	allowance;
{
	if ((*G125_check_size) && ((size_so_far + allowance) > non_fragmentation_limit))
		if ((allowance <= fragmentation_threshold)) {
			fragmentation_used = true;
			if (Member((unsigned)(omode), cmode.S)) {
				(void)fprintf((*G119_where).fp, "%*cif (rpc_p_buf->m_index > RPC_BUFFER_SIZE - %1d) (void)rpc_", leftin((*G121_level)) + 4, ' ', allowance), Putl((*G119_where), 0);
				if ((*G123_topack))
					(void)fprintf((*G119_where).fp, "put(&rpc_p_buf);\n"), Putl((*G119_where), 1);
				else
					(void)fprintf((*G119_where).fp, "get(&rpc_p_buf);\n"), Putl((*G119_where), 1);
			} else {
				(void)fprintf((*G119_where).fp, "%*cif (rpc_p_buf^.m_index > RPC_BUFFER_SIZE - %1d) then rpc_", leftin((*G121_level)) + 4, ' ', allowance), Putl((*G119_where), 0);
				if ((*G123_topack))
					(void)fprintf((*G119_where).fp, "put(rpc_p_buf);\n"), Putl((*G119_where), 1);
				else
					(void)fprintf((*G119_where).fp, "get(rpc_p_buf);\n"), Putl((*G119_where), 1);
			}
		}
}

 void
gen_pack_type(where, expr, typ, level, deref, topack, check_size)
	text	*where;
	expression	expr;
	ptr_defined_type	typ;
	integer	level;
	boolean	deref;
	boolean	topack;
	boolean	check_size;
{
	char	ch;
	ptr_named_type	scan;
	expression	exp2;
	expression	l_expr, s_expr;
	register integer	i;
	integer	original_size;
	boolean	check_subtypes;
	text	*F120;
	integer	*F122;
	boolean	*F124;
	boolean	*F126;
	integer	*F128;
	boolean	*F130;

	F130 = G129_check_subtypes;
	G129_check_subtypes = &check_subtypes;
	F128 = G127_original_size;
	G127_original_size = &original_size;
	F126 = G125_check_size;
	G125_check_size = &check_size;
	F124 = G123_topack;
	G123_topack = &topack;
	F122 = G121_level;
	G121_level = &level;
	F120 = G119_where;
	G119_where = &(*where);
	(*G127_original_size) = size_so_far;
	ch = (unsigned)('a') + (*G121_level) - 1;
	l_expr = expr;
	prepend_1(&l_expr, '_');
	s_expr = l_expr;
	prepend_1(&l_expr, 'l');
	prepend_1(&s_expr, 's');
	{
		register struct S75 *W150 = &(*typ);

		if (W150->typ_external) {
			(void)fprintf((*G119_where).fp, "%*c%.3s_", leftin((*G121_level)), ' ', upkpck.A[(int)((*G123_topack))].A), Putl((*G119_where), 0);
			write_name(&op_file, &W150->typ_name->nty_name);
			(void)fprintf((*G119_where).fp, "(rpc_p_buf,"), Putl((*G119_where), 0);
			if ((Member((unsigned)(omode), cmode.S)) && !(*G123_topack))
				Putchr('&', (*G119_where));
			write_exp(&(*G119_where), &expr);
			(void)fprintf((*G119_where).fp, ");\n"), Putl((*G119_where), 1);
		} else {
			(*G129_check_subtypes) = (boolean)((*G125_check_size) && (size_so_far + W150->typ_max_size > non_fragmentation_limit) && (W150->typ_max_size > fragmentation_threshold));
			check_buffer_overflow(W150->typ_max_size);
			switch ((int)(W150->typ_basic_type)) {
			  case chartok:
				if ((Member((unsigned)(omode), cmode.S)) || (*G123_topack) || (expr.str.A[expr.len - 1] != ']')) {
					(void)fprintf((*G119_where).fp, "%*c%.3s_char(rpc_p_buf, ", leftin((*G121_level)), ' ', upkpck.A[(int)((*G123_topack))].A), Putl((*G119_where), 0);
					if (((*G121_level) == 1) && deref && (Member((unsigned)(omode), cmode.S)))
						Putchr('*', (*G119_where));
					write_exp(&(*G119_where), &expr);
					(void)fprintf((*G119_where).fp, ");\n"), Putl((*G119_where), 1);
				} else {
					(void)fprintf((*G119_where).fp, "%*cBEGIN\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
					(void)fprintf((*G119_where).fp, "%*c", leftin((*G121_level)) + 4, ' '), Putl((*G119_where), 0);
					write_exp(&(*G119_where), &expr);
					(void)fprintf((*G119_where).fp, ":=rpc_ch[m_index];\n"), Putl((*G119_where), 1);
					(void)fprintf((*G119_where).fp, "%*cm_index := m_index+1;\n", leftin((*G121_level)) + 4, ' '), Putl((*G119_where), 1);
					(void)fprintf((*G119_where).fp, "%*cEND;\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
				}
				size_so_far = size_so_far + 1;
				break ;
			  case bytetok:  case shortok:  case integertok:  case real32tok:
			  case real48tok:  case real64tok:  case real128tok:  case longtok:
				(void)fprintf((*G119_where).fp, "%*c%.3s", leftin((*G121_level)), ' ', upkpck.A[(int)((*G123_topack))].A), Putl((*G119_where), 0);
				{
					register struct S102 *W151 = &W150->typ_name->nty_name;

					{
						integer	B152 = 4,
							B153 = W151->len;

						if (B152 <= B153)
							for (i = B152; ; i++) {
								Putchr(W151->str.A[i - 1], (*G119_where));
								if (i == B153) break;
							}
					}
				}
				(void)fprintf((*G119_where).fp, "(rpc_p_buf, "), Putl((*G119_where), 0);
				if (((*G121_level) == 1) && deref && (Member((unsigned)(omode), cmode.S)))
					Putchr('*', (*G119_where));
				write_exp(&(*G119_where), &expr);
				(void)fprintf((*G119_where).fp, ");\n"), Putl((*G119_where), 1);
				switch ((int)(W150->typ_basic_type)) {
				  case bytetok:
					size_so_far = size_so_far + 1;
					break ;
				  case shortok:  case integertok:
					size_so_far = size_so_far + 2;
					break ;
				  case real32tok:  case longtok:
					size_so_far = size_so_far + 4;
					break ;
				  case real48tok:
					size_so_far = size_so_far + 6;
					break ;
				  case real64tok:
					size_so_far = size_so_far + 8;
					break ;
				  case real128tok:
					size_so_far = size_so_far + 16;
					break ;
				  default:
					Caseerror(Line);
				}
				break ;
			  case arraytok:
				exp2 = expr;
				append_index(&exp2, (*G121_level));
				(void)fprintf((*G119_where).fp, "%*c", leftin((*G121_level)), ' '), Putl((*G119_where), 0);
				if (!(Member((unsigned)(omode), cmode.S))) {
					(void)fprintf((*G119_where).fp, "FOR rpc_%c := %1d TO %1d DO BEGIN\n", ch, W150->U.V4.typ_low, W150->U.V4.typ_high), Putl((*G119_where), 1);
				} else {
					(void)fprintf((*G119_where).fp, "for (rpc_%c = 0; rpc_%c<%1d; rpc_%c++) {\n", ch, ch, W150->U.V4.typ_high - W150->U.V4.typ_low + 1, ch), Putl((*G119_where), 1);
				}
				size_so_far = (*G127_original_size) + W150->typ_max_size;
				gen_pack_type(&(*G119_where), exp2, W150->typ_subtype, (*G121_level) + 1, false, (*G123_topack), (*G129_check_subtypes));
				size_so_far = (*G127_original_size) + W150->typ_max_size;
				if (Member((unsigned)(omode), cmode.S))
					(void)fprintf((*G119_where).fp, "%*c}\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
				else
					(void)fprintf((*G119_where).fp, "%*cEND {FOR};\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
				break ;
			  case recordtok:
				scan = W150->U.V5.typ_fields;
				while (scan != (struct S76 *)NIL)
					{
						register struct S76 *W154 = &(*scan);

						exp2 = expr;
						if (((*G121_level) == 1) && deref && (Member((unsigned)(omode), cmode.S)))
							format(&exp2, *((template_type *)STRALIGN("$->       ")));
						else
							format(&exp2, *((template_type *)STRALIGN("$.        ")));
						append_name(&exp2, W154->nty_name);
						gen_pack_type(&(*G119_where), exp2, W154->nty_type, (*G121_level), false, (*G123_topack), (*G129_check_subtypes));
						scan = W154->nty_next;
					}
				break ;
			  case accesstok:
				if ((*G129_check_subtypes))
					check_buffer_overflow(1);
				size_so_far = size_so_far + 1;
				if (Member((unsigned)(omode), cmode.S)) {
					exp2 = expr;
					format(&exp2, *((template_type *)STRALIGN("*($)      ")));
					if (!(*G123_topack)) {
						(void)fprintf((*G119_where).fp, "%*c", leftin((*G121_level)), ' '), Putl((*G119_where), 0);
						(void)fprintf((*G119_where).fp, "if (next_byte(rpc_p_buf)) {\n"), Putl((*G119_where), 1);
						(void)fprintf((*G119_where).fp, "%*c", leftin((*G121_level) + 1), ' '), Putl((*G119_where), 0);
						write_exp(&(*G119_where), &expr);
						if (W150->typ_subtype->typ_name == (struct S76 *)NIL)
							codegen_error(*((error_string *)STRALIGN("Pointer to unnamed type - cannot allocate space!")));
						(void)fprintf((*G119_where).fp, " = ("), Putl((*G119_where), 0);
						write_name(&(*G119_where), &W150->typ_subtype->typ_name->nty_name);
						(void)fprintf((*G119_where).fp, "*) malloc(sizeof("), Putl((*G119_where), 0);
						write_name(&(*G119_where), &W150->typ_subtype->typ_name->nty_name);
						(void)fprintf((*G119_where).fp, "));\n"), Putl((*G119_where), 1);
					} else {
						(void)fprintf((*G119_where).fp, "%*cif (", leftin((*G121_level)), ' '), Putl((*G119_where), 0);
						write_exp(&(*G119_where), &expr);
						(void)fprintf((*G119_where).fp, "==NULL) pck_byte(0);\n"), Putl((*G119_where), 1);
						(void)fprintf((*G119_where).fp, "%*celse {\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
						(void)fprintf((*G119_where).fp, "%*cpck_byte(1);\n", leftin((*G121_level) + 1), ' '), Putl((*G119_where), 1);
					}
					gen_pack_type(&(*G119_where), exp2, W150->typ_subtype, (*G121_level), false, (*G123_topack), (*G129_check_subtypes));
					(void)fprintf((*G119_where).fp, "%*c} /* end if */\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
				} else {
					exp2 = expr;
					append_1(&exp2, '^');
					if (!(*G123_topack)) {
						(void)fprintf((*G119_where).fp, "m_index:=m_index+1;\n"), Putl((*G119_where), 1);
						(void)fprintf((*G119_where).fp, "%*cif b[m_index-1]<>0 then begin\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
						(void)fprintf((*G119_where).fp, "%*cnew(", leftin((*G121_level) + 1), ' '), Putl((*G119_where), 0);
						write_exp(&(*G119_where), &expr);
						(void)fprintf((*G119_where).fp, ");\n"), Putl((*G119_where), 1);
					} else {
						(void)fprintf((*G119_where).fp, "%*cif ", leftin((*G121_level)), ' '), Putl((*G119_where), 0);
						write_exp(&(*G119_where), &expr);
						(void)fprintf((*G119_where).fp, " = NIL then pck_byte(0)\n"), Putl((*G119_where), 1);
						(void)fprintf((*G119_where).fp, "%*celse begin\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
						(void)fprintf((*G119_where).fp, "%*cpck_byte(1);\n", leftin((*G121_level) + 1), ' '), Putl((*G119_where), 1);
					}
					gen_pack_type(&(*G119_where), exp2, W150->typ_subtype, (*G121_level), false, (*G123_topack), (*G129_check_subtypes));
					(void)fprintf((*G119_where).fp, "%*cend {if};\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
				}
				break ;
			  case sequence:
				if ((*G121_level) > 1)
					codegen_error(*((error_string *)STRALIGN("SEQUENCE type not allowed within composite type.")));
				gen_pack_type(&(*G119_where), l_expr, simple_descriptor.A[(int)(integertok)], (*G121_level), deref, (*G123_topack), (*G129_check_subtypes));
				exp2 = expr;
				format(&exp2, *((template_type *)STRALIGN("a_$       ")));
				append_index(&exp2, (*G121_level));
				(void)fprintf((*G119_where).fp, "%*c", leftin((*G121_level)), ' '), Putl((*G119_where), 0);
				if (!(Member((unsigned)(omode), cmode.S))) {
					(void)fprintf((*G119_where).fp, "FOR rpc_%c := 1 TO l_", ch), Putl((*G119_where), 0);
					write_exp(&(*G119_where), &expr);
					(void)fprintf((*G119_where).fp, " DO BEGIN\n"), Putl((*G119_where), 1);
				} else {
					(void)fprintf((*G119_where).fp, "for (rpc_%c = 0; rpc_%c< ", ch, ch), Putl((*G119_where), 0);
					if (deref && (Member((unsigned)(omode), cmode.S)))
						Putchr('*', (*G119_where));
					write_exp(&(*G119_where), &l_expr);
					(void)fprintf((*G119_where).fp, "; rpc_%c++) {\n", ch), Putl((*G119_where), 1);
				}
				size_so_far = (*G127_original_size) + W150->typ_max_size;
				gen_pack_type(&(*G119_where), exp2, W150->typ_subtype, (*G121_level) + 1, false, (*G123_topack), (*G129_check_subtypes));
				size_so_far = (*G127_original_size) + W150->typ_max_size;
				if (Member((unsigned)(omode), cmode.S))
					(void)fprintf((*G119_where).fp, "%*c      }\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
				else
					(void)fprintf((*G119_where).fp, "%*cEND {FOR};\n", leftin((*G121_level)), ' '), Putl((*G119_where), 1);
				break ;
			  case stringtok:
				gen_pack_string(&(*G119_where), expr, typ, (*G121_level), (*G123_topack));
				gen_align(&(*G119_where), 1);
				break ;
			  case substring:
				exp2 = s_expr;
				gen_pack_type(&(*G119_where), exp2, simple_descriptor.A[(int)(integertok)], (*G121_level), deref, (*G123_topack), (*G129_check_subtypes));
				gen_pack_type(&(*G119_where), l_expr, simple_descriptor.A[(int)(integertok)], (*G121_level), deref, (*G123_topack), (*G129_check_subtypes));
				if (Member((unsigned)(omode), cmode.S)) {
					(void)fprintf((*G119_where).fp, "    for (rpc_%c = ", ch), Putl((*G119_where), 0);
					if (deref)
						Putchr('*', (*G119_where));
					write_exp(&(*G119_where), &s_expr);
					(void)fprintf((*G119_where).fp, "-1; rpc_%c < ", ch), Putl((*G119_where), 0);
					if (deref)
						Putchr('*', (*G119_where));
					write_exp(&(*G119_where), &l_expr);
					(void)fprintf((*G119_where).fp, " + "), Putl((*G119_where), 0);
					if (deref)
						Putchr('*', (*G119_where));
					write_exp(&(*G119_where), &s_expr);
					(void)fprintf((*G119_where).fp, "-1; rpc_%c++) {\n", ch), Putl((*G119_where), 1);
				} else {
					(void)fprintf((*G119_where).fp, "    FOR rpc_%c := ", ch), Putl((*G119_where), 0);
					write_exp(&(*G119_where), &s_expr);
					(void)fprintf((*G119_where).fp, " TO "), Putl((*G119_where), 0);
					write_exp(&(*G119_where), &l_expr);
					Putchr('+', (*G119_where));
					write_exp(&(*G119_where), &s_expr);
					(void)fprintf((*G119_where).fp, " - 1 DO BEGIN\n"), Putl((*G119_where), 1);
				}
				exp2 = expr;
				prepend_1(&exp2, '_');
				prepend_1(&exp2, 'a');
				append_index(&exp2, (*G121_level));
				size_so_far = (*G127_original_size) + W150->typ_max_size;
				gen_pack_type(&(*G119_where), exp2, simple_descriptor.A[(int)(chartok)], (*G121_level) + 1, false, (*G123_topack), (*G129_check_subtypes));
				size_so_far = (*G127_original_size) + W150->typ_max_size;
				if (Member((unsigned)(omode), cmode.S)) {
					(void)fprintf((*G119_where).fp, "    }\n"), Putl((*G119_where), 1);
				} else {
					(void)fprintf((*G119_where).fp, "    END;\n"), Putl((*G119_where), 1);
				}
				gen_align(&(*G119_where), 1);
				break ;
			  default:
				Caseerror(Line);
			}
		}
	}
	G119_where = F120;
	G121_level = F122;
	G123_topack = F124;
	G125_check_size = F126;
	G127_original_size = F128;
	G129_check_subtypes = F130;
}

 void
gen_pack(where, head, dirn, topack)
	text	*where;
	ptr_idlist	head;
	attr_type	dirn;
	boolean	topack;
{
	expression	expr;

	do {
		{
			register struct S77 *W155 = &(*head);
			register struct S75 *W156 = &(*W155->id_type);

			expr.len = 0;
			append_name(&expr, head->name);
			if ((!client) && (!topack) && (omode == vaxvms))
				if (contains(W155->id_type, *((set_of_token *)SETALIGN(Conset[65]))))
					gen_allocate(&(*where), expr, W155->id_type, 1, true, *((set_of_token *)SETALIGN(Conset[66])));
			if ((W155->attr == inoutok) || (W155->attr == dirn)) {
				deref = (boolean)(client && !(runoptions.A[(int)(byvalue)].value && (W155->attr == intok)));
				gen_pack_type(&(*where), expr, W155->id_type, 1, deref, topack, true);
			}
			if ((!client) && topack)
				if (omode == vaxvms) {
					if (contains(W155->id_type, *((set_of_token *)SETALIGN(Conset[67]))))
						gen_allocate(&(*where), expr, W155->id_type, 1, false, *((set_of_token *)SETALIGN(Conset[68])));
				} else {
					if (contains(W155->id_type, *((set_of_token *)SETALIGN(Conset[69]))))
						gen_allocate(&(*where), expr, W155->id_type, 1, false, *((set_of_token *)SETALIGN(Conset[70])));
				}
			if (client && (W155->attr == inoutok) && topack)
				if (contains(W155->id_type, *((set_of_token *)SETALIGN(Conset[71]))))
					gen_allocate(&(*where), expr, W155->id_type, 1, false, *((set_of_token *)SETALIGN(Conset[72])));
		}
		head = head->next;
	} while (!(head == (struct S77 *)NIL));
}

void gen_header();

 void
gen_formals_c(head)
	ptr_idlist	head;
{
	integer	a;
	ptr_idlist	scan;

	a = 0;
	scan = head;
	Putchr('(', (*G131_where));
	while (scan != (struct S77 *)NIL) {
		if (Member((unsigned)(scan->id_type->typ_basic_type), Conset[73]))
			(void)fprintf((*G131_where).fp, "a_"), Putl((*G131_where), 0);
		write_name(&(*G131_where), &scan->name);
		if (scan->id_type->typ_basic_type == substring) {
			(void)fprintf((*G131_where).fp, ", s_"), Putl((*G131_where), 0);
			write_name(&(*G131_where), &scan->name);
			a = a + 1;
		}
		if (Member((unsigned)(scan->id_type->typ_basic_type), Conset[74])) {
			(void)fprintf((*G131_where).fp, ", l_"), Putl((*G131_where), 0);
			write_name(&(*G131_where), &scan->name);
			a = a + 1;
		}
		scan = scan->next;
		if (scan != (struct S77 *)NIL) {
			(void)fprintf((*G131_where).fp, ", "), Putl((*G131_where), 0);
			a = a + 1;
			if (a > 3) {
				a = 0;
				Putchr('\n', (*G131_where));
				(void)fprintf((*G131_where).fp, "        "), Putl((*G131_where), 0);
			}
		}
	}
	Putchr(')', (*G131_where)),Putchr('\n', (*G131_where));
}

 void
gen_params(head)
	ptr_idlist	head;
{
	integer	a;
	ptr_idlist	scan;
	char	ch;
	boolean	simple_ref;
	boolean	array_deref;

	scan = head;
	do {
		(void)fprintf((*G131_where).fp, "    "), Putl((*G131_where), 0);
		array_deref = (boolean)((client || (*G133_doing_externals)) && !(Member((unsigned)(omode), cmode.S)));
		simple_ref = (boolean)((client || (*G133_doing_externals)) && !((runoptions.A[(int)(byvalue)].value) && (scan->attr == intok)));
		{
			register struct S75 *W157 = &(*scan->id_type);

			switch ((int)(W157->typ_basic_type)) {
			  case chartok:  case bytetok:  case shortok:  case integertok:
			  case real32tok:  case real48tok:  case real64tok:  case real128tok:
			  case longtok:  case recordtok:  case accesstok:
				write_declaration(&(*G131_where), ' ', scan, simple_ref);
				break ;
			  case arraytok:
				write_declaration(&(*G131_where), ' ', scan, array_deref);
				break ;
			  case stringtok:
				if (!(Member((unsigned)(omode), (Union(cmode.S, Conset[75]))))) {
					write_declaration(&(*G131_where), 'a', scan, array_deref);
					Putchr(';', (*G131_where)),Putchr('\n', (*G131_where));
					write_integer(&(*G131_where), 'l', &scan->name, simple_ref);
				} else {
					write_declaration(&(*G131_where), ' ', scan, array_deref);
				}
				Claimset();
				break ;
			  case sequence:
				write_declaration(&(*G131_where), 'a', scan, array_deref);
				Putchr(';', (*G131_where)),Putchr('\n', (*G131_where));
				write_integer(&(*G131_where), 'l', &scan->name, simple_ref);
				break ;
			  case substring:
				write_declaration(&(*G131_where), 'a', scan, array_deref);
				Putchr(';', (*G131_where)),Putchr('\n', (*G131_where));
				write_integer(&(*G131_where), 's', &scan->name, simple_ref);
				Putchr(';', (*G131_where)),Putchr('\n', (*G131_where));
				write_integer(&(*G131_where), 'l', &scan->name, simple_ref);
				break ;
			  default:
				Caseerror(Line);
			}
		}
		scan = scan->next;
		if (scan != (struct S77 *)NIL)
			Putchr(';', (*G131_where)),Putchr('\n', (*G131_where));
	} while (!(scan == (struct S77 *)NIL));
}

 void
gen_header(where, ptr, doing_externals, parameters_wanted)
	text	*where;
	ptr_block_table	ptr;
	boolean	doing_externals, parameters_wanted;
{
	text	*F132;
	boolean	*F134;

	F134 = G133_doing_externals;
	G133_doing_externals = &doing_externals;
	F132 = G131_where;
	G131_where = &(*where);
	{
		register struct S78 *W158 = &(*ptr);

		if (Member((unsigned)(omode), cmode.S)) {
			if (client) {
				if (W158->b_type == functok) {
					writok(&(*G131_where), W158->C33_return);
					Putchr(' ', (*G131_where));
				}
				write_name(&(*G131_where), &W158->name);
				gen_formals_c(W158->list);
			} else {
				if (!(*G133_doing_externals))
					(void)fprintf((*G131_where).fp, "r_"), Putl((*G131_where), 0);
				write_name(&(*G131_where), &W158->name);
				(void)fprintf((*G131_where).fp, "()"), Putl((*G131_where), 0);
				if ((*G133_doing_externals)) {
					Putchr(';', (*G131_where)),Putchr('\n', (*G131_where));
					(void)fprintf((*G131_where).fp, "/*  Parameters: "), Putl((*G131_where), 0);
					if (W158->list == (struct S77 *)NIL)
						(void)fprintf((*G131_where).fp, "none"), Putl((*G131_where), 0);
				}
				Putchr('\n', (*G131_where));
				if (!(*G133_doing_externals))
					Putchr('{', (*G131_where)),Putchr('\n', (*G131_where));
			}
		} else {
			if ((client || (*G133_doing_externals))) {
				writok(&(*G131_where), W158->b_type);
				write_name(&(*G131_where), &W158->name);
			} else {
				writok(&(*G131_where), proctok);
				if (!(*G133_doing_externals))
					(void)fprintf((*G131_where).fp, "r_"), Putl((*G131_where), 0);
				write_name(&(*G131_where), &W158->name);
				if (!(*G133_doing_externals))
					Putchr(';', (*G131_where)),Putchr('\n', (*G131_where));
			}
		}
		if (parameters_wanted)
			if ((W158->list != (struct S77 *)NIL)) {
				if (!(Member((unsigned)(omode), cmode.S)))
					if (client || (*G133_doing_externals))
						Putchr('(', (*G131_where)),Putchr('\n', (*G131_where));
					else
						(void)fprintf((*G131_where).fp, "VAR\n"), Putl((*G131_where), 1);
				gen_params(W158->list);
				if ((client || (*G133_doing_externals)) && !(Member((unsigned)(omode), cmode.S)))
					Putchr(')', (*G131_where));
			}
		if (!(Member((unsigned)(omode), cmode.S))) {
			if ((client || (*G133_doing_externals))) {
				if (parameters_wanted && (W158->b_type == functok)) {
					(void)fprintf((*G131_where).fp, ": "), Putl((*G131_where), 0);
					writok(&(*G131_where), W158->C33_return);
				}
			}
		}
		if (((client || (*G133_doing_externals)) && !(Member((unsigned)(omode), cmode.S))) || (W158->list != (struct S77 *)NIL))
			Putchr(';', (*G131_where)),Putchr('\n', (*G131_where));
	}
	G131_where = F132;
	G133_doing_externals = F134;
}

 void
generate_externals()
{
	ptr_block_table	scan;

	scan = blockptr;
	while (scan != (struct S78 *)NIL) {
		if (Member((unsigned)(omode), cmode.S)) {
			(void)fprintf(op_file.fp, "extern "), Putl(op_file, 0);
			if (scan->b_type == functok) {
				writok(&op_file, scan->C33_return);
				Putchr(' ', op_file);
			}
			gen_header(&op_file, scan, true, true);
			(void)fprintf(op_file.fp, "    */\n"), Putl(op_file, 1);
		} else {
			gen_header(&op_file, scan, true, true);
			if (omode == m6809)
				(void)fprintf(op_file.fp, "EXTERNAL;\n"), Putl(op_file, 1);
			else
				(void)fprintf(op_file.fp, "EXTERN;\n"), Putl(op_file, 1);
		}
		Putchr('\n', op_file);
		scan = scan->next;
	}
}

 void
gen_type_decl_c(where, expr, pt, level)
	text	*where;
	expression	expr;
	ptr_defined_type	pt;
	integer	level;
{
	ptr_named_type	scan;
	expression	exp2;

	{
		register struct S75 *W159 = &(*pt);

		switch ((int)(W159->typ_basic_type)) {
		  case chartok:  case bytetok:  case shortok:  case integertok:
		  case real32tok:  case real48tok:  case real64tok:  case real128tok:
		  case longtok:
			(void)fprintf((*where).fp, "%*c", leftin(level), ' '), Putl((*where), 0);
			write_name(&(*where), &simple_descriptor.A[(int)(W159->typ_basic_type)]->typ_name->nty_name);
			Putchr(' ', (*where));
			write_exp(&(*where), &expr);
			break ;
		  case substring:  case stringtok:
			(void)fprintf((*where).fp, "%*c", leftin(level), ' '), Putl((*where), 0);
			(void)fprintf((*where).fp, "rpc_char "), Putl((*where), 0);
			write_exp(&(*where), &expr);
			(void)fprintf((*where).fp, "[%1d]", (W159->U.V4.typ_high + 1)), Putl((*where), 0);
			break ;
		  case arraytok:
			exp2 = expr;
			append_1(&exp2, '[');
			append_decimal(&exp2, W159->U.V4.typ_high - W159->U.V4.typ_low + 1);
			append_1(&exp2, ']');
			gen_type_decl_c(&(*where), exp2, W159->typ_subtype, level);
			break ;
		  case sequence:
			exp2 = expr;
			append_1(&exp2, '[');
			append_decimal(&exp2, W159->U.V4.typ_high - W159->U.V4.typ_low + 1);
			append_1(&exp2, ']');
			gen_type_decl_c(&(*where), exp2, W159->typ_subtype, level);
			break ;
		  case accesstok:
			exp2 = expr;
			prepend_1(&exp2, '(');
			prepend_1(&exp2, '*');
			append_1(&exp2, ')');
			gen_type_decl_c(&(*where), exp2, W159->typ_subtype, level);
			break ;
		  case recordtok:
			(void)fprintf((*where).fp, "%*cstruct {\n", leftin(level), ' '), Putl((*where), 1);
			scan = W159->U.V5.typ_fields;
			while (scan != (struct S76 *)NIL) {
				exp2.len = 0;
				append_name(&exp2, scan->nty_name);
				gen_type_decl_c(&(*where), exp2, scan->nty_type, level + 1);
				Putchr(';', (*where)),Putchr('\n', (*where));
				scan = scan->nty_next;
			}
			(void)fprintf((*where).fp, "%*c} ", leftin(level), ' '), Putl((*where), 0);
			write_exp(&(*where), &expr);
			break ;
		  default:
			Caseerror(Line);
		}
	}
}

 void
gen_type_pas(where, pt, level)
	text	*where;
	ptr_defined_type	pt;
	integer	level;
{
	ptr_named_type	scan;
	expression	exp2;

	{
		register struct S75 *W160 = &(*pt);

		if ((level > 1) && (W160->typ_name != (struct S76 *)NIL)) {
			write_name(&(*where), &W160->typ_name->nty_name);
		} else
			switch ((int)(W160->typ_basic_type)) {
			  case chartok:  case bytetok:  case shortok:  case integertok:
			  case real32tok:  case real48tok:  case real64tok:  case real128tok:
			  case longtok:
				write_name(&(*where), &simple_descriptor.A[(int)(W160->typ_basic_type)]->typ_name->nty_name);
				break ;
			  case substring:  case stringtok:
				if ((omode == vaxvms) && (W160->typ_basic_type == stringtok)) {
					(void)fprintf((*where).fp, "RECORD strlen: rpc_short;\n"), Putl((*where), 1);
					(void)fprintf((*where).fp, "%*cDType, Cont: rpc_byte;\n", leftin(level) + 8, ' '), Putl((*where), 1);
					(void)fprintf((*where).fp, "%*cStrAdr: ^t_", leftin(level) + 8, ' '), Putl((*where), 0);
					write_name(&(*where), &W160->typ_name->nty_name);
					Putchr('\n', (*where));
					(void)fprintf((*where).fp, "%*cEND", leftin(level) + 4, ' '), Putl((*where), 0);
				} else
					if ((omode == vaxpas) && (W160->typ_basic_type == stringtok)) {
						(void)fprintf((*where).fp, "VARYING[%1d] OF CHAR", W160->U.V4.typ_high), Putl((*where), 0);
					} else
						if ((Member((unsigned)(omode), Conset[76])) && (W160->typ_basic_type == stringtok)) {
							(void)fprintf((*where).fp, "STRING[%1d]", W160->U.V4.typ_high), Putl((*where), 0);
						} else {
							(void)fprintf((*where).fp, "PACKED ARRAY [1..%1d] OF CHAR", W160->U.V4.typ_high), Putl((*where), 0);
						}
				break ;
			  case arraytok:
				(void)fprintf((*where).fp, "ARRAY [%1d..%1d] OF ", W160->U.V4.typ_low, W160->U.V4.typ_high), Putl((*where), 0);
				gen_type_pas(&(*where), W160->typ_subtype, level + 1);
				break ;
			  case sequence:
				(void)fprintf((*where).fp, "ARRAY [1..%1d] OF ", W160->U.V4.typ_high), Putl((*where), 0);
				gen_type_pas(&(*where), W160->typ_subtype, level + 1);
				break ;
			  case accesstok:
				Putchr('^', (*where));
				gen_type_pas(&(*where), W160->typ_subtype, level + 1);
				break ;
			  case recordtok:
				(void)fprintf((*where).fp, "RECORD\n"), Putl((*where), 1);
				scan = W160->U.V5.typ_fields;
				while (scan != (struct S76 *)NIL) {
					exp2.len = 0;
					(void)fprintf((*where).fp, "%*c", (leftin(level) + 4), ' '), Putl((*where), 0);
					write_name(&(*where), &scan->nty_name);
					(void)fprintf((*where).fp, ": "), Putl((*where), 0);
					gen_type_pas(&(*where), scan->nty_type, level + 1);
					Putchr(';', (*where)),Putchr('\n', (*where));
					scan = scan->nty_next;
				}
				(void)fprintf((*where).fp, "%*cEND {RECORD}", leftin(level), ' '), Putl((*where), 0);
				break ;
			  default:
				Caseerror(Line);
			}
	}
}

 void
generate_types(where)
	text	*where;
{
	ptr_named_type	scan;
	expression	expr;

	scan = typeptr;
	while (scan != (struct S76 *)NIL)
		{
			register struct S76 *W161 = &(*scan);

			if (omode == vaxvms)
				if ((W161->nty_type->typ_basic_type == stringtok)) {
					(void)fprintf((*where).fp, "t_"), Putl((*where), 0);
					write_name(&(*where), &W161->nty_name);
					(void)fprintf((*where).fp, " = "), Putl((*where), 0);
					(void)fprintf((*where).fp, "PACKED ARRAY [1..%1d] OF CHAR;\n", W161->nty_type->U.V4.typ_high), Putl((*where), 1);
				}
			expr.len = 0;
			append_name(&expr, W161->nty_name);
			if (Member((unsigned)(omode), cmode.S)) {
				(void)fprintf((*where).fp, "typedef "), Putl((*where), 0);
				gen_type_decl_c(&(*where), expr, W161->nty_type, 1);
			} else {
				write_name(&(*where), &W161->nty_name);
				(void)fprintf((*where).fp, " = "), Putl((*where), 0);
				gen_type_pas(&(*where), W161->nty_type, 1);
			}
			Putchr(';', (*where)),Putchr('\n', (*where));
			scan = W161->nty_next;
		}
	Putchr('\n', (*where));
}

 void
ext_generator(ext_mode, ext_name)
	output_mode	ext_mode;
	astring	ext_name;
{
	if (!(Member((unsigned)(omode), Conset[77])))
		if (file_open(&op_file, &ext_name, rewriting)) {
			client = false;
			omode = ext_mode;
			Putchr('\n', op_file);
			if (Member((unsigned)(omode), cmode.S))
				(void)fprintf(op_file.fp, "/*  "), Putl(op_file, 0);
			else
				(void)fprintf(op_file.fp, "{*  "), Putl(op_file, 0);
			(void)fprintf(op_file.fp, "Stub Version Number: "), Putl(op_file, 0);
			if (version_num == 0)
				(void)fprintf(op_file.fp, "zero (no check)"), Putl(op_file, 0);
			else
				(void)fprintf(op_file.fp, "%1d", version_num), Putl(op_file, 0);
			if (Member((unsigned)(omode), cmode.S))
				(void)fprintf(op_file.fp, "  */\n"), Putl(op_file, 1);
			else
				(void)fprintf(op_file.fp, "  *}\n"), Putl(op_file, 1);
			Putchr('\n', op_file);
			if ((runoptions.A[(int)(types)].value) && (typeptr != (struct S76 *)NIL)) {
				if (!(Member((unsigned)(omode), cmode.S)))
					(void)fprintf(op_file.fp, "TYPE\n"), Putl(op_file, 1);
				generate_types(&op_file);
			}
			generate_externals();
			if (!(file_close(&op_file)))
				error(cant_cls_ext);
		} else
			error(cant_opn_ext);
}

void gen_module();

 void
do_include(which)
	opt_name	which;
{
	register integer	i;

	(void)fprintf((*G135_where).fp, "*INCLUDE rpc"), Putl((*G135_where), 0);
	{
		integer	B162 = 1,
			B163 = 10;

		if (B162 <= B163)
			for (i = B162; ; i++) {
				if (which.A[i - 1] != ' ')
					Putchr(which.A[i - 1], (*G135_where));
				if (i == B163) break;
			}
	}
	Putchr('\n', (*G135_where));
}

 void
gen_module(where)
	text	*where;
{
	text	*F136;

	F136 = G135_where;
	G135_where = &(*where);
	Putchr('\n', (*G135_where));
	if (Member((unsigned)(omode), cmode.S)) {
		(void)fprintf((*G135_where).fp, "#include <rpcrts.h>\n"), Putl((*G135_where), 1);
		Putchr('\n', (*G135_where));
	} else {
		if (!(Member((unsigned)(omode), Conset[78]))) {
			(void)fprintf((*G135_where).fp, "MODULE "), Putl((*G135_where), 0);
			if (client)
				(void)fprintf((*G135_where).fp, "CLI"), Putl((*G135_where), 0);
			else
				(void)fprintf((*G135_where).fp, "SER"), Putl((*G135_where), 0);
			write_name(&(*G135_where), &unitname);
			Putchr(';', (*G135_where)),Putchr('\n', (*G135_where));
		}
		if ((Member((unsigned)(omode), Conset[79]))) {
			(void)fprintf((*G135_where).fp, "UNIT "), Putl((*G135_where), 0);
			if (client)
				(void)fprintf((*G135_where).fp, "CLI"), Putl((*G135_where), 0);
			else
				(void)fprintf((*G135_where).fp, "SER"), Putl((*G135_where), 0);
			write_name(&(*G135_where), &unitname);
			if ((omode == macturbo))
				(void)fprintf((*G135_where).fp, "(5)"), Putl((*G135_where), 0);
			Putchr(';', (*G135_where)),Putchr('\n', (*G135_where));
			(void)fprintf((*G135_where).fp, "INTERFACE\n"), Putl((*G135_where), 1);
			if ((omode == pcturbo)) {
				(void)fprintf((*G135_where).fp, "USES rpcpcpas,\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     rpcstub,\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     tsturbo,\n"), Putl((*G135_where), 1);
				if (external_marshalling)
					(void)fprintf((*G135_where).fp, "     extmarsh,\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     rpcrts"), Putl((*G135_where), 0);
			} else {
				(void)fprintf((*G135_where).fp, "{$U RPCMacPas}\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "{$U RPCStub}\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "{$U TSTurbo}\n"), Putl((*G135_where), 1);
				if (external_marshalling)
					(void)fprintf((*G135_where).fp, "{$U extmarsh}\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "{$U RPCRTS}\n"), Putl((*G135_where), 1);
				if (!client) {
					(void)fprintf((*G135_where).fp, "{--> It is assumed, by default, that the name of the unit library file <--}\n"), Putl((*G135_where), 1);
					(void)fprintf((*G135_where).fp, "{--> containing the server routines is the same as the package name.   <--}\n"), Putl((*G135_where), 1);
					(void)fprintf((*G135_where).fp, "{--> If the assumption is wrong, just replace the following line.      <--}\n"), Putl((*G135_where), 1);
					(void)fprintf((*G135_where).fp, "{$U "), Putl((*G135_where), 0);
					write_name(&(*G135_where), &unitname);
					Putchr('}', (*G135_where)),Putchr('\n', (*G135_where));
				}
				Putchr('\n', (*G135_where));
				(void)fprintf((*G135_where).fp, "USES MemTypes,\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     QuickDraw,\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     OSIntf,\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     ToolIntf,\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     RPCMacPas,\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     RPCStub,\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     TSTurbo,\n"), Putl((*G135_where), 1);
				if (external_marshalling)
					(void)fprintf((*G135_where).fp, "     extmarsh,\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     RPCRTS"), Putl((*G135_where), 0);
			}
			if (!client) {
				Putchr(',', (*G135_where)),Putchr('\n', (*G135_where));
				(void)fprintf((*G135_where).fp, "{--> It is assumed, by default, that the name of the unit containing   <--}\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "{--> the server routines is the same as the package name. If the       <--}\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "{--> assumption is wrong, just replace the following line.             <--}\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "     "), Putl((*G135_where), 0);
				write_name(&(*G135_where), &unitname);
			}
			Putchr(';', (*G135_where)),Putchr('\n', (*G135_where));
			Putchr('\n', (*G135_where));
			if ((!client) && (typeptr != (struct S76 *)NIL)) {
				(void)fprintf((*G135_where).fp, "{--> Being this a server stub, the TYPE declarations should not be     <--}\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "{--> included here (they belong to the unit containing the server      <--}\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "{--> routines). However you will find them below (commented out), in   <--}\n"), Putl((*G135_where), 1);
				(void)fprintf((*G135_where).fp, "{--> case you need them for reference.                                 <--}\n"), Putl((*G135_where), 1);
				Putchr('{', (*G135_where)),Putchr('\n', (*G135_where));
			}
			if ((typeptr != (struct S76 *)NIL))
				(void)fprintf((*G135_where).fp, "TYPE\n"), Putl((*G135_where), 1);
		} else {
			Putchr('\n', (*G135_where));
			(void)fprintf((*G135_where).fp, "CONST\n"), Putl((*G135_where), 1);
			do_include(*((opt_name *)STRALIGN("const.h   ")));
			Putchr('\n', (*G135_where));
			(void)fprintf((*G135_where).fp, "TYPE\n"), Putl((*G135_where), 1);
			do_include(*((opt_name *)STRALIGN("types.h   ")));
		}
	}
	generate_types(&(*G135_where));
	if ((!client) && (Member((unsigned)(omode), Conset[80])) && (typeptr != (struct S76 *)NIL))
		Putchr('}', (*G135_where)),Putchr('\n', (*G135_where));
	if (client) {
		if (Member((unsigned)(omode), cmode.S)) {
			(void)fprintf((*G135_where).fp, "rpc_handle h_"), Putl((*G135_where), 0);
			write_name(&(*G135_where), &unitname);
			Putchr(';', (*G135_where)),Putchr('\n', (*G135_where));
		} else {
			if ((omode == cerncross))
				(void)fprintf((*G135_where).fp, "EXPORT\n"), Putl((*G135_where), 1);
			else
				(void)fprintf((*G135_where).fp, "VAR\n"), Putl((*G135_where), 1);
			(void)fprintf((*G135_where).fp, "    h_"), Putl((*G135_where), 0);
			write_name(&(*G135_where), &unitname);
			if ((Member((unsigned)(omode), Conset[81])))
				(void)fprintf((*G135_where).fp, ": [global] integer;\n"), Putl((*G135_where), 1);
			else
				if ((omode == m6809))
					(void)fprintf((*G135_where).fp, ": integer external;\n"), Putl((*G135_where), 1);
				else
					if ((Member((unsigned)(omode), Conset[82])))
						(void)fprintf((*G135_where).fp, ": client_pointer;\n"), Putl((*G135_where), 1);
					else
						(void)fprintf((*G135_where).fp, ": integer;\n"), Putl((*G135_where), 1);
		}
	} else {
		if (Member((unsigned)(omode), cmode.S)) {
			(void)fprintf((*G135_where).fp, "program_index p_"), Putl((*G135_where), 0);
			write_name(&(*G135_where), &unitname);
			Putchr(';', (*G135_where)),Putchr('\n', (*G135_where));
		} else {
			if ((omode == cerncross))
				(void)fprintf((*G135_where).fp, "EXPORT\n"), Putl((*G135_where), 1);
			else
				(void)fprintf((*G135_where).fp, "VAR\n"), Putl((*G135_where), 1);
			(void)fprintf((*G135_where).fp, "    p_"), Putl((*G135_where), 0);
			write_name(&(*G135_where), &unitname);
			if ((Member((unsigned)(omode), Conset[83])))
				(void)fprintf((*G135_where).fp, ": [global] integer;\n"), Putl((*G135_where), 1);
			else
				if ((Member((unsigned)(omode), Conset[84])))
					(void)fprintf((*G135_where).fp, ": program_pointer;\n"), Putl((*G135_where), 1);
				else
					(void)fprintf((*G135_where).fp, ": program_index;\n"), Putl((*G135_where), 1);
		}
	}
	Putchr('\n', (*G135_where));
	if (!(Member((unsigned)(omode), Union(cmode.S, Conset[85])))) {
		do_include(*((opt_name *)STRALIGN("proc.h    ")));
		do_include(*((opt_name *)STRALIGN("stub.h    ")));
		Putchr('\n', (*G135_where));
	}
	Claimset();
	if (external_marshalling)
		if ((Member((unsigned)(omode), Union(cmode.S, Conset[86]))))
			decl_ext_marshal();
	Claimset();
	if ((!client) && (!(Member((unsigned)(omode), Conset[87]))))
		generate_externals();
	G135_where = F136;
}

void client_generator();

 void
gen_client_block_pas(ptr)
	ptr_block_table	ptr;
{
	register integer	a;
	expression	return_value;

	if (Member((unsigned)(omode), Conset[88]))
		(void)fprintf(op_file.fp, "[GLOBAL]\n"), Putl(op_file, 1);
	size_so_far = 0;
	gen_header(&op_file, ptr, false, (boolean)(!(omode == macturbo)));
	if (omode == m6809)
		(void)fprintf(op_file.fp, "    ENTRY;\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "VAR rpc_p_buf: rpc_message_pointer;\n"), Putl(op_file, 1);
	{
		integer	B164 = 1,
			B165 = ptr->blk_nesting;

		if (B164 <= B165)
			for (a = B164; ; a++) {
				(void)fprintf(op_file.fp, "    rpc_%c : rpc_integer;\n", (unsigned)('a') - 1 + a), Putl(op_file, 1);
				if (a == B165) break;
			}
	}
	if (ptr->b_type == functok) {
		(void)fprintf(op_file.fp, "    rpc_ret : "), Putl(op_file, 0);
		writok(&op_file, ptr->C33_return);
		Putchr(';', op_file),Putchr('\n', op_file);
	}
	(void)fprintf(op_file.fp, "BEGIN\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "  rpc_begin(rpc_p_buf, h_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, ", {vers=}%1d, {proc=}%1d);\n", version_num, (*G137_proc_number)), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "  WITH rpc_p_buf^ DO BEGIN\n"), Putl(op_file, 1);
	if (ptr->list != (struct S77 *)NIL)
		gen_pack(&op_file, ptr->list, intok, true);
	(void)fprintf(op_file.fp, "  END  {WITH};\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	if (ptr->blk_status_param != (struct S77 *)NIL) {
		write_name(&op_file, &ptr->blk_status_param->name);
		(void)fprintf(op_file.fp, " := "), Putl(op_file, 0);
	}
	if (ptr->blk_cast)
		(void)fprintf(op_file.fp, "rpc_cast"), Putl(op_file, 0);
	else
		(void)fprintf(op_file.fp, "rpc_call"), Putl(op_file, 0);
	if (ptr->blk_status_param != (struct S77 *)NIL)
		(void)fprintf(op_file.fp, "_status"), Putl(op_file, 0);
	(void)fprintf(op_file.fp, "(h_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, ", rpc_p_buf"), Putl(op_file, 0);
	if (!ptr->blk_cast)
		(void)fprintf(op_file.fp, ",%1d", ptr->blk_timeout), Putl(op_file, 0);
	(void)fprintf(op_file.fp, ");\n"), Putl(op_file, 1);
	if (ptr->blk_status_param != (struct S77 *)NIL) {
		(void)fprintf(op_file.fp, "  IF odd("), Putl(op_file, 0);
		write_name(&op_file, &ptr->blk_status_param->name);
		(void)fprintf(op_file.fp, ") THEN "), Putl(op_file, 0);
	}
	(void)fprintf(op_file.fp, "  WITH rpc_p_buf^ DO BEGIN\n"), Putl(op_file, 1);
	size_so_far = 0;
	if (ptr->blk_max_out > 0) {
		if (Member((unsigned)(omode), cmode.S))
			(void)fprintf(op_file.fp, "    rpc_p_buf->m_index ="), Putl(op_file, 0);
		else
			(void)fprintf(op_file.fp, "    m_index :="), Putl(op_file, 0);
		(void)fprintf(op_file.fp, " RETURN_HEADER_LENGTH;\n"), Putl(op_file, 1);
	}
	if (ptr->b_type == functok) {
		(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
		dopack_simple(&op_file, ptr->C33_return, false);
		(void)fprintf(op_file.fp, "rpc_ret);\n"), Putl(op_file, 1);
	}
	if (ptr->list != (struct S77 *)NIL)
		gen_pack(&op_file, ptr->list, outok, false);
	if (Member((unsigned)(omode), cmode.S)) {
		(void)fprintf(op_file.fp, "    c_dispose(rpc_p_buf);\n"), Putl(op_file, 1);
		if (ptr->b_type == functok)
			(void)fprintf(op_file.fp, "    return(rpc_ret);\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    }\n"), Putl(op_file, 1);
	} else {
		if (ptr->b_type == functok) {
			(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
			write_name(&op_file, &ptr->name);
			(void)fprintf(op_file.fp, " := rpc_ret;\n"), Putl(op_file, 1);
		}
		(void)fprintf(op_file.fp, "  END  {WITH};\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "  rpc_dispose(rpc_p_buf);\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "END;\n"), Putl(op_file, 1);
	}
	Putchr('\n', op_file);
}

 void
gen_client_block_c(ptr)
	ptr_block_table	ptr;
{
	register integer	a;
	expression	return_value;

	size_so_far = 0;
	gen_header(&op_file, ptr, false, true);
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "{   rpc_message *rpc_p_buf;\n"), Putl(op_file, 1);
	{
		integer	B166 = 1,
			B167 = ptr->blk_nesting;

		if (B166 <= B167)
			for (a = B166; ; a++) {
				(void)fprintf(op_file.fp, "    register rpc_integer rpc_%c;\n", (unsigned)('a') - 1 + a), Putl(op_file, 1);
				if (a == B167) break;
			}
	}
	if (ptr->b_type == functok) {
		(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
		writok(&op_file, ptr->C33_return);
		(void)fprintf(op_file.fp, " rpc_ret;\n"), Putl(op_file, 1);
	}
	Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	(void)fprintf(op_file.fp, "c_begin(rpc_p_buf, h_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, ", /*vers=*/%1d, /*proc=*/%1d);\n", version_num, (*G137_proc_number)), Putl(op_file, 1);
	if (ptr->list != (struct S77 *)NIL)
		gen_pack(&op_file, ptr->list, intok, true);
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	if (ptr->blk_status_param != (struct S77 *)NIL) {
		Putchr('*', op_file);
		write_name(&op_file, &ptr->blk_status_param->name);
		(void)fprintf(op_file.fp, " = "), Putl(op_file, 0);
	}
	(void)fprintf(op_file.fp, "c_call"), Putl(op_file, 0);
	if (ptr->blk_status_param != (struct S77 *)NIL)
		(void)fprintf(op_file.fp, "_status"), Putl(op_file, 0);
	(void)fprintf(op_file.fp, "(h_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, ", rpc_p_buf, %1d);\n", ptr->blk_timeout), Putl(op_file, 1);
	if (ptr->blk_status_param != (struct S77 *)NIL) {
		(void)fprintf(op_file.fp, "  if (*"), Putl(op_file, 0);
		write_name(&op_file, &ptr->blk_status_param->name);
		(void)fprintf(op_file.fp, " & 1) { /* If good call */ \n"), Putl(op_file, 1);
	}
	size_so_far = 0;
	if (ptr->blk_max_out > 0)
		(void)fprintf(op_file.fp, "    rpc_p_buf->m_index = RETURN_HEADER_LENGTH;\n"), Putl(op_file, 1);
	if (ptr->b_type == functok) {
		(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
		dopack_simple(&op_file, ptr->C33_return, false);
		(void)fprintf(op_file.fp, "rpc_ret);\n"), Putl(op_file, 1);
	}
	if (ptr->list != (struct S77 *)NIL)
		gen_pack(&op_file, ptr->list, outok, false);
	if (ptr->blk_status_param != (struct S77 *)NIL)
		(void)fprintf(op_file.fp, "  } /* end if good call */\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "    c_dispose(rpc_p_buf);\n"), Putl(op_file, 1);
	if (ptr->b_type == functok)
		(void)fprintf(op_file.fp, "    return(rpc_ret);\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "    }\n"), Putl(op_file, 1);
	Putchr('\n', op_file);
}

 void
P71_gen_open()
{
	if (Member((unsigned)(omode), Conset[89]))
		if (runoptions.A[(int)(noautoinit)].value)
			(void)fprintf(op_file.fp, "[GLOBAL]\n"), Putl(op_file, 1);
		else
			(void)fprintf(op_file.fp, "[GLOBAL, INITIALIZE]\n"), Putl(op_file, 1);
	writok(&op_file, proctok);
	(void)fprintf(op_file.fp, "open_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "()\n"), Putl(op_file, 1);
	else
		Putchr(';', op_file),Putchr('\n', op_file);
	if (omode == m6809)
		(void)fprintf(op_file.fp, "   ENTRY;\n"), Putl(op_file, 1);
	if (Member((unsigned)(omode), cmode.S)) {
		(void)fprintf(op_file.fp, "{   rpc_status       status;\n"), Putl(op_file, 1);
	} else {
		(void)fprintf(op_file.fp, "VAR\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    status : rpc_status;\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    service : rpc_name;\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "BEGIN\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    service := "), Putl(op_file, 0);
		write_name_padded(&op_file, unitname, '\'');
		Putchr(';', op_file),Putchr('\n', op_file);
	}
	if (Member((unsigned)(omode), cmode.S))
		Putchr('\n', op_file);
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	if (!(Member((unsigned)(omode), cmode.S)))
		(void)fprintf(op_file.fp, "rp"), Putl(op_file, 0);
	(void)fprintf(op_file.fp, "c_open(status, h_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, ", "), Putl(op_file, 0);
	if (Member((unsigned)(omode), cmode.S))
		write_name_padded(&op_file, unitname, '"');
	else
		(void)fprintf(op_file.fp, "service"), Putl(op_file, 0);
	(void)fprintf(op_file.fp, ");\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	if (!(Member((unsigned)(omode), cmode.S)))
		(void)fprintf(op_file.fp, "rp"), Putl(op_file, 0);
	(void)fprintf(op_file.fp, "c_report_error(status);\n"), Putl(op_file, 1);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "    }\n"), Putl(op_file, 1);
	else
		(void)fprintf(op_file.fp, "END;\n"), Putl(op_file, 1);
}

 void
P72_gen_close()
{
	if (Member((unsigned)(omode), Conset[90]))
		(void)fprintf(op_file.fp, "[GLOBAL]\n"), Putl(op_file, 1);
	writok(&op_file, proctok);
	(void)fprintf(op_file.fp, "close_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "()\n"), Putl(op_file, 1);
	else
		Putchr(';', op_file),Putchr('\n', op_file);
	if (omode == m6809)
		(void)fprintf(op_file.fp, "   ENTRY;\n"), Putl(op_file, 1);
	if (Member((unsigned)(omode), cmode.S)) {
		(void)fprintf(op_file.fp, "{   rpc_status       status;\n"), Putl(op_file, 1);
		Putchr('\n', op_file);
	} else {
		(void)fprintf(op_file.fp, "VAR\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    status : rpc_status;\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "BEGIN\n"), Putl(op_file, 1);
	}
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	if (!(Member((unsigned)(omode), cmode.S)))
		(void)fprintf(op_file.fp, "rp"), Putl(op_file, 0);
	(void)fprintf(op_file.fp, "c_close(status, h_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, ");\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	if (!(Member((unsigned)(omode), cmode.S)))
		(void)fprintf(op_file.fp, "rp"), Putl(op_file, 0);
	(void)fprintf(op_file.fp, "c_report_error(status);\n"), Putl(op_file, 1);
	if ((omode == pcturbo)) {
		(void)fprintf(op_file.fp, "   ExitProc := e_"), Putl(op_file, 0);
		write_name(&op_file, &unitname);
		Putchr(';', op_file),Putchr('\n', op_file);
	}
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "    }\n"), Putl(op_file, 1);
	else
		(void)fprintf(op_file.fp, "END;\n"), Putl(op_file, 1);
}

 void
client_generator(client_mode, cli_name)
	output_mode	client_mode;
	astring	cli_name;
{
	ptr_block_table	scan;
	integer	proc_number;
	integer	*F138;

	F138 = G137_proc_number;
	G137_proc_number = &proc_number;
	if (file_open(&op_file, &cli_name, rewriting)) {
		omode = client_mode;
		client = true;
		fragmentation_used = false;
		if (omode == pils)
			client_generator_pils();
		else
			if (omode == vaxfor)
				client_gen_for();
			else {
				if (!(omode == monolith))
					gen_module(&op_file);
				if ((omode == pcturbo)) {
					(void)fprintf(op_file.fp, "    e_"), Putl(op_file, 0);
					write_name(&op_file, &unitname);
					(void)fprintf(op_file.fp, ":   pointer;\n"), Putl(op_file, 1);
				}
				if ((Member((unsigned)(omode), Conset[91]))) {
					(*G137_proc_number) = 1;
					scan = blockptr;
					while (scan != (struct S78 *)NIL) {
						gen_header(&op_file, scan, false, true);
						(*G137_proc_number) = (*G137_proc_number) + 1;
						scan = scan->next;
					}
					(void)fprintf(op_file.fp, "PROCEDURE open_"), Putl(op_file, 0);
					write_name(&op_file, &unitname);
					Putchr(';', op_file),Putchr('\n', op_file);
					(void)fprintf(op_file.fp, "PROCEDURE close_"), Putl(op_file, 0);
					write_name(&op_file, &unitname);
					Putchr(';', op_file),Putchr('\n', op_file);
					Putchr('\n', op_file);
					(void)fprintf(op_file.fp, "IMPLEMENTATION\n"), Putl(op_file, 1);
					Putchr('\n', op_file);
				}
				(*G137_proc_number) = 1;
				scan = blockptr;
				while (scan != (struct S78 *)NIL) {
					if (Member((unsigned)(omode), cmode.S))
						gen_client_block_c(scan);
					else
						gen_client_block_pas(scan);
					(*G137_proc_number) = (*G137_proc_number) + 1;
					scan = scan->next;
				}
				P71_gen_open();
				P72_gen_close();
				if ((Member((unsigned)(omode), Conset[92]))) {
					if ((!runoptions.A[(int)(noautoinit)].value) || (omode == pcturbo))
						(void)fprintf(op_file.fp, "BEGIN\n"), Putl(op_file, 1);
					if ((omode == pcturbo)) {
						(void)fprintf(op_file.fp, "  e_"), Putl(op_file, 0);
						write_name(&op_file, &unitname);
						(void)fprintf(op_file.fp, " := ExitProc;\n"), Putl(op_file, 1);
						(void)fprintf(op_file.fp, "  ExitProc := @close_"), Putl(op_file, 0);
						write_name(&op_file, &unitname);
						Putchr(';', op_file),Putchr('\n', op_file);
					}
					if ((!runoptions.A[(int)(noautoinit)].value)) {
						(void)fprintf(op_file.fp, "  open_"), Putl(op_file, 0);
						write_name(&op_file, &unitname);
						Putchr(';', op_file),Putchr('\n', op_file);
					}
					(void)fprintf(op_file.fp, "END.\n"), Putl(op_file, 1);
				}
				if ((Member((unsigned)(omode), Conset[93])))
					(void)fprintf(op_file.fp, "END .\n"), Putl(op_file, 1);
				else
					if ((omode == m6809))
						(void)fprintf(op_file.fp, "MODEND .\n"), Putl(op_file, 1);
					else
						if ((omode == cerncross))
							Putchr('.', op_file),Putchr('\n', op_file);
			}
		if (fragmentation_used)
			(void)fprintf(output.fp, "Buffer fragmentation may be used for large parameters.\n"), Putl(output, 1);
		if (!(file_close(&op_file)))
			error(cant_cls_client);
	} else
		error(cant_opn_client);
	G137_proc_number = F138;
}

void server_generator();

void gen_server_block();

 void
write_camp()
{
	(void)fprintf(op_file.fp, ", "), Putl(op_file, 0);
	if ((Member((unsigned)(omode), cmode.S)) && !(runoptions.A[(int)(byvalue)].value && ((*G139_scanlist)->attr == intok)))
		Putchr('&', op_file);
}

 void
gen_server_block(ptr)
	ptr_block_table	ptr;
{
	register integer	a;
	ptr_idlist	scanlist;
	integer	par_count;
	ptr_idlist	*F140;

	F140 = G139_scanlist;
	G139_scanlist = &scanlist;
	size_so_far = 0;
	gen_header(&op_file, ptr, false, true);
	{
		integer	B168 = 1,
			B169 = ptr->blk_nesting;

		if (B168 <= B169)
			for (a = B168; ; a++) {
				(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
				if (Member((unsigned)(omode), cmode.S))
					(void)fprintf(op_file.fp, "register rpc_integer "), Putl(op_file, 0);
				(void)fprintf(op_file.fp, "rpc_%c", (unsigned)('a') - 1 + a), Putl(op_file, 0);
				if (!(Member((unsigned)(omode), cmode.S)))
					(void)fprintf(op_file.fp, " : rpc_integer"), Putl(op_file, 0);
				Putchr(';', op_file),Putchr('\n', op_file);
				if (a == B169) break;
			}
	}
	if (Member((unsigned)(omode), cmode.S))
		Putchr('\n', op_file);
	else {
		(void)fprintf(op_file.fp, "BEGIN\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "  WITH rpc_p_buf^ DO BEGIN\n"), Putl(op_file, 1);
	}
	if (ptr->list != (struct S77 *)NIL)
		gen_pack(&op_file, ptr->list, intok, false);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "    c_turn(rpc_p_buf);\n"), Putl(op_file, 1);
	else {
		(void)fprintf(op_file.fp, "    rpc_p_buf^.which := RETURN_MESSAGE;\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    rpc_p_buf^.m_index := RETURN_HEADER_LENGTH;\n"), Putl(op_file, 1);
	}
	size_so_far = 0;
	if ((ptr->b_type == proctok) && ptr->in_only)
		if ((runoptions.A[(int)(concurrent)].value || ptr->blk_concurrent)) {
			if ((Member((unsigned)(omode), cmode.S)))
				(void)fprintf(op_file.fp, "    c"), Putl(op_file, 0);
			else
				(void)fprintf(op_file.fp, "    rpc"), Putl(op_file, 0);
			(void)fprintf(op_file.fp, "_early_return(rpc_p_buf);\n"), Putl(op_file, 1);
		} else
			if (ptr->blk_cast)
				if (Member((unsigned)(omode), cmode.S))
					(void)fprintf(op_file.fp, "    rpc_p_buf->m_status=1;\n"), Putl(op_file, 1);
				else
					(void)fprintf(op_file.fp, "    m_status:=1;\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	if (ptr->b_type == functok)
		dopack_simple(&op_file, ptr->C33_return, true);
	write_name(&op_file, &ptr->name);
	if (ptr->list != (struct S77 *)NIL) {
		Putchr('(', op_file);
		(*G139_scanlist) = ptr->list;
		par_count = 1;
		do {
			if ((Member((unsigned)(omode), cmode.S)) && (Member((unsigned)((*G139_scanlist)->id_type->typ_basic_type), Conset[94])) && !(runoptions.A[(int)(byvalue)].value && ((*G139_scanlist)->attr == intok)))
				Putchr('&', op_file);
			if (((*G139_scanlist)->id_type->typ_basic_type == sequence)) {
				(void)fprintf(op_file.fp, "a_"), Putl(op_file, 0);
				write_name(&op_file, &(*G139_scanlist)->name);
				par_count = par_count + 1;
				write_camp();
				(void)fprintf(op_file.fp, "l_"), Putl(op_file, 0);
			} else
				if (((*G139_scanlist)->id_type->typ_basic_type == substring)) {
					(void)fprintf(op_file.fp, "a_"), Putl(op_file, 0);
					write_name(&op_file, &(*G139_scanlist)->name);
					write_camp();
					(void)fprintf(op_file.fp, "s_"), Putl(op_file, 0);
					write_name(&op_file, &(*G139_scanlist)->name);
					par_count = par_count + 2;
					write_camp();
					(void)fprintf(op_file.fp, "l_"), Putl(op_file, 0);
				} else
					if (((*G139_scanlist)->id_type->typ_basic_type == stringtok) && !(Member((unsigned)(omode), (Union(cmode.S, Conset[95]))))) {
						(void)fprintf(op_file.fp, "a_"), Putl(op_file, 0);
						write_name(&op_file, &(*G139_scanlist)->name);
						par_count = par_count + 1;
						(void)fprintf(op_file.fp, ", l_"), Putl(op_file, 0);
					}
			Claimset();
			write_name(&op_file, &(*G139_scanlist)->name);
			par_count = par_count + 1;
			(*G139_scanlist) = (*G139_scanlist)->next;
			if ((*G139_scanlist) != (struct S77 *)NIL) {
				(void)fprintf(op_file.fp, ", "), Putl(op_file, 0);
				if (par_count > 3) {
					Putchr('\n', op_file);
					(void)fprintf(op_file.fp, "        "), Putl(op_file, 0);
					par_count = 0;
				}
			}
		} while (!((*G139_scanlist) == (struct S77 *)NIL));
		Putchr(')', op_file);
	} else
		if (Member((unsigned)(omode), cmode.S))
			(void)fprintf(op_file.fp, "()"), Putl(op_file, 0);
	if (ptr->b_type == functok)
		Putchr(')', op_file);
	Putchr(';', op_file),Putchr('\n', op_file);
	if (ptr->list != (struct S77 *)NIL)
		gen_pack(&op_file, ptr->list, outok, true);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "    }\n"), Putl(op_file, 1);
	else {
		(void)fprintf(op_file.fp, "  END {with};\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "END;\n"), Putl(op_file, 1);
	}
	Putchr('\n', op_file);
	G139_scanlist = F140;
}

 void
gen_jump_proc()
{
	integer	proc_num;

	if (Member((unsigned)(omode), cmode.S)) {
		(void)fprintf(op_file.fp, "static rpc_message *rpc_p_buf;\n"), Putl(op_file, 1);
		Putchr('\n', op_file);
		(*G141_scan) = blockptr;
		proc_num = 0;
		while ((*G141_scan) != (struct S78 *)NIL) {
			gen_server_block((*G141_scan));
			(*G141_scan) = (*G141_scan)->next;
			proc_num = proc_num + 1;
		}
	}
	if (Member((unsigned)(omode), Conset[96]))
		(void)fprintf(op_file.fp, "[GLOBAL]\n"), Putl(op_file, 1);
	writok(&op_file, proctok);
	(void)fprintf(op_file.fp, "r_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "(rpc_a) rpc_message **rpc_a;\n"), Putl(op_file, 1);
	else
		(void)fprintf(op_file.fp, "(VAR rpc_p_buf : rpc_message_pointer);\n"), Putl(op_file, 1);
	if (omode == m6809)
		(void)fprintf(op_file.fp, "    ENTRY;\n"), Putl(op_file, 1);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "{   rpc_short request;\n"), Putl(op_file, 1);
	else {
		(void)fprintf(op_file.fp, "VAR\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    request : rpc_short;\n"), Putl(op_file, 1);
	}
	if (!(Member((unsigned)(omode), cmode.S))) {
		(*G141_scan) = blockptr;
		proc_num = 0;
		while ((*G141_scan) != (struct S78 *)NIL) {
			gen_server_block((*G141_scan));
			(*G141_scan) = (*G141_scan)->next;
			proc_num = proc_num + 1;
		}
		(void)fprintf(op_file.fp, "BEGIN\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "  WITH rpc_p_buf^ DO BEGIN\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    m_index :"), Putl(op_file, 0);
	} else {
		Putchr('\n', op_file);
		(void)fprintf(op_file.fp, "    rpc_p_buf = *rpc_a;\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    rpc_p_buf->m_index "), Putl(op_file, 0);
	}
	(void)fprintf(op_file.fp, "= CALL_HEADER_LENGTH - "), Putl(op_file, 0);
	if (version_num == 0)
		(void)fprintf(op_file.fp, "2;\n"), Putl(op_file, 1);
	else {
		(void)fprintf(op_file.fp, "4;\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    upk_short(rpc_p_buf, request);\n"), Putl(op_file, 1);
		if (Member((unsigned)(omode), cmode.S)) {
			(void)fprintf(op_file.fp, "    if (request != 0 && request != %1d)\n", version_num), Putl(op_file, 1);
			(void)fprintf(op_file.fp, "         rpc_p_buf->m_status = RPC_S_UNSUPPORTED_VERSION;\n"), Putl(op_file, 1);
			(void)fprintf(op_file.fp, "    else {\n"), Putl(op_file, 1);
		} else {
			(void)fprintf(op_file.fp, "    IF (request<>0) AND (request<>%1d)\n", version_num), Putl(op_file, 1);
			(void)fprintf(op_file.fp, "    THEN m_status := RPC_S_UNSUPPORTED_VERSION\n"), Putl(op_file, 1);
			(void)fprintf(op_file.fp, "    ELSE begin\n"), Putl(op_file, 1);
		}
	}
	(void)fprintf(op_file.fp, "     upk_short(rpc_p_buf, request);\n"), Putl(op_file, 1);
	if (Member((unsigned)(omode), cmode.S)) {
		(void)fprintf(op_file.fp, "     switch (request)\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "     {   "), Putl(op_file, 0);
	} else {
		(void)fprintf(op_file.fp, "     IF (request = 0) OR (request > %1d) THEN\n", proc_num), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "         m_status := RPC_S_BAD_PROCEDURE_NUMBER\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "     ELSE CASE request OF\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "        "), Putl(op_file, 0);
	}
	(*G141_scan) = blockptr;
	proc_num = 1;
	while ((*G141_scan) != (struct S78 *)NIL) {
		if (Member((unsigned)(omode), cmode.S))
			(void)fprintf(op_file.fp, "case "), Putl(op_file, 0);
		(void)fprintf(op_file.fp, "%2d : r_", proc_num), Putl(op_file, 0);
		write_name(&op_file, &(*G141_scan)->name);
		if (Member((unsigned)(omode), cmode.S))
			(void)fprintf(op_file.fp, "()"), Putl(op_file, 0);
		Putchr(';', op_file),Putchr('\n', op_file);
		proc_num = proc_num + 1;
		(*G141_scan) = (*G141_scan)->next;
		if ((Member((unsigned)(omode), cmode.S)))
			(void)fprintf(op_file.fp, "                  break;\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "        "), Putl(op_file, 0);
	}
	if (Member((unsigned)(omode), cmode.S)) {
		(void)fprintf(op_file.fp, "default : rpc_p_buf->m_status = RPC_S_BAD_PROCEDURE_NUMBER;\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "        }\n"), Putl(op_file, 1);
		if (version_num != 0)
			(void)fprintf(op_file.fp, "     }\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    }\n"), Putl(op_file, 1);
	} else {
		(void)fprintf(op_file.fp, "END {case};\n"), Putl(op_file, 1);
		if (version_num != 0)
			(void)fprintf(op_file.fp, "    END {if};\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "  END {with};\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "END;\n"), Putl(op_file, 1);
	}
	Putchr('\n', op_file);
}

 void
P73_gen_attach()
{
	if (Member((unsigned)(omode), Conset[97]))
		if (runoptions.A[(int)(noautoinit)].value)
			(void)fprintf(op_file.fp, "[GLOBAL]\n"), Putl(op_file, 1);
		else
			(void)fprintf(op_file.fp, "[GLOBAL, INITIALIZE]\n"), Putl(op_file, 1);
	writok(&op_file, proctok);
	(void)fprintf(op_file.fp, "attach_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "()\n"), Putl(op_file, 1);
	else
		Putchr(';', op_file),Putchr('\n', op_file);
	if (Member((unsigned)(omode), cmode.S)) {
		(void)fprintf(op_file.fp, "{   rpc_status      status;\n"), Putl(op_file, 1);
		Putchr('\n', op_file);
	} else {
		(void)fprintf(op_file.fp, "VAR\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    status  : rpc_status;\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    service : rpc_name;\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "BEGIN\n"), Putl(op_file, 1);
		(void)fprintf(op_file.fp, "    service := "), Putl(op_file, 0);
		write_name_padded(&op_file, unitname, '\'');
		Putchr(';', op_file),Putchr('\n', op_file);
	}
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	if (!(Member((unsigned)(omode), cmode.S)))
		(void)fprintf(op_file.fp, "rp"), Putl(op_file, 0);
	if ((Member((unsigned)(omode), Conset[98])))
		(void)fprintf(op_file.fp, "c_attach_stub(status, @r_"), Putl(op_file, 0);
	else
		(void)fprintf(op_file.fp, "c_attach_stub(status, r_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, ", "), Putl(op_file, 0);
	if (Member((unsigned)(omode), cmode.S)) {
		Putchr('\n', op_file);
		(void)fprintf(op_file.fp, "        "), Putl(op_file, 0);
		write_name_padded(&op_file, unitname, '"');
	} else
		(void)fprintf(op_file.fp, "service"), Putl(op_file, 0);
	(void)fprintf(op_file.fp, ", p_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, ");\n"), Putl(op_file, 1);
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	if (!(Member((unsigned)(omode), cmode.S)))
		(void)fprintf(op_file.fp, "rp"), Putl(op_file, 0);
	(void)fprintf(op_file.fp, "c_report_error(status);\n"), Putl(op_file, 1);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "    }\n"), Putl(op_file, 1);
	else
		(void)fprintf(op_file.fp, "END;\n"), Putl(op_file, 1);
}

 void
P74_gen_detach()
{
	if (Member((unsigned)(omode), Conset[99]))
		(void)fprintf(op_file.fp, "[GLOBAL]\n"), Putl(op_file, 1);
	writok(&op_file, proctok);
	(void)fprintf(op_file.fp, "detach_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "()\n"), Putl(op_file, 1);
	else
		Putchr(';', op_file),Putchr('\n', op_file);
	if (Member((unsigned)(omode), cmode.S)) {
		Putchr('{', op_file),Putchr('\n', op_file);
	} else {
		(void)fprintf(op_file.fp, "BEGIN\n"), Putl(op_file, 1);
	}
	(void)fprintf(op_file.fp, "    "), Putl(op_file, 0);
	if (!(Member((unsigned)(omode), cmode.S)))
		(void)fprintf(op_file.fp, "rp"), Putl(op_file, 0);
	(void)fprintf(op_file.fp, "c_detach_stub(p_"), Putl(op_file, 0);
	write_name(&op_file, &unitname);
	(void)fprintf(op_file.fp, ");\n"), Putl(op_file, 1);
	if (Member((unsigned)(omode), cmode.S))
		(void)fprintf(op_file.fp, "    }\n"), Putl(op_file, 1);
	else
		(void)fprintf(op_file.fp, "END;\n"), Putl(op_file, 1);
}

 void
server_generator(server_mode, ser_name)
	output_mode	server_mode;
	astring	ser_name;
{
	ptr_block_table	scan;
	ptr_block_table	*F142;

	F142 = G141_scan;
	G141_scan = &scan;
	if (file_open(&op_file, &ser_name, rewriting)) {
		omode = server_mode;
		client = false;
		fragmentation_used = false;
		if (omode == pils)
			server_generator_pils();
		else
			if (omode == vaxfor)
				server_gen_for();
			else {
				if (!(Member((unsigned)(omode), Conset[100])))
					gen_module(&op_file);
				if ((Member((unsigned)(omode), Conset[101]))) {
					(void)fprintf(op_file.fp, "PROCEDURE attach_"), Putl(op_file, 0);
					write_name(&op_file, &unitname);
					Putchr(';', op_file),Putchr('\n', op_file);
					if ((omode == pcturbo)) {
						(void)fprintf(op_file.fp, "PROCEDURE r_"), Putl(op_file, 0);
						write_name(&op_file, &unitname);
						(void)fprintf(op_file.fp, "(VAR rpc_p_buf : rpc_message_pointer);\n"), Putl(op_file, 1);
					}
					Putchr('\n', op_file);
					(void)fprintf(op_file.fp, "IMPLEMENTATION\n"), Putl(op_file, 1);
					Putchr('\n', op_file);
				}
				gen_jump_proc();
				if (!(Member((unsigned)(omode), Conset[102])))
					P73_gen_attach();
				if ((Member((unsigned)(omode), Conset[103])))
					(void)fprintf(op_file.fp, "END .\n"), Putl(op_file, 1);
				else
					if ((omode == m6809))
						(void)fprintf(op_file.fp, "MODEND .\n"), Putl(op_file, 1);
					else
						if ((omode == cerncross))
							Putchr('.', op_file),Putchr('\n', op_file);
			}
		if (!(file_close(&op_file)))
			error(cant_cls_server);
		if (fragmentation_used)
			(void)fprintf(output.fp, "Buffer fragmentation may be used for large parameters.\n"), Putl(output, 1);
	} else
		error(cant_opn_server);
	G141_scan = F142;
}

/*
**	Start of program code
*/
main(_ac, _av)
int	_ac;
char	*_av[];
{

	argc = _ac;
	argv = _av;
# ifdef STDINIT
	(void)(Getx(input));
# endif
	init_global();
	get_parameters();
	parser();
	if (!file_close(&inp_file))
		error(cant_cls_input);
	if (!runoptions.A[(int)(version)].value) {
		version_num = checksum + 1000;
		(void)fprintf(output.fp, "RPCC: generated stub version number is %1d.\n", version_num), Putl(output, 1);
	}
	if (runoptions.A[(int)(dtree)].value) {
		print_tab_types();
		print_tab_blocks();
	} else
		if (!(ser_spec || cli_spec))
			(void)fprintf(output.fp, "RPCC: no stubs specified - no code generated, hope that's okay.\n"), Putl(output, 1);
	if (errorfound > 0) {
		(void)fprintf(output.fp, "RPCC: %3d errors found, no code generated.\n", errorfound), Putl(output, 1);
		abort();
	}
	if (cli_spec) {
		client_generator(cli_mode, cli_name);
		ext_generator(cli_mode, ext_name);
	}
	if (ser_spec) {
		server_generator(ser_mode, ser_name);
	}
	exit(0);
	/* NOTREACHED */
}
# undef rpc_name_length
# undef maxstring
# undef expression_length
# undef template_length
# undef error_length
# undef maxidlen
# undef numkeyword
# undef numomodes
# undef maxdim
# undef non_fragmentation_limit
# undef fragmentation_threshold
# undef rpc_default_timeout
# undef commandline
/*
**	End of program code
*/

static void
Getl(f)
 text	*f;
{
	while (f->eoln == 0)
		Getx(*f);
	Getx(*f);
}

static FILE *
Fopen(n, l, m)
char	*n, *m;
int	l;
{
	FILE		*f;
	register char	*s;
	static char	ch = 'A';
	static char	tmp[MAXFILENAME];
	extern int	unlink(),
			strlen();

	if (n == NULL)
		sprintf(tmp, "/tmp/ptc%d%c", getpid(), ch++);
	else {
		if (l < 0)
			l = strlen(n);
		strncpy(tmp, n, sizeof(tmp));
		for (s = &tmp[sizeof(tmp)-1]; *s == ' ' || *s == '\0' || s - tmp > l; )
			*s-- = '\0';
		if (tmp[sizeof(tmp)-1]) {
			(void)fprintf(stderr, "Too long filename '%s'\n", n);
			exit(1);
		}
	}
	s = tmp;
	if ((f = fopen(s, m)) == NULL) {
		(void)fprintf(stderr, "Cannot open: %s\n", s);
		exit(1);
	}
	if (n == NULL)
		unlink(tmp);
	return (f);
}
static setword	Q0[] = {
	1,
	0x00D8
};
static setword	Q1[] = {
	1,
	0x0002
};
static setword	Q2[] = {
	1,
	0x00C0
};
static setword	Q3[] = {
	1,
	0x0004
};
static setword	Q4[] = {
	1,
	0x0018
};
static setword	Q5[] = {
	1,
	0x00C0
};
static setword	Q6[] = {
	1,
	0x0018
};
static setword	Q7[] = {
	1,
	0x0018
};
static setword	Q8[] = {
	1,
	0x00DA
};
static setword	Q9[] = {
	1,
	0x05FF
};
static setword	Q10[] = {
	1,
	0x0018
};
static setword	Q11[] = {
	1,
	0x00C0
};
static setword	Q12[] = {
	1,
	0x00C0
};
static setword	Q13[] = {
	1,
	0x0018
};
static setword	Q14[] = {
	1,
	0x0018
};
static setword	Q15[] = {
	1,
	0x0018
};
static setword	Q16[] = {
	1,
	0x00C0
};
static setword	Q17[] = {
	1,
	0x003B
};
static setword	Q18[] = {
	1,
	0x00C0
};
static setword	Q19[] = {
	1,
	0x00C0
};
static setword	Q20[] = {
	1,
	0x0018
};
static setword	Q21[] = {
	1,
	0x00C0
};
static setword	Q22[] = {
	1,
	0x0018
};
static setword	Q23[] = {
	1,
	0x00C0
};
static setword	Q24[] = {
	1,
	0x00C0
};
static setword	Q25[] = {
	1,
	0x00C4
};
static setword	Q26[] = {
	1,
	0x0300
};
static setword	Q27[] = {
	1,
	0x00C2
};
static setword	Q28[] = {
	1,
	0x00DA
};
static setword	Q29[] = {
	1,
	0x5000
};
static setword	Q30[] = {
	1,
	0x5000
};
static setword	Q31[] = {
	1,
	0x0800
};
static setword	Q32[] = {
	1,
	0x0800
};
static setword	Q33[] = {
	1,
	0x0800
};
static setword	Q34[] = {
	1,
	0x0800
};
static setword	Q35[] = {
	1,
	0x2800
};
static setword	Q36[] = {
	1,
	0x2800
};
static setword	Q37[] = {
	1,
	0x2000
};
static setword	Q38[] = {
	1,
	0x2000
};
static setword	Q39[] = {
	1,
	0x00C2
};
static setword	Q40[] = {
	1,
	0x00C2
};
static setword	Q41[] = {
	1,
	0x0002
};
static setword	Q42[] = {
	1,
	0x5000
};
static setword	Q43[] = {
	1,
	0x5000
};
static setword	Q44[] = {
	1,
	0x5000
};
static setword	Q45[] = {
	1,
	0x5000
};
static setword	Q46[] = {
	3,
	0x0000,	0x8009,	0x0001
};
static setword	Q47[] = {
	1,
	0x01FF
};
static setword	Q48[] = {
	2,
	0x0000,	0x0E00
};
static setword	Q49[] = {
	3,
	0x0000,	0x8008,	0x0005
};
static setword	Q50[] = {
	3,
	0x0000,	0x8008,	0x0005
};
static setword	Q51[] = {
	3,
	0x0000,	0xA081,	0x0001
};
static setword	Q52[] = {
	2,
	0x0000,	0x0081
};
static setword	Q53[] = {
	2,
	0x0000,	0x0C00
};
static setword	Q54[] = {
	2,
	0x0000,	0x0A00
};
static setword	Q55[] = {
	2,
	0x0000,	0x0600
};
static setword	Q56[] = {
	2,
	0x0000,	0x2030
};
static setword	Q57[] = {
	3,
	0x0000,	0x8001,	0x0001
};
static setword	Q58[] = {
	3,
	0x0000,	0x8004,	0x0001
};
static setword	Q59[] = {
	3,
	0x0000,	0x8004,	0x0001
};
static setword	Q60[] = {
	3,
	0x0000,	0x8000,	0x0001
};
static setword	Q61[] = {
	2,
	0x0000,	0x0001
};
static setword	Q62[] = {
	2,
	0x0000,	0x0001
};
static setword	Q63[] = {
	2,
	0x0000,	0x0001
};
static setword	Q64[] = {
	2,
	0x0000,	0x0001
};
static setword	Q65[] = {
	2,
	0x0000,	0x0001
};
static setword	Q66[] = {
	2,
	0x0000,	0x0001
};
static setword	Q67[] = {
	2,
	0x0000,	0x0001
};
static setword	Q68[] = {
	2,
	0x0000,	0x0001
};
static setword	Q69[] = {
	2,
	0x0000,	0x0001
};
static setword	Q70[] = {
	2,
	0x0000,	0x0081
};
static setword	Q71[] = {
	2,
	0x0000,	0x0001
};
static setword	Q72[] = {
	2,
	0x0000,	0x0001
};
static setword	Q73[] = {
	2,
	0x0000,	0x0001
};
static setword	Q74[] = {
	2,
	0x0000,	0x0001
};
static setword	Q75[] = {
	2,
	0x0000,	0x0001
};
static setword	Q76[] = {
	2,
	0x0000,	0x0001
};
static setword	Q77[] = {
	2,
	0x0000,	0x0001
};
static setword	Q78[] = {
	1,
	0x6000
};
static setword	Q79[] = {
	2,
	0x0000,	0x0008
};
static setword	Q80[] = {
	2,
	0x0000,	0x0009
};
static setword	Q81[] = {
	1,
	0x01FF
};
static setword	Q82[] = {
	2,
	0x0000,	0x0101
};
static setword	Q83[] = {
	2,
	0x0000,	0x0001
};
static setword	Q84[] = {
	2,
	0x0000,	0x0101
};
static setword	Q85[] = {
	4,
	0x0000,	0x0000,	0x5300,	0x2C00
};
static setword	Q86[] = {
	4,
	0x0000,	0x0000,	0x0000,	0x03FF
};
static setword	Q87[] = {
	4,
	0x0000,	0x0000,	0x2000,	0x03FF
};
static setword	Q88[] = {
	8,
	0x0000,	0x0000,	0x0000,	0x03FF,	0x0000,	0x8000,
	0xFFFE,	0x07FF
};
static setword	Q89[] = {
	8,
	0x0000,	0x0000,	0x0000,	0x0000,	0x0000,	0x8000,
	0xFFFE,	0x07FF
};
static setword	Q90[] = {
	4,
	0x0000,	0x0000,	0x1301,	0x0C00
};
static setword	Q91[] = {
	4,
	0x0000,	0x0000,	0x1300,	0x0C00
};
static setword	Q92[] = {
	6,
	0x0000,	0x0000,	0x0000,	0x0000,	0xFFFE,	0x07FF
};
static setword	Q93[] = {
	8,
	0x0000,	0x0000,	0x0000,	0x0000,	0xFFFE,	0x07FF,
	0xFFFE,	0x07FF
};
static setword	Q94[] = {
	8,
	0x0000,	0x0000,	0x4000,	0x03FF,	0xFFFE,	0x87FF,
	0xFFFE,	0x07FF
};
static setword	Q95[] = {
	4,
	0x0000,	0x0000,	0x0000,	0x03FF
};
static setword	Q96[] = {
	4,
	0x0000,	0x0000,	0x0000,	0x03FF
};
static setword	Q97[] = {
	6,
	0x0000,	0x0000,	0x0000,	0x0000,	0xFFFE,	0x07FF
};
static setword	Q98[] = {
	1,
	0x0400
};
static setword	Q99[] = {
	1,
	0x01FF
};
static setword	Q100[] = {
	1,
	0x7FFF
};
static setword	Q101[] = {
	3,
	0xFFFF,	0xFFFF,	0x000F
};
static setword	Q102[] = {
	3,
	0xFFFF,	0xFFFF,	0x000F
};
static setword	Q103[] = {
	3,
	0xFFFF,	0xFFFF,	0x0FFF
};
static setword	*Conset[] = {
	Q103,	Q102,	Q101,
	Q100,	Q99,	Q98,	Q97,	Q96,	Q95,
	Q94,	Q93,	Q92,	Q91,	Q90,	Q89,
	Q88,	Q87,	Q86,	Q85,	Q84,	Q83,
	Q82,	Q81,	Q80,	Q79,	Q78,	Q77,
	Q76,	Q75,	Q74,	Q73,	Q72,	Q71,
	Q70,	Q69,	Q68,	Q67,	Q66,	Q65,
	Q64,	Q63,	Q62,	Q61,	Q60,	Q59,
	Q58,	Q57,	Q56,	Q55,	Q54,	Q53,
	Q52,	Q51,	Q50,	Q49,	Q48,	Q47,
	Q46,	Q45,	Q44,	Q43,	Q42,	Q41,
	Q40,	Q39,	Q38,	Q37,	Q36,	Q35,
	Q34,	Q33,	Q32,	Q31,	Q30,	Q29,
	Q28,	Q27,	Q26,	Q25,	Q24,	Q23,
	Q22,	Q21,	Q20,	Q19,	Q18,	Q17,
	Q16,	Q15,	Q14,	Q13,	Q12,	Q11,
	Q10,	Q9,	Q8,	Q7,	Q6,	Q5,
	Q4,	Q3,	Q2,	Q1,	Q0
};

static setptr
Union(p1, p2)
	register setptr	p1, p2;
{
	register int		i, j, k;
	register setptr		sp = Newset(),
				p3 = sp;

	j = *p1;
	*p3 = j;
	if (j > *p2)
		j = *p2;
	else
		*p3 = *p2;
	k = *p1 - *p2;
	p1++, p2++, p3++;
	for (i = 0; i < j; i++)
		*p3++ = (*p1++ | *p2++);
	while (k > 0) {
		*p3++ = *p1++;
		k--;
	}
	while (k < 0) {
		*p3++ = *p2++;
		k++;
	}
	return (Saveset(sp));
}

static boolean
Member(m, sp)
	register unsigned int	m;
	register setptr	sp;
{
	register unsigned int	i = m / (setbits+1) + 1;

	if ((i <= *sp) && (sp[i] & (1 << (m % (setbits+1)))))
		return (true);
	return (false);
}

# ifndef SETSPACE
# define SETSPACE 256
# endif
static setptr
Currset(n,sp)
	int	n;
	setptr	sp;
{
	static setword	Space[SETSPACE];
	static setptr	Top = Space;

	switch (n) {
	  case 0:
		Top = Space;
		return (0);
	  case 1:
		if (&Space[SETSPACE] - Top <= 15) {
			(void)fprintf(stderr, "Set-space exhausted\n");
			exit(1);
		}
		*Top = 0;
		return (Top);
	  case 2:
		if (Top <= &sp[*sp])
			Top = &sp[*sp + 1];
		return (sp);
	}
	/* NOTREACHED */
}

static void
Setncpy(S1, S2, N)
	register setptr	S1, S2;
	register unsigned int	N;
{
	register unsigned int	m;

	N /= sizeof(setword);
	*S1++ = --N;
	m = *S2++;
	while (m != 0 && N != 0) {
		*S1++ = *S2++;
		--N;
		--m;
	}
	while (N-- != 0)
		*S1++ = 0;
}

static struct Set *
Alignset(Sp)
	register unsigned short	*Sp;
{
	static struct Set	tmp;
	register unsigned short	*tp = tmp.S;
	register int		i = *Sp;

	while (i-- >= 0)
		*tp++ = *Sp++;
	return (&tmp);
}

static struct String *
Alignstr(Cp)
	register char	*Cp;
{
	static struct String	tmp;
	register char	*sp = tmp.A;

	while (*sp++ = *Cp++)
		;
	return (&tmp);
}

static void
Caseerror(n)
	int	n;
{
	(void)fprintf(stderr, "Missing case limb: line %d\n", n);
	exit(1);
	/* NOTREACHED */
}