Apple-2gs-SW
/
ORCALib
mirror of https://github.com/byteworksinc/ORCALib.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into gno-version. 

The includes all the changes through the version in ORCA/C 2.2.0 B4, plus a small POSIX conformance tweak in strtol/strtoul.

# Conflicts:
#	assert.asm
#	cc.asm
#	ctype.asm
#	string.asm
#	vars.asm
This commit is contained in:
Stephen Heumann 2020-02-19 12:43:57 -06:00
parent 97c3ecad73 e9de42d6c4
commit 3145f4b023
12 changed files with 1053 additions and 363 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
assert.asm
View File

@ -34,9 +34,9 @@ __assert start
csubroutine (4:f,2:l,4:s),0
ph4 s
ph2 l
ph4 f
ph4 <s
ph2 <l
ph4 <f
ph4 #msg
ph4 >__assertfp
jsl fprintf

169
assert.macros
View File

@ -1,81 +1,94 @@
MACRO
&LAB PH2 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDA (&N1)
PHA
AGO .E
.B
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PH4 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDY #2
LDA (&N1),Y
PHA
LDA (&N1)
PHA
AGO .E
.B
AIF "&C"<>"[",.C
LDY #2
LDA &N1,Y
PHA
LDA &N1
PHA
AGO .E
.C
LDA &N1+2
PHA
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA +(&N1)|-16
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
macro
&l ph2 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
lda (&n1)
pha
ago .e
.b
aif "&c"="<",.c
lda &n1
pha
ago .e
.c
&n1 amid &n1,2,l:&n1-1
pei &n1
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
macro
&l ph4 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab csubroutine &parms,&work
&lab anop

170
cc.asm
View File

@ -172,8 +172,8 @@ TAB equ 9 TAB key code
plb
plx
ply
pea 0 make room for argc, argv
pea 0
pea targv|-16 make room for argc, argv
per targv (default argv = ptr to targv)
pea 0
phy put the return addr back on the stack
phx
@ -184,36 +184,53 @@ TAB equ 9 TAB key code
stz ~ExitList no exit routines, yet
stz ~ExitList+2
stz ~QuickExitList
stz ~QuickExitList+2
lda cLine if cLine == 0 then
ora cLine+2
jeq rtl exit
bne lb0
stz targv argv[0] = NULL
stz targv+2
brl rtl exit
add4 cLine,#8 skip the shell identifier
lb0 add4 cLine,#8 skip the shell identifier
ldx #0 count the arguments
txy
short M
lb2 lda [cLine],Y
* skip over white space
lb1 lda [cLine],Y
beq lb6
cmp #' '
beq lb3
cmp #'"'
beq lb3
cmp #TAB
bne lb4
lb3 iny
bra lb2
lb4 inx
lb5 lda [cLine],Y
beq lb6
cmp #' '
beq lb2
cmp #'"'
beq lb2
cmp #TAB
beq lb2
iny
bra lb5
cmp #' '
beq lb1
cmp #TAB
beq lb1
inx
cmp #'"'
beq lb3
* skip to next white space
lb2 anop
lda [cLine],y
beq lb6
iny
cmp #' '
beq lb1
cmp #TAB
beq lb1
bra lb2
* skip to next "
lb3 anop
lda [cLine],y
beq lb6
iny
cmp #'"'
beq lb1
bra lb3
lb6 long M
txa we need (X+1)*4 + strlen(cLine)+1 bytes
inc A
@ -333,17 +350,26 @@ start ds 2 start of the command line string
plb
plx
ply
pea 0 set argc, argv to 0
pea 0
pea targv|-16 set argc = 0, argv to point to targv
per targv
pea 0
phy put the return addr back on the stack
phx
stz ~ExitList no exit routines, yet
stz ~ExitList+2
stz ~QuickExitList
stz ~QuickExitList+2
lda #~RTL set up so exit(), etc. call ~RTL
sta ~C_Quit+1
stz targv argv[0] = NULL
stz targv+2
plb return
rtl
targv ds 4
end
****************************************************************
@ -422,14 +448,78 @@ lb4 pld return
rts
end
****************************************************************
*
* ~QuickExit - call quick exit routines
*
* Inputs:
* ~QuickExitList - list of quick exit routines
*
****************************************************************
*
~QuickExit start
ptr equ 3 pointer to exit routines
;
; Set up our stack frame
;
phb
phk
plb
ph4 ~QuickExitList set up our stack frame
phd
tsc
tcd
;
; Call the quick exit functions
;
lb1 lda ptr if the pointer is non-nil then
ora ptr+2
beq lb3
pea +(lb2-1)|-8 call the function
pea +(lb2-1)|8
phb
pla
ldy #5
lda [ptr],Y
pha
dey
dey
lda [ptr],Y
pha
phb
pla
rtl
lb2 ldy #2 dereference the pointer
lda [ptr],Y
tax
lda [ptr]
sta ptr
stx ptr+2
bra lb1
;
; return
;
lb3 pld return
pla
pla
plb
rts
end
****************************************************************
*
* ~ExitList - list of exit routines
* ~QuickExitList - list of quick exit routines
* ~C_Quit - call to quit (may be changed to call ~RTL)
*
****************************************************************
*
~ExitList start
ds 4
~QuickExitList entry
ds 4
~C_Quit entry
jmp ~QUIT
end
****************************************************************
@ -998,26 +1088,26 @@ dv10 pld return
* ~Zero - zero an area of direct page memory
*
* Inputs:
* addr - address of the memory
* size - number of bytes to zero (must be > 1)
* addr - address of the memory
* size - number of bytes to zero (must be > 1)
*
****************************************************************
*
~Zero start
~Zero start
csubroutine (2:size,4:addr),0
lda #0
sta [addr]
ldx addr
txy
iny
lda size
dea
dea
phb
mvn 0,0
plb
lda #0
sta [addr]
ldx addr
txy
iny
lda size
dea
dea
phb
mvn 0,0
plb
creturn
end
end

