zOs/REXX.O08/SCANOLD

/* copy scan begin ****************************************************
Scan: scan an input:
    scanLine(m,ln) : begin scanning a single line (string)
    scanReader(m,ln): begin scanning all lines of an opened reader
    scanAtEnd(m)   : returns whether we reached end of input
    scanLit(m,lit) : scan Literal lit if present or return 0
    scanChar(m,n)  : scan next n characters
    scanName(m)    : scan a name
    ScanNat(m)     : scan a natural number (without sign)
    scanString(m,q): scan a String with quote q. (with doubble = 1)
    scanVerify(m,c,o): verify(...,c,o,...)
    scanKeyValue(m): scan a key = value clause (with spaces)
    scanWord(m,u)  : scan a space delimited word or a string,
                          if u=1 then uppercase non-strings
    scanErr(m, txt): error with current scan location

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

returns: true if scanned, false otherwise
         m.tok    ==> last token
         m.val    ==> last value for scanString/Word/KeyValue
         m.key    ==> key for scanKeyValue
         m.scan.m.pos ==> scan position
         m.scan.m.src ==> scan source
***********************************************************************/

/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
    m.scan.m.pos = 1
    call scanInit m
    return m
endProcedure scanLine

/*--- switch to next line if atEnd of line or unCond=1 ---------------*/
scanNL: procedure expose m.
parse arg m, unCond
    if m.scan.m.reading then do
        interpret m.scan.m.scanNl
        end
    else do
        np = 1 + length(m.scan.m.src)
        if np <= m.scan.m.pos then
            return 0
        if unCond == 1 then nop
        else if unCond ^= 0 & m.scan.m.comment ^== '' ,
              &  abbrev(m.scan.m.src, m.scan.m.comment) then nop
        else
            return 0
        m.scan.m.pos = np
        return 1
        end
endProcedure scanNL

scanAtEnd: procedure expose m.
parse arg m, what
    if m.scan.m.reading then
        interpret m.scan.m.scanAtEnd
    else
        return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEnd

/*--- initialize scanner for m  --------------------------------------*/
scanInit: procedure expose m.
parse arg m, rdng
    m.scan.m.reading = rdng == 1
    m.tok = ''
    m.val = ''
    m.key = ''
    if symbol('m.scan.m.name') ^== 'VAR' then do
        m.scan.LC   = 'abcdefghijklmnopqurstuvwxyz'
        m.scan.UC   = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
        m.scan.Alpha = m.scan.LC || m.scan.UC
        m.scan.AlNum = '0123456789' || m.scan.ALPHA
        m.scan.m.Name1 = m.scan.ALPHA
        m.scan.m.Name = m.scan.ALNUM
        m.scan.m.comment = ''
        end
    return
endProcedure scanInit

/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
    call scanInit m
    m.scan.m.comment = comm
    if nameOne ^== '' then do
        m.scan.m.Name1 = nameOne
        m.scan.m.name = m.scan.m.name1 || '0123456789'
        end
    if namePlus ^== '' then
        m.scan.m.name = m.scan.m.name1 || namePlus
    return
endProcedure scanOptions

/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
    nx = 1 + length(m.scan.m.src)
    if len ^== '' then
        if nx > m.scan.m.pos + len then
            nx = m.scan.m.pos + len
    return substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
endProcedure scanLit

/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
    m.tok = scanLook(m, len)
    m.scan.m.pos = m.scan.m.pos + length(m.tok)
    return length(m.tok) > 0
endProcedure scanChar

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

/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
    m.val = ''
    if qu = '' then
        qu = "'"
    if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
        return 0
    bx = m.scan.m.pos
    qx = m.scan.m.pos + 1
    do forever
        px = pos(qu, m.scan.m.src, qx)
        if px < 1 then
            call scanErr m, 'ending Apostroph('qu') missing'
        m.val = m.val || substr(m.scan.m.src, qx, px-qx)
        if px >= length(m.scan.m.src) then
            leave
        else if substr(m.scan.m.src, px+1, 1) <> qu then
            leave
        qx = px+2
        m.val = m.val || qu
        end
    m.tok = substr(m.scan.m.src, bx, px+1-bx)
    m.scan.m.pos = px+1
    return 1
endProcedure scanString

/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
    if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
                 , m.scan.m.Name1) <= 0 then
        return 0
    bx = m.scan.m.pos
    m.scan.m.pos = bx + 1
    call scanVerify m, m.scan.m.Name
    m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
    return 1
