make_vms.com 15.2 KB
Newer Older
M
Mark Adler 已提交
1 2
$! make libz under VMS written by
$! Martin P.J. Zinser
M
Mark Adler 已提交
3 4 5 6 7 8 9 10 11 12
$!
$! In case of problems with the install you might contact me at
$! zinser@zinser.no-ip.info(preferred) or
$! zinser@sysdev.deutsche-boerse.com (work)
$!
$! Make procedure history for Zlib
$!
$!------------------------------------------------------------------------------
$! Version history
$! 0.01 20060120 First version to receive a number
M
Mark Adler 已提交
13 14 15 16 17 18 19 20 21
$!
$ on error then goto err_exit
$!
$!
$! Just some general constants...
$!
$ true  = 1
$ false = 0
$ tmpnam = "temp_" + f$getjpi("","pid")
M
Mark Adler 已提交
22 23 24 25
$ its_decc = false
$ its_vaxc = false
$ its_gnuc = false
$ s_case   = False
M
Mark Adler 已提交
26 27 28 29 30 31 32 33 34 35
$!
$! Setup variables holding "config" information
$!
$ Make     = ""
$ name     = "Zlib"
$ version  = "?.?.?"
$ v_string = "ZLIB_VERSION"
$ v_file   = "zlib.h"
$ ccopt    = ""
$ lopts    = ""
M
Mark Adler 已提交
36
$ dnsrl   = ""
M
Mark Adler 已提交
37 38 39
$ linkonly = false
$ optfile  = name + ".opt"
$ axp      = f$getsyi("HW_MODEL").ge.1024
M
Mark Adler 已提交
40
$!
M
Mark Adler 已提交
41 42 43 44 45 46 47 48 49
$! Check for MMK/MMS
$!
$ If F$Search ("Sys$System:MMS.EXE") .nes. "" Then Make = "MMS"
$ If F$Type (MMK) .eqs. "STRING" Then Make = "MMK"
$!
$!
$ gosub find_version
$!
$ gosub check_opts
M
Mark Adler 已提交
50 51 52
$!
$! Look for the compiler used
$!
M
Mark Adler 已提交
53 54
$ gosub check_compiler
$ if its_decc
M
Mark Adler 已提交
55
$ then
M
Mark Adler 已提交
56 57
$   ccopt = "/prefix=all" + ccopt
$   if f$trnlnm("SYS") .eqs. ""
M
Mark Adler 已提交
58
$   then
M
Mark Adler 已提交
59 60
$     if axp
$     then
M
Mark Adler 已提交
61 62 63 64 65 66
$       define sys sys$library:
$     else
$       ccopt = "/decc" + ccopt
$       define sys decc$library_include:
$     endif
$   endif
M
Mark Adler 已提交
67
$ endif
M
Mark Adler 已提交
68 69 70
$ if its_vaxc .or. its_gnuc
$ then
$    if f$trnlnm("SYS").eqs."" then define sys sys$library:
M
Mark Adler 已提交
71
$ endif
M
Mark Adler 已提交
72 73 74 75
$!
$! Build the thing plain or with mms
$!
$ write sys$output "Compiling Zlib sources ..."
M
Mark Adler 已提交
76
$ if make.eqs.""
M
Mark Adler 已提交
77 78 79
$  then
$   dele example.obj;*,minigzip.obj;*
$   CALL MAKE adler32.OBJ "CC ''CCOPT' adler32" -
M
Mark Adler 已提交
80
                adler32.c zlib.h zconf.h
M
Mark Adler 已提交
81 82 83
$   CALL MAKE compress.OBJ "CC ''CCOPT' compress" -
                compress.c zlib.h zconf.h
$   CALL MAKE crc32.OBJ "CC ''CCOPT' crc32" -
M
Mark Adler 已提交
84
                crc32.c zlib.h zconf.h
M
Mark Adler 已提交
85
$   CALL MAKE deflate.OBJ "CC ''CCOPT' deflate" -
M
Mark Adler 已提交
86
                deflate.c deflate.h zutil.h zlib.h zconf.h
M
Mark Adler 已提交
87
$   CALL MAKE gzio.OBJ "CC ''CCOPT' gzio" -
M
Mark Adler 已提交
88
                gzio.c zutil.h zlib.h zconf.h
