Mike 2 months ago
parent
commit
c4d423ce9a
8 changed files with 81 additions and 24 deletions
  1. +8
    -3
      src/defs.l
  2. +7
    -1
      src/glob.l
  3. +28
    -10
      src/io.l
  4. +23
    -1
      src/lib.c
  5. +11
    -6
      src/lib/llvm.l
  6. BIN
      src/main.bc
  7. +2
    -2
      src/main.l
  8. +2
    -1
      src/pico.h

+ 8
- 3
src/defs.l View File

@@ -1,4 +1,4 @@
# 06nov19 Software Lab. Alexander Burger
# 11nov19 Software Lab. Alexander Burger

# Constants
(compile) (HEAP CELLS STACK TOP DB1 inFile outFile)
@@ -82,14 +82,19 @@ strrchr memcpy dlerror kill exit)
(de T NIL exit (i32))

# Glue lib.c
(compile) (stderrMsg strErrno fcntlCloExec fcntlSetFl nonBlocking xSignal xErrno
dlOpen ffiPrep ffiCall)
(compile) (stderrMsg strErrno fcntlCloExec fcntlSetFl nonBlocking pollIn
pollOut xPoll pollInRdy pollOutRdy xSignal xErrno dlOpen ffiPrep ffiCall)

(de T void stderrMsg (i8*))
(de T i8* strErrno ())
(de T i32 fcntlCloExec (i32))
(de T i32 fcntlSetFl (i32 i32))
(de T i32 nonBlocking (i32))
(de T void pollIn (i32 i64*))
(de T void pollOut (i32 i64*))
(de T i32 xPoll (i64* i64 i64))
(de T i32 pollInRdy (i64*))
(de T i32 pollOutRdy (i64*))
(de T i32 xSignal (i32))
(de T i32 xErrno ())


+ 7
- 1
src/glob.l View File

@@ -1,4 +1,4 @@
# 08nov19 Software Lab. Alexander Burger
# 10nov19 Software Lab. Alexander Burger

(compile) ()

@@ -156,6 +156,12 @@
($CtlFrames 0) # Control frames
($Intern $Pico1) # Current namespaces of internal symbols
($Next $Nil) # Next vararg
($Cls 0) # Method class
($Key 0) # Method key
($Apply 0) # Apply frames
($Make 0) # 'make' env
($Yoke 0)
($Task $Nil) # Task list
($Protect 0) # Signal protection
($Trace 0) ) # Trace level


+ 28
- 10
src/io.l View File

@@ -1,9 +1,9 @@
# 10nov19 Software Lab. Alexander Burger
# 11nov19 Software Lab. Alexander Burger

(compile) (openErr closeErr eofErr badInput closeOnExec initInFile initOutFile
closeInFile closeOutFile slow slowNb stdinByte waitFd _getStdin getChar skipC
comment skip testEsc anonymous rdAtom rdList read0 read1 _putStdout newline
space outWord outNum outString print load)
space outWord outNum outString print repl)

(de NIL openErr ()
(err 0 0 ($ "%s open: %s") (strErrno)) )
@@ -118,14 +118,32 @@ space outWord outNum outString print load)
(de i32 stdinByte ()
(getchar) )

(de i1 inReady ((i32 . Fd))
(and
(> (val $InFDs) Fd)
(let F (inFile (val (ofs (val $InFiles) Fd)))
(and (n0 (F)) (> (F cnt) (F ix))) ) ) )

(de i64 waitFd (Exe (i32 . Fd) (i64 . Ms))
(loop T
(let
(S (stack)
P (b64 (+ (+ (length (val $Run)) (val $Children)) 3)) )
#! ...
(stack S) )
(? (=0 Fd) 0) ) )
(let (Task (val $Task) P (link (push (val $At) ZERO NIL)))
(loop T
(let
(S (stack)
P (b64 (+ (+ (length (val $Run)) (val $Children)) 3))
I 0
M Ms )
(when (ge0 Fd)
(if (inReady Fd)
(setq M 0)
(pollIn Fd (ofs P I))
(inc 'I) ) )
#! ...
#! (xPoll P I M)
#! ...
(stack S) )
(? (=0 Fd) 0) )
(set $At (pop P) $Task Task)
Ms ) )

(de i32 _getStdin ()
(let F (inFile (val $InFile))
@@ -459,7 +477,7 @@ space outWord outNum outString print load)
(space) )
(call $Put (char ")")) ) ) )

