From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  8-NOV-1988 23:14
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VAXCIO (MISC.SHAR) Source


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Tue,  8 NOV 88 19:25:46 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Tue, 8 Nov 88 19:16:37 PST
Received: by ucbvax.Berkeley.EDU (5.59/1.31)
	id AA07928; Mon, 7 Nov 88 23:55:59 PST
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 7 Nov 88 20:00:30 GMT
From: tektronix!gvgpsa!gvgpvd!tony@ucbvax.Berkeley.EDU  (Tony Ivanov)
Organization: Grass Valley Group, Inc., Grass Valley, CA
Subject: VAXCIO (MISC.SHAR) Source
Message-Id: <893@gvgpvd.GVG.TEK.COM>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-5.01 01-Oct-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by TONY
$! on Wednesday 2-NOV-1988 12:59:03.94
$!
$! It contains the following 6 files:
$! MOD_ENTRY_NAME.FOR DOIT.C DOIT1.C TEST.C TEST1.C TEST2.C
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="MOD_ENTRY_NAME.FOR"
$ Check_Sum_is=842832530
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009OPTIONS`009/EXTEND_SOURCE
X`009PROGRAM`009MOD_ENTRY_NAME
V*******************************************************************************
X*********************
X*
V*`009`009This program prompts for an object file name and upon entry of such, a
Xllows
X*`009two options: list entry point symbols and change entry point symbol name.
X*
X*`009`009This function is particularly useful when you want to re-write a
X*`009common system function, and you want all programs previously compiled to
X*`009use your new function.  In my particular case, I needed to re-write the
X*`009VAXCIO funcitons to allow a more unix-like interface so that terminal
X*`009control function like cbreak, noecho, nonl, etc would work.
X*
X*`009`009In doing things like this it is very important that you have your
V*`009site specific functions already set up and possibly just calling the syste
Xm
X*`009default funcitions otherwise you will get link warnings since some of the
X*`009modules don't exist (in particular, the ones you just renamed!).
X*
X*`009Modification history:
V*`009`009June 8, 1987`009Anton Sale-Ivanov`009Grass Valley Group, Grass Valley 
XCA 95945
X*`009`009`009Original coding.  Uses a real sloppy algorithm of keeping track of
X*`009`009`009symbol cross reference names.  It does an initial load of all the
X*`009`009`009symobl names in use and stores them in the local variable XREF.
X*`009`009`009When a name is to be changed, it uses the cross reference table.
X*`009`009`009Upon completion of the program, the table is scaned and the new
X*`009`009`009object file is re-read and written to a new file.
X*
V*******************************************************************************
X*********************
X`009implicit integer * 4`009(A-Z)`009`009`009! No number crunching.
X`009include`009`009'($FORIOSDEF)'`009`009`009! FOR$IOS_xxx parameters.
V`009parameter`009MAX_SYMS = 1000`009`009`009! Total number of symbol names I ca
Xn handle.
X`009parameter`009OLD_SYM = 1`009`009`009! Index into symbol name table.
X`009parameter`009NEW_SYM = 2`009`009`009! Index into symobl name table.
X`009parameter`009OLD_FILE_LUN = 1`009`009! LUN for old object file.
X`009parameter`009NEW_FILE_LUN = 2`009`009! LUN for new object file.
X
X`009character * 256`009OBJECT_FILE`009`009`009! Name of object file.
V`009character * 31`009XREF(MAX_SYMS,2)`009`009! Symbol name cross reference tab
Xle.
V`009logical`009`009TOUCHED`009`009`009`009! TRUE if some symbol names have chan
Xged.
X`009logical`009`009DONE`009`009`009`009! TRUE when done playing in object file.
X`009character * 32`009ANS`009`009`009`009! Answer to a question.
X
X*`009`009Format statements
X1000`009format ('$Enter the name of the object file: ')
X1010`009format (' Object file "',(A),'" does not exist.')
X1020`009format (' Cannot open object file "',(A),'".  Status = ',Z8.8)
X1030`009format (' Here are your options:'/
X`0091`009'     1)  List all entry point symbols.'/
X`0091`009'     2)  Change an entry point symbol name.'/
X`0091`009'     3)  Exit.'/
X`0091`009'$Choose an option (1-3): ')
X1040`009format (' Invalid option: ',(A))
X1050`009format (' Some symbols names have changed.'/
X`0091`009'$Do you wish to update the object file [y/n]? ')
X1060`009format (' Please answer with Y or N.')
X1070`009format (' Updating object file "',(A),'".')
X1075`009format (' Object file not updated.')
X1080`009format (' Object file "',(A),'" WILL NOT be updated.')
X1090`009format (' No symbol names changed.  No update is necessary.')
X*`009`009Input formats:
X2000`009format (A)
X*`009`009Output formats:
X3000`009format (1x,(A))
V*------------------------------------------------------------------------------
X----------
X*
X*`009`009Get the object file.
X*
X 100`009write (6, 1000)
X`009read (5, 2000, end=9999) OBJECT_FILE
X`009OBJECT_FILE = OBJECT_FILE(f_nb_nnl(OBJECT_FILE):)
X`009LEN_OBJECT_FILE = l_nb_nnl(OBJECT_FILE)
X`009if (LEN_OBJECT_FILE .eq. 0) goto 100
X`009call str$upcase (OBJECT_FILE, OBJECT_FILE)
X*
X*`009`009Try to open it with exclusive access.
X*
V`009open (OLD_FILE_LUN, file=OBJECT_FILE(1:LEN_OBJECT_FILE), status='OLD', acce
Xss='APPEND', iostat=IOS)
X`009if (IOS .eq. FOR$IOS_FILNOTFOU) then
X`009`009write (6, 1010) OBJECT_FILE(1:LEN_OBJECT_FILE)
X`009`009goto 100
X`009else if (IOS .ne. 0) then
X`009`009write (6, 1020) OBJECT_FILE(1:LEN_OBJECT_FILE), IOS
X`009`009goto 100
X`009end if
X`009rewind (OLD_FILE_LUN)
X*
X*`009`009Load in the symbol names.
X*
X`009NUM_SYMS = 0
X`009if ( .not. GET_SYM_NAMES (OLD_FILE_LUN, XREF, NUM_SYMS) ) then
X`009`009goto 100
X`009end if
X*
X*`009`009Enter main menu.
X*
X`009DONE = .false.
X`009do while (.not.DONE)
X`009`009write (6, 1030)
X`009`009read (5, 2000, end=800) ANS
X`009`009if (ANS(1:1) .eq. '1') then
X`009`009`009call LIST_ENTRIES (XREF, NUM_SYMS)
X`009`009else if (ANS(1:1) .eq. '2') then
X`009`009`009call MOD_ENTRY (XREF, NUM_SYMS)
X`009`009else if (ANS(1:1) .eq. '3') then
X`009`009`009DONE = .true.
X`009`009else
X`009`009`009write (6, 1040)
X`009`009end if
X`009end do
X*
X*`009`009Come here when done processing symbol names.
X*
X 800`009TOUCHED = .false.
X`009i = 0
X`009do while (i .lt. NUM_SYMS  .and. .not.TOUCHED)
X`009`009i = i + 1
X`009`009if (XREF(i,OLD_SYM) .ne. XREF(i,NEW_SYM))  TOUCHED = .true.
X`009end do
X*
X*`009`009Create new object file if necessary.
X*
X`009if (TOUCHED) then
X 900`009`009write (6, 1050)
X`009`009read (5, 2000, end=950) ANS
X`009`009call str$upcase (ANS, ANS)
X`009`009if (ANS(1:1) .eq. 'Y') then
X`009`009`009write (6, 1070) OBJECT_FILE(1:LEN_OBJECT_FILE)
X`009`009`009rewind (OLD_FILE_LUN)
X`009`009`009if (.not. CREATE_NEW_FILE (OLD_FILE_LUN, XREF, NUM_SYMS,
V`0091`009`009`009`009`009   NEW_FILE_LUN, OBJECT_FILE(1:LEN_OBJECT_FILE)) ) the
Xn
X`009`009`009`009write (6, 1075)
X`009`009`009end if
X`009`009else if (ANS(1:1) .eq. 'N') then
X 950`009`009`009write (6, 1080) OBJECT_FILE(1:LEN_OBJECT_FILE)
X`009`009else
X`009`009`009write (6, 1060)
X`009`009`009goto 900
X`009`009end if
X`009else
X`009`009write (6, 1090)
X`009end if
X
X9999`009END
X
X
X
X`009OPTIONS`009/EXTEND_SOURCE
X`009LOGICAL FUNCTION`009GET_SYM_NAMES (LUN, XREF, NUM_SYMS)
X*`009======= ========`009=============
X*
X*`009`009This function loads the symbol names from the object file that
X*`009that is pointed to by LUN.  NUM_SYMS is returned as the number of
X*`009symbols loaded.
X*
V*******************************************************************************
X***********
X`009implicit integer * 4`009(A-Z)`009`009`009! No number crunching.
V`009include`009`009'GLIBSRC:$OBJDEF.FTN'`009`009! All symbols used in object fi
Xle definitions.
V`009parameter`009MAX_SYMS = 1000`009`009`009! Total number of symbol names I ca
Xn handle.
X`009parameter`009OLD_SYM = 1`009`009`009! Index into symbol name table.
X`009parameter`009NEW_SYM = 2`009`009`009! Index into symobl name table.
X
X`009structure /GSD_EPM_STRUCT/`009`009`009! Structure for GSD$C_EPM subrecord.
X`009  union
X`009    map
X`009`009character`009raw*(OBJ$C_MAXRECSIZ)`009!`009For use with formatted read.
X`009    end map
X`009    map
V`009`009byte`009`009rectyp`009`009`009!`009RECORD TYPE...will be OBJ$C_GSD for 
XGSD records.
V`009`009byte`009`009gsdtyp`009`009`009!`009GSD TYPE...will be GSD$C_EPM for cor
Xrect record.
X`009`009byte`009`009datyp`009`009`009!`009DATA TYPE.
X`009`009integer * 2`009flags`009`009`009!`009FLAGS.
X`009`009byte`009`009psindx`009`009`009!`009PSECT INDEX.
X`009`009integer * 4`009addrs`009`009`009!`009VALUE (entry point address).
X`009`009integer * 2`009mask`009`009`009!`009ENTRY MASK.
X`009`009byte`009`009namlng`009`009`009!`009NAME LENGTH.
X`009`009character * 31`009name`009`009`009!`009SYMBOL NAME.
X`009    end map
X`009  end union
X`009end structure ! /GSD_EPM_STRUCT/
X
X`009character * 31`009XREF(MAX_SYMS,2)
V`009record /GSD_EPM_STRUCT/`009REC`009`009`009! Record to get entry point symbo
Xl names.
X
X*`009`009Format statements.
X1000`009format (' Error reading object file.  Status = ',Z8.8)
X2000`009format (A)
X3000`009format (' Maximum number of symbols (',I5,') exceeded.'/
X`0091`009' Please increase MAX_SYMS and re-compile.')
V*------------------------------------------------------------------------------
X-----------
X*
X*`009`009Go to it.
X*
X`009GET_SYM_NAMES = .false.`009`009`009! Assume we won't be able to do it.
X`009do while (.true.)
X*
X*`009`009`009Read the next record if there is one and process any errors.
X*
X`009`009read (LUN, 2000, end=800, iostat=IOS) REC.raw
X`009`009if (IOS .ne. 0) then
X`009`009`009write (6, 1000) IOS
X`009`009`009goto 9999
X`009`009end if
X*
X*`009`009`009Account for only "Entry point symbols."
X*
X`009`009if (REC.rectyp .eq. OBJ$C_GSD  .and.  REC.gsdtyp .eq. GSD$C_EPM) then
X`009`009`009NUM_SYMS = NUM_SYMS + 1
X*
X*`009`009`009`009Check for overflow conditions.
X*
X`009`009`009if (NUM_SYMS .gt. MAX_SYMS) then`009
X`009`009`009`009write (6, 3000) MAX_SYMS
X`009`009`009`009goto 9999
X`009`009`009end if
X*
X*`009`009`009`009Record new symbol.
X*
X`009`009`009XREF(NUM_SYMS,OLD_SYM) = REC.name(1:REC.namlng)
X`009`009`009XREF(NUM_SYMS,NEW_SYM) = REC.name(1:REC.namlng)
X`009`009end if
X`009end do
X*
X*`009`009Come here on successful completion.
X*
X 800`009GET_SYM_NAMES = .true.
X*
X*`009`009Exit here!
X*
X9999`009return
X`009END
X
X
X
X`009OPTIONS`009/EXTEND_SOURCE
V`009LOGICAL FUNCTION`009CREATE_NEW_FILE (OLD_LUN, XREF, NUM_SYMS, NEW_LUN, FILE
X)
X*`009======= ========`009===============
X*
V*`009`009This function creates a new object file with the name FILE.  The symbo
Xl
V*`009names are changed according to XREF which is a two dimensionaly array of o
Xld
X*`009name to new name.
X*
V*******************************************************************************
X***********
X`009implicit integer * 4`009(A-Z)`009`009`009! No number crunching.
V`009include`009`009'GLIBSRC:$OBJDEF.FTN'`009`009! All symbols used in object fi
Xle definitions.
V`009parameter`009MAX_SYMS = 1000`009`009`009! Total number of symbol names I ca
Xn handle.
X`009parameter`009OLD_SYM = 1`009`009`009! Index into symbol name table.
X`009parameter`009NEW_SYM = 2`009`009`009! Index into symobl name table.
X
X`009structure /GSD_EPM_STRUCT/`009`009`009! Structure for GSD$C_EPM subrecord.
X`009  union
X`009    map
X`009`009character`009raw*(OBJ$C_MAXRECSIZ)`009!`009For use with formatted read.
X`009    end map
X`009    map
V`009`009byte`009`009rectyp`009`009`009!`009RECORD TYPE...will be OBJ$C_GSD for 
XGSD records.
V`009`009byte`009`009gsdtyp`009`009`009!`009GSD TYPE...will be GSD$C_EPM for cor
Xrect record.
X`009`009byte`009`009datyp`009`009`009!`009DATA TYPE.
X`009`009integer * 2`009flags`009`009`009!`009FLAGS.
X`009`009byte`009`009psindx`009`009`009!`009PSECT INDEX.
X`009`009integer * 4`009addrs`009`009`009!`009VALUE (entry point address).
X`009`009integer * 2`009mask`009`009`009!`009ENTRY MASK.
X`009`009byte`009`009namlng`009`009`009!`009NAME LENGTH.
X`009`009character * 31`009name`009`009`009!`009SYMBOL NAME.
X`009    end map
X`009  end union
X`009end structure ! /GSD_EPM_STRUCT/
X
X`009character * 31`009XREF(MAX_SYMS,2)`009`009! Input parameter.
X`009character * (*)`009FILE`009`009`009`009! Input parameter.
X
V`009record /GSD_EPM_STRUCT/`009REC`009`009`009! Record to get entry point symbo
Xl names.
X`009logical`009`009IS_THERE`009`009`009! TRUE if symbol is in symbol table.
X
X*`009`009Format statements.
X1000`009format (Q,(A))
X2000`009format ((A))
X3000`009format (' Error creating new object file.  Status = ', Z8.8)
X3010`009format (' Error reading old object file.  Status = ', Z8.8)
X3020`009format (' Error writing to new object file.  Status = ', Z8.8)
X3030`009format (' Error closing new object file.  Status = ', Z8.8)
X5000`009format (' Object file "',(A),'" deleted.')
X8000`009format (' Internal inconsistency in routine CREATE_NEW_FILE!')
V*------------------------------------------------------------------------------
X-----------
X*
X*`009`009Open a NEW file.
X*
X`009CREATE_NEW_FILE = .false.
V`009open (NEW_LUN, file=FILE, status='NEW', carriage control='NONE', recl=OBJ$C
X_MAXRECSIZ, iostat=IOS)
X`009if (IOS .ne. 0) then
X`009`009write (6, 3000) IOS
X`009`009goto 9999
X`009end if
X*
X*`009`009Loop reading and writing.
X*
X`009ptr_last = 0
X`009do while (.true.)
X*
X*`009`009`009Read the next record if there is one and process any errors.
X*
X`009`009read (OLD_LUN, 1000, end=800, iostat=IOS) LEN_REC, REC.raw
X`009`009if (IOS .ne. 0) then
X`009`009`009write (6, 3010) IOS
X`009`009`009write (6, 5000) FILE
X`009`009`009close (NEW_LUN, disp='DELETE', iostat=junk)
X`009`009`009goto 9999
X`009`009end if
X*
X*`009`009`009Account for only "Entry point symbol" changes.
X*
X`009`009if (REC.rectyp .eq. OBJ$C_GSD  .and.  REC.gsdtyp .eq. GSD$C_EPM) then
X`009`009`009if (REC.name .eq. XREF(ptr_last+1,OLD_SYM)) then
X`009`009`009`009ptr_last = ptr_last + 1
X`009`009`009else`009`009`009! Out of order for some reason!
X`009`009`009`009ptr_last = 0
X`009`009`009`009IS_THERE = .false.
X`009`009`009`009do while (ptr_last .lt. NUM_SYMS  .and.  .not.IS_THERE)
X`009`009`009`009`009ptr_last = ptr_last + 1
V`009`009`009`009`009if (REC.name .eq. XREF(ptr_last,OLD_SYM))  IS_THERE = .true
X.
X`009`009`009`009end do
X`009`009`009`009if (.not.IS_THERE) then
X`009`009`009`009`009write (6, 8000)
X`009`009`009`009`009write (6, 5000) FILE
X`009`009`009`009`009close (NEW_LUN, disp='DELETE', iostat=junk)
X`009`009`009`009`009goto 9999
X`009`009`009`009end if
X`009`009`009end if
X*
X*`009`009`009`009Change the name of the entry point symbol if necessary.
X*
X`009`009`009if (XREF(ptr_last,OLD_SYM) .ne. XREF(ptr_last,NEW_SYM)) then
X`009`009`009`009REC.name = XREF(ptr_last,NEW_SYM)`009! New symbol name.
V`009`009`009`009REC.namlng = l_nb_nnl(REC.name)`009`009! New symbol name length
X.
X`009`009`009`009LEN_REC = l_nb_nnl(REC.raw)`009`009! New record length!
X`009`009`009end if
X`009`009end if
X*
X*`009`009`009Write out the (possibly updated) record.
X*
X`009`009write (NEW_LUN, 2000, iostat=IOS) REC.raw(1:LEN_REC)
X`009`009if (IOS .ne. 0) then
X`009`009`009write (6, 3020) IOS
X`009`009`009write (6, 5000) FILE
X`009`009`009close (NEW_LUN, disp='DELETE', iostat=junk)
X`009`009`009goto 9999
X`009`009end if
X`009end do
X
X 800`009close (NEW_LUN, iostat=IOS)
X`009if (IOS .ne. 0) then
X`009`009write (6, 3030) IOS
X`009`009write (6, 5000) FILE
X`009`009close (NEW_LUN, disp='DELETE', iostat=junk)
X`009`009goto 9999
X`009end if
X`009CREATE_NEW_FILE = .true.
X
X9999`009return
X`009END
X
X
X
X`009OPTIONS`009/EXTEND_SOURCE
X`009SUBROUTINE`009LIST_ENTRIES (XREF, NUM_SYMS)
X*`009==========`009============
X*
X*`009`009This procedure lists out all the symbol names in the database.
X*
V*******************************************************************************
X***********
X`009implicit integer * 4`009(A-Z)`009`009`009! No number crunching.
V`009parameter`009MAX_SYMS = 1000`009`009`009! Total number of symbol names I ca
Xn handle.
X`009parameter`009OLD_SYM = 1`009`009`009! Index into symbol name table.
X`009parameter`009NEW_SYM = 2`009`009`009! Index into symobl name table.
X
X`009character * 31`009XREF(MAX_SYMS,2)`009`009! Input parameter.
X
X`009character * 80`009LINE`009`009`009`009! Output line.
X`009character * 64`009NEW_ENTRY`009`009`009! New entry for line.
X`009logical`009`009FIRST`009`009`009`009! True if first entry on line.
X
X*`009`009Format statements.
X1000`009format (' ',(A))
V*------------------------------------------------------------------------------
X----------
X
X`009LINE = ' '
X`009FIRST = .true.
X`009do i=1,NUM_SYMS
V`009`009LINE_FREE = len(LINE) - 2 - l_nb_nnl(LINE)`009`009! Amount of line rema
Xining before adding symbol.
V`009`009LINE_FREE = LINE_FREE - l_nb_nnl(XREF(i,OLD_SYM))`009! Is there room fo
Xr old symbol name?
V`009`009NEW_ENTRY = XREF(i,OLD_SYM)`009`009`009`009! Start building new line-en
Xtry.
V`009`009if (XREF(i,NEW_SYM) .ne. XREF(i,OLD_SYM)) then`009`009! Are symbol name
Xs different?
V`009`009`009LINE_FREE = LINE_FREE - l_nb_nnl(XREF(i,NEW_SYM)) - 2`009! Yes,`009
XSubtract its length (and "->").
V`009`009`009NEW_ENTRY = NEW_ENTRY(1:l_nb_nnl(NEW_ENTRY)) //`009`009!`009Take ol
Xd entry...
X`0091`009`009`009`009'->' //`009`009`009`009`009!`009Tack on "->"...
V`0091`009`009`009`009XREF(i,NEW_SYM)`009`009`009`009!`009Tack on new symbol nam
Xe.
X`009`009end if
X`009`009if (LINE_FREE .lt. 0) then
V`009`009`009write (6, 1000) LINE(1:l_nb_nnl(LINE))`009`009! No room on this lin
Xe...write it out.
X`009`009`009FIRST = .TRUE.
X`009`009end if
X`009`009if (FIRST) then
X`009`009`009FIRST = .false.
X`009`009`009LINE = NEW_ENTRY
X`009`009else
X`009`009`009LINE = LINE(1:l_nb_nnl(LINE)) // '  ' // NEW_ENTRY
X`009`009endif
X`009end do
X*
X*`009`009Print any portion of a line not already printed.
X*
X`009if (.not.FIRST)  write (6, 1000) LINE(1:l_nb_nnl(LINE))
X*
X*`009`009Exit the procedure.
X*
X`009return
X`009END
X
X
X
X`009OPTIONS`009/EXTEND_SOURCE
X`009SUBROUTINE`009MOD_ENTRY (XREF, NUM_SYMS)
X*`009==========`009=========
X*
X*`009`009This procedure allows you to modify the name of an entry point.
X*`009The name you specify is always the ORIGINAL name in the object file.
X*
V*******************************************************************************
X*******
X`009implicit integer * 4`009(A-Z)`009`009`009! No number crunching.
V`009parameter`009MAX_SYMS = 1000`009`009`009! Total number of symbol names I ca
Xn handle.
X`009parameter`009OLD_SYM = 1`009`009`009! Index into symbol name table.
X`009parameter`009NEW_SYM = 2`009`009`009! Index into symobl name table.
X
X`009character * 31`009XREF(MAX_SYMS,2)`009`009! Input parameter.
X`009character * 32`009ANS`009`009`009`009! Answer to a question.
X`009logical`009`009IS_THERE`009`009`009! TRUE if symbol is in table.
X
X*`009`009Format statements.
X1000`009format ('$    Enter OLD entry point symbol name (<CR> when done): ')
X1010`009format ('$    Enter NEW entry point symbol name: ')
X*`009`009Input formats:
X2000`009format (A)
X*`009`009Error formats:
X4000`009format (' Symbol "',(A),'" does not exist in object file.')
X4010`009format (' Duplicate symobol name...operation not done.')
X4020`009format (' Symbol has invalid characters in it.'/
X`0091`009' Must be A-Z, 0-9, "_", or "$".')
X4030`009format (' Symbol name can be no more than 31 characters long.')
V*------------------------------------------------------------------------------
X---------
X*
X*`009`009Get the old symbol name.
X*
X 100`009write (6, 1000)
X`009read (5, 2000, end=9999) ANS
X`009ANS = ANS(f_nb_nnl(ANS):)
X`009LEN_ANS = l_nb_nnl(ANS)
X`009if (LEN_ANS .eq. 0)  goto 9999
X`009call str$upcase (ANS, ANS)
X*
X*`009`009Make sure it is in symbol table.
X*
X`009IS_THERE = .false.
X`009ptr_old = 0
X`009do while (ptr_old .lt. NUM_SYMS  .and.  .not.IS_THERE)
X`009`009ptr_old = ptr_old + 1
X`009`009if (XREF(ptr_old,OLD_SYM) .eq. ANS)  IS_THERE = .true.
X`009end do
X`009if (.not.IS_THERE) then
X`009`009write (6, 4000) ANS(1:LEN_ANS)
X`009`009goto 100
X`009end if
X*
X*`009`009Now get the new name.
X*
X 200`009write (6, 1010)
X`009read (5, 2000, end=9999) ANS
X`009ANS = ANS(f_nb_nnl(ANS):)
X`009LEN_ANS = l_nb_nnl(ANS)
X`009if (LEN_ANS .eq. 0)  goto 100
X`009if (LEN_ANS .gt. 31) then
X`009`009write (6, 4030)
X`009`009goto 200
X`009end if
X*
X*`009`009Validate its character set.
X*
X`009call str$upcase (ANS, ANS)
X`009if (.not. VALID_SYMBOL (ANS)) then
X`009`009write (6, 4020)
X`009`009goto 200
X`009end if
X*
X*`009`009Make sure it is NOT in symbol table.
X*
X`009IS_THERE = .false.
X`009i = 0
X`009do while (i .lt. NUM_SYMS  .and.  .not.IS_THERE)
X`009`009i = i + 1
X`009`009if (i .ne. ptr_old  .and.  XREF(i,NEW_SYM) .eq. ANS)  IS_THERE = .true.
X`009end do
X`009if (IS_THERE) then
X`009`009write (6, 4010)
X`009`009goto 100
X`009end if
X*
X*`009`009Everything O.K.  Make the change.
X*
X`009XREF(ptr_old,NEW_SYM) = ANS
X*
X*`009`009Loop to beginning until <CR> entered.
X*
X`009goto 100
X
X9999`009return
X`009END
X
X
X
X`009LOGICAL FUNCTION`009VALID_SYMBOL (SYMB)
X*`009======= ========`009============
X*
X*`009`009This function test SYMB to see if it conforms to standard naming
X*`009conventions.  These currently are A-Z, 0-9, "_", and "$".
X*
V*******************************************************************************
X******
X`009implicit integer * 4`009(A-Z)
X
X`009character * (*)`009SYMB
X`009character`009CH
X
X`009logical`009`009GOOD
X
X`009GOOD = .true.
X`009i = 0
X`009do while (i .lt. l_nb_nnl(SYMB)  .and. GOOD)
X`009`009i = i + 1
X`009`009CH = SYMB(i:i)
X`009`009if (CH .ge. 'A'  .and.  CH .le. 'Z') then
X`009`009else if (CH .ge. '0'  .and.  CH .le. '9') then
X`009`009else if (CH .eq. '_'  .or.  CH .eq. '$') then
X`009`009else
X`009`009`009GOOD = .false.
X`009`009end if
X`009end do
X
X`009VALID_SYMBOL = GOOD
X`009return
X`009END
X
X
X
X
X`009integer * 4 function l_nb_nnl (string)`009`009! Last non-blank, non-null.
X`009character * (*)`009string
X`009integer * 4`009value
X`009do i=len(string),1,-1
X`009`009value = ichar(string(i:i))
X`009`009if (value.ne.'20'x.and.`009`009`009! No spaces.
X`0091`009    value.ne.'09'x.and.`009`009`009! No tabs.
X`0091`009    value.ne.'00'x)  goto 200`009`009! No nulls.
X`009end do
X 200`009l_nb_nnl = i
X`009return
X`009end
X
X`009integer * 4 function f_nb_nnl (string)`009`009! First non-blank, non-null.
X`009character * (*)`009string
X`009integer * 4`009value
X`009do i=1,len(string)
X`009`009value = ichar(string(i:i))
X`009`009if (value.ne.'20'x.and.`009`009`009! No spaces.
X`0091`009    value.ne.'09'x.and.`009`009`009! No tabs.
X`0091`009    value.ne.'00'x)  goto 200`009`009! No nulls.
X`009end do
X 200`009f_nb_nnl = i
X`009return
X`009end
$ GoSub Convert_File
$ File_is="DOIT.C"
$ Check_Sum_is=239207140
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X#include`009<vmscurses.h>
X
XWINDOW`009`009*win1;
X
Xmain ()
X{`009char`009str[80];
X
X`009initscr ();
X`009noecho ();
X`009cbreak ();
X
X`009win1 = newwin (10,20,10,10);
X`009box (stdscr, '|','-');
X`009box (win1, '|','-');
X`009refresh ();
X`009wrefresh (win1);
X
X`009getstr(str);
X`009mvwaddstr(stdscr, 22, 1, str);
X`009refresh ();
X`009getch ();
X
X`009mvwaddstr (win1, 5, 5, "Hello");
X`009wrefresh (win1);
X`009getch ();
X
X`009delwin (win1);
X`009touchwin (stdscr);
X`009refresh ();
X`009getch ();
X
X`009endwin ();
X}
$ GoSub Convert_File
$ File_is="DOIT1.C"
$ Check_Sum_is=761488067
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X#include`009<stdio.h>
X#include`009<curses.h>
X
XWINDOW`009`009*win1;
X
Xmain ()
X{`009char`009str[80];
X
X`009initscr ();
X`009noecho ();
X
X`009win1 = newwin (10,20,10,10);
X`009box (stdscr, '|','-');
X`009box (win1, '|','-');
X`009refresh ();
X`009wrefresh (win1);
X
X`009getstr(str);
X`009mvaddstr(22, 1, str);
X`009getch ();
X
X`009mvwaddstr (win1, 5, 5, "Hello");
X`009wrefresh (win1);
X`009getch ();
X
X`009delwin (win1);
X`009touchwin (stdscr);
X`009getch ();
X
X`009endwin ();
X}
$ GoSub Convert_File
$ Goto Part
$Part:
$ File_is="TEST.C"
$ Check_Sum_is=1196126340
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X#include`009<vmstermio.h>
X#include`009<errno.h>
X
Xmain (argc, argv)
X`009int`009argc;
X`009char`009*argv[];
X{
X`009struct termio`009saved_data;
X`009char`009`009ch;
X
X`009gtty();
X`009saved_data = def_termio;
X
X`009if (argc > 1)
X`009{`009noecho();
X`009`009noistrip();
X`009}
X
X`009printf ("\n\n****************\n");
X`009for (ch=getchar();  ch != '\t';  ch=getchar())
X`009`009putchar(ch);
X`009printf ("\n****************\n\n");
X
X`009if (argc > 2)
X`009`009flush();
X
X`009printf ("\n\n****************\n");
X`009for (ch=getchar();  ch != '\n';  ch=getchar())
X`009`009putchar(ch);
X`009printf ("\n****************\n\n");
X
X`009if (argc > 3)
X`009{`009echo();
X`009`009istrip();
X`009}
X}
$ GoSub Convert_File
$ File_is="TEST1.C"
$ Check_Sum_is=1077571003
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X#include <vmscurses.h>
X
X#define YPOSBOX`009`009 0
X#define XPOSBOX`009`009 0
X#define YBOX`009`00920
X#define XBOX`009        80
X
X#define YPOSSBOX`009 2
X#define XPOSSBOX`00910
X#define YSBOX`009        17
X#define XSBOX`009        66
X
XWINDOW *boxing,*sub_box;
Xmain()
X{
X`009boxing = newwin(YBOX,XBOX,YPOSBOX,XPOSBOX);
X`009sub_box = subwin(boxing,YSBOX,XSBOX,YPOSSBOX,XPOSSBOX);
X`009initscr();
X`009box(boxing,'|','-');
X`009wrefresh(boxing);
X`009box(sub_box,'.','.');
X`009overlay(sub_box,boxing);/* overlays sub_box on top of boxing */
X`009wrefresh(sub_box);
X`009mvcur(0,COLS-1,LINES-1,0);`009/* move to bottom of screen */
X`009endwin();
X}
$ GoSub Convert_File
$ File_is="TEST2.C"
$ Check_Sum_is=1360928203
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X# include <stdio.h>
X
Xstatic char`009str[] = "This is a test.\n";
X
Xmain ()
X{`009int`009size = strlen(str);
X
X`009isatty (fileno(stdout));
X
X`009(*stdout)->_flag &= ~_IONBF;
X`009(*stdout)->_cnt -= size;
X`009strcpy ((*stdout)->_base, str);
X`009(*stdout)->_ptr += size;
X
X`009fflush (stdout);
X}
$ GoSub Convert_File
$ Exit
-- 
/* My opinions...               *	Tony Ivanov   MS-4B		*/
/* shared by my company?!...    *	Grass Valley Group, Inc.	*/
/* you've got to be kidding!    *	P.O. Box 1114			*/
/* "tony@gvgpvd.GVG.TEK.COM"    *	Grass Valley, CA  95945		*/

