finalyze moving

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/CMakeLists.txt

@@ -0,0 +1,18 @@
+set(DB_SOURCES anal_ind.c db.c db_unp.c db_unp_vpc.c dbutils.c
+  garb_coll.c glob_anal.c ker_fun.c list.c make_nodes.c mod_ref.c ndeps.c
+  readnodes.c sets.c setutils.c symb_alg.c writenodes.c)
+
+if(MSVC_IDE)
+  foreach(DIR ${DVM_SAGE_INCLUDE_DIRS})
+    file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR}
+      "${DIR}/*.h" "${DIR}/*.def" "${DIR}/head" "${DIR}/tag")
+    set(DB_HEADERS ${DB_HEADERS} ${FILES})
+  endforeach()
+  source_group("Header Files" FILES ${DB_HEADERS})
+endif()
+
+add_library(db ${DB_SOURCES} ${DB_HEADERS})
+
+target_compile_definitions(db PRIVATE SYS5)
+target_include_directories(db PUBLIC "${DVM_SAGE_INCLUDE_DIRS}")
+set_target_properties(db PROPERTIES FOLDER "${DVM_LIBRARY_FOLDER}")

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/Makefile

@@ -0,0 +1,123 @@
+#######################################################################
+##                  pC++/Sage++  Copyright (C) 1993                  ##
+##  Indiana University  University of Oregon  University of Rennes   ##
+#######################################################################
+
+
+# sage/lib/oldsrc/Makefile (phb)
+
+LSX = .a
+
+#HP_CFLAGS#CEXTRA = -Ae +z#ENDIF#
+#HP_CFLAGS#LSX = .sl#ENDIF#
+
+SHELL = /bin/sh
+CONFIG_ARCH=iris4d
+
+RANLIB_TEST = [ -f /usr/bin/ranlib ] || [ -f /bin/ranlib ]
+#NO_RANLIB#RANLIB_TEST = (exit 1)#ENDIF#
+
+# Directory with all the include headers
+H = ../../h
+
+#INSTALLDEST = ../$(CONFIG_ARCH)
+INSTALLDEST = ../../../libsage
+INSTALL = /bin/cp
+
+CC = gcc
+#CC=cc#ENDIF##USE_CC#
+
+CXX = g++
+CXX = /usr/WorkShop/usr/bin/DCC
+LINKER = $(CC)
+
+CFLAGS	= -g -Wall -I$H $(CEXTRA)
+
+DEST	= ${HOME}/bin
+
+EXTHDRS	= $H/bif.h $H/db.h $H/db.h $H/defs.h $H/dep.h \
+	  $H/dep_str.h $H/list.h $H/ll.h $H/sets.h $H/symb.h \
+	  $H/tag $H/vparse.h
+
+OBJS	= anal_ind.o db.o db_unp.o db_unp_vpc.o  dbutils.o \
+	  garb_coll.o glob_anal.o ker_fun.o list.o \
+	  make_nodes.o mod_ref.o ndeps.o readnodes.o sets.o setutils.o \
+	  symb_alg.o writenodes.o 
+
+SRCS	= anal_ind.c db.c db_unp.c db_unp_vpc.c  dbutils.c \
+	  garb_coll.c glob_anal.c ker_fun.c list.c \
+	  make_nodes.c mod_ref.c ndeps.c readnodes.c sets.c setutils.c \
+	  symb_alg.c writenodes.c
+
+
+all:		$(OBJS) libdb$(LSX)
+
+libdb.a:	$(OBJS)
+		/bin/rm -f libdb.a
+		ar qc libdb.a $(OBJS)
+		@if $(RANLIB_TEST) ; then ranlib libdb.a ; \
+		   else echo "\tNOTE: ranlib not required" ; fi
+
+libdb.sl:	$(OBJS)
+		/bin/rm -f libdb.sl
+		ld -b -s -o libdb.sl $(OBJS)
+
+clean:
+		@/bin/rm -f $(OBJS) $(PROGRAM) *.dep libdb$(LSX)
+
+index:
+		ctags -wx $(HDRS) $(SRCS)
+
+print:
+		$(PRINT) $(HDRS) $(SRCS)
+
+program:        $(PROGRAM)
+
+tags:           $(HDRS) $(SRCS); ctags $(HDRS) $(SRCS)
+
+install: $(INSTALLDEST)/libdb$(LSX)
+
+$(INSTALLDEST)/libdb$(LSX): libdb$(LSX)
+		if [ -d $(INSTALLDEST) ] ; then true; \
+                    else mkdir $(INSTALLDEST) ;fi
+		$(INSTALL) libdb$(LSX) $(INSTALLDEST)
+		@if $(RANLIB_TEST) ; then ranlib $(INSTALLDEST)/libdb$(LSX) ; \
+		   else echo "\tNOTE: ranlib not required" ; fi
+
+###
+anal_ind.o: $H/db.h $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+db.o:  $H/db.h $H/defs.h \
+	$H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h
+db_unp.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+db_unp_vpc.o:  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h $H/db.h $H/vparse.h
+dbutils.o:  $H/db.h \
+	$H/defs.h $H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h
+garb-coll.o:  $H/db.h $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+glob_anal.o:  $H/db.h $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+ker_fun.o:  $H/defs.h $H/tag $H/bif.h $H/ll.h \
+	$H/symb.h $H/sets.h
+list.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h $H/list.h
+make_nodes.o: $H/db.h  $H/defs.h $H/tag \
+	$H/bif.h $H/ll.h $H/symb.h $H/sets.h
+mod_ref.o:  $H/defs.h $H/tag $H/bif.h $H/ll.h \
+	$H/symb.h $H/sets.h $H/vparse.h $H/db.h
+ndeps.o:  $H/db.h $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+readnodes.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \
+	 $H/dep.h
+sets.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+setutils.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+symb_alg.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+writenodes.o: $H/db.h $H/defs.h $H/tag \
+	$H/bif.h $H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \
+	$H/dep.h

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/db_unp_comm.c

@@ -0,0 +1,10 @@
+/*********************************************************************/
+/*                  pC++/Sage++  Copyright (C) 1993                  */
+/*  Indiana University  University of Oregon  University of Rennes   */
+/*********************************************************************/
+
+
+#define BUFLEN		50000
+
+char	 buffer[BUFLEN],	/* buffer to build the unparsed text */
+	*bp;			/* points to where next char goes in buffer */

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/dbutils.c

