/*
*****************************************************************************
*									    *
*  Copyright (c) 1978, 1979, 1980, 1988	                                    *
*  by DIGITAL Equipment Corporation, Maynard, Mass.			    *
* 									    *
*  This software is furnished under a license and may be used and  copied   *
*  only  in  accordance  with  the  terms  of  such  license and with the   *
*  inclusion of the above copyright notice.  This software or  any  other   *
*  copies  thereof may not be provided or otherwise made available to any   *
*  other person.  No title to and ownership of  the  software  is  hereby   *
*  transferred.							 	    *
* 									    *
*  The information in this software is subject to change  without  notice   *
*  and  should  not  be  construed  as  a commitment by DIGITAL Equipment   *
*  Corporation.							   	    *
* 									    *
*  DIGITAL assumes no responsibility for the use or  reliability  of  its   *
*  software on equipment which is not supplied by DIGITAL.		    *
*									    *
*****************************************************************************

facility:

	SDL (Structure Definition Language)

abstract:

	Generates the MACRO language output from the SDL tree
author:
	C.T. Pacy
date:
	revised 22-DEC-1980	ctp
	revised 30-JUN-1982	ls		version 1.5 changes
	revised 15-AUG-1982	ls		version 1.6 changes
	revised 04-OCT-1982	ls		version 1.7 changes
	revised 30-NOV-1982	ls		level 1.7-3 changes
	revised 07-Apr-1983	kd		to correct the supression of
						aggregate names for /VMS and to
						add SDL$LIBRARY: to definition files
						included below.  Add some comments.
	revised 02-Aug-1984	kd		Add ident field (1.0)

			C H A N G E    L O G

      Date	| Name	| Description
________________|_______|______________________________________________________
   8-Apr-1985	|  kd 	| 2-1  Add named type support.
________________|_______|______________________________________________________
    11-Jun-1985	|  kd	| T2.9-0 Make the backend ident be the sdl version
________________|_______|______________________________________________________
    21-Aug-1985	|  kd	| T2.9-1 Change comments flag to sdl$v_comment_opt.
________________|_______|______________________________________________________
    22-Feb-1987	|  jgw	| T3.1-0 Bug fix #137: Add support for OPTIONAL parameter option.
________________|_______|______________________________________________________
    25-Feb-1987	|  jgw	| T3.1-0 Bug fix #138: No .GLOBL for _S macro if VARIABLE
________________|_______|______________________________________________________
     9-Mar-1987	|  jgw	| T3.1-1 Corrected macro $name derived for
		|	|	 an entry point with no ALIAS specified;
		|	|	 provided support here for LIB$, SCR$, MTH$,
		|	|	 OTS$, SMG$, DTK$ and STR$ prefixes.  Also:
		|	|	 made enhancements for LIST parameter option;
		|	|	 emptied output buffer (buf) after call to
		|	|	 sdl$putline in "common" section; initialized
		|	|	 output buffer (buf) to '' at outer-level
		|	|	 declaration.
________________|_______|______________________________________________________
     2-Apr-1987	|  jgw	| X3.1-2 Bumped the version number and switched from T
		|	|	 to X in the version number, since X is used
		|	|	 for development releases.
________________|_______|______________________________________________________
    01-May-1987	|  jgw	| X3.1-3 Modified pusharg_proc for addition of COMPLEX
		|	|	 data types.
________________|_______|______________________________________________________
    17-May-1987	|  jgw	| X3.1-4 Make sure CHARACTER RTL_STR_DESC is treated
		|	|	 just like CHARACTER DESCRIPTOR (pusharg_proc
		|	|	 modified accordingly)
________________|_______|______________________________________________________
    22-Jan-1988	|  PG	| X3.2-0 Add CONSTANT STRING
________________|_______|______________________________________________________
    02-Feb-1988	|  jg	| X3.2-1 User-defined types.  All this involves here
		|	|	 is to ignore an Item node with the DECLARED
		|	|	 attribute.
________________|_______|______________________________________________________
    18-Feb-1988	|  jg	| X3.2-2 Add support for conditional compilation and
		|	|	  LITERAL.
________________|_______|______________________________________________________
    29-Jun-1988	|  jgw	| X3.2-3 Fixed macro names generated for ENTRY
		|	|	  interface definitions without the ALIAS
		|	|	  clause specified (made these names conform
		|	|	  to VMS naming conventions).
________________|_______|______________________________________________________
    28-Oct-1988	|  jgw	| V3.2-4 Cleared BUF variable immediately after an
		|	|	  SDL$PUTLINE call in the CASE(NOD$K_MODULNODE)
		|	|	  section of OUTPUTNODE to prevent garbage from
		|	|	  being output later.
________________|_______|______________________________________________________
    13-FEB-1990 |  WRV  | X3.2-VMS1 Modifiers are members of VMS tools group.
                |  RHT  |           Added code for file dependency recording for
                |       |           VMS VDE system builder.
________________|_______|______________________________________________________
    16-Jun-1990 |  MAS  | X3.2-VMS2 Change all 32 char var fields to 64 to
                |       |           avoid trucation on long field names.
________________|_______|______________________________________________________
    21-Aug-1991 |  AWF  | X3.2-7  Fixed macro generation for VARYING_ARG
                |       |         and VARYING RETURNS.  These were modified
		|	|	  to generate a ".IRP" terminated by a ".ENDR".
________________|_______|______________________________________________________
     3-Jun-1992	|  JAK	| EV1-11  Added test for uppercase 'FILL' as well as 'fill'.
________________|_______|______________________________________________________
    29-Mar-1993 |  RS   | EV1-22  Don't change module name in the node produced
		|	|	  by the front end because other back ends may
		|	|	  need it.
________________|_______|______________________________________________________
    20-Oct-1994	|  RC	| EV1-40    Native Alpha port.  See SDLGETFNM.PLI.
________________|_______|______________________________________________________
    06-Mar-1996	|  aem	| EV1-52  Fix problem with if statement testing and 
		|	|	  using typeinfo2 when typeinfo2 is null.
________________|_______|______________________________________________________
    05-Jun-1996	|  aem	| EV1-53  Add entries/processing for datatypes 23-36
		|	|	  to  pusharg_proc procedure.  These datatypes
		|	|	  were not being processed, resulting in 
		|	|	  garbage in the Macro defined for the CALLS
		|	|	  definition for a given ENTRY.
________________|_______|______________________________________________________
    10-Jan-1997	|  aem	| EV1-54  Bumped maximum_number_of_parameters to 23 so
		|	|	  SYS$FAO will be generated properly.
________________|_______|______________________________________________________
*/
%replace MODULE_IDENT by 'EV1-54';


