{                         P32 - 32bit Pascal Compiler                       }
{ ------------------------------------------------------------------------- }
{                       Johan Prins - jprins@knoware.nl                     }
{ ========================================================================= }
{ Routines for the assembler                                                }
{                                                  (c) Copyright 1996-1998  }
{                                                                           }
{ ------------------------------------------------------------------------- }

unit P32_asm;

interface

uses P32_cfg, P32_prep, P32_scan, P32_err;

type
  assemblerdef = record
                   desc    :string[40];
                   header1,
                   header2,
                   model,
                   stackseg,
                   codeseg,
                   dataseg,
                   udataseg,
                   start,
                   ends,
                   proc,
                   endp,
                   macro,
                   endm,
                   align,
                   include,
                   inc_char,
                   byteptr,
                   wordptr,
                   dwordptr,
                   qwordptr,
                   jump_prefix,
                   offset,
                   decldata,
                   floatdata,
                   valdata,
                   extern,
                   extern2,
                   global
                   : string[20];
                 end;
  asmop = (_unknown, _opcode, _reg, _prefix);

var asdef:assemblerdef;

type
    opcode_num =
   (_mov_, _jmp_, _cmp_, _xor_, _int_, _jnc_,
    _aaa_, _aad_, _aam_, _aas_, _adc_, _add_, _and_, _arpl_, _bound_,
    _bsf_, _bsr_, _bswap_, _bt_, _btc_, _btr_, _bts_, _call_, _cbw_,
    _cdq_, _clc_, _cld_, _cli_, _clts_, _cmc_, _cmpsb_,
    _cmpsd_, _cmpsw_, _cmpxchg_, _cmpxchg8b_, _cpuid_, _cwd_, _cwde_,
    _daa_, _das_, _dec_, _div_, _enter_, _f2xm1_,
    _fabs_, _fadd_, _faddp_, _fbld_, _fbstp_, _fchs_, _fclex_, _fcom_,
    _fcomp_, _fcompp_, _fcos_, _fdecstp_, _fdisi_, _fdiv_, _fdivp_,
    _fdivr_, _fdivrp_, _feni_, _ffree_, _fiadd_, _ficom_, _ficomp_,
    _fidiv_, _fidivr_, _fild_, _fimul_, _fincstp_, _finit_, _fist_,
    _fistp_, _fisub_, _fisubr_, _fld_, _fld1_, _fldcw_, _fldenv_,
    _fldl2e_, _fldl2t_, _fldlg2_, _fldln2_, _fldpi_, _fldz_, _fmul_,
    _fmulp_, _fnop_, _fpatan_, _fprem_, _fprem1_, _fptan_, _frndint_,
    _frstor_, _fsave_, _fscale_, _fsetpm_, _fsin_, _fsincos_, _fsqrt_,
    _fst_, _fstcw_, _fstenv_, _fstp_, _fstsw_, _fsub_, _fsubp_,
    _fsubr_, _fsubrp_, _ftst_, _fucom_, _fucomp_, _fucompp_, _fxam_,
    _fxch_, _fxtract_, _fyl2x_, _fyl2xpi_, _hlt_, _idiv_, _imul_,
    _in_, _inc_, _insb_, _insd_, _insw_, _int3_, _into_,
    _invd_, _invlpg_, _iret_, _iretd_, _iretw_, _jcxz_, _jecxz_,
    _ja_, _jae_, _jb_, _jbe_, _jc_, _je_, _jg_, _jge_, _jl_, _jle_, _jna_,
    _jnae_,_jnb_, _jnbe_, _jne_, _jng_, _jnge_, _jnl_, _jnle_,
    _jno_, _jnp_,_jns_, _jnz_, _jo_, _jp_, _jpe_, _jpo_, _js_, _jz_,
    _seta_, _setae_, _setb_, _setbe_, _setc_, _sete_, _setg_, _setge_,
    _setl_, _setle_, _setna_, _setnae_, _setnb_, _setnbe_, _setnc_,
    _setne_, _setng_, _setnge_, _setnl_, _setnle_, _setno_, _setnp_,
    _setns_, _setnz_, _seto_, _setp_, _setpe_, _setpo_, _sets_, _setz_,
    _lahf_, _lar_, _lds_, _lea_, _leave_, _les_, _lfs_, _lgdt_,
    _lgs_, _lidt_, _lldt_, _lmsw_, _lodsb_, _lodsd_, _lodsw_, _loop_,
    _loope_, _loopne_, _loopnz_, _loopz_, _lsl_, _lss_, _ltr_,
    _movsb_, _movsd_, _movsw_, _movsx_, _movzx_, _mul_, _neg_, _nop_,
    _not_, _or_, _out_, _outsb_, _outsd_, _outsw_, _pop_, _popa_,
    _popad_, _popaw_, _popf_, _popfd_, _popfw_, _push_, _pusha_,
    _pushad_, _pushaw_, _pushf_, _pushfd_, _pushfw_, _rcl_, _rcr_,
    _rdmsr_, _rdtsc_, _ret_, _retf_, _retn_, _rol_, _ror_, _rsm_,
    _sahf_, _sal_, _sar_, _sbb_, _scasb_, _scasd_, _scasw_, _sgdt_,
    _shl_, _shld_, _shr_, _shrd_, _sidt_, _sldt_, _smsw_, _stc_,
    _std_, _sti_, _stosb_, _stosd_, _stosw_, _str_, _sub_, _test_,
    _verr_, _verw_, _wait_, _wbinvd_, _wrmsr_, _xadd_, _xchg_,
    _xlatb_,

    _align_, _rep_, _repne_, _repe_);