13
ctype.asm
View File

@ -139,8 +139,7 @@ isblank start
*
****************************************************************
*
iscntrl start
isctrl entry
iscntrl start
lda 4,S fetch the operand
tax
@ -525,6 +524,8 @@ tolower start
pla
sta 1,S
txa
bmi lb2
lda >__ctype+1,X branch if the character is not uppercase
and #_upper
beq lb1
@ -533,7 +534,7 @@ tolower start
rtl
lb1 txa return the input character
rtl
lb2 rtl
end
****************************************************************
@ -557,6 +558,8 @@ toupper start
pla
sta 1,S
txa
bmi lb2
lda >__ctype+1,X branch if the character is not lowercase
and #_lower
beq lb1
@ -565,7 +568,7 @@ toupper start
rtl
lb1 txa return the input character
rtl
lb2 rtl
end
****************************************************************
@ -847,7 +850,7 @@ __ctype start
* __ctype2 - character types array
*
* This data area defines a second array of of bit masks. It
* is used to test for character types. For example, to
* is used to test for character types. For example, to
* determine if a character is allowed as an initial character
* in a symbol, and _csym with the array element for the
* character being tested. If the result is non-zero, the

6
equates.asm
View File

@ -61,7 +61,7 @@ _IOMYBUF gequ $0040 buffer was allocated by stdio
_IOEOF gequ $0080 has an EOF been found?
_IOERR gequ $0100 has an error occurred?
_IOTEXT gequ $0200 is this file a text file?
_IOTEMPFILE gequ $0400 was this file created by tmpfile()?
_IOTEMPFILE gequ $0400 was this file created by tmpfile()?
! record structure
! ----------------
@ -70,9 +70,9 @@ FILE_ptr gequ FILE_next+4 next location to write to
FILE_base gequ FILE_ptr+4 first byte of the buffer
FILE_end gequ FILE_base+4 end of the file buffer
FILE_size gequ FILE_end+4 size of the file buffer
FILE_cnt gequ FILE_size+4 # chars that can be read/writen to buffer
FILE_cnt gequ FILE_size+4 # chars that can be read/written to buffer
FILE_pbk gequ FILE_cnt+4 put back character
FILE_flag gequ FILE_pbk+4 buffer flags
FILE_flag gequ FILE_pbk+2 buffer flags
FILE_file gequ FILE_flag+2 GS/OS file ID
sizeofFILE gequ FILE_file+2 size of the record

