home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional Developers Kit 1992 November / Disc01 / Disc01.mdf / prodtool / epm / e_macros / math.e < prev    next >
Encoding:
Text File  |  1992-06-04  |  10.8 KB  |  389 lines
  1. ; MATH.E      Combines old MATH.E and EXP.E.
  2. ;
  3. ;  Linking version for EOS2:  The bulk of the old MATH.E routines are
  4. ;  placed in another file MATHLIB.E, which is linked only when needed.
  5. ;
  6. define math_link = not (INCLUDE_MATHLIB or E3 or EXTRA_EX)
  7. defc add=
  8.  compile if MATH_LINK
  9.    --- For linking version:  make sure the base routines are linked in.
  10.    link 'mathlib'
  11.    if RC<0 then
  12.       sayerror UNABLE_TO_LINK__MSG 'MathLib'
  13.       return
  14.    endif
  15.  compile endif
  16.  compile if not E3
  17.    if marktype()=='' then
  18.       'L /[0-9]/g'      -- find first number
  19.       if rc then
  20.          sayerror "Can't find a number (from cursor position to end of file)"
  21.          return
  22.       endif
  23.       call psave_pos(save_pos)
  24.       markline
  25.       for i=.line+1 to .last  -- find first line without a number
  26.          if not verify(textline(i),'0123456789','M') then
  27.             leave
  28.          endif
  29.       endfor
  30.       .line=i-1; markline
  31.       call column_math('+')
  32.       unmark        -- Started with no mark
  33.       call prestore_pos(save_pos)
  34.    else
  35.  compile else  -- else *is* E3
  36.    call checkmark()
  37.  compile endif
  38.    call column_math('+')
  39.  compile if not E3
  40.   endif
  41.  compile endif
  42.  
  43. defc math=
  44.    call mathcommon(arg(1),'')
  45.  
  46. defc matho=
  47.    call mathcommon(arg(1),'o')
  48.  
  49. defc mathx=
  50.    call mathcommon(arg(1),'x')
  51.  
  52. defc mult=
  53.    call checkmark()
  54.  compile if MATH_LINK
  55.    --- For linking version:  make sure the base routines are linked in.
  56.    link 'mathlib'
  57.    if RC<0 then
  58.       sayerror UNABLE_TO_LINK__MSG 'MathLib'
  59.       return
  60.    endif
  61.  compile endif
  62.    call column_math('*')
  63.  
  64. defproc mathcommon(input,suffix)
  65.  compile if MATH_LINK
  66.    --- For linking version:  make sure the base routines are linked in.
  67.    link 'mathlib'
  68.    if RC<0 then
  69.       sayerror UNABLE_TO_LINK__MSG 'MathLib'
  70.       return
  71.    endif
  72.  compile endif
  73.    if evalinput(result,input,suffix) then
  74.       call experror();stop
  75.    else
  76. compile if EVERSION < 5
  77.       setcommand 'math'suffix input'= 'result
  78. compile else
  79.       sayerror 'math'suffix input'= 'result  -- no setcommand in epm
  80. compile endif
  81.    endif
  82.  
  83. ;  The rest is the same as MATHLIB.E.  Must be compiled into base if we're
  84. ;  not running the linking version of EOS2 (unless INCLUDE_MATHLIB set).
  85. compile if not MATH_LINK
  86.  
  87. defproc column_math
  88.   getmark firstline,lastline,firstcol,lastcol,fileid
  89.    result = arg(1)='*'   -- Result = 1 if '*', or 0 if '+'
  90. ;  if arg(1)='+' then
  91. ;     result=0
  92. ;  else
  93. ;    result=1
  94. ;  endif
  95.  
  96.   call pinit_extract()
  97.   loop
  98.     code = pextract_string(line)
  99.     if code = 1 then leave endif
  100.     if code = 0 then  /* ignore blank lines */
  101.          -- Find the number within the line.  Frees the user from having
  102.          -- to have a perfectly-fitting block mark around the numbers.
  103.          -- jbl 12/20/88 bug fix:  line might start with minus sign or decimal.
  104.          -- LAM: The Parse was using only the first number on each line.
  105.          startnum = verify(line,'0123456789-','M')
  106.          if startnum then
  107. ;           parse value substr(line,startnum) with line .
  108.             line = substr(line,startnum)
  109.          endif
  110.          if evalinput(tempresult, line, '',arg(1)) then
  111.             call experror()
  112.          else
  113.            if arg(1)='+' then
  114.              result=result+tempresult
  115.            else
  116.              result=result*tempresult
  117.            endif
  118.          endif
  119.       endif
  120.    endloop
  121.    -- Line up by the last digit of last line.  The old way lined up by
  122.    -- the first digit which was seldom desirable:
  123.    --insertline substr('',1,firstcol-1)result,lastline+1,fileid
  124.    res_len = length(result)
  125.    lpad = startnum+length(line)-res_len-1
  126.  
  127.    -- jbl 12/11/88:  make it work with or without a marked area.
  128.    lpad = max(lpad + firstcol -1, 0)
  129.  
  130.    -- If the next line has spaces in the proper posiition, fill them,
  131.    -- don't insert a new line.
  132.    if lastline<.last then
  133.       getline line, lastline+1
  134.    else
  135.       line=''
  136.    endif
  137.    -- If the next line is all same character, like a dotted line, skip over.
  138.    dash = substr(line,lpad+1,res_len)
  139.    ch = substr(dash,1,1)
  140.    if not verify(dash,ch) & ch<>' ' then
  141.       lastline=lastline+1
  142.       if lastline<.last then
  143.          getline line, lastline+1
  144.       endif
  145.    endif
  146.    if not verify(substr(line,lpad+1,res_len),' ') & lastline<.last then
  147. compile if not E3
  148.       replaceline overlay(result,line,lpad+1), lastline+1
  149. compile else                                       -- No overlay() in E3
  150.       replaceline substr(line,1,lpad) || result || substr(line,lpad+res_len+1),
  151.                   lastline+1
  152. compile endif
  153.    else
  154.       pad = substr(' ',1,lpad)
  155.       insertline pad || result,lastline+1,fileid
  156.    endif
  157.  
  158.  
  159. /* returns 0 if expression evaluated successfully. */
  160. /* result is set to evaluation of expression when successful */
  161. /* returns 1 if error.  No message displayed */
  162. defproc evalinput(var result,var sourceline,output)
  163.    universal i,input
  164.    universal exp_stack
  165.    universal sym
  166.  
  167.    exp_stack=''
  168.    i=pos('=',sourceline)
  169.    if i then
  170.       sourceline=substr(sourceline,1,i-1)
  171.    endif
  172.    input=sourceline
  173.    i=1; call next_sym()
  174.    call exp(arg(4))  -- Accept & pass to exp an optional 4th argument
  175.    if sym<>'$' then
  176.       return 1
  177.    else
  178.       result=exp_stack
  179.       if output='x' then
  180.          result=dec2hex(result)
  181.       elseif output='o' then
  182.          result=dec2hex(result,8)
  183.       endif
  184.       return 0
  185.    endif
  186.  
  187.  
  188. ;  EXP takes an optional argument saying what the default operator
  189. ;  should be.  (I.e., what operator should be assumed if 2 numbers appear one
  190. ;  after the other).  If not given, error.  ('+' was assumed previously.)
  191. defproc exp
  192.    universal sym
  193.    op_stack='$'
  194.    loop
  195.       call unary_exp(arg(1))   -- Pass to unary_exp, because it calls us.
  196.       /* look for dual operator */
  197.       if pos(sym,'+-*%/?') then
  198.          oldsym=''
  199.       else
  200.          if not isnum(sym) & sym<>'(' then  -- '(' OK for column math.
  201.             leave
  202.          endif
  203.          oldsym=sym
  204.          if arg(1) then sym=arg(1); else call experror(); stop; endif
  205.       endif
  206.       while prec(substr(op_stack,length(op_stack)))>=prec(sym) do
  207.          call reduce_dualop(substr(op_stack,length(op_stack)))
  208.          op_stack=substr(op_stack,1,length(op_stack)-1)
  209.       endwhile
  210.       op_stack=op_stack||sym
  211.       if oldsym='' then
  212.          call next_sym()
  213.       else
  214.          sym=oldsym
  215.       endif
  216.    endloop
  217.    for j=length(op_stack) to 2 by -1
  218.       call reduce_dualop(substr(op_stack,j,1))
  219.    endfor
  220.  
  221.  
  222. defproc experror
  223.    sayerror SYNTAX_ERROR__MSG
  224.  
  225.  
  226. /* Dec2Hex       Usage:  HexStringOut=Dec2Hex(DecimalIn)          */
  227. /*               Result will be a string beginning with 'x'.      */
  228. /*  If decimal number is invalid, null string is returned.        */
  229. defproc dec2hex
  230.    if arg(2)<>'' then base=arg(2);output='o' else base=16;output='x' endif
  231.    if base='' then base=16 endif
  232.    dec=arg(1)
  233.    if not isnum(dec) then
  234.       return ''
  235.    endif
  236.    if dec<0 then
  237.       dec=dec+ MAXINT+1
  238.    endif
  239.    vhex=''
  240.    while dec>0 do
  241.       i=dec%base
  242.       vhex=substr('0123456789ABCDEF',dec-i*base+1,1)vhex
  243.       dec=i
  244.    endwhile
  245.    if vhex='' then
  246.       vhex='0'
  247.    endif
  248.    if arg(1)<0 then
  249.       if base=8 then
  250.          vhex='1'vhex
  251.       else
  252.          vhex='F'substr(vhex,2)
  253.       endif
  254.    endif
  255.    return output||vhex
  256.  
  257.  
  258. /* Hex2Dec       Usage:  DecimalOut=Hex2Dec(HexStringIn)                   */
  259. /*                       where HexStringIn may optionally begin with 'X'.  */
  260. /*  If hex number is invalid, null string is returned.                     */
  261. defproc hex2dec
  262.    if arg(2)<>'' then base=arg(2) else base=16 endif
  263.    vhex=arg(1)
  264.    if vhex='' then
  265.       return ''
  266.    endif
  267.    dec=0
  268.    loop
  269.       i=upcase(substr(vhex,1,1))
  270.       if i='' then leave endif
  271.       if i<>'X' then                     /* Ignore initial X if any. */
  272.          i=pos(i,'0123456789ABCDEF')
  273.          if not i then
  274.             return ''
  275.          endif
  276.          dec=dec*base -1 +i
  277.       endif
  278.       vhex=substr(vhex,2)
  279.    endloop
  280.    return dec
  281.  
  282. defproc lex_number
  283.    universal input,i
  284.    universal sym
  285.    universal j
  286.  
  287.    if not j then j=length(input)+1 endif
  288.    sym=substr(input,i+1,j-i-1)
  289.    sym=hex2dec(sym,arg(1))
  290.    if sym=='' then
  291.       call experror();stop
  292.    endif
  293.    i=j
  294.  
  295. defproc next_sym
  296.    universal sym
  297.    universal input,i
  298.    universal j
  299.  
  300.    call skip_spaces()
  301.    if i>length(input) then sym='$';return '' endif
  302.    sym=substr(input,i,1)
  303. compile if EVERSION >= 4            -- OS/2 version - real numbers
  304.    if pos(sym,'Oo\xX0123456789+-/%*()'DECIMAL) then
  305. compile else                        -- DOS version - integers only
  306.    if pos(sym,'Oo\xX0123456789+-/%*()') then
  307. compile endif
  308.       if isnum(sym) then
  309. compile if EVERSION >= 4            -- OS/2 version
  310.          j=verify(input,'0123456789'DECIMAL,'',i)
  311. compile else                        -- DOS version
  312.          j=verify(input,'0123456789','',i)
  313. compile endif
  314.          if not j then j=length(input)+1 endif
  315.          sym=substr(input,i,j-i)
  316.          i=j
  317.       elseif upcase(sym)='X' then
  318.          j=verify(input,'0123456789ABCDEFabcdef','',i+1)
  319.          call lex_number(16)
  320.       elseif upcase(sym)='O' or sym='\' then
  321.          j=verify(input,'01234567','',i+1)
  322.          call lex_number(8)
  323.       else
  324.          i=i+1
  325.          if sym='/' & substr(input,i,1)='/' then
  326.             sym = '?'  -- Use '?' to represent '//'
  327.             i=i+1
  328.          endif
  329.       endif
  330.    else
  331.       call experror();stop
  332.    endif
  333.  
  334. defproc prec
  335.    /* Group operators in 4's so +- and *%/? each have same precedence. */
  336.    return pos(arg(1),'$  +-  *%/?')%4+1
  337.  
  338. defproc reduce_dualop
  339.    universal exp_stack
  340.    parse value exp_stack with e2 e1 exp_stack
  341.    if arg(1)='+' then
  342.       exp_stack=e1+e2 exp_stack
  343.    elseif arg(1)='-' then
  344.       exp_stack=e1-e2 exp_stack
  345.    elseif arg(1)='*' then
  346.       exp_stack=e1*e2 exp_stack
  347.    elseif arg(1)='/' then
  348.       exp_stack=e1/e2 exp_stack
  349.    elseif arg(1)='%' then
  350.       exp_stack=e1%e2 exp_stack
  351.    elseif arg(1)='?' then
  352.       exp_stack=e1//e2 exp_stack
  353.    endif
  354.  
  355. defproc skip_spaces
  356.    universal input,i
  357.    j=verify(input,' ','',i)
  358.    if j then
  359.       i=j
  360.    else
  361.       i=length(input)+1
  362.    endif
  363.  
  364. defproc unary_exp
  365.    universal exp_stack
  366.    universal sym
  367.  
  368.    if sym='(' then
  369.       call next_sym()
  370.       call exp(arg(1))
  371.       if sym<>')' then experror();stop endif
  372.       call next_sym()
  373.    elseif isnum(sym) then
  374.       exp_stack=sym exp_stack
  375.       call next_sym()
  376.    elseif sym='-' then
  377.       call next_sym()
  378.       call unary_exp(arg(1))
  379.       parse value exp_stack with e1 exp_stack
  380.       exp_stack=-e1 exp_stack
  381.    elseif sym='+' then
  382.       call next_sym()
  383.       call unary_exp()
  384.    else
  385.       call experror();stop
  386.    endif
  387.  
  388. compile endif -- not MATH_LINK
  389.