| HOME | NEWS | AWARDS | ABOUT ME | TEXTE | REFERATE | PROJEKTE |
|
MUSIK | CHAT | SPECIAL | LINKS |

6. Listing

program regma;
uses crt,maus;
type
  tOperation   = (LDA,LDK,STA,ADD,SUB,MUL,DIW,JMP,JEZ,JNE,JLZ,JLE,JGZ,JGE,INP,
                 OUT,HLT);
  tAdresse    = byte;
  tBefehl      = record
                 operation : tOperation;
                 adresse : tAdresse;
                end;
  tDatum       =-255..255 ;
  tProgrammspeicher = array[1..255] of tBefehl;
  tDatenspeicher = array[0..255] of tDatum;
  tBefehlswoerter = array[1..17] of string[3];
  tfenster = 1..6;
  tframe   = record
             framet: string[19];
             x, y, l, h, c1, c2, sy, my : Byte;
             end;
  eframes  = (HOTKEYS,MONITOR,PROZESSOR,HILFE,PROGSPEICHER,DATSPEICHER,SCREEN);
const
  befehlswort : array[tOperation] of string[3] = ('LDA','LDK','STA','ADD','SUB','MUL',
                                       'DIW','JMP','JEZ','JNE','JLZ','JLE',
                                       'JGZ','JGE','INP','OUT','HLT');
  cframes    : array[eFrames] of tframe
                = ((framet: ' Hotkeys ';
                   x:01; y:01; l:17; h:07; c1:11; c2:01; sy:00; my: 00),
                  (framet: ' Monitor ';
                   x:62; y:01; l:17; h:07; c1:11; c2:01; sy:00; my: 00),
                  (framet: ' Prozessor ';
                   x:20; y:03; l:40; h:11; c1:14; c2:02; sy:00; my: 00),
                  (framet: ' Hilfe\Information ';
                   x:20; y:17; l:40; h:07; c1:11; c2:01; sy:00; my: 00),
                  (framet: ' Programmsp. ';
                   x:02; y:11; l:16; h:13; c1:14; c2:02; sy:00; my: 13),
                  (framet: ' Datensp. ';
                   x:62; y:11; l:16; h:13; c1:14; c2:02; sy:00; my: 13),
                  (framet: '';
                   x:1; y:1; l:80; h:25; c1:14; c2:02; sy:00; my: 13));
var
  progMem               :tProgrammspeicher;
  dataMem               :tDatenSpeicher;
  ax                    :tDatum;
  ip                    :tAdresse;
  l                     :integer;
  monitorSpalte         :word;
  fileName              :string;
  helpfile              :file of string;
const bkgcolor:byte=blue;
      link    :byte=red;
      helpok  :boolean=true;
procedure setWindow(what:eFrames);
begin
 window(cFrames[what].x+1,cFrames[what].y+1,
        cFrames[what].l+cFrames[what].x-1,
        cFrames[what].h+cFrames[what].y);
 textcolor(cFrames[what].c1);
 textbackground(cFrames[what].c2);
 gotoxy(1,1);
end;
procedure printtext(s:string;maxx:byte);
var i   :byte;
    wort:string;
    zeilezeichen:byte;
  procedure getword(var w:string;beg:byte);
  var j :byte;
  begin
    j:=beg;
    w:='';
    while (s[j]<>' ') and (j<=length(s)) do begin
      w:=w+s[j];
      inc(j);
    end;
  end;
begin
  i:=1;
  zeilezeichen:=1;
  while i<=length(s) do begin
    getword(wort,i);
    if ((zeilezeichen mod maxx) +length(wort)>=maxx-1) and (wort<>'%') then begin
      writeln;
      zeilezeichen:=1;
    end;
    if wort[1]='@' then begin
      textbackground(link);
      delete(wort,1,1);
      write(wort);
      textbackground(bkgcolor);
      write(' ');
      inc(zeilezeichen,length(wort)+1);
      inc(i);
    end
    else if wort='%' then begin
      writeln;
      wort:='';
      zeilezeichen:=1;
    end else begin
      inc(zeilezeichen,length(wort)+1);
      write(wort+' ');
    end;
    i:=i+length(wort)+1;
  end;
end;
function mousebackground:byte;
begin
  mousebackground:=mem[$b800:mousey div 8*160+ mousex div 8*2+1] shr 4;
end;
function string_under_mouse:string;
var ad:integer;
    s :string;
begin
  ad:=mousey div 8*160+ mousex div 8*2;
  s:='';
  while mem[$b800:ad]<>32 do begin
    s:=s+chr(mem[$b800:ad]);
    inc(ad,2);
  end;
  ad:=mousey div 8*160+ mousex div 8*2-2;
  while mem[$b800:ad]<>32 do begin
    s:=chr(mem[$b800:ad])+s;
    dec(ad,2);
  end;
  string_under_mouse:=s;
