home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rdebug21.zip / RSYNTAX.KEX < prev    next >
Text File  |  1993-03-25  |  13KB  |  506 lines
  1. /*H* RSYNTAX.KEX 02-08-93 09:48 */
  2.  /*      test seperately
  3.  signal on error
  4.  signal on halt
  5.  signal on syntax
  6.  */
  7.  Parse source sys .
  8.  if      sys='OS/2'  then sys='OS2'
  9.  else if sys='PCDOS' then sys='DOS'
  10.  if (sys='DOS') + (sys='OS2')>0 then pc?=1
  11.  me='rSYNTAX'
  12.  If arg(1)='?' Then Exit tell(me)
  13.  Arg num auto .
  14.  /*check syntax of a REXX exec or macro.*/
  15.  Call initial
  16.  t?=0
  17.  Do k=1 To num
  18.    parse?=0
  19.    do?=0
  20.    '+1 EXTRACT /LINE/CURLINE'
  21.    string=strip(curline.3,'b')
  22.    If t? Then Call dump
  23.    Upper string
  24.    If string='' Then Iterate
  25.    If k=1&left(strip(string,'l'),2)<>'/*' Then Call msg "020"
  26.    If wordpos(line.1,listunpaired)>0 Then Call msg '030'
  27.    Call drop_comments
  28.    Call join_lines
  29.    Call split_lines
  30.    Call process_stack
  31.  End
  32.  Call process_stack
  33.  If level<>0 Then Call msg '230' level 'since line:' lastset
  34.  Address Command 'FINIS' syntax
  35.  'XEDIT' syntdata
  36.  'QQUIT'
  37.  'COMMAND SET MSGMODE' msgmode.1
  38.  'COMMAND EMSG Processing complete'
  39.  Exit
  40.  DUMP:
  41.    test=k string
  42.  Address Command 'EXECIO 1 DISKW A.A (VAR TEST'
  43.  Return
  44.  DROP_COMMENTS:
  45.  temp=''
  46.  Do Forever
  47.    Parse Value pos(sq,string) pos(dq,string) pos("/*",string,),
  48.    With h i j
  49.    If h=0 Then h=500
  50.    If i=0 Then i=500
  51.    If j=0 Then j=500
  52.    i=min(h,i,j)
  53.    If i=500 Then Leave
  54.    delimiter=substr(string,i,1)
  55.    If delimiter='/' Then Parse Value '*/' 2 With delimiter width
  56.    Else width=1
  57.    temp=temp substr(string,1,i+1-width)
  58.    string=substr(string,i+1)
  59.    Do k=k
  60.      j=pos(delimiter,string)
  61.      If j>0 Then Leave
  62.      If k>ssize Then Leave
  63.      '+1 EXTRACT /CURLINE'
  64.      string=curline.3
  65.    End
  66.    If j>0&delimiter='*/' Then string=substr(string,j+width)
  67.    Else Do
  68.      temp=temp substr(string,1,j+width-1)
  69.      string=substr(string,j+width)
  70.    End
  71.  End
  72.  string=temp string
  73.  temp=''
  74.  Return
  75.  JOIN_LINES:
  76.  Do k=k To ssize
  77.    If right(string,1)<>',' Then Leave
  78.    '+1 EXTRACT /CURLINE'
  79.    string=substr(string,1,length(string)-1) curline.3
  80.  End
  81.  Return
  82.  SPLIT_LINES:
  83.  Trace 'o'   /*T*/
  84.  temp=''
  85.  Do n=words(string)to 2 By -1
  86.    word=word(string,n)
  87.    If lastpos(' 'word' ',commands)=0 Then Iterate
  88.    i=lastpos(' 'word,string)
  89.    temp=strip(substr(string,i+1))
  90.    If left(temp,1)=':' Then temp=substr(temp,2)
  91.    If temp<>'' & temp<>';' Then Push temp
  92.    string=substr(string,1,i-1)
  93.  End
  94.  If string<>'' Then Push string
  95.  Drop temp word i
  96.  Return
  97.  PROCESS_STACK:
  98.  Do queued()
  99.    Pull string
  100.    string=strip(string,'b')
  101.    /* l.x contains values without quotes */
  102.    noquotes=translate(string,' ',"'"'"')
  103.    Parse Var noquotes l.1 l.2 l.3 .
  104.    /* process function calls */
  105.    Call process_function
  106.    Call drop_quoted_strings
  107.    Parse Var string wd.1 wd.2 wd.3 rest
  108.    /* check For assignment statement */
  109.    string=translate(string,' ',"'"'"')
  110.    /* process rexx commands and keywords */
  111.    i=wordpos(wd.1,commands)
  112.    If i>4 Then Interpret Call 'k'wd.1
  113.    Else If i>2 Then conditional?=1
  114.    If conditional? Then Call conditional
  115.    Call chklabels wd.2 wd.3 rest
  116.  End
  117.  Return
  118.  PROCESS_FUNCTION:
  119.  Do Forever
  120.    x=length(string)
  121.    If x=0 Then Leave
  122.    x=lastpos('( ',string,x)
  123.    If x<2 Then Leave
  124.    y=max(lastpos(' ',string,x),lastpos('=',string,x),,
  125.    lastpos('(',string,x-1))
  126.    function=substr(string,y+1)
  127.    w=pos(')',function,)
  128.    If w=0 Then Do
  129.      Call msg '240'
  130.      Leave; End
  131.    function=substr(function,1,w-1)
  132.    x=pos('(',function,)
  133.    name=substr(function,1,x-1)
  134.    If name='' Then Leave
  135.    If x+1=w Then parms=''
  136.    Else parms=substr(function,x+1,length(function)-x-1)
  137.    If right(string,1)='('
  138.    Then string=left(string,y-1)'RESULT' substr(string,w+y+2)
  139.    Else string=left(string,y-1) 'RESULT' substr(string,w+y+2)
  140.    words=space(translate(parms,' ',"'"'"'))
  141.    Parse Var words w1','w2','w3','w4','w5','w6','w7','w8','w9','w10
  142.    Parse Var parms p1','p2','p3','p4','p5','p6','p7','p8','p9','p10
  143.    If wordpos(name'(',list)>0 Then Do
  144.      Interpret 'call F'name
  145.      Call chklabels p1 p2 p3 p4 p5 p6 p7 p8 p9 p10; End
  146.    Else Call msg '040' name
  147.  End
  148.  Drop name parms function
  149.  Return
  150.  CHKLABELS:
  151.  Arg parms
  152.  codes='+-/\*:,%><='
  153.  if pc? then nop
  154.  else codes=codes'4f'x'5f'x /* bar and negate */
  155.  parms=translate(parms,' ',codes)
  156.  Do Until parms=''
  157.    Parse Var parms parm parms
  158.    If parm='.' Then Iterate
  159.    If datatype(parm,'w')then Nop;else Do
  160.      i=wordpos(parm,labels)
  161.      If i>0&word(labels,i+1)='undef' Then Call msg '050' parm
  162.    End
  163.  End
  164.  
  165.  Return; CONDITIONAL:
  166.  Parse Var string . wd.2 wd.3 rest
  167.  conditional?=0
  168.  j=translate(string,' ','ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"?.@#!_()'"'")
  169.  i=any(listop,j)
  170.  If words(i)>1 Then Call msg '061'
  171.  Else If i=0 & words(j)=1 Then Call msg '060' strip(j) 'may be:' listop
  172.  If (wd.1='UNTIL')+(wd.1='WHILE')>0 Then Return
  173.  Return
  174.  
  175.    /* Will Return a 1 If any of the words in the first */
  176.    /* argument are also in the second argument Else    */
  177.    /* Return a 0                                       */
  178.  ANY:
  179.  Arg dblist , dbarg
  180.  Do dbi=1 To words(dblist)
  181.    dbj=wordpos(word(dblist,dbi),dbarg)
  182.    If dbj > 0 Then Return 1
  183.  End
  184.  Return 0
  185.  
  186.    /* Drop quoted strings */
  187.  DROP_QUOTED_STRINGS:
  188.  Do Forever
  189.    Parse Value pos(sq,str) pos(dq,str) pos('/*',str),
  190.    With h i j
  191.    If h=0 Then h=500
  192.    If i=0 Then i=500
  193.    i=min(h,i)
  194.    If i=500 Then Leave
  195.    delimiter=substr(string,i,1)
  196.    temp=substr(string,1,i-1)
  197.    string=substr(string,i+1)
  198.    j=pos(delimiter,string)
  199.    If j>0 Then string=temp 'LITERAL' substr(string,j+1)
  200.    Else Do
  201.      string=temp 'LITERAL'
  202.      Leave; End
  203.  End
  204.  temp=''
  205.  
  206.  Return; MSG:
  207.  Parse Arg key msg
  208.  'COMMAND EXTRACT /line'
  209.  msg='***' right(line.1,3) rsynmsg(key) msg
  210.  ':1 REPLACE' msg
  211.  If pc? Then 'COMMAND PUT 1' syntax
  212.  Else Address Command 'EXECIO 1 DISKW' syntax '(NOTYPE VAR MSG'
  213.  'COMMAND SOS TABCMDF'
  214.  'QQUIT'
  215.  'XEDIT' syntax
  216.  'COMMAND BOTTOM'
  217.  '-5'
  218.  'COMMAND SOS TABCMDB'
  219.  ':'line.1
  220.  'COMMAND REFRESH'
  221.  Drop msg
  222.  
  223.  Return;fABBREV:fCENTRE:fCENTER:fCOMPARE:fINDEX:fJUSTIFY:
  224.  If (p1='')+(p2='')>0 Then Call msg 070 1 or 2
  225.  If p4<>'' Then Call msg 080 w4
  226.  
  227.  Return;fABS:fC2X:fERRORTEXT:fLENGTH:fOPTIONS:fREVERSE:fSIGN:
  228.  fSYMBOL:fVALUE:fX2C:fX2D:fWORDS:
  229.  If p1='LITERAL' Then Call msg 090 '1:' p1
  230.  If p1='' Then Call msg 070
  231.  If p2<>'' Then Call msg 080 w2
  232.  
  233.  Return;fADDRESS:fEXTERNAL:fLINESIZE:fQUEUED:fUSERID:
  234.  If p1<>'' Then Call msg 080 w1
  235.  
  236.  Return;fARG:
  237.  If p3<>'' Then Call msg 080 w3
  238.  If p2='' Then Nop
  239.  Else If w2<>'E' & w2<>'O' Then Call msg 100 w2
  240.  
  241.  Return;fSTORAGE:
  242.  If p1='' & p2='' & p3='' Then Return
  243.  fBITAND:fBITOR:fBITXOR:fFIND:fSPACE:
  244.  If p1='' Then Call msg 070
  245.  If p4<>'' Then Call msg 080 w4
  246.  
  247.  Return;fCMSFLAG:
  248.  If wordpos(w1,listflag)=0 Then Call msg '120' w1 'may be: 'listflag
  249.  If p2<>'' Then Call msg 080 w2
  250.  
  251.  Return;fDATATYPE:
  252.  If p2<>'' Then Do
  253.    If wordpos(w1,listdatatype,substr(w2,2,1))=0 Then
  254.    Call msg 100 w2 'may be:' listdatatype; End
  255.  p2=''
  256.  fCOPIES:fWORD:fWORDINDEX:fWORDLENGTH:fXRANGE:
  257.  If p1='' Then Call msg 110
  258.  If p3<>'' Then Call msg 080 w3
  259.  
  260.  Return;fc2X:fD2C:fX2D:fD2X:fTRUNC:
  261.  If p3<>'' Then Call msg 080 w2
  262.  If (p1='')+(p2='')>0 Then Call msg 110
  263.  If p3<>'' Then Call msg 080 w3
  264.  
  265.  Return;fDATE:
  266.  If p1='' Then Return
  267.  If p2<>'' Then Call msg 080
  268.  If wordpos(w1,listdate)=0 Then Call msg 100 w1 'may be:' listdate
  269.  
  270.  Return;fDIAG:fDIAGRC:
  271.  
  272.  Return;fFORMAT:
  273.  If p1='' Then Call msg 070
  274.  If p2='' Then Return
  275.  If p2<>'BEFORE' Then Call msg 260
  276.  If p3<>'AFTER'  Then Call msg 270
  277.  p2=''
  278.  p3=''
  279.  
  280.  Return;fDELSTR:fDELWORD:fLASTPOS:fLEFT:fPOS:fRIGHT:fSUBWORD:
  281.  If p4<>'' Then Call msg 080 w4
  282.  If p2='LITERAL' Then Call msg 090 '2:' w2
  283.  If (p1='')+(p2='')>0 Then Call msg 110
  284.  
  285.  Return;fINSERT:fOVERLAY:
  286.  If (p1='')+(p2='')>0 Then Call msg 110
  287.  
  288.  Return;fMAX:fMIN:
  289.  If p1='' Then Call msg 070
  290.  
  291.  Return;fSTRIP:
  292.  If w2<>''&wordpos(w2,liststrip)=0 Then Call msg 100 w2 'may be:' liststrip
  293.  p2=p1
  294.  fRANDOM:
  295.  If p1<>'' Then Signal fbitand
  296.  
  297.  Return;fSOURCELINE:
  298.  If p1='' Then Return
  299.  If p2<>'' Then Call msg 080 w2
  300.  
  301.  Return;fSUBSTR:
  302.  If p5<>'' Then Call msg 080 w5
  303.  If (p1='')+(p2='')>0 Then Call msg 110
  304.  
  305.  Return;fTIME:
  306.  If p1='' Then Return
  307.  If wordpos(w1,listtime)=0 Then Call msg '100' w1 'may be:' listtime
  308.  If p2<>'' Then Call msg 080 w2
  309.  
  310.  Return;fTRANSLATE:
  311.  If p1='' Then Call msg 070 1
  312.  If p6<>'' Then Call msg 080 w6
  313.  
  314.  Return;fVERIFY:
  315.  If (p1='')+(p2='')>0 Then Call msg 110
  316.  If p5<>'' Then Call msg 080 w5
  317.  If left(w3,2)<>' M' & p3<>'' Then Call msg 130
  318.  w3=''
  319.  
  320.  Return;kADDRESS:
  321.  If wd.2<>'' Then Do
  322.    If (wd.2='RESULT')+(wordpos(wd.2,listaddress)>0)>0 Then wd.2=''
  323.    Else Call msg 100 wd.2 'may be:' listaddress
  324.  End
  325.  
  326.  Return;kARG:kPULL:
  327.  Parse Value '' With wd.2 wd.3 rest
  328.  
  329.  Return;kDIGITS:
  330.  
  331.  Return;kBY:kCALL:kDROP:kEXIT:kFOR:kOPTIONS:kPUSH:kQUEUE:kRETURN:kSAY:
  332.  kTO:kUPPER:
  333.  
  334.  Return;kSELECT:
  335.  selectlevel=level
  336.  select?=1
  337.  kDO:
  338.  If level=0 Then lastset=line.1
  339.  level=level+1
  340.  do?=1
  341.  If wd.2='' Then Return
  342.  doloop?=1
  343.  
  344.  Return; kELSE:
  345.  If then?.level=0 Then Call msg 190
  346.  If else?.level Then Call msg 200
  347.  else?.level=1
  348.  then?.level=0
  349.  
  350.  Return; kEND:
  351.  If level>-1 Then
  352.  Parse Value 0 0 0 0 With if?.level then?.level else?.level when?.level
  353.  level=level-1
  354.  If level=0 Then Do
  355.    doloop?=0
  356.    lastset=line.1
  357.    If selectlevel=level Then select?=0
  358.  End
  359.  
  360.  Return;kEXTERNAL:kSOURCE:kVAR:kVERSION:
  361.  If parse?=0 Then Call msg 140
  362.  If wd.1<>'VAR' Then wd.2=''
  363.  Parse Value '' With wd.3 rest
  364.  
  365.  Return;kIF:
  366.  If if?.level Then Call msg 190
  367.  Parse Value 1 0 0 1 With if?.level then?.level else?.level conditional?
  368.  
  369.  Return;kINTERPRET:
  370.  If pos('=',string)>0 Then Call msg 150
  371.  Parse Var noquotes wd.1 wd.2 wd.3 rest
  372.  
  373.  Return;kUNTIL:kWHILE:
  374.  If do? Then do?=1
  375.  conditional?=1
  376.  kITERATE:kLEAVE:
  377.  If doloop?=0 Then Call msg 160
  378.  
  379.  Return;kNUMERIC:
  380.  If wordpos(wd.2,listnumeric)=0 Then
  381.  Call msg 100 wd.2 'may be:' listnumeric
  382.  If (wd.3='SCIENTIFIC')+(wd.3='ENGINEERING')>0 Then wd.3=
  383.  wd.2=''
  384.  
  385.  Return;kOTHERWISE:
  386.  If select?=0 Then Call msg 210
  387.  
  388.  Return;kPARSE:
  389.  parse?=1
  390.  
  391.  Return;kPROCEDURE:
  392.  If wd.2='EXPOSE' & wd.3='' Then Call msg 170
  393.  wd.2=''
  394.  
  395.  Return;kSIGNAL:
  396.  If (wd.2='ON')+(wd.2='OFF')>0 Then Do
  397.    wd.2=''
  398.    If wordpos(wd.3,listsignal)=0 Then
  399.    Call msg 100 wd.3 'may be:' listsignal; End
  400.  If wd.2='VALUE' Then wd.2=''
  401.  
  402.  Return;kTHEN:
  403.  If if?.level=0&when?.level=0 Then Call msg 200
  404.  If (then?.level)+(else?.level)>0 Then Call msg 200
  405.  Parse Value 0 0 1 With if?.level when?.level then?.level
  406.  If wd.3='=' Then wd.3=''
  407.  
  408.  Return;kTRACE:
  409.  If left(wd.2,6)='VALUE(' Then Return
  410.  If wd.2='RESULT' Then Return
  411.  w1=left(l.2,1)
  412.  w2=substr(l.2,2,1)
  413.  If w2='' Then w2=w1
  414.  If wordpos(w1,listtrace)>0&wordpos(w2,listtrace)>0 Then Nop
  415.  Else Call msg 100 l.2 'may be:' listtrace
  416.  
  417.  Return;kVALUE:  /*  ? check out */
  418.  If parse? Then Do
  419.    w2=''
  420.    i=wordpos('WITH',string)
  421.    If i=0 Then Call msg 180
  422.    Else Do
  423.      Do x=2 To i
  424.        w2=w2 wd.x; End
  425.      wd.2=w2
  426.    End
  427.  End
  428.  
  429.  Return;kWHEN:
  430.  If select?=0 Then Call msg 210
  431.  If when?.level Then Call msg 190
  432.  Parse Value 1 0 0 1 With when?.level then?.level else?.level conditional?
  433.  
  434.  Return; initial:
  435.  ':0 EXTRACT /FN/FT/LINE/SIZE/MSGMODE'
  436.  'COMMAND SET MSGMODE OFF'
  437.  If pc? Then Do
  438.  trace o?r   /*T*/
  439.    listop='= \> <> > < >< <> >= \<  <= == \== >> <<'
  440.    target=fname.1'.'ftype.1
  441.    syntax=fname.1'.syn'
  442.    commfile='rsyncomm.dat'
  443.    funcfile='rsynfunc.dat'
  444.    xrefmap=fname.1'.map'
  445.    syntdata='rsyndata.kex'
  446.  End
  447.  Else Do
  448.    listop='=' '5f'x'> <> > < >< <> >=' '5f'x'<  <=' '5f'x'> ==' '5f'x,
  449.    '== >> <<' /* 5f is negate */
  450.    target=fname.1 ftype.1 'A'
  451.    syntax=fname.1 'SYNTAX A'
  452.    commfile='RSYNCOMM DATA A'
  453.    funcfile='RSYNFUNC DATA A'
  454.    xrefmap=fname.1 'XREFMAP A'
  455.    syntdata='RSYNDATA XEDIT A3'
  456.  End
  457.  If line.1=0 Then line.1=1
  458.  sline=1
  459.  ssize=size.1
  460.  If (num='*')+(num='')>0 Then num=size.1-line.1+1
  461.  If datatype('0'num,'w')=0 Then Call msg '010'
  462.  labels='RESULT DEF LITERAL DEF SIGL DEF RC DEF'
  463.  listaddress='COMMAND CMS COMMAND ISPEXEC DOS XEDIT KEDIT'
  464.  listdatatype='A B L M N S U W X'
  465.  listdate='C D E J M O S U W'
  466.  listflag='ABBREV AUTOREAD CMSTYPE DOS EXTERNAL IMPCP IMPEX PROTECT',
  467.  'RELPAGE SUBSET'
  468.  listnumeric='DIGITS FORM FUZZ'
  469.  listsignal='SYNTAX ERROR HALT NOVALUE'
  470.  liststrip='L T B'
  471.  listtime='E H L M R S'
  472.  listtrace='? ! A C E F I L N O R S'
  473.  Parse Value '' With commands list listunpaired
  474.  Parse Value "'" "|" 0 With sq DQ inserts
  475.  Parse Value 0 1 0 0 0 0 0 0 With level lastset doloop? conditional?,
  476.  if?. then?. else?. when?.
  477.  'MACRO rMATCH'
  478.  listunpaired=''
  479.  Do n=1
  480.    '.'n
  481.    If rc<>0  Then Leave
  482.    'COMMAND EXTRACT /line'
  483.    listunpaired=listunpaired line.1
  484.  End
  485.  Do n=1 To 2
  486.    'XEDIT' commfile
  487.    'COMMAND EXTRACT /SIZE'
  488.    Do size.1
  489.      '+1 EXTRACT /CURLINE'
  490.      If n=1 Then COMMANDS=Commands curline.3
  491.      Else list=list curline.3
  492.    End
  493.    'COMMAND QUIT'
  494.    commfile=funcfile
  495.  End
  496.  'ERASE' syntdata
  497.  'ERASE' syntax
  498.  ':1 PUT' ssize syntdata
  499.  'XEDIT' syntdata
  500.  'COMMAND SET SCR 2'
  501.  if pc?
  502.  then 'MACRO RSYNCHG' sline num
  503.  else 'RSYNCHG' sline num
  504.  Drop commfile funcfile
  505.  Return
  506.