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:orcalib-220b7
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:master
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

27 Commits
orcalib-22 ... master

Author SHA1 Message Date
Stephen Heumann 5b04986f08 Add tool glue code for ReadMouse2. 
This is documented in TBR3 and is already declared in <misctool.h>, but did not previously have glue code. TBR3 says "Applications should never make this call," but it may be useful in system utilities.
 2024-04-17 19:57:23 -05:00
Stephen Heumann d9e26d4467 Small optimizations related to 8/16-bit register switching. 2024-03-22 21:10:33 -05:00
Stephen Heumann 0e519e1e58 Small optimizations in memset and memcpy. 2024-02-29 17:16:47 -06:00
Stephen Heumann 49ffb1065b Unroll the core loop of strlen one time. 
This makes the core loop about 10% faster at the cost of 5 extra code bytes, which seems like a reasonable tradeoff.
 2024-02-26 22:14:59 -06:00
Stephen Heumann 9181b0bd73 fclose: Free the file buffer earlier. 
This moves the free() call for the file buffer before the malloc() that occurs when closing a temp file, which should at least slightly reduce the chances that the malloc() call fails.
 2024-02-20 22:22:26 -06:00
Stephen Heumann 7384c82667 fclose: Check for malloc failure when closing temp files. 
Previously, the code for closing a temporary file assumed that malloc would succeed. If it did not, the code would trash memory and (at least in my testing) crash the system. Now it checks for and handles malloc failures, although they will still lead to the temporary file not being deleted.

Here is a test program illustrating the problem:

#include <stdio.h>
#include <stdlib.h>

int main(void) {
        FILE *f = tmpfile();
        if (!f)
                return 0;

        void *p;
        do {
                p = malloc(8*1024);
        } while (p);

        fclose(f);
}
 2024-02-20 22:20:17 -06:00
Stephen Heumann 16c7952648 fclose: close stream even if there is an error flushing buffered data. 
This can happen, e.g., if there is an IO error or if there is insufficient free disk space to flush the data. In this case, fclose should return -1 to report an error, but it should still effectively close the stream and deallocate the buffer for it. (This behavior is explicitly specified in the C99 and later standards.)

Previously, ORCA/C effectively left the stream open in these cases. As a result, the buffer was not deallocated. More importantly, this could cause the program to hang at exit, because the stream would never be removed from the list of open files.

Here is an example program that demonstrates the problem:

/*
 * Run this on a volume with less than 1MB of free space, e.g. a floppy.
 * The fclose return value should be -1 (EOF), indicating an error, but
 * the two RealFreeMem values should be close to each other (indicating
 * that the buffer was freed), and the program should not hang on exit.
 */

#include <stdio.h>
#include <stddef.h>
#include <memory.h>

#define BUFFER_SIZE 1000000

int main(void) {
        size_t i;
        int ret;

        printf("At start, RealFreeMem = %lu\n", RealFreeMem());

        FILE *f = fopen("testfile", "wb");
        if (!f)
                return 0;

        setvbuf(f, NULL, _IOFBF, BUFFER_SIZE);

        for (i = 0; i < BUFFER_SIZE; i++) {
                putc('x', f);
        }

        ret = fclose(f);
        printf("fclose return value = %d\n", ret);

        printf("At end, RealFreeMem = %lu (should be close to start value)\n",
                RealFreeMem());
}
 2024-02-19 22:30:15 -06:00
Stephen Heumann 9d42552756 strncmp: Fix issues related to very large n values. 
This fixes the following issues:
*If n was 0x80000000 or greater, strncmp would return 0 without performing a comparison.
*If n was 0x1000000 or greater, strncmp might compare fewer characters than it should because the high byte of n was effectively ignored, causing it to return 0 when it should not.

Here is an example demonstrating these issues:

#pragma memorymodel 1
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#define LEN 100000
int main(void) {
        char *s1 = malloc(LEN+1);
        char *s2 = malloc(LEN+1);
        if (!s1 || !s2)
                return 0;
        for (unsigned long i = 0; i < LEN; i++) {
                s2[i] = s1[i] = '0' + (i & 0x07);
        }
        s1[LEN] = 'x';
        return strncmp(s1,s2,0xFFFFFFFF);
}
 2024-02-19 22:12:26 -06:00
Stephen Heumann bbfad1e299 strncat: fix more issues related to large n values. 
This addresses the following issues:
*If the low-order 16 bits of n were 0x0000, no concatenation would be performed.
*If n was 0x1000000 or greater, the output could be cut off prematurely because the high byte of n was effectively ignored.

The following test program demonstrates these issues:

#pragma memorymodel 1
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#define LEN2 100000
int main(void) {
        char *s1 = malloc(LEN2+2);
        char *s2 = malloc(LEN2+1);
        if (!s1 || !s2)
                return 0;
        for (unsigned long i = 0; i < LEN2; i++)
                s2[i] = '0' + (i & 0x07);
        strcpy(s1,"a");
        strncat(s1, s2, 0x1000000);
        puts(s1);
        printf("len = %zu\n", strlen(s1));
}
 2024-02-19 22:01:53 -06:00
Stephen Heumann f1582be5a2 Fix handling of large strings in strncat. 
There were two issues:
*If bit 15 of the n value was set, the second string would not be copied.
*If the length of the second string was 64K or more, it would not be copied properly because the pointers were not updated.

This test program demonstrates both issues:

#pragma memorymodel 1
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#define LEN2 100000
int main(void) {
        char *s1 = malloc(LEN2+2);
        char *s2 = malloc(LEN2+1);
        if (!s1 || !s2)
                return 0;
        for (unsigned long i = 0; i < LEN2; i++)
                s2[i] = '0' + (i & 0x07);
        strcpy(s1,"a");
        strncat(s1, s2, LEN2);
        puts(s1);
        printf("len = %zu\n", strlen(s1));
}
 2024-02-18 21:53:03 -06:00
Stephen Heumann b60c307ee6 Make strcat and strncat work properly when first string crosses a bank boundary. 
Previously, the pointer was not properly updated to account for the bank crossing, so the characters from the second string would be written to the wrong bank.

Here is an example that illustrates this:

#include <memory.h>
#include <string.h>
#include <orca.h>
#include <stdio.h>
int main(void) {
        Handle hndl = NewHandle(0x1000f, userid(), 0xC000, 0);
        if (toolerror())
                return 0;
        char *s = *hndl;
        s = (void*)((unsigned long)s | 0xffff);
        strcpy(s, "foo");
        strcat(s, "bar");
        strncat(s, "baz", 5);
        puts(s);
}
 2024-02-18 21:01:01 -06:00
Stephen Heumann bf3a4d7ceb Small optimizations in library code. 
There should be no functional differences.
 2024-02-18 17:35:21 -06:00
Stephen Heumann ce87c0e008 Add script to set filetypes. 2023-08-06 17:48:41 -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
17 changed files with 351 additions and 5968 deletions
Show Stats Expand all files Collapse all files

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

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

10
settypes Normal file
View File

@ -0,0 +1,10 @@
filetype -p =.asm src; change -p =.asm asm65816
filetype -p =.macros src; change -p =.macros asm65816
filetype m16.int64 src; change m16.int64 exec
filetype smac src; change smac asm65816
filetype backup src; change backup exec
filetype make src; change make exec
filetype settypes src; change settypes exec
filetype LICENSE txt
filetype README.md txt
filetype obj:README.txt txt

5
signal.asm
View File

@ -107,9 +107,8 @@ lb2 asl A get the signal handler address
tay
lda >subABRT-2,X
bmi lb3 skip if it is SIG_DFL or SIG_IGN
short M set up the call address
sta >jsl+3
long M
xba set up the call address
sta >jsl+2
tya
sta >jsl+1
ph2 <sig call the user signal handler

522
stdio.asm
View File

