rtsi.com/2014.01.www.rtsi.com.tar/www.rtsi.com/UNIFLEX/UNIFLEX/UniFLEX_Std.Utils1.tar.Z/UniFLEX_Std.Utils1.tar/utils1/time

Text File | 1981-09-01 | 8KB | 438 lines

 opt pag,nol
 ttl UniFLEX Time
 pag
 lib sysdef
 opt lis
 pag

 info UniFLEX time
 info Version 1, Released January 19, 1981
 info Copyright, (C) 1981, by
 info Technical Systems Consultants, Inc.
 info All rights reserved.

* definitions

ENOTB equ 21 not binary
BHDBT equ $8a basic file header
BHDBT2 equ $9a new basic header (v2.0)
PHDBT0 equ $8b Pascal (normal) header byte ***GDT
PHDBT1 equ $8c Pascal (system) ***GDT
BUFSIZ equ 256 buffer size

* time starts here

tim ldd 0,s get arg count
 cmpd #1
 lbls err1 if 1 - error
 ldd #cshln set shell name
 std sargls
 sys time,tstrt get current time
 leax 4,s point to args
 ldu #arglst point to arg list
tim1 ldd 0,x++ copy args to list
 std 0,u++
 bne tim1 repeat to end of list
 ldx arglst point to first arg
 ldy #comnd point to command buffer
tim2 lda 0,x+ get a character
 sta 0,y+ xfr to command buffer
 bne tim2 end?
 leax -1,x back up to term
tim25 cmpx arglst back to beginning?
 beq tim3
 lda 0,-x get previous character
 cmpa #'/ is it /?
 bne tim25
 leax 1,x eat slash
tim3 stx arglst set first arg (cmnd name)
 sys fork
 bra doit go exec command
 pshs d save task id
 sys cpint,2,1 ignore INTERRUPT signal
tim4 sys wait wait for task
 cmpd 0,s is it him?
 bne tim4
 puls d
 stx tstat save status
 lbra fin go finish up

 pag

* execute command

doit clr rtcnt clear out retry counter
 sys exec,comnd,arglst exec program
 cmpd #ENOTB file not binary?
 beq trya
 lda comnd check first char
 cmpa #'/ is it path head?
 beq doit3
 inc rtcnt bump retry count
 sys exec,retry1,arglst try 'bin/...'
 cmpd #ENOTB not binary?
 beq trya
 inc rtcnt bump counter
 sys exec,retry2,arglst try '/bin/...'
 cmpd #ENOTB not binary?
 beq trya
 inc rtcnt bump retry count
 sys exec,retry3,arglst try '/usr/bin/...'
 cmpd #ENOTB
 beq trya
doit3 ldd #1 if here, error!
 sys write,ermsg1,ERSIZ1
 ldx #comnd
 ldd #0
doit4 lda 0,x+
 beq doit5
 incb
 bra doit4
doit5 tst b
 beq doit7
 std doit6+5 save as arg
 ldd #1 set file desc
doit6 sys write,comnd,0
doit7 ldd #1
 sys write,ermsg2,ERSIZ2
 ldd #$ff set error status
 sys term terminate this guy!

 pag

*
* trya
*
* Try to execute ascii file.
*

trya ldx #rtclst point to list
 lda rtcnt get retry count
 asla
 leax a,x point to retry number
 ldd 0,x get pointer
 std iopn2 set in open call
 std arglst
 sys ind,iopn open file
 bes trya6
 pshs d save file desc
 clr smbuf
 sys read,smbuf,2 read 1st 2 characters
 puls d get fd
 sys close close the file
 lda smbuf get 1st char
 bmi trybas basic file?
 cmpa #$20 is it ascii?
 blo trya6
trya4 sys exec,cshell,sargls execute a shell
trya6 lbra doit3 report error

rtclst fdb comnd,retry1,retry2,retry3

