Subject: Re: front end 1.61

From: Zheng Gengbin <[email-masked]>
Date: Sat, 28 Sep 1996 08:59:27 +0800 (EAT)

On Thu, 26 Sep 1996, Guansong Zhang wrote:

> On Sep 26, 10:05am, Zheng Gengbin wrote:
> > Subject: Re: front end 1.61
> > On Wed, 25 Sep 1996, Guansong Zhang wrote:
> >
> > > I just merged the change in 1.60 from pku and hpf2dep change from lxy, and
> a
> > > little update in unparse by me. fortunately three parts in different dir.
> > >
> > > The new version as 1.61 is ready. But I don't know how to send it to pku, I
> > > will try this week end, maybe that time the network is better.
> > >
> >
> >
> >
> > 	Maybe we can try it by mail again .
> >
> >
> >
> >
> > Zheng
> >-- End of excerpt from Zheng Gengbin
> 
> Please give me your modification in hpfsc first, I will try to send it later.

	Here , I attached the file I modified : link.c .

Zheng

/*****************************************************************************

		link.c  --- link dep files

written by  Zheng Gengbin , Yan Mi
           Peking University , P.R.C
*****************************************************************************/

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

#if defined(STDC_HEADERS) && (STDC_HEADERS==1)
#include <stdlib.h>
#include <string.h>
#else
#include <strings.h>
#endif

#include <stdio.h>

#   include "typedef.h"
#   include "bif.h"
#   include "ll.h"
#   include "symb.h"
#include "defnodes.h"
#include "dep.h"
#include "dep_struct.h"
#include "tags.h"
#include "decl.h"

#include "exglobal.h"

static int free_blob(blob)
PTR_BLOB blob;
{
	PTR_BLOB p;

        while (blob) {
                p=blob->next;
                free(blob);
                blob=p;
        }
}

/*---------------------------------------------------------------------------
		merge utility , include
	merge_bfnd()
	merge_llnd()
	merge_symb()
	merge_type()
*--------------------------------------------------------------------------*/

int merge_bfnd(fi,tmp_fi)
PTR_FILE fi,tmp_fi;
{
	PTR_BLOB last_blob,blob;
	PTR_BFND last_bfnd,bfnd;
	int	no=1;

	for (last_blob=fi->head_bfnd->entry.Template.bl_ptr1; last_blob->next;
		last_blob=last_blob->next);
	last_blob->next=tmp_fi->head_bfnd->entry.Template.bl_ptr1;

	for (last_bfnd=fi->head_bfnd; last_bfnd->thread; 
		last_bfnd=last_bfnd->thread);
			/* jump the first global_bfnd */
	last_bfnd->thread = tmp_fi->head_bfnd->thread;  

	fi->num_bfnds += tmp_fi->num_bfnds -1;
	fi->num_blobs += tmp_fi->num_blobs ;

	no =1;
	for (bfnd=last_bfnd->thread;bfnd;bfnd=bfnd->thread)
	{
		bfnd->id = last_bfnd->id +(no++);	
	}
	fi->cur_bfnd=tmp_fi->cur_bfnd;
	fi->cur_blob=tmp_fi->cur_blob;

	/* fix control parent link */
	for (blob=tmp_fi->head_bfnd->entry.Template.bl_ptr1;blob;
		blob=blob->next)
		blob->ref->control_parent=fi->head_bfnd;
}

int merge_llnd(fi,tmp_fi)
PTR_FILE fi,tmp_fi;
{
        PTR_LLND last_llnd,llnd;
        int     no=1;

        for (last_llnd=fi->head_llnd; last_llnd->thread; last_llnd=last_llnd->thread);
        last_llnd->thread = tmp_fi->head_llnd;

        fi->num_llnds += tmp_fi->num_llnds ;

        no =1;
        for (llnd=last_llnd->thread;llnd;llnd=llnd->thread)
                llnd->id = last_llnd->id +(no++);
	fi->cur_llnd=tmp_fi->cur_llnd;
}

