IgorCielniak/l2
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added strconcat and strcpy functions

Browse Source
This commit is contained in:
IgorCielniak
2025-12-24 23:19:08 +01:00
parent 8bab3485a8
commit 6988a89a51
3 changed files with 282 additions and 175 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
mem.sl
View File

@@ -26,7 +26,7 @@ struct: Point
field y 8 field y 8
;struct ;struct
: main : main2
32 alloc # allocate 32 bytes (enough for a Point struct) 32 alloc # allocate 32 bytes (enough for a Point struct)
dup 111 swap Point.x! dup 111 swap Point.x!
dup 222 swap Point.y! dup 222 swap Point.y!

351
stdlib/stdlib.sl
View File

@@ -1,3 +1,4 @@
# : int3 ( -- )
:asm int3 { :asm int3 {
int3 int3
} }
@@ -5,88 +6,96 @@
# : c@ ( addr -- byte ) # : c@ ( addr -- byte )
:asm c@ { :asm c@ {
mov rax, [r12] mov rax, [r12] ; get address from stack
movzx rax, byte [rax] movzx rax, byte [rax] ; load byte at address, zero-extend to rax
mov [r12], rax mov [r12], rax ; store result back on stack
ret ret
} }
; ;
# : c! ( byte addr -- ) # : c! ( byte addr -- )
:asm c! { :asm c! {
mov rax, [r12] mov rax, [r12] ; get address from stack
add r12, 8 add r12, 8 ; pop address
mov rbx, [r12] mov rbx, [r12] ; get byte value
mov [rbx], al mov [rbx], al ; store byte at address
ret ret
} }
; ;
# : r@ ( -- x ) # : r@ ( -- x )
:asm r@ { :asm r@ {
mov rax, [r13] mov rax, [r13] ; get value from return stack
sub r12, 8 sub r12, 8 ; make room on data stack
mov [r12], rax mov [r12], rax ; push value to data stack
ret ret
} }
; ;
# : dup ( x -- x x )
:asm dup { :asm dup {
mov rax, [r12] mov rax, [r12] ; get top of stack
sub r12, 8 sub r12, 8 ; make room
mov [r12], rax mov [r12], rax ; duplicate value
} }
; ;
# : drop ( x -- )
:asm drop { :asm drop {
add r12, 8 add r12, 8 ; remove top of stack
} }
; ;
# : over ( x1 x2 -- x1 x2 x1 )
:asm over { :asm over {
mov rax, [r12 + 8] mov rax, [r12 + 8] ; get second item
sub r12, 8 sub r12, 8 ; make room
mov [r12], rax mov [r12], rax ; push copy
} }
; ;
# : swap ( x1 x2 -- x2 x1 )
:asm swap { :asm swap {
mov rax, [r12] mov rax, [r12] ; get top
mov rbx, [r12 + 8] mov rbx, [r12 + 8] ; get second
mov [r12], rbx mov [r12], rbx ; swap
mov [r12 + 8], rax mov [r12 + 8], rax
} }
; ;
# : rot ( x1 x2 x3 -- x2 x3 x1 )
:asm rot { :asm rot {
mov rax, [r12] ; x3 mov rax, [r12] ; x3 (top)
mov rbx, [r12 + 8] ; x2 mov rbx, [r12 + 8] ; x2
mov rcx, [r12 + 16] ; x1 mov rcx, [r12 + 16] ; x1 (bottom)
mov [r12], rcx ; top = x1 mov [r12], rcx ; new top = x1
mov [r12 + 8], rax ; next = x3 mov [r12 + 8], rax ; new 2nd = x3
mov [r12 + 16], rbx ; third = x2 mov [r12 + 16], rbx ; new 3rd = x2
} }
; ;
# : -rot ( x1 x2 x3 -- x3 x1 x2 )
:asm -rot { :asm -rot {
mov rax, [r12] ; x3 mov rax, [r12] ; x3 (top)
mov rbx, [r12 + 8] ; x2 mov rbx, [r12 + 8] ; x2
mov rcx, [r12 + 16] ; x1 mov rcx, [r12 + 16] ; x1 (bottom)
mov [r12], rbx ; top = x2 mov [r12], rbx ; new top = x2
mov [r12 + 8], rcx ; next = x1 mov [r12 + 8], rcx ; new 2nd = x1
mov [r12 + 16], rax ; third = x3 mov [r12 + 16], rax ; new 3rd = x3
} }
; ;
# : nip ( x1 x2 -- x2 )
:asm nip { :asm nip {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 ; drop lower element add r12, 8 ; drop lower
mov [r12], rax ; keep original top mov [r12], rax ; keep original top
} }
; ;
# : tuck ( x1 x2 -- x2 x1 x2 )
:asm tuck { :asm tuck {
mov rax, [r12] ; x2 mov rax, [r12] ; x2 (top)
mov rbx, [r12 + 8] ; x1 mov rbx, [r12 + 8] ; x1
sub r12, 8 ; make room sub r12, 8 ; make room
mov [r12], rax ; x2 mov [r12], rax ; x2
@@ -95,277 +104,305 @@
} }
; ;
# : 2dup ( x1 x2 -- x1 x2 x1 x2 )
:asm 2dup { :asm 2dup {
mov rax, [r12] ; b mov rax, [r12] ; b (top)
mov rbx, [r12 + 8] ; a mov rbx, [r12 + 8] ; a
sub r12, 8 sub r12, 8 ; make room
mov [r12], rbx ; push a mov [r12], rbx ; push a
sub r12, 8 sub r12, 8 ; make room
mov [r12], rax ; push b mov [r12], rax ; push b
} }
; ;
# : 2drop ( x1 x2 -- )
:asm 2drop { :asm 2drop {
add r12, 16 add r12, 16 ; remove two items
} }
; ;
# : 2swap ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
:asm 2swap { :asm 2swap {
mov rax, [r12] ; d mov rax, [r12] ; d (top)
mov rbx, [r12 + 8] ; c mov rbx, [r12 + 8] ; c
mov rcx, [r12 + 16] ; b mov rcx, [r12 + 16] ; b
mov rdx, [r12 + 24] ; a mov rdx, [r12 + 24] ; a (bottom)
mov [r12], rcx ; top = b mov [r12], rcx ; new top = b
mov [r12 + 8], rdx ; next = a mov [r12 + 8], rdx ; new 2nd = a
mov [r12 + 16], rax ; third = d mov [r12 + 16], rax ; new 3rd = d
mov [r12 + 24], rbx ; fourth = c mov [r12 + 24], rbx ; new 4th = c
} }
; ;
# : 2over ( x1 x2 x3 x4 -- x3 x4 x1 x2 x3 x4 )
:asm 2over { :asm 2over {
mov rax, [r12 + 16] ; b mov rax, [r12 + 16] ; b
mov rbx, [r12 + 24] ; a mov rbx, [r12 + 24] ; a
sub r12, 8 sub r12, 8 ; make room
mov [r12], rbx ; push a mov [r12], rbx ; push a
sub r12, 8 sub r12, 8 ; make room
mov [r12], rax ; push b mov [r12], rax ; push b
} }
; ;
# : + ( x1 x2 -- x3 )
:asm + { :asm + {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
add qword [r12], rax add qword [r12], rax ; add to next
} }
; ;
# : - ( x1 x2 -- x3 )
:asm - { :asm - {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
sub qword [r12], rax sub qword [r12], rax ; subtract from next
} }
; ;
# : * ( x1 x2 -- x3 )
:asm * { :asm * {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
imul qword [r12] imul qword [r12] ; multiply
mov [r12], rax mov [r12], rax ; store result
} }
; ;
# : / ( x1 x2 -- x3 )
:asm / { :asm / {
mov rbx, [r12] mov rbx, [r12] ; divisor
add r12, 8 add r12, 8 ; pop
mov rax, [r12] mov rax, [r12] ; dividend
cqo cqo ; sign-extend
idiv rbx idiv rbx ; divide
mov [r12], rax mov [r12], rax ; store quotient
} }
; ;
# : % ( x1 x2 -- x3 )
:asm % { :asm % {
mov rbx, [r12] mov rbx, [r12] ; divisor
add r12, 8 add r12, 8 ; pop
mov rax, [r12] mov rax, [r12] ; dividend
cqo cqo ; sign-extend
idiv rbx idiv rbx ; divide
mov [r12], rdx mov [r12], rdx ; store remainder
} }
; ;
# : == ( x1 x2 -- flag )
:asm == { :asm == {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
mov rbx, [r12] mov rbx, [r12] ; get next
cmp rbx, rax cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
sete bl sete bl ; set if equal
mov [r12], rbx mov [r12], rbx ; store flag
} }
; ;
# : != ( x1 x2 -- flag )
:asm != { :asm != {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
mov rbx, [r12] mov rbx, [r12] ; get next
cmp rbx, rax cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
setne bl setne bl ; set if not equal
mov [r12], rbx mov [r12], rbx ; store flag
} }
; ;
# : < ( x1 x2 -- flag )
:asm < { :asm < {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
mov rbx, [r12] mov rbx, [r12] ; get next
cmp rbx, rax cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
setl bl setl bl ; set if less
mov [r12], rbx mov [r12], rbx ; store flag
} }
; ;
# : > ( x1 x2 -- flag )
:asm > { :asm > {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
mov rbx, [r12] mov rbx, [r12] ; get next
cmp rbx, rax cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
setg bl setg bl ; set if greater
mov [r12], rbx mov [r12], rbx ; store flag
} }
; ;
# : <= ( x1 x2 -- flag )
:asm <= { :asm <= {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
mov rbx, [r12] mov rbx, [r12] ; get next
cmp rbx, rax cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
setle bl setle bl ; set if less or equal
mov [r12], rbx mov [r12], rbx ; store flag
} }
; ;
# : >= ( x1 x2 -- flag )
:asm >= { :asm >= {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
mov rbx, [r12] mov rbx, [r12] ; get next
cmp rbx, rax cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
setge bl setge bl ; set if greater or equal
mov [r12], rbx mov [r12], rbx ; store flag
} }
; ;
# : @ ( addr -- x )
:asm @ { :asm @ {
mov rax, [r12] mov rax, [r12] ; get address
mov rax, [rax] mov rax, [rax] ; load value
mov [r12], rax mov [r12], rax ; store on stack
} }
; ;
# : ! ( x addr -- )
:asm ! { :asm ! {
mov rax, [r12] mov rax, [r12] ; get address
add r12, 8 add r12, 8 ; pop address
mov rbx, [r12] mov rbx, [r12] ; get value
mov [rax], rbx mov [rax], rbx ; store value at address
add r12, 8 add r12, 8 ; pop value
} }
; ;
# : mmap ( addr len prot flags fd offset -- addr )
:asm mmap { :asm mmap {
mov r9, [r12] mov r9, [r12] ; offset
add r12, 8 add r12, 8
mov r8, [r12] mov r8, [r12] ; fd
add r12, 8 add r12, 8
mov r10, [r12] mov r10, [r12] ; flags
add r12, 8 add r12, 8
mov rdx, [r12] mov rdx, [r12] ; prot
add r12, 8 add r12, 8
mov rsi, [r12] mov rsi, [r12] ; len
add r12, 8 add r12, 8
mov rdi, [r12] mov rdi, [r12] ; addr
mov rax, 9 mov rax, 9 ; syscall: mmap
syscall syscall
mov [r12], rax mov [r12], rax ; return addr
} }
; ;
# : munmap ( addr len -- res )
:asm munmap { :asm munmap {
mov rsi, [r12] mov rsi, [r12] ; len
add r12, 8 add r12, 8
mov rdi, [r12] mov rdi, [r12] ; addr
mov rax, 11 mov rax, 11 ; syscall: munmap
syscall syscall
mov [r12], rax mov [r12], rax ; return value
} }
; ;
# : exit ( code -- )
:asm exit { :asm exit {
mov rdi, [r12] mov rdi, [r12] ; exit code
add r12, 8 add r12, 8
mov rax, 60 mov rax, 60 ; syscall: exit
syscall syscall
} }
; ;
# : and ( x1 x2 -- flag )
:asm and { :asm and {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
mov rbx, [r12] mov rbx, [r12] ; get next
test rax, rax test rax, rax
setz cl setz cl
test rbx, rbx test rbx, rbx
setz dl setz dl
movzx rcx, cl movzx rcx, cl
movzx rdx, dl movzx rdx, dl
and rcx, rdx and rcx, rdx ; logical and
mov [r12], rcx mov [r12], rcx ; store flag
} }
; ;
# : or ( x1 x2 -- flag )
:asm or { :asm or {
mov rax, [r12] mov rax, [r12] ; get top
add r12, 8 add r12, 8 ; pop
mov rbx, [r12] mov rbx, [r12] ; get next
test rax, rax test rax, rax
setz cl setz cl
test rbx, rbx test rbx, rbx
setz dl setz dl
movzx rcx, cl movzx rcx, cl
movzx rdx, dl movzx rdx, dl
or rcx, rdx or rcx, rdx ; logical or
mov [r12], rcx mov [r12], rcx ; store flag
} }
; ;
# : not ( x -- flag )
:asm not { :asm not {
mov rax, [r12] mov rax, [r12] ; get value
test rax, rax test rax, rax
setz al setz al ; set if zero
movzx rax, al movzx rax, al
mov [r12], rax mov [r12], rax ; store flag
} }
; ;
# : >r ( x -- )
:asm >r { :asm >r {
mov rax, [r12] mov rax, [r12] ; get value
add r12, 8 add r12, 8 ; pop
sub r13, 8 sub r13, 8 ; make room on return stack
mov [r13], rax mov [r13], rax ; push to return stack
} }
; ;
# : r> ( -- x )
:asm r> { :asm r> {
mov rax, [r13] mov rax, [r13] ; get value from return stack
add r13, 8 add r13, 8 ; pop return stack
sub r12, 8 sub r12, 8 ; make room on data stack
mov [r12], rax mov [r12], rax ; push to data stack
} }
; ;
# : rdrop ( -- )
:asm rdrop { :asm rdrop {
add r13, 8 add r13, 8 ; pop return stack
} }
; ;
# : pick ( n -- x )
:asm pick { :asm pick {
mov rcx, [r12] mov rcx, [r12] ; get index
add r12, 8 add r12, 8 ; pop
mov rax, [r12 + rcx * 8] mov rax, [r12 + rcx * 8] ; get value at index
sub r12, 8 sub r12, 8 ; make room
mov [r12], rax mov [r12], rax ; push value
} }
; ;
# : rpick ( n -- x )
:asm rpick { :asm rpick {
mov rcx, [r12] mov rcx, [r12] ; get index
add r12, 8 add r12, 8 ; pop
mov rax, [r13 + rcx * 8] mov rax, [r13 + rcx * 8] ; get value from return stack
sub r12, 8 sub r12, 8 ; make room
mov [r12], rax mov [r12], rax ; push value
} }
; ;

70
strconcat.sl Normal file
View File

@@ -0,0 +1,70 @@
import stdlib/stdlib.sl
import stdlib/io.sl
: strconcat
0 pick 3 pick +
>r >r >r >r >r
8 alloc
r> r>
dup >r
strcpy
swap
r> dup -rot +
r> r>
strcpy
swap
3 pick
-
swap
drop
swap
0 rpick
nip
;
: alloc
0 # addr hint (NULL)
swap # size
3 # prot (PROT_READ | PROT_WRITE)
34 # flags (MAP_PRIVATE | MAP_ANON)
-1 # fd
0 # offset
mmap
;
: free
munmap drop
;
: strcpy #(dst_addr src_addr len -- dst_addr len)
dup
>r
swap
dup c@
3 pick swap
c!
drop
swap
for
1 + dup
c@
swap
-rot
swap
1 +
dup
rot
c!
drop
swap
next
swap
nip
r> dup -rot - swap
;
: main
"hello " "world"
strconcat
puts
;