[unix-history] / usr / src / cmd / px / 28fun.s

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