regs =
    (none, ah, al, ax, bh, bl, bp, bx, ch, cl, cs, cx, dh, di, dl, ds, dx,
     eax, edx, ecx, ebx, esi, edi, esp, ebp, es, fs, gs, si, sp, ss);

const opcodes: array[opcode_num] of string[10]=
   ('mov','jmp','cmp','xor','int','jnc',
    'aaa', 'aad', 'aam', 'aas', 'adc', 'add', 'and', 'arpl', 'bound',
    'bsf', 'bsr', 'bswap', 'bt', 'btc', 'btr', 'bts', 'call', 'cbw',
    'cdq', 'clc', 'cld', 'cli', 'clts', 'cmc', 'cmpsb',
    'cmpsd', 'cmpsw', 'cmpxchg', 'cmpxchg8b', 'cpuid', 'cwd', 'cwde',
    'daa', 'das', {'db', 'dd',} 'dec', 'div', {'dw',} 'enter', 'f2xm1',
    'fabs', 'fadd', 'faddp', 'fbld', 'fbstp', 'fchs', 'fclex', 'fcom',
    'fcomp', 'fcompp', 'fcos', 'fdecstp', 'fdisi', 'fdiv', 'fdivp',
    'fdivr', 'fdivrp', 'feni', 'ffree', 'fiadd', 'ficom', 'ficomp',
    'fidiv', 'fidivr', 'fild', 'fimul', 'fincstp', 'finit', 'fist',
    'fistp', 'fisub', 'fisubr', 'fld', 'fld1', 'fldcw', 'fldenv',
    'fldl2e', 'fldl2t', 'fldlg2', 'fldln2', 'fldpi', 'fldz', 'fmul',
    'fmulp', 'fnop', 'fpatan', 'fprem', 'fprem1', 'fptan', 'frndint',
    'frstor', 'fsave', 'fscale', 'fsetpm', 'fsin', 'fsincos', 'fsqrt',
    'fst', 'fstcw', 'fstenv', 'fstp', 'fstsw', 'fsub', 'fsubp',
    'fsubr', 'fsubrp', 'ftst', 'fucom', 'fucomp', 'fucompp', 'fxam',
    'fxch', 'fxtract', 'fyl2x', 'fyl2xpi', 'hlt', 'idiv', 'imul',
    'in', 'inc', 'insb', 'insd', 'insw', 'int3', 'into',
    'invd', 'invlpg', 'iret', 'iretd', 'iretw', 'jcxz', 'jecxz',
    'ja', 'jae', 'jb', 'jbe', 'jc', 'je', 'jg', 'jge', 'jl', 'jle', 'jna',
    'jnae','jnb', 'jnbe', 'jne', 'jng', 'jnge', 'jnl', 'jnle',
    'jno', 'jnp','jns', 'jnz', 'jo', 'jp', 'jpe', 'jpo', 'js', 'jz',
    'seta', 'setae', 'setb', 'setbe', 'setc', 'sete', 'setg', 'setge',
    'setl', 'setle', 'setna', 'setnae', 'setnb', 'setnbe', 'setnc',
    'setne', 'setng', 'setnge', 'setnl', 'setnle', 'setno', 'setnp',
    'setns', 'setnz', 'seto', 'setp', 'setpe', 'setpo', 'sets', 'setz',
    'lahf', 'lar', 'lds', 'lea', 'leave', 'les', 'lfs', 'lgdt',
    'lgs', 'lidt', 'lldt', 'lmsw', 'lodsb', 'lodsd', 'lodsw', 'loop',
    'loope', 'loopne', 'loopnz', 'loopz', 'lsl', 'lss', 'ltr',
    'movsb', 'movsd', 'movsw', 'movsx', 'movzx', 'mul', 'neg', 'nop',
    'not', 'or', 'out', 'outsb', 'outsd', 'outsw', 'pop', 'popa',
    'popad', 'popaw', 'popf', 'popfd', 'popfw', 'push', 'pusha',
    'pushad', 'pushaw', 'pushf', 'pushfd', 'pushfw', 'rcl', 'rcr',
    'rdmsr', 'rdtsc', 'ret', 'retf', 'retn', 'rol', 'ror', 'rsm',
    'sahf', 'sal', 'sar', 'sbb', 'scasb', 'scasd', 'scasw', 'sgdt',
    'shl', 'shld', 'shr', 'shrd', 'sidt', 'sldt', 'smsw', 'stc',
    'std', 'sti', 'stosb', 'stosd', 'stosw', 'str', 'sub', 'test',
    'verr', 'verw', 'wait', 'wbinvd', 'wrmsr', 'xadd', 'xchg',
    'xlatb',
    'align', 'rep', 'repne','repe');

  r: array[regs] of string[3]=
    ('', 'ah', 'al', 'ax', 'bh', 'bl', 'bp', 'bx', 'ch', 'cl',
     'cs', 'cx', 'dh', 'di', 'dl', 'ds', 'dx',
     'eax', 'edx', 'ecx', 'ebx', 'esi', 'edi',
     'esp', 'ebp',  'es', 'fs', 'gs', 'si', 'sp',
     'ss');

