/	MARK PROGRAM FOR PDP-12

/	LAST EDIT:	08-APR-1986	05:00:00	CJL

/	ORIGINALLY WRITTEN BY RICHARD J. CLAYTON: 30-MAY-1969

/	COPYRIGHT 1969, DIGITAL EQUIPMENT CORP, MAYNARD MASS.
 
/	VERSION MARK12-1, 1970

/	RE-EDITED AND ENHANCED BY CHARLES J. LASNER: 15-JAN-1983

/	NOW P?S/8 PAL AND OS/8 PAL12 COMPATIBLE.

/	MUST BE ASSEMBLED WITH '/J' AND '/9' SWITCHES SET.

/	EQUATED SYMBOLS.

	LMODE			/JUST IN CASE

	D=	2000		/DATA FIELD BIT
	FIXMRI	JSR=	6000	/LINC MODE SUBROUTINE CALL

	PMODE			/GOODY MODE SYMBOLS

/	P?S/8 DEFINITIONS.

	INCON=	0031		/EQUATED FROM CONSOLE!
	OUTCON=	0033		/EQUATED FROM CONSOLE!
	SBOOT=	7600		/SYSTEM EXIT HERE
	SCRSIZE=7611		/SOFTWARE CORE SIZE WORD
	SYSIO=	7640		/ENTER I/O ROUTINES HERE

/	OTHER DEFINITIONS.

	JMSC=	JMS	.&7600	/CURRENT PAGE JMS INSTRUCTION
	JMSSYSI=SYSIO&177+JMSC	/CALL TO SYSIO ON ITS PAGE
	LMR=	6151		/LOAD MAINTENANCE REGISTER
	NL0002=	CLA CLL CML RTL	/LOAD AC WITH 0002
	NL0003=	CLA STL IAC RAL	/LOAD AC WITH 0003
	NL7775=	CLA CLL CMA RTL	/LOAD AC WITH 7775
	NL7777=	CLA CMA		/LOAD AC WITH 7777
	TRC=	6152		/TAPE REGISTER CLOCK
	TTY=	0003		/CONSOLE DEVICE CODE
	XFR=	6154		/TAPE REGISTER TRANSFER

/	CONSOLE IOT DEFINITIONS.

	KCCIOT=	TTY^10+6002	/CLEAR KEYBOARD FLAG
	KRSIOT=	TTY^10+6004	/READ KEYBOARD BUFFER
	KSFIOT=	TTY^10+6001	/SKIP ON KEYBOARD FLAG
	TLSIOT=	TTY+1^10+6006	/OUTPUT TO TELEPRINTER
	TSFIOT=	TTY+1^10+6001	/SKIP ON TELEPRINTER FLAG
	LMODE			/GOTO L...MODE

	SEGMNT	2		/PROGRAM LOADING STARTS HERE

	*0			/ON TOP OF ALPHA, BETA REGISTERS

	PMODE			/PROGRAM STARTS IN GOODY MODE

	MARK12=	.		/START OF MARK12 SYSTEM PROGRAM

	IFNZRO	.&177	<ERROR	.>
MARK12,	NOP			/HERE IN CASE WE'RE CHAINED TO
	JMS I	MACHECK/(ISIT12)/ENSURE WE REALLY ARE ON A PDP-12!
	LINC			/GOTO L...MODE

	LMODE			/TELL ASSEMBLER ABOUT IT

	LDA I;	20		/SET THE CLEAR BIT
	ESF			/DO A POWER CLEAR
	LIF	2		/SET OUR FIELD
	LDF	3		/SET OUR DATA FIELD
	JMP	DSP1		/GO START IT UP

	PMODE			/BACK TO GOODY MODE

MACHECK,ISIT12			/POINTER TO MACHINE CHECK ROUTINE

	LMODE			/GOTO L...MODE

	ZBLOCK	20-.		/REST OF BETA REGISTERS FOR RUNNING PROGRAM

/	MANUAL RESTART ADDRESS.

MARKAGN,JMP	DSP1		/CONTINUE THERE
EXAMANS,LDA;	ANS		/GET ANSWER VALUE
	SHD I;	0		/COMPARE TO EMPTY VALUE
	JMP	QARFSH		/JUMP IF ANSWER EMPTY (A VALID CASE)
	SHD I;	"1^100		/COMPARE TO "1"
	JMP	QARFSH		/JUMP IF ANSWER IS TENTATIVELY "1"
	SHD I;	"P^100		/COMPARE TO "P"
	JMP	QARFSH		/JUMP IF ANSWER IS TENTATIVELY "P"
	SHD I;	"B^100		/COMPARE TO "B"
	JMP	QARFSH		/JUMP IF ANSWER IS TENTATIVELY "B"

/	THIS IS THE RESTART POINT OF THE MARK12 PROGRAM. DSP1 CREATES THE
/	FIRST DISPLAY WHERE THE USER PICKS THE TYPE OF TAPE TO FORMAT.
 
DSP1,	LDF	3		/JUST IN CASE
	JSR	QAINIT		/CALL QANDA
	DS1!D			/FRAME ADDRESS
	ANS			/ANSWER BUFFER
	JMP	EXAMANS		/CHECK THERE IF NO <LF> YET

/	COMES HERE IF <LF> IS HIT.

	LDA;	ANS		/GET ANSWER VALUE
	SHD I;	"1^100		/COMPARE TO "1"
	JMP	LTAPE		/JUMP IF IT MATCHES
	SHD I;	"P^100		/COMPARE TO "P"
	JMP	PTAPE		/JUMP IF IT MATCHES
	SHD I;	"B^100		/COMPARE TO "B"
	JMP	BIGTAPE		/JUMP IF IT MATCHES
	JMP	DSP1		/GO BACK IF BAD RESPONSE

	PMODE			/WHAT FOLLOWS IS IN GOODY MODE
/	SUBROUTINE TO TEST TAPE TRANSPORTS AND MARK SWITCH TO DETERMINE
/	THAT IT IS OK TO MARK TAPE. MUST HAVE UNIT 1 SELECTED, WRITE ENABLED.
/	MUST THEN PRESS MARK SWITCH. THIS WILL PREVENT BASHING TAPE ON UNIT 0.

ONMARK,	.-.			/ONLINE, WRITE-ENABLED AND MARK SWITCH ROUTINE
	LINC			/GOTO L...MODE

	LMODE			/TELL ASSEMBLER ALSO

DSP2,	JSR	QAINIT		/CALL QANDA
	DS2A!D			/FIRST HALF-FRAME DISPLAYED DURING REVERSE MOTION
	ANS			/ANSWER BUFFER (UNUSED)
	NOP			/DON'T CARE IF ANY REPLY
	LDA I;	0144		/SETUP FOR UNIT ONE
	IOB;	TRC		/AND FORWARD MOTION
	JSR	QAINIT		/CALL QANDA
	DS2B!D			/SECOND HALF-FRAME DISPLAYED DURING FORWARD MOTION
	ANS			/ANSWER BUFFER (UNUSED)
	NOP			/DON'T CARE IF ANY REPLY
	SET I	4;	-100	/SETUP TIMED LOOP
	XSK I	4		/THIS EQUALIZES
	JMP	.-1		/FORWARD AND BACKWARD MOTION TIMES
	LDA I;	5000		/LOAD UNITS AND MOTION VALUE
	IOB;	LMR		/SELECT MAINTENANCE REGISTER
	CLR			/CLEAN UP
	IOB;	XFR		/GET THE VALUE
	SAE I;	5777		/SHOULD HAVE UNIT 1, WRITE ENABLE, AND FORWARD MOTION
	JMP	OMKST		/NOT YET
