Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > JavaScript: Общие вопросы > Практ. задачи связанные с Компьютерными Науками

Автор: flowex 16.10.2005, 10:59

Приветствую всех!!
В данной теме мне бы хотелась рассмотреть некоторые задачи компьютерного моделирования основных математических концепций, на которых основаны большинство компьютерных систем..

Эту тему я создал для того, чтобы самому разобраться в некоторых моментах моделирования. Итак, начнём.
Вот список задач, предлагаемых на обсуждение в этой теме на этот момент:
I. 1. Эмулировать при помощи JScript работу процессора, работающего по Фон-Неймановской системе. В результате мы должны получить следующее: в файле data.txt должны содержаться основные команды процессора (go, ip и др.) и поступающие данные; хочется добиться того, чтобы в этом текстовом файле можно было бы реализовывать разные операции типа сложение, деление, нахождение НОД, вычисление факториала числа.. В роли процессора играет файл CPU.js Его память лучше также реализовать в текстовом документе.
2. a. Видоизменить процессор так, чтобы он соответствовал архитектуре RISC.
b. Видоизменить процессор так, чтобы он соответствовал архитектуре CISC.
II. Создать свой тип вещественных чисел. smile

При поступлении на вход обычного десятичного числа, скрипт должен преобразовывать его в какой-то код (что-то типа стандарта IEEE) и хранить в памяти, откуда можно вызывать его и производить над ним определённые действия (прибавить к другому, поделить, умножить).
Также должен быть возможен обратный перевод. Обязательно учесть,что сущечтвует Underfined, Infinity, NaN..
III. Создать кодер/декодер для кодировки текста по методу Хафмана. smile

Очень прошу помочь мне разобраться с этими задачами, я хочу всё это понять!.. smile

С уважением, flowex.

Автор: Sardar 16.10.2005, 14:33

Сразу оговоримся, писать это лучше не на JScript.

Фон-Нейманская архитектура, очень упрощённо, состоит из ALU; общей памяти для программ и данных; механизма выборки и декодирования инструкций.

Работа с устройствами ввода/вывода не так важно, они могыт быть просто отражены в память(чипы 8051), или иметь отдельные инструкции(чипы eZ80, ARM7 etc).

ALU вещь очень простая, в идеале не имеет состояний(не автомат), получает инструкцию и выполняет. Содержит регистры(чем больше, тем лучше) и может работать со стеком в памяти (ограниченный стек не в RAM можно найти в PIC'овских микроконтроллерах, лажа если честно).
Через любой регистр можно обращаться к памяти, регистры можно комбинировать, в любой операции можно задействовать любые регистры - возьмём это условие для простоты, на практике создать такое железо очень сложно и дорого.

Далее будем рассматривать примеры, поэтому оговорим некторые вещи и команды:

Регистров у нас немерянно: A-Z, все 8-битные
Регистры можно комбинировать, получая неограниченный(ну хотя бы до 64бит) регистр: AC, ZE, AEC, RTYU и т.д. Такие комбинации будем называт одним регистром.
Существуют специальные регистры, через которые нельзя прводит вычисления: SP - указатель(адрес) стека, PC - указатель(адрес) текущей инструкции, STATUS - регистр состояния, об этом позже
Все операции происходят только через регистры (свойственно RISC процам), например нельзя инкрементировать некую ячейку памяти(свойственно CISC процам), нужно подгрузить её в регистр, инкрементировать, а потом записать обратно.
В скобках указываем адрес: (90) ячейка памяти, (BC) ячейка под регистром BC. Количество выбираемых байт зависит от целевого регистра, например LD AB, (40) - возьмём два байта
Операция LD <цель>, <источник> подгружает инфу, например регистр->регистр, регистр->память или память->регистр.
Операции PUSH, POP <регситр> записывают в стек регистр, количесто байт зависит от длинны регистра. Напомню что стек у нас в RAM, т.е. запись это цикл((SP)=байт, SP+=1)
Операции ADD, SUB, MUL, DIV etc <целевой регистр>, <операнд 1>, <операнд 2> выполняют арифметические операци(+, -, *, /) над операндами и пишут результат в целевой регистр. При переполнении ставят биты статуса.
остальные операции работают аналогично, например CPL <регистр> в бинарном преставлении инвертирует число.

Посмотрим как при выше описанной конфигурации можно порешать выражение:

Код

var a=(78+3)/9;
------------------
LD A, 78
LD B, 3
ADD CD, A, B  ;заметь что для результата взяли регистр в два раза больший ;-)
LD E, 9;
DIV AB, CD, E ;поделили число
LD (0), AB ;записали по адресу 0 результат, это у нас переменная а