int merge_symb(fi,tmp_fi)
PTR_FILE fi,tmp_fi;
{
	PTR_SYMB last_symb,last_next,sym;
	int no;

	for (last_next=fi->head_bfnd->entry.Template.bl_ptr1->ref->entry.Template.symbol ; last_next->next_symb ; last_next=last_next->next_symb);
	last_next->next_symb=tmp_fi->head_symb;

	for (last_symb=fi->head_symb;last_symb->thread;last_symb=last_symb->thread);
	last_symb->thread=tmp_fi->head_symb;

	fi->num_symbs += tmp_fi->num_symbs;

	no=1;
	for (sym=tmp_fi->head_symb; sym ; sym=sym->thread) {
		sym->id = last_symb->id + (no++);
			/* global bfnd scope */
		if (sym->scope == tmp_fi->head_bfnd)
			sym->scope=fi->head_bfnd;
	}
	fi->cur_symb=tmp_fi->cur_symb;

}

int merge_type(fi,tmp_fi)
PTR_FILE fi,tmp_fi;
{
	PTR_TYPE last_type, in_type[20] , type_head , base_type, type;
	PTR_SYMB sym;
	PTR_LLND llnd;
	int   no,i,INTR_NO=global_template->id;

	last_type=fi->head_type;
	for (i=0; i<INTR_NO-1; i++) {
		in_type[i]= last_type;
		last_type=last_type->thread;
	}
	in_type[i]=last_type;

	for ( ; last_type->thread; last_type= last_type->thread);

	type_head=tmp_fi->head_type;
	for (i=0; i<INTR_NO; i++)
		type_head=type_head->thread;

	last_type->thread=type_head;
	
	no=1;
	for (type=type_head ; type; type=type->thread)
		type->id = last_type->id + (no++);
	fi->num_types += tmp_fi->num_types - INTR_NO;

		/* chage type pointer of tmp_fi */
	for (sym=tmp_fi->head_symb; sym ; sym=sym->thread) {
		type=sym->type;
		if (type)
			if (type->id <= INTR_NO)
				sym->type=in_type[type->id-1];
	}
	for (llnd=tmp_fi->head_llnd; llnd ; llnd=llnd->thread) {
                type=llnd->type;
                if (type)
                        if (type->id <= INTR_NO)
                                llnd->type=in_type[type->id-1];
        }
	for (type=type_head ; type ; type=type->thread)
		switch (type->variant) {
		case T_ARRAY:
		case T_KIND:
			base_type=type->entry.Template.base_type;
			if (base_type && base_type->id <= INTR_NO)
                               type->entry.Template.base_type=in_type[base_type->id-1];
			break;
		}

	fi->cur_type=tmp_fi->cur_type;
}

int merge_label(fi,tmp_fi)
PTR_FILE fi,tmp_fi;
{
        PTR_LABEL last_label,label;
        int     no;

	last_label=fi->head_lab;
	if (last_label)  {
        	for ( ; last_label->next; 
			last_label=last_label->next);
		/* if no label */
        	last_label->next = tmp_fi->head_lab;
	}
	else fi->head_lab=tmp_fi->head_lab;

        fi->num_label += tmp_fi->num_label ;

        no =1;
	if (last_label)
        	for (label=last_label->next;label;label=label->next)
                	label->id = last_label->id +(no++);
	fi->cur_lab=tmp_fi->cur_lab;
}

int combine_dep(fi1,fi2)
PTR_FILE fi1,fi2;
{
	PTR_BFND bfnd;
	PTR_SYMB sym;

	merge_bfnd(fi1,fi2);
	merge_llnd(fi1,fi2);
	merge_symb(fi1,fi2);
	merge_type(fi1,fi2);
	merge_label(fi1,fi2);
	
	/* set cur_bfnd of fi1 */
	bfnd=fi2->head_bfnd;
	while (bfnd) {
		if (bfnd->thread && bfnd->thread->checked==VIRTUAL_BFND) 
		{
			fi1->cur_bfnd=bfnd;
			break;
		}
		else if(bfnd->thread == BFNULL)
			fi1->cur_bfnd=bfnd;
		bfnd=bfnd->thread;
	}
	
	if (fi1->cur_bfnd->thread) {
		sym=fi2->head_symb;
		while (sym) {
			if (sym->thread && sym->thread==fi1->cur_bfnd->thread->
						entry.Template.symbol) 
			{
				fi1->cur_symb=sym;
				break;
			}
			else if (sym->thread==SMNULL)
				fi1->cur_symb=sym;
			sym=sym->thread;
		}
	}
}