@ -83,16 +83,13 @@ stdfile equ 7 is this a standard file?
phk
plb
lda #EOF assume we will get an error
sta err
ph4 <stream verify that stream exists
jsl ~VerifyStream
jcs rts
jcs rts_err
ph4 <stream do any pending I/O
jsl fflush
tax
jne rts
sta err initialize err to fflush result
stz stdfile not a standard file
lda stream+2 bypass file disposal if the file is
@ -110,11 +107,10 @@ lb1 inc stdfile
cl0 lla p,stderr+4 find the file record that points to this
ldy #2 one
cl1 lda [p]
ora [p],Y
jeq rts
lda [p],Y
cl1 lda [p],Y
tax
ora [p]
jeq rts_err
lda [p]
cmp stream
bne cl2
@ -128,46 +124,10 @@ cl3 lda [stream] remove stream from the file list
sta [p]
lda [stream],Y
sta [p],Y
cl3a ldy #FILE_flag if the file was opened by tmpfile then
lda [stream],Y
and #_IOTEMPFILE
beq cl3d
ph4 #nameBuffSize p = malloc(nameBuffSize)
jsl malloc grPathname = p
sta p dsPathname = p+2
stx p+2
sta grPathname
stx grPathname+2
clc
adc #2
bcc cl3b
inx
cl3b sta dsPathname
stx dsPathname+2
lda #nameBuffSize p->size = nameBuffSize
sta [p]
ldy #FILE_file clRefnum = grRefnum = stream->_file
lda [stream],Y
beq cl3e
sta grRefnum
GetRefInfoGS gr GetRefInfoGS(gr)
bcs cl3c
lda grRefnum OSClose(cl)
sta clRefNum
OSClose cl
DestroyGS ds DestroyGS(ds)
cl3c ph4 <p free(p)
jsl free
bra cl3e else
cl3d ldy #FILE_file close the file
lda [stream],Y
beq cl3e
sta clRefNum
OSClose cl
cl3e ldy #FILE_flag if the buffer was allocated by fopen then
cl3a ldy #FILE_flag if the buffer was allocated by fopen then
lda [stream],Y
and #_IOMYBUF
beq cl4
beq cl3b
ldy #FILE_base+2 dispose of the file buffer
lda [stream],Y
pha
@ -176,6 +136,47 @@ cl3e ldy #FILE_flag if the buffer was allocated by fopen the
lda [stream],Y
pha
jsl free
cl3b ldy #FILE_flag if the file was opened by tmpfile then
lda [stream],Y
and #_IOTEMPFILE
beq cl3f
ph4 #nameBuffSize p = malloc(nameBuffSize)
jsl malloc
sta p
stx p+2
ora p+2 if p == NULL then
bne cl3c
lda #EOF flag error
sta err
bra cl3f just close the file
cl3c lda p
sta grPathname grPathname = p
stx grPathname+2
clc dsPathname = p+2
adc #2
bcc cl3d
inx
cl3d sta dsPathname
stx dsPathname+2
lda #nameBuffSize p->size = nameBuffSize
sta [p]
ldy #FILE_file clRefnum = grRefnum = stream->_file
lda [stream],Y
beq cl4
sta grRefnum
sta clRefNum
GetRefInfoGS gr GetRefInfoGS(gr)
bcs cl3e
OSClose cl OSClose(cl)
DestroyGS ds DestroyGS(ds)
cl3e ph4 <p free(p)
jsl free
bra cl4 else
cl3f ldy #FILE_file close the file
lda [stream],Y
beq cl4
sta clRefNum
OSClose cl
cl4 lda stdfile if this is not a standard file then
bne cl5
ph4 <stream dispose of the file buffer
@ -189,7 +190,10 @@ cl6 lda [p],Y
dey
cpy #2
bne cl6
cl7 stz err no error found
cl7 bra rts no error found
rts_err lda #EOF
sta err
rts plb
creturn 2:err
@ -1322,11 +1326,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 +3330,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 +3883,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 +3959,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 +4051,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 +4080,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 +4229,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 +4248,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 +4286,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 +4294,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 +4378,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 +4436,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 +4563,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 +4591,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 +4702,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 +4715,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 +4851,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 +4897,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 +4934,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 +4987,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 +5872,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

21
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
****************************************************************
@ -1584,16 +1584,13 @@ cn3 cmp base branch if the digit is too big
cn3a clc add in the new digit
adc val
sta val
lda val+2
adc #0
sta val+2
lda val+4
adc #0
sta val+4
lda val+6
adc #0
sta val+6
bcc cn4
inc val+2
bne cn4
inc val+4
bne cn4
inc val+6
bne cn4
stz rangeOK
cn4 inc4 str next char
bra cn1

117
string.asm
View File

