PROGRAM REASSEMBLER_8085;
{$X+}

uses geminit,gem,tos,dos;

(* Programm zur Resassemblierung von INTEL 8080/85 Bin„rdateien *)
(* Jens Schulz, Rosenstraže 5, D-25368 Kiebitzreihe             *)                               
(* Programmiert in PurePascal 1.1                               *)
(* Freeware 7/1994                                              *)

CONST  
     DISASM85 =   0; (* Menuebaum *)
     SHOWINFO =   9; (* STRING in Baum DISASM85 *)
     LOADCODE =  18; (* STRING in Baum DISASM85 *)
     SETADR   =  20; (* STRING in Baum DISASM85 *)
     JUMPADR  =  21; (* STRING in Baum DISASM85 *)
     ADRCODE  =  22; (* STRING in Baum DISASM85 *)
     DISASM   =  24; (* STRING in Baum DISASM85 *)
     QUIT     =  26; (* STRING in Baum DISASM85 *)
     SET8080  =  28; (* STRING in Baum DISASM85 *)
     SET8085  =  29; (* STRING in Baum DISASM85 *)
     DISPOUT  =  31; (* STRING in Baum DISASM85 *)
     PRTOUT   =  32; (* STRING in Baum DISASM85 *)
     FILEOUT  =  33; (* STRING in Baum DISASM85 *)
     PARAM_S  =  35; (* STRING in Baum DISASM85 *)
     LABLOAD  =  37; (* STRING in Baum DISASM85 *)
     LABSAVE  =  38; (* STRING in Baum DISASM85 *)
     LABCLEAR =  40; (* STRING in Baum DISASM85 *)

     INFOBOX  =   1; (* Formular/Dialog *)
     EXITINFO =  15; (* BUTTON in Baum INFOBOX *)

     SETSTART =   2; (* Formular/Dialog *)
     STARTADR =   4; (* FTEXT in Baum SETSTART *)
     FILEOFFSET = 5; (* FTEXT in Baum SETSTART *)
     ENDADR   =   6; (* FTEXT in Baum SETSTART *)

     JUMP     =   5; (* BUTTON in Baum JMPADDR *)
     JMPADDR  =   3; (* Formular/Dialog *)
     JADDRESS =   4; (* FTEXT in Baum JMPADDR *)

     Resourcefile = 'REASS_85.RSC';               (* Resource-Name       *)
     Maxram       = 8192;                         (* max. 8 KB Code      *)
		     
TYPE STRG50  = String[50];                        (* Befehlsstring       *)
     Hexa    = String[4];                         (* Hex-string          *)
     DirStr  = String[105];                       (* Datei-Angaben       *)
     NameStr = String[8];
     ExtStr  = String[4];
     Pfad    = String[128];     
     GRECT   = record                             (* fr RC_INTERSECT    *)
					g_x,g_y,g_w,g_h: integer;
	   END; 

	   Reasmline = record                           (* Befehlszeile        *)
	      Befehl : STRG50;
	      Adr    : WORD;
	   END;

     Paramdata = record
        starta : STRING[4];
        starto : STRING[4];
        fileoff: STRING[4];
        labelf : boolean;
        showad : byte;
        mode_85: byte;
     END; 

VAR 

     Disasmline   : STRG50;                        (* Befehlzeile        *)
     M            : ARRAY[0..255] OF String[12];   (* Mnemonics          *)
     Codefield    : ARRAY[0..MAXRAM] OF BYTE;      (* Feld fr Code      *)
     Labelfield   : ARRAY[0..65535] OF BYTE;       (* Labelmarkierung    *)
     Disasmfield  : ARRAY[0..MAXRAM] OF Reasmline; (* Befehlsfeld        *)
     proztype     : Hexa;
     Codefile     : FILE OF BYTE;   
 
     ap_id, error : integer;          (* GEM-Idnr.                       *)
     tree,mtree   : pointer;          (* Zeiger auf Formulare, Men      *)
	   work_in      :	workin_array;     (* GEM-Arrays                      *)
	   work_out     :	workout_array;
	   
     psrcMFDB, pdesMFDB : MFDB;       (* MFDB-Records fr VDI 109        *)
     scrnMFDB           : MFDB;       (* MFDB-Records Screen und Buffer  *)
     
     startlen     : word;             (* L„nge des reasm. Codes    *)
     d_nr         : integer;          (* Befehlszeilen-Z„hler      *)
     act_d_nr     : integer;          (* Aktuelle Startzeile       *)
     number_lines : word;             (* Anzahl Zeilen im Fenster  *)
	   Codestart    : word;             (* ORG-Adresse               *)
	   Filelength   : word;             (* Gr”že der Bin„rdatei      *)
	   file_offset  : word;             (* Offset vom Dateianfang    *)
	   
	   whandle      :	integer;	        (* Window-Handle             *)
	   max_x,max_y  :	integer;	        (* gr”žte x bzw y Koordinate *)
	   x,y,w,h      :	integer;	        (* Fenstergr”že              *)
     button       : integer;          (* Alert-Button              *)
     key          : integer;          (* Event-Taste               *)
     nachr        : integer;          (* Event-Ergebnis            *)
     typ_nachricht: integer;          (* Event-Art                 *)
     planes       : integer;          (* Bitplanes                 *)
     show_mode    : byte;             (* Adresseneinblendung       *)
     mode85       : byte;             (* 8080/85 CPU-Typ           *)
	   path         : String;           (* Pfadname                  *)
	   title        :	String[60];     	(* Titelzeile fr Fenster    *)
	   winfo        : String[60];       (* Infozeile fr Fenster     *)
     lab_clr      : boolean;          (* Label autom. l”schen      *)
     ENDE         : boolean;          (* Abbruch per Closer        *)
          
(****************** Proceduren / Funktionen **************************)
                       
function max(a,b:integer):integer;	
(*Maximum zweier Integerwerte ermitteln*)

BEGIN
	if a>b then max:=a else max:=b
END;

function min(a,b:integer):integer;	

(*Minimum zweier Integerwerte ermitteln*)
BEGIN
	if a<b then min:=a else min:=b
END;

function hiword(wert:pointer):word;	(*Highword eines Pointers ermitteln*)
BEGIN
	hiword:=longint(wert) div 65536;
END;

function loword(wert:pointer):word;	(*Lowword eines Pointers ermitteln*)
BEGIN
	loword:=longint(wert) mod 65536;
END;

procedure mouse_on;                        (* Maus an *)
BEGIN
    graf_mouse( M_ON, NIL );
END;

procedure mouse_off;                       (* Maus aus *)
BEGIN
    graf_mouse( M_OFF, NIL );
END;

(********************** Anzahl Bitplanes holen *************************)

FUNCTION get_bitplanes:integer;  (* Stelt die Anzahl der Bitplanes fest *)

VAR testout:Workout_array;

BEGIN
  vq_extnd(vdiHandle,1,testout);
  get_bitplanes := testout[4];    (* Bitplaneanzahl steht im 4. Feld *)
END;

(************************** Dialogbehandlung *****************************)

FUNCTION get_obj_state(t : aestreeptr; o : integer) : integer;
BEGIN
	(* Ermittel Status eines Objektes *)
	get_obj_state:=t^[o].ob_state;
END;

PROCEDURE set_obj_state(t : aestreeptr; o, s : integer);
BEGIN
	(* Žndert Status eines Objektes *)
	t^[o].ob_state:=s;
END;

(********************** Dialog aufrufen **********************************)

FUNCTION hndl_form(obj: integer) : integer;

	(* Stellt Dialogbox dar und gibt den gedrckten Knopf zurck.*)

VAR	answer  : integer;
		x, y, w, h : integer;

	PROCEDURE hide_form(obj:integer);
	(* L”scht Formular vom Bildschirm *)
	BEGIN
		form_center(tree, x, y, w, h);
		form_dial(FMD_FINISH, x, y, w, h, x, y, w, h);
	END;

	PROCEDURE show_form(obj:integer);
	(* Zeichnet Formular *)
	BEGIN
		form_center(tree, x, y, w, h);
		form_dial(FMD_START, x, y, w, h, x, y, w, h);
		objc_draw(tree, 0, max_depth, x, y, w, h);
	END;

BEGIN
	rsrc_gaddr(R_TREE, obj, tree);   (* Adresse des Formulars ermitteln *)
	graf_mouse( M_OFF, NIL );        (* Maus vor Zeichnen ausschalten   *)
	show_form(obj); 
	graf_mouse( M_ON, NIL );         (* Maus wieder einschalten         *)
	answer := form_do(tree, 0);      (* Dialog dem GEM berlassen       *)
	hide_form(obj);                  (* weg mit der Box                 *)
	                                 (* Exit-Button wieder deselekt.    *)
	set_obj_state(tree,answer,get_obj_state(tree, answer) and (not selected));
	hndl_form:=answer;	