@@ -0,0 +1,961 @@
+/*********************************************************************/
+/*                  pC++/Sage++  Copyright (C) 1993                  */
+/*  Indiana University  University of Oregon  University of Rennes   */
+/*********************************************************************/
+
+
+/****************************************************************
+ *								*
+ *   dbutils -- contains those utilities that will be used by	*
+ *		the data base management routines		*
+ *								*
+ ****************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "compatible.h"
+#ifdef SYS5
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+ 
+# include "db.h"
+
+/*
+ * global references
+ */
+extern int language;
+extern PTR_FILE cur_file;
+
+int   read_nodes();
+
+/*
+ * Local variables
+ */
+static PTR_SYMB head_symb;
+static char *proj_filename;
+static int   temp[200];
+static int  *pt;
+
+#ifdef __SPF
+extern void addToCollection(const int line, const char *file, void *pointer, int type);
+extern void removeFromCollection(void *pointer);
+#endif
+
+/****************************************************************
+ *								*
+ *  alloc_blob -- allocate new space for structure blob		*
+ *								*
+ *  output:							*
+ *	Non-NULL - pointer to the newly allocated structure	*
+ *	NULL - something was wrong				*
+ *								*
+ ****************************************************************/
+PTR_BLOB
+alloc_blob()
+{
+    void *p = calloc(1, sizeof(struct blob));
+#ifdef __SPF
+    addToCollection(__LINE__, __FILE__,p, 0);
+#endif
+	return ((PTR_BLOB)p);
+}
+
+
+/****************************************************************
+ *								*
+ *  alloc_blob1 -- allocate new space for structure blob1	*
+ *								*
+ *  output:							*
+ *	Non-NULL - pointer to the newly allocated structure	*
+ *	NULL - something was wrong				*
+ *								*
+ ****************************************************************/
+static PTR_BLOB1
+alloc_blob1()
+{
+    void *p = calloc(1, sizeof(struct blob1));
+#ifdef __SPF
+    addToCollection(__LINE__, __FILE__,p, 0);
+#endif
+	return ((PTR_BLOB1) p);
+}
+
+	
+/****************************************************************
+ *								*
+ *  alloc_info -- allocate new space for structure obj_info	*
+ *								*
+ *  output:							*
+ *	Non-NULL - pointer to the newly allocated structure	*
+ *	NULL - something was wrong				*
+ *								*
+ ****************************************************************/
+static PTR_INFO
+alloc_info()
+{
+    void *p = calloc(1, sizeof(struct obj_info));
+#ifdef __SPF
+    addToCollection(__LINE__, __FILE__,p, 0);
+#endif
+	return ((PTR_INFO) p);
+}
+
+
+/****************************************************************
+ *								*
+ *   check_ref -- check if the variable whose id is "id" has	*
+ *		  referenced in this statement or not		*
+ *   input:							*
+ *	    id -- the id of the variable to be checked		*
+ *								*
+ *   output:							*
+ *	    1, if it's been refereneced				*
+ *	    0, if not and add it to the table			*
+ *								*
+ ****************************************************************/
+int
+check_ref(id)
+	int  id;
+{
+	int	*p;
+
+	for(p = temp; p < pt;)
+		if(*p++ == id)
+			return(1);
+	*pt++ = id;
+	return(0);
+}
+
+
+/****************************************************************
+ *								*
+ *   build_ref -- add "bif" to the reference chain of "symb"	*
+ *								*
+ *   input:							*
+ *	    symb - the symb where the reference to be added	*
+ *	    bif  - the statement that references symb		*
+ *								*
+ ****************************************************************/
+void
+build_ref(symb, bif)
+	PTR_SYMB symb;
+	PTR_BFND bif;
+{
+	register PTR_BLOB   b, b1, b2;
+
+	b = alloc_blob();
+#ifdef __SPF
+    addToCollection(__LINE__, __FILE__,b, 0);
+#endif
+	b->ref = bif;
+	if (symb->ud_chain == NULL)
+		symb->ud_chain = b;
+	else {
+		for (b1 = b2 = symb->ud_chain; b1; b1 = b1->next)
+			b2 = b1;
+		b2->next = b;
+	}
+	b->next = NULL;
+}
+
+
+/****************************************************************
+ *								*
+ *  make_blob1 -- make a new blob1 node				*
+ *								*
+ *  input:							*
+ *	   tag  - type of this blob1 node			*
+ *	   ref  - pointer to the object it references		*
+ *	   next - link to the next blob1 node			*
+ *								*
+ ****************************************************************/
+PTR_BLOB1
+make_blob1(tag, ref, next)
+	int	  tag;
+	PTR_BFND  ref;
+	PTR_BLOB1 next;
+{
+	PTR_BLOB1 new;
+
+	new = alloc_blob1();
+#ifdef __SPF
+    addToCollection(__LINE__, __FILE__,new, 0);
+#endif
+	new->tag = tag;
+	new->ref = (char *) ref;
+	new->next = next;
+	return (new);
+}
+
+
+/****************************************************************
+ *								*
+ *  make_obj_info -- make a new obj_info node			*
+ *								*
+ *  input:							*
+ *	   filename - name of the file where this obj_info	*
+ *		      resides					*
+ *	   g_line   - ablosute line no. of the obj in the file	*
+ *	   l_line   - line no. of the object relative to its	*
+ *		      parent objec				*
+ *	   source   - the objec in the source form		*
+ *								*
+ ****************************************************************/
+PTR_INFO
+make_obj_info(filename, g_line, l_line, source)
+	char	*filename;
+	int	 g_line;
+	int	 l_line;
+	char	*source;
+{
+	register PTR_INFO new;
+
+	new = alloc_info();
+#ifdef __SPF
+    addToCollection(__LINE__, __FILE__,new, 0);
+#endif
+	new->filename = filename;
+	new->g_line = g_line;
+	new->l_line = l_line;
+	new->source = source;
+	return (new);
+}
+
+/****************************************************************
+ *								*
+ *   visit_llnd -- recursively visit the low level nodes and	*
+ *		   find those use and def info it references	*
+ *								*
+ *   input:							*
+ *	    bif  - the bif node to which the llnd belongs	*
+ *	    llnd - the low level node to be visit		*
+ *								*
+ ****************************************************************/
+void
+visit_llnd(bif, llnd)
+	PTR_BFND	bif;
+	PTR_LLND	llnd;
+{
+	if (llnd == NULL) return;
+
+	switch (llnd->variant) {
+	case LABEL_REF:
+		{
+		}
+		break;
+	case CONST_REF	:
+	case VAR_REF	:
+	case ARRAY_REF	:
+		if(check_ref(llnd->entry.Template.symbol->id) == 0)
+			build_ref(llnd->entry.Template.symbol, bif);
+		break;
+	case CONSTRUCTOR_REF	:
+		break;
+	case ACCESS_REF	:
+		break;
+	case CONS	:
+		break;
+	case ACCESS	:
+		break;
+	case IOACCESS	:
+		break;
+	case PROC_CALL	:
+	case FUNC_CALL	:
+		visit_llnd(bif, llnd->entry.proc.param_list);
+		break;
+	case EXPR_LIST	:
+		visit_llnd(bif, llnd->entry.list.item);
+		if (llnd->entry.list.next)
+			visit_llnd(bif, llnd->entry.list.next);
+		break;
+	case EQUI_LIST	:
+		visit_llnd(bif, llnd->entry.list.item);
+		if (llnd->entry.list.next) {
+			visit_llnd(bif, llnd->entry.list.next);
+		}
+		break;
+	case COMM_LIST	:
+		if (llnd->entry.Template.symbol) {
+/*			addstr(llnd->entry.Template.symbol->ident);
+ */		}
+		visit_llnd(bif, llnd->entry.list.item);
+		if (llnd->entry.list.next)
+			visit_llnd(bif, llnd->entry.list.next);
+		break;
+	case VAR_LIST	:
+	case RANGE_LIST	:
+	case CONTROL_LIST	:
+		visit_llnd(bif, llnd->entry.list.item);
+		if (llnd->entry.list.next)
+			visit_llnd(bif, llnd->entry.list.next);
+		break;
+	case DDOT	:
+		visit_llnd(bif, llnd->entry.binary_op.l_operand);
+		if (llnd->entry.binary_op.r_operand)
+			visit_llnd(bif, llnd->entry.binary_op.r_operand);
+		break;
+	case DEF_CHOICE	:
+	case SEQ	:
+		visit_llnd(bif, llnd->entry.seq.ddot);
+		if (llnd->entry.seq.stride)
+			visit_llnd(bif, llnd->entry.seq.stride);
+		break;
+	case SPEC_PAIR	:
+		visit_llnd(bif, llnd->entry.spec_pair.sp_label);
+		visit_llnd(bif, llnd->entry.spec_pair.sp_value);
+		break;
+	case EQ_OP	:
+	case LT_OP	:
+	case GT_OP	:
+	case NOTEQL_OP	:
+	case LTEQL_OP	:
+	case GTEQL_OP	:
+	case ADD_OP	:
+	case SUBT_OP	:
+	case OR_OP	:
+	case MULT_OP	:
+	case DIV_OP	:
+	case MOD_OP	:
+	case AND_OP	:
+	case EXP_OP	:
+	case CONCAT_OP	:
+		visit_llnd(bif, llnd->entry.binary_op.l_operand);
+		visit_llnd(bif, llnd->entry.binary_op.r_operand);
+		break;
+	case MINUS_OP	:
+	case NOT_OP	:
+		visit_llnd(bif, llnd->entry.unary_op.operand);
+		break;
+	case STAR_RANGE	:
+		break;
+	default	:
+		break;
+	}
+}
+       
+
+/****************************************************************
+ *								*
+ *   visit_bfnd -- visits the subtree "bif" and generates the	*
+ *		     use-definition info of the variables it	*
+ *		     references					*
+ *   input:							*
+ *	     bif - the root of the tree to be visitd		*
+ *								*
+ *   side effect:						*
+ *	     build the ud_chain at where the static variable	*
+ *	     "head_symb" points to				*
+ *								*
+ ****************************************************************/
+void
+visit_bfnd(bif)
+	PTR_BFND bif;
+{
+	register PTR_BLOB b;
+
+	if(bif == NULL)
+		return;
+	pt = temp;		/* reset the pointer */
+
+	switch(bif->variant) {
+	    case GLOBAL:
+	    case PROG_HEDR:
+	    case PROC_HEDR:
+	    case FUNC_HEDR:
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			visit_bfnd(b->ref);
+		break;
+	    case FOR_NODE:
+		build_ref(bif->entry.Template.symbol, bif); /* control var */
+		visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check range */
+		visit_llnd(bif, bif->entry.Template.ll_ptr2); /* check incr */
+		visit_llnd(bif, bif->entry.Template.ll_ptr3); /* where cond */
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			visit_bfnd(b->ref);
+		break;
+	    case CDOALL_NODE:
+		build_ref(bif->entry.Template.symbol, bif); /* control var */
+		visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check range */
+		visit_llnd(bif, bif->entry.Template.ll_ptr2); /* check incr */
+		visit_llnd(bif, bif->entry.Template.ll_ptr3); /* where cond */
+		for (b = bif->entry.Template.bl_ptr2; b; b = b->next)
+			visit_bfnd(b->ref);
+		break;
+	    case WHILE_NODE:
+		visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			visit_bfnd(b->ref);
+		break;
+	    case WHERE_NODE:
+		visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			visit_bfnd(b->ref);
+		for (b = bif->entry.Template.bl_ptr2; b; b = b->next)
+			visit_bfnd(b->ref);
+		break;
+	    case IF_NODE:
+	    case ELSEIF_NODE:
+		visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			visit_bfnd(b->ref);
+		for (b = bif->entry.Template.bl_ptr2; b; b = b->next)
+			visit_bfnd(b->ref);
+		break;
+	    case LOGIF_NODE:
+		visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */
+		visit_bfnd(bif->entry.Template.bl_ptr1->ref);
+		break;
+	    case ARITHIF_NODE:
+		visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */
+		break;
+	    case ASSIGN_STAT:
+	    case IDENTIFY:
+		visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check l_val */
+		visit_llnd(bif, bif->entry.Template.ll_ptr2); /* check r_val */
+		break;
+	    case PROC_STAT:
+		visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check l_val */
+		break;
+	    case CONT_STAT:
+	    case FORMAT_STAT:
+	    case GOTO_NODE:
+	    case ASSGOTO_NODE:
+	    case COMGOTO_NODE:
+	    case STOP_STAT:
+	    case VAR_DECL:
+	    case PARAM_DECL:
+	    case DIM_STAT:
+	    case EQUI_STAT:
+	    case DATA_DECL:
+	    case IMPL_DECL:
+	    case READ_STAT:
+	    case WRITE_STAT:
+	    case OTHERIO_STAT:
+	    case COMM_STAT:
+	    case CONTROL_END:
+		break;
+	    default:
+		break;
+	}
+}
+
+
+/****************************************************************
+ *								*
+ *   cvisit_llnd -- recursively visit the low level nodes and	*
+ *	 	    find those use and def info it references	*
+ *                  for VPC++					*
+ *								*
+ *   input:							*
+ *	    bif  - the bif node to which the llnd belongs	*
+ *	    llnd - the low level node to be visit		*
+ *								*
+ ****************************************************************/
+void
+cvisit_llnd(bif,llnd)
+PTR_BFND        bif;
+PTR_LLND        llnd;
+
+{    
+        if (!llnd) return;
+
+        switch (llnd->variant) {
+        case INT_VAL    :
+        case STMT_STR   : 
+        case FLOAT_VAL  :
+        case DOUBLE_VAL :
+        case STRING_VAL :
+        case BOOL_VAL   :
+        case CHAR_VAL   :
+                break;
+        case CONST_REF  :
+        case ENUM_REF   :
+                break;
+        case VAR_REF    :
+		if(check_ref(llnd->entry.Template.symbol->id) == 0)
+			build_ref(llnd->entry.Template.symbol, bif);
+		break;
+        case POINTST_OP :                /* New added for VPC */
+        case RECORD_REF:	         /* Need More */
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                /* Need More work for pointer combined with structure */
+                break ;
+	case ARRAY_OP :
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+		break;
+        case ARRAY_REF  :
+		if(check_ref(llnd->entry.Template.symbol->id) == 0)
+			build_ref(llnd->entry.Template.symbol, bif);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                break;
+        case CONSTRUCTOR_REF    :
+                break;
+        case ACCESS_REF :
+                break;
+        case CONS       :
+                break;
+        case ACCESS     :
+                break;
+        case IOACCESS   :
+                break;
+        case PROC_CALL  :
+        case FUNC_CALL  :
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                break;
+        case EXPR_LIST  :
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+                break;
+        case EQUI_LIST  :
+                break;
+        case COMM_LIST  :
+                break;
+        case VAR_LIST   :
+        case CONTROL_LIST       :
+                break;
+        case RANGE_LIST :
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+                break;
+        case DDOT       :
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+                break;
+        case COPY_NODE :
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+                break;
+        case VECTOR_CONST : /* NEW ADDED FOR VPC++  */
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+		break;
+        case INIT_LIST:
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                break ;
+        case BIT_NUMBER:
+                break ;
+        case DEF_CHOICE :
+        case SEQ        :
+                break;
+        case SPEC_PAIR  :
+                break;
+        case MOD_OP     :
+	        break;
+        case ASSGN_OP   :                /* New added for VPC */
+        case ARITH_ASSGN_OP:             /* New added for VPC */
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+		break;
+        case EQ_OP      :
+        case LT_OP      :
+        case GT_OP      :
+        case NOTEQL_OP  :
+        case LTEQL_OP   :
+        case GTEQL_OP   :
+        case ADD_OP     :
+        case SUBT_OP    :
+        case OR_OP      :
+        case MULT_OP    :
+        case DIV_OP     :
+        case AND_OP     :
+        case EXP_OP     :
+        case LE_OP      :                /* New added for VPC *//*Duplicated*/
+        case GE_OP      :                /* New added for VPC *//*Duplicated*/
+        case NE_OP      :                /* New added for VPC *//*Duplicated*/
+        case BITAND_OP    :              /* New added for VPC */
+        case BITOR_OP     :              /* New added for VPC */
+        case LSHIFT_OP         :         /* New added for VPC */
+        case RSHIFT_OP         :         /* New added for VPC */
+        case INTEGER_DIV_OP :             /* New added for VPC */
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+                break;
+        case FUNCTION_OP:
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+		break;
+        case ADDRESS_OP   :               /* New added for VPC */
+        case SIZE_OP      :               /* New added for VPC */
+                break;
+        case DEREF_OP :
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+	        break;
+        case SUB_OP   :                  /* duplicated unary minus  */
+        case MINUS_OP   :                /* unary operations */
+        case UNARY_ADD_OP      :         /* New added for VPC */
+        case BIT_COMPLEMENT_OP :         /* New added for VPC */
+        case NOT_OP     :
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+		break;
+        case MINUSMINUS_OP:              /* New added for VPC */
+        case PLUSPLUS_OP  :              /* New added for VPC */
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+		break;
+        case STAR_RANGE :
+                break;
+        case CLASSINIT_OP :               /* New added for VPC */
+                break ;
+        case CAST_OP :             /* New added for VPC */
+	         break;
+        case EXPR_IF      :               /* New added for VPC */
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+		break;
+        case EXPR_IF_BODY :               /* New added for VPC */
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr1);
+                cvisit_llnd(bif,llnd->entry.Template.ll_ptr2);
+		break;
+        case FUNCTION_REF :               /* New added for VPC */
+                break ;
+        case LABEL_REF: /* Fortran Version, For VPC we need more */
+                  break;
+
+        default                 :
+                  break;
+
+        }
+}
+
+
+/****************************************************************
+ *								*
+ *   cvisit_bfnd -- visits the subtree "bif" and generates the	*
+ *	            use-definition info of the variables it	*
+ *		    references	for VPC++			*
+ *   input:							*
+ *	     bif - the root of the tree to be visitd		*
+ *								*
+ *   side effect:						*
+ *	     build the ud_chain at where the static variable	*
+ *	     "head_symb" points to				*
+ *								*
+ ****************************************************************/
+void
+cvisit_bfnd(bif)
+PTR_BFND     bif;
+
+{
+        register PTR_BLOB  b;
+	void cvisit_llnd();
+
+        if (!bif) return;
+        pt = temp;        /* reset the pointer */
+
+        switch (bif->variant) {
+        case GLOBAL     :
+        case PROG_HEDR  :
+        case PROC_HEDR  :  
+        case FUNC_HEDR  :
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			cvisit_bfnd(b->ref);
+                break;
+        case IF_NODE    :
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			cvisit_bfnd(b->ref);
+		for (b = bif->entry.Template.bl_ptr2; b; b = b->next)
+			cvisit_bfnd(b->ref);
+                break;
+        case LOGIF_NODE :
+        case ARITHIF_NODE:
+        case WHERE_NODE :
+                break;
+        case FOR_NODE   :
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr1); 
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr2); 
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr3); 
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			cvisit_bfnd(b->ref);
+                break;
+        case FORALL_NODE        :
+        case WHILE_NODE :
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr1); 
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			cvisit_bfnd(b->ref);
+                break;
+        case ASSIGN_STAT:
+        case IDENTIFY:
+        case PROC_STAT  :
+        case SAVE_DECL:
+        case CONT_STAT:
+        case FORMAT_STAT:
+                break;
+        case LABEL_STAT:
+                break;
+        case GOTO_NODE:
+                break;
+        case ASSGOTO_NODE:
+        case COMGOTO_NODE:
+        case STOP_STAT:
+                break;
+        case RETURN_STAT:
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr1); 
+                break;
+        case PARAM_DECL :
+        case DIM_STAT:
+        case EQUI_STAT:
+        case DATA_DECL:
+        case READ_STAT:
+        case WRITE_STAT:
+        case OTHERIO_STAT:
+        case COMM_STAT:
+        case CONTROL_END:
+                break;
+        case CLASS_DECL:                /* New added for VPC */
+		break;
+        case ENUM_DECL :                /* New added for VPC */
+        case UNION_DECL:                /* New added for VPC */
+        case STRUCT_DECL:               /* New added for VPC */
+	        break;
+        case DERIVED_CLASS_DECL:        /* Need More for VPC */
+        case VAR_DECL:
+		break;
+        case EXPR_STMT_NODE:            /* New added for VPC */
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr1); 
+		break ;
+        case DO_WHILE_NODE:             /* New added for VPC */
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr1); 
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			cvisit_bfnd(b->ref);
+                break;
+        case SWITCH_NODE :              /* New added for VPC */
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr1); 
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			cvisit_bfnd(b->ref);
+		break ;
+        case CASE_NODE :                /* New added for VPC */
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr1); 
+		break ;
+        case DEFAULT_NODE:              /* New added for VPC */
+		break;
+        case BASIC_BLOCK :
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			cvisit_bfnd(b->ref);
+	        break ;
+        case BREAK_NODE  :              /* New added for VPC */
+	        break;
+        case CONTINUE_NODE:             /* New added for VPC */
+		break;
+        case RETURN_NODE  :             /* New added for VPC */
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr1); 
+		break;
+        case ASM_NODE     :             /* New added for VPC */
+               break;                   /* Need More         */
+        case SPAWN_NODE :             /* New added for VPC */
+               break;
+        case PARFOR_NODE  :             /* New added for VPC */
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr1); 
+		cvisit_llnd(bif, bif->entry.Template.ll_ptr2); 
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			cvisit_bfnd(b->ref);
+               break;
+        case PAR_NODE  :             /* New added for VPC */
+		for (b = bif->entry.Template.bl_ptr1; b; b = b->next)
+			cvisit_bfnd(b->ref);
+		break;
+        default:
+                break; 
+	}
+     
+}
+
+
+/****************************************************************
+ *								*
+ *  gen_udchain -- visits the bif tree of the given "proj"	*
+ *		   and generates the use-definition info the	*
+ *		   proj has referenced				*
+ *								*
+ *   input:							*
+ *	    proj -- the project to be visited			*
+ *								*
+ ****************************************************************/
+void
+gen_udchain(proj)
+	PTR_FILE proj;
+{
+	if(proj->head_bfnd == NULL)
+		return;
+
+	proj_filename = (char *) calloc(strlen(proj->filename), sizeof(char));
+#ifdef __SPF
+    addToCollection(__LINE__, __FILE__,proj_filename, 0);
+#endif
+	head_symb = proj->head_symb;
+	switch (language) {
+	case ForSrc:
+		visit_bfnd(proj->global_bfnd);
+		break;
+	case CSrc:
+		cvisit_bfnd(proj->global_bfnd);
+		break;
+	default:
+		break;
+	}
+}
+
+
+void
+dump_udchain(proj)
+	PTR_FILE proj;
+{
+	register PTR_SYMB s;
+	register PTR_BLOB b;
+
+	if(proj->global_bfnd)
+	    for (s = proj->head_symb; s; s = s->thread) {
+		if (s->ud_chain) {
+		    fprintf(stderr, "Variable \"%s\" referenced at line(s) -- ",
+			       s->ident);
+		    for(b = s->ud_chain; b; b = b->next)
+			    fprintf(stderr, "%d%s", b->ref->g_line,
+				   (b->next? ", ": "\n"));
+	    }
+	}
+}
+
+
+static void
+clean_hash_tbl(fi)
+	PTR_FILE fi;
+{
+	register PTR_HASH h, h1, h2;
+
+	for (h = *(fi->hash_tbl); h < *(fi->hash_tbl)+hashMax; h++)
+		if (h) {
+			for (h1 = h->next_entry; h1; h1 = h2) {
+				h2 = h1->next_entry;
+#ifdef __SPF
+                removeFromCollection(h1);
+#endif
+				free(h1);
+			}
+			h = NULL;
+		}
+}
+
+
+static void
+free_dep(fi)
+	PTR_FILE fi;
+{
+	register PTR_BLOB bl1, bl2;
+	register PTR_BFND bf;
+
+	clean_hash_tbl(fi);
+	for (bf = fi->global_bfnd; bf; bf = bf->thread) {
+		for (bl1 = bf->entry.Template.bl_ptr1; bl1; bl1 = bl2) {
+			bl2 = bl1->next;
+#ifdef __SPF
+            removeFromCollection(bl1);
+#endif
+			free(bl1);
+		}
+		for (bl1 = bf->entry.Template.bl_ptr2; bl1; bl1 = bl2) {
+			bl2 = bl1->next;
+#ifdef __SPF
+            removeFromCollection(bl1);
+#endif
+			free(bl1);
+		}
+	}
+ 
+    if (fi->num_bfnds)
+    {
+#ifdef __SPF
+        removeFromCollection(fi->head_bfnd);
+#endif
+        free(fi->head_bfnd);
+    }
+
+    if (fi->num_llnds)
+    {
+#ifdef __SPF
+        removeFromCollection(fi->head_llnd);
+#endif
+        free(fi->head_llnd);
+    }
+
+	if (fi->num_symbs) {
+		register PTR_SYMB s;
+
+        for (s = fi->head_symb; s; s = s)
+        {
+#ifdef __SPF
+            removeFromCollection(s->ident);
+#endif
+            free(s->ident);
+        }
+#ifdef __SPF
+        removeFromCollection(fi->head_symb);
+#endif
+		free(fi->head_symb);
+	}
+
+    if (fi->num_label)
+    {
+#ifdef __SPF
+        removeFromCollection(fi->head_lab);
+#endif
+        free(fi->head_lab);
+    }
+
+    if (fi->num_types)
+    {
+#ifdef __SPF
+        removeFromCollection(fi->head_type);
+#endif
+        free(fi->head_type);
+    }
+
+    if (fi->num_dep)
+    {
+#ifdef __SPF
+        removeFromCollection(fi->head_dep);
+#endif
+        free(fi->head_dep);
+    }
+
+	if (fi->num_cmnt) {
+		register PTR_CMNT c;
+
+        for (c = fi->head_cmnt; c; c = c->next)
+        {
+#ifdef __SPF
+            removeFromCollection(c->string);
+#endif
+            free(c->string);
+        }
+#ifdef __SPF
+        removeFromCollection(fi->head_cmnt);
+#endif
+		free(fi->head_cmnt);
+	}
+}
+
+
+int
+replace_dep(filename)
+	char	*filename;
+{
+	PTR_FILE fi;
+	PTR_BLOB bl;
+	extern PTR_PROJ cur_proj;
+
+	for (bl = cur_proj->file_chain; bl; bl = bl->next) {
+		fi = (PTR_FILE) bl->ref;
+		if (!strcmp(fi->filename, filename)) {
+#ifdef __SPF
+            removeFromCollection(fi);
+#endif
+			free_dep(fi);
+			read_nodes(fi);
+			return (1);
+		}
+	}
+	return (0);
+}

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/garb_coll.c

