Adding xlib stuff.

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

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 

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 ,
+' call0 , ' call1 , ' call2 , ' call3 , ' call4 , ' call5 ,
-' call5 , ' call6 , ' call7 , ' call8 , ' call9 ,
+' 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 ;
+: close-file ( fh -- ior ) close ;
-: delete-file ( a n -- ior ) s>z unlink 0<ior ;
+: delete-file ( a n -- ior ) s>z unlink ;
-: rename-file ( a n a n -- ior ) s>z -rot s>z swap rename 0<ior ;
+: 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 ;

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("CALL4", OP_CALL4, tos = ((cell_t (*)()) tos)(sp[-3], sp[-2], sp[-1], \
-  X("CALL5", OP_CALL5, tos = ((cell_t (*)()) tos)(sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 5) \
+              *sp); sp -= 4) \
-  X("CALL6", OP_CALL6, tos = ((cell_t (*)()) tos)(sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 6) \
+  X("CALL5", OP_CALL5, tos = ((cell_t (*)()) tos)(sp[-4], sp[-3], sp[-2], \
-  X("CALL7", OP_CALL7, tos = ((cell_t (*)()) tos)(sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], *sp); sp -= 7) \
+              sp[-1], *sp); sp -= 5) \
-  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("CALL6", OP_CALL6, tos = ((cell_t (*)()) tos)(sp[-5], sp[-4], sp[-3], \
-  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) \
+              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"
 

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

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 ;