| $ v = 'f$verify(0)' $! CODE.COM - command procedure to manipulate the code to large utilities $! Written by Bob Graham 5-Jul-1983 VMS v3.3 $! Revised by Bob Graham 13-Jul-1983 VMS v3.3 $! added CLEANUP function $! Revised by Bob Graham 21-Jul-1983 VMS v3.3 $! added message file support $! Revised by Bob Graham 29-Jul-1983 VMS v3.3 $! added stripping of /NOOPTIMIZE/CHECK qualifiers from macro processing $! Revised by Bob Graham 5-Aug-1983 VMS v3.3 $! added support for alternate text (include) libraries $! Revised by Bob Graham 4-Oct-1983 VMS v3.3 $! added support for the division model preprocessor $! Revised by Bob Graham 14-Sep-1984 VMS v3.6 $! get rid of error messages from PRINT and LIBRARY functions $! Revised by Bob Graham 30-Dec-1985 VMS v4.2 $! added support for command definition files (.CLD) $! Revised by Bob Graham 21-Jan-1987 VMS v4.5 $! added support for precompiled RDB FORTRAN modules and /PRINT qualifier $! /LIST/NOPRINT is the default $! $! This is a replacement for the CO, EX, EXTRACT and COMPALL procedures $! used previously. Instead of separate procedures, this single procedure $! performs all the functions by itself. The user can extract all or any $! module from the source library. The user can also compile any or all $! modules and include them in the source and object library. $! $! This version has some enhancements in that the source library is $! ".TLB" and is included as a library to search in each $ FORTRAN command. $! This prevents having to extract the current versions of the include $! files. Also this version allows the user to specify a list of modules $! when extracting or compiling instead of having to do a single command $! for each. One last change is that the logical name "DEVEL:" only refers $! to where the utilities files (source library, object library, module $! description) are found. The individual sources always default to the $! current default directory. $! $! The module description file is now an ISAM file, to speed up $! processing single modules. This means that to modify the file the user $! will have to edit it, producing a sequential file and then use CONVERT $! to load the text into the ISAM file. NOTE: if the file is not an ISAM $! file the procedure will assume that the utility was created using the $! old routines and thus will expect the source library to be named $! "utility.SOR". $! $! INPUTS: $! $! P1 - function to perform $! EX - extract single module or list of modules $! EXI- extract all include files $! EXA- extract all modules $! CO - compile single module or list of modules $! COA- compile all modules $! CLA- clean up (delete all sources, which are in library) $! LDA- reload the description file from a text file $! $! P2 - if P1 was EX or CO then this is a list of modules, $! otherwise it is the name of the utility. For the CO $! and COA commands, any qualifiers which are to be passed $! to the $FORTRAN or $MACRO commands are attached to the $! end of this parameter. $! $! P3 - if P1 was EX or CO then this is the name of the utility $! $! setup control Y trap $! $ on control_y then goto ctly_trap $ set noon $! $! find out what function to perform $! $ if p1 .eqs. "" then inquire p1 "What function to perform" $ l = f$length(p1) $ function = "COMPILE" $ if f$locate("EX",p1) .lt. l then function = "EXTRACT" $ if f$locate("CL",p1) .lt. l then function = "CLEANUP" $ if f$locate("LD",p1) .lt. l then function = "LOADTXT" $ do_all = f$extract(2,1,p1) .eqs. "A" $ if function .eqs. "LOADTXT" then do_all = 1 $ do_include = f$extract(2,1,p1) .eqs. "I" $ do_module = do_all .eq. .and. do_include .eq. $! $! strip any/all qualifiers of P2, then get utility name and $! list of modules (if any) $! $ n = f$locate("/",p2) $ q_all = f$extract(n,f$length(p2)-n,p2) $ p2 = f$extract(0,n,p2) $ pu = 2 $ if .not. do_module then got not_mod $ if p2 .eqs. "" then inquire p2 "What modules" $ n = f$locate("/",p2) $ q_all = q_all + f$extract(n,f$length(p2)-n,p2) $ p2 = f$extract(0,n,p2) $ module = p2 $ pu = 3 $ not_mod: $ utility = p'pu' $ if utility .eqs. "" then inquire utility "What utility" $! $! check for the DEVEL logical name, if not found, then assume current $! default directory. $! $ devel = "" $ if f$logical("DEVEL") .nes. "" then devel = "DEVEL:" $ desc_file = devel + utility + ".dat" $ source_lib = devel + utility + ".tlb" $ object_lib = devel + utility + ".olb" $! $! make check for LOADTXT function, if it is then jump to special code $! $ if function .eqs. "LOADTXT" then goto loadtxt_mod $! $! look for description file and open it $! $ if f$search(desc_file) .eqs. "" then goto err_nodesc $ if f$file_attribute(desc_file,"ORG") .nes. "IDX" then goto err_oldver $ open/read/error=err_nodesc desc 'desc_file' $! $! check for /NOLIST qualifier, if not found, then assume /LIST $! $ if f$locate("/NOL",q_all) .eq. f$length(q_all) .and. - f$locate("/L",q_all) .eq. f$length(q_all) then - q_all = "/LIST" + q_all $ list = f$locate("/L",q_all) .lt. f$length(q_all) $! $! check for /PRINT qualifier, if not found, assume /NOPRINT $! $ prilst = f$locate("/PRI",q_all) .lt. f$length(q_all) $ if .not. prilst then goto end_prichk $ n = f$locate("/PRI",q_all) + 1 $ tmp := 'f$extract(n,f$length(q_all)-n,q_all)' $ n = f$locate("/",tmp) $ tmp := 'f$extract(0,n,tmp)' $ q_all = q_all - ( "/" + tmp ) $ end_prichk: $ prilst = list .and. prilst $! $! extract /LIST=value if any $! $ list_value = "" $ if .not. list then goto end_listval $ n = f$locate("/L",q_all) + 1 $ tmp := 'f$extract(n,f$length(q_all)-n,q_all)' $ n = f$locate("/",tmp) $ tmp := 'f$extract(0,n,tmp)' $ n = f$locate("=",tmp) $ list_value := 'f$extract(n,f$length(tmp)-n,tmp)' $ end_listval: $! $! the only qualifier on preprocessor files is /LIST $! $ if .not. list then q_pre = "/NOLIST" $ if list then q_pre = "/LIST" + list_value $! $! the only qualifier on message file is /LIST $! $ if .not. list then q_msg = "/NOLIST" $ if list then q_msg = "/LIST" + list_value $! $! no qualifiers current allows on CLD (command definition) files $! $ q_cld = "" $! $! strip /NOOPTI/CHECK for MACRO files $! NOTE: actually we only allow /LIST/DEBUG since it's easier to do $! $ if .not. list then q_macro = "/NOLIST" $ if list then q_macro = "/LIST" + list_value $ if f$locate("/DE",q_all) .lt. f$length(q_all) then - q_macro = q_macro + "/DEBUG" $! $! check for alternate text (include) libraries, these are specified by $! the logical names CODE_LIB1, CODE_LIB2, ... CODE_LIBn. Currently, only $! FORTRAN modules use include libraries. $! $ n = $ alt_lib = "" $ loop: $ n = n + 1 $ log = "CODE_LIB" + f$string(n) $ log = f$logical(log) $ if log .eqs. "" then goto end_altlib $ alt_lib = alt_lib + "+" + log + "/libr" $ goto loop $ end_altlib: $! $! begin loop to handle all modules $! $ next_module: $! $! if all or include then read the next record, if include then the $! record (and module name) must start with a $. $! if module then pop the next module name off of the list $! and read the record for it $! $ if do_module then goto nxt_mod $ loop: $ read/end=end_list desc record $ if do_include .and. f$extract(0,1,record) .nes. "$" then goto loop $ goto get_mod $ nxt_mod: $ n = f$locate(",",module) $ key = f$extract(0,n,module) $ if key .eqs. "" then goto end_list $ module = f$extract(n+1,f$length(module)-n-1,module) $ read/key="''key'"/nolock/error=err_nosuchmod desc record $! $! extract the needed info from the current record $! $! mod - module name $! q_mod - module specific qualifiers $! file - module's file name $! $ get_mod: $ n = f$locate(";",record) $ mod := 'f$extract(0,n,record)' $ record = f$extract(n+1,f$length(record)-n-1,record) $ n = f$locate("/",record) $ q_mod = f$extract(n,f$length(record)-n,record) $ file = f$extract(0,n,record) $! $! branch based on function to be done $! NOTE: the labels are the function code appeneded with "_MOD" $! $ goto 'function'_mod $! $! the extract function - extract the module from the source library $! $ extract_mod: $ library 'source_lib'/text/extract='mod'/output='file' $ write sys$output "module ", mod, " extracted to ", file $ goto next_module $! $! the cleanup function - delete the source file, a copy should be $! in the source library already $! $ cleanup_mod: $ f = f$parse(";*",file) $ if f$search(f) .eqs. "" then goto next_module $ delete 'f' $ write sys$output "file: ", f, " deleted" $ goto next_module $! $! the compile function - compile/assemble the source file, replace it $! in the source library and replace the object in the object library $! if /list was selected then print the listing. $! $ compile_mod: $ type = f$parse(file,,,"TYPE") $ filename = f$parse(file,,,"NAME") $ if f$extract(0,1,mod) .eqs. "$" then goto insert_text $ if type .eqs. ".FOR" then - fortran'q_mod''q_all' 'filename'+'source_lib'/libr'alt_lib' $ if type .eqs. ".MAR" then - macro'q_mod''q_macro' 'filename' $ if type .eqs. ".MSG" then - message'q_mod''q_msg' 'filename' $ if type .eqs. ".CLD" then - set command'q_mod''q_cld'/object 'filename' $ if type .eqs. ".RFO" then - rdbpre/fortran'q_mod''q_all' 'filename' $ if type .nes. ".PRE" then goto not_pre $ premodel'q_pre' 'filename' $ fortran'q_mod''q_all'/nolist 'filename'+'source_lib'/libr'alt_lib' $ not_pre: $ if prilst .and. f$search(f$parse(filename,".LIS")) .nes. "" then - print/delete/noidentify 'filename' $ if f$search(f$parse(filename,".OBJ")) .nes. "" then - library 'object_lib' 'filename'/replace $ delete 'filename'.obj;0 $ library 'source_lib'/text 'file'/replace/module='mod' $ write sys$output "file ", file, " compiled for module ", mod $ goto next_module $ insert_text: $ library 'source_lib'/text 'file'/replace/module='mod' $ if prilst .and. list_value .eqs. "" then print/noidentify 'file' $ if prilst .and. list_value .nes. "" then - copy 'file' "''f$extract(1,f$length(list_value),list_value)'" $ write sys$output "file ", file, " included as module ", mod goto next_module $! $! there are no more modules to process so close file and exit $! $ end_list: $ close desc $ goto exit_here $! $!********************************** $! all error routines come here $!********************************** $! $! a specific module could not be found $! note: this error is non fatal, the procedure simply goes to the $! next module on the list $! $ err_nosuchmod: $ write sys$output "module ", key, " could not be found in ", utility $ goto next_module $! $! fatal error when the module description file can't be found $! $ err_nodesc: $ write sys$output "the description file ", desc_file, " could not be found" $ goto exit_here $! $! fatal error when the utility is in the old version format $! $ err_oldver: $ write sys$output "you must use the old version procedures on ", utility $ goto exit_here $! $! control Y traps to here, close all open files and then exit $! $ ctly_trap: $ if f$logical("DESC") .nes. "" then close desc $ write sys$output function, " aborted by user" $ goto exit_here $! $! exit from errors here $! $ exit_here: $ if v then set verify $ exit $! $!*************************************************** $! special code for reloading description file $!*************************************************** $! $! LOADTXT function, a new description file is created using the $! contents of a text file: 'utility'.txt. This enables a user $! to edit the description file to add, delete, and change entries. $! $ loadtxt_mod: $! $! open the input text file $! $ txt_file = f$parse(".TXT",desc_file) $ open/read/error=err_notxtfile in 'txt_file' $! $! create a new description file $! $ create/fdl=sys$input 'desc_file' IDENT 6-JUL-1983 07:29:50 VAX-11 ANALYZE/RMS_FILE Utility SYSTEM SOURCE VAX/VMS FILE ALLOCATION 6 BEST_TRY_CONTIGUOUS yes BUCKET_SIZE 1 CONTIGUOUS no EXTENSION 1 GLOBAL_BUFFER_COUNT ORGANIZATION indexed READ_CHECK no WRITE_CHECK no RECORD BLOCK_SPAN yes CARRIAGE_CONTROL carriage_return FORMAT variable SIZE AREA ALLOCATION 3 BEST_TRY_CONTIGUOUS yes BUCKET_SIZE 1 CONTIGUOUS no EXTENSION 1 AREA 1 ALLOCATION 3 BEST_TRY_CONTIGUOUS yes BUCKET_SIZE 1 CONTIGUOUS no EXTENSION KEY CHANGES no DATA_KEY_COMPRESSION yes DATA_RECORD_COMPRESSION yes DATA_FILL 68 DATA_AREA DUPLICATES no INDEX_AREA 1 INDEX_COMPRESSION yes INDEX_FILL 68 LEVEL1_INDEX_AREA 1 NULL_KEY no PROLOGUE 3 SEG0_LENGTH 31 SEG0_POSITION TYPE string $! $! open the newly create file $! $ desc_file = f$search(desc_file) $ open/read/write out 'desc_file' $! $! read each record of the input file, upper case the module name and $! then write it into the description file $! $ read: $ read/end=end_txt in line $ n = f$locate(";",line) $ mod := 'f$extract(0,n,line)' $ rest = f$extract(n,f$length(line)-n,line) $ line = f$fao("!31AS!AS",mod,rest) $ write out line $ goto read $ end_txt: $ close in $ close out $ goto exit_here $! $! error if no text file is found $! $ err_notxtfile: $ write sys$output "the input text file ", txt_file, " could not be found" $ goto exit_here | |
|
