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

Compare commits

base: Apple-2gs-SW:b6bab6df8073c2a4140425aa0aaf3d2de372b22c
Branches Tags
Apple-2gs-SW:master
Apple-2gs-SW:gno-version
Apple-2gs-SW:gno-orcalib-220
Apple-2gs-SW:orcalib-220
Apple-2gs-SW:orcalib-220b7
Apple-2gs-SW:gno-orcalib-220b7
Apple-2gs-SW:orcalib-220b6
Apple-2gs-SW:gno-orcalib-220b6
Apple-2gs-SW:gno-orcalib-220b5
Apple-2gs-SW:orcalib-220b5
Apple-2gs-SW:gno-orcalib-220b4
Apple-2gs-SW:orcalib-220b4
Apple-2gs-SW:orcalib-220b3
...
compare: Apple-2gs-SW:cd1eabf60c7ec77d8875ebf8a0c4ecdc9008a68f
Branches Tags
Apple-2gs-SW:master
Apple-2gs-SW:gno-version
Apple-2gs-SW:gno-orcalib-220
Apple-2gs-SW:orcalib-220
Apple-2gs-SW:orcalib-220b7
Apple-2gs-SW:gno-orcalib-220b7
Apple-2gs-SW:orcalib-220b6
Apple-2gs-SW:gno-orcalib-220b6
Apple-2gs-SW:gno-orcalib-220b5
Apple-2gs-SW:orcalib-220b5
Apple-2gs-SW:gno-orcalib-220b4
Apple-2gs-SW:orcalib-220b4
Apple-2gs-SW:orcalib-220b3

16 Commits
b6bab6df80 ... cd1eabf60c

Author SHA1 Message Date
Stephen Heumann cd1eabf60c Update version number and README for ORCA/C 2.2.0. 2023-07-16 17:34:54 -05:00
Stephen Heumann 2f79cf3f3a Merge branch 'master' into gno-version 2023-07-03 17:11:05 -05:00
Stephen Heumann 3f70daed7d Remove floating-point code from ORCALib. 
It is being moved to SysFloat.
 2023-06-23 15:52:46 -05:00
Stephen Heumann a81a9964c2 Change several JMP instructions to BRL. 
This avoids the need for run-time relocation and makes executables smaller.
 2023-06-19 18:05:46 -05:00
Stephen Heumann a5504be621 scanf: skip remaining directives after encountering EOF. 
Encountering EOF is an input failure, which terminates scanf processing. Thus, remaining directives (even %n) should not be processed.
 2023-06-11 16:07:19 -05:00
Stephen Heumann 6bc1c3741c scanf: Do not test for EOF at the beginning of scanf processing. 
If the format string is empty or contains only %n conversions, then nothing should be read from the stream, so no error should be indicated even if it is at EOF. If a directive does read from the stream and encounter EOF, that will be handled when the directive is processed.

This could cause scanf to pause waiting for input from the console in cases where it should not.
 2023-06-11 16:05:12 -05:00
Stephen Heumann 614af65c68 printf: print inf/nan rather than INF/NAN when using f and a formats. 
This works in conjunction with SysFloat commit e409ecd4717, and at least that version of SysFloat is now required.
 2023-06-01 20:10:12 -05:00
Stephen Heumann b21a51ba33 Optimize lgamma. 
This includes adjustments that make it a little faster for most input values, but especially for |x| < 7. The impact on accuracy should be minimal.
 2023-05-22 18:05:15 -05:00
Stephen Heumann 97a295522c Implement lgamma (C99). 
This uses an approximation based on the Stirling series for most positive values, but uses separate rational approximations for greater accuracy near 1 and 2. A reflection formula is used for negative values.
 2023-05-21 18:24:01 -05:00
Stephen Heumann afff478793 More small size optimizations for (f)printf. 2023-04-18 22:27:49 -05:00
Stephen Heumann 78a9e1d93b printf: Unify code for hex and octal formatting. 
These are similar enough that they can use the same code with just a few conditionals, which saves space.

(This same code can also be used for binary when that is added.)
 2023-04-17 21:52:26 -05:00
Stephen Heumann 67ae5f7b44 printf: optimize hex and octal printing code. 
This also fixes a bug: printf("%#.0o\n", 0) should print "0", rather than nothing.
 2023-04-17 19:36:45 -05:00
Stephen Heumann 80c0bbc32b Small size optimizations in printf code. 2023-04-16 22:14:15 -05:00
Stephen Heumann 34f78fb1f2 printf: add support for 'a'/'A' conversion specifiers (C99). 
These print a floating-point number in a hexadecimal format, with several variations based on the conversion specification:

