Извините, ничего не найдено.

dimanche13 · 24.09.2008, 09:59

Однако, свежо! Интересная веточка, желаю вам удачи в создании русского MP.

24.09.2008, 12:48

лутче бы написали бы компилятор из какого нибудь более универсального синтаксиса и два транслятора из pascal-подобного и basic-подобного синтаксиса

правда в прочем можно транслировать на java и компилить уже обычным способом

satan · 24.09.2008, 18:52

Ребят, да вы не понимаете... Ето пока наброски, потом, когда перейдем к синтаксическому анализатору каждый сможет свой язык прикрутить, вплоть до выдуманого. Просто я сейчас иду методом рекурсивного подъёма, а не как в классической книге дракона метод рекурсивного спуска. Почему? Да потому что виден сразу результат работы, во вторых можно проверять на ходу работоспособность и в третьих, когда подходишь уже к оформлению языка (на каком будет проходить в принципе программирование) у тебя уже все готово, то есть остаётся лишь придумать или взять какой нить язык за основу и вписать его в лекс. анализ...
Просто сейчас я пытаюсь объяснить структуру БАЙТ-КОДА который будет на выходе, попросту CLASS файл, затем у нас пойдут простейшие функции, которые переводят строки в этот самый байт код... Но, по структуре CLASS файла можно понять, что он состоит из нескольких секций и в основном самая большая из них - это Заголовок файла.
Потом лексический анализатор пробежится по строчкам кода (причом пробежиться он по правилам заданным нами) и если не встретит ошибки отдаст строку на растерзание синтаксическому анализатору... Вот в кратце как работает эта связка на примере строки
class HelloWorld{

Пусть у нас будет L– лексический анализатор а S– синтаксический
L – встретил “class” отдает S-> “class”
S – возвращает L<-_CLASSES то есть “class” у нас структура
Ошибки нет, записываем в массив с номером N+1 07 00 {номер N}
L – далее должно быть название строка UTF8
L – следующийтокен “HelloWorld” отдает S->“HelloWorld”
S – возвращает L<-_UTF8 то есть строка
Lсверяет UTF8 == _UTF8 ошибки нет
Записываем в массив с номером Nпоследовательность байт строки “HelloWorld” или
48 65 6C 6C 6F 57 6F 72 6C 64
И так в цикле и рекурсивно...
Тоесть у нас одна рекурсивная функция будет отдавать три варианта
1.Ошибки нет правила совпадают
2.Ошибки нет правила не совпадают
3.Ошибка
В первом случае все нормально и пишется код, в третьем выводится ошибка а во втором управление передается точно такой же рекурсивной функции, которая разберёт уже другую строку, например выражение, и т.д...

satan · 24.09.2008, 21:19

Итак мы подошли к созданию функций нижнего уровня! Почему я так заострил вопрос о именно нижнем уровне? Все очень просто. Многие простые компиляторы и интерпритаторы начинаются с верхнего уровня, и когда доходят до создания файлов то происходит как бы ломка кода... Или приходится дорабатывать анализаторы, что бы код был по возможности оптимальным, или дорабатывать выходной файл (ASMили байт-код)... В любом случае ошибки допущенные сверху сказываются на коде в прогрессии.

Итак предлагаю определить две переменные. Первая это

Var

Token : array of record
Name : String;
Types : Byte;
Code : Array of byte;
end;

ByteCode: array of record
Name : String;
Types : Byte;
Len : Byte;
end;

Теперь представте как работает Лексич. Анализатор. Он разобьет наш скрипт на отдельные лексемы, но не просто а запишет их в переменную Token? Поэтому строка вида class HelloWorld{ превратится в набор

Token[0].Name = “Class”
Token[0].Types = _CLASSES
Token[0].Code[] = []

Token[1].Name = “ HelloWorld”
Token[1].Types = _UTF8
Token[1].Code[] = [$48, $65, $6C, $6C, $6F, $57, $6F, $72, $6C, $64]

Token[2].Name = “{”
Token[2].Types = _OPERATOR
Token[2].Code[] = []

Что это даст?
Все просто, при синтаксическом анализе мы сразу будем лепить код без хитрых манипуляций и во вторых сразу же можно будет формировать байт-код заголовка на основании предыдущего и последующего кода...
Ну ладно, щас попробую занятся уже формированием CLASS файла...

abcdef · 25.09.2008, 15:21

вот сбрал приблизительную модель загрузки clsass-файлов, но после считывания константного пула, где-то рвет в размерах считываемых байтов, соответственно неверно заполняются поля размера ниже-следующих структур, посмотрите кто-нить в чем здесь неправ.

формат и доку брал из предоставленной информации.

Программу можно компилировать как и в TurboPascal 7.0, так и Delphi 7.0
только после создания .exe-файла в Delphi антивирус кричит на него что это вирус...

{$R+,S+}
const
  CONSTANT_Class              = 7;
  CONSTANT_Fieldref           = 9;
  CONSTANT_Methodref          = 10;
  CONSTANT_InterfaceMethodref = 11;
  CONSTANT_String             = 8;
  CONSTANT_Integer            = 3;
  CONSTANT_Float              = 4;
  CONSTANT_Long               = 5;
  CONSTANT_Double             = 6;
  CONSTANT_NameAndType        = 12;
  CONSTANT_Utf8               = 1;
  CONSTANT_Unicode            = 2;
  {------------------------------}
  ACC_PUBLIC = 1;
  ACC_PRIVATE = 2;
  ACC_PROTECTED = 4;
  ACC_STATIC = 8;
  ACC_FINAL = 16;
  ACC_SYNCHRONIZED = 32;
  ACC_SUPER = 32;
  ACC_VOLATILE = 64;
  ACC_TRANSIENT = 128;
  ACC_NATIVE = 256;
  ACC_INTERFACE = 512;
  ACC_ABSTRACT = 1024;
{}
type
  tfield_info = record
    access_flags : word;
    name_index : word;
    signature_index : word;
    attributes_count : word;
    {attributes[attribute_count]}
  end;
{}
  tmethod_info = record
    access_flags : word;
    name_index : word;
    signature_index : word;
    attributes_count : word;
    {attributes[attribute_count]}
  end;
  {--атрибуты--}
  tGenericAttribute_info = record
    attribute_name : word;
    attribute_length : longInt;
    {info[attribute_length] of byte}
  end;
  {}
  tSourceFile_attribute = record
    attribute_name_index : word;
    attribute_length : longInt;
    sourcefile_index : word;
  end;
  {}
  tLineNumberTable_attribute = record
    attribute_name_index : word;
    attribute_length : longInt;
    line_number_table_length : word;
    {line_number_table[line_number_table_length] of record start_pc,line_number:word;}
  end;
  {}
  tConstantValue_attribute = record
    attribute_name_index : word;
    attribute_length : longInt;
    constantvalue_index : word;
  end;
  {}
  tLocalVariableTable_attribute = record
    attribute_name_index : word;
    attribute_length : longInt;
    local_variable_table_length : word;
    {local_variable_table[local_variable_table_length]}
  end;
  tLocal_variable_table = record
    start_pc   : word;
    length     : word;
    name_index : word;
    signature_index : word;
    slot       : word;
  end;
  {}
  tCode_attribute = record
    attribute_name_index : word;
    attribute_length : longInt;
    max_stack : word;
    max_locals : word;
    code_length : longInt;
  end;
  {code[code_length]}
  {exception_table_length : word;{***}
  {exception_table[exception_table_length]}
  {attributes_count : word;{***}
  {attribute_info[attribute_count]}
  tException_table = record
    start_pc : word;
    end_pc : word;
    handler_pc : word;
    catch_type : word;
  end;
  {--------------------------}
var
  cf : record      {ClassFile}
    magic               : longInt;
    minor_version       : word;
    major_version       : word;
    constant_pool_count : word;
    cp_info             : pointer; {constant_pool[constant_pool_count - 1];}
    access_flags        : word;
    this_class          : word;
    super_class         : word;
    interfaces_count    : word;
    interfaces          : pointer; {[interfaces_count];}
    fields_count        : word;
    field_info          : pointer; {fields[fields_count];}
    methods_count       : word;
    method_info         : pointer; {methods[methods_count];}
    attributes_count    : word;
    attribute_info      : pointer; {attributes[attribute_count];}
  end;
var
  f                     : file;
  i,j,n,rc              : integer;{longInt;}
  s                     : string;
  tag                   : byte;
  p                     :^byte;
  pfield_info           :^tfield_info;
  pmethod_info          :^tmethod_info;
  pGenericAttribute_info:^tGenericAttribute_info;
  pCode_attribute       :^tCode_attribute;
  pException_table      :^tException_table;
  pexception_table_length:^word;
  pattributes_count      :^word;
  pLocalVariableTable_attribute:^tLocalVariableTable_attribute;
  pLocal_variable_table :^tLocal_variable_table;


function hex(b:byte) : string;
const
  h : array[0..$F] of char = '0123456789ABCDEF';
begin
  hex := h[b shr 4]+h[b and $F];
end;


function hexw(w:word) : string;
begin
  hexw:=hex(hi(w))+hex(lo(w));
end;


function get(p : pointer;  count : integer) : pointer;
var
  n : integer;
begin
  blockRead(f,p^,count,n);
  inc(longInt(p),n); {pasc}
  inc(rc,n);
  get := p;  {get := ptr(cardinal(p)+count);  //delphi}
end;

function swap2(p:pointer; offs:integer) : pointer;
var
  b1,b2 :^byte;
  b     : byte;
begin
  dec(longInt(p),offs+1);
  b1:=p;
  dec(longInt(p));
  b2:=p;
  b:=b1^;b1^:=b2^;b2^:=b;
  swap2 := p;
end;


function swap4(p:pointer; offs:integer) : pointer;
var
  b1,b2,b3,b4 :^byte;
  b           : byte;
begin
  dec(longInt(p),offs+1);
  b1:=p;
  dec(longInt(p));
  b2:=p;
  dec(longInt(p));
  b3:=p;
  dec(longInt(p));
  b4:=p;
  b:=b1^;b1^:=b4^;b4^:=b;
  b:=b2^;b2^:=b3^;b3^:=b;
  swap4 := p;
end;


function getConstStr(index : word) : string;
var
  s     : string;
  i,j,w : word;
  p     :^byte;
begin
  s:='';
  p:=cf.cp_info;
  for i := 1 to cf.constant_pool_count-1 do  {цикл начинается именно с 1, а не 0}
  begin
    if i=index then if (p^ in [CONSTANT_Utf8, CONSTANT_Unicode]) then
    begin
      w:=p^;
      inc(p,2);
      for j := 0 to w-1 do
      begin
        s := s+chr(p^);
        inc(p);
      end;
      getConstStr := s;
      break;
    end;
    case p^ of
      CONSTANT_Class: inc(p,2);
      CONSTANT_Fieldref,CONSTANT_Methodref,CONSTANT_InterfaceMethodref: inc(p,4);
      CONSTANT_String: inc(p,2);
      CONSTANT_Integer,CONSTANT_Float: inc(p,4);
      CONSTANT_Long: inc(p,8);
      CONSTANT_NameAndType: inc(p,4);
      CONSTANT_Utf8, CONSTANT_Unicode:
      begin      {null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
        w:=p^;
        inc(p,2);
        inc(p,w)
      end;
    end;
    getConstStr := s;
  end;
end;

{-------------------}

procedure load_const;
begin
  get(p,1);
  tag:=p^;
  inc(p);
  write(tag:2,' ');
  case tag of
    CONSTANT_Class:
    begin
      p:=get(p,2);
      write('CONSTANT_Class:',word(swap2(p,0)^));
    end;
    CONSTANT_Fieldref,CONSTANT_Methodref,CONSTANT_InterfaceMethodref:
    begin
      case tag of
        CONSTANT_Fieldref: write('CONSTANT_Fieldref:');
        CONSTANT_Methodref: write('CONSTANT_Methodref:');
        CONSTANT_InterfaceMethodref: write('CONSTANT_InterfaceMethodref:');
      end;
      p:=get(p,4);
      write(word(swap2(p,2)^),'  ',word(swap2(p,0)^));
    end;
    CONSTANT_String:
    begin
      p:=get(p,2);
      write('CONSTANT_String:',word(swap2(p,0)^));
    end;
    CONSTANT_Integer,CONSTANT_Float:
    begin
      case tag of
        CONSTANT_Integer: write('CONSTANT_Integer:');
        CONSTANT_Float: write('CONSTANT_Float:');
      end;
      p:=get(p,4);
      write(longInt(swap4(p,0)^));
    end;
    CONSTANT_Long,CONSTANT_Double:
    begin
      case tag of
        CONSTANT_Long: write('CONSTANT_Integer:');
        CONSTANT_Double: write('CONSTANT_Double:');
      end;
      p:=get(p,8);
      write('_hi_',longInt(swap4(p,4)^),'_lo_',longInt(swap4(p,0)^));
    end;
    CONSTANT_NameAndType:
    begin
      p:=get(p,4);
      write('CONSTANT_NameAndType:',word(swap2(p,2)^),' ',word(swap2(p,0)^));
    end;
    CONSTANT_Utf8, CONSTANT_Unicode:
    begin        {null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
      p:=get(p,2);       {length}
      n:=word(swap2(p,0)^);
      write('CONSTANT_Utf8-Unicode [',n,']=');
      for j := 0 to n-1 do
      begin
        get(p,1);
        write(chr(p^));
        inc(p);
      end;
    end;
    else
    if tag<>0 then
    begin
      write('error:',tag);
      halt;
    end;
  end;
  writeln;
end;


procedure load_attribute_info;
begin
  writeln(hexw(rc), 'h  GenericAttribute_info');
  p:=get(p,sizeof(pGenericAttribute_info^));
  pGenericAttribute_info:=swap2(swap2{4}(p,0),0);
  writeln('attribute_name:',pGenericAttribute_info^.attribute_name);
  writeln('attribute_length:',pGenericAttribute_info^.attribute_length);
  s := getConstStr(pGenericAttribute_info^.attribute_name);
  if s='Code' then
  begin
    writeln(hexw(rc), 'h  Code');
    p:=get(p,sizeof(pCode_attribute^));
    pCode_attribute := swap2(swap4(swap2(swap2(swap4(p,0),0),0),0),0);
    writeln(hexw(rc-sizeof(pCode_attribute^.attribute_name_index)),
      ' attribute_name_index:',pCode_attribute^.attribute_name_index);
    writeln(hexw(rc-sizeof(pCode_attribute^.attribute_length)),
      ' attribute_length:',pCode_attribute^.attribute_length);
    writeln(hexw(rc-sizeof(pCode_attribute^.max_stack)),
      ' max_stack:',pCode_attribute^.max_stack);
    writeln(hexw(rc-sizeof(pCode_attribute^.max_locals)),
      ' max_locals:',pCode_attribute^.max_locals);
    writeln(hexw(rc-sizeof(pCode_attribute^.code_length)),
      ' code_length:',pCode_attribute^.code_length);
    for j := 0 to pCode_attribute^.code_length-1 do  p:=get(p,1);
    p:=get(p,sizeof(pexception_table_length^));
    pexception_table_length:=swap2(p,0);
    for j := 0 to pexception_table_length^-1 do
    begin
      p := get(p,sizeof(pException_table^));
      pException_table := swap2(swap2(swap2(swap2(p,0),0),0),0);
    end;
    p:=get(p,sizeof(pattributes_count^));
    pattributes_count :=swap2(p,0);
    for j := 0 to pattributes_count^-1 do p:=get(p,1);
  end
  else if s='LocalVariableTable' then
  begin
    writeln(hexw(rc), 'h  LocalVariableTable');
    p := get(p,sizeof(pLocalVariableTable_attribute^));
    pLocalVariableTable_attribute := swap2(swap4(swap2(p,0),0),0);
    writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.attribute_name_index)),
      ' attribute_name_index:',pLocalVariableTable_attribute^.attribute_name_index);
    writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.attribute_length)),
      ' attribute_length:',pLocalVariableTable_attribute^.attribute_length);
    writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.local_variable_table_length)),
      ' local_variable_table_length:',pLocalVariableTable_attribute^.local_variable_table_length);
    for j := 0 to pLocalVariableTable_attribute^.local_variable_table_length-1 do
    begin
      p := get(p,sizeof(pLocal_variable_table^));
      pLocal_variable_table := swap2(swap2(swap2(swap2(swap2(p,0),0),0),0),0);
      writeln('start_pc:',pLocal_variable_table^.start_pc);
      writeln('length:',pLocal_variable_table^.length);
      writeln('name_index:',pLocal_variable_table^.name_index);
      writeln('signature_index:',pLocal_variable_table^.signature_index);
      writeln('slot:',pLocal_variable_table^.slot);
    end;
  end
  {if s='SourceFile' then
  begin
  end
  else if s='LineNumberTable' then
  begin
  end{}
  else  {don't know... skip atributes}
  begin
    for j := 0 to pGenericAttribute_info^.attribute_length-1 do
    begin
      get(p,1);
      write(hex(byte(p^)),' ');
      inc(p);
    end;
  end;
  writeln;
end;


procedure load_interfaces;
begin
  p:=get(p,2);
  write(word(swap2(p,0)^),',');
end;


procedure load_field_info;
begin
  p := get(p,sizeof(pfield_info^));
  pfield_info := swap2(swap2(swap2(swap2(p,0),0),0),0);
  writeln('access_flags:',pfield_info^.access_flags);
  writeln('name_index:',pfield_info^.name_index);
  writeln('signature_index:',pfield_info^.signature_index);
  writeln('attributes_count:',pfield_info^.attributes_count, ' offs:[',hexw(rc), 'h]');
  for j := 0 to pfield_info^.attributes_count-1 do
    load_attribute_info;
end;


procedure method_info;
begin
  p := get(p,sizeof(pmethod_info^));
  pmethod_info := swap2(swap2(swap2(swap2(p,0),0),0),0);
  writeln('access_flags:',pmethod_info^.access_flags);
  writeln('name_index:',pmethod_info^.name_index);
  writeln('signature_index:',pmethod_info^.signature_index);
  writeln('attributes_count:',pmethod_info^.attributes_count, ' offs:[',hexw(rc), 'h]' );
  for j := 0 to pmethod_info^.attributes_count-1 do
    load_attribute_info;
end;


begin
  getMem(cf.cp_info,$FFFF);
  getMem(cf.interfaces,$7FFF);
  getMem(cf.field_info,$FFFF);
  getMem(cf.method_info,$FFFF);
  getMem(cf.attribute_info,$FFFF);
  fillChar(cf.cp_info^, $FFFF, 0);
  fillChar(cf.interfaces^, $7FFF, 0);
  fillChar(cf.field_info^, $FFFF, 0);
  fillChar(cf.method_info^, $FFFF, 0);
  fillChar(cf.attribute_info^, $FFFF, 0);
  assign(f,'fw.cla');
  {cf.magic := $CAFEBABE; cf.minor_version := $0000; cf.major_version := $002E;
  rewrite(f,1);
  blockWrite(f,cf.magic,sizeof(cf.magic),n);
  blockWrite(f,cf.minor_version,sizeof(cf.minor_version),n);
  blockWrite(f,cf.major_version,sizeof(cf.major_version),n);{...}
  reset(f,1);
  rc:=0;
  swap4(get(@cf.magic,sizeof(cf.magic)),0);
  swap2(get(@cf.minor_version,sizeof(cf.minor_version)),0);
  swap2(get(@cf.major_version,sizeof(cf.major_version)),0);
  swap2(get(@cf.constant_pool_count,sizeof(cf.constant_pool_count)),0);
  p:=cf.cp_info;
  for i := 1 to cf.constant_pool_count-1 do {цикл начинается именно с 1, а не 0}
  begin
    write(hexw(rc-1),'h ',i:3,' ');
    load_const;
  end;
  writeln('__________________________');
  swap2(get(@cf.access_flags,sizeof(cf.access_flags)),0);
  writeln(hexw(rc-sizeof(cf.access_flags)),'h access_flags:',cf.access_flags);
  swap2(get(@cf.this_class,sizeof(cf.this_class)),0);
  writeln(hexw(rc-sizeof(cf.this_class)),'h this_class:',cf.this_class);
  swap2(get(@cf.super_class,sizeof(cf.super_class)),0);
  writeln(hexw(rc-sizeof(cf.super_class)),'h super_class:',cf.super_class);
  writeln(#13#10'-----load_interfaces----');
  swap2(get(@cf.interfaces_count,sizeof(cf.interfaces_count)),0);
  writeln(hexw(rc-sizeof(cf.interfaces_count)),'h interfaces[',cf.interfaces_count,']=');
  p := cf.interfaces;
  for i := 0 to cf.interfaces_count-1 do
    load_interfaces;
  writeln(#13#10'__________________________');
  writeln(#13#10'-----load_field_info----');
  swap2(get(@cf.fields_count,sizeof(cf.fields_count)),0);
  writeln(hexw(rc-sizeof(cf.fields_count)),'h field_info[',cf.fields_count,']=');
  p := cf.field_info;
  for i:=0 to cf.fields_count-1 do
  begin
    writeln(hexw(rc), 'h  field_info:',i:3,'---------');
    load_field_info;
  end;
  writeln('__________________________');
  writeln(#13#10'-----method_info----');
  swap2(get(@cf.methods_count,sizeof(cf.methods_count)),0);
  writeln(hexw(rc-sizeof(cf.methods_count)), 'h  method_info [',cf.methods_count,']=');
  p := cf.method_info;
  for i:=0 to cf.methods_count-1 do
  begin
    writeln(hexw(rc),'h  method_info:',i:3,'---------');
    method_info;
  end;
  writeln('__________________________');
  writeln('OFFSET:',hexw(rc));
  swap2(get(@cf.attributes_count,sizeof(cf.attributes_count)),0);
  writeln(hexw(rc-sizeof(cf.attributes_count)),'h  attribute_info [',cf.attributes_count,']=');
  p:=cf.attribute_info;
  for i:=0 to cf.attributes_count-1 do
  begin
    load_attribute_info;
    writeln('-');
  end;
  close(f);
  freeMem(cf.attribute_info,$FFFF);
  freeMem(cf.method_info,$FFFF);
  freeMem(cf.field_info,$FFFF);
  freeMem(cf.interfaces,$7FFF);
  freeMem(cf.cp_info,$FFFF);
end.

satan · 25.09.2008, 16:20

Ну вот мля куды ты гонишь? У меня падает компилер на этом
reset(f,1); <- Вот тута... Но ладно, ща буду разбирацо!

Сори файл fw.cla на русском создал... Пойду просыпацоо ...

for i:=0 to cf.methods_count-1 do
begin
writeln(hexw(rc),'hmethod_info:',i:3,'---------');
method_info; // <- Тут зацикливается
end;

-----------------------------------------------------------------

А ваще красавец! 100 балов! Ты тока шо создал Дизассемблер Java, если синтаксис немного поменять,
JavaBite копия! Гы...ы.ы.ыыыыы.....

Ты токма не гони лошадей... Ща буим смореть...
Ток не пойму чо у тя антивирь кричит?
У меня лицуха... все ОК... KIS7

abcdef · 25.09.2008, 19:02

хм, сейчас глянул, а некоторые символы исчезли в исходнике...
наверное при конвертировке почему-то потерялись..
function swap2(pointer; offs:integer) : pointer;
должно быть function swap2(P : pointer; offs:integer) : pointer;
тоже самое с function swap4(...

abcdef · 25.09.2008, 19:14

да и еще в строке: pGenericAttribute_info:=swap2(swap2{4}(p,0),0);
поставить pGenericAttribute_info:=swap2(swap4(p,0),0);
тестировал, забыл убрать, думал описка там тип 4 байта, я ставил 2..

ПРИМЕЧАНИЕ: компилятор нужно настроить чтобы он не выравнивал переменные в памяти, а то размер структур будет больше, т.е. sizeof(...) и д.р. будет работать некорректно

Piligrim · 26.09.2008, 14:05

Сообщение от abcdef

хм, сейчас глянул, а некоторые символы исчезли в исходнике...
наверное при конвертировке почему-то потерялись..

Если хотите чтобы символы н пропадали, для кусков кода используйте форматирование.

const
 t : integer;

abcdef · 26.09.2008, 23:07

вот передалел немножко на свежую голову... - заработало,
теперь нужно сделать чтоб распознавались блоки "Code", "Exception", "LocalVariableTable"
будет свободное время - надо начинать делать java-ассемблер

{$apptype console}
{$R+,S+}
const
CONSTANT_Class = 7;
CONSTANT_Fieldref = 9;
CONSTANT_Methodref = 10;
CONSTANT_InterfaceMethodref = 11;
CONSTANT_String = 8;
CONSTANT_Integer = 3;
CONSTANT_Float = 4;
CONSTANT_Long = 5;
CONSTANT_Double = 6;
CONSTANT_NameAndType = 12;
CONSTANT_Utf8 = 1;
CONSTANT_Unicode = 2;
{------------------------------}
ACC_PUBLIC = 1;
ACC_PRIVATE = 2;
ACC_PROTECTED = 4;
ACC_STATIC = 8;
ACC_FINAL = 16;
ACC_SYNCHRONIZED = 32;
ACC_SUPER = 32;
ACC_VOLATILE = 64;
ACC_TRANSIENT = 128;
ACC_NATIVE = 256;
ACC_INTERFACE = 512;
ACC_ABSTRACT = 1024;
{}
type
tfield_info = record
access_flags : word;
name_index : word;
signature_index : word;
attributes_count : word;
{attributes[attribute_count]}
end;
{}
tmethod_info = record
access_flags : word;
name_index : word;
signature_index : word;
attributes_count : word;
{attributes[attribute_count]}
end;
{--атрибуты--}
tGenericAttribute_info = record
attribute_name : word;
attribute_length : longInt;
{info[attribute_length] of byte}
end;
{}
tSourceFile_attribute = record
attribute_name_index : word;
attribute_length : longInt;
sourcefile_index : word;
end;
{}
tLineNumberTable_attribute = record
attribute_name_index : word;
attribute_length : longInt;
line_number_table_length : word;
{line_number_table[line_number_table_length] of record start_pc,line_number:word;end;}
end;
{}
tConstantValue_attribute = record
attribute_name_index : word;
attribute_length : longInt;
constantvalue_index : word;
end;
{}
tLocalVariableTable_attribute = record
attribute_name_index : word;
attribute_length : longInt;
local_variable_table_length : word;
{local_variable_table[local_variable_table_length]}
end;
tLocal_variable_table = record
start_pc : word;
length : word;
name_index : word;
signature_index : word;
slot : word;
end;
{}
tExceptions_attribute = record
attribute_name_index : word;
attribute_length : longInt;
number_of_exceptions : word;
{exception_index_table[number_of_exceptions] of word}
end;
{}
tInnerClasses_attribute = record
attribute_name_index : word;
attribute_length : longInt;
number_of_classes : word;
{classes[number_of_classes] of record
inner_class_info_index : word;
outer_class_info_index : word;
inner_name_index : word;
inner_class_access_flags : word;
end}
end;
{}
tSynthetic_attribute = record
attribute_name_index : word;
attribute_length : longInt;
end;
{}
Deprecated_attribute = record
attribute_name_index : word;
attribute_length : longInt;
end;
{}
tCode_attribute = record
attribute_name_index : word;
attribute_length : longInt;
max_stack : word;
max_locals : word;
code_length : longInt;
end;
{code[code_length]}
{exception_table_length : word;{***}
{exception_table[exception_table_length]}
{attributes_count : word;{***}
{attribute_info[attribute_count]}
tException_table = record
start_pc : word;
end_pc : word;
handler_pc : word;
catch_type : word;
end;
{--------------------------}
tarr = array[0..$FFFF-1] of byte;
var
cf : record {ClassFile}
magic : longInt;
minor_version : word;
major_version : word;
constant_pool_count : word;
cp_info :^tarr;{constant_pool[constant_pool_count - 1];}
access_flags : word;
this_class : word;
super_class : word;
interfaces_count : word;
interfaces :^tarr;{[interfaces_count];}
fields_count : word;
field_info :^tarr;{fields[fields_count];}
methods_count : word;
method_info :^tarr;{methods[methods_count];}
attributes_count : word;
attribute_info :^tarr;{attributes[attribute_count];}
end;
var
f : file;
i,j,n,rc : integer; {longInt;}
s : string;
tag : byte;
p :^byte;
pfield_info :^tfield_info;
pmethod_info :^tmethod_info;
pGenericAttribute_info :^tGenericAttribute_info;
pCode_attribute :^tCode_attribute;
pException_table :^tException_table;
pexception_table_length :^word;
pattributes_count :^word;
pLocalVariableTable_attribute :^tLocalVariableTable_attribute;
pLocal_variable_table :^tLocal_variable_table;

function hex(b : byte) : string;
const
h : array[0..$F] of char = '0123456789ABCDEF';
begin
hex := h[b shr 4]+h[b and $F];
end;

function hexw(w : word) : string;
begin
hexw := hex(hi(w))+hex(lo(w));
end;

function get(p : pointer; count : integer) : pointer;
var
n : integer;
begin
blockRead(f,p^,count,n);
inc(longInt(p),n); {pasc}
inc(rc,n);
get := p; {get := ptr(cardinal(p)+count); //delphi}
end;

function swap2(p : pointer; offs : integer) : pointer;
var
b1,b2 :^byte;
b : byte;
begin
dec(longInt(p),offs+1);
b1 := p;
dec(longInt(p));
b2 := p;
b := b1^; b1^ := b2^; b2^ := b;
swap2 := p;
end;

function swap4(p : pointer; offs : integer) : pointer;
var
w1,w2 : ^word;
w : word;
begin
w1 := swap2(p,0);
w2 := swap2(w1,0);
w := w1^; w1^ := w2^; w2^ := w;
swap4 := w2;
end;

function pconst(i : integer) : pointer;
var
w :^word;
p :^byte;
begin
p := nil;
if (i>=1) and (i<cf.constant_pool_count-1) then
begin
p := @cf.cp_info^;
while i>=1 do
begin
case p^ of
CONSTANT_Class: inc(p,1+2);
CONSTANT_Fieldref,CONSTANT_Methodref,CONSTANT_Inte rfaceMethodref: inc(p,1+4);
CONSTANT_String: inc(p,1+2);
CONSTANT_Integer,CONSTANT_Float: inc(p,1+4);
CONSTANT_Long: inc(p,1+8 );
CONSTANT_NameAndType: inc(p,1+4);
CONSTANT_Utf8, CONSTANT_Unicode:
begin {null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
inc(p);
w := @p^;
inc(p,2);
inc(p,w^)
end;
else
begin
p := nil; i := 0;
end;
end;
dec(i);
end;
end;
pconst := p;
end;

function getConstStr(index : word) : string;
var
s : string;
i,j : word;
p :^byte;
w :^word;
begin
s := '';
p := pconst(index);
if p<>nil then
case p^ of
CONSTANT_Class:
begin
w := @p^;
inc(w);
p := pconst(w^);
end;
CONSTANT_Fieldref,CONSTANT_Methodref,CONSTANT_Inte rfaceMethodref:
begin
w := @p^;
inc(w);
p := pconst(w^);
end;
CONSTANT_String:
begin
w := @p^;
inc(w);
p := pconst(w^);
end;
CONSTANT_NameAndType:
begin
w := @p^;
inc(w);
p := pconst(w^);
end;
end;
{null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
if p<>nil then
if (p^ in [CONSTANT_Utf8, CONSTANT_Unicode]) then
begin
inc(p);
w := @p^;
inc(p,2);
for j := 0 to w^-1 do
begin
s := s+chr(p^);
inc(p);
end;
end;
getConstStr := s;
end;

{-------------------}

procedure load_const;
begin
get(p,1);
tag := p^;
inc(p);
write(tag:2,' ');
case tag of
CONSTANT_Class:
begin
p := get(p,2);
write('CONSTANT_Class:',word(swap2(p,0)^));
end;
CONSTANT_Fieldref,CONSTANT_Methodref,CONSTANT_Inte rfaceMethodref:
begin
case tag of
CONSTANT_Fieldref: write('CONSTANT_Fieldref:');
CONSTANT_Methodref: write('CONSTANT_Methodref:');
CONSTANT_InterfaceMethodref: write('CONSTANT_InterfaceMethodref:');
end;
p := get(p,4);
write(word(swap2(p,2)^),' ',word(swap2(p,0)^));
end;
CONSTANT_String:
begin
p := get(p,2);
write('CONSTANT_String:',word(swap2(p,0)^));
end;
CONSTANT_Integer,CONSTANT_Float:
begin
case tag of
CONSTANT_Integer: write('CONSTANT_Integer:');
CONSTANT_Float: write('CONSTANT_Float:');
end;
p := get(p,4);
write(longInt(swap4(p,0)^));
end;
CONSTANT_Long,CONSTANT_Double:
begin
case tag of
CONSTANT_Long: write('CONSTANT_Integer:');
CONSTANT_Double: write('CONSTANT_Double:');
end;
p := get(p,8 );
write('_hi_',longInt(swap4(p,4)^),'_lo_',longInt(s wap4(p,0)^));
end;
CONSTANT_NameAndType:
begin
p := get(p,4);
write('CONSTANT_NameAndType:',word(swap2(p,2)^),' ',word(swap2(p,0)^));
end;
CONSTANT_Utf8, CONSTANT_Unicode:
begin {null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
p := get(p,2); {length}
n := word(swap2(p,0)^);
write('CONSTANT_Utf8-Unicode [',n,']=');
for j := 0 to n-1 do
begin
get(p,1);
write(chr(p^));
inc(p);
end;
end;
else
if tag<>0 then
begin
write('error:',tag);
halt;
end;
end;
writeln;
end;

procedure load_attribute_info;
begin
writeln(hexw(rc), 'h GenericAttribute_info');
p:=get(p,sizeof(pGenericAttribute_info^));
pGenericAttribute_info:=swap2(swap4(p,0),0);
writeln('attribute_name:',pGenericAttribute_info^. attribute_name);
writeln('attribute_length:',pGenericAttribute_info ^.attribute_length);
s := getConstStr(pGenericAttribute_info^.attribute_name );
if s='Code' then
begin
writeln(hexw(rc), 'h Code');
p := get(p,sizeof(pCode_attribute^));
pCode_attribute := swap2(swap4(swap2(swap2(swap4(p,0),0),0),0),0);
writeln(hexw(rc-sizeof(pCode_attribute^.attribute_name_index)),
' attribute_name_index:',pCode_attribute^.attribute_ name_index);
writeln(hexw(rc-sizeof(pCode_attribute^.attribute_length)),
' attribute_length:',pCode_attribute^.attribute_leng th);
writeln(hexw(rc-sizeof(pCode_attribute^.max_stack)),
' max_stack:',pCode_attribute^.max_stack);
writeln(hexw(rc-sizeof(pCode_attribute^.max_locals)),
' max_locals:',pCode_attribute^.max_locals);
writeln(hexw(rc-sizeof(pCode_attribute^.code_length)),
' code_length:',pCode_attribute^.code_length);
for n := 0 to pCode_attribute^.code_length-1 do p:=get(p,1);
p := get(p,sizeof(pexception_table_length^));
pexception_table_length:=swap2(p,0);
for n := 0 to pexception_table_length^-1 do
begin
p := get(p,sizeof(pException_table^));
pException_table := swap2(swap2(swap2(swap2(p,0),0),0),0);
end;
p := get(p,sizeof(pattributes_count^));
pattributes_count :=swap2(p,0);
for n := 0 to pattributes_count^-1 do
load_attribute_info;
end
else if s='LocalVariableTable' then
begin
writeln(hexw(rc), 'h LocalVariableTable');
p := get(p,sizeof(pLocalVariableTable_attribute^));
pLocalVariableTable_attribute := swap2(swap4(swap2(p,0),0),0);
writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.attribute_na me_index)),
' attribute_name_index:',pLocalVariableTable_attribu te^.attribute_name_index);
writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.attribute_le ngth)),
' attribute_length:',pLocalVariableTable_attribute^. attribute_length);
writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.local_variab le_table_length)),
' local_variable_table_length:',pLocalVariableTable_ attribute^.local_variable_table_length);
for n := 0 to pLocalVariableTable_attribute^.local_variable_tabl e_length-1 do
begin
p := get(p,sizeof(pLocal_variable_table^));
pLocal_variable_table := swap2(swap2(swap2(swap2(swap2(p,0),0),0),0),0);
writeln('start_pc:',pLocal_variable_table^.start_p c);
writeln('length:',pLocal_variable_table^.length);
writeln('name_index:',pLocal_variable_table^.name_ index);
writeln('signature_index:',pLocal_variable_table^. signature_index);
writeln('slot:',pLocal_variable_table^.slot);
end;
end
{if s='SourceFile' then
begin
end
else if s='LineNumberTable' then
begin
end{}
else {don't know... skip atributes}
begin
for n := 0 to pGenericAttribute_info^.attribute_length-1 do
begin
get(p,1);
write(hex(byte(p^)),' ');
inc(p);
end;
end;
writeln;
end;

procedure load_interfaces;
begin
p := get(p,2);
write(word(swap2(p,0)^),',');
end;

procedure load_field_info;
begin
p := get(p,sizeof(pfield_info^));
pfield_info := swap2(swap2(swap2(swap2(p,0),0),0),0);
writeln('access_flags:',pfield_info^.access_flags) ;
writeln('name_index:',pfield_info^.name_index);
writeln('signature_index:',pfield_info^.signature_ index);
writeln('attributes_count:',pfield_info^.attribute s_count, ' offs:[',hexw(rc), 'h]');
for j := 0 to pfield_info^.attributes_count-1 do
load_attribute_info;
end;

procedure method_info;
begin
p := get(p,sizeof(pmethod_info^));
pmethod_info := swap2(swap2(swap2(swap2(p,0),0),0),0);
writeln('access_flags:',pmethod_info^.access_flags );
writeln('name_index:',pmethod_info^.name_index);
writeln('signature_index:',pmethod_info^.signature _index);
writeln('attributes_count:',pmethod_info^.attribut es_count, ' offs:[',hexw(rc), 'h]' );
for j := 0 to pmethod_info^.attributes_count-1 do
load_attribute_info;
end;

begin
getMem(cf.cp_info,$FFFF);
getMem(cf.interfaces,$7FFF);
getMem(cf.field_info,$FFFF);
getMem(cf.method_info,$FFFF);
getMem(cf.attribute_info,$FFFF);
fillChar(cf.cp_info^, $FFFF, 0);
fillChar(cf.interfaces^, $7FFF, 0);
fillChar(cf.field_info^, $FFFF, 0);
fillChar(cf.method_info^, $FFFF, 0);
fillChar(cf.attribute_info^, $FFFF, 0);
assign(f,'fw.cla');
{cf.magic := $CAFEBABE; cf.minor_version := $0000; cf.major_version := $002E;
rewrite(f,1);
blockWrite(f,cf.magic,sizeof(cf.magic),n);
blockWrite(f,cf.minor_version,sizeof(cf.minor_vers ion),n);
blockWrite(f,cf.major_version,sizeof(cf.major_vers ion),n);{...}
reset(f,1);
rc := 0;
swap4(get(@cf.magic,sizeof(cf.magic)),0);
swap2(get(@cf.minor_version,sizeof(cf.minor_versio n)),0);
swap2(get(@cf.major_version,sizeof(cf.major_versio n)),0);
swap2(get(@cf.constant_pool_count,sizeof(cf.consta nt_pool_count)),0);
p := @cf.cp_info^;
for i := 1 to cf.constant_pool_count-1 do {здесь именно с 1 по cf.constant_pool_count-1}
begin
write(hexw(rc-1),'h ',i:3,' ');
load_const; {загрузка и распознование cp_info}
end;
writeln('__________________________');
swap2(get(@cf.access_flags,sizeof(cf.access_flags) ),0);
writeln(hexw(rc-sizeof(cf.access_flags)),'h access_flags:',cf.access_flags);
swap2(get(@cf.this_class,sizeof(cf.this_class)),0) ;
writeln(hexw(rc-sizeof(cf.this_class)),'h this_class:',cf.this_class);
swap2(get(@cf.super_class,sizeof(cf.super_class)), 0);
writeln(hexw(rc-sizeof(cf.super_class)),'h super_class:',cf.super_class);
writeln(#13#10'-----load_interfaces----');
swap2(get(@cf.interfaces_count,sizeof(cf.interface s_count)),0);
writeln(hexw(rc-sizeof(cf.interfaces_count)),'h interfaces[',cf.interfaces_count,']=');
p := @cf.interfaces^;
for i := 0 to cf.interfaces_count-1 do
load_interfaces; {загрузка interfaces}
writeln(#13#10'__________________________');
writeln(#13#10'-----load_field_info----');
swap2(get(@cf.fields_count,sizeof(cf.fields_count) ),0);
writeln(hexw(rc-sizeof(cf.fields_count)),'h field_info[',cf.fields_count,']=');
p := @cf.field_info^;
for i := 0 to cf.fields_count-1 do
begin
writeln(hexw(rc), 'h field_info:',i:3,'---------');
load_field_info; {загрузка field_info}
end;
writeln('__________________________');
writeln(#13#10'-----method_info----');
swap2(get(@cf.methods_count,sizeof(cf.methods_coun t)),0);
writeln(hexw(rc-sizeof(cf.methods_count)), 'h method_info [',cf.methods_count,']=');
p := @cf.method_info^;
for i := 0 to cf.methods_count-1 do
begin
writeln(hexw(rc),'h method_info:',i:3,'---------');
method_info; {загрузка method_info}
end;
writeln('__________________________');
writeln('OFFSET:',hexw(rc));
swap2(get(@cf.attributes_count,sizeof(cf.attribute s_count)),0);
writeln(hexw(rc-sizeof(cf.attributes_count)),'h attribute_info [',cf.attributes_count,']=');
p := @cf.attribute_info^;
for i := 0 to cf.attributes_count-1 do
begin
load_attribute_info;
writeln('-');
end;
close(f);
freeMem(cf.attribute_info,$FFFF);
freeMem(cf.method_info,$FFFF);
freeMem(cf.field_info,$FFFF);
freeMem(cf.interfaces,$7FFF);
freeMem(cf.cp_info,$FFFF);
end.

satan · 27.09.2008, 00:55

а ты какой файл дизазмишь если не секрет? Я простой HelloWord, так у меня что тот, что этот зацикливается на методах а этот теперь еще и на атрибутах...

Мля... Сори, все ок... Я тож наверно от недосыпу тупить уж начал...

satan · 27.09.2008, 05:05

Вобчем смотрим чо происходит

0009h 1 1 CONSTANT_Utf8-Unicode [10] = HelloWorld
0016h 2 7 CONSTANT_Class:1
0019h 3 1 CONSTANT_Utf8-Unicode [16] = java/lang/Object
002Ch 4 7 CONSTANT_Class:3
002Fh 5 1 CONSTANT_Utf8-Unicode [4] = main
0036h 6 1 CONSTANT_Utf8-Unicode [22] = ([Ljava/lang/StringV
004Fh 7 1 CONSTANT_Utf8-Unicode [4] = Code
0056h 8 1 CONSTANT_Utf8-Unicode [15] = LineNumberTable
0068h 9 1 CONSTANT_Utf8-Unicode [3] = out
006Eh 10 1 CONSTANT_Utf8-Unicode [21] = Ljava/io/PrintStream;
0086h 11 12 CONSTANT_NameAndType: 9 10
008Bh 12 1 CONSTANT_Utf8-Unicode [16] = java/lang/System
009Eh 13 7 CONSTANT_Class: 12
00A1h 14 9 CONSTANT_Fieldref: 13 11
00A6h 15 1 CONSTANT_Utf8-Unicode [12] = Hello World!
00B5h 16 8 CONSTANT_String:15
00B8h 17 1 CONSTANT_Utf8-Unicode [7] = println
00C2h 18 1 CONSTANT_Utf8-Unicode [21] = (Ljava/lang/StringV
00DAh 19 12 CONSTANT_NameAndType: 17 18
00DFh 20 1 CONSTANT_Utf8-Unicode [19] = java/io/PrintStream
00F5h 21 7 CONSTANT_Class: 20
00F8h 22 10 CONSTANT_Methodref: 21 19
00FDh 23 1 CONSTANT_Utf8-Unicode [6] = <init>
0106h 24 1 CONSTANT_Utf8-Unicode [3] = ()V
010Ch 25 12 CONSTANT_NameAndType: 23 24
0111h 26 10 CONSTANT_Methodref: 4 25
0116h 27 1 CONSTANT_Utf8-Unicode [10] = SourceFile
0123h 28 1 CONSTANT_Utf8-Unicode [15] = HelloWorld.java

0136h access_flags:32
0138h this_class:2
013Ah super_class:4

013Ch interfaces[0]=
013Eh field_info[0]=

0140h method_info [2]=
0142h method_info: 0---------
access_flags:9
name_index:5
signature_index:6
attributes_count:1 offs:[014Ah]
014Ah GenericAttribute_info
attribute_name:7 <- Ссылкана 7 элемент “Code”
attribute_length:37 <- Длинна

00 02 00 01 00 00 00 09 B2 00 0E 12 10 B6 00 16 B1 00 00 00 01 00 08 00 00 00 0A00 02 00 00 00 03 00 08 00 04

0175h method_info: 1---------
access_flags:0
name_index:23
signature_index:24
attributes_count:1 offs:[017Dh]
017Dh GenericAttribute_info
attribute_name:7 <- Ссылкана 7 элемент “Code”
attribute_length:33 <- Длинна

00 01 00 01 00 00 00 05 2A B7 00 1A B1 00 00 00 01 00 08 00 00 00 0A 00 02 00 00 00 01 00 04 00 01

OFFSET: 01A4
01A4h attribute_info [1]=

красным выделил где данные уже считываюца, тоесть у нас уже атрибуты получены, поэтому дальше надо сразу разбирать код

Вот на вскидку...
procedure load_attribute_info;
...

s := getConstStr(pGenericAttribute_info^.attribute_name - 1); // отнятьединицу так как элементы с нуля отчет ведут
...
if s='Code' then
...
pCode_attribute := swap2(swap4(swap2(swap2(swap4(p,0),0),0),0),0); // удалить красное

writeln(hexw(rc-sizeof(pCode_attribute^.attribute_name_index)),
' attribute_name_index:',pCode_attribute^.attribute_ name_index);
writeln(hexw(rc-sizeof(pCode_attribute^.attribute_length)),
' attribute_length:',pCode_attribute^.attribute_leng th); // Удалить

{}
tCode_attribute = record
attribute_name_index : word; // Удалить или задать pGenericAttribute_info^.attribute_name
attribute_length : longInt;// Удалить или задать pGenericAttribute_info ^.attribute_length
max_stack : word;
max_locals : word;
code_length : longInt;
end;

В итоге получаем типа вот этого

attribute_name:7 <- Ссылкана 7 элемент “Code”
attribute_length:37 <- Длинна

0150h Code:
0156 max_stack:2
0156 max_locals:1
0154 code_length:9
0165h GenericAttribute_info
attribute_name:8
attribute_length:10
00 02 00 00 00 03 00 08 00 04

где красным - это уже сам байт-код должен идти, а за ним уже разбор exception_table
и естественно если у нас тута будет attribute_name:NN <- Ссылка на элемент “Exceptions” то разбирать её...

Ужо голова не соображает
abcdef дружище ты если проснесся быстрее меня, замути тему... А то я ужо совсем в осадок выпадаю, кабы косяков не натворил...

satan · 27.09.2008, 05:48

Так после перекоцывания

0150h Code:
0156 max_stack:2
0156 max_locals:1
0154 code_length:9

B2 00 0E 12 10 B6 00 16 B1 <- Байт код

//------------------------------
B2 00 0E ....getstatic #000E
12 10 .......ldc #0010
B6 00 16 ....invokevirtual #0016
B1 ..........return
//------------------------------

0165h GenericAttribute_info
attribute_name:8 <- Указатель (в нашем случае) на LineNumberTable
attribute_length:10 <- Длинна

00 02 00 00 00 03 00 08 00 04

Осталось разобрать LineNumberTable которая в свою очередь уже начинается не с attribute_name_index а с start_pc

satan · 27.09.2008, 07:56

Вощем во...

{$apptype console}

{$R+,S+}
const
  CONSTANT_Class = 7;
  CONSTANT_Fieldref = 9;
  CONSTANT_Methodref = 10;
  CONSTANT_InterfaceMethodref = 11;
  CONSTANT_String = 8;
  CONSTANT_Integer = 3;
  CONSTANT_Float = 4;
  CONSTANT_Long = 5;
  CONSTANT_Double = 6;
  CONSTANT_NameAndType = 12;
  CONSTANT_Utf8 = 1;
  CONSTANT_Unicode = 2;
  {------------------------------}
  ACC_PUBLIC = 1;
  ACC_PRIVATE = 2;
  ACC_PROTECTED = 4;
  ACC_STATIC = 8;
  ACC_FINAL = 16;
  ACC_SYNCHRONIZED = 32;
  ACC_SUPER = 32;
  ACC_VOLATILE = 64;
  ACC_TRANSIENT = 128;
  ACC_NATIVE = 256;
  ACC_INTERFACE = 512;
  ACC_ABSTRACT = 1024;
  {}
  TAB             = ^I;
  TAB2            = ^I^I;
  TAB3            = ^I^I^I;
  TAB4            = ^I^I^I^I;
  CR              = ^M;
  LF              = ^J;
  {}
type
  tfield_info = record
  access_flags : word;
  name_index : word;
  signature_index : word;
  attributes_count : word;
  {attributes[attribute_count]}
  end;
  {}
  tmethod_info = record
  access_flags : word;
  name_index : word;
  signature_index : word;
  attributes_count : word;
  {attributes[attribute_count]}
  end;
  {--атрибуты--}
  tGenericAttribute_info = record
  attribute_name : word;
  attribute_length : longInt;
  {info[attribute_length] of byte}
  end;
  {}
  tSourceFile_attribute = record
  attribute_name_index : word;
  attribute_length : longInt;
  sourcefile_index : word;
  end;
  {}
  tLineNumberTable_attribute = record
  attribute_name_index : word;
  attribute_length : longInt;
  line_number_table_length : word;
  {line_number_table[line_number_table_length] of record start_pc,line_number:word;end;}
  end;
  {}
  tConstantValue_attribute = record
  attribute_name_index : word;
  attribute_length : longInt;
  constantvalue_index : word;
  end;
  {}
  tLocalVariableTable_attribute = record
  attribute_name_index : word;
  attribute_length : longInt;
  local_variable_table_length : word;
  {local_variable_table[local_variable_table_length]}
  end;
  tLocal_variable_table = record
  start_pc : word;
  length : word;
  name_index : word;
  signature_index : word;
  slot : word;
  end;
  {}
  tExceptions_attribute = record
  attribute_name_index : word;
  attribute_length : longInt;
  number_of_exceptions : word;
  {exception_index_table[number_of_exceptions] of word}
  end;
  {}
  tInnerClasses_attribute = record
  attribute_name_index : word;
  attribute_length : longInt;
  number_of_classes : word;
  {classes[number_of_classes] of record
  inner_class_info_index : word;
  outer_class_info_index : word;
  inner_name_index : word;
  inner_class_access_flags : word;
  end}
  end;
  {}
  tSynthetic_attribute = record
  attribute_name_index : word;
  attribute_length : longInt;
  end;
  {}
  Deprecated_attribute = record
  attribute_name_index : word;
  attribute_length : longInt;
  end;
  {}
  tCode_attribute = record
  //attribute_name_index : word;
  //attribute_length : longInt;
  max_stack : word;
  max_locals : word;
  code_length : longInt;
  end;
  {code[code_length]}
  {exception_table_length : word;{***}
  {exception_table[exception_table_length]}
  {attributes_count : word;{***}
  {attribute_info[attribute_count]}
  tException_table = record
  start_pc : word;
  end_pc : word;
  handler_pc : word;
  catch_type : word;
  end;
  {--------------------------}

tarr = array[0..$FFFF-1] of byte;

var
  cf : record {ClassFile}
  magic : longInt;
  minor_version : word;
  major_version : word;
  constant_pool_count : word;
  cp_info :^tarr;{constant_pool[constant_pool_count - 1];}
  access_flags : word;
  this_class : word;
  super_class : word;
  interfaces_count : word;
  interfaces :^tarr;{[interfaces_count];}
  fields_count : word;
  field_info :^tarr;{fields[fields_count];}
  methods_count : word;
  method_info :^tarr;{methods[methods_count];}
  attributes_count : word;
  attribute_info :^tarr;{attributes[attribute_count];}
end;

var
  f : file;
  i,j,n,rc : integer; {longInt;}
  s : string;
  tag : byte;
  p :^byte;
  pfield_info :^tfield_info;
  pmethod_info :^tmethod_info;
  pGenericAttribute_info :^tGenericAttribute_info;
  pCode_attribute :^tCode_attribute;
  pException_table :^tException_table;
  pexception_table_length :^word;
  pattributes_count :^word;
  pLocalVariableTable_attribute :^tLocalVariableTable_attribute;
  pLocal_variable_table :^tLocal_variable_table;


function hex(b : byte) : string;
const
  h : array[0..$F] of char = '0123456789ABCDEF';
begin
  hex := h[b shr 4]+h[b and $F];
end;


function hexw(w : word) : string;
begin
  hexw := hex(hi(w))+hex(lo(w));
end;


function get(p : pointer; count : integer) : pointer;
var
  n : integer;
begin
  blockRead(f,p^,count,n);
  inc(longInt(p),n); {pasc}
  inc(rc,n);
  get := p; {get := ptr(cardinal(p)+count); //delphi}
end;

function swap2(p : pointer; offs : integer) : pointer;
var
  b1,b2 :^byte;
  b : byte;
begin
  dec(longInt(p),offs+1);
  b1 := p;
  dec(longInt(p));
  b2 := p;
  b := b1^; b1^ := b2^; b2^ := b;
  swap2 := p;
end;


function swap4(p : pointer; offs : integer) : pointer;
var
  w1,w2 : ^word;
  w : word;
begin
  w1 := swap2(p,0);
  w2 := swap2(w1,0);
  w := w1^; w1^ := w2^; w2^ := w;
  swap4 := w2;
end;


function pconst(i : integer) : pointer;
var
  w :^word;
  p :^byte;
begin
  p := nil;
  if (i>=1) and (i<cf.constant_pool_count-1) then
  begin
    p := @cf.cp_info^;
    while i>=1 do
    begin
      case p^ of
        CONSTANT_Class                        : inc(p,1+2);
        CONSTANT_Fieldref,CONSTANT_Methodref,
        CONSTANT_InterfaceMethodref           : inc(p,1+4);
        CONSTANT_String                       : inc(p,1+2);
        CONSTANT_Integer,CONSTANT_Float       : inc(p,1+4);
        CONSTANT_Long                         : inc(p,1+8 );
        CONSTANT_NameAndType                  : inc(p,1+4);
        CONSTANT_Utf8, CONSTANT_Unicode       :
                                                begin {null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
                                                  inc(p);
                                                  w := @p^;
                                                  inc(p,2);
                                                  inc(p,w^)
                                                end;
      else
      begin
        p := nil; i := 0;
      end;
    end;
    dec(i);
    end;
  end;
  pconst := p;
end;

function getConstStr(index : word) : string;
var
  s : string;
  j : word;
  p :^byte;
  w :^word;
begin
  s := '';
  p := pconst(index);
  if p<>nil then
  case p^ of
    CONSTANT_Class                          :
                                              begin
                                                w := @p^;
                                                inc(w);
                                                p := pconst(w^);
                                              end;
    CONSTANT_Fieldref,CONSTANT_Methodref,
    CONSTANT_InterfaceMethodref             :
                                              begin
                                                w := @p^;
                                                inc(w);
                                                p := pconst(w^);
                                              end;
    CONSTANT_String                         :
                                              begin
                                                w := @p^;
                                                inc(w);
                                                p := pconst(w^);
                                              end;
    CONSTANT_NameAndType                    :
                                              begin
                                                w := @p^;
                                                inc(w);
                                                p := pconst(w^);
                                              end;
  end;
  {null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
  if p<>nil then
    if (p^ in [CONSTANT_Utf8, CONSTANT_Unicode]) then
    begin
      inc(p);
      w := @p^;
      inc(p,2);
      for j := 0 to w^-1 do
      begin
        s := s+chr(p^);
        inc(p);
      end;
    end;
  getConstStr := s;
end;

{-------------------}

procedure load_const;
begin
  get(p,1);
  tag := p^;
  inc(p);
  write(tag:2,' ');
  case tag of
  CONSTANT_Class                                  :
                                                    begin
                                                      p := get(p,2);
                                                      write('CONSTANT_Class             :',TAB,word(swap2(p,0)^));
                                                    end;
  CONSTANT_Fieldref,CONSTANT_Methodref,
  CONSTANT_InterfaceMethodref                     :
                                                    begin
                                                      case tag of
                                                        CONSTANT_Fieldref             : write('CONSTANT_Fieldref          :');
                                                        CONSTANT_Methodref            : write('CONSTANT_Methodref         :');
                                                        CONSTANT_InterfaceMethodref   : write('CONSTANT_InterfaceMethodref:');
                                                      end;
                                                      p := get(p,4);
                                                      write(TAB,word(swap2(p,2)^),TAB,word(swap2(p,0)^));
                                                    end;
  CONSTANT_String                                 :
                                                    begin
                                                      p := get(p,2);
                                                      write('CONSTANT_String            :',TAB,word(swap2(p,0)^));
                                                    end;
  CONSTANT_Integer,CONSTANT_Float                 :
                                                    begin
                                                      case tag of
                                                        CONSTANT_Integer  : write('CONSTANT_Integer         :');
                                                        CONSTANT_Float    : write('CONSTANT_Float           :');
                                                      end;
                                                      p := get(p,4);
                                                      write(TAB,longInt(swap4(p,0)^));
                                                    end;
  CONSTANT_Long,CONSTANT_Double                   :
                                                    begin
                                                      case tag of
                                                        CONSTANT_Long: write('CONSTANT_Integer          :');
                                                        CONSTANT_Double: write('CONSTANT_Double         :');
                                                      end;
                                                      p := get(p,8 );
                                                      write(TAB,'_hi_',longInt(swap4(p,4)^),TAB,'_lo_',longInt(swap4(p,0)^));
                                                    end;
  CONSTANT_NameAndType                            :
                                                    begin
                                                      p := get(p,4);
                                                      write('CONSTANT_NameAndType       :',TAB,word(swap2(p,2)^),TAB,word(swap2(p,0)^));
                                                    end;
  CONSTANT_Utf8, CONSTANT_Unicode                 :
                                                    begin {null=$0000, 1b=$0001-$007F,2b=$0008-$07FF,3b=$0800-$FFFF{}
                                                      p := get(p,2); {length}
                                                      n := word(swap2(p,0)^);
                                                      write('CONSTANT_Utf8-Unicode [',n,']',TAB,'=',TAB);
                                                      for j := 0 to n-1 do
                                                      begin
                                                        get(p,1);
                                                        write(chr(p^));
                                                        inc(p);
                                                      end;
                                                    end;
  else
    if tag<>0 then
    begin
      write('error:',tag);
      halt;
    end;
  end;
  writeln;
end;


procedure load_attribute_info;
begin

  writeln(hexw(rc), 'h',TAB2,'GenericAttribute_info');
  p:=get(p,sizeof(pGenericAttribute_info^));
  pGenericAttribute_info:=swap2(swap4(p,0),0);
  s := getConstStr(pGenericAttribute_info^.attribute_name-1);
  writeln(TAB2,'attribute_name    :',TAB2,pGenericAttribute_info^.attribute_name,TAB,'-> ',s);
  writeln(TAB2,'attribute_length  :',TAB2,pGenericAttribute_info ^.attribute_length);

  if s='Code' then
  begin

    writeln(hexw(rc), 'h',TAB,'Code:');
    p := get(p,sizeof(pCode_attribute^));
    pCode_attribute := swap2(swap2(swap4(p,0),0),0);

    writeln(hexw(rc-sizeof(pCode_attribute^.max_stack)),
    'h',TAB2,'max_stack         :',TAB2,pCode_attribute^.max_stack);
    writeln(hexw(rc-sizeof(pCode_attribute^.max_locals)),
    'h',TAB2,'max_locals        :',TAB2,pCode_attribute^.max_locals);
    writeln(hexw(rc-sizeof(pCode_attribute^.code_length)),
    'h',TAB2,'code_length       :',TAB2,pCode_attribute^.code_length);

    write(#10#13,TAB2);
    for n := 0 to pCode_attribute^.code_length-1 do
    begin
      get(p,1);
      write(hex(byte(p^)),' ');
      if ((n+1) mod 8)=0 then write(#10#13,TAB2);
    end;
    writeln;
    writeln;

    p := get(p,sizeof(pexception_table_length^));
    pexception_table_length:=swap2(p,0);
    for n := 0 to pexception_table_length^-1 do
    begin
      p := get(p,sizeof(pException_table^));
      pException_table := swap2(swap2(swap2(swap2(p,0),0),0),0);
    end;
    p := get(p,sizeof(pattributes_count^));
    pattributes_count :=swap2(p,0);
    for n := 0 to pattributes_count^-1 do
      load_attribute_info;
  end
  else if s='LocalVariableTable' then
  begin
    writeln(hexw(rc), 'h',TAB2,'LocalVariableTable');
    p := get(p,sizeof(pLocalVariableTable_attribute^));
    pLocalVariableTable_attribute := swap2(swap4(swap2(p,0),0),0);
    writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.attribute_name_index)),
    ' attribute_name_index:',pLocalVariableTable_attribute^.attribute_name_index);
    writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.attribute_length)),
    ' attribute_length:',pLocalVariableTable_attribute^. attribute_length);
    writeln(hexw(rc-sizeof(pLocalVariableTable_attribute^.local_variable_table_length)),
    ' local_variable_table_length:',pLocalVariableTable_attribute^.local_variable_table_length);
    for n := 0 to pLocalVariableTable_attribute^.local_variable_table_length-1 do
    begin
      p := get(p,sizeof(pLocal_variable_table^));
      pLocal_variable_table := swap2(swap2(swap2(swap2(swap2(p,0),0),0),0),0);
      writeln('start_pc:',pLocal_variable_table^.start_pc);
      writeln('length:',pLocal_variable_table^.length);
      writeln('name_index:',pLocal_variable_table^.name_index);
      writeln('signature_index:',pLocal_variable_table^. signature_index);
      writeln('slot:',pLocal_variable_table^.slot);
    end;
  end
  {if s='SourceFile' then
  begin
  end{}
  else if s='LineNumberTable' then
  begin
    for n := 0 to pGenericAttribute_info^.attribute_length-1 do
    begin
      get(p,1);
      //write(hex(byte(p^)),' ');
      inc(p);
    end;
  end{}
  else {don't know... skip atributes}
  begin
    write(#10#13,TAB2);
    for n := 0 to pGenericAttribute_info^.attribute_length-1 do
    begin
      get(p,1);
      write(hex(byte(p^)),' ');
      inc(p);
    end;
  end;
  writeln;
end;


procedure load_interfaces;
begin
  p := get(p,2);
  write(word(swap2(p,0)^),',');
end;


procedure load_field_info;
begin
  p := get(p,sizeof(pfield_info^));
  pfield_info := swap2(swap2(swap2(swap2(p,0),0),0),0);
  writeln(TAB2,'access_flags      :',TAB2,pfield_info^.access_flags) ;
  writeln(TAB2,'name_index        :',TAB2,pfield_info^.name_index);
  writeln(TAB2,'signature_index   :',TAB2,pfield_info^.signature_index);
  writeln(TAB2,'attributes_count  :',TAB2,pfield_info^.attributes_count,TAB,'offs:[',hexw(rc), 'h]');
  for j := 0 to pfield_info^.attributes_count-1 do
    load_attribute_info;
end;


procedure method_info;
begin
  p := get(p,sizeof(pmethod_info^));
  pmethod_info := swap2(swap2(swap2(swap2(p,0),0),0),0);
  s := getConstStr(pmethod_info^.name_index-1);
  writeln(TAB2,'access_flags      :',TAB2,pmethod_info^.access_flags );
  writeln(TAB2,'name_index        :',TAB2,'[',pmethod_info^.name_index,']',TAB,'-> ',s);
  writeln(TAB2,'signature_index   :',TAB2,pmethod_info^.signature_index);
  writeln(TAB2,'attributes_count  :',TAB2,pmethod_info^.attributes_count,TAB,'offs:[',hexw(rc), 'h]' );
  for j := 0 to pmethod_info^.attributes_count-1 do
    load_attribute_info;
end;


begin

  getMem(cf.cp_info,            $FFFF);
  getMem(cf.interfaces,         $7FFF);
  getMem(cf.field_info,         $FFFF);
  getMem(cf.method_info,        $FFFF);
  getMem(cf.attribute_info,     $FFFF);

  fillChar(cf.cp_info^,         $FFFF, 0);
  fillChar(cf.interfaces^,      $7FFF, 0);
  fillChar(cf.field_info^,      $FFFF, 0);
  fillChar(cf.method_info^,     $FFFF, 0);
  fillChar(cf.attribute_info^,  $FFFF, 0);

  assign(f,'fw.clas');
  {cf.magic := $CAFEBABE; cf.minor_version := $0000; cf.major_version := $002E;
  rewrite(f,1);
  blockWrite(f,cf.magic,sizeof(cf.magic),n);
  blockWrite(f,cf.minor_version,sizeof(cf.minor_version),n);
  blockWrite(f,cf.major_version,sizeof(cf.major_version),n);{...}
  reset(f,1);

  rc := 0;

  swap4(get(@cf.magic,sizeof(cf.magic)),0);
  swap2(get(@cf.minor_version,sizeof(cf.minor_version)),0);
  swap2(get(@cf.major_version,sizeof(cf.major_version)),0);
  swap2(get(@cf.constant_pool_count,sizeof(cf.constant_pool_count)),0);

  p := @cf.cp_info^;
  for i := 1 to cf.constant_pool_count-1 do {здесь именно с 1 по cf.constant_pool_count-1}
  begin
    write(hexw(rc-1),'h ',i:3,' ');
    load_const; {загрузка и распознование cp_info}
  end;

  writeln;
  swap2(get(@cf.access_flags,sizeof(cf.access_flags) ),0);
  writeln(hexw(rc-sizeof(cf.access_flags)),'h',TAB2,'access_flags      :',TAB2,cf.access_flags);
  swap2(get(@cf.this_class,sizeof(cf.this_class)),0) ;
  writeln(hexw(rc-sizeof(cf.this_class)),'h',TAB2,'this_class        :',TAB2,cf.this_class);
  swap2(get(@cf.super_class,sizeof(cf.super_class)), 0);
  writeln(hexw(rc-sizeof(cf.super_class)),'h',TAB2,'super_class       :',TAB2,cf.super_class);

  writeln;
  swap2(get(@cf.interfaces_count,sizeof(cf.interfaces_count)),0);
  writeln(hexw(rc-sizeof(cf.interfaces_count)),'h',TAB2,'interfaces',TAB,'[',cf.interfaces_count,']',TAB3);
  p := @cf.interfaces^;
  for i := 0 to cf.interfaces_count-1 do
    load_interfaces; {загрузка interfaces}

  writeln;
  swap2(get(@cf.fields_count,sizeof(cf.fields_count) ),0);
  writeln(hexw(rc-sizeof(cf.fields_count)),'h',TAB2,'field_info',TAB,'[',cf.fields_count,']',TAB3);
  p := @cf.field_info^;
  for i := 0 to cf.fields_count-1 do
  begin
    writeln(hexw(rc), 'h',TAB2,'field_info       :',TAB,i:3,'-----------');
    load_field_info; {загрузка field_info}
  end;

  writeln;
  swap2(get(@cf.methods_count,sizeof(cf.methods_count)),0);
  writeln(hexw(rc-sizeof(cf.methods_count)), 'h',TAB2,'method_info',TAB,'[',cf.methods_count,']',TAB3);
  p := @cf.method_info^;
  for i := 0 to cf.methods_count-1 do
  begin
    writeln(hexw(rc),'h',TAB2,'method_info       :',TAB,i:3,'-----------');
    method_info; //загрузка method_info

  end;

  writeln;
  writeln('OFFSET:         ',hexw(rc),'h');
  swap2(get(@cf.attributes_count,sizeof(cf.attributes_count)),0);
  writeln(hexw(rc-sizeof(cf.attributes_count)),'h',TAB2,'attribute_info',TAB,'[',cf.attributes_count,']');
  p := @cf.attribute_info^;
  for i := 0 to cf.attributes_count-1 do
  begin
    load_attribute_info;
    writeln(#10#13'------------------------------------------------------------------');
  end;

  close(f);
  
  freeMem(cf.attribute_info,  $FFFF);
  freeMem(cf.method_info,     $FFFF);
  freeMem(cf.field_info,      $FFFF);
  freeMem(cf.interfaces,      $7FFF);
  freeMem(cf.cp_info,         $FFFF);

end.

satan · 27.09.2008, 18:54

исправил работу с double и long переменными

case tag of
CONSTANT_Long: write('CONSTANT_Integer :');
CONSTANT_Double: write('CONSTANT_Double :');
end;
p := get(p,8 ) ;
write(TAB,'_hi: ',longInt(swap4(p,4)^),TAB,'_lo: ',longInt(swap4(p,0)^));
inc(i); // Добавить

изменить функцию на такую

i := 1;
while i <= cf.constant_pool_count-1 do {здесь именно с 1 по cf.constant_pool_count-1}
begin
write(hexw(rc-1),'h ',i:3,' ');
load_const; {загрузка и распознование cp_info}
inc(i);
end;