path: root/packages/vms/generate_vax_transfer.com

$! File: generate_vax_transfer.com
$!
$! $Id$
$!
$! File to generate and compile the VAX transfer vectors from reading in the
$! Alpha/Itanium gnv_libcurl_symbols.opt file.
$!
$! This procedure patches the VAX Macro32 assembler to be case sensitive
$! and then compiles the generated
$!
$! The output of this procedure is:
$!     gnv_libcurl_xfer.mar_exact
$!     gnv_libcurl_xfer.obj
$!     gnv_libcurl_xfer.opt
$!     macro32_exactcase.exe
$!
$! Copyright 2013 - 2020, John Malmberg
$!
$! Permission to use, copy, modify, and/or distribute this software for any
$! purpose with or without fee is hereby granted, provided that the above
$! copyright notice and this permission notice appear in all copies.
$!
$! THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
$! WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
$! MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
$! ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
$! WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
$! ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
$! OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
$!
$! 20-Jul-2013  J. Malmberg
$!============================================================================
$!
$! Save this so we can get back.
$ default_dir = f$environment("default")
$!
$ on warning then goto all_exit
$!
$! Want hard tabs in the generated file.
$ tab[0,8] = 9
$!
$! This procedure is used on VAX only
$ if (f$getsyi("HW_MODEL") .ge. 1024)
$ then
$   write sys$output "This procedure is only used on VAX."
$   goto all_exit
$ endif
$!
$!
$! Get the libcurl version to generate the ident string.
$! ident string is max of 31 characters.
$!
$ ident_string = "unknown"
$ open/read cver [-.-.include.curl]curlver.h
$cver_loop:
$ read/end=cver_loop_end cver line_in
$ line_in = f$edit(line_in, "COMPRESS,TRIM")
$ if line_in .eqs. "" then goto cver_loop
$ code = f$extract(0, 1, line_in)
$ if code .nes. "#" then goto cver_loop
$ directive = f$element(0, " ", line_in)
$ if directive .nes. "#define" then goto cver_loop
$ name = f$element(1, " ", line_in)
$ if name .nes. "LIBCURL_VERSION" then goto cver_loop
$ ident_string = f$element(2, " ", line_in) - "" - ""
$cver_loop_end:
$ close cver
$!
$ open/read aopt gnv_libcurl_symbols.opt
$!
$! Write out the header
$ gosub do_header
$!
$ open/append vopt gnv_libcurl_xfer.mar_exact
$ write vopt tab,".IDENT /", ident_string, "/"
$!
$ write vopt tab, ".PSECT LIBCURL_XFERVECTORS  -"
$ write vopt tab,tab,tab, "PIC,USR,CON,REL,GBL,SHR,EXE,RD,NOWRT,QUAD"
$ write vopt ""
$ write vopt tab, "SPARE", tab, "; never delete this spare"
$ write vopt ";"
$ write vopt ";", tab, "Exact case and upper case transfer vectors"
$!
$ alias_count = 0
$vector_loop:
$!
$!  Read in symbol_vector
$!
$   read/end=vector_loop_end aopt line_in
$   line = f$edit(line_in, "UNCOMMENT,COMPRESS,TRIM")
$   if line .eqs. "" then goto vector_loop
$!
$   line_u = f$edit(line, "UPCASE")
$   key = f$element(0, "=", line_u)
$   if (key .eqs. "SYMBOL_VECTOR")
$   then
$       symbol_string = f$element(1, "=", line) - "("
$       symbol_type = f$element(2, "=", line_u) - ")"
$       symbol_name = f$element(1, "/", symbol_string)
$       if symbol_type .nes. "PROCEDURE"
$       then
$           write sys$output "%CURLBUILD-W-NOTPROC, " + -
$                            "This procedure can only handle procedure vectors"
$           write sys$output -
"Data vectors require manual construction for which this procedure or"
$           write sys$output -
"the shared library needs to be updated to resolve."
$           write sys$output -
"the preferred solution is to have a procedure return the address of the "
$           write sys$output -
"the variable instead of having a variable, as if the size of the variable "
            write sys$output -
"changes, the symbol vector is no longer backwards compatible."
$       endif
$       if (symbol_name .eqs. "/")
$       then
$           symbol_name = symbol_string
$           write vopt tab, symbol_type, tab, symbol_name
$       else
$           alias_count = alias_count + 1
$           symbol_alias = f$element(0, "/", symbol_string)
$           write vopt -
                  tab, "''symbol_type_U", tab, symbol_name, tab, symbol_alias