END;

(*************************** 16-bit Hex-Adresse erzeugen ****************)

PROCEDURE Makehexadr(VAR hexvalue:Hexa;VAR PC:word);

{Hexadresse als String erzeugen}
VAR ZwischenPC:word;
    DivPC     :word;
    Zw1,Zw2,i :word;

BEGIN
  ZwischenPC := PC;
  DivPC := 12;
  FOR i :=1 TO 4 DO
  BEGIN
    Zw1 := ZwischenPC shr DivPC;
    Zw2 := ZwischenPC - (Zw1 shl DivPC);
    DivPC := DivPC - 4;
    IF zw1 <= 9 THEN
    BEGIN
      hexvalue[i] := chr(Zw1+48);
    END
    ELSE
    BEGIN
      hexvalue[i] := chr(Zw1+55);
    END;
    ZwischenPC := Zw2;
  END;
  hexvalue[0] := chr(4);
END;

(******************* Label-Routine fr Reassembler *********************)

Procedure Set_Label(i:integer);   (* Setzt Label ein *)

VAR hexvalue:Hexa;

BEGIN
	IF Labelfield[Disasmfield[i].adr] = 1 THEN
	BEGIN
	   IF show_mode = 1 THEN
	   BEGIN
       Disasmfield[i].befehl[11] := 'L';
       Disasmfield[i].befehl[12] := Disasmfield[i].befehl[3];
       Disasmfield[i].befehl[13] := Disasmfield[i].befehl[4];
       Disasmfield[i].befehl[14] := Disasmfield[i].befehl[5];
       Disasmfield[i].befehl[15] := Disasmfield[i].befehl[6];
       Disasmfield[i].befehl[16] := ':';
     END
     ELSE
     BEGIN
       Makehexadr(hexvalue,Disasmfield[i].adr);
       Disasmfield[i].befehl[2] := 'L';
       Disasmfield[i].befehl[3] := hexvalue[1];
       Disasmfield[i].befehl[4] := hexvalue[2];
       Disasmfield[i].befehl[5] := hexvalue[3];
       Disasmfield[i].befehl[6] := hexvalue[4];
       Disasmfield[i].befehl[7] := ':';
     END;
  END;
END;  

(**********************************************************************)

procedure set_label_color(i:integer);   (* Label rot drucken    *)
                                        (* Absolutziele schwarz *)
BEGIN
  CASE Labelfield[Disasmfield[i].adr] OF
    0: vst_color(vdiHandle,Blue);  
    1: vst_color(vdiHandle,Red);
    2: vst_color(vdiHandle,Black);  
	END;       
END;

(*************************** MFDB VDI 109 definieren ******************)

procedure Set_MFDB; (* Setzen der MFDB-Bl”cke fr VDI 109 *)

VAR xw,yw,bw,hw : integer;

BEGIN
  wind_get(0,WF_WORKXYWH,xw,yw,bw,hw);    (* Bildgr”že holen *)
	scrnMFDB.fd_addr := NIL;                (* Bildschirm-MFDB *)
	scrnMFDB.fd_w := bw;
	scrnMFDB.fd_h := hw;
	scrnMFDB.fd_wdwidth := bw shr 4;
	scrnMFDB.fd_stand := 0;
	scrnMFDB.fd_nplanes:= planes;     (* Farbtiefe in Planes *)
END;

(************************* Fensterteile restaurieren ****************)

Procedure restore_window(clip:Array_4);  (* Restaurieren des Fensterinhaltes *)

VAR xw,yw,bw,hw,i,start_x,start_y: INTEGER;
    pxyarray   : ARRAY_8;
    
BEGIN
	wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);
	i := act_d_nr;
	start_x := xw +16;
	start_y := yw + 16;
	WHILE (i <= d_nr) and (start_y <= yw + hw) DO  (* Befehle drucken *)
  BEGIN
     Set_label_color(i);
     v_gtext(vdiHandle,start_x,start_y,Disasmfield[i].befehl);
     inc(i);
     start_y := start_y + 16;
  END;  
END;

(*************************** Fenster s„ubern ***************************)

PROCEDURE Clear_Window;

VAR xw, yw, bw, hw : integer;
    pxyarray : ARRAY_4;
    
BEGIN
    wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw); (* Arbeitsfl„che holen *)
    vsf_color(vdiHandle,White);
    vsf_interior(vdiHandle,FIS_SOLID);
    vsf_perimeter(vdiHandle,0);
    pxyarray[0] := xw;
		pxyarray[1] := yw;
		pxyarray[2] := xw+bw-1;
		pxyarray[3] := yw+hw-1;
    mouse_off;
    wind_update(BEG_UPDATE);
    v_bar(vdiHandle,pxyarray);                 (* Fenster weiž fllen *)
    wind_update(END_UPDATE);
    mouse_on;  
END;

(**************************** Fenster ”ffnen ***************************)

procedure open_window;	(*Fenster ”ffnen*)

var	wx,wy,wb,wh : integer;
    
BEGIN
	  wind_get(0,WF_WORKXYWH,	wx, wy, wb, wh);   (* Gr”že Bildschirm in Pixel *)
	  max_x := wb;
	  max_y := wh;
		whandle:=wind_create(NAME or CLOSER or MOVER or VSLIDE or INFO or
		                      UPARROW or DNARROW or SIZER ,((wb-400) div 2),
		                      0,400,max_y);
		if whandle<=0 then
 			 exit;
		title :=' Reassembler INTEL 8080/85 '#0;
		winfo :='   Adresse  Label   Code      Mnemonics'#0;
		wind_set(whandle,WF_NAME,hiword(@title[1]),loword(@title[1]),0,0);
  	wind_set(whandle,WF_INFO,hiword(@winfo[1]),loword(@winfo[1]),0,0);
		mouse_off;
		wind_open(whandle,((wb-400) div 2),wy,400,max_y); (* Fenster aufmachen *)
    Set_MFDB;         (* MFDB initialisieren     *)
    Clear_window;     (* Fenster mit weiž fllen *)
		mouse_on;
END;

(************************ Zeilen-Scrolling *****************************)

procedure scroll_line_down;  (* Pfeil nach unten geklickt *)

VAR pxyarray    : ARRAY_8;
    pxyarray1   : ARRAY_4;
    xw,yw,bw,hw : integer;
    slider_pos  : integer;    

BEGIN
  IF act_d_nr < (d_nr - number_lines + 1 ) THEN
  BEGIN
  	psrcMFDB := scrnMFDB;     (* MFDB-Bl”cke bernehmen             *)
  	pdesMFDB := scrnMFDB;     (* pscrMFDB = Quelle, pdesMFDB = Ziel *)
	  wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);	
	  pxyarray[0] := xw; 
	  pxyarray[1] := yw+16;
	  pxyarray[2] := xw+bw;
	  pxyarray[3] := yw+hw;
	  pxyarray[4] := xw;
	  pxyarray[5] := yw;
	  pxyarray[6] := xw+bw;
	  pxyarray[7] := yw+hw-16;						
    mouse_off;
    wind_update(BEG_UPDATE);
    wind_set(whandle,WF_TOP,0,0,0,0); (* fr MultiTOS nach vorn *)
    vro_cpyfm(vdihandle,3,pxyarray,psrcMFDB,pdesMFDB);  (* VDI 109 *)
    pxyarray1[0] := xw;
  	pxyarray1[1] := yw+hw-17;     (* untere Zeile l”schen *)
	  pxyarray1[2] := xw+bw-1;
	  pxyarray1[3] := yw+hw;
    v_bar(vdiHandle,pxyarray1);
    inc(act_d_nr);
	  Set_label_color(act_d_nr+number_lines-2);
	  v_gtext(vdiHandle,xw,yw+16*(number_lines-1),'  '+Disasmfield[act_d_nr+number_lines-2].befehl);    
    slider_pos := trunc(1000.0 * ((act_d_nr-1) / (d_nr-number_lines-1+0.1)));
    wind_set(whandle,WF_VSLIDE,slider_pos,0,0,0); (* Sliderdaten holen *)
    wind_update(END_UPDATE);
    mouse_on;
  END;  
END;

procedure scroll_line_up;   (* Pfeil nach oben geklickt *)

VAR pxyarray    : ARRAY_8;
    pxyarray1   : ARRAY_4;
    xw,yw,bw,hw : integer;
    slider_pos  : integer;

