(* Modul DC-002.INC                                          *)
(* Prozeduren und Funktionen des Codegenerators              *)
(* Vorherige Version einfach ersetzen                        *)

PROCEDURE Gen(x, y, z:INTEGER; Kommentar:str40);
LABEL 99;
CONST s : STRING[10] = '          ';
VAR   i : INTEGER; obj : ObjPtr; BP : Str4;

   FUNCTION MakeHex(s:Str2) : CHAR;
   (* Konversion 2 Character -> CHAR; ohne Fehlercheck !!!  *)
   VAR i , j : INTEGER;
   BEGIN
     i := ORD(s[l]) - 48;
     IF i > 9 THEN i := i - 7;  (* Behandlung von A..F *)
     j := i * 16;  i := ORD(s[2]) - 48;
     IF i > 9 THEN i := i - 7;  (* Behandlung von A..F *)
     MakeHex := CHAR(j + i);
   END (* MakeHex *);

   PROCEDURE WriteCode(OpCode:Str4; Adresse,OpCodeLaenge:INTEGER)
   VAR Code1, Code2, Code3, Code4 : CHAR; s1 : Str2;
   BEGIN  (* WriteCode *)
     IF COM_Gen THEN BEGIN
        Code1 := MakeHex(COPY(OpCode,1,2));
        IF OpCodeLaenge > 1 THEN BEGIN
           IF Length(OpCode) > 2 THEN  (* Auf Verdacht errechnen *)
              Code2 := MakeHex(COPY(OpCode,3,2));
           Code3 := CHAR(LO(Adresse));  (* Low  Byte der Adresse *)
           Code4 := CHAR(HI(Adresse));  (* High Byte der Adresse *)
        END;
        IF OpCodeLaenge = 1 THEN WRITE(COM File,Code1)
        ELSE IF OpCodeLaenge = 2 THEN WRITE(COM File,Code1,Code2)
        ELSE IF OpCodeLaenge = 3 THEN
        (* Faelle: 1) LD HL,0006 entspr. 21 86 OO Hex                *)
        (*            mit elnem Byte OpCode und zwei Byte Daten      *)
        (*         2) LD H,(IX+5) entspr. DD 66 05 Hex               *)
        (*            mit zwei Byte OpCode und einem Byte Daten (05) *)
        (* Unterscheidbar an Laenge des OpCode-Strings:              *)
        IF Length(OpCode) = 2 THEN  (* entspricht Fall 1)            *)
           WRITE(COM_File,Code1,Code3,Code*)
        ELSE BEGIN  (* entspricht Fall 2)                            *)
           WRITE(COM_File,Code1,Code2,Code3);
        END
      ELSE IF OpCodeLaenge = 4 THEN BEGIN
        (* Zwei Byte OpCode und zwei Byte Daten                      *)
        WRITE(COM_File,Code1,Code2,Code3,Code*);
      END;
      MCode_Adresse := MCode_Adresse + OpCodeLaenge;
      END (* IF COM_Gen *)
      IF ASM_Gen THEN WRITE(ASM_File,ASMCode);
   END (* WriteCode *)

   PROCEDURE Setze_ASM_Adresse;
   BEGIN  ASMCode.nr := ASMCode_Adresse;
     ASMCode_Adresse := ASMCode_Adresse + 1;
   END (* Setze_ASM_Adresse *)