int link_dep(proj)
PTR_PROJ proj;
{
	PTR_BLOB blob,first,p,r,new;
	PTR_FNAME head;

	/* rearrange the sequence */
	head=make_sequence(proj);

	r = (struct blob *) chkalloc(sizeof(struct blob));
        r->ref=(PTR_BFND)NULL;
        r->next=BLNULL;
	p=r;
	for (head=head->next; head; head=head->next) {
		new = (struct blob *) chkalloc(sizeof(struct blob));
        	new->ref=(PTR_BFND)name_in_proj(head->name,proj);
        	new->next=BLNULL;
		p->next=new;
		p=new;
	}
	free_blob(proj->file_chain);
	proj->file_chain=r->next;

	first = proj->file_chain;
	if (first==BLNULL) {
		link_error1(700);
		exit(0);
	}
	reget_type((PTR_FILE)first->ref);
	for (blob=first->next ; blob ; blob=blob->next)  {
		combine_dep((PTR_FILE)first->ref,(PTR_FILE)blob->ref);
		/* delete the redundent bfnd and symbol */
		fix_merged_dep((PTR_FILE)first->ref,(PTR_FILE)blob->ref);
	}
	check_link_dep((PTR_FILE)first->ref);
}

/*---------------------------------------------------------------------------
			fix_sym_in_module()

	find the real symbol in module and append to declared_name;
---------------------------------------------------------------------------*/
int fix_sym_in_module(fi,bfnd)
PTR_FILE fi;
PTR_BFND bfnd;
{
	PTR_BFND scope;
	PTR_SYMB sym,real_sym;

	scope=search_head_name(fi,bfnd->entry.Template.symbol->ident);
	if (scope==bfnd) {
		error3(52,bfnd->entry.Template.symbol->ident);
		return 1;
	}
	for (sym=bfnd->entry.Template.symbol->thread; sym; sym=sym->thread)
	{
		if (sym->scope != bfnd) break;
		if (sym->variant==FIELD_NAME) 
			real_sym=look_up_field(sym->ident,sym->entry.field.base_name->entry.Template.declared_name->type);
		else
			real_sym=look_up_symb_at_scope_in_hash(sym->ident,scope);
		if (real_sym==SMNULL) {
			/* link_error3(702,sym->ident); */
			insert_undef(sym);
			continue;
		}
		for (; sym->entry.Template.declared_name; sym=sym->entry.Template.declared_name);
/*
printf("fixed_sym_in_module:%s.%d %d\n",real_sym->ident,sym->id,real_sym->id);
*/
		sym->entry.Template.declared_name=real_sym;
	}
	return 0;
}

get_real_sym(fi)
PTR_FILE fi;
{
	PTR_BFND bfnd;
	
	for (bfnd=fi->cur_bfnd->thread; bfnd ; bfnd=bfnd->thread->thread)
	{
		fix_sym_in_module(fi,bfnd);
	}
}

/*   a record type defined in other module */ 
PTR_TYPE get_real_record(fi,type)
PTR_FILE fi;
PTR_TYPE type;
{
	PTR_TYPE real_type;
	PTR_SYMB sym;

	for (sym=type->name->entry.Template.declared_name;
                        sym->entry.Template.declared_name;
                        sym=sym->entry.Template.declared_name);
	real_type=sym->type;
	return real_type;
}

/* if a type defined in virtual module then return 1; else 0 */
int  record_type_is_defined_outside(type)
PTR_TYPE type;
{
	PTR_SYMB name;

	if (type == TYNULL) return 0;
	if (type->variant != T_RECORD ) return 0;
	name=type->name;
	if (name && name->scope && name->scope->checked==VIRTUAL_BFND) 
		return 1;
	return 0;
}

int fix_llnd(fi,tmp_fi)
PTR_FILE fi,tmp_fi;
{
	PTR_LLND llnd;
	PTR_TYPE type,real_type;
	PTR_SYMB sym;

	for (llnd=tmp_fi->head_llnd; llnd; llnd=llnd->thread) {
		/* fix symbol */
		if (ll_has_sym(llnd->variant)) {
			sym=llnd->entry.Template.symbol;
			if(sym&&sym->scope&&sym->scope->checked==VIRTUAL_BFND)
			{
				for (; sym->entry.Template.declared_name;
                        		sym=sym->entry.Template.declared_name);
				llnd->entry.Template.symbol=sym;
			}
		}
		/* fix type */
		type=llnd->type;
                if (record_type_is_defined_outside(type))
                {
                        real_type=get_real_record(fi,type);
                        if (type==real_type)
                                link_error3(53,type->name->ident);
                        else
                                llnd->type=real_type;
                }
	}
}

