home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional Developers Kit 1992 November / Disc01 / Disc01.mdf / prodtool / epm / e_macros / mathlib.e < prev    next >
Encoding:
Text File  |  1992-06-04  |  8.5 KB  |  309 lines
  1. ;  MATHLIB.E   added to EOS2 4.02 to make the bulk of the math procedures
  2. ;              linkable on an as-needed basis.
  3. ;
  4. include 'STDCONST.E'
  5. tryinclude 'mycnf.e'
  6. compile if not defined(DECIMAL)
  7. const DECIMAL = '.'
  8. compile endif
  9. compile if not defined(NLS_LANGUAGE)
  10.   const NLS_LANGUAGE = 'ENGLISH'
  11. compile endif
  12. include NLS_LANGUAGE'.e'
  13.  
  14.  
  15. defproc column_math
  16.    getmark firstline,lastline,firstcol,lastcol,fileid
  17.    result = arg(1)='*'   -- Result = 1 if '*', or 0 if '+'
  18. ;  if arg(1)='+' then
  19. ;     result=0
  20. ;  else
  21. ;    result=1
  22. ;  endif
  23.  
  24.    call pinit_extract()
  25.    loop
  26.       code = pextract_string(line)
  27.       if code = 1 then leave endif
  28.       if code = 0 then  /* ignore blank lines */
  29.          -- Find the number within the line.  Frees the user from having
  30.          -- to have a perfectly-fitting block mark around the numbers.
  31.          -- jbl 12/20/88 bug fix:  line might start with minus sign or decimal.
  32.          -- LAM: The Parse was using only the first number on each line.
  33.          startnum = verify(line,'0123456789-'DECIMAL,'M')
  34.          if startnum then
  35. ;           parse value substr(line,startnum) with line .
  36.             line = substr(line,startnum)
  37.          endif
  38.          if evalinput(tempresult, line, '',arg(1)) then
  39.             call experror()
  40.          else
  41.             if arg(1)='+' then
  42.                result=result+tempresult
  43.             else
  44.                result=result*tempresult
  45.             endif
  46.          endif
  47.       endif
  48.    endloop
  49.    -- Line up with decimal point of last line if there is one, else line up
  50.    -- by the last digit of last line.  The old way lined up by the first digit
  51.    -- which was seldom desirable:
  52.    --insertline substr('',1,firstcol-1)result,lastline+1,fileid
  53.    p = pos(DECIMAL,line)
  54.    if p then
  55.       q = pos(DECIMAL,result)
  56.       lpad = startnum+p-q-1
  57.    else
  58.       lpad = startnum+length(line)-length(result)-1
  59.    endif
  60.  
  61.    -- jbl 12/11/88:  make it work with or without a marked area.
  62.    lpad = max(lpad + firstcol -1, 0)
  63.  
  64.    -- If the next line has spaces in the proper posiition, fill them,
  65.    -- don't insert a new line.
  66.    if lastline<.last then
  67.       getline line, lastline+1
  68.    else
  69.       line=''
  70.    endif
  71.    -- If the next line is all same character, like a dotted line, skip over.
  72.    dash = substr(line,lpad+1,length(result))
  73.    ch = substr(dash,1,1)
  74.    if not verify(dash,ch) & ch<>' ' then
  75.       lastline=lastline+1
  76.       if lastline<.last then
  77.          getline line, lastline+1
  78.       endif
  79.    endif
  80.    if not verify(substr(line,lpad+1,length(result)),' ') & lastline<.last then
  81.       replaceline overlay(result,line,lpad+1), lastline+1
  82.    else
  83.       pad = substr(' ',1,lpad)
  84.       insertline pad || result,lastline+1,fileid
  85.    endif
  86.  
  87.  
  88. /* returns 0 if expression evaluated successfully. */
  89. /* result is set to evaluation of expression when successful */
  90. /* returns 1 if error.  No message displayed */
  91. defproc evalinput(var result,var sourceline,output)
  92.    universal i,input
  93.    universal exp_stack
  94.    universal sym
  95.  
  96.    exp_stack=''
  97.    i=pos('=',sourceline)
  98.    if i then
  99.       sourceline=substr(sourceline,1,i-1)
  100.    endif
  101.    input=sourceline
  102.    i=1; call next_sym()
  103.    call exp(arg(4))  -- Accept & pass to exp an optional 4th argument
  104.    if sym<>'$' then
  105.       return 1
  106.    else
  107.       result=exp_stack
  108.       if output='x' then
  109.          result=dec2hex(result)
  110.       elseif output='o' then
  111.          result=dec2hex(result,8)
  112.       endif
  113.       return 0
  114.    endif
  115.  
  116.  
  117. ;  EXP takes an optional argument saying what the default operator
  118. ;  should be.  (I.e., what operator should be assumed if 2 numbers appear one
  119. ;  after the other).  If not given, error.  ('+' was assumed previously.)
  120. defproc exp
  121.    universal sym
  122.    op_stack='$'
  123.    loop
  124.       call unary_exp(arg(1))   -- Pass to unary_exp, because it calls us.
  125.       /* look for dual operator */
  126.       if pos(sym,'+-*%/?') then
  127.          oldsym=''
  128.       else
  129.          if not isnum(sym) & sym<>'(' then  -- '(' OK for column math.
  130.             leave
  131.          endif
  132.          oldsym=sym
  133.          if arg(1) then sym=arg(1); else call experror(); stop; endif
  134.       endif
  135.       while prec(substr(op_stack,length(op_stack)))>=prec(sym) do
  136.          call reduce_dualop(substr(op_stack,length(op_stack)))
  137.          op_stack=substr(op_stack,1,length(op_stack)-1)
  138.       endwhile
  139.       op_stack=op_stack||sym
  140.       if oldsym='' then
  141.          call next_sym()
  142.       else
  143.          sym=oldsym
  144.       endif
  145.    endloop
  146.    for j=length(op_stack) to 2 by -1
  147.       call reduce_dualop(substr(op_stack,j,1))
  148.    endfor
  149.  
  150.  
  151. defproc experror
  152.    sayerror SYNTAX_ERROR__MSG
  153.  
  154.  
  155. /* Dec2Hex       Usage:  HexStringOut=Dec2Hex(DecimalIn)          */
  156. /*               Result will be a string beginning with 'x'.      */
  157. /*  If decimal number is invalid, null string is returned.        */
  158. defproc dec2hex
  159.    if arg(2)<>'' then base=arg(2);output='o' else base=16;output='x' endif
  160.    if base='' then base=16 endif
  161.    dec=arg(1)
  162.    if not isnum(dec) then
  163.       return ''
  164.    endif
  165.    if dec<0 then
  166.       dec=dec+ MAXINT+1
  167.    endif
  168.    vhex=''
  169.    while dec>0 do
  170.       i=dec%base
  171.       vhex=substr('0123456789ABCDEF',dec-i*base+1,1)vhex
  172.       dec=i
  173.    endwhile
  174.    if vhex='' then
  175.       vhex='0'
  176.    endif
  177.    if arg(1)<0 then
  178.       if base=8 then
  179.          vhex='1'vhex
  180.       else
  181.          vhex='F'substr(vhex,2)
  182.       endif
  183.    endif
  184.    return output||vhex
  185.  
  186.  
  187. /* Hex2Dec       Usage:  DecimalOut=Hex2Dec(HexStringIn)                   */
  188. /*                       where HexStringIn may optionally begin with 'X'.  */
  189. /*  If hex number is invalid, null string is returned.                     */
  190. defproc hex2dec
  191.    if arg(2)<>'' then base=arg(2) else base=16 endif
  192.    vhex=arg(1)
  193.    if vhex='' then
  194.       return ''
  195.    endif
  196.    dec=0
  197.    loop
  198.       i=upcase(substr(vhex,1,1))
  199.       if i='' then leave endif
  200.       if i<>'X' then                     /* Ignore initial X if any. */
  201.          i=pos(i,'0123456789ABCDEF')
  202.          if not i then
  203.             return ''
  204.          endif
  205.          dec=dec*base -1 +i
  206.       endif
  207.       vhex=substr(vhex,2)
  208.    endloop
  209.    return dec
  210.  
  211. defproc lex_number
  212.    universal input,i
  213.    universal sym
  214.    universal j
  215.  
  216.    if not j then j=length(input)+1 endif
  217.    sym=substr(input,i+1,j-i-1)
  218.    sym=hex2dec(sym,arg(1))
  219.    if sym=='' then
  220.       call experror();stop
  221.    endif
  222.    i=j
  223.  
  224. defproc next_sym
  225.    universal sym
  226.    universal input,i
  227.    universal j
  228.  
  229.    call skip_spaces()
  230.    if i>length(input) then sym='$';return '' endif
  231.    sym=substr(input,i,1)
  232.    if pos(sym,'Oo\xX0123456789+-/%*()'DECIMAL) then
  233.       if isnum(sym) then
  234.          j=verify(input,'0123456789'DECIMAL,'',i)
  235.          if not j then j=length(input)+1 endif
  236.          sym=substr(input,i,j-i)
  237.          i=j
  238.       elseif upcase(sym)='X' then
  239.          j=verify(input,'0123456789ABCDEFabcdef','',i+1)
  240.          call lex_number(16)
  241.       elseif upcase(sym)='O' or sym='\' then
  242.          j=verify(input,'01234567','',i+1)
  243.          call lex_number(8)
  244.       else
  245.          i=i+1
  246.          if sym='/' & substr(input,i,1)='/' then
  247.             sym = '?'  -- Use '?' to represent '//'
  248.             i=i+1
  249.          endif
  250.       endif
  251.    else
  252.       call experror();stop
  253.    endif
  254.  
  255. defproc prec
  256.    /* Group operators in 4's so +- and *%/? each have same precedence. */
  257.    return pos(arg(1),'$  +-  *%/?')%4+1
  258.  
  259. defproc reduce_dualop
  260.    universal exp_stack
  261.    parse value exp_stack with e2 e1 exp_stack
  262.    if arg(1)='+' then
  263.       exp_stack=e1+e2 exp_stack
  264.    elseif arg(1)='-' then
  265.       exp_stack=e1-e2 exp_stack
  266.    elseif arg(1)='*' then
  267.       exp_stack=e1*e2 exp_stack
  268.    elseif arg(1)='/' then
  269.       exp_stack=e1/e2 exp_stack
  270.    elseif arg(1)='%' then
  271.       exp_stack=e1%e2 exp_stack
  272.    elseif arg(1)='?' then
  273.       exp_stack=e1//e2 exp_stack
  274.    endif
  275.  
  276. defproc skip_spaces
  277.    universal input,i
  278.    j=verify(input,' ','',i)
  279.    if j then
  280.       i=j
  281.    else
  282.       i=length(input)+1
  283.    endif
  284.  
  285. defproc unary_exp
  286.    universal exp_stack
  287.    universal sym
  288.  
  289.    if sym='(' then
  290.       call next_sym()
  291.       call exp(arg(1))
  292.       if sym<>')' then experror();stop endif
  293.       call next_sym()
  294.    elseif isnum(sym) then
  295.       exp_stack=sym exp_stack
  296.       call next_sym()
  297.    elseif sym='-' then
  298.       call next_sym()
  299.       call unary_exp(arg(1))
  300.       parse value exp_stack with e1 exp_stack
  301.       exp_stack=-e1 exp_stack
  302.    elseif sym='+' then
  303.       call next_sym()
  304.       call unary_exp()
  305.    else
  306.       call experror();stop
  307.    endif
  308.  
  309.