interpreteur, comparaison bytecoce-p-code

Sujets variés concernant le développement en PureBasic
Anonyme

interpreteur, comparaison bytecoce-p-code

Message par Anonyme »

dans mon interpreteur logo (pureGolo) , j'utilise une liste chainée comme pile de prg !!
Hs:

je profite de ce que tu as écrit pour te posé une question simple.
dans cette pile de commande , tu stocke quoi ? des chaines de caractères , que tu analyses au fur & à mesure de l'exécution ?
Avatar de l’utilisateur
GeBonet
Messages : 453
Inscription : ven. 29/févr./2008 16:17
Localisation : Belgique

Message par GeBonet »

He oui !
Dobro a écrit : c'est une pile !! :)
Je n'avais pas vus la liste chainée sous cet angle...
Dobro a écrit : donc si tu entasse des blocs de données par 10
il faudra quater de 10 en 10 pour atteindre la debut de chacun de tes blocs de données :)
c'est assez simple en faite !
Effectivement... C'est curieux car en fait cela me rappelle un système que j'avais monté qui était basé sur un principe similaire...
Ou les blocs étaient des enregistrements liés entre eux par des pointeurs croisés (pour reconstituer en cas de crash) et ayant leurs adresse début référencé dans un fichier "Index" avec la ou les clef d'accès... J'avais donc aussi un fichier "Index" ou "Dico" avec les clef pointant vers le bloc concerné et ce pour un ou plusieurs fichiers et des fichiers "binaire" contenant les blocs ou enregistrements. Soit de même type que PB puisque qu'on y accède par FileSeek, donc directement au byte près. (Système à longueur variable...).
J'ai d'ailleurs encore et sur papier (image sur disque) le schéma de ce type de "chainage"... Et les séquence qui le traite. Et ça pour le coup devient "obsolète. :(
avant j'etais tres tableau Dim()
mais je dois dire que ma conversion est quasi total !!
Ben voilà, comme c'est pas encore le cas... je vais étudier ça de beaucoup plus près de manière à ce que cette "pile" me remplace mes tables de paramètres !!!
:lol: :lol:
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

Cpl.Bator a écrit :
dans mon interpreteur logo (pureGolo) , j'utilise une liste chainée comme pile de prg !!
Hs:

je profite de ce que tu as écrit pour te posé une question simple.
dans cette pile de commande , tu stocke quoi ? des chaines de caractères , que tu analyses au fur & à mesure de l'exécution ?

oui ! j'utilise en réalité une liste chainée comme "pseudo" pile

chaque ligne de prg est stocké dedans
puis je balaye la liste pour analyser chacune des lignes de code PureGolo

la liste me permet d'effectuer les sauts, les procédures et leur retours

puisqu'on connais en permanence le lieu d'où l'on part, et le lieu d'arrivé du pointeur , cela permet de "sauter" dans la "pile" , et de revenir au point de depart lors de la rencontre d'un "Fin_pour"(endprocedure)

biens sur, j'utilise une structure pour enregistrer ce genre d'info
ce qui me permet de pouvoir faire des saut et retour imbriqué :)

bien sur, pour mes variables,
j'utilise une autre listes chainée,(pseudo-pile) ce qui me permet d'ajouter des variables
a la volée, et ensuite d'effectuer un "garbage collection", en effaçant l'existence de ces variables crée lors de la sortie de cette procedure "Pour[]" (procédure), qui pour le coup se comporte comme des variable locale !! :D

ce qui m'évite d'avoir une pile qui se remplirai trop vite en cas d'appel récursif ;), en fait ça creer une variable fille a chaque appel !!
....... sans oublier la gestion des valeurs des variables fille pour les variables parent lors d'un retour de valeur d'une procédure grâce a RETOURNE,ret,return ;) ,(ça fera partie de la prochaine version , je bosse encore dessus)


j'ai préféré faire comme ça , au détriment du fonctionnement d'une vraie pile , ou l'on utilise qu'un endroit pour empiler, ou dépiler
tout !


mais le fonctionnement a la base est bien le même , il s'agit d'une liste
avec un pointeur qui se promène tout du long pour " pointer" un élément a l'intérieur ! :D


il me semble qu'une vrai pile doit en plus se réduire pour supprimer les éléments inutiles
c'est ce que je fait pour ma pile des variables :)

mais c'est pas utile pour ma pile contenant mon prg ! :)
qui n'est elle qu'un moyen pour se promener parmi un listing :)


le tout demande une bonne rigueur de gestion, surtout lorsqu'on ajoute
la possibilité d'imbrication des boucles repete , des if,si , des "tant_que (while)" etc .... :D

un vrai casse tete a la fin :)
Avatar de l’utilisateur
GeBonet
Messages : 453
Inscription : ven. 29/févr./2008 16:17
Localisation : Belgique

Message par GeBonet »

Pour le cas ou voici :
un schéma de liaison Dictionnaire fichier "Binaire" organisé par bloc...
http://home.euphonynet.be/bonet/Fiche00Bin2.jpg
il me semble assez explicite sur les relations.
Le dictionaire quant a lui est
en insertion/recherche "dichotomique" ou autre...
Voilà, voilà... :roll:
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

oui ! bah une liste chainée c'est pareil que ton shemas !! :)

regarde la doc purebasic a ce sujet, je pense que tu vas percuter ! :)
Anonyme

Message par Anonyme »

un vrai casse tete a la fin
Oui , mais je pense avoir trouvé une solution bien meilleur que mes recherches passées dans le domaine de l'interprétation.

en fait l'idée de base c'est de transformer chaque commande en un byte

par exemple :

do = 0x50h
loop = 0x10h
operateur d'égalité "=" = 0x25h
variable = 0x37h
valeur immédiate = 0x48h

le code

Code : Tout sélectionner

do 
A=45
loop
deviens une serie de byte

Code : Tout sélectionner

$50,$37,$XX,$XX,$XX,$XX,$25,$48,$00,$00,$00,$2D,$10
$XX = pointeur

tu n'a plus qu'a interprété des bytes , c'est à mis chemin entre la compilation "pure" , et un interpréteur basique.


- la premiere instruction est $50 (DO)
tu stocke la position dans une pile FIFO , on l'appelera pile A

- la deuxième instruction $37
on s'apprête à accéder à une variable , les 4 prochains byte constitue le pointeur.
on lis le pointeur , on le stocke dans une pile FIFO , pile B