Upper or lower case letters (%A or %a)
Number of digits after decimal point (precision)
Use + sign for positive numbers? (+ flag)
Use leading space for positive numbers (space flag)
Include decimal point when there are no more digits? (# flag)
Pad with leading zeros after 0x? (0 flag)

If no precision is given, enough digits are printed to represent the value exactly. Otherwise, the value is correctly rounded based on the rounding mode.
 2023-04-16 20:23:53 -05:00
Stephen Heumann 578e544174 Update comments about printf. 2023-04-16 15:41:00 -05:00
Stephen Heumann b7b4182cd2 printf: ignore '0' flag if '-' is also used. 
This is what the standards require. Previously, the '0' flag would effectively override '-'.

Here is a program that demonstrates the problem:

#include <stdio.h>
int main(void) {
        printf("|%-020d|\n", 123);
        printf("|%0-20d|\n", 123);
        printf("|%0*d|\n", -20, 123);
}
 2023-04-16 15:39:49 -05:00
15 changed files with 190 additions and 5869 deletions
Show Stats Expand all files Collapse all files

3
Makefile
View File

@ -10,8 +10,7 @@
LIB = orca
SRCS = cc.asm ctype.asm orca.asm signal2.c stdlib.asm string.asm \
time.asm toolglue.asm vars.asm int64.asm fenv.asm fpextra.asm \
math2.asm locale.asm uchar.asm
time.asm toolglue.asm vars.asm int64.asm locale.asm uchar.asm
buildall .PHONY: build assert.o

25
README.GNO
View File

@ -1,13 +1,18 @@
This is an updated version of the ORCALib library suitable for use with
GNO 2.0.6. For those library functions that it implements, it contains
the same updates and fixes as the standard version of ORCALib included
with ORCA/C 2.2.0 B7. However, under GNO, some portions of the C standard
library are implemented by GNO's libc rather than by ORCALib, and so
updating ORCALib will not affect those library functions. This applies
This package contains a special version of ORCALib intended for use with
the GNO multitasking environment. This version of ORCALib is specific to
GNO and should only be used if you are running ORCA/C under GNO 2.0.6.
For those library functions that it implements, this version of ORCALib
contains the same updates and changes as the standard version of ORCALib
included with ORCA/C 2.2.0. However, under GNO, some portions of the C
standard library are implemented by GNO's libc rather than by ORCALib, and
so updating ORCALib will not affect those library functions. This applies
to all of <stdio.h>, as well as to certain other functions.
This library update is intended for use with ORCA/C 2.2.0 B7, but it
should also be compatible with ORCA/C versions back to 2.1.
To install the ORCA/C 2.2.0 libraries for use under GNO, you should copy
the following three libraries into the /lib directory of your GNO
installation in the order shown, replacing any previous versions:
To install the update, copy the new version of ORCALib into the /lib
directory, replacing the version provided with GNO 2.0.6.
1) ORCALib (from this package)
2) SysFloat (from the Libraries directory of your ORCA/C installation)
3) SysLib (from the Libraries directory of your ORCA/C installation)

361
fenv.asm
View File

@ -1,361 +0,0 @@
keep obj/fenv
mcopy fenv.macros
case on
****************************************************************
*
* Fenv - Floating-point environment access
*
* This code provides routines to query and modify the
* floating-point environment.
*
* Note: This relies on and only works with SANE.
*
****************************************************************
*
fenv private dummy segment
end
FE_ALL_EXCEPT gequ $001F
****************************************************************
*
* int feclearexcept(int excepts);
*
* Clear floating-point exceptions
*
* Inputs:
* excepts - floating-point exceptions to clear
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
feclearexcept start
csubroutine (2:excepts),0
FGETENV get current environment
phx
lda excepts
and #FE_ALL_EXCEPT
eor #$FFFF mask off excepts to clear
xba
and 1,S
sta 1,S
FSETENV clear them
creturn 2:#0
end
****************************************************************
*
* int fegetexceptflag(fexcept_t *flagp, int excepts);
*
* Get floating-point exception flags.
*
* Inputs:
* flagp - pointer to location to store exception flags
* excepts - floating-point exceptions to get
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
fegetexceptflag start
csubroutine (4:flagp,2:excepts),0
FGETENV get current environment
tya
and excepts get desired exceptions
and #FE_ALL_EXCEPT
sta [flagp] store them in *flagp
creturn 2:#0
end
****************************************************************
*
* int feraiseexcept(int excepts);
*
* Raise floating-point exceptions
*
* Inputs:
* excepts - floating-point exceptions to raise
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
feraiseexcept start
csubroutine (2:excepts),0
lda excepts
and #FE_ALL_EXCEPT
beq done
pha
FSETXCP raise exceptions
done creturn 2:#0
end
****************************************************************
*
* int fesetexceptflag(fexcept_t *flagp, int excepts);
*
* Set (but do not raise) floating-point exception flags
*
* Inputs:
* flagp - pointer to stored exception flags
* excepts - floating-point exceptions to set
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
fesetexceptflag start
csubroutine (4:flagp,2:excepts),0
FGETENV get env with excepts masked off
phx
lda excepts
and #FE_ALL_EXCEPT
eor #$FFFF
xba
and 1,S
sta 1,S
lda [flagp] set new exceptions
and excepts
and #FE_ALL_EXCEPT
xba
ora 1,S
sta 1,S
FSETENV
creturn 2:#0
end
****************************************************************
*
* int fetestexcept(int excepts);
*
* Test if floating-point exception flags are set
*
* Inputs:
* excepts - floating-point exceptions to test for
*
* Outputs:
* Bitwise or of exceptions that are set
*
****************************************************************
*
fetestexcept start
csubroutine (2:excepts),0
FGETENV get exception flags
tya
and excepts mask to just the ones we want
and #FE_ALL_EXCEPT
sta excepts
creturn 2:excepts
end
****************************************************************
*
* int fegetround(void);
*
* Get the current rounding direction
*
* Outputs:
* The current rounding direction
*
****************************************************************
*
fegetround start
FGETENV get high word of environment
tya
and #$00C0 just rounding direction
rtl
end
****************************************************************
*
* int fesetround(int round);
*
* Set the current rounding direction
*
* Inputs:
* round - the rounding direction to set
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
fesetround start
csubroutine (2:round),0
lda round flip words
xba
sta round
and #$3FFF do nothing if not a valid rounding dir
bne done
FGETENV set the rounding direction
txa
and #$3FFF
ora round
pha
FSETENV
stz round
done creturn 2:round
end
****************************************************************
*
* int fegetenv(fenv_t *envp);
*
* Get the current floating-point environment
*
* Inputs:
* envp - pointer to location to store environment
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
fegetenv start
csubroutine (4:envp),0
FGETENV get the environment
txa
sta [envp] store it in *envp
creturn 2:#0
end
****************************************************************
*
* int feholdexcept(fenv_t *envp);
*
* Get environment, then clear status flags and disable halts
*
* Inputs:
* envp - pointer to location to store environment
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
feholdexcept start
csubroutine (4:envp),0
FGETENV get the environment
txa
sta [envp] store it in *envp
and #$E0E0 clear exception flags and disable halts
pha
FSETENV set the new environment
creturn 2:#0
end
****************************************************************
*
* int fesetenv(const fenv_t *envp);
*
* Set the floating-point environment
*
* Inputs:
* envp - pointer to environment to set
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
fesetenv start
csubroutine (4:envp),0
lda [envp] set the environment
pha
FSETENV
creturn 2:#0
end
****************************************************************
*
* int feupdateenv(const fenv_t *envp);
*
* Save exceptions, set environment, then re-raise exceptions
*
* Inputs:
* envp - pointer to environment to set
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
feupdateenv start
csubroutine (4:envp),0
lda [envp] set the environment
pha
FPROCEXIT
creturn 2:#0
end
****************************************************************
*
* Default floating-point environment
*
****************************************************************
*
__FE_DFL_ENV start
dc i2'0'
end
****************************************************************
*
* int __get_flt_rounds(void);
*
* Get the value of FLT_ROUNDS, accounting for rounding mode
*
* Outputs:
* Current value of FLT_ROUNDS
*
****************************************************************
*
__get_flt_rounds start
FGETENV
tya get rounding direction in low bits of A
asl a
asl a
xba
inc a convert to values used by FLT_ROUNDS
and #$0003
rtl
end