int fix_symb(fi,tmp_fi)
PTR_FILE fi,tmp_fi;
{
	PTR_SYMB sym,type_name;
	PTR_TYPE type,real_type;

	for (sym=tmp_fi->head_symb; sym; sym=sym->thread) {
		type=sym->type;
		/* fix type */
		if (record_type_is_defined_outside(type))
		{
			real_type=get_real_record(fi,type);
			if (type==real_type) 
				link_error3(53,type->name->ident);
			else
				sym->type=real_type;
		}
	}
}

/*   delete the redundent bfnd , symbol */
fix_merged_dep(fi,tmp_fi)
PTR_FILE fi,tmp_fi;
{
	PTR_BLOB blob;
	PTR_BFND bfnd;
	PTR_SYMB sym;
	int num;

	/* get the right symbol */
	get_real_sym(fi);

	fix_symb(fi,tmp_fi);
	fix_llnd(fi,tmp_fi);
	
	/* get rid of the blob */
	for (blob=fi->head_bfnd->entry.Template.bl_ptr1; 
		blob->next && blob->next->ref!=fi->cur_bfnd->thread; 
			blob=blob->next);
	fi->cur_blob=blob;
	if (blob->next) {
		num=0;
		for ( ; blob ; blob=blob->next) num++;
		fi->num_blobs-=num;
		fi->cur_blob->next=BLNULL;
	}
	
	/* at end get rid of the bfnd */
	num=0;
	for (bfnd=fi->cur_bfnd->thread; bfnd; bfnd=bfnd->thread)
		num++;
	if (num) {
		fi->num_bfnds-=num;
		fi->cur_bfnd->thread=BFNULL;
	}
	/* at end get rid of the sym */
	if (num) {
		num=0;
		for (sym=fi->cur_symb->thread; sym; sym=sym->thread)
			num++;
		if (num) {
			fi->num_symbs-=num;
			fi->cur_symb->thread=SMNULL;
		}
		fi->cur_blob->ref->entry.Template.symbol->next_symb=SMNULL;
	}
}

int check_link_dep(fi)
PTR_FILE fi;
{
	PTR_BFND bfnd;
	PTR_BLOB blob;

	for (blob=fi->head_bfnd->entry.Template.bl_ptr1;blob; blob=blob->next)
	{
		bfnd=blob->ref;
		if (bfnd->checked == VIRTUAL_BFND)
			link_error3(701,bfnd->entry.Template.symbol->ident);
	}
}

/*  notice :
	check :
	1. if duplicate main program;
	2. array_ref maybe a external function_ref
*/

void	is_checked_bfnd(proj)
PTR_PROJ	proj;
{
	PTR_FILE	fi=(PTR_FILE)proj->file_chain->ref;
        PTR_BLOB        cur_blob,contains_blob;

	cur_bfnd=fi->global_bfnd;
        cur_blob =  cur_bfnd->entry.Template.bl_ptr1;
        /* contains_blob = get_contain_blob(cur_bfnd); */

	recheck_blob(cur_blob,fi);
	/* recheck_blob(contains_blob,fi); */
	
}

int  recheck_blob(thisblob,fi)
PTR_BLOB        thisblob;
PTR_FILE	fi;
{
	PTR_BLOB	temp_blob=thisblob;
	PTR_BLOB	cur_blob,contains_blob;
	
	for(;temp_blob;temp_blob=temp_blob->next)
	{	cur_bfnd=temp_blob->ref;
		if (cur_bfnd->checked==SOFT)
			recheck_bfnd(fi);
			/* a procedure header found here */
		if (is_main_header(cur_bfnd)) {
 	        	cur_blob =  temp_blob->ref->entry.Template.bl_ptr1;
        		recheck_blob(cur_blob,fi);
		}
		else {
			/*  IF stmt or Do stmt */
 	        	cur_blob =  temp_blob->ref->entry.Template.bl_ptr1;
        		recheck_blob(cur_blob,fi);
 	        	cur_blob =  temp_blob->ref->entry.Template.bl_ptr2;
        		recheck_blob(cur_blob,fi);
		}
	}

}