trybas cmpa #BHDBT is it basic file?
 beq trybs2
 cmpa #BHDBT2 new basic?
 bne tryP try Pascal program ***GDT
trybs2 sys exec,cbasic,sargls try basic execution
 lbra doit3 error?

tryP cmpa #PHDBT0 normal Pascal program? ***GDT
 bne tryP1 no - try system ***GDT
 sys exec,Pscl0,sargls try Pascal execution ***GDT
 lbra doit3 error ***GDT
tryP1 cmpa #PHDBT1 Pascal system program? ***GDT
 lbne doit3 no - error ***GDT
 sys exec,Pscl1,sargls try to execute program ***GDT
 lbra doit3 error ***GDT
err1 ldd #2 report syntax error
 sys write,syrms,SYSIZ
 ldd #$ff set status
 sys term exit

 pag

*
* finish up and report times
*

fin sys time,tend get current time
 sys ttime,ttbuf get task info
 lda tend+4 get tenths secs
 suba tstrt+4 calc real time difference
 sta rtt
 ldd tend+2
 sbcb tstrt+3
 sbca tstrt+2
 std rt save real time
 tst rtt
 bpl fin2
 lda #10 fix negative tenths
 adda rtt
 sta rtt
fin2 ldd ttbuf+6 get user time
 std r0
 ldd ttbuf+8
 std r0+2
 ldd #10 divide by 10
 std r1
 jsr ldiv
 ldb work+1 get remainder (.1 seconds)
 stb utt
 ldd r0+2 get seconds
 std ut
 ldd ttbuf+10 get system time
 std r0
 ldd ttbuf+12
 std r0+2
 ldd #10 divide by 10
 std r1
 jsr ldiv
 ldb work+1 get .1 seconds
 stb stt
 ldd r0+2 get seconds
 std st
 ldd #1 output rt message
 sys write,m1,M1
 ldx #rt output real time
 jsr ptm
 ldd #1 output user time message
 sys write,m2,M2
 ldx #ut
 jsr ptm output user time
 ldd #1 output sys message
 sys write,m3,M3
 ldx #st output system time
 jsr ptm
 ldd tstat get term status
 sys term exit

 pag

*
* print time
*

ptm pshs x save time ptr
 ldd 0,x get seconds
 std r0
 ldb #60 divide by 60
 stb r1 for minutes
 jsr div
 ldd r0 get minutes
 ldx #obfr point to output buffer
 jsr decstn output number
 std iwrt2 save length
 leax d,x
 lda #': output ':'
 sta 0,x+
 stx optr save ptr
 ldb work get seconds
 clra
 jsr decstn output it
 leax d,x
 addd #2 adjust count
 addd iwrt2
 std iwrt2
 lda #'. output '.'
 sta 0,x+
 stx optr
 puls x point to time
 ldb 2,x get tenths of seconds
 clra
 ldx optr get output ptr
 jsr decstn output number
 leax d,x
 addd iwrt2 adjust count
 addd #1
 std iwrt2
 lda #$d output cr
 sta 0,x
 ldd #1 get file desc
 sys ind,iwrt output number info
 rts return

 pag

*
* decst
*
* Convert the number in D into an ascii string
* representing a decimal number.  The string
* is pointed at by X (X should be set on entry!)
* Also on exit, D has the length of the string.
* The second entry point, 'decstn' will not print
* leading spaces for leading zeroes, but will
* suppress all leading zero info.  All strings
* start with a space.
*

decst pshs x save user pointer
 clr 0,-s set suppression flag
 bra decst2
*
decstn pshs x save user pointer
 clr 0,-s
 inc 0,s set for no fielding
decst2 clr 0,-s set up bookkeeping
 clr 0,-s
 ldy #conlst point to constants
decst4 cmpd 0,y compare number to constant
 blo decst5
 subd 0,y do subtraction of constant
 inc 1,s bump digits counter
 bra decst4