MARKSW,	LDA I;	0200		/GET MARK VALUE
	AXO			/TRY TO SET MARK FLIP-FLOP
	CLR			/CLEAN UP
	XOA			/READ IT BACK
	ROL I	5		/MOVE MARK BIT TO LINK
	LZE I			/SKIP IF IT TOOK
	JMP	OMKST		/JUMP IF NOT YET PRESSED
	PDP			/BACK TO GOODY MODE

	PMODE			/TELL ASSEMBLER ABOUT IT

/	MARK FLIP-FLOP IS ON WITH TAPE IN FORWARD MOTION.

	CLA			/CLEAN UP
	LMR			/SET TAPE MAINTENANCE REGISTER SO XFR
				/WILL TRANSFER AC TO TAPE BUFFER
	JMP I	ONMARK		/RETURN
	LMODE			/GOTO L...MODE

OMKST,	LDA I;	0024		/SETUP REVERSE MOTION
	IOB;	TRC		/START IT UP
	JMP	DSP2		/GO BACK AND TRY IT AGAIN

/	TABLE USED TO FORM BACKWARD BLOCK NUMBER.

B1TAB,	0400			/\
	1000			/ \
	2000			/  \
	4000			/   \
	0020			/    \
	0040			/     \USED WHILE WRITING THE
	0100			/     /FIRST TWELVE DATA WORDS
	0200			/    /
	0001			/   /
	0002			/  /
	0004			/ /
	0010			//

/	COMES HERE IF USER WANTS TO EXIT.

BUTIT,	PDP			/GOTO GOODY MODE

	PMODE			/ALSO TELL ASSEMBLER

	JMP I	(SBOOT)		/GOODBYE!

P7CH,	.-.			/SEVEN-BIT PRINT ROUTINE
	DCA	P7TEMP		/STASH PASSED VALUE
P7AGN,	JMS I	(CHKUP)		/CHECK FOR <^C>, ETC.
	TAD	P7TEMP		/GET THE VALUE
