home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
listdl.zip
/
LISTDLL.CMD
next >
Wrap
OS/2 REXX Batch file
|
1994-10-25
|
64KB
|
949 lines
/*------------------------------------------------------------------------*\
| |
| LISTDLL.CMD - Version 1.0 - Version Date 1994-09-29 |
| Version 1.1 - Version Date 1994-10-25 |
| Copyright (C) 1994 by C F S Nevada, Inc. |
| |
| by Dick Goran - Voice 702-732-9616 |
| - FAX 702-732-3847 |
| - CIS 71154,2002 |
| - FIDO 1:209/705 |
| - IBMLink DEV4672 at HONE81 |
| - Internet 71154.2002@compuserve.com |
| |
| ------------------------------------------------------------------------ |
| REXXLIB.DLL - OS/2 REXX external function library |
| (c) Copyright 1992-94 Quercus Systems |
\*------------------------------------------------------------------------*/
/*
This program will produce an ASCII file (LISTDLL.TXT) containing a
list of all of all of the DLLs that are "addressable" via the LIBPATH
statement. This program may be run from any directory and will include
DLLs in the current directory if the .; token is included in the LIBPATH
statement located in CONFIG.SYS on the IPL (boot drive).
This program is released to the public domain.
Updates & Fixes:
================
1) LIBPATH string was searched for in uppercase only.
*/
parse Version REXX_Version . /* 0034 */
parse Source OS_Name, /* 0035 */
Calling_Environment, /* 0036 */
program_path_and_name /* 0037 */
GBL. = '' /* initialize stem */ /* 0038 */
GBL.environment = 'OS2ENVIRONMENT' /* 0039 */
GBL.program_name = FILESPEC( 'N', program_path_and_name ) /* 0040 */
GBL.program_path = FILESPEC( 'D', program_path_and_name ) ||, /* 0041 */
FILESPEC( 'P', program_path_and_name ) /* 0042 */
GBL.program_version = 1.1 /* version / mod of this program */
call TIME 'E' /* set elapsed timer - sssss.uuuuu */
/* 0045 */
say 'Begin' TRANSLATE( GBL.program_name ) 'at' TIME('N') /* 0046 */
call REGISTER_REQUIRED_FUNCTIONS /* 0047 */
/* 0048 */
SIGNAL ON ERROR /* trap object time errors */
SIGNAL ON HALT /* trap object time errors */
SIGNAL ON NOVALUE /* trap object time errors */
SIGNAL ON SYNTAX /* trap object time errors */
/* 0053 */
parse value GBL.program_name with, /* 0054 */
fn '.' fe /* 0055 */
GBL.output_file = DOSDRIVE() || ':' ||, /* 0056 */
DOSCD() ||, /* 0057 */
'\' || TRANSLATE( fn ) || '.TXT' /* 0058 */
GBL.output_line_count = 0 /* 0059 */
GBL.column_blanks = COPIES( ' ', 2 ) /* 0060 */
GBL.conflict_count = 0 /* number of multiple DLL entries */
/* 0062 */
/*-------------------------------------------------------*\ /* 0063 */
| Check for output file being specified on command line | /* 0064 */
\*-------------------------------------------------------*/ /* 0065 */
parse arg parameter_1 /* 0066 */
if LEFT( parameter_1, 1 ) = '"' then /* 0067 */
do /* 0068 */
parameter_1 = STRIP( parameter_1, 'B', '"' ) /* 0069 */
end /* 0070 */
else /* 0071 */
if WORDS( parameter_1 ) > 1 then /* 0072 */
do /* 0073 */
say ' The only parameter allowed is the output file name.'
say ' Program cancelled.' /* 0075 */
call EOJ 255 /* 0076 */
end /* 0077 */
if parameter_1 <> '' then /* 0078 */
do /* 0079 */
GBL.output_file = parameter_1 /* 0080 */
end /* 0081 */
call SysFileDelete GBL.output_file /* erase any prior file */ /* 0082 */
if RESULT > 2 then /* 0083 */
do /* 0084 */
say ' SysFileDelete returned ' ||, /* 0085 */
RESULT ||, /* 0086 */
' for file name ' ||, /* 0087 */
GBL.output_file /* 0088 */
say ' Program cancelled.' /* 0089 */
call EOJ RESULT /* 0090 */
end /* 0091 */
/* 0092 */
/*----------------------------------------------------------*\ /* 0093 */
| Read CONFIG.SYS from IPL drive to find LIBPATH statement | /* 0094 */
\*----------------------------------------------------------*/ /* 0095 */
config_sys_file_name = DOSBOOTDRIVE() ||, /* 0096 */
':\config.sys' /* 0097 */
config_sys_file_size = STREAM( config_sys_file_name, 'C', 'QUERY SIZE' )
if config_sys_file_size \> 0 then /* 0099 */
do /* 0100 */
say 'Unable to locate ' ||, /* 0101 */
config_sys_file_name ||, /* 0102 */
'. Program cancelled.' /* 0103 */
call EOJ 254 /* 0104 */
end /* 0105 */
config_sys_file_area = CHARIN( config_sys_file_name, 1, config_sys_file_size )
config_sys_file_area = TRANSLATE( config_sys_file_area ) /* 0107 */
call STREAM config_sys_file_name /* 0108 */
/* 0109 */
/*------------------------*\ /* 0110 */
| Find LIBPATH statement | /* 0111 */
\*------------------------*/ /* 0112 */
libpath_search_arg = '0D0A'x || 'LIBPATH=' /* 0113 */
libpath_beg_pointer = POS( libpath_search_arg, config_sys_file_area )
if libpath_beg_pointer = 0 then /* 0115 */
do /* 0116 */
say 'Unable to locate LIBPATH= in ' ||, /* 0117 */
config_sys_file_name ||, /* 0118 */
'. Program cancelled.' /* 0119 */
call EOJ 254 /* 0120 */
end /* 0121 */
else /* 0122 */
do /* 0123 */
libpath_beg_pointer = libpath_beg_pointer + LENGTH(libpath_search_arg)
libpath_end_pointer = POS( '0D0A'x,, /* 0125 */
config_sys_file_area,, /* 0126 */
libpath_beg_pointer ) /* 0127 */
if libpath_end_pointer = 0 then /* 0128 */
do /* 0129 */
say 'Unable to locate end of LIBPATH line. Should not occur.'
call EOJ 254 /* 0131 */
end /* 0132 */
else /* 0133 */
do /* 0134 */
libpath_line = SUBSTR( config_sys_file_area,, /* 0135 */
libpath_beg_pointer,, /* 0136 */
libpath_end_pointer - libpath_beg_pointer)
end /* 0138 */
end /* 0139 */
/* 0140 */
/*------------------------------------------*\ /* 0141 */
| Build SysFileTree array of all DLL files | /* 0142 */
\*------------------------------------------*/ /* 0143 */
heading_3 = '' /* current directory if .; included */
libpath_tokens = libpath_line /* copy LIBPATH data */ /* 0145 */
path_table.0 = 0 /* table of all DLL paths */ /* 0146 */
path_index. = 0 /* associative array for path_table */
search_order_stem.0 = 0 /* combined array of DLL files - search order */
/* 0149 */
do while libpath_tokens <> '' /* 0150 */
parse value libpath_tokens with, /* 0151 */
dll_path ';' libpath_tokens /* 0152 */
if dll_path = '.' then /* 0153 */
do /* 0154 */
dll_path = DOSDRIVE() || ':' || DOSCD() /* 0155 */
heading_3 = 'Search path includes ' ||, /* 0156 */
dll_path /* 0157 */
end /* 0158 */
else /* 0159 */
/* check for duplicate path */ /* 0160 */
do /* 0161 */
uppercase_dll_path = TRANSLATE( dll_path ) /* 0162 */
pt = path_table.0 + 1 /* potential subscript */ /* 0163 */
if path_index.uppercase_dll_path > 0 then /* 0164 */
do /* 0165 */
output_line =, /* 0166 */
dll_path ||, /* 0167 */
' is duplicated in LIBPATH.' /* 0168 */
call LINEOUT GBL.output_file, output_line || '0D0A'x
GBL.output_line_count = GBL.output_line_count + 1 /* 0170 */
say ' ' || output_line /* 0171 */
iterate /* 0172 */
end /* 0173 */
path_table.pt = uppercase_dll_path /* add dll path to table */
path_table.0 = pt /* 0175 */
path_index.dll_path = pt /* create associative index */
end /* 0177 */
/* 0178 */
call SysFileTree dll_path || '\*.dll',, /* 0179 */
'temp_stem',, /* 0180 */
'F' /* 0181 */
if temp_stem.0 = 0 then iterate /* 0182 */
call ARRAYCOPY 'temp_stem', 'search_order_stem', 1, search_order_stem.0 + 1
end /* 0184 */
/* 0185 */
/*------------------------------------*\ /* 0186 */
| Write heading lines to output_file | /* 0187 */
\*------------------------------------*/ /* 0188 */
say ' Building ' ||, /* 0189 */
GBL.output_file /* 0190 */
heading_1 =, /* 0191 */
DATE( 'N' ) || COPIES( ' ', 3 ) ||, /* 0192 */
TIME( 'N' ) || COPIES( ' ', 3 ) ||, /* 0193 */
TRANSLATE( GBL.program_name ) ||, /* 0194 */
' - Addressble DLLs per ' ||, /* 0195 */
TRANSLATE( config_sys_file_name ) /* 0196 */
call LINEOUT GBL.output_file, heading_1 /* 0197 */
GBL.output_line_count = GBL.output_line_count + 1 /* 0198 */
/* 0199 */
output_line =, /* 0200 */
'(c) 1994 by Dick Goran, C F S Nevada, Inc. ' ||, /* 0201 */
'(71154.2002@compuserve.com)' /* 0202 */
heading_2 = CENTER( output_line, LENGTH(heading_1) ) /* 0203 */
call LINEOUT GBL.output_file, heading_2 /* 0204 */
GBL.output_line_count = GBL.output_line_count + 1 /* 0205 */
/* 0206 */
if heading_3 <> '' then /* 0207 */
do /* 0208 */
call LINEOUT GBL.output_file, CENTER( heading_3, LENGTH(heading_1) )
GBL.output_line_count = GBL.output_line_count + 1 /* 0210 */
end /* 0211 */
call LINEOUT GBL.output_file, ' ' /* 0212 */
GBL.output_line_count = GBL.output_line_count + 1 /* 0213 */
/* 0214 */
/*-----------------------------------------------------*\ /* 0215 */
| Build an associative array of all DLL names looking | /* 0216 */
| for any conflicts arising from search order along | /* 0217 */
| with an array to allow sorting by DLL name. | /* 0218 */
\*-----------------------------------------------------*/ /* 0219 */
index_stem. = '' /* 0220 */
sort_stem.0 = 0 /* 0221 */
do sos = 1 to search_order_stem.0 /* 0222 */
/* 0223 */
parse upper value search_order_stem.sos with, /* 0224 */
ordered_file_date, /* 0225 */
ordered_file_time, /* 0226 */
ordered_file_size, /* 0227 */
ordered_file_attr, /* 0228 */
ordered_file_path_and_name /* 0229 */
ordered_file_path_and_name = STRIP( ordered_file_path_and_name )
/* 0231 */
ordered_file_path = FILESPEC( 'D', ordered_file_path_and_name ) ||,
FILESPEC( 'P', ordered_file_path_and_name )
parse value FILESPEC( 'N', ordered_file_path_and_name ) with, /* 0234 */
ordered_file_name '.' ordered_file_ext /* 0235 */
/* 0236 */
/*---------------------------*\ /* 0237 */
| Add to array to be sorted | /* 0238 */
\*---------------------------*/ /* 0239 */
ss = sort_stem.0 + 1 /* 0240 */
sort_stem.0 = ss /* 0241 */
sort_stem.ss =, /* 0242 */
LEFT( FILESPEC( 'N', ordered_file_path_and_name ), 13 ) ||, /* 0243 */
RIGHT( sos, 6) /* 0244 */
/* 0245 */
/*----------------------------------*\ /* 0246 */
| Check for prior existence of DLL | /* 0247 */
\*----------------------------------*/ /* 0248 */
if index_stem.ordered_file_name <> '' then /* 0249 */
do /* 0250 */
index_stem.ordered_file_name = index_stem.ordered_file_name,
sos /* 0252 */
end /* 0253 */
else /* 0254 */
do /* 0255 */
index_stem.ordered_file_name = sos /* search order number */
end /* 0257 */
end /* 0258 */
/* 0259 */
/*-------------------------------*\ /* 0260 */
| List any multiple occurrences | /* 0261 */
\*-------------------------------*/ /* 0262 */
do sos = 1 to search_order_stem.0 /* 0263 */
/* 0264 */
parse upper value search_order_stem.sos with, /* 0265 */
ordered_file_date, /* 0266 */
ordered_file_time, /* 0267 */
ordered_file_size, /* 0268 */
ordered_file_attr, /* 0269 */
ordered_file_path_and_name /* 0270 */
ordered_file_path_and_name = STRIP( ordered_file_path_and_name )
/* 0272 */
ordered_file_path = FILESPEC( 'D', ordered_file_path_and_name ) ||,
FILESPEC( 'P', ordered_file_path_and_name )
parse value FILESPEC( 'N', ordered_file_path_and_name ) with, /* 0275 */
ordered_file_name '.' ordered_file_ext /* 0276 */
/* 0277 */
/*----------------------------------*\ /* 0278 */
| Check for prior existence of DLL | /* 0279 */
\*----------------------------------*/ /* 0280 */
index_list = index_stem.ordered_file_name /* 0281 */
if WORDS( index_list ) > 1 then /* 0282 */
if sos = WORD( index_list, 1 ) then /* 0283 */
do /* 0284 */
/* Show precedence conflict in output listing */ /* 0285 */
call LIST_SUPERCEDED_OCCURRENCES index_list /* 0286 */
GBL.conflict_count = GBL.conflict_count + 1 /* 0287 */
end /* 0288 */
end /* 0289 */
/* 0290 */
/*-----------------------------*\ /* 0291 */
| Create TXT file of all DLLs | /* 0292 */
\*-----------------------------*/ /* 0293 */
output_line =, /* 0294 */
'List of all DLLs sorted by DLL name (case insensitive) & search order'
heading_4 = CENTER( output_line, LENGTH(heading_1) ) || '0D0A'x /* 0296 */
call LINEOUT GBL.output_file, heading_4 /* 0297 */
GBL.output_line_count = GBL.output_line_count + 1 /* 0298 */
/* 0299 */
call ARRAYSORT 'sort_stem', 1, sort_stem.0 /* 0300 */
/* 0301 */
do ss = 1 to sort_stem.0 /* 0302 */
parse value sort_stem.ss with, /* 0303 */
. sos . /* 0304 */
parse value search_order_stem.sos with, /* 0305 */
file_date, /* 0306 */
file_time, /* 0307 */
file_size, /* 0308 */
file_attr, /* 0309 */
file_path_and_name /* 0310 */
file_path_and_name = STRIP( file_path_and_name ) /* 0311 */
/* 0312 */
file_path = FILESPEC( 'D', file_path_and_name ) ||, /* 0313 */
FILESPEC( 'P', file_path_and_name ) /* 0314 */
parse value FILESPEC( 'N', file_path_and_name ) with, /* 0315 */
file_name '.' file_ext /* 0316 */
/* 0317 */
output_line =, /* 0318 */
RIGHT( file_date , 8 ) || GBL.column_blanks ||, /* 0319 */
RIGHT( file_time , 6 ) || GBL.column_blanks ||, /* 0320 */
RIGHT( EDIT( file_size ), 10 ) || GBL.column_blanks ||, /* 0321 */
LEFT( FILESPEC( 'N', file_path_and_name ), 12 ) || GBL.column_blanks ||,
file_path /* 0323 */
call LINEOUT GBL.output_file, output_line /* 0324 */
end /* 0325 */
call STREAM GBL.output_file, 'C', 'CLOSE' /* 0326 */
/* 0327 */
output_line =, /* 0328 */
EDIT( search_order_stem.0 ) ||, /* 0329 */
' DLLs found' /* 0330 */
call LINEOUT GBL.output_file, '0D0A'x || CENTER( output_line, LENGTH(heading_1) )
GBL.output_line_count = GBL.output_line_count + 1 /* 0332 */
/* 0333 */
/*-----------------------------------------*\ /* 0334 */
| Inform user if there were any conflicts | /* 0335 */
\*-----------------------------------------*/ /* 0336 */
if GBL.conflict_count > 0 then /* 0337 */
do /* 0338 */
if GBL.conflict_count = 1 then /* 0339 */
do /* 0340 */
was_were = 'was ' /* 0341 */
end /* 0342 */
else /* 0343 */
do /* 0344 */
was_were = 'were ' /* 0345 */
end /* 0346 */
say ' There ' ||, /* 0347 */
was_were ||, /* 0348 */
GBL.conflict_count ||, /* 0349 */
' DLL conflicts listed in ' ||, /* 0350 */
GBL.output_file /* 0351 */
end /* 0352 */
/* 0353 */
call EOJ 0 /* 0354 */
/* 0355 */
/*----------------------------------------------------------------*\
| |
| EDIT REXX function |
| ---------------------------------------------------------------- |
| |
| The following REXX subroutine / function will return an |
| edited integer or decimal value with appropriate |
| punctuation inserted appropriately (subject to DIGITS() ). |
| The correct punctuation characters are obtained from the |
| object system. For example (assuming US notation): |
| |
| EDIT(12345) |
| |
| will return 12,345; and |
| |
| EDIT(-123456.78) |
| |
| will return -123,456.78 |
| |
| The intent behind the creation of this function was speed. |
| It is being released to the public domain by the author - |
| Dick Goran, author of the "REXX Reference Summary Handbook" |
| 71154,2002 CompuServe |
| 71154.2002@compuserve.com Internet |
| HONE80(DEV4672) IBMLink |
| (1:209/705) FIDONET |
| |
| 88/04/24 - originally written for DOS Personal REXX |
| 93/12/25 - handle negative values & international notation |
| (presumes REXXUTIL registered) |
| |
\*----------------------------------------------------------------*/
EDIT: /* 0388 */
Procedure /* 0389 */
/* first time here, build translate tables */ /* 0390 */
SIGNAL OFF NOVALUE /* 0391 */
if LEFT(e1, 1) <> '01'x then /* 0392 */
do /* 0393 */
e1 = XRANGE('01'x, '19'x) /* 0394 */
e2 = XRANGE('01'x, '03'x) || '19'x ||, /* 0395 */
XRANGE('04'x, '06'x) || '19'x ||, /* 0396 */
XRANGE('07'x, '09'x) || '19'x ||, /* 0397 */
XRANGE('0A'x, '0C'x) || '19'x ||, /* 0398 */
XRANGE('0D'x, '0F'x) || '19'x ||, /* 0399 */
XRANGE('10'x, '12'x) || '19'x ||, /* 0400 */
XRANGE('13'x, '15'x) || '19'x ||, /* 0401 */
XRANGE('16'x, '18'x) /* 0402 */
/* get punctuation characters from INI file */ /* 0403 */
decimal = STRIP( SysIni( 'USER',, /* 0404 */
'PM_National',, /* 0405 */
'sDecimal' ), 'T', '00'x ) /* 0406 */
thousand = STRIP( SysIni( 'USER',, /* 0407 */
'PM_National',, /* 0408 */
'sThousand' ), 'T', '00'x ) /* 0409 */
end /* 0410 */
SIGNAL ON NOVALUE /* 0411 */
/* 0412 */
/* return BAD if non-numeric data */ /* 0413 */
if DATATYPE( ARG(1) ) <> 'NUM' then /* 0414 */
return 'BAD' /* 0415 */
/* 0416 */
/* test and save sign value along with absolute numeric value */ /* 0417 */
if SIGN( ARG(1) ) <> '-1' then /* 0418 */
sign_character = '' /* 0419 */
else /* 0420 */
sign_character = '-' /* 0421 */
absolute_value = ABS( ARG(1) ) /* 0422 */
/* 0423 */
/* test for and save decimal value indicator */ /* 0424 */
decimal_position = POS( decimal, absolute_value ) /* 0425 */
/* 0426 */
if decimal_position = 0 then /* 0427 */
source = RIGHT( absolute_value, LENGTH(e1) - 1 ) || ' ' /* 0428 */
else /* 0429 */
source = RIGHT( LEFT( absolute_value, decimal_position - 1 ), LENGTH(e1) - 1 ) || ' '
/* 0431 */
if decimal_position = 0 then /* 0432 */
edited_number =, /* 0433 */
STRIP( TRANSLATE( TRANSLATE( e2, source, e1), ',', ' '), 'B', ',')
else /* 0435 */
edited_number =, /* 0436 */
STRIP( TRANSLATE( TRANSLATE( e2, source, e1), ',', ' '), 'B', ','),
|| RIGHT( absolute_value,, /* 0438 */
LENGTH(absolute_value) - decimal_position + 1)
return sign_character || edited_number /* 0440 */
/* 0441 */
/*------------------------------------------------------------------------*\
| |
| Show precedence conflict in output listing |
| |
\*------------------------------------------------------------------------*/
LIST_SUPERCEDED_OCCURRENCES: /* 0447 */
Procedure expose, /* 0448 */
GBL., /* 0449 */
search_order_stem. /* 0450 */
/* 0451 */
parse arg search_order_subscript_list /* 0452 */
superceding_subscript = WORD( search_order_subscript_list, 1 ) /* 0453 */
/* 0454 */
parse value search_order_stem.superceding_subscript with, /* 0455 */
superceding_file_date, /* 0456 */
superceding_file_time, /* 0457 */
superceding_file_size, /* 0458 */
superceding_file_attr, /* 0459 */
superceding_file_name_ext /* 0460 */
superceding_file_name_ext = STRIP( superceding_file_name_ext ) /* 0461 */
/* 0462 */
output_line =, /* 0463 */
RIGHT( superceding_file_date , 8 ) || GBL.column_blanks ||,
RIGHT( superceding_file_time , 6 ) || GBL.column_blanks ||,
RIGHT( EDIT( superceding_file_size ), 10 ) || GBL.column_blanks ||,
superceding_file_name_ext || GBL.column_blanks ||, /* 0467 */
' supercedes:' /* 0468 */
call LINEOUT GBL.output_file, output_line /* 0469 */
GBL.output_line_count = GBL.output_line_count + 1 /* 0470 */
/* 0471 */
do sl = 2 to WORDS( search_order_subscript_list ) /* 0472 */
/* 0473 */
prior_subscript = WORD( search_order_subscript_list, sl ) /* 0474 */
parse value search_order_stem.prior_subscript with, /* 0475 */
prior_file_date, /* 0476 */
prior_file_time, /* 0477 */
prior_file_size, /* 0478 */
prior_file_attr, /* 0479 */
prior_file_name_ext /* 0480 */
prior_file_name_ext = STRIP( prior_file_name_ext ) /* 0481 */
/* 0482 */
output_line =, /* 0483 */
RIGHT( prior_file_date, 8 ) || GBL.column_blanks ||,
RIGHT( prior_file_time, 6 ) || GBL.column_blanks ||,
RIGHT( EDIT( prior_file_size ), 10 ) || GBL.column_blanks ||,
prior_file_name_ext /* 0487 */
call LINEOUT GBL.output_file, output_line /* 0488 */
GBL.output_line_count = GBL.output_line_count + 1 /* 0489 */
end /* 0490 */
/* 0491 */
call LINEOUT GBL.output_file, ' ' /* 0492 */
GBL.output_line_count = GBL.output_line_count + 1 /* 0493 */
/* 0494 */
return /* 0495 */
/* 0496 */
!tr! = VALUE('TRACE',,'OS2ENVIRONMENT'); if !tr! <> '' then do; TRACE(!tr!); nop; end
/*------------------------------------------------------------------------*\
| |
| End of Job |
| |
\*------------------------------------------------------------------------*/
EOJ: /* 0503 */
Procedure /* 0504 */
/* 0505 */
if ARG() = 0 then /* 0506 */
eoj_rc = 0 /* 0507 */
else /* 0508 */
eoj_rc = ARG(1) /* 0509 */
/* 0510 */
elapsed_time = TIME('E') /* get elapsed time - sssss.uuuuu */
parse value elapsed_time with seconds '.' micro_seconds /* 0512 */
if SUBSTR( micro_seconds, 1, 1 ) >= 5 then /* 0513 */
seconds = seconds + 1 /* 0514 */
ss = FORMAT( seconds // 60, 2 ) /* 0515 */
minutes = ( seconds - ss ) / 60 /* 0516 */
mm = FORMAT( minutes // 60, 2 ) /* 0517 */
hh = FORMAT( ( minutes - mm ) / 60, 2 ) /* 0518 */
duration = hh':'mm':'ss /* 0519 */
/* 0520 */
parse Source . . program_path_and_name /* 0521 */
program_name = TRANSLATE( FILESPEC( 'N', program_path_and_name ) )
say 'EOJ ' program_name 'at' TIME('N') ||, /* 0523 */
', duration' TRANSLATE( duration, '0', ' ' ) /* 0524 */
exit eoj_rc /* 0525 */
/* 0526 */
/*------------------------------------------------------------------------*\
| |
| Register external function routines |
| |
\*------------------------------------------------------------------------*/
REGISTER_REQUIRED_FUNCTIONS: /* 0532 */
Procedure expose REXX_Version /* 0533 */
/* 0534 */
/*----------------------------------------*\ /* 0535 */
| Load REXXUtil External Function Module | /* 0536 */
\*----------------------------------------*/ /* 0537 */
module = 'REXXUTIL' /* 0538 */
entry_name = 'SysLoadFuncs' /* 0539 */
function_name = 'SysLoadFuncs' /* 0540 */
anticipated_return = '' /* 0541 */
call REGISTER_ROUTINE function_name module entry_name anticipated_return
/* 0543 */
/*-----------------------------------*\ /* 0544 */
| Load the REXXLIB Function Package | /* 0545 */
\*-----------------------------------*/ /* 0546 */
if REXX_Version = 'REXX/Personal' then /* 0547 */
do /* 0548 */
module = 'qrexxlib' /* 0549 */
end /* 0550 */
else /* 0551 */
do /* 0552 */
module = 'rexxlib' /* 0553 */
end /* 0554 */
entry_name = 'rexxlibregister' /* 0555 */
function_name = 'RexxLibRegister' /* 0556 */
anticipated_return = '1' /* 0557 */
call REGISTER_ROUTINE function_name module entry_name anticipated_return
/* 0559 */
return /* 0560 */
/* 0561 */
/* 0562 */
/*---------------------*\ /* 0563 */
| Register Subroutine | /* 0564 */
\*---------------------*/ /* 0565 */
REGISTER_ROUTINE: /* 0566 */
Procedure /* 0567 */
/* 0568 */
parse ARG function_name, /* 0569 */
module, /* 0570 */
entry_name, /* 0571 */
anticipated_return /* 0572 */
/* 0573 */
if RxFuncQuery(function_name) = 0 then return /* function registered */
/* 0575 */
if LENGTH(module) > 8 then /* 0576 */
do /* 0577 */
dll_drive = FILESPEC( 'D', module ) /* 0578 */
dll_path = STRIP( FILESPEC( 'P', module ), 'T', '\' ) /* 0579 */
module = FILESPEC( 'N', module ) /* 0580 */
'@' || dll_drive /* 0581 */
'@cd' dll_drive || dll_path /* 0582 */
end /* 0583 */
else /* 0584 */
do /* 0585 */
dll_drive = '' /* 0586 */
end /* 0587 */
/* 0588 */
parse var module module_fname '.' module_fext /* 0589 */
if RxFuncAdd( function_name, module_fname, entry_name ) = 0 then /* 0590 */
do /* 0591 */
register_call = 'call' function_name /* 0592 */
interpret register_call /* 0593 */
if WORD( RESULT, 1 ) <> WORD( anticipated_return, 1 ) then /* 0594 */
do /* 0595 */
Say function_name 'returned' RESULT '-', /* 0596 */
anticipated_return 'was expected'
exit 255 /* 0598 */
end /* 0599 */
end /* 0600 */
else /* 0601 */
do /* 0602 */
Say 'RxFuncAdd returned' RESULT 'registering' module /* 0603 */
exit 254 /* 0604 */
end /* 0605 */
if dll_drive <> '' then /* 0606 */
do /* 0607 */
Parse Source . . program_path_and_name /* 0608 */
'@' || LEFT( program_path_and_name, 2 ) /* 0609 */
end /* 0610 */
return /* 0611 */
/* 0612 */
/*------------------------------------------------------------------------*\
| |
| Trap Routines |
| |
\*------------------------------------------------------------------------*/
ERROR: call TRAP_PROCESSING SIGL, 'ERROR', RC /* 0618 */
FAILURE: call TRAP_PROCESSING SIGL, 'FAILURE', RC /* 0619 */
HALT: call TRAP_PROCESSING SIGL, 'HALT', '' /* 0620 */
NOVALUE: call TRAP_PROCESSING SIGL, 'NOVALUE', '' /* 0621 */
SYNTAX: call TRAP_PROCESSING SIGL, 'SYNTAX', RC /* 0622 */
/* 0623 */
/* Rev. 94/06/14 */ /* 0624 */
TRAP_PROCESSING: /* 0625 */
parse Source . . TRAP.path_and_program /* 0626 */
if POS( ':', TRAP.path_and_program ) > 0 then /* 0627 */
/* get source line if it is available */ /* 0628 */
do /* 0629 */
trap_source_line = STRIP( SOURCELINE(ARG(1)) ) /* 0630 */
end /* 0631 */
else /* 0632 */
/* program is running in macrospace */ /* 0633 */
do /* 0634 */
TRAP.path_and_program = VALUE( 'TEMP',, 'OS2ENVIRONMENT' ) ||,
TRAP.path_and_program /* 0636 */
trap_source_line = 'Source line is not available.' /* 0637 */
end /* 0638 */
/* 0639 */
parse value FILESPEC( 'N', TRAP.path_and_program ) with, /* 0640 */
TRAP.fn '.' TRAP.fe /* 0641 */
trap_file_name = FILESPEC( 'D', TRAP.path_and_program ) ||, /* 0642 */
FILESPEC( 'P', TRAP.path_and_program ) ||, /* 0643 */
TRAP.fn || '.' || 'DMP' /* 0644 */
/* 0645 */
/*------------------------------------------*\ /* 0646 */
| check for reason not to create .DMP file | /* 0647 */
\*------------------------------------------*/ /* 0648 */
if ARG(2) = 'HALT' then /* 0649 */
do /* 0650 */
trap_file_name = '' /* 0651 */
end /* 0652 */
if RxFuncQuery( 'VARDUMP' ) <> 0 then /* 0653 */
do /* 0654 */
trap_file_name = '' /* 0655 */
end /* 0656 */
if POS( ':', trap_file_name ) = 0 then /* 0657 */
do /* 0658 */
trap_file_name = '' /* 0659 */
end /* 0660 */
/* 0661 */
/*------------------------*\ /* 0662 */
| Build trap message box | /* 0663 */
\*------------------------*/ /* 0664 */
dbl.h = 'CD'x /* ═ double line - horizontal */
dbl.v = 'BA'x /* ║ double line - vertical */
dbl.bl = 'C8'x /* ╚ double line - bottom left */
dbl.br = 'BC'x /* ╝ double line - bottom right */
dbl.tl = 'C9'x /* ╔ double line - top left */
dbl.tr = 'BB'x /* ╗ double line - top right */
say ' ' /* 0671 */
trap_error_description =, /* 0672 */
'Error line = ' || ARG(1) ||, /* 0673 */
'; ' ||, /* 0674 */
ARG(2) ||, /* 0675 */
' error.' /* 0676 */
if ARG(3) <> '' then /* 0677 */
trap_error_description = trap_error_description ||, /* 0678 */
' Return code = ' || ARG(3) /* 0679 */
say dbl.tl || COPIES( dbl.h, LENGTH(trap_error_description) + 2 ) || dbl.tr
say dbl.v || COPIES( ' ', LENGTH(trap_error_description) + 2 ) || dbl.v
say dbl.v CENTER( TRAP.fn || '.CMD', LENGTH(trap_error_description)) dbl.v
say dbl.v trap_error_description dbl.v
if trap_file_name <> '' then /* 0684 */
do /* 0685 */
say dbl.v || COPIES( ' ', LENGTH(trap_error_description) + 2 ) || dbl.v
say dbl.v CENTER( 'See: ' || trap_file_name,, /* 0687 */
LENGTH(trap_error_description) ) dbl.v
end /* 0689 */
say dbl.v || COPIES( ' ', LENGTH(trap_error_description) + 2 ) || dbl.v
say dbl.bl || COPIES( dbl.h, LENGTH(trap_error_description) + 2 ) || dbl.br
say ' ' /* 0692 */
say 'Source line at time of trap:' /* 0693 */
say ' ' || trap_source_line /* 0694 */
say ' ' /* 0695 */
/* 0696 */
/*---------------------------------*\ /* 0697 */
| Create .DMP file if appropriate | /* 0698 */
\*---------------------------------*/ /* 0699 */
if trap_file_name <> '' then /* 0700 */
do /* 0701 */
call SysFileDelete trap_file_name /* 0702 */
/* remove meaningless labels from dump for clarity */ /* 0703 */
drop dbl. TRAP. RC RESULT SIGL !tr! /* 0704 */
call VARDUMP trap_file_name /* write variables to program.DMP file */
end /* 0706 */
exit 254 /* 0707 */
/*--------- REXX Cross Reference - Created: 10/25/94 3:26pm ----------*\
---- VARIABLES ----
!tr! 0497< 0497 0497 0704
Calling_Environment
0036
GBL. 0038< 0449
GBL.column_blanks 0060< 0319 0320 0321 0322 0464 0465 0466
0467 0484 0485 0486
GBL.conflict_count 0061< 0287< 0287 0337 0339 0349
GBL.environment 0039<
GBL.output_file 0056< 0080< 0082 0088 0169 0190 0197 0204
0209 0212 0297 0324 0326 0331 0351 0469
0488 0492
GBL.output_line_count
0059< 0170< 0170 0198< 0198 0205< 0205 0210<
0210 0213< 0213 0298< 0298 0332< 0332 0470<
0470 0489< 0489 0493< 0493
GBL.program_name 0040< 0046 0054 0194
GBL.program_path 0041<
GBL.program_version
0043<
OS_Name 0035
RC 0618 0619 0622 0704
RESULT 0083 0086 0090 0594 0596 0603 0704
REXX_Version 0034 0533 0547
SIGL 0618 0619 0620 0621 0622 0704
TRAP. 0704
TRAP.fe 0641
TRAP.fn 0641 0644 0682
TRAP.path_and_program
0626 0627 0635< 0636 0640 0642 0643
Version 0034
absolute_value 0422< 0425 0428 0430 0438 0439
anticipated_return 0541< 0542 0557< 0558 0572 0594 0597
config_sys_file_area
0106< 0107< 0107 0114 0126 0135
config_sys_file_name
0096< 0098 0102 0106 0108 0118 0196
config_sys_file_size
0098< 0099 0106
dbl. 0704
dbl.bl 0667< 0691
dbl.br 0668< 0691
dbl.h 0665< 0680 0691
dbl.tl 0669< 0680
dbl.tr 0670< 0680
dbl.v 0666< 0681 0681 0682 0682 0683 0683 0686
0686 0687 0688 0690 0690
decimal 0404< 0425
decimal_position 0425< 0427 0430 0432 0439
dll_drive 0578< 0581 0582 0586< 0606
dll_path 0152 0153 0155< 0157 0162 0167 0179 0579<
0582
duration 0519< 0524
e1 0392 0394< 0428 0430 0434 0437
e2 0395< 0434 0437
edited_number 0433< 0436< 0440
elapsed_time 0511< 0512
entry_name 0539< 0542 0555< 0558 0571 0590
eoj_rc 0507< 0509< 0525
fe 0055
file_attr 0309
file_date 0306 0319
file_ext 0316
file_name 0316
file_path 0313< 0323
file_path_and_name 0310 0311< 0311 0313 0314 0315 0322
file_size 0308 0321
file_time 0307 0320
fn 0055 0058
function_name 0540< 0542 0556< 0558 0569 0574 0590 0592
0596
heading_1 0191< 0197 0203 0209 0296 0331
heading_2 0203< 0204
heading_3 0144< 0156< 0207 0209
heading_4 0296< 0297
hh 0518< 0519
index_list 0281< 0282 0283 0286
index_stem. 0220<
index_stem.ordered_file_name
0249 0251< 0251 0256< 0281
libpath_beg_pointer
0114< 0115 0124< 0124 0127 0136 0137
libpath_end_pointer
0125< 0128 0137
libpath_line 0135< 0145
libpath_search_arg 0113< 0114 0124
libpath_tokens 0145< 0150 0151 0152
micro_seconds 0512 0513
minutes 0516< 0517 0518
mm 0517< 0518 0519
module 0538< 0542 0549< 0553< 0558 0570 0576 0578
0579 0580< 0580 0589 0603
module_fext 0589
module_fname 0589 0590
ordered_file_attr 0228 0269
ordered_file_date 0225 0266
ordered_file_ext 0235 0276
ordered_file_name 0235 0276
ordered_file_path 0232< 0273<
ordered_file_path_and_name
0229 0230< 0230 0232 0233 0234 0243 0270
0271< 0271 0273 0274 0275
ordered_file_size 0227 0268
ordered_file_time 0226 0267
output_line 0166< 0169 0171 0200< 0203 0294< 0296 0318<
0324 0328< 0331 0463< 0469 0483< 0488
parameter_1 0066 0067 0069< 0069 0072 0078 0080
path_index. 0147<
path_index.dll_path
0176<
path_index.uppercase_dll_path
0164
path_table.0 0146< 0163 0175<
path_table.pt 0174<
prior_file_attr 0479
prior_file_date 0476 0484
prior_file_name_ext
0480 0481< 0481 0487
prior_file_size 0478 0486
prior_file_time 0477 0485
prior_subscript 0474<
program_name 0522< 0523
program_path_and_name
0037 0040 0041 0042 0521 0522 0608 0609
pt 0163< 0175 0176
register_call 0592< 0593
search_order_stem. 0450
search_order_stem.0
0148< 0183 0222 0263 0329
search_order_stem.prior_subscript
0475
search_order_stem.sos
0224 0265 0305
search_order_stem.superceding_subscript
0455
search_order_subscript_list
0452 0453 0472 0474
seconds 0512 0514< 0514 0515 0516
sign_character 0419< 0421< 0440
sl 0472 0474
sort_stem.0 0221< 0240 0241< 0300 0302
sort_stem.ss 0242< 0303
sos 0222 0244 0252 0256 0263 0283 0304
ss 0240< 0241 0302 0515< 0516 0519
superceding_file_attr
0459
superceding_file_date
0456 0464
superceding_file_name_ext
0460 0461< 0461 0467
superceding_file_size
0458 0466
superceding_file_time
0457 0465
superceding_subscript
0453<
temp_stem.0 0182
thousand 0407<
trap_error_description
0672< 0678< 0678 0680 0681 0682 0683 0686
0688 0690 0691
trap_file_name 0642< 0651< 0655< 0657 0659< 0684 0687 0700
0702 0705
trap_source_line 0630< 0637< 0694
uppercase_dll_path 0162< 0174
was_were 0341< 0345< 0348
with 0054 0151 0224 0234 0265 0275 0303 0305
0315 0455 0475 0512 0640
x 0113 0125 0169 0296 0331 0392 0394 0394
0395 0395 0395 0396 0396 0396 0397 0397
0397 0398 0398 0398 0399 0399 0399 0400
0400 0400 0401 0401 0401 0402 0402 0406
0409 0665 0666 0667 0668 0669 0670
---- LABELS ----
EDIT 0388:
EOJ 0076 0090 0104 0120 0131 0354 0503:
ERROR 0049 0618:
FAILURE 0619:
HALT 0050 0620:
LIST_SUPERCEDED_OCCURRENCES
0286 0447:
NOVALUE 0051 0391 0411 0621:
REGISTER_REQUIRED_FUNCTIONS
0047 0532:
REGISTER_ROUTINE 0542 0558 0566:
SYNTAX 0052 0622:
TRAP_PROCESSING 0618 0619 0620 0621 0622 0625:
---- FUNCTIONS ----
ABS 0422
ARG 0414 0418 0422 0506 0509 0630 0649 0673
0675 0677 0679
ARRAYCOPY 0183
ARRAYSORT 0300
CENTER 0203 0209 0296 0331 0682 0687
CHARIN 0106
COPIES 0060 0192 0193 0680 0681 0686 0690 0691
DATATYPE 0414
DATE 0192
DOSBOOTDRIVE 0096
DOSCD 0057 0155
DOSDRIVE 0056 0155
EDIT 0321 0329 0466 0486
FILESPEC 0040 0041 0042 0232 0233 0234 0243 0273
0274 0275 0313 0314 0315 0322 0522 0578
0579 0580 0640 0642 0643
FORMAT 0515 0517 0518
LEFT 0067 0243 0322 0392 0430 0609
LENGTH 0124 0203 0209 0296 0331 0428 0430 0439
0576 0680 0681 0682 0686 0688 0690 0691
LINEOUT 0169 0197 0204 0209 0212 0297 0324 0331
0469 0488 0492
POS 0114 0125 0425 0627 0657
RIGHT 0244 0319 0320 0321 0428 0430 0438 0464
0465 0466 0484 0485 0486
RxFuncAdd 0590
RxFuncQuery 0574 0653
SIGN 0418
SOURCELINE 0630
STREAM 0098 0108 0326
STRIP 0069 0230 0271 0311 0404 0407 0434 0437
0461 0481 0579 0630
SUBSTR 0135 0513
SysFileDelete 0082 0702
SysFileTree 0179
SysIni 0404 0407
TIME 0044 0046 0193 0511 0523
TRACE 0497
TRANSLATE 0046 0058 0107 0162 0194 0196 0434 0434
0437 0437 0522 0524
VALUE 0497 0635
VARDUMP 0705
WORD 0283 0453 0474 0594 0594
WORDS 0072 0282 0472
XRANGE 0394 0395 0396 0397 0398 0399 0400 0401
0402
\*------------------- End of REXX Cross Reference -------------------*/