sdl$output:	proc (out_file, def_filename, sdl$_shr_data)
				options(ident(MODULE_IDENT));


%include 'SDL$LIBRARY:sdlnodef.in';	/* include node structure definition */
%include 'SDL$LIBRARY:sdltypdef.in';  	/* include data type definitions */
%include 'SDL$LIBRARY:sdlshr.in';	/* include error message interface */
%include 'SDL$LIBRARY:sdlmsgdef.in';	/* include sdl routine declararions */
%include 'SDL$LIBRARY:sdlgetfnm.in';

 
%replace true by '1'b;	
%replace false by '0'b;
%replace lang_ext by '.mar';
%replace lang_name by 'MACRO';	/* Language name for conditional - jg */


	dcl def_filename char(132) var;
	dcl out_file char(128) var ;
	dcl output_file file output record sequential;
	dcl buf char(1024) var init('');
	dcl based_string char(1024) var based;
	dcl (i, j, trailing_optional_count) fixed bin(31);
	dcl tab char initial (byte(9));
	dcl tab2 char(2) initial (byte(9)||byte(9));
	dcl (origin, space_position, comma_position) fixed bin(31);
	dcl (temp_name, temp_separator) char(64) var;
	dcl (trailing_optionals_exist, vms_dummy_name) bit(1);
	dcl process_conditional bit init (false);		/* jg */

/*** main ***/

/* first open up the output file */

			/* make the default output file name to be the
			   input source name and concatenate the extension 
			   for the language */
	open file (output_file) title (out_file) 
			environment (default_file_name( def_filename || lang_ext ),
				     user_open (sdl$getfnm) );
	outfile = output_file;	/* equate the file with the file variable 
					in the shared structure */	

	call sdl$header(sdl$_shr_data, '; ','',line_length);

	call outputnode(tree_root->nod$a_flink,tree_root,0);

/* Get the fully resolved language specific output file and
   and move it the shared data area for the front-end. The reultant
   name will be recorded as a file dependency for the VDE system builder.
*/
	vde_lang_file = sdl$gt_filename;
 
/** print node routine **/
outputnode:	proc (initp,startp,level);
  dcl (initp,p,startp,q) ptr;
  dcl level fixed bin(31);
  dcl module_name char(128) static var;				/* PG */

  p = initp;
  do while (p^=startp);
	goto case(p->nod$b_type);
 
case(nod$k_rootnode):
	goto common_3;
case(nod$k_commnode):
	buf='';
	goto common;
case(nod$k_constnode):
	if sdl$v_vms_opt
	then
	   if p->nod$w_datatype = typ$k_char then do;
	      call sdl$putline(outfile, '.SAVE', line_length);
	      call sdl$putline(outfile,
		 '.PSECT'||tab||substr(module_name,1,22)
		 ||'_STRCONST PIC,CON,REL,NOEXE,GBL,SHR,RD,NOWRT,LONG',
		 line_length);
	      buf = '$EQU'||tab||p->nod$t_prefix||'S_'||
		 p->nod$t_naked||tab||trim(p->nod$l_typeinfo);
	      call sdl$putline(outfile, buf, line_length);
	      call sdl$putline(outfile, p->nod$t_name||':', line_length);
	      call select_delimiter(p->nod$a_typeinfo2->based_string);
	      buf = '.RESTORE';
	      end;
	   else
            if p->nod$v_mask then
                buf = '$EQU'||tab||p->nod$t_name||tab||'<^X'||p->nod$t_maskstr||'>';
            else
                buf = '$EQU'||tab||p->nod$t_name||tab||trim(p->nod$l_typeinfo);
	else
	   if p->nod$w_datatype = typ$k_char then do;
	      call sdl$putline(outfile, '.SAVE', line_length);
	      call sdl$putline(outfile,
		 '.PSECT'||tab||substr(module_name,1,22)
		 ||'_STRCONST PIC,CON,REL,NOEXE,GBL,SHR,RD,NOWRT,LONG',
		 line_length);
	      buf = p->nod$t_prefix||'S_'||
		 p->nod$t_naked||'''..equ'''||trim(p->nod$l_typeinfo);
	      call sdl$putline(outfile, buf, line_length);
	      call sdl$putline(outfile, p->nod$t_name||'''..col''', line_length);
	      call select_delimiter(p->nod$a_typeinfo2->based_string);
	      buf = '.RESTORE';
	      end;
	   else
	    if p->nod$v_mask then
                buf = p->nod$t_name||'''..equ'''||'^X'||p->nod$t_maskstr;
            else
                buf = p->nod$t_name||'''..equ'''||trim(p->nod$l_typeinfo);
	goto common;
case(nod$k_entrynode):
	buf='; External entry '||p->nod$t_name;
