home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 12 / dc / dc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-09-22  |  10.4 KB  |  251 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                                 DC.PAS                                  *)
  3. (*         Simulation eines einfachen didaktischen Computers "DC"          *)
  4. (* Autor: Zbigniew Szkaradnik - Vers. 1.1 fuer DEC LSI-11  25-April-85     *)
  5. (*                            - Vers. 1.2 fuer JOYCE       10-Febr.-87     *)
  6. (*   Modifikation und Implementierung (Vers. 1.3) von Michael Ceol fuer    *)
  7. (* PC-/MS-DOS (Turbo Pascal), CP/M (Turbo Pascal), Atari ST (Pascal ST +)  *)
  8. (* Sept. 87. Kurzanleitung siehe Datei "DC.HLP".  Viel Spass....           *)
  9. PROGRAM Didactic_Computer;
  10. (*$C-*)                                           (* nur fuer Turbo Pascal *)
  11. CONST
  12.   none         = -1;  null      = 0;      addr_start = 5;   op_start  = 1;
  13.   addr_end     = 10;  op_end    = 4;      mnem_size  = 3;   word_size = 10;
  14.   max_length   = 30;  mem_size  = 63;     winymin    = 18;  winymax   = 24;
  15.   instructions = 15;  screen_lines = 25;  sign_val   = 512; sign_bit  = 1;
  16.   zero = '0000000000';
  17.  
  18. TYPE
  19.   dc_word  = STRING[word_size];    op_str   = STRING[op_end];
  20.   mnem_str = STRING[mnem_size];    one_line = STRING[80];
  21.   lines    = STRING[max_length];   string2  = STRING[2];
  22.   errors   = (illcmd, illadd, illlab, illcod, illarg, illcon,
  23.               loops, ovf, illfil, illhlp, break);
  24.   mem_area = ARRAY [0..mem_size] OF dc_word;
  25.  
  26. VAR
  27.   end_of_program, out_cycle: BOOLEAN;  inp_file: TEXT;  esc: CHAR;
  28.   command : (cl, instr, regr, step, run, go, tim, bpt, Int, ldf,
  29.              other, hlp, view, ends);
  30.   mode    : (waiting, nowait, delaying);
  31.   err     : errors;   memory : mem_area;   Line : lines;
  32.   item    : ARRAY[1..3] OF lines;
  33.   window  : ARRAY[winymin..winymax] OF lines;
  34.   mnems   : ARRAY[0..instructions] OF mnem_str;
  35.   op_codes: ARRAY[0..instructions] OF op_str;
  36.   ar, pc, ac, dr, ir, sp: dc_word;
  37.   address, counter, int_addr, break_addr, s_ptr,
  38.   time, blink_num, blink_time, row, items, mempage, op_code: INTEGER;
  39.   ve, he, ce, dle, dre, ule, ure, uhe, dhe, rve, lve, se, vd, led_on, dpc,
  40.   led_off, wr, rd, sp2, ipc, pl, mi, sp1, u_arrow, d_arrow, bar, sl: string2;
  41. (* ----------------------------------------------------------------------- *)
  42. (*$I DCTURMS.PAS *)    (* bzw. ein anderes System-Modul, z.B. DCPSPTOS.PAS *)
  43. (*$I DCKONV.PAS  *)
  44. (*$I DCOUT.PAS   *)
  45. (*$I DCTRAN.PAS  *)
  46. (*$I DCEXE.PAS   *)
  47. (* ----------------------------------------------------------------------- *)
  48. PROCEDURE Init;
  49. VAR i: INTEGER;  temp: dc_word;
  50. BEGIN
  51.   esc := Chr(27);  RevOff;  CrsOff;  ClrScr;  Init_Sys;
  52.   pl := '+';    mi  := '-';   sp1 := ' ';   sp2 := '  ';
  53.   ipc := '+1';  dpc := '-1';  rd  := 'rd';  wr  := 'wr';  mode := nowait;
  54.   mnems[0]  := 'LDA';  mnems[1]  := 'STA';  mnems[2]  := 'ADD';
  55.   mnems[3]  := 'SUB';  mnems[4]  := 'JMP';  mnems[5]  := 'JMS';
  56.   mnems[6]  := 'JSR';  mnems[7]  := 'RTN';
  57.   FOR i := 8 TO 15 DO mnems[i] := '???';
  58.   temp := zero;  sp := zero;
  59.   FOR i := 0 TO instructions DO BEGIN
  60.     Int_to_Bin(i,op_start,op_end,temp);
  61.     op_codes[i] := Copy(temp,op_start,op_end);
  62.   END;
  63.   Print_Display;  Print_Computer;  Clear;
  64.   GotoXY(2,25);  revon;  Write(' <H> fuer Information');  RevOff;
  65.   row := winymin;  GotoXY(1,row);
  66. END;
  67. (* ----------------------------------------------------------------------- *)
  68. PROCEDURE Load_Constant (address: INTEGER); (* Konstante in Speicher laden *)
  69. VAR  value, err: INTEGER;
  70. BEGIN
  71.   Val(item[3],value,err);
  72.   IF (err = null)
  73.   AND (value > (-1 * Succ(sign_val))) AND (value < sign_val) THEN BEGIN
  74.       Load_Int(value,memory[address]);  print_cell(address);
  75.     END
  76.   ELSE  Error(illcon);                                 (* Illegal constant *)
  77. END;
  78.  
  79. PROCEDURE Load_Instruction (address: INTEGER; op_code: op_str);
  80. VAR  arg, i: INTEGER;  Mem: dc_word;           (* Befehl in Speicher laden *)
  81. BEGIN
  82.   IF item[2] = 'RTN' THEN item[3] := '0';
  83.   Val(item[3],arg,i);  Mem := zero;
  84.   IF (i = null) AND Legal(arg) THEN BEGIN
  85.       Int_to_Bin(arg,addr_start,addr_end,Mem);
  86.       FOR i := op_start TO op_end DO Mem[i] := op_code[i];
  87.       memory[address] := Mem;  print_cell(address);
  88.     END
  89.   ELSE  Error(illarg);                                 (* Illegal argument *)
  90. END;
  91.  
  92. PROCEDURE Load_PC;
  93. VAR  temp: dc_word;  value, err: INTEGER;
  94. BEGIN
  95.   Val(item[2],value,err);  Int_to_Bin(value,1,word_size,temp);
  96.   IF (err = null) AND Legal(value) THEN
  97.     IF item[1] = 'PC' THEN BEGIN pc := temp; counter := value; END
  98.     ELSE Error(illcmd)
  99.   ELSE Error(illadd);                           (* Illegal binary argument *)
  100.   Display_Status;
  101. END;
  102. (* ----------------------------------------------------------------------- *)
  103. PROCEDURE Interpret_Instruction;    (* Befehl in Maschinencode uebersetzen *)
  104. VAR  i, address: INTEGER;
  105. BEGIN
  106.   Val(item[1],address,i);
  107.   IF (i = null) AND Legal(address) THEN BEGIN
  108.       i := -1;
  109.       REPEAT
  110.         i := Succ(i);
  111.       UNTIL (item[2] = mnems[i]) OR (i = instructions);
  112.       IF item[2] = mnems[i] THEN Load_Instruction(address,op_codes[i])
  113.       ELSE IF item[2] = 'DEF' THEN Load_Constant(address)
  114.       ELSE Error(illcod);                                  (* Illegal code *)
  115.     END
  116.   ELSE Error(illlab);                                     (* Illegal label *)
  117. END;
  118. (* ----------------------------------------------------------------------- *)
  119. PROCEDURE Read_Line;                            (* Kommando-Zeile einlesen *)
  120. VAR  st: lines;  i: INTEGER;
  121. BEGIN
  122.   Invert_Cell(counter);  CrsOn;  GotoXY(1,row);  Bell;
  123.   Write('> ');  ReadLn(Line);  st := Line;
  124.   FOR i := 1 TO max_length - Length(Line) DO st := Concat(st,' ');
  125.   CrsOff;  w_write(st);  Erase_Error;   print_cell(counter);
  126. END;
  127. (* ----------------------------------------------------------------------- *)
  128. PROCEDURE Separate_Tokens;         (* Bestandteile des Kommandos aufloesen *)
  129. VAR  i: INTEGER;
  130.  
  131.  FUNCTION empty (VAR st: lines): BOOLEAN;
  132.  VAR  i: INTEGER;  temp: BOOLEAN;
  133.  BEGIN
  134.    temp := FALSE;  i := 0;
  135.    REPEAT
  136.      i := Succ(i);
  137.      IF i <= Length(st) THEN  IF st[i] <> ' ' THEN  temp := TRUE;
  138.    UNTIL temp OR (i >= Length(st));
  139.    empty := NOT(temp);
  140.  END;
  141.  
  142. BEGIN
  143.   FOR i := 1 TO 3 DO  item[i] := '';
  144.   i := Pos(';',Line);
  145.   IF i > 0 THEN  Delete(Line,i,Length(Line)-i+1);   (* Kommentar entfernen *)
  146.   items := 0;
  147.   IF empty(Line) THEN Line := '';
  148.   IF Length(Line) > 0 THEN BEGIN
  149.     Line := Concat(Line,' ');
  150.     REPEAT
  151.       items := Succ(items);
  152.       WHILE Line[1] = ' ' DO  Delete(Line,1,1);
  153.       i := Pos(' ',Line);  item[items] := Copy(Line,1,Pred(i));
  154.       Delete(Line,1,Length(item[items]))
  155.     UNTIL (items = 3) OR empty(Line);
  156.   END;
  157. END;
  158. (* ----------------------------------------------------------------------- *)
  159. PROCEDURE Interpret_Line;                     (* Kommandozeile uebersetzen *)
  160. VAR  st: lines;  i, err: INTEGER;
  161. BEGIN
  162.   To_Upper(Line);   Separate_Tokens;   st := item[1];   command := other;
  163.   Val(item[1],i,err);
  164.   IF items = 0 THEN  command := step
  165.   ELSE IF err = null THEN  command := instr
  166.   ELSE IF (items = 1) AND (Length(st) = 1) THEN
  167.     CASE st[1] OF
  168.       'H': command := hlp;      'I': command := Int;
  169.       'B': command := bpt;      'C': command := cl;
  170.       'R': command := run;      'E': command := ends;
  171.       'W': command := tim;      'N': command := tim;
  172.       'D': command := tim;
  173.     END
  174.   ELSE IF (items = 2) AND (Length(st) = 1) THEN
  175.     CASE st[1] OF
  176.       'B': command := bpt;   'I': command := Int;  'V': command := view;
  177.       'G': command := go;    'L': command := ldf;
  178.     END
  179.   ELSE IF (items = 2) AND (Length(st) = 2) THEN
  180.     IF (st = 'AR') OR (st = 'PC')
  181.     OR (st = 'AC') OR (st = 'DR') OR (st = 'IR') THEN  command := regr
  182. END;
  183. (* ----------------------------------------------------------------------- *)
  184. PROCEDURE Set_Time;       (* Pause bei schrittweiser Ausfuehrung festlegen *)
  185. VAR  st: lines;
  186. BEGIN
  187.   st := item[1];
  188.   CASE st[1] OF
  189.     'N': mode := nowait;   'W': mode := waiting;   'D': mode := delaying;
  190.   END;
  191. END;
  192. (* ----------------------------------------------------------------------- *)
  193. PROCEDURE View_Page;
  194. VAR address, err: INTEGER;  ch: CHAR;
  195. BEGIN
  196.   Val(item[2],address,err);  IF err = null THEN Print_Mempage(address);
  197.   GotoXY(2,25);  revon;  Write('Druecke eine Taste');  RevOff;
  198.   ch := ReadKeyboard;
  199. END;
  200. (* ----------------------------------------------------------------------- *)
  201. PROCEDURE help;
  202. VAR  counter, i: INTEGER;  ch: CHAR;  Str: lines;
  203. BEGIN
  204.   IF Open_File('DC.HLP') THEN BEGIN
  205.       counter := 0;  ch := ' ';
  206.       WHILE NOT Eof(inp_file) AND (ch <> esc) DO BEGIN
  207.         counter := counter + 1;  ReadLn(inp_file, Line);  Str := Line;
  208.         FOR i := 1 TO max_length - Length(Line) DO  Str := Concat(Str, ' ');
  209.         IF counter MOD 7 = 0 THEN BEGIN
  210.             Write(Line);
  211.             GotoXY (2,25); RevOn; Write('ESC: Ende  WEITER: Taste'); RevOff;
  212.             ch := ReadKeyboard;  Erase_Error;
  213.             IF ch = esc THEN
  214.               BEGIN  GotoXY(1,row);  Write ('> ');  w_write(Str);  END;
  215.           END
  216.         ELSE BEGIN  GotoXY(1,row);  Write('> ');  w_write(Str);  END;
  217.       END;
  218.     END
  219.   ELSE error(illhlp);
  220. END;
  221. (* ----------------------------------------------------------------------- *)
  222. PROCEDURE Load_File;  FORWARD;                 (* Programm aus Datei laden *)
  223. (* ----------------------------------------------------------------------- *)
  224. PROCEDURE Execute_Command;                          (* Kommando ausfuehren *)
  225. BEGIN
  226.   CASE command OF
  227.     hlp  : help;                     cl   : Clear;
  228.     tim  : Set_Time;                 regr : Load_PC;
  229.     instr: Interpret_Instruction;    go   : Go_From;
  230.     bpt  : breakpoint;               Int  : interrupt;
  231.     ldf  : Load_File;                step : Single_Step;
  232.     run  : execute_program;          view : View_Page;
  233.     other: Error(illcmd);            ends : Exit_DC;
  234.   END;
  235. END;
  236. (* ----------------------------------------------------------------------- *)
  237. PROCEDURE Load_File;
  238. BEGIN
  239.   IF Pos('.',item[2]) = 0 THEN item[2] := Concat(item[2],'.DC');
  240.   IF Open_File(item[2]) THEN
  241.     WHILE NOT Eof(inp_file) DO BEGIN
  242.       ReadLn(inp_file, Line);  Interpret_Line;  Execute_Command;
  243.     END
  244.   ELSE Error(illfil);                                  (* Illegal filename *)
  245. END;
  246. (* ----------------------------------------------------------------------- *)
  247. BEGIN (* Didactic_Computer *)
  248.   Init;
  249.   REPEAT Read_Line; Interpret_Line; Execute_Command;  UNTIL command = ends;
  250. END.
  251.