(DECLARE (SPECIAL J*STAD CURRENT-JOB %PI %PJ)
	 (NEWIO T))

(DECLARE (EVAL (READ)))
(FASLOAD HUMLSP FASL DSK GLS)

(SETQ J*STAD 23)

(DEFUN BITNAMES1 (PRE SUFS QUAN)
       (DO ((S SUFS (CDR S))
	    (L NIL (COND ((ZEROP (BOOLE 4 (CDAR S) QUAN))
			  (SETQ QUAN (- QUAN (CDAR S)))
			  (CONS (CAAR S) L))
			 (T L))))
	   ((NULL S)
	    (COND ((NULL L) QUAN)
		  ((ZEROP QUAN)
		   (CONS PRE L))
		  (T (LIST '+ (CONS PRE L) QUAN))))))

;;; NULL LOC => CURRENT START ADDRESS
;;; ATTYP => DO *ATTY

(DEFUN START-JOB (LOC ATTYP)
       (OR CURRENT-JOB (ERROR '|NO JOB - START-JOB|))
       (COND (LOC (STORE (ARRAYCALL FIXNUM CURRENT-JOB J*STAD)
			 (+ 254_33 (BOOLE 1 777777 LOC))))
	     ((ZEROP (SETQ LOC (ARRAYCALL FIXNUM CURRENT-JOB J*STAD)))
	      (ERROR '|NO START ADDRESS?|)))
       (*USET *SUPC (BOOLE 1 777777 LOC))
       (CONTINUE-JOB ATTYP))


(DEFUN JOBINT (X)
       (*DTTY)
       (TERPRI)
       (PRIN1 X)
       (PRINC '| INFERIOR INTERRUPTED|)
       (PRINT (BITNAMES %PJ %PI (*USET *RPIRQ))))

(DEFUN CHNINT (X)
       (*DTTY)
       (ERROR '|INFERIOR CHANNEL INTERRUPT| X))

(DEFUN CONTINUE-JOB (ATTYP)
       (OR CURRENT-JOB (ERROR '|NO JOB - CONTINUE-JOB|))
       (AND ATTYP (*ATTY))
       (*USET *SUSTP 0))

(DEFUN CONT ()		;HACK FOR DEBUGGING
       (*USET *SPIRQ 0)
       (CONTINUE-JOB T))

(DEFUN CALC-EFF-ADR (ADR)
       ((LAMBDA (@ X Y)
		(OR (ZEROP X)
		    (SETQ Y (BOOLE 1 777777
				   (+ Y (EXAMINE-JOB X)))))
		(COND ((ZEROP @) Y)
		      (T (CALC-EFF-ADR (EXAMINE-JOB Y)))))
	(BOOLE 1 ADR 20_22)
	(BOOLE 1 17 (LSH ADR -22))
	(BOOLE 1 777777 ADR)))

(DEFUN GOBBLE-VALRET-STRING (ADR)
       ((LAMBDA (FILE)
		(FILEPOS FILE (* ADR 5))
		(DO ((C (TYI FILE) (TYI FILE))
		     (L NIL (CONS C L)))
		    ((ZEROP C)
		     (CLOSE FILE)
		     (NREVERSE L))))
	(COND (CURRENT-JOB (OPEN CURRENT-JOB '(IN BLOCK ASCII)))
	      (T (ERROR '|NO CURRENT JOB - GOBBLE-VALRET-STRING|)))))

(DEFUN VIEW ()
       (MAKNAM (GOBBLE-VALRET-STRING (CALC-EFF-ADR (EXAMINE-JOB (- (*USET *RUPC) 1))))))