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