	PROGRAM LIBTOSHAR
C
C	INVOKE THIS PROGRAM TO CREATE MACRO TRANSFER TABLE WHEN
C	CREATING A SHARED EXECUTABLE LIBRARY FROM AN EXISTING 
C	OBJECT LIBRARY
C
C	OUTPUTS ARE A FILE NAMED 'SHARE.MAR'
C		WHICH IS MACRO CODE FOR TRANSFER VECTOR TABLE
C		AND A FILE NAMED 'SHARE.OPT' WHICH IS MOST OF AN OPTION
C		FILE, NEEDED AT "LINK/SHARE" TIME
C
C	JOHN WHITMORE, MAY 1984, U. OF WA.
C
C	EXPAND NCSYMB FOR LONGER OBJECT MODULE NAMES IF NECESSARY
C
	INTEGER BUFFIL
	LOGICAL LOOP1
	PARAMETER (NCSYMB=31, NCLINE=135)
	CHARACTER*(NCSYMB) NAME,MODULE,LINE*(NCLINE)
	PARAMETER (INCLEN=26,BUFLEN=61)
	CHARACTER INCLUD*(INCLEN),BUFFER*(BUFLEN)
	DATA INCLUD/ 'LTSHAR_LIB_NAME/INCLUDE=( '/
C
	OPEN(4,FILE='LIB.LIS',FORM='FORMATTED',STATUS='OLD',
	1	CARRIAGECONTROL='LIST',READONLY)
	OPEN(5,FILE='SHARE.MAR',FORM='FORMATTED',STATUS='NEW',
	1	CARRIAGECONTROL='LIST')
	OPEN(6,FILE='SHARE.OPT',FORM='FORMATTED',STATUS='NEW',
	1	CARRIAGECONTROL='LIST')
C
	LOOP1= .TRUE.
C
C		READ UNTIL FIND A LINE ABOUT A MODULE
 1	READ(4,1001,END=999) LINE
	IF(INDEX(LINE(1:10) ,'Module') .EQ. 0) GO TO 1
C		AND FIND OUT HOW MANY ENTRY POINTS THERE ARE
	READ(LINE,1003) N_OFSYMBOLS
C
C		EXTRACT MODULE NAME (IF BLANK, SOMETHING WRONG)
	CALL SUBSTG(LINE,'Module ', ' ', MODULE)
	IF(MODULE .EQ. ' ') GO TO 9992
	NLEN= NBLEN(MODULE)
C
C		TEST TO SEE IF ANOTHER MODULE NAME FITS ON LINE;
C		PURGE BUFFER FIRST IF NOT; ADD MODULE TO BUFFER
	IF( LOOP1) THEN
		LOOP1= .FALSE.
C
C	  FIRST MODULE SEEN, ADOPT ITS NAME FOR THE TRANSFER TABLE
		WRITE(5,1001) '; SHARE.MAR'
		WRITE(5,1001) '; Transfer vectors'
		WRITE(5,1001) ';'
		WRITE(5,1001) '	.TITLE '//MODULE(1:NLEN)//'_SHARE'
		WRITE(5,1001) '	.IDENT ''V01-000'' '
		WRITE(5,1001) ';'
		WRITE(5,1001) '	.PSECT TRANSFER,EXE,NOWRT,PIC,SHR,GBL'
		WRITE(5,1001) ';'
C	 AND THE EXECUTABLE, AS WELL
		JSTAT= LIB$SET_LOGICAL('EXE_NAME',
	1		MODULE(1:NLEN)//'_SHARE',,)
		IF(.NOT. JSTAT) CALL EXIT(JSTAT)
C
		BUFFER=' '
		BUFFIL= NLEN+ INCLEN
		BUFFER(1:BUFFIL) = INCLUD//MODULE(1:NLEN)
	ELSE IF( BUFFIL + NLEN + 1 .GT. BUFLEN ) THEN
		WRITE(6,1001) BUFFER//'),-'
		BUFFER=' '
		BUFFIL= NLEN+ INCLEN
		BUFFER(1:BUFFIL) = INCLUD//MODULE(1:NLEN)
	ELSE
		IBEGIN= BUFFIL+1
		BUFFIL= BUFFIL + NLEN + 1
		BUFFER(IBEGIN:BUFFIL) = ','//MODULE(1:NLEN)
	ENDIF
C
C		READ NEXT LINE (OR SEVERAL) AND UNPACK NAMES
	READ(4,1001) LINE
	DO 20 NN=1, N_OFSYMBOLS
 10		CALL SUBSTG(LINE,'BEGINNING-OF-STRING',' ',NAME)
		IF(NAME .EQ. ' ') THEN
			READ(4,1001,END=9993) LINE
			GO TO 10
		ENDIF
		N=NBLEN(NAME)
		WRITE(5, 1004) NAME(1:N), NAME(1:N), NAME(1:N)
 20	CONTINUE
C
C		AND SKIP A TRAILING BLANK LINE
	READ(4,1001)
C		READ NAMES NOW FROM NEXT MODULE
	GO TO 1
C
C		ERROR ON READ TRAPPED HERE
 9992	STOP ' ERR-LIBTOSHR: MODULE NAME NOT WHERE IT SHOULD BE'
 9993	STOP ' ERR-LIBTOSHR: LESS ENTRY POINTS THAN EXPECTED '
C
C		NORMAL EXIT HERE, ON HITTING END OF INPUT LIB.LIS
 999	CONTINUE
C
	WRITE(5,1001) '	.END'
C
	WRITE(6,1001) BUFFER(1:BUFFIL)//')'
	WRITE(6,1001) '!  Names of FORTRAN common blocks used must'
	WRITE(6,1001) '!   be mentioned in this next section, as :'
	WRITE(6,1001) '!	PSECT=common_block,GBL,NOSHR,RD,WRT'
	WRITE(6,1001) 'GSMATCH=ALWAYS,0,0'
	WRITE(6,1001) 'CLUSTER=XFER,,,DEF_DIR:XSHARE'
	CLOSE(6)
	CLOSE(5)
	CLOSE(4)
	STOP ' NORMAL EXIT FROM LIBTOSHR'
 1001	FORMAT (A)
 1003	FORMAT (BN, 76X, I2)
 1004	FORMAT (';',/,  '	.TRANSFER	',	A,
	1	/,	'	.MASK	',	A,
	2	/,	'	JMP L^',	A,'+2')
 1005	FORMAT ( A1,A,' -')
C
	END
