$ERR.REX

The   $ERR.REX   (REXX) program is used to issue various formatted error messages from other REXX programs.

The   $ERR.REX   program makes use of the   $T.REX   program to issue the error messages in red (if available).

The help for the   $ERR   REXX program is included here ──► $ERR.HEL. <lang rexx>/*REXX*/ trace off /*turn off all REXX cmd err msgs.*/ parse arg ! /*obtain the original arguments. */ if !all(arg()) then exit /*if a request for doc, then exit*/ if !cms then address /*handle ADDRESS for CMS. */ signal on halt /*setup label for HALT condition.*/ signal on noValue /* " " " NOVALUE " */ signal on syntax /* " " " SYNTAX " */ numeric digits 100 /*what the hell, support big 'uns*/

                                      /*══════list of external commands*/

@ctty = 'CTTY' /*point to the CTTY command.*/ @globalv = 'GLOBALV' /* " " " GLOBALV " */ @finis = 'FINIS' /* " " " FINIS " */ @subcom = 'SUBCOM' /* " " " 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 msgs*/

               else @ = '--------'    /* "   minuses  "     "    "   " */

parse var !! !! ' ..F=' ftops /*is $ERR to write errors to file*/ if ftops\== then ftops='.F='ftops /*Yes, then add to FTOPS var. */ etops=strip(ftops '.C=red .END=1') /*also, add to ETOPS variable. */ g.1=space(!!) /*a version with no extra blanks.*/ pblank='05'x /*use pseudoBlank as "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 (= "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  var.*/
 c.k=comma(a.k)                       /*add a comma (,) to the number. */
 w.k=length(c.k)                      /*get the length of commatized #.*/
 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, use ABS value*/ i=a.1 /*this is the error number. */ errmsgto= errmsgnt= xedit=0 /*indicate no XEDIT (so far). */

if !cms then do /*if CMS, then do some housework.*/

             @globalv 'SELECT' !fn 'GET ERRMSGTO ERRMSGNT'
             @finis '* * *'
             @cmstype 'RT'
             @conwait
             @cpspool 'CON TERM'
             @cpset' IMSG ON'
             @cpset' EMSG ON'
             @subcom 'XEDIT'
             xedit=\rc  &  \cmsflag('SUBSET')
             ufid=a3 a4 a5
             end

if !dos then do /*if COS, then do some housework.*/

             if \!nt  then @ctty 'con'  /*Not Windows NT?  Use CTTY cmd*/
             _=a4
             if _\==  &  right(_,1)\=="\"  then _=_'\'
             ufid=_ || a2"."a3
             end

i=space(translate(i,,'-'),0) /*remove all minus signs from str*/ if i== then call erb 57 /*Is it null? Oops-say message.*/

if i=0 then do /*if "error" is zero, show author*/

            _=                        /*start with a clean slate.      */
            iL=length(i)              /*use # 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 than 1 zero*/
            exit 0                    /*exit with a return code of zero*/
            end

if i==14000 |, /*is this a message for a HALT ? */

  i=='14.1'  then do                  /* ··· or in some cases,  14.1   */
                  htops=strip(ftops '.X=-1 .C=red .J=c .BOX=')
                  call $t htops 'The REXX program' @ a2 @ "has been halted !"
                  exit 14000          /* ··· and indicate a HALT cond· */
                  end

if \isInt(i) then call erb 53,i "error_code" /*Hmmm, an "internal" err*/ oi=i /*keep the original value around.*/ xedit= xedit & i>0 /*inside the XEDIT program? */ i=abs(i) /*use the absolute value of I. */ if i<1400 | i>1499 then call erb 99,oi /*check for a legal range of I. */ k=i-1400 /*from now on, use a shorter I. */ if xedit then address 'XEDIT' "SET MSGM ON LONG" /*allow XEDIT msgs.*/ call sy /*write blank line.*/ call sy "($$$"i") *error*:" /*write a hdr line.*/

if k==0 then call sy "some commands can't or shouldn't be executed while in" g3 if k==1 then call sy "the" g3 'was previously specified or specified more than once' if k==2 then call sy "the" a4 "argument can't be" choose("negative",g5)":" a3 if k==3 then call sy 'the (disk) filemode' a3 "can't have any read-only extensions" g4 if k==4 then call sy 'the' a4 "filemode/address can't be" choose('RELEASEd',g5)":" a3 if k==5 then do

             call sy "illegal compator operator" @ a3 'specified,'
             call sy "it must be one of:    =  \=  <  <=  >  >=  \<  \>"
             end

if k==6 then call sy "no special characters are allowed in the" g4':' a3 if k==7 then call sy "fixed-point underflow or overflow (result is too small or too large)" 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' 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 then do

             call sy "REXX syntax error"
             if isInt(a.6)  then call sy errortext(a.6)
             call syline
             end

if k==14 then call sy 'the' a5 "argument" a3 "can't be" choose('greater',a.7) "than" a6 a4 if k==15 then do

             if a3==  then call sy "division by zero"
                        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==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==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 then call sy "the" a3 @ a4 'and' g5 @ "aren't alike" if k==21 then call sy choose("increment",a3) 'must be preceeded by a plus (+) or a minus (-)' if k==22 then do

             _='combination of characters:'
             if L.4==1  then _="character:"
             call sy a3 'contains an invalid' _ g4
             end

if k==23 then call sy "the" a3 choose("option",a5) "requires the" a4 choose('option or feature',g6) if k==24 then call sy "illegal" choose('volume',a4) "serial:" a3 ' (it must be six or less characters)' if k==25 then do

             call sy "you must be in the" a3 'mode/program to use the'
             call sy "specified command (or it's" 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 then call sy choose('number',g4) "can't be negative or zero (must 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 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 \isInt(i) then call er 53,i exit sign(oi)*i

/*═════════════════════════════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=1=='f0'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; return c2 comma: procedure; parse arg _,c,p,t; c=pickBlank(c,","); o=p(p 3); p=abs(o); t=p(t 999999999); if \isInt(p) | \isInt(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 isInt: return datatype(arg(1),'W') isNum: return datatype(arg(1),'N') noValue: !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) pickBlank: 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>