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

Text File | 1984-05-02 | 24KB | 1,275 lines

 opt pag,nol
 ttl Mail Utility
 lib sysdef
 spc 4
**   Local Macro Definitions.
 spc 2
**   msg - define message
*
* tag msg "text"[,terminator]
*
* defines "tag" concatencated with "l" to be length of message
 spc 2
msg macro
 fcc "&1"
 ifnc &2,""
 fcb &2
 endif
&0l equ *-&0
 endm
 spc 2
**   Messag - Write message.
*
*    messag file-descriptor,message-address[,message-length]
*
*    if "message-length" is not specified, the symbol for
*    "message-address", concatenated with an "l", is used.
 spc 2
messag macro
 ldd #&1
 ifnc &3,""
 sys write,&2,&3
 else
 sys write,&2,&2l
 endif
 endm
 opt lis
 pag
 info UniFLEX mail
 info Version 1.21, Released March 28, 1984
 info Copyright, (C) 1981, by
 info Technical Systems Consultants, Inc.
 info All rights reserved.

*
* Mail Utility - send or read mail.
*

 org 0

mail sts stkptr save system stack ptr
 jsr pop process options
 ldd 0,s get arg count
 cmpd #1 list or send?
 lbhi smail

* list mail

lmail sys guid reset effective user id
 std uid save for fndnam
 sys suid to actual id (for perms)
 jsr opnpass open password file
1 jsr getlin get a line from password file
 lbeq lmail8 if eof
 ldx #linbuf point to line buffer
 jsr fcol find end of user name
 jsr fcol find end of password
 pshs x save ptr to user id #
 jsr fcol find end of user id #
 clr -1,x set term
 leay 0,x save x
 puls x restore ptr to user if #
 pshs y save ptr to login dir
 jsr decvt convert user id to binary
 puls y restore ptr to login dir
 cmpd uid
 bne 1b if not a match
 jsr fcol find end of login dir
 clr -1,x set term
 leax 0,y (x)=ptr to login dir
 pshs x save ptr to login dir
 jsr cpylog copy log dir to usst
 puls x restore login dir ptr
 jsr cpyml copy log dir to usst2
 jsr clspass close the password file
 sys status,usst,stb get file status
 bes lmail8 error?
 ldd stb+9 check for non zero size
 bne lmail2
 ldd stb+11
 beq lmail9
lmail2 sys open,usst,0 open mail file
 bes lmail8 error?
 std mfd save file desc
 jsr cptt copy mail to terminal
 ldd mfd close the mail file
 sys close
 ldd #1 prompt user
 sys write,savms,SAVSZ 'Save mail?'
 ldd #0 set input file desc
 sys read,ibuf,32 get response
 cmpd #0 eof?
 beq quit
 lda ibuf get 1st char of response
 anda #$5F make upper case
 cmpa #'Y responde yes?
 beq lmail5
 cmpa #'N response no?
 beq lmail6
quit ldd #0 exit with no action
abort lds stkptr restore stack ptr
 sys term
lmail5 jsr savml save the mail file
lmail6 jsr trnml truncate .mail file
 jmp quit exit
lmail8 pshs d save error
 ldd #2 set error file desc
 sys write,comms,COSZ output error
 puls d get error
 jmp abort
lmail9 ldd #1 set file desc
 sys write,noms,NOMSZ output error
 jmp quit exit

 pag

*
* Send mail
*

smail leax 4,s point to arg list
 stx argpt save arg pointer
 jsr crtmp create mail temp file
 tst all
 bne sndall if sending mail to all
1 jsr opnpass open password file
2 ldx argpt get arg pointer
 ldy 0,x++ get next arg
 beq 6f finished?
 stx argpt
 lda 0,y get 1st char of arg
 cmpa #'+
 beq 2b if arg is an option
 pshs y save ptr to user name arg
