![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to MIPS.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 MIPS.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 stdarg 2
6: #define stdcont 3
7: #define stdclos 4
8: #define storeptr 22
9: #define dataptr 23
10: #define exnptr 30
11: #define artemp1 24
12: #define artemp2 25
13: #define artemp3 20
14: #define ptrtemp 21
15: #define String(handle,len,str) .align 2;\
16: .set noreorder;\
17: .word len*power_tags+tag_string;\
18: handle: .ascii str;\
19: .set reorder
20: #define Closure(name) .align 2;\
21: .set noreorder;\
22: .word mak_desc(1,tag_record);\
23: name: .word 9f; /* address of routine */ \
24: .word 1; /* here for historical reasons */\
25: .word tag_backptr;\
26: .set reorder;\
27: 9:
28: .data
29: bottom: .word 0 /* C's saved stack pointer */
30: saved_pc_diff: .word 0
31:
32:
33: .text
34:
35: .globl runvec
36: .align 2
37: .word mak_desc(8,tag_record)
38: runvec:
39: .word array_v
40: .word callc_v
41: .word create_b_v
42: .word create_s_v
43: .word floor_v
44: .word logb_v
45: .word scalb_v
46: .word syscall_v
47:
48: Closure(array_v)
49: lw $artemp1,0($stdarg) /* tagged length in $artemp1 */
50: lw $10,4($stdarg) /* get initial value in $10 */
51: sra $artemp1,1 /* drop the tag bit */
52: sll $artemp2,$artemp1,width_tags /* length for descr into $artemp2 */
53: ori $artemp2,tag_array /* complete descriptor into $artemp2 */
54: sll $artemp1,2 /* get length in bytes into $artemp1 */
55: .set noreorder /* can't reorder because collection might occur */
56: add $artemp3,$artemp1,$dataptr /* $artemp3 points to last word
57: of new array*/
58: badgc1: sw $0,($artemp3) /* clear; causes allocation */
59: .set reorder /* can rearrange instructions again */
60: sw $artemp2,0($dataptr) /* store the descriptor */
61: add $dataptr,4 /* points to new object */
62: add $artemp3,$artemp1,$dataptr /* beyond last word of new array*/
63: add $stdarg,$dataptr,$0 /* put ptr in return register
64: (return val = arg of continuation) */
65: b 2f
66: 1: sw $10,0($dataptr) /* store the value */
67: addi $dataptr,4 /* on to the next word */
68: 2: bne $dataptr,$artemp3,1b /* if not off the end, repeat */
69:
70:
71: lw $10,0($stdcont) /* grab continuation */
72: j $10 /* return */
73:
74: Closure(create_b_v)
75: addi $artemp3,$0,tag_bytearray /* tag into $artemp3 */
76: b 2f
77: Closure(create_s_v)
78: addi $artemp3,$0,tag_string /* tag into $artemp3 */
79: 2:
80: addi $artemp1,$stdarg,13 /* $2n+14$ */
81: sra $artemp1,3 /* number of words in string+tag */
82: sll $artemp1,2 /* # of bytes allocated for str+tag */
83: .set noreorder /* don't cross gc boundary */
84: add $artemp2,$artemp1,$dataptr /* beyond last word of string */
85: badgc2: sw $0,-4($artemp2) /* clear last; causes allocation */
86: .set reorder
87: sra $artemp2,$stdarg,1 /* untagged length in bytes */
88: sll $artemp2,width_tags /* room for descriptor */
89: or $artemp2,$artemp3 /* descriptor */
90: sw $artemp2,0($dataptr) /* store descriptor */
91: addi $stdarg,$dataptr,4 /* pointer to new string */
92: add $dataptr,$artemp1 /* advance; save 1 instruction */
93: lw $10,0($stdcont) /* grab continuation */
94: j $10 /* return */
95:
96: .globl saveregs
97: .globl handle_c
98: .globl return_c
99: .globl restoreregs
100: .ent restoreregs
101: restoreregs:
102: #define regspace 44
103: #define localspace 4
104: #define argbuild 16
105: #define framesize (regspace+localspace+argbuild) /* must be multiple of 8 */
106: #define frameoffset (0-localspace)
107: subu $sp,framesize
108: .mask 0xd0ff0000,0-localspace
109: sw $31,argbuild+40($sp)
110: sw $30,argbuild+36($sp)
111: sw $gp,argbuild+32($sp)
112: sw $23,argbuild+28($sp)
113: sw $22,argbuild+24($sp)
114: sw $21,argbuild+20($sp)
115: sw $20,argbuild+16($sp)
116: sw $19,argbuild+12($sp)
117: sw $18,argbuild+8($sp)
118: sw $17,argbuild+4($sp)
119: sw $16,argbuild($sp)
120:
121: .set noat
122: cfc1 $at,$31 /* grab fpa control register */
123: ori $at,$at,0x600 /* set O and Z bits */
124: ctc1 $at,$31 /* return fpa control register */
125: .set at
126:
127: sw $sp,bottom /* save C's stack pointer */
128: lw $artemp1,saved_pc
129: la $artemp2,badgc1
130: beq $artemp1,$artemp2,badpc
131: la $artemp2,badgc2
132: beq $artemp1,$artemp2,badpc
133:
134: b 1f
135: badpc:
136: subu $artemp1,4 /* adjust */
137: sw $artemp1,saved_pc /* save */
138: 1:
139:
140:
141: /* the big three: argument, continuation, closure */
142: lw $stdarg,saved_ptrs
143: lw $stdcont,saved_ptrs+4
144: lw $stdclos,saved_ptrs+8
145:
146: /* All the miscellaneous guys */
147: lw $5,saved_ptrs+12
148: lw $6,saved_ptrs+16
149: lw $7,saved_ptrs+20
150: lw $8,saved_ptrs+24
151: lw $9,saved_ptrs+28
152: lw $10,saved_ptrs+32
153: lw $11,saved_ptrs+36
154: lw $12,saved_ptrs+40
155: lw $13,saved_ptrs+44
156: lw $14,saved_ptrs+48
157: lw $15,saved_ptrs+52
158: lw $16,saved_ptrs+56
159: lw $17,saved_ptrs+60
160: lw $18,saved_ptrs+64
161: lw $19,saved_ptrs+68
162:
163: lw $21, saved_ptrs+72
164:
165: lw $artemp1,saved_pc
166: lw $31,saved_pc_diff
167: addu $31,$artemp1 /* mustn't overflow */
168: lw $artemp1,saved_nonptrs
169: lw $artemp2,saved_nonptrs+4
170: lw $artemp3,saved_nonptrs+8
171:
172: /* don't touch registers $26 and $27 */
173:
174: lw $storeptr,saved_storeptr
175: lw $dataptr,saved_dataptr
176: lw $exnptr,saved_exnptr
177:
178: .set noat /* This trick will cause a warning, but the code is OK */
179: lw $at,saved_pc /* grab the saved program counter */
180: j $at /* and continue executing at that spot */
181: .set at
182:
183: Closure(handle_c) /* exception handler for ML functions called from C */
184: li $artemp1,CAUSE_EXN
185: sw $artemp1,cause
186: b saveregs
187: Closure(return_c) /* continuation for ML functions called from C */
188: li $artemp1,CAUSE_RET
189: sw $artemp1,cause
190: saveregs:
191: /* needn't save $1 */
192: /* the big three: argument, continuation, closure */
193: sw $stdarg,saved_ptrs
194: sw $stdcont,saved_ptrs+4
195: sw $stdclos,saved_ptrs+8
196:
197: /* All the miscellaneous guys */
198: sw $5,saved_ptrs+12
199: sw $6,saved_ptrs+16
200: sw $7,saved_ptrs+20
201: sw $8,saved_ptrs+24
202: sw $9,saved_ptrs+28
203: sw $10,saved_ptrs+32
204: sw $11,saved_ptrs+36
205: sw $12,saved_ptrs+40
206: sw $13,saved_ptrs+44
207: sw $14,saved_ptrs+48
208: sw $15,saved_ptrs+52
209: sw $16,saved_ptrs+56
210: sw $17,saved_ptrs+60
211: sw $18,saved_ptrs+64
212: sw $19,saved_ptrs+68
213:
214: sw $21, saved_ptrs+72
215:
216: sw $artemp1,saved_nonptrs
217: sw $artemp2,saved_nonptrs+4
218: sw $artemp3,saved_nonptrs+8
219:
220: /* don't touch registers $26 and $27 */
221:
222: sw $storeptr,saved_storeptr
223: sw $dataptr,saved_dataptr
224: sw $exnptr,saved_exnptr
225:
226: lw $artemp1,saved_pc
227: subu $artemp1,$31,$artemp1 /* mustn't overflow */
228: sw $artemp1,saved_pc_diff
229:
230:
231: lw $sp,bottom /* recover C's stack pointer */
232: lw $31,argbuild+40($sp)
233: lw $30,argbuild+36($sp)
234: lw $gp,argbuild+32($sp)
235: lw $23,argbuild+28($sp)
236: lw $22,argbuild+24($sp)
237: lw $21,argbuild+20($sp)
238: lw $20,argbuild+16($sp)
239: lw $19,argbuild+12($sp)
240: lw $18,argbuild+8($sp)
241: lw $17,argbuild+4($sp)
242: lw $16,argbuild($sp)
243:
244:
245: addu $sp,framesize
246: j $31 /* return to C program */
247: .end restoreregs
248:
249: Closure(callc_v)
250: sw $stdcont,argbuild+regspace($sp) /* save continuation on stack */
251: lw $4,4($stdarg) /* get value a into arg register */
252: lw $10,0($stdarg) /* get address of f into misc reg */
253: jal $10 /* call f ($31 can be trashed) */
254: move $stdarg,$2 /* return val is argument to continuation */
255: lw $stdcont,argbuild+regspace($sp) /* recover continuation */
256: move $stdclos,$0
257: move $5,$0
258: move $6,$0
259: move $7,$0
260: move $8,$0
261: move $9,$0
262: move $10,$0
263: move $11,$0
264: move $12,$0
265: move $13,$0
266: move $14,$0
267: move $15,$0
268: /* $16--$23 and $30 are saved by the callee */
269:
270: lw $artemp3,cause /* get cause */
271: bne $artemp3,$0,saveregs /* if cause != 0, save ML & return to C */
272: lw $10,0($stdcont) /* grab continuation */
273: j $10 /* return */
274: Closure(syscall_v)
275: sw $stdcont,argbuild+regspace($sp) /* save continuation on stack */
276: lw $artemp1,8($stdarg) /* 2*argc+1 in $artemp1 */
277: sra $artemp1,1 /* argc in $artemp1 */
278: move $16,$sp /* save our $sp */
279: ble $artemp1,4,1f /* big enough */
280: sub $artemp2,$artemp1,3 /* (temp2 = argc - 4 + 1) > 1 */
281: sra $artemp2,1
282: sll $artemp2,3 /* temp2 = 4 * roundup (argc-4,2) */
283: subu $sp,$artemp2 /* increase stack */
284: 1:
285:
286: lw $ptrtemp,4($stdarg) /* argv in $ptrtemp */
287: move $artemp2,$sp /* destination in $artemp2 */
288: b 1f /* branch forward to test */
289: 2: /* argc > 0 */
290: lw $artemp3,0($ptrtemp) /* get list element */
291: andi $10,$artemp3,1 /* tagged? */
292: beqz $10,3f
293: sra $artemp3,1 /* drop tag bit */
294: 3: sw $artemp3,0($artemp2) /* save the argument */
295: lw $ptrtemp,4($ptrtemp) /* next element */
296: add $artemp2,4 /* next arg build area */
297: sub $artemp1,1 /* --argc */
298: 1: bgtz $artemp1,2b /* if argc>0, store another */
299:
300: lw $4,0($sp)
301: lw $5,4($sp)
302: lw $6,8($sp)
303: lw $7,12($sp)
304:
305: 9: lw $2,0($stdarg) /* get syscall # in $2; trash $stdarg */
306: sra $2,1 /* throw out the tag bit */
307: syscall
308: move $sp,$16 /* recover the good stack pointer */
309: lw $stdcont,argbuild+regspace($sp) /* recover continuation */
310: bnez $7,1f /* if error, return ~1 */
311: move $stdarg,$2 /* return val is argument to continuation */
312: add $stdarg,$stdarg /* double return value */
313: addi $stdarg,1 /* and add tag bit */
314: b 2f
315: 1: sw $stdarg,errno
316: li $stdarg,-1
317: 2:
318: move $stdclos,$0
319: move $5,$0
320: move $6,$0
321: move $7,$0
322: move $8,$0
323: move $9,$0
324: move $10,$0
325: move $11,$0
326: move $12,$0
327: move $13,$0
328: move $14,$0
329: move $15,$0
330: /* $16--$23 and $30 are saved by the callee */
331:
332: lw $10,0($stdcont) /* grab continuation */
333: j $10 /* return */
334:
335: /* Floating exceptions raised (assuming ROP's are never passed to functions):
336: * DIVIDE BY ZERO - (div)
337: * OVERFLOW/UNDERFLOW - (add,div,sub,mul) as appropriate
338: *
339: * floor raises integer overflow if the float is out of 32-bit range,
340: * so the float is tested before conversion, to make sure it is in (31-bit)
341: * range */
342:
343: Closure(floor_v)
344: lwc1 $f4,0($stdarg) /* get least significant word */
345: lwc1 $f5,4($stdarg) /* get most significant word */
346: .set noat
347: cfc1 $at,$31 /* grab fpa control register */
348: ori $at,0x03 /* set rounding bits to 11 */
349: ctc1 $at,$31 /* return fpa control register */
350: .set at
351: cvt.w.d $f6,$f4 /* convert to integer */
352: .set noat
353: cfc1 $at,$31 /* grab fpa control register */
354: ori $at,0x03 /* set rounding bits to 11 */
355: xori $at,0x03 /* set rounding bits to 00
356: ctc1 $at,$31 /* return fpa control register */
357: .set at
358: mfc1 $stdarg,$f6 /* get in std argument register */
359: sll $stdarg,1 /* make room for tag bit */
360: add $stdarg,1 /* add the tag bit */
361: lw $10,0($stdcont) /* grab continuation */
362: j $10 /* return */
363:
364:
365: Closure(logb_v)
366: lw $stdarg,4($stdarg) /* most significant part */
367: srl $stdarg,20 /* throw out 20 low bits */
368: andi $stdarg,0x07ff /* clear all but 11 low bits */
369: sub $stdarg,1023 /* subtract 1023 */
370: sll $stdarg,1 /* make room for tag bit */
371: add $stdarg,1 /* add the tag bit */
372: lw $10,0($stdcont) /* grab continuation */
373: j $10 /* return */
374:
375: Closure(scalb_v)
376: lw $artemp1,4($stdarg) /* get tagged n */
377: sra $artemp1,1 /* get real n */
378: beqz $artemp1,9f /* if zero, return the old float */
379: lw $ptrtemp,0($stdarg) /* get pointer to float */
380: lw $artemp2,4($ptrtemp) /* most significant part */
381: srl $artemp2,20 /* throw out 20 low bits */
382: andi $artemp2,0x07ff /* clear all but 11 low bits */
383: add $artemp3,$artemp2,$artemp1 /* new := old + n */
384: blt $artemp3,1,under /* punt if underflow */
385: bgt $artemp3,2046,over /* or overflow */
386: xor $artemp3,$artemp2 /* at3 = new xor old */
387: sll $artemp3,20 /* put exponent in right position */
388: lw $artemp2,4($ptrtemp) /* most significant word */
389: xor $artemp2,$artemp3 /* change to new exponent */
390: .set noreorder
391: sw $artemp2,8($dataptr) /* allocate; may cause gc */
392: .set reorder
393: lw $artemp2,0($ptrtemp) /* get least significant word */
394: li $10,mak_desc(8,tag_string) /* make descriptor */
395: sw $artemp2,4($dataptr) /* save lsw */
396: sw $10,0($dataptr) /* save descriptor */
397: add $stdarg,$dataptr,4 /* get pointer to new float */
398: add $dataptr,12 /* point to new free word */
399: lw $10,0($stdcont) /* grab continuation */
400: j $10 /* return */
401:
402: 9: lw $stdarg,0($stdarg) /* get old float */
403: lw $10,0($stdcont) /* grab continuation */
404: j $10 /* return */
405:
406: over: la $stdarg,1f /* exception name in $stdarg */
407: b raise_real
408: String(1,8,"overflow")
409: under: la $stdarg,1f /* exception name in $stdarg */
410: b raise_real
411: String(1,9,"underflow\0\0\0")
412:
413: raise_real:
414: /* build new record to pass to exception handler */
415: /* [descriptor]
416: /* [exception (string)]
417: /* [real_e (more exception info)]
418: */
419: la $10,real_e /* get address of real_e */
420: .set noreorder
421: sw $10,8($dataptr) /* allocate; may cause gc */
422: .set reorder
423: sw $stdarg,4($dataptr)
424: li $10,mak_desc(2,tag_record)
425: sw $10,0($dataptr)
426: add $stdarg,$dataptr,4 /* new record is argument */
427: addi $dataptr,12 /* $dataptr restored */
428: move $stdclos,$exnptr /* make sure closure is right */
429: lw $10,0($exnptr) /* grab handler */
430: j $10 /* raise the exception */
431:
432: /* this bogosity is for export.c */
433: .globl startptr
434: startptr: .word __start /* just a guess... */
435:
436:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.