###############################################################################
#
#	File:     add_id.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"

#
#
#  add_id(defnode, scopenode);
#  NODE# defnode, scopenode;
#
#  defnode   - Definition node.
#  scopenode - The root of the subtree for which this definition is valid.
#
#  Add the new definiton of the id to the symbol table and adjust Idtable.
#  The basic operations are:
#      idnode.last_definition = defnode (local type ids only)
#      idnode.use_list = current use list
#      defnode.previous_definition = previous definition (from Idtable)
#      Update Idtable
#      if declaration or parameter, defnode.scope = scopenode
#
#  Nothing is done if idnode is NIL, e.g. in the case of anonymous 
#  parameters.
#

# include "parm.h"
# include "pass1/stt/sttdefs.h"
# include "stree/ststructs.mh"
# include "Idtable.h"

# extern NODE * usl_ptr;


# Identry * retrieve();

procedure add_id(defnode_orig, scopenode)
    local defnode
    write(sym2file,"Top add_id defnode_orig")
    if \defnode_orig then
	defnode_orig.dump(sym2file)
    else     write(sym2file,"defnode_orig NIL")
    if \scopenode then
	scopenode.dump(sym2file)
    else     
	write(sym2file,"scopenode NIL")
    if /defnode then 
	{
	    write(sym2file,"add_id defnode nil")
	    return TRUE
	}
    else 
	if not(has_field(defnode_orig,"kind")) then 
	    {
		defnode := defnode_orig.cn_hd_field
	    }
	else
	    defnode := denode_orig 
    findfields(defnode)
    # update scope fields and set last_definition for local type ids */
	case (defnode.kind) of 
	    {
	    DECLARATION:
		defnode.decl_scope := scopenode
	    PARAMETER:
		defnode.par_scope := scopenode
	    default:
		if (\idnode) then idnode . id_last_definition := defnode
	}    
    if (/idnode) then 
	return TRUE
    idnode.id_use_list := usl_ptr
    ip := retrieve(idnode.id_str_table_index)
    prevdef_field := ip.i_value
    ip.i_value := defnode
end
#
#  Given a definition node for an identifier,
#
#  set 
#     idnode to point to the identifier node for the declareed identifier
#     prevdef_field to the address of the field pointing to an enclosing
#          declaration.
#

procedure findfields(defnode)
    case (defnode.kind) of {
	DECLARATION:
	    {
                idnode := defnode.decl_id;
                prevdef_field := defnode.decl_previous_definition
	    }
	PARAMETER:
	    {
                idnode := defnode.par_id
                prevdef_field = defnode.par_previous_definition
	    }
	TYPESIGNATURE:
	    {        
		idnode := defnode.ts_local_type_id;
		prevdef_field := defnode.ts_previous_definition
	    }
	UNIONCONSTRUCTION:
	    {
		idnode := defnode.prod_local_type_id
		prevdef_field = defnode.prod_previous_definition
	    }
	PRODCONSTRUCTION:
	    {
		idnode := defnode.prod_local_type_id
		prevdef_field = defnode.prod_previous_definition
	    }
	MODPRIMARY:
	    {
		modifier := defnode . mp_type_modifier
		
		case (modifier . kind) of {
		    WITHLIST:
			{
                            idnode := modifier.wl_local_type_id
                            prevdef_field := modifier.wl_previous_definition
			}
		    EXPORTLIST:
			{
			    idnode := modifier.el_local_type_id
			    prevdef_field := modifier.el_previous_definition
			}
		    HIDELIST:
			{
			    idnode := modifier.el_local_type_id
			    prevdef_field := modifier.el_previous_definition
			}
		}
	    }
	default:
	    yyinfo("add_id: bad defnode:" || dump_info(defnode.kind))
    }
end

procedure list_ids(str)
    if /idnode
    then write(sym2file,"Symbol 2 Table Empty at " || str)
    else {
	write(sym2file,"Begin Symbol 2 Table at " || str)
	temp := idnode
	while \temp do {
	    temp.dump(sym2file)
	    temp := temp.id_last_definition
	}
	write(sym2file,"End Symbol 2 Table at " || str)
    }
end
    
    
