![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to VAX.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 VAX.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: .long 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-7 can contain only pointers or tagged integers
14: r8 is the data limit
15: registers 9-10 can contain anything except pointers
16: r11 is the store pointer
17: r12 is the data ptr
18: r13 is the exception handler
19: r14 is the stack pointer (mostly unused)
20: r15 is the program counter
21: */
22: #define Closure(name) .align 2;\
23: .long mak_desc(1,tag_record);\
24: name: .long 9f;\
25: .long 1;\
26: .long tag_backptr;\
27: 9:
28:
29: .text
30: .globl _runvec
31: .align 2
32: .long mak_desc(8,tag_record)
33: _runvec:
34: .long _array_v
35: .long _callc_v
36: .long _create_b_v
37: .long _create_s_v
38: .long _floor_v
39: .long _logb_v
40: .long _scalb_v
41: .long _syscall_v
42:
43: Closure(_array_v)
44: 4: ashl $-1,(r0),r9 /* r9 = length */
45: ashl $2,r9,r10
46: addl2 r12,r10
47: addl2 $0x80000000,r10
48: subl2 $4096,r10
49: addl2 r8,r10
50: jgeq 3f
51: ashl $width_tags,r9,r10
52: bisl3 $tag_array,r10,-4(r12)
53: movl 4(r0),r2 /* r2 = initial value */
54: movl r12,r0
55: jbr 2f
56: 1: movl r2,(r12)+ /* store default */
57: 2: sobgeq r9,1b
58: addl2 $4,r12
59: jmp *(r1)
60: 3: movl $0x7fffffff,r8
61: addl3 r12,r8,r9 /* guaranteed to fault */
62: jbr 4b
63:
64: Closure(_create_b_v)
65: movl $tag_bytearray,r4
66: jbr 2f
67: Closure(_create_s_v)
68: movl $tag_string,r4
69: 2: addl3 $13,r0,r10
70: ashl $-3,r10,r10
71: ashl $2,r10,r10 /* r9 = bytes in string including tag */
72: movl r10,r9
73: addl2 r12,r10
74: addl2 $0x80000000,r10
75: subl2 $4096,r10
76: addl2 r8,r10
77: jgeq 3f
78: ashl $-1,r0,r10 /* r10 = length */
79: ashl $width_tags,r10,r10
80: bisl3 r4,r10,-4(r12) /* new tag */
81: movl r12,r0
82: addl2 r9,r12
83: jmp *(r1)
84: 3: movl $0x7fffffff,r8
85: addl3 r12,r8,r9 /* guaranteed to fault */
86: jbr 2b
87:
88: .globl _saveregs
89: .globl _handle_c
90: .globl _return_c
91: .globl _restoreregs
92: Closure(_handle_c)
93: movl $CAUSE_EXN,_cause;
94: jbr _saveregs
95: Closure(_return_c)
96: movl $CAUSE_RET,_cause;
97: _saveregs:
98: subl3 $4,r12,_saved_dataptr
99: movl r13,_saved_exnptr
100: movl r11,_saved_storeptr
101: movq r0,_saved_ptrs
102: movq r2,_saved_ptrs+8
103: movq r4,_saved_ptrs+16
104: movq r6,_saved_ptrs+24
105: /* movl r8,_saved_limit */
106: movq r9,_saved_nonptrs
107: movl _bottom,sp
108: movl _fpsave,fp
109: ret
110:
111: _restoreregs:
112: .word 0x4000
113: movl fp,_fpsave
114: movl sp,_bottom
115: movq _saved_nonptrs,r9
116: addl3 $4,_saved_dataptr,r12
117: movl _saved_exnptr,r13
118: movl _saved_storeptr,r11
119: #ifdef BSD
120: pushl $0
121: calls $1,_sigsetmask
122: #endif
123: #ifdef V9
124: calls $0,_setupsignals
125: #endif
126: subl3 _saved_limit,$0x7fffffff,r8
127: incl r8
128: movq _saved_ptrs,r0
129: movq _saved_ptrs+8,r2
130: movq _saved_ptrs+16,r4
131: movq _saved_ptrs+24,r6
132: go: jmp *_saved_pc
133:
134: /* Floating exceptions raised (assuming ROP's are never passed to functions):
135: * DIVIDE BY ZERO - (div)
136: * OVERFLOW/UNDERFLOW - (add,div,sub,mul) as appropriate
137: *
138: * floor raises integer overflow if the float is out of 32-bit range,
139: * so the float is tested before conversion, to make sure it is in (31-bit)
140: * range */
141:
142: Closure(_floor_v)
143: .byte 0xfd; cvtfl (r0),r9 # cvtgl
144: .byte 0xfd; tstf (r0) # tstg
145: bgeq 1f
146: .byte 0xfd; cvtlf r9,r4 # cvtlg, to handle negative
147: .byte 0xfd; cmpf (r0),r4 # cmpg
148: beql 2f
149: decl r9
150: 2: clrq r4
151: 1: ashl $1,r9,r9
152: bisl3 $1,r9,r0
153: jmp *(r1)
154:
155: Closure(_logb_v)
156: bicl3 $0xffff800f,(r0),r9 # grab exponent
157: ashl $-3,r9,r9
158: subl2 $2048,r9 # unbias
159: bisl3 $1,r9,r0
160: jmp *(r1)
161:
162: Closure(_scalb_v)
163: addl3 r12,r8,r9
164: bicl3 $1,4(r0),r9 # grab add value
165: beql 1f # 0?
166: ashl $3,r9,r9 # shift to exponent field
167: movl (r0),r0 # grab old float
168: bicl3 $0xffff800f,(r0),r10 # grab exponent
169: addl2 r9,r10 # check out the new exponent
170: bleq under # too small?
171: cmpl r10,$0x8000
172: bgeq over # too large?
173: movl 4(r0),4(r12)
174: addl3 (r0),r9,(r12)
175: movl $mak_desc(8,tag_string),-4(r12)
176: movl r12,r0
177: addl2 $12,r12
178: jmp *(r1)
179: 1: movl (r0),r0
180: jmp *(r1)
181: over: moval 1f,r0
182: jbr _raise_real
183: String(1,8,"overflow")
184: under: moval 1f,r0
185: jbr _raise_real
186: String(1,9,"underflow\0\0\0")
187:
188: _raise_real:
189: addl3 r12,r8,r9 /* ensure enough space */
190: moval _real_e,4(r12)
191: movl r0,(r12)
192: movl $mak_desc(2,tag_record),-4(r12)
193: movl r12,r0
194: addl2 $12,r12
195: movl r13,r1
196: jmp *(r13)
197:
198: Closure(_syscall_v) /* ARGS: call#, arglist, argcount */
199: addl3 r12,r8,r9 /* ensure enough space */
200: ashl $-1,8(r0),r9
201: clrl r10
202: movl 4(r0),r5
203: 1: tstl r9
204: jleq 2f
205: decl r9
206: incl r10
207: movl (r5),r2
208: movl 4(r5),r5
209: jlbs r2,3f
210: movl r2,(ap)[r10]
211: jbr 1b
212: 3: ashl $-1,r2,(ap)[r10]
213: jbr 1b
214: 2: ashl $-1,8(r0),(ap)
215: ashl $-1,(r0),r0
216: clrl r2
217: chmk r0
218: jcs 1f
219: addl2 r0,r0
220: incl r0
221: jmp *(r1)
222: 1: movl r0,_errno
223: movl $-1,r0
224: jmp *(r1)
225:
226: Closure(_callc_v)
227: pushl r1
228: pushl 4(r0)
229: calls $1,*(r0)
230: movl (sp)+,r1
231: clrq r2
232: clrq r4
233: tstl _cause
234: jneq _saveregs
235: jmp *(r1)
236:
237: /* this bogosity is for export.c */
238: .globl _startptr
239: _startptr: .long start
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.