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

Text File | 1981-09-01 | 15KB | 800 lines

 opt nol,pag
 ttl Date Utility
 lib sysdef
 opt lis
 pag
 info UniFLEX date
 info Version 1.1, Released May 18, 1981
 info Copyright, (C) 1980, by
 info Technical Systems Consultants, Inc.
 info All rights reserved.

* Print and set the date

 org 0

date sys time,stbuf get system time info
 ldx #stbuf point to time
 lbsr tmloc convert to local time
 ldd 0,s get arg count
 cmpd #1 no args?
 lbls displ display date and time
 sys guid check user id
 cmpd #0 is it super user?
 lbne date8 if not - error
 ldd 0,s get arg count
 leax 4,s point to args
 cmpd #2 1 arg?
 beq date5
 cmpd #3 2 args?
 lbne synerr
 ldx 0,x point to 1st arg
 ldu #dvec point to date vector
date2 cmpu #dvec+6 too many params?
 lbhs synerr if so - error
 lbsr atob convert to binary
 lbne synerr
 std 0,u++ save arg
 lda 0,x+ get next char
 beq date3 if null - finished
 cmpa #'- is it sep char?
 beq date2
 lbra synerr report error
date3 ldd #-1 mark end of vector
 std 0,u
 ldu #dvec point to vector
 ldd 0,u++ get 1st arg
 tst 0,u any more?
 bmi date4
 subd #1 must be month number
 std month save month
 ldd 0,u++ get next param (day)
date4 std mday save the day
 ldd 0,u another param?
 bmi date45
 cmpd #80 its the year (<80)
 bhs date42
 addd #100 make 2000
date42 std year save year
date45 leax 6,s point to next arg

 pag

* date continued - get hh:mm:ss

date5 ldx 0,x poit to string
 lbsr atob convert to binary
 lbne synerr error?
 std dhour save hour
 lda 0,x+ get sep char
 cmpa #': is it ':'?
 lbne synerr
 lbsr atob do conversion
 lbne synerr
 std dmins save minutes
 lda 0,x+ get sep
 beq date6 end of arg?
 cmpa #': is it ':'?
 lbne synerr if not - error
 lbsr atob do conversion
 lbne synerr error?
 std dsec save seconds
date6 lbsr cdate calculate date
 lbsr fixzn add in time zone
 sys time,uphtim get current time
 ldd #('b<<8)|'d set up 'bd' (before date)
 lbsr uphf update history file
 ldx ntime get new time
 ldd ntime+2
 sys stime set the time
 sys time,stbuf get new time
 sys time,uphtim
 ldd #('a<<8)|'d set up 'ad' (after date)
 lbsr uphf update history file
 ldx #stbuf point to new time
 lbsr tmloc convert time
 bra displ display the new time & exit
date8 ldd #2 set file desc
 sys write,nprms,NPSZ output error
 ldd #10 set perm error
 sys term

*
* synerr
*
* Report syntax error and exit.
*

synerr ldd #2 set file desc
 sys write,synmsg,SYSZ output error
 ldd #$ff set term status
 sys term

 pag

*
* displ
*
* Display the time and date.
*

displ ldx #second point to time vector
 lbsr tasc convert to ascii string
 ldd #1 set file desc
 sys write,tstr,25 output time & date
 ldd #0 set status
 sys term

*
* atob
*
* Convert the 2 digit ascii number pointed at by
* X into a binary number returned in D.  Return
* 'ne' if error.
*

atob lda 0,x+ get char
 suba #'0 remove bias
 bmi atob2 error?
 cmpa #9 is it digit?
 bhi atob2
 ldb 0,x get next character
 beq atob4 is it null term?
 cmpb #'0 is it term char
 blo atob4
 cmpb #'9
 bhi atob4
 asla multiply by 10
 pshs a
 asla
 asla
 adda 0,s
 sta 0,s save result
 ldb 0,x+ get next char
 subb #'0 remove bias
 bmi atob2 error?
 cmpb #9 is it digit?
 bhi atob2
 clra set hi byte
 addb 0,s+ add in hi digit
 sez set status
atob2 rts return
atob4 tfr a,b get digit
 clra
 rts return

 pag

*
* cdate
*
* Calculate the actual internal date
*

