|
|
1.1 ! root 1: # ! 2: # Copyright (c) 1979 Regents of the University of California ! 3: # ! 4: # char sccsid[] = "@(#)28fun.s 4.1 10/10/80"; ! 5: # ! 6: # BUILT IN FUNCTIONS ! 7: # ! 8: _LLIMIT: ! 9: incl r10 ! 10: movl (sp)+,r0 #r0 has line limit ! 11: bgtr l2811 ! 12: movl $0x7fffffff,r0 #non-positive indicates no limit ! 13: l2811: ! 14: movl *(sp)+,r1 #r1 has file ! 15: movl r0,LLIMIT(r1) ! 16: jmp (r8) ! 17: _ARGC: ! 18: incl r10 ! 19: pushl _argc ! 20: jmp (r8) ! 21: _ARGV: ! 22: cvtbl (r10)+,r2 ! 23: bneq l2801 ! 24: movzwl (r10)+,r2 #r2 has size of character array ! 25: l2801: ! 26: movl (sp)+,r3 #r3 has addr of character array ! 27: movl (sp)+,r4 #r4 has subscript into argv ! 28: cmpl r4,_argc ! 29: bgequ eargv ! 30: movl *_argv[r4],r4 #r4 has pointer to argv string ! 31: locc $0,r2,(r4) #find end of string ! 32: subl3 r0,r2,r0 #calculate actual string length ! 33: movc5 r0,(r4),$blank,r2,(r3) #move with blank fill ! 34: jmp (r8) ! 35: eargv: ! 36: movw $EARGV,_perrno ! 37: jbr error ! 38: _WCLCK: ! 39: incl r10 ! 40: pushal -(sp) #space for time ! 41: calls $1,_time ! 42: jmp (r8) ! 43: _SCLCK: ! 44: cvtbl $1,r6 ! 45: brb l2805 ! 46: _CLCK: ! 47: clrl r6 ! 48: l2805: ! 49: incl r10 ! 50: subl2 $16,sp ! 51: pushl sp ! 52: calls $1,_times ! 53: movl (sp)[r6],r0 ! 54: addl2 $16,sp ! 55: mull2 $50,r0 #(60ths * 1000) / 60 ! 56: divl3 $3,r0,-(sp) # == (60ths * 50) / 3 ! 57: jmp (r8) ! 58: _DATE: ! 59: incl r10 ! 60: pushl $O_DATE ! 61: calls $2,_pdattim ! 62: jmp (r8) ! 63: _TIME: ! 64: incl r10 ! 65: pushl $O_TIME ! 66: calls $2,_pdattim ! 67: jmp (r8) ! 68: _STLIM: ! 69: incl r10 ! 70: movl (sp)+,_stlim ! 71: cmpl _stcnt,_stlim ! 72: bgeq l2812 ! 73: jmp (r8) ! 74: l2812: ! 75: movw $ESTLIM,_perrno ! 76: jbr error ! 77: _SEED: ! 78: incl r10 ! 79: calls $0,_srand ! 80: jmp (r8) ! 81: _RANDOM: ! 82: incl r10 ! 83: calls $0,_rand ! 84: cvtld r0,r1 ! 85: divd3 $0d2.147483647e+09,r1,(sp) #div by maxint to get 0..1 ! 86: jmp (r8) ! 87: _DISPOSE: ! 88: movzbl (r10)+,r0 #r0 has size being disposed ! 89: bneq l2813 ! 90: movzwl (r10)+,r0 ! 91: l2813: ! 92: movl (sp)+,r6 #r6 points to pointer ! 93: pushl (r6) #fetch pointer value ! 94: calls $1,_pfree #free space ! 95: clrl (r6) #set pointer to nil ! 96: jmp (r8) ! 97: _NEW: ! 98: movzbl (r10)+,r6 ! 99: bneq l2806 ! 100: movzwl (r10)+,r6 ! 101: l2806: ! 102: pushl r6 ! 103: calls $1,_palloc ! 104: movl r0,*(sp)+ ! 105: movc5 $0,(r1),$0,r6,(r0) ! 106: jmp (r8) ! 107: _EXPO: ! 108: incl r10 ! 109: clrl 4(sp) ! 110: movl (sp)+,r0 ! 111: beql l2807 ! 112: bicl2 $0xffff8000,r0 ! 113: ashl $-7,r0,r0 ! 114: subl2 $128,r0 ! 115: movl r0,(sp) ! 116: l2807: ! 117: jmp (r8) ! 118: _ATAN: ! 119: incl r10 ! 120: calls $2,_atan ! 121: movd r0,-(sp) ! 122: jmp (r8) ! 123: _COS: ! 124: incl r10 ! 125: calls $2,_cos ! 126: movd r0,-(sp) ! 127: jmp (r8) ! 128: _EXP: ! 129: incl r10 ! 130: calls $2,_exp ! 131: movd r0,-(sp) ! 132: jmp (r8) ! 133: _SIN: ! 134: incl r10 ! 135: calls $2,_sin ! 136: movd r0,-(sp) ! 137: jmp (r8) ! 138: _LN: ! 139: incl r10 ! 140: tstd (sp) ! 141: bleq eln ! 142: calls $2,_log ! 143: movd r0,-(sp) ! 144: jmp (r8) ! 145: eln: ! 146: movw $ELN,_perrno ! 147: jbr error ! 148: _SQRT: ! 149: incl r10 ! 150: tstd (sp) ! 151: blss esqrt ! 152: calls $2,_sqrt ! 153: movd r0,-(sp) ! 154: jmp (r8) ! 155: esqrt: ! 156: movw $ESQRT,_perrno ! 157: jbr error ! 158: _CHR2: ! 159: _CHR4: ! 160: incl r10 ! 161: movl (sp)+,r0 ! 162: cmpl r0,$0x7f ! 163: bgtru echr ! 164: movw r0,-(sp) ! 165: jmp (r8) ! 166: echr: ! 167: movw $ECHR,_perrno ! 168: jbr error ! 169: _ODD4: ! 170: _ODD2: ! 171: movw (sp)+,(sp) ! 172: incl r10 ! 173: bicw2 $0xfffe,(sp) ! 174: jmp (r8) ! 175: _PRED2: ! 176: incl r10 ! 177: movw (sp)+,(sp) ! 178: decw (sp) ! 179: jmp (r8) ! 180: _PRED4: ! 181: _PRED24: ! 182: incl r10 ! 183: decl (sp) ! 184: jmp (r8) ! 185: _SUCC2: ! 186: incl r10 ! 187: movw (sp)+,(sp) ! 188: incw (sp) ! 189: jmp (r8) ! 190: _SUCC4: ! 191: _SUCC24: ! 192: incl r10 ! 193: incl (sp) ! 194: jmp (r8) ! 195: _ROUND: ! 196: incl r10 ! 197: cvtrdl (sp)+,-(sp) ! 198: jmp (r8) ! 199: _TRUNC: ! 200: incl r10 ! 201: cvtdl (sp)+,-(sp) ! 202: jmp (r8) ! 203: _UNDEF: ! 204: incl r10 ! 205: addl2 $8,sp ! 206: clrw -(sp) ! 207: jmp (r8) ! 208: # ! 209: # pack(a,i,z) ! 210: # ! 211: # with: a: array[m..n] of t ! 212: # z: packed array[u..v] of t ! 213: # ! 214: # semantics: for j := u to v do ! 215: # z[j] := a[j-u+i]; ! 216: # ! 217: # need to check: ! 218: # 1. i >= m ! 219: # 2. i+(v-u) <= n (i.e. i-m <= (n-m)-(v-u)) ! 220: # ! 221: # on stack: lv(z), lv(a), rv(i) (len 4) ! 222: # ! 223: # move w(t)*(v-u+1) bytes from lv(a)+w(t)*(i-m) to lv(z) ! 224: # ! 225: _PACK: ! 226: cvtbl (r10)+,r0 ! 227: bneq l2809 ! 228: movzwl (r10)+,r0 #r0 has size of "a" types ! 229: l2809: ! 230: clrl r1 #r1 := subscript - lower_bound ! 231: subw3 (r10)+,8(sp),r1 ! 232: blss epack ! 233: cmpw r1,(r10)+ #check upper bound ! 234: bgtru epack ! 235: mull2 r0,r1 #r1 has byte offset ! 236: movc3 (r10)+,*4(sp)[r1],*(sp) #make the move ! 237: addl2 $12,sp #clear the stack ! 238: jmp (r8) ! 239: epack: ! 240: movw $EPACK,_perrno ! 241: jbr error ! 242: # ! 243: # unpack(z,a,i) ! 244: # ! 245: # with: z and a as in pack ! 246: # ! 247: # semantics: for j := u to v do ! 248: # a[j-u+i] := z[j] ! 249: # ! 250: _UNPACK: ! 251: cvtbl (r10)+,r0 ! 252: bneq l2810 ! 253: movzwl (r10)+,r0 #r0 has size of "a" types ! 254: l2810: ! 255: clrl r1 #r1 := subscript - lower_bound ! 256: subw3 (r10)+,8(sp),r1 ! 257: blss eunpack ! 258: cmpw r1,(r10)+ #check upper bound ! 259: bgtru eunpack ! 260: mull2 r0,r1 #r1 has byte offset ! 261: movc3 (r10)+,*(sp),*4(sp)[r1] #make the move ! 262: addl2 $12,sp #clear the stack ! 263: jmp (r8) ! 264: eunpack: ! 265: movw $EUNPACK,_perrno ! 266: jbr error
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.