home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 12 / dc / dc4.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-03-30  |  36.9 KB  |  933 lines
  1. {$A+,B-,D-,E-,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
  2. {$M 16384,0,655360}
  3. (* ----------------------------------------------------------------------- *)
  4. (*                                 DC.PAS                                  *)
  5. (*         Simulation eines einfachen didaktischen Computers "DC"          *)
  6. (* Autor: Zbigniew Szkaradnik - Vers. 1.1 fuer DEC LSI-11  25-April-85     *)
  7. (*                            - Vers. 1.2 fuer JOYCE       10-Febr.-87     *)
  8. (*   Modifikation und Implementierung (Vers. 1.3) von Michael Ceol fuer    *)
  9. (* PC-/MS-DOS (Turbo Pascal), CP/M (Turbo Pascal), Atari ST (Pascal ST +)  *)
  10. (* Sept. 87. Kurzanleitung siehe Datei "DC.HLP".  Viel Spass....           *)
  11.  
  12. (*         10-Minuten-Konvertierung auf Turbo 4-7 jb /3'94                 *)
  13.  
  14. PROGRAM Didactic_Computer;
  15.  
  16. USES
  17.   DOS, Crt;
  18.  
  19. VAR
  20.  Regs: Registers;
  21.  
  22. CONST
  23.   none         = -1;  null      = 0;      addr_start = 5;   op_start  = 1;
  24.   addr_end     = 10;  op_end    = 4;      mnem_size  = 3;   word_size = 10;
  25.   max_length   = 30;  mem_size  = 63;     winymin    = 18;  winymax   = 24;
  26.   instructions = 15;  screen_lines = 25;  sign_val   = 512; sign_bit  = 1;
  27.   zero = '0000000000';
  28.  
  29. TYPE
  30.   dc_word  = STRING[word_size];    op_str   = STRING[op_end];
  31.   mnem_str = STRING[mnem_size];    one_line = STRING[80];
  32.   lines    = STRING[max_length];   string2  = STRING[2];
  33.   errors   = (illcmd, illadd, illlab, illcod, illarg, illcon,
  34.               loops, ovf, illfil, illhlp, break);
  35.   mem_area = ARRAY [0..mem_size] OF dc_word;
  36.  
  37. VAR
  38.   end_of_program, out_cycle: BOOLEAN;  inp_file: TEXT;  esc: CHAR;
  39.   command : (cl, instr, regr, step, run, go, tim, bpt, Int, ldf,
  40.              other, hlp, view, ends);
  41.   mode    : (waiting, nowait, delaying);
  42.   err     : errors;   memory : mem_area;   Line : lines;
  43.   item    : ARRAY[1..3] OF lines;
  44.   window  : ARRAY[winymin..winymax] OF lines;
  45.   mnems   : ARRAY[0..instructions] OF mnem_str;
  46.   op_codes: ARRAY[0..instructions] OF op_str;
  47.   ar, pc, ac, dr, ir, sp: dc_word;
  48.   address, counter, int_addr, break_addr, s_ptr,
  49.   time, blink_num, blink_time, row, items, mempage, op_code: INTEGER;
  50.   ve, he, ce, dle, dre, ule, ure, uhe, dhe, rve, lve, se, vd, led_on, dpc,
  51.   led_off, wr, rd, sp2, ipc, pl, mi, sp1, u_arrow, d_arrow, bar, sl: string2;
  52.  
  53. PROCEDURE RevOn;                   (* reverse (inverse) Textdarstellung an *)
  54. BEGIN
  55.   TextColor(Black);
  56.   TextBackGround(White);
  57. END;
  58.  
  59. PROCEDURE RevOff;                 (* reverse (inverse) Textdarsetllung aus *)
  60. BEGIN
  61.   TextColor(White);
  62.   TextBackGround(Black);
  63. END;
  64.  
  65. PROCEDURE CrsOn;                                     (* Cursor einschalten *)
  66. BEGIN
  67.   Regs.AX := $100;
  68.   Regs.CX := 1543;
  69.   Intr($10,Regs);
  70. END;
  71.  
  72. PROCEDURE CrsOff;                                    (* Cursor ausschalten *)
  73. BEGIN
  74.   Regs.AX := $100;
  75.   Regs.CX := 128 SHL 8;
  76.   Intr($10,Regs);
  77. END;
  78.  
  79. PROCEDURE Bell;                           (* einen Piepser ertoenen lassen *)
  80. BEGIN
  81.   Write(Chr(7));
  82. END;
  83.  
  84. PROCEDURE Exit_DC;  (* alles wieder beim alten, wenn Programm beendet wird *)
  85. BEGIN
  86.   ClrScr;
  87.   GotoXY(1,1);
  88.   RevOff;
  89.   CrsOn;
  90. END;
  91.  
  92. (* eine Datei zum Lesen oeffnen. Die I/O-Ueberwachung durch das Laufzeit-  *)
  93. (* system wird dazu kurzzeitig deaktiviert (I- bzw. I+). Konnte die Datei  *)
  94. (* geoeffnet werden, ist "Open_File" = TRUE, sonst FALSE.                  *)
  95. FUNCTION Open_File (filename: lines): BOOLEAN;
  96. BEGIN
  97.   Assign(inp_file, filename);
  98. (*$I-*)
  99.   Reset(inp_file);
  100. (*$I+*)
  101.   Open_File := (IOResult = null);
  102. END;
  103.  
  104. PROCEDURE Init_Sys;
  105. (*  hier notfalls die entsprechenden ASCII-Codes Ihres Systems einsetzen:  *)
  106. BEGIN                                   (* Grafiksymbole, einfache Linien: *)
  107.   ve := Chr(179);   he := Chr(196);    (* senkrechter, waagerechter Strich *)
  108.   ce := Chr(197);                                                 (* Kreuz *)
  109.   dle := Chr(217);  dre := Chr(192);   (* rechte untere, linke untere Ecke *)
  110.   ule := Chr(191);  ure := Chr(218);   (* rechte obere, linke obere Ecke   *)
  111.   uhe := Chr(193);  dhe := Chr(194);   (* T-Stueck: nach oben, nach unten  *)
  112.   rve := Chr(195);  lve := Chr(180);   (* T-Stueck: nach rechts,nach links *)
  113.   vd := Chr(186);                      (* senkrechte, doppelte Linie       *)
  114.   bar := Chr(179);  sl := Chr(186);     (* senkr. Strich: einfach, doppelt *)
  115.   u_arrow := Chr(24);  d_arrow := Chr(25);  (* Pfeil nach oben, nach unten *)
  116.   led_on := Chr(2);    led_off := Chr(1);    (* voller Kreis, leerer Kreis *)
  117.   time := 1000;    (* Zeitverzoegerung bei Prog-Ausfuehrung im Delay-Modus *)
  118. END;
  119.  
  120. PROCEDURE To_Upper (VAR Str: lines);          (* String in Grossbuchstaben *)
  121. VAR  Aux: lines;  i: INTEGER;
  122. BEGIN
  123.   Aux := '';
  124.   FOR i := 1 TO Length(Str) DO  Aux := Concat(Aux, UpCase(Str[i]));
  125.   Str := Aux;
  126. END;
  127.  
  128. PROCEDURE Bin_to_Int (bin: dc_word; left,right: INTEGER; VAR value: INTEGER);
  129. VAR  i: INTEGER;
  130. BEGIN
  131.   value := Ord(bin[left])-Ord('0');
  132.   FOR i := Succ(left) TO right DO value := 2*value + (Ord(bin[i])-Ord('0'));
  133. END;
  134.  
  135. PROCEDURE Int_to_Bin (value, left, rigth: INTEGER; VAR bin: dc_word);
  136. VAR  i: INTEGER;
  137. BEGIN
  138.   FOR i := rigth DOWNTO left DO BEGIN
  139.     IF (value MOD 2) = 0 THEN bin[i] := '0'  ELSE  bin[i] := '1';
  140.     value := value DIV 2;
  141.   END;
  142. END;
  143.  
  144. FUNCTION Legal (n: INTEGER): BOOLEAN;     (* Argument n im Adressbereich ? *)
  145. BEGIN
  146.   IF (n > -1) AND (n <= mem_size) THEN Legal := TRUE  ELSE  Legal := FALSE;
  147. END;
  148.  
  149. PROCEDURE Load_Int (i: INTEGER; VAR reg: dc_word);
  150. BEGIN
  151.  IF i < 0 THEN BEGIN
  152.      Int_to_Bin(i+sign_val,Succ(sign_bit),word_size,reg);
  153.      reg[sign_bit] := '1';
  154.    END
  155.  ELSE BEGIN
  156.    Int_to_Bin(i,Succ(sign_bit),word_size,reg); reg[sign_bit] := '0';
  157.  END;
  158. END;
  159.  
  160. FUNCTION is_Minus (VAR reg: dc_word): BOOLEAN;
  161. BEGIN  is_Minus := reg[sign_bit] = '1';  END;
  162.  
  163. PROCEDURE Increment (VAR value: INTEGER);
  164. BEGIN  value := Succ(value) MOD Succ(mem_size);  END;
  165.  
  166. PROCEDURE Decrement (VAR value: INTEGER);
  167. BEGIN  value := Pred(value);  IF value < 0 THEN value := mem_size;  END;
  168.  
  169. PROCEDURE Copy_Bits (VAR source, dest: dc_word; left, right: INTEGER);
  170. VAR  i: INTEGER;
  171. BEGIN  FOR i:= left TO right DO dest[i] := source[i];  END;
  172.  
  173. FUNCTION Int_Val (VAR reg: dc_word): INTEGER;
  174. VAR  value: INTEGER;
  175. BEGIN
  176.   Bin_to_Int(reg,Succ(sign_bit),word_size,value);
  177.   IF is_Minus(reg) THEN Int_Val := value - sign_val  ELSE  Int_Val := value;
  178. END;
  179.  
  180. PROCEDURE Error (error_type: errors);                     (* Fehleranzeige *)
  181. CONST
  182.   s1 = 'falsch';       s2 = 'es Argument';          s3 = 'e Adresse';
  183.   s4 = 'er Befehl';    s5 = 'e Konstante';          s6 = 'e Marke';
  184.   s7 = 'er Code';      s8 = 'Ueberlauf';            s9 = 'Endlos-Schleife';
  185.   s10= 'er Dateiname'; s11= 'Hilfe nicht gefunden'; s12= 'Programm gestoppt';
  186. BEGIN
  187.   GotoXY(2,25);  RevOn;  Write('Fehler: ');
  188.   CASE error_type OF
  189.     illcmd: Write(s1, s4);                      (* Illegal command         *)
  190.     illadd: Write(s1, s3);                      (* Illegal address         *)
  191.     illarg: Write(s1, s2);                      (* Illegal argument        *)
  192.     illlab: Write(s1, s6);                      (* Illegal label           *)
  193.     illcod: Write(s1, s7);                      (* Illegal code            *)
  194.     illcon: Write(s1, s5);                      (* Illegal constant        *)
  195.     illfil: Write(s1, s10);                     (* Illegal filename        *)
  196.     illhlp: Write(s11);                         (* Help not found          *)
  197.     break : Write(s12);                         (* User break              *)
  198.     loops : Write(s9);                          (* Looping                 *)
  199.     ovf   : Write(s8);                          (* Overflow                *)
  200.   END;
  201.   RevOff;
  202. END;
  203.  
  204. PROCEDURE Erase_Error;
  205. BEGIN  GotoXY(2,25);  RevOn;  Write(' ':31);  RevOff;  END;
  206. (* ----------------------------------------------------------------------- *)
  207. PROCEDURE Disassemble (VAR reg : dc_word;       (* Code und Argument eines *)
  208.                        VAR mnem: mnem_str;      (* Maschinenbefehls wieder *)
  209.                        VAR arg : INTEGER);      (* zurueck uebersetzen     *)
  210. BEGIN
  211.   Bin_to_Int(reg,op_start,op_end,arg);  mnem := mnems[arg];
  212.   Bin_to_Int(reg,addr_start,addr_end,arg);
  213. END;
  214. (* ----------------------------------------------------------------------- *)
  215. PROCEDURE Print_Register (x, y: INTEGER; VAR reg: dc_word);
  216. BEGIN  GotoXY(x,y);  Write(reg);  END;
  217.  
  218. PROCEDURE Out_Cell (adr: INTEGER);
  219. VAR arg, y: INTEGER;  mnem: mnem_str;
  220. BEGIN
  221.   Disassemble(memory[adr],mnem,arg);  y := (adr MOD 25) + 1;
  222.   GotoXY(59,y);  Write(adr:2,mnem:4,arg:3);
  223.   GotoXY(69,y);  Write(memory[adr],' ');
  224. END;
  225.  
  226. PROCEDURE Print_MemPage (adr: INTEGER);
  227. VAR i, from_cell, to_cell, arg, y: INTEGER;
  228. BEGIN
  229.   i := adr DIV screen_lines;  RevOn;
  230.   IF i <> mempage THEN BEGIN
  231.     mempage := i;  y := 0;
  232.     from_cell := i*screen_lines;  to_cell := from_cell+Pred(screen_lines);
  233.     IF to_cell > mem_size THEN to_cell := mem_size;
  234.     FOR i := from_cell TO to_cell DO BEGIN Out_Cell(i); y := Succ(y); END;
  235.     WHILE y < screen_lines DO BEGIN
  236.       y := Succ(y);
  237.       GotoXY(59,y); Write(' ':9); GotoXY(69,y); Write(' ':Succ(word_size));
  238.     END;
  239.   END;
  240.   RevOff;
  241. END;
  242.  
  243. PROCEDURE Print_Cell (i: INTEGER);  (* Inhalt einer Speicherzelle anzeigen *)
  244. BEGIN
  245.  IF (i DIV screen_lines)=mempage THEN BEGIN RevOn; Out_Cell(i); RevOff; END;
  246. END;
  247.  
  248. PROCEDURE Invert_Cell (i: INTEGER);
  249. BEGIN  Print_MemPage(i);  RevOff;  Out_Cell(i);  END;
  250.  
  251. PROCEDURE Print_Cycle (Str: lines);           (* Maschinen-Zyklus anzeigen *)
  252. BEGIN
  253.   IF out_cycle THEN BEGIN  RevOn;  GotoXY(6,25);  Write(Str);  RevOff;  END;
  254. END;
  255. (* ----------------------------------------------------------------------- *)
  256. PROCEDURE WriteCh (ch: string2; n: INTEGER);  (* "n" Zeichen  ausgeben *)
  257. VAR  i: INTEGER;
  258. BEGIN  FOR i := 1 TO n DO Write(ch);  END;
  259.  
  260. PROCEDURE Scroll_Up;                            (* Dialog-Fenster scrollen *)
  261. VAR  i: INTEGER;
  262. BEGIN
  263.   FOR i := winymin TO winymax-1 DO BEGIN
  264.     window[i] := window[i+1];  GotoXY(3,i);  Write(window[i]);
  265.   END;
  266.   GotoXY(3,winymax);  WriteCh(' ',max_length);  GotoXY(3,winymax);
  267. END;
  268.  
  269. PROCEDURE W_Write (VAR Str: lines);       (* In's Dialog-Fenster schreiben *)
  270. BEGIN
  271.   window[row] := Str;  row := row + 1;  GotoXY(1,row);
  272.   IF row = winymax+1 THEN BEGIN  row := winymax;  Scroll_Up;  END;
  273. END;
  274. (* ----------------------------------------------------------------------- *)
  275. PROCEDURE LED (ch: CHAR);     (* Die LEDs zur Anzeige von Registerinhalten *)
  276. BEGIN  CASE ch OF '0': Write(led_off); '1': Write(led_on);  END;  END;
  277.                            (* ein Registerinhalt mit obigen LEDs anzeigen: *)
  278. PROCEDURE Display (VAR register: dc_word; x, y, left, right: INTEGER);
  279. VAR  i: INTEGER;
  280. BEGIN
  281.   IF out_cycle THEN
  282.     BEGIN  GotoXY(x,y);  FOR i := left TO right DO LED(register[i]);  END;
  283. END;
  284.  
  285. PROCEDURE Display_AC;                                   (* der Akkumulator *)
  286. BEGIN Display(ac,23,4,sign_bit,1); Display(ac,25,4,sign_bit+1,word_size);END;
  287.  
  288. PROCEDURE Display_PC;                               (* der Programmzaehler *)
  289. BEGIN  Display(pc,8,4,addr_start,addr_end);  END;
  290.  
  291. PROCEDURE Display_AR;                                (* das Adressregister *)
  292. BEGIN  Display(ar,48,4,addr_start,addr_end);  END;
  293.  
  294. PROCEDURE Display_DR;                                 (* das Datenregister *)
  295. BEGIN  Display(dr,44,12,sign_bit,word_size);  END;
  296.  
  297. PROCEDURE Display_IR;                               (* das Befehlsregister *)
  298. BEGIN
  299.   Display(ir,4,13,op_start,op_end);  Display(ir,9,13,addr_start,addr_end);
  300. END;
  301.  
  302. PROCEDURE Display_SP;                                 (* der Stack-Pointer *)
  303. BEGIN  Display(sp,4,7,addr_start,addr_end);  END;
  304.  
  305. PROCEDURE Print_Registers; (* und jetzt alle zusammen neben Dialog-Fenster *)
  306. BEGIN
  307.   Print_Register(37,18,ac);  Print_Register(37,19,dr);
  308.   Print_Register(37,20,ar);  Print_Register(37,21,ir);
  309.   Print_Register(37,22,pc);  Print_Register(37,23,sp);
  310. END;
  311.  
  312. PROCEDURE Display_Status;                                        (* logo ? *)
  313. BEGIN
  314.  out_cycle := TRUE; Print_Registers; Display_AR; Display_PC; Display_AC;
  315.  Display_DR; Display_IR; Display_SP;
  316. END;
  317. (* ----------------------------------------------------------------------- *)
  318. PROCEDURE Interrupt;                        (* Anzeige einer Unterbrechung *)
  319. VAR  ia: dc_word;  err: INTEGER;
  320. BEGIN
  321.   IF items = 1 THEN BEGIN
  322.       int_addr := none; GotoXY(41,25); RevOn; Write('none'); RevOff;
  323.       GotoXY(38,4); WriteCh('-',Succ(addr_end-addr_start));
  324.     END
  325.   ELSE BEGIN
  326.       Val(item[2],int_addr,err);
  327.       IF (err = null) AND Legal(int_addr) THEN BEGIN
  328.           GotoXY(41,25);  RevOn;  Write(int_addr:4);  RevOff;
  329.           Int_to_Bin(int_addr,addr_start,addr_end,ia);
  330.           Display(ia,38,4,addr_start,addr_end);
  331.         END
  332.       ELSE  Error(illadd);                             (* Illegall address *)
  333.     END;
  334. END;
  335. (* ----------------------------------------------------------------------- *)
  336. PROCEDURE Breakpoint;                        (* Anzeige eines Haltepunktes *)
  337. VAR  err: INTEGER;
  338. BEGIN
  339.   IF items = 1 THEN BEGIN
  340.       break_addr := none;  GotoXY(41,24);  RevOn;  Write('none');  RevOff;
  341.     END
  342.   ELSE BEGIN
  343.       Val(item[2],break_addr,err);
  344.       IF (err = null) AND Legal(break_addr) THEN BEGIN
  345.           GotoXY(41,24);  RevOn;  Write(break_addr:4);  RevOff;
  346.         END
  347.       ELSE  Error(illadd);                             (* Illegall address *)
  348.     END;
  349. END;
  350. (* ----------------------------------------------------------------------- *)
  351. PROCEDURE Wait;         (* bei der Ausfuehrung eines Progs. entspr. warten *)
  352. VAR ch: CHAR;
  353. BEGIN
  354.   CASE mode OF
  355.     waiting : IF command = step THEN BEGIN
  356.                 GotoXY(2,25);  RevOn;  Write('Druecke eine Taste');  RevOff;
  357.                 Bell;  REPEAT UNTIL KeyPressed;  ch := ReadKey;
  358.               END;
  359.     nowait  : ;
  360.     delaying: Delay(time);
  361.   END;
  362.   IF out_cycle THEN Erase_Error;
  363. END;
  364. (* ----------------------------------------------------------------------- *)
  365. (*      Anzeigen der verschiedenen Steuersignale bei der Ausfuehrung:      *)
  366. PROCEDURE Gate (VAR s: string2; x,y : INTEGER; blink: BOOLEAN);
  367. VAR i: INTEGER;
  368. BEGIN
  369.   IF blink THEN
  370.     FOR i := 1 TO blink_num DO BEGIN
  371.       GotoXY(x,y);  Write(s);  Delay(blink_time);  RevOn;
  372.       GotoXY(x,y);  Write(s);  Delay(blink_time);  RevOff;
  373.     END
  374.   ELSE BEGIN  RevOff; GotoXY(x,y); Write(s);  END;
  375. END;
  376. (* ----------------------------------------------------------------------- *)
  377. PROCEDURE Print_Computer;                   (* Bild des Computers zeichnen *)
  378. VAR  i: INTEGER;  s: CHAR;
  379. BEGIN
  380.   s := ' ';  GotoXY(1,1);
  381.   Write('AB',he,dhe); WriteCh(he,6); Write(dhe); WriteCh(he,5); Write(dhe);
  382.   WriteCh(he,23); Write(dhe); WriteCh(he,9); Write(dhe); WriteCh(he,4);
  383.   WriteLn(ule);
  384.   WriteCh(s,3); Write(sl); WriteCh(s,6); Write(sl); WriteCh(s,5);
  385.   Write(sl,s,ure); WriteCh(he,8);  Write(ule);  WriteCh(s,12); Write(sl);
  386.   WriteCh(s,9); Write(sl); WriteCh(s,4); WriteLn(sl);
  387.   WriteCh(s,3); Write(ve); WriteCh(s,2); Write(ure,he,he,he,uhe,he,he,ule);
  388.   WriteCh(s,2); Write(ve,s,ve); WriteCh(s,2); Write(ure); WriteCh(he,5);
  389.   Write(uhe); WriteCh(he,5); Write(ule); WriteCh(s,2);
  390.   Write(ure,he,he,he,uhe,he,he,ule); WriteCh(s,2);
  391.   WriteLn(ure,he,he,he,uhe,he,he,ule,s,ve);
  392.   WriteCh(s,3); Write(ve,'PC',ve); WriteCh(s,6); Write(rve); WriteCh(s,2);
  393.   Write(ve,s,ve,'AC',ve); WriteCh(s,11); Write(ve,'IA',ve); WriteCh(s,6);
  394.   Write(ve,'AR',ve); WriteCh(s,6); WriteLn(ve,s,ve);
  395.   WriteCh(s,3); Write(ve); WriteCh(s,2); Write(dre); WriteCh(he,6);
  396.   Write(dle); WriteCh(s,2); Write(ve,s,ve); WriteCh(s,2); Write(dre);
  397.   WriteCh(he,5); Write(dhe); WriteCh(he,5); Write(dle); WriteCh(s,2);
  398.   Write(rve); WriteCh(he,6); Write(lve); WriteCh(s,2);
  399.   WriteLn(dre,he,he,he,dhe,he,he,dle,s,ve);
  400.   Write(sp2,ure,uhe); WriteCh(he,5); Write(ule); WriteCh(s,6);
  401.   Write(ve,s,ve); WriteCh(s,8); Write(sl); WriteCh(s,8);
  402.   Write(ve,' INT  ',ve,ure); WriteCh(he,5); WriteLn(uhe,he,he,ule,s,ve);
  403.   Write('SP',ve); WriteCh(s,6); Write(rve); WriteCh(s,6); Write(ve,s,ve);
  404.   WriteCh(s,5); Write(ure,he,he,uhe,he,he,ule); WriteCh(s,5); Write(dre);
  405.   WriteCh(he,6); Write(dle,ve); WriteCh(s,8); WriteLn(ve,s,ve);
  406.   Write(sp2,dre); WriteCh(he,6); Write(dle); WriteCh(s,6); Write(ve,s,ve);
  407.   WriteCh(s,5); Write(ve); WriteCh(s,5); Write(ve); WriteCh(s,13);
  408.   WriteLn(ve,' MEMORY ',ve,s,ve);
  409.   Write(ure); WriteCh(he,9); Write(ule); WriteCh(s,5); Write(ve,s,ve,s,s);
  410.   Write(ure,he,he,dle); WriteCh(s,5); Write(dre,he,he,ule); WriteCh(s,10);
  411.   Write(lve); WriteCh(s,8); WriteLn(ve,s,ve);
  412.   Write(ve,' CONTROL ',ve); WriteCh(s,5); Write(ve,s,ve,s,s,ve);
  413.   WriteCh(s,4); Write('ALU'); WriteCh(s,4); Write(ve); WriteCh(s,10);
  414.   Write(dre); WriteCh(he,5); WriteLn(dhe,he,he,dle,s,ve);
  415.   Write(dre,he,ule); WriteCh(s,4); Write(ure,he,he,dle,ure);
  416.   WriteCh(he,4); Write(dle,s,ve,s,s,ve); WriteCh(s,4); Write(ure,he,ule);
  417.   WriteCh(s,4); Write(ve); WriteCh(s,8); Write(ure); WriteCh(he,7);
  418.   WriteLn(uhe,he,he,ule,s,ve);
  419.   WriteCh(s,2); Write(rve); WriteCh(s,4); Write(ce); WriteCh(he,3);
  420.   Write(uhe,he,he,ule,s,s,s,ve,s,s,ve); WriteCh(s,4); Write(ve,s,ve);
  421.   WriteCh(s,4); Write(ve); WriteCh(s,6); Write('DR',ve); WriteCh(s,10);
  422.   WriteLn(ve,s,ve);
  423.   Write('IR',ve); WriteCh(s,11); Write(ve,s,s,s,ve,s,s);
  424.   Write(dre,he,dhe,he,he,dle,s,dre,he,he,dhe,he,dle);
  425.   WriteCh(s,8); Write(dre); WriteCh(he,5); Write(dhe); WriteCh(he,4);
  426.   WriteLn(dle,s,ve);
  427.   WriteCh(s,2); Write(dre); WriteCh(he,4); Write(ce); WriteCh(he,6);
  428.   Write(dle,s,s,s,rve); WriteCh(he,4); Write(dle); WriteCh(s,7); Write(ve);
  429.   WriteCh(s,16); Write(ve); WriteCh(s,6); WriteLn(ve);
  430.   WriteCh(s,7);  Write(sl);  WriteCh(s,10);  Write(sl);
  431.   WriteCh(s,12); Write(sl);  WriteCh(s,16); Write(sl);
  432.   WriteCh(s,6);  WriteLn(ve);
  433.   Write('DB'); WriteCh(he,5); Write(uhe); WriteCh(he,10); Write(uhe);
  434.   WriteCh(he,12);Write(uhe); WriteCh(he,16);Write(uhe);
  435.   WriteCh(he,6); WriteLn(dle);
  436. END;
  437. (* ----------------------------------------------------------------------- *)
  438. PROCEDURE Print_Display;                         (* das Drumherum zeichnen *)
  439. VAR  i: INTEGER;
  440. BEGIN
  441.   FOR i := 1 TO 25 DO
  442.     BEGIN GotoXY(58,i); Write(vd); GotoXY(68,i); Write(vd);  END;
  443.   GotoXY(1,winymin-1);
  444.   RevOn;  Write('  DC v1.3 (c) 1987  PASCAL INT.  ');
  445.   Write('  Register:      Mnem:  ');  RevOff;
  446.   FOR i := winymin-1 TO winymax+1 DO
  447.     BEGIN  GotoXY(33,i); Write(vd);  GotoXY(47,i);  Write(vd);  END;
  448.   GotoXY(34,24); RevOn; Write('  Bpt: none  ');
  449.   GotoXY(34,25);        Write('  Int: none  ');
  450.   GotoXY(1,25);  Write(' ':32);
  451.   GotoXY(48,18); Write(' LDA  ??? ');  GotoXY(48,19); Write(' STA  ??? ');
  452.   GotoXY(48,20); Write(' ADD  ??? ');  GotoXY(48,21); Write(' SUB  ??? ');
  453.   GotoXY(48,22); Write(' JMP  ??? ');  GotoXY(48,23); Write(' JMS  ??? ');
  454.   GotoXY(48,24); Write(' JSR  ??? ');  GotoXY(48,25); Write(' RTN  DEF ');
  455.   RevOff;  GotoXY(34,18); Write('AC');  GotoXY(34,19);  Write('DR');
  456.   GotoXY(34,20); Write('AR');  GotoXY(34,21); Write('IR');
  457.   GotoXY(34,22); Write('PC');  GotoXY(34,23); Write('SP');
  458. END;
  459.  
  460. PROCEDURE Read_Cycle;                                   (* der Lese-Zyklus *)
  461. BEGIN
  462.   Print_Cycle('MEMORY -> DR');  Gate(rd,43,9,TRUE);    Display_DR;
  463.   Wait;                         Gate(sp2,43,9,FALSE);
  464. END;
  465.  
  466. PROCEDURE Write_Cycle;                               (* der Schreib-Zyklus *)
  467. BEGIN
  468.   Print_Cycle('DR -> MEMORY');         Gate(wr,43,9,TRUE);
  469.   Print_Cell(address);          Wait;  Gate(sp2,43,9,FALSE);
  470. END;
  471.  
  472. PROCEDURE Inc_PC;                              (* Programmzaehler erhoehen *)
  473. BEGIN
  474.   Print_Cycle('PC+1 -> PC');  Gate(ipc,15,4,TRUE);  Display_PC;
  475.   Wait;                       Gate(sp2,15,4,FALSE);
  476. END;
  477.  
  478. PROCEDURE Transfer_IA_AR;        (* Interrupt-Adresse in's Adress-Register *)
  479. BEGIN
  480.   Print_Cycle('IA -> AR');  Gate(bar,41,2,TRUE);  Gate(d_arrow,51,2,TRUE);
  481.   Display_AR;  Wait;        Gate(sl,41,2,FALSE);  Gate(sl,51,2,FALSE);
  482. END;
  483.  
  484. PROCEDURE Transfer_IA_PC;      (* Interrupt-Adresse in den Programmzaehler *)
  485. BEGIN
  486.   Print_Cycle('IA -> PC');  Gate(bar,41,2,TRUE);  Gate(d_arrow,11,2,TRUE);
  487.   Display_PC;  Wait;        Gate(sl,41,2,FALSE);  Gate(sl,11,2,FALSE);
  488. END;
  489.  
  490. PROCEDURE Transfer_PC_AR;          (* Programmzaehler in's Adress-Register *)
  491. BEGIN
  492.   Print_Cycle('PC -> AR');  Gate(bar,11,2,TRUE);  Gate(d_arrow,51,2,TRUE);
  493.   Display_AR;  Wait;        Gate(sl,11,2,FALSE);  Gate(sl,51,2,FALSE);
  494. END;
  495.  
  496. PROCEDURE Transfer_DR_IR;           (* Daten-Register in's Befehlsregister *)
  497. BEGIN
  498.   Print_Cycle('DR -> IR');  Gate(bar,49,15,TRUE);  Gate(u_arrow,8,15,TRUE);
  499.   Display_IR;  Wait;        Gate(sl,49,15,FALSE);  Gate(sl,8,15,FALSE);
  500. END;
  501.  
  502. PROCEDURE Transfer_AC_DR;                       (* Akku in's Datenregister *)
  503. BEGIN
  504.   Print_Cycle('AC -> DR');  Gate(bar,19,15,TRUE);  Gate(u_arrow,49,15,TRUE);
  505.   Display_DR;  Wait;        Gate(sl,19,15,FALSE);  Gate(sl,49,15,FALSE);
  506. END;
  507.  
  508. PROCEDURE Transfer_AD_PC; (* Adressteil des Befehls in den Programmzaehler *)
  509. BEGIN
  510.   Print_Cycle('XXX -> PC'); Gate(bar,17,2,TRUE);   Gate(d_arrow,11,2,TRUE);
  511.   Display_PC;  Wait;        Gate(sl,17,2,FALSE);   Gate(sl,11,2,FALSE);
  512. END;
  513.  
  514. PROCEDURE Transfer_AD_AR;   (* Adressteil des Befehls in's Adress-Register *)
  515. BEGIN
  516.   Print_Cycle('XXX -> AR'); Gate(bar,17,2,TRUE);   Gate(d_arrow,51,2,TRUE);
  517.   Display_AR;  Wait;        Gate(sl,17,2,FALSE);   Gate(sl,51,2,FALSE);
  518. END;
  519.  
  520. PROCEDURE Transfer_DR_ALU;     (* Daten-Register ueber die ALU in den Akku *)
  521. BEGIN
  522.   Print_Cycle('DR -> AC');  Gate(bar,49,15,TRUE);  Gate(bar,32,15,TRUE);
  523.   Gate(u_arrow,28,6,TRUE);  Display_AC;            Wait;
  524.   Gate(sl,49,15,FALSE);     Gate(sl,32,15,FALSE);  Gate(sl,28,6,FALSE);
  525. END;
  526.  
  527. PROCEDURE Transfer_DR_PC;         (* Daten-Register in den Programmzaehler *)
  528. BEGIN
  529.   Print_Cycle('DR -> PC');  Gate(bar,49,15,TRUE);  Gate(bar,56,2,TRUE);
  530.   Gate(d_arrow,11,2,TRUE);  Display_PC;            Wait;
  531.   Gate(sl,49,15,FALSE);     Gate(sl,56,2,FALSE);   Gate(sl,11,2,FALSE);
  532. END;
  533.  
  534. PROCEDURE Transfer_PC_DR;           (* Programmzaehler in's Daten-Register *)
  535. BEGIN
  536.   Print_Cycle('PC -> DR');  Gate(bar,11,2,TRUE);   Gate(bar,56,2,TRUE);
  537.   Gate(u_arrow,49,15,TRUE); Display_DR;            Wait;
  538.   Gate(sl,11,2,FALSE);      Gate(sl,56,2,FALSE);   Gate(sl,49,15,FALSE);
  539. END;
  540.  
  541. PROCEDURE Transfer_SP_AR;             (* Stackpointer in's Adress-Register *)
  542. BEGIN
  543.   Print_Cycle('SP -> AR');  Gate(bar,4,2,TRUE);    Gate(d_arrow,51,2,TRUE);
  544.   Display_AR;  Wait;        Gate(sl,4,2,FALSE);    Gate(sl,51,2,FALSE);
  545. END;
  546.  
  547. PROCEDURE Inc_SP;                                 (* Stackpointer erhoehen *)
  548. BEGIN
  549.   Print_Cycle('SP+1 -> SP');  Gate(ipc,11,7,TRUE);   Display_SP;
  550.   Wait;                       Gate(sp2,11,7,FALSE);
  551. END;
  552.  
  553. PROCEDURE Dec_SP;
  554. BEGIN
  555.   Print_Cycle('SP-1 -> SP');  Gate(dpc,11,7,TRUE);   Display_SP;
  556.   Wait;                       Gate(sp2,11,7,FALSE);
  557. END;
  558.  
  559. PROCEDURE Stop;     (* nach Programmende bei "RUN" und "GO" alles anzeigen *)
  560. BEGIN
  561.   IF command <> step THEN BEGIN Print_MemPage(counter); display_status;  END;
  562.   end_of_program := TRUE;
  563. END;
  564.  
  565. PROCEDURE End_Condition;                  (* Programm in Endlos-Schleife ? *)
  566. BEGIN
  567.   IF (ar = pc) AND ((command = run) OR (command = go)) THEN
  568.     BEGIN  Stop;  error(loops);  END;
  569. END;
  570. (* ----------------------------------------------------------------------- *)
  571. PROCEDURE Load_Accu (value: INTEGER);
  572. BEGIN
  573.   IF (value > (-1 * Succ(sign_val))) AND (value < sign_val) THEN
  574.     BEGIN  Load_Int(value,ac);  Transfer_DR_ALU;  END
  575.   ELSE  BEGIN  Stop;  error(ovf);  END;                        (* Overflow *)
  576. END;
  577. (* ----------------------------------------------------------------------- *)
  578. PROCEDURE Memory_Cycle;
  579. BEGIN  Copy_Bits(ir,ar,addr_start,addr_end);  Transfer_AD_AR;  END;
  580.  
  581. PROCEDURE Memory_Read;
  582. BEGIN  Memory_Cycle;  dr := memory[address];  Read_Cycle;  END;
  583.  
  584. PROCEDURE Memory_Write;
  585. BEGIN  Memory_Cycle;  memory[address] := dr;  Write_Cycle;  END;
  586.  
  587. PROCEDURE Memory_Push;
  588. BEGIN
  589.   ar := sp;  Transfer_SP_AR;  memory[s_ptr] := dr;  Write_Cycle;
  590.   decrement(s_ptr); Int_to_Bin(s_ptr,addr_start,addr_end,sp);  Dec_SP;
  591. END;
  592.  
  593. PROCEDURE Memory_Pop;
  594. BEGIN
  595.   increment(s_ptr);  Int_to_Bin(s_ptr,addr_start,addr_end,sp);  Inc_SP;
  596.   ar := sp;  Transfer_SP_AR;  dr := memory[s_ptr];  Read_Cycle;
  597. END;
  598. (* ----------------------------------------------------------------------- *)
  599. PROCEDURE Load;
  600. BEGIN  Memory_Read;  ac := dr;  Transfer_DR_ALU;  END;
  601.  
  602. PROCEDURE Store;
  603. BEGIN  dr := ac;  Transfer_AC_DR;  Memory_Write;  END;
  604. (* ----------------------------------------------------------------------- *)
  605. PROCEDURE Add;
  606. BEGIN
  607.  Memory_Read;                         Gate(pl,28,12,TRUE);
  608.  Load_Accu(Int_Val(ac)+Int_Val(dr));  Gate(sp1,28,12,FALSE);
  609. END;
  610.  
  611. PROCEDURE Subtract;
  612. BEGIN
  613.   Memory_Read;                         Gate(mi,28,12,TRUE);
  614.   Load_Accu(Int_Val(ac)-Int_Val(dr));  Gate(sp1,28,12,FALSE);
  615. END;
  616. (* ----------------------------------------------------------------------- *)
  617. PROCEDURE Jump;
  618. BEGIN
  619.   Copy_Bits(ir,pc,addr_start,addr_end); Transfer_AD_PC;
  620.   counter := address;  End_Condition;
  621. END;
  622.  
  623. PROCEDURE Jump_if_Minus;
  624. BEGIN  IF is_Minus(ac) THEN  Jump;  END;
  625.  
  626. PROCEDURE Jump_to_Subroutine;
  627. BEGIN
  628.   dr := pc;  Transfer_PC_DR;  Memory_Push;
  629.   Copy_Bits(ir,pc,addr_start,addr_end);  Transfer_AD_PC;
  630.   Int_to_Bin(address,addr_start,addr_end,pc);  counter := address;
  631. END;
  632.  
  633. PROCEDURE Return;
  634. BEGIN
  635.   Memory_Pop; pc := dr; Transfer_DR_PC;
  636.   Bin_to_Int(pc,addr_start,addr_end,counter);  End_Condition;
  637. END;
  638. (* ----------------------------------------------------------------------- *)
  639. PROCEDURE Fetch_Instruction;
  640. BEGIN
  641.   ar := pc;  Transfer_PC_AR;  Bin_to_Int(ar,addr_start,addr_end,address);
  642.   dr := memory[address];  Read_Cycle;  increment(counter);
  643.   Int_to_Bin(counter,addr_start,addr_end,pc);  Inc_PC;
  644.   ir := dr;  Transfer_DR_IR;  Bin_to_Int(ir,op_start,op_end,op_code);
  645.   Bin_to_Int(ir,addr_start,addr_end,address);
  646. END;
  647. (* ----------------------------------------------------------------------- *)
  648. PROCEDURE do_Interrupt;                        (* Unterbrechung ausfuehren *)
  649. BEGIN
  650.   dr := pc;  Transfer_PC_DR;  Memory_Push;  counter := int_addr;
  651.   Int_to_Bin(int_addr,addr_start,addr_end,pc);  Transfer_IA_PC;
  652. END;
  653.  
  654. PROCEDURE check_Interrupt;                  (* Unterbrechung aufgetreten ? *)
  655. VAR  ch: CHAR;
  656. BEGIN
  657.   IF Legal(int_addr) THEN
  658.     IF KeyPressed AND ((command = run) OR (command = go)) THEN BEGIN
  659.         GotoXY(2,25);  RevOn;  Write(' Interrupt wird ausgefuehrt ');
  660.         RevOff;  Bell;  Delay(2 * time);  ch := ReadKey;
  661.         Erase_Error;  do_Interrupt;
  662.         IF ch = esc THEN BEGIN  Stop;  error(break);  END;
  663.       END
  664.     ELSE IF command = step THEN BEGIN
  665.         GotoXY(2,25);  RevOn;  Write('<ESC>: Interrupt ausfuehren');  RevOff;
  666.         ch := ReadKey;  Erase_Error;
  667.         IF ch = esc THEN  do_Interrupt;
  668.       END;
  669. END;
  670. (* ----------------------------------------------------------------------- *)
  671. PROCEDURE check_Breakpoint;
  672. BEGIN
  673.   IF (counter = break_addr)
  674.   AND ((command = run) OR (command = go)) THEN BEGIN
  675.     Stop; GotoXY(2,25); RevOn; Write('Stop: Breakpoint erreicht'); RevOff;
  676.   END
  677. END;
  678. (* ----------------------------------------------------------------------- *)
  679. PROCEDURE Execute_Instruction;
  680. VAR old_pc: INTEGER;  ch: CHAR;
  681. BEGIN
  682.   end_of_program := FALSE;  old_pc := counter;  Invert_Cell(old_pc);
  683.   Fetch_Instruction;
  684.   CASE op_code OF
  685.      0: Load;                1: Store;                2: Add;
  686.      3: Subtract;            4: Jump;                 5: Jump_if_Minus;
  687.      6: Jump_to_Subroutine;  7: Return;
  688.   END;
  689.   IF out_cycle THEN Print_Registers;
  690.   check_Interrupt;  check_Breakpoint;
  691.   IF KeyPressed THEN
  692.     IF ReadKey = esc THEN BEGIN Stop; error(break); END;
  693.   print_cell(old_pc);
  694. END;
  695. (* ----------------------------------------------------------------------- *)
  696. PROCEDURE Execute_Program;
  697. BEGIN
  698.   blink_num := 0; blink_time := 0;  out_cycle := mode = delaying;
  699.   IF out_cycle THEN blink_num := 2;
  700.   REPEAT  Execute_Instruction;  UNTIL end_of_program;  END;
  701. (* ----------------------------------------------------------------------- *)
  702. PROCEDURE Go_From;
  703. VAR  err: INTEGER;
  704. BEGIN
  705.   Val(item[2],counter,err);
  706.   IF (err = null) AND Legal(counter) THEN
  707.     BEGIN  Int_to_Bin(counter,addr_start,addr_end,pc);  Execute_Program; END
  708.   ELSE  error(illadd);                                  (* Illegal address *)
  709. END;
  710. (* ----------------------------------------------------------------------- *)
  711. PROCEDURE Single_Step;
  712. BEGIN
  713.   blink_num := 2;  blink_time := time DIV 2;
  714.   out_cycle := TRUE;   Execute_Instruction;
  715. END;
  716. (* ----------------------------------------------------------------------- *)
  717. PROCEDURE Clear;                          (* Computer zuruecksetzen: RESET *)
  718. VAR  i: INTEGER;
  719. BEGIN
  720.   FOR i := 0 TO mem_size DO  memory[i] := zero;
  721.   ac := zero;  ar := zero;  pc := zero;  dr := zero;  ir := zero;
  722.   counter := 0;    address := 0;  s_ptr := mem_size;
  723.   Int_to_Bin(s_ptr,addr_start,addr_end,sp);
  724.   mempage := -1;   Print_MemPage(0);         out_cycle := TRUE;
  725.   display_status;  items := 1;  breakpoint;  interrupt;
  726. END;
  727.  
  728. (* ----------------------------------------------------------------------- *)
  729.  
  730. PROCEDURE Init;
  731. VAR i: INTEGER;  temp: dc_word;
  732. BEGIN
  733.   esc := Chr(27);  RevOff;  CrsOff;  ClrScr;  Init_Sys;
  734.   pl := '+';    mi  := '-';   sp1 := ' ';   sp2 := '  ';
  735.   ipc := '+1';  dpc := '-1';  rd  := 'rd';  wr  := 'wr';  mode := nowait;
  736.   mnems[0]  := 'LDA';  mnems[1]  := 'STA';  mnems[2]  := 'ADD';
  737.   mnems[3]  := 'SUB';  mnems[4]  := 'JMP';  mnems[5]  := 'JMS';
  738.   mnems[6]  := 'JSR';  mnems[7]  := 'RTN';
  739.   FOR i := 8 TO 15 DO mnems[i] := '???';
  740.   temp := zero;  sp := zero;
  741.   FOR i := 0 TO instructions DO BEGIN
  742.     Int_to_Bin(i,op_start,op_end,temp);
  743.     op_codes[i] := Copy(temp,op_start,op_end);
  744.   END;
  745.   Print_Display;  Print_Computer;  Clear;
  746.   GotoXY(2,25);  revon;  Write(' <H> fuer Information');  RevOff;
  747.   row := winymin;  GotoXY(1,row);
  748. END;
  749. (* ----------------------------------------------------------------------- *)
  750. PROCEDURE Load_Constant (address: INTEGER); (* Konstante in Speicher laden *)
  751. VAR  value, err: INTEGER;
  752. BEGIN
  753.   Val(item[3],value,err);
  754.   IF (err = null)
  755.   AND (value > (-1 * Succ(sign_val))) AND (value < sign_val) THEN BEGIN
  756.       Load_Int(value,memory[address]);  print_cell(address);
  757.     END
  758.   ELSE  Error(illcon);                                 (* Illegal constant *)
  759. END;
  760.  
  761. PROCEDURE Load_Instruction (address: INTEGER; op_code: op_str);
  762. VAR  arg, i: INTEGER;  Mem: dc_word;           (* Befehl in Speicher laden *)
  763. BEGIN
  764.   IF item[2] = 'RTN' THEN item[3] := '0';
  765.   Val(item[3],arg,i);  Mem := zero;
  766.   IF (i = null) AND Legal(arg) THEN BEGIN
  767.       Int_to_Bin(arg,addr_start,addr_end,Mem);
  768.       FOR i := op_start TO op_end DO Mem[i] := op_code[i];
  769.       memory[address] := Mem;  print_cell(address);
  770.     END
  771.   ELSE  Error(illarg);                                 (* Illegal argument *)
  772. END;
  773.  
  774. PROCEDURE Load_PC;
  775. VAR  temp: dc_word;  value, err: INTEGER;
  776. BEGIN
  777.   Val(item[2],value,err);  Int_to_Bin(value,1,word_size,temp);
  778.   IF (err = null) AND Legal(value) THEN
  779.     IF item[1] = 'PC' THEN BEGIN pc := temp; counter := value; END
  780.     ELSE Error(illcmd)
  781.   ELSE Error(illadd);                           (* Illegal binary argument *)
  782.   Display_Status;
  783. END;
  784. (* ----------------------------------------------------------------------- *)
  785. PROCEDURE Interpret_Instruction;    (* Befehl in Maschinencode uebersetzen *)
  786. VAR  i, address: INTEGER;
  787. BEGIN
  788.   Val(item[1],address,i);
  789.   IF (i = null) AND Legal(address) THEN BEGIN
  790.       i := -1;
  791.       REPEAT
  792.         i := Succ(i);
  793.       UNTIL (item[2] = mnems[i]) OR (i = instructions);
  794.       IF item[2] = mnems[i] THEN Load_Instruction(address,op_codes[i])
  795.       ELSE IF item[2] = 'DEF' THEN Load_Constant(address)
  796.       ELSE Error(illcod);                                  (* Illegal code *)
  797.     END
  798.   ELSE Error(illlab);                                     (* Illegal label *)
  799. END;
  800. (* ----------------------------------------------------------------------- *)
  801. PROCEDURE Read_Line;                            (* Kommando-Zeile einlesen *)
  802. VAR  st: lines;  i: INTEGER;
  803. BEGIN
  804.   Invert_Cell(counter);  CrsOn;  GotoXY(1,row);  Bell;
  805.   Write('> ');  ReadLn(Line);  st := Line;
  806.   FOR i := 1 TO max_length - Length(Line) DO st := Concat(st,' ');
  807.   CrsOff;  w_write(st);  Erase_Error;   print_cell(counter);
  808. END;
  809. (* ----------------------------------------------------------------------- *)
  810. PROCEDURE Separate_Tokens;         (* Bestandteile des Kommandos aufloesen *)
  811. VAR  i: INTEGER;
  812.  
  813.  FUNCTION empty (VAR st: lines): BOOLEAN;
  814.  VAR  i: INTEGER;  temp: BOOLEAN;
  815.  BEGIN
  816.    temp := FALSE;  i := 0;
  817.    REPEAT
  818.      i := Succ(i);
  819.      IF i <= Length(st) THEN  IF st[i] <> ' ' THEN  temp := TRUE;
  820.    UNTIL temp OR (i >= Length(st));
  821.    empty := NOT(temp);
  822.  END;
  823.  
  824. BEGIN
  825.   FOR i := 1 TO 3 DO  item[i] := '';
  826.   i := Pos(';',Line);
  827.   IF i > 0 THEN  Delete(Line,i,Length(Line)-i+1);   (* Kommentar entfernen *)
  828.   items := 0;
  829.   IF empty(Line) THEN Line := '';
  830.   IF Length(Line) > 0 THEN BEGIN
  831.     Line := Concat(Line,' ');
  832.     REPEAT
  833.       items := Succ(items);
  834.       WHILE Line[1] = ' ' DO  Delete(Line,1,1);
  835.       i := Pos(' ',Line);  item[items] := Copy(Line,1,Pred(i));
  836.       Delete(Line,1,Length(item[items]))
  837.     UNTIL (items = 3) OR empty(Line);
  838.   END;
  839. END;
  840. (* ----------------------------------------------------------------------- *)
  841. PROCEDURE Interpret_Line;                     (* Kommandozeile uebersetzen *)
  842. VAR  st: lines;  i, err: INTEGER;
  843. BEGIN
  844.   To_Upper(Line);   Separate_Tokens;   st := item[1];   command := other;
  845.   Val(item[1],i,err);
  846.   IF items = 0 THEN  command := step
  847.   ELSE IF err = null THEN  command := instr
  848.   ELSE IF (items = 1) AND (Length(st) = 1) THEN
  849.     CASE st[1] OF
  850.       'H': command := hlp;      'I': command := Int;
  851.       'B': command := bpt;      'C': command := cl;
  852.       'R': command := run;      'E': command := ends;
  853.       'W': command := tim;      'N': command := tim;
  854.       'D': command := tim;
  855.     END
  856.   ELSE IF (items = 2) AND (Length(st) = 1) THEN
  857.     CASE st[1] OF
  858.       'B': command := bpt;   'I': command := Int;  'V': command := view;
  859.       'G': command := go;    'L': command := ldf;
  860.     END
  861.   ELSE IF (items = 2) AND (Length(st) = 2) THEN
  862.     IF (st = 'AR') OR (st = 'PC')
  863.     OR (st = 'AC') OR (st = 'DR') OR (st = 'IR') THEN  command := regr
  864. END;
  865. (* ----------------------------------------------------------------------- *)
  866. PROCEDURE Set_Time;       (* Pause bei schrittweiser Ausfuehrung festlegen *)
  867. VAR  st: lines;
  868. BEGIN
  869.   st := item[1];
  870.   CASE st[1] OF
  871.     'N': mode := nowait;   'W': mode := waiting;   'D': mode := delaying;
  872.   END;
  873. END;
  874. (* ----------------------------------------------------------------------- *)
  875. PROCEDURE View_Page;
  876. VAR address, err: INTEGER;  ch: CHAR;
  877. BEGIN
  878.   Val(item[2],address,err);  IF err = null THEN Print_Mempage(address);
  879.   GotoXY(2,25);  revon;  Write('Druecke eine Taste');  RevOff;
  880.   ch := ReadKey;
  881. END;
  882. (* ----------------------------------------------------------------------- *)
  883. PROCEDURE help;
  884. VAR  counter, i: INTEGER;  ch: CHAR;  Str: lines;
  885. BEGIN
  886.   IF Open_File('DC.HLP') THEN BEGIN
  887.       counter := 0;  ch := ' ';
  888.       WHILE NOT Eof(inp_file) AND (ch <> esc) DO BEGIN
  889.         counter := counter + 1;  ReadLn(inp_file, Line);  Str := Line;
  890.         FOR i := 1 TO max_length - Length(Line) DO  Str := Concat(Str, ' ');
  891.         IF counter MOD 7 = 0 THEN BEGIN
  892.             Write(Line);
  893.             GotoXY (2,25); RevOn; Write('ESC: Ende  WEITER: Taste'); RevOff;
  894.             ch := ReadKey;  Erase_Error;
  895.             IF ch = esc THEN
  896.               BEGIN  GotoXY(1,row);  Write ('> ');  w_write(Str);  END;
  897.           END
  898.         ELSE BEGIN  GotoXY(1,row);  Write('> ');  w_write(Str);  END;
  899.       END;
  900.     END
  901.   ELSE error(illhlp);
  902. END;
  903. (* ----------------------------------------------------------------------- *)
  904. PROCEDURE Load_File;  FORWARD;                 (* Programm aus Datei laden *)
  905. (* ----------------------------------------------------------------------- *)
  906. PROCEDURE Execute_Command;                          (* Kommando ausfuehren *)
  907. BEGIN
  908.   CASE command OF
  909.     hlp  : help;                     cl   : Clear;
  910.     tim  : Set_Time;                 regr : Load_PC;
  911.     instr: Interpret_Instruction;    go   : Go_From;
  912.     bpt  : breakpoint;               Int  : interrupt;
  913.     ldf  : Load_File;                step : Single_Step;
  914.     run  : execute_program;          view : View_Page;
  915.     other: Error(illcmd);            ends : Exit_DC;
  916.   END;
  917. END;
  918. (* ----------------------------------------------------------------------- *)
  919. PROCEDURE Load_File;
  920. BEGIN
  921.   IF Pos('.',item[2]) = 0 THEN item[2] := Concat(item[2],'.DC');
  922.   IF Open_File(item[2]) THEN
  923.     WHILE NOT Eof(inp_file) DO BEGIN
  924.       ReadLn(inp_file, Line);  Interpret_Line;  Execute_Command;
  925.     END
  926.   ELSE Error(illfil);                                  (* Illegal filename *)
  927. END;
  928. (* ----------------------------------------------------------------------- *)
  929. BEGIN (* Didactic_Computer *)
  930.   Init;
  931.   REPEAT Read_Line; Interpret_Line; Execute_Command;  UNTIL command = ends;
  932. END.
  933.