1$! File: generate_vax_transfer.com
2$!
3$! $Id$
4$!
5$! File to generate and compile the VAX transfer vectors from reading in the
6$! Alpha/Itanium gnv_libcurl_symbols.opt file.
7$!
8$! This procedure patches the VAX Macro32 assembler to be case sensitive
9$! and then compiles the generated
10$!
11$! The output of this procedure is:
12$!     gnv_libcurl_xfer.mar_exact
13$!     gnv_libcurl_xfer.obj
14$!     gnv_libcurl_xfer.opt
15$!     macro32_exactcase.exe
16$!
17$! Copyright 2013 - 2020, John Malmberg
18$!
19$! Permission to use, copy, modify, and/or distribute this software for any
20$! purpose with or without fee is hereby granted, provided that the above
21$! copyright notice and this permission notice appear in all copies.
22$!
23$! THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
24$! WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
25$! MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
26$! ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
27$! WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
28$! ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
29$! OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
30$!
31$! 20-Jul-2013  J. Malmberg
32$!============================================================================
33$!
34$! Save this so we can get back.
35$ default_dir = f$environment("default")
36$!
37$ on warning then goto all_exit
38$!
39$! Want hard tabs in the generated file.
40$ tab[0,8] = 9
41$!
42$! This procedure is used on VAX only
43$ if (f$getsyi("HW_MODEL") .ge. 1024)
44$ then
45$   write sys$output "This procedure is only used on VAX."
46$   goto all_exit
47$ endif
48$!
49$!
50$! Get the libcurl version to generate the ident string.
51$! ident string is max of 31 characters.
52$!
53$ ident_string = "unknown"
54$ open/read cver [-.-.include.curl]curlver.h
55$cver_loop:
56$ read/end=cver_loop_end cver line_in
57$ line_in = f$edit(line_in, "COMPRESS,TRIM")
58$ if line_in .eqs. "" then goto cver_loop
59$ code = f$extract(0, 1, line_in)
60$ if code .nes. "#" then goto cver_loop
61$ directive = f$element(0, " ", line_in)
62$ if directive .nes. "#define" then goto cver_loop
63$ name = f$element(1, " ", line_in)
64$ if name .nes. "LIBCURL_VERSION" then goto cver_loop
65$ ident_string = f$element(2, " ", line_in) - "" - ""
66$cver_loop_end:
67$ close cver
68$!
69$ open/read aopt gnv_libcurl_symbols.opt
70$!
71$! Write out the header
72$ gosub do_header
73$!
74$ open/append vopt gnv_libcurl_xfer.mar_exact
75$ write vopt tab,".IDENT /", ident_string, "/"
76$!
77$ write vopt tab, ".PSECT LIBCURL_XFERVECTORS  -"
78$ write vopt tab,tab,tab, "PIC,USR,CON,REL,GBL,SHR,EXE,RD,NOWRT,QUAD"
79$ write vopt ""
80$ write vopt tab, "SPARE", tab, "; never delete this spare"
81$ write vopt ";"
82$ write vopt ";", tab, "Exact case and upper case transfer vectors"
83$!
84$ alias_count = 0
85$vector_loop:
86$!
87$!  Read in symbol_vector
88$!
89$   read/end=vector_loop_end aopt line_in
90$   line = f$edit(line_in, "UNCOMMENT,COMPRESS,TRIM")
91$   if line .eqs. "" then goto vector_loop
92$!
93$   line_u = f$edit(line, "UPCASE")
94$   key = f$element(0, "=", line_u)
95$   if (key .eqs. "SYMBOL_VECTOR")
96$   then
97$       symbol_string = f$element(1, "=", line) - "("
98$       symbol_type = f$element(2, "=", line_u) - ")"
99$       symbol_name = f$element(1, "/", symbol_string)
100$       if symbol_type .nes. "PROCEDURE"
101$       then
102$           write sys$output "%CURLBUILD-W-NOTPROC, " + -
103$                            "This procedure can only handle procedure vectors"
104$           write sys$output -
105"Data vectors require manual construction for which this procedure or"
106$           write sys$output -
107"the shared library needs to be updated to resolve."
108$           write sys$output -
109"the preferred solution is to have a procedure return the address of the "
110$           write sys$output -
111"the variable instead of having a variable, as if the size of the variable "
112            write sys$output -
113"changes, the symbol vector is no longer backwards compatible."
114$       endif
115$       if (symbol_name .eqs. "/")
116$       then
117$           symbol_name = symbol_string
118$           write vopt tab, symbol_type, tab, symbol_name
119$       else
120$           alias_count = alias_count + 1
121$           symbol_alias = f$element(0, "/", symbol_string)
122$           write vopt -
123                  tab, "''symbol_type_U", tab, symbol_name, tab, symbol_alias
124$       endif
125$   endif
126$   goto vector_loop
127$vector_loop_end:
128$!
129$! End of pass one, second pass needed if aliases exist
130$ close aopt
131$!
132$ if alias_count .eq. 0 then goto finish_file
133$!
134$! Start pass 2, write stub routine header
135$!
136$ open/read aopt gnv_libcurl_symbols.opt
137$!
138$alias_loop:
139$!
140$!  Read in symbol_vector
141$!
142$   read/end=alias_loop_end aopt line_in
143$   line = f$edit(line_in, "UNCOMMENT,COMPRESS,TRIM")
144$   if line .eqs. "" then goto alias_loop
145$!
146$   line_u = f$edit(line, "UPCASE")
147$   key = f$element(0, "=", line_u)
148$   if (key .eqs. "SYMBOL_VECTOR")
149$   then
150$       symbol_string = f$element(1, "=", line) - "("
151$       symbol_type = f$element(2, "=", line_u) - ")"
152$       symbol_name = f$element(1, "/", symbol_string)
153$       if (symbol_name .eqs. "/")
154$       then
155$           symbol_name = symbol_string
156$       else
157$           alias_count = alias_count + 1
158$           symbol_alias = f$element(0, "/", symbol_string)
159$           write vopt tab, ".ENTRY", tab, symbol_alias, ", ^M<>"
160$       endif
161$   endif
162$   goto alias_loop
163$! read in symbol_vector
164$! if not alias, then loop
165$! write out subroutine name
166$!
167$alias_loop_end:
168$!
169$ write vopt tab, "MOVL #1, R0"
170$ write vopt tab, "RET"
171$!
172$finish_file:
173$!
174$ write vopt ""
175$ write vopt tab, ".END"
176$!
177$ close aopt
178$ close vopt
179$!
180$! Patch the Macro32 compiler
181$!----------------------------
182$ patched_macro = "sys$disk:[]macro32_exactcase.exe"
183$ if f$search(patched_macro) .eqs. ""
184$ then
185$   copy sys$system:macro32.exe 'patched_macro'
186$   patch @macro32_exactcase.patch
187$ endif
188$ define/user macro32 'patched_macro'
189$ macro/object=gnv_libcurl_xfer.obj gnv_libcurl_xfer.mar_exact
190$!
191$! Create the option file for linking the shared image.
192$ create gnv_libcurl_xfer.opt
193$ open/append lco gnv_libcurl_xfer.opt
194$ write lco "gsmatch=lequal,1,1"
195$ write lco "cluster=transfer_vector,,,''default_dir'gnv_libcurl_xfer"
196$ write lco "collect=libcurl_global, libcurl_xfervectors"
197$ close lco
198$!
199$!
200$ goto all_exit
201$!
202$! Process the header
203$do_header:
204$!
205$! Force the mode of the file to same as text editor generated.
206$ create gnv_libcurl_xfer.mar_exact
207$deck
208; File: gnv_libcurl_xfer.mar_exact
209;
210; VAX transfer vectors
211;
212; This needs to be compiled with a specialized patch on Macro32 to make it
213; preserve the case of symbols instead of converting it to uppercase.
214;
215; This patched Macro32 requires all directives to be in upper case.
216;
217; There are three sets of symbols for transfer vectors here.
218;
219; The first for upper case which matches the tradition method of generating
220; VAX transfer vectors.
221;
222; The second is the exact case for compatibility with open source C programs
223; that expect exact case symbols in images.  These are separated because a
224; previous kit had only upper case symbols.
225;
226; The third is the routine stub that is used to resolve part of the upper
227; case transfer vectors, with exact case entry symbols.
228;
229; When you add routines, you need to add them after the second set of transfer
230; vectors for both upper and exact case, and then additional entry points
231; in upper case added to stub routines.
232;
233;*************************************************************************
234
235        .TITLE libcurl_xfer - Transfer vector for libcurl
236        .DISABLE GLOBAL
237
238;
239; Macro to generate a transfer vector entry
240;
241        .MACRO  PROCEDURE       NAME
242        .EXTRN          'NAME
243        .ALIGN  QUAD
244        .TRANSFER       'NAME
245        .MASK           'NAME
246        JMP             'NAME+2
247        .ENDM
248
249        .MACRO  PROCEDUREU      NAME    NAMEU
250        .EXTRN          'NAME
251        .ALIGN  QUAD
252        .TRANSFER       'NAMEU
253        .MASK           'NAME
254        JMP             'NAME+2
255
256        .ENDM
257;
258;
259; Macro to reserve a spare entry.
260;
261        .MACRO  SPARE
262        .ALIGN QUAD
263        .ALIGN QUAD
264        .QUAD   0
265        .ENDM
266
267$EOD
268$!
269$!
270$ return
271$!
272$all_exit:
273$set def 'default_dir'
274$exit '$status'
275