Apple-2-SW/prog8
1
0
Fork 0
mirror of https://github.com/irmen/prog8.git synced 2024-12-24 16:29:21 +00:00
Code Issues Projects Releases Wiki Activity

sort() added (bytes+words)

Browse Source
This commit is contained in:
Irmen de Jong 2019-08-17 23:32:26 +02:00
parent cbb7083307
commit d837cc11f9
8 changed files with 279 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
DeprecatedStackVm/src/compiler/target/c64/codegen/AsmGen.kt
View File

@ -232,7 +232,7 @@ class AsmGen(private val options: CompilationOptions, private val program: Inter
private fun block2asm(blk: IntermediateProgram.ProgramBlock) {
block = blk
out("\n; ---- block: '${block.name}' ----")
out("\n\n; ---- block: '${block.name}' ----")
if(!blk.force_output)
out("${block.name}\t.proc\n")
if(block.address!=null) {

187
compiler/res/prog8lib/prog8lib.asm
View File

@ -1384,3 +1384,190 @@ _mod2b lda #0 ; self-modified
_done rts
.pend
sort_ub .proc
; 8bit unsigned sort
; sorting subroutine coded by mats rosengren (mats.rosengren@esa.int)
; input: address of array to sort in c64.SCRATCH_ZPWORD1, length in c64.SCRATCH_ZPB1
; first, put pointer BEFORE array
lda c64.SCRATCH_ZPWORD1
bne +
dec c64.SCRATCH_ZPWORD1+1
+ dec c64.SCRATCH_ZPWORD1
_sortloop ldy c64.SCRATCH_ZPB1 ;start of subroutine sort
lda (c64.SCRATCH_ZPWORD1),y ;last value in (what is left of) sequence to be sorted
sta c64.SCRATCH_ZPREG ;save value. will be over-written by largest number
jmp _l2
_l1 dey
beq _l3
lda (c64.SCRATCH_ZPWORD1),y
cmp c64.SCRATCH_ZPWORD2+1
bcc _l1
_l2 sty c64.SCRATCH_ZPWORD2 ;index of potentially largest value
sta c64.SCRATCH_ZPWORD2+1 ;potentially largest value
jmp _l1
_l3 ldy c64.SCRATCH_ZPB1 ;where the largest value shall be put
lda c64.SCRATCH_ZPWORD2+1 ;the largest value
sta (c64.SCRATCH_ZPWORD1),y ;put largest value in place
ldy c64.SCRATCH_ZPWORD2 ;index of free space
lda c64.SCRATCH_ZPREG ;the over-written value
sta (c64.SCRATCH_ZPWORD1),y ;put the over-written value in the free space
dec c64.SCRATCH_ZPB1 ;end of the shorter sequence still left
bne _sortloop ;start working with the shorter sequence
rts
.pend
sort_b .proc
; 8bit signed sort
; sorting subroutine coded by mats rosengren (mats.rosengren@esa.int)
; input: address of array to sort in c64.SCRATCH_ZPWORD1, length in c64.SCRATCH_ZPB1
; first, put pointer BEFORE array
lda c64.SCRATCH_ZPWORD1
bne +
dec c64.SCRATCH_ZPWORD1+1
+ dec c64.SCRATCH_ZPWORD1
_sortloop ldy c64.SCRATCH_ZPB1 ;start of subroutine sort
lda (c64.SCRATCH_ZPWORD1),y ;last value in (what is left of) sequence to be sorted
sta c64.SCRATCH_ZPREG ;save value. will be over-written by largest number
jmp _l2
_l1 dey
beq _l3
lda (c64.SCRATCH_ZPWORD1),y
cmp c64.SCRATCH_ZPWORD2+1
bmi _l1
_l2 sty c64.SCRATCH_ZPWORD2 ;index of potentially largest value
sta c64.SCRATCH_ZPWORD2+1 ;potentially largest value
jmp _l1
_l3 ldy c64.SCRATCH_ZPB1 ;where the largest value shall be put
lda c64.SCRATCH_ZPWORD2+1 ;the largest value
sta (c64.SCRATCH_ZPWORD1),y ;put largest value in place
ldy c64.SCRATCH_ZPWORD2 ;index of free space
lda c64.SCRATCH_ZPREG ;the over-written value
sta (c64.SCRATCH_ZPWORD1),y ;put the over-written value in the free space
dec c64.SCRATCH_ZPB1 ;end of the shorter sequence still left
bne _sortloop ;start working with the shorter sequence
rts
.pend
sort_uw .proc
; 16bit unsigned sort
; sorting subroutine coded by mats rosengren (mats.rosengren@esa.int)
; input: address of array to sort in c64.SCRATCH_ZPWORD1, length in c64.SCRATCH_ZPB1
; first: subtract 2 of the pointer
asl c64.SCRATCH_ZPB1 ; *2 because words
lda c64.SCRATCH_ZPWORD1
sec
sbc #2
sta c64.SCRATCH_ZPWORD1
bcs _sort_loop
dec c64.SCRATCH_ZPWORD1+1
_sort_loop ldy c64.SCRATCH_ZPB1 ;start of subroutine sort
lda (c64.SCRATCH_ZPWORD1),y ;last value in (what is left of) sequence to be sorted
sta _work3 ;save value. will be over-written by largest number
iny
lda (c64.SCRATCH_ZPWORD1),y
sta _work3+1
dey
jmp _l2
_l1 dey
dey
beq _l3
iny
lda (c64.SCRATCH_ZPWORD1),y
dey
cmp c64.SCRATCH_ZPWORD2+1
bne +
lda (c64.SCRATCH_ZPWORD1),y
cmp c64.SCRATCH_ZPWORD2
+ bcc _l1
_l2 sty _work1 ;index of potentially largest value
lda (c64.SCRATCH_ZPWORD1),y
sta c64.SCRATCH_ZPWORD2 ;potentially largest value
iny
lda (c64.SCRATCH_ZPWORD1),y
sta c64.SCRATCH_ZPWORD2+1
dey
jmp _l1
_l3 ldy c64.SCRATCH_ZPB1 ;where the largest value shall be put
lda c64.SCRATCH_ZPWORD2 ;the largest value
sta (c64.SCRATCH_ZPWORD1),y ;put largest value in place
iny
lda c64.SCRATCH_ZPWORD2+1
sta (c64.SCRATCH_ZPWORD1),y
ldy _work1 ;index of free space
lda _work3 ;the over-written value
sta (c64.SCRATCH_ZPWORD1),y ;put the over-written value in the free space
iny
lda _work3+1
sta (c64.SCRATCH_ZPWORD1),y
dey
dec c64.SCRATCH_ZPB1 ;end of the shorter sequence still left
dec c64.SCRATCH_ZPB1
bne _sort_loop ;start working with the shorter sequence
rts
_work1 .byte 0
_work3 .word 0
.pend
sort_w .proc
; 16bit signed sort
; sorting subroutine coded by mats rosengren (mats.rosengren@esa.int)
; input: address of array to sort in c64.SCRATCH_ZPWORD1, length in c64.SCRATCH_ZPB1
; first: subtract 2 of the pointer
asl c64.SCRATCH_ZPB1 ; *2 because words
lda c64.SCRATCH_ZPWORD1
sec
sbc #2
sta c64.SCRATCH_ZPWORD1
bcs _sort_loop
dec c64.SCRATCH_ZPWORD1+1
_sort_loop ldy c64.SCRATCH_ZPB1 ;start of subroutine sort
lda (c64.SCRATCH_ZPWORD1),y ;last value in (what is left of) sequence to be sorted
sta _work3 ;save value. will be over-written by largest number
iny
lda (c64.SCRATCH_ZPWORD1),y
sta _work3+1
dey
jmp _l2
_l1 dey
dey
beq _l3
iny
lda (c64.SCRATCH_ZPWORD1),y
dey
cmp c64.SCRATCH_ZPWORD2+1
bne +
lda (c64.SCRATCH_ZPWORD1),y
cmp c64.SCRATCH_ZPWORD2
+ bmi _l1
_l2 sty _work1 ;index of potentially largest value
lda (c64.SCRATCH_ZPWORD1),y
sta c64.SCRATCH_ZPWORD2 ;potentially largest value
iny
lda (c64.SCRATCH_ZPWORD1),y
sta c64.SCRATCH_ZPWORD2+1
dey
jmp _l1
_l3 ldy c64.SCRATCH_ZPB1 ;where the largest value shall be put
lda c64.SCRATCH_ZPWORD2 ;the largest value
sta (c64.SCRATCH_ZPWORD1),y ;put largest value in place
iny
lda c64.SCRATCH_ZPWORD2+1
sta (c64.SCRATCH_ZPWORD1),y
ldy _work1 ;index of free space
lda _work3 ;the over-written value
sta (c64.SCRATCH_ZPWORD1),y ;put the over-written value in the free space
iny
lda _work3+1
sta (c64.SCRATCH_ZPWORD1),y
dey
dec c64.SCRATCH_ZPB1 ;end of the shorter sequence still left
dec c64.SCRATCH_ZPB1
bne _sort_loop ;start working with the shorter sequence
rts
_work1 .byte 0
_work3 .word 0
.pend

5
compiler/src/prog8/ast/processing/AstChecker.kt
View File

@ -1,5 +1,6 @@
package prog8.ast.processing
import prog8.ast.IFunctionCall
import prog8.ast.INameScope
import prog8.ast.Module
import prog8.ast.Program
@ -694,7 +695,7 @@ internal class AstChecker(private val program: Program,
super.visit(array)
if(array.heapId==null && array.parent !is FunctionCall)
if(array.heapId==null && array.parent !is IFunctionCall)
throw FatalAstException("array should have been moved to heap at ${array.position}")
}
@ -831,7 +832,7 @@ internal class AstChecker(private val program: Program,
printWarning("result values of subroutine call are discarded", functionCallStatement.position)
}
if(functionCallStatement.target.nameInSource.last() in setOf("lsl", "lsr", "rol", "ror", "rol2", "ror2", "swap")) {
if(functionCallStatement.target.nameInSource.last() in setOf("lsl", "lsr", "rol", "ror", "rol2", "ror2", "swap", "sort")) {
// in-place modification, can't be done on literals
if(functionCallStatement.arglist.any { it !is IdentifierReference && it !is RegisterExpr && it !is ArrayIndexedExpression && it !is DirectMemoryRead }) {
checkResult.add(ExpressionError("can't use that as argument to a in-place modifying function", functionCallStatement.position))

2
compiler/src/prog8/compiler/target/c64/codegen/AsmGen.kt
View File

@ -149,7 +149,7 @@ internal class AsmGen(val program: Program,
}
private fun block2asm(block: Block) {
out("\n; ---- block: '${block.name}' ----")
out("\n\n; ---- block: '${block.name}' ----")
out("${block.name}\t" + (if("force_output" in block.options()) ".block\n" else ".proc\n"))
if(block.address!=null) {

38
compiler/src/prog8/compiler/target/c64/codegen/BuiltinFunctionsAsmGen.kt
View File

@ -9,6 +9,8 @@ import prog8.ast.base.WordDatatypes
import prog8.ast.expressions.*
import prog8.ast.statements.AssignTarget
import prog8.ast.statements.FunctionCallStatement
import prog8.compiler.target.c64.MachineDefinition
import prog8.compiler.target.c64.MachineDefinition.C64Zeropage
import prog8.compiler.target.c64.MachineDefinition.ESTACK_HI_HEX
import prog8.compiler.target.c64.MachineDefinition.ESTACK_HI_PLUS1_HEX
import prog8.compiler.target.c64.MachineDefinition.ESTACK_LO_HEX
@ -298,6 +300,42 @@ internal class BuiltinFunctionsAsmGen(private val program: Program, private val
else -> throw AssemblyError("weird type")
}
}
"sort" -> {
val variable = fcall.arglist.single()
if(variable is IdentifierReference) {
val decl = variable.targetVarDecl(program.namespace)!!
val varName = asmgen.asmIdentifierName(variable)
val numElements = decl.arraysize!!.size()
when(decl.datatype) {
DataType.ARRAY_UB, DataType.ARRAY_B -> {
asmgen.out("""
lda #<$varName
ldy #>$varName
sta ${C64Zeropage.SCRATCH_W1}
sty ${C64Zeropage.SCRATCH_W1+1}
lda #$numElements
sta ${C64Zeropage.SCRATCH_B1}
""")
asmgen.out(if(decl.datatype==DataType.ARRAY_UB) " jsr prog8_lib.sort_ub" else " jsr prog8_lib.sort_b")
}
DataType.ARRAY_UW, DataType.ARRAY_W -> {
asmgen.out("""
lda #<$varName
ldy #>$varName
sta ${C64Zeropage.SCRATCH_W1}
sty ${C64Zeropage.SCRATCH_W1+1}
lda #$numElements
sta ${C64Zeropage.SCRATCH_B1}
""")
asmgen.out(if(decl.datatype==DataType.ARRAY_UW) " jsr prog8_lib.sort_uw" else " jsr prog8_lib.sort_w")
}
DataType.ARRAY_F -> TODO("sort floats (consider another solution if possible - this will be very slow, if ever implemented)")
else -> throw AssemblyError("weird type")
}
}
else
throw AssemblyError("weird type")
}
else -> {
translateFunctionArguments(fcall.arglist, func)
asmgen.out(" jsr prog8_lib.func_$functionName")

11
compiler/src/prog8/functions/BuiltinFunctions.kt
View File

@ -27,6 +27,7 @@ val BuiltinFunctions = mapOf(
"ror2" to FunctionSignature(false, listOf(BuiltinFunctionParam("item", setOf(DataType.UBYTE, DataType.UWORD))), null),
"lsl" to FunctionSignature(false, listOf(BuiltinFunctionParam("item", IntegerDatatypes)), null),
"lsr" to FunctionSignature(false, listOf(BuiltinFunctionParam("item", IntegerDatatypes)), null),
"sort" to FunctionSignature(false, listOf(BuiltinFunctionParam("array", ArrayDatatypes)), null),
// these few have a return value depending on the argument(s):
"max" to FunctionSignature(true, listOf(BuiltinFunctionParam("values", ArrayDatatypes)), null) { a, p, prg -> collectionArg(a, p, prg, ::builtinMax) }, // type depends on args
"min" to FunctionSignature(true, listOf(BuiltinFunctionParam("values", ArrayDatatypes)), null) { a, p, prg -> collectionArg(a, p, prg, ::builtinMin) }, // type depends on args
@ -75,18 +76,20 @@ val BuiltinFunctions = mapOf(
"read_flags" to FunctionSignature(false, emptyList(), DataType.UBYTE),
"swap" to FunctionSignature(false, listOf(BuiltinFunctionParam("first", NumericDatatypes), BuiltinFunctionParam("second", NumericDatatypes)), null),
"memcopy" to FunctionSignature(false, listOf(
BuiltinFunctionParam("from", IterableDatatypes + setOf(DataType.UWORD)),
BuiltinFunctionParam("to", IterableDatatypes + setOf(DataType.UWORD)),
BuiltinFunctionParam("from", IterableDatatypes + DataType.UWORD),
BuiltinFunctionParam("to", IterableDatatypes + DataType.UWORD),
BuiltinFunctionParam("numbytes", setOf(DataType.UBYTE))), null),
"memset" to FunctionSignature(false, listOf(
BuiltinFunctionParam("address", IterableDatatypes + setOf(DataType.UWORD)),
BuiltinFunctionParam("address", IterableDatatypes + DataType.UWORD),
BuiltinFunctionParam("numbytes", setOf(DataType.UWORD)),
BuiltinFunctionParam("bytevalue", ByteDatatypes)), null),
"memsetw" to FunctionSignature(false, listOf(
BuiltinFunctionParam("address", IterableDatatypes + setOf(DataType.UWORD)),
BuiltinFunctionParam("address", IterableDatatypes + DataType.UWORD),
BuiltinFunctionParam("numwords", setOf(DataType.UWORD)),
BuiltinFunctionParam("wordvalue", setOf(DataType.UWORD, DataType.WORD))), null),
"strlen" to FunctionSignature(true, listOf(BuiltinFunctionParam("string", StringDatatypes)), DataType.UBYTE, ::builtinStrlen),
// TODO clean up these vm-specific functions
"vm_write_memchr" to FunctionSignature(false, listOf(BuiltinFunctionParam("address", setOf(DataType.UWORD))), null),
"vm_write_memstr" to FunctionSignature(false, listOf(BuiltinFunctionParam("address", setOf(DataType.UWORD))), null),
"vm_write_num" to FunctionSignature(false, listOf(BuiltinFunctionParam("number", NumericDatatypes)), null),

21
examples/cube3d-sprites.p8
View File

@ -136,16 +136,17 @@ main {
; first sort vertices to sprite order so the back/front order is correct as well
; (simple bubble sort as it's only 8 items to sort)
; TODO make a builtin function sort()
for ubyte sorti in 6 to 0 step -1 {
for ubyte i1 in 0 to sorti {
ubyte i2 = i1+1
if(rotatedz[i1] > rotatedz[i2]) {
swap(rotatedx[i1], rotatedx[i2])
swap(rotatedy[i1], rotatedy[i2])
swap(rotatedz[i1], rotatedz[i2])
}
}
}
sort(rotatedz)
; for ubyte sorti in 6 to 0 step -1 {
; for ubyte i1 in 0 to sorti {
; ubyte i2 = i1+1
; if(rotatedz[i1] > rotatedz[i2]) {
; swap(rotatedx[i1], rotatedx[i2])
; swap(rotatedy[i1], rotatedy[i2])
; swap(rotatedz[i1], rotatedz[i2])
; }
; }
; }
ubyte[] spritecolors = [1,1,7,15,12,11,9,9]

34
examples/test.p8
View File

@ -7,7 +7,6 @@ main {
sub start() {
ubyte[] uba = [10,0,2,8,5,4,3,9]
uword[] uwa = [1000,0,200,8000,50,40000,3,900]
byte[] ba = [-10,0,-2,8,5,4,-3,9]
@ -37,12 +36,41 @@ main {
c64.CHROUT(',')
}
c64.CHROUT('\n')
c64.CHROUT('\n')
for ubyte i in 0 to len(fla)-1 {
c64flt.print_f(fla[i])
sort(uba)
sort(uwa)
sort(ba)
sort(wa)
for ubyte ub2 in uba {
c64scr.print_ub(ub2)
c64.CHROUT(',')
}
c64.CHROUT('\n')
for uword uw2 in uwa {
c64scr.print_uw(uw2)
c64.CHROUT(',')
}
c64.CHROUT('\n')
for byte bb2 in ba {
c64scr.print_b(bb2)
c64.CHROUT(',')
}
c64.CHROUT('\n')
for word ww2 in wa {
c64scr.print_w(ww2)
c64.CHROUT(',')
}
c64.CHROUT('\n')
ubyte qq=X
c64scr.print_ub(qq)
; TODO 2 for loops that both define the same loopvar -> double definition -> fix second for -> 'unknown symbol' ????
}
}