- la troisième instruction $25 , est l'opérateur d'égalité
on sait donc que cet opérateur va être utilisé avec le sommet de la pile B
l'instruction qui suit peut être une autre variable , une valeur immédiate, on ne sait pas encore.

- la 4° instruction $48 , c'est une valeur immédiate .l
les 4 prochain bytes constitue donc la valeur.
$0000002D = 45
on lis le pointeur de la pile B , on affecte la valeur.

la 5° , 10$ , le loop
on lis le sommet de la pile A , on "saute" en changeant de position dans le code
on retire de la pile A le premier élément

etc...

au niveau des perfs, y a pas foto , c'est 1000x plus performant que de lire des chaines de caractères une à une. analyser par la suite des bytes est plus simple aussi que les strings :D

le plus dur , c'est de le transformé en byte :D
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

c'est le principe que j'utilise , sauf qu'effectivement moi je reste en clair !
en chaine

tu me propose de faire un "bytecode" en quelque sorte

mais au fond, la raison en serai que l'acces dans une structure list chainée serai plus rapide pour des chiffres que pour une chaine ....
c'est interressant , mais es tu sur de ça ?? 8O

faudrai que je fasse des tests pour vérifier ça ..

l'acces d'une liste chainé, serai donc plus rapide pour des valeurs que pour des chaine$.... y a t'il une raison a cela ? 8O

ha bah oui , on a plus a analyser la ligne de code a chaque tour ! :)
Anonyme

Message par Anonyme »

Certain , lors de mon apprentissage à la compilation à la main , j'ai du transformé a la main des executables , qui eux même ne sont ni plus ni moins que des series de byte.

a titre d'exemple :

Cela ne reflete pas la réalité , il n'y a pas la phase d'interpretation , juste un parcours de chaine ( donc assez rapide ) en réalité, c'est plus lent .

Code : Tout sélectionner

NewList A.s()
NewList B.b()


; 500 instruction bidon
For i = 0 To 500-1
AddElement(A()) 
; 20 lettres max par instruction
For j = 0 To Random(20)
    A() + Chr( 48 + Random(122-48))
Next 
Next 

; en admettant que 500 instructions du code source se transforme 
; en 4000 instruction byte code
For i =  0 To 4000 
AddElement(B())
B() = Random(255)
Next 


OpenConsole()

A = ElapsedMilliseconds()
; 10000 boucle
For i = 0 To 9999
    ForEach A()
      
      ; On parcour la commande pour l'analyser
      For j = 1 To Len(A())
          ; Analyse bidon
      Next 
      
    Next 
Next 
B = ElapsedMilliseconds()

Print("Langage interpreter pour 10.000 itérations avec 500 commandes dans la pile : ")
PrintN(Str(B-A)+"ms")

A = ElapsedMilliseconds()
; 10000 boucle
For i = 0 To 9999
    ForEach B()
      Byte.b = B()      
    Next 
Next 
B = ElapsedMilliseconds()

Print("Langage Byte code pour 10.000 itérations avec 4000 commandes dans la pile :  ")
PrintN(Str(B-A)+"ms")
Input()
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

j'ai cree un nouveau sujet pour pas poluer celui de gebonet :)

je regarde ton code :)
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

ha oui !! ç'est impressionnant !!

je vais finaliser la version actuel de puregolo
et je ferai une version byte code apres :D

merci pour l'idée , c'est excellent

mon code est pas trop mal foutu , je ne devrai pas trop galerer a faire le changement :D
cha0s
Messages : 681
Inscription : sam. 05/mars/2005 16:09

Message par cha0s »

j'ai dev un petit language de script pour reproduire la lib bulletml en purebasic, comme je doit utiliser en temps réel les script je transforme les informations sous forme d'action mais pour traiter les opérations du genre :

Code : Tout sélectionner

$1+50*random()
je transforme l'opération en arbre ou les différentes opérations sont exécuté du bas vers le haut récursivement (matheux s'abstenir faut pas faire péter la pile).
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

cha0s a écrit :

Code : Tout sélectionner

$1+50*random()
je transforme l'opération en arbre ou les différentes opérations sont exécuté du bas vers le haut récursivement (matheux s'abstenir faut pas faire péter la pile).
perso pour puregolo j'utilise un code allemand , un evaluateur d'expression, qui permet de calculer plein de truc a partir d'une chaine de caractere ! :)

il reconnait : les parentheses

"sqr"
"asin"
"sin"
"acos"
"cos"
"atan"
"tan"
"int"
"abs"
"logten"
"log"

"pi"
"e" (la constante Euler)

pour l'utilisation c'est simple


; ici les expression sont evalué soit en long, soit en flottant !! :D
il y a 2 procedures :)


Debug "5-6*2+10 ="+Str(CalculateL("5-6*2+10") )
Debug "10+SQR(9) ="+StrF(CalculateF("10+Sqr(9)") )


Code : Tout sélectionner

;#PI=3.1415926
#NUM = "0123456789" 
#STRIN ="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_"

; *************************************************************
;-*** D E C L A R E *** 




;Operanten-Codes 
#OP_UNKNOWN         = -1 
#OP_NONE            = 0 
#OP_PLUS            = 1 
#OP_MINUS           = 2 
#OP_MULT            = 3 
#OP_DIV             = 4 
#OP_POT             = 5 
#OP_FUNC            = 6 

;Funktions-Codes 
#FUNC_SQR           = 1 
#FUNC_SIN           = 2 
#FUNC_ASIN          = 3 
#FUNC_COS           = 4 
#FUNC_ACOS          = 5 
#FUNC_TAN           = 6 
#FUNC_ATAN          = 7 
#FUNC_INT           = 8 
#FUNC_ABS           = 9 
#FUNC_LOG10         = 10 
#FUNC_LOG           = 11 

;Konstanten 
#CONST_PI           = "3.1415926"   ;PI 
#CONST_E            = "2.7182818"   ;Eulersche Zahl 

;Error-Codes 
#CALC_ERR_NONE          = 0         ;kein Fehler 
#CALC_ERR_SYNTAX        = 1         ;Allgemeiner Syntax-Fehler (fehlender Wert) 
#CALC_ERR_DIVNULL       = 2         ;Division / 0 aufgetreten 
#CALC_ERR_OPNOTFOUND    = 3         ;Operant nicht gefunden 
#CALC_ERR_FUNCNOTFOUND  = 4         ;Funktion nicht gefunden 

#PRIORITY_STEP      = 4             ;entspricht der höchsten Prioritätsstufe der Operanten 
#MAX_TREENODES      = 100           ;Maximale Anzahl an SyntaxBaum-Knoten 

