              <<< VAXAXP::NOTES$:[NOTES$LIBRARY]VMSNOTES.NOTE;1 >>>
               -< VAX and Alpha VMS - Digital Internal Use Only >-
================================================================================
Note 1358.0      Linker and definition environment GSD records ?       3 replies
SWTHOM::VOUTERS "Philippe VOUTERS, Evry (France)"   892 lines  12-AUG-1996 02:53
--------------------------------------------------------------------------------
    Hello,
    
From OpenVMS Linker Utility Manual:
   page 2-1: "...Some symbols, called LOCAL symbols, are meant to be visible
	      only within a single module ..." 
             "Other symbols, called GLOBAL symbols, are meant to be visible
	      to external modules..."
             definition GSD$C_ENV, GSD$C_LSY, GSD$C_LEPM, GSD$C_LPRO records
	     refer to GLOBAL symbols.
   2.2.3.1  Identifying Library Files Using the /LIBRARY Quaklifier
	     "When the linker processes a library file identified by the
	      /LIBRARY qualifier, the linker processes the library's name
	      table, lookin,g for the definitions of symbols referenced in
	      previously processed input files.
	      ..." 


             Why are definition GSD$C_ENV, GSD$C_LSY, GSD$C_LEPM, GSD$C_LPRO
	     records not fetched from Object Libraries ????

    Best regards,
    Philippe Vouters (CSC France)

/***
/*									     
/*		COPYRIGHT ©1996 DIGITAL EQUIPMENT CORPORATION		     
/*									     
/*   THIS SOFTWARE MAY BE COPIED WITHOUT FEE PROVIDED THAT THE  COPIES  ARE   
/*   NOT  MADE OR DISTRIBUTED FOR DIRECT COMMERCIAL ADVANTAGE,  THAT CREDIT   
/*   TO THE SOURCE IS GIVEN AND THAT THIS ENTIRE COPYRIGHT NOTICE IS INCLUDED.
/*									      
/*   THE  INFORMATION  IN  THIS  SOFTWARE  SHOULD  NOT  BE  CONSTRUED  AS A   
/*   COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.			      
/*									      
/*   DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE,     
/*   SUPPORT, OR RELIABILITY OF THIS SOFTWARE.  THIS SOFTWARE IS 	      
/*   DISTRIBUTED "AS IS."						      
/*									      
/*  Author: Philippe Vouters                                                   
/*  Creation date : 09-Aug-96                                                  
/*  Version: V1.0-00                                                           
/*  File : LIBENV.C
/*  Functionnal description: 						     	
/*	Creates or updates a VAX OBJect module library by inserting or
/*	replacing VAX object modules containing environment symbols in library. 
/*      The module name is inserted in the first index of the library.
/*      Module's related definition environment symbols are inserted into the
/*      second index key table, specifically for the following GSD records:
/*	      (refer to OpenVMS Linker Utility manual pages A-18 to A-20)
/*	      - GSD$C_ENV which defines an environment and which
/*		name is inserted into the second index key table. 
/*	      - GSD$C_LSY which defines an environment local symbol
/*                definition/reference and which name, if it is a definition,
/*		  is inserted into the second index key table
/*            - GSD$C_LEPM which defines a local entry point definition.
/*		  the name of the local entry-point is inserted into the
/*		  second key index table if it is a definition.
/*  	      - GSD$C_LPRO which defines a Local Procedure definition.
/*		  the name of the local procedure is inserted into the
/*		  second index key table, if it is a definition.
/*
/*      This program is an attempt to solve undefined environment symbols
/*	at link time, when the user specify a VAX OBJect Library with an
/*      inserted module containing environment symbols definitions.
/*	For example:
/*      $ CREATE PASCAL.PAS
/*	module foo;
/*	type my_char(n:integer) = packed array [0..n] of char;
/*	     my_char2 = my_char(size(integer));
/*	end.
/*	$ CREATE MAIN.PAS
/*	[inherit ('pascal.pen')]program truc;
/*	var foo2 : my_char2;
/*	begin
/*	end.
/*	$ PASCAL/ENVIRONMENT=PASCAL PASCAL
/*	$ LIBRARY/CREATE/OBJECT PASCAL PASCAL
/*	$ PASCAL/DEBUG/NOOPT MAIN
/*	$ LINK MAIN,PASCAL/LIBRARY reports undefined environment symbols
/*	$ LIBRARY/LIST=TT:/NAMES PASCAL does not show any symbols.
/*	$ cc[/decc] libenv
/*	$ link libenv
/*	$ libenv :== $disk:[directory]libenv
/*      $ libenv PASCAL.OLB PASCAL.OBJ
/*	$ LIBRARY/LIST=TT:/NAMES PASCAL shows all environment symbols.
/*	$ LINK MAIN,PASCAL/LIBRARY reports undefined environment symbols
/****/

