ReyC is coming up: Don't worry...

[Thomas.Schneider.Wien]

Hello there,
    don't worry too much about the Scanning and Parsing of Rexx and/or
NetRexx programs:

The Rey package does include a couple of ready made NetRexx classes and
methods, supporting EXECIO, a programmable Scanner and Parser,
and some more.

As an example Program, I am attachich IMSDEF.nrx

IMSDEF.nrx parses an IBM IMS DBD, and generates a DB-123 Data
Dictionary, which in Turn then maybe used to generate all the necessary
details to Convert an IBM IMS Database to an IBM DB2 database (without
the need to change the source programs :-)

I'm just attaching it as a Sample how to program a Parser by Hand.

Any volunteers to help with the documentation?

Thomas Schneider.

PS: All of my Software is going OPEN source very soon.
=========================================================
/******************************************************************************/
/* IMSDEF: Main Program to DEFINE IMS
DBD'S                                   */
/*            (c) Th. Schneider, www.thsitc.com,
2004-2010                    */
/******************************************************************************/
/* 16.08.2010: STRUCTURE attribute added to reference ths
source-language     */
/*           : STRUCTURE definition
file                                      */
/******************************************************************************/
package com.thsitc.db123

import com.thsitc.db123.IMSDBD -- the IMS DBD Declarations necessary
import com.thsitc.db123.IMSGEN -- generate DB123 Data Dictionary

import com.thsitc.rey.rt. -- the run-time-package routines
import com.thsitc.rey.in. -- needed for Scanner
import com.thsitc.rey.c.  -- needed for Counters, etc

class IMSDEF uses ReyMsg
properties private static
    debug = Options.opt_debug
    file_list = Rexx ''
    o_IMSDCL=IMSDCL