#OPERAND            = 1 
#VALUE              = 2 

Structure SyntaxTreeNode 
    *parent.SyntaxTreeNode 
    *child.SyntaxTreeNode[2] 
    operand.l 
    prior.l 
    Value.f 
EndStructure 

Structure SyntaxTree 
    *root.SyntaxTreeNode 
    node.SyntaxTreeNode[#MAX_TREENODES] 
    remark$ ;frei verwendbar 
EndStructure 





; *************************************************************************************
Declare.l Calc_Modulo(a.l, b.l) 
Declare Calc_SetOperand(operand$, *node.SyntaxTreeNode) 
Declare.s Calc_GetContent(*expression, type.l, *pos.Long)
Declare Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode) 
Declare Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.l, *nodeInsert.SyntaxTreeNode)
Declare.f Calc_GetNodeValueF(*node.SyntaxTreeNode) 
Declare Calc_ConsoleOutSyntaxNode(*node.SyntaxTreeNode, level.l) 
Declare Calc_ConsoleOutSyntaxTree(*tree.SyntaxTree) 
Declare CreateSyntaxTree(*tree.SyntaxTree, expression$) 
Declare.f CalculateSyntaxTreeF(*tree.SyntaxTree) 
Declare.l CalculateSyntaxTreeL(*tree.SyntaxTree) 
Declare.l CalculateL(expression$) 
Declare.f CalculateF(expression$) 
Declare.l GetCalculationError() 
Declare EnableFunctionCalculation(bool.b) 
Declare EnableConstantCalculation(bool.b) 
EnableFunctionCalculation(1) 
EnableConstantCalculation(1) 
; *************************************************************************************
; *************************************************************************************
; *************************************************************************************
; *************************************************************************************





; Ton programme ici 


; DOBRO !! ici les expression sont evalué soit en long, soit en flottant !! :D
Debug "5-6*2+10 ="+Str(CalculateL("5-6*2+10") )
Debug "10+SQR(9) ="+StrF(CalculateF("10+Sqr(9)") )

; *************************************************************************************
; *************************************************************************************
; *************************************************************************************
 ;**************************Calculateur**********************************************
  
  ; a la fin les procedures :D
Procedure.l Calc_Modulo(a.l, b.l) 
    ProcedureReturn a - a / b * b 
EndProcedure 
  
Procedure Calc_SetOperand(operand$, *node.SyntaxTreeNode) 
    Shared priorMod.l 
    
    While PeekB(@operand$) = 41 ;Left(operand$, 1) = ")" 
        operand$ = Mid(operand$, 2, Len(operand$)) 
        priorMod - #PRIORITY_STEP 
    Wend 
    
    While PeekB(@operand$ + Len(operand$) - 1) = 40 ;Right(operand$, 1) = "(" 
        operand$ = Left(operand$, Len(operand$) - 1) 
        changePrior.l + #PRIORITY_STEP 
    Wend 
    
    Select operand$ 
        Case "+" 
            *node\operand = #OP_PLUS 
            *node\prior = priorMod + 1 
        Case "-" 
            *node\operand = #OP_MINUS 
            *node\prior = priorMod + 1 
        Case "*" 
            *node\operand = #OP_MULT 
            *node\prior = priorMod + 2 
        Case "/" 
            *node\operand = #OP_DIV 
            *node\prior = priorMod + 2 
        Case "^" 
            *node\operand = #OP_POT 
            *node\prior = priorMod + 3 
            
            
        Case "~" 
            *node\operand = #OP_FUNC 
            ;ACHTUNG: Funktionen müssen IMMMER die höchste Priorität besitzen 
            *node\prior = priorMod + 4 
        Default 
            *node\operand = #OP_UNKNOWN 
    EndSelect 
    
    priorMod + changePrior 
EndProcedure 
  
Procedure.s Calc_GetContent(*expression, type.l, *pos.Long) 
    *pointer.Byte = *expression + *pos\l 
    
    If type = #VALUE 
        ;(-x) Ausrdrücke zulassen 
        If PeekB(*pointer) = 45 ; '-' 
            *pointer + 1 
        EndIf 
        
        ;) + - * / ^ ~ \0 
        ;Ascii-Wert eines neuen Operators hier mit einfügen 
        While (*pointer\b < 97 Or *pointer\b > 122) And *pointer\b <> 41 And *pointer\b <> 42 And *pointer\b <> 43  And *pointer\b <> 45 And *pointer\b <> 47 And *pointer\b <> 94 And *pointer\b <> 126 And *pointer\b <> 0 
            *pointer + 1 
        Wend 
    Else 
        ;0-9 . 
        While (*pointer\b < 48 Or *pointer\b > 57) And *pointer\b <> 46 And *pointer\b <> 0 
            *pointer + 1 
        Wend 
        ;(-x) Ausrdrücke zulassen 
        If PeekB(*pointer - 1) = 45 And PeekB(*pointer - 2) = 40 ; '(-' 
            *pointer - 1 
        EndIf 
    EndIf 
    
    a_RET$ = PeekS(*expression + *pos\l, (*pointer - *expression) - *pos\l) 
    
    If *pointer\b 
        *pos\l = *pointer - *expression 
    Else 
        *pos\l = -1 
    EndIf 
    
    ProcedureReturn a_RET$ 
EndProcedure 
  
Procedure Calc_InsertNodeAsParent(*nodeTarget.SyntaxTreeNode, *nodeInsert.SyntaxTreeNode) 
    child.l 
    
    If *nodeTarget\parent 
        If *nodeTarget\parent\child[0] = *nodeTarget 
            child = 0 
        ElseIf *nodeTarget\parent\child[1] = *nodeTarget 
            child = 1 
        EndIf 
        *nodeTarget\parent\child[child] = *nodeInsert 
        *nodeInsert\parent = *nodeTarget\parent 
    EndIf 
    *nodeTarget\parent = *nodeInsert 
    *nodeInsert\child[0] = *nodeTarget 
EndProcedure 
  
Procedure Calc_InsertNodeAsChild(*nodeTarget.SyntaxTreeNode, child.l, *nodeInsert.SyntaxTreeNode) 
    If *nodeTarget\child[child] 
        *nodeChild.SyntaxTreeNode = *nodeTarget\child[child] 
        *nodeChild\parent = *nodeInsert 
        *nodeInsert\child[0] = *nodeTarget\child[child] 
    EndIf 
    
    *nodeTarget\child[child] = *nodeInsert 
    *nodeInsert\parent = *nodeTarget 