@@ -0,0 +1,229 @@
+/*********************************************************************/
+/*                  pC++/Sage++  Copyright (C) 1993                  */
+/*  Indiana University  University of Oregon  University of Rennes   */
+/*********************************************************************/
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "db.h"
+
+
+
+PTR_LLND free_ll_list = NULL;
+static int num_marked;
+int num_ll_allocated = 0;
+
+
+static void
+mark_llnd(p)
+PTR_LLND p;
+{
+	if(p == NULL || p->id == -1)
+		return;
+	p->id = -1; num_marked++;
+	mark_llnd(p->entry.Template.ll_ptr1);
+	mark_llnd(p->entry.Template.ll_ptr2);
+}
+
+
+static void
+mark_refl(p)
+	PTR_REFL p;
+{
+	for (; p; p = p->next)
+		if(p->node != NULL) 
+			mark_llnd(p->node->refer);
+}
+	
+
+static void
+mark_arefl(p)
+	PTR_AREF p;
+{
+	for (; p; p = p->next){
+   		mark_llnd(p->decl_ranges);
+   		mark_llnd(p->use_bnd0); 
+   		mark_llnd(p->mod_bnd0);
+   		mark_llnd(p->use_bnd1); 
+   		mark_llnd(p->mod_bnd1);
+   		mark_llnd(p->use_bnd2);
+   		mark_llnd(p->mod_bnd2);
+	}
+}
+
+
+static void
+mark_sets(s)
+	struct sets *s;
+{
+	if(s == NULL) return;
+
+	mark_refl(s->gen);
+	mark_refl(s->in_def);
+	mark_refl(s->use);
+	mark_refl(s->in_use);
+	mark_refl(s->out_def);
+	mark_refl(s->out_use);
+	mark_arefl(s->arefl);
+}
+
+
+static void
+mark_depnds(p)
+	PTR_DEP p;
+{
+	int depcnt;
+	depcnt = 0;
+
+	for (; p != NULL; p = p->thread){
+		mark_llnd(p->to.refer);
+		mark_llnd(p->from.refer);
+		depcnt++;
+	}
+}
+
+
+static void
+mark_symb(fi)
+	PTR_FILE fi;
+{
+	PTR_SYMB s;
+
+	for (s = fi->head_symb; s; s = s->thread) {
+		if (s->variant == CONST_NAME)
+			mark_llnd(s->entry.const_value);
+      		else if(s->variant == FIELD_NAME)
+			mark_llnd(s->entry.field.restricted_bit);
+		else if(s->variant == VAR_FIELD)
+			mark_llnd(s->entry.variant_field.variant_list);
+		else if (s->variant == PROCEDURE_NAME || 
+			 s->variant == FUNCTION_NAME)
+			mark_llnd(s->entry.proc_decl.call_list);
+		else if(s->variant == MEMBER_FUNC)
+			mark_llnd(s->entry.member_func.call_list);
+
+	}
+}
+
+
+static void
+mark_type(fi)
+	PTR_FILE fi;
+{
+	PTR_TYPE s;
+	for (s = fi->head_type; s; s = s->thread) {
+		if(s->variant == T_ARRAY)
+			mark_llnd(s->entry.ar_decl.ranges);
+		else if(s->variant == T_DESCRIPT || 
+			s->variant == T_POINTER ||
+			s->variant == T_LIST ||
+			s->variant == T_FUNCTION)
+			mark_llnd(s->entry.Template.ranges);
+		else if(s->variant == T_SUBRANGE){
+			mark_llnd(s->entry.subrange.lower);
+			mark_llnd(s->entry.subrange.upper);
+			}
+		else{
+		 mark_llnd(s->entry.Template.ranges);
+		 }
+	      }
+}
+
+
+
+static void
+mark_bfnd(b)
+	PTR_BFND b;
+{
+	PTR_BLOB bl;
+
+	if(b == NULL) return;
+
+	mark_llnd(b->entry.Template.ll_ptr1);
+	mark_llnd(b->entry.Template.ll_ptr2);
+	mark_llnd(b->entry.Template.ll_ptr3);
+	mark_sets(b->entry.Template.sets); 
+
+	for (bl = b->entry.Template.bl_ptr1; bl; bl = bl->next)
+		mark_bfnd(bl->ref);
+
+	for (bl = b->entry.Template.bl_ptr2; bl; bl = bl->next)
+		mark_bfnd(bl->ref);
+}
+
+
+void
+collect_garbage(fi)
+	PTR_FILE fi;
+{
+	PTR_LLND p, t;
+	int count;
+
+	p = free_ll_list;
+	count = 0;
+	while(p != NULL){
+		count++;
+		p = p->thread;
+	}
+
+	count = 0;
+	for (p = fi->head_llnd; p && p != fi->cur_llnd; p = p->thread){
+		p->id = 0;
+		count++;
+	}
+
+	fi->cur_llnd->id = 0; count++;
+
+	num_marked = 0;
+	mark_bfnd(fi->head_bfnd);
+	/* printf("num marked from bfnd = %d\n", num_marked); */
+
+	num_marked = 0;
+	mark_depnds(fi->head_dep);
+	/* printf("num marked from deps= %d\n", num_marked); */
+
+	num_marked = 0;
+	mark_symb(fi);
+	/* printf("num marked from symb= %d\n", num_marked); */
+
+	num_marked = 0;
+	mark_type(fi);
+	/* printf("num marked from type= %d\n", num_marked); */
+
+	num_marked = 0;
+	p = fi->head_llnd;
+	fi->cur_llnd = fi->head_llnd;
+	count = 1;
+	p->id = count++; p = p->thread;
+	fi->cur_llnd->thread = NULL;
+    
+	while(p != NULL){
+		if(p->id == -1){ /*touched */
+			fi->cur_llnd->thread = p;
+			fi->cur_llnd = p;
+                        p = p->thread;
+			fi->cur_llnd->id = count++;
+			fi->cur_llnd->thread = NULL;
+		} else if(p->id == 0) {
+			t = p; p = p->thread;
+			t->id = -2; num_marked++;
+			t->thread= free_ll_list;
+			t->entry.Template.ll_ptr1 = NULL;
+			t->entry.Template.ll_ptr2 = NULL;
+			t->entry.Template.symbol = NULL;
+			t->variant = 800;
+			free_ll_list = t;
+		      }
+               else { printf("error in garbage collection\n");
+		      exit(0);
+		    }
+		}
+	fi->num_llnds = count -1 ;
+	num_ll_allocated = 0;
+	printf(" total llnodes = %d garbage collected = %d\n",count, num_marked);
+}
+
+int num_of_llnds(fi)
+PTR_FILE fi;
+{ return fi->num_llnds; }

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/glob_anal.c

@@ -0,0 +1,494 @@
+/*********************************************************************/
+/*                  pC++/Sage++  Copyright (C) 1993                  */
+/*  Indiana University  University of Oregon  University of Rennes   */
+/*********************************************************************/
+
+
+/* file: glob_anal.c */
+
+#include <stdio.h>
+#include "db.h"
+#ifdef SYS5
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+#define MAX_FUNS 500
+
+#ifdef __SPF
+extern void addToCollection(const int line, const char *file, void *pointer, int type);
+#endif
+
+void *malloc();
+void bind_call_site_info();
+
+static PTR_FILE current_file;
+
+extern PTR_FILE cur_file;
+extern int debug;
+
+typedef struct call_list *PTR_CALLS;
+typedef struct function_decl *PTR_FUNCS;
+
+struct call_list {
+  char *name;
+  int funs_number;              /* set to the index in the funs table */
+  /* -1 if the function is unknown      */
+  PTR_LLND used, modified;
+  PTR_BFND call_site;           /* statement which holds call to this fun */
+  PTR_CALLS next;
+};
+
+
+struct function_decl {
+  PTR_FILE file;                /* file object where this function was
+                                 * defined */
+  PTR_SYMB name;                /* point to the symbol table of this functin */
+  PTR_BFND fun;                 /* point to the BIF node of this functio */
+  int is_done;
+  PTR_LLND used, modified;
+  PTR_CALLS calls;
+} funs[MAX_FUNS];
+
+int num_of_funs = 0;
+
+static int now;
+static int val[MAX_FUNS],       /* keep the depth-first numbering */
+ ival[MAX_FUNS];                /* keep the inverse calling numbering */
+
+
+/*
+ * visit does the depth-first numbering for nodes
+ * for the call graph
+ *
+ * the array "val" keep the depth-first visiting numbering
+ * while the array "ival" is the inverse of "val", i.e. is
+ * the reverse calling sequence
+ */
+static void visit(k)
+int k;
+{
+  PTR_CALLS p;
+
+  ival[now] = k;
+  val[k] = now++;
+  for (p = funs[k].calls; p; p = p->next)       /* for each adjacent node */
+    if (val[p->funs_number] < 0)/* haven't visited yet */
+      visit(p->funs_number);
+}
+
+
+/*
+ * dfs does the depth-first search of the call graph
+ */
+static void dfs()
+{
+  int k;
+
+  now = 0;                      /* keep track of the numbering */
+  for (k = 0; k < num_of_funs; k++)     /* initialize to be un-read */
+    val[k] = -1;
+  for (k = 0; k < num_of_funs; k++)     /* now do the depth-first search */
+    if (val[k] < 0)
+      visit(k);
+}
+
+
+void reset_llnd(p)
+PTR_LLND p;
+{
+  if (p == NULL)
+    return;
+  if (p->variant == VAR_REF) {
+    p->entry.Template.ll_ptr1 = NULL;
+  }
+  reset_llnd(p->entry.Template.ll_ptr1);
+  reset_llnd(p->entry.Template.ll_ptr2);
+}
+
+
+void reset_scalar_propogation(b)
+PTR_BFND b;
+{
+  PTR_BLOB bl;
+
+  if (b == NULL)
+    return;
+  if ((b->variant != FUNC_HEDR) && (b->variant != PROC_HEDR)) {
+    reset_llnd(b->entry.Template.ll_ptr1);
+    reset_llnd(b->entry.Template.ll_ptr2);
+    reset_llnd(b->entry.Template.ll_ptr3);
+  }
+  for (bl = b->entry.Template.bl_ptr1; bl; bl = bl->next)
+    reset_scalar_propogation(bl->ref);
+
+  for (bl = b->entry.Template.bl_ptr2; bl; bl = bl->next)
+    reset_scalar_propogation(bl->ref);
+}
+
+
+/* make_fun_decl initialized an entry in the funs table for a function at */
+/* statement b                                                            */
+static void make_fun_decl(f, b)
+PTR_FILE f;
+PTR_BFND b;
+{
+  PTR_FUNCS i;
+  PTR_LLND make_llnd();
+
+  i = funs + num_of_funs++;
+  if (num_of_funs > MAX_FUNS) {
+    fprintf(stderr, "Too many functions!\n");
+    return;
+  }
+
+  /* b's ll_ptr3 points to an expr list whose ll_ptr1 is the pre global */
+  /* analysis use set and whose ll_ptr2 will be the post analysis use set */
+  if (b->entry.Template.ll_ptr3 == NULL) {      /* summary of use info */
+    fprintf(stderr, "bad initial analysis. run vcc or cfp again\n");
+    b->entry.Template.ll_ptr3 = make_llnd(cur_file,EXPR_LIST,NULL, NULL, NULL);
+  }
+  if (b->entry.Template.ll_ptr2 == NULL) {      /* summary of mod info */
+    fprintf(stderr, "bad initial analysis. run vcc or cfp again\n");
+    b->entry.Template.ll_ptr2 = make_llnd(cur_file,EXPR_LIST, NULL, NULL, NULL);
+  }
+
+  i->file = f;
+  i->name = b->entry.Template.symbol;
+  i->fun = b;
+  i->is_done = 0;
+  i->used = b->entry.Template.ll_ptr3->entry.Template.ll_ptr1;
+  i->modified = b->entry.Template.ll_ptr2->entry.Template.ll_ptr1;
+  i->calls = NULL;
+}
+
+
+/* call this function with the project_object   */
+/* to build the list of functions.              */
+static void make_fun_list(proj)
+PTR_PROJ proj;
+{
+  PTR_FILE f;
+  PTR_BLOB b1, b;
+  PTR_BFND p;
+  PTR_REFL make_name_list();
+  PTR_SETS alloc_sets();
+  /* Scan through all files in the project */
+  for (b1 = proj->file_chain; b1; b1 = b1->next) {
+    f = (PTR_FILE) b1->ref;
+    for (b = f->global_bfnd->entry.Template.bl_ptr1; b; b = b->next)
+      if (b->ref->variant == FUNC_HEDR ||
+          b->ref->variant == PROC_HEDR ||
+          b->ref->variant == PROG_HEDR) {
+        make_fun_decl(f, b->ref);
+        p = b->ref;
+        if (p->entry.Template.sets == NULL)
+          p->entry.Template.sets = alloc_sets();
+        p->entry.Template.sets->out_use = NULL;
+        p->entry.Template.sets->in_use = NULL;
+        p->entry.Template.sets->out_def = NULL;
+        p->entry.Template.sets->in_def = NULL;
+        p->entry.Template.sets->gen = NULL;
+        p->entry.Template.sets->use = NULL;
+        /* set in_def  to be a ref list of all */
+        /* parameters to this proc.  this is   */
+        /* used in the global analysis phase   */
+        p->entry.Template.sets->in_def =
+          make_name_list(
+                         p->entry.Template.symbol->entry.proc_decl.in_list
+          );
+      }
+  }
+}
+
+
+/* find_by_name searches the funs list for the function whose name is */
+/* given by the char string s                                         */
+static int find_by_name(PTR_FILE f, char *s)
+/*PTR_FILE f;*/
+/*char *s;*/
+{
+  int i;
+
+  f = f;                        /* make lint happy, f unused */
+  for (i = 0; i < num_of_funs; i++)
+    if ( /* funs[i].file == f && */ (!strcmp(s, funs[i].name->ident)))
+      return i;
+  for (i = 0; i < num_of_funs; i++)
+    if (!strcmp(s, funs[i].name->ident))
+      return i;
+  return (-1);
+}
+
+PTR_BFND find_fun_by_name(s)
+char *s;
+{
+  int i;
+  i = find_by_name(NULL, s);
+  if (i < 0)
+    return NULL;
+  return funs[i].fun;
+}
+
+
+/* get_fun_number takes a pointer to a symbol table entry and looks */
+/* it up in the funs table and returns the index.  like the others  */
+/* it returns -1 if nothing is found that matches s.                */
+/*static int get_fun_number(f, s)
+PTR_FILE f;
+PTR_SYMB s;
+{
+  int i;
+  for (i = 0; i < num_of_funs; i++)
+    if (funs[i].file == f && funs[i].name == s)
+      return i;
+  return (-1);
+}*/
+
+
+/* append_to_call_list takes the symbol table pointer of a function */
+/* that calls another function whose name is given by a char string */
+/* and appends the name of the called function to the calls list of */
+/* the funs entry for the calling function.                         */
+static void append_to_call_list(calling_fun, called_fun_ident, bf)
+int calling_fun;
+char *called_fun_ident;
+PTR_BFND bf;
+{
+  int called_fun;
+  PTR_CALLS p;
+  PTR_BFND b;
+
+  called_fun = find_by_name(funs[calling_fun].file, called_fun_ident);
+  if (called_fun == -1) {
+    fprintf(stderr, "Called \"%s\" function not in the project\n",
+           called_fun_ident);
+    return;
+  }
+
+  b = funs[calling_fun].fun;
+  p = (PTR_CALLS) malloc(sizeof(struct call_list));
+#ifdef __SPF
+  addToCollection(__LINE__, __FILE__,p, 0);
+#endif
+  p->name = b->entry.Template.symbol->ident;
+  p->funs_number = called_fun;
+  p->call_site = bf;
+  p->used = NULL;
+  p->modified = NULL;
+  p->next = funs[calling_fun].calls;
+  funs[calling_fun].calls = p;
+}
+
+
+static void func_call_in_llnd(ll, i, bf)
+PTR_LLND ll;
+int i;
+PTR_BFND bf;
+{
+  if (ll == NULL)
+    return;
+  if (ll->variant == FUNC_CALL ||
+      ll->variant == PROC_CALL ||
+      ll->variant == FUNCTION_REF)
+    append_to_call_list(i, ll->entry.Template.symbol->ident, bf);
+
+  /* NOTE: the following code is "tag" dependent */
+  if (ll->variant >= VAR_LIST && ll->variant < CONST_NAME) {
+    func_call_in_llnd(ll->entry.Template.ll_ptr1, i, bf);
+    func_call_in_llnd(ll->entry.Template.ll_ptr2, i, bf);
+  }
+}
+
+
+static void func_call_in_bfnd(bl, i)
+PTR_BLOB bl;
+int i;
+{
+  PTR_BFND bf;
+  PTR_BLOB bl1;
+
+  for (bl1 = bl; bl1; bl1 = bl1->next) {
+    bf = bl1->ref;
+    if (bf->variant == PROC_CALL ||
+        bf->variant == FUNC_CALL ||
+        bf->variant == PROC_STAT)
+      append_to_call_list(i, bf->entry.Template.symbol->ident, bf);
+    func_call_in_llnd(bf->entry.Template.ll_ptr1, i, bf);
+    func_call_in_llnd(bf->entry.Template.ll_ptr2, i, bf);
+    func_call_in_llnd(bf->entry.Template.ll_ptr3, i, bf);
+
+    func_call_in_bfnd(bf->entry.Template.bl_ptr1, i);
+    func_call_in_bfnd(bf->entry.Template.bl_ptr2, i);
+  }
+}
+
+static void rec_list_cgraph(i)
+int i;
+{
+  func_call_in_bfnd(funs[i].fun->entry.Template.bl_ptr1, i);
+}
+
+
+void BuildCallGraph()
+{
+  int i;
+  fprintf(stderr, "\n the call graph is:\n");
+  for (i = 0; i < num_of_funs; i++) {
+    rec_list_cgraph(i);
+  }
+}
+
+
+/*
+ * ready_for_analysis returns
+ *
+ *      0  if not ready
+ *      1  if it is ready
+ *      2  if analysis is done.
+ */
+static int ready_for_analysis(i)
+int i;
+{
+  PTR_CALLS calls;
+
+  if (funs[i].is_done == 0) {
+    for (calls = funs[i].calls; calls; calls = calls->next)
+      if (calls->funs_number > -1 &&
+          funs[calls->funs_number].is_done == 0)
+        return (0);
+    return (1);
+  }
+  return (2);
+}
+
+
+static PTR_LLND link_ll_chain(list, elist)
+PTR_LLND list, elist;
+{
+  PTR_LLND p;
+
+  p = list;
+  while (p != NULL && p->entry.Template.ll_ptr2 != NULL)
+    p = p->entry.Template.ll_ptr2;
+  if (p != NULL)
+    p->entry.Template.ll_ptr2 = elist;
+  else
+    list = elist;
+  return (list);
+}
+
+
+static PTR_LLND link_ll_set_list(b, s)
+PTR_LLND s;
+PTR_BFND b;
+{
+  PTR_REFL rl, build_refl(), remove_locals_from_list();
+  PTR_LLND link_set_list();
+
+  rl = build_refl(b, s);
+  rl = remove_locals_from_list(rl);
+  return (link_set_list(rl));
+}
+
+
+static void use_mod(c)
+PTR_CALLS c;
+{
+  PTR_BFND b;
+  PTR_LLND used, modified;
+
+  b = c->call_site;
+  bind_call_site_info(b, &used, &modified);
+  c->used = link_ll_set_list(b, used);
+  c->modified = link_ll_set_list(b, modified);
+}
+
+
+static void compute_use_mod()
+{
+  int modified = 1;
+  PTR_CALLS calls;
+  PTR_LLND use, mod;
+  int i, j;
+
+  while (modified) {
+    modified = 0;
+    for (j = num_of_funs - 1; j >= 0; j--) {
+      i = ival[j];
+      if (ready_for_analysis(i) == 1) {
+	if (debug) {
+	  fprintf(stderr, "_______________________________\n");
+          fprintf(stderr, "doing global analysis for %s\n", funs[i].name->ident);
+        }
+        calls = funs[i].calls;
+	current_file = funs[i].file;
+        while (calls != NULL) {
+          if (calls->funs_number > -1 &&
+              funs[calls->funs_number].is_done == 1)
+            use_mod(calls);
+          calls = calls->next;
+        }
+        funs[i].is_done = 1;
+        /* now link results together */
+        use = funs[i].used;
+        mod = funs[i].modified;
+        calls = funs[i].calls;
+        while (calls != NULL) {
+          if (calls->funs_number > -1 &&
+              funs[calls->funs_number].is_done == 1) {
+            use = link_ll_chain(use, calls->used);
+            mod = link_ll_chain(mod, calls->modified);
+          }
+          calls = calls->next;
+        }
+        use = link_ll_set_list(funs[i].fun, use);
+        mod = link_ll_set_list(funs[i].fun, mod);
+        funs[i].used = link_ll_set_list(funs[i].fun, use);
+        funs[i].modified = link_ll_set_list(funs[i].fun, mod);
+        funs[i].fun->entry.Template.ll_ptr3
+          ->entry.Template.ll_ptr2 = funs[i].used;
+        funs[i].fun->entry.Template.ll_ptr2
+          ->entry.Template.ll_ptr2 = funs[i].modified;
+        modified = 1;
+      }
+    }                           /* end for */
+  }                             /* end while */
+
+  modified = 0;
+  for (i = 0; i < num_of_funs; i++) {
+    if (ready_for_analysis(i) == 2) {
+      funs[i].fun->entry.Template.ll_ptr3
+        ->entry.Template.ll_ptr2 = funs[i].used;
+      funs[i].fun->entry.Template.ll_ptr2
+        ->entry.Template.ll_ptr2 = funs[i].modified;
+    }
+    else
+      modified = 1;
+  }
+  if (modified && debug)
+    fprintf(stderr, "; cycle in call graph. no global analysis\n");
+  current_file = NULL;
+}
+
+
+/****************************************************************
+ *                                                              *
+ *  GlobalAnal -- does the inter-procedural analysis for the    *
+ *                given project                                 *
+ *                                                              *
+ *  Input:                                                      *
+ *        proj - the pointer to the project to be analized      *
+ *                                                              *
+ *  Output:                                                     *
+ *        none                                                  *
+ *                                                              *
+ ****************************************************************/
+void GlobalAnal(proj)
+PTR_PROJ proj;
+{
+  make_fun_list(proj);          /* gather all the functions declared */
+  BuildCallGraph();             /* build the call graph */
+  dfs();                        /* do the depth-first search */
+  compute_use_mod();            /* do the inter-procedural analysis now */
+}

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/ker_fun.c

