Rosetta Code

$ERR.REX: Difference between revisions

Page Discussion

$ERR.REX (view source)

Revision as of 14:10, 7 August 2023

6,138 bytes added ,  9 months ago
no edit summary
(added this program, it is a general purpose program to display specific error messages. -- ~~~~)
 
No edit summary
 
(8 intermediate revisions by 2 users not shown)
Line 1:
The <code>$ERR.REX</code> (REXX) program is used to issue various formatted error messages from other REXX programs.
<lang rexx>/**/trace o; parse arg !; if !all(arg()) then exit
if !cms then address ''
signal on halt; signal on novalue; signal on syntax
numeric digits 100
 
The <code>$ERR.REX</code> program makes use of the <code>$T.REX</code> program to issue the error messages in red (if available).
@ctty = 'CTTY' /*point to the CTTY cmd*/
@globalv = 'GLOBALV' /*point to the GLOBALV cmd*/
@finis = 'FINIS' /*point to the FINIS cmd*/
@subcom = 'SUBCOM' /*point to the SUBCOM cmd*/
@cpset = 'CP SET' /*point to the CP SET cmd*/
@conwait = 'CONWAIT' /*point to the CONWAIT cmd*/
@cpspool = 'CP SPOOL' /*point to the CP SPOOL cmd*/
@cmstype = 'SET CMSTYPE' /*point to SET CMSTYPE cmd*/
 
The help for the <code>$ERR</code> REXX program is included here ──► [[$ERR.HEL]].
if !cms |!dos then @ = '────────'
<syntaxhighlight lang="rexx">
else @ = '--------'
/*REXX program to display error or informational messages (in color, if supported). */
 
trace off /*turn off all REXX cmd error messages.*/
parse var !! !! ' ..F=' ftops
if ftops\=='' then ftops='.F='ftops
etops=strip(ftops '.C=red .END=1')
g.1=space(!!)
pblank='05'x /*use pseudoblank as blank.*/
 
parse arg ! /*obtain the original arguments. */
do j=2 to 9
k=j-1
parse var g.k a.k g.j
if a.k==',' then a.k=
g.k=translate(g.k,,pblank)
a.k=translate(a.k,,pblank)
aU.k=a.k; upper aU.k
L.k=length(a.k)
c.k=comma(a.k)
w.k=length(c.k)
end /*j*/
 
if !all( arg() ) then exit /*Request for help? Display, then exit*/
a2=a.2; a3=a.3; a4=a.4; a5=a.5; a6=a.6; a7=a.7; a8=a.8
if !cms g3=g.3; then address '' g4=g.4; g5=g.5; g6=g.6; g7=g.7; /*handle g8=g ADDRESS for CMS.8 */
 
aa5=a.5
signal on halt /*be able to handle the halting of pgm.*/
if isnum(aa5) then aa5=abs(aa5)
signal on noValue /* " " " " undefined variables*/
i=a.1
signal on syntax /* " " " " pgm syntax errors.*/
 
numeric digits 100 /*what the hell, support big numbers. */
/*══════ a list of external commands. */
@ctty = 'CTTY' /*point to the CTTY command. */
@globalv = 'GLOBALV' /* " " " GLOBALV " */
@finis = 'FINIS' /* " " " FINIS " */
@subcom = 'SUBCOM' /* " " " CMS SUBCOM " */
@cpset = 'CP SET' /* " " " CP SET " */
@conwait = 'CONWAIT' /* " " " CONWAIT " */
@cpspool = 'CP SPOOL' /* " " " CP SPOOL " */
@cmstype = 'SET CMSTYPE' /* " " " SET CMSTYPE " */
 
if !cms | !dos then @ = '────────' /*use hyphens for dashes in messages. */
else @ = '--------' /* " minuses " " " " */
 
parse var !! !! ' ..F=' ftops /*is $ERR to write errors to file? */
if ftops\=='' then ftops= '.F='ftops /*Yes, then add to FTOPS variable. */
etops= strip(ftops '.C=red .END=1') /*also, add it to the ETOPS variable.*/
g.1= space(!!) /*a version with no extra blanks. */
pblank= '05'x /*use pseudoBlank as the "true" blank*/
 
do j=2 to 9 /*process some possible shortcuts. */
k= j - 1 /*point to the previous variable. */
parse var g.k a.k g.j /*get the "G" version (equals "all").*/
if a.k==',' then a.k= /*if omitted, then use a null. */
g.k= translate(g.k, , pblank) /*translate to a true blank. */
a.k= translate(a.k, , pblank) /* " " " " " */
aU.k= a.k
upper aU.k /*get an uppercase version of a.k */
L.k= length(a.k) /*get the length of the a.k variable.*/
c.k= comma(a.k) /*add a comma (,) to the number. */
w.k= length(c.k) /*get the length of commatized number. */
end /*j*/
/* [↓] shortcut versions of a. */
a2= a.2; a3= a.3; a4= a.4; a5= a.5; a6= a.6; a7= a.7; a8= a.8
g3= g.3; g4= g.4; g5= g.5; g6= g.6; g7= g.7; g8= g.8
aa5= a.5
if isNum(aa5) then aa5= abs(aa5) /*if it's a number, then use ABS value.*/
i= a.1 /*this is the error number. */
errmsgto=
errmsgnt=
xedit= 0 /*indicate no XEDIT (so far). */
xedit=0
 