int recheck_bfnd(fi)
PTR_FILE 	fi;
{	
	PTR_BFND 	scope;
	PTR_SYMB	sub_name,sym;
	PTR_LLND	expr;

	switch (cur_bfnd->variant)
	{
	  case  PROC_STAT:
		re_call_func(fi,PROCEDURE_NAME,
		     cur_bfnd->entry.call.call_exp->entry.Template.ll_ptr1,
			TYNULL);
		cur_bfnd->entry.call.call_exp->entry.Template.symbol=cur_subname;
		  break;
	  case ASSIGN_STAT:
		init_scope_table();
                push_scope(fi,fi->head_bfnd);
		check_assign_stmt();
		break;
	  case LOGIF_NODE:
		expr=cur_bfnd->entry.if_stmt.condition;
		scope = cur_bfnd;
        	while (!is_main_header(scope))
        	{
                	scope=scope->control_parent;
        	}
		push_virtual_scopes(fi,scope);
		check_expr_type(expr);
		break;
	  default:  ;
			
	}
	return(0);

}

int push_virtual_scopes(fi,bfnd)
PTR_FILE fi;
PTR_BFND bfnd;
{
	PTR_BFND bf;

	if (bfnd->control_parent)
		push_virtual_scopes(fi,bfnd->control_parent);
	if (is_main_header(bfnd) || bfnd->variant == GLOBAL)
                push_scope(fi,bfnd);
}

int re_call_func(fi,type,actual_list,func_type)
PTR_FILE	fi;
int	type;
PTR_LLND	actual_list;
PTR_TYPE	*func_type;
{
        PTR_SYMB        sub_name,sym;
	PTR_SYMB	spec_name;
	PTR_LLND	param;
	PTR_BFND	sub_bfnd;
	int	errcode;
	PTR_LLND	call_list,p,q;
	PTR_BFND	scope;
	PTR_SYMB	parent_name;

        sym = cur_bfnd->entry.call.call_exp-> entry.Template.symbol;
	sub_name=sym;
	cur_subname=sub_name;
	if (sym->variant != INTERFACE_NAME) {
      		sub_bfnd=search_head_name(fi,sym->ident);
		if (!(sub_bfnd))
	    	{	/* link_error3(595,sym->ident);*/
			insert_undef(sym);
			return(595);
	    	}
		cur_subname=sub_bfnd->entry.Template.symbol;
		sub_name=sub_bfnd->entry.Template.symbol;
		sym=sub_name;
	}
	/*added to call_list*/
/*
	while (scope=cur_bfnd->control_parent) 
	{	if ((scope->variant==PROC_HEDR) || (scope->variant==FUNC_HEDR))
			break;
	}
*/
	scope=cur_bfnd;
	while (!is_main_header(scope))
	{
		scope=scope->control_parent;
	}
        parent_name=scope->entry.Template.symbol;
        if ((parent_name!=SMNULL) &&
              ((parent_name->variant==FUNCTION_NAME)
              || (parent_name->variant==PROCEDURE_NAME)))

            {    call_list=parent_name->entry.Template.call_list;
                 p=makeLlnd(fi,VAR_REF,LLNULL,LLNULL,sym);
              q=makeLlnd(fi,EXPR_LIST,p,call_list,SMNULL);
          parent_name->entry.Template.call_list=q;
             }

        if ((sub_name->attr & EXTERNAL_BIT)!=0)
        {       if (sub_name->variant!=FUNCTION_NAME);
		     if  (type==FUNCTION_NAME)
			{
			 link_error3(539,sub_name->ident);
			  return(539);
			}
                if (sub_name->variant!=PROCEDURE_NAME)
                      if (type==PROCEDURE_NAME)
			{
			  link_error3(540,sub_name->ident);
			  return(540);
			}
	}
        switch (sub_name->variant)       
	{
        case    INTERFACE_NAME:
		/* add by zheng.gb 1996.7.3 */
		check_interface_extern_proc(fi,sub_name);

                spec_name=sub_name->entry.Template.next;
                for(;spec_name!=SMNULL;
			spec_name=spec_name->entry.Template.next)
                {
                   if (spec_name->variant!=type)
                        { if (type==FUNCTION_NAME)
                              {  link_error3(539,sub_name->ident);
				return(539);
				}
                            else {
                                   link_error3(540,sub_name->ident);
					return(540);
                                  }
                         }
		   if(match_arg(cur_bfnd,spec_name,actual_list,0,0)==0)
		   {
			sym=spec_name;
                        if (spec_name->variant==FUNCTION_NAME)
                            *func_type=spec_name->type;
                        return(0);

		   }
		}
		link_error3(541,sym->ident);
		return(541);
		break;
        case    FUNCTION_NAME:
        case    PROCEDURE_NAME:
                if (sub_name->variant!=type)
                   { if (type==FUNCTION_NAME)
			{ link_error3(539,sub_name->ident); 
			   return(539);
			}
			else { link_error3(540,sub_name->ident); 
				return(540);
				}
		   }
		if ((sub_name->attr & EXTERNAL_BIT)==0)
		{
		  errcode=match_arg(cur_bfnd,sub_name,actual_list,0,1);
		  if (errcode!=0)
			return(errcode);
		}
		break;
	}
 	if (((sub_name->variant==FUNCTION_NAME) ||
		 (sub_name->variant==PROCEDURE_NAME))     
		&& ((sub_name->attr &  INTERFACE_BIT)==0))
        {       if (actual_list!=LLNULL)
                    param=actual_list->entry.list_s.item;
                   else {
                         /* add by zheng.gb */
                       	if (sub_name->variant==FUNCTION_NAME)
                            *func_type=sub_name->type;
		      	}
                for(;actual_list!=LLNULL;
			actual_list=actual_list->entry.list_s.next)
                {       param=actual_list->entry.list_s.item;
                        if ((param->variant==KEYWORD_ARG) && 
				(param->entry.keyword.keyword!=LLNULL))
                        {
                            link_error3(542,sub_name->ident);
			    return(542);
                        }
		}
       	}
        if (sub_name->variant==FUNCTION_NAME)           /* by zheng.gb */
                *func_type=sub_name->type;
	return(0);

}

