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