method main(args=String[]) static
all_args=Rexx(args) -- program arguments as single string

    Reymsg.init_info('IMSDEF','NEW')

    Params.set_pp_Parameters(all_args)  /* set the Parameter string */

    file_list=Params.get_pp_file_list()  /* get FILENAME list Part */
    file_parms=Params.pp_file_parms
    ndef=file_list[0] -- the number of DBD's given

    if ndef=0 then do
      info("no DBD's given, or files don't exist, no IMSDEF action")
      exit 9
    end

    options_list=Params.get_pp_options_list() /* get OPTIONS list part */
    options.set_pp_options(options_list)

    loop ix=1 to ndef
       DBD=file_list[ix]
       ID=ReyFile.FileName(DBD)
       IMS_define(DBD)
       ReyMsg.statistics

       if ReyMsg.n_errors > 0 then do
            ReyMsg.info('Please correct errors and try again')

       end
       else do
          IMSDBD.save_IMSDBD(ID) -- save NEW version of IMS DBD
       end
    end

    if ndef >> 1 then ReyMsg.print_total_statistics

    info(' ')
    info0(Counters.n_IMS_DBDS 'total IMS DBDS defined')
    info0(Counters.n_IMS_DATASETS 'total number of of IMS DataSets
defined')
    info0(Counters.n_IMS_segments 'total number of IMS Segments defined')
    info0(Counters.n_IMS_fields 'total number of IMS Fields defined')
    info0(Counters.n_IMS_LCHILDS 'total number of IMS Logical Childs
defined')
    info0(Counters.n_IMS_XDFLDs 'total number of IMS Index-Fields defined')
    info()

    info()
    if ReyMsg.n_tot_errors > 0 then do
       ReyMsg.info('Please correct errors and try again!')
    end

    info('IMSDEF completed, LOG File in IMSDEF.LOG.')

    ReyFile.closeAllFiles()
    exit

method IMS_define(dbd_name=Rexx) private static

    ID=ReyFile.filename(dbd_name)
    type=ReyFile.filetype(dbd_name)
    -- if no type is given, assume extension 'dbd'
    if type='' then dbd_name=ReyFile.fileid(ID,'dbd')

     ReyMsg.info('IMSDEF: IMS DBD:' dbd_name 'ID:' ID)

    -------------------------------------------------------------------
    -- do NO Longer load old DBD, as compiled DBD is saved by source ID
    -- IMSDBD.load_IMSDBD(ID) -- load OLD version of compiled IMS DBD
    -------------------------------------------------------------------
    /**********************************************************/
    IMSDBD.init_IMSDBD()

    o_IMSDCL=IMSDCL()
    o_IMSDCL.parse_IMSDEF(dbd_name)
    o_IMSGEN=IMSGEN()
    o_IMSGEN.generate_DB123_Data_Dictionary(ID)

    /*********************************************************/
    /* note that the DBD is now in CORE                      */
    /*********************************************************/

    return

class IMSDCL extends object uses ReyMsg


properties private
    o_scan=Scan
    debug=Options.opt_debug
/******************************************************************************/
/* Declare static Exposed properties of
Class:                                */
/******************************************************************************/
    /* ... Declare Exposed Variables */
    n_lists = int 0   -- nested lists are denoted by @n, where n is LIST
NUMBER
    /* ... Declare Exposed Stems / Arrays */
    lists = Rexx '' /*Stem!*/   -- temporary storage for NESTED lists

    seg_name= Rexx '' -- the name of the CURRENT SEGMENT
    struct_name = Rexx '' -- the name of the current STRUCTURE (COPY
book / INCLUDE File)

    /* ... Declare Global Strings */
    label = Rexx '' -- the current content of the prefix area
                    -- which may be a DD for DATASETs

    Action = Rexx '-unknown-'
    attr = Rexx '' -- the current attribute

    /* ... Declare Global other Variables */
    dbd_name = Rexx

/*****************************************************/
/* current (private) indices                         */
/*****************************************************/
    dbd_no = int 0  -- DBD Number (within DBD-File)
    dsn_no = int 0  -- Dataset - Number
    seg_no = int 0  -- Segment - number
    fld_no = int 0  -- Field Number
    xfd_no = int 0  -- Index Field Number
    lch_no = int 0  -- Logical Child Number


method parse_IMSDEF(def_file) public
    -- Options.trace_tokens=1 -- debug

    o_scan=Scan(def_file,'DELIMITED') -- define the Scan Object

    ReyMsg.info2('Parsing IMS DBD: 'def_file)

    lists = ''   -- temporary storage for NESTED lists
    n_lists = 0   -- nested lists are denoted by @n, where n is LIST NUMBER

    /*******************************************************************/
    /* note that ActionS are recoginzed at a NEW LINE only in AREA1    */
    /* where AREA1 goes from column 1 to column 15. If Column 1 is NOT */
    /* blank, then the Action is preceeded by a label                  */
    /*******************************************************************/
    -- note that IMS DBD's may have sequence numbers starting at column 73
    o_scan.set_margins(1,72)
    o_scan.set_area1(1,15) -- area1 for Actions
    o_scan.set_cmnt_chars('*')   -- the IMS comment character (type 1
comment)
    -- we don't set the comment column, and thus each line starting with
a '*' is a comment line
    o_scan.set_margins(1,71)
    o_scan.set_cont_column2(72,'*') -- asterisk in column 72 indicates a
continuation
    -- actually, MAYBE NON-blank indicates a continuation, must re-think
    o_scan.set_delims('=(),')  -- note that BLANK is NO delimiter
    o_scan.set_autoline(0) -- set AUTOLINE OFF

    loop until o_scan.EOF()
       o_scan.next_line()

       if o_scan.line_type <> 'Line' then iterate -- skip comments &
blank lines

       if debug then ReyMsg.debug('After o_scan.next_line,
line_type='o_scan.line_type)
       Action = next_Action()

       if debug then ReyMsg.debug('Action:' Action)

       /********************************************************/
       /* note that o_scan.in_token returns the UPPERCASED word, thus */
       /* we may use 'select case' for simplicity              */
       /********************************************************/
       select case Action
          when 'PRINT'        then skip_section() -- not needed
          when 'DBD NAME'     then in_DBD()
          when 'DATASET DD1'  then in_DATASET()
          when 'DATASET DD2'  then in_DATASET()
          when 'AREA NAME'     then in_AREA()
          when 'SEGM NAME'     then in_SEGM()
          /* DB-123 STRUCTURE (own attribute) */
          when 'STRUCTURE' then in_STRUCTURE()

          when 'FIELD NAME'    then in_FIELD()
          when 'LCHILD NAME'   then in_LCHILD()
          when 'XDFLD NAME'    then in_XDFLD()
          when 'DBDGEN'   then in_DBDGEN()
          when 'FINISH'   then in_FINISH()
          when 'END'      then in_END()
          when '-EOF-'    then leave
          when 'PSB'      then skip_section() -- currently not implemented
          when 'PCB'      then skip_section() -- detto
          when 'SENSEG'   then skip_section() -- detto

          otherwise do
             ReyMsg.error('IMS Action' Action 'not understood')
             skip_section()
          end--otherwise
       end--select
    end--loop
    return

method next_Action() private returns Rexx;

    loop while \o_scan.EOF()
       if o_scan.EOL() then o_scan.next_line()
       if o_scan.is_area1() then do
          area1=o_scan.in_token().space(1) -- multiple words are now
separated by 1 space
          if debug then Reymsg.debug('area1:' area1)
          if ReyMsg.ic1=1 then do /* if token starts at 1, it is a label */
             label=area1.word(1) -- first word is the Labelin this case
             ReyMsg.info('label:' label)
             area1=area1.subword(2) -- and the actual area1 is the
rest            o_scan.out_token()
          end
          else label='' -- clear label

          attr='' -- clear current attr
       end
       else do
          skip_section()
          -- ReyMsg.debug('After skip_section, ic1=' ReyMsg.ic1)
          iterate
       end

       return area1

    end--loop

    if o_scan.EOF() then return '-EOF-'

    ReyMsg.abort('no IMS Action found, parsing terminated')
    exit 99

method in_DBD() private ;

    dbname1=''
    access = ''
    datexit = ''
    paswd = ''
    xexit = ''
    ReyMsg.version = ''

    o_scan.get_delim('=')
    dbname1 = o_scan.get_value()
    o_scan.get_delim(',')

    loop while \o_scan.EOL()

       attr = next_attr()

       select case attr
          when 'ACCESS'   then access = o_scan.get_list()
          when 'DATXEXIT' then datxexit = o_scan.get_YES_or_NO()
          when 'PASWD'    then paswd = o_scan.get_YES_or_NO()
          when 'EXIT'     then xexit = o_scan.get_list() -- NOT parsed
in DETAIL
          when 'VERSION'  then xversion = o_scan.get_value()
          when 'RMNAME'   then randomizer=o_scan.get_list() -- we do NOT
need the randomizer
          when '-EOA-'    then leave
          otherwise
             ReyMsg.error('unknown DBD attribute:' attr 'ignored!')
             skip_clause()
             leave

       end--select
       if o_scan.EOL() then leave
       xx=o_scan.get_delim(',')
       if xx=',' then iterate
    end--loop    -- do forever

    /* ...
assignments                                                         */

    Counters.n_IMS_DBDS = Counters.n_IMS_DBDS + 1
    dbd_no = Counters.n_IMS_DBDS   -- for brevity

    IMSDBD.IMSDBD_name[dbd_no] = dbname1
    IMSDBD.IMS_ACCESS[dbd_no] = access
    IMSDBD.IMS_PASSW[dbd_no] = paswd
    IMSDBD.IMS_DATXEXIT[dbd_no] = datxexit
    IMSDBD.IMS_EXIT[dbd_no] = xexit

    IMSDBD.IMS_data_set1[dbd_no] = Counters.n_IMS_DATASETS + 1
                   -- index of first dataset belonging to each DBD
    IMSDBD.IMS_data_set2[dbd_no] = Counters.n_IMS_DATASETS
                   -- index of last dataset belonging to each DBD
    IMSDBD.IMS_segment1[dbd_no] = Counters.n_IMS_SEGMENTS + 1
            -- first segment (index into IMS_SEGM...)
    IMSDBD.IMS_segment2[dbd_no] = Counters.n_IMS_SEGMENTS  -- last segment

    return

method in_DBDGEN()  private ;  -- stub
    if \o_scan.EOL() then do
       ReyMsg.error('End of Line expected after DBDGEN')
       skip_section()
    end
    return

method in_FINISH() private ;
    if \o_scan.EOL() then do
       ReyMsg.error('End of Line expected after FINISH')
       skip_section()
    end
    return

method in_END() private ;
    if \o_scan.EOL() then do
       ReyMsg.error('End of Line expected after END')
       skip_section()
    end
    return


method in_DATASET() private ;
    /*********************************************/
    /* init LOCAL DATASET-parameters             */
    /* see page 35 Utilities reference manual    */
    /*********************************************/
    is_logical=0 -- 1 indicate logical database dataset
    dd_name1  = ''
    dd_name2  = ''
    blkfact   = ''
    size1     = ''  -- size1 size2
    recfm1    = ''
    cyls1     = ''
    frspc1    = ''  -- the FREE space
    searcha1  = ''  -- HDAM, HIDAM
    rel1      = ''  -- MSDB
    dd_name3  = ''  -- for OVERFLOW file name
    device    = ''

    ddx=Action.word(2)
    o_scan.get_delim('=')

    select case ddx
       when 'DD1'     then dd_name1 = o_scan.get_value()
       when 'DD2'     then dd_name2 = o_scan.get_value()
       otherwise error('only DD1 and DD2 currently supported')
    end
    o_scan.get_delim(',')

    loop while \o_scan.EOL()
       attr = next_attr()
       display_attr()

       select case attr
          when 'LOGICAL' then do
             is_logical = 1
             leave
          end

          when 'BLOCK'   then blkfact  = o_scan.get_list()  -- factor1
factor2
          when 'RECORD'  then reclen   = o_scan.get_list()  -- reclen1
reclen2
          when 'SIZE'    then size1    = o_scan.get_list()  -- maybe
size1 size2
          when 'RECFM'   then recfm1   = o_scan.get_value('F FB V VB U')
          when 'SCAN'    then cyls1    = o_scan.get_value()
          when 'FRSPC'   then frspc1   = o_scan.get_list()  -- fbff fspf
for HDAM, HIDAM
          when 'SEARCHA' then searcha1 = o_scan.get_value() -- HDAM, HIDAM
          when 'REL'     then rel1     = o_scan.get_list()   -- MSDB
          when 'OVFLW'   then dd_name3 = o_scan.get_value()
          when 'DEVICE'  then device   = o_scan.get_value()
          when '-EOA-'    then leave

          otherwise
             Reymsg.error('Invalid Attribute:' attr 'in DATASET statement')
             skip_clause()
       end

       if o_scan.EOL() then leave

       xx=o_scan.get_delim(',')
       if xx=',' then iterate

    end--loop

    Counters.n_IMS_DATASETS = Counters.n_IMS_DATASETS +1
    dsn_no=Counters.n_IMS_DATASETS

    IMSDBD.IMS_DSD1[dsn_no]       = dd_name1   -- Dataset name
    IMSDBD.IMS_DSD1_BLOCK[dsn_no] = blkfact    -- factor1 factor2
    IMSDBD.IMS_DSD1_SIZE[dsn_no]  = size1      -- size1 size2 when given
    IMSDBD.IMS_data_set2[dbd_no] = dsn_no

    /* the other attributes are NOT yet stored */
    return

method in_AREA()  private ;
    skip_section()   -- and also NOT in the areas
    return

method in_SEGM() private ;

    seg_name = ''
    parent = ''
    xsource = ''
    xbytes = 0
    xfreq = 0
    xcomprtn= ''
    xexit=''

    o_scan.get_delim('=')
    seg_name = o_scan.get_list() /* segment name may be a LIST of names */
    o_scan.get_delim(',')

    if seg_name.words=1 then ReyMsg.info('SEGMENT name is:' seg_name)
    else ReyMsg.info('SEGMENT names are:' seg_name)

    loop while \o_scan.EOL()
       attr = next_attr()   -- not that next_attr also skips the '='
delimiter
       this.display_attr()

       select case attr
          when 'PARENT' then parent = get_parent()
          when 'SOURCE' then xsource = o_scan.get_list() -- max min
          when 'RULES'  then xrules=o_scan.get_list()
          when 'BYTES'  then xbytes = o_scan.get_list()
          when 'FREQ'   then xfreq = o_scan.get_number()
          when 'PTR','POINTER' then xptr = o_scan.get_list()
          when 'COMPRTN' then xcomprtn=o_scan.get_list()
          when 'STRUCTURE' then xstructure=o_scan.get_value() -- note
that this is an own addition
              -- the STRUCTURE clause defines the record structure in
the SOURCE-Language
              -- which is either
          when 'EXIT'   then xexit=o_scan.get_list()
          when attr = '-EOA-'    then leave

          otherwise do
             ReyMsg.error('unknown SEGM attribute:' attr 'ignored')
             skip_clause()
             leave
          end--otherwise   -- select
       end--select

       if o_scan.EOL() then leave

       xx=o_scan.get_delim()
       if xx=',' then iterate
       leave
    end--loop

    Counters.n_IMS_segments = Counters.n_IMS_segments + 1

    seg_no = Counters.n_IMS_segments

    ReyMsg.info(' ')
    if parent='' then ReyMsg.info('Segment # 'seg_no':' seg_name)
    else ReyMsg.info('Segment # 'seg_no':' seg_name 'parent:' parent)

    ReyMsg.info(' ')

    IMSDBD.IMS_segment2[dbd_no] = seg_no  -- store last segment of dbd

    IMSDBD.IMS_SEGM_NAME[seg_no] = seg_name
    IMSDBD.IMS_SEGM_PARENT[seg_no] = parent
    IMSDBD.IMS_SEGM_NO[seg_no] = seg_no
    /* logical parents still
missing                                           */
    IMSDBD.IMS_SEGM_SOURCE[seg_no] = xsource

    parse xbytes max_bytes min_bytes
    if min_bytes = '' then do
       min_bytes = max_bytes
    end--if

    IMSDBD.IMS_SEGM_BYTES_max[seg_no] = max_bytes
    IMSDBD.IMS_SEGM_BYTES_min[seg_no] = min_bytes
    IMSDBD.IMS_SEGM_FREQ[seg_no] = xfreq
    IMSDBD.IMS_SEGM_PTR[seg_no] = xptr

    IMSDBD.IMS_SEGM_field1[seg_no]  = Counters.n_IMS_FIELDS +1  -- index
of first IMS FIELD of segment
    IMSDBD.IMS_SEGM_field2[seg_no]  = Counters.n_IMS_FIELDS     -- index
of last field of segment
    IMSDBD.IMS_SEGM_xdfld1[seg_no]  = Counters.n_IMS_XDFLDS +1   --
index of first secondary index
    IMSDBD.IMS_SEGM_xdfld2[seg_no]  = Counters.n_IMS_XDFLDS      --
index of last secondary index
    IMSDBD.IMS_SEGM_lchild1[seg_no] = Counters.n_IMS_LCHILDS +1  --
index of first Logical Child
    IMSDBD.IMS_SEGM_lchild2[seg_no] = Counters.n_IMS_LCHILDS     --
index of last Logical Child

    return

method in_FIELD() private ;

    if struct_name = '' then do
       struct_name= seg_name
       ReyMsg.info('STRUCTURE='struct_name 'for SEGMENT:' seg_name
'assumed!')

       /* must temporary save ReyMsg-buffer */
       line_save=ReyMsg.line
       line_no_save=ReyMsg.line_no
       ic1_save=ReyMsg.ic1
       ic2_save=ReyMsg.ic2
       /***********************************************/
       Dict.load_record_struct(seg_name,struct_name)
       /***********************************************/
       /* reset msg buffer */
       ReyMsg.line=line_save
       ReyMsg.line_len=ReyMsg.line.length
       if o_scan.rmargin > 0 then ReyMsg.line_len=o_scan.rmargin
       ReyMsg.line_no=line_no_save
       ReyMsg.ic1=ic1_save
       ReyMsg.ic2=ic2_save

    end

    Field_name1=''
    bytes=''
    start=''
    type=''

    o_scan.get_delim('=')
    field_name1 = o_scan.get_list()
    o_scan.get_delim(',')

    ReyMsg.info('   Field-Name:' field_name1)

    parse field_name1 field_name1 seq1 key_type1

    -- ReyMsg.debug('after get FIELD NAME, pointer is here...')

    loop while \o_scan.EOL()
       attr = next_attr()
       this.display_attr()
       select case attr

          when 'BYTES' then do
             bytes = o_scan.get_number()
             end--when
          when 'START' then do
             start = o_scan.get_number()
             end--when
          when 'TYPE' then do
             type = o_scan.get_value('X P C F H') /* see page 82
Utilities Ref. manual */
             end--when
          when '-EOA-'    then leave

          otherwise do
             ReyMsg.error('unknown FIELD attribute:' attr 'ignored!')
             skip_clause()
             leave
          end--otherwise
       end--select
       if o_scan.EOL() then leave

       xx=o_scan.get_delim(',')
       if xx=',' then iterate
       leave
    end--loop

    Counters.n_IMS_fields = Counters.n_IMS_fields + 1
    jf = Counters.n_IMS_fields

    IMSDBD.IMS_SEGM_field2[seg_no]  = jf     -- index of last field of
segment

    if field_name1 = '' then ReyMsg.error('Field-Name is missing!')
    if bytes = ''       then ReyMsg.error('Length in Bytes is misssing!')
    if type=''          then ReyMsg.error('Type is missing!')
    if start = ''       then ReyMsg.error('Start is missing!')

    IMSDBD.IMS_FLD_name[jf] = field_name1
    ReyMsg.info('   Field #' jf':' field_name1 'start='start 'bytes='
bytes 'type='type)

    if seq1 = 'SEQ' then do   -- U=Unique, M=Multiple
       IMSDBD.IMS_FLD_KEY[jf] = key_type1
    end--then
    else do
       IMSDBD.IMS_FLD_KEY[jf] = ''
    end--if   -- first byte is 1

    IMSDBD.IMS_FLD_START[jf] = start
    IMSDBD.IMS_FLD_BYTES[jf] = bytes
    IMSDBD.IMS_FLD_TYPE[jf] = type
    return

method in_LCHILD() private ;   -- in logical child
   
/****************************************************************************/
    /* for LOGICAL CHILD Parsing, see page 72 of the Utilities reference
manual */
    /* Below defined are the parsing parameters of the LOGICAL CHILD
definition */
   
/****************************************************************************/
    lchild_name1 = '' -- logical childs name (segment blank DB )
    seg_name1='' -- the segment of the logical child
    db_name1 ='' -- and the DB where it resides
    pointer1='' -- the type of pointers used
    pair1   = '' -- the segment name of the pair
    rules1  = '' -- the RULES used
    index1  = '' -- the INDEX Database LCHILD statement (see page 74)
    rksize1 = '' -- the Root Key Size of target segmen (page 76)

    o_scan.get_delim('=')
    lchild_name1 = o_scan.get_list()
    o_scan.get_delim(',')

    parse lchild_name1 seg_name1 db_name1

    ReyMsg.info('Logical Child:' seg_name1 'in DB:' db_name1)

    loop while \o_scan.EOL()
       attr = next_attr()
       this.display_attr()
       select case attr

          when 'POINTER', 'PTR' then pointer1=o_scan.get_value('DBLE
NONE INDX SYMB')
          when 'PAIR'           then seg_name2=o_scan.get_value()
          when 'RULES'          then rules1=o_scan.get_value('L=LAST
F=FIRST H=HERE')
          when 'INDEX'          then index1=o_scan.get_value()
          when '-EOA-'          then leave
          otherwise
             ReyMsg.error('Logical Child Attribute:' attr 'not allowed!')
             skip_clause()
       end--select
       if o_scan.EOL() then leave
       xx=o_scan.get_delim(',')
       if xx=',' then iterate
    end--loop

    Counters.n_IMS_LCHILDS = Counters.n_IMS_LCHILDS+1
    lc=Counters.n_IMS_LCHILDS -- just for brevity

    IMSDBD.IMS_SEGM_lchild2[seg_no] =lc
    ReyMsg.info('saving LCHILD #'lc':' seg_name1 'of SEGMENT #' seg_no)

    /* IMS_LC: IMS Logical Child Properties */
    IMSDBD.IMS_LC_NAME[lc]     = seg_name1    -- logical childs name
(segment-name)
    IMSDBD.IMS_LC_DB[lc]       = db_name1     -- and the DB where this
segment resides
    IMSDBD.IMS_LC_POINTER[lc]  = pointer1     -- the type of pointers used
    IMSDBD.IMS_LC_PAIR[lc]     = pair1        -- the segment name of the
pair
    IMSDBD.IMS_LC_RULES[lc]    = rules1       -- the RULES used
    IMSDBD.IMS_LC_INDEX[lc]    = index1       -- the INDEX Database
LCHILD statement (see page 74)
    IMSDBD.IMS_LC_RKSIZE[lc]   = rksize1      -- the Root Key Size of
target segmen (page 76)

    return

method in_XDFLD() private ;   -- in INDEX FIELD

    /* for details, see page 84 ff of Utilities Reference manual */
    xdfld_name=''
    xsegname=''
    xconst=''
    xsearch=''
    xsubseq = ''
    xddata= ''
    xnullval = ''
    xextrtn = ''

    o_scan.get_delim('=')
    xdfld_name=o_scan.get_value()
    o_scan.get_delim(',')

    ReyMsg.info('   Index Field:' xdfld_name)

    loop while \o_scan.EOL()
       attr = next_attr()
       this.display_attr()

       select case attr
          when 'SEGMENT' then xsegname=o_scan.get_value()
          when 'CONST'   then xconst=o_scan.get_value()
          when 'SRCH'    then xsearch=o_scan.get_list()
          when 'SUBSEQ'  then xsubseq = o_scan.get_list()
          when 'DDATA'   then xddata= o_scan.get_list()
          when 'NULLVAL' then xnullval = o_scan.get_value()
          when 'EXTRTN'  then xextrtn = o_scan.get_value()

          otherwise
             ReyMsg.error('Index Field Attribute:' attr 'not allowed!')
             skip_clause()
       end--select

       if o_scan.EOL() then leave
       xx=o_scan.get_delim(',')
       if xx=',' then iterate
       leave
    end--loop

    Counters.n_IMS_XDFLDS = Counters.n_IMS_XDFLDS + 1
    IMSDBD.IMS_SEGM_xdfld2[seg_no]  = Counters.n_IMS_XDFLDS      --
index of last secondary index

    xdf_no = Counters.n_IMS_XDFLDS -- just for brevity

    IMSDBD.IMS_XDF_NAME[xdf_no]    = xdfld_name
    IMSDBD.IMS_XDF_SEGNAME[xdf_no] = xsegname  -- segment name
    IMSDBD.IMS_XDF_CONST[xdf_no]   = xconst    -- constant
    IMSDBD.IMS_XDF_SEARCH[xdf_no]  = xsearch   -- SRCH attribut
    IMSDBD.IMS_XDF_SUBSEQ[xdf_no]  = xsubseq   -- SUBSEQ
    IMSDBD.IMS_XDF_DDATA[xdf_no]   = xddata    -- DDATA
    IMSDBD.IMS_XDF_NULLVAL[xdf_no] = xnullval  -- NULLVAL
    IMSDBD.IMS_XDF_EXTRTN[xdf_no]  = xextrtn   -- external EXIT Routine


    return


method display_attr() private
    ReyMsg.info('     attr='attr)
    return

method skip_section() private ;
    ReyMsg.info('... skipping section:' Action)
    loop while \o_scan.EOF()
       o_scan.next_line()
       if o_scan.is_area1() then do
          if debug then do
             ReyMsg.debug('skip_section: new area1 found!')
             ReyMsg.lineinfo('Area1 starts at ic1:' ReyMsg.ic1)
          end
          leave
       end
    end--loop
    return




method skip_clause() private ;
    loop while \o_scan.EOL() & \o_scan.EOF()
       o_scan.in_token()

       if o_scan.is_area1() then do
          o_scan.go_back()
          leave -- new Action
       end

       if o_scan.next_char() '=' then do
          attr=o_scan.token
          leave  -- new attr
       end

       o_scan.out_token()
    end--loop

    return    -- now next token is a Action or an attribute



   
/***************************************************************************/
    /* Scanner enhancements (maybe later in tokenizer when
tested)             */
   
/***************************************************************************/
method next_attr() private returns Rexx;

    ne = 0   -- local error count

    loop while \o_scan.EOL()

       token1= o_scan.in_token()

       if o_scan.is_area1() then do
          o_scan.go_back()
          return '-EOA-' -- indicates end of attribute-list
       end

       if o_scan.next_char() = '=' then do
          attr1 = token1
          o_scan.get_delim('=')   -- and accept the delimiter
          leave    -- next attr found
       end--then
       else do
          ne = ne + 1
          if ne = 1 then do
             ReyMsg.error('expected ATTRIBUTE, but found:' o_scan.token)
          end--if
          o_scan.out_token() -- skip erroneous entry
          iterate -- and search for next attr
       end--if
    end--loop

    attr1=attr1.upper()
    if debug then ReyMsg.debug('parsing attr:' attr1)

    return attr1



method get_parent() private returns Rexx;
    xx = Rexx ''
    xx = o_scan.get_list()   -- may be actually a LIST of parent names
    if xx = '0' then  return '' -- we use '' to denote NO PARENT!

    return xx

  /*********************************************************/
  /* own DB-123 additions                                  */
  /*********************************************************/
  method in_STRUCTURE()
    struct_name = o_scan.get_value()
    ReyMsg.info(o_scan.language'-structure of SEGMENT :' seg_name 'is'
struct_name)
    Dict.load_record_struct(seg_name,struct_name)
    return

--
Thomas Schneider Projects PP, ReyC, and LOGOS on www.KENAI.com
www.thsitc.com
_______________________________________________
Ibm-netrexx mailing list
[hidden email]

[Thomas.Schneider.Wien]

The (external) Operators Control file named Rexx.opers (for Rexx and
ooRexx), NetRexx.opers for NetRexx, PLI.opers for PL/I,
COBOL.opers for COBOL, etc.

Note that the Operators are defined with a precedence, thus allowing for
regular epxression Parsing. The flaggs allow_abut_ops etc are used in
the generalaized expression Parse (InExpr.nrx), whish is usually common
to all
languages, but may be *extended* when you have a need to do so...

This approach, for having the Operator definitions *External* to the
Parser and the Program Generator, will aloow you even to define other
symbols
like OR == |, AND = &, XOR = &&, when you like for your personal style,
or when language enhancements arise....

I only *do hope* this information *is welcome* on ibm-netrexx...
.
Thomas Schneider.
========================================================

File: Rexx.opers          -- just as an example
=============

****************************************************************************
* Rexx Operator Tables
****************************************************************************
*   (c) Th. Schneider, all rights reserved
****************************************************************************
* 05.11.2009: ' and " added to delims (trial for COMPAXX)
* 06.04.2010: Compound Assign Operators added
* 09.04.2010: Delimiters are now built dynamically from OpCodes (Tokens)
****************************************************************************
autoline: 0

lmargin: 1
rmargin: 0  -- indicates NO right margin

skip_leading_blanks: 1
skip_trailing_blanks: 0

delims: blank'":,;

* note: rest is addeded dynamically from OpCodes

idchars1: ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz._$?!
idchars2:
ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789._$?!
idchars: ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789._$?!

EOLAB: :
EOS: ;

allow_abut_OP: 1
allow_blank_OP: 1

op_SOCmnt: /*
op_EOCmnt: */

op_SOShell: #!

op_SONote: --
op_SODir: /*%   -- for IBM compiled Rexx compatibility
op_CONT: , -  -- note that ooRexx does now support both variants

cont_column1: 0
cont_column2: 0
cmnt_column: 0
cmnt_chars:

nested_comments: 1

opt_test: 0

* Class: Code Precedence Operator(s)

Arithmetic: 1 15 +
Arithmetic: 2 15 -
Arithmetic: 3 16 *
Arithmetic: 4 16 /
Arithmetic: 5 17 **
Arithmetic: 6 16 %
Arithmetic: 7 16 //

Compare: 11 13 =
Compare: 12 13 <
Compare: 13 13 >
Compare: 14 13 <>
Compare: 15 13 <=
Compare: 16 13 >=
Compare: 14 13 \=
Compare: 14 13 ^=
Compare: 15 13 ^>
Compare: 16 13 ^<
Compare: 15 13 ¬>
Compare: 16 13 ¬<

Compare: 21 13 ==
Compare: 22 13 <<
Compare: 23 13 >>
Compare: 24 13 ^==
Compare: 25 13 <<=
Compare: 26 13 >>=
Compare: 25 13 ^>>
Compare: 26 13 ^<<
Compare: 25 13 \>>
Compare: 26 13 \<<
Compare: 24 13 \==
Compare: 14 13 ¬=
Compare: 25 13 ¬>>
Compare: 26 13 ¬<<
Compare: 24 13 ¬==


Logical: 40 18 \
Logical: 41 12 &
Logical: 42 11 |
Logical: 43 12 &&
Logical: 42 11 !
Logical: 40 18 ¬
Logical: 40 18 ^

String: 51 14 ||
String: 51 14 !!
String: 51 14 °
String: 52 14 °°

List: 61 5 (
List: 62 8 ,
List: 63 5 )
List: 64 7 [
List: 65 7 ]
List: 66 1 ;
List: 67 9 ~
List: 68 9 ~~
List: 69 8 ][
List: 70 10 :


* ... note that the Assign Operator := is an artificial Operator
*     as the = Operator may be actually used in the Rexx SOURCE
Assign: 91 1 :=
Assign: 92 1 +=
Assign: 93 1 -=
Assign: 94 1 *=
Assign: 95 1 /=
Assign: 96 1 **=
Assign: 97 1 //=
Assign: 98 1 %=

-

_______________________________________________
Ibm-netrexx mailing list
[hidden email]