dcl (internal_name, external_name, entry_name_prefix) char (34) var ;
dcl pcnt fixed bin;
dcl (dollar_pos, required_count) fixed bin init (0);
dcl starting_list bit;
%replace maximum_number_of_parameters by 23;
%replace var_addr_len by 5;
dcl var_addr_str (var_addr_len) char (128) var static init (
'		.IF NB $$T2',
'		$$T1=$$T1+1',
'		.ENDC',
'		.ENDR',
'		.ADDRESS	$$T1');	
%replace var_push_len by 5;
dcl var_push_str (var_push_len) char (128) var static init (
'		.IF NB $$T1',
'		PUSHL	$$T1',
'		$$T2=$$T2+1',
'		.ENDC',
'		.ENDR');
%replace trailing_opt1_len by 12;
dcl trailing_opt1_str (trailing_opt1_len) char (128) var static init (
'		.IF NB $$T2',
'		$$PRESENT_FLAG = 1',
'		.MEXIT',
'		.IFF',
'		$$SUPPLIED = $$SUPPLIED - 1',
'		.ENDC',
'		.ENDR',
'		.IF EQUAL $$PRESENT_FLAG',
'		$$SUPPLIED = 0',
'		.ENDC',
'		$$NUMARGS = $$NUMREQARGS + $$SUPPLIED',
'		.LONG		$$NUMARGS');
%replace trailing_opt2_len by 10;
dcl trailing_opt2_str (trailing_opt2_len) char (128) var static init (
'		.IF EQUAL $$SUPPLIED',
'		.MEXIT',
'		.ENDC',
'		.IF NB $$T2',
'		.ADDRESS	$$T2',
'		.IFF',
'		.LONG		0',
'		.ENDC',
'		$$SUPPLIED = $$SUPPLIED - 1',
'		.ENDR');
/* check for special case of VMS entry info, including macros for definition
   and calls */

	if sdl$v_vms_opt
	    then do;
		/* make $name label spelling */
		external_name = p->nod$t_name;
		if p->nod$v_alias then
		  internal_name = p->nod$t_naked;
		else do;
		 /*
		  * No ALIAS clause was specified, so construct a
		  * macro name of the form:
		  *
		  *	    $fac_routine
		  *
		  */
		  internal_name = p->nod$t_name;
   		  dollar_pos = index(internal_name, '$');
   		  if dollar_pos ^= 0 then do;
   		      entry_name_prefix =
   		          translate(substr(internal_name, 1, dollar_pos - 1),
   				    'ABCDEFGHIJKLMNOPQRSTUVWXYZ',
   				    'abcdefghijklmnopqrstuvwxyz');
   			  if (entry_name_prefix = 'SYS') then
   			      internal_name = substr(internal_name, 4,
						     length(internal_name)-3);
   			  else
   			      internal_name = '$' ||
   			          substr(internal_name, 1, dollar_pos - 1) ||
   				  '_' || substr(internal_name, dollar_pos + 1,
   				            length(internal_name) - dollar_pos);
   		      end;
   		  else
		     /*
		      * No dollar sign is present, so we don't have a
		      * facility prefix in the specified name.  Therefore,
		      * just stick an underscore in front of the routine
		      * name to form the macro name.  VMS Development agrees
		      * that this is the appropriate convention.
		      */
   		      internal_name = '_' || internal_name;
   		  end;

		/* see if there are any trailing optionals */
		if p->nod$a_child ^= null() then do; /* if there are parameters */
		  i = count_parameters (p->nod$a_child);
		  trailing_optional_count = examine_trailing_parameters (p->nod$a_child);
		  if (trailing_optional_count = 0) & (^p->nod$a_child->nod$a_blink->nod$v_list) then
		    trailing_optionals_exist = false;
		  else
		    trailing_optionals_exist = true;
		  required_count = i - trailing_optional_count;
		  end;
		else do; /* if there aren't any parameters */
		    trailing_optional_count = 0;
		    trailing_optionals_exist = false;
		    required_count = 0;
		  end;

		if p->nod$v_link     /* special linkage */
		then do;
		call sdl$putline (outfile, ' ',line_length);
		buf = tab || '.MACRO' || tab || internal_name || tab;
		/* go down the parameter list putting out macro arg list*/
		pcnt = outputspell ( p->nod$a_child->nod$a_flink,
		  p->nod$a_child, comma_proc, true, false, true, 
		  p->nod$v_variable, required_count, 0);
		call sdl$putline (outfile, buf,line_length); /* put out macro header */
		/* put out linkage name as macro call */
		buf = tab2 || p->nod$t_prefix || tab || substr(internal_name,2,
			length(internal_name)-1) ||',';
		/* go down the parameter list for rest of linkage call */
		pcnt = outputspell ( p->nod$a_child->nod$a_flink,
		  p->nod$a_child, comma_proc, false, false, false, 
		  p->nod$v_variable, required_count, 0);
		call sdl$putline (outfile, buf, line_length);
		call sdl$putline (outfile, tab || '.ENDM' || tab || internal_name
				,line_length);
		buf='';
		end;
		else do;	     /* standard vms macros */
		if  p->nod$a_child^=null() then do;

		/* put out $name_G macro */
		call sdl$putline (outfile, ' ',line_length);
		call sdl$putline (outfile, tab || '.MACRO' || tab || internal_name ||
			'_G' || tab || 'ARGPTR', line_length);
		call sdl$putline (outfile, tab2 || '.GLOBL' || tab || external_name,
				line_length);
		buf = tab2 || 'CALLG' || tab || 'ARGPTR,G^' || external_name;
		call sdl$putline (outfile, buf, line_length);
		call sdl$putline (outfile, tab || '.ENDM' || tab || internal_name ||
					'_G', line_length);

		/* put out $nameDEF macro */
		call sdl$putline (outfile, ' ',line_length);
		call sdl$putline (outfile, tab || '.MACRO' || tab || internal_name ||
				'DEF', line_length);
		buf = tab2 || '$OFFDEF' || tab || substr(internal_name,2,
			length(internal_name)-1) || ', <';
		/* go down the parameter list */
		pcnt = outputspell ( p->nod$a_child->nod$a_flink,
		  p->nod$a_child, comma_proc, false, false, false, 
		  p->nod$v_variable, required_count, 0);
		call sdl$putline (outfile, buf || '>', line_length);
		call sdl$putline (outfile, tab || '.ENDM' || tab || internal_name ||
					'DEF', line_length);

		/* put out $name macro */
		call sdl$putline (outfile, ' ',line_length);
		buf = tab || '.MACRO' || tab || internal_name || tab;

		/* go down the parameter list putting out macro arg list*/
		pcnt = outputspell ( p->nod$a_child->nod$a_flink,
		   p->nod$a_child, comma_proc, true, true, false, 
		   p->nod$v_variable, required_count, 0);

		call sdl$putline (outfile, buf,line_length); /* put out macro header */
		call sdl$putline (outfile, tab2|| internal_name || 'DEF',line_length);
						/* line to invoke DEF macro */
		if p->nod$v_variable	/* generate .IRP for var len list */
		then do;
		  call sdl$putline (outfile, tab2 || '$$T1 = ' || trim(pcnt-1),
					 line_length);
		  buf = tab2 || '.IRP' || tab || '$$T2,<';
		  call putvarlist ((pcnt));
		  call sdl$putline (outfile, buf || '>', line_length);
		  buf = '';
		  do i = 1 to var_addr_len;
		    call sdl$putline (outfile, (var_addr_str(i)), line_length);
		    end;
		  end;
		else
		  if trailing_optionals_exist then do;
		    call sdl$putline (outfile, tab2 || '$$PRESENT_FLAG = 0',
				      line_length);
		    if p->nod$a_child->nod$a_blink->nod$v_list then
		      if p->nod$a_child->nod$a_blink->nod$v_optional then
		        call sdl$putline (outfile, tab2 || '$$SUPPLIED = ' ||
				          trim(maximum_number_of_parameters - required_count),
				          line_length);
		      else
		        call sdl$putline (outfile, tab2 || '$$SUPPLIED = ' ||
				          trim(maximum_number_of_parameters - (required_count + trailing_optional_count)),
				          line_length);
		    else
		      call sdl$putline (outfile, tab2 || '$$SUPPLIED = ' ||
				        trim(trailing_optional_count),
				        line_length);
		    call sdl$putline (outfile, tab2 || '$$NUMREQARGS = ' ||
				      trim(required_count),
				      line_length);
		    buf = tab2 || '.IRP' || tab || '$$T2,<';
		    call bak_trailing_optional_list (p->nod$a_child->nod$a_blink,
						     trailing_optional_count, required_count);
		    call sdl$putline (outfile, buf || '>', line_length);
		    buf = '';
		    do i = 1 to trailing_opt1_len;
		    call sdl$putline (outfile, (trailing_opt1_str(i)),
				      line_length);
		    end; /* do */
		    end;
		  else
		    buf = tab2|| '.LONG' || tab2 || trim(pcnt);
		if ^trailing_optionals_exist then do;
		  /* go down the parameter list */
		  pcnt = outputspell ( p->nod$a_child->nod$a_flink,
		 	  p->nod$a_child, address_proc, false, false, false, 
			  p->nod$v_variable, required_count, 0);
		  call sdl$putline (outfile, buf, line_length);
		  end; /* if ^trailing_optionals_exist */
		else do;
		  q = p->nod$a_child->nod$a_flink;
		  starting_list = true;
		  do i = 1 to required_count;
		    temp_separator = address_proc (q, 0, false, starting_list);
		    starting_list = false;
		    buf = buf || temp_separator;
		    call sdl$putline (outfile, buf, line_length);
		    buf = '';
		    q = q->nod$a_flink;
		  end; /* do i = 1 to ... */
		  buf = tab2 || '.IRP' || tab || '$$T2,<';
		  pcnt = outputspell ( q,
			p->nod$a_child, comma_proc, false, false, false, 
			p->nod$v_variable, required_count, required_count);
		  call sdl$putline (outfile, buf || '>', line_length);
		  buf = '';
		  do i = 1 to trailing_opt2_len;
		    call sdl$putline (outfile, (trailing_opt2_str(i)),
				      line_length);
		    end; /* do */
		  end; /* do */
		call sdl$putline (outfile, tab || '.ENDM' || tab || internal_name,
				line_length);
		end;

		/* put out $name_S macro */
		call sdl$putline (outfile, ' ',line_length);
		buf = tab || '.MACRO' || tab || internal_name ||
			'_S ';
		if  p->nod$a_child^=null() then do;
		/* if it has parameters, then go down the parameter list */
			pcnt = outputspell ( p->nod$a_child->nod$a_flink,
			   p->nod$a_child, comma_proc, true, false, true,
			   p->nod$v_variable, required_count, 0);
			end;
		else pcnt = 0;
		call sdl$putline (outfile, buf, line_length);
		buf = tab2 || '.GLOBL' || tab || external_name;
		call sdl$putline (outfile, buf, line_length);
		buf = '';
		if p->nod$v_variable	/* generate .IRP for var len list */
		then do;
		  call sdl$putline (outfile, tab2 || '$$T2 = ' || trim(pcnt-1), line_length);
		  buf = tab2 || '.IRP' || tab || '$$T1,<';
		  call bakvarlist ((pcnt));
		  call sdl$putline (outfile, buf || '>', line_length);
		  buf = '';
		  do i = 1 to var_push_len;
		    call sdl$putline (outfile, (var_push_str(i)), line_length);
		    end;
		  end;
		else if trailing_optionals_exist then do;
		  call sdl$putline (outfile, tab2 || '$$NONESEEN = 1', line_length);
		  q = p->nod$a_child->nod$a_blink; /* q = last parameter */
		  if q->nod$v_list then do;
		    call sdl$putline (outfile, tab2 || '$$T2 = ' ||
				      trim(maximum_number_of_parameters), line_length); /* initialize arg ctr to maximum */
		    buf = tab2 || '.IRP' || tab || '$$T9,<';
		    starting_list = true;
		    do j = (maximum_number_of_parameters - (required_count + trailing_optional_count)) to 1 by -1;
		      temp_separator = comma_proc (q, (j + 1), false, starting_list);
		      starting_list = false;
		      buf = buf || temp_separator;
		      end; /* trailing optional LIST parameter loop */
		    call sdl$putline (outfile, buf || '>', line_length);
		    buf = '';
		    call sdl$putline (outfile, tab2 || '.IF B $$T9', line_length);
		    call sdl$putline (outfile, tab2 || '.IF EQUAL $$NONESEEN', line_length);
		    call sdl$putline (outfile, tab2 || 'PUSHL' || tab2 || '#0', line_length);
		    call sdl$putline (outfile, tab2 || '.IFF', line_length);
		    call sdl$putline (outfile, tab2 || '$$T2 = $$T2 - 1', line_length);
		    call sdl$putline (outfile, tab2 || '.ENDC', line_length);
		    call sdl$putline (outfile, tab2 || '.IFF', line_length);
		    call sdl$putline (outfile, tab2 || '$$NONESEEN = 0', line_length);
		    temp_separator = pusharg_proc (q, 0, true); /* 0 is dummy argument */
		    space_position = index(temp_separator, ' ');
		    if space_position = 0 then
		      space_position = index(temp_separator, tab);
		    comma_position = index(temp_separator, ',');
		    if comma_position ^= 0 then
		      buf = substr(temp_separator, 1, space_position) || '$$T2' ||
			    substr(temp_separator, comma_position, (length(temp_separator) - (comma_position - 1)));
		    else
		      buf = substr(temp_separator, 1, space_position) || '$$T2';
		    call sdl$putline (outfile, buf, line_length);
		    buf = '';
		    call sdl$putline (outfile, tab2 || '.ENDC', line_length);
		    call sdl$putline (outfile, tab2 || '.ENDR', line_length);
		    end; /* if a LIST parameter */
		  else
		    call sdl$putline (outfile, tab2 || '$$T2 = ' ||
				      trim(pcnt), line_length); /* initialize arg ctr to maximum */
		  do i = 1 to trailing_optional_count;
		    if q->nod$v_list then
		      call sdl$putline (outfile, tab2 || '.IF B ' || q->nod$t_name || '1', line_length);
		    else
		      call sdl$putline (outfile, tab2 || '.IF B ' || q->nod$t_name, line_length);
		    call sdl$putline (outfile, tab2 || '.IF EQUAL $$NONESEEN', line_length);
		    call sdl$putline (outfile, tab2 || 'PUSHL' ||
				    tab2 || '#0', line_length);
		    call sdl$putline (outfile, tab2 || '.IFF', line_length);
		    call sdl$putline (outfile, tab2 || '$$T2 = $$T2 - 1', line_length);
		    call sdl$putline (outfile, tab2 || '.ENDC', line_length);
		    call sdl$putline (outfile, tab2 || '.IFF', line_length);
		    call sdl$putline (outfile, tab2 || '$$NONESEEN = 0', line_length);
		    temp_separator = pusharg_proc (q, 0, true); /* 0 is dummy argument */
		    buf = buf || temp_separator;
		    call sdl$putline (outfile, buf, line_length);
		    buf = '';
		    call sdl$putline (outfile, tab2 || '.ENDC', line_length);
		    q = q->nod$a_blink; /* walk backward along trailing optionals */
		    end; /* do */
		  buf = '';
		  end; /* if trailing_optionals_exist */
		if  (p->nod$a_child^=null()) then do;
		/* if it has parameters, then go down the parameter list */
			q = p->nod$a_child;
			if p->nod$v_variable then q = q->nod$a_blink;
			else if trailing_optionals_exist then
			   /* skip trailing optionals since they are already taken care of */
			   do i = 1 to trailing_optional_count;
			     q = q->nod$a_blink;
			     end; /* else if...do */
			call outbakspell ( q->nod$a_blink,
			   p->nod$a_child, pusharg_proc, false);
			end;
		call sdl$putline (outfile, buf, line_length);
		buf = tab2 || 'CALLS' || tab || '#';
		if p->nod$v_variable | trailing_optionals_exist
		  then buf = buf || '$$T2' ;
		  else buf = buf || trim(pcnt);
		buf = buf || ',G^' || external_name;
		call sdl$putline (outfile, buf, line_length);
		call sdl$putline (outfile, tab || '.ENDM' || tab || internal_name ||
					'_S', line_length);
		call sdl$putline (outfile, ' ',line_length);
		buf = '';
		end;
		end;
	goto common;
