KolibriOS/oberon-07-compiler
16
0 Fork 0
mirror of https://github.com/AntKrotov/oberon-07-compiler.git synced 2026-10-05 09:45:47 +00:00
Code Issues Packages Projects Releases Wiki Activity

Linux: обновление примеров

Browse Source
This commit is contained in:
AntKrotov committed 2020-12-03 17:50:18 +03:00
1 parent f85179518b
commit c8bf5cca1f
12 files changed
+16 -601
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

samples/Linux/HW.ob07 → samples/Linux/Hello.ob07
+2 -2
View File
@@ -1,4 +1,4 @@
MODULE HW;
MODULE Hello;
IMPORT SYSTEM, Libdl, Args;
@@ -49,4 +49,4 @@ BEGIN
SYSTEM.PUT(SYSTEM.ADR(puts), Libdl.sym(libc, "puts"));
ASSERT(puts # NIL);
main
END HW.
END Hello.
samples/Linux/X11/animation/animation.ob07 → samples/Linux/X11/animation.ob07
+6 -1
View File
@@ -1,6 +1,11 @@
MODULE animation; (* moving turtle example *)
(* demonstrates use of timeout and select() to display a moving turtle in an X11 window *)
IMPORT SYSTEM, gr;
IMPORT
SYSTEM,
gr IN "./common/gr.ob07";
CONST
Side = 8; (* nr of pixels of a square side *)
samples/Linux/X11/animation/_unix.ob07 → samples/Linux/X11/common/_unix.ob07
View File
File renamed without changes.
samples/Linux/X11/animation/gr.ob07 → samples/Linux/X11/common/gr.ob07
View File
File renamed without changes.
samples/Linux/X11/animation/out.ob07 → samples/Linux/X11/common/out.ob07
View File
File renamed without changes.
samples/Linux/X11/animation/unix.ob07 → samples/Linux/X11/common/unix.ob07
View File
File renamed without changes.
samples/Linux/X11/filler/filler.ob07 → samples/Linux/X11/filler.ob07
+8 -1
View File
@@ -1,5 +1,12 @@
MODULE filler; (* filler game, color more fields than the opponent *)
IMPORT SYSTEM, out, unix, gr;
IMPORT
SYSTEM,
out IN "./common/out.ob07",
unix IN "./common/unix.ob07",
gr IN "./common/gr.ob07";
CONST
Side = 14; (* nr of pixels of a field side *)
samples/Linux/X11/filler/_unix.ob07
-74
View File
@@ -1,74 +0,0 @@
MODULE _unix; (* connect to unix host *)
IMPORT SYSTEM, API;
(* how to find C declarations:
- gcc -E preprocess only (to stdout) (preprocessor expand)
- grep -r name /usr/include/*
- ldd progfile
- objdump -T progfile (-t) (-x)
*)
CONST RTLD_LAZY = 1;
BIT_DEPTH* = API.BIT_DEPTH;
VAR sym, libc, libdl :INTEGER;
_dlopen* :PROCEDURE [linux] (name, flags :INTEGER) :INTEGER;
_dlsym* :PROCEDURE [linux] (p, name :INTEGER) :INTEGER;
_dlclose* :PROCEDURE [linux] (p :INTEGER) :INTEGER;
_open* :PROCEDURE [linux] (name, flags, mode :INTEGER) :INTEGER;
_close* :PROCEDURE [linux] (fd :INTEGER) :INTEGER;
_read* :PROCEDURE [linux] (fd, buf, sz :INTEGER): INTEGER;
_write* :PROCEDURE [linux] (fd, buf, sz :INTEGER) :INTEGER;
_exit* :PROCEDURE [linux] (n :INTEGER);
_malloc* :PROCEDURE [linux] (sz :INTEGER) :INTEGER;
_select* :PROCEDURE [linux] (cnt, readfds, writefds, exceptfds, timeout :INTEGER) :INTEGER;
(* error message to stderr *)
PROCEDURE writeChar (c :CHAR);
VAR ri :INTEGER;
BEGIN ri := _write (2, SYSTEM.ADR(c), 1); ASSERT (ri = 1) END writeChar;
PROCEDURE writeString (s :ARRAY OF CHAR);
VAR i :INTEGER;
BEGIN i := 0; WHILE s[i] # 0X DO writeChar (s[i]); INC(i) END; END writeString;
PROCEDURE nl;
BEGIN writeChar (0AX) END nl;
PROCEDURE getSymAdr (lib :INTEGER; name :ARRAY OF CHAR; adr :INTEGER);
BEGIN
sym := _dlsym (lib, SYSTEM.ADR(name[0]));
IF sym = 0 THEN writeString ("error: dlsym: "); writeString (name); nl END;
ASSERT (sym # 0);
SYSTEM.PUT (adr, sym)
END getSymAdr;
PROCEDURE finish*;
VAR ri :INTEGER;
BEGIN
IF libc # 0 THEN ri := _dlclose (libc); libc := 0 END;
IF libdl # 0 THEN ri := _dlclose (libdl); libdl := 0 END;
END finish;
BEGIN
_dlopen := API.dlopen;
_dlsym := API.dlsym;
libc := _dlopen (SYSTEM.SADR("libc.so.6"), RTLD_LAZY); ASSERT (libc # 0);
(* getSymAdr is not used for write() to get writeString() error message going *);
sym := _dlsym (libc, SYSTEM.SADR("write")); ASSERT (sym # 0); SYSTEM.PUT (SYSTEM.ADR(_write), sym);
libdl := _dlopen (SYSTEM.SADR("libdl.so.2"), RTLD_LAZY); ASSERT (libdl # 0);
getSymAdr (libdl, "dlclose", SYSTEM.ADR(_dlclose));
getSymAdr (libc, "open", SYSTEM.ADR(_open));
getSymAdr (libc, "close", SYSTEM.ADR(_close));
getSymAdr (libc, "read", SYSTEM.ADR(_read));
getSymAdr (libc, "exit", SYSTEM.ADR(_exit));
getSymAdr (libc, "malloc", SYSTEM.ADR(_malloc));
getSymAdr (libc, "select", SYSTEM.ADR(_select));
END _unix.
samples/Linux/X11/filler/filler.txt
-15
View File
@@ -1,15 +0,0 @@
Filler game
Player and computer each try to conquer the most fields.
Player starts at left bottom and computer at right top.
At each turn, a new color is chosen and area extended.
Press 1 .. 6 to choose color. At the left side of the board the top
color has nr 1 and the bottom color nr 6. The current colors of player
and opponent can not be chosen. The current area receives the new color
and is extended with all bordering areas of the chosen color.
Have fun!
samples/Linux/X11/filler/gr.ob07
-292
View File
@@ -1,292 +0,0 @@
MODULE gr; (* connect to libX11 *)
IMPORT SYSTEM, unix, out;
(*
X11 documentation in:
- http://tronche.com/gui/x/xlib/ an X11 reference
- http://www.sbin.org/doc/Xlib an X11 tutorial (this domain has disappeared)
*)
CONST
InputOutput = 1;
StructureNotifyMask = 20000H; (* input event mask *)
ExposureMask = 8000H; KeyPressMask = 1; KeyReleaseMask = 2;
ButtonPressMask = 4; ButtonReleaseMask = 8; (* PointerNotionMask *)
ZPixmap = 2;
Expose = 12; (* X event type *) ConfigureNotify = 22; KeyPress = 2; ButtonPress = 4;
EventTimeOut* = 80; (* 0, 0, 0, 0 *)
EventResize* = 81; (* 0, w, h, 0 *)
EventKeyPressed* = 82; (* isPrintable, keyCode (X11 scan code), state, keySym (ASCII) *)
EventKeyReleased* = 83; (* 0, keyCode, state, 0 *)
EventButtonPressed* = 84; (* button, x, y, state *)
EventButtonReleased* = 85; (* button, x, y, state *)
(* mouse button 1-5 = Left, Middle, Right, Scroll wheel up, Scroll wheel down *)
bit64 = ORD(unix.BIT_DEPTH = 64);
TYPE EventPars* = ARRAY 5 OF INTEGER;
XEvent = RECORD
val :ARRAY 192 OF BYTE (* union { ..., long pad[24]; } *)
(* val :ARRAY 48 OF CARD32; *)
END;
VAR ScreenWidth*, ScreenHeight* :INTEGER;
winWidth*, winHeight* :INTEGER; (* draw by writing to pixel buffer: *)
base*, stride* :INTEGER; (* width, height, base ptr, stride in bytes, 32-bit RGB *)
painting :BOOLEAN;
libX11 :INTEGER; (* handle to dynamic library *)
XOpenDisplay :PROCEDURE [linux] (name :INTEGER) :INTEGER;
XCloseDisplay :PROCEDURE [linux] (display :INTEGER);
XSynchronize :PROCEDURE [linux] (display, onoff :INTEGER) :INTEGER; (* return prev onoff *)
XConnectionNumber :PROCEDURE [linux] (display :INTEGER) :INTEGER;
XCreateWindow :PROCEDURE [linux] (display, parent_window, x, y, w, h, border_width, depth,
class, visual, valuemask, attributes :INTEGER) :INTEGER; (* Window *)
XDefaultScreen :PROCEDURE [linux] (display :INTEGER) :INTEGER;
XDefaultGC :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER; (* GC *)
XDisplayWidth :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
XDisplayHeight :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
XDefaultVisual :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER; (* visual *)
XDefaultRootWindow :PROCEDURE [linux] (display :INTEGER) :INTEGER; (* Window *)
XDefaultDepth :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
XSelectInput :PROCEDURE [linux] (display, window, event_mask :INTEGER);
XMapWindow :PROCEDURE [linux] (display, window :INTEGER);
XNextEvent :PROCEDURE [linux] (display, XEvent_p :INTEGER);
XPending :PROCEDURE [linux] (display :INTEGER) :INTEGER;
XLookupString :PROCEDURE [linux] (key_event, buffer_return, buflen, keysym_return, status_in_out :INTEGER) :INTEGER;
XCreateImage :PROCEDURE [linux] (display, visual, depth, format, offset, data,
width, height, bitmap_pad, bytes_per_line :INTEGER) :INTEGER; (* ptr to XImage *)
XPutImage :PROCEDURE [linux] (display, window, gc, image, sx, sy, dx, dy, w, h :INTEGER);
display, screen, window, gc, img :INTEGER;
connectionNr :INTEGER; (* fd of X11 socket *)
readX11 :unix.fd_set; (* used by select() timeout on X11 socket *)
PROCEDURE getSymAdr (lib :INTEGER; name :ARRAY OF CHAR; adr :INTEGER);
VAR sym :INTEGER;
BEGIN
sym := unix.dlsym (lib, SYSTEM.ADR(name[0]));
IF sym = 0 THEN out.formatStr ("error: dlsym: %", name); out.nl END;
ASSERT (sym # 0);
SYSTEM.PUT (adr, sym)
END getSymAdr;
PROCEDURE init;
BEGIN
display := XOpenDisplay (0);
IF display = 0 THEN out.str ("error: can not open X11 display."); out.nl; out.exit(1) END;
(* ri := XSynchronize (display, 1); *)
connectionNr := XConnectionNumber (display); ASSERT (connectionNr < unix.FD_SETSIZE);
NEW (readX11); unix.FD_ZERO(readX11); unix.FD_SET (connectionNr, readX11);
screen := XDefaultScreen (display); gc := XDefaultGC (display, screen);
ScreenWidth := XDisplayWidth (display, screen); ScreenHeight := XDisplayHeight (display, screen);
base := unix.malloc (ScreenWidth * ScreenHeight * 4);
IF base = 0 THEN
out.formatInt2 ("error: can not allocate screen buffer % x %", ScreenWidth, ScreenHeight); out.nl; out.exit(1);
END;
stride := ScreenWidth * 4;
img := XCreateImage (display, XDefaultVisual (display, screen), XDefaultDepth (display, screen),
ZPixmap, 0, base, ScreenWidth, ScreenHeight, 32, 0);
END init;
PROCEDURE finish*;
VAR ri :INTEGER;
BEGIN
IF display # 0 THEN XCloseDisplay(display); display := 0 END;
IF libX11 # 0 THEN ri := unix.dlclose (libX11); libX11 := 0 END;
END finish;
PROCEDURE createWindow* (w, h :INTEGER);
VAR eventMask :INTEGER;
BEGIN
IF (w > ScreenWidth) OR (h > ScreenHeight) THEN
out.str ("error: X11.createWindow: window too large"); out.exit(1);
END;
ASSERT ((w >= 0) & (h >= 0));
window := XCreateWindow (display, XDefaultRootWindow (display), 0, 0, w, h, 0,
XDefaultDepth (display, screen), InputOutput, XDefaultVisual (display, screen), 0, 0);
winWidth := w; winHeight := h;
eventMask := StructureNotifyMask + ExposureMask + KeyPressMask + ButtonPressMask;
XSelectInput (display, window, eventMask);
XMapWindow (display, window);
END createWindow;
PROCEDURE screenBegin*;
(* intended to enable future cooperation with iOS / MacOS *)
BEGIN
ASSERT (~painting); painting := TRUE
END screenBegin;
PROCEDURE screenEnd*;
BEGIN
ASSERT (painting);
XPutImage (display, window, gc, img, 0, 0, 0, 0, winWidth, winHeight);
painting := FALSE;
END screenEnd;
PROCEDURE readInt (e :XEvent; i :INTEGER) :INTEGER;
(* treat XEvent byte array as int array *)
VAR n :INTEGER;
BEGIN
ASSERT (i >= 0);
ASSERT (i < 48);
i := i * 4;
n := e.val[i+3]*1000000H + e.val[i+2]*10000H + e.val[i+1]*100H + e.val[i];
RETURN n
END readInt;
PROCEDURE nextEvent* (msTimeOut :INTEGER; VAR ev :EventPars);
VAR _type, n, ri :INTEGER;
event :XEvent;
x, y, w, h :INTEGER;
timeout :unix.timespec;
BEGIN
(* struct XEvent (64-bit):
any: 4 type 8 serial 4 send_event 8 display 8 window 8 window
expose: 40 any 4 x, y, w, h, count
xconfigure: 48 any 4 x, y, w, h
xkey / xbutton / xmotion: 48 any 8 sub_window 8 time_ms 4 x, y, x_root, y_root 4 state 4 keycode/button
*)
(* struct XEvent (32-bit):
any: 4 type 4 serial 4 send_event 4 display 4 window
expose: 20 any 4 x, y, w, h, count
xconfigure: 24 any 4 x, y, w, h
xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root, y_root 4 state 4 keycode/button
*)
_type := 0;
WHILE _type = 0 DO
IF (msTimeOut > 0) & (XPending(display) = 0) THEN
timeout.tv_sec := msTimeOut DIV 1000; timeout.tv_usec := (msTimeOut MOD 1000) * 1000;
ri := unix.select (connectionNr + 1, readX11, NIL, NIL, timeout); ASSERT (ri # -1);
IF ri = 0 THEN _type := EventTimeOut; ev[1] := 0; ev[2] := 0; ev[3] := 0; ev[4] := 0 END;
END;
IF _type = 0 THEN
XNextEvent (display, SYSTEM.ADR(event));
CASE readInt (event, 0) OF
Expose :
x := readInt (event, 5 + 5 * bit64); y := readInt (event, 6 + 5 * bit64);
w := readInt (event, 7 + 5 * bit64); h := readInt (event, 8 + 5 * bit64);
XPutImage (display, window, gc, img, x, y, x, y, w, h);
| ConfigureNotify :
w := readInt (event, 8 + 6 * bit64); h := readInt (event, 9 + 6 * bit64);
IF (w # winWidth) & (h # winHeight) THEN
ASSERT ((w >= 0) & (h >= 0));
IF w > ScreenWidth THEN w := ScreenWidth END;
IF h > ScreenHeight THEN h := ScreenHeight END;
winWidth := w; winHeight := h;
ev[0] := EventResize; ev[1] := 0; ev[2] := w; ev[3] := h; ev[4] := 0;
END;
| KeyPress :
_type := EventKeyPressed;
x := XLookupString (SYSTEM.ADR(event), 0, 0, SYSTEM.ADR(n), 0); (* KeySym *)
IF (n = 8) OR (n = 10) OR (n >= 32) & (n <= 126) THEN ev[1] := 1 ELSE ev[1] := 0; n := 0 END; (* isprint *)
ev[2] := readInt (event, 13 + 8 * bit64); (* keycode *)
ev[3] := readInt (event, 12 + 8 * bit64); (* state *)
ev[4] := n; (* KeySym *)
| ButtonPress :
_type := EventButtonPressed;
ev[1] := readInt (event, 13 + 8 * bit64); (* button *)
ev[2] := readInt (event, 8 + 8 * bit64); (* x *)
ev[3] := readInt (event, 9 + 8 * bit64); (* y *)
ev[4] := readInt (event, 12 + 8 * bit64); (* state *)
ELSE
END
END
END;
ev[0] := _type
END nextEvent;
PROCEDURE clear* (color :INTEGER); (* fill window area with color *)
VAR p, i, j :INTEGER;
BEGIN
FOR j := 0 TO winHeight-1 DO
p := base + j*stride;
FOR i := 0 TO winWidth-1 DO SYSTEM.PUT32 (p, color); INC (p, 4) END
END
END clear;
(*
PROCEDURE blitError (stride, x, y, w, h :INTEGER);
BEGIN
o.formatInt ("error: screen.blit (src, %)", stride);
o.formatInt2 (", %, %", x, y);
o.formatInt2 (", %, %) out of bounds", w, h); o.nl;
ASSERT (FALSE)
END blitError;
PROCEDURE blit* (src, srcStride, x, y, w, h :INTEGER);
VAR dstStride, p :INTEGER;
BEGIN
IF (x < 0) OR (y < 0) THEN blitError (srcStride, x, y, w, h) END;
IF (w <= 0) OR (h <= 0) THEN blitError (srcStride, x, y, w, h) END;
IF (x + w > ScreenWidth) OR (y + h > ScreenHeight) THEN blitError (srcStride, x, y, w, h) END;
dstStride := ScreenWidth - w;
p := ScreenBase + y * ScreenWidth + x * 4;
REPEAT
SYSTEM.COPY (src, p, w);
INC (src, srcStride); INC (p, dstStride); DEC (h)
UNTIL h = 0
END blit;
*)
(*
PROCEDURE setPixel* (x, y, color :INTEGER);
VAR p :INTEGER;
BEGIN
ASSERT ((x >= 0) & (x < ScreenWidth) & (y >= 0) & (y < ScreenHeight));
screenBegin; p := base + (y*ScreenWidth + x)*4; SYSTEM.PUT32 (p, color); p := p + 4 screenEnd
END setPixel;
*)
(*
PROCEDURE loop; (* example main loop *)
VAR e :EventPars;
stop :BOOLEAN;
BEGIN
createWindow (200, 200);
stop := FALSE;
REPEAT
nextEvent (0, e);
IF e[0] = EventKeyPressed THEN stop := TRUE END;
UNTIL stop;
XCloseDisplay (display);
END loop;
*)
BEGIN
libX11 := unix.dlopen (SYSTEM.SADR("libX11.so.6"), unix.RTLD_LAZY); ASSERT (libX11 # 0);
getSymAdr (libX11, "XOpenDisplay", SYSTEM.ADR(XOpenDisplay));
getSymAdr (libX11, "XCloseDisplay", SYSTEM.ADR(XCloseDisplay));
getSymAdr (libX11, "XSynchronize", SYSTEM.ADR(XSynchronize));
getSymAdr (libX11, "XConnectionNumber", SYSTEM.ADR(XConnectionNumber));
getSymAdr (libX11, "XCreateWindow", SYSTEM.ADR(XCreateWindow));
getSymAdr (libX11, "XDefaultScreen", SYSTEM.ADR(XDefaultScreen));
getSymAdr (libX11, "XDefaultGC", SYSTEM.ADR(XDefaultGC));
getSymAdr (libX11, "XDisplayWidth", SYSTEM.ADR(XDisplayWidth));
getSymAdr (libX11, "XDisplayHeight", SYSTEM.ADR(XDisplayHeight));
getSymAdr (libX11, "XDefaultVisual", SYSTEM.ADR(XDefaultVisual));
getSymAdr (libX11, "XDefaultRootWindow", SYSTEM.ADR(XDefaultRootWindow));
getSymAdr (libX11, "XDefaultDepth", SYSTEM.ADR(XDefaultDepth));
getSymAdr (libX11, "XSelectInput", SYSTEM.ADR(XSelectInput));
getSymAdr (libX11, "XMapWindow", SYSTEM.ADR(XMapWindow));
getSymAdr (libX11, "XNextEvent", SYSTEM.ADR(XNextEvent));
getSymAdr (libX11, "XPending", SYSTEM.ADR(XPending));
getSymAdr (libX11, "XLookupString", SYSTEM.ADR(XLookupString));
getSymAdr (libX11, "XCreateImage", SYSTEM.ADR(XCreateImage));
getSymAdr (libX11, "XPutImage", SYSTEM.ADR(XPutImage));
init;
END gr.
samples/Linux/X11/filler/out.ob07
-142
View File
@@ -1,142 +0,0 @@
MODULE out; (* formatted output to stdout *)
(* Wim Niemann, Jan Tuitman 06-OCT-2016 *)
IMPORT SYSTEM, _unix;
(* example: IMPORT o:=out;
o.str("Hello, World!");o.nl;
o.formatInt("n = %", 3);o.nl;
*)
(*
The output functions buffer the characters in buf. This buffer is flushed when out.nl is
called and also when the buffer is full.
Calling flush once per line is far more efficient then one system call per
character, but this is noticable only at very long outputs.
*)
CONST MAX = 63; (* last position in buf *)
VAR len :INTEGER; (* string length in buf *)
buf :ARRAY MAX+1 OF BYTE;
PROCEDURE exit* (n :INTEGER);
(* prevent IMPORT unix for many programs *)
BEGIN _unix._exit(n) END exit;
PROCEDURE writeChars;
(* write buf to the output function and set to empty string *)
VAR ri :INTEGER;
BEGIN
IF len > 0 THEN
(* buf[len] := 0X; *)
ri := _unix._write (1, SYSTEM.ADR(buf), len); ASSERT (ri = len); (* stdout *)
len := 0
END
END writeChars;
PROCEDURE nl*; (* append a newline to buf and flush *)
BEGIN
IF len = MAX THEN writeChars END;
buf[len] := 0AH; INC(len);
(* unix: 0AX; Oberon: 0DX;
Windows: IF len >= MAX-1 THEN 0DX 0AX; *)
writeChars;
END nl;
PROCEDURE char* (c :CHAR);
(* append char to the end of buf *)
BEGIN
IF len = MAX THEN writeChars END;
buf[len] := ORD(c); INC(len)
END char;
PROCEDURE str* (t :ARRAY OF CHAR);
(* append t to buf *)
VAR j :INTEGER;
BEGIN
j := 0; WHILE t[j] # 0X DO char(t[j]); INC(j) END
END str;
PROCEDURE int* (n :INTEGER);
(* append integer; append n to d, return TRUE on overflow of d *)
VAR j :INTEGER;
sign :BOOLEAN;
dig :ARRAY 11 OF CHAR; (* assume 32 bit INTEGER *)
BEGIN
sign := FALSE; IF n < 0 THEN sign := TRUE; n := -n END;
IF n < 0 THEN
str ("-2147483648");
ELSE
j := 0;
REPEAT dig[j] := CHR (n MOD 10 + 30H); n := n DIV 10; INC(j) UNTIL n = 0;
IF sign THEN char ("-") END;
REPEAT DEC(j); char(dig[j]) UNTIL j = 0;
END
END int;
PROCEDURE formatInt* (t :ARRAY OF CHAR; n :INTEGER);
(* append formatted string t. Replace the first % by n *)
VAR j :INTEGER;
BEGIN
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
IF t[j] = "%" THEN
int(n); INC(j);
WHILE t[j] # 0X DO char(t[j]); INC(j) END
END
END formatInt;
PROCEDURE formatInt2* (t:ARRAY OF CHAR; n1, n2 :INTEGER);
(* append formatted string t. Replace the first two % by n1 and n2 *)
VAR j :INTEGER;
BEGIN
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
IF t[j] = "%" THEN
int(n1); INC(j);
WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
IF t[j] = "%" THEN
int(n2); INC(j);
WHILE t[j] # 0X DO char(t[j]); INC(j) END
END
END
END formatInt2;
PROCEDURE formatStr* (t, u :ARRAY OF CHAR);
(* append formatted string. Replace the first % in t by u *)
VAR j, k :INTEGER;
BEGIN
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
IF t[j] = "%" THEN
k := 0; WHILE u[k] # 0X DO char(u[k]); INC(k) END;
INC(j); WHILE t[j] # 0X DO char(t[j]); INC(j) END
END
END formatStr;
PROCEDURE hex* (n, width :INTEGER);
(* print width positions of n as hex string. If necessary, prefix with leading zeroes *)
(* note: if n needs more positions than width, the first hex digits are not printed *)
VAR j :INTEGER;
dig :ARRAY 9 OF CHAR;
BEGIN
ASSERT(width > 0);
ASSERT (width <= 8);
dig[width] := 0X;
REPEAT
j := n MOD 16; n := n DIV 16;
IF j < 10 THEN j := ORD("0") + j ELSE j := ORD("A") + j - 10 END;
DEC(width); dig[width] := CHR(j)
UNTIL width = 0;
str (dig);
END hex;
PROCEDURE flush*;
(* this routine comes at the end. It won't hardly ever be called
because nl also flushes. It is present only in case you
want to write a flushed string which does not end with nl. *)
BEGIN writeChars END flush;
(* note: global variable 'len' must be 0 on init. Within the core, bodies of imported modules
are not executed, so rely on zero initialisation by Modules.Load *)
END out.
samples/Linux/X11/filler/unix.ob07
-74
View File
@@ -1,74 +0,0 @@
MODULE unix; (* connect to unix host *)
IMPORT SYSTEM, _unix;
(* provide some Oberon friendly POSIX without need for SYSTEM *)
CONST RTLD_LAZY* = 1;
O_RDONLY* = 0;
O_NEWFILE* = 0C2H; (* O_RDWR | O_CREAT | O_EXCL *)
(* O_RDONLY=0, O_WRONLY=1, O_RDWR=2, O_CREAT=0x40, O_EXCL=0x80, O_TRUNC=0x200 *)
FD_SETSIZE* = 1024; (* fd for select() must be smaller than FD_SETSIZE *)
BIT_DEPTH* = _unix.BIT_DEPTH;
LEN_FD_SET = FD_SETSIZE DIV BIT_DEPTH;
TYPE
timespec* = RECORD
tv_sec*, tv_usec* :INTEGER
END;
fd_set* = POINTER TO RECORD (* for select() *)
bits* :ARRAY LEN_FD_SET OF SET (* 1024 bits *)
END;
VAR
dlopen* :PROCEDURE [linux] (name, flags :INTEGER) :INTEGER;
dlsym* :PROCEDURE [linux] (p, name :INTEGER) :INTEGER;
dlclose* :PROCEDURE [linux] (p :INTEGER) :INTEGER;
close* :PROCEDURE [linux] (fd :INTEGER) :INTEGER;
exit* :PROCEDURE [linux] (n :INTEGER);
malloc* :PROCEDURE [linux] (sz :INTEGER) :INTEGER;
PROCEDURE open* (path :ARRAY OF CHAR; flag, perm :INTEGER) :INTEGER;
BEGIN RETURN _unix._open (SYSTEM.ADR(path[0]), flag, perm) END open;
PROCEDURE read* (fd :INTEGER; VAR buf :ARRAY OF BYTE; len :INTEGER) :INTEGER;
BEGIN RETURN _unix._read (fd, SYSTEM.ADR(buf[0]), len) END read;
PROCEDURE readByte* (fd :INTEGER; VAR n :BYTE) :INTEGER;
BEGIN RETURN _unix._read (fd, SYSTEM.ADR(n), 1) END readByte;
PROCEDURE write* (fd :INTEGER; buf :ARRAY OF BYTE; len :INTEGER) :INTEGER;
BEGIN RETURN _unix._write (fd, SYSTEM.ADR(buf[0]), len) END write;
PROCEDURE writeByte* (fd :INTEGER; n :BYTE) :INTEGER;
BEGIN RETURN _unix._write (fd, SYSTEM.ADR(n), 1) END writeByte;
PROCEDURE FD_ZERO* (VAR selectSet :fd_set);
VAR i :INTEGER;
BEGIN FOR i := 0 TO LEN_FD_SET-1 DO selectSet.bits[i] := {} END END FD_ZERO;
PROCEDURE FD_SET* (fd :INTEGER; VAR selectSet :fd_set); (* set fd bit in a select() fd_set *)
BEGIN INCL(selectSet.bits[fd DIV BIT_DEPTH], fd MOD BIT_DEPTH)
END FD_SET;
PROCEDURE select* (cnt :INTEGER; readfds, writefds, exceptfds :fd_set; timeout :timespec) :INTEGER;
VAR n1, n2, n3 :INTEGER;
BEGIN
n1 := 0; IF readfds # NIL THEN n1 := SYSTEM.ADR (readfds.bits[0]) END;
n2 := 0; IF writefds # NIL THEN n2 := SYSTEM.ADR (writefds.bits[0]) END;
n3 := 0; IF exceptfds # NIL THEN n3 := SYSTEM.ADR (exceptfds.bits[0]) END;
RETURN _unix._select (cnt, n1, n2, n3, SYSTEM.ADR(timeout))
END select;
PROCEDURE finish*;
BEGIN _unix.finish; END finish;
BEGIN
dlopen := _unix._dlopen;
dlsym := _unix._dlsym;
dlclose := _unix._dlclose;
close := _unix._close;
exit := _unix._exit;
malloc := _unix._malloc;
END unix.