3 jsr getlin get a line from the password file
 beq 7f if eof
 ldx #linbuf point to the line
 ldy 0,s restore ptr to user name arg
4 lda 0,y+ get char from user name arg
 beq 5f if end of user name arg
 cmpa 0,x+ check against password file
 bne 3b if no match
 bra 4b not done yet
5 lda 0,x+ next char of password file
 cmpa #': should be a ":"
 bne 3b if no match
 puls y restore stack
 jsr setup setup for mailing
 bne 8f error?
 jsr head send out header
 jsr copy copy mail to file
 ldd tfd close the dest file
 sys close
 ldd mfd
 sys close
 bra 8f repeat for next user
6 sys unlink,tmpn delete temp file
 jmp quit

7 puls x get ptr to user name arg
 jsr prter "Can't send mail to"
8 jsr clspass close the password file
 bra 1b process next user


sndall jsr opnpass open password file
3 jsr getlin get a line from the password file
 beq 4f if eof
 jsr setup setup for mailing
 bne 3b error?
 jsr head send out header
 jsr copy copy mail to file
 ldd tfd close the dest file
 sys close
 ldd mfd
 sys close
 bra 3b repeat for next user
4 sys unlink,tmpn delete temp file
 jsr clspass close the password file
 jmp quit

*
* trnml
*
* Truncate the '.mail' file to zero length.
*

trnml sys status,usst,stb get file status
 bes trnml2 error?
 ldb stb+5 get perm bits
 clra make 16 bit word
 std icrt2 set up create call
 sys ind,icrt create .mail file (truncate)
 bes trnml2 error?
 sys close close the file
trnml2 rts return

*
* cptt
*
* Copy mail file to terminal.
*

cptt ldd #1 set file desc (standard output)
 std tfd save it

* fall thru to copy

 pag

*
* copy
*
* Copy file (mfd) to file (tfd).
*

copy ldd mfd get file desc
 sys read,ibuf,32 read some of file
 bes copy5 error?
 std iwrt2 save count
 beq copy5
 ldd tfd get file desc
 sys ind,iwrt write out data
 bra copy repeat
copy5 rts return

*
* savml
*
* Save the .mail file by writing it to the end
* of the 'mailbox' file if it exists.
*

savml sys chacc,usst2,0 check if 'mailbox' exists
 bec savml2 error?
 sys create,usst2,3 create mailbox file
 bes savml4 error?
 std tfd save file desc
 bra savml3
savml2 sys open,usst2,1 open mailbox for write
 bes savml4 error?
 std tfd save file desc
 sys seek,0,0,2 seek to end of file
savml3 sys open,usst,0 open '.mail' for read
 bes savml4 error?
 std mfd save file desc
 bsr copy copy file
 ldd mfd get file desc
 sys close close .mail file
 ldd tfd get file desc
 sys close close mailbox file
 rts return
savml4 pshs d save error
 ldd #2 set file desc
 sys write,nbmms,NBSZ output error
 puls d get error
 jmp abort

 pag

*
* setup
*
* Setup the sending of mail.
*
*   entry linbuf contains line from password file.
*         mail will be sent to this user.
*

setup bsr copynm copy user name
 jsr fnddir locate login dir
 bsr cpylog copy log dir to usst
 ldx #usst point to complete file name
4 stx iopn2 set up sys call
 sys ind,iopn open file for write
 bes 6f error?
 std tfd save file desc
 sys ofstat,stb get status
 lda stb+6 check link count
 deca
 bne 6f if not 1 - error
 lda stb+4 regular file?
 bita #%00001110
 bne 6f if not - error
 ldd tfd
 sys seek,0,0,2 seek to end of file
 sys open,tmpn,0 open temp file for read
 std mfd save file desc
 sez set status
 rts return
6 ldx #usrnm point to user name
 jsr prter print error
 clz set error status
 rts return

*
* copynm - copy user name from password file to "usrnm"
*