# if defined (VAXC) || defined (__VAXC)
# error Must compile $ CC[/DECC] this_program
# endif
# if __ALPHA
# error Not designed for OpenVMS ALPHA. Compile, link and run on a VAX
# endif
/*
 * Include definition files.
 */
# include <stsdef.h>
# include <ssdef.h>
# include <rmsdef.h>
# include <rms.h>
# include <descrip.h>
# include <objrecdef.h>
# include <lbrdef.h>
/*
 * Include standard C files.
 */
# include <unixio.h>
# include <string.h>
# include <file.h>
# include <stdio.h>
# include <stdlib.h>
# include <ctype.h>
/*
 * Include OpenVMS prototype files.
 */
# include <starlet.h> 
# include <str$routines.h>
# include <lib$routines.h>
# include <lbr$routines.h>

# define	MHD$C_MHD       0
# define        MHD$C_LNM	1
# define        MHD$C_SRC	2
# define        MHD$C_TTL	3
# define        MHD$C_CPR	4
# define        MHD$C_MTC 	5
# define        MHD$C_GTX	6

# define	CRE$C_VMSV2	2
# define	CRE$C_VMSV3	3
# define	CRE$M_NOCASECMP	1
# define	CRE$M_NOCASENTR	2
# define	CRE$M_UPCASNTRY	4
# define	CRE$C_HLPCASING	6
# define	CRE$C_OBJCASING	3
# define	CRE$C_MACTXTCAS	0
# define	CRE$K_LENGTH	80
# define	CRE$C_LENGTH	80
# define	CRE$S_CREDEF	80
# define	CRE$L_TYPE	0
# define	CRE$L_KEYLEN	4
# define	CRE$L_ALLOC	8
# define	CRE$L_IDXMAX	12
# define	CRE$L_UHDMAX	16
# define	CRE$L_ENTALL	20
# define	CRE$L_LUHMAX	24
# define	CRE$L_VERTYP	28
# define	CRE$R_IDXOPT_OVERLAY	32
# define	CRE$L_IDXOPT	32
# define	CRE$R_IDXOPT_BITS	32
# define	CRE$V_NOCASECMP	0
# define	CRE$V_NOCASENTR	1
# define	CRE$V_UPCASNTRY	2

# define MAX_FILE_NAME 256
                                                 /* CREATE OPTIONS:        */
#ifdef __DECC
#pragma extern_model globalvalue
extern const int LBR$_NORMAL,LBR$_KEYNOTFND;
#else
globalvalue int LBR$_NORMAL,LBR$_KEYNOTFND;
#endif

/*
 * Define Macros here
 */
#define sizeof_ascic(chr) ((chr)+sizeof(char))

typedef struct sdadefs objdef_t;

typedef struct  membuf {
     struct membuf* next;
     unsigned short flags;
     unsigned short bufsiz;
     char	*buffer;
} membuf_t;

typedef struct queue {
    int flink;                         /* forward link to next element     */
    int blink;                         /* back link to previous element    */
} queue_entry;

typedef struct symbols {
    queue_entry head;
    struct dsc$descriptor dsc;
} symbols_t;

typedef unsigned char ** envbuf_t;
#ifndef __DECC
   static queue_entry _align ( quadword ) symbols_header ;
#else
#pragma member_alignment save
#pragma nomember_alignment quadword
   static queue_entry symbols_header ;
#pragma member_alignment restore
#endif
static queue_entry *head = &symbols_header;