EndProcedure 
  
Procedure.f Calc_GetNodeValueF(*node.SyntaxTreeNode) 
    Shared calculationErrorOccured.b 
    Result.f 
    
    If *node 
        If *node\operand 
            valueOne.f = Calc_GetNodeValueF(*node\child[0]) 
            valueTwo.f = Calc_GetNodeValueF(*node\child[1]) 
            Select *node\operand 
                Case #OP_PLUS 
                    Result = valueOne + valueTwo 
                Case #OP_MINUS 
                    Result = valueOne - valueTwo 
                Case #OP_MULT 
                    Result = valueOne * valueTwo 
                Case #OP_DIV 
                    Result = valueOne / valueTwo 
                    If valueTwo = 0 And calculationErrorOccured = 0 
                        calculationErrorOccured = #CALC_ERR_DIVNULL 
                    EndIf 
                Case #OP_POT 
                    Result = Pow(valueOne, valueTwo) 
                    
                Case #OP_FUNC 
                    Select valueOne ;steht für den Funktionstyp 
                        Case #FUNC_SQR 
                            Result = Sqr(valueTwo) 
                        Case #FUNC_SIN 
                            Result = Sin(valueTwo) 
                        Case #FUNC_ASIN 
                            Result = ASin(valueTwo) 
                        Case #FUNC_COS 
                            Result = Cos(valueTwo) 
                        Case #FUNC_ACOS 
                            Result = ACos(valueTwo) 
                        Case #FUNC_TAN 
                            Result = Tan(valueTwo) 
                        Case #FUNC_ATAN 
                            Result = ATan(valueTwo) 
                        Case #FUNC_INT 
                            Result = Int(valueTwo) 
                        Case #FUNC_ABS 
                            Result = Abs(valueTwo) 
                        Case #FUNC_LOG10 
                            Result = Log10(valueTwo) 
                        Case #FUNC_LOG 
                            Result = Log(valueTwo) 
                        Default 
                            calculationErrorOccured = #CALC_ERR_FUNCNOTFOUND 
                    EndSelect 
                    
                Case #OP_UNKNOWN 
                    calculationErrorOccured = #CALC_ERR_OPNOTFOUND 
            EndSelect 
            ProcedureReturn Result 
        Else 
            ProcedureReturn *node\Value 
        EndIf 
    Else 
        calculationErrorOccured = 1 
    EndIf 
EndProcedure 
  
Procedure Calc_ConsoleOutSyntaxNode(*node.SyntaxTreeNode, level.l) 
    ;für Debugging und Veranschaulischungszwecke 
    Shared isFunction.b 
    
    If *node 
        
        If  *node\operand 
            If *node\operand = #OP_PLUS 
                PrintN(Space(level * 2) + "+") 
            ElseIf *node\operand = #OP_MINUS 
                PrintN(Space(level * 2) + "-") 
            ElseIf *node\operand = #OP_MULT 
                PrintN(Space(level * 2) + "*") 
            ElseIf *node\operand = #OP_DIV 
                PrintN(Space(level * 2) + "/") 
            ElseIf *node\operand = #OP_POT 
                PrintN(Space(level * 2) + "^") 
            ElseIf *node\operand = #OP_FUNC 
                isFunction = 1 
            EndIf 
        Else 
            If isFunction 
                Print(Space((level-1) * 2)) 
                Select *node\Value 
                    Case #FUNC_SQR 
                        PrintN("SQR") 
                    Case #FUNC_SIN 
                        PrintN("SIN") 
                    Case #FUNC_ASIN 
                        PrintN("ASIN") 
                    Case #FUNC_COS 
                        PrintN("COS") 
                    Case #FUNC_ACOS 
                        PrintN("ACOS") 
                    Case #FUNC_TAN 
                        PrintN("TAN") 
                    Case #FUNC_ATAN 
                        PrintN("ATAN") 
                    Case #FUNC_INT 
                        PrintN("INT") 
                    Case #FUNC_ABS 
                        PrintN("ABS") 
                    Case #FUNC_LOG10 
                        PrintN("LOGTEN") 
                    Case #FUNC_LOG 
                        PrintN("LOG") 
                EndSelect 
            Else 
                PrintN(Space(level * 2) + StrF(*node\Value)) 
            EndIf 
        EndIf 
        
        If *node\child[0] 
            Calc_ConsoleOutSyntaxNode(*node\child[0], level + 1) 
            isFunction = 0 
        EndIf 
        If *node\child[1] 
            Calc_ConsoleOutSyntaxNode(*node\child[1], level + 1) 
        EndIf 
    EndIf 
EndProcedure 
  
Procedure Calc_ConsoleOutSyntaxTree(*tree.SyntaxTree) 
    ;für Debugging und Veranschaulischungszwecke 
    Calc_ConsoleOutSyntaxNode(*tree\root, 0) 
EndProcedure 
  
  ;--    Public 
  