case(nod$k_itemnode):

	if p->nod$v_declared then goto common;			/* jg */

	if level = 1 then
		if (p->nod$w_datatype = typ$k_structure |
		   p->nod$w_datatype = typ$k_union ) then
			origin = p->nod$l_typeinfo;
		else
			origin = 0;
	if p->nod$v_userfill & (^p->nod$v_fixed_fldsiz
		| substr(p->nod$t_naked,1,4)='fill'
		| substr(p->nod$t_naked,1,4)='FILL')
	  then	/* skip if user specified fill */
		goto common_2;
	if p->nod$v_common then do;
		call sdl$putline (outfile, tab||'.SAVE',line_length);
		call sdl$putline (outfile, tab||'.PSECT '||p->nod$t_name||
		' PIC,OVR,REL,GBL,SHR,NOEXE,RD,WRT,LONG',line_length);
		if sdl$v_vms_opt
		  then
		    buf = '$DEF'||tab||p->nod$t_name||
		     tab||'.blkb '||trim(p->nod$l_fldsiz);
		  else
		    buf = p->nod$t_name||'''..col'''||
		     tab||'.blkb '||trim(p->nod$l_fldsiz);
		call sdl$putline (outfile, buf, line_length);
		call sdl$putline (outfile, tab||'.RESTORE',line_length);
		end;
	if p->nod$v_global then do;
		if sdl$v_vms_opt
		  then
		    buf = '$DEF'||tab||p->nod$t_name||
		     tab||'.blkb '||trim(p->nod$l_fldsiz);
		  else if sdl$v_global_opt
		    then buf = p->nod$t_name||'''..col'''||
		     tab||'.blkb '||trim(p->nod$l_fldsiz);
		    else buf = tab || '.GLOBL' || tab || p->nod$t_name;
		call sdl$putline (outfile, buf, line_length);
		end;
	buf='';
	vms_dummy_name = sdl$v_vms_opt &
			index(p->nod$t_naked,'_FIELDS')	^= 0 |
			index(p->nod$t_naked,'_BITS') ^= 0 |
			index(p->nod$t_naked,'_OVERLAY') ^= 0;
	if p->nod$w_datatype=typ$k_vield & p->nod$l_typeinfo > 1 
	then
	  if sdl$v_vms_opt
	  then do;
		if ^vms_dummy_name then
		buf='$EQU'||tab||p->nod$t_prefix||'S_'||p->nod$t_naked||
		     tab||trim(p->nod$l_typeinfo);
	  end;
	  else
		buf=p->nod$t_prefix||'S_'||p->nod$t_naked||
		     '''..equ'''||trim(p->nod$l_typeinfo);
	else
	    if p->nod$w_datatype=typ$k_structure |
		   p->nod$w_datatype=typ$k_union |
		   (p->nod$w_datatype=typ$k_char &
		   p->nod$l_fldsiz > 1) |
		   p-> nod$l_fldsiz > 4 |
		   p->nod$v_dimen  
	    then
		if sdl$v_vms_opt
		then do;
		    if ^vms_dummy_name 
		    then
			buf='$EQU'||tab||p->nod$t_prefix||'S_'||p->nod$t_naked
				    ||tab||trim(p->nod$l_fldsiz);
		end;
	    else
		buf=p->nod$t_prefix||'S_'||p->nod$t_naked
			     ||'''..equ'''||trim(p->nod$l_fldsiz);

		/* don't put out size for items with named types */
		if (p->nod$w_datatype = typ$k_structure |
		    p->nod$w_datatype = typ$k_union) 
		    
		then if p->nod$a_typeinfo2 ^= null() 
		    then if (p->nod$a_typeinfo2->nod$w_datatype ^= nod$k_typnode)
			then buf = '';

		if buf^='' 
		then do;
		    if length(buf)>line_length then
		    buf=substr(buf,1,line_length);
		    call sdl$putline (outfile, buf,line_length);
		    buf = '';
		end;

