home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / program / compiler / reass_us / source85 / reass_85.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-14  |  50.4 KB  |  1,576 lines
  1. PROGRAM REASSEMBLER_8085;
  2. {$X+}
  3.  
  4. uses geminit,gem,tos,dos;
  5.  
  6. (* Program for reassembling of INTEL 8080/85 binary code files  *)
  7. (* Jens Schulz, Rosenstraße 5, D-25368 Kiebitzreihe,Germany     *)                               
  8. (* Programmed in PurePascal 1.1                                 *)
  9. (* Freeware 4/1994                                              *)
  10.  
  11. CONST  
  12.      DISASM85 =   0; (* Menu tree *)
  13.      SHOWINFO =   9; (* STRING in tree DISASM85 *)
  14.      LOADCODE =  18; (* STRING in tree DISASM85 *)
  15.      SETADR   =  20; (* STRING in tree DISASM85 *)
  16.      JUMPADR  =  21; (* STRING in tree DISASM85 *)
  17.      ADRCODE  =  22; (* STRING in tree DISASM85 *)
  18.      DISASM   =  24; (* STRING in tree DISASM85 *)
  19.      QUIT     =  26; (* STRING in tree DISASM85 *)
  20.      SET8080  =  28; (* STRING in tree DISASM85 *)
  21.      SET8085  =  29; (* STRING in tree DISASM85 *)
  22.      DISPOUT  =  31; (* STRING in tree DISASM85 *)
  23.      PRTOUT   =  32; (* STRING in tree DISASM85 *)
  24.      FILEOUT  =  33; (* STRING in tree DISASM85 *)
  25.      LABLOAD  =  35; (* STRING in tree DISASM85 *)
  26.      LABSAVE  =  36; (* STRING in tree DISASM85 *)
  27.      LABCLEAR =  38; (* STRING in tree DISASM85 *)
  28.  
  29.      INFOBOX  =   1; (* Dialog *)
  30.      EXITINFO =  15; (* BUTTON in tree INFOBOX *)
  31.  
  32.      SETSTART =   2; (* Dialog *)
  33.      STARTADR =   4; (* FTEXT in tree SETSTART *)
  34.      FILEOFFSET = 5; (* FTEXT in tree SETSTART *)
  35.      ENDADR   =   6; (* FTEXT in tree SETSTART *)
  36.  
  37.      JMPADDR  =   3; (* Dialog *)
  38.      JADDRESS =   4; (* FTEXT in tree JMPADDR *)
  39.      JUMP     =   5; (* BUTTON in tree JMPADDR *)
  40.  
  41.      Resourcefile = 'REASS_85.RSC';               (* Resource-Name       *)
  42.      Maxram       = 8192;                         (* max. 8 KB Code      *)
  43.              
  44. TYPE STRG50  = String[50];                        (* Mnemonics string    *)
  45.      Hexa    = String[4];                         (* Hex-String          *)
  46.      DirStr  = String[105];                       (* Directory path      *)
  47.      NameStr = String[8];
  48.      ExtStr  = String[4];
  49.      Pfad    = String[128];     
  50.      GRECT   = record                             (* for RC_INTERSECT    *)
  51.                     g_x,g_y,g_w,g_h: integer;
  52.        END; 
  53.        Reasmline = record                           (* Reassembler line    *)
  54.           Befehl : STRG50;
  55.           Adr    : WORD;
  56.        END;
  57.           
  58. VAR 
  59.  
  60.      Disasmline   : STRG50;                        (* Mnemonic line      *)
  61.      M            : ARRAY[0..255] OF String[12];   (* Mnemonics          *)
  62.      Codefield    : ARRAY[0..MAXRAM] OF BYTE;      (* Array for code     *)
  63.      Labelfield   : ARRAY[0..65535] OF BYTE;       (* Label flags        *)
  64.      Disasmfield  : ARRAY[0..MAXRAM] OF Reasmline; (* Mnemonics array    *)
  65.      proztype     : Hexa;
  66.      Codefile     : FILE OF BYTE;   
  67.  
  68.      ap_id, error : integer;          (* GEM-Id.                         *)
  69.      tree,mtree   : pointer;          (* Pointer for dialogues, menus    *)
  70.      screen_buffer: pointer;          (* Pointer for window memory       *)
  71.      bufferlen    : longint;          (* window memory length in bytes   *)
  72.        work_in      :    workin_array;     (* GEM arrays                      *)
  73.        work_out     :    workout_array;
  74.        
  75.      psrcMFDB, pdesMFDB : MFDB;       (* MFDB records for VDI 109        *)
  76.      scrnMFDB, buffMFDB : MFDB;       (* MFDB records screen and buffer  *)
  77.      
  78.      startlen     : word;             (* Length of code file       *)
  79.      d_nr         : word;             (* Counter of reassemb. lines*)
  80.      act_d_nr     : word;             (* Start reassemb. line      *)
  81.      number_lines : word;             (* Number of window rows     *)
  82.        Codestart    : word;             (* ORG addresse              *)
  83.        Filelength   : word;             (* file length .BIN          *)
  84.        file_offset  : word;             (* file offset               *)
  85.        
  86.        whandle      :    integer;            (* Window handle             *)
  87.        max_x,max_y  :    integer;            (* max. x and y coordinate   *)
  88.        x,y,w,h      :    integer;            (* Window dimensions         *)
  89.      button       : integer;          (* Alert button              *)
  90.      key          : integer;          (* Event keys                *)
  91.      nachr        : integer;          (* Event message             *)
  92.      typ_nachricht: integer;          (* Event type                *)
  93.      show_mode    : byte;             (* Show address flag         *)
  94.        path         : String;           (* Pathname                  *)
  95.        title        :    String[60];         (* Titel of window           *)
  96.        winfo        : String[60];       (* Info line of window       *)
  97.      lab_clr      : boolean;          (* Clear label list          *)
  98.      ENDE         : boolean;          (* Exit flag                 *)
  99.           
  100. (****************** Procedures / Functions **************************)
  101.                        
  102. function max(a,b:integer):integer;    
  103. (* Maximum of two integer values *)
  104.  
  105. BEGIN
  106.     if a>b then max:=a else max:=b
  107. END;
  108.  
  109. function min(a,b:integer):integer;    
  110.  
  111. (* Minimum of two integer values *)
  112. BEGIN
  113.     if a<b then min:=a else min:=b
  114. END;
  115.  
  116. function hiword(wert:pointer):word;    (* High word of pointer *)
  117. BEGIN
  118.     hiword:=longint(wert) div 65536;
  119. END;
  120.  
  121. function loword(wert:pointer):word;    (* Low word of pointer *)
  122. BEGIN
  123.     loword:=longint(wert) mod 65536;
  124. END;
  125.  
  126. procedure mouse_on;                        (* Mouse on *)
  127. BEGIN
  128.     graf_mouse( M_ON, NIL );
  129. END;
  130.  
  131. procedure mouse_off;                       (* Mouse off *)
  132. BEGIN
  133.     graf_mouse( M_OFF, NIL );
  134. END;
  135.  
  136. (********************** Number of bitplanes *************************)
  137.  
  138. FUNCTION get_bitplanes:integer;  (* Get number of bitplanes *)
  139.  
  140. VAR testout:Workout_array;
  141.  
  142. BEGIN
  143.   vq_extnd(vdiHandle,1,testout);
  144.   get_bitplanes := testout[4];    (* Bitplanes number *)
  145. END;
  146.  
  147. (************************** Dialogue handling ***************************)
  148.  
  149. FUNCTION get_obj_state(t : aestreeptr; o : integer) : integer;
  150. BEGIN
  151.     (* Get status of object *)
  152.     get_obj_state:=t^[o].ob_state;
  153. END;
  154.  
  155. PROCEDURE set_obj_state(t : aestreeptr; o, s : integer);
  156. BEGIN
  157.     (* Change status of object *)
  158.     t^[o].ob_state:=s;
  159. END;
  160.  
  161. (********************** Call dialogue **********************************)
  162.  
  163. FUNCTION hndl_form(obj: integer) : integer;
  164.  
  165.     (* Show dialogbox and get number of selected button *)
  166.  
  167. VAR    answer  : integer;
  168.         x, y, w, h : integer;
  169.  
  170.     PROCEDURE hide_form(obj:integer);
  171.     (* hide dialogue *)
  172.     BEGIN
  173.         form_center(tree, x, y, w, h);
  174.         form_dial(FMD_FINISH, x, y, w, h, x, y, w, h);
  175.     END;
  176.  
  177.     PROCEDURE show_form(obj:integer);
  178.     (* Show dialogue *)
  179.     BEGIN
  180.         form_center(tree, x, y, w, h);
  181.         form_dial(FMD_START, x, y, w, h, x, y, w, h);
  182.         objc_draw(tree, 0, max_depth, x, y, w, h);
  183.     END;
  184.  
  185. BEGIN
  186.     rsrc_gaddr(R_TREE, obj, tree);   (* Get address of diagolue         *)
  187.     graf_mouse( M_OFF, NIL );        (* Mouse off                       *)
  188.     show_form(obj); 
  189.     graf_mouse( M_ON, NIL );         (* Mouse on                        *)
  190.     answer := form_do(tree, 0);      (* Dialogue handling of GEM        *)
  191.     hide_form(obj);                  (* hide dialogue                   *)
  192.                                      (* Deselect exit button            *)
  193.     set_obj_state(tree,answer,get_obj_state(tree, answer) and (not selected));
  194.     hndl_form:=answer;    
  195. END;
  196.  
  197. (*************************** Create 16-bit Hex address ****************)
  198.  
  199. PROCEDURE Makehexadr(VAR hexvalue:Hexa;VAR PC:word);
  200.  
  201. {Hex address as 4 character string}
  202. VAR ZwischenPC:word;
  203.     DivPC     :word;
  204.     Zw1,Zw2,i :word;
  205.  
  206. BEGIN
  207.   ZwischenPC := PC;
  208.   DivPC := 4096;
  209.   FOR i :=1 TO 4 DO
  210.   BEGIN
  211.     Zw1 := ZwischenPC DIV DivPC;
  212.     Zw2 := ZwischenPC MOD DivPC;
  213.     DivPC := DivPC DIV 16;
  214.     hexvalue[i] := chr(Zw1);
  215.     IF ord(hexvalue[i]) <= 9 THEN
  216.     BEGIN
  217.       hexvalue[i] := chr(Zw1+48);
  218.     END
  219.     ELSE
  220.     BEGIN
  221.       hexvalue[i] := chr(Zw1+55);
  222.     END;
  223.     ZwischenPC := Zw2;
  224.   END;
  225.   hexvalue[0] := chr(4);
  226. END;
  227.  
  228. (******************* Label set for reassembler *********************)
  229.  
  230. Procedure Set_Label(i:integer);   (* Put Label in reassembler line *)
  231.  
  232. VAR hexvalue:Hexa;
  233.  
  234. BEGIN
  235.     IF Labelfield[Disasmfield[i].adr] = 1 THEN
  236.     BEGIN
  237.        IF show_mode = 1 THEN
  238.        BEGIN
  239.        Disasmfield[i].befehl[11] := 'L';
  240.        Disasmfield[i].befehl[12] := Disasmfield[i].befehl[3];
  241.        Disasmfield[i].befehl[13] := Disasmfield[i].befehl[4];
  242.        Disasmfield[i].befehl[14] := Disasmfield[i].befehl[5];
  243.        Disasmfield[i].befehl[15] := Disasmfield[i].befehl[6];
  244.        Disasmfield[i].befehl[16] := ':';
  245.      END
  246.      ELSE
  247.      BEGIN
  248.        Makehexadr(hexvalue,Disasmfield[i].adr);
  249.        Disasmfield[i].befehl[2] := 'L';
  250.        Disasmfield[i].befehl[3] := hexvalue[1];
  251.        Disasmfield[i].befehl[4] := hexvalue[2];
  252.        Disasmfield[i].befehl[5] := hexvalue[3];
  253.        Disasmfield[i].befehl[6] := hexvalue[4];
  254.        Disasmfield[i].befehl[7] := ':';
  255.      END;
  256.   END;
  257. END;  
  258.  
  259. (**********************************************************************)
  260.  
  261. procedure set_label_color(i:integer);   (* Label has red color *)
  262.                                         (* Absolute addresses has black color *)
  263. BEGIN
  264.     IF Labelfield[Disasmfield[i].adr] = 1 THEN
  265.     BEGIN
  266.       vst_color(vdiHandle,Red);
  267.     END
  268.     ELSE
  269.     BEGIN
  270.       IF Labelfield[Disasmfield[i].adr] = 2 THEN
  271.       BEGIN
  272.         vst_color(vdiHandle,Black);    
  273.       END;
  274.     END;       
  275. END;
  276.  
  277. (*************************** Define MFDB VDI 109 ******************)
  278.  
  279. procedure Set_MFDB; 
  280.  
  281. VAR xw,yw,bw,hw : integer;
  282.  
  283. BEGIN
  284.   wind_get(0,WF_WORKXYWH,xw,yw,bw,hw);    (* Get screen size *)
  285.     scrnMFDB.fd_addr := NIL;                (* screen MFDB     *)
  286.     scrnMFDB.fd_w := bw;
  287.     scrnMFDB.fd_h := hw;
  288.     scrnMFDB.fd_wdwidth := bw div 16;
  289.     scrnMFDB.fd_stand := 0;
  290.     scrnMFDB.fd_nplanes:=get_bitplanes;     (* Number of bitplanes *)
  291.  
  292.      wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);    
  293.     buffMFDB.fd_addr := screen_buffer;  (* screen_buffer-MFDB *)
  294.     buffMFDB.fd_w := 400;
  295.     buffMFDB.fd_h := hw;
  296.     buffMFDB.fd_wdwidth := 25;;  (* 25 words width = 400/16 *)
  297.     buffMFDB.fd_stand:= 0;
  298.     buffMFDB.fd_nplanes:=get_bitplanes;    
  299. END;
  300.  
  301. (************************** Save window ****************************)
  302.  
  303. Procedure save_window;  (* Save window contents in screenbuffer *)
  304.  
  305. VAR pxyarray    : ARRAY_8;
  306.     xw,yw,bw,hw : integer;
  307. BEGIN
  308.     psrcMFDB := scrnMFDB;     (* Set MFDB records                    *)
  309.     pdesMFDB := buffMFDB;     (* pscrMFDB = source, pdesMFDB = dest. *)
  310.     
  311.     wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);    (* get window work size *)
  312.     pxyarray[0] := xw; 
  313.     pxyarray[1] := yw;
  314.     pxyarray[2] := xw+bw;
  315.     pxyarray[3] := yw+hw;
  316.     pxyarray[4] := 0;
  317.     pxyarray[5] := 0;
  318.     pxyarray[6] := bw;
  319.     pxyarray[7] := hw;                        
  320.   mouse_off;
  321.   vro_cpyfm(vdihandle,3,pxyarray,psrcMFDB,pdesMFDB);  (* VDI 109 *)
  322.   mouse_on;
  323. END;    
  324.  
  325. (************************* Restore window parts ****************)
  326.  
  327. Procedure restore_window(clip:Array_4);  
  328.  
  329. VAR xw,yw,bw,hw: INTEGER;
  330.     pxyarray   : ARRAY_8;
  331.     
  332. BEGIN
  333.     wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);
  334.     psrcMFDB := buffMFDB;     (* Set MFDB records                    *)
  335.     pdesMFDB := scrnMFDB;     (* pscrMFDB = source, pdesMFDB = dest. *)
  336.     pxyarray[0] := clip[0]-xw;
  337.     pxyarray[1] := clip[1]-yw;
  338.     pxyarray[2] := clip[2]-xw;
  339.     pxyarray[3] := clip[3]-yw;                        
  340.     pxyarray[4] := clip[0]; 
  341.     pxyarray[5] := clip[1];
  342.     pxyarray[6] := clip[2];
  343.     pxyarray[7] := clip[3];
  344.   vro_cpyfm(vdiHandle,3,pxyarray,psrcMFDB,pdesMFDB); (* VDI 109 *)
  345. END;    
  346.  
  347. (*************************** Clean window ***************************)
  348.  
  349. PROCEDURE Clear_Window;
  350.  
  351. VAR xw, yw, bw, hw : integer;
  352.     pxyarray : ARRAY_4;
  353.     
  354. BEGIN
  355.     wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw); (* Get window work size *)
  356.     vsf_color(vdiHandle,White);
  357.     vsf_interior(vdiHandle,FIS_SOLID);
  358.     vsf_perimeter(vdiHandle,0);
  359.     pxyarray[0] := xw;
  360.         pxyarray[1] := yw;
  361.         pxyarray[2] := xw+bw-1;
  362.         pxyarray[3] := yw+hw-1;
  363.     mouse_off;
  364.     v_bar(vdiHandle,pxyarray);                 (* Fill window white *)
  365.     mouse_on;  
  366.     save_window;
  367. END;
  368.  
  369. (**************************** Open window ***************************)
  370.  
  371. procedure open_window;
  372.  
  373. var    wx,wy,wb,wh : integer;
  374.     
  375. BEGIN
  376.       wind_get(0,WF_WORKXYWH,    wx, wy, wb, wh);   (* Get screen size in pixel *)
  377.       max_x := wb;
  378.       max_y := wh;
  379.         whandle:=wind_create(NAME or CLOSER or MOVER or VSLIDE or INFO or
  380.                               UPARROW or DNARROW or SIZER or LFARROW or
  381.                               RTARROW,((wb-400) div 2),0,400,max_y);
  382.         if whandle<=0 then
  383.               exit;
  384.         title :=' Reassembler INTEL 8080/85 '#0;
  385.         winfo :='   Address  Label   Code      Mnemonics'#0;
  386.         wind_set(whandle,WF_NAME,hiword(@title[1]),loword(@title[1]),0,0);
  387.       wind_set(whandle,WF_INFO,hiword(@winfo[1]),loword(@winfo[1]),0,0);
  388.         mouse_off;
  389.         wind_open(whandle,((wb-400) div 2),wy,400,max_y); (* Open window *)
  390.     Set_MFDB;         (* MFDB init          *)
  391.     Clear_window;     (* Fill window whiten *)
  392.         mouse_on;
  393. END;
  394.  
  395. (************************ Line scrolling *****************************)
  396.  
  397. procedure scroll_line_down;  (* Arrow down *)
  398.  
  399. VAR pxyarray    : ARRAY_8;
  400.     pxyarray1   : ARRAY_4;
  401.     xw,yw,bw,hw : integer;
  402.     slider_pos  : integer;    
  403.  
  404. BEGIN
  405.   IF act_d_nr < (d_nr - number_lines + 1 ) THEN
  406.   BEGIN
  407.       psrcMFDB := buffMFDB;     (* MFDB set                            *)
  408.       pdesMFDB := scrnMFDB;     (* pscrMFDB = source, pdesMFDB = dest. *)
  409.       wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);    
  410.       pxyarray[0] := 0; 
  411.       pxyarray[1] := 16;
  412.       pxyarray[2] := bw;
  413.       pxyarray[3] := hw-2;
  414.       pxyarray[4] := xw;
  415.       pxyarray[5] := yw;
  416.       pxyarray[6] := xw+bw;
  417.       pxyarray[7] := yw+hw-2;                        
  418.     mouse_off;
  419.     wind_set(whandle,WF_TOP,0,0,0,0); (* in front for MultiTOS *)
  420.     vro_cpyfm(vdihandle,3,pxyarray,psrcMFDB,pdesMFDB);  (* VDI 109 *)
  421.     pxyarray1[0] := xw;
  422.       pxyarray1[1] := yw+hw-17;     (* clear last line *)
  423.       pxyarray1[2] := xw+bw-1;
  424.       pxyarray1[3] := yw+hw-1;
  425.     v_bar(vdiHandle,pxyarray1);
  426.     inc(act_d_nr);
  427.     vst_color(vdiHandle,Blue);             (* Set line color *)
  428.       Set_label_color(act_d_nr+number_lines-2);
  429.       v_gtext(vdiHandle,xw,yw+16*(number_lines-1),'  '+Disasmfield[act_d_nr+number_lines-2].befehl);    
  430.     vst_color(vdiHandle,Black);
  431.     slider_pos := trunc(1000.0 * ((act_d_nr-1) / (d_nr-number_lines-1+0.1)));
  432.     wind_set(whandle,WF_VSLIDE,slider_pos,0,0,0); (* Get slider values *)
  433.     save_window;
  434.     mouse_on;
  435.   END;  
  436. END;
  437.  
  438. procedure scroll_line_up;   (* Arrow up *)
  439.  
  440. VAR pxyarray    : ARRAY_8;
  441.     pxyarray1   : ARRAY_4;
  442.     xw,yw,bw,hw : integer;
  443.     slider_pos  : integer;
  444.  
  445. BEGIN
  446.   IF act_d_nr > 1 THEN
  447.   BEGIN
  448.       psrcMFDB := buffMFDB;     (* MFDB set                            *)
  449.       pdesMFDB := scrnMFDB;     (* pscrMFDB = source, pdesMFDB = dest. *)
  450.       wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);    
  451.       pxyarray[0] := 0; 
  452.       pxyarray[1] := 0;
  453.       pxyarray[2] := bw;
  454.       pxyarray[3] := hw-15;
  455.       pxyarray[4] := xw;
  456.       pxyarray[5] := yw+16;
  457.       pxyarray[6] := xw+bw;
  458.       pxyarray[7] := yw+hw-15;                        
  459.     mouse_off;
  460.     wind_set(whandle,WF_TOP,0,0,0,0);  (* for MultiTOS *)
  461.     vro_cpyfm(vdihandle,3,pxyarray,psrcMFDB,pdesMFDB);  (* VDI 109 *)
  462.     pxyarray1[0] := xw;
  463.       pxyarray1[1] := yw;           (* Clear top line *)
  464.       pxyarray1[2] := xw+bw-1;
  465.       pxyarray1[3] := yw+16;
  466.     v_bar(vdiHandle,pxyarray1);
  467.     dec(act_d_nr);
  468.     vst_color(vdiHandle,Blue);    (* Set line color *)
  469.       Set_label_color(act_d_nr);
  470.       v_gtext(vdiHandle,xw,yw+16,'  '+Disasmfield[act_d_nr].befehl);    
  471.     vst_color(vdiHandle,Black);
  472.     slider_pos := trunc(1000.0 * ((act_d_nr-1) / (d_nr-number_lines-1+0.1)));
  473.     wind_set(whandle,WF_VSLIDE,slider_pos,0,0,0); (* Get slider values *)
  474.     save_window;     
  475.     mouse_on;
  476.   END;  
  477. END;
  478.  
  479. (*************************** Set slider move ****************)
  480.  
  481.  
  482. Procedure Slider_move(slider_pos:integer);   (* Slider scrolling *)
  483.  
  484. VAR i,xw,yw,bw,hw : integer;
  485.     start_x,start_y : integer;
  486.     slider_v : real;
  487.     
  488. BEGIN
  489.   wind_set(whandle,WF_TOP,0,0,0,0);
  490.   IF (d_nr >= number_lines-1) and (slider_pos > 0) THEN
  491.   BEGIN
  492.     act_d_nr := d_nr-number_lines;
  493.     slider_v := slider_pos/1000+0.00001;
  494.     act_d_nr := trunc(slider_v * act_d_nr)+1;
  495.     IF act_d_nr < 1 THEN
  496.     BEGIN
  497.       act_d_nr := 1;
  498.     END;  
  499.     wind_set(whandle,WF_VSLIDE,slider_pos,0,0,0); (* Get slider value *)
  500.   END
  501.   ELSE
  502.   BEGIN
  503.     act_d_nr := 1;
  504.     wind_set(whandle,WF_VSLIDE,0,0,0,0);
  505.   END;
  506.   Clear_Window;
  507.     wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);  
  508.     i := act_d_nr;
  509.     start_x := xw +16;
  510.     start_y := yw + 16;
  511.   vst_color(vdiHandle,Blue);
  512.     WHILE (i <= d_nr) and (start_y <= yw + hw) DO  (* Set line color *)
  513.   BEGIN
  514.      Set_label_color(i);
  515.      v_gtext(vdiHandle,start_x,start_y,Disasmfield[i].befehl);
  516.      inc(i);
  517.      start_y := start_y + 16;
  518.        vst_color(vdiHandle,Blue);
  519.   END;  
  520.   vst_color(vdiHandle,Black);
  521.   save_window;
  522. END;
  523.  
  524. (*************** rc_intersect for window redraw ***********************)
  525.  
  526. function rc_intersect(var r1,r2: GRECT): boolean;    
  527.  
  528. var    x,y,w,h:    integer;
  529.  
  530. BEGIN
  531.     x:=max(r2.g_x,r1.g_x);
  532.     y:=max(r2.g_y,r1.g_y);
  533.     w:=min(r2.g_x+r2.g_w,r1.g_x+r1.g_w);
  534.     h:=min(r2.g_y+r2.g_h,r1.g_y+r1.g_h);
  535.     r2.g_x:=x;
  536.     r2.g_y:=y;
  537.     r2.g_w:=w-x;
  538.     r2.g_h:=h-y;
  539.     if (w>x) and (h>y) then
  540.         rc_intersect:=true
  541.     else
  542.         rc_intersect:=false;
  543. END;
  544.  
  545. (********************* Redraw routine for reassembler window **********)
  546.  
  547. procedure redrawwindow;
  548.  
  549. var    box,work : GRECT;
  550.       clip     : Array_4;
  551.     pxyarray : Array_4;
  552.  
  553. BEGIN
  554.   mouse_off;
  555.   wind_update(BEG_UPDATE);
  556.     if whandle<=0 then
  557.         exit;
  558.     wind_get(whandle,WF_WORKXYWH,work.g_x,work.g_y,work.g_w,work.g_h);
  559.     wind_get(whandle,WF_FIRSTXYWH,box.g_x,box.g_y,box.g_w,box.g_h);
  560.     while (box.g_w>0) and (box.g_h>0) do
  561.     BEGIN
  562.         if rc_intersect(work,box) then
  563.         BEGIN
  564.             clip[0]:=box.g_x; clip[1]:=box.g_y;
  565.             clip[2]:=box.g_x+box.g_w-1; clip[3]:=box.g_y+box.g_h-1;
  566.             vs_clip(vdiHandle,1,clip);
  567.       restore_window(clip);
  568.         END;
  569.         wind_get(whandle,WF_NEXTXYWH,box.g_x,box.g_y,box.g_w,box.g_h);
  570.     END;
  571.     wind_update(END_UPDATE);
  572.   mouse_on;
  573. END;
  574.  
  575. (************************************************************************)
  576.  
  577. Procedure Hex_in_Word(VAR start:WORD;hexstr:Hexa);  
  578.  
  579. VAR i,divfaktor: word;  (* Hex string in 16-bit word *)
  580.     hex : ARRAY[1..4] OF byte;
  581.     
  582. BEGIN
  583.   start := 0;
  584.   divfaktor := 4096;
  585.   WHILE length(hexstr) < 4 DO
  586.   BEGIN
  587.     hexstr := '0'+hexstr;
  588.   END;   
  589.   FOR i := 1 TO 4 DO
  590.   BEGIN
  591.     IF hexstr[i] <= '9' THEN
  592.     BEGIN
  593.       hex[i] := ord(hexstr[i])-48;     (* 0 - 9 *)
  594.     END
  595.     ELSE        
  596.     BEGIN
  597.       IF upcase(hexstr[i]) <= 'F' THEN
  598.       BEGIN
  599.         hex[i] := ord(upcase(hexstr[i]))-55;   (* A - F *)
  600.       END;
  601.     END;
  602.     start := start + hex[i]*divfaktor;
  603.     divfaktor := divfaktor DIV 16;
  604.   END;
  605. END;    
  606.  
  607. (**************************** File selector ****************************)
  608.  
  609.  
  610. Procedure SelectFile(VAR selectname:pfad;ext:Extstr);         
  611.  
  612. VAR
  613.   filename   : String;              (* Path/file name *)
  614.     dir        : DirStr;     
  615.     name       : NameStr;
  616.     exitButton : Integer;
  617.     path1      : String;
  618.     
  619. BEGIN
  620.  
  621.   path1 := concat(path,ext);
  622.     filename := '';
  623.     name := '';
  624.     fsel_input( path1, filename, exitButton );  (* Call file selector *)
  625.     IF exitButton = 0 then
  626.         selectname := ''
  627.     ELSE
  628.     BEGIN
  629.         FSplit( path1, dir, name, ext );     (* Separation of path *)
  630.         selectname := dir + filename;
  631.         path := concat(dir,'*.');
  632.     END;
  633. END;
  634.  
  635. (**************************** Load binary code *************************)
  636.  
  637. PROCEDURE Laden;
  638.  
  639. VAR name    : pfad; 
  640.     len_str : string[4];
  641.  
  642. BEGIN
  643.   SelectFile(name,'BIN');
  644.   IF name <> '' THEN
  645.   BEGIN
  646.     d_nr := 1;
  647.     act_d_nr := 1;
  648.     ASSIGN(Codefile,name);              (* Assign filename *)
  649.     RESET(Codefile);
  650.     filelength := FileSize(Codefile);   (* Get file size *)
  651.     IF (filelength <= MAXRAM) THEN
  652.     BEGIN
  653.       blockread(Codefile,Codefield,filelength); (* block load       *)
  654.       rsrc_gaddr(R_TREE, SETSTART, tree);       (* dialogue address *)   
  655.       IF (filelength < 10) THEN
  656.       BEGIN
  657.         str(filelength:1,len_str);
  658.       END;
  659.       IF (filelength >= 10) and (filelength < 100) THEN
  660.       BEGIN
  661.         str(filelength:2,len_str);
  662.       END;      
  663.       IF (filelength >= 100) and (filelength < 1000) THEN
  664.       BEGIN
  665.         str(filelength:3,len_str);
  666.       END;      
  667.       IF (filelength >= 1000) THEN
  668.       BEGIN
  669.         str(filelength:4,len_str);
  670.       END;
  671.       SetPtext(tree,ENDADR,len_str);  (* Filelength for dialogue *) 
  672.       startlen := filelength;        
  673.       Clear_Window;
  674.       wind_set(whandle,WF_VSLIDE,0,0,0,0); 
  675.       close(codefile);
  676.     END
  677.     ELSE
  678.     BEGIN
  679.       form_alert(1,'[1][ File size > 8192 Bytes ! ][ Stop ]');
  680.       close(codefile);
  681.     END;
  682.   END;  
  683. END;
  684.  
  685. (*************************** Create 8-bit Hex value *********************)
  686.  
  687. PROCEDURE Makehexbyte(VAR hexvalue:Hexa;Cbyte:byte);
  688.  
  689. {Hex byte to string}
  690. VAR
  691.     DivPC     :byte;
  692.     Zw1,Zw2,i :byte;
  693.  
  694. BEGIN
  695.   DivPC := 16;
  696.   FOR i :=1 TO 2 DO
  697.   BEGIN
  698.     Zw1 := CByte DIV DivPC;
  699.     Zw2 := CByte MOD DivPC;
  700.     DivPC := DivPC DIV 16;
  701.     hexvalue[i] := chr(Zw1);
  702.     IF ord(hexvalue[i]) <= 9 THEN
  703.     BEGIN
  704.       hexvalue[i] := chr(Zw1+48);
  705.     END
  706.     ELSE
  707.     BEGIN
  708.       hexvalue[i] := chr(Zw1+55);
  709.     END;
  710.     CByte := Zw2;
  711.   END;
  712.   hexvalue[0] := chr(2);
  713. END;
  714.  
  715. (********************* Concat mnemonics *************************)
  716.  
  717. PROCEDURE GETINSTRUCTION(VAR Instcode:STRG50;VAR PC:word);
  718.  
  719. VAR
  720. Codebyte : byte;
  721. Abs_adr  : word;
  722. Codename,name2 : STRING[18];
  723. Codechar : CHAR;
  724. Hexbyte  : Hexa;
  725. Hexbyt2  : Hexa;
  726.  
  727. BEGIN
  728.   Codebyte := Codefield[PC+file_offset];
  729.   Codename := M[Codebyte];
  730.   Codechar := Codename[1];
  731.   Makehexbyte(Hexbyte,Codebyte);
  732.   Instcode := concat(Hexbyte,' ');
  733.   CASE Codechar OF
  734.     '0' : BEGIN    {Implied Adressierung}
  735.             Name2 := copy(Codename,2,length(Codename)-1);
  736.             Instcode := Concat(Instcode,'       ',Name2);
  737.           END;
  738.     '1' : BEGIN    {Absolute Adressierung}
  739.             IF Labelfield[PC+Codestart] <> 1 THEN
  740.             BEGIN
  741.                Labelfield[PC+Codestart] := 2;  (* Mark absolute address *)  
  742.             END;     
  743.             Inc(PC);
  744.             Codebyte := Codefield[PC+file_offset];            
  745.             Abs_adr := Codebyte + 256 * Codefield[PC+1+file_offset];
  746.             Labelfield[Abs_Adr] := 1;       (* Mark label *)
  747.             Makehexbyte(Hexbyt2,Codebyte);
  748.             Inc(PC); 
  749.             Codebyte := Codefield[PC+file_offset];
  750.             Makehexbyte(Hexbyte,Codebyte);
  751.             Instcode := Concat(Instcode,Hexbyt2,' ',Hexbyte,'  ');
  752.             Name2 := copy(Codename,2,length(Codename)-1);
  753.             Instcode := Concat(Instcode,Name2);
  754.             Instcode := Concat(Instcode,'L',hexbyte,hexbyt2);
  755.           END;
  756.     '2' : BEGIN     {Immediate adress}
  757.             Inc(PC);
  758.             Codebyte := Codefield[PC+file_offset];
  759.             Makehexbyte(Hexbyte,Codebyte);
  760.             Instcode := Concat(Instcode,Hexbyte,'     ');
  761.             Name2 := copy(Codename,2,length(Codename)-1);
  762.             Instcode := Concat(Instcode,Name2);
  763.             IF hexbyte[1] > '9' THEN
  764.             BEGIN
  765.               Instcode := Concat(Instcode,'0');
  766.             END;
  767.             Instcode := Concat(Instcode,Hexbyte,'H');
  768.           END;
  769.     '3' : BEGIN      {16-bit Immediate value}
  770.             Inc(PC);
  771.             Codebyte := Codefield[PC+file_offset];
  772.             Makehexbyte(Hexbyt2,Codebyte);
  773.             Inc(PC);
  774.             Codebyte := Codefield[PC+file_offset];
  775.             Makehexbyte(Hexbyte,Codebyte);
  776.             Instcode := Concat(Instcode,Hexbyt2,' ',Hexbyte,'  ');
  777.             Name2 := copy(Codename,2,length(Codename)-1);
  778.             Instcode := Concat(Instcode,Name2);
  779.             IF hexbyte[1] > '9' THEN
  780.             BEGIN
  781.               Instcode := Concat(Instcode,'0');
  782.             END;   
  783.             Instcode := Concat(Instcode,hexbyte,hexbyt2,'H');
  784.           END;
  785.     '4' : BEGIN       {Unknown code DATA-statement}
  786.             Name2 := copy(Codename,2,length(Codename)-1);
  787.             Instcode := Concat(Instcode,'       ',Name2);
  788.             IF hexbyte[1] > '9' THEN
  789.             BEGIN
  790.               Instcode := Concat(Instcode,'0');
  791.             END;
  792.             Instcode := Concat(Instcode,hexbyte,'H');
  793.           END;
  794.      END;
  795.      Inc(PC);
  796. END;
  797.  
  798. (*********************** Concat mnemonic + address ********************)
  799.  
  800. PROCEDURE BEFEHL(VAR Mnemonic:STRG50;VAR PC:word);
  801.  
  802. VAR
  803. Hexadr : Hexa;
  804. Inst   : STRG50;
  805. tempPC : word;
  806.  
  807. BEGIN
  808.   Inst := '';
  809.   tempPC := PC + codestart;
  810.   Makehexadr(Hexadr,tempPC);
  811.   Mnemonic := Concat(' $',Hexadr,'            ');
  812.   Getinstruction(Inst,PC);
  813.   Mnemonic := Concat(Mnemonic,Inst);
  814. END;
  815.  
  816. (********************** Reassembler call ******************************)
  817.  
  818. Procedure Display;
  819.  
  820. VAR PC                : word;
  821.     xw, yw, bw, hw    : integer;
  822.     start_x, start_y  : integer;
  823.     start_pc,tempPC   : word;
  824.     clip              : ARRAY_4;
  825.     Labelstr          : String[6];
  826.     i                 : word;
  827.     
  828. BEGIN
  829.   IF Filelength <> 0 THEN
  830.   BEGIN
  831.     PC := 0;
  832.     menu_icheck(mtree,FILEOUT,0);  (* File flag off         *)
  833.     menu_icheck(mtree,PRTOUT,0);   (* Printer flag off      *)    
  834.     menu_icheck(mtree,DISPOUT,1);  (* Screen flag on        *)  
  835.       IF file_offset > filelength THEN
  836.       BEGIN
  837.       form_alert(1,'[1][ File offset > file size ! | Offset set to 0 ][ Hmmh ]');
  838.       rsrc_gaddr(R_TREE, SETSTART, tree);  (* Get dialogue address *)
  839.       SetPtext(tree,FILEOFFSET,'0000');  
  840.         file_offset := 0;
  841.       END;  
  842.       wind_set(whandle,WF_VSLIDE,0,0,0,0);
  843.       Clear_window;                               (* Clear window *)
  844.       wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);
  845.       clip[0]:= xw; clip[1]:=yw;
  846.         clip[2]:= xw+bw-1; clip[3]:= yw+hw-1;
  847.         vs_clip(vdiHandle,1,clip); 
  848.       start_x := xw + 16;
  849.       start_y := yw + 16;
  850.       Clear_Window;
  851.       v_gtext(vdiHandle,start_x,start_y,'Reassembler works..., please wait');
  852.       v_gtext(vdiHandle,start_x,start_y+16,'       Motorola 680xx for ever');
  853.     FOR i:=1 To filelength+1 DO
  854.     BEGIN
  855.         Disasmfield[i].adr := 0;       (* Clear Reassembler array *)
  856.         Disasmfield[i].befehl := '';
  857.     END;
  858.     IF lab_clr THEN           (* Clear label list ? *)
  859.     BEGIN
  860.       FOR i:= 0 TO 65535 DO
  861.       BEGIN
  862.         Labelfield[i] := 0; (* Clear label list *)
  863.       END;
  864.     END;  
  865.       d_nr := 1;
  866.       act_d_nr := 1;
  867.     Start_PC := PC + Codestart;          (* Store start address *)
  868.       WHILE (PC+codestart <= 65535) and (PC+codestart <= start_pc+startlen) DO      
  869.       BEGIN
  870.         tempPC := PC + codestart;
  871.         Disasmfield[d_nr].adr := tempPC;    (* Main reassembler loop *)
  872.         BEFEHL(Disasmline,PC);
  873.       Disasmfield[d_nr].befehl := Disasmline;
  874.       IF (show_mode =  0) THEN   (* Show address/code *)
  875.       BEGIN
  876.         Disasmfield[d_nr].befehl := copy(Disasmfield[d_nr].befehl,28,length(Disasmfield[d_nr].befehl)-27);
  877.         Disasmfield[d_nr].befehl := concat('       ',Disasmfield[d_nr].befehl);
  878.       END;         
  879.         inc(d_nr);
  880.       END;
  881.       FOR i :=1 TO d_nr DO
  882.       BEGIN
  883.           Set_Label(i);    (* Insert label *)
  884.     END;
  885.       Clear_Window;
  886.       i := 1;
  887.       mouse_off;
  888.       wind_update(BEG_UPDATE);
  889.       vst_color(vdiHandle,Blue);
  890.       WHILE (i <= d_nr) and (start_y <= yw + hw) DO   (* window print loop *)
  891.       BEGIN
  892.           Set_label_color(i);
  893.         v_gtext(vdiHandle,start_x,start_y,Disasmfield[i].befehl);
  894.         inc(i);
  895.         number_lines := i;
  896.         start_y := start_y + 16;
  897.       vst_color(vdiHandle,Blue);
  898.       END;  
  899.       wind_update(END_UPDATE);
  900.       mouse_on;
  901.       vst_color(vdiHandle,Black);
  902.       save_window;
  903.   END
  904.   ELSE 
  905.   BEGIN
  906.     form_alert(1,'[1][ No binary code | found ! ][ Hmmh ]');
  907.   END;
  908. END;
  909.  
  910. (**************************** Labeltabelle laden ***********************)
  911.  
  912. PROCEDURE Label_laden;
  913.  
  914. VAR name       : pfad; 
  915.     len_str    : string[4];
  916.     lablength  : longint;
  917.     Labfile : FILE OF BYTE;
  918.     
  919. (* Load of 64 KB Label list from disc *)
  920.  
  921. BEGIN
  922.   SelectFile(name,'LAB');
  923.   IF name <> '' THEN
  924.   BEGIN
  925.     ASSIGN(Labfile,name);               (* Assign file *)
  926.     RESET(Labfile);    
  927.     lablength := FileSize(Labfile);     (* Get file size *)
  928.     IF (lablength = 65536) THEN
  929.     BEGIN
  930.       blockread(Labfile,Labelfield,lablength);  (* Block load                 *)
  931.       menu_icheck(mtree,LABCLEAR,0);            (* Disable label list clear   *)
  932.       lab_clr := false;
  933.       close(Labfile);
  934.       IF filelength <> 0 THEN
  935.       BEGIN
  936.         Display;
  937.       END;  
  938.     END
  939.     ELSE
  940.     BEGIN
  941.       form_alert(1,'[1][ No label list (64 KB) ! ][ Hmmh ]');
  942.       close(Labfile);
  943.     END;
  944.   END;  
  945. END;
  946.  
  947. (**************************** Save label list ***********************)
  948.  
  949. PROCEDURE Label_sichern;
  950.  
  951. VAR name    : pfad; 
  952.     len_str : string[4];
  953.     Labfile : FILE OF BYTE;
  954.     
  955. (* Save 64 KB label list on disc *)
  956.  
  957. BEGIN
  958.   IF filelength <> 0 THEN
  959.   BEGIN
  960.       SelectFile(name,'LAB');
  961.       IF name <> '' THEN
  962.       BEGIN
  963.         ASSIGN(Labfile,name);                   (* Assign filename *)
  964.         REWRITE(Labfile);                       (* Write file      *)
  965.         blockwrite(Labfile,Labelfield,65536);   (* Block write     *)
  966.         close(Labfile);
  967.       END;  
  968.     END
  969.     ELSE
  970.     BEGIN
  971.     form_alert(1,'[1][ Please reassemble code !][ Okay ]');
  972.     END;  
  973. END;
  974.  
  975. (*************************** Clear label list automatically ***********)
  976.  
  977. Procedure Lab_clear;
  978.  
  979. BEGIN
  980.   IF filelength <> 0 THEN
  981.   BEGIN
  982.    IF lab_clr THEN
  983.    BEGIN
  984.      menu_icheck(mtree,LABCLEAR,0);     (* disable label list clear *)
  985.      lab_clr := false;
  986.    END
  987.    ELSE
  988.    BEGIN
  989.      menu_icheck(mtree,LABCLEAR,1);     (* enable label list clear *)
  990.      lab_clr := true;
  991.    END;
  992.     END
  993.     ELSE
  994.     BEGIN
  995.       form_alert(1,'[1][ Please reassemble code !][ Okay ]');
  996.     END;     
  997. END;
  998.  
  999. (*************** Dialog für Adresseingabe bearbeiten *******************)
  1000.  
  1001. PROCEDURE ADDRESS;              (* Get Hex numbers of dialogue *)
  1002.                                 (* and reassemble code         *)
  1003. VAR res : integer;
  1004.     start     : Word;
  1005.     start_str : Hexa;
  1006.     len_str   : Hexa;
  1007.     off_str   : Hexa;
  1008.     
  1009. BEGIN
  1010.   hndl_form(SETSTART);
  1011.   rsrc_gaddr(R_TREE, SETSTART, tree);  (* Get dialogue address    *)
  1012.   GetPtext(tree,STARTADR,start_str);   (* Get edit dialogue lines *)
  1013.   GetPtext(tree,ENDADR,len_str);
  1014.   GetPtext(tree,FILEOFFSET,off_str);  
  1015.   WHILE length(start_str) < 4 DO (* Hex to 16-bit word *)
  1016.   BEGIN
  1017.     start_str := '0' + start_str;
  1018.   END;
  1019.   WHILE length(off_str) < 4 DO   
  1020.   BEGIN
  1021.     off_str := '0' + off_str;
  1022.   END;  
  1023.   val(len_str,startlen,res);     (* String in number       *)
  1024.   IF res <> 0 THEN               (* Check illegal input    *)
  1025.   BEGIN
  1026.     codestart := 0;
  1027.     SetPtext(tree,STARTADR,'1024');
  1028.   END;  
  1029.   Hex_in_Word(start,start_str);     (* Hex in Word *)
  1030.   codestart := start;
  1031.   Hex_in_Word(start,off_str);       (* Hex in Word *)
  1032.   file_offset := start;
  1033.   Display;
  1034. END;
  1035.  
  1036. (*************** Dialog für Adresseingabe bearbeiten *******************)
  1037.  
  1038. PROCEDURE JUMP_ADDRESS;         (* Get hex address from dialogue *)
  1039.                                 (* and reassemble code           *)
  1040. VAR res,j       : Integer;
  1041.     start       : Word;
  1042.     start_str   : Hexa;
  1043.     exitbutton  : Integer;
  1044.     start_x,start_y : Integer;
  1045.     xw,yw,bw,hw :Integer;
  1046.     
  1047. BEGIN
  1048.   exitbutton := hndl_form(JMPADDR);
  1049.   IF exitbutton = JUMP THEN
  1050.   BEGIN
  1051.     rsrc_gaddr(R_TREE, JMPADDR, tree);   (* Get dialogue address *)
  1052.     GetPtext(tree,JADDRESS,start_str);   (* read edit lines      *)
  1053.     WHILE length(start_str) < 4 DO 
  1054.     BEGIN
  1055.       start_str := '0' + start_str;
  1056.     END;
  1057.     Hex_in_Word(start,start_str);     (* Hex in Word *)
  1058.     IF d_nr > 1 THEN
  1059.     BEGIN
  1060.       IF (disasmfield[1].adr <= start) and (disasmfield[d_nr-1].adr >= start) THEN
  1061.       BEGIN
  1062.         j := 1;
  1063.         WHILE (disasmfield[j].adr <= start) DO
  1064.         BEGIN
  1065.           inc(j); 
  1066.         END;
  1067.         IF (disasmfield[j].adr = start) THEN
  1068.         BEGIN
  1069.            act_d_nr := j;
  1070.         END
  1071.         ELSE
  1072.         BEGIN
  1073.            act_d_nr := j - 1;         
  1074.         END;
  1075.       END;
  1076.     END;
  1077.     wind_get(whandle,WF_WORKXYWH,xw,yw,bw,hw);
  1078.     start_x := xw + 16;
  1079.     start_y := yw + 16;    
  1080.       Clear_Window;
  1081.       mouse_off;
  1082.       wind_update(BEG_UPDATE);
  1083.       vst_color(vdiHandle,Blue);
  1084.       j := act_d_nr;
  1085.       WHILE (j <= d_nr) and (start_y <= yw + hw) DO   (* window print loop *)
  1086.       BEGIN
  1087.           Set_label_color(j);
  1088.         v_gtext(vdiHandle,start_x,start_y,Disasmfield[j].befehl);
  1089.         inc(j);
  1090.         start_y := start_y + 16;
  1091.       vst_color(vdiHandle,Blue);
  1092.       END;  
  1093.       wind_update(END_UPDATE);
  1094.       mouse_on;
  1095.       vst_color(vdiHandle,Black);
  1096.       save_window;
  1097.     END;  
  1098. END;
  1099.  
  1100. (********************* File-/printer output ************************)
  1101.  
  1102. PROCEDURE ASCIIOUT(VAR kanal:text;printflag:byte);   
  1103.  
  1104. VAR j: integer;
  1105.     c_start, c_end : Hexa;
  1106.     
  1107. (* Output 60 rows/page in file or on printer *)
  1108.  
  1109. BEGIN                         (* Printer/file output *)
  1110.   IF d_nr > 1  THEN           
  1111.   BEGIN                        
  1112.     IF show_mode = 1 THEN
  1113.     BEGIN                            
  1114.       c_start := copy(disasmfield[1].befehl,3,4);
  1115.       c_end   := copy(disasmfield[d_nr-1].befehl,3,4);
  1116.     END
  1117.     ELSE
  1118.     BEGIN
  1119.         Makehexadr(c_start,Disasmfield[1].adr); 
  1120.         Makehexadr(c_end,Disasmfield[d_nr-1].adr);     
  1121.     END;
  1122.     rewrite(kanal);           (* Schreibkanal öffnen                *)
  1123.     writeln(kanal,'   ; INTEL 8080/85 REASSEMBLER by Jens Schulz 1994');
  1124.     writeln(kanal,'   ; for ATARI ST/TT/FALCON computers');
  1125.     writeln(kanal);
  1126.     writeln(kanal,'   ; Codestart : $',c_start,'   Codeend : $',c_end);
  1127.     writeln(kanal);
  1128.     FOR j := 1 TO d_nr DO
  1129.     BEGIN
  1130.       writeln(kanal,'  ',Disasmfield[j].Befehl);
  1131.       IF (j mod 60 = 0) THEN  (* Formfeed *)
  1132.       BEGIN
  1133.         IF printflag = 1 THEN
  1134.         BEGIN
  1135.           writeln(kanal,chr(12));  (* Formfeed *)
  1136.         END;
  1137.       END;  
  1138.     END;
  1139.     close(kanal);                    (* close output stream   *)
  1140.     IF printflag = 0 THEN
  1141.     BEGIN
  1142.       menu_icheck(mtree,FILEOUT,1); 
  1143.       menu_icheck(mtree,PRTOUT,0);   
  1144.       menu_icheck(mtree,DISPOUT,0);   
  1145.     END
  1146.     ELSE
  1147.     BEGIN
  1148.       menu_icheck(mtree,PRTOUT,1);  
  1149.       menu_icheck(mtree,DISPOUT,0); 
  1150.       menu_icheck(mtree,FILEOUT,0);       
  1151.     END;      
  1152.   END
  1153.   ELSE
  1154.   BEGIN
  1155.       form_alert(1,'[1][ Please reassemble code !][ Okay ]');  
  1156.   END;
  1157. END;
  1158.  
  1159. (***************************** File output ***************************)
  1160.  
  1161. PROCEDURE DATEI;
  1162.  
  1163. {Reassemble on disc as ASCII file }
  1164.  
  1165. VAR kanal : text;
  1166.     name  : pfad;
  1167.  
  1168. BEGIN
  1169.   IF d_nr > 1 THEN
  1170.   BEGIN
  1171.     SelectFile(name,'ASC');
  1172.     IF name <> '' THEN    
  1173.     BEGIN
  1174.       assign(kanal,name);
  1175.       asciiout(kanal,0);
  1176.     END;  
  1177.   END
  1178.   ELSE
  1179.   BEGIN
  1180.       form_alert(1,'[1][ Please reassemble code !][ Okay ]');  
  1181.   END;
  1182. END;
  1183.  
  1184. (************************** Printer output *****************************)
  1185.  
  1186. PROCEDURE DRUCKER;
  1187.  
  1188. VAR kanal : text;        
  1189.  
  1190. BEGIN
  1191.   assign(kanal,'PRN');
  1192.   ASCIIOUT(kanal,1);
  1193. END;
  1194.  
  1195. (********************** Toggle 8080/8085 mode *******************)
  1196.  
  1197. PROCEDURE MODUS(mode:byte);
  1198.  
  1199. { 8085 has 2 new machine commands (SIM and RIM) }
  1200.  
  1201. BEGIN
  1202.   IF mode = 0 THEN
  1203.   BEGIN
  1204.     proztype := '8080';
  1205.     m[32] := '4DEFB ';
  1206.     m[48] := '4DEFB ';
  1207.     menu_icheck(mtree,SET8080,1);       
  1208.     menu_icheck(mtree,SET8085,0);
  1209.   END
  1210.   ELSE
  1211.   BEGIN
  1212.     proztype := '8085';
  1213.     m[32] := '0RIM';
  1214.     m[48] := '0SIM';
  1215.     menu_icheck(mtree,SET8085,1);       
  1216.     menu_icheck(mtree,SET8080,0);    
  1217.   END;
  1218. END;
  1219.  
  1220. (******************** Show address/code ******************)
  1221.  
  1222. Procedure Objcode_show;
  1223.  
  1224. BEGIN
  1225.   IF show_mode = 0 THEN   
  1226.   BEGIN
  1227.     show_mode := 1;
  1228.     menu_icheck(mtree,ADRCODE,1);
  1229.         winfo :='   Address  Label   Code      Mnemonics'#0;
  1230.       wind_set(whandle,WF_INFO,hiword(@winfo[1]),loword(@winfo[1]),0,0)
  1231.  END     
  1232.  ELSE     
  1233.  BEGIN
  1234.     show_mode := 0;
  1235.     menu_icheck(mtree,ADRCODE,0);
  1236.         winfo :='  Label   Mnemonics'#0;
  1237.       wind_set(whandle,WF_INFO,hiword(@winfo[1]),loword(@winfo[1]),0,0);
  1238.  END;
  1239.  Display;
  1240. END;
  1241.  
  1242. (*****  Mnemonic table for code $00 - $FF *****)
  1243.  
  1244. PROCEDURE LOADDATA ;
  1245.  
  1246. { 1st character :  Address mode
  1247.                0 = Implied addressing
  1248.                1 = Absolute addressing
  1249.                2 = Immediate addressing 8- bit constant
  1250.                3 = Immediate addressing 16-bit constant
  1251.                4 = DATA (unknown code)
  1252. }
  1253.  
  1254. BEGIN
  1255.   proztype := '8085';
  1256.   M[0] :='0NOP';      M[1] :='3LXI  B,';  M[2] :='0STAX B';    M[3] :='0INX  B';
  1257.   M[4] :='0INC  R';   M[5] :='0DCR  B';   M[6] :='2MVI  B,';   M[7] :='0RLC';
  1258.   M[8] :='4DEFB ';    M[9] :='0DAD  B';   M[10]:='0LDAX B';    M[11]:='0DCX  B';
  1259.   M[12]:='0INR  C';   M[13]:='0DCR  C';   M[14]:='2MVI  C,';   M[15]:='0RRC';
  1260.   M[16]:='4DEFB ';    M[17]:='3LXI  D,';  M[18]:='0STAX D';    M[19]:='0INX  D';
  1261.   M[20]:='0INR  D';   M[21]:='0DCR  D';   M[22]:='2MVI  D,';   M[23]:='0RAL';
  1262.   M[24]:='4DEFB ';    M[25]:='0DAD  D';   M[26]:='0LDAX D';    M[27]:='0DCX  D';
  1263.   M[28]:='0INR  E';   M[29]:='0DCR  E';   M[30]:='2MVI  E,';   M[31]:='0RAR';
  1264.   M[32]:='0RIM';      M[33]:='3LXI  H,';  M[34]:='1SHLD ';     M[35]:='0INX  H';
  1265.   M[36]:='0INR  H';   M[37]:='0DCR  H';   M[38]:='2MVI  H,';   M[39]:='0DAA';
  1266.   M[40]:='4DEFB ';    M[41]:='0DAD  H';   M[42]:='1LHLD ';     M[43]:='0DCX  H';
  1267.   M[44]:='0INR  L';   M[45]:='0DCR  L';   M[46]:='2MVI  L,';   M[47]:='0CMA';
  1268.   M[48]:='0SIM';      M[49]:='3LXI  SP,'; M[50]:='1STA  ';     M[51]:='0INX  SP';
  1269.   M[52]:='0INR  M';   M[53]:='0DCR  M';   M[54]:='2MVI  M,';    M[55]:='0STC';
  1270.   M[56]:='4DEFB ';    M[57]:='0DAD  SP';  M[58]:='1LDA  ';      M[59]:='0DCX  SP';
  1271.   M[60]:='0INR  A';    M[61]:='0DCR  A';   M[62]:='2MVI  A,';   M[63]:='0CMC';
  1272.   M[64]:='0MOV  B,B';  M[65]:='0MOV  B,C'; M[66]:='0MOV  B,D';  M[67]:='0MOV  B,E';
  1273.   M[68]:='0MOV  B,H';  M[69]:='0MOV  B,L'; M[70]:='0MOV  B,M';  M[71]:='0MOV  B,A';
  1274.   M[72]:='0MOV  C,B';  M[73]:='0MOV  C,C'; M[74]:='0MOV  C,D';  M[75]:='0MOV  C,E';
  1275.   M[76]:='0MOV  C,H';  M[77]:='0MOV  C,L'; M[78]:='0MOV  C,M';  M[79]:='0MOV  C,A';
  1276.   M[80]:='0MOV  D,B';  M[81]:='0MOV  D,C'; M[82]:='0MOV  D,D';  M[83]:='0MOV  D,E';
  1277.   M[84]:='0MOV  D,H';  M[85]:='0MOV  D,L'; M[86]:='0MOV  D,M';  M[87]:='0MOV  D,A';
  1278.   M[88]:='0MOV  E,B';  M[89]:='0MOV  E,C'; M[90]:='0MOV  E,D';  M[91]:='0MOV  E,E';
  1279.   M[92]:='0MOV  E,H';  M[93]:='0MOV  E,L'; M[94]:='0MOV  E,M';  M[95]:='0MOV  E,A';
  1280.   M[96]:='0MOV  H,B';  M[97]:='0MOV  H,C'; M[98]:='0MOV  H,D';  M[99]:='0MOV  H,E';
  1281.   M[100]:='0MOV  H,H'; M[101]:='0MOV  H,L';M[102]:='0MOV  H,M'; M[103]:='0MOV  H,A';
  1282.   M[104]:='0MOV  L,B'; M[105]:='0MOV  L,C';M[106]:='0MOV  L,D'; M[107]:='0MOV  L,E';
  1283.   M[108]:='0MOV  L,H'; M[109]:='0MOV  L,L';M[110]:='0MOV  L,M'; M[111]:='0MOV  L,A';
  1284.   M[112]:='0MOV  M,B'; M[113]:='0MOV  M,C';M[114]:='0MOV  M,D'; M[115]:='0MOV  M,E';
  1285.   M[116]:='0MOV  M,H'; M[117]:='0MOV  M,L';M[118]:='0HLT';      M[119]:='0MOV  M,A';
  1286.   M[120]:='0MOV  A,B'; M[121]:='0MOV  A,C';M[122]:='0MOV  A,D'; M[123]:='0MOV  A,E';
  1287.   M[124]:='0MOV  A,H'; M[125]:='0MOV  A,L';M[126]:='0MOV  A,M'; M[127]:='0MOV  A,A';
  1288.   M[128]:='0ADD  B';   M[129]:='0ADD  C';  M[130]:='0ADD  D';   M[131]:='0ADD  E';
  1289.   M[132]:='0ADD  H';   M[133]:='0ADD  L';  M[134]:='0ADD  M';   M[135]:='0ADD  A';
  1290.   M[136]:='0ADC  B';   M[137]:='0ADC  C';  M[138]:='0ADC  D';   M[139]:='0ADC  E';
  1291.   M[140]:='0ADC  H';   M[141]:='0ADC  L';  M[142]:='0ADC  M';   M[143]:='0ADC  A';
  1292.   M[144]:='0SUB  B';   M[145]:='0SUB  C';  M[146]:='0SUB  D';   M[147]:='0SUB  E';
  1293.   M[148]:='0SUB  H';   M[149]:='0SUB  L';  M[150]:='0SUB  M';   M[151]:='0SUB  A';
  1294.   M[152]:='0SBB  B';   M[153]:='0SBB  C';  M[154]:='0SBB  D';   M[155]:='0SBB  E';
  1295.   M[156]:='0SBB  H';   M[157]:='0SBB  L';  M[158]:='0SBB  M';   M[159]:='0SBB  A';
  1296.   M[160]:='0ANA  B';   M[161]:='0ANA  C';  M[162]:='0ANA  D';   M[163]:='0ANA  E';
  1297.   M[164]:='0ANA  H';   M[165]:='0ANA  L';  M[166]:='0ANA  M';   M[167]:='0ANA  A';
  1298.   M[168]:='0XRA  B';   M[169]:='0XRA  C';  M[170]:='0XRA  D';   M[171]:='0XRA  E';
  1299.   M[172]:='0XRA  H';   M[173]:='0XRA  L';  M[174]:='0XRA  M';   M[175]:='0XRA  A';
  1300.   M[176]:='0ORA  B';   M[177]:='0ORA  C';  M[178]:='0ORA  D';   M[179]:='0ORA  E';
  1301.   M[180]:='0ORA  H';   M[181]:='0ORA  L';  M[182]:='0ORA  M';   M[183]:='0ORA  A';
  1302.   M[184]:='0CMP  B';   M[185]:='0CMP  C';  M[186]:='0CMP  D';   M[187]:='0CMP  E';
  1303.   M[188]:='0CMP  H';   M[189]:='0CMP  L';  M[190]:='0CMP  M';   M[191]:='0CMP  A';
  1304.   M[192]:='0RNZ';      M[193]:='0POP  B';  M[194]:='1JNZ  ';    M[195]:='1JMP  ';
  1305.   M[196]:='1CNZ  ';    M[197]:='0PUSH B';  M[198]:='2ADI  ';    M[199]:='0RST  0';
  1306.   M[200]:='0RZ';       M[201]:='0RET';     M[202]:='1JZ   ';    M[203]:='4DEFB ';
  1307.   M[204]:='1CZ   ';    M[205]:='1CALL ';   M[206]:='2ACI  ';    M[207]:='0RST  1';
  1308.   M[208]:='0RNC';      M[209]:='0POP  D';  M[210]:='1JNC  ';    M[211]:='2OUT  ';
  1309.   M[212]:='1CNC  ';    M[213]:='0PUSH D';  M[214]:='2SUI  ';    M[215]:='0RST  2';
  1310.   M[216]:='0RC';       M[217]:='4DEFB ';   M[218]:='1JC   ';    M[219]:='2IN   ';
  1311.   M[220]:='1CC   ';    M[221]:='4DEFB ';   M[222]:='2SBI  ';    M[223]:='0RST  3';
  1312.   M[224]:='0RPO';      M[225]:='0POP  H';  M[226]:='1JPO  ';    M[227]:='0XTHL';
  1313.   M[228]:='1CPO  ';    M[229]:='0PUSH H';  M[230]:='2ANI  ';    M[231]:='0RST  4';
  1314.   M[232]:='0RPE';      M[233]:='0PCHL ';   M[234]:='1JPE  ';    M[235]:='0XCHG';
  1315.   M[236]:='1CPE  ';    M[237]:='4DEFB ';   M[238]:='2XRI  ';    M[239]:='0RST  5';
  1316.   M[240]:='0RP';       M[241]:='0POP  PSW';M[242]:='1JP   ';    M[243]:='0DI';
  1317.   M[244]:='1CP   ';    M[245]:='0PUSH PSW';M[246]:='2ORI  ';    M[247]:='0RST  6';
  1318.   M[248]:='0RM';       M[249]:='0SPHL ';   M[250]:='1JM   ';    M[251]:='0EI';
  1319.   M[252]:='1CM   ';    M[253]:='4DEFB ';   M[254]:='2CPI  ';    M[255]:='0RST  7';
  1320. END;
  1321.  
  1322. (*********************** GEM event loop ****************************)
  1323.  
  1324. Procedure event_loop(VAR nachr,typ_nachricht:integer);
  1325.     
  1326. VAR msgbuff : array_8;
  1327.     clip    : array_4;
  1328.     dummy   : integer;
  1329.     i,j     : integer;
  1330.     start_x : integer;
  1331.     start_y : integer;
  1332.     was_liegt_an : integer;
  1333.  
  1334. BEGIN
  1335.   REPEAT
  1336.     was_liegt_an := evnt_multi( MU_MESAG or MU_KEYBD, 0, 0, 0, 0, 0,
  1337.                     0, 0, 0, 0, 0, 0, 0, 0,
  1338.                     msgbuff,    0,0,
  1339.                     dummy, dummy, dummy,
  1340.                     dummy, key, dummy );
  1341.  
  1342.     IF was_liegt_an = MU_MESAG THEN   (* Message event ? *)
  1343.     BEGIN
  1344.         case msgbuff[0] of
  1345.            WM_REDRAW:    if msgbuff[3]=whandle then      (* Redraw window *)
  1346.                             BEGIN
  1347.                               redrawwindow;
  1348.                             END;  
  1349.            WM_TOPPED:    if msgbuff[3]=whandle then      (* Top window *)
  1350.                             BEGIN
  1351.                               wind_update(BEG_UPDATE);
  1352.                         wind_set(whandle,WF_TOP,0,0,0,0);
  1353.                         wind_update(END_UPDATE);
  1354.                       END;  
  1355.            WM_CLOSED:    if msgbuff[3]=whandle then      (* Close window *)
  1356.                                 BEGIN
  1357.                                     button := form_alert(1,'[2][ EXIT|INTEL 8080/85 Reassembler ? ][ Yes | No ]');
  1358.                                     if button = 1 THEN
  1359.                                     BEGIN
  1360.                                       ENDE := true;
  1361.                                     END;  
  1362.                                 END;
  1363.              WM_MOVED:    if msgbuff[3]=whandle then       (* Window move *)
  1364.                             BEGIN
  1365.                               wind_update(BEG_UPDATE);
  1366.                               IF (msgbuff[4]+400) > max_x THEN  (* Window is always *)
  1367.                               BEGIN                             (* complete on the  *)
  1368.                                 msgbuff[4] := max_x-400;        (* screen           *)
  1369.                               END;                              
  1370.                               IF (msgbuff[5] < 19) THEN
  1371.                               BEGIN
  1372.                                  msgbuff[5] := 19;
  1373.                               END;
  1374.                               wind_get(whandle,WF_CURRXYWH,x,y,w,h);
  1375.                               IF msgbuff[5] + h > max_y + 19 THEN
  1376.                               BEGIN
  1377.                                 msgbuff[5] := 19 + max_y - h;  (* window bottom border *)
  1378.                               END;
  1379.                               BEGIN   
  1380.                                     wind_set(whandle,WF_CURRXYWH,msgbuff[4],msgbuff[5],msgbuff[6],msgbuff[7]);
  1381.                                   END;   
  1382.                                   redrawwindow;
  1383.                                 wind_update(END_UPDATE);
  1384.                               END;
  1385.                               
  1386.                 WM_SIZED: IF msgbuff[3] = whandle THEN   (* Window size changed *)
  1387.                           BEGIN
  1388.                             wind_update(BEG_UPDATE);
  1389.                             IF msgbuff[6] <> 400 THEN
  1390.                             BEGIN
  1391.                                msgbuff[6] := 400;  (* always 400 pixel wide *);
  1392.                             END;   
  1393.                             IF msgbuff[7] < 130 THEN
  1394.                             BEGIN
  1395.                                msgbuff[7] := 130;  (* min. window height 130 *);
  1396.                             END; 
  1397.                             wind_set(whandle,WF_CURRXYWH,msgbuff[4],msgbuff[5],msgbuff[6],msgbuff[7]);
  1398.                           wind_get(whandle,WF_WORKXYWH,x,y,w,h);
  1399.                           clip[0]:= x; clip[1]:= y;
  1400.                             clip[2]:= x + w - 1; clip[3]:= y + h - 1;
  1401.                             vs_clip(vdiHandle,1,clip);
  1402.                         clear_window;        
  1403.                       start_x := x + 16;
  1404.                       start_y := y + 16;
  1405.                       vst_color(vdiHandle,blue);
  1406.                       i := act_d_nr;
  1407.                       j := 1;
  1408.                         WHILE start_y <= y + h DO   (* Nummer of window rows *)
  1409.                         BEGIN
  1410.                           inc(j);
  1411.                           number_lines := j;
  1412.                           start_y := start_y + 16;
  1413.                         END;                
  1414.                         start_y := y + 16;                 
  1415.                         WHILE (i <= d_nr) and (start_y <= y + h) DO   (* Druckschleife *)
  1416.                         BEGIN
  1417.                           Set_label_color(i);
  1418.                           v_gtext(vdiHandle,start_x,start_y,Disasmfield[i].befehl);
  1419.                           inc(i);
  1420.                           start_y := start_y + 16;
  1421.                         vst_color(vdiHandle,Blue);
  1422.                         END;                       
  1423.                       save_window;
  1424.                       wind_update(END_UPDATE);  
  1425.                           END;
  1426.               
  1427.               WM_ARROWED: IF msgbuff[3]=whandle THEN     (* scroll text *)
  1428.                             BEGIN
  1429.                               wind_update(BEG_UPDATE);
  1430.                               CASE msgbuff[4] OF
  1431.                                 WA_UPLINE : Scroll_line_up;
  1432.                                 WA_DNLINE : Scroll_line_down;
  1433.                               END;   
  1434.                               wind_update(END_UPDATE);
  1435.                             END;
  1436.                                    
  1437.                  WM_VSLID:  IF msgbuff[3]=whandle THEN    (* Slider scrolling *)
  1438.                             BEGIN
  1439.                               wind_update(BEG_UPDATE);
  1440.                       slider_move(msgbuff[4]);
  1441.                               wind_update(END_UPDATE);
  1442.                             END;              
  1443.          END;
  1444.     END;
  1445.   UNTIL (msgbuff[0] = MN_selected) or (was_liegt_an = MU_KEYBD) or ENDE;
  1446.   IF (msgbuff[0] = MN_selected) THEN
  1447.   BEGIN
  1448.      menu_tnormal( mtree, msgbuff[3], 1);
  1449.      nachr := msgbuff[4];
  1450.   END;   
  1451.   IF (was_liegt_an = MU_KEYBD) THEN
  1452.   BEGIN
  1453.      nachr := key;
  1454.   END;   
  1455.   typ_nachricht := was_liegt_an;
  1456. END;
  1457.  
  1458. PROCEDURE main;
  1459.  
  1460. VAR
  1461.   wahl1 : integer;
  1462.   
  1463. BEGIN
  1464.     show_mode := 1;
  1465.     ENDE := FALSE;
  1466.     error:=rsrc_load(Resourcefile);
  1467.     IF error=0 THEN
  1468.         form_alert(1,'[1][ Error, Resource file| not found ][ Why ? ]')
  1469.     ELSE
  1470.     BEGIN
  1471.         rsrc_gaddr(R_TREE, DISASM85, mtree);
  1472.         mouse_off;
  1473.         menu_bar( mtree, 1 );
  1474.         mouse_on;
  1475.         graf_mouse( ARROW, NIL );
  1476.         path := '';
  1477.           Dgetpath( path, 0 );                  (* Get path    *)
  1478.           path := FExpand( path )+'\*.';        (* Expand path *)
  1479.         IF pos('\\',path) > 0 THEN            (* Kill double backslash *)    
  1480.         BEGIN                                 
  1481.           delete(path,pos('\\',path),1)
  1482.         END;          
  1483.         hndl_form(INFOBOX);
  1484.         REPEAT
  1485.             event_loop(wahl1,typ_nachricht);
  1486.             IF ENDE THEN
  1487.             BEGIN
  1488.               wahl1 := QUIT;
  1489.             END;
  1490.             IF typ_nachricht = MU_MESAG THEN  (* Menu selection *)
  1491.             BEGIN
  1492.               CASE wahl1 OF
  1493.                 SHOWINFO : hndl_form(INFOBOX);
  1494.                 LOADCODE : Laden;
  1495.                 ADRCODE  : Objcode_Show;
  1496.                 DISASM   : Display;
  1497.                 SETADR   : ADDRESS;
  1498.                 JUMPADR  : JUMP_ADDRESS;
  1499.                 SET8080  : Modus(0); 
  1500.                 SET8085  : Modus(1);
  1501.                 DISPOUT  : Display;
  1502.                 PRTOUT   : Drucker;
  1503.                 FILEOUT  : Datei;  
  1504.                 LABLOAD  : Label_laden;
  1505.                 LABSAVE  : Label_sichern;
  1506.                 LABCLEAR : Lab_clear;
  1507.               END;
  1508.             END  
  1509.             ELSE
  1510.             BEGIN
  1511.               CASE wahl1 OF
  1512.                 9740  : Laden;  (* Selection by keyboard *)
  1513.                 7681  : Objcode_Show;
  1514.                 15104 : Display;
  1515.                 7955  : ADDRESS;
  1516.                 9226  : JUMP_ADDRESS;
  1517.                 15360 : Modus(0); 
  1518.                 15616 : Modus(1);
  1519.                 12290 : Display;
  1520.                 6416  : Drucker;
  1521.                 8454  : Datei;
  1522.                 5140  : Label_laden;
  1523.                 12558 : Label_sichern;
  1524.                 11779 : Lab_clear;
  1525.                 18432 : BEGIN
  1526.                                   wind_update(BEG_UPDATE); (* Cursor up *)
  1527.                                   Scroll_line_up;
  1528.                                   wind_update(END_UPDATE);
  1529.                                 END;
  1530.                         20480 : BEGIN
  1531.                                   wind_update(BEG_UPDATE);  (* Cursor down *)
  1532.                                   Scroll_line_down;
  1533.                                   wind_update(END_UPDATE);
  1534.                                 END;                          
  1535.                 4113  : wahl1 := QUIT;                             
  1536.               END;
  1537.             END;  
  1538.         UNTIL wahl1=QUIT;
  1539.         mouse_off;
  1540.         menu_bar( mtree, 0 );
  1541.         mouse_on;
  1542.         wind_close(whandle);
  1543.         wind_delete(whandle);
  1544.         rsrc_free( );
  1545.         IF error=0 THEN
  1546.             form_alert(1,'[1][ Error| RSC deallocation failed ][ Hmmh ]');
  1547.     END;
  1548. END;
  1549.  
  1550. BEGIN
  1551.     file_offset := 0;   (* Init global variables *)
  1552.     filelength := 0;
  1553.     codestart := 0;
  1554.     d_nr := 0;
  1555.     lab_clr := true;
  1556.     IF initgem=true THEN   (* GEM Init *)
  1557.     BEGIN
  1558.       wind_get(0,WF_CURRXYWH,    x, y, w, h);
  1559.       IF h < 399 THEN
  1560.       BEGIN
  1561.         form_alert(1,'[1][ Screen resolution error !| Min. 640 * 400 ! ][ No game ]');
  1562.       END
  1563.       ELSE
  1564.       BEGIN 
  1565.         bufferlen := trunc(get_bitplanes * 400.0 * h + 256.0) div 8; (* Use float, otherwise garbage values *)
  1566.         screen_buffer := malloc(bufferlen);  (* Reserve window memory *)
  1567.         LOADDATA ;
  1568.         Open_window;   
  1569.         main;
  1570.         mfree(screen_buffer);  (* Deallocate window memory *)
  1571.       END;
  1572.         ExitGEM;
  1573.     END;  
  1574. END.
  1575.  
  1576.