     	Subroutine IMGPRS
     $	(REC,GEN,FIL,MOD,CLU,ENT,COM,OPT,SHR,ICLU,NOSIZE,UPD)
C	###############################################################
C	# (C) Copyright 1985 Auto-trol Technology Corporation         #
C	#                                                             #
C	# This program is the sole property of Auto-trol Technology   #
C	# Corporation and is considered a trade secret and/or a       #
C	# proprietary product of Auto-trol Technology Corporation.    #
C	# Use or disclosure of this program by other than Auto-trol   #
C	# Technology Corporation and its assigned licensees and       #
C	# customers is strictly forbidden by law.                     #
C	#                                                             #
C	# Use, duplication or disclosure by the Government is subject #
C	# to restrictions as set forth in subdivision (b)(3)(ii) of   #
C	# the Rights in Technical Data and Computer Software clause   #
C	# at 252.227.7013.                                            #
C	###############################################################
C
C      /BEGIN MODULE HEADER/        		/STANDARD MODULE HEADER/
C
C       NAME -- IMGPRS
C
C       PURPOSE -- VAX IMAGE BUILD TOOLS
C		   Parse the valid control (CTL) file record
C
C       CALLING SEQUENCE --
C     	   Call IMGPRS
C	        (REC,GEN,FIL,MOD,CLU,ENT,COM,OPT,SHR,ICLU,NOSIZE,UPD)
C
C       COMMON REFERENCES -- none
C
C       ERRORS DETECTED --
C              Handled by a call to IMGMSG, terminating by severity "F"
C
C       EXTERNAL REFERENCES --
C
C       INTERNAL DESCRIPTION AND DESIGN CONSIDERATIONS --
C
C       NOTES --
C
C       HISTORY --
C         MM/DD/YY,SDRC,functional spec number,initials,comments
C	  08/31/87,,,MXB,Handle blank size field in COMMON=name, !
C	  02/24/87,,,MXB,Initial coding
C
C /END MODULE HEADER/        		    /STANDARD MODULE HEADER/
C ******************************************************************
	IMPLICIT NONE			! Force all declared
C
C PARAMETER CONSTANTS --
	INCLUDE		'IMGPAR'	! Parameters
	INCLUDE		'IMGDAT'	! Structures definitions
C
C ARGUMENTS --
	Character*(*)	REC		! Processed record, compressed
	RECORD/SGENP/	GEN		! General purpose parameters
	RECORD/SFILE/	FIL		! Image files
	RECORD/SMODU/	MOD		! Module names
	RECORD/SCLUS/	CLU		! Image clusters
	RECORD/SENTR/	ENT		! Image entry points
	RECORD/SCOMM/	COM		! Image commons
	RECORD/SOPTI/	OPT		! Image link options
	RECORD/SSHRI/	SHR		! Shareable image names
	Integer*4	ICLU		! Current CLUSTER index
	Logical*1	NOSIZE		! /NOSIZE flag for nested file level
	Logical		UPD		! update path (call) flag
C
C LOCAL VARIABLES --
	Character*(pl)	inrec		! Input record (pathname length)
	Character*3	KEY		! Control file keyword
	Integer*4	lrec,linrec	! record length
	Integer*4	i,j,k		! temporrary (loop variables)
	Integer*4	ibeg,iold	! file name element delimiters
	Integer*4	lmod,lfil	! file and module name lengths
	Integer*4	ifir,ilas	! module name delimiters
	Integer*4	ilpa		! parenthesis flag/position
	Integer*4	ityp		! module expression type
	Integer*4	oldclu		! Original (old) module cluster 