cdate ldd #0 init to zero
 std ntime
 lda dmins+1 get minutes
 ldb #60 60 seconds per minute
 mul find total seconds
 addd dsec add in seconds
 std ntime+2 save time so far
 ldd dhour get hour
 std r0+2 set up for multiply
 ldd #3600 3600 seconds per hour
 std r1+2
 ldd #0 clear out hi words
 std r0
 std r1
 lbsr lmul do hours*3600
 ldd ntime+2 add in result to seconds so far
 addd r0+2
 std ntime+2
 ldd ntime
 adcb r0+1
 adca r0
 std ntime save new result
 bsr clmd calculate days in this year
 lbsr clyd
 ldd mday get month day
 subd #1 remove bias
 addd cmday add in month days
 addd cyday add in year days
 std r0+2 set up for multiply
 ldd #0
 std r0
 ldd #1 set up 86400 (seconds per day)
 std r1 which is $15180
 ldd #$5180
 std r1+2
 lbsr lmul calculate day seconds
 ldd ntime+2 add in to total so far
 addd r0+2
 std ntime+2
 ldd ntime
 adcb r0+1
 adca r0
 std ntime save result
 rts return

 pag

*
* clmd
*
* Calculate number of days in past months.
*

clmd ldd #0 do init
 std cmday
 ldd year get year
 bitb #3 is it leap year?
 bne clmd1
 ldd #29 fix up Feb in table
 std mdays+2
clmd1 ldx #mdays point to month-day table
 ldd #0 set month counter
clmd2 cmpd month current month?
 beq clmd4 if so - done
 pshs d save count
 ldd cmday get day counter
 addd 0,x++ add in to month day count
 std cmday save total
 puls d get month count
 addd #1 bump one
 bra clmd2
clmd4 ldd #28 reset month table
 std mdays+2
 rts return

 pag

*
* clyd
*
* Calculate days in previous years.
*

clyd ldd #0 do init
 std cyday
 ldd #80 set year
clyd2 cmpd year current year?
 beq clyd6
 pshs d save year count
 bitb #3 leap year?
 beq clyd3
 ldd #365 set year day count
 bra clyd4
clyd3 ldd #366 set leap year day count
clyd4 addd cyday add in day count
 std cyday save total
 puls d get year count
 addd #1 bump by one
 bra clyd2 repeat
clyd6 rts return

 pag

*
* fixzn
*
* Adjust input date & time from local time zone
* to UTC time.
*

fixzn tst dlflg daylight savings here?
 beq fixzn1
 ldx #ntime point to it
 lbsr tmutc convert to utc
 lbsr chkdl daylight savings here?
 bne fixzn1
 ldd ntime+2 get time
 subd #3600 if so, subtract 1 hour
 std ntime+2
 bcc fixzn1
 ldd ntime do hi part
 subd #1
 std ntime save new hi
fixzn1 ldd ntime+2 get the new time
 tst eutc east of UTC?
 bne fixzn2
 addd tzn+2 add in time zone since west
 std ntime+2
 ldd ntime
 adcb tzn+1
 adca tzn
 bra fixzn3
fixzn2 subd tzn+2 subtract since east of utc
 std ntime+2
 ldd ntime do lo part
 sbcb tzn+1
 sbca tzn
fixzn3 std ntime save new time
fixzn6 rts return

 pag

*
* lmul
*
* Long multiply - 32 bits (r0) X 32 bits (r1).
* Result is in r0.
*

lmul ldb #32 set loop count
 pshs b
 ldd #0 init variables
 std work
 std work+2
 lsr r0 do initial shift
 ror r0+1
 ror r0+2
 ror r0+3
lmul1 bcc lmul2 need to add?
 ldd work+2
 addd r1+2
 std work+2
 ldd work
 adcb r1+1
 adca r1
 std work save result
lmul2 ror work do shifting
 ror work+1
 ror work+2
 ror work+3
 ror r0
 ror r0+1
 ror r0+2
 ror r0+3
 dec 0,s dec the loop count
 bne lmul1 repeat?
 puls b,pc return

 pag

*
* tmloc
*
* Convert time pointed at by x to vector time (local).
*

tmloc ldd 0,x get time
 std ltime
 ldd 2,x
 std ltime+2
 lda 7,x get day light savings flag
 sta dlflg
 clr eutc init flag
 ldd 5,x get time zone
 bpl tmloc2 west of GMT?
 inc eutc if not - set flag
 coma and make pos number
 comb
 addd #1
tmloc2 std r0+2 save time zone
 ldd #60 calculate zone seconds
 std r1+2
 ldd #0 set hi bytes to 0
 std r0
 std r1
 lbsr lmul calculate time zone seconds
 ldd r0 get result
 std tzn save it
 ldd r0+2
 std tzn+2
 lbsr adjtim adjust time for zone
 ldx #ltime point to time
 lbsr tmutc convert to vector
 tst dlflg do dlst?
 beq tmloc6
 lbsr chkdl in dlst?
 bne tmloc6