@@ -0,0 +1,433 @@
+/*********************************************************************/
+/*                  pC++/Sage++  Copyright (C) 1993                  */
+/*  Indiana University  University of Oregon  University of Rennes   */
+/*********************************************************************/
+
+
+/* file: ker_fun.c */
+
+/**********************************************************************/
+/*  This file contains the routines called in sets.c that do all cache*/
+/*  analysis and estimation routines.                                 */
+/**********************************************************************/
+
+#include <stdio.h>
+#include "defs.h"
+#include "bif.h"
+#include "ll.h"
+#include "symb.h"
+#include "sets.h"
+
+#define PLUS 2
+#define ZPLUS 3
+#define MINUS 4
+#define ZMINUS 5
+#define PLUSMINUS 6
+#define NODEP -1
+
+#ifdef __SPF
+extern void addToCollection(const int line, const char *file, void *pointer, int type);
+#endif
+
+extern int show_deps;
+
+void *malloc();
+PTR_SETS alloc_sets();
+PTR_REFL alloc_ref();
+int disp_refl();
+PTR_REFL copy_refl();
+PTR_REFL union_refl();
+int **a_array;
+int a_allocd = 0;
+int x[20];                      /* a temporary used to compute the vector c */
+int c[20];                      /* such that h(c) = dist                    */
+int gcd();
+int make_induct_list();
+int comp_ker();
+int find_mults();
+
+int unif_gen(sor, des, vec, troub, source, destin)
+int vec[], troub[];
+struct ref *sor;
+struct ref *des;
+struct subscript *source;
+struct subscript *destin;
+{
+  PTR_SYMB sor_ind_l[MAX_NEST_DEPTH], des_ind_l[MAX_NEST_DEPTH];
+  struct subscript il_lo[MAX_NEST_DEPTH];
+  struct subscript il_hi[MAX_NEST_DEPTH];
+  PTR_LLND ll, tl;
+  int arr_dim, uniform;
+  int v[AR_DIM_MAX];
+  int r, i, j, sd, dd, depth;
+
+  /* the a array that is used here is allocated once and used */
+  /* again in future calls */
+
+  if (a_allocd == 0) {
+      a_allocd = 1;
+      a_array = (int **)malloc(MAX_NEST_DEPTH * (sizeof(int *)));
+#ifdef __SPF
+      addToCollection(__LINE__, __FILE__,a_array, 0);
+#endif
+      for (i = 0; i < MAX_NEST_DEPTH; i++)
+      {
+          a_array[i] = (int *)malloc((AR_DIM_MAX + MAX_NEST_DEPTH) * (sizeof(int)));
+#ifdef __SPF
+          addToCollection(__LINE__, __FILE__,a_array[i], 0);
+#endif
+      }
+  }
+  for (i = 0; i < MAX_NEST_DEPTH; i++) {
+    sor_ind_l[i] = NULL;
+    des_ind_l[i] = NULL;
+  }
+
+
+  dd = make_induct_list(des->stmt, des_ind_l, il_lo, il_hi);
+  sd = make_induct_list(sor->stmt, sor_ind_l, il_lo, il_hi);
+
+  depth = (sd < dd) ? sd : dd;
+
+  i = 0;
+  while ((i < depth) && (des_ind_l[i] == sor_ind_l[i]))
+    i++;
+  if (i < depth)
+    depth = i;
+
+  arr_dim = 0;
+  /* compute the dimension of the array */
+  ll = sor->refer;
+  if (ll->variant == ARRAY_REF) {
+    tl = ll->entry.array_ref.index;
+    while (tl != NULL) {
+      if ((tl->variant == VAR_LIST) ||
+          (tl->variant == EXPR_LIST) ||
+          (tl->variant == RANGE_LIST)) {
+        tl = tl->entry.list.next;
+        arr_dim++;
+      }
+    }
+  }
+  uniform = 1;
+  for (i = 0; i < arr_dim; i++) {
+    if (source[i].decidable != destin[i].decidable)
+      uniform = 0;
+    v[i] = source[i].offset - destin[i].offset;
+    for (j = 0; j < depth; j++)
+      if (source[i].coefs[j] != destin[i].coefs[j])
+        uniform = 0;
+  }
+  if (uniform == 1) {
+    r = comp_ker(arr_dim, depth, source, a_array, sor_ind_l, v, vec, troub);
+  }
+  /* else if (show_deps) fprintf(stderr, "not uniform\n"); */
+  return (uniform);
+
+}
+
+/* comp_ker is a function that takes the matrix "h" associated with        */
+/* a uniformly generated (potential) dependence and a offest vector "dist" */
+/* and computes the distance vector "vec" and a trouble vector "troub"     */
+/* the matrix is associated with the access function of an array reference */
+/* where the array is of dimension "adim" and the depth of nesting is      */
+/* depth.  The "a" array is a matrix that is allocated by the caller and   */
+/* upon return contains a factorization of "h".  The array is "depth" rows */
+/* by dept+adim columns but is viewed as its transpose mathematically.     */
+/* It should be allocated as MAX_NEST_DEPTH by AR_DIM_MAX+MAX_NEST_DEPTH   */
+/* In other words "a" is first initialized as
+             
+                  |<- depth ->|
+           -------|           |
+            ^     |           |
+           adim   |    h      |
+            v     |           |
+           -------|-----------|  where rows in C are columns.
+            ^     |           |
+           depth  |    I      |
+            v     |           |
+           --------------------
+
+   A factoriation takes place which converts this to the form where the
+h component is now the matrix L and the Identity block I is now a square
+matrix B such that
+             L = hB
+
+and L is lower triangular and B and L  are integer valued.  
+
+What this means is that
+if dist = Lx, for some x then let c be such that c = Bx and we have 
+dist = Lx = hBx = hc.  (note x and c are global and returned by side effect.)
+and c is the distance vector.
+
+Furturemore, comp_ker returns the dimension of ker(h) and the right hand
+dim(ker(h)) columns of B form a basis of the kernel.
+
+*/
+
+  
+int comp_ker(adim, depth, sa, a, sor_ind_l, dist, vec, troub)
+int adim, depth;
+struct subscript *sa;
+int **a;
+PTR_SYMB sor_ind_l[];
+int dist[];
+int vec[], troub[];
+{
+  int i, j, k, piv_row, piv_col, cols_done, m, mval, cur_x;
+  int nosolution;
+  int p, q, r, s, z;
+  int *tmp;
+
+  sor_ind_l = sor_ind_l;        /* make lint happy, sor_ind_l not used */
+
+  /* h components in first adim rows of matrix */
+  for (i = 0; i < adim; i++) {
+    for (j = 0; j < depth; j++)
+      a[j][i] = sa[i].coefs[j];
+  }
+
+  /* depth by depth square identity in second block of matrix */
+  for (i = adim; i < adim + depth; i++) {
+    for (j = 0; j < depth; j++)
+      if ((i - adim) == j)
+        a[j][i] = 1;
+      else
+        a[j][i] = 0;
+  }
+  /* if(show_deps) print_a_arr(adim+depth,depth); */
+  /* The following is a factorization of the  array H from the */
+  /* function h (stored as the upper part of a ) into a lower  */
+  /* triangluar matrix L and a matrix B such that L = HB          */
+  /* now do column operations to reduce top to lower triangular */
+  /* remember that a is transposed to use pointers for columns */
+  /* for each row ... */
+  cols_done = 0;
+  for (i = 0; i < adim; i++) {
+    piv_row = i;
+    piv_col = cols_done;
+    while ((a[piv_col][piv_row] == 0) && (piv_col < depth))
+      piv_col++;
+    if (piv_col < depth) {
+      m = piv_col;
+      mval = a[m][piv_row];
+      mval = mval * mval;
+      k = 0;
+      /* pick min non-zero term on row to right of cols_done */
+      for (j = cols_done; j < depth; j++)
+        if ((a[j][piv_row] != 0) &&
+            ((a[j][piv_row] * a[j][piv_row]) < mval)) {
+          m = j;
+          mval = a[j][piv_row] * a[j][piv_row];
+        }
+      /* now move col m to col cols_done */
+      tmp = a[m];
+      a[m] = a[cols_done];
+      a[cols_done] = tmp;
+      /* now eliminate rest of row */
+      for (j = cols_done + 1; j < depth; j++)
+        if (a[j][piv_row] != 0) {
+          find_mults(a[cols_done][piv_row],
+                     a[j][piv_row], &p, &q, &r, &s);
+          for (k = 0; k < adim + depth; k++) {
+            z = a[cols_done][k] * p + a[j][k] * q;
+            a[j][k] = a[cols_done][k] * r
+              + a[j][k] * s;
+            a[cols_done][k] = z;
+          }
+          if (a[cols_done][piv_row] == 0) {
+            tmp = a[j];
+            a[j] = a[cols_done];
+            a[cols_done] = tmp;
+          }
+        }
+      cols_done++;
+    }
+  }
+  /* reduce system by gcd of each column */
+  for (j = 0; j < depth; j++) {
+    z = gcd(depth + adim, a[j]);
+    if (z != 1 && z != 0) {
+      for (k = 0; k < adim + depth; k++)
+        a[j][k] = a[j][k] / z;
+    }
+  }
+
+  /* now back solve for x in dist = Lx */
+  nosolution = 0;
+  cur_x = 0;
+  for (j = 0; (j < adim && cur_x < depth); j++) {
+    z = 0;
+    for (k = 0; k < cur_x; k++)
+      z = z + a[k][j] * x[k];
+    if (a[cur_x][j] == 0) {
+      if (z != dist[j]) {
+        nosolution = 1;
+      }
+      /* this equation is consistent, so skip it */
+    }
+    else {
+      r = (dist[j] - z) / a[cur_x][j];
+      if (r * a[cur_x][j] != dist[j] - z) {
+        nosolution = 1;
+      }
+      x[cur_x] = r;
+      cur_x++;
+    }
+  }
+  for (j = cur_x; j < depth; j++) x[j] = 0;
+
+
+  /* the following is a double check on the solution */
+
+  for (j = 0; j < adim; j++) {
+    z = 0;
+    for (k = 0; k < depth; k++)
+      z = z + a[k][j] * x[k];
+    if (z != dist[j])
+      nosolution = 1;
+  }
+  /* if there is no solution then there is no dependence! */
+  if (nosolution) {
+    troub[0] = 1;
+    return (depth - cols_done);
+  }
+  /* because L = HB where B is the lower block of a       */
+  /* and dist = Lx  we have dist = HBx, so if c = Bx, dist = Hc    */
+  for (j = 0; j < depth; j++) {
+    c[j] = 0;
+    for (k = 0; k < depth; k++)
+      c[j] = c[j] + a[k][j + adim] * x[k];
+  }
+  /* to compute vec and troub, we start by setting */
+  /* vec to c.  (if ker(h) =0) we are done then  */
+  for (j = 0; j < depth; j++)
+    vec[j + 1] = c[j];
+  /* we now modify by the leading terms of the ker basis */
+  for (j = cols_done; j < depth; j++) {
+    /* find leading non-zero */
+    z = -1;
+    for (k = 0; k < depth; k++)
+      if (z == -1 && a[j][k + adim] != 0)
+        z = k;
+    if (z > -1) {
+      troub[z + 1] = PLUS;
+    }
+  }
+  z = 100;
+  for (j = 1; j < depth + 1; j++) {
+    if (troub[j] == PLUS || vec[j] > 0)
+      z = j;
+    if (troub[j] != PLUS && vec[j] < 0 && z == 100) {
+      troub[0] = 1;
+      /* fprintf(stderr, " reject - wrong direction \n"); */
+      return (depth - cols_done);
+    }
+    if (z < j && troub[j] == PLUS && vec[j] < 0)
+      troub[j] = ZPLUS;
+  }
+
+  /* print_a_arr(adim+depth,depth); */
+  return (depth - cols_done);
+}
+
+static int myabs(x)
+int x;
+{
+  if (x < 0)
+    return (-x);
+  else
+    return (x);
+}
+
+int eval_h(c, depth, i, val)
+int c[];
+int depth, i, val;
+{
+  depth = depth;                /* make lint happy, depth unused */
+
+  return (c[i] * val);
+}
+
+int find_mults(a, b, p1, q1, r1, s1)
+int a, b;
+int *p1;
+int *q1;
+int *r1;
+int *s1;
+{
+  /* upon return :      a*p+b*q  or a*r+b*s is 0 */
+  int p, q, r, s, olda, oldb;
+
+  olda = a;
+  oldb = b;
+  p = 1;
+  q = 0;
+  r = 0;
+  s = 1;
+  while (a * b != 0) {
+    if (a == b) {
+      r = r - p;
+      s = s - q;
+      b = 0;
+    }
+    else if (a == -b) {
+      r = r + p;
+      s = s + q;
+      b = 0;
+    }
+    else if (myabs(a) < myabs(b)) {
+      if (a * b > 0) {          /* same sign */
+        r = r - p;
+        s = s - q;
+        b = b - a;
+      }
+      else {
+        r = r + p;
+        s = s + q;
+        b = b + a;
+      }
+    }
+    else {
+      if (a * b > 0) {
+        p = p - r;
+        q = q - s;
+        a = a - b;
+      }
+      else {
+        p = p + r;
+        q = q + s;
+        a = a + b;
+      }
+    }
+  }                             /* end while */
+
+  if ((a != (olda * p + oldb * q)) || (b != (olda * r + oldb * s)))
+    fprintf(stderr, " reduce failed!\n");
+  *p1 = p;
+  *q1 = q;
+  *r1 = r;
+  *s1 = s;
+return 1;
+}
+
+void print_a_arr(rows, cols)
+int rows, cols;
+{
+  int i, j;
+  for (i = 0; i < rows; i++) {
+    fprintf(stderr, "    | ");
+    for (j = 0; j < cols; j++) {
+      fprintf(stderr, " %d ", a_array[j][i]);
+      if (j == cols - 1)
+        fprintf(stderr, "        |\n");
+    }
+  }
+}
+
+
+
+
+
+
+

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/list.c