void locate_env_records (objdef_t *objdef_p, int size,
			envbuf_t environment, unsigned short *max_index,
			int *put_in_library)
{
#pragma nostandard
    struct formal_arg {
	char arg$b_valctl;
	unsigned char arg$b_bytecnt;
	};
		
    struct gsd_missing_rec {
	char gsd$b_gsd_type;
	__union {
	  __struct {
		char pro$b_datyp;
		unsigned char gsd$v_weak:1;
		unsigned char gsd$v_def:1;
                unsigned char gsd$v_uni:1;
		unsigned char gsd$v_rel:1;
		unsigned short gsd$v_res:12;
		char pro$b_psindx;
		unsigned int pro$l_addrs;
		unsigned short pro$w_mask;
		char pro$t_name;  /* Counted string */
		char profml$b_minargs;
		char profml$b_maxargs;
		struct formal_arg proargs;
	  } overlay_obj$gsd_pro;
	  __struct {
		unsigned char env$v_def:1;
		unsigned char env$v_nested:1;
		unsigned short env$res:14;
	        unsigned short env$w_envindx;
		char env$t_name; /* Counted string */
	  } overlay_obj$gsd_env;
	  __struct {
		char lepm$b_datyp;
		unsigned char lepm$v_weak:1;
		unsigned char lepm$v_def:1;
                unsigned char lepm$v_uni:1;
		unsigned char lepm$v_rel:1;
		unsigned short lepm$v_res:12;
                unsigned short lepm$w_envindx;
		unsigned short lepm$w_psindx;
		unsigned int lepm$l_addrs;
		unsigned short lepm$w_mask;
		char lepm$t_name;  /* Counted string */
	  } overlay_obj$gsd_lepm;
	  __struct {
		char lsy$b_datyp;
		unsigned char lsy$v_weak:1;
		unsigned char lsy$v_def:1;
                unsigned char lsy$v_uni:1;
		unsigned char lsy$v_rel:1;
		unsigned short lsy$v_res:12;
                unsigned short lsy$w_envindx;
                __union {
		    __struct {
			unsigned short lsy$b_psindx;
			unsigned int lsy$l_value;
 		        char lsy$t_name_definition;  /* Counted string */
		    } lsy$_symbol_definition;
		    char lsy$t_name_reference;
 		} lsy$_ref_def;
	  } overlay_obj$gsd_lsy;
	  __struct {
		char lpro$b_datyp;
		unsigned char lpro$v_weak:1;
		unsigned char lpro$v_def:1;
                unsigned char lpro$v_uni:1;
		unsigned char lpro$v_rel:1;
		unsigned short lpro$v_res:12;
                unsigned short lpro$w_envindx;
		unsigned short lrpo$w_psindx;
		unsigned int pro$l_addrs;
		unsigned short pro$w_mask;
		char lpro$t_name;  /* Counted string */
		char lprofml$b_minargs;
		char lprofml$b_maxargs;
		struct formal_arg lproargs;
	  } overlay_obj$gsd_lpro;
	  __struct {
		unsigned char idc$v_binident:1;
		unsigned char idc$v_match:2;
		unsigned char idc$v_errsev:2;
		unsigned short idc$res:11;
		char idc$t_name; /* Counted string */
               /*
	        * Follows the ident (counted string) and the object (counted
		* string) names.
                */
	  } overlay_obj$gsd_idc;
        } gsd_overlays;
      };

typedef struct gsd_missing_rec gsd_missing_rec_t;
typedef struct formal_arg formal_arg_t;

#define obj$t_pro_name gsd_overlays.overlay_obj$gsd_pro.pro$t_name
#define obj$t_sym_name_ref gsd_overlays.overlay_obj$gsd_pro.pro$t_name
#define obj$b_pro_maxargs gsd_overlays.overlay_obj$gsd_pro.profml$b_maxargs
#define obj$t_env_name gsd_overlays.overlay_obj$gsd_env.env$t_name
#define obj$v_env_def gsd_overlays.overlay_obj$gsd_env.env$v_def
#define obj$w_env_index gsd_overlays.overlay_obj$gsd_env.env$w_envindx
#define obj$t_lepm_name gsd_overlays.overlay_obj$gsd_lepm.lepm$t_name
#define obj$w_lepm_env_index gsd_overlays.overlay_obj$gsd_lepm.lepm$w_envindx
#define obj$v_lepm_def gsd_overlays.overlay_obj$gsd_lepm.lepm$v_def
#define obj$v_lsy_def gsd_overlays.overlay_obj$gsd_lsy.lsy$v_def
#define obj$w_lsy_env_index gsd_overlays.overlay_obj$gsd_lsy.lsy$w_envindx
#define obj$t_lsy_name_def gsd_overlays.overlay_obj$gsd_lsy.lsy$_ref_def.lsy$_symbol_definition.lsy$t_name_definition
#define obj$t_lsy_name_ref gsd_overlays.overlay_obj$gsd_lsy.lsy$_ref_def.lsy$t_name_reference
#define obj$t_lpro_name gsd_overlays.overlay_obj$gsd_lpro.lpro$t_name
#define obj$b_lpro_maxargs gsd_overlays.overlay_obj$gsd_lpro.lprofml$b_maxargs
#define obj$w_lpro_env_index gsd_overlays.overlay_obj$gsd_lpro.lpro$w_envindx
#define obj$v_lpro_def gsd_overlays.overlay_obj$gsd_lpro.lpro$v_def
#define obj$t_idc_name gsd_overlays.overlay_obj$gsd_idc.idc$t_name
#pragma standard

    unsigned char *cp;
    unsigned char *env_names;
    int *env_ptr;

    while (size > 0) {
      switch (objdef_p->obj$b_gsd_type) {
	case OBJ$C_GSD_PSC :         /* P-sect definition                */
		cp = (unsigned char *)&objdef_p->obj$t_psc_name;
                cp = cp + sizeof_ascic(*cp);
                break;
	case OBJ$C_GSD_SYM :         /* Symbol (simple) definition       */
		if (objdef_p->obj$v_sym_def)
		     cp = (unsigned char *)&objdef_p->obj$t_sym_name;
		else cp = (unsigned char *)&objdef_p->obj$b_sym_psind ;
                cp = cp + sizeof_ascic(*cp);
                break;
 	case OBJ$C_GSD_EPM :         /* Entry point definition           */
		cp = (unsigned char *)&objdef_p->obj$t_epm_name;
                cp = cp + sizeof_ascic(*cp);
                break;
        case OBJ$C_GSD_PRO :         /* Procedure definition             */
              { int i;char *cp1;
                gsd_missing_rec_t *gsdrec;
                formal_arg_t *fargs;

                gsdrec = (gsd_missing_rec_t *)objdef_p;
		cp1 = &gsdrec->obj$t_pro_name;
                cp = (unsigned char *)cp1+sizeof_ascic(*cp1)+ 2;
                fargs = (formal_arg_t *)cp;
                for (i=0;i<gsdrec->obj$b_pro_maxargs;i++){
                     cp = cp + sizeof_ascic(fargs->arg$b_bytecnt) +
					sizeof(fargs->arg$b_valctl);
                     fargs = (formal_arg_t *)cp;
		     }
              }
	      break;
	case OBJ$C_GSD_SYMW :        /* Symbol definition with word psect  */
		if (objdef_p->obj$v_sym_def)
		     cp = (unsigned char *)&objdef_p->obj$t_sym_name  + 1;
		else cp = (unsigned char *)&objdef_p->obj$b_sym_psind + 2;
                cp = cp + sizeof_ascic(*cp);
                break;
	case OBJ$C_GSD_EPMW :        /* Entry point definition with word psect  */
		cp = (unsigned char *)&objdef_p->obj$t_epm_name+1;
                cp = cp + sizeof_ascic(*cp);
                break;
	case OBJ$C_GSD_PROW :        /* Procedure definition with word psect  */
              { int i;char *cp1;
                gsd_missing_rec_t *gsdrec;
                formal_arg_t *fargs;

                gsdrec = (gsd_missing_rec_t *)objdef_p;
		cp1 = &gsdrec->obj$t_pro_name + 1;
                cp = (unsigned char *)cp1+sizeof_ascic(*cp1)+ 2;
                fargs = (formal_arg_t *)cp;
                cp1 = &gsdrec->obj$b_pro_maxargs +1;
                for (i=0;i<*cp1;i++){
                     cp = cp + sizeof_ascic(fargs->arg$b_bytecnt) +
					sizeof(fargs->arg$b_valctl);
                     fargs = (formal_arg_t *)cp;
		     }
              }
	      break;
	case OBJ$C_GSD_IDC :         /* Random entity check              */
                {
                gsd_missing_rec_t *gsdrec;

                gsdrec = (gsd_missing_rec_t *)objdef_p;
		cp = (unsigned char *)&gsdrec->obj$t_idc_name;
                cp = cp + sizeof_ascic(*cp); /* cp points to the ident string */
                cp = cp + sizeof_ascic(*cp); /* cp points to the object string */
		cp = cp + sizeof_ascic(*cp);
		}
		break;
	case OBJ$C_GSD_ENV :         /* Environment definition           */
                {
                gsd_missing_rec_t *gsdrec;

                gsdrec = (gsd_missing_rec_t *)objdef_p;
		cp = (unsigned char *)&gsdrec->obj$t_env_name;
                if (gsdrec->obj$v_env_def) {
                    *put_in_library = 1;
		    env_names = (unsigned char *)malloc(OBJ$C_MAXRECSIZ+sizeof(int));
                    if (env_names == 0)
			lib$stop(SS$_VASFULL);
                    if (gsdrec->obj$w_env_index > *max_index)
			*max_index = gsdrec->obj$w_env_index;
                    environment[gsdrec->obj$w_env_index]=env_names;
                    env_ptr = (int *)env_names;
		    *env_ptr = (int)env_names + sizeof(int);
		    env_names = env_names + sizeof(int);
		    memcpy (env_names,cp,sizeof_ascic(*cp));
		    *env_ptr = *env_ptr+ sizeof_ascic(*cp);
                    }
		cp = cp + sizeof_ascic(*cp);
		}
		break;
	case OBJ$C_GSD_LSY :         /* Local symbol definition/reference  */
                {
                gsd_missing_rec_t *gsdrec;

                gsdrec = (gsd_missing_rec_t *)objdef_p;
                if (gsdrec->obj$v_lsy_def)
		     cp = (unsigned char *)&gsdrec->obj$t_lsy_name_def;
		else
		     cp = (unsigned char *)&gsdrec->obj$t_lsy_name_ref;
                if (gsdrec->obj$v_lsy_def) {
                    env_names = environment[gsdrec->obj$w_lsy_env_index];
                    if (env_names == 0)
			lib$stop(SS$_ABORT);
                    env_ptr = (int *)env_names;
  		    memcpy ((void *)*env_ptr,cp,sizeof_ascic(*cp));
		    *env_ptr = *env_ptr+ sizeof_ascic(*cp);
                    }
		cp = cp + sizeof_ascic(*cp);
		}
		break;
	case OBJ$C_GSD_LEPM :        /* Local symbol entry point def.    */
                {
                gsd_missing_rec_t *gsdrec;

                gsdrec = (gsd_missing_rec_t *)objdef_p;
		cp = (unsigned char *)&gsdrec->obj$t_lepm_name;
                if (gsdrec->obj$v_lepm_def) {
                    env_names = environment[gsdrec->obj$w_lepm_env_index];
                    if (env_names == 0)
			lib$stop(SS$_ABORT);
                    env_ptr = (int *)env_names;
  		    memcpy ((void *)*env_ptr,cp,sizeof_ascic(*cp));
		    *env_ptr = *env_ptr+ sizeof_ascic(*cp);
                    }
		cp = cp + sizeof_ascic(*cp);
		}
 		break;
	case OBJ$C_GSD_LPRO :        /* Local symbol procedure def.      */
              { int i;char *cp1;
                gsd_missing_rec_t *gsdrec;
                formal_arg_t *fargs;

                gsdrec = (gsd_missing_rec_t *)objdef_p;
		cp1 = &gsdrec->obj$t_pro_name;
                if (gsdrec->obj$v_lpro_def) {
                    env_names = environment[gsdrec->obj$w_lpro_env_index];
                    if (env_names == 0)
			lib$stop(SS$_ABORT);
                    env_ptr = (int *)env_names;
  		    memcpy ((void *)*env_ptr,cp,sizeof_ascic(*cp));
		    *env_ptr = *env_ptr+ sizeof_ascic(*cp);
                    }
                cp = (unsigned char *)cp1 + sizeof_ascic(*cp1) + 2;
                fargs = (formal_arg_t *)cp;
                for (i=0;i<gsdrec->obj$b_lpro_maxargs;i++){
                     cp = cp + sizeof_ascic(fargs->arg$b_bytecnt) +
					sizeof(fargs->arg$b_valctl);
                     fargs = (formal_arg_t *)cp;
		     }
              }
		break;
	case OBJ$C_GSD_SPSC :        /* Shareable image psect definition  */
		cp = (unsigned char *)&objdef_p->obj$t_psc_name + sizeof(int);
		cp = cp + sizeof_ascic(*cp);
                break;
	case OBJ$C_GSD_SYMV :        /* Global symbol definition (vectored) */
		if (objdef_p->obj$v_symv_def)
		     cp = (unsigned char *)&objdef_p->obj$t_symv_name;
		else cp = (unsigned char *)&objdef_p->obj$b_symv_psind ;
		cp = cp + sizeof_ascic(*cp);
                break;
	case OBJ$C_GSD_EPMV :        /* Entry point definition (vectored) */
		cp = (unsigned char *)&objdef_p->obj$t_epmv_name;
		cp = cp + sizeof_ascic(*cp);
                break;
	case OBJ$C_GSD_PROV :        /* Procedure definition (vectored)  */
              { int i;char *cp1;
                gsd_missing_rec_t *gsdrec;
                formal_arg_t *fargs;

                gsdrec = (gsd_missing_rec_t *)objdef_p;
		cp1 = &gsdrec->obj$t_pro_name + sizeof(int);
                cp = (unsigned char *)cp1 + *cp1 + 1 + 2;
                fargs = (formal_arg_t *)cp;
                cp1 = &gsdrec->obj$b_pro_maxargs + sizeof (int);
                for (i=0;i<*cp1;i++){
                     cp = cp + sizeof_ascic(fargs->arg$b_bytecnt) +
					sizeof(fargs->arg$b_valctl);
                     fargs = (formal_arg_t *)cp;
		     }
              }
	      break;
	case OBJ$C_GSD_SYMM :        /* Global symbol definition (special double valued) */
		if (objdef_p->obj$v_symm_def)
		     cp = (unsigned char *)&objdef_p->obj$t_symm_name;
		else cp = (unsigned char *)&objdef_p->obj$b_symm_psind ;
		cp = cp + sizeof_ascic(*cp);
                break;
	case OBJ$C_GSD_EPMM :        /* Entry point definition (special double valued) */
 		cp = (unsigned char *)&objdef_p->obj$t_epmm_name;
		cp = cp + sizeof_ascic(*cp);
                break;
	case OBJ$C_GSD_PROM :        /* Procedure definition (special double valued) */
              { int i;char *cp1;
                gsd_missing_rec_t *gsdrec;
                formal_arg_t *fargs;

                gsdrec = (gsd_missing_rec_t *)objdef_p;
		cp1 = &gsdrec->obj$t_pro_name + sizeof(int);
                cp = (unsigned char *)cp1 + *cp1 + 1 + 2;
                fargs = (formal_arg_t *)cp;
                cp1 = &gsdrec->obj$b_pro_maxargs + sizeof (int);
                for (i=0;i<*cp1;i++){
                     cp = cp + sizeof_ascic(fargs->arg$b_bytecnt) +
					sizeof(fargs->arg$b_valctl);
                     fargs = (formal_arg_t *)cp;
		     }
              }
                break;
      }
      size = size - ((int)cp - (int)objdef_p);
      objdef_p = (objdef_t *)cp;
      }
  return;
}