end;
procedure openhelpfile;
begin
  helpok:=true;
  assign(helpfile,'help.hlp');
  {$I-}
  reset(helpfile);
  if ioresult<>0 then begin
    helpok:=false;
    writeln('Hilfedatei nicht gefunden! Return!');
    readln;
  end;
  {$I+}
end;
procedure closehelpfile;
begin
  {$I-}
  if helpok then close(helpfile);
  {$I+}
end;
procedure ersetzen(var s:string;adresse,badresse:byte);
var i:byte;
    newstring:string;
begin
  while pos('#',s)<>0 do begin
    i:=pos('#',s);
    if s[i+1]='b' then begin
      delete(s,i,5);
      str(badresse,newstring);
    end else begin
      delete(s,i,4);
      str(adresse,newstring);
    end;
    if badresse=255 then newstring:='xx';
    insert(newstring,s,i);
  end;
end;
function searchtopic(s:string):string;
var j       :word;
    helptext:string;
    wort1   :string;
begin
  wort1:='';
  seek(helpfile,0);
  while not eof(helpfile) and (wort1<>s) do begin
    wort1:='';
    read(helpfile,helptext);
    j:=1;
    while helptext[j]<>' ' do begin
      wort1:=wort1+helptext[j];
      inc(j);
    end;
  end;
  searchtopic:=helptext;
end;
procedure help(data:tbefehl;adresse:word);
var befstr                                :string;
    helptext                              :string;
begin
  if helpok then begin
    befstr:=befehlswort[data.operation];
    helptext:=searchtopic(befstr);
    ersetzen(helptext,data.adresse,adresse);
    printtext(helptext,38);
  end;
end;
procedure help2(s:string);
var i:byte;
    helptext:string;
begin
  if helpok then begin
    helptext:=searchtopic(s);
    clrscr;
    printtext(helptext,38);
  end;
end;
procedure mouseinhelp;
var s     :string;
    c,i   :byte;
    data  :tbefehl;
begin
  mousehide;
  s:=string_under_mouse;
  c:=mousebackground;
  i:=0;
  setwindow(HILFE);
  if c=link then begin
    if length(s)>3 then help2(s)
    else begin
      while befehlswort[toperation(i)]<>s do inc(i);
      data.operation:=toperation(i);
      data.adresse:=255;
      clrscr;
      help(data,255);
    end;
  end;
  mouseshow;
  mousestatus;
end;
Procedure laden(name:string;var p:tprogrammspeicher;var w:integer);
var  f                     :text;
     s                     :string;
     load                  :boolean;
  procedure init(n:string; var p:tprogrammspeicher);
  var i                     :integer;
  begin
    clrscr;
    for i:=1 to 255 do
      begin
      p[i].operation:=HLT;
      p[i].adresse:=99;
      datamem[i]:=0;
      end;
    {$I-}
    assign(f,n);
    reset(f);
    if ioresult<>0 then load:=false else load:=true;
    {$I+}
  end;
  procedure lade(var w:integer;var p:tprogrammspeicher);
  var q,e                 :integer;
      s1                  :string;
      fehl                :boolean;
      r                   :tOperation;
  Begin
    w:=1;
    fehl:=false;
    while not(eof(f)) and not(fehl) do begin
      fehl:=true;
      readln(f,s);
      s1:=copy(s,1,3);
      for e:= 1 to 3 do s1[e]:=upcase(s1[e]);
      s :=copy(s,5,3);
      val(s,q,e);
      if e=0 then begin
        for e:=1 to 16 do begin
          if s1=befehlswort[toperation(e-1)] then begin
            p[w].operation:=toperation(e-1);
            p[w].adresse:=q;
            fehl:=false;
          end
        end;
        inc(w);
        end;
       end;
    dec(w);
  End;
  procedure ende;
  begin
    close(f);
  end;
Begin
  init(name,p);
  if load then begin
    lade(w,p);
    ende;
  end;
End;
procedure frame(what:eFrames);
var i, j                      : Byte;
    s0, s1, s2                : string[80];
