packages/vms/generate_vax_transfer.com

   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, 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'