![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to NS32.prim.s CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / runtime|
Return to NS32.prim.s CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / runtime |
1.1 root 1: /* Copyright 1989 by AT&T Bell Laboratories */
2: #include "tags.h"
3: #include "prof.h"
4: #include "prim.h"
5: #define String(handle,len,str) .align 2;\
6: .double len*power_tags+tag_string;\
7: handle: .ascii str
8: /* args come in as
9: r2 = closure; can be ignored because contains no free vars
10: r0 = arg
11: r1 = continuation
12:
13: registers 0-4 can contain only pointers or tagged integers
14: register 5 is ptrtemp, and it could be anything?!?
15: registers 6-7 can contain anything except pointers
16: 4(sb) is the store pointer
17: fp is the data ptr
18: 0(sb) is the exception handler
19: sp is the stack pointer (mostly unused)
20: pc is the program counter
21: sb is the base address for the exception handler and store pointer
22: mod is the base address for sb
23: */
24: #define Closure(name) .align 2;\
25: .double mak_desc(1,tag_record);\
26: name: .double .L/**/name/**/code;\
27: .double 1;\
28: .double tag_backptr;\
29: .L/**/name/**/code:
30:
31: .text
32: .globl _mlmodreg
33: .align 2
34: _mlmodreg:
35: .double _mlsbreg
36: .data
37: _saved_cmodreg:
38: .double 0 /* keep C happy, just in case */
39: _saved_csbreg:
40: .double 0
41: .globl _mlsbreg
42: _mlsbreg:
43: .double 0 /* exnptr */
44: .double 0 /* storeptr */
45: .text
46: /* Aligned strings for floating point exceptions */
47: String(.Loflw,8,"overflow")
48: String(.Luflw,9,"underflow\0\0\0")
49: .globl _runvec
50: .align 2
51: .double mak_desc(8,tag_record)
52: _runvec:
53: .double _array_v
54: .double _callc_v
55: .double _create_b_v
56: .double _create_s_v
57: .double _floor_v
58: .double _logb_v
59: .double _scalb_v
60: .double _syscall_v
61:
62: Closure(_array_v)
63: movd 0(r0),r6 /* r6 = ML_int(length) */
64: ashd $-1,r6 /* r6 = length */
65: movd 4(r0),r2 /* r2 = initial value */
66: movd r6,r7
67: ashd $width_tags,r7
68: ord $tag_array,r7 /* r7 = proper tag for array */
69: movzbd $0,-4(fp)[r6:d] /* allocate (maybe fault) */
70: movd r7,-4(fp) /* set array tag */
71: sprd fp,r0 /* return value is array start */
72: addr 4(fp)[r6:d],r5 /* r5 = new freespace pointer */
73: br .Ltest
74: .Ltop: movd r2,0(fp)[r6:d] /* store default at array sub r6 */
75: .Ltest: acbd $-1,r6,.Ltop
76: movd r2,0(fp) /* store default at array sub 0 */
77: lprd fp,r5 /* update freespace pointer */
78: movd 0(r1),r5 /* r5 = code pointer for cont */
79: jump 0(r5)
80:
81: Closure(_create_b_v)
82: movd $tag_bytearray,r4
83: br .Lcre
84: Closure(_create_s_v)
85: movd $tag_string,r4
86: .Lcre: addr 13(r0),r7 /* r0 = ML_int(length) */
87: ashd $-3,r7 /* r7 = (length + 7) div 4 */
88: movd r7,r6
89: ashd $2,r6 /* r6 = bytes in string including tag */
90: addqd $-1,r7 /* r7 = words in string, not including tag */
91: movzbd $0,-4(fp)[r7:d] /* allocate (maybe fault) */
92: movd r0,r7
93: ashd $-1,r7 /* r7 = length */
94: ashd $width_tags,r7
95: ord r4,r7
96: movd r7,-4(fp) /* install new tag */
97: sprd fp,r0 /* return value is start of object */
98: addr 0(fp)[r6:b],r5
99: lprd fp,r5 /* uptdate freespace pointer */
100: movd 0(r1),r5
101: jump 0(r5)
102:
103: .globl _saveregs
104: .globl _handle_c
105: .globl _return_c
106: .globl _restoreregs
107: Closure(_handle_c)
108: movd $CAUSE_EXN,_cause;
109: br _saveregs
110: Closure(_return_c)
111: movd $CAUSE_RET,_cause;
112: _saveregs:
113: addr -4(fp),_saved_dataptr
114: movd 0(sb),_saved_exnptr
115: movd 4(sb),_saved_storeptr
116: movd r0,_saved_ptrs
117: movd r1,_saved_ptrs+4
118: movd r2,_saved_ptrs+8
119: movd r3,_saved_ptrs+12
120: movd r4,_saved_ptrs+16
121: movd r5,_saved_nonptrs
122: movd r6,_saved_nonptrs+4
123: movd r7,_saved_nonptrs+8
124: lprd sp,_bottom
125: lprd fp,_fpsave
126: lprw mod,_saved_cmodreg
127: lprd sb,_saved_csbreg
128: exit [r0,r1,r2,r3,r4,r5,r6,r7]
129: ret $0
130:
131: _restoreregs:
132: /* .word 0x4000 /* What is this for on the VAX??? */
133: /* Is it the register mask, for C calls? */
134: enter [r0,r1,r2,r3,r4,r5,r6,r7],$0
135: sprd fp,_fpsave
136: sprd sp,_bottom
137: sprd sb,_saved_csbreg
138: sprw mod,_saved_cmodreg
139: movd _saved_nonptrs,r5
140: movd _saved_nonptrs+4,r6
141: movd _saved_nonptrs+8,r7
142: movd _saved_dataptr,r0
143: addqd $4,r0
144: lprd fp,r0
145: addr _mlmodreg,r0
146: lprw mod,r0 /* _mlmodreg had better be below 64K */
147: lprd sb,0(r0) /* this will always be _mlsbreg */
148: movd _saved_exnptr,0(sb)
149: movd _saved_storeptr,4(sb)
150: #ifdef BSD
151: movd $0,TOS
152: bsr ?_sigsetmask
153: adjspb $-4
154: #endif
155: #ifdef V9
156: bsr ?_setupsignals
157: #endif
158: movd _saved_ptrs,r0
159: movd _saved_ptrs+4,r1
160: movd _saved_ptrs+8,r2
161: movd _saved_ptrs+12,r3
162: movd _saved_ptrs+16,r4
163: go: movd _saved_pc,tos
164: ret $0
165:
166: /* Floating exceptions raised (assuming ROP's are never passed to functions):
167: * DIVIDE BY ZERO - (div)
168: * OVERFLOW/UNDERFLOW - (add,div,sub,mul) as appropriate
169: *
170: * floor raises integer overflow if the float is out of 32-bit range,
171: * so the float is tested before conversion, to make sure it is in (31-bit)
172: * range */
173:
174: Closure(_floor_v)
175: floorld 0(r0),r6
176: ashd $1,r6
177: ord $1,r6
178: movd r6,r0
179: movd 0(r1),r5
180: jump 0(r5)
181:
182: /*
183: * I don't know whether this routine is supposed to get
184: * the log base 2, or one more than that.
185: * On the Vax, it seems to do the latter, although in
186: * my port to the Sony, it does the former.
187: */
188: Closure(_logb_v)
189: movd 4(r0),r6 /* Second half, containing exponent */
190: bicd $0x800fffff,r6 /* grab only the exponent */
191: ashd $-19,r6 /* move into position */
192: subd $2046,r6 /* unbias */
193: ord $1,r6 /* convert to ML int */
194: movd r6,r0 /* give as arg to cont */
195: movd 0(r1),r5 /* follow cont */
196: jump 0(r5)
197:
198: Closure(_scalb_v)
199: /* args: float and incr */
200: movd 4(r0),r6
201: bicd $1,r6 /* grab add value */
202: cmpqd $0,r6
203: beq .Lnoth /* 0? */
204: ashd $3,r6 /* shift to exponent field */
205: movd 0(r0),r0 /* grab old float */
206: movd 4(r0),r7
207: bicd $0x800fffff,r7 /* grab exponent */
208: ashd $-16,r7 /* move to vax exp field */
209: addd r6,r7 /* check out the new exponent */
210: cmpd r7,$0
211: ble under /* too small? */
212: cmpd r7,$0x8000
213: bge over /* too large? */
214: ashd $16,r6 /* move to ns32 exp field */
215: addd 4(r0),r6
216: movd r6,4(fp) /* place second half of float */
217: movd 0(r0),0(fp) /* place first half of float */
218: movd $mak_desc(8,tag_string),-4(fp) /* place tag */
219: sprd fp,r0 /* return value is new float */
220: addr 12(fp),r5 /* update freespace pointer */
221: lprd fp,r5
222: movd 0(r1),r5 /* follow cont */
223: jump 0(r5)
224: .Lnoth: movd 0(r0),r0 /* return original float */
225: movd 0(r1),r5 /* follow cont */
226: jump 0(r5)
227: over: movzbd $0,4(fp) /* make space */
228: addr .Loflw,r0
229: br _raise_real
230: under: movzbd $0,4(fp) /* make space */
231: addr .Luflw,r0
232: br _raise_real
233:
234: _raise_real:
235: /* Danger: syntax of the C macro _real_e may matter here! */
236: addr _real_e,4(fp) /* allocate arg record for exception */
237: movd r0,0(fp)
238: movd $mak_desc(2,tag_record),-4(fp)
239: sprd fp,r0 /* arg to handler is exception value */
240: addr 12(fp),r5
241: lprd fp,r5 /* update freespace pointer */
242: movd 0(sb),r1 /* get handler's cont */
243: movd 0(r1),r5 /* jump to handler */
244: jump 0(r5)
245:
246: Closure(_syscall_v) /* ARGS: call#, arglist, argcount */
247: movzbd $0,20(fp) /* ensure enough space */
248: movd 8(r0),r6
249: ashd $-1,r6 /* r6 = argcount */
250: movzbd $0,r7 /* r7 = 0 */
251: movd 4(r0),r4 /* r4 = arglist */
252: .Largloop:
253: cmpqd $0,r6
254: bge .Largdone
255: addqd $-1,r6
256: addqd $1,r7
257: movd 0(r4),r2 /* r2 = hd(r4) */
258: movd 4(r4),r4 /* r4 = tl(r4) */
259: tbitb $0,r2 /* test tag bit of r2 */
260: bfs .Largint
261: movd r2,0(fp)[r7:d] /* place arg */
262: br .Largloop
263: .Largint:
264: movd r2,r5 /* convert from ML to C int */
265: ashd $-1,r5
266: movd r5,0(fp)[r7:d] /* place arg */
267: br .Largloop
268: .Largdone:
269: movd 8(r0),r5
270: ashd $-1,r5
271: movd r5,0(fp) /* place argcount */
272: movd 0(r0),r0 /* ML int call# */
273: ashd $-1,r0 /* call# in r0 */
274: movd r1,r5 /* save our continuation */
275: addr 4(fp),r1 /* addr of first arg in r1 */
276: movzbd $0,r2 /* clear r2, why? */
277: svc
278: bcs .Lsyslose
279: addd r0,r0 /* convert result to ML int */
280: addqd $1,r0
281: movd r5,r1 /* restore cont */
282: movd 0(r1),r5 /* follow cont */
283: jump 0(r5)
284: .Lsyslose:
285: movd r0,_errno
286: movd $-1,r0 /* system call lost */
287: movd r5,r1 /* restore cont */
288: movd 0(r1),r5 /* follow cont */
289: jump 0(r5)
290:
291: Closure(_callc_v)
292: movd r1,TOS
293: movd 4(r0),TOS
294: movd 0(r0),r5
295: lprw mod,_saved_cmodreg /* keep C happy, just in case */
296: lprd sb,_saved_csbreg
297: jsr 0(r5) /* call C routine */
298: adjspb $-4 /* pop single C arg */
299: addr _mlmodreg,r5 /* put ml mod and sb back */
300: lprw mod,r5
301: lprd sb,0(r5)
302: movd TOS,r1
303: movzbd $0,r2
304: movzbd $0,r3
305: movzbd $0,r4
306: movzbd $0,r5
307: cmpqd $0,_cause
308: bne _saveregs
309: movd 0(r1),r5
310: jump 0(r5)
311:
312: /* this bogosity is for export.c */
313: .globl _startptr
314: _startptr: .double start
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.