@ -244,8 +244,8 @@ lb3 lda [p1],Y scan until the end of memory is reached
dex
bne lb3
ldx #0 memory matches
bra lb5
; ldx #0
bra lb5 memory matches
lb4 blt less memory differs - set the result
ldx #1
@ -253,9 +253,9 @@ lb4 blt less memory differs - set the result
less ldx #-1
lb5 long M
lda rtl remove the parameters from the stack
lb5 lda rtl remove the parameters from the stack
sta len+1
long M
lda rtl+1
sta len+2
pld
@ -303,8 +303,8 @@ rtl equ 1 return address
short M move 1 byte now
lda [p2]
sta [p1]
long M
dec len
long M
inc4 p1
inc4 p2
lb1 anop endif
@ -436,11 +436,11 @@ lb10 lda [p2],Y
dex
bne lb9
lb11 long M
ply get the original source pointer
lb11 ply get the original source pointer
plx
lda rtl remove the parameters from the stack
sta len+1
long M
lda rtl+1
sta len+2
pld
@ -482,19 +482,19 @@ rtl equ 1 return address
ph4 <p save the pointer
short M
lda val form a 2 byte value
sta val+1
short I,M
ldx val form a 2 byte value
stx val+1
lda len if there are an odd # of bytes then
lsr A
bcc lb1
lda val set 1 byte now
txa set 1 byte now
sta [p]
long M
dec len
long I,M
inc4 p
lb1 long M endif
lb1 long I,M endif
lda val set len bytes
ldx len+2 set full banks
@ -616,7 +616,9 @@ lb2 long M
clc
adc s1
sta s1
short M copy characters 'til the null is found
bcc lb2a
inc s1+2
lb2a short M copy characters 'til the null is found
ldy #0
lb3 lda [s2],Y
sta [s1],Y
@ -627,9 +629,9 @@ lb3 lda [s2],Y
inc s2+2
bra lb3
lb4 long M return to the caller
lda rtl
lb4 lda rtl return to the caller
sta s2+1
long M
lda rtl+1
sta s2+2
ldx rval+2
@ -749,9 +751,9 @@ less ldx #-1 It wasn't, so *s1 < *s2
lb3 blt less the strings differ - set the result
ldx #1
lb4 long M
lda rtl remove the parameters from the stack
lb4 lda rtl remove the parameters from the stack
sta s2+1
long M
lda rtl+1
sta s2+2
pld
@ -828,9 +830,9 @@ lb1 lda [s2],Y
inc s2+2
bra lb1
lb2 long M return to the caller
lda rtl
lb2 lda rtl return to the caller
sta s2+1
long M
lda rtl+1
sta s2+2
ldx rval+2
@ -956,9 +958,12 @@ str equ 4 pointer to the string
tcd
ldy #0 advance s1 to point to the terminating
ldx #0 null
tyx null
short M
lb1 lda [str],Y
beq lb2
iny
lda [str],Y
beq lb2
iny
bne lb1
@ -966,10 +971,10 @@ lb1 lda [str],Y
inc str+2
bra lb1
lb2 long M
pld remove str from the stack
lda 2,S
sta 6,S
lb2 pld remove str from the stack
lda 3,S
sta 7,S
long M
pla
sta 3,S
pla
@ -1013,27 +1018,35 @@ lb2 long M
clc
adc s1
sta s1
short M copy characters 'til the null is found
bcc lb2a
inc s1+2
lb2a ldx n copy characters 'til the null is found
bne lb2b
lda n+2
beq lb6
lb2b short M
ldy #0
ldx n
beq lb4
bmi lb4
lb3 lda [s2],Y
sta [s1],Y
beq lb4
beq lb5
iny
dex
bne lb3a
inc s1+2
inc s2+2
lb3a dex
bne lb3
lda n+2
ldx n+2
beq lb4
dec n+2
dex
stx n+2
ldx #0
bra lb3
lb4 lda #0 write the terminating null
sta [s1],Y
long M return to the caller
lb5 long M return to the caller
creturn 4:rval
lb6 creturn 4:rval
end
****************************************************************
@ -1060,7 +1073,6 @@ flag equ 1 return flag
ldy #0 scan until the end of string is reached
ldx n+2 or a difference is found
bmi equal
bne lb0
ldx n
beq equal
@ -1072,9 +1084,11 @@ lb1 lda [s1],Y
bne lb3
dex
bne lb1a
lda n+2
ldx n+2
beq equal
dec n+2
dex
stx n+2
ldx #0
lb1a iny
bne lb1
inc s1+2
@ -1189,20 +1203,19 @@ lb1 lda [s],Y
short M
bra lb1
lb2 long I,M no match found -> return NULL
ldx #0
lb2 ldx #0 no match found -> return NULL
txy
long I,M
bra lb4
lb3 long I,M increment s by Y and load the value
tya
and #$00FF
clc
adc s
tay
lda s+2
adc #0
tax
ldx s+2
bcc lb4
inx
lb4 lda rtl+1 remove the parameters
sta set+2
@ -1252,10 +1265,10 @@ lb1 lda [str],Y
lb2 ldy #-1 no match found -> return -1
lb3 long M
pld remove parameters from the stack
lda 2,S
sta 8,S
lb3 pld remove parameters from the stack
lda 3,S
sta 9,S
long M
pla
sta 5,S
pla
@ -1363,10 +1376,10 @@ lb2 cmp #0
iny
bpl lb1
lb3 long M
pld remove parameters from the stack
lda 2,S
sta 8,S
lb3 pld remove parameters from the stack
lda 3,S
sta 9,S
long M
pla
sta 5,S
pla

38
toolglue.asm
View File

@ -206,6 +206,44 @@ yPos ds 2
xPos ds 2
end
****************************************************************
*
* ReadMouse2 - return mouse statistics
*
* Outputs:
* Returns a pointer to a record with the following
* structure:
*
* typedef struct MouseRec {
* char mouseMode;
* char mouseStatus;
* int yPos;
* int xPos;
* }
*
****************************************************************
*
ReadMouse2 start
pha
pha
pha
_ReadMouse2
sta >~TOOLERROR
pl2 >mouseMode
pl2 >yPos
pl2 >xPos
lda #mouseMode
ldx #^mouseMode
rtl
mouseMode ds 1
mouseStatus ds 1
yPos ds 2
xPos ds 2
end
****************************************************************
*
* ReadTimeHex - returns the time in hex format

5
toolglue.macros
View File

@ -384,3 +384,8 @@
&lab ldx #$1F23
jsl $E10000
MEND
MACRO
&lab _ReadMouse2
&lab ldx #$3303
jsl $E10000
MEND