BEGIN
  IF act_d_nr > 1 THEN
  BEGIN
  	psrcMFDB := scrnMFDB;     (* MFDB-Bl”cke bernehmen             *)
	  pdesMFDB := scrnMFDB;     (* pscrMFDB = Quelle, pdesMFDB = Ziel *)
	  wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);	
    wind_update(BEG_UPDATE);
	  pxyarray[0] := xw; 
	  pxyarray[1] := yw;
	  pxyarray[2] := xw+bw;
	  pxyarray[3] := yw+hw-16;
	  pxyarray[4] := xw;
	  pxyarray[5] := yw+16;
	  pxyarray[6] := xw+bw;
	  pxyarray[7] := yw+hw-16;						
    mouse_off;
    wind_set(whandle,WF_TOP,0,0,0,0);  (* fr MultiTOS *)
    vro_cpyfm(vdihandle,3,pxyarray,psrcMFDB,pdesMFDB);  (* VDI 109 *)
    pxyarray1[0] := xw;
	  pxyarray1[1] := yw;           (* obere Zeile l”schen *)
	  pxyarray1[2] := xw+bw-1;
	  pxyarray1[3] := yw+16;
    v_bar(vdiHandle,pxyarray1);
    dec(act_d_nr);
	  Set_label_color(act_d_nr);
	  v_gtext(vdiHandle,xw,yw+16,'  '+Disasmfield[act_d_nr].befehl);    
    slider_pos := trunc(1000.0 * ((act_d_nr-1) / (d_nr-number_lines-1+0.1)));
    wind_set(whandle,WF_VSLIDE,slider_pos,0,0,0); (* Sliderdaten holen *)
    wind_update(END_UPDATE);
    mouse_on;
  END;  
END;

(*************************** Slider-Verschiebung setzen ****************)


Procedure Slider_move(slider_pos:integer);   (* Slider-Scrolling *)

VAR i,xw,yw,bw,hw : integer;
    start_x,start_y : integer;
    slider_v : real;
    
BEGIN
  mouse_off;
  wind_update(BEG_UPDATE);
  wind_set(whandle,WF_TOP,0,0,0,0);
  IF (d_nr >= number_lines-1) and (slider_pos > 0) THEN
  BEGIN
    act_d_nr := d_nr-number_lines;
    slider_v := slider_pos/1000+0.00001;
    act_d_nr := trunc(slider_v * act_d_nr)+1;
    IF act_d_nr < 1 THEN
    BEGIN
      act_d_nr := 1;
    END;  
    wind_set(whandle,WF_VSLIDE,slider_pos,0,0,0); (* Sliderdaten holen *)
  END
  ELSE
  BEGIN
    act_d_nr := 1;
    wind_set(whandle,WF_VSLIDE,0,0,0,0);
  END;
  Clear_Window;
	wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);  
	i := act_d_nr;
	start_x := xw +16;
	start_y := yw + 16;
	WHILE (i <= d_nr) and (start_y <= yw + hw) DO  (* Befehle drucken *)
  BEGIN
     Set_label_color(i);
     v_gtext(vdiHandle,start_x,start_y,Disasmfield[i].befehl);
     inc(i);
     start_y := start_y + 16;
  END;  
  wind_update(END_UPDATE);
  mouse_on;
END;

(*************************************************************************)

function rc_intersect(var r1,r2: GRECT): boolean;	

var	x,y,w,h:	integer;

BEGIN
	x:=max(r2.g_x,r1.g_x);
	y:=max(r2.g_y,r1.g_y);
	w:=min(r2.g_x+r2.g_w,r1.g_x+r1.g_w);
	h:=min(r2.g_y+r2.g_h,r1.g_y+r1.g_h);
	r2.g_x:=x;
	r2.g_y:=y;
	r2.g_w:=w-x;
	r2.g_h:=h-y;
	if (w>x) and (h>y) then
		rc_intersect:=true
	else
		rc_intersect:=false;
END;

(********************* Redrawroutine fr Reassembler-Fenster **********)

procedure redrawwindow;

var	box,work : GRECT;
  	clip     : Array_4;
    pxyarray : Array_4;

BEGIN
  mouse_off;
  wind_update(BEG_UPDATE);
	if whandle<=0 then
		exit;
	wind_get(whandle,WF_WORKXYWH,work.g_x,work.g_y,work.g_w,work.g_h);
	wind_get(whandle,WF_FIRSTXYWH,box.g_x,box.g_y,box.g_w,box.g_h);
	while (box.g_w>0) and (box.g_h>0) do
	BEGIN
		if rc_intersect(work,box) then
		BEGIN
			clip[0]:=box.g_x; clip[1]:=box.g_y;
			clip[2]:=box.g_x+box.g_w-1; clip[3]:=box.g_y+box.g_h-1;
			vs_clip(vdiHandle,1,clip);
      vsf_color(vdiHandle,White);
      vsf_interior(vdiHandle,FIS_SOLID);
      vsf_perimeter(vdiHandle,0);
      pxyarray[0] := clip[0];
		  pxyarray[1] := clip[1];
		  pxyarray[2] := clip[2];
		  pxyarray[3] := clip[3];
      v_bar(vdiHandle,pxyarray);                 (* Fenster weiž fllen *)
      restore_window(clip);
		END;
		wind_get(whandle,WF_NEXTXYWH,box.g_x,box.g_y,box.g_w,box.g_h);
	END;
	wind_update(END_UPDATE);
  mouse_on;
END;

(************************************************************************)

Procedure Hex_in_Word(VAR start:WORD;hexstr:Hexa);  

VAR i,divfaktor: word;  (* 4-stellig Hex in Word-Format *)
    hex : ARRAY[1..4] OF byte;
    
BEGIN
  start := 0;
  divfaktor := 4096;
  WHILE length(hexstr) < 4 DO
  BEGIN
    hexstr := '0'+hexstr;
  END;   
  FOR i := 1 TO 4 DO
  BEGIN
    IF hexstr[i] <= '9' THEN
    BEGIN
      hex[i] := ord(hexstr[i])-48;     (* 0 - 9 *)
    END
    ELSE        
    BEGIN
      IF upcase(hexstr[i]) <= 'F' THEN
      BEGIN
        hex[i] := ord(upcase(hexstr[i]))-55;   (* A - F *)
      END;
    END;
    start := start + hex[i]*divfaktor;  
    divfaktor := divfaktor SHR 4;
  END;
END;    

(**************************** File-Selector ****************************)


Procedure SelectFile(VAR selectname:pfad;ext:Extstr);         

VAR
  filename   : String;              (* Pfad-/Dateinamen *)
	dir        : DirStr;     
	name       : NameStr;
	exitButton : Integer;
	path1      : String;
	
BEGIN

  path1 := concat(path,ext);
	filename := '';
	name := '';
	fsel_input( path1, filename, exitButton );  (* File_Selector aufrufen *)
	IF exitButton = 0 then
		selectname := ''
	ELSE
	BEGIN
		FSplit( path1, dir, name, ext );     (* Pfad zerlegen *)
		selectname := dir + filename;
		path := concat(dir,'*.');
	END;
END;

(**************************** Bin„rcode laden *************************)

PROCEDURE Laden;
 
VAR name    : pfad; 
    len_str : string[4];

{ Laden eines Bin„rfiles von der Diskette
  Dateigr”že ist durch Maxram begrenzt
  Datei vom Typ FILE OF BYTE }

BEGIN
  SelectFile(name,'BIN');
  IF name <> '' THEN
  BEGIN
    d_nr := 0;
    act_d_nr := 1;
    ASSIGN(Codefile,name);              (* Datei zuordnen *)
    RESET(Codefile);
    filelength := FileSize(Codefile);   (* Dateigr”že holen *)
    IF (filelength <= MAXRAM) THEN
    BEGIN
      blockread(Codefile,Codefield,filelength); (* Datei komplett laden *)
      rsrc_gaddr(R_TREE, SETSTART, tree);       (* Dialog Adresse       *)   
      IF (filelength < 10) THEN
      BEGIN
        str(filelength:1,len_str);
      END;
      IF (filelength >= 10) and (filelength < 100) THEN
      BEGIN
        str(filelength:2,len_str);
      END;      
      IF (filelength >= 100) and (filelength < 1000) THEN
      BEGIN
        str(filelength:3,len_str);
      END;      
      IF (filelength >= 1000) THEN
      BEGIN
        str(filelength:4,len_str);
      END;
      SetPtext(tree,ENDADR,len_str);  (* Dateil„nge in Dialog einsetzen *) 
      startlen := filelength;        
      Clear_Window;
      wind_set(whandle,WF_VSLIDE,0,0,0,0); 
      close(codefile);
    END
    ELSE
    BEGIN
      form_alert(1,'[1][ Datei ist gr”žer | als 8192 Bytes ! ][ Schade ]');
      close(codefile);
    END;
  END;  
