{$I ASSEMBLIFY.H}

Implementation

{ ****************
  Lo et Hi 32 bits
  **************** }
Procedure SetHiWord(Var V : LongInt; C : Integer);
Begin
{ LES DI,[BP+@V] }
  InLine($C4/$7E/<V);
{ MOV AX,[BP+@C] }
  InLine($8B/$46/<C);
{ ES:            }
{ MOV [DI+2],AX  }
  InLine($26/$89/$45/$02);
End;

Procedure SetLoWord(Var V : LongInt; C : Integer);
Begin
{ LES DI,[BP+@V] }
  InLine($C4/$7E/<V);
{ MOV AX,[BP+@C] }
  InLine($8B/$46/<C);
{ ES:            }
{ MOV [DI],AX  }
  InLine($26/$89/$05);
End;

Function HiWord(V : LongInt) : Integer;
Begin
{ MOV AX,[BP+@V+2] }
  InLine($8B/$46/<V+2);
{ MOV [BP-2],AX }
  InLine($89/$46/$FE);
End;

Function LoWord(V : LongInt) : Integer;
Begin
{ MOV AX,[BP+@V] }
  InLine($8B/$46/<V);
{ MOV [BP-2],AX }
  InLine($89/$46/$FE);
End;

{ **********
  Assemblage
  ********** }
Var
   YouWrite : Boolean;
   F : Text;

Function GetBPtr : Word;
Begin
  GetBPtr:=$3;
End;

Procedure SetByteCode(P : Pointer; L : Word);
Begin
  Error('FIC : SetByteCode');
End;

Function GetByteCode : Pointer;
Begin
  Error('FIC : GetByteCode');
End;

Procedure PokeB(B : Byte);
Begin
  If Not YouWrite Then Exit;
  Write(F,'DB ');
  FWriteInt(F,B,16);
  Writeln(F,'');
End;

Procedure PokeBAt(I : Word; B : Byte);
Begin
End;

Procedure PokeW(W : Word);
Begin
  If Not YouWrite Then Exit;
  Write(F,'DW ');
  FWriteInt(F,W,16);
  Writeln(F,'');
End;

Procedure PokeWAt(I,W : Word);
Begin
End;

