###############################################################################
#
#	File:     sig_out.icn
#
#	Subject:  russell language support procedures
#
#	Author:   Dennis J Darland
#
#	Date:     October - Novmber, 2015
#
###############################################################################
#
# Copyright 1986-1989 Hans-Juergen Boehm, Alan J. Demers, Kumar Srikantan,
# Vernon Lee, and Lucy Hederman.
# Copyright Digital Equipment Corporation & INRIA 1988, 1989.
# Copyright (c) 1990-1993 by Xerox Corporation.  All rights reserved.
#
# This material is provided as is, with no warranty expressed or implied.
# Any use is at your own risk.
#
# Permission is hereby granted to copy this compiler for any non-commercial
# purpose, provided the above notices are retained on all copies.  Further
# restrictions apply to the DEC/INRIA BigNum package.  These are stated in
# the file runtime/BigNum/doc/bnbody.tex.
#
# This work uses the BigNum package developed jointly by INRIA and
# Digital PRL.  It has been modified by Hans-J. Boehm in August 1990
# and February 1993 at Xerox PARC.  When you receive this software,
# please send mail to librarian@prl.dec.com to inform them that you
# have a copy of the package.
###############################################################################
#
#   NOTE From Dennis J. Darland (11/2/2015)
#
#   I obtained the "c" language source code for "russell" copyrighted above
#   in the 1990's. I have made efforts to get it to work over the years, but
#   always failed. It has many hardware and OS dependancies. Now (October 2015
#   forward, I am tring to port to the language "Unicon". Practically every
#   line of code will need to be changed, as someing as simple as the
#   assignment operator is different. Also I will not use the BigNum package
#   mentioned above. Also I am doing this not for profit, and am sharing
#   freely. I am not at all confident that I will get it working well, but
#   believe in open source, so am sharing my work as I make progress.
#   Unicon is also much more portable.
#
###############################################################################

