diff --git a/ueforth/common/boot.fs b/ueforth/common/boot.fs index 0d41808..547c84d 100644 --- a/ueforth/common/boot.fs +++ b/ueforth/common/boot.fs @@ -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 diff --git a/ueforth/common/core_test.fs.golden b/ueforth/common/core_test.fs.golden index ab3093d..9690872 100644 --- a/ueforth/common/core_test.fs.golden +++ b/ueforth/common/core_test.fs.golden @@ -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 diff --git a/ueforth/posix/posix.fs b/ueforth/posix/posix.fs index f565dda..5271646 100644 --- a/ueforth/posix/posix.fs +++ b/ueforth/posix/posix.fs @@ -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 0r s>z r> O_CREAT or 0777 open 0z unlink 0z -rot s>z swap rename 0z unlink ; +: rename-file ( a n a n -- ior ) s>z -rot s>z swap rename ; : read-file ( a n fh -- n ior ) -rot read 0r 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 0r @@ -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 ; diff --git a/ueforth/posix/posix_main.c b/ueforth/posix/posix_main.c index af3724a..59c32b9 100644 --- a/ueforth/posix/posix_main.c +++ b/ueforth/posix/posix_main.c @@ -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" diff --git a/ueforth/posix/xlib.fs b/ueforth/posix/xlib.fs new file mode 100644 index 0000000..ee701b8 --- /dev/null +++ b/ueforth/posix/xlib.fs @@ -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 diff --git a/ueforth/posix/xlib_test.fs b/ueforth/posix/xlib_test.fs new file mode 100644 index 0000000..d9db502 --- /dev/null +++ b/ueforth/posix/xlib_test.fs @@ -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 ;