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

Adding xlib stuff.

Browse Source
This commit is contained in:
Brad Nelson
2021-01-03 23:58:04 -08:00
parent 99eb96536f
commit 7275245858
6 changed files with 152 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
ueforth/common/boot.fs
View File

@ -22,6 +22,7 @@
: bl 32 ; : nl 10 ;
: 1+ 1 + ; : 1- 1 - ;
: 2* 2 * ; : 2/ 2 / ;
: 4* 4 * ; : 2/ 4 / ;
: +! ( n a -- ) swap over @ + swap ! ;
( Cells )
@ -175,6 +176,10 @@ variable hld
: see cr ['] : see. ' dup see. space see-loop drop ['] ; see. cr ;
: words last @ begin dup see. >link dup 0= until drop cr ;
( Examine Memory )
: dump ( a n -- )
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

1
ueforth/common/core_test.fs.golden
View File

@ -1,4 +1,3 @@
uEForth
ok
39
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99

24
ueforth/posix/posix.fs
View File

@ -1,16 +1,17 @@
( Shared Library Handling )
1 constant RTLD_LAZY
2 constant RTLD_NOW
: dlopen ( n z -- a ) [ 0 z" dlopen" dlsym aliteral ] call2 ;
0 z" dlopen" dlsym constant 'dlopen
: dlopen ( z n -- a ) 'dlopen call2 ;
create calls
' call0 , ' call1 , ' call2 , ' call3 , ' call4 ,
' call5 , ' call6 , ' call7 , ' call8 , ' call9 ,
' call0 , ' call1 , ' call2 , ' call3 , ' call4 , ' call5 ,
' call6 , ' call7 , ' call8 , ' call9 , ' call10 ,
: sofunc ( z n a "name" -- )
swap >r swap dlsym dup 0= throw create , r> cells calls + @ ,
does> dup @ swap cell+ @ execute ;
: sysfunc ( z n "name" -- ) 0 sofunc ;
: shared-library ( z "name" -- )
RTLD_NOW dlopen 0= throw create , does> @ sofunc ;
RTLD_NOW dlopen dup 0= throw create , does> @ sofunc ;
( Major Syscalls )
z" open" 3 sysfunc open
@ -92,7 +93,7 @@ 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 0 ;
: free ( a -- ior ) sysfree drop 0 ;
: resize ( a n -- a ior ) realloc 0ior ;
( String Handling )
@ -110,11 +111,11 @@ 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 0<ior ;
: delete-file ( a n -- ior ) s>z unlink 0<ior ;
: rename-file ( a n a n -- ior ) s>z -rot s>z swap rename 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 ;
: read-file ( a n fh -- n ior ) -rot read 0<ior ;
: write-file ( a n fh -- ior ) -rot dup >r write r> = 0ior ;
: write-file ( a n fh -- ior ) -rot dup >r write r> = 0= ;
: file-position ( fh -- n ior ) dup 0 SEEK_CUR lseek 0<ior ;
: file-size ( fh -- n ior )
dup 0 SEEK_CUR lseek >r
@ -129,6 +130,9 @@ octal 777 constant 0777 decimal
swap 2dup >r >r
rot dup >r read-file throw drop
r> close-file throw
r> r> over >r dup . cr evaluate
r> r> over >r evaluate
r> free throw ;
: include ( "name" -- ) bl parse included ;
( Load Libraries )
: xlib s" posix/xlib_test.fs" included ;

20
ueforth/posix/posix_main.c
View File

@ -11,12 +11,20 @@
X("CALL1", OP_CALL1, tos = ((cell_t (*)()) tos)(*sp); --sp) \
X("CALL2", OP_CALL2, tos = ((cell_t (*)()) tos)(sp[-1], *sp); sp -= 2) \
X("CALL3", OP_CALL3, tos = ((cell_t (*)()) tos)(sp[-2], sp[-1], *sp); sp -= 3) \
X("CALL4", OP_CALL4, tos = ((cell_t (*)()) tos)(sp[-3], sp[-2], sp[-1], *sp); sp -= 4) \
X("CALL5", OP_CALL5, tos = ((cell_t (*)()) tos)(sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 5) \
X("CALL6", OP_CALL6, tos = ((cell_t (*)()) tos)(sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 6) \
X("CALL7", OP_CALL7, tos = ((cell_t (*)()) tos)(sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 7) \
X("CALL8", OP_CALL8, tos = ((cell_t (*)()) tos)(sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 8) \
X("CALL9", OP_CALL9, tos = ((cell_t (*)()) tos)(sp[-8], sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 9) \
X("CALL4", OP_CALL4, tos = ((cell_t (*)()) tos)(sp[-3], sp[-2], sp[-1], \
*sp); sp -= 4) \
X("CALL5", OP_CALL5, tos = ((cell_t (*)()) tos)(sp[-4], sp[-3], sp[-2], \
sp[-1], *sp); sp -= 5) \
X("CALL6", OP_CALL6, tos = ((cell_t (*)()) tos)(sp[-5], sp[-4], sp[-3], \
sp[-2], sp[-1], *sp); sp -= 6) \
X("CALL7", OP_CALL7, tos = ((cell_t (*)()) tos)(sp[-6], sp[-5], sp[-4], \
sp[-3], sp[-2], sp[-1], *sp); sp -= 7) \
X("CALL8", OP_CALL8, tos = ((cell_t (*)()) tos)(sp[-7], sp[-6], sp[-5], \
sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 8) \
X("CALL9", OP_CALL9, tos = ((cell_t (*)()) tos)(sp[-8], sp[-7], sp[-6], \
sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 9) \
X("CALL10", OP_CALL10, tos = ((cell_t (*)()) tos)(sp[-9], sp[-8], sp[-7], \
sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 10) \
#include "common/core.h"

95
ueforth/posix/xlib.fs Normal file
View File

@ -0,0 +1,95 @@
( Bindings for Xlib )
z" libX11.so" shared-library xlib
z" XOpenDisplay" 1 xlib XOpenDisplay ( a -- a )
z" XBlackPixel" 2 xlib XBlackPixel ( a n -- n )
z" XWhitePixel" 2 xlib XWhitePixel ( a n -- n )
z" XDisplayOfScreen" 1 xlib XDisplayOfScreen ( a -- a )
z" XScreenOfDisplay" 2 xlib XScreenOfDisplay ( a n -- a )
z" XDefaultColormap" 2 xlib XDefaultColormap ( a n -- n )
z" XDefaultScreen" 1 xlib XDefaultScreen ( a -- n )
z" XRootWindow" 2 xlib XRootWindow ( a n -- n )
z" XCheckMaskEvent" 3 xlib XCheckMaskEvent ( a n a -- n )
z" XCreateGC" 4 xlib XCreateGC ( a n n a -- a )
z" XCreateImage" 10 xlib XCreateImage ( a a n n n a n n n n -- a )
z" XCreateSimpleWindow" 9 xlib XCreateSimpleWindow ( a n n n n n n n n -- n )
z" XDefaultDepth" 2 xlib XDefaultDepth ( a n -- n )
z" XDefaultVisual" 2 xlib XDefaultVisual ( a n -- a )
z" XDestroyImage" 1 xlib XDestroyImage ( a -- void )
z" XFlush" 1 xlib XFlush ( a -- void )
z" XLookupString" 5 xlib XLookupString ( a a n a a -- n )
z" XMapWindow" 2 xlib XMapWindow ( a n -- void )
z" XNextEvent" 2 xlib XNextEvent ( a a -- void )
z" XPutImage" 10 xlib XPutImage ( a n a a n n n n n n -- void )
z" XSelectInput" 3 xlib XSelectInput ( a n n -- void )
z" XDrawString" 7 xlib XDrawString ( a n n n n a n -- void )
0 constant NULL
32 cells constant xevent-size
0 constant NoEventMask
1 : xmask dup constant 2* ;
xmask KeyPressMask
xmask KeyReleaseMask
xmask ButtonPressMask
xmask ButtonReleaseMask
xmask EnterWindowMask
xmask LeaveWindowMask
xmask PointerMotionMask
xmask PointerMotionHintMask
xmask Button1MotionMask
xmask Button2MotionMask
xmask Button3MotionMask
xmask Button4MotionMask
xmask Button5MotionMask
xmask ButtonMotionMask
xmask KeymapStateMask
xmask ExposureMask
xmask VisibilityChangeMask
xmask StructureNotifyMask
xmask ResizeRedirectMask
xmask SubstructureNotifyMask
xmask SubstructureRedirectMask
xmask FocusChangeMask
xmask PropertyChangeMask
xmask ColormapChangeMask
xmask OwnerGrabButtonMask
drop
2 : xevent dup constant 1+ ;
xevent KeyPress
xevent KeyRelease
xevent ButtonPress
xevent ButtonRelease
xevent MotionNotify
xevent EnterNotify
xevent LeaveNotify
xevent FocusIn
xevent FocusOut
xevent KeymapNotify
xevent Expose
xevent GraphicsExpose
xevent NoExpose
xevent VisibilityNotify
xevent CreateNotify
xevent DestroyNotify
xevent UnmapNotify
xevent MapNotify
xevent MapRequest
xevent ReparentNotify
xevent ConfigureNotify
xevent ConfigureRequest
xevent GravityNotify
xevent ResizeRequest
xevent CirculateNotify
xevent CirculateRequest
xevent PropertyNotify
xevent SelectionClear
xevent SelectionRequest
xevent SelectionNotify
xevent ColormapNotify
xevent ClientMessage
xevent MappingNotify
xevent GenericEvent
drop

24
ueforth/posix/xlib_test.fs Normal file
View File

@ -0,0 +1,24 @@
include posix/xlib.fs
z" :0" XOpenDisplay constant display
display XDefaultScreen constant screen
display screen XBlackPixel constant black
display screen XWhitePixel constant white
display screen XRootWindow constant root-window
display root-window 0 0 640 480 0 black white XCreateSimpleWindow constant window
display window XMapWindow drop
display window 0 NULL XCreateGC constant gc
ExposureMask
ButtonPressMask or
ButtonReleaseMask or
KeyPressMask or
KeyReleaseMask or
PointerMotionMask or
StructureNotifyMask or constant event-mask
display window event-mask XSelectInput drop
create event xevent-size allot
: de event xevent-size dump cr cr ;
: 1e display event XNextEvent drop de ;
: gg begin 1e again ;