home *** CD-ROM | disk | FTP | other *** search
/ Enigma Amiga Life 113 / EnigmaAmiga113CD.iso / software / grafica / picfx / e-source / parser.e < prev    next >
Encoding:
Text File  |  2000-05-21  |  32.2 KB  |  908 lines
  1. OPT MODULE,LARGE,PREPROCESS
  2.  
  3. MODULE 'amigalib/lists',
  4.        'dos/dos',
  5.        'exec/lists','exec/memory','exec/nodes','exec/ports','exec/semaphores','exec/tasks',
  6.        'graphics/rastport',->'cybergraphics','picasso96api',
  7.        '*varlist'
  8.  
  9. MODULE 'tools/debug' -> kputfmt('',[])
  10.  
  11. #define pixel(raw,w,x,y) raw[x+(y*w)]
  12. -> Can't we export a #define?
  13.  
  14. /* Some stuff for picFX... I was forced to put it here, as I couldn't reference the main executable when needing them */
  15.  
  16. EXPORT OBJECT subtaskmsg
  17.    stm_Message:mn
  18.    stm_Command:INT
  19.    stm_Parameter:LONG
  20.    stm_Result:LONG
  21. ENDOBJECT
  22.  
  23. EXPORT OBJECT subtask
  24.   st_Task:PTR TO tc      /* sub task pointer */
  25.   st_Port:PTR TO mp      /* allocated by sub task */
  26.   st_Reply:PTR TO mp     /* allocated by main task */
  27.   st_Data:LONG           /* more initial data to pass to the sub task */
  28.   st_Message:subtaskmsg  /* Message buffer */
  29. ENDOBJECT
  30.  
  31.  
  32. EXPORT OBJECT planeFunc_data
  33.     projectid -> Project ID, used when referencing a project from "outside"
  34.     modified:CHAR -> if the project had been modified after last save
  35.  
  36.                         /***attributes storage***/
  37.     bfunc:PTR TO expression
  38.     bstr:PTR TO CHAR
  39.     failure                    /*$RGB*/
  40.     gfunc:PTR TO expression
  41.     gstr:PTR TO CHAR
  42.     height
  43.     imagefile:PTR TO CHAR    -> eg 'picture."2:t"'
  44.     imagefilename:PTR TO CHAR-> eg 'picture.06'
  45.     left,newleft                ->scroll when newleft is non-zero
  46.     loading
  47.     loadm
  48.     lock -> -1 when there's a writelock, 0 when it is free, number of readlocks otherwise
  49.     name:PTR TO CHAR
  50.     paused -> this is used by the 'state' attribute, with the 'lock' var
  51.     ratio        -> scale ratio to which display the picture, multiplied by one million.
  52.     rfunc:PTR TO expression
  53.     rstr:PTR TO CHAR
  54.     outputr,outputg,outputb
  55.     quiet
  56.     top,newtop                  -> scroll when newtop is non-zero
  57.     type
  58.     width
  59.     xmin,xmax,ymin,ymax         -> area to draw to
  60.                         /***some pointers...***/
  61.     hscroll,vscroll         -> scrollers of the window
  62.     app                     -> true if we can send an update message.
  63.     self                    -> pointer to ourselves
  64.     win                     -> pointer to our window object
  65.                         /***some useful data***/
  66.     savepixel               -> true if the previous pixel must be saved
  67.     rupd                    -> copy of the render-update preference variable.
  68.     sema:ss                 -> data item protection
  69.     subtask:PTR TO subtask  -> our sub task
  70.  
  71.     drawhandle              -> draw handle
  72.     imagedata:PTR TO LONG,vec-> pixel information for the picture. vec is TRUE if we did allocate it with AllocVec()
  73.     picture                 -> picture
  74.  
  75.     drawn                   -> the last line that has been drawn to the window
  76.     calculated              -> the last line that has been calculated by the subtask
  77.     ds:datestamp            -> planeFunc stores the datestamp when a calculation is started
  78. ENDOBJECT
  79.  
  80. EXPORT ENUM OUT_Integer=0, -> 32bits integer
  81.             OUT_Float32, -> 32Bits float
  82.             OUT_Float64,  -> 64Bits float
  83.             OUT_OldR,OUT_OldG,OUT_OldB, -> Components of the pixel (previous calculation!)
  84.             OUT_CopyR,OUT_CopyG          -> Copies the new expression (e.g. black'n'white)
  85.  
  86. /* Function class. This class handles the functions like sin, +, r(), and so on, the old function class has been renamed to expression.
  87. You can easily add functions, just put the evaluation code somewhere (better is to keep the order !) and then put it in initfuncs, in
  88. the same way as the other.*/
  89.  
  90. OBJECT function
  91.     ln:ln
  92.     argcount:LONG
  93.     readpid -> if TRUE: cte::projectid ->-> data
  94.     evalI,evalF:LONG -> address of the evaluating procedures
  95. ENDOBJECT
  96. /* For compatibility with previous versions, a function having a constant will
  97. be read as f(cte,arg1,arg2), and not f(arg1,arg2,cte), as you might think*/
  98.  
  99. EXPORT DEF fconstant,fvariable, -> The addresses of these two function nodes  (!FUNCTION OBJECTS!)
  100.            firstb,lastb:PTR TO ln        -> first & last x_y .     (!LN OBJECTS!)
  101.  
  102. DEF funclist:PTR TO lh,
  103.     gtd,-> gtd is the address of the getdata(dat,num) PROC
  104.     dat,-> dat is the address of the ProjectlistObject's data
  105.     vlo -> vlo is the current VariableListObject
  106.  
  107. DEF c,p,s -> c,p = number of used A5, respectively by calc and precalc; s is used A1.
  108.  
  109. DEF count,mc,bs, -> precompilation stuff    mc stands for max-count, bs for buffer-size
  110.     code:PTR TO INT,crs:PTR TO INT, -> code is the beginning, crs is the point we are at.
  111.     precalc:PTR TO INT,prs:PTR TO INT,
  112.     buffer                          ->  *temporary* storage of the current buffer (*copy* of self.buffer, the address)
  113.  
  114. PROC create(name,argcount,evalI,evalF) OF function
  115.     self.ln.name:=String(StrLen(name))
  116.     StrCopy(self.ln.name,name)
  117.     self.argcount:=argcount
  118.     self.evalI:=evalI
  119.     self.evalF:=evalF
  120. ENDPROC
  121.  
  122. PROC end() OF function
  123.     DisposeLink(self.ln.name)
  124. ENDPROC
  125.  
  126. EXPORT PROC initfuncs(gtda,data,varlst) -> getData(), projectList_data, VarListObject
  127. DEF thatfunc:PTR TO function
  128.  
  129.     IF gtd = gtda THEN RETURN -> We had already been called
  130.  
  131.     gtd:=gtda
  132.     dat:=data
  133.     vlo:=varlst
  134.  
  135.     NEW funclist
  136.     newList(funclist)
  137.  
  138.     NEW thatfunc.create('Constant',0,{e_constant},{e_constant})
  139.     AddTail(funclist,thatfunc.ln)
  140.     fconstant:=thatfunc
  141.     NEW thatfunc.create('Variable',0,{e_variable},{e_variable})
  142.     AddTail(funclist,thatfunc.ln)
  143.     fvariable:=thatfunc
  144.  
  145. /*Following functions are sorted by order of priority*/
  146.  
  147.     NEW thatfunc.create('%',2,{e_mod},{f_mod})
  148.     AddTail(funclist,thatfunc.ln)
  149.     firstb:=thatfunc.ln -> This is the first x_y style operator
  150.  
  151.     NEW thatfunc.create('+',2,{e_add},{f_add})
  152.     AddTail(funclist,thatfunc.ln)
  153.  
  154.     NEW thatfunc.create('-',2,{e_sub},{f_sub})
  155.     AddTail(funclist,thatfunc.ln)
  156.  
  157.     NEW thatfunc.create('*',2,{e_mul},{f_mul})
  158.     AddTail(funclist,thatfunc.ln)
  159.  
  160.     NEW thatfunc.create('/',2,{e_div},{f_div})
  161.     AddTail(funclist,thatfunc.ln)
  162.  
  163.     NEW thatfunc.create('^',2,{e_pow},{f_pow})
  164.     AddTail(funclist,thatfunc.ln)
  165.     lastb:=thatfunc.ln -> this is the last x_y style operator
  166.  
  167.     NEW thatfunc.create('abs',1,{e_abs},{f_abs})
  168.     AddTail(funclist,thatfunc.ln)
  169.  
  170.     NEW thatfunc.create('neg',1,{e_neg},{f_neg}) -> '-a' is possible but slower than 'neg(a)', because interpreted as '0-a'
  171.     AddTail(funclist,thatfunc.ln)
  172.  
  173.     NEW thatfunc.create('cos',1,{e_constant},{f_cos}) -> return zero for int32 :-)
  174.     AddTail(funclist,thatfunc.ln)
  175.  
  176.     NEW thatfunc.create('sin',1,{e_constant},{f_sin})
  177.     AddTail(funclist,thatfunc.ln)
  178.  
  179.     NEW thatfunc.create('tan',1,{e_constant},{f_tan})
  180.     AddTail(funclist,thatfunc.ln)
  181.  
  182.     NEW thatfunc.create('acos',1,{e_constant},{f_acos})
  183.     AddTail(funclist,thatfunc.ln)
  184.  
  185.     NEW thatfunc.create('asin',1,{e_constant},{f_asin})
  186.     AddTail(funclist,thatfunc.ln)
  187.  
  188.     NEW thatfunc.create('atan',1,{e_constant},{f_atan})
  189.     AddTail(funclist,thatfunc.ln)
  190.  
  191.     NEW thatfunc.create('angle',2,{e_constant},{f_angle})
  192.     AddTail(funclist,thatfunc.ln)
  193.  
  194.     NEW thatfunc.create('min',2,{e_min},{f_min})
  195.     AddTail(funclist,thatfunc.ln)
  196.  
  197.     NEW thatfunc.create('max',2,{e_max},{f_max})
  198.     AddTail(funclist,thatfunc.ln)
  199.  
  200.     NEW thatfunc.create('sqrt',1,{e_sqrt},{f_sqrt})
  201.     AddTail(funclist,thatfunc.ln)
  202.  
  203.     NEW thatfunc.create('ln',1,{e_ln},{f_ln})
  204.     AddTail(funclist,thatfunc.ln)
  205.  
  206.     NEW thatfunc.create('log',2,{e_log},{f_log})
  207.     AddTail(funclist,thatfunc.ln)
  208.  
  209.     NEW thatfunc.create('cosh',1,{e_constant},{f_cosh}) -> maybe later, approximated int value?
  210.     AddTail(funclist,thatfunc.ln)
  211.  
  212.     NEW thatfunc.create('sinh',1,{e_constant},{f_sinh})
  213.     AddTail(funclist,thatfunc.ln)
  214.  
  215.     NEW thatfunc.create('tanh',1,{e_constant},{f_tanh})
  216.     AddTail(funclist,thatfunc.ln)
  217.  
  218.     NEW thatfunc.create('acosh',1,{e_constant},{e_constant})->,{f_acosh})
  219.     AddTail(funclist,thatfunc.ln)                      
  220.                                                        
  221.     NEW thatfunc.create('asinh',1,{e_constant},{e_constant})->,{f_asinh})
  222.     AddTail(funclist,thatfunc.ln)                      
  223.                                                        
  224.     NEW thatfunc.create('atanh',1,{e_constant},{e_constant})->,{f_atanh})
  225.     AddTail(funclist,thatfunc.ln)
  226.  
  227.     NEW thatfunc.create('r',3,{e_red},{f_red})
  228.     thatfunc.readpid:=TRUE
  229.     AddTail(funclist,thatfunc.ln)
  230.     NEW thatfunc.create('g',3,{e_green},{f_green})
  231.     thatfunc.readpid:=TRUE
  232.     AddTail(funclist,thatfunc.ln)
  233.     NEW thatfunc.create('b',3,{e_blue},{f_blue})
  234.     thatfunc.readpid:=TRUE
  235.     AddTail(funclist,thatfunc.ln)
  236. ENDPROC
  237.  
  238. EXPORT PROC cleanfuncs()
  239. DEF thisnode:PTR TO ln,nextone
  240.  
  241.     thisnode:=funclist.head
  242.     WHILE (nextone:=thisnode.succ) AND Not(CtrlC()) -> Destroy all functions...
  243.         DisposeLink(thisnode.name)
  244.         END thisnode;thisnode:=nextone
  245.     ENDWHILE
  246.     END funclist
  247. ENDPROC
  248.  
  249. /* I am required to have the three arguments, so I cannot get rid of the unreferenced messages.*/
  250.  
  251. PROC e_constant(x,y,c) IS c
  252.  
  253. ENUM VAR_x,VAR_y
  254. PROC e_variable(x,y,c)
  255.     IF c=VAR_x THEN RETURN x
  256. ENDPROC y
  257. /*PROC f_variable(x,y,c) -> Test: Let's use the above one instead and have picFX convert the vars...
  258.     IF c=VAR_x THEN RETURN x!
  259. ENDPROC y!
  260. */
  261. EXPORT PROC e_mod(x,y,c=0) -> This is also used in picFX as a kind of replacement to Mod()
  262.     IF y = 0; RETURN 0
  263.     ELSEIF x >= 0; RETURN Mod(x,y)
  264.     ENDIF
  265. ENDPROC Mod(x,y)+y
  266. PROC f_mod(x,y,c)
  267.     IF y = 0. THEN RETURN 0.
  268. ENDPROC !x-(!Ffloor(!x/y)*y)
  269.  
  270. PROC e_add(x,y,c) IS x+y
  271. PROC f_add(x,y,c) IS !x+y
  272.  
  273. PROC e_sub(x,y,c) IS x-y
  274. PROC f_sub(x,y,c) IS !x-y
  275.  
  276. PROC e_mul(x,y,c) IS Mul(x,y)
  277. PROC f_mul(x,y,c) IS !x*y
  278.  
  279. PROC e_div(x,y,c)
  280.     IF y = 0 THEN RETURN 123456 ELSE RETURN Div(x,y)
  281. ENDPROC
  282.  
  283. PROC f_div(x,y,c)
  284.     IF y = 0. THEN RETURN 123456. ELSE RETURN !x/y
  285. ENDPROC
  286.  
  287. PROC e_pow(x,y,c) -> maybe would be quicker to convert to float, power, and back to int again?
  288. DEF result
  289.     IF y = 0 THEN RETURN 1
  290.     result:=x
  291.     WHILE y > 1
  292.         result:=Mul(result,x)
  293.         y--
  294.     ENDWHILE
  295. ENDPROC result
  296. PROC f_pow(x,y,c) IS Fpow(y,x)
  297.  
  298. PROC e_abs(x,y,c) IS Abs(x)
  299. PROC f_abs(x,y,c) IS Fabs(x)
  300.  
  301. PROC e_neg(x,y,c) IS -x
  302. PROC f_neg(x,y,c) IS !-x
  303.  
  304. PROC f_sin(x,y,c) IS Fsin(x)
  305. PROC f_cos(x,y,c) IS Fcos(x)
  306. PROC f_tan(x,y,c) IS Ftan(x) -> I don't know if we can pass pi/2 to this function. But as it is approximated, it shouldn't cause problems...
  307. PROC f_asin(x,y,c) IS Fasin(x)
  308. PROC f_acos(x,y,c) IS Facos(x)
  309. PROC f_atan(x,y,c) IS Fatan(x)
  310.  
  311. PROC f_angle(x,y,c)
  312.     IF y=0.
  313.         IF x<0. THEN RETURN 3.14159265 ELSE RETURN 0.
  314.     ELSEIF !y<0
  315.         RETURN !Fatan(!x/y)+1.5707963
  316.     ENDIF
  317. ENDPROC !Fatan(!x/y)-1.5707963
  318.  
  319. PROC e_min(x,y,c) IS Min(x,y)
  320. PROC f_min(x,y,c)
  321.     IF !x>y THEN RETURN y ELSE RETURN x
  322. ENDPROC
  323.  
  324. PROC e_max(x,y,c) IS Max(x,y)
  325. PROC f_max(x,y,c)
  326.     IF !x<y THEN RETURN y ELSE RETURN x
  327. ENDPROC
  328.  
  329. PROC e_sqrt(x,y,c) IS !Fsqrt(x!)!
  330. PROC f_sqrt(x,y,c) IS Fsqrt(x)
  331.  
  332. PROC e_ln(x,y,c)
  333.     IF x <= 0 THEN RETURN 123456 ELSE RETURN !Flog(x!)!
  334. ENDPROC
  335. PROC f_ln(x,y,c)
  336.     IF x<=0 THEN RETURN 123456. ELSE RETURN Flog(x)
  337. ENDPROC
  338.  
  339. PROC e_log(x,y,c) -> All these tests are annoying, but I do not know how to avoid them...
  340.     IF (x<=0) OR (y<=0) OR (y=1) THEN RETURN 123456 ELSE RETURN !Flog(x!)/Flog(y!)!
  341. ENDPROC
  342. PROC f_log(x,y,c)
  343.     IF (x<=0.) OR (y<=0.) OR (y=1. ) THEN RETURN 123456. ELSE RETURN !Flog(x)/Flog(y)
  344. ENDPROC
  345.  
  346. PROC f_sinh(x,y,c) IS !Fcosh(x)*Ftanh(x) -> Fsinh(x) -> I am doing something wrong somewhere, anyway putting fsinh causes a crash...
  347. PROC f_cosh(x,y,c) IS Fcosh(x)
  348. PROC f_tanh(x,y,c) IS Ftanh(x)
  349.  
  350. /*PROC f_asinh(x,y,c) IS Fasinh(x) -> These three aren't implemented in E...
  351. PROC f_acosh(x,y,c) IS Facosh(x)
  352. PROC f_atanh(x,y,c) IS Fatanh(x)*/
  353.  
  354. PROC e_red(x,y,c:PTR TO planeFunc_data) IS Shr(pixel(c.imagedata,c.width,e_mod(x,c.width),e_mod(y,c.height)),16)
  355. PROC f_red(x,y,c:PTR TO planeFunc_data) IS (Shr(pixel(c.imagedata,c.width,e_mod(!x!,c.width),e_mod(!y!,c.height)),16))!
  356.  
  357. PROC e_green(x,y,c:PTR TO planeFunc_data) IS Shr(pixel(c.imagedata,c.width,e_mod(x,c.width),e_mod(y,c.height)),8) AND $FF
  358. PROC f_green(x,y,c:PTR TO planeFunc_data) IS (Shr(pixel(c.imagedata,c.width,e_mod(!x!,c.width),e_mod(!y!,c.height)),8) AND $FF)!
  359.  
  360. PROC e_blue(x,y,c:PTR TO planeFunc_data) IS pixel(c.imagedata,c.width,e_mod(x,c.width),e_mod(y,c.height)) AND $FF
  361. PROC f_blue(x,y,c:PTR TO planeFunc_data) IS (pixel(c.imagedata,c.width,e_mod(!x!,c.width),e_mod(!y!,c.height)) AND $FF)!
  362.  
  363. /* Expression class. This is equivalent to the old function one. Decoding is now put in the constructor (=> a little bit less code ;)
  364. If there's a problem while decoding, the function will get f(x,y)=0*/
  365.  
  366. EXPORT SET NEEDX,SHORT -> short is x,y,e,pi,numeric-constant, i.e. what does not need computation.
  367. EXPORT ENUM FAILURE=$100,ERR_NoParse,ERR_NoFunc,ERR_NoChar
  368. EXPORT SET WARN_NoSupport,WARN_EPi
  369.  
  370. EXPORT OBJECT expression
  371.     func:PTR TO function
  372.     arg1:PTR TO expression
  373.     arg2:PTR TO expression
  374.     cte:LONG -> third arg. For reason of backward compatibility, it is the arg #1 in the expression string, when present.
  375.  
  376.     precision
  377.     evaluate -> evaluate THIS proc.
  378.  
  379.     /*precalculation stuff*/
  380. /*following: allocated with AllocVec()!!!!*/
  381.     precalc:PTR TO LONG         -> pre-calculates. Values put in buffer (only in main expr)
  382.     calculate:PTR TO LONG       -> calculates function value (only in main expr)
  383.     buffer:PTR TO LONG          -> pre-calculated value (only in main expr)
  384.  
  385.     message -> how last decoding went: WARN_#? or ERR_#? or NIL
  386.  
  387.     need:LONG -> what vars are required to eval. it
  388. ->    value:LONG -> precalculated value
  389. ENDOBJECT
  390.  
  391. /*EXPORT OBJECT outinfo
  392.     error:LONG
  393.     quote:PTR TO CHAR
  394. ENDOBJECT*/
  395.  
  396. PROC setfunc(address:PTR TO function) OF expression
  397.     self.func:=address
  398.     IF self.precision = OUT_Integer
  399.         self.evaluate:=self.func.evalI
  400.     ELSEIF self.precision = OUT_Float32
  401.         self.evaluate:=self.func.evalF
  402.     ELSE -> Actually this happens when using a non-direct output mode (copy, old,..?)
  403. ->        WriteF('Unknown output mode\n')
  404.         self.evaluate:=self.func.evalF -> (Just in case of problem, but it shouldn't be useful)
  405.     ENDIF
  406. ENDPROC
  407.  
  408. /* A Little But Serious change done here: start is the first char to decode, but end is the last plus one. (It made code a little simpler)*/
  409.  
  410. /*first: TRUE means that the function will be compiled;
  411. FALSE means that it might throw an exception;
  412. 1 means that it will not be compiled neither throw an exception*/
  413. PROC create(precision,input:PTR TO CHAR,start=0,end=-1,first=TRUE) OF expression HANDLE
  414. DEF currfunc:PTR TO ln,name:PTR TO CHAR,var,
  415.     open,close,nxt:PTR TO LONG,fnc,out=NIL ->:PTR TO outinfo
  416.  
  417.     self.precision:=precision
  418.  
  419.     IF end=-1
  420.         end:=StrLen(input)
  421.         mc:=0;bs:=0
  422.     ENDIF
  423.  
  424.     IF start=end -> Empty expressions => constant zero
  425.         self.setfunc(fconstant)
  426.         self.cte:=0
  427.         JUMP toEnd
  428.     ENDIF
  429.  
  430.     IF input[start] = "(" -> If the whole expression is surrounded by brackets, decode inside.
  431.         IF findseparator(input,start,')') = (end-1)
  432.             self.create(precision,input,start+1,end-1,first)
  433.             JUMP toEnd
  434.         ENDIF
  435.     ENDIF
  436.  
  437.     /* Let's seek x_y operators */
  438.  
  439.     currfunc:=firstb
  440.     REPEAT
  441.         nxt:=findseparator(input,start-1,currfunc.name)
  442.         IF (nxt<>-1) AND (nxt<end)
  443.             self.setfunc(currfunc-4) ->!!! There's a four-bytes gap between function and ln (because function is not simply an object: it's a class :-)
  444.             NEW self.arg1.create(precision,input,start,nxt,FALSE)
  445.             out:=out OR self.arg1.message -> Gather eventual warning..
  446.             count++;mc:=Max(mc,count)
  447.             NEW self.arg2.create(precision,input,nxt+1,end,FALSE)
  448.             out:=out OR self.arg2.message
  449.             self.need:=self.arg1.need OR self.arg2.need AND Not(SHORT)
  450.             count--
  451.             JUMP toEnd
  452.         ENDIF
  453.  
  454.         currfunc:=currfunc.succ
  455.     UNTIL (currfunc = lastb.succ) OR CtrlC()
  456.     /* Now look for f() functions */
  457.  
  458.     open:=InStr(input,'(',start)
  459.     IF (open=-1) OR (open >= end) -> No () in expression, let's treat it as a whole
  460.         var:=getvariable(input+start,end-start,vlo) -> this is inside varlist.m
  461.         IF var <> -1
  462.             self.setfunc(fconstant)
  463.             IF self.precision=OUT_Integer
  464.                 self.cte:=!var! -> If we are integer, then convert the flt32 into int32...
  465.             ELSE
  466.                 self.cte:=var
  467.             ENDIF
  468.             self.need:=SHORT
  469.         ELSEIF StrCmp(input+start,'x',1)
  470.             self.setfunc(fvariable)
  471.             self.cte:=VAR_x
  472.             IF end<>(start+1) THEN Throw(ERR_NoParse,input)
  473.             self.need:=NEEDX OR SHORT
  474.         ELSEIF StrCmp(input+start,'y',1)
  475.             self.setfunc(fvariable)
  476.             self.cte:=VAR_y
  477.             IF end<>(start+1) THEN Throw(ERR_NoParse,input)
  478.             self.need:=SHORT
  479.         ELSEIF StrCmp(input+start,'e',1)
  480.             self.setfunc(fconstant)
  481.             IF self.precision=OUT_Integer
  482.                 self.cte:=3
  483.                 out:=out OR WARN_EPi
  484.             ELSE
  485.                 self.cte:=2.71828183
  486.             ENDIF
  487.             IF end<>(start+1) THEN Throw(ERR_NoParse,input)
  488.             self.need:=SHORT
  489.         ELSEIF StrCmp(input+start,'pi',2)
  490.             self.setfunc(fconstant)
  491.             IF self.precision = OUT_Integer
  492.                 self.cte:=3
  493.                 out:=out OR WARN_EPi
  494.             ELSE
  495.                 self.cte:=3.14159265
  496.             ENDIF
  497.             IF end<>(start+2) THEN Throw(ERR_NoParse,input)
  498.             self.need:=SHORT
  499.         ELSE
  500.             self.setfunc(fconstant)
  501.             IF self.precision=OUT_Integer
  502.                 open,close:=Val(input+start)
  503.             ELSE
  504.                 open,close:=RealVal(input+start)
  505.             ENDIF
  506.             self.cte:=open -> putting multiple return values in objects (x.y) is not accepted...
  507.             IF close <> (end-start) THEN Throw(ERR_NoParse,input)
  508.             self.need:=SHORT
  509.         ENDIF
  510.     ELSE
  511.         IF open=start THEN -> THEN in cases like '(a)(b)', or '(a))'
  512.             Throw(ERR_NoParse,input)
  513.  
  514.         name:=String(open-start)
  515.         MidStr(name,input,start)
  516.         fnc:=FindName(lastb.pred,name) -> .pred because abs must also be found
  517.         IF fnc=NIL THEN Throw(ERR_NoFunc,name)
  518.         self.setfunc(fnc-4)
  519.         IF self.func.argcount>1
  520.             close:=findseparator(input,open,',')
  521.             IF (close=-1) OR (close>=end) THEN Throw(ERR_NoChar,',')
  522.             IF self.func.argcount>2 -> In this case, read cte,arg1,arg2
  523.  
  524.                 self.cte:=Val(input+open+1) -> Second return value: # of read chars. For error handling.
  525.                 IF self.func.readpid -> This is a project id
  526.                     self.cte:=gtd(dat,self.cte)
  527.                 ELSEIF self.precision=OUT_Float32 -> Not used for now, but may come once :-)
  528.                     self.cte:=RealVal(input+open)
  529.                 ENDIF
  530.  
  531.                 open:=close
  532.                 close:=findseparator(input,open,',')
  533.                 IF (close=-1) OR (close>=end) THEN Throw(ERR_NoChar,',')
  534.                 NEW self.arg1.create(precision,input,open+1,close,FALSE)
  535.                 self.need:=self.arg1.need AND Not(SHORT)
  536.                 count++;mc:=Max(mc,count)
  537.  
  538.  
  539.                 open:=close
  540.                 close:=findseparator(input,open,')')
  541.                 IF (close=-1) OR (close>=end) THEN Throw(ERR_NoChar,')')
  542.                 NEW self.arg2.create(precision,input,open+1,close,FALSE)
  543.                 self.need:=self.need OR self.arg2.need AND Not(SHORT)
  544.  
  545.                 count--  -> storage not needed anymore.
  546.  
  547.             ELSE -> two args
  548.                 NEW self.arg1.create(precision,input,open+1,close,FALSE)
  549.                 self.need:=self.arg1.need AND Not(SHORT)
  550.                 count++;mc:=Max(mc,count)
  551.                 open:=close
  552.                 close:=findseparator(input,open,')') 
  553.                 IF (close=-1) OR (close>=end) THEN Throw(ERR_NoChar,')')
  554.                 NEW self.arg2.create(precision,input,open+1,close,FALSE)
  555.                 self.need:=self.need OR self.arg2.need AND Not(SHORT)
  556.                 count-- -> storage not needed anymore.
  557.             ENDIF
  558.             out:=out OR self.arg2.message
  559.  
  560.         ELSE -> Single arg
  561.             close:=findseparator(input,open,')')
  562.             IF (close=-1) OR (close>=end) THEN Throw(ERR_NoChar,')')
  563.             NEW self.arg1.create(precision,input,open+1,close,FALSE)
  564.             self.need:=self.arg1.need AND Not(SHORT)
  565.         ENDIF
  566.         out:=out OR self.arg1.message
  567.         IF self.evaluate={e_constant} THEN -> I assume that if a function with args is constant, then there's a problem...
  568.             out:=out OR WARN_NoSupport
  569.     ENDIF
  570. toEnd:
  571. EXCEPT DO
  572.     IF exception
  573.         IF first=FALSE THEN Throw(exception,exceptioninfo)
  574.         /*NEW out
  575.         out.error:= exception;out.quote:=exceptioninfo*/
  576.         out:=/*out OR */exception -> Once there will be some more error information sent...
  577.         self.end()
  578.         self.create(self.precision,'')
  579.     ENDIF
  580.     IF self.need AND NEEDX
  581.         IF self.arg1 ->THEN
  582.             IF (self.arg1.need AND NEEDX) = $0 THEN
  583.                 bs++
  584.         ENDIF
  585.         IF self.arg2 ->THEN
  586.             IF (self.arg2.need AND NEEDX) = $0 THEN
  587.                 bs++
  588.         ENDIF
  589.     ELSEIF first -> x *never* used in whole expression: use one buffer slot.
  590.         bs:=1
  591.     ENDIF
  592.  
  593.  
  594.     IF first=TRUE THEN
  595.         self.compile((end-start)*10+32,mc,bs) -> Be sure that there's enough room in string :-)
  596.     self.message:=out
  597. ENDPROC
  598.  
  599. /* find first separator (sep: ')', ',', or '+', .....) following index, in input */
  600. PROC findseparator(input:PTR TO CHAR,index,sep)
  601. DEF open,nxt
  602.     open:=InStr(input,'(',index+1)
  603.     IF open=-1 THEN open:=StrLen(input)
  604.     nxt:=InStr(input,sep,index+1)
  605.     IF nxt < open THEN RETURN nxt
  606.  
  607.     /* nxt > open */
  608.     nxt:=findseparator(input,open,')') -> Where does that "open" close?
  609.     IF nxt=-1 THEN Throw(ERR_NoChar,')') -> If it doesn't => error
  610. ENDPROC findseparator(input,nxt,sep) -> If it does, let's return the following sep
  611.  
  612. /*
  613.  * str:=evalstr(str) will read a string of the form
  614.  * '[<len>:]<expr>' and return an estring containing the value of expr.
  615.  * zeros are added on the left if necessary, to have a length of at least len.
  616.  * variables are allowed, of course
  617.  *
  618.  * evalstr('2*2') -> '4'      (default len is 1)
  619.  * evalstr('2:2*2') -> '04'   (padding 0 if necessary)
  620.  * evalstr('2:7*15') -> '105' (overtaking len if necessary)
  621.  * evalstr('4:6-8') -> '-002' (the "-", if any, comes at the very beginning)
  622.  *
  623.  * (You are responsible for freeing the returned string)
  624.  *
  625.  */
  626.  
  627. EXPORT PROC evalstr(input) HANDLE
  628. DEF len,neg,i,expr:PTR TO expression,st,out
  629.  
  630.     i:=InStr(input,':')
  631.     IF i <> -1
  632.         len:=Val(input)
  633.     ELSE
  634.         len:=1
  635.     ENDIF
  636.     NEW expr.create(OUT_Float32,input,i+1,-1,1)
  637.       /*we start after the :... first is set to false so that the expression won't be compiled*/
  638.     i:=expr.evaluate(0.,0.) -> evaluate into i using x=y=0
  639.     i:=!i! -> Convert to int32
  640.     END expr
  641.     st:=String(11) -> 11, as max is -2^31, which is -2147483648
  642.     StringF(st,'\d',Abs(i)) -> Now st contains i on the left
  643.     neg:=(i<0)
  644.     IF StrLen(st)-neg < len -> then we must add len-(StrLen(st)-neg) padding zeroes
  645.         out:=String(len)
  646.         IF neg THEN StrCopy(out,'-')
  647.         StrAdd(out,'00000000000000000000') -> I am too lazy to use loops or such stuff. Just don't use
  648.                                            ->  this proc with len larger than 21...
  649.         SetStr(out,len-StrLen(st)) -> the - is already there, so no "-neg"...
  650.         StrAdd(out,st)
  651.     ELSE -> then we can just return st, maybe with a heading "-"
  652.         out:=String(StrLen(st)-neg)
  653.         IF neg THEN StrCopy(out,'-')
  654.         StrAdd(out,st)
  655.     ENDIF
  656. EXCEPT
  657.     IF out THEN DisposeLink(out)
  658.     out:=String(10)
  659.     StrCopy(out,'--Error--')
  660. ENDPROC out
  661.  
  662.  
  663. /* Reg usage: A5 is for temporary values, valid during one single expr evaluation;
  664.               A1 points to the pre-calculated values*/
  665.  
  666. PROC compile(len,maxcount,buffsize) OF expression
  667. DEF nxt:PTR TO LONG,dest:PTR TO LONG
  668.     c:=0;p:=0;s:=-1
  669.     NEW code[len];crs:=code
  670.     NEW precalc[len];prs:=precalc
  671.     buffer:=AllocVec(buffsize*4+4,MEMF_PUBLIC) -> 4 is SIZEOF LONG
  672.     self.buffer:=buffer
  673.  
  674.     crs[]:=$4E55;crs++; crs[]:=(-maxcount-2)*4 AND $FFFF;crs++ -> LINK A5,#$<..maxcount..>
  675.  
  676.     prs[]:=$4E55;prs++; prs[]:=(-maxcount-2)*4 AND $FFFF;prs++ -> LINK A5,#$<maxcount>
  677.  
  678.     self.subcompile()
  679.     IF (self.need AND NEEDX)=$0 -> If *nothing* in the expression depends on x, let's save+recall here.
  680.         s++
  681.  
  682.         crs[]:=$227C;crs++; crs[]:=Shr(buffer,16);crs++; crs[]:=buffer;crs++ ->MOVE.L buffer,A1
  683.         prs[]:=$227C;prs++; prs[]:=Shr(buffer,16);prs++; prs[]:=buffer;prs++ ->MOVE.L buffer,A1
  684.  
  685.         prs[]:=$2340;prs++;prs[]:=s*4;prs++ -> MOVE.L D0,<s*4>(A1)
  686.         crs[]:=$2029;crs++;crs[]:=s*4;crs++ -> MOVE.L <s*4>(A1),D0
  687.     ENDIF
  688.  
  689.     crs[]:=$4E5D;crs++ -> UNLK A5
  690.     crs[]:=$4E75;crs++ -> RTS
  691.  
  692.     prs[]:=$4E5D;prs++ -> UNLK A5
  693.     prs[]:=$4E75;prs++ -> RTS
  694.  
  695.     self.calculate:=AllocVec(crs-code+16,NIL)
  696.     nxt:=code;dest:=self.calculate
  697.     WHILE nxt <= (crs)
  698.         dest[]:=nxt[]
  699.         nxt++;dest++
  700.     ENDWHILE
  701.     END code[len]
  702.  
  703.     self.precalc:=AllocVec(prs-precalc+16,NIL)
  704.     nxt:=precalc;dest:=self.precalc
  705.     WHILE nxt <= (prs)
  706.         dest[]:=nxt[]
  707.         nxt++;dest++
  708.     ENDWHILE
  709.     END precalc[len]
  710. ENDPROC
  711.  
  712. PROC long(k:PTR TO expression)
  713.     IF k
  714.         RETURN (k.need AND SHORT) = $0
  715.     ELSE
  716.         RETURN FALSE
  717.     ENDIF
  718. ENDPROC
  719.  
  720. PROC subcompile() OF expression
  721. DEF saved=FALSE, -> TRUE if arg1 was saved in A5.
  722.     buff=-1  -> buffer-slot (in case "f(y)_f(x)") where f(y) is stored
  723.     IF long(self) = FALSE -> That's only if the global (whole) expression is short.
  724.         IF self.func=fvariable -> For now, use pre-calculation as usual, I mean, 'y' expression will be pre-calculated even if it is quite useless...
  725.            IF self.cte=VAR_x
  726.                crs[]:=$202D;crs++ -> MOVE.L $C(A5),D0
  727.                crs[]:=$C;crs++
  728.            ELSEIF self.cte=VAR_y
  729.                prs[]:=$202D;prs++ -> MOVE.L $8(A5),D0
  730.                prs[]:=$8;prs++
  731.            ENDIF
  732.        ELSEIF self.func=fconstant
  733.            prs[]:=$203C ;prs++ -> MOVE.L #self.cte,D0
  734.            prs[]:=Shr(self.cte,16);prs++;prs[]:=self.cte ;prs++ -> constant argument
  735.        ENDIF
  736.        RETURN
  737.     ENDIF
  738.  
  739. /* First of all calculate subexpressions that need to be calculated */
  740.     IF long(self.arg1)
  741.         self.arg1.subcompile()
  742.         IF long(self.arg2) -> If we have two args that need computation, then we'll have to save one to do the other one...
  743.             IF self.arg1.need AND NEEDX -> Neither arg1, nor us can pre-calculate.
  744.                 c++
  745.                 crs[]:=$2B40;crs++-> MOVE.L D0,$-<c*4>(A5)
  746.                 crs[]:=-c*4 ;crs++-> store that arg
  747.                 saved:=TRUE
  748.             ELSEIF (self.need AND NEEDX) = $0
  749.                 p++
  750.                 prs[]:=$2B40;prs++-> MOVE.L D0,$-<p*4>(A5)
  751.                 prs[]:=-p*4 ;prs++-> store that arg
  752.                 saved:=TRUE
  753.             ENDIF
  754.         ENDIF
  755.         IF self.need AND Not(self.arg1.need) AND NEEDX -> save pre-calculated arg1 to A1
  756.             s++
  757.             buff:=s
  758.             prs[]:=$227C;prs++;prs[]:=Shr(buffer,16);prs++; prs[]:=buffer;prs++ ->MOVE.L buffer,A1
  759.             prs[]:=$2340;prs++;prs[]:=s*4;prs++ -> MOVE.L D0,<s*4>(A1)
  760.         ENDIF
  761.     ENDIF
  762.     IF long(self.arg2)
  763.         self.arg2.subcompile()
  764.         IF self.need AND Not(self.arg2.need) AND NEEDX -> arg2 doesn't needx but we do => save pre-calculated arg2 to A1
  765.             s++
  766.             prs[]:=$227C;prs++;prs[]:=Shr(buffer,16);prs++; prs[]:=buffer;prs++ ->MOVE.L buffer,A1
  767.             prs[]:=$2340;prs++;prs[]:=s*4;prs++ -> MOVE.L D0,<s*4>(A1)
  768.         ENDIF
  769.     ENDIF
  770.  
  771. /* Now put arguments in stack and execute function. */
  772.     IF long(self.arg1)=FALSE -> I assume that self.arg1 exists
  773.         IF self.arg1.func=fvariable
  774.             IF self.arg1.cte=VAR_x
  775.                 crs[]:=$2F2D;crs++ -> MOVE.L $C(A5),-(A7)
  776.                 crs[]:=$C;crs++
  777.             ELSEIF self.arg1.cte=VAR_y
  778.                 write($2F2D,self.need) -> MOVE.L $8(A5),-(A7)
  779.                 write($8,self.need) -> "write", as we wouldn't need pre-calculation if there's only a single y.
  780.             ENDIF
  781.         ELSEIF self.arg1.func=fconstant
  782.             write($2F3C,self.need) -> MOVE.L #self.cte,-(A7)
  783.             write(Shr(self.arg1.cte,16),self.need);write(self.arg1.cte,self.need)
  784.         ENDIF
  785.     ELSEIF saved
  786.         IF self.need AND NEEDX
  787.             crs[]:=$2F2D ;crs++ -> MOVE.L $-<c*4>(A5),-(A7)
  788.             crs[]:=-c*4 ;crs++-> push copied argument (a)
  789.             c--
  790.         ELSE
  791.             prs[]:=$2F2D ;prs++ -> MOVE.L $-<p*4>(A5),-(A7)
  792.             prs[]:=-p*4 ;prs++-> push copied argument (a)
  793.             p--
  794.         ENDIF
  795.     ELSEIF buff>-1 -> Copy pre-calculated value.
  796.         crs[]:=$227C;crs++;crs[]:=Shr(buffer,16);crs++; crs[]:=buffer;crs++ ->MOVE.L buffer,A1
  797.         crs[]:=$2F29;crs++ -> MOVE.L <buff*4>(A1),-(A7)
  798.         crs[]:=buff*4;crs++
  799.     ELSE -> Long arg1(x), Short arg2
  800.         IF self.need AND NEEDX
  801.             crs[]:=$2F00 ;crs++ -> MOVE.L D0,-(A7)
  802.         ELSE
  803.             prs[]:=$2F00 ;prs++ -> MOVE.L D0,-(A7)
  804.         ENDIF
  805.     ENDIF
  806.  
  807.     IF self.arg2
  808.         IF long(self.arg2)
  809.             IF self.need AND NEEDX
  810.                 IF self.arg2.need AND NEEDX
  811.                     crs[]:=$2F00 ;crs++ -> MOVE.L D0,-(A7)
  812.                 ELSE
  813.                     crs[]:=$227C;crs++;crs[]:=Shr(buffer,16);crs++; crs[]:=buffer;crs++ ->MOVE.L buffer,A1
  814.                     crs[]:=$2F29;crs++ -> MOVE.L <s*4>(A1),-(A7)
  815.                     crs[]:=s*4;crs++
  816.                 ENDIF
  817.             ELSE
  818.                 prs[]:=$2F00 ;prs++ -> MOVE.L D0,-(A7)
  819.             ENDIF
  820.         ELSE
  821.             IF self.arg2.func=fvariable
  822.                 IF self.arg2.cte=VAR_x
  823.                     crs[]:=$2F2D;crs++ -> MOVE.L $C(A5),-(A7)
  824.                     crs[]:=$C;crs++
  825.                 ELSEIF self.arg2.cte=VAR_y
  826.                     write($2F2D,self.need) -> MOVE.L $8(A5),-(A7)
  827.                     write($8,self.need) -> "write", as we wouldn't need pre-calculation if there's only a single y.
  828.                 ENDIF
  829.             ELSEIF self.arg2.func=fconstant
  830.                 write($2F3C,self.need) -> MOVE.L #self.arg2.cte,-(A7)
  831.                 write(Shr(self.arg2.cte,16),self.need);write(self.arg2.cte,self.need) -> constant argument
  832.             ENDIF
  833.         ENDIF
  834.     ELSE -> No arg2: push zero
  835.         write($2F3C,self.need) -> MOVE.L #0,-(A7)
  836.         write(0,self.need);write(0,self.need)
  837.     ENDIF
  838.     IF self.need AND NEEDX
  839.         crs[]:=$2F3C ;crs++ -> MOVE.L #self.cte,-(A7)
  840.         crs[]:=Shr(self.cte,16);crs++;crs[]:=self.cte ;crs++
  841.         crs[]:=$4EB9 ;crs++ -> JSR self.evaluate
  842.         crs[]:=Shr(self.evaluate,16);crs++;crs[]:=self.evaluate ;crs++
  843.     ELSE
  844.         prs[]:=$2F3C ;prs++ -> MOVE.L #self.cte,-(A7)
  845.         prs[]:=Shr(self.cte,16);prs++;prs[]:=self.cte ;prs++
  846.         prs[]:=$4EB9 ;prs++ -> JSR self.evaluate
  847.         prs[]:=Shr(self.evaluate,16);prs++;prs[]:=self.evaluate ;prs++
  848.     ENDIF
  849. ENDPROC
  850.  
  851. PROC write(value,need) -> Little loss of time here at pre-compilation-time, but it is nicer so.
  852.     IF need AND NEEDX
  853.         crs[]:=value;crs++
  854.     ELSE
  855.         prs[]:=value;prs++
  856.     ENDIF
  857. ENDPROC
  858.  
  859. PROC reference() OF expression
  860.     IF self.func.readpid = TRUE THEN -> I guess that all function that need a data require having its project frozen...
  861.         RETURN self.cte,self.arg1,self.arg2
  862. ENDPROC self.func.argcount+1,self.arg1,self.arg2
  863.  
  864. PROC evaluate(x,y) OF expression
  865. DEF a,b,p
  866.     IF self.func=fvariable
  867.         p:=self.evaluate
  868.         RETURN p(x,y,self.cte)
  869.     ENDIF
  870.     IF self.func.argcount>0
  871.         a:=self.arg1.evaluate(x,y)
  872.         IF self.func.argcount>1 ->THEN
  873.             b:=self.arg2.evaluate(x,y)
  874.         ENDIF
  875.     ENDIF
  876.     p:=self.evaluate
  877. ENDPROC p(a,b,self.cte)
  878.  
  879. PROC end() OF expression
  880.     IF self.func -> Maybe the decoding was aborted before we could know the function...
  881.         IF self.func.argcount>0
  882.             END self.arg1
  883.             IF self.func.argcount>1 THEN END self.arg2
  884.         ENDIF
  885.     ENDIF
  886.     IF self.calculate THEN
  887.         FreeVec(self.calculate)
  888.     IF self.precalc THEN
  889.         FreeVec(self.precalc)
  890.     IF self.buffer THEN
  891.         FreeVec(self.buffer)
  892. ENDPROC
  893.  
  894. /*last(): Exactely like InStr(), but from right to left..*/
  895. PROC last(str,findme,before=-1)
  896. DEF found=0,next
  897.     IF before=-1 THEN before:=StrLen(findme)
  898.  
  899.     WHILE ((next:=InStr(str,findme,found)) < before) AND (next <> -1)
  900.         found:=next
  901.         IF CtrlC()
  902.             WriteF('Infinite loop?\nnext=\d;found=\d... [returning -1]\n')
  903.             RETURN -1
  904.         ENDIF
  905.     ENDWHILE
  906.     IF found=0 THEN found:=-1
  907. ENDPROC found
  908.