|
|
1.1 root 1: #
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)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.