END;

(*************************** 8-bit Hexwert erzeugen *********************)

PROCEDURE Makehexbyte(VAR hexvalue:Hexa;Cbyte:byte);

{Hexbyte als String erzeugen}

VAR Zw1,Zw2 : byte;

BEGIN
  Zw1 := CByte shr 4;  
  Zw2 := CByte MOD 16;  
  IF zw1 <= 9 THEN
  BEGIN
     hexvalue[1] := chr(Zw1+48);
  END
  ELSE
  BEGIN
     hexvalue[1] := chr(Zw1+55);
  END;
  IF zw2 <= 9 THEN
  BEGIN
    hexvalue[2] := chr(Zw2+48);
  END
  ELSE
  BEGIN
    hexvalue[2] := chr(Zw2+55);
  END;  
  hexvalue[0] := chr(2);
END;

(********************* Befehl zusammensetzen *************************)

PROCEDURE GETINSTRUCTION(VAR Instcode:STRG50;VAR PC:word);

VAR
Codebyte : byte;
Abs_adr  : word;
Code_adr : word;
Codename,name2 : STRING[18];
Codechar : CHAR;
Hexbyte  : Hexa;
Hexbyt2  : Hexa;

BEGIN
  Codebyte := Codefield[PC+file_offset];
  Codename := M[Codebyte];
  Codechar := Codename[1];
  Makehexbyte(Hexbyte,Codebyte);
  Instcode := concat(Hexbyte,' ');
  CASE Codechar OF
    '0' : BEGIN    {Implied Adressierung}
            Name2 := copy(Codename,2,length(Codename)-1);
            Instcode := Concat(Instcode,'       ',Name2);
          END;
    '1' : BEGIN    {Absolute Adressierung}
            IF Labelfield[PC+Codestart] <> 1 THEN
            BEGIN
               Labelfield[PC+Codestart] := 2;  (* Absolut-Adresse markieren *)  
            END;     
            Inc(PC);
            Code_adr := PC + file_offset;
            Codebyte := Codefield[Code_adr];      
            Inc(code_adr);      
            Abs_adr := Codebyte + 256 * Codefield[code_adr];
            Labelfield[Abs_Adr] := 1;       (* Label markieren *)
            Makehexbyte(Hexbyt2,Codebyte);
            Inc(PC); 
            Codebyte := Codefield[code_adr];
            Makehexbyte(Hexbyte,Codebyte);
            Instcode := Concat(Instcode,Hexbyt2,' ',Hexbyte,'  ');
            Name2 := copy(Codename,2,length(Codename)-1);
            Instcode := Concat(Instcode,Name2);
            Instcode := Concat(Instcode,'L',hexbyte,hexbyt2);
          END;
    '2' : BEGIN     {Immediate Adressierung}
            Inc(PC);
            Codebyte := Codefield[PC+file_offset];
            Makehexbyte(Hexbyte,Codebyte);
            Instcode := Concat(Instcode,Hexbyte,'     ');
            Name2 := copy(Codename,2,length(Codename)-1);
            Instcode := Concat(Instcode,Name2);
            IF hexbyte[1] > '9' THEN
            BEGIN
              Instcode := Concat(Instcode,'0');
            END;
            Instcode := Concat(Instcode,Hexbyte,'H');
          END;
    '3' : BEGIN      {16-bit Immediate-Adressierung}
            Inc(PC);
            Code_adr := PC+file_offset;
            Codebyte := Codefield[Code_adr];
            Makehexbyte(Hexbyt2,Codebyte);
            Inc(PC);
            Inc(Code_adr);
            Codebyte := Codefield[Code_adr];
            Makehexbyte(Hexbyte,Codebyte);
            Instcode := Concat(Instcode,Hexbyt2,' ',Hexbyte,'  ');
            Name2 := copy(Codename,2,length(Codename)-1);
            Instcode := Concat(Instcode,Name2);
            IF hexbyte[1] > '9' THEN
            BEGIN
              Instcode := Concat(Instcode,'0');
            END;   
            Instcode := Concat(Instcode,hexbyte,hexbyt2,'H');
          END;
    '4' : BEGIN       {Unbekannter Code als DATA ausgeben}
            Name2 := copy(Codename,2,length(Codename)-1);
            Instcode := Concat(Instcode,'       ',Name2);
            IF hexbyte[1] > '9' THEN
            BEGIN
              Instcode := Concat(Instcode,'0');
            END;
            Instcode := Concat(Instcode,hexbyte,'H');
          END;
     END;
     Inc(PC);
END;

(*********************** Befehl + Adresse montieren ********************)

PROCEDURE BEFEHL(VAR Mnemonic:STRG50;VAR PC:word);

VAR
Hexadr : Hexa;
Inst   : STRG50;
tempPC : word;

{ Mnemonic enth„lt beim Verlassen der Procedure den Vollst„ndigen Befehl }

BEGIN
  Inst := '';
  tempPC := PC + codestart;
  Makehexadr(Hexadr,tempPC);
  Mnemonic := Concat(' $',Hexadr,'            ');
  Getinstruction(Inst,PC);
  Mnemonic := Concat(Mnemonic,Inst);
END;

(********************** Reassembler-Aufruf ******************************)

Procedure Display;

VAR PC                : word;
    xw, yw, bw, hw    : integer;
    start_x, start_y  : integer;
    start_pc,tempPC   : word;
    clip              : ARRAY_4;
    Labelstr          : String[6];
    i                 : word;
    
BEGIN
  IF Filelength <> 0 THEN
  BEGIN
    PC := 0;
    menu_icheck(mtree,FILEOUT,0);  (* Dateih„kchen aus      *)
    menu_icheck(mtree,PRTOUT,0);   (* Druckerh„kchen aus    *)    
    menu_icheck(mtree,DISPOUT,1);  (* Bildschirmh„kchen an  *)  
	  IF file_offset > filelength THEN
	  BEGIN
      form_alert(1,'[1][ File-Offset > Dateil„nge ! | Offset wird 0 gesetzt ][ Hmmh ]');
      rsrc_gaddr(R_TREE, SETSTART, tree);  (* Dialogadresse holen  *)
      SetPtext(tree,FILEOFFSET,'0000');  
	    file_offset := 0;
	  END;  
	  wind_set(whandle,WF_VSLIDE,0,0,0,0);
	  wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);
	  Clear_window;                               (* Fenster s„ubern *)
	  clip[0]:= xw; clip[1]:=yw;
		clip[2]:= xw+bw-1; clip[3]:= yw+hw-1;
		vs_clip(vdiHandle,1,clip); 
	  start_x := xw + 16;
	  start_y := yw + 16;
	  v_gtext(vdiHandle,start_x,start_y,'Reassembler l„uft..., bitte warten');
	  v_gtext(vdiHandle,start_x,start_y+16,'       Motorola 680xx for ever');
    FOR i:=1 To filelength+1 DO
    BEGIN
	    Disasmfield[i].adr := 0;       (* Befehls-Array l”schen *)
	    Disasmfield[i].befehl := '';
    END;
    IF lab_clr THEN           (* Labelarray automatisch l”schen ? *)
    BEGIN
      FOR i:= 0 TO 65535 DO
      BEGIN
        Labelfield[i] := 0; (* Labelfeld l”schen *)
      END;
    END;  
	  d_nr := 1;
	  act_d_nr := 1;
    Start_PC := PC + Codestart;          (* Startadresse merken           *)
	  WHILE (PC+codestart <= 65535) and (PC+codestart <= start_pc+startlen) DO      
	  BEGIN
	    tempPC := PC + codestart;
	    Disasmfield[d_nr].adr := tempPC;    (* Befehlsmontage, Hauptschleife *)
	    BEFEHL(Disasmline,PC);
      Disasmfield[d_nr].befehl := Disasmline;
      IF (show_mode =  0) THEN   (* Adresse/Objektcode entfernen *)
      BEGIN
        Disasmfield[d_nr].befehl := copy(Disasmfield[d_nr].befehl,28,length(Disasmfield[d_nr].befehl)-27);
        Disasmfield[d_nr].befehl := concat('       ',Disasmfield[d_nr].befehl);
      END;         
	    inc(d_nr);
	  END;
	  FOR i :=1 TO d_nr DO
	  BEGIN
	  	Set_Label(i);    (* Label einfgen *)
    END;
	  Clear_Window;
	  i := 1;
	  mouse_off;
	  wind_update(BEG_UPDATE);
	  WHILE (i <= d_nr) and (start_y <= yw + hw) DO   (* Druckschleife *)
	  BEGIN
	  	Set_label_color(i);
	    v_gtext(vdiHandle,start_x,start_y,Disasmfield[i].befehl);
	    inc(i);
	    number_lines := i;
	    start_y := start_y + 16;
	  END;  
	  wind_update(END_UPDATE);
	  mouse_on;
  END
  ELSE 
  BEGIN
    form_alert(1,'[1][ Noch keine Bin„rdatei | geladen ! ][ Hmmh ]');
  END;
