$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.

/*REXX program to display  error  or  informational messages  (in color, if supported). */

trace off                                        /*turn off all REXX cmd error messages.*/

parse arg !                                      /*obtain the original arguments.       */

if !all( arg() )  then exit                      /*Request for help?  Display, then exit*/
if !cms           then address ''                /*handle    ADDRESS  for  CMS.   */

signal on halt                                   /*be able to handle the halting of pgm.*/
signal on noValue                                /* "   "   "    "   undefined variables*/
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).       */

if !cms  then do                                 /*if CMS, then do some housework first.*/
              @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 \!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. */
             _=                                  /*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 ?       */
   i==14.1    then do                            /*  ··· or in some cases,  14.1 error. */
                   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  condition*/
                   end


if \isInt(i)  then call erb 53,i "error_code"    /*Hmmm, we got an "internal" pgm error.*/
oi= i                                            /*keep the original error number 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 messages to be seen.     */
call sy                                          /*display a blank line for the eyeballs*/
call sy '($$$'i") *error*:"                      /*write a header line (before the msg).*/

                                                 /*now, display the error message(s).   */



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 comparator 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 "preceded 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 preceded 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 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=3=='f3'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)