zOs/REXX/SB

/* copy SB begin ***************************************************
     Achtung: inc generiert SB aus scanSB, Aenderungen nur in scanSB|
scan: basic scan
    scanLook(m,len) : returns next len chars, pos is not moved
    scanChar(m,len) : scans next len chars
    scanString(m,q): scan a String with quote q. (with doubble = 1)
    scanVerify(m,c,o): verify(...,c,o,...)
    scanWord(m,u)  : scan a space delimited word or a string,
                          if u=1 then uppercase non-strings
variable interface
    scanSrc(m, source) starts scanning a single line
    scanEnd(m)     : returns whether we reached end of input
    scanErr(m, txt): error with current scan location

    m is an address, to store our state
    if a scan function succeeds, the scan posititon is moved

returns: true if scanned, false otherwise
         m.m.tok  ==> last token
         m.m.val  ==> last value for scanString/Word
         m.m.pos ==> scan position
         m.m.src ==> scan source
***********************************************************************/
/*--- return the next len characters until end of src ----------------*/
scanLook: procedure expose m.
parse arg m, len
    if len == '' then
        return substr(m.m.src, m.m.pos)
    else
        return substr(m.m.src, m.m.pos,
                     , min(len, 1 + length(m.m.src) - m.m.pos))
endProcedure scanLook

/*--- scan len chararcters, atmost to end of src ---------------------*/
scanChar: procedure expose m.
parse arg m, len
    m.m.tok = scanLook(m, len)
    m.m.pos = m.m.pos + length(m.m.tok)
    return m.m.tok \== ''
endProcedure scanChar

/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m
    do ax=2 to arg()
        if abbrev(substr(m.m.src, m.m.pos), arg(ax)) then do
            m.m.tok = arg(ax)
            m.m.pos = m.m.pos + length(arg(ax))
            return 1
            end
        end
    m.m.tok = ''
    return 0
endProcedure scanLit

/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt, onlyIfMatch
    if arg() > 3 then
        call err 'deimplement onlyIfMatch???'
    if vOpt == '' then   /* empty string does not take default */
        nx = verify(m.m.src, alpha, , m.m.pos)
    else
        nx = verify(m.m.src, alpha, vOpt, m.m.pos)
    if nx = 0 then
        if onlyIfMatch == 1 then
            nx = m.m.pos
        else
            nx = length(m.m.src) + 1
    m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
    m.m.pos = nx
    return m.m.tok \== ''
endProcedure scanVerify

/*--- scan while in charset ------------------------------------------*/
scanWhile: procedure expose m.
parse arg m, chSet
    return scanVerify(m, chSet, 'n')

/*--- scan until in charset ------------------------------------------*/
scanUntil: procedure expose m.
parse arg m, chSet
    return scanVerify(m, chSet, 'm')

/*--- scan until (and over) string End -------------------------------*/
scanStrEnd: procedure expose m.
parse arg m, sep
    sx = m.m.pos
    bx = sx
    do forever
        ex = pos(sep, m.m.src, sx)
        if ex = 0 then do
            m.m.val = m.m.val || substr(m.m.src, bx)
            return 0
            end
        m.m.val = m.m.val || substr(m.m.src, bx, ex-bx)
        bx = ex + length(sep)
        if \ abbrev(substr(m.m.src, bx), sep) then do
            m.m.tok = m.m.tok || substr(m.m.src, m.m.pos, bx-m.m.pos)
            m.m.pos = bx
            return 1
            end
        sx = bx + length(sep)
        end
endProcedure scanStrEnd

/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, prefs
    if prefs = '' then do
        call scanLit m, "'", '"'
        end
    else do
        do px=1 to words(prefs) until scanLit(m, word(prefs, px))
            end
        end
    if m.m.tok == '' then
        return 0
    m.m.val = ''
    if \ scanStrEnd(m, m.m.tok) then
        return scanErr(m, 'ending Apostroph missing')
    return 1
endProcedure scanString

/*--- scan a word and put value into *.val
           a word is either delimited by space or stopper
                     or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper, ucWord
    if scanString(m) then
        return 1
    if stopper == '' then
        stopper = ' '
    if \scanUntil(m, stopper) then
        return 0
    if ucWord == 1 then
        m.m.val = translate(m.m.tok)
    else
        m.m.val = m.m.tok
    return 1
endProcedure scanWord

/*--- skip, scan and return next word --------------------------------*/
scanSkWord: procedure expose m.
parse arg m, stopper, ucWord, eMsg
    if scanWord(scanSkip(m), stopper, ucWord) then
        return m.m.val
    else if eMsg == '' then
        return ''
    else
        call scanErr m, eMsg 'expected'
endProcedure scanSkWord

/*--- go back the current token --------------------------------------*/
scanBack: procedure expose m.
parse arg m, tok
    if m.m.pos <= length(tok) then
        call scanErr sc, 'cannot back "'tok'" length'
    cx = m.m.pos - length(tok)
    if substr(m.m.src, cx, length(tok)) \== tok then
        return scanErr(m, 'cannot back "'tok'" value')
    m.m.pos = cx
    return
endProcedure scanBack

/*--- set new src - allow scanning without open ----------------------*/
scanSrc: procedure expose m.
parse arg m, m.m.src
    return scanStart(m)
endProcedure scanSrc

/*--- start scanning -------------------------------------------------*/
scanStart: procedure expose m.
parse arg m
    m.m.pos = 1
    m.m.tok = ''
    return m
endProcedure scanStart

scanSpace: procedure expose m.
parse arg m
    nx = verify(m.m.src, ' ', , m.m.pos)
    if nx = 0 then
        nx = length(m.m.src) + 1
    res = nx <> m.m.pos
    m.m.tok = left(' ', res)
    m.m.pos = nx
    return res
endProcedure scanSpace

/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
    call scanSpace m
    return m
endProcedure scanSkip

scanErr: procedure expose m.
parse arg m, txt
    if arg() < 3 then
        return err('s}'txt'\n'scanInfo(m))
    else
        return err('scanErr' txt'\n'arg(3))
endProcedure scanErr

scanInfo: procedure expose m.
parse arg m
    return 'last token' m.m.tok 'scanPosition' ,
        strip(substr(m.m.src, m.m.pos, 40), 't') ,
        || '\npos' m.m.Pos 'in string' strip(m.m.src, 't')
endProcedure scanInfo

/*--- return position in simple format -------------------------------*/
scanPos: procedure expose m.
parse arg m
    return 'singleSrc' m.m.pos
    return if(m.m.pos > length(m.m.src), 'E', 'singleSrc' m.m.pos)

/*--- set position to position in arg to------------------------------*/
scanSetPos: procedure expose m.
parse arg m, to
    cur = scanPos(m)
    wc = words(cur)
    if wc <> words(to) ,
        | subWord(cur, 1, wc-1) <> subWord(to, 1, wc-1) then
        call scanErr m 'cannot back from' cur 'to' to
    m.m.pos = word(to, wc)
    return

/*--- return true if at end of src -----------------------------------*/
scanEnd: procedure expose m.
parse arg m
    return m.m.pos > length(m.m.src)

/*--- return true if at comment --------------------------------------*/
scanCom: procedure expose m.
parse arg m
    m.m.tok = ''
    if m.m.scanComment == '' then
        return 0
    if \ abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then
        return 0
    m.m.tok = substr(m.m.scr, m.m.pos)
    m.m.pos = 1 + length(m.m.src)
    return 1
endProcedure scanCom

/* copy SB end ****************************************************/