~ubuntu-branches/ubuntu/karmic/ocaml-doc/karmic

« back to all changes in this revision

Viewing changes to examples/picomach/simul.ml

  • Committer: Bazaar Package Importer
  • Author(s): Vanicat Rémi
  • Date: 2002-02-05 10:51:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020205105143-a061tunf8tev07ne
Tags: 3.04-4
* New debian maintainer
* Split doc-base file
* Move to non-free
* Change the copyright file to the copyright of the documentation
* remove FAQs (their license prohibit their redistribution)
* corrected the examples

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
open Code;;
 
2
 
 
3
exception Erreur of string * int;;
 
4
 
 
5
type �tat_du_processeur =
 
6
   { registres: int array;
 
7
     mutable pc: int;
 
8
     mutable code: instruction array;
 
9
     mutable m�moire: int array };;
 
10
 
 
11
let pico =
 
12
  { registres = Array.make nombre_de_registres 0;
 
13
    pc = 0;
 
14
    code = [| |];
 
15
    m�moire = [| |] };;
 
16
let lire_registre reg =
 
17
    if reg < 0 or reg >= nombre_de_registres then
 
18
      raise (Erreur ("registre ill�gal", reg));
 
19
    pico.registres.(reg);;
 
20
 
 
21
let �crire_registre reg valeur =
 
22
    if reg < 0 or reg >= nombre_de_registres then
 
23
      raise (Erreur ("registre ill�gal", reg));
 
24
    if reg <> 0 then pico.registres.(reg) <- valeur;;
 
25
 
 
26
let lire_instruction adresse =
 
27
    let adr = adresse/taille_du_mot in
 
28
    if adr < 0 or adr >= Array.length pico.code then
 
29
      raise (Erreur ("sortie de la zone code", adr));
 
30
    if adresse mod taille_du_mot <> 0 then
 
31
      raise (Erreur ("pc non align�", adresse));
 
32
    pico.code.(adr);;
 
33
 
 
34
let lire_m�moire adresse =
 
35
    let adr = adresse/taille_du_mot in
 
36
    if adr < 0 or adr >= Array.length pico.m�moire then
 
37
      raise (Erreur ("lecture en dehors de la m�moire", adresse));
 
38
    if adresse mod taille_du_mot <> 0 then
 
39
      raise (Erreur ("lecture non align�e", adresse));
 
40
    pico.m�moire.(adr);;
 
41
 
 
42
let �crire_m�moire adresse valeur =
 
43
    let adr = adresse/taille_du_mot in
 
44
    if adr < 0 or adr >= Array.length pico.m�moire then
 
45
      raise (Erreur ("�criture en dehors de la m�moire", adresse));
 
46
    if adresse mod taille_du_mot <> 0 then
 
47
      raise (Erreur ("�criture non align�e", adresse));
 
48
    pico.m�moire.(adr) <- valeur;;
 
49
 
 
50
let valeur_op�rande = function
 
51
  | Reg r -> lire_registre r
 
52
  | Imm n -> n;;
 
53
let tableau_des_appels_syst�me =
 
54
  Array.make 10 ((function x -> x) : int -> int);;
 
55
 
 
56
let ex�cute_appel_syst�me appel argument =
 
57
    if appel < 0 or appel >= Array.length tableau_des_appels_syst�me
 
58
     then raise(Erreur("mauvais appel syst�me", appel))
 
59
     else tableau_des_appels_syst�me.(appel) argument;;
 
60
exception Arr�t;;
 
61
 
 
62
let cycle_d'horloge () =
 
63
  let instruction = lire_instruction pico.pc in
 
64
  pico.pc <- pico.pc + taille_du_mot;
 
65
  match instruction with
 
66
  | Op(op�ration, reg1, op�rande, reg2) ->
 
67
      let arg1 = lire_registre reg1
 
68
      and old2 = lire_registre reg2
 
69
      and arg2 = valeur_op�rande op�rande in
 
70
      begin match op�ration with
 
71
      | Load  -> �crire_registre reg2 (lire_m�moire (arg1 + arg2))
 
72
      | Store -> �crire_m�moire (arg1 + arg2) (lire_registre reg2)
 
73
      | Add   -> �crire_registre reg2 (arg1 + arg2)
 
74
      | Mult  -> �crire_registre reg2 (arg1 * arg2)
 
75
      | Sub   -> �crire_registre reg2 (arg1 - arg2)
 
76
      | Div   -> if arg2 = 0
 
77
                 then raise (Erreur("division par z�ro", pico.pc-1))
 
78
                 else �crire_registre reg2 (arg1 / arg2)
 
79
      | And   -> �crire_registre reg2 (arg1 land arg2)
 
80
      | Or    -> �crire_registre reg2 (arg1 lor arg2)
 
81
      | Xor   -> �crire_registre reg2 (arg1 lxor arg2)
 
82
      | Shl   -> �crire_registre reg2 (arg1 lsl arg2)
 
83
      | Shr   -> �crire_registre reg2 (arg1 asr arg2)
 
84
      | Slt   -> �crire_registre reg2 (if arg1 < arg2 then 2 else 0)
 
85
      | Sle   -> �crire_registre reg2 (if arg1 <= arg2 then 2 else 0)
 
86
      | Seq   -> �crire_registre reg2 (if arg1 = arg2 then 2 else 0)
 
87
      end
 
88
  | Jmp(op�rande, reg) ->
 
89
      �crire_registre reg pico.pc;
 
90
      pico.pc <- valeur_op�rande op�rande
 
91
  | Braz(reg, adresse) ->
 
92
      if lire_registre reg = 0 then pico.pc <- adresse
 
93
  | Branz(reg, adresse) ->
 
94
      if lire_registre reg <> 0 then pico.pc <- adresse
 
95
  | Scall(appel_syst�me) ->
 
96
      �crire_registre 1
 
97
        (ex�cute_appel_syst�me appel_syst�me (lire_registre 1))
 
98
  | Stop -> raise Arr�t;;
 
99
let ex�cute programme taille_m�moire_en_octets =
 
100
    let taille_m�moire_en_mots = (taille_m�moire_en_octets + 3) / 4 in
 
101
    pico.code <- programme;
 
102
    pico.m�moire <- Array.make taille_m�moire_en_mots 0;
 
103
    pico.registres.(0) <- 0;
 
104
    pico.registres.(sp) <- taille_m�moire_en_mots * taille_du_mot;
 
105
    pico.pc <- 0;
 
106
    try while true do cycle_d'horloge () done
 
107
    with Arr�t -> ();;
 
108
 
 
109
let appel_syst�me_read _ =
 
110
    print_string "? "; flush stdout;
 
111
    try read_int ()
 
112
    with Failure _ -> raise (Erreur ("erreur de lecture", 1))
 
113
 
 
114
and appel_syst�me_write argument =
 
115
    print_int argument; print_newline (); argument;;
 
116
 
 
117
tableau_des_appels_syst�me.(0) <- appel_syst�me_read;
 
118
tableau_des_appels_syst�me.(1) <- appel_syst�me_write;;