home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 6 / AACD06.ISO / AACD / Graphics / picFX / e-source / parser.e next >
Text File  |  1999-12-27  |  31KB  |  857 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 project_Node
  17.     ln:ln   -> base node structure
  18.     window  -> window object
  19.     item    -> string that appears in opened_lst
  20.     pid     -> Project ID
  21. ENDOBJECT
  22.  
  23. EXPORT OBJECT subtaskmsg
  24.    stm_Message:mn
  25.    stm_Command:INT
  26.    stm_Parameter:LONG
  27.    stm_Result:LONG
  28. ENDOBJECT
  29.  
  30. EXPORT OBJECT subtask
  31.   st_Task:PTR TO tc      /* sub task pointer */
  32.   st_Port:PTR TO mp      /* allocated by sub task */
  33.   st_Reply:PTR TO mp     /* allocated by main task */
  34.   st_Data:LONG           /* more initial data to pass to the sub task */
  35.   st_Message:subtaskmsg  /* Message buffer */
  36. ENDOBJECT
  37.  
  38.  
  39. EXPORT OBJECT planeFunc_data
  40.     projectid -> Project ID, used when referencing a project from "outside"
  41.  
  42.                         /***attributes storage***/
  43.     bfunc:PTR TO expression
  44.     bstr:PTR TO CHAR
  45.     failure                    /*$RGB*/
  46.     gfunc:PTR TO expression
  47.     gstr:PTR TO CHAR
  48.     height
  49.     imagefile:PTR TO CHAR
  50.     left,newleft                ->scroll when newleft is non-zero
  51.     loading
  52.     loadm
  53.     lock -> -1 when there's a writelock, 0 when it is free, number of readlocks otherwise
  54.     name:PTR TO CHAR
  55.     paused -> this is used by the 'state' attribute, with the 'lock' var
  56.     projectnode:PTR TO project_Node
  57.     ratio        -> scale ratio to which display the picture, multiplied by one million.
  58.     rfunc:PTR TO expression
  59.     rstr:PTR TO CHAR
  60.     outputr,outputg,outputb
  61.     quiet
  62.     top,newtop                  -> scroll when newtop is non-zero
  63.     type
  64.     width
  65.     xmin,xmax,ymin,ymax         -> area to draw to
  66.                         /***some pointers...***/
  67.     hscroll,vscroll         -> scrollers of the window
  68.     app                     -> true if we can send an update message.
  69.     self                    -> pointer to ourselves
  70.                         /***some useful data***/
  71.     savepixel               -> true if the previous pixel must be saved
  72.     rupd                    -> copy of the render-update preference variable.
  73.     sema:ss                 -> data item protection
  74.     subtask:PTR TO subtask  -> our sub task
  75.  
  76.     drawhandle              -> draw handle
  77.     imagedata:PTR TO LONG,vec-> pixel information for the picture. vec is TRUE if we did allocate it with AllocVec()
  78.     picture                 -> picture
  79.  
  80.     drawn                   -> the last line that has been drawn to the window
  81.     calculated              -> the last line that has been calculated by the subtask
  82.     ds:datestamp            -> planeFunc stores the datestamp when a calculation is started
  83. ENDOBJECT
  84.  
  85. EXPORT ENUM OUT_Integer=0, -> 32bits integer
  86.             OUT_Float32, -> 32Bits float
  87.             OUT_Float64,  -> 64Bits float
  88.             OUT_OldR,OUT_OldG,OUT_OldB, -> Components of the pixel (previous calculation!)
  89.             OUT_CopyR,OUT_CopyG          -> Copies the new expression (e.g. black'n'white)
  90.  
  91. /* Function class. This class handles the functions like sin, +, r(), and so on, the old function class has been renamed to expression.
  92. You can easily add functions, just put the evaluation code somewhere (better is to keep the order !) and then put it in initfuncs, in
  93. the same way as the other.*/
  94.  
  95. OBJECT function
  96.     ln:ln
  97.     argcount:LONG
  98.     readpid -> if TRUE: cte::projectid ->-> data
  99.     evalI,evalF:LONG -> address of the evaluating procedures
  100. ENDOBJECT
  101. /* For compatibility with previous versions, a function having a constant will
  102. be read as f(cte,arg1,arg2), and not f(arg1,arg2,cte), as you might think*/
  103.  
  104. EXPORT DEF fconstant,fvariable, -> The addresses of these two function nodes  (!FUNCTION OBJECTS!)
  105.            firstb,lastb:PTR TO ln        -> first & last x_y .     (!LN OBJECTS!)
  106.  
  107. DEF funclist:PTR TO lh,
  108.     gtd,-> gtd is the address of the getdata(dat,num) PROC
  109.     dat,-> dat is the address of the ProjectlistObject's data
  110.     vlo -> vlo is the current VariableListObject
  111.  
  112. DEF c,p,s -> c,p = number of used A5, respectively by calc and precalc; s is used A1.
  113.  
  114. DEF count,mc,bs, -> precompilation stuff    mc stands for max-count, bs for buffer-size
  115.     code:PTR TO INT,crs:PTR TO INT, -> code is the beginning, crs is the point we are at.
  116.     precalc:PTR TO INT,prs:PTR TO INT,
  117.     buffer                          ->  *temporary* storage of the current buffer (*copy* of self.buffer, the address)
  118.  
  119. PROC create(name,argcount,evalI,evalF) OF function
  120.     self.ln.name:=String(StrLen(name))
  121.     StrCopy(self.ln.name,name)
  122.     self.argcount:=argcount
  123.     self.evalI:=evalI
  124.     self.evalF:=evalF
  125. ENDPROC
  126.  
  127. PROC end() OF function
  128.     DisposeLink(self.ln.name)
  129. ENDPROC
  130.  
  131. EXPORT PROC initfuncs(gtda,data,varlst) -> getData(), projectList_data, VarListObject
  132. DEF thatfunc:PTR TO function,k:PTR TO function
  133.  
  134.     gtd:=gtda
  135.     dat:=data
  136.     vlo:=varlst
  137.  
  138.     NEW funclist
  139.     newList(funclist)
  140.  
  141.     NEW thatfunc.create('Constant',0,{e_constant},{e_constant})
  142.     AddTail(funclist,thatfunc.ln)
  143.     fconstant:=thatfunc
  144.                                                        
  145.     NEW thatfunc.create('Variable',0,{e_variable},{e_variable})
  146.     AddTail(funclist,thatfunc.ln)
  147.     fvariable:=thatfunc
  148.  
  149. /*Following functions are sorted by order of priority*/
  150.  
  151.     NEW thatfunc.create('%',2,{e_mod},{f_mod})
  152.     AddTail(funclist,thatfunc.ln)
  153.     firstb:=thatfunc.ln -> This is the first x_y style operator
  154.  
  155.     NEW thatfunc.create('+',2,{e_add},{f_add})
  156.     AddTail(funclist,thatfunc.ln)
  157.  
  158.     NEW thatfunc.create('-',2,{e_sub},{f_sub})
  159.     AddTail(funclist,thatfunc.ln)
  160.  
  161.     NEW thatfunc.create('*',2,{e_mul},{f_mul})
  162.     AddTail(funclist,thatfunc.ln)
  163.  
  164.     NEW thatfunc.create('/',2,{e_div},{f_div})
  165.     AddTail(funclist,thatfunc.ln)
  166.  
  167.     NEW thatfunc.create('^',2,{e_pow},{f_pow})
  168.     AddTail(funclist,thatfunc.ln)
  169.     lastb:=thatfunc.ln -> this is the last x_y style operator
  170.  
  171.     NEW thatfunc.create('abs',1,{e_abs},{f_abs})
  172.     AddTail(funclist,thatfunc.ln)
  173.  
  174.     NEW thatfunc.create('neg',1,{e_neg},{f_neg}) -> '-a' is possible but slower than 'neg(a)', because interpreted as '0-a'
  175.     AddTail(funclist,thatfunc.ln)
  176.  
  177.     NEW thatfunc.create('cos',1,{e_constant},{f_cos}) -> return zero for int32 :-)
  178.     AddTail(funclist,thatfunc.ln)
  179.  
  180.     NEW thatfunc.create('sin',1,{e_constant},{f_sin})
  181.     AddTail(funclist,thatfunc.ln)
  182.  
  183.     NEW thatfunc.create('tan',1,{e_constant},{f_tan})
  184.     AddTail(funclist,thatfunc.ln)
  185.  
  186.     NEW thatfunc.create('acos',1,{e_constant},{f_acos})
  187.     AddTail(funclist,thatfunc.ln)
  188.  
  189.     NEW thatfunc.create('asin',1,{e_constant},{f_asin})
  190.     AddTail(funclist,thatfunc.ln)
  191.  
  192.     NEW thatfunc.create('atan',1,{e_constant},{f_atan})
  193.     AddTail(funclist,thatfunc.ln)
  194.  
  195.     NEW thatfunc.create('angle',2,{e_constant},{f_angle})
  196.     AddTail(funclist,thatfunc.ln)
  197.  
  198.     NEW thatfunc.create('min',2,{e_min},{f_min})
  199.     AddTail(funclist,thatfunc.ln)
  200.  
  201.     NEW thatfunc.create('max',2,{e_max},{f_max})
  202.     AddTail(funclist,thatfunc.ln)
  203.  
  204.     NEW thatfunc.create('sqrt',1,{e_sqrt},{f_sqrt})
  205.     AddTail(funclist,thatfunc.ln)
  206.  
  207.     NEW thatfunc.create('ln',1,{e_ln},{f_ln})
  208.     AddTail(funclist,thatfunc.ln)
  209.  
  210.     NEW thatfunc.create('log',2,{e_log},{f_log})
  211.     AddTail(funclist,thatfunc.ln)
  212.  
  213.     NEW thatfunc.create('cosh',1,{e_constant},{f_cosh}) -> maybe later, approximated int value?
  214.     AddTail(funclist,thatfunc.ln)
  215.  
  216.     NEW thatfunc.create('sinh',1,{e_constant},{f_sinh})
  217.     AddTail(funclist,thatfunc.ln)
  218.  
  219.     NEW thatfunc.create('tanh',1,{e_constant},{f_tanh})
  220.     AddTail(funclist,thatfunc.ln)
  221.  
  222.     NEW thatfunc.create('acosh',1,{e_constant},{e_constant})->,{f_acosh})
  223.     AddTail(funclist,thatfunc.ln)                      
  224.                                                        
  225.     NEW thatfunc.create('asinh',1,{e_constant},{e_constant})->,{f_asinh})
  226.     AddTail(funclist,thatfunc.ln)                      
  227.                                                        
  228.     NEW thatfunc.create('atanh',1,{e_constant},{e_constant})->,{f_atanh})
  229.     AddTail(funclist,thatfunc.ln)
  230.  
  231.     NEW thatfunc.create('r',3,{e_red},{f_red})
  232.     thatfunc.readpid:=TRUE
  233.     AddTail(funclist,thatfunc.ln)
  234.     NEW thatfunc.create('g',3,{e_green},{f_green})
  235.     thatfunc.readpid:=TRUE
  236.     AddTail(funclist,thatfunc.ln)
  237.     NEW thatfunc.create('b',3,{e_blue},{f_blue})
  238.     thatfunc.readpid:=TRUE
  239.     AddTail(funclist,thatfunc.ln)
  240. ENDPROC
  241.  
  242. EXPORT PROC cleanfuncs()
  243. DEF thisnode:PTR TO ln,nextone
  244.  
  245.     thisnode:=funclist.head
  246.     WHILE (nextone:=thisnode.succ) AND Not(CtrlC()) -> Destroy all functions...
  247.         DisposeLink(thisnode.name)
  248.         END thisnode;thisnode:=nextone
  249.     ENDWHILE
  250.     END funclist
  251. ENDPROC
  252.  
  253. /* I am required to have the three arguments, so I cannot get rid of the unreferenced messages.*/
  254.  
  255. PROC e_constant(x,y,c) IS c
  256.  
  257. ENUM VAR_x,VAR_y
  258. PROC e_variable(x,y,c)
  259.     IF c=VAR_x THEN RETURN x
  260. ENDPROC y
  261. /*PROC f_variable(x,y,c) -> Test: Let's use the above one instead and have picFX convert the vars...
  262.     IF c=VAR_x THEN RETURN x!
  263. ENDPROC y!
  264. */
  265. EXPORT PROC e_mod(x,y,c=0) -> This is also used in picFX as a kind of replacement to Mod()
  266.     IF y = 0; RETURN 0
  267.     ELSEIF x >= 0; RETURN Mod(x,y)
  268.     ENDIF
  269. ENDPROC Mod(x,y)+y
  270. PROC f_mod(x,y,c)
  271.     IF y = 0. THEN RETURN 0.
  272. ENDPROC !x-(!Ffloor(!x/y)*y)
  273.  
  274. PROC e_add(x,y,c) IS x+y
  275. PROC f_add(x,y,c) IS !x+y
  276.  
  277. PROC e_sub(x,y,c) IS x-y
  278. PROC f_sub(x,y,c) IS !x-y
  279.  
  280. PROC e_mul(x,y,c) IS Mul(x,y)
  281. PROC f_mul(x,y,c) IS !x*y
  282.  
  283. PROC e_div(x,y,c)
  284.     IF y = 0 THEN RETURN 123456 ELSE RETURN Div(x,y)
  285. ENDPROC
  286.  
  287. PROC f_div(x,y,c)
  288.     IF y = 0. THEN RETURN 123456. ELSE RETURN !x/y
  289. ENDPROC
  290.  
  291. PROC e_pow(x,y,c) -> maybe would be quicker to convert to float, power, and back to int again?
  292. DEF result
  293.     IF y = 0 THEN RETURN 1
  294.     result:=x
  295.     WHILE y > 1
  296.         result:=Mul(result,x)
  297.         y--
  298.     ENDWHILE
  299. ENDPROC result
  300. PROC f_pow(x,y,c) IS Fpow(y,x)
  301.  
  302. PROC e_abs(x,y,c) IS Abs(x)
  303. PROC f_abs(x,y,c) IS Fabs(x)
  304.  
  305. PROC e_neg(x,y,c) IS -x
  306. PROC f_neg(x,y,c) IS !-x
  307.  
  308. PROC f_sin(x,y,c) IS Fsin(x)
  309. PROC f_cos(x,y,c) IS Fcos(x)
  310. 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...
  311. PROC f_asin(x,y,c) IS Fasin(x)
  312. PROC f_acos(x,y,c) IS Facos(x)
  313. PROC f_atan(x,y,c) IS Fatan(x)
  314.  
  315. PROC f_angle(x,y,c)
  316.     IF y=0.
  317.         IF x<0. THEN RETURN 3.14159265 ELSE RETURN 0.
  318.     ELSEIF !y<0
  319.         RETURN !Fatan(!x/y)+1.5707963
  320.     ENDIF
  321. ENDPROC !Fatan(!x/y)-1.5707963
  322.  
  323. PROC e_min(x,y,c) IS Min(x,y)
  324. PROC f_min(x,y,c)
  325.     IF !x>y THEN RETURN y ELSE RETURN x
  326. ENDPROC
  327.  
  328. PROC e_max(x,y,c) IS Max(x,y)
  329. PROC f_max(x,y,c)
  330.     IF !x<y THEN RETURN y ELSE RETURN x
  331. ENDPROC
  332.  
  333. PROC e_sqrt(x,y,c) IS !Fsqrt(x!)!
  334. PROC f_sqrt(x,y,c) IS Fsqrt(x)
  335.  
  336. PROC e_ln(x,y,c)
  337.     IF x <= 0 THEN RETURN 123456 ELSE RETURN !Flog(x!)!
  338. ENDPROC
  339. PROC f_ln(x,y,c)
  340.     IF x<=0 THEN RETURN 123456. ELSE RETURN Flog(x)
  341. ENDPROC
  342.  
  343. PROC e_log(x,y,c) -> All these tests are annoying, but I do not know how to avoid them...
  344.     IF (x<=0) OR (y<=0) OR (y=1) THEN RETURN 123456 ELSE RETURN !Flog(x!)/Flog(y!)!
  345. ENDPROC
  346. PROC f_log(x,y,c)
  347.     IF (x<=0.) OR (y<=0.) OR (y=1. ) THEN RETURN 123456. ELSE RETURN !Flog(x)/Flog(y)
  348. ENDPROC
  349.  
  350. 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...
  351. PROC f_cosh(x,y,c) IS Fcosh(x)
  352. PROC f_tanh(x,y,c) IS Ftanh(x)
  353.  
  354. /*PROC f_asinh(x,y,c) IS Fasinh(x) -> These three aren't implemented in E...
  355. PROC f_acosh(x,y,c) IS Facosh(x)
  356. PROC f_atanh(x,y,c) IS Fatanh(x)*/
  357.  
  358. 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)
  359. 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))!
  360.  
  361. 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
  362. 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)!
  363.  
  364. 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
  365. 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)!
  366.  
  367. /* Expression class. This is equivalent to the old function one. Decoding is now put in the constructor (=> a little bit less code ;)
  368. If there's a problem while decoding, the function will get f(x,y)=0*/
  369.  
  370. EXPORT SET NEEDX,SHORT -> short is x,y,e,pi,numeric-constant, i.e. what does not need computation.
  371. EXPORT ENUM FAILURE=$100,ERR_NoParse,ERR_NoFunc,ERR_NoChar
  372. EXPORT SET WARN_NoSupport,WARN_EPi
  373.  
  374. EXPORT OBJECT expression
  375.     func:PTR TO function
  376.     arg1:PTR TO expression
  377.     arg2:PTR TO expression
  378.     cte:LONG -> third arg. For reason of backward compatibility, it is the arg #1 in the expression string, when present.
  379.  
  380.     precision
  381.     evaluate -> evaluate THIS proc.
  382.  
  383.     /*precalculation stuff*/
  384. /*following: allocated with AllocVec()!!!!*/
  385.     precalc:PTR TO LONG         -> pre-calculates. Values put in buffer (only in main expr)
  386.     calculate:PTR TO LONG       -> calculates function value (only in main expr)
  387.     buffer:PTR TO LONG          -> pre-calculated value (only in main expr)
  388.  
  389.     message -> how last decoding went: WARN_#? or ERR_#? or NIL
  390.  
  391.     need:LONG -> what vars are required to eval. it
  392. ->    value:LONG -> precalculated value
  393. ENDOBJECT
  394.  
  395. /*EXPORT OBJECT outinfo
  396.     error:LONG
  397.     quote:PTR TO CHAR
  398. ENDOBJECT*/
  399.  
  400. PROC setfunc(address:PTR TO function) OF expression
  401.     self.func:=address
  402.     IF self.precision = OUT_Integer
  403.         self.evaluate:=self.func.evalI
  404.     ELSEIF self.precision = OUT_Float32
  405.         self.evaluate:=self.func.evalF
  406.     ELSE -> Actually this happens when using a non-direct output mode (copy, old,..?)
  407. ->        WriteF('Unknown output mode\n')
  408.         self.evaluate:=self.func.evalF -> (Just in case of problem, but it shouldn't be useful)
  409.     ENDIF
  410. ENDPROC
  411.  
  412. /* 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)*/
  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,ee:PTR TO expression,var,
  415.     open,close,nxt:PTR TO LONG,dest: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 Not(first) 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 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. /* Reg usage: A5 is for temporary values, valid during one single expr evaluation;
  613.               A1 points to the pre-calculated values*/
  614.  
  615. PROC compile(len,maxcount,buffsize) OF expression
  616. DEF nxt:PTR TO LONG,dest:PTR TO LONG
  617.     c:=0;p:=0;s:=-1
  618.     NEW code[len];crs:=code
  619.     NEW precalc[len];prs:=precalc
  620.     buffer:=AllocVec(buffsize*4+4,MEMF_PUBLIC) -> 4 is SIZEOF LONG
  621.     self.buffer:=buffer
  622.  
  623.     crs[]:=$4E55;crs++; crs[]:=(-maxcount-2)*4 AND $FFFF;crs++ -> LINK A5,#$<..maxcount..>
  624.  
  625.     prs[]:=$4E55;prs++; prs[]:=(-maxcount-2)*4 AND $FFFF;prs++ -> LINK A5,#$<maxcount>
  626.  
  627.     self.subcompile()
  628.     IF (self.need AND NEEDX)=$0 -> If *nothing* in the expression depends on x, let's save+recall here.
  629.         s++
  630.  
  631.         crs[]:=$227C;crs++; crs[]:=Shr(buffer,16);crs++; crs[]:=buffer;crs++ ->MOVE.L buffer,A1
  632.         prs[]:=$227C;prs++; prs[]:=Shr(buffer,16);prs++; prs[]:=buffer;prs++ ->MOVE.L buffer,A1
  633.  
  634.         prs[]:=$2340;prs++;prs[]:=s*4;prs++ -> MOVE.L D0,<s*4>(A1)
  635.         crs[]:=$2029;crs++;crs[]:=s*4;crs++ -> MOVE.L <s*4>(A1),D0
  636.     ENDIF
  637.  
  638.     crs[]:=$4E5D;crs++ -> UNLK A5
  639.     crs[]:=$4E75;crs++ -> RTS
  640.  
  641.     prs[]:=$4E5D;prs++ -> UNLK A5
  642.     prs[]:=$4E75;prs++ -> RTS
  643.  
  644.     self.calculate:=AllocVec(crs-code+16,NIL)
  645.     nxt:=code;dest:=self.calculate
  646.     WHILE nxt <= (crs)
  647.         dest[]:=nxt[]
  648.         nxt++;dest++
  649.     ENDWHILE
  650.     END code[len]
  651.  
  652.     self.precalc:=AllocVec(prs-precalc+16,NIL)
  653.     nxt:=precalc;dest:=self.precalc
  654.     WHILE nxt <= (prs)
  655.         dest[]:=nxt[]
  656.         nxt++;dest++
  657.     ENDWHILE
  658.     END precalc[len]
  659. ENDPROC
  660.  
  661. PROC long(k:PTR TO expression)
  662.     IF k
  663.         RETURN (k.need AND SHORT) = $0
  664.     ELSE
  665.         RETURN FALSE
  666.     ENDIF
  667. ENDPROC
  668.  
  669. PROC subcompile() OF expression
  670. DEF saved=FALSE, -> TRUE if arg1 was saved in A5.
  671.     buff=-1  -> buffer-slot (in case "f(y)_f(x)") where f(y) is stored
  672.     IF long(self) = FALSE -> That's only if the global (whole) expression is short.
  673.         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...
  674.            IF self.cte=VAR_x
  675.                crs[]:=$202D;crs++ -> MOVE.L $C(A5),D0
  676.                crs[]:=$C;crs++
  677.            ELSEIF self.cte=VAR_y
  678.                prs[]:=$202D;prs++ -> MOVE.L $8(A5),D0
  679.                prs[]:=$8;prs++
  680.            ENDIF
  681.        ELSEIF self.func=fconstant
  682.            prs[]:=$203C ;prs++ -> MOVE.L #self.cte,D0
  683.            prs[]:=Shr(self.cte,16);prs++;prs[]:=self.cte ;prs++ -> constant argument
  684.        ENDIF
  685.        RETURN
  686.     ENDIF
  687.  
  688. /* First of all calculate subexpressions that need to be calculated */
  689.     IF long(self.arg1)
  690.         self.arg1.subcompile()
  691.         IF long(self.arg2) -> If we have two args that need computation, then we'll have to save one to do the other one...
  692.             IF self.arg1.need AND NEEDX -> Neither arg1, nor us can pre-calculate.
  693.                 c++
  694.                 crs[]:=$2B40;crs++-> MOVE.L D0,$-<c*4>(A5)
  695.                 crs[]:=-c*4 ;crs++-> store that arg
  696.                 saved:=TRUE
  697.             ELSEIF (self.need AND NEEDX) = $0
  698.                 p++
  699.                 prs[]:=$2B40;prs++-> MOVE.L D0,$-<p*4>(A5)
  700.                 prs[]:=-p*4 ;prs++-> store that arg
  701.                 saved:=TRUE
  702.             ENDIF
  703.         ENDIF
  704.         IF self.need AND Not(self.arg1.need) AND NEEDX -> save pre-calculated arg1 to A1
  705.             s++
  706.             buff:=s
  707.             prs[]:=$227C;prs++;prs[]:=Shr(buffer,16);prs++; prs[]:=buffer;prs++ ->MOVE.L buffer,A1
  708.             prs[]:=$2340;prs++;prs[]:=s*4;prs++ -> MOVE.L D0,<s*4>(A1)
  709.         ENDIF
  710.     ENDIF
  711.     IF long(self.arg2)
  712.         self.arg2.subcompile()
  713.         IF self.need AND Not(self.arg2.need) AND NEEDX -> arg2 doesn't needx but we do => save pre-calculated arg2 to A1
  714.             s++
  715.             prs[]:=$227C;prs++;prs[]:=Shr(buffer,16);prs++; prs[]:=buffer;prs++ ->MOVE.L buffer,A1
  716.             prs[]:=$2340;prs++;prs[]:=s*4;prs++ -> MOVE.L D0,<s*4>(A1)
  717.         ENDIF
  718.     ENDIF
  719.  
  720. /* Now put arguments in stack and execute function. */
  721.     IF long(self.arg1)=FALSE -> I assume that self.arg1 exists
  722.         IF self.arg1.func=fvariable
  723.             IF self.arg1.cte=VAR_x
  724.                 crs[]:=$2F2D;crs++ -> MOVE.L $C(A5),-(A7)
  725.                 crs[]:=$C;crs++
  726.             ELSEIF self.arg1.cte=VAR_y
  727.                 write($2F2D,self.need) -> MOVE.L $8(A5),-(A7)
  728.                 write($8,self.need) -> "write", as we wouldn't need pre-calculation if there's only a single y.
  729.             ENDIF
  730.         ELSEIF self.arg1.func=fconstant
  731.             write($2F3C,self.need) -> MOVE.L #self.cte,-(A7)
  732.             write(Shr(self.arg1.cte,16),self.need);write(self.arg1.cte,self.need)
  733.         ENDIF
  734.     ELSEIF saved
  735.         IF self.need AND NEEDX
  736.             crs[]:=$2F2D ;crs++ -> MOVE.L $-<c*4>(A5),-(A7)
  737.             crs[]:=-c*4 ;crs++-> push copied argument (a)
  738.             c--
  739.         ELSE
  740.             prs[]:=$2F2D ;prs++ -> MOVE.L $-<p*4>(A5),-(A7)
  741.             prs[]:=-p*4 ;prs++-> push copied argument (a)
  742.             p--
  743.         ENDIF
  744.     ELSEIF buff>-1 -> Copy pre-calculated value.
  745.         crs[]:=$227C;crs++;crs[]:=Shr(buffer,16);crs++; crs[]:=buffer;crs++ ->MOVE.L buffer,A1
  746.         crs[]:=$2F29;crs++ -> MOVE.L <buff*4>(A1),-(A7)
  747.         crs[]:=buff*4;crs++
  748.     ELSE -> Long arg1(x), Short arg2
  749.         IF self.need AND NEEDX
  750.             crs[]:=$2F00 ;crs++ -> MOVE.L D0,-(A7)
  751.         ELSE
  752.             prs[]:=$2F00 ;prs++ -> MOVE.L D0,-(A7)
  753.         ENDIF
  754.     ENDIF
  755.  
  756.     IF self.arg2
  757.         IF long(self.arg2)
  758.             IF self.need AND NEEDX
  759.                 IF self.arg2.need AND NEEDX
  760.                     crs[]:=$2F00 ;crs++ -> MOVE.L D0,-(A7)
  761.                 ELSE
  762.                     crs[]:=$227C;crs++;crs[]:=Shr(buffer,16);crs++; crs[]:=buffer;crs++ ->MOVE.L buffer,A1
  763.                     crs[]:=$2F29;crs++ -> MOVE.L <s*4>(A1),-(A7)
  764.                     crs[]:=s*4;crs++
  765.                 ENDIF
  766.             ELSE
  767.                 prs[]:=$2F00 ;prs++ -> MOVE.L D0,-(A7)
  768.             ENDIF
  769.         ELSE
  770.             IF self.arg2.func=fvariable
  771.                 IF self.arg2.cte=VAR_x
  772.                     crs[]:=$2F2D;crs++ -> MOVE.L $C(A5),-(A7)
  773.                     crs[]:=$C;crs++
  774.                 ELSEIF self.arg2.cte=VAR_y
  775.                     write($2F2D,self.need) -> MOVE.L $8(A5),-(A7)
  776.                     write($8,self.need) -> "write", as we wouldn't need pre-calculation if there's only a single y.
  777.                 ENDIF
  778.             ELSEIF self.arg2.func=fconstant
  779.                 write($2F3C,self.need) -> MOVE.L #self.arg2.cte,-(A7)
  780.                 write(Shr(self.arg2.cte,16),self.need);write(self.arg2.cte,self.need) -> constant argument
  781.             ENDIF
  782.         ENDIF
  783.     ELSE -> No arg2: push zero
  784.         write($2F3C,self.need) -> MOVE.L #0,-(A7)
  785.         write(0,self.need);write(0,self.need)
  786.     ENDIF
  787.     IF self.need AND NEEDX
  788.         crs[]:=$2F3C ;crs++ -> MOVE.L #self.cte,-(A7)
  789.         crs[]:=Shr(self.cte,16);crs++;crs[]:=self.cte ;crs++
  790.         crs[]:=$4EB9 ;crs++ -> JSR self.evaluate
  791.         crs[]:=Shr(self.evaluate,16);crs++;crs[]:=self.evaluate ;crs++
  792.     ELSE
  793.         prs[]:=$2F3C ;prs++ -> MOVE.L #self.cte,-(A7)
  794.         prs[]:=Shr(self.cte,16);prs++;prs[]:=self.cte ;prs++
  795.         prs[]:=$4EB9 ;prs++ -> JSR self.evaluate
  796.         prs[]:=Shr(self.evaluate,16);prs++;prs[]:=self.evaluate ;prs++
  797.     ENDIF
  798. ENDPROC
  799.  
  800. PROC write(value,need) -> Little loss of time here at pre-compilation-time, but it is nicer so.
  801.     IF need AND NEEDX
  802.         crs[]:=value;crs++
  803.     ELSE
  804.         prs[]:=value;prs++
  805.     ENDIF
  806. ENDPROC
  807.  
  808. PROC reference() OF expression
  809.     IF self.func.readpid = TRUE THEN -> I guess that all function that need a data require having its project frozen...
  810.         RETURN self.cte,self.arg1,self.arg2
  811. ENDPROC self.func.argcount+1,self.arg1,self.arg2
  812.  
  813. PROC evaluate(x,y) OF expression
  814. DEF a,b,p
  815.     IF self.func=fvariable
  816.         p:=self.evaluate
  817.         RETURN p(x,y,self.cte)
  818.     ENDIF
  819.     IF self.func.argcount>0
  820.         a:=self.arg1.evaluate(x,y)
  821.         IF self.func.argcount>1 ->THEN
  822.             b:=self.arg2.evaluate(x,y)
  823.         ENDIF
  824.     ENDIF
  825.     p:=self.evaluate
  826. ENDPROC p(a,b,self.cte)
  827.  
  828. PROC end() OF expression
  829.     IF self.func -> Maybe the decoding was aborted before we could know the function...
  830.         IF self.func.argcount>0
  831.             END self.arg1
  832.             IF self.func.argcount>1 THEN END self.arg2
  833.         ENDIF
  834.     ENDIF
  835.     IF self.calculate THEN
  836.         FreeVec(self.calculate)
  837.     IF self.precalc THEN
  838.         FreeVec(self.precalc)
  839.     IF self.buffer THEN
  840.         FreeVec(self.buffer)
  841. ENDPROC
  842.  
  843. /*last(): Exactely like InStr(), but from right to left..*/
  844. PROC last(str,findme,before=-1)
  845. DEF found=0,next
  846.     IF before=-1 THEN before:=StrLen(findme)
  847.  
  848.     WHILE ((next:=InStr(str,findme,found)) < before) AND (next <> -1)
  849.         found:=next
  850.         IF CtrlC()
  851.             WriteF('Infinite loop?\nnext=\d;found=\d... [returning -1]\n')
  852.             RETURN -1
  853.         ENDIF
  854.     ENDWHILE
  855.     IF found=0 THEN found:=-1
  856. ENDPROC found
  857.