prefix: array[1..17] of string[6]=
    ('byte', 'dword', 'far', 'long', 'near', 'qword', 'short',
     'tbyte', 'word','ptr','offset','st', 'db','dw','dd','dq','dt');

procedure ReadDefinition(s:string);
function GetAsmType(const s:string):asmop;
{function GetAsmType(s:string):asmop;}

implementation


procedure ReadDefinition(s:string);

var def:file;

begin
  if FileExists(s) then
    begin
      assign(def, s);
      reset(def,1);
      blockread(def, asdef, sizeof(asdef));
      close(def);
    end
  else
    begin
      Error('Assembler definition file ('+s+') not found');
    end;
end;

function StrCmp(Str1,Str2: string):boolean;
{ Str1 converted to lowercase            }
{ Str2 always lowercase (see asm-tables) }
var
   StrPos, i:integer;
   CmpResult:boolean;           { Result of comparison.               }

begin
  CmpResult := TRUE;
  if Str1[0] <> Str2[0] then CmpResult := FALSE
  else
    begin
      for i:=1 to ord(Str1[0]) do
         if ('A' <= Str1[i]) and (Str1[i] <= 'Z') then
           Str1[i]:=chr(ord(Str1[i])+32);
      StrPos := 0;
      repeat
        inc(StrPos);
        if Str1[StrPos] <> Str2[StrPos] then
         begin
           CmpResult := FALSE;
           break;
         end;
      until StrPos = Length(Str2);
    end;
  StrCmp := CmpResult;
end;



function IsOpcode(const s:string):boolean;

var i:opcode_num;

begin
  IsOpCode:=FALSE;
  i:=low(opcode_num);
  repeat
    if strcmp(s,opcodes[i]) then
      begin
        IsOpCode:=TRUE;
        exit;
      end;
    inc(i);
  until (i=high(opcode_num));
end;

function IsReg(const s:string):boolean;

var i: regs;

begin
  IsReg:=FALSE;
  i:=low(regs);
  repeat
    if strcmp(s, r[i]) then
      begin
        IsReg:=TRUE;
        exit;
      end;
    inc(i);
  until (i=high(regs));
end;

function IsPrefix(const s:string):boolean;

var i: integer;

begin
  IsPrefix:=FALSE;
  i:=1;
  repeat
    if strcmp(s, prefix[i]) then
      begin
        IsPrefix:=TRUE;
        exit;
      end;
    inc(i);
  until (i=17);
end;

function GetAsmType(const s:string):asmop;

begin
  if IsOpcode(s) then GetAsmType:=_opcode
  else
  if IsReg(s) then GetAsmType:=_reg
  else
  if IsPrefix(s) then GetAsmType:=_prefix
  else GetAsmType:=_unknown;
end;

begin
end.
