home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 555 / M85 / M85.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  38KB  |  1,351 lines
  1. Program M85;
  2. {======================================================================
  3.                Assembleur - Désassembleur - Interpréteur
  4.                              de code M85
  5.            Vocation pédagogique de modèle de processeur RISC
  6.               Assemblage et exécutions en modes pas à pas
  7.                Accès direct aux registres du processeur
  8.       Version 1.0
  9.       Début de projet       : 9.1.93
  10.       Dernière modification : 16.1.93
  11.       Eric Nicolas, d'après le cours de Jean Suchard.
  12.  ======================================================================}
  13.  
  14. {$DEFINE Int}
  15. {$DEFINE Ass}
  16. {$DEFINE Hor}
  17.  
  18. {$X+}
  19.  
  20. Uses Crt,Dos,Objects,Drivers,Menus,Views,App,Dialogs,StdDlg,TvExt;
  21.  
  22. Type
  23.   TIdent = String[40];
  24.   TEtiq  = Record
  25.              Id : TIdent;
  26.              Ad : Word;
  27.            End;
  28.   TMnem = Record
  29.             Id : TIdent;
  30.             Co : Byte;
  31.             Ad : String[3];
  32.           End;
  33.  
  34. Const
  35.   EtiqMax  = 50;
  36.   MemMax   = 500;
  37.   PilMax   = 100;
  38.   StrError : Array[1..15] Of String[50] =
  39.              ('Identificateur attendu',
  40.               'Table des symboles pleine',
  41.               'Mnémonique attendue',
  42.               'Registre Rx attendu',
  43.               'Mauvais numero de registre',
  44.               'Valeur numérique entière attendue',
  45.               '"[" attendu',
  46.               '"]" attendu',
  47.               'Symbole défini pour la deuxième fois',
  48.               'Identificateur inconnu',
  49.               'Code d''instruction inconnu',
  50.               'Saut à une adresse contenant une donnée',
  51.               'Tentative d''empilement sur une pile pleine',
  52.               'Tentative de dépilement sur une pile vide',
  53.               'Changement d''une case mémoire non autorisée');
  54.   NbMnem    = 24;
  55.   Mnem      : Array[1..NbMnem] Of TMnem =
  56.               ((Id:'NOP';Co:00;Ad:'   '),
  57.                (Id:'MOV';Co:10;Ad:'rr '),
  58.                (Id:'STO';Co:11;Ad:'br '),
  59.                (Id:'LDR';Co:12;Ad:'rb '),
  60.                (Id:'LDI';Co:13;Ad:'ri '),
  61.                (Id:'JMP';Co:20;Ad:'a  '),
  62.                (Id:'JZE';Co:21;Ad:'ra '),
  63.                (Id:'JNZ';Co:22;Ad:'ra '),
  64.                (Id:'JPO';Co:23;Ad:'ra '),
  65.                (Id:'JPN';Co:24;Ad:'ra '),
  66.                (Id:'ADD';Co:30;Ad:'rrr'),
  67.                (Id:'SUB';Co:31;Ad:'rrr'),
  68.                (Id:'MUL';Co:32;Ad:'rrr'),
  69.                (Id:'DIV';Co:33;Ad:'rrr'),
  70.                (Id:'NEG';Co:34;Ad:'r  '),
  71.                (Id:'INC';Co:35;Ad:'r  '),
  72.                (Id:'DEC';Co:36;Ad:'r  '),
  73.                (Id:'INP';Co:40;Ad:'   '),
  74.                (Id:'OUT';Co:41;Ad:'   '),
  75.                (Id:'PSH';Co:50;Ad:'r  '),
  76.                (Id:'POP';Co:51;Ad:'r  '),
  77.                (Id:'JSR';Co:52;Ad:'a  '),
  78.                (Id:'RTS';Co:53;Ad:'   '),
  79.                (Id:'END';Co:60;Ad:'   '));
  80.  
  81.  
  82. {======================================================================
  83.                          Routines générales
  84.  ======================================================================}
  85.  
  86. Procedure SignaleError(S : String);
  87. Var E      : TEvent;
  88.     Sortie : Boolean;
  89. Begin
  90.   Sortie:=FALSE;
  91.   TextAttr:=$4F;
  92.   GotoXY(1,25);ClrEol;Write(Copy(S,1,72),' Pressez ESC.');
  93.   Repeat
  94.     GetKeyEvent(E);
  95.     If E.What=evKeyDown Then
  96.       If E.CharCode=#27 Then Sortie:=TRUE;
  97.   Until Sortie;
  98.   StatusLine^.DrawView;
  99. End;
  100.  
  101. {$IFDEF Ass}
  102.  
  103. {======================================================================
  104.                 Assembleur 2 passes avec mode pas à pas
  105.  ======================================================================}
  106.  
  107. Const
  108.   cmAssWReset  = 200;
  109.   cmAssWUnPas  = 201;
  110.   cmAssWPasse1 = 202;
  111.   cmAssWPasse2 = 203;
  112.   cmIsAssW     = 204;
  113.  
  114. Type
  115.   PAssembleur = ^TAssembleur;
  116.   PAssInterior= ^TAssInterior;
  117.   TAssInterior= Object(TScroller)
  118.                   Ass : PAssembleur;
  119.                   Tpe : Byte;
  120.                   constructor Init(var Bounds: TRect;
  121.                               AHScrollBar,AVScrollBar: PScrollBar;
  122.                               eAss : PAssembleur ; eTpe : Byte);
  123.                   Procedure   Draw; Virtual;
  124.                   Procedure   MiseAJour;
  125.                 End;
  126.   TAssembleur = Object(TDialog)
  127.                   I1,I2,I3: PAssInterior;
  128.                   Ligne   : Word;
  129.                   NbEtiq  : Word;
  130.                   Etiq    : Array[1..EtiqMax] Of TEtiq;
  131.                   Code    : Array[0..MemMax-1] Of Word;
  132.                   Marque  : Array[0..MemMax-1] Of Boolean;
  133.                   Adr     : Word;
  134.                   CarLu   : Char;
  135.                   Etat    : Byte;
  136.                   EtatStr : String;
  137.                   Source  : PByteArray;
  138.                   Taille  : Word;
  139.                   Pos     : Word;
  140.                   PosAff  : Byte;
  141.                   NbLigne : Word;
  142.                   Err     : String;
  143.                   Constructor Init(eNom : String);
  144.                   Destructor  Done;  Virtual;
  145.                   Procedure   Reset;
  146.                   Procedure   UnPas;
  147.                   Procedure   Passe1;
  148.                   Procedure   Passe2;
  149.                   Procedure   LitCar;
  150.                   Procedure   Error(n : Byte);
  151.                   Procedure   Sauve(eNom : String);
  152.                   Function    MakeInterior(Bounds : TRect;Tpe : Byte) : PAssInterior;
  153.                   Procedure   HandleEvent(Var Event : TEvent);  Virtual;
  154.                   Function    Valid(Command : Word) : Boolean;  Virtual;
  155.                   Procedure   SizeLimits(Var Min,Max : TPoint); Virtual;
  156.                 End;
  157.  
  158. constructor TAssInterior.Init(var Bounds: TRect; AHScrollBar,
  159.   AVScrollBar: PScrollBar; eAss : PAssembleur ; eTpe : Byte);
  160. begin
  161.   TScroller.Init(Bounds, AHScrollBar, AVScrollBar);
  162.   Ass:=eAss;
  163.   Tpe:=eTpe;
  164.   Options := Options or ofFramed;
  165.   Case Tpe Of
  166.     1 : SetLimit(128,Ass^.NbLigne);
  167.     2 : SetLimit(128,0);
  168.     3 : SetLimit(128,0);
  169.   End;
  170. end;
  171.  
  172. Procedure TAssInterior.MiseAJour;
  173. Begin
  174.   Case Tpe Of
  175.     1 : Begin
  176.           If Ass^.Ligne>=Size.Y Then ScrollTo(0,Ass^.Ligne-Size.Y+1);
  177.           If Ass^.Ligne<=Delta.Y Then ScrollTo(0,Ass^.Ligne);
  178.         End;
  179.     2 : Begin
  180.           SetLimit(128,Ass^.NbEtiq);
  181.           ScrollTo(0,Ass^.NbEtiq-Size.Y);
  182.         End;
  183.     3 : Begin
  184.           SetLimit(128,Ass^.Adr);
  185.           ScrollTo(0,Ass^.Adr-Size.Y);
  186.         End;
  187.   End;
  188. End;
  189.  
  190. Procedure TAssInterior.Draw;
  191. Var I,J   : Byte;
  192.     B     : TDrawBuffer;
  193.     S,T   : String;
  194.     Color : Byte;
  195.     E     : TEtiq;
  196.     P     : Word;
  197. Begin
  198.   P:=0;
  199.   If Tpe=1 Then
  200.     For I:=1 to Delta.Y do
  201.     Begin
  202.       While (Ass^.Source^[P]<>10) do Inc(P);
  203.       Inc(P);
  204.     End;
  205.   Color:=GetColor(1);
  206.   For I:=0 to Size.Y-1 do
  207.   Begin
  208.     S:='';
  209.     Case Tpe Of
  210.       1 : Begin
  211.             While (Ass^.Source^[P]<>10) AND (P<Ass^.Taille) do
  212.             Begin
  213.               Case Ass^.Source^[P] Of
  214.                 9       : S:=S+'   ';
  215.                 32..255 : S:=S+Chr(Ass^.Source^[P]);
  216.               End;
  217.               Inc(P);
  218.             End;
  219.             Inc(P);
  220.             If I+Delta.Y+1=Ass^.Ligne Then Color:=$2F Else Color:=$70;
  221.           End;
  222.       2 : If I+Delta.Y<Ass^.NbEtiq Then
  223.           Begin
  224.             E:=Ass^.Etiq[I+Delta.Y+1];
  225.             S:=Copy(E.Id,1,16);
  226.             While Length(S)<16 do S:=S+' ';
  227.             If E.Ad<>0 Then Str(E.Ad-1:4,T)
  228.                        Else T:='NR';
  229.             S:=S+T;
  230.           End;
  231.       3 : If I+Delta.Y<Ass^.Adr Then
  232.           Begin
  233.             Str(Ass^.Code[I+Delta.Y],S);
  234.             If Ass^.Marque[I+Delta.Y] Then S:='$'+S;
  235.           End;
  236.     End;
  237.     MoveChar(B,' ',Color,Size.X);
  238.     MoveStr(B,Copy(S,Delta.X,Size.X),Color);
  239.     WriteLine(0,I,Size.X,1,B);
  240.   End;
  241. End;
  242.  
  243. Procedure TAssembleur.SizeLimits(Var Min,Max : TPoint);
  244. Begin
  245.   Min.X:=60;
  246.   Min.Y:=13;
  247.   Max:=Owner^.Size;
  248. End;
  249.  
  250. Function TAssembleur.Valid(Command : Word) : Boolean;
  251. Var R : Boolean;
  252. Begin
  253.   If Command=cmValid Then If Err='Not Enough Memory' Then R:=FALSE;
  254.   R:=R AND TDialog.Valid(Command);
  255.   Valid:=R;
  256. End;
  257.  
  258. Function TAssembleur.MakeInterior(Bounds: TRect ; Tpe : Byte): PAssInterior;
  259. var
  260.   HScrollBar, VScrollBar: PScrollBar;
  261.   R: TRect;
  262. begin
  263.   R.Assign(Bounds.B.X - 1, Bounds.A.Y + 1, Bounds.B.X, Bounds.B.Y - 1);
  264.   VScrollBar := New(PScrollBar, Init(R));
  265.   VScrollBar^.Options := VScrollBar^.Options or ofPostProcess;
  266.   Insert(VScrollBar);
  267.   if Tpe=1 Then
  268.   Begin
  269.     R.Assign(Bounds.A.X + 2, Bounds.B.Y - 1, Bounds.B.X - 2, Bounds.B.Y);
  270.     HScrollBar := New(PScrollBar, Init(R));
  271.     HScrollBar^.Options := HScrollBar^.Options or ofPostProcess;
  272.     Insert(HScrollBar);
  273.   End
  274.   Else HScrollBar:=NIL;
  275.   Bounds.Grow(-1, -1);
  276.   MakeInterior := New(PAssInterior, Init(Bounds, HScrollBar, VScrollBar,@Self,Tpe));
  277. end;
  278.  
  279. Constructor TAssembleur.Init(eNom : String);
  280. Var Rep     : DirStr;
  281.     NomFich : NameStr;
  282.     Ext     : ExtStr;
  283.     R,R1    : TRect;
  284.     S       : PDosStream;
  285.     I       : Word;
  286.     P       : PView;
  287. Begin
  288.   FSplit(eNom,Rep,NomFich,Ext);
  289.   If Ext='' Then Ext:='.ASM';
  290.   DeskTop^.GetExtent(R);
  291.   R.Grow(-1,-4);
  292.   TDialog.Init(R,NomFich+Ext);
  293.   S:=New(PDosStream,Init(Rep+NomFich+Ext,stOpenRead));
  294.   Taille:=S^.GetSize;
  295.   If MaxAvail<Taille Then Err:='Not Enough Memory';
  296.   GetMem(Source,Taille);
  297.   S^.Read(Source^,Taille);
  298.   Dispose(S,Done);
  299.   NbLigne:=1;
  300.   For I:=1 to Taille do
  301.     If Source^[I]=10 Then Inc(NbLigne);
  302.   GetExtent(R); R.Grow(0,-1);
  303.   R.A.X:=2;
  304.   R.B.X:=R.B.X-46;
  305.   I1:=MakeInterior(R,1);
  306.   I1^.GrowMode:=I1^.GrowMode OR gfGrowHiX OR gfGrowHiY;
  307.   Insert(I1);
  308.   R1.Assign(R.A.X+1,R.A.Y,R.A.X+7,R.A.Y+1);
  309.   Insert(New(PStaticText,Init(R1,'Source')));
  310.   R.A.X:=R.B.X+1;
  311.   R.B.X:=R.A.X+22;
  312.   I2:=MakeInterior(R,2);
  313.   I2^.GrowMode:=I2^.GrowMode OR gfGrowHiX OR gfGrowLoX OR gfGrowHiY;
  314.   Insert(I2);
  315.   R1.Assign(R.A.X+1,R.A.Y,R.A.X+9,R.A.Y+1);
  316.   P:=New(PStaticText,Init(R1,'Symboles'));
  317.   P^.GrowMode:=P^.GrowMode OR gfGrowHiX OR gfGrowLoX;  Insert(P);
  318.   R.A.X:=R.B.X+1;
  319.   R.B.X:=R.A.X+7;
  320.   I3:=MakeInterior(R,3);
  321.   I3^.GrowMode:=I3^.GrowMode OR gfGrowHiX OR gfGrowLoX OR gfGrowHiY;
  322.   Insert(I3);
  323.   R1.Assign(R.A.X+1,R.A.Y,R.A.X+5,R.A.Y+1);
  324.   P:=New(PStaticText,Init(R1,'Code'));
  325.   P^.GrowMode:=P^.GrowMode OR gfGrowHiX OR gfGrowLoX;  Insert(P);
  326.   R.A.X:=R.B.X+1;
  327.   R.B.X:=R.A.X+11;
  328.   R.A.Y:=R.B.Y-11;
  329.   R.B.Y:=R.A.Y+1;
  330.   P:=New(PStaticText,Init(R,'Etat : '));
  331.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  332.   R.A.Y:=R.B.Y;
  333.   R.B.Y:=R.A.Y+1;
  334.   P:=New(PStatus,Init(R,@EtatStr));
  335.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  336.   R.A.Y:=R.B.Y+1;
  337.   R.B.Y:=R.A.Y+2;
  338.   P:=New(PButton,Init(R,'Reset',cmAssWReset,bfNormal));
  339.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  340.   R.A.Y:=R.B.Y;
  341.   R.B.Y:=R.A.Y+2;
  342.   P:=New(PButton,Init(R,'Un Pas',cmAssWUnPas,bfNormal));
  343.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  344.   R.A.Y:=R.B.Y;
  345.   R.B.Y:=R.A.Y+2;
  346.   P:=New(PButton,Init(R,'Passe 1',cmAssWPasse1,bfNormal));
  347.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  348.   R.A.Y:=R.B.Y;
  349.   R.B.Y:=R.A.Y+2;
  350.   P:=New(PButton,Init(R,'Passe 2',cmAssWPasse2,bfNormal));
  351.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  352.   Reset;
  353.   Flags:=Flags OR wfGrow OR wfZoom;
  354. End;
  355.  
  356. Procedure TAssembleur.HandleEvent(Var Event : TEvent);
  357. Begin
  358.   TDialog.HandleEvent(Event);
  359.   If Event.What=evBroadCast Then
  360.     If Event.Command=cmIsAssW Then ClearEvent(Event);
  361.   If Event.What=evCommand Then
  362.   Begin
  363.     Case Event.Command Of
  364.       cmAssWReset  : Reset;
  365.       cmAssWUnPas  : UnPas;
  366.       cmAssWPasse1 : Passe1;
  367.       cmAssWPasse2 : Passe2;
  368.     Else
  369.       Exit;
  370.     End;
  371.     ClearEvent(Event);
  372.     I1^.MiseAJour;
  373.     I2^.MiseAJour;
  374.     I3^.MiseAJour;
  375.     ReDraw;
  376.   End;
  377. End;
  378.  
  379. Procedure TAssembleur.Sauve(eNom : String);
  380. Var S : PDosStream;
  381. Begin
  382.   If Etat<>2 Then Exit;
  383.   S:=New(PDosStream,Init(eNom,stCreate));
  384.   S^.Write(Code,Adr*2);
  385.   Dispose(S,Done);
  386. End;
  387.  
  388. Destructor TAssembleur.Done;
  389. Begin
  390.   FreeMem(Source,Taille);
  391.   TWindow.Done;
  392. End;
  393.  
  394. Procedure TAssembleur.Reset;
  395. Begin
  396.   Etat:=0;
  397.   EtatStr:='Initial';
  398.   Err:='';
  399.   FillChar(Code,SizeOf(Code),0);
  400.   FillChar(Marque,SizeOf(Marque),FALSE);
  401.   Adr:=0;
  402.   NbEtiq:=0;
  403.   Ligne:=1;PosAff:=1;
  404.   Pos:=0;
  405.   LitCar;
  406. End;
  407.  
  408. Procedure TAssembleur.Error(n : Byte);
  409. Var S : String;
  410. Begin
  411.   Str(Ligne,S);
  412.   Err:=StrError[n]+' : Ligne '+S+'.';
  413.   EtatStr:='Erreur survenue';
  414.   Etat:=5;
  415.   I1^.MiseAJour;
  416.   I2^.MiseAJour;
  417.   I3^.MiseAJour;
  418.   ReDraw;
  419.   SignaleError(Err);
  420.   Ligne:=0;
  421. End;
  422.  
  423. Procedure TAssembleur.LitCar;
  424. Begin
  425.   If Etat<>0 Then Exit;
  426.   If Pos=Taille Then
  427.   Begin
  428.     Etat:=1;
  429.     EtatStr:='Passe 1 OK';
  430.     Ligne:=0;PosAff:=0;
  431.   End;
  432.   CarLu:=UpCase(Chr(Source^[Pos]));
  433.   Inc(Pos);
  434.   Inc(PosAff);
  435.   If CarLu=#10 Then
  436.   Begin
  437.     PosAff:=1;
  438.     Inc(Ligne);
  439.   End;
  440. End;
  441.  
  442. Procedure TAssembleur.UnPas;
  443. Var Id     : TIdent;
  444.     NoReg  : Byte;
  445.     Regs   : Array[0..2] Of Byte;
  446.     I,J    : Byte;
  447.     AdrPas : Byte;
  448.   Procedure LitCarUtile;
  449.   Begin
  450.     While (Etat=0) AND (Ord(CarLu)<=32) Do LitCar;
  451.   End;
  452.   Procedure PasseLigne;
  453.   Begin
  454.     While (Etat=0) AND (CarLu<>#10) Do LitCar;
  455.     LitCar;
  456.   End;
  457.   Procedure LitIdent(Var Id : TIdent ; Test : Boolean);
  458.   Begin
  459.     Id:='';
  460.     If Test Then
  461.       If (CarLu<'A') Or (CarLu>'Z') Then Error(1);
  462.     Repeat
  463.       Id:=Id+CarLu;
  464.       LitCar;
  465.     Until (Etat<>0) Or (Not(CarLu IN ['0'..'9','A'..'Z','_']));
  466.   End;
  467.   Procedure NewEtiq(Id : TIdent ; Ad : Word);
  468.   Begin
  469.     If NbEtiq=EtiqMax Then Error(2)
  470.                       Else
  471.     Begin
  472.       Inc(NbEtiq);
  473.       Etiq[NbEtiq].Id:=Id;
  474.       Etiq[NbEtiq].Ad:=Ad;
  475.     End;
  476.   End;
  477.   Procedure LitRegistre;
  478.   Begin
  479.     LitCarUtile;
  480.     LitIdent(Id,False);
  481.     If Length(Id)<>2 Then Begin Error(4); Exit; End;
  482.     If Id[1]<>'R' Then Begin Error(4); Exit; End;
  483.     Regs[NoReg]:=Ord(Id[2])-48;
  484.     If (Regs[NoReg]>3) Then Error(5);
  485.     Inc(NoReg);
  486.   End;
  487.   Procedure LitAdresse;
  488.   Var ValRes : Real;
  489.       ValErr : Integer;
  490.       I,J    : Byte;
  491.   Begin
  492.     LitCarUtile;
  493.     LitIdent(Id,FALSE);
  494.     Val(Id,ValRes,ValErr);
  495.     If ValErr=0 Then Code[Adr+1]:=Round(ValRes)
  496.                 Else
  497.     Begin
  498.       J:=0;
  499.       For I:=1 to NbEtiq do
  500.         If Etiq[I].Id=Id Then J:=I;
  501.       If J=0
  502.       Then
  503.         Begin
  504.           NewEtiq(Id,0);
  505.           Code[Adr+1]:=NbEtiq;
  506.           Marque[Adr+1]:=TRUE;
  507.         End
  508.       Else
  509.         If Etiq[J].Ad=0
  510.         Then
  511.           Begin
  512.             Code[Adr+1]:=J;
  513.             Marque[Adr+1]:=TRUE;
  514.           End
  515.         Else
  516.           Code[Adr+1]:=Etiq[J].Ad-1;
  517.     End;
  518.     AdrPas:=2;
  519.   End;
  520.   Procedure LitIndirect;
  521.   Begin
  522.     LitCarUtile;
  523.     If CarLu<>'[' Then Error(7);
  524.     LitCar;
  525.     LitAdresse;
  526.     If CarLu<>']' Then Error(8);
  527.     LitCar;
  528.   End;
  529.   Procedure LitImmediat;
  530.   Var ValRes : Real;
  531.       ValErr : Integer;
  532.   Begin
  533.     LitCarUtile;
  534.     LitIdent(Id,FALSE);
  535.     Val(Id,ValRes,ValErr);
  536.     If ValErr<>0 Then Error(6)
  537.                  Else
  538.     Begin
  539.       Code[Adr+1]:=Round(ValRes);
  540.       AdrPas:=2;
  541.     End;
  542.   End;
  543. Begin
  544.   If Etat<>0 Then Exit;
  545.   LitCarUtile;
  546.   Case CarLu Of
  547.     ';' : PasseLigne;
  548.     '$' : Begin
  549.             LitCar;
  550.             LitIdent(Id,TRUE);
  551.             J:=0;
  552.             For I:=1 to NbEtiq Do
  553.               If Etiq[I].Id=Id Then
  554.               Begin
  555.                 If Etiq[I].Ad=0 Then Etiq[I].Ad:=Adr+1
  556.                                 Else Error(9);
  557.                 J:=I;
  558.               End;
  559.             If J=0 Then NewEtiq(Id,Adr+1);
  560.           End;
  561.   Else
  562.     Begin
  563.       LitIdent(Id,TRUE);
  564.       If Id='DAT'
  565.       Then
  566.         Begin
  567.           LitImmediat;
  568.           Code[Adr]:=Code[Adr+1];
  569.           Inc(Adr);
  570.         End
  571.       Else
  572.         Begin
  573.           J:=0;
  574.           For I:=1 to NbMnem do
  575.             If Id=Mnem[I].Id Then J:=I;
  576.           If J=0 Then Error(3)
  577.           Else
  578.             Begin
  579.               NoReg:=0;Regs[0]:=0;Regs[1]:=0;Regs[2]:=0;
  580.               AdrPas:=1;
  581.               For I:=1 to 3 do
  582.               Begin
  583.                 If Err<>'' Then Exit;
  584.                 Case Mnem[J].Ad[I] Of
  585.                   'r' : LitRegistre;
  586.                   'a' : LitAdresse;
  587.                   'i' : LitImmediat;
  588.                   'b' : LitIndirect;
  589.                 End;
  590.               End;
  591.               If Err<>'' Then Exit;
  592.               Code[Adr]:=Mnem[J].Co*1000+Regs[0]*100+Regs[1]*10+Regs[2];
  593.               Inc(Adr,AdrPas);
  594.             End;
  595.         End;
  596.     End;
  597.   End;
  598. End;
  599.  
  600. Procedure TAssembleur.Passe1;
  601. Var I : Byte;
  602. Begin
  603.   If Etat<>0 Then Exit;
  604.   Repeat UnPas;
  605.   Until Etat<>0;
  606. End;
  607.  
  608. Procedure TAssembleur.Passe2;
  609. Var I : Word;
  610. Begin
  611.   If Etat<>1 Then Exit;
  612.   For I:=0 to Adr-1 do
  613.     If Marque[I] Then
  614.       If Etiq[Code[I]].Ad=0
  615.       Then
  616.         Begin
  617.           Err:=StrError[9]+' '+Etiq[Code[I]].Id;
  618.           Exit;
  619.         End
  620.       Else
  621.         Begin
  622.           Code[I]:=Etiq[Code[I]].Ad-1;
  623.           Marque[I]:=FALSE;
  624.         End;
  625.   Etat:=2;
  626.   EtatStr:='Passe 2 OK';
  627. End;
  628.  
  629. {$ENDIF}
  630.  
  631. {$IFDEF Int}
  632.  
  633. {======================================================================
  634.              Interpréteur et désassembleur avec mode pas à pas
  635.  ======================================================================}
  636.  
  637. Const
  638.   cmIntWDesassemble = 150;
  639.   cmIntWUnPas       = 151;
  640.   cmIntWRun         = 152;
  641.   cmIntWReset       = 153;
  642.  
  643. Type
  644.   TData       = Record
  645.                   Regs : Array[0..3] Of Integer;
  646.                   CO   : Word;
  647.                   InM  : String[60];
  648.                   OutM : String[60];
  649.                 End;
  650.   PInterpret  = ^TInterpret;
  651.   PIntInterior= ^TIntInterior;
  652.   TIntInterior= Object(TScroller)
  653.                   Int : PInterpret;
  654.                   Tpe : Byte;
  655.                   constructor Init(var Bounds: TRect;
  656.                               AHScrollBar,AVScrollBar: PScrollBar;
  657.                               eInt : PInterpret ; eTpe : Byte);
  658.                   Procedure   Draw;      Virtual;
  659.                   Procedure   MoveTo(Ad : Word);
  660.                   Procedure   PileHaut;
  661.                 End;
  662.   TInterpret  = Object(TDialog)
  663.                   LongMem : Word;
  664.                   Mem     : Array[0..MemMax-1] Of Word;
  665.                   Struct  : Array[0..MemMax-1] Of Word;
  666.                   Source  : Array[0..MemMax-1] Of PString;
  667.                   Pile    : Array[0..PilMax-1] Of Word;
  668.                   HautPile: Word;
  669.                   Etiq    : Word;
  670.                   Int     : PIntInterior;
  671.                   Data    : TData;
  672.                   Fin     : Boolean;
  673.                   Desass  : Boolean;
  674.                   Constructor Init(Nom : String);
  675.                   Procedure   Error(n : Byte);
  676.                   Function    VerifieCO : Boolean;
  677.                   Procedure   UnPas;
  678.                   Procedure   Run;
  679.                   Procedure   Reset;
  680.                   Procedure   ProduitListing;
  681.                   Function    MakeInterior(R : TRect; Tpe : Byte) : PIntInterior;
  682.                   Procedure   HandleEvent(Var Event : TEvent); Virtual;
  683.                   Procedure   SizeLimits(Var Min,Max : TPoint); Virtual;
  684.                   Destructor  Done;    Virtual;
  685.                 End;
  686.  
  687. Procedure TIntInterior.PileHaut;
  688. Begin
  689.   If Tpe=2 Then
  690.   Begin
  691.     SetLimit(5,Int^.HautPile);
  692.   End;
  693. End;
  694.  
  695. Procedure TIntInterior.MoveTo(Ad : Word);
  696. Begin
  697.   If Ad>Delta.Y+Size.Y-1 Then ScrollTo(0,Size.Y-Ad-1);
  698. End;
  699.  
  700. constructor TIntInterior.Init(var Bounds: TRect; AHScrollBar,
  701.   AVScrollBar: PScrollBar; eInt : PInterpret ; eTpe : Byte);
  702. Begin
  703.   TScroller.Init(Bounds, AHScrollBar, AVScrollBar);
  704.   Tpe:=eTpe;
  705.   Int:=eInt;
  706.   Options := Options or ofFramed;
  707.   If Tpe=1 Then SetLimit(55,Int^.LongMem)
  708.            Else SetLimit(5,0);
  709. End;
  710.  
  711. Procedure TIntInterior.Draw;
  712. Var I     : Byte;
  713.     B     : TDrawBuffer;
  714.     Color : Byte;
  715.     S     : String;
  716. Begin
  717.   For I:=0 to Size.Y-1 do
  718.   Begin
  719.     S:='';Color:=$70;
  720.     Case Tpe Of
  721.       1 : Begin
  722.             If I+Delta.Y<Int^.LongMem Then S:=Int^.Source[I+Delta.Y]^;
  723.             If (I+Delta.Y=Int^.Data.Co) AND (Not Int^.Fin) Then Color:=$2F;
  724.           End;
  725.       2 : If I+Delta.Y<Int^.HautPile Then Str(Int^.Pile[I+Delta.Y]:5,S);
  726.     End;
  727.     MoveChar(B,' ',Color,Size.X);
  728.     MoveStr(B,Copy(S,Delta.X,Size.X),Color);
  729.     WriteLine(0,I,Size.X,1,B);
  730.   End;
  731. End;
  732.  
  733. Procedure TInterpret.SizeLimits(Var Min,Max : TPoint);
  734. Begin
  735.   Min.X:=39;
  736.   Min.Y:=17;
  737.   Max:=Owner^.Size;
  738. End;
  739.  
  740. Procedure TInterpret.Error(n : Byte);
  741. Begin
  742.   SignaleError(StrError[n]);
  743.   Fin:=TRUE;
  744. End;
  745.  
  746. Function TInterpret.VerifieCO : Boolean;
  747. Var B : Boolean;
  748. Begin
  749.   B:=(Struct[Data.CO] AND 3)<>2;
  750.   If B Then Error(12);
  751.   VerifieCO:=B;
  752. End;
  753.  
  754. Procedure TInterpret.ProduitListing;
  755. Var Adr,AdrPas  : Word;
  756.     I,K,L,CodOp : Byte;
  757.     Temp      : String[50];
  758.     NbRegs      : Byte;
  759.     R           : Array[0..2] Of Byte;
  760.   Function Zeros(A : Word) : String;
  761.   Var S : String;
  762.   Begin
  763.     S[1]:='L';
  764.     S[2]:=Chr(((A DIV 1000 ) MOD 10)+48);
  765.     S[3]:=Chr(((A DIV 100  ) MOD 10)+48);
  766.     S[4]:=Chr(((A DIV 10   ) MOD 10)+48);
  767.     S[5]:=Chr(((A DIV 1    ) MOD 10)+48);
  768.     S[0]:=#5;
  769.     Zeros:=S;
  770.   End;
  771. Begin
  772.   If Desass
  773.   Then
  774.     Begin
  775.       Adr:=0;
  776.       While Adr<LongMem do
  777.       Begin
  778.         AdrPas:=1;
  779.         If Struct[Adr] SHR 2<>0 Then Source[Adr]^:=Zeros(Struct[Adr] SHR 2)+' '
  780.                                 Else Source[Adr]^:='      ';
  781.         Case Struct[Adr] AND 3 Of
  782.           0 : ;
  783.           1,3 : Begin
  784.                 Source[Adr]^:=Source[Adr]^+'DAT  ';
  785.                 Str(Mem[Adr],Temp);
  786.                 Source[Adr]^:=Source[Adr]^+Temp;
  787.               End;
  788.           2 : Begin
  789.                 CodOp:=Mem[Adr] DIV 1000;
  790.                 R[0]:=(Mem[Adr] DIV 100) MOD 10;
  791.                 R[1]:=(Mem[Adr] DIV 10) MOD 10;
  792.                 R[2]:=Mem[Adr] MOD 10;
  793.                 NbRegs:=0;
  794.                 L:=0;
  795.                 For K:=1 to NbMnem do
  796.                   If CodOp=Mnem[K].CO Then L:=K;
  797.                 With Mnem[L] do
  798.                 Begin
  799.                   Source[Adr]^:=Source[Adr]^+Id+'  ';
  800.                   For K:=1 to 3 do
  801.                   Begin
  802.                     Temp:='';
  803.                     Case Ad[K] Of
  804.                       'r' : Begin
  805.                               Temp:='R'+Chr(R[NbRegs]+48)+'      ';
  806.                               Inc(NbRegs);
  807.                             End;
  808.                       'a' : Begin
  809.                               Temp:=Zeros(Struct[Mem[Adr+1]] SHR 2)+'   ';
  810.                               AdrPas:=2;
  811.                             End;
  812.                       'b' : Begin
  813.                               Temp:='['+Zeros(Struct[Mem[Adr+1]] SHR 2)+'] ';
  814.                               AdrPas:=2;
  815.                             End;
  816.                       'i' : Begin
  817.                               Str(Mem[Adr+1],Temp);
  818.                               While Length(Temp)<8 Do Temp:=Temp+' ';
  819.                               AdrPas:=2;
  820.                             End;
  821.                     End;
  822.                     Source[Adr]^:=Source[Adr]^+Temp;
  823.                   End;
  824.                 End;
  825.               End;
  826.         End;
  827.         For I:=1 to AdrPas do
  828.         Begin
  829.           K:=38-Length(Source[Adr]^);
  830.           FillChar(Temp[1],K,' ');
  831.           Temp[0]:=Chr(K);
  832.           Source[Adr]^:=Source[Adr]^+Temp;
  833.           Str(Adr:3,Temp);
  834.           Source[Adr]^:=Source[Adr]^+';'+Temp;
  835.           Str(Mem[Adr]:5,Temp);
  836.           Source[Adr]^:=Source[Adr]^+'   '+Temp;
  837.           Case Struct[Adr] AND 3 Of
  838.             1 : Source[Adr]^:=Source[Adr]^+' A';
  839.             2 : Source[Adr]^:=Source[Adr]^+' I';
  840.             3 : Source[Adr]^:=Source[Adr]^+' D';
  841.           End;
  842.           Inc(Adr);
  843.           Source[Adr]^:='';
  844.         End;
  845.       End;
  846.     End
  847.   Else
  848.     For I:=0 To LongMem-1 do
  849.     Begin
  850.       Str(Mem[I]:5,Source[I]^);
  851.       Str(I:4,Temp);
  852.       Source[I]^:=Source[I]^+'     ;'+Temp;
  853.       Case Struct[I] AND 3 Of
  854.         1 : Source[I]^:=Source[I]^+' A';
  855.         2 : Source[I]^:=Source[I]^+' I';
  856.         3 : Source[I]^:=Source[I]^+' D';
  857.       End;
  858.     End;
  859. End;
  860.  
  861. Function TInterpret.MakeInterior(R : TRect; Tpe : Byte) : PIntInterior;
  862. Var R1        : TRect;
  863.     HScrollBar,
  864.     VScrollBar: PScrollBar;
  865. Begin
  866.   R1.Assign(R.B.X - 1, R.A.Y + 1, R.B.X, R.B.Y - 1);
  867.   VScrollBar := New(PScrollBar, Init(R1));
  868.   VScrollBar^.Options := VScrollBar^.Options or ofPostProcess;
  869.   Insert(VScrollBar);
  870.   If Tpe=1 Then
  871.   Begin
  872.   R1.Assign(R.A.X + 2, R.B.Y - 1, R.B.X - 2, R.B.Y);
  873.     HScrollBar := New(PScrollBar, Init(R1));
  874.     HScrollBar^.Options := HScrollBar^.Options or ofPostProcess;
  875.     Insert(HScrollBar);
  876.   End Else HScrollBar:=NIL;
  877.   R.Grow(-1,-1);
  878.   MakeInterior := New(PIntInterior, Init(R, HScrollBar, VScrollBar,@Self,Tpe));
  879. End;
  880.  
  881. Constructor TInterpret.Init(Nom : String);
  882. Var I    : Byte;
  883.     S    : PDosStream;
  884.     R,R1 : TRect;
  885.     Dir  : DirStr;
  886.     Name : NameStr;
  887.     Ext  : ExtStr;
  888.     Temp : String;
  889.     P    : PView;
  890.   Procedure InstalleStruct(Adr0 : Word);
  891.   Var Adr : Word;
  892.       Fini: Boolean;
  893.       Cod : Byte;
  894.       I   : Word;
  895.     Procedure MetType(A : Word ; T : Byte);
  896.     Begin
  897.       Struct[A]:=(Struct[A] AND (Not 3)) + T;
  898.     End;
  899.     Procedure MetLabel(A : Word);
  900.     Begin
  901.       Struct[A]:=(Struct[A] AND 3) + (Etiq SHL 2);
  902.       Inc(Etiq);
  903.     End;
  904.   Begin
  905.     Adr:=Adr0;
  906.     Fini:=FALSE;
  907.     Repeat
  908.       If Struct[Adr] AND 3<>0 Then
  909.       Begin
  910.         If Struct[Adr] AND 3<>2 Then Error(12);
  911.         Exit;
  912.       End;
  913.       Cod:=Mem[Adr] DIV 1000;
  914.       Case Cod Of
  915.         00,
  916.         10,
  917.         30..36,
  918.         40..41,
  919.         50,51,53,
  920.         60      : MetType(Adr,2);
  921.         13      : Begin
  922.                     MetType(Adr,2);
  923.                     Inc(Adr);
  924.                     MetType(Adr,3);
  925.                   End;
  926.         11..12,
  927.         20..24,
  928.         52      : Begin
  929.                     MetType(Adr,2);
  930.                     Inc(Adr);
  931.                     MetType(Adr,1);
  932.                     MetLabel(Mem[Adr]);
  933.                     If Cod=12 Then
  934.                       If Struct[Mem[Adr]] AND 3 IN [1,2] Then Error(15);
  935.                     If Cod IN [11..12] Then MetType(Mem[Adr],3);
  936.                   End;
  937.       Else
  938.         Error(11);
  939.       End;
  940.       If Cod IN [60,53] Then Fini:=TRUE;
  941.       If Cod IN [21..24,52] Then InstalleStruct(Mem[Adr]);
  942.       If Cod=20 Then Adr:=Mem[Adr]
  943.                 Else Inc(Adr);
  944.     Until Fini;
  945.   End;
  946. Begin
  947.   DeskTop^.GetExtent(R);
  948.   R.Grow(-2,-2);
  949.   FSplit(Nom,Dir,Name,Ext);
  950.   TDialog.Init(R,Name);
  951.   S:=New(PDosStream,Init(Nom,stOpenRead));
  952.   LongMem:=S^.GetSize div 2;
  953.   S^.Read(Mem,LongMem*2);
  954.   Dispose(S,Done);
  955.   Etiq:=1;
  956.   FillChar(Struct,SizeOf(Struct),0);
  957.   For I:=0 to LongMem-1 do GetMem(Source[I],51);
  958.   InstalleStruct(0);
  959.   Desass:=FALSE;
  960.   ProduitListing;
  961.   GetExtent(R); R.Grow(0,-1);
  962.   R.A.X:=2;
  963.   R.B.X:=R.B.X-29;
  964.   R.B.Y:=R.B.Y-3;
  965.   Int:=MakeInterior(R,1);
  966.   Int^.GrowMode:=Int^.GrowMode OR gfGrowHiY OR gfGrowHiX;
  967.   Insert(Int);
  968.   R1.Assign(R.A.X+1,R.A.Y,R.A.X+5,R.A.Y+1);
  969.   Insert(New(PStaticText,Init(R1,'Code')));
  970.   GetExtent(R); R.Grow(0,-1);
  971.   R.A.X:=R.B.X-28;
  972.   R.B.X:=R.B.X-20;
  973.   R.B.Y:=R.B.Y-3;
  974.   Int:=MakeInterior(R,2);
  975.   Int^.GrowMode:=Int^.GrowMode OR gfGrowHiY OR gfGrowLoX OR gfGrowHiX;
  976.   Insert(Int);
  977.   R1.Assign(R.A.X+1,R.A.Y,R.A.X+5,R.A.Y+1);
  978.   P:=New(PStaticText,Init(R1,'Pile'));
  979.   P^.GrowMode:=P^.GrowMode OR gfGrowHiX OR gfGrowLoX;  Insert(P);
  980.   R.A.Y:=R.B.Y-11;
  981.   R.A.X:=R.B.X+3;
  982.   R.B.X:=R.A.X+4;
  983.   R.B.Y:=R.A.Y+1;
  984.   P:=New(PStaticText,Init(R,'R0 ='));
  985.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  986.   R1.Assign(R.A.X+5,R.A.Y,R.A.X+12,R.B.Y);
  987.   P:=New(PInputWord,Init(R1));
  988.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  989.   R.A.Y:=R.B.Y;
  990.   R.B.Y:=R.A.Y+1;
  991.   P:=New(PStaticText,Init(R,'R1 ='));
  992.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  993.   R1.Assign(R.A.X+5,R.A.Y,R.A.X+12,R.B.Y);
  994.   P:=New(PInputWord,Init(R1));
  995.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  996.   R.A.Y:=R.B.Y;
  997.   R.B.Y:=R.A.Y+1;
  998.   P:=New(PStaticText,Init(R,'R2 ='));
  999.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  1000.   R1.Assign(R.A.X+5,R.A.Y,R.A.X+12,R.B.Y);
  1001.   P:=New(PInputWord,Init(R1));
  1002.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  1003.   R.A.Y:=R.B.Y;
  1004.   R.B.Y:=R.A.Y+1;
  1005.   P:=New(PStaticText,Init(R,'R3 ='));
  1006.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  1007.   R1.Assign(R.A.X+5,R.A.Y,R.A.X+12,R.B.Y);
  1008.   P:=New(PInputWord,Init(R1));
  1009.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  1010.   R.A.Y:=R.B.Y;
  1011.   R.B.Y:=R.A.Y+1;
  1012.   P:=New(PStaticText,Init(R,'CO ='));
  1013.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  1014.   R1.Assign(R.A.X+5,R.A.Y,R.A.X+12,R.B.Y);
  1015.   P:=New(PInputWord,Init(R1));
  1016.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  1017.   Dec(R.A.X,2);
  1018.   R.B.X:=R.A.X+15;
  1019.   R.A.Y:=R.B.Y+1;
  1020.   R.B.Y:=R.A.Y+2;
  1021.   P:=New(PButton,Init(R,'Desassemble',cmIntWDesassemble,bfNormal));
  1022.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  1023.   R.A.Y:=R.B.Y;
  1024.   R.B.Y:=R.A.Y+2;
  1025.   P:=New(PButton,Init(R,'Un Pas',cmIntWUnPas,bfNormal));
  1026.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  1027.   R.A.Y:=R.B.Y;
  1028.   R.B.Y:=R.A.Y+2;
  1029.   P:=New(PButton,Init(R,'Run',cmIntWRun,bfNormal));
  1030.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  1031.   R.A.Y:=R.B.Y;
  1032.   R.B.Y:=R.A.Y+2;
  1033.   P:=New(PButton,Init(R,'Reset',cmIntWReset,bfNormal));
  1034.   P^.GrowMode:=P^.GrowMode OR gfGrowAll;  Insert(P);
  1035.   GetExtent(R);
  1036.   R.A.X:=12;
  1037.   Dec(R.B.X,20);
  1038.   R.A.Y:=R.B.Y-4;
  1039.   R.B.Y:=R.A.Y+1;
  1040.   R1.Assign(2,R.A.Y,11,R.B.Y);
  1041.   P:=New(PStaticText,Init(R1,'Entrée : '));
  1042.   P^.GrowMode:=P^.GrowMode OR gfGrowHiY OR gfGrowLoY;  Insert(P);
  1043.   P:=New(PInputLine,Init(R,60));
  1044.   P^.GrowMode:=P^.GrowMode OR gfGrowHiX OR gfGrowHiY OR gfGrowLoY;  Insert(P);
  1045.   R.A.Y:=R.A.Y+2;
  1046.   R.B.Y:=R.B.Y+2;
  1047.   R1.Assign(2,R.A.Y,11,R.B.Y);
  1048.   P:=New(PStaticText,Init(R1,'Sortie : '));
  1049.   P^.GrowMode:=P^.GrowMode OR gfGrowHiY OR gfGrowLoY;  Insert(P);
  1050.   P:=New(PInputLine,Init(R,60));
  1051.   P^.GrowMode:=P^.GrowMode OR gfGrowHiX OR gfGrowHiY OR gfGrowLoY;  Insert(P);
  1052.   Reset;
  1053.   For I:=0 to 3 do Data.Regs[I]:=0;
  1054.   Data.InM:='';
  1055.   Options:=Options OR ofPreProcess;
  1056.   Flags:=Flags OR wfGrow OR wfZoom;
  1057. End;
  1058.  
  1059. Procedure TInterpret.Reset;
  1060. Var I : Byte;
  1061. Begin
  1062.   FillChar(Pile,SizeOf(Pile),0);
  1063.   HautPile:=0;
  1064.   Data.Co:=0;
  1065.   Data.OutM:='';
  1066.   Fin:=FALSE;
  1067.   SetData(Data);
  1068. End;
  1069.  
  1070. Destructor TInterpret.Done;
  1071. Var I : Word;
  1072. Begin
  1073.   For I:=0 To LongMem-1 do FreeMem(Source[I],51);
  1074.   TDialog.Done;
  1075. End;
  1076.  
  1077. Procedure TInterpret.HandleEvent(Var Event : TEvent);
  1078. Begin
  1079.   TDialog.HandleEvent(Event);
  1080.   If Event.What=evCommand Then
  1081.   Begin
  1082.     GetData(Data);
  1083.     Case Event.Command Of
  1084.       cmIntWDesassemble : Begin Desass:=Not Desass; ProduitListing; End;
  1085.       cmIntWRun         : Run;
  1086.       cmIntWUnPas       : UnPas;
  1087.       cmIntWReset       : Reset;
  1088.     Else
  1089.       Exit;
  1090.     End;
  1091.     SetData(Data);
  1092.     Int^.MoveTo(Data.CO);
  1093.     ReDraw;
  1094.     ClearEvent(Event);
  1095.   End;
  1096. End;
  1097.  
  1098. Procedure TInterpret.UnPas;
  1099. Var TypOp : Byte;
  1100.     ExOp  : Byte;
  1101.     R     : Array[0..2] Of Byte;
  1102.     I,J   : Word;
  1103.   Procedure SautConditionnel(Condition : Boolean);
  1104.   Begin
  1105.     Inc(Data.Co);
  1106.     If Condition Then Data.Co:=Mem[Data.Co]-1;
  1107.   End;
  1108.   Procedure Empile(V : Word);
  1109.   Begin
  1110.     If HautPile=PilMax Then Error(13)
  1111.                        Else Begin Pile[HautPile]:=V; Inc(HautPile); End;
  1112.     Int^.PileHaut;
  1113.   End;
  1114.   Function Depile : Word;
  1115.   Begin
  1116.     If HautPile=0 Then Error(14)
  1117.                   Else Begin Dec(HautPile); Depile:=Pile[HautPile]; End;
  1118.     Int^.PileHaut;
  1119.   End;
  1120. Begin
  1121.   If VerifieCO Then Exit;
  1122.   I:=Mem[Data.CO];
  1123.   TypOp:=(I DIV 10000) MOD 10;
  1124.   ExOp:=(I DIV 1000) MOD 10;
  1125.   R[0]:=(I DIV 100) MOD 10;
  1126.   R[1]:=(I DIV 10) MOD 10;
  1127.   R[2]:=I MOD 10;
  1128.   Case TypOp Of
  1129.     1 : Case ExOp Of  { Transferts }
  1130.           0 : Data.Regs[R[0]]:=Data.Regs[R[1]];
  1131.           1 : Begin
  1132.                 Inc(Data.Co);
  1133.                 Mem[Mem[Data.Co]]:=Data.Regs[R[0]];
  1134.                 ProduitListing;
  1135.               End;
  1136.           2 : Begin Inc(Data.Co); Data.Regs[R[0]]:=Mem[Mem[Data.Co]]; End;
  1137.           3 : Begin Inc(Data.Co); Data.Regs[R[0]]:=Mem[Data.Co];      End;
  1138.         End;
  1139.     2 : Case ExOp Of  { Sauts }
  1140.           0 : SautConditionnel(TRUE);
  1141.           1 : SautConditionnel(Data.Regs[R[0]]=0);
  1142.           2 : SautConditionnel(Data.Regs[R[0]]<>0);
  1143.           3 : SautConditionnel(Data.Regs[R[0]]>0);
  1144.           4 : SautConditionnel(Data.Regs[R[0]]>=0);
  1145.         End;
  1146.     3 : Case ExOp Of  { Operation }
  1147.           0 : Data.Regs[R[0]]:=Data.Regs[R[1]]+Data.Regs[R[2]];
  1148.           1 : Data.Regs[R[0]]:=Data.Regs[R[1]]-Data.Regs[R[2]];
  1149.           2 : Data.Regs[R[0]]:=Data.Regs[R[1]]*Data.Regs[R[2]];
  1150.           3 : Data.Regs[R[0]]:=Data.Regs[R[1]] DIV Data.Regs[R[2]];
  1151.           4 : Data.Regs[R[0]]:= - Data.Regs[R[1]];
  1152.           5 : Inc(Data.Regs[R[0]]);
  1153.           6 : Dec(Data.Regs[R[0]]);
  1154.         End;
  1155.     4 : Case ExOp Of  { Entrée Sortie }
  1156.           0 : Begin
  1157.                 If Data.InM='' Then {???};
  1158.                 Data.Regs[0]:=Ord(Data.InM[1]);
  1159.                 Data.InM:=Copy(Data.InM,2,Length(Data.InM)-1);
  1160.               End;
  1161.           1 : Data.OutM:=Data.OutM+Chr(Data.Regs[0]);
  1162.         End;
  1163.     5 : Case ExOp Of  { Gestion pile }
  1164.           0 : Empile(Data.Regs[R[0]]);
  1165.           1 : Data.Regs[R[0]]:=Depile;
  1166.           2 : Begin
  1167.                 Empile(Data.CO+2);
  1168.                 Data.Co:=Mem[Data.Co+1]-1;
  1169.               End;
  1170.           3 : Data.Co:=Depile-1;
  1171.         End;
  1172.     6 : Fin:=TRUE;    { END }
  1173.   End;
  1174.   If Not Fin Then Inc(Data.CO);
  1175. End;
  1176.  
  1177. Procedure TInterpret.Run;
  1178. Begin
  1179.   If VerifieCO Then Exit;
  1180.   Repeat UnPas;
  1181.   Until Fin;
  1182. End;
  1183.  
  1184. {$ENDIF}
  1185.  
  1186. {======================================================================
  1187.                              Application
  1188.  ======================================================================}
  1189.  
  1190. Const
  1191.   cmAbout     = 100;
  1192.   cmHorloge   = 101;
  1193.   cmAssCharge = 102;
  1194.   cmAssSauve  = 103;
  1195.   cmIntCharge = 104;
  1196.   cmIntSauve  = 105;
  1197.  
  1198. Type
  1199.   TMonApp = Object(TApplication)
  1200.               Constructor Init;
  1201.               Procedure   HandleEvent(Var Event : TEvent);   Virtual;
  1202.               Procedure   InitMenuBar;                       Virtual;
  1203.               Procedure   OutOfMemory;                       Virtual;
  1204.               Procedure   AssCharge;
  1205.               Procedure   AssSauve;
  1206.               Procedure   IntCharge;
  1207.               Procedure   Horloge;
  1208.             End;
  1209.  
  1210. Procedure TMonApp.Horloge;
  1211. Var R : TRect;
  1212.     P : PView;
  1213. Begin
  1214. {$IFDEF Hor}
  1215.   P:=Message(DeskTop,evBroadCast,cmClockSearch,nil);
  1216.   If P=NIL
  1217.   Then
  1218.     Begin
  1219.       R.Assign(10,5,40,12);
  1220.       P:=ValidView(New(PClock,Init(R)));
  1221.       If P<>NIL Then DeskTop^.Insert(P);
  1222.     End
  1223.   Else P^.Select;
  1224. {$ENDIF}
  1225. End;
  1226.  
  1227. Procedure TMonApp.OutOfMemory;
  1228. Begin
  1229.   SignaleError('Pas assez de mémoire pour l''opération');
  1230. End;
  1231.  
  1232. Procedure TMonApp.IntCharge;
  1233. {$IFDEF Int}
  1234. Var D        : PFileDialog;
  1235.     FileName : PathStr;
  1236.     I        : PInterpret;
  1237. begin
  1238.   D := PFileDialog(ValidView(New(PFileDialog, Init('*.BIN',
  1239.        'Charge un fichier code','~N~om', fdOkButton, 100))));
  1240.   If D<>Nil Then
  1241.   Begin
  1242.     If Desktop^.ExecView(D) <> cmCancel then
  1243.     Begin
  1244.       D^.GetFileName(FileName);
  1245.       I:=PInterpret(ValidView(New(PInterpret,Init(FileName))));
  1246.       If I<>Nil Then DeskTop^.Insert(I);
  1247.     End;
  1248.     Dispose(D, Done);
  1249.   End;
  1250. {$ELSE}
  1251. Begin
  1252. {$ENDIF}
  1253. End;
  1254.  
  1255. Procedure TMonApp.AssCharge;
  1256. {$IFDEF Ass}
  1257. Var D        : PFileDialog;
  1258.     FileName : PathStr;
  1259.     A        : PAssembleur;
  1260. begin
  1261.   D := PFileDialog(ValidView(New(PFileDialog, Init('*.ASM',
  1262.        'Charge un fichier source','~N~om', fdOkButton, 100))));
  1263.   If D<>Nil Then
  1264.   Begin
  1265.     If Desktop^.ExecView(D) <> cmCancel then
  1266.     Begin
  1267.       D^.GetFileName(FileName);
  1268.       A:=PAssembleur(ValidView(New(PAssembleur,Init(FileName))));
  1269.       If A<>Nil Then DeskTop^.Insert(A);
  1270.     End;
  1271.     Dispose(D, Done);
  1272.   End;
  1273. {$ELSE}
  1274. Begin
  1275. {$ENDIF}
  1276. End;
  1277.  
  1278. Procedure TMonApp.AssSauve;
  1279. {$IFDEF Ass}
  1280. Var D        : PFileDialog;
  1281.     FileName : PathStr;
  1282.     A        : PAssembleur;
  1283. begin
  1284.   A:=Message(DeskTop,evBroadCast,cmIsAssW,nil);
  1285.   D := PFileDialog(ValidView(New(PFileDialog, Init('*.BIN',
  1286.        'Charge un fichier source','~N~om', fdOkButton, 100))));
  1287.   If D<>Nil Then
  1288.   Begin
  1289.     If Desktop^.ExecView(D) <> cmCancel then
  1290.     Begin
  1291.       D^.GetFileName(FileName);
  1292.       A^.Sauve(FileName);
  1293.     End;
  1294.     Dispose(D, Done);
  1295.   End;
  1296. {$ELSE}
  1297. Begin
  1298. {$ENDIF}
  1299. End;
  1300.  
  1301. Procedure TMonApp.InitMenuBar;
  1302. Var R : TRect;
  1303. Begin
  1304.   GetExtent(R);
  1305.   R.B.Y:=R.A.Y+1;
  1306.   MenuBar:=New(PMenuBar,Init(R,NewMenu(
  1307.     NewSubMenu('≡',hcNoContext,NewMenu(
  1308.                  NewItem('~H~orloge...','',0,cmHorloge,hcNoContext,
  1309.                  NewItem('~Q~uitter...','Alt-X',kbAltX,cmQuit,hcNoContext,
  1310.                  nil))),
  1311.     NewSubMenu('~A~ssembleur',hcNoContext,NewMenu(
  1312.                  NewItem('~C~harger source...','',0,cmAssCharge,hcNoContext,
  1313.                  NewItem('~S~auver code...','F3',kbF3,cmAssSauve,hcNoContext,
  1314.                  nil))),
  1315.     NewSubMenu('~I~nterpréteur',hcNoContext,NewMenu(
  1316.                  NewItem('~C~harger code...','',0,cmIntCharge,hcNoContext,
  1317.                  NewItem('~S~auver source...','F3',kbF3,cmIntSauve,hcNoContext,
  1318.                  nil))),
  1319.               nil))))));
  1320. End;
  1321.  
  1322. Constructor TMonApp.Init;
  1323. Begin
  1324.   TApplication.Init;
  1325. End;
  1326.  
  1327. Procedure TMonApp.HandleEvent(Var Event : TEvent);
  1328. Begin
  1329.   TApplication.HandleEvent(Event);
  1330.   If Event.What=evCommand Then
  1331.   Begin
  1332.     Case Event.Command Of
  1333.       cmAssCharge : AssCharge;
  1334.       cmAssSauve  : AssSauve;
  1335.       cmIntCharge : IntCharge;
  1336.       cmHorloge   : Horloge;
  1337.     Else
  1338.       Exit;
  1339.     End;
  1340.     ClearEvent(Event);
  1341.   End;
  1342.   Message(DeskTop,evBroadCast,cmClockUpDate,nil);
  1343. End;
  1344.  
  1345. Var MonApp : TMonApp;
  1346.  
  1347. BEGIN
  1348.   MonApp.Init;
  1349.   MonApp.Run;
  1350.   MonApp.Done;
  1351. END.