begin
  gotoxy(cFrames[what].x, cFrames[what].y);
  textcolor(cFrames[what].c1);
  textbackground(cFrames[what].c2);
  fillchar(s0,cFrames[what].l-length(cFrames[what].framet),'Ä');
  s0[0] := chr(cFrames[what].l-1-length(cFrames[what].framet));
  fillchar(s1,cFrames[what].l,'Ä');
  s1[0] := chr(cFrames[what].l-1);
  fillchar(s2,cFrames[what].l,' ');
  s2[0] := chr(cFrames[what].l-1);
  write('Ú', cFrames[what].framet, s0, '¿');
  for i := 1 to cFrames[what].h do
    begin
    gotoxy(cFrames[what].x, wherey+1);
    write('³',s2,'³');
    end;
  gotoxy(cFrames[what].x, wherey+1);
  write('À', s1, 'Ù');
end;
procedure showDesktop;
begin
  setwindow(SCREEN);
  textbackground(black);
  clrscr;
  textcolor(yellow);
  gotoxy(19, 1);
  write(' --- SIMULATION EINER REGISTERMASCHINE --- ');
  gotoxy(19, 2);
  write('  --------------------------------------- ');
  frame(MONITOR);
  frame(HILFE);
  frame(HOTKEYS);
  frame(PROGSPEICHER);
  frame(DATSPEICHER);
  frame(PROZESSOR);
  (* Datenleitungen *)
    textcolor(white);
    textbackground(black);
    gotoxy(01,10); write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
    gotoxy(01,11); write('³');
    gotoxy(01,12); write('ÀÄ');
    gotoxy(18,12); write('ÄÄÄ');
    gotoxy(60,10); write('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
    gotoxy(79,11); write('³');
    gotoxy(78,12); write('ÄÙ');
    gotoxy(60,12); write('ÄÄÄ');
    textbackground(green);
    gotoxy(20,10); write('Ä');
    gotoxy(60,10); write('Ä');
    gotoxy(20,12); write('Ä');
    gotoxy(60,12); write('Ä');
    gotoxy(02,12); write('Ä');
    gotoxy(14,12); write('ÄÄÄÄÄ');
    gotoxy(62,12); write('Ä');
    gotoxy(78,12); write('Ä');
 (* fr Hotkeys *)
    setWindow(HOTKEYS);
     textColor(green);
     writeln('Weiter:"Return"');
     writeln('Laden :"l"');
     writeln('Neustart:"n"');
     write  ('Ende  :"ESC"');
 (* fr Prozessor*)
    setWindow(PROZESSOR);
     write('     ÚÄÄÄÄÄÄÄÄ¿        ÚÄÄÄÄÄÄÄÄÄÄÄ¿   ');
     write('ÚÄÄÄÄ´Befehls-³        ³Akkumulator³   ');
     write('³    ³ zhler ³        ÃÄÄÄÄÄÂÄÄÄÄÄ´   ');
     write('³    ÀÄÄÄÂÄÄÄÄÙ      ÚÄ´ ... ³ ... ÃÄ¿ ');
     write('³        ³ ÚÄÄÄÄÄÄÄÄ¿³ ÀÄÄÄÄÄÁÄÄÄÄÄÙ ³ ');
     write('³ ÚÄÄÄÄÄÄÁÄÁÄÄÄÄÄÄ¿ ³³ ÚÄÄÄÄÄÄÄÄÄÄÄ¿ ³ ');
     write('Ù ³Befehlsregister³ ÀÅÄ´    ...    ³ ÀÄ');
     write('  ÃÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄ´  ³ ÃÄÄÄÄÄÂÄÄÄÄÄ´   ');
     write('¿ ³   ... ³ ...   ÃÄ¿ÀÄ´ ... ³ ... ³ ÚÄ');
     write('³ ÀÄÄÄÂÄÄÄÁÄÄÂÄÄÄÄÙ ³  ÀÄÄÄÄÄÁÄÄÄÄÄÙ ³ ');
     write('ÀÄÄÄÄÄÁÄÄÄÄÄÄÙ      ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  setWindow(SCREEN);
end;
procedure printByte(b:tDatum);
begin
  if abs(b)<10 then write('  ')
   else if abs(b)<100 then write(' ');
  write(b);
end;
procedure showProgMem;
var i : Byte;
begin
  setWindow(PROGSPEICHER);
  textcolor(yellow);
  for i := 1 to cFrames[PROGSPEICHER].h do
   begin
     gotoxy(1, i);
     write('$');
     printbyte(i+ip-1);
     gotoxy(5,i);
     write(':',befehlswort[progMem[ip+i-1].operation],' ');
     printByte(progMem[ip+i-1].adresse);
   end;
end;
procedure showDataMem;
var i,h : Byte;
begin
  setWindow(DATSPEICHER);
  textcolor(yellow);
  h:=progMem[ip].adresse-1;
  for i := 1 to cFrames[DATSPEICHER].h do
   begin
    gotoxy(1, i);
    write('$');
    printbyte(i);
    gotoxy(5,i);
    write(':      ');
    printByte(dataMem[i]);
   end;
end;
procedure showAll;
begin
  showDataMem;
  showProgMem;
  setWindow(PROZESSOR);
  textcolor(red);
  gotoxy(7,9);
  write(befehlswort[progMem[ip].operation]);
  gotoxy(13,9);
  printByte(progMem[ip].adresse);
  gotoxy(26,9);
  printByte(ax);
  gotoxy(32,9);
  printByte(dataMem[progMem[ip].adresse]);
  gotoxy(29,7);
  write(befehlswort[progMem[ip].operation]);
  gotoxy(26,4);
  printByte(ax);
  gotoxy(32,4);
  printByte(dataMem[progMem[ip].adresse]);
  setwindow(HILFE);
  clrscr;
  help(progmem[ip],ip);
end;
procedure interpreter(key:char);
var i:string;
    j:integer;
begin
  case key of
    #13:begin
          case progMem[ip].operation of
            LDA:ax:=dataMem[progMem[ip].adresse];
            LDK:ax:=progMem[ip].adresse;
            STA:dataMem[progMem[ip].adresse]:=ax;
            ADD:ax:=ax+dataMem[progMem[ip].adresse];
            SUB:ax:=ax-dataMem[progMem[ip].adresse];
            MUL:ax:=ax*dataMem[progMem[ip].adresse];
            DIW:ax:=ax div dataMem[progMem[ip].adresse];
            JMP:ip:=progMem[ip].adresse-1;
            JEZ:if ax=0 then ip:=progMem[ip].adresse-1;
            JNE:if ax<>0 then ip:=progMem[ip].adresse-1;
            JLZ:if ax<0 then ip:=progMem[ip].adresse-1;
            JLE:if ax<=0 then ip:=progMem[ip].adresse-1;
            JGZ:if ax>0 then ip:=progMem[ip].adresse-1;
            JGE:if ax>=0 then ip:=progMem[ip].adresse-1;
            INP:begin
                  setWindow(MONITOR);
                  gotoxy(1,monitorSpalte);
                  write('$',progMem[ip].adresse,':=');
                  readln(I);
                  val(i,dataMem[progMem[ip].adresse],j);
                  dataMem[progMem[ip].adresse]:=dataMem[progMem[ip].adresse] mod 255;
                  monitorSpalte:=whereY;
                end;
            OUT:begin
                  setWindow(MONITOR);
                  gotoxy(1,monitorSpalte);
                  write('"',datamem[progMem[ip].adresse],'"');
                  monitorSpalte:=whereY;
                end;
          end;
          inc(ip);
          datamem[0]:=ax;
          mouseHide;
          showAll;
          mouseShow;
          mousestatus;
        end;
    'L':begin
          setWindow(MONITOR);
          gotoxy(1,monitorSpalte);
          write('Lade:');
          readln(fileName);
          laden(fileName,progMem,l);
          ip:=1;
          monitorSpalte:=whereY;
          mouseHide;
          showAll;
          mouseShow;
          mousestatus;
        end;
    'N':begin
          for j:=0 to 255 do datamem[j]:=0;
          ip:=1;
          mouseHide;
          showAll;
          mouseShow;
          mousestatus;
        end;
  end;
end;
procedure run;
var key:char;
begin
  ip:=1;
  monitorSpalte:=1;
  key:=#0;
  mouseInit;
  showAll;
  mouseShow;
  mousestatus;
  while (key<>#27) do
   begin
     key:=#0;
     if keypressed then key:=upcase(readkey);
     getMouseStatus;
     if button=1 then begin
       mousehide;
       if mousebackground=link then begin
         mouseshow;
         mousestatus;
         getmousestatus;
         mouseinhelp;
         delay(500);
       end
       else begin
         mouseshow;
         mousestatus;
         getmousestatus;
         if mousein(cFrames[HOTKEYS].x shl 3,cFrames[HOTKEYS].y shl 3,
               (cFrames[HOTKEYS].x+cFrames[HOTKEYS].l-2) shl 3,
               (cFrames[HOTKEYS].y+cFrames[HOTKEYS].h-1) shl 3) then
           case ((mouseY shr 3)-cFrames[HOTKEYS].y) of
             0:key:=#13;
             1:key:='L';
             2:key:='N';
             3:key:=#27;
           end;
       end;
     end;
     interpreter(key);
  end;
end;
BEGIN
  openhelpfile;
  laden('prog.dat',progMem,l);
  showDesktop;
  run;
  closehelpfile;
END.

ZURÜCK

| HOME | NEWS | AWARDS | ABOUT ME | TEXTE | REFERATE | PROJEKTE |
|
MUSIK | CHAT | SPECIAL | LINKS |