link_match_arg(sub_name,actual_list,kind)
PTR_SYMB	sub_name;
PTR_LLND	actual_list;
int	kind; /*0: don't print error*/
{
	PTR_SYMB        dummy_list=sub_name->entry.proc_decl.symb_list;
	PTR_SYMB	dummy_arg=dummy_list,dum;
        PTR_LLND        actual_arg;

}

void	is_dup_globle(proj)
PTR_PROJ	proj;
{	int	exist_main=0;
	PTR_FILE 	fi =(PTR_FILE)proj->file_chain->ref;
	PTR_SYMB	sym1,sym2;
	PTR_BLOB	pre_blob=fi->head_bfnd->entry.Template.bl_ptr1;
	PTR_BLOB	cur_blob;

	for (;pre_blob;pre_blob=pre_blob->next)
	{
	   if (pre_blob->ref->checked == VIRTUAL_BFND) continue;
	   sym1=pre_blob->ref->entry.Template.symbol;
	   if (sym1->variant==PROGRAM_NAME) exist_main=1;
	   cur_blob=pre_blob->next;
	   while (cur_blob)
	   {
	   	if (cur_blob->ref->checked == VIRTUAL_BFND) {
			cur_blob=cur_blob->next;
			continue;
		}
		sym2=cur_blob->ref->entry.Template.symbol;
		if (strcasecmp(sym1->ident,sym2->ident)==0)
			link_error3(601,sym1->ident);
		cur_blob=cur_blob->next;
		
	   }
	}
	if (exist_main==0)
		link_error3(602);
	return;

}

/*--------------------------------------------------------------------------
-----------------------------------------------------------------------------*/

/*
 *  if sym is a external function  in  header scope 
 */
int is_extern(scope,sym)
PTR_BFND scope;
PTR_SYMB sym;
{
	PTR_BFND bfnd;
	PTR_SYMB interface_name;

		/* if the symbol is a dummy */
	if (is_dummy(scope,sym)) return 0;
        bfnd=sym->entry.proc_decl.proc_hedr;
        if (bfnd->control_parent->variant == INTERFACE_STMT) {
		interface_name=bfnd->control_parent->entry.Template.symbol;
		if (!is_dummy(scope,interface_name)) return 1;
	}
	return 0;
}

/*  
 *  check_extern_proc(sym) : if sym is extern func , check if it is defined 
 */