------------------
Пример по сложнее
var a=[90, 4, 56, 34], b
for(var i=0; i<a.length; i++) b+=a[i];
------------------
;условимся что по адресу (4) лежит массив с 16битными числами, (0) - 32битное число(длинна массива)
;по адресу (100) лежит 16 битная переменная b

LD ABCD, 0
for: ;это метка, смысл её держать адрес следующей инструкции
LD EFJH, (0)
CMP ABCD, EFJH ;сравнить регистры, в статусе под битом Z(zero, нулевой результат) будет 0 если они равны, бит C(carry) будет 1 если первый операнд больше
XOR E, STATUS, 0x01 ; Zbit и Cбит находяться в STATUS под позициями 1 и 2, XOR - логическое исключение, в Е будет 0 если Cбит=0 и Zbit=1
; после операции в STATUS.Zбит будет записан 0 если E=0!
JMPNZ end ;если STATUS.Z бит не 0, то прыгаем на метку end (goto end)
LD EF, (100) ; грузим нашу b
LD JH, (4 + ABCD) ; грузим очередную ячейку массива
ADD EF, EF, JH
LD (100), EF ;назад в память
INC ABCD ; инкремент (+=1), в любом процессоре есть, наверное даже в самых "аскетичных" RISC
JMP for ;безусловный прыжок на метку for
end: ;метка конца цикла, сюда прыгнем когда условие в for будет ложным

Если не брать во внимание наши навороченные регистры, то в остальном код такой же как x86 и подобных процах. В настоящем железе регистров обычно очень мало, все результаты постоянно в стек пишуться, что бы освободить регистр. Это не так существенно, если бы я писал "по настоящему" код бы разросся в полтора раза smile

И так врубились как работает ALU, в простейшем случае это огроменный switch, хотя не советую так делать, работать будет очень медленно. В хорошем интерпретаторе имееться быстрая хешь-таблица с адресами обработчиков инструкций.

