unit common;
interface
uses classes,sysutils,windows;

//remove comment on line below for debug mode.
//{$DEFINE DEBUG}
// warning - debug files can get big quickly. I only use them for
// hard to find bugs.
procedure DebugMessage(szFormat:pchar; a:array of const);

// keep enums at byte size!
type
  long=dword;
  dword=cardinal;
  pfloat =^single;
  pdouble=^double;
  ptr=pointer;
  pd=^dword;
  pw=^word;
  pda=^tda;
  pwa=^twa;
  tda=array[0..1] of dword;
  twa=array[0..1] of word;

function CreateStatusWindow(Style:Longint; lpszText:PChar; hwndParent:HWND; wID:UINT):HWND; stdcall;

const
  BORG_VER       = 221;
  fname:pchar    ='Borg Disassembler';
  reg_borg:pchar ='Software\Borg';
  CCS_BOTTOM     = $00000003;
  CALLSTACKSIZE  = 100;
  BYTEPOS        = 14;
  ASMPOS         = 31;
  ARGPOS         = 38;
  COMMENTPOS     = 50;
  COMMENT_MAXLEN = 100;

  wm_User     = $0400;
  SB_SETTEXT  = WM_USER+1;
  WM_MAXITOUT = WM_USER+100;
  WM_CREATE           = $0001;
  WM_DESTROY          = $0002;
  WM_SIZE             = $0005;
  WM_SETTEXT          = $000C;
  WM_GETTEXT          = $000D;
  WM_PAINT            = $000F;
  WM_CLOSE            = $0010;
  WM_SYSCOLORCHANGE   = $0015;
  BM_GETCHECK         = $00F0;
  BM_SETCHECK         = $00F1;
  WM_INITDIALOG       = $0110;
  WM_COMMAND          = $0111;
  WM_CTLCOLORBTN      = $0135;
  WM_CTLCOLORDLG      = $0136;
  WM_CTLCOLORSTATIC   = $0138;
  WM_KEYDOWN          = $0100;
  WM_CHAR             = $0102;
  WM_HSCROLL          = $0114;
  WM_VSCROLL          = $0115;
  LB_DELETESTRING     = $0182;
  WM_LBUTTONDOWN      = $0201;
  WM_RBUTTONDOWN      = $0204;
  EN_CHANGE           = $0300;
  LBN_SELCHANGE       = 1;
  LB_ADDSTRING        = $0180;
  LB_GETCURSEL        = $0188;
  LB_SETCURSEL        = $0186;

  CD_PUSHBP      = 1;
  CD_ENTER       = 2;
  CD_MOVBX       = 4;
  CD_AGGRESSIVE  = 8;
  CD_EAXFROMESP  = 16;
  CD_MOVEAX      = 32;
  VERTSCROLLRANGE= 16000;

  function dobool(var b:bool):bool;
  procedure ProcessMessages_;
  function LoCase(ch:Char):Char;
  function SysFileIsDevice_(Handle:dword):dword;
  function ofsp(o:dword):pointer;
  function isprint(c:char):boolean;
  procedure cleanstring(str:pchar);
  procedure InitCommonControls;

type
  dsmitemtype =(dsmnull,dsmsegheader,dsm2,dsm3,dsm4,dsmnameloc,dsmcomment,dsmxref,dsmcode);
  byteoverride=(over_null,over_decimal,over_char,over_dsoffset,over_single);
  segtype     =(codenull,code16,code32,data16,data32,uninitdata,debugdata,resourcedata);

  plptr=^lptr;
  lptr=packed record
    s:word;
    o:dword;
  end;

  fontselection=(nul,ansifont,systemfont,courierfont,courierfont10,courierfont12);

  tglobaloptions=packed record
    loaddebug    :bool;
    mode16       :bool;
    mode32       :bool;
    loaddata     :bool;
    loadresources:bool;
    demangle     :bool;
    cfa          :bool;
    processor    :dword;
    loadaddr     :lptr;
    dseg         :word;
    codedetect   :word;
    bgcolor      :COLORREF;
    textcolor    :COLORREF;
    highcolor    :COLORREF;
    font         :fontselection;
  end;

  pdsmitem=^tdsmitem;
  tdsmitem=packed record
    addr:lptr;
    tptr:pointer;                   // string pointer for comment
    typ:dsmitemtype;
    length:word;
    modrm:byte;                     // length, offset to  modrm byte
    mode32:bool;
    data:pchar;                     // data ptr
    overrid:byteoverride;
    flags:dword;
    displayflags:byte;
  end;

  pdsmitemsave=^tdsmitemsave;
  tdsmitemsave=packed record
    addr:lptr;
    tptroffset:dword;
    typ:dsmitemtype;
    length:word;
    modrm:byte;
    mode32:bool;
    fileoffset:dword;
    overrid:byteoverride;
    flags:dword;
    displayflags:byte;
  end;

const
  UseCompression:boolean=true;
  nlptr:lptr=(s:0;o:0);
  cf:HFONT=0;
  lastline:dword=0;

const
  buffer_lines   =60;
  max_length     =200;
  max_stringprint=max_length-60;