M
Mark Adler 已提交
89
$   CALL MAKE infback.OBJ "CC ''CCOPT' infback" -
M
Mark Adler 已提交
90
                infback.c zutil.h inftrees.h inflate.h inffast.h inffixed.h
M
Mark Adler 已提交
91
$   CALL MAKE inffast.OBJ "CC ''CCOPT' inffast" -
M
Mark Adler 已提交
92
                inffast.c zutil.h zlib.h zconf.h inffast.h
M
Mark Adler 已提交
93
$   CALL MAKE inflate.OBJ "CC ''CCOPT' inflate" -
M
Mark Adler 已提交
94
                inflate.c zutil.h zlib.h zconf.h infblock.h
M
Mark Adler 已提交
95 96 97
$   CALL MAKE inftrees.OBJ "CC ''CCOPT' inftrees" -
                inftrees.c zutil.h zlib.h zconf.h inftrees.h
$   CALL MAKE trees.OBJ "CC ''CCOPT' trees" -
M
Mark Adler 已提交
98
                trees.c deflate.h zutil.h zlib.h zconf.h
M
Mark Adler 已提交
99 100 101 102 103 104 105 106 107 108
$   CALL MAKE uncompr.OBJ "CC ''CCOPT' uncompr" -
                uncompr.c zlib.h zconf.h
$   CALL MAKE zutil.OBJ "CC ''CCOPT' zutil" -
                zutil.c zutil.h zlib.h zconf.h
$   write sys$output "Building Zlib ..."
$   CALL MAKE libz.OLB "lib/crea libz.olb *.obj" *.OBJ
$   write sys$output "Building example..."
$   CALL MAKE example.OBJ "CC ''CCOPT' example" -
                example.c zlib.h zconf.h
$   call make example.exe "LINK example,libz.olb/lib" example.obj libz.olb
M
Mark Adler 已提交
109 110 111 112
$   if f$search("x11vms:xvmsutils.olb") .nes. ""
$   then
$     write sys$output "Building minigzip..."
$     CALL MAKE minigzip.OBJ "CC ''CCOPT' minigzip" -
M
Mark Adler 已提交
113
                minigzip.c zlib.h zconf.h
M
Mark Adler 已提交
114 115
$     call make minigzip.exe -
                "LINK minigzip,libz.olb/lib,x11vms:xvmsutils.olb/lib" -
M
Mark Adler 已提交
116
                minigzip.obj libz.olb
M
Mark Adler 已提交
117
$   endif
M
Mark Adler 已提交
118
$  else
M
Mark Adler 已提交
119
$   gosub crea_mms
M
Mark Adler 已提交
120
$   write sys$output "Make ''name' ''version' with ''Make' "
M
Mark Adler 已提交
121
$   'make'
M
Mark Adler 已提交
122
$  endif
M
Mark Adler 已提交
123 124 125 126 127 128 129 130
$!
$! Alpha gets a shareable image
$!
$ If axp
$ Then
$   gosub crea_olist
$   write sys$output "Creating libzshr.exe"
$   call anal_obj_axp modules.opt _link.opt
M
Mark Adler 已提交
131
$   if s_case
M
Mark Adler 已提交
132 133 134 135 136 137 138
$   then
$      open/append optf modules.opt
$      write optf "case_sensitive=YES"
$      close optf
$   endif
$   LINK_'lopts'/SHARE=libzshr.exe modules.opt/opt,_link.opt/opt
$ endif
M
Mark Adler 已提交
139 140
$ write sys$output "Zlib build completed"
$ exit
M
Mark Adler 已提交
141 142 143 144 145
$CC_ERR:
$ write sys$output "C compiler required to build ''name'"
$ goto err_exit
$ERR_EXIT:
$ set message/facil/ident/sever/text
M
Mark Adler 已提交
146
$ close/nolog optf
M
Mark Adler 已提交
147 148
$ write sys$output "Exiting..."
$ exit 2
M
Mark Adler 已提交
149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
$!
$!
$MAKE: SUBROUTINE   !SUBROUTINE TO CHECK DEPENDENCIES
$ V = 'F$Verify(0)
$! P1 = What we are trying to make
$! P2 = Command to make it
$! P3 - P8  What it depends on
$
$ If F$Search(P1) .Eqs. "" Then Goto Makeit
$ Time = F$CvTime(F$File(P1,"RDT"))
$arg=3
$Loop:
$       Argument = P'arg
$       If Argument .Eqs. "" Then Goto Exit
$       El=0
$Loop2:
$       File = F$Element(El," ",Argument)
$       If File .Eqs. " " Then Goto Endl
$       AFile = ""
$Loop3:
$       OFile = AFile
$       AFile = F$Search(File)
$       If AFile .Eqs. "" .Or. AFile .Eqs. OFile Then Goto NextEl
$       If F$CvTime(F$File(AFile,"RDT")) .Ges. Time Then Goto Makeit
$       Goto Loop3
$NextEL:
$       El = El + 1
$       Goto Loop2
$EndL:
$ arg=arg+1
$ If arg .Le. 8 Then Goto Loop
$ Goto Exit
$
$Makeit:
$ VV=F$VERIFY(0)
$ write sys$output P2
$ 'P2
$ VV='F$Verify(VV)
$Exit:
$ If V Then Set Verify
$ENDSUBROUTINE
M
Mark Adler 已提交
190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213
$!------------------------------------------------------------------------------
$!
$! 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 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)
$     if f$locate("AS_IS",f$edit(ccopt,"UPCASE")) .lt. f$length(ccopt) -
         then s_case = true
