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-220b5
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

113 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
Stephen Heumann bdfed3628d Fix fma to support large memory model. 
It was not using long addressing where needed, so it could store results in the wrong bank.
 2023-04-06 14:34:40 -05:00
Stephen Heumann 2f2d3d2056 Save a few bytes in floating-to-long long conversion code. 2023-04-04 18:06:21 -05:00
Stephen Heumann cd6131abab Small optimization of strto* functions. 2023-04-03 20:16:22 -05:00
Stephen Heumann fca8c1ef85 Save a few bytes in printf and scanf. 2023-04-03 13:26:37 -05:00
Stephen Heumann de978dab48 Use more efficient code to return values from various math functions. 2023-04-02 16:33:24 -05:00
Stephen Heumann 68fc475721 Implement fma(). 
This tries to carefully follow the C and IEEE standards regarding rounding, exceptions, etc. Like the other ORCA/C <math.h> functions, there is really just one version that has extended precision, so double rounding is still possible if the result gets assigned to a float or double variable.

In addition to the tests I added to the ORCA/C test suite, I have also tested this against (somewhat modified versions of) the following:

*FreeBSD fma tests by David Schultz:
https://github.com/freebsd/freebsd-src/blob/release/9.3.0/tools/regression/lib/msun/test-fma.c

*Tests by Bruno Haible, in the Gnulib test suite and attached to this bug report:
https://sourceware.org/bugzilla/show_bug.cgi?id=13304
 2023-04-02 16:30:29 -05:00
Stephen Heumann 3c1f357b0c Save a few bytes in the startup code. 2023-03-28 21:38:55 -05:00
Stephen Heumann a4ba2403fe Call atexit functions with correct data bank in large memory model 
Previously, the functions registered with atexit() would be called with data bank corresponding to the blank segment, which is correct in the small memory model but not necessarily in the large memory model. This could cause memory corruption or misbehavior for certain operations accessing global variables.
 2023-03-28 18:52:14 -05:00
Stephen Heumann 48371dc669 tmpnam: allow slightly longer temp directory name 
ORCA/C's tmpnam() implementation is designed to use prefix 3 if it is defined and the path is sufficiently short. I think it was intended to allow up to a 15-character disk name to be specified, but it used a GS/OS result buffer size of 16, which only leaves 12 characters for the path, including initial and terminal : characters. As such, only up to a 10-character disk name could be used. This patch increases the specified buffer size to 21, allowing for a 17-character path that can encompass a 15-character disk name.
 2023-03-08 18:59:10 -06:00
Stephen Heumann b03e462125 bsearch: return NULL without calling compare function if count==0. 
This is explicitly required in C99 and later.
 2023-02-17 20:31:55 -06:00
Stephen Heumann b3f028da2f Avoid address comparison error in qsort. 
If the last element in the range being sorted has the smallest value, rsort can be called with last set to first-1, i.e. pointing to (what would be) the element before the first one. But with large enough element sizes and appropriate address values, this address computation can wrap around and produce a negative value for last. We need to treat such a value as being less than first, so it terminates that branch of the recursive computation. Previously, we were doing an unsigned comparison, so such a last value would be treated as greater than first and would lead to improper behavior including memory trashing.

Here is an example program that can show this (depending on memory layout):

#pragma memorymodel 1
#include <stdlib.h>
#include <stdio.h>

#define PADSIZE 2000000 /* may need to adjust based on memory size/layout */
#define N 2

struct big {
        int i;
        char pad[PADSIZE];
};

int cmp(const void *p1, const void *p2) {
        int a = ((struct big *)p1)->i;
        int b = ((struct big *)p2)->i;

        return (a < b) ? -1 : (a > b);
}

int main(void) {
        int j;
        struct big *p = malloc(sizeof(struct big) * N);
        if (!p)
                return 0;

        for (j = 0; j < N; j++) {
                p[j].i = N-j;
        }

        qsort(p, N, sizeof(struct big), cmp);

        for (j = 0; j < N; j++) {
                printf("%i\n", p[j].i);
        }
}
 2023-02-16 18:45:03 -06:00
Stephen Heumann 2540b28ca3 Avoid excessively deep recursion in qsort. 
It could have O(n) recursion depth for some inputs (e.g. if already sorted or reverse sorted), which could easily cause stack overflows.

Now, recursion is only used for the smaller of the two subarrays at each step, so the maximum recursion depth is bounded to log2(n).
 2023-02-15 22:04:10 -06:00