6
orca.asm
View File

@ -85,9 +85,9 @@ shellid start
rtl
lb1 lda >~COMMANDLINE+2
pha
lda >~COMMANDLINE
pha
pha
lda >~COMMANDLINE
pha
phd
tsc
tcd

6
signal.asm
View File

@ -4,7 +4,7 @@
****************************************************************
*
* signal - Asyncronous event signal handler
* signal - Asynchronous event signal handler
*
* April 1990
* Mike Westerfield
@ -27,7 +27,7 @@ SIGMAX gequ 6 maximum number of signals
*
* void (*signal(int sig, void (*func) (int)))(int);
*
* Set the interupt handler
* Set the interrupt handler
*
* Inputs:
* sig - signal number
@ -41,7 +41,7 @@ SIGMAX gequ 6 maximum number of signals
*
signal start
using signalCommon
ptr equ 1 old sugnal handler
ptr equ 1 old signal handler
csubroutine (2:sig,4:func),4

636
stdio.asm
View File

File diff suppressed because it is too large Load Diff

263
stdlib.asm
View File

@ -37,7 +37,7 @@ abort start
ph2 #SIGABRT
jsl raise
lda #-1
jmp ~QUIT
jmp ~C_QUIT
end
****************************************************************
@ -70,6 +70,42 @@ lb1 tay return A
rtl
end
****************************************************************
*
* void *aligned_alloc(size_t alignment, size_t size)
*
* Allocate memory with specified alignment.
*
* Inputs:
* alignment - alignment to use (only value allowed is 1)
* size - bytes of memory to allocate
*
* Outputs:
* Returns pointer to allocated memory, or NULL on error.
*
****************************************************************
*
aligned_alloc start
csubroutine (4:alignment,4:size),0
lda alignment check that alignment==1
dec a
ora alignment+2
beq good
stz size return NULL on error
stz size+2
lda #EINVAL
sta >errno
bra ret
good ph4 <size call malloc
jsl malloc
sta size
stx size+2
ret creturn 4:size
end
****************************************************************
*
* int atexit(func)
@ -123,6 +159,60 @@ rval equ 5 return value
lb1 creturn 2:rval
end
****************************************************************
*
* int at_quick_exit(func)
* void (*func)();
*
* This function is used to build a list of functions that will
* be called as part of the quick exit processing.
*
* Inputs:
* func - address of the function to call on quick exit
*
* Outputs:
* Returns 0 if successful, -1 if not.
*
****************************************************************
*
at_quick_exit start
ptr equ 1 work pointer
rval equ 5 return value
csubroutine (4:func),6
lda #-1 assume we will fail
sta rval assume we will fail
dec4 func we need the addr-1, not the addr
ph4 #8 get space for the record
jsl malloc
stx ptr+2
sta ptr
ora ptr+2 quit now if we failed
beq lb1
ldy #2 place the record in the exit list
lda >~QUICKEXITLIST
sta [ptr]
lda >~QUICKEXITLIST+2
sta [ptr],Y
lda ptr
sta >~QUICKEXITLIST
lda ptr+2
sta >~QUICKEXITLIST+2
iny place the function address in the record
iny
lda func
sta [ptr],Y
iny
iny
lda func+2
sta [ptr],Y
inc rval success...
lb1 creturn 2:rval
end
****************************************************************
*
* atof - convert a string to a float
@ -282,7 +372,7 @@ addr equ 1
jsl ~DIV2
sta div_t save the results
stx div_t+2
tay if the result is negative then
lda n if the numerator is negative then
bpl lb1
sub2 #0,div_t+2,div_t+2 make the remainder negative
lb1 lla addr,div_t return the address
@ -295,11 +385,13 @@ div_t ds 4
****************************************************************
*
* void exit(status)
* int status;
* void exit(int status);
*
* void _exit(status)
* int status;
* void _exit(int status);
*
* void _Exit(int status);
*
* void quick_exit(int status);
*
* Stop the program. Exit cleans up, _exit does not. Status
* is the status returned to the shell.
@ -313,8 +405,16 @@ exit start
jsr ~EXIT
_exit entry
_Exit entry
lda 4,S
jmp ~QUIT
jmp ~C_QUIT
end
quick_exit start
jsr ~QUICKEXIT
lda 4,S
jmp ~C_QUIT
end
****************************************************************
@ -423,7 +523,7 @@ addr equ 1
jsl ~DIV4
pl4 div_t
pl4 div_t+4
lda div_t+2 if the result is negative then
lda n+2 if the numerator is negative then
bpl lb1
sub4 #0,div_t+4,div_t+4 make the remainder negative
lb1 lla addr,div_t return the result
@ -561,7 +661,7 @@ sr4b ph4 left swap left/right entries
lda left
cmp right
sr5 blt sr2
ph4 right sqap left/right entries
ph4 right swap left/right entries
ph4 left
jsr swap
ph4 left swap left/last entries
@ -695,9 +795,9 @@ rtl equ 7 return address
val equ 3 value
negative equ 1 is the number negative?
pea 0 make room for & initialize negative
pea 0 make room for & initialize val
pea 0
pea 0 make room for & initialize negative
tsc set up direct page addressing
phd
tcd
@ -738,24 +838,30 @@ cn3 ph4 str save the starting string
ph2 base convert the unsigned number
ph4 ptr
ph4 str
jsl strtoul
jsl ~strtoul
stx val+2
sta val
txy see if we have an overflow
bpl rt1
ldy negative allow -2147483648 as legal value
beq ov0
cpx #$8000
bne ov0
tay
beq rt1
;
; Overflow - flag the error
;
lda #ERANGE errno = ERANGE
ov0 lda #ERANGE errno = ERANGE
sta >errno
lda ptr if ptr <> NULL then
ora ptr+2
bne rt1
lda 1,S *ptr = original str
sta [ptr]
ldy #2
lda 3,S
sta [ptr],Y
ldx #$7FFF return value = LONG_MAX
ldy #$FFFF
lda negative if negative then
beq ov1
inx return value = LONG_MIN
iny
ov1 sty val
stx val+2
;
; return the results
;
@ -783,6 +889,8 @@ rt2 ldx val+2 get the value
****************************************************************
*
* strtoul - convert a string to an unsigned long
* ~strtoul - alt entry point that does not parse leading
* white space and sign
*
* Inputs:
* str - pointer to the string
@ -797,23 +905,36 @@ rt2 ldx val+2 get the value
****************************************************************
*
strtoul start
base equ 18 base
ptr equ 14 *return pointer
str equ 10 string pointer
rtl equ 7 return address
base equ 22 base
ptr equ 18 *return pointer
str equ 14 string pointer
rtl equ 11 return address
rangeOK equ 9 was the number within range?
negative equ 7 was there a minus sign?
val equ 3 value
foundOne equ 1 have we found a number?
pea 0 make room for & initialize foundOne
ldx #0
bra init
~strtoul entry alt entry point called from strtol
ldx #1
init pea 1 make room for & initialize rangeOK
pea 0 make room for & initialize negative
pea 0 make room for & initialize val
pea 0
pea 0 make room for & initialize foundOne
tsc set up direct page addressing
phd
tcd
;
; Skip any leading whitespace
;
txa just process number if called from strtol
bne db1c
lda ptr if ptr in non-null then
ora ptr+2
beq sw1
@ -834,35 +955,44 @@ sw1 lda [str] skip the white space
;
; Deduce the base
;
db1 lda [str] skip any leading '+'
db1 lda [str] if the next char is '-' then
and #$00FF
cmp #'+'
cmp #'-'
bne db1a
inc4 str
db1a lda base if the base is zero then
inc negative negative := true
bra db1b
db1a cmp #'+' skip any leading '+'
bne db1c
db1b inc4 str
db1c lda base if the base is zero then
bne db2
lda #10 assume base 10
sta base
lda [str] if the first char is 0 then
and #$00FF
cmp #'0'
bne db2
bne cn1
lda #8 assume base 8
sta base
ldy #1 if the second char is 'X' or 'x' then
lda [str],Y
and #$005F
and #$00DF
cmp #'X'
bne db2
bne cn1
asl base base 16
db2 lda [str] if the first two chars are 0x or 0X then
and #$5F7F
bra db3
db2 cmp #16 if the base is 16 then
bne db4
lda [str] if the first two chars are 0x or 0X then
and #$DFFF
cmp #'X0'
bne cn1
add4 str,#2 skip them
lda base make sure the base is 16
cmp #16
bne returnERANGE
db3 add4 str,#2 skip them
bra cn1
db4 cmp #37 check for invalid base value
bge cn6
dec a
beq cn6
;
; Convert the number
;
@ -872,7 +1002,7 @@ cn1 lda [str] get a (possible) digit
blt cn5
cmp #'9'+1 branch if it is a numeric digit
blt cn2
and #$005F convert lowercase to uppercase
and #$00DF convert lowercase to uppercase
cmp #'A' branch if it is not a digit
blt cn5
cmp #'Z'+1 branch if it is not a digit
@ -901,47 +1031,56 @@ cn3 cmp base branch if the digit is too big
plx
ply
tax
bne returnERANGE
clc add in the new digit
beq cn3a
stz rangeOK
cn3a clc add in the new digit
tya
adc val
sta val
bcc cn4
inc val+2
beq returnERANGE
bne cn4
stz rangeOK
cn4 inc4 str next char
bra cn1
cn5 lda foundOne if no digits were found, flag the error
bne rt1
;
; flag an error
;
returnERANGE anop
lda #ERANGE errno = ERANGE
cn6 lda #EINVAL
sta >errno
bra rt2 skip setting ptr
bra rt2a
;
; return the results
;
rt1 lda ptr if ptr is non-null then
ora ptr+2
beq rt2
beq rt1a
lda str set it to str
sta [ptr]
ldy #2
lda str+2
sta [ptr],Y
rt2 ldx val+2 get the value
rt1a lda rangeOK check if number was out of range
bne rt2
lda #ERANGE errno = ERANGE
sta >errno
ldx #$FFFF return value = ULONG_MAX
txy
bra rt3
rt2 lda negative if negative then
beq rt2a
sub4 #0,val,val val = -val
rt2a ldx val+2 get the value
ldy val
lda rtl fix the stack
rt3 lda rtl fix the stack
sta base-1
lda rtl+1
sta base
pld
tsc
clc
adc #16
adc #20
tcs
tya return
rtl
@ -973,14 +1112,28 @@ system start
sta exComm
pla
sta exComm+2
phy execute the command
ora exComm
sta empty
bne lb1 if calling system(NULL)
lda #empty use empty command string
sta exComm
lda #^empty
sta exComm+2
lb1 phy execute the command
phx
plb
Execute ex
rtl
ldy empty
bne ret if doing system(NULL)
tya
bcs ret error => no command processor
inc a (& vice versa)
ret rtl
ex dc i'$8000'
exComm ds 4
empty ds 2
end
****************************************************************
@ -1035,7 +1188,7 @@ D equ 1 caller's DP
tsc
adc >toRemove
tcs
pld resore the caller's DP
pld restore the caller's DP
plx remove the parameter from the stack
ply
pla

