1$! MKSHARED.COM -- script to created shareable images on VMS
2$!
3$! No command line parameters.  This should be run at the start of the source
4$! tree (the same directory where one finds INSTALL.VMS).
5$!
6$! Input:	[.UTIL]LIBEAY.NUM,[.AXP.EXE.CRYPTO]LIBCRYPTO.OLB
7$!		[.UTIL]SSLEAY.NUM,[.AXP.EXE.SSL]LIBSSL.OLB
8$! Output:	[.AXP.EXE.CRYPTO]LIBCRYPTO.OPT,.MAP,.EXE
9$!		[.AXP.EXE.SSL]LIBSSL.OPT,.MAP,.EXE
10$!
11$! So far, tests have only been made on VMS for Alpha.  VAX will come in time.
12$! ===========================================================================
13$
14$! ----- Prepare info for processing: version number and file info
15$ gosub read_version_info
16$ if libver .eqs. ""
17$ then
18$   write sys$error "ERROR: Couldn't find any library version info..."
19$   exit
20$ endif
21$
22$ if f$getsyi("CPU") .ge. 128
23$ then
24$   libid  = "Crypto"
25$   libnum = "[.UTIL]LIBEAY.NUM"
26$   libdir = "[.AXP.EXE.CRYPTO]"
27$   libolb = "''libdir'LIBCRYPTO.OLB"
28$   libopt = "''libdir'LIBCRYPTO.OPT"
29$   libmap = "''libdir'LIBCRYPTO.MAP"
30$   libgoal= "''libdir'LIBCRYPTO.EXE"
31$   libref = ""
32$   gosub create_axp_shr
33$   libid  = "SSL"
34$   libnum = "[.UTIL]SSLEAY.NUM"
35$   libdir = "[.AXP.EXE.SSL]"
36$   libolb = "''libdir'LIBSSL.OLB"
37$   libopt = "''libdir'LIBSSL.OPT"
38$   libmap = "''libdir'LIBSSL.MAP"
39$   libgoal= "''libdir'LIBSSL.EXE"
40$   libref = "[.AXP.EXE.CRYPTO]LIBCRYPTO.EXE"
41$   gosub create_axp_shr
42$ else
43$   libtit = "CRYPTO_TRANSFER_VECTOR"
44$   libid  = "Crypto"
45$   libnum = "[.UTIL]LIBEAY.NUM"
46$   libdir = "[.VAX.EXE.CRYPTO]"
47$   libmar = "''libdir'LIBCRYPTO.MAR"
48$   libolb = "''libdir'LIBCRYPTO.OLB"
49$   libopt = "''libdir'LIBCRYPTO.OPT"
50$   libobj = "''libdir'LIBCRYPTO.OBJ"
51$   libmap = "''libdir'LIBCRYPTO.MAP"
52$   libgoal= "''libdir'LIBCRYPTO.EXE"
53$   libref = ""
54$   libvec = "LIBCRYPTO"
55$   gosub create_vax_shr
56$   libtit = "SSL_TRANSFER_VECTOR"
57$   libid  = "SSL"
58$   libnum = "[.UTIL]SSLEAY.NUM"
59$   libdir = "[.VAX.EXE.SSL]"
60$   libmar = "''libdir'LIBSSL.MAR"
61$   libolb = "''libdir'LIBSSL.OLB"
62$   libopt = "''libdir'LIBSSL.OPT"
63$   libobj = "''libdir'LIBSSL.OBJ"
64$   libmap = "''libdir'LIBSSL.MAP"
65$   libgoal= "''libdir'LIBSSL.EXE"
66$   libref = "[.VAX.EXE.CRYPTO]LIBCRYPTO.EXE"
67$   libvec = "LIBSSL"
68$   gosub create_vax_shr
69$ endif
70$ exit
71$
72$! ----- Soubroutines to actually build the shareable libraries
73$! The way things work, there's a main shareable library creator for each
74$! supported architecture, which is called from the main code above.
75$! The creator will define a number of variables to tell the next levels of
76$! subroutines what routines to use to write to the option files, call the
77$! main processor, read_func_num, and when that is done, it will write version
78$! data at the end of the .opt file, close it, and link the library.
79$!
80$! read_func_num reads through a .num file and calls the writer routine for
81$! each line.  It's also responsible for checking that order is properly kept
82$! in the .num file, check that each line applies to VMS and the architecture,
83$! and to fill in "holes" with dummy entries.
84$!
85$! The creator routines depend on the following variables:
86$! libnum	The name of the .num file to use as input
87$! libolb	The name of the object library to build from
88$! libid	The identification string of the shareable library
89$! libopt	The name of the .opt file to write
90$! libtit	The title of the assembler transfer vector file (VAX only)
91$! libmar	The name of the assembler transfer vector file (VAX only)
92$! libmap	The name of the map file to write
93$! libgoal	The name of the shareable library to write
94$! libref	The name of a shareable library to link in
95$!
96$! read_func_num depends on the following variables from the creator:
97$! libwriter	The name of the writer routine to call for each .num file line
98$! -----
99$
100$! ----- Subroutines for AXP
101$! -----
102$! The creator routine
103$ create_axp_shr:
104$   open/write opt 'libopt'
105$   write opt "identification=""",libid," ",libverstr,""""
106$   write opt libolb,"/lib"
107$   if libref .nes. "" then write opt libref,"/SHARE"
108$   write opt "SYMBOL_VECTOR=(-"
109$   libfirstentry := true
110$   libwrch   := opt
111$   libwriter := write_axp_transfer_entry
112$   textcount = 0
113$   gosub read_func_num
114$   write opt ")"
115$   write opt "GSMATCH=",libvmatch,",",libver
116$   close opt
117$   link/map='libmap'/full/share='libgoal' 'libopt'/option
118$   return
119$
120$! The record writer routine
121$ write_axp_transfer_entry:
122$   if libentry .eqs. ".dummy" then return
123$   if info_kind .eqs. "VARIABLE"
124$   then
125$     pr:=DATA
126$   else
127$     pr:=PROCEDURE
128$   endif
129$   textcount_this = f$length(pr) + f$length(libentry) + 5
130$   if textcount + textcount_this .gt. 1024
131$   then
132$     write opt ")"
133$     write opt "SYMBOL_VECTOR=(-"
134$     textcount = 16
135$     libfirstentry := true
136$   endif
137$   if libfirstentry
138$   then
139$     write 'libwrch' "    ",libentry,"=",pr," -"
140$   else
141$     write 'libwrch' "    ,",libentry,"=",pr," -"
142$   endif
143$   libfirstentry := false
144$   textcount = textcount + textcount_this
145$   return
146$
147$! ----- Subroutines for AXP
148$! -----
149$! The creator routine
150$ create_vax_shr:
151$   open/write mar 'libmar'
152$   type sys$input:/out=mar:
153;
154; Transfer vector for VAX shareable image
155;
156$   write mar "	.TITLE ",libtit
157$   write mar "	.IDENT /",libid,"/"
158$   type sys$input:/out=mar:
159;
160; Define macro to assist in building transfer vector entries.  Each entry
161; should take no more than 8 bytes.
162;
163	.MACRO FTRANSFER_ENTRY routine
164	.ALIGN QUAD
165	.TRANSFER routine
166	.MASK	routine
167	JMP	routine+2
168	.ENDM FTRANSFER_ENTRY
169;
170; Place entries in own program section.
171;
172$   write mar "	.PSECT $$",libvec,",QUAD,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT"
173$   write mar libvec,"_xfer:"
174$   libwrch   := mar
175$   libwriter := write_vax_ftransfer_entry
176$   gosub read_func_num
177$   type sys$input:/out=mar:
178;
179; Allocate extra storage at end of vector to allow for expansion.
180;
181$   write mar "	.BLKB 32768-<.-",libvec,"_xfer>	; 64 pages total."
182$!   libwriter := write_vax_vtransfer_entry
183$!   gosub read_func_num
184$   write mar "	.END"
185$   close mar
186$   open/write opt 'libopt'
187$   write opt "identification=""",libid," ",libverstr,""""
188$   write opt libobj
189$   write opt libolb,"/lib"
190$   if libref .nes. "" then write opt libref,"/SHARE"
191$   type sys$input:/out=opt:
192!
193! Ensure transfer vector is at beginning of image
194!
195CLUSTER=FIRST
196$   write opt "COLLECT=FIRST,$$",libvec
197$   write opt "GSMATCH=",libvmatch,",",libver
198$   type sys$input:/out=opt:
199!
200! make psects nonshareable so image can be installed.
201!
202PSECT_ATTR=$CHAR_STRING_CONSTANTS,NOWRT
203$   libwrch   := opt
204$   libwriter := write_vax_psect_attr
205$   gosub read_func_num
206$   close opt
207$   macro/obj='libobj' 'libmar'
208$   link/map='libmap'/full/share='libgoal' 'libopt'/option
209$   return
210$
211$! The record writer routine for VAX functions
212$ write_vax_ftransfer_entry:
213$   if info_kind .nes. "FUNCTION" then return
214$   if libentry .eqs ".dummy"
215$   then
216$     write 'libwrch' "	.BLKB 8" ! Dummy is zeroes...
217$   else
218$     write 'libwrch' "	FTRANSFER_ENTRY ",libentry
219$   endif
220$   return
221$! The record writer routine for VAX variables (should never happen!)
222$ write_vax_psect_attr:
223$   if info_kind .nes. "VARIABLE" then return
224$   if libentry .eqs ".dummy" then return
225$   write 'libwrch' "PSECT_ATTR=",libentry,",NOSHR"
226$   return
227$
228$! ----- Common subroutines
229$! -----
230$! The .num file reader.  This one has great responsability.
231$ read_func_num:
232$   open libnum 'libnum'
233$   goto read_nums
234$
235$ read_nums:
236$   libentrynum=0
237$   liblastentry:=false
238$   entrycount=0
239$   loop:
240$     read/end=loop_end/err=loop_end libnum line
241$     entrynum=f$int(f$element(1," ",f$edit(line,"COMPRESS,TRIM")))
242$     entryinfo=f$element(2," ",f$edit(line,"COMPRESS,TRIM"))
243$     curentry=f$element(0," ",f$edit(line,"COMPRESS,TRIM"))
244$     info_exist=f$element(0,":",entryinfo)
245$     info_platforms=","+f$element(1,":",entryinfo)+","
246$     info_kind=f$element(2,":",entryinfo)
247$     info_algorithms=","+f$element(3,":",entryinfo)+","
248$     if info_exist .eqs. "NOEXIST" then goto loop
249$     truesum = 0
250$     falsesum = 0
251$     negatives = 1
252$     plat_i = 0
253$     loop1:
254$       plat_entry = f$element(plat_i,",",info_platforms)
255$       plat_i = plat_i + 1
256$       if plat_entry .eqs. "" then goto loop1
257$       if plat_entry .nes. ","
258$       then
259$         if f$extract(0,1,plat_entry) .nes. "!" then negatives = 0
260$         if f$getsyi("CPU") .lt. 128
261$         then
262$           if plat_entry .eqs. "EXPORT_VAR_AS_FUNCTION" then -
263$             truesum = truesum + 1
264$           if plat_entry .eqs. "!EXPORT_VAR_AS_FUNCTION" then -
265$             falsesum = falsesum + 1
266$         endif
267$         if plat_entry .eqs. "VMS" then truesum = truesum + 1
268$         if plat_entry .eqs. "!VMS" then falsesum = falsesum + 1
269$         if f$trnlnm("OPENSSL_FIPS") .nes. ""
270$         then
271$           if plat_entry .eqs. "OPENSSL_FIPS" then truesum = truesum + 1
272$           if plat_entry .eqs. "!OPENSSL_FIPS" then falsesum = falsesum + 1
273$         else
274$           if plat_entry .eqs. "OPENSSL_FIPS" then falsesum = falsesum + 1
275$           if plat_entry .eqs. "!OPENSSL_FIPS" then truesum = truesum + 1
276$         endif
277$	  goto loop1
278$       endif
279$     endloop1:
280$!DEBUG!$     if info_platforms - "EXPORT_VAR_AS_FUNCTION" .nes. info_platforms
281$!DEBUG!$     then
282$!DEBUG!$       write sys$output line
283$!DEBUG!$       write sys$output "        truesum = ",truesum,-
284$!DEBUG!		", negatives = ",negatives,", falsesum = ",falsesum
285$!DEBUG!$     endif
286$     if falsesum .ne. 0 then goto loop
287$     if truesum+negatives .eq. 0 then goto loop
288$     alg_i = 0
289$     loop2:
290$       alg_entry = f$element(alg_i,",",info_algorithms)
291$	alg_i = alg_i + 1
292$       if alg_entry .eqs. "" then goto loop2
293$       if alg_entry .nes. ","
294$       then
295$         if alg_entry .eqs. "KRB5" then goto loop ! Special for now
296$         if f$trnlnm("OPENSSL_NO_"+alg_entry) .nes. "" then goto loop
297$	  goto loop2
298$       endif
299$     endloop2:
300$     if info_platforms - "EXPORT_VAR_AS_FUNCTION" .nes. info_platforms
301$     then
302$!DEBUG!$     write sys$output curentry," ; ",entrynum," ; ",entryinfo
303$     endif
304$   redo:
305$     next:=loop
306$     tolibentry=curentry
307$     if libentrynum .ne. entrynum
308$     then
309$       entrycount=entrycount+1
310$       if entrycount .lt. entrynum
311$       then
312$!DEBUG!$         write sys$output "Info: entrycount: ''entrycount', entrynum: ''entrynum' => 0"
313$         tolibentry=".dummy"
314$         next:=redo
315$       endif
316$       if entrycount .gt. entrynum
317$       then
318$         write sys$error "Decreasing library entry numbers!  Can't continue"
319$         write sys$error """",line,""""
320$         close libnum
321$         return
322$       endif
323$       libentry=tolibentry
324$!DEBUG!$       write sys$output entrycount," ",libentry," ",entryinfo
325$       if libentry .nes. "" .and. libwriter .nes. "" then gosub 'libwriter'
326$     else
327$       write sys$error "Info: ""''curentry'"" is an alias for ""''libentry'"".  Overriding..."
328$     endif
329$     libentrynum=entrycount
330$     goto 'next'
331$   loop_end:
332$   close libnum
333$   return
334$
335$! The version number reader
336$ read_version_info:
337$   libver = ""
338$   open/read vf [.CRYPTO]OPENSSLV.H
339$   loop_rvi:
340$     read/err=endloop_rvi/end=endloop_rvi vf rvi_line
341$     if rvi_line - "SHLIB_VERSION_NUMBER """ .eqs. rvi_line then -
342	goto loop_rvi
343$     libverstr = f$element(1,"""",rvi_line)
344$     libvmajor = f$element(0,".",libverstr)
345$     libvminor = f$element(1,".",libverstr)
346$     libvedit = f$element(2,".",libverstr)
347$     libvpatch = f$cvui(0,8,f$extract(1,1,libvedit)+"@")-f$cvui(0,8,"@")
348$     libvedit = f$extract(0,1,libvedit)
349$     libver = f$string(f$int(libvmajor)*100)+","+-
350	f$string(f$int(libvminor)*100+f$int(libvedit)*10+f$int(libvpatch))
351$     if libvmajor .eqs. "0"
352$     then
353$       libvmatch = "EQUAL"
354$     else
355$       ! Starting with the 1.0 release, backward compatibility should be
356$       ! kept, so switch over to the following
357$       libvmatch = "LEQUAL"
358$     endif
359$   endloop_rvi:
360$   close vf
361$   return
362