Следующей проблемой будет декодер комманд. Ясно ведь что опкодов во много раз больше чем мнемоник их преставляющих в ассемблерном листинге. Например LD A, B и LD B, A это два разных опкода. Как ты будешь их кодировать - твоя свобода. В Гарвардской архитектуре часто все опкоды имеют один размер(напрример в PIC'ах так), естественно за счёт простоты декодера имеем кучу лишних потерь памяти. В х86 архитектуре(современный Intel/AMD/VIA комп) имеет, если не ошибаюсь, опкоды от 1 байта до 16 и больше. Открой даташит по любому микроконтроллеру, в конце всегда есть листинг опкодов, почитай, подумай, пиши.

Различия между RISC и CISC архитектурами в общих словах сходяться на количестве инструкций. Например в PIC'e всего 32 инструкции(RISC процессор), а в eZ80L92 их более 150 (CISC процессор). CISC проц. удобней программировать на ассемблере, но сложней под него писать компиляторы, вернее не задействуешь всю его мощь коммманд. RISC процы чсто имеют огроменное количество регистров и оптимизированны под компиляторы (например ARM7 в AVR, Phillips etc процах), писать человеку под такой проц. довольно сложно. CISC в железном плане сложней и дороже RISC. Сейчас мало кто пишет на асме если есть C компилятор. Из всего сказанного выше можно сделать заключение: все новые адря процев RISC, все CISC это спроектированные ранее процы, выпускаемые с новой архитектурой smile

Вещественные числа можно представить по IEEE(чего то там ещё smile

) стандарту как мантиссу+експоненту, сохранённую в одном 32-64-128 битном числе. Об этом много писали, даже у нас в JS несколько раз.
Другой способ хранения числа - fixed point, где храниться только мантисса и знаковый бит. Такое число может хранить что угодно от 0 до 1. ИXМО не плохой способ повышения точности, но ядро проца должно сие число поддерживать smile

На счёт Xафмана ты наверное пошутил smile

Необходимую инфу найдёшь здесь: http://forum.vingrad.ru/index.php?showtopic=4397

Автор: flowex 17.10.2005, 16:49

Насчёт Хафмана я как раз не шутил, на этой неделе я должен представить готовый кодер, использующий хеш массив.. Но мне просто офигенно трудно во всём этом разобраться, поэтому и спршиваю! smile

Автор: Sardar 17.10.2005, 17:06

А где ты раньше был? Неделя у тебя как раз уйдёт на написание архиватора на ассемблере, компилера под твой "процессор" ещё нет smile

При этом тебе ещё нужно написать симулятор твоей машины. На проекте можно ставить крест ИМXО, тут работы на месяца два.

Автор: flowex 18.10.2005, 16:28

Да нет же, первоочередной задачей сейчас для меня является написание кодера по Хафману! Как мне сказали, в программе должен использоваться массив объектов.. ? smile

Автор: flowex 18.10.2005, 16:36

Я тут нашёл Хафмана на паскале, но мне от этого не луше: с трудом могу интерпретировать на JScript. Help!

Код


{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,R+,S+,V+,X-}
{$M 16384,0,655360}
{******************************************************}
{*         Алгоритм уплотнения данных по методу       *}
{*                     Хафмана.                       *}
{******************************************************}
Program Hafman;

Uses Crt,Dos,Printer;

Type    PCodElement = ^CodElement;
        CodElement = record
                      NewLeft,NewRight,
                      P0, P1 : PCodElement;   {элемент входящий одновременно}
                      LengthBiteChain : byte; { в массив , очередь и дерево }
                      BiteChain : word;
                      CounterEnter : word;
                      Key : boolean;
                      Index : byte;
                     end;

        TCodeTable = array [0..255] of PCodElement;

Var     CurPoint,HelpPoint,
        LeftRange,RightRange : PCodElement;
        CodeTable : TCodeTable;
        Root : PCodElement;
        InputF, OutputF, InterF : file;
        TimeUnPakFile : longint;
        AttrUnPakFile : word;
        NumRead, NumWritten: Word;
        InBuf  : array[0..10239] of byte;
        OutBuf : array[0..10239] of byte;
        BiteChain : word;
        CRC,
        CounterBite : byte;
        OutCounter : word;
        InCounter : word;
        OutWord : word;
        St : string;
        LengthOutFile, LengthArcFile : longint;
        Create : boolean;
        NormalWork : boolean;
        ErrorByte : byte;
        DeleteFile : boolean;
{-------------------------------------------------}

procedure ErrorMessage;
{ --- вывод сообщения об ошибке --- }
begin
 If ErrorByte <> 0 then
  begin
   Case ErrorByte of
    2 : Writeln('File not found ...');
    3 : Writeln('Path not found ...');
    5 : Writeln('Access denied ...');
    6 : Writeln('Invalid handle ...');
    8 : Writeln('Not enough memory ...');
   10 : Writeln('Invalid environment ...');
.
   11 : Writeln('Invalid format ...');
   18 : Writeln('No more files ...');
   else Writeln('Error #',ErrorByte,' ...');
   end;
   NormalWork:=False;
   ErrorByte:=0;
  end;
end;

procedure ResetFile;
{ --- открытие файла для архивации --- }
Var St : string;
begin
  Assign(InputF, ParamStr(3));
  Reset(InputF, 1);
  ErrorByte:=IOResult;
  ErrorMessage;
  If NormalWork then Writeln('Pak file : ',ParamStr(3),'...');
end;

procedure ResetArchiv;
{ --- открытие файла архива, или его создание --- }
begin
  St:=ParamStr(2);
  If Pos('.',St)<>0 then Delete(St,Pos('.',St),4);
  St:=St+'.vsg';
  Assign(OutputF, St);
  Reset(OutPutF,1);
  Create:=False;
  If IOResult=2 then
   begin
    Rewrite(OutputF, 1);
    Create:=True;
   end;
  If NormalWork then
   If Create then Writeln('Create archiv : ',St,'...')
    else Writeln('Open archiv : ',St,'...')
end;

procedure SearchNameInArchiv;
{ --- в дальнейшем - поиск имени файла в архиве --- }
begin
 Seek(OutputF,FileSize(OutputF));
 ErrorByte:=IOResult;
 ErrorMessage;
end;

procedure DisposeCodeTable;
{ --- уничтожение кодовой таблицы и очереди --- }
Var I : byte;
begin
 For I:=0 to 255 do Dispose(CodeTable[I]);
end;

procedure ClosePakFile;
{ --- закрытие архивируемого файла --- }
Var I : byte;
begin
 If DeleteFile then Erase(InputF);
.
 Close(InputF);
end;

procedure CloseArchiv;
{ --- закрытие архивного файла --- }
begin
 If FileSize(OutputF)=0 then Erase(OutputF);
 Close(OutputF);
end;

procedure InitCodeTable;
{ --- инициализация таблицы кодировки --- }
Var I : byte;
begin
 For I:=0 to 255 do
  begin
    New(CurPoint);
    CodeTable[I]:=CurPoint;
    With CodeTable[I]^ do
     begin
      P0:=Nil;
      P1:=Nil;
      LengthBiteChain:=0;
      BiteChain:=0;
      CounterEnter:=1;
      Key:=True;
      Index:=I;
     end;
  end;
 For I:=0 to 255 do
  begin
   If I>0 then CodeTable[I-1]^.NewRight:=CodeTable[I];
   If I<255 then CodeTable[I+1]^.NewLeft:=CodeTable[I];
  end;
 LeftRange:=CodeTable[0];
 RightRange:=CodeTable[255];
 CodeTable[0]^.NewLeft:=Nil;
 CodeTable[255]^.NewRight:=Nil;
end;

procedure SortQueueByte;
{ --- пузырьковая сортировка по возрастанию --- }
Var Pr1,Pr2 : PCodElement;
begin
 CurPoint:=LeftRange;
 While CurPoint <> RightRange do
  begin
   If CurPoint^.CounterEnter > CurPoint^.NewRight^.CounterEnter then
    begin
     HelpPoint:=CurPoint^.NewRight;
     HelpPoint^.NewLeft:=CurPoint^.NewLeft;
     CurPoint^.NewLeft:=HelpPoint;
     If HelpPoint^.NewRight<>Nil then HelpPoint^.NewRight^.NewLeft:=CurPoint;
     CurPoint^.NewRight:=HelpPoint^.NewRight;
     HelpPoint^.NewRight:=CurPoint;
     If HelpPoint^.NewLeft<>Nil then HelpPoint^.NewLeft^.NewRight:=HelpPoint;
     If CurPoint=LeftRange then LeftRange:=HelpPoint;
     If HelpPoint=RightRange then RightRange:=CurPoint;
     CurPoint:=CurPoint^.NewLeft;
.
     If CurPoint = LeftRange then CurPoint:=CurPoint^.NewRight
      else CurPoint:=CurPoint^.NewLeft;
    end
    else CurPoint:=CurPoint^.NewRight;
  end;
end;

procedure CounterNumberEnter;
{ --- подсчет частот вхождений байтов в блоке --- }
Var C : word;
begin
 For C:=0 to NumRead-1 do
  Inc(CodeTable[(InBuf[C])]^.CounterEnter);
end;

function SearchOpenCode : boolean;
{ --- поиск в очереди пары открытых по Key минимальных значений --- }
begin
 CurPoint:=LeftRange;
 HelpPoint:=LeftRange;
 HelpPoint:=HelpPoint^.NewRight;
 While not CurPoint^.Key do
  CurPoint:=CurPoint^.NewRight;
 While (not (HelpPoint=RightRange)) and (not HelpPoint^.Key) do
  begin
   HelpPoint:=HelpPoint^.NewRight;
   If (HelpPoint=CurPoint) and (HelpPoint<>RightRange) then
    HelpPoint:=HelpPoint^.NewRight;
  end;
 If HelpPoint=CurPoint then SearchOpenCode:=False else SearchOpenCode:=True;
end;

procedure CreateTree;
{ --- создание дерева частот вхождения --- }
begin
 While SearchOpenCode do
  begin
   New(Root);
   With Root^ do
    begin
     P0:=CurPoint;
     P1:=HelpPoint;
     LengthBiteChain:=0;
     BiteChain:=0;
     CounterEnter:=P0^.CounterEnter + P1^.CounterEnter;
     Key:=True;
     P0^.Key:=False;
     P1^.Key:=False;
    end;
   HelpPoint:=LeftRange;
   While (HelpPoint^.CounterEnter < Root^.CounterEnter) and
    (HelpPoint<>Nil) do HelpPoint:=HelpPoint^.NewRight;
   If HelpPoint=Nil then { добавление в конец }
    begin
     Root^.NewLeft:=RightRange;
     RightRange^.NewRight:=Root;
     Root^.NewRight:=Nil;
     RightRange:=Root;
    end
.
   else
    begin { вставка перед HelpPoint }
     Root^.NewLeft:=HelpPoint^.NewLeft;
     HelpPoint^.NewLeft:=Root;
     Root^.NewRight:=HelpPoint;
     If Root^.NewLeft<>Nil then Root^.NewLeft^.NewRight:=Root;
    end;
  end;
end;

procedure ViewTree( P : PCodElement );
{ --- просмотр дерева частот и присваивание кодировочных цепей листьям --- }
Var Mask,I : word;
begin
 Inc(CounterBite);
 If P^.P0<>Nil then ViewTree( P^.P0 );
 If P^.P1<>Nil then
  begin
   Mask:=(1 SHL (16-CounterBite));
   BiteChain:=BiteChain OR Mask;
   ViewTree( P^.P1 );
   Mask:=(1 SHL (16-CounterBite));
   BiteChain:=BiteChain XOR Mask;
  end;
 If (P^.P0=Nil) and (P^.P1=Nil) then
  begin
   P^.BiteChain:=BiteChain;
   P^.LengthBiteChain:=CounterBite-1;
  end;
 Dec(CounterBite);
end;

procedure CreateCompressCode;
{ --- обнуление переменных и запуск просмотра дерева с вершины --- }
begin
 BiteChain:=0;
 CounterBite:=0;
 Root^.Key:=False;
 ViewTree(Root);
end;

procedure DeleteTree;
{ --- удаление дерева --- }
Var P : PCodElement;
begin
 CurPoint:=LeftRange;
 While CurPoint<>Nil do
  begin
   If (CurPoint^.P0<>Nil) and (CurPoint^.P1<>Nil) then
    begin
     If CurPoint^.NewLeft <> Nil then
      CurPoint^.NewLeft^.NewRight:=CurPoint^.NewRight;
     If CurPoint^.NewRight <> Nil then
      CurPoint^.NewRight^.NewLeft:=CurPoint^.NewLeft;
     If CurPoint=LeftRange then LeftRange:=CurPoint^.NewRight;
     If CurPoint=RightRange then RightRange:=CurPoint^.NewLeft;
     P:=CurPoint;
     CurPoint:=P^.NewRight;
     Dispose(P);
    end
.
   else CurPoint:=CurPoint^.NewRight;
  end;
end;

procedure SaveBufHeader;
{ --- запись в буфер заголовка архива --- }
Type
      ByteField = array[0..6] of byte;
Const
      Header : ByteField = ( $56, $53, $31, $00, $00, $00, $00 );
begin
 If Create then
  begin
   Move(Header,OutBuf[0],7);
   OutCounter:=7;
  end
 else
  begin
   Move(Header[3],OutBuf[0],4);
   OutCounter:=4;
  end;
end;

procedure SaveBufFATInfo;
{ --- запись в буфер всей информации по файлу --- }
Var I : byte;
    St : PathStr;
    R : SearchRec;
begin
 St:=ParamStr(3);
 For I:=0 to Length(St)+1 do
  begin
   OutBuf[OutCounter]:=byte(Ord(St[I]));
   Inc(OutCounter);
  end;
 FindFirst(St,$00,R);
 Dec(OutCounter);
 Move(R.Time,OutBuf[OutCounter],4);
 OutCounter:=OutCounter+4;
 OutBuf[OutCounter]:=R.Attr;
 Move(R.Size,OutBuf[OutCounter+1],4);
 OutCounter:=OutCounter+5;
end;

procedure SaveBufCodeArray;
{ --- сохранить массив частот вхождений в архивном файле --- }
Var I : byte;
begin
 For I:=0 to 255 do
  begin
   OutBuf[OutCounter]:=Hi(CodeTable[I]^.CounterEnter);
   Inc(OutCounter);
   OutBuf[OutCounter]:=Lo(CodeTable[I]^.CounterEnter);
   Inc(OutCounter);
  end;
end;
.
procedure CreateCodeArchiv;
{ --- создание кода сжатия --- }
begin
 InitCodeTable;      { инициализация кодовой таблицы                      }
 CounterNumberEnter; { подсчет числа вхождений байт в блок                }
 SortQueueByte;      { cортировка по возрастанию числа вхождений          }
 SaveBufHeader;      { сохранить заголовок архива в буфере                }
 SaveBufFATInfo;     { сохраняется FAT информация по файлу                }
 SaveBufCodeArray;   { сохранить массив частот вхождений в архивном файле }
 CreateTree;         { создание дерева частот                             }
 CreateCompressCode; { cоздание кода сжатия                               }
 DeleteTree;         { удаление дерева частот                             }
end;

procedure PakOneByte;
{ --- сжатие и пересылка в выходной буфер одного байта --- }
Var Mask : word;
    Tail : boolean;
begin
 CRC:=CRC XOR InBuf[InCounter];
 Mask:=CodeTable[InBuf[InCounter]]^.BiteChain SHR CounterBite;
 OutWord:=OutWord OR Mask;
 CounterBite:=CounterBite+CodeTable[InBuf[InCounter]]^.LengthBiteChain;
 If CounterBite>15 then Tail:=True else Tail:=False;
 While CounterBite>7 do
  begin
   OutBuf[OutCounter]:=Hi(OutWord);
   Inc(OutCounter);
   If OutCounter=(SizeOf(OutBuf)-4) then
    begin
     BlockWrite(OutputF,OutBuf,OutCounter,NumWritten);
     OutCounter:=0;
    end;
   CounterBite:=CounterBite-8;
   If CounterBite<>0 then OutWord:=OutWord SHL 8 else OutWord:=0;
  end;
 If Tail then
  begin
   Mask:=CodeTable[InBuf[InCounter]]^.BiteChain SHL
   (CodeTable[InBuf[InCounter]]^.LengthBiteChain-CounterBite);
   OutWord:=OutWord OR Mask;
  end;
 Inc(InCounter);
 If (InCounter=(SizeOf(InBuf))) or (InCounter=NumRead) then
  begin
   InCounter:=0;
   BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead);
  end;
