diff --git a/src/llogo/loader.2 b/src/llogo/loader.2
index a86211c2..301e1d9c 100644
--- a/src/llogo/loader.2
+++ b/src/llogo/loader.2
@@ -132,8 +132,6 @@ UUO:/	)	       (PRINC (COND ((NUMBERP PURE) (* PURE 2048.)) (0.)))
 		(MAKUNBOUND 'INITIAL-SIZE)
 		(SETQ PURE NIL ^W NIL)
 		(LOGO)
-(defun dprinc (x) (princ x))
-(defun dterpri () (terpri))	
 		(SETQ BASE 10. 
 		      IBASE 10. 
 		      *NOPOINT T 
@@ -148,6 +146,7 @@ UUO:/	)	       (PRINC (COND ((NUMBERP PURE) (* PURE 2048.)) (0.)))
                             (PUTPROP 'LLOGO (LIST DUMP (READ)) 'VERSION))
                        (UCLOSE)
 		       (PURIFY 0. 0. 'BPORG)
+	               (close (prog1 infile (inpush -1)))
 		       (SUSPEND (ATOMIZE ':SYMLOD EOL ':PDUMP/ LLOGO/;TS/  DUMP EOL ':KILL/ )))
 		      (DUMP (IOG NIL (PRINC 'VERSION/ NUMBER?/ )
                                      (PUTPROP 'LLOGO (LIST DUMP (READ)) 'VERSION))
diff --git a/src/llogo/print.2 b/src/llogo/print.2
new file mode 100644
index 00000000..c6cc531b
--- /dev/null
+++ b/src/llogo/print.2
@@ -0,0 +1,336 @@
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;			LLOGO PRINTING FUNCTIONS.            ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+
+(DECLARE (OR (STATUS FEATURE DEFINE)
+	     (COND ((STATUS FEATURE ITS)
+		    ;;MULTICS?
+		    (FASLOAD DEFINE FASL DSK LLOGO))))) 
+
+(SAVE-VERSION-NUMBER PRINT) 
+
+(DECLARE (GENPREFIX PRINT)) 
+
+[(OR MULTICS DEC10) (DEFINE DPRINC (SYN PRINC)) 
+		    (DEFINE DTERPRI (SYN TERPRI))] 
+
+;[ITS (DEFUN DPRINC (X) (SUBRCALL NIL DPRINC X))
+;     (DEFUN DTERPRI NIL (SUBRCALL NIL DTERPRI))
+;     ;;WATCH IT, THESE ARE LSUBRS IN NEWIO!
+;     (SETQ DPRINC (GET 'PRINC 'SUBR) DTERPRI (GET 'TERPRI 'SUBR))] 
+
+[ITS (defun dprinc (x) (princ x))
+     (defun dterpri () (terpri))
+     (SETQ DPRINC (GET 'DPRINC 'SUBR) DTERPRI (GET 'DTERPRI 'SUBR))] 
+
+(DEFUN DPRINT (X) (DTERPRI) (DPRIN1 X) (DPRINC '/ )) 
+
+(DEFUN DPRIN1 (X) 
+       (COND ((NUMBERP X) (DPRINC X))
+             ((ATOM X) 
+              (COND ((= (FLATC X) (FLATSIZE X)) (DPRINC X))
+                    ((MAPC 'DPRINC (LIST '$ X '$)))))
+	     ((DPRINC '/() 
+              (DO ((REST-LIST X (CDR REST-LIST)))
+                  ((COND ((NULL REST-LIST) (DPRINC '/)))
+                         ((ATOM REST-LIST) 
+                          (DPRINC '" . ") (DPRIN1 REST-LIST) (DPRINC '/)))))
+                  (DPRIN1 (CAR REST-LIST))
+                  (AND (CDR REST-LIST) (DPRINC '/  ))))))
+
+(DEFUN DPRINTL ARGS 
+       (DO ARG-INDEX 1. (1+ ARG-INDEX) (> ARG-INDEX ARGS) 
+           (DPRINC (ARG ARG-INDEX)) (DPRINC '/ ))
+       (DTERPRI)) 
+
+(DEFUN DPRINCSP (X) (DPRINC X) (DPRINC '/ )) 
+
+(DEFINE PRINT (PARSE (PARSE-SUBSTITUTE 'LOGO-PRINT))) 
+
+(DEFINE LOGO-PRINT (UNPARSE (UNPARSE-SUBSTITUTE 'PRINT)) (ABB P PR) (PARSE 1. L) ARGS 
+	(DO I 1. (1+ I) (> I ARGS) (TYPE (ARG I)) (DTERPRI))
+	NO-VALUE) 
+
+(DEFINE FPRINT (ABB FP) (PARSE 1. L) ARGS 
+	(DO I 1. (1+ I) (> I ARGS) (DPRIN1 (ARG I)))
+	?) 
+
+(DEFINE TYPE (PARSE 1. L) ARGS (DO ((I 1. (1+ I)))
+				   ((> I ARGS) NO-VALUE)
+				   (COND ((ATOM (ARG I)) (DPRINC (ARG I)))
+					 ((DO ((TYPE-ARG (ARG I) (CDR TYPE-ARG)))
+					      ((ATOM (CDR TYPE-ARG))
+					       (DPRINC (CAR TYPE-ARG))
+					       (AND (CDR TYPE-ARG)
+						    (DPRINC '/ /./ )
+						    (DPRINC (CDR TYPE-ARG))))
+					      (DPRINCSP (CAR TYPE-ARG))))))) 
+
+(DEFINE BLANK NIL (DPRINC '/ ) NO-VALUE) 
+
+(DEFINE CARRIAGERETURN (ABB CR) NIL (DPRINC EOL) NO-VALUE) 
+
+(DEFINE LINEFEED NIL NIL (DPRINC (ASCII 10.)) NO-VALUE) 
+
+[MULTICS (DEFINE PRETTY (NEWLINEL) 
+		 ;;UPDATES CHRCT AND LINEL.  IDENTICAL TO "NEWLINEL" IN GRIND.
+		 (CHRCT NIL (+ (CHRCT NIL) (- NEWLINEL (LINEL NIL))))
+		 (LINEL NIL NEWLINEL))] 
+
+[(OR ITS DEC10) (DEFINE PRETTY (NEWLINEL) (SETQ CHRCT (+ CHRCT (- NEWLINEL LINEL)))
+					  (SETQ LINEL NEWLINEL))] 
+
+;;THE DPRIN FNS PRINT ON DISPLAY AS WELL AS AT TTY IF :SHOW = T.  IF TRUE, THE
+;;DPRINT FNS OUTPUT TO 6.
+
+(SETQ :SHOW NIL) 
+
+;;LISTING
+
+(DEFINE PRINTOUT (ABB PO) FEXPR (X) 
+	(COND ((NULL X) (LIST-PROCEDURE FN))
+	      ((MEMQ (CAR X) '(ABBREVIATIONS ABBS)) (PRINTOUTABBREVIATIONS))
+	      ((MEMQ (CAR X) '(NAMES :NAMES)) (PRINTOUTNAMES))
+	      ((EQ (CAR X) 'PROCEDURES) (PRINTOUTPROCEDURES))
+	      ((EQ (CAR X) 'ALL)
+	       (PRINTOUTPROCEDURES)
+	       (DTERPRI)
+	       (PRINTOUTNAMES))
+	      ((MEMQ (CAR X) '(CONTENTS :CONTENTS TITLES)) (PRINTOUTCONTENTS))
+	      ((EQ (CAR X) 'TITLE) (APPLY 'PRINTOUTTITLE (CDR X)))
+	      ((EQ (CAR X) 'LINE) (PRINTOUTLINE (CADR X)))
+	      ((MEMQ (CAR X) '(PRIMITIVES :PRIMITIVES)) (PRINTOUTPRIMITIVES))
+	      ((EQ (CAR X) 'FILE) (APPLY 'PRINTOUTFILES (CDR X)))
+	      [(OR ITS MULTICS) ((MEMQ (CAR X) '(INDEX FILES))
+				 (APPLY 'PRINTOUTINDEX (CDR X)))]
+	      [ITS ((MEMQ (CAR X) '(SNAPS :SNAPS)) (PRINTOUTSNAPS))]
+	      ((MAPC 'LIST-PROCEDURE X)))
+	?) 
+
+(DEFINE CONTENTS NIL (DELEET :CONTENTS :BURIED)) 
+
+[CLOGO (DEFINE LIST (PARSE (PARSE-CLOGO-HOMONYM PRINTOUT L)))] 
+
+(DEFINE PRINTOUTCONTENTS (ABB LC LISTCONTENTS POC POTS) NIL 
+	(MAPC '(LAMBDA (USER-PROCEDURE) 
+		       (OR (MEMQ USER-PROCEDURE :BURIED)
+			   (LOGOPRINT (CAR (EDITINIT1 USER-PROCEDURE)))))
+	      :CONTENTS)
+	NO-VALUE) 
+
+(DEFINE PRINTOUTSNAPS (ABB LISTSNAPS) NIL (AND :SNAPS (TYPE :SNAPS EOL)) NO-VALUE) 
+
+(DEFINE PRINTOUTPROCEDURES (ABB LISTPROCEDURES LPR POPR) NIL 
+	(MAPC '(LAMBDA (USER-PROCEDURE) (OR (MEMQ USER-PROCEDURE :BURIED)
+					    (LIST-PROCEDURE USER-PROCEDURE)
+					    (DTERPRI)))
+	      :CONTENTS)
+	?) 
+
+(DEFINE PRINTOUTTITLE (ABB LISTTITLE POT) FEXPR (OPTFUNCTION) 
+	(DEFAULT-FUNCTION 'PRINTOUTTITLE (AND OPTFUNCTION (CAR OPTFUNCTION)))
+	(LOGOPRINT TITLE)
+	NO-VALUE) 
+
+(DEFINE PRINTOUTALL (ABB POA LISTALL) NIL (PRINTOUTPROCEDURES) (PRINTOUTNAMES) ?) 
+
+(DEFINE PRINTOUTFILE (ABB POF LISTFILE) FEXPR (FILENAME) 
+	;;TAKES A FILE NAME AS INPUT AND PRINTS THE FILE.
+	(APPLY 'UREAD (FILESPEC FILENAME))
+	(SETQ ^Q T)
+	(DO ((CHARNUM (TYI -1.) (TYI -1.)))
+	    ((OR (NULL ^Q) (MINUSP CHARNUM)) (SETQ ^Q NIL) (TERPRI))
+	    (OR (= CHARNUM 12.) (= CHARNUM 10.) (TYO CHARNUM)))
+	NO-VALUE) 
+
+[(OR ITS MULTICS) (DEFINE PRINTOUTINDEX (ABB POI LISTINDEX LISTFILES) FEXPR (WHOSE) 
+		   ;;PRINTS OUT LISTING OF FILES.
+		   [ITS (APPLY 'PRINTOUTFILE
+			       (APPEND '(".FILE."
+					 "(DIR)")
+				       WHOSE))]
+		   [MULTICS (CLINE (GET_PNAME (APPLY 'ATOMIZE
+						     (CONS 'LIST/ 
+							   (AND WHOSE
+								(CONS '/ -P/ 
+								      WHOSE))))))]
+		   [DEC10 (VALRET (APPLY 'ATOMIZE
+					 (APPEND '("DIR ")
+						 (AND WHOSE (CONS '/[ WHOSE))
+						 (AND WHOSE '(/]))
+						 '(/
+))))]		   NO-VALUE)] 
+
+(DEFINE PRINTOUTLINE (ABB LISTLINE LL POL) (NUMBER) 
+	(DEFAULT-FUNCTION 'PRINTOUTLINE NIL)
+	(COND ((GETLINE PROG (SETQ NUMBER (NUMBER? 'PRINTOUTLINE NUMBER)))
+	       (TYPE '";PRINTING LINE "
+		     NUMBER
+		     '" OF "
+		     FN
+		     EOL)
+	       (LOGOPRINT (CONS NUMBER THIS-LINE))
+	       NO-VALUE)
+	      ((SETQ NUMBER
+		     (ERRBREAK 'PRINTOUTLINE
+			       (LIST '"NO LINE NUMBERED "
+				     NUMBER
+				     '" IN "
+				     FN)))
+	       (PRINTOUTLINE NUMBER)))) 
+
+;;;FOR EACH NAME ON :NAMES, PRINTOUTNAMES WRITES OUT
+;;; 	MAKE "<NAME>" "<THING>"
+;;;WHICH CAN BE REREAD TO RESTORE VALUES OF VARIABLES.
+
+(DEFINE PRINTOUTNAMES (ABB LISTNAMES LN PON) NIL 
+ (COND
+  (:CAREFUL
+   (COND (:NAMES (DTERPRI)
+		 (MAPC 
+		  '(LAMBDA (NAME) 
+			   (AND (BOUNDP NAME)
+				(DPRINC '"MAKE '")
+				(DO ((CHARNUM 3. (1+ CHARNUM))
+				     (CHAR (GETCHAR NAME 2.) (GETCHAR NAME CHARNUM)))
+				    ((NULL CHAR) T)
+				    (DPRINC CHAR))
+				;;SPECIAL CASE CHECK FOR :EMPTYW IS REQUIRED, SINCE
+				;;ITS PRINTED REPRESENTATION IS NOT REREADABLE.
+				(COND ((EQ (SETQ NAME (SYMEVAL NAME)) :EMPTYW)
+				       (TYPE '" :EMPTYW" EOL))
+				      ((DPRINC '" '") (DPRIN1 NAME) (DTERPRI)))))
+		  :NAMES))
+	 ((IOG NIL (TYPE '";NO NAMES DEFINED" EOL)))))
+  ((IOG
+    NIL
+    (TYPE
+     '";YOU ARE NOT IN CAREFUL MODE. NO NAMES ARE SAVED."
+     EOL))))
+ NO-VALUE) 
+
+;;LISTING ABBREVIATIONS AND PRIMITIVES IS ACCOMPLISHED BY EXAMINING THE OBLIST. 
+;;THIS TAKES NO SPACE BUT RESULTS IN AN UNORDERED AND THEREFORE UNINFORMATIVE
+;;PRINTOUT.  AN IMPROVEMENT WOULD BE TO HAVE THESE INQUIRES BE ANSWERED BY ACCESSING
+;;A DSK FILE OF COMMENTARY.  THE FILE COULD BE CREATED AT COMPILE TIME.
+
+(DEFINE PRINTOUTABBREVIATIONS (ABB LISTABBREVIATIONS) NIL 
+ (TYPE '";ABBREVIATIONS:" EOL)
+ ;;FILTER FOR ABBREVIATIONS.
+ (OBFILTER (EXPR-FUNCTION ABBREVIATIONP)
+	   (EXPR-FUNCTION (LAMBDA (AB) 
+				  (TYPE AB
+					'" ABBREVIATION FOR "
+					(ABBREVIATIONP AB)
+					EOL))))) 
+
+(DEFINE PRINTOUTPRIMITIVES (ABB LISTPRIMITIVES) NIL 
+	(TYPE 'PRIMITIVES: EOL)
+	(OBFILTER (EXPR-FUNCTION (LAMBDA (X) (AND (PRIMITIVEP X)
+						  (NOT (ABBREVIATIONP X)))))
+		  (EXPR-FUNCTION DPRINT))) 
+
+(DEFUN OBFILTER (*FILTER* *MESSAGE*) 
+       ;;PRINTS (MESSAGE ATOM) FOR EACH ATOM ON
+       (DO ((J 0. (1+ J)))
+	   ((= J (CADR (ARRAYDIMS 'OBARRAY))))
+	   (MAPC '(LAMBDA (ATOM) 
+			  (AND (EXPR-CALL *FILTER* ATOM) (EXPR-CALL *MESSAGE* ATOM)))
+		 (ARRAYCALL NIL OBARRAY J)))
+       ?) 
+
+(DEFUN LIST-PROCEDURE (FNNAME) 
+       ;;PRINTS LISPIFIED USER FN AS LOGO.
+       (DEFAULT-FUNCTION 'LIST-PROCEDURE FNNAME)
+       (DTERPRI)
+       (LOGOPRINC TITLE)
+       (DO ((PROC (CDDDR PROG) (CDR PROC)) (THIS-FORM (CADDR PROG) (CAR PROC)))
+	   ((NULL PROC) (TYPE EOL 'END EOL))
+	   (COND ((NUMBERP THIS-FORM)
+		  ;;TAG PRINTED
+		  (DTERPRI)
+		  (DPRINC THIS-FORM))
+		 ((DPRINC '/ )
+		  (UNPARSE-FORM (EXPR-FUNCTION DPRINC) THIS-FORM))))) 
+
+;;*PAGE
+
+
+(DEFUN LOGOPRINT (X) (LOGOPRINC X) (DTERPRI)) 
+
+(DEFUN LOGOPRINSP (X) (LOGOPRINC X) (DPRINC '/ )) 
+
+;;; THE FOLLOWING CODE INSERTS CARRAIGE RETURNS IN LONG COMMENTS
+;;; LIKE THE PRETTY-PRINTER DOES. THIS CODE IS NOW UNUSUABLE DUE
+;;; TO MODIFICATIONS IN THE PRINTER, BUT SIMILAR STUFF SHOULD BE
+;;; WRITTEN AT SOME POINT.
+;;;
+;;;
+;;; (DEFUN PRINT-COMMENT (FN ARGS) 
+;;;        (DINDENT-TO (DIFFERENCE LINEL 20.))
+;;;        (DPRINC '!)
+;;;        (DSEGTEXT (CAR ARGS))
+;;;        (DPRINC '!)) 
+;;; 
+;;;  
+;;;  
+;;; 
+;;; (DEFUN DINDENT-TO (X) 						      
+;;;SIMILAR
+;;TO INDENT-TO BUT DOES NOT USE TABS
+;;;        (AND (LESSP CHRCT X) (DTERPRI))				      
+;;;WHICH
+;;DISPLAY DOES NOT UNDERSTAND.
+;;;        (PROG NIL 
+;;; 	LOOP (COND ((= CHRCT X)) ((DPRINC '/ ) (GO LOOP))))) 
+;;; 
+;;; (DEFUN DSEGTEXT (L) 
+;;;        (PROG (N) 
+;;; 	     (AND (ATOM L) (RETURN (TYPE L)))			       ;GRINDS THE
+;;SEGMENT L AS TEXT INTO REMAINING
+;;; 	     (SETQ N CHRCT)					       ;SPACE ON
+;;LINE.  SERVES TO INSERT CR'S IN
+;;; 	A    (TYPE (CAR L))					       ;EXCESSIVELY
+;;LONG COMMENTS.
+;;; 	     (POP L)
+;;; 	     (OR L (RETURN NIL))
+;;; 	     (COND ((LESSP (FLATSIZE (CAR L)) (DIFFERENCE CHRCT 2.))
+;;; 		    (DPRINC '/ ))
+;;; 		   ((DINDENT-TO N)))
+;;; 	     (GO A))) 
+;;; 
+
+(DEFINE LINEPRINT FEXPR (X) 
+ [ITS (UWRITE TPL)]
+ [MULTICS (UWRITE)]
+ (IOG
+  RW
+  (PROG (CRUNIT :SHOW LINEL) 
+	[(OR ITS DEC10) (SETQ LINEL 120.)]
+	[MULTICS (SETQ LINEL (LINEL NIL)) 
+		 (LINEL NIL 120.)]
+	;;SAVE CURRENT DEVICE, DIRNAME.
+	(SETQ CRUNIT (CRUNIT))
+	(TYPE '";************* "
+	      (STATUS UNAME)
+	      '/ 
+	      (OR X :EMPTYW)
+	      '" *************"
+	      EOL)
+	(DPRINTL '/; (DAYTIME))
+	(DPRINTL '/; (DATE))
+	(DTERPRI)
+	(PRINTOUTALL)
+	[ITS (UFILE)]
+	[MULTICS (LET ((DIRECTORY (GET_PNAME (CAR (NAMES (CAR OUTFILES))))))
+		      (UFILE LINE_PRINT LOGO)
+		      (CLINE (CATENATE "DPRINT -DELETE "
+				       DIRECTORY
+				       ">LINE_PRINT.LOGO "))) 
+		 (LINEL NIL LINEL)]
+	;;RESTORE ORIGINAL DEVICE.
+	(APPLY 'CRUNIT CRUNIT)))
+ NO-VALUE) 
+