From 9d2d9625be5349adcae8108ca660d8ad30747765 Mon Sep 17 00:00:00 2001
From: Eric Swenson <eric@swenson.org>
Date: Sun, 22 Jul 2018 09:24:45 -0700
Subject: [PATCH] Added LISP; SHARAB LISP as present in PI distribution. This
 is used for dumping out sharable lisps. Partially addresses #251.

---
 src/lisp/sharab.lisp | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)
 create mode 100755 src/lisp/sharab.lisp

diff --git a/src/lisp/sharab.lisp b/src/lisp/sharab.lisp
new file mode 100755
index 00000000..e51b245c
--- /dev/null
+++ b/src/lisp/sharab.lisp
@@ -0,0 +1,38 @@
+(comment )  ;;; -*-lisp-*-
+
+
+(progn 
+     ;closes init file, if any, or else load file
+   (and (filep uread) (close uread))
+   (and (filep infile) (not (eq infile tyi)) (close infile))
+   (setq infile 't)
+   (setq pure t *pure () )
+   (load '((liblsp) sharab))
+   (fasload (lisp) defmax)
+   (setq pure 1 *pure 'T)
+   (*rset 'T)
+   (pagebporg)
+   (setq putprop (purcopy 
+		  (append '(STRUCT=INFO SELECTOR CONSTRUCTOR AUTOLOAD VERSION 
+			    CARCDR |side-effectsp/|| SETF-X 
+			    GRINDFN GRINDPREDICT GRINDMACRO GRINDFLATSIZE)  
+			  putprop))
+	 pure-putprop putprop)
+   (setq SHBDMP (list (cond ((status feature ITS) '(DSK LSPDMP))
+			    ('T (+internal-lossage "Not Yet Implemented for Non-ITS systems" 'SHARAB () )
+				'(LISP)))
+		      'SHBDMP 
+		      (implode (nconc (exploden (get 'SHARABLE 'VERSION))
+				      (list '|.|)
+				      (cdr (exploden (status LISPV)))))))
+   (sstatus 
+     TOPLEVEL 
+     '((lambda () 
+	 (sstatus TOPLEVEL () )
+	 (setq - () + () )
+	 (pure-suspend "SHARABJ:VP " SHBDMP)
+	 (announce-&-load-init-file 'SHARABLE (status JCL)) )))
+   (sstatus feature SHARABLE)
+   (*throw () () ))
+
+