BEGIN  (* Gen *)
  IF NOT Noerr THEN GOTO 99;
  s := ''; i := 8;

  WITH ASMCode DO BEGIN
    nr := 0; bc := ''; op1 := ''; op2 := ''; km := '';
  END;

  (* Kleine Optimierung falls Save und Load auf gleiche             *)
  WITH ZCode DO          (* Variable aufeinander folgen             *)
  IF ((bc = 5) OR (bc = 63) AND (ad = z> THEN
     BEGIN x := 8; z := 2; END;    (* Zcode korrigieren             *)

  (* Bearbeitung aller Zwischencodebefehle und Uebersetzung in      *)
  (* (Folgen von) (Z80->Assembler- und Maschinencodebefehle(n).     *)
  (* Das folgende WITH gilt ueber das gesammte CASE..Statement      *)
  WITH ASMCode DO CASE x OF
    0, 1 : BEGIN  (* Konstante auf Stack laden                      *)
             Setze_ASM_Adresse;
             IF x = 1 THEN BEGIN  (* Character, '$' -> H, ch -> L   *)
                z := 256 * ORD('$') + z;
                km := 'Characterkonstante ins Register laden';
             END ELSE km := 'Integerkonstante ins Register laden';
             bc := 'LD  '; op1 := 'HL'; STR(z,s); op2 := s;
             WriteCode('21',z,3);
             Setze_ASM_Adresse;
             bc := 'PUSH'; op1 := 'HL'; op2 := '';
             km := 'und auf Stack schreiben ;
             WriteCode('E5',0,1);
           END;

    2 : BEGIN  (* Arithmetische Operatoren,                          *)
          Setze_ASM_Adresse;    (* z wie bei Call_RTsystem (11)      *)
          i := TPA_Anfang + z;  (* Adresse der RT-Lib berechnen      *)
          bc := 'CALL'; STR(i,s); op1 := s; op2 := '';
          km := 'Arithmetische Operation';
          WriteCode('CD',i,3);
        END;

    3 : BEGIN  (* LoadIntegeVariable-Behandlung                      *)
          (* Grundsaetzlich muss zwischen globalen und lokalen       *)
          (* Variablen unterschieden werden. Moeglich ist dies       *)
          (* durch den Uebergabeparameter y. Es gilt dabei:          *)
          (* - y = 0 : lokale  Variable (IX ist BasePointer)         *)
          (* - y = 1 : globale Variable (IY ist BasePointer)         *)
          Setze_ASM_Adresse;
          bc := 'LD  '; op1 := 'H'; STR(z+1,s);
          IF y = 0 THEN BEGIN
             op2 := '(IX-'+s+')'; BP := 'DD66';
          END ELSE BEGIN
             op2 := '(IY-'+s+')'; BP := 'FD66';
          END;
          km := 'Integervariable';
          WriteCode(BP,255-z,3); z := z + 1;
          Setze_ASM_Adresse;
          bc := 'LD  '; op1 := 'L'; STR(z+1,s);
          IF y = 0 THEN BEGIN
             op2 := '(IX-'+s+')'; BP := 'DD6E';
          END ELSE BEGIN
             op2 := '(IY-'+s+')'; BP := 'FD6E';
          END;
          km := 'von Speicherplatz 1aden und';
          WriteCode(BP,255-z,3);
          (* Variablenwert auf den Operationsstack bringen           *)
          Setze_ASM_Adresse;
          bc := 'PUSH'; op1 := 'HL'; op2 := '';
          km := 'auf Stack schreiben';
          WriteCode('E5',0,1); z := z - 1;
        END;

    4 : BEGIN  (* LoadCharacterUariable-Behandlung                   *)
          (* Fallunterscheidungen wie bei LoadINTEGER.               *)
          Setze_ASM_Adresse;
          bc := 'LD  '; op1 := 'H'; STR(z+1,s);
          IF y = 0 THEN BEGIN
             op2 := '(IX-'+s+')'; BP := 'DD66';
          END ELSE BEGIN
             op2 := '(IY-'+s+')'; BP := 'FD66';
          END;
          km := 'Charactervariable';
          WriteCode(BP,255-z,3); z := z + 1;
          Setze_ASM_Adresse;
          bc := 'LD  '; op1 := 'L';STR(z+1,s); km := 'und $';
          IF y = 0 THEN BEGIN
             op2 := '(lX-'+s+')'; BP := 'DD6E';
          END ELSE BEGIN
             op2 := '(IY-'+s+')'; BP := 'FD6E';
          END;
          WriteCode(BP,255-z,3);
          (* Variablenwert auf den Operationsstack bringen           *)
          Setze_ASM_Adresse;
          bc := 'PUSH'; op1 := 'HL'; op2 := '';
          km := 'auf Stack schreiben';
          WriteCode('E5',0,1); z := z - 1;
        END;

    5 : BEGIN  (* SaveIntegervariable-Behandlung                     *)
          (* Variablenwert vom Stack holen                           *)
          Setze_ASM_Adresse;
          bc := 'POP '; op1 := 'HL'; op2 := '';
          km := 'Integer vom Stack holen';
          Write Code('E1',0,1);
          (* Variablenwert auf seinen Speicherplatz im               *)
          (* Aktivierungs-Record schreiben                           *)
          Setze_ASM_Adresse;
          bc := 'LD  '; STR(z+1,s);
          IF y = 0 THEN BEGIN
             op1 := '(IX-'+s+')'; BP := 'DD74';
          END ELSE BEGIN
             op1 := '(IY-'+s+')'; BP := 'FD74';
          END;
          op2 := 'H'; km := 'und auf';
          WriteCode(BP,255-z,3); z := z + 1;
          Setze_ASM_Adresse;
          bc := 'LD  '; STR(z+1,s);
          IF y = 0 THEN BEGIN
             op1 := '(IX-'+s+')'; BP := 'DD75';
          END ELSE BEGIN
             op1 := '(IY-'+s+')'; BP := 'FD75';
          END;
          op2 := 'L'; km := 'Speicherplatz schreiben';
          WriteCode(BP,255-z,3); z := z - 1;
        END;

    6 : BEGIN  (* SaveCharacterVariable-Behandlung                   *)
          (* Variablenwert vom Stack holen                           *)
          Setze_ASM_Adresse;
          bc := 'POP '; op1 := 'HL'; op2 := '';
          km := 'Character vom Stack holen';
          WriteCode('E1',8,1);
          (* Variablenwert auf seinen Speicherplatz im               *)
          (* Aktivierungs-Record schreiben                           *)
          Setze_ASM_Adresse;
          bc := 'LD  '; STR(z+1,s);
          IF y = 0 THEN BEGIN
             op1 := '(IX-'+s+')'; BP := 'DD74';
          END ELSE BEGIN
             op2 := '(IY-'+s+')'; BP := 'FD74';
          END;
          op2 := 'H'; km := 'und auf';
          WriteCode(BP,255-z,3); z := z + 1;
          Setze_ASM_Adresse;
          bc := 'LD  '; STR(z+1,s); op1 := '(lX-'+s+')';
          IF y = 0 THEN BEGIN
             op1 := '(IX-'+s+')'; BP := 'DD75';
          END ELSE BEGIN
             op1 := '(IY-'+s+')'; BP := 'FD75';
          END;
          op2 := 'L'; km := 'Spaicherplatz schreiben';
          WriteCode(BP,255-z,3); z := z - 1;
        END;

    7 : BEGIN  (* Call-Behandlung, z enthaelt UP-Adresse             *)
          (* Unterscheidung zwischen Hauptprogramm- und Prozedur-    *)
          (* aufruf ist noetig. Die variable z enthaelt je nach      *)
          (* Aufruf die Adresse des Hauptprogramms oder (Dank        *)
          (* TURBO-PASCAL) den Zeiger auf das Symboltabellenele-     *)
          (* ment mit dem Prozedurnamen.                             *)
          Setze_ASM Adresse;
          IF y > 0 THEN BEGIN  (* Unterprogramma, UP-Adresse         *)
             Obj := ptr(z);    (* holen                              *)
             i := Obj^.ASM_Startadresse; STR(i,s);
             j := Obj^.COM_Startadresse;
             z := Obj^.ZWC_Startadresse;
             km := 'Unterprogrammaufruf';
          END ELSE BEGIN  (* Hauptprogrammaufruf, HP-Adresse         *)
             i := ASMCode_0ffset + z +5; STR(i,s);
             i := MCode_Adresse + 6;
             km := 'Hauptprogrammaufruf';
          END;
          bc := 'CALL'; op1 := s; op2 :=
          WriteCode('CD',i,3);
        END;

    8 : BEGIN  (* DECR_SP-Behandlung                                 *)
          (* Stackpointer um <z> erniedrigen                         *)
          bc := 'DEC '; op1 := 'SP'; op2 := '';
          km := 'Stackpointer decrementieren';
          FOR i := 1 TO z DO BEGIN
              Setze_ASM_Adresse:
              WriteCode('3B',0,1);
          END;
        END;

    9 : BEGIN  (* Unbedingter Sprung: JUMP-Behandlung                *)
          Setze_ASM_Adresse;
          bc := 'JP  '; op1 := '0'; op2 := '';
          km := 'unbedingter Sprung';
          Write Code ('C3',0,3);
        END;

   10 : BEGIN  (* Bedingter Sprung: JUMP_COND-Behandlung             *)
          Setze_ASM_Adresse;
          bc := 'POP '; op1 := 'HL'; op2 := '';
          km := 'logisches Ergibnis nach HL,';
          WriteCode('E1',8,1);
          Setze_ASM_Adresse;
          bc := 'LD  '; op1 := 'A'; op2 := 'H';
          km := 'dann in AKKU,';
          WriteCode('7C',8,1);
          Setze_ASM_Adresse;
          bc := 'OR  '; op1 := 'A'; op2 := '';
          km := 'FLAGs setzen,';
          WriteCode('B7',0,1);
          Setze_ASM_Adresse;
          bc := 'JP  '; op1 := 'Z'; op2 := '';
          km := 'Sprung, falls AKKU = 0';
          WriteCode('CA',0,3);
        END;

   11 : BEGIN  ( Call RunTimeSystem Behandlung, z enthaelt die       *)
          (* Adresse des RTS-Vektors der gewuenschten Funktion       *)
          Setze_ASM_Adresse;
          bc := 'CALL'; STR(TPA_Anfang+z,s);
          op1 := s; op2 := ''; km := 'RTS-Aufruf';
          WriteCode('CD',TPA Anf ang+z,3);
        END;

   12 : BEGIN  (* RETURN-Behandlung: Alten Basepointer vom           *)
          Setze_ASM_Adresse;  (* Stack holen                         *)
          bc := 'LD  '; op1 := 'SP'; op2 := 'IX';
          km := 'alten BasePointer vom Stack holen';
          WriteCode('DDF9',0,2);
          Setze_ASM_Adresse;
          bc := 'DEC '; op1 := 'SP'; op2 := '';
          km := 'Stackpointer decrementieren';
          WriteCode('3B',0,1);
          Setze_ASM_Adresse;
          bc := 'POP '; op1 := 'IX'; op2 := '';
          km := 'alten BasePointer vom Stack holen';
          WriteCode('DDE1',0,2);
          Setze_ASM_Adresse;
          bc := 'RET '; op1 := ''; op2 := '';
          km := 'Return vom Unterprogramm';
          IF Level = 0 THEN km := 'Return zum Hauptprogramm';
          WriteCode('C9',0,1);
        END;

   13 : BEGIN  (* Bei Up-Aufruf Basepointer (= IX-Register)          *)
          (* sichern und mit dem Wert von SP - 1 laden               *)
          Setze_ASM_Adresse;
          i := MCode_Offset - 2;
          bc := 'LD  '; STR(i,s); op1 := '('+s+')'; op2 := 'SP';
          km := 'StackPointer zwischenspeichern';
          WriteCode('ED73',i,4);
          Setze_ASM_Adresse;
          bc := 'PUSH'; op1 := 'IX'; op2 := '';
          km := 'BasePointer auf Stack schreiben';
          WriteCode('DDE5',0,2);
          Setze_ASM_Adresse;
          bc := 'LD  '; op1 := 'IX'; op2 := '('+s+')';
          km := 'BasePointer von Zwischenspeicher lesen';
          WriteCode('DD2A',i,4);
          Setze_ASM_Adresse;
          bc := 'DEC ' ; op1 := 'IX'; op2 := ''; km := '';
          WriteCode('DD2B',0,2);
        END;

   14 : BEGIN  (* Stack- und BasePointer bei Programmbeginn          *)
          Setze_ASM_Adresse;  (* initialisieren                      *)
          bc := 'LD  '; op1 := 'SP'; op2 := '(0006)';
          km := 'StackPointer auf';
          WriteCode('ED78',6,4);
          Setze_ASM_Adresse;
          bc := 'LD  '; op1 := 'IY';
          op2 := '(0006)'; km := 'die BasePointer fuer globale';
          WriteCode('FD2A',6,4);
          bc := 'DEC '; op1 := 'IY'; op2 := '';
          km := '';  (* IY wegen Ret.Adr. des HP 3x DEC              *)
          FOR i := 1 TO 3 DO BEGIN
              Setze_ASM_Adresse;
              WriteCode('FD2B',0,2);
          END;
          Setze_ASM_Adresse;
          bc := 'LD  '; op1 := 'IX';
          op2 := '(0006)'; km := 'und lokale Varlable ebenso';
          Wr1teCode('DD2A',6,4);
        END;
  END (* CASE x OF ... *);

  (* Neuen Zwischencode in ZCODE merken und wegschreiben             *)
  WITH ZCode DO BEGIN nr := ZCode_Adresse;
    bc := x; lv := y; ad := z; km := Kommentar;
  END;
  IF ZWC_Gen THEN WRITE(ZWC_File,ZCode);
  ZCode_Adresse := ZCode_Adresse + 1;
99:
END (* Gen *);


(* --------------------------------------------------------- *)
(* Diese Prozeduren m}ssen in DC-003.INC                     *)
(* eingesetzt werden                                         *)
(* --------------------------------------------------------- *)

PROCEDURE PatchASMFile;
VAR ASMCode2 : ASM_Instruction; i,j : INTEGER;
BEGIN
  WRITELN; WRITELN('Assemblercode-File...');
  RESET(ASM_File); i := 1;
  REPEAT
    WITH ASMCode2 DO WITH PatchFeld[i] DO BEGIN
      j := A_Adresse - ASMCode_0ffset;
      SEEK(ASM_File,j); READ(ASM_File,ASMCode2);
      IF JPC THEN STR(A_Patch,Op2) ELSE STR(A_Patch,Opl);
      SEEK(ASM_File,j); WRITE(ASM_File,ASMCode2);
      WRITELN('Patch Nr: ', i:2,' Adresse:',A_Adresse:5,
               ' Patch: ',A_Patch:5,'     SatzNr: ',j:3);
    END;
    i := i + 1;
  UNTIL i = ipatch;
END (* PatchASMFile *);

PROCEDURE PatchCOMFile;
TYPE Puffer = ARRAY[8..127] OF BYTE;
VAR Sektorpuffer : Puffer; Sektor, pos, i, j : INTEGER;
    CMD          : FILE;
BEGIN
  WRITELN; WRITELN('Maschinencode-File...');
  FOR i := O TO 127 DO SektorPuffer[i] := 0;
  CLOSE(COM_File);
  ASSIGN(CMD,ProgrammName+'.COM'); RESET(CMD);
  WRITELN('Dateigr|~e = ',FILESIZE(CMD):3,' CP/M Sektoren');
  FOR i := 1 TO ipatch - 1 DO WITH PatchFeld[i] DO BEGIN
      j := M_Adresse - TPA_Anfang;  (* TPA-Anfang = 0100H            *)
      Sektor := j DIV 128; pos := j MOD 128;
      SEEK(CMD,Sektor); BLOCKREAD(CMD,Sektorpuffer,1);
      Sektorpuffer[pos]   := BYTE(LO(M_Patch));
      Sektorpuffer[pos+1] := BYTE(HI(M_Patch));
      SEEK(CMD,Sektor); BLOCKWRITE(CMD,Sektorpuffer,1);
      WRITELN('Patch Nr: ',i:2,'   Adresse:',M_Adresse:5,
              '   Patch: ',M_Patch:5,'   Sektor: ',Sektor(3);
  END;
  CLOSE(CMD); Ist_Offen(COM) := FALSE;
END (* PatchCOMFile *);