membuf_t* new_membuf(membuf_t *flist,int size)
{
    membuf_t *p;

    if (flist != NULL) {
	p = flist;
        flist = p->next;
    } else {
	p = (membuf_t*) malloc (sizeof (membuf_t));
        if (p == 0) 
	    lib$stop (SS$_VASFULL);
        p->buffer = (char*) malloc (size);
        if (p->buffer == 0) 
	    lib$stop (SS$_VASFULL);
    }
    p->next 	= 0;	/* zeroes fields of interrest */
    p->bufsiz 	= 0;
    p->flags 	= 0;
    return p;
}

void free_membuf (membuf_t* p,membuf_t *flist)
{
     p->next = flist;
     flist = p;
}

int lookup_secondary_key (struct dsc$descriptor *key_name,
				unsigned long *mhdrfa)
{
    symbols_t *dsc;
    char *nam;

    dsc = malloc(sizeof(symbols_t));
    memcpy (&dsc->dsc,key_name,sizeof(struct dsc$descriptor));
    nam = malloc (dsc->dsc.dsc$w_length);
    memcpy (nam,dsc->dsc.dsc$a_pointer,dsc->dsc.dsc$w_length);
    dsc->dsc.dsc$a_pointer = nam;
    /* Insert element at tail */
    (void)lib$insqti (dsc,head,NULL);
    return (SS$_NORMAL);
}