endProcedure scanName

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

/*--- scan a natural number (no sign, decpoint ...) ------------------*/
ScanNat: procedure expose m.
parse arg m
    if ^ scanVerify(m, '0123456789') then
        return 0
    else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
             > 0 then
        call scanErr m, 'illegal number end'
    return 1
endProcedure ScanNat

/*--- 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
    if scanString(m, "'")              then return 1
    if scanString(m, """")             then return 1
    if ^scanVerify(m, ' 'stopper, 'm') then return 0
    m.val = m.tok
    return 1
endProcedure scanWord

scanBack: procedure expose m.
parse arg m, tok
    if m.scan.m.pos <= length(tok) then
        call scanErr sc, 'cannot back "'tok'" length'
    cx = m.scan.m.pos - length(tok)
    if substr(m.scan.m.src, cx, length(tok)) ^== tok then
        call scanErr sc, 'cannot back "'tok'" value'
    m.scan.m.pos = cx
    return
endProcedure scanBack

/*--- scan a key = word phrase
          put key into m.key and word into m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
    if ^ scanName(m) then
        return 0
    m.key = m.tok
    if ^ scanLit(scanSkip(m), '=') then do
        m.val = def
        m.tok = ' no='
        end
    else if ^scanWord(scanSkip(m)) then
        call scanErr(m, 'word expected after' m.key '=')
    return 1
endProcedure scanKeyValue

scanLinePos: procedure expose m.
parse arg m
    interpret 'return' m.scan.m.scanLinePos
endProcedure scanLinePos
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
    say 'scanErr' txt
    say '  last token' m.tok 'scanPosition' ,
         strip(left(substr(m.scan.m.src, m.scan.m.pos), 40), 't')
    if m.scan.m.reading then
        say scanLinePos(m)
    else
        say '  pos' m.scan.m.Pos 'in string' strip(m.scan.m.src, 't')
    call err 'scanErr' txt
    return
endProcedure scanErr

/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
    lastTok = m.tok
    res = 0
    do forever
        if scanVerify(m, ' ') then    nop
        else if ^ scanNL(m) then      leave
        res = 1
        end
    m.tok = lastTok
    return res
endProcedure scanSpaceNL

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

/*--- begin scanning the lines of a reader ---------------------------*/
scanReader: procedure expose m.
parse arg m, m.scan.m.rdr
    call scanInit m, 1
    m.scan.m.atEnd = 0
    m.scan.m.lineX = 0
    m.scan.m.scanNl = 'return scanReaderNl(m, unCond)'
    m.scan.m.scanAtEnd = 'return scanReaderAtEnd(m, what)'
    m.scan.m.scanLinePos = "scanReaderLinePos(m)"
    call scanReaderNl m, 1
    return m
endProcedure scanReader

/*--- return true/false whether we are at the end of line / reader ---*/
scanReaderAtEnd: procedure expose m.
parse arg m, what
    if m.scan.m.pos <= length(m.scan.m.src) then
        return 0
    if what == 'l' then
        return 1
    return m.scan.m.atEnd
endProcedure scanReaderAtEnd

scanReaderNL: procedure expose m.
parse arg m, unCond
    if unCond == 1 then nop
    else if unCond ^= 2 & m.scan.m.pos > length(m.scan.m.src) then nop
    else if unCond ^= 0 & m.scan.m.comment ^== '' & abbrev(substr( ,
               m.scan.m.src, m.scan.m.pos), m.scan.m.comment) then nop
    else
        return 0
    if m.scan.m.atEnd then
        return 0
    m.scan.m.atEnd = ^ jRead(m.scan.m.rdr, 'SCAN.'m'.SRC')
    if m.scan.m.atEnd then do
        m.scan.m.pos = 1 + length(m.scan.m.src)
        end
    else do
        m.scan.m.pos = 1
        m.scan.m.lineX = m.scan.m.lineX + 1
        end
    return ^ m.scan.m.atEnd
endProcedure scanReaderNL

scanReaderLinePos: procedure expose m.
parse arg m
    if m.scan.m.atEnd then
        qq = 'atEnd after'
    else
        qq = 'pos' m.scan.m.pos 'in'
    return qq 'line' m.scan.m.lineX':' strip(m.scan.m.src, 't')
endProcedure scanReaderLinePos
/* copy scan end   ****************************************************/