Procedure CreateSyntaxTree(*tree.SyntaxTree, expression$) 
    Shared priorMod.l, functionCalculationEnabled.b, constantCalculationEnabled.b 
    
    priorMod = 0 
    nodeCount.l = 0 
    Position.l = 0 
    
    *nodeLastValue.SyntaxTreeNode 
    *nodeCurrentValue.SyntaxTreeNode 
    *nodeLastOperand.SyntaxTreeNode 
    *nodeCurrentOperand.SyntaxTreeNode 
    
    expression$ = LCase(ReplaceString(expression$, " ", "")) 
    
    While Left(expression$, 1) = "(" 
        expression$ = Mid(expression$, 2, Len(expression$)) 
        priorMod + #PRIORITY_STEP 
    Wend 
    While Right(expression$, 1) = ")" 
        expression$ = Left(expression$, Len(expression$) - 1) 
    Wend 
    
    If functionCalculationEnabled 
        expression$ = ReplaceString(expression$, "sqr",   Str(#FUNC_SQR) + "~") 
        expression$ = ReplaceString(expression$, "asin",  Str(#FUNC_ASIN) + "~") 
        expression$ = ReplaceString(expression$, "sin",   Str(#FUNC_SIN) + "~") 
        expression$ = ReplaceString(expression$, "acos",  Str(#FUNC_ACOS) + "~") 
        expression$ = ReplaceString(expression$, "cos",   Str(#FUNC_COS) + "~") 
        expression$ = ReplaceString(expression$, "atan",  Str(#FUNC_ATAN) + "~") 
        expression$ = ReplaceString(expression$, "tan",   Str(#FUNC_TAN) + "~") 
        expression$ = ReplaceString(expression$, "int",   Str(#FUNC_INT) + "~") 
        expression$ = ReplaceString(expression$, "abs",   Str(#FUNC_ABS) + "~") 
        expression$ = ReplaceString(expression$, "logten",Str(#FUNC_LOG10) + "~") 
        expression$ = ReplaceString(expression$, "log",   Str(#FUNC_LOG) + "~") 
    EndIf 
    
    If constantCalculationEnabled 
        expression$ = ReplaceString(expression$, "pi", #CONST_PI) 
        expression$ = ReplaceString(expression$, "e",  #CONST_E) 
    EndIf 
    
    ;Debug expression$ 
    
    Repeat 
        nodeCount + 1 
        
        If Calc_Modulo(nodeCount, 2) ;Wert 
            node$ = Calc_GetContent(@expression$, #VALUE, @Position) 
            *tree\node[nodeCount]\Value = ValF(node$) 
            *nodeCurrentValue = *tree\node[nodeCount] 
            ;Debug node$ 
            
            If nodeCount > 1 
                Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentValue) 
            EndIf 
            
            *nodeLastValue = *nodeCurrentValue 
        Else ;Operator 
            node$ = Calc_GetContent(@expression$, #OPERAND, @Position) 
            Calc_SetOperand(node$, *tree\node[nodeCount]) 
            
            *nodeCurrentOperand = *tree\node[nodeCount] 
            ;Debug node$ + " :: " + Str(*nodeCurrentOperand\prior) 
            
            If *nodeLastOperand 
                If *nodeCurrentOperand\prior > *nodeLastOperand\prior 
                    Calc_InsertNodeAsChild(*nodeLastOperand, 1, *nodeCurrentOperand) 
                ElseIf *nodeCurrentOperand\prior = *nodeLastOperand\prior 
                    Calc_InsertNodeAsParent(*nodeLastOperand, *nodeCurrentOperand) 
                Else 
                    *node.SyntaxTreeNode = *nodeLastOperand 
                    While *node\parent And *node\prior > *nodeCurrentOperand\prior 
                        *node = *node\parent 
                    Wend 
                    
                    If *node\prior = *nodeCurrentOperand\prior 
                        Calc_InsertNodeAsParent(*node, *nodeCurrentOperand) 
                    ElseIf *node\prior < *nodeCurrentOperand\prior 
                        Calc_InsertNodeAsChild(*node, 1, *nodeCurrentOperand) 
                    Else 
                        Calc_InsertNodeAsParent(*node, *nodeCurrentOperand) 
                    EndIf 
                EndIf 
            Else 
                Calc_InsertNodeAsParent(*nodeLastValue, *nodeCurrentOperand) 
            EndIf 
            
            *nodeLastOperand = *nodeCurrentOperand 
        EndIf 
        
    Until Position = -1 
    
    If *nodeLastOperand 
        While *nodeLastOperand\parent 
            *nodeLastOperand = *nodeLastOperand\parent 
        Wend 
        *tree\root = *nodeLastOperand 
    ElseIf nodeCount = 1 
        *tree\root = *nodeLastValue 
    Else 
        *tree\root = 0 
    EndIf 
    
EndProcedure 
  
Procedure.f CalculateSyntaxTreeF(*tree.SyntaxTree) 
    Shared calculationErrorOccured.b 
    calculationErrorOccured = 0 
    
    If *tree\root 
        Result.f = Calc_GetNodeValueF(*tree\root) 
    Else 
        ;Fehler auslösen 
        calculationErrorOccured = 1 
        Result.f = 0 / Result 
    EndIf 
    
    ProcedureReturn Result 
EndProcedure 
  
Procedure.l CalculateSyntaxTreeL(*tree.SyntaxTree) 
    Shared calculationErrorOccured.b 
    calculationErrorOccured = 0 
    
    If *tree\root 
        Result.l = Calc_GetNodeValueF(*tree\root) 
    Else 
        ;Fehler auslösen 
        calculationErrorOccured = 1 
    EndIf 
    
    ProcedureReturn Result 
EndProcedure 
  
Procedure.l CalculateL(expression$) 
    Shared calculationErrorOccured.b 
    calculationErrorOccured = 0 
    
    tree.SyntaxTree 
    CreateSyntaxTree(@tree, expression$) 
    
    If tree\root 
        Result.l = Calc_GetNodeValueF(tree\root) 
    Else 
        ;Fehler auslösen 
        calculationErrorOccured = 1 
    EndIf 
    
    ProcedureReturn Result 
EndProcedure 
  
Procedure.f CalculateF(expression$) 
    Shared calculationErrorOccured.b 
    calculationErrorOccured = 0 
    
    tree.SyntaxTree 
    CreateSyntaxTree(tree, expression$) 
    
    If tree\root  
        ;Shared-Variable und If-Abfrage ist nur für das Beispiel und kann rausgenommen werden 
        Shared outputSyntaxTree.b 
        If outputSyntaxTree 
            Calc_ConsoleOutSyntaxTree(tree) 
        EndIf 
        
        Result.f = Calc_GetNodeValueF(tree\root) 
    Else 
        ;Fehler auslösen 
        calculationErrorOccured = 1 
        Result.f = 0 / Result 
    EndIf 
    
    ProcedureReturn Result 
EndProcedure 
  
Procedure.l GetCalculationError() 
    Shared calculationErrorOccured.b 
    ProcedureReturn calculationErrorOccured 
EndProcedure 
  
Procedure EnableFunctionCalculation(bool.b) 
    Shared functionCalculationEnabled.b 
    functionCalculationEnabled = bool 
EndProcedure 
  
Procedure EnableConstantCalculation(bool.b) 
    Shared constantCalculationEnabled.b 
    constantCalculationEnabled = bool 
EndProcedure 
  
  ; ****************************************************************************************** 




cha0s
Messages : 681
Inscription : sam. 05/mars/2005 16:09

Message par cha0s »

@a dobro le mien fonctionne a peu prêt pareil sauf qu'il ne prend que les doubles et peut prendre des parametres.
Anonyme

Message par Anonyme »

mon code est pas trop mal foutu , je ne devrai pas trop galerer a faire le changement Very Happy

La conception n'a plus rien à voir. a mon avis tu vas pas être déçu :D

il faut bien que tu comprennes qu'il faut "compilé" la source.
tu ne la compileras pas avec des instructions microprocesseurs , mais des instructions "maison" , la seule différence qu'il y aura avec un véritable exécutable , c'est qu'il ne sera pas exécuter directement par l'OS.

l'avantage :

pas la doc d'intel a se claquer
pas besoin d'apprendre le format PE de windows ou ELF de linux.
plus rapide qu'un simple "interpreteur"

l'inconvénient :

moins rapide qu'un exe "pur" , mais rapide quand même. :D


Avant de se lancer dans se genre de chose , faut bien comprendre le concept d'execution.

Image


Le petit schéma montre comment doit être disposer se genre de programme.


En tête donne quelque renseignements :

- la taille de l'entête.
- le nombres d' entête de segment.
- la taille des entêtes de segment.
- la position du point d'entré du programme.

les entêtes de segments donne les infos suivantes :

- le point d'entré du segment de code
- la taille du segment de code.


etc...

Regarde le schéma du dessus.

Imagine que l'on exécute notre programme.

La 1° instruction commence à "point d'entré"
ensuite il continue l'exécution
jusqu'à tomber sur un appel de fonction.

une fonction est dans un segment différent.
on consulte donc l'entete ( flêche rouge )
on recherche la bonne entete (flêche verte)
on change de segment ( flêche bleue )
on execute le segment.

Chaque segment possède ses propres tables de variables , ce qui nous donne des variables locale...
le programme possède aussi une table commune à tout les segments , ce qui donne des variables globales.

le schéma est "grossi" pour bien te faire comprendre la tâche que cela implique.
La compilation peut se passer en plusieurs "passe"

ex :

passe 1
Tu énumères toute les fonction , la boucle principale ,
tu créer les segment et les en tête correspondante.

passe 2
pour chaque segment , tu transforme en byte code , le resultat te donne une taille , tu mets à jours les en tête.



Voila , voila , pas simple hein? :D
cha0s
Messages : 681
Inscription : sam. 05/mars/2005 16:09

Message par cha0s »

compliqué ton histoire, regarde comment marche le code que dobro a posté c'est beaucoup plus simple et plus rapide par contre plus gourmand en mémoire.



voici ma méthode : (inutile d'essayer de compiler il manque les dépendances ^^')

Code : Tout sélectionner

;===========================================================
;lib Calcul
;requis :
;Array.pb
;variable.Class.pb
;function.Class.pb
;script.Class.pb
;chaos.Class.pb 
;===========================================================

Enumeration 1
  #Function
  #operation
  #param
  #random
  #value
EndEnumeration

Structure operation
  type.b
  value.d
  *operation.operation[3]
  *Function.Function
EndStructure


Structure GlobalOperation
  *FirstOperation.operation
  *Chaos.chaos
EndStructure

#Calcul_Value = "0123456789"
#Calcul_FormatOperator = "* / + -"
#Calcul_FormatFonction = "FactDouble DivDouble AddDouble SubDouble"
Declare.d ExecuteOperation_(*operation.operation, *param.i)


Procedure FindEndPosition(text.s, position.w)
  Protected n.w ,x.w
  For x=position To Len(text)
    If Mid(text, x, 1) = "("
      n+1
    EndIf
    If Mid(text, x, 1) = ")"
      If n = 1
        ProcedureReturn x
      Else
        n -1
      EndIf
    EndIf 
  Next x
  ProcedureReturn -1
EndProcedure

;===========================================================
;renvoie le parametre sous forme de string
;===========================================================
Procedure.s Calcul_FindNextArgument(text.s, index.b)
  ;Debug "argument a trouver " + Str(index) + " dans " + text
  If Not Len(text) Or index <=0 
    ProcedureReturn ""
  EndIf
  Protected Parenthese_Found = 0
  Protected Virgule_Found = 0
  Protected Index_text.w
  Protected Index_LastVirgule
  Protected Char_Current.s
  For Index_text = 1 To Len(text)
    Char_Current = Mid(text, Index_text, 1)
    Select Char_Current   
      Case "("
        Parenthese_Found + 1
      Case ")"
        Parenthese_Found - 1
        If Parenthese_Found < 0
           ProcedureReturn "" 
        EndIf
      Case ","
        If Parenthese_Found = 0;si on trouve une virgule qui n'est pas entre parenthese
          Virgule_Found + 1
          If Virgule_Found = index
            ProcedureReturn Mid(text, Index_LastVirgule, Index_text - Index_LastVirgule - 1)
          EndIf
          Index_LastVirgule = Index_text + 1
        EndIf;sinon on ignore
    EndSelect
  Next Index_text
  ProcedureReturn Mid(text, Index_LastVirgule, Index_text - Index_LastVirgule)
EndProcedure

;===========================================================
;renvoie le numero de parametre si c'est un parametre
;===========================================================
Procedure Calcul_IsParam(text.s)
  If Len(text)> 2
    ProcedureReturn #False
  EndIf
  If Mid(text, 1, 1) = "$"
    Protected value.b = Val(Mid(text, 2, 1))
    For x=1 To 9
      If value = x
        ProcedureReturn x
      EndIf
    Next x
  EndIf
  ProcedureReturn #False
EndProcedure

;===========================================================
;renvoie vrai si l'expression est un valeur (type flotant)
;===========================================================
Procedure Calcul_IsValue(text.s)
  Protected x.w, char.s, n.b, found.b, virgule.b
  For x=0 To Len(text)
    char = Mid(text, x, 1)
    found = 0
    For n=0 To Len(#Calcul_Value)
      If (Mid(#Calcul_Value, n, 1) = char)
        found = 1
      EndIf
    Next n
    
    If char = "."
      If virgule
        ProcedureReturn #False
      Else
        virgule = 1
      EndIf
      found = 1
    EndIf
    
    If found = 0
      ProcedureReturn #False
    EndIf
  Next x
  ProcedureReturn #True
EndProcedure

;===========================================================
;renvoie vrai si l'expression une operation
;===========================================================
Procedure IsOperation(text.s)
  Protected x.w, char.s, n.b
  For x=0 To Len(text)
    char = Mid(text, x, 1)
    For n=0 To 9
      If Not (Str(n) = char)
        ProcedureReturn #True
      EndIf
    Next n
  Next x
  ProcedureReturn -1
EndProcedure

;===========================================================
;renvoie vrai si l'expression un operateur
;===========================================================
Procedure Calcul_IsOperator(char.s)
  Protected n.w, operator.s
  For n=1 To 4
    operator = StringField(#Calcul_FormatOperator, n, " ")
    If operator = char
      ProcedureReturn #True
    EndIf
  Next n
  ProcedureReturn #False
EndProcedure


;===========================================================
;renvoie expression + function(argument1,
;===========================================================
Procedure.s Calcul_GetLeftExpression(text.s, function.s)
  Protected char.s, n.w, Parenthese_Found.w
  For n = Len(text) To 0 Step -1
    char = Mid(text, n, 1)
    If Calcul_IsOperator(char)
      If Parenthese_Found = 0
        ProcedureReturn Left(text, n) + function + "(" + Right(text, Len(text) - n) + ","
      EndIf
    EndIf
    If char = ")"
      Parenthese_Found + 1
    EndIf
    If char = "(" Or char = ","
      If Parenthese_Found = 0
        ProcedureReturn Left(text, n) + function + "(" + Right(text, Len(text) - n) + ","
      EndIf
      If char = "("
        Parenthese_Found - 1
      EndIf
    EndIf
  Next n
  ProcedureReturn function  + "(" + text + ","
EndProcedure

;===========================================================
;renvoie argument2) + expression
;===========================================================
Procedure.s Calcul_GetRightExpression(text.s)
  Protected char.s, n.w, Parenthese_Found.w
  For n = 1 To Len(text) - 1
    char = Mid(text, n, 1)
    If Calcul_IsOperator(char)
      If Parenthese_Found = 0
        ProcedureReturn Left(text, n) + ")" + Right(text, Len(text) - n)
      EndIf
    EndIf

    If char = ")" Or char = ","
      If char = ")"
        Parenthese_Found - 1
      EndIf
      If Parenthese_Found = 0
        ProcedureReturn Left(text, n) + ")" + Right(text, Len(text) - n)
      EndIf
    EndIf
    
    If char = "("
      Parenthese_Found + 1
    EndIf
  Next n
  ProcedureReturn text + ")"
EndProcedure

;===========================================================
;formate le texte en remplacant les operateurs par des fonctions
;===========================================================
Procedure.s Calcul_FormatOperation(text.s)
  If Not Len(text)
    ProcedureReturn ""
  EndIf
  Protected n.b, operator.s, function.s, i.w, x.b, char.s
  For n=1 To 4
    operator = StringField(#Calcul_FormatOperator, n, " ")
    function =  StringField(#Calcul_FormatFonction, n, " ")
    i = FindString(text, operator, 1)
    While i
      text = Calcul_GetLeftExpression(Left(text, i - 1), function) + Calcul_GetRightExpression(Right(text,Len(text) - i))
      i = FindString(text, operator, 1)
    Wend
  Next
  ProcedureReturn text
EndProcedure

;===========================================================
;on crée les operations en cascade
;===========================================================
Procedure CreateOperation(*Chaos.Chaos, text.s)
  If Not Len(text)
    ProcedureReturn #False
  EndIf
  Protected *NewOperation.operation
;===========================================================
;si l'operation est une simple valeur
;===========================================================
  If Not (Calcul_IsValue(text) = #False)
    ;Debug "value " + text
    *NewOperation = AllocateMemory(SizeOf(operation))
    *NewOperation\type = #value
    *NewOperation\value = ValD(text)
    ProcedureReturn *NewOperation
  EndIf
;===========================================================
;si l'operation est un parametres
;===========================================================
  Protected Param.b = Calcul_IsParam(text)
  If Param
    ;Debug "param " + Str(Param)
    *NewOperation = AllocateMemory(SizeOf(operation))
    *NewOperation\type = #param
    *NewOperation\value = Param
    ProcedureReturn *NewOperation
  EndIf
;===========================================================
;si l'operation comporte des fonctions
;===========================================================
  Protected FctFound.s
  Protected n.w, i.w, x.w,  NbrParam.b
  Protected Index_Param.b
  n = FindString(text, "(" ,1)
  If n
    FctFound = Left(text, n - 1)
    For x = 1 To CountEllement(*Chaos\function)
      If LCase(GetFunctionName(GetEllement(*Chaos\function, x))) = FctFound
        NbrParam = GetNbrParam(GetEllement(*Chaos\function, x))
        ;Debug "fonction trouvé : " + FctFound + Str(NbrParam) + " parametres"
        *NewOperation = AllocateMemory(SizeOf(operation))
        *NewOperation\type = #Function
        *NewOperation\Function = GetEllement(*Chaos\function, x)
        text = Left(text, Len(text) - 1)
        text = Right(text, Len(text) - Len(FctFound) - 1)
        ;Debug "traitement de " + text
        ;si aucun parametre
        If NbrParam = 0  
          If Len(text) = 0
            ProcedureReturn *NewOperation
          Else
            ProcedureReturn #False
          EndIf
        EndIf
        If NbrParam >= 1
          If Len(text) = 0
            ProcedureReturn #False
          Else

          For Index_Param = 1 To NbrParam
            ;Debug "arg " + Str(Index_Param) + " " + Calcul_FindNextArgument(text, Index_Param) 
            *NewOperation\operation[Index_Param - 1] = CreateOperation(*Chaos, Calcul_FindNextArgument(text, Index_Param))
            If *NewOperation\operation[Index_Param - 1] = #False
              ;Debug "erreur"
              ProcedureReturn #False
            EndIf
          Next Index_Param
          ProcedureReturn *NewOperation

          EndIf
        EndIf
        

      EndIf
    Next x
  EndIf
  ProcedureReturn #False
EndProcedure

;===========================================================
;-constructeur
;===========================================================
Procedure NewOperation(*Chaos.Chaos, text.s)
  Protected n.w = CountString(text, "(")
  If Len(text)=0 Or Not (n = CountString(text, ")")) 
    ProcedureReturn -1
  EndIf
  text = LCase(Calcul_FormatOperation(RemoveString(text, " ")))
  Protected *this.GlobalOperation = AllocateMemory(SizeOf(GlobalOperation))
  *this\FirstOperation = CreateOperation(*Chaos, text)
  If *this\FirstOperation
    *this\Chaos = *Chaos
    ProcedureReturn *this
  Else
    FreeMemory(*this)
    ProcedureReturn -1
  EndIf
EndProcedure

Procedure FastNewOperation(*Chaos.Chaos, text.s)
  Protected *this.GlobalOperation = AllocateMemory(SizeOf(GlobalOperation))
  *this\FirstOperation = CreateOperation(*Chaos, text)
  If *this\FirstOperation
    *this\Chaos = *Chaos
    ProcedureReturn *this
  Else
    FreeMemory(*this)
    ProcedureReturn -1
  EndIf
EndProcedure

;===========================================================
;-execution de l'operation
;===========================================================
Procedure.d ExecuteOperation(*this.GlobalOperation, *param = #Null)
  ProcedureReturn ExecuteOperation_(*this\FirstOperation, *param)
EndProcedure

Procedure.d ExecuteOperation_(*this.operation, *param.i)
  Protected n.w
  Select *this\type
    Case #param
      ProcedureReturn PeekD(*param + SizeOf(double)*(*this\value-1))
    Case #random
      ProcedureReturn (Random(100)*0.01)
    Case #value
      ProcedureReturn *this\value
    Case #Function
      If *this\function\NbrParam
        Protected *arg = AllocateMemory(*this\function\SizeParam)
        For n=0 To (*this\function\NbrParam - 1)
          PokeD(*arg + SizeOf(double) * n, ExecuteOperation_(*this\operation[n], *param))
        Next n
      EndIf
      ProcedureReturn ExecuteFunctionD(*this\Function, *arg)
  EndSelect
EndProcedure
Edit : Pour BulletML meme combat

Code : Tout sélectionner

Procedure BML_ExecuteAction( *this.BML_Action)
  If Not *this\LocalAction
    *this\LocalAction = *this\MainAction
  EndIf
  Protected *OldAction
  Protected  *fire.BML_Fire, *bullet.BMl_Bullet, *LocalArray.Array = CreateArray()
  Protected  *boucle.Array = CreateArray()
  Protected  n, i, *ptr, *count.BML_ShardeCounter, delay
  Protected NewList RepeatAction.BML_RepeatAction()
  *this\State = #BML_ActionAlive
  While Not (size = MemorySize(*this\LocalAction\script))
    LockMutex(*this\mutex)
    If *this\State = #BML_ActionEnded
      Break
    EndIf
    Select PeekI(*this\LocalAction\script + size)
      Case #BML_Repeat
        AddElement(RepeatAction())
        RepeatAction()\Time = PeekI(*this\LocalAction\script + size + SizeOf(integer))
        RepeatAction()\CurrentSize = size
        size + SizeOf(integer)*2
      Case  #BML_Next
        If RepeatAction()\Time > 0 
          RepeatAction()\Time - 1
        EndIf
        If RepeatAction()\Time = -1 Or RepeatAction()\Time > 0
          size = RepeatAction()\CurrentSize + SizeOf(integer)*2
        Else
          DeleteElement(RepeatAction())
          size + SizeOf(integer)*2
        EndIf
      Case  #BML_Sleep
        *count = AllocateMemory(SizeOf(BML_ShardeCounter))
        *count\mutex = CreateMutex()
        *count\count = ExecuteOperation(PeekI(*this\LocalAction\script + size + SizeOf(integer)), #Null)
        delay =*count\count
        LockArray(*this\BulletML\Frame)
        SetEllement(*this\BulletML\Frame, CountEllement(*this\BulletML\Frame) + 1, *count)
        UnlockArray(*this\BulletML\Frame)
        While delay >= 0
          LockMutex(*count\mutex)
          delay = *count\count
          UnlockMutex(*count\mutex)
          Delay(10)
        Wend
        LockArray(*this\BulletML\Frame)
        For n=1 To CountEllement(*this\BulletML\Frame)
          If *count = GetEllement(*this\BulletML\Frame, n)
            FreeEllement(*this\BulletML\Frame, n)
            Break
          EndIf
        Next n
        UnlockArray(*this\BulletML\Frame)
        FreeMemory(*count)
        size + SizeOf(integer)*2
      Case  #BML_Fire
        *fire = PeekI(*this\LocalAction\script + size + SizeOf(integer))
        *bullet = CreateBullet(*BulletMl, *fire\bullet, *this\shooter, *this\target)
        If Not (*fire\DirectionType = #BML_None)
            *bullet\DirectionType = *fire\DirectionType
            *bullet\Speed = *fire\Speed
        EndIf
        SetEllement(*LocalArray, CountEllement(*LocalArray) + 1, *bullet)
        LockArray(*this\Bullet)
        SetEllement(*this\Bullet, CountEllement(*this\Bullet) + 1, *bullet)
        UnlockArray(*this\Bullet)
        LockArray(*this\BulletML\Bullet)
        SetEllement(*this\BulletML\Bullet, CountEllement(*this\BulletML\Bullet) + 1, *bullet)
        UnLockArray(*this\BulletML\Bullet)
        AddEvent(*this\Event, *bullet, #BML_BulletCreated)
        size + SizeOf(integer)*2
      Case  #BML_ChangeSpeed
        For n = 1 To CountEllement(*LocalArray)
            *bullet = GetEllement(*LocalArray, n)
            LockMutex(*bullet\mutex)
            *bullet\speed = PeekI(*this\LocalAction\script+ size + SizeOf(integer))
            UnlockMutex(*bullet\mutex)
        Next n
        size + SizeOf(integer)*2
      Case  #BML_ChangeDirection
        For n = 1 To CountEllement(*LocalArray)
            *bullet = GetEllement(*LocalArray, n)
            LockMutex(*bullet\mutex)
            *bullet\direction = PeekI(*this\LocalAction\script + size + SizeOf(integer))
            UnlockMutex(*bullet\mutex)
        Next n
        size + SizeOf(integer)*2
      Case  #BML_ChangeDirectionType
        For n = 1 To CountEllement(*LocalArray)
            *bullet = GetEllement(*LocalArray, n)
            LockMutex(*bullet\mutex)
            *bullet\DirectionType = PeekI(*this\LocalAction\script + size + SizeOf(integer))
            UnlockMutex(*bullet\mutex)
        Next n
        size + SizeOf(integer)*2
      Case  #BMl_ModelAction
        *OldAction = *this\LocalAction 
        *this\LocalAction = PeekI(*this\LocalAction\script + size + SizeOf(integer))
        BML_ExecuteAction(*this)
        *this\LocalAction = *OldAction
        size + SizeOf(integer)*2
      Case  #BML_Vanish
        While CountEllement(*LocalArray)
          *bullet = GetEllement(*LocalArray, CountEllement(*LocalArray))
          FreeEllement(*LocalArray, CountEllement(*LocalArray))
          AddEvent(*this\Event, *bullet, #BML_BulletDestroy)
        Wend
        size + SizeOf(integer)
      Default 
        Debug PeekI(*this\LocalAction\script + size)
        size + SizeOf(integer)*2
    EndSelect
    LockMutex(*this\mutex)
  Wend
EndProcedure
Répondre