diff --git a/assert.asm b/assert.asm index b04cc9b..c07582f 100644 --- a/assert.asm +++ b/assert.asm @@ -22,11 +22,12 @@ Assert start dummy routine **************************************************************** * -* void __assert (char *f, int l) +* void __assert (char *f, unsigned l, char *s) * * Inputs: * f - pointer to the file name * l - line number +* s - assertion string * **************************************************************** * @@ -44,5 +45,35 @@ __assert start creturn -msg dc c'Assertion failed: file %s, line %d; assertion: %s',i1'10,0' +msg dc c'Assertion failed: file %s, line %u; assertion: %s',i1'10,0' + end + +**************************************************************** +* +* void __assert2 (char *f, unsigned l, char *fn, char *s) +* +* Inputs: +* f - pointer to the file name +* l - line number +* fn - function name +* s - assertion string +* +**************************************************************** +* +__assert2 start + + csubroutine (4:f,2:l,4:fn,4:s),0 + + ph4 stderr + jsl fprintf + jsl abort + + creturn + +msg dc c'Assertion failed: file %s, line %u, function %s; assertion: %s',i1'10,0' end diff --git a/fenv.asm b/fenv.asm new file mode 100644 index 0000000..f240a25 --- /dev/null +++ b/fenv.asm @@ -0,0 +1,369 @@ + 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 diff --git a/fenv.macros b/fenv.macros new file mode 100644 index 0000000..aa38744 --- /dev/null +++ b/fenv.macros @@ -0,0 +1,117 @@ + MACRO +&lab csubroutine &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta 1 +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+4+&work +&totallen seta &totallen+&len +&i seta &i+1 + aif &i<=c:&parms,^b +.e + tsc + aif &work=0,.f + sec + sbc #&work + tcs +.f + phd + tcd + mend + MACRO +&lab creturn &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + ldy #&r + ldx #^&r + ago .h +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+2 + sta &worklen+&totallen+2 + lda &worklen+1 + sta &worklen+&totallen+1 +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rtl + mend + MACRO +&LAB FGETENV +&LAB PEA $03 + LDX #$090A + JSL $E10000 + MEND + MACRO +&LAB FSETENV +&LAB PEA $01 + LDX #$090A + JSL $E10000 + MEND + MACRO +&LAB FSETXCP +&LAB PEA $15 + LDX #$090A + JSL $E10000 + MEND + MACRO +&LAB FPROCEXIT +&LAB PEA $19 + LDX #$090A + JSL $E10000 + MEND diff --git a/fpextra.asm b/fpextra.asm new file mode 100644 index 0000000..ac9f035 --- /dev/null +++ b/fpextra.asm @@ -0,0 +1,97 @@ + 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 + diff --git a/fpextra.macros b/fpextra.macros new file mode 100644 index 0000000..ddba238 --- /dev/null +++ b/fpextra.macros @@ -0,0 +1,36 @@ + 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 diff --git a/make b/make index 1676424..ebb32f1 100644 --- a/make +++ b/make @@ -19,7 +19,7 @@ if {#} == 0 unset exit end - for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal int64 + for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal int64 fenv fpextra math2 Newer obj/{i}.a {i}.asm if {Status} != 0 set exit on @@ -40,6 +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 for i in {list} echo makelib orcalib +obj/{i} makelib orcalib +obj/{i} diff --git a/math2.asm b/math2.asm new file mode 100644 index 0000000..3f353b3 --- /dev/null +++ b/math2.asm @@ -0,0 +1,155 @@ + keep obj/math2 + mcopy math2.macros + case on + +**************************************************************** +* +* Math2 - additional math routines +* +* This code provides additional functions from +* (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 diff --git a/math2.macros b/math2.macros new file mode 100644 index 0000000..ba5bd1a --- /dev/null +++ b/math2.macros @@ -0,0 +1,123 @@ + MACRO +&lab csubroutine &parms,&work +&lab anop + aif c:&work,.a + lclc &work +&work setc 0 +.a + gbla &totallen + gbla &worklen +&worklen seta &work +&totallen seta 0 + aif c:&parms=0,.e + lclc &len + lclc &p + lcla &i +&i seta 1 +.b +&p setc &parms(&i) +&len amid &p,2,1 + aif "&len"=":",.c +&len amid &p,1,2 +&p amid &p,4,l:&p-3 + ago .d +.c +&len amid &p,1,1 +&p amid &p,3,l:&p-2 +.d +&p equ &totallen+4+&work +&totallen seta &totallen+&len +&i seta &i+1 + aif &i<=c:&parms,^b +.e + tsc + aif &work=0,.f + sec + sbc #&work + tcs +.f + phd + tcd + mend + MACRO +&lab creturn &r +&lab anop + lclc &len + aif c:&r,.a + lclc &r +&r setc 0 +&len setc 0 + ago .h +.a +&len amid &r,2,1 + aif "&len"=":",.b +&len amid &r,1,2 +&r amid &r,4,l:&r-3 + ago .c +.b +&len amid &r,1,1 +&r amid &r,3,l:&r-2 +.c + aif &len<>2,.d + ldy &r + ago .h +.d + aif &len<>4,.e + ldx &r+2 + ldy &r + ago .h +.e + aif &len<>10,.g + ldy #&r + ldx #^&r + ago .h +.g + mnote 'Not a valid return length',16 + mexit +.h + aif &totallen=0,.i + lda &worklen+2 + sta &worklen+&totallen+2 + lda &worklen+1 + sta &worklen+&totallen+1 +.i + pld + tsc + clc + adc #&worklen+&totallen + tcs + aif &len=0,.j + tya +.j + rtl + mend + MACRO +&LAB 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 diff --git a/stdlib.asm b/stdlib.asm index 05847e5..8b3a183 100644 --- a/stdlib.asm +++ b/stdlib.asm @@ -4,10 +4,10 @@ **************************************************************** * -* StdDef - Standard Definitions +* StdLib - Standard Library Utility Functions * * This code implements the tables and subroutines needed to -* support the standard C library STDDEF. +* support the standard C library STDLIB. * * December 1988 * Mike Westerfield @@ -19,7 +19,7 @@ * **************************************************************** * -StdDef start dummy segment +StdLib start dummy segment copy equates.asm end @@ -1593,14 +1593,14 @@ system start sta exComm+2 lb1 phy execute the command phx - plb Execute ex ldy empty bne ret if doing system(NULL) tya bcs ret error => no command processor inc a (& vice versa) -ret rtl +ret plb + rtl ex dc i'$8000' exComm ds 4 diff --git a/string.asm b/string.asm index 283c57e..7bfd5fe 100644 --- a/string.asm +++ b/string.asm @@ -482,21 +482,19 @@ rtl equ 1 return address ph4 p save the pointer + short M lda val form a 2 byte value - xba - ora val - sta val + sta val+1 lda len if there are an odd # of bytes then lsr A bcc lb1 - short M set 1 byte now - lda val + lda val set 1 byte now sta [p] long M dec len inc4 p -lb1 anop endif +lb1 long M endif lda val set len bytes ldx len+2 set full banks diff --git a/time.asm b/time.asm index 4af8d83..b2b0a8b 100644 --- a/time.asm +++ b/time.asm @@ -46,6 +46,30 @@ lasttime ds 4 last time_t value returned by time() lastDST dc i2'-1' tm_isdst value for lasttime end +**************************************************************** +* +* clock_t __clocks_per_sec() +* +* Outputs: +* X-A - the number of clock ticks per second (50 or 60) +* +**************************************************************** +* +__clocks_per_sec start +LANGSEL equ $E1C02B LANGSEL soft switch + + short I,M + ldy #60 + ldx #0 + lda >LANGSEL + and #$10 test NTSC/PAL bit of LANGSEL + beq lb1 + ldy #50 +lb1 long I,M + tya + rtl + end + **************************************************************** * * char *asctime(struct tm *ts) diff --git a/time.macros b/time.macros index 01fb94f..c50a85f 100644 --- a/time.macros +++ b/time.macros @@ -560,3 +560,43 @@ &lab ldx #$0C03 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