/*	if sdl$v_vms_opt &
	   p->nod$w_datatype ^= typ$k_structure &
	   p->nod$w_datatype ^= typ$k_union &
	   p->nod$w_datatype ^= typ$k_vield
	  then
	    buf = '$DEF'||tab||p->nod$t_name||
		     tab||'.BLKB '||trim(p->nod$l_fldsiz); */

	if ^p->nod$v_userfill   /* FILL not specified */
	then do;
		if sdl$v_vms_opt
        	then do;
			if level = 1  &   
				(p->nod$w_datatype = typ$k_structure |
				 p->nod$w_datatype = typ$k_union) 
			then
				go to common;   /* skip SDL aggregate macro */

			buf = '$EQU'||tab||p->nod$t_name|| tab; 
		 end;
	 
		else		/* VMS option not specified */
			buf=p->nod$t_name||'''..equ''';

		if p->nod$w_datatype=typ$k_vield then
			buf=buf||trim(p->nod$l_typeinfo2);
		else
			buf=buf||trim(origin + p->nod$l_offset);
	
		if p->nod$v_global | p->nod$v_common then
			buf='; '||buf;

	end;
	
	goto common;

case(nod$k_modulnode):
	call sdl$putline (outfile, ' ',line_length);
	buf=tab||'.MACRO'||tab;
	if sdl$v_vms_opt
	then do;
	  if p->nod$t_name = 'STARLET'
	  then do;
	    call sdl$putline (outfile, tab||'.TITLE'||tab||'STARLET', line_length);
	    buf = '';
	    temp_name = '';
	    end;
	  else do;
	    temp_name=p->nod$t_name;
	    if (index(temp_name,'DEF')=length(temp_name) - 2 |
		index(temp_name,'def')=length(temp_name) - 2 |
		index(temp_name,'TBL')=length(temp_name) - 2 |
		index(temp_name,'tbl')=length(temp_name) - 2)
	    then if index(temp_name,'$') = 1
		then
		  temp_name = substr(temp_name,2,length(temp_name)-4);
		else
		  temp_name = substr(temp_name,1,length(temp_name)-3);