$include "defs.icn"
$include "global_vars.icn"
#DJDSTOP
# # define TRACE_DECL
# # undef TRACE_DECL
# 
# /* Routines to write out a signature and optimization information */
# 
# # ifdef TRACE_DECLT
# #   define IFTRACE_DECL(x) x
# # else
# #   define IFTRACE_DECL(x)
# # endif
# 
# # define EXTERN_LIMIT 5   /* Maximum number of nested extern { ... } 's */
# 
# /* This assumes that putw can write a pointer */
# 
# # include "parm.h"
# # include <stdio.h>
# # include "stree/ststructs.mh"
# # include "pass3/is_local.h"
# 
# extern boolean Gflag;
# 
# extern FILE * unparse_file;
# 
# static NODE * Outer_arg;
# 
# struct decl_entry {
#     NODE * de_decl;
#     int de_number;
#     struct decl_entry * de_next;
# } *decl_nums;       /* list of declaration nodes and corresponding numbers */
#                     /* This is a silly data structure, but the list is     */
#                     /* unlikely to have length > 1                         */
# 
# static int decl_num = 0;  /* last number assigned to a declaration */
# 
# /* Add a new declartion to decl_nums.  Assign it the next available number */
# # define add_decl(decl) { \
#     struct decl_entry * o = (struct decl_entry *) \
#     				malloc(sizeof (struct decl_entry)); \
#     o -> de_number = (++decl_num); \
#     o -> de_decl = decl; \
#     o -> de_next = decl_nums; \
#     decl_nums = o; \
# }
# 
# # define NONE -1
# 
# /* Get the number associated with decl.  Return NONE if there isn't any */
# static get_decl_num(decl)
# NODE * decl;
# {
#     struct decl_entry *p = decl_nums;
# 
#     while (p != NIL ) {
#         if (decl -> pre_num == p -> de_decl -> pre_num) return(p -> de_number);
#         p = p -> de_next;
#     }
#     return(NONE);
# }
# 
# void sig_out1();
# 
# /* Write a 0 terminated string onto Soutfile.
#  * A NIL pointer is represented as a string consisting of a single FF
#  * (delete) character
#  */
# put_string(Soutfile, s)
# FILE * Soutfile;
# char * s;
# {
#     if (s == NIL) {
#         putc(0xff, Soutfile);
#     } else {
#         fputs(s, Soutfile);
#     }
#     putc(0, Soutfile);
# }
# 
# /* Identifiers are written out as
#  *              kind
#  *              representation kind
#  *              selection expression (if any)
#  *              declaration number (local) or address (global)
#  *                                 (not used for selection)
#  *              name (0 terminated string, empty if local type id)
#  *
#  * The following options exist for the representation kind field:
#  */
# # define LOCALREP  0
# # define GLOBALREP 1
# # define SELECTREP 2
# 
# /* Write out an identifier */
# put_name(Soutfile, p)
# register NODE *p;
# FILE *Soutfile;
# {
#     int string_index;
#     char * name;
#     int rep;
#     int dn;
# 
# #   ifdef DEBUG
#         if(p -> kind != LETTERID && p -> kind != OPRID) {
#             dbgmsg("put_name: bad identifier\n");
#         }
# #   endif
#     putw(p -> kind, Soutfile);
#     if (p -> sel_type != NIL) {
#         rep = SELECTREP;
#     } else {
#         if (p -> id_last_definition != NIL
#             && (dn = get_decl_num(p -> id_last_definition)) != NONE) {
#             rep = LOCALREP;
#         } else {
#             rep = GLOBALREP;
#         }
#     }
#     putw(rep, Soutfile);
# #   ifdef TRACE_DECL
# 	printf("put_name: identifier: %s; index: %d",
# 	       (p -> id_str_table_index == -1? "(anon)"
# 		: get_name(p -> id_str_table_index)),
# 	       p -> id_str_table_index);
# #   endif
#     switch(rep) {
#         case SELECTREP:
#             sig_out1(Soutfile, p -> sel_type);
# #           ifdef TRACE_DECL
# 		printf(" (selected)\n");
# #           endif
#             break;
#         case GLOBALREP:
#             putw(p -> id_last_definition, Soutfile);
# #           ifdef TRACE_DECL
# 		printf(" (global)\n");
# #           endif
#             break;
#         case LOCALREP:
#             putw(dn, Soutfile);
# #           ifdef TRACE_DECL
# 		printf(" (declaration: %d; pre_num: %d)\n", dn,
# 		       p -> id_last_definition -> pre_num);
# #           endif
#             break;
#     }
#     string_index = p -> id_str_table_index;
# #   ifdef DEBUG
#         if (string_index <= -2) {
#             dbgmsg("put_name: funny id name: %X\n", string_index);
#         }
# #   endif
#     if (string_index == -1) {
#         /* local type id is represented as empty string */
#         putc(0, Soutfile);
#     } else {
#         put_string(Soutfile, get_name(string_index));
#     }
# }
# 
# /* Write a representation of the expression tree headed by p onto Soutfile */
# /* This is the same representation used by sig_in.  It is designed to be   */
# /* relatively efficient.  Local identifiers are represented by the number  */
# /* of their declaration.  Such numbers are assigned in preorder fashion.   */
# /* Globally declared identifiers are saved as character strings.           */
# void sig_out(Soutfile, p)
# register NODE * p;
# FILE * Soutfile;
# {
#     decl_nums = NIL;
#     Outer_arg = p;
#     sig_out1(Soutfile, p);
# }
# 
# void sig_out1(Soutfile, p)
# register NODE * p;
# FILE * Soutfile;
# {
# register NODE * v;
# 
#     if (p == NIL) {
#         putw(-1, Soutfile);
#         return TRUE;
#     }
# 
#     switch ( p -> kind ) {
# 
#         case DECLARATION:
#                 putw(DECLARATION, Soutfile);
#                 /* write representation of identifier */
# 		  put_name(Soutfile, p -> decl_id);
# 		putw(p -> decl_sig_transp, Soutfile);
#                 sig_out1(Soutfile, p -> decl_signature);
#                 sig_out1(Soutfile, p -> decl_denotation);
#                 break;
# 
#         case BLOCKDENOTATION:
#                 putw(BLOCKDENOTATION, Soutfile);
#                 maplist(v, p -> bld_declaration_list, {
#                     add_decl(v);
# 		    IFTRACE_DECL(
# 			printf("Declaration: %s, decl: %d\n",
# 				get_name(v -> decl_id -> id_str_table_index),
# 				decl_num);
# 		    )
#                 });
#                 putw(length(p -> bld_declaration_list), Soutfile);
#                 maplist(v, p -> bld_declaration_list, {
#                     sig_out1(Soutfile, v);
#                 });
#                 putw(length(p -> bld_den_seq), Soutfile);
#                 maplist(v, p -> bld_den_seq, {
#                     sig_out1(Soutfile, v);
#                 });
# 		break;
# 
#         case APPLICATION:
#                 putw(APPLICATION, Soutfile);
#                 sig_out1(Soutfile, p -> ap_operator);
#                 putw(length(p -> ap_args), Soutfile);
#                 maplist(v, p -> ap_args, {
#                     sig_out1(Soutfile, v);
#                 });
# 		break;
# 
#         case LOOPDENOTATION:
#         case GUARDEDLIST:
#                 putw(p -> kind, Soutfile);
#                 putw(length(p -> gl_list), Soutfile);
#                 maplist(v, p -> gl_list, {
#                     sig_out1(Soutfile, v);
#                 });
# 		break;
# 
#         case GUARDEDELEMENT:
#                 putw(GUARDEDELEMENT, Soutfile);
#                 sig_out1(Soutfile, p->ge_guard);
#                 sig_out1(Soutfile, p->ge_element);
# 		break;
# 
#         case OPRID:
# 	case LETTERID:
# #               ifdef DEBUG
# 		    if (!p -> id_def_found) {
# 			dbgmsg("Sig_out: unresolved identifier reference\n");
# 			abort(p);
# 		    }
# #               endif
# 		if (p -> sel_type == NIL
# 		    && p -> id_last_definition != NIL
# 		    && p -> id_last_definition -> kind == DECLARATION
# 		    && p -> id_last_definition -> decl_sig_transp) {
# #                       ifdef TRACE_DECL
# 			    printf("Writing out ");
# 			    unparse_file = stdout;
# 			    unparse(p -> id_last_definition -> decl_denotation);
# 			    printf("instead of identifier ");
# 			    unparse(p);
# 			    printf("\n");
# #                       endif
# 			sig_out1(Soutfile,
# 				 p -> id_last_definition -> decl_denotation);
# 		} else {
# 		    put_name(Soutfile, p);
# 		}
#                 break;
# 
#         case FUNCCONSTR:
#                 putw(FUNCCONSTR, Soutfile);
#                 sig_out1(Soutfile, p -> signature);
#                 sig_out1(Soutfile, p -> fc_body);
#                 break;
# 
#         case USELIST:
#                 putw(USELIST, Soutfile);
#                 putw(length(p -> usl_type_list), Soutfile);
#                 maplist(q, p -> usl_type_list, {
#                     sig_out1(Soutfile, q);
#                 });
#                 putw(length(p -> usl_den_seq), Soutfile);
#                 maplist(q, p -> usl_den_seq, {
#                     sig_out1(Soutfile, q);
#                 });
# 		break;
# 
#         case MODPRIMARY:
#                 if (p -> mp_type_modifier == NIL) {
#                     /* forgetting is unimportant here */
#                         sig_out1(Soutfile, p -> mp_primary);
#                 } else {
# 		    add_decl(p);
# #                   ifdef TRACE_DECL
# 			printf("Modified type: decl: %d\n",
# 				decl_num);
# #                   endif
#                     putw(MODPRIMARY, Soutfile);
#                     sig_out1(Soutfile, p -> mp_primary);
#                     sig_out1(Soutfile, p -> mp_type_modifier);
#                 }
#                 break;
# 
#         case QSTR:
#         case UQSTR:
#                 if (p -> str_expansion == NIL) {
#                     sig_out1(Soutfile, expand_str(p));
#                 } else {
#                     sig_out1(Soutfile, p -> str_expansion);
#                 }
#                 break;
# 
# 	case PRODCONSTRUCTION:
#         case UNIONCONSTRUCTION:
#                 add_decl(p);
# #               ifdef TRACE_DECL
# 		    printf("Type construction: decl: %d\n",
# 			    decl_num);
# #               endif
#                 putw(p -> kind, Soutfile);
#                 sig_out1(Soutfile, p -> prod_local_type_id);
#                 putw(length(p -> prod_components), Soutfile);
#                 maplist(s, p -> prod_components, {
#                     sig_out1(Soutfile, s);
#                 });
# 		break;
# 
# 	case WORDELSE:
#                 putw(WORDELSE, Soutfile);
# 		break;
# 
#         case PARAMETER:
#                 putw(PARAMETER, Soutfile);
#                 sig_out1(Soutfile, p -> par_id);
#                 sig_out1(Soutfile, p -> par_signature);
#                 break;
# 
#         case FUNCSIGNATURE:
#                 /* Try to fill in in-line code, if not already there */
#                     if (p -> fsig_inline_code == NIL
#                         && p -> fsig_construction != NIL) {
#                         p -> fsig_inline_code = p -> fsig_construction
#                                                   -> signature
#                                                   -> fsig_inline_code;
#                     }
#                 putw(FUNCSIGNATURE, Soutfile);
# 		putw(p -> fsig_special, Soutfile);
# 		if (Gflag) {
# 		    put_RIC(p -> fsig_inline_code, Soutfile);
# 		} else {
# 		    put_string(Soutfile, p -> fsig_inline_code);
# 		}
#                 /* Add parameters to declaration list */
#                     maplist(s, p -> fsig_param_list, {
#                         add_decl(s);
# 			IFTRACE_DECL(
# 			    printf("Parameter: %s, decl: %d\n",
# 				   (s -> par_id == NIL? "(anon)" :
# 				    get_name(s -> par_id -> id_str_table_index)),
# 				   decl_num);
# 			)
# 		    });
#                 putw(length(p -> fsig_param_list), Soutfile);
#                 maplist(s, p -> fsig_param_list, {
#                     sig_out1(Soutfile, s);
# 		});
#                 sig_out1(Soutfile, p -> fsig_result_sig);
#                 /* Preserve info about function construction if available */
# #                   define CONSTR_UNKNOWN 0
# #                   define CONSTR_AVAIL 1
# #                   define SLINK_AVAIL 2
#                     if (p -> fsig_construction == NIL) {
#                         putw(CONSTR_UNKNOWN, Soutfile);
#                     } else {
#                       NODE * constr = p -> fsig_construction;
# 
#                       if (p -> fsig_slink_known) {
#                         putw(SLINK_AVAIL, Soutfile);
#                       } else {
#                         putw(CONSTR_AVAIL, Soutfile);
# 		      }
# 		      putw(constr -> fc_complexity, Soutfile);
# #                     ifdef VERBOSE
# 			unparse_file = stdout;
# 			printf("Signature: ");
# 			unparse(p);
# 			printf(" bound to construction %s\n",
# 			       constr -> fc_code_label);
# #                     endif
#                       put_string(Soutfile, constr -> fc_code_label);
# 		      putw(constr -> ar_static_level, Soutfile);
# 		      putw(constr -> ar_size, Soutfile);
# 		    }
#                 break;
# 
#         case VALSIGNATURE:
#                 putw(VALSIGNATURE, Soutfile);
#                 sig_out1(Soutfile, p -> val_denotation);
#                 break;
# 
#         case VARSIGNATURE:
#                 putw(VARSIGNATURE, Soutfile);
#                 sig_out1(Soutfile, p -> var_denotation);
# 		break;
# 
# 	case SIGNATURESIG:
# 		putw(SIGNATURESIG, Soutfile);
# 		break;
# 
#         case TYPESIGNATURE:
#                 add_decl(p);
# #               ifdef TRACE_DECL
# 		    printf("Type signature: decl: %d\n",
# 			   decl_num);
# 		    unparse_file = stdout;
# 		    unparse(p);
# 		    printf("\n");
# #               endif
#                 putw(TYPESIGNATURE, Soutfile);
#                 sig_out1(Soutfile, p -> ts_local_type_id);
#                 putw(length(p -> ts_clist), Soutfile);
#                 maplist(s, p -> ts_clist, {
#                     sig_out1(Soutfile, s);
#                 });
#                 /* preserve optimization information: */
#                     put_string(Soutfile, p -> ts_const_code);
#                     put_string(Soutfile, p -> ts_string_code);
# 		    put_string(Soutfile, p -> ts_element_code);
# 		    putw(p -> ts_string_max, Soutfile);
# 		    putw(p -> ts_simple_type, Soutfile);
# #               ifdef TRACE_DECL
# 		    printf("Finished type signature\n");
# #                   endif
#                 break;
# 
#         case TSCOMPONENT:
#                 putw(TSCOMPONENT, Soutfile);
#                 sig_out1(Soutfile, p -> tsc_id);
#                 sig_out1(Soutfile, p -> tsc_signature);
#                 break;
# 
#         case DEFCHARSIGS:
#                 {
#                     int i;
#                     unsigned * base = &(p -> dcs_0);
# 
#                     putw(DEFCHARSIGS, Soutfile);
#                     for(i = 0; i < NVECTORS; i++) {
#                         putw(base[i], Soutfile);
#                     }
#                 }
# 		break;
# 
# 	case REXTERNDEF:
# 		putw(REXTERNDEF, Soutfile);
# 		put_string(Soutfile, p -> r_ext_name);
# 		break;
# 
#         case RECORDCONSTRUCTION:
#         case EXTENSION:
#         case ENUMERATION:
#         case RECORDELEMENT:
#         case WITHLIST:
#         case EXPORTLIST:
#         case HIDELIST:
#         case EXPORTELEMENT:
# 		dbgmsg("Signature output can't handle %s yet\n",
#                        kindname(p -> kind));
#                 break;
# 
#         case LISTHEADER:
#         case FREEVARNODE:
#         case WORDCAND:
#         case WORDCOR:
#         case EXTERNDEF:
# 	default:
#                 dbgmsg("sig_out: bad kind, kind = %d\n", p -> kind);
# 		abort();
# 
#     };
#     return TRUE;
# }
# #DJDSTART