if !cms then do /*if CMS, then do some housework first.*/
if !cms then do
@globalv 'SELECT' !fn ' "GET ERRMSGTO ERRMSGNT'"
@finis '* * *' /*close all open files. */
@cmstype 'RT' /*ensure the user sees the error msgs. */
@conwait /*wait for all messages to be written. */
@cpspool 'CON TERM' /*ensure user sees the error messages. */
@cpset' IMSG ON' /* " " " informational msgs. */
@cpset' EMSG ON' /* " " " error " */
@subcom 'XEDIT' /*see if executing under XEDIT. */
xedit= \rc & \cmsflag('SUBSET') /*set flag: running under XEDIT |SUBSET*/
ufid= a3 a4 a5 /*maybe obtain a fileID for a message. */
end
 
if !dos then do /*if DOS, then perform some housework.*/
if !dos then do
if \!nt then @ctty 'con' /*Not Windows NT? Then use CTTY cmd.*/
_= a4
if _\=='' & right(_,1)\=="\" then _= _'\'
ufid= _ || a2"'."'a3
end
 
i= space( translate(i, , '-'), 0) /*remove all minus signs from string. */
if i=='' then call erb 57 /*Is it null? Than an oops-say message*/
 
if i=0 then do /*if "error" is zero, show the author. */
if i=0 then do
_= /*now, start with a clean slate. */
_=
iL= length(i) /*use number of zeroes for more info. */
if iL>1 then _= @'author'@"÷÷÷÷Gerard J. Schildberger"
if iL>2 then _= _ '÷÷phone (701)-242-8238'
if iL>3 then _= _ '÷÷E-mail gerardS@rrt.net'
if iL>5 then _= _ '÷÷9411 West Ridge Road,'
if iL>5 then _= _ '÷÷Hankinson, ND 58041'
atops= strip(ftops '.A=-2 .X=-2 .E=2 .C=yell .J=c .BOX= .KD=÷')
if _\=='' then call $t atops _ /*tell if more info if than one zero.*/
exit 0 /*exit with a return code of zero. */
end
 
if i==14000 |, /*is this a message for a HALT ? */
if i==14000 |,
i=='14.1' then do /* ··· or in some cases, 14.1 error. */
htops= strip(ftops '.A=-1 .X=-1 .E=1 .C=red .J=c .BOX=')
call $t htops 'The REXX program' @ a2 @ "has been halted !"
exit 14000 /* ··· and indicate a HALT condition*/
end
 
if \isint(i) then call erb 53,i "error_code"
oi=i
xedit= xedit & oi>0
i=abs(i)
if i<1400 | i>1499 then call erb 99,oi
k=i-1400
if xedit then address 'XEDIT' "SET MSGM ON LONG"
call sy
call sy "($$$"i") *error*:"
 
if \isInt(i) k==0 then call syerb 53,i "error_code"some commands can't or shouldn't/*Hmmm, bewe executedgot whilean in"internal" pgm g3error.*/
oi= i /*keep the original error number around*/
if k==1 then call sy "the" g3 'was previously specified or specified more than once'
xedit= (xedit & i>0) /*inside the XEDIT program? */
if k==2 then call sy "the" a4 "argument can't be" choose("negative",g5)":" a3
i= abs(i) /*use the absolute value of I. */
if k==3 then call sy 'the (disk) filemode' a3 "can't have any read-only extensions" g4
if i<1400 | i>1499 then call erb 99,oi /*check for a legal range of I. */
if k==4 then call sy 'the' a4 "filemode/address can't be" choose('RELEASEd',g5)":" a3
k= i - 1400 /*from now on, use a shorter I. */
if k==5 then do;call sy "illegal compator operator" @ a3 'specified,';call sy "it must be one of: = \= < <= > >= \< \>";end
if xedit then address 'XEDIT' "SET MSGM ON LONG" /*allow XEDIT messages to be seen. */
if k==6 then call sy "no special characters are allowed in the" g4':' a3
call sy /*display a blank line for the eyeballs*/
if k==7 then call sy "fixed-point underflow or overflow (result is too small or too large)"
call sy '($$$'i") *error*:" /*write a header line (before the msg).*/
if k==8 then call sy "illegal filemode" @ a3 @ g4
 