117
fenv.macros
View File

@ -1,117 +0,0 @@
MACRO
&lab csubroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta 1
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+4+&work
&totallen seta &totallen+&len
&i seta &i+1
aif &i<=c:&parms,^b
.e
tsc
aif &work=0,.f
sec
sbc #&work
tcs
.f
phd
tcd
mend
MACRO
&lab creturn &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+2
sta &worklen+&totallen+2
lda &worklen+1
sta &worklen+&totallen+1
.i
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&LAB FGETENV
&LAB PEA $03
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSETENV
&LAB PEA $01
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSETXCP
&LAB PEA $15
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FPROCEXIT
&LAB PEA $19
LDX #$090A
JSL $E10000
MEND

116
fpextra.asm
View File

@ -1,116 +0,0 @@
keep obj/fpextra
mcopy fpextra.macros
****************************************************************
*
* FPextra - extra floating-point routines
*
* This code provides routines dealing with floating-point
* numbers that are used only by ORCA/C, supplementing the
* ones in SysFloat.
*
****************************************************************
*
fpextra private dummy segment
end
****************************************************************
*
* ~SinglePrecision - limit fp value to single precision & range
*
* Inputs:
* extended-format real on stack
*
****************************************************************
*
~SinglePrecision start
tsc
clc
adc #4
ldy #0
phy
pha
phy
pha
phy
pha
phy
pha
FX2S
FS2X
rtl
end
****************************************************************
*
* ~DoublePrecision - limit fp value to double precision & range
*
* Inputs:
* extended-format real on stack
*
****************************************************************
*
~DoublePrecision start
tsc
clc
adc #4
ldy #0
phy
pha
phy
pha
phy
pha
phy
pha
FX2D
FD2X
rtl
end
****************************************************************
*
* ~CompPrecision - limit fp value to comp precision & range
*
* Inputs:
* extended-format real on stack
*
* Note: This avoids calling FX2C on negative numbers,
* because it is buggy for certain values.
*
****************************************************************
*
~CompPrecision start
tsc round to integer
clc
adc #4
pea 0
pha
FRINTX
lda 4+8,s
pha save original sign
asl a force sign to positive
lsr a
sta 6+8,s
tsc limit precision
clc
adc #6
ldy #0
phy
pha
phy
pha
phy
pha
phy
pha
FX2C
FC2X
pla restore original sign
bpl ret
lda 4+8,s
ora #$8000
sta 4+8,s
ret rtl
end

42
fpextra.macros
View File

@ -1,42 +0,0 @@
MACRO
&LAB FX2S
&LAB PEA $0210
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2D
&LAB PEA $0110
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2C
&LAB PEA $0510
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FC2X
&LAB PEA $050E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FD2X
&LAB PEA $010E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FS2X
&LAB PEA $020E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FRINTX
&LAB PEA $0014
LDX #$090A
JSL $E10000
MEND

270
int64.asm
View File

