zOs/REXX/EXTRAP

/* rexx testing traps  -----------------------------------------------

    call stack bleibt immer erhalten.
      return in trap funktioniert unterschiedlich, signErr <=> callErr

        call on: ist return von trap procedure,
            code continues nach dem statement, das trap auslöste
        signal on: ist return von der Prozedur, die trap auslöste
    on syntax und on no value nur mit signal
----------------------------------------------------------------------*/
m.stack = 0
call info 'exTrap  0 vor bist Du'
call stack 10, 'bist Du da?'
call info 'exTrap  1 vor signal on novalue'
call signNoVa
call info 'exTrap  2 vor signal on syntax'
call signSyn
call info 'exTrap  3 vor signal on error'
call signErr
call info 'exTrap  3 vor call on error'
call callErr
call info 'exTrap  3 exiting'
exit

signNoVa: procedure expose m.
    say 'signlNoValue throwing no value'
    signal on novalue name noVaTrap
    call stack 10, 'noVa'
    say 'signNoValue returning after no value'
    return 0

signSyn: procedure expose m.
    say 'signal on syntax'
    signal on syntax name synTrap
    call stack 10, 'syn'
    say 'signal on syntax returning after syntax'
    return 0

signErr: procedure expose m.
    say 'signal on error'
    signal on error name errSignTrap
    call stack 10, 'err'
    say 'signal on error returning after error'
    return 0

callErr: procedure expose m.
    say 'call on error'
    call on error name errCallTrap
    call stack 10, 'err'
    say 'call on error returning after error'
    return 0

stack: procedure expose m.
parse arg lv, what
    m.stack = m.stack + 1
    localStack = m.stack
    if lv = 1 | lv = 2 | lv = 7  then do
         call info 'stack'lv
         r = stack(lv-1, what)
         call info 'stack'lv 'returning r='r
         return '<stack local='localStack'>'
         end
    if lv > 0 then
         return stack(lv-1, what)
    call info 'stack:'
    if what = 'noVa' then
        x=y
    else if what = 'syn' then
        x=1/0
    else if what = 'err' then
        address tso 'tso?err'
    else
        say 'not implemented' what
    call info 'stack returning'
    return '<stack' what',local='localStack'>'
endProcedure stack

noVaTrap:
    return trapInfo('no value trap', sigl)

synTrap:
    return trapInfo('syntax trap', sigl)

errSignTrap:
    return trapInfo('signal on error trap', sigl)

errCallTrap:
    return trapInfo('call on error trap', sigl)

trapInfo:
   call info arg(1) 'trapinfo begin '
   say '  condition c='condition('c')', i='condition('i') ,
              || ', d='condition('d')', s='condition('s')
   say '  sigl='arg(2)
   say '  rc='rc', result='result
   if datatype(rc, 'n') & rc > 0 then
       say '    errortext='errortext(rc)
   call info arg(1) 'trapinfo return'
   return '<trapInfo' arg(1)', local='localStack'>'

info:
    say arg(1)': m.stack='m.stack', localStack='localStack', what='what
    return