$   endif
$   if cparm .eqs. "LINK" then linkonly = true
M
Mark Adler 已提交
214
$   if f$locate("LOPTS=",cparm) .lt. f$length(cparm)
M
Mark Adler 已提交
215 216 217 218 219
$   then
$     start = f$locate("=",cparm) + 1
$     len   = f$length(cparm) - start
$     lopts = lopts + f$extract(start,len,cparm)
$   endif
M
Mark Adler 已提交
220
$   if f$locate("CC=",cparm) .lt. f$length(cparm)
M
Mark Adler 已提交
221 222 223 224
$   then
$     start  = f$locate("=",cparm) + 1
$     len    = f$length(cparm) - start
$     cc_com = f$extract(start,len,cparm)
M
Mark Adler 已提交
225 226
      if (cc_com .nes. "DECC") .and. -
         (cc_com .nes. "VAXC") .and. -
M
Mark Adler 已提交
227 228 229 230
	 (cc_com .nes. "GNUC")
$     then
$       write sys$output "Unsupported compiler choice ''cc_com' ignored"
$       write sys$output "Use DECC, VAXC, or GNUC instead"
M
Mark Adler 已提交
231 232 233 234 235
$     else
$     	if cc_com .eqs. "DECC" then its_decc = true
$     	if cc_com .eqs. "VAXC" then its_vaxc = true
$     	if cc_com .eqs. "GNUC" then its_gnuc = true
$     endif
M
Mark Adler 已提交
236
$   endif
M
Mark Adler 已提交
237
$   if f$locate("MAKE=",cparm) .lt. f$length(cparm)
M
Mark Adler 已提交
238 239 240 241
$   then
$     start  = f$locate("=",cparm) + 1
$     len    = f$length(cparm) - start
$     mmks = f$extract(start,len,cparm)
M
Mark Adler 已提交
242
$     if (mmks .eqs. "MMK") .or. (mmks .eqs. "MMS")
M
Mark Adler 已提交
243 244
$     then
$       make = mmks
M
Mark Adler 已提交
245
$     else
M
Mark Adler 已提交
246 247
$       write sys$output "Unsupported make choice ''mmks' ignored"
$       write sys$output "Use MMK or MMS instead"
M
Mark Adler 已提交
248
$     endif
M
Mark Adler 已提交
249 250 251 252 253 254 255
$   endif
$   i = i + 1
$   goto opt_loop
$ endif
$ return
$!------------------------------------------------------------------------------
$!
M
Mark Adler 已提交
256
$! Look for the compiler used
M
Mark Adler 已提交
257
$!
M
Mark Adler 已提交
258 259 260
$! Version history
$! 0.01 20040223 First version to receive a number
$! 0.02 20040229 Save/set value of decc$no_rooted_search_lists
M
Mark Adler 已提交
261 262 263 264 265 266 267 268 269 270
$CHECK_COMPILER:
$ if (.not. (its_decc .or. its_vaxc .or. its_gnuc))
$ then
$   its_decc = (f$search("SYS$SYSTEM:DECC$COMPILER.EXE") .nes. "")
$   its_vaxc = .not. its_decc .and. (F$Search("SYS$System:VAXC.Exe") .nes. "")
$   its_gnuc = .not. (its_decc .or. its_vaxc) .and. (f$trnlnm("gnu_cc") .nes. "")
$ endif
$!
$! Exit if no compiler available
$!
M
Mark Adler 已提交
271
$ if (.not. (its_decc .or. its_vaxc .or. its_gnuc))
M
Mark Adler 已提交
272 273
$ then goto CC_ERR
$ else
M
Mark Adler 已提交
274 275 276 277 278 279 280 281 282 283 284 285 286 287
$   if its_decc
$   then
$     write sys$output "CC compiler check ... Compaq C"
$     if f$trnlnm("decc$no_rooted_search_lists") .nes. ""
$     then
$       dnrsl = f$trnlnm("decc$no_rooted_search_lists")
$     endif
$     define decc$no_rooted_search_lists 1
$   else
$     if its_vaxc then write sys$output "CC compiler check ... VAX C"
$     if its_gnuc then write sys$output "CC compiler check ... GNU C"
$     if f$trnlnm(topt) then write topt "sys$share:vaxcrtl.exe/share"
$     if f$trnlnm(optf) then write optf "sys$share:vaxcrtl.exe/share"
$   endif
M
Mark Adler 已提交
288 289 290 291 292 293 294 295 296 297 298 299 300
$ endif
$ return
$!------------------------------------------------------------------------------
$!
$! If MMS/MMK are available dump out the descrip.mms if required
$!
$CREA_MMS:
$ write sys$output "Creating descrip.mms..."
$ create descrip.mms
$ open/append out descrip.mms
$ copy sys$input: out
$ deck
# descrip.mms: MMS description file for building zlib on VMS
M
Mark Adler 已提交
301
# written by Martin P.J. Zinser
M
Mark Adler 已提交
302 303 304 305 306 307 308
# <zinser@zinser.no-ip.info or zinser@sysdev.deutsche-boerse.com>

