diff --git a/build/lisp.tcl b/build/lisp.tcl
index 5aa5e343..7343f38b 100644
--- a/build/lisp.tcl
+++ b/build/lisp.tcl
@@ -906,3 +906,14 @@ respond "*" ":lisp math; kermit dumper\r"
 respond "to dump.|" "(kermit-dump)"
 expect ":KILL"
 respond "*" ":link sys3;ts kermit,math;\r"
+
+# SUPDUP ARDS
+respond "*" ":complr\r"
+respond "_" "dcp;sgincl\r"
+respond "_" "dcp;supard\r"
+respond "_" "\032"
+type ":kill\r"
+respond "*" ":lisp\r"
+respond "Alloc?" "n"
+respond "*" {(load "dcp;supard")}
+respond "system program" "(bootstrap)"
diff --git a/doc/programs.md b/doc/programs.md
index cc33faf3..334c9048 100644
--- a/doc/programs.md
+++ b/doc/programs.md
@@ -199,6 +199,7 @@
 - STUFF, load code into PDP-11 through 10-11 interface.
 - STY, pseudo-terminal for multiple sessions.
 - STYLOG, convert PTY output file into ASCII file.
+- SUPARD, draw ARDS graphics to SUPDUP.
 - SUPDUP, Supdup client.
 - SYSCHK, check up on system job.
 - SYSLOD, system load histogram.
