mirror of
https://git.sr.ht/~crc_/retroforth
synced 2024-09-29 05:36:52 +02:00
vm/nga-c-no-libc: drop WIP support for OpenBSD as future OpenBSD releases will require syscalls to be routed through libc. Ref thread: https://www.mail-archive.com/tech@openbsd.org/msg54429.html
FossilOrigin-Name: 909ee67a53191440235e0a9dcfdea1e8588c91344541d3bce250eddf2f50897f
This commit is contained in:
crc
parent
d8d1b0b759
commit
e7d3030ebf
3 changed files with 117 additions and 89 deletions
|
|
@ -1,46 +1,133 @@
|
|||
This implements a FIFO queue. It's directly based on the code in
|
||||
a comp.lang.forth post titled "A queue without move". See
|
||||
# FIFO Queue
|
||||
|
||||
This implements a FIFO queue. It was based on the code in
|
||||
a comp.lang.forth post titled "A queue without move", but
|
||||
has been refactored and expanded slightly. See
|
||||
https://narkive.com/khcCauFY for the original posting.
|
||||
|
||||
# Limits
|
||||
|
||||
The queue size needs to be a power of 2.
|
||||
|
||||
# Code
|
||||
|
||||
~~~
|
||||
:q:named (size,string) d:create #0 , #0 , dup , allot ;
|
||||
:q:head (q-a) ; immediate
|
||||
:q:tail (q-a) n:inc ;
|
||||
:q:size (q-n) #2 + fetch ;
|
||||
:q:list (q-a) #3 + ;
|
||||
:q:mask (q-n) q:size n:dec ;
|
||||
:q:len (q-n) [ q:head fetch ] [ q:tail fetch ] bi - ;
|
||||
:q:free (q-n) [ q:size ] sip q:len - ;
|
||||
:q:clear (q-) [ q:head v:off ] [ q:tail v:off ] bi ;
|
||||
:q:new (n-a) here [ #0 , #0 , dup , allot ] dip ;
|
||||
:q:named (ns-) [ q:new ] dip const ;
|
||||
:q:head (q-a) ; immediate
|
||||
:q:tail (q-a) n:inc ;
|
||||
:q:size (q-n) #2 + fetch ;
|
||||
:q:list (q-a) #3 + ;
|
||||
:q:mask (q-n) q:size n:dec ;
|
||||
:q:length (q-n) [ q:head fetch ] [ q:tail fetch ] bi - ;
|
||||
:q:free (q-n) [ q:size ] sip q:length - ;
|
||||
:q:clear (q-) [ q:head v:off ] [ q:tail v:off ] bi ;
|
||||
:q:masked (aq-n) q:mask swap fetch and ;
|
||||
:q:reset0 (q-) dup q:len n:zero? [ q:clear ] [ drop ] choose ;
|
||||
:q:reset0 (q-) dup q:length n:zero? &q:clear &drop choose ;
|
||||
|
||||
{{
|
||||
'R var
|
||||
|
||||
(for_adding_values)
|
||||
:append-value swap @R q:list @R q:head @R q:masked + store
|
||||
@R q:head v:inc ;
|
||||
|
||||
(for_fetching_values)
|
||||
:fetch-value @R q:list @R q:tail @R q:masked + fetch
|
||||
@R q:tail v:inc swap @R q:reset0 ;
|
||||
---reveal---
|
||||
:q:add (nq-f)
|
||||
[ !R ] [ q:free n:strictly-positive? dup ] bi
|
||||
[ append-value ] if; nip ;
|
||||
|
||||
:q:get (q-nf)
|
||||
[ !R ] [ q:length n:strictly-positive? dup ] bi
|
||||
[ fetch-value ] if; #0 swap ;
|
||||
}}
|
||||
~~~
|
||||
|
||||
I am separating out the display code as it's fairly large
|
||||
and some may want to leave it out. (When compiled, this
|
||||
increases the size by more than 50%. While useful, the size
|
||||
hit may make it undesirable on systems with tight memory
|
||||
constraints)
|
||||
|
||||
~~~
|
||||
{{
|
||||
'R var
|
||||
|
||||
(for_display)
|
||||
:head? @R q:tail @R q:masked eq? ;
|
||||
:tail? @R q:head fetch n:dec @R q:mask and eq? ;
|
||||
:display nl I dup n:put sp dup @R q:list + fetch n:put sp ;
|
||||
:indicators dup head? [ '<--_tail s:put ] if
|
||||
tail? [ '<--_head s:put ] if ;
|
||||
---reveal---
|
||||
:q:add (nq-f)
|
||||
[ !R ] [ q:free n:strictly-positive? ] bi
|
||||
[ @R q:list @R q:head @R q:masked + store
|
||||
@R q:head v:inc TRUE ]
|
||||
[ drop FALSE ] choose ;
|
||||
|
||||
:q:get (q-nf)
|
||||
[ !R ] [ q:len n:strictly-positive? ] bi
|
||||
[ @R q:list @R q:tail @R q:masked + fetch @R q:tail
|
||||
v:inc TRUE @R q:reset0 ]
|
||||
[ #0 FALSE ] choose ;
|
||||
|
||||
:q:put (q-)
|
||||
[ !R ] [ q:free ] [ q:len ] tri
|
||||
[ !R ] [ q:free ] [ q:length ] tri
|
||||
'\nin_que:_%n,_free:_%n s:format s:put
|
||||
@R q:len n:strictly-positive?
|
||||
[ @R q:size
|
||||
[ display dup head? [ '<--_tail s:put ] if
|
||||
tail? [ '<--_head s:put ] if
|
||||
] times<with-index> ]
|
||||
@R q:length n:strictly-positive?
|
||||
[ @R q:size [ display indicators ] times<with-index> ]
|
||||
[ 'queue_is_empty s:put nl ] choose ;
|
||||
}}
|
||||
~~~
|
||||
|
||||
# Usage
|
||||
|
||||
The original didn't include any documentation, so here are a few
|
||||
brief notes on this.
|
||||
|
||||
Creating a new queue:
|
||||
|
||||
q:new
|
||||
q:named
|
||||
|
||||
Examples:
|
||||
|
||||
#16 q:new (returns_a_pointer_to_the_queue)
|
||||
#16 'Q q:named (create_a_queue_and_create_a_constant)
|
||||
(pointing_to_it)
|
||||
|
||||
See the Limits section for a note on the sizing.
|
||||
|
||||
Adding Values:
|
||||
|
||||
#1 Q q:add
|
||||
#2 Q q:add
|
||||
|
||||
The `q:add` returns a flag indicating success or fail. Check or
|
||||
discard this as necessary for your application.
|
||||
|
||||
Retreive Values:
|
||||
|
||||
Q q:get
|
||||
Q q:get
|
||||
|
||||
Like `q:add`, this returns a flag indicating success or failure.
|
||||
This also returns the value, or a value of 0 on failure.
|
||||
|
||||
Empty the Queue:
|
||||
|
||||
Q q:clear
|
||||
|
||||
Queue Queries:
|
||||
|
||||
Q q:size
|
||||
Q q:length
|
||||
|
||||
# A Test
|
||||
|
||||
```
|
||||
#16 'Q q:named
|
||||
#100 Q q:add
|
||||
#200 Q q:add
|
||||
#300 Q q:add
|
||||
#400 Q q:add
|
||||
#500 Q q:add dump-stack nl reset
|
||||
Q q:put
|
||||
Q q:get drop n:put sp
|
||||
Q q:get drop n:put sp
|
||||
Q q:get drop n:put nl
|
||||
Q q:get drop n:put nl
|
||||
Q q:put
|
||||
```
|
||||
|
|
|
|||
|
|
@ -24,12 +24,6 @@ freebsd-x86-64bit: common
|
|||
nasm -f elf64 fbsd64.s
|
||||
ld -nostdlib -m elf_x86_64_fbsd fbsd64.o retro.o -o bin/retro.freebsd64
|
||||
|
||||
openbsd-x86-64bit: common
|
||||
cc -m64 -c retro.c
|
||||
nasm -f elf64 obsd64.s
|
||||
ld.bfd -m elf_x86_64_obsd -r obsd64.o retro.o -o bin/retro.openbsd64
|
||||
chmod +x bin/retro.openbsd64
|
||||
|
||||
macos: common
|
||||
cc -m64 -c retro.c
|
||||
nasm -f macho64 macos.s
|
||||
|
|
|
|||
|
|
@ -1,53 +0,0 @@
|
|||
; This is the minimal startup + I/O functionality needed to run
|
||||
; RETRO on an OpenBSD x86-64 system.
|
||||
; =============================================================
|
||||
|
||||
bits 64
|
||||
|
||||
section .note.openbsd.ident
|
||||
align 2
|
||||
dd 8,4,1
|
||||
db "OpenBSD",0
|
||||
dd 0
|
||||
align 2
|
||||
|
||||
section .text
|
||||
global putchar
|
||||
global getchar
|
||||
global _start
|
||||
|
||||
extern main
|
||||
|
||||
align 8
|
||||
_start:
|
||||
jmp main
|
||||
jmp $
|
||||
|
||||
align 8
|
||||
putchar:
|
||||
mov rax, rdi
|
||||
mov [buf], eax
|
||||
mov rax, 4 ; sys_write
|
||||
mov rdi, 1 ; stdout
|
||||
mov rsi, buf ; address
|
||||
mov rdx, 1 ; 1 byte
|
||||
syscall
|
||||
ret
|
||||
|
||||
align 8
|
||||
getchar:
|
||||
mov rax, 3 ; sys_read
|
||||
mov rdi, 0 ; stdin
|
||||
mov rsi, buf ; address
|
||||
mov rdx, 1 ; 1 byte
|
||||
syscall
|
||||
mov rax, 0
|
||||
mov eax, [buf]
|
||||
ret
|
||||
|
||||
section .data
|
||||
buf:
|
||||
dd 0
|
||||
dd 0
|
||||
dd 0
|
||||
dd 0
|
||||
Loading…
Reference in a new issue