$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;
#     }
# 
#     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;
# }
# #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;
    }

    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
end
procedure    putw(w , Soutfile)
    Soutfile |||:= w
end