l2/stdlib/core.sl

# Reserve 64 bytes in .bss
# persistent: resb 64
# push the addr of it

:asm mem {
	lea rax, [rel persistent]
	sub r12, 8
	mov [r12], rax
}
;

# : argc ( -- n )
:asm argc {
	extern sys_argc
	mov rax, [rel sys_argc]
	sub r12, 8
	mov [r12], rax
	ret
}
;

# : argv ( -- ptr )
:asm argv {
	extern sys_argv
	mov rax, [rel sys_argv]
	sub r12, 8
	mov [r12], rax
	ret
}
;

# : argv@ ( n -- ptr )
:asm argv@ {
	extern sys_argv
	mov rbx, [r12]      ; n
	mov rax, [rel sys_argv]
	mov rax, [rax + rbx*8]
	mov [r12], rax
	ret
}
;

# : c@ ( addr -- byte )
:asm c@ {
	mov rax, [r12]         ; get address from stack
	movzx rax, byte [rax]  ; load byte at address, zero-extend to rax
	mov [r12], rax         ; store result back on stack
	ret
}
;

# : c! ( byte addr -- )
:asm c! {
	mov rax, [r12]         ; get address from stack
	add r12, 8             ; pop address
	mov rbx, [r12]         ; get byte value
	add r12, 8
	mov [rbx], al          ; store byte at address
	ret
}
;

# : r@ ( -- x )
:asm r@ {
	mov rax, [r13]         ; get value from return stack
	sub r12, 8             ; make room on data stack
	mov [r12], rax         ; push value to data stack
	ret
}
;

# : dup ( x -- x x )
:asm dup {
	mov rax, [r12]         ; get top of stack
	sub r12, 8             ; make room
	mov [r12], rax         ; duplicate value
}
;

# : drop ( x -- )
:asm drop {
	add r12, 8             ; remove top of stack
}
;

# : over ( x1 x2 -- x1 x2 x1 )
:asm over {
	mov rax, [r12 + 8]     ; get second item
	sub r12, 8              ; make room
	mov [r12], rax          ; push copy
}
;

# : swap ( x1 x2 -- x2 x1 )
:asm swap {
	mov rax, [r12]         ; get top
	mov rbx, [r12 + 8]     ; get second
	mov [r12], rbx         ; swap
	mov [r12 + 8], rax
}
;

# : rot ( x1 x2 x3 -- x2 x3 x1 )
:asm rot {
	mov rax, [r12]         ; x3 (top)
	mov rbx, [r12 + 8]     ; x2
	mov rcx, [r12 + 16]    ; x1 (bottom)
	mov [r12], rcx         ; new top = x1
	mov [r12 + 8], rax     ; new 2nd = x3
	mov [r12 + 16], rbx    ; new 3rd = x2
}
;

# : -rot ( x1 x2 x3 -- x3 x1 x2 )
:asm -rot {
	mov rax, [r12]         ; x3 (top)
	mov rbx, [r12 + 8]     ; x2
	mov rcx, [r12 + 16]    ; x1 (bottom)
	mov [r12], rbx         ; new top = x2
	mov [r12 + 8], rcx     ; new 2nd = x1
	mov [r12 + 16], rax    ; new 3rd = x3
}
;

# : nip ( x1 x2 -- x2 )
:asm nip {
	mov rax, [r12]         ; get top
	add r12, 8             ; drop lower
	mov [r12], rax         ; keep original top
}
;

# : tuck ( x1 x2 -- x2 x1 x2 )
:asm tuck {
	mov rax, [r12]         ; x2 (top)
	mov rbx, [r12 + 8]     ; x1
	sub r12, 8             ; make room
	mov [r12], rax         ; x2
	mov [r12 + 8], rbx     ; x1
	mov [r12 + 16], rax    ; x2
}
;

