From b81b4e1109782405d8e23f13666e819d94be70a6 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 15 Oct 2022 19:01:16 -0500 Subject: [PATCH 01/35] 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). --- stdio.asm | 38 +++++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 15 deletions(-) diff --git a/stdio.asm b/stdio.asm index 7ae9d4b..8befdf1 100644 --- a/stdio.asm +++ b/stdio.asm @@ -688,24 +688,26 @@ disp equ 1 disp in s ph4 stdin if error encountered, return NULL + jsl ferror + tax + beq rts else return s +err stz s stz s+2 bra rts lb2 cmp #LF quit if it was a \n From 73ed0778f2e1dd5a7241b7a406a24e70b5602717 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 11 Dec 2022 22:04:22 -0600 Subject: [PATCH 02/35] 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. --- cc.asm | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/cc.asm b/cc.asm index c794916..3ddb0f8 100644 --- a/cc.asm +++ b/cc.asm @@ -375,6 +375,60 @@ 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 + **************************************************************** * * ~CUMul2 - unsigned multiply From 88e764f72dc635b1c6d684ea532dca24984546a7 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 17 Dec 2022 22:25:53 -0600 Subject: [PATCH 03/35] 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 --- math2.asm | 341 +++++++++++++++++++++++++++++++++++++++++++++++++++ math2.macros | 28 +++++ 2 files changed, 369 insertions(+) diff --git a/math2.asm b/math2.asm index d173779..15a46da 100644 --- a/math2.asm +++ b/math2.asm @@ -702,6 +702,300 @@ copysignl entry rtl end +**************************************************************** +* +* double erf(double x); +* +* Returns the error function of x. +* +* double erfc(double x); +* +* Returns the complementary error function of x, 1 - erf(x). +* +* This implementation is based on W. J. Cody's article +* "Rational Chebyshev Approximations for the Error Function." +* +**************************************************************** +* +erf start +erff entry +erfl entry + using MathCommon2 +x_offset equ 9 stack offset of x (in most of the code) + + clc + bra lb1 + +erfc entry +erfcf entry +erfcl entry + + sec + +lb1 phb save & set data bank + phk + plb + + pha make space for saved SANE environment + + lda x_offset-2+8,s + ror a save erf/erfc flag (high bit) + pha and original sign (next bit) + + rol a t1 := |x| + rol a + lsr a + sta t1+8 + lda x_offset+6,s + sta t1+6 + lda x_offset+4,s + sta t1+4 + lda x_offset+2,s + sta t1+2 + lda x_offset,s + sta t1 + + tsc save env & set to default + clc + adc #3 + pea 0 + pha + FPROCENTRY +; +; Computation using approximation of erf, for small enough x values +; + ph4 #threshold if |x| <= 0.5 then + ph4 #t1 + FCMPS + jmi use_erfc + + ph4 #t1 t1 := x^2 + ph4 #t1 + FMULX + + ph4 #y y := P1(t1) + pea 4 + ph4 #P1 + jsl poly + + ph4 #z z := Q1(t1) + pea 4 + ph4 #Q1 + jsl poly + + ph4 #z y := y/z + ph4 #y + FDIVX + + tsc y := x * y + clc + adc #x_offset + pea 0 + pha + ph4 #y + FMULX + + pla + jpl clearxcp if computing erfc then + + ph4 #one y := y - 1 + ph4 #y + FSUBX + brl flipsign y := -y +; +; Computation using approximations of erfc, for larger x values +; +use_erfc ph4 #four else + ph4 #t1 + FCMPI + jmi big_erfc if |x| <= 4 then + + ph4 #y y := P2(t1) + pea 8 + ph4 #P2 + jsl poly + + ph4 #z z := Q2(t1) + pea 8 + ph4 #Q2 + jsl poly + + ph4 #z y := y/z + ph4 #y + FDIVX + + ph4 #t1 t1 := e^(-x^2) + ph4 #t1 + FMULX + lda t1+8 + eor #$8000 + sta t1+8 + ph4 #t1 + FEXPX + + ph4 #t1 y := t1 * y + ph4 #y + FMULX + + brl end_erfc else (if |x| > 4 or NAN) + +big_erfc pea -2 t1 := 1 / x^2 + ph4 #t1 + FXPWRI + + ph4 #y y := P3(t1) + pea 5 + ph4 #P3 + jsl poly + + ph4 #z z := Q3(t1) + pea 5 + ph4 #Q3 + jsl poly + + ph4 #z y := y/z + ph4 #y + FDIVX + + ph4 #t1 y := t1 * y + ph4 #y + FMULX + + ph4 #one_over_sqrt_pi y := 1/sqrt(pi) + y + ph4 #y + FADDX + + lda x_offset+8,s y := y / |x| + and #$7fff + sta x_offset+8,s + tsc + clc + adc #x_offset + ldx #0 + phx (push operands of below calls) + pha + phx + pha + phx + pha + phx + pha + phx + pha + ph4 #y + FDIVX + + FMULX y := e^(-x^2) * y + lda x_offset+8+8,s + eor #$8000 + sta x_offset+8+8,s + FEXPX + ph4 #y + FMULX + +end_erfc pla + bpl erf_from_erfc if computing erfc then + + ldx #$1300 (set allowed exception mask) + asl a + bpl rstr_env if x < 0 + + ph4 #two y := y - 2 + ph4 #y + FSUBI + bra flipsign y := -y + +erf_from_erfc anop + pha + ph4 #one if computing erf then + ph4 #y + FSUBX y := y - 1 + + pla + asl a + bmi clearxcp if x > 0 then + +flipsign lda y+8 y := -y + eor #$8000 + sta y+8 + +clearxcp ldx #$1100 ignore overflow, div-by-zero +rstr_env stx z (& underflow unless doing erfc for x>.5) + FGETENV + txa + and z + ora 1,s + sta 1,s + FSETENV unless computing erfc for x > 4 + + pla clean up stack + sta 9,s + pla + sta 9,s + tsc + clc + adc #6 + tcs + plb + ldx #^y return a pointer to the result + lda #y + rtl + +threshold dc f'0.5' threshold for computing erf or erfc + +; constants +two dc i2'2' +four dc i2'4' +one_over_sqrt_pi dc e'0.564189583547756286924' +; coefficients for erf calculation, |x| <= .5 +P1 dc e'1.857777061846031526730e-1' + dc e'3.161123743870565596947e+0' + dc e'1.138641541510501556495e+2' + dc e'3.774852376853020208137e+2' + dc e'3.209377589138469472562e+3' +one anop +Q1 dc e'1.0' + dc e'2.360129095234412093499e+1' + dc e'2.440246379344441733056e+2' + dc e'1.282616526077372275645e+3' + dc e'2.844236833439170622273e+3' +; coefficients for erfc calculation, .46875 <= x <= 4 +P2 dc e'2.15311535474403846343e-8' + dc e'5.64188496988670089180e-1' + dc e'8.88314979438837594118e+0' + dc e'6.61191906371416294775e+1' + dc e'2.98635138197400131132e+2' + dc e'8.81952221241769090411e+2' + dc e'1.71204761263407058314e+3' + dc e'2.05107837782607146532e+3' + dc e'1.23033935479799725272e+3' +Q2 dc e'1.0' + dc e'1.57449261107098347253e+1' + dc e'1.17693950891312499305e+2' + dc e'5.37181101862009857509e+2' + dc e'1.62138957456669018874e+3' + dc e'3.29079923573345962678e+3' + dc e'4.36261909014324715820e+3' + dc e'3.43936767414372163696e+3' + dc e'1.23033935480374942043e+3' +; coefficients for erfc calculation, x >= 4 +P3 dc e'-1.63153871373020978498e-2' + dc e'-3.05326634961232344035e-1' + dc e'-3.60344899949804439429e-1' + dc e'-1.25781726111229246204e-1' + dc e'-1.60837851487422766278e-2' + dc e'-6.58749161529837803157e-4' +Q3 dc e'1.0' + dc e'2.56852019228982242072e+0' + dc e'1.87295284992346047209e+0' + dc e'5.27905102951428412248e-1' + dc e'6.05183413124413191178e-2' + dc e'2.33520497626869185443e-3' +; temporaries / return values +y ds 10 +z ds 10 + end + **************************************************************** * * double exp2(double x); @@ -2383,6 +2677,53 @@ plusinf dc f'+inf' minusinf dc f'-inf' end +**************************************************************** +* +* poly: evaluate a polynomial +* +* Evaluates sum from i=0 to n of K_i * x^i +* +* Inputs: +* coeffs: array of coefficients, K_n down to K_0 +* n: degree of polynomial +* result: pointer to location for result +* t1: x value +* +* Note: The coeffs array is assumed not to cross banks. +* +**************************************************************** +* +poly private + using MathCommon2 + + csubroutine (4:coeffs,2:n,4:result),0 + + ldy #8 val := K_n +loop1 lda [coeffs],y + sta [result],y + dey + dey + bpl loop1 + +loop2 lda coeffs for i := n-1 downto 0 + clc + adc #10 + sta coeffs + + ph4 #t1 val := val * x + ph4 Date: Sat, 24 Dec 2022 20:20:40 -0600 Subject: [PATCH 04/35] 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. --- math2.asm | 239 +++++++++++++++++++++++++++++++++++++++++++++++++++ math2.macros | 23 +++++ 2 files changed, 262 insertions(+) diff --git a/math2.asm b/math2.asm index 15a46da..05179e3 100644 --- a/math2.asm +++ b/math2.asm @@ -3094,6 +3094,245 @@ scalbnl entry rtl end +**************************************************************** +* +* double tgamma(double x); +* +* Computes the gamma function of x. +* +**************************************************************** +* +tgamma start +tgammaf entry +tgammal entry + using MathCommon2 + + csubroutine (10:x),0 + + phb + phk + plb + + pha save env & set to default + tsc + inc a + pea 0 + pha + FPROCENTRY + +* For x < 0.5, use Gamma(x) = pi / (sin(x * pi) * Gamma(1 - x)) + stz reflect + ph4 #one_half if x < 0.5 then + tdc + clc + adc #x + pea 0 + pha + FCMPS + bvc lb1 + inc reflect + + ldx #8 orig_x := x +lp0 lda x,x + sta fracpart,x + sta orig_x,x + dex + dex + bpl lp0 + + ph4 #two fracpart := x REM 2 + ph4 #fracpart + FREMI + + ph4 #one x := x-1 + tdc + clc + adc #x + pea 0 + pha + FSUBX + + lda x+8 + eor #$8000 + sta x+8 + +* For 0 <= x <= 9.375, use the identity Gamma(x) = Gamma(x+1)/x +lb1 ldy #8 denom := 1 +lp1 lda one,y + sta denom,y + dey + dey + bpl lp1 + +lp2 ph4 #cutoff while x < 9.375 then + tdc + clc + adc #x + pea 0 + pha + FCMPS + bvc stirling + + tdc denom := denom * x + clc + adc #x + pea 0 + pha + ph4 #denom + FMULX + + ph4 #one x := x + 1 + tdc + clc + adc #x + pea 0 + pha + FADDX + bra lp2 + +* For x >= 9.375, calculate Gamma(x) using a Stirling series approximation +stirling lda x t1 := x + sta y y := x + sta z z := x + sta t1 + lda x+2 + sta y+2 + sta z+2 + sta t1+2 + lda x+4 + sta y+4 + sta z+4 + sta t1+4 + lda x+6 + sta y+6 + sta z+6 + sta t1+6 + lda x+8 + sta y+8 + sta z+8 + sta t1+8 + + ph4 #e z := x/e + ph4 #z + FDIVX + ph4 #one_half y := x - 1/2 + ph4 #y + FSUBS + ph4 #y z := (x/e)^(x-1/2) + ph4 #z + FXPWRY + + pea -1 t1 := 1/x + ph4 #t1 + FXPWRI + ph4 #y y := P(t1) + pea 17 + ph4 #P + jsl poly + + ph4 #y z := z * y * sqrt(2*pi/e) + ph4 #z + FMULX + ph4 #sqrt_2pi_over_e + ph4 #z + FMULX + +* Adjust result as necessary for small or negative x values + ph4 #denom z := z / denom + ph4 #z (for cases where initial x was small) + FDIVX + + lda reflect if doing reflection + jeq done + + ph4 #pi fracpart := sin(x*pi) + ph4 #fracpart + FMULX + ph4 #fracpart + FSINX + + ph4 #fracpart if sin(x*pi)=0 (i.e. x was an integer) + FCLASSX + txa + inc a + and #$00ff + bne lb2 + + asl fracpart+8 take sign from original x (for +-0) + asl orig_x+8 + ror fracpart+8 + + lda orig_x if original x was not 0 + ora orig_x+2 + ora orig_x+4 + ora orig_x+6 + beq lb2 + + lda #32767 force NAN result + sta z+8 + sta z+6 + + pea $0100 raise "invalid" exception (only) + FSETENV + +lb2 ph4 #z z := pi / (fracpart * z) + ph4 #fracpart + FMULX + + ph4 #pi + ph4 #z + FX2X + + ph4 #fracpart + ph4 #z + FDIVX + +done FPROCEXIT restore env & raise any new exceptions + plb + + lda #^z return a pointer to the result + sta x+2 + lda #z + sta x + creturn 4:x + +cutoff dc f'9.375' cutoff for using Stirling approximation + +one_half dc f'0.5' +two dc i2'2' +e dc e'2.7182818284590452353602874713526624977572' +pi dc e'3.1415926535897932384626433' +sqrt_2pi_over_e dc e'1.520346901066280805611940146754975627' + +P anop Stirling series constants + dc e'+1.79540117061234856108e-01' + dc e'-2.48174360026499773092e-03' + dc e'-2.95278809456991205054e-02' + dc e'+5.40164767892604515180e-04' + dc e'+6.40336283380806979482e-03' + dc e'-1.62516262783915816899e-04' + dc e'-1.91443849856547752650e-03' + dc e'+7.20489541602001055909e-05' + dc e'+8.39498720672087279993e-04' + dc e'-5.17179090826059219337e-05' + dc e'-5.92166437353693882865e-04' + dc e'+6.97281375836585777429e-05' + dc e'+7.84039221720066627474e-04' + dc e'-2.29472093621399176955e-04' + dc e'-2.68132716049382716049e-03' + dc e'+3.47222222222222222222e-03' + dc e'+8.33333333333333333333e-02' +one dc e'+1.00000000000000000000e+00' + +y ds 10 +z ds 10 +denom ds 10 +fracpart ds 10 + +reflect ds 2 flag: do reflection? +orig_x ds 10 original x value + end + **************************************************************** * * double trunc(double x); diff --git a/math2.macros b/math2.macros index 9634cc5..f03ec39 100644 --- a/math2.macros +++ b/math2.macros @@ -385,6 +385,11 @@ macro &l jpl &bp &l bmi *+5 + brl &bp + mend + macro +&l jeq &bp +&l bne *+5 brl &bp mend MACRO @@ -680,3 +685,21 @@ LDX #$090A JSL $E10000 MEND + MACRO +&LAB FSUBS +&LAB PEA $0202 + LDX #$090A + JSL $E10000 + MEND + MACRO +&LAB FSINX +&LAB PEA $001A + LDX #$0B0A + JSL $E10000 + MEND + MACRO +&LAB FREMI +&LAB PEA $040C + LDX #$090A + JSL $E10000 + MEND From 89664d2921325408b4dedda0a526bab5e1f9068e Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 24 Dec 2022 21:59:52 -0600 Subject: [PATCH 05/35] 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. --- math2.asm | 63 +++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 45 insertions(+), 18 deletions(-) diff --git a/math2.asm b/math2.asm index 05179e3..aec6b73 100644 --- a/math2.asm +++ b/math2.asm @@ -3164,30 +3164,57 @@ lp1 lda one,y dey bpl lp1 -lp2 ph4 #cutoff while x < 9.375 then - tdc - clc - adc #x - pea 0 - pha - FCMPS - bvc stirling - - tdc denom := denom * x - clc - adc #x - pea 0 - pha - ph4 #denom - FMULX + ph4 #cutoff + ph4 #z + FS2X - ph4 #one x := x + 1 + tdc z := 10.375 - x + clc + adc #x + pea 0 + pha + ph4 #z + FSUBX + + lda z+8 if z < 0 (or NAN) + jmi stirling just use Stirling series approx. + cmp #$7fff + jeq stirling + + ph4 #z truncate z to integer + FTINTX + + ph4 #z x := x + z tdc clc adc #x pea 0 pha FADDX + + tdc y := x + clc + adc #x + pea 0 + pha + ph4 #y + FX2X + + ph4 #z repeat z times : + ph4 #z + FX2I + +lp2 dec z + bmi stirling + + ph4 #one y := y - 1 + ph4 #y + FSUBX + + ph4 #y denom := denom * y + ph4 #denom + FMULX + bra lp2 * For x >= 9.375, calculate Gamma(x) using a Stirling series approximation @@ -3296,7 +3323,7 @@ done FPROCEXIT restore env & raise any new exceptions sta x creturn 4:x -cutoff dc f'9.375' cutoff for using Stirling approximation +cutoff dc f'10.375' cutoff for Stirling approximation (+1) one_half dc f'0.5' two dc i2'2' From 4019e9f3708af5c3fda4de77e2969ba58c05600c Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Wed, 28 Dec 2022 19:46:49 -0600 Subject: [PATCH 06/35] 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. --- time.asm | 158 +++++++++++++++++++++++++++++++++++++++++++++------- time.macros | 10 ++++ 2 files changed, 149 insertions(+), 19 deletions(-) diff --git a/time.asm b/time.asm index d1feb74..f323c77 100644 --- a/time.asm +++ b/time.asm @@ -283,43 +283,161 @@ lb3 add4 t2,#300 count := count - rts end +**************************************************************** +* +* struct tm *gmtime(t) +* time_t *t; +* +* Inputs: +* t - pointer to # of seconds since 1 Jan 1970 +* +* Outputs: +* returns a pointer to a time record for UTC time +* +**************************************************************** +* +gmtime start +t equ 6 + + phd + tsc + tcd + ldy #2 dereference the pointer to time_t + lda [t],Y + tax + lda [t] + tay + pld + + phb + pla move return address + sta 3,s + pla + sta 3,s + plb + + pea 0 push tm_isdst value (no DST for UTC) + phx push time_t value to convert + phy + + pha check if time tool is active + _tiStatus + pla + bcs lb2 + beq lb2 + + pha make space for TZ preferences record + pha + pea 1 get one record element only (TZ offset) + + tsc get time zone preference + inc a + pea 0 + pha + _tiGetTimePrefs + pla + bcs lb1 + + sec adjust for time zone (standard time) + lda 5,s + sbc 1,s + sta 5,s + lda 7,s + sbc 3,s + sta 7,s + + pha determine if it's daylight savings + ph2 #$5E + _ReadBParam + pla + lsr a + lsr a + bcs lb1 + +; clc + lda #-60*60 adjust for DST (+1 hour) if needed + adc 5,s + sta 5,s + lda #$ffff + adc 7,s + sta 7,s + +lb1 pla remove time zone offset from stack + pla + +lb2 jsl ~gmlocaltime use common gmtime/localtime code + rtl + end + **************************************************************** * * struct tm *localtime(t) * time_t *t; * * Inputs: -* t - # seconds since 1 Jan 1970 +* t - pointer to # of seconds since 1 Jan 1970 +* +* Outputs: +* returns a pointer to a time record for local time +* +**************************************************************** +* +localtime start + using TimeCommon +t equ 6 + + phd + tsc + tcd + ldy #2 dereference the pointer to time_t + lda [t],Y + tax + lda [t] + tay + pld + + phb + pla move return address + sta 3,s + pla + sta 3,s + + lda #-1 default DST setting = -1 (unknown) + cpy lasttime determine DST setting, if we can + bne lb1 + cpx lasttime+2 + bne lb1 + lda lastDST +lb1 plb + + pha push tm_isdst value + phx push time_t value to convert + phy + jsl ~gmlocaltime use common gmtime/localtime code + rtl + end + +**************************************************************** +* +* ~gmlocaltime - common code for gmtime and localtime +* +* Inputs: +* t - time_t value (# of seconds since 1 Jan 1970) +* isdst - value for tm_isdst flag * * Outputs: * returns a pointer to a time record * **************************************************************** * -localtime start -gmtime entry +~gmlocaltime private using TimeCommon - csubroutine (4:t),0 + csubroutine (4:t,2:isdst),0 phb phk plb - ldy #2 dereference the pointer - lda [t],Y - tax - lda [t] - sta t - stx t+2 - - ldy #-1 default DST setting = -1 (unknown) - cmp lasttime determine DST setting, if we can - bne lb0 - cpx lasttime+2 - bne lb0 - ldy lastDST -lb0 sty tm_isdst - lda #69 find the year sta year lda #1 @@ -377,6 +495,8 @@ lb2a ble lb2 ph4 #tm_sec set the day of week/year jsl mktime lla t,tm_sec + lda isdst set the DST flag + sta tm_isdst plb creturn 4:t diff --git a/time.macros b/time.macros index 3a9999b..c9db57c 100644 --- a/time.macros +++ b/time.macros @@ -621,3 +621,13 @@ &LAB LDX #$260B JSL $E10000 MEND + MACRO +&lab _tiStatus +&lab ldx #$0638 + jsl $E10000 + MEND + MACRO +&lab _tiGetTimePrefs +&lab ldx #$0938 + jsl $E10000 + MEND From e2de990f4d5c608cc191ad9d94a2df27571d22a5 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Wed, 28 Dec 2022 19:55:48 -0600 Subject: [PATCH 07/35] 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. --- time.asm | 54 ++++++++++++++++++++++++++++++++++++++++++++++++----- time.macros | 5 +++++ 2 files changed, 54 insertions(+), 5 deletions(-) diff --git a/time.asm b/time.asm index f323c77..9cbc246 100644 --- a/time.asm +++ b/time.asm @@ -1098,12 +1098,56 @@ Y_skip inx rts ;%z - offset from UTC, if available -;we print nothing, because time zone info is not available -fmt_z rts - ;%Z - time zone name or abbreviation, if available -;we print nothing, because time zone info is not available -fmt_Z rts +;we print the numeric offset for both, or nothing if time zone is not available +fmt_z anop +fmt_Z pha check if time tool is active + _tiStatus + pla + bcs z_ret + beq z_ret + pea 0 push pointer to string buffer + tdc +; clc + adc #numstr + pha + pha make space for TZ preferences record + pha + pea 1 get one record element only (TZ offset) + tsc get time zone preference + inc a + pea 0 + pha + _tiGetTimePrefs + pla + bcc z_dst +z_bail pla bail out in case of error + pla + pla + pla +z_ret rts +z_dst ldy #tm_isdst adjust for DST (+1 hour) if needed + lda [timeptr],y + bmi z_bail bail out if DST is unknown + beq z_fmtstr +; clc + pla + adc #60*60 + tay + pla + adc #0 + pha + phy +z_fmtstr pea 0 no DST mangling + _tiOffset2TimeZoneString get TZ offset string + bcs z_ret + ldx #1 +z_loop lda numstr,x print the digits + jsr writech + inx + cpx #5+1 + blt z_loop + rts fmt_invalid rts diff --git a/time.macros b/time.macros index c9db57c..e291e83 100644 --- a/time.macros +++ b/time.macros @@ -631,3 +631,8 @@ &lab ldx #$0938 jsl $E10000 MEND + MACRO +&lab _tiOffset2TimeZoneString +&lab ldx #$1138 + jsl $E10000 + MEND From d30ee1a2e56a3d115bfe52fd108882bed9e70709 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Thu, 29 Dec 2022 14:25:24 -0600 Subject: [PATCH 08/35] 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.) --- time.asm | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/time.asm b/time.asm index 9cbc246..82ea245 100644 --- a/time.asm +++ b/time.asm @@ -30,7 +30,7 @@ Time start dummy segment * TimeCommon privdata ; -; For conversion to/from seconds since 1970 +; For conversion to/from seconds since 13 Nov 1969 ; year ds 4 year 0..99 month ds 4 month 1..12 @@ -38,7 +38,7 @@ day ds 4 day 1..31 hour ds 4 hour 0..23 minute ds 4 minute 0..59 second ds 4 second 0..59 -count ds 4 seconds since 1 Jan 1970 +count ds 4 seconds since 13 Nov 1969 t1 ds 4 work variable t2 ds 4 work variable @@ -225,20 +225,20 @@ mk1 inx **************************************************************** * -* factor - compute the seconds since 1 Jan 1970 from date +* factor - compute the seconds since 13 Nov 1969 from date * * Inputs: * year,month,day,hour,minute,second - time to convert * * Outputs: -* count - seconds since 1 Jan 1970 +* count - seconds since 13 Nov 1969 * **************************************************************** * factor private using TimeCommon ; -; compute the # of days since 1 Jan 1970 +; compute the # of days since 13 Nov 1969 ; mul4 year,#365,count count := 365*year + day + 31*(month-1) add4 count,day @@ -269,8 +269,9 @@ lb3 add4 t2,#300 count := count - mul4 t2,#3 div4 t2,#4 sub4 count,t2 - sub4 count,#25516 subtract off days between 1 Jan 00 and -! 1 Jan 70 + sub4 count,#25516 subtract off days between 1 Jan 1900 +! and 13 Nov 1969, minus 2 to adjust for +! skipped leap days in 1700 and 1800 ; ; Convert to seconds and add in time of day in seconds ; @@ -289,7 +290,7 @@ lb3 add4 t2,#300 count := count - * time_t *t; * * Inputs: -* t - pointer to # of seconds since 1 Jan 1970 +* t - pointer to # of seconds since 13 Nov 1969 * * Outputs: * returns a pointer to a time record for UTC time @@ -375,7 +376,7 @@ lb2 jsl ~gmlocaltime use common gmtime/localtime code * time_t *t; * * Inputs: -* t - pointer to # of seconds since 1 Jan 1970 +* t - pointer to # of seconds since 13 Nov 1969 * * Outputs: * returns a pointer to a time record for local time @@ -422,7 +423,7 @@ lb1 plb * ~gmlocaltime - common code for gmtime and localtime * * Inputs: -* t - time_t value (# of seconds since 1 Jan 1970) +* t - time_t value (# of seconds since 13 Nov 1969) * isdst - value for tm_isdst flag * * Outputs: @@ -522,7 +523,7 @@ tm_isdst ds 2 daylight savings? 1 = yes, 0 = no * Outputs: * tmptr->wday - day of week * tmptr->yday - day of year -* returns the ime in seconds since 1 Jan 1970 +* returns the ime in seconds since 13 Nov 1969 * **************************************************************** * @@ -561,7 +562,7 @@ temp2 equ 5 temp variable sta minute lda [tmptr] sta second - jsr factor compute seconds since 1970 + jsr factor compute seconds since 13 Nov 1969 move4 count,temp save the value for later return lda #1 compute the days since the start of the sta month year From 17faeda1de23039a8c330f59c934f2951075cc71 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Thu, 29 Dec 2022 22:31:31 -0600 Subject: [PATCH 09/35] 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. --- time.asm | 132 ++++++++++++++++++++++++++++++++++++++++------------ time.macros | 29 ++++++++++-- 2 files changed, 126 insertions(+), 35 deletions(-) diff --git a/time.asm b/time.asm index 82ea245..65bd9e1 100644 --- a/time.asm +++ b/time.asm @@ -38,7 +38,7 @@ day ds 4 day 1..31 hour ds 4 hour 0..23 minute ds 4 minute 0..59 second ds 4 second 0..59 -count ds 4 seconds since 13 Nov 1969 +count ds 8 seconds since 13 Nov 1969 t1 ds 4 work variable t2 ds 4 work variable @@ -229,59 +229,121 @@ mk1 inx * * Inputs: * year,month,day,hour,minute,second - time to convert +* (each treated as a signed 16-bit value) * * Outputs: -* count - seconds since 13 Nov 1969 +* count - seconds since 13 Nov 1969 (signed 64-bit value) * **************************************************************** * factor private using TimeCommon + +; +; sign-extend time components to 4 bytes +; + stz year+2 + lda year + bpl lb0 + dec year+2 +lb0 stz month+2 + lda month + bpl lb0a + dec month+2 +lb0a stz day+2 + lda day + bpl lb0b + dec day+2 +lb0b stz hour+2 + lda hour + bpl lb0c + dec hour+2 +lb0c stz minute+2 + lda minute + bpl lb0d + dec minute+2 +lb0d stz second+2 + lda second + bpl lb0e + dec second+2 ; ; compute the # of days since 13 Nov 1969 ; - mul4 year,#365,count count := 365*year + day + 31*(month-1) +lb0e mul4 year,#365,count count := 365*year + day + 31*(month-1) add4 count,day mul4 month,#31,t1 add4 count,t1 sub4 count,#31 - move4 year,t2 t2 := year + add4 year,#32800,t2 t2 := year + 32800 (so it is positive) lda month if January or February then cmp #3 bge lb1 - dec t2 year := year-1 + dec4 t2 year := year-1 bra lb2 else lb1 mul4 month,#4,t1 count := count - (month*4+23) div 10 add4 t1,#23 div4 t1,#10 sub4 count,t1 -lb2 lda t2 count := count + year div 4 - lsr A - lsr A - clc - adc count - sta count - bcc lb3 - inc count+2 -lb3 add4 t2,#300 count := count - - div4 t2,#100 ((300+year) div 100+1)*3 div 4 +lb2 div4 t2,#4,t1 count := count + (year+32800) div 4 + add4 count,t1 + add4 t2,#300 count := count - + div4 t2,#100 ((300+year+32800) div 100+1)*3 div 4 inc4 t2 mul4 t2,#3 div4 t2,#4 sub4 count,t2 - sub4 count,#25516 subtract off days between 1 Jan 1900 + sub4 count,#25518-2+7954 subtract off days between 1 Jan 1900 ! and 13 Nov 1969, minus 2 to adjust for -! skipped leap days in 1700 and 1800 +! skipped leap days in 1700 and 1800, +! plus 7954 to adjust for leap days in +! an additional 32800 years ; ; Convert to seconds and add in time of day in seconds ; - mul4 count,#24*60*60 convert to seconds - mul4 hour,#3600,t1 add in hours*3600 - add4 count,t1 + lda count+2 convert to 64-bit count of seconds + pha + bpl lb3 if count is negative, negate it + sub4 #0,count,count +lb3 tsc compute count*24*60*60 + sec + sbc #8 + tcs + ph4 count + ph4 #24*60*60 + _LongMul + pla + sta count + pla + sta count+2 + pla + sta count+4 + pla + sta count+6 + pla + bpl lb4 if count was negative, negate result + negate8 count +lb4 mul4 hour,#3600,t1 add in hours*3600 + jsr add_t1_to_count mul4 minute,#60,t1 add in minutes*60 - add4 count,t1 - add4 count,second add in seconds - rts + jsr add_t1_to_count + move4 second,t1 add in seconds +; +; Add t1 (4 bytes) to count (8 bytes). +; (This is called as a subroutine and also run at the end of factor.) +; +add_t1_to_count anop + clc + lda count + adc t1 + sta count + lda count+2 + adc t1+2 + sta count+2 + bcc ret + inc count+4 + bne ret + inc count+6 +ret rts end **************************************************************** @@ -537,13 +599,10 @@ temp2 equ 5 temp variable phk plb - lla temp,-1 assume we can't do it - ldy #10 error if year < 70 + ldy #10 set time parameters lda [tmptr],Y sta year - cmp #70 - jlt lb1 - dey set the other time parameters + dey dey lda [tmptr],Y inc A @@ -563,7 +622,14 @@ temp2 equ 5 temp variable lda [tmptr] sta second jsr factor compute seconds since 13 Nov 1969 - move4 count,temp save the value for later return + lda count+4 if time is unrepresentable + ora count+6 + beq lb0 + lda #-1 return -1 + sta temp + sta temp+2 + brl lb1 +lb0 move4 count,temp save the value for later return lda #1 compute the days since the start of the sta month year sta day @@ -638,7 +704,13 @@ time start pla pla jsr factor convert the seconds - lda tptr if tptr <> nil then + lda count+4 if time is unrepresentable + ora count+6 + beq lb0 + lda #-1 set return value to -1 + sta count + sta count+2 +lb0 lda tptr if tptr <> nil then ora tptr+2 beq lb1 ldy #2 place the result there diff --git a/time.macros b/time.macros index e291e83..f65e0b5 100644 --- a/time.macros +++ b/time.macros @@ -477,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 @@ -636,3 +631,27 @@ &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 From b302a85fd68588ec9d6c3a6b477a034b865a7c9d Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Thu, 29 Dec 2022 22:53:37 -0600 Subject: [PATCH 10/35] 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. --- time.asm | 33 +++++++++++++-------------------- 1 file changed, 13 insertions(+), 20 deletions(-) diff --git a/time.asm b/time.asm index 65bd9e1..0c12ba0 100644 --- a/time.asm +++ b/time.asm @@ -33,7 +33,7 @@ TimeCommon privdata ; For conversion to/from seconds since 13 Nov 1969 ; year ds 4 year 0..99 -month ds 4 month 1..12 +month ds 4 month 0..11 day ds 4 day 1..31 hour ds 4 hour 0..23 minute ds 4 minute 0..59 @@ -269,19 +269,18 @@ lb0d stz second+2 ; ; compute the # of days since 13 Nov 1969 ; -lb0e mul4 year,#365,count count := 365*year + day + 31*(month-1) +lb0e mul4 year,#365,count count := 365*year + day + 31*month add4 count,day mul4 month,#31,t1 add4 count,t1 - sub4 count,#31 add4 year,#32800,t2 t2 := year + 32800 (so it is positive) lda month if January or February then - cmp #3 + cmp #2 bge lb1 dec4 t2 year := year-1 bra lb2 else -lb1 mul4 month,#4,t1 count := count - (month*4+23) div 10 - add4 t1,#23 +lb1 mul4 month,#4,t1 count := count - (month*4+27) div 10 + add4 t1,#27 div4 t1,#10 sub4 count,t1 lb2 div4 t2,#4,t1 count := count + (year+32800) div 4 @@ -504,8 +503,8 @@ lb1 plb lda #69 find the year sta year lda #1 - sta month sta day + stz month stz hour stz minute stz second @@ -531,7 +530,6 @@ lb2a ble lb2 lda year set the year sta tm_year lda month set the month - dec A sta tm_mon sub4 t,count find the number of seconds move4 t,t1 @@ -605,7 +603,6 @@ temp2 equ 5 temp variable dey dey lda [tmptr],Y - inc A sta month dey dey @@ -631,8 +628,8 @@ temp2 equ 5 temp variable brl lb1 lb0 move4 count,temp save the value for later return lda #1 compute the days since the start of the - sta month year - sta day + sta day year + stz month jsr factor sub4 temp,count,count div4 count,#60*60*24 @@ -681,20 +678,16 @@ time start and #$00FF inc A sta day - lda 5,S set the month - and #$FF00 - xba - inc A + lda 6,S set the month + and #$00FF sta month - lda 3,S set the year - and #$FF00 - xba + lda 4,S set the year + and #$00FF sta year lda 3,S set the hour and #$00FF sta hour - lda 1,S set the minute - xba + lda 2,S set the minute and #$00FF sta minute pla set the second From f15caf8096d900c44fc6d16697d753dd97cbdd85 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Thu, 29 Dec 2022 23:17:24 -0600 Subject: [PATCH 11/35] 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). --- time.asm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/time.asm b/time.asm index 0c12ba0..2fcd8e4 100644 --- a/time.asm +++ b/time.asm @@ -510,22 +510,27 @@ lb1 plb stz second lb1 inc year jsr factor + lda count+4 + bne lb1b lda count+2 cmp t+2 bne lb1a lda count cmp t lb1a ble lb1 - dec year +lb1b dec year lb2 inc month find the month jsr factor + lda count+4 + bmi lb2 + bne lb2b lda count+2 cmp t+2 bne lb2a lda count cmp t lb2a ble lb2 - dec month +lb2b dec month jsr factor recompute the factor lda year set the year sta tm_year From 32c5fd94a1a0833f8b78b1e0049056e8bc0e56c6 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Thu, 29 Dec 2022 23:50:01 -0600 Subject: [PATCH 12/35] Handle out-of-range months in mktime() input. --- time.asm | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/time.asm b/time.asm index 2fcd8e4..4f5a448 100644 --- a/time.asm +++ b/time.asm @@ -32,7 +32,7 @@ TimeCommon privdata ; ; For conversion to/from seconds since 13 Nov 1969 ; -year ds 4 year 0..99 +year ds 4 year (years since 1900) month ds 4 month 0..11 day ds 4 day 1..31 hour ds 4 hour 0..23 @@ -234,6 +234,8 @@ mk1 inx * Outputs: * count - seconds since 13 Nov 1969 (signed 64-bit value) * +* Note: Input values outside their normal ranges are allowed. +* **************************************************************** * factor private @@ -247,9 +249,6 @@ factor private bpl lb0 dec year+2 lb0 stz month+2 - lda month - bpl lb0a - dec month+2 lb0a stz day+2 lda day bpl lb0b @@ -267,9 +266,25 @@ lb0d stz second+2 bpl lb0e dec second+2 ; +; adjust for out-of-range month values +; +lb0e lda month + bpl lb0f + clc + adc #12 + sta month + dec4 year + bra lb0e +lb0f sec + sbc #12 + bmi lb0x + sta month + inc4 year + bra lb0e +; ; compute the # of days since 13 Nov 1969 ; -lb0e mul4 year,#365,count count := 365*year + day + 31*month +lb0x mul4 year,#365,count count := 365*year + day + 31*month add4 count,day mul4 month,#31,t1 add4 count,t1 From 3b0c1c21492b407121f510c1361f255b03e192b1 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Fri, 30 Dec 2022 17:28:16 -0600 Subject: [PATCH 13/35] 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(). --- time.asm | 112 ++++++++++++++++++++++++++++++------------------------- 1 file changed, 62 insertions(+), 50 deletions(-) diff --git a/time.asm b/time.asm index 4f5a448..3054868 100644 --- a/time.asm +++ b/time.asm @@ -227,9 +227,13 @@ mk1 inx * * factor - compute the seconds since 13 Nov 1969 from date * +* factor_second32 - alt entry point taking second as a +* signed 32-bit input value +* * Inputs: * year,month,day,hour,minute,second - time to convert -* (each treated as a signed 16-bit value) +* (each treated as a signed 16-bit value, with the +* exception of second when using factor_second32) * * Outputs: * count - seconds since 13 Nov 1969 (signed 64-bit value) @@ -244,12 +248,18 @@ factor private ; ; sign-extend time components to 4 bytes ; - stz year+2 - lda year + + stz second+2 + lda second bpl lb0 + dec second+2 +factor_second32 entry +lb0 stz year+2 + lda year + bpl lb0a dec year+2 -lb0 stz month+2 -lb0a stz day+2 +lb0a stz month+2 + stz day+2 lda day bpl lb0b dec day+2 @@ -259,12 +269,8 @@ lb0b stz hour+2 dec hour+2 lb0c stz minute+2 lda minute - bpl lb0d - dec minute+2 -lb0d stz second+2 - lda second bpl lb0e - dec second+2 + dec minute+2 ; ; adjust for out-of-range month values ; @@ -347,17 +353,24 @@ lb4 mul4 hour,#3600,t1 add in hours*3600 ; add_t1_to_count anop clc - lda count - adc t1 + lda t1 + adc count sta count - lda count+2 - adc t1+2 + lda t1+2 + tax + adc count+2 sta count+2 - bcc ret - inc count+4 - bne ret - inc count+6 -ret rts + lda #0 + txy + bpl ad1 + dec a +ad1 tay + adc count+4 + sta count+4 + tya + adc count+6 + sta count+6 + rts end **************************************************************** @@ -397,14 +410,13 @@ t equ 6 phx push time_t value to convert phy - pha check if time tool is active - _tiStatus - pla - bcs lb2 - beq lb2 - - pha make space for TZ preferences record + pha make space for status return/TZ prefs pha + _tiStatus check if time tool is active + bcs no_tz + lda 1,s + beq no_tz + pea 1 get one record element only (TZ offset) tsc get time zone preference @@ -413,15 +425,7 @@ t equ 6 pha _tiGetTimePrefs pla - bcs lb1 - - sec adjust for time zone (standard time) - lda 5,s - sbc 1,s - sta 5,s - lda 7,s - sbc 3,s - sta 7,s + bcs no_tz pha determine if it's daylight savings ph2 #$5E @@ -429,20 +433,22 @@ t equ 6 pla lsr a lsr a - bcs lb1 + bcs doit ; clc - lda #-60*60 adjust for DST (+1 hour) if needed - adc 5,s - sta 5,s - lda #$ffff - adc 7,s - sta 7,s + lda #60*60 adjust for DST (+1 hour) if needed + adc 1,s + sta 1,s + lda #0 + adc 3,s + sta 3,s + bra doit -lb1 pla remove time zone offset from stack - pla +no_tz lda #0 + sta 1,s + sta 3,s -lb2 jsl ~gmlocaltime use common gmtime/localtime code +doit jsl ~gmlocaltime use common gmtime/localtime code rtl end @@ -490,6 +496,8 @@ lb1 plb pha push tm_isdst value phx push time_t value to convert phy + pea 0 no time zone offset + pea 0 jsl ~gmlocaltime use common gmtime/localtime code rtl end @@ -499,6 +507,7 @@ lb1 plb * ~gmlocaltime - common code for gmtime and localtime * * Inputs: +* tz_offset - offset of local time from desired time zone * t - time_t value (# of seconds since 13 Nov 1969) * isdst - value for tm_isdst flag * @@ -510,7 +519,7 @@ lb1 plb ~gmlocaltime private using TimeCommon - csubroutine (4:t,2:isdst),0 + csubroutine (4:tz_offset,4:t,2:isdst),0 phb phk plb @@ -522,9 +531,12 @@ lb1 plb stz month stz hour stz minute - stz second + lda tz_offset + sta second + lda tz_offset+2 + sta second+2 lb1 inc year - jsr factor + jsr factor_second32 lda count+4 bne lb1b lda count+2 @@ -535,7 +547,7 @@ lb1 inc year lb1a ble lb1 lb1b dec year lb2 inc month find the month - jsr factor + jsr factor_second32 lda count+4 bmi lb2 bne lb2b @@ -546,7 +558,7 @@ lb2 inc month find the month cmp t lb2a ble lb2 lb2b dec month - jsr factor recompute the factor + jsr factor_second32 recompute the factor lda year set the year sta tm_year lda month set the month From 882af9e0756e1e7060beb2c67ce9de3643e7e41a Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Fri, 30 Dec 2022 18:46:51 -0600 Subject: [PATCH 14/35] 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. --- time.asm | 63 ++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 41 insertions(+), 22 deletions(-) diff --git a/time.asm b/time.asm index 3054868..00aeea8 100644 --- a/time.asm +++ b/time.asm @@ -373,6 +373,16 @@ ad1 tay rts end +**************************************************************** +* +* gmlocaltime_tm - struct tm used by gmtime and localtime +* +**************************************************************** +* +gmlocaltime_tm private + ds 9*2 + end + **************************************************************** * * struct tm *gmtime(t) @@ -406,6 +416,7 @@ t equ 6 sta 3,s plb + ph4 #gmlocaltime_tm push address of struct tm to use pea 0 push tm_isdst value (no DST for UTC) phx push time_t value to convert phy @@ -484,7 +495,8 @@ t equ 6 sta 3,s pla sta 3,s - + + ph4 #gmlocaltime_tm push address of struct tm to use lda #-1 default DST setting = -1 (unknown) cpy lasttime determine DST setting, if we can bne lb1 @@ -510,6 +522,7 @@ lb1 plb * tz_offset - offset of local time from desired time zone * t - time_t value (# of seconds since 13 Nov 1969) * isdst - value for tm_isdst flag +* tm - pointer to struct tm for result * * Outputs: * returns a pointer to a time record @@ -518,8 +531,18 @@ lb1 plb * ~gmlocaltime private using TimeCommon +tm_sec equ 0 seconds 0..59 +tm_min equ tm_sec+2 minutes 0..59 +tm_hour equ tm_min+2 hours 0..23 +tm_mday equ tm_hour+2 day 1..31 +tm_mon equ tm_mday+2 month 0..11 +tm_year equ tm_mon+2 year 69..205 (1900=0) +tm_wday equ tm_year+2 day of week 0..6 (Sun = 0) +tm_yday equ tm_wday+2 day of year 0..365 +tm_isdst equ tm_yday+2 daylight savings? 1 = yes, 0 = no - csubroutine (4:tz_offset,4:t,2:isdst),0 + + csubroutine (4:tz_offset,4:t,2:isdst,4:tm),0 phb phk plb @@ -560,48 +583,44 @@ lb2a ble lb2 lb2b dec month jsr factor_second32 recompute the factor lda year set the year - sta tm_year + ldy #tm_year + sta [tm],y lda month set the month - sta tm_mon + ldy #tm_mon + sta [tm],y sub4 t,count find the number of seconds move4 t,t1 div4 t,#60 mul4 t,#60,t2 sub4 t1,t2 lda t1 - sta tm_sec + ldy #tm_sec + sta [tm],y move4 t,t1 find the number of minutes div4 t,#60 mul4 t,#60,t2 sub4 t1,t2 lda t1 - sta tm_min + ldy #tm_min + sta [tm],y move4 t,t1 find the number of hours div4 t,#24 mul4 t,#24,t2 sub4 t1,t2 lda t1 - sta tm_hour + ldy #tm_hour + sta [tm],y lda t set the day inc A - sta tm_mday - ph4 #tm_sec set the day of week/year + ldy #tm_mday + sta [tm],y + ph4 tm set the day of week/year jsl mktime - lla t,tm_sec lda isdst set the DST flag - sta tm_isdst + ldy #tm_isdst + sta [tm],y plb - creturn 4:t - -tm_sec ds 2 seconds 0..59 -tm_min ds 2 minutes 0..59 -tm_hour ds 2 hours 0..23 -tm_mday ds 2 day 1..31 -tm_mon ds 2 month 0..11 -tm_year ds 2 year 70..200 (1900=0) -tm_wday ds 2 day of week 0..6 (Sun = 0) -tm_yday ds 2 day of year 0..365 -tm_isdst ds 2 daylight savings? 1 = yes, 0 = no + creturn 4:tm end **************************************************************** From 7e4f067c350c39cbb51a90ec8f9be851f3019315 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 31 Dec 2022 19:10:36 -0600 Subject: [PATCH 15/35] 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. --- time.asm | 28 ++++++++++++++++++++++++++-- time.macros | 12 ++++++++++++ 2 files changed, 38 insertions(+), 2 deletions(-) diff --git a/time.asm b/time.asm index 00aeea8..5cc9ff6 100644 --- a/time.asm +++ b/time.asm @@ -588,6 +588,7 @@ lb2b dec month lda month set the month ldy #tm_mon sta [tm],y + ph4 Date: Sat, 31 Dec 2022 21:45:49 -0600 Subject: [PATCH 16/35] mktime: force struct tm components to their normal ranges. This is done by calling ~gmlocaltime after computing the time_t value in mktime. --- time.asm | 48 ++++++++++++++++++++---------------------------- 1 file changed, 20 insertions(+), 28 deletions(-) diff --git a/time.asm b/time.asm index 5cc9ff6..9b7be1f 100644 --- a/time.asm +++ b/time.asm @@ -19,7 +19,18 @@ * **************************************************************** * -Time start dummy segment +Time private dummy segment + +; struct tm fields +tm_sec gequ 0 seconds 0..59 +tm_min gequ tm_sec+2 minutes 0..59 +tm_hour gequ tm_min+2 hours 0..23 +tm_mday gequ tm_hour+2 day 1..31 +tm_mon gequ tm_mday+2 month 0..11 +tm_year gequ tm_mon+2 year 69..205 (1900=0) +tm_wday gequ tm_year+2 day of week 0..6 (Sun = 0) +tm_yday gequ tm_wday+2 day of year 0..365 +tm_isdst gequ tm_yday+2 daylight savings? 1 = yes, 0 = no end **************************************************************** @@ -531,16 +542,6 @@ lb1 plb * ~gmlocaltime private using TimeCommon -tm_sec equ 0 seconds 0..59 -tm_min equ tm_sec+2 minutes 0..59 -tm_hour equ tm_min+2 hours 0..23 -tm_mday equ tm_hour+2 day 1..31 -tm_mon equ tm_mday+2 month 0..11 -tm_year equ tm_mon+2 year 69..205 (1900=0) -tm_wday equ tm_year+2 day of week 0..6 (Sun = 0) -tm_yday equ tm_wday+2 day of year 0..365 -tm_isdst equ tm_yday+2 daylight savings? 1 = yes, 0 = no - csubroutine (4:tz_offset,4:t,2:isdst,4:tm),0 phb @@ -672,7 +673,7 @@ temp2 equ 5 temp variable phk plb - ldy #10 set time parameters + ldy #tm_year set time parameters lda [tmptr],Y sta year dey @@ -702,22 +703,13 @@ temp2 equ 5 temp variable sta temp+2 brl lb1 lb0 move4 count,temp save the value for later return - lda #1 compute the days since the start of the - sta day year - stz month - jsr factor - sub4 temp,count,count - div4 count,#60*60*24 - ldy #14 set the days - lda count - sta [tmptr],Y - div4 temp,#60*60*24,temp2 compute the day of week - add4 temp2,#4 - mod4 temp2,#7 - lda temp2 set the day of week - ldy #12 - sta [tmptr],Y - + ph4 Date: Sun, 1 Jan 2023 21:31:25 -0600 Subject: [PATCH 17/35] 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. --- time.asm | 156 ++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 120 insertions(+), 36 deletions(-) diff --git a/time.asm b/time.asm index 9b7be1f..a64b9ae 100644 --- a/time.asm +++ b/time.asm @@ -383,6 +383,60 @@ ad1 tay sta count+6 rts end + +**************************************************************** +* +* ~get_tz_offset - get current time zone offset from UTC +* +* Outputs: +* A-X - time zone offset from UTC +* +**************************************************************** +* +~get_tz_offset private + pha make space for status return/TZ prefs + pha + _tiStatus check if time tool is active + bcs no_tz + lda 1,s + beq no_tz + + pea 1 get one record element only (TZ offset) + + tsc get time zone preference + inc a + pea 0 + pha + _tiGetTimePrefs + pla + bcs no_tz + + pha determine if it's daylight savings + ph2 #$5E + _ReadBParam + pla + lsr a + lsr a + bcs ret + +; clc + lda #60*60 adjust for DST (+1 hour) if needed + adc 1,s + sta 1,s + lda #0 + adc 3,s + sta 3,s + +ret pla return offset value + plx + rts + +no_tz pla + pla + lda #0 assume 0 offset if no TZ info available + tax + rts + end **************************************************************** * @@ -432,43 +486,9 @@ t equ 6 phx push time_t value to convert phy - pha make space for status return/TZ prefs + jsr ~get_tz_offset push time zone offset + phx pha - _tiStatus check if time tool is active - bcs no_tz - lda 1,s - beq no_tz - - pea 1 get one record element only (TZ offset) - - tsc get time zone preference - inc a - pea 0 - pha - _tiGetTimePrefs - pla - bcs no_tz - - pha determine if it's daylight savings - ph2 #$5E - _ReadBParam - pla - lsr a - lsr a - bcs doit - -; clc - lda #60*60 adjust for DST (+1 hour) if needed - adc 1,s - sta 1,s - lda #0 - adc 3,s - sta 3,s - bra doit - -no_tz lda #0 - sta 1,s - sta 3,s doit jsl ~gmlocaltime use common gmtime/localtime code rtl @@ -797,6 +817,70 @@ lb1 lda count creturn 4:tptr end +**************************************************************** +* +* int timespec_get(struct timespec *ts, int base); +* +* Inputs: +* ts - pointer to structure for result +* base - requested time base +* +* Outputs: +* *tptr - the requested time (if successful) +* returns base if successful, or 0 otherwise +* +**************************************************************** +* +timespec_get start + using TimeCommon +tz_offset equ 1 time zone offset from UTC +current_time equ 5 current time + +TIME_UTC equ 1 UTC time base + +tv_sec equ 0 struct timespec members +tv_nsec equ 4 + + csubroutine (4:ts,2:base),8 + + lda base + cmp #TIME_UTC + bne err + + ph4 #0 get current time (in count) + jsl time + sta current_time + stx current_time+2 + and current_time+2 if time is not available + inc a + beq err report error + + jsr ~get_tz_offset get time zone offset + sta tz_offset + stx tz_offset+2 + + sec adjust for time zone & store result + lda current_time + sbc tz_offset + sta [ts] + lda current_time+2 + sbc tz_offset+2 + ldy #tv_sec+2 + sta [ts],y + + ldy #tv_nsec ts->tv_nsec = 0 + lda #0 + sta [ts],y + iny + iny + sta [ts],y + bra ret + +err stz base unsupported base: return 0 + +ret creturn 2:base + end + **************************************************************** * * size_t strftime( From 69765a96eff972ffa10df3233dae93baeb9c6604 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 2 Jan 2023 18:01:28 -0600 Subject: [PATCH 18/35] 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. --- cc.asm | 4 ++++ time.asm | 34 ++++++++++++++-------------------- vars.asm | 2 ++ 3 files changed, 20 insertions(+), 20 deletions(-) diff --git a/cc.asm b/cc.asm index 3ddb0f8..89f3da5 100644 --- a/cc.asm +++ b/cc.asm @@ -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 @@ -363,6 +364,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 diff --git a/time.asm b/time.asm index a64b9ae..54dda5f 100644 --- a/time.asm +++ b/time.asm @@ -394,13 +394,11 @@ ad1 tay **************************************************************** * ~get_tz_offset private - pha make space for status return/TZ prefs + lda >__useTimeTool if not using time tool + beq no_tz assume we have no TZ offset + + pha make space for TZ prefs pha - _tiStatus check if time tool is active - bcs no_tz - lda 1,s - beq no_tz - pea 1 get one record element only (TZ offset) tsc get time zone preference @@ -409,9 +407,14 @@ ad1 tay pha _tiGetTimePrefs pla - bcs no_tz + bcc have_tz + pla + pla + lda #0 assume 0 offset if TZ info not available +no_tz tax + rts - pha determine if it's daylight savings +have_tz pha determine if it's daylight savings ph2 #$5E _ReadBParam pla @@ -430,12 +433,6 @@ ad1 tay ret pla return offset value plx rts - -no_tz pla - pla - lda #0 assume 0 offset if no TZ info available - tax - rts end **************************************************************** @@ -1318,14 +1315,11 @@ Y_skip inx ;%Z - time zone name or abbreviation, if available ;we print the numeric offset for both, or nothing if time zone is not available fmt_z anop -fmt_Z pha check if time tool is active - _tiStatus - pla - bcs z_ret - beq z_ret +fmt_Z lda >__useTimeTool if not using Time Tool + beq z_ret write nothing pea 0 push pointer to string buffer tdc -; clc + clc adc #numstr pha pha make space for TZ preferences record diff --git a/vars.asm b/vars.asm index 20be459..6332749 100644 --- a/vars.asm +++ b/vars.asm @@ -35,6 +35,8 @@ sys_nerr entry # of error messages _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 functions? + ds 2 end **************************************************************** From 506b070439510a7ee283fb193151a06c0ff338a7 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 2 Jan 2023 18:41:45 -0600 Subject: [PATCH 19/35] Rename CVars to ~CVars to avoid namespace pollution. --- vars.asm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vars.asm b/vars.asm index 6332749..fbfe3bc 100644 --- a/vars.asm +++ b/vars.asm @@ -23,7 +23,7 @@ Dummy start (dummy root segment) * **************************************************************** * -CVars start +~CVars start errno entry library error number ds 2 From 35516443557f0bafc6f650f923716b705f7969bc Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Thu, 5 Jan 2023 20:00:44 -0600 Subject: [PATCH 20/35] Fix stack handling in localtime. This was broken by commit 882af9e0756e. --- time.asm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/time.asm b/time.asm index 54dda5f..8edcd44 100644 --- a/time.asm +++ b/time.asm @@ -524,7 +524,6 @@ t equ 6 pla sta 3,s - ph4 #gmlocaltime_tm push address of struct tm to use lda #-1 default DST setting = -1 (unknown) cpy lasttime determine DST setting, if we can bne lb1 @@ -533,6 +532,7 @@ t equ 6 lda lastDST lb1 plb + ph4 #gmlocaltime_tm push address of struct tm to use pha push tm_isdst value phx push time_t value to convert phy From 74de206058f21e59b9ae730ea11bd2942a0f1b5c Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 12 Feb 2023 18:57:56 -0600 Subject: [PATCH 21/35] 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. --- cc.asm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/cc.asm b/cc.asm index 89f3da5..5b9bf44 100644 --- a/cc.asm +++ b/cc.asm @@ -433,6 +433,24 @@ ret tya store return value in result space 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 From 60d49c7dc3426f5690fcc495e16bcc88ecfef49b Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Tue, 14 Feb 2023 18:43:40 -0600 Subject: [PATCH 22/35] 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. --- stdlib.asm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/stdlib.asm b/stdlib.asm index c790553..bcbe300 100644 --- a/stdlib.asm +++ b/stdlib.asm @@ -830,8 +830,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 @@ -844,7 +845,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 @@ -893,6 +894,7 @@ sw6 pld ; lsize entry ds 4 local copy of size +banks ds 2 number of whole banks to swap end **************************************************************** From 3417a98d1022b3abc4e6d85721282c3d4db8a246 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Tue, 14 Feb 2023 18:53:27 -0600 Subject: [PATCH 23/35] 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. --- stdlib.asm | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/stdlib.asm b/stdlib.asm index bcbe300..329c67b 100644 --- a/stdlib.asm +++ b/stdlib.asm @@ -700,13 +700,14 @@ ret stx n 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 @@ -717,12 +718,13 @@ qsort start lda compar+1 sta jsl1+2 sta jsl2+2 + plb + ph4 = *last -sr3 ph4 Date: Wed, 15 Feb 2023 22:04:10 -0600 Subject: [PATCH 24/35] 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). --- stdlib.asm | 26 ++++++++++++++++++-------- stdlib.macros | 12 ++++++++++++ 2 files changed, 30 insertions(+), 8 deletions(-) diff --git a/stdlib.asm b/stdlib.asm index 329c67b..20f63f5 100644 --- a/stdlib.asm +++ b/stdlib.asm @@ -767,10 +767,10 @@ 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 cmp first+2 bne sr1 lda last @@ -825,15 +825,24 @@ sr5 blt sr2 ph4 Date: Thu, 16 Feb 2023 18:44:47 -0600 Subject: [PATCH 25/35] 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 #include #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); } } --- stdlib.asm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/stdlib.asm b/stdlib.asm index 20f63f5..0c30719 100644 --- a/stdlib.asm +++ b/stdlib.asm @@ -771,15 +771,16 @@ sr0 phb phk plb 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 From b03e4621253ce98b939cbd371a902450b7a1be4c Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Fri, 17 Feb 2023 20:31:55 -0600 Subject: [PATCH 26/35] bsearch: return NULL without calling compare function if count==0. This is explicitly required in C99 and later. --- stdlib.asm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/stdlib.asm b/stdlib.asm index 0c30719..74baece 100644 --- a/stdlib.asm +++ b/stdlib.asm @@ -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 From 48371dc6693c798eced86734fcc202e68198a98f Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Wed, 8 Mar 2023 18:59:10 -0600 Subject: [PATCH 27/35] 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. --- stdio.asm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/stdio.asm b/stdio.asm index 8befdf1..5ad0ac9 100644 --- a/stdio.asm +++ b/stdio.asm @@ -3210,9 +3210,8 @@ pr dc i'2' parameter block for OSGet_Prefix dc i'3' dc a4'name' -name dc i'16,0' GS/OS name buffer +name dc i'17+4,0' GS/OS name buffer cname ds 26 part of name; also C buffer -GS_OSname dc i'8' used for OSGet_File_Info syscxxxx dc c'SYSC0000',i1'0' for creating unique names GIParm dc i'2' used to see if the file exists From a4ba2403fe4ff27679e77962e5a2a6ea96c07795 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Tue, 28 Mar 2023 18:52:14 -0500 Subject: [PATCH 28/35] 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. --- cc.asm | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/cc.asm b/cc.asm index 5b9bf44..d0301bc 100644 --- a/cc.asm +++ b/cc.asm @@ -522,10 +522,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 @@ -574,7 +571,6 @@ lb3 lda >stderr+6 while there is a next file lb4 pld return pla pla - plb rts end @@ -592,10 +588,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 @@ -632,7 +625,6 @@ lb2 ldy #2 dereference the pointer lb3 pld return pla pla - plb rts end From 3c1f357b0cf7df6c040ed75c9e3c8cf542535df9 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Tue, 28 Mar 2023 21:38:55 -0500 Subject: [PATCH 29/35] Save a few bytes in the startup code. --- cc.asm | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/cc.asm b/cc.asm index d0301bc..4155078 100644 --- a/cc.asm +++ b/cc.asm @@ -244,8 +244,6 @@ lb6 long M phy sec adc 1,S - ply - pha pha pea 0 pha @@ -265,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 From 68fc475721d8a69e70d9508a9b53c976583f6e26 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 2 Apr 2023 16:30:29 -0500 Subject: [PATCH 30/35] Implement fma(). This tries to carefully follow the C and IEEE standards regarding rounding, exceptions, etc. Like the other ORCA/C 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 --- math2.asm | 424 +++++++++++++++++++++++++++++++++++++++++++++++++++ math2.macros | 45 ++++++ 2 files changed, 469 insertions(+) diff --git a/math2.asm b/math2.asm index aec6b73..e850333 100644 --- a/math2.asm +++ b/math2.asm @@ -1147,6 +1147,430 @@ ret plx clean up stack rtl end +**************************************************************** +* +* double fma(double x, double y, double z); +* +* Compute (x * y) + z, rounded only once at the end. +* +**************************************************************** +* +fma start +fmaf entry +fmal entry + using MathCommon2 +mant1 equ 1 mantissa of value 1 +exp1 equ mant1+16 exponent of value 1 +sign1 equ exp1+4 sign of value 1 (high bit) +mant2 equ sign1+2 mantissa of value 2 +exp2 equ mant2+16 exponent of value 2 +sign2 equ exp2+4 sign of value 2 (low bit) +expdiff equ sign2+2 difference between exponents +extra equ expdiff+4 extra bits (guard, round, sticky) +xcps equ extra+2 floating-point exceptions + + csubroutine (10:x,10:y,10:z),54 + + stz extra + lda x if x or y is NAN, INF, or 0 then + ora x+2 + ora x+4 + ora x+6 + beq nanInf0 return (x * y) + z computed with SANE + lda x+8 + asl a + cmp #32767*2 + beq nanInf0 + + lda y + ora y+2 + ora y+4 + ora y+6 + beq nanInf0 + lda y+8 + asl a + cmp #32767*2 + beq nanInf0 + + lda z+8 else if z is INF or NAN then + asl a + cmp #32767*2 + beq x_plus_z return x + z computed with SANE + inc extra + lda z else if z is 0 then + ora z+2 + ora z+4 + ora z+6 return x * y computed with SANE + bne compute else compute fma(x,y,z) ourselves + +; +; Compute with SANE if any operands are NAN/INF/0 +; +nanInf0 tdc if in first or third case above then + clc + adc #y + pea 0 + pha + adc #x-y + pea 0 + pha + FMULX x = x * y + +x_plus_z ldy extra if in first or second case above then + bne return_x + + tdc + clc + adc #z + phy + pha + adc #x-z + phy + pha + FADDX x = x + z + +return_x lda x copy result to t1 + sta t1 + lda x+2 + sta t1+2 + lda x+4 + sta t1+4 + lda x+6 + sta t1+6 + lda x+8 + sta t1+8 + brl ret return result + +; +; Compute it ourselves if all operands are finite and non-zero +; +compute stz xcps no exceptions so far + lda x copy mantissa of x to mant1 + sta mant1 + lda x+2 + sta mant1+2 + lda x+4 + sta mant1+4 + lda x+6 + sta mant1+6 + stz mant1+8 + stz mant1+10 + stz mant1+12 + stz mant1+14 + + ldy #64 multiply mantissas (64 x 64 to 128-bit) +ml1 lda mant1 + lsr a + bcc ml2 + clc add multiplicand to partial product + lda mant1+8 + adc y + sta mant1+8 + lda mant1+10 + adc y+2 + sta mant1+10 + lda mant1+12 + adc y+4 + sta mant1+12 + lda mant1+14 + adc y+6 + sta mant1+14 +ml2 ror mant1+14 shift the interim result + ror mant1+12 + ror mant1+10 + ror mant1+8 + ror mant1+6 + ror mant1+4 + ror mant1+2 + ror mant1 + dey loop until done + bne ml1 + + lda x+8 calculate exponent + asl a + sta exp1 + lda y+8 + asl a + clc + adc exp1 + ror a + sta exp1 + stz exp1+2 + add4 exp1,#-16383+1 + + lda mant1+14 normalize calculated value + bmi getsign1 +norm1_lp dec4 exp1 + asl mant1 + rol mant1+2 + rol mant1+4 + rol mant1+6 + rol mant1+8 + rol mant1+10 + rol mant1+12 + rol mant1+14 + bpl norm1_lp + +getsign1 lda x+8 get sign of x*y + eor y+8 + sta sign1 + + lda z+8 get sign of z + sta sign2 + + and #$7fff copy exponent of z to exp2 + sta exp2 + stz exp2+2 + + stz mant2 copy mantissa of z to mant2 + stz mant2+2 + stz mant2+4 + stz mant2+6 + lda z + sta mant2+8 + lda z+2 + sta mant2+10 + lda z+4 + sta mant2+12 + lda z+6 + sta mant2+14 + + bmi exp_cmp normalize z value +norm2_lp dec4 exp2 + asl mant2+8 (low mantissa bits stay 0) + rol mant2+10 + rol mant2+12 + rol mant2+14 + bpl norm2_lp + +exp_cmp cmp4 exp1,exp2 if exp1 < exp2 + bge do_align + jsr exchange exchange value 1 and value 2 + +; at this point, exp1 >= exp2 +do_align stz extra initially extra bits are 0 + sub4 exp1,exp2,expdiff expdiff = exp1 - exp2 + cmpl expdiff,#65+1 if expdiff > 65 then + blt aligntst + stz mant2 zero out mant2 + stz mant2+2 + stz mant2+4 + stz mant2+6 + stz mant2+8 + stz mant2+10 + stz mant2+12 + stz mant2+14 + inc extra but set the sticky bit for rounding + bra addorsub else + +align_lp dec4 expdiff + lsr mant2+14 shift mant2 until it is aligned + ror mant2+12 + ror mant2+10 + ror mant2+8 + ror mant2+6 + ror mant2+4 + ror mant2+2 + ror mant2 + ror extra + bcc aligntst maintain sticky bit + lda #$0001 + tsb extra +aligntst lda expdiff + ora expdiff+2 + bne align_lp + +addorsub lda sign1 if signs of x*y and z are the same then + eor sign2 + bmi subtract + + clc mant1 = mant1 + mant2 + ldx #-16 +addLoop lda mant1+16,x + adc mant2+16,x + sta mant1+16,x + inx + inx + bmi addLoop + bcc add_done if there is carry out + ror mant1+14 rotate carry back into result + ror mant1+12 + ror mant1+10 + ror mant1+8 + ror mant1+6 + ror mant1+4 + ror mant1+2 + ror mant1 + ror extra + bcc inc_exp maintain sticky bit + lda #$0001 + tsb extra +inc_exp inc4 exp1 increment exponent +add_done bra xtrabits else + +subtract ldx #14 if mant1 < mant2 then +subCmpLp lda mant1,x (note: only occurs if mant2 was + cmp mant2,x not shifted, so extra is 0) + bne sub_cmp + dex + dex + bpl subCmpLp +sub_cmp bge do_sub + jsr exchange exchange mant2 and mant1 + +do_sub sec mant1 = mant1 - mant2 (including extra) + lda #0 + sbc extra + sta extra + ldx #-16 +subLoop lda mant1+16,x + sbc mant2+16,x + sta mant1+16,x + inx + inx + bmi subLoop + ora mant1 if result (including extra bits) is 0 then + ora mant1+2 + ora mant1+4 + ora mant1+6 + ora mant1+8 + ora mant1+10 + ora mant1+12 + ora extra + bne subalign + stz exp1 set exponent to 0 + stz sign1 set sign to + + FGETENV if rounding direction is downward then + txa + bpl savezero + asl a + bmi savezero + dec sign1 set sign to - +savezero brl do_save skip to return +subalign lda mant1+14 + bmi xtrabits normalize after subtraction, if needed +subAl_lp dec4 exp1 + asl extra + rol mant1 + rol mant1+2 + rol mant1+4 + rol mant1+6 + rol mant1+8 + rol mant1+10 + rol mant1+12 + rol mant1+14 +subAlNeg bpl subAl_lp + +xtrabits lda mant1 consolidate extra bits (into mant1+6) + ora mant1+2 + ora mant1+4 + ora extra + beq denorm + lda #$0001 + tsb mant1+6 + +denorm lda #INEXACT assume INEXACT is just INEXACT + bra denormCk while exponent is too small +denormLp inc4 exp1 increment exponent + lsr mant1+14 shift mantissa right + ror mant1+12 + ror mant1+10 + ror mant1+8 + ror mant1+6 + bcc denorm2 maintain sticky bit + lda #$0001 + tsb mant1+6 +denorm2 lda #UNDERFLOW+INEXACT flag that INEXACT also implies UNDERFLOW +denormCk ldy exp1+2 + bmi denormLp + + ldy mant1+6 if there are extra bits then + beq saveval + tsb xcps set inexact (+ maybe underflow) exception + FGETENV get rounding direction + txa + asl a + bcs roundDn0 + bmi roundUp if rounding to nearest then + lda mant1+6 if first extra bit is 0 + bpl saveval do not round + asl a else if remaining extra bits are non-zero + bne do_round + lda mant1+8 or low-order bit of result is 1 then + lsr a + bcc saveval + bra do_round apply rounding + +roundUp lda sign1 if rounding upward then + bmi saveval if positive then + bra do_round apply rounding + +roundDn0 bmi saveval if rounding downward then + lda sign1 if negative then + bpl saveval apply rounding + +do_round inc mant1+8 (perform the rounding, if needed) + bne saveval + inc mant1+10 + bne saveval + inc mant1+12 + bne saveval + inc mant1+14 + bne saveval + sec + ror mant1+14 + ror mant1+12 + ror mant1+10 + ror mant1+8 + inc4 exp1 + +saveval lda exp1+2 if value is too large to represent then + bne save_inf + lda exp1 + cmp #32766+1 + blt do_save +save_inf lda #32767 set it to infinity + sta exp1 + stz mant1+8 + stz mant1+10 + stz mant1+12 + stz mant1+14 + lda #OVERFLOW+INEXACT set overflow and inexact exceptions + tsb xcps +do_save lda mant1+8 generate result + sta t1 + lda mant1+10 + sta t1+2 + lda mant1+12 + sta t1+4 + lda mant1+14 + sta t1+6 + lda exp1 + asl a + asl sign1 + ror a + sta t1+8 + + lda xcps if there were exceptions then + beq ret + pha set them in SANE environment + FSETXCP + +ret creturn 10:t1 return t1 + +; local subroutine - exchange value 1 and value 2 +; Note: requires mant1/exp1/sign1 and mant2/exp2/sign2 to be in order +exchange ldx #16+4+2-2 +xchgLp lda mant1,x + ldy mant2,x + sta mant2,x + sty mant1,x + dex + dex + bpl xchgLp + rts + end + **************************************************************** * * double fmax(double x, double y); diff --git a/math2.macros b/math2.macros index f03ec39..7c3e1d9 100644 --- a/math2.macros +++ b/math2.macros @@ -703,3 +703,48 @@ LDX #$090A JSL $E10000 MEND + macro +&l dec4 &a +&l ~setm + lda &a + bne ~&SYSCNT + dec 2+&a +~&SYSCNT dec &a + ~restm + mend + macro +&l add4 &m1,&m2,&m3 + lclb &yistwo + lclc &c +&l ~setm + aif c:&m3,.a +&c amid "&m2",1,1 + aif "&c"<>"#",.a +&c amid "&m1",1,1 + aif "&c"="{",.a + aif "&c"="[",.a +&c amid "&m2",2,l:&m2-1 + aif &c>=65536,.a + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m1 + bcc ~&SYSCNT + ~op.h inc,&m1 +~&SYSCNT anop + ago .c +.a + aif c:&m3,.b + lclc &m3 +&m3 setc &m1 +.b + clc + ~lda &m1 + ~op adc,&m2 + ~sta &m3 + ~lda.h &m1 + ~op.h adc,&m2 + ~sta.h &m3 +.c + ~restm + mend From de978dab485bcebce0e5996a59fa5adc9ddcc142 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 2 Apr 2023 16:33:24 -0500 Subject: [PATCH 31/35] Use more efficient code to return values from various math functions. --- fenv.asm | 24 ++++++------------ math2.asm | 74 +++++++++++-------------------------------------------- 2 files changed, 22 insertions(+), 76 deletions(-) diff --git a/fenv.asm b/fenv.asm index f240a25..843f063 100644 --- a/fenv.asm +++ b/fenv.asm @@ -47,8 +47,7 @@ feclearexcept start sta 1,S FSETENV clear them - stz excepts - creturn 2:excepts + creturn 2:#0 end **************************************************************** @@ -76,8 +75,7 @@ fegetexceptflag start and #FE_ALL_EXCEPT sta [flagp] store them in *flagp - stz excepts - creturn 2:excepts + creturn 2:#0 end **************************************************************** @@ -104,8 +102,7 @@ feraiseexcept start pha FSETXCP raise exceptions -done stz excepts - creturn 2:excepts +done creturn 2:#0 end **************************************************************** @@ -144,8 +141,7 @@ fesetexceptflag start sta 1,S FSETENV - stz excepts - creturn 2:excepts + creturn 2:#0 end **************************************************************** @@ -250,8 +246,7 @@ fegetenv start txa sta [envp] store it in *envp - stz envp - creturn 2:envp + creturn 2:#0 end **************************************************************** @@ -280,8 +275,7 @@ feholdexcept start pha FSETENV set the new environment - stz envp - creturn 2:envp + creturn 2:#0 end **************************************************************** @@ -306,8 +300,7 @@ fesetenv start pha FSETENV - stz envp - creturn 2:envp + creturn 2:#0 end **************************************************************** @@ -332,8 +325,7 @@ feupdateenv start pha FPROCEXIT - stz envp - creturn 2:envp + creturn 2:#0 end **************************************************************** diff --git a/math2.asm b/math2.asm index e850333..62a5c1a 100644 --- a/math2.asm +++ b/math2.asm @@ -317,11 +317,7 @@ acoshl entry ret FPROCEXIT restore env & raise any new exceptions plb - lda #t1 return t1 - sta x - lda #^t1 - sta x+2 - creturn 4:x + creturn 10:t1 return t1 y ds 10 temporary variable one dc i'1' constants @@ -442,11 +438,7 @@ setsign asl z+8 sign of z = original sign of x FPROCEXIT restore env & raise any new exceptions plb - lda #z return z - sta x - lda #^z - sta x+2 - creturn 4:x + creturn 10:z return z y ds 10 temporary variables z ds 10 @@ -546,11 +538,7 @@ setsign asl t1+8 sign of t1 = original sign of x FPROCEXIT restore env & raise any new exceptions plb - lda #t1 return t1 - sta x - lda #^t1 - sta x+2 - creturn 4:x + creturn 10:t1 return t1 one dc i'1' constants minustwo dc i'-2' @@ -646,11 +634,7 @@ do_calc sta t1+8 ror t1+8 plb - lda #t1 return t1 - sta x - lda #^t1 - sta x+2 - creturn 4:x + creturn 10:t1 return t1 onethird dc e'0.33333333333333333333' end @@ -1865,12 +1849,8 @@ naninf anop (we skip to here if x or y is nan/inf) FSCALBX done FPROCEXIT restore env - lda #^t1 return t1 - sta x+2 - lda #t1 - sta x plb - creturn 4:x + creturn 10:t1 return t1 end **************************************************************** @@ -2474,12 +2454,8 @@ copysign asl t1+8 copy sign of x to t1 asl x+8 ror t1+8 - lda #^t1 return t1 (fractional part) - sta iptr+2 - lda #t1 - sta iptr plb - creturn 4:iptr + creturn 10:t1 return t1 (fractional part) end **************************************************************** @@ -2552,12 +2528,8 @@ copysign asl t1+8 copy sign of x to t1 asl x+8 ror t1+8 -ret lda #^t1 return t1 (fractional part) - sta iptr+2 - lda #t1 - sta iptr - plb - creturn 4:iptr +ret plb + creturn 10:t1 return t1 (fractional part) end **************************************************************** @@ -2615,13 +2587,9 @@ codeok ora #$4000 set high bit of f for quiet NaN stz t1+4 set rest of fraction field to 0 stz t1+2 stz t1 - - lda #^t1 return a pointer to the result - sta tagp+2 - lda #t1 - sta tagp + plb - creturn 4:tagp + creturn 10:t1 return a pointer to the result end **************************************************************** @@ -3389,12 +3357,7 @@ roundl entry ret FPROCEXIT restore env & raise any new exceptions plb - - lda #^t1 return a pointer to the result - sta x+2 - lda #t1 - sta x - creturn 4:x + creturn 10:t1 return a pointer to the result onehalf dc f'0.5' end @@ -3466,12 +3429,8 @@ do_scalb ph4 #t1 scale the number bne done stop: more scaling would not change it brl loop else scale by remaining amount -done lda #^t1 return a pointer to the result - sta n+2 - lda #t1 - sta n - plb - creturn 4:n +done plb + creturn 10:t1 return a pointer to the result end **************************************************************** @@ -3740,12 +3699,7 @@ lb2 ph4 #z z := pi / (fracpart * z) done FPROCEXIT restore env & raise any new exceptions plb - - lda #^z return a pointer to the result - sta x+2 - lda #z - sta x - creturn 4:x + creturn 10:z return a pointer to the result cutoff dc f'10.375' cutoff for Stirling approximation (+1) From fca8c1ef855220a7cb3f78c8aa5f90dd6e14c7fa Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 3 Apr 2023 13:26:37 -0500 Subject: [PATCH 32/35] Save a few bytes in printf and scanf. --- stdio.asm | 110 +++++++++++++++++++++++++++--------------------------- 1 file changed, 55 insertions(+), 55 deletions(-) diff --git a/stdio.asm b/stdio.asm index 5ad0ac9..1b2917f 100644 --- a/stdio.asm +++ b/stdio.asm @@ -4916,20 +4916,20 @@ fm4 cmp #'L' else if *format in ['L','h'] then inc ~isByte fm5 inc4 format ++format lda [format] find the proper format character - and #$00FF fm6 inc4 format - ldx #fListEnd-fList-4 + short M,I + ldx #fListEnd-fList-3 fm7 cmp fList,X beq fm8 dex dex dex - dex bpl fm7 + long M,I brl ps1 none found - continue -fm8 pea ps1-1 push the return address +fm8 long M,I + pea ps1-1 push the return address inx call the subroutine - inx jmp (fList,X) ; ; Flag - Read and process a flag character @@ -5020,27 +5020,27 @@ val ds 2 value ; ; List of format specifiers and the equivalent subroutines ; -fList dc c'%',i1'0',a'~Format_Percent' % - dc c'a',i1'0',a'~Format_e' a (not formatted correctly) - dc c'A',i1'0',a'~Format_E' A (not formatted correctly) - dc c'f',i1'0',a'~Format_f' f - dc c'F',i1'0',a'~Format_f' F - dc c'e',i1'0',a'~Format_e' e - dc c'E',i1'0',a'~Format_E' E - dc c'g',i1'0',a'~Format_g' g - dc c'G',i1'0',a'~Format_G' G - dc c'n',i1'0',a'~Format_n' n - dc c's',i1'0',a'~Format_s' s - dc c'b',i1'0',a'~Format_b' b - dc c'P',i1'0',a'~Format_P' P - dc c'p',i1'0',a'~Format_p' p - dc c'c',i1'0',a'~Format_c' c - dc c'X',i1'0',a'~Format_X' X - dc c'x',i1'0',a'~Format_x' x - dc c'o',i1'0',a'~Format_o' o - dc c'u',i1'0',a'~Format_u' u - dc c'd',i1'0',a'~Format_d' d - dc c'i',i1'0',a'~Format_d' i +fList dc c'%',a'~Format_Percent' % + dc c'a',a'~Format_e' a (not formatted correctly) + dc c'A',a'~Format_E' A (not formatted correctly) + dc c'f',a'~Format_f' f + dc c'F',a'~Format_f' F + dc c'e',a'~Format_e' e + dc c'E',a'~Format_E' E + dc c'g',a'~Format_g' g + dc c'G',a'~Format_G' G + dc c'n',a'~Format_n' n + dc c's',a'~Format_s' s + dc c'b',a'~Format_b' b + dc c'P',a'~Format_P' P + dc c'p',a'~Format_p' p + dc c'c',a'~Format_c' c + dc c'X',a'~Format_X' X + dc c'x',a'~Format_x' x + dc c'o',a'~Format_o' o + dc c'u',a'~Format_u' u + dc c'd',a'~Format_d' d + dc c'i',a'~Format_d' i fListEnd anop end @@ -6124,7 +6124,7 @@ fm2b inc ~size fm2c inc ~size bra fm4 fm3 cmp #'h' 'h' specifies short int - bne fm5 + bne fm6 inc4 format unless it is 'hh' for char types lda [format] and #$00FF @@ -6133,21 +6133,21 @@ fm3 cmp #'h' 'h' specifies short int dec ~size fm4 inc4 format ignore the character -fm5 lda [format] find the proper format character - and #$00FF + lda [format] find the proper format character fm6 inc4 format - ldx #fListEnd-fList-4 + short M,I + ldx #fListEnd-fList-3 fm7 cmp fList,X beq fm8 dex dex dex - dex bpl fm7 + long M,I brl ps1 none found - continue -fm8 pea ps1-1 push the return address +fm8 long M,I + pea ps1-1 push the return address inx call the subroutine - inx jmp (fList,X) ; ; GetSize - get a numeric value @@ -6189,28 +6189,28 @@ val ds 2 value ; ; List of format specifiers and the equivalent subroutines ; -fList dc c'd',i1'0',a'~Scan_d' d - dc c'i',i1'0',a'~Scan_i' i - dc c'u',i1'0',a'~Scan_u' u - dc c'o',i1'0',a'~Scan_o' o - dc c'x',i1'0',a'~Scan_x' x - dc c'X',i1'0',a'~Scan_x' X - dc c'p',i1'0',a'~Scan_p' p - dc c'c',i1'0',a'~Scan_c' c - dc c's',i1'0',a'~Scan_s' s - dc c'b',i1'0',a'~Scan_b' b - dc c'P',i1'0',a'~Scan_P' P - dc c'n',i1'0',a'~Scan_n' n - dc c'a',i1'0',a'~Scan_f' a - dc c'A',i1'0',a'~Scan_f' A - dc c'f',i1'0',a'~Scan_f' f - dc c'F',i1'0',a'~Scan_f' F - dc c'e',i1'0',a'~Scan_f' e - dc c'E',i1'0',a'~Scan_f' E - dc c'g',i1'0',a'~Scan_f' g - dc c'G',i1'0',a'~Scan_f' G - dc c'%',i1'0',a'~Scan_percent' % - dc c'[',i1'0',a'~Scan_lbrack' [ +fList dc c'd',a'~Scan_d' d + dc c'i',a'~Scan_i' i + dc c'u',a'~Scan_u' u + dc c'o',a'~Scan_o' o + dc c'x',a'~Scan_x' x + dc c'X',a'~Scan_x' X + dc c'p',a'~Scan_p' p + dc c'c',a'~Scan_c' c + dc c's',a'~Scan_s' s + dc c'b',a'~Scan_b' b + dc c'P',a'~Scan_P' P + dc c'n',a'~Scan_n' n + dc c'a',a'~Scan_f' a + dc c'A',a'~Scan_f' A + dc c'f',a'~Scan_f' f + dc c'F',a'~Scan_f' F + dc c'e',a'~Scan_f' e + dc c'E',a'~Scan_f' E + dc c'g',a'~Scan_f' g + dc c'G',a'~Scan_f' G + dc c'%',a'~Scan_percent' % + dc c'[',a'~Scan_lbrack' [ fListEnd anop ; ; Other local data From cd6131abab3aed0438863486250880633749a2ea Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Mon, 3 Apr 2023 20:16:22 -0500 Subject: [PATCH 33/35] Small optimization of strto* functions. --- stdlib.asm | 44 ++++++++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/stdlib.asm b/stdlib.asm index 74baece..6499423 100644 --- a/stdlib.asm +++ b/stdlib.asm @@ -999,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 @@ -1126,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 @@ -1317,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 @@ -1466,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 From 2f2d3d205675c1669cc4d11bc87b6502d8fd9609 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Tue, 4 Apr 2023 18:06:21 -0500 Subject: [PATCH 34/35] Save a few bytes in floating-to-long long conversion code. --- int64.asm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/int64.asm b/int64.asm index 926a7d1..297c85b 100644 --- a/int64.asm +++ b/int64.asm @@ -691,16 +691,17 @@ convert lda 4+8,s pla if original value was negative bpl done sec - lda #0 negate result + ldx #0 negate result + txa sbc 6,s sta 6,s - lda #0 + txa sbc 6+2,s sta 6+2,s - lda #0 + txa sbc 6+4,s sta 6+4,s - lda #0 + txa sbc 6+6,s sta 6+6,s From bdfed3628dbc643bea7fe35d37cb76f7330e9465 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Thu, 6 Apr 2023 14:34:40 -0500 Subject: [PATCH 35/35] Fix fma to support large memory model. It was not using long addressing where needed, so it could store results in the wrong bank. --- math2.asm | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/math2.asm b/math2.asm index 62a5c1a..4bebb88 100644 --- a/math2.asm +++ b/math2.asm @@ -1214,15 +1214,15 @@ x_plus_z ldy extra if in first or second case above then FADDX x = x + z return_x lda x copy result to t1 - sta t1 + sta >t1 lda x+2 - sta t1+2 + sta >t1+2 lda x+4 - sta t1+4 + sta >t1+4 lda x+6 - sta t1+6 + sta >t1+6 lda x+8 - sta t1+8 + sta >t1+8 brl ret return result ; @@ -1522,18 +1522,18 @@ save_inf lda #32767 set it to infinity lda #OVERFLOW+INEXACT set overflow and inexact exceptions tsb xcps do_save lda mant1+8 generate result - sta t1 + sta >t1 lda mant1+10 - sta t1+2 + sta >t1+2 lda mant1+12 - sta t1+4 + sta >t1+4 lda mant1+14 - sta t1+6 + sta >t1+6 lda exp1 asl a asl sign1 ror a - sta t1+8 + sta >t1+8 lda xcps if there were exceptions then beq ret