commit 954c3a02b58c9c5ceacbda53f14e9e76c9002d29 Author: mikew50 Date: Sun Oct 1 18:00:58 2017 -0600 ORCA libraries, from the Opus ][ CD diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..9e2c000 --- /dev/null +++ b/LICENSE @@ -0,0 +1,11 @@ +ORCALib is released by the copyright holder under the terms of the original copyright. + +The Byte Works, Inc. grants you the right to use this source code privately, fork it, and change it. + +You may not redistribute the code in any form other than submission to this repository without the written permission of the copyright holder. + +The copyright holder decided to do things this way for two reasons: + +1. Reserve commercial distribution rights. + +2. Ensure that any contributions and updates are available from a centralized source (this GitHib repository, for now). diff --git a/README.md b/README.md new file mode 100644 index 0000000..9cdf868 --- /dev/null +++ b/README.md @@ -0,0 +1,14 @@ +# ORCALib +Libraries for the ORCA language suite (ORCA/C, ORCA/M, ORCA/Pascal) for the Apple IIGS + +If you would like to make changes to this compiler and distribute them to others, feel free to submit them here. If the changes apply to the Apple IIGS, they will generally be approved for distribution on the master branch. For changes that retarget the library to generate code for a different platform, the project will either be forked or a new repository will be created, as appropriate. + +The general conditions that must be met before a change is released on master are: + +1. The modified library must compile under the currently released version of ORCA/M. + +2. The various languages that make use of the library mush still pass their respective test suites, or changes to those test suites must also be submitted. + +Contact support@byteworks.us if you need contributor access. + +A complete distribution of the ORCA languages, including installers and documentation, is available from the Juiced GS store at https://juiced.gs/store/category/software/. It is distributed as part of the Opus ][ package. diff --git a/assert.asm b/assert.asm new file mode 100755 index 0000000..2cb7a2b --- /dev/null +++ b/assert.asm @@ -0,0 +1 @@ + keep obj/assert mcopy assert.macros case on **************************************************************** * * Assert - Condition assertion macro * * This code implements the subroutines needed to support the * standard C library assert. * * October 1991 * Mike Westerfield * * Copyright 1991 * Byte Works, Inc. * **************************************************************** * Assert start dummy routine end **************************************************************** * * void __assert (char *f, int l) * * Inputs: * f - pointer to the file name * l - line number * **************************************************************** * __assert start csubroutine (4:f,2:l,4:s),0 ph4 s ph2 l ph4 f ph4 #msg ph4 >stderr jsl fprintf jsl abort creturn msg dc c'Assertion failed: file %s, line %d; assertion: %s',i1'10,0' end \ No newline at end of file diff --git a/assert.macros b/assert.macros new file mode 100755 index 0000000..a8fbc28 --- /dev/null +++ b/assert.macros @@ -0,0 +1 @@ + MACRO &LAB PH2 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &lab 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 \ No newline at end of file diff --git a/backup b/backup new file mode 100755 index 0000000..4153669 --- /dev/null +++ b/backup @@ -0,0 +1 @@ +if "{#}" != "1" echo Form: backup [day] exit 65535 end set dest /library/mike/{1}/ORCALib set list make backup smac equates.asm set list {list} assert.asm assert.macros set list {list} cc.asm cc.macros set list {list} ctype.asm set list {list} fcntl.asm fcntl.macros set list {list} orca.asm orca.macros set list {list} setjmp.asm set list {list} signal.asm signal.macros set list {list} ctype.asm set list {list} stdio.asm stdio.macros set list {list} stdlib.asm stdlib.macros set list {list} string.asm string.macros set list {list} time.asm time.macros set list {list} toolglue.asm toolglue.macros set list {list} vars.asm vars.macros unset exit create {dest} >.null >&.null for i in {list} newer {dest}/{i} {i} if {Status} != 0 copy -c {i} {dest}/{i} end end \ No newline at end of file diff --git a/cc.asm b/cc.asm new file mode 100755 index 0000000..cb860e2 --- /dev/null +++ b/cc.asm @@ -0,0 +1 @@ + keep obj/cc mcopy cc.macros **************************************************************** * * CC - C Specific Run Time Libraries * * October 1988 * Mike Westerfield * * Copyright 1988 * Byte Works, Inc. * **************************************************************** * CC start dummy routine end **************************************************************** * * ~CopyBF - Copy a bit field * ~SaveBF - Save a bit field * * Inputs: * addr - address to copy to * bitDisp - displacement past the address * bitNum - number of bits * val - value to copy * **************************************************************** * ~CopyBF start ret equ 2 return address val equ 5 value to copy bitNum equ 9 number of bits bitDisp equ 11 displacement past the address addr equ 13 address to copy to lda #0 set the call type bra lb1 ~SaveBF entry lda #1 lb1 phb phk plb sta isSave tsc set up the stack frame phd tcd move4 val,lval save the value (for copybf only) stz mask+2 set up the and mask ldx bitNum lda #0 lb2 sec rol A rol mask+2 dex bne lb2 sta mask and val and out extra bits in the mask sta val lda mask+2 and val+2 sta val+2 ldx bitDisp shift the mask and value beq lb4 lda mask lb3 asl A rol mask+2 asl val rol val+2 dex bne lb3 sta mask lb4 ldy #2 place the bits in memory lda mask eor #$FFFF and [addr] ora val sta [addr] lda mask+2 eor #$FFFF and [addr],Y ora val+2 sta [addr],Y lda isSave branch based on call type beq lb5 lda ret+1 return from save sta addr+2 lda ret sta addr+1 pld plb tsc clc adc #12 tcs rtl lb5 move4 lval,addr place the value back on the stack lda ret+1 return from copy sta bitDisp lda ret sta bitDisp-1 pld plb tsc clc adc #8 tcs rtl ; ; local data ; mask ds 4 bit mask isSave ds 2 is the call a save? (or copy?) lval ds 4 temp storage for val end **************************************************************** * * ~C_ShutDown - do shut down peculiar to the C language * * Inputs: * A - shell return code * **************************************************************** * ~C_ShutDown start pha save the return code jsr ~Exit do exit processing pla quit jml ~Quit end **************************************************************** * * ~C_ShutDown2 - do shut down peculiar to the C language * * Inputs: * A - shell return code * **************************************************************** * ~C_ShutDown2 start pha save the return code jsr ~Exit do exit processing pla quit jml ~RTL end **************************************************************** * * ~C_StartUp - do startup peculiar to the C language * **************************************************************** * ~C_StartUp start argv equ 11 argument vector argc equ 9 argument count cLine equ 1 command line address TAB equ 9 TAB key code phb remove our return address phk plb plx ply pea 0 make room for argc, argv pea 0 pea 0 phy put the return addr back on the stack phx ph4 ~CommandLine create some work space tsc set up our stack frame phd tcd stz ~ExitList no exit routines, yet stz ~ExitList+2 case on jsl ~InitIO reset standard I/O case off lda cLine if cLine == 0 then ora cLine+2 jeq rtl exit add4 cLine,#8 skip the shell identifier ldx #0 count the arguments txy short M lb2 lda [cLine],Y beq lb6 cmp #' ' beq lb3 cmp #'"' beq lb3 cmp #TAB bne lb4 lb3 iny bra lb2 lb4 inx lb5 lda [cLine],Y beq lb6 cmp #' ' beq lb2 cmp #'"' beq lb2 cmp #TAB beq lb2 iny bra lb5 lb6 long M txa we need (X+1)*4 + strlen(cLine)+1 bytes inc A asl A asl A sta start phy sec adc 1,S ply pha pha pea 0 pha ph2 >~User_ID ph2 #$C008 ph4 #0 _NewHandle bcc lb7 puts #'Out of memory',cr=t,errout=t lda #-1 jml ~Quit lb7 pl4 argv get the pointer to the area ldy #2 lda [argv],Y tax lda [argv] sta targv stx targv+2 clc get a pointer to the command line string adc start bcc lb8 inx lb8 sta argv stx argv+2 short M move the command line string ldy #0 lb9 lda [cLine],Y sta [argv],Y beq lb10 iny bra lb9 lb10 long M move4 argv,cLine save the pointer move4 targv,argv set up the pointer to argv av1 lda [cLine] skip leading spaces and #$00FF beq av8 cmp #' ' beq av2 cmp #TAB bne av3 av2 inc4 cLine bra av1 av3 tax save the argument cmp #'"' if the argument is quoted then bne av4 inc4 cLine skip the quote av4 ldy #2 save the address in argv lda cLine sta [argv] lda cLine+2 sta [argv],Y add4 argv,#4 inc argc inc the # of arguments cpx #'"' if the string is quoted then bne av6 av5 lda [cLine] skip to the next quote and #$00FF beq av8 cmp #'"' beq av7 inc4 cLine bra av5 else av6 lda [cLine] skip to the next whitespace char and #$00FF beq av8 cmp #' ' beq av7 cmp #TAB beq av7 inc4 cLine bra av6 av7 short M null terminate the parameter lda #0 sta [cLine] long M bra av2 get the next parameter av8 lda #0 null terminate the arg list sta [argv] ldy #2 sta [argv],Y move4 targv,argv set up the pointer to argv rtl pld return pla pla plb rtl targv ds 4 start ds 2 start of the command line string end **************************************************************** * * ~C_StartUp2 - do C startup for RTL pragma programs * **************************************************************** * ~C_StartUp2 start phb remove our return address phk plb plx ply pea 0 set argc, argv to 0 pea 0 pea 0 phy put the return addr back on the stack phx stz ~ExitList no exit routines, yet stz ~ExitList+2 plb return rtl end **************************************************************** * * ~Exit - call exit routines and clean up open files * * Inputs: * ~ExitList - list of exit routines * **************************************************************** * ~Exit start ptr equ 3 pointer to exit routines ; ; Set up our stack frame ; phb phk plb ph4 ~ExitList set up our stack frame phd tsc tcd ; ; Call the exit functions ; lb1 lda ptr if the pointer is non-nil then ora ptr+2 beq lb3 pea +(lb2-1)|-8 call the function pea +(lb2-1)|8 phb pla ldy #5 lda [ptr],Y pha dey dey lda [ptr],Y pha phb pla rtl lb2 ldy #2 dereference the pointer lda [ptr],Y tax lda [ptr] sta ptr stx ptr+2 bra lb1 ; ; Close (and flush) any open files ; case on lb3 lda >stderr+6 while there is a next file ora >stderr+4 beq lb4 ph4 >stderr+4 close it dc h'22' (jsl fclose, soft reference) dc s3'fclose' bra lb3 case off ; ; return ; lb4 pld return pla pla plb rts end **************************************************************** * * ~ExitList - list of exit routines * **************************************************************** * ~ExitList start ds 4 end **************************************************************** * * ~IntChkC - check for integer math error * * Inputs: * V - set for error * **************************************************************** * ~IntChkC start bvc lb1 branch if no error php pha phx phy error #9 integer math error ply plx pla plp lb1 rtl end **************************************************************** * * ~LoadBF - load a bit field * * Inputs: * addr - address to load from * bitDisp - displacement past the address * bitNum - number of bits * **************************************************************** * ~LoadBF start mask equ 1 bit mask sign equ 5 sign mask csubroutine (2:bitNum,2:bitDisp,4:addr),8 ldy #2 get the value lda [addr],Y tax lda [addr] sta addr stx addr+2 ldx bitDisp normalize the value beq lb2 lb1 lsr addr+2 ror addr dex bne lb1 lb2 stz mask form the bit and sign mask lda #-1 sta sign sta sign+2 lda #0 ldx bitNum lb3 sec rol A rol mask asl sign rol sign+2 dex bne lb3 sec adjust the sign flag ror sign+2 ror sign and addr and out the extra bits sta addr lda mask and addr+2 sta addr+2 lda addr if the value is negative then and sign bne lb4 lda addr+2 and sign+2 beq lb5 lb4 lda addr or in the sign bits ora sign sta addr lda addr+2 ora sign+2 sta addr+2 lb5 creturn 4:addr end **************************************************************** * * ~LoadStruct - load a long value onto the stack * * Inputs: * addr - address of the structure to load * size - size of the structure * **************************************************************** * ~LoadStruct start phb save the caller's data bank pl4 >ret get the return address plx get the transfer size pla get the absolute save addr sta >ad1+1 sta >ad2+1 plb set the data bank phb remove the data bank & extra addr byte pla txa quit if there are no bytes to move beq lb3 lsr a branch if the # of bytes is even bcc lb1 dex move one byte short M ad1 lda ad1,X pha long M txa beq lb3 lb1 dex move the words dex bmi lb3 ad2 lda ad2,X pha bra lb1 lb3 ph4 >ret return to the caller plb rtl ; ; Local data ; ret ds 4 end **************************************************************** * * ~LoadUBF - load an unsigned bit field * * Inputs: * addr - address to load from * bitDisp - displacement past the address * bitNum - number of bits * **************************************************************** * ~LoadUBF start mask equ 1 msw of bit mask csubroutine (2:bitNum,2:bitDisp,4:addr),2 ldy #2 get the value lda [addr],Y tax lda [addr] sta addr stx addr+2 ldx bitDisp normalize the value beq lb2 lb1 lsr addr+2 ror addr dex bne lb1 lb2 stz mask form the bit mask lda #0 ldx bitNum lb3 sec rol A rol mask dex bne lb3 and addr and out the extra bits sta addr lda mask and addr+2 sta addr+2 creturn 4:addr end **************************************************************** * * ~LongMove2 - move some bytes * * Inputs: * source - pointer to source bytes * dest - pointer to destination bytes * len - number of bytes to move * * Notes: * This subroutine leaves the destination address on the * stack. It is used by C for multiple assignment of * arrays and structures. It differs from ~Move2 in that * it can move 64K or more. * **************************************************************** * ~LongMove2 start csubroutine (4:len,4:source),0 dest equ source+4 ldx len+2 move whole banks beq lm2 ldy #0 lm1 lda [source],Y sta [dest],Y dey dey bne lm1 inc source+2 inc dest+2 dex bne lm1 lm2 lda len move one byte if the move length is odd lsr a bcc lb1 short M lda [source] sta [dest] long M inc4 source inc4 dest dec len lb1 ldy len move the bytes beq lb4 dey dey beq lb3 lb2 lda [source],Y sta [dest],Y dey dey bne lb2 lb3 lda [source] sta [dest] lb4 creturn end **************************************************************** * * ~LShr4 - Shift an unsigned long value right * * Inputs: * A - value to shift * X - # bits to shift by * * Outputs: * A - result * **************************************************************** * ~LShr4 start num1 equ 8 number to shift num2 equ 4 # bits to shift by tsc set up DP phd tcd lda num2+2 if num2 < 0 then bpl lb2 cmp #$FFFF shift left bne zero ldx num2 cpx #-34 blt zero lb1 asl num1 rol num1+2 inx bne lb1 bra lb4 zero stz num1 (result is zero) stz num1+2 bra lb4 lb2 bne zero else shift right ldx num2 beq lb4 cpx #33 bge zero lb3 lsr num1+2 ror num1 dex bne lb3 lb4 lda 0 fix stack and return sta num2 lda 2 sta num2+2 pld pla pla rtl end **************************************************************** * * ~Move2 - move some bytes * * Inputs: * source - pointer to source bytes * dest - pointer to destination bytes * len - number of bytes to move * * Notes: * This subroutine leaves the destination address on the * stack. It is used by C for multiple assignment of * arrays and structures. * **************************************************************** * ~Move2 start csubroutine (2:len,4:source),0 dest equ source+4 lda len move one byte if the move length is odd lsr a bcc lb1 short M lda [source] sta [dest] long M inc4 source inc4 dest dec len lb1 ldy len move the bytes beq lb4 dey dey beq lb3 lb2 lda [source],Y sta [dest],Y dey dey bne lb2 lb3 lda [source] sta [dest] lb4 creturn end **************************************************************** * * extern pascal PDosInt(int callNum, void *parm) * * Make a ProDOS or shell call * * Inputs: * callNum - ProDOS call number * parm - address of the parameter block * **************************************************************** * PDOSINT start ProDOS equ $E100A8 csubroutine (4:parm,2:callNum),0 lda callNum sta >lb1 lda parm sta >lb2 lda parm+2 sta >lb2+2 jsl ProDOS lb1 ds 2 lb2 ds 4 sta >~TOOLERROR creturn end **************************************************************** * * ~UDiv4 - Four byte unsigned integer divide * * Inputs: * num1 - numerator * X-A - denominator * * Outputs: * ans - result * **************************************************************** * ~UDiv4 start num1 equ 12 arguments ans equ 1 answer rem equ 5 remainder return equ 9 ; ; Initialize ; tay place the values in the correct spot pea 0 on the stack frame pea 0 lda 10,S pha lda 10,S pha tsc set up DP phd tcd sty num1 stx num1+2 tya check for division by zero ora num1+2 beq dv10 lda num1+2 do 16 bit divides separately ora ans+2 beq dv5 ; ; 32 bit divide ; ldy #32 32 bits to go dv3 asl ans roll up the next number rol ans+2 rol ans+4 rol ans+6 sec subtract for this digit lda ans+4 sbc num1 tax lda ans+6 sbc num1+2 bcc dv4 branch if minus stx ans+4 turn the bit on sta ans+6 inc ans dv4 dey next bit bne dv3 bra dv9 go do the sign ; ; 16 bit divide ; dv5 lda #0 initialize the remainder ldy #16 16 bits to go dv6 asl ans roll up the next number rol a sec subtract the digit sbc num1 bcs dv7 adc num1 digit is 0 dey bne dv6 bra dv8 dv7 inc ans digit is 1 dey bne dv6 dv8 sta ans+4 save the remainder ; ; Return the result ; dv9 move4 ans,num1 move answer dv10 pld return tsc clc adc #8 tcs rtl end **************************************************************** * * ~UMod4 - Four byte unsigned integer remainder * * Inputs: * num1 - numerator * X-A - denominator * * Outputs: * ans - result * **************************************************************** * ~UMod4 start num1 equ 12 arguments ans equ 1 answer rem equ 5 remainder return equ 9 ; ; Initialize ; tay place the values in the correct spot pea 0 on the stack frame pea 0 lda 10,S pha lda 10,S pha tsc set up DP phd tcd sty num1 stx num1+2 tya check for division by zero ora num1+2 beq dv10 lda num1+2 do 16 bit divides separately ora ans+2 beq dv5 ; ; 32 bit divide ; ldy #32 32 bits to go dv3 asl ans roll up the next number rol ans+2 rol ans+4 rol ans+6 sec subtract for this digit lda ans+4 sbc num1 tax lda ans+6 sbc num1+2 bcc dv4 branch if minus stx ans+4 turn the bit on sta ans+6 inc ans dv4 dey next bit bne dv3 bra dv9 go do the sign ; ; 16 bit divide ; dv5 lda #0 initialize the remainder ldy #16 16 bits to go dv6 asl ans roll up the next number rol a sec subtract the digit sbc num1 bcs dv7 adc num1 digit is 0 dey bne dv6 bra dv8 dv7 inc ans digit is 1 dey bne dv6 dv8 sta ans+4 save the remainder ; ; Return the result ; dv9 move4 ans+4,num1 move answer dv10 pld return tsc clc adc #8 tcs rtl end **************************************************************** * * ~Zero - zero an area of direct page memory * * Inputs: * addr - address of the memory * size - number of bytes to zero (must be > 1) * **************************************************************** * ~Zero start csubroutine (2:size,4:addr),0 lda #0 sta [addr] ldx addr txy iny lda size dea dea phb mvn 0,0 plb creturn end \ No newline at end of file diff --git a/cc.macros b/cc.macros new file mode 100755 index 0000000..3a8760e --- /dev/null +++ b/cc.macros @@ -0,0 +1 @@ + MACRO &lab error &e &lab ph2 &e jsl SystemError mend MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND MACRO &LAB PUTS &N1,&F1,&CR,&ERROUT &LAB ~SETM LCLC &C &C AMID "&N1",1,1 AIF "&C"<>"#",.C AIF L:&N1>127,.A BRA ~&SYSCNT AGO .B .A BRL ~&SYSCNT .B &N1 AMID "&N1",2,L:&N1-1 ~L&SYSCNT DC I1"L:~S&SYSCNT" ~S&SYSCNT DC C&N1 ~&SYSCNT ANOP &N1 SETC ~L&SYSCNT-1 .C ~PUSHA &N1 AIF C:&F1,.C1 PEA 0 AGO .C2 .C1 PH2 &F1 .C2 PH2 #C:&CR PH2 #C:&ERROUT JSL ~PUTS ~RESTM MEND MACRO &LAB ~PUSHA &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 SEP #$20 LONGA OFF LDA #0 PHA REP #$20 LONGA ON PHK LDA &N1 PHA MEXIT .B AIF "&C"<>"[",.C &N1 AMID &N1,2,L:&N1-2 LDA &N1+2 PHA LDA &N1 PHA MEXIT .C PEA +(&N1)|-16 PEA &N1 MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB ~SETM &LAB ANOP AIF C:&~LA,.B GBLB &~LA GBLB &~LI .B &~LA SETB S:LONGA &~LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) LONGA ON LONGI ON .A MEND MACRO &LAB ~RESTM &LAB ANOP AIF (&~LA+&~LI)=2,.I SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) AIF &~LA,.H LONGA OFF .H AIF &~LI,.I LONGI OFF .I MEND MACRO &LAB ADD4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~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 MACRO &LAB ~OP.H &OPC,&OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C &OPC &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" &OPC &OP MEXIT .E &OPC 2+&OP MEND MACRO &LAB ~LDA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C LDA &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" LDA &OP MEXIT .E LDA 2+&OP MEND MACRO &LAB ~STA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C STA &OP MEXIT .D STA 2+&OP MEND MACRO &LAB ~LDA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB LDA &OP MEND MACRO &LAB ~STA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB STA &OP MEND MACRO &LAB ~OP &OPC,&OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB &OPC &OP MEND MACRO &LAB INC4 &A &LAB ~SETM INC &A BNE ~&SYSCNT INC 2+&A ~&SYSCNT ~RESTM MEND MACRO &LAB JEQ &BP &LAB BNE *+5 BRL &BP MEND MACRO &LAB 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 &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB PH2 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PL4 &N1 LCLC &C &LAB ANOP AIF S:LONGA=1,.A REP #%00100000 .A &C AMID &N1,1,1 AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.F &N1 AMID &N1,2,L:&N1-2 PLA STA (&N1) LDY #2 PLA STA (&N1),Y AGO .D .B AIF "&C"<>"[",.C PLA STA &N1 LDY #2 PLA STA &N1,Y AGO .D .C PLA STA &N1 PLA STA &N1+2 .D AIF S:LONGA=1,.E SEP #%00100000 .E MEXIT .F MNOTE "Missing closing '}'",16 MEND MACRO &LAB 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 &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND MACRO &LAB _NEWHANDLE &LAB LDX #$0902 JSL $E10000 MEND MACRO &lab csubroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta 1 .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+4+&work &totallen seta &totallen+&len &i seta &i+1 aif &i<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend MACRO &lab creturn &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+2 sta &worklen+&totallen+2 lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend \ No newline at end of file diff --git a/ctype.asm b/ctype.asm new file mode 100755 index 0000000..a68a53d --- /dev/null +++ b/ctype.asm @@ -0,0 +1 @@ + keep obj/ctype case on **************************************************************** * * CType - Character Types Library * * This code implements the tables and subroutines needed to * support the standard C library CTYPES. * * July 1988 * Mike Westerfield * * Copyright 1988 * Byte Works, Inc. * **************************************************************** * CType start dummy routine copy equates.asm end **************************************************************** * * int isalnum (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isalnum start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_upper+_lower+_digit rtl end **************************************************************** * * int isalpha (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isalpha start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_upper+_lower rtl end **************************************************************** * * int isascii (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isascii start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S cpx #$0080 form the result blt yes lda #0 rtl yes lda #1 rtl end **************************************************************** * * int isctrl (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isctrl start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_control rtl end **************************************************************** * * int iscsym (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * iscsym start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype2,X and #_csym rtl end **************************************************************** * * int iscsymf (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * iscsymf start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype2,X and #_csymf rtl end **************************************************************** * * int isdigit (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isdigit start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_digit rtl end **************************************************************** * * int isgraph (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isgraph start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_upper+_lower+_digit+_punctuation rtl end **************************************************************** * * int islower (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * islower start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_lower rtl end **************************************************************** * * int isodigit (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isodigit start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype2,X and #_octal rtl end **************************************************************** * * int isprint (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isprint start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_print rtl end **************************************************************** * * int ispunct (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * ispunct start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_punctuation rtl end **************************************************************** * * int isspace (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isspace start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_space rtl end **************************************************************** * * int isupper (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isupper start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_upper rtl end **************************************************************** * * int isxdigit (int c) * * Inputs: * 4,S - digit to test * * Outputs: * A - result * **************************************************************** * isxdigit start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx form the result lda >__ctype,X and #_hex rtl end **************************************************************** * * int toascii (int c) * * Inputs: * 4,S - digit to convert * * Outputs: * A - result * **************************************************************** * toascii start lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S txa form the result and #$7F rtl end **************************************************************** * * toint - convert a hex digit to a binary value * * Inputs: * 4,S - digit to convert * * Outputs: * A - converted digit * **************************************************************** * toint start FALSE equ -1 returned for false conditions lda 4,S fetch the operand tax lda 2,S remove parm from stack sta 4,S pla sta 1,S inx branch if not hex lda >__ctype,X and #_hex beq no txa insure char is uppercase and #$5F dec A cmp #'A' if the character is alpha then blt lb1 sbc #7 convert the value lb1 and #$000F return ordinal value rtl no lda #FALSE not hex rtl end **************************************************************** * * tolower - if the input is uppercase, convert it to lowercase * * Inputs: * 4,S - digit to convert * * Outputs: * A - converted character * **************************************************************** * tolower start lda 4,S fetch the operand tax lda 2,S remove parm from the stack sta 4,S pla sta 1,S lda >__ctype+1,X branch if the character is not uppercase and #_upper beq lb1 txa convert to lowercase ora #$20 rtl lb1 txa return the input character rtl end **************************************************************** * * toupper - if the input is lowercase, convert it to uppercase * * Inputs: * 4,S - digit to convert * * Outputs: * A - converted character * **************************************************************** * toupper start lda 4,S fetch the operand tax lda 2,S remove parm from the stack sta 4,S pla sta 1,S lda >__ctype+1,X branch if the character is not lowercase and #_lower beq lb1 txa convert to uppercase and #$5F rtl lb1 txa return the input character rtl end **************************************************************** * * __ctype - character types array * * This data area defines an array of bit masks. It is used * to test for character types. For example, to determine if * a character is alphabetic, and the uppercase and lowercase * bit masks with the array element for the character being * tested. If the result is non-zero, the character is * alphabetic. * **************************************************************** * __ctype start dc i1'0' EOF dc i1'_control' $00 dc i1'_control' $01 dc i1'_control' $02 dc i1'_control' $03 dc i1'_control' $04 dc i1'_control' $05 dc i1'_control' $06 dc i1'_control' $07 dc i1'_control' $08 dc i1'_control+_space' $09 dc i1'_control+_space' $0A dc i1'_control+_space' $0B dc i1'_control+_space' $0C dc i1'_control+_space' $0D dc i1'_control' $0E dc i1'_control' $0F dc i1'_control' $10 dc i1'_control' $11 dc i1'_control' $12 dc i1'_control' $13 dc i1'_control' $14 dc i1'_control' $15 dc i1'_control' $16 dc i1'_control' $17 dc i1'_control' $18 dc i1'_control' $19 dc i1'_control' $1A dc i1'_control' $1B dc i1'_control' $1C dc i1'_control' $1D dc i1'_control' $1E dc i1'_control' $1F dc i1'_space+_print' ' ' dc i1'_punctuation+_print' ! dc i1'_punctuation+_print' " dc i1'_punctuation+_print' # dc i1'_punctuation+_print' $ dc i1'_punctuation+_print' % dc i1'_punctuation+_print' & dc i1'_punctuation+_print' ' dc i1'_punctuation+_print' ( dc i1'_punctuation+_print' ) dc i1'_punctuation+_print' * dc i1'_punctuation+_print' + dc i1'_punctuation+_print' , dc i1'_punctuation+_print' - dc i1'_punctuation+_print' . dc i1'_punctuation+_print' / dc i1'_digit+_hex+_print' 0 dc i1'_digit+_hex+_print' 1 dc i1'_digit+_hex+_print' 2 dc i1'_digit+_hex+_print' 3 dc i1'_digit+_hex+_print' 4 dc i1'_digit+_hex+_print' 5 dc i1'_digit+_hex+_print' 6 dc i1'_digit+_hex+_print' 7 dc i1'_digit+_hex+_print' 8 dc i1'_digit+_hex+_print' 9 dc i1'_punctuation+_print' : dc i1'_punctuation+_print' ; dc i1'_punctuation+_print' < dc i1'_punctuation+_print' = dc i1'_punctuation+_print' > dc i1'_punctuation+_print' ? dc i1'_punctuation+_print' @ dc i1'_upper+_hex+_print' A dc i1'_upper+_hex+_print' B dc i1'_upper+_hex+_print' C dc i1'_upper+_hex+_print' D dc i1'_upper+_hex+_print' E dc i1'_upper+_hex+_print' F dc i1'_upper+_print' G dc i1'_upper+_print' H dc i1'_upper+_print' I dc i1'_upper+_print' J dc i1'_upper+_print' K dc i1'_upper+_print' L dc i1'_upper+_print' M dc i1'_upper+_print' N dc i1'_upper+_print' O dc i1'_upper+_print' P dc i1'_upper+_print' Q dc i1'_upper+_print' R dc i1'_upper+_print' S dc i1'_upper+_print' T dc i1'_upper+_print' U dc i1'_upper+_print' V dc i1'_upper+_print' W dc i1'_upper+_print' X dc i1'_upper+_print' Y dc i1'_upper+_print' Z dc i1'_punctuation+_print' [ dc i1'_punctuation+_print' \ dc i1'_punctuation+_print' ] dc i1'_punctuation+_print' ^ dc i1'_punctuation+_print' _ dc i1'_punctuation+_print' ` dc i1'_lower+_hex+_print' a dc i1'_lower+_hex+_print' b dc i1'_lower+_hex+_print' c dc i1'_lower+_hex+_print' d dc i1'_lower+_hex+_print' e dc i1'_lower+_hex+_print' f dc i1'_lower+_print' g dc i1'_lower+_print' h dc i1'_lower+_print' i dc i1'_lower+_print' j dc i1'_lower+_print' k dc i1'_lower+_print' l dc i1'_lower+_print' m dc i1'_lower+_print' n dc i1'_lower+_print' o dc i1'_lower+_print' p dc i1'_lower+_print' q dc i1'_lower+_print' r dc i1'_lower+_print' s dc i1'_lower+_print' t dc i1'_lower+_print' u dc i1'_lower+_print' v dc i1'_lower+_print' w dc i1'_lower+_print' x dc i1'_lower+_print' y dc i1'_lower+_print' z dc i1'_punctuation+_print' { dc i1'_punctuation+_print' | dc i1'_punctuation+_print' } dc i1'_punctuation+_print' ~ dc i1'_control' $7F dc i1'0' $80 dc i1'0' $81 dc i1'0' $82 dc i1'0' $83 dc i1'0' $84 dc i1'0' $85 dc i1'0' $86 dc i1'0' $87 dc i1'0' $88 dc i1'0' $89 dc i1'0' $8A dc i1'0' $8B dc i1'0' $8C dc i1'0' $8D dc i1'0' $8E dc i1'0' $8F dc i1'0' $90 dc i1'0' $91 dc i1'0' $92 dc i1'0' $93 dc i1'0' $94 dc i1'0' $95 dc i1'0' $96 dc i1'0' $97 dc i1'0' $98 dc i1'0' $99 dc i1'0' $9A dc i1'0' $9B dc i1'0' $9C dc i1'0' $9D dc i1'0' $9E dc i1'0' $9F dc i1'0' $A0 dc i1'0' $A1 dc i1'0' $A2 dc i1'0' $A3 dc i1'0' $A4 dc i1'0' $A5 dc i1'0' $A6 dc i1'0' $A7 dc i1'0' $A8 dc i1'0' $A9 dc i1'0' $AA dc i1'0' $AB dc i1'0' $AC dc i1'0' $AD dc i1'0' $AE dc i1'0' $AF dc i1'0' $B0 dc i1'0' $B1 dc i1'0' $B2 dc i1'0' $B3 dc i1'0' $B4 dc i1'0' $B5 dc i1'0' $B6 dc i1'0' $B7 dc i1'0' $B8 dc i1'0' $B9 dc i1'0' $BA dc i1'0' $BB dc i1'0' $BC dc i1'0' $BD dc i1'0' $BE dc i1'0' $BF dc i1'0' $C0 dc i1'0' $C1 dc i1'0' $C2 dc i1'0' $C3 dc i1'0' $C4 dc i1'0' $C5 dc i1'0' $C6 dc i1'0' $C7 dc i1'0' $C8 dc i1'0' $C9 dc i1'0' $CA dc i1'0' $CB dc i1'0' $CC dc i1'0' $CD dc i1'0' $CE dc i1'0' $CF dc i1'0' $D0 dc i1'0' $D1 dc i1'0' $D2 dc i1'0' $D3 dc i1'0' $D4 dc i1'0' $D5 dc i1'0' $D6 dc i1'0' $D7 dc i1'0' $D8 dc i1'0' $D9 dc i1'0' $DA dc i1'0' $DB dc i1'0' $DC dc i1'0' $DD dc i1'0' $DE dc i1'0' $DF dc i1'0' $E0 dc i1'0' $E1 dc i1'0' $E2 dc i1'0' $E3 dc i1'0' $E4 dc i1'0' $E5 dc i1'0' $E6 dc i1'0' $E7 dc i1'0' $E8 dc i1'0' $E9 dc i1'0' $EA dc i1'0' $EB dc i1'0' $EC dc i1'0' $ED dc i1'0' $EE dc i1'0' $EF dc i1'0' $F0 dc i1'0' $F1 dc i1'0' $F2 dc i1'0' $F3 dc i1'0' $F4 dc i1'0' $F5 dc i1'0' $F6 dc i1'0' $F7 dc i1'0' $F8 dc i1'0' $F9 dc i1'0' $FA dc i1'0' $FB dc i1'0' $FC dc i1'0' $FD dc i1'0' $FE dc i1'0' $FF end **************************************************************** * * __ctype2 - character types array * * This data area defines a second array of of bit masks. It * is used to test for character types. For example, to * determine if a character is allowed as an initial character * in a symbol, and _csym with the array element for the * character being tested. If the result is non-zero, the * character is alphabetic. * **************************************************************** * __ctype2 start dc i1'0' EOF dc i1'0' $00 dc i1'0' $01 dc i1'0' $02 dc i1'0' $03 dc i1'0' $04 dc i1'0' $05 dc i1'0' $06 dc i1'0' $07 dc i1'0' $08 dc i1'0' $09 dc i1'0' $0A dc i1'0' $0B dc i1'0' $0C dc i1'0' $0D dc i1'0' $0E dc i1'0' $0F dc i1'0' $10 dc i1'0' $11 dc i1'0' $12 dc i1'0' $13 dc i1'0' $14 dc i1'0' $15 dc i1'0' $16 dc i1'0' $17 dc i1'0' $18 dc i1'0' $19 dc i1'0' $1A dc i1'0' $1B dc i1'0' $1C dc i1'0' $1D dc i1'0' $1E dc i1'0' $1F dc i1'0' ' ' dc i1'0' ! dc i1'0' " dc i1'0' # dc i1'0' $ dc i1'0' % dc i1'0' & dc i1'0' ' dc i1'0' ( dc i1'0' ) dc i1'0' * dc i1'0' + dc i1'0' , dc i1'0' - dc i1'0' . dc i1'0' / dc i1'_csym+_octal' 0 dc i1'_csym+_octal' 1 dc i1'_csym+_octal' 2 dc i1'_csym+_octal' 3 dc i1'_csym+_octal' 4 dc i1'_csym+_octal' 5 dc i1'_csym+_octal' 6 dc i1'_csym+_octal' 7 dc i1'_csym' 8 dc i1'_csym' 9 dc i1'0' : dc i1'0' ; dc i1'0' < dc i1'0' = dc i1'0' > dc i1'0' ? dc i1'0' @ dc i1'_csym+_csymf' A dc i1'_csym+_csymf' B dc i1'_csym+_csymf' C dc i1'_csym+_csymf' D dc i1'_csym+_csymf' E dc i1'_csym+_csymf' F dc i1'_csym+_csymf' G dc i1'_csym+_csymf' H dc i1'_csym+_csymf' I dc i1'_csym+_csymf' J dc i1'_csym+_csymf' K dc i1'_csym+_csymf' L dc i1'_csym+_csymf' M dc i1'_csym+_csymf' N dc i1'_csym+_csymf' O dc i1'_csym+_csymf' P dc i1'_csym+_csymf' Q dc i1'_csym+_csymf' R dc i1'_csym+_csymf' S dc i1'_csym+_csymf' T dc i1'_csym+_csymf' U dc i1'_csym+_csymf' V dc i1'_csym+_csymf' W dc i1'_csym+_csymf' X dc i1'_csym+_csymf' Y dc i1'_csym+_csymf' Z dc i1'0' [ dc i1'0' \ dc i1'0' ] dc i1'0' ^ dc i1'_csym+_csymf' _ dc i1'0' ` dc i1'_csym+_csymf' a dc i1'_csym+_csymf' b dc i1'_csym+_csymf' c dc i1'_csym+_csymf' d dc i1'_csym+_csymf' e dc i1'_csym+_csymf' f dc i1'_csym+_csymf' g dc i1'_csym+_csymf' h dc i1'_csym+_csymf' i dc i1'_csym+_csymf' j dc i1'_csym+_csymf' k dc i1'_csym+_csymf' l dc i1'_csym+_csymf' m dc i1'_csym+_csymf' n dc i1'_csym+_csymf' o dc i1'_csym+_csymf' p dc i1'_csym+_csymf' q dc i1'_csym+_csymf' r dc i1'_csym+_csymf' s dc i1'_csym+_csymf' t dc i1'_csym+_csymf' u dc i1'_csym+_csymf' v dc i1'_csym+_csymf' w dc i1'_csym+_csymf' x dc i1'_csym+_csymf' y dc i1'_csym+_csymf' z dc i1'0' { dc i1'0' | dc i1'0' } dc i1'0' ~ dc i1'0' $7F dc i1'0' $80 dc i1'0' $81 dc i1'0' $82 dc i1'0' $83 dc i1'0' $84 dc i1'0' $85 dc i1'0' $86 dc i1'0' $87 dc i1'0' $88 dc i1'0' $89 dc i1'0' $8A dc i1'0' $8B dc i1'0' $8C dc i1'0' $8D dc i1'0' $8E dc i1'0' $8F dc i1'0' $90 dc i1'0' $91 dc i1'0' $92 dc i1'0' $93 dc i1'0' $94 dc i1'0' $95 dc i1'0' $96 dc i1'0' $97 dc i1'0' $98 dc i1'0' $99 dc i1'0' $9A dc i1'0' $9B dc i1'0' $9C dc i1'0' $9D dc i1'0' $9E dc i1'0' $9F dc i1'0' $A0 dc i1'0' $A1 dc i1'0' $A2 dc i1'0' $A3 dc i1'0' $A4 dc i1'0' $A5 dc i1'0' $A6 dc i1'0' $A7 dc i1'0' $A8 dc i1'0' $A9 dc i1'0' $AA dc i1'0' $AB dc i1'0' $AC dc i1'0' $AD dc i1'0' $AE dc i1'0' $AF dc i1'0' $B0 dc i1'0' $B1 dc i1'0' $B2 dc i1'0' $B3 dc i1'0' $B4 dc i1'0' $B5 dc i1'0' $B6 dc i1'0' $B7 dc i1'0' $B8 dc i1'0' $B9 dc i1'0' $BA dc i1'0' $BB dc i1'0' $BC dc i1'0' $BD dc i1'0' $BE dc i1'0' $BF dc i1'0' $C0 dc i1'0' $C1 dc i1'0' $C2 dc i1'0' $C3 dc i1'0' $C4 dc i1'0' $C5 dc i1'0' $C6 dc i1'0' $C7 dc i1'0' $C8 dc i1'0' $C9 dc i1'0' $CA dc i1'0' $CB dc i1'0' $CC dc i1'0' $CD dc i1'0' $CE dc i1'0' $CF dc i1'0' $D0 dc i1'0' $D1 dc i1'0' $D2 dc i1'0' $D3 dc i1'0' $D4 dc i1'0' $D5 dc i1'0' $D6 dc i1'0' $D7 dc i1'0' $D8 dc i1'0' $D9 dc i1'0' $DA dc i1'0' $DB dc i1'0' $DC dc i1'0' $DD dc i1'0' $DE dc i1'0' $DF dc i1'0' $E0 dc i1'0' $E1 dc i1'0' $E2 dc i1'0' $E3 dc i1'0' $E4 dc i1'0' $E5 dc i1'0' $E6 dc i1'0' $E7 dc i1'0' $E8 dc i1'0' $E9 dc i1'0' $EA dc i1'0' $EB dc i1'0' $EC dc i1'0' $ED dc i1'0' $EE dc i1'0' $EF dc i1'0' $F0 dc i1'0' $F1 dc i1'0' $F2 dc i1'0' $F3 dc i1'0' $F4 dc i1'0' $F5 dc i1'0' $F6 dc i1'0' $F7 dc i1'0' $F8 dc i1'0' $F9 dc i1'0' $FA dc i1'0' $FB dc i1'0' $FC dc i1'0' $FD dc i1'0' $FE dc i1'0' $FF end \ No newline at end of file diff --git a/equates.asm b/equates.asm new file mode 100755 index 0000000..8b012bc --- /dev/null +++ b/equates.asm @@ -0,0 +1 @@ +**************************************************************** * * This file contains constant values defined in the C interfaces * that are also used in the assembly language portion of the * libraries. * **************************************************************** ; ; error numbers ; EDOM gequ 1 domain error ERANGE gequ 2 # too large, too small, or illegal ENOMEM gequ 3 Not enough memory ENOENT gequ 4 No such file or directory EIO gequ 5 I/O error EINVAL gequ 6 Invalid argument EBADF gequ 7 bad file descriptor EMFILE gequ 8 too many files are open EACCES gequ 9 access bits prevent the operation EEXIST gequ 10 the file exists ENOSPC gequ 11 the file is too large ; ; masks for the __ctype array ; _digit gequ $01 ['0'..'9'] _upper gequ $02 ['A'..'Z'] _lower gequ $04 ['a'..'z'] _control gequ $08 [chr(0)..chr(31),chr(127)] _punctuation gequ $10 [' ','!'..'/',':'..'@','['..'`','{'..'~'] _space gequ $20 [chr(9)..chr(13),' '] _hex gequ $40 ['0'..'9','a'..'f','A'..'F'] _print gequ $80 [' '..'~'] ; ; masks for the __ctype2 array ; _csym gequ $01 ['0'..'9','A'..'Z','a'..'z','_'] _csymf gequ $02 ['A'..'Z','a'..'z'.'_'] _octal gequ $04 ['0'..'7'] ; ; signal numbers ; SIGABRT gequ 1 SIGFPE gequ 2 SIGILL gequ 3 SIGINT gequ 4 SIGSEGV gequ 5 SIGTERM gequ 6 ; ; The FILE record ; ! flags ! ----- _IOFBF gequ $0001 full buffering _IONBF gequ $0002 no buffering _IOLBF gequ $0004 flush when a \n is written _IOREAD gequ $0008 currently reading _IOWRT gequ $0010 currently writing _IORW gequ $0020 read/write enabled _IOMYBUF gequ $0040 buffer was allocated by stdio _IOEOF gequ $0080 has an EOF been found? _IOERR gequ $0100 has an error occurred? _IOTEXT gequ $0200 is this file a text file? _IOTEMPFILE gequ $0400 was this file created by tmpfile()? ! record structure ! ---------------- FILE_next gequ 0 disp to next pointer (must stay 0!) FILE_ptr gequ FILE_next+4 next location to write to FILE_base gequ FILE_ptr+4 first byte of the buffer FILE_end gequ FILE_base+4 end of the file buffer FILE_size gequ FILE_end+4 size of the file buffer FILE_cnt gequ FILE_size+4 # chars that can be read/writen to buffer FILE_pbk gequ FILE_cnt+4 put back character FILE_flag gequ FILE_pbk+4 buffer flags FILE_file gequ FILE_flag+2 GS/OS file ID sizeofFILE gequ FILE_file+2 size of the record BUFSIZ gequ 1024 default file buffer size _LBUFSIZ gequ 255 line buffer size L_tmpnam gequ 9 size of a temp name TMP_MAX gequ 10000 # of uniq temp names ; ; Seek codes for fseek ; SEEK_SET gequ 0 seek from start of file SEEK_CUR gequ 1 seek from current position SEEK_END gequ 2 seek from end of file ; ; Values for fcntl.h ; OPEN_MAX gequ 30 files in the file array F_DUPFD gequ 1 dup file flag (fcntl) O_RDONLY gequ $0001 file is read only O_WRONLY gequ $0002 file is write only O_RDWR gequ $0004 file is read/write O_NDELAY gequ $0008 not used O_APPEND gequ $0010 append to file on all writes O_CREAT gequ $0020 create a new file if needed O_TRUNC gequ $0040 erase old file O_EXCL gequ $0080 don't create a new file O_BINARY gequ $0100 file is binary ; ; Misc. ; EOF gequ -1 end of file character stdinID gequ -1 standard in file ID stdoutID gequ -2 standard out file ID stderrID gequ -3 error out file ID \ No newline at end of file diff --git a/fcntl.asm b/fcntl.asm new file mode 100755 index 0000000..b4f32fc --- /dev/null +++ b/fcntl.asm @@ -0,0 +1 @@ + keep obj/fcntl mcopy fcntl.macros case on **************************************************************** * * fcntl - UNIX primitive input/output facilities * * This code implements the tables and subroutines needed to * support a subset of the UNIX library FCNTL. * * October 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * **************************************************************** * FCNTL start dummy segment copy equates.asm strSize gequ 255 max size of a GS/OS path name end **************************************************************** * * ctoosstr - convert a C string to a GS/OS input string * * Inputs: * cstr - pointer to the c string * * Outputs: * returns a pointer to the OS string * * Notes: * If the C string is longer than strSize bytes, the * string is truncated without warning. * **************************************************************** * ctoosstr private osptr equ 1 os string pointer csubroutine (4:cstr),4 phb use a local B reg phk plb short M copy over the characters ldy #0 lb1 lda [cstr],Y beq lb2 sta osstr+2,Y iny cpy #strSize bne lb1 lb2 sty osstr set the string length long M lla osptr,osstr set the address of the string plb restore caller's B creturn 4:osptr return osptr osstr ds 2+strSize GS/OS string buffer end **************************************************************** * * int chmod(char *path, int mode); * * Changes the access bits. * * Inputs: * path - name of the file * mode - zero or more flags to set: * 0x0100 - read * 0x0080 - write * 0x1000 - delete * 0x2000 - rename * 0x4000 - backup * 0x8000 - invisible * * Outputs: * returns 0 if successful; else -1 * errno - set if an error occurred * **************************************************************** * chmod start err equ 1 error return code csubroutine (4:path,2:mode),2 phb use local B phk plb stz err err = 0 {no error} lda mode convert mode to ProDOS format jsr unixtoprodos sta siAccess ph4 path set the path name jsl ctoosstr sta siPathname stx siPathname+2 OSSet_File_Info siRec set the access bits bcs lb1 lda siAccess if the backup bit is clear then and #$0020 bne lb2 move4 siPathname,cbPathname clear the backup bit OSClear_Backup cbRec bcc lb2 lb1 lda #ENOENT flag an error sta >errno dec err lb2 plb creturn 2:err cbRec dc i'1' ClearBackup record cbPathname ds 4 siRec dc i'2' SetFileInfo record siPathname ds 4 siAccess ds 2 end **************************************************************** * * int close(int filds); * * Close a file. * * Inputs: * filds - file ID of the file to close * * Outputs: * returns 0 if successful; else -1 * errno - set if an error occurred * **************************************************************** * close start err equ 1 error return code csubroutine (2:filds),2 stz err err = 0 {no error} lda filds error if there are too many open files bmi lb2 cmp #OPEN_MAX bge lb2 asl A get the file reference number asl A tax lda >files,X beq lb2 sta >clRefnum lda #0 free the file record sta >files,X ldx #OPEN_MAX*4-4 for each file record do lda >clRefnum if the file is a duplicate then lb1 cmp >files,X beq lb3 skip the close dex dex dex dex bpl lb1 OSClose clRec close the file bcc lb3 lb2 lda #EBADF an error occurred - set errno sta >errno dec err err = -1 lb3 creturn 2:err clRec dc i'1' close record clRefnum ds 2 end **************************************************************** * * int creat(char *path, int mode); * * Create a file. * * Inputs: * path - name of the file * mode - zero or more flags to set: * 0x0100 - read * 0x0080 - write * 0x1000 - delete * 0x2000 - rename * 0x4000 - backup * 0x8000 - invisible * * Outputs: * returns 0 if successful; else -1 * errno - set if an error occurred * **************************************************************** * creat start err equ 1 error return code csubroutine (4:path,2:mode),2 ph2 #O_WRONLY+O_TRUNC+O_CREAT ph2 mode ph4 path jsl openfile sta err creturn 2:err end **************************************************************** * * int dup(int old); * * Duplicate a file descriptor * * Inputs: * old - existing file descriptor * * Outputs: * returns 0 if successful; else -1 * errno - set if an error occurred * **************************************************************** * dup start err equ 1 error return code csubroutine (2:old),2 ph2 #0 ph2 #F_DUPFD ph2 old jsl fcntl sta err creturn 2:err end **************************************************************** * * int fcntl(int filds, int cmd, int arg); * * Open file control * * Inputs: * filds - file ID of file * cmd - command; F_DUPD is the only one accepted * arg - lowest acceptable returned file ID * * Outputs: * returns -1 for an error; new filds for success * errno - set if an error occurred * **************************************************************** * fcntl start err equ 1 error return code refnum equ 3 reference number flags equ 5 file flags csubroutine (2:filds,2:cmd,2:arg),6 stz err err = 0 {no error} lda cmd the command must be F_DUPFD cmp #F_DUPFD beq lb1 dec err lda #EINVAL sta >errno bra lb7 lb1 lda filds error if there are too many open files bmi lb2 cmp #OPEN_MAX bge lb2 asl A get the file reference number asl A tax lda >files,X bne lb3 lb2 dec err flag an invalid filds error lda #EBADF sta >errno bra lb7 lb3 sta refnum lda >files+2,X get the file flags sta flags lda arg find a new filds bmi lb5 cmp #OPEN_MAX bge lb5 asl A asl A lb4 lda >files,X beq lb6 inx inx inx inx cpx #OPEN_MAX*4 bne lb4 lb5 dec err none are available -- flag the error lda #EMFILE sta >errno bra lb7 lb6 lda refnum set the new refnum sta >files,X lda flags set the new flags sta >files+2,X txa return the filds lsr A lsr A sta err lb7 creturn 2:err end **************************************************************** * * files - array of file records * * There are OPEN_MAX elements, each with the following format: * * bytes use * ----- --- * 2 file reference number; 0 if element is free * 2 flags; set by open command * * Notes: Array calculations throughout the module depend on * a record size within the array of exactly 4 bytes. * **************************************************************** * files private ds 4*OPEN_MAX end **************************************************************** * * long lseek(int filds, long offset, int whence); * * Set the file mark * * Inputs: * filds - file ID of file * offset - new file mark * whence - set the mark in relation to: * 0 - file start * 1 - current mark * 2 - file end * * Outputs: * returns file pointer if successful; -1 for an error * errno - set if an error occurred * **************************************************************** * lseek start mark equ 1 new file mark csubroutine (2:filds,4:offset,2:whence),4 lda #$FFFF assume we will get an error sta mark sta mark+2 lda filds get the file refnum bmi lb1 cmp #OPEN_MAX bge lb1 asl A asl A tax lda >files,X bne lb2 lb1 lda #EBADF bad refnum error sta >errno bra lb4 lb2 sta >smRefnum set the file refnum sta >gmRefnum lda whence convert from UNIX whence to GS/OS base beq lb3 eor #$0003 cmp #4 bge lb2a cmp #2 bne lb3 sta >smBase lda offset+2 bpl lb3a sub4 #0,offset,offset lda #3 bra lb3 lb2a lda #EINVAL invalid whence flag sta >errno bra lb4 lb3 sta >smBase save the base parameter lb3a lda offset set the displacement sta >smDisplacement lda offset+2 sta >smDisplacement+2 OSSet_Mark smRec set the file mark bcs lb1 OSGet_Mark gmRec get the new mark bcs lb1 lda >gmDisplacement sta mark lda >gmDisplacement+2 sta mark+2 lb4 creturn 4:mark smRec dc i'3' SetMark record smRefnum ds 2 smBase ds 2 smDisplacement ds 4 gmRec dc i'2' GetMark record gmRefnum ds 2 gmDisplacement ds 4 end **************************************************************** * * int open(char *path, int oflag); * * Open a file * * Inputs: * path - name of the file * oflag - output flags * * Outputs: * returns 0 if successful; else -1 * errno - set if an error occurred * **************************************************************** * open start err equ 1 error return code csubroutine (4:path,2:oflag),2 ph2 oflag ph2 #$7180 ph4 path jsl openfile sta err creturn 2:err end **************************************************************** * * int openfile(char *path, int mode, int oflag); * * Open a file * * Inputs: * path - name of the file * mode - zero or more flags to set: * 0x0100 - read * 0x0080 - write * 0x1000 - delete * 0x2000 - rename * 0x4000 - backup * 0x8000 - invisible * oflag - output flags * * Outputs: * returns 0 if successful; else -1 * errno - set if an error occurred * **************************************************************** * openfile private err equ 1 error return code index equ 3 index into the files array BIN equ $06 BIN file type TXT equ $04 TXT file type csubroutine (4:path,2:mode,2:oflag),6 phb use local B phk plb stz err err = 0 {no error} ldx #0 find a free file entry lb1 lda files,X beq lb2 inx inx inx inx cpx #OPEN_MAX*4 bne lb1 dec err flag the open file error lda #EMFILE sta >errno brl lb11 lb2 stx index save the index to the file ph4 path convert the path to an OS string jsl ctoosstr sta opPathname stx opPathname+2 sta giPathname stx giPathname+2 sta crPathname stx crPathname+2 lda mode set the access bits for the create call jsr unixtoprodos sta crAccess lda oflag set the flags in the files array ldx index sta files+2,X and #O_BINARY if the file is binary then beq lb3 lda #BIN set the create file type to BIN bra lb4 else lb3 lda #TXT set the create file type to TXT lb4 sta crFileType OSGet_File_Info giRec if the file exists then bcs lb5 lda oflag if O_EXCL is set then and #O_EXCL beq lb4a dec err flag the error lda #ENOENT sta >errno bra lb11 lb4a ph2 mode set the access bits ph4 path jsl chmod bra lb8 else lb5 lda oflag if O_CREAT is not set then and #O_CREAT bne lb7 dec err flag the error lda #EEXIST sta >errno bra lb11 lb7 OSCreate crRec create the file bcs lb9 lb8 anop OSOpen opRec open the file bcs lb9 lda oflag if the O_TRUNC flag is set then and #O_TRUNC beq lb10 lda opRefnum set the EOF to 0 sta efRefnum OSSet_EOF efRec bcc lb10 lb9 dec err flag an I/O error lda #EACCES sta >errno bra lb11 lb10 lda opRefnum save the reference number ldx index sta files,X txa set the return file index lsr A lsr A sta err lb11 plb restore the caller's B creturn 2:err crRec dc i'3' Create record crPathname ds 4 crAccess ds 2 crFileType ds 2 giRec dc i'2' GetFileInfo record giPathname ds 4 ds 2 opRec dc i'2' Open record opRefnum ds 2 opPathname ds 4 efRec dc i'3' SetEOF record efRefnum ds 2 dc i'0' dc i4'0' end **************************************************************** * * int read(int filds, char *buf, int n); * * Read from a file * * Inputs: * filds - file ID of file * buf - file buffer * n - # of bytes to read * * Outputs: * returns 0 if successful; else -1 * errno - set if an error occurred * **************************************************************** * read start err equ 1 error return code csubroutine (2:filds,4:buf,2:n),2 stz err err = 0 {no error} phb use our B phk plb lda filds error if the file has not been opened bmi lb0 cmp #OPEN_MAX bge lb0 asl A get the file reference number asl A tax lda files,X beq lb0 sta rdRefnum stx filds lda files+2,X make sure the file is open for reading and #O_RDONLY+O_RDWR bne lb0a lb0 lda #EBADF errno = EBANF sta >errno dec err return = -1 bra lb5 lb0a move4 buf,rdDataBuffer set the location to read to lda n set the number of bytes to read sta rdRequestCount OSRead rdRec read the bytes bcc lb1 if an error occurred cmp #$4C and it was not EOF then beq lb1 lda #EIO errno = EIO sta >errno dec err return -1 bra lb5 lb1 ldy rdTransferCount return the bytes read sty err beq lb5 lb2 ldx filds if the file is not binary then lda files+2,X and #O_BINARY bne lb5 dey for each byte do beq lb4a short M lb3 lda [buf],Y if the byte is \r then cmp #13 bne lb4 lda #10 change it to \n sta [buf],Y lb4 dey next byte bne lb3 lb4a lda [buf] if the first byte is \r then cmp #13 bne lb4b lda #10 change it to \n sta [buf] lb4b long M lb5 plb restore B creturn 2:err rdRec dc i'4' Read record rdRefnum ds 2 rdDataBuffer ds 4 rdRequestCount ds 4 rdTransferCount ds 4 end **************************************************************** * * unixtoprodos - Convert UNIX access flags to ProDOS access flags * * Inputs: * A - UNIX access flags * * Outputs: * A - ProDOS access flags * **************************************************************** * unixtoprodos private bits equ 3 ProDOS bits pea 0 set ProDOS bits to 0 phd set up a stack frame tax tsc tcd txa bit #$1000 if unix delete bit is set then beq lb1 sec set the ProDOS delete bit rol bits lb1 bit #$2000 if unix rename bit is set then beq lb2 sec set the ProDOS rename bit bra lb3 else lb2 clc clear the ProDOS rename bit lb3 rol bits bit #$4000 if unix backup bit is set then beq lb4 sec set the ProDOS backup bit bra lb5 else lb4 clc clear the ProDOS backup bit lb5 rol bits rol bits roll in the two unused bit fields rol bits bit #$8000 if unix invisible bit is set then beq lb6 sec set the ProDOS invisible bit bra lb7 else lb6 clc clear the ProDOS invisible bit lb7 rol bits bit #$0080 if unix write bit is set then beq lb8 sec set the ProDOS write bit bra lb9 else lb8 clc clear the ProDOS write bit lb9 rol bits bit #$0100 if unix read bit is set then beq lb10 sec set the ProDOS read bit bra lb11 else lb10 clc clear the ProDOS read bit lb11 rol bits pld return the new flags pla rts end **************************************************************** * * int write(filds, char *buf, unsigned n); * * Write to a file * * Inputs: * filds - file ID of file * buf - file buffer * n - # of bytes to write * * Outputs: * returns 0 if successful; else -1 * errno - set if an error occurred * **************************************************************** * write start err equ 1 error return code nbuff equ 3 new buffer pointer csubroutine (2:filds,4:buf,2:n),6 stz err err = 0 {no error} phb use our B phk plb lda filds error if the file has not been opened bmi lb0 cmp #OPEN_MAX bge lb0 asl A get the file reference number asl A tax lda files,X beq lb0 sta wrRefnum stx filds lda files+2,X make sure the file is open for writing and #O_WRONLY+O_RDWR bne lb0a lb0 lda #EBADF errno = EBADF sta >errno dec err return = -1 brl lb5 lb0a move4 buf,wrDataBuffer set the location to write from lda n set the number of bytes to read sta wrRequestCount stz nbuff nbuff == nil stz nbuff+2 ldx filds if the file is not binary then lda files+2,X and #O_BINARY bne lb0g pea 0 reserve a file buffer ph2 n jsl malloc sta nbuff stx nbuff+2 ora nbuff+2 bne lb0b dec err flag an out of memory error lda #ENOSPC sta >errno bra lb5 lb0b ldy n move the bytes to the new buffer, beq lb0f converting \n chars to \r chars dey in the process beq lb0da short M lb0c lda [buf],Y cmp #10 bne lb0d lda #13 lb0d sta [nbuff],Y dey bne lb0c lb0da lda [buf] cmp #10 bne lb0e lda #13 lb0e sta [nbuff] long M lb0f move4 nbuff,wrDataBuffer set the data buffer start lb0g OSWrite wrRec write the bytes bcc lb1 if an error occurred then lda #EIO errno = EIO sta >errno dec err return -1 bra lb5 lb1 ldy wrTransferCount return the bytes read sty err lda nbuff if nbuff <> NULL then ora nbuff+2 beq lb2 ph4 nbuff dispose of the buffer jsl free lb2 anop lb5 plb restore B creturn 2:err wrRec dc i'4' Write record wrRefnum ds 2 wrDataBuffer ds 4 wrRequestCount ds 4 wrTransferCount ds 4 end \ No newline at end of file diff --git a/fcntl.macros b/fcntl.macros new file mode 100755 index 0000000..f2a68b1 --- /dev/null +++ b/fcntl.macros @@ -0,0 +1 @@ + MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND MACRO &lab csubroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta 1 .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+4+&work &totallen seta &totallen+&len &i seta &i+1 aif &i<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend MACRO &lab creturn &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+2 sta &worklen+&totallen+2 lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend MACRO &LAB ~SETM &LAB ANOP AIF C:&~LA,.B GBLB &~LA GBLB &~LI .B &~LA SETB S:LONGA &~LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) LONGA ON LONGI ON .A MEND MACRO &LAB ~RESTM &LAB ANOP AIF (&~LA+&~LI)=2,.I SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) AIF &~LA,.H LONGA OFF .H AIF &~LI,.I LONGI OFF .I MEND MACRO &LAB 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 &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB PH2 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB SHORT &A,&B LCLB &I LCLB &M &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 &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND MACRO &LAB OSREAD &DCB &LAB JSL $E100A8 DC I2'$2012' DC I4'&DCB' MEND MACRO &LAB OSCLOSE &DCB &LAB JSL $E100A8 DC I2'$2014' DC I4'&DCB' MEND MACRO &LAB OSSET_MARK &DCB &LAB JSL $E100A8 DC I2'$2016' DC I4'&DCB' MEND MACRO &LAB OSGET_MARK &DCB &LAB JSL $E100A8 DC I2'$2017' DC I4'&DCB' MEND MACRO &LAB OSSET_FILE_INFO &DCB &LAB JSL $E100A8 DC I2'$2005' DC I4'&DCB' MEND MACRO &LAB OSCLEAR_BACKUP &DCB &LAB JSL $E100A8 DC I2'$200B' DC I4'&DCB' MEND MACRO &LAB LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND MACRO &LAB OSCREATE &DCB &LAB JSL $E100A8 DC I2'$2001' DC I4'&DCB' MEND MACRO &LAB OSGET_FILE_INFO &DCB &LAB JSL $E100A8 DC I2'$2006' DC I4'&DCB' MEND MACRO &LAB OSOPEN &DCB &LAB JSL $E100A8 DC I2'$2010' DC I4'&DCB' MEND MACRO &LAB OSWRITE &DCB &LAB JSL $E100A8 DC I2'$2013' DC I4'&DCB' MEND MACRO &LAB OSSET_EOF &DCB &LAB JSL $E100A8 DC I2'$2018' DC I4'&DCB' MEND MACRO &LAB SUB4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~SETM AIF C:&M3,.A &C AMID "&M2",1,1 AIF "&C"<>"#",.A &C AMID "&M1",1,1 AIF "&C"="{",.A AIF "&C"="[",.A &C AMID "&M2",2,L:&M2-1 AIF &C>=65536,.A SEC ~LDA &M1 ~OP SBC,&M2 ~STA &M1 BCS ~&SYSCNT ~OP.H DEC,&M1 ~&SYSCNT ANOP AGO .C .A AIF C:&M3,.B LCLC &M3 &M3 SETC &M1 .B SEC ~LDA &M1 ~OP SBC,&M2 ~STA &M3 ~LDA.H &M1 ~OP.H SBC,&M2 ~STA.H &M3 .C ~RESTM MEND MACRO &LAB ~OP.H &OPC,&OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C &OPC &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" &OPC &OP MEXIT .E &OPC 2+&OP MEND MACRO &LAB ~LDA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C LDA &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" LDA &OP MEXIT .E LDA 2+&OP MEND MACRO &LAB ~STA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C STA &OP MEXIT .D STA 2+&OP MEND MACRO &LAB ~LDA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB LDA &OP MEND MACRO &LAB ~STA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB STA &OP MEND MACRO &LAB ~OP &OPC,&OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB &OPC &OP MEND \ No newline at end of file diff --git a/make b/make new file mode 100755 index 0000000..93d4b2e --- /dev/null +++ b/make @@ -0,0 +1 @@ +unset exit unset cc >&/work unset cg >&/work if {#} == 0 Newer obj/stdio.a stdio.asm equates.asm if {Status} != 0 set exit on echo assemble +e +t stdio.asm assemble +e +t stdio.asm unset exit end Newer obj/assert.a assert.asm if {Status} != 0 set exit on echo assemble +e +t assert.asm assemble +e +t assert.asm unset exit end for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal Newer obj/{i}.a {i}.asm if {Status} != 0 set exit on echo assemble +e +t {i}.asm assemble +e +t {i}.asm unset exit end end else set exit on for i assemble +e +t {i}.asm end end echo delete orcalib 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 for i in {list} echo makelib orcalib +obj/{i} makelib orcalib +obj/{i} end set echo on \ No newline at end of file diff --git a/obj/README.txt b/obj/README.txt new file mode 100644 index 0000000..e1e1427 --- /dev/null +++ b/obj/README.txt @@ -0,0 +1 @@ +This directory is used by the make file for storing object files. \ No newline at end of file diff --git a/orca.asm b/orca.asm new file mode 100755 index 0000000..814847a --- /dev/null +++ b/orca.asm @@ -0,0 +1 @@ + keep obj/orca mcopy orca.macros case on **************************************************************** * * ORCA - ORCA/C specific libraries * * This code implements the tables and subroutines needed to * support the ORCA/C library ORCA. * * March 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * **************************************************************** * ORCA start dummy segment end **************************************************************** * * char *commandline(void) * * Inputs: * ~CommandLine - address of the command line * **************************************************************** * commandline start ldx #0 lda ~COMMANDLINE ora ~COMMANDLINE+2 beq lb1 lda ~COMMANDLINE ldx ~COMMANDLINE+2 clc adc #8 bcc lb1 inx lb1 rtl end **************************************************************** * * void enddesk(void) * **************************************************************** * enddesk start jmp ~ENDDESK end **************************************************************** * * void endgraph(void) * **************************************************************** * endgraph start jmp ~ENDGRAPH end **************************************************************** * * char *shellid(void) * * Inputs: * ~CommandLine - address of the command line * **************************************************************** * shellid start ldx #0 return NULL if there is no command line lda >~COMMANDLINE ora >~COMMANDLINE+2 bne lb1 rtl lb1 lda >~COMMANDLINE+2 pha lda >~COMMANDLINE pha phd tsc tcd phb phk plb ldy #6 lb2 lda [3],Y sta id,Y dey dey bpl lb2 plb pld pla pla lda #id ldx #^id rtl id dc 8c' ',i1'0' end **************************************************************** * * void startdesk(int width) * **************************************************************** * startdesk start jmp ~STARTDESK end **************************************************************** * * void startgraph(int width) * **************************************************************** * startgraph start jmp ~STARTGRAPH end **************************************************************** * * int toolerror(void) * **************************************************************** * toolerror start lda >~TOOLERROR rtl end **************************************************************** * * int userid(void) * **************************************************************** * userid start lda >~USER_ID rtl end \ No newline at end of file diff --git a/orca.macros b/orca.macros new file mode 100755 index 0000000..eb175eb --- /dev/null +++ b/orca.macros @@ -0,0 +1 @@ + MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND \ No newline at end of file diff --git a/setjmp.asm b/setjmp.asm new file mode 100755 index 0000000..1bda629 --- /dev/null +++ b/setjmp.asm @@ -0,0 +1 @@ + keep obj/setjmp case on **************************************************************** * * SetJmp - Set jump library * * This code implements the subroutines needed to support the * standard C library SETJMP. * * January 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * **************************************************************** * SetJmp start dummy segment end **************************************************************** * * int setjmp(env) * jmp_buf env; * * Inputs: * env - pointer to the environment array * * Outputs: * Returns 0. * **************************************************************** * setjmp start env equ 4 pointer to array ret equ 1 return address tsc set up addressing phd tcd clc save the correct stack pointer adc #4 sta [env] ldy #2 save D lda 1,S sta [env],Y ldy #4 save the return address lda ret-1 sta [env],Y iny iny lda ret+1 sta [env],Y pld repair the stack phb plx ply pla pla phy phx plb lda #0 return 0 rtl end **************************************************************** * * void longjmp(env,status) * jmp_buf env; * int status; * * Inputs: * env - pointer to the environment array * status - status to return * **************************************************************** * longjmp start env equ 4 environment pointer status equ 8 status to return tsc set up the local stack frame tcd phb phk plb ldx status get the status bne lb1 inx lb1 ldy #6 get the env record lb2 lda [env],Y sta lenv,Y dey dey bpl lb2 plb lda >stackPtr reset the stack pointer tcs lda >ret+2 reset the return address sta 2,S lda >ret sta 0,S lda >dp reset the dp tcd txa return the status rtl lenv anop local copy of *env stackPtr ds 2 dp ds 2 ret ds 4 end \ No newline at end of file diff --git a/signal.asm b/signal.asm new file mode 100755 index 0000000..bb6d805 --- /dev/null +++ b/signal.asm @@ -0,0 +1 @@ + keep obj/signal mcopy signal.macros case on **************************************************************** * * signal - Asyncronous event signal handler * * April 1990 * Mike Westerfield * * Copyright 1990 * Byte Works, Inc. * **************************************************************** * SIGNAL start dummy segment copy equates.asm SIG_DFL gequ -3 SIG_IGN gequ -2 SIG_ERR gequ -1 SIGMAX gequ 6 maximum number of signals end **************************************************************** * * void (*signal(int sig, void (*func) (int)))(int); * * Set the interupt handler * * Inputs: * sig - signal number * func - signal handler * * Returns: * Pointer to the last signal handler; SIG_ERR if sig * is out of range. * **************************************************************** * signal start using signalCommon ptr equ 1 old sugnal handler csubroutine (2:sig,4:func),4 lla ptr,SIG_ERR assume we will find an error lda sig if (!sig in [1..6]) beq lb1 cmp #SIGMAX+1 blt lb2 lb1 lda #ERANGE errno = ERANGE sta >errno bra lb3 lb2 asl A get the old signal handler address asl A tax lda >subABRT-4,X sta ptr lda >subABRT-2,X sta ptr+2 lda func set the new signal handler address sta >subABRT-4,X lda func+2 sta >subABRT-2,X lb3 creturn 4:ptr end **************************************************************** * * int raise(int sig); * * Raise a signal. * * Inputs: * sig - signal number * * Returns: * 0 if successful, -1 if sig is out of range * **************************************************************** * raise start using signalCommon val equ 1 value to return csubroutine (2:sig),2 stz val no error lda sig if (!sig in [1..6]) beq lb1 cmp #SIGMAX+1 blt lb2 lb1 lda #-1 val = -1 sta val lda #ERANGE errno = ERANGE sta >errno bra lb3 lb2 asl A get the signal handler address asl A tax lda >subABRT-4,X tay lda >subABRT-2,X bmi lb3 skip if it is SIG_DFL or SIG_IGN short M set up the call address sta >jsl+3 long M tya sta >jsl+1 ph2 sig call the user signal handler jsl jsl jsl lb3 creturn 2:val end **************************************************************** * * signalCommon - data area for the signal unit * **************************************************************** * signalCommon privdata subABRT dc a4'SIG_DFL' subFPE dc a4'SIG_DFL' subILL dc a4'SIG_DFL' subINT dc a4'SIG_DFL' subSEGV dc a4'SIG_DFL' subTERM dc a4'SIG_DFL' end \ No newline at end of file diff --git a/signal.macros b/signal.macros new file mode 100755 index 0000000..ed492b5 --- /dev/null +++ b/signal.macros @@ -0,0 +1 @@ + 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 LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND MACRO &LAB 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 &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB PH2 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB SHORT &A,&B LCLB &I LCLB &M &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 &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND \ No newline at end of file diff --git a/smac b/smac new file mode 100755 index 0000000..b0a2323 --- /dev/null +++ b/smac @@ -0,0 +1 @@ + macro &lab cstr &s &lab dc c"&s",i1'0' mend MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND macro &lab csubroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta 1 .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+4+&work &totallen seta &totallen+&len &i seta &i+1 aif &i<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend macro &lab creturn &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+2 sta &worklen+&totallen+2 lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend \ No newline at end of file diff --git a/stdio.asm b/stdio.asm new file mode 100755 index 0000000..d897cb6 --- /dev/null +++ b/stdio.asm @@ -0,0 +1 @@ + keep stdio mcopy stdio.macros case on **************************************************************** * * StdIO - Standard I/O Library * * This code implements the tables and subroutines needed to * support the standard C library STDIO. * * November 1988 * Mike Westerfield * * Copyright 1988 * Byte Works, Inc. * * Note: Portions of this library appear in SysFloat. * **************************************************************** * StdIO start dummy segment copy equates.asm end **************************************************************** * * void clearerr(stream) * FILE *stream; * * Clears the error flag for the givin stream. * * Inputs: * stream - file to clear * **************************************************************** * clearerr start stream equ 4 input stream tsc phd tcd ph4 stream verify that stream exists jsl ~VerifyStream bcs lb1 ldy #FILE_flag clear the error flag lda [stream],Y and #$FFFF-_IOERR-_IOEOF sta [stream],Y lb1 pld lda 2,S sta 6,S pla sta 3,S pla rtl end **************************************************************** * * int fclose(stream) * FILE *stream; * * Inputs: * stream - pointer to the file buffer to close * * Outputs: * A - EOF for an error; 0 if there was no error * **************************************************************** * fclose start nameBuffSize equ 8*1024 pathname buffer size err equ 1 return value p equ 3 work pointer stdfile equ 7 is this a standard file? csubroutine (4:stream),8 phb phk plb lda #EOF assume we will get an error sta err ph4 stream verify that stream exists jsl ~VerifyStream jcs rts ph4 stream do any pending I/O jsl fflush tax jne rts stz stdfile not a standard file lda stream+2 bypass file disposal if the file is cmp #^stdin+4 one of the standard ones bne cl0 lda stream cmp #stdin+4 beq lb1 cmp #stdout+4 beq lb1 cmp #stderr+4 bne cl0 lb1 inc stdfile bra cl3a cl0 lla p,stderr+4 find the file record that points to this ldy #2 one cl1 lda [p] ora [p],Y jeq rts lda [p],Y tax lda [p] cmp stream bne cl2 cpx stream+2 beq cl3 cl2 stx p+2 sta p bra cl1 cl3 lda [stream] remove stream from the file list sta [p] lda [stream],Y sta [p],Y cl3a ldy #FILE_flag if the file was opened by tmpfile then lda [stream],Y and #_IOTEMPFILE beq cl3d ph4 #nameBuffSize p = malloc(nameBuffSize) jsl malloc grPathname = p sta p dsPathname = p+2 stx p+2 sta grPathname stx grPathname+2 clc adc #2 bcc cl3b inx cl3b sta dsPathname stx dsPathname+2 lda #nameBuffSize p->size = nameBuffSize sta [p] ldy #FILE_file clRefnum = grRefnum = stream->_file lda [stream],Y beq cl3e sta grRefnum GetRefInfoGS gr GetRefInfoGS(gr) bcs cl3c lda grRefnum OSClose(cl) sta clRefNum OSClose cl DestroyGS ds DestroyGS(ds) cl3c ph4 p free(p) jsl free bra cl3e else cl3d ldy #FILE_file close the file lda [stream],Y beq cl3e sta clRefNum OSClose cl cl3e ldy #FILE_flag if the buffer was allocated by fopen then lda [stream],Y and #_IOMYBUF beq cl4 ldy #FILE_base+2 dispose of the file buffer lda [stream],Y pha dey dey lda [stream],Y pha jsl free cl4 lda stdfile if this is not a standard file then bne cl5 ph4 stream dispose of the file buffer jsl free bra cl7 else cl5 add4 stream,#sizeofFILE-4,p reset the standard out stuff ldy #sizeofFILE-2 cl6 lda [p],Y sta [stream],Y dey dey cpy #2 bne cl6 cl7 stz err no error found rts plb creturn 2:err cl dc i'1' parameter block for OSclose clRefNum ds 2 gr dc i'3' parameter block for GetRefInfoGS grRefnum ds 2 ds 2 grPathname ds 4 ds dc i'1' parameter block for DestroyGS dsPathname ds 4 end **************************************************************** * * int feof(stream) * FILE *stream; * * Inputs: * stream - file to check * * Outputs: * Returns _IOEOF if an end of file has been reached; else * 0. * **************************************************************** * feof start stream equ 4 input stream tsc phd tcd ph4 stream verify that stream exists jsl ~VerifyStream ldx #_IOEOF bcs lb1 ldy #FILE_flag check for eof lda [stream],Y and #_IOEOF tax lb1 pld lda 2,S sta 6,S pla sta 3,S pla txa rtl end **************************************************************** * * int ferror(stream) * FILE *stream; * * Inputs: * stream - file to check * * Outputs: * Returns _IOERR if an end of file has been reached; else * 0. * **************************************************************** * ferror start stream equ 4 input stream tsc phd tcd ph4 stream verify that stream exists jsl ~VerifyStream ldx #_IOERR bcs lb1 ldy #FILE_flag return the error status lda [stream],Y and #_IOERR tax lb1 pld lda 2,S sta 6,S pla sta 3,S pla txa rtl end **************************************************************** * * int fflush(steam) * FILE *stream; * * Write any pending characters to the output file * * Inputs: * stream - file buffer * * Outputs: * A - EOF for an error; 0 if there was no error * **************************************************************** * fflush start err equ 1 return value sp equ 3 stream work pointer csubroutine (4:stream),6 phb phk plb lda stream if stream = nil then ora stream+2 bne fa3 lda stderr+4 sp = stderr.next sta sp lda stderr+6 sta sp+2 stz err err = 0 fa1 lda sp while sp <> nil ora sp+2 jeq rts ph4 sp fflush(sp); jsl fflush tax if returned value <> 0 then beq fa2 sta err err = returned value fa2 ldy #2 sp = sp^.next lda [sp],Y tax lda [sp] sta sp stx sp+2 bra fa1 endwhile fa3 lda #EOF assume there is an error sta err ph4 stream verify that stream exists jsl ~VerifyStream jcs rts ldy #FILE_flag if the mode is not writting, quit lda [stream],Y and #_IOWRT beq fl1 ldy #FILE_file set the reference number lda [stream],Y sta wrRefNum ldy #FILE_base set the starting location lda [stream],Y sta wrDataBuffer iny iny lda [stream],Y sta wrDataBuffer+2 sec set the # of bytes to write ldy #FILE_ptr lda [stream],Y sbc wrDataBuffer sta wrRequestCount iny iny lda [stream],Y sbc wrDataBuffer+2 sta wrRequestCount+2 ora wrRequestCount skip the write if there are no beq fl1 characters OSwrite wr write the info bcc fl1 ph4 stream jsr ~ioerror bra rts fl1 ldy #FILE_flag if the file is open for read/write then lda [stream],Y bit #_IORW beq fl3 bit #_IOREAD if the file is being read then beq fl2 ph4 stream use ftell to set the mark jsl ftell ldy #FILE_flag lda [stream],Y fl2 and #$FFFF-_IOWRT-_IOREAD turn off the reading and writing flags sta [stream],Y fl3 ph4 stream prepare file for output jsl ~InitBuffer stz err no error found rts plb creturn 2:err wr dc i'5' parameter block for OSwrite wrRefNum ds 2 wrDataBuffer ds 4 wrRequestCount ds 4 ds 4 dc i'1' end **************************************************************** * * int fgetc(stream) * FILE *stream; * * Read a character from a file * * Inputs: * stream - file to read from * * Outputs: * A - character read; EOF for an error * **************************************************************** * fgetc start getc entry c equ 1 character read p equ 3 work pointer csubroutine (4:stream),6 phb phk plb ph4 stream verify that stream exists jsl ~VerifyStream bcs lb0 ldy #FILE_flag quit with error if the end of file lda [stream],Y has been reached or an error has been and #_IOEOF+_IOERR encountered beq lb1 lb0 lda #EOF sta c brl gc9 lb1 ldy #FILE_pbk if there is a char in the putback buffer lda [stream],Y bmi lb2 and #$00FF return it sta c ldy #FILE_pbk+2 pop the putback buffer lda [stream],Y tax lda #$FFFF sta [stream],Y ldy #FILE_pbk txa sta [stream],Y brl gc9 lb2 ldy #FILE_file branch if this is a disk file lda [stream],Y bpl gc2 cmp #stdinID if stream = stdin then bne gc1 jsl SYSKEYIN get a character tax branch if not eof bne st1 lda #_IOEOF set EOF flag ora >stdin+4+FILE_flag sta >stdin+4+FILE_flag jsl SYSKEYIN read the closing cr lda #EOF return EOF st1 sta c brl gc9 gc1 ph4 stream else flag the error jsr ~ioerror lda #EOF sta c brl gc9 gc2 ldy #FILE_flag if the file is not read enabled then lda [stream],Y bit #_IOREAD bne gc2a bit #_IOWRT it is an error if it is write enabled bne gc1 bra gc2b gc2a ldy #FILE_cnt we're ready if there are characters lda [stream],Y left iny iny ora [stream],Y jne gc8 gc2b ldy #FILE_flag if input is unbuffered then lda [stream],Y bit #_IONBF beq gc3 stz rdDataBuffer+2 set up to read one char to c tdc clc adc #c sta rdDataBuffer lla rdRequestCount,1 bra gc4 gc3 ldy #FILE_base else set up to read a buffer full lda [stream],Y sta rdDataBuffer iny iny lda [stream],Y sta rdDataBuffer+2 ldy #FILE_size lda [stream],Y sta rdRequestCount iny iny lda [stream],Y sta rdRequestCount+2 gc4 ldy #FILE_file set the file reference number lda [stream],Y sta rdRefNum OSRead rd read the data bcc gc7 if there was a read error then ldy #FILE_flag cmp #$4C if it was eof then bne gc5 lda #_IOEOF set the EOF flag bra gc6 else gc5 lda #_IOERR set the error flag gc6 ora [stream],Y sta [stream],Y lda #EOF return EOF sta c brl gc9 gc7 ldy #FILE_flag we're done if the read is unbuffered lda [stream],Y and #_IONBF jne gc9 clc set the end of the file buffer ldy #FILE_end lda rdDataBuffer adc rdTransferCount sta [stream],Y iny iny lda rdDataBuffer+2 adc rdTransferCount+2 sta [stream],Y ldy #FILE_base reset the file pointer lda [stream],Y tax iny iny lda [stream],Y ldy #FILE_ptr+2 sta [stream],Y dey dey txa sta [stream],Y ldy #FILE_cnt set the # chars in the buffer lda rdTransferCount sta [stream],Y iny iny lda rdTransferCount+2 sta [stream],Y ldy #FILE_flag note that the file is read enabled lda [stream],Y ora #_IOREAD sta [stream],Y gc8 ldy #FILE_ptr get the next character lda [stream],Y sta p clc adc #1 sta [stream],Y iny iny lda [stream],Y sta p+2 adc #0 sta [stream],Y lda [p] and #$00FF sta c ldy #FILE_cnt dec the # chars in the buffer sec lda [stream],Y sbc #1 sta [stream],Y bcs gc8a iny iny lda [stream],Y dec A sta [stream],Y gc8a ldy #FILE_flag if the file is read/write lda [stream],Y and #_IORW beq gc9 ldy #FILE_cnt and the buffer is empty then lda [stream],Y iny iny ora [stream],Y bne gc9 ldy #FILE_flag note that no chars are left lda [stream],Y eor #_IOREAD sta [stream],Y gc9 lda c if c = \r then cmp #13 bne gc10 ldy #FILE_flag if this is a text file then lda [stream],Y and #_IOTEXT beq gc10 lda #10 sta c gc10 plb creturn 2:c ; ; Local data ; rd dc i'4' parameter block for OSRead rdRefNum ds 2 rdDataBuffer ds 4 rdRequestCount ds 4 rdTransferCount ds 4 end **************************************************************** * * char *fgets(s, n, stream) * char *s; * int n; * FILE *stream; * * Reads a line into the string s. * * Inputs: * s - location to put the string read. * n - size of the string * stream - file to read from * * Outputs: * Returns NULL if an EOF is encountered, placing any * characters read before the EOF into s. Returns S if * a line or part of a line is read. * **************************************************************** * fgets start RETURN equ 13 RETURN key code LF equ 10 newline disp equ 1 disp in s csubroutine (4:s,2:n,4:stream),2 ph4 stream verify that stream exists jsl ~VerifyStream bcs err1 ph4 stream quit with NULL if at EOF jsl feof tax beq lb0 err1 stz s stz s+2 bra rts lb0 stz disp no characters processed so far lda #0 sta [s] dec n leave room for the null terminator bmi err beq err lb1 ph4 stream get a character jsl fgetc tax quit with error if it is an EOF bpl lb2 err stz s stz s+2 bra rts lb2 cmp #RETURN if the char is a return, switch to lf bne lb3 lda #LF lb3 ldy disp place the char in the string sta [s],Y (null terminates automatically) inc disp cmp #LF quit if it was an LF beq rts dec n next character bne lb1 rts creturn 4:s end **************************************************************** * * int fgetpos(FILE *stream, fpos_t *pos); * * Inputs: * stream - pointer to stream to get position of * pos - pointer to location to place position * * Outputs: * A - 0 if successful; else -1 if not * errno - if unsuccessful, errno is set to EIO * **************************************************************** * fgetpos start err equ 1 error code csubroutine (4:stream,4:pos),2 ph4 stream get the position jsl ftell cmp #-1 if the position = -1 then bne lb1 cpx #-1 bne lb1 sta err err = -1 bra lb2 return lb1 sta [pos] else txa *pos = position ldy #2 sta [pos],Y stz err err = 0 lb2 anop endif creturn 2:err end **************************************************************** * * FILE *fopen(filename, type) * char *filename, *type; * * Inputs: * filename - pointer to the file name * type - pointer to the type string * * Outputs: * X-A - pointer to the file variable; NULL for an error * **************************************************************** * fopen start BIN equ 6 file type for BIN files TXT equ 4 file type for TXT files fileType equ 1 file type letter fileBuff equ 3 pointer to the file buffer buffStart equ 7 start of the file buffer OSname equ 11 pointer to the GS/OS file name ; ; initialization ; csubroutine (4:filename,4:type),14 phb use our data bank phk plb stz fileBuff no file so far stz fileBuff+2 lda [type] make sure the file type is in ['a','r','w'] and #$00FF sta fileType ldx #$0003 cmp #'a' beq cn1 ldx #$0002 cmp #'w' beq cn1 ldx #$0001 cmp #'r' beq cn1 lda #EINVAL sta >errno brl rt2 ; ; create a GS/OS file name ; cn1 stx opAccess set the access flags ph4 filename get the length of the name buffer jsl ~osname sta OSname stx OSname+2 ora OSname+2 jeq rt2 ; ; check for file modifier characters + and b ; lda #TXT we must open a new file - determine it's sta crFileType type by looking for the 'b' designator ldy #1 lda [type],Y jsr Modifier bcc cm1 iny lda [type],Y jsr Modifier cm1 anop ; ; open the file ; move4 OSname,opName try to open an existing file OSopen op bcc of2 lda fileType if the type is 'r', flag an error cmp #'r' bne of1 lda #ENOENT sta >errno brl rt1 of1 move4 OSname,crPathName create the file OScreate cr bcs errEIO OSopen op open the file bcc of2 errEIO lda #EIO sta >errno brl rt1 of2 lda fileType if the file type is 'w' then cmp #'w' bne of3 lda opRefNum reset it sta efRefNum OSSet_EOF ef bcc ar1 allow "not a block device error" cmp #$0058 beq ar1 bra errEIO flag the error of3 cmp #'a' else if the file type is 'a' then bne ar1 lda opRefNum sta gfRefNum sta smRefNum OSGet_EOF gf append to it bcs errEIO move4 gfEOF,smDisplacement OSSet_Mark sm bcs errEIO ; ; allocate and fill in the file record ; ar1 ph4 #sizeofFILE get space for the file record jsl malloc sta fileBuff stx fileBuff+2 ora fileBuff+2 beq ar2 ph4 #BUFSIZ get space for the file buffer jsl malloc sta buffStart stx buffStart+2 ora buffStart+2 bne ar3 ph4 fileBuff memory error jsl free ar2 lda #ENOMEM sta >errno brl rt1 ar3 ldy #2 insert the record right after stderr lda >stderr+4 sta [fileBuff] lda >stderr+6 sta [fileBuff],Y lda fileBuff sta >stderr+4 lda fileBuff+2 sta >stderr+6 lda buffStart set the start of the buffer ldy #FILE_base sta [fileBuff],Y iny iny lda buffStart+2 sta [fileBuff],Y ldy #FILE_ptr+2 sta [fileBuff],Y dey dey lda buffStart sta [fileBuff],Y ldy #FILE_size set the buffer size lda #BUFSIZ sta [fileBuff],Y iny iny lda #^BUFSIZ sta [fileBuff],Y ldy #1 set the flags lda [type],Y and #$00FF cmp #'+' beq ar3a cmp #'b' bne ar4 iny lda [type],Y and #$00FF cmp #'+' bne ar4 ar3a lda #_IOFBF+_IORW+_IOMYBUF bra ar6 ar4 lda fileType cmp #'r' beq ar5 lda #_IOFBF+_IOWRT+_IOMYBUF bra ar6 ar5 lda #_IOFBF+_IOREAD+_IOMYBUF ar6 ldy #FILE_flag ldx crFileType cpx #BIN beq ar6a ora #_IOTEXT ar6a sta [fileBuff],Y ldy #FILE_cnt no chars in buffer lda #0 sta [fileBuff],Y iny iny sta [fileBuff],Y ldy #FILE_pbk nothing in the putback buffer lda #$FFFF sta [fileBuff],Y ldy #FILE_pbk+2 sta [fileBuff],Y ldy #FILE_file set the file ID lda opRefNum sta [fileBuff],Y ; ; return the result ; rt1 ph4 OSname dispose of the file name buffer jsl free rt2 plb restore caller's data bank creturn 4:fileBuff return ; ; Modifier - local subroutine to check modifier character ; ; Returns: C=0 if no modifier found, else C=1 ; Modifier and #$00FF beq md3 cmp #'+' bne md1 lda #$0003 sta opAccess sec rts md1 cmp #'b' bne md2 lda #BIN sta crFileType md2 sec rts md3 clc rts ; ; local data areas ; op dc i'3' parameter block for OSopen opRefNum ds 2 opName ds 4 opAccess ds 2 gf dc i'2' GetEOF record gfRefNum ds 2 gfEOF ds 4 sm dc i'3' SetMark record smRefNum ds 2 smBase dc i'0' smDisplacement ds 4 ef dc i'3' parameter block for OSSet_EOF efRefNum ds 2 dc i'0' dc i4'0' cr dc i'7' parameter block for OScreate crPathName ds 4 dc i'$C3' crFileType ds 2 dc i4'0' dc i'1' dc i4'0' dc i4'0' dc r'fgetc' dc r'fputc' dc r'fclose' end **************************************************************** * * FILE *freopen(filename, type, stream) * char *filename, *type; * FILE *stream; * * Inputs: * filename - pointer to the file name * type - pointer to the type string * stream - file buffer to use * * Outputs: * X-A - pointer to the file variable; NULL for an error * **************************************************************** * freopen start BIN equ 6 file type for BIN files TXT equ 4 file type for TXT files fileType equ 1 file type letter buffStart equ 3 start of the file buffer OSname equ 7 pointer to the GS/OS file name fileBuff equ 11 file buffer to return ; ; initialization ; csubroutine (4:filename,4:type,4:stream),14 phb use our data bank phk plb stz fileBuff the open is not legal, yet stz fileBuff+2 ph4 stream verify that stream exists jsl ~VerifyStream jcs rt2 lda [type] make sure the file type is in ['a','r','w'] and #$00FF sta fileType cmp #'a' beq cl1 cmp #'w' beq cl1 cmp #'r' beq cl1 lda #EINVAL sta >errno brl rt2 ; ; close the old file ; cl1 ldy #FILE_file branch if the file is not a disk file lda [stream],Y bmi cn1 ph4 stream do any pending I/O jsl fflush ldy #FILE_file close the file lda [stream],Y sta clRefNum OSclose cl ldy #FILE_flag if the buffer was allocated by fopen then lda [stream],Y and #_IOMYBUF beq cn1 ldy #FILE_base+2 dispose of the file buffer lda [stream],Y pha dey dey lda [stream],Y pha jsl free ; ; create a GS/OS file name ; cn1 ph4 filename get the length of the name buffer jsl ~osname sta OSname stx OSname+2 ora OSname+2 jeq rt2 ; ; open the file ; lda #TXT we must open a new file - determine it's sta crFileType type by looking for the 'b' designator ldy #1 lda [type],Y and #$00FF cmp #'+' bne nl1 iny lda [type],Y and #$00FF nl1 cmp #'b' bne nl2 lda #BIN sta crFileType nl2 move4 OSname,opName try to open an existing file OSopen op bcc of2 lda fileType if the type is 'r', flag an error cmp #'r' bne of1 errEIO ph4 stream jsr ~ioerror brl rt1 of1 move4 OSname,crPathName create the file OScreate cr bcs errEIO OSopen op open the file bcs errEIO of2 lda fileType if the file type is 'w', reset it cmp #'w' bne ar1 lda opRefNum sta efRefNum OSSet_EOF ef bcs errEIO ; ; fill in the file record ; ar1 ph4 #BUFSIZ get space for the file buffer jsl malloc sta buffStart stx buffStart+2 ora buffStart+2 bne ar3 lda #ENOMEM memory error sta >errno brl rt1 ar3 move4 stream,fileBuff set the file buffer address lda buffStart set the start of the buffer ldy #FILE_base sta [fileBuff],Y iny iny lda buffStart+2 sta [fileBuff],Y ldy #FILE_ptr+2 sta [fileBuff],Y dey dey lda buffStart sta [fileBuff],Y ldy #FILE_size set the buffer size lda #BUFSIZ sta [fileBuff],Y iny iny lda #^BUFSIZ sta [fileBuff],Y ldy #1 set the flags lda [type],Y and #$00FF cmp #'+' bne ar4 lda #_IOFBF+_IORW+_IOMYBUF bra ar6 ar4 lda fileType cmp #'r' beq ar5 lda #_IOFBF+_IOWRT+_IOMYBUF bra ar6 ar5 lda #_IOFBF+_IOREAD+_IOMYBUF ar6 ldy #FILE_flag ldx crFileType cpx #BIN beq ar6a ora #_IOTEXT ar6a sta [fileBuff],Y ldy #FILE_cnt no chars in buffer lda #0 sta [fileBuff],Y iny iny sta [fileBuff],Y ldy #FILE_pbk nothing in the putback buffer lda #$FFFF sta [fileBuff],Y ldy #FILE_pbk+2 sta [fileBuff],Y ldy #FILE_file set the file ID lda opRefNum sta [fileBuff],Y ; ; return the result ; rt1 ph4 OSname dispose of the file name buffer jsl free rt2 plb restore caller's data bank creturn 4:fileBuff return ; ; local data areas ; op dc i'2' parameter block for OSopen opRefNum ds 2 opName ds 4 ef dc i'3' parameter block for OSSet_EOF efRefNum ds 2 dc i'0' dc i4'0' cr dc i'7' parameter block for OScreate crPathName ds 4 dc i'$C3' crFileType ds 2 dc i4'0' dc i'1' dc i4'0' dc i4'0' cl dc i'1' parameter block for OSclose clRefNum ds 2 ; ; Patch for standard out ; stdoutFile jmp stdoutPatch stdoutPatch phb plx ply pla pha pha pha phy phx plb lda >stdout sta 6,S lda >stdout+2 sta 8,S brl fputc ; ; Patch for standard in ; stdinFile jmp stdinPatch stdinPatch ph4 #stdin+4 jsl fgetc rtl end **************************************************************** * * int fprintf(stream, char *format, additional arguments) * * Print the format string to standard out. * **************************************************************** * fprintf start using ~printfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta stream pla sta stream+2 phy restore return address/data bank phx plb lda >stream+2 verify that stream exists pha lda >stream pha jsl ~VerifyStream bcc lb1 lda #EIO sta >errno lda #EOF bra rts lb1 lda #put set up output routine sta >~putchar+4 lda #>put sta >~putchar+5 tsc find the argument list address clc adc #8 sta >args pea 0 pha jsl ~printf call the formatter sec compute the space to pull from the stack pla sbc >args clc adc #4 sta >args pla phb remove the return address plx ply tsc update the stack pointer clc adc >args tcs phy restore the return address phx plb lda >~numChars return the value rtl return put phb remove the char from the stack phk plb plx pla ply pha phx plb lda stream+2 write to a file pha lda stream pha phy jsl fputc rts rtl args ds 2 original argument address stream ds 4 stream address end **************************************************************** * * int fputc(c, stream) * char c; * FILE *stream; * * Write a character to a file * * Inputs: * c - character to write * stream - file to write to * * Outputs: * A - character written; EOF for an error * **************************************************************** * fputc start putc entry c2 equ 5 output char p equ 1 work pointer csubroutine (2:c,4:stream),6 ph4 stream verify that stream exists jsl ~VerifyStream bcs lb0 ldy #FILE_flag quit with error if the end of file lda [stream],Y has been reached or an error has been and #_IOEOF+_IOERR encountered beq lb1 lb0 lda #EOF sta c brl pc8 lb1 ldy #FILE_flag if the file is not prepared for lda [stream],Y writing then bit #_IOWRT bne lb2 bit #_IOREAD if it is being read then bne pc2 flag the error ora #_IOWRT set the writting flag sta [stream],Y lb2 ldy #FILE_file branch if this is a disk file lda [stream],Y bpl pc3 cmp #stdoutID if stream = stdout then bne pc1 ph2 c write the character jsl ~stdout brl pc8 pc1 cmp #stderrID else if stream = stderr then bne pc2 lda c (for \n, write \r) cmp #10 bne pc1a lda #13 pc1a pha write to error out jsl SYSCHARERROUT brl pc8 pc2 ph4 stream else stream = stdin; flag the error jsr ~ioerror lda #EOF sta c brl pc8 pc3 lda c set the output char sta c2 ldy #FILE_flag if this is a text file then lda [stream],Y and #_IOTEXT beq pc3a lda c if the char is lf then cmp #10 bne pc3a lda #13 substitute a cr sta c2 pc3a ldy #FILE_cnt if the buffer is full then lda [stream],Y iny iny ora [stream],Y bne pc4 pc3b ldy #FILE_flag purge it lda [stream],Y pha ph4 stream jsl fflush ldy #FILE_flag pla sta [stream],Y pc4 ldy #FILE_ptr deposit the character in the buffer, lda [stream],Y incrementing the buffer pointer sta p clc adc #1 sta [stream],Y iny iny lda [stream],Y sta p+2 adc #0 sta [stream],Y short M lda c2 sta [p] long M ldy #FILE_cnt dec the buffer counter sec lda [stream],Y sbc #1 sta [stream],Y bcs pc5 iny iny lda [stream],Y dec A sta [stream],Y pc5 ldy #FILE_cnt if the buffer is full lda [stream],Y iny iny ora [stream],Y beq pc7 lda c2 or if (c = '\n') and (flag & _IOLBF) cmp #13 beq pc5a cmp #10 bne pc6 pc5a ldy #FILE_flag lda [stream],Y and #_IOLBF bne pc7 pc6 ldy #FILE_flag or is flag & _IONBF then lda [stream],Y and #_IONBF beq pc8 pc7 ldy #FILE_flag flush the stream lda [stream],Y pha ph4 stream jsl fflush ldy #FILE_flag pla sta [stream],Y pc8 creturn 2:c end **************************************************************** * * int fputs(s,stream) * char *s; * * Print the string to standard out. * **************************************************************** * fputs start err equ 1 return code csubroutine (4:s,4:stream),2 ph4 stream verify that stream exists jsl ~VerifyStream lda #EOF sta err bcs lb4 stz err no error so far bra lb2 skip initial increment lb1 inc4 s next char lb2 ph4 stream push the stream, just in case... lda [s] exit loop if at end of string and #$00FF beq lb3 pha push char to write jsl fputc write the character cmp #EOF loop if no error bne lb1 sta err set the error code bra lb4 lb3 pla remove stream from the stack pla lb4 creturn 2:err end **************************************************************** * * size_t fread(ptr, element_size, count, stream) * void *ptr; * size_t element_size; * size_t count; * FILE *stream; * * Reads element*count bytes to stream, putting the bytes in * ptr. * * Inputs: * ptr - location to store the bytes read * element_size - size of each element * count - number of elements * stream - file to read from * * Outputs: * Returns the number of elements actually read. * **************************************************************** * fread start temp equ 1 csubroutine (4:ptr,4:element_size,4:count,4:stream),4 phb phk plb stz rdTransferCount set the # of elements read stz rdTransferCount+2 ph4 stream verify that stream exists jsl ~VerifyStream jcs lb6 ph4 stream reset file pointer jsl ~SetFilePointer mul4 element_size,count,rdRequestCount set the # of bytes lda rdRequestCount quit if the request count is 0 ora rdRequestCount+2 jeq lb6 ldy #FILE_file set the file ID number lda [stream],Y bpl lb2 branch if it is a file cmp #stdinID if the file is stdin then jne lb6 stz rdTransferCount stz rdTransferCount+2 lda >stdin+4+FILE_flag and #_IOEOF jne lb6 lb1 jsl SYSKEYIN read the bytes tax branch if not eof bne lb1a lda #_IOEOF set EOF flag ora >stdin+4+FILE_flag sta >stdin+4+FILE_flag jsl SYSKEYIN read the closing cr brl lb6 lb1a short M set character sta [ptr] long M inc4 rdTransferCount inc4 ptr dec4 rdRequestCount lda rdRequestCount ora rdRequestCount+2 bne lb1 bra lb6 lb2 sta rdRefNum set the reference number move4 ptr,rdDataBuffer set the start address OSRead rd read the bytes bcc lb5 cmp #$4C if the error was $4C then bne lb3 jsr SetEOF set the EOF flag bra lb5 lb3 ph4 stream I/O error jsr ~ioerror ! set the # records read lb5 div4 rdTransferCount,element_size lda count if there were too few elements read then cmp rdTransferCount bne lb5a lda count+2 cmp rdTransferCount+2 beq lb6 lb5a jsr SetEOF set the EOF flag lb6 move4 rdTransferCount,temp plb creturn 4:temp ; ; Local data ; rd dc i'5' parameter block for OSRead rdRefNum ds 2 rdDataBuffer ds 4 rdRequestCount ds 4 rdTransferCount ds 4 dc i'1' ; ; Set the EOF flag ; SetEOF ldy #FILE_flag set the eof flag lda [stream],Y ora #_IOEOF sta [stream],Y rts end **************************************************************** * * int fscanf(stream, format, additional arguments) * char *format; * FILE *stream; * * Read a string from a string. * **************************************************************** * fscanf start using ~scanfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta stream pla sta stream+2 phy restore return address/data bank phx plb ph4 >stream verify that stream exists jsl ~VerifyStream bcc lb1 lda #EOF rtl lb1 lda #get set up our routines sta >~getchar+10 lda #>get sta >~getchar+11 lda #unget sta >~putback+12 lda #>unget sta >~putback+13 brl ~scanf get ph4 stream get a character jsl fgetc rtl unget ldx stream+2 put a character back phx ldx stream phx pha jsl ungetc rtl stream ds 4 end **************************************************************** * * int fseek(stream,offset,wherefrom) * FILE *stream; * long int offset; * int wherefrom; * * Change the read/write location for the stream. * * Inputs: * stream - file to change * offset - position to move to * wherefrom - move relative to this location * * Outputs: * Returns non-zero for error * **************************************************************** * fseek start jmp __fseek end __fseek start err equ 1 return value csubroutine (4:stream,4:offset,2:wherefrom),2 phb phk plb lda #-1 assume we will get an error sta err ph4 stream verify that stream exists jsl ~VerifyStream jcs rts ph4 stream purge the file jsl fflush ldy #FILE_file set the file reference lda [stream],Y jmi lb6 sta gpRefNum sta spRefNum lda wherefrom if position is relative to the end then cmp #SEEK_END bne lb2 OSGet_EOF gp get the eof jcs erEIO add4 offset,gpPosition add it to the offset bra lb3 lb2 cmp #SEEK_CUR else if relative to current position then bne lb3 ph4 stream get the current position jsl ftell clc add it to the offset adc offset sta offset txa adc offset+2 sta offset+2 lb3 OSGet_EOF gp get the end of the file jcs erEIO lda offset+2 if the offset is >= EOF then cmp gpPosition+2 bne lb4 lda offset cmp gpPosition lb4 ble lb5 move4 offset,spPosition extend the file OSSet_EOF sp bcs erEIO lb5 move4 offset,spPosition OSSet_Mark sp bcs erEIO lb6 ldy #FILE_flag clear the EOF , READ, WRITE flags lda #$FFFF-_IOEOF-_IOREAD-_IOWRT and [stream],Y sta [stream],Y ldy #FILE_cnt clear the character count lda #0 sta [stream],Y iny iny sta [stream],Y ldy #FILE_base+2 reset the file pointer lda [stream],Y tax dey dey lda [stream],Y ldy #FILE_ptr sta [stream],Y iny iny txa sta [stream],Y ldy #FILE_pbk nothing in the putback buffer lda #$FFFF sta [stream],Y ldy #FILE_pbk+2 sta [stream],Y stz err rts plb creturn 2:err erEIO ph4 stream flag an IO error jsr ~ioerror bra rts gp dc i'2' parameter block for OSGet_EOF gpRefNum ds 2 gpPosition ds 4 sp dc i'3' parameter block for OSSet_EOF spRefNum ds 2 and OSSet_Mark dc i'0' spPosition ds 4 end **************************************************************** * * int fsetpos(FILE *stream, fpos_t *pos); * * Inputs: * stream - pointer to stream to set position of * pos - pointer to location to set position * * Outputs: * A - 0 if successful; else -1 if not * errno - if unsuccessful, errno is set to EIO * **************************************************************** * fsetpos start err equ 1 error code csubroutine (4:stream,4:pos),2 ph2 #SEEK_SET ldy #2 lda [pos],Y pha lda [pos] pha ph4 stream jsl fseek sta err creturn 2:err end **************************************************************** * * long int ftell(stream) * FILE *stream; * * Find the number of characters already passed in the file. * * Inputs: * stream - strem to find the location in * * Outputs: * Returns the position, or -1L for an error. * **************************************************************** * ftell start pos equ 1 position in the file csubroutine (4:stream),4 phb phk plb lda #-1 assume an error sta pos sta pos+2 ph4 stream verify that stream exists jsl ~VerifyStream jcs rts ldy #FILE_flag if the file is being written then lda [stream],Y bit #_IOWRT beq lb0 ph4 stream do any pending writes jsl fflush tax bne rts lb0 ldy #FILE_file get the file's mark lda [stream],Y sta gmRefNum OSGet_Mark gm bcc lb1 ph4 stream jsr ~ioerror bra rts lb1 move4 gmPosition,pos set the position ldy #FILE_flag if the file is being read then lda [stream],Y bit #_IOREAD beq rts sec subtract off characters left to be ldy #FILE_cnt read lda pos sbc [stream],Y sta pos iny iny lda pos+2 sbc [stream],Y sta pos+2 ldy #FILE_pbk dec pos by 1 for each char in the lda [stream],Y putback buffer then bmi lb2 dec4 pos ldy #FILE_pbk+2 lda [stream],Y bmi lb2 dec4 pos lb2 ldy #FILE_file set the file's mark lda [stream],Y sta spRefNum move4 pos,spPosition OSSet_Mark sp rts plb creturn 4:pos sp dc i'3' parameter block for OSSet_Mark spRefNum ds 2 dc i'0' spPosition ds 4 gm dc i'2' parameter block for OSGetMark gmRefNum ds 2 gmPosition ds 4 end **************************************************************** * * size_t fwrite(ptr, element_size, count, stream) * void *ptr; * size_t element_size; * size_t count; * FILE *stream; * * Writes element*count bytes to stream, taking the bytes from * ptr. * * Inputs: * ptr - pointer to the bytes to write * element_size - size of each element * count - number of elements * stream - file to write to * * Outputs: * Returns the number of elements actually written. * **************************************************************** * fwrite start csubroutine (4:ptr,4:element_size,4:count,4:stream),0 phb phk plb stz wrTransferCount set the # of elements written stz wrTransferCount+2 ph4 stream verify that stream exists jsl ~VerifyStream jcs lb6 mul4 element_size,count,wrRequestCount set the # of bytes lda wrRequestCount quit if the request count is 0 ora wrRequestCount+2 jeq lb6 ldy #FILE_file set the file ID number lda [stream],Y bpl lb4 branch if it is a file cmp #stdoutID if the file is stdout then bne lb2 lb1 lda [ptr] write the bytes pha jsl ~stdout inc4 ptr dec4 wrRequestCount lda wrRequestCount ora wrRequestCount+2 bne lb1 move4 count,wrTransferCount set the # of elements written bra lb6 lb2 cmp #stderrID if the file is stderr then bne lb6 lb3 lda [ptr] write the bytes pha jsl SYSCHARERROUT inc4 ptr dec4 wrRequestCount lda wrRequestCount ora wrRequestCount+2 bne lb3 move4 count,wrTransferCount set the # of elements written bra lb6 lb4 sta wrRefNum set the reference number ph4 stream purge the file jsl fflush move4 ptr,wrDataBuffer set the start address OSWrite wr write the bytes bcc lb5 ph4 stream I/O error jsr ~ioerror ! set the # records written lb5 div4 wrTransferCount,element_size,count lb6 plb creturn 4:count return wr dc i'4' parameter block for OSWrite wrRefNum ds 2 wrDataBuffer ds 4 wrRequestCount ds 4 wrTransferCount ds 4 end **************************************************************** * * int getchar() * * Read a character from standard in. No errors are possible. * * The character read is returned in A. The null character * is mapped into EOF. * **************************************************************** * getchar start ; ; Determine which method to use ; lda >stdin use fgetc if stdin has changed cmp #stdin+4 bne fl1 lda >stdin+2 cmp #^stdin+4 bne fl1 lda >stdin+4+FILE_file use fgetc if stdio has a bogus file ID cmp #stdinID bne fl1 ; ; get the char from the keyboard ; lda >stdin+4+FILE_pbk if there is a char in the putback bmi lb1 buffer then and #$00FF save it in X tax lda >stdin+4+FILE_pbk+2 pop the buffer sta >stdin+4+FILE_pbk lda #$FFFF sta >stdin+4+FILE_pbk+2 txa restore the char bra lb2 lb1 jsl SYSKEYIN else get a char from the keyboard tax branch if not eof bne lb2 lda #_IOEOF set EOF flag ora >stdin+4+FILE_flag sta >stdin+4+FILE_flag jsl SYSKEYIN read the closing cr lda #EOF return EOF lb2 cmp #13 if the char is \r then bne lb3 lda #10 return \n lb3 rtl ; ; Call fgetc ; fl1 ph4 >stdin dc i1'$22',s3'fgetc' jsl fgetc rtl end **************************************************************** * * char *gets(s) * char s; * * Read a line from standard in. * * Inputs: * s - string to read to. * * Outputs: * Returns a pointer to the string * **************************************************************** * gets start LF equ 10 \n key code disp equ 1 disp in s csubroutine (4:s),2 stz disp no characters processed so far lb1 jsl getchar get a character tax quit with error if it is an EOF bpl lb2 stz s stz s+2 bra rts lb2 cmp #LF quit if it was a \n beq lb3 ldy disp place the char in the string sta [s],Y inc disp bra lb1 next character lb3 ldy disp null terminate short M lda #0 sta [s],Y long M rts creturn 4:s end **************************************************************** * * void perror(s); * char *s; * * Prints the string s and the error in errno to standard out. * **************************************************************** * perror start maxErr equ ENOSPC max error in sys_errlist s equ 4 string address tsc set up DP addressing phd tcd ph4 >stderr write the error string ph4 s jsl fputs ph4 >stderr write ': ' pea ':' jsl fputc ph4 >stderr pea ' ' jsl fputc ph4 >stderr write the error message lda >errno cmp #maxErr+1 blt lb1 lda #0 lb1 asl A asl A tax lda >sys_errlist+2,X pha lda >sys_errlist,X pha jsl fputs ph4 >stderr write lf, cr pea 10 jsl fputc ph4 >stderr pea 13 jsl fputc pld remove parm and return lda 2,S sta 6,S pla sta 3,S pla rtl end **************************************************************** * * int printf(format, additional arguments) * char *format; * * Print the format string to standard out. * **************************************************************** * printf start using ~printfCommon lda #putchar sta >~putchar+4 lda #>putchar sta >~putchar+5 tsc find the argument list address clc adc #8 sta >args pea 0 pha jsl ~printf call the formatter sec compute the space to pull from the stack pla sbc >args clc adc #4 sta >args pla phb remove the return address plx ply tsc update the stack pointer clc adc >args tcs phy restore the return address phx plb lda >~numChars return the value rtl return args ds 2 original argument address end **************************************************************** * * int putchar(c) * char c; * * Print the character to standard out. The character is * returned. No errors are possible. * * The character \n is automatically followed by a $0D, which * causes the IIGS to respond the way \n works on other machines. * **************************************************************** * putchar start using ~printfCommon _n equ 10 linefeed character _r equ 13 RETURN key code ; ; Determine which method to use ; lda >stdout use fgetc if stdin has changed cmp #stdout+4 bne fl1 lda >stdout+1 cmp #>stdout+4 bne fl1 lda >stdout+4+FILE_file use fgetc if stdio has a bogus file ID cmp #stdoutID bne fl1 ; ; Write to the CRT ; ~stdout entry php remove the parameter from the stack plx ply pla phy phx plp pha save the parameter cmp #_n if this is a line feed, do a bne lb1 carriage return, instead. lda #_r lb1 pha write the character jsl SYSCHAROUT pla return the input character rtl ; ; Use fputc ; fl1 ph4 >stdout lda 8,S pha dc i1'$22' jsl fputc dc s3'fputc' phb plx ply pla phy phx plb rtl end **************************************************************** * * int puts(s) * char *s; * * Print the string to standard out. A zero is returned; no * error is possible. * **************************************************************** * puts start LINEFEED equ 10 linefeed character err equ 1 erro code csubroutine (4:s),2 stz err no error lb1 lda [s] print the string and #$00FF beq lb2 pha jsl putchar inc4 s bra lb1 lb2 pea LINEFEED print the linefeed jsl putchar creturn 2:err end **************************************************************** * * int remove(filename) * char *filename; * * Inputs: * filename - name of the file to delete * * Outputs: * Returns zero if successful, GS/OS error code if not. * **************************************************************** * remove start err equ 1 return code csubroutine (4:filename),2 phb phk plb ph4 filename convert to a GS/OS file name jsl ~osname sta dsPathName stx dsPathName+2 ora dsPathName+2 bne lb1 lda #$FFFF sta err bra lb2 lb1 OSDestroy ds delete the file sta err set the error code bcc lb1a lda #ENOENT sta >errno lb1a ph4 dsPathName dispose of the name buffer jsl free lb2 plb creturn 2:err ds dc i'1' parameter block for OSDestroy dsPathName ds 4 end **************************************************************** * * int rename(oldname,newname) * char *filename; * * Inputs: * filename - name of the file to delete * * Outputs: * Returns zero if successful, GS/OS error code if not. * **************************************************************** * rename start err equ 1 return code csubroutine (4:oldname,4:newname),2 phb phk plb ph4 oldname convert oldname to a GS/OS file name jsl ~osname sta cpPathName stx cpPathName+2 ora cpPathName+2 bne lb1 lda #$FFFF sta err bra lb4 lb1 ph4 newname convert newname to a GS/OS file name jsl ~osname sta cpNewPathName stx cpNewPathName+2 ora cpNewPathName+2 bne lb2 lda #$FFFF sta err bra lb3 lb2 OSChange_Path cp rename the file sta err set the error code ph4 cpNewPathName dispose of the new name buffer jsl free lb3 ph4 cpPathName dispose of the old name buffer jsl free lb4 plb creturn 2:err cp dc i'2' parameter block for OSChange_Path cpPathName ds 4 cpNewPathName ds 4 end **************************************************************** * * int rewind(stream) * FILE *stream; * * Change the read/write location for the stream. * * Inputs: * stream - file to change * * Outputs: * Returns non-zero for error * **************************************************************** * rewind start err equ 1 return code csubroutine (4:stream),2 ph2 #SEEK_SET ph4 #0 ph4 stream jsl __fseek sta err creturn 2:err end **************************************************************** * * int scanf(format, additional arguments) * char *format; * * Read a string from standard in. * **************************************************************** * scanf start using ~scanfCommon lda #getchar sta >~getchar+10 lda #>getchar sta >~getchar+11 lda #unget sta >~putback+12 lda #>unget sta >~putback+13 brl ~scanf unget tax lda >stdin+2 pha lda >stdin pha phx jsl ungetc rtl end **************************************************************** * * int setbuf (FILE *stream, char *) * * Set the buffer type and size. * * Inputs: * stream - file to set the buffer for * buf - buffer to use, or NULL for automatic buffer * * Outputs: * Returns zero if successful, -1 for an error * **************************************************************** * setbuf start err equ 1 return code csubroutine (4:stream,4:buf),2 lda buf ora buf+2 bne lb1 ph4 #0 ph2 #_IONBF bra lb2 lb1 ph4 #BUFSIZ ph2 #_IOFBF lb2 ph4 buf ph4 stream jsl __setvbuf sta err creturn 2:err end **************************************************************** * * int setvbuf(stream,buf,type,size) * FILE *stream; * char *buf; * int type,size; * * Set the buffer type and size. * * Inputs: * stream - file to set the buffer for * buf - buffer to use, or NULL for automatic buffer * type - buffer type; _IOFBF, _IOLBF or _IONBF * size - size of the buffer * * Outputs: * Returns zero if successful, -1 for an error * **************************************************************** * setvbuf start jmp __setvbuf end __setvbuf start err equ 1 return code csubroutine (4:stream,4:buf,2:type,4:size),2 phb phk plb lda #-1 assume we will get an error sta err ph4 stream verify that stream exists jsl ~VerifyStream jcs rts ldy #FILE_ptr make sure the buffer is not in use lda [stream],Y ldy #FILE_base cmp [stream],Y jne rts ldy #FILE_ptr+2 lda [stream],Y ldy #FILE_base+2 cmp [stream],Y jne rts cb1 lda size if size is zero then ora size+2 bne lb1 lda type if ~(type & _IONBF) then and #_IONBF jeq rts flag the error inc size else size = 1 lb1 lda type error if type is not one of these cmp #_IOFBF beq lb2 cmp #_IOLBF beq lb2 cmp #_IONBF bne rts lb2 lda buf if the buffer is not supplied by the ora buf+2 caller then bne sb1 ph4 size allocate a buffer jsl malloc sta buf stx buf+2 ora buf+2 quit if there was no memory beq rts lda type set the buffer flag ora #_IOMYBUF sta type sb1 ldy #FILE_flag if the buffer was allocated by fopen then lda [stream],Y bit #_IOMYBUF beq sb2 ldy #FILE_base+2 dispose of the old buffer lda [stream],Y pha dey dey lda [stream],Y pha jsl free sb2 ldy #FILE_flag clear the old buffering flags lda #$FFFF-_IOFBF-_IOLBF-_IONBF-_IOMYBUF and [stream],Y ora type set the new buffer flag sta [stream],Y lda buf set the start of the buffer ldy #FILE_base sta [stream],Y iny iny lda buf+2 sta [stream],Y ldy #FILE_ptr+2 sta [stream],Y dey dey lda buf sta [stream],Y ldy #FILE_size set the buffer size lda size sta [stream],Y iny iny lda size+2 sta [stream],Y ldy #FILE_cnt no chars in buffer lda #0 sta [stream],Y iny iny sta [stream],Y stz err no error rts plb creturn 2:err end **************************************************************** * * int sprintf(s, format, additional arguments) * char *format; * * Print the format string to a string. * **************************************************************** * sprintf start using ~printfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta string pla sta string+2 phy restore return address/data bank phx plb lda #put set up output routine sta >~putchar+4 lda #>put sta >~putchar+5 tsc find the argument list address clc adc #8 sta >args pea 0 pha jsl ~printf call the formatter sec compute the space to pull from the stack pla sbc >args clc adc #4 sta >args pla phb remove the return address plx ply tsc update the stack pointer clc adc >args tcs phy restore the return address phx plb lda >~numChars return the value rtl return put phb remove the char from the stack plx pla ply pha phx plb ldx string+2 write to a file phx ldx string phx phd tsc tcd tya and #$00FF sta [3] pld pla pla phb phk plb inc4 string plb rtl args ds 2 original argument address string ds 4 string address end **************************************************************** * * int sscanf(s, format, additional arguments) * char *s, *format; * * Read a string from a string. * **************************************************************** * sscanf start using ~scanfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta string pla sta string+2 phy restore return address/data bank phx plb lda #get set up our routines sta >~getchar+10 lda #>get sta >~getchar+11 lda #unget sta >~putback+12 lda #>unget sta >~putback+13 brl ~scanf get ph4 string get a character phd tsc tcd lda [3] and #$00FF bne gt1 dec4 string lda #EOF gt1 pld ply ply inc4 string rtl unget cmp #EOF put a character back beq ug1 dec4 string ug1 rtl string ds 4 end **************************************************************** * * sys_errlist - array of pointers to messages * **************************************************************** * sys_errlist start dc a4'EUNDEF' 0th message is undefined dc a4'EDOM' (if the size of this list changes, dc a4'ERANGE' change sys_nerr in VARS.ASM) dc a4'ENOMEM' dc a4'ENOENT' dc a4'EIO' dc a4'EINVAL' dc a4'EBADF' dc a4'EMFILE' dc a4'EACCESS' dc a4'EEXISTS' dc a4'ENOSPC' ! Note: if more errors are added, change maxErr in perror(). EUNDEF cstr 'invalid error number' EDOM cstr 'domain error' ERANGE cstr '# too large, too small, or illegal' ENOMEM cstr 'not enough memory' ENOENT cstr 'no such file or directory' EIO cstr 'I/O error' EINVAL cstr 'invalid argument' EBADF cstr 'bad file descriptor' EMFILE cstr 'too many files are open' EACCESS cstr 'access bits prevent the operation' EEXISTS cstr 'the file exists' ENOSPC cstr 'the file is too large' end **************************************************************** * * char *tmpnam(buf) * char *buf; * * Inputs: * buf - Buffer to write the name to. Buf is assumed to * be at least L_tmpnam characters long. It may be * NULL, in which case the name is not written to * a buffer. * * Outputs: * Returns a pointer to the name, which is changed on the * next call to tmpnam or tmpfile. * * Notes: * If the work prefix is set, and is less than or equal * to 15 characters in length, the file name returned is * in the work prefix (3); otherwise, it is a partial path * name. * **************************************************************** * tmpnam start csubroutine (4:buf),0 phb phk plb lb1 OSGet_Prefix pr get the prefix bcc lb2 stz name+2 lb2 short M ldx name+2 stz cname,X ldx #7 update the file number lb3 inc syscxxxx,X lda syscxxxx,X cmp #'9'+1 bne lb4 lda #'0' sta syscxxxx,X dex cpx #3 bne lb3 lb4 long M append the two strings ph4 #syscxxxx ph4 #cname jsl strcat ph4 #cname if the file exists then jsl strlen sta name+2 OSGet_File_Info GIParm bcc lb1 get a different name lda buf if buf != NULL then ora buf+2 beq lb5 ph4 #cname move the string ph4 buf jsl strcpy lb5 lla buf,cname return the string pointer plb creturn 4:buf pr dc i'2' parameter block for OSGet_Prefix dc i'3' dc a4'name' name dc i'16,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 dc a4'name+2' dc i'0' end **************************************************************** * * FILE *tmpfile() * * Outputs: * Returns a pointer to a temp file; NULL for error. * **************************************************************** * tmpfile start f equ 1 file pointer csubroutine ,4 ph4 #type open a file with a temp name ph4 #0 jsl tmpnam phx pha jsl fopen sta f stx f+2 ora f+2 if sucessful then beq lb1 ldy #FILE_flag f->_flag |= _IOTEMPFILE lda [f],Y ora #_IOTEMPFILE sta [f],Y lb1 creturn 4:f type cstr 'w+b' end **************************************************************** * * int ungetc(c, stream) * char c; * FILE *stream; * * Return a character to the input stream. * * Inputs: * c - character to return * stream - stream to put it back in * * Outputs: * Returns EOF if the attempt was unsuccessful; c if the * attempt succeeded. * **************************************************************** * ungetc start char equ 1 characater to return csubroutine (2:c,4:stream),2 lda #EOF assume we will fail sta char ldy #FILE_flag error if the file is open for output lda [stream],Y bit #_IOWRT bne rts lda c error if EOF is pushed cmp #EOF beq rts ldy #FILE_pbk+2 error if the buffer is full lda [stream],Y bpl rts ldy #FILE_pbk push the old character (if any) lda [stream],Y ldy #FILE_pbk+2 sta [stream],Y ldy #FILE_pbk put back the character lda c and #$00FF sta [stream],Y sta char rts long M creturn 2:char end **************************************************************** * * int vfprintf(stream, char *format, va_list arg) * * Print the format string to standard out. * **************************************************************** * vfprintf start using ~printfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta stream pla sta stream+2 phy restore return address/data bank phx plb lda >stream+2 verify that stream exists pha lda >stream pha jsl ~VerifyStream bcc lb1 lda #EIO sta >errno lda #EOF bra rts lb1 lda #put set up output routine sta >~putchar+4 lda #>put sta >~putchar+5 phd find the argument list address tsc tcd lda [10] pld pea 0 pha jsl ~printf call the formatter ply update the argument list pointer plx phd tsc tcd tya sta [10] pld phb remove the return address plx ply tsc update the stack pointer clc adc #8 tcs phy restore the return address phx plb lda >~numChars return the value rtl return put phb remove the char from the stack phk plb plx pla ply pha phx plb lda stream+2 write to a file pha lda stream pha phy jsl fputc rts rtl stream ds 4 stream address end **************************************************************** * * int vprintf (const char *format, va_list arg) * * Print the format string to standard out. * **************************************************************** * vprintf start using ~printfCommon lda #putchar set up the output hooks sta >~putchar+4 lda #>putchar sta >~putchar+5 phd find the argument list address tsc tcd lda [10] pld pea 0 pha jsl ~printf call the formatter ply update the argument list pointer plx phd tsc tcd tya sta [10] pld phb remove the return address plx ply tsc update the stack pointer clc adc #8 tcs phy restore the return address phx plb lda >~numChars return the value rtl return end **************************************************************** * * int vsprintf(char *s, char *format, va_list arg) * * Print the format string to a string. * **************************************************************** * vsprintf start using ~printfCommon phb use local addressing phk plb plx remove the return address ply pla save the stream sta string pla sta string+2 phy restore return address/data bank phx plb lda #put set up output routine sta >~putchar+4 lda #>put sta >~putchar+5 phd find the argument list address tsc tcd lda [10] pld pea 0 pha jsl ~printf call the formatter ply update the argument list pointer plx phd tsc tcd tya sta [10] pld phb remove the return address plx ply tsc update the stack pointer clc adc #8 tcs phy restore the return address phx plb lda >~numChars return the value rtl return put phb remove the char from the stack plx pla ply pha phx plb ldx string+2 write to a file phx ldx string phx phd tsc tcd tya and #$00FF sta [3] pld pla pla phb phk plb inc4 string plb rtl string ds 4 string address end **************************************************************** * * ~Format_c - format a '%' character * * Inputs: * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * **************************************************************** * ~Format_c private using ~printfCommon argp equ 7 argument pointer dec ~fieldWidth account for the width of the value jsr ~RightJustify handle right justification lda [argp] print the character pha jsl ~putchar inc argp remove the parameter from the stack inc argp brl ~LeftJustify handle left justification end **************************************************************** * * ~Format_d - format a signed decimal number * ~Format_u - format an unsigned decimal number * * Inputs: * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * ~isLong - is the operand long? * ~precision - precision of output * ~precisionSpecified - was the precision specified? * ~sign - char to use for positive sign * * Note: The ~Format_IntOut entry point is used by other number * formatting routines to write their number strings. * **************************************************************** * ~Format_d private using ~printfCommon argp equ 7 argument pointer ; ; For signed numbers, if the value is negative, use the sign flag ; lda ~isLong handle long values beq sn1 ldy #2 lda [argp],Y bpl cn0 sec lda #0 sbc [argp] sta [argp] lda #0 sbc [argp],Y sta [argp],Y bra sn2 sn1 lda [argp] handle int values bpl cn0 eor #$FFFF inc a sta [argp] sn2 lda #'-' sta ~sign ~Format_u entry ; ; Convert the number to an ASCII string ; cn0 stz ~hexPrefix don't lead with 0x lda ~isLong if the value is long then beq cn1 ldy #2 push a long value lda [argp],Y pha ! lda [argp] ! pha ! bra cn2 else cn1 lda [argp] push an int value pha cn2 ph4 #~str push the string addr ph2 #l:~str push the string buffer length ph2 #0 do an unsigned conversion lda ~isLong do the proper conversion beq cn3 _Long2Dec bra pd1 cn3 _Int2Dec ; ; Padd with the proper number of zeros ; ~Format_IntOut entry pd1 lda ~precisionSpecified if the precision was not specified then bne pd2 lda #1 use a precision of 1 sta ~precision pd2 ldx ~precision if the precision is zero then bne pd2a lda ~str+l:~str-2 if the result is ' 0' then cmp #'0 ' bne dp0 lda #' ' set the result to the null string sta ~str+l:~str-2 stz ~hexPrefix erase any hex prefix bra dp0 pd2a ldy #0 skip leading blanks short M lda #' ' pd3 cmp ~str,Y bne pd4 iny cpy #l:~str bne pd3 bra pd6 pd4 cmp ~str,Y deduct any characters from the precision beq pd5 dex beq pd5 iny cpy #l:~str bne pd4 pd5 stx ~precision pd6 long M ; ; Determine the padding and do left padding ; dp0 sub2 ~fieldWidth,~precision subtract off any remaining 0 padds lda ~sign if the sign is non-zero, allow for it beq dp1 dec ~fieldWidth dp1 lda ~hexPrefix if there is a hex prefix, allow for it beq dp1a dec ~fieldWidth dec ~fieldWidth dp1a ldx #0 determine the length of the buffer ldy #l:~str-1 short M lda #' ' dp2 cmp ~str,Y beq dp3 inx dey bpl dp2 dp3 long M sec subtract it from ~fieldWidth txa sbc ~fieldWidth eor #$FFFF inc a sta ~fieldWidth lda ~paddChar skip justification if we are padding cmp #'0' beq pn0 jsr ~RightJustify handle right justification ; ; Print the number ; pn0 lda ~sign if there is a sign character then beq pn1 pha print it jsl ~putchar pn1 lda ~hexPrefix if there is a hex prefix then beq pn1a pha print it jsl ~putchar ph2 ~hexPrefix+1 jsl ~putchar pn1a lda ~paddChar if the number needs 0 padding then cmp #'0' bne pn1c lda ~fieldWidth bmi pn1c beq pn1c pn1b ph2 ~paddChar print padd zeros jsl ~putchar dec ~fieldWidth bne pn1b pn1c lda ~precision if the number needs more padding then beq pn3 pn2 ph2 #'0' print padd characters jsl ~putchar dec ~precision bne pn2 pn3 ldy #-1 skip leading blanks in the number pn4 iny lda ~str,Y and #$00FF cmp #' ' beq pn4 pn5 cpy #l:~str quit if we're at the end of the ~str beq rn1 phy save Y lda ~str,Y print the character and #$00FF pha jsl ~putchar ply next character iny bra pn5 ; ; remove the number from the argument list ; rn1 lda ~isLong beq rn2 inc argp inc argp rn2 inc argp inc argp ; ; Handle left justification ; brl ~LeftJustify handle left justification end **************************************************************** * * ~Format_n - return the number of characters printed * * Inputs: * ~numChars - characters written * ~isLong - is the operand long? * **************************************************************** * ~Format_n private using ~printfCommon argp equ 7 argument pointer ph4 argp save the original argp ldy #2 dereference argp lda [argp],Y tax lda [argp] sta argp stx argp+2 lda ~numChars return the value sta [argp] lda ~isLong if long, set the high word beq lb1 ldy #2 lda #0 sta [argp],Y lb1 clc restore the original argp+4 pla adc #4 sta argp pla sta argp+2 rts end **************************************************************** * * ~Format_o - format an octal number * * Inputs: * ~altForm - use a leading '0'? * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * ~isLong - is the operand long? * ~precision - precision of output * ~precisionSpecified - was the precision specified? * **************************************************************** * ~Format_o private using ~printfCommon argp equ 7 argument pointer ; ; Initialization ; stz ~sign ignore the sign flag lda #' ' initialize the string to blanks sta ~str move ~str,~str+1,#l:~str-1 stz ~num+2 get the value to convert lda ~isLong beq cn2 ldy #2 lda [argp],Y sta ~num+2 cn2 lda [argp] sta ~num ; ; Convert the number to an ASCII string ; short I,M ldy #l:~str-1 set up the character index cn3 lda ~num+3 quit if the number is zero ora ~num+2 ora ~num+1 ora ~num beq al1 lda #0 roll off 3 bits ldx #3 cn4 lsr ~num+3 ror ~num+2 ror ~num+1 ror ~num ror A dex bne cn4 lsr A form a character lsr A lsr A lsr A lsr A ora #'0' sta ~str,Y save the character dey bra cn3 ; ; If a leading zero is required, be sure we include one ; al1 cpy #l:~str-1 include a zero if no characters have beq al2 been placed in the string lda ~altForm branch if no leading zero is required beq al3 al2 lda #'0' sta ~str,Y al3 long I,M ; ; Piggy back off of ~Format_d for output ; stz ~hexPrefix don't lead with 0x brl ~Format_IntOut end **************************************************************** * * ~Format_s - format a c-string * ~Format_b - format a p-string * * Inputs: * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * **************************************************************** * ~Format_s private using ~printfCommon argp equ 7 argument pointer ph4 argp save the original argp ldy #2 dereference argp lda [argp],Y tax lda [argp] sta argp stx argp+2 short M determine the length of the string ldy #-1 lb1 iny lda [argp],Y bne lb1 long M tya bra lb1a ~Format_b entry ph4 argp save the original argp ldy #2 dereference argp lda [argp],Y tax lda [argp] sta argp stx argp+2 lda [argp] get the length of the string and #$00FF inc4 argp lb1a ldx ~precisionSpecified if the precision is specified then beq lb2 cmp ~precision if the precision is smaller then blt lb2 lda ~precision process only precision characters lb2 sta ~num save the length in the temp variable area sub2 ~fieldWidth,~num account for the width of the value jsr ~RightJustify handle right justification ldx ~num skip printing if the length is 0 beq lb4 ldy #0 print the characters lb3 phy lda [argp],Y and #$00FF pha jsl ~putchar ply iny dec ~num bne lb3 lb4 clc restore and increment argp pla adc #4 sta argp pla sta argp+2 brl ~LeftJustify handle left justification end **************************************************************** * * ~Format_x - format a hexadecimal number (lowercase output) * ~Format_X - format a hexadecimal number (uppercase output) * ~Format_p - format a pointer * * Inputs: * ~altForm - use a leading '0x'? * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * ~isLong - is the operand long? * ~precision - precision of output * ~precisionSpecified - was the precision specified? * **************************************************************** * ~Format_x private using ~printfCommon argp equ 7 argument pointer ; ; Set the "or" value; this is used to set the case of character results ; lda #$20 sta orVal bra cn0 ~Format_p entry lda #1 sta ~isLong ~Format_X entry stz orVal ; ; Initialization ; cn0 stz ~sign ignore the sign flag lda #' ' initialize the string to blanks sta ~str move ~str,~str+1,#l:~str-1 stz ~num+2 get the value to convert lda ~isLong beq cn2 ldy #2 lda [argp],Y sta ~num+2 cn2 lda [argp] sta ~num stz ~hexPrefix assume we won't lead with 0x ; ; Convert the number to an ASCII string ; short I,M ldy #l:~str-1 set up the character index cn3 lda #0 roll off 4 bits ldx #4 cn4 lsr ~num+3 ror ~num+2 ror ~num+1 ror ~num ror A dex bne cn4 lsr A form a character lsr A lsr A lsr A ora #'0' cmp #'9'+1 if the character should be alpha, blt cn5 adjust it adc #6 ora orVal cn5 sta ~str,Y save the character dey lda ~num+3 loop if the number is not zero ora ~num+2 ora ~num+1 ora ~num bne cn3 ; ; If a leading '0x' is required, be sure we include one ; lda ~altForm branch if no leading '0x' is required beq al3 al2 lda #'X' insert leading '0x' ora orVal sta ~hexPrefix+1 lda #'0' sta ~hexPrefix al3 long I,M ; ; Piggy back off of ~Format_d for output ; brl ~Format_IntOut ; ; Local data ; orVal ds 2 for setting the case of characters end **************************************************************** * * ~Format_Percent - format the '%' character * * Inputs: * ~fieldWidth - output field width * ~paddChar - padd character * ~leftJustify - left justify the output? * **************************************************************** * ~Format_Percent private using ~printfCommon dec ~fieldWidth account for the width of the value jsr ~RightJustify handle right justification pea '%' print the character jsl ~putchar brl ~LeftJustify handle left justification end **************************************************************** * * ~InitBuffer - prepare a file buffer for output * * Inputs: * stream - buffer to prepare * **************************************************************** * ~InitBuffer start csubroutine (4:stream),0 ldy #FILE_base+2 set the next buffer location lda [stream],Y tax dey dey lda [stream],Y ldy #FILE_ptr sta [stream],Y iny iny txa sta [stream],Y ldy #FILE_base set the end of buffer mark lda [stream],Y ldy #FILE_size clc adc [stream],Y pha txa iny iny adc [stream],Y ldy #FILE_end+2 sta [stream],Y pla dey dey sta [stream],Y ldy #FILE_size set the number of chars the buffer lda [stream],Y can hold tax iny iny lda [stream],Y ldy #FILE_cnt+2 sta [stream],Y dey dey txa sta [stream],Y creturn end **************************************************************** * * ~ioerror - flag an I/O error * * Inputs: * stream - file to clear * * Outputs: * errno - set to EIO * stream->flag - error flag set * **************************************************************** * ~ioerror start stream equ 3 input stream tsc phd tcd ldy #FILE_flag lda [stream],Y ora #_IOERR sta [stream],Y lda #EIO sta >errno pld pla ply ply pha rts end **************************************************************** * * ~LeftJustify - print padd characters for left justification * ~RightJustify - print padd characters for right justification * * Inputs: * ~fieldWidth - # chars to print ( <= 0 prints none) * ~leftJustify - left justify the output? * **************************************************************** * ~LeftJustify start using ~printfCommon lda ~leftJustify padd if we are to left justify the field bne padd rts rts ~RightJustify entry lda ~leftJustify quit if we are to left justify the field bne rts padd lda ~fieldWidth quit if the field width is <= 0 bmi rts beq rts lb1 ph2 #' ' write the proper # of padd characters jsl ~putchar dec ~fieldWidth bne lb1 rts end **************************************************************** * * ~osname - convert a c string to a GS/OS file name * * Inputs: * filename - ptr to the c string * * Outputs: * X-A - ptr to GS/OS file name * * Notes: * 1. Returns nil for error. * 2. Caller must dispose of the name with a free call. * **************************************************************** * ~osname private namelen equ 1 length of the string ptr equ 3 pointer to return csubroutine (4:filename),6 ph4 filename get the length of the name buffer jsl strlen sta namelen inc A inc A pea 0 reserve some memory pha jsl malloc sta ptr stx ptr+2 ora ptr+2 bne lb1 lda #ENOMEM sta >errno brl lb3 lb1 lda namelen set the name length sta [ptr] pea 0 copy the file name to the OS name buffer pha ph4 filename clc lda ptr ldx ptr+2 adc #2 bcc lb2 inx lb2 phx pha jsl memcpy lb3 creturn 4:ptr end **************************************************************** * * int ~printf(char *format, additional arguments) * * Print the format string by calling ~putchar indirectly. If a * '%' is found, it is interpreted as follows: * * Optional Flag Characters * ------------------------ * * '-' Left justify the output. * '0' Use '0' for the pad character rather than ' '. This * flag is ignored if the '-' flag is also used. * '+' Only used for conversion operations 'd' 'e' 'E' 'f' 'g' 'G'. * Specifies that a leading sign is to be printed for * positive values. * ' ' Only used for conversion operations 'd' 'e' 'E' 'f' 'g' 'G'. * Ignored if '+' is specified. For positive values, this * causes a padd space to be written where the sign would * appear. * '#' Modify the conversion operation. * * Optional Min Field Width * ------------------------ * * This field is either a number or *. If it is *, an integer * argument is consumed from the stack and used as the field * width. In either case, the output value is printed in a field * that is NUMBER characters wide. By default, the value is * right justified and blank padded. * * Optional Precision * ------------------ * * This field is a number, *, or is ommitted. If it is an integer, * an argument is removed from the stack and used as the precision. * The precision is used to describe how many digits to print. * * Long Size Specification * ----------------------- * * An 'l' indicates that the 'd', 'o', 'u', 'x' or 'X' argument is * long. 'L' and 'u' are also accepted for compliance with ANSI C, * but have no effect in this implementation. * * Conversion Specifier * -------------------- * * d,i Signed decimal conversion from type int or long. * u Signed decmal conversion from type unsigned or unsigned long. * o Octal conversion. * x,X Hexadecomal conversion. 'x' generates lowercase hex digits, * while 'X' generates uppercase hex digits. * c Character. * s String. * p Pascal string. * n The argument is (int *); the number of characters written so * far is written to the location. * f Signed decimal floating point. * e,E Exponential format floating point. * g,G Use f,e or E, as appropriate. * % Write a '%' character. * **************************************************************** * ~printf private using ~printfCommon argp equ 7 pointer to first argument format equ 14 pointer to format code ; ; Set up the stack frame ; phb save the caller's B phk use local addressing plb phd save the caller's DP tsc set up a DP tcd ; ; Process the format string ; stz ~numChars initialize the character counter ps1 lda [format] get a character and #$00FF beq rt1 branch if at the end of the format string cmp #'%' branch if this is a conversion beq fm1 specification pha write the character jsl ~putchar inc4 format bra ps1 ; ; Remove the format parameter and return ; rt1 lda format-2 move the return address sta format+2 lda format-3 sta format+1 pld restore DP plb restore B rtl return to top level formatter ; ; Handle a format specification ; fm1 inc4 format skip the '%' stz ~removeZeros not a G specifier stz ~fieldWidth use only the space required stz ~precision use the default precision stz ~precisionSpecified stz ~isLong assume short operands lda #' ' use a blank for padding sta ~paddChar stz ~leftJustify right justify the output stz ~sign don't print the sign unless arg < 0 stz ~altForm use the primary output format fm2 jsr Flag read and interpret flag characters bcs fm2 jsr GetSize get the field width (if any) sta ~fieldWidth lda [format] if format == '.' then and #$00FF cmp #'.' bne fm3 inc4 format skip the '.' inc ~precisionSpecified note that the precision is specified jsr GetSize get the precision sta ~precision lda [format] if *format == 'l' then and #$00FF fm3 cmp #'l' bne fm4 inc ~isLong ~isLong = true bra fm5 ++format fm4 cmp #'L' else if *format in ['L','h'] then beq fm5 cmp #'h' bne fm6 fm5 inc4 format ++format lda [format] find the proper format character and #$00FF fm6 inc4 format ldx #fListEnd-fList-4 fm7 cmp fList,X beq fm8 dex dex dex dex bpl fm7 brl ps1 none found - continue fm8 pea ps1-1 push the return address inx call the subroutine inx jmp (fList,X) ; ; Flag - Read and process a flag character ; ; If a flag character was found, the carry flag is set. ; Flag lda [format] get the character and #$00FF cmp #'-' if it is a '-' then bne fl1 lda #1 left justify the output sta ~leftJustify bra fl5 fl1 cmp #'0' if it is a '0' then bne fl2 sta ~paddChar padd with '0' characters bra fl5 fl2 cmp #'+' if it is a '+' or ' ' then beq fl3 cmp #' ' bne fl4 ldx ~sign cpx #'+' beq fl5 fl3 sta ~sign set the sign flag bra fl5 fl4 cmp #'#' if it is a '#' then bne fl6 lda #1 use the alternate output form sta ~altForm fl5 inc4 format skip the format character sec rts fl6 clc no flag was found rts ; ; GetSize - get a numeric value ; ; The value is returned in A ; GetSize stz val assume a value of 0 lda [format] if the format character is '*' then and #$00FF cmp #'*' bne gs1 inc4 format skip the '*' char lda [argp] fetch the value sta val inc argp remove it from the argument list inc argp gs0 lda val rts gs1 lda [format] while the character stream had digits do and #$00FF cmp #'0' blt gs0 cmp #'9'+1 bge gs0 gs2 and #$000F save the ordinal value pha asl val A := val*10 lda val asl a asl a adc val adc 1,S A := A+ord([format]) plx sta val val := A inc4 format skip the character bra gs1 val ds 2 value ; ; List of format specifiers and the equivalent subroutines ; fList dc c'%',i1'0',a'~Format_Percent' % 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'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 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 fListEnd anop end **************************************************************** * * ~printfCommon - common data for formatted output * **************************************************************** * ~printfCommon data ; ; ~putchar is a vector to the proper output routine. ; ~putchar dc h'EE',i'~numChars' inc ~numChars dc h'5C 00 00 00' ; ; Format options ; ~altForm ds 2 use alternate output format? ~fieldWidth ds 2 output field width ~hexPrefix ds 2 hex 0x prefix characters (if present) ~isLong ds 2 is the operand long? ~leftJustify ds 2 left justify the output? ~paddChar ds 2 output padd character ~precision ds 2 precision of output ~precisionSpecified ds 2 was the precision specified? ~removeZeros ds 2 remove insignificant zeros? (g specifier) ~sign ds 2 char to use for positive sign ; ; Work buffers ; ~num ds 4 long integer ~numChars ds 2 number of characters printed with this printf ~str ds 83 string buffer ; ; Real formatting ; ~decForm anop controls SANE's formatting styles ~style ds 2 0 -> exponential; 1 -> fixed ~digits ds 2 sig. digits; decimal digits ~decRec anop decimal record ~sgn ds 2 sign ~exp ds 2 exponent ~sig ds 29 significant digits end **************************************************************** * * ~RemoveWord - remove Y words from the stack for printf * * Inputs: * Y - number of words to remove (must be >0) * **************************************************************** * ~RemoveWord start lb1 lda 13,S move the critical values sta 15,S lda 11,S sta 13,S lda 9,S sta 11,S lda 7,S sta 9,S lda 5,S sta 7,S lda 3,S sta 5,S pla sta 1,S tdc update the direct page location inc a inc a tcd dey next word bne lb1 rts end **************************************************************** * * ~Scan_c - read a character or multiple characters * * Inputs: * ~scanWidth - # of characters to read (0 implies one) * ~suppress - suppress save? * **************************************************************** * ~Scan_c private using ~scanfCommon arg equ 11 argument lda ~scanWidth if ~scanWidth == 0 then bne lb1 inc ~scanWidth ~scanWidth = 1 lb1 jsl ~getchar get the character cmp #EOF if at EOF then bne lb1a sta ~eofFound ~eofFound = EOF lda ~suppress if input is not suppressed then bne lb3 dec ~assignments no assignment made bra lb3 bail out lb1a ldx ~suppress if input is not suppressed then bne lb2 short M save the value sta [arg] long M inc4 arg update the pointer lb2 dec ~scanWidth next character bne lb1 lb3 lda ~suppress if input is not suppressed then bne lb4 ldy #2 jsr ~RemoveWord remove the parameter from the stack lb4 rts end **************************************************************** * * ~Scan_d - read an integer * ~Scan_i - read a based integer * * Inputs: * ~scanError - has a scan error occurred? * ~scanWidth - max input length * ~suppress - suppress save? * ~size - size specifier * **************************************************************** * ~Scan_d private using ~scanfCommon arg equ 11 argument stz based always use base 10 bra bs1 ~Scan_i entry lda #1 allow base 8, 10, 16 sta based bs1 stz read no chars read lda #10 assume base 10 sta base stz val initialize the value to 0 stz val+2 lb1 jsl ~getchar skip leading whitespace... cmp #EOF if EOF then bne ef1 sta ~eofFound ~eofFound = EOF lda ~suppress if input is not suppressed then bne lb6l dec ~assignments no assignment made lb6l brl lb6 bail out ef1 tax {...back to skipping whitespace} lda __ctype+1,X and #_space bne lb1 inc read txa stz minus assume positive number cmp #'+' skip leading + beq sg1 cmp #'-' if - then set minus flag bne sg2 inc minus sg1 jsl ~getchar inc read sg2 ldx based if base 8, 16 are allowed then beq lb2 cmp #'0' if the digit is '0' then bne lb2 lda #8 assume base 8 sta base dec ~scanWidth get the next character jeq lb4a bpl lb1a stz ~scanWidth lb1a jsl ~getchar inc read cmp #'X' if it is X then beq lb1b cmp #'x' bne lb2 lb1b asl base use base 16 dec ~scanWidth get the next character beq lb4a bpl lb1c stz ~scanWidth lb1c jsl ~getchar inc read lb2 cmp #'0' if the char is a digit then blt lb4 cmp #'7'+1 blt lb2a ldx base cpx #8 beq lb4 cmp #'9'+1 blt lb2a cpx #16 bne lb4 and #$00DF cmp #'A' blt lb4 cmp #'F'+1 bge lb4 sbc #6 lb2a and #$000F convert it to a value pha save the value ph4 val update the old value lda base ldx #0 jsl ~UMUL4 pl4 val pla add in the new digit clc adc val sta val bcc lb3 inc val+2 lb3 dec ~scanWidth quit if the max # chars have been beq lb4a scanned bpl lb3a make sure 0 stays a 0 stz ~scanWidth lb3a jsl ~getchar next char inc read bra lb2 lb4 jsl ~putback put the last character back dec read lb4a lda read if no chars read then bne lb4b inc ~scanError ~scanError = true lda ~suppress if input is not suppressed then bne lb6 dec ~assignments no assignment made bra lb6 skip the save lb4b lda ~suppress if input is not suppressed then bne lb7 lda minus if minus then beq lb4c sub4 #0,val,val negate the value lb4c lda val save the value sta [arg] dec ~size bmi lb6 ldy #2 lda val+2 sta [arg],Y lb6 lda ~suppress if input is not suppressed then bne lb7 ldy #2 remove the parameter from the stack jsr ~RemoveWord lb7 rts val ds 4 value base dc i4'10' constant for mul4 based ds 2 based conversion? minus ds 2 is the value negative? read ds 2 # chars read end **************************************************************** * * ~Scan_lbrack - read character in a set * * Inputs: * ~scanWidth - max input length * ~suppress - suppress save? * ~size - size specifier * **************************************************************** * ~Scan_lbrack private using ~scanfCommon using ~printfCommon arg equ 11 argument format equ 7 pointer to format code stz read no characters read into the set stz didOne no characters scanned from the stream move #0,~str,#32 clear the set stz negate don't negate the set lda [format] if the first char is '^' then and #$00FF cmp #'^' bne lb2 dec negate negate the set lb1 inc4 format skip the ^ lb2 lda [format] while *format != ']' do and #$00FF ldx read but wait: ']' as the first char is beq lb2a allowed! cmp #']' beq lb3 lb2a inc read jsr Set set the char's bit ora ~str,X sta ~str,X bra lb1 next char lb3 inc4 format skip the ']' ldy #30 negate the set (if needed) lb4 lda ~str,Y eor negate sta ~str,Y dey dey bpl lb4 lb5 jsl ~getchar get a character cmp #EOF quit if at EOF beq lb8 pha quit if not in the set jsr Set ply and ~str,X beq lb7 sty didOne note that we scanned a character ldx ~suppress if output is not suppressed then bne lb6 tya short M save the character sta [arg] long M inc4 arg update the argument lb6 dec ~scanWidth note that we processed one beq lb8 bpl lb5 stz ~scanWidth bra lb5 next char lb7 tya put back the last char scanned jsl ~putback lb8 lda didOne if no chars read then bne lb8a inc ~scanError ~scanError = true lda ~suppress if input is not suppressed then bne lb9 dec ~assignments no assignment made bra lb8b skip the save lb8a lda ~suppress if output is not suppressed then bne lb9 short M set the terminating null lda #0 sta [arg] long M lb8b ldy #2 remove the parameter from the stack jsr ~RemoveWord lb9 rts ; ; Set - form a set disp/bit pattern from a character value ; Set ldx #1 stx disp st1 bit #$0007 beq st2 asl disp dec A bra st1 st2 lsr A lsr A lsr A tax lda disp rts negate ds 2 negate the set? disp ds 2 used to form the set disp read ds 2 number of characters in the scan set didOne ds 2 non-zero if we have scanned a character end **************************************************************** * * ~Scan_n - return the # of characters scanned so far * * Inputs: * ~suppress - suppress save? * * Notes: * Decrements ~assignments so the increment in scanf will * leave the assignment count unaffected by this call. * **************************************************************** * ~Scan_n private using ~scanfCommon arg equ 11 argument ldx ~suppress if output is not suppressed then bne lb1 lda ~scanCount save the count sta [arg] dec ~assignments fix assignment count lb1 ldy #2 remove the parameter from the stack jsr ~RemoveWord rts end **************************************************************** * * ~Scan_b - read a pascal string * ~Scan_s - read a c string * * Inputs: * ~scanError - has a scan error occurred? * ~scanWidth - max input length * ~suppress - suppress save? * ~size - size specifier * **************************************************************** * ~Scan_b private using ~scanfCommon arg equ 11 argument move4 arg,length save the location to store the length inc4 arg increment to the first char position lda #1 sta pString set the p-string flag bra lb1 ~Scan_s entry stz pString clear the p-string flag lb1 jsl ~getchar skip leading whitespace cmp #EOF bne lb2 inc ~scanError lda ~suppress (no assignment made) bne lb6 dec ~assignments bra lb6 lb2 tax lda __ctype+1,X and #_space bne lb1 lb2a txa ldx ~suppress if output is not suppressed then bne lb3 short M save the character sta [arg] long M inc4 arg update the argument lb3 dec ~scanWidth note that we processed one beq lb5 bpl lb4 stz ~scanWidth lb4 jsl ~getchar next char cmp #EOF quit if at EOF beq lb5 and #$00FF loop if not whitespace tax lda __ctype+1,X and #_space beq lb2a txa whitespace: put it back jsl ~putback lb5 lda ~suppress if output is not suppressed then bne lb6 short M set the terminating null lda #0 sta [arg] long M lda pString if this is a p-string then beq lb6 sec compute the length lda arg sbc length dec A ldx length set up the address stx arg ldx length+2 stx arg+2 short M save the length sta [arg] long M lb6 lda ~suppress if output is not suppressed then bne lb7 ldy #2 remove the parameter from the stack jsr ~RemoveWord lb7 rts length ds 4 ptr to the length byte (p string only) pString ds 2 is this a p string? end **************************************************************** * * ~Scan_percent - read a % character * * Inputs: * ~scanWidth - max input length * ~suppress - suppress save? * ~size - size specifier * **************************************************************** * ~Scan_percent private using ~scanfCommon arg equ 11 argument jsl ~getchar get the character cmp #'%' if it is not a percent then beq lb1 jsl ~putback put it back inc ~scanError note the error lda ~suppress if input is not suppressed then bne lb1 dec ~assignments no assignment done lb1 rts end **************************************************************** * * ~Scan_u - read an unsigned integer * ~Scan_o - read an unsigned octal integer * ~Scan_x - read an unsigned hexadecimal integer * ~Scan_p - read a pointer * * Inputs: * ~scanWidth - max input length * ~suppress - suppress save? * ~size - size specifier * **************************************************************** * ~Scan_u private using ~scanfCommon arg equ 11 argument jsr Init lda #10 base 10 bra bs1 ~Scan_o entry jsr Init lda #8 base 8 bra bs1 ~Scan_p entry lda #1 sta ~size ~Scan_x entry jsr Init jsl ~getchar if the initial char is a '0' then inc read sta ch cmp #'0' bne hx2 dec ~scanWidth get the next character jeq lb4a bpl hx1 stz ~scanWidth hx1 jsl ~getchar inc read sta ch cmp #'x' if it is an 'x' or 'X' then beq hx1a cmp #'X' bne hx2 hx1a dec ~scanWidth accept the character jeq lb4a bpl hx3 stz ~scanWidth bra hx3 hx2 jsl ~putback put back the character dec read hx3 lda #16 base 16 bs1 sta base set the base lb2 jsl ~getchar if the char is a digit then inc read sta ch cmp #'0' blt lb4 cmp #'7'+1 blt lb2a ldx base cpx #8 beq lb4 cmp #'9'+1 blt lb2a cpx #16 bne lb4 and #$00DF cmp #'A' blt lb4 cmp #'F'+1 bge lb4 sbc #6 lb2a and #$000F convert it to a value pha save the value ph4 val update the old value lda base ldx base+2 jsl ~UMUL4 pl4 val pla add in the new digit clc adc val sta val bcc lb3 inc val+2 lb3 dec ~scanWidth quit if the max # chars have been beq lb4a scanned bpl lb2 make sure 0 stays a 0 stz ~scanWidth bra lb2 lb4 lda ch put the last character back jsl ~putback dec read lb4a lda read if no chars read then bne lb4b inc ~scanError ~scanError = true lda ~suppress if input is not suppressed then bne lb6 dec ~assignments no assignment made bra lb6 remove the parameter lb4b lda ~suppress if input is not suppressed then bne lb7 lda val save the value sta [arg] dec ~size bmi lb6 ldy #2 lda val+2 sta [arg],Y lb6 lda ~suppress if input is not suppressed then bne lb7 ldy #2 remove the parameter from the stack jsr ~RemoveWord lb7 rts ; ; Initialization ; Init stz read no chars read stz val initialize the value to 0 stz val+2 in1 jsl ~getchar skip leading whitespace... cmp #EOF if at EOF then bne in2 lda ~suppress if input is not suppressed then bne in1a dec ~assignments no assignment made in1a sta ~eofFound eofFound = EOF pla pop stack bra lb6 bail out in2 tax ...back to slipping whitespace lda __ctype+1,X and #_space bne in1 txa jsl ~putback rts ch ds 2 char buffer val ds 4 value base dc i4'10' constant for mul4 based ds 2 based conversion? read ds 2 # chars read end **************************************************************** * * int ~scanf(format, additional arguments) * char *format; * * Scan by calling ~getchar indirectly. If a '%' is found, it * is interpreted as follows: * * Assignment Suppression Flag * --------------------------- * * '*' Do everyting but save the result and remove a pointer from * the stack. * * Max Field Width * --------------- * * No more than this number of characters are removed from the * input stream. * * Size Specification * ------------------ * * 'h' Used with 'd', 'u', 'o' or 'x' to indicate a short store. * 'l' Used with 'd', 'u', 'o' or 'x' to indicate a four-byte store. * Also used with 'e', 'f' or 'g' to indicate double reals. * * Conversion Specifier * -------------------- * * d,i Signed decimal conversion to type int or long. * u Signed decmal conversion to type unsigned short, unsigned or * unsigned long. * o Octal conversion. * x,X Hexadecomal conversion. * c Character. * s String. * p Pascal string. * n The argument is (int *); the number of characters written so * far is written to the location. * f,e,E,g,G Signed floating point conversion. * % Read a '%' character. * [ Scan and included characters and place them in a string. * **************************************************************** * ~scanf private using ~scanfCommon arg equ format+4 first argument format equ 7 pointer to format code ; ; Set up the stack frame ; phb save the caller's B phk use local addressing plb phd save the caller's DP tsc set up a DP tcd ; ; Process the format string ; stz ~assignments no assignments yet stz ~scanCount no characters scanned stz ~scanError no scan error so far stz ~eofFound eof was not the first char jsl ~getchar test for eof cmp #EOF bne ps0 sta ~eofFound ps0 jsl ~putback ps1 lda ~scanError quit if a scan error has occurred bne rm1 lda [format] get a character and #$00FF jeq rt1 branch if at the end of the format string tax if this is a whitespace char then lda __ctype+1,X and #_space beq ps4 ps2 inc4 format skip whitespace in the format string lda [format] and #$00FF tax lda __ctype+1,X and #_space bne ps2 ps3 jsl ~getchar skip whitespace in the input stream tax cpx #EOF beq ps3a lda __ctype+1,X and #_space bne ps3 ps3a txa jsl ~putback bra ps1 ps4 cpx #'%' branch if this is a conversion beq fm1 specification stx ch make sure the char matches the format inc4 format specifier jsl ~getchar cmp ch beq ps1 jsl ~putback put the character back ; ; Remove the parameters for remaining conversion specifications ; rm1 lda [format] if this is a format specifier then and #$00FF beq rt1 cmp #'%' bne rm4 inc4 format if it is not a '%' or '*' then lda [format] and #$00FF beq rt1 cmp #'%' beq rm4 cmp #'*' beq rm4 cmp #'[' if it is a '[' then bne rm3 rm2 inc4 format skip up to the closing ']' lda [format] and #$00FF beq rt1 cmp #']' bne rm2 rm3 ldy #2 remove an addr from the stack jsr ~RemoveWord rm4 inc4 format next format character bra rm1 ; ; Remove the format parameter and return ; rt1 lda format-2 move the return address sta format+2 lda format-3 sta format+1 pld restore DP plb restore B pla remove the extra 4 bytes from the stack pla lda >~assignments return the number of assignments bne rt2 lda >~eofFound return EOF if no characters scanned rt2 rtl ; ; Handle a format specification ; fm1 inc4 format skip the '%' inc ~assignments another one made... stz ~suppress assignment is not suppressed stz ~size default operand size lda [format] if the char is an '*' then and #$00FF cmp #'*' bne fm2 inc ~suppress suppress the output dec ~assignments no assignment made inc4 format skip the '*' fm2 jsr GetSize get the field width specifier sta ~scanWidth lda [format] if the character is an 'l' then and #$00FF cmp #'l' bne fm3 inc ~size long specifier bra fm4 fm3 cmp #'h' else if it is an 'h' then bne fm5 fm4 inc4 format ignore the character fm5 lda [format] find the proper format character and #$00FF inc4 format ldx #fListEnd-fList-4 fm7 cmp fList,X beq fm8 dex dex dex dex bpl fm7 brl ps1 none found - continue fm8 pea ps1-1 push the return address inx call the subroutine inx jmp (fList,X) ; ; GetSize - get a numeric value ; ; The value is returned in A ; GetSize stz val assume a value of 0 gs1 lda [format] while the character stream had digits do and #$00FF cmp #'0' blt gs3 cmp #'9'+1 bge gs3 gs2 and #$000F save the ordinal value pha asl val A := val*10 lda val asl a asl a adc val adc 1,S A := A+ord([format]) plx sta val val := A inc4 format skip the character bra gs1 gs3 lda val rts 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'n',i1'0',a'~Scan_n' n 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' [ fListEnd anop ; ; Other local data ; ch ds 2 temp storage end **************************************************************** * * ~scanfCommon - common data for formatted input * **************************************************************** * ~scanfCommon data ; ; ~getchar is a vector to the proper input routine. ; ~getchar dc h'AF',a3'~scanCount' lda >~scanCount dc h'1A' inc A dc h'8F',a3'~scanCount' sta >~scanCount dc h'5C 00 00 00' ; ; ~putback is a vector to the proper putback routine. ; ~putback dc h'48' pha dc h'AF',a3'~scanCount' lda >~scanCount dc h'3A' dec A dc h'8F',a3'~scanCount' sta >~scanCount dc h'68' pla dc h'5C 00 00 00' ; ; global variables ; ~assignments ds 2 # of assignments made ~eofFound ds 2 was EOF found during the scan? ~suppress ds 2 suppress assignment? ~scanCount ds 2 # of characters scanned ~scanError ds 2 set to 1 by scaners if an error occurs ~scanWidth ds 2 max # characters to scan ~size ds 2 size specifier; -1 -> short, 1 -> long, ! 0 -> default end **************************************************************** * * ~SetFilePointer - makes sure nothing is in the input buffer * * Inputs: * stream - stream to check * **************************************************************** * ~SetFilePointer private csubroutine (4:stream),0 ldy #FILE_pbk if stream->FILE_pbk != -1 lda [stream],Y inc A ldy #FILE_cnt or stream->FILE_cnt != 0 then ora [stream],Y iny iny ora [stream],Y beq lb1 ph2 #SEEK_CUR fseek(stream, 0L, SEEK_CUR) ph4 #0 ph4 stream jsl fseek lb1 anop creturn end **************************************************************** * * ~VerifyStream - insures that a stream actually exists * * Inputs: * stream - stream to check * * Outputs: * C - set for error; clear if the stream exists * **************************************************************** * ~VerifyStream private stream equ 9 stream to check ptr equ 1 stream pointer phb set up the stack frame phk plb ph4 #stdin+4 tsc phd tcd lb1 lda ptr error if the list is exhausted ora ptr+2 beq err lda ptr OK if the steams match cmp stream bne lb2 lda ptr+2 cmp stream+2 beq OK lb2 ldy #2 next pointer lda [ptr],Y tax lda [ptr] sta ptr stx ptr+2 bra lb1 err lda #EIO set the error code sta >errno sec return with error bra OK2 OK clc return with no error OK2 pld pla pla plx ply pla pla phy phx plb rtl end \ No newline at end of file diff --git a/stdio.macros b/stdio.macros new file mode 100755 index 0000000..8cf7587 --- /dev/null +++ b/stdio.macros @@ -0,0 +1 @@ + MACRO &lab cstr &s &lab dc c"&s",i1'0' mend MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND MACRO &lab csubroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta 1 .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+4+&work &totallen seta &totallen+&len &i seta &i+1 aif &i<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend MACRO &lab creturn &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+2 sta &worklen+&totallen+2 lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend MACRO &LAB ~SETM &LAB ANOP AIF C:&~LA,.B GBLB &~LA GBLB &~LI .B &~LA SETB S:LONGA &~LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) LONGA ON LONGI ON .A MEND MACRO &LAB ~RESTM &LAB ANOP AIF (&~LA+&~LI)=2,.I SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) AIF &~LA,.H LONGA OFF .H AIF &~LI,.I LONGI OFF .I MEND MACRO &LAB SUB2 &N1,&N2,&N3 AIF C:&N3,.A LCLC &N3 &N3 SETC &N1 .A &LAB ~SETM SEC ~LDA &N1 ~OP SBC,&N2 ~STA &N3 ~RESTM MEND MACRO &LAB ~LDA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB LDA &OP MEND MACRO &LAB ~STA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB STA &OP MEND MACRO &LAB ~OP &OPC,&OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB &OPC &OP MEND MACRO &LAB ADD4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~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 MACRO &LAB DIV4 &N1,&N2,&N3 &LAB ~SETM PH4 &N1 PH4 &N2 JSL ~DIV4 AIF C:&N3,.A PL4 &N1 AGO .B .A PL4 &N3 .B PLA PLA ~RESTM MEND MACRO &LAB MUL4 &N1,&N2,&N3 &LAB ~SETM PH4 &N1 PH4 &N2 JSL ~MUL4 AIF C:&N3,.A PL4 &N1 AGO .B .A PL4 &N3 .B ~RESTM MEND MACRO &LAB SUB4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~SETM AIF C:&M3,.A &C AMID "&M2",1,1 AIF "&C"<>"#",.A &C AMID "&M1",1,1 AIF "&C"="{",.A AIF "&C"="[",.A &C AMID "&M2",2,L:&M2-1 AIF &C>=65536,.A SEC ~LDA &M1 ~OP SBC,&M2 ~STA &M1 BCS ~&SYSCNT ~OP.H DEC,&M1 ~&SYSCNT ANOP AGO .C .A AIF C:&M3,.B LCLC &M3 &M3 SETC &M1 .B SEC ~LDA &M1 ~OP SBC,&M2 ~STA &M3 ~LDA.H &M1 ~OP.H SBC,&M2 ~STA.H &M3 .C ~RESTM MEND MACRO &LAB ~OP.H &OPC,&OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C &OPC &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" &OPC &OP MEXIT .E &OPC 2+&OP MEND MACRO &LAB ~LDA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C LDA &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" LDA &OP MEXIT .E LDA 2+&OP MEND MACRO &LAB ~STA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C STA &OP MEXIT .D STA 2+&OP MEND MACRO &LAB BLE &BP &LAB BLT &BP BEQ &BP MEND MACRO &LAB DEC4 &A &LAB ~SETM LDA &A BNE ~&SYSCNT DEC 2+&A ~&SYSCNT DEC &A ~RESTM MEND MACRO &LAB INC4 &A &LAB ~SETM INC &A BNE ~&SYSCNT INC 2+&A ~&SYSCNT ~RESTM MEND MACRO &LAB JCS &BP &LAB BCC *+5 BRL &BP MEND MACRO &LAB JEQ &BP &LAB BNE *+5 BRL &BP MEND MACRO &LAB JNE &BP &LAB BEQ *+5 BRL &BP MEND MACRO &LAB LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND MACRO &LAB 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 &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB MOVE &AD1,&AD2,&LEN &LAB ANOP LCLB &LA LCLB &LI LCLC &C AIF C:&LEN,.A1 LCLC &LEN &LEN SETC #2 .A1 &LA SETB S:LONGA &LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&LA)+16*(.NOT.&LI) LONGA ON LONGI ON .A &C AMID &LEN,1,1 AIF "&C"<>"#",.D &C AMID &LEN,2,L:&LEN-1 AIF &C<>2,.D &C AMID &AD1,1,1 AIF "&C"<>"{",.B &AD1 AMID &AD1,2,L:&AD1-2 &AD1 SETC (&AD1) .B LDA &AD1 &C AMID &AD2,1,1 AIF "&C"<>"{",.C &AD2 AMID &AD2,2,L:&AD2-2 &AD2 SETC (&AD2) .C STA &AD2 AGO .G .D &C AMID &AD1,1,1 AIF "&C"="#",.F &C AMID &LEN,1,1 AIF "&C"<>"{",.E &LEN AMID &LEN,2,L:&LEN-2 &LEN SETC (&LEN) .E &C AMID &LEN,1,1 AIF "&C"="#",.E1 LDA &LEN DEC A AGO .E2 .E1 LDA &LEN-1 .E2 LDX #&AD1 LDY #&AD2 MVN &AD1,&AD2 AGO .G .F LDA &AD1 STA &AD2 LDA &LEN-1 LDX #&AD2 LDY #&AD2+1 MVN &AD2,&AD2 .G AIF (&LA+&LI)=2,.I SEP #32*(.NOT.&LA)+16*(.NOT.&LI) AIF &LA,.H LONGA OFF .H AIF &LI,.I LONGI OFF .I MEND MACRO &LAB PH2 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PL4 &N1 LCLC &C &LAB ANOP AIF S:LONGA=1,.A REP #%00100000 .A &C AMID &N1,1,1 AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.F &N1 AMID &N1,2,L:&N1-2 PLA STA (&N1) LDY #2 PLA STA (&N1),Y AGO .D .B AIF "&C"<>"[",.C PLA STA &N1 LDY #2 PLA STA &N1,Y AGO .D .C PLA STA &N1 PLA STA &N1+2 .D AIF S:LONGA=1,.E SEP #%00100000 .E MEXIT .F MNOTE "Missing closing '}'",16 MEND MACRO &LAB 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 &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND MACRO &LAB OSCREATE &DCB &LAB JSL $E100A8 DC I2'$2001' DC I4'&DCB' MEND MACRO &LAB OSDESTROY &DCB &LAB JSL $E100A8 DC I2'$2002' DC I4'&DCB' MEND MACRO &LAB OSCHANGE_PATH &DCB &LAB JSL $E100A8 DC I2'$2004' DC I4'&DCB' MEND MACRO &LAB OSGET_PREFIX &DCB &LAB JSL $E100A8 DC I2'$200A' DC I4'&DCB' MEND MACRO &LAB OSOPEN &DCB &LAB JSL $E100A8 DC I2'$2010' DC I4'&DCB' MEND MACRO &LAB OSREAD &DCB &LAB JSL $E100A8 DC I2'$2012' DC I4'&DCB' MEND MACRO &LAB OSWRITE &DCB &LAB JSL $E100A8 DC I2'$2013' DC I4'&DCB' MEND MACRO &LAB OSCLOSE &DCB &LAB JSL $E100A8 DC I2'$2014' DC I4'&DCB' MEND MACRO &LAB OSSET_MARK &DCB &LAB JSL $E100A8 DC I2'$2016' DC I4'&DCB' MEND MACRO &LAB OSGET_MARK &DCB &LAB JSL $E100A8 DC I2'$2017' DC I4'&DCB' MEND MACRO &LAB OSSET_EOF &DCB &LAB JSL $E100A8 DC I2'$2018' DC I4'&DCB' MEND MACRO &LAB OSGET_EOF &DCB &LAB JSL $E100A8 DC I2'$2019' DC I4'&DCB' MEND MACRO &LAB _INT2DEC &LAB LDX #$260B JSL $E10000 MEND MACRO &LAB _LONG2DEC &LAB LDX #$270B JSL $E10000 MEND MACRO &LAB JMI &BP &LAB BPL *+5 BRL &BP MEND MACRO &LAB OSGET_FILE_INFO &DCB &LAB JSL $E100A8 DC I2'$2006' DC I4'&DCB' MEND macro &l getrefinfogs &p &l jsl $E100A8 dc i2'$2039' dc i4'&p' mend macro &l destroygs &p &l jsl $E100A8 dc i2'$2002' dc i4'&p' mend \ No newline at end of file diff --git a/stdlib.asm b/stdlib.asm new file mode 100755 index 0000000..8ffc535 --- /dev/null +++ b/stdlib.asm @@ -0,0 +1 @@ + keep obj/stdlib mcopy stdlib.macros case on **************************************************************** * * StdDef - Standard Definitions * * This code implements the tables and subroutines needed to * support the standard C library STDDEF. * * December 1988 * Mike Westerfield * * Copyright 1988 * Byte Works, Inc. * * Note: Portions of this library appear in SysFloat * **************************************************************** * StdDef start dummy segment copy equates.asm end **************************************************************** * * void abort() * * Stop the program. * **************************************************************** * abort start ph2 #SIGABRT jsl raise lda #-1 jmp ~QUIT end **************************************************************** * * int abs(int i) * * Return the absolute value of i. * * Inputs: * i - argument * * Outputs: * Returns abs(i). * **************************************************************** * abs start i equ 4 position of argument on stack lda i,S A := i bpl lb1 if A < 0 then eor #$FFFF A := -A inc A lb1 tay return A lda 2,S sta 4,S pla sta 1,S tya rtl end **************************************************************** * * int atexit(func) * void (*func)(); * * This function is used to build a list of functions that will * be called as part of the exit processing. * * Inputs: * func - address of the function to call on exit * * Outputs: * Returns 0 if successful, -1 if not. * **************************************************************** * atexit start ptr equ 1 work pointer rval equ 5 return value csubroutine (4:func),6 lda #-1 assume we will fail sta rval assume we will fail dec4 func we need the addr-1, not the addr ph4 #8 get space for the record jsl malloc stx ptr+2 sta ptr ora ptr+2 quit now if we failed beq lb1 ldy #2 place the record in the exit list lda >~EXITLIST sta [ptr] lda >~EXITLIST+2 sta [ptr],Y lda ptr sta >~EXITLIST lda ptr+2 sta >~EXITLIST+2 iny place the function address in the record iny lda func sta [ptr],Y iny iny lda func+2 sta [ptr],Y inc rval success... lb1 creturn 2:rval end **************************************************************** * * atof - convert a string to a float * * Inputs: * str - pointer to the string * * Outputs: * X-A - pointer to converted number * **************************************************************** * atof start ph4 #0 no pointer returned lda 10,S pass the string addr on pha lda 10,S pha jsl strtod convert the string tay fix the stack lda 2,S sta 6,S pla sta 3,S pla tya rtl end **************************************************************** * * atoi - convert a string to an int * atol - convert a string to a long * * Inputs: * str - pointer to the string * * Outputs: * X-A - converted number * **************************************************************** * atoi start atol entry ph2 #10 base 10 ph4 #0 no pointer returned lda 12,S pass the string addr on pha lda 12,S pha jsl strtol convert the string tay fix the stack lda 2,S sta 6,S pla sta 3,S pla tya rtl end **************************************************************** * * char *bsearch(key, base, count, size, compar) * void *key, *base; * size_t count, size; * int (*compar)(const void *, const void *) * * Inputs: * key - pointer to element to search for * base - start address of the array to search * count - # elements in the array * size - size of each array element * compar - function that compares array elements * * Outputs: * Returns a pointer to the array element found; NULL if * no match was found. * **************************************************************** * bsearch start left equ 1 left index right equ 5 right index test equ 9 test index addr equ 13 address of array element of index test csubroutine (4:key,4:base,4:count,4:size,4:compar),16 lda compar patch the call address sta >jsl+1 lda compar+1 sta >jsl+2 stz left left = 0 stz left+2 sub4 count,#1,right right = count-1 lb1 clc test = (left+right)/2 lda left adc right sta test lda left+2 adc right+2 lsr A sta test+2 ror test mul4 test,size,addr addr = test*size + base add4 addr,base ph4 addr compare the array elements ph4 key jsl jsl jsl tax quit if *addr = *key beq lb6 bmi lb2 if *key > *addr then add4 test,#1,left left = test+1 bra lb3 else lb2 sub4 test,#1,right right = test-1 lb3 lda right+2 loop if right >= left bmi lb5 cmp left+2 bne lb4 lda right cmp left lb4 bge lb1 lb5 stz addr no match - return null stz addr+2 lb6 creturn 4:addr end **************************************************************** * * div_t div(n,d) * int n,d; * * Inputs: * n - numerator * d - denominator * * Outputs: * div_t - contains result & remainder * **************************************************************** * div start addr equ 1 csubroutine (2:n,2:d),4 phb use local data phk plb lda n do the divide ldx d jsl ~DIV2 sta div_t save the results stx div_t+2 tay if the result is negative then bpl lb1 sub2 #0,div_t+2,div_t+2 make the remainder negative lb1 lla addr,div_t return the address plb creturn 4:addr div_t ds 4 end **************************************************************** * * void exit(status) * int status; * * void _exit(status) * int status; * * Stop the program. Exit cleans up, _exit does not. Status * is the status returned to the shell. * * Inputs: * status - exit code * **************************************************************** * exit start jsr ~EXIT _exit entry lda 4,S jmp ~QUIT end **************************************************************** * * char *getenv(const char *name) * * Returns a pointer to a shell variable. If the shell variable * has no value, a null is returned. * * Inputs: * namePtr - pointer to the name of the shell variable * * Outputs: * Returns a pointer to the shell variable * **************************************************************** * getenv start ptr equ 1 pointer to the shell variable csubroutine (4:namePtr),4 phb use local addressing phk plb lla ptr,0 initialize the pointer to null short I,M copy the variable name to the buffer ldy #0 lb1 lda [namePtr],Y beq lb2 iny sta name,Y bne lb1 dey lb2 sty name long I,M Read_Variable rdRec read the shell variable bcs lb3 if there was no error then lda var if the variable was set then and #$00FF beq lb3 short I,M set the null terminator ldx var stz var+1,X long I,M lla ptr,var+1 set the pointer to return lb3 plb restore B creturn 4:ptr rdRec dc a4'name,var' read variable record name ds 256 shell variable name var ds 257 shell variable value end **************************************************************** * * long labs(long i) * * Return the absolute value of i. * * Inputs: * i - argument * * Outputs: * Returns abs(i). * **************************************************************** * labs start csubroutine (4:i),0 lda i+2 bpl lb1 sub4 #0,i,i lb1 creturn 4:i end **************************************************************** * * ldiv_t ldiv(n,d) * long n,d; * * Inputs: * n - numerator * d - denominator * * Outputs: * ldiv_t - contains result & remainder * **************************************************************** * ldiv start addr equ 1 csubroutine (4:n,4:d),4 phb use local addressing phk plb ph4 n do the divide ph4 d jsl ~DIV4 pl4 div_t pl4 div_t+4 lda div_t+2 if the result is negative then bpl lb1 sub4 #0,div_t+4,div_t+4 make the remainder negative lb1 lla addr,div_t return the result plb creturn 4:addr div_t ds 8 end **************************************************************** * * void qsort(base, count, size, compar) * void *base; * size_t count, size; * int (*compar)(const void *, const void *) * * Inputs: * base - start address of the array to sort * count - # elements in the array * size - size of each array element * compar - function that compares array elements * * Outputs: * The array is sorted on exit. * **************************************************************** * qsort start csubroutine (4:base,4:count,4:size,4:compar),0 phb phk plb dec4 count set count to the addr of the last entry mul4 count,size add4 count,base move4 size,lsize save size in a global var lda compar set the jsl addresses sta jsl1+1 sta jsl2+1 lda compar+1 sta jsl1+2 sta jsl2+2 ph4 count do the sort ph4 base jsl rsort plb creturn end **************************************************************** * * rand - get a random number * * Outputs: * A - random number * **************************************************************** * rand start lda >~srand if no initialization then bne lb1 ph2 #1 initialize with a value of 1 jsl srand lb1 jsl ~RANX find the random number lda >~SEED and #$7FFF rtl ~srand entry dc i'0' end **************************************************************** * * rsort - recursive sort for qsort * * Inputs: * first - first array element to sort * last - last array element to sort * **************************************************************** * rsort private left equ 1 left address right equ 5 right address csubroutine (4:first,4:last),8 phb phk plb sr0 lda last+2 if last <= first then quit cmp first+2 bne sr1 lda last cmp first sr1 bgt sr1a plb creturn sr1a move4 last,right right = last move4 first,left left = first bra sr3 sr2 add4 left,lsize inc left until *left >= *last sr3 ph4 last ph4 left jsl1 entry jsl jsl1 tax bmi sr2 sr4 lda right quit if right = first cmp first bne sr4a lda right+2 cmp first+2 beq sr4b sr4a sub4 right,lsize dec right until *right <= *last ph4 last ph4 right jsl2 entry jsl jsl2 dec A bpl sr4 sr4b ph4 left swap left/right entries ph4 right jsr swap lda left+2 loop if left < right cmp right+2 bne sr5 lda left cmp right sr5 blt sr2 ph4 right sqap left/right entries ph4 left jsr swap ph4 left swap left/last entries ph4 last jsr swap sub4 left,lsize,right sort left part of array ph4 right ph4 first jsl rsort add4 left,lsize,first sort right part of array brl sr0 ; ; swap - swap two entries ; l equ 3 left entry r equ 7 right entry swap tsc set up addressing phd tcd ldx lsize+2 move 64K chunks beq sw2 ldy #0 sw1 lda [l],Y tax lda [r],Y sta [l],Y txa sta [r],Y dey dey bne sw1 inc l+2 inc r+2 dex bne sw1 sw2 lda lsize if there are an odd number of bytes then lsr A bcc sw3 short M move one byte lda [l] tax lda [r] sta [l] txa sta [r] long M inc4 l inc4 r lda lsize lsr A sw3 asl A quit if there are no more bytes beq sw6 tay bra sw5 sw4 lda [l],Y move the bytes tax lda [r],Y sta [l],Y txa sta [r],Y sw5 dey dey bne sw4 lda [l] tax lda [r] sta [l] txa sta [r] sw6 pld plx tsc clc adc #8 tcs phx rts ; ; local data ; lsize entry ds 4 local copy of size end **************************************************************** * * srand - seed the random number generator * * Inputs: * 4,S - random number seed * **************************************************************** * srand start lda #1 sta >~srand phb plx ply pla phy phx plb brl ~RANX2 end **************************************************************** * * strtol - convert a string to a long * * Inputs: * str - pointer to the string * ptr - pointer to a pointer; a pointer to the first * char past the number is placed here. If ptr is * nil, no pointer is returned * base - base of the number * * Outputs: * X-A - converted number * **************************************************************** * strtol start base equ 18 base ptr equ 14 *return pointer str equ 10 string pointer rtl equ 7 return address val equ 3 value negative equ 1 is the number negative? pea 0 make room for & initialize negative pea 0 make room for & initialize val pea 0 tsc set up direct page addressing phd tcd ; ; Skip any leading whitespace ; lda ptr if ptr in non-null then ora ptr+2 beq sw1 lda str initialize it to str sta [ptr] ldy #2 lda str+2 sta [ptr],Y sw1 lda [str] skip the white space and #$00FF tax lda >__ctype+1,X and #_space beq cn0 inc4 str bra sw1 ; ; Convert the number ; cn0 lda [str] if the next char is '-' then and #$00FF cmp #'-' bne cn1 inc negative negative := true bra cn2 ++str cn1 cmp #'+' else if the char is '+' then bne cn3 cn2 inc4 str ++str cn3 ph4 str save the starting string ph2 base convert the unsigned number ph4 ptr ph4 str jsl strtoul stx val+2 sta val txy see if we have an overflow bpl rt1 ; ; Overflow - flag the error ; lda #ERANGE errno = ERANGE sta >errno lda ptr if ptr <> NULL then ora ptr+2 bne rt1 lda 1,S *ptr = original str sta [ptr] ldy #2 lda 3,S sta [ptr],Y ; ; return the results ; rt1 pla remove the original value of str from pla the stack lda negative if negative then beq rt2 sub4 #0,val,val val = -val rt2 ldx val+2 get the value ldy val lda rtl fix the stack sta base-1 lda rtl+1 sta base pld tsc clc adc #16 tcs tya return rtl end **************************************************************** * * strtoul - convert a string to an unsigned long * * Inputs: * str - pointer to the string * ptr - pointer to a pointer; a pointer to the first * char past the number is placed here. If ptr is * nil, no pointer is returned * base - base of the number * * Outputs: * X-A - converted number * **************************************************************** * strtoul start base equ 18 base ptr equ 14 *return pointer str equ 10 string pointer rtl equ 7 return address val equ 3 value foundOne equ 1 have we found a number? pea 0 make room for & initialize foundOne pea 0 make room for & initialize val pea 0 tsc set up direct page addressing phd tcd ; ; Skip any leading whitespace ; lda ptr if ptr in non-null then ora ptr+2 beq sw1 lda str initialize it to str sta [ptr] ldy #2 lda str+2 sta [ptr],Y sw1 lda [str] skip the white space and #$00FF tax lda >__ctype+1,X and #_space beq db1 inc4 str bra sw1 ; ; Deduce the base ; db1 lda [str] skip any leading '+' and #$00FF cmp #'+' bne db1a inc4 str db1a lda base if the base is zero then bne db2 lda #10 assume base 10 sta base lda [str] if the first char is 0 then and #$00FF cmp #'0' bne db2 lda #8 assume base 8 sta base ldy #1 if the second char is 'X' or 'x' then lda [str],Y and #$005F cmp #'X' bne db2 asl base base 16 db2 lda [str] if the first two chars are 0x or 0X then and #$5F7F cmp #'X0' bne cn1 add4 str,#2 skip them lda base make sure the base is 16 cmp #16 bne returnERANGE ; ; Convert the number ; cn1 lda [str] get a (possible) digit and #$00FF cmp #'0' branch if it is not a digit blt cn5 cmp #'9'+1 branch if it is a numeric digit blt cn2 and #$005F convert lowercase to uppercase cmp #'A' branch if it is not a digit blt cn5 cmp #'Z'+1 branch if it is not a digit bge cn5 sbc #'A'-11 convert "alpha" digit to value bra cn3 go test the digit cn2 and #$000F convert digit to value cn3 cmp base branch if the digit is too big bge cn5 ldx #1 note that we have found a number stx foundOne pha save the digit pha val = val*base pha pha pha ph4 val pea 0 ph2 base _LongMul pl4 val pla branch if there was an error ora 1,S plx ply tax bne returnERANGE clc add in the new digit tya adc val sta val bcc cn4 inc val+2 beq returnERANGE cn4 inc4 str next char bra cn1 cn5 lda foundOne if no digits were found, flag the error bne rt1 ; ; flag an error ; returnERANGE anop lda #ERANGE errno = ERANGE sta >errno bra rt2 skip setting ptr ; ; return the results ; rt1 lda ptr if ptr is non-null then ora ptr+2 beq rt2 lda str set it to str sta [ptr] ldy #2 lda str+2 sta [ptr],Y rt2 ldx val+2 get the value ldy val lda rtl fix the stack sta base-1 lda rtl+1 sta base pld tsc clc adc #16 tcs tya return rtl end **************************************************************** * * int system(command) * char *command; * * Executes the command steam as an exec file. * * Inputs: * command - command string * * Outputs: * Returns the status of the command * **************************************************************** * system start phb get the addr of the string from the phk stack plb plx ply pla sta exComm pla sta exComm+2 phy execute the command phx plb Execute ex rtl ex dc i'$8000' exComm ds 4 end **************************************************************** * * void __va_end(list) * va_list list; * * Remove variable length arguments from the stack. * * Inputs: * list - Pointer to an array. The second element is a * pointer to the first variable argument, while * the first is a pointer to the first byte past * the argument list. * * Notes: * 1. The number of bytes to remove must be even. * 2. D is incremented by the # of bytes removed. * **************************************************************** * __va_end start list equ 7 pointer to the array D equ 1 caller's DP phb save the caller's data bank phd save the caller's D reg tsc set up our stack frame tcd sec calculate the # of bytes to be removed ldy #4 lda [list] sbc [list],Y sta >toRemove clc update the caller's DP adc D sta D lda [list],Y set the source address tax dex lda [list] set the destination address tay dey sec set the # of bytes to move - 1 tsc sbc [list] eor #$FFFF mvp 0,0 move the bytes clc update out stack ptr tsc adc >toRemove tcs pld resore the caller's DP plx remove the parameter from the stack ply pla pla phy phx plb restore the caller's data bank rtl toRemove ds 2 # bytes to remove end \ No newline at end of file diff --git a/stdlib.macros b/stdlib.macros new file mode 100755 index 0000000..4331c34 --- /dev/null +++ b/stdlib.macros @@ -0,0 +1 @@ + MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND MACRO &lab csubroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta 1 .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+4+&work &totallen seta &totallen+&len &i seta &i+1 aif &i<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend MACRO &lab creturn &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+2 sta &worklen+&totallen+2 lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend MACRO &LAB ~SETM &LAB ANOP AIF C:&~LA,.B GBLB &~LA GBLB &~LI .B &~LA SETB S:LONGA &~LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) LONGA ON LONGI ON .A MEND MACRO &LAB ~RESTM &LAB ANOP AIF (&~LA+&~LI)=2,.I SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) AIF &~LA,.H LONGA OFF .H AIF &~LI,.I LONGI OFF .I MEND MACRO &LAB ADD4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~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 MACRO &LAB MUL4 &N1,&N2,&N3 &LAB ~SETM PH4 &N1 PH4 &N2 JSL ~MUL4 AIF C:&N3,.A PL4 &N1 AGO .B .A PL4 &N3 .B ~RESTM MEND MACRO &LAB SUB4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~SETM AIF C:&M3,.A &C AMID "&M2",1,1 AIF "&C"<>"#",.A &C AMID "&M1",1,1 AIF "&C"="{",.A AIF "&C"="[",.A &C AMID "&M2",2,L:&M2-1 AIF &C>=65536,.A SEC ~LDA &M1 ~OP SBC,&M2 ~STA &M1 BCS ~&SYSCNT ~OP.H DEC,&M1 ~&SYSCNT ANOP AGO .C .A AIF C:&M3,.B LCLC &M3 &M3 SETC &M1 .B SEC ~LDA &M1 ~OP SBC,&M2 ~STA &M3 ~LDA.H &M1 ~OP.H SBC,&M2 ~STA.H &M3 .C ~RESTM MEND MACRO &LAB ~OP.H &OPC,&OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C &OPC &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" &OPC &OP MEXIT .E &OPC 2+&OP MEND MACRO &LAB ~LDA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C LDA &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" LDA &OP MEXIT .E LDA 2+&OP MEND MACRO &LAB ~STA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C STA &OP MEXIT .D STA 2+&OP MEND MACRO &LAB ~LDA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB LDA &OP MEND MACRO &LAB ~STA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB STA &OP MEND MACRO &LAB ~OP &OPC,&OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB &OPC &OP MEND MACRO &LAB BGT &BP &LAB BEQ *+4 BGE &BP MEND MACRO &LAB DEC4 &A &LAB ~SETM LDA &A BNE ~&SYSCNT DEC 2+&A ~&SYSCNT DEC &A ~RESTM MEND MACRO &LAB INC4 &A &LAB ~SETM INC &A BNE ~&SYSCNT INC 2+&A ~&SYSCNT ~RESTM MEND MACRO &LAB 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 &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB PH2 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PL4 &N1 LCLC &C &LAB ANOP AIF S:LONGA=1,.A REP #%00100000 .A &C AMID &N1,1,1 AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.F &N1 AMID &N1,2,L:&N1-2 PLA STA (&N1) LDY #2 PLA STA (&N1),Y AGO .D .B AIF "&C"<>"[",.C PLA STA &N1 LDY #2 PLA STA &N1,Y AGO .D .C PLA STA &N1 PLA STA &N1+2 .D AIF S:LONGA=1,.E SEP #%00100000 .E MEXIT .F MNOTE "Missing closing '}'",16 MEND MACRO &LAB 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 &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND MACRO &LAB EXECUTE &DCB &LAB ~SETM JSL $E100A8 DC I2'$010D' DC I4'&DCB' ~RESTM MEND MACRO &LAB _LONGMUL &LAB LDX #$0C0B JSL $E10000 MEND MACRO &LAB LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND MACRO &LAB SUB2 &N1,&N2,&N3 AIF C:&N3,.A LCLC &N3 &N3 SETC &N1 .A &LAB ~SETM SEC ~LDA &N1 ~OP SBC,&N2 ~STA &N3 ~RESTM MEND MACRO &LAB READ_VARIABLE &DCB &LAB ~SETM JSL $E100A8 DC I2'$010B' DC I4'&DCB' ~RESTM MEND \ No newline at end of file diff --git a/string.asm b/string.asm new file mode 100755 index 0000000..85e55dd --- /dev/null +++ b/string.asm @@ -0,0 +1 @@ + keep obj/string case on mcopy string.macros **************************************************************** * * String - String Processing Library * * This code implements the subroutines needed to support the * standard C library STRING. * * December 1988 * Mike Westerfield * * Copyright 1988 * Byte Works, Inc. * **************************************************************** * String start dummy routine end **************************************************************** * * c2pCommon - common work buffer for c2pstr and p2cstr * **************************************************************** * c2pCommon privdata str1 ds 258 end **************************************************************** * * char *c2pstr(str) * char *str; * * Inputs: * str - pointer to the c string to convert * * Outputs: * Returns a pointer to the p string. * * Notes: * Any characters after the 255th are truncated without * warning. * **************************************************************** * c2pstr start using c2pCommon addr equ 1 csubroutine (4:str),4 phb phk plb short I,M ldy #0 lb1 lda [str],Y sta str1+1,Y beq lb2 iny bne lb1 dey lb2 sty str1 long I,M lla addr,str1 plb creturn 4:addr end **************************************************************** * * makeset - create a set of characters * * This subroutine is called by strspn, strcspn, strpbrk and * strrpbrk to create a set of characters. * * Inputs: * set - pointer to the set of characters * * Outputs: * strset - set of bytes; non-sero for chars in set * **************************************************************** * makeset private set equ 8 string set lda set if the set is null then ora set+2 beq lb3 return lda #0 clear the string set sta >strset phb move strset,strset+1,#255 plb short I,M while there are chars in the set do ldy #0 lb1 lda [set],Y beq lb2 tax set the array element for this char lda #1 sta >strset,X iny endwhile bne lb1 inc set+1 bne lb1 inc set+2 bra lb1 lb2 long I,M lb3 rts end **************************************************************** * * memchr - find a byte in memory * * Returns a pointer to the byte in memory * * Inputs: * ptr - first byte to search * val - byte to search for * len - # bytes to search * * Outputs: * A,X - pointer to the byte; NULL for no match * **************************************************************** * memchr start ptr equ 4 pointer to the first byte val equ 8 byte to search for len equ 10 # bytes to search rtl equ 1 return address tsc establish DP addressing phd tcd short M ldy #0 ldx len+2 scan 64K blocks beq lb1a lb1 lda [ptr],Y cmp val beq lb3 iny bne lb1 inc ptr+2 dex bne lb1 lb1a ldx len beq lb2a lb2 lda [ptr],Y scan the remaining characters cmp val beq lb3 iny dex bne lb2 lb2a long M no match found -> return NULL ldx #0 txy bra lb4 lb3 long M compute the length tya clc adc ptr tay ldx ptr+2 bcc lb4 inx lb4 lda rtl+1 remove parameters from the stack sta len+2 lda rtl sta len+1 pld tsc clc adc #10 tcs tya return the pointer in X-A rtl end **************************************************************** * * memcmp - memory compare * * Compare *s1 to *s2. If *s1 < *s2 then return -1; if they are * equal, return 0; otherwise, return 1. * * Inputs: * p1 - string to concatonate to * p2 - string to concatonate * * Outputs: * A - result * **************************************************************** * memcmp start p1 equ 4 pointer to memory area 1 p2 equ 8 pointer to memory area 2 len equ 12 length to compare rtl equ 1 return address tsc establish DP addressing phd tcd short M ldy #0 scan 64K chunks ldx len+2 beq lb2 lb1 lda [p1],Y cmp [p2],Y bne lb4 iny bne lb1 inc p1+2 inc p2+2 dex bne lb1 lb2 ldx len beq lb5 lb3 lda [p1],Y scan until the end of memory is reached cmp [p2],Y or a difference is found bne lb4 iny dex bne lb3 ldx #0 memory matches bra lb5 lb4 blt less memory differs - set the result ldx #1 bra lb5 less ldx #-1 lb5 long M lda rtl remove the parameters from the stack sta len+1 lda rtl+1 sta len+2 pld tsc clc adc #12 tcs txa return the result rtl end **************************************************************** * * memcpy - memory copy * * Copy len bytes from p1 to p2. * * Inputs: * p1 - destination pointer * p2 - source pointer * len - # bytes to copy * * Outputs: * X-A - p1 * * Notes: The memory areas should not overlap * **************************************************************** * memcpy start p1 equ 4 destination pointer p2 equ 8 source pointer len equ 12 length to compare rtl equ 1 return address tsc establish DP addressing phd tcd ph4 p1 save the dest pointer lda len if there are an odd # of bytes then lsr A bcc lb1 short M move 1 byte now lda [p2] sta [p1] long M dec len inc4 p1 inc4 p2 lb1 anop endif ldx len+2 move full banks of memory beq lb1b ldy #0 lb1a lda [p2],Y sta [p1],Y dey dey bne lb1a inc p2+2 inc p1+2 dex bne lb1a lb1b ldy len move len bytes beq lb4 dey dey beq lb3 lb2 lda [p2],Y sta [p1],Y dey dey bne lb2 lb3 lda [p2] sta [p1] lb4 ply get the original source pointer plx lda rtl remove the parameters from the stack sta len+1 lda rtl+1 sta len+2 pld tsc clc adc #12 tcs tya return the result rtl end **************************************************************** * * memmove - memory move * * Move len bytes from p1 to p2. * * Inputs: * p1 - destination pointer * p2 - source pointer * len - # bytes to copy * * Outputs: * X-A - p2 * * Notes: The memory areas may overlap; the move will still work * **************************************************************** * memmove start p1 equ 4 destination pointer p2 equ 8 source pointer len equ 12 length to compare rtl equ 1 return address tsc establish DP addressing phd tcd ph4 p1 save the dest pointer lda p1+2 if p1 < p2 then cmp p2+2 bne lb1 lda p1 cmp p2 lb1 bge lb5 short M move len bytes, starting with the 1st ldy #0 ldx len+2 move 64K chunks beq lb3 lb2 lda [p2],Y sta [p1],Y iny bne lb2 inc p2+2 inc p1+2 dex bne lb2 lb3 ldx len skip if there are no more bytes to beq lb11 move lb4 lda [p2],Y move the remaining bytes sta [p1],Y iny dex bne lb4 bra lb11 else longa on lb5 add2 p1+2,len+2 move len bytes, starting from the end add2 p2+2,len+2 short M ldy len branch if there are no individual beq lb8 bytes to move dey move the individual bytes beq lb7 lb6 lda [p2],Y sta [p1],Y dey bne lb6 lb7 lda [p2] sta [p1] lb8 ldx len+2 branch if there are no 64K chunks to beq lb11 move lb9 dec p1+2 move the 64K chunks dec p2+2 ldy #$FFFF lb10 lda [p2],Y sta [p1],Y dey bne lb10 lda [p2] sta [p1] dex bne lb9 lb11 long M ply get the original source pointer plx lda rtl remove the parameters from the stack sta len+1 lda rtl+1 sta len+2 pld tsc clc adc #12 tcs tya return the result rtl end **************************************************************** * * memset - set memory to a value * * Set len bytes, starting at p, to val. * * Inputs: * p - destination pointer * val - value (byte!) to set memory to * len - # bytes to set * * Outputs: * X-A - p * * Notes: The memory areas should not overlap * **************************************************************** * memset start p equ 4 destination pointer val equ 8 source pointer len equ 10 length to compare rtl equ 1 return address tsc establish DP addressing phd tcd ph4 p save the pointer lda val form a 2 byte value xba ora val sta val lda len if there are an odd # of bytes then lsr A bcc lb1 short M set 1 byte now lda val sta [p] long M dec len inc4 p lb1 anop endif lda val set len bytes ldx len+2 set full banks beq lb1b ldy #0 lb1a sta [p],Y dey dey bne lb1a inc p+2 dex bne lb1a lb1b ldy len set a partial bank beq lb4 dey dey beq lb3 lb2 sta [p],Y dey dey bne lb2 lb3 sta [p] lb4 ply get the original source pointer plx lda rtl remove the parameters from the stack sta len+1 lda rtl+1 sta len+2 pld tsc clc adc #10 tcs tya return the result rtl end **************************************************************** * * char *p2cstr(str) * char *str; * * Inputs: * str - pointer to the p string to convert * * Outputs: * Returns a pointer to the c string. * **************************************************************** * p2cstr start using c2pCommon addr equ 1 csubroutine (4:str),4 phb phk plb short I,M lda [str] tay lda #0 sta str1,Y tyx beq lb2 lb1 lda [str],Y sta str1-1,Y dey bne lb1 lb2 long I,M lla addr,str1 plb creturn 4:addr end **************************************************************** * * strcat - string concatonation * * Place *s2 at the end of *s1, returning a pointer to *s1. No * checking for length is performed. * * Inputs: * s1 - string to concatonate to * s2 - string to concatonate * * Outputs: * X-A - pointer to the result (s1) * **************************************************************** * strcat start s1 equ 8 pointer to string 1 s2 equ 12 pointer to string 2 rtl equ 5 return address rval equ 1 string value to return lda 6,S save the starting value of s1 pha lda 6,S pha tsc establish DP addressing phd tcd ldy #0 advance s1 to point to the terminating short M null lb1 lda [s1],Y beq lb2 iny bne lb1 inc s1+2 bra lb1 lb2 long M tya clc adc s1 sta s1 short M copy characters 'til the null is found ldy #0 lb3 lda [s2],Y sta [s1],Y beq lb4 iny bne lb3 inc s1+2 inc s2+2 bra lb3 lb4 long M return to the caller lda rtl sta s2+1 lda rtl+1 sta s2+2 ldx rval+2 ldy rval pld tsc clc adc #12 tcs tya rtl end **************************************************************** * * strchr - find a character in a string * * Returns a pointer to the character in the string * * Inputs: * str - string to search * c - character to search for * * Outputs: * A,X - pointer to the character; NULL for no match * **************************************************************** * strchr start str equ 4 pointer to the string c equ 8 character tsc establish DP addressing phd tcd short M advance s1 to point to the char ldy #0 lb1 lda [str],Y cmp c beq lb3 cmp #0 beq lb2 iny bne lb1 inc str+2 bra lb1 lb2 long M no match found -> return NULL ldy #0 tyx bra lb4 lb3 long M compute the length tya clc adc str tay ldx str+2 bcc lb4 inx lb4 pld remove parameters from the stack lda 2,S sta 8,S pla sta 5,S pla pla tya return the pointer in X-A rtl end **************************************************************** * * strcmp - string compare * * Compare *s1 to *s2. If *s1 < *s2 then return -1; if they are * equal, return 0; otherwise, return 1. * * Inputs: * s1 - first string ptr * s2 - second string ptr * * Outputs: * A - result * **************************************************************** * strcmp start s1 equ 4 pointer to string 1 s2 equ 8 pointer to string 2 rtl equ 1 return address tsc establish DP addressing phd tcd ldy #0 scan until the end of string is reached short M or a difference is found lb1 lda [s1],Y beq lb2 cmp [s2],Y bne lb3 iny bne lb1 inc s1+2 inc s2+2 bra lb1 lb2 ldx #0 s1 is finished. If s2 is, too, the lda [s2],Y strings are equal. beq lb4 less ldx #-1 It wasn't, so *s1 < *s2 bra lb4 lb3 blt less the strings differ - set the result ldx #1 lb4 long M lda rtl remove the parameters from the stack sta s2+1 lda rtl+1 sta s2+2 pld tsc clc adc #8 tcs txa return the result rtl end **************************************************************** * * strcpy - string copy * * Copy string *s2 to string *s1. Return a pointer to s1. * * Inputs: * s1 - string to copy to * s2 - string to copy * * Outputs: * X-A - pointer to the result (s1) * **************************************************************** * strcpy start s1 equ 8 pointer to string 1 s2 equ 12 pointer to string 2 rtl equ 5 return address rval equ 1 string value to return lda 6,S save the starting value of s1 pha lda 6,S pha tsc establish DP addressing phd tcd short M copy characters 'til the null is found ldy #0 lb1 lda [s2],Y sta [s1],Y beq lb2 iny bne lb1 inc s1+2 inc s2+2 bra lb1 lb2 long M return to the caller lda rtl sta s2+1 lda rtl+1 sta s2+2 ldx rval+2 ldy rval pld tsc clc adc #12 tcs tya rtl end **************************************************************** * * strcspn - find the first char in s in set * * Inputs: * s - pointer to the string to scan * set - set of characters to check against * * Outputs: * A - disp to first char in s * **************************************************************** * strcspn start s equ 4 string to scan set equ 8 set of characters rtl equ 1 return address tsc establish DP addressing phd tcd jsr makeset form the set of characters stz set set initial displacement stz set+2 short I,M scan for a matching char ldy #0 lb1 lda [s],Y beq lb2 tax lda >strset,X bne lb2 iny bne lb1 long M inc s+1 inc set+1 short M bra lb1 lb2 sty set set the disp past the current disp long I,M ldx set+2 get the return value ldy set lda rtl+1 remove the parameters sta set+2 lda rtl sta set+1 pld tsc clc adc #8 tcs tya return the disp rtl end **************************************************************** * * strerror - return the addr of an error message * * Inputs: * err - error number to return the error for * **************************************************************** * strerror start phb get the error number plx ply pla phy phx phk use local data bank plb asl A compute the index asl A tay ldx sys_errlist+2,Y load the address lda sys_errlist,Y plb restore caller's data bank rtl end **************************************************************** * * strlen - find the length of a string * * Returns the length of the string. * * Inputs: * str - string to find the length of * * Outputs: * X-A - length of the string * **************************************************************** * strlen start str equ 4 pointer to the string tsc establish DP addressing phd tcd ldy #0 advance s1 to point to the terminating ldx #0 null short M lb1 lda [str],Y beq lb2 iny bne lb1 inx inc str+2 bra lb1 lb2 long M pld remove str from the stack lda 2,S sta 6,S pla sta 3,S pla tya return the length rtl end **************************************************************** * * strncat - string concatonation with max length * * Place *s2 at the end of *s1, returning a pointer to *s1. No * checking for length is performed. * * Inputs: * s1 - string to concatonate to * s2 - string to concatonate * n - max # chars to copy * * Outputs: * X-A - pointer to the result (s1) * **************************************************************** * strncat start rval equ 1 string value to return csubroutine (4:s1,4:s2,4:n),4 move4 s1,rval save the address to return ldy #0 advance s1 to point to the terminating short M null lb1 lda [s1],Y beq lb2 iny bne lb1 inc s1+2 bra lb1 lb2 long M tya clc adc s1 sta s1 short M copy characters 'til the null is found ldy #0 ldx n beq lb4 bmi lb4 lb3 lda [s2],Y sta [s1],Y beq lb4 iny dex bne lb3 lda n+2 beq lb4 dec n+2 bra lb3 lb4 lda #0 write the terminating null sta [s1],Y long M return to the caller creturn 4:rval end **************************************************************** * * strncmp - string compare; max length of n * * Compare *s1 to *s2. If *s1 < *s2 then return -1; if they are * equal, return 0; otherwise, return 1. * * Inputs: * s1 - string to concatonate to * s2 - string to concatonate * n - max length of the strings * * Outputs: * A - result * **************************************************************** * strncmp start flag equ 1 return flag csubroutine (4:s1,4:s2,4:n),2 ldy #0 scan until the end of string is reached ldx n+2 or a difference is found bmi equal bne lb0 ldx n beq equal lb0 ldx n short M lb1 lda [s1],Y beq lb2 cmp [s2],Y bne lb3 dex bne lb1a lda n+2 beq equal dec n+2 lb1a iny bne lb1 inc s1+2 inc s2+2 bra lb1 lb2 ldx #0 s1 is finished. If s2 is, too, the lda [s2],Y strings are equal. beq lb4 less ldx #-1 It wasn't, so *s1 < *s2 bra lb4 equal ldx #0 bra lb4 lb3 blt less the strings differ - set the result ldx #1 lb4 stx flag return the result long M creturn 2:flag end **************************************************************** * * strncpy - string copy; max length of n * * Copy string *s2 to string *s1. Return a pointer to s1. * * Inputs: * s1 - string to copy to * s2 - string to copy * n - max length of the string * * Outputs: * X-A - pointer to the result (s1) * **************************************************************** * strncpy start rval equ 1 string value to return csubroutine (4:s1,4:s2,4:n),4 move4 s1,rval save the address to return short M copy characters 'til the null is found ldy #0 or we have copied n characters ldx n+2 bmi lb4 bne lb0 ldx n beq lb4 lb0 ldx n lb1 lda [s2],Y sta [s1],Y beq lb2 dex bne lb1a lda n+2 beq lb4 dec n+2 lb1a iny bne lb1 inc s1+2 inc s2+2 bra lb1 lb3 iny null terminate the string sta [s1],Y lb2 dex bne lb3 lb4 long M return to the caller creturn 4:rval end **************************************************************** * * strpbrk - find the first char in s in set * * Inputs: * s - pointer to the string to scan * set - set of characters to check against * * Outputs: * X-A - pointer to first char in s; NULL if none found * **************************************************************** * strpbrk start s equ 4 string to scan set equ 8 set of characters rtl equ 1 return address tsc establish DP addressing phd tcd jsr makeset form the set of characters short I,M scan for a matching char ldy #0 lb1 lda [s],Y beq lb2 tax lda >strset,X bne lb3 iny bne lb1 long M inc s+1 short M bra lb1 lb2 long I,M no match found -> return NULL ldx #0 txy bra lb4 lb3 long I,M increment s by Y and load the value tya and #$00FF clc adc s tay lda s+2 adc #0 tax lb4 lda rtl+1 remove the parameters sta set+2 lda rtl sta set+1 pld tsc clc adc #8 tcs tya return the ptr rtl end **************************************************************** * * strpos - find a character in a string * * Returns the position of a character in a string * * Inputs: * str - string to search * c - character to search for * * Outputs: * A - position of the character; -1 of none * **************************************************************** * strpos start str equ 4 pointer to the string c equ 8 character tsc establish DP addressing phd tcd ldy #0 advance s1 to point to the char short M lb1 lda [str],Y cmp c beq lb3 cmp #0 beq lb2 iny bpl lb1 lb2 ldy #-1 no match found -> return -1 lb3 long M pld remove parameters from the stack lda 2,S sta 8,S pla sta 5,S pla pla tya return the result rtl end **************************************************************** * * strrchr - find the last occurrance of a character in a string * * Returns a pointer to the last occurrance of the character * * Inputs: * str - string to search * c - character to search for * * Outputs: * A,X - pointer to the character; NULL for no match * **************************************************************** * strrchr start str equ 8 pointer to the string c equ 12 character ptr equ 1 result pointer pea 0 initialize the result pea 0 tsc establish DP addressing phd tcd short M advance s1 to point to the char ldy #0 lb1 lda [str],Y cmp c beq lb3 cmp #0 beq lb4 lb2 iny bne lb1 inc str+2 bra lb1 lb3 long M compute the pointer tya clc adc str sta ptr lda str+2 adc #0 sta ptr+2 sep #$20 lda [str],Y bne lb2 lb4 long M pld rest DP ply remove the return value plx lda 2,S remove the parameters sta 8,S pla sta 5,S pla pla tya return the pointer in X-A rtl end **************************************************************** * * strrpos - find the last occurrance of a character in a string * * Returns the position of the las occurrance of the character * * Inputs: * str - string to search * c - character to search for * * Outputs: * A - position of the character; -1 of none * **************************************************************** * strrpos start str equ 4 pointer to the string c equ 8 character tsc establish DP addressing phd tcd ldx #-1 assume we won't find it ldy #0 advance s1 to point to the char short M lb1 lda [str],Y cmp c bne lb2 tyx lb2 cmp #0 beq lb3 iny bpl lb1 lb3 long M pld remove parameters from the stack lda 2,S sta 8,S pla sta 5,S pla pla txa return the result rtl end **************************************************************** * * strrpbrk - find the first char in s in set * * Inputs: * s - pointer to the string to scan * set - set of characters to check against * * Outputs: * X-A - pointer to first char in s; NULL if none found * **************************************************************** * strrpbrk start s equ 4 string to scan set equ 8 set of characters rtl equ 1 return address tsc establish DP addressing phd tcd jsr makeset form the set of characters stz set assume no match will be found stz set+2 short I,M scan for a matching char ldy #0 lb1 lda [s],Y beq lb4 tax lda >strset,X bne lb3 lb2 iny bne lb1 long M inc s+1 short M bra lb1 lb3 long I,M set the address of the match found tya and #$00FF clc adc s sta set lda s+2 adc #0 sta set+2 short I,M bra lb2 lb4 long I,M ldy set get the address ldx set+2 lda rtl+1 remove the parameters sta set+2 lda rtl sta set+1 pld tsc clc adc #8 tcs tya return the ptr rtl end **************************************************************** * * strset - work area for string operations * **************************************************************** * strset private ds 256 end **************************************************************** * * strspn - find the first char in s not in set * * Inputs: * s - pointer to the string to scan * set - set of characters to check against * * Outputs: * A - disp to first char not in s * **************************************************************** * strspn start s equ 4 string to scan set equ 8 set of characters rtl equ 1 return address tsc establish DP addressing phd tcd jsr makeset form the set of characters stz set set initial displacement stz set+2 short I,M scan for a non-matching char ldy #0 lb1 lda [s],Y beq lb2 tax lda >strset,X beq lb2 iny bne lb1 long M inc s+1 inc set+1 short M bra lb1 lb2 sty set set the disp past the current disp long I,M ldx set+2 get the return value ldy set lda rtl+1 remove the parameters sta set+2 lda rtl sta set+1 pld tsc clc adc #8 tcs tya return the disp rtl end **************************************************************** * * strstr - string search * * Inputs: * src - string to search * sub - string to search for * * Outputs: * X-A - pointer to the string; NULL if not found * **************************************************************** * strstr start len equ 1 length of remaining string - strlen(sub) lensub equ 5 strlen(sub) p1 equ 9 temp pointer p2 equ 13 cnt equ 17 temp counter num1 equ 21 temp number workLen equ 24 length of work space src equ workLen+4 string to scan sub equ workLen+8 string to search for rtl equ workLen+1 return address ; ; Set up our local variables ; tsc create work space sec sbc #workLen tcs tsc establish DP addressing phd tcd phb use local data areas phk plb ; ; Calculate the max # chars we can search ; lda sub if the search string is null, return null ora sub+2 beq fl2 lda src if the string to search is null, ora src+2 return null beq fl2 ph4 sub get the length of the search string jsl strlen stx strset+2 sta strset stx lensub+2 sta lensub ora lensub+2 if the length is 0 then jeq rt1 return the search string ph4 src get the length of the string to search jsl strlen sec subtract off the length of the search sbc lensub string bvs fl2 sta len txa sbc lensub+2 sta len+2 bpl fl3 if there aren't enough chars for a match fl2 stz src stz src+2 then return NULL brl rt1 fl3 anop ; ; Set up the displacement array (used to see how far we can shift) ; lda strset+1 if strlen(sub) > 255 then ora strset+2 use 255 for the max move beq ds1 lda #255 sta strset ds1 move strset,strset+1,#255 init all char disps to strlen(sub) lda strset skip if the length is 1 and #$00FF dec A beq ds5 stz cnt no chars processed so far stz cnt+2 move4 sub,p1 for each char but the last do ds3 lda [p1] branch if this is the last char and #$FF00 beq ds5 sub4 lensub,cnt,num1 compute strlen(sub) - cnt - 1 dec4 num1 lda num1+1 ora num1+2 bne ds4 if the result is <= 255 then short I,M set the char index lda [p1] tax lda num1 sta strset,X long I,M ds4 inc4 cnt next char inc4 p1 bra ds3 ds5 anop ; ; Search for the string ; ss0 lda lensub if the length of the sreach string is and #$8000 > 32767 then use a long method ora lensub+2 beq ss3 add4 lensub,src,p1 set the pointer to the end of the dec4 p1 string to search add4 lensub,sub,p2 set the pointer to the end of the dec4 p2 search string move4 lensub,cnt set the # chars to check ss1 lda [p1] branch if the characters do not match eor [p2] and #$00FF bne ss2 dec4 p1 match - next char dec4 p2 dec4 cnt lda cnt ora cnt+2 bne ss1 bra rt1 match - return the pointer ss2 add4 lensub,src,p1 no match - find the skip length dec4 p1 lda [p1] bra ss6 go to common handling for no match ss3 ldy lensub strlen(sub) < 32K, so use fast search dey short M ss4 lda [src],Y cmp [sub],Y bne ss5 dey bpl ss4 long M match - return the pointer bra rt1 ss5 long M no match - find the skip length ldy lensub dey lda [src],Y ss6 and #$00FF tax lda strset,X and #$00FF sta cnt update the source string pointer clc adc src sta src bcc ss7 inc src+2 ss7 sec update the # of chars left lda len sbc cnt sta len lda len+2 sbc #0 sta len+2 jcs ss0 go try for another match stz src no match - return NULL stz src+2 ; ; Return to the caller ; rt1 ldx src+2 get the return value ldy src lda rtl+1 remove the parameters sta sub+2 lda rtl sta sub+1 plb pld tsc clc adc #8+workLen tcs tya return the disp rtl end **************************************************************** * * strtok - find a token * * Inputs: * s - pointer to the string to scan * set - set of characters to check against * * Outputs: * X-A - pointer to the token; NULL if none * **************************************************************** * strtok start s equ 4 string to scan set equ 8 set of characters rtl equ 1 return address tsc establish DP addressing phd tcd phb use our local direct page phk plb jsr makeset form the set of characters lda s if s is not NULL then ora s+2 beq lb3 short I,M scan for a non-matching char ldy s stz s lb1 lda [s],Y tax lda strset,X beq lb2 iny bne lb1 long M inc s+1 short M bra lb1 lb2 sty s set the disp past the current disp long I,M bra lb4 else lb3 lda isp s := internal state pointer ldx isp+2 sta s stx s+2 lb4 anop endif lda [s] if we are at the end of the string then and #$00FF bne lb5 stz set return NULL stz set+2 stz isp set the isp to NULL stz isp+2 bra lb10 else lb5 lda [s] scan to the 1st char not in the set and #$00FF beq lb8a tax lda strset,X and #$00FF beq lb6 inc4 s bra lb5 lb6 lda s return a ptr to the string sta set lda s+2 sta set+2 lb7 lda [s] scan to the 1st char in the set and #$00FF beq lb8a tax lda strset,X and #$00FF bne lb8 inc4 s bra lb7 lb8 short M if a match was found then lda #0 null terminate the token sta [s] long I,M set isp to the char past the token add4 s,#1,isp bra lb9 lb8a long I,M else stz isp set isp to NULL stz isp+2 lb9 anop endif lb10 ldx set+2 get the return value ldy set lda rtl+1 remove the parameters sta set+2 lda rtl sta set+1 plb pld tsc clc adc #8 tcs tya return the disp rtl isp ds 4 internal state pointer (isp) end \ No newline at end of file diff --git a/string.macros b/string.macros new file mode 100755 index 0000000..0feb2e9 --- /dev/null +++ b/string.macros @@ -0,0 +1 @@ + MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND MACRO &lab csubroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta 1 .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+4+&work &totallen seta &totallen+&len &i seta &i+1 aif &i<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend MACRO &lab creturn &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+2 sta &worklen+&totallen+2 lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend MACRO &LAB ~SETM &LAB ANOP AIF C:&~LA,.B GBLB &~LA GBLB &~LI .B &~LA SETB S:LONGA &~LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) LONGA ON LONGI ON .A MEND MACRO &LAB ~RESTM &LAB ANOP AIF (&~LA+&~LI)=2,.I SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) AIF &~LA,.H LONGA OFF .H AIF &~LI,.I LONGI OFF .I MEND MACRO &LAB ADD2 &N1,&N2,&N3 AIF C:&N3,.A LCLC &N3 &N3 SETC &N1 .A &LAB ~SETM CLC ~LDA &N1 ~OP ADC,&N2 ~STA &N3 ~RESTM MEND MACRO &LAB ~LDA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB LDA &OP MEND MACRO &LAB ~STA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB STA &OP MEND MACRO &LAB ~OP &OPC,&OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB &OPC &OP MEND MACRO &LAB ADD4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~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 MACRO &LAB SUB4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~SETM AIF C:&M3,.A &C AMID "&M2",1,1 AIF "&C"<>"#",.A &C AMID "&M1",1,1 AIF "&C"="{",.A AIF "&C"="[",.A &C AMID "&M2",2,L:&M2-1 AIF &C>=65536,.A SEC ~LDA &M1 ~OP SBC,&M2 ~STA &M1 BCS ~&SYSCNT ~OP.H DEC,&M1 ~&SYSCNT ANOP AGO .C .A AIF C:&M3,.B LCLC &M3 &M3 SETC &M1 .B SEC ~LDA &M1 ~OP SBC,&M2 ~STA &M3 ~LDA.H &M1 ~OP.H SBC,&M2 ~STA.H &M3 .C ~RESTM MEND MACRO &LAB ~OP.H &OPC,&OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C &OPC &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" &OPC &OP MEXIT .E &OPC 2+&OP MEND MACRO &LAB ~LDA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C LDA &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" LDA &OP MEXIT .E LDA 2+&OP MEND MACRO &LAB ~STA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C STA &OP MEXIT .D STA 2+&OP MEND MACRO &LAB DEC4 &A &LAB ~SETM LDA &A BNE ~&SYSCNT DEC 2+&A ~&SYSCNT DEC &A ~RESTM MEND MACRO &LAB INC4 &A &LAB ~SETM INC &A BNE ~&SYSCNT INC 2+&A ~&SYSCNT ~RESTM MEND MACRO &LAB JCS &BP &LAB BCC *+5 BRL &BP MEND MACRO &LAB 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 &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB MOVE &AD1,&AD2,&LEN &LAB ANOP LCLB &LA LCLB &LI LCLC &C AIF C:&LEN,.A1 LCLC &LEN &LEN SETC #2 .A1 &LA SETB S:LONGA &LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&LA)+16*(.NOT.&LI) LONGA ON LONGI ON .A &C AMID &LEN,1,1 AIF "&C"<>"#",.D &C AMID &LEN,2,L:&LEN-1 AIF &C<>2,.D &C AMID &AD1,1,1 AIF "&C"<>"{",.B &AD1 AMID &AD1,2,L:&AD1-2 &AD1 SETC (&AD1) .B LDA &AD1 &C AMID &AD2,1,1 AIF "&C"<>"{",.C &AD2 AMID &AD2,2,L:&AD2-2 &AD2 SETC (&AD2) .C STA &AD2 AGO .G .D &C AMID &AD1,1,1 AIF "&C"="#",.F &C AMID &LEN,1,1 AIF "&C"<>"{",.E &LEN AMID &LEN,2,L:&LEN-2 &LEN SETC (&LEN) .E &C AMID &LEN,1,1 AIF "&C"="#",.E1 LDA &LEN DEC A AGO .E2 .E1 LDA &LEN-1 .E2 LDX #&AD1 LDY #&AD2 MVN &AD1,&AD2 AGO .G .F LDA &AD1 STA &AD2 LDA &LEN-1 LDX #&AD2 LDY #&AD2+1 MVN &AD2,&AD2 .G AIF (&LA+&LI)=2,.I SEP #32*(.NOT.&LA)+16*(.NOT.&LI) AIF &LA,.H LONGA OFF .H AIF &LI,.I LONGI OFF .I MEND MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB SHORT &A,&B LCLB &I LCLB &M &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 &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND MACRO &LAB LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND macro &l jeq &bp &l bne *+5 brl &bp mend \ No newline at end of file diff --git a/time.asm b/time.asm new file mode 100755 index 0000000..3aa14c4 --- /dev/null +++ b/time.asm @@ -0,0 +1 @@ + keep obj/time mcopy time.macros case on **************************************************************** * * Time - Time and date libraries for C * * This code implements the tables and subroutines needed to * support the standard C library TIME. * * January 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * * Note: Portions of this library appear in SysFloat * **************************************************************** * Time start dummy segment end **************************************************************** * * TimeCommon - common variables for the time library * **************************************************************** * TimeCommon privdata ; ; For conversion to/from seconds since 1970 ; year ds 4 year 0..99 month ds 4 month 1..12 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 t1 ds 4 work variable t2 ds 4 work variable end **************************************************************** * * char *asctime(struct tm *ts) * * Inputs: * ts - time record to create string for * * Outputs: * returns a pointer to the time string * **************************************************************** * asctime start csubroutine (4:ts),0 phb phk plb brl ~ctime2 end **************************************************************** * * clock_t clock() * * Outputs: * X-A - tick count * **************************************************************** * clock start pha pha _GetTick pla plx rtl end **************************************************************** * * char *ctime(timeptr) * time_t *timptr; * * Inputs: * timeptr - time to create string for * * Outputs: * returns a pointer to the time string * **************************************************************** * ctime start tm_sec equ 0 displacements into the time record tm_min equ 2 tm_hour equ 4 tm_mday equ 6 tm_mon equ 8 tm_year equ 10 tm_wday equ 12 csubroutine (4:timeptr),0 phb phk plb ph4 timeptr convert to a time record jsl localtime sta timeptr stx timeptr+2 ~ctime2 entry ldy #tm_wday convert the week day to a string lda [timeptr],Y asl a asl a tax lda weekDay,X sta str lda weekDay+1,X sta str+1 ldy #tm_mon convert the month to a string lda [timeptr],Y asl a asl a tax lda monthStr,X sta str+4 lda monthStr+1,X sta str+5 ldy #tm_mday convert the day to a string lda [timeptr],Y jsr mkstr sta str+8 ldy #tm_hour convert the hour to a string lda [timeptr],Y jsr mkstr sta str+11 ldy #tm_min convert minutes to a string lda [timeptr],Y jsr mkstr sta str+14 ldy #tm_sec convert seconds to a string lda [timeptr],Y jsr mkstr sta str+17 ldy #tm_year convert the year to a string lda #'91' sta str+20 lda [timeptr],Y cmp #100 blt lb1 ldx #'02' stx str+20 sec sbc #100 lb1 jsr mkstr sta str+22 lla timeptr,str plb creturn 4:timeptr weekDay dc c'Sun Mon Tue Wed Thu Fri Sat' monthStr dc c'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec' str dc c'Sun Jan 00 00:00:00 1900',i1'10,0' ; ; mkstr - convert a number to a string ; mkstr ldx #-1 mk1 inx sec sbc #10 bcs mk1 clc adc #10 xba pha txa ora 1,S ora #$3030 plx rts end **************************************************************** * * factor - compute the seconds since 1 Jan 1970 from date * * Inputs: * year,month,day,hour,minute,second - time to convert * * Outputs: * count - seconds since 1 Jan 1970 * **************************************************************** * factor private using TimeCommon ; ; compute the # of days since 1 Jan 1970 ; 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 lda month if January or February then cmp #3 bge lb1 dec 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 inc4 t2 mul4 t2,#3 div4 t2,#4 sub4 count,t2 sub4 count,#25516 subtract off days between 1 Jan 00 and ! 1 Jan 70 ; ; 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 mul4 minute,#60,t1 add in minutes*60 add4 count,t1 add4 count,second add in seconds rts end **************************************************************** * * struct tm *localtime(t) * time_t *t; * * Inputs: * t - # seconds since 1 Jan 1970 * * Outputs: * returns a pointer to a time record * **************************************************************** * localtime start gmtime entry using TimeCommon csubroutine (4:t),0 phb phk plb ldy #2 dereference the pointer lda [t],Y tax lda [t] sta t stx t+2 lda #69 find the year sta year lda #1 sta month sta day stz hour stz minute stz second lb1 inc year jsr factor lda count+2 cmp t+2 bne lb1a lda count cmp t lb1a ble lb1 dec year lb2 inc month find the month jsr factor lda count+2 cmp t+2 bne lb2a lda count cmp t lb2a ble lb2 dec month jsr factor recompute the factor 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 div4 t,#60 mul4 t,#60,t2 sub4 t1,t2 lda t1 sta tm_sec move4 t,t1 find the number of minutes div4 t,#60 mul4 t,#60,t2 sub4 t1,t2 lda t1 sta tm_min move4 t,t1 find the number of hours div4 t,#24 mul4 t,#24,t2 sub4 t1,t2 lda t1 sta tm_hour lda t set the day inc A sta tm_mday ph4 #tm_sec set the day of week/year jsl mktime pha determine if it's daylight savings ph2 #$5E _ReadBParam pla lsr A and #$0001 eor #$0001 sta tm_isdst lla t,tm_sec 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 end **************************************************************** * * time_t mktime(tmptr) * struct tm *tmptr * * Inputs: * tmptr - poiner to a time record * * Outputs: * tmptr->wday - day of week * tmptr->yday - day of year * returns the ime in seconds since 1 Jan 1970 * **************************************************************** * mktime start using TimeCommon temp equ 1 temp variable temp2 equ 5 temp variable csubroutine (4:tmptr),8 phb phk plb lla temp,-1 assume we can't do it ldy #10 error if year < 70 lda [tmptr],Y sta year cmp #70 jlt lb1 dey set the other time parameters dey lda [tmptr],Y inc A sta month dey dey lda [tmptr],Y sta day dey dey lda [tmptr],Y sta hour dey dey lda [tmptr],Y sta minute lda [tmptr] sta second jsr factor compute seconds since 1970 move4 count,temp save the value for later return lda #1 compute the days since the start of the sta month year sta day jsr factor sub4 temp,count,count div4 count,#60*60*24 ldy #14 set the days lda count inc A 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 lb1 plb creturn 4:temp end **************************************************************** * * time_t time(tptr) * time_t *tptr; * * Outputs: * tptr - if non-null, the value it points to is set * time - returns the value * **************************************************************** * time start using TimeCommon csubroutine (4:tptr),0 phb phk plb ; ; get the current time ; pha get the current time pha pha pha _ReadTimeHex lda 5,S set the day and #$00FF inc A sta day lda 5,S set the month and #$FF00 xba inc A sta month lda 3,S set the year and #$FF00 xba sta year lda 3,S set the hour and #$00FF sta hour lda 1,S set the minute xba and #$00FF sta minute pla set the second and #$00FF sta second pla clean up the stack pla pla jsr factor convert the seconds lda tptr if tptr <> nil then ora tptr+2 beq lb1 ldy #2 place the result there lda count sta [tptr] lda count+2 sta [tptr],Y lb1 move4 count,tptr plb creturn 4:tptr end \ No newline at end of file diff --git a/time.macros b/time.macros new file mode 100755 index 0000000..46b0993 --- /dev/null +++ b/time.macros @@ -0,0 +1 @@ + MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND MACRO &lab csubroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta 1 .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+4+&work &totallen seta &totallen+&len &i seta &i+1 aif &i<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend MACRO &lab creturn &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+2 sta &worklen+&totallen+2 lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend MACRO &LAB ~SETM &LAB ANOP AIF C:&~LA,.B GBLB &~LA GBLB &~LI .B &~LA SETB S:LONGA &~LI SETB S:LONGI AIF S:LONGA.AND.S:LONGI,.A REP #32*(.NOT.&~LA)+16*(.NOT.&~LI) LONGA ON LONGI ON .A MEND MACRO &LAB ~RESTM &LAB ANOP AIF (&~LA+&~LI)=2,.I SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI) AIF &~LA,.H LONGA OFF .H AIF &~LI,.I LONGI OFF .I MEND MACRO &LAB ADD4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~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 MACRO &LAB DIV4 &N1,&N2,&N3 &LAB ~SETM PH4 &N1 PH4 &N2 JSL ~DIV4 AIF C:&N3,.A PL4 &N1 AGO .B .A PL4 &N3 .B PLA PLA ~RESTM MEND MACRO &LAB MOD4 &N1,&N2,&N3 &LAB ~SETM PH4 &N1 PH4 &N2 JSL ~MOD4 PLA PLA AIF C:&N3,.A PL4 &N1 AGO .B .A PL4 &N3 .B ~RESTM MEND MACRO &LAB MUL4 &N1,&N2,&N3 &LAB ~SETM PH4 &N1 PH4 &N2 JSL ~MUL4 AIF C:&N3,.A PL4 &N1 AGO .B .A PL4 &N3 .B ~RESTM MEND MACRO &LAB SUB4 &M1,&M2,&M3 LCLB &YISTWO LCLC &C &LAB ~SETM AIF C:&M3,.A &C AMID "&M2",1,1 AIF "&C"<>"#",.A &C AMID "&M1",1,1 AIF "&C"="{",.A AIF "&C"="[",.A &C AMID "&M2",2,L:&M2-1 AIF &C>=65536,.A SEC ~LDA &M1 ~OP SBC,&M2 ~STA &M1 BCS ~&SYSCNT ~OP.H DEC,&M1 ~&SYSCNT ANOP AGO .C .A AIF C:&M3,.B LCLC &M3 &M3 SETC &M1 .B SEC ~LDA &M1 ~OP SBC,&M2 ~STA &M3 ~LDA.H &M1 ~OP.H SBC,&M2 ~STA.H &M3 .C ~RESTM MEND MACRO &LAB ~OP.H &OPC,&OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C &OPC &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" &OPC &OP MEXIT .E &OPC 2+&OP MEND MACRO &LAB ~LDA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C LDA &OP MEXIT .D AIF "&C"<>"#",.E &OP AMID "&OP",2,L:&OP-1 &OP SETC "#^&OP" LDA &OP MEXIT .E LDA 2+&OP MEND MACRO &LAB ~STA.H &OP &LAB ANOP LCLC &C &C AMID "&OP",1,1 AIF "&C"="[",.B AIF "&C"<>"{",.D &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B AIF &YISTWO,.C &YISTWO SETB 1 LDY #2 &OP SETC "&OP,Y" .C STA &OP MEXIT .D STA 2+&OP MEND MACRO &LAB ~LDA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB LDA &OP MEND MACRO &LAB ~STA &OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB STA &OP MEND MACRO &LAB ~OP &OPC,&OP LCLC &C &C AMID "&OP",1,1 AIF "&C"<>"{",.B &C AMID "&OP",L:&OP,1 AIF "&C"="}",.A MNOTE "Missing closing '}'",2 &OP SETC &OP} .A &OP AMID "&OP",2,L:&OP-2 &OP SETC (&OP) .B &LAB &OPC &OP MEND MACRO &LAB INC4 &A &LAB ~SETM INC &A BNE ~&SYSCNT INC 2+&A ~&SYSCNT ~RESTM MEND MACRO &LAB JLT &BP &LAB BGE *+5 BRL &BP MEND MACRO &LAB LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PL4 &N1 LCLC &C &LAB ANOP AIF S:LONGA=1,.A REP #%00100000 .A &C AMID &N1,1,1 AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.F &N1 AMID &N1,2,L:&N1-2 PLA STA (&N1) LDY #2 PLA STA (&N1),Y AGO .D .B AIF "&C"<>"[",.C PLA STA &N1 LDY #2 PLA STA &N1,Y AGO .D .C PLA STA &N1 PLA STA &N1+2 .D AIF S:LONGA=1,.E SEP #%00100000 .E MEXIT .F MNOTE "Missing closing '}'",16 MEND MACRO &LAB _READTIMEHEX &LAB LDX #$0D03 JSL $E10000 MEND MACRO &LAB _GETTICK &LAB LDX #$2503 JSL $E10000 MEND macro &l ble &bp &l blt &bp beq &bp mend macro &l ph2 &n1 aif "&n1"="*",.f lclc &c &l anop &c amid &n1,1,1 aif "&c"="#",.d aif s:longa=1,.a rep #%00100000 .a aif "&c"<>"{",.b &c amid &n1,l:&n1,1 aif "&c"<>"}",.g &n1 amid &n1,2,l:&n1-2 lda (&n1) pha ago .e .b aif "&c"="<",.c lda &n1 pha ago .e .c &n1 amid &n1,2,l:&n1-1 pei &n1 ago .e .d &n1 amid &n1,2,l:&n1-1 pea &n1 ago .f .e aif s:longa=1,.f sep #%00100000 .f mexit .g mnote "Missing closing '}'",16 mend MACRO &lab _ReadBParam &lab ldx #$0C03 jsl $E10000 MEND \ No newline at end of file diff --git a/toolglue.asm b/toolglue.asm new file mode 100755 index 0000000..8c38f45 --- /dev/null +++ b/toolglue.asm @@ -0,0 +1 @@ + keep obj/toolglue mcopy toolglue.macros case on **************************************************************** * * ToolGlue - Glue routines for tools that return records * * June 1989 * Mike Westerfield * * Copyright 1989, 1990, 1992 * Byte Works, Inc. * **************************************************************** * * November 1992 * * Parameter orders corrected. * **************************************************************** * * August 1990 * * 1. Restart() has been corrected to expect a single * parameter. In the previous version of the library, * it expected the same parameter list as InitialLoad(). * * 2. All tool calls now store the tool error number returned * by the toolbox in ~toolError. * **************************************************************** * ToolGlue start dummy routine end **************************************************************** * * MiscTool - Miscelaneous tool kit * **************************************************************** * * FWEntry - Firmware Entry * * Inputs: * aRegValue, xRegValue, yRegValue - registers on entry * eModeEntryPt - call address * * Outputs: * Returns a pointer to a record with the following * structure: * * typedef struct FWRec { * int yRegExit; * int xRegExit; * int aRegExit; * int status; * } * **************************************************************** * FWEntry start addr equ 1 work pointer csubroutine (2:aRegValue,2:xRegValue,2:yRegValue,2:eModeEntryPt),4 pha pha pha pha ph2 aRegValue ph2 xRegValue ph2 yRegValue ph2 eModeEntryPt _FWEntry sta >~TOOLERROR pl2 >yRegExit pl2 >xRegExit pl2 >aRegExit pl2 >status lla addr,yRegExit creturn 4:addr yRegExit ds 2 record returned xRegExit ds 2 aRegExit ds 2 status ds 2 end **************************************************************** * * GetAbsClamp - returns the absolute device clamp * * Outputs: * Returns a pointer to a record with the following * structure: * * typedef struct ClampRec { * int yMaxClamp; * int yMinClamp; * int xMaxClamp; * int xMinClamp; * } * **************************************************************** * GetAbsClamp start pha pha pha pha _GetAbsClamp sta >~TOOLERROR pl2 >yMaxClamp pl2 >yMinClamp pl2 >xMaxClamp pl2 >xMinClamp lda #yMaxClamp ldx #^yMaxClamp rtl yMaxClamp ds 2 record returned yMinClamp ds 2 xMaxClamp ds 2 xMinClamp ds 2 end **************************************************************** * * GetMouseClamp - returns the mouse clamp * * Outputs: * Returns a pointer to a record with the following * structure: * * typedef struct ClampRec { * int yMaxClamp; * int yMinClamp; * int xMaxClamp; * int xMinClamp; * } * **************************************************************** * GetMouseClamp start pha pha pha pha _GetMouseClamp sta >~TOOLERROR pl2 >yMaxClamp pl2 >yMinClamp pl2 >xMaxClamp pl2 >xMinClamp lda #yMaxClamp ldx #^yMaxClamp rtl yMaxClamp ds 2 record returned yMinClamp ds 2 xMaxClamp ds 2 xMinClamp ds 2 end **************************************************************** * * ReadMouse - return mouse statistics * * Outputs: * Returns a pointer to a record with the following * structure: * * typedef struct MouseRec { * char mouseMode; * char mouseStatus; * int yPos; * int xPos; * } * **************************************************************** * ReadMouse start pha pha pha _ReadMouse sta >~TOOLERROR pl2 >mouseMode pl2 >yPos pl2 >xPos lda #mouseMode ldx #^mouseMode rtl mouseMode ds 1 mouseStatus ds 1 yPos ds 2 xPos ds 2 end **************************************************************** * * ReadTimeHex - returns the time in hex format * * Outputs: * Returns a pointer to a record with the following * structure: * * typedef struct TimeRec { * char second; * char minute; * char hour; * char year; * char day; * char month; * char extra; * char weekDay; * } * **************************************************************** * ReadTimeHex start pha pha pha pha _ReadTimeHex sta >~TOOLERROR pl2 >second pl2 >hour pl2 >day pl2 >extra lda #second ldx #^second rtl second ds 1 minute ds 1 hour ds 1 year ds 1 day ds 1 month ds 1 extra ds 1 weekDay ds 1 end **************************************************************** * * IntMath - Integer Math Tool Kit * **************************************************************** * * extern LongDivRec LongDivide(); * * typedef struct LongDivRec { * Longint quotient; /* LongDivRec - Quotient from LongDiv*/ * Longint remainder; /* LongDivRec - remainder from LongDiv*/ * } * **************************************************************** * LongDivide start addr equ 1 csubroutine (4:dividend,4:divisor),4 tsc sec sbc #8 tcs ph4 dividend ph4 divisor _LongDivide sta >~TOOLERROR pl4 >quotient pl4 >remainder lla addr,quotient creturn 4:addr quotient ds 4 remainder ds 4 end **************************************************************** * * extern LongMulRec LongMul(); * * typedef struct LongMulRec { * Longint lsResult; /* LongMulRec - Low Long of result*/ * Longint msResult; /* LongMulRec - High long of result*/ * } * **************************************************************** * LongMul start addr equ 1 csubroutine (4:multiplicand,4:multiplier),4 tsc sec sbc #8 tcs ph4 multiplicand ph4 multiplier _LongMul sta >~TOOLERROR pl4 >lsResult pl4 >msResult lla addr,lsResult creturn 4:addr lsResult ds 4 msResult ds 4 end **************************************************************** * * extern IntDivRec SDivide(); * * typedef struct IntDivRec { * Integer quotient; /* IntDivRec - quotient from SDivide*/ * Integer remainder; /* IntDivRec - remainder from SDivide*/ * } IntDivRec, *IntDivRecPtr ; * **************************************************************** * SDivide start addr equ 1 csubroutine (2:dividend,2:divisor),4 pha pha ph2 dividend ph2 divisor _SDivide sta >~TOOLERROR pl2 >quotient pl2 >remainder lla addr,quotient creturn 4:addr quotient ds 2 remainder ds 2 end **************************************************************** * * extern IntDivRec UDivide(); * * typedef struct IntDivRec { * Integer quotient; /* IntDivRec - quotient from SDivide*/ * Integer remainder; /* IntDivRec - remainder from SDivide*/ * } IntDivRec, *IntDivRecPtr ; * **************************************************************** * UDivide start addr equ 1 csubroutine (2:dividend,2:divisor),4 pha pha ph2 dividend ph2 divisor _UDivide sta >~TOOLERROR pl2 >quotient pl2 >remainder lla addr,quotient creturn 4:addr quotient ds 2 remainder ds 2 end **************************************************************** * * Loader * **************************************************************** * * extern InitialLoadOutputRec InitialLoad(); * * typedef struct InitialLoadOutputRec { * Word userID; * Pointer startAddr; * Word dPageAddr; * Word buffSize; * } * **************************************************************** * InitialLoad start addr equ 1 csubroutine (2:uID,4:stAddr,2:dpAddr),4 tsc sec sbc #10 tcs ph2 uID ph4 stAddr ph2 dpAddr _InitialLoad sta >~TOOLERROR pl2 >userID pl4 >startAddr pl2 >dPageAddr pl2 >buffSize lla addr,userID creturn 4:addr userID ds 2 startAddr ds 4 dPageAddr ds 2 buffSize ds 2 end **************************************************************** * * extern InitialLoadOutputRec InitialLoad2(); * * typedef struct InitialLoadOutputRec { * Word buffSize; * Word dPageAddr; * Pointer startAddr; * Word userID; * } * **************************************************************** * InitialLoad2 start addr equ 1 csubroutine (2:uID,4:buffAddr,2:flagWord,2:inputType),4 tsc sec sbc #10 tcs ph2 uID ph4 buffAddr ph2 flagWord ph2 inputType _InitialLoad2 sta >~TOOLERROR pl2 >userID pl4 >startAddr pl2 >dPageAddr pl2 >buffSize lla addr,userID creturn 4:addr userID ds 2 startAddr ds 4 dPageAddr ds 2 buffSize ds 2 end **************************************************************** * * extern LoadSegNameOut LoadSegName(); * * typedef struct LoadSegNameOut { * Pointer segAddr; * Word userID; * Word fileNum; * Word segNum; * } * **************************************************************** * LoadSegName start addr equ 1 csubroutine (2:uID,4:fName,4:sName),4 tsc sec sbc #10 tcs ph2 uID ph4 fName ph4 sName _LoadSegName sta >~TOOLERROR pl4 >segAddr pl2 >userID pl2 >fileNum pl2 >segNum lla addr,segAddr creturn 4:addr segAddr ds 4 userID ds 2 fileNum ds 2 segNum ds 2 end **************************************************************** * * extern InitialLoadOutputRec Restart(); * * typedef struct InitialLoadOutputRec { * Word userID; * Pointer startAddr; * Word dPageAddr; * Word buffSize; * } * **************************************************************** * Restart start addr equ 1 csubroutine (2:uID),4 tsc sec sbc #10 tcs ph2 uID _Restart sta >~TOOLERROR pl2 >userID pl4 >startAddr pl2 >dPageAddr pl2 >buffSize lla addr,userID creturn 4:addr userID ds 2 startAddr ds 4 dPageAddr ds 2 buffSize ds 2 end **************************************************************** * * extern UnloadSegOutRec UnloadSeg(); * * typedef struct UnloadSegOutRec { * Word userID; * Word fileNum; * Word segNum; * } UnloadSegOutRec, *UnloadSegOutRecPtr ; * **************************************************************** * UnloadSeg start addr equ 1 csubroutine (4:segaddr),4 pha pha pha ph4 segaddr _UnloadSeg sta >~TOOLERROR pl2 >userID pl2 >fileNum pl2 >segNum lla addr,userID creturn 4:addr userID ds 2 fileNum ds 2 segNum ds 2 end **************************************************************** * * midiSynth - MIDI Synth Tool Kit * **************************************************************** * * extern LongDivRec LongDivide(); * * typedef struct LongDivRec { * Longint quotient; /* LongDivRec - Quotient from LongDiv*/ * Longint remainder; /* LongDivRec - remainder from LongDiv*/ * } * **************************************************************** * GetMSData start csubroutine (4:reserved,4:DP),0 tsc sec sbc #8 tcs _GetMSData sta >~TOOLERROR ldy #2 pla sta [DP] pla sta [DP],Y pla sta [reserved] pla sta [reserved],Y creturn end **************************************************************** * * Note Sequencer * **************************************************************** * * extern LocRec GetLoc(); * * typedef struct LocRec { * Word curPhraseItem; * Word curPattItem; * Word curLevel; * } LocRec, *LocRecPtr, **LocRecHndl; * **************************************************************** * GetLoc start pha pha pha _GetLoc sta >~TOOLERROR pl2 >curLevel pl2 >curPattItem pl2 >curPhraseItem lda #curPhraseItem ldx #^curPhraseItem rtl curPhraseItem ds 2 curPattItem ds 2 curLevel ds 2 end **************************************************************** * * TextTools * **************************************************************** * * extern TxtMaskRec GetErrGlobals(); * * typedef struct TxtMaskRec { * Word orMask; * Word andMask; * } TxtMaskRec, *TxtMaskRecPtr, **TxtMaskRecHndl ; * **************************************************************** * GetErrGlobals start pha pha _GetErrGlobals sta >~TOOLERROR pl2 >orMask pl2 >andMask lda #orMask ldx #^orMask rtl orMask ds 2 andMask ds 2 end **************************************************************** * * extern DeviceRec GetErrorDevice(); * * typedef struct DeviceRec { * LongWord ptrOrSlot; /* DeviceRec - slot number or jump table ptr*/ * Word deviceType; /* DeviceRec - type of input device*/ * } DeviceRec, *DeviceRecPtr, **DeviceRecHndl ; * **************************************************************** * GetErrorDevice start pha pha pha _GetErrorDevice sta >~TOOLERROR pl4 >ptrOrSlot pl2 >deviceType lda #ptrOrSlot ldx #^ptrOrSlot rtl ptrOrSlot ds 4 deviceType ds 2 end **************************************************************** * * extern TxtMaskRec GetInGlobals(); * * typedef struct TxtMaskRec { * Word orMask; * Word andMask; * } TxtMaskRec, *TxtMaskRecPtr, **TxtMaskRecHndl ; * **************************************************************** * GetInGlobals start pha pha _GetInGlobals sta >~TOOLERROR pl2 >orMask pl2 >andMask lda #orMask ldx #^orMask rtl orMask ds 2 andMask ds 2 end **************************************************************** * * extern DeviceRec GetInputDevice(); * * typedef struct DeviceRec { * LongWord ptrOrSlot; /* DeviceRec - slot number or jump table ptr*/ * Word deviceType; /* DeviceRec - type of input device*/ * } DeviceRec, *DeviceRecPtr, **DeviceRecHndl ; * **************************************************************** * GetInputDevice start pha pha pha _GetInputDevice sta >~TOOLERROR pl4 >ptrOrSlot pl2 >deviceType lda #ptrOrSlot ldx #^ptrOrSlot rtl ptrOrSlot ds 4 deviceType ds 2 end **************************************************************** * * extern TxtMaskRec GetOutGlobals(); * * typedef struct TxtMaskRec { * Word orMask; * Word andMask; * } TxtMaskRec, *TxtMaskRecPtr, **TxtMaskRecHndl ; * **************************************************************** * GetOutGlobals start pha pha _GetOutGlobals sta >~TOOLERROR pl2 >orMask pl2 >andMask lda #orMask ldx #^orMask rtl orMask ds 2 andMask ds 2 end **************************************************************** * * extern DeviceRec GetOutputDevice(); * * typedef struct DeviceRec { * LongWord ptrOrSlot; /* DeviceRec - slot number or jump table ptr*/ * Word deviceType; /* DeviceRec - type of input device*/ * } DeviceRec, *DeviceRecPtr, **DeviceRecHndl ; * **************************************************************** * GetOutputDevice start pha pha pha _GetOutputDevice sta >~TOOLERROR pl4 >ptrOrSlot pl2 >deviceType lda #ptrOrSlot ldx #^ptrOrSlot rtl ptrOrSlot ds 4 deviceType ds 2 end \ No newline at end of file diff --git a/toolglue.macros b/toolglue.macros new file mode 100755 index 0000000..2b31aa2 --- /dev/null +++ b/toolglue.macros @@ -0,0 +1 @@ + MACRO &LAB LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND MACRO &LAB PH2 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PL2 &N1 LCLC &C &LAB ANOP AIF S:LONGA=1,.A REP #%00100000 .A &C AMID &N1,1,1 AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.F &N1 AMID &N1,2,L:&N1-2 PLA STA (&N1) AGO .D .B PLA STA &N1 .D AIF S:LONGA=1,.E SEP #%00100000 .E MEXIT .F MNOTE "Missing closing '}'",16 MEND MACRO &LAB _READTIMEHEX &LAB LDX #$0D03 JSL $E10000 MEND MACRO &LAB _FWENTRY &LAB LDX #$2403 JSL $E10000 MEND MACRO &LAB _GETMOUSECLAMP &LAB LDX #$1D03 JSL $E10000 MEND MACRO &LAB _READMOUSE &LAB LDX #$1703 JSL $E10000 MEND MACRO &LAB _GETABSCLAMP &LAB LDX #$2B03 JSL $E10000 MEND MACRO &lab csubroutine &parms,&work &lab anop aif c:&work,.a lclc &work &work setc 0 .a gbla &totallen gbla &worklen &worklen seta &work &totallen seta 0 aif c:&parms=0,.e lclc &len lclc &p lcla &i &i seta 1 .b &p setc &parms(&i) &len amid &p,2,1 aif "&len"=":",.c &len amid &p,1,2 &p amid &p,4,l:&p-3 ago .d .c &len amid &p,1,1 &p amid &p,3,l:&p-2 .d &p equ &totallen+4+&work &totallen seta &totallen+&len &i seta &i+1 aif &i<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend MACRO &lab creturn &r &lab anop lclc &len aif c:&r,.a lclc &r &r setc 0 &len setc 0 ago .h .a &len amid &r,2,1 aif "&len"=":",.b &len amid &r,1,2 &r amid &r,4,l:&r-3 ago .c .b &len amid &r,1,1 &r amid &r,3,l:&r-2 .c aif &len<>2,.d ldy &r ago .h .d aif &len<>4,.e ldx &r+2 ldy &r ago .h .e aif &len<>10,.g ldy #&r ldx #^&r ago .h .g mnote 'Not a valid return length',16 mexit .h aif &totallen=0,.i lda &worklen+2 sta &worklen+&totallen+2 lda &worklen+1 sta &worklen+&totallen+1 .i pld tsc clc adc #&worklen+&totallen tcs aif &len=0,.j tya .j rtl mend MACRO &LAB PH4 &N1 LCLC &C &LAB ANOP &C AMID &N1,1,1 AIF "&C"="#",.D AIF S:LONGA=1,.A REP #%00100000 .A AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.G &N1 AMID &N1,2,L:&N1-2 LDY #2 LDA (&N1),Y PHA LDA (&N1) PHA AGO .E .B AIF "&C"<>"[",.C LDY #2 LDA &N1,Y PHA LDA &N1 PHA AGO .E .C LDA &N1+2 PHA LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA +(&N1)|-16 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PL4 &N1 LCLC &C &LAB ANOP AIF S:LONGA=1,.A REP #%00100000 .A &C AMID &N1,1,1 AIF "&C"<>"{",.B &C AMID &N1,L:&N1,1 AIF "&C"<>"}",.F &N1 AMID &N1,2,L:&N1-2 PLA STA (&N1) LDY #2 PLA STA (&N1),Y AGO .D .B AIF "&C"<>"[",.C PLA STA &N1 LDY #2 PLA STA &N1,Y AGO .D .C PLA STA &N1 PLA STA &N1+2 .D AIF S:LONGA=1,.E SEP #%00100000 .E MEXIT .F MNOTE "Missing closing '}'",16 MEND MACRO &LAB _LONGDIVIDE &LAB LDX #$0D0B JSL $E10000 MEND MACRO &LAB _LONGMUL &LAB LDX #$0C0B JSL $E10000 MEND MACRO &LAB _SDIVIDE &LAB LDX #$0A0B JSL $E10000 MEND MACRO &LAB _UDIVIDE &LAB LDX #$0B0B JSL $E10000 MEND MACRO &LAB _INITIALLOAD &LAB LDX #$0911 JSL $E10000 MEND MACRO &LAB _RESTART &LAB LDX #$0A11 JSL $E10000 MEND MACRO &LAB _LOADSEGNAME &LAB LDX #$0D11 JSL $E10000 MEND MACRO &LAB _UNLOADSEG &LAB LDX #$0E11 JSL $E10000 MEND MACRO &LAB _GETLOC &LAB LDX #$0C1A JSL $E10000 MEND MACRO &LAB _GETERRGLOBALS &LAB LDX #$0E0C JSL $E10000 MEND MACRO &LAB _GETINGLOBALS &LAB LDX #$0C0C JSL $E10000 MEND MACRO &LAB _GETINPUTDEVICE &LAB LDX #$120C JSL $E10000 MEND MACRO &LAB _GETOUTGLOBALS &LAB LDX #$0D0C JSL $E10000 MEND MACRO &LAB _GETOUTPUTDEVICE &LAB LDX #$130C JSL $E10000 MEND MACRO &LAB _GETERRORDEVICE &LAB LDX #$140C JSL $E10000 MEND MACRO &LAB _INITIALLOAD2 &LAB LDX #$2011 JSL $E10000 MEND MACRO &lab _GetMSData &lab ldx #$1F23 jsl $E10000 MEND \ No newline at end of file diff --git a/vars.asm b/vars.asm new file mode 100755 index 0000000..0956e6b --- /dev/null +++ b/vars.asm @@ -0,0 +1 @@ + keep obj/vars mcopy vars.macros case on **************************************************************** * * VARS.ASM * * This module contains the global variables used by C. When * using the large memory module, these variables are replaced by * GVARS.ASM, which places the variables in the ~GLOBALS * segment. * **************************************************************** * Dummy start (dummy root segment) copy equates.asm end **************************************************************** * * Global variables used by C * **************************************************************** * CVars start errno entry library error number ds 2 _ownerid entry user ID (C) ~USER_ID entry user ID (Pascal, libraries) ds 2 sys_nerr entry # of error messages dc i'6' _toolErr entry last error in a tool call (C) ~TOOLERROR entry last error in a tool call (Pascal) ds 2 end **************************************************************** * * ~InitIO - initialize the standad I/O files * **************************************************************** * ~InitIO start ldx #24 set up the file records lb1 lda stderr+34,X sta stderr+8,X lda stdin+34,X sta stdin+8,X lda stdout+34,X sta stdout+8,X dex dex bpl lb1 lla stderr,stderr+4 set up the file pointers lla stdin,stdin+4 lla stdout,stdout+4 rtl end **************************************************************** * * stderr - error out file * **************************************************************** * stderr start dc a4'lb1' lb1 dc a4'0' next file dc a4'0' next location to write to dc a4'0' first byte of buffer dc a4'0' end of the file buffer dc i4'0' size of the file buffer dc i4'0' count dc i'EOF' putback buffer dc i'_IONBF+_IOWRT+_IOTEXT' no buffering; allow writes; text file dc i'stderrID' error out dc a4'0' next location to write to dc a4'0' first byte of buffer dc a4'0' end of the file buffer dc i4'0' size of the file buffer dc i4'0' count dc i'EOF' putback buffer dc i'_IONBF+_IOWRT+_IOTEXT' no buffering; allow writes; text file dc i'stderrID' error out end **************************************************************** * * stdin - standard in file * **************************************************************** * stdin start dc a4'lb1' lb1 dc a4'stdout+4' next file dc a4'0' next location to write to dc a4'0' first byte of buffer dc a4'0' end of the file buffer dc i4'0' size of the file buffer dc i4'0' count dc i'EOF' putback buffer dc i'_IONBF+_IOREAD+_IOTEXT' no buffering; allow reads; text file dc i'stdinID' standard in dc a4'0' next location to write to dc a4'0' first byte of buffer dc a4'0' end of the file buffer dc i4'0' size of the file buffer dc i4'0' count dc i'EOF' putback buffer dc i'_IONBF+_IOREAD+_IOTEXT' no buffering; allow reads; text file dc i'stdinID' standard in end **************************************************************** * * stdout - standard out file * **************************************************************** * stdout start dc a4'lb1' lb1 dc a4'stderr+4' next file dc a4'0' next location to write to dc a4'0' first byte of buffer dc a4'0' end of the file buffer dc i4'0' size of the file buffer dc i4'0' count dc i'EOF' putback buffer dc i'_IONBF+_IOWRT+_IOTEXT' no buffering; allow writes; text file dc i'stdoutID' standard out dc a4'0' next location to write to dc a4'0' first byte of buffer dc a4'0' end of the file buffer dc i4'0' size of the file buffer dc i4'0' count dc i'EOF' putback buffer dc i'_IONBF+_IOWRT+_IOTEXT' no buffering; allow writes; text file dc i'stdoutID' standard out end \ No newline at end of file diff --git a/vars.macros b/vars.macros new file mode 100755 index 0000000..e676f03 --- /dev/null +++ b/vars.macros @@ -0,0 +1 @@ + MACRO &LAB LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND \ No newline at end of file