alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Improving library layout.

Browse Source
This commit is contained in:
Brad Nelson
2021-01-07 17:33:17 -08:00
parent c8f6776511
commit 41e25178fb
10 changed files with 76 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
ueforth/Makefile
View File

@ -69,7 +69,10 @@ core_test: $(POSIX)/ueforth common/core_test.fs \
$(GEN):
mkdir -p $@
POSIX_BOOT = common/boot.fs common/terminal.fs posix/posix.fs
POSIX_BOOT = common/boot.fs common/terminal.fs \
posix/posix.fs posix/posix_highlevel.fs \
common/filetools.fs posix/posix_desktop.fs \
common/autoboot.fs
$(GEN)/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | $(GEN)
echo "ok" | cat $(POSIX_BOOT) - | $< boot >$@

4
ueforth/arduino/arduino.fs
View File

@ -15,6 +15,8 @@
: freq ( n n -- ) 1000 * 13 ledcSetup drop ;
: tone ( n n -- ) 1000 * ledcWriteTone drop ;
( Startup Serial )
( Startup Setup )
-1 echo !
115200 Serial.begin
100 ms
-1 z" /" 10 SPIFFS.begin drop

25
ueforth/arduino/arduino.template.ino
View File

@ -22,7 +22,13 @@
# define STACK_SIZE 32
#endif
#define PUSH(v) (DUP, tos = (v))
#define PLATFORM_OPCODE_LIST \
/* Allocation and Strings */ \
X("MALLOC", MALLOC, tos = (cell_t) malloc(tos)) \
X("SYSFREE", FREE, free((void *) tos); DROP) \
X("REALLOC", REALLOC, tos = (cell_t) realloc((void *) *sp, tos); --sp) \
/* Serial */ \
X("Serial.begin", SERIAL_BEGIN, Serial.begin(tos); DROP) \
X("Serial.end", SERIAL_END, Serial.end()) \
@ -47,30 +53,30 @@
X("MS", MS, delay(tos); DROP) \
X("TERMINATE", TERMINATE, exit(tos)) \
/* File words */ \
X("R/O", R_O, *++sp = O_RDONLY) \
X("R/W", R_W, *++sp = O_RDWR) \
X("W/O", W_O, *++sp = O_WRONLY) \
X("R/O", R_O, PUSH(O_RDONLY)) \
X("R/W", R_W, PUSH(O_RDWR)) \
X("W/O", W_O, PUSH(O_WRONLY)) \
X("BIN", BIN, ) \
X("CLOSE-FILE", CLOSE_FILE, tos = close(tos); tos = tos ? errno : 0) \
X("OPEN-FILE", OPEN_FILE, cell_t mode = tos; DROP; cell_t len = tos; DROP; \
memcpy(filename, (void *) tos, len); filename[len] = 0; \
tos = open(filename, mode, 0777); PUSH tos < 0 ? errno : 0) \
tos = open(filename, mode, 0777); PUSH(tos < 0 ? errno : 0)) \
X("CREATE-FILE", CREATE_FILE, cell_t mode = tos; DROP; cell_t len = tos; DROP; \
memcpy(filename, (void *) tos, len); filename[len] = 0; \
tos = open(filename, mode | O_CREAT | O_TRUNC); PUSH tos < 0 ? errno : 0) \
tos = open(filename, mode | O_CREAT | O_TRUNC); PUSH(tos < 0 ? errno : 0)) \
X("DELETE-FILE", DELETE_FILE, cell_t len = tos; DROP; \
memcpy(filename, (void *) tos, len); filename[len] = 0; \
tos = unlink(filename); tos = tos ? errno : 0) \
X("WRITE-FILE", WRITE_FILE, cell_t fd = tos; DROP; cell_t len = tos; DROP; \
tos = write(fd, (void *) tos, len); tos = tos != len ? errno : 0) \
X("READ-FILE", READ_FILE, cell_t fd = tos; DROP; cell_t len = tos; DROP; \
tos = read(fd, (void *) tos, len); PUSH tos != len ? errno : 0) \
tos = read(fd, (void *) tos, len); PUSH(tos != len ? errno : 0)) \
X("FILE-POSITION", FILE_POSITION, \
tos = (cell_t) lseek(tos, 0, SEEK_CUR); PUSH tos < 0 ? errno : 0) \
tos = (cell_t) lseek(tos, 0, SEEK_CUR); PUSH(tos < 0 ? errno : 0)) \
X("REPOSITION-FILE", REPOSITION_FILE, cell_t fd = tos; DROP; \
tos = (cell_t) lseek(fd, tos, SEEK_SET); tos = tos < 0 ? errno : 0) \
X("FILE-SIZE", FILE_SIZE, struct stat st; w = fstat(tos, &st); \
tos = (cell_t) st.st_size; PUSH w < 0 ? errno : 0) \
tos = (cell_t) st.st_size; PUSH(w < 0 ? errno : 0)) \
/* WiFi */ \
X("WiFi.config", WIFI_CONFIG, \
WiFi.config(ToIP(sp[-1]), ToIP(*sp), ToIP(tos)); sp -= 2; DROP) \
@ -81,7 +87,8 @@
X("WiFi.macAddress", WIFI_MAC_ADDRESS, WiFi.macAddress((uint8_t *) tos); DROP) \
X("WiFi.localIP", WIFI_LOCAL_IPS, DUP; tos = FromIP(WiFi.localIP())) \
/* SPIFFS */ \
X("SPIFFS.begin", SPIFFS_BEGIN, tos = SPIFFS.begin(tos)) \
X("SPIFFS.begin", SPIFFS_BEGIN, \
tos = SPIFFS.begin(sp[-1], (const char *) *sp, tos); sp -=2) \
X("SPIFFS.end", SPIFFS_END, SPIFFS.end()) \
X("SPIFFS.format", SPIFFS_FORMAT, DUP; tos = SPIFFS.format()) \
X("SPIFFS.totalBytes", SPIFFS_TOTAL_BYTES, DUP; tos = SPIFFS.totalBytes()) \

