# 17mar26 Software Lab. Alexander Burger

(symbols '(llvm))

(local) (openErr closeErr pipeErr sizeErr eofErr badInput badFd writeErr
selectErr)

(de NIL openErr (Exe X)
   (err Exe X ($ "Open error: %s") (strErrno)) )

(de NIL closeErr ()
   (err 0 0 ($ "Close error: %s") (strErrno)) )

(de NIL pipeErr (Exe)
   (err Exe 0 ($ "Pipe error: %s") (strErrno)) )

(de NIL sizeErr (Exe)
   (err Exe 0 ($ "Size overflow") null) )

(de NIL eofErr ()
   (err 0 0 ($ "EOF Overrun") null) )

(de NIL badInput ()
   (let S (b8 2)
      (set S (i8 (val $Chr)))
      (set 2 S 0)
      (err 0 0 ($ "Bad input '%s'") S) ) )

(de NIL badFd (Exe Fd)
   (err Exe Fd ($ "Bad FD") null) )

(de NIL writeErr ((i8* . Fmt))
   (err 0 0 Fmt (strErrno)) )

(de NIL selectErr (Exe)
   (err Exe 0 ($ "Select error: %s") (strErrno)) )

(local) (closeOnExec rdLockWait wrLockWait)

(de void closeOnExec (Exe (i32 . Fd))
   (when (lt0 (fcntlCloExec Fd))
      (err Exe 0 ($ "SETFD %s") (strErrno)) ) )

(de void rdLockWait ((i32 . Fd) (i64 . Len))
   (while (lt0 (rdLock Fd 0 Len YES))
      (unless (== (gErrno) EINTR)
         (lockErr) ) ) )

(de void wrLockWait ((i32 . Fd) (i64 . Len))
   (while (lt0 (wrLock Fd 0 Len YES))
      (unless (== (gErrno) EINTR)
         (lockErr) ) ) )

(local) (initInFile initOutFile closeInFile closeOutFile)

(de i8* initInFile ((i32 . Fd) (i8* . Nm))
   (let I (val $InFDs)
      (when (>= Fd I)
         (let P
            (set $InFiles
               (i8**
                  (alloc
                     (i8* (val $InFiles))
                     (* 8 (i64 (set $InFDs (+ Fd 1)))) ) ) )
            (loop
               (set (ofs P I) null)
               (? (== I Fd))
               (inc 'I) ) ) ) )
   (let In:
      (inFile
         (let P (ofs (val $InFiles) Fd)
            (if (val P)
               @
               (set P (alloc null (inFile T))) ) ) )
      (In: name Nm)
      (In: tty (n0 (isatty (In: fd Fd))))
      (In: chr 0)
      (In: line (In: src 1))
      (In: ix (In: cnt 0))
      (In:) ) )

(de i8* initOutFile ((i32 . Fd))
   (let I (val $OutFDs)
      (when (>= Fd I)
         (let P
            (set $OutFiles
               (i8**
                  (alloc
                     (i8* (val $OutFiles))
                     (* 8 (i64 (set $OutFDs (+ Fd 1)))) ) ) )
            (loop
               (set (ofs P I) null)
               (? (== I Fd))
               (inc 'I) ) ) ) )
   (let Out:
      (outFile
         (let P (ofs (val $OutFiles) Fd)
            (if (val P)
               @
               (set P (alloc null (outFile T))) ) ) )
      (Out: tty (n0 (isatty (Out: fd Fd))))
      (Out: ix 0)
      (Out:) ) )

(de void closeInFile ((i32 . Fd))
   (when (> (val $InFDs) Fd)
      (let P (ofs (val $InFiles) Fd)
         (when (val P)
            (let In: (inFile @)
               (free (In: name))
               (In: name null)
               (In: fd -1) ) ) ) ) )

(de void closeOutFile ((i32 . Fd))
   (when (> (val $OutFDs) Fd)
      (let P (ofs (val $OutFiles) Fd)
         (when (val P)
            ((outFile @) fd -1) ) ) ) )

(local) (slow slowNb rdBytes rdBytesNb wrBytes clsChild wrChild flush flushAll)

(de i32 slow ((i8* . In))
   (let In: (inFile In)
      (In: ix 0)
      (loop
         (?
            (ge0
               (i32 (read (In: fd) (In: (buf)) BUFSIZ)) )
            (In: cnt @) )
         (? (<> (gErrno) EINTR)
            (In: cnt 0) )
         (sigChk 0) ) ) )

(de i32 slowNb ((i8* . In))
   (let In: (inFile In)
      (loop
         (let
            (Flg (nonBlocking (In: fd))
               N (i32 (read (In: fd) (In: (buf)) BUFSIZ)) )
            (fcntlSetFl (In: fd) Flg)
            (? (gt0 N)
               (In: ix 0)
               (In: cnt N) )
            (? (=0 N)
               (In: ix (In: cnt -1))
               0 ) )
         (? (== (gErrno) EAGAIN) -1)
         (? (<> @ EINTR)
            (In: ix (In: cnt 0)) )
         (sigChk 0) ) ) )

(de i1 rdBytes ((i32 . Fd) (i8* . P) (i32 . Cnt))
   (loop
      (loop
         (? (gt0 (i32 (read Fd P (i64 Cnt))))
            (inc 'P @)
            (dec 'Cnt @) )
         (unless (and @ (== (gErrno) EINTR))
            (ret NO) )
         (sigChk 0) )
      (? (=0 Cnt) YES) ) )

(de i64 rdBytesNb ((i32 . Fd) (i8* . P) (i32 . Cnt))
   (loop
      (let
         (Flg (nonBlocking Fd)
            N (i32 (read Fd P (i64 Cnt))) )
         (fcntlSetFl Fd Flg)
         (when (gt0 N)
            (loop
               (unless (dec 'Cnt N)
                  (ret 1) )
               (inc 'P N)
               (while
                  (le0
                     (setq N (i32 (read Fd P (i64 Cnt)))) )
                  (unless (and N (== (gErrno) EINTR))
                     (ret 0) )
                  (sigChk 0) ) ) )
         (? (=0 N) 0) )
      (? (== (gErrno) EAGAIN) -1)
      (? (<> @ EINTR) 0)
      (sigChk 0) ) )

(de i1 wrBytes ((i32 . Fd) (i8* . P) (i32 . Cnt))
   (loop
      (? (lt0 Fd) NO)
      (let N (i32 (write Fd P (i64 Cnt)))
         (if (lt0 N)
            (let E (gErrno)
               (? (== E EBADF) NO)
               (? (== E EPIPE) NO)
               (? (== E ECONNRESET) NO)
               (unless (== E EINTR)
                  (when (== Fd 2)  # Stderr
                     (bye 2) )
                  (writeErr ($ "bytes write: %s")) )
               (sigChk 0) )
            (? (=0 (dec 'Cnt N)) YES)
            (inc 'P N) ) ) ) )

(de void clsChild ((i8* . Cld))
   (let Cld: (child Cld)
      (when (== (Cld: pid) (val $Talking))
         (set $Talking 0) )
      (Cld: pid 0)
      (close (Cld: hear))
      (close (Cld: tell))
      (free (Cld: buf)) ) )

(de void wrChild ((i8* . Cld)  (i8* . P) (i32 . Cnt))
   (let (Cld: (child Cld)  C (Cld: cnt))
      (unless C
         (loop
            (let N (i32 (write (Cld: tell) P (i64 Cnt)))
               (if (lt0 N)
                  (let E (gErrno)
                     (? (== E EAGAIN))
                     (when (or (== E EPIPE) (== E ECONNRESET))
                        (clsChild Cld)
                        (ret) )
                     (unless (== E EINTR)
                        (writeErr ($ "child write: %s")) ) )
                  (unless (dec 'Cnt N)
                     (ret) )
                  (inc 'P N) ) ) ) )
      (let Siz (+ C Cnt 4)  # New buffer size
         (when (> Siz (hex "3FFFFFFF"))  # Allow max 1 GiB
            (sizeErr 0) )
         (let Q (ofs (Cld: buf (alloc (Cld: buf) (i64 Siz))) C)
            (set (i32* Q) Cnt)
            (memcpy (ofs Q 4) P (i64 Cnt))
            (Cld: cnt Siz) ) ) ) )

(de i1 flush ((i8* . Out))
   (ifn Out
      YES
      (let Out: (outFile Out)
         (ifn (Out: ix)
            YES
            (Out: ix 0)
            (wrBytes (Out: fd) (Out: (buf)) @) ) ) ) )

(de void flushAll ()
   (let (A (val $OutFiles)  N (val $OutFDs)  I (i32 0))
      (while (> N I)
         (flush (val (ofs A I)))
         (inc 'I) ) ) )

(local) (stdinByte getBinary binRead)

(de i32 stdinByte ()
   (let In: (inFile (val (val $InFiles)))  # Stdin
      (cond
         ((and
               (ge0 (In: fd))
               (or
                  (<> (In: ix) (In: cnt))
                  (and (ge0 @) (slow (In:))) ) )
            (let I (In: ix)
               (In: ix (+ I 1))
               (i32 (val (ofs (In: (buf)) I))) ) )
         ((In: tty) (bye 0))
         (T -1) ) ) )

(de i32 getBinary ()
   (let (In: (inFile (val $InFile))  I (In: ix))
      (when (== I (In: cnt))
         (when (or (lt0 I) (=0 (slow (In:))))  # Closed or EOF
            (ret -1) )
         (setq I 0) )
      (In: ix (+ I 1))
      (i32 (val (ofs (In: (buf)) I))) ) )

# Read binary PLIO expression
(de binRead ()
   (case (call $GetBin)
      (NIX $Nil)  # NIL
      (BEG
         (ifn (binRead)
            0
            (let (X (cons @ $Nil)  R (save X))
               (loop
                  (? (=0 (binRead)) @)
                  (? (== @ END) R)
                  (? (== @ -ZERO)  # DOT
                     (ifn (binRead)
                        0
                        (set 2 X (if (== @ END) R @))
                        R ) )
                  (setq X (set 2 X (cons @ $Nil))) ) ) ) )
      (DOT -ZERO)  # DOT -> -ZERO
      (END (i64 @))  # END
      (T
         (if (lt0 @)
            0  # EOF
            (let  # Atom
               (Tag (& @ 3)
                  Cnt (shr @ 2)
                  P (i64* (push NIL NIL ZERO NIL))  # [cnt last name link]
                  Q (link (ofs P 2)) )
               (cond
                  ((== Tag NUMBER)
                     (set P 3)  # 'cnt' for signed number
                     (when (== Cnt 63)  # More than one chunk
                        (loop
                           (loop
                              (when (lt0 (call $GetBin))
                                 (: 1
                                    (drop Q)
                                    (ret 0) ) )
                              (byteNum (i8 @) P)
                              (? (=0 (dec 'Cnt))) )
                           (when (lt0 (setq Cnt (call $GetBin)))
                              (goto 1) )
                           (? (<> Cnt 255)) )
                        (unless Cnt
                           (goto 2) ) )
                     (loop
                        (when (lt0 (call $GetBin))
                           (goto 1) )
                        (byteNum (i8 @) P)
                        (? (=0 (dec 'Cnt))) )
                     (: 2
                        (drop Q
                           (if (cnt? (val Q))
                              @
                              (let S (& (val (dig @)) 1)
                                 (| (half @) (shl S 3)) ) ) ) ) )
                  (T  # Symbol
                     (set P 4)  # 'cnt' for symbol name
                     (when (== Cnt 63)  # More than one chunk
                        (loop
                           (loop
                              (when (lt0 (call $GetBin))
                                 (goto 1) )
                              (byteSym (i8 @) P)
                              (? (=0 (dec 'Cnt))) )
                           (when (lt0 (setq Cnt (call $GetBin)))
                              (goto 1) )
                           (? (<> Cnt 255)) )
                        (unless Cnt
                           (goto 3) ) )
                     (loop
                        (when (lt0 (call $GetBin))
                           (goto 1) )
                        (byteSym (i8 @) P)
                        (? (=0 (dec 'Cnt))) )
                     (: 3
                        (drop Q
                           (let Nm (val Q)
                              (case Tag
                                 (TRANSIENT (consStr Nm))
                                 (INTERN (requestSym Nm))
                                 (T  # External
                                    (when (val $Extn)
                                       (let N
                                          (shl
                                             (& (i64 (+ (objFile Nm) @)) (hex "FFFF"))
                                             24 )  # Mask overflow
                                          (setq Nm
                                             (|
                                                (& Nm (hex "FFF00FFF00FFFFFF"))  # Mask object ID
                                                (&
                                                   (| N (shl N 12))
                                                   (hex "000FF000FF000000") ) ) ) ) )  # Mask file number
                                    (extern Nm) ) ) ) ) ) ) ) ) ) ) ) )

(local) (prCnt binPrint pr putTell prTell tellBeg tellEnd unsync)

# Binary print short number
(de void prCnt ((i8 . Tag) Num)
   (let N Num
      (while (setq N (shr N 8))
         (inc 'Tag 4) ) )
   (call $PutBin Tag)
   (loop
      (call $PutBin (i8 Num))
      (? (=0 (setq Num (shr Num 8)))) ) )

# Binary print expression
(de void binPrint (X)
   (cond
      ((cnt? X)
         (tailcall (prCnt (+ NUMBER 4) (shr X 3))) )
      ((big? X)
         (let (Y (pos X)  Z Y  N 8)
            (loop
               (let C (val (dig Z))
                  (? (cnt? (setq Z (val (big Z))))
                     (setq
                        Z (int Z)  # Normalize short
                        C (add C C)  # Get most significant bit of last digit
                        Z (add Z Z @@) ) )
                  (inc 'N 8) ) )
            (when Z  # Significant bits in short number
               (loop
                  (inc 'N)
                  (? (=0 (setq Z (shr Z 8)))) ) )
            (let (M (- N 63)  D (val (dig Y)))
               (when (ge0 M)
                  (setq N 63) )
               (setq Y (val (big Y)))
               (setq X (shr X X 4))  # Sign into highest bit
               (add X X)  # Keep in carry
               (setq D (add D D @@))
               (call $PutBin (i8 (shl N 2)))  # Output tag byte
               (let (S @@  C 8)
                  (loop
                     (loop
                        (call $PutBin (i8 D))  # Output next byte
                        (if (dec 'C)
                           (setq D (shr D 8))
                           (setq C 8)
                           (if (cnt? Y)
                              (setq D (int Y))
                              (setq
                                 D (val (dig Y))
                                 Y (val (big Y)) ) )
                           (setq
                              D (add D D S)
                              S @@ ) )
                        (? (=0 (dec 'N))) )
                     (? (lt0 M))
                     (? (=0 M) (call $PutBin 0))  # Output final zero
                     (when (ge0 (setq M (- (setq N M) 255)))
                        (setq N 255) )
                     (call $PutBin (i8 N)) ) ) ) ) )  # Output next chunk size
      ((nil? X) (call $PutBin NIX))
      ((pair X)
         (call $PutBin BEG)
         (let (P (circ X)  Z X)
            (loop
               (binPrint (car X))
               (? (nil? (shift X))
                  (call $PutBin END) )
               (? (atom X)
                  (call $PutBin DOT)
                  (binPrint X) )
               (? (== Z X)
                  (call $PutBin DOT)
                  (call $PutBin END) )
               (when (== P X)
                  (call $PutBin DOT)
                  (call $PutBin BEG)
                  (setq Z P) ) ) ) )
      ((sym? (val (tail X)))  # External symbol
         (let Nm (name (& @ -9))
            (when (val $Extn)
               (let N
                  (shl
                     (& (i64 (- (objFile Nm) @)) (hex "FFFF"))
                     24 )  # Mask overflow
                  (setq Nm
                     (|
                        (& Nm (hex "FFF00FFF00FFFFFF"))  # Mask object ID
                        (&
                           (| N (shl N 12))
                           (hex "000FF000FF000000") ) ) ) ) )  # Mask file number
            (tailcall
               (prCnt (+ EXTERN 4) (shr (shl Nm 2) 6)) ) ) )  # Strip status bits
      ((== (name @) ZERO) (call $PutBin NIX))
      (T
         (let
            (Nm @
               Tag
               (if (findSym X Nm (val $Intern))
                  (i8 INTERN)
                  (i8 TRANSIENT) ) )
            (if (cnt? Nm)
               (prCnt (+ Tag 4) (int Nm))
               (let (Y Nm  N 8)
                  (while (big? (setq Y (val (big Y))))
                     (inc 'N 8) )
                  (setq Y (int Y))
                  (while Y
                     (inc 'N)
                     (setq Y (shr Y 8)) )
                  (let (P (push 0 Nm)  M (- N 63)  C 8)  # [cnt name]
                     (when (ge0 M)
                        (setq N 63) )
                     (call $PutBin (+ Tag (i8 (shl N 2))))
                     (loop
                        (loop
                           (call $PutBin (symByte P))
                           (? (=0 (dec 'N))) )
                        (? (lt0 M))
                        (? (=0 M) (call $PutBin 0))
                        (when (ge0 (setq M (- (setq N M) 255)))
                           (setq N 255) )
                        (call $PutBin (i8 N)) ) ) ) ) ) ) ) )

(de void pr (X)
   (set $PutBin (fun (void i8) _putStdout))
   (tailcall (binPrint X)) )

(de void putTell ((i8 . B))
   (let P (val $Ptr)
      (set P B)
      (when (== (set $Ptr (inc P)) (val $End))
         (err 0 0 ($ "Tell PIPE_BUF") null) ) ) )

(de void prTell (X)
   (set
      $PutBin (fun (void i8) putTell)
      $Extn 0 )
   (tailcall (binPrint X)) )

(de void tellBeg ((i8* . P))
   (set
      $TellBuf P
      $End (ofs P (dec (val PipeBufSize)))
      (inc 'P 8) BEG  # 8 bytes space (PID and count)
      $Ptr (inc P) ) )  # Begin a list

(de void tellEnd ((i32 . Pid))
   (let (P (val $Ptr)  Q (val $TellBuf))
      (set P END)  # Close list
      (inc 'P)
      (let (D (i32 (- P Q))  N (- D 8))  # Size without PID and count
         (set
            (i32* Q) Pid
            (inc (i32* Q)) N )
         (when (val $Tell)
            (let Fd @
               (unless (wrBytes Fd Q D)
                  (close Fd)
                  (set $Tell 0) ) ) )
         (let
            (Cld (val $Child)  # Iterate children
               <Cld (ofs Cld (* (val $Children) (child T))) )
            (inc 'Q 8)
            (until (== Cld <Cld)
               (let Cld: (child Cld)
                  (when
                     (and
                        (Cld: pid)
                        (or (lt0 Pid) (== Pid (Cld: pid))) )
                     (wrChild Cld Q N) ) )
               (setq Cld (ofs Cld (child T))) ) ) ) ) )

(de void unsync ()
   (when (val $Tell)
      (let Fd @
         (unless (wrBytes Fd (i8* (push -1)) 8)
            (close Fd)
            (set $Tell 0) ) ) )
   (set $Sync NO) )

(local) (waitFile currFd)

# Wait for pipe process if necessary
(de void waitFile ((i32 . Pid))
   (let Res (b32 1)
      (while (lt0 (waitpid Pid Res 0))
         (unless (== (gErrno) EINTR)
            (closeErr) )
         (sigChk 0) )
      (set $At2 (cnt (i64 (val Res)))) ) )

(de i32 currFd (Exe)
   (let (In: (ioFrame (val $InFrames))  Out: (ioFrame (val $OutFrames)))
      (nond
         ((or (In: file) (Out: file))
            (err Exe 0 ($ "No current fd") null) )
         ((Out: file) ((inFile (In: file)) fd))
         ((In: file) ((outFile (Out: file)) fd))
         (NIL
            (if
               (if (> (In:) (stack))  # Assume stack is growing downwards
                  (> (Out:) (In:))
                  (> (In:) (Out:)) )
               ((inFile (In: file)) fd)
               ((outFile (Out: file)) fd) ) ) ) ) )

(local) (getIn put1 putOut)

(de i32 getIn ()
   (set $Chr
      (cond
         ((val $InChar)
            (set $InChar (shr @ 8))
            (i32 (i8 @)) )
         ((nil?
               (let (Iox: (ioxFrame (val $InFrames))  At (save (val $At)))
                  (prog2
                     (set
                        $Chr (Iox: chr)
                        (i8** $Get) (Iox: fun)
                        $InFrames (Iox: link) )
                     (eval (Iox: exe))
                     (set
                        $InFrames (Iox:)
                        $Get (fun (i32) getIn)
                        $At At )
                     (Iox: chr (val $Chr)) ) ) )
            -1 )
         ((sym? @)
            (let (S @  V (val (tail @)))
               (if
                  (or
                     (sym? V)
                     (not (cnt? (setq V (name V)))) )
                  (charErr 0 S)
                  (let C (int V)
                     (set $InChar (shr C 8))
                     (i32 (i8 C)) ) ) ) )
         (T (symErr 0 @)) ) ) )

(de void put1 ((i8* . Iox) (i32 . C) (i32 . D))
   (let
      (Iox: (ioxFrame Iox)
         At (save (val $At))
         At2 (save (val $At2))
         At3 (save (val $At3)) )
      (set
         (i8** $Put) (Iox: fun)
         $OutFrames (Iox: link)
         $At2 (consStr (cnt (i64 C)))
         $At3 (if D (consStr (cnt (i64 @))) $Nil) )
      (eval (Iox: exe))
      (set
         $OutFrames (Iox:)
         $Put (fun (void i8) putOut)
         $At3 At3
         $At2 At2
         $At At ) ) )

(de void putOut ((i8 . B))
   (nond
      ((& B (hex "80"))  # Single byte
         (set $OutChar (i64 B)) )
      ((& B (hex "40"))  # Following byte
         (set $OutChar
            (|
               (val $OutChar)
               (shl
                  (i64 B)
                  (set $IoIx (+ (val $IoIx) 8)) ) ) )
         (when (set $IoCnt (dec (val $IoCnt)))
            (ret) ) )
      ((& B (hex "20"))
         (set $IoCnt 1  $IoIx 0  $OutChar (i64 B))
         (ret) )
      ((& B (hex "10"))
         (set $IoCnt 2  $IoIx 0  $OutChar (i64 B))
         (ret) )
      (NIL
         (set $IoCnt 3  $IoIx 0  $OutChar (i64 B))
         (ret) ) )
   (let (Iox: (ioxFrame (val $OutFrames))  C (i32 (val $OutChar)))
      (when (Iox: chr)
         (put1 (Iox:) @ C) )
      (Iox: chr C) ) )

(local) (pushInFile pushOutFile pushErrFile pushCtlFile)

(de void pushInFile ((i8* . Io) (i8* . In) (i32 . Pid))
   (let Io: (ioFrame Io)
      (Io: link (val $InFrames))
      (when (val $InFile)
         ((inFile @) chr (val $Chr)) )
      (set $Chr
         ((inFile (Io: file (set $InFile In))) chr) )
      (Io: fun (val (i8** $Get)))
      (Io: pid Pid)
      (set $InFrames (Io:)  $Get (fun (i32) _getStdin)) ) )

(de void pushOutFile ((i8* . Io) (i8* . Out) (i32 . Pid))
   (let Io: (ioFrame Io)
      (Io: link (val $OutFrames))
      (Io: file (set $OutFile Out))
      (Io: fun (val (i8** $Put)))
      (Io: pid Pid)
      (set $OutFrames (Io:)  $Put (fun (void i8) _putStdout)) ) )

(de void pushErrFile ((i8* . Ct))
   ((ctFrame Ct) link (val $ErrFrames))
   (set $ErrFrames Ct) )

(de void pushCtlFile ((i8* . Ct))
   ((ctFrame Ct) link (val $CtlFrames))
   (set $CtlFrames Ct) )

(local) (popInFiles popOutFiles popErrFiles popCtlFiles)

(de void popInFiles ()
   (let Io: (ioFrame (val $InFrames))
      (when (Io: file)
         (let In: (inFile @)
            (when (ge0 (In: fd))
               (ifn (Io: pid)
                  (In: chr (val $Chr))
                  (close (In: fd))
                  (closeInFile (In: fd))
                  (when (> (Io: pid) 1)
                     (waitFile @) ) ) ) ) )
      (set (i8** $Get) (Io: fun))
      (setq Io: (ioFrame (set $InFrames (Io: link))))
      (set $Chr
         (if (Io: file)
            ((inFile (set $InFile @)) chr)
            ((ioxFrame (Io:)) chr) ) ) ) )

(de void popOutFiles ()
   (let Io: (ioFrame (val $OutFrames))
      (cond
         ((Io: file)
            (let Out: (outFile @)
               (flush (val $OutFile))
               (when (ge0 (Out: fd))
                  (when (Io: pid)
                     (close (Out: fd))
                     (closeOutFile (Out: fd))
                     (when (> (Io: pid) 1)
                        (waitFile @) ) ) ) ) )
         (((ioxFrame (Io:)) chr)
            (put1 (Io:) @ 0) ) )
      (set (i8** $Put) (Io: fun))
      (setq Io: (ioFrame (set $OutFrames (Io: link))))
      (when (Io: file)
         (set $OutFile @) ) ) )

(de void popErrFiles ()
   (let Ct: (ctFrame (val $ErrFrames))
      (dup2 (Ct: fd) 2)  # Restore stderr
      (close (Ct: fd))
      (set $ErrFrames (Ct: link)) ) )

(de void popCtlFiles ()
   (let Ct: (ctFrame (val $CtlFrames))
      (if (ge0 (Ct: fd))
         (close @)
         (unLock (currFd 0) 0 0) )
      (set $CtlFrames (Ct: link)) ) )

# (path 'any) -> sym
(de _Path (Exe)
   (let Nm (xName (evSym (cdr Exe)))
      (mkStr (pathString Nm (b8 (pathSize Nm)))) ) )

(local) (pollfd hasData inReady getBlk waitFd)

(de i64* pollfd ((i32 . Fd))
   (let I (val $Nfds)
      (when (>= Fd I)
         (let P
            (set $Poll
               (i64*
                  (alloc
                     (i8* (val $Poll))
                     (* 8 #{pollfd}# (i64 (set $Nfds (+ Fd 1)))) ) ) )
            (loop
               (pollIgn (ofs P I))
               (? (== I Fd))
               (inc 'I) ) ) ) )
   (ofs (val $Poll) Fd) )

(de i1 hasData ((i32 . Fd))
   (and
      (> (val $InFDs) Fd)
      (val (ofs (val $InFiles) Fd))
      (let In: (inFile @)
         (and
            (ge0 (In: fd))
            (> (In: cnt) (In: ix)) ) ) ) )

(de i1 inReady ((i32 . Fd) (i1 . Flg))
   (let P (pollfd Fd)
      (cond
         ((>= Fd (val $InFDs))
            (readyIn P) )
         ((=0 (val (ofs (val $InFiles) Fd)))
            (readyIn P) )
         (T
            (let In: (inFile @)
               (if (lt0 (In: fd))
                  (readyIn P)
                  (or
                     (> (In: cnt) (In: ix))
                     (and
                        (readyIn P)
                        (or Flg (ge0 (slowNb (In:)))) ) ) ) ) ) ) ) )
(de i32 getBlk ()
   (let P (val $BlkPtr)
      (set $BlkPtr (inc P))
      (i32 (val P)) ) )

(de i64 waitFd (Exe (i32 . Fd) (i64 . Ms))
   (let
      (Run (save (val $Run))
         At (save (val $At))
         Buf (b8 (val PipeBufSize))
         Pn (b32 2)
         Tim (getMsec) )
      (stkChk Exe)
      (loop
         (let Dly Ms
            (when (ge0 Fd)
               (if (hasData Fd)
                  (setq Dly 0)
                  (pollIn Fd (pollfd Fd)) ) )
            (let R Run  # '*Run' elements
               (while (pair R)
                  (let X (++ R)
                     (cond
                        ((sign? (car X))
                           (let N (int (cadr X))
                              (when (> Dly N)
                                 (setq Dly N) ) ) )
                        ((<> (i32 (int @)) Fd)
                           (let N @
                              (if (hasData N)
                                 (setq Dly 0)
                                 (pollIn N (pollfd N)) ) ) ) ) ) ) )
            (when (and (val $Hear) (<> @ Fd))  # RPC listener
               (let N @
                  (if (hasData N)
                     (setq Dly 0)
                     (pollIn N (pollfd N)) ) ) )
            (when (val $Spkr)  # RPC speaker
               (pollIn @ (pollfd @))
               (let
                  (Cld (val $Child)  # Iterate children
                     <Cld (ofs Cld (* (val $Children) (child T))) )
                  (until (== Cld <Cld)
                     (let Cld: (child Cld)
                        (when (Cld: pid)
                           (pollIn (Cld: hear) (pollfd (Cld: hear)))
                           (when (Cld: cnt)
                              (pollOut (Cld: tell) (pollfd (Cld: tell))) ) ) )
                     (setq Cld (ofs Cld (child T))) ) ) )
            (while (lt0 (gPoll (val $Poll) (val $Nfds) Dly))
               (unless (== (gErrno) EINTR)
                  (set $Run $Nil)
                  (selectErr Exe) )
               (sigChk Exe) ) )
         (let (Now (getMsec)  Dif (- Now Tim))
            (when (val $Spkr)  # RPC speaker
               (set $Protect (inc (val $Protect)))
               (let
                  (Cld (val $Child)  # Iterate children
                     <Cld (ofs Cld (* (val $Children) (child T))) )
                  (until (== Cld <Cld)
                     (let Cld: (child Cld)
                        (when (Cld: pid)
                           (when (readyIn (pollfd (Cld: hear)))
                              (cond
                                 ((=0 (rdBytesNb (Cld: hear) (i8* Pn) (* 2 4)))
                                    (clsChild Cld)
                                    (goto 1) )
                                 ((gt0 @)
                                    (cond
                                       ((lt0 (val (i64* Pn)))  # PID and size are -1
                                          (when (== (Cld: pid) (val $Talking))
                                             (set $Talking 0) ) )
                                       ((> (val 2 Pn) (val PipeBufSize))
                                          (sizeErr Exe) )
                                       ((rdBytes (Cld: hear) Buf @)
                                          (ifn (=0 (val Pn))
                                             (let
                                                (Cld2 (val $Child)  # Iterate children
                                                   <Cld2 (ofs Cld2 (* (val $Children) (child T))) )
                                                (until (== Cld2 <Cld2)
                                                   (let Cld2: (child Cld2)
                                                      (when
                                                         (and
                                                            (<> Cld Cld2)
                                                            (Cld2: pid)
                                                            (or (lt0 (val Pn)) (== @ (Cld2: pid))) )
                                                         (wrChild Cld2 Buf (val 2 Pn)) ) )
                                                   (setq Cld2 (ofs Cld2 (child T))) ) )
                                             (set
                                                $BlkPtr Buf
                                                $GetBin (fun (i32) getBlk)
                                                $Extn 0 )
                                             (let E (binRead)
                                                (save E (evList E)) ) ) )
                                       (T
                                          (clsChild Cld)
                                          (goto 1) ) ) ) ) )
                           (when (readyOut (pollfd (Cld: tell)))
                              (let
                                 (P (ofs (Cld: buf) (Cld: ofs))  # Buffer pointer plus offset
                                    N (val (i32* P)) )  # Size
                                 (ifn (wrBytes (Cld: tell) (ofs P 4) N)
                                    (clsChild Cld)
                                    (setq N (Cld: ofs (+ (Cld: ofs) N 4)))  # Add size plus size of size to buffer offset
                                    (when (>= (* 2 N) (Cld: cnt))
                                       (when (Cld: cnt (- (Cld: cnt) N))
                                          (memcpy
                                             (Cld: buf)
                                             (ofs (Cld: buf) N)
                                             (i64 (Cld: cnt)) )
                                          (Cld: buf (alloc (Cld: buf) (i64 (Cld: cnt)))) )
                                       (Cld: ofs 0) ) ) ) ) ) )
                     (: 1
                        (setq Cld (ofs Cld (child T))) ) ) )
               (when
                  (and
                     (=0 (val $Talking))
                     (readyIn (pollfd (val $Spkr)))
                     (gt0 (rdBytesNb (val $Spkr) (i8* Pn) 4)) )  # Slot
                  (let Cld (ofs (val $Child) (* (val Pn) (child T)))
                     (when ((child Cld) pid)
                        (set $Talking @)
                        (wrChild Cld $TBuf 2) ) ) )
               (set $Protect (dec (val $Protect))) )
            (let N (val $Hear)  # RPC listener
               (when (and N (<> N Fd) (inReady N NO))
                  (let In (val $InFile)
                     (set
                        $InFile (val (ofs (val $InFiles) (val $Hear)))
                        $GetBin (fun (i32) getBinary)
                        $Extn 0 )
                     (let E (binRead)
                        (cond
                           ((=0 E)
                              (close N)
                              (closeInFile N)
                              (closeOutFile N)
                              (set $Hear 0) )
                           ((t? E) (set $Sync YES))
                           (T (save E (evList E))) ) )
                     (set $InFile In) ) ) )
            (let R Run
               (while (pair R)
                  (let X (++ R)
                     (cond
                        ((sign? (car X))
                           (let Y (cdr X)
                              (if (gt0 (- (int (car Y)) Dif))  # Not yet timed out
                                 (set Y (sign (cnt @)))   # Store short negative number
                                 (let V (car X)  # Timeout value
                                    (set Y (pos V)  $At V)
                                    (exec (cdr Y)) ) ) ) )  # Run body
                        ((<> (i32 (int @)) Fd)
                           (when (inReady @ NO)
                              (set $At (car X))  # File descriptor
                              (exec (cdr X)) ) ) ) ) ) )  # Run body
            (and
               (gt0 Ms)
               (<> Ms 292MY)
               (lt0 (dec 'Ms Dif))
               (setq Ms 0) )
            (setq Tim Now) )
         (sigChk Exe)
         (? (or (=0 Ms) (lt0 Fd) (inReady Fd YES)))
         (setq Run (safe (val $Run))) )
      (set $At At)
      Ms ) )

# (wait 'cnt|NIL . prg) -> any
# (wait 'cnt|NIL T 'fd) -> fd|NIL
(de _Wait (Exe)
   (let
      (X (cdr Exe)
         N
         (if (nil? (eval (++ X)))
            292MY
            (xCnt Exe @) ) )
      (if (t? (car X))
         (let Fd (evCnt Exe (cdr X))  # Wait for file descriptor
            (if (waitFd Exe (i32 Fd) N)
               (cnt Fd)
               $Nil ) )
         (loop
            (? (not (nil? (run X))) @)  # 'prg'
            (? (=0 (waitFd Exe -1 N)) (run X))  # Timeout
            (setq N @) ) ) ) )

# (sync) -> flg
(de _Sync (Exe)
   (cond
      ((or (=0 (val $Mic)) (=0 (val $Hear)))
         $Nil )
      ((val $Sync) $T)
      (T
         (let (Mic (val $Mic)  P (i8* $Slot)  Cnt 4)
            (loop
               (let N (write Mic P Cnt)
                  (cond
                     ((ge0 N)
                        (? (=0 (dec 'Cnt N)))
                        (setq P (ofs P N)) )
                     ((== (gErrno) EINTR) (sigChk Exe))
                     (T (writeErr ($ "sync write: %s"))) ) ) ) )
         (set $Sync NO)
         (loop
            (waitFd Exe -1 292MY)
            (? (val $Sync)) )
         $T ) ) )

# (hear 'cnt) -> cnt
(de _Hear (Exe)
   (let
      (X (eval (cadr Exe))
         Fd (i32 (xCnt Exe X)) )
      (when
         (or
            (lt0 Fd)
            (>= Fd (val $InFDs))
            (=0 (val (ofs (val $InFiles) Fd)))
            (lt0 ((inFile @) fd)) )
         (badFd Exe X) )
      (when (val $Hear)
         (close @)
         (closeInFile @)
         (closeOutFile @) )
      (set $Hear Fd)
      X ) )

# (tell ['cnt] 'sym ['any ..]) -> any
(de _Tell (Exe)
   (cond
      ((and (=0 (val $Tell)) (=0 (val $Children)))
         $Nil )
      ((atom (cdr Exe))
         (unsync)
         $Nil )
      (T
         (let (X @  Y (eval (car X))  Pid (i32 -1))
            (when (cnt? Y)
               (setq
                  Pid (i32 (int @))
                  Y (eval (car (shift X))) ) )
            (let (TellBuf (val $TellBuf)  Ptr (val $Ptr)  End (val $End))
               (tellBeg (b8 (val PipeBufSize)))
               (stkChk Exe)
               (loop
                  (prTell Y)
                  (? (atom (shift X)))
                  (setq Y (eval (car X))) )
               (tellEnd Pid)
               (set $TellBuf TellBuf  $Ptr Ptr  $End End)
               Y ) ) ) ) )

# (poll 'cnt) -> cnt | NIL
(de _Poll (Exe)
   (let
      (C (eval (cadr Exe))
         Fd (i32 (xCnt Exe C)) )
      (when (or (lt0 Fd) (>= Fd (val $InFDs)))
         (badFd Exe C) )
      (let In: (inFile (val (ofs (val $InFiles) Fd)))
         (ifn (and (In:) (ge0 (In: fd)))
            $Nil
            (let Poll (b64 1)
               (pollIn Fd Poll)
               (loop
                  (? (> (In: cnt) (In: ix)) C)
                  (while (lt0 (gPoll Poll 1 0))
                     (unless (== (gErrno) EINTR)
                        (selectErr Exe) ) )
                  (? (not (readyIn Poll)) $Nil)
                  (? (ge0 (slowNb (In:))) C) ) ) ) ) ) )

(local) (rdOpen wrOpen erOpen ctOpen)

(de void rdOpen (Exe X (i8* . Io))
   (cond
      ((nil? X)
         (pushInFile Io (val (val $InFiles)) 0) )  # Stdin
      ((num? X)
         (let N (i32 (int X))
            (pushInFile Io
               (cond
                  ((sign? X)
                     (let In (val $InFrames)
                        (loop
                           (unless (setq In ((ioFrame In) link))
                              (badFd Exe X) )
                           (? (=0 (dec 'N))) )
                        ((ioFrame In) file) ) )
                  ((>= N (val $InFDs))
                     (badFd Exe X) )
                  ((=0 (val (ofs (val $InFiles) N)))
                     (badFd Exe X) )
                  (T @) )
               0 ) ) )
      ((sym? X)
         (let
            (Nm (xName X)
               S (pathString Nm (b8 (pathSize Nm)))
               Fd T )
            (while (lt0 (setq Fd (openRd S)))
               (unless (== (gErrno) EINTR)
                  (openErr Exe X) )
               (sigChk Exe) )
            (closeOnExec Exe Fd)
            (pushInFile Io (initInFile Fd (strdup S)) 1) ) )
      (T  # Pipe
         (let
            (Pfd (b32 2)
               Av (b8* (inc (length X)))
               Cmd (xName (xSym (car X))) )
            (when (lt0 (pipe Pfd))
               (pipeErr Exe) )
            (set Av (pathString Cmd (b8 (pathSize Cmd))))
            (let A Av
               (while (pair (shift X))
                  (let Nm (xName (xSym (car X)))
                     (set (inc 'A)
                        (bufString Nm (b8 (bufSize Nm))) ) ) )
               (set (inc 'A) null) )
            (cond
               ((lt0 (fork)) (forkErr Exe))
               ((=0 @)  # In child
                  (setpgid 0 0)  # Set process group
                  (close (val Pfd))  # Close read pipe
                  (unless (== (val 2 Pfd) 1)
                     (dup2 @ 1)  # Dup write pipe to STDOUT_FILENO
                     (close @) )
                  (signal (val SIGPIPE Sig) (val SigDfl))  # Default SIGPIPE
                  (execvp (val Av) Av)  # Execute program
                  (execErr (val Av)) ) )  # Error if failed
            # In parent
            (let (Pid @  Fd (val Pfd))
               (setpgid Pid 0)  # Set process group
               (close (val 2 Pfd))  # Close write pipe
               (closeOnExec Exe Fd)
               (pushInFile Io (initInFile Fd null) Pid) ) ) ) ) )

(de void wrOpen (Exe X (i8* . Io))
   (cond
      ((nil? X)
         (pushOutFile Io (val 2 (val $OutFiles)) 0) )  # Stdout
      ((num? X)
         (let N (i32 (int X))
            (pushOutFile Io
               (cond
                  ((sign? X)
                     (let Out (val $OutFrames)
                        (loop
                           (unless (setq Out ((ioFrame Out) link))
                              (badFd Exe X) )
                           (? (=0 (dec 'N))) )
                        ((ioFrame Out) file) ) )
                  ((>= N (val $OutFDs))
                     (badFd Exe X) )
                  ((=0 (val (ofs (val $OutFiles) N)))
                     (badFd Exe X) )
                  (T @) )
               0 ) ) )
      ((sym? X)
         (let
            (Nm (xName X)
               S (pathString Nm (b8 (pathSize Nm)))
               Flg (== (val S) (char "+"))
               Fd T )
            (when Flg
               (setq S (ofs S 1)) )
            (while (lt0 (setq Fd (if Flg (openRdWrAppend S) (openWr S))))
               (unless (== (gErrno) EINTR)
                  (openErr Exe X) )
               (sigChk Exe) )
            (closeOnExec Exe Fd)
            (pushOutFile Io (initOutFile Fd) 1) ) )
      (T  # Pipe
         (let
            (Pfd (b32 2)
               Av (b8* (inc (length X)))
               Cmd (xName (xSym (car X))) )
            (when (lt0 (pipe Pfd))
               (pipeErr Exe) )
            (set Av (pathString Cmd (b8 (pathSize Cmd))))
            (let A Av
               (while (pair (shift X))
                  (let Nm (xName (xSym (car X)))
                     (set (inc 'A)
                        (bufString Nm (b8 (bufSize Nm))) ) ) )
               (set (inc 'A) null) )
            (cond
               ((lt0 (fork)) (forkErr Exe))
               ((=0 @)  # In child
                  (setpgid 0 0)  # Set process group
                  (close (val 2 Pfd))  # Close write pipe
                  (when (val Pfd)  # STDIN_FILENO
                     (dup2 @ 0)  # Dup read pipe to STDIN_FILENO
                     (close @) )
                  (execvp (val Av) Av)  # Execute program
                  (execErr (val Av)) ) )  # Error if failed
            # In parent
            (let (Pid @  Fd (val 2 Pfd))
               (setpgid Pid 0)  # Set process group
               (close (val Pfd))  # Close read pipe
               (closeOnExec Exe Fd)
               (pushOutFile Io (initOutFile Fd) Pid) ) ) ) ) )

(de void erOpen (Exe X (i8* . Ct))
   (let Ct: (ctFrame Ct)
      (Ct: fd (dup 2))  # Stderr
      (let Fd
         (if (nil? (needSymb Exe X))
            (dup ((outFile (val $OutFile)) fd))
            (let
               (Nm (xName X)
                  S (pathString Nm (b8 (pathSize Nm)))
                  Flg (== (val S) (char "+")) )
               (when Flg
                  (setq S (ofs S 1)) )
               (while (lt0 (if Flg (openWrAppend S) (openWr S)))
                  (unless (== (gErrno) EINTR)
                     (openErr Exe X) )
                  (sigChk Exe) )
               (closeOnExec Exe @)
               @ ) )
         (dup2 Fd 2)
         (close Fd) )
      (pushErrFile Ct) ) )

(de void ctOpen (Exe X (i8* . Ct))
   (let Ct: (ctFrame Ct)
      (cond
         ((nil? (needSymb Exe X))
            (Ct: fd -1)
            (rdLockWait (currFd Exe) 0) )
         ((t? X)
            (Ct: fd -1)
            (wrLockWait (currFd Exe) 0) )
         (T
            (let
               (Nm (xName X)
                  S (pathString Nm (b8 (pathSize Nm)))
                  Flg (== (val S) (char "+")) )
               (when Flg
                  (setq S (ofs S 1)) )
               (while (lt0 (openRdWrCreate S))
                  (unless (== (gErrno) EINTR)
                     (openErr Exe X) )
                  (sigChk Exe) )
               (let Fd (Ct: fd @)
                  (if Flg
                     (rdLockWait Fd 0)
                     (wrLockWait Fd 0) )
                  (closeOnExec Exe Fd) ) ) ) )
      (pushCtlFile Ct) ) )

(local) (read0 getChar skipc comment skip)

(de read0 (i1))

(de i32 rlGetc ((i8* . F))
   (if (waitFd 0 0 292MY)
      (stdinByte)
      -1 ) )

(de i32 rlAvail ()
   (i32 (waitFd 0 0 60)) )

(de i32 _getStdin ()
   (let In: (inFile (val $InFile))
      (set $Chr
         (cond
            ((lt0 (In: fd)) -1)  # EOF
            ((or (In: fd) (not (In: tty)))  # Not stdin
               (if
                  (and
                     (== (In: ix) (In: cnt))
                     (or (lt0 (In: ix)) (=0 (slow (In:)))) )
                  -1
                  (let I (In: ix)
                     (prog1
                        (i32 (val (ofs (In: (buf)) I)))
                        (when (== @ (char "\n"))
                           (In: line (+ (In: line) 1)) )
                        (In: ix (+ I 1)) ) ) ) )
            (T
               (let P (val $LinePtr)
                  (unless P
                     (when (val $LineBuf)
                        (free @)
                        (set $LineBuf null) )
                     (flushAll)
                     (unless (setq P (set $LineBuf (gReadline (val $LinePrmt))))
                        (wrnl)
                        (when (or (val $Bind) (== (val $LinePrmt) (val $ContPrmt)))
                           (err 0 0 $Empty null) )  # quit
                        (bye 0) )
                     (set $LinePrmt (val $ContPrmt))
                     (unless
                        (or
                           (=0 (val P))
                           (== @ 32)
                           (and
                              (== @ (char "."))
                              (=0 (val (inc P))) )
                           (and (currentLine) (=0 (strcmp @ P))) )
                        (add_history P) ) )
                  (nond
                     ((val P)
                        (set $LinePtr null)
                        (char "\n") )
                     (NIL
                        (set $LinePtr (inc P))
                        (i32 @) ) ) ) ) ) ) ) )

(de i32 getChar ((i32 . C))
   (cond
      ((>= 127 C) C)  # Single byte
      ((== C (hex "FF")) (i32 TOP))  # Infinite
      (T
         (let B
            (ifn (& C (hex "20"))  # Two bytes
               (& C (hex "1F"))  # First byte 110xxxxx
               (let A
                  (ifn (& C (hex "10"))  # Three bytes
                     (& C (hex "0F"))  # First byte 1110xxxx
                     (|  # Four bytes
                        (shl (& C 7) 6)  # First byte 11110xxx
                        (& (call $Get) (hex "3F")) ) )  # 10xxxxxx
                  (| (shl A 6) (& (call $Get) (hex "3F"))) ) )
            (| (shl B 6) (& (call $Get) (hex "3F"))) ) ) ) )

# Skip White Space and Comments
(de i32 skipc ((i32 . C))
   (let Chr (val $Chr)
      (loop
         (while (>= 32 Chr)  # White space
            (when (lt0 (setq Chr (call $Get)))
               (ret Chr) ) )
         (unless (== Chr C)
            (ret Chr) )
         (until (== (setq Chr (call $Get)) (char "\n"))
            (when (lt0 Chr)
               (ret Chr) ) )
         (setq Chr (call $Get)) ) ) )

(de void comment ()
   (let Chr (call $Get)
      (if (== Chr (char "{"))
         (let N 0
            (loop
               (? (lt0 (setq Chr (call $Get))))
               (if
                  (and
                     (== Chr (char "#"))
                     (== (setq Chr (call $Get)) (char "{")) )
                  (inc 'N)
                  (?
                     (and
                        (== Chr (char "}"))
                        (== (setq Chr (call $Get)) (char "#"))
                        (lt0 (dec 'N)) ) ) ) ) )
         (until (== Chr (char "\n"))
            (? (lt0 Chr))
            (setq Chr (call $Get)) ) )
      (call $Get) ) )

(de i32 skip ()
   (loop
      (let Chr (val $Chr)
         (when (lt0 Chr)
            (ret Chr) )
         (while (>= (char " ") Chr)
            (when (lt0 (setq Chr (call $Get)))
               (ret Chr) ) )
         (unless (== Chr (char "#"))
            (ret Chr) )
         (comment) ) ) )

(local) (uniChr testEsc anonymous rdAtom rdl rdList)

(de i32 uniChr ((i32 . Chr))
   (when (and (>= Chr (char "0")) (>= (char "9") Chr))
      (dec 'Chr (char "0"))
      (until (== (call $Get) (char "\\"))
         (unless
            (and
               (>= (val $Chr) (char "0"))
               (>= (char "9") (val $Chr)) )
            (badInput) )
         (setq Chr
            (+ (* Chr 10) (- (val $Chr) (char "0"))) ) ) )
   Chr )

(de i1 testEsc ((i32 . Chr))
   (loop
      (? (lt0 Chr) NO)
      (? (== Chr (char "\^"))  # Control character
         (when (== (setq Chr (call $Get)) (char "@"))
            (badInput) )
         (set $Chr
            (if (== Chr (char "?"))
               127
               (& Chr (hex "1F")) ) )
         YES )
      (? (<> Chr (char "\\"))  # No Backslash
         (set $Chr (getChar Chr))
         YES )
      (? (<> (char "\n") (setq Chr (call $Get)))  # Backslash: Skip '\'
         (case Chr
            ((char "b") (set $Chr (char "\b")))
            ((char "e") (set $Chr (char "\e")))
            ((char "n") (set $Chr (char "\n")))
            ((char "r") (set $Chr (char "\r")))
            ((char "t") (set $Chr (char "\t")))
            (T (set $Chr (uniChr Chr))) )
         YES )
      (loop
         (setq Chr (call $Get))
         (?
            (and
               (<> Chr (char " "))
               (<> Chr (char "\t")) ) ) ) ) )

(de anonymous (Nm)
   (let P (push 0 Nm)  # [cnt name]
      (unless (== (symByte P) (char "$"))  # Starting with '$'
         (ret 0) )
      (let B (- (symByte P) (char "0"))
         (unless (>= 7 B)  # Octal Digit
            (ret 0) )
         (let N (i64 B)
            (loop
               (? (=0 (symByte P))
                  (sym (shl N 4)) )  # Make symbol pointer
               (? (> (- @ (char "0")) 7) 0)
               (setq N (| (i64 @) (shl N 3))) ) ) ) ) )

(de rdAtom ((i32 . Chr))
   (let
      (Int (save (val $Intern))  # Current symbol namespaces
         P (push 4 NIL ZERO NIL)  # [cnt last name link]
         C (val $Chr) )
      (when
         (and
            (== Chr (char "%"))
            (== C (char "~")) )
         (when (nil? (cdr Int))
            (symNspErr 0 $rem) )
         (set $Intern @)
         (setq Chr (call $Get)  C (call $Get)) )
      (link (ofs P 2))
      (byteSym (i8 Chr) P)  # Pack first byte
      (setq Chr C)
      (while (ge0 Chr)
         (if (== Chr (char "~"))  # Namespace
            (let S (requestSym (val 3 P))  # Find or create symbol
               (needNsp 0 S)
               (set (set $Intern (any $Cell)) S)  # Switch symbol namespace
               (set P 4  3 P ZERO) )  # Build new name
            (? (strchr $Delim Chr))
            (when (== Chr (char "\\"))
               (setq Chr (uniChr (call $Get))) )
            (byteSym (i8 Chr) P) )
         (setq Chr (call $Get)) )
      (prog1
         (let (Nm (val 3 P)  L (val $Intern))
            (cond
               ((== Nm ZERO) (badInput))
               ((== L (any $Cell))
                  (intern 0 $Nil Nm (cdar (car @)) $Nil NO) )
               ((symToNum Nm (int (val $Scl)) (char ".") 0) @)
               ((anonymous Nm) @)
               ((and (== (car L) $priv) (nil? (cdr L)))
                  (intern (consSym Nm $Nil) 0 Nm $PrivT $Nil YES) )
               (T (requestSym Nm)) ) )
         (set $Intern Int) ) ) )

(de void rdl (R P)
   (loop
      (? (== (skip) (char ")"))
         (call $Get) )
      (? (== @ (char "]")))
      (cond
         ((== @ (char "."))
            (? (strchr $Delim (call $Get))
               (setq P
                  (set 2 P
                     (if
                        (or
                           (== (skip) (char ")"))
                           (== @ (char "]")) )
                        R
                        (read0 NO) ) ) )
               (cond
                  ((== (skip) (char ")"))
                     (call $Get) )
                  ((<> (val $Chr) (char "]"))
                     (err 0 P ($ "Bad dotted pair") null) ) ) )
            (setq P
               (set 2 P (cons (rdAtom (char ".")) $Nil)) ) )
         ((== @ (char "~"))
            (call $Get)
            (let (X (save (read0 NO))  R (eval X))
               (cond
                  ((nil? R))
                  ((atom R)
                     (set 2 P (cons R $Nil))
                     (shift P) )
                  (T
                     (set 2 P R)
                     (while (pair (cdr P))
                        (shift P) ) ) ) ) )
         (T
            (setq P
               (set 2 P (cons (read0 NO) $Nil)) ) ) ) ) )

(de rdList ()
   (stkChk 0)
   (call $Get)
   (save -ZERO)
   (loop
      (? (== (skip) (char ")"))  # Empty list
         (call $Get)
         $Nil )
      (? (== @ (char "]")) $Nil)  # Empty list
      (? (<> @ (char "~"))  # Read macro
         (let R (safe (cons (read0 NO) $Nil))
            (rdl R R)
            R ) )
      (call $Get)
      (let (X (safe (read0 NO))  R (eval X))
         (? (not (nil? R))
            (if (atom (safe R))
               (rdl (safe (setq R (cons R $Nil))) R)
               (let L R
                  (while (pair (cdr L))
                     (setq L @) )
                  (rdl R L) ) )
            R ) ) ) )

(de read0 ((i1 . Top))
   (let C (skip)
      (when Top
         (let In: (inFile (val $InFile))
            (In: src (In: line)) ) )
      (cond
         ((lt0 C)
            (unless Top (eofErr))
            $Nil )
         ((== C (char "("))
            (prog1
               (rdList)
               (and
                  Top
                  (== (val $Chr) (char "]"))
                  (call $Get) ) ) )
         ((== C (char "["))
            (let X (rdList)
               (unless (== (val $Chr) (char "]"))
                  (err 0 X ($ "Super parentheses mismatch") null) )
               (call $Get)
               X ) )
         ((== C (char "'"))
            (call $Get)
            (cons $Quote (read0 Top)) )
         ((== C (char ","))
            (call $Get)
            (let
               (Tr1 (save (val $Transient))
                  Tr2 (save (val 2 $Transient)) )
               (set $Transient (set 2 $Transient $Nil))
               (prog1
                  (let X (read0 Top)
                     (if (t? (val $Uni))
                        X
                        (save X
                           (if (pair (idxPut $Uni X $T))
                              (car @)
                              X ) ) ) )
                  (set 2 $Transient Tr2)
                  (set $Transient Tr1) ) ) )
         ((== C (char "`"))
            (call $Get)
            (let E (read0 Top)
               (save E
                  (eval E) ) ) )
         ((== C (char "\""))
            (if (== (setq C (call $Get)) (char "\""))
               (prog (call $Get) $Nil)  # Empty string
               (unless (testEsc C) (eofErr))
               (let
                  (P (push 4 NIL ZERO NIL)  # [cnt last name link]
                     Q (link (ofs P 2)) )
                  (loop
                     (charSym (val $Chr) P)
                     (? (== (setq C (call $Get)) (char "\"")))
                     (unless (testEsc C) (eofErr)) )
                  (call $Get)  # Skip "\""
                  (drop Q
                     (intern 0 0 (val Q) $Transient $Nil NO) ) ) ) )
         ((== C (char "{"))
            (prog1
               (if (== (setq C (call $Get)) (char "}"))
                  (consSym ZERO $Nil)  # Empty: New anonymous symbol
                  (let F (i32 0)  # File number
                     (while (>= C (char "@"))
                        (when (> C (char "O"))  # A-O range
                           (badInput) )
                        (setq
                           F (| (shl F 4) (- C (char "@")))
                           C (call $Get) ) )
                     (let N 0  # Id
                        (loop
                           (unless (and (>= C (char "0")) (>= (char "7") C))
                              (badInput) )
                           (setq N
                              (|
                                 (shl N 3)
                                 (i64 (- C (char "0"))) ) )
                           (? (== (setq C (call $Get)) (char "}"))) )
                        (extern (extNm F N)) ) ) )
               (call $Get) ) )  # Skip "}"
         ((or (== C (char ")")) (== C (char "]")) (== C (char "~")))
            (badInput) )
         (T
            (when (== C (char "\\"))
               (call $Get) )
            (setq C (val $Chr))
            (call $Get)
            (rdAtom C) ) ) ) )

(local) (read1 noToken token)

(de read1 ((i32 . End))
   (unless (val $Chr)
      (call $Get) )
   (if (== End (val $Chr))
      $Nil
      (read0 YES) ) )

(inline noToken (C Set)
   (not
      (or
         (== C (char "\\"))
         (and (>= (char "z") C) (>= C (char "a")))
         (and (>= (char "Z") C) (>= C (char "A")))
         (strchr Set C) ) ) )

(de token (Set (i32 . Cmt))
   (let C (if (val $Chr) @ (call $Get))
      (cond
         ((lt0 (skipc Cmt)) 0)  # Skip white space and comments
         ((== (setq C @) (char "\""))
            (cond
               ((== (setq C (call $Get)) (char "\""))  # Empty string
                  (call $Get)
                  $Nil )
               ((not (testEsc C)) $Nil)
               (T
                  (let
                     (Y (cons (mkChar (val $Chr)) $Nil)
                        R (save Y) )
                     (loop
                        (? (== (setq C (call $Get)) (char "\""))
                           (call $Get) )  # Skip "\""
                        (? (not (testEsc C)))
                        (setq Y
                           (set 2 Y (cons (mkChar (val $Chr)) $Nil)) ) )
                     R ) ) ) )
         ((and (>= (char "9") C) (>= C (char "0")))
            (let P (push 4 NIL ZERO NIL)  # [cnt last name link]
               (link (ofs P 2) T)
               (loop
                  (byteSym (i8 C) P)
                  (?
                     (and
                        (<> (setq C (call $Get)) (char "."))
                        (or (> (char "0") C) (> C (char "9"))) ) ) )
               (symToNum
                  (val 3 P)
                  (int (val $Scl))
                  (char ".")
                  0 ) ) )
         (T
            (let
               (Nm (xName Set)
                  S (bufString Nm (b8 (bufSize Nm))) )
               (if
                  (or
                     (== C (char "+"))
                     (== C (char "-"))
                     (noToken C S) )
                  (prog1
                     (mkChar (getChar C))
                     (call $Get) )
                  (when (== C (char "\\"))
                     (call $Get) )
                  (let P (push 4 NIL ZERO NIL)  # [cnt last name link]
                     (link (ofs P 2) T)
                     (loop
                        (byteSym (i8 C) P)
                        (?
                           (and
                              (noToken (setq C (call $Get)) S)
                              (or (> (char "0") C) (> C (char "9"))) ) )
                        (when (== C (char "\\"))
                           (call $Get) ) )
                     (requestSym (val 3 P)) ) ) ) ) ) ) )

# (read ['sym1 ['sym2]]) -> any
(de _Read (Exe)
   (let X (cdr Exe)
      (prog1
         (if (atom X)
            (read1 0)
            (let Y (save (needSymb Exe (eval (++ X))))
               (if (token Y (firstChar (needSymb Exe (eval (car X)))))
                  @
                  $Nil ) ) )
         (and
            (== (val $Chr) (char "\n"))
            (== (val $InFile) (val (val $InFiles)))  # Stdin
            (set $Chr 0) ) ) ) )

# (key ['cnt ['var]]) -> sym
(de _Key (Exe)
   (flushAll)
   (let
      (X (cdr Exe)
         Cnt
         (if (nil? (eval (++ X)))
            292MY
            (xCnt Exe @) )
         Var
         (save
            (if (nil? (eval (car X)))
               -ZERO
               (needChkVar Exe @) ) )
         Raw (val Termio) )
      (prog2
         (setRaw)
         (if (waitFd Exe 0 Cnt)
            (let (Ms @  C (stdinByte))
               (unless (== Var -ZERO)
                  (set Var (cnt Ms)) )
               (mkChar
                  (cond
                     ((>= 127 C) C)  # Single byte
                     ((== C (hex "FF")) (i32 TOP))  # Infinite
                     (T
                        (let B
                           (ifn (& C (hex "20"))  # Two bytes
                              (& C (hex "1F"))  # First byte 110xxxxx
                              (let A
                                 (ifn (& C (hex "10"))  # Three bytes
                                    (& C (hex "0F"))  # First byte 1110xxxx
                                    (|  # Four bytes
                                       (shl (& C 7) 6)  # First byte 11110xxx
                                       (& (stdinByte) (hex "3F")) ) )  # 10xxxxxx
                                 (| (shl A 6) (& (stdinByte) (hex "3F"))) ) )
                           (| (shl B 6) (& (stdinByte) (hex "3F"))) ) ) ) ) )
            $Nil )
         (unless Raw
            (setCooked) ) ) ) )

# (peek) -> sym
(de _Peek (Exe)
   (let C (if (val $Chr) @ (call $Get))
      (if (lt0 C) $Nil (mkChar C)) ) )

# (char) -> sym
# (char 'cnt) -> sym
# (char T) -> sym
# (char 'sym) -> cnt
(de _Char (Exe)
   (let X (cdr Exe)
      (cond
         ((atom X)
            (let Chr (if (val $Chr) @ (call $Get))
               (prog1
                  (if (lt0 Chr)
                     $Nil
                     (mkChar (getChar Chr)) )
                  (call $Get) ) ) )
         ((cnt? (eval (car X)))
            (if (int @)
               (mkChar (i32 @))
               $Nil ) )
         ((t? @) (mkChar TOP))
         ((symb? @) (cnt (i64 (firstChar @))))
         (T (atomErr Exe @)) ) ) )

# (skip ['any]) -> sym
(de _Skip (Exe)
   (if (lt0 (skipc (firstChar (evSym (cdr Exe)))))
      $Nil
      (mkChar @) ) )

# (eol) -> flg
(de _Eol (Exe)
   (let C (if (val $Chr) @ (call $Get))
      (if (or (le0 C) (== C (char "\n")))
         $T
         $Nil ) ) )

# (eof ['flg]) -> flg
(de _Eof (Exe)
   (nond
      ((nil? (eval (cadr Exe)))
         (set $Chr -1)
         $T )
      ((=0 (val $Chr))
         (if (lt0 @) $T $Nil) )
      (NIL
         (if (lt0 (call $Get)) $T $Nil) ) ) )

# (from 'any ..) -> sym
(de _From (Exe)
   (let
      (X (cdr Exe)
         N 1
         Y (evSym X)
         Nm (xName Y)
         L
         (link
            (push Y NIL 0  # [sym link ix str]
               (any (bufString Nm (b8 (bufSize Nm)))) ) )
         P L )
      (while (pair (shift X))
         (setq
            Y (evSym X)
            Nm (xName Y)
            L
            (link
               (push Y NIL 0  # [sym link ix str]
                  (any (bufString Nm (b8 (bufSize Nm)))) ) ) )
         (inc 'N) )
      (unless (val $Chr)
         (call $Get) )
      (while (ge0 (val $Chr))
         (let (B (i8 @)  Q (i64* L)  I N)
            (loop
               (loop
                  (let S (ofs (i8* (val 4 Q)) (val 3 Q))
                     (when (== B (val S))  # Bytes match
                        (set 3 Q (inc (val 3 Q)))  # Increment index
                        (? (val 2 S))  # Not end of string
                        (call $Get) # Skip next input byte
                        (drop P)
                        (ret (val Q)) ) )  # Return matched symbol
                  (? (=0 (val 3 Q)))  # Still at beginning of string
                  (let S (ofs (i8* (val 4 Q)) 1)  # Pointer to second byte
                     (while (set 3 Q (dec (val 3 Q)))  # Decrement index
                        (? (=0 (memcmp (i8* (val 4 Q)) S @)))
                        (inc 'S) ) ) )
               (? (=0 (dec 'I)))
               (setq Q (i64* (val 2 Q))) ) )
         (call $Get) )
      (drop P)
      $Nil ) )

# (till 'any ['flg]) -> lst|sym
(de _Till (Exe)
   (let
      (X (cdr Exe)
         Nm (xName (evSym X))
         S (bufString Nm (b8 (bufSize Nm))) )
      (let C (if (val $Chr) @ (call $Get))
         (cond
            ((or (lt0 C) (strchr S C))
               $Nil )
            ((nil? (eval (cadr X)))
               (let
                  (Y (cons (mkChar (getChar C)) $Nil)
                     R (save Y) )
                  (until
                     (or
                        (le0 (setq C (call $Get)))
                        (strchr S C) )
                     (setq Y
                        (set 2 Y (cons (mkChar (getChar C)) $Nil)) ) )
                  R ) )
            (T
               (let
                  (P (push 4 NIL ZERO NIL)  # [cnt last name link]
                     Q (link (ofs P 2)) )
                  (loop
                     (charSym (getChar C) P)
                     (? (le0 (setq C (call $Get))))
                     (? (strchr S C)) )
                  (drop Q
                     (consStr (val 3 P)) ) ) ) ) ) ) )

(local) eol

(de i1 eol ((i32 . C))
   (cond
      ((lt0 C) YES)
      ((== C (char "\n"))
         (set $Chr 0)
         YES )
      ((== C (char "\r"))
         (when (== (call $Get) (char "\n"))
            (set $Chr 0) )
         YES )
      (T NO) ) )

# (line 'flg ['cnt ..]) -> lst|sym
(de _Line (Exe)
   (let C (if (val $Chr) @ (call $Get))
      (if (eol C)
         $Nil
         (let X (cdr Exe)
            (cond
               ((nil? (eval (++ X)))
                  (let  # List of characters
                     (Y (cons (mkChar (getChar C)) $Nil)
                        R (save Y) )
                     (when (pair X)
                        (let Z (set Y (cons (car Y) $Nil))
                           (loop
                              (let N (evCnt Exe X)
                                 (while (gt0 (dec 'N))
                                    (when (eol (setq C (call $Get)))
                                       (ret R) )
                                    (setq Z
                                       (set 2 Z (cons (mkChar (getChar C)) $Nil)) ) ) )
                              (? (atom (shift X)))
                              (when (eol (setq C (call $Get)))
                                 (ret R) )
                              (setq Y
                                 (set 2 Y
                                    (cons
                                       (setq Z (cons (mkChar (getChar C)) $Nil))
                                       $Nil ) ) ) ) ) )
                     (until (eol (setq C (call $Get)))
                        (setq Y
                           (set 2 Y (cons (mkChar (getChar C)) $Nil)) ) )
                     R ) )
               ((atom X)  # Pack single string
                  (let
                     (P (push 4 NIL ZERO NIL)  # [cnt last name link]
                        Q (link (ofs P 2)) )
                     (loop
                        (charSym (getChar C) P)
                        (? (eol (setq C (call $Get)))) )
                     (drop Q
                        (consStr (val 3 P)) ) ) )
               (T
                  (let
                     (N (evCnt Exe X)
                        P (push 4 NIL ZERO NIL)  # [cnt last name link]
                        Q (link (ofs P 2) T) )
                     (loop
                        (charSym (getChar C) P)
                        (when (eol (setq C (call $Get)))
                           (ret (cons (consStr (val Q)) $Nil)) )
                        (? (=0 (dec 'N))) )
                     (let
                        (Y (cons (consStr (val Q)) $Nil)
                           R (save Y) )
                        (while (pair (shift X))
                           (setq N (evCnt Exe X))
                           (set P 4  3 P ZERO)
                           (loop
                              (charSym (getChar C) P)
                              (when (eol (setq C (call $Get)))
                                 (set 2 Y (cons (consStr (val Q)) $Nil))
                                 (ret R) )
                              (? (=0 (dec 'N))) )
                           (setq Y
                              (set 2 Y (cons (consStr (val Q)) $Nil)) ) )
                        (loop
                           (setq Y
                              (set 2 Y (cons (mkChar (getChar C)) $Nil)) )
                           (? (eol (setq C (call $Get)))) )
                        R ) ) ) ) ) ) ) )

# (in 'any . prg) -> any
(de _In (Exe)
   (let X (cdr Exe)
      (rdOpen Exe (eval (++ X)) (b8+ (ioFrame T)))
      (prog1
         (run X)
         (popInFiles) ) ) )

# (out 'any . prg) -> any
(de _Out (Exe)
   (let X (cdr Exe)
      (wrOpen Exe (eval (++ X)) (b8+ (ioFrame T)))
      (prog1
         (run X)
         (popOutFiles) ) ) )

# (err 'sym . prg) -> any
(de _Err (Exe)
   (let X (cdr Exe)
      (erOpen Exe (eval (++ X)) (b8+ (ctFrame T)))
      (prog1
         (run X)
         (popErrFiles) ) ) )

# (ctl 'sym . prg) -> any
(de _Ctl (Exe)
   (let X (cdr Exe)
      (ctOpen Exe (eval (++ X)) (b8+ (ctFrame T)))
      (prog1
         (run X)
         (popCtlFiles) ) ) )

(local) (pushInput pushOutput)

(de void pushInput ((i8* . Iox) Exe)
   (let Iox: (ioxFrame Iox)
      (Iox: link (val $InFrames))
      (Iox: file null)
      (Iox: fun (val (i8** $Get)))
      (Iox: exe Exe)
      (Iox: chr (val $Chr))
      (set
         $InFrames (Iox:)
         $Get (fun (i32) getIn)
         $InChar 0
         $Chr 0 ) ) )

(de void pushOutput ((i8* . Iox) Exe)
   (let Iox: (ioxFrame Iox)
      (Iox: link (val $OutFrames))
      (Iox: file null)
      (Iox: fun (val (i8** $Put)))
      (Iox: exe Exe)
      (Iox: chr 0)
      (set $OutFrames (Iox:)  $Put (fun (void i8) putOut)) ) )

# (input exe . prg) -> any
(de _Input (Exe)
   (let X (cdr Exe)
      (pushInput (b8+ (ioxFrame T)) (++ X))
      (prog1
         (run X)
         (popInFiles) ) ) )

# (output exe . prg) -> any
(de _Output (Exe)
   (let X (cdr Exe)
      (pushOutput (b8+ (ioxFrame T)) (++ X))
      (prog1
         (run X)
         (popOutFiles) ) ) )

# (fd ['cnt]) -> cnt
(de _Fd (Exe)
   (let (X (eval (cadr Exe))  Fd (currFd Exe))
      (unless (nil? X)
         (dup2 Fd (i32 (xCnt Exe X))) )
      (cnt (i64 Fd)) ) )

(local) forkLisp

(de i32 forkLisp (Exe)
   (flushAll)
   (unless (val $Spkr)  # Not listening for children yet
      (when (lt0 (pipe $SpMiPipe))  # Open speaker/microphone pipe
         (pipeErr Exe) )
      (closeOnExec Exe (set $Spkr (val $SpMiPipe)))
      (closeOnExec Exe (val 2 $SpMiPipe)) )
   (let (Hear (b32 2)  Tell (b32 2))
      (when (or (lt0 (pipe Hear)) (lt0 (pipe Tell)))
         (pipeErr Exe) )
      (closeOnExec Exe (val Hear))  # Read end of 'hear'
      (closeOnExec Exe (val 2 Hear))  # Write end
      (closeOnExec Exe (val Tell))  # Read end of 'tell'
      (closeOnExec Exe (val 2 Tell))  # Write end
      (let (I (i32 0)  N (val $Children))
         (let Cld (val $Child)
            (while (> N I)  # Find a free child slot
               (? (=0 ((child Cld) pid)))
               (inc 'I)
               (setq Cld (ofs Cld (child T))) ) )
         (cond
            ((lt0 (fork)) (forkErr Exe))
            ((=0 @)  # In child
               (set
                  $Slot I  # Set child index
                  $Spkr 0  # No children yet
                  $Mic (val 2 $SpMiPipe) )  # Set microphone to write end
               (close (val 2 Hear))  # Close write end of 'hear'
               (close (val Tell))  # Close read end of 'tell'
               (close (val $SpMiPipe))  # Close read end
               (when (val $Hear)
                  (close @)
                  (closeInFile @)
                  (closeOutFile @) )
               (initInFile (set $Hear (val Hear)) null)  # Read end of 'hear'
               (when (val $Tell)  # Telling
                  (close @) )
               (set $Tell (val 2 Tell))  # Write end of 'tell'
               (set $Nfds 0)   # Clear poll entries
               (free (i8* (val $Poll)))
               (set $Poll (i64* null))
               (let Cld (val $Child)
                  (while (ge0 (dec 'N))  # Close children
                     (let Cld: (child Cld)
                        (when (Cld: pid)
                           (free (Cld: buf))
                           (close (Cld: hear))
                           (close (Cld: tell)) ) )
                     (setq Cld (ofs Cld (child T))) ) )
               (set $Children 0)  # No children
               (free (val $Child))
               (set $Child null)
               (let In (val $InFrames)  # Clear pids in InFrames
                  (while In
                     (let In: (ioFrame In)
                        (when (In: file)
                           (In: pid 0) )
                        (setq In (In: link)) ) ) )
               (let Out (val $OutFrames)  # Clear pids in OutFrames
                  (while Out
                     (let Out: (ioFrame Out)
                        (when (Out: file)
                           (Out: pid 0) )
                        (setq Out (Out: link)) ) ) )
               (let Ca (val $Catch)  # Clear 'finally' expressions in Catch frames
                  (while Ca
                     (let Ca: (caFrame Ca)
                        (Ca: fin ZERO)
                        (setq Ca (Ca: link)) ) ) )
               (let R (val $Run)  # Switch off all tasks
                  (while (pair R)
                     (let X (++ R)
                        (unless (sign? (car X))
                           (let Fd (i32 (int @))
                              (close Fd)
                              (closeInFile Fd)
                              (closeOutFile Fd) ) ) ) ) )
               (set $Bye $Nil)
               (set $Run $Nil)
               (free (val Termio))  # Give up terminal control
               (set Termio null)
               (set
                  $PRepl (val $Repl)  # Set parent REPL flag
                  $PPid (val $Pid) )  # Set parent process ID
               (set $Pid (cnt (i64 (getpid))))  # Set new process ID
               (execAt (val $Fork))  # Run '*Fork'
               (set $Fork $Nil)
               0 )
            (T  # In parent
               (let Pid @
                  (when (== I N)  # Children table full
                     (set $Children (inc 'N 8))  # Eight more slots
                     (let P
                        (set $Child
                           (alloc (val $Child) (i64 (* N (child T)))) )
                        (let Cld (ofs P (* I (child T)))
                           (loop
                              ((child Cld) pid 0)  # Clear 'pid'
                              (? (== I (dec 'N)))
                              (setq Cld (ofs Cld (child T))) ) ) ) )
                  (close (val Hear))  # Close read end of 'hear'
                  (close (val 2 Tell))  # Close write end of 'tell'
                  (let Cld: (child (ofs (val $Child) (* I (child T))))  # Free 'child' entry
                     (Cld: buf null)  # No buffer yet
                     (Cld: ofs (Cld: cnt 0))  # Init buffer offset and count
                     (Cld: pid Pid)  # Set 'pid'
                     (Cld: hear (val Tell))  # Read end of 'tell'
                     (nonBlocking (Cld: tell (val 2 Hear))) )  # Write end of 'hear'
                  Pid ) ) ) ) ) )

# (pipe exe) -> cnt
# (pipe exe . prg) -> any
(de _Pipe (Exe)
   (let
      (X (cdr Exe)
         E (++ X)
         Pfd (b32 2)
         Io: (ioFrame (b8+ (ioFrame T))) )
      (when (lt0 (if (pair X) (pipe Pfd) (socketPair Pfd)))
         (pipeErr Exe) )
      (when (< (val 2 Pfd) 2)  # pfd[1]
         (pipeErr Exe) )
      (if (forkLisp Exe)
         (let Pid @  # In parent
            (close (val 2 Pfd))  # Close write end
            (let Fd (val Pfd)  # Read end
               (closeOnExec Exe Fd)
               (cond
                  ((atom X)  # No 'prg'
                     (initInFile Fd null)
                     (initOutFile Fd)
                     (cnt (i64 Fd)) )
                  (T
                     (setpgid Pid 0)  # Set process group
                     (pushInFile (Io:) (initInFile Fd null) Pid)
                     (prog1
                        (run X)
                        (popInFiles) ) ) ) ) )
         # In child
         (close (val Pfd))  # Close read end
         (let Fd (val 2 Pfd)  # Write end
            (if (pair X)  # 'prg'
               (setpgid 0 0)  # Set process group
               (dup2 Fd 0)  # Dup write pipe to STDIN_FILENO
               ((inFile (val (val $InFiles))) tty NO) )  # Clear 'tty' in stdin
            (dup2 Fd 1)  # Dup write pipe to STDOUT_FILENO
            (close Fd) )
         (signal (val SIGPIPE Sig) (val SigDfl))  # Default SIGPIPE
         ((outFile (val $OutFile)) tty NO)  # Clear 'tty'
         (pushOutFile (Io:) (val 2 (val $OutFiles)) 0)  # Stdout
         (set $LinePtr null)  # Switch off line editor
         (when (pair E)  # Evaluate 'exe'
            (evList E) )
         (bye 0) ) ) )

# (open 'any ['flg]) -> cnt | NIL
(de _Open (Exe)
   (let
      (X (cdr Exe)
         Nm (xName (evSym X))
         S (pathString Nm (b8 (pathSize Nm)))
         Flg (nil? (eval (cadr X))) )
      (loop
         (? (ge0 (if Flg (openRdWrCreate S) (openRd S)))
            (closeOnExec Exe @)
            (initInFile @ (strdup S))
            (initOutFile @)
            (cnt (i64 @)) )
         (? (<> (gErrno) EINTR) $Nil)
         (sigChk Exe) ) ) )

# (close 'cnt) -> cnt | NIL
(de _Close (Exe)
   (let
      (X (eval (cadr Exe))
         Fd (i32 (xCnt Exe X)) )
      (loop
         (? (=0 (close Fd))
            (closeInFile Fd)
            (closeOutFile Fd)
            X )
         (? (<> (gErrno) EINTR) $Nil)
         (sigChk Exe) ) ) )

# (echo ['cnt ['cnt]] | ['sym ..]) -> sym
(de _Echo (Exe)
   (let (X (cdr Exe)  Y (eval (++ X)))
      (cond
         ((and (nil? Y) (atom X))
            (let C (if (val $Chr) @ (call $Get))
               (until (lt0 C)
                  (call $Put (i8 C))
                  (setq C (call $Get)) ) )
            $T )
         ((num? Y)
            (let N (xCnt Exe Y)
               (when (pair X)
                  (let C (evCnt Exe X)
                     (while (ge0 (dec 'N))
                        (when (lt0 (call $Get))
                           (ret $Nil) ) )
                     (setq N C) ) )
               (while (ge0 (dec 'N))
                  (when (lt0 (call $Get))
                     (ret $Nil) )
                  (call $Put (i8 @)) )
               (set $Chr 0)
               $T ) )
         ((pair Y) (argErr Exe Y))
         (T  # sym
            (let
               (M (i64* null)
                  N 1
                  Nm (xName Y)
                  L
                  (link
                     (push Y NIL 0  # [sym link ix str]
                        (any (bufString Nm (b8 (bufSize Nm)))) ) )
                  P L )
               (while (pair X)
                  (setq
                     Y (evSym (++ X))
                     Nm (xName Y)
                     L
                     (link
                        (push Y NIL 0  # [sym link ix str]
                           (any (bufString Nm (b8 (bufSize Nm)))) ) ) )
                  (inc 'N) )
               (unless (val $Chr)
                  (call $Get) )
               (while (ge0 (val $Chr))
                  (let
                     (B (i8 @)
                        Q (i64* L)
                        I N
                        OutM M
                        OutC (if M (val 3 M) 0) )
                     (loop
                        (loop
                           (let S (ofs (i8* (val 4 Q)) (val 3 Q))
                              (when (== B (val S))  # Bytes match
                                 (set 3 Q (inc (val 3 Q)))  # Increment index
                                 (? (val 2 S)  # Not end of string
                                    (unless (and M (>= (val 3 M) (val 3 Q)))
                                       (setq M Q) ) )
                                 (when OutM
                                    (setq S (i8* (val 4 OutM)))
                                    (dec 'OutC (val 3 Q))
                                    (until (lt0 OutC)
                                       (call $Put (val S))
                                       (inc 'S)
                                       (dec 'OutC) ) )
                                 (set $Chr 0)  # Clear look ahead
                                 (drop P)
                                 (ret (val Q)) ) )  # Return matched symbol
                           (? (=0 (val 3 Q)))  # Still at beginning of string
                           (let S (ofs (i8* (val 4 Q)) 1)  # Pointer to second byte
                              (while (set 3 Q (dec (val 3 Q)))  # Decrement index
                                 (? (=0 (memcmp (i8* (val 4 Q)) S @)))
                                 (inc 'S) ) )
                           (when (== Q M)  # On current max
                              (setq M (i64* null))
                              (let (Z (i64* L)  J N)
                                 (loop
                                    (when (val 3 Z)
                                       (unless (and M (>= (val 3 M) (val 3 Z)))
                                          (setq M Z) ) )
                                    (? (=0 (dec 'J)))
                                    (setq Z (i64* (val 2 Z))) ) ) ) )
                        (? (=0 (dec 'I)))
                        (setq Q (i64* (val 2 Q))) )
                     (cond
                        ((=0 M)
                           (when OutM
                              (let (S (i8* (val 4 OutM))  C OutC)
                                 (loop
                                    (call $Put (val S))
                                    (inc 'S)
                                    (? (=0 (dec 'C))) ) ) )
                           (call $Put B) )
                        (OutM
                           (let S (i8* (val 4 OutM))
                              (dec 'OutC (val 3 M))
                              (until (lt0 OutC)
                                 (call $Put (val S))
                                 (inc 'S)
                                 (dec 'OutC) ) ) ) ) )
                  (call $Get) )
               (drop P)
               $Nil ) ) ) ) )

(de void _putStdout ((i8 . B))
   (let Out: (outFile (val $OutFile))
      (when (Out:)
         (let I (Out: ix)
            (when (== I BUFSIZ)
               (Out: ix (setq I 0))
               (wrBytes (Out: fd) (Out: (buf)) BUFSIZ) )
            (set (ofs (Out: (buf)) I) B)
            (Out: ix (inc 'I))
            (when (and (== B (char "\n")) (Out: tty))
               (Out: ix 0)
               (wrBytes (Out: fd) (Out: (buf)) I) ) ) ) ) )

(local) (newline space)

(de void newline ()
   (call $Put (char "\n")) )

(de void space ()
   (call $Put (char " ")) )

(local) (outWord outNum outOct outAo bufAo prExt)

# Output decimal number
(de void outWord ((i64 . N))
   (when (> N 9)
      (outWord (/ N 10))
      (setq N (% N 10)) )
   (call $Put (+ (i8 N) (char "0"))) )

(de void outNum (X)
   (when (sign? X)
      (call $Put (char "-")) )
   (outWord (shr (i64 X) 4)) )

# Output octal number
(de void outOct ((i64 . N))
   (when (> N 7)
      (outOct (shr N 3))
      (setq N (& N 7)) )
   (call $Put (+ (i8 N) (char "0"))) )

# Output A-O encoding
(de void outAo ((i32 . N))
   (when (> N 15)
      (outAo (shr N 4))
      (setq N (& N 15)) )
   (call $Put (+ (i8 N) (char "@"))) )

# Append A-O encoding to buffer
(de i8* bufAo ((i8* . P) (i32 . N))
   (when (> N 15)
      (setq
         P (bufAo P (shr N 4))
         N (& N 15) ) )
   (set P (+ (i8 N) (char "@")))
   (inc P) )

# Output external symbol name
(de void prExt (Nm)
   (when (objFile Nm)
      (outAo @) )
   (outOct (objId Nm)) )

(local) (outString prName prSym printName printSym)

# Output string
(de void outString ((i8* . S))
   (while (val S)
      (call $Put @)
      (inc 'S) ) )

(de void prName (Nm)
   (let P (push 0 Nm)  # [cnt name]
      (while (symByte P)
         (call $Put @) ) ) )

(de void prSym (Sym)
   (prName (name (val (tail Sym)))) )

(de void printName (Nm)
   (ifn (== Nm (hex "2E2"))  # Dot
      (let (P (push 0 Nm)  B (symByte P))  # [cnt name]
         (when (== B (char "#"))
            (call $Put (char "\\")) )  # Escape leading hash
         (loop
            (if (or (== B 127) (> 32 B))  # DEL or Ctrl
               (prog
                  (call $Put (char "\\"))  # Unicode
                  (outWord (i64 B))
                  (call $Put (char "\\")) )
               (when
                  (or
                     (== B (char "\\"))
                     (strchr $Delim (i32 B)) )
                  (call $Put (char "\\")) )  # Escape backslash and delimiters
               (call $Put B) )
            (? (=0 (setq B (symByte P))) ) ) )
      (call $Put (char "\\"))
      (call $Put (char ".")) ) )

(de void printSym (Sym)
   (printName (name (val (tail Sym)))) )

(local) (print prin)

(de void print (X)
   (sigChk 0)
   (cond
      ((cnt? X) (outNum X))
      ((big? X) (fmtNum X 0 0 0 null))
      ((sym? X)
         (cond
            ((sym? (val (tail X)))  # External
               (call $Put (char "{"))
               (prExt (name (& @ -9)))
               (call $Put (char "}")) )
            ((== (name @) ZERO)  # Anonymous
               (call $Put (char "$"))
               (outOct (int X)) )
            (T
               (let (Nm @  Prv (isIntern Nm $PrivT))
                  (ifn (== X Prv)
                     (let (Lst (val $Intern)  F NO)  # Search namespaces
                        (loop
                           (? (atom Lst)  # Transient
                              (call $Put (char "\""))
                              (let (P (push 0 Nm)  B (symByte P))  # [cnt name]
                                 (loop
                                    (cond
                                       ((or
                                             (== B (char "\\"))
                                             (== B (char "\^"))
                                             (== B (char "\"")) )
                                          (call $Put (char "\\")) )
                                       ((== B 127)  # DEL
                                          (call $Put (char "\^"))  # Print ^?
                                          (setq B (char "?")) )
                                       ((> 32 B)  # Ctrl
                                          (call $Put (char "\^"))  # Escape with caret
                                          (setq B (| B 64)) ) )
                                    (call $Put B)
                                    (? (=0 (setq B (symByte P))) ) ) )
                              (call $Put (char "\"")) )
                           (let Nsp (car Lst)
                              (when (isIntern Nm (cdar Nsp))
                                 (? (== @ X)  # Internal
                                    (when (or Prv F)  # Found in other namespace
                                       (printSym Nsp)
                                       (call $Put (char "~")) )
                                    (printName Nm) )
                                 (setq F YES) ) )
                           (shift Lst) ) )
                     (outString ($ "priv~"))  # Found in 'priv'
                     (printName Nm) ) ) ) ) )
      ((and (== (car X) $Quote) (<> X (cdr X)))
         (call $Put (char "'"))
         (print (cdr X)) )
      (T
         (stkChk 0)
         (call $Put (char "("))
         (let (P (circ X)  Z X)
            (loop
               (print (car X))
               (? (nil? (shift X)))
               (? (atom X)
                  (outString ($ " . "))
                  (print X) )
               (space)
               (? (== Z X)
                  (call $Put (char "."))
                  (unless P
                     (call $Put (char ")")) ) )
               (when (== P X)
                  (outString ($ ". ("))
                  (setq Z P  P 0) ) ) )
         (call $Put (char ")")) ) ) )

(de void prin (X)
   (sigChk 0)
   (unless (nil? X)
      (cond
         ((cnt? X) (outNum X))
         ((big? X) (fmtNum X 0 0 0 null))
         ((pair X)
            (stkChk 0)
            (loop
               (prin (car X))
               (? (nil? (shift X)))
               (? (atom X) (prin X)) ) )
         ((sym? (val (tail X)))
            (call $Put (char "{"))
            (prExt (name (& @ -9)))
            (call $Put (char "}")) )
         (T (prName (name @))) ) ) )

# (prin 'any ..) -> any
(de _Prin (Exe)
   (let X (cdr Exe)
      (loop
         (let Y (eval (++ X))
            (prin Y)
            (? (atom X) Y) ) ) ) )

# (prinl 'any ..) -> any
(de _Prinl (Exe)
   (prog1 (_Prin Exe) (newline)) )

# (space ['cnt]) -> cnt
(de _Space (Exe)
   (let X (eval (cadr Exe))
      (ifn (nil? X)
         (let N (xCnt Exe X)
            (while (ge0 (dec 'N))
               (space) )
            X )
         (space)
         ONE ) ) )

# (print 'any ..) -> any
(de _Print (Exe)
   (let X (cdr Exe)
      (loop
         (let Y (eval (++ X))
            (print Y)
            (? (atom X) Y)
            (space) ) ) ) )

# (printsp 'any ..) -> any
(de _Printsp (Exe)
   (prog1 (_Print Exe) (space)) )

# (println 'any ..) -> any
(de _Println (Exe)
   (prog1 (_Print Exe) (newline)) )

# (flush) -> flg
(de _Flush (Exe)
   (if (flush (val $OutFile)) $T $Nil) )

# (rewind) -> flg
(de _Rewind (Exe)
   (let Out: (outFile (val $OutFile))
      (if
         (and
            (Out:)
            (let Fd (Out: fd)
               (Out: ix 0)
               (and (seek0 Fd) (truncate0 Fd)) ) )
         $T
         $Nil ) ) )

# (ext 'cnt . prg) -> any
(de _Ext (Exe)
   (let (X (cdr Exe)  N (evCnt Exe X)  Old (val $ExtN))
      (set $ExtN (i32 N))
      (prog1
         (run (cdr X))
         (set $ExtN Old) ) ) )

(local) (getPlio putPlio)

(de i32 getPlio ()
   (let P (val $Ptr)
      (set $Ptr (inc P))
      (i32 (val P)) ) )

(de void putPlio ((i8 . B))
   (let P (val $Ptr)
      (set P B)
      (when (== (set $Ptr (inc P)) (val $End))
         (sizeErr 0) ) ) )

# (plio 'num) -> any
# (plio 'num 'cnt 'any) -> cnt
(de _Plio (Exe)
   (let
      (X (cdr Exe)
         P (i8* (xCnt64 Exe (eval (++ X)))) )
      (let (Ptr (val $Ptr)  End (val $End))
         (set
            $Extn (val $ExtN)  # Set external symbol offset
            $Ptr P )
         (prog1
            (if (pair X)
               (let (N (evCnt Exe X)  Y (eval (car (shift X))))
                  (set
                     $PutBin (fun (void i8) putPlio)
                     $End (ofs P N) )
                  (binPrint Y)
                  (cnt (- (val $Ptr) P)) )
               (set $GetBin (fun (i32) getPlio))
               (if (binRead) @ $Nil) )
            (set $Ptr Ptr  $End End) ) ) ) )

# (rd ['sym]) -> any
# (rd 'cnt) -> num | NIL
(de _Rd (Exe)
   (let X (save (eval (cadr Exe)))
      (cond
         ((lt0 ((inFile (val $InFile)) fd)) $Nil)
         ((num? X)
            (let
               (P (push 3 NIL ZERO NIL)  # [cnt last name link]
                  Q (link (ofs P 2))
                  Cnt (int X) )
               (cond
                  ((=0 Cnt) $Nil)
                  ((sign? X)  # Little endian
                     (loop
                        (when (lt0 (getBinary))
                           (: 1 (ret $Nil)) )
                        (byteNum (i8 @) P)
                        (? (=0 (dec 'Cnt))) )
                     (if (cnt? (val Q))
                        (twice @)
                        (zapZero @) ) )
                  (T
                     (loop
                        (when (lt0 (getBinary))
                           (goto 1) )
                        (set Q
                           (addu
                              (cnt (i64 @))
                              (set Q (mulu (val Q) (hex "1002"))) ) )  # Multiply number by 256
                        (? (=0 (dec 'Cnt))) )
                     (if (cnt? (val Q))
                        @
                        (zapZero @) ) ) ) ) )
         (T
            (set
               $GetBin (fun (i32) getBinary)
               $Extn (val $ExtN) )
            (if (binRead) @ X) ) ) ) )

# (pr 'any ..) -> any
(de _Pr (Exe)
   (let X (cdr Exe)
      (loop
         (let Y (eval (++ X))
            (set $Extn (val $ExtN))  # Set external symbol offset
            (pr Y)  # Print binary
            (? (atom X) Y) ) ) ) )

# (wr 'cnt ..) -> cnt
(de _Wr (Exe)
   (let X (cdr Exe)
      (loop
         (let N (eval (++ X))
            (_putStdout (i8 (int N)))
            (? (atom X) N) ) ) ) )

(local) (getParse parse)

(de i32 getParse ()
   (let P (val $Parser)
      (set $Chr
         (if (i32 (symByte P))
            @
            (let C (val 3 P)
               (set 3 P (shr C 8))
               (if C (i32 (i8 C)) -1) ) ) ) ) )

(de parse (Nm (i1 . Skip) Eof Set)
   (let
      (Chr (val $Chr)
         Get (val (i8** $Get))
         Pars (val $Parser) )
      (set
         $Chr 0
         $Get (fun (i32) getParse)
         $Parser (push 0 (save Nm) Eof) )
      (when Skip
         (getParse) )
      (prog1
         (cond
            ((=0 Set) (rdList))
            ((== 1 Set) (read0 YES))
            ((=0 (token Set 0)) $Nil)
            (T
               (let (R (save (cons @ $Nil))  P R)
                  (while (token Set 0)
                     (setq P (set 2 P (cons @ $Nil))) )
                  R ) ) )
         (set
            $Parser Pars
            (i8** $Get) Get
            $Chr Chr ) ) ) )

(local) (putString begString tglString endString)

(de void putString ((i8 . B))
   (byteSym B (val $StrP)) )

(de void begString ((i64* . P))  # [cnt last name link fun ptr]
   (set 6 P (i64 (val $StrP)))
   (link (ofs (set $StrP P) 2))
   (set
      5 P (val (i64* $Put))
      $Put (fun (void i8) putString) ) )

(de void tglString ((i64* . P))
   (xchg (any (ofs P 4)) (any (i64* $Put))) )

(de endString ()
   (let (P (val $StrP)  Q (ofs P 2))
      (set
         (i64* $Put) (val 5 P)
         $StrP (i64* (val 6 P)) )
      (drop Q
         (consStr (val Q)) ) ) )

# (any 'sym) -> any
(de _Any (Exe)
   (if (sym? (val (tail (save (evSym (cdr Exe))))))
      $Nil
      (parse (name @) YES (hex "20") 1) ) )  # Blank, EOF

# (sym 'any) -> sym
(de _Sym (Exe)
   (let X (eval (cadr Exe))
      (begString (push 4 NIL ZERO NIL NIL NIL))  # [cnt last name link fun ptr]
      (print X)
      (endString) ) )

# (str 'sym ['sym1]) -> lst
# (str 'lst) -> sym
(de _Str (Exe)
   (let (X (cdr Exe)  Y (eval (car X)))
      (cond
         ((nil? Y) Y)
         ((num? Y) (argErr Exe Y))
         ((pair Y)
            (begString (push 4 NIL ZERO NIL NIL NIL))  # [cnt last name link fun ptr]
            (loop
               (print (++ Y))
               (? (atom Y))
               (space) )
            (endString) )
         ((sym? (setq Y (val (tail @)))) $Nil)
         ((atom (shift X))
            (parse (name Y) NO (hex "5D0A") 0) )  # '\n', ']', EOF
         (T
            (save Y
               (parse (name Y) NO 0 (save (evSym X))) ) ) ) ) )

(local) (stdRead stdEval repl loadAll)

(de stdRead ((i8* . Prmt))
   (prog2
      (set
         $LinePrmt
         (if
            (or
               (nil? (runAt (val $Prompt)))
               (not (symb? @)) )
            Prmt
            (let
               (Nm (name (val (tail @)))
                  N (bufSize Nm)
                  P
                  (set $ReplPrmt
                     (alloc (val $ReplPrmt) (+ N (strlen Prmt))) ) )
               (bufString Nm P)
               (strcpy (ofs P (dec N)) Prmt)
               P ) )
         $ContPrmt ($ "   ") )
      (read1
         (if ((inFile (val $InFile)) tty)
            (char "\n")
            (i32 0) ) )
      (set $LinePrmt (set $ContPrmt null))
      (while (gt0 (val $Chr))
         (? (== (val $Chr) (char "\n"))
            (set $Chr 0) )
         (if (== (val $Chr) (char "#"))
            (comment)
            (? (> (val $Chr) (char " ")))
            (call $Get) ) ) ) )

(de stdEval (Exe)
   (flushAll)
   (let
      (At (save (val $At))
         At2 (save (val $At2))
         X (save (eval Exe)) )
      (outString ($ "-> "))
      (flushAll)
      (print X)
      (unless (nil? (val $Remark))
         (evExe $Remark X $Nil) )
      (newline)
      (set $At3 At2  $At2 At  $At X) ) )

(de repl (Exe (i8* . Prmt) X)
   (if
      (and
         (symb? (save X))
         (== (firstByte X) (char "-")) )
      (evList (safe (parse (xName X) YES (hex "5D0A") 0)))  # '\n', ']', EOF
      (let
         (Lnk (val $NsLink)
            Tr1 (save (val $Transient))
            Tr2 (save (val 2 $Transient))
            Pr1 (save (val $PrivT))
            Pr2 (save (val 2 $PrivT))
            V (link (push -ZERO NIL))
            Raw (val Termio) )
         (save (val $Intern))
         (set $NsLink (val $Link))
         (when (nil? X)
            (setCooked)
            (unless (val $Repl)
               (set $Repl YES)
               (iSignal (val SIGINT Sig) (fun sig)) ) )
         (rdOpen Exe X (b8+ (ioFrame T)))
         (set $PrivT (set 2 $PrivT $Nil))
         (set $Rule (set $Transient (set 2 $Transient $Nil)))
         (setq X $Nil)
         (if (== (val $InFile) (val (val $InFiles)))  # Stdin
            (until (nil? (stdRead Prmt))
               (let Y (set V @)
                  (setq X
                     (if (and Prmt (=0 (val $Chr)))
                        (stdEval Y)
                        (eval Y) ) ) ) )
            (until (nil? (read1 0))
               (setq X (eval (set V @))) ) )
         (popInFiles)
         (set $Intern (val (val $NsLink)))
         (when Raw
            (setRaw) )
         (set 2 $PrivT Pr2)
         (set $PrivT Pr1)
         (set 2 $Transient Tr2)
         (set $Transient Tr1)
         (set $NsLink Lnk)
         X ) ) )

(de loadAll (Exe)
   (let X $Nil
      (loop
         (let (A (val $AV)  P (val A))
            (?
               (or
                  (=0 P)
                  (and
                     (== (val P) (char "-"))
                     (=0 (val 2 P)) ) ) )
            (set $AV (inc A))
            (setq X (repl Exe null (mkStr P))) ) )
      X ) )

# (load 'any ..) -> any
(de _Load (Exe)
   (let X (cdr Exe)
      (loop
         (let Y
            (if (t? (eval (++ X)))
               (loadAll Exe)
               (repl Exe ($ "> ") @) )
            (? (atom X) Y) ) ) ) )
