vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 15:42:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Update test files to v2.

Browse source
This commit is contained in:
David Brown 2016-06-16 16:25:36 +01:00
parent a9b273e30a
commit ce855c93c8
6 changed files with 212 additions and 241 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/test/files/testFiles.Mod
View file

@ -20,8 +20,9 @@ IF F # NIL THEN
Texts.Read (R, ch); Texts.Read (R, ch);
WHILE ~R.eot DO WHILE ~R.eot DO
Texts.Read (R, ch);
Console.Char(ch); Console.Char(ch);
IF ch = 0DX THEN Console.Char(0AX) END;
Texts.Read (R, ch);
END; END;
ELSE ELSE

158
src/test/server/s.Mod
View file

@ -1,106 +1,90 @@
MODULE s; MODULE s;
IMPORT sockets, types, Out := Console, Unix, S := SYSTEM; IMPORT sockets, types, Out := Console, SYSTEM, Platform, Strings;
TYPE Int32 = types.Int32;
Int16 = types.Int16;
String = types.String;
PROCEDURE DoSmth(sock : Int32); PROCEDURE DoSmth(sock: Platform.FileHandle);
VAR str, aff : String; VAR
n, s : LONGINT; str, aff: ARRAY 256 OF CHAR;
n: LONGINT;
BEGIN BEGIN
s := SIZE(String); aff := "Affirmative, Dave";
aff := "Affirmative, Dave"; (* IF Platform.Read(sock, SYSTEM.ADR(str), 256, n) # 0 THEN *)
n := Unix.Read(sock, S.ADR(str), s); IF Platform.ReadBuf(sock, str, n) # 0 THEN
Out.String("error reading from socket"); Out.Ln;
ELSE
str[n] := 0X; (* Make sure that received message is zero terminated *)
Out.String("received message is "); Out.String(str); Out.Ln;
IF n < 0 THEN IF Platform.Write(sock, SYSTEM.ADR(aff), Strings.Length(aff)) # 0 THEN
Out.String("error reading from socket"); Out.Ln;
END;
Out.String("received message is "); Out.String(str); Out.Ln;
s := 17;
n := Unix.Write(sock, S.ADR(aff), s);
IF n < 2 THEN
Out.String("error writing to socket"); Out.Ln Out.String("error writing to socket"); Out.Ln
END; END;
END;
END DoSmth; END DoSmth;
PROCEDURE ZeroByteArr(VAR a : ARRAY OF S.BYTE);
VAR i : LONGINT;
BEGIN PROCEDURE -includeunistd "#include <unistd.h>";
FOR i := 0 TO LEN(a)-1 DO PROCEDURE -fork(): LONGINT "(LONGINT)fork()";
a[i] := 0
END;
END ZeroByteArr;
PROCEDURE serve; PROCEDURE serve;
VAR sockfd, newsockfd, portno, clilen, pid: sockets.Int32; CONST
ServAddr, CliAddr: sockets.SockAddrIn; Port = 2055;
Null : Int32; MaxQueue = 5;
Port, maxQueue, res : Int32; VAR
afinet, port, port0: Int16; sockfd: LONGINT;
newsockfd: LONGINT;
ServAddr: sockets.SockAddrIn;
pid: LONGINT;
res: Platform.ErrorCode;
sockaddrlen: LONGINT;
BEGIN BEGIN
Port := 2055; sockfd := sockets.Socket(sockets.AfInet, sockets.SockStream, 0);
maxQueue := 5; IF sockfd < 0 THEN
Null := 0; Out.String("error opening socket")
sockfd := sockets.Socket(S.VAL(Int32, sockets.AfInet), S.VAL(Int32, sockets.SockStream), Null); ELSE
IF sockfd < 0 THEN Out.String("socket created.")
Out.String("error opening socket") END;
ELSE Out.Ln;
Out.String("socket created.")
END;
Out.Ln;
types.IntegerToInt16(sockets.AfInet, afinet); sockets.SetSockAddrIn(sockets.AfInet, Port, 0, ServAddr);
types.IntegerToInt16(Port, port); IF sockets.Bind(sockfd, SYSTEM.VAL(sockets.SockAddr, ServAddr), SIZE(sockets.SockAddr)) < 0 THEN
types.htons(port, port0); (* only necessary on little endian computers *) Out.String("error on binding")
ServAddr.SinFamily := afinet; ELSE
ServAddr.SinPort := port0; Out.String("binding completed.")
ZeroByteArr(ServAddr.SinZero); END;
(*Out.String("listening on port ");Out.Int(S.VAL(INTEGER, ServAddr.SinPort), 0); Out.Ln;*) Out.Ln;
ServAddr.SinAddr.SAddr := 0(*sockets.InAddrAny*);
res := sockets.Bind(sockfd, S.VAL(sockets.SockAddr, ServAddr), (SIZE(sockets.SockAddr))); IF sockets.Listen(sockfd, MaxQueue) # 0 THEN
IF res < 0 THEN Out.String("listen() failed");
Out.String("error on binding") ELSE
ELSE Out.String("listen okay");
Out.String("binding completed.") END;
END; Out.Ln;
Out.Ln;
res := sockets.Listen(sockfd, maxQueue);
IF res # 0 THEN
Out.String("listen() failed");
ELSE
Out.String("listen okay");
END;
Out.Ln;
clilen := SIZE(sockets.SockAddrIn);
LOOP
newsockfd := sockets.Accept(sockfd, S.VAL(sockets.SockAddr, ServAddr), clilen);
IF newsockfd < 0 THEN
Out.String("error on accept")
ELSE
Out.String("accept okay")
END;
Out.Ln;
pid := Unix.Fork();
IF pid < 0 THEN
Out.String("error on fork")
ELSIF pid = 0 THEN
Out.String("forked okay"); Out.Ln;
res := Unix.Close(sockfd);
DoSmth(newsockfd);
EXIT
ELSE
res := Unix.Close(newsockfd);
END;
END;
LOOP
sockaddrlen := SIZE(sockets.SockAddrIn);
newsockfd := sockets.Accept(sockfd, SYSTEM.VAL(sockets.SockAddr, ServAddr), sockaddrlen);
IF newsockfd < 0 THEN
Out.String("error on accept")
ELSE
Out.String("accept okay")
END;
Out.Ln;
pid := fork();
IF pid < 0 THEN
Out.String("error on fork")
ELSIF pid = 0 THEN
Out.String("forked okay"); Out.Ln;
res := Platform.Close(sockfd);
DoSmth(newsockfd);
EXIT
ELSE
res := Platform.Close(newsockfd)
END
END
END serve; END serve;

177
src/test/server/sockets.Mod
View file

@ -1,119 +1,126 @@
MODULE sockets; MODULE sockets;
IMPORT types, SYS := SYSTEM;
TYPE IMPORT SYSTEM, oocC;
Int16* = types.Int16; (* INTEGER on 32 bit platform *)
Int32* = types.Int32;
Int64* = types.Int64;
CONST CONST
SockStream* = 1; SockStream* = 1;
SockDgram* = 2; SockDgram* = 2;
SockRaw* = 3; SockRaw* = 3;
SockRdm* = 4; SockRdm* = 4;
SockSeqpacket* = 5; SockSeqpacket* = 5;
SockDccp* = 6; SockDccp* = 6;
SockPacket* = 10; SockPacket* = 10;
AfUnscec* = 0; (* Unspecified. *) AfUnscec* = 0; (* Unspecified. *)
AfLocal* = 1; (* Local to host (pipes and file-domain). *) AfLocal* = 1; (* Local to host (pipes and file-domain). *)
AfUnix* = 1; (* POSIX name for PF_LOCAL. *) AfUnix* = 1; (* POSIX name for PF_LOCAL. *)
AfFile* = 1; (* Another non-standard name for PF_LOCAL. *) AfFile* = 1; (* Another non-standard name for PF_LOCAL. *)
AfInet* = 2; (* IP protocol family. *) AfInet* = 2; (* IP protocol family. *)
AfAx25* = 3; (* Amateur Radio AX.25. *) AfAx25* = 3; (* Amateur Radio AX.25. *)
AfIpx* = 4; (* Novell Internet Protocol. *) AfIpx* = 4; (* Novell Internet Protocol. *)
AfAppletalk* = 5; (* Appletalk DDP. *) AfAppletalk* = 5; (* Appletalk DDP. *)
AfNetrom* = 6; (* Amateur radio NetROM. *) AfNetrom* = 6; (* Amateur radio NetROM. *)
AfBridge* = 7; (* Multiprotocol bridge. *) AfBridge* = 7; (* Multiprotocol bridge. *)
AfAtmpvc* = 8; (* ATM PVCs. *) AfAtmpvc* = 8; (* ATM PVCs. *)
AfX25* = 9; (* Reserved for X.25 project. *) AfX25* = 9; (* Reserved for X.25 project. *)
AfInet6* = 10; (* IP version 6. *) AfInet6* = 10; (* IP version 6. *)
AfRose* = 11; (* Amateur Radio X.25 PLP. *) AfRose* = 11; (* Amateur Radio X.25 PLP. *)
AfDecnet* = 12; (* Reserved for DECnet project. *) AfDecnet* = 12; (* Reserved for DECnet project. *)
AfNetbeui*= 13; (* Reserved for 802.2LLC project. *) AfNetbeui* = 13; (* Reserved for 802.2LLC project. *)
AfSecurity*=14; (* Security callback pseudo AF. *) AfSecurity* = 14; (* Security callback pseudo AF. *)
AfKey* = 15; (* PF_KEY key management API. *) AfKey* = 15; (* PF_KEY key management API. *)
AfNetlink*= 16; AfNetlink* = 16;
AfRoute* = 16; (* Alias to emulate 4.4BSD. *) AfRoute* = 16; (* Alias to emulate 4.4BSD. *)
AfPacket = 17; (* Packet family. *) AfPacket = 17; (* Packet family. *)
AfAsh = 18; (* Ash. *) AfAsh = 18; (* Ash. *)
AfEconet* = 19; (* Acorn Econet. *) AfEconet* = 19; (* Acorn Econet. *)
AfAtmsvc* = 20; (* ATM SVCs. *) AfAtmsvc* = 20; (* ATM SVCs. *)
AfRds* = 21; (* RDS sockets. *) AfRds* = 21; (* RDS sockets. *)
AfSna = 22; (* Linux SNA Project *) AfSna = 22; (* Linux SNA Project *)
AfIrda* = 23; (* IRDA sockets. *) AfIrda* = 23; (* IRDA sockets. *)
AfPppox = 24; (* PPPoX sockets. *) AfPppox = 24; (* PPPoX sockets. *)
AfWanpipe*= 25; (* Wanpipe API sockets. *) AfWanpipe* = 25; (* Wanpipe API sockets. *)
AfLlc* = 26; (* Linux LLC. *) AfLlc* = 26; (* Linux LLC. *)
AfCan* = 29; (* Controller Area Network. *) AfCan* = 29; (* Controller Area Network. *)
AfTipc* = 30; (* TIPC sockets. *) AfTipc* = 30; (* TIPC sockets. *)
AfBluetooth* = 31; (* Bluetooth sockets. *) AfBluetooth* = 31; (* Bluetooth sockets. *)
AfIucv* = 32; (* IUCV sockets. *) AfIucv* = 32; (* IUCV sockets. *)
AfRxrpc* = 33; (* RxRPC sockets. *) AfRxrpc* = 33; (* RxRPC sockets. *)
AfIsdn* = 34; (* mISDN sockets. *) AfIsdn* = 34; (* mISDN sockets. *)
AfPhonet* = 35; (* Phonet sockets. *) AfPhonet* = 35; (* Phonet sockets. *)
AfIeee802154* = 36; (* IEEE 802.15.4 sockets. *) AfIeee802154* = 36; (* IEEE 802.15.4 sockets. *)
AfCaif* = 37; (* CAIF sockets. *) AfCaif* = 37; (* CAIF sockets. *)
AfAlg* = 38; (* Algorithm sockets. *) AfAlg* = 38; (* Algorithm sockets. *)
AfNfc* = 39; (* NFC sockets. *) AfNfc* = 39; (* NFC sockets. *)
AfVsock* = 40; (* vSockets. *) AfVsock* = 40; (* vSockets. *)
AfMax* = 41; (* For now.. *) AfMax* = 41; (* For now.. *)
InAddrAny* = 0; InAddrAny* = 0;
TYPE TYPE
(* /usr/include/netinet/in.h *) (* /usr/include/netinet/in.h *)
InAddr* = RECORD InAddr* = RECORD
SAddr* : Int32; SAddr*: oocC.int;
END; END;
SockAddrIn* = RECORD SockAddrIn* = RECORD
SinFamily* : Int16; SinFamily*: oocC.shortint;
SinPort* : Int16; SinPort*: oocC.shortint;
SinAddr* : InAddr; SinAddr*: InAddr;
SinZero* : ARRAY 8 OF CHAR; SinZero*: ARRAY 8 OF CHAR;
END; END;
(* /usr/include/sys/socket.h *) (* /usr/include/sys/socket.h *)
SockAddr* = RECORD SockAddr* = RECORD
SaFamily* : Int16; SaFamily*: oocC.shortint;
SaData* : ARRAY 14 OF CHAR SaData*: ARRAY 14 OF CHAR
END; END;
PROCEDURE -socket(domain, type, protocol: Int32): Int32 PROCEDURE -includesocket "#include <sys/socket.h>";
"(int)socket(domain, type, protocol)";
PROCEDURE Socket*(domain, type, protocol: Int32): Int32; PROCEDURE -SetCShort(i: INTEGER; VAR si: oocC.shortint)
"*(short*)si = i";
PROCEDURE -SetCShortSwapped(i: INTEGER; VAR si: oocC.shortint)
"*(short*)si = ((i >> 8) & 0x00ff) | ((i << 8) & 0xff00)";
PROCEDURE SetSockAddrIn*(family, port, inaddr: INTEGER; VAR sai: SockAddrIn);
VAR i: INTEGER;
BEGIN BEGIN
RETURN socket(domain, type, protocol) SetCShort(family, sai.SinFamily);
SetCShortSwapped(port, sai.SinPort);
sai.SinAddr.SAddr := inaddr;
i := 0; WHILE i < 8 DO sai.SinZero[i] := 0X; INC(i) END
END SetSockAddrIn;
PROCEDURE -socket(domain, type, protocol: LONGINT): INTEGER
"(INTEGER)socket((int)domain, (int)type, (int)protocol)";
PROCEDURE Socket*(domain, type, protocol: LONGINT): INTEGER;
BEGIN RETURN socket(domain, type, protocol)
END Socket; END Socket;
PROCEDURE -bind(sockfd: Int32; VAR addr: SockAddr; addrlen: Int32): Int32 PROCEDURE -bind(sockfd: LONGINT; VAR addr: SockAddr; addrlen: LONGINT): INTEGER
"(int)bind(sockfd, addr, addrlen)"; "(INTEGER)bind((int)sockfd, (const struct sockaddr*)addr, (int)addrlen)";
PROCEDURE Bind*(sockfd: Int32; VAR addr: SockAddr; addrlen: Int32): Int32; PROCEDURE Bind*(sockfd: LONGINT; VAR addr: SockAddr; addrlen: LONGINT): INTEGER;
BEGIN BEGIN RETURN bind(sockfd, addr, addrlen)
RETURN bind(sockfd, addr, addrlen)
END Bind; END Bind;
PROCEDURE -listen(sockfd, backlog: Int32): Int32 PROCEDURE -listen(sockfd, backlog: LONGINT): INTEGER
"(int)listen(sockfd, backlog)"; "(INTEGER)listen((int)sockfd, (int)backlog)";
PROCEDURE Listen*(sockfd, backlog: Int32): Int32; PROCEDURE Listen*(sockfd, backlog: LONGINT): INTEGER;
BEGIN BEGIN RETURN listen(sockfd, backlog)
RETURN listen(sockfd, backlog)
END Listen; END Listen;
PROCEDURE -accept(sockfd: Int32; VAR addr: SockAddr; VAR addrlen: Int32): Int32 PROCEDURE -accept(sockfd: LONGINT; VAR addr: SockAddr; VAR addrlen: LONGINT; VAR result: INTEGER)
"(int)accept(sockfd, addr, addrlen)"; "int _o_al = (int)addrlen; *result = (INTEGER)accept((int)sockfd, (struct sockaddr*)addr, &_o_al); *addrlen = _o_al";
PROCEDURE Accept*(sockfd: Int32; VAR addr: SockAddr; VAR addrlen: Int32): Int32; PROCEDURE Accept*(sockfd: LONGINT; VAR addr: SockAddr; VAR addrlen: LONGINT): INTEGER;
BEGIN VAR result: INTEGER;
RETURN accept(sockfd, addr, addrlen) BEGIN accept(sockfd, addr, addrlen, result); RETURN result
END Accept; END Accept;
BEGIN
END sockets. END sockets.

47
src/test/server/types.Mod
View file

@ -1,38 +1,25 @@
MODULE types; MODULE types;
IMPORT SYS := SYSTEM;
IMPORT SYSTEM;
TYPE TYPE
intarr64 = ARRAY 8 OF SYS.BYTE; (* to emulate int16 on x86_64; -- noch *) (* Int32* = ARRAY 4 OF SYSTEM.BYTE; *)
intarr32 = ARRAY 4 OF SYS.BYTE; Int16* = ARRAY 2 OF SYSTEM.BYTE;
intarr16 = ARRAY 2 OF SYS.BYTE;
Int16* = intarr16; (* INTEGER on 32 bit platform *)
Int32* = INTEGER;
Int64* = LONGINT;
String* = ARRAY 256 OF CHAR;
PROCEDURE LongintToInt16*(int: LONGINT; VAR int16: Int16); PROCEDURE IntegerToInt16*(int: INTEGER; VAR int16: Int16);
VAR longintarr : intarr64; TYPE PInt16 = POINTER TO Int16;
BEGIN VAR p: PInt16;
(*RETURN SYS.VAL(Int16, int)*) BEGIN
longintarr := SYS.VAL(intarr64, int); (* Note: We take the least significant 16 bits of int, which
int16[0] := longintarr[0]; is correct on supported (i.e. little-endian) architectures. *)
int16[1] := longintarr[1]; (* this will work for little endian -- noch *) p := SYSTEM.VAL(PInt16, SYSTEM.ADR(int));
END LongintToInt16; int16 := p^;
END IntegerToInt16;
PROCEDURE IntegerToInt16*(int: INTEGER; VAR int16: Int16); PROCEDURE htons*(in: Int16; VAR out : Int16);
VAR intarr : intarr32; BEGIN
BEGIN out[0] := in[1];
int16 := SYS.VAL(Int16, int) out[1] := in[0];
(*intarr := SYS.VAL(intarr32, int); END htons;
int16[0] := intarr[0];
int16[1] := intarr[1];*) (* this will work for little endian -- noch *)
END IntegerToInt16;
PROCEDURE htons*(in: Int16; VAR out : Int16);
BEGIN
out[0] := in[1];
out[1] := in[0];
END htons;
END types. END types.

16
src/test/vt100/crt.Mod
View file

@ -1,6 +1,6 @@
MODULE crt; MODULE crt;
IMPORT vt100, Unix, Console, IMPORT vt100, Platform, Console,
Strings; (* strings to remove later ? *) Strings; (* strings to remove later ? *)
CONST CONST
@ -28,8 +28,6 @@ CONST
(* Add-in for blinking *) (* Add-in for blinking *)
Blink* = 128; Blink* = 128;
TYPE
PFdSet = POINTER TO Unix.FdSet;
VAR tmpstr : ARRAY 23 OF CHAR; VAR tmpstr : ARRAY 23 OF CHAR;
@ -58,16 +56,8 @@ VAR tmpstr : ARRAY 23 OF CHAR;
vt100.DECTCEMh; vt100.DECTCEMh;
END cursoron; END cursoron;
PROCEDURE Delay*( ms : INTEGER); PROCEDURE Delay*(ms: INTEGER);
VAR i : LONGINT; BEGIN Platform.Delay(ms) END Delay;
tv : Unix.Timeval;
pfd : PFdSet;
BEGIN
tv.sec := 0;
tv.usec := ms * 1000;
pfd := NIL;
i := Unix.Select(0, pfd^, pfd^, pfd^, tv);
END Delay;
PROCEDURE GotoXY* (x, y: INTEGER); PROCEDURE GotoXY* (x, y: INTEGER);
BEGIN BEGIN

40
src/test/x11/0/test.Mod
View file

@ -1,29 +1,31 @@
MODULE test; MODULE test;
IMPORT p := oocXYplane, Out := Console; IMPORT p := oocXYplane, Out := Console;
VAR ch : CHAR;
i : INTEGER; VAR
ch : CHAR;
i : INTEGER;
BEGIN BEGIN
p.Open;
p.Open; (*p.Clear;*)
FOR i := 1 TO 555 DO
p.Dot(i,300 ,p.draw)
END;
(*p.Clear;*) (*
FOR i := 1 TO 555 DO FOR i := 100 TO 500 DO
p.Dot(i,300 ,p.draw) p.Dot(i,300 ,p.erase)
END; END;
(* *)
FOR i := 100 TO 500 DO
p.Dot(i,300 ,p.erase)
END;
*)
IF p.IsDot (5, 300) THEN Out.String("Yes") ELSE Out.String("No") END; Out.Ln; IF p.IsDot (5, 300) THEN Out.String("Yes") ELSE Out.String("No") END; Out.Ln;
IF p.IsDot (5, 500) THEN Out.String("Yes") ELSE Out.String("No") END; Out.Ln; IF p.IsDot (5, 500) THEN Out.String("Yes") ELSE Out.String("No") END; Out.Ln;
REPEAT REPEAT
ch := p.Key(); ch := p.Key();
UNTIL ch # 0X; UNTIL ch # 0X;
p.Close;
p.Close;
END test. END test.