![[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.