copynm ldx #linbuf get ptr to user name
 ldy #usrnm
1 lda 0,x+ get char from file
 cmpa #':
 beq 2f if colon found
 sta 0,y+
 bra 1b not done yet
2 clra set term
 sta 0,y+
 rts

*
* cpylog - build .mail path name
*

cpylog ldy #usst point to file name string
2 lda 0,x+ get char from password file
 sta 0,y+ copy char to file name
 bne 2b end of login dir?
 lda #'/ set path sep char
 sta -1,y
 ldx #mlnam set up .mail name
3 lda 0,x+
 sta 0,y+
 bne 3b
 rts

*
* cpyml - build mailbox path name
*

cpyml ldy #usst2 point to file name string
2 lda 0,x+ get char from password file
 sta 0,y+ copy char to file name
 bne 2b end of login dir?
 lda #'/ set path sep char
 sta -1,y
 ldx #mbnam set up .mail name
3 lda 0,x+
 sta 0,y+
 bne 3b
 rts

*
* fnddir - find login dir in paswword file line
*
*  entry linbuf contains line from password file.
*   exit (x)=ptr to login dir
*

fnddir ldx #linbuf point to line
 jsr fcol find end of user name
 clr -1,x set term
 jsr fcol find end of password
 clr -1,x set term
 jsr fcol find end of user id #
 pshs x (x)=ptr to 1st char of login dir
 jsr fcol find end of login dir
 clr -1,x set term
 puls x get login dir pointer
 rts return

*
* fcol
*
* Find colon in string pointed at by X.
*

fcol lda 0,x+ get char
 cmpa #': is it ':'?
 bne fcol
 rts return

 pag

*
* crtmp
*
* Create temp mail file.
*

crtmp sys gtid get task id
 ldx #tmpn2 point to name slot
 jsr decstn convert to string
 lda #'. overwrite leading space
 sta tmpn2
 sys status,tmpn,stb2 see if temp file exists
 bec crtmp4 error if so
 sys create,tmpn,3 create temp file
 bes crtmp4 error?
 std tfd save file desc
 ldd #0 set s.input file desc
 std mfd
 jsr copy copy input to temp file
 ldd tfd close file
 sys close
 rts return
crtmp4 pshs d save error
 ldd #2 set file desc
 sys write,cctms,CCSZ output error
 puls d
 jmp abort

 pag

*
* head
*
* Output mail header (date and user name)
*

head sys time,tbuf get current time
 ldx #tbuf point to time
 jsr tmloc convert time to local
 jsr tasc convert to ascii string
 lda #$20 set spaces in string
 sta tstr+24
 sta tstr+25
 jsr fndusr find this user's name
 ldy #namslt point to name slot
 ldb #HDSZ set up counter
head2 incb bump the count
 lda 0,x+ move the name
 sta 0,y+
 bne head2 repeat?
 lda #'. term the name with period
 sta -1,y
 pshs b
 ldd #$d0d set cr
 std 0,y
 puls b
 addb #2 adjust count
 clra
 std hwrt2 setup call
 ldd tfd get file desc
 sys ind,hwrt output header
 rts return

*
* fndusr
*
* Find the user's name.  Return in linbuf.
*

fndusr sys guid get the user id
 std uid save it
 bsr fndnam look up in pswd file
 ldx #linbuf point to name
 rts return

 pag

*
* fndnam
*
* Find name in password file.
*   entry uid contains user id to search for
*

fndnam ldx linpt get current line ptr
 pshs x save it
 ldx linend get current line end ptr
 pshs x save it
 ldd namfd
 sys seek,0,0,1 get current position
 pshs x save hi pos
 pshs d save lo pos
 ldx #fbuf point to file buffer
 stx linpt init buf ptrs
 stx linend
 ldd namfd rewind password file
 sys seek,0,0,0