END;

(**************************** Labeltabelle laden ***********************)

PROCEDURE Label_laden;
 
VAR name       : pfad; 
    len_str    : string[4];
    lablength  : longint;
    Labfile : FILE OF BYTE;
    
(* Laden einer 64 KB Labeltabelle / Bin„rfiles von der Diskette *)

BEGIN
  SelectFile(name,'LAB');
  IF name <> '' THEN
  BEGIN
    ASSIGN(Labfile,name);               (* Datei zuordnen *)
    RESET(Labfile);    
    lablength := FileSize(Labfile);     (* Dateigr”že holen *)
    IF (lablength = 65536) THEN
    BEGIN
      blockread(Labfile,Labelfield,lablength);  (* Datei komplett laden *)
      menu_icheck(mtree,LABCLEAR,0);            (* Label l”schen unterdrcken *)
      lab_clr := false;
      close(Labfile);
      IF filelength <> 0 THEN
      BEGIN
        Display;
      END;  
    END
    ELSE
    BEGIN
      form_alert(1,'[1][ Dies ist keine | Labeltabelle ! ][ Gepennt ]');
      close(Labfile);
    END;
  END;  
END;

(**************************** Labeltabelle sichern ***********************)

PROCEDURE Label_sichern;
 
VAR name    : pfad; 
    len_str : string[4];
    Labfile : FILE OF BYTE;
    
(* Sichern einer 64 KB Labeltabelle / Bin„rfiles auf Diskette *)

BEGIN
  IF filelength <> 0 THEN
  BEGIN
	  SelectFile(name,'LAB');
	  IF name <> '' THEN
	  BEGIN
	    ASSIGN(Labfile,name);                   (* Datei zuordnen *)
	    REWRITE(Labfile);                       (* Datei schreiben *)
	    blockwrite(Labfile,Labelfield,65536);   (* Label komplett sichern *)
	    close(Labfile);
	  END;  
	END
	ELSE
	BEGIN
    form_alert(1,'[1][ Mind. 1x reassemblieren,| sonst macht das keinen | Sinn ! ][ Hmmh ]');
	END;  
END;

(*************************** Labeltabelle automatisch l”schen ***********)

Procedure Lab_clear;

BEGIN
  IF filelength <> 0 THEN
  BEGIN
   IF lab_clr THEN
   BEGIN
     menu_icheck(mtree,LABCLEAR,0);     (* Label l”schen ausschalten *)
     lab_clr := false;
   END
   ELSE
   BEGIN
     menu_icheck(mtree,LABCLEAR,1);     (* Label l”schen einschalten *)
     lab_clr := true;
   END;
	END
	ELSE
	BEGIN
    form_alert(1,'[1][ Mind. 1x reassemblieren,| sonst macht das keinen | Sinn ! ][ Hmmh ]');
	END;     
END;

(********************** Umschalter 8080 oder 8085-Code *******************)

PROCEDURE MODUS(mode:byte);

{ Prozessor 8080 oder 8085 festlegen
  8085 besitzt 2 Befehle mehr, n„mlich SIM und RIM }

BEGIN
  IF mode = 0 THEN
  BEGIN
    proztype := '8080';
    m[32] := '4DEFB ';
    m[48] := '4DEFB ';
    menu_icheck(mtree,SET8080,1);       (* H„kchen setzen *)
    menu_icheck(mtree,SET8085,0);
  END
  ELSE
  BEGIN
    proztype := '8085';
    m[32] := '0RIM';
    m[48] := '0SIM';
    menu_icheck(mtree,SET8085,1);       (* H„kchen setzen *)
    menu_icheck(mtree,SET8080,0);    
  END;
  mode85 := mode;
END;

(*************** Parameter sichern *******************)

PROCEDURE PARAM_SAVE;           (* Aktuelle Einstellungen *)
                                (* sichern                *)
VAR
    pararec   : paramdata;
    paramfile : FILE of paramdata;
    
BEGIN
  rsrc_gaddr(R_TREE, SETSTART, tree);       (* Dialogadresse holen  *)
  GetPtext(tree,STARTADR,pararec.starta);   (* Edit-Dialog auslesen *)
  GetPtext(tree,ENDADR,pararec.starto);
  GetPtext(tree,FILEOFFSET,pararec.fileoff);  
  pararec.labelf := lab_clr;
  pararec.showad := show_mode; 
  pararec.mode_85 := mode85;
  assign(paramfile,'REASS.INF');
  rewrite(paramfile);
  write(paramfile,pararec);
  close(paramfile);
END;

(**************************** Parameter laden **************************)

PROCEDURE PARAM_LOAD;           (* Aktuelle Einstellungen *)
                                (* laden                  *)
VAR res : integer;
    start     : Word;
    start_str : Hexa;
    len_str   : Hexa;
    off_str   : Hexa;

    pararec   : paramdata;
    paramfile : FILE of paramdata;
    
BEGIN
  rsrc_gaddr(R_TREE, SETSTART, tree);       (* Dialogadresse holen  *)
  {$I-}  
  assign(paramfile,'REASS.INF');
  reset(paramfile);
  IF IORESULT <> 0 THEN
  BEGIN
    SetPtext(tree,STARTADR,'0000');   (* Edit-Dialog auslesen *)
    SetPtext(tree,ENDADR,'1024');
    SetPtext(tree,FILEOFFSET,'0000');  
    lab_clr := true ;
    show_mode := 1;
    mode85 := 1; 
    MODUS(1);
  END
  ELSE
  BEGIN
    read(paramfile,pararec);
    SetPtext(tree,STARTADR,pararec.starta);   (* Edit-Dialog auslesen *)
    SetPtext(tree,ENDADR,pararec.starto);
    SetPtext(tree,FILEOFFSET,pararec.fileoff);  
    lab_clr := pararec.labelf ;
    show_mode := pararec.showad; 
    MODUS(pararec.mode_85);
    mode85 := pararec.mode_85;
    close(paramfile);
  END;
  IF lab_clr = false THEN
  BEGIN
    menu_icheck(mtree,LABCLEAR,0);     (* Label l”schen ausschalten *)
  END
  ELSE
  BEGIN
    menu_icheck(mtree,LABCLEAR,1);     (* Label l”schen einschalten *)
  END;
  IF show_mode = 0 THEN
  BEGIN
    menu_icheck(mtree,ADRCODE,0);     (* Label l”schen ausschalten *)
  END
  ELSE
  BEGIN
    menu_icheck(mtree,ADRCODE,1);     (* Label l”schen einschalten *)
  END;
  GetPtext(tree,STARTADR,start_str);   (* Edit-Dialog auslesen *)
  GetPtext(tree,ENDADR,len_str);
  GetPtext(tree,FILEOFFSET,off_str);  
  WHILE length(start_str) < 4 DO (* Hexziffer 4stellig machen *)
  BEGIN
    start_str := '0' + start_str;
  END;
  WHILE length(off_str) < 4 DO   (* Hexziffer 4stellig machen *)
  BEGIN
    off_str := '0' + off_str;
  END;  
  val(len_str,startlen,res);     (* String in Zahl wandeln *)
  IF res <> 0 THEN               (* Schrotteingabe         *)
  BEGIN
    codestart := 0;
    SetPtext(tree,ENDADR,'1024');
  END;  
  Hex_in_Word(start,start_str);     (* Hex in Word *)
  codestart := start;
  Hex_in_Word(start,off_str);       (* Hex in Word *)
  file_offset := start;
END;

(*************** Dialog fr Adresseingabe bearbeiten *******************)

PROCEDURE ADDRESS;              (* Hexzahlen aus Dialog holen *)
                                (* und neu reassemblieren     *)
VAR res : integer;
    start     : Word;
    start_str : Hexa;
    len_str   : Hexa;
    off_str   : Hexa;
    
