|
Основной форум Сюда все проблемы связанные с программированием. |
24.09.2008, 09:59
|
#31
|
Мастер
Регистрация: 19.03.2007
Сообщений: 1,039
Написано 153 полезных сообщений (для 252 пользователей)
|
Ответ: создание MIDletPascal compiler'a
Однако, свежо! Интересная веточка, желаю вам удачи в создании русского MP.
|
(Offline)
|
|
24.09.2008, 12:48
|
#32
|
|
Ответ: создание MIDletPascal compiler'a
лутче бы написали бы компилятор из какого нибудь более универсального синтаксиса и два транслятора из pascal-подобного и basic-подобного синтаксиса
правда в прочем можно транслировать на java и компилить уже обычным способом
|
|
|
24.09.2008, 18:52
|
#33
|
Нуждающийся
Регистрация: 10.02.2007
Сообщений: 99
Написано 18 полезных сообщений (для 28 пользователей)
|
Re: создание MIDletPascal compiler'a
Ребят, да вы не понимаете... Ето пока наброски, потом, когда перейдем к синтаксическому анализатору каждый сможет свой язык прикрутить, вплоть до выдуманого. Просто я сейчас иду методом рекурсивного подъёма, а не как в классической книге дракона метод рекурсивного спуска. Почему? Да потому что виден сразу результат работы, во вторых можно проверять на ходу работоспособность и в третьих, когда подходишь уже к оформлению языка (на каком будет проходить в принципе программирование) у тебя уже все готово, то есть остаётся лишь придумать или взять какой нить язык за основу и вписать его в лекс. анализ...
Просто сейчас я пытаюсь объяснить структуру БАЙТ-КОДА который будет на выходе, попросту 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.Ошибка
В первом случае все нормально и пишется код, в третьем выводится ошибка а во втором управление передается точно такой же рекурсивной функции, которая разберёт уже другую строку, например выражение, и т.д...
|
(Offline)
|
|
24.09.2008, 21:19
|
#34
|
Нуждающийся
Регистрация: 10.02.2007
Сообщений: 99
Написано 18 полезных сообщений (для 28 пользователей)
|
Re: создание MIDletPascal compiler'a
Итак мы подошли к созданию функций нижнего уровня! Почему я так заострил вопрос о именно нижнем уровне? Все очень просто. Многие простые компиляторы и интерпритаторы начинаются с верхнего уровня, и когда доходят до создания файлов то происходит как бы ломка кода... Или приходится дорабатывать анализаторы, что бы код был по возможности оптимальным, или дорабатывать выходной файл (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 файла...
Последний раз редактировалось satan, 24.09.2008 в 21:32.
|
(Offline)
|
|
25.09.2008, 15:21
|
#35
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: создание MIDletPascal compiler'a
вот сбрал приблизительную модель загрузки 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.
Последний раз редактировалось Piligrim, 26.09.2008 в 14:09.
Причина: Используйте пожалуйста нормальное форматирование!
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
25.09.2008, 16:20
|
#36
|
Нуждающийся
Регистрация: 10.02.2007
Сообщений: 99
Написано 18 полезных сообщений (для 28 пользователей)
|
Re: создание MIDletPascal compiler'a
Ну вот мля куды ты гонишь? У меня падает компилер на этом
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
Последний раз редактировалось satan, 25.09.2008 в 18:20.
|
(Offline)
|
|
25.09.2008, 19:02
|
#37
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: создание MIDletPascal compiler'a
хм, сейчас глянул, а некоторые символы исчезли в исходнике...
наверное при конвертировке почему-то потерялись..
function swap2(pointer; offs:integer) : pointer;
должно быть function swap2(P : pointer; offs:integer) : pointer;
тоже самое с function swap4(...
|
(Offline)
|
|
25.09.2008, 19:14
|
#38
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: создание MIDletPascal compiler'a
да и еще в строке: pGenericAttribute_info:=swap2(swap2{4}(p,0),0);
поставить pGenericAttribute_info:=swap2(swap4(p,0),0);
тестировал, забыл убрать, думал описка там тип 4 байта, я ставил 2..
ПРИМЕЧАНИЕ: компилятор нужно настроить чтобы он не выравнивал переменные в памяти, а то размер структур будет больше, т.е. sizeof(...) и д.р. будет работать некорректно
|
(Offline)
|
|
26.09.2008, 14:05
|
#39
|
Оптимист
Регистрация: 07.01.2006
Сообщений: 961
Написано 105 полезных сообщений (для 259 пользователей)
|
Ответ: создание MIDletPascal compiler'a
Сообщение от abcdef
хм, сейчас глянул, а некоторые символы исчезли в исходнике...
наверное при конвертировке почему-то потерялись..
|
Если хотите чтобы символы н пропадали, для кусков кода используйте форматирование.
|
(Offline)
|
|
26.09.2008, 23:07
|
#40
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: создание MIDletPascal compiler'a
вот передалел немножко на свежую голову... - заработало,
теперь нужно сделать чтоб распознавались блоки "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.
|
(Offline)
|
|
27.09.2008, 00:55
|
#41
|
Нуждающийся
Регистрация: 10.02.2007
Сообщений: 99
Написано 18 полезных сообщений (для 28 пользователей)
|
Re: создание MIDletPascal compiler'a
а ты какой файл дизазмишь если не секрет? Я простой HelloWord, так у меня что тот, что этот зацикливается на методах а этот теперь еще и на атрибутах...
Мля... Сори, все ок... Я тож наверно от недосыпу тупить уж начал...
Последний раз редактировалось satan, 27.09.2008 в 02:55.
|
(Offline)
|
|
27.09.2008, 05:05
|
#42
|
Нуждающийся
Регистрация: 10.02.2007
Сообщений: 99
Написано 18 полезных сообщений (для 28 пользователей)
|
Re: создание MIDletPascal compiler'a
Вобчем смотрим чо происходит
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 дружище ты если проснесся быстрее меня, замути тему... А то я ужо совсем в осадок выпадаю, кабы косяков не натворил...
|
(Offline)
|
|
27.09.2008, 05:48
|
#43
|
Нуждающийся
Регистрация: 10.02.2007
Сообщений: 99
Написано 18 полезных сообщений (для 28 пользователей)
|
Re: создание MIDletPascal compiler'a
Так после перекоцывания
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 в 05:54.
|
(Offline)
|
|
27.09.2008, 07:56
|
#44
|
Нуждающийся
Регистрация: 10.02.2007
Сообщений: 99
Написано 18 полезных сообщений (для 28 пользователей)
|
Re: создание MIDletPascal compiler'a
Вощем во...
{$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.
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
27.09.2008, 18:54
|
#45
|
Нуждающийся
Регистрация: 10.02.2007
Сообщений: 99
Написано 18 полезных сообщений (для 28 пользователей)
|
Re: создание MIDletPascal compiler'a
исправил работу с 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;
|
(Offline)
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 09:58.
|