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