# : 2dup ( x1 x2 -- x1 x2 x1 x2 )
:asm 2dup {
	mov rax, [r12]         ; b (top)
	mov rbx, [r12 + 8]     ; a
	sub r12, 8             ; make room
	mov [r12], rbx         ; push a
	sub r12, 8             ; make room
	mov [r12], rax         ; push b
}
;

# : 2drop ( x1 x2 -- )
:asm 2drop {
	add r12, 16            ; remove two items
}
;

# : 2swap ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
:asm 2swap {
	mov rax, [r12]         ; d (top)
	mov rbx, [r12 + 8]     ; c
	mov rcx, [r12 + 16]    ; b
	mov rdx, [r12 + 24]    ; a (bottom)
	mov [r12], rcx         ; new top = b
	mov [r12 + 8], rdx     ; new 2nd = a
	mov [r12 + 16], rax    ; new 3rd = d
	mov [r12 + 24], rbx    ; new 4th = c
}
;

# : 2over ( x1 x2 x3 x4 -- x3 x4 x1 x2 x3 x4 )
:asm 2over {
	mov rax, [r12 + 16]    ; b
	mov rbx, [r12 + 24]    ; a
	sub r12, 8             ; make room
	mov [r12], rbx         ; push a
	sub r12, 8             ; make room
	mov [r12], rax         ; push b
}
;

# : + ( x1 x2 -- x3 )
:asm + {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	add qword [r12], rax   ; add to next
}
;

# : - ( x1 x2 -- x3 )
:asm - {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	sub qword [r12], rax   ; subtract from next
}
;

# : * ( x1 x2 -- x3 )
:asm * {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	imul qword [r12]       ; multiply
	mov [r12], rax         ; store result
}
;

# : / ( x1 x2 -- x3 )
:asm / {
	mov rbx, [r12]         ; divisor
	add r12, 8             ; pop
	mov rax, [r12]         ; dividend
	cqo                    ; sign-extend
	idiv rbx               ; divide
	mov [r12], rax         ; store quotient
}
;

# : % ( x1 x2 -- x3 )
:asm % {
	mov rbx, [r12]         ; divisor
	add r12, 8             ; pop
	mov rax, [r12]         ; dividend
	cqo                    ; sign-extend
	idiv rbx               ; divide
	mov [r12], rdx         ; store remainder
}
;

# : == ( x1 x2 -- flag )
:asm == {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	mov rbx, [r12]         ; get next
	cmp rbx, rax           ; compare
	mov rbx, 0
	sete bl                ; set if equal
	mov [r12], rbx         ; store flag
}
;

# : != ( x1 x2 -- flag )
:asm != {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	mov rbx, [r12]         ; get next
	cmp rbx, rax           ; compare
	mov rbx, 0
	setne bl               ; set if not equal
	mov [r12], rbx         ; store flag
}
;

# : < ( x1 x2 -- flag )
:asm < {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	mov rbx, [r12]         ; get next
	cmp rbx, rax           ; compare
	mov rbx, 0
	setl bl                ; set if less
	mov [r12], rbx         ; store flag
}
;

# : > ( x1 x2 -- flag )
:asm > {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	mov rbx, [r12]         ; get next
	cmp rbx, rax           ; compare
	mov rbx, 0
	setg bl                ; set if greater
	mov [r12], rbx         ; store flag
}
;

# : <= ( x1 x2 -- flag )
:asm <= {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	mov rbx, [r12]         ; get next
	cmp rbx, rax           ; compare
	mov rbx, 0
	setle bl               ; set if less or equal
	mov [r12], rbx         ; store flag
}
;

# : >= ( x1 x2 -- flag )
:asm >= {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	mov rbx, [r12]         ; get next
	cmp rbx, rax           ; compare
	mov rbx, 0
	setge bl               ; set if greater or equal
	mov [r12], rbx         ; store flag
}
;

# : @ ( addr -- x )
:asm @ {
	mov rax, [r12]         ; get address
	mov rax, [rax]         ; load value
	mov [r12], rax         ; store on stack
}
;

