1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
/******************************************************************************/
/* Copyright (c) 1993 by GMD Karlruhe, Germany */
/* Gesellschaft fuer Mathematik und Datenverarbeitung */
/* (German National Research Center for Computer Science) */
/* Forschungsstelle fuer Programmstrukturen an Universitaet Karlsruhe */
/* All rights reserved. */
/******************************************************************************/
/* Mocka INTEL 80386/387 run time system */
/* Holger Hopp Stand: 23.03.95 */
/******************************************************************************/
MaxDisplay_ = 16
DisplaySize_ = 4 * MaxDisplay_
stderr_ = 2
.globl _M2ROOT # Imports
.globl write
.globl abort
.globl errno
.globl main # Exports
.globl GetArgs
.globl GetEnv
.globl ErrNo
.globl exit_
.globl ReturnErr_
.globl BoundErr_
.globl CaseErr_
.globl Transfer_
.globl NewProcess_
.globl RealOne_
.globl RealLog2e_
.globl RealLn2_
.globl TwoExp31_
.globl TwoExp32_
.comm argv_, 4
.comm argc_, 4
.comm env_, 4
.comm DISPLAY_, DisplaySize_
.comm spsave_, 4
.comm fpucw_round_to_nearest,2 # used in MathLib.exp
.comm fpucw_round_to_zero,2 # used in TRUNC, LREAL.LTRUNC
.comm fpucw_round_to_inf,2 # not used
.comm fpucw_round_to_neginf,2 # used in MathLib.entier
main:
pushl %ebp
movl %esp, %ebp
movl %esp, spsave_ # save stack pointer
movl 8(%ebp),%eax # save arguments of main
movl %eax,argc_
movl 12(%ebp),%eax
movl %eax,argv_
movl 16(%ebp),%eax
movl %eax,env_
fnstcw fpucw_round_to_nearest # save fpu control words
movw fpucw_round_to_nearest,%ax
andw $0xf3ff,%ax
movw %ax,fpucw_round_to_nearest
orw $0x0400,%ax
movw %ax,fpucw_round_to_neginf
orw $0x0c00,%ax
movw %ax,fpucw_round_to_zero
andw $0xfbff,%ax
movw %ax,fpucw_round_to_inf
fldcw fpucw_round_to_zero # this is default for MOCKA
call _M2ROOT
.Lret_:
movl $0,%eax
leave
ret
# IMPLEMENTATION MODULE Arguments
# PROCEDURE GetArgs (VAR argc: SHORTCARD; VAR argv: ADDRESS)
GetArgs:
movl 4(%esp),%eax
movl argc_,%ebx
movl %ebx,(%eax)
movl 8(%esp),%eax
movl argv_,%ebx
movl %ebx,(%eax)
ret
# PROCEDURE GetEnv (VAR env: ADDRESS)
GetEnv:
movl 4(%esp),%eax
movl env_,%ebx
movl %ebx,(%eax)
ret
# IMPLEMENTATION MODULE ErrNumbers
# PROCEDURE ErrNo () : SHORTCARD;
ErrNo:
movl errno,%eax
ret
# IMPLEMENTATION MODULE SYSTEM
# PROCEDURE HALT
exit_:
movl spsave_, %esp
movl spsave_, %ebp
jmp .Lret_
# PROCEDURE TRANSFER (VAR from, to: ADDRESS)
Transfer_:
movl 4(%esp),%eax # eax := from
movl 8(%esp),%ebx # ebx := to
pushl %ebp # save base pointer
subl $DisplaySize_,%esp # save display vector
movl $MaxDisplay_,%ecx
movl $DISPLAY_,%esi
movl %esp,%edi
cld
repz
movsl
movl %esp,(%eax) # switch stack pointer
movl (%ebx),%esp
movl $MaxDisplay_,%ecx # get display vector
movl %esp,%esi
movl $DISPLAY_,%edi
cld
repz
movsl
addl $DisplaySize_,%esp
popl %ebp # get base pointer
ret # switch to to process
# PROCEDURE NEWPROCESS (p: PROC; a: ADDRESS; s: CARDINAL; VAR co: ADDRESS)
NewProcess_:
movl 8(%esp),%eax # eax := a (Start of Workspace)
addl 12(%esp),%eax # eax := a + s (End of Workspace)
andl $-4,%eax # align End of Workspace
movl $exit_,-4(%eax) # Exit of Coroutine
movl 4(%esp),%ebx # Start of Procedure
movl %ebx,-8(%eax)
movl $MaxDisplay_,%ecx # copy display vector
movl $DISPLAY_,%esi
leal -12-DisplaySize_(%eax),%edi
movl 16(%esp),%edx # edx := address of result co
movl %edi,(%edx) # result
cld
repz
movsl
ret
# RunTimeChecks
.data
returnerr_:
.ascii "\012**** RUNTIME ERROR missing return from function\n\0"
returnerrsize_ = . - returnerr_
bounderr_:
.ascii "\012**** RUNTIME ERROR bound check error\n\0"
bounderrsize_ = . - bounderr_
caseerr_:
.ascii "\012**** RUNTIME ERROR case expression out of range\n\0"
caseerrsize_ = . - caseerr_
.text
ReturnErr_:
pushl $returnerrsize_
pushl $returnerr_
RuntimeErr_:
pushl $stderr_
call write
addl $12,%esp
#call abort
mov $0,%ebx
divl %ebx
ret
BoundErr_:
pushl $bounderrsize_
pushl $bounderr_
jmp RuntimeErr_
CaseErr_:
pushl $caseerrsize_
pushl $caseerr_
jmp RuntimeErr_
.data
.align 4
RealOne_:
.single 0r0.1E1
.align 8
RealLog2e_:
.double 0r0.144269504088896340737E1
RealLn2_:
.double 0r0.69314718055994530941E0
TwoExp32_:
.double 0r0.4294967296E10
TwoExp31_:
.double 0r0.2147483648E10
|