(de load (Exe (i32 . Pr) X)
(de repl (Exe (i32 . Pr) X)
(setq X $Nil)
(loop
(when (and (n0 Pr) (=0 (val $Chr)))

+ 23
- 1
src/lib.c View File

@@ -1,4 +1,4 @@
// 06nov19 Software Lab. Alexander Burger
// 11nov19 Software Lab. Alexander Burger

#include "pico.h"

@@ -26,6 +26,28 @@ int32_t nonBlocking(int32_t fd) {
return flg;
}

void pollIn(int32_t fd, struct pollfd *p) {
p->fd = fd;
p->events = POLLIN;
}

void pollOut(int32_t fd, struct pollfd *p) {
p->fd = fd;
p->events = POLLOUT;
}

int xPoll(struct pollfd *fds, int64_t nfds, int64_t timeout) {
return poll(fds, (nfds_t)nfds, (int)timeout);
}

int pollInRdy(struct pollfd *p) {
return p->revents & POLLIN;
}

int pollOutRdy(struct pollfd *p) {
return p->revents & POLLOUT;
}

// Sync src/defs.l 'ENOENT' and src/glob.l '$Signal'
int32_t xSignal(int32_t n) {
switch (n) {

+ 11
- 6
src/lib/llvm.l View File

@@ -1,9 +1,10 @@
# 10nov19 Software Lab. Alexander Burger
# 11nov19 Software Lab. Alexander Burger

(de compile ()
(symbols '(llvm pico))
(symbols '(llvm))
(local) )


## PicoLisp LLVM frontend ##
(symbols 'llvm 'pico)

@@ -11,6 +12,8 @@
any YES NO ZERO ONE begin end $ ? short global var str const globals array table
symTab inline define struct $Nil)

(import pico symbols T NIL @ @@ compile load setq prog */ >> char hex)

(def 'void 'void)
(def 'null 'null)

@@ -24,10 +27,10 @@ symTab inline define struct $Nil)
(symbols 'cc 'llvm 'pico)

(local) (*Strings *Ssa *Lbl *Curr *? *Exit *Bind *Phi *Ret log asm ssa phi +phi
br label +lbl +bind type func ptr pointee store A B C I L N P V X Y Exe Prg Prg2
Bnd2 Typ Sym Ret Args Ext Body Var Val Lst Lbl Flg Skip True False Beg End)
br label +lbl +bind type func ptr pointee store A B C I L M N P V X Y Exe Prg
Prg2 Bnd2 Typ Sym Ret Args Ext Body Var Val Lst Lbl Flg Skip True False Beg End)

(import llvm~any pico~inc pico~dec pico~++ #{pico~>>>}#)
(import any inc dec ++ #{>>>}# show bt)


# Generate LLVM-IR
@@ -129,7 +132,7 @@ Bnd2 Typ Sym Ret Args Ext Body Var Val Lst Lbl Flg Skip True False Beg End)
(== 'quote (caadr X))
(== Var (cdadr X)) )
(and
(memq (car X) '(setq llvm~++ llvm~>>>))
(memq (car X) '(llvm~setq llvm~++ llvm~>>>))
(for (L (cdr X) L (cddr L))
(T (== Var (car L)) T) ) ) ) ) )
Lst )
@@ -490,6 +493,7 @@ Bnd2 Typ Sym Ret Args Ext Body Var Val Lst Lbl Flg Skip True False Beg End)
((=T @) (llvm~set P (eval @)))
(NIL P) ) ) ) ) ) ) ) ) ) ) )


## Cross compiler overridden ##
(symbols '(cc pico llvm))

@@ -1182,6 +1186,7 @@ Bnd2 Typ Sym Ret Args Ext Body Var Val Lst Lbl Flg Skip True False Beg End)
NIL )
(llvm~ret) )


## Composite ##
(symbols '(llvm cc pico))


BIN
src/main.bc View File


+ 2
- 2
src/main.l View File

@@ -1,4 +1,4 @@
# 10nov19 Software Lab. Alexander Burger
# 11nov19 Software Lab. Alexander Burger

(compile) (length finish giveup bye alloc heapAlloc sig sighandler err numErr
needNum undefined evExpr evList2 evList equal compare natRet main)
@@ -365,6 +365,6 @@ needNum undefined evExpr evList2 evList equal compare natRet main)
(set $OutFile (initOutFile 1)) # Standard output
(set $InFile (initInFile 0 null)) # Standard input
(loop
(load $Nil (char ":") $Nil) ) )
(repl $Nil (char ":") $Nil) ) )

(end)

+ 2
- 1
src/pico.h View File

@@ -1,4 +1,4 @@
// 07nov19 Software Lab. Alexander Burger
// 11nov19 Software Lab. Alexander Burger

#include <stdint.h>
#include <string.h>
@@ -7,6 +7,7 @@
#include <stdio.h>
#include <errno.h>
#include <fcntl.h>
#include <poll.h>
#include <signal.h>

// Lisp data access

Loading…
Cancel
Save