class decl_entry (de_decl,de_number,de_next)
       # list of declaration nodes and corresponding numbers
                    # This is a silly data structure, but the list is
                    # unlikely to have length > 1

end
# Add a new declartion to decl_nums.  Assign it the next available number
procedure add_decl(decl)
local o
decl_num +:= 1
    o := decl_entry(decl,decl_num,decl_nums)
    decl_nums := o
end

$define NONE -1

# Get the number associated with decl.  Return NONE if there isn't any
procedure get_decl_num(decl)
local p
    p := decl_nums

    while (\p ) do {
        if (decl.pre_num = p.de_decl.pre_num) then return(p.de_number)
        p := p.de_next
    }
    return(NONE)
end

# procedure sig_out1()

# Write a 0 terminated string onto Soutfile.
# A NIL pointer is represented as a string consisting of a single FF
# (delete) character
#
procedure put_string(Soutfile, s)
Soutfile |||:= s
end

# Identifiers are written out as
 #              kind
 #              representation kind
 #              selection expression (if any)
 #              declaration number (local) or address (global)
 #                                 (not used for selection)
 #              name (0 terminated string, empty if local type id)
 #
 # The following options exist for the representation kind field:
 #
$define LOCALREP  0
$define GLOBALREP 1
$define SELECTREP 2