@ -515,273 +515,3 @@ loop1 asl num1 do the remaining shift
rt0 pld
rtl rtl
end
****************************************************************
*
* ~CnvULongLongReal - convert an unsigned long long integer
* into an extended SANE real
*
* Inputs:
* unsigned long long int on stack
*
* Outputs:
* extended real on stack
*
****************************************************************
*
~CnvULongLongReal start
mantissa equ 4 mantissa (integer and fraction)
exponent equ mantissa+8 biased exponent and sign bit
lda 1,S move return value
pha
lda 4,S
sta 2,S
tsc set up DP
phd
tcd
lda mantissa+2 move 64-bit value to mantissa
sta mantissa
lda mantissa+4
sta mantissa+2
lda mantissa+6
sta mantissa+4
lda mantissa+8
sta mantissa+6
ora mantissa if value is 0 then
ora mantissa+2
ora mantissa+4
beq ret return
lda #63+16383 set initial exponent (2^63) and sign
sta exponent
lda mantissa+6 if number is normalized (i=1) then
bmi ret return
lp1 dec exponent normalize number
asl mantissa
rol mantissa+2
rol mantissa+4
rol mantissa+6
bpl lp1
ret pld
rtl
end
****************************************************************
*
* ~CnvLongLongReal - convert a long long integer into
* an extended SANE real
*
* Inputs:
* signed long long int on stack
*
* Outputs:
* extended real on stack
*
****************************************************************
*
~CnvLongLongReal start
mantissa equ 4 mantissa (integer and fraction)
exponent equ mantissa+8 biased exponent and sign bit
lda 1,S move return value
pha
lda 4,S
sta 2,S
tsc set up DP
phd
tcd
lda mantissa+2 move 64-bit value to mantissa
sta mantissa
lda mantissa+4
sta mantissa+2
lda mantissa+6
sta mantissa+4
lda mantissa+8
sta mantissa+6
ora mantissa if value is 0 then
ora mantissa+2
ora mantissa+4
beq ret return
ldy #0 default sign bit is 0 (positive)
lda mantissa+6 if mantissa is negative then
bpl lb0
negate8 mantissa negate it
ldy #$8000 sign bit is 1 (negative)
lb0 tya set sign
ora #63+16383 set initial exponent (2^63)
sta exponent
lda mantissa+6 if number is normalized (i=1) then
bmi ret return
lp1 dec exponent normalize number
asl mantissa
rol mantissa+2
rol mantissa+4
rol mantissa+6
bpl lp1
ret pld
rtl
end
****************************************************************
*
* ~CnvRealLongLong - convert an extended SANE real into
* a long long integer
*
* Inputs:
* extended real on stack
*
* Outputs:
* signed long long int on stack
*
* Note: This avoids calling FX2C on negative numbers,
* because it is buggy for certain values.
*
****************************************************************
*
~CnvRealLongLong start
tsc
clc
adc #4
pea 0 push src address for fcpxx
pha
pea llmin|-16 push dst address for fcpxx
pea llmin
pea 0 push operand address for ftintx
pha
ftintx round
fcpxx compare with LLONG_MIN
bne convert
lda #$8000 if it is LONG_MIN, use that value
sta 12,s
asl a
sta 10,s
sta 8,s
sta 6,s
bra done otherwise
convert lda 4+8,s
pha save original sign
asl a force sign to positive
lsr a
sta 6+8,s
tsc
clc
adc #6
pea 0 push src address for fx2c
pha
pea 0 push dst address for fx2c
inc a
inc a
pha
fx2c convert
pla if original value was negative
bpl done
sec
ldx #0 negate result
txa
sbc 6,s
sta 6,s
txa
sbc 6+2,s
sta 6+2,s
txa
sbc 6+4,s
sta 6+4,s
txa
sbc 6+6,s
sta 6+6,s
done phb move return address
pla
plx
ply
phx
pha
plb
rtl
llmin dc e'-9223372036854775808'
end
****************************************************************
*
* ~CnvRealULongLong - convert an extended SANE real into
* an unsigned long long integer
*
* Inputs:
* extended real on stack
*
* Outputs:
* unsigned long long int on stack
*
****************************************************************
*
~CnvRealULongLong start
pea 0 initially assume val <= LLONG_MAX
tsc
clc
adc #6
pea 0 push src address for fcpxx
pha
pea llbig|-16 push dst address for fcpxx
pea llbig
pea 0 push operand address for ftintx
pha
ftintx round
fcpxx compare with LLONG_MAX+1
bmi convert
lda #1 if val > LLONG_MAX:
sta 1,S save flag to indicate this
tsc
clc
adc #6
pea llbig|-16 push src address for fsubx
pea llbig
pea 0 push dst address for fsubx
pha
fsubx val -= LLONG_MAX+1
convert tsc
clc
adc #6
pea 0 push src address for fx2c
pha
pea 0 push dst address for fx2c
inc a
inc a
pha
fx2c convert val as comp
pla if orig val was > LLONG_MAX:
beq done
lda 12,s
eor #$8000
sta 12,s result += LLONG_MAX+1
done phb move return address
pla
plx
ply
phx
pha
plb
rtl
llbig dc e'9223372036854775808'
end

43
int64.macros
View File

@ -1,23 +1,4 @@
macro
&l negate8 &n1
&l ~setm
sec
ldy #0
tya
sbc &n1
sta &n1
tya
sbc &n1+2
sta &n1+2
tya
sbc &n1+4
sta &n1+4
tya
sbc &n1+6
sta &n1+6
~restm
mend
macro
&l move4 &m1,&m2
lclb &yistwo
&l ~setm
@ -140,27 +121,3 @@
.d
sta 2+&op
mend
MACRO
&LAB FTINTX
&LAB PEA $0016
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2C
&LAB PEA $0510
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCPXX
&LAB PEA $0A
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSUBX
&LAB PEA 2
LDX #$090A
JSL $E10000
MEND

2
liborca.rez
View File

