![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to M68.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 M68.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: a0 = arg ! 10: a1 = continuation ! 11: a2 = closure; can be ignored because contains no free vars ! 12: a3,a4 = general purpose pointers ! 13: a5 = pointer temp ! 14: a6 = data ptr ! 15: a7 = stack ptr ! 16: d0 = unused ! 17: d1,d2,d4 = arithtemps ! 18: d3 = pointer temp ! 19: d5 = data limit ! 20: d6 = store ptr ! 21: d7 = exception handler ! 22: */ ! 23: #define Closure(name) .align 2;\ ! 24: .long mak_desc(1,tag_record);\ ! 25: name: .long 7f;\ ! 26: .long 1;\ ! 27: .long tag_backptr;\ ! 28: 7: ! 29: ! 30: .text ! 31: .globl _runvec ! 32: .align 2 ! 33: .long mak_desc(8,tag_record) ! 34: _runvec: ! 35: .long _array_v ! 36: .long _callc_v ! 37: .long _create_b_v ! 38: .long _create_s_v ! 39: .long _floor_v ! 40: .long _logb_v ! 41: .long _scalb_v ! 42: .long _syscall_v ! 43: ! 44: Closure(_array_v) ! 45: movl a0@,d1 /* a0 = (int * int) */ ! 46: movl a0@(4),d3 /* d3 = initial value */ ! 47: asrl #1,d1 /* d1 = length */ ! 48: movl d1,d2 ! 49: asll #width_tags,d2 ! 50: orl #tag_array,d2 /* d2 = new tag */ ! 51: asll #2,d1 ! 52: 3: movl a6,d4 ! 53: addl d1,d4 ! 54: cmpl d4,d5 ! 55: jmi 6f ! 56: movl d2,a6@+ ! 57: movl a6,a0 ! 58: jra 2f ! 59: 1: movl d3,a6@+ /* store default */ ! 60: 2: subql #4,d1 ! 61: jge 1b ! 62: movl a1@,a2 ! 63: jmp a2@ ! 64: ! 65: clrl d0 ! 66: 6: trapmi ! 67: jra 3b ! 68: ! 69: Closure(_create_b_v) ! 70: movl #tag_bytearray,d3 ! 71: jra 2f ! 72: Closure(_create_s_v) ! 73: movl #tag_string,d3 ! 74: 2: movl a0,d1 ! 75: asrl #1,d1 /* d1 = length */ ! 76: movl d1,d2 ! 77: asll #width_tags,d2 ! 78: addl d3,d2 /* d2 = new tag */ ! 79: andl #~3,d1 /* d1+4 = bytes in string, not including tag */ ! 80: 3: movl a6,d4 ! 81: addl d1,d4 ! 82: cmpl d4,d5 ! 83: jmi 1f ! 84: movl d2,a6@+ ! 85: movl a6,a0 ! 86: addl d1,a6 ! 87: clrl a6@+ /* must clear the last 4 bytes */ ! 88: movl a1@,a2 ! 89: jmp a2@ ! 90: ! 91: clrl d0 ! 92: 1: trapmi ! 93: jra 3b ! 94: ! 95: #define RAISE \ ! 96: movl d7,a1 ; \ ! 97: movl a1@,a2 ; \ ! 98: jra a2@ ! 99: ! 100: .align 2 ! 101: .globl _handleinterrupt ! 102: _handleinterrupt: ! 103: movl #0,sp@- ! 104: jsr _sigsetmask ! 105: movl _bottom, sp ! 106: clrl d3 ! 107: movl d3,a0 ! 108: movl d3,a1 ! 109: movl d3,a2 ! 110: movl d3,a3 ! 111: movl d3,a4 ! 112: movl d3,a5 ! 113: lea _interrupt_e,a0 ! 114: RAISE ! 115: ! 116: .globl _saveregs ! 117: .globl _handle_c ! 118: .globl _return_c ! 119: .globl _restoreregs ! 120: Closure(_handle_c) ! 121: movl #CAUSE_EXN,_cause; ! 122: jra _saveregs ! 123: ! 124: Closure(_return_c) ! 125: movl #CAUSE_RET,_cause; ! 126: _saveregs: ! 127: movl a6,_saved_dataptr ! 128: movl d7,_saved_exnptr ! 129: movl d6,_saved_storeptr ! 130: movl d5,_saved_limit ! 131: movl a0,_saved_ptrs ! 132: movl a1,_saved_ptrs+4 ! 133: movl a2,_saved_ptrs+8 ! 134: movl a3,_saved_ptrs+12 ! 135: movl a4,_saved_ptrs+16 ! 136: movl a5,_saved_ptrs+20 ! 137: movl d3,_saved_ptrs+24 ! 138: movl d1,_saved_nonptrs ! 139: movl d2,_saved_nonptrs+4 ! 140: movl d4,_saved_nonptrs+8 ! 141: movl _bottom,sp ! 142: movl _fpsave,a6 ! 143: #ifdef MACH ! 144: moveml sp@+, a0-a5/d0-d7 ! 145: #endif MACH ! 146: rts ! 147: ! 148: _restoreregs: ! 149: #ifdef MACH ! 150: /* C requires callee to save, and NeXT/MACH compiler uses registers */ ! 151: moveml a0-a5/d0-d7,sp@- ! 152: #endif MACH ! 153: movl a6,_fpsave ! 154: movl sp,_bottom ! 155: movl _saved_dataptr,a6 ! 156: movl _saved_exnptr,d7 ! 157: movl _saved_storeptr,d6 ! 158: movl _saved_limit,d5 ! 159: movl _saved_ptrs,a0 ! 160: movl _saved_ptrs+4,a1 ! 161: movl _saved_ptrs+8,a2 ! 162: movl _saved_ptrs+12,a3 ! 163: movl _saved_ptrs+16,a4 ! 164: movl _saved_ptrs+20,a5 ! 165: movl _saved_ptrs+24,d3 ! 166: movl _saved_nonptrs,d1 ! 167: movl _saved_nonptrs+4,d2 ! 168: movl _saved_nonptrs+8,d4 ! 169: go: movl _saved_pc,sp@- ! 170: rts ! 171: ! 172: /* Floating point primitives ! 173: * ! 174: * All the m68code for ML reals assumes that NaN's and INF's are never ! 175: * generated and therefore do not need to be handled. ! 176: * This code does not produce NaN's or INF's as long as none are passed to it ! 177: * and overflow, underflow, and operr are handled. ! 178: * ! 179: * Floating exceptions raised (assuming NaN's and INF's are never passed to ! 180: * functions): ! 181: * OPERR - (div) for 0.0/0.0 (does NOT also cause DZ) ! 182: * DZ - (div) for (in range) / 0.0 ! 183: * OVERFLOW/UNDERFLOW - (add,div,sub,mul) as appropriate */ ! 184: ! 185: Closure(_floor_v) ! 186: fmoved a0@,fp0 ! 187: ftstx fp0 | handle positive and negative cases separately ! 188: fblt 1f ! 189: /* positive numbers */ ! 190: fintrzx fp0,fp0 | round towards zero (down) ! 191: fmovel fp0,d0 ! 192: asll #1,d0 ! 193: trapv ! 194: addql #1,d0 ! 195: movl d0,a0 ! 196: movl a1@,a2 ! 197: jmp a2@ ! 198: /* negative numbers */ ! 199: 1: fintrzx fp0,fp1 | round towards zero (up) ! 200: fmovel fp1,d0 ! 201: asll #1,d0 ! 202: trapv ! 203: fcmpx fp0,fp1 ! 204: fjeq 1f ! 205: subql #1,d0 ! 206: trapv ! 207: movl d0,a0 ! 208: movl a1@,a2 ! 209: jmp a2@ ! 210: 1: addql #1,d0 ! 211: movl d0,a0 ! 212: movl a1@,a2 ! 213: jmp a2@ ! 214: ! 215: /* returns 0 on 0. */ ! 216: Closure(_logb_v) ! 217: fgetexpd a0@,fp0 ! 218: fmovel fp0,d0 ! 219: asll #1,d0 ! 220: addql #1,d0 ! 221: movl d0,a0 ! 222: movl a1@,a2 ! 223: jmp a2@ ! 224: ! 225: Closure(_scalb_v) ! 226: lea 2f,a0 ! 227: RAISE ! 228: .align 2 ! 229: .long mak_desc(2,tag_record); ! 230: 2: .long 1f ! 231: .long _real_e ! 232: String(1,19,"scalb unimplemented\0") ! 233: ! 234: Closure(_callc_v) ! 235: movl a1,sp@- ! 236: movl a0@,a1 ! 237: movl a0@(4),sp@- ! 238: jsr a1@ ! 239: movl d0,a0 ! 240: addql #4,sp ! 241: movl sp@+,a1 ! 242: tstl _cause ! 243: jne _saveregs ! 244: movl a1@,a2 ! 245: jmp a2@ ! 246: ! 247: #ifdef sony_news ! 248: .data ! 249: .align 2 ! 250: _freestart: ! 251: .long 0 ! 252: .text ! 253: #endif sony_news ! 254: ! 255: Closure(_syscall_v) /* ARGS: call#, arglist, argcount */ ! 256: movl a0@(8),d0 /* arg count */ ! 257: asrl #1,d0 ! 258: movl d0,d1 ! 259: asll #2,d1 ! 260: subl d1,sp ! 261: movl sp,a2 ! 262: movl a0@(4),a3 ! 263: 1: subl #1,d0 ! 264: blt 2f ! 265: movl a3@,d1 ! 266: movl a3@(4),a3 ! 267: btst #0,d1 ! 268: jeq 3f ! 269: asrl #1,d1 ! 270: 3: movl d1,a2@+ ! 271: jra 1b ! 272: 2: pea 0 ! 273: movl a0@,d0 ! 274: asrl #1,d0 ! 275: movl d0,sp@- ! 276: #ifdef sony_news ! 277: movl a6,_freestart /* save help pointer */ ! 278: movl sp,a6 /* tell kernel args ptr */ ! 279: #endif sony_news ! 280: trap #0 ! 281: jcs 1f ! 282: #ifdef sony_news ! 283: movl _freestart,a6 /* restore heap pointer */ ! 284: #endif sony_news ! 285: movl a2,sp ! 286: addl d0,d0 ! 287: addql #1,d0 ! 288: movl d0,a0 ! 289: movl a1@,a2 ! 290: jmp a2@ ! 291: ! 292: #ifdef sony_news ! 293: 1: movl _freestart,a6 /* restore heap pointer */ ! 294: movl a2,sp ! 295: #else ! 296: 1: movl a2,sp ! 297: #endif sony_news ! 298: movl d0,_errno ! 299: movl #-1,d0 ! 300: movl d0,a0 ! 301: movl a1@,a2 ! 302: jmp a2@ ! 303: ! 304: ! 305: #ifndef sony_news ! 306: #ifndef MACH ! 307: .globl _minitfp_ /* checks for 68881 and sets flags */ ! 308: .globl _fp_state_mc68881 /* a flag that gets set */ ! 309: #define fp_enabled 2 /* from /usr/src/lib/libc/sun/crt/fpcrttypes.h */ ! 310: #endif MACH ! 311: #endif sony_news ! 312: .align 2 ! 313: /* Enable/disable float operand error, overflow, and div. If no 68881 ! 314: is present, nothing happens. */ ! 315: .globl _fpenable ! 316: .globl _fpdisable ! 317: _fpenable: ! 318: #ifndef sony_news ! 319: #ifndef MACH ! 320: jsr _minitfp_ /* checks for 68881 and sets flags. ! 321: normally executed on startup, ! 322: but won't be if compiled without ! 323: -f68881 (for possible sun/50 ! 324: compatibility). This is just ! 325: to make sure. */ ! 326: cmpl #fp_enabled,_fp_state_mc68881 ! 327: jne 1f ! 328: #endif MACH ! 329: #endif sony_news ! 330: fmovel #0x3400,fpcr ! 331: 1: rts ! 332: _fpdisable: ! 333: #ifndef sony_news ! 334: #ifndef MACH ! 335: cmpl #fp_enabled,_fp_state_mc68881 ! 336: jne 1f ! 337: #endif MACH ! 338: #endif sony_news ! 339: fmovel #0,fpcr ! 340: 1: rts ! 341: ! 342: /* From here on used to be M68.math.s */ ! 343: .text ! 344: .align 2 ! 345: .globl _mathvec ! 346: .long mak_desc(9,tag_record) ! 347: _mathvec: ! 348: .long _exp_e ! 349: .long _ln_e ! 350: .long _sqrt_e ! 351: .long _atan_v ! 352: .long _cos_v ! 353: .long _exp_v ! 354: .long _ln_v ! 355: .long _sin_v ! 356: .long _sqrt_v ! 357: end_mathvec: ! 358: ! 359: .align 2 ! 360: .globl _math_functor ! 361: Closure(_math_functor) ! 362: lea _mathvec,a0 ! 363: movl a1@,a2 ! 364: jmp a2@ ! 365: ! 366: .align 2 ! 367: .long mak_desc(2,tag_record) ! 368: _exp_e: .long 1 ! 369: .long 1f ! 370: .long mak_desc(1,tag_array) ! 371: 1: .long 1f ! 372: String(1,3,"Exp\0") ! 373: ! 374: .align 2 ! 375: .long mak_desc(2,tag_record) ! 376: _ln_e: .long 1 ! 377: .long 1f ! 378: .long mak_desc(1,tag_array) ! 379: 1: .long 1f ! 380: String(1,2,"Ln\0\0") ! 381: ! 382: .align 2 ! 383: .long mak_desc(2,tag_record) ! 384: _sqrt_e: ! 385: .long 1 ! 386: .long 1f ! 387: .long mak_desc(1,tag_array) ! 388: 1: .long 1f ! 389: String(1,4,"Sqrt") ! 390: ! 391: Closure(_sin_v) ! 392: fsind a0@,fp0 ! 393: finishfloat: ! 394: cmpl a6,d5 ! 395: trapmi ! 396: movl #mak_desc(8,tag_string),a6@+ ! 397: movl a6,a0 ! 398: fmoved fp0,a6@+ ! 399: movl a1@,a2 ! 400: jmp a2@ ! 401: ! 402: Closure(_cos_v) ! 403: fcosd a0@,fp0 ! 404: jra finishfloat ! 405: Closure(_ln_v) ! 406: flognd a0@,fp0 ! 407: jra finishfloat ! 408: Closure(_exp_v) ! 409: fetoxd a0@,fp0 ! 410: jra finishfloat ! 411: Closure(_sqrt_v) ! 412: fsqrtd a0@,fp0 ! 413: jra finishfloat ! 414: Closure(_atan_v) ! 415: fatand a0@,fp0 ! 416: jra finishfloat ! 417: ! 418: /* this bogosity is for export.c */ ! 419: .globl _startptr ! 420: _startptr: .long start
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.