var
  InThread   :boolean;
  KillThread :boolean;
  BufferReady:boolean;

var
  log:textfile;
  Inst:dword;
  mainwindow:hwnd;
  hwndStatusBar:dword;
  mainwnd:trect;
  Options:tglobaloptions;
  cs:TRTLCriticalSection;
  winname:array[0..300] of char;
  szFile :array[0..260] of char;
  MainBuff:array[0..buffer_lines*max_length+1000] of char;

  function add_(l1:plptr; offs2:dword):dword;
  function sub_(l1:plptr; offs2:dword):dword;
  function plus(l1:plptr; offs2:dword):dword;
  function minus(l1:plptr; offs2:dword):dword;
  function eq(l1,loc2:lptr):boolean;
  function neq(l1,loc2:lptr):boolean;
  function leeq(l1,loc2:lptr):boolean;
  function greq(l1,loc2:lptr):boolean;
  function le(l1,loc2:lptr):boolean;
  function gr(l1,loc2:lptr):boolean;

const
  hdr:pchar=';             Created by Borg Disassembler'#13#10+
            ';                   written by Cronos';

implementation

function  add_(l1:plptr; offs2:dword):dword;
begin inc(l1.o,offs2); result:=l1.o; end;

function  sub_(l1:plptr; offs2:dword):dword;
begin dec(l1.o,offs2); result:=l1.o; end;

function  plus(l1:plptr; offs2:dword):dword;
begin result:=l1.o+offs2; end;

function  minus(l1:plptr; offs2:dword):dword;
begin result:=l1.o-offs2; end;

function eq(l1,loc2:lptr):boolean;
begin result:=(l1.s=loc2.s)and(l1.o=loc2.o); end;

function neq(l1,loc2:lptr):boolean;
begin result:=(l1.s<>loc2.s)or(l1.o<>loc2.o); end;

function leeq(l1,loc2:lptr):boolean;
begin if(l1.s<>loc2.s) then result:=(l1.s<=loc2.s) else result:=(l1.o<=loc2.o); end;

function greq(l1,loc2:lptr):boolean;
begin if(l1.s<>loc2.s) then result:=(l1.s>=loc2.s) else result:=(l1.o>=loc2.o); end;

function le(l1,loc2:lptr):boolean;
begin if(l1.s<>loc2.s) then result:=(l1.s<loc2.s) else result:=(l1.o<loc2.o); end;

function gr(l1,loc2:lptr):boolean;
begin if(l1.s<>loc2.s) then result:=(l1.s>loc2.s) else result:=(l1.o>loc2.o); end;


function isprint(c:char):boolean;
begin
  result:=c in['A'..'Z','a'..'z','0'..'9','+','-','=','_','!',
    '@','$','%','^','&','*','(',')','[',']','{','}','''',' ',
    '#','/','<','>','|','\','"','.',',',';',':','`','?','~'];
end;

function isalnum(c:char):boolean;
begin
  result:=c in['A'..'Z','a'..'z','0'..'9','_'];
end;

procedure cleanstring(str:pchar);
var i:integer;
begin
  for i:=0 to strlen(str)-1 do if not isalnum(str[i]) then str[i]:='_';
end;

function ofsp(o:dword):pointer;
begin
  result:=pointer(o);
end;

function CreateStatusWindow(Style:Longint; lpszText:PChar; hwndParent:HWND; wID:UINT):HWND;
 external 'comctl32.dll' name 'CreateStatusWindowA';

procedure InitCommonControls;
external 'comctl32.dll' name 'InitCommonControls';

function SysFileIsDevice_(Handle:dword):dword;
begin
  result := GetFileType(Handle);
{$IFDEF VIRTUALPASCAL}
  case result of
  0,1 : Result := 0; // File;
    2 : Result := 1; // Device
    3 : Result := 2; // Pipe
  end;
{$ENDIF}
end;

function LoCase(ch:Char):Char;
asm
        CMP     AL,'A'
        JB      @@exit
        CMP     AL,'Z'
        JA      @@exit
        add     AL,'a' - 'A'
@@exit:
end;

procedure ProcessMessages_;
var Msg :TMsg;
begin
  while PeekMessage(Msg,0,0,0,PM_REMOVE) do begin
    TranslateMessage(Msg); DispatchMessage(Msg);
    break;
  end;
end;

function dobool(var b:bool):bool;
begin
  dword(b):=dword(b) and 1; result:=b;
end;

procedure DebugMessage(szFormat:pchar; a:array of const);
var
  DebugBuff:array[0..200] of char;
  efile:textfile;
begin
  wvsprintf(DebugBuff,szFormat,a);
  assignfile(efile,'c:\debug.txt'); {$I-}append(efile);{$I+}
  if ioresult<>0 then {$I-}rewrite(efile);{$I+}
  if ioresult<>0 then begin
    MessageBox(mainwindow,'Debug File Creation Failed','Borg Disassembler Alert',MB_OK); exit;
  end;
  writeln(efile,DebugBuff,strlen(DebugBuff));
  closefile(efile);
end;

begin
end.