2 jsr getlin get a line from the file
 beq 3f eof?
 ldx #linbuf point to line
 jsr fcol find colon
 clr -1,x set term
 jsr fcol find next colon
 pshs x save pointer
 jsr fcol find end of field
 clr -1,x set term
 puls x get user id field pointer
 jsr decvt convert to binary
 cmpd uid user id match?
 bne 2b
3 puls d restore low pos
 std iseek2
 puls x restore hi pos
 stx iseek1
 ldd namfd get file desc
 sys ind,iseek
 puls x restore line end ptr
 stx linend
 puls x restore line ptr
 stx linpt
4 rts return

*
* opnpass - open the password file
*
opnpass ldx #fbuf point to file buffer
 stx linpt init buffer ptrs
 stx linend
 sys open,nfile,0 open the password file
 std namfd save file desc
 rts

*
* clspass - close the password file
*
clspass ldd namfd restore file desc
 sys close
 rts

*
* pop
*
* process options.
*
pop leax 6,s point to list of args
1 ldy 0,x++ get arg address
 beq 7f if end of arg list
 lda 0,y check char
 cmpa #'+
 bne 1b if not an option arg
 leay 1,y advance to first opt letter

2 lda 0,y+ get option letter
 beq 1b if end of option string
 ldu #poptbl (u)=option table addr

3 cmpa 0,u+ check char
 beq 5f if found
 leau 2,u advance option tbl ptr
 tst 0,u check entry
 bne 3b if not end of table
 messag 2,popms "Unknown option specified"
 jmp abort quit processing

5 lda 0,y+ check char
 cmpa #'=
 beq 6f
 leay -1,y
6 jsr [0,u] execute option processor
 bra 2b loop for next option

7 rts

poptbl fcb 'a a - send mail to all users
 fdb pop1
 fcb 0 end of table

pop1 sys guid get actual user id
 cmpd #0 system manager?
 bne 1f if not system manager
 ldd [stkptr] get count of args
 cmpd #2
 bne 2f if too many args
 inc all set all flag
 rts
1 messag 2,noper "no permission"
 jmp abort
2 messag 2,syner "command syntax error"
 jmp abort


popms msg "Unknown option specified.",$d
noper msg "No permission.",$d
syner msg 'Command syntax error',$d

 opt nol
*
* getlin
*
* Get a line from the password file.  Put it
* in the linbuf.
*

getlin ldx #linbuf point to line buffer
getli2 bsr gtch get a character
 beq getli4 eof?
 sta 0,x+ save character in buffer
 cmpa #$d end of line?
 bne getli2
 clz set ok status
getli4 rts return

 pag

*
* gtch
*
* Get a character from the password file.  Return
* eq status if eof.
*

gtch pshs x save x
gtch2 ldx linpt get line pointer
 cmpx linend end of buffer?
 bne gtch4
 ldd namfd get file desc
 sys read,fbuf,512 read in some file
 bes gtch6 error?
 cmpd #0 eof?
 beq gtch6
 ldx #fbuf point to buffer begin
 stx linpt save pointer
 leax d,x mark end of buffer
 stx linend
 ldx linpt reset pointer
gtch4 lda 0,x+ get next character
 stx linpt save pointer
 clz set ok status
 puls x,pc return
gtch6 sez set error
 puls x,pc return

 pag

*
* decvt
*
* Decimal convert routine.  Convert ascii string
* pointed at by x and null terminated.
* Return number in D and ne if error.
*

decvt ldd #0 set up zero
 pshs d
decvt2 lda 0,x+ get character
 beq decvt4 end of list?
 cmpa #'0 check for valid number
 blo decvt3 error?
 cmpa #'9
 bhi decvt3
 anda #$F mask character
 pshs a save digit
 ldd 1,s get number
 aslb multiply by 8
 rola
 aslb
 rola
 aslb
 rola
 addd 1,s add in original twice
 addd 1,s
 addb 0,s+ add in new digit
 adca #0
 std 0,s save result
 bra decvt2 repeat
