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