tmloc5 ldd #3600 adjust for dlst
 addd ltime+2
 std ltime+2
 ldd ltime
 adcb #0
 adca #0
 std ltime
 ldx #ltime point to time
 lbsr tmutc convert to vector
 inc daylit set daylit flag
tmloc6 ldx #second point to vector
 rts return

 pag

*
* tmutc
*
* Convert the internal system time (4 bytes
* pointed at by X on entry) to an 18 byte
* vector representing the broken down time.
* The time in this form is UTC (Universal
* Coordinated Time).
*

tmutc ldd #0 set daylight savings word
 std daylit
 ldd 0,x get hi word of time
 std r0 save ir divide register
 ldd 2,x get lo word of time
 std r0+2
 ldd #60*60 seconds*minutes constant
 std r1 set up for divide
 lbsr ldiv min*sec=time % 3600
 ldd work hour*day=time / 3600
 pshs d save min*sec
 ldd #24 set up hours per day constant
 std r1
 lbsr ldiv hours= (hour*day) % 24
 ldd work day= (hour*day) / 24
 std hours set hours word
 ldd r0+2 get day number
 std day save the day
 addd #2 add in day bias (Jan 1 80 => Tue)
 std r0 set up for divide
 ldb #7 days per week constant
 stb r1
 lbsr div wday=(day+2) % 7
 ldb work get result
 clra make into word
 std wday set week day
 puls d get min*sec
 std r0 set up for divide
 ldb #60 seconds per minute
 stb r1
 lbsr div seconds= (min*sec) % 60
 ldb work minutes= (min*sec) / 60
 clra
 std second set seconds word
 ldd r0 get minutes
 std minute save it

 pag

* continue tutc for year and month data

 clr 0,-s clear year counter
tutc2 ldx #ylen point to year length table
 lda 0,s get year number
 bita #$3 is it leap year?
 bne tutc3
 leax 2,x if so, move to long year value
tutc3 ldd day get day number
 cmpd 0,x day in current year?
 blo tutc4 if 'lt' - we got the year!
 subd 0,x subtract off years days
 std day save new day count
 inc 0,s bump the year count
 bra tutc2 repeat
tutc4 std yday set day of year word
 puls b get year count
 addb #80 add to '1980'
 clra make 16 bits long
 std year save the year
 bitb #$3 is it leap year?
 bne tutc5
 ldd #29 if so, set Feb day count to 29
 std mdays+2
tutc5 ldx #mdays point to month-day table
 clr 0,-s set month count to zero
 ldd yday get day of the year
tutc6 cmpd 0,x in the month?
 blo tutc7 if 'lt' - we got the month!
 inc 0,s bump the month counter
 subd 0,x++ subtract of this month's days
 bra tutc6
tutc7 addd #1 add 1 to month day (day 1 is 1 - not 0!)
 std mday save the month day
 puls b get the month
 std month save it
 ldd #28 reset month - day table
 std mdays+2
 rts return

 pag

*
* chkdl
*
* Check if in dlst - return 'eq' if so.
*

chkdl ldd #119 check for last Sun in Apr
 bsr fixtim
 std fstdl first day of dlst
 ldd #303 last Sun in Oct
 bsr fixtim
 std lstdl last day of dlst
 ldd yday get day of year
 cmpd fstdl up to 1st day yet?
 blo chkdl6
 bhi chkdl4
 ldd hours on the 1st day - so
 cmpd #2 is it 2:00 AM yet?
 blo chkdl6
 bra chkdl5
chkdl4 ldd yday get day of year
 cmpd lstdl past last day of dlst?
 bhi chkdl6
 blo chkdl5
 ldd hours on the last day - so
 cmpd #1 is it 1:00 AM yet?
 bhs chkdl6
chkdl5 sez we are in dlst!
 rts return
chkdl6 clz not in dlst
 rts return

 pag

*
* adjtim
*
* Adjust time for time zone.
*

adjtim ldd ltime+2 get time
 tst eutc east of UTC?
 bne adjti2
 subd r0+2 subtract time zone minutes
 std ltime+2
 ldd ltime get hi part
 sbcb r0+1
 sbca r0
 bra adjti4
adjti2 addd r0+2 add in minutes
 std ltime+2
 ldd ltime
 adcb r0+1
 adca r0
adjti4 std ltime save new time
adjti5 rts return

*
* fixtim
*
* Return the closest day to the date in D
* which is a Sunday.
*

