-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathimm.rex
110 lines (95 loc) · 5.01 KB
/
imm.rex
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
/* Classic REXX 5.00 (Regina) or 6.03+ (ooRexx) with RexxUtil */
signal on novalue name ERROR ; parse version UTIL REXX .
if ( 0 <> x2c( 30 )) | ( REXX <> 5 & REXX < 6.03 )
then exit ERROR( 'untested' UTIL REXX )
if 6 <= REXX then interpret 'signal on nostring name ERROR'
if 5 <= REXX then interpret 'signal on lostdigits name ERROR'
signal on halt name ERROR ; signal on failure name ERROR
signal on notready name ERROR ; signal on error name ERROR
numeric digits 20 ; UTIL = REGUTIL()
/* -------------------------------------------------------------- */
LINE = strip( strip( strip( arg( 1 )),, '"' ))
TEMP = wordpos( LINE, '? -? /? /h -h' )
select
when LINE = '' | arg() <> 1 then return USAGE()
when wordpos( LINE, TEMP ) > 0 then return USAGE()
otherwise /* JFTR, Regina can start ooRexx */
TEMP = '"' || changestr( '"', LINE, '""' ) || '"'
address CMD 'rexx -e' TEMP ; return rc
end /* SIGNAL ON ERROR shows rc <> 0 */
/* ----------------------------- (REXX USAGE template 2016-03-06) */
USAGE: procedure /* show (error +) usage message: */
parse source . . USE ; USE = filespec( 'name', USE )
say x2c( right( 7, arg())) /* terminate line (BEL if error) */
if arg() then say 'Error:' arg( 1 )
say 'Usage:' USE 'LINE'
say /* suited for REXXC tokenization */
say USE 'emulates Kedit command IMM and runs a one-LINE script '
say ' with ooRexx. On a Windows command line escape < & ^ " | >'
say ' as ^< ^& ^^ ^" ^| ^> outside of DQUOTed strings. Example:'
say ' ' USE 'say c2d( "&" ) ^> c2d( ''^"'' ) '
say
say USE 'uses rexx -e to execcute the LINE, this has to be the '
say ' ooRexx rexx.exe binary, `rexx -h` should list option "-e".'
return 1
/* ----------------------------- (Regina SysLoadFuncs 2015-12-06) */
REGUTIL: procedure /* Not needed for ooRexx > 6.03 */
if RxFuncQuery( 'SysLoadFuncs' ) then do
ERR = RxFuncAdd( 'SysLoadFuncs', 'RexxUtil' )
if ERR <> 0 then exit ERROR( 'RexxUtil load error' ERR )
end /* static Regina has no RexxUtil */
ERR = SysLoadFuncs() ; return SysUtilVersion()
/* ----------------------------- (STDERR: unification 2020-03-14) */
/* PERROR() emulates lineout( 'STDERR:', emsg ) with ERROUT(). */
/* ERROUT() emulates charout( 'STDERR:', emsg ). */
/* ERROR() shows an error message and the source line number sigl */
/* on stderr. Examples: if 0 = 1 then exit ERROR( 'oops' ) */
/* call ERROR 'interactive debug here' */
/* ERROR() can also catch exceptions (REXX conditions), examples: */
/* SIGNAL ON ERROR non-zero rc or unhandled FAILURE */
/* SIGNAL ON NOVALUE NAME ERROR uninitialized variable */
/* CALL ON NOTREADY NAME ERROR blocked I/O (incl. EOF on input) */
/* ERROR() uses ERROR. in the context of its caller and returns 1 */
/* for explicit calls or CALL ON conditions. For a SIGNAL ON ... */
/* condition ERROR() ends with exit 1. */
PERROR: return sign( ERROUT( arg( 1 ) || x2c( 0D0A )))
ERROUT: procedure
parse version S V . ; signal off notready
select
when 6 <= V & V < 7 then S = 'STDERR:' /* (o)oRexx */
when S == 'REXXSAA' then S = 'STDERR:' /* IBM Rexx */
when V == 5.00 then S = '<STDERR>' /* Regina */
otherwise S = '/dev/con' /* Quercus */
end /* Kedit KEXX 5.xy not supported */
return charout( S, arg( 1 ))
ERROR: /* trace off, save result + sigl */
ERROR.3 = trace( 'o' ) ; ERROR.1 = value( 'result' )
ERROR.2 = sigl ; call PERROR
ERROR.3 = right( ERROR.2 '*-*', 10 )
if ERROR.2 <= sourceline()
then call PERROR ERROR.3 strip( sourceline( ERROR.2 ))
else call PERROR ERROR.3 '(source line unavailable)'
ERROR.3 = right( '+++', 10 ) condition( 'c' ) condition( 'd' )
if condition() = '' then ERROR.3 = right( '>>>', 10 ) arg( 1 )
call PERROR ERROR.3
select
when sign( wordpos( condition( 'c' ), 'ERROR FAILURE' ))
then ERROR.3 = 'RC' rc
when condition( 'c' ) = 'SYNTAX'
then ERROR.3 = errortext( rc )
when condition( 'c' ) = 'HALT'
then ERROR.3 = errortext( 4 )
when condition( 'c' ) = 'NOTREADY' then do
ERROR.3 = condition( 'd' )
if ERROR.3 <> '' then do
ERROR.3 = stream( ERROR.3, 'd' )
end
end
otherwise ERROR.3 = ''
end
if ERROR.3 <> '' then call PERROR right( '>>>', 10 ) ERROR.3
parse value ERROR.2 ERROR.1 with sigl result
if ERROR.1 == 'RESULT' then drop result
trace ?L /* -- interactive label trace -- */
ERROR: if condition() = 'SIGNAL' then exit 1
else return 1