git-svn-id: svn://10.65.10.50/branches/R_10_00@23289 c028cbd2-c16b-5b4b-a496-9718f37d4682
		
			
				
	
	
		
			275 lines
		
	
	
		
			8.1 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
			
		
		
	
	
			275 lines
		
	
	
		
			8.1 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
$! 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, 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 compatibilty 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'
 |