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

Compare commits

base: IgorCielniak:e8271895fb6bf5909ce027fe3505395d4a06068d
Branches Tags
IgorCielniak:main
..
compare: IgorCielniak:main
Branches Tags
IgorCielniak:main

7 Commits
e8271895fb ... main

Author SHA1 Message Date
IgorCielniak
052f9191c3 I was bored 2026-03-25 13:28:26 +01:00
IgorCielniak
a74c4b8c41 added 'arr_find', 'arr_contains' and did small fixes to 'find' and 'rfind' 2026-03-25 11:52:45 +01:00
IgorCielniak
d639c63fd3 added 'rfind' 2026-03-25 11:12:32 +01:00
IgorCielniak
ab613e644a small fix to 'contains' and added 'find' 2026-03-25 11:05:55 +01:00
IgorCielniak
75b01b9635 added contains, 3dup and 4dup 2026-03-25 10:38:43 +01:00
IgorCielniak
b263e7d0de added startswith and endswith 2026-03-25 10:10:14 +01:00
IgorCielniak
bc3a894737 added trim functions 2026-03-25 08:59:35 +01:00
6 changed files with 441 additions and 320 deletions
Expand all files Collapse all files

8
main.py
View File

@@ -11542,7 +11542,7 @@ def _run_docs_tui(
"\n" "\n"
" 5. NASM + LINKER\n" " 5. NASM + LINKER\n"
" The assembly is assembled by NASM into an object\n" " The assembly is assembled by NASM into an object\n"
" file, then linked (via ld or gcc) into the final\n" " file, then linked (via ld or ld.ldd) into the final\n"
" binary.\n" " binary.\n"
"\n" "\n"
"───────────────────────────────────────────────────────────────\n" "───────────────────────────────────────────────────────────────\n"
@@ -11567,7 +11567,7 @@ def _run_docs_tui(
" The CT VM is a stack-based interpreter that runs during\n" " The CT VM is a stack-based interpreter that runs during\n"
" parsing. It maintains:\n" " parsing. It maintains:\n"
"\n" "\n"
" - A value stack (Python list of ints/strings/lists)\n" " - A value stack\n"
" - A dictionary of CT-callable words\n" " - A dictionary of CT-callable words\n"
" - A return stack for nested calls\n" " - A return stack for nested calls\n"
"\n" "\n"
@@ -11579,7 +11579,7 @@ def _run_docs_tui(
"\n" "\n"
" When --ct-run-main is used, the CT VM can also JIT-compile\n" " When --ct-run-main is used, the CT VM can also JIT-compile\n"
" and execute native x86-64 code via the Keystone assembler\n" " and execute native x86-64 code via the Keystone assembler\n"
" engine (for words that need native performance).\n" " engine (for words that need near native performance).\n"
"\n" "\n"
"───────────────────────────────────────────────────────────────\n" "───────────────────────────────────────────────────────────────\n"
"\n" "\n"
@@ -11641,7 +11641,7 @@ def _run_docs_tui(
" just numbers. Type safety is your responsibility.\n" " just numbers. Type safety is your responsibility.\n"
"\n" "\n"
" - Macro expansion depth: macros can expand macros,\n" " - Macro expansion depth: macros can expand macros,\n"
" but there's a limit (default 64, configurable via\n" " but there's a limit (default 256, configurable via\n"
" --macro-expansion-limit).\n" " --macro-expansion-limit).\n"
"\n" "\n"
" - :py blocks: Python code embedded in :py { ... }\n" " - :py blocks: Python code embedded in :py { ... }\n"

19
stdlib/arr.sl
View File

@@ -326,3 +326,22 @@ word dyn_arr_sorted
dyn_arr_clone dyn_arr_clone
dyn_arr_sort dyn_arr_sort
end end
# arr_contains [*, addr | x] -> [* | bool]
word arr_contains
over @ >r >r 8 + r> r>
for
2dup swap @ == if 1 nip nip rdrop ret end
swap 8 + swap
end 0 nip nip
end
# arr_find [*, addr | x] -> [* | bool]
word arr_find
over @ >r >r 8 + r> r>
0 >r
for
2dup swap @ == if rswap r> nip nip rdrop ret end
swap 8 + swap rswap r> 1 + >r rswap
end rdrop -1 nip nip
end

663
stdlib/core.sl
View File

@@ -18,455 +18,486 @@
#mem [*] -> [* | ptr] #mem [*] -> [* | ptr]
:asm mem { :asm mem {
lea rax, [rel persistent] lea rax, [rel persistent]
sub r12, 8 sub r12, 8
mov [r12], rax mov [r12], rax
} }
; ;
#argc [*] -> [* | n] #argc [*] -> [* | n]
:asm argc { :asm argc {
extern sys_argc extern sys_argc
mov rax, [rel sys_argc] mov rax, [rel sys_argc]
sub r12, 8 sub r12, 8
mov [r12], rax mov [r12], rax
ret ret
} }
; ;
#argv [*] -> [* | ptr] #argv [*] -> [* | ptr]
:asm argv { :asm argv {
extern sys_argv extern sys_argv
mov rax, [rel sys_argv] mov rax, [rel sys_argv]
sub r12, 8 sub r12, 8
mov [r12], rax mov [r12], rax
ret ret
} }
; ;
#argv@ [* | n] -> [* | ptr] #argv@ [* | n] -> [* | ptr]
:asm argv@ { :asm argv@ {
extern sys_argv extern sys_argv
mov rbx, [r12] ; n mov rbx, [r12] ; n
mov rax, [rel sys_argv] mov rax, [rel sys_argv]
mov rax, [rax + rbx*8] mov rax, [rax + rbx*8]
mov [r12], rax mov [r12], rax
ret ret
} }
; ;
#c@ [* | addr] -> [* | byte] #c@ [* | addr] -> [* | byte]
:asm c@ { :asm c@ {
mov rax, [r12] ; get address from stack mov rax, [r12] ; get address from stack
movzx rax, byte [rax] ; load byte at address, zero-extend to rax movzx rax, byte [rax] ; load byte at address, zero-extend to rax
mov [r12], rax ; store result back on stack mov [r12], rax ; store result back on stack
ret ret
} }
; ;
#c! [*, addr | byte] -> [*] #c! [*, addr | byte] -> [*]
:asm c! { :asm c! {
mov rax, [r12] ; get byte value (TOS) mov rax, [r12] ; get byte value (TOS)
add r12, 8 ; pop byte add r12, 8 ; pop byte
mov rbx, [r12] ; get address (NOS) mov rbx, [r12] ; get address (NOS)
add r12, 8 ; pop address add r12, 8 ; pop address
mov [rbx], al ; store low byte at address mov [rbx], al ; store low byte at address
ret ret
} }
; ;
#r@ [*] -> [* | x] #r@ [*] -> [* | x]
:asm r@ { :asm r@ {
mov rax, [r13] ; get value from return stack mov rax, [r13] ; get value from return stack
sub r12, 8 ; make room on data stack sub r12, 8 ; make room on data stack
mov [r12], rax ; push value to data stack mov [r12], rax ; push value to data stack
ret ret
} }
; ;
#dup [* | x] -> [*, x | x] #dup [* | x] -> [*, x | x]
:asm dup { :asm dup {
mov rax, [r12] ; get top of stack mov rax, [r12] ; get top of stack
sub r12, 8 ; make room sub r12, 8 ; make room
mov [r12], rax ; duplicate value mov [r12], rax ; duplicate value
} }
; ;
#drop [* | x] -> [*] #drop [* | x] -> [*]
:asm drop { :asm drop {
add r12, 8 ; remove top of stack add r12, 8 ; remove top of stack
} }
; ;
#over [*, x1 | x2] -> [*, x1, x2 | x1] #over [*, x1 | x2] -> [*, x1, x2 | x1]
:asm over { :asm over {
mov rax, [r12 + 8] ; get second item mov rax, [r12 + 8] ; get second item
sub r12, 8 ; make room sub r12, 8 ; make room
mov [r12], rax ; push copy mov [r12], rax ; push copy
} }
; ;
#swap [*, x1 | x2] -> [*, x2 | x1] #swap [*, x1 | x2] -> [*, x2 | x1]
:asm swap { :asm swap {
mov rax, [r12] ; get top mov rax, [r12] ; get top
mov rbx, [r12 + 8] ; get second mov rbx, [r12 + 8] ; get second
mov [r12], rbx ; swap mov [r12], rbx ; swap
mov [r12 + 8], rax mov [r12 + 8], rax
} }
; ;
#rot [*, x1, x2 | x3] -> [*, x2, x3 | x1] #rot [*, x1, x2 | x3] -> [*, x2, x3 | x1]
:asm rot { :asm rot {
mov rax, [r12] ; x3 (top) mov rax, [r12] ; x3 (top)
mov rbx, [r12 + 8] ; x2 mov rbx, [r12 + 8] ; x2
mov rcx, [r12 + 16] ; x1 (bottom) mov rcx, [r12 + 16] ; x1 (bottom)
mov [r12], rcx ; new top = x1 mov [r12], rcx ; new top = x1
mov [r12 + 8], rax ; new 2nd = x3 mov [r12 + 8], rax ; new 2nd = x3
mov [r12 + 16], rbx ; new 3rd = x2 mov [r12 + 16], rbx ; new 3rd = x2
} }
; ;
#-rot [*, x1, x2 | x3] -> [*, x3, x1 | x2] #-rot [*, x1, x2 | x3] -> [*, x3, x1 | x2]
:asm -rot { :asm -rot {
mov rax, [r12] ; x3 (top) mov rax, [r12] ; x3 (top)
mov rbx, [r12 + 8] ; x2 mov rbx, [r12 + 8] ; x2
mov rcx, [r12 + 16] ; x1 (bottom) mov rcx, [r12 + 16] ; x1 (bottom)
mov [r12], rbx ; new top = x2 mov [r12], rbx ; new top = x2
mov [r12 + 8], rcx ; new 2nd = x1 mov [r12 + 8], rcx ; new 2nd = x1
mov [r12 + 16], rax ; new 3rd = x3 mov [r12 + 16], rax ; new 3rd = x3
} }
; ;
#nip [*, x1 | x2] -> [* | x2] #nip [*, x1 | x2] -> [* | x2]
:asm nip { :asm nip {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; drop lower add r12, 8 ; drop lower
mov [r12], rax ; keep original top mov [r12], rax ; keep original top
} }
; ;
#tuck [*, x1 | x2] -> [*, x2, x1 | x2] #tuck [*, x1 | x2] -> [*, x2, x1 | x2]
:asm tuck { :asm tuck {
mov rax, [r12] ; x2 (top) 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
mov [r12 + 8], rbx ; x1 mov [r12 + 8], rbx ; x1
mov [r12 + 16], rax ; x2 mov [r12 + 16], rax ; x2
} }
; ;
#2dup [*, x1 | x2] -> [*, x1, x2, x1 | x2] #2dup [*, x1 | x2] -> [*, x1, x2, x1 | x2]
:asm 2dup { :asm 2dup {
mov rax, [r12] ; b (top) mov rax, [r12] ; b (top)
mov rbx, [r12 + 8] ; a mov rbx, [r12 + 8] ; a
sub r12, 8 ; make room sub r12, 8 ; make room
mov [r12], rbx ; push a mov [r12], rbx ; push a
sub r12, 8 ; make room sub r12, 8 ; make room
mov [r12], rax ; push b mov [r12], rax ; push b
}
;
#3dup [*, x1, x2 | x3] -> [*, x1, x2, x3, x1, x2 | x3]
:asm 3dup {
mov rax, [r12] ; c (top)
mov rbx, [r12 + 8] ; b
mov rcx, [r12 + 16] ; a
sub r12, 8 ; make room
mov [r12], rcx ; push a
sub r12, 8 ; make room
mov [r12], rbx ; push b
sub r12, 8 ; make room
mov [r12], rax ; push c
}
;
#4dup [*, x1, x2, x3 | x4] -> [*, x1, x2, x3, x4, x1, x2, x3 | x4]
:asm 4dup {
mov rax, [r12] ; d
mov rbx, [r12 + 8] ; c
mov rcx, [r12 + 16] ; b
mov rdx, [r12 + 24] ; a
sub r12, 8 ; make room
mov [r12], rdx ; push a
sub r12, 8 ; make room
mov [r12], rcx ; push b
sub r12, 8 ; make room
mov [r12], rbx ; push c
sub r12, 8 ; make room
mov [r12], rax ; push d
} }
; ;
#2drop [*, x1 | x2] -> [*] #2drop [*, x1 | x2] -> [*]
:asm 2drop { :asm 2drop {
add r12, 16 ; remove two items add r12, 16 ; remove two items
} }
; ;
#2swap [*, x1, x2, x3 | x4] -> [*, x3, x4, x1 | x2] #2swap [*, x1, x2, x3 | x4] -> [*, x3, x4, x1 | x2]
:asm 2swap { :asm 2swap {
mov rax, [r12] ; d (top) 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 (bottom) mov rdx, [r12 + 24] ; a (bottom)
mov [r12], rcx ; new top = b mov [r12], rcx ; new top = b
mov [r12 + 8], rdx ; new 2nd = a mov [r12 + 8], rdx ; new 2nd = a
mov [r12 + 16], rax ; new 3rd = d mov [r12 + 16], rax ; new 3rd = d
mov [r12 + 24], rbx ; new 4th = c mov [r12 + 24], rbx ; new 4th = c
} }
; ;
#2over [*, x1, x2, x3 | x4] -> [*, x3, x4, x1, x2, x3 | x4] #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 ; make room sub r12, 8 ; make room
mov [r12], rbx ; push a mov [r12], rbx ; push a
sub r12, 8 ; make room sub r12, 8 ; make room
mov [r12], rax ; push b mov [r12], rax ; push b
} }
; ;
#+ [*, x1 | x2] -> [* | x3] #+ [*, x1 | x2] -> [* | x3]
:asm + { :asm + {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
add qword [r12], rax ; add to next add qword [r12], rax ; add to next
} }
; ;
#- [*, x1 | x2] -> [* | x3] #- [*, x1 | x2] -> [* | x3]
:asm - { :asm - {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
sub qword [r12], rax ; subtract from next sub qword [r12], rax ; subtract from next
} }
; ;
#* [*, x1 | x2] -> [* | x3] #* [*, x1 | x2] -> [* | x3]
:asm * { :asm * {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
imul qword [r12] ; multiply imul qword [r12] ; multiply
mov [r12], rax ; store result mov [r12], rax ; store result
} }
; ;
#/ [*, x1 | x2] -> [* | x3] #/ [*, x1 | x2] -> [* | x3]
:asm / { :asm / {
mov rbx, [r12] ; divisor mov rbx, [r12] ; divisor
add r12, 8 ; pop add r12, 8 ; pop
mov rax, [r12] ; dividend mov rax, [r12] ; dividend
cqo ; sign-extend cqo ; sign-extend
idiv rbx ; divide idiv rbx ; divide
mov [r12], rax ; store quotient mov [r12], rax ; store quotient
} }
; ;
#% [*, x1 | x2] -> [* | x3] #% [*, x1 | x2] -> [* | x3]
:asm % { :asm % {
mov rbx, [r12] ; divisor mov rbx, [r12] ; divisor
add r12, 8 ; pop add r12, 8 ; pop
mov rax, [r12] ; dividend mov rax, [r12] ; dividend
cqo ; sign-extend cqo ; sign-extend
idiv rbx ; divide idiv rbx ; divide
mov [r12], rdx ; store remainder mov [r12], rdx ; store remainder
} }
; ;
#== [*, x1 | x2] -> [* | flag] #== [*, x1 | x2] -> [* | flag]
:asm == { :asm == {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
mov rbx, [r12] ; get next mov rbx, [r12] ; get next
cmp rbx, rax ; compare cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
sete bl ; set if equal sete bl ; set if equal
mov [r12], rbx ; store flag mov [r12], rbx ; store flag
} }
; ;
#!= [*, x1 | x2] -> [* | flag] #!= [*, x1 | x2] -> [* | flag]
:asm != { :asm != {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
mov rbx, [r12] ; get next mov rbx, [r12] ; get next
cmp rbx, rax ; compare cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
setne bl ; set if not equal setne bl ; set if not equal
mov [r12], rbx ; store flag mov [r12], rbx ; store flag
} }
; ;
#< [*, x1 | x2] -> [* | flag] #< [*, x1 | x2] -> [* | flag]
:asm < { :asm < {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
mov rbx, [r12] ; get next mov rbx, [r12] ; get next
cmp rbx, rax ; compare cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
setl bl ; set if less setl bl ; set if less
mov [r12], rbx ; store flag mov [r12], rbx ; store flag
} }
; ;
#> [*, x1 | x2] -> [* | flag] #> [*, x1 | x2] -> [* | flag]
:asm > { :asm > {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
mov rbx, [r12] ; get next mov rbx, [r12] ; get next
cmp rbx, rax ; compare cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
setg bl ; set if greater setg bl ; set if greater
mov [r12], rbx ; store flag mov [r12], rbx ; store flag
} }
; ;
#<= [*, x1 | x2] -> [* | flag] #<= [*, x1 | x2] -> [* | flag]
:asm <= { :asm <= {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
mov rbx, [r12] ; get next mov rbx, [r12] ; get next
cmp rbx, rax ; compare cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
setle bl ; set if less or equal setle bl ; set if less or equal
mov [r12], rbx ; store flag mov [r12], rbx ; store flag
} }
; ;
#>= [*, x1 | x2] -> [* | flag] #>= [*, x1 | x2] -> [* | flag]
:asm >= { :asm >= {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
mov rbx, [r12] ; get next mov rbx, [r12] ; get next
cmp rbx, rax ; compare cmp rbx, rax ; compare
mov rbx, 0 mov rbx, 0
setge bl ; set if greater or equal setge bl ; set if greater or equal
mov [r12], rbx ; store flag mov [r12], rbx ; store flag
} }
; ;
#@ [* | addr] -> [* | x] #@ [* | addr] -> [* | x]
:asm @ { :asm @ {
mov rax, [r12] ; get address mov rax, [r12] ; get address
mov rax, [rax] ; load value mov rax, [rax] ; load value
mov [r12], rax ; store on stack mov [r12], rax ; store on stack
} }
; ;
#! [*, addr | x] -> [*] #! [*, addr | x] -> [*]
:asm ! { :asm ! {
mov rax, [r12] ; get value (TOS) mov rax, [r12] ; get value (TOS)
add r12, 8 ; pop value add r12, 8 ; pop value
mov rbx, [r12] ; get addr (NOS) mov rbx, [r12] ; get addr (NOS)
add r12, 8 ; pop addr add r12, 8 ; pop addr
mov [rbx], rax ; store value at address mov [rbx], rax ; store value at address
} }
; ;
#mmap [*, addr, len, prot, flags, fd | offset] -> [* | addr] #mmap [*, addr, len, prot, flags, fd | offset] -> [* | addr]
:asm mmap { :asm mmap {
mov r9, [r12] ; offset mov r9, [r12] ; offset
add r12, 8 add r12, 8
mov r8, [r12] ; fd mov r8, [r12] ; fd
add r12, 8 add r12, 8
mov r10, [r12] ; flags mov r10, [r12] ; flags
add r12, 8 add r12, 8
mov rdx, [r12] ; prot mov rdx, [r12] ; prot
add r12, 8 add r12, 8
mov rsi, [r12] ; len mov rsi, [r12] ; len
add r12, 8 add r12, 8
mov rdi, [r12] ; addr mov rdi, [r12] ; addr
mov rax, 9 ; syscall: mmap mov rax, 9 ; syscall: mmap
syscall syscall
sub r12, 8 sub r12, 8
mov [r12], rax ; return addr mov [r12], rax ; return addr
} }
; ;
#munmap [*, addr | len] -> [* | res] #munmap [*, addr | len] -> [* | res]
:asm munmap { :asm munmap {
mov rsi, [r12] ; len mov rsi, [r12] ; len
add r12, 8 add r12, 8
mov rdi, [r12] ; addr mov rdi, [r12] ; addr
add r12, 8 add r12, 8
mov rax, 11 ; syscall: munmap mov rax, 11 ; syscall: munmap
syscall syscall
sub r12, 8 sub r12, 8
mov [r12], rax ; return value mov [r12], rax ; return value
} }
; ;
#exit [* | code] -> [*] #exit [* | code] -> [*]
:asm exit { :asm exit {
mov rdi, [r12] ; exit code mov rdi, [r12] ; exit code
add r12, 8 add r12, 8
mov rax, 60 ; syscall: exit mov rax, 60 ; syscall: exit
syscall syscall
} }
; ;
#and [*, x1 | x2] -> [* | flag] #and [*, x1 | x2] -> [* | flag]
:asm and { :asm and {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
mov rbx, [r12] ; get next 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 ; logical and and rcx, rdx ; logical and
mov [r12], rcx ; store flag mov [r12], rcx ; store flag
} }
; ;
#or [*, x1 | x2] -> [* | flag] #or [*, x1 | x2] -> [* | flag]
:asm or { :asm or {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
mov rbx, [r12] ; get next 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 ; logical or or rcx, rdx ; logical or
mov [r12], rcx ; store flag mov [r12], rcx ; store flag
} }
; ;
#not [* | x] -> [* | flag] #not [* | x] -> [* | flag]
:asm not { :asm not {
mov rax, [r12] ; get value mov rax, [r12] ; get value
test rax, rax test rax, rax
setz al ; set if zero setz al ; set if zero
movzx rax, al movzx rax, al
mov [r12], rax ; store flag mov [r12], rax ; store flag
} }
; ;
#>r [* | x] -> [*] #>r [* | x] -> [*]
:asm >r { :asm >r {
mov rax, [r12] ; get value mov rax, [r12] ; get value
add r12, 8 ; pop add r12, 8 ; pop
sub r13, 8 ; make room on return stack sub r13, 8 ; make room on return stack
mov [r13], rax ; push to return stack mov [r13], rax ; push to return stack
} }
; ;
#r> [*] -> [* | x] #r> [*] -> [* | x]
:asm r> { :asm r> {
mov rax, [r13] ; get value from return stack mov rax, [r13] ; get value from return stack
add r13, 8 ; pop return stack add r13, 8 ; pop return stack
sub r12, 8 ; make room on data stack sub r12, 8 ; make room on data stack
mov [r12], rax ; push to data stack mov [r12], rax ; push to data stack
} }
; ;
#rdrop [*] -> [*] #rdrop [*] -> [*]
:asm rdrop { :asm rdrop {
add r13, 8 ; pop return stack add r13, 8 ; pop return stack
} }
; ;
:asm rswap { :asm rswap {
mov rax, [r13] ; get top mov rax, [r13] ; get top
mov rbx, [r13 + 8] ; get second mov rbx, [r13 + 8] ; get second
mov [r13], rbx ; swap mov [r13], rbx ; swap
mov [r13 + 8], rax mov [r13 + 8], rax
} }
; ;
#pick [* | n] -> [* | x] #pick [* | n] -> [* | x]
:asm pick { :asm pick {
mov rcx, [r12] ; get index mov rcx, [r12] ; get index
add r12, 8 ; pop add r12, 8 ; pop
mov rax, [r12 + rcx * 8] ; get value at index mov rax, [r12 + rcx * 8] ; get value at index
sub r12, 8 ; make room sub r12, 8 ; make room
mov [r12], rax ; push value mov [r12], rax ; push value
} }
; ;
#rpick [* | n] -> [* | x] #rpick [* | n] -> [* | x]
:asm rpick { :asm rpick {
mov rcx, [r12] ; get index mov rcx, [r12] ; get index
add r12, 8 ; pop add r12, 8 ; pop
mov rax, [r13 + rcx * 8] ; get value from return stack mov rax, [r13 + rcx * 8] ; get value from return stack
sub r12, 8 ; make room sub r12, 8 ; make room
mov [r12], rax ; push value mov [r12], rax ; push value
} }
; ;
@@ -480,12 +511,12 @@
#abs [* | x] -> [* | |x|] #abs [* | x] -> [* | |x|]
:asm abs { :asm abs {
mov rax, [r12] ; get value mov rax, [r12] ; get value
test rax, rax ; check sign test rax, rax ; check sign
jge .done ; keep if non-negative jge .done ; keep if non-negative
neg rax ; flip sign when negative neg rax ; flip sign when negative
.done: .done:
mov [r12], rax ; store result mov [r12], rax ; store result
} }
; ;
@@ -499,162 +530,162 @@
#band [*, x1 | x2] -> [* | x3] #band [*, x1 | x2] -> [* | x3]
:asm band { :asm band {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
and qword [r12], rax ; bitwise and and qword [r12], rax ; bitwise and
} }
; ;
#bor [*, x1 | x2] -> [* | x3] #bor [*, x1 | x2] -> [* | x3]
:asm bor { :asm bor {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
or qword [r12], rax ; bitwise or or qword [r12], rax ; bitwise or
} }
; ;
#bxor [*, x1 | x2] -> [* | x3] #bxor [*, x1 | x2] -> [* | x3]
:asm bxor { :asm bxor {
mov rax, [r12] ; get top mov rax, [r12] ; get top
add r12, 8 ; pop add r12, 8 ; pop
xor qword [r12], rax ; bitwise xor xor qword [r12], rax ; bitwise xor
} }
; ;
#bnot [* | x] -> [* | x] #bnot [* | x] -> [* | x]
:asm bnot { :asm bnot {
not qword [r12] ; bitwise not not qword [r12] ; bitwise not
} }
; ;
#shl [*, x1 | x2] -> [* | x3] #shl [*, x1 | x2] -> [* | x3]
:asm shl { :asm shl {
mov rcx, [r12] ; shift count mov rcx, [r12] ; shift count
add r12, 8 ; pop add r12, 8 ; pop
shl qword [r12], cl ; logical left shift shl qword [r12], cl ; logical left shift
} }
; ;
#sal [*, x1 | x2] -> [* | x3] #sal [*, x1 | x2] -> [* | x3]
:asm sal { :asm sal {
mov rcx, [r12] ; shift count mov rcx, [r12] ; shift count
add r12, 8 ; pop add r12, 8 ; pop
sal qword [r12], cl ; arithmetic left shift (same as shl) sal qword [r12], cl ; arithmetic left shift (same as shl)
} }
; ;
#shr [*, x1 | x2] -> [* | x3] #shr [*, x1 | x2] -> [* | x3]
:asm shr { :asm shr {
mov rcx, [r12] ; shift count mov rcx, [r12] ; shift count
add r12, 8 ; pop add r12, 8 ; pop
shr qword [r12], cl ; logical right shift shr qword [r12], cl ; logical right shift
} }
; ;
#sar [*, x1 | x2] -> [* | x3] #sar [*, x1 | x2] -> [* | x3]
:asm sar { :asm sar {
mov rcx, [r12] ; shift count mov rcx, [r12] ; shift count
add r12, 8 ; pop add r12, 8 ; pop
sar qword [r12], cl ; arithmetic right shift sar qword [r12], cl ; arithmetic right shift
} }
; ;
#rol [*, x1 | x2] -> [* | x3] #rol [*, x1 | x2] -> [* | x3]
:asm rol { :asm rol {
mov rcx, [r12] ; shift count mov rcx, [r12] ; shift count
add r12, 8 ; pop add r12, 8 ; pop
rol qword [r12], cl ; rotate left rol qword [r12], cl ; rotate left
} }
; ;
#ror [*, x1 | x2] -> [* | x3] #ror [*, x1 | x2] -> [* | x3]
:asm ror { :asm ror {
mov rcx, [r12] ; shift count mov rcx, [r12] ; shift count
add r12, 8 ; pop add r12, 8 ; pop
ror qword [r12], cl ; rotate right ror qword [r12], cl ; rotate right
} }
; ;
#inc [* | x] -> [* | x+1] #inc [* | x] -> [* | x+1]
:asm inc { :asm inc {
inc qword [r12] inc qword [r12]
} }
; ;
#dec [* | x] -> [* | x-1] #dec [* | x] -> [* | x-1]
:asm dec { :asm dec {
dec qword [r12] dec qword [r12]
} }
; ;
#min [*, x1 | x2] -> [* | x3] #min [*, x1 | x2] -> [* | x3]
:asm min { :asm min {
mov rax, [r12] ; x2 mov rax, [r12] ; x2
add r12, 8 ; pop add r12, 8 ; pop
mov rbx, [r12] ; x1 mov rbx, [r12] ; x1
cmp rbx, rax cmp rbx, rax
cmovg rbx, rax ; if x1 > x2, pick x2 cmovg rbx, rax ; if x1 > x2, pick x2
mov [r12], rbx mov [r12], rbx
} }
; ;
#max [*, x1 | x2] -> [* | x3] #max [*, x1 | x2] -> [* | x3]
:asm max { :asm max {
mov rax, [r12] ; x2 mov rax, [r12] ; x2
add r12, 8 ; pop add r12, 8 ; pop
mov rbx, [r12] ; x1 mov rbx, [r12] ; x1
cmp rbx, rax cmp rbx, rax
cmovl rbx, rax ; if x1 < x2, pick x2 cmovl rbx, rax ; if x1 < x2, pick x2
mov [r12], rbx mov [r12], rbx
} }
; ;
#clamp [*, x, lo | hi] -> [* | y] #clamp [*, x, lo | hi] -> [* | y]
:asm clamp { :asm clamp {
mov rax, [r12] ; hi mov rax, [r12] ; hi
mov rbx, [r12 + 8] ; lo mov rbx, [r12 + 8] ; lo
mov rcx, [r12 + 16] ; x mov rcx, [r12 + 16] ; x
cmp rcx, rbx cmp rcx, rbx
cmovl rcx, rbx ; if x < lo -> lo cmovl rcx, rbx ; if x < lo -> lo
cmp rcx, rax cmp rcx, rax
cmovg rcx, rax ; if x > hi -> hi cmovg rcx, rax ; if x > hi -> hi
mov [r12 + 16], rcx mov [r12 + 16], rcx
add r12, 16 ; drop lo, hi add r12, 16 ; drop lo, hi
} }
; ;
#time [*] -> [* | t] #time [*] -> [* | t]
:asm time { :asm time {
mov rax, 201 ; syscall: time mov rax, 201 ; syscall: time
xor rdi, rdi xor rdi, rdi
syscall syscall
sub r12, 8 sub r12, 8
mov [r12], rax mov [r12], rax
ret ret
} }
; ;
#rand [*] -> [* | n] #rand [*] -> [* | n]
:asm rand { :asm rand {
lea rbx, [rel persistent] lea rbx, [rel persistent]
mov rax, [rbx] ; state mov rax, [rbx] ; state
test rax, rax test rax, rax
jne .seeded jne .seeded
; seed with time() ; seed with time()
mov rax, 201 ; syscall: time mov rax, 201 ; syscall: time
xor rdi, rdi xor rdi, rdi
syscall syscall
mov [rbx], rax mov [rbx], rax
.seeded: .seeded:
mov rax, [rbx] mov rax, [rbx]
mov rcx, 1103515245 mov rcx, 1103515245
imul rax, rcx imul rax, rcx
add rax, 12345 add rax, 12345
mov [rbx], rax mov [rbx], rax
shr rax, 16 shr rax, 16
and rax, 0x7fff and rax, 0x7fff
sub r12, 8 sub r12, 8
mov [r12], rax mov [r12], rax
ret ret
} }
; ;

63
stdlib/utils.sl
View File

@@ -491,3 +491,66 @@ word splitby_char
r> r>
rm_zero_len_str rm_zero_len_str
end end
# ltrim [*, addr | len] -> [*, addr, | len]
word ltrim
dup for
over c@ 32 == if
swap 1 + swap 1 -
end
end
end
# rtrim [*, addr | len] -> [*, addr, | len]
word rtrim
swap tuck swap
swap over + 1 - swap
dup for
over c@ 32 == if
swap 1 - swap 1 -
end
end nip
end
# trim [*, addr | len] -> [*, addr | len]
word trim
ltrim rtrim
end
# startswith [*, addr, len, addr | len] -> [*, bool]
inline word startswith
strcmp
end
# endswith [*, addr, len, addr | len] -> [*, bool]
word endswith
dup 3 pick swap - 4 pick + over 2 pick 4 pick swap strcmp
nip nip nip nip
end
# contains [*, addr, len, addr | len] -> [* | bool]
word contains
2 pick for
4dup strcmp 1 == if 1 nip nip nip nip rdrop ret end
>r >r >r 1 + r> r> r>
end 0 nip nip nip nip
end
# find the first occurence of a string inside another string, returns the index
# find [*, addr, len, addr | len] -> [* | index]
word find
0 >r 2 pick for
4dup strcmp 1 == if rswap r> nip nip nip nip rdrop ret end
>r >r >r 1 + r> r> r> rswap r> 1 + >r rswap
end -1 nip nip nip nip
end
# find the last occurence of a string inside another string, returns the index
# rfind [*, addr, len, addr | len] -> [* | index]
word rfind
>r >r dup >r + 1 - r> r> r>
2 pick 1 - >r 2 pick for
4dup strcmp 1 == if rswap r> nip nip nip nip rdrop ret end
>r >r >r 1 - r> r> r> rswap r> 1 - >r rswap
end -1 nip nip nip nip
end

3
tests/str.expected
View File

@@ -11,3 +11,6 @@ o wor
d he d he
o wor o wor
he he
|f |
| f|
|f|

5
tests/str.sl
View File

@@ -21,4 +21,9 @@ word main
for puts end for puts end
"hello world hello world hello" "l" splitby "hello world hello world hello" "l" splitby
for puts end for puts end
" f " 2dup 2dup
124 putc ltrim write_buf 124 putc cr
124 putc rtrim write_buf 124 putc cr
124 putc trim write_buf 124 putc cr
end end