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