fixtim pshs d save day number
 ldd year get year
 bitb #$3 is it leap year?
 puls d
 bne fixti2
 addd #1 if so - bump day number
fixti2 pshs d save day number
 addd #420 add in 420 so no negatives result
 addd wday add in day of week
 subd yday subtract day of year
 std r0 save result
 ldb #7
 stb r1 set up for divide
 lbsr div do: (day+420+wday-yday) % 7
 puls d get day number
 subb work
 sbca #0
 rts return day in d

 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

 pag

*
* tasc
*
* Convert the time vector data (18 bytes) pointed
* at by x into an ascii string.  Return x pointing
* to the string.
*

tasc tfr x,u save vector pointer
 ldx #tstr point to string
 ldd 4,u get hours
 lbsr cvt convert to ascii
 leax 1,x skip the ':'
 ldd 2,u get minutes
 lbsr cvt convert to ascii
 leax 1,x skip the ':'
 ldd 0,u get seconds
 lbsr cvt convert to ascii
 leax 1,x skip space
 ldd 6,u get day of week
 ldy #dtab point to day table
 bsr tasxfr xfr to string
 ldd 10,u get month
 ldy #mtab point to month table
 bsr tasxfr xfr to string
 ldd 8,u get month day
 bsr cvt convert to ascii
 leax 1,x
 ldd #('1<<8)|'9 set up '19'
 std 0,x save in string
 ldd 12,u get year
 cmpd #100 >100 (year 2000 yet?)
 blo tasc4
 subd #100 remove bias
 pshs d save year
 ldd #('2<<8)|'0 set up '20'
 std 0,x set in string
 puls d reset year
tasc4 leax 2,x
 bsr cvt convert year to ascii
 ldx #tstr point to string
 rts return

 pag

*
* tasxfr
*
* Transfer the 3 bytes of ascii indexed by b
* at y to location pointed at by x.
*

tasxfr pshs b index * 3
 aslb
 addb 0,s+
 leay b,y point to indexed data
 ldd 0,y xfr the data to x
 std 0,x++
 lda 2,y
 sta 0,x
 leax 2,x bump string pointer
 rts return

*
* cvt
*
* Convert number in b to ascii at x.
*

cvt lda #'0 set ascii 0
cvt2 cmpb #10 >10?
 blo cvt4
 subb #10 subtract off 10
 inca bump ascii
 bra cvt2 repeat
cvt4 addb #'0 make 1's ascii
 std 0,x++ save ascii at x
 rts return

 pag

*
* uphf
*
* Update the history file
*

uphf std uphbuf set up name
 sys open,hisf,1 open file
 bes uphf4 error?
 pshs d save file desc
 sys seek,0,0,2 find eof
 ldd 0,s get file desc
 sys write,uphbuf,16 make entry
 puls d
 sys close close the file
uphf4 rts return

 pag

*
* Strings and constants
*

nprms fcc "Can't set date - No permission",$d
NPSZ equ *-nprms
synmsg fcc 'Command syntax error.',$d
SYSZ equ *-synmsg
hisf fcc '/act/history',0 history file

ylen fdb 365 year length
 fdb 366 leap year

mdays fdb 31,28,31,30,31,30,31,31,30,31,30,31


tstr fcc 'xx:xx:xx xxx xxx xx xxxx',$d,0

dtab fcc 'SunMonTueWedThuFriSat'

mtab fcc 'JanFebMarAprMayJunJulAugSepOctNovDec'

second fdb 0 seconds (0-59)
minute fdb 0 minutes (0-59)
hours fdb 0 hours (0-23)
wday fdb 0 week day (0-6) 0=Sunday
mday fdb 0 month day (1-31)
month fdb 0 month (0-11)
year fdb 0 year (80+)
yday fdb 0 day of year (0-355)
daylit fdb 0 daylight savings flag


r0 fdb 0,0 regs for div and mul
r1 fdb 0,0
work fdb 0,0
day fdb 0 day temp
ntime fdb 0,0 new time
dhour fdb 0 hour of day
dmins fdb 0 min of hour
dsec fdb 0 sec of min
cmday fdb 0 month days
cyday fdb 0 year days
dvec fdb 0,0,0,0 date vector
stbuf fdb 0,0,0,0 time buffer
eutc fcb 0 east of utc flag
fstdl fdb 0 1st day of dlst
lstdl fdb 0 last day of dlst
dlflg fcb 0 dlst flag
ltime fdb 0,0 local time
tzn fdb 0,0 time zone seconds
uphbuf fdb 0,0,0,0,0,0 history buffer
uphtim fdb 0,0,0,0 time for history


 end date