if k==9 then call sy "a terminal screen (CRT) is required with the" @ a3 @ 'feature'
/*now, display the error message(s). */
if k==10 then if a3=='' then call sy "missing fileid for" g4
 
else call sy "illegal fileid" @ space(a3 a4 a5) @ g6
 
if k==11 then call sy "comparand operand must be an = or \= when using *xxx* type comparisons"
 
if k==12 then call sy "not enough" choose('virtual storage',g4)", at least" a3 'are needed'
if k==13 0 then do;call sy "REXXsome syntaxcommands error";ifcan't isint(a.6)or thenshouldn't callbe syexecuted while in" errortext(a.6);call syline;endg3
 
if k==14 then call sy 'the' a5 "argument" a3 "can't be" choose('greater',a.7) "than" a6 a4
if k==15 then1 do;if a3=='' then call sy "divisionthe" by zero"g3 'was previously specified or specified more than once'
 
else do;call sy 'raising a negative number' @ a3 @;call sy "to a negative or an odd fractional power" @ a4 @;call fto g5;end;end
if k== 2 then call sy "the" a4 "argument can't be" choose("negative", g5)":" a3
if k==16 then do;call sy "illegal MDISK" g4 'address:' a3",";call sy 'it must be exactly three hexadecimal characters (but not 000), or it may be';call sy "preceeded by an asterisk (*) followed by three decimal characters";end
 
if k==17 then do;call sy "undefined REXX variable referenced" a.6;call syline;end
if k== 3 then call sy 'the (disk) filemode' a3 "can't have any read-only extensions" g4
if k==18 then do;call sy "illegal MDISK address or filemode,";call sy "the 191 A MDISK address is reserved for the CMS user's private MDISK";end
 
if k==19 then call sy 'numeric digits ('comma(a6)") isn't sufficient to" a4 a5 'to' a3
if k==20 4 then call sy "'the"' a3 @ a4 'and' g5 @ "arenfilemode/address can't alikebe" choose('RELEASEd',g5)":" a3
 
if k==21 then call sy choose("increment",a3) 'must be preceeded by a plus (+) or a minus (-)'
if k== 5 then do
if k==22 then do;_='combination of characters:';if L.4==1 then _="character:";call sy a3 'contains an invalid' _ g4;end
call sy "illegal comparator operator" @ a3 'specified,'
if k==23 then call sy "the" a3 choose("option",a5) "requires the" a4 choose('option or feature',g6)
call sy "it must be one of: = \= < <= > >= \< \>"
if k==24 then call sy "illegal" choose('volume',a4) "serial:" a3 ' (it must be six or less characters)'
end
if k==25 then do;call sy "you must be in the" a3 'mode/program to use the';call sy "specified command (or its" g4 "option)";end
 
if k==26 then do;call sy "illegal MDISK" g4 'address:' a3",";call sy 'it must be exactly three hexadecimal characters (but not 000)';end
if k==27 6 then call sy choose('number',g4) "can'tno bespecial negativecharacters orare zeroallowed (mustin bethe" positive)g4':"' a3
 
if k==28 then call sy "duplicate" a3 'defined or specified:' g4
if k==29 7 then call sy "illegalfixed-point filemode:"underflow a3',or itoverflow must be(result oneis character'too small or too large)"
 
if k==30 then do;call say30;if a5==a6|a6==''|a6=="," then call sy "it must be" space(aa5 g8 _b)
if k== 8 then call sy "illegal filemode" @ a3 @ g4
else do;_to='to';if a6==aa5+1 then _to="or";call sy 'it must be from' aa5 _to a6 _b;end;end
 
if k==31 then call sy "no lines (or incorrect lines) were put in the program stack" g3
if k==32 9 then call sy 'the"a command'terminal a3screen (CRT) is required with the"exited, but it@ isn't supposeda3 to exit@ or stop"'feature'
 
if k==33 then call sy 'the' a3 "MDISK isn't a CMS MDISK, it's in the wrong format"
if k==3410 then callif sya3=='' @ a3then a4call @sy "can't be executedmissing fromfileid thefor" a5 'MDISK'g4
else call sy "illegal fileid" @ space(a3 a4 a5) @ g6
if k==35 then do;call sy "no" choose('argument',a4) 'was specified after or';call fto a3 g5;end
 
