BSD 4 release

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

#\f
# Copyright (c) 1979 Regents of the University of California
#
# char sccsid[] = "@(#)28fun.s 4.1 10/10/80";
#
# 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
       movzwl  (r10)+,r2               #r2 has size of character array
l2801:
       movl    (sp)+,r3                #r3 has addr of character array
       movl    (sp)+,r4                #r4 has subscript into argv
       cmpl    r4,_argc
       bgequ   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,r6
       brb     l2805
_CLCK:
       clrl    r6
l2805:
       incl    r10
       subl2   $16,sp
       pushl   sp
       calls   $1,_times
       movl    (sp)[r6],r0
       addl2   $16,sp
       mull2   $50,r0          #(60ths * 1000) / 60
       divl3   $3,r0,-(sp)     # == (60ths * 50) / 3
       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
       cmpl    _stcnt,_stlim
       bgeq    l2812
       jmp     (r8)
l2812:
       movw    $ESTLIM,_perrno
       jbr     error
_SEED:
       incl    r10
       calls   $0,_srand
       jmp     (r8)
_RANDOM:
       incl    r10
       calls   $0,_rand
       cvtld   r0,r1
       divd3   $0d2.147483647e+09,r1,(sp)      #div by maxint to get 0..1
       jmp     (r8)
_DISPOSE:
       movzbl  (r10)+,r0       #r0 has size being disposed
       bneq    l2813
       movzwl  (r10)+,r0
l2813:
       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)+,r6
       bneq    l2806
       movzwl  (r10)+,r6
l2806:
       pushl   r6
       calls   $1,_palloc
       movl    r0,*(sp)+
       movc5   $0,(r1),$0,r6,(r0)
       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:
_CHR4:
       incl    r10
       movl    (sp)+,r0
       cmpl    r0,$0x7f
       bgtru   echr
       movw    r0,-(sp)
       jmp     (r8)
echr:
       movw    $ECHR,_perrno
       jbr     error
_ODD4:
_ODD2:
       movw    (sp)+,(sp)
       incl    r10
       bicw2   $0xfffe,(sp)
       jmp     (r8)
_PRED2:
       incl    r10
       movw    (sp)+,(sp)
       decw    (sp)
       jmp     (r8)
_PRED4:
_PRED24:
       incl    r10
       decl    (sp)
       jmp     (r8)
_SUCC2:
       incl    r10
       movw    (sp)+,(sp)
       incw    (sp)
       jmp     (r8)
_SUCC4:
_SUCC24:
       incl    r10
       incl    (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 4)
#
# move w(t)*(v-u+1) bytes from lv(a)+w(t)*(i-m) to lv(z)
#
_PACK:
       cvtbl   (r10)+,r0
       bneq    l2809
       movzwl  (r10)+,r0               #r0 has size of "a" types
l2809:
       clrl    r1                      #r1 := subscript - lower_bound
       subw3   (r10)+,8(sp),r1
       blss    epack
       cmpw    r1,(r10)+               #check upper bound
       bgtru   epack
       mull2   r0,r1                   #r1 has byte offset
       movc3   (r10)+,*4(sp)[r1],*(sp) #make the move
       addl2   $12,sp                  #clear the stack
       jmp     (r8)
epack:
       movw    $EPACK,_perrno
       jbr     error
#
# 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
       movzwl  (r10)+,r0               #r0 has size of "a" types
l2810:
       clrl    r1                      #r1 := subscript - lower_bound
       subw3   (r10)+,8(sp),r1
       blss    eunpack
       cmpw    r1,(r10)+               #check upper bound
       bgtru   eunpack
       mull2   r0,r1                   #r1 has byte offset
       movc3   (r10)+,*(sp),*4(sp)[r1] #make the move
       addl2   $12,sp                  #clear the stack
       jmp     (r8)
eunpack:
       movw    $EUNPACK,_perrno
       jbr     error