BEGIN
  hndl_form(SETSTART);
  rsrc_gaddr(R_TREE, SETSTART, tree);  (* Dialogadresse holen  *)
  GetPtext(tree,STARTADR,start_str);   (* Edit-Dialog auslesen *)
  GetPtext(tree,ENDADR,len_str);
  GetPtext(tree,FILEOFFSET,off_str);  
  WHILE length(start_str) < 4 DO (* Hexziffer 4stellig machen *)
  BEGIN
    start_str := '0' + start_str;
  END;
  WHILE length(off_str) < 4 DO   (* Hexziffer 4stellig machen *)
  BEGIN
    off_str := '0' + off_str;
  END;  
  val(len_str,startlen,res);     (* String in Zahl wandeln *)
  IF res <> 0 THEN               (* Schrotteingabe         *)
  BEGIN
    codestart := 0;
    SetPtext(tree,ENDADR,'1024');
  END;  
  Hex_in_Word(start,start_str);     (* Hex in Word *)
  codestart := start;
  Hex_in_Word(start,off_str);       (* Hex in Word *)
  file_offset := start;
  Display;
END;

(*************** Dialog fr Adresseingabe bearbeiten *******************)

PROCEDURE JUMP_ADDRESS;         (* Hexzahlen aus Dialog holen *)
                                (* und neu reassemblieren     *)
VAR res,j       : Integer;
    start       : Word;
    start_str   : Hexa;
    exitbutton  : Integer;
    start_x,start_y : Integer;
    xw,yw,bw,hw :Integer;
    
BEGIN
  exitbutton := hndl_form(JMPADDR);
  IF exitbutton = JUMP THEN
  BEGIN
    rsrc_gaddr(R_TREE, JMPADDR, tree);   (* Dialogadresse holen  *)
    GetPtext(tree,JADDRESS,start_str);   (* Edit-Dialog auslesen *)
    WHILE length(start_str) < 4 DO (* Hexziffer 4stellig machen *)
    BEGIN
      start_str := '0' + start_str;
    END;
    Hex_in_Word(start,start_str);     (* Hex in Word *)
    IF d_nr > 1 THEN
    BEGIN
      IF (disasmfield[1].adr <= start) and (disasmfield[d_nr-1].adr >= start) THEN
      BEGIN
        j := 1;
        WHILE (disasmfield[j].adr <= start) DO
        BEGIN
          inc(j); 
        END;
        IF (disasmfield[j].adr = start) THEN
        BEGIN
           act_d_nr := j;
        END
        ELSE
        BEGIN
           act_d_nr := j - 1;         
        END;
      END;
    END;
    wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);
    start_x := xw + 16;
    start_y := yw + 16;    
	  Clear_Window;
	  mouse_off;
	  wind_update(BEG_UPDATE);
	  j := act_d_nr;
	  WHILE (j <= d_nr) and (start_y <= yw + hw) DO   (* Druckschleife *)
	  BEGIN
	  	Set_label_color(j);
	    v_gtext(vdiHandle,start_x,start_y,Disasmfield[j].befehl);
	    inc(j);
	    start_y := start_y + 16;
	  END;  
	  wind_update(END_UPDATE);
	  mouse_on;
	END;  
END;

(********************* Datei / Drucker-Ausgabe ************************)

PROCEDURE ASCIIOUT(VAR kanal:text;printflag:byte);   

VAR j: integer;
    c_start, c_end : Hexa;
    zw : STRING[60];
    
(* Ausgabe 60 Zeilen/Seite in Datei und auf Drucker *)

BEGIN                         (* Drucker/Datei Ausgabe nur m”glich, *)
  IF d_nr > 1  THEN           (* wenn bereits reassembliert wurde.  *)
  BEGIN                        
    IF show_mode = 1 THEN
    BEGIN                            
      c_start := copy(disasmfield[1].befehl,3,4);
      c_end   := copy(disasmfield[d_nr-1].befehl,3,4);
    END
    ELSE
    BEGIN
        Makehexadr(c_start,Disasmfield[1].adr); 
        Makehexadr(c_end,Disasmfield[d_nr-1].adr);     
    END;
    rewrite(kanal);           (* Schreibkanal ”ffnen                *)
    writeln(kanal,'; INTEL 8080/85 REASSEMBLER by Jens Schulz 1994');
    writeln(kanal,'; for ATARI ST/TT/FALCON computers');
    writeln(kanal);
    writeln(kanal,'; Codestart : $',c_start,'   Codeend : $',c_end);
    writeln(kanal);
    FOR j := 1 TO d_nr DO
    BEGIN
      IF show_mode = 1 THEN
      BEGIN
         zw := Disasmfield[j].Befehl;
      END   
      ELSE    
      BEGIN
         zw := copy(Disasmfield[j].Befehl,2,length(Disasmfield[j].Befehl)-1);
      END;   
      writeln(kanal,zw);
      IF (j mod 60 = 0) THEN  (* Seitenvorschub *)
      BEGIN
        IF printflag = 1 THEN
        BEGIN
          writeln(kanal,chr(12));  (* Formfeed *)
        END;
      END;  
    END;
    close(kanal);                    (* Kanal schliessen      *)
    IF printflag = 0 THEN
    BEGIN
      menu_icheck(mtree,FILEOUT,1);  (* Dateih„kchen an       *)
      menu_icheck(mtree,PRTOUT,0);   (* Druckerh„kchen aus    *)    
      menu_icheck(mtree,DISPOUT,0);  (* Bildschirmh„kchen aus *) 
    END
    ELSE
    BEGIN
      menu_icheck(mtree,PRTOUT,1);   (* Druckerh„kchen an     *)
      menu_icheck(mtree,DISPOUT,0);  (* Bildschirmh„kchen aus *)
      menu_icheck(mtree,FILEOUT,0);  (* Dateih„kchen aus      *)      
    END;      
  END
  ELSE
  BEGIN
    form_alert(1,'[1][ Fehler, bitte vorher | 1x reassemblieren ! ][ Okay ]')
  END;
END;

(***************************** Datei-Ausgabe ***************************)

PROCEDURE DATEI;

{Reassemblieren auf Diskette als Textfile }

VAR kanal : text;
    name  : pfad;

BEGIN
  IF d_nr > 1 THEN
  BEGIN
    SelectFile(name,'ASC');
    IF name <> '' THEN    
    BEGIN
      assign(kanal,name);
      asciiout(kanal,0);
    END;  
  END
  ELSE
  BEGIN
    form_alert(1,'[1][ Fehler, bitte vorher | 1x reassemblieren ! ][ Okay ]')
  END;
END;

(**************************Drucker-Ausgabe ******************************)

PROCEDURE DRUCKER;

VAR kanal : text;        (* Ausgabe auf Drucker, LST-Kanal ”ffnen *)

BEGIN
  assign(kanal,'PRN');
  ASCIIOUT(kanal,1);
END;


(******************** Adressen/Objektcode einblenden ******************)

Procedure Objcode_show;

BEGIN
  IF show_mode = 0 THEN   (* Adressen/Objekt einblenden *)
  BEGIN
    show_mode := 1;
    menu_icheck(mtree,ADRCODE,1);
		winfo :='   Adresse  Label   Code      Mnemonics'#0;
  	wind_set(whandle,WF_INFO,hiword(@winfo[1]),loword(@winfo[1]),0,0)
 END 	
 ELSE 	
 BEGIN
    show_mode := 0;
    menu_icheck(mtree,ADRCODE,0);
		winfo :='  Label   Mnemonics'#0;
  	wind_set(whandle,WF_INFO,hiword(@winfo[1]),loword(@winfo[1]),0,0);
 END;
 Display;
END;

(*****  Initialisierung der Mnemonic-Tabelle fr Code $00 - $FF *****)

PROCEDURE LOADDATA ;

{ 1. Zeichen = Adressierungsart
               0 = implizite Adressierung
               1 = absolute  Adressierung
               2 = immediate Adressierung 8- bit Konstante
               3 = immediate Adressierung 16-bit Konstante
               4 = DATA Element

  ab 2.Zeichen Mnemonics-Abkrzung
  unerlaubte Codes werden als DATA  #Code resassembliert
}

