Skip to content

Commit 1b75e6c

Browse files
slackydevslackydev
committed
export socket and serial
1 parent bcef127 commit 1b75e6c

7 files changed

Lines changed: 562 additions & 14 deletions

File tree

‎compiler/imports/xpr.import.system.pas‎

Lines changed: 100 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@
99
interface
1010

1111
uses
12-
SysUtils, DateUtils, classes, xpr.Types, xpr.CompilerContext;
12+
SysUtils, DateUtils, classes, serial, sockets, xpr.Types, xpr.CompilerContext;
1313

1414
procedure ImportExternalMethods(ctx: TCompilerContext);
1515
procedure ImportSystemModules(ctx: TCompilerContext);
@@ -244,7 +244,7 @@ 'type TMemoryManager = record' + LineEnding +
244244
TCS.Name := 'TCriticalSection';
245245
ctx.AddManagedType(TCS);
246246
ctx.AddType('TCriticalSection', TCS);
247-
ctx.AddExternalMethod(@_CSInit, 'Init', TCS, [], [], TCS);
247+
ctx.AddExternalMethod(@_CSInit, 'Create', TCS, [], [], TCS);
248248
ctx.AddExternalMethod(@_CSDestroy, 'Destroy', TCS, [], [], nil);
249249
ctx.AddExternalMethod(@_CSLock, 'Lock', TCS, [], [], nil);
250250
ctx.AddExternalMethod(@_CSUnlock, 'Unlock', TCS, [], [], nil);
@@ -255,6 +255,104 @@ 'type TMemoryManager = record' + LineEnding +
255255
ctx.AddExternalFunc(@_FreeLib, 'FreeLib', [tInt], [pbCopy], nil);
256256
ctx.AddExternalFunc(@_GetProc, 'GetProc', [tInt, tString], [pbCopy, pbCopy], tInt);
257257
ctx.AddExternalFunc(@_FreeCallback, 'free_callback', [tInt], [pbCopy], nil);
258+
259+
260+
// --- Sockets & Serial -------------------
261+
ctx.ParseNativeDecls(
262+
// --- Types ---
263+
'type TSerialParity = enum(NoneParity, OddParity, EvenParity, MarkParity, SpaceParity)' + LineEnding +
264+
// --- Socket constants ---
265+
'const AF_INET: Int32 = 2' + LineEnding +
266+
'const AF_INET6: Int32 = 10' + LineEnding +
267+
'const AF_UNIX: Int32 = 1' + LineEnding +
268+
269+
'const SOCK_STREAM: Int32 = 1' + LineEnding +
270+
'const SOCK_DGRAM: Int32 = 2' + LineEnding +
271+
'const SOCK_RAW: Int32 = 3' + LineEnding +
272+
273+
'const IPPROTO_TCP: Int32 = 6' + LineEnding +
274+
'const IPPROTO_UDP: Int32 = 17' + LineEnding +
275+
276+
'const SOL_SOCKET: Int32 = 1' + LineEnding +
277+
278+
'const SO_REUSEADDR:Int32 = 2' + LineEnding +
279+
'const SO_KEEPALIVE:Int32 = 9' + LineEnding +
280+
'const SO_RCVBUF: Int32 = 8' + LineEnding +
281+
'const SO_SNDBUF: Int32 = 7' + LineEnding +
282+
'const SO_RCVTIMEO: Int32 = 20' + LineEnding +
283+
'const SO_SNDTIMEO: Int32 = 21' + LineEnding +
284+
285+
'const SHUT_RD: Int32 = 0' + LineEnding +
286+
'const SHUT_WR: Int32 = 1' + LineEnding +
287+
'const SHUT_RDWR: Int32 = 2' + LineEnding +
288+
289+
'const INADDR_ANY: Int32 = 0' + LineEnding +
290+
'const INADDR_LOOPBACK: Int32 = $7F000001' + LineEnding +
291+
'const INADDR_BROADCAST: Int32 = $FFFFFFFF' + LineEnding +
292+
293+
'const MSG_PEEK: Int32 = 2' + LineEnding +
294+
'const MSG_WAITALL: Int32 = 256' + LineEnding +
295+
'const MSG_DONTWAIT: Int32 = 64' + LineEnding +
296+
297+
// --- Sockets ---
298+
'func fpSocket(domain, typ, protocol: Int32): Int32' + LineEnding +
299+
'func fpConnect(sockfd: Int32; addr: Pointer; addrlen: Int32): Int32' + LineEnding +
300+
'func fpBind(sockfd: Int32; addr: Pointer; addrlen: Int32): Int32' + LineEnding +
301+
'func fpListen(sockfd: Int32; backlog: Int32): Int32' + LineEnding +
302+
'func fpAccept(sockfd: Int32; addr: Pointer; ref addrlen: Int32): Int32' + LineEnding +
303+
'func fpRecv(sockfd: Int32; buf: Pointer; len, flags: Int32): Int32' + LineEnding +
304+
'func fpRecvFrom(sockfd: Int32; buf: Pointer; len, flags: Int32; addr: Pointer; ref addrlen: Int32): Int32' + LineEnding +
305+
'func fpSend(sockfd: Int32; buf: Pointer; len, flags: Int32): Int32' + LineEnding +
306+
'func fpSendTo(sockfd: Int32; buf: Pointer; len, flags: Int32; addr: Pointer; addrlen: Int32): Int32' + LineEnding +
307+
'func fpClose(sockfd: Int32): Int32' + LineEnding +
308+
'func fpSetSockOpt(sockfd, level, optname: Int32; optval: Pointer; optlen: Int32): Int32' + LineEnding +
309+
'func fpGetSockOpt(sockfd, level, optname: Int32; optval: Pointer; ref optlen: Int32): Int32' + LineEnding +
310+
'func fpSelect(nfds: Int32; readfds, writefds, exceptfds: Pointer; timeout: Pointer): Int32' + LineEnding +
311+
'func fpShutdown(sockfd, how: Int32): Int32' + LineEnding +
312+
313+
// --- Byte order ---
314+
'func htons(v: UInt16): UInt16' + LineEnding +
315+
'func htonl(v: UInt32): UInt32' + LineEnding +
316+
'func ntohs(v: UInt16): UInt16' + LineEnding +
317+
'func ntohl(v: UInt32): UInt32' + LineEnding +
318+
319+
// --- Serial ---
320+
'func SerOpen(device: string): Int32' + LineEnding +
321+
'func SerClose(handle: Int32)' + LineEnding +
322+
'func SerSetParams(handle: Int32; baud, bits: Int32; parity: TSerialParity; stopBits: Int32; flags: Int32)' + LineEnding +
323+
'func SerRead(handle: Int32; buffer: Pointer; count: Int32): Int32' + LineEnding +
324+
'func SerWrite(handle: Int32; buffer: Pointer; count: Int32): Int32' + LineEnding +
325+
'func SerSync(handle: Int32)' + LineEnding +
326+
'func SerFlushOutput(handle: Int32)' + LineEnding,
327+
328+
[Bind('fpSocket', @_fpSocket),
329+
Bind('fpConnect', @_fpConnect),
330+
Bind('fpBind', @_fpBind),
331+
Bind('fpListen', @_fpListen),
332+
Bind('fpAccept', @_fpAccept),
333+
Bind('fpRecv', @_fpRecv),
334+
Bind('fpRecvFrom', @_fpRecvFrom),
335+
Bind('fpSend', @_fpSend),
336+
Bind('fpSendTo', @_fpSendTo),
337+
Bind('fpClose', @_fpClose),
338+
Bind('fpSetSockOpt', @_fpSetSockOpt),
339+
Bind('fpGetSockOpt', @_fpGetSockOpt),
340+
Bind('fpSelect', @_fpSelect),
341+
Bind('fpShutdown', @_fpShutdown),
342+
343+
Bind('htons', @_htons),
344+
Bind('htonl', @_htonl),
345+
Bind('ntohs', @_ntohs),
346+
Bind('ntohl', @_ntohl),
347+
348+
Bind('SerOpen', @_SerOpen),
349+
Bind('SerClose', @_SerClose),
350+
Bind('SerSetParams', @_SerSetParams),
351+
Bind('SerRead', @_SerRead),
352+
Bind('SerWrite', @_SerWrite),
353+
Bind('SerSync', @_SerSync),
354+
Bind('SerFlushOutput', @_SerFlushOutput)]
355+
);
258356
end;
259357