end;

procedure PakFile;
{ --- процедура непосредственного сжатия файла --- }
begin
 ResetFile;
 SearchNameInArchiv;
 If NormalWork then
  begin
   BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead);
   OutWord:=0;
.
   CounterBite:=0;
   OutCounter:=0;
   InCounter:=0;
   CRC:=0;
   CreateCodeArchiv;
   While (NumRead<>0) do PakOneByte;
   OutBuf[OutCounter]:=Hi(OutWord);
   Inc(OutCounter);
   OutBuf[OutCounter]:=CRC;
   Inc(OutCounter);
   BlockWrite(OutputF,OutBuf,OutCounter,NumWritten);
   DisposeCodeTable;
   ClosePakFile;
  end;
end;

procedure ResetUnPakFiles;
{ --- открытие файла для распаковки --- }
begin
 InCounter:=7;
 St:='';
 repeat
  St[InCounter-7]:=Chr(InBuf[InCounter]);
  Inc(InCounter);
 until InCounter=InBuf[7]+8;
 Assign(InterF,St);
 Rewrite(InterF,1);
 ErrorByte:=IOResult;
 ErrorMessage;
 If NormalWork then
  begin
   WriteLn('UnPak file : ',St,'...');
   Move(InBuf[InCounter],TimeUnPakFile,4);
   InCounter:=InCounter+4;
   AttrUnPakFile:=InBuf[InCounter];
   Inc(InCounter);
   Move(InBuf[InCounter],LengthArcFile,4);
   InCounter:=InCounter+4;
  end;