OBJS = adler32.obj, compress.obj, crc32.obj, gzio.obj, uncompr.obj, infback.obj\
       deflate.obj, trees.obj, zutil.obj, inflate.obj, \
       inftrees.obj, inffast.obj

$ eod
M
Mark Adler 已提交
309
$ write out "CFLAGS=", ccopt
M
Mark Adler 已提交
310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325
$ write out "LOPTS=", lopts
$ copy sys$input: out
$ deck

all : example.exe minigzip.exe libz.olb
        @ write sys$output " Example applications available"

libz.olb : libz.olb($(OBJS))
	@ write sys$output " libz available"

example.exe : example.obj libz.olb
              link $(LOPTS) example,libz.olb/lib

minigzip.exe : minigzip.obj libz.olb
              link $(LOPTS) minigzip,libz.olb/lib,x11vms:xvmsutils.olb/lib

M
Mark Adler 已提交
326
clean :
M
Mark Adler 已提交
327 328 329 330 331 332 333 334 335 336 337
	delete *.obj;*,libz.olb;*,*.opt;*,*.exe;*


# Other dependencies.
adler32.obj  : adler32.c zutil.h zlib.h zconf.h
compress.obj : compress.c zlib.h zconf.h
crc32.obj    : crc32.c zutil.h zlib.h zconf.h
deflate.obj  : deflate.c deflate.h zutil.h zlib.h zconf.h
example.obj  : example.c zlib.h zconf.h
gzio.obj     : gzio.c zutil.h zlib.h zconf.h
inffast.obj  : inffast.c zutil.h zlib.h zconf.h inftrees.h inffast.h
M
Mark Adler 已提交
338
inflate.obj  : inflate.c zutil.h zlib.h zconf.h
M
Mark Adler 已提交
339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359
inftrees.obj : inftrees.c zutil.h zlib.h zconf.h inftrees.h
minigzip.obj : minigzip.c zlib.h zconf.h
trees.obj    : trees.c deflate.h zutil.h zlib.h zconf.h
uncompr.obj  : uncompr.c zlib.h zconf.h
zutil.obj    : zutil.c zutil.h zlib.h zconf.h
infback.obj  : infback.c zutil.h inftrees.h inflate.h inffast.h inffixed.h
$ eod
$ close out
$ return
$!------------------------------------------------------------------------------
$!
$! Read list of core library sources from makefile.in and create options
$! needed to build shareable image
$!
$CREA_OLIST:
$ open/read min makefile.in
$ open/write mod modules.opt
$ src_check = "OBJS ="
$MRLOOP:
$ read/end=mrdone min rec
$ if (f$extract(0,6,rec) .nes. src_check) then goto mrloop
M
Mark Adler 已提交
360
$ rec = rec - src_check
M
Mark Adler 已提交
361 362 363 364
$ gosub extra_filnam
$ if (f$element(1,"\",rec) .eqs. "\") then goto mrdone
$MRSLOOP:
$ read/end=mrdone min rec
M
Mark Adler 已提交
365
$ gosub extra_filnam
M
Mark Adler 已提交
366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
$ if (f$element(1,"\",rec) .nes. "\") then goto mrsloop
$MRDONE:
$ close min
$ close mod
$ return
$!------------------------------------------------------------------------------
$!
$! Take record extracted in crea_olist and split it into single filenames
$!
$EXTRA_FILNAM:
$ myrec = f$edit(rec - "\", "trim,compress")
$ i = 0
$FELOOP:
$ srcfil = f$element(i," ", myrec)
$ if (srcfil .nes. " ")
$ then
$   write mod f$parse(srcfil,,,"NAME"), ".obj"
$   i = i + 1
M
Mark Adler 已提交
384
$   goto feloop
M
Mark Adler 已提交
385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409
$ endif
$ return
$!------------------------------------------------------------------------------
$!
$! Find current Zlib version number
$!
$FIND_VERSION:
$ open/read h_in 'v_file'
$hloop:
$ read/end=hdone h_in rec
$ rec = f$edit(rec,"TRIM")
$ if (f$extract(0,1,rec) .nes. "#") then goto hloop
$ rec = f$edit(rec - "#", "TRIM")
$ if f$element(0," ",rec) .nes. "define" then goto hloop
$ if f$element(1," ",rec) .eqs. v_string
$ then
$   version = 'f$element(2," ",rec)'
$   goto hdone
$ endif
$ goto hloop
$hdone:
$ close h_in
$ return
$!------------------------------------------------------------------------------
$!
M
Mark Adler 已提交
410
$! Analyze Object files for OpenVMS AXP to extract Procedure and Data 
M
Mark Adler 已提交
411 412 413
$! information to build a symbol vector for a shareable image
$! All the "brains" of this logic was suggested by Hartmut Becker
$! (Hartmut.Becker@compaq.com). All the bugs were introduced by me
M
Mark Adler 已提交
414
$! (zinser@zinser.no-ip.info), so if you do have problem reports please do not
M
Mark Adler 已提交
415 416
$! bother Hartmut/HP, but get in touch with me
$!
M
Mark Adler 已提交
417 418 419 420 421 422 423
$! Version history
$! 0.01 20040406 Skip over shareable images in option file
$! 0.02 20041109 Fix option file for shareable images with case_sensitive=YES
$! 0.03 20050107 Skip over Identification labels in option file
$! 0.04 20060117 Add uppercase alias to code compiled with /name=as_is
$!
$ ANAL_OBJ_AXP: Subroutine   
M
Mark Adler 已提交
424 425
$ V = 'F$Verify(0)
$ SAY := "WRITE_ SYS$OUTPUT"
M
Mark Adler 已提交
426
$ 
M
Mark Adler 已提交
427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442
$ IF F$SEARCH("''P1'") .EQS. ""
$ THEN
$    SAY "ANAL_OBJ_AXP-E-NOSUCHFILE:  Error, inputfile ''p1' not available"
$    goto exit_aa
$ ENDIF
$ IF "''P2'" .EQS. ""
$ THEN
$    SAY "ANAL_OBJ_AXP:  Error, no output file provided"
$    goto exit_aa
$ ENDIF
$
$ open/read in 'p1
$ create a.tmp
$ open/append atmp a.tmp
$ loop:
$ read/end=end_loop in line
M
Mark Adler 已提交
443 444 445 446 447 448 449 450 451 452 453
$ if f$locate("/SHARE",f$edit(line,"upcase")) .lt. f$length(line)
$ then
$   write sys$output "ANAL_SKP_SHR-i-skipshare, ''line'"
$   goto loop
$ endif
$ if f$locate("IDENTIFICATION=",f$edit(line,"upcase")) .lt. f$length(line)
$ then
$   write sys$output "ANAL_OBJ_AXP-i-ident: Identification ", -
                     f$element(1,"=",line)
$   goto loop
$ endif
M
Mark Adler 已提交
454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494
$ f= f$search(line)
$ if f .eqs. ""
$ then
$	write sys$output "ANAL_OBJ_AXP-w-nosuchfile, ''line'"
$	goto loop
$ endif
$ define/user sys$output nl:
$ define/user sys$error nl:
$ anal/obj/gsd 'f /out=x.tmp
$ open/read xtmp x.tmp
$ XLOOP:
$ read/end=end_xloop xtmp xline
$ xline = f$edit(xline,"compress")
$ write atmp xline
$ goto xloop
$ END_XLOOP:
$ close xtmp
$ goto loop
$ end_loop:
$ close in
$ close atmp
$ if f$search("a.tmp") .eqs. "" -
	then $ exit
$ ! all global definitions
$ search a.tmp "symbol:","EGSY$V_DEF 1","EGSY$V_NORM 1"/out=b.tmp
$ ! all procedures
$ search b.tmp "EGSY$V_NORM 1"/wind=(0,1) /out=c.tmp
$ search c.tmp "symbol:"/out=d.tmp
$ define/user sys$output nl:
$ edito/edt/command=sys$input d.tmp
sub/symbol: "/symbol_vector=(/whole
sub/"/=PROCEDURE)/whole
exit
$ ! all data
$ search b.tmp "EGSY$V_DEF 1"/wind=(0,1) /out=e.tmp
$ search e.tmp "symbol:"/out=f.tmp
$ define/user sys$output nl:
$ edito/edt/command=sys$input f.tmp
sub/symbol: "/symbol_vector=(/whole
sub/"/=DATA)/whole
exit
M
Mark Adler 已提交
495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519
$ sort/nodupl d.tmp,f.tmp g.tmp
$ open/read raw_vector g.tmp
$ open/write case_vector 'p2'
$ RAWLOOP:
$ read/end=end_rawloop raw_vector raw_element
$ write case_vector raw_element
$ if f$locate("=PROCEDURE)",raw_element) .lt. f$length(raw_element)
$ then
$     name = f$element(1,"=",raw_element) - "("
$     if f$edit(name,"UPCASE") .nes. name then -
          write case_vector f$fao(" symbol_vector=(!AS/!AS=PROCEDURE)", - 
	                          f$edit(name,"UPCASE"), name) 
$ endif
$ if f$locate("=DATA)",raw_element) .lt. f$length(raw_element)
$ then
$     name = f$element(1,"=",raw_element) - "("
$     if f$edit(name,"UPCASE") .nes. name then -
          write case_vector f$fao(" symbol_vector=(!AS/!AS=DATA)", - 
	                          f$edit(name,"UPCASE"), name) 
$ endif
$ goto rawloop
$ END_RAWLOOP:
$ close raw_vector
$ close case_vector
$ delete a.tmp;*,b.tmp;*,c.tmp;*,d.tmp;*,e.tmp;*,f.tmp;*,g.tmp;*
M
Mark Adler 已提交
520 521 522 523 524
$ if f$search("x.tmp") .nes. "" -
	then $ delete x.tmp;*
$!
$ EXIT_AA:
$ if V then set verify
M
Mark Adler 已提交
525
$ endsubroutine 
M
Mark Adler 已提交
526
$!------------------------------------------------------------------------------