int display_module (struct dsc$descriptor *module_name,unsigned long *mhdrfa)
{
printf ("Module %.*s inserted into library ...\n",
			module_name->dsc$w_length,module_name->dsc$a_pointer);
return (SS$_NORMAL);
}

void insert_library (int library_index, membuf_t list_head,
			envbuf_t environment, unsigned short max_index,
			unsigned char *module_name)
{
    int lbr_status,status;
    int status_lookup_module_key;
    int i;
    symbols_t *dsc;
    membuf_t    *list_p;
    unsigned char *start;
    unsigned char *end;
    unsigned int *env_ptr;
    unsigned char *ascic_data;
    $DESCRIPTOR (env_name_descr,"");
    unsigned long txtrfa[2],oldrfa[2],old_first_rfa[2];
    $DESCRIPTOR (bufdsc,"");
    int index;

    /*
     * Lookup for this module being already in library.
     * If so delete the key..
     */
    index = 1;
    env_name_descr.dsc$w_length = *module_name;
    env_name_descr.dsc$a_pointer = (char *)module_name + sizeof(char);
    lbr_status = lbr$lookup_key (&library_index,&env_name_descr,old_first_rfa);
    status_lookup_module_key = lbr_status;
    if ((lbr_status != SS$_NORMAL) && (lbr_status !=  LBR$_KEYNOTFND))
	 lib$stop (lbr_status);
    if (lbr_status == SS$_NORMAL) {
        lbr_status = lbr$delete_key(&library_index,&env_name_descr);
        if (lbr_status != SS$_NORMAL) lib$stop (lbr_status);
    }
    /*
     * Lookup for this module's second index keys being already in library.
     * If so delete the stored key names.
     */
    index = 2;
    lbr_status = lbr$set_index(&library_index, &index);
    if (lbr_status != SS$_NORMAL) lib$stop (lbr_status);
    if (status_lookup_module_key == SS$_NORMAL) {
        lbr_status = lbr$search(&library_index,&index,old_first_rfa,
				  lookup_secondary_key);
	if ((lbr_status != SS$_NORMAL) && (lbr_status !=  LBR$_KEYNOTFND))
	     lib$stop (lbr_status);
        if (lbr_status == SS$_NORMAL) {
            dsc = (symbols_t *)((char *)head + head->flink);
            while (dsc != (symbols_t *)head) {
	          lbr_status = lbr$delete_key(&library_index,&dsc->dsc);
                  if (lbr_status != SS$_NORMAL) lib$stop (lbr_status);
	          /* Remove element at head of queue */
                  (void)lib$remqhi (head,dsc,NULL);
                  free(dsc->dsc.dsc$a_pointer);
                  free(dsc);
                  dsc = (symbols_t *)((char *)head + head->flink);
                  }/* end while */
            }/* If status == SS$_NORMAL */
        }/* if status_lookup_module_key */

    /*
     * After all keys deleted, delete the associated data.
     */
    if (status_lookup_module_key == SS$_NORMAL) {
        lbr_status = lbr$delete_data(&library_index,old_first_rfa);
        if (lbr_status != SS$_NORMAL) lib$stop (lbr_status);
    }

    /*
     * Put/replace object module data into library.
     * For this, copy each read object record the library
     */
    list_p = list_head.next;
    while (list_p != NULL){
       bufdsc.dsc$w_length = list_p->bufsiz;
       bufdsc.dsc$a_pointer = list_p->buffer;
       lbr_status = lbr$put_record (&library_index,&bufdsc,txtrfa);
       if (lbr_status != SS$_NORMAL) lib$stop (lbr_status);
       list_p = list_p->next;
    }
    lbr_status = lbr$put_end (&library_index);
    if (lbr_status != SS$_NORMAL) lib$stop (lbr_status);


    /*
     * Insert/reinsert second level keys
     */
    for (i=0;i<=max_index;i++) {
	 env_ptr = (unsigned int *)environment[i];
	 end = (unsigned char *)*env_ptr;
	 start = (unsigned char *)env_ptr + sizeof(int);
	 ascic_data = start;
         *end = 0;
         /*
          * Insert all strings into the second index keys.
          */
         while (ascic_data < end) {
	     env_name_descr.dsc$w_length = *ascic_data;
	     env_name_descr.dsc$a_pointer = (char *)ascic_data + sizeof(char);
             lbr_status = lbr$insert_key (&library_index, &env_name_descr,
						txtrfa);
	     if (lbr_status != SS$_NORMAL) lib$stop (lbr_status);
             ascic_data = ascic_data + sizeof_ascic(*ascic_data);
	     }
    }/* end for */

    /* insert the module name */
    index=1;
    env_name_descr.dsc$w_length = *module_name;
    env_name_descr.dsc$a_pointer = (char *)module_name + sizeof(char);
    lbr_status = lbr$set_index(&library_index, &index);
    if (lbr_status != SS$_NORMAL) lib$stop (lbr_status);
    lbr_status = lbr$insert_key (&library_index, &env_name_descr,
						txtrfa);
    if (lbr_status != SS$_NORMAL) lib$stop (lbr_status);
    /*
     * display inserted module.
     */
    lbr_status = lbr$get_index (&library_index,&index,display_module,
					&env_name_descr);
    if (lbr_status != SS$_NORMAL) lib$stop (lbr_status);
}