decst5 pshs a save number
 tst 2,s zero digit?
 bne decst6
 tst 1,s any numbers output yet?
 bne decst6
 tst 3,s doing suppression?
 bne decst8
 lda #$20 set up space
 bra decst7
decst6 lda 2,s get digit count
 inc 1,s set 'got one' flag
 ora #$30 make ascii
decst7 sta 0,x+ save in buffer
decst8 puls a reset number
 clr 1,s clear out digit
 leay 2,y bump constant ptr
 cmpy #conend end of list?
 bne decst4
 leas 3,s clean up stack
 orb #$30 make last digit
 stb 0,x+ save in buffer
 clr 0,x null terminate string
 tfr x,d
 subd 0,s calculate string length
 puls x,pc return

* constants for convert

conlst fdb 10000
 fdb 1000
 fdb 100
 fdb 10
conend equ * end of list

 pag

*
* Divide routines for time conversion use.  'Ldiv'
* divides a 32 bit number (r0 -> r0+3) by a 16 bit
* number (r1 -> r1+1) and produces a 32 bit result
* in r0 and a 16 bit remainder in 'work'.  'Div'
* divides a 16 bit number (r0 -> r0+1) by an 8 bit
* number (r1) and produces a 16 bit result (r0)
* and an 8 bit remainder (work).
*

div lda #17 set up loop counter
 clrb do initialize
 stb work
 bra div2
div1 ldb work
 subb r1 do subtraction
 bcs div2 s3et new work?
 stb work yes!
div2 rol r0+1 do shift left
 rol r0
 rol work
 deca dec the loop count
 bne div1 repeat?
 com r0 fix up result
 com r0+1
 lsr work fix remainder
 rts


 pag

*
* Long divide
*

ldiv ldb #33 set loop counter
 pshs b
 ldd #0 do init
 std work
 bra ldiv2
ldiv1 ldd work do subtraction
 subd r1
 bcs ldiv2 work > r1 ?
 std work set new work value
ldiv2 rol r0+3 do shifting
 rol r0+2
 rol r0+1
 rol r0
 rol work+1
 rol work
 dec 0,s dec the loop count
 bne ldiv1
 com r0 compliment the result
 com r0+1
 com r0+2
 com r0+3
 lsr work adjust the remainder
 ror work+1
 puls b,pc return


*
* data section
*

m1 fcc 'Elapsed real time - '
M1 equ *-m1
m2 fcc 'User CPU time - '
M2 equ *-m2
m3 fcc 'System CPU time - '
M3 equ *-m3
ermsg1 fcc "Can't execute '"
ERSIZ1 equ *-ermsg1
ermsg2 fcc "'",$d
ERSIZ2 equ *-ermsg2
syrms fcc 'Syntax error.',$d
SYSIZ equ *-syrms
cshell fcc '/bin/shell',0
cbasic fcc '/bin/basic',0
Pscl0 fcc '/bin/nrun',0 ***GDT
Pscl1 fcc '/bin/sys_rt',0 ***GDT
cshln fcc 'shell',0

r0 fdb 0,0 regs for div and mul
r1 fdb 0,0
work fdb 0,0
tstrt rzb 8 time start
tend rzb 8 time end
ttbuf rzb 14 ttime buffer
smbuf fdb 0 buffer for file header
tstat fdb 0 term status
rtcnt fcb 0 retry counter
optr fdb 0 output pointer
rt fdb 0
rtt fcb 0 real time storage
ut fdb 0 user time
utt fcb 0
st fdb 0 system time
stt fcb 0

iopn fcb open ind open call
iopn2 fdb 0,0

iwrt fcb write
 fdb obfr
iwrt2 fdb 0


retry3 fcc '/usr'
retry2 fcc '/'
retry1 fcc 'bin/'
comnd rzb 64 command name buffer
obfr rzb 32

sargls rmb 2 shell arg list
arglst rzb BUFSIZ argument list for exec

 end tim