# : ! ( x addr -- )
:asm ! {
	mov rax, [r12]         ; get value (TOS)
	add r12, 8             ; pop value
	mov rbx, [r12]         ; get addr (NOS)
	add r12, 8			   ; pop addr
	mov [rbx], rax         ; store value at address
}
;

# : mmap ( addr len prot flags fd offset -- addr )
:asm mmap {
	mov r9, [r12]          ; offset
	add r12, 8
	mov r8, [r12]          ; fd
	add r12, 8
	mov r10, [r12]         ; flags
	add r12, 8
	mov rdx, [r12]         ; prot
	add r12, 8
	mov rsi, [r12]         ; len
	add r12, 8
	mov rdi, [r12]         ; addr
	mov rax, 9             ; syscall: mmap
	syscall
	sub r12, 8
	mov [r12], rax         ; return addr
}
;

# : munmap ( addr len -- res )
:asm munmap {
	mov rsi, [r12]         ; len
	add r12, 8
	mov rdi, [r12]         ; addr
	add r12, 8
	mov rax, 11            ; syscall: munmap
	syscall
	sub r12, 8
	mov [r12], rax         ; return value
}
;

# : exit ( code -- )
:asm exit {
	mov rdi, [r12]         ; exit code
	add r12, 8
	mov rax, 60            ; syscall: exit
	syscall
}
;

# : and ( x1 x2 -- flag )
:asm and {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	mov rbx, [r12]         ; get next
	test rax, rax
	setz cl
	test rbx, rbx
	setz dl
	movzx rcx, cl
	movzx rdx, dl
	and rcx, rdx           ; logical and
	mov [r12], rcx         ; store flag
}
;

# : or ( x1 x2 -- flag )
:asm or {
	mov rax, [r12]         ; get top
	add r12, 8             ; pop
	mov rbx, [r12]         ; get next
	test rax, rax
	setz cl
	test rbx, rbx
	setz dl
	movzx rcx, cl
	movzx rdx, dl
	or rcx, rdx            ; logical or
	mov [r12], rcx         ; store flag
}
;

# : not ( x -- flag )
:asm not {
	mov rax, [r12]         ; get value
	test rax, rax
	setz al                ; set if zero
	movzx rax, al
	mov [r12], rax         ; store flag
}
;

# : >r ( x -- )
:asm >r {
	mov rax, [r12]         ; get value
	add r12, 8             ; pop
	sub r13, 8             ; make room on return stack
	mov [r13], rax         ; push to return stack
}
;

# : r> ( -- x )
:asm r> {
	mov rax, [r13]         ; get value from return stack
	add r13, 8             ; pop return stack
	sub r12, 8             ; make room on data stack
	mov [r12], rax         ; push to data stack
}
;

# : rdrop ( -- )
:asm rdrop {
	add r13, 8             ; pop return stack
}
;

# : pick ( n -- x )
:asm pick {
	mov rcx, [r12]         ; get index
	add r12, 8             ; pop
	mov rax, [r12 + rcx * 8] ; get value at index
	sub r12, 8             ; make room
	mov [r12], rax         ; push value
}
;

# : rpick ( n -- x )
:asm rpick {
	mov rcx, [r12]         ; get index
	add r12, 8             ; pop
	mov rax, [r13 + rcx * 8] ; get value from return stack
	sub r12, 8             ; make room
	mov [r12], rax         ; push value
}
;

# : neg ( x -- -x )
:asm neg {
    mov rax, [r12]   ; get value
    neg rax          ; arithmetic negation
    mov [r12], rax   ; store result
}
;

# : abs ( x -- |x| )
:asm abs {
	mov rax, [r12]   ; get value
	test rax, rax    ; check sign
	jge .done        ; keep if non-negative
	neg rax          ; flip sign when negative
.done:
	mov [r12], rax   ; store result
}
;

# : bitnot ( 0|1 -- 1|0 )
:asm bitnot {
    mov rax, [r12]   ; get value
    xor rax, 1       ; flip lowest bit
    mov [r12], rax   ; store result
}
;