@@ -0,0 +1,655 @@
+/*********************************************************************/
+/*                  pC++/Sage++  Copyright (C) 1993                  */
+/*  Indiana University  University of Oregon  University of Rennes   */
+/*********************************************************************/
+
+#include <stdlib.h>
+
+#include "db.h"
+#include "list.h"
+ 
+/* the following declarations are temporary fixes until we */
+/* decide how to deal with numbering and write nodes.	   */
+
+#ifdef __SPF
+extern void addToCollection(const int line, const char *file, void *pointer, int type);
+#endif
+
+struct bfnd cbfnd;
+struct dep  cdep;
+
+static LIST lis_array;
+static int list_not_ready = 1;
+
+/* end of declaration hack */
+
+extern PTR_FILE cur_file;
+
+PTR_BFND make_bfnd();
+PTR_BLOB make_blob();
+PTR_LLND make_llnd();
+PTR_LLND copy_llnd();
+PTR_SYMB make_symb();
+
+/************************************************************************
+ *									*
+ *	List manipuliation functions alloc_list(), push_llnd()		*
+ *	push_symb(), free_list() to be used by make_expr()		*
+ *									*
+ ************************************************************************/
+
+LIST
+alloc_list(type)
+	int type;
+{
+	int i;
+
+	if(list_not_ready){
+		lis_array   =  (LIST) calloc(NUMLIS, sizeof(struct lis_node));
+#ifdef __SPF
+        addToCollection(__LINE__, __FILE__,lis_array, 0);
+#endif
+		for(i = 0; i < NUMLIS; i++) 
+			lis_array[i].variant = UNUSED; 
+		list_not_ready = 0;
+	}
+	for(i = 0; i < NUMLIS; i++)
+		if(lis_array[i].variant == UNUSED){
+			lis_array[i].variant = type;
+			return(&lis_array[i]);
+		}
+	return(NULL);
+}
+
+
+/* push the low level node llnd on the front of list lis */
+LIST
+push_llnd(llnd, lis)
+	PTR_LLND llnd;
+	LIST lis;
+{
+	LIST nl;
+
+	nl = alloc_list(LLNDE);
+	nl->entry.llnd = llnd;
+	nl->next = lis;
+	return(nl);
+}
+
+
+/* push the symb node symb on the front of list lis */
+LIST
+push_symb(symb, lis)
+	PTR_SYMB symb;
+	LIST lis;
+{
+	LIST nl;
+
+	nl = alloc_list(SYMNDE);
+	nl->entry.symb = symb;
+	nl->next = lis;
+	return(nl);
+}
+
+
+void
+free_list(lis)
+	LIST lis;
+{
+	LIST nxt;
+
+	while(lis != NULL){
+		lis->variant = UNUSED;
+		nxt = lis->next;
+		lis->next = NULL;
+		lis = nxt;
+	}
+}
+
+
+
+/************************************************************************
+ *									*
+ *		blob list manipulation routines car, cdr, append.	*
+ *									*
+ ************************************************************************/
+
+#define car(bl_list)  bl_list->ref
+#define cdr(bl_list)  bl_list->next
+
+PTR_BLOB
+cons( bif, bl_list)
+	PTR_BFND bif;
+	PTR_BLOB bl_list;
+{
+	return (make_blob(cur_file, bif, bl_list));
+}
+
+
+/* append without copy -- not standard lisp append */
+PTR_BLOB
+append(bl_list, bif)
+	PTR_BLOB bl_list;
+	PTR_BFND bif;
+{
+	PTR_BLOB b;
+
+	if (bl_list == NULL)
+		return(make_blob(cur_file, bif, NULL));
+
+	for (b = bl_list; b->next; b = b->next)
+		;
+	b->next = make_blob(cur_file, bif, NULL);
+	return(bl_list);
+}
+
+
+
+
+/*
+ * get_r_follow_node recursively checks source and all of its decendents until
+ * it finds the ith dependence.	 It returns the node on the same level as
+ * source.
+ */
+PTR_BFND
+get_r_follow_node(par,source,bfptr,j,i)
+    PTR_BFND bfptr, par, source;
+    int *j;
+    int i;
+{
+	PTR_DEP  p;
+	PTR_BFND targ;
+	PTR_BLOB b;
+	PTR_BFND child, final; 
+
+	p = bfptr->entry.Template.dep_ptr1;
+	while(( p != NULL) && ( *j <= i)) {
+		if((p->to.stmt != source) &&
+		   ((p->type == 0) ||(p->type == 1) ||(p->type == 2))
+		   ){
+			if( *j == i){ 
+				targ = p->to.stmt;
+				while(targ != NULL && targ->variant != GLOBAL &&
+				      targ->control_parent != par) targ = targ->control_parent; 
+				if(targ->variant == GLOBAL) return(NULL);
+				else if (targ == source) p = p->from_fwd;
+				else return( targ);
+			}
+			else {
+				p =p->from_fwd;
+				*j = (*j)+1;
+			}
+		}
+		else p =p->from_fwd;
+	} 
+	if(p == NULL && (bfptr->variant == FOR_NODE || bfptr->variant == FORALL_NODE || bfptr->variant == IF_NODE)){ 
+		b = bfptr->entry.Template.bl_ptr1;
+		while(b != NULL && *j <=i){ 
+			child = b->ref;
+			final = get_r_follow_node(par,source,child,j,i);
+			if(final != NULL && final != source) return(final);
+			b = b->next;
+		}
+	}
+	if(p == NULL && bfptr->variant == IF_NODE){ 
+		b = bfptr->entry.Template.bl_ptr2;
+		while(b != NULL && *j <=i){ 
+			child = b->ref;
+			final = get_r_follow_node(par,source,child,j,i);
+			if(final != NULL && final != source) return(final);
+			b = b->next;
+		} 
+	}
+	/* if *j <= i then we are not there yet but out of dependences and childern so return null */
+  
+	return(NULL);
+}
+
+
+/* returns pointer to i-th bf-node following *bfptr in dep order */
+PTR_BFND
+get_follow_node(bfptr,i)
+	PTR_BFND bfptr;
+	int i;
+{
+	PTR_BFND par    = bfptr->control_parent,
+	source = bfptr;
+	int	     j	    = 0;
+    
+	return(get_r_follow_node(par,source,bfptr,&j,i));
+}  
+
+/****************************************************************
+ *								*
+ *		MAKE functions: make_expr(),			*
+ *				mk_llnd(),			*
+ *				make_ddnd(),			*
+ *				mk_symb(),			*
+ *				make_asign()			*
+ *				make_for()  & mkloop()		*
+ *				make_cntlend()			*
+ *								*
+ ****************************************************************/
+
+PTR_LLND
+mk_llnd(PTR_LLND p)
+/*	PTR_LLND p;*/
+{
+	PTR_LLND nd;
+	
+	nd = make_llnd(cur_file, 0, NULL, NULL, NULL);
+	if (p != NULL){
+		nd->variant = p->variant;
+		nd->type = p->type;   
+		nd->entry.Template.symbol = p->entry.Template.symbol;
+		nd->entry.Template.ll_ptr1 = p->entry.Template.ll_ptr1;
+		nd->entry.Template.ll_ptr2 = p->entry.Template.ll_ptr2;
+	} else
+		nd->variant = VAR_REF;
+	return(nd);
+}
+
+
+PTR_SYMB
+mk_symb(name,p)
+	char    *name;
+	PTR_SYMB p;
+{
+	PTR_SYMB nd;
+	
+	nd = make_symb(cur_file, 0, name);
+	if (p != NULL){
+		nd->variant = p->variant;
+		nd->type = p->type;
+		nd->next_symb = p->next_symb;
+		p->next_symb = nd;
+		nd->parent = p->parent;
+	} else {
+		nd->variant = VARIABLE_NAME;
+		nd->type = NULL;
+		nd->next_symb = NULL;
+		nd->parent = NULL;
+	}
+	nd->entry.var_decl.local = LOCAL;
+	nd->outer = NULL;
+	nd->id_list = NULL;
+	
+	return(nd);
+}
+
+
+static LIST lispt;
+
+/* op = one of ADD_OP SUBT_OP MULT_OP DIV_OP (or other binary ops) */
+PTR_LLND
+make_oper(op)
+	int op;
+{
+	PTR_LLND nd;
+
+	nd = mk_llnd(NULL);
+	nd->variant = op;
+	return(nd);
+}
+
+
+PTR_LLND
+make_arref(ar,index)
+    PTR_SYMB ar;
+    PTR_LLND index;
+{
+	PTR_LLND nd;
+
+	nd = mk_llnd(NULL);
+	nd->variant = ARRAY_REF;
+	nd->entry.array_ref.symbol = ar;
+	nd->entry.array_ref.index = index;
+	nd->entry.array_ref.array_elt = NULL;
+	return(nd);
+}
+
+
+PTR_LLND
+make_int(i)
+	int i;
+{
+	PTR_LLND nd;
+
+	nd = mk_llnd(NULL);
+	nd->variant = INT_VAL;
+	nd->entry.ival = i;
+	return(nd);
+}
+
+
+PTR_LLND
+hmake_expr()
+{
+	LIST lis;
+	PTR_LLND nd;
+     
+	if (lispt  == NULL)
+		return(NULL);
+
+	lis = lispt;
+	lispt = lis->next;
+	if (lis->variant == SYMNDE){
+		nd = mk_llnd(NULL);
+		if(lis->entry.symb->variant == VARIABLE_NAME)
+			nd->variant = VAR_REF;
+		else
+			fprintf(stderr, "wrong symbol type in make_expr");
+		nd->entry.Template.symbol = lis->entry.symb;
+		return(nd);
+	} else if(lis->variant == LLNDE){
+		nd = lis->entry.llnd;
+		switch (nd->variant) {
+		case DDOT	:
+		case EQ_OP	:
+		case LT_OP	:
+		case GT_OP	:
+		case NOTEQL_OP	:
+		case LTEQL_OP	:
+		case GTEQL_OP	:
+		case ADD_OP	:
+		case SUBT_OP 	:
+		case OR_OP	:
+		case MULT_OP 	:
+		case DIV_OP	:
+		case MOD_OP	:
+		case AND_OP	:
+		case EXP_OP	:
+			if (nd->entry.binary_op.l_operand == NULL){
+				nd->entry.binary_op.l_operand =
+					hmake_expr();
+				nd->entry.binary_op.r_operand =
+					hmake_expr();
+			}
+			break;
+		case MINUS_OP	:
+		case NOT_OP	:
+			if (nd->entry.unary_op.operand == NULL){
+				nd->entry.unary_op.operand =
+					hmake_expr();
+			}
+			break;
+			
+		default:
+			break;
+		}
+		return(nd);
+	}
+	return NULL;
+}
+
+
+/*
+ * this routine creates a low level expression tree from the preorder
+ * list of llnds and symbol pointers then deletes the list
+ */
+PTR_LLND
+make_expr(lis)
+	LIST lis;
+{
+	LIST L;
+	PTR_LLND n;
+
+	L = lis;
+	lispt = lis;
+	n = hmake_expr();
+	free_list(L);
+	return(n);
+}
+
+
+PTR_BFND
+make_asign(lhs,rhs)
+	PTR_LLND lhs,rhs;
+{
+	return(make_bfnd(cur_file, ASSIGN_STAT, NULL, lhs, rhs, NULL));
+}
+
+
+PTR_BFND
+make_for(index,range)
+	PTR_SYMB index;
+	PTR_LLND range;
+{
+	return(make_bfnd(cur_file, FOR_NODE, index, range, NULL, NULL));
+}
+
+
+/*
+ * make a for_node like *p
+ * this is a special version used by distribute
+ */
+PTR_BFND
+mkloop(p)
+	PTR_BFND p;
+{
+	PTR_BFND newp;
+ 
+	/* we should be making new copies of the following structures! */
+	newp = make_bfnd(cur_file,
+			 FOR_NODE,
+			 p->entry.Template.symbol,
+			 p->entry.Template.ll_ptr1,
+			 p->entry.Template.ll_ptr2,
+			 p->entry.Template.ll_ptr3);
+
+	newp->entry.Template.bf_ptr1  = p->entry.Template.bf_ptr1;
+	newp->entry.Template.cmnt_ptr  = p->entry.Template.cmnt_ptr;
+	
+	newp->filename = p->filename;
+	return(newp);
+}
+
+
+
+PTR_BFND
+make_cntlend(par)
+	PTR_BFND par;
+{
+	PTR_BFND b;
+
+	b = make_bfnd(cur_file, CONTROL_END, NULL, NULL, NULL, NULL);
+	b->control_parent = par;
+	return(b);
+}
+ 
+
+static int modified = 0;
+
+/* create a NEW low level node tree with cvar replaced by newref */
+PTR_LLND
+replace_ref(lnd,cvar,newref)
+	PTR_LLND lnd;
+	PTR_SYMB cvar;
+	PTR_LLND newref;
+{
+	PTR_LLND pllnd, rtnval;
+	
+	if (lnd == NULL) return(NULL);
+	
+	pllnd = mk_llnd(lnd);
+	rtnval = pllnd;
+
+	switch (pllnd->variant) {
+	case CONST_REF:
+	case VAR_REF  :
+	case ENUM_REF :
+		if( pllnd->entry.Template.symbol==cvar){
+			/* replace with subtree consisting of newref */
+			modified = 1;
+			rtnval = copy_llnd(newref);
+		}
+		break;
+	case ARRAY_REF:
+		pllnd->entry.array_ref.index =
+			replace_ref(pllnd->entry.array_ref.index,cvar,newref);
+		if (pllnd->entry.array_ref.array_elt != NULL) {
+			pllnd->entry.array_ref.array_elt =
+				replace_ref(pllnd->entry.array_ref.array_elt,cvar,newref);
+		}
+		break;
+	case RECORD_REF:
+		if (pllnd->entry.record_ref.rec_field != NULL) {
+			pllnd->entry.record_ref.rec_field =
+				replace_ref(pllnd->entry.record_ref.rec_field,cvar,newref);
+		}
+		break;
+	case PROC_CALL	:
+	case FUNC_CALL	:
+		pllnd->entry.proc.param_list =
+			replace_ref(pllnd->entry.proc.param_list,cvar,newref);
+		break;
+	case VAR_LIST	:
+	case EXPR_LIST	:
+	case RANGE_LIST	:
+		pllnd->entry.list.item =
+			replace_ref(pllnd->entry.list.item,cvar,newref);
+		if (pllnd->entry.list.next != NULL) {
+			pllnd->entry.list.next =
+				replace_ref(pllnd->entry.list.next,cvar,newref);
+		}
+		break;
+
+	case CASE_CHOICE:
+	case DDOT	:
+		pllnd->entry.binary_op.l_operand =
+			replace_ref(pllnd->entry.binary_op.l_operand,cvar,newref);
+		pllnd->entry.binary_op.r_operand =
+			replace_ref(pllnd->entry.binary_op.r_operand,cvar,newref);
+		break;
+		/* binary ops */
+	case EQ_OP	:
+	case LT_OP	:
+	case GT_OP	:
+	case NOTEQL_OP	:
+	case LTEQL_OP	:
+	case GTEQL_OP	:
+	case ADD_OP	:
+	case SUBT_OP	:
+	case OR_OP	:
+	case MULT_OP	:
+	case DIV_OP	:
+	case MOD_OP	:
+	case AND_OP	:
+	case EXP_OP	:
+		pllnd->entry.binary_op.l_operand =
+			replace_ref(pllnd->entry.binary_op.l_operand,cvar,newref);
+		pllnd->entry.binary_op.r_operand =
+			replace_ref(pllnd->entry.binary_op.r_operand,cvar,newref);
+		break;
+	case MINUS_OP:
+	case NOT_OP	 :
+		pllnd->entry.unary_op.operand =
+			replace_ref(pllnd->entry.unary_op.operand,cvar,newref);
+		break;
+	default:
+		break;
+	}
+	return(rtnval);
+}
+
+
+/* routine to make double dot node  low..hi  from an expression */
+PTR_LLND
+make_ddnd(pllnd,cvar,low,hi)
+	PTR_LLND pllnd,low,hi;
+	PTR_SYMB cvar;
+{
+	PTR_LLND tmp, dotnd;
+	
+	tmp = replace_ref(pllnd,cvar,low);
+	if(modified){ 
+		dotnd = mk_llnd(NULL);
+		dotnd->variant = DDOT;
+		dotnd->entry.Template.symbol = NULL;
+		dotnd->entry.Template.ll_ptr1 = tmp;
+		dotnd->entry.Template.ll_ptr2 = 
+			replace_ref(pllnd,cvar,hi);
+		return(dotnd);
+	}
+	else return(pllnd);
+}
+
+
+/*
+ * create a new ddot node for every array-ref in expression containing
+ * a reference to cvar
+ */
+void
+expand_ref(pllnd,cvar,low,hi)
+	PTR_LLND	pllnd;
+	PTR_SYMB	cvar;
+	PTR_LLND	low,hi;
+{
+	if (pllnd == NULL) return;
+
+	switch (pllnd->variant) {
+	case ARRAY_REF:
+		/* [ */
+		modified = 0;	/* set changed flag */
+		if((pllnd->entry.array_ref.index->variant != EXPR_LIST) &&
+		   (pllnd->entry.array_ref.index->variant != RANGE_LIST))
+			pllnd->entry.array_ref.index =
+				make_ddnd(pllnd->entry.array_ref.index,cvar,low,hi);
+		else expand_ref(pllnd->entry.array_ref.index,cvar,low,hi);
+		
+		/* otherwise this is a scalar reference and should */
+		/* not be changed here. In any case reset flag	   */
+		modified = 0;
+		/* ] */
+		break;
+	case RECORD_REF:
+		if (pllnd->entry.record_ref.rec_field != NULL) 
+			expand_ref(pllnd->entry.record_ref.rec_field,cvar,low,hi);
+		break;
+	case PROC_CALL:
+	case FUNC_CALL:
+		expand_ref(pllnd->entry.proc.param_list,cvar,low,hi);
+		break;
+	case VAR_LIST :
+	case EXPR_LIST:
+	case RANGE_LIST:
+		/* the other place where something can happen is here	*
+		 * if we have a[i,j] and we are vectorizing j then this *
+		 * should be a[i,low..hi], unless it is i we are after	*/
+		modified = 0;
+		pllnd->entry.list.item =
+			make_ddnd(pllnd->entry.list.item,cvar,low,hi);
+		modified = 0;
+		if (pllnd->entry.list.next != NULL) {
+			/* pllnd->entry.list.next = */
+			expand_ref(pllnd->entry.list.next,cvar,low,hi);
+			modified = 0;
+		}
+		break;
+	case EQ_OP	:
+	case LT_OP	:
+	case GT_OP	:
+	case NOTEQL_OP:
+	case LTEQL_OP:
+	case GTEQL_OP:
+	case ADD_OP	:
+	case SUBT_OP:
+	case OR_OP	:
+	case MULT_OP:
+	case DIV_OP	:
+	case MOD_OP	:
+	case AND_OP	:
+	case EXP_OP	:
+		expand_ref(pllnd->entry.binary_op.l_operand,cvar,low,hi);
+		expand_ref(pllnd->entry.binary_op.r_operand,cvar,low,hi);
+		break;
+	case MINUS_OP:
+		expand_ref(pllnd->entry.unary_op.operand,cvar,low,hi);
+		break;
+	case NOT_OP	:
+		expand_ref(pllnd->entry.unary_op.operand,cvar,low,hi);
+		break;
+	default:
+		break;
+	}
+}

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/make_nodes.c