/* Comment out the next line because back ends should not modify the */
/* tree. Not sure why this is here! */
/*	    p->nod$t_name=temp_name;	*/
	    module_name = temp_name;				/* PG */
	    buf = buf ||'$'||temp_name|| 'DEF,$GBL';
	    call sdl$putline (outfile, buf, line_length);
	    buf = tab || '$DEFINI' || tab || temp_name || ',$GBL' ;
	    end;
	  end;
	else do;
	    module_name = p->nod$t_name;			/* PG */
	    buf = buf ||p->nod$t_name||',..EQU=<=>,..COL=<:';
	    if sdl$v_global_opt
	    then buf = buf || ':';
	    buf = buf || '>';
	    if p->nod$t_naked ^= '' then
		buf= fill(buf,40)||'; IDENT '||p->nod$t_naked;
	    end;
	call sdl$putline (outfile, buf,line_length);
	buf = '';
	if p->nod$a_comment^=null() & sdl$v_comment_opt then 
		call sdl$putline (outfile, '; '||p->nod$a_comment->based_string,
		     line_length);
	call outputnode(p->nod$a_child->nod$a_flink,p->nod$a_child,level+1);
	if sdl$v_vms_opt
	then do;
	    if temp_name = '' then goto common_3;
	    buf = tab || '$DEFEND'|| tab || temp_name || ',$GBL,DEF' ;
	    call sdl$putline (outfile, buf, line_length);
	    end;
	call sdl$putline (outfile, tab||'.ENDM',line_length);
case(nod$k_parmnode): ;
case(nod$k_objnode): ;
case(nod$k_headnode): ;
	goto common_3;

case(nod$k_condnode):						/* jg */

	/* Search for this language in the list */

	q = p->nod$a_typeinfo2->nod$a_flink;
	do while (^process_conditional & q->nod$b_type = nod$k_objnode);
	    if q->nod$t_name = lang_name then process_conditional = true;
	    q = q->nod$a_flink;
	end;

	/*
	 * If this language has been found, then children will be processed
	 * at common_2 at the same level.
	 *
	 * Process a comment attached to IFLANGUAGE only if for this language.
	 */
	if process_conditional then goto common;
	else goto common_2;

case(nod$k_litnode):						/* jg */

	/* Process literal node */

	buf = p->nod$a_typeinfo2->based_string;
	goto common;

common:
	if p->nod$a_comment^=null() & sdl$v_comment_opt then do;
		if buf ^= '' then
			buf = fill(buf,40);
		buf=buf||'; '||p->nod$a_comment->based_string;
		end;
	if length(buf)>line_length then
		buf=substr(buf,1,line_length);
	call sdl$putline (outfile, buf,line_length);
	buf='';
common_2:
	if process_conditional then do;				/* jg */
	    process_conditional = false;
	    call outputnode(p->nod$a_child->nod$a_flink,p->nod$a_child,
				level);
	    end;

	else if p->nod$a_child^=null() & p->nod$b_type ^= nod$k_condnode then
		call outputnode(p->nod$a_child->nod$a_flink,p->nod$a_child,level+1);
common_3:
	p = p->nod$a_flink;
	end;
    return;