43
string.asm
View File

@ -17,6 +17,7 @@
****************************************************************
*
String start dummy routine
copy equates.asm
end
@ -84,7 +85,7 @@ lb2 sty str1
* set - pointer to the set of characters
*
* Outputs:
* strset - set of bytes; non-sero for chars in set
* strset - set of bytes; non-zero for chars in set
*
****************************************************************
*
@ -202,8 +203,8 @@ lb4 lda rtl+1 remove parameters from the stack
* equal, return 0; otherwise, return 1.
*
* Inputs:
* p1 - string to concatonate to
* p2 - string to concatonate
* p1 - string to concatenate to
* p2 - string to concatenate
*
* Outputs:
* A - result
@ -576,14 +577,14 @@ lb2 long I,M
****************************************************************
*
* strcat - string concatonation
* strcat - string concatenation
*
* Place *s2 at the end of *s1, returning a pointer to *s1. No
* checking for length is performed.
*
* Inputs:
* s1 - string to concatonate to
* s2 - string to concatonate
* s1 - string to concatenate to
* s2 - string to concatenate
*
* Outputs:
* X-A - pointer to the result (s1)
@ -741,7 +742,7 @@ lb1 lda [s1],Y
inc s2+2
bra lb1
lb2 ldx #0 s1 is finished. If s2 is, too, the
lb2 ldx #0 s1 is finished. If s2 is, too, the
lda [s2],Y strings are equal.
beq lb4
less ldx #-1 It wasn't, so *s1 < *s2
@ -923,14 +924,14 @@ lb2 long M
****************************************************************
*
* strncat - string concatonation with max length
* strncat - string concatenation with max length
*
* Place *s2 at the end of *s1, returning a pointer to *s1. No
* checking for length is performed.
*
* Inputs:
* s1 - string to concatonate to
* s2 - string to concatonate
* s1 - string to concatenate to
* s2 - string to concatenate
* n - max # chars to copy
*
* Outputs:
@ -988,8 +989,8 @@ lb4 lda #0 write the terminating null
* equal, return 0; otherwise, return 1.
*
* Inputs:
* s1 - string to concatonate to
* s2 - string to concatonate
* s1 - string to concatenate to
* s2 - string to concatenate
* n - max length of the strings
*
* Outputs:
@ -1025,7 +1026,7 @@ lb1a iny
inc s2+2
bra lb1
lb2 ldx #0 s1 is finished. If s2 is, too, the
lb2 ldx #0 s1 is finished. If s2 is, too, the
lda [s2],Y strings are equal.
beq lb4
less ldx #-1 It wasn't, so *s1 < *s2
@ -1210,9 +1211,9 @@ lb3 long M
****************************************************************
*
* strrchr - find the last occurrance of a character in a string
* strrchr - find the last occurrence of a character in a string
*
* Returns a pointer to the last occurrance of the character
* Returns a pointer to the last occurrence of the character
*
* Inputs:
* str - string to search
@ -1274,9 +1275,9 @@ lb4 long M
****************************************************************
*
* strrpos - find the last occurrance of a character in a string
* strrpos - find the last occurrence of a character in a string
*
* Returns the position of the las occurrance of the character
* Returns the position of the last occurrence of the character
*
* Inputs:
* str - string to search
@ -1565,7 +1566,7 @@ ds5 anop
;
; Search for the string
;
ss0 lda lensub if the length of the sreach string is
ss0 lda lensub if the length of the search string is
and #$8000 > 32767 then use a long method
ora lensub+2
beq ss3
@ -1697,15 +1698,17 @@ lb3 lda isp s := internal state pointer
ldx isp+2
sta s
stx s+2
ora s+2 check if already at end of string
beq lb4a
lb4 anop endif
lda [s] if we are at the end of the string then
and #$00FF
bne lb5
stz set return NULL
stz set+2
stz isp set the isp to NULL
stz isp+2
lb4a stz set return NULL
stz set+2
bra lb10 else
lb5 lda [s] scan to the 1st char not in the set
and #$00FF