C
C EXTERNALS --
C
C DATA STATEMENTS --
C
C /END DECLARATIONS/			    /STANDARD MODULE HEADER/
C ******************************************************************
C
C START OF EXECUTABLE CODE --
C
C	Single control record processing
C
	lrec=len(rec)					! Record length
	inrec=rec					! save initial record
	linrec=lrec					! and length for errors

	KEY=rec(1:3)					! Get CTL file keyword
	i=index(rec(:lrec),'=')				! look for equals sign
	if (i.eq.0) then
	   Call IMGSIG('W-NOEQAL, Equal sign missing: '//rec)
	   Return					! skip this record
	end if
	if (i.eq.lrec) then
	   Call IMGSIG('W-EMPREC, Empty name field: '//rec)
	   Return					! skip this record
	end if
	rec=rec(i+1:lrec)				! Reduce record to
	lrec=lrec-i					! data portion only
C
C	ENTRY=name[,seq#] keyword processing
C
C	Any ENTRY name is simply added to the existing list. During the
C	initial run, we check the sequence number folowing the EPT name,
C	to make sure no EPT has been removed. For the update, we simply
C	add a new name, ignoring a seqence number, but we DO check for
C	duplicite entry names (skipping duplicite ones)
C
C 2000
	if      (KEY.eq.'ENT') then
	   k=0						! Assume undef. seq #
	   i=index(rec(:lrec),',')			! Look for comma
	   if (i.ne.0) then				! Comma present -
	      read(rec(i+1:lrec),*,err=2010) k		! Get the sequence #
	      if (i.eq.1) then	
	         Call IMGSIG('W-NONAME, Missing name: '//inrec(:linrec))
		 Return
	      end if
              lrec=i-1					! remove seq. #
	    end if !i
	    if ( .not. UPD .and. ENT.NUM+1 .ne. k ) then
2010	       Call IMGSIG('W-SEQERR, Sequence error: '//inrec(:linrec))
 	    end if
C	    For update, make sure the EPT name does not duplicate existing one
	    if (UPD) then
	       do i=1,ENT.NUM
	         if (rec(:lrec).eq.ENT.BUF(ENT.D(i).FIR:ENT.D(i).LAS)) then
		   Call IMGSIG('W-DUPENT, Duplicite ENTRY name '//rec(:lrec))
	           Return
	         end if
	       end do
	    end if
C	    Add a new entry record to our structure (entry points list)
	    If (ENT.NUM.eq.ment) 
     $		 Call IMGSIG('F-MANYEP, ENTRY names count overflow')
	    If (ENT.FREE+lrec .gt. bent) 
     $	         Call IMGSIG('F-LONGEP, ENTRY names buffer overflow')
	    ENT.NUM=ENT.NUM+1
	    ENT.BUF(ENT.FREE:ENT.FREE+lrec-1)=rec(:lrec)
	    ENT.D(ENT.NUM).FIR=ENT.FREE
	    ENT.D(ENT.NUM).LAS=ENT.FREE+lrec-1
	    ENT.FREE          =ENT.FREE+lrec
	    Return		  
C
C	NOENTRY=name[,seq#] keyword processing
C	This keyword merely replaces entry point definiton by "OBSOLETE",
C	thus generating a stub entry in transfer vector table, in order
C	to maintain other entry points positions
C
	else if (KEY.eq.'NOE') then
	   i=index(rec(:lrec),',')			! Look for comma
	   if (i.ne.0) then				! Comma present -
              lrec=i-1					! remove seq. #
	   end if !i
C	   Find the Entry name in our entry name table, and replace it
C	   with an "OBSOLETE"
	   do i=1,ENT.NUM
	      if (rec(:lrec).eq.ENT.BUF(ENT.D(i).FIR:ENT.D(i).LAS)) then
C	         Rename this entry to an "OBSOLETE"
	         If (ENT.FREE+8 .gt. bent) 
     $	           Call IMGSIG('F-LONGEP, ENTRY names buffer overflow')
	         ENT.BUF(ENT.FREE:ENT.FREE+8-1)='OBSOLETE'
	         ENT.D(i).FIR=ENT.FREE
	         ENT.D(i).LAS=ENT.FREE+8-1
	         ENT.FREE    =ENT.FREE+8
		 Call IMGSIG('I-OBSENT, Obsoleted entry name: '//rec(:lrec))
	         Return
	      end if
	   end do
	   Call IMGSIG('W-NOENTR, Entry '//rec(:lrec)//' not found')
	   Return
C
C	COMMON=name[,size] keyword   UTL='7FFFFFFF'X or UTL=size
C	GLOBAL=name[,size] keyword
C	LOCAL=name[,size]  keyword   UTL=-1
C
C	COM.D(i).UTL defines data type:
C	 '7FFFFFFF'X = defined as GLOBAL in CTL file, no size given
C	  > 0        = defined as GLOBAL in CTL file, size given OR
C		       extracted size from "reference image"
C	  = 0	     = GLOBAL data extracted from shareable image
C	  < 0        = LOCAL data
C
C 3000
	else if (KEY.eq.'COM' .or. KEY.eq.'GLO' .or. KEY.eq.'LOC') then
	   k='7FFFFFFF'X				! Assume no size given
	   i=index(rec(:lrec),',')			! Look for comma
	   if (i.eq.1) then				! Only comma =
	      Call IMGSIG('W-NONAME, Missing name: '//inrec(:linrec))
	      Return
	   end if
	   if (i.ne.0.and.i.lt.lrec) then		! Comma present -
	      read(rec(i+1:lrec),*,err=3010) k		! Get the common size
	      if (i.eq.1) then	
3010	       Call IMGSIG('W-SIZERR, Size syntax error: '//inrec(:linrec))
	      end if
              lrec=i-1					! remove size from name
	    end if !i
C	    In the case of /NOSIZE flag, zeroe any common sizes specified:
	    if (NOSIZE) k='7FFFFFFF'X			! Set no given size
C	    In case of LOCAL data, define negative size: k=-1
	    if (KEY.eq.'LOC') k=-1			! Size <0 = LOCAL
C	    For update, check if the COM does not update existing size only:
	    if (UPD) then
	       do i=1,COM.NUM
	         if (rec(:lrec).eq.COM.BUF(COM.D(i).FIR:COM.D(i).LAS)) then
	           if (k.lt.0) then
		    if (COM.D(i).UTL .ge. 0)
     $		    Call IMGSIG('I-NEWLOC, GBL Data set LOCAL: '//rec(:lrec))
                   else
		    if (COM.D(i).UTL .ne. k)
     $		    Call IMGSIG('I-NEWSIZ, GBL Data size changed: '//rec(:lrec))
	           end if
	           COM.D(i).UTL=k			! Update size
	           Return				! We are done here
	         end if
	       end do
	    end if
C	    Add a new COMMON record to our structure (GLOBAL names list):
	    If (COM.NUM.eq.mcom) 
     $		 Call IMGSIG('F-MANYGN, GBL DATA  names count overflow')
	    If (COM.FREE+lrec .gt. bcom) 
     $	         Call IMGSIG('F-LONGGD, GBL DATA names buffer overflow')
	    COM.NUM=COM.NUM+1
	    COM.BUF(COM.FREE:COM.FREE+lrec-1)=rec(:lrec)
	    COM.D(COM.NUM).UTL=k			! Save common size
	    COM.D(COM.NUM).FIR=COM.FREE
	    COM.D(COM.NUM).LAS=COM.FREE+lrec-1
	    COM.FREE          =COM.FREE+lrec
	    Return		  
C
C 4000
C	CLUSTER=name[,] processing
C	
	else if (KEY.eq.'CLU') then
	   i=index(rec(:lrec),',')			! Look for comma
	   if (i.ne.0) lrec=i-1				! remove comma
	   if (lrec.eq.0) then
	      Call IMGSIG('E-EMPCLU, Empty CLUSTER name ')
	      Return
	   end if
	   if (rec(:lrec).eq.'DEFAULT_CLUSTER') then	! Check for default clust.
	       ICLU=0					! indexed by ZERO
	       Return				! here
	   end if
C	   Scan our cluster names list, to see if the cluster allready exists
	   Do i=1,CLU.NUM
	    if (CLU.BUF(CLU.D(i).FIR:CLU.D(i).LAS) .eq. rec(:lrec) ) then
	       ICLU=i
	       Return
	    end if
	   end do
C	   Add the new cluster to our list:
	   If (CLU.NUM.eq.mclu) 
     $	      Call IMGSIG('F-MANYCL, CLUSTER names count overflow')
	   If (CLU.FREE+lrec .gt. bclu) 
     $	      Call IMGSIG('F-LONGCL, CLUSTER names buffer overflow')
	   CLU.NUM=CLU.NUM+1
	   CLU.BUF(CLU.FREE:CLU.FREE+lrec-1)=rec(:lrec)
	   CLU.D(CLU.NUM).FIR=CLU.FREE
	   CLU.D(CLU.NUM).LAS=CLU.FREE+lrec-1
	   CLU.FREE          =CLU.FREE+lrec
	   ICLU=CLU.NUM
	   Return
C
C 5000
C	FILE=specifier   keyword processing
C	The "specifier" may have several formats, all accepted by the LINKER:
C	Handled specifier formats (module_type):
C	mt_non  - invalid or empty pathname/module name
C	mt_mul	- pathname/INC=(module,...,module)[,...]
C	mt_sha	- pathname/SHA[,...]
C	mt_lib	- pathname/LIB[,...]
C	mt_inc	- pathname/INC=module[,...]
C	mt_fil	- pathname[,...]
C
	else if (KEY.eq.'FIL') then
C
C	    Parse the "LINKER" filespecification to find module name(s).
C	    Module names are added to modules list for update processing,
C	    entire filespec record is added to the files list.
C	    There may be multiple filespec records (elements) in line:
C
	    ibeg=1				! Init first element begin
	    ilpa=0				! No parenthesis yet
	    do while (ibeg.le.lrec)		! For all line elements
	       iold=ibeg			! Save this element start
5100	       Call IMGPLL(rec,ibeg,lrec,ilpa,ityp,ifir,ilas)
C
C	       Process module names handling types: /LIBRARY, /SHARE
	       lmod=ilas-ifir+1			! Module name length
	       if (ityp.eq.mt_non) Return	! No "module" = error
C	       write (*,*)'module: '//rec(ifir:ilas)
	       if (rec(ifir:ilas).eq.'-') then	! Invalid continuation
		  Call IMGSIG('E-INVCON, Invalid continuation: '
     $            //rec(:lrec) )
		  Return
	       end if
C
	       if (ityp.eq.mt_lib) Goto 5300	! Library specification
C
	       if (ityp.eq.mt_sha) then		! Shareable image spec.
	          lfil=ilas-ifir+1		! Image pathname length
	          If (SHR.NUM.eq.mshr) 
     $		      Call IMGSIG('F-MANYSI, ShrImage count overflow')
	          If (SHR.FREE+lfil .gt. bshr) 
     $	              Call IMGSIG('F-LONGSN, ShrImage buffer overflow')
	          SHR.NUM=SHR.NUM+1
	          SHR.BUF(SHR.FREE:SHR.FREE+lfil-1)=rec(ifir:ilas)
	          SHR.D(SHR.NUM).FIR=SHR.FREE
	          SHR.D(SHR.NUM).LAS=SHR.FREE+lfil-1
	          SHR.FREE          =SHR.FREE+lfil
	          Goto 5300			! Add to filespecs
	       end if
C
C	       Check for duplicite modules. If update, then remove
C	       this module specification from original file record.
C
	       OLDCLU=ICLU			! Original module's CLUSTER
	       Do i=1,MOD.NUM			! - assume the same cluster
	          if (MOD.D(i).LEN.eq.lmod) then
		     if (MOD.BUF(MOD.D(i).FIR:MOD.D(i).LAS)
     $			.eq.rec(ifir:ilas))then
			if (UPD) then
			  OLDCLU=FIL.D(MOD.D(i).FIL).UTL ! Get orig. cluster
			  Call IMGRMF(MOD,FIL,i) ! Remove module's file
			  MOD.D(i).FIL=FIL.NUM+1 ! New file will be added
			else
			   Call IMGSIG('W-DUPMOD, Duplicite module: '
     $			   //rec(ifir:ilas) )	 ! report error
			end if	        	 ! but proceed normally
		     end if	! module name match
	          end if    ! module length match
	       end do    ! all modules
C
C	       Add the new module to our module names structure
	       If (MOD.NUM.eq.mmod) 
     $		   Call IMGSIG('F-MANYMN, MODULE names count overflow')
	       If (MOD.FREE+lmod .gt. bmod) 
     $	           Call IMGSIG('F-LONGMN, MODULE names buffer overflow')
	       MOD.NUM=MOD.NUM+1
	       MOD.BUF(MOD.FREE:MOD.FREE+lmod-1)=rec(ifir:ilas)
	       MOD.D(MOD.NUM).FIR=MOD.FREE
	       MOD.D(MOD.NUM).LAS=MOD.FREE+lmod-1
	       MOD.FREE          =MOD.FREE+lmod
	       MOD.D(MOD.NUM).LEN=lmod		! module name length
	       MOD.D(MOD.NUM).FIL=FIL.NUM+1	! Module in next file
5200	       Continue
	       if (ilpa.ne.0) Goto 5100		! Loop for next module
C
C	       Add a new FILE record to FILe names structure, using the
C 	       current cluster number (may be zero) as a utility value.
C	       In case of update, use the original module's cluster as
C	       long as current cluster is zero (DEFAULT_CLUSTER). 
C	       Thus only explicite update cluster changes module location.
C
5300	       Continue
	       lfil=ibeg-1-iold
	       if (lfil.le.0) then
	           Call IMGSIG('E-EMPTYE, Empty element: '//rec(:lrec) )
    	           Return
	       end if
C	       write (*,*)'elemnt: '//rec(iold:ibeg-2)
	       If (FIL.NUM.eq.mfil) 
     $		   Call IMGSIG('F-MANYFN, FILE names count overflow')
	       If (FIL.FREE+lfil .gt. bfil) 
     $	           Call IMGSIG('F-LONGFN, FILE names buffer overflow')
	       FIL.NUM=FIL.NUM+1
	       FIL.BUF(FIL.FREE:FIL.FREE+lfil-1)=rec(iold:ibeg-2)
	       if (UPD .and. ICLU.eq.0) then	! On update, no explicite cluster
	          FIL.D(FIL.NUM).UTL=OLDCLU	! use the old module cluster #
	       else				! (no old module - OLDCLU=ICLU)
	          FIL.D(FIL.NUM).UTL=ICLU	! Set the current cluster #
	       end if
	       FIL.D(FIL.NUM).FIR=FIL.FREE
	       FIL.D(FIL.NUM).LAS=FIL.FREE+lfil-1
	       FIL.FREE          =FIL.FREE+lfil
	    End do				! while ( ibeg .le. iend )
	    Return		  
C
C	OPTION=text   keyword processing
C
	else if (KEY.eq.'OPT') then
C	    For LINKER unique options, make sure the UPDATE option
C	    redefines the old one, if any:
	    if (UPD) then
	     KEY=rec(1:3)				! Get Linker OPTION name
	     if (KEY .eq. 'GSM' .or. KEY .eq. 'ISD' .or.
     $	         KEY .eq. 'UNS' .or. KEY .eq. 'BAS' ) then
	         do i=1,OPT.NUM
	          if (KEY.eq.OPT.BUF(OPT.D(i).FIR:OPT.D(i).FIR+2))then
	    	    If (OPT.FREE+lrec .gt. bopt) 
     $	            Call IMGSIG('F-LONGOP, OPTION names buffer overflow')
	            OPT.BUF(OPT.FREE:OPT.FREE+lrec-1)=rec(:lrec)
	            OPT.D(i).FIR=OPT.FREE
	            OPT.D(i).LAS=OPT.FREE+lrec-1
	            OPT.FREE    =OPT.FREE+lrec
	            CALL IMGSIG('I-NEWOPT, Option redefined: '//rec(:lrec))
	            Return
	          end if
	        end do
             end if
	    end if
C	    Add a new OPT record to our structure (OPT names list):
	    If (OPT.NUM.eq.mopt) 
     $		 Call IMGSIG('F-MANYOP, OPTION names count overflow')
	    If (OPT.FREE+lrec .gt. bopt) 
     $	         Call IMGSIG('F-LONGOP, OPTION names buffer overflow')
	    OPT.NUM=OPT.NUM+1
	    OPT.BUF(OPT.FREE:OPT.FREE+lrec-1)=rec(:lrec)
	    OPT.D(OPT.NUM).FIR=OPT.FREE
	    OPT.D(OPT.NUM).LAS=OPT.FREE+lrec-1
	    OPT.FREE          =OPT.FREE+lrec
	    Return		  
C
C	General info keywords processing:
C	TABSIZ=number
C	IMAGE=logical_name[,error_handler]
C
	else if (KEY.eq.'IMA') then
	     i=index(rec(:lrec),',')		! Find handler delimiter
	     if (i.eq.0) i=lrec+1
	     GEN.IMAGE=rec(:i-1)
	     GEN.LIMAG=i-1
	     if (lrec-i.gt.0) then
	        GEN.LERRO=lrec-i
	        GEN.ERROR=rec(i+1:lrec)
	     end if
	     Return
	else if (KEY.eq.'TAB'.or.KEY.eq.'TBS') then
	     read (rec(:lrec),*,ERR=7000)GEN.TBSIZ
	     Return
7000	     Call IMGSIG('W-IVLNUM, Invalid number: '//inrec(:linrec))
	     Return
C
C	INVALID keyword. Report warning and continue
C
	else
	  Call IMGSIG('W-IVLKEY, Invalid keyword: '//inrec(:linrec))
	end if
	Return					! Loop for next record
	END