260358

‎compiler/imports/xpr.inc.import.system.inc‎

Lines changed: 222 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -529,3 +529,225 @@ begin
529529
FuncPtr := Pointer(Params^[0]^);
530530
XprUnregisterAndFreeClosure(FuncPtr);
531531
end;
532+
533+
534+
// ------------------------------
535+
// Sockets
536+
// ------------------------------
537+
538+
procedure _fpSocket(const Params: PParamArray; const Result: Pointer); cdecl;
539+
begin
540+
Int32(Result^) := fpSocket(
541+
Int32(Params^[0]^),
542+
Int32(Params^[1]^),
543+
Int32(Params^[2]^)
544+
);
545+
end;
546+
547+
procedure _fpConnect(const Params: PParamArray; const Result: Pointer); cdecl;
548+
begin
549+
Int32(Result^) := fpConnect(
550+
Int32(Params^[0]^),
551+
PSockAddr(Params^[1]^),
552+
Int32(Params^[2]^)
553+
);
554+
end;
555+
556+
procedure _fpBind(const Params: PParamArray; const Result: Pointer); cdecl;
557+
begin
558+
Int32(Result^) := fpBind(
559+
Int32(Params^[0]^),
560+
PSockAddr(Params^[1]^),
561+
Int32(Params^[2]^)
562+
);
563+
end;
564+
565+
procedure _fpListen(const Params: PParamArray; const Result: Pointer); cdecl;
566+
begin
567+
Int32(Result^) := fpListen(
568+
Int32(Params^[0]^),
569+
Int32(Params^[1]^)
570+
);
571+
end;
572+
573+
procedure _fpAccept(const Params: PParamArray; const Result: Pointer); cdecl;
574+
begin
575+
Int32(Result^) := fpAccept(
576+
Int32(Params^[0]^),
577+
PSockAddr(Params^[1]^),
578+
PInt32(Params^[2]^)
579+
);
580+
end;
581+
582+
procedure _fpRecv(const Params: PParamArray; const Result: Pointer); cdecl;
583+
begin
584+
Int32(Result^) := fpRecv(
585+
Int32(Params^[0]^),
586+
Pointer(Params^[1]^),
587+
Int32(Params^[2]^),
588+
Int32(Params^[3]^)
589+
);
590+
end;
591+
592+
procedure _fpRecvFrom(const Params: PParamArray; const Result: Pointer); cdecl;
593+
begin
594+
Int32(Result^) := fpRecvFrom(
595+
Int32(Params^[0]^),
596+
Pointer(Params^[1]^),
597+
Int32(Params^[2]^),
598+
Int32(Params^[3]^),
599+
PSockAddr(Params^[4]^),
600+
PInt32(Params^[5]^)
601+
);
602+
end;
603+
604+
procedure _fpSend(const Params: PParamArray; const Result: Pointer); cdecl;
605+
begin
606+
Int32(Result^) := fpSend(
607+
Int32(Params^[0]^),
608+
Pointer(Params^[1]^),
609+
Int32(Params^[2]^),
610+
Int32(Params^[3]^)
611+
);
612+
end;
613+
614+
procedure _fpSendTo(const Params: PParamArray; const Result: Pointer); cdecl;
615+
begin
616+
Int32(Result^) := fpSendTo(
617+
Int32(Params^[0]^),
618+
Pointer(Params^[1]^),
619+
Int32(Params^[2]^),
620+
Int32(Params^[3]^),
621+
PSockAddr(Params^[4]^),
622+
Int32(Params^[5]^)
623+
);
624+
end;
625+
626+
procedure _fpClose(const Params: PParamArray; const Result: Pointer); cdecl;
627+
begin
628+
Int32(Result^) := CloseSocket(Int32(Params^[0]^));
629+
end;
630+
631+
procedure _fpSetSockOpt(const Params: PParamArray; const Result: Pointer); cdecl;
632+
begin
633+
Int32(Result^) := fpSetSockOpt(
634+
Int32(Params^[0]^),
635+
Int32(Params^[1]^),
636+
Int32(Params^[2]^),
637+
Pointer(Params^[3]^),
638+
Int32(Params^[4]^)
639+
);
640+
end;
641+
642+
procedure _fpGetSockOpt(const Params: PParamArray; const Result: Pointer); cdecl;
643+
begin
644+
Int32(Result^) := fpGetSockOpt(
645+
Int32(Params^[0]^),
646+
Int32(Params^[1]^),
647+
Int32(Params^[2]^),
648+
Pointer(Params^[3]^),
649+
PInt32(Params^[4]^)
650+
);
651+
end;
652+
653+
procedure _fpSelect(const Params: PParamArray; const Result: Pointer); cdecl;
654+
begin
655+
(*
656+
Int32(Result^) := fpSelect(
657+
Int32(Params^[0]^),
658+
PFDSet(Params^[1]^),
659+
PFDSet(Params^[2]^),
660+
PFDSet(Params^[3]^),
661+
PTimeVal(Params^[4]^)
662+
);
663+
*)
664+
end;
665+
666+
procedure _fpShutdown(const Params: PParamArray; const Result: Pointer); cdecl;
667+
begin
668+
Int32(Result^) := fpShutdown(
669+
Int32(Params^[0]^),
670+
Int32(Params^[1]^)
671+
);
672+
end;
673+
674+
675+
// ------------------------------
676+
// Networking
677+
// ------------------------------
678+
679+
procedure _htons(const Params: PParamArray; const Result: Pointer); cdecl;
680+
begin
681+
UInt16(Result^) := htons(UInt16(Params^[0]^));
682+
end;
683+
684+
procedure _htonl(const Params: PParamArray; const Result: Pointer); cdecl;
685+
begin
686+
UInt32(Result^) := htonl(UInt32(Params^[0]^));
687+
end;
688+
689+
procedure _ntohs(const Params: PParamArray; const Result: Pointer); cdecl;
690+
begin
691+
UInt16(Result^) := ntohs(UInt16(Params^[0]^));
692+
end;
693+
694+
procedure _ntohl(const Params: PParamArray; const Result: Pointer); cdecl;
695+
begin
696+
UInt32(Result^) := ntohl(UInt32(Params^[0]^));
697+
end;
698+
699+
700+
701+
// ------------------------------
702+
// Serial
703+
// ------------------------------
704+
705+
procedure _SerOpen(const Params: PParamArray; const Result: Pointer); cdecl;
706+
begin
707+
Int32(Result^) := SerOpen(string(Params^[0]^));
708+
end;
709+
710+
procedure _SerClose(const Params: PParamArray); cdecl;
711+
begin
712+
SerClose(Int32(Params^[0]^));
713+
end;
714+
715+
procedure _SerSetParams(const Params: PParamArray; const Result: Pointer); cdecl;
716+
begin
717+
SerSetParams(
718+
TSerialHandle(Params^[0]^),
719+
Int32(Params^[1]^),
720+
Int32(Params^[2]^),
721+
TParityType(Params^[3]^),
722+
Int32(Params^[4]^),
723+
TSerialFlags(Params^[5]^)
724+
);
725+
end;
726+
727+
procedure _SerRead(const Params: PParamArray; const Result: Pointer); cdecl;
728+
begin
729+
Int32(Result^) := SerRead(
730+
Int32(Params^[0]^),
731+
PChar(Params^[1]^)^,
732+
Int32(Params^[2]^)
733+
);
734+
end;
735+
736+
procedure _SerWrite(const Params: PParamArray; const Result: Pointer); cdecl;
737+
begin
738+
Int32(Result^) := SerWrite(
739+
Int32(Params^[0]^),
740+
PChar(Params^[1]^)^,
741+
Int32(Params^[2]^)
742+
);
743+
end;
744+
745+
procedure _SerSync(const Params: PParamArray); cdecl;
746+
begin
747+
SerSync(Int32(Params^[0]^));
748+
end;
749+
750+
procedure _SerFlushOutput(const Params: PParamArray); cdecl;
751+
begin
752+
SerFlushOutput(Int32(Params^[0]^));
753+
end;

‎compiler/xpr.parser.pas‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -961,9 +961,9 @@ function TParser.ParseIf(): XTree_If;
961961
if Current.Token = tkKW_ELIF then
962962
begin
963963
Next(); // consume 'elif'
964-
Consume(tkLPARENTHESES);
964+
//Consume(tkLPARENTHESES);
965965
Condition := ParseExpression(False);
966-
Consume(tkRPARENTHESES);
966+
//Consume(tkRPARENTHESES);
967967
consume(tkKW_THEN); // enforce structure
968968
Bodys.Add(ParseBody());
969969
Conditions.Add(Condition);

‎examples/serial.xpr‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
import 'system/serial.xpr' as *
2+
3+
var ser := new TSerial('COM4', 115200)
4+
5+
// sync
6+
print ser.ReadLine()
7+
8+
// async for 10 seconds
9+
ser.OnLine := lambda(line: string)
10+
print line
11+
12+
ser.Start()
13+
Sleep(10000);
14+
ser.Stop()

0 commit comments

Comments
 (0)