$       endif
$   endif
$   goto vector_loop
$vector_loop_end:
$!
$! End of pass one, second pass needed if aliases exist
$ close aopt
$!
$ if alias_count .eq. 0 then goto finish_file
$!
$! Start pass 2, write stub routine header
$!
$ open/read aopt gnv_libcurl_symbols.opt
$!
$alias_loop:
$!
$!  Read in symbol_vector
$!
$   read/end=alias_loop_end aopt line_in
$   line = f$edit(line_in, "UNCOMMENT,COMPRESS,TRIM")
$   if line .eqs. "" then goto alias_loop
$!
$   line_u = f$edit(line, "UPCASE")
$   key = f$element(0, "=", line_u)
$   if (key .eqs. "SYMBOL_VECTOR")
$   then
$       symbol_string = f$element(1, "=", line) - "("
$       symbol_type = f$element(2, "=", line_u) - ")"
$       symbol_name = f$element(1, "/", symbol_string)
$       if (symbol_name .eqs. "/")
$       then
$           symbol_name = symbol_string
$       else
$           alias_count = alias_count + 1
$           symbol_alias = f$element(0, "/", symbol_string)
$           write vopt tab, ".ENTRY", tab, symbol_alias, ", ^M<>"
$       endif
$   endif
$   goto alias_loop
$! read in symbol_vector
$! if not alias, then loop
$! write out subroutine name
$!
$alias_loop_end:
$!
$ write vopt tab, "MOVL #1, R0"
$ write vopt tab, "RET"
$!
$finish_file:
$!
$ write vopt ""
$ write vopt tab, ".END"
$!
$ close aopt
$ close vopt
$!
$! Patch the Macro32 compiler
$!----------------------------
$ patched_macro = "sys$disk:[]macro32_exactcase.exe"
$ if f$search(patched_macro) .eqs. ""
$ then
$   copy sys$system:macro32.exe 'patched_macro'
$   patch @macro32_exactcase.patch
$ endif
$ define/user macro32 'patched_macro'
$ macro/object=gnv_libcurl_xfer.obj gnv_libcurl_xfer.mar_exact
$!
$! Create the option file for linking the shared image.
$ create gnv_libcurl_xfer.opt
$ open/append lco gnv_libcurl_xfer.opt
$ write lco "gsmatch=lequal,1,1"
$ write lco "cluster=transfer_vector,,,''default_dir'gnv_libcurl_xfer"
$ write lco "collect=libcurl_global, libcurl_xfervectors"
$ close lco
$!
$!
$ goto all_exit
$!
$! Process the header
$do_header:
$!
$! Force the mode of the file to same as text editor generated.
$ create gnv_libcurl_xfer.mar_exact
$deck
; File: gnv_libcurl_xfer.mar_exact
;
; VAX transfer vectors
;
; This needs to be compiled with a specialized patch on Macro32 to make it
; preserve the case of symbols instead of converting it to uppercase.
;
; This patched Macro32 requires all directives to be in upper case.
;
; There are three sets of symbols for transfer vectors here.
;
; The first for upper case which matches the tradition method of generating
; VAX transfer vectors.
;
; The second is the exact case for compatibility with open source C programs
; that expect exact case symbols in images.  These are separated because a
; previous kit had only upper case symbols.
;
; The third is the routine stub that is used to resolve part of the upper
; case transfer vectors, with exact case entry symbols.
;
; When you add routines, you need to add them after the second set of transfer
; vectors for both upper and exact case, and then additional entry points
; in upper case added to stub routines.
;
;*************************************************************************

        .TITLE libcurl_xfer - Transfer vector for libcurl
        .DISABLE GLOBAL

;
; Macro to generate a transfer vector entry
;
        .MACRO  PROCEDURE       NAME
        .EXTRN          'NAME
        .ALIGN  QUAD
        .TRANSFER       'NAME
        .MASK           'NAME
        JMP             'NAME+2
        .ENDM

        .MACRO  PROCEDUREU      NAME    NAMEU
        .EXTRN          'NAME
        .ALIGN  QUAD
        .TRANSFER       'NAMEU
        .MASK           'NAME
        JMP             'NAME+2

        .ENDM
;
;
; Macro to reserve a spare entry.
;
        .MACRO  SPARE
        .ALIGN QUAD
        .ALIGN QUAD
        .QUAD   0
        .ENDM

$EOD
$!
$!
$ return
$!
$all_exit:
$set def 'default_dir'
$exit '$status'