# Write out an identifier
procedure put_name(Soutfile, p)

    local string_index, name,  rep, dn
    Soutfile |||:= p.kind
    if (\p.sel_type) then {
        rep := SELECTREP
    } else {
        if (\p.id_last_definition &
	    (dn := get_decl_num(p.id_last_definition)) ~= NONE) then {
		rep := LOCALREP
	    } else {
		rep := GLOBALREP
	    }
    }
    Soutfile |||:= rep
    case (rep) of {
	SELECTREP:
            sig_out1(Soutfile, p.sel_type)
	GLOBALREP:
	    Soutfile |||:= p.id_last_definition
	LOCALREP:
	    Soutfile |||:= dn
    }
    string_index := p.id_str_table_index
    if (string_index == -1) then {
        # local type id is represented as empty string
        Soutfile |||:= ""
    } else {
        put_string(Soutfile, get_name(string_index))
    }
end

# Write a representation of the expression tree headed by p onto Soutfile
# This is the same representation used by sig_in.  It is designed to be
# relatively efficient.  Local identifiers are represented by the number
# of their declaration.  Such numbers are assigned in preorder fashion.
# Globally declared identifiers are saved as character strings.
procedure sig_out(Soutfile, p)
    decl_nums := nil
    Outer_arg := p
    sig_out1(Soutfile, p)