diff --git a/src/dcp/sgincl.14 b/src/dcp/sgincl.14
new file mode 100755
index 00000000..2727330e
--- /dev/null
+++ b/src/dcp/sgincl.14
@@ -0,0 +1,277 @@
+;;; -*-Mode:lisp;Package:user;Base:8-*-  
+
+;;; SUPDUP Graphics include file
+
+#+LISPM (defmacro +tyo (a b) `(funcall ,b ':tyo ,a))
+#+NIL   (defmacro +tyo (a b) `(sfa-call ,b ':raw-tyo ,a))
+#+NIL   (eval-when (eval load compile)
+	   (pkg-create-package 'supdup)
+	   (pkg-create-package 'tv)
+	   )
+	       
+(declare (special sgttyo sgos
+		  sg-current-x sg-current-y sg-xor-ior
+		  sg-next-must-be-absolute
+		  )
+	 )
+
+(defvar sgttyo
+  #+PDP10 (open "tty:" '(out image tty))
+  #+LISPM (funcall terminal-io
+		   ':eval-inside-yourself 'supdup:chaos-stream)
+  #+NIL   standard-output
+  )
+(defvar sgos sgttyo)
+
+(defvar sg-current-x 0) (defvar sg-current-y 0) (defvar sg-xor-ior 'ior)
+
+(defconst %TDGRF #o231) (defconst %TDNOP #o210) (defconst %TDRST #o230)
+
+(defconst tv:alu-ior 0) (defconst tv:alu-andcam #o40) (defconst tv:alu-xor -1)
+(defconst %goMVR #o001) (defconst %goMVA #o021)
+(defconst %goXOR #o002) (defconst %goIOR #o022)
+(defconst %goSET #o003)
+(defconst %goMSR #o004) (defconst %goMSA #o024)
+(defconst %goINV #o006) (defconst %goVIS #o026)
+(defconst %goBNK #o007)
+(defconst %goCLR #o010)
+(defconst %go*LR #o101) (defconst %goDLR #o101) (defconst %goELR #o141)
+(defconst %go*LA #o121) (defconst %goDLA #o121) (defconst %goELA #o161)
+(defconst %go*PR #o102) (defconst %goDPR #o102) (defconst %goEPR #o142)
+(defconst %go*PA #o122) (defconst %goDPA #o122) (defconst %goEPA #o162)
+(defconst %go*RR #o103) (defconst %goDRR #o103) (defconst %goERR #o143)
+(defconst %go*RA #o123) (defconst %goDRA #o123) (defconst %goERA #o163)
+(defconst %go*CH #o104) (defconst %goDCH #o104) (defconst %goECH #o144)
+(defconst %go*SC #o105) (defconst %goDSC #o105) (defconst %goESC #o145)
+(defconst %go*RN #o106) (defconst %goDRN #o106) (defconst %goERN #o146)
+
+
+(defvar sg-tty-info '())
+
+#-NIL
+(defun sg-get-tty-info ()
+  (or sg-tty-info
+      (setq sg-tty-info
+	    (let* ((cnsget #+ITS (syscall 7 'cnsget tyo)
+			   #+Tops-20 '(47. 96. 0 0 0 0 #o31011040000)
+			   #+NIL     '(47. 96. 0 0 0 0 #o31011040000)
+			   )
+		   (smarts (nth 6 cnsget)))
+	      `((char-height ,(nth 0 cnsget))
+		(char-width  ,(nth 1 cnsget))
+		(height	     ,(* (nth 0 cnsget) (ldb #o3405 smarts)))
+		(width       ,(* (nth 1 cnsget) (ldb #o3004 smarts)))
+		(virtual     ,(plusp (logand smarts #o040000000)))
+		(blink       ,(plusp (logand smarts #o020000000)))
+		(xor         ,(plusp (logand smarts #o010000000)))
+		(rectangles  ,(plusp (logand smarts #o004000000)))
+		(sets        ,(plusp (logand smarts #o002000000)))
+		(graphics    ,(plusp (logand smarts #o001000000)))
+		(ginput      ,(plusp (logand smarts #o000400000)))
+		(hardcopy    ,(plusp (logand smarts #o000200000)))
+		(rasters     ,(plusp (logand smarts #o000040000))))))))
+
+#+NIL
+(defun sg-get-tty-info () 
+  (setq sg-tty-info '((char-height 47.) 
+		      (char-width  95.)
+		      (height	 #.(* 47. 12.))
+		      (width       #.(* 95. 08.))
+		      (virtual     ())
+		      (blink       ())
+		      (xor         #t)
+		      (rectangles  #t)
+		      (sets        ())
+		      (graphics    #t)
+		      (ginput      ())
+		      (hardcopy    ())
+		      (rasters     #t))))
+
+#.`(progn 'compile
+	  ,@(do ((names '((char-height char-height)
+			  (char-width  char-width)
+			  (height      height)
+			  (width       width)
+			  (virtual?    virtual)
+			  (blink?      blink)
+			  (xor?        xor)
+			  (rectangles? rectangles)
+			  (sets?       sets)
+			  (graphics?   graphics)
+			  (ginput?     ginput)
+			  (hardcopy?   hardcopy)
+			  (rasters?    rasters))
+			(cdr names))
+		 (funs '() (cons `(defun
+				    ,(implode
+				      (append (exploden 'sg-tty-info-)
+					      (exploden (caar names))))
+				    ()
+				    (cadr (assoc ',(cadar names)
+						 (sg-get-tty-info))))
+				 funs)))
+		((null names) funs)))
+
+(defun sg-tty-info-max-xy ()
+  (// (min (sg-tty-info-width) (sg-tty-info-height)) 2))
+
+(defvar sg-output-file '())
+
+(defun sg-file-output (filename)
+  (sg-revert-output)
+  (setq sg-output-file (open filename '(out ascii))))
+
+(defun sg-revert-output ()
+  (if sg-output-file (close sg-output-file))
+  (setq sg-output-file '()))
+
+
+(defun sg-can-i-do-it-relative? (x y)
+  (and (not (prog1 sg-next-must-be-absolute
+		   (setq sg-next-must-be-absolute '())))
+       (< (abs (- sg-current-x x)) #o100)
+       (< (abs (- sg-current-y y)) #o100)))
+(defun sg-out (n)
+  (+tyo n sgos)
+  (if (and sg-output-file (< n #o200))
+      (+tyo n sg-output-file)))
+(defun sg-short-out (n) (sg-out (logand n #o177)))
+(defun sg-long-out (n)
+  (sg-out (logand n #o177))
+  (sg-out (logand (lsh n -7) #o177)))
+(defun sg-with-write-mode (com alu)
+  (cond ((= alu tv:alu-xor)
+	 (or (eq sg-xor-ior 'xor) (sg-do '(xor)))
+	 (sg-out com))
+	('else
+	 (or (eq sg-xor-ior 'ior) (sg-do '(ior)))
+	 (sg-out (+ com alu)))))
+
+(defun sg-do (coms)
+  (do ((coms coms (cdr coms)))
+      ((null coms))
+    (caseq (car coms)
+      ((enter)   (sg-out %TDGRF) (setq sg-next-must-be-absolute t))
+      ((exit)	 (sg-out %TDNOP))
+      ((reset)   (sg-out %TDRST) (setq sg-xor-ior 'ior))
+      ((clear)	 (sg-out %goCLR))
+      ((xor)	 (sg-out %goXOR) (setq sg-xor-ior 'xor))
+      ((ior)	 (sg-out %goIOR) (setq sg-xor-ior 'ior))
+      )))
+
+
+(defun sg-set-point (x y)
+  (sg-move-absolute x y))
+(defun sg-move-to (x y)
+  (cond ((sg-can-i-do-it-relative? x y)
+	 (sg-move-relative (- x sg-current-x) (- y sg-current-y)))
+	('else (sg-move-absolute x y))))
+(defun sg-move-relative (dx dy)
+  (cond ((and (zerop dx) (zerop dy)))
+	('else (setq sg-current-x (+ sg-current-x dx)
+		     sg-current-y (+ sg-current-y dy))
+	       (sg-out %goMVR)
+	       (sg-short-out dx)
+	       (sg-short-out dy))))
+(defun sg-move-absolute (x y)
+  (setq sg-current-x x
+	sg-current-y y)
+  (sg-out %goMVA)
+  (sg-long-out x)
+  (sg-long-out y))
+
+(defun sg-draw-line (x1 y1 x2 y2 alu)
+  (sg-move-to x1 y1)
+  (sg-draw-to x2 y2 alu))
+(defun sg-draw-to (x y alu)
+  (cond ((sg-can-i-do-it-relative? x y)
+	 (sg-draw-relative (- x sg-current-x) (- y sg-current-y) alu))
+	('else
+	 (sg-draw-absolute x y alu))))
+(defun sg-draw-relative (dx dy alu)
+  (cond ((and (zerop dx) (zerop dy))
+	 (sg-point-relative dx dy alu))
+	('else
+	 (setq sg-current-x (+ sg-current-x dx)
+	       sg-current-y (+ sg-current-y dy))
+	 (sg-with-write-mode %go*LR alu)
+	 (sg-short-out dx)
+	 (sg-short-out dy))))
+(defun sg-draw-absolute (x y alu)
+  (setq sg-current-x x
+	sg-current-y y)
+  (sg-with-write-mode %go*LA alu)
+  (sg-long-out x)
+  (sg-long-out y))
+
+(defun sg-draw-rect (x1 y1 x2 y2 alu)
+  (sg-move-to x1 y1)
+  (sg-draw-rect-to x2 y2 alu))
+(defun sg-draw-rect-to (x y alu)
+  (cond ((sg-can-i-do-it-relative? x y)
+	 (sg-draw-rect-relative (- x sg-current-x) (- y sg-current-y) alu))
+	('else
+	 (sg-draw-rect-absolute x y alu))))
+(defun sg-draw-rect-relative (dx dy alu)
+  (cond ((and (zerop dx) (zerop dy))
+	 (sg-point-relative dx dy alu))
+	('else
+	 (setq sg-current-x (+ sg-current-x dx)
+	       sg-current-y (+ sg-current-y dy))
+	 (sg-with-write-mode %go*RR alu)
+	 (sg-short-out dx)
+	 (sg-short-out dy))))
+(defun sg-draw-rect-absolute (x y alu)
+  (setq sg-current-x x
+	sg-current-y y)
+  (sg-with-write-mode %go*RA alu)
+  (sg-long-out x)
+  (sg-long-out y))
+
+(defun sg-point (x y alu)
+  (cond ((sg-can-i-do-it-relative? x y)
+	 (sg-point-relative (- x sg-current-x) (- y sg-current-y) alu))
+	('else
+	 (sg-point-absolute x y alu))))
+(defun sg-point-relative (dx dy alu)
+  (setq sg-current-x (+ sg-current-x dx)
+	sg-current-y (+ sg-current-y dy))
+  (sg-with-write-mode %go*PR alu)
+  (sg-short-out dx)
+  (sg-short-out dy))
+(defun sg-point-absolute (x y alu)
+  (setq sg-current-x x
+	sg-current-y y)
+  (sg-with-write-mode %go*PA alu)
+  (sg-long-out x)
+  (sg-long-out y))
+
+(defun sg-select-set (number)
+  (sg-out %goSET)
+  (sg-out number))
+(defun sg-move-set-origin-rel (dx dy)
+  (sg-out %goMSR)
+  (sg-short-out dx)
+  (sg-short-out dy))
+(defun sg-move-set-origin-abs (x y)
+  (sg-out %goMSA)
+  (sg-long-out x)
+  (sg-long-out y))
+(defun sg-make-set-invisible ()
+  (sg-out %goINV))
+(defun sg-make-set-visible ()
+  (sg-out %goVIS))
+(defun sg-make-set-blink ()
+  (sg-out %goBNK))
+
+(defun sg-draw-runs (run-list alu)
+  (sg-with-write-mode %go*RN alu)
+  (mapcar 'sg-short-out run-list)
+  (sg-short-out 0))
+
+(defun sg-draw-chars (char-list alu)
+  (sg-with-write-mode %go*CH alu)
+  (mapcar 'sg-short-out char-list)
+  (sg-short-out 0))
+
+(defconst sgincl-loaded 't)
diff --git a/src/dcp/supard.1 b/src/dcp/supard.1
new file mode 100644
index 00000000..9828dd61
--- /dev/null
+++ b/src/dcp/supard.1
@@ -0,0 +1,112 @@
+;;; -*-Mode:lisp-*-
+
+(or (boundp 'sgincl-loaded) (load "dcp;sgincl"))
+
+(defun bootstrap ()
+  (close sgttyo)
+  (close sgos)
+  (sstatus toplevel '(quit))
+  (gc) (gc) (gc)
+  (suspend ":Creating  SYS3;TS SUPARDî:pdump dsk:sys3;ts supardî:kill ")
+  (setq sgttyo (open "tty:" '(out image tty)))
+  (if (eq (status subsys) 'SUPARD)
+      (convert (implode (status jcl)) sgttyo)
+      (let ((jcl (readlist `(#/( ,@(nreverse (cdr (nreverse (status jcl)))) #/)))))
+	(sg-file-output (cadr jcl))
+	(convert (car jcl) sgttyo)
+	(sg-revert-output)))
+  (valret ":kill ")
+  (quit))
+
+(defun convert (i-file o-file)
+  (cond ((errset (setq ards-in (open i-file '(in ascii))) t)
+	 (errset (progn
+		  (setq sgos o-file)
+		  (setq ards-x -512. ards-y +511.)
+		  (cursorpos 'c)
+		  (sg-do '(reset enter clear ior))
+		  (sg-set-point 0 0)
+		  (setq exit-chars '(-1 3 34 35 36 37))
+		  (do ((last-char (tyi ards-in) (process-char last-char)))
+		      ((member last-char '(-1 3))))
+		  (sg-do '(exit)))
+		 t))))
+
+(defun process-char (n)
+  (sg-do '(enter))
+  (caseq n
+    (34 (enter-character-mode (tyi ards-in)))
+    (35 (enter-set-point-mode))
+    (36 (enter-long-vector-mode))
+    (37 (enter-short-vector-mode))
+    (t  (enter-character-mode n))))
+
+(defun enter-character-mode (n)
+  (sg-out %GODCH)
+  (do ((n n (tyi ards-in)))
+      ((member n exit-chars)
+       (sg-out 0)
+       (sg-set-point 0 0)
+       n)
+    (sg-out n)))
+
+(defun enter-set-point-mode ()
+  (do ((i 0)
+       (chars '())
+       (char (tyi ards-in) (tyi ards-in)))
+      ((member char exit-chars) char)
+    (setq chars (cons char chars)
+	  i (1+ i))
+    (cond ((= i 4)
+	   (let (( (x y vis) (decode-ards-long (nreverse chars))))
+	     (sg-move-to (// (setq ards-x x) 2)
+			 (// (setq ards-y y) 2)))
+	   (setq chars '() i 0)))))
+
+(defun enter-long-vector-mode ()
+  (do ((i 0)
+       (chars '())
+       (char (tyi ards-in) (tyi ards-in)))
+      ((member char exit-chars) char)
+    (setq chars (cons char chars)
+	  i (1+ i))
+    (cond ((= i 4)
+	   (let (( (x y vis) (decode-ards-long (nreverse chars))))
+	     (cond (vis (sg-draw-to (// (setq ards-x (+ ards-x x)) 2)
+				    (// (setq ards-y (+ ards-y y)) 2)
+				    tv:alu-ior))
+		   ('else
+		    (sg-move-to  (// (setq ards-x (+ ards-x x)) 2)
+				 (// (setq ards-y (+ ards-y y)) 2)))))
+	   (setq chars '() i 0)))))
+
+(defun enter-short-vector-mode ()
+  (do ((i 0)
+       (chars '())
+       (char (tyi ards-in) (tyi ards-in)))
+      ((member char exit-chars) char)
+    (setq chars (cons char chars)
+	  i (1+ i))
+    (cond ((= i 2)
+	   (let (( (x y vis) (decode-ards-short (nreverse chars))))
+	     (sg-draw-to (// (setq ards-x (+ ards-x x)) 2)
+			 (// (setq ards-y (+ ards-y y)) 2)
+			 tv:alu-ior))
+	   (setq chars '() i 0)))))
+
+(defun decode-ards-long (l)
+  (let (( (a b c d) l))
+    (list  (* (+ (lsh (logand b 37) 5) (logand (lsh a -1) 37))
+	      (cond ((oddp a) -1) ('else 1)))
+	   (* (+ (lsh (logand d 37) 5) (logand (lsh c -1) 37))
+	      (cond ((oddp c) -1) ('else 1)))
+	   (zerop (logand b 40)))))
+
+(defun decode-ards-short (l)
+  (list (* (logand (lsh (car  l) -1) 37)
+	   (cond ((oddp (car  l)) -1) ('else 1)))
+	(* (logand (lsh (cadr l) -1) 37)
+	   (cond ((oddp (cadr l)) -1) ('else 1)))
+	'T))
+
+(princ "Type  (bootstrap)  to recreate system program")