	PROGRAM IMGSCA
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 -- IMGSCA
C
C       PURPOSE -- Scan and analyze the image file
C
C       RESTRICTIONS -- VMS/VAX specific support routine
C
C	CALLING SEQUENCE --
C	        $IMGSCA image options outfile
C
C	INPUT --
C	       imagefile -- file to scan for a pattern,
C	 		    default extension .EXE
C
C	       options   -- cobination of GSD entries to display
C			    E - entry points
C			    S - Shareable image Psects
C			    P - regular Psects
C			    M - Procedure entry points (if any)
C			    C - Check S-PSECT to be NOSHR
C			    1 - COMMON= format (default)
C			    2 - name only format
C
C	OUTPUT --
C	       outfile   -- output file
C		            XXXXXX          ,000000  ! ADR=00000000 FLG=0000
C
C       ERRORS DETECTED -- Signalled on sys$output
C
C       EXTERNAL REFERENCES -- see external declaration
C
C       INTERNAL DESCRIPTION AND DESIGN CONSIDERATIONS --
C
C       NOTES --
C
C       HISTORY --
C         MM/DD/YY,SDRC,functional spec number,initials,comments
C	  06/18/87,MXB,Use GPS bits to determine PSECT shareability
C	  08/26/86,MXB,Initial code
C
C  /END MODULE HEADER/        AUOSI 	    /STANDARD MODULE HEADER/
C  *****************************************************************
	IMPLICIT NONE			! Force all declared
C
C PARAMETER CONSTANTS --
C
C COMMON -- 
	INCLUDE		'IMGCOM/NoList'	! IMGOPN common
	INCLUDE		'IMGGPS/Nolist'	! Global Program Section bit definitons
C
C LOCAL VARIABLES --
C
	Integer*4	ADR(2)		! File VM address range
C
	Character*256  	CMDLIN		! Command line with cmd. file names
	Character*80  	INPFIL		! Input file name
	Character*80	OPTION		! Options
	Character*80	OUTFIL		! Output file name
C	
	Integer	      	CMDLEN		! Command name
	Integer	      	INPFNL		! Input file name
	Integer		OPTLEN		! Options length
	Integer		OUTFNL		! Output file name
C
	Integer*4	GSTREC		! GST records count
	Integer*4	GSTCTX(5)	! GST position contex (REC,SUBREC)
	Character*32	SYM		! GST symbol or PSECT name
	Integer*4	TYP		! GST record type
	Integer*4	SIZ		! GST symbol size (PSECT only)
	Integer*4	VAL		! GST symbol value
	Integer*4	ATR		! GST symbol attributes
C
	Integer		ISTAT		! Final exit status
	Integer		I,J		! Utility variables
	Character*1	CH		! Single utility character
	Logical		CHK
	Logical		EPT,PSE,SSE,MOD	! Flags for options
	Integer		FMT		! Output format flag
C
C EQUIVALENCES -- none
C
C EXTERNALS --
C
	EXTERNAL LIB$GET_FOREIGN		! VMS GET command line
	EXTERNAL SYS$EXIT			! VMS exit
	EXTERNAL SYS$CRMPSC			! VMS cretae and map section
	EXTERNAL SYS$DELTVA			! VMS delete temp. virtual mem
	EXTERNAL SYS$DASSGN			! VMS deassign channel
	EXTERNAL SEC$M_EXPREG			! Expand region flag
	EXTERNAL IMGOPN				! User OPEN routine
	EXTERNAL IMGSIG				! Local error signalling routine,	
	Integer  SYS$CRMPSC			!
	Integer	 IMGOPN				! 
	Logical	 IMGGSR				! GET next GST sub-record
C
C DATA STATEMENTS --
C
C
C  /END DECLARATIONS/		AUOSI 	    /STANDARD MODULE HEADER/
C  *****************************************************************
C
C START OF EXECUTABLE CODE --
C
C	Get command line or inquire filenames	
C
	Call LIB$GET_FOREIGN(CMDLIN,'IMGSCA>',CMDLEN)
	If (CMDLEN.eq.0) Call IMGSIG('F-NOCMD, no command line')
C
C	Simple command line parsing assumes the command has a format:
C	xxxx  input_file  output_file
C	
	INPFNL=0				! All three filenames are	
	OUTFNL=0	
	J=0					! Set the "out of name" flag
	Do I=1,CMDLEN+1				! Scan the command line
	   CH=CMDLIN(I:I)			! 
	   if (J.ne.0) then			! J nonzero = within filename
	      if (ch.le.' '.or.I.eq.CMDLEN+1)then ! This is name terminator
	        if (INPFNL .eq. 0) then		! input filename still empty
	            INPFIL=CMDLIN(J:I-1)	! load this pattern
	            INPFNL=I-J			! and it's length
	        else if (OPTLEN.eq.0) then	! 
	            OPTION=CMDLIN(J:I-1)	! must be an option
	            OPTLEN=I-J	      		! load it and length
	        else if (OUTFNL.eq.0) then	! 
	            OUTFIL=CMDLIN(J:I-1)	! must be output file
	            OUTFNL=I-J	      		! load name and length
	        end if
	        J=0				! set out-of name flag
	      end if				! enf for terminator handling
	   else					! Out of filename
	      if (ch .gt. ' ') J=I		! valid char = name start
	   end if
	end do