decvt3 clz set error
decvt4 puls d,pc 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 pshs a
 lda #$20 setup leading space
 sta 0,x+ save in buffer
 puls a
 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

*
* prter
*
* Print  "Can't send mail to _____ "
*   entry (x)=ptr to user name
*

prter stx ewrt2 set in os call
 ldd #2 set file desc
 sys write,ermsg1,ERSZ1
 clrb set count to 0
2 lda 0,x+ look for name end
 beq 4f
 incb bump char count
 bra 2b
4 std ewrt3 save count in call
 ldd #2 set up file desc
 sys ind,ewrt output file name
 ldd #2 set file desc
 sys write,ermsg2,ERSZ2 output rest of message
 rts 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
 jsr lmul calculate time zone seconds
 ldd r0 get result
 std tzn save it
 ldd r0+2
 std tzn+2
 jsr adjtim adjust time for zone
 ldx #ltime point to time
 jsr tmutc convert to vector
 tst dlflg do dlst?
 beq tmloc6
 jsr 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
 jsr 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
 jsr 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
 jsr 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
 jsr 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
 jsr 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
 jsr 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

*
* 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

*
* 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
 jsr cvt convert to ascii
 leax 1,x skip the ':'
 ldd 2,u get minutes
 jsr cvt convert to ascii
 leax 1,x skip the ':'
 ldd 0,u get seconds
 jsr 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

*
* Strings and constants
*

nbmms fcc "Can't save mail.",$d
NBSZ equ *-nbmms
cctms fcc "Can't create temp file.",$d
CCSZ equ *-cctms
noms fcc 'You have no mail.',$d
NOMSZ equ *-noms
mlnam fcc '.mail',0
nfile fcc '/etc/log/password',0
savms fcb $d
 fcc 'Save mail? '
SAVSZ equ *-savms
mbnam fcc 'mailbox',0
comms fcc "Can't open '.mail'.",$d
COSZ equ *-comms
ermsg1 fcc "Can't send mail to '"
ERSZ1 equ *-ermsg1
ermsg2 fcc "'.",$d
ERSZ2 equ *-ermsg2
tmpn fcc '/tmp/mail'
tmpn2 fcc '        '
ylen fdb 365 year length
 fdb 366 leap year

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


hdst fcb $d
tstr fcc 'xx:xx:xx xxx xxx xx xxxx',$d,0
 fcc 'received from '
HDSZ equ *-hdst
namslt fcc '            '

dtab fcc 'SunMonTueWedThuFriSat'

mtab fcc 'JanFebMarAprMayJunJulAugSepOctNovDec'

stkptr fdb 0 system stack ptr
all fcb 0 mail to all flag
usrnm fdb 0,0,0,0,0,0
 fdb 0,0,0,0,0,0

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

icrt fcb create
 fdb usst
icrt2 fdb 0

iseek fcb seek
iseek1 fdb 0 hi pos
iseek2 fdb 0 low pos
 fdb 0 from beginning of file

iwrt fcb write
 fdb ibuf
iwrt2 fdb 0

iopn fcb open
iopn2 fdb 0,1

hwrt fcb write
 fdb hdst
hwrt2 fdb 0

ewrt fcb write
ewrt2 fdb 0
ewrt3 fdb 0

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
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
tfd fdb 0 file desc
mfd fdb 0 file desc
argpt fdb 0 arg pointer
uid fdb 0 user id
linpt fdb 0 line pointer
linend fdb 0 end pointer
namfd fdb 0 file desc

tbuf rmb 8 time buffer
ibuf rmb 32 input buffer
stb rmb 24 status buffer
stb2 rmb 24 temp status buffer

linbuf rmb 128 line buffer
fbuf rmb 512 file buffer
usst rmb 100 path name for ".mail"
usst2 rmb 100 path name for "mailbox"


 end mail