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