diff --git a/ChangeLog b/ChangeLog index e4a1026b6..7fcd67ee1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,7 +1,29 @@ +2003-05-21 Werner Lemberg + + * include/freetype/config/ftstdlib.h (ft_strcat): New wrapper macro + for strcat. + + * src/base/ftmac.c (create_lwfn_name): s/isupper/ft_isupper/. + (parse_font): s/memcpy/ft_memcpy/. + (is_dfont) [TARGET_API_MAC_CARBON]: s/memcmp/ft_memcmp/. + * src/base/ftobjs.c (load_mac_face) [FT_MACINTOSH]: + s/strlen/ft_strlen/. + s/strcat/ft_strcat/. + s/strcpy/ft_strcpy/. + * src/gzip/zutil.h: s/memset/ft_memset/. + s/memcmp/ft_memcmp/. + + * src/bdf/bdfdrivr.c (BDF_Face_Init), src/pcf/pcfdriver.c + (PCF_Face_Init): Test for charset registry case-insensitively. + 2003-05-21 Martin Zinser * t1load.c (parse_blend_axis_types): Fix compiler warning. + * descrip.mms: Removed. Now created by... + + * vms_make.com: New file. + 2003-05-21 Weiqi Gao * src/gzip/ftgzip.c (ft_gzip_file_io): Avoid zero value of `delta' diff --git a/descrip.mms b/descrip.mms deleted file mode 100644 index 069244337..000000000 --- a/descrip.mms +++ /dev/null @@ -1,73 +0,0 @@ -# -# FreeType 2 build system -- top-level Makefile for OpenVMS -# - - -# Copyright 2001 by -# David Turner, Robert Wilhelm, and Werner Lemberg. -# -# This file is part of the FreeType project, and may only be used, modified, -# and distributed under the terms of the FreeType project license, -# LICENSE.TXT. By continuing to use, modify, or distribute this file you -# indicate that you have read the license and understand and accept it -# fully. - - -all : - define freetype [--.include.freetype] - define psaux [-.psaux] - define autohint [-.autohint] - define base [-.base] - define cache [-.cache] - define cff [-.cff] - define cid [-.cid] - define pcf [-.pcf] - define psnames [-.psnames] - define raster [-.raster] - define sfnt [-.sfnt] - define smooth [-.smooth] - define truetype [-.truetype] - define type1 [-.type1] - define winfonts [-.winfonts] - if f$search("lib.dir") .eqs. "" then create/directory [.lib] - set default [.builds.vms] - $(MMS)$(MMSQUALIFIERS) - set default [--.src.autohint] - $(MMS)$(MMSQUALIFIERS) - set default [-.base] - $(MMS)$(MMSQUALIFIERS) - set default [-.bdf] - $(MMS)$(MMSQUALIFIERS) - set default [-.cache] - $(MMS)$(MMSQUALIFIERS) - set default [-.cff] - $(MMS)$(MMSQUALIFIERS) - set default [-.cid] - $(MMS)$(MMSQUALIFIERS) - set default [-.pcf] - $(MMS)$(MMSQUALIFIERS) - set default [-.pfr] - $(MMS)$(MMSQUALIFIERS) - set default [-.psaux] - $(MMS)$(MMSQUALIFIERS) - set default [-.pshinter] - $(MMS)$(MMSQUALIFIERS) - set default [-.psnames] - $(MMS)$(MMSQUALIFIERS) - set default [-.raster] - $(MMS)$(MMSQUALIFIERS) - set default [-.sfnt] - $(MMS)$(MMSQUALIFIERS) - set default [-.smooth] - $(MMS)$(MMSQUALIFIERS) - set default [-.truetype] - $(MMS)$(MMSQUALIFIERS) - set default [-.type1] - $(MMS)$(MMSQUALIFIERS) - set default [-.type42] - $(MMS)$(MMSQUALIFIERS) - set default [-.winfonts] - $(MMS)$(MMSQUALIFIERS) - set default [--] - -# EOF diff --git a/include/freetype/config/ftstdlib.h b/include/freetype/config/ftstdlib.h index 6c060912d..7868fd402 100644 --- a/include/freetype/config/ftstdlib.h +++ b/include/freetype/config/ftstdlib.h @@ -82,6 +82,7 @@ #include #define ft_strlen strlen +#define ft_strcat strcat #define ft_strcmp strcmp #define ft_strncmp strncmp #define ft_memcpy memcpy diff --git a/src/base/ftmac.c b/src/base/ftmac.c index ba018bcc9..cbc5072f3 100644 --- a/src/base/ftmac.c +++ b/src/base/ftmac.c @@ -149,8 +149,8 @@ int nameLen = spec->name[0]; - return nameLen >= 6 && - !memcmp( spec->name + nameLen - 5, ".dfont", 6 ); + return nameLen >= 6 && + !ft_memcmp( spec->name + nameLen - 5, ".dfont", 6 ); } #endif @@ -170,7 +170,7 @@ while ( *q ) { - if ( isupper( *q ) ) + if ( ft_isupper( *q ) ) { if ( count ) max = 3; @@ -309,7 +309,7 @@ if ( ps_name_len != 0 ) { - memcpy(ps_name, names[0] + 1, ps_name_len); + ft_memcpy(ps_name, names[0] + 1, ps_name_len); ps_name[ps_name_len] = 0; } if ( style->indexes[0] > 1 ) @@ -330,7 +330,7 @@ if ( s_len != 0 && ps_name_len + s_len < sizeof ( ps_name ) ) { - memcpy( ps_name + ps_name_len, s + 1, s_len ); + ft_memcpy( ps_name + ps_name_len, s + 1, s_len ); ps_name_len += s_len; ps_name[ps_name_len] = 0; } diff --git a/src/base/ftobjs.c b/src/base/ftobjs.c index f20fd4e86..78d98715d 100644 --- a/src/base/ftobjs.c +++ b/src/base/ftobjs.c @@ -1535,9 +1535,10 @@ memory = library->memory; - FT_ALLOC( newpath, strlen( args->pathname ) + strlen( "/rsrc" ) + 1 ); - strcpy( newpath, args->pathname ); - strcat( newpath, "/rsrc" ); + FT_ALLOC( newpath, + ft_strlen( args->pathname ) + ft_strlen( "/rsrc" ) + 1 ); + ft_strcpy( newpath, args->pathname ); + ft_strcat( newpath, "/rsrc" ); args2.flags = FT_OPEN_PATHNAME; args2.pathname = (char*)newpath; diff --git a/src/bdf/bdfdrivr.c b/src/bdf/bdfdrivr.c index 63c40021d..05c8faa18 100644 --- a/src/bdf/bdfdrivr.c +++ b/src/bdf/bdfdrivr.c @@ -381,18 +381,32 @@ THE SOFTWARE. ( charset_registry->value.atom != NULL ) && ( charset_encoding->value.atom != NULL ) ) { + const char* s; + + if ( FT_NEW_ARRAY( face->charset_encoding, strlen( charset_encoding->value.atom ) + 1 ) ) goto Exit; if ( FT_NEW_ARRAY( face->charset_registry, strlen( charset_registry->value.atom ) + 1 ) ) goto Exit; + ft_strcpy( face->charset_registry, charset_registry->value.atom ); ft_strcpy( face->charset_encoding, charset_encoding->value.atom ); - if ( !ft_strcmp( face->charset_registry, "ISO10646" ) || - ( !ft_strcmp( face->charset_registry, "ISO8859" ) && - !ft_strcmp( face->charset_encoding, "1" ) ) ) + + /* Uh, oh, compare first letters manually to avoid dependency + on locales. */ + s = face->charset_registry; + if ( ( s[0] == 'i' || s[0] == 'I' ) && + ( s[1] == 's' || s[1] == 'S' ) && + ( s[2] == 'o' || s[2] == 'O' ) ) + { + s += 3; + if ( !ft_strcmp( s, "10646" ) || + ( !ft_strcmp( s, "8859" ) && + !ft_strcmp( face->charset_encoding, "1" ) ) ) unicode_charmap = 1; + } { FT_CharMapRec charmap; diff --git a/src/gzip/zutil.h b/src/gzip/zutil.h index 2b26c5ce2..ce02022aa 100644 --- a/src/gzip/zutil.h +++ b/src/gzip/zutil.h @@ -173,8 +173,8 @@ typedef unsigned long ulg; # define zmemzero(dest, len) _fmemset(dest, 0, len) # else # define zmemcpy ft_memcpy -# define zmemcmp memcmp -# define zmemzero(dest, len) memset(dest, 0, len) +# define zmemcmp ft_memcmp +# define zmemzero(dest, len) ft_memset(dest, 0, len) # endif #else extern void zmemcpy OF((Bytef* dest, const Bytef* source, uInt len)); diff --git a/src/pcf/pcfdriver.c b/src/pcf/pcfdriver.c index 2d46c2037..e009ee83b 100644 --- a/src/pcf/pcfdriver.c +++ b/src/pcf/pcfdriver.c @@ -274,10 +274,21 @@ THE SOFTWARE. if ( ( charset_registry != NULL ) && ( charset_encoding != NULL ) ) { - if ( !ft_strcmp( face->charset_registry, "ISO10646" ) || - ( !ft_strcmp( face->charset_registry, "ISO8859" ) && - !ft_strcmp( face->charset_encoding, "1" ) ) ) + char* s = face->charset_registry; + + + /* Uh, oh, compare first letters manually to avoid dependency + on locales. */ + if ( ( s[0] == 'i' || s[0] == 'I' ) && + ( s[1] == 's' || s[1] == 'S' ) && + ( s[2] == 'o' || s[2] == 'O' ) ) + { + s += 3; + if ( !ft_strcmp( s, "10646" ) || + ( !ft_strcmp( s, "8859" ) && + !ft_strcmp( face->charset_encoding, "1" ) ) ) unicode_charmap = 1; + } } { diff --git a/vms_make.com b/vms_make.com new file mode 100644 index 000000000..e5ed9aa31 --- /dev/null +++ b/vms_make.com @@ -0,0 +1,444 @@ +$!---------------vms_make.com for Freetype2------------------------------------ +$! make Freetype2 under OpenVMS +$! +$! In case of problems with the build you might want to contact me at +$! zinser@decus.de (preferred) or zinser@sysdev.deutsche-boerse.com (Work) +$! +$! This procedure currently does support the following commandline options +$! in arbitrary order +$! +$! * DEBUG - Compile modules with /noopt/debug and link shareable image +$! with /debug +$! * LOPTS - Options to be passed to the link command +$! * CCOPT - Options to be passed to the C compiler +$!------------------------------------------------------------------------------ +$! +$! Just some general constants +$! +$ true = 1 +$ false = 0 +$ Make = "" +$! +$! Setup variables holding "config" information +$! +$ name = "Freetype2" +$ mapfile = name + ".map" +$ optfile = name + ".opt" +$ s_case = false +$ libdefs = "" +$ libincs = "" +$ liblist = "" +$ ccopt = "" +$ lopts = "" +$! +$! Check for MMK/MMS +$! +$ If F$Search ("Sys$System:MMS.EXE") .nes. "" Then Make = "MMS" +$ If F$Type (MMK) .eqs. "STRING" Then Make = "MMK" +$! +$! Which command parameters were given +$! +$ gosub check_opts +$! +$! Create option file +$! +$ open/write optf 'optfile' +$! +$! Pull in external libraries +$! +$ gosub check_create_vmslib +$! +$! Create objects +$! +$ if libdefs .nes. "" then ccopt = ccopt + "/define=(" + libdefs + ")" +$! +$ if f$locate("AS_IS",f$edit(ccopt,"UPCASE")) .lt. f$length(ccopt) - + then s_case = true +$ gosub crea_mms +$! +$ 'Make' /macro=(comp_flags="''ccopt'") +$ delete/nolog/noconf temp.mms;*,descrip.fdl;* +$ purge/nolog [...]descrip.mms +$! +$! Add them to options +$! +$FLOOP: +$ file = f$edit(f$search("[...]*.obj"),"UPCASE") +$ if (file .nes. "") +$ then +$ if f$locate("DEMOS",file) .eqs. f$length(file) then write optf file +$ goto floop +$ endif +$! +$! Pull in external libraries +$! +$ gosub check_create_vmslib +$! +$ if s_case then WRITE optf "case_sensitive=YES" +$ close optf +$! +$! +$! Alpha gets a shareable image +$! +$ If f$getsyi("HW_MODEL") .gt. 1024 +$ Then +$ LINK_/NODEB/NOSHARE/NOEXE/MAP='mapfile'/full 'optfile'/opt +$ call anal_map_axp 'mapfile' _link.opt +$ LINK_/NODEB/SHARE=[.lib]freetype2shr.exe 'optfile'/opt,_link.opt/opt +$ dele/noconf 'mapfile';* +$ endif +$! +$ exit +$! +$!------------------------------------------------------------------------------ +$! +$! If MMS/MMK are available dump out the descrip.mms if required +$! +$CREA_MMS: +$ write sys$output "Creating descrip.mms files ..." +$ write sys$output "... Main directory" +$ copy sys$input: descrip.mms +$ deck +# +# FreeType 2 build system -- top-level Makefile for OpenVMS +# + + +# Copyright 2001 by +# David Turner, Robert Wilhelm, and Werner Lemberg. +# +# This file is part of the FreeType project, and may only be used, modified, +# and distributed under the terms of the FreeType project license, +# LICENSE.TXT. By continuing to use, modify, or distribute this file you +# indicate that you have read the license and understand and accept it +# fully. + + +all : + define freetype [--.include.freetype] + define psaux [-.psaux] + define autohint [-.autohint] + define base [-.base] + define cache [-.cache] + define cff [-.cff] + define cid [-.cid] + define pcf [-.pcf] + define psnames [-.psnames] + define raster [-.raster] + define sfnt [-.sfnt] + define smooth [-.smooth] + define truetype [-.truetype] + define type1 [-.type1] + define winfonts [-.winfonts] + if f$search("lib.dir") .eqs. "" then create/directory [.lib] + set default [.builds.vms] + $(MMS)$(MMSQUALIFIERS) + set default [--.src.autohint] + $(MMS)$(MMSQUALIFIERS) + set default [-.base] + $(MMS)$(MMSQUALIFIERS) + set default [-.bdf] + $(MMS)$(MMSQUALIFIERS) + set default [-.cache] + $(MMS)$(MMSQUALIFIERS) + set default [-.cff] + $(MMS)$(MMSQUALIFIERS) + set default [-.cid] + $(MMS)$(MMSQUALIFIERS) + set default [-.gzip] + $(MMS)$(MMSQUALIFIERS) + set default [-.pcf] + $(MMS)$(MMSQUALIFIERS) + set default [-.pfr] + $(MMS)$(MMSQUALIFIERS) + set default [-.psaux] + $(MMS)$(MMSQUALIFIERS) + set default [-.pshinter] + $(MMS)$(MMSQUALIFIERS) + set default [-.psnames] + $(MMS)$(MMSQUALIFIERS) + set default [-.raster] + $(MMS)$(MMSQUALIFIERS) + set default [-.sfnt] + $(MMS)$(MMSQUALIFIERS) + set default [-.smooth] + $(MMS)$(MMSQUALIFIERS) + set default [-.truetype] + $(MMS)$(MMSQUALIFIERS) + set default [-.type1] + $(MMS)$(MMSQUALIFIERS) + set default [-.type42] + $(MMS)$(MMSQUALIFIERS) + set default [-.winfonts] + $(MMS)$(MMSQUALIFIERS) + set default [--] + +# EOF +$ eod +$ anal/rms/fdl descrip.mms +$ create/fdl=descrip.fdl temp.mms +$ open/append mmsf temp.mms +$ write mmsf "CFLAGS = ", ccopt +$ close mmsf +$ copy temp.mms,descrip.mms;-1 descrip.mms +$ write sys$output "... [.src.gzip] directory" +$ copy sys$input: [.src.gzip]descrip.mms +$ deck +# +# FreeType 2 GZip support compilation rules for VMS +# + + +# Copyright 2002 by +# David Turner, Robert Wilhelm, and Werner Lemberg. +# +# This file is part of the FreeType project, and may only be used, modified, +# and distributed under the terms of the FreeType project license, +# LICENSE.TXT. By continuing to use, modify, or distribute this file you +# indicate that you have read the license and understand and accept it +# fully. + + +CFLAGS=$(COMP_FLAGS)$(DEBUG)/include=($(LIBINCS)[--.include],[--.src.gzip]) + +OBJS=ftgzip.obj + +all : $(OBJS) + library [--.lib]freetype.olb $(OBJS) + +# EOF +$ eod +$ create/fdl=descrip.fdl temp.mms +$ if libincs .nes. "" +$ then +$ open/append mmsf temp.mms +$ write mmsf "LIBINCS = ", libincs, "," +$ close mmsf +$ copy temp.mms,[.src.gzip]descrip.mms;-1 [.src.gzip]descrip.mms +$ endif +$ return +$!------------------------------------------------------------------------------ +$! +$! Check command line options and set symbols accordingly +$! +$ CHECK_OPTS: +$ i = 1 +$ OPT_LOOP: +$ if i .lt. 9 +$ then +$ cparm = f$edit(p'i',"upcase") +$ if cparm .eqs. "DEBUG" +$ then +$ ccopt = ccopt + "/noopt/deb" +$ lopts = lopts + "/deb" +$ endif +$! if cparm .eqs. "LINK" then linkonly = true +$ if f$locate("LOPTS",cparm) .lt. f$length(cparm) +$ then +$ start = f$locate("=",cparm) + 1 +$ len = f$length(cparm) - start +$ lopts = lopts + f$extract(start,len,cparm) +$ endif +$ if f$locate("CCOPT",cparm) .lt. f$length(cparm) +$ then +$ start = f$locate("=",cparm) + 1 +$ len = f$length(cparm) - start +$ ccopt = ccopt + f$extract(start,len,cparm) +$ endif +$ i = i + 1 +$ goto opt_loop +$ endif +$ return +$!------------------------------------------------------------------------------ +$! +$! Take care of driver file with information about external libraries +$! +$CHECK_CREATE_VMSLIB: +$! +$ if f$search("VMSLIB.DAT") .eqs. "" +$ then +$ type/out=vmslib.dat sys$input +! +! This is a simple driver file with information used by make.com to +! check if external libraries (like t1lib and freetype) are available on +! the system. +! +! Layout of the file: +! +! - Lines starting with ! are treated as comments +! - Elements in a data line are separated by # signs +! - The elements need to be listed in the following order +! 1.) Name of the Library +! 2.) Location where the object library can be found +! 3.) Location where the include files for the library can be found +! 4.) Include file used to verify library location +! 5.) CPP define to pass to the build to indicate availability of +! the library +! +! Example: The following lines show how definitions +! might look like. They are site specific and the locations of the +! library and include files need almost certainly to be changed. +! +! Location: All of the libaries can be found at the following addresses +! +! ZLIB: http://www.decus.de:8080/www/vms/sw/zlib.htmlx +! +!ZLIB # pubbin:libz.olb # public$Root:[util.libs.zlib] # zlib.h # FT_CONFIG_OPTION_SYSTEM_ZLIB +$ write sys$output "New driver file vmslib.dat created." +$ write sys$output "Please customize libary locations for your site" +$ write sys$output "and afterwards re-execute vms_make.com" +$ write sys$output "Exiting..." +$ close/nolog optf +$ exit +$ endif +$! +$! Open data file with location of libraries +$! +$ open/read/end=end_lib/err=lib_err libdata VMSLIB.DAT +$LIB_LOOP: +$ read/end=end_lib libdata libline +$ libline = f$edit(libline, "UNCOMMENT,COLLAPSE") +$ if libline .eqs. "" then goto LIB_LOOP ! Comment line +$ libname = f$edit(f$element(0,"#",libline),"UPCASE") +$ liblist = liblist + "#" + libname +$ write sys$output "Processing ''libname' setup ..." +$ libloc = f$element(1,"#",libline) +$ libsrc = f$element(2,"#",libline) +$ testinc = f$element(3,"#",libline) +$ cppdef = f$element(4,"#",libline) +$ old_cpp = f$locate("=1",cppdef) +$ if old_cpp.lt.f$length(cppdef) then cppdef = f$extract(0,old_cpp,cppdef) +$ if f$search("''libloc'").eqs. "" +$ then +$ write sys$output "Can not find library ''libloc' - Skipping ''libname'" +$ goto LIB_LOOP +$ endif +$ libsrc_elem = 0 +$ libsrc_found = false +$LIBSRC_LOOP: +$ libsrcdir = f$element(libsrc_elem,",",libsrc) +$ if (libsrcdir .eqs. ",") then goto END_LIBSRC +$ if f$search("''libsrcdir'''testinc'") .nes. "" then libsrc_found = true +$ libsrc_elem = libsrc_elem + 1 +$ goto LIBSRC_LOOP +$END_LIBSRC: +$ if .not. libsrc_found +$ then +$ write sys$output "Can not find includes at ''libsrc' - Skipping ''libname'" +$ goto LIB_LOOP +$ endif +$ if cppdef .nes. "" then libdefs = libdefs + "," + cppdef +$ libincs = libincs + "," + libsrc +$ lqual = "/lib" +$ libtype = f$parse(libloc,,,"TYPE") +$ if f$locate("EXE",libtype) .lt. f$length(libtype) then lqual = "/share" +$ write optf libloc , lqual +$! +$! Yet another special treatment for Xpm/X11 +$! +$ if (libname .eqs. "XPM") +$ then +$ my_x11 = f$parse("''libsrc'xpm.h",,,"device") + - + f$parse("''libsrc'xpm.h",,,"directory") +$ x11_save = f$trnlnm("X11") +$ define x11 'my_x11',decw$include +$ endif +$ goto LIB_LOOP +$END_LIB: +$ close libdata +$ libincs = libincs - "," +$ libdefs = libdefs - "," +$ return +$!------------------------------------------------------------------------------$$!------------------------------------------------------------------------------ +$! +$! Analyze Map for OpenVMS AXP +$! +$ ANAL_MAP_AXP: Subroutine +$ V = 'F$Verify(0) +$ SET SYMBOL/GENERAL/SCOPE=(NOLOCAL,NOGLOBAL) +$ SAY := "WRITE_ SYS$OUTPUT" +$ +$ IF F$SEARCH("''P1'") .EQS. "" +$ THEN +$ SAY " ANAL_MAP_AXP: Error, no mapfile provided" +$ goto exit_aa +$ ENDIF +$ IF "''P2'" .EQS. "" +$ THEN +$ SAY " ANALYZE_MAP_AXP: Error, no output file provided" +$ goto exit_aa +$ ENDIF +$ +$ LINK_TMP = F$PARSE(P2,,,"DEVICE")+F$PARSE(P2,,,"DIRECTORY")+F$PARSE(P2,,,"NAME")+".TMP" +$ +$ SAY " creating PSECT list in ''P2'" +$ OPEN_/READ IN 'P1' +$ OPEN_/WRITE OUT 'P2' +$ WRITE_ OUT "!" +$ WRITE_ OUT "! ### PSECT list extracted from ''P1'" +$ WRITE_ OUT "!" +$ LOOP_PSECT_SEARCH: +$ READ_/END=EOF_PSECT IN REC +$ if F$EXTRACT(0,5,REC) .nes. "$DATA" then goto LOOP_PSECT_SEARCH +$ LAST = "" +$ LOOP_PSECT: +$ READ_/END=EOF_PSECT IN REC +$ if F$EXTRACT(0,1,REC) .eqs. "$" .and. F$EXTRACT(0,5,REC) .nes. "$DATA" then goto EOF_PSECT +$ if REC - "NOPIC,OVR,REL,GBL,NOSHR,NOEXE, WRT,NOVEC" .nes. REC +$ then +$ J = F$LOCATE(" ",REC) +$ S = F$EXTRACT(0,J,REC) +$ IF S .EQS. LAST THEN GOTO LOOP_PSECT +$ WRITE_ OUT "symbol_vector = (" + S + " = PSECT)" +$ P$_'S= 1 +$ LAST = S +$ endif +$ GOTO LOOP_PSECT +$ +$ EOF_PSECT: +$ CLOSE_ IN +$ CLOSE_ OUT +$! +$ OPEN_/READ IN 'P1' +$ OPEN_/APPEND OUT 'P2' +$ WRITE_ OUT "!" +$ WRITE_ OUT "! ### Global definition list extracted from ''P1'" +$ WRITE_ OUT "!" +$ LOOP_DATA_SEARCH: +$ READ_/END=EOF_DATA IN REC +$ if f$locate("NOPIC,OVR,REL,GBL,NOSHR,NOEXE",rec) .eq. f$length(rec) - + then goto LOOP_DATA_SEARCH +$ s = f$element(0," ",rec) +$! write_ out "symbol_vector = (" + s + " = DATA)" +$ p$_'s' =1 +$ goto loop_data_search +$ EOF_DATA: +$ CLOSE_ IN +$ CLOSE_ OUT +$ SAY " appending list of UNIVERSAL procedures to ''P2'" +$ SEARCH_/NOHIGH/WINDOW=(0,0) 'P1' " R-"/OUT='LINK_TMP +$ OPEN_/READ IN 'LINK_TMP +$ OPEN_/APPEND OUT 'P2' +$ WRITE_ OUT "!" +$ WRITE_ OUT "! ### UNIVERSAL procedures and global definitions extracted from ''P1'" +$ WRITE_ OUT "!" +$ LOOP_UNIVERSAL: +$ READ_/END=EOF_UNIVERSAL IN REC +$ data = 0 +$ J = F$LOCATE(" R-",REC) +$ S = F$EXTRACT(J+3,F$length(rec),REC) +$ IF (F$TYPE(P$_'S').EQS."").and.(data.ne.1) +$ THEN +$ WRITE_ OUT "symbol_vector = ("+S+" = PROCEDURE)" +$ ELSE +$ WRITE_ OUT "symbol_vector = ("+S+" = DATA)" +$ ENDIF +$ GOTO LOOP_UNIVERSAL +$ EOF_UNIVERSAL: +$ CLOSE_ IN +$ CLOSE_ OUT +$ if f$search("''LINK_TMP'") .nes. "" then DELETE_/NOLOG/NOCONFIRM 'LINK_TMP';* +$ +$ EXIT_AA: +$ if V then set verify +$ endsubroutine