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