@@ -0,0 +1,641 @@
+/*********************************************************************/
+/*                  pC++/Sage++  Copyright (C) 1993                  */
+/*  Indiana University  University of Oregon  University of Rennes   */
+/*********************************************************************/
+
+#include <stdlib.h>
+
+#include "db.h"
+#include "compatible.h"
+#ifdef SYS5
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+ 
+#ifdef __SPF
+extern void addToCollection(const int line, const char *file, void *pointer, int type);
+#endif
+
+#define ALLOC(x)  (struct x *) chkalloc(sizeof(struct x))
+#define LABUNKNOWN  0
+
+/*
+ * External references
+ */
+extern PTR_FILE cur_file;
+
+/*
+ * copyn -- makes a copy of a string with known length
+ *
+ * input:
+ *	  n - length of the string "s"
+ *	  s - the string to be copied
+ *
+ * output:
+ *	  pointer to the new string
+ */
+char   *
+copyn(int n, char *s)
+/*	int n; */
+/*	char *s; */
+{
+	char *p, *q;
+
+	p = q = (char *) calloc(1, (unsigned) n);
+#ifdef __SPF
+    addToCollection(__LINE__, __FILE__,p, 0);
+#endif
+	while (--n >= 0)
+		*q++ = *s++;
+	return (p);
+}
+
+
+/*
+ * copys -- makes a copy of a string
+ *
+ * input:
+ *	  s - string to be copied
+ *
+ * output:
+ *	  pointer to the new string
+ */
+char   *
+copys(s)
+	char   *s;
+{
+	return (copyn(strlen(s) + 1, s));
+}
+
+
+char *
+chkalloc(int n)
+/*	int n; */
+{
+	char *p;
+
+    if ((p = (char *)calloc(1, (unsigned)n)) != 0)
+    {
+#ifdef __SPF
+        addToCollection(__LINE__, __FILE__,p, 0);
+#endif
+        return (p);
+    }
+	return NULL;
+}
+
+
+PTR_BFND
+alloc_bfndnt (fi)
+	PTR_FILE fi;
+{
+	register PTR_BFND new;
+
+	new = ALLOC (bfnd);
+	new->id = ++(fi->num_bfnds);
+	new->thread = BFNULL;
+	return (new);
+}
+
+PTR_BFND
+alloc_bfnd (fi)
+	PTR_FILE fi;
+{
+	register PTR_BFND new;
+
+	new = ALLOC (bfnd);
+	new->id = ++(fi->num_bfnds);
+	new->thread = BFNULL;
+	if (fi->num_bfnds == 1)
+		fi->head_bfnd = new;
+	else
+		fi->cur_bfnd->thread = new;
+	fi->cur_bfnd = new;
+	return (new);
+}
+
+
+PTR_LLND
+alloc_llnd (fi)
+	PTR_FILE fi;
+{
+	register PTR_LLND new;
+
+	new = ALLOC (llnd);
+	new->id = ++(fi->num_llnds);
+	new->thread = LLNULL;
+	if (fi->num_llnds == 1)
+		fi->head_llnd = new;
+	else
+		fi->cur_llnd->thread = new;
+	fi->cur_llnd = new;
+	return (new);
+}
+
+
+PTR_TYPE
+alloc_type (fi)
+	PTR_FILE fi;
+{
+	PTR_TYPE new;
+
+	new = (PTR_TYPE) calloc (1, sizeof (struct data_type));
+#ifdef __SPF
+    addToCollection(__LINE__, __FILE__,new, 0);
+#endif
+	new->id = ++(fi->num_types);
+	new->thread = TYNULL;
+	if (fi->num_types == 1)
+		fi->head_type = new;
+	else
+		fi->cur_type->thread = new;
+	fi->cur_type = new;
+	return (new);
+}
+
+
+PTR_SYMB
+alloc_symb (fi)
+	PTR_FILE fi;
+{
+	PTR_SYMB new;
+
+	if (fi->cur_symb && (fi->cur_symb->variant == 0))
+		return (fi->cur_symb);
+	new = ALLOC (symb);
+	new->id = ++(fi->num_symbs);
+	new->thread = SMNULL;
+	if (fi->num_symbs == 1)
+		fi->head_symb = new;
+	else
+		fi->cur_symb->thread = new;
+	fi->cur_symb = new;
+	return (new);
+}
+
+
+PTR_LABEL
+alloc_lab (fi)
+	PTR_FILE fi;
+{
+	PTR_LABEL new;
+
+	new = ALLOC (Label);
+	new->id = ++(fi->num_label);
+	new->next = LBNULL;
+	if (fi->num_label == 1)
+		fi->head_lab = new;
+	else
+		fi->cur_lab->next = new;
+	fi->cur_lab = new;
+	return (new);
+}
+ 
+ 
+PTR_DEP
+alloc_dep (fi)
+	PTR_FILE fi;
+{
+	PTR_DEP new;
+
+	new = ALLOC (dep);
+	new->id = ++(fi->num_dep);
+	new->thread = NULL;
+	if (fi->num_dep == 1)
+	    fi->head_dep = new;
+	else
+	    fi->cur_dep->thread = new;
+	fi->cur_dep = new;
+	return (new);
+}
+
+
+/*
+ * Make a BIF node
+ */
+PTR_BFND
+make_bfnd (PTR_FILE fi, int node_type, PTR_SYMB symb_ptr, PTR_LLND ll1, PTR_LLND ll2, PTR_LLND ll3)
+/*	PTR_FILE fi; */
+/*	int	 node_type; */
+/*	PTR_SYMB symb_ptr;  */
+/*	PTR_LLND ll1, ll2, ll3; */
+{
+	register PTR_BFND new_bfnd;
+
+	new_bfnd = alloc_bfnd (fi);	/* should set up id field */
+	new_bfnd->variant = node_type;
+	new_bfnd->filename = NULL;
+	new_bfnd->entry.Template.symbol = symb_ptr;
+	new_bfnd->entry.Template.ll_ptr1 = ll1;
+	new_bfnd->entry.Template.ll_ptr2 = ll2;
+	new_bfnd->entry.Template.ll_ptr3 = ll3;
+	new_bfnd->entry.Template.cmnt_ptr = NULL;
+	fi->cur_bfnd = new_bfnd;
+	return (new_bfnd);
+}
+
+PTR_BFND
+make_bfndnt (fi, node_type, symb_ptr, ll1, ll2, ll3)
+	PTR_FILE fi;
+	int	 node_type;
+	PTR_SYMB symb_ptr;
+	PTR_LLND ll1, ll2, ll3;
+{
+	register PTR_BFND new_bfnd;
+
+	new_bfnd = alloc_bfndnt (fi);	/* should set up id field */
+	new_bfnd->variant = node_type;
+	new_bfnd->filename = NULL;
+	new_bfnd->entry.Template.symbol = symb_ptr;
+	new_bfnd->entry.Template.ll_ptr1 = ll1;
+	new_bfnd->entry.Template.ll_ptr2 = ll2;
+	new_bfnd->entry.Template.ll_ptr3 = ll3;
+	new_bfnd->entry.Template.cmnt_ptr = NULL;
+	fi->cur_bfnd = new_bfnd;
+	return (new_bfnd);
+}
+
+/*
+ * Make a new low level node
+ */
+PTR_LLND
+make_llnd (PTR_FILE fi, int node_type, PTR_LLND ll1, PTR_LLND ll2, PTR_SYMB symb_ptr)
+/*	PTR_FILE fi; */
+/*	int	 node_type; */
+/*	PTR_LLND ll1, ll2; */
+/*	PTR_SYMB symb_ptr; */
+{
+	PTR_LLND new_llnd;
+
+	new_llnd = alloc_llnd (fi);	/* should set up id field */
+
+	new_llnd->variant = node_type;
+	new_llnd->type = TYNULL;
+	new_llnd->entry.Template.ll_ptr1 = ll1;
+	new_llnd->entry.Template.ll_ptr2 = ll2;
+	switch (node_type) {
+	  case INT_VAL:
+        /*    new_llnd->entry.ival = (int) symb_ptr; */
+            break;
+	  case BOOL_VAL:
+         /*   new_llnd->entry.bval = (int) symb_ptr; */
+            break;
+	  default:
+            new_llnd->entry.Template.symbol = symb_ptr;
+            break;
+	  }
+	return (new_llnd);
+}
+
+
+/*
+ * Make a new low level node for label
+ */
+PTR_LLND
+make_llnd_label (fi, node_type, lab)
+	PTR_FILE  fi;
+	int	  node_type;
+	PTR_LABEL lab;
+{
+	PTR_LLND new_llnd;
+
+	new_llnd = alloc_llnd (fi);	/* should set up id field */
+
+	new_llnd->variant = node_type;
+	new_llnd->type = TYNULL;
+	new_llnd->entry.label_list.lab_ptr = lab;
+	new_llnd->entry.label_list.null_1 = LLNULL;
+	new_llnd->entry.label_list.next = LLNULL;
+	return (new_llnd);
+}
+
+
+/*
+ * Make a new symb node
+ */
+PTR_SYMB
+make_symb (fi, node_type, string)
+	PTR_FILE fi;
+	int	 node_type;
+	char	*string;
+{
+	PTR_SYMB new_symb;
+
+	new_symb = alloc_symb (fi);
+	new_symb->variant = node_type;
+	new_symb->ident = copys (string);
+	return (new_symb);
+}
+
+
+/*
+ * Make a new type node
+ */
+PTR_TYPE
+make_type (fi, node_type)
+	PTR_FILE fi;
+	int      node_type;
+{
+	PTR_TYPE new_type;
+
+	new_type = alloc_type (fi);
+	new_type->entry.Template.ranges =  NULL;
+	new_type->variant = node_type;
+	return (new_type);
+}
+
+
+/*
+ * Make a new label node for Fortran.  VPC has its own get_labe
+ */
+PTR_LABEL
+make_label (fi, l)
+	PTR_FILE fi;
+	long	 l;
+{       
+	PTR_LABEL new_lab;
+	PTR_BFND  this_scope;
+        int num;/*podd*/
+        num = fi->cur_bfnd ? fi->cur_bfnd->g_line : 0; /*podd*/
+	if (l <= 0 || l > 99999) {
+	  /*	fprintf (stderr, "Error 038 on line %d of %s: Label out of range\n", num, fi->filename); */
+		l = 0;
+	}
+	this_scope = NULL;
+	for (new_lab = fi->head_lab; new_lab; new_lab = new_lab->next)
+		if (new_lab->stateno == l && new_lab->scope == this_scope)
+			return (new_lab);
+
+	new_lab = alloc_lab (fi);
+
+	new_lab->stateno = l;
+	new_lab->scope = this_scope;
+	new_lab->labused = NO;
+	new_lab->labdefined = NO;
+	new_lab->labinacc = NO;
+	new_lab->labtype = LABUNKNOWN;
+	new_lab->statbody = BFNULL;
+	return (new_lab);
+}
+
+
+/*
+ * Make a DEP node
+ */
+PTR_DEP
+make_dep(fi, sym,t,lls,lld,bns,bnd,dv)
+	PTR_FILE fi;
+	PTR_SYMB sym;		/* symbol for variable name		*/
+	char t; 		/* type: 0=flow 1=anti 2 = output	*/
+	PTR_LLND lls, lld;	/* term source and destination		*/
+	PTR_BFND bns, bnd;	/* biff nd source and destination	*/
+	char *dv;		/* dep. vector: 1="="	2="<"  4=">" ?	*/
+{
+	int i;
+	PTR_DEP d;
+
+	if ((d = alloc_dep(fi)) == NULL)
+		return NULL;
+	d->type = t;
+	d->symbol = sym;
+	d->from.stmt = bns; d->from.refer = lls;
+	d->to.stmt   = bnd; d->to.refer   = lld;
+	for(i=0; i < MAX_DEP; i++) d->direct[i] = 0;
+	for(i=0; i < MAX_NEST_DEPTH; i++) d->direct[i] = dv[i];
+
+	return(d);
+}
+
+
+/*------------------------------------------------------*
+ *			alloc_blob			*
+ *------------------------------------------------------*/
+PTR_BLOB
+alloc_blob1(fi)
+	PTR_FILE fi;
+{
+	PTR_BLOB new;
+
+	new = ALLOC(blob);
+	++(fi->num_blobs);
+	return (new);
+}
+
+
+PTR_CMNT
+alloc_cmnt (fi)
+	PTR_FILE fi;
+{
+	PTR_CMNT new;
+
+	new = ALLOC (cmnt);
+	new->id = ++(fi->num_cmnt);
+	new->thread = CMNULL;
+	if (fi->num_cmnt == 1)
+		fi->head_cmnt = new;
+	else
+		fi->cur_cmnt->thread = new;
+	fi->cur_cmnt = new;
+	return (new);
+}
+
+
+/*------------------------------------------------------*
+ *			make_blob			*
+ *------------------------------------------------------*/
+PTR_BLOB
+make_blob (fi, ref, next)
+	PTR_FILE fi;
+	PTR_BFND ref;
+	PTR_BLOB next;
+{
+	PTR_BLOB new;
+
+	new = alloc_blob1(fi);
+	new->ref = ref;
+	new->next = next;
+	return (new);
+}
+
+
+PTR_CMNT
+make_comment (fi, s, t)
+	PTR_FILE fi;
+	char	*s;
+	int	 t;
+{
+	PTR_CMNT new;
+
+	new = alloc_cmnt(fi);
+	new->string = copys (s);
+	new->type = t;
+	return (new);
+}
+
+
+void
+MakeBfnd (node_type, symb_ptr, ll1, ll2, ll3)
+	int	 node_type;
+	PTR_SYMB symb_ptr;
+	PTR_LLND ll1, ll2, ll3;
+{
+	PTR_BFND b;
+
+	b = make_bfnd (cur_file, node_type, symb_ptr, ll1, ll2, ll3);
+	fprintf(stderr, "%d\n", b->id);
+}
+
+
+void
+MakeLlnd (node_type, ll1, ll2, symb_ptr)
+	int	 node_type;
+	PTR_LLND ll1, ll2;
+	PTR_SYMB symb_ptr;
+{
+	PTR_LLND l;
+
+	l = make_llnd (cur_file, node_type, ll1, ll2, symb_ptr);
+	fprintf(stderr, "%d\n", l->id);
+}
+
+
+void
+Makellnd_label (node_type, lab)
+	int     node_type;
+	PTR_LABEL lab;
+{
+	make_llnd_label (cur_file, node_type, lab);
+}
+
+
+void
+MakeSymb (node_type, string)
+	int     node_type;
+	char   *string;
+{
+	PTR_SYMB s;
+
+	s = make_symb (cur_file, node_type, string);
+	fprintf(stderr, "%d\n", s->id);
+}
+
+
+void
+Maketype (node_type)
+	int     node_type;
+{
+	PTR_TYPE t;
+	t = make_type (cur_file, node_type);
+	fprintf(stderr, "%d\n", t->id);
+}
+
+
+void
+MakeLabel (l)
+	long    l;
+{
+	PTR_LABEL l1;
+
+	l1 = make_label (cur_file, l);
+	fprintf(stderr, "%d\n",l1->id);
+}
+
+
+void
+MakeBlob (ref, next)
+	PTR_BFND ref;
+	PTR_BLOB next;
+{
+	make_blob (cur_file, ref, next);
+}
+
+
+void
+MakeComment (s, t)
+	char   *s;
+	int     t;
+{
+	PTR_CMNT c;
+
+	c = make_comment (cur_file, s, t);
+	fprintf(stderr, "%d\n",c->id);
+}
+
+
+/*
+ * declare variable can be used to create a new variable in the
+ * symbol table that is "like" another variable.  For example
+ * if x is in a statement b and you wish to make a new variable
+ * with id x_new that is an array of the same type as x (which
+ * is a scalar), this function creates the new varaible and
+ * creates a declartion for it at the appropriate scope level
+ */
+PTR_SYMB 
+declare_variable (id, like, dimension, scope)
+	char    *id;		/* identifier for new variable	 */
+	PTR_SYMB like;		/* the Template variable	 */
+	int      dimension;	/* if > 1 then this is an array */
+				/* version of Template variable */
+	PTR_BFND scope;		/* pointer to a statment that is */
+				/* in the block where this is to */
+				/* be declared */
+{
+	PTR_LLND expr_list, reference;
+	PTR_BFND decl_stmt;
+	PTR_LLND dimen_expr;
+	PTR_SYMB new_var;
+
+	if (like == NULL) {
+		fprintf (stderr, "no Template in declare_varaible\n");
+		return (NULL);
+	}
+	if (id == NULL) {
+		fprintf (stderr, "no id in declare_variable\n");
+		return (NULL);
+	}
+	if (scope == NULL) {
+		fprintf (stderr, "no scope in declare_varaible\n");
+		return (NULL);
+	}
+	new_var = make_symb (cur_file, VARIABLE_NAME, id);
+	if (dimension <= 1) {
+		if (like->type == NULL) {
+			fprintf (stderr, "problems with type of like in declare_variable\n");
+			return (NULL);
+		}
+		new_var->type = like->type;
+		if (like->type->variant == T_ARRAY) {
+			dimen_expr = make_llnd (cur_file, INT_VAL, NULL, NULL, NULL);
+			dimen_expr = like->type->entry.ar_decl.ranges ->
+				entry.Template.ll_ptr1;
+			reference = make_llnd (cur_file, ARRAY_REF, dimen_expr,
+					       NULL, new_var);
+		} else
+			reference = make_llnd (cur_file, VAR_REF, NULL, NULL, new_var);
+	} else {
+		dimen_expr = make_llnd (cur_file, INT_VAL, NULL, NULL, NULL);
+		dimen_expr->entry.ival = dimension;
+		reference = make_llnd (cur_file, ARRAY_REF, dimen_expr, NULL, new_var);
+		new_var->type = make_type (cur_file, T_ARRAY);
+		new_var->type->entry.ar_decl.base_type = like->type;
+		new_var->type->entry.ar_decl.num_dimensions = 1;
+		new_var->type->entry.ar_decl.ranges = dimen_expr;
+	}
+	expr_list = make_llnd (cur_file, EXPR_LIST, reference, NULL, NULL);
+	decl_stmt = make_bfnd (cur_file, VAR_DECL, NULL, expr_list, NULL, NULL);
+	scope = scope->control_parent;
+	while (scope != NULL &&
+	       scope->variant != GLOBAL && scope->variant != PROC_HEDR &&
+	       scope->variant != PROG_HEDR && scope->variant != FUNC_HEDR &&
+	       scope->variant != FOR_NODE && scope->variant != CDOALL_NODE &&
+	       scope->variant != PARFOR_NODE && scope->variant != PAR_NODE)
+		scope = scope->control_parent;
+	if (scope == NULL || scope->variant == GLOBAL) {
+		fprintf(stderr, "bad scope in declare_variable \n");
+		return (NULL);
+	}
+	scope->entry.Template.bl_ptr1 = make_blob (cur_file, decl_stmt,
+					   scope->entry.Template.bl_ptr1);
+	return (new_var);
+}

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/makefile.uni