end;

procedure CloseUnPakFile;
{ --- закрытие файла для распаковки --- }
begin
 If not NormalWork then Erase(InterF)
  else
   begin
    SetFAttr(InterF,AttrUnPakFile);
    SetFTime(InterF,TimeUnPakFile);
   end;
 Close(InterF);
end;

procedure RestoryCodeTable;
{ --- воссоздание кодовой таблицы по архивному файлу --- }
Var I : byte;
begin
 InitCodeTable;
 For I:=0 to 255 do
.
  begin
   CodeTable[I]^.CounterEnter:=InBuf[InCounter];
   CodeTable[I]^.CounterEnter:=CodeTable[I]^.CounterEnter SHL 8;
   Inc(InCounter);
   CodeTable[I]^.CounterEnter:=CodeTable[I]^.CounterEnter+InBuf[InCounter];
   Inc(InCounter);
  end;
end;

procedure UnPakByte( P : PCodElement );
{ --- распаковка одного байта --- }
Var Mask : word;
begin
 If (P^.P0=Nil) and (P^.P1=Nil) then
  begin
   OutBuf[OutCounter]:=P^.Index;
   Inc(OutCounter);
   Inc(LengthOutFile);
   If OutCounter = (SizeOf(OutBuf)-1) then
    begin
     BlockWrite(InterF,OutBuf,OutCounter,NumWritten);
     OutCounter:=0;
    end;
  end
 else
  begin
   Inc(CounterBite);
   If CounterBite=9 then
    begin
     Inc(InCounter);
     If InCounter = (SizeOf(InBuf)) then
      begin
       InCounter:=0;
       BlockRead(OutputF,InBuf,SizeOf(InBuf),NumRead);
      end;
     CounterBite:=1;
    end;
   Mask:=InBuf[InCounter];
   Mask:=Mask SHL (CounterBite-1);
   Mask:=Mask OR $FF7F; { установка всех битов кроме старшего }
   If Mask=$FFFF then UnPakByte(P^.P1)
    else UnPakByte(P^.P0);
  end;