select_delimiter: procedure(string);

  %replace delimiter_list_length by 18;
  dcl delimiter_list char(delimiter_list_length)
    static initial('/\''"!@#$%^&*-=+_|?');
  dcl delimiter char(1);
  dcl string char(1024) var;
  dcl (first,i,j) fixed bin(31);

  /* if the string is blank, exit */
  if string = '' then return;

  /* set the first delimiter break to none */
  first = -1;

  /* pick the first delimiter */
  i=1;
  delimiter = substr(delimiter_list,i,1);

  /* search the string for the delimiter */
loop:
  do j=1 to length(string) by 1;

	if delimiter = substr(string, j, 1) then do;

	  /* string contains delimiter, try next delimiter, and
	     re-search entire string */
	  if first = -1 then first = j;
	  i = i + 1;
	  if i > delimiter_list_length then do;
	    if first = 1 then first = 2;
	    call select_delimiter(substr(string, 1, first-1));
	    call select_delimiter(substr(string, first));
	    return;
	    end;
	  else do;
	    delimiter = substr(delimiter_list,i,1);
	    goto loop;
	    end;

	  end;

    end;

  buf = tab||'.ASCII '||delimiter||string||delimiter;
  call sdl$putline(outfile, buf, line_length);
  end select_delimiter;
 
outputspell : procedure (initp, startp, separator_proc, default_flag,
	all_default_flag,immed_flag, var_flag, required_count, already_handled_count) returns (fixed bin);

/*
 * parameters:
 *		initp	= address of node to output
 *
 *		startp	= address of where to stop on outputting list
 *
 *		separator_proc	= procedure to supply separator
 *
 *		default_flag = flag for default parameter value to be gen'd
 *
 *		all_default_flag = flag for zero default parameter value
 *
 *		immed_flag = flag for immediate default parameter value
 *
 *		var_flag = flag for variable length list
 *
 *		required_count = number of parameters less trailing optionals
 *
 *		already_handled_count = the number of parameters "already handled", if any,  which should *not*
 *					be included in the size of the list generated by this routine.  This parameter
 *					is used to initialize list_length.  Formerly, list_length was always initialized
 *					locally to 0; this routine (outputspell) is being used not only to generate
 *					"complete" lists of parameters, but also to generate "partial" parameter lists --
 *					more specifically, the trailing list of optionals *less* required parameters (which
 *					are either "already handled" before the call to this routine -- presumably with
 *					.ADDRESS directives -- or are not necessary in the context of the call).  Make the
 *					actual parameter 0 if you intend outputspell to generate a complete list of parameters.
 */

dcl (initp, p, startp) pointer;
dcl separator_proc entry (pointer, fixed bin, bit(1), bit)
	returns (char (64) var);
dcl (default_flag, all_default_flag, immed_flag, var_flag, starting_list, LIST_optionals_in_list) bit(1);
dcl (already_handled_count, required_count, list_length, num_args, pos_index) fixed bin;
dcl separator char(64) var;

/* Loop on input name list */
	p = initp;
	list_length = already_handled_count;
	num_args = 0;
	if p->nod$v_list then
	  pos_index = 1;
	else
	  pos_index = 0;
	LIST_optionals_in_list = false;
	starting_list = true;

	do while ((p^=startp | var_flag | startp->nod$a_blink->nod$v_list) & list_length < maximum_number_of_parameters);
	  if (p=startp) & (p->nod$a_blink->nod$v_list) then do;

	   /*
	    * If this is the first optional generation of the LIST parameter,
	    * then initialize the number to be appended to the "base name":
	    */
	    if ^LIST_optionals_in_list then
	      pos_index = 2;

	    LIST_optionals_in_list = true;
	    separator = separator_proc (p->nod$a_blink, pos_index, var_flag &
			  (p=startp | p->nod$a_flink=startp), starting_list);
	    end; /* if we've reached a LIST parameter */
	  else
	    separator = separator_proc (p, pos_index, var_flag &
			  (p=startp | p->nod$a_flink=startp), starting_list);

	  starting_list = false;
	  buf = buf || separator ;
	  if default_flag
	  then if (p->nod$v_default | (all_default_flag & (num_args < required_count)) |
				      (p->nod$v_optional & (num_args < required_count))) &
		  (^var_flag | ( p^=startp & p->nod$a_flink^=startp))
	    then do;
		buf = buf || '=';
		if immed_flag & p->nod$v_value
		   then buf = buf || '#';
		if p->nod$v_default
		then buf = buf || trim(p->nod$l_initial);
		else buf = buf || '0';
		end;
	  list_length = list_length + 1;
	  if p ^= startp
	  then do;
	    p = p->nod$a_flink;
	    if (var_flag | startp->nod$a_blink->nod$v_list) & p = startp
	    	then pos_index = pos_index+1;
	    else pos_index=1;
	    num_args = num_args + 1;
	    end;
	  else pos_index = pos_index+1;
	  end;
	return (num_args);
end outputspell;

putvarlist : procedure (pcnt);
dcl pcnt fixed binary;
dcl separator char(64) var;

/* Loop on input name list */
	starting_list = true;
	do i = pcnt-1 to (maximum_number_of_parameters - 1);
	  separator = comma_proc (p, i-pcnt+2, true, starting_list);
	  starting_list = false;
	  buf = buf || separator;
	end;
end putvarlist;

bakvarlist: procedure (pcnt);
dcl pcnt fixed binary;
dcl separator char(64) var;

/* Loop on input name list */
	starting_list = true;
	do i = (maximum_number_of_parameters - 1) to pcnt-1 by -1;
	  separator = comma_proc (p, i-pcnt+2, true, starting_list);
	  starting_list = false;
	  buf = buf || separator;
	end;
end bakvarlist;

bak_trailing_optional_list : procedure (q, trailing_optional_count, required_count);

/*
 * parameters:
 *		q = address of last parameter node
 *
 *		trailing_optional_count = number of trailing optionals which exist
 *
 *		required_count = number of required parameters
 */

dcl (q,z) pointer;
dcl separator char(64) var;
dcl (i, j, trailing_optional_count, required_count, pos_index) fixed bin;
dcl (starting_list, LIST_optionals_in_list) bit;

	LIST_optionals_in_list = false;
	z = q;
	pos_index = 0;
	/* Loop backward through trailing optionals */
	if z->nod$v_list then do;
	  /* First, loop through LIST optionals */
	  starting_list = true;
	  do j = (maximum_number_of_parameters - (required_count + trailing_optional_count)) to 1 by -1;
	    LIST_optionals_in_list = true;
	    separator = comma_proc (z, (j + 1), false, starting_list);
	    starting_list = false;
	    buf = buf || separator;
	    end; /* loop */
	  pos_index = 1;
	  end; /* if a LIST parameter */
	if LIST_optionals_in_list then
	  starting_list = false;
	else
	  starting_list = true;
	do i = 1 to trailing_optional_count;
	  separator = comma_proc (z, pos_index, false, starting_list);
	  starting_list = false;
	  buf = buf || separator ;
	  z = z->nod$a_blink;
	  pos_index = pos_index + 1;
	  end; /* do */
end bak_trailing_optional_list;

outbakspell : procedure (initp, startp, separator_proc, default_flag);

/*
 * parameters:
 *		initp	= address of node to output
 *
 *		startp	= address of where to stop on outputting list
 *
 *		separator_proc	= procedure to supply separator
 *
 *		default_flag = flag for default parameter value to be gen'd
 */

dcl (initp,p,startp) pointer;
dcl separator_proc entry (pointer, fixed bin, bit) returns (char (64) var);
dcl default_flag bit;
dcl separator char(64) var;
dcl list_length fixed bin;

/* Loop on input name list */
	p = initp;
	do while (p^=startp);
	  separator = separator_proc (p, list_length, false);
	  buf = buf || separator ;
	  if default_flag & p->nod$v_default then
		buf = buf || '=' || trim(p->nod$l_initial);
	  p = p->nod$a_blink;
	  end;
end outbakspell;

count_parameters : procedure (head) returns (fixed bin);
/*
* Returns the total number of formal parameters described
* in the SDL declaration.  This counts LIST parameters
* as 1 parameter only (i.e., what is returned could be
* described as the number of "parameter descriptions" in
* the entry point declaration).
*/
dcl (q, head) pointer;
dcl p_counter fixed bin;

    p_counter = 0;
    q = head->nod$a_flink;
    do while (q ^= head);
      p_counter = p_counter + 1;
      q = q->nod$a_flink;
      end; /* do while */
    return (p_counter);

end count_parameters;

examine_trailing_parameters : procedure (head) returns (fixed bin);
/*
* Returns the number of formal trailing optional parameters in the
* SDL declaration.  LIST parameters count as only 1 parameter -- as
* in the procedure count_parameters.
*/
dcl (q, head) pointer;
dcl t_counter fixed bin;
dcl end_trailing_optionals bit;

    t_counter = 0;
    end_trailing_optionals = false;
    q = head->nod$a_blink;
    do while ((q ^= head) & (^end_trailing_optionals));
      if q->nod$v_optional then
	t_counter = t_counter + 1;
      else
	end_trailing_optionals = true;
      q = q->nod$a_blink;
      end; /* do while */
    return (t_counter);

end examine_trailing_parameters;

comma_proc : procedure (p,i,var_part, starting_list) returns (char (64)var);
dcl p pointer;
dcl i fixed bin;
dcl (var_part, starting_list) bit;
dcl name char(64) var;
/* get name */
	if var_part
	then name = 'P'||trim(i);
	else
	  if p->nod$v_list then
	    name = p->nod$t_name || trim(i);
	  else
	    name = p->nod$t_name;
/* just return comma within list */
	if starting_list
	then return(name);
	else
	if length (buf) > 55
	  then do;
	    buf = buf || ',-';
	    call sdl$putline (outfile, buf, line_length);
	    buf = tab2 || tab;
	    return(name);
	    end;
	else return (',' || name);

end comma_proc;

address_proc : procedure (p, i, var_part, starting_list) returns (char (64) var);
dcl p pointer;
dcl i fixed bin;
dcl (var_part, starting_list) bit;
dcl name char(64) var;


/* just return line separator and .ADDRESS */

	call sdl$putline (outfile, buf, line_length);
	buf = '';
	if var_part
	then do;
	  name = 'P'||trim(i);
	  call sdl$putline (outfile, tab2 || '.IF NB ' || name, line_length);
	  call sdl$putline (outfile, tab2 || '.ADDRESS'|| tab || name, line_length);
	  return (tab2 || '.ENDC');
	  end;
	else
	  if p->nod$v_list then
	    return (tab2 || '.ADDRESS'|| tab || p->nod$t_name || '1');
	  else
	    return (tab2 || '.ADDRESS'|| tab || p->nod$t_name);

end address_proc;

pusharg_proc : procedure (p,i, trailing_optional) returns (char (64) var);
dcl p pointer;
dcl i fixed bin;
dcl trailing_optional bit;
dcl push_instr char(64) var;
dcl two_flag bit init ('0'b);

dcl push_opcode (36) char(64) var static init(
	'$PUSHADR',
	'CVTBL',
	'$PUSHADR',
	'PUSHL',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'PUSHL',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'CVTWL',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHL',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'CVTBL',
	'CVTWL',
	'PUSHL',
	'$PUSHADR',
	'$PUSHADR'
	);

dcl unsigned_opcode (36) char(64) var static init(
	'$PUSHADR',
	'MOVZBL',
	'$PUSHADR',
	'PUSHL',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'PUSHL',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'MOVZWL',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'PUSHL',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'$PUSHADR',
	'CVTBL',
	'CVTWL',
	'PUSHL',
	'$PUSHADR',
	'$PUSHADR'
	);

dcl context_flag (36) bit static init(
false,true,true,false,false,true,
false,true,true,false,true,true,
true,true,false,false,false,false,
true,true,true,false,false,false,
false,true,true,true,false,false,
true,true,true,false,true,true);

dcl context_string(36) char(64) var static init(
	'',
	',CONTEXT=B',
	',CONTEXT=Q',
	'',
	'',
	',CONTEXT=Q',
	'',
	',CONTEXT=Q',
	',CONTEXT=O',
	'',
	',CONTEXT=O',
	',CONTEXT=Q',
	',CONTEXT=B',
	',CONTEXT=W',
	'',
	'',
	'',
	'',
	',CONTEXT=O',
	',CONTEXT=Q',
	',CONTEXT=O',
	'',
	'',
	'',
	'',
	',CONTEXT=Q',
	',CONTEXT=Q',
	',CONTEXT=Q',
	'',
	'',
	',CONTEXT=Q',
	',CONTEXT=B',
	',CONTEXT=W',
	'',
	',CONTEXT=Q',
	',CONTEXT=Q'
	);

	if ^sdl$v_alpha_opt
	   then do;
		context_string(typ$k_hardware_address) 	= ',CONTEXT=L';
		context_string(typ$k_hardware_integer)	= ',CONTEXT=L';
		context_string(typ$k_pointer_hw)     	= ',CONTEXT=L';
		context_string(typ$k_integer_hw)	= ',CONTEXT=L';
		end;
/* compute case from arg context and return appropriate push arg instr */
	if (p->nod$w_datatype = typ$k_longword |
	    p->nod$w_datatype = typ$k_word |
	    p->nod$w_datatype = typ$k_byte)
	then if p->nod$v_value
	  then if p->nod$v_unsigned
	    then push_instr = unsigned_opcode (p->nod$w_datatype);
	    else push_instr = push_opcode (p->nod$w_datatype);
	  else push_instr = '$PUSHADR';
	else push_instr = push_opcode (p->nod$w_datatype);
	if (p->nod$w_datatype = typ$k_longword & p->nod$v_value &
	   p->nod$a_blink->nod$w_datatype = typ$k_longword &
	   p->nod$a_blink->nod$v_value |
	   p->nod$w_datatype = typ$k_any & p->nod$v_default &
	   p->nod$a_blink->nod$w_datatype = typ$k_any) & (^trailing_optional) & (^p->nod$v_list)
	then do;
	     push_instr = '$PUSHTWO';
	     two_flag = true;
	     end;
	else if ((p->nod$w_datatype = typ$k_longword & p->nod$v_dimen &
		p->nod$l_hidim=2 | p->nod$w_datatype = typ$k_quadword |
		p->nod$w_datatype = typ$k_char & (p->nod$v_desc | p->nod$v_rtl_str_desc)) &
		(p->nod$a_blink->nod$w_datatype = typ$k_longword &
		 p->nod$a_blink->nod$v_value)) & (^trailing_optional) & (^p->nod$v_list)
	then do;
	     push_instr = '$ASNPUSH';
	     two_flag = true;
	     end;
	else if (p->nod$w_datatype = typ$k_longword & p->nod$v_value &
	   (p->nod$a_blink->nod$w_datatype = typ$k_longword & ^p->nod$v_value |
	    p->nod$a_blink->nod$w_datatype = typ$k_address)) & (^trailing_optional) & (^p->nod$v_list)
	then do;
	     push_instr = '$QIOPUSH';
	     two_flag = true;
	     end;
	if length (push_instr) > 7
	then push_instr = push_instr || ' ';
	else push_instr = push_instr || tab ;
	if p->nod$v_list then
	  push_instr = push_instr || p->nod$t_name || '1';
	else
	  push_instr = push_instr || p->nod$t_name;
	if two_flag then do;
	     p = p->nod$a_blink;
	     push_instr	= push_instr || ',' || p->nod$t_name;
	     end;
	else do;
	  if p->nod$w_datatype = typ$k_longword &
		p->nod$v_dimen & p->nod$l_hidim = 2
	    then push_instr = push_instr || ',CONTEXT=Q';
	  else if p->nod$v_dimen
	    then push_instr = push_instr || ' ';
	  else if  context_flag (p->nod$w_datatype) then
	    if p->nod$v_value
	    then
	      push_instr = push_instr || ',-(SP)';
	    else
	     push_instr = push_instr || context_string (p->nod$w_datatype);
	  end;
	call sdl$putline (outfile, buf,line_length);
	buf = '';
	return (tab2 || push_instr);
end pusharg_proc;
end outputnode;
 
end sdl$output;