BEGIN
  proztype := '8085';
  M[0] :='0NOP';      M[1] :='3LXI  B,';  M[2] :='0STAX B';    M[3] :='0INX  B';
  M[4] :='0INC  R';   M[5] :='0DCR  B';   M[6] :='2MVI  B,';   M[7] :='0RLC';
  M[8] :='4DEFB ';    M[9] :='0DAD  B';   M[10]:='0LDAX B';    M[11]:='0DCX  B';
  M[12]:='0INR  C';   M[13]:='0DCR  C';   M[14]:='2MVI  C,';   M[15]:='0RRC';
  M[16]:='4DEFB ';    M[17]:='3LXI  D,';  M[18]:='0STAX D';    M[19]:='0INX  D';
  M[20]:='0INR  D';   M[21]:='0DCR  D';   M[22]:='2MVI  D,';   M[23]:='0RAL';
  M[24]:='4DEFB ';    M[25]:='0DAD  D';   M[26]:='0LDAX D';    M[27]:='0DCX  D';
  M[28]:='0INR  E';   M[29]:='0DCR  E';   M[30]:='2MVI  E,';   M[31]:='0RAR';
  M[32]:='0RIM';      M[33]:='3LXI  H,';  M[34]:='1SHLD ';     M[35]:='0INX  H';
  M[36]:='0INR  H';   M[37]:='0DCR  H';   M[38]:='2MVI  H,';   M[39]:='0DAA';
  M[40]:='4DEFB ';    M[41]:='0DAD  H';   M[42]:='1LHLD ';     M[43]:='0DCX  H';
  M[44]:='0INR  L';   M[45]:='0DCR  L';   M[46]:='2MVI  L,';   M[47]:='0CMA';
  M[48]:='0SIM';      M[49]:='3LXI  SP,'; M[50]:='1STA  ';     M[51]:='0INX  SP';
  M[52]:='0INR  M';   M[53]:='0DCR  M';   M[54]:='2MVI  M,';    M[55]:='0STC';
  M[56]:='4DEFB ';    M[57]:='0DAD  SP';  M[58]:='1LDA  ';      M[59]:='0DCX  SP';
  M[60]:='0INR  A';    M[61]:='0DCR  A';   M[62]:='2MVI  A,';   M[63]:='0CMC';
  M[64]:='0MOV  B,B';  M[65]:='0MOV  B,C'; M[66]:='0MOV  B,D';  M[67]:='0MOV  B,E';
  M[68]:='0MOV  B,H';  M[69]:='0MOV  B,L'; M[70]:='0MOV  B,M';  M[71]:='0MOV  B,A';
  M[72]:='0MOV  C,B';  M[73]:='0MOV  C,C'; M[74]:='0MOV  C,D';  M[75]:='0MOV  C,E';
  M[76]:='0MOV  C,H';  M[77]:='0MOV  C,L'; M[78]:='0MOV  C,M';  M[79]:='0MOV  C,A';
  M[80]:='0MOV  D,B';  M[81]:='0MOV  D,C'; M[82]:='0MOV  D,D';  M[83]:='0MOV  D,E';
  M[84]:='0MOV  D,H';  M[85]:='0MOV  D,L'; M[86]:='0MOV  D,M';  M[87]:='0MOV  D,A';
  M[88]:='0MOV  E,B';  M[89]:='0MOV  E,C'; M[90]:='0MOV  E,D';  M[91]:='0MOV  E,E';
  M[92]:='0MOV  E,H';  M[93]:='0MOV  E,L'; M[94]:='0MOV  E,M';  M[95]:='0MOV  E,A';
  M[96]:='0MOV  H,B';  M[97]:='0MOV  H,C'; M[98]:='0MOV  H,D';  M[99]:='0MOV  H,E';
  M[100]:='0MOV  H,H'; M[101]:='0MOV  H,L';M[102]:='0MOV  H,M'; M[103]:='0MOV  H,A';
  M[104]:='0MOV  L,B'; M[105]:='0MOV  L,C';M[106]:='0MOV  L,D'; M[107]:='0MOV  L,E';
  M[108]:='0MOV  L,H'; M[109]:='0MOV  L,L';M[110]:='0MOV  L,M'; M[111]:='0MOV  L,A';
  M[112]:='0MOV  M,B'; M[113]:='0MOV  M,C';M[114]:='0MOV  M,D'; M[115]:='0MOV  M,E';
  M[116]:='0MOV  M,H'; M[117]:='0MOV  M,L';M[118]:='0HLT';      M[119]:='0MOV  M,A';
  M[120]:='0MOV  A,B'; M[121]:='0MOV  A,C';M[122]:='0MOV  A,D'; M[123]:='0MOV  A,E';
  M[124]:='0MOV  A,H'; M[125]:='0MOV  A,L';M[126]:='0MOV  A,M'; M[127]:='0MOV  A,A';
  M[128]:='0ADD  B';   M[129]:='0ADD  C';  M[130]:='0ADD  D';   M[131]:='0ADD  E';
  M[132]:='0ADD  H';   M[133]:='0ADD  L';  M[134]:='0ADD  M';   M[135]:='0ADD  A';
  M[136]:='0ADC  B';   M[137]:='0ADC  C';  M[138]:='0ADC  D';   M[139]:='0ADC  E';
  M[140]:='0ADC  H';   M[141]:='0ADC  L';  M[142]:='0ADC  M';   M[143]:='0ADC  A';
  M[144]:='0SUB  B';   M[145]:='0SUB  C';  M[146]:='0SUB  D';   M[147]:='0SUB  E';
  M[148]:='0SUB  H';   M[149]:='0SUB  L';  M[150]:='0SUB  M';   M[151]:='0SUB  A';
  M[152]:='0SBB  B';   M[153]:='0SBB  C';  M[154]:='0SBB  D';   M[155]:='0SBB  E';
  M[156]:='0SBB  H';   M[157]:='0SBB  L';  M[158]:='0SBB  M';   M[159]:='0SBB  A';
  M[160]:='0ANA  B';   M[161]:='0ANA  C';  M[162]:='0ANA  D';   M[163]:='0ANA  E';
  M[164]:='0ANA  H';   M[165]:='0ANA  L';  M[166]:='0ANA  M';   M[167]:='0ANA  A';
  M[168]:='0XRA  B';   M[169]:='0XRA  C';  M[170]:='0XRA  D';   M[171]:='0XRA  E';
  M[172]:='0XRA  H';   M[173]:='0XRA  L';  M[174]:='0XRA  M';   M[175]:='0XRA  A';
  M[176]:='0ORA  B';   M[177]:='0ORA  C';  M[178]:='0ORA  D';   M[179]:='0ORA  E';
  M[180]:='0ORA  H';   M[181]:='0ORA  L';  M[182]:='0ORA  M';   M[183]:='0ORA  A';
  M[184]:='0CMP  B';   M[185]:='0CMP  C';  M[186]:='0CMP  D';   M[187]:='0CMP  E';
  M[188]:='0CMP  H';   M[189]:='0CMP  L';  M[190]:='0CMP  M';   M[191]:='0CMP  A';
  M[192]:='0RNZ';      M[193]:='0POP  B';  M[194]:='1JNZ  ';    M[195]:='1JMP  ';
  M[196]:='1CNZ  ';    M[197]:='0PUSH B';  M[198]:='2ADI  ';    M[199]:='0RST  0';
  M[200]:='0RZ';       M[201]:='0RET';     M[202]:='1JZ   ';    M[203]:='4DEFB ';
  M[204]:='1CZ   ';    M[205]:='1CALL ';   M[206]:='2ACI  ';    M[207]:='0RST  1';
  M[208]:='0RNC';      M[209]:='0POP  D';  M[210]:='1JNC  ';    M[211]:='2OUT  ';
  M[212]:='1CNC  ';    M[213]:='0PUSH D';  M[214]:='2SUI  ';    M[215]:='0RST  2';
  M[216]:='0RC';       M[217]:='4DEFB ';   M[218]:='1JC   ';    M[219]:='2IN   ';
  M[220]:='1CC   ';    M[221]:='4DEFB ';   M[222]:='2SBI  ';    M[223]:='0RST  3';
  M[224]:='0RPO';      M[225]:='0POP  H';  M[226]:='1JPO  ';    M[227]:='0XTHL';
  M[228]:='1CPO  ';    M[229]:='0PUSH H';  M[230]:='2ANI  ';    M[231]:='0RST  4';
  M[232]:='0RPE';      M[233]:='0PCHL ';   M[234]:='1JPE  ';    M[235]:='0XCHG';
  M[236]:='1CPE  ';    M[237]:='4DEFB ';   M[238]:='2XRI  ';    M[239]:='0RST  5';
  M[240]:='0RP';       M[241]:='0POP  PSW';M[242]:='1JP   ';    M[243]:='0DI';
  M[244]:='1CP   ';    M[245]:='0PUSH PSW';M[246]:='2ORI  ';    M[247]:='0RST  6';
  M[248]:='0RM';       M[249]:='0SPHL ';   M[250]:='1JM   ';    M[251]:='0EI';
  M[252]:='1CM   ';    M[253]:='4DEFB ';   M[254]:='2CPI  ';    M[255]:='0RST  7';
END;

(*********************** GEM-Event-Schleife ****************************)

Procedure event_loop(VAR nachr,typ_nachricht:integer);
    
VAR msgbuff : array_8;
    clip    : array_4;
    dummy   : integer;
    i,j     : integer;
    start_x : integer;
    start_y : integer;
    was_liegt_an : integer;