@@ -0,0 +1,83 @@
+#######################################################################
+##                             Copyright (C) 1999                    ##
+##              Keldysh Institute of Appllied Mathematics            ##
+#######################################################################
+
+# sage/lib/oldsrc/makefile.sgi
+
+LIBDIR = ../../../lib
+
+OLDHEADERS = ../../h
+H = ../../h
+# Directory in which include file can be found
+TOOLBOX_INCLUDE = ../include
+
+INCL = -I$(OLDHEADERS) -I../include
+
+CFLAGS = $(INCL) -c -DSYS5 -Wall
+
+EXTHDRS	= $H/bif.h $H/db.h $H/db.h $H/defs.h $H/dep.h \
+	  $H/dep_str.h $H/list.h $H/ll.h $H/sets.h $H/symb.h \
+	  $H/tag $H/vparse.h
+
+OBJS	=  anal_ind.o  db.o  db_unp.o \
+           db_unp_vpc.o   dbutils.o  garb_coll.o \
+	   glob_anal.o  ker_fun.o  list.o \
+	   make_nodes.o  mod_ref.o  ndeps.o \
+	   readnodes.o  sets.o  setutils.o \
+	   symb_alg.o  writenodes.o 
+
+SRCS = anal_ind.c db.c db_unp.c db_unp_vpc.c  dbutils.c \
+	  garb_coll.c glob_anal.c ker_fun.c list.c \
+	  make_nodes.c mod_ref.c ndeps.c readnodes.c sets.c setutils.c \
+	  symb_alg.c writenodes.c
+
+$(LIBDIR)/libdb.a: $(OBJS)
+	ar qc $(LIBDIR)/libdb.a $(OBJS)
+
+all: $(LIBDIR)/libdb.a
+	@echo "*** COMPILING LIBRARY oldsrc DONE"
+
+clean:
+	rm -f $(OBJS)
+
+cleanall:
+	rm -f $(OBJS)
+
+###
+anal_ind.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h
+db.o:  $(H)/db.h $(H)/defs.h \
+	$(H)/tag $(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h
+db_unp.o: $(H)/db.h  $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h
+db_unp_vpc.o:  $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/db.h $(H)/vparse.h
+dbutils.o:  $(H)/db.h \
+	$(H)/defs.h $(H)/tag $(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h
+garb-coll.o:  $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h
+glob_anal.o:  $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h
+ker_fun.o:  $(H)/defs.h $(H)/tag $(H)/bif.h $(H)/ll.h \
+	$(H)/symb.h $(H)/sets.h
+list.o: $(H)/db.h  $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/list.h
+make_nodes.o: $(H)/db.h  $(H)/defs.h $(H)/tag \
+	$(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h
+mod_ref.o:  $(H)/defs.h $(H)/tag $(H)/bif.h $(H)/ll.h \
+	$(H)/symb.h $(H)/sets.h $(H)/vparse.h $(H)/db.h
+ndeps.o:  $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h
+readnodes.o: $(H)/db.h  $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/dep_str.h \
+	 $(H)/dep.h
+sets.o: $(H)/db.h  $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h
+setutils.o: $(H)/db.h  $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h
+symb_alg.o: $(H)/db.h  $(H)/defs.h $(H)/tag $(H)/bif.h \
+	$(H)/ll.h $(H)/symb.h $(H)/sets.h
+writenodes.o: $(H)/db.h $(H)/defs.h $(H)/tag \
+	$(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/dep_str.h \
+	$(H)/dep.h

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/makefile.win

@@ -0,0 +1,96 @@
+#######################################################################
+##                             Copyright (C) 1999                    ##
+##              Keldysh Institute of Appllied Mathematics            ##
+#######################################################################
+
+# sage/lib/oldsrc/makefile.win
+
+
+OUTDIR = ..\..\..\obj
+LIBDIR = ..\..\..\lib
+
+OLDHEADERS = ..\..\h
+
+# Directory in which include file can be found
+TOOLBOX_INCLUDE = ../include
+
+INCL = -I$(OLDHEADERS) -I../include
+
+# -w don't issue warning now.
+#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \
+#	/Fp"$(OUTDIR)/oldsrc.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c 
+CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \
+	/Fp"$(OUTDIR)/oldsrc.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c 
+
+.c{$(OUTDIR)/}.obj:
+    $(CC) $(CFLAGS) $<
+
+LIB32=$(LINKER) -lib
+LIB32_FLAGS=/nologo /out:"$(LIBDIR)/libdb.lib" 
+
+
+EXTHDRS	= $H/bif.h $H/db.h $H/db.h $H/defs.h $H/dep.h \
+	  $H/dep_str.h $H/list.h $H/ll.h $H/sets.h $H/symb.h \
+	  $H/tag $H/vparse.h
+
+OBJS	= $(OUTDIR)/anal_ind.obj $(OUTDIR)/db.obj $(OUTDIR)/db_unp.obj \
+      $(OUTDIR)/db_unp_vpc.obj  $(OUTDIR)/dbutils.obj $(OUTDIR)/garb_coll.obj \
+	  $(OUTDIR)/glob_anal.obj $(OUTDIR)/ker_fun.obj $(OUTDIR)/list.obj \
+	  $(OUTDIR)/make_nodes.obj $(OUTDIR)/mod_ref.obj $(OUTDIR)/ndeps.obj \
+	  $(OUTDIR)/readnodes.obj $(OUTDIR)/sets.obj $(OUTDIR)/setutils.obj \
+	  $(OUTDIR)/symb_alg.obj $(OUTDIR)/writenodes.obj 
+
+SRCS = anal_ind.c db.c db_unp.c db_unp_vpc.c  dbutils.c \
+	  garb_coll.c glob_anal.c ker_fun.c list.c \
+	  make_nodes.c mod_ref.c ndeps.c readnodes.c sets.c setutils.c \
+	  symb_alg.c writenodes.c
+
+$(LIBDIR)/libdb.lib: $(OBJS)
+    $(LIB32) @<<
+	$(LIB32_FLAGS) $(OBJS)  
+<<
+
+all: $(LIBDIR)/libdb.lib
+    @echo "*** COMPILING LIBRARY oldsrc DONE"
+
+clean:
+
+cleanall:
+
+###
+anal_ind.o: $H/db.h $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+db.o:  $H/db.h $H/defs.h \
+	$H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h
+db_unp.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+db_unp_vpc.o:  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h $H/db.h $H/vparse.h
+dbutils.o:  $H/db.h \
+	$H/defs.h $H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h
+garb-coll.o:  $H/db.h $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+glob_anal.o:  $H/db.h $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+ker_fun.o:  $H/defs.h $H/tag $H/bif.h $H/ll.h \
+	$H/symb.h $H/sets.h
+list.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h $H/list.h
+make_nodes.o: $H/db.h  $H/defs.h $H/tag \
+	$H/bif.h $H/ll.h $H/symb.h $H/sets.h
+mod_ref.o:  $H/defs.h $H/tag $H/bif.h $H/ll.h \
+	$H/symb.h $H/sets.h $H/vparse.h $H/db.h
+ndeps.o:  $H/db.h $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+readnodes.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \
+	 $H/dep.h
+sets.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+setutils.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+symb_alg.o: $H/db.h  $H/defs.h $H/tag $H/bif.h \
+	$H/ll.h $H/symb.h $H/sets.h
+writenodes.o: $H/db.h $H/defs.h $H/tag \
+	$H/bif.h $H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \
+	$H/dep.h

projects/dvm/fdvm/trunk/Sage/lib/oldsrc/mod_ref.c

@@ -0,0 +1,540 @@
+/*********************************************************************/
+/*                  pC++/Sage++  Copyright (C) 1993                  */
+/*  Indiana University  University of Oregon  University of Rennes   */
+/*********************************************************************/
+
+
+/* file: mod_ref.c */
+
+/* Modified by Jenq-Kuen Lee Feb 24,1988          */
+/* The simple un-parser for VPC++                 */
+# include "db.h"
+# include "vparse.h"
+
+#define  BLOB1_NULL (PTR_BLOB1)NULL
+#define  R_VALUE     0
+#define  L_VALUE     1
+
+extern PCF UnparseBfnd[];
+extern PTR_BLOB1 chain_blob1();
+extern PTR_BLOB1 make_blob1();
+extern char *cunparse_llnd();
+extern PTR_FILE cur_file;
+
+static void ccheck_bfnd();
+static void ccheck_llnd();
+void print_out();
+void test_mod_ref();
+int is_i_code();
+
+static void ccheck_bfnd(pbf, ref_list, mod_list)
+PTR_BFND pbf;
+PTR_BLOB1 *ref_list, *mod_list;
+{
+    PTR_BLOB1 list_r, list_m;
+
+    *ref_list = BLOB1_NULL;
+    *mod_list = BLOB1_NULL;
+    if (!pbf)
+	return;
+
+    switch (pbf->variant) {
+    case GLOBAL:
+	break;
+    case PROG_HEDR:
+    case PROC_HEDR:
+	break;
+    case FUNC_HEDR:
+	break;
+    case IF_NODE:
+	ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case LOGIF_NODE:
+    case ARITHIF_NODE:
+    case WHERE_NODE:
+	break;
+    case FOR_NODE:
+	ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	ccheck_llnd(pbf->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	ccheck_llnd(pbf->entry.Template.ll_ptr3, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	break;
+    case FORALL_NODE:
+    case WHILE_NODE:
+	ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case ASSIGN_STAT:
+    case IDENTIFY:
+    case PROC_STAT:
+    case SAVE_DECL:
+    case CONT_STAT:
+    case FORMAT_STAT:
+	break;
+    case LABEL_STAT:
+	break;
+    case GOTO_NODE:
+	break;
+    case ASSGOTO_NODE:
+    case COMGOTO_NODE:
+    case STOP_STAT:
+	break;
+    case RETURN_STAT:
+	ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case PARAM_DECL:
+    case DIM_STAT:
+    case EQUI_STAT:
+    case DATA_DECL:
+    case READ_STAT:
+    case WRITE_STAT:
+    case OTHERIO_STAT:
+    case COMM_STAT:
+    case CONTROL_END:
+	break;
+    case CLASS_DECL:		/* New added for VPC */
+	break;
+    case ENUM_DECL:		/* New added for VPC */
+    case UNION_DECL:		/* New added for VPC */
+    case STRUCT_DECL:		/* New added for VPC */
+	break;
+    case DERIVED_CLASS_DECL:	/* Need More for VPC */
+    case VAR_DECL:
+	break;
+    case EXPR_STMT_NODE:	/* New added for VPC */
+	ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case DO_WHILE_NODE:		/* New added for VPC */
+	/* Need study        */
+	break;
+    case SWITCH_NODE:		/* New added for VPC */
+	ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case CASE_NODE:		/* New added for VPC */
+	ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case DEFAULT_NODE:		/* New added for VPC */
+	break;
+    case BASIC_BLOCK:
+	break;
+    case BREAK_NODE:		/* New added for VPC */
+	break;
+    case CONTINUE_NODE:		/* New added for VPC */
+	break;
+    case RETURN_NODE:		/* New added for VPC */
+	ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case ASM_NODE:		/* New added for VPC */
+	break;			/* Need More         */
+    case SPAWN_NODE:		/* New added for CC++ */
+	break;
+    case PARFOR_NODE:		/* New added for CC++ */
+	ccheck_llnd(pbf->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case PAR_NODE:		/* New added for CC++ */
+	break;
+    default:
+	fprintf(stderr, "bad bfnd case\n");
+	break;			/* don't know what to do at this point */
+    }
+}
+
+
+static void ccheck_llnd(pllnd, ref_list, mod_list, type)
+PTR_LLND pllnd;
+PTR_BLOB1 *ref_list, *mod_list;
+int type;
+{
+    PTR_BLOB1 list_r, list_m;
+
+    *ref_list = (PTR_BLOB1) NULL;
+    *mod_list = (PTR_BLOB1) NULL;
+    if (pllnd == NULL)
+	return;
+
+    switch (pllnd->variant) {
+    case INT_VAL:
+    case STMT_STR:
+    case FLOAT_VAL:
+    case DOUBLE_VAL:
+    case STRING_VAL:
+    case BOOL_VAL:
+    case CHAR_VAL:
+	break;
+    case CONST_REF:
+    case ENUM_REF:
+	break;
+    case VAR_REF:
+	if (type == L_VALUE) {
+	    *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL);
+	    *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL);
+	}
+	else {
+	    *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL);
+	    *mod_list = (PTR_BLOB1) NULL;
+	}
+	break;
+    case POINTST_OP:		/* New added for VPC */
+    case RECORD_REF:		/* Need More */
+	if (type == L_VALUE) {
+	    *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL);
+	    *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL);
+	}
+	else {
+	    *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL);
+	    *mod_list = (PTR_BLOB1) NULL;
+	}
+	/* Need more */
+	break;
+    case ARRAY_OP:
+	*ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL);
+	if (type == L_VALUE)
+	    *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL);
+	else
+	    *mod_list = BLOB1_NULL;
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	break;
+    case ARRAY_REF:
+	*ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL);
+	if (type == L_VALUE)
+	    *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL);
+	else
+	    *mod_list = BLOB1_NULL;
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	break;
+    case CONSTRUCTOR_REF:
+	break;
+    case ACCESS_REF:
+	break;
+    case CONS:
+	break;
+    case ACCESS:
+	break;
+    case IOACCESS:
+	break;
+    case PROC_CALL:
+    case FUNC_CALL:
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case EXPR_LIST:
+	if (type == R_VALUE) {
+	    ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	    *ref_list = list_r;
+	    *mod_list = list_m;
+	    ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE);
+	    *ref_list = chain_blob1(*ref_list, list_r);
+	    *mod_list = chain_blob1(*mod_list, list_m);
+	}
+	else {
+	    if (pllnd->entry.Template.ll_ptr2) {
+		ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+		*ref_list = list_r;
+		*mod_list = list_m;
+		ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, L_VALUE);
+		*ref_list = chain_blob1(*ref_list, list_r);
+		*mod_list = chain_blob1(*mod_list, list_m);
+	    }
+	    else {
+		ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, L_VALUE);
+		*ref_list = list_r;
+		*mod_list = list_m;
+	    }
+	}
+	break;
+    case EQUI_LIST:
+	break;
+    case COMM_LIST:
+	break;
+    case VAR_LIST:
+    case CONTROL_LIST:
+	break;
+    case RANGE_LIST:
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	break;
+    case DDOT:
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	break;
+    case COPY_NODE:
+	break;
+    case VECTOR_CONST:		/* NEW ADDED FOR VPC++  */
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case INIT_LIST:
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case BIT_NUMBER:
+	break;
+    case DEF_CHOICE:
+    case SEQ:
+	break;
+    case SPEC_PAIR:
+	break;
+    case MOD_OP:
+	break;
+
+    case ASSGN_OP:		/* New added for VPC */
+    case ARITH_ASSGN_OP:	/* New added for VPC */
+    case PLUS_ASSGN_OP:
+    case MINUS_ASSGN_OP:
+    case AND_ASSGN_OP:
+    case IOR_ASSGN_OP:
+    case MULT_ASSGN_OP:
+    case DIV_ASSGN_OP:
+    case MOD_ASSGN_OP:
+    case XOR_ASSGN_OP:
+    case LSHIFT_ASSGN_OP:
+    case RSHIFT_ASSGN_OP:
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, L_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	break;
+    case EQ_OP:
+    case LT_OP:
+    case GT_OP:
+    case NOTEQL_OP:
+    case LTEQL_OP:
+    case GTEQL_OP:
+    case ADD_OP:
+    case SUBT_OP:
+    case OR_OP:
+    case MULT_OP:
+    case DIV_OP:
+    case AND_OP:
+    case EXP_OP:
+    case LE_OP:			/* New added for VPC *//* Duplicated */
+    case GE_OP:			/* New added for VPC *//* Duplicated */
+    case NE_OP:			/* New added for VPC *//* Duplicated */
+    case BITAND_OP:		/* New added for VPC */
+    case BITOR_OP:		/* New added for VPC */
+    case LSHIFT_OP:		/* New added for VPC */
+    case RSHIFT_OP:		/* New added for VPC */
+    case NEW_OP:
+    case DELETE_OP:
+    case THIS_NODE:
+    case SCOPE_OP:
+    case INTEGER_DIV_OP:	/* New added for VPC */
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	break;
+    case ADDRESS_OP:		/* New added for VPC */
+    case SIZE_OP:		/* New added for VPC */
+	break;
+    case DEREF_OP:
+	break;
+    case SUB_OP:		/* duplicated unary minus  */
+    case MINUS_OP:		/* unary operations */
+    case UNARY_ADD_OP:		/* New added for VPC */
+    case BIT_COMPLEMENT_OP:	/* New added for VPC */
+    case NOT_OP:
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	break;
+    case MINUSMINUS_OP:		/* New added for VPC */
+    case PLUSPLUS_OP:		/* New added for VPC */
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, L_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, L_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	break;
+    case STAR_RANGE:
+	break;
+    case CLASSINIT_OP:		/* New added for VPC */
+	break;
+    case CAST_OP:		/* New added for VPC */
+	break;
+    case FUNCTION_OP:
+    case EXPR_IF:		/* New added for VPC */
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	break;
+    case EXPR_IF_BODY:		/* New added for VPC */
+	ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE);
+	*ref_list = list_r;
+	*mod_list = list_m;
+	ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE);
+	*ref_list = chain_blob1(*ref_list, list_r);
+	*mod_list = chain_blob1(*mod_list, list_m);
+	break;
+    case FUNCTION_REF:		/* New added for VPC */
+	break;
+    case LABEL_REF:		/* Fortran Version, For VPC we need more */
+	break;
+
+    default:
+	fprintf(stderr, "ccheck_llnd -- bad llnd ptr %d!\n", pllnd->variant);
+	break;
+    }
+}
+
+
+/*  Very important routine to see a given bif node of a function is
+ *  local-variable declaration or argument declaration
+ *   return   1 ---TRUE
+ *            0    False
+ */
+int is_param_decl_interface(var_bf, functor)
+PTR_BFND var_bf;
+PTR_SYMB functor;
+{
+    PTR_LLND flow_ptr, lpr;
+    PTR_SYMB s;
+
+    switch (var_bf->variant) {
+    case VAR_DECL:
+    case ENUM_DECL:
+    case CLASS_DECL:
+    case UNION_DECL:
+    case STRUCT_DECL:
+    case DERIVED_CLASS_DECL:
+	lpr = var_bf->entry.Template.ll_ptr1;
+	for (flow_ptr = lpr; flow_ptr; flow_ptr=flow_ptr->entry.Template.ll_ptr1) {
+	    if ((flow_ptr->variant == VAR_REF) ||
+		(flow_ptr->variant == ARRAY_REF) ||
+		(flow_ptr->variant == FUNCTION_REF))
+		break;
+	}
+	if (!flow_ptr) {
+	   return 0;
+	}
+
+	for (s = functor->entry.member_func.in_list; s;) {
+	    if (flow_ptr->entry.Template.symbol == s)
+		return (1);
+	    s = s->entry.var_decl.next_in;
+	}
+	return (0);
+
+    default:
+	return (0);
+    }
+
+}
+
+
+PTR_BLOB1 chain_blob1(b1, b2)
+PTR_BLOB1 b1, b2;
+{
+    PTR_BLOB1 oldptr, temptr;
+
+    if (!b1)
+	return (b2);
+    if (!b2)
+	return (b1);
+    for (oldptr = temptr = b1; temptr; temptr = temptr->next)
+	oldptr = temptr;
+
+    oldptr->next = b2;
+    return (b1);
+}
+
+
+/* -------------------------------------------------------------------*/
+/* The following code for testing ccheck_bfnd and ccheck_llnd         */
+void print_out(list, type)
+PTR_BLOB1 list;
+int type;
+{
+    PTR_BLOB1 b;
+    char *source_ptr;
+
+    if (!list)
+	return;
+    if (type == R_VALUE)
+	fprintf(stderr, "------ reference ---------------------------------------------\n");
+    else
+	fprintf(stderr, "------ modified ---------------------------------------------\n");
+    for (b = list; b; b = b->next) {
+	source_ptr = (UnparseBfnd[cur_file->lang])(b->ref);
+	fprintf(stderr, "%s\n", source_ptr);
+    }
+
+}
+
+void test_mod_ref(pbf)
+PTR_BFND pbf;
+{
+    PTR_BLOB b;
+    PTR_BLOB1 list_r, list_m;
+
+    if (!pbf)
+	return;
+    ccheck_bfnd(pbf, &list_r, &list_m);
+
+    if (is_i_code(pbf)) {
+	for (b = pbf->entry.Template.bl_ptr1; b; b = b->next)
+	    test_mod_ref(b->ref);
+	for (b = pbf->entry.Template.bl_ptr2; b; b = b->next)
+	    test_mod_ref(b->ref);
+    }
+
+}
+
+int is_i_code(pbf)
+PTR_BFND pbf;
+{
+    switch (pbf->variant) {
+    case ENUM_DECL:
+    case STRUCT_DECL:
+    case UNION_DECL:
+	return (0);
+    default:
+	return (1);
+    }
+}