2
ueforth/common/autoboot.fs Normal file
View File

@ -0,0 +1,2 @@
: autoexec s" autoexec.fs" ['] included catch 2drop drop ;
autoexec

11
ueforth/common/boot.fs
View File

@ -39,8 +39,6 @@
: 'heap ( -- a ) 'sys 5 cells + ;
: last ( -- a ) 'sys 6 cells + ;
: 'notfound ( -- a ) 'sys 7 cells + ;
: 'argc ( -- a ) 'sys 8 cells + ;
: 'argv ( -- a ) 'sys 9 cells + ;
( Dictionary )
: here ( -- a ) 'heap @ ;
@ -162,6 +160,8 @@ variable hld
: ." postpone s" state @ if postpone type else type then ; immediate
: z" postpone s" state @ if postpone drop else drop then ; immediate
: r" parse-quote state @ if swap aliteral aliteral then ; immediate
: s>z ( a n -- z ) here >r $place r> ;
: z>s ( z -- a n ) 0 over begin dup c@ while 1+ swap 1+ swap repeat drop ;
( Better Errors )
: notfound ( a n n -- )
@ -182,8 +182,11 @@ variable hld
cr 0 do i 16 mod 0= if cr then dup i + c@ . loop drop cr ;
( Input )
: accept ( a n -- n ) 0 swap begin 2dup < while
key dup nl = if 2drop nip exit then
variable echo
: ?echo ( n -- ) echo @ if emit else drop then ;
: ?echo-prompt echo @ if ." --> " then ;
: accept ( a n -- n ) ?echo-prompt 0 swap begin 2dup < while
key dup ?echo dup nl = if 2drop nip exit then
>r rot r> over c! 1+ -rot swap 1+ swap repeat drop nip ;
200 constant input-limit
: tib ( -- a ) 'tib @ ;

5
ueforth/common/filetools.fs Normal file
View File

@ -0,0 +1,5 @@
: dump-file ( a n a n -- )
w/o create-file if drop ." failed create-file" exit then
>r r@ write-file if r> drop ." failed write-file" exit then
r> close-file drop
;

1
ueforth/common/opcodes.h
View File

@ -14,7 +14,6 @@ typedef uint64_t udcell_t;
# error "unsupported cell size"
#endif
#define PUSH DUP; tos =
#define DUP *++sp = tos
#define DROP tos = *sp--
#define COMMA(n) *g_sys.heap++ = (n)

55
ueforth/posix/posix.fs
View File

@ -12,6 +12,7 @@ create calls
: sysfunc ( z n "name" -- ) 0 sofunc ;
: shared-library ( z "name" -- )
RTLD_NOW dlopen dup 0= throw create , does> @ sofunc ;
: sign-extend ( n -- n ) >r rp@ l@ rdrop ;
( Major Syscalls )
z" open" 3 sysfunc open
@ -28,7 +29,9 @@ z" mmap" 6 sysfunc mmap
z" munmap" 2 sysfunc munmap
z" unlink" 1 sysfunc unlink
z" rename" 2 sysfunc rename
z" strlen" 1 sysfunc strlen
z" malloc" 1 sysfunc malloc
z" free" 1 sysfunc sysfree
z" realloc" 2 sysfunc realloc
( Errno )
z" __errno_location" 0 sysfunc __errno_location
@ -53,12 +56,14 @@ $10 constant MAP_FIXED
$20 constant MAP_ANONYMOUS
( open )
octal
0 constant O_RDONLY
1 constant O_WRONLY
2 constant O_RDWR
$100 constant O_CREAT
$200 constant O_TRUNC
$2000 constant O_APPEND
100 constant O_CREAT
200 constant O_TRUNC
2000 constant O_APPEND
decimal
( Hookup I/O )
: stdout-write ( a n -- ) stdout -rot write drop ;
@ -72,32 +77,17 @@ $2000 constant O_APPEND
: 0ior ( n -- n ior ) dup 0= if errno else 0 then ;
: 0<ior ( n -- n ior ) dup 0< if errno else 0 then ;
( Words with OS assist )
z" malloc" 1 sysfunc malloc
z" free" 1 sysfunc sysfree
z" realloc" 2 sysfunc realloc
: allocate ( n -- a ior ) malloc 0ior ;
: free ( a -- ior ) sysfree drop 0 ;
: resize ( a n -- a ior ) realloc 0ior ;
( String Handling )
: s>z ( a n -- z ) here >r $place r> ;
: z>s ( z -- a n ) dup strlen ;
( Arguments )
: argc ( -- n ) 'argc @ ;
: argv ( n -- a n ) cells 'argv @ + @ z>s ;
( Generic Files )
O_RDONLY constant r/o
O_WRONLY constant w/o
O_RDWR constant r/w
octal 777 constant 0777 decimal
: open-file ( a n fam -- fh ior ) >r s>z r> 0777 open 0<ior ;
: create-file ( a n fam -- fh ior ) >r s>z r> O_CREAT or 0777 open 0<ior ;
: close-file ( fh -- ior ) close ;
: delete-file ( a n -- ior ) s>z unlink ;
: rename-file ( a n a n -- ior ) s>z -rot s>z swap rename ;
: open-file ( a n fam -- fh ior ) >r s>z r> 0777 open sign-extend 0<ior ;
: create-file ( a n fam -- fh ior )
>r s>z r> O_CREAT or 0777 open sign-extend 0<ior ;
: close-file ( fh -- ior ) close sign-extend ;
: delete-file ( a n -- ior ) s>z unlink sign-extend ;
: rename-file ( a n a n -- ior ) s>z -rot s>z swap rename sign-extend ;
: read-file ( a n fh -- n ior ) -rot read 0<ior ;
: write-file ( a n fh -- ior ) -rot dup >r write r> = 0= ;
: file-position ( fh -- n ior ) dup 0 SEEK_CUR lseek 0<ior ;
@ -105,18 +95,3 @@ octal 777 constant 0777 decimal
dup 0 SEEK_CUR lseek >r
dup 0 SEEK_END lseek r> swap >r
SEEK_SET lseek drop r> 0<ior ;
( Including Files )
: included ( a n -- )
r/o open-file throw
dup file-size throw
dup allocate throw
swap 2dup >r >r
rot dup >r read-file throw drop
r> close-file throw
r> r> over >r evaluate
r> free throw ;
: include ( "name" -- ) bl parse included ;
( Load Libraries )
: xlib s" posix/xlib_test.fs" included ;

8
ueforth/posix/posix_desktop.fs Normal file
View File

@ -0,0 +1,8 @@
( Arguments )
: 'argc ( -- a ) 'sys 8 cells + ;
: 'argv ( -- a ) 'sys 9 cells + ;
: argc ( -- n ) 'argc @ ;
: argv ( n -- a n ) cells 'argv @ + @ z>s ;
( Load Libraries )
: xlib s" posix/xlib_test.fs" included ;

16
ueforth/posix/posix_highlevel.fs Normal file
View File

@ -0,0 +1,16 @@
( Words with OS assist )
: allocate ( n -- a ior ) malloc dup 0= ;
: free ( a -- ior ) sysfree drop 0 ;
: resize ( a n -- a ior ) realloc dup 0= ;
( Including Files )
: included ( a n -- )
r/o open-file dup if nip throw else drop then
dup file-size throw
dup allocate throw
swap 2dup >r >r
rot dup >r read-file throw drop
r> close-file throw
r> r> over >r evaluate
r> free throw ;
: include ( "name" -- ) bl parse included ;