int check_extern_proc(fi,sym)
PTR_BFND fi;
PTR_SYMB sym;
{
	PTR_BFND bfnd;

	bfnd=sym->entry.proc_decl.proc_hedr;
	if (bfnd && bfnd->control_parent &&
			bfnd->control_parent->variant == INTERFACE_STMT) 
	{
		if (search_head_name(fi,sym->ident)==BFNULL) 
			/* error3(702,sym->ident); */
			insert_undef(sym);
	}
}

int  check_interface_extern_proc(fi,inter)
PTR_FILE fi;
PTR_SYMB inter;
{
	PTR_SYMB sym;

	for (sym=inter->entry.Template.next;sym; sym=sym->entry.Template.next) {
		check_extern_proc(sym);
	}
}

/*---------------------------------------------------------------------------
		maintain undeifined symbol list 
-----------------------------------------------------------------------------*/
int insert_undef(symbol)
PTR_SYMB symbol;
{
	SYMB_LIST new;

	for (new = undef_symlist ; new; new=new->next)
		if (strcasecmp(new->sym->ident,symbol->ident)==0) return ;

	new = (SYMB_LIST)chkalloc(sizeof(struct _symbol_list));
	new->sym=symbol;

	new->next=undef_symlist;
	undef_symlist=new;
}

int report_undef_symbol()
{
	for (;undef_symlist;undef_symlist=undef_symlist->next)
		error3(702,undef_symlist->sym->ident);
}

---

From: Zheng Gengbin <[email-masked]>
Date: Thu, 3 Oct 1996 08:25:08 +0800 (EAT)

On Tue, 1 Oct 1996, Guansong Zhang wrote:

> link.c fixed the problem!
> 
> Li Xinying is working on .l file. She need a little more time to make update.
> So I will send to you the latest version as soon as I can.
> 
> Here is new problem I met: hpfsc complain about the following program, which is
> an example I am trying to compile.
> 
> 
> 
>       PROGRAM MAIN
>       REAL X(2:99), Y(100), NO(10)
> !HPF$ PROCESSORS P(4)
> !HPF$ TEMPLATE TX(400),TY(-200:199)
> !HPF$ DISTRIBUTE TX(BLOCK) ONTO P
> !HPF$ DISTRIBUTE TY(BLOCK) ONTO P
> !HPF$ ALIGN X(i) WITH TX(2*i+1)     ! some crazy alignment
> !HPF$ ALIGN Y(i) WITH TY(3*i-50)
> 
>       CALL FOO (X(1:49), Y(1:100:2))
> 
>       PRINT *, (X(i),i=2,99)        ! back to beginning ?
>       END
> 
>       SUBROUTINE FOO(X,Y)
>       REAL X(1:*), Y(1:*)
> !HPF$ INHERIT X,Y
> 
>       FORALL (i=1:49) X(i) = Y(i)
> 
>       END
> 
> 

	Please note that the line 10 of the program :
CALL FOO (X(1:49), Y(1:100:2))
	use the X(1:49) , while X is defined as 2:99 . So X(1) is illegal .

	I think I have explained this in some letter before .

Zheng

---

From: Zheng Gengbin <[email-masked]>
Date: Fri, 4 Oct 1996 16:06:49 +0800 (EAT)

On Thu, 3 Oct 1996, Guansong Zhang wrote:

> On Oct 3,  8:25am, Zheng Gengbin wrote:
> Sorry about my careless. Then everything is OK. Li Xinying is working on the .l
> file to make it portable to flex. (after her change) I will give your the
> latest update ASPS.
> 
> What about latest development of libsage.a? May we exchange some idea about
> this now?
> 

	Now , we have worked out the link b stage . During this time ,
I examined the lib carefully and supported other people's work . I think
now it is time to  merge our change to the lib.

Zheng

---

From: Zheng Gengbin <[email-masked]>
Date: Tue, 8 Oct 1996 18:08:57 +0800 (EAT)

On Mon, 7 Oct 1996, Guansong Zhang wrote:

> I faild to send 1.61 to you any way. So I tared hpf2dep in 1.61 to you here.
> Please check the core dump problem I mentioned in last mail.
> 

	I fixed some bugs in hpf2dep and hpfsc , it seems I have solved the
core dump error . I will send new hpf2dep.tar.gz tomorrow .

Zheng