Stephen Heumann 3417a98d10 Use proper data bank when calling comparison function in qsort. 
When using the large memory model, the wrong data bank (that of the library code rather than the program's static data) would be in place when the comparison function was called, potentially leading to data corruption or other incorrect behavior.
 2023-02-15 18:46:46 -06:00
Stephen Heumann 60d49c7dc3 Fix qsort code for swapping elements with a size of 64KiB or more. 
This code did not previously work properly, because the X register value was overwritten within the loop. This could result in incorrect behavior such as hanging or data corruption when using qsort with element sizes >= 64KiB.
 2023-02-14 18:43:40 -06:00
Stephen Heumann 74de206058 Add library function for null pointer checking. 
This is used by the new ORCA/C debugging option to check for illegal use of null pointers. It is similar to an existing routine in PasLib used by ORCA/Pascal's similar checks.
 2023-02-12 18:57:56 -06:00
Stephen Heumann 3551644355 Fix stack handling in localtime. 
This was broken by commit 882af9e075.
 2023-01-05 20:00:44 -06:00
Stephen Heumann 506b070439 Rename CVars to ~CVars to avoid namespace pollution. 2023-01-02 18:41:45 -06:00
Stephen Heumann 69765a96ef Use a variable to control use of Time Tool. 
This ensures use of the Time Tool is fully under the control of the programmer, rather than potentially being affected by other things that may load it (like the Time Zone CDev). It also avoids calls to tiStatus in the default non-Time Tool code paths, and thereby allows them to work under Golden Gate.
 2023-01-02 18:01:28 -06:00
Stephen Heumann c4d485e960 Implement timespec_get (C11). 
This follows gmtime in using the Time Tool to get UTC time if it is active, but otherwise just using local time.
 2023-01-01 21:33:00 -06:00
Stephen Heumann 44c3078ab3 mktime: force struct tm components to their normal ranges. 
This is done by calling ~gmlocaltime after computing the time_t value in mktime.
 2022-12-31 22:06:25 -06:00
Stephen Heumann 7e4f067c35 Compute tm_yday and tm_wday directly in ~gmlocaltime. 
This avoids calling mktime (future versions of which may call ~gmlocaltime), and also deals correctly with time zones.
 2022-12-31 19:10:36 -06:00
Stephen Heumann 882af9e075 Make gmlocaltime take a parameter for the struct tm to use. 
This will be needed for gmtime_r/localtime_r, but also is a step toward using this code to normalize the struct tm values for mktime.
 2022-12-30 18:46:51 -06:00
Stephen Heumann 3b0c1c2149 Fix gmtime() handling of times very near the limits of time_t. 
The UTC time may be several hours before or after local time, and therefore the UTC time/date may be slightly outside the limits of what can be represented as a local time/date. This is now handled correctly.

This also more generally fixes handling of negative seconds/minutes/hours, which is also applicable to mktime().
 2022-12-30 17:28:16 -06:00
Stephen Heumann 32c5fd94a1 Handle out-of-range months in mktime() input. 2022-12-29 23:54:10 -06:00
Stephen Heumann f15caf8096 Make gmtime/localtime properly support times near the limits of the time_t range. 
They did not properly handle times in 1969 or 2105 (for the latter, they would infinite-loop).
 2022-12-29 23:18:48 -06:00
Stephen Heumann b302a85fd6 Switch time "factor" code over to 0-based month indexing. 
This matches both struct tm and ReadTimeHex, so it avoids needing to increment the values.

Also, simplify the time() code a little bit.
 2022-12-29 22:53:37 -06:00
Stephen Heumann 17faeda1de Rework time "factor" routine to work for the full 32-bit time range. 
ORCA/C uses an unsigned 32-bit time_t which should give a range up to 2105, but calculations on it were being done with signed types, causing them not to work correctly beyond 2036-2038. Now the factor routine, mktime(), and time() should work up to 2105. (In the case of time(), this assumes ReadTimeHex reports the time correctly.)

The factor routine actually computes a 64-bit time value. Currently, the rest of the code only takes the bottom 32 bits of it, but this could be extended if we ever wanted to switch to 64-bit time_t.
 2022-12-29 22:31:31 -06:00
Stephen Heumann d30ee1a2e5 Adjust comments in time.asm to reflect actual starting date of time_t. 
It was clearly supposed to be 1 Jan 1970, but it's actually not, probably because the number of days from 1 Jan 1900 to 1 Jan 1970 was miscalculated. Changing it now could potentially cause compatibility issues (especially for GNO, which uses time_t in some kernel call interfaces and file formats), so for now it is left as is and just documented appropriately.

Nothing in the C standards requires the time_t epoch to be 1 Jan 1970, so this does not cause any standards-compliance problem for the C standards. (It is different from POSIX, though.)
 2022-12-29 14:25:24 -06:00
Stephen Heumann e2de990f4d strftime: use Time Tool Set to get time zone offset. 
This is used for the %z conversion specifier (giving the time zone offset in +-HHMM format). The %Z conversion specifier (giving the locale's time zone name or abbreviation) also prints the same thing for now.

As with gmtime, this will only use the Time Tool Set if it has already been started. Otherwise, these conversions simply produce no output.
 2022-12-28 19:55:48 -06:00
Stephen Heumann 4019e9f370 gmtime: support time zone adjustment with Time Tool Set. 
If the Time Tool Set (tool 56, by Geoff Weiss) is present and active, gmtime will use it (plus the DST flag) to determine the local time offset from UTC, allowing it to produce the correct UTC time. If not, it will still treat local time as being equal to UTC, like it did previously.

The library code will not try to load or start the Time Tool Set, so the program will have to do that before calling gmtime if it wants to use this functionality.
 2022-12-28 19:46:49 -06:00
Stephen Heumann 89664d2921 Slightly improve tgamma calculation for x < 8. 
Previously, 1-4 low-order bits of the input value were essentially ignored when calculating the numerator, but used to some degree when calculating the denominator. This would lead to the calculated tgamma values decreasing slightly over the range of several consecutive input values (when they should increase). Now, the low-order bits of the input value are effectively just rounded away. This should give slightly more accurate results, and greatly reduces the frequency of cases where consecutive output values go in the wrong direction.
 2022-12-24 21:59:52 -06:00
Stephen Heumann 5985e7d774 Implement tgamma (c99). 
This uses an approximation based on the Stirling series for large enough x (for which it is highly accurate). For smaller x, identities are used to express gamma(x) in terms of gamma(x+1) or gamma(1-x), ultimately letting the Stirling series approximation be used.
 2022-12-24 20:20:40 -06:00
Stephen Heumann 88e764f72d Implement the erf and erfc functions (C99). 
This implementation is based on the approximations given in the following paper:

W. J. Cody, Rational Chebyshev Approximations for the Error Function, Mathematics of Computation, Vol. 23, No. 107 (Jul., 1969), pp. 631-637.

Per the paper, the approximations have maximal relative error of 6e-19 or lower (although I have not verified what the figure is for this actual implementation).

See also Cody's FORTRAN implementation based on the same approach:

https://netlib.org/specfun/erf
 2022-12-17 22:25:53 -06:00
Stephen Heumann 73ed0778f2 Add cleanup code for CDev calls. 
The new CDev root code generated by ORCA/C will now branch to this code after each CDev call, giving it an opportunity to clean up if necessary. Specifically, it will dispose of the user ID allocated for the CDev if it is going away after this call. There are several cases where this occurs, which need to be detected based on the message code passed to the CDev and in some cases other factors.
 2022-12-12 18:01:28 -06:00
Stephen Heumann b81b4e1109 Fix several bugs in fgets() and gets(). 
Bugs fixes:
*fgets() would write 2 bytes in the buffer if called with n=1 (should be 1).
*fgets() would write 2 bytes in the buffer if it encountered EOF before reading any characters, but the EOF flag had not previously been set. (It should not modify the buffer in this case.)
*fgets() and gets() would return NULL if EOF was encountered after reading one or more characters. (They should return the buffer pointer).
 2022-10-15 19:01:16 -05:00
Stephen Heumann 505f1c2804 lseek: make seeking to an offset before end of file work properly. 
The direction specified by the offset was essentially reversed when calling lseek with whence==2 (seek to offset from end of file). Therefore, specifying a negative offset with whence==2 would fail, rather than seeking before the end of the file as it should.

(The ORCA/C manual is not totally clear about this behavior, but the new behavior is consistent with the POSIX spec and all other implementations I'm aware of, including traditional Unix and APW C. Note that Unix/POSIX allows seeking beyond the end of the file, but GS/OS does not.)

There are also improvements to error handling, so lseek consistently reports EINVAL for invalid offsets.
 2022-07-14 18:34:24 -05:00
Stephen Heumann a2bca0df04 Implement O_APPEND mode. 
This was documented as supported, but not actually implemented.
 2022-07-13 18:34:29 -05:00
Stephen Heumann ad273126dd Remove unnecessary instructions. 2022-07-13 18:27:24 -05:00
Stephen Heumann 7b6cb049b7 Add an 16-bit unsigned multiply routine suitable for use in C. 
This differs from the existing ~UMul2 in SysLib in that it gives the low-order 16 bits of the true result in the event of overflow. The C standards require this behavior for computations on unsigned types.
 2022-07-06 22:19:32 -05:00
Stephen Heumann 12f8d74c99 Do not use separate segments for __-prefixed versions of functions. 
The __-prefixed versions were introduced for use in <stdio.h> macros that have since been removed, so they are not really necessary any more. However, they may be used in old object files, so those symbols are still included for now.
 2022-07-05 18:24:18 -05:00
Stephen Heumann 463d24a028 Avoid errors caused by fseek after ungetc on read-only files. 
The error could occur because fseek calls fflush followed by ftell. fflush would reset the file position as if the characters in the putback buffer were removed, but ftell would still see them and try to adjust for them (in the case of a read-only file). This could result in trying to seek before the beginning of the file, producing an error.

Here is a program that was affected:

#include <stdio.h>
int main(void) {
        FILE *f = fopen("somefile","r");
        if (!f) return 0;
        fgetc(f);
        ungetc('X', f);
        fseek(f, 0, SEEK_CUR);
        if (ferror(f)) puts("error encountered");
}
 2022-07-03 21:58:00 -05:00
Stephen Heumann 219e4352a0 fseek: do not clear read/write flags for read-only/write-only streams. 
This maintains the invariant that these flags stay set to reflect the setting of the stream as read-only or write-only, allowing code elsewhere to behave appropriately based on that.
 2022-07-03 20:27:19 -05:00
Stephen Heumann 89b501f259 fread: do not try to read if EOF flag is set. 
This behavior is implied by the specification of fread in terms of fgetc.
 2022-07-03 20:04:12 -05:00
Stephen Heumann ef63f26c4f Allow writing immediately after reading to EOF. 
This should be allowed (for read/write files), but it was leading to errors, both because fputc would error out if the EOF flag was set and because the FILE record was not fully reset from its "reading" state. In particular, the _IOREAD flag and the current buffer position pointer need to be reset.

Here is a program that demonstrates the problem:

#include <stdio.h>
int main(void) {
        FILE *f = fopen("somefile","r+");
        if (!f) return 0;
        while (!feof(f)) fgetc(f); /* or: fgetc then fread */
        if (fputc('X', f) == EOF)
                puts("fputc error");
}
 2022-07-03 18:54:24 -05:00
Stephen Heumann c877c74b92 In fflush, reset the mark to account for flushing the buffer even on read-only files. 
This is needed to keep the file mark consistent with the state of the buffer. Otherwise, subsequent reads may return data from the wrong place. (Using fflush on a read-only stream is undefined behavior, but other things in stdio call it that way, so it must work consistently with what they expect.)

Here is an example that was affected by this:

#include <stdio.h>
#include <string.h>

char buf[100];

int main(void) {
        FILE *f = fopen("somefile","r");
        if (!f) return 0;

        setvbuf(f, 0L, _IOFBF, 14);

        fgets(buf, 10, f);
        printf("first read : %s\n", buf);
        ftell(f);

        memset(buf, 0, sizeof(buf));
        fgets(buf, 10, f);
        printf("second read: %s\n", buf);

        fseek(f, 0, SEEK_CUR);
        memset(buf, 0, sizeof(buf));
        fgets(buf, 10, f);
        printf("third read : %s\n", buf);
}
 2022-07-02 23:34:01 -05:00
Stephen Heumann 2d6ca8a7b2 Do not set read/write error indicator if ftell cannot get the file mark. 
This is not really an IO operation on the file, and accordingly the C standards do not describe the error indicator as being set here. In particular, you cannot get the mark for a character device, but that is expected behavior, not really an error condition.

errno is still set, indicating that the ftell operation failed.
 2022-07-02 22:09:56 -05:00
Stephen Heumann 3eb8a9cb55 Fix bug where ftell would inappropriately change the file mark. 
ftell would set the mark as if the buffer and putback were being discarded, but not actually discard them. This resulted in characters being reread once the end of the buffer was reached.

Here is an example that illustrates the problem:

#include <stdio.h>
#include <string.h>
char buf[100];
int main(void) {
        FILE *f = fopen("somefile","r"); // a file with some text
        if (!f) return 0;
        setvbuf(f, 0L, _IOFBF, 14); // to see problem sooner
        fgets(buf, 10, f);
        printf("first read : %s\n", buf);
        ftell(f);
        memset(buf, 0, sizeof(buf));
        fgets(buf, 10, f);
        printf("second read: %s\n", buf);]
}
 2022-07-02 22:05:40 -05:00
Stephen Heumann 36808404ca Fix fread bug causing it to discard buffered data. 
If you read from a file using fgetc (or another function that calls it internally), and then later read from it using fread, any data left in the buffer from fgetc would be skipped over. The pattern causing this to happen was as follows:

fread called ~SetFilePointer, which (if there was buffered data) called fseek(f, 0, SEEK_CUR). fseek would call fflush, which calls ~InitBuffer. That zeros out the buffer count. fseek then calls ftell, which gets the current mark from GS/OS and then subtracts the buffer count.  But the count was set to 0 in ~InitBuffer, so ftell reflects the position after any previously buffered data. fseek sets the mark to the position returned by ftell, i.e. after any data that was previously read and buffered, so that data would get skipped over. (Before commits 0047b755c9 and c95bfc19fb the behavior would be somewhat different due to the issue with ~InitBuffer that they addressed, but you could still get similar symptoms.)

The fix is simply to use the buffered data (if any), rather than discarding it.

Here is a test program illustrating the problem:

#include <stdio.h>
char buf[BUFSIZ+1];
#define RECSIZE 2
int main(void) {
        FILE *f = fopen("somefile","r"); // a file with some data
        if (!f) return 0;
        fgetc(f);
        size_t count = fread(buf, RECSIZE, BUFSIZ/RECSIZE, f);
        printf("read %zu records: %s\n", count, buf);
}
 2022-07-02 18:24:57 -05:00
Stephen Heumann 84f471474a Use newer, more efficient ph2/ph4 macros throughout ORCALib. 
These push DP values with pei, rather than lda+pha as in the old versions of the macros.
 2022-06-30 19:01:47 -05:00
Stephen Heumann c95bfc19fb Fix a logic error. 
There was a problem with the fix in commit 0047b755c9660: an instruction should have had an immediate operand, but did not because it was missing the #. This might cause the code to behave incorrectly, depending on memory contents.
 2022-06-28 22:25:10 -05:00
Stephen Heumann a2b3d4541a fread fixes. 
This includes changes to fread to fix two problems. The first is that fread would ignore and discard characters put back with ungetc(). The second is that it would generally return the wrong value if reading from stdin with an element size other than 1 (it would return the count of bytes, not elements).

This fixes #9 (the first problem mentioned above).
 2022-06-27 18:24:52 -05:00
Stephen Heumann 1f88a38e2e Clear the EOF flag on successful calls to ungetc(). 
This is specified by the C standards.
 2022-06-27 17:59:21 -05:00
Stephen Heumann 38666ee111 Restore changes to allow ungetc of byte values 0x80 through 0xFF. 
These are the stdio.asm changes that were present in the beta source code on Opus ][, but had been reverted in commit e3c0c962d4. As it turns out, the changes to stdio.asm were OK--the issue was simply that the definitions of stdin/stdout/stderr and the associated initialization code in vars.asm had not been updated to account for the new version of the FILE structure. That has now been done, allowing the changes to work properly.

This fixes #7.
 2022-06-27 17:58:23 -05:00
Stephen Heumann 7c2fb70c4a freopen improvements 
This adds a check for the filename argument being null, in which case it bails out and returns NULL. Previously, it would just dereference the null pointer and treat the contents of memory location 0 as a filename, with unpredictable results. A null filename indicates freopen should try to reopen the same file with a different mode, but the degree of support for that is implementation-defined. We still don't really support it, but at least this will report the failure and avoid unpredictable behavior.

It also removes some unused code at the end, but still forces fputc and fgetc to be linked in. These are needed because there are weak references to them in putchar and getchar, which may need to be used if stdin/stdout have been reopened.
 2022-06-26 21:20:23 -05:00
Stephen Heumann 8cfb73a474 Force the file mark to EOF whenever writing to a stream in append mode. 
This is what the standards require. Note that the mark is only set to EOF when actually writing to the underlying file, not merely buffering data to write later. This is consistent with the usual POSIX implementation using O_APPEND.
 2022-06-26 18:59:57 -05:00
Stephen Heumann 0047b755c9 Fix bug with fseek(..., SEEK_CUR) on read-only streams. 
This would seek to the wrong location, and in some cases try to seek before the beginning of the file, leading to an error condition.

The problem stemmed from fseek calling fflush, which sets up the stream's buffer state in a way appropriate for writing but not for reading. It then calls ftell, which (for a read-only stream) would misinterpret this state and miscalculate the current position.

The fix is to make fflush work correctly on a read-only stream, setting up the state for reading. (User code calling fflush on a read-only stream would be undefined behavior, but since fseek does it we need to make it work.)

This fixes #6.
 2022-06-26 14:35:56 -05:00
Stephen Heumann 3581d20a7c Standardize indentation using spaces. 
Most files already used spaces, but three used tabs for indentation. These have been converted to use spaces. This allows the files to be displayed with proper formatting in modern editors and on GitHub. It also removes any dependency on SysTabs settings when assembling them.

The spacing in fpextra.asm was also modified to use standard column positions.

There are no non-whitespace changes in this commit.
 2022-06-25 18:27:20 -05:00
Stephen Heumann ab2f17c249 Clear the IO error indicator as part of rewind(). 
The C standards require it to do this, in addition to calling fseek.

Here is a test that can show the issue (in a realistic program, the indicator would be set due to an actual IO error, but for testing purposes this just sets it explicitly):

#include <stdio.h>
int main(void) {
        FILE *f = tmpfile();
        if (!f) return 0;
        f->_flag |= _IOERR;
        if (!ferror(f)) puts("bad ferror");
        rewind(f);
        if (ferror(f)) puts("rewind does not reset ferror");
        fclose(f);
}
 2022-06-24 18:36:25 -05:00
Stephen Heumann 997e430562 Implement asinh(). 
This is similar to the approach recommended in Apple Numerics Manual Ch. 9, except that there is an added case for large values that would otherwise cause an overflow or spuriously report underflow.
 2021-12-24 15:56:36 -06:00
Stephen Heumann b62940404f Implement atanh(). 
This basically follows the approach recommended in Apple Numerics Manual Ch. 9.
 2021-12-23 18:30:52 -06:00
Stephen Heumann 818707ed8c Use a more accurate implementation of cbrt(). 
The previous simple one could be wrong in several low-order digits due to the inaccuracy in the representation of the exponent (1/3). This version effectively breaks the number up into the form a*8^b, computes the cube root of 8^b exactly (i.e. 2^b), and uses the slightly inaccurate exponentiation only for a.
 2021-12-21 19:11:18 -06:00
Stephen Heumann a45f531fe6 Implement hypot(). 
This uses the obvious calculation, except with scaling to avoid unnecessary overflow/underflow.

There is a discussion of hypot implementations in C. Borges, An Improved Algorithm for hypot(a,b) (https://arxiv.org/pdf/1904.09481.pdf). This implementation is similar to the "Naive (Unfused)" version discussed in that paper. As the paper notes, it is possible to get better accuracy by adding a correction term, but the "naive" version is already reasonably good, so we skip the correction in the interest of code size and speed.
 2021-12-20 21:52:48 -06:00
Stephen Heumann b01800ff77 Fix rounding issues introduced by SANE bug workarounds. 
The lrint functions could give the wrong result for negative numbers in upward/downward rounding modes. Casts to comp could also have different rounding behavior.
 2021-11-30 20:19:57 -06:00
Stephen Heumann b6690c4826 Implement acosh(). 
This is basically the implementation recommended in Apple Numerics Manual Ch. 9, except that there is an added case for large values that would otherwise cause an overflow.
 2021-11-30 19:15:54 -06:00
Stephen Heumann eddf778f09 Implement llround(). 2021-11-28 18:30:20 -06:00
Stephen Heumann 66cfa0d406 Remove unnecessary code in lround(). 2021-11-28 18:30:01 -06:00
Stephen Heumann e00c21dd70 Work around bug in FX2C and FX2L. 
These SANE operations can sometimes return incorrect values for certain negative integers such as -2147483648 and -53021371269120 (numbers with at least 16 low-order zero bits in their two's-complement representation). To work around this, we now avoid calling FX2C or FX2L on negative numbers, generally by saving and restoring the sign separately.

These workarounds are used in several of the new <math.h> rounding functions, and also for code that converts floating-point values to comp or long long. There are some places in SysFloat that should be patched similarly, so we may still hit this problem in certain situations until that is done.
 2021-11-28 14:18:27 -06:00
Stephen Heumann 503182e435 Initial implementation of lround(). 
This should work, and mostly does. However, it is affected by a bug in FX2L (and FX2C) which can sometimes give the wrong results for certain negative integers (such as -2147483648). I believe this can occur when at least the lower 16 bits if the integer (in two's-complement representation) are zeros.
 2021-11-27 17:52:46 -06:00
Stephen Heumann 88a7bbebcc Implement round(). 
This is a bit more complex than other rounding functions, because it rounds to nearest but always away from zero in halfway cases, which is not a rounding direction directly supported by SANE.
 2021-11-27 15:55:54 -06:00
Stephen Heumann d08773af0d Implement nextafter and nexttoward. 
Unlike most of the math functions, these actually have separate implementations for float/double/long double.
 2021-11-26 12:47:02 -06:00
Stephen Heumann 6364d0f48f Implement llrint. 2021-11-23 21:16:12 -06:00
Stephen Heumann ce05615a63 Implement fmax and fmin. 2021-11-23 18:54:18 -06:00
Stephen Heumann 14908ebcd6 Implement the nan() function. 
This parses the NaN code string itself, but it should give equivalent behavior to the SANE parser.
 2021-11-22 21:59:50 -06:00
Stephen Heumann c025bba177 Implement nearbyint and fdim. 2021-11-22 19:25:25 -06:00
Stephen Heumann 2334443437 Implement scalbln. 
This differs from scalbn in that the exponent has type long. When scaling an extended value, exponents slightly outside the range of int can actually be used meaningfully. We address this by doing multiple SCALBX calls (at most 2) in a loop.
 2021-11-21 20:10:36 -06:00
Stephen Heumann 268892b671 Add float and long double versions of functions in SysFloat. 
Most of these actually just jump to the existing functions, since they really use extended precision anyway. The exception is the modf functions, which need a separate implementation for each type because they store a value through a pointer to that type.
 2021-11-21 14:34:52 -06:00
Stephen Heumann 3ec8a8797f Implement some of the math functions added in C99. 
The functions implemented so far are largely the ones that map (nearly) directly to SANE calls.

Note that C99 specifies separate float/double/long double versions of each of these functions, but under ORCA/C they generally use the same code.
 2021-11-20 19:24:51 -06:00
Stephen Heumann fb5683a14d Add a function to implement the FP comparison macros in <math.h>. 
These macros differ from the normal comparison operators in that they will not signal invalid due to the operands being unordered. However, this implementation will still signal invalid for SNaNs. That is clearly OK according to the wording in draft C23. C17 and earlier do not mention that possibility, but they do not really specify the behavior of SNaNs in general.
 2021-11-02 21:56:30 -05:00
Stephen Heumann b8605de33f Add a new helper function to record varargs info when va_end is called. 
This will be used in conjunction with the new implementation of variable arguments, where they are not removed from the stack until the end of the function.
 2021-10-23 21:08:30 -05:00
Stephen Heumann e3c9bc96bc Add implementation of the <uchar.h> functions. 2021-10-03 16:02:30 -05:00
Stephen Heumann ae504c6e4f Add support for EILSEQ errno value. 
EILSEQ is required by C95 and later.
 2021-10-02 14:34:35 -05:00
Stephen Heumann 09942026a8 Add mblen function. 
The currently implementation assumes we do not actually support a multi-byte character set for char strings.
 2021-09-30 18:38:57 -05:00
Stephen Heumann 3a847d245e Add strcoll and strxfrm functions. 
This is currently a minimalistic implementation in which strcoll always sorts strings the same way as strcmp.
 2021-09-30 18:37:54 -05:00
Stephen Heumann 512fadeff0 Add an implementation of the <locale.h> functions. 
This is currently a minimalistic implementation, which only supports the C locale.
 2021-09-30 18:34:54 -05:00
Stephen Heumann 5ad86f4a0b Implement strftime. 
This is intended to be a complete implementation of strftime as specified in C17, although it lacks meaningful support for time zones or non-C locales.
 2021-09-26 20:31:15 -05:00
Stephen Heumann 379f2f93ad Fix bug causing data corruption when assigning to multiple structs. 
This affects code where multiple structs or unions are assigned by successive = operators in one expression, e.g. "s1=s2=s3". The middle struct assignment(s) would use the ~Move2 or ~LongMove2 helper functions (for <64k or >=64k moves, respectively). These functions are supposed to leave the destination pointer on the stack so it can be used as the source of a subsequent move, but they both had bugs where they could modify dest and leave that modified value on the stack, which would cause subsequent moves to use the wrong source location. In the case of ~Move2, this only happened if the size was odd.

Here is a program that demonstrated the problems with both functions:

#pragma memorymodel 1
#include <stdio.h>

struct S1 {
        char s[80000];
} a,b,c;

int main(void) {
        struct S2 {
                int x,y;
                char z;
        } d,e,f;

        c.s[66000] = 123;
        f.y = 5678;

        a = b = c;
        d = e = f;

        printf("%i %i %i\n", a.s[66000], b.s[66000], c.s[66000]);
        printf("%i %i %i\n", d.y, e.y, f.y);
}
 2021-09-17 18:25:32 -05:00
33 changed files with 9829 additions and 8892 deletions
Show Stats Expand all files Collapse all files

174
cc.asm
View File

@ -187,6 +187,7 @@ TAB equ 9 TAB key code
stz ~QuickExitList
stz ~QuickExitList+2
case on
stz __useTimeTool do not use Time Tool
jsl ~InitIO reset standard I/O
case off
@ -243,8 +244,6 @@ lb6 long M
phy
sec
adc 1,S
ply
pha
pha
pea 0
pha
@ -264,20 +263,19 @@ lb7 pl4 argv get the pointer to the area
lda [argv]
sta targv
stx targv+2
clc get a pointer to the command line string
adc start
; clc (already clear)
adc start get a pointer to the command line string
bcc lb8
inx
lb8 sta argv
stx argv+2
short M move the command line string
ldy #0
lb9 lda [cLine],Y
ldy #-1
lb9 iny
lda [cLine],Y
sta [argv],Y
beq lb10
iny
bra lb9
lb10 long M
bne lb9
long M
move4 argv,cLine save the pointer
move4 targv,argv set up the pointer to argv
@ -363,6 +361,9 @@ start ds 2 start of the command line string
stz ~ExitList+2
stz ~QuickExitList
stz ~QuickExitList+2
case on
stz __useTimeTool do not use Time Tool
case off
lda #~RTL set up so exit(), etc. call ~RTL
sta ~C_Quit+1
@ -375,6 +376,135 @@ start ds 2 start of the command line string
targv ds 4
end
****************************************************************
*
* ~CDevCleanup - cleanup code run after a CDev call
*
* Inputs:
* A+X - CDev result value
* 1,S - Original data bank to restore
* 2,S - Return address
* 5,S - Message code passed to CDev
* 7,S - Old user ID from before the call (0 if none)
*
* Notes:
* This routine handles cases where the CDev is going
* away and so the user ID allocated for it needs to be
* disposed of to avoid being leaked.
*
****************************************************************
*
~CDevCleanup start
MachineCDEV equ 1
BootCDEV equ 2
CloseCDEV equ 5
AboutCDEV equ 8
tay stash low word of result
lda 5,s if message == CloseCDEV
cmp #CloseCDEV
beq cleanup
cmp #BootCDEV or message == BootCDEV
beq cleanup
cmp #AboutCDEV or message == AboutCDEV
bne lb1
lda 7,s and original user ID was 0
beq cleanup (i.e. CDev window was not open)
bra ret
lb1 cmp #MachineCDEV or message == MachineCDEV
bne ret
tya and return value is 0
bne ret
txa
bne ret
cleanup pea 0 ...then dispose of user ID
jsl >~DAID
ret tya store return value in result space
sta 5,s
txa
sta 7,s
plb restore data bank
rtl return to original caller
end
****************************************************************
*
* ~CheckPtrC - check a pointer to insure it is not null
*
* Inputs:
* 1,S - return address
* 4,S - pointer
*
****************************************************************
*
~CheckPtrC start
lda 4,S
ora 5,S
bne lb1
error #1 subrange exceeded
lb1 rtl
end
****************************************************************
*
* ~CUMul2 - unsigned multiply
*
* Inputs:
* X,A - operands
*
* Outputs:
* A - result
*
* Notes:
* This routine is used for array index calculations and
* for unsigned multiplies. It returns the low-order
* 16 bits of the true result in case of overflow.
*
****************************************************************
*
~CUMul2 start
n1 equ 3
n2 equ 5
;
; Initialization
;
phx save the operands
pha
phd set up our DP
tsc
tcd
cpx n1 make sure n1 is the smaller argument
bge in1
lda n1
stx n1
sta n2
in1 anop
;
; Do the multiply
;
lda #0
lsr n1
lb0 bcc lb1
clc
adc n2
lb1 asl n2
lsr n1
bne lb0
bcc aa1
clc
adc n2
aa1 pld return the result
plx
plx
rtl
end
****************************************************************
*
* ~Exit - call exit routines and clean up open files
@ -389,10 +519,7 @@ ptr equ 3 pointer to exit routines
;
; Set up our stack frame
;
phb
phk
plb
ph4 ~ExitList set up our stack frame
ph4 >~ExitList set up our stack frame
phd
tsc
tcd
@ -441,7 +568,6 @@ lb3 lda >stderr+6 while there is a next file
lb4 pld return
pla
pla
plb
rts
end
@ -459,10 +585,7 @@ ptr equ 3 pointer to exit routines
;
; Set up our stack frame
;
phb
phk
plb
ph4 ~QuickExitList set up our stack frame
ph4 >~QuickExitList set up our stack frame
phd
tsc
tcd
@ -499,7 +622,6 @@ lb2 ldy #2 dereference the pointer
lb3 pld return
pla
pla
plb
rts
end
@ -727,6 +849,8 @@ lb3 sec
csubroutine (4:len,4:source),0
dest equ source+4
pei dest+2 save original dest value
pei dest
ldx len+2 move whole banks
beq lm2
ldy #0
@ -761,7 +885,11 @@ lb2 lda [source],Y
bne lb2
lb3 lda [source]
sta [dest]
lb4 creturn
lb4 pla restore original dest value
sta dest
pla
sta dest+2
creturn
end
****************************************************************
@ -862,7 +990,9 @@ lb2 lda [source],Y
bne lb2
lb3 lda [source]
sta [dest]
lb4 creturn
lb4 bcc lb5 if the move length was odd
dec4 dest restore original dest value
lb5 creturn
end
****************************************************************

183
cc.macros
View File

@ -1,3 +1,94 @@
macro
&l ph2 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
lda (&n1)
pha
ago .e
.b
aif "&c"="<",.c
lda &n1
pha
ago .e
.c
&n1 amid &n1,2,l:&n1-1
pei &n1
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
macro
&l ph4 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab error &e
&lab ph2 &e
@ -280,11 +371,6 @@
~&SYSCNT ~RESTM
MEND
MACRO
&LAB JEQ &BP
&LAB BNE *+5
BRL &BP
MEND
MACRO
&LAB LONG &A,&B
LCLB &I
LCLB &M
@ -305,84 +391,6 @@
.C
MEND
MACRO
&LAB PH2 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDA (&N1)
PHA
AGO .E
.B
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PH4 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDY #2
LDA (&N1),Y
PHA
LDA (&N1)
PHA
AGO .E
.B
AIF "&C"<>"[",.C
LDY #2
LDA &N1,Y
PHA
LDA &N1
PHA
AGO .E
.C
LDA &N1+2
PHA
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA +(&N1)|-16
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PL4 &N1
LCLC &C
&LAB ANOP
@ -539,3 +547,12 @@
.j
rtl
mend
macro
&l dec4 &a
&l ~setm
lda &a
bne ~&SYSCNT
dec 2+&a
~&SYSCNT dec &a
~restm
mend

1652
ctype.asm
View File

File diff suppressed because it is too large Load Diff

4
equates.asm
View File

@ -19,6 +19,7 @@ EMFILE gequ 8 too many files are open
EACCES gequ 9 access bits prevent the operation
EEXIST gequ 10 the file exists
ENOSPC gequ 11 the file is too large
EILSEQ gequ 12 encoding error
;
; masks for the __ctype array
;
@ -62,6 +63,7 @@ _IOEOF gequ $0080 has an EOF been found?
_IOERR gequ $0100 has an error occurred?
_IOTEXT gequ $0200 is this file a text file?
_IOTEMPFILE gequ $0400 was this file created by tmpfile()?
_IOAPPEND gequ $0800 is this file open in append mode?
! record structure
! ----------------
@ -72,7 +74,7 @@ FILE_end gequ FILE_base+4 end of the file buffer
FILE_size gequ FILE_end+4 size of the file buffer
FILE_cnt gequ FILE_size+4 # chars that can be read/written to buffer
FILE_pbk gequ FILE_cnt+4 put back character
FILE_flag gequ FILE_pbk+2 buffer flags
FILE_flag gequ FILE_pbk+4 buffer flags
FILE_file gequ FILE_flag+2 GS/OS file ID
sizeofFILE gequ FILE_file+2 size of the record

96
fcntl.asm
View File

@ -99,7 +99,7 @@ err equ 1 error return code
lda mode convert mode to ProDOS format
jsr unixtoprodos
sta siAccess
ph4 path set the path name
ph4 <path set the path name
jsl ctoosstr
sta siPathname
stx siPathname+2
@ -148,7 +148,6 @@ err equ 1 error return code
stz err err = 0 {no error}
lda filds error if there are too many open files
bmi lb2
cmp #OPEN_MAX
bge lb2
asl A get the file reference number
@ -209,8 +208,8 @@ err equ 1 error return code
csubroutine (4:path,2:mode),2
ph2 #O_WRONLY+O_TRUNC+O_CREAT
ph2 mode
ph4 path
ph2 <mode
ph4 <path
jsl openfile
sta err
@ -239,7 +238,7 @@ err equ 1 error return code
ph2 #0
ph2 #F_DUPFD
ph2 old
ph2 <old
jsl fcntl
sta err
@ -280,7 +279,6 @@ flags equ 5 file flags
bra lb7
lb1 lda filds error if there are too many open files
bmi lb2
cmp #OPEN_MAX
bge lb2
asl A get the file reference number
@ -297,7 +295,6 @@ lb3 sta refnum
sta flags
lda arg find a new filds
bmi lb5
cmp #OPEN_MAX
bge lb5
asl A
@ -376,7 +373,6 @@ mark equ 1 new file mark
sta mark
sta mark+2
lda filds get the file refnum
bmi lb1
cmp #OPEN_MAX
bge lb1
asl A
@ -384,43 +380,56 @@ mark equ 1 new file mark
tax
lda >files,X
bne lb2
lb1 lda #EBADF bad refnum error
sta >errno
bra lb4
lb1 bra lb4a bad refnum error
lb2 sta >smRefnum set the file refnum
sta >gmRefnum
lda whence convert from UNIX whence to GS/OS base
beq lb3
eor #$0003
cmp #4
bge lb2a
cmp #2
bne lb3
sta >smBase
lda offset+2
bpl lb3a
sub4 #0,offset,offset
lda #3
cmp #SEEK_SET if whence == 0 (SEEK_SET)
bne lb2a
lda offset+2 if offset is negative
bmi lb4 fail with EINVAL
lda #0 set mark to offset
bra lb3
lb2a lda #EINVAL invalid whence flag
sta >errno
bra lb4
lb2a cmp #SEEK_END else if whence == 2 (SEEK_END)
bne lb2c
lda offset+2 if offset > 0
bmi lb2b
ora offset
bne lb4 fail with EINVAL
lb2b sub4 #0,offset,offset negate offset
lda #1 set mark to EOF - offset
bra lb3
lb2c cmp #SEEK_CUR else if whence == 1 (SEEK_CUR)
bne lb4
lda offset if offset is positive or 0
bmi lb2d
lda #2 set mark to old mark + offset
bra lb3 else
lb2d sub4 #0,offset,offset negate offset
lda #3 set mark to old mark - offset
lb3 sta >smBase save the base parameter
lb3a lda offset set the displacement
sta >smDisplacement
lda offset+2
sta >smDisplacement+2
OSSet_Mark smRec set the file mark
bcs lb1
OSGet_Mark gmRec get the new mark
bcs lb1
bcc lb5
cmp #$4D out of range error => fail with EINVAL
bne lb4a
lb4 lda #EINVAL
bra lb4b
lb4a lda #EBADF bad refnum error
lb4b sta >errno
bra lb6
lb5 OSGet_Mark gmRec get the new mark
bcs lb4a
lda >gmDisplacement
sta mark
lda >gmDisplacement+2
sta mark+2
lb4 creturn 4:mark
lb6 creturn 4:mark
smRec dc i'3' SetMark record
smRefnum ds 2
@ -453,9 +462,9 @@ err equ 1 error return code
csubroutine (4:path,2:oflag),2
ph2 oflag
ph2 <oflag
ph2 #$7180
ph4 path
ph4 <path
jsl openfile
sta err
@ -515,7 +524,7 @@ lb1 lda files,X
brl lb11
lb2 stx index save the index to the file
ph4 path convert the path to an OS string
ph4 <path convert the path to an OS string
jsl ctoosstr
sta opPathname
stx opPathname+2
@ -546,8 +555,8 @@ lb4 sta crFileType
lda #ENOENT
sta >errno
bra lb11
lb4a ph2 mode set the access bits
ph4 path
lb4a ph2 <mode set the access bits
ph4 <path
jsl chmod
bra lb8 else
lb5 lda oflag if O_CREAT is not set then
@ -634,7 +643,6 @@ err equ 1 error return code
phk
plb
lda filds error if the file has not been opened
bmi lb0
cmp #OPEN_MAX
bge lb0
asl A get the file reference number
@ -797,7 +805,6 @@ nbuff equ 3 new buffer pointer
phk
plb
lda filds error if the file has not been opened
bmi lb0
cmp #OPEN_MAX
bge lb0
asl A get the file reference number
@ -806,6 +813,7 @@ nbuff equ 3 new buffer pointer
lda files,X
beq lb0
sta wrRefnum
sta smRefnum
stx filds
lda files+2,X make sure the file is open for writing
and #O_WRONLY+O_RDWR
@ -827,7 +835,7 @@ lb0a move4 buf,wrDataBuffer set the location to write from
and #O_BINARY
bne lb0g
pea 0 reserve a file buffer
ph2 n
ph2 <n
jsl malloc
sta nbuff
stx nbuff+2
@ -857,7 +865,12 @@ lb0e sta [nbuff]
long M
lb0f move4 nbuff,wrDataBuffer set the data buffer start
lb0g OSWrite wrRec write the bytes
lb0g ldx filds if the file is in O_APPEND mode then
lda files+2,X
and #O_APPEND
beq lb0h
OSSet_Mark smRec set mark to EOF
lb0h OSWrite wrRec write the bytes
bcc lb1 if an error occurred then
lda #EIO errno = EIO
sta >errno
@ -869,7 +882,7 @@ lb1 ldy wrTransferCount return the bytes read
lda nbuff if nbuff <> NULL then
ora nbuff+2
beq lb2
ph4 nbuff dispose of the buffer
ph4 <nbuff dispose of the buffer
jsl free
lb2 anop
@ -881,4 +894,9 @@ wrRefnum ds 2
wrDataBuffer ds 4
wrRequestCount ds 4
wrTransferCount ds 4
smRec dc i'3' SetMark record
smRefnum ds 2
smBase dc i'1' EOF-displacement mode
smDisplacement dc i4'0' displacement = 0
end

169
fcntl.macros
View File

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

369
fenv.asm
View File

@ -1,369 +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
stz excepts
creturn 2:excepts
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
stz excepts
creturn 2:excepts
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 stz excepts
creturn 2:excepts
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
stz excepts
creturn 2:excepts
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
stz envp
creturn 2:envp
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
stz envp
creturn 2:envp
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
stz envp
creturn 2:envp
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
stz envp
creturn 2:envp
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

97
fpextra.asm
View File

@ -1,97 +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
*
****************************************************************
*
~CompPrecision start
tsc
clc
adc #4
ldy #0
phy
pha
phy
pha
phy
pha
phy
pha
FX2C
FC2X
rtl
end

36
fpextra.macros
View File

@ -1,36 +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

246
int64.asm
View File

@ -515,249 +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
*
****************************************************************
*
~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
convert tsc if it is not LONG_MIN, call fx2c:
clc
adc #4
pea 0 push src address for fx2c
pha
pea 0 push dst address for fx2c
inc a
inc a
pha
fx2c convert
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

107
locale.asm Normal file
View File

@ -0,0 +1,107 @@
keep obj/locale
mcopy locale.macros
case on
****************************************************************
*
* Locale - locale support
*
* This currently implements a minimalistic version of the
* <locale.h> functions, supporting only the "C" locale.
*
****************************************************************
*
Locale private dummy routine
end
****************************************************************
*
* char *setlocale(int category, const char *locale);
*
* Set or query current locale
*
* Inputs:
* category - locale category to set or query
* locale - locale name (or NULL for query)
*
* Outputs:
* returns locale string (for relevant category),
* or NULL if locale cannot be set as requested
*
****************************************************************
*
setlocale start
LC_MAX equ 5 maximum valid LC_* value
csubroutine (2:category,4:locale),0
lda category if category is invalid
cmp #LC_MAX+1
bge err return NULL
lda locale if querying the current locale
ora locale+2
beq good return "C"
lda [locale]
cmp #'C' if locale is "C" or "", we are good
beq good
and #$00FF
bne err
good lda #C_str if successful, return "C"
sta locale
lda #^C_str
sta locale+2
bra ret
err stz locale otherwise, return NULL for error
stz locale+2
ret creturn 4:locale
C_str dc c'C',i1'0'
end
****************************************************************
*
* struct lconv *localeconv(void);
*
* Get numeric formatting conventions
*
* Outputs:
* returns pointer to a struct lconv containing
* appropriate values for the current locale
*
****************************************************************
*
localeconv start
CHAR_MAX equ 255
ldx #^C_locale_lconv
lda #C_locale_lconv
rtl
C_locale_lconv anop
decimal_point dc a4'period'
thousands_sep dc a4'emptystr'
grouping dc a4'emptystr'
mon_decimal_point dc a4'emptystr'
mon_thousands_sep dc a4'emptystr'
mon_grouping dc a4'emptystr'
positive_sign dc a4'emptystr'
negative_sign dc a4'emptystr'
currency_symbol dc a4'emptystr'
frac_digits dc i1'CHAR_MAX'
p_cs_precedes dc i1'CHAR_MAX'
n_cs_precedes dc i1'CHAR_MAX'
p_sep_by_space dc i1'CHAR_MAX'
n_sep_by_space dc i1'CHAR_MAX'
p_sign_posn dc i1'CHAR_MAX'
n_sign_posn dc i1'CHAR_MAX'
int_curr_symbol dc a4'emptystr'
int_frac_digits dc i1'CHAR_MAX'
int_p_cs_precedes dc i1'CHAR_MAX'
int_n_cs_precedes dc i1'CHAR_MAX'
int_p_sep_by_space dc i1'CHAR_MAX'
int_n_sep_by_space dc i1'CHAR_MAX'
int_p_sign_posn dc i1'CHAR_MAX'
int_n_sign_posn dc i1'CHAR_MAX'
period dc c'.',i1'0'
emptystr dc i1'0'
end

24
fenv.macros → locale.macros
View File

@ -91,27 +91,3 @@
.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

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
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
set list {list} locale.a uchar.a
for i in {list}
echo makelib orcalib +obj/{i}
makelib orcalib +obj/{i}

155
math2.asm
View File

@ -1,155 +0,0 @@
keep obj/math2
mcopy math2.macros
case on
****************************************************************
*
* Math2 - additional math routines
*
* This code provides additional functions from <math.h>
* (including internal helper functions used by macros),
* supplementing the ones in SysFloat.
*
****************************************************************
math2 private dummy segment
end
****************************************************************
*
* int __fpclassifyf(float x);
*
* Classify a float value
*
* Inputs:
* val - the number to classify
*
* Outputs:
* one of the FP_* classification values
*
****************************************************************
*
__fpclassifyf start
csubroutine (10:val),0
tdc
clc
adc #val
ldy #0
phy
pha
phy
pha
phy
pha
FX2S
FCLASSS
txa
and #$00FF
cmp #$00FC
bne lb1
inc a
lb1 sta val
creturn 2:val
end
****************************************************************
*
* int __fpclassifyd(double x);
*
* Classify a double value
*
* Inputs:
* val - the number to classify
*
* Outputs:
* one of the FP_* classification values
*
****************************************************************
*
__fpclassifyd start
csubroutine (10:val),0
tdc
clc
adc #val
ldy #0
phy
pha
phy
pha
phy
pha
FX2D
FCLASSD
txa
and #$00FF
cmp #$00FC
bne lb1
inc a
lb1 sta val
creturn 2:val
end
****************************************************************
*
* int __fpclassifyl(long double x);
*
* Classify a long double value
*
* Inputs:
* val - the number to classify
*
* Outputs:
* one of the FP_* classification values
*
****************************************************************
*
__fpclassifyl start
csubroutine (10:val),0
tdc
clc
adc #val
pea 0
pha
FCLASSX
txa
and #$00FF
cmp #$00FC
bne lb1
inc a
lb1 sta val
creturn 2:val
end
****************************************************************
*
* int __signbit(long double x);
*
* Get the sign bit of a floating-point value
*
* Inputs:
* val - the number
*
* Outputs:
* 0 if positive, non-zero if negative
*
****************************************************************
*
__signbit start
csubroutine (10:val),0
lda val+8
and #$8000
sta val
creturn 2:val
end

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

46
orca.macros
View File

@ -1,46 +0,0 @@
MACRO
&LAB PH4 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDY #2
LDA (&N1),Y
PHA
LDA (&N1)
PHA
AGO .E
.B
AIF "&C"<>"[",.C
LDY #2
LDA &N1,Y
PHA
LDA &N1
PHA
AGO .E
.C
LDA &N1+2
PHA
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA +(&N1)|-16
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND

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

7
signal.asm
View File

@ -107,12 +107,11 @@ 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
ph2 <sig call the user signal handler
jsl jsl jsl
lb3 creturn 2:val

70
signal.macros
View File

@ -1,3 +1,41 @@
macro
&l ph2 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
lda (&n1)
pha
ago .e
.b
aif "&c"="<",.c
lda &n1
pha
ago .e
.c
&n1 amid &n1,2,l:&n1-1
pei &n1
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab csubroutine &parms,&work
&lab anop
@ -139,38 +177,6 @@
.C
MEND
MACRO
&LAB PH2 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDA (&N1)
PHA
AGO .E
.B
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB SHORT &A,&B
LCLB &I
LCLB &M

9760
stdio.asm
View File

File diff suppressed because it is too large Load Diff

169
stdio.macros
View File

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

281
stdlib.asm
View File

@ -37,7 +37,7 @@ abort start
ph2 #SIGABRT
jsl raise
lda #-1
jmp ~C_QUIT
brl ~C_QUIT
end
****************************************************************
@ -333,6 +333,10 @@ addr equ 13 address of array element of index test
csubroutine (4:key,4:base,4:count,4:size,4:compar),16
lda count if count is 0 then
ora count+2
jeq lb5 just return a null pointer
lda compar patch the call address
sta >jsl+1
lda compar+1
@ -351,8 +355,8 @@ lb1 clc test = (left+right)/2
ror test
mul4 test,size,addr addr = test*size + base
add4 addr,base
ph4 addr compare the array elements
ph4 key
ph4 <addr compare the array elements
ph4 <key
jsl jsl jsl
tax quit if *addr = *key
beq lb6
@ -436,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
****************************************************************
@ -588,8 +592,8 @@ addr equ 1
phb use local addressing
phk
plb
ph4 n do the divide
ph4 d
ph4 <n do the divide
ph4 <d
jsl ~DIV4
pl4 div_t
pl4 div_t+4
@ -638,6 +642,47 @@ addr equ 1
lldiv_t ds 16
end
****************************************************************
*
* int mblen(const char *s, size_t n)
*
* Inputs:
* s - NULL or pointer to character
* n - maximum number of bytes to inspect
*
* Outputs:
* If s is NULL, returns 0, indicating encodings are not
* state-dependent. Otherwise, returns 0 if s points to a
* null character, -1 if the next n or fewer bytes do not
* form a valid character, or the number of bytes forming
* a valid character.
*
* Note: This implementation assumes we do not support actual
* multi-byte or state-dependent character encodings.
*
****************************************************************
*
mblen start
csubroutine (4:s,4:n)
ldx #0
lda s if s == NULL
ora s+2
beq ret return 0
lda n if n == 0
ora n+2
bne readchar
dex return -1
bra ret
readchar lda [s] if *s == '\0'
and #$00FF
beq ret return 0
inx else return 1
ret stx n
creturn 2:n
end
****************************************************************
*
* void qsort(base, count, size, compar)
@ -659,13 +704,14 @@ lldiv_t ds 16
qsort start
csubroutine (4:base,4:count,4:size,4:compar),0
phb
phk
plb
lda count nothing to do if count is 0
ora count+2
beq done
phb
phk
plb
dec4 count set count to the addr of the last entry
mul4 count,size
add4 count,base
@ -676,12 +722,13 @@ qsort start
lda compar+1
sta jsl1+2
sta jsl2+2
ph4 count do the sort
ph4 base
plb
ph4 <count do the sort
ph4 <base
jsl rsort
done plb
creturn
done creturn
end
****************************************************************
@ -724,26 +771,31 @@ right equ 5 right address
csubroutine (4:first,4:last),8
phb
sr0 phb
phk
plb
sr0 lda last+2 if last <= first then quit
lda last+2 if last <= first then quit
bmi sr1a
cmp first+2
bne sr1
lda last
cmp first
sr1 bgt sr1a
plb
sr1 bgt sr1b
sr1a plb
creturn
sr1a move4 last,right right = last
sr1b move4 last,right right = last
move4 first,left left = first
bra sr3
sr2 add4 left,lsize inc left until *left >= *last
sr3 ph4 last
ph4 left
sr3 plb
ph4 <last
ph4 <left
jsl1 entry
jsl jsl1
phb
phk
plb
tax
bmi sr2
sr4 lda right quit if right = first
@ -753,14 +805,18 @@ sr4 lda right quit if right = first
cmp first+2
beq sr4b
sr4a sub4 right,lsize dec right until *right <= *last
ph4 last
ph4 right
plb
ph4 <last
ph4 <right
jsl2 entry
jsl jsl2
phb
phk
plb
dec A
bpl sr4
sr4b ph4 left swap left/right entries
ph4 right
sr4b ph4 <left swap left/right entries
ph4 <right
jsr swap
lda left+2 loop if left < right
cmp right+2
@ -768,17 +824,30 @@ sr4b ph4 left swap left/right entries
lda left
cmp right
sr5 blt sr2
ph4 right swap left/right entries
ph4 left
ph4 <right swap left/right entries
ph4 <left
jsr swap
ph4 left swap left/last entries
ph4 last
ph4 <left swap left/last entries
ph4 <last
jsr swap
sub4 left,lsize,right sort left part of array
ph4 right
ph4 first
sub4 left,lsize,right calculate bounds of subarrays
add4 left,lsize (first..right and left..last)
add4 first,last,mid calculate midpoint of range being sorted
lsr mid+2
ror mid
cmpl right,mid if right < mid then
bge sr6
plb
ph4 <right sort left subarray recursively
ph4 <first
jsl rsort
add4 left,lsize,first sort right part of array
move4 left,first sort right subarray via tail call
brl sr0
sr6 plb else
ph4 <last sort right subarray recursively
ph4 <left
jsl rsort
move4 right,last sort left subarray via tail call
brl sr0
;
; swap - swap two entries
@ -789,8 +858,9 @@ r equ 7 right entry
swap tsc set up addressing
phd
tcd
ldx lsize+2 move 64K chunks
lda lsize+2 move 64K chunks
beq sw2
sta banks
ldy #0
sw1 lda [l],Y
tax
@ -803,7 +873,7 @@ sw1 lda [l],Y
bne sw1
inc l+2
inc r+2
dex
dec banks
bne sw1
sw2 lda lsize if there are an odd number of bytes then
lsr A
@ -852,6 +922,8 @@ sw6 pld
;
lsize entry
ds 4 local copy of size
banks ds 2 number of whole banks to swap
mid ds 4 midpoint of the elements being sorted
end
****************************************************************
@ -877,6 +949,31 @@ srand start
brl ~RANX2
end
****************************************************************
*
* strtof - convert a string to a float
* strtold - convert a string to a long double
*
* Inputs:
* str - pointer to the string
* ptr - pointer to a pointer; a pointer to the first
* char past the number is placed here. If ptr is
* nil, no pointer is returned
*
* Outputs:
* X-A - pointer to result
*
* Note: These are currently implemented by just calling strtod
* (in SysFloat). As such, all of these function really
* return values in the SANE extended format.
*
****************************************************************
*
strtold start
strtof entry
jml strtod
end
****************************************************************
*
* strtol - convert a string to a long
@ -902,9 +999,10 @@ rtl equ 7 return address
val equ 3 value
negative equ 1 is the number negative?
pea 0 make room for & initialize val
pea 0
pea 0 make room for & initialize negative
lda #0
pha make room for & initialize val
pha
pha make room for & initialize negative
tsc set up direct page addressing
phd
tcd
@ -941,10 +1039,10 @@ cn1 cmp #'+' else if the char is '+' then
bne cn3
cn2 inc4 str ++str
cn3 ph4 str save the starting string
ph2 base convert the unsigned number
ph4 ptr
ph4 str
cn3 ph4 <str save the starting string
ph2 <base convert the unsigned number
ph4 <ptr
ph4 <str
jsl ~strtoul
stx val+2
sta val
@ -1029,10 +1127,11 @@ foundOne equ 1 have we found a number?
ldx #1
init pea 1 make room for & initialize rangeOK
pea 0 make room for & initialize negative
pea 0 make room for & initialize val
pea 0
pea 0 make room for & initialize foundOne
lda #0
pha make room for & initialize negative
pha make room for & initialize val
pha
pha make room for & initialize foundOne
tsc set up direct page addressing
phd
tcd
@ -1128,9 +1227,9 @@ cn3 cmp base branch if the digit is too big
pha
pha
pha
ph4 val
ph4 <val
pea 0
ph2 base
ph2 <base
_LongMul
pl4 val
pla branch if there was an error
@ -1220,13 +1319,14 @@ retptr equ 11 pointer to location for return value
val equ 3 value
negative equ 1 is the number negative?
pea 0 make room for & initialize retptr
lda #0
pha make room for & initialize retptr
phx
pea 0 make room for & initialize val
pea 0
pea 0
pea 0
pea 0 make room for & initialize negative
pha make room for & initialize val
pha
pha
pha
pha make room for & initialize negative
tsc set up direct page addressing
phd
tcd
@ -1263,10 +1363,10 @@ cn1 cmp #'+' else if the char is '+' then
bne cn3
cn2 inc4 str ++str
cn3 ph4 str save the starting string
ph2 base convert the unsigned number
ph4 ptr
ph4 str
cn3 ph4 <str save the starting string
ph2 <base convert the unsigned number
ph4 <ptr
ph4 <str
tdc
clc
adc #val
@ -1369,15 +1469,16 @@ foundOne equ 1 have we found a number?
~strtoull entry alt entry point called from strtoll
ldy #1
init pea 0 make room for & initialize retptr
init lda #0
pha make room for & initialize retptr
phx
pea 1 make room for & initialize rangeOK
pea 0 make room for & initialize negative
pea 0 make room for & initialize val
pea 0
pea 0
pea 0
pea 0 make room for & initialize foundOne
pha make room for & initialize negative
pha make room for & initialize val
pha
pha
pha
pha make room for & initialize foundOne
tsc set up direct page addressing
phd
tcd
@ -1473,7 +1574,7 @@ cn3 cmp base branch if the digit is too big
pea 0
pea 0
pea 0
ph2 base
ph2 <base
jsl ~UMUL8
pl8 val
pla get the saved digit
@ -1483,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
@ -1610,8 +1708,37 @@ empty ds 2
****************************************************************
*
* void __va_end(list)
* va_list list;
* void __record_va_info(va_list ap);
*
* Record that a traversal of variable arguments has finished.
* Data is recorded in the internal va info that will be used
* to remove variable arguments at the end of the function.
*
* Inputs:
* ap - the va_list
*
****************************************************************
*
__record_va_info start
va_info_ptr equ 1 pointer to the internal va info
csubroutine (4:ap),4
ldy #4 get pointer to internal va info
lda [ap],y
sta va_info_ptr
stz va_info_ptr+2
lda [ap] update end of variable arguments
cmp [va_info_ptr]
blt ret
sta [va_info_ptr]
ret creturn
end
****************************************************************
*
* void __va_end(internal_va_info *list);
*
* Remove variable length arguments from the stack.
*

181
stdlib.macros
View File

@ -1,4 +1,95 @@
macro
&l ph2 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
lda (&n1)
pha
ago .e
.b
aif "&c"="<",.c
lda &n1
pha
ago .e
.c
&n1 amid &n1,2,l:&n1-1
pei &n1
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
macro
&l ph4 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
macro
&l negate8 &n1
&l ~setm
sec
@ -459,84 +550,6 @@
.C
MEND
MACRO
&LAB PH2 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDA (&N1)
PHA
AGO .E
.B
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PH4 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDY #2
LDA (&N1),Y
PHA
LDA (&N1)
PHA
AGO .E
.B
AIF "&C"<>"[",.C
LDY #2
LDA &N1,Y
PHA
LDA &N1
PHA
AGO .E
.C
LDA &N1+2
PHA
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA +(&N1)|-16
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PL4 &N1
LCLC &C
&LAB ANOP
@ -721,3 +734,15 @@
&l bne *+5
brl &bp
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

2659
string.asm
View File

File diff suppressed because it is too large Load Diff

111
string.macros
View File

@ -1,3 +1,56 @@
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 MOVE4 &F,&T
&LAB ~SETM
@ -458,52 +511,6 @@
.I
MEND
MACRO
&LAB PH4 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDY #2
LDA (&N1),Y
PHA
LDA (&N1)
PHA
AGO .E
.B
AIF "&C"<>"[",.C
LDY #2
LDA &N1,Y
PHA
LDA &N1
PHA
AGO .E
.C
LDA &N1+2
PHA
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA +(&N1)|-16
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB SHORT &A,&B
LCLB &I
LCLB &M
@ -555,3 +562,15 @@
&l bne *+5
brl &bp
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

1256
time.asm
View File

File diff suppressed because it is too large Load Diff

245
time.macros
View File

@ -1,3 +1,94 @@
macro
&l ph2 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
lda (&n1)
pha
ago .e
.b
aif "&c"="<",.c
lda &n1
pha
ago .e
.c
&n1 amid &n1,2,l:&n1-1
pei &n1
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
macro
&l ph4 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&LAB MOVE4 &F,&T
&LAB ~SETM
@ -386,11 +477,6 @@
~&SYSCNT ~RESTM
MEND
MACRO
&LAB JLT &BP
&LAB BGE *+5
BRL &BP
MEND
MACRO
&LAB LLA &AD1,&AD2
&LAB ANOP
LCLA &L
@ -418,52 +504,6 @@
.D
MEND
MACRO
&LAB PH4 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDY #2
LDA (&N1),Y
PHA
LDA (&N1)
PHA
AGO .E
.B
AIF "&C"<>"[",.C
LDY #2
LDA &N1,Y
PHA
LDA &N1
PHA
AGO .E
.C
LDA &N1+2
PHA
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA +(&N1)|-16
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PL4 &N1
LCLC &C
&LAB ANOP
@ -517,44 +557,6 @@
&l blt &bp
beq &bp
mend
macro
&l ph2 &n1
aif "&n1"="*",.f
lclc &c
&l anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
lda (&n1)
pha
ago .e
.b
aif "&c"="<",.c
lda &n1
pha
ago .e
.c
&n1 amid &n1,2,l:&n1-1
pei &n1
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab _ReadBParam
&lab ldx #$0C03
@ -600,3 +602,68 @@
longi off
.c
mend
macro
&l dec4 &a
&l ~setm
lda &a
bne ~&SYSCNT
dec 2+&a
~&SYSCNT dec &a
~restm
mend
MACRO
&LAB _INT2DEC
&LAB LDX #$260B
JSL $E10000
MEND
MACRO
&lab _tiStatus
&lab ldx #$0638
jsl $E10000
MEND
MACRO
&lab _tiGetTimePrefs
&lab ldx #$0938
jsl $E10000
MEND
MACRO
&lab _tiOffset2TimeZoneString
&lab ldx #$1138
jsl $E10000
MEND
MACRO
&lab _LongMul
&lab ldx #$0C0B
jsl $E10000
MEND
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 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

86
toolglue.asm
View File

@ -68,10 +68,10 @@ addr equ 1 work pointer
pha
pha
pha
ph2 aRegValue
ph2 xRegValue
ph2 yRegValue
ph2 eModeEntryPt
ph2 <aRegValue
ph2 <xRegValue
ph2 <yRegValue
ph2 <eModeEntryPt
_FWEntry
sta >~TOOLERROR
pl2 >yRegExit
@ -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
@ -278,8 +316,8 @@ addr equ 1
sec
sbc #8
tcs
ph4 dividend
ph4 divisor
ph4 <dividend
ph4 <divisor
_LongDivide
sta >~TOOLERROR
pl4 >quotient
@ -313,8 +351,8 @@ addr equ 1
sec
sbc #8
tcs
ph4 multiplicand
ph4 multiplier
ph4 <multiplicand
ph4 <multiplier
_LongMul
sta >~TOOLERROR
pl4 >lsResult
@ -346,8 +384,8 @@ addr equ 1
pha
pha
ph2 dividend
ph2 divisor
ph2 <dividend
ph2 <divisor
_SDivide
sta >~TOOLERROR
pl2 >quotient
@ -379,8 +417,8 @@ addr equ 1
pha
pha
ph2 dividend
ph2 divisor
ph2 <dividend
ph2 <divisor
_UDivide
sta >~TOOLERROR
pl2 >quotient
@ -421,9 +459,9 @@ addr equ 1
sec
sbc #10
tcs
ph2 uID
ph4 stAddr
ph2 dpAddr
ph2 <uID
ph4 <stAddr
ph2 <dpAddr
_InitialLoad
sta >~TOOLERROR
pl2 >userID
@ -464,10 +502,10 @@ addr equ 1
sec
sbc #10
tcs
ph2 uID
ph4 buffAddr
ph2 flagWord
ph2 inputType
ph2 <uID
ph4 <buffAddr
ph2 <flagWord
ph2 <inputType
_InitialLoad2
sta >~TOOLERROR
pl2 >userID
@ -508,9 +546,9 @@ addr equ 1
sec
sbc #10
tcs
ph2 uID
ph4 fName
ph4 sName
ph2 <uID
ph4 <fName
ph4 <sName
_LoadSegName
sta >~TOOLERROR
pl4 >segAddr
@ -551,7 +589,7 @@ addr equ 1
sec
sbc #10
tcs
ph2 uID
ph2 <uID
_Restart
sta >~TOOLERROR
pl2 >userID
@ -590,7 +628,7 @@ addr equ 1
pha
pha
pha
ph4 segaddr
ph4 <segaddr
_UnloadSeg
sta >~TOOLERROR
pl2 >userID

174
toolglue.macros
View File

@ -1,3 +1,94 @@
macro
&l ph2 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
lda (&n1)
pha
ago .e
.b
aif "&c"="<",.c
lda &n1
pha
ago .e
.c
&n1 amid &n1,2,l:&n1-1
pei &n1
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
macro
&l ph4 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&LAB LLA &AD1,&AD2
&LAB ANOP
@ -26,38 +117,6 @@
.D
MEND
MACRO
&LAB PH2 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDA (&N1)
PHA
AGO .E
.B
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PL2 &N1
LCLC &C
&LAB ANOP
@ -202,52 +261,6 @@
rtl
mend
MACRO
&LAB PH4 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDY #2
LDA (&N1),Y
PHA
LDA (&N1)
PHA
AGO .E
.B
AIF "&C"<>"[",.C
LDY #2
LDA &N1,Y
PHA
LDA &N1
PHA
AGO .E
.C
LDA &N1+2
PHA
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA +(&N1)|-16
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PL4 &N1
LCLC &C
&LAB ANOP
@ -371,3 +384,8 @@
&lab ldx #$1F23
jsl $E10000
MEND
MACRO
&lab _ReadMouse2
&lab ldx #$3303
jsl $E10000
MEND

203
uchar.asm Normal file
View File

@ -0,0 +1,203 @@
keep obj/uchar
mcopy uchar.macros
case on
****************************************************************
*
* UChar - Unicode utilities
*
* This code implements conversions to and from Unicode.
* It assumes the multibyte character set is Mac OS Roman.
*
****************************************************************
*
uchar private
copy equates.asm
end
****************************************************************
*
* size_t mbrtoc16(char16_t * pc16, const char * s, size_t n,
* mbstate_t * ps);
*
* size_t mbrtoc32(char32_t * pc32, const char * s, size_t n,
* mbstate_t * ps);
*
* Convert a multibyte character to UTF-16 or UTF-32.
*
* Inputs:
* pc16 or pc32 - pointer to output location
* s - pointer to multibyte character
* n - maximum number of bytes to examine
* ps - conversion state
*
* Outputs:
* *pc16 or *pc32 - UTF-16 or UTF-32 code unit
* Returns number of bytes in multibyte character or
* 0 for null character.
*
****************************************************************
*
mbrtoc16 start
clv v flag clear => doing mbrtoc16
bra csub
mbrtoc32 entry
sep #$40 v flag set => doing mbrtoc32
csub csubroutine (4:pc16,4:s,4:n,4:ps),0
lda s if s == NULL
ora s+2
bne check_n
stz n call is equivalent to
stz n+2 mbrtoc16(NULL, "", 1, ps),
bra ret so return 0
check_n lda n if n = 0
ora n+2
bne getchar
dec a return (size_t)(-2)
sta n+2
dec a
sta n
bra ret
getchar ldy #1 assume return value is 1
lda [s] load character *s
and #$00ff
bne set_rv if *s == '\0'
dey return value is 0
set_rv sty n set return value
stz n+2
cmp #$0080 if *s is an ASCII character
blt output store it as-is
asl a else
and #$00FF
tax
lda >macRomanToUCS,x convert it to Unicode
output ldx pc16 if pc16 != NULL
bne storeit
ldx pc16+2
beq ret
storeit sta [pc16] store result to *pc16
bvc ret if doing mbrtoc32
lda #0
ldy #2
sta [pc16],y store 0 as high word of result
ret creturn 4:n
end
****************************************************************
*
* size_t c16rtomb(char * s, char16_t c16, mbstate_t * ps);
*
* Convert a UTF-16 code unit to a multibyte character.
*
* Inputs:
* s - pointer to output location
* c16 - UTF-16 code unit
* ps - conversion state
*
* Outputs:
* *s - converted character
* Returns number of bytes stored, or -1 for error.
*
****************************************************************
*
c16rtomb start
csubroutine (4:s,2:c16,4:ps),0
lda s if s == NULL, call is equivalent to
ora s+2 c16rtomb(internal_buf, 0, ps),
beq return_1 so return 1
lda c16 if c16 is an ASCII character
cmp #$0080
blt storeit store it as-is
short I
ldx #0
cvt_loop lda >macRomanToUCS,x for each entry in macRomanToUCS
cmp c16 if it matches c16
beq gotit break and handle the mapping
inx
inx
bne cvt_loop
lda #EILSEQ if no mapping was found
sta >errno errno = EILSEQ
lda #-1 return -1
sta s
sta s+2
long I
bra ret
gotit longi off
txa if we found a mapping
lsr a compute the MacRoman character
ora #$0080
storeit short M store the character
sta [s]
long M,I
return_1 lda #1 return 1
sta s
stz s+2
ret creturn 4:s
end
****************************************************************
*
* size_t c32rtomb(char * s, char16_t c16, mbstate_t * ps);
*
* Convert a UTF-32 code unit to a multibyte character.
*
* Inputs:
* s - pointer to output location
* c16 - UTF-32 code unit
* ps - conversion state
*
* Outputs:
* *s - converted character
* Returns number of bytes stored, or -1 for error.
*
****************************************************************
*
c32rtomb start
lda 10,s if char is outside the BMP
beq fixstack
lda #$FFFD substitute REPLACEMENT CHARACTER
bra fs2
fixstack lda 8,s adjust stack for call to c16rtomb
fs2 sta 10,s
lda 6,s
sta 8,s
lda 4,s
sta 6,s
lda 2,s
sta 4,s
pla
sta 1,s
jml c16rtomb do the equivalent c16rtomb call
end
macRomanToUCS private
dc i2'$00C4, $00C5, $00C7, $00C9, $00D1, $00D6, $00DC, $00E1'
dc i2'$00E0, $00E2, $00E4, $00E3, $00E5, $00E7, $00E9, $00E8'
dc i2'$00EA, $00EB, $00ED, $00EC, $00EE, $00EF, $00F1, $00F3'
dc i2'$00F2, $00F4, $00F6, $00F5, $00FA, $00F9, $00FB, $00FC'
dc i2'$2020, $00B0, $00A2, $00A3, $00A7, $2022, $00B6, $00DF'
dc i2'$00AE, $00A9, $2122, $00B4, $00A8, $2260, $00C6, $00D8'
dc i2'$221E, $00B1, $2264, $2265, $00A5, $00B5, $2202, $2211'
dc i2'$220F, $03C0, $222B, $00AA, $00BA, $03A9, $00E6, $00F8'
dc i2'$00BF, $00A1, $00AC, $221A, $0192, $2248, $2206, $00AB'
dc i2'$00BB, $2026, $00A0, $00C0, $00C3, $00D5, $0152, $0153'
dc i2'$2013, $2014, $201C, $201D, $2018, $2019, $00F7, $25CA'
dc i2'$00FF, $0178, $2044, $00A4, $2039, $203A, $FB01, $FB02'
dc i2'$2021, $00B7, $201A, $201E, $2030, $00C2, $00CA, $00C1'
dc i2'$00CB, $00C8, $00CD, $00CE, $00CF, $00CC, $00D3, $00D4'
dc i2'$F8FF, $00D2, $00DA, $00DB, $00D9, $0131, $02C6, $02DC'
dc i2'$00AF, $02D8, $02D9, $02DA, $00B8, $02DD, $02DB, $02C7'
end

70
math2.macros → uchar.macros
View File

@ -91,33 +91,43 @@
.j
rtl
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
&l long &a,&b
lclb &i
lclb &m
&a amid &a,1,1
&m setb ("&a"="M").or.("&a"="m")
&i setb ("&a"="I").or.("&a"="i")
aif c:&b=0,.a
&b amid &b,1,1
&m setb ("&b"="M").or.("&b"="m").or.&m
&i setb ("&b"="I").or.("&b"="i").or.&i
.a
&l rep #&m*32+&i*16
aif .not.&m,.b
longa on
.b
aif .not.&i,.c
longi on
.c
mend
macro
&l short &a,&b
lclb &i
lclb &m
&a amid &a,1,1
&m setb ("&a"="M").or.("&a"="m")
&i setb ("&a"="I").or.("&a"="i")
aif c:&b=0,.a
&b amid &b,1,1
&m setb ("&b"="M").or.("&b"="m").or.&m
&i setb ("&b"="I").or.("&b"="i").or.&i
.a
&l sep #&m*32+&i*16
aif .not.&m,.b
longa off
.b
aif .not.&i,.c
longi off
.c
mend

26
vars.asm
View File

@ -23,7 +23,7 @@ Dummy start (dummy root segment)
*
****************************************************************
*
CVars start
~CVars start
errno entry library error number
ds 2
@ -31,10 +31,12 @@ _ownerid entry user ID (C)
~USER_ID entry user ID (Pascal, libraries)
ds 2
sys_nerr entry # of error messages
dc i'12'
dc i'13'
_toolErr entry last error in a tool call (C)
~TOOLERROR entry last error in a tool call (Pascal)
ds 2
__useTimeTool entry use Time Tool in <time.h> functions?
ds 2
end
****************************************************************
@ -45,12 +47,12 @@ _toolErr entry last error in a tool call (C)
*
~InitIO start
ldx #24 set up the file records
lb1 lda stderr+34,X
ldx #sizeofFILE-4-2 set up the file records
lb1 lda stderr+4+sizeofFILE,X
sta stderr+8,X
lda stdin+34,X
lda stdin+4+sizeofFILE,X
sta stdin+8,X
lda stdout+34,X
lda stdout+4+sizeofFILE,X
sta stdout+8,X
dex
dex
@ -77,7 +79,7 @@ lb1 dc a4'0' next file
dc a4'0' end of the file buffer
dc i4'0' size of the file buffer
dc i4'0' count
dc i'EOF' putback buffer
dc i'EOF,EOF' putback buffer
dc i'_IONBF+_IOWRT+_IOTEXT' no buffering; allow writes; text file
dc i'stderrID' error out
@ -86,7 +88,7 @@ lb1 dc a4'0' next file
dc a4'0' end of the file buffer
dc i4'0' size of the file buffer
dc i4'0' count
dc i'EOF' putback buffer
dc i'EOF,EOF' putback buffer
dc i'_IONBF+_IOWRT+_IOTEXT' no buffering; allow writes; text file
dc i'stderrID' error out
end
@ -107,7 +109,7 @@ lb1 dc a4'stdout+4' next file
dc a4'0' end of the file buffer
dc i4'0' size of the file buffer
dc i4'0' count
dc i'EOF' putback buffer
dc i'EOF,EOF' putback buffer
dc i'_IONBF+_IOREAD+_IOTEXT' no buffering; allow reads; text file
dc i'stdinID' standard in
@ -116,7 +118,7 @@ lb1 dc a4'stdout+4' next file
dc a4'0' end of the file buffer
dc i4'0' size of the file buffer
dc i4'0' count
dc i'EOF' putback buffer
dc i'EOF,EOF' putback buffer
dc i'_IONBF+_IOREAD+_IOTEXT' no buffering; allow reads; text file
dc i'stdinID' standard in
end
@ -137,7 +139,7 @@ lb1 dc a4'stderr+4' next file
dc a4'0' end of the file buffer
dc i4'0' size of the file buffer
dc i4'0' count
dc i'EOF' putback buffer
dc i'EOF,EOF' putback buffer
dc i'_IONBF+_IOWRT+_IOTEXT' no buffering; allow writes; text file
dc i'stdoutID' standard out
@ -146,7 +148,7 @@ lb1 dc a4'stderr+4' next file
dc a4'0' end of the file buffer
dc i4'0' size of the file buffer
dc i4'0' count
dc i'EOF' putback buffer
dc i'EOF,EOF' putback buffer
dc i'_IONBF+_IOWRT+_IOTEXT' no buffering; allow writes; text file
dc i'stdoutID' standard out
end