{ Poke la chaŚne avec un skip devant, et renvoie l'offset ds CS }
Procedure PokeStr(A : Word);
Begin
  If Not YouWrite Then Exit;
  Write(F,'STR "');
  FWriteString(F,A);
  Writeln(F,'"');
End;

Function PokeSkippedStr(A : Word) : Word;
Begin
  If Not YouWrite Then Exit;
  Write(F,'STR "');
  FWriteString(F,A);
  Writeln(F,'"');
  PokeSkippedStr:=$3FFF;
End;

Procedure WriteCop(C : COP);
Begin
  Case C Of
    PUSH:  Write(F,'PUSH ');
    POP:   Write(F,'POP ');
    MOV:   Write(F,'MOV ');
    LEA:   Write(F,'LEA ');
    LES:   Write(F,'LES ');
    CMP:   Write(F,'CMP ');
    JZ:    Write(F,'JZ ');
    JNZ:   Write(F,'JNZ ');
    JL:    Write(F,'JL ');
    JLE:   Write(F,'JLE ');
    JG:    Write(F,'JG ');
    JGE:   Write(F,'JGE ');
    JB:    Write(F,'JB ');
    JBE:   Write(F,'JBE ');
    JA:    Write(F,'JA ');
    JAE:   Write(F,'JAE ');
    JMP:   Write(F,'JMP ');
    CAND:  Write(F,'AND ');
    COR:   Write(F,'OR ');
    CXOR:  Write(F,'XOR ');
    CSHL:  Write(F,'SHL ');
    SAL:   Write(F,'SAL ');
    CSHR:  Write(F,'SHR ');
    SAR:   Write(F,'SAR ');
    NCALL: Write(F,'NCALL ');
    FCALL: Write(F,'FCALL ');
    RETN:  Write(F,'RETN ');
    RETF:  Write(F,'RETF ');
    ADD:   Write(F,'ADD ');
    ADC:   Write(F,'ADC ');
    CINC:  Write(F,'INC ');
    CDEC:  Write(F,'DEC ');
    SUB:   Write(F,'SUB ');
    SBB:   Write(F,'SBB ');
    NEG:   Write(F,'NEG ');
    CNOT:  Write(F,'NOT ');
    IMUL:  Write(F,'IMUL ');
    MUL:   Write(F,'MUL ');
    CWD:   Write(F,'CWD');
    CBW:   Write(F,'CBW');
    UDIV:  Write(F,'UDIV ');
    IDIV:
      Begin
        Writeln(F,'CWD');
        Write(F,'IDIV ');
      End;
    XCHG:  Write(F,'XCHG ');
  Else
    Write(F,'<BADCOP> ');
  End;
End;

Var
   RegName : Array[AX..rSS] of String;

Procedure WriteTypedAddress(A : TypedAddress);
Begin
  Case A.C Of
    CS:         Write(F,Abs(A.Value));
    DS,SS,ES:
      Begin
        If A.C=SS Then Write(F,'BP');
        Write(F,'[');
        Case A.M Of
          IndOfs:       Write(F,A.Value);
          IndReg:       Write(F,RegName[A.Value]);
          IndRegOfs:
            Begin
              Write(F,RegName[LoWord(A.Value)]);
              If A.Value>=0 Then Write(F,'+');
              Write(F,HiWord(A.Value));
            End;
        { IndRegReg:    Write(F,RegName[Lo(A.Value)],'+',RegName[Hi(A.Value)]);
          IndRegRegOfs: Write(F,RegName[Lo(A.Value)],'+',
                              RegName[Hi(A.Value)],'+',
                              HiWord(A.Value)
                             )
                             ; }
          Else
            Error('WriteTyped@');
        End;
        Write(F,']');
      End;

    Register:   Write(F,RegName[A.Value]);
    Immediate:  Write(F,A.Value);
    Null:       Write('');
  Else
    Write(F,'<BAD@>');
  End;
End;

Procedure Assemble(C : COP; Var A1,A2 : TypedAddress);
Begin
  If Not YouWrite Then Exit;
  If ByteAddr Then Write(F,'á');
  If ((A1.C=ES) Or (A2.C=ES)) And (C<>LEA) Then Write(F,'ES:');
  WriteCop(C);
  If A1.C<>Null Then
  Begin
    WriteTypedAddress(A1);
    If A2.C<>Null Then
    Begin
      Write(F,',');WriteTypedAddress(A2);
    End;
  End;
  Writeln(F,'');
End;

{ ******
  Labels
  ****** }
Var
   NoCurLab : Word;

Function IsForWard(Var L : TypedAddress) : Boolean;
Begin
  If (L.C<>CS) Or
     ((L.SType^.Nature<>KeySub) And
      (L.SType^.Nature<>KeyDef) And
      (L.SType<>@SymbLabel)
     )
  Then
    Error('IsForWard : bad L');

  IsForWard:=L.Value<0;
End;

Procedure NewLabel(Var R : TypedAddress);
Begin
  R.C:=CS;
  R.Value:=-NoCurLab;
  R.SType:=@SymbLabel;
  Inc(NoCurLab);
End;

{ ************************************************
  Cette procedure affecte le label R au IP actuel,
  et remonte la chaine des jmps lies a ce label.
  ************************************************ }
Procedure PutLabel(Var R : TypedAddress);
Begin
  If Not YouWrite Then Exit;
  Write(F,Abs(R.Value),':');
  Writeln(F,'');
End;

{ **************************************************
  Gestion des tables de symboles des fichiers objets
  ************************************************** }
Procedure PutType(T : TVArrayPtr);
Var
   S : SymbPtr;
Begin
  While IsValTV(Name(T^.Nature)) Do
  Begin
    If Not Nature(T^.Nature)=Symbol Then Error('PutType : Nat(T)=Symb expected');
    Case Name(T^.Nature) Of
      ValTVPtr:
        Write(F,'(',Name(T^.Nature),' ',T^.Size,')');
      ValTVArray:
        Write(F,'(',Name(T^.Nature),' ',T^.Size,' ',T^.NbElems,' ',T^.FirstInd,')');
      Else
        Error('PutType : Bad ValTV');
    End;
    T:=T^.Next;
  End;
  S:=@T^;
  If S^.Addr.C<>CType Then Error('PutType : Type val exp.');
  Write(F,'(',Name(S^.Nature),' ',S^.Addr.Value,')');
End;

Procedure PutSigma(S : SymbPtr);
Begin
  FWriteString(F,S^.Name);
  Write(F,',');
  PutType(@S^.Addr.SType^);
  Write(F,',');
  FWriteInt(F,LoWord(S^.Addr.Value),16);
  Writeln(F,'');
End;

Procedure RecordObjFile(Var H : Header; Name : Word);
Begin
  Writeln(F,'C0=',H.C0);
  Writeln(F,'#CS=',H.SizCode);
  Writeln(F,'Ofs(Start)=',H.OfsStart);
  Writeln(F,'#DS=',H.SizData);
  Writeln(F,'#Imports=',H.SizImports);
  Write(F,'Name=');FWriteString(F,Name);Writeln(F,'');
End;

Var
   SpeedBuf : Array[1..1024] Of Char;

Procedure StartAssemblify(S : String);
Begin
  S:=Concat(S,'.asm');
  Assign(F,S);Rewrite(F);
  SetTextBuf(F,SpeedBuf);
  NoCurLab:=0;
End;

Procedure EndAssemblify;
Begin
  Close(F);
End;

Procedure SaveContextCompilo(Var C : ContextCompilo);
Var
   I : Integer;
Begin
  For I:=AX To rSS Do
    Begin
      If Not RegFree[I] Then C.RegContainsValues[I]:=RegContains[I]^;
      C.RegContains[I]:=RegContains[I];
      C.RegFree[I]:=RegFree[I];
    End
  ;
  YouWrite:=False;
End;

Procedure RestoreContextCompilo(Var C : ContextCompilo);
Var
   I : Integer;
Begin
  For I:=AX To rSS Do
    Begin
      RegFree[I]:=C.RegFree[I];
      RegContains[I]:=C.RegContains[I];
      If Not RegFree[I] Then RegContains[I]^:=C.RegContainsValues[I];
    End
  ;
  YouWrite:=True;
End;

Begin
  YouWrite:=True;
  ByteAddr:=False;
  RegName[AX]:='AX';
  RegName[BX]:='BX';
  RegName[CX]:='CX';
  RegName[DX]:='DX';
  RegName[SP]:='SP';
  RegName[BP]:='BP';
  RegName[SI]:='SI';
  RegName[DI]:='DI';
  RegName[rCS]:='CS';
  RegName[rDS]:='DS';
  RegName[rSS]:='SS';
  RegName[rES]:='ES';
End.
