From b38fca72550ed9b154708ccc231aa41fa17633a7 Mon Sep 17 00:00:00 2001
From: Lars Brinkhoff <lars@nocrew.org>
Date: Mon, 24 Sep 2018 14:53:53 +0200
Subject: [PATCH] Compile LLOGO.

---
 build/lisp.tcl     | 30 ++++++++++++++++++++++++++++++
 src/llogo/ioc.lsp  | 13 +++++++++++++
 src/llogo/loader.x | 12 +++++++-----
 3 files changed, 50 insertions(+), 5 deletions(-)
 create mode 100644 src/llogo/ioc.lsp

diff --git a/build/lisp.tcl b/build/lisp.tcl
index baae99de..e6049fee 100644
--- a/build/lisp.tcl
+++ b/build/lisp.tcl
@@ -922,3 +922,33 @@ respond "*" ":complr\r"
 respond "_" "kle;forth\r"
 respond "_" "\032"
 type ":kill\r"
+
+# Lisp Logo
+respond "*" ":cwd llogo\r"
+respond "*" ":complr\r"
+respond "_" "\007"
+respond "*" {(load "ioc")}
+respond "T" "(maklap)"
+respond "_" "define\r"
+respond "_" "\032"
+type ":kill\r"
+respond "*" ":complr\r"
+respond "_" "\007"
+respond "*" {(load "ioc")}
+respond "T" {(load "define")}
+respond "0" "(maklap)"
+respond "_" "error\r"
+respond "_" "parser\r"
+respond "_" "primit\r"
+respond "_" "print\r"
+respond "_" "reader\r"
+respond "_" "setup\r"
+respond "_" "tvrtle\r"
+respond "_" "unedit\r"
+respond "_" "\032"
+type ":kill\r"
+respond "*" ":lisp loader\r"
+respond "?" "Y\r"
+respond "?" "LLOGO\r"
+respond ";BKPT" "\032"
+type ":kill\r"
diff --git a/src/llogo/ioc.lsp b/src/llogo/ioc.lsp
new file mode 100644
index 00000000..dbae5c39
--- /dev/null
+++ b/src/llogo/ioc.lsp
@@ -0,0 +1,13 @@
+;;; -*- lisp -*-
+
+(defmacro ioc (sym)
+  (cond
+    ((eq sym 'G)   `(^G))
+    ((eq sym 'R)   `(setq ^R t))
+    ((eq sym 'T)   `(setq ^R nil))
+    (t             (error "Unknown IOC character"))))
+
+(defmacro iog (sym &rest forms)
+  `(let ((^Q nil) (^R nil) (^W nil)
+         ,@(if sym `((ioc ,sym))))
+     ,@forms))
diff --git a/src/llogo/loader.x b/src/llogo/loader.x
index 3bc84884..d9fb7316 100644
--- a/src/llogo/loader.x
+++ b/src/llogo/loader.x
@@ -11,6 +11,8 @@
 
 (DECLARE (COUTPUT (READ))) 
 
+(load "ioc")
+
 (DEFUN HOW-BIG NIL 
        (REMPROP 'HOW-BIG 'EXPR)
        ((LAMBDA (FREE) 
@@ -42,7 +44,7 @@
 			    (MAPC 
 			     '(LAMBDA (SOURCE-FILE) 
 				      (APPLY 'UREAD
-					     (CONS SOURCE-FILE '(> AI LLOGO)))
+					     (CONS SOURCE-FILE '(> DSK LLOGO)))
 				      (MAPC 'PRINC
 					    (LIST 'READING
 						  '/ 
@@ -81,9 +83,9 @@ FASLOADING/ 						 FASL-FILE
 							 '/ FASL))
 					     (APPLY 'FASLOAD
 						    (CONS FASL-FILE
-							  '(FASL AI LLOGO))))
+							  '(FASL DSK LLOGO))))
 				    (CDR (GET 'LLOGO 'FILES)))))
-		     (AND DUMP (UWRITE AI LLOGO) (IOC R)
+		     (AND DUMP (UWRITE DSK LLOGO) (IOC R)
 		     (MAPC 'PRINC
 			   (LIST '/
 CREATING/ 			 DUMP
@@ -139,7 +141,7 @@ UUO:/	)	       (PRINC (COND ((NUMBERP PURE) (* PURE 2048.)) (0.)))
 		(TERPRI)
                 (SSTATUS TOPLEVEL '(START-UP))
 		(COND ((AND DUMP (STATUS FEATURE ITS))
-		       (ERRSET (UFILE LLOGO > AI LLOGO) NIL)
+		       (ERRSET (UFILE LLOGO > DSK LLOGO) NIL)
                        (IOG NIL (PRINC 'VERSION/ NUMBER?/ )
                             (PUTPROP 'LLOGO (LIST DUMP (READ)) 'VERSION))
                        (UCLOSE)
@@ -194,4 +196,4 @@ UUO:/	)	       (PRINC (COND ((NUMBERP PURE) (* PURE 2048.)) (0.)))
 (AND (STATUS FEATURE BIBOP) (SETQ INITIAL-SIZE (HOW-BIG))) 
 
 (SSTATUS TOPLEVEL '(CREATE)) 
-
\ No newline at end of file
+