if k==36 then call sy 'file' @ g3 @ "can't exist on the" a5 'MDISK'
if k==11 then call sy "comparand operand must be an = or \= when using *xxx* type comparisons"
if k==37 then do;y=a3;_=pos(a3,'''"`{[(«');if _\==0 then y=translate(word('single_quote double_quote grave_accent left_brace left_bracket left_parenthesis left_double_carrot',_),,"_") a3;call sy 'unmatched' y g4;end
 
if k==38 then call sy 'file' @ space(a3 a4 a5) @ choose("can't be located or is empty",g6)
if k==3912 then call sy "thenot enough" a3 choose('argumentvirtual storage',a8 g4)", 'mustat be'least" a4 a5a3 "the" a6'are choose(needed'argument',a7)
 
if k==40 then do;call sy 'argument' @ a3 @ "isn't a valid hexadecimal string/number";call sy "(it contains a character other than 0123456789ABCDEFabcdef or a blank)";call fto g4;end
if k==13 then do
if k==41 then do;call sy "VM userid" @ g3 @ "doesn't exist or";call sy 'is illegal (it may have an illegal character in it)';end
call sy "REXX syntax error"
if k==42 then call sy "the MDISK" a4 'for the user' a3 "doesn't exist"
if isInt(a.6) then call sy errortext(a.6)
if k==43 then call sy "illegal password for the" a3 a5 'MDISK was specified'
call syline
if k==44 then do;call sy "a CMS command is being used out of context, or";call sy 'a command was renamed, or the FSTs have been altered';_='DOS';if cms then _="CMS";call sy '(you may have to IPL' _")";end
end
if k==45 then call sy 'VM userid' @ g3 @ "isn't logged on"
 
if k==46 then call sy "the file's" @ g4 "LRECL can't exceed" a3
if k==4714 then call sy a3'the' @ a4a5 @ "notargument" a3 found"can't g5be" choose('greater',a.7) "than" a6 a4
 
if k==48 then do;_=;L=1;if L.4==1|right(aU.4,1)=='X' then _=" an";if _=='' then L=0;call sy @ a3 g5 @ 'contains'_ "invalid character"s(L)':' a4;end
if k==15 then do
if k==49 then call sy "CP LINK error for MDISK" a4 'userid' a3
if ka3==50'' then do;call sy 'illegal/invalid' a3 "specified"division @by a4 @;call fto g5;endzero"
else do
if k==51 then call sy choose("documentation",a5) 'for' a3 a4 "couldn't be located"
call sy 'raising a negative number' @ a3 @
if k==52 then do;call sy "arguments aren't permitted";call fto a4;end
call sy "to a negative or an odd fractional power" @ a4 @
if k==53 then do;call sy 'argument' @ a3 @ "isn't numeric" g5;call fto a4;end
call fto g5
if k==54 then do;call sy "not enough" choose('arguments',a3) "were specified" g5;call fto a4;end
end
if k==55 then do;call sy "illegal argument" @ a3 @ g5;call fto a4;end
end
if k==56 then call sy "illegal number of" choose('arguments',a4) "were specified" g5 a3
 
if k==57 then do;y=choose("arguments",a3);z='was';if translate(right(y,1))=="S" then z='were';call sy "no" y z "specified";end
if k==16 then do
if k==58 then call sy "only" g3 'argument's(a3) 'are accepted'
call sy "illegal MDISK" g4 'address:' a3","
if k==59 then do;call sy "too many" choose('arguments',a3) "were specified" g5;call fto a4;end
call sy 'it must be exactly three hexadecimal characters (but not 000), or it may be'
if k==60 then call sy "argument#" a4 @ a3 @ 'must be an * or numeric'
call sy "preceded by an asterisk (*) followed by three decimal characters"
if k==61 then call sy "conflicting arguments:" g3
end
if k==62 then call sy choose('fileid1',a3) "and" choose('fileid2',a4) "can't be identical" g5
 
if k==63 then do;call sy "no" 'argument was specified after or';call fto g3;end
if k==17 then do
if k==64 then call sy "up to" g3 'argument's(a3) 'are accepted'
call sy "undefined REXX variable referenced" a.6
if k==65 then call sy "bad argument" @ a3 @ "illegal use of" g4
call syline
if k==66 then call sy "only" a3 'to' a4 "arguments are accepted"
end
if k==67 then call sy "unable to parse" a3 'from the results of:' g4
 
if k==68 then do;call sy "return code" a3 'doing:';call sy g4;i=a3;end
if k==18 then do
if k==69 then call sy 'user' @ a3 @ "can't be logged on while the command" @ a2 @ 'is running'
call sy "illegal MDISK address or filemode,"
if k==70 then do;if a3==2 then call sy "the" @ a2 @ 'command must be executed under the' a4 "userid";if a3==1 then call sy "the" @ a2 @ "command must be executed from the A MDISK";call sy "illegal use of the" @ a2 @ "command, subrc="a3;end
call sy "the 191 A MDISK address is reserved for the CMS user's private MDISK"
if k==71 then call sy "can't attach a" g3
end
if k==72 then do;call sy 'argument' @ a3 @ "isn't alphabetic" g5;call fto a4;end
 
if k==73 then do;call sy "an attempt was made to execute an unauthorized or restricted command";if g3\=='' then call sy g3;end
if k==7419 then call sy 'numeric digits ('comma(a6)"the) isn't sufficient userto" @ a3a4 @ 'musta5 be in'to' a4 "mode"a3
 
if k==75 then call sy "no" choose('write',a4) "access to the" @ choose('A',space(left(a3),1)) @ "MDISK"
if k==7620 then call sy "the" a3 g5 "isn@ a4 'and't known org5 @ supported:"aren't a4alike"
 
if k==77 then call sy space('error' a3 "in writing to disk file" @ g4 @)
if k==7821 then call sy choose("fileincrement",g6a3) @'must a3be a4preceded a5by @a 'notplus found(+) or a minus (-)'
 
if k==79 then call sy "the time window for execution is" a3 'through' a4
if k==8022 then call sy @ a3 @ "isn't a known userid"do
_= 'combination of characters:'
if k==81 then do;call sy 'argument' @ a5 space(@ g7) "is out of range";_=max(w.3,w.4);if L.3\==0 then call sy 'the lower limit is:' right(c.3,_);if L.4\==0 then call sy 'the upper limit is:' right(c.4,_);call fto a6;end
if L.4==1 then _="character:"
if k==82 then call sy g4 @ a3 @ "can't be located"
call sy a3 'contains an invalid' _ g4
if k==83 then call sy "the" @ g3 @ 'option is required'
if k==84 then call sy "file" @ g4 @ 'had a syntax error for' a3 end
 
if k==85 then call sy "illegal combination of arguments:" g4
if k==8623 then do;call sy "the" a3 choose(a3"option",a2a5) 'command"requires is being invokedthe" outa4 of contextchoose(';ifoption g4\=='' thenor call sy g4;endfeature',g6)
 
if k==87 then do;call sy 'argument' @ a3 @ "isn't a valid" choose('bit digit',a4);call sy '(it contains more than one binary digit)';call fto g5;end
if k==8824 then call sy g4"illegal" @choose('volume',a4) "serial:" a3 @ "doesn't exist"(it must be six or less characters)'
 
if k==89 then call sy 'the' a3 "command can't be found"
if k==25 then do
if k==90 then do;call sy 'evaluation of' a3 "contains a zero divisor and";call sy 'the result is infinite' g4;end
call sy "you must be in the" a3 'mode/program to use the'
if k==91 then do;call sy 'argument' @ a3 @ "isn't a valid" choose('bit string',a4);call sy '(it contains a non-binary character other than 0 or 1)';call fto g5;end
call sy "specified command (or it's" g4 "option)"
if k==92 then do;call sy choose('argument',a4) @ a3 @ "isn't a whole number (integer)" g7;call fto a5;end
end
if k==93 then call sy "file" @ g3 @ 'already exists'
 
if k==94 then call sy "the T-DISK requested can't be obtained"
if k==26 then do
if k==95 then call sy "not enough free storage can be obtained"
if k==96 then call sy "illegal fileMDISK" @g4 g3 @ 'or it was incorrectly modifiedaddress:' a3","
call sy 'it must be exactly three hexadecimal characters (but not 000)'
if k==97 then do;call sy "a command failed,";if a3 \=='' then call sy "sub-command" @ g3 @',';call sy "it's all or partially restricted to authorized users";end
end
if k==98 then do;call sy "an attempt was made to execute the" @ a2 @ 'command while';call sy "the user" @ userid() @ "was in disconnected mode";end
 
if k==99 then call sy "illegal error number for the" !fn 'REXX EXEC' ":" g3
if a2\k==''27 then call sy "forchoose('number',g4) the"can't @be a2negative @or 'commandzero or(must function.'be positive):" a3
 
if k==28 then call sy "duplicate" a3 'defined or specified:' g4
 
if k==29 then call sy "illegal filemode:" a3', it must be one character'
 
if k==30 then do
call say30
if a5==a6 | a6=='' | a6=="," then call sy "it must be" space(aa5 g8 _b)
else do
_to= 'to'
if a6==aa5+1 then _to= "or"
call sy 'it must be from' aa5 _to a6 _b
end
end
 
if k==31 then call sy "no lines (or incorrect lines) were put in the program stack" g3
 
if k==32 then call sy 'the command' a3 "exited, but it isn't supposed to exit or stop"
 
if k==33 then call sy 'the' a3 "MDISK isn't a CMS MDISK, it's in the wrong format"
 
if k==34 then call sy @ a3 a4 @ "can't be executed from the" a5 'MDISK'
 
if k==35 then do
call sy "no" choose('argument', a4) 'was specified after or'
call fto a3 g5
end
 
if k==36 then call sy 'file' @ g3 @ "can't exist on the" a5 'MDISK'
 
if k==37 then do
y= a3
_= pos(a3,'''"`{[(«')
if _\==0 then y=translate(word('single_quote double_quote grave_accent left_brace left_bracket left_parenthesis left_double_carrot',_),,"_") a3
call sy 'unmatched' y g4
end
 
if k==38 then call sy 'file' @ space(a3 a4 a5) @ choose("can't be located or is empty",g6)
 
if k==39 then call sy "the" a3 choose('argument',a8) 'must be' a4 a5 "the" a6 choose('argument',a7)
 
if k==40 then do
call sy 'argument' @ a3 @ "isn't a valid hexadecimal string/number"
call sy "(it contains a character other than 0123456789ABCDEFabcdef or a blank)"
call fto g4
end
 
if k==41 then do
call sy "VM userid" @ g3 @ "doesn't exist or"
call sy 'is illegal (it may have an illegal character in it)'
end
 
if k==42 then call sy "the MDISK" a4 'for the user' a3 "doesn't exist"
 
if k==43 then call sy "illegal password for the" a3 a5 'MDISK was specified'
 
if k==44 then do
call sy "a CMS command is being used out of context, or"
call sy 'a command was renamed, or the FSTs have been altered'
_= 'DOS'
if !cms then _="CMS"
call sy '(you may have to IPL' _")"
end
 
if k==45 then call sy 'VM userid' @ g3 @ "isn't logged on"
 
if k==46 then call sy "the file's" @ g4 "LRECL can't exceed" a3
 
if k==47 then call sy a3 @ a4 @ "not found" g5
 
if k==48 then do
_=
L= 1
if L.4==1 | right(aU.4,1)=='X' then _= " an"
if _=='' then L= 0
call sy @ a3 g5 @ 'contains'_ "invalid character"s(L)':' a4
end
 
if k==49 then call sy "CP LINK error for MDISK" a4 'userid' a3
 
if k==50 then do
call sy 'illegal/invalid' a3 "specified" @ a4 @
call fto g5
end
 
if k==51 then call sy choose("documentation", a5) 'for' a3 a4 "couldn't be located"
 
if k==52 then do
call sy "arguments aren't permitted"
call fto a4
end
 
if k==53 then do
call sy 'argument' @ a3 @ "isn't numeric" g5
call fto a4
end
 
if k==54 then do
call sy "not enough" choose('arguments',a3) "were specified" g5
call fto a4
end
 
if k==55 then do
call sy "illegal argument" @ a3 @ g5
call fto a4
end
 
if k==56 then call sy "illegal number of" choose('arguments',a4) "were specified" g5 a3
 
if k==57 then do
y= choose("arguments", a3)
z= 'was'
if translate(right(y,1))=="S" then z= 'were'
call sy "no" y z "specified"
end
 
if k==58 then call sy "only" g3 'argument's(a3) 'are accepted'
 
if k==59 then do
call sy "too many" choose('arguments',a3) "were specified" g5
call fto a4
end
 
if k==60 then call sy "argument#" a4 @ a3 @ 'must be an * or numeric'
 
if k==61 then call sy "conflicting arguments:" g3
 
if k==62 then call sy choose('fileid1',a3) "and" choose('fileid2',a4) "can't be identical" g5
 
if k==63 then do
call sy "no" 'argument was specified after or'
call fto g3
end
 
if k==64 then call sy "up to" g3 'argument's(a3) 'are accepted'
 
if k==65 then call sy "bad argument" @ a3 @ "illegal use of" g4
 
if k==66 then call sy "only" a3 'to' a4 "arguments are accepted"
 
if k==67 then call sy "unable to parse" a3 'from the results of:' g4
 
if k==68 then do
call sy "return code" a3 'doing:'
call sy g4
i= a3
end
 
if k==69 then call sy 'user' @ a3 @ "can't be logged on while the command" @ a2 @ 'is running'
 
if k==70 then do
if a3==2 then call sy "the" @ a2 @ 'command must be executed under the' a4 "userid"
if a3==1 then call sy "the" @ a2 @ "command must be executed from the A MDISK"
call sy "illegal use of the" @ a2 @ "command, subrc="a3
end
 
if k==71 then call sy "can't attach a" g3
 
if k==72 then do
call sy 'argument' @ a3 @ "isn't alphabetic" g5
call fto a4
end
 
if k==73 then do
call sy "an attempt was made to execute an unauthorized or restricted command"
if g3\=='' then call sy g3
end
 
if k==74 then call sy "the user" @ a3 @ 'must be in' a4 "mode"
 
if k==75 then call sy "no" choose('write',a4) "access to the" @ choose('A',space(left(a3),1)) @ "MDISK"
 
if k==76 then call sy a3 g5 "isn't known or supported:" a4
 
if k==77 then call sy space('error' a3 "in writing to disk file" @ g4 @)
 
if k==78 then call sy choose("file", g6) @ a3 a4 a5 @ 'not found'
 
if k==79 then call sy "the time window for execution is" a3 'through' a4
 
if k==80 then call sy @ a3 @ "isn't a known userid"
 
if k==81 then do
call sy 'argument' @ a5 space(@ g7) "is out of range"
_= max(w.3, w.4)
if L.3\==0 then call sy 'the lower limit is:' right(c.3, _)
if L.4\==0 then call sy 'the upper limit is:' right(c.4, _)
call fto a6
end
 
if k==82 then call sy g4 @ a3 @ "can't be located"
 
if k==83 then call sy "the" @ g3 @ 'option is required'
 
if k==84 then call sy "file" @ g4 @ 'had a syntax error for' a3
 
if k==85 then call sy "illegal combination of arguments:" g4
 
if k==86 then do
call sy "the" choose(a3,a2) 'command is being invoked out of context'
if g4\=='' then call sy g4
end
 
if k==87 then do
call sy 'argument' @ a3 @ "isn't a valid" choose('bit digit',a4)
call sy '(it contains more than one binary digit)'
call fto g5
end
 
if k==88 then call sy g4 @ a3 @ "doesn't exist"
 
if k==89 then call sy 'the' a3 "command can't be found"
 
if k==90 then do
call sy 'evaluation of' a3 "contains a zero divisor and"
call sy 'the result is infinite' g4
end
 
if k==91 then do
call sy 'argument' @ a3 @ "isn't a valid" choose('bit string',a4)
call sy '(it contains a non-binary character other than 0 or 1)'
call fto g5
end
 
if k==92 then do
call sy choose('argument',a4) @ a3 @ "isn't a whole number (integer)" g7
call fto a5
end
 
if k==93 then call sy "file" @ g3 @ 'already exists'
 
if k==94 then call sy "the T-DISK requested can't be obtained"
 
if k==95 then call sy "not enough free storage can be obtained"
 
if k==96 then call sy "illegal file" @ g3 @ 'or it was incorrectly modified'
 
if k==97 then do
call sy "a command failed,"
if a3\=='' then call sy "sub-command" @ g3 @','
call sy "it's all or partially restricted to authorized users"
end
 
if k==98 then do
call sy "an attempt was made to execute the" @ a2 @ 'command while'
call sy "the user" @ userid() @ "was in disconnected mode"
end
 
if k==99 then call sy "illegal error number for the" !fn 'REXX EXEC' ":" g3
 
 
 
if a2\=='' then call sy "for the" @ a2 @ 'command or function.'
call sy
if errmsgnt\=='' & errmsgto\==''"" then call sy " 'A notification (via $M) of this error has been sent to"' errmsgto
if !cms then @globalv 'SELECT' !fn "PURGE"
if \isintisInt(i) then call er 53, i
exit sign(oi)*i
 
/*──────────────────────────────────DCHARS subroutine───────────────────*/
dchars: chr.=
_='¶'; chr._='paragraph_mark'
_='§'; chr._='section_mark'
_='!'; chr._='exclaimation_point'
_='"'; chr._='double_quote'
_='#'; chr._='pound_or_hash_mark'
_='$'; chr._='dollar_sign'
_='%'; chr._='percent_sign'
_='&'; chr._='ampersand'
_="'"; chr._='single_quote'
_='('; chr._='left_parenthesis'
_=')'; chr._='right_parenthesis'
_='*'; chr._='asterisk'
_='+'; chr._='plus_sign'
_=','; chr._='comma'
_='-'; chr._='minus_sign'
_='.'; chr._='period'
_='/'; chr._='slash'
_=':'; chr._='colon'
_='; ';chr._='semi-colon'
_='<'; chr._='less-than'
_='='; chr._='equal_sign'
_='>'; chr._='greater-than'
_='?'; chr._='question_mark'
_='@'; chr._='commercial_at'
_='['; chr._='left_bracket'
_='\'; chr._='backslash'
_=']'; chr._='right_bracket'
_='^'; chr._='circumflex'
_='_'; chr._='underscore'
_='`'; chr._='grace_accent'
_='{'; chr._='left_brace'
_='|'; chr._='OR-or-pipe'
_='}'; chr._='right_brace'
_='~'; chr._='tilde'
_='¢'; chr._='cent_sign'
_='£'; chr._='pound_sign'
_='¥'; chr._='yen_sign'
_='₧'; chr._='peseta_sign'
_='ƒ'; chr._='franc_sign'
_='¿'; chr._='inverted_question_mark'
_='¬'; chr._='not_sign'
_='¡'; chr._='inverted_exclaimation_point'
_='«'; chr._='left_guillemet'
_='»'; chr._='right_guillemet'
_='─'; chr._='dash_or_hyphen'
_='±'; chr._='plus_or_minus'
_='≥'; chr._='greater_then_or_equal_to'
_='≤'; chr._='less_then_or_equal_to'
_='÷'; chr._='divison'
_='°'; chr._='degree'
_='∙'; chr._='bullet'
_='√'; chr._='radical'
return
 
/*─────────────────────────────general 1-line subs────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
/*═════════════════════════════general 1-line subs════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/
!all: !!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='"NT'";!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'"? ?SAMPLES ?AUTHOR ?FLOW'")==0 then return 0;!call=']$H';call '"$H'" !fn !;!call=;return 1
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call
!env: !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo then !env='SYSTEM'; if !os2 then !env='OS2'!env; !ebcdic=13=='f0f3'x; if !crx then !env='DOS'; return
!fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .; call !sys; if !dos then do; _=lastpos('\',!fn); !fm=left(!fn,_); !fn=substr(!fn,_+1); parse var !fn !fn '.' !ft; end; return word(0 !fn !ft !fm,1+('0'arg(1)))
!rex: parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx='KEXX'==!ver; !pcrexx='REXX/PERSONAL'==!ver|'REXX/PC'==!ver; !r4='REXX-R4'==!ver; !regina='REXX-REGINA'==left(!ver,11); !roo='REXX-ROO'==!ver; call !env; return
!sys: !cms=!sys=='CMS'; !os2=!sys=='OS2'; !tso=!sys=='TSO' | !sys=='MVS'; !vse=!sys=='VSE'; !dos=pos('DOS',!sys)\==0 | pos('WIN',!sys)\==0 | !sys=='CMD'; !crx=left(!sys,6)=='DOSCRX'; call !rex; return
!var: call !fid; if !kexx then return space(dosenv(arg(1))); return space(value(arg(1),,!env))
$t: !call=']$T'; call "$T" arg(1); call=; return
choose: parse arg c1,c2; if c2=='' | c2=="," then return c1; else return c2
comma: procedure; parse arg _,c,p,t; c=pickblankpickBlank(c,","); o=p(p 3); p=abs(o); t=p(t 999999999); if \isintisInt(p) | \isintisInt(t) | p==0 | arg()>4 then return _; n=_'.9'; #=123456789; k=0; return comma_()
comma_: if o<0 then do; b=verify(_,' '); if b==0 then return _; e=length(_)-verify(reverse(_),' ')+1; end; else do; b=verify(n,#,"M"); e=verify(n,#'0',,verify(n,#"0.",'M'))-p-1; end; do j=e to b by -p while k<t; _=insert(c,_,j); k=k+1;end;return _
er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2; if _1<0 then return _1; exit result
erb: call sy; if a2\=="" then call sy '('!fn "was invoked by the" @ a2 @ 'EXEC)'; call er arg(1),arg(2)
fto: parse arg fto ftox; ftoo='option'; if right(fto,2)=='()' then ftoo='function'; if fto\=='' then call sy "for the" ftoo @ space(fto ftox) @; return
halt: call er .1
isintisInt: return datatype(arg(1),'W')
isnumisNum: return datatype(arg(1),'N')
novaluenoValue: !sigl=sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
opf: if right(arg(1),2)=='()' then return "function"; return 'option'
p: return word(arg(1),1)
pickblankpickBlank: procedure; parse arg x,y; arg xu; if xu=='BLANK' then return ' '; return p(x y)
s: if arg(1)==1 then return arg(3); return p(arg(2) 's')
say30: if a5==-1 then call sy 'illegal' a4":" a3; else call sy "illegal length of" a4":" a3; _t=p(a7 'character'); _b=_t || s(p(a6 aa5))" in length"; return
sy: sy=arg(1); if length(sy)<81 then do; call syit sy; return; end; sysy=; do forever while sy\==''; parse var sy _t sy; if length(sysy _t)<80 then do;sysy=sysy _t;iterate;end; call syitb;sysy=_t;end; if strip(sysy)\=='' then call syitb;return
syfunc: if left(a6,1)==']' then do; _sl=g8; call sy "invocation of an undefined REXX function/subroutine" substr(a6,2); end; return
syit: syit=arg(1); if xedit then address 'XEDIT' "EMSG" syit; else if a2=='$T' then say syit; else call $t etops syit; if errmsgto\=='' & syit\=='' then call '$M' errmsgto syit; return
syitb: if left(sysy,1)==' ' then sysy=substr(sysy,2); call syit sysy; return
syline: if a5\==0 then call sy 'on line' a5 "of" ufid; _sl=g7; call syfunc; if _sl\=='' then do; call sy; call sy "REXX sourceline is:"; call sy; call sy _sl; call sy; end; if !cms then do;'EXECSTAT' a2 a3;if rc==0 then "EXECDROP" a2 a3;end;return
syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)</lang>
</syntaxhighlight>
 
[[Category:REXX library routines]]
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/277881...347667"