void lookup_object (int fd,int library_index,
			membuf_t *flist,membuf_t list_head)
{
    objdef_t 	*objdef_p;
    unsigned char *module_name;
    struct objrecdef *object;
    membuf_t    *list_p;
    membuf_t	*p;
    int		count = 0;
    int recordsize = OBJ$C_MAXRECSIZ;
    int		put_in_library = 0;
    unsigned short max_index = 0;
    envbuf_t    environment;

    environment = (envbuf_t)malloc (65536*sizeof(int));
    if (environment == 0) lib$stop(SS$_VASFULL);
    list_p = &list_head;      
    while (1) {
    	list_p->next = new_membuf(flist,recordsize);
    	list_p = list_p->next;
    	list_p->bufsiz = read (fd,list_p->buffer,recordsize);
        if (list_p->bufsiz == 0) 
	   goto error;
        object = (struct objrecdef *)&list_p->buffer[0];
        switch (object->obj$b_rectyp){
	  case OBJ$C_HDR :
               if ((count == 0) && (object->obj$b_subtyp == MHD$C_MHD)) {
                   recordsize = object->obj$w_mhd_recsz;
                   module_name = (unsigned char *)&object->obj$w_mhd_recsz +
				sizeof (object->obj$w_mhd_recsz);
	           } 
	       else if ((count != 0) && (object->obj$b_subtyp == MHD$C_MHD))
		   goto error;
	       break;
          case OBJ$C_GSD: 
               objdef_p = (objdef_t*) &object->obj$b_subtyp;
	       locate_env_records (objdef_p, list_p->bufsiz, environment,
					&max_index,&put_in_library);
               break;
          case OBJ$C_EOMW:  
	  case OBJ$C_EOM : 
               goto put;
	} /* end switch */
	count++;
    }/* end while */
put:
    if (put_in_library)
	insert_library(library_index,list_head,
				environment,max_index,module_name);
    goto end;
error:
    printf ("** OBJect file has an invalid format\n");
end:
    if (put_in_library)
        for (count = 0; count <= max_index; count ++)
	     free (environment[count]);
    free (environment);
    list_p = list_head.next;
    while (list_p != NULL) {
        p = list_p;
        list_p = list_p->next;
        free_membuf (p,flist);
    } 
    list_head.next = NULL;
    return;
}

