zOs/REXX.O08/TTJ
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jNew: procedure expose m.
return 'J.'mIncD(j.0)
endProcedure jNew
jFree: procedure expose m.
parse arg m
return
endProcedure jFree
jRead: procedure expose m.
parse arg m, arg
res = '?'
interpret m.m.jRead
return res
endProcedure jRead
jWrite: procedure expose m.
parse arg m, arg
interpret m.m.jWrite
return
endProcedure jWrite
jReset: procedure expose m.
parse arg m, arg
interpret 'call' m.m.jPref'Reset m, arg'
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret 'call' m.m.jPref'Open m, arg'
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
interpret 'call' m.m.jPref'Close m'
m.m.jRead = 'call err "read('m') when closed"'
m.m.jWrite = 'call err "write('m') when closed"'
return m
endProcedure jClose
jDefine: procedure expose m.
parse arg m, m.m.jPref
m.m.jRead = 'call err "read('m') when closed"'
m.m.jWrite = 'call err "write('m') when closed"'
return m
endProcedure jDefine
jDefRead: procedure expose m.
parse arg m, m.m.jRead
m.m.jWrite = 'call err "write('m') when reading"'
return m
endProcedure jDeRead
jDefWrite: procedure expose m.
parse arg m, m.m.jWrite
m.m.jRead = 'call err "read('m') when writing"'
return m
endProcedure jDeWrite
jOpts: procedure
parse arg src, alone, val
if left(src, 1) ^== '-' then
return ''
opt = substr(src, 2)
vv = ''
if val ^== '' then do
vx = verify(src, opt, 'm')
if vx ^= 0 then do
vv = substr(opt, vx+1)
opt = left(opt, vx)
end
end
if alone ^== '' then do
if verify(left(opt, length(opt)-1), alone) > 0 then
call err 'bad opt "'src'" should be "'alone'"' ,
'or "'valid'" with value'
end
return strip(opt vv)
endProcedure jOpts
jPush: procedure expose m.
parse arg i, o
sx = m.j.jStack.0 + 1
m.j.jStack.0 = sx
if i == '' then
i = m.j.jIn
else if i ^== m.j.jIn then
call jOpen i, 'r'
if o == '' then
o = m.j.jOut
else if o ^== m.j.jOut then
call jOpen o, 'w'
m.j.jIn.sx = i
m.j.jIn = i
m.j.jOut.sx = o
m.j.jOut = o
return
endProcedure jPush
jPop: procedure expose m.
sx = m.j.jStack.0 - 1
m.j.jStack.0 = sx
if sx < 1 then
call err 'jPop on empty stack' sx
if m.j.jIn ^== m.j.jIn.sx then
call jClose m.j.jIn
if m.j.jOut ^== m.j.jOut.sx then
call jClose m.j.jOut
m.j.jIn = m.j.jIn.sx
m.j.jOut = m.j.jOut.sx
return
endProcedure jPop
jReadWrite: procedure expose m.
parse arg i, o
if i == '' then
i = m.j.jIn
if o == '' then
o = m.j.jOut
do while (jRead(i, line))
call jWrite o, m.line
end
return
endProcedure jReadWrite
jInit: procedure expose m.
if symbol('m.j.0') == 'VAR' | symbol('m.j.jStack.0')=='VAR' then do
say 'jInit but alread initialised'
end
else do
m.j.0 = 0
end
m.j.jStack.0 = 1
m.j.jIn = jNew()
m.j.jIn.1 = m.j.jIn
m.j.jOut = jNew()
m.j.jOut.1 = m.j.jOut
call jDefine m.j.jIn, "jStdIOError "
call jDefRead m.j.jIn, "res = 0"
call jDefine m.j.jOut, "jStdIOError "
call jDefWrite m.j.jOut, "say 'jOut'" arg
return
endProcedure jInit
jStdIOError: procedure expose m.
parse arg fun m, arg
call err 'do not j'fun'('m',' arg') base stdIn/stdOut'
return
endSubroutine
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
jBuf: procedure expose m.
parse arg m
call jDefine m, "jBuf"
do ax=1 to arg() - 1
m.m.jBuf.ax = arg(ax+1)
end
m.m.jBuf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
do ax=1 to arg() - 1
m.m.jBuf.ax = arg(ax+1)
end
m.m.jBuf.0 = ax-1
return m
endProcedure jBuf
jBufOpen: procedure expose m.
parse arg m, opt
if opt == 'r' then do
call jDefRead m, "res = jBufRead(m , arg)"
m.m.jBufIx = 0
return m
end
if opt == 'w' then
m.m.jBuf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
call jDefWrite m, "call mAdd m'.'jBuf, arg"
return m
endProcedure jBufOpen
jBufClose:
return arg(1)
endProcedure jBufOpen
jBufStem: procedure expose m.
parse arg m
return m'.JBUF'
endProcedure jBufStem
jBufRead: procedure expose m.
parse arg m, var
ix = m.m.jBufIx + 1
if ix > m.m.jBuf.0 then
return 0
m.m.jBufIx = ix
m.var = m.m.jBuf.ix
return 1
endProcedure jBufRead
/* copy j end *********************************************************/