/*
*****************************************************************************
*									    *
*  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.
________________|_______|______________________________________________________
*/
%replace MODULE_IDENT by 'EV1-22';


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:filedef.in';      /* rms file definitions */

 
%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 */

/* Declare variables needed for getting a fully resolved file specification.
   The resolved file specification will be recorded as a dependency for
   the VDE system builder through the LIB$REC_DEPENDENCY interface.
 */
        dcl vde_filename char(128) var
                        init ('');      /* input source file name */
        dcl vde_input_file file variable static;
        dcl vde_in_file pointer initial(addr(vde_input_file));
        dcl vde_in_file_ptr pointer based (vde_in_file);
        dcl vde_esa_area char(120) static;
        dcl vde_addr_esa_area pointer initial(addr(vde_esa_area));
        dcl vde_rsa_area char(120) static;
        dcl vde_addr_rsa_area pointer initial(addr(vde_rsa_area));

        dcl vde_full_name pointer;
        dcl vde_result_name char(132) based (vde_full_name) ;

 
/*** main ***/

/* Set up file structures for receiving the fully resolved language specific
   output file from the open call. The fully resolved output file, file
   specification is passed back to the front end through the variable
   vde_lang_file which is declared in the shared data area (SDLSHR.SDL).
*/
        vde_input_file = output_file;
        vde_in_file_ptr->nam$l_esa = vde_addr_esa_area;
        vde_in_file_ptr->nam$b_ess = 120;
        vde_in_file_ptr->nam$l_rsa = vde_addr_rsa_area;
        vde_in_file_ptr->nam$b_rss = 120;
	
/* 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 ) );
	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_full_name = vde_in_file_ptr->nam$l_rsa;
        vde_filename = vde_result_name;
	vde_lang_file = substr( vde_result_name, 1, vde_in_file_ptr->nam$b_rsl);
 
/** 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 20;
%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) &
		    (p->nod$a_typeinfo2 ^= null() &
		    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 (22) 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'
	);

dcl unsigned_opcode (22) 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'
	);

dcl context_flag (22) 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);

dcl context_string(22) 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',
	''
	);

/* 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;