Changeset fb25694c in rtems


Ignore:
Timestamp:
Mar 18, 2011, 10:11:25 AM (9 years ago)
Author:
Ralf Corsepius <ralf.corsepius@…>
Branches:
4.11, master
Children:
f82036a5
Parents:
8158421
Message:

Import from zlib-1.2.4

File:
1 edited

Legend:

Unmodified
Added
Removed
  • cpukit/zlib/make_vms.com

    r8158421 rfb25694c  
    11$! make libz under VMS written by
    22$! Martin P.J. Zinser
    3 $! <zinser@zinser.no-ip.info or zinser@sysdev.deutsche-boerse.com>
     3$!
     4$! In case of problems with the install you might contact me at
     5$! zinser@zinser.no-ip.info(preferred) or
     6$! zinser@sysdev.deutsche-boerse.com (work)
     7$!
     8$! Make procedure history for Zlib
     9$!
     10$!------------------------------------------------------------------------------
     11$! Version history
     12$! 0.01 20060120 First version to receive a number
     13$! 0.02 20061008 Adapt to new Makefile.in
     14$! 0.03 20091224 Add support for large file check
     15$! 0.04 20100110 Add new gzclose, gzlib, gzread, gzwrite
     16$! 0.05 20100221 Exchange zlibdefs.h by zconf.h.in
    417$!
    518$ on error then goto err_exit
    6 $!
    7 $!
    8 $! Just some general constants...
     19$ set proc/parse=ext
    920$!
    1021$ true  = 1
    1122$ false = 0
    1223$ tmpnam = "temp_" + f$getjpi("","pid")
    13 $ SAY = "WRITE SYS$OUTPUT"
     24$ tt = tmpnam + ".txt"
     25$ tc = tmpnam + ".c"
     26$ th = tmpnam + ".h"
     27$ define/nolog tconfig 'th'
     28$ its_decc = false
     29$ its_vaxc = false
     30$ its_gnuc = false
     31$ s_case   = False
    1432$!
    1533$! Setup variables holding "config" information
    1634$!
    17 $ Make     = ""
     35$ Make    = ""
    1836$ name     = "Zlib"
    1937$ version  = "?.?.?"
    2038$ v_string = "ZLIB_VERSION"
    2139$ v_file   = "zlib.h"
    22 $ ccopt    = ""
    23 $ lopts    = ""
     40$ ccopt   = ""
     41$ lopts   = ""
     42$ dnsrl   = ""
     43$ aconf_in_file = "zconf.h.in#zconf.h_in"
     44$ conf_check_string = ""
    2445$ linkonly = false
    2546$ optfile  = name + ".opt"
    26 $ its_decc = false
    27 $ its_vaxc = false
    28 $ its_gnuc = false
    29 $ axp      = f$getsyi("HW_MODEL").ge.1024
    30 $ s_case   = false
     47$ libdefs  = ""
     48$ axp      = f$getsyi("HW_MODEL").ge.1024 .and. f$getsyi("HW_MODEL").lt.4096
     49$!
     50$ whoami = f$parse(f$enviornment("Procedure"),,,,"NO_CONCEAL")
     51$ mydef  = F$parse(whoami,,,"DEVICE")
     52$ mydir  = f$parse(whoami,,,"DIRECTORY") - "]["
     53$ myproc = f$parse(whoami,,,"Name") + f$parse(whoami,,,"type")
     54$!
    3155$! Check for MMK/MMS
    3256$!
     
    3761$ gosub find_version
    3862$!
     63$  open/write topt tmp.opt
     64$  open/write optf 'optfile'
     65$!
    3966$ gosub check_opts
    4067$!
     
    4269$!
    4370$ gosub check_compiler
     71$ close topt
     72$!
    4473$ if its_decc
    4574$ then
     
    6190$ endif
    6291$!
     92$! Build a fake configure input header
     93$!
     94$ open/write conf_hin config.hin
     95$ write conf_hin "#undef _LARGEFILE64_SOURCE"
     96$ close conf_hin
     97$!
     98$!
     99$ i = 0
     100$FIND_ACONF:
     101$ fname = f$element(i,"#",aconf_in_file)
     102$ if fname .eqs. "#" then goto AMISS_ERR
     103$ if f$search(fname) .eqs. ""
     104$ then
     105$   i = i + 1
     106$   goto find_aconf
     107$ endif
     108$ open/read/err=aconf_err aconf_in 'fname'
     109$ open/write aconf zconf.h
     110$ACONF_LOOP:
     111$ read/end_of_file=aconf_exit aconf_in line
     112$ work = f$edit(line, "compress,trim")
     113$ if f$extract(0,6,work) .nes. "#undef"
     114$ then
     115$   if f$extract(0,12,work) .nes. "#cmakedefine"
     116$   then
     117$       write aconf line
     118$   endif
     119$ else
     120$   cdef = f$element(1," ",work)
     121$   gosub check_config
     122$ endif
     123$ goto aconf_loop
     124$ACONF_EXIT:
     125$ write aconf "#define VMS 1"
     126$ write aconf "#include <unistd.h>"
     127$ write aconf "#include <unixio.h>"
     128$ write aconf "#ifdef _LARGEFILE"
     129$ write aconf "#define off64_t __off64_t"
     130$ write aconf "#define fopen64 fopen"
     131$ write aconf "#define fseeko64 fseeko"
     132$ write aconf "#define lseek64 lseek"
     133$ write aconf "#define ftello64 ftell"
     134$ write aconf "#endif"
     135$ close aconf_in
     136$ close aconf
     137$ if f$search("''th'") .nes. "" then delete 'th';*
    63138$! Build the thing plain or with mms
    64139$!
     
    75150$   CALL MAKE deflate.OBJ "CC ''CCOPT' deflate" -
    76151                deflate.c deflate.h zutil.h zlib.h zconf.h
    77 $   CALL MAKE gzio.OBJ "CC ''CCOPT' gzio" -
    78                 gzio.c zutil.h zlib.h zconf.h
     152$   CALL MAKE gzclose.OBJ "CC ''CCOPT' gzclose" -
     153                gzclose.c zutil.h zlib.h zconf.h
     154$   CALL MAKE gzlib.OBJ "CC ''CCOPT' gzlib" -
     155                gzlib.c zutil.h zlib.h zconf.h
     156$   CALL MAKE gzread.OBJ "CC ''CCOPT' gzread" -
     157                gzread.c zutil.h zlib.h zconf.h
     158$   CALL MAKE gzwrite.OBJ "CC ''CCOPT' gzwrite" -
     159                gzwrite.c zutil.h zlib.h zconf.h
    79160$   CALL MAKE infback.OBJ "CC ''CCOPT' infback" -
    80161                infback.c zutil.h inftrees.h inflate.h inffast.h inffixed.h
     
    108189$  else
    109190$   gosub crea_mms
    110 $   SAY "Make ''name' ''version' with ''Make' "
     191$   write sys$output "Make ''name' ''version' with ''Make' "
    111192$   'make'
    112193$  endif
     
    134215$ERR_EXIT:
    135216$ set message/facil/ident/sever/text
     217$ close/nolog optf
     218$ close/nolog topt
     219$ close/nolog conf_hin
     220$ close/nolog aconf_in
     221$ close/nolog aconf
     222$ close/nolog out
     223$ close/nolog min
     224$ close/nolog mod
     225$ close/nolog h_in
    136226$ write sys$output "Exiting..."
    137227$ exit 2
     
    181271$! Check command line options and set symbols accordingly
    182272$!
     273$!------------------------------------------------------------------------------
     274$! Version history
     275$! 0.01 20041206 First version to receive a number
     276$! 0.02 20060126 Add new "HELP" target
    183277$ CHECK_OPTS:
    184278$ i = 1
     
    187281$ then
    188282$   cparm = f$edit(p'i',"upcase")
    189 $   if cparm .eqs. "DEBUG"
    190 $   then
    191 $     ccopt = ccopt + "/noopt/deb"
    192 $     lopts = lopts + "/deb"
    193 $   endif
    194 $   if f$locate("CCOPT=",cparm) .lt. f$length(cparm)
    195 $   then
    196 $     start = f$locate("=",cparm) + 1
    197 $     len   = f$length(cparm) - start
    198 $     ccopt = ccopt + f$extract(start,len,cparm)
    199 $     if f$locate("AS_IS",f$edit(ccopt,"UPCASE")) .lt. f$length(ccopt) -
    200          then s_case = true
    201 $   endif
    202 $   if cparm .eqs. "LINK" then linkonly = true
    203 $   if f$locate("LOPTS=",cparm) .lt. f$length(cparm)
    204 $   then
    205 $     start = f$locate("=",cparm) + 1
    206 $     len   = f$length(cparm) - start
    207 $     lopts = lopts + f$extract(start,len,cparm)
    208 $   endif
    209 $   if f$locate("CC=",cparm) .lt. f$length(cparm)
    210 $   then
    211 $     start  = f$locate("=",cparm) + 1
    212 $     len    = f$length(cparm) - start
    213 $     cc_com = f$extract(start,len,cparm)
    214       if (cc_com .nes. "DECC") .and. -
    215          (cc_com .nes. "VAXC") .and. -
    216          (cc_com .nes. "GNUC")
    217 $     then
    218 $       write sys$output "Unsupported compiler choice ''cc_com' ignored"
    219 $       write sys$output "Use DECC, VAXC, or GNUC instead"
    220 $     else
    221 $       if cc_com .eqs. "DECC" then its_decc = true
    222 $       if cc_com .eqs. "VAXC" then its_vaxc = true
    223 $       if cc_com .eqs. "GNUC" then its_gnuc = true
    224 $     endif
    225 $   endif
    226 $   if f$locate("MAKE=",cparm) .lt. f$length(cparm)
    227 $   then
    228 $     start  = f$locate("=",cparm) + 1
    229 $     len    = f$length(cparm) - start
    230 $     mmks = f$extract(start,len,cparm)
    231 $     if (mmks .eqs. "MMK") .or. (mmks .eqs. "MMS")
    232 $     then
    233 $       make = mmks
    234 $     else
    235 $       write sys$output "Unsupported make choice ''mmks' ignored"
    236 $       write sys$output "Use MMK or MMS instead"
    237 $     endif
     283$!
     284$! Check if parameter actually contains something
     285$!
     286$   if f$edit(cparm,"trim") .nes. ""
     287$   then
     288$     if cparm .eqs. "DEBUG"
     289$     then
     290$       ccopt = ccopt + "/noopt/deb"
     291$       lopts = lopts + "/deb"
     292$     endif
     293$     if f$locate("CCOPT=",cparm) .lt. f$length(cparm)
     294$     then
     295$       start = f$locate("=",cparm) + 1
     296$       len   = f$length(cparm) - start
     297$       ccopt = ccopt + f$extract(start,len,cparm)
     298$       if f$locate("AS_IS",f$edit(ccopt,"UPCASE")) .lt. f$length(ccopt) -
     299          then s_case = true
     300$     endif
     301$     if cparm .eqs. "LINK" then linkonly = true
     302$     if f$locate("LOPTS=",cparm) .lt. f$length(cparm)
     303$     then
     304$       start = f$locate("=",cparm) + 1
     305$       len   = f$length(cparm) - start
     306$       lopts = lopts + f$extract(start,len,cparm)
     307$     endif
     308$     if f$locate("CC=",cparm) .lt. f$length(cparm)
     309$     then
     310$       start  = f$locate("=",cparm) + 1
     311$       len    = f$length(cparm) - start
     312$       cc_com = f$extract(start,len,cparm)
     313        if (cc_com .nes. "DECC") .and. -
     314           (cc_com .nes. "VAXC") .and. -
     315           (cc_com .nes. "GNUC")
     316$       then
     317$         write sys$output "Unsupported compiler choice ''cc_com' ignored"
     318$         write sys$output "Use DECC, VAXC, or GNUC instead"
     319$       else
     320$         if cc_com .eqs. "DECC" then its_decc = true
     321$         if cc_com .eqs. "VAXC" then its_vaxc = true
     322$         if cc_com .eqs. "GNUC" then its_gnuc = true
     323$       endif
     324$     endif
     325$     if f$locate("MAKE=",cparm) .lt. f$length(cparm)
     326$     then
     327$       start  = f$locate("=",cparm) + 1
     328$       len    = f$length(cparm) - start
     329$       mmks = f$extract(start,len,cparm)
     330$       if (mmks .eqs. "MMK") .or. (mmks .eqs. "MMS")
     331$       then
     332$         make = mmks
     333$       else
     334$         write sys$output "Unsupported make choice ''mmks' ignored"
     335$         write sys$output "Use MMK or MMS instead"
     336$       endif
     337$     endif
     338$     if cparm .eqs. "HELP" then gosub bhelp
    238339$   endif
    239340$   i = i + 1
     
    245346$! Look for the compiler used
    246347$!
     348$! Version history
     349$! 0.01 20040223 First version to receive a number
     350$! 0.02 20040229 Save/set value of decc$no_rooted_search_lists
     351$! 0.03 20060202 Extend handling of GNU C
     352$! 0.04 20090402 Compaq -> hp
    247353$CHECK_COMPILER:
    248354$ if (.not. (its_decc .or. its_vaxc .or. its_gnuc))
     
    258364$ then goto CC_ERR
    259365$ else
    260 $   if its_decc then write sys$output "CC compiler check ... Compaq C"
    261 $   if its_vaxc then write sys$output "CC compiler check ... VAX C"
    262 $   if its_gnuc then write sys$output "CC compiler check ... GNU C"
     366$   if its_decc
     367$   then
     368$     write sys$output "CC compiler check ... hp C"
     369$     if f$trnlnm("decc$no_rooted_search_lists") .nes. ""
     370$     then
     371$       dnrsl = f$trnlnm("decc$no_rooted_search_lists")
     372$     endif
     373$     define/nolog decc$no_rooted_search_lists 1
     374$   else
     375$     if its_vaxc then write sys$output "CC compiler check ... VAX C"
     376$     if its_gnuc
     377$     then
     378$         write sys$output "CC compiler check ... GNU C"
     379$         if f$trnlnm(topt) then write topt "gnu_cc:[000000]gcclib.olb/lib"
     380$         if f$trnlnm(optf) then write optf "gnu_cc:[000000]gcclib.olb/lib"
     381$         cc = "gcc"
     382$     endif
     383$     if f$trnlnm(topt) then write topt "sys$share:vaxcrtl.exe/share"
     384$     if f$trnlnm(optf) then write optf "sys$share:vaxcrtl.exe/share"
     385$   endif
    263386$ endif
    264387$ return
     
    277400# <zinser@zinser.no-ip.info or zinser@sysdev.deutsche-boerse.com>
    278401
    279 OBJS = adler32.obj, compress.obj, crc32.obj, gzio.obj, uncompr.obj, infback.obj\
     402OBJS = adler32.obj, compress.obj, crc32.obj, gzclose.obj, gzlib.obj\
     403       gzread.obj, gzwrite.obj, uncompr.obj, infback.obj\
    280404       deflate.obj, trees.obj, zutil.obj, inflate.obj, \
    281405       inftrees.obj, inffast.obj
     
    309433deflate.obj  : deflate.c deflate.h zutil.h zlib.h zconf.h
    310434example.obj  : example.c zlib.h zconf.h
    311 gzio.obj     : gzio.c zutil.h zlib.h zconf.h
     435gzclose.obj  : gzclose.c zutil.h zlib.h zconf.h
     436gzlib.obj    : gzlib.c zutil.h zlib.h zconf.h
     437gzread.obj   : gzread.c zutil.h zlib.h zconf.h
     438gzwrite.obj  : gzwrite.c zutil.h zlib.h zconf.h
    312439inffast.obj  : inffast.c zutil.h zlib.h zconf.h inftrees.h inffast.h
    313440inflate.obj  : inflate.c zutil.h zlib.h zconf.h
     
    329456$ open/read min makefile.in
    330457$ open/write mod modules.opt
    331 $ src_check = "OBJS ="
     458$ src_check = "OBJC ="
    332459$MRLOOP:
    333460$ read/end=mrdone min rec
     
    383510$!------------------------------------------------------------------------------
    384511$!
     512$CHECK_CONFIG:
     513$!
     514$ in_ldef = f$locate(cdef,libdefs)
     515$ if (in_ldef .lt. f$length(libdefs))
     516$ then
     517$   write aconf "#define ''cdef' 1"
     518$   libdefs = f$extract(0,in_ldef,libdefs) + -
     519              f$extract(in_ldef + f$length(cdef) + 1, -
     520                        f$length(libdefs) - in_ldef - f$length(cdef) - 1, -
     521                        libdefs)
     522$ else
     523$   if (f$type('cdef') .eqs. "INTEGER")
     524$   then
     525$     write aconf "#define ''cdef' ", 'cdef'
     526$   else
     527$     if (f$type('cdef') .eqs. "STRING")
     528$     then
     529$       write aconf "#define ''cdef' ", """", '''cdef'', """"
     530$     else
     531$       gosub check_cc_def
     532$     endif
     533$   endif
     534$ endif
     535$ return
     536$!------------------------------------------------------------------------------
     537$!
     538$! Check if this is a define relating to the properties of the C/C++
     539$! compiler
     540$!
     541$ CHECK_CC_DEF:
     542$ if (cdef .eqs. "_LARGEFILE64_SOURCE")
     543$ then
     544$   copy sys$input: 'tc'
     545$   deck
     546#include "tconfig"
     547#define _LARGEFILE
     548#include <stdio.h>
     549
     550int main(){
     551FILE *fp;
     552  fp = fopen("temp.txt","r");
     553  fseeko(fp,1,SEEK_SET);
     554  fclose(fp);
     555}
     556
     557$   eod
     558$   test_inv = false
     559$   comm_h = false
     560$   gosub cc_prop_check
     561$   return
     562$ endif
     563$ write aconf "/* ", line, " */"
     564$ return
     565$!------------------------------------------------------------------------------
     566$!
     567$! Check for properties of C/C++ compiler
     568$!
     569$! Version history
     570$! 0.01 20031020 First version to receive a number
     571$! 0.02 20031022 Added logic for defines with value
     572$! 0.03 20040309 Make sure local config file gets not deleted
     573$! 0.04 20041230 Also write include for configure run
     574$! 0.05 20050103 Add processing of "comment defines"
     575$CC_PROP_CHECK:
     576$ cc_prop = true
     577$ is_need = false
     578$ is_need = (f$extract(0,4,cdef) .eqs. "NEED") .or. (test_inv .eq. true)
     579$ if f$search(th) .eqs. "" then create 'th'
     580$ set message/nofac/noident/nosever/notext
     581$ on error then continue
     582$ cc 'tmpnam'
     583$ if .not. ($status)  then cc_prop = false
     584$ on error then continue
     585$! The headers might lie about the capabilities of the RTL
     586$ link 'tmpnam',tmp.opt/opt
     587$ if .not. ($status)  then cc_prop = false
     588$ set message/fac/ident/sever/text
     589$ on error then goto err_exit
     590$ delete/nolog 'tmpnam'.*;*/exclude='th'
     591$ if (cc_prop .and. .not. is_need) .or. -
     592     (.not. cc_prop .and. is_need)
     593$ then
     594$   write sys$output "Checking for ''cdef'... yes"
     595$   if f$type('cdef_val'_yes) .nes. ""
     596$   then
     597$     if f$type('cdef_val'_yes) .eqs. "INTEGER" -
     598         then call write_config f$fao("#define !AS !UL",cdef,'cdef_val'_yes)
     599$     if f$type('cdef_val'_yes) .eqs. "STRING" -
     600         then call write_config f$fao("#define !AS !AS",cdef,'cdef_val'_yes)
     601$   else
     602$     call write_config f$fao("#define !AS 1",cdef)
     603$   endif
     604$   if (cdef .eqs. "HAVE_FSEEKO") .or. (cdef .eqs. "_LARGE_FILES") .or. -
     605       (cdef .eqs. "_LARGEFILE64_SOURCE") then -
     606      call write_config f$string("#define _LARGEFILE 1")
     607$ else
     608$   write sys$output "Checking for ''cdef'... no"
     609$   if (comm_h)
     610$   then
     611      call write_config f$fao("/* !AS */",line)
     612$   else
     613$     if f$type('cdef_val'_no) .nes. ""
     614$     then
     615$       if f$type('cdef_val'_no) .eqs. "INTEGER" -
     616           then call write_config f$fao("#define !AS !UL",cdef,'cdef_val'_no)
     617$       if f$type('cdef_val'_no) .eqs. "STRING" -
     618           then call write_config f$fao("#define !AS !AS",cdef,'cdef_val'_no)
     619$     else
     620$       call write_config f$fao("#undef !AS",cdef)
     621$     endif
     622$   endif
     623$ endif
     624$ return
     625$!------------------------------------------------------------------------------
     626$!
     627$! Check for properties of C/C++ compiler with multiple result values
     628$!
     629$! Version history
     630$! 0.01 20040127 First version
     631$! 0.02 20050103 Reconcile changes from cc_prop up to version 0.05
     632$CC_MPROP_CHECK:
     633$ cc_prop = true
     634$ i    = 1
     635$ idel = 1
     636$ MT_LOOP:
     637$ if f$type(result_'i') .eqs. "STRING"
     638$ then
     639$   set message/nofac/noident/nosever/notext
     640$   on error then continue
     641$   cc 'tmpnam'_'i'
     642$   if .not. ($status)  then cc_prop = false
     643$   on error then continue
     644$! The headers might lie about the capabilities of the RTL
     645$   link 'tmpnam'_'i',tmp.opt/opt
     646$   if .not. ($status)  then cc_prop = false
     647$   set message/fac/ident/sever/text
     648$   on error then goto err_exit
     649$   delete/nolog 'tmpnam'_'i'.*;*
     650$   if (cc_prop)
     651$   then
     652$     write sys$output "Checking for ''cdef'... ", mdef_'i'
     653$     if f$type(mdef_'i') .eqs. "INTEGER" -
     654         then call write_config f$fao("#define !AS !UL",cdef,mdef_'i')
     655$     if f$type('cdef_val'_yes) .eqs. "STRING" -
     656         then call write_config f$fao("#define !AS !AS",cdef,mdef_'i')
     657$     goto msym_clean
     658$   else
     659$     i = i + 1
     660$     goto mt_loop
     661$   endif
     662$ endif
     663$ write sys$output "Checking for ''cdef'... no"
     664$ call write_config f$fao("#undef !AS",cdef)
     665$ MSYM_CLEAN:
     666$ if (idel .le. msym_max)
     667$ then
     668$   delete/sym mdef_'idel'
     669$   idel = idel + 1
     670$   goto msym_clean
     671$ endif
     672$ return
     673$!------------------------------------------------------------------------------
     674$!
    385675$! Analyze Object files for OpenVMS AXP to extract Procedure and Data
    386676$! information to build a symbol vector for a shareable image
    387677$! All the "brains" of this logic was suggested by Hartmut Becker
    388678$! (Hartmut.Becker@compaq.com). All the bugs were introduced by me
    389 $! (zinser@decus.de), so if you do have problem reports please do not
     679$! (zinser@zinser.no-ip.info), so if you do have problem reports please do not
    390680$! bother Hartmut/HP, but get in touch with me
     681$!
     682$! Version history
     683$! 0.01 20040406 Skip over shareable images in option file
     684$! 0.02 20041109 Fix option file for shareable images with case_sensitive=YES
     685$! 0.03 20050107 Skip over Identification labels in option file
     686$! 0.04 20060117 Add uppercase alias to code compiled with /name=as_is
    391687$!
    392688$ ANAL_OBJ_AXP: Subroutine
     
    410706$ loop:
    411707$ read/end=end_loop in line
     708$ if f$locate("/SHARE",f$edit(line,"upcase")) .lt. f$length(line)
     709$ then
     710$   write sys$output "ANAL_SKP_SHR-i-skipshare, ''line'"
     711$   goto loop
     712$ endif
     713$ if f$locate("IDENTIFICATION=",f$edit(line,"upcase")) .lt. f$length(line)
     714$ then
     715$   write sys$output "ANAL_OBJ_AXP-i-ident: Identification ", -
     716                     f$element(1,"=",line)
     717$   goto loop
     718$ endif
    412719$ f= f$search(line)
    413720$ if f .eqs. ""
     
    451758sub/"/=DATA)/whole
    452759exit
    453 $ sort/nodupl d.tmp,f.tmp 'p2'
    454 $ delete a.tmp;*,b.tmp;*,c.tmp;*,d.tmp;*,e.tmp;*,f.tmp;*
     760$ sort/nodupl d.tmp,f.tmp g.tmp
     761$ open/read raw_vector g.tmp
     762$ open/write case_vector 'p2'
     763$ RAWLOOP:
     764$ read/end=end_rawloop raw_vector raw_element
     765$ write case_vector raw_element
     766$ if f$locate("=PROCEDURE)",raw_element) .lt. f$length(raw_element)
     767$ then
     768$     name = f$element(1,"=",raw_element) - "("
     769$     if f$edit(name,"UPCASE") .nes. name then -
     770          write case_vector f$fao(" symbol_vector=(!AS/!AS=PROCEDURE)", -
     771                                  f$edit(name,"UPCASE"), name)
     772$ endif
     773$ if f$locate("=DATA)",raw_element) .lt. f$length(raw_element)
     774$ then
     775$     name = f$element(1,"=",raw_element) - "("
     776$     if f$edit(name,"UPCASE") .nes. name then -
     777          write case_vector f$fao(" symbol_vector=(!AS/!AS=DATA)", -
     778                                  f$edit(name,"UPCASE"), name)
     779$ endif
     780$ goto rawloop
     781$ END_RAWLOOP:
     782$ close raw_vector
     783$ close case_vector
     784$ delete a.tmp;*,b.tmp;*,c.tmp;*,d.tmp;*,e.tmp;*,f.tmp;*,g.tmp;*
    455785$ if f$search("x.tmp") .nes. "" -
    456786        then $ delete x.tmp;*
     
    460790$ endsubroutine
    461791$!------------------------------------------------------------------------------
     792$!
     793$! Write configuration to both permanent and temporary config file
     794$!
     795$! Version history
     796$! 0.01 20031029 First version to receive a number
     797$!
     798$WRITE_CONFIG: SUBROUTINE
     799$  write aconf 'p1'
     800$  open/append confh 'th'
     801$  write confh 'p1'
     802$  close confh
     803$ENDSUBROUTINE
     804$!------------------------------------------------------------------------------
Note: See TracChangeset for help on using the changeset viewer.