int main (int argc, char** argv)
{
    int 	i;
    unsigned long status;
    membuf_t  list_head;
    membuf_t* flist = NULL;
    int 	fd;
    char*	fname;
    unsigned int library_index;
    unsigned long func;
    unsigned long type;
    unsigned long flags;
    unsigned long context = 0;
    char 	result_name[NAM$C_MAXRSS];
    $DESCRIPTOR (result_name_d, "");
    char 	file_name[NAM$C_MAXRSS];
    $DESCRIPTOR (file_name_d, "");
    $DESCRIPTOR (defname_d, ".OBJ");
    $DESCRIPTOR (libname_d, ".OLB");
    struct dsc$descriptor lbr_rns;
    unsigned long lbr_rnslen;
    unsigned long options[21] = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};

    options [ CRE$L_TYPE / 4 ] = LBR$C_TYP_OBJ;  /* USER OBJECT LIBRARY    */
    options [ CRE$L_KEYLEN/4 ] = 31;             /* MAX.  KEY LENGTH KEYS  */
    options [ CRE$L_ALLOC /4 ] = 100;            /* INITIAL FILE ALLOCATION*/
    options [ CRE$L_IDXMAX/4 ] = 2;              /* NO. LIBRARY INDEXES    */
    options [ CRE$L_ENTALL/4 ] = 1211;           /* ENTRIES TO PREALLOCATE */
    options [ CRE$L_LUHMAX/4 ] = 20;             /* MAX HISTORY RECORDS    */
    options [ CRE$L_VERTYP/4 ] = CRE$C_VMSV3;    /* VMS VERSION 3.0 FORMAT */
    options [ CRE$L_IDXOPT/4 ] = CRE$C_OBJCASING;/* TREAT CHAR CASE AS IS  */


    file_name_d.dsc$w_length = strlen (argv[1]);
    file_name_d.dsc$a_pointer = argv[1];
    status = lib$find_file (&file_name_d, 
			    &result_name_d, 
			    &context,
			    &libname_d); 
    if (status != RMS$_NORMAL)
	func = LBR$C_CREATE;     /* Create the library */
    else
	func = LBR$C_UPDATE;     /* Open the library for update access */
    type = LBR$C_TYP_OBJ;        /* VAX Object library type */

    lib$find_file_end (&context);
    status = lbr$ini_control (&library_index,&func,&type,0);   
    if (status != LBR$_NORMAL)
	lib$stop (status);

    /*
     * Actually open or create the library using the library index returned by
     * lbr$ini_control.
     */
    lbr_rns.dsc$w_length = MAX_FILE_NAME;
    lbr_rns.dsc$b_dtype = DSC$K_DTYPE_T;
    lbr_rns.dsc$b_class = DSC$K_CLASS_S;
    lbr_rns.dsc$a_pointer = malloc (MAX_FILE_NAME);
    status = lbr$open (&library_index,&file_name_d,&options,&libname_d,0,
				&lbr_rns,&lbr_rnslen);
    if (status != LBR$_NORMAL)  {
	printf ("Error opening library %.*s\n",lbr_rns.dsc$w_length,
                         lbr_rns.dsc$a_pointer);
	lib$stop (status);
        }
    /*
     * Search for all OBJ files specified in the rest of the command
     */
    context = 0;
    for (i = 2; i < argc; i++) {
        file_name_d.dsc$w_length = strlen (argv[i]);
        file_name_d.dsc$a_pointer = argv[i];
        flags = 0;
        do {
           result_name_d.dsc$w_length = sizeof (result_name);
           result_name_d.dsc$a_pointer = result_name; 
           status = lib$find_file (&file_name_d, 
				   &result_name_d, 
				   &context,
				   &defname_d,
				   0, /* related filespec */
				   0, /* Status-value */
				   &flags); 
           if (status == RMS$_NORMAL){
               str$trim (&result_name_d,
                         &result_name_d,
                         &result_name_d.dsc$w_length);
               fname = result_name_d.dsc$a_pointer;
               fname [result_name_d.dsc$w_length] = '\0';
               fd = open (fname, O_RDONLY|O_EXCL,"rfm=var");
               if (fd == -1) {
	            char bufmsg[80];
	            sprintf (bufmsg, "Error opening object file: %s", fname);
	            perror (bufmsg);
	            continue;
	       }
              printf ("processing file %s\n", fname);
              lookup_object (fd,library_index,flist,list_head);
              (void)close (fd);
              /* lbr$flush for all but last module */
              if (i == argc - 2){
		  status = lbr$flush (&library_index,LBR$C_FLUSHALL);
                  if (status != LBR$_NORMAL) lib$stop(status);
                  }
	   }/* end if status == RMS$_NORMAL */
        } while (status != RMS$_NMF);
        lib$find_file_end (&context);
    }
    status = lbr$close (&library_index);
    if (!(status & 1))
	lib$stop (status);
    exit (0);
}