end;

procedure UnPakFile;
{ --- распаковка одного файла --- }
begin
 BlockRead(OutputF,InBuf,SizeOf(InBuf),NumRead);
 ErrorByte:=IOResult;
 ErrorMessage;
 If NormalWork then ResetUnPakFiles;
 If NormalWork then
  begin
   RestoryCodeTable;
   SortQueueByte;
   CreateTree;                   { создание дерева частот }
   CreateCompressCode;
   CounterBite:=0;
.
   OutCounter:=0;
   LengthOutFile:=0;
   While LengthOutFile<LengthArcFile do
    UnPakByte(Root);
   BlockWrite(InterF,OutBuf,OutCounter,NumWritten);
   DeleteTree;
   DisposeCodeTable;
  end;
 CloseUnPakFile;
end;

{ ------------------------- main text ------------------------- }
begin
 DeleteFile:=False;
 NormalWork:=True;
 ErrorByte:=0;
 WriteLn;
 WriteLn('ArcHaf version 1.0  (c) Copyright VVS Soft Group, 1992.');
 ResetArchiv;
 If NormalWork then
  begin
   St:=ParamStr(1);
   Case St[1] of
    'a','A' : PakFile;
    'm','M' : begin
               DeleteFile:=True;
               PakFile;
              end;
    'e','E' : UnPakFile;
    else ;
   end;
  end;
 CloseArchiv;
end.

Автор: flowex 21.10.2005, 14:56

Большое спасибо тебе, Sardar, за "процессор". У меня всё получилось, да вот и с Хафманом тут немного разобрался - почти написал (через объекты), а вот с типом float всё вожусь, - идей тьма, а толку никакого.. Так что вопрос: где бы достать IEEE на русском?

Автор: Sardar 21.10.2005, 15:49

Цитата(flowex @ 21.10.2005, 13:56)

У меня всё получилось

Классно, у меня бы на такой симулятор не менее двух месяцев ушло бы и не на JScript smile

Цитата(flowex @ 21.10.2005, 13:56)

где бы достать IEEE на русском?

Очень плохая тактика, доку нужно читать на инлише и никак иначе, вот это обязательно, там же и стандарты: http://www.validlab.com/goldberg/paper.pdf
Полезно: http://babbage.cs.qc.edu/courses/cs341/IEEE-754references.html

Иначе идём в яндекс и забиваем IEEE 754