Compilerbau: Die virtuelle ppl-Maschine
| Compilerbau: Die virtuelle ppl-Maschine |
|
|
|
1module PPL.MachineArchitecture where
2
3import PPL.Instructions
4import PPL.Picture
5
6import Data.Array
7
8type MProg = Array Int Instr -- the machine programm
9
10-- machine values are tagged
11-- there is an undefined value for initializing variable
12-- if this value is read from the data memory, an error is issued
13--
14
15data MV
16 = VUndef
17 | VInt Int
18 | VFloat Double
19 | VString String
20 | VPic Picture
21 | VList [MV]
22 | VCodeAddr Int
23
24data MStatus
25 = Ok -- continue
26 | Exc String -- exception in instr exec
27
28-- the memory for program variables
29
30type Mem = [MV]
31
32-- the evaluation stack
33
34type Stack = [MV]
35
36-- the complete machine state
37
38data MS = MS { instr :: ! MProg
39 , pc :: ! Int
40 , mem :: ! Mem
41 , stack :: ! Stack
42 , frames :: ! [Mem]
43 , status :: ! MStatus
44 }
45
46-- -------------------------------------------------------------------
47
48-- machine state access functions
49
50-- -------------------------------------------------------------------
51
52-- pc access
53
54getPc :: MS -> Int
55getPc ms = pc ms
56
57setPc :: Int -> MS -> MS
58setPc pc1 ms = ms { pc = pc1 }
59
60incrPc :: MS -> MS
61incrPc ms = ms { pc = (getPc ms + 1) }
62
63legalPc :: MS -> Bool
64legalPc ms
65 = pc1 >= lb && pc1 <= ub
66 where
67 (lb, ub) = bounds (instr ms)
68 pc1 = pc ms
69
70getInstr :: MS -> Instr
71getInstr ms
72 = instr ms ! pc ms
73
74-- -------------------------------------------------------------------
75
76-- memory access
77
78-- global memory
79
80legalMemAddr :: Address -> MS -> Bool
81legalMemAddr (AbsA addr) ms
82 = addr >= 0 && addr < ub
83 where
84 ub = length (mem ms)
85
86legalMemAddr (LocA addr) ms
87 = not (null stackframes)
88 && addr >= 0
89 && addr < ub
90 where
91 ub = length (head stackframes)
92 stackframes = frames ms
93
94readMem :: Address -> MS -> MV
95 -- pre: legalMemAddr
96readMem (AbsA addr) ms
97 = (mem ms) !! addr
98
99readMem (LocA addr) ms
100 = head (frames ms) !! addr
101
102
103writeMem :: Address -> MV -> MS -> MS
104 -- pre: legalMemAddr
105writeMem (AbsA addr) val ms
106 = ms { mem = substVal addr val (mem ms) }
107
108writeMem (LocA addr) val ms
109 = ms { frames = substVal addr val top : rest }
110 where
111 (top : rest) = frames ms
112
113substVal :: Int -> MV -> Mem -> Mem
114substVal ix val l
115 = left ++ (val : tail right)
116 where
117 (left, right) = splitAt ix l
118
119allocFrame :: Int -> MS -> MS
120allocFrame size ms
121 = ms { frames = newframe : frames ms }
122 where
123 newframe = replicate size VUndef
124
125freeFrame :: MS -> MS
126 -- pre: not empty stack of frames
127freeFrame ms
128 = ms { frames = tail (frames ms) }
129
130nullFrames :: MS -> Bool
131nullFrames ms = null (frames ms)
132
133-- -------------------------------------------------------------------
134
135-- stack access
136
137pushValue :: MV -> MS -> MS
138pushValue val ms
139 = ms { stack = (val : stack ms) }
140
141popValue :: MS -> (MS, MV)
142popValue ms
143 = ( ms { stack = st1 }, val )
144 where
145 (val : st1) = stack ms
146 -- pre: not emptyStack
147
148emptyStack :: MS -> Bool
149emptyStack ms
150 = null (stack ms)
151
152
153-- -------------------------------------------------------------------
154--
155-- status register
156
157programTerminated :: String
158programTerminated = "program terminated"
159
160programAborted :: String
161programAborted = "program aborted"
162
163statusIsTerminated :: MS -> Bool
164statusIsTerminated ms
165 = case status ms
166 of
167 Exc e -> e == programTerminated
168 _ -> False
169
170statusIsExc :: MS -> Bool
171statusIsExc ms
172 = case status ms
173 of
174 Exc _e -> not (statusIsTerminated ms)
175 _ -> False
176
177statusIsOk :: MS -> Bool
178statusIsOk ms
179 = case status ms
180 of
181 Ok -> True
182 _ -> False
183
184getExc :: MS -> String
185getExc ms
186 = let
187 Exc exc = status ms
188 in
189 exc
190
191setExc :: String -> MS -> MS
192setExc e ms = ms { status = Exc e }
193
194clearStatus :: MS -> MS
195clearStatus ms = ms { status = Ok }
196
197-- -------------------------------------------------------------------
|
|
1module PPL.Instructions where
2
3type Code = [Instr]
4
5data Instr
6 = LoadI Int -- load int const
7 | LoadF Double -- load float const
8 | LoadS String -- load string const
9 | LoadU -- load undefined value
10 | LoadEL -- load empty list
11 | Load Address -- read data memory
12 | Store Address -- write data memory
13 | Pop -- remove arg from stack
14 | Dup -- duplicate top of stack
15 | Compute Opcode -- evaluate something
16 | SysCall Subroutine -- system call (svc)
17 | PushJ Dest -- subroutine call
18 | PopJ -- computed jump (subroutine return)
19 | Entry Int -- allocate stack frame
20 | Exit -- delete stack frame
21 | Branch Bool Dest -- gotos and branches
22 | Jump Dest
23 | Label Label -- symbolic jump target
24 | IllegalInstr String -- not yet implemented
25 deriving (Eq, Show)
26
27data Address
28 = LocA Int -- local address
29 | AbsA Int -- global address
30 deriving (Eq, Show)
31
32data Dest
33 = Symb Label
34 | Disp Int
35 deriving (Eq, Show)
36
37data Opcode
38 = OPabort
39 | OPabove
40 | OPaddf
41 | OPaddi
42 | OPappendl
43 | OPbitmap
44 | OPblack
45 | OPblackAndWhite
46 | OPconcatHorizontal
47 | OPconcatVertical
48 | OPconcl
49 | OPconcs
50 | OPcut
51 | OPdecri
52 | OPdiff
53 | OPdivf
54 | OPdivi
55 | OPeqf
56 | OPeqi
57 | OPf2s
58 | OPflipDiagonal
59 | OPflipHorizontal
60 | OPflipVertical
61 | OPgamma
62 | OPgef
63 | OPgei
64 | OPgrey
65 | OPgtf
66 | OPgti
67 | OPheight
68 | OPi2f
69 | OPi2s
70 | OPincri
71 | OPindexl
72 | OPinverseDiff
73 | OPinverseMean
74 | OPinvert
75 | OPisemptyl
76 | OPlengthl
77 | OPmaxf
78 | OPmaxi
79 | OPmaxp
80 | OPmean
81 | OPmergeHorizontal
82 | OPmergeVertical
83 | OPminf
84 | OPmini
85 | OPminp
86 | OPmodi
87 | OPmulf
88 | OPmuli
89 | OPmulp
90 | OPpartitionHorizontal
91 | OPpartitionVertical
92 | OPpaste
93 | OPconsl
94 | OPreduceColor
95 | OPreplicate
96 | OPresize
97 | OProtate
98 | OPround
99 | OPscale
100 | OPshift
101 | OPshrink
102 | OPsideBySide
103 | OPsplitHorizontal
104 | OPsplitVertical
105 | OPsubf
106 | OPsubi
107 | OPtaill
108 | OPterminate
109 | OPtrunc
110 | OPwhite
111 | OPwidth
112 deriving (Eq, Show)
113
114type Arg = String
115type Comment = String
116type Label = String
117type Subroutine = String
118
119type DataSeg = Int
120
121type Executable = (Code, DataSeg)
|
|
1-- test with functions and procedures
2
3function ggt(x,y : int) : int
4 if x = y
5 then x
6 else if x > y
7 then ggt(x - y, y)
8 else ggt(y, x)
9;
10
11procedure test(i,j : int)
12 writeln("ggt("
13 + i.toString
14 + ","
15 + j.toString
16 + ") = "
17 + ggt(i,j).toString
18 )
19;
20
21begin
22 test(13,8)
23end
|
|
1.text
2 loadi 13
3 loadi 8
4 pushj _test
5 pop
6 terminate
7_ggt:
8 entry 3
9 store l[0]
10s_ggt:
11 store l[1]
12 store l[2]
13 load l[2]
14 load l[1]
15 eqi
16 brfalse l0
17 load l[2]
18 jmp l1
19l0:
20 load l[2]
21 load l[1]
22 gti
23 brfalse l2
24 load l[2]
25 load l[1]
26 subi
27 load l[1]
28 pushj _ggt
29 jmp l3
30l2:
31 load l[1]
32 load l[2]
33 pushj _ggt
34l3:
35l1:
36e_ggt:
37 load l[0]
38 exit
39 popj
40_test:
41 entry 3
42 store l[0]
43s_test:
44 store l[1]
45 store l[2]
46 loads "ggt("
47 load l[2]
48 i2s
49 concs
50 loads ","
51 concs
52 load l[1]
53 i2s
54 concs
55 loads ") = "
56 concs
57 load l[2]
58 load l[1]
59 pushj _ggt
60 i2s
61 concs
62 svc writeln
63 pop
64 undef
65e_test:
66 load l[0]
67 exit
68 popj
69
70.data 0
|
|
start execution
0: loadi 13
1: loadi 8
2: pushj 28 --> 30
30: entry 3
31: store l[0]
32: store l[1]
33: store l[2]
34: loads "ggt("
35: load l[2]
36: i2s
37: concs
38: loads ","
39: concs
40: load l[1]
41: i2s
42: concs
43: loads ") = "
44: concs
45: load l[2]
46: load l[1]
47: pushj -42 --> 5
5: entry 3
6: store l[0]
7: store l[1]
8: dup
9: store l[2]
10: load l[1]
11: eqi
12: brfalse 3 --> 15
15: load l[2]
16: load l[1]
17: gti
18: brfalse 6 --> 24
19: load l[2]
20: load l[1]
21: subi
22: load l[1]
23: jmp -16 --> 7
7: store l[1]
8: dup
9: store l[2]
10: load l[1]
11: eqi
12: brfalse 3 --> 15
15: load l[2]
16: load l[1]
17: gti
18: brfalse 6 --> 24
24: load l[1]
25: load l[2]
26: jmp -19 --> 7
7: store l[1]
8: dup
9: store l[2]
10: load l[1]
11: eqi
12: brfalse 3 --> 15
15: load l[2]
16: load l[1]
17: gti
18: brfalse 6 --> 24
19: load l[2]
20: load l[1]
21: subi
22: load l[1]
23: jmp -16 --> 7
7: store l[1]
8: dup
9: store l[2]
10: load l[1]
11: eqi
12: brfalse 3 --> 15
15: load l[2]
16: load l[1]
17: gti
18: brfalse 6 --> 24
24: load l[1]
25: load l[2]
26: jmp -19 --> 7
7: store l[1]
8: dup
9: store l[2]
10: load l[1]
11: eqi
12: brfalse 3 --> 15
15: load l[2]
16: load l[1]
17: gti
18: brfalse 6 --> 24
19: load l[2]
20: load l[1]
21: subi
22: load l[1]
23: jmp -16 --> 7
7: store l[1]
8: dup
9: store l[2]
10: load l[1]
11: eqi
12: brfalse 3 --> 15
15: load l[2]
16: load l[1]
17: gti
18: brfalse 6 --> 24
24: load l[1]
25: load l[2]
26: jmp -19 --> 7
7: store l[1]
8: dup
9: store l[2]
10: load l[1]
11: eqi
12: brfalse 3 --> 15
15: load l[2]
16: load l[1]
17: gti
18: brfalse 6 --> 24
19: load l[2]
20: load l[1]
21: subi
22: load l[1]
23: jmp -16 --> 7
7: store l[1]
8: dup
9: store l[2]
10: load l[1]
11: eqi
12: brfalse 3 --> 15
15: load l[2]
16: load l[1]
17: gti
18: brfalse 6 --> 24
24: load l[1]
25: load l[2]
26: jmp -19 --> 7
7: store l[1]
8: dup
9: store l[2]
10: load l[1]
11: eqi
12: brfalse 3 --> 15
15: load l[2]
16: load l[1]
17: gti
18: brfalse 6 --> 24
19: load l[2]
20: load l[1]
21: subi
22: load l[1]
23: jmp -16 --> 7
7: store l[1]
8: dup
9: store l[2]
10: load l[1]
11: eqi
12: brfalse 3 --> 15
13: load l[2]
14: jmp 13 --> 27
27: load l[0]
28: exit
29: popj
48: i2s
49: concs
50: svc writeln
51: load l[0]
52: exit
53: popj
3: pop
4: terminate
execution terminated
|
| Letzte Änderung: 14.02.2012 | © Prof. Dr. Uwe Schmidt |
