{$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;

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

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

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

Procedure PokeB(B : Byte);
Begin
  If Not YouWrite Then Exit;
  Write('#');
  WriteInt(B,16);
  WriteCarriage;
End;

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

Procedure PokeW(W : Word);
Begin
  If Not YouWrite Then Exit;
  Write('#');
  WriteInt(W,16);
  WriteCarriage;
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('STR "');
  WriteString(A);
  Write('"');
  WriteCarriage;
End;

Function PokeSkippedStr(A : Word) : Word;
Begin
  If Not YouWrite Then Exit;
  Write('STR "');
  WriteString(A);
  Write('"');
  WriteCarriage;
  PokeSkippedStr:=$3FFF;
End;

Procedure WriteS(S : String);
Begin
  Write(S,' ');
End;

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

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

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

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

Procedure Assemble(C : COP; Var A1,A2 : TypedAddress);
Begin
  If Not YouWrite Then Exit;
  If ByteAddr Then Write('á');
  If ((A1.C=ES) Or (A2.C=ES)) And (C<>LEA) Then Write('ES:');
  WriteCop(C);
  If A1.C<>Null Then
  Begin
    WriteTypedAddress(A1);
    If A2.C<>Null Then
    Begin
      Write(',');WriteTypedAddress(A2);
    End;
  End;
  WriteCarriage;
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(Abs(R.Value),':');
  WriteCarriage;
End;

{ **************************************************
  Gestion des tables de symboles des fichiers objets
  ************************************************** }
Procedure PutType(T : TVArrayPtr);
Var
   S : SymbPtr;
   B : BoxPtr;
Begin
  If (T^.Nature=KeyWord Or KeySub) Or (T^.Nature=KeyWord Or KeyDef) Then
    Begin
    { ********************************************************
      REM : Aucune v‚rif., bikoze le proto a d‚j… ‚t‚ formatt‚
      ******************************************************** }
    { Putter le tag }
      Write('(');
      If T^.Nature=KeyWord Or KeySub Then Write(ValTVSub)
                                     Else Write(ValTVDef);
      Write(')');
      B:=BoxPtr(T);

    { Si Def, putter Type(Result) }
      If T^.Nature=KeyWord Or KeyDef Then PutType(TVArrayPtr(B^.Droite^.Droite));

    { Putter le type des parms }
      If B^.Gauche^.Nature=Operator Or OpPouvr Then
        Begin
          B:=B^.Gauche^.Droite;
          While B^.Nature=Operator Or OpVirg Do
          Begin
            PutType(TVArrayPtr(B^.Droite^.Droite));
            B:=B^.Gauche;
          End;
          PutType(TVArrayPtr(B^.Droite));
        End;
    End
  Else
    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('(',Name(T^.Nature),' ',T^.Size,')');
          ValTVArray:
            Write('(',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('(',Name(S^.Nature),' ',S^.Addr.Value,')');
    End;
End;

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

Procedure RecordObjFile(Var H : Header; Name : Word);
Var
   C : ConsPtr;
Begin
{ Header }
  Writeln('C0=',H.C0);
  Writeln('#CS=',H.SizCode);
  Writeln('Ofs(Start)=',H.OfsStart);
  Writeln('#DS=',H.SizData);
  Writeln('#Imports=',H.SizImports);
  Write('Name=');WriteString(Name);Writeln;
{ Imports }
  While Imports<>Nil Do
  Begin
    C:=ConsPtr(Imports^.Car);
    Imports:=Imports^.Cdr;
  { Nom du module import‚ }
    WriteString(SymbPtr(C^.Car)^.Name);
  { #Sigmas }
    Write(';????');
    Writeln;
    C:=C^.Cdr;
  { Les sigmas }
    While C<>Nil Do
    Begin
      If Word(HiWord(C^.Car^.Addr.Value))<>$FFFF Then
      Begin
        Write('  ');
        PutSigma(C^.Car);
      End;
      C:=C^.Cdr;
    End;
  End;
End;

Procedure StartAssemblify(S : String);
Begin
  NoCurLab:=1;
End;

Procedure EndAssemblify;
Begin
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.