68
time.asm
View File

@ -41,6 +41,9 @@ second ds 4 second 0..59
count ds 4 seconds since 1 Jan 1970
t1 ds 4 work variable
t2 ds 4 work variable
lasttime ds 4 last time_t value returned by time()
lastDST dc i2'-1' tm_isdst value for lasttime
end
****************************************************************
@ -137,7 +140,10 @@ tm_wday equ 12
ldy #tm_mday convert the day to a string
lda [timeptr],Y
jsr mkstr
sta str+8
bit #$00CF check for leading '0'
bne lb1
and #$FFEF convert leading '0' to ' '
lb1 sta str+8
ldy #tm_hour convert the hour to a string
lda [timeptr],Y
jsr mkstr
@ -151,17 +157,21 @@ tm_wday equ 12
jsr mkstr
sta str+17
ldy #tm_year convert the year to a string
lda #'91'
sta str+20
lda [timeptr],Y
cmp #100
blt lb1
ldx #'02'
stx str+20
sec
sbc #100
lb1 jsr mkstr
ldy #19
sec
yr1 iny
sbc #100
bpl yr1
clc
yr2 dey
adc #100
bmi yr2
jsr mkstr
sta str+22
tya
jsr mkstr
sta str+20
lla timeptr,str
plb
@ -277,6 +287,15 @@ gmtime entry
lda [t]
sta t
stx t+2
ldy #-1 default DST setting = -1 (unknown)
cmp lasttime determine DST setting, if we can
bne lb0
cpx lasttime+2
bne lb0
ldy lastDST
lb0 sty tm_isdst
lda #69 find the year
sta year
lda #1
@ -333,15 +352,6 @@ lb2a ble lb2
sta tm_mday
ph4 #tm_sec set the day of week/year
jsl mktime
pha determine if it's daylight savings
ph2 #$5E
_ReadBParam
pla
lsr A
and #$0001
eor #$0001
sta tm_isdst
lla t,tm_sec
plb
creturn 4:t
@ -354,7 +364,7 @@ tm_mon ds 2 month 0..11
tm_year ds 2 year 70..200 (1900=0)
tm_wday ds 2 day of week 0..6 (Sun = 0)
tm_yday ds 2 day of year 0..365
tm_isdst ds 2 daylight savings? 1 = yes, 0 = no
tm_isdst ds 2 daylight savings? 1 = yes, 0 = no
end
****************************************************************
@ -363,7 +373,7 @@ tm_isdst ds 2 daylight savings? 1 = yes, 0 = no
* struct tm *tmptr
*
* Inputs:
* tmptr - poiner to a time record
* tmptr - pointer to a time record
*
* Outputs:
* tmptr->wday - day of week
@ -417,7 +427,6 @@ temp2 equ 5 temp variable
div4 count,#60*60*24
ldy #14 set the days
lda count
inc A
sta [tmptr],Y
div4 temp,#60*60*24,temp2 compute the day of week
add4 temp2,#4
@ -493,7 +502,20 @@ time start
lda count+2
sta [tptr],Y
lb1 move4 count,tptr
lb1 lda count
sta tptr
sta lasttime
lda count+2
sta tptr+2
sta lasttime+2
pha determine if it's daylight savings
ph2 #$5E
_ReadBParam
pla
lsr A
and #$0001
eor #$0001
sta lastDST
plb
creturn 4:tptr
end

30
toolglue.asm
View File

@ -36,7 +36,7 @@ ToolGlue start dummy routine
****************************************************************
*
* MiscTool - Miscelaneous tool kit
* MiscTool - Miscellaneous tool kit
*
****************************************************************
*
@ -625,21 +625,21 @@ GetMSData start
csubroutine (4:reserved,4:DP),0
tsc
sec
sbc #8
tcs
_GetMSData
tsc
sec
sbc #8
tcs
_GetMSData
sta >~TOOLERROR
ldy #2
pla
sta [DP]
pla
sta [DP],Y
pla
sta [reserved]
pla
sta [reserved],Y
ldy #2
pla
sta [DP]
pla
sta [DP],Y
pla
sta [reserved]
pla
sta [reserved],Y
creturn
end