В далекие, далекие времена, когда еще слово компьютер никто не слышал, нам по телевидению, радио и печати очень красиво рассказывали про ЭВМ - верх творчества человеческого сознания! Сколько было прочитано разных книг о Кибернетике, ЭВМ. Тогда очень легко и не дорого можно было их купить. И не мечтали тогда мальчишки о карьере бухгалтера и непонятного менеджера. Вот закончена школа (1976), впереди поступление в институт. Я уже выбрал куда – филиал МЭИ в г. Смоленске, на специальность конструирования ЭВМ. Но…, как всегда бывает но. Родители уговорили попробовать сперва силы, для тренировки, в военный ВУЗ. А отец тогда служил в СГВ (Польша), и родителям явно не хотелось оставить меня одного свободным, потому пошли на хитрость. Короче так попробовал, что пробовать закончил в 2001 году, отдав Родине 25 календарей и 34 льготных. Но никогда не забывал свою “первую любовь”, с детства увлекался радиоэлектроникой, изучал ее в военном училище, и конечно же, изучал военные ЭВМ. Но хотелось не только военных, поэтому когда появились первые программируемые калькуляторы, пришлось раскошелиться. Помню, как 83 читал в журнале “Радио” про первую любительскую ЭВМ – "Микро-80". Читал и понимал, не иметь мне Микро, ну негде мне было взять деталей. Время идет, в обиходе уже появилось слово компьютер, персональный, но никто его из моих друзей близко не видел, отдаленный гарнизон всеж. В 1986 году, в 4 номере журнала “Радио” печатают про новую любительскую персональную ЭВМ – “Радио РК-86”, которую уже реально было собрать. И вот, наконец, промы (так жаргонно звали у нас представителей заводов изготовителей нашей военной техники) предложили комплект деталей и плату с клавиатурой для самостоятельной сборки, и всего-то за 250 рублей. После обсуждения с женой, деньги были выделены, но опять но, пошла задержка и купил я его только в очередном отпуске, в г Смоленске, в магазине радиоэлектроники, но уже значительно дороже.
Сколько бессонных ночей было проведено за ним. Даже ДОС свою написал для него.
Прошло время, он давно вышел из моды, но и сейчас в строю. На нем сделан программатор ППЗУ типа РФ, собственной конструкции, и бывает иногда востребован. Последний раз в прошлом году.
В 2006 году, в период моей очередной безработицы был написан эмулятор РКашки на Дельфи, просто так, чтоб мозги не черствели. Было много планов, была уже проработка отладчика, серьезного, преобразование в компоненты и т.д., но появилась статья Ульянича, посвященная гибели МРК “Муссон”, я с головой ушел в эту тему, сам был участником – более 20 минут в ледяной воде. Стали другие вопросы. Так и лежит с тех пор, иногда заглядываю, мимоходом, может, что и подправляю, но тема стоит. В то время уже был хороший эмулятор В. Пыхонина, но он был написан под ДОС и плохо работал под ХР, загружая ресурсы ПК почти на 100%. Сейчас зайдя на сайт http://emu80.org/#sitenews вижу, что он вроде бы выполнил свое обещание и написал новую версию. Мой эмулятор не пытается сделать ему конкуренцию, поэтому я выкладываю коды. Может кому будет интересна возможность реализации эмулятора на Дельфи.
Последний раз редактировалось: Valeriy (18 Янв 2011 02:25), всего редактировалось 3 раз(а)
uses
Forms,
UIm in 'UIm.pas' {Form1},
UDebag in 'UDebag.pas' {DebagForm},
UMem in 'UMem.pas',
UKeyb in 'UKeyb.pas',
U8080 in 'U8080.pas',
UStrHex in 'UStrHex.pas',
UDMemo in 'UDMemo.pas' {FormDM},
UGlbPK in 'UGlbPK.pas',
UIm2 in 'UIm2.pas' {Form2};
procedure TForm1.Button1Click(Sender: TObject);
begin
//Button1.Enabled := false;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
kb:=true;
close;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Button3.Enabled:= false;
Button3.Enabled:= true;
if Cpu.dbg then exit;
kb:= true;
sleep(200);
Cpu.RESET;
Cpu.dbg := false;
ks:=kss;
TimerSpeed.Enabled:= false;
TimerSpeed.Enabled:= true;
NewThread := TMyThread.Create(false);
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
KeybCPU.KeyDownCPU(Key,Shift);
end;
procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
begin
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
sleep(20);
KeybCPU.KeyUPCPU(Sender);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MemThread.Terminate;
Application.Terminate;
sleep(100);
end;
procedure TForm1.TimerLabTimer(Sender: TObject);
begin
Label1.Caption:=IntToStr(Tik-TikOld);
TikOld:= Tik;
Label2.Enabled:= not Label2.Enabled;
Label3.Caption:=IntToStr(Tok-TokOld);
TokOld:= Tok;
end;
procedure TForm1.TimerSpeedTimer(Sender: TObject);
var
f,c: integer;
const
b: integer=2800;
begin
c:= Tok-TokOld1; //автоматическая стабилизация скорости
f:= oldc-c;
ks:= byte((c + kss*100 + f div 5)div b);
TokOld1:= Tok;
oldc:= c;
Label4.Caption:= IntToStr(ks)+' '+ IntToStr(kss);
end;
procedure TForm1.sbDebagClick(Sender: TObject);
begin
if sbDebug.Down then begin
kb:= true;
sleep(100);
Cpu.dbg:= true;
FormDM.Memo.Lines.Add(#13#10+' BEGIN TRACE'+#13#10#13#10);
DebagForm.Show;
end
else begin
FormDM.Memo.Lines.Add(#13#10+' STOP TRACE'+#13#10#13#10);
DebagForm.Hide;
Cpu.dbg:= false;
ks:= kss;
NewThread := TMyThread.Create(false);
end;
end;
procedure TForm1.Image1DblClick(Sender: TObject);
begin
if not Form2.Visible then begin
Form1.Hide;
Form2.Show;
end;
end;
procedure TForm1.SetPortKey(Sender: TObject);
begin
KeybCPU.vPortKeyC:= MemCpu.vPortC;
end;
procedure TForm1.SetAddrCpu(Sender: TObject);
begin
MemCpu.vAddr:= CPU.vAddr;
end;
procedure TForm1.GetByteCpu(Sender: TObject);
begin
CPU.vMemB:= MemCpu.vMemB;
end;
procedure TForm1.SetByteCpu(Sender: TObject);
begin
MemCpu.vMemB:= CPU.vMemB;
end;
{формирует мигающий курсор с кордионатами Х и У}
procedure TForm1.TimerCursTimer(Sender: TObject);
begin
if(FCrsX<64) and (FCrsY<25) then// курсор в пределах экрана
FClCrs := not FClCrs else FClCrs:= clBlack;
{показывает раскладку клавы}
if KeybCPU.vPortLang then begin
Label5.Font.Color:=clBlack;
Label5.Caption:= 'LAT';
end
else begin
Label5.Font.Color:=clRed;
Label5.Caption:= 'RUS';
end;
end;
procedure TForm1.Keyb(Sender: TObject);
begin
// Form1.Repaint;
KeybCPU.KeyUPCPU(Sender);
end;
procedure TForm1.tmThMemTimer(Sender: TObject);
begin
tmThMem.Enabled :=false;
MemThread.Resume
end;
procedure TForm1.LoadFont;
var
i: Integer;
FonFl: file of byte;
P : PBtArray;
begin
FontBitMap := TBitMap.create;
FontBitMap.Height := 16*$80;
FontBitMap.Width := 8;
FontBitMap.PixelFormat := pf1bit;
try
AssignFile(FonFl, 'FONTS.BIN');
Reset(FonFl);
for i := 0 to FontBitMap.Height -1 do
begin
P := FontBitMap.ScanLine[i];
read(FonFl,P[0]);
end;
finally
CloseFile(FonFl);
end;
end;
function LoadBt: byte;
var
j,buf: byte;
begin
FFile.Read(buf,1); //читаем байт
LtFl:= LtFl+1;
Result:= buf;
j:=0;
//обработка команды по чтению байта с поиском синхробайта
if WrdRec(rTakt.regs[4]).Hi=$FF then
begin
//читаем заголовок, делаем анализ
if (buf=$E6) and (LtFl = 1) then
begin
while buf = $E6 do
begin
FFile.Read(buf,1);
j:=j+1;
end;
FFile.Position:=0;
FFile.Read(buf,1);
end;
if j > 0 then
if j < 4 then
while buf = $E6 do
begin
FFile.Read(buf,1);
LtFl:= LtFl+1;
end
else exit;
//конец обработки заголовка
if LtFl > 5 then //поиск синробайта, либо после заголовка, либо в конце файла, пропуск нулей
begin
while buf <> $E6 do
begin
FFile.Read(buf,1);
LtFl:= LtFl+1;
if LtFl>$75FF then begin
Result:= buf;
rTakt.regs[6]:= ExitErrAdd;
Cpu.SetCpu(rTakt);
Form1.Timer1.Enabled:= true; exit;
end;
end;
FFile.Read(buf,1);
LtFl:= LtFl+1;
end;
end;
Result:= buf;
end;
begin
b:=ks;
a:=ks;f:=ks;e:=ks;
c:=ks;
FreeOnTerminate := True;
Kb := false;
repeat
{перехват процедур монитора чтения и записи байта
программы, использующие собственные процедуры записи и чтения байта -
не перехватываются}
case rTakt.regs[6] of
$FB98: begin
Form1.Timer1.Enabled:= false;
Form1.Timer1.Enabled:= true;
POP(rTakt.regs[6]); //ret
Cpu.SetCpu(rTakt);
if KOpfl and (WrdRec(rTakt.regs[4]).Hi=$FF) then begin
Form1.FileLoad; //открываем файл для чтения
if assigned(FFile) then WrdRec(rTakt.regs[4]).Hi:= LoadBt //читаем первый байт
else rTakt.regs[6]:= ExitErrAdd;
Cpu.SetCpu(rTakt);
end
else if assigned(FFile) then //чтение байта
begin
WrdRec(rTakt.regs[4]).Hi:=LoadBt;
if (LtFl+1) > LnFlB then //выход за пределы файла, конец чтения
begin
LnFlB:= 0;
KOpfl:= true;
FFile.Free;
FFile:=nil;
end;
end
else rTakt.regs[6]:= ExitErrAdd;
Cpu.SetCpu(rTakt);
end;
$FC46: begin
Form1.Timer1.Enabled:= false;
Form1.Timer1.Enabled:= true;
POP(rTakt.regs[6]);
Cpu.SetCpu(rTakt);
if KOpfl then Form1.FileSave;
if assigned(FFile) then begin
if KSvfl then FFile.Write((WrdRec(rTakt.regs[1]).Lo),1)
else
if WrdRec(rTakt.regs[1]).Lo = $E6 then KSvfl:= true;//запуск по первому синхробайту, синхробайт пропускается
end
else begin
FFile.Free;
FFile:= nil;
KOpfl:= true;
KSvfl:= false;
rTakt.regs[6]:= ExitErrAdd;
end;
Cpu.SetCpu(rTakt);
end;
end;
rTakt := cpu.Takt(rtkt,Cpu.dbg);
Kb := rTakt.auto;
if (rtkt mod 4000) = 0 then //часть системы автомтической стабилизации скорости
begin
kss:=((ks+c+b+a+f+e) div 6);
sleep(kss);
Application.ProcessMessages;
e:= f;
f:= a;
a:= b;
b:= c;
c:= ks;
//Application.ProcessMessages;
end;
tok:= rtkt;
until (Kb = True) or Terminated or Application.Terminated;
end;
{ TMemThread }
procedure TMemThread.Execute;
var
X,Y,i: Integer;
ScrSrfHD: HDC;
FontHD: HDC;
myRect: TRect;
ScrBitMap: TBitMap;
Tyk: int64;
Bm:byte;
begin
{экран}
Tyk:= 0;
ScrBitMap := TBitMap.create;
with ScrBitMap do
begin
Height := Form1.Image1.Height;
Width := Form1.Image1.Width;
PixelFormat := pf1bit;
myRect:= Canvas.ClipRect;
end;
FontBitMap.Canvas.Lock;
FontHD:= FontBitMap.Canvas.Handle;
ScrBitMap.Canvas.Lock;
ScrSrfHD:= ScrBitMap.Canvas.Handle;
FreeOnTerminate := True;
repeat
//Закрашивание фона
PatBlt (ScrSrfHD,0,0,ScrBitMap.Width,ScrBitMap.Height,BLACKNESS);
//Заполнение буфера
if (MemCpu.FMemC[$C001] and $04) <> 0 then begin
for i :=0 to 2178 do
begin
Y := (i div 78)-1; //расчет знакоместа
X := (i mod 78)-1;
// границы экрана и проверка на знакогенератор
if (X>=-1) and (Y>=-1) and (X<66) and (Y<25) then begin
Bm :=MemCpu.FMemC[$7773+ i] and $7f;
if (Bm>0) and (Bm<>$20) then
BitBlt(ScrSrfHD,X*(C_SynX+1) + 34,Y*(C_SynY+2) + 27,C_SynX,C_SynY,FontHD,0,Bm*C_SynY,SrcCopy);
end;
if ((X mod 76)=0) and ((Y mod 26)=0) then
MemCpu.FMemC[$C001]:= (MemCpu.FMemC[$C001] or $20); // конец отображения кадра
if (i mod 65*3) = 0 then sleep(0);
Application.ProcessMessages;
end;
{курсор}
for i:= 0 to 8 do //размер курсора
if FClCrs <> 0 then
ScrBitMap.Canvas.Pixels[FCrsX*(C_SynX+1)+33+i,FCrsY * (C_SynY+2)+41]:= clWhite; //вывод курсора
end;
//Копирование буфера на форму
If Form1.Visible then begin
Form1.Image1.Canvas.Lock;
Form1.Image1.Canvas.CopyRect(myRect,ScrBitMap.Canvas,myRect);
Form1.Image1.Canvas.unLock;
end else
If Form2.Visible then begin
Form2.Canvas.Lock;
Form2.Canvas.CopyRect(Form2.Canvas.ClipRect,ScrBitMap.Canvas,myRect);
Form2.Canvas.unLock;
end;
Tik:= Tik+1;
Tyk:= Tyk+1;
if (tyk mod 3) = 0 then begin
if form1.Active then sleep(30) else sleep(20);
Application.ProcessMessages;
end;
Application.ProcessMessages;
until Terminated or Application.Terminated;
ScrBitMap.Canvas.unLock;
FontBitMap.Canvas.unLock;
ScrBitMap.Free;
end;
procedure SetFlg(Reg:byte); //установка флагов
var
F: byte;
begin
F := (PSW and $11) or (Reg and $80) or Paritc[Reg];
if Reg = 0 then F := F or (not Reg and $40);
PSW:= (F or 2) and $D7;
end;
procedure FlgInr(Reg:byte);
begin
PSW:= (PSW and 1) or ((((Reg - 1) and $0F) + 1) and $10);
SetFlg(Reg);
end;
procedure FlgDcr(Reg:byte);
begin
PSW:= (PSW and 1) or ((((Reg + 1) and $0F) - 1) and $10);
SetFlg(Reg);
end;
procedure DAD(W:word);
begin
PSW:= ((PSW and $FE) or (((HL + W) and $10000) shr 16)or 2) and $D7;
HL := HL + W;
end;
procedure ADD(Reg: byte);
var
R: byte;
begin
R:= A;
PSW:= ((R + Reg) and $100) shr 8 or (((R and $0F) + (Reg and $0F)) and $10);
R:= R + Reg;
A:= R;
SetFlg(R);
end;
procedure ADC(Reg: byte);
var
F,R,R1: byte;
begin
R:= A;
F:= PSW;
R1:= R + Reg + (F and $01);
PSW:= ((R + Reg + (F and $01)) and $100) shr 8 or (((R and $0F) + (Reg and $0F) + (F and $01)) and $10);
A:= R1;
SetFlg(R1);
end;
procedure SUB(Reg: byte);
var
R: byte;
begin
R:= A;
PSW:= ((R-Reg) and $100) shr 8 or ((R and $0F) - (Reg and $0F)) and $10;
R:= R - Reg;
A:= R;
SetFlg(R);
end;
procedure SBB(Reg: byte);
var
F,R,R1: byte;
begin
R:= A;
F:= PSW;
R1:= R - Reg - (F and $01);
PSW:= (R1 and $100) shr 8 or ((R and $0F) - (Reg and $0F) - (F and $01)) and $10;
A:= R1;
SetFlg(R1);
end;
procedure ANA(Reg: byte);
begin
A := A and Reg;
PSW := PSW and $10;
SetFlg(A);
end;
procedure XRA(Reg: byte);
begin
A := A xor Reg;
PSW := 0;
SetFlg(A);
end;
procedure ORA(Reg: byte);
begin
A := A or Reg;
PSW := 0;
SetFlg(A);
end;
procedure CMP(Reg: byte);
var
R: byte;
begin
R := A;
PSW:= ((R-Reg) and $100) shr 8 or (((R and $0F) - (Reg and $0F)) and $10);
SetFlg(R-reg);
end;
procedure CALL;
begin
PUSH(PC + 2);
PC := RD_WORD(PC);
end;
procedure RST(Reg: word);
begin
PUSH(PC);
PC := Reg;
end;
begin
t:= t+1;
FvAddr := PC; // адрес очередной операции
OnAddr(self);
OnReadB(self);
Rslt.cop:= FvMemB; //чтение кода операции
Rslt.auto := false;
if dbg then begin
if StepOver then
if ((ContPC = PC) and (ContSP = SP)) then
Rslt.auto:= true;
end;
{debug обработка кода}
{тело отладчика
DbgPrmOut(R: TTakt); выполнение пошагово и авто, ловушки
.......
else}
inc(PC); //inr счетчика, если необходимо ветвление, то происходит в дальнейшем в теле case
Rslt.dly:= 0;
case(Rslt.cop)of
$00: Rslt.dly:= 4; // nop
$01: begin // lxi bc, data16
BC:= RD_WORD(PC);
PC:= PC + 2;
Rslt.dly:= 10;
end;
$02: begin // stax b
WR_BYTE(BC,A);
Rslt.dly:= 7;
end;
$03: begin // inx b
BC:= BC + 1;
Rslt.dly:= 5;
end;
$04: begin // inr b
B := B + 1;
FlgInr(B);
Rslt.dly:= 5;
end;
$05: begin // dcr b
B := B - 1;
FlgDcr(B);
Rslt.dly:= 5;
end;
$06: begin // mvi b, data8
B:= RD_BYTE(PC);
PC:= PC + 1;
Rslt.dly:= 7;
end;
$07: begin // rlc
Reg:= A;
PSW := (PSW and $D6) or ((Reg and $80) shr 7) or 2;
A:= (Reg shl 1) or ((Reg and $80) shr 7);
Rslt.dly:= 4;
end;
$08: ;//invalid_opcode();
$09: begin // dad b
DAD(BC);
Rslt.dly:= 10;
end;
$0A: begin // ldax b
A:= RD_BYTE(BC);
Rslt.dly:= 7;
end;
$0B: begin // dcx b
BC:=BC - 1;
Rslt.dly:= 5;
end;
$0C: begin // inr c
C:= C + 1;
FlgInr(C);
Rslt.dly:= 5;
end;
$0D: begin // dcr c
C:= C - 1;
FlgDcr(C);
Rslt.dly:= 5;
end;
$0E: begin // mvi c, data8
C:= RD_BYTE(PC);
PC:= PC + 1;
Rslt.dly:= 7;
end;
$0F: begin // rrc
Reg:= A;
PSW := (PSW and $D6) or (Reg and $01) or 2;
A:= (Reg shr 1) or (Reg and $01) shl 7;
Rslt.dly:= 4;
end;
$10: ;//invalid_opcode();
$11: begin // lxi de, data16
DE := RD_WORD(PC);
PC:= PC + 2;
Rslt.dly:= 10;
end;
$12: begin // stax d
WR_BYTE(DE, A);
Rslt.dly:= 7;
end;
$13: begin // inx d
DE:=DE + 1;
Rslt.dly:= 5;
end;
$14: begin // inr d
D:= D + 1;
FlgInr(D);
Rslt.dly:= 5;
end;
$15: begin // dcr d
D:= D - 1;
FlgDcr(D);
Rslt.dly:= 5;
end;
$16: begin // mvi d, data8
D := RD_BYTE(PC);
PC:= PC + 1;
Rslt.dly:= 7;
end;
$17: begin // ral
Reg:= A;
FL:= PSW and $01;
PSW := (PSW and $D6) or (Reg and $80) shr 7 or 2;
A := (Reg shl 1) or FL;
Rslt.dly:= 4;
end;
$18: ;//invalid_opcode();
$19: begin // dad d
DAD(DE);
Rslt.dly:= 10;
end;
$1A: begin // ldax d
A := RD_BYTE(DE);
Rslt.dly:= 7;
end;
$1B: begin // dcx d
DE:= DE - 1;
Rslt.dly:= 5;
end;
$1C: begin // inr e
E:= E + 1;
FlgInr(E);
Rslt.dly:= 5;
end;
$1D: begin // dcr e
E:= E - 1;
FlgDcr(E);
Rslt.dly:= 5;
end;
$1E: begin // mvi e, data8
E := RD_BYTE(PC);
PC:= PC + 1;
Rslt.dly:= 7;
end;
$1F: begin // rar
Reg:= A;
FL := PSW and $01;
PSW := (PSW and $D6) or (Reg and $01) or 2;
A := (Reg shr 1) or (FL shl 7);
Rslt.dly:= 4;
end;
$20: ;//invalid_opcode();
$21: begin // lxi hl, data16
HL := RD_WORD(PC);
PC:= PC + 2;
Rslt.dly:= 10;
end;
$22: begin // shld addr
WR_WORD(RD_WORD(PC), HL);
PC:= PC + 2;
Rslt.dly:= 16;
end;
$23: begin // inx h
HL:= HL + 1;
Rslt.dly:= 5;
end;
$24: begin // inr h
H:= H + 1;
FlgInr(H);
Rslt.dly:= 5;
end;
$25: begin // dcr h
H:= H - 1;
FlgDcr(H);
Rslt.dly:= 5;
end;
$26: begin // mvi h, data8
H := RD_BYTE(PC);
PC:= PC + 1;
Rslt.dly:= 7;
end;
$27: begin // daa
if (A and $0F)> 9 then PSW := PSW or $10;
if (PSW and $10)<0> $90 then PSW := PSW or $01;
if (PSW and $01)<> 0 then A:= A + $60;
SetFlg(A);
Rslt.dly:= 4;
end;
$28: ;//invalid_opcode
$29: begin // dad hl
DAD(HL);
Rslt.dly:= 10;
end;
$2A: begin // ldhl addr
HL := RD_WORD(RD_WORD(PC));
PC:= PC + 2;
Rslt.dly:= 16;
end;
$2B: begin // dcx h
HL:= HL - 1;
Rslt.dly:= 5;
end;
$2C: begin // inr l
L:= L + 1;
FlgInr(L);
Rslt.dly:= 5;
end;
$2D: begin // dcr l
L:= L - 1;
FlgDcr(L);
Rslt.dly:= 5;
end;
$2E: begin // mvi l, data8
L := RD_BYTE(PC);
PC:= PC + 1;
Rslt.dly:= 7;
end;
$2F: begin // cma
A := A xor $ff;
Rslt.dly:= 4;
end;
$30: ;//invalid_opcode
$31: begin // lxi sp, data16
SP:= RD_WORD(PC);
PC:= PC + 2;
Rslt.dly:= 10;
end;
$32: begin // sta addr
WR_BYTE(RD_WORD(PC),A);
PC:= PC + 2;
Rslt.dly:= 13;
end;
$E4: begin // cpo addr
if (PSW and $04) = 0 then begin
CALL; Rslt.dly:= 17; end
else begin
PC:= PC + 2; Rslt.dly:= 11; end;
end;
$E5: begin // push h
PUSH(HL);
Rslt.dly:= 11;
end;
$E6: begin // ani data8
ANA(RD_BYTE(PC));
PC:= PC + 1;
Rslt.dly:= 7;
end;
$E7: begin // rst 4
RST($0020);
Rslt.dly:= 11;
end;
$E8: begin // rpe
Rslt.dly:= 5;
if (PSW and $04) <> 0 then begin
POP(PC); Rslt.dly:= 11; end;
end;
$E9: begin // pchl
PC := HL;
Rslt.dly:= 5;
end;
$EA: begin // jpe addr
if (PSW and $04) <> 0 then PC := RD_WORD(PC)
else PC:= PC + 2;
Rslt.dly:= 10;
end;
$EB: begin // xchg
WR := DE; DE := HL; HL := WR;
Rslt.dly:= 4;
end;
$EC: begin // cpe addr
if (PSW and $04) <> 0 then begin
CALL; Rslt.dly:= 17; end
else begin
PC:= PC + 2; Rslt.dly:= 11; end;
end;
$ED: ;//invalid_opcode()
$EE: begin // xri data8
XRA(RD_BYTE(PC));
PC:= PC + 1;
Rslt.dly:= 7;
end;
$EF: begin // rst 5
RST($0028);
Rslt.dly:= 11;
end;
$F0: begin // rp
Rslt.dly:= 5;
if (PSW and $80) = 0 then begin
POP(PC); Rslt.dly:= 11; end;
end;
$F1: begin // pop psw
POP(AF);
AF:= AF and $FFDF or 2;
Rslt.dly:= 10;
end;
$F2: begin // jp addr
Rslt.dly:= 10;
if (PSW and $80) = 0 then PC := RD_WORD(PC)
else PC:= PC + 2;
end;
$F3: begin // di
//sound_off();
Rslt.dly:= 4;
end;
$F4: begin // cp addr
if (PSW and $80) = 0 then begin
CALL; Rslt.dly:= 17; end
else begin
PC:= PC + 2; Rslt.dly:= 11; end;
end;
$F5: begin // push psw
PUSH(AF);
Rslt.dly:= 11;
end;
$F6: begin // ori data8
ORA(RD_BYTE(PC));
PC:= PC + 1;
Rslt.dly:= 7;
end;
$F7: begin // rst 6
RST($0030);
Rslt.dly:= 11;
end;
$F8: begin // rm
Rslt.dly:= 5;
if (PSW and $80) <> 0 then begin
POP(PC); Rslt.dly:= 11; end;
end;
$F9: begin // sphl
SP := HL;
Rslt.dly:= 5;
end;
$FA: begin // jm addr
if (PSW and $80) <> 0 then PC := RD_WORD(PC)
else PC:= PC + 2;
Rslt.dly:= 10;
end;
$FB: begin // ei
//sound_on();
Rslt.dly:= 4;
end;
$FC: begin // cm addr
if (PSW and $80) <> 0 then begin
CALL; Rslt.dly:= 17; end
else begin
PC:= PC + 2; Rslt.dly:= 11; end;
end;
$FD: ;//invalid_opcode
$FE: begin // cpi data8
CMP(RD_BYTE(PC));
PC:= PC + 1;
Rslt.dly:= 7;
end;
$FF: begin // rst 7
RST($0038);
Rslt.dly:= 11;
end;
end;
with Result do begin
regs[1]:= BC; regs[2]:= DE; regs[3]:= HL;
regs[4]:= AF; regs[5]:= SP; regs[6]:= PC;
FvAddr := PC; // адрес очередной операции
OnAddr(self);
OnReadB(self);
cop:= FvMemB; //чтение кода операции
end;
//Result := Rslt;
end;
procedure Tcpu.RESET;
begin
AF := 2; BC:=0; DE:= 0; HL:= 0; SP:= 0; PC:= 0;
PC := $F800;
OnReset(self)
end;
procedure TCpu.SetCpu(var t: TTakt);
begin
//if not Dbg then exit
//else
with t do begin
BC:= regs[1]; DE:= regs[2]; HL:= regs[3];
AF:= regs[4]; SP:= regs[5]; PC:= regs[6];
FvAddr := PC; // адрес очередной операции
OnAddr(self);
OnReadB(self);
cop:= FvMemB; //чтение кода операции
end;
end;
constructor Tcpu.Create(AOnwer:TComponent);
begin
inherited Create(AOnwer);
AF := 2; BC:=0; DE:= 0; HL:= 0; SP:= 0; PC:= 0;
end;
destructor TCpu.Destroy;
begin
inherited;
end;
procedure Register;
begin
RegisterComponents('Samples', [TCPU]);
end;
end.
Последний раз редактировалось: Valeriy (26 Ноя 2011 16:41), всего редактировалось 7 раз(а)
procedure TKeybCPU.KeyDownCPU(var Key: Word; Shift: TShiftState);
var
KLng1: TLang;
begin
if (ssShift in Shift) and (ssCtrl in Shift) then //ctrl+shift - перекл. РУС - ЛАТ
begin FPKeyC := $70; exit; end;
if FPLand then KLng1 := [sLat]
else KLng1 := [sRus];
if (KLng1 <> KLng) then //если смены небыло, то перегружать расладку не надо
begin
KLng := KLng1;
if sLat in KLng then
VKeybSet:= KeybSetU //латинская раскладка
else
VKeybSet := KeybSetR; end; //русская раскладка
if Key = $10 then begin FPKeyC := FPKeyC or $E0;exit; end; //выход, если нажат только шифт
if (ssCtrl in Shift) then FPKeyC := FPKeyC and $bf; // УС
KeyScan := VKeybSet[WrdRec(Key).lo];
if ssShift in Shift then begin
case Key of
$30: begin KeyScan := $FDF7; FPKeyC := FPKeyC and $df; end;
$31,$33,$35: FPKeyC := FPKeyC and $df;
$38: begin KeyScan := $FBF7; FPKeyC := FPKeyC and $df; end;
$39: begin KeyScan := $FEF7; FPKeyC := FPKeyC and $df; end;
$BB: begin KeyScan := $F7F7; FPKeyC := FPKeyC and $df; end;
end;
if sLat in KLng then
case Key of
$32: KeyScan := $FEeF; //снять шифт
$34: begin KeyScan := $EFFB; FPKeyC := FPKeyC and $df; end;
$36: KeyScan := $BF7F; //снять шифт
$37: begin KeyScan := $BFFB; FPKeyC := FPKeyC and $df; end;
$BA: KeyScan := $FBF7; //снять шифт
$BC: begin KeyScan := $EFF7; FPKeyC := FPKeyC and $df; end;
$BE: FPKeyC := FPKeyC and $df;
$BF: FPKeyC := FPKeyC and $df;
$DE: begin KeyScan := $FBFB; FPKeyC := FPKeyC and $df; end;
end
else
case Key of
$32: begin KeyScan := $FBFB; FPKeyC := FPKeyC and $df; end;
$34: KeyScan := $F7F7; //снять шифт
$36: KeyScan := $FBF7; //снять шифт
$37: begin KeyScan := $7FF7; FPKeyC := FPKeyC and $df; end;
$BF: KeyScan := $EFF7; //снять шифт
$DD: FPKeyC := FPKeyC and $df;
end;
end else begin
case Key of
$6A,$6B,$BB: FPKeyC := FPKeyC and $df;
end;
if ((Key = $DE) and (sLat in KLng)) or ((Key = $DD) and (sRus in KLng)) then FPKeyC := FPKeyC and $df;
end;
function TKeybCPU.GetPKeyC: byte;
begin
GetPKeyC := FPKeyC and $F0;
end;
procedure TKeybCPU.KeyUPCPU(Sender: TObject);
begin
FPKeyA := $FF; //сброс имитации нажатия клавиши
FPKeyB := $FF;
FPKeyC := FPKeyC or $F0;
end;
procedure TKeybCPU.SetPKeyC(Key: byte);
begin
FPKeyC:= (FPKeyC and $F0) or (Key and $0F);
if (Key and $8)= 0 then FPLand:= true else FPLand:= false;
end;
//******************************************************************************
//******************************************************************************
function TMemCPU.ContrlMem(var AddrM:TAddrM; KeyM:Char='R'; WM: byte=0):Boolean;
// контроль зоны озу, обработка портов
{Осуществляет контроль за записью и чтением в адресном пространстве.
Если обращение производится по рабочим адресам ОЗУ, функция выдает разрешение
устанавливая Result в True, в противном случае в False. Если требуется особая
обработка адресов, как в случае работы с портами, чтение и запись производиться
в теле функции в поле FWmM_M, а Result устанавливается в False.
AddrM - адрес ячейки в зоне памяти, WM- в режиме чтения=0, в режиме записи
значение записываемое в память.
KeyM = W - установлен режим записи, R - установлен режим чтения памяти.
По умолчанию - KeyM = R, WM = 0}
var
Db: byte;
begin
{КАРТА распределения адресного пространства памяти}
{*************************************************}
case AddrM of
{зона ОЗУ}//********************************************************************
{зона клавиатуры, и магнитафона КР580ВВ55}//************************************
$8000..$9fff : begin AddrM:= AddrM and $8003;
Result:= false;
case AddrM of
$8000 : begin if KeyM = 'W' then FMemC[$8000]:= WM; Result:= false; end; // порт A запись
$8001 : begin if KeyM = 'R' then begin// порт B чтение
OnPortR(self);
if (FMemC[$8000] = 0) //проверка нажатия клавиши
or (FvPortA = FMemC[$8000]) then begin //проверка сканкода клавиши
FMemC[$8001] := FvPortB end
else FMemC[$8001] := $FF;
FWmM_M := FMemC[$8001]; end;
Result:= false;
end;
$8002 : begin // порт C //магнитафон, индикатор клавиатуры, перекл.языка, УС, СС - запись в разряды 0-3, чтение из разрядов 4-7
OnPortR(self);
if KeyM = 'W' then begin
//FvPortC:= (FvPortC and $F0) or (WM and $0F); OnPortW(self)
end
else FWmM_M := FvPortC and $F0;
FMemC[$8002]:= FvPortC;
Result:= false;
end;
$8003 : begin // порт управляющего слова, только запись!
if KeyM = 'W' then begin OnPortR(self); FMemC[$8002] := (FvPortC or FMemC[$8002]);
//WM and $80; //проверка режима управляющего слова - "1" в 7 разряде.
if (WM and $80)= 0 then begin //режим установки разрядов порта С
if (WM and $01) <> 0 then begin //установка разряда С в 0 или 1
Db := 1 shl((WM and $0E)shr 1); //выбор разряда
FMemC[$8002]:= (FMemC[$8002] and $F7 or Db);
end;
end;
FvPortC:= FMemC[$8002];
OnPortW(self);
end;
Result:= false;
end;
end;
end;
{зона внешнего интерфейса КР580ВВ55}//******************************************
$A000..$Bfff : begin AddrM:= AddrM and $A003;
Result:= false;
case AddrM of
$A000 : Result:= True; // порт A
$A001 : Result:= True; // порт B
$A002 : Result:= True; // порт C
$A003 : begin
if KeyM = 'W' then Result:= True // только запись, порт управляющего слова
else Result:= true;
end;
end;
end;
//******************************************************************************
{управление контролером ЭЛТ}//**************************************************
{порт $C000 - порт параметров,
порт $C001 - порт команд, команда однобайтовая, если до поступления следующей
команды не было получено необходимое для предыдущей команды число
байтов параметров, то в регистре состояния выставится
флаг - неверная команда.}
{коды команд 00000000 ($00) - сброс (формат) экрана, имеет 4 параметра, сброс D6,D2;
001SSSBB ($20) - ражрешение отображения, параметров нет, D6, D2;
01000000 ($40) - конец отображения, параметров нет, сброс D2;
01100000 ($60) - считывание положения светового пера,
2 параметра, чтение параметров из порта $C000;
10000000 ($80) - загружка положения курсора, 2 параметра;
10100000 ($A0) - разрешения прерывания, параметров нет, D6;
11000000 ($C0) - запрещение прерывания, параметров нет, сброс D6;
11100000 ($E0) - предустановка счетчиков, параметров нет.
в скобках значение после операции И с $E0
SSS - интервал между пакетами
BB - число запросов в пакете.}
{Регистр слова состояния, чтение из порта $C001:
D7 ($80)- 0;
D6 ($40) - разрешение прерывания, устанавливается при включении питания,
а также при выполнении команд Разрешение прерывания,
Разрешения отображения, сбрасывается командами Запрещение
прерывания и Формат экрана;
D5 ($20) - запрос на прерывание; устанавливается в начале отображения
последнего ряда знакоместа кадра, если было разрешено
прерывание;
D4 ($10) - сигнал от светового пера, устанавливается, когда вход от
светового пера активен и загружены регистры светового пера;
D3 ($08) - неверная команда, устанавливается при неправильной записи
команды в контроллер ЭЛТ,т.е. последовательность параметров
слишком длинная или короткая;
D2 ($04) - разрешение отображения; устанавливается по команде Ражрешение
отображения и сбрасывается по командам Запрет отображения и
Фортат экрана;
D1 ($02)- недогружка ПДП, устанавливается при недргружке данных в
буфере в ходе отображения информации на экране, при появлении
бита режим ПДП прекращается и экран затемняется до начала
отображения нового кадра изображения;
D0 ($01) - переполнение стека символов, устанавливается если число
признаков в строке символов превысило 16.
{управление курсором осуществляется по команде 10000000 ($80),
параметр 1- номер знакоместа в ряду,
параметр 2 - номер ряда знакоместа}
$C000..$Dfff : begin AddrM:= AddrM and $C001;
Result:= false;
case AddrM of
$C000 : begin SetCrtA(Wm,KeyM); Result := false; end;
$C001 : begin SetCrtB(Wm,KeyM); Result:= false; end;
end;
end;
//******************************************************************************
{контролер Прямого доступа к памяти}//******************************************
{зона монитора}//***************************************************************
$E000..$FFFF : begin AddrM:= AddrM and $E7FF;
if KeyM = 'R' then Result:= True // только чтение
else Result:= false;
end;
else Result:= false;
end;
end;
//******************************************************************************
//******************************************************************************
{ Процедура обработки параметров по адресу $C000}
procedure TMemCPU.SetCrtA(Wm: byte;KeyM: Char );
begin
if KeyM = 'W' then //проверка на запись - чтение
begin
FNambPar:= FNambPar + 1;
if ((FNambPar<>0) and (FNambPar<= FNambParCtr))and (FWmM in [0,$80]) then
begin
case FWmM of //в WmM команда формата экрана или установки курсора
//запись параметров
$00 : begin
if FNambPar = 4 then
end;
$80 : begin //установка курсора
case FNambPar of
1 : begin FCrsX:= WM-8; end;//запись коордионат курсора в регистры
2 : FCrsY := WM-3;
end;
end;
end;
end
else FMemC[$C001]:= FMemC[$C001] or $08; {записать в регистр состояния - неправильная команда}
end;
end;
//******************************************************************************
{обработка команд контролера ЭЛТ (C001)}
procedure TMemCPU.SetCrtB(Wm: byte; KeyM: Char);
begin
if KeyM = 'W' then // запись в регистр управления, чтение регистра состояния
begin {обработка при записи, т.е. производится запись команды }
if ((FNambPar<>FNambParCtr) or (FNambPar > 4)) then
FMemC[$C001]:= FMemC[$C001] or $08; //установка бита - неврная команда
FNambPar:=0; //обнулить счетчики параметров
FNambParCtr:=0; //....
FWmM := WM and $E0; // маска для выделения разрядов команды
{далее определяем команду, устанавливаем NambParCtr}
case FWmM of
$00 : begin //сброс (формат) экрана, имеет 4 параметра, сброс D6,D2 00111011 $3B
FNambParCtr:= 4;
FMemC[$C001]:= FMemC[$C001] and $3B;
end;
$20 : begin//ражрешение отображения, параметров нет, D6, D2;
FMemC[$C001]:= FMemC[$C001] or $44;
end;
$40 : begin //конец отображения, параметров нет, сброс D2;
FMemC[$C001]:= FMemC[$C001] and $7B;
end;
$60 : FWmM := 0; //считывание положения светового пера,
$80 : FNambParCtr:= 2;//WmM=$80 загружка положения курсора, 2 параметра;
$A0 : begin//разрешения прерывания, параметров нет, D6;
FMemC[$C001]:= FMemC[$C001] or $40;
end;
$C0 : begin//запрещение прерывания, параметров нет, сброс D6;
FWmM := 0;
FMemC[$C001]:= FMemC[$C001] and $3F;
end;
$E0 : begin//предустановка счетчиков, параметров нет
//WmM := 0;
FCrsX :=0;
FCrsY :=0;
end;
else FWmM := 0
end;
end
else begin
{чтение регистра состояния C001}
FNambPar:=0; //обнулить счетчики параметров
FNambParCtr:=0;
FWmM_M := FMemC[$C001]; //чтение слова состояния
FMemC[$C001]:= FMemC[$C001] and $44; // D5, D4, D3, D1, D0 0100 0100 $44 - сбрасываются после чтения регистра состояния
end;
end;
//******************************************************************************
function TMemCPU.GetMemRead: byte; // чтение байта
begin
FWmM_M := 0;
if ContrlMem(FAddrM) then Result:= FMemC[FAddrM] else Result:= FWmM_M;
end;
//******************************************************************************
procedure TMemCPU.SetMemWrite(AValie: byte); // запись байта
begin
if ContrlMem(FAddrM,'W',AValie) then FMemC[FAddrM]:= AValie;
end;
//******************************************************************************
procedure TMemCPU.SetAddrM(const AValie: TAddrM);
begin
if FAddrM <> AValie then FAddrM:= AValie; //установка адреса
end;
//******************************************************************************
procedure TMemCPU.LoadMon;
var
i:integer;
MonFl: file of byte;
AV: byte;
begin
for i:=0 to $7fff do FMemC[i]:= random($100);
AssignFile(MonFl, 'mon32.bin');
Reset(MonFl);
for i:=0 to $7ff do
begin
read(MonFl,AV);
FMemC[$E000+i]:= AV;
end;
CloseFile(MonFl);
AssignFile(MonFl, 'Asm.rkr');
Reset(MonFl);
for i:=0 to $fff do
begin
read(MonFl,AV);
FMemC[i]:= AV;
end;
CloseFile(MonFl);
end;
//******************************************************************************
function FlToBin (B :Byte) :string;
function BtToHexAddr (W :Word) :string;
function WrdToHexAddr (W :Word) :string;
function BtToChrAddr(W: Word) :string;
function StrHexToInt(S:string): integer;
function StrDel(S:string):string;
function RD_WORD(W:word): word;
function ByteToHex (B :Byte) :string;
begin
ByteToHex := HexNumbers[b div 16] + HexNumbers[b mod 16]
end;
function WordToHex(W:word):string;
begin
WordToHex:= ByteToHex(WrdRec(W).Hi)+ ByteToHex(WrdRec(W).Lo);
end;
function FlToBin (B :Byte) :string;
begin
if B <> 0 then FlToBin:= '1' else FlToBin:= '0';
end;
function RD_BYTE(W:word): byte;
begin
MemCPU.vAddr := W;
Result := MemCPU.vMemB;
end;
function RD_WORD(W:word): word;
var
Reg:word;
begin
MemCPU.vAddr := W;
WrdRec(Reg).Lo := MemCPU.vMemB;
MemCPU.vAddr := W +1;
WrdRec(Reg).Hi := MemCPU.vMemB;
Result := Reg;
end;
function BtToHexAddr (W :Word) :string; //байт в Н виде по адресу
//const
// HexNumbers :array [0..15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
begin
BtToHexAddr:= ByteToHex(RD_BYTE(W));
end;
function WrdToHexAddr (W :Word) :string; //слово в Н виде по адресу
begin
WrdToHexAddr:= WordToHex(RD_WORD(W));
end;
function BtToChrAddr(W: Word) :string; //байт в символ по адресу
begin
BtToChrAddr:= Chr(ChrSet[($7f and RD_BYTE(W))]);
end;
function StrHexToInt(S:string): integer; //строку в Н виде в целое
var
w: word;
b,i,k: byte;
begin
w:=0;
b:= Length(S);
for i:= 1 to b do
begin
k:=0;
while S[i]<> HexNumbers[k] do k:=k+1;
w:= w+k;
if i<b then w:= w*16;
end;
StrHexToInt:=w;
end;
function StrDel(S:string):string; //удаление пробелов
var
i: integer;
begin
Result:= S;
for i:=1 to Length(Result) do
if Result[i]=' ' then delete(Result,i,1);
end;
end.
UIm2.pas
Код:
{ *********************************************************************** }
{ }
{ Full screen Form Unit UIm2.pas }
{ V. 1.0.03 }
{ Copyright (c) 2006 Mihaylov Valeriy }
{ }
{ *********************************************************************** }
sFS:= FlToBin((WrdRec(r.regs[4]).Lo) and $80); //двоичные значения флагов
sFZ:= FlToBin((WrdRec(r.regs[4]).Lo) and $40);
sFAC:= FlToBin((WrdRec(r.regs[4]).Lo) and $10);
sFO:= FlToBin((WrdRec(r.regs[4]).Lo) and $08);
sFP:= FlToBin((WrdRec(r.regs[4]).Lo) and $04);
sFC:= FlToBin((WrdRec(r.regs[4]).Lo) and $01);
srBC:= BtToHexAddr(r.regs[1]); //значение байта по адресу
srDE:= BtToHexAddr(r.regs[2]); // в регистрах BC,DE,HL
srHL:= BtToHexAddr(r.regs[3]);
srPC:= BtToHexAddr(r.regs[6]); //код операции
srSP:= WrdToHexAddr(r.regs[5]); // значение слова в стеке
srSP2:= WrdToHexAddr(r.regs[5]-2);
srSP4:= WrdToHexAddr(r.regs[5]-4);
srSP6:= WrdToHexAddr(r.regs[5]-6);
schrBC:= BtToChrAddr(r.regs[1]); //преобразование байта
schrDE:= BtToChrAddr(r.regs[2]); //находящегося по адресу
schrHL:= BtToChrAddr(r.regs[3]); //в символ
//with DebagForm do begin
EditA.Text:= sA; //вывод
EditB.Text:= sB;
EditC.Text:= sC;
EditD.Text:= sD;
EditE.Text:= sE;
EditH.Text:= sH;
EditL.Text:= sL;
EditSP.Text:= sSP;
EditPC.Text:= sPC;
EditFS.Text:= sFS;
EditFZ.Text:= sFZ;
EditFAC.Text:= sFAC;
EditFO.Text:= sFO;
EditFP.Text:= sFP;
EditFC.Text:= sFC;
EditF0.Text:= FlToBin((WrdRec(r.regs[4]).Lo) and $20);
EditF1.Text:= FlToBin((WrdRec(r.regs[4]).Lo) and $02);
LabelBC.Caption:= srBC;
LabelDE.Caption:= srDE;
LabelHL.Caption:= srHL;
LabelPC.Caption:= srPC;
LabelSP.Caption:= srSP;
LabelChrBC.Caption:= schrBC;
LabelChrDE.Caption:= schrDE;
LabelChrHL.Caption:= schrHL;
//LabelPC2.Font.Color:= $F040F0;
//end;
//with DebagForm do begin
case r.cop of //подсветка флага, контролируемого операцией условного перехода
$C2,$C0,$C4,$C8,$CA,$CC: begin EditFZ.Color:= clRed; LabelPC.Font.Color:= clRed; end;
$D2,$D0,$D4,$D8,$DA,$DC: begin EditFC.Color:= clRed; LabelPC.Font.Color:= clRed; end;
$E2,$E0,$E4,$E8,$EA,$EC: begin EditFP.Color:= clRed; LabelPC.Font.Color:= clRed; end;
$F2,$F0,$F4,$F8,$FA,$FC: begin EditFS.Color:= clRed; LabelPC.Font.Color:= clRed; end;
else
EditFZ.Color:= clWindow; //обнуление цвета
EditFC.Color:= clWindow;
EditFP.Color:= clWindow;
EditFS.Color:= clWindow;
end;
case r.cop of //подсветка кода операций перехода
$C3,$CD,$CF,$D7,$DF,
$E7,$EF,$F7,$FF,$C9 : LabelPC.Font.Color:= clRed;
$C1,$C5,$D1,$D5,
$E1,$E5,$F1,$F5 : LabelPC.Font.Color:= $F040F0; //PUSH, POP
else
LabelPC.Font.Color:= clBlue;
end;
//end;
//if r.regs[6] < $F000 then //монитор не выводить
ReportMemo;
end;
procedure TDebagForm.ButtonStepIntoClick(Sender: TObject); //Step into
begin
if Sender<Timer1> $F836) and (rTakt.regs[6]< $FFFF)) then
DebagFormChange(rTakt);
end;
procedure TDebagForm.ButtonStepOverClick(Sender: TObject); //Step over
begin
if Sender<> Timer1 then ButtonStop.Click;
if rTakt.cop in [$C4,$CC,$CD,$D4,$DC,$E4,$EC,$F4,$FC] then
begin
Cpu.ContPC:= rTakt.regs[6]+3;
Cpu.ContSP:= rTakt.regs[5];
repeat
rTakt:= cpu.Takt(rtkt,true);
Application.ProcessMessages;
until rTakt.auto;
end else rTakt:= cpu.Takt(rtkt);
DebagFormChange(rTakt);
end;
procedure TDebagForm.ButtonRunClick(Sender: TObject); //работа эмулятора в автоматическом режиме
begin // под контролем отладчика
// // происходит контроль точек останова
end;
procedure TDebagForm.FormClose(Sender: TObject; var Action: TCloseAction); //закрытие формы
begin
Form1.sbDebug.Down:= false;
Form1.sbDebagClick(Sender);
end;
procedure TDebagForm.EditFSDblClick(Sender: TObject); //ручная инверсия флагов
var
S:string;
begin
if not(ButtonAutoStepOver.Down or ButtonAutoStepInto.Down) then
if Sender = EditFS then begin
WrdRec(rTakt.regs[4]).Lo:= (not WrdRec(rTakt.regs[4]).Lo and $80)
or (WrdRec(rTakt.regs[4]).Lo and $7F); S:= 'S'; end
else if Sender = EditFZ then begin
WrdRec(rTakt.regs[4]).Lo:= (not WrdRec(rTakt.regs[4]).Lo and $40)
or (WrdRec(rTakt.regs[4]).Lo and $BF); S:= 'Z'; end
else if Sender = EditFAC then begin
WrdRec(rTakt.regs[4]).Lo:= (not WrdRec(rTakt.regs[4]).Lo and $10)
or (WrdRec(rTakt.regs[4]).Lo and $EF); S:= 'AC'; end
else if Sender = EditFO then begin
WrdRec(rTakt.regs[4]).Lo:= (not WrdRec(rTakt.regs[4]).Lo and $08)
or (WrdRec(rTakt.regs[4]).Lo and $F7); S:= 'O'; end
else if Sender = EditFP then begin
WrdRec(rTakt.regs[4]).Lo:= (not WrdRec(rTakt.regs[4]).Lo and $04)
or (WrdRec(rTakt.regs[4]).Lo and $FB); S:= 'P'; end
else if Sender = EditFC then begin
WrdRec(rTakt.regs[4]).Lo:= (not WrdRec(rTakt.regs[4]).Lo and $01)
or (WrdRec(rTakt.regs[4]).Lo and $FE); S:= 'C'; end;
FormDM.Memo.Lines.Add(' ИНВЕРСИЯ ФЛАГА '+S+#13#10);
Cpu.SetCpu(rTakt);
DebagFormChange(rTakt);
end;
procedure TDebagForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); //обработка клавиш F7,F8,F9
begin
DebagForm.SetFocus;
case Key of
VK_F7: ButtonStepIntoClick(Sender);
VK_F8: ButtonStepOverClick(Sender);
VK_F9: ButtonRunClick(Sender);
end;
end;
procedure TDebagForm.EditADblClick(Sender: TObject); //разрешить редактирование регистров и флагов
begin
(Sender as TEdit).ReadOnly:= false;
end;
procedure TDebagForm.EditRegs(Sender: TEdit);//редактирование регистров
var
S:string;
begin
If Sender = EditB then begin //case не катит, не порядковый тип
WrdRec(rTakt.regs[1]).Hi:= byte(StrHexToInt(Sender.Text));
S:= 'B'; end
else If Sender = EditC then begin
WrdRec(rTakt.regs[1]).Lo:= byte(StrHexToInt(Sender.Text));
S:= 'C'; end
else If Sender = EditD then begin
WrdRec(rTakt.regs[2]).Hi:= byte(StrHexToInt(Sender.Text));
S:= 'D'; end
else If Sender = EditE then begin
WrdRec(rTakt.regs[2]).Lo:= byte(StrHexToInt(Sender.Text));
S:= 'E'; end
else If Sender = EditH then begin
WrdRec(rTakt.regs[3]).Hi:= byte(StrHexToInt(Sender.Text));
S:= 'H'; end
else If Sender = EditL then begin
WrdRec(rTakt.regs[3]).Lo:= byte(StrHexToInt(Sender.Text));
S:= 'L'; end
else If Sender = EditA then begin
WrdRec(rTakt.regs[4]).Hi:= byte(StrHexToInt(Sender.Text));
S:= 'A'; end
else If Sender = EditSP then begin
rTakt.regs[5]:= StrHexToInt(Sender.Text);
S:= 'SP'; end
else If Sender = EditPC then begin
rTakt.regs[6]:= StrHexToInt(Sender.Text);
S:= 'PC';
end;
FormDM.Memo.Lines.Add(' ИЗМЕНЕНИЕ РЕГИСТРА '+S+#13#10);
Cpu.SetCpu(rTakt);
DebagFormChange(rTakt);
end;
procedure TDebagForm.EditAKeyPress(Sender: TObject; var Key: Char); //ввод значений в регистры
begin
LoadKeyboardLayout('00000409', KLF_ACTIVATE);
Key := UpCase(Key);
if not (Key in ['0'..'9','A'..'F',#8,#13,#27,#46]) then Key := #0;
if Key = #13 then
begin
if (Sender as TEdit).Modified then EditRegs(Sender as TEdit);
(Sender as TEdit).Modified:= false;
(Sender as TEdit).ReadOnly:= true;
end;
if (Key =#27) then begin
if (Sender as TEdit).Modified then
if (Sender as TEdit).CanUndo then (Sender as TEdit).Undo;
(Sender as TEdit).Modified:= false;
(Sender as TEdit).ReadOnly:= true;
end;
end;
procedure TDebagForm.ButtonResetClick(Sender: TObject); //установка всех регистров в ноль
begin
ButtonStop.Click;
rtkt:= 0;
rTakt.regs[1]:= 0; rTakt.regs[2]:= 0; rTakt.regs[3]:= 0;
rTakt.regs[4]:= 2; rTakt.regs[5]:= 0; rTakt.regs[6]:= 0;
FormDM.Memo.Lines.Add(' СБРОС в ноль');
Cpu.SetCpu(rTakt);
DebagFormChange(rTakt);
end;
procedure TDebagForm.EditSPExit(Sender: TObject); //потеря фокуса регистра
begin
if (Sender as TEdit).Modified then EditRegs(Sender as TEdit);
(Sender as TEdit).ReadOnly:= true;
end;
procedure TDebagForm.Timer1Timer(Sender: TObject);// таймер автотрассировки
begin
if ButtonAutoStepInto.Down then ButtonStepIntoClick(Sender)
else
if ButtonAutoStepOver.Down then ButtonStepOverClick(Sender)
else
Timer1.Enabled:= false;
end;
procedure TDebagForm.ButtonAutoStepOverClick(Sender: TObject);//auto Step over
begin
if ButtonAutoStepOver.Down then
Timer1.Enabled:= true;
end;
procedure TDebagForm.ButtonAutoStepIntoClick(Sender: TObject);//auto Step into
begin
if ButtonAutoStepInto.Down then
Timer1.Enabled:= true;
end;
procedure TDebagForm.Button6Click(Sender: TObject);// включение экрана трассировки
begin
if BoolMemo then FormDM.Show
else FormDM.Hide;
BoolMemo:= not BoolMemo;
end;
Вы не можете начинать темы Вы можете отвечать на сообщения Вы не можете редактировать свои сообщения Вы не можете удалять свои сообщения Вы не можете голосовать в опросах
FAQ
Поиск
Пользователи
Группы
Регистрация
Профиль
Войти и проверить личные сообщения
Вход