BEGIN
  REPEAT
    was_liegt_an := evnt_multi( MU_MESAG or MU_KEYBD, 0, 0, 0, 0, 0,
                    0, 0, 0, 0, 0, 0, 0, 0,
                    msgbuff,    0,0,
                    dummy, dummy, dummy,
                    dummy, key, dummy );

    IF was_liegt_an = MU_MESAG THEN   (* eine Message liegt an *)
    BEGIN
	    case msgbuff[0] of
	       WM_REDRAW:	if msgbuff[3]=whandle then      (* Fenster restaurieren *)
				            BEGIN
				              redrawwindow;
				            END;  
	       WM_TOPPED:	if msgbuff[3]=whandle then      (* Fenster toppen *)
				            BEGIN
				              wind_update(BEG_UPDATE);
	                    wind_set(whandle,WF_TOP,0,0,0,0);
	                    wind_update(END_UPDATE);
	                  END;  
	       WM_CLOSED:	if msgbuff[3]=whandle then      (* Fenster schliessen *)
					  	      BEGIN
						  	      button := form_alert(1,'[2][ INTEL 8080/85 Reassembler | beenden ? ][ Ja | Nein ]');
							        if button = 1 THEN
							        BEGIN
							          ENDE := true;
							        END;  
						        END;
		     WM_MOVED:	if msgbuff[3]=whandle then       (* Fenster verschoben *)
				            BEGIN
				              wind_update(BEG_UPDATE);
				              IF (msgbuff[4]+448) > max_x THEN  (* Fenster soll   *)
				              BEGIN                             (* immer komplett *)
				                msgbuff[4] := max_x-448;        (* auf Screen     *)
				              END;                              (* bleiben        *)
				              IF (msgbuff[5] < 19) THEN
				              BEGIN
				                 msgbuff[5] := 19;
				              END;
                      wind_get(whandle,WF_CURRXYWH,x,y,w,h);
				              IF msgbuff[5] + h > max_y + 19 THEN
				              BEGIN
				                msgbuff[5] := 19 + max_y - h;  (* nicht ber unteren Rand *)
				              END;
					            wind_set(whandle,WF_CURRXYWH,msgbuff[4],msgbuff[5],w,h);
					            wind_get(whandle,WF_WORKXYWH,x,y,w,h);
					            clip[0]:= x; clip[1]:= y;
			                clip[2]:= x + w - 1; clip[3]:= y + h - 1;
			                vs_clip(vdiHandle,1,clip);
					            wind_update(END_UPDATE);
					          END;
					          
		  	  WM_SIZED: IF msgbuff[3] = whandle THEN
		  	            BEGIN
		  	              wind_update(BEG_UPDATE);
		  	              IF msgbuff[6] <> 448 THEN
		  	              BEGIN
		  	                 msgbuff[6] := 448;  (* feste Breite);
		  	              END;   
		  	              IF msgbuff[7] < 130 THEN
		  	              BEGIN
		  	                 msgbuff[7] := 130;  (* minimale H”he *);
		  	              END; 
		  	              wind_set(whandle,WF_CURRXYWH,msgbuff[4],msgbuff[5],msgbuff[6],msgbuff[7]);
	  	                wind_get(whandle,WF_WORKXYWH,x,y,w,h);
	  	                clip[0]:= x; clip[1]:= y;
			                clip[2]:= x + w - 1; clip[3]:= y + h - 1;
			                vs_clip(vdiHandle,1,clip);
                      start_y := y + 16;
                      j := 1;
	                    WHILE start_y <= y + h DO   (* Zeilenanzahl *)
	                    BEGIN
	                      inc(j);
	                      number_lines := j;
	                      start_y := start_y + 16;
	                    END;                
                      wind_update(END_UPDATE);  
		  	            END;
		  	WM_ARROWED: IF msgbuff[3]=whandle THEN     (* zeilenweise scrollen *)
			  	          BEGIN
				              wind_update(BEG_UPDATE);
				              CASE msgbuff[4] OF
				                WA_UPLINE : Scroll_line_up;
				                WA_DNLINE : Scroll_line_down;
				              END;   
				              wind_update(END_UPDATE);
				            END;
				            	   
				 WM_VSLID:  IF msgbuff[3]=whandle THEN    (* Slider-Scrolling *)
				            BEGIN
				              wind_update(BEG_UPDATE);
                      slider_move(msgbuff[4]);
				              wind_update(END_UPDATE);
				            END;	          
   	  END;
    END;
  UNTIL (msgbuff[0] = MN_selected) or (was_liegt_an = MU_KEYBD) or ENDE;
  IF (msgbuff[0] = MN_selected) THEN
  BEGIN
     menu_tnormal( mtree, msgbuff[3], 1);
     nachr := msgbuff[4];
  END;   
  IF (was_liegt_an = MU_KEYBD) THEN
  BEGIN
     nachr := key;
  END;   
  typ_nachricht := was_liegt_an;
END;

PROCEDURE main;

VAR
  wahl1 : integer;
  
BEGIN
    ENDE := FALSE;
    error:=rsrc_load(Resourcefile);
    IF error=0 THEN
        form_alert(1,'[1][ Fehler beim Laden | der RSC-Datei ][ Pech ]')
    ELSE
    BEGIN
        rsrc_gaddr(R_TREE, DISASM85, mtree);
        mouse_off;
        menu_bar( mtree, 1 );
        PARAM_LOAD;
        mouse_on;
        graf_mouse( ARROW, NIL );
        path := '';
	      Dgetpath( path, 0 );                  (* Pfad holen    *)
	      path := FExpand( path )+'\*.';        (* Pfad erg„nzen *)
        IF pos('\\',path) > 0 THEN            (* Doppel-Backslash killen *)	
        BEGIN                                 (* z.B. bei Laufwerk A:    *)
          delete(path,pos('\\',path),1)
        END;          
        hndl_form(INFOBOX);
        REPEAT
            event_loop(wahl1,typ_nachricht);
            IF ENDE THEN
            BEGIN
              wahl1 := QUIT;
            END;
            IF typ_nachricht = MU_MESAG THEN  (* Menauswahl *)
            BEGIN
              CASE wahl1 OF
                SHOWINFO : hndl_form(INFOBOX);
                LOADCODE : Laden;
                ADRCODE  : Objcode_Show;
                DISASM   : Display;
                SETADR   : ADDRESS;
                JUMPADR  : JUMP_ADDRESS;
                SET8080  : Modus(0); 
                SET8085  : Modus(1);
                DISPOUT  : Display;
                PRTOUT   : Drucker;
                FILEOUT  : Datei;  
                PARAM_S  : Param_save;
                LABLOAD  : Label_laden;
                LABSAVE  : Label_sichern;
                LABCLEAR : Lab_clear;
              END;
            END  
            ELSE
            BEGIN
              CASE wahl1 OF
                9740  : Laden;  (* Tastaturauswahl *)
                7681  : Objcode_Show;
                15104 : Display;
                7955  : ADDRESS;
                9226  : JUMP_ADDRESS;
                15360 : Modus(0); 
                15616 : Modus(1);
                12290 : Display;
                6416  : Drucker;
                8454  : Datei;
                5140  : Label_laden;
                12558 : Label_sichern;
                11779 : Lab_clear;
                18432 : BEGIN
                				  wind_update(BEG_UPDATE); (* Cursor hoch *)
				                  Scroll_line_up;
				                  wind_update(END_UPDATE);
				                END;
				        20480 : BEGIN
                				  wind_update(BEG_UPDATE);  (* Cursor tief *)
				                  Scroll_line_down;
				                  wind_update(END_UPDATE);
				                END;                          
                4113  : wahl1 := QUIT;                             
              END;
            END;  
        UNTIL wahl1=QUIT;
        mouse_off;
        menu_bar( mtree, 0 );
        mouse_on;
        wind_close(whandle);
        wind_delete(whandle);
        rsrc_free( );
        IF error=0 THEN
            form_alert(1,'[1][ Fehler bei der | Freigabe des RSC-Speichers ][ Pech ]');
    END;
END;

BEGIN
    d_nr := 0;
    IF initgem=true THEN
    BEGIN
      wind_get(0,WF_CURRXYWH,	x, y, w, h);
      IF h < 399 THEN
      BEGIN
        form_alert(1,'[1][ Bildschirm-Aufl”sung | ist zu klein ! | Mindestens 640 * 400 ! ][ Okay ]');
      END
      ELSE
      BEGIN 
        planes := get_bitplanes;
        LOADDATA ;
        Open_window;   
        main;
      END;
    	ExitGEM;
    END;  
END.