@ -2,7 +2,7 @@
resource rVersion (0x1, purgeable3) {
{
2,2,0,beta,7
2,2,0,release,0
},
verUS,
"ORCALib (GNO Version)",

4
make
View File

@ -19,7 +19,7 @@ if {#} == 0
unset exit
end
for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal int64 fenv fpextra math2 locale uchar
for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal int64 locale uchar
Newer obj/{i}.a {i}.asm
if {Status} != 0
set exit on
@ -40,7 +40,7 @@ delete orcalib
set list vars.a assert.a cc.a setjmp.a ctype.a string.a stdlib.a
set list {list} time.a signal.a toolglue.a orca.a fcntl.a stdio.a int64.a
set list {list} fenv.a fpextra.a math2.a locale.a uchar.a
set list {list} locale.a uchar.a
for i in {list}
echo makelib orcalib +obj/{i}
makelib orcalib +obj/{i}

3890
math2.asm
View File

File diff suppressed because it is too large Load Diff

750
math2.macros
View File

@ -1,750 +0,0 @@
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
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta 1
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+4+&work
&totallen seta &totallen+&len
&i seta &i+1
aif &i<=c:&parms,^b
.e
tsc
aif &work=0,.f
sec
sbc #&work
tcs
.f
phd
tcd
mend
MACRO
&lab creturn &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+2
sta &worklen+&totallen+2
lda &worklen+1
sta &worklen+&totallen+1
.i
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
macro
&l cmp4 &n1,&n2
lclb &yistwo
&l ~setm
~lda.h &n1
~op.h eor,&n2
bpl ~a&SYSCNT
~lda.h &n2
~op.h cmp,&n1
bra ~b&SYSCNT
~a&SYSCNT ~lda.h &n1
~op.h cmp,&n2
bne ~b&SYSCNT
~lda &n1
~op cmp,&n2
~b&SYSCNT anop
~restm
mend
macro
&l ~lda &op
lclc &c
&c amid "&op",1,1
aif "&c"<>"{",.b
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
&l lda &op
mend
macro
&l ~lda.h &op
&l anop
lclc &c
&c amid "&op",1,1
aif "&c"="[",.b
aif "&c"<>"{",.d
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
aif &yistwo,.c
&yistwo setb 1
ldy #2
.c
&op setc "&op,y"
lda &op
mexit
.d
aif "&c"<>"#",.e
&op amid "&op",2,l:&op-1
&op setc "#^&op"
lda &op
mexit
.e
lda 2+&op
mend
macro
&l ~op &opc,&op
lclc &c
&c amid "&op",1,1
aif "&c"<>"{",.b
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
&l &opc &op
mend
macro
&l ~op.h &opc,&op
&l anop
lclc &c
&c amid "&op",1,1
aif "&c"="[",.b
aif "&c"<>"{",.d
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
aif &yistwo,.c
&yistwo setb 1
ldy #2
.c
&op setc "&op,y"
&opc &op
mexit
.d
aif "&c"<>"#",.e
&op amid "&op",2,l:&op-1
&op setc "#^&op"
&opc &op
mexit
.e
&opc 2+&op
mend
macro
&l ~restm
&l anop
aif (&~la+&~li)=2,.i
sep #32*(.not.&~la)+16*(.not.&~li)
aif &~la,.h
longa off
.h
aif &~li,.i
longi off
.i
mend
macro
&l ~setm
&l anop
aif c:&~la,.b
gblb &~la
gblb &~li
.b
&~la setb s:longa
&~li setb s:longi
aif s:longa.and.s:longi,.a
rep #32*(.not.&~la)+16*(.not.&~li)
longa on
longi on
.a
mend
macro
&l inc4 &a
&l ~setm
inc &a
bne ~&SYSCNT
inc 2+&a
~&SYSCNT ~restm
mend
macro
&l sub4 &m1,&m2,&m3
lclb &yistwo
lclc &c
&l ~setm
aif c:&m3,.a
&c amid "&m2",1,1
aif "&c"<>"#",.a
&c amid "&m1",1,1
aif "&c"="{",.a
aif "&c"="[",.a
&c amid "&m2",2,l:&m2-1
aif &c>=65536,.a
sec
~lda &m1
~op sbc,&m2
~sta &m1
bcs ~&SYSCNT
~op.h dec,&m1
~&SYSCNT anop
ago .c
.a
aif c:&m3,.b
lclc &m3
&m3 setc &m1
.b
sec
~lda &m1
~op sbc,&m2
~sta &m3
~lda.h &m1
~op.h sbc,&m2
~sta.h &m3
.c
~restm
mend
macro
&l ~sta &op
lclc &c
&c amid "&op",1,1
aif "&c"<>"{",.b
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
&l sta &op
mend
macro
&l ~sta.h &op
&l anop
lclc &c
&c amid "&op",1,1
aif "&c"="[",.b
aif "&c"<>"{",.d
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
aif &yistwo,.c
&yistwo setb 1
ldy #2
.c
&op setc "&op,y"
sta &op
mexit
.d
sta 2+&op
mend
macro
&l cmpl &n1,&n2
lclb &yistwo
&l ~setm
~lda.h &n1
~op.h cmp,&n2
bne ~a&SYSCNT
~lda &n1
~op cmp,&n2
~a&SYSCNT anop
~restm
mend
macro
&l jmi &bp
&l bpl *+5
brl &bp
mend
macro
&l jpl &bp
&l bmi *+5
brl &bp
mend
macro
&l jeq &bp
&l bne *+5
brl &bp
mend
MACRO
&LAB FCLASSS
&LAB PEA $021C
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCLASSD
&LAB PEA $011C
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCLASSX
&LAB PEA $001C
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2S
&LAB PEA $0210
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2D
&LAB PEA $0110
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCMPX
&LAB PEA $0008
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FEXP2X
&LAB PEA $000A
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FEXP1X
&LAB PEA $000C
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FLN1X
&LAB PEA $0004
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FLOG2X
&LAB PEA $0002
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FLOGBX
&LAB PEA $001A
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2I
&LAB PEA $0410
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FTINTX
&LAB PEA $0016
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FRINTX
&LAB PEA $0014
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FXPWRY
&LAB PEA $0012
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FREMX
&LAB PEA $000C
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSCALBX
&LAB PEA $0018
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSUBX
&LAB PEA $0002
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FGETENV
&LAB PEA $03
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSETENV
&LAB PEA $01
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2C
&LAB PEA $0510
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCPXX
&LAB PEA $0A
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FNEXTX
&LAB PEA $001E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2X
&LAB PEA $0010
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCPXD
&LAB PEA $010A
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FNEXTD
&LAB PEA $011E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FD2X
&LAB PEA $010E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FS2X
&LAB PEA $020E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FNEXTS
&LAB PEA $021E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCPXS
&LAB PEA $020A
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FPROCENTRY
&LAB PEA $0017
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FPROCEXIT
&LAB PEA $0019
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FTESTXCP
&LAB PEA $001B
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FADDS
&LAB PEA $0200
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSETXCP
&LAB PEA $0015
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FADDX
&LAB PEA $0000
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FADDI
&LAB PEA $0400
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSUBI
&LAB PEA $0402
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FMULX
&LAB PEA $0004
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSQRTX
&LAB PEA $0012
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FLNX
&LAB PEA $0000
LDX #$0B0A
JSL $E10000
MEND
MACRO
&lab _SDivide
&lab ldx #$0A0B
jsl $E10000
MEND
MACRO
&LAB FMULI
&LAB PEA $0404
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FDIVI
&LAB PEA $0406
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FDIVX
&LAB PEA $0006
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FXPWRI
&LAB PEA $0010
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FCMPS
&LAB PEA $0208
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FEXPX
&LAB PEA $0008
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FCMPI
&LAB PEA $0408
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSUBS
&LAB PEA $0202
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSINX
&LAB PEA $001A
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FREMI
&LAB PEA $040C
LDX #$090A
JSL $E10000
MEND
macro
&l dec4 &a
&l ~setm
lda &a
bne ~&SYSCNT
dec 2+&a
~&SYSCNT dec &a
~restm
mend
macro
&l add4 &m1,&m2,&m3
lclb &yistwo
lclc &c
&l ~setm
aif c:&m3,.a
&c amid "&m2",1,1
aif "&c"<>"#",.a
&c amid "&m1",1,1
aif "&c"="{",.a
aif "&c"="[",.a
&c amid "&m2",2,l:&m2-1
aif &c>=65536,.a
clc
~lda &m1
~op adc,&m2
~sta &m1
bcc ~&SYSCNT
~op.h inc,&m1
~&SYSCNT anop
ago .c
.a
aif c:&m3,.b
lclc &m3
&m3 setc &m1
.b
clc
~lda &m1
~op adc,&m2
~sta &m3
~lda.h &m1
~op.h adc,&m2
~sta.h &m3
.c
~restm
mend

8
orca.asm
View File

@ -53,7 +53,7 @@ lb1 rtl
*
enddesk start
jmp ~ENDDESK
brl ~ENDDESK
end
****************************************************************
@ -64,7 +64,7 @@ enddesk start
*
endgraph start
jmp ~ENDGRAPH
brl ~ENDGRAPH
end
****************************************************************
@ -119,7 +119,7 @@ id dc 8c' ',i1'0'
*
startdesk start
jmp ~STARTDESK
brl ~STARTDESK
end
****************************************************************
@ -130,7 +130,7 @@ startdesk start
*
startgraph start
jmp ~STARTGRAPH
brl ~STARTGRAPH
end
****************************************************************

422
stdio.asm
View File

@ -1322,11 +1322,10 @@ fprintf start
sta stream+2
phy restore return address/data bank
phx
ldx stream
plb
lda >stream+2 verify that stream exists
pha
lda >stream
pha
pha verify that stream exists
phx
jsl ~VerifyStream
bcc lb1
lda #EIO
@ -3327,11 +3326,10 @@ vfprintf start
sta stream+2
phy restore return address/data bank
phx
ldx stream
plb
lda >stream+2 verify that stream exists
pha
lda >stream
pha
pha verify that stream exists
phx
jsl ~VerifyStream
bcc lb1
lda #EIO
@ -3881,40 +3879,33 @@ argp equ 7 argument pointer
;
; For signed numbers, if the value is negative, use the sign flag
;
lda ~isLongLong handle long long values
beq sn0
ldy #6
lda [argp],Y
bpl cn0
sec
lda #0
sbc [argp]
sta [argp]
ldy #2
lda #0
sbc [argp],Y
sta [argp],Y
iny
iny
lda #0
sbc [argp],Y
sta [argp],Y
iny
iny
lda #0
sbc [argp],Y
sta [argp],Y
bra sn2
sn0 lda ~isLong handle long values
lda ~isLong handle long and long long values
beq sn0a
ldy #2
lda [argp],Y
lda ~isLongLong
beq sn0
ldy #6
sn0 lda [argp],Y
bpl cn0
sec
lda #0
ldx #0
txa
sbc [argp]
sta [argp]
lda #0
ldy #2
txa
sbc [argp],Y
sta [argp],Y
lda ~isLongLong
beq sn2
iny
iny
txa
sbc [argp],Y
sta [argp],Y
iny
iny
txa
sbc [argp],Y
sta [argp],Y
bra sn2
@ -3964,13 +3955,12 @@ cn1 lda [argp] push an int value
cn1a pha
cn2 ph4 #~str push the string addr
ph2 #l:~str push the string buffer length
ph2 #0 do an unsigned conversion
lda ~isLongLong do the proper conversion
beq cn2a
pla
jsr ~ULongLong2Dec
bra pd1
cn2a lda ~isLong
cn2a ph2 #0 do an unsigned conversion
lda ~isLong
beq cn3
_Long2Dec
bra pd1
@ -4057,17 +4047,8 @@ pn1 lda ~hexPrefix if there is a hex prefix then
jsl ~putchar
ph2 ~hexPrefix+1
jsl ~putchar
pn1a lda ~paddChar if the number needs 0 padding then
cmp #'0'
bne pn1c
lda ~fieldWidth
bmi pn1c
beq pn1c
pn1b ph2 ~paddChar print padd zeros
jsl ~putchar
dec ~fieldWidth
bne pn1b
pn1c lda ~precision if the number needs more padding then
pn1a jsr ~ZeroPad pad with '0's if needed
lda ~precision if the number needs more padding then
beq pn3
pn2 ph2 #'0' print padd characters
jsl ~putchar
@ -4095,10 +4076,10 @@ pn5 cpy #l:~str quit if we're at the end of the ~str
;
rn1 lda ~isLongLong
beq rn2
inc argp
inc argp
inc argp
inc argp
lda argp
clc
adc #4
sta argp
rn2 lda ~isLong
beq rn3
inc argp
@ -4244,9 +4225,12 @@ lb1 clc restore the original argp+4
****************************************************************
*
* ~Format_o - format an octal number
* ~Format_x - format a hexadecimal number (lowercase output)
* ~Format_X - format a hexadecimal number (uppercase output)
* ~Format_p - format a pointer
*
* Inputs:
* ~altForm - use a leading '0'?
* ~altForm - use a leading '0' (octal) or '0x' (hex)?
* ~fieldWidth - output field width
* ~paddChar - padd character
* ~leftJustify - left justify the output?
@ -4260,15 +4244,34 @@ lb1 clc restore the original argp+4
~Format_o private
using ~printfCommon
argp equ 7 argument pointer
lda #3 use 3 bits per output character
bra cn0
~Format_x entry
;
; Set the "or" value; this is used to set the case of character results
;
lda #$20*256
sta ~orVal
bra hx0
~Format_p entry
inc ~isLong
~Format_X entry
stz ~orVal
hx0 lda #4 use 4 bits per output character
;
; Initialization
;
cn0 sta bitsPerChar
stz ~hexPrefix assume we won't lead with 0x
stz ~sign ignore the sign flag
lda #' ' initialize the string to blanks
sta ~str
move ~str,~str+1,#l:~str-1
stz ~num+2 get the value to convert
lda ~isLongLong
lda ~isLongLong get the value to convert
beq cn1
ldy #6
lda [argp],Y
@ -4279,7 +4282,7 @@ argp equ 7 argument pointer
sta ~num+4
cn1 lda ~isLong
beq cn2
cn1a ldy #2
ldy #2
lda [argp],Y
sta ~num+2
cn2 lda [argp]
@ -4287,57 +4290,71 @@ cn2 lda [argp]
beq cn2a
and #$00FF
cn2a sta ~num
ldx bitsPerChar if doing hex format then
cpx #3
beq cn2b
ldx ~altForm if alt form has been selected then
beq cn2b
ora ~num+2 if value is not 0 then
ora ~num+4
ora ~num+6
beq cn2b
lda #'X0' set hex prefix to '0X' or '0x'
ora ~orVal
sta ~hexPrefix
;
; Convert the number to an ASCII string
;
short I,M
ldy #l:~str-1 set up the character index
cn3 lda ~num+7 quit if the number is zero
ora ~num+6
ora ~num+5
ora ~num+4
ora ~num+3
ora ~num+2
ora ~num+1
ora ~num
beq al1
lda #0 roll off 3 bits
ldx #3
cn4 lsr ~num+7
ror ~num+6
ror ~num+5
cn2b ldy #l:~str-1 set up the character index
cn3 lda #' 0' roll off 4 bits
ldx bitsPerChar
cn4 lsr ~num+6
ror ~num+4
ror ~num+3
ror ~num+2
ror ~num+1
ror ~num
ror A
dex
bne cn4
lsr A form a character
lsr A
lsr A
lsr A
lsr A
ora #'0'
xba form a character
ldx bitsPerChar
cn4a asl A
dex
bne cn4a
cmp #('9'+1)*256+' ' if the character should be alpha then
blt cn5
clc
adc #7*256 adjust it
ora ~orVal
cn5 dey
sta ~str,Y save the character
dey
bra cn3
lda ~num+6 loop if the number is not zero
ora ~num+4
ora ~num+2
ora ~num
bne cn3
;
; If a leading zero is required, be sure we include one
; If a leading '0x' is required, be sure we include one
;
al1 cpy #l:~str-1 include a zero if no characters have
beq al2 been placed in the string
lda ~altForm branch if no leading zero is required
lda bitsPerChar if doing octal format then
cmp #3
bne al3
lda ~altForm if alt form has been selected then
beq al3
al2 lda #'0'
sta ~str,Y
al3 long I,M
lda ~precision make sure precision is non-zero
bne al2
inc ~precision
al2 lda #'0 ' if the result is not ' 0' then
cmp ~str+l:~str-2
beq al3
sta ~str-1,Y include a zero in the string
;
; Piggy back off of ~Format_d for output
;
stz ~hexPrefix don't lead with 0x
brl ~Format_IntOut
al3 brl ~Format_IntOut
;
; Local data
;
bitsPerChar ds 2 bits per output character
end
****************************************************************
@ -4357,36 +4374,36 @@ al3 long I,M
using ~printfCommon
argp equ 7 argument pointer
ph4 <argp save the original argp
ldy #2 dereference argp
lda [argp],Y
tax
lda [argp]
sta argp
stx argp+2
short M determine the length of the string
ldy #-1
lb1 iny
lda [argp],Y
bne lb1
long M
tya
bra lb1a
sec set flag for c-string
bra lb0
~Format_b entry
~Format_P entry
ph4 <argp save the original argp
clc set flag for p-string
lb0 ph4 <argp save the original argp
ldy #2 dereference argp
lda [argp],Y
tax
lda [argp]
sta argp
stx argp+2
lda [argp] get the length of the string
bcs lb1 if formatting a p-string then
lda [argp] get the length of the string
and #$00FF
inc4 argp
bra lb1x else if formatting a c-string then
lb1 short M compute the length of the string
ldy #-1
lb1a iny
lda [argp],Y
bne lb1a
long M
tya
lb1a ldx ~precisionSpecified if the precision is specified then
lb1x ldx ~precisionSpecified if the precision is specified then
beq lb2
cmp ~precision if the precision is smaller then
blt lb2
@ -4415,133 +4432,6 @@ lb4 clc restore and increment argp
brl ~LeftJustify handle left justification
end
****************************************************************
*
* ~Format_x - format a hexadecimal number (lowercase output)
* ~Format_X - format a hexadecimal number (uppercase output)
* ~Format_p - format a pointer
*
* Inputs:
* ~altForm - use a leading '0x'?
* ~fieldWidth - output field width
* ~paddChar - padd character
* ~leftJustify - left justify the output?
* ~isLong - is the operand long?
* ~isLongLong - is the operand long long?
* ~precision - precision of output
* ~precisionSpecified - was the precision specified?
*
****************************************************************
*
~Format_x private
using ~printfCommon
argp equ 7 argument pointer
;
; Set the "or" value; this is used to set the case of character results
;
lda #$20
sta orVal
bra cn0
~Format_p entry
lda #1
sta ~isLong
~Format_X entry
stz orVal
;
; Initialization
;
cn0 stz ~sign ignore the sign flag
lda #' ' initialize the string to blanks
sta ~str
move ~str,~str+1,#l:~str-1
stz ~num+2 get the value to convert
stz ~num+4
stz ~num+6
lda ~isLongLong
beq cn1
ldy #6
lda [argp],Y
sta ~num+6
dey
dey
lda [argp],Y
sta ~num+4
cn1 lda ~isLong
beq cn2
ldy #2
lda [argp],Y
sta ~num+2
cn2 lda [argp]
ldx ~isByte
beq cn2a
and #$00FF
cn2a sta ~num
ora ~num+2
ora ~num+4
ora ~num+6
bne cn2b
stz ~altForm if value is 0, do not print hex prefix
cn2b stz ~hexPrefix assume we won't lead with 0x
;
; Convert the number to an ASCII string
;
short I,M
ldy #l:~str-1 set up the character index
cn3 lda #0 roll off 4 bits
ldx #4
cn4 lsr ~num+7
ror ~num+6
ror ~num+5
ror ~num+4
ror ~num+3
ror ~num+2
ror ~num+1
ror ~num
ror A
dex
bne cn4
lsr A form a character
lsr A
lsr A
lsr A
ora #'0'
cmp #'9'+1 if the character should be alpha,
blt cn5 adjust it
adc #6
ora orVal
cn5 sta ~str,Y save the character
dey
lda ~num+7 loop if the number is not zero
ora ~num+6
ora ~num+5
ora ~num+4
ora ~num+3
ora ~num+2
ora ~num+1
ora ~num
bne cn3
;
; If a leading '0x' is required, be sure we include one
;
lda ~altForm branch if no leading '0x' is required
beq al3
al2 lda #'X' insert leading '0x'
ora orVal
sta ~hexPrefix+1
lda #'0'
sta ~hexPrefix
al3 long I,M
;
; Piggy back off of ~Format_d for output
;
brl ~Format_IntOut
;
; Local data
;
orVal ds 2 for setting the case of characters
end
****************************************************************
*
* ~Format_Percent - format the '%' character
@ -4669,10 +4559,12 @@ stream equ 3 input stream
*
* ~LeftJustify - print padd characters for left justification
* ~RightJustify - print padd characters for right justification
* ~ZeroPad - print zeros to pad to field width
*
* Inputs:
* ~fieldWidth - # chars to print ( <= 0 prints none)
* ~leftJustify - left justify the output?
* ~paddChar - padding character
*
****************************************************************
*
@ -4695,6 +4587,19 @@ lb1 ph2 #' ' write the proper # of padd characters
dec ~fieldWidth
bne lb1
rts
~ZeroPad entry
lda ~paddChar if the number needs 0 padding then
cmp #'0'
bne zp2
lda ~fieldWidth
bmi zp2
beq zp2
zp1 ph2 ~paddChar print padd zeros
jsl ~putchar
dec ~fieldWidth
bne zp1
zp2 rts
end
****************************************************************
@ -4793,7 +4698,7 @@ lb3 creturn 4:ptr
* -----------------------
*
* An 'l' indicates that the 'd', 'o', 'u', 'x' or 'X' argument is
* long. 'L' and 'u' are also accepted for compliance with ANSI C,
* long. 'L' and 'h' are also accepted for compliance with ANSI C,
* but have no effect in this implementation.
*
* Conversion Specifier
@ -4806,12 +4711,14 @@ lb3 creturn 4:ptr
* while 'X' generates uppercase hex digits.
* c Character.
* s String.
* p Pascal string.
* P,b Pascal string.
* p Pointer.
* n The argument is (int *); the number of characters written so
* far is written to the location.
* f Signed decimal floating point.
* f,F Signed decimal floating point.
* e,E Exponential format floating point.
* g,G Use f,e or E, as appropriate.
* a,A Hexadecimal format floating point.
* % Write a '%' character.
*
****************************************************************
@ -4940,23 +4847,23 @@ Flag lda [format] get the character
and #$00FF
cmp #'-' if it is a '-' then
bne fl1
lda #1 left justify the output
sta ~leftJustify
sta ~leftJustify left justify the output
lda #' ' pad with spaces (ignore any '0' flag)
sta ~paddChar
bra fl5
fl1 cmp #'0' if it is a '0' then
bne fl2
sta ~paddChar padd with '0' characters
ldx ~leftJustify if not left justifying then
bne fl5
sta ~paddChar padd with '0' characters
bra fl5
fl2 cmp #'+' if it is a '+' or ' ' then
beq fl3
cmp #' '
bne fl4
ldx ~sign
cpx #'+'
beq fl5
fl3 sta ~sign set the sign flag
fl3 tsb ~sign set the sign flag ('+' overrides ' ')
bra fl5
fl4 cmp #'#' if it is a '#' then
@ -4986,8 +4893,10 @@ GetSize stz val assume a value of 0
bne fv0
eor #$ffff negative field width is like
inc a positive with - flag
ldx #1
ldx #'-'
stx ~leftJustify
ldx #' '
stx ~paddChar
bra fv1
fv0 lda #0 negative precision is ignored
stz ~precisionSpecified
@ -5021,10 +4930,10 @@ val ds 2 value
; List of format specifiers and the equivalent subroutines
;
fList dc c'%',a'~Format_Percent' %
dc c'a',a'~Format_e' a (not formatted correctly)
dc c'A',a'~Format_E' A (not formatted correctly)
dc c'a',a'~Format_a' a
dc c'A',a'~Format_A' A
dc c'f',a'~Format_f' f
dc c'F',a'~Format_f' F
dc c'F',a'~Format_F' F
dc c'e',a'~Format_e' e
dc c'E',a'~Format_E' E
dc c'g',a'~Format_g' g
@ -5074,8 +4983,9 @@ fListEnd anop
;
; Work buffers
;
~num ds 8 long long integer
~num ds 8 long long integer (must be 0 after each conversion)
~numChars ds 2 number of characters printed with this printf
~orVal ds 2 value to 'or' with to set case of characters
~str ds 83 string buffer
;
; Real formatting
@ -5958,13 +5868,9 @@ ps stz ~assignments no assignments yet
stz ~scanCount no characters scanned
stz ~scanError no scan error so far
stz ~eofFound eof was not the first char
jsl ~getchar test for eof
cmp #EOF
bne ps0
sta ~eofFound
ps0 jsl ~putback
ps1 lda ~scanError quit if a scan error has occurred
ora ~eofFound
bne rm1
lda [format] get a character
and #$00FF

6
stdlib.asm
View File

@ -37,7 +37,7 @@ abort start
ph2 #SIGABRT
jsl raise
lda #-1
jmp ~C_QUIT
brl ~C_QUIT
end
****************************************************************
@ -440,14 +440,14 @@ exit start
_exit entry
_Exit entry
lda 4,S
jmp ~C_QUIT
brl ~C_QUIT
end
quick_exit start
jsr ~QUICKEXIT
lda 4,S
jmp ~C_QUIT
brl ~C_QUIT
end
****************************************************************