end

procedure  sig_out1(Soutfile, p)
local v,temp

if (/p) then {
    putw(-1, Soutfile);
    return TRUE
}

case ( p.kind ) of {
    DECLARATION: {
	putw(DECLARATION, Soutfile)
	# write representation of identifier
	put_name(Soutfile, p.decl_id)
	putw(p.decl_sig_transp, Soutfile)
	sig_out1(Soutfile, p.decl_signature)
	sig_out1(Soutfile, p.decl_denotation)
    }
    BLOCKDENOTATION: {
	putw(BLOCKDENOTATION, Soutfile)
	temp := p.bld_declaration_list
	while \temp do {
	    v := temp.cn_hd_field
	    add_decl(v)
	    temp := temp.cn_tl_field
	}
	putw(length(p -> bld_declaration_list), Soutfile)

	temp := p.bld_declaration_list
	while \temp do {
	    v := temp.cn_hd_field
	    sig_out1(Soutfile, v);
	    temp := temp.cn_tl_field
	}
	putw(length(p.bld_den_seq), Soutfile)
	temp := p.bld_den_seq
	while \temp do {
	    v := temp.cn_hd_field
	    sig_out1(Soutfile, v)
	    temp := temp.cn_tl_field
	}
    }
    APPLICATION: {
	putw(APPLICATION, Soutfile)
	sig_out1(Soutfile, p.ap_operator)
	putw(length(p.ap_args), Soutfile)
	temp := p.ap_rgs
	while \temp do {
	    v := temp.cn_hd_field
	    sig_out1(Soutfile, v)
	    temp := temp.cn_tl_field
	}
    }
    LOOPDENOTATION:  {
	putw(p.kind, Soutfile)
	putw(length(p.gl_list), Soutfile)
	temp := p.gl_list
	while \temp do {
	    v := temp.cn_hd_field
	    sig_out1(Soutfile, v);
	    temp := temp.cn_tl_field
	}
    }
    GUARDEDLIST: {
	putw(p.kind, Soutfile)
	putw(length(p.gl_list), Soutfile)
	temp := p.gl_list
	while \temp do {
	    v := temp.cn_hd_field
	    sig_out1(Soutfile, v);
	    temp := temp.cn_tl_field
	}
    }
    GUARDEDELEMENT: {
	putw(GUARDEDELEMENT, Soutfile);
	sig_out1(Soutfile, p.ge_guard);
	sig_out1(Soutfile, p.ge_element);
    }
    OPRID: {
	if ((/p.sel_type) &
	    \ (p.id_last_definition) &
	    (p.id_last_definition.kind = DECLARATION) &
	    (\p.id_last_definition.decl_sig_transp)) then {
		sig_out1(Soutfile,
			 p.id_last_definition.decl_denotation)
	    } else {
		put_name(Soutfile, p)
	    }
    }
    LETTERID: {
	if ((/p.sel_type) &
	    \ (p.id_last_definition) &
	    (p.id_last_definition.kind = DECLARATION) &
	    (\p.id_last_definition.decl_sig_transp)) then {
		sig_out1(Soutfile,
			 p.id_last_definition.decl_denotation)
	    } else {
		put_name(Soutfile, p)
	    }
    }
    FUNCCONSTR: {
	putw(FUNCCONSTR, Soutfile)
	sig_out1(Soutfile, p.signature)
	sig_out1(Soutfile, p.fc_body)
    }
    USELIST: {
	putw(USELIST, Soutfile)
	putw(length(p.usl_type_list), Soutfile)
	temp := p.usl.den_seq
	while \temp do {
	    v := temp.cn_hd_fiel
	    sig_out1(Soutfile, v)
	    temp := temp.cn_tl_field
	}
	putw(length(p.usl_den_seq), Soutfile)
	temp := p.usl_den_seq
	while \temp do {
	    v := temp.cn_hd_fiel
	    sig_out1(Soutfile, v)
	    temp := temp.cn_tl_field
	}
    }
    MODPRIMARY: {
	if (/p.mp_type_modifier) then {
	    # forgetting is unimportant here
	    sig_out1(Soutfile, p.mp_primary);
	} else {
	    add_decl(p)
	    putw(MODPRIMARY, Soutfile)
	    sig_out1(Soutfile, p.mp_primary)
	    sig_out1(Soutfile, p.mp_type_modifier)
	}
	    }

    QSTR: {
	     if (/p.str_expansion) then {
		 sig_out1(Soutfile, expand_str(p))
	     } else {
		 sig_out1(Soutfile, p.str_expansion)
	     }
	 }

    UQSTR: {
	if (/p.str_expansion) then {
	    sig_out1(Soutfile, expand_str(p))
	} else {
	    sig_out1(Soutfile, p.str_expansion)
	}
    }

    PRODCONSTRUCTION: {
	add_decl(p)
	putw(p.kind, Soutfile)
	sig_out1(Soutfile, p.prod_local_type_id)
	putw(length(p.prod_components), Soutfile)
	temp := p.prod_components
	while \temp do {
	    v := temp.cn_hd_field
	    sig_out1(Soutfile, v)
	    temp := temp.cn_tl_field
	}
    }
    UNIONCONSTRUCTION: {
	add_decl(p)
	putw(p.kind, Soutfile)
	sig_out1(Soutfile, p.prod_local_type_id)
	putw(length(p.prod_components), Soutfile)
	temp := p.prod_components
	while \temp do {
	    v := temp.cn_hd_field
	    sig_out1(Soutfile, v)
	    temp := temp.cn_tl_field
	}
    }
    WORDELSE: {
	putw(WORDELSE, Soutfile)
    }
    PARAMETER: {
	putw(PARAMETER, Soutfile)
	sig_out1(Soutfile, p -> par_id)
	sig_out1(Soutfile, p -> par_signature)
    }
    FUNCSIGNATURE: {
	# Try to fill in in-line code, if not already there
	if ((/p.fsig_inline_code ) &
	    (\fsig_construction)) then {
		p.fsig_inline_code := p.fsig_construction.signature.fsig_inline_code
	    }
	putw(FUNCSIGNATURE, Soutfile)
	putw(p.fsig_special, Soutfile)
	if (Gflag) then {
	    put_RIC(p.fsig_inline_code, Soutfile);
	} else {
	    put_string(Soutfile, p.fsig_inline_code)
	}
	# Add parameters to declaration list
	temp := p.fsig_param_list
	while \temp do {
	    v := temp.cn_hd_field
	    add_decl(v);
	    temp := temp.cn_tail_field
	}
	putw(length(p.fsig_param_list), Soutfile)
	temp := p.fsig_param_list
	while \temp do {
	    v := temp.cn_hd_field
	    sig_out1(Soutfile, v)
	    temp := temp.cn_tl_field
	}
	sig_out1(Soutfile, p.fsig_result_sig)
    # Preserve info about function construction if available
#                   define CONSTR_UNKNOWN 0
#                   define CONSTR_AVAIL 1
#                   define SLINK_AVAIL 2
    if (/(p.fsig_construction)) then {
	putw(CONSTR_UNKNOWN, Soutfile)
    } else {
	constr := p.fsig_construction
	if (p.fsig_slink_known) then {
	    putw(SLINK_AVAIL, Soutfile)
	} else {
	    putw(CONSTR_AVAIL, Soutfile)
	}
	putw(constr.fc_complexity, Soutfile)
	put_string(Soutfile, constr.fc_code_label)
	putw(constr.ar_static_level, Soutfile)
	putw(constr.ar_size, Soutfile)
    }
    }
    VALSIGNATURE: {
	putw(VALSIGNATURE, Soutfile);
	sig_out1(Soutfile, p.val_denotation);
    }
    VARSIGNATURE: {
	putw(VARSIGNATURE, Soutfile)
	sig_out1(Soutfile, p.var_denotation)
    }
    SIGNATURESIG: {
	putw(SIGNATURESIG, Soutfile)
    }
    TYPESIGNATURE: {
	add_decl(p)
	putw(TYPESIGNATURE, Soutfile)
	sig_out1(Soutfile, p.ts_local_type_id)
	putw(length(p.ts_clist), Soutfile)
	temp := p.ts.clist
	while \temp do {
	    v := temp.cn_hd_field
	    sig_out1(Soutfile, v);
	    temp := temp.cn_tl_field
	}
    # preserve optimization information:
	put_string(Soutfile, p.ts_const_code)
	put_string(Soutfile, p.ts_string_code)
	put_string(Soutfile, p.ts_element_code)
	putw(p.ts_string_max, Soutfile)
	putw(p.ts_simple_type, Soutfile)
    }
    TSCOMPONENT: {
	putw(TSCOMPONENT, Soutfile)
	sig_out1(Soutfile, p.tsc_id)
	sig_out1(Soutfile, p.tsc_signature)
    }
    DEFCHARSIGS:
	{
	    rpt_err("sig_out: DEFCHARSIG not implementer")
#DJDSTOP
# 	    int i;
# 	    unsigned * base = &(p -> dcs_0);
# 
# 	    putw(DEFCHARSIGS, Soutfile);
# 	    for(i = 0; i < NVECTORS; i++) {
# 		putw(base[i], Soutfile);
# 	    }
# #DJDSTART
	}

    REXTERNDEF: {
	putw(REXTERNDEF, Soutfile)
	put_string(Soutfile, p.r_ext_name)
    }

    RECORDCONSTRUCTION:
	{
	    rpt_err("sig_out: RECORDCONSTRUCTION not implemented yet")
	}
    EXTENSION:
	{
	    rpt_err("sig_out: EXTENSION not implemented yet")
	}
    ENUMERATION:
	{
	    rpt_err("sig_out: ENUMERATION not implemented yet")
	}
    RECORDELEMENT:
	{
	    rpt_err("sig_out: RECORDELEMENT not implemented yet")
	}
    WITHLIST:
	{
	    rpt_err("sig_out: WITHLIST not implemented yet")
	}
    EXPORTLIST:
	{
	    rpt_err("sig_out: EXPORTLIST not implemented yet")
	}
    HIDELIST:
	{
	    rpt_err("sig_out: HIDELIST not implemented yet")
	}
    EXPORTELEMENT:
	{
	    rpt_err("sig_out: EXPORTELEMENT not implemented yet")
	}
    LISTHEADER:
	{
	    rpt_err("sig_out:BAD KIND LISTHEADER")
	}
    FREEVARNODE:
	{
	    rpt_err("sig_out:BAD KIND LISTHEADER")
	}
    WORDCAND:
	{
	    rpt_err("sig_out:BAD KIND LISTHEADER")
	}
    WORDCOR:
	{
	    rpt_err("sig_out:BAD KIND LISTHEADER")
	}
    EXTERNDEF:
	{
	    rpt_err("sig_out:BAD KIND LISTHEADER")
	}

    default:
	{
	    rpt_err("sig_out:BAD KIND LISTHEADER")
	}
}
return TRUE
end
procedure    putw(w , Soutfile)
    Soutfile |||:= w
return TRUE
end