P7TSF,	TSFIOT			/**** CONSOLE **** CIF MCS+10
P7JMP,	JMP	P7AGN		/**** CONSOLE **** JMS OUTCON
P7TLS,	TLSIOT			/**** CONSOLE **** JMP P7AGN
	JMS I	(CHKUP)		/CHECK FOR <^C>, ETC.
	JMP I	P7CH		/RETURN

P7TEMP,	.-.			/TEMPORARY

	PAGE
	LMODE			/GOTO L...MODE

/	THIS ROUTINE IS USED AFTER CHECKING A TAPE THAT THIS PROGRAM MARKED.
/	FROM HERE THE USER RELOADS THE OPERATING SYSTEM OR MARKS ANOTHER TAPE.

DSP3,	JSR	QAINIT		/CALL QANDA
DS3OR4,	DS3!D			/**** DS3!D OR DS4!D ****
	ANS			/ANSWER BUFFER
	JMP	DSP3R		/NO ANSWER YET, CHECK BUFFER
	LDA;	ANS		/GET ANSWER VALUE
	SHD I;	"1^100		/COMPARE TO "1"
	JMP	DSP1		/RESTART IF IT MATCHES
	SHD I;	"2^100		/COMPARE TO "2"
	JMP	BUTIT		/BOOTSTRAP IF IT MATCHES
	JMP	DSP3		/BAD RESPONSE, TRY AGAIN

DSP3R,	LDA;	ANS		/GET ANSWER BUFFER SO FAR
	SHD I;	"1^100		/COMPARE TO "1"
	JMP	QARFSH		/JUMP IF IT MATCHES
	SHD I;	"2^100		/COMPARE TO "2"
	JMP	QARFSH		/JUMP IF IT MATCHES
	SHD I;	0000		/COMPARE TO EMPTY VALUE
	JMP	QARFSH		/JUMP IF IT MATCHES
	JMP	DSP3		/REJECT BAD ANSWERS

	PMODE			/WHAT FOLLOWS IS IN GOODY MODE
/	TAPE WRITE SUBROUTINE.

/	CALLING SEQUENCE:

/	JMS I	(WRTAP)		/CALL TAPE WRITE ROUTINE
/	XX			/NUMBER OF BEGINNING END MARKS
/	XX			/NUMBER OF BEGINNING INTERMEDIATE MARKS
/	XX			/NUMBER OF WORDS OF DATA/BLOCK
/	XX			/FIRST FORWARD BLOCK NUMBER
/	XX			/FIRST BACKWARD BLOCK NUMBER
/	XX			/NUMBER OF BLOCKS
/	XX			/NUMBER OF INTERMEDIATE WORDS BETWEEN BLOCKS
/	XX			/NUMBER OF FINAL INTERMEDIATE MARKS
/	XX			/NUMBER OF FINAL END MARKS
/	RETURNS HERE WITH CLEAR AC.

WRTAP,	.-.			/WRITE TAPE ROUTINE
	CLA			/CLEAN UP
	TAD I	WRTAP		/GET BEGINNING END MARKS COUNT
	ISZ	WRTAP		/BUMP TO NEXT
	DCA	KIEM		/STORE THE COUNT
	TAD I	WRTAP		/GET BEGINNING INTERMEDIATE MARKS COUNT
	ISZ	WRTAP		/BUMP TO NEXT
	DCA	KIIM		/STORE THE COUNT
	TAD I	WRTAP		/GET DATA WORD COUNT
	ISZ	WRTAP		/BUMP TO NEXT
	DCA	WRLUP2		/STORE IN-LINE
	TAD I	WRTAP		/GET FIRST FORWARD BLOCK NUMBER
	ISZ	WRTAP		/BUMP TO NEXT
	DCA	FBLK		/STASH IT
	TAD I	WRTAP		/GET FIRST BACKWARD BLOCK NUMBER
	ISZ	WRTAP		/BUMP TO NEXT
	DCA	WRLUP3		/STORE IN-LINE
	TAD I	WRTAP		/GET BLOCK COUNT
	ISZ	WRTAP		/BUMP TO NEXT
	CMA			/WANT ONE'S COMPLEMENT FORM
	DCA	BLKCNT		/STORE IT
	TAD	(HERE-1)	/SETUP THE
	DCA I	(WAIT)		/WAIT ROUTINE
	TAD	(0200)		/GET CLEAR VALUE
	TRC			/CLEAR TAPE WORD FLAG NOW
	LINC			/GOTO L...MODE

	LMODE			/TELL ASSEMBLER ABOUT IT

	JMP	FRSTGO		/GO DO FIRST WORD AND COME BACK TO HERE

	PMODE			/BACK TO GOODY MODE
HERE,	TAD	KIEM		/GET FIRST END MARKS COUNT
	JMS I	(WMKWD)		/ACTUALLY GO WRITE IT
	0000			/THIS IS THE EM CODE
	TAD	KIIM		/GET FIRST INTERMEDIATE MARKS COUNT
	JMS I	(WMKWD)		/WRITE IT OUT
	0017			/THIS IS THE IM CODE
WRLOOP,	TAD	FBLK		/GET FORWARD BLOCK NUMBER
	JMS I	(BLOCK)		/GO WRITE IT
WRLUP2,	.-.			/NUMBER OF WORDS FILLED IN
WRLUP3,	.-.			/BACKWARD BLOCK NUMBER FILLED IN
	TAD I	WRTAP		/GET IM COUNT BETWEEN BLOCKS
	JMS I	(WMKWD)		/WRITE IT OUT
	0017			/IM CODE VALUE
	ISZ	FBLK		/BUMP FORWARD BLOCK NUMBER
	NOP			/JUST IN CASE
	ISZ	WRLUP3		/BUMP BACKWARD BLOCK NUMBER
	NOP			/JUST IN CASE
	ISZ	BLKCNT		/DONE ALL BLOCKS YET?
	JMP	WRLOOP		/NO, KEEP GOING

/	TO PREVENT TIMING PROBLEMS, NOW WRITE OUT ONE FINAL IM THE EASY WAY.

	JMS I	(WAIT)		/GO WRITE IT OUT
	0017			/EM VALUE
	ISZ	WRTAP		/BUMP TO FINAL IM COUNT
	NL7777			/BACKUP
	TAD I	WRTAP		/GET CORRECTED COUNT OF FINAL IM MARKS
	ISZ	WRTAP		/BUMP TO NEXT
	JMS I	(WMKWD)		/WRITE IT OUT
	0017			/IM MARK CODE
	TAD I	WRTAP		/GET FINAL END MARKS COUNT
	ISZ	WRTAP		/BUMP PAST LAST ARGUMENT
	JMS I	(WMKWD)		/WRITE IT OUT
	0000			/EM CODE
	LINC			/GOTO L...MODE

	LMODE			/TELL ASSEMBLER ALSO
	CLR			/CLEAN UP
	AXO			/CLEAR MARK FLIP-FLOP
	SET I	4;	-50	/SETUP TIME DELAY
	LDA I;	0024		/GET REVERSE MOTION VALUE
	IOB;	TRC		/BACK UP THE TAPE
	XSK I	5		/DONE ENOUGH?
	JMP	.-5		/NO, GO DO IT AGAIN
	XSK I	4		/DONE THIS ENOUGH TIMES?
	JMP	.-7		/NO, GO DO IT AGAIN
	PDP			/YES, BACK TO GOODY MODE

	PMODE			/TELL ASSEMBLER ABOUT IT

	CLA			/CLEAN UP
	JMP I	WRTAP		/RETURN TO CALLER

BLKCNT,	.-.			/BLOCK COUNTER
FBLK,	.-.			/FORWARD BLOCK NUMBER
KIEM,	.-.			/FORWARD EM COUNTER
KIIM,	.-.			/FORWARD IM COUNTER

	PAGE
	LMODE			/GOTO L...MODE

/	ROUTINE TO WRITE A STANDARD LINC FORMAT TAPE.

LTAPE,	PDP			/GOTO GOODY MODE

	PMODE			/TELL ASSEMBLER ALSO

	JMS I	(ONMARK)	/GET MARK FLIP-FLOP TURNED ON
	JMS I	(WRTAP)		/GO WRITE THE TAPE
	2000			/BEGINNING EM
	7777			/BEGINNING IM
	0400			/256 WORDS/BLOCK
	-10			/FIRST FORWARD BLOCK NUMBER
	-10			/FIRST BACKWARD BLOCK NUMBER
	1024			/TOTAL NUMBER OF BLOCKS INCLUDING A FEW EXTRA FOR TURNAROUND
	5			/IM BETWEEN BLOCKS
	10			/NUMBER OF FINAL IM CODES
	4000			/NUMBER OF FINAL EM CODES
	LINC			/GOTO L...MODE

	LMODE			/TELL ASSEMBLER ALSO

	LDA I;	1000		/LOAD DATA BLOCK COUNT
	JMP	CHECK		/FINISH THE JOB THERE

/	ROUTINE TO WRITE 128 WORD LINCTAPES.

PTAPE,	PDP			/GOTO GOODY MODE

	PMODE			/ALSO TELL ASSEMBLER

	JMS I	(ONMARK)	/GET MARK FLIP-FLOP TURNED ON
	JMS I	(WRTAP)		/GO WRITE THE TAPE
	2000			/BEGINNING EM
	7777			/BEGINNING IM
	0200			/128 WORDS/BLOCK
	-20			/FIRST FORWARD BLOCK NUMBER
	-15			/FIRST BACKWARD BLOCK NUMBER (NOTE OFFSET!)
	3340			/TOTAL NUMBER OF BLOCKS INCLUDING A FEW FOR TURNAROUND
	5			/IM BETWEEN BLOCKS
	1777			/NUMBER OF FINAL IM CODES
	2000			/NUMBER OF FINAL EM CODES
	LINC			/GOTO L...MODE

	LMODE			/ALSO TELL ASSEMBLER

	LDA I;	3300		/GET DATA BLOCK COUNT
	JMP	CHECK		/FINISH THE JOB THERE
/	ROUTINE TO WRITE OUT 1600 BLOCK STANDARD LENGTH TAPES.

BIGTAP,	PDP			/GOTO GOODY MODE

	PMODE			/ALSO TELL ASSEMBLER

	JMS I	(ONMARK)	/GET MARK FLIP-FLOP TURNED ON
	JMS I	(WRTAP)		/GO WRITE THE TAPE
	1000			/BEGINNING EM
	7777			/BEGINNING IM
	0400			/256 WORDS/BLOCK
	-10			/FIRST FORWARD BLOCK NUMBER
	-10			/FIRST BACKWARD BLOCK NUMBER
	1624			/TOTAL NUMBER OF BLOCKS INCLUDING A FEW FOR TURNAROUND
	5			/IM BETWEEN BLOCKS
	10			/NUMBER OF FINAL IM CODES
	0400			/NUMBER OF FINAL EM CODES
	LINC			/GOTO L...MODE

	LMODE			/ALSO TELL ASSEMBLER

	LDA I;	1600		/GET DATA BLOCK COUNT
	JMP	CHECK		/FINISH THE JOB THERE

	PMODE			/WHAT FOLLOWS IS IN GOODY MODE
/	ROUTINE TO WRITE A BLOCK OF TAPE.

/	CALLING SEQUENCE:

/	TAD	(FORWARD BLOCK)	/AC CONTAINS FORWARD BLOCK NUMBER
/	JMS I	(BLOCK)		/CALL BLOCK WRITE ROUTINE
/	DATA WORD COUNT		/COUNT OF DATA WORDS IN BLOCK
/	REVERSE BLOCK		/REVERSE BLOCK NUMBER

/	THIS ROUTINE WILL WRITE:

/	BM  (FORWARD)
/	GM
/	DM  (MINIMUM 14, MAXIMUM 4096)
/	FM
/	CM  (THREE WORDS)
/	GM
/	BM  (BACKWARD)

BLOCK,	.-.			/WRITE A BLOCK ROUTINE
	CMA			/NEED COMPLEMENT FORM
	JMS I	(WAIT)		/WRITE FORWARD BM
	0016			/BLOCK NUMBER CODE WORD
	TAD I	BLOCK		/GET NUMBER OF DATA WORDS
	CLL CMA			/INVERT FOR TEST
	TAD	(16)		/ADD ON LIMITING VALUE
	SZL			/SKIP IF MORE THAN 14 WORDS
	HLT			/ELSE BARF
	SNA			/SKIP IF NOT EXACTLY 14 WORDS
	HLT			/ELSE BARF
	DCA	COUNTA		/SAVE CORRECTED NUMBER OF WORDS
	ISZ	BLOCK		/BUMP TO NEXT ARGUMENT
	TAD I	BLOCK		/GET BACKWARD BLOCK NUMBER
	DCA	BKBNS		/SAVE IT
	DCA	BKBNA		/CLEAR BACKWARD BLOCK ASSEMBLY REGISTER
	JMS I	(WAIT)		/WRITE GUARD WORD
	0002			/GUARD MARK CODE
	TAD	(-14)		/SETUP
	DCA	COUNTB		/BIT COUNTER
	TAD	(B1TAB)		/SETUP THE
	DCA	TEMPA		/BIT TABLE POINTER
BLKLP1,	TAD	(5252)		/GET DATA PATTERN
	JMS I	(WAIT)		/WRITE OUT A DATA WORD
	0011			/DATA MARK CODE
	TAD	BKBNS		/GET BACKWARDS BLOCK NUMBER
	RAL			/SHIFT IT OVER
	DCA	BKBNS		/SAVE IT BACK
	SZL			/SKIP IF LATEST IS OFF
	TAD I	TEMPA		/ELSE USE TRANSLATED BIT
	TAD	BKBNA		/ADD ONTO ACCUMULATION
	DCA	BKBNA		/SAVE IT BACK
	ISZ	TEMPA		/BUMP TO NEXT BIT VALUE
	ISZ	COUNTB		/DONE 12 YET?
	JMP	BLKLP1		/NO, GO BACK
BLKLP2,	TAD	(5252)		/GET DATA PATTERN
	JMS I	(WAIT)		/WRITE OUT A DATA WORD
	0011			/DATA MARK CODE
	ISZ	COUNTA		/DONE ALL ADDITIONAL DATA WORDS YET?
	JMP	BLKLP2		/NO, GO BACK
	TAD	(5252)		/GET DATA PATTERN
	JMS I	(WAIT)		/WRITE OUT
	0013			/FINAL MARK CODE
	NL0003			/SETUP THE COUNT
	JMS I	(WMKWD)		/WRITE OUT THREE WORDS OF
	0001			/CHECK MARK CODE
	JMS I	(WAIT)		/WRITE OUT
	0002			/GUARD MARK CODE
	TAD	BKBNA		/GET BACKWARD BLOCK NUMBER
	JMS I	(WAIT)		/WRITE OUT
	0007			/BACKWARD BLOCK NUMBER CODE
	ISZ	BLOCK		/BUMP PAST LAST ARGUMENT
	JMP I	BLOCK		/RETURN

COUNTA,	.-.			/NUMBER OF DATA WORDS COUNTER
COUNTB,	.-.			/COUNTER FOR FIRST 12 DATA WORDS
TEMPA,	.-.			/TEMPORARY
BKBNA,	.-.			/FORM BACKWARD BLOCK NUMBER IN COMPLEMENT OBVERSE FORM
BKBNS,	.-.			/BACKWARD BLOCK NUMBER IN BINARY FORM

	PAGE
/	ROUTINE TO WAIT FOR COMPLETION OF CURRENT TAPE WORD AND THEN
/	TRANSFER DATA TO TAPE CONTROL FOR THE NEXT WORD (4 LINES).
 
/	CALLING SEQUENCE:

/	TAD	(DATA WORD)	/AC CONTAINS DATA WORD TO BE WRITTEN
/	JMS I	(WAIT)		/CALL WAIT ROUTINE
/	MARK CODE		/MARK CODE TO BEW WRITTEN WITH DATA WORD

/	PROGRAM MUST RETURN WITH THE NEXT WORD TO BE WRITTEN WITHIN 42
/	MICROSECONDS. THIS SUBROUTINE TAKES UP TO 52 MICROSECONDS IF SYSTEM
/	CYCLE TIME WERE TO GET AS SLOW AS 1.9 MICROSECONDS.

WAIT,	.-.			/WAIT ROUTINE
	XFR			/COMPLEMENT OF TAPE BUFFER WILL BE WRITTEN ON THE TAPE
	CLA CLL			/CLEAN UP
	TAD I	WAIT		/GET MARK CODE
	LINC			/GOTO L...MODE

	LMODE			/TELL ASSEMBLER ALSO

	TWC I			/FLAG UP ALREADY?
	HLT			/YES, BARF
FRSTGO,	TWC			/NO, WAIT FOR IT
	JMP	FRSTGO		/TO COME UP
	LDA I;	0200		/GET CLEAR VALUE
	PDP			/GOTO GOODY MODE

	PMODE			/TELL ASSEMBLER ALSO

	TRC			/CLEAR TAPE FLAG
	ISZ	WAIT		/BUMP PAST MARK CODE
	CLA			/CLEAN UP
	JMP I	WAIT		/RETURN
/	ROUTINE TO WRITE A NUMBER OF WORDS OF A GIVEN MARK CODE.

/	CALLING SEQUENCE:

/	TAD	(WORD COUNT)	/AC CONTAINS NUMBER OF WORDS TO BE WRITTEN
/	JMS I	(WMKWD)		/CALL ROUTINE
/	RETURNS WTH CLEAR AC.

/	THIS SUBROUTINE ADDS 17 CYCLES TO THE WAIT ROUTINE AND MUST BE CALLED
/	WITHIN 20 MICROSECONDS OF THE LAST WAIT EXIT. THIS ADDS 10 MICROSECONDS
/	TO THE WAIT EXIT TIME.

WMKWD,	.-.			/MARK WRITE ROUTINE
	CIA			/INVERT WORD COUNT
	DCA	WMCNT		/STASH THE COUNT
	TAD I	WMKWD		/GET THE MARK CODE
	DCA	WMCODE		/STASH IT
	JMS	WAIT		/GO WRITE A WORD
WMCODE,	.-.			/MARK CODE HERE
	ISZ	WMCNT		/DONE YET?
	JMP	.-3		/NO, GO DO IT AGAIN
	CLA			/YES, CLEAN UP
	ISZ	WMKWD		/BUMP PAST ARGUMENT
	JMP I	WMKWD		/RETURN

WMCNT,	.-.			/WORD COUNTER

	LMODE			/L...MODE CODE FOLLOWS
/	ROUTINE TO CHECK THE JUST-WRITTEN TAPE. AC SHOULD CONTAIN TOTAL
/	NUMBER OF POSITIVE DATA BLOCKS. THE ROUTINE WILL WRITE A PATTERN OF
/	11+11+11 ETC. IN EACH BLOCK, THEN BACKWARD BLOCK NUMBERS ARE CHECKED,
/	THEN ALL BLOCKS ARE READ INTO CORE AND THEIR CHECKSUMS VERIFIED;
/	THEN THE LAST DATA BLOCK IS CHECKED TO BE SURE ALL DATA IS CORRECT.

/	ROUTINE EXITS TO DSP3 ROUTINE WHICH INFORMS THE USER OF TAPE VIABILITY.
/	USER CAN OPT TO MARK MORE TAPES OR RESTART THE OPERATION SYSTEM.

CHECK,	STC	CFBLK		/SAVE NUMBER OF BLOCKS
	LDF	0		/SETUP DATA BUFFER FIELD
	SET I	1;	3777	/SETUP DATA POINTER
	LDA I;	11		/GET DATA INCREMENT
	STA I	1		/STORE A VALUE
	ADD	.-2		/ADD ON DATA INCREMENT
	XSK	1		/DONE YET?
	JMP	.-3		/NO, KEEP GOING
	CLR			/CLEAN UP
	STC	WBLKNO		/INITIALIZE BLOCK NUMBER
	LDA I;	0020		/SETUP EXTENDED ADDRESSING MODE
	AXO			/FOR TAPE TRANSFER
WLOOP,	LDA I;	0		/GET TRANSFER ADDRESS
	TMA			/LOAD TMA SETUP REGISTER
	WRI I	U		/WRITE ON TAPE ONE
WBLKNO,	.-.			/BLOCK NUMBER WILL BE INCRMENTED
	LDA I;	1		/GET BLOCK INCREMENT
	ADM;	WBLKNO		/INCREMENT BLOCK NUMBER
	SAE I			/COMPARE LATEST TO
CFBLK,	.-.			/FINAL BLOCK NUMBER
	JMP	WLOOP		/KEEP GOING IF NOT THERE YET
	MTB I	U;	0000	/START TAPE MOVING BACKWARDS
	MTB I	U;	0000	/JUST IN CASE, DO IT AGAIN
BTSTLP,	ADA I;	0001		/ADD ON INCREMENT
	STA I			/STORE RESULTANT
BTEST,	.-.			/HERE FOR TEST
	MTB I	U;	0	/MOVE TOWARDS BLOCK ZERO
	SAE;	BTEST		/SKIP IF BLOCK MATCHES INTENDED
	JMP	RERROR		/JUMP IF BACKWARD BLOCK NUMBER WRONG
	AZE			/AT BEGINNING OF TAPE?
	JMP	BTSTLP		/NO, KEEP GOING
/	NOW READ CHECK THE TAPE.

	LDA I;	0020		/GET EXTENDED ADDRESSING BIT
	AXO			/LOAD IT
	CLR			/CLEAN UP
	STC	RBLKNO		/INITIALIZE TO BLOCK ZERO
RLOOP,	LDA I;	0000		/GET TRANSFER ADDRESS
	TMA			/LOAD TMA SETUP REGISTER
	RDE I	U		/READ IN
RBLKNO,	.-.			/LATEST BLOCK
	SAE I;	7777		/COMPARE CHECKSUM TO DESIRED
	JMP	RERROR		/JUMP IF BAD
	LDA I;	0001		/GET BLOCK INCREMENT
	ADM;	RBLKNO		/BUMP THE BLOCK NUMBER
	SAE;	CFBLK		/AT HIGHEST BLOCK YET?
	JMP	RLOOP		/NO, KEEP READING
	SET I	1;	3777	/SETUP DATA POINTER
	LDA I;	11		/GET INITIAL DATA VALUE
DLOOP,	SAE I	1		/VALUE CORRECT?
	JMP	RERROR		/NO, BARF
	ADD	.-3		/ADD ON DATA INCREMENT
	XSK	1		/DONE YET?
	JMP	DLOOP		/NO, KEEP GOING
	LDA I;	DS3!D		/SETUP FOR GOOD TAPE FRAME
	JMP	.+3		/DON'T USE BAD FRAME

RERROR,	LDA I;	DS4!D		/SETUP ERROR FRAME
	STC	DS3OR4		/STORE PROPER FRAME ADDRESS
	LDF	3		/SETUP DATA FIELD
	CLR			/CLEAN UP
	AXO			/CLEAR EXTENDED ADDRESSING MODE
	MTB I	U;	0000	/START THE TAPE
	MTB I	U;	0000	/MOVING BACKWARDS
	JMP	DSP3		/NOW GO TELL THEM THE NEWS

ANS,	ZBLOCK	2		/ANSWER BUFFER FOR QANDA CALLS
	PAGE

/	QANDA SUBROUTINE FOR THE PDP-12.

/	COMES HERE TO INITIALIZE THE ROUTINE.

QAINIT,	LDA I;	2		/SET SKIP RETURN VALUE
	ADD	0		/GET CALLER
	STA I			/STORE RETURN
QAB,	.-.			/HERE FOR EXIT LATER
	ADD	QAL+3
	STC	1		/PTR TO FIRST PARAM
	LDA	1		/GET FIRST PARAM
	ADD	QAQ+1		/PTR TO HALFWORD-1
	STC	QAG-3
	LDA I	1
	STC	QARFSH-1
	STC	6		/XR6=0 IF NO ANSWER FIELD, XR6=1777 IF YES
QACA,	SET	3;	QARFSH-1/POINT XR3 TO ANSWERS
	SET	4;	QAG-3	/POINT XR4 TO QUESTIONS

/	COMES HERE IF FIRST TIME THROUGH OR FOLLOWING A <CR>.

	SET	1;	4
	JMP	QAT
	NOP			/F
	LDH I	4		/H. BUMP PTR IF H OR F
QAD,	JMP	QAO
	JMP	.+6		/74
	JMP	QAE		/34
	SAE I;	43		/<CR>?
	JMP	QAD		/NO
	JMP	QACA+4		/EXAMINE NEXT CHAR
				/INITIALIZE ANSWER BUFR
	STH	3		/74 TO ANSWERS
	LDH I	4		/NEXT HALFWORD
	ADA I;	-60
	COM
	STC	6
	STH I	3		/0 IN AC
	XSK I	6
	JMP	.-2
	LDH I	3		/BUMP PTR TO ANSWERS
	JMP	QAD
/	ANSWER BUFFER IS INITIATED.

QAE,	STH	3
	SET I	4;	0	/XR4 TO PTR TO LAST TYPED CHAR IN ANSWER BUFR

/	----RE-ENTER HERE TO REFRESH----

QARFSH,	LDA I;	377		/SET INITIAL Y POSITION HIGH
	STC	QAH-1
	SET I	3;	0	/XR3 TO PTR TO HALFWORD QUESTIONS-1
	SET	5;	QARFSH-1/XR5 TO PTR TO LAST DISPLAYED CHAR IN ANSWER BUFR
QAG,	SET	1;	3
	JMP	QAT
	JMP	.+7		/F
	LDH I	3		/H. BUMP PTR
	LDA I;	BCL I		/NEITHER. ASSUME HALF SIZE
	STC	QAM+2		/SET INSTR TO CLEAR FF FOR HALF SIZE
	ADD	QAW		/NOP IN AC
	JMP	QAM
	LDH I	3		/BUMP PTR
	LDA I;	BSE I
	STC	QAM+2		/SET INSTR TO SET FF FOR FULL SIZE
	ADD	QAW+1		/ADD 9U IN AC
QAM,	STC	QAP+3
	MSC I	4		/READ CONTROL REGISTER
	BSE I;	200		/THIS INSTR CHANGES. EITHER BSE I OR BCL I
	MSC	 4		/AC TO CONTROL REGISTER
	SET I	1;	100	/XR1 TO INITIAL X POSITION
	LDA I;	-40		/Y COORDINATE MULTIPLE
	ADM I;	0		/Y COORDINATE
QAH,	LDH I	3
	JMP	QAO+1
	JMP	QAZ		/74 BUMP PTR TO NEXT CHAR, PUT 40 IN AC
	JMP	QAJ		/34
	SHD I;	"#^100		/NEITHER
	JMP	QAG		/CR. MOVE X AND Y COORDINATE
	JMP	QAP		/DISPLAY CHAR
	JMP	QAH		/PICK UP NEXT CHAR
	JMP	QAP		/TO HERE IF DISPLAYING ANSWER BUFR
	SRO I;			/SWITCH TO DISPLAY CURSOR. EITHER 0000 OR 7777
	0			/IF XR4=XR5, THEN SWITCH=7777
	JMP	QAF
/	QUESTION MODE.

QAI,	LDH I	5
	JMP	QAO+1
	JMP	QAH		/74
	JMP	QAH		/34
	JMP	QAI-4		/NEITHER. DISPLAY IT
QAJ,	JMP	GETKBD		/TO HERE IF DISPLAYED BUFFER
	AZE I
	JMP	QAB		/NOTHING TYPED . EXIT
	SET I	2;	QAY
	SHD	2		/LF?
	JMP	QAK+4		/YES. EXIT
	SHD I	2		/CR?
	JMP	QAN
	XSK	6		/IS THERE AN ANSWER FIELD?
	JMP	QARFSH
	SHD I	2		/<?
	JMP	QAL
	SHD I	2		/>?
	JMP	QAK
	SHD I	2		/ALT?
	JMP	QACA		/REINITIALIZE
	SHD I	2		/BACK SLASH?
	JMP	QARFSH		/IGNORE
	SHD I	2		/RUBOUT?
	JMP	QAL		/IGNORE
	SHD I	2		/TAB?
	JMP	QARFSH		/IGNORE
	STC	.+5		/ACCEPTABLE CHAR
	JMP	QAO		/TEST NEXT CHAR
	JMP	QAQ		/74 BACK PTR UP BY 1
	JMP	QAQ		/34 ^
	LDA I;	0		/OK. STORE IT
	STH	4
	JMP	QARFSH		/REDISPLAY

QAL,	LDH	4		/TO HERE IF RUBOUT OR <
	JMP	QAO+1
	JMP	QARFSH		/74 IGNORE
	-6002
	LDH	2		/TEST THE CHAR
	SAE I;	37		/RUBOUT?
	JMP	QAQ		/NO. BACK PTR UP BY 1
	SET	5;	4
	SET	3;	4
	JMP	.+2
	LDH I	5		/BUMP PTR
	LDH I	3		/GET NEXT CHAR
	JMP	QAO+1
	NOP			/IF 74 OR 34, REPLACE CURRENT CHAR WITH 0
	CLR
	STH	5
	AZE			/WAS IT 74 OR 34?
	JMP	.-7		/NO. CONTINUE
	JMP	QAQ		/BACK PTR UP BY 1

/	TO HERE IF CR.

QAN,	XSK	 6	
	JMP	QAK+4		/EXIT ROUTINE IF NO ANSWER FIELD
	JMP	QAO
	JMP	QARFSH		/74 MOVE PTR TO NEXT QUESTION FIELD
	JMP	QAE+1		/34 END OF BUFR. MOVE PTR TO FIRST QUESTION FIELD
	JMP	QAN+2
	
QAO,	LDH I	4		/S\R
	SHD I;	7400		/+1 74 BEGIN FIELD
	JMP	0		/+3 NEITHER 74 NOR 34
	SAE I;	34
	XSK I	0
	XSK I	0
	JMP	0

/	S\R TO DISP LINC CHAR IN AC.

QAP,	ROL	1		/MULT BY 2 FOR INDEX TO ADDRESS OF TABLE
	ADD	QAX+4
	STC	2		/ADDRESS OF CHAR TO DISP IN XR2
	ADD	QAU		/THIS INSTR CHANGES. EITHER OP OR ADD 9U
	ADD	QAU
	ADD	1		/ADD 4 TO XR1 TO SPACE CHAR
	STC	1
	ADD	5		/GET ADDRESS OF ANSWER BUFR
	COM
	ADD	4
	AZE
	CLR
	STC	QAI-2		/SWITCH=0 OR 7777
	ADD	QAH-1		/Y COORDINATE IN AC
	DSC	2
	DSC I	2		/DISPLAY CHAR
	JMP	0

QAQ,	LDA I;	-4000		/BACK UP PTR BY 1
	ADM;	4
	JMP	QARFSH		/REDISPLAY
QAT,	LDH I	1		/S\R
	SHD I;	"F^100		/+1 F
	JMP	0		/+3 NEITHER
	SAE I;	10
	XSK I	0
	XSK I	0
	JMP	0

QAZ,	LDH I	3
	LDA I;	40
	JMP	QAI-4

/	TO HERE IF >.

QAK,	LDH I	4
	AZE I			/IS CURRENT CHAR BLANK?
	JMP	QAQ		/YES. IGNORE
	JMP	QAX		/MOVE DOT FORWARD

/	TO HERE TO EXIT WITH SKIP.

	LDA I;	1
	ADM;	QAB
	JMP	QAB
/	CHARACTER PATTERNS.

QAV,	0101			/KBD 0, ILLEGAL. USED AS MARKER
	0101
	4477			/1:A
	7744
	5177			/2:B
	2651
	4136			/3:C
	2241
	4177			/4:D
	3641
	4577			/5:E
	4145
	4477			/6:F
	4044
	4136			/7:G
	2645
	1077			/10:H
	7710
	7741			/11:I
	0041
	4142			/12:J
	4076
	1077			/13:K
	4324
	0177			/14:L
	0301
	3077			/15:M
	7730	
	3077			/16:N
	7706	
	4177			/17:O
	7741
	4477			/20:P
	3044
	4276			/21:Q
	0376
	4477			/22:R
	3146
	5121			/23:S
	4651
	4040			/24:T
	4077
	0177			/25:U
	7701	
	0176			/26:V
	7402
	0677			/27:W
	7701
	1463			/30:X
	6314
	0770			/31:Y
	7007
	4543			/32:Z
	6151
	4177			/33:/
	0000
				/34:BACKSLASH IGNORED ON INPUT
	0			/NOT USED
	0			/NOT USED
	0000			/35:]
	7741
				/CODES 36:ALT, 37:RUBOUT NOT DISPLAYED
QAY,	4543			/LF,CR
	7476			/<,>
	3634			/ALT, BACKSLASH
	3747			/RUBOUT, TAB
	0000			/40:SPACE
	0000
	7500			/41:X!
	0000
	7000			/42:"
	0070
				/CODES 43:, 44:, 45:LF NOT DISPLAYED
QAX,	JMP	QAO+1
	JMP	QAQ
	JMP	QAQ
	JMP	QARFSH
	QAV
	0			/NOT USED
	5166			/46: &
	0526
				/CODE 47:TAB NOT DISPLAYED
	0			/NOT USED
	0			/NOT USED
	3600			/50:(
	0041
	4100			/51:)
	0036
	2050			/52:*
	0050
	0404			/53:+
	0437
	0500			/54:,
	0006
	0404			/55:-
	0404
	0001			/56:.
	0000
	0601			/57:\
	4030
	4536			/60:0
	3651
	2101			/61:1
	0177
	4523			/62:2
	2151
	4122			/63:3
	2651
	2414			/64:4
	0477
	5172			/65:5
	0651
	1506			/66:6
	4225
	4443			/67:7
	6050
	5126			/70:8
	2651
	5122			/71:9
	3651
	2200			/72::
	0000
	4601			/73:;
	0000
				/CODE 74:<NOT DISPLAYED
QAU,	2			/CONSTANT
	0			/NOT USED
	1212			/75:=
	1212
				/CODE 76:> NOT DISPLAYED
QAW,	NOP
	ADD	QAU
	4020			/77:?
	2055

QAF,	DSC I;	6000
	JMP	QAI

/	END Q+A.
/	KEYBOARD INPUT ROUTINE.

GETKBD,	LDA;	0
	STC	QAEXIT+6	/SAVE RETURN
	ADD	1		/SAVE XRS 1 AND 2
	STC	QAEXIT+3
	ADD	2
	STC	QAEXIT+5
	STC	QAEXIT+1
	KST			/WAS SOMETHING TYPED?
	JMP	0		/NO: EXIT
	IOB;	KRB		/GET TTY CHARACTER, CLEAR THE FLAG
	STA I			/SAVE IT
QATY,	.-.
	ADA I;	-237
	APO			/BETWEEN 200 AND 237?
	JMP	QACNTR		/CONTROL CHAR. CHECK FOR CR, LF, TAB
	SET I	1;	QACHAR-1/NO
	SET I	2;	-7
	LDA;	QATY
	SAE I	1
	JMP	.+2
	JMP	QAEXIT		/ILLEGAL CHAR. DONT ECHO
	XSK I	2		/CHECKED THEM ALL?
	JMP	.-4
	ADA I;	-337
	APO			/BETWEEN 240 AND 337?
	JMP	QALEGL		/YES. LEGAL CHAR
	SAE I	1		/NO. CHECK FURTHER.
	JMP	.+7
	LDA I;	334		/RUBOUT
	JMP	QATPE		/ECHO BACKSLASH
	LDA I;	37
	JMP	QAEXIT+2	/LEGAL EXIT
	SAE I	1
	JMP	QAEXIT		/ILLEGAL
				/ALT
	JMP	QAEXIT+2	/EXIT, DONT ECHO
QALEGL,	LDA;	QATY
	JMP	QATPE		/ECHO CHAR
	ADD	QATY
	BCL I;	7700		/STRIP IT TO 6-BIT
	JMP	QAEXIT+2

/	TO HERE IF CONTROL CHAR.

QACNTR,	SAE I;	7755
	JMP	QACKLF
	LDA I;	43		/CR
	STC	QAEXIT+1
	LDA I;	215
	JMP	QATPE
	LDA I;	212
	JMP	QATPE
	JMP	QAEXIT

QACKLF,	SAE I;	7752
	JMP	.+4
	LDA I;	45		/LF
	JMP	QACNTR+5
	SAE I;	7751
	JMP	QAEXIT		/ILLEGAL
	LDA I;	47
	JMP	QAEXIT+2	/EXIT, DONT ECHO

QAEXIT,	LDA I;	0		/GET 6-BIT ASCII
	SET I	1;	0	/RESTORE XRS
	SET I	2;	0
	JMP	0		/EXIT S\R GETKBD
/	S\R TO PRINT C(AC).

QATPE,	IOB;	TLS
	LDA;	0
	STC	.+4		/SAVE RETURN
	IOB;	TSF
	JMP	.-2
	JMP	0	 	/EXIT

QACHAR,	243			/HASH
	244			/DOLLAR SIGN
	245			/PER CENT
	247			/APOSTROPHE
	300			/AT SIGN
	336			/UP ARROW
	337			/BACK ARROW
	40			/RUBOUT
	36			/ALT
	PMODE			/GOTO GOODY MODE

ISIT12,	.-.			/MACHINE CHECK ROUTINE
	CLA			/CLEAN UP
	LINC			/GOTO LINC MODE
	COM			/COMPLEMENT AC
	PDP			/COME BACK TO PDP MODE
	IAC			/SHOULD BE ZERO
	SNA CLA			/SKIP IF NOT A -12
	JMP I	ISIT12		/ELSE JUST RETURN
	TAD I	(SBOOT)		/GET BOOTSTRAP INSTRUCTION
	TAD	(-JMSSYSIO)	/COMPARE TO POSSIBLE VALUE
	SNA CLA			/SKIP IF DIFFERENT
	JMP	CHKCOVERLAY	/JUMP IF IT MATCHES
	ISZ	CHKKRS		/TURN "KRSIOT"
	ISZ	CHKKRS		/INTO "KRBIOT"
	DCA	CHKKCC		/DESTROY "KCCIOT"
CHKCOVR,NL0002			/SETUP "C" BIT MASK
	AND I	(SCRSIZE)	/GET THE "C" BIT
	SNA CLA			/SKIP IF CONSOLE OVERLAY PRESENT
	JMP	COMPLAIN	/JUMP IF NOT
	TAD I	(SCRSIZE)	/GET THE CORE SIZE WORD
	RTR;RAR			/MOVE OVER AND
	AND	(70)		/ISOLATE MCS BITS
	TAD	(CIF	10)	/TURN INTO CIF MCS+10
	DCA I	(P7TSF)		/STORE OVER "TSFIOT"
	TAD I	(P7JMP)		/GET "JMP P7AGN"
	DCA I	(P7TLS)		/STORE OVER "TLSIOT"
	TAD	(JMS	OUTCON)	/GET OUTPUT CALL INSTRUCTION
	DCA I	(P7JMP)		/STORE OVER "JMP P7AGN"
	TAD I	(P7TSF)		/GET "CIF MCS+10" AGAIN
	DCA	CHKKSF		/STORE OVER "KSFIOT"
	TAD	CHKJMP		/GET "JMP I CTLCTST"
	DCA	CHKKRS		/STORE OVER "KRSIOT" (OR "KRBIOT")
	TAD	(JMS	INCON)	/GET INPUT CALL INSTRUCTION
	DCA	CHKJMP		/STORE OVER "JMP I CTLCTST"
	DCA	CHKKCC		/DESTROY "KCCIOT"
COMPLAI,TAD I	MESSPTR		/GET A CHARACTER
	SNA			/END OF MESSAGE?
	JMP I	(SBOOT)		/YES, GOODBYE!
	JMS I	(P7CH)		/NO, PRINT IT
	ISZ	MESSPTR		/BUMP TO NEXT
	JMP	COMPLAIN	/GO DO ANOTHER ONE
CTLCTST,.-.			/CHECK FOR <^C> ROUTINE
	CLA			/CLEAN UP
CHKKSF,	KSFIOT			/**** CONSOLE **** CIF MCS+10
CHKJMP,	JMP I	CTLCTST		/**** CONSOLE **** JMS INCON
CHKKRS,	KRSIOT/OR KRBIOT	/**** CONSOLE **** JMP I CTLCTST
	AND	(177)		/JUST SEVEN BITS
	DCA I	(INCHAR)	/STASH THE CHARACTER
	NL7775			/-3
	TAD I	(INCHAR)	/COMPARE INPUT TO <^C>
	SNA			/SKIP IF OTHER
	ISZ I	(SCRSIZE)	/ELSE SET SOFT INDICATOR
	SPA SNA CLA		/SKIP IF <^D> OR GREATER
	JMP I	(SBOOT)		/ELSE GOODBYE
CHKKCC,	KCCIOT/OR 0000		/**** CONSOLE **** 0000
	TAD I	(INCHAR)	/GET THE CHARACTER
	JMP I	CTLCTST		/RETURN

MESSPTR,MESSAGE			/COMPLAINT MESSAGE POINTER

	PAGE

	LMODE			/GOTO L...MODE
	SEGMNT	3		/WHERE TEXT FRAMES GO

	*1			/START OF FRAMES
 
/	FRAME 1:

/   MARK12
/THIS PROGRAM WILL FORMAT AND CHECK 
/LINC TAPES FOR THE PDP-12
 
/SELECT OPTION AND PRESS LINE FEED 
/ON THE CONSOLE TELETYPE
 
/SELECT -
 
/ 1 STD LINC FORMAT
 
/ P 129 WORD FORMAT
 
/ B 1600 STD BLKS
 
/	FRAME 2:
 
/MOUNT TAPE TO BE
/MARKED ON THE RIGHT
/REEL OF UNIT 1
 
/PLACE UNIT 1 IN
/REMOTE WITH
/WRITE ENABLED, THEN
 
/PRESS THE MARK SWITCH
 
 
/	FRAME 3:
 
/   GOOD TAPE
 
/ALLOW MARKED TAPE TO REWIND
/THEN SELECT OPTION AND TYPE
/LINE FEED ON THE TELETYPE
 
/SELECT -
 
/ 1 MARK ANOTHER TAPE
 
/ 2 RESTART P?S/8
/FRAME 4
 
/TAPE CHECK FAILED
 
/SELECT -
 
/ 1 MARK ANOTHER TAPE
 
/ 2 RESTART P?S/8

DS1,	TEXT	"F    MARK 12#H#H"
	TEXT	"    THIS PROGRAM WILL FORMAT AND CHECK#H"
	TEXT	"    LINC TAPES FOR THE PDP-12#"
	TEXT	"H#H    SELECT OPTION AND PRESS LINE FEED"
	TEXT	"#H    ON THE CONSOLE TELETYPE# #"
	TEXT	"FSELECT  <1# #"
	TEXT	"F  1  STD LINC FORMAT#F#"
	TEXT	"F  P  128 WORD FORMAT#F#"
	TEXT	"F  B  896 STD  BLKS#\"
DS2A,	TEXT	"#F MOUNT TAPE TO BE#"
	TEXT	"F MARKED ON THE RIGHT#"
	TEXT	"F REEL OF UNIT 1.#F#"
	TEXT	"F PLACE UNIT 1 IN#\"
DS2B,	TEXT	"# # # # # #F"
	TEXT	" REMOTE WITH #" 
	TEXT	"F WRITE ENABLED, THEN#F #F"
	TEXT	" PRESS THE MARK SWITCH#\"
DS3,	TEXT	"F#F   GOOD TAPE#F#"
	TEXT	"H   ALLOW MARKED TAPE TO REWIND#"
	TEXT	"H   THEN SELECT OPTION AND TYPE#"
	TEXT	"H   LINE FEED ON THE TELETYPE#F#"
	TEXT	"FSELECT  <1#F#"
	TEXT	"F 1 MARK ANOTHER TAPE#F#"
	TEXT	"F 2 BOOT P?S/8 #\"
DS4,	TEXT	"F#F   TAPE CHECK FAILED#"
	TEXT	"F#F#F#FSELECT <1#F#F"
	TEXT	" 1 MARK ANOTHER TAPE#F#F"
	TEXT	" 2  RESTART P?S/8#F#\"
	PMODE			/GOTO GOODY MODE

CHKUP,	.-.			/CHECK FOR <^C>, ETC. ROUTINE
	JMS I	(CTLCTST)	/CHECK FOR <^C>
	SZA			/SKIP IF NOTHING CAME IN
	TAD	(-"Q!300)	/ELSE COMPARE TO <^Q>
	SNA			/SKIP IF NEITHER CASE
	JMP	CHKCLR		/ELSE FORGET IT
	TAD	(-"S+"Q)	/COMPARE TO <^S>
	SZA CLA			/SKIP IF IT MATCHES
	JMP I	CHKUP		/ELSE RETURN
	JMS I	(CTLCTST)	/GET ANOTHER CHARACTER
	TAD	(-"Q!300)	/COMPARE TO <^Q>
	SZA CLA			/SKIP IF IT MATCHES
	JMP	.-3		/ELSE KEEP GOING
CHKCLR,	DCA	INCHAR		/OBLITERATE <^Q>, ETC.
	JMP I	CHKUP		/RETURN

/	COMPLAINT MESSAGE.

MESSAGE,15			/<CR>
	12			/<LF>
	"N&177
	"O&177+40
	"T&177+40
	" &177
	"R&177
	"U&177+40
	"N&177+40
	"N&177+40
	"I&177+40
	"N&177+40
	"G&177+40
	" &177
	"O&177+40
	"N&177+40
	" &177
	"P&177
	"D&177
	"P&177
	"-&177
	"1&177
	"2&177
	"!&177
	0			/THIS ENDS THE MESSAGE

INCHAR,	.-.			/TEMPORARY

	PAGE

	$			/THAT'S ALL FOLK!