Apple-2-SW/prog8
1
0
Fork 0
mirror of https://github.com/irmen/prog8.git synced 2024-06-26 07:29:32 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into multi-assign

Browse Source 
# Conflicts:
#	docs/source/todo.rst
#	examples/test.p8
This commit is contained in:
Irmen de Jong 2024-03-28 01:06:43 +01:00
commit 4700a239b9
12 changed files with 445 additions and 1012 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
compiler/res/prog8lib/atari/textio.p8
View File

@ -3,7 +3,6 @@
%import syslib
%import conv
%import shared_textio_functions
txt {
@ -168,13 +167,13 @@ asmsub print (str text @ AY) clobbers(A,Y) {
asmsub print_ub0 (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, with left padding 0s (3 positions total)
%asm {{
jsr conv.ubyte2decimal
jsr conv.internal_ubyte2decimal
pha
tya
jsr chrout
pla
jsr chrout
txa
jsr chrout
pla
jmp chrout
}}
}
@ -182,21 +181,21 @@ asmsub print_ub0 (ubyte value @ A) clobbers(A,X,Y) {
asmsub print_ub (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, without left padding 0s
%asm {{
jsr conv.ubyte2decimal
jsr conv.internal_ubyte2decimal
_print_byte_digits
pha
cpy #'0'
beq +
tya
jsr chrout
pla
txa
jsr chrout
jmp _ones
+ pla
cmp #'0'
+ cpx #'0'
beq _ones
txa
jsr chrout
_ones txa
_ones pla
jmp chrout
}}
}
@ -210,7 +209,7 @@ asmsub print_b (byte value @ A) clobbers(A,X,Y) {
lda #'-'
jsr chrout
+ pla
jsr conv.byte2decimal
jsr conv.internal_byte2decimal
jmp print_ub._print_byte_digits
}}
}
@ -223,7 +222,7 @@ asmsub print_ubhex (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
lda #'$'
jsr chrout
pla
+ jsr conv.ubyte2hex
+ jsr conv.internal_ubyte2hex
jsr chrout
tya
jmp chrout
@ -277,9 +276,9 @@ asmsub print_uwhex (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
asmsub print_uw0 (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, with left padding 0s (5 positions total)
%asm {{
jsr conv.uword2decimal
jsr conv.internal_uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
- lda conv.internal_uword2decimal.decTenThousands,y
beq +
jsr chrout
iny
@ -291,9 +290,9 @@ asmsub print_uw0 (uword value @ AY) clobbers(A,X,Y) {
asmsub print_uw (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, without left padding 0s
%asm {{
jsr conv.uword2decimal
jsr conv.internal_uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
- lda conv.internal_uword2decimal.decTenThousands,y
beq _allzero
cmp #'0'
bne _gotdigit
@ -303,7 +302,7 @@ asmsub print_uw (uword value @ AY) clobbers(A,X,Y) {
_gotdigit
jsr chrout
iny
lda conv.uword2decimal.decTenThousands,y
lda conv.internal_uword2decimal.decTenThousands,y
bne _gotdigit
rts
_allzero

214
compiler/res/prog8lib/c128/textio.p8
View File

@ -4,7 +4,7 @@
%import syslib
%import conv
%import shared_textio_functions
%import shared_cbm_textio_functions
txt {
@ -13,6 +13,8 @@ txt {
const ubyte DEFAULT_WIDTH = 40
const ubyte DEFAULT_HEIGHT = 25
romsub $FFD2 = chrout(ubyte character @ A) ; for consistency. You can also use cbm.CHROUT directly ofcourse. Note: takes a PETSCII encoded character.
sub clear_screen() {
chrout(147)
@ -288,216 +290,6 @@ _scroll_screen ; scroll only the screen memory
}}
}
romsub $FFD2 = chrout(ubyte char @ A) ; for consistency. You can also use cbm.CHROUT directly ofcourse. Note: takes a PETSCII encoded character.
asmsub print (str text @ AY) clobbers(A,Y) {
; ---- print null terminated string, in PETSCII encoding, from A/Y
; note: the compiler contains an optimization that will replace
; a call to this subroutine with a string argument of just one char,
; by just one call to cbm.CHROUT of that single char.
%asm {{
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
ldy #0
- lda (P8ZP_SCRATCH_B1),y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_ub0 (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, with left padding 0s (3 positions total)
%asm {{
jsr conv.ubyte2decimal
pha
tya
jsr cbm.CHROUT
pla
jsr cbm.CHROUT
txa
jmp cbm.CHROUT
}}
}
asmsub print_ub (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, without left padding 0s
%asm {{
jsr conv.ubyte2decimal
_print_byte_digits
pha
cpy #'0'
beq +
tya
jsr cbm.CHROUT
pla
jsr cbm.CHROUT
jmp _ones
+ pla
cmp #'0'
beq _ones
jsr cbm.CHROUT
_ones txa
jmp cbm.CHROUT
}}
}
asmsub print_b (byte value @ A) clobbers(A,X,Y) {
; ---- print the byte in A in decimal form, without left padding 0s
%asm {{
pha
cmp #0
bpl +
lda #'-'
jsr cbm.CHROUT
+ pla
jsr conv.byte2decimal
jmp print_ub._print_byte_digits
}}
}
asmsub print_ubhex (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the ubyte in A in hex form (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
bcc +
pha
lda #'$'
jsr cbm.CHROUT
pla
+ jsr conv.ubyte2hex
jsr cbm.CHROUT
tya
jmp cbm.CHROUT
}}
}
asmsub print_ubbin (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the ubyte in A in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
sta P8ZP_SCRATCH_B1
bcc +
lda #'%'
jsr cbm.CHROUT
+ ldy #8
- lda #'0'
asl P8ZP_SCRATCH_B1
bcc +
lda #'1'
+ jsr cbm.CHROUT
dey
bne -
rts
}}
}
asmsub print_uwbin (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the uword in A/Y in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
pha
tya
jsr print_ubbin
pla
clc
jmp print_ubbin
}}
}
asmsub print_uwhex (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the uword in A/Y in hexadecimal form (4 digits)
; (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
pha
tya
jsr print_ubhex
pla
clc
jmp print_ubhex
}}
}
asmsub print_uw0 (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, with left padding 0s (5 positions total)
%asm {{
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_uw (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, without left padding 0s
%asm {{
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq _allzero
cmp #'0'
bne _gotdigit
iny
bne -
_gotdigit
jsr cbm.CHROUT
iny
lda conv.uword2decimal.decTenThousands,y
bne _gotdigit
rts
_allzero
lda #'0'
jmp cbm.CHROUT
}}
}
asmsub print_w (word value @ AY) clobbers(A,X,Y) {
; ---- print the (signed) word in A/Y in decimal form, without left padding 0's
%asm {{
cpy #0
bpl +
pha
lda #'-'
jsr cbm.CHROUT
tya
eor #255
tay
pla
eor #255
clc
adc #1
bcc +
iny
+ jmp print_uw
}}
}
asmsub input_chars (uword buffer @ AY) clobbers(A) -> ubyte @ Y {
; ---- Input a string (max. 80 chars) from the keyboard, in PETSCII encoding.
; Returns length in Y. (string is terminated with a 0 byte as well)
; It assumes the keyboard is selected as I/O channel!
%asm {{
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0 ; char counter = 0
- jsr cbm.CHRIN
cmp #$0d ; return (ascii 13) pressed?
beq + ; yes, end.
sta (P8ZP_SCRATCH_W1),y ; else store char in buffer
iny
bne -
+ lda #0
sta (P8ZP_SCRATCH_W1),y ; finish string with 0 byte
rts
}}
}
asmsub setchr (ubyte col @X, ubyte row @Y, ubyte character @A) clobbers(A, Y) {
; ---- sets the character in the screen matrix at the given position
%asm {{

213
compiler/res/prog8lib/c64/textio.p8
View File

@ -4,7 +4,7 @@
%import syslib
%import conv
%import shared_textio_functions
%import shared_cbm_textio_functions
txt {
@ -13,6 +13,7 @@ txt {
const ubyte DEFAULT_WIDTH = 40
const ubyte DEFAULT_HEIGHT = 25
romsub $FFD2 = chrout(ubyte character @ A) ; for consistency. You can also use cbm.CHROUT directly ofcourse. Note: takes a PETSCII encoded character.
sub clear_screen() {
chrout(147)
@ -292,216 +293,6 @@ _scroll_screen ; scroll only the screen memory
}}
}
romsub $FFD2 = chrout(ubyte character @ A) ; for consistency. You can also use cbm.CHROUT directly ofcourse. Note: takes a PETSCII encoded character.
asmsub print (str text @ AY) clobbers(A,Y) {
; ---- print null terminated string, in PESCII encoding, from A/Y
; note: the compiler contains an optimization that will replace
; a call to this subroutine with a string argument of just one char,
; by just one call to cbm.CHROUT of that single char.
%asm {{
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
ldy #0
- lda (P8ZP_SCRATCH_B1),y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_ub0 (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, with left padding 0s (3 positions total)
%asm {{
jsr conv.ubyte2decimal
pha
tya
jsr cbm.CHROUT
pla
jsr cbm.CHROUT
txa
jmp cbm.CHROUT
}}
}
asmsub print_ub (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, without left padding 0s
%asm {{
jsr conv.ubyte2decimal
_print_byte_digits
pha
cpy #'0'
beq +
tya
jsr cbm.CHROUT
pla
jsr cbm.CHROUT
jmp _ones
+ pla
cmp #'0'
beq _ones
jsr cbm.CHROUT
_ones txa
jmp cbm.CHROUT
}}
}
asmsub print_b (byte value @ A) clobbers(A,X,Y) {
; ---- print the byte in A in decimal form, without left padding 0s
%asm {{
pha
cmp #0
bpl +
lda #'-'
jsr cbm.CHROUT
+ pla
jsr conv.byte2decimal
jmp print_ub._print_byte_digits
}}
}
asmsub print_ubhex (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the ubyte in A in hex form (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
bcc +
pha
lda #'$'
jsr cbm.CHROUT
pla
+ jsr conv.ubyte2hex
jsr cbm.CHROUT
tya
jmp cbm.CHROUT
}}
}
asmsub print_ubbin (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the ubyte in A in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
sta P8ZP_SCRATCH_B1
bcc +
lda #'%'
jsr cbm.CHROUT
+ ldy #8
- lda #'0'
asl P8ZP_SCRATCH_B1
bcc +
lda #'1'
+ jsr cbm.CHROUT
dey
bne -
rts
}}
}
asmsub print_uwbin (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the uword in A/Y in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
pha
tya
jsr print_ubbin
pla
clc
jmp print_ubbin
}}
}
asmsub print_uwhex (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the uword in A/Y in hexadecimal form (4 digits)
; (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
pha
tya
jsr print_ubhex
pla
clc
jmp print_ubhex
}}
}
asmsub print_uw0 (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, with left padding 0s (5 positions total)
%asm {{
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_uw (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, without left padding 0s
%asm {{
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq _allzero
cmp #'0'
bne _gotdigit
iny
bne -
_gotdigit
jsr cbm.CHROUT
iny
lda conv.uword2decimal.decTenThousands,y
bne _gotdigit
rts
_allzero
lda #'0'
jmp cbm.CHROUT
}}
}
asmsub print_w (word value @ AY) clobbers(A,X,Y) {
; ---- print the (signed) word in A/Y in decimal form, without left padding 0's
%asm {{
cpy #0
bpl +
pha
lda #'-'
jsr cbm.CHROUT
tya
eor #255
tay
pla
eor #255
clc
adc #1
bcc +
iny
+ jmp print_uw
}}
}
asmsub input_chars (uword buffer @ AY) clobbers(A) -> ubyte @ Y {
; ---- Input a string (max. 80 chars) from the keyboard, in PETSCII encoding.
; Returns length in Y. (string is terminated with a 0 byte as well)
; It assumes the keyboard is selected as I/O channel!
%asm {{
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0 ; char counter = 0
- jsr cbm.CHRIN
cmp #$0d ; return (ascii 13) pressed?
beq + ; yes, end.
sta (P8ZP_SCRATCH_W1),y ; else store char in buffer
iny
bne -
+ lda #0
sta (P8ZP_SCRATCH_W1),y ; finish string with 0 byte
rts
}}
}
asmsub setchr (ubyte col @X, ubyte row @Y, ubyte character @A) clobbers(A, Y) {
; ---- sets the character in the screen matrix at the given position
%asm {{

200
compiler/res/prog8lib/conv.p8
View File

@ -8,97 +8,79 @@ conv {
str @shared string_out = "????????????????" ; result buffer for the string conversion routines
asmsub str_ub0 (ubyte value @ A) clobbers(X) -> str @AY {
; ---- convert the ubyte in A in decimal string form, with left padding 0s (3 positions total)
%asm {{
jsr conv.ubyte2decimal
sty string_out
sta string_out+1
stx string_out+2
lda #0
sta string_out+3
lda #<string_out
ldy #>string_out
rts
}}
}
asmsub str_ub0(ubyte value @A) clobbers(X) -> str @AY {
; ---- convert the ubyte in A in decimal string form, with left padding 0s (3 positions total)
%asm {{
jsr internal_ubyte2decimal
sty conv.string_out
stx conv.string_out+1
sta conv.string_out+2
lda #0
sta conv.string_out+3
lda #<conv.string_out
ldy #>conv.string_out
rts
}}
}
asmsub str_ub (ubyte value @ A) clobbers(X) -> str @AY {
; ---- convert the ubyte in A in decimal string form, without left padding 0s
%asm {{
ldy #0
sty P8ZP_SCRATCH_B1
jsr ubyte2decimal ; result in Y/A/X (100s, 10s, 1s).
; hundreds?
cpy #'0'
beq +
sty string_out
sta string_out+1
stx string_out+2
lda #0
sta string_out+3
jmp _done
; tens?
+ cmp #'0'
beq +
sta string_out
stx string_out+1
lda #0
sta string_out+2
jmp _done
+ ; ones.
stx string_out
lda #0
sta string_out+1
_done lda #<string_out
ldy #>string_out
rts
}}
}
asmsub str_ub(ubyte value @A) clobbers(X) -> str @AY {
; ---- convert the ubyte in A in decimal string form, without left padding 0s
%asm {{
jsr internal_ubyte2decimal
cpy #'0'
beq +
sty conv.string_out
stx conv.string_out+1
sta conv.string_out+2
lda #0
sta conv.string_out+3
jmp _done
+ cpx #'0'
beq +
stx conv.string_out
sta conv.string_out+1
lda #0
sta conv.string_out+2
jmp _done
+ sta conv.string_out
lda #0
sta conv.string_out+1
_done lda #<conv.string_out
ldy #>conv.string_out
rts
}}
}
asmsub str_b (byte value @ A) clobbers(X) -> str @AY {
; ---- convert the byte in A in decimal string form, without left padding 0s
%asm {{
ldy #0
cmp #0
bpl +
ldy #'-'
sty string_out
ldy #1
+ sty P8ZP_SCRATCH_REG
jsr conv.byte2decimal ; result in Y/A/X (100s, 10s, 1s). and in uword2decimal.decHundreds, decTens, decOnes.
; hundreds?
cpy #'0'
bne _out_hundreds
ldy P8ZP_SCRATCH_REG
cmp #'0'
bne _out_tens
beq _out_ones
_out_hundreds
ldy P8ZP_SCRATCH_REG
lda uword2decimal.decHundreds
sta string_out,y
iny
_out_tens
lda uword2decimal.decTens
sta string_out,y
iny
_out_ones
lda uword2decimal.decOnes
sta string_out,y
iny
lda #0
sta string_out,y
lda #<string_out
ldy #>string_out
rts
}}
}
asmsub str_b(byte value @A) clobbers(X) -> str @AY {
; ---- convert the byte in A in decimal string form, without left padding 0s
%asm {{
cmp #0
bpl str_ub
eor #255
clc
adc #1
jsr str_ub
; insert a minus sign at the start
lda #0
sta conv.string_out+4
lda conv.string_out+2
sta conv.string_out+3
lda conv.string_out+1
sta conv.string_out+2
lda conv.string_out
sta conv.string_out+1
lda #'-'
sta conv.string_out
lda #<conv.string_out
ldy #>conv.string_out
rts
}}
}
asmsub str_ubhex (ubyte value @ A) clobbers(X) -> str @AY {
; ---- convert the ubyte in A in hex string form
%asm {{
jsr conv.ubyte2hex
jsr internal_ubyte2hex
sta string_out
sty string_out+1
lda #0
@ -158,11 +140,11 @@ asmsub str_uwhex (uword value @ AY) -> str @AY {
%asm {{
pha
tya
jsr conv.ubyte2hex
jsr internal_ubyte2hex
sta string_out
sty string_out+1
pla
jsr conv.ubyte2hex
jsr internal_ubyte2hex
sta string_out+2
sty string_out+3
lda #0
@ -176,9 +158,9 @@ asmsub str_uwhex (uword value @ AY) -> str @AY {
asmsub str_uw0 (uword value @ AY) clobbers(X) -> str @AY {
; ---- convert the uword in A/Y in decimal string form, with left padding 0s (5 positions total)
%asm {{
jsr conv.uword2decimal
jsr conv.internal_uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
- lda conv.internal_uword2decimal.decTenThousands,y
sta string_out,y
beq +
iny
@ -193,11 +175,11 @@ asmsub str_uw0 (uword value @ AY) clobbers(X) -> str @AY {
asmsub str_uw (uword value @ AY) clobbers(X) -> str @AY {
; ---- convert the uword in A/Y in decimal string form, without left padding 0s
%asm {{
jsr conv.uword2decimal
jsr conv.internal_uword2decimal
ldx #0
_output_digits
ldy #0
- lda conv.uword2decimal.decTenThousands,y
- lda internal_uword2decimal.decTenThousands,y
beq _allzero
cmp #'0'
bne _gotdigit
@ -206,7 +188,7 @@ _output_digits
_gotdigit sta string_out,x
inx
iny
lda conv.uword2decimal.decTenThousands,y
lda internal_uword2decimal.decTenThousands,y
bne _gotdigit
_end lda #0
sta string_out,x
@ -238,7 +220,7 @@ asmsub str_w (word value @ AY) clobbers(X) -> str @AY {
adc #1
bcc +
iny
+ jsr conv.uword2decimal
+ jsr conv.internal_uword2decimal
ldx #1
bne str_uw._output_digits
rts
@ -533,17 +515,25 @@ _stop
; ----- low level number conversions to decimal strings ----
asmsub ubyte2decimal (ubyte value @A) -> ubyte @Y, ubyte @A, ubyte @X {
; ---- A to decimal string in Y/A/X (100s in Y, 10s in A, 1s in X)
%asm {{
ldy #uword2decimal.ASCII_0_OFFSET
jmp uword2decimal.hex_try200
}}
asmsub internal_ubyte2decimal(ubyte value @A) -> ubyte @Y, ubyte @X, ubyte @A {
%asm {{
ldy #'0'-1
ldx #'9'+1
sec
- iny
sbc #100
bcs -
- dex
adc #10
bmi -
adc #'0'-1
rts
}}
}
asmsub uword2decimal (uword value @AY) -> ubyte @Y, ubyte @A, ubyte @X {
asmsub internal_uword2decimal (uword value @AY) -> ubyte @Y, ubyte @A, ubyte @X {
; ---- convert 16 bit uword in A/Y to decimal
; output in uword2decimal.decTenThousands, decThousands, decHundreds, decTens, decOnes
; output in internal_uword2decimal.decTenThousands, decThousands, decHundreds, decTens, decOnes
; (these are terminated by a zero byte so they can be easily printed)
; also returns Y = 100's, A = 10's, X = 1's
@ -716,7 +706,7 @@ decOnes .byte 0
}}
}
asmsub byte2decimal (byte value @A) -> ubyte @Y, ubyte @A, ubyte @X {
asmsub internal_byte2decimal (byte value @A) -> ubyte @Y, ubyte @A, ubyte @X {
; ---- A (signed byte) to decimal string in Y/A/X (100s in Y, 10s in A, 1s in X)
; note: if the number is negative, you have to deal with the '-' yourself!
%asm {{
@ -725,11 +715,11 @@ asmsub byte2decimal (byte value @A) -> ubyte @Y, ubyte @A, ubyte @X {
eor #255
clc
adc #1
+ jmp ubyte2decimal
+ jmp internal_ubyte2decimal
}}
}
asmsub ubyte2hex (ubyte value @A) clobbers(X) -> ubyte @A, ubyte @Y {
asmsub internal_ubyte2hex (ubyte value @A) clobbers(X) -> ubyte @A, ubyte @Y {
; ---- A to hex petscii string in AY (first hex char in A, second hex char in Y)
%asm {{
pha
@ -749,7 +739,7 @@ _hex_digits .text "0123456789abcdef" ; can probably be reused for other stuff as
}}
}
asmsub uword2hex (uword value @AY) clobbers(A,Y) {
asmsub internal_uword2hex (uword value @AY) clobbers(A,Y) {
; ---- convert 16 bit uword in A/Y into 4-character hexadecimal string 'uword2hex.output' (0-terminated)
%asm {{
sta P8ZP_SCRATCH_REG

33
compiler/res/prog8lib/cx16/diskio.p8
View File

@ -525,6 +525,39 @@ io_error:
goto done
}
; similar to above, but instead of fetching the entire string, it only fetches the status code and returns it as ubyte
; in case of IO error, returns 255 (CMDR-DOS itself is physically unable to return such a value)
sub status_code() -> ubyte {
if cbm.READST()==128 {
return 255
}
cbm.SETNAM(0, list_filename)
cbm.SETLFS(15, drivenumber, 15)
void cbm.OPEN() ; open 15,8,15
if_cs
goto io_error
void cbm.CHKIN(15) ; use #15 as input channel
list_filename[0] = cbm.CHRIN()
list_filename[1] = cbm.CHRIN()
list_filename[2] = 0
while cbm.READST()==0 {
void cbm.CHRIN()
}
cbm.CLRCHN() ; restore default i/o devices
cbm.CLOSE(15)
return conv.str2ubyte(list_filename)
io_error:
cbm.CLRCHN()
cbm.CLOSE(15)
return 255
}
; saves a block of memory to disk, including the default 2 byte prg header.
sub save(uword filenameptr, uword startaddress, uword savesize) -> bool {

213
compiler/res/prog8lib/cx16/textio.p8
View File

@ -4,7 +4,7 @@
%import syslib
%import conv
%import shared_textio_functions
%import shared_cbm_textio_functions
txt {
@ -16,6 +16,8 @@ const ubyte DEFAULT_HEIGHT = 60
const ubyte VERA_TEXTMATRIX_BANK = 1
const uword VERA_TEXTMATRIX_ADDR = $b000
romsub $FFD2 = chrout(ubyte character @ A) ; for consistency. You can also use cbm.CHROUT directly ofcourse. Note: takes a PETSCII encoded character.
sub clear_screen() {
chrout(147)
@ -431,215 +433,6 @@ _nextline
}}
}
romsub $FFD2 = chrout(ubyte character @ A) ; for consistency. You can also use cbm.CHROUT directly ofcourse. Note: takes a PETSCII encoded character.
asmsub print (str text @ AY) clobbers(A,Y) {
; ---- print null terminated string, in PETSCII encoding, from A/Y
; note: the compiler contains an optimization that will replace
; a call to this subroutine with a string argument of just one char,
; by just one call to cbm.CHROUT of that single char.
%asm {{
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
ldy #0
- lda (P8ZP_SCRATCH_B1),y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_ub0 (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, with left padding 0s (3 positions total)
%asm {{
jsr conv.ubyte2decimal
pha
tya
jsr cbm.CHROUT
pla
jsr cbm.CHROUT
txa
jmp cbm.CHROUT
}}
}
asmsub print_ub (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, without left padding 0s
%asm {{
jsr conv.ubyte2decimal
_print_byte_digits
pha
cpy #'0'
beq +
tya
jsr cbm.CHROUT
pla
jsr cbm.CHROUT
bra _ones
+ pla
cmp #'0'
beq _ones
jsr cbm.CHROUT
_ones txa
jmp cbm.CHROUT
}}
}
asmsub print_b (byte value @ A) clobbers(A,X,Y) {
; ---- print the byte in A in decimal form, without left padding 0s
%asm {{
pha
cmp #0
bpl +
lda #'-'
jsr cbm.CHROUT
+ pla
jsr conv.byte2decimal
bra print_ub._print_byte_digits
}}
}
asmsub print_ubhex (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the ubyte in A in hex form (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
bcc +
pha
lda #'$'
jsr cbm.CHROUT
pla
+ jsr conv.ubyte2hex
jsr cbm.CHROUT
tya
jmp cbm.CHROUT
}}
}
asmsub print_ubbin (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the ubyte in A in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
sta P8ZP_SCRATCH_B1
bcc +
lda #'%'
jsr cbm.CHROUT
+ ldy #8
- lda #'0'
asl P8ZP_SCRATCH_B1
bcc +
lda #'1'
+ jsr cbm.CHROUT
dey
bne -
rts
}}
}
asmsub print_uwbin (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the uword in A/Y in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
pha
tya
jsr print_ubbin
pla
clc
bra print_ubbin
}}
}
asmsub print_uwhex (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the uword in A/Y in hexadecimal form (4 digits)
; (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
pha
tya
jsr print_ubhex
pla
clc
bra print_ubhex
}}
}
asmsub print_uw0 (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, with left padding 0s (5 positions total)
%asm {{
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_uw (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, without left padding 0s
%asm {{
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq _allzero
cmp #'0'
bne _gotdigit
iny
bne -
_gotdigit
jsr cbm.CHROUT
iny
lda conv.uword2decimal.decTenThousands,y
bne _gotdigit
rts
_allzero
lda #'0'
jmp cbm.CHROUT
}}
}
asmsub print_w (word value @ AY) clobbers(A,X,Y) {
; ---- print the (signed) word in A/Y in decimal form, without left padding 0's
%asm {{
cpy #0
bpl +
pha
lda #'-'
jsr cbm.CHROUT
tya
eor #255
tay
pla
eor #255
ina
bne +
iny
+ bra print_uw
}}
}
asmsub input_chars (uword buffer @ AY) clobbers(A) -> ubyte @ Y {
; ---- Input a string (max. 80 chars) from the keyboard, in PETSCII encoding.
; Returns length in Y. (string is terminated with a 0 byte as well)
; It assumes the keyboard is selected as I/O channel!
%asm {{
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0 ; char counter = 0
- jsr cbm.CHRIN
cmp #$0d ; return (ascii 13) pressed?
beq + ; yes, end.
sta (P8ZP_SCRATCH_W1),y ; else store char in buffer
iny
bne -
+ lda #0
sta (P8ZP_SCRATCH_W1),y ; finish string with 0 byte
rts
}}
}
asmsub setchr (ubyte col @X, ubyte row @Y, ubyte character @A) clobbers(A) {
; ---- sets the character in the screen matrix at the given position
%asm {{

32
compiler/res/prog8lib/diskio.p8
View File

@ -460,6 +460,38 @@ io_error:
goto done
}
; similar to above, but instead of fetching the entire string, it only fetches the status code and returns it as ubyte
; in case of IO error, returns 255 (CBM-DOS itself is physically unable to return such a value)
sub status_code() -> ubyte {
if cbm.READST()==128 {
return 255
}
cbm.SETNAM(0, list_filename)
cbm.SETLFS(15, drivenumber, 15)
void cbm.OPEN() ; open 15,8,15
if_cs
goto io_error
void cbm.CHKIN(15) ; use #15 as input channel
list_filename[0] = cbm.CHRIN()
list_filename[1] = cbm.CHRIN()
list_filename[2] = 0
while cbm.READST()==0 {
void cbm.CHRIN()
}
cbm.CLRCHN() ; restore default i/o devices
cbm.CLOSE(15)
return conv.str2ubyte(list_filename)
io_error:
cbm.CLRCHN()
cbm.CLOSE(15)
return 255
}
sub save(uword filenameptr, uword start_address, uword savesize) -> bool {
cbm.SETNAM(string.length(filenameptr), filenameptr)
cbm.SETLFS(1, drivenumber, 0)

214
compiler/res/prog8lib/pet32/textio.p8
View File

@ -4,7 +4,7 @@
%import syslib
%import conv
%import shared_textio_functions
%import shared_cbm_textio_functions
txt {
%option no_symbol_prefixing, ignore_unused
@ -12,6 +12,8 @@ txt {
const ubyte DEFAULT_WIDTH = 40
const ubyte DEFAULT_HEIGHT = 25
romsub $FFD2 = chrout(ubyte character @ A) ; for consistency. You can also use cbm.CHROUT directly ofcourse. Note: takes a PETSCII encoded character.
sub clear_screen() {
chrout(147)
@ -145,216 +147,6 @@ asmsub scroll_down () clobbers(A,X) {
}}
}
romsub $FFD2 = chrout(ubyte character @ A) ; for consistency. You can also use cbm.CHROUT directly ofcourse. Note: takes a PETSCII encoded character.
asmsub print (str text @ AY) clobbers(A,Y) {
; ---- print null terminated string, in PETSCII encoding, from A/Y
; note: the compiler contains an optimization that will replace
; a call to this subroutine with a string argument of just one char,
; by just one call to cbm.CHROUT of that single char.
%asm {{
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
ldy #0
- lda (P8ZP_SCRATCH_B1),y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_ub0 (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, with left padding 0s (3 positions total)
%asm {{
jsr conv.ubyte2decimal
pha
tya
jsr cbm.CHROUT
pla
jsr cbm.CHROUT
txa
jmp cbm.CHROUT
}}
}
asmsub print_ub (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, without left padding 0s
%asm {{
jsr conv.ubyte2decimal
_print_byte_digits
pha
cpy #'0'
beq +
tya
jsr cbm.CHROUT
pla
jsr cbm.CHROUT
jmp _ones
+ pla
cmp #'0'
beq _ones
jsr cbm.CHROUT
_ones txa
jmp cbm.CHROUT
}}
}
asmsub print_b (byte value @ A) clobbers(A,X,Y) {
; ---- print the byte in A in decimal form, without left padding 0s
%asm {{
pha
cmp #0
bpl +
lda #'-'
jsr cbm.CHROUT
+ pla
jsr conv.byte2decimal
jmp print_ub._print_byte_digits
}}
}
asmsub print_ubhex (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the ubyte in A in hex form (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
bcc +
pha
lda #'$'
jsr cbm.CHROUT
pla
+ jsr conv.ubyte2hex
jsr cbm.CHROUT
tya
jmp cbm.CHROUT
}}
}
asmsub print_ubbin (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the ubyte in A in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
sta P8ZP_SCRATCH_B1
bcc +
lda #'%'
jsr cbm.CHROUT
+ ldy #8
- lda #'0'
asl P8ZP_SCRATCH_B1
bcc +
lda #'1'
+ jsr cbm.CHROUT
dey
bne -
rts
}}
}
asmsub print_uwbin (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the uword in A/Y in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
pha
tya
jsr print_ubbin
pla
clc
jmp print_ubbin
}}
}
asmsub print_uwhex (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the uword in A/Y in hexadecimal form (4 digits)
; (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
pha
tya
jsr print_ubhex
pla
clc
jmp print_ubhex
}}
}
asmsub print_uw0 (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, with left padding 0s (5 positions total)
%asm {{
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_uw (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, without left padding 0s
%asm {{
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq _allzero
cmp #'0'
bne _gotdigit
iny
bne -
_gotdigit
jsr cbm.CHROUT
iny
lda conv.uword2decimal.decTenThousands,y
bne _gotdigit
rts
_allzero
lda #'0'
jmp cbm.CHROUT
}}
}
asmsub print_w (word value @ AY) clobbers(A,X,Y) {
; ---- print the (signed) word in A/Y in decimal form, without left padding 0's
%asm {{
cpy #0
bpl +
pha
lda #'-'
jsr cbm.CHROUT
tya
eor #255
tay
pla
eor #255
clc
adc #1
bcc +
iny
+ jmp print_uw
}}
}
asmsub input_chars (uword buffer @ AY) clobbers(A) -> ubyte @ Y {
; ---- Input a string (max. 80 chars) from the keyboard, in PETSCII encoding.
; Returns length in Y. (string is terminated with a 0 byte as well)
; It assumes the keyboard is selected as I/O channel!
%asm {{
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0 ; char counter = 0
- jsr cbm.CHRIN
cmp #$0d ; return (ascii 13) pressed?
beq + ; yes, end.
sta (P8ZP_SCRATCH_W1),y ; else store char in buffer
iny
bne -
+ lda #0
sta (P8ZP_SCRATCH_W1),y ; finish string with 0 byte
rts
}}
}
asmsub setchr (ubyte col @X, ubyte row @Y, ubyte character @A) clobbers(A, Y) {
; ---- sets the character in the screen matrix at the given position
%asm {{

251
compiler/res/prog8lib/shared_cbm_textio_functions.p8 Normal file
View File

@ -0,0 +1,251 @@
txt {
; the textio functions common across CBM-compatible compiler targets (c64, c128, pet32 and cx16)
%option merge, no_symbol_prefixing, ignore_unused
asmsub print (str text @ AY) clobbers(A,Y) {
; ---- print null terminated string, in PETSCII encoding, from A/Y
; note: the compiler contains an optimization that will replace
; a call to this subroutine with a string argument of just one char,
; by just one call to cbm.CHROUT of that single char.
%asm {{
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
ldy #0
- lda (P8ZP_SCRATCH_B1),y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_ubhex (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the ubyte in A in hex form (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
bcc +
pha
lda #'$'
jsr cbm.CHROUT
pla
+ jsr conv.internal_ubyte2hex
jsr cbm.CHROUT
tya
jmp cbm.CHROUT
}}
}
asmsub print_ubbin (ubyte value @ A, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the ubyte in A in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
sta P8ZP_SCRATCH_B1
bcc +
lda #'%'
jsr cbm.CHROUT
+ ldy #8
- lda #'0'
asl P8ZP_SCRATCH_B1
bcc +
lda #'1'
+ jsr cbm.CHROUT
dey
bne -
rts
}}
}
asmsub print_uwbin (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the uword in A/Y in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
pha
tya
jsr print_ubbin
pla
clc
jmp print_ubbin
}}
}
asmsub print_uwhex (uword value @ AY, bool prefix @ Pc) clobbers(A,X,Y) {
; ---- print the uword in A/Y in hexadecimal form (4 digits)
; (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
pha
tya
jsr print_ubhex
pla
clc
jmp print_ubhex
}}
}
asmsub print_uw0 (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, with left padding 0s (5 positions total)
%asm {{
jsr conv.internal_uword2decimal
ldy #0
- lda conv.internal_uword2decimal.decTenThousands,y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_uw (uword value @ AY) clobbers(A,X,Y) {
; ---- print the uword in A/Y in decimal form, without left padding 0s
%asm {{
jsr conv.internal_uword2decimal
ldy #0
- lda conv.internal_uword2decimal.decTenThousands,y
beq _allzero
cmp #'0'
bne _gotdigit
iny
bne -
_gotdigit jsr cbm.CHROUT
iny
lda conv.internal_uword2decimal.decTenThousands,y
bne _gotdigit
rts
_allzero lda #'0'
jmp cbm.CHROUT
}}
}
asmsub print_w (word value @ AY) clobbers(A,X,Y) {
; ---- print the (signed) word in A/Y in decimal form, without left padding 0's
%asm {{
cpy #0
bpl +
pha
lda #'-'
jsr cbm.CHROUT
tya
eor #255
tay
pla
eor #255
clc
adc #1
bcc +
iny
+ jmp print_uw
}}
}
asmsub input_chars (uword buffer @ AY) clobbers(A) -> ubyte @ Y {
; ---- Input a string (max. 80 chars) from the keyboard, in PETSCII encoding.
; Returns length in Y. (string is terminated with a 0 byte as well)
; It assumes the keyboard is selected as I/O channel!
%asm {{
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0 ; char counter = 0
- jsr cbm.CHRIN
cmp #$0d ; return (ascii 13) pressed?
beq + ; yes, end.
sta (P8ZP_SCRATCH_W1),y ; else store char in buffer
iny
bne -
+ lda #0
sta (P8ZP_SCRATCH_W1),y ; finish string with 0 byte
rts
}}
}
asmsub petscii2scr(ubyte petscii_char @A) -> ubyte @A {
; -- convert petscii character to screencode
%asm {{
sta P8ZP_SCRATCH_REG
lsr a
lsr a
lsr a
lsr a
lsr a
tax
lda _offsets,x
eor P8ZP_SCRATCH_REG
rts
_offsets .byte 128, 0, 64, 32, 64, 192, 128, 128
}}
}
asmsub petscii2scr_str(str petscii_string @AY) {
; -- convert petscii string to screencodes string
%asm {{
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0
- lda (P8ZP_SCRATCH_W1),y
beq +
jsr petscii2scr
sta (P8ZP_SCRATCH_W1),y
iny
bne -
+ rts
}}
}
sub print_bool(bool value) {
if value
txt.print("true")
else
txt.print("false")
}
asmsub print_ub0 (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, with left padding 0s (3 positions total)
%asm {{
jsr conv.internal_ubyte2decimal
pha
tya
jsr cbm.CHROUT
txa
jsr cbm.CHROUT
pla
jmp cbm.CHROUT
}}
}
asmsub print_ub (ubyte value @ A) clobbers(A,X,Y) {
; ---- print the ubyte in A in decimal form, without left padding 0s
%asm {{
jsr conv.internal_ubyte2decimal
_print_byte_digits
pha
cpy #'0'
beq +
tya
jsr cbm.CHROUT
txa
jsr cbm.CHROUT
jmp _ones
+ cpx #'0'
beq _ones
txa
jsr cbm.CHROUT
_ones pla
jmp cbm.CHROUT
}}
}
asmsub print_b (byte value @ A) clobbers(A,X,Y) {
; ---- print the byte in A in decimal form, without left padding 0s
%asm {{
pha
cmp #0
bpl +
lda #'-'
jsr cbm.CHROUT
+ pla
jsr conv.internal_byte2decimal
jmp print_ub._print_byte_digits
}}
}
}

46
compiler/res/prog8lib/shared_textio_functions.p8
View File

@ -1,46 +0,0 @@
txt {
; the textio functions shared across compiler targets
%option merge, no_symbol_prefixing, ignore_unused
asmsub petscii2scr(ubyte petscii_char @A) -> ubyte @A {
; -- convert petscii character to screencode
%asm {{
sta P8ZP_SCRATCH_REG
lsr a
lsr a
lsr a
lsr a
lsr a
tax
lda _offsets,x
eor P8ZP_SCRATCH_REG
rts
_offsets .byte 128, 0, 64, 32, 64, 192, 128, 128
}}
}
asmsub petscii2scr_str(str petscii_string @AY) {
; -- convert petscii string to screencodes string
%asm {{
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0
- lda (P8ZP_SCRATCH_W1),y
beq +
jsr petscii2scr
sta (P8ZP_SCRATCH_W1),y
iny
bne -
+ rts
}}
}
sub print_bool(bool value) {
if value
txt.print("true")
else
txt.print("false")
}
}

6
compiler/res/prog8lib/virtual/diskio.p8
View File

@ -145,6 +145,12 @@ diskio {
return "unknown"
}
sub status_code() -> ubyte {
; -- return status code instead of whole CBM-DOS status string. (in this case always 255, which means 'unable to return sensible value')
return 255
}
sub save(uword filenameptr, uword start_address, uword savesize) -> bool {
%ir {{
load.b r65532,0

4
compiler/test/TestImportedModulesOrderAndOptions.kt
View File

@ -42,7 +42,7 @@ main {
"textio",
"syslib",
"conv",
"shared_textio_functions",
"shared_cbm_textio_functions",
"floats",
"shared_floats_functions",
"math",
@ -101,7 +101,7 @@ main {
listOf(
internedStringsModuleName,
filenameBase,
"textio", "syslib", "conv", "shared_textio_functions", "floats", "shared_floats_functions", "math", "prog8_lib"
"textio", "syslib", "conv", "shared_cbm_textio_functions", "floats", "shared_floats_functions", "math", "prog8_lib"
)
}
options.floats shouldBe true