C
CD	write(*,*)INPFIL(:INPFNL),'*',OUTFIL(:OUTFNL)
C
	if (INPFNL.eq.0) Call IMGSIG('F-NOINP, no input   file')
	if (OPTLEN.eq.0) Call IMGSIG('F-NOOPT, no options ')
	if (OUTFNL.eq.0) Call IMGSIG('F-NOOUT, no output  file')
	CHK=.false.
	EPT=.false.
	PSE=.false.
	SSE=.false.
	MOD=.false.
	FMT=2
	if (index(OPTION,'C').ne.0) CHK=.true.
	if (index(OPTION,'E').ne.0) EPT=.true.
	if (index(OPTION,'P').ne.0) PSE=.true.
	if (index(OPTION,'S').ne.0) SSE=.true.
	if (index(OPTION,'M').ne.0) MOD=.true.
	if (index(OPTION,'1').ne.0) FMT=1
	if (index(OPTION,'2').ne.0) FMT=2
	if (index(OPTION,'3').ne.0) FMT=3
	if (index(OPTION,'4').ne.0) FMT=4
C
C	O P E N  all the required files here
C
300	Open (UNIT=1,name=INPFIL(:INPFNL),READONLY,SHARED,
     1		DEFAULTFILE='.EXE;0',
     1		USEROPEN=IMGOPN,	! Using user open for map-section
     1		STATUS='OLD',ERR=310)
	Goto 340
310	Call IMGSIG('F-OPNINP, error opening '//INPFIL(:INPFNL) )
C
340	Open (UNIT=3,name=OUTFIL(:OUTFNL),FORM='FORMATTED',
     1		DEFAULTFILE='.LOC;0',
     1		CARRIAGECONTROL='LIST',
     1		STATUS='NEW',ERR=350)
	Goto 400
350	Call IMGSIG('F-OPNOUT, error opening '//OUTFIL(:OUTFNL) )
C
C	LOAD the input file into memmory. Here we MAP the entire file
C	into virtual address space.
C
400	ADR(1)=1024				! Request P0 space use
	ADR(2)=1024
	i=SYS$CRMPSC(adr,adr,,%val(%loc(SEC$M_EXPREG)),,,,
     1	            %val(CHAN),,,,)
	if (.not.i) then
	   call sys$dassgn(%val(chan))
	   close (unit=1)
	   Call IMGSIG('F-ERRFIL, error mapping file '//INPFIL(:INPFNL) )
	   Call sys$exit(%val(i))		! And report error status
	end if
C
C	Here we determine the position and size of the GST table in the
C	image:
500	Call IMGGST(ADR,GSTCTX)
	If (GSTCTX(2).eq.0) Call IMGSIG (
     1	    'F-NOTGST, image does not contain GST '//INPFIL(:INPFNL) )
C
C	Now we will process individual GST records trying to display
C	those of interest to us:
C
600	istat=1					! Assume no errors
	Do while (IMGGSR (GSTCTX,TYP,%ref(SYM),SIZ,VAL,ATR) )
	   if (CHK.and.TYP.eq.12) then		! Shareable SPSECT is
	         if (iand(ATR,GPS$M_GBL).ne.0 .and.	! Global
     1		     iand(ATR,GPS$M_WRT).ne.0 .and.	! Writeable
     1		     iand(ATR,GPS$M_SHR).ne.0 ) then	! Shareable
	             Call IMGSIG('E-SHRSEC, Writeable global SPSECT '//SYM)
		     istat='10000004'X
		 end if
      	   else if ((EPT.and.(TYP.eq.2)).or.
     1	       (PSE.and.(TYP.eq.0)).or.
     1	       (SSE.and.(TYP.eq.12)).or.
     1	       (MOD.and.(TYP.eq.3)) ) then
	      if (FMT.eq.1) then
	         write (3,750,err=800)SYM
	      else if (FMT.eq.2) then
	         write (3,700,ERR=800)SYM,SIZ,VAL,ATR
	      else if (FMT.eq.3) then
	         write (3,725,err=800)SYM
	      else if (FMT.eq.4) then
	         write (3,775,err=800)SYM
	      endif
700	      format('COMMON=',a,',',I8.8,' ! VAL=',Z8.8,' FLG:',Z4.4)
725	      format('GLOBAL=',a)
750	      format(a)
775	      format('LOCAL=',a)
800	   end if
	end do
C
C	Finish all
	close (unit=3)
	call sys$deltva(adr,,)
	call sys$dassgn(%val(chan))
	close (unit=1)
	CALL	SYS$EXIT(%val(istat))
	END
