/TC12-F TAPE CONVERTER PROGRAM

/	PDP-12 DECTAPE CONVERSION PROGRAM.

/	LAST EDIT:	10-APR-1986	09:00:00	CJL

/	ORIGINAL DEC VERSION:	18-MAR-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

	SKP=	0456		/UNCONDITIONAL SKIP

	PMODE			/DEFINE GOODY MODE SYMBOLS

	LMR=	6151		/LOAD MAINTENANCE REGISTER

/	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
	NL0002=	CLA CLL CML RTL	/LOAD AC WITH 0002
	NL7775=	CLA CLL CMA RTL	/LOAD AC WITH 7775
	TTY=	0003		/CONSOLE DEVICE CODE

/	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
	SEGMNT	2		/STARTS LOADING HERE

	TC12F=	.		/TC12F SYSTEM STARTS HERE

	IFNZRO	.&177	<ERROR	.>
TC12F,	NOP			/HERE IN CASE WE'RE CHAINED TO
	JMS I	MACHECK/(ISIT12)/ENSURE WE REALLY ARE ON A PDP-12!
MVLOOP,	TAD I	P3200		/GET A WORD
	DCA I	P7600		/PUT A WORD
	ISZ	P3200		/BUMP TO NEXT
	ISZ	P7600		/DONE YET?
	JMP	MVLOOP		/NO, KEEP GOING
	JMP	DIVCNT		/YES, CONTINUE THERE

MACHECK,ISIT12			/POINTER TO MACHINE CHECK ROUTINE
P3200,	3200			/POINTER TO CODE TO MOVE
P7600,	7600			/WHERE CODE BELONGS

	LMODE			/GOTO L...MODE

	ZBLOCK	15-.		/EMPTY SPACE IN BETA REGISTERS

DIVCNT,	0			/DIVIDE COUNTER
	0
	LINC			/GOTO L...MODE

STAR20,	LDF	1		/SETUP DATA FIELD
	JSR	QAINIT		/CALL QANDA
	TXTINTRO!D		/FRAME ADDRESS
	1777!D			/SAFE ANSWER ADDRESS
	JMP	QARFSH		/REFRESH WHILE WAITING
	LDF	3		/SETUP DATA FIELD
QAREAD,	JSR	QAINIT		/CALL QANDA
	TXTRDE!D		/FRAME ADDRESS
	ANSWR1!D		/ANSWER ADDRESS
	JMP	QARFSH		/REFRESH WHILE WAITING
UNREAD,	SET I	17;	ANSWR1!D/ROUTINE TO GET NUMBER OF BLOCKS TO BE TRANSFERRED
	SET I	16;
M4,	-4			/4 NUM ANS
	SET I	15;	NUMBRS-1/ANS ADD -1
	SET I	13;
	JMP	QAREAD		/RETURN JMP
	JMP	GET		/GET ANSWER;
	AZE I			/IS RDENUM=0?
	JMP	QAREAD		/YES;
	APO			/NOT ZERO; NEGATIVE?
	JMP	QAREAD		/YES; TRY AGAIN
	ADA I	14		/ADD -2000
	APO I			/TOO MANY?
	JMP	QAREAD		/YES TRY AGAIN
	ADA I	14		/ADD +2000
	STC	RDENUM		/NUM OF BLOCKS
	SET I	17;		/ROUTINE TO GET TAPE UNIT NO.
	ANSWR1!D+4003
	SET I	16;	-1	/1 NUM ANS
	SET I	15;	NUMBRS-1/ANS ADD -1
	JMP	GET		/GET ANS
	STC	RDEFU		/UNIT
/
/
	SET I	17;		/ROUTINE TO GET STARTING BLOCK
	ANSWR1!D+4004
	SET I	16;	-4	/4 WORD ANS
	SET I	15;	NUMBRS-1/ANS ADD-1
	JMP	GET		/GET ANS
	STC	RDEBN		/BLOCK NUM
/
/
	SET I	17;		/GET READ FORMAT
	ANSWR1!D+4002
	SET I	16;	-1	/1 NUM ANS
	SET I	15;	CHARS-1	/ANS ADD-1
	JMP	GET		/GET ANS
	MUL I;	3		/CONVERT TO MODOP ADDRESS
	ADA I;			/CHANGE RANGE
M3,	-3			/FROM 3,6,9 TO
	STC	MODOP		/0,3,6
	JMP	QAWRIT		/GET NEXT FRAME
/
/
NUMBRS,	-57			/NUMBER  LIMITS
	+57
	-67
	+67
	-2000
	+2000
CHARS,	0			/CHAR LIMITS
	0
	-3
	+3
QAWRITE,JSR	QAINIT		/CALL QANDA
	TXTWRI!D		/FRAME ADDRESS
	ANSWR2!D		/ANSWER ADDRESS
	JMP	QARFSH		/REFRESH WHILE WAITING
UNWRIT,	SET I	17;		/GET UNIT TO WRITE ON;
	ANSWR2!D+1
	SET I	16;	-1	/1 NUM ANS
	SET I	15;	NUMBRS-1
	SET I	13;
	JMP	QAWRIT		/RETURN ADD
	JMP	GET		/GET ANS
	STC	WRIFU		/UNIT
/
/
	SET I	17;		/GET STARTING BLOCK FOR WRITE;
	ANSWR2!D+2
	SET I	16;	-4	/4 NUM ANS
	SET I	15;	NUMBRS-1/ADDRESS-1
	JMP	GET		/GET ANS
	STC	WRIBN		/BLOCK
/
/
	SET I	17;	ANSWR2!D/ANS ADD
	SET I	16;	-1	/1 NUM ANS
	SET I	15;	CHARS-1	/CHECK ADD
	JMP	GET		/GET ANS
	ADM I;
MODOP,  0			/FORMAT
	ADA I;			/GENERATE JMP STA
	JMP	0+SETUP
	STC	SETUP
	CLR     		/CLEAR THE LINK BIT
	LDF	3
QPAR,	JMP	QAINIT		/PARITY FRAME
	TXTPAR!D
	ANSWR3!D
	JMP	QARFSH
UNPAR,	LDA;	ANSWR3!D	/CHECK PAR ANSWER
	ROR	1
	APO			/NO CHECK
	JMP	.+4		/YES
	LDA I;	NOP		/REPLACE JMP RDEAGN WITH NOP
	JMP	.+3
	LDA I;	JMP	RDEAGN
	STA;	PARERR!D
	CLR
/
/
/
SETUP,  JMP			/MODES OF OPERATION
	JMP	MODOP1
	JMP	MODOP2
	JMP	MODOP3
	JMP	MODOP4
	JMP	MODOP5
	JMP	MODOP6
	JMP	MODOP7
	JMP	MODOP8
	JMP	MODOP9
/
/
/
/
GET,    SET	1;	0	/SAVE RETURN JMP
	CLR
	STC	HOLD
NEXT,	LDH I	17		/THIS ROUTINE GETS THE ANSWERS
	SAE I;	00
	SKP
	JMP	HOLD-3
	SET	14;	15
	ADA I	14		/SUBTRACT LOWER LIMIT
	APO			/
	JMP	13
	ADA I	14		/ADD LOWER LIMIT BACK
	ADA I	14		/SUBTRACT UPPER LIMIT
	APO I			/
	JMP	13
	ADA I	14		/ADD UPPER LIMIT BACK
	BCL I;	7770		/JUST TO BE SURE
	ROR	 3
	ADD	HOLD
	ROL	3
	STC	HOLD
	XSK I	16
	JMP	NEXT
	LDA I;
HOLD,	0
	JMP	1
/
/
/
/
MODOP1, ADD	P8FMT1      	/PDP-8 TO PDP-8
	STC	RDELNG
	ADD	P8FMT2		/129 WORD TRANSFER
	STC	WRILNG
	ADD	RDENUM		/NUM OF BLOCKS TO READ
	STC	WRINUM		/AND WRITE
	ADD	M16		/DO 16 AT A TIME
	STA;	RDLTAN!D
	STA;	WDLTAN!D
	LDA I;	-201		/TOTAL WORDS PER BLOCK		
	STA;	RDEKEY!D
	LDA I;	-202
	STA;	WRIKEY!D
	JMP	GO		/DO THE JOB !
/
/
/
/
MODOP2, ADD	P8FMT1		/PDP-8 TO PDP-12
	STA;	ADDINC!D	/WRITE 129 WORDS IN A 400 WORD BLOCK
	STC	RDELNG		/READ 129 WORDS
	ADD	RDENUM
	STC	WRINUM		/1:1 BLOCK TRANSFER
	LDA I;
M16,    -16
	STA;	RDLTAN!D
	STA;	WDLTAN!D
	LDA I;	-201
	STA;	RDEKEY!D
	CLR
	COM
	STA;	WRIKEY!D
	JMP	GO
/
/
/
/
MODOP3, ADD	P8FMT0		/PDP-8 TO PDP-N
	STC	RDELNG
	ADD	P10FM1
	STC	WRILNG
	LDA I;	-3
	STC	DIVISR
	JMP	DIVIDE
	CLR
	ADD	DIVCNT
	STC	WRINUM
	LDA I;	-14
	STA;	RDLTAN!D
	LDA I;	-4
	STA;	WDLTAN!D
	LDA I;	-201
	STA;	RDEKEY!D
	LDA I;
M601,	-601
	STA;	WRIKEY!D
	JMP	GO
/
/
/
/
MODOP4, ADD	P8FMT1      	/PDP-12 TO PDP-8
	STC	WRILNG		/READ 400 WORDS
	ADD	RDENUM		/WRITE 200 WORDS
	NOP/ROL	1		/1:2 BLOCK TRANSFER
	STC	WRINUM
	LDA I;
K200,	200
	STA;	ADDINC!D
	LDA I;
NM16,	-16
	STA;	RDLTAN!D
	LDA I;	-16
	STA;	WDLTAN!D
	CLR
	COM
	STA;	RDEKEY!D
	LDA I;	-202
	STA;	WRIKEY!D
	JMP	GO
/
/
/
/
MODOP5, ADD	RDENUM		/PDP-12 TO PDP-12
	STC	WRINUM
	ADD	NM16
	STA;	RDLTAN!D
	STA;	WDLTAN!D
	CLR
	ADD	K200
	STA;	ADDINC!D
	CLR
	COM
	STA;	RDEKEY!D
	STA;	WRIKEY!D
	JMP	GO
/
/
/
/
MODOP6, ADD	P10FM1		/PDP12 TO PDP-N
	STC	WRILNG
	ADD	M3
	STC	DIVISR
	JMP	DIVIDE
	NOP/ADA	I   		/ACC =-2 INDICATES REMAINDER WAS 1; I.E., RDENUM =1,4,7, ETC.;
	NOP/1
	NOP/SAE	I   		/ADDING 1 WOULD MAKE ACC=7776=-1;
	NOP/7776
	NOP/JMP	.+3		/NO;ACC NOT = -1
	NOP/STC	EXTRA		/YES; NOW PUT IN EXTRA TO SUBTRACT 1 
	NOP/JMP	MULT2		/AFTER MULTIPLYING DIVCNT BY 2;
	CLR			/ACC NOT = -1;
	STC	EXTRA		/CLEAR EXTRA;
MULT2,	ADD	DIVCNT		/GET RESULTS OF DIVISION;
	NOP/ROL	1		/MULTIPLY BY 2;
	SKP/ADA	I;
EXTRA,	0			/ADD EXTRA;
	STC	WRINUM
	ADD	K200
	STA;	ADDINC!D
	LDA I;	-14
	STA;	RDLTAN!D
	LDA I;	-4
	STA;	WDLTAN!D
	CLR
	COM
	STA;	RDEKEY!D
	LDA I;	-601
	STA;	WRIKEY!D
	JMP	GO
/
/
/
/
MODOP7, ADD	P10FMT		/PDP-N TO PDP-8
	STC	RDELNG
	ADD	P8FMT1
	STC	WRILNG
	ADD	RDENUM
	MUL I;	3
	STC	WRINUM
	ADD	M4
	STA;	RDLTAN!D
	LDA I;	-14
	STA;	WDLTAN!D
	LDA I;
M600,	-600
	STA;	RDEKEY!D
	LDA I;	-202
	STA;	WRIKEY!D
	JMP	GO
/
/
/
/
MODOP8, ADD	P10FMT		/PDP-N TO PDP-12
	STC	RDELNG		/WRIFMT IS OK FOR 12 TAPE
	ADD	RDENUM
	MUL I;/STA;
	3/WRINUM
	NOP/ROR I 1
	NOP/LAM;    		/ADD AGAIN TO MAKE 1.5 X RDENUM;
	NOP/WRINUM		/LINK BIT GIVES US EXTRA BLK IF RDENUM WAS AN ODD NUMBER
	STC	WRINUM
	ADD	M4
	STA;	RDLTAN!D
	LDA I;/CLR
	-14/ADD	M6
	STA;	WDLTAN!D
	LDA I;	200
	STA;	ADDINC!D
	CLR
	COM
	STA;	WRIKEY!D
	CLR
	ADD	M600
	STA;	RDEKEY!D
	JMP	GO
/
/
/
/
MODOP9, ADD	P10FMT		/PDP-N TO PDP-N
	STC	RDELNG
	ADD	P10FM1
	STC	WRILNG
	ADD	RDENUM
	STC	WRINUM
	ADD	M4
	STA;	RDLTAN!D
	STA;	WDLTAN!D
	CLR
	ADD	M601
	STA;	WRIKEY!D
	CLR
	ADD	M600
	STA;	RDEKEY!D
/
/
/
GO,     PDP

	PMODE

JOB1,   JMS I	READPT

	LMODE

RDEFU,  0000
RDELOC, 0000    		/ALWAYS LEFT AS 0000
RDELNG, 0000
RDEBN,  0000
RDENUM, 0000
/

	PMODE

JOB2,   JMS I	WRITPT

	LMODE

WRIFU,  0000
WRILOC, 0000
WRILNG, 0000
WRIBN,  0000
WRINUM, 0000

	PMODE

WRIEXIT,LINC

	LMODE

	LDF	3
	LDA;	NBLOCK!D	/GET REMAINING BLOCKS
	BSE I;	6000
	AZE I			/ARE WE FINISHED?
	JMP	DONE		/YES
	PDP			/HELL NO

	PMODE

	JMP	JOB1		/OK; GO READ MORE
	HLT
	HLT			/TRY AGAIN;
/
READPT, READ!6000
WRITPT, WRITE!6000

	LMODE

P8FMT0,	0200			/WORDS PER BLOCK
P8FMT1,	0201
P8FMT2,	0202
P10FMT, 0600
P10FM1, 0601
/
/
/
/
DIVIDE, SET 1;	0		/SET UP RETURN JUMP;
	CLR			/CLEAR DIVIDEND
	STC	DIVCNT
	ADD	RDENUM
	XSK I	DIVCNT		/INCREMENT DIVIDEND;
	ADA I;
DIVISR, 0			/SUBTRACT DIVISOR;
	APO I			/HAS ACC GONE NEGATIVE YET?
	JMP	.-4		/NO;
	JMP 1			/YES; RETURN;
/
/
DONE,   JMP	20		/DISPLAY FRAME 1
/
////
	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 I	(CHKKRS)	/TURN "KRSIOT"
	ISZ I	(CHKKRS)	/INTO "KRBIOT"
	DCA I	(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 I	(CHKKSF)	/STORE OVER "KSFIOT"
	TAD I	(CHKJMP)	/GET "JMP I CTLCTST"
	DCA I	(CHKKRS)	/STORE OVER "KRSIOT" (OR "KRBIOT")
	TAD	(JMS	INCON)	/GET INPUT CALL INSTRUCTION
	DCA I	(CHKJMP)	/STORE OVER "JMP I CTLCTST"
	DCA I	(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
MESSPTR,MESSAGE			/COMPLAINT MESSAGE POINTER

	PAGE

	LMODE			/GOTO L...MODE
	SEGMNT	2

	*1113

/	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,	0			/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;	277		/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,	0
	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
	0/36			/ALT
///////////////////////////////////
/
/
/
/
/
/			DECTAPE ROUTINE FOR THE PDP - 12
/		
/
/
/
/
/
/
/
/
/
/
/
	LMODE
/
	SEGMNT	3
/
/
/
/
/
/
/
/
/
/
/
/
/
/
/
	SBM=	414		/SKIP ON BLOCK MARK FLAG
	SWD=	457		/SKIP ON WORD IN TAC.
/
/
/
/
/
/
/
	*1
/
/
/
TASK,	HLT
BEST,	0
WCOUNT,	0
BETAR,	0
SKIP1,	0
SKIP2,	0
DATAWD,	0
COUNT0,	0
COUNT1,	0
NBLOCK,	0
POINT1,	0
POINT2,	0
IBLOCK, 0
SWITCH, 0
/
/
/
/
/
/
/
/
/
/
/
	*20
/
/
/
/
/
/
/
/
/
/
/
/
/
/
/
EXIT,	PDP			/COMES HERE AFTER READS & WRITES

	PMODE

	CLA CLL CML RAR
	6152
	CLA
	JMP I	READ
/
/
/
/
/
/
/
/
/
/
	LMODE
/
/
/
/
/
/	IT'S IMPORTANT THAT "WRITE" LOCATION HAVE A 10 BIT ADDRESS;
/
/
/
WRITE,	0			/GENERAL WRITE ROUTINE

	PMODE			/CALLED IN 8 MODE

	LINC			/GET INTO LINC MODE

	LMODE

	LDA;	WRITE		/GET THE CALLING ADDRESS
	STC	READ		/AND PLACE IN THE READ ADDRESS
	SET I	TASK;		/SET THE OPERATION TO DO A WRITE
	JMP	DOUTIT		/JMP TO WRITE ROUTINE
	SET I	BEST;		/SET THE BEST CASE TO SKIP
	-3			/3 WORDS. THE WRITTERS NEED SOME ROOM
	SET I	IBLOCK;
WDLTAN, 0			/NUMBER OF BLOCKS WRITTEN AT A TIME
	SET I	SWITCH;
WRIKEY, 0			/TOTAL NUM WORDS WRITTEN
	LDA I;	0706		/LINC WRITE
	STC	INST
	LDA I;	WRIBN!D		/SET-UP WRITE
	STC	BNSET
	LDA I;	WRINUM!D	/DITTO
	STC	NUMSET
	LDA I;	APO 
	STC	WRIOK		/CHECK THE WRITE SWITCH
	JMP	COMMON		/GO TO THE COMMON READ-WRITE
/
/
/
READ,	0			/GENERAL READ ENTRY

	PMODE			/WE'RE IN 8 MODE WHEN CALLED

	LINC			/GET OVER INTO LINC MODE

	LMODE

	SET I	TASK;		/SET THE TASK TO READ
	JMP	DINIT
	SET I	BEST;	-4	/SET THE BEST CASE TO SKIP 5 WORDS
	SET I	IBLOCK;
RDLTAN, 0			/NUM BLKS READ AT A TIME
	SET I	SWITCH;
RDEKEY, 0			/TOTAL WORDS PER BLK
	LDA I;	0702		/LINC READ
	STC	INST
	LDA I;	RDEBN!D
	STC	BNSET		/SET-UP FOR READ
	LDA I;	RDENUM!D	/NUM BLKS
	STC	NUMSET
	LDA I;	NOP
	STC	WRIOK		/DONT CHECK WRITE SW
/
/
COMMON,	PDP			/GET OVER INTO 8 MODE TO GET THE ARGUMENTS

	PMODE

	JMS	AGET		/GET THE ARGUMENTS
	DCA	ARG1
	JMS	AGET
	DCA	ARG2
	JMS	AGET
	DCA	ARG3
	JMS	AGET
	DCA	ARG4
	JMS	AGET
	DCA	ARG5
	JMP	PASTS		/SKIP PAST SUBROUTINE
/
/
AGET,	0
	TAD I	READ
	ISZ	READ
	JMP I	AGET
/
/
/
/
/
/
	LMODE
/
/
/
/
/
/
ARG1,	0		/READ & WRITE ARGS
ARG2,	0
ARG3,	0
ARG4,	0
ARG5,	0
SIZE,	0
TEMP,	0

	FBLOCK=ARG4
/
/
/
/
/
/
/
/
/
/
/
	PMODE
/
/
PASTS,	LINC			/GET INTO LINC MODE

	LMODE

	ADD	ARG1		/GET THE FIRST ARGUMENT
	ROL	5		/ROTATE TO GOOD IOB PLACE
	BCL I;	-40		/JUST GET BIT 6
	STC	UNITL1		/SAVE UNITS 0 & 1;
	ADD	ARG1		/GET IT AGAIN
	ROR	1		/SHIFT OVER
	BCL I;	-3
	STC	LAXO		/AND STASH AWAY
	ADD	ARG1		/GET THE CRAP AGAIN
	ROR	1
	BCL I;	-34
	BSE I;	LDF	0
	STC	SDATAF
	ADD	ARG2		/GET THE ADDRESS
	STA;	COREL1		/STORE IN FIRST CORE LOC
	STC	COREL2		/ALSO IN SECOND LOC.
	ADD	ARG3		/GET THE NUMBER OF WORDS TO TDUE
	COM			/NEGATE IT
	STC	SIZE		/AND STASH AWAY
	ADD	ARG5		/GET THE NUMBER OF BLOCKS
	AZE I
	JMP	EXIT		/NO BLOCKS TO DO.
	COM
	STC	NBLOCK		/AND STASH AWAY.
XSK SWITCH
	SKP
	JMP	LINCE		/IF SWITCH=7777
/
/
/
/
/
/
/
WAITL,	LDA I;	5000		/THIS WAITS TILL DRIVE IS READY.
	IOB;	LMR		/GET INTO MAINTENANCE MODE
	LDA I;	40
	ADD	LAXO		/ADD ON CORRECT UNITS
	AXO
	LDA;	UNITL1
	ADA I;	206
	IOB;	6152		/SELECT,SET MTN
	LDA I;	100
	IOB;	6152		/SET BACKWARD
	CLR
	IOB;	6154		/READ TRANSPORT STATUS
	ROR I	2
	LZE I
	JMP	WAITL		/UNIT NOT READY YET.
WRIOK,	NOP			/THIS INST. IS REPLACED DURING THE READ/WRITE SUBROUTINE
				/READ=NOP WRITE=APO
	JMP   .+6
	LDA I;	4000		/WRITE SWITCH NOT ON; STOP TAPE
	IOB;	6152         	/LTM PRESET
	JMP	WAITL
/
/
/
	CLR			/CLEAR OUT THE MAINTENANCE MODE
	IOB;	LMR
	LDA I;
LAXO,	0
	AXO
	JMP	BACKWARD
/
/
FORWARD,SET	DATAWD;	SIZE	/DATA WORDS PER BLOCK
	SET	WCOUNT;	SWITCH	/TOTAL WORDS PER BLOCK
	LDA I;	226
	ADA I;
UNITL1,	0
	IOB;	6152		/SEL,SET FWD
	SET	SKIP1;	BEST	/NUM CONTROL WORDS
	SBM			/WAIT FOR BM
	JMP	.-1
	TAC			/BN TO AC
	NOP
	SWD			/SKIP FIRST SHORT WORD
	JMP	.-1
	JMP	INIT		/SHUFFLE
	APO			/ARE WE OUT OF END ZONE?
	JMP	FORWARD		/NO
	SAE;	FBLOCK		/YES, RIGHT BLOCK?
	SKP			/NO
	JMP	TASK		/YES; NOW DO IT!
	COM
	ADD	FBLOCK
	APO I			/GOING RIGHT DIRECTION??
	JMP	FORWARD		/YES, KEEP GOIN
/
/
/
/
/
/
/
/
/
/
BACKWARD,LDA I;	306
	ADA;	UNITL1
	IOB;	6152		/GO BACKWARD
	LDA;	FBLOCK
	ADA I;	7774
	APO			/IS BLOCK <4?
	JMP	DEEP		/YES
	SBM			/WAIT FOR BM
	JMP	.-1
	TAC			/BN TO AC
	JMP	INIT		/SHUFFLE
	ADA I;	3		/GO 3 BLOCKS PAST DESIRED BLK
	COM
	ADD	FBLOCK
	AZE I			/RIGHT BLOCK?
	JMP	FORWARD		/YES
	APO			/NO,
	JMP	BACKWARD
	JMP	FORWARD
/
/
/
/
/
/
/
/
/
/
DEEP,	SBM			/COMES HERE IF BLOCK < 4
	JMP	.-1
	TAC			/BN TO AC
	JMP	INIT		/SHUFFLE IT
	AZE			/BLOCK 0?
	JMP	BACKWARD	/NOT YET!
	SET I	COUNT1;	-13	/THIS DELAY ALLOWS US TO FIND THE BLK GOING FWD
	STC	COUNT0
	XSK I	COUNT0
	JMP	.-1
	XSK I	COUNT1
	JMP	.-3
	JMP	FORWARD
/
/
/
/
COREL1,	0
/
/
/
/
/
DINIT,	SET	SKIP2;	SKIP1	/READ ROUTINE
	CLR
	STC	LPB
	JMP	SDATAF		/JUST SET DF
	XSK I	SKIP2		/SKIP 3 CONTROL WORDS
	SKP
	JMP	IGETCK		/GET REV CS
	SWD			/SKIP ON WD FLAG
	
	JMP	.-1
	SWD
	JMP	DINIT+2		/REPEAT
	JMP	.-2
/
/
IGETCK,	SWD			/WAIT FOR REV CS
	JMP	.-1
	TAC			/GET IT
	JMP	INIT		/PUT IN LPB & SHUFFLE
/
/
/
/
IGETIT,	SWD			/WAIT FOR WORD
	JMP	.-1
	TAC			/TAPE AC TO AC
	JMP	INIT		/COMP PARITY & SHUFFLE
	PDP

	PMODE

	DCA I	COREL1		/STORE DATA
	ISZ	COREL1		/INCR ADD
	NOP

	LINC

	LMODE

	XSK I WCOUNT		/FINISHED?
	SKP			/NO
	JMP	IGETLP		/YES,GET CS
	XSK I	DATAWD		/GOT ALL DATA?
	JMP	IGETIT		/NO,GO TO IT
	JMP	LASTWD		/GET LAST WORD
IGETLP, SWD			/WAIT FOR LPB
	JMP	.-1
        TAC			/LPB TO AC
	BCL I;	1463		/CS IS ONLY 6 BITS; CLEAR LEFT HALF
	JMP	INIT		/COMP PARITY
	CLR
	ADD	LPB		/GET PARITY BUF
	JMP	LPB+5		/SHUFFLE IT
	STA;	LPB
	ROL	6		/XOR L&R
	BCO;	LPB
	ROR	6
	AZE     		/GOOD CHK SUM?
PARERR,	JMP	RDEAGN		/NO!TRY AGAIN
/
/
/
/
/
RDEDUN, LDA I;	1
	ADM;	FBLOCK		/INCR BLOCK
	XSK I	NBLOCK		/ALL DONE?
	SKP	  		/NOT DONE YET
	JMP	EXIT  		/YES DONE
	XSK I	IBLOCK  	/FINISHED DBN?
	JMP	FORWARD 	 /NO
	LDF	2
	STA;	RDEBN!D		/SET UP FOR NEXT READ
	CLR
	ADD	NBLOCK
	COM
	STA;	RDENUM!D
	JMP	EXIT
/
/
LASTWD,	SWD			/THIS WORD IS INCLUDED IN THE CS
	JMP	.-1
	TAC
	JMP	INIT		/PUT IN LPB 
	JMP	IGETLP		/GET THE CS
/
/
RDEAGN,	CLR			/PARITY ERROR
	ADD	SIZE		/DECR ADDRESS
	ADA I;	1	   	/BY 1 BLOCK
	LAM;	COREL1
	CLR		 	/CLR LINK
	LDA;	FBLOCK
	ADA I;	-3
	APO I
	JMP	BACKWARD
	JMP	FORWARD
/
/
DOUTIT,	CLR			/WRITE ROUTINE
	STC	LPB
	SET	SKIP2;	SKIP1
	JMP	SDATAF		/SET DF
	LDA I;	27
	XSK I	SKIP2		/SKIP 2 CONTROL WORDS
	SKP
	JMP	OGETIT		/PREPARE TO WRITE
	SWD			/SKIP ON WORD FLAG
	JMP	.-1
	SWD			/WAIT FOR FLAG TO GO DOWN
	JMP	DOUTIT+7	/DO IT AGAIN
	JMP	.-2
/
/
/
/
/
/
/
/
OGETIT,	IOB;	6152		/SET WRITE
	LDA I;			/SET RTN JMP
	JMP	GOWRI
	STC	OUTRTN
GOWRI,	SWD			/WAIT FOR WORD FLAG
	JMP	.-1
	IOB;	6154		/AC TO TB	
	XSK I	WCOUNT		/FINISHED?
	SKP			/NOT YET
	JMP	OGETLP		/GET CS
	XSK I	DATAWD		/WRITTEN ALL DATA?
	SKP			/NOO
	JMP	WRILAST		/WRITE 7777
	PDP 

	PMODE

	CLA CLL
	TAD I	COREL2		/GET DATA 
	ISZ	COREL2		/INCR ADDRESS
	LINC

	LMODE

	COM			/COMPUTE PARITY
	STC	TEMP0
	ADD	LPB
	BCO I;
TEMP0,	0
	STC	LPB
	ADD	TEMP0
	COM
	JMP	OUTIT		/SHUFFLE DATA & WRITE IT

COREL2,	0
WRILAST,CLR			/WRITE 7777 WHEN THE LAST WORD IS JUNK
	SWD			/WAIT FOR FLAG TO GO DOWN JUST IN CASE
	SKP
	JMP	.-2
	JMP	GOWRI		/WRITE 7777
OGETLP,	LDA I;			/SET RTN JMP TO
	JMP	WRILPB		/WRITE PARITY
	STC	OUTRTN
	LDA;	LPB		/GET PARITY WOR
	ROR	6		/ITS 6 BITS
	BCO;	LPB		/XOR IT	
	JMP	OUTIT		/SHUFFLE IT GOOD
WRILPB,	SWD			/WRITE CS
	JMP	.-1
	IOB;	6154		/CS TO TB
WRIOFF,	SWD			/NOW WAIT TILL LAST IS OPT AND WELL
	SKP
	JMP	.-2
	SWD			/NEXT WORD ALL SET???
	JMP	.-1		/NOPE. WAIT
	SWD			/NEXT WORD THERE. WAIT TILL IT PASSES.
	SKP
	JMP	.-2		/ITS PAST. LAST WORD IS NOW OUT COMPLETEL
	LDA I;	226		/YEP. TURN OFF THE WRITTERS.
	IOB;	6152
WRIDUN, LDA I;	0001		/PREPARE TO WRITE NEXT BLK	
	ADM;	FBLOCK
	XSK I	NBLOCK		/ALL DONE?
	SKP			/NOT YET
	JMP	EXIT		/THATS IT!
	SET	WCOUNT;	WRIKEY	/INIT WCOUNT
	XSK I	IBLOCK		/FINISHED GROUP?
	JMP	FORWARD		/GO DO IT!
	LDF	2
	STA;	WRIBN!D		/NEXT BLOCK
	CLR
	ADD	NBLOCK
	COM
	STA;	WRINUM!D	/REMAINING BLKS
	JMP	EXIT		/READ SOME MORE
/
/
/
/
/
/
/
/
/
/
	SDATAF=	.

DATAF,	HLT			/OPTION FOR EXT MEM
	JMP	0
/
/
/
/
INIT,	STC	TEMP1		/COMPUTE PARITY
	ADA I;
LPB,	0
	BCO I;
TEMP1,	0
	STC	LPB
	ADD	TEMP1		/READ SHUFFLE
	COM
	STA;	TEMP1
	BCL I;	-77
	ADA I;
	ADD	TABLE1
	STC	ADDIN1
	LDH;	TEMP1&3777	/GET LEFT HALF OF TEMP1
	ADA I;
	ADD	TABLE1
	STC	ADDIN2
	CLR
ADDIN2,	ADD	0
	ROL I	5
ADDIN1,	ADD	0
	JMP	0
/
/
/
/
/
/
/
/
/
/
OUTIT,	STA I;			/WRITE SHUFFLE
TEMP2,	0
	BCL I;	-77		/LOOK AT RIGHT HALF
	ADA I;
	ADD	TABLE2
	STC	ADOUT1
	LDH;	TEMP2&3777	/GET LEFT HALF
	ADA I;
	ADD	TABLE2
	STC	.+1
ADOUT2,	0
	ROL	2
ADOUT1,	0
	COM
OUTRTN,	0			/WRITE IT
/
/
/
/
LINCE,  LDA;	ARG1     	/LINC TAPE HANDLER; GET UNIT
	ROR I	1
	BCL I;	7774
	STC	EXUN
	ROL I	4		/GET LINK BIT BACK
	ADM;	INST		/ADD UNIT ONE BIT IF ITS THERE
	BSE I;	0007
	STC	CHECK
	LDA I;	0020    	/EXTENDED ADDRESS FORMAT, BANK 0
	ADA I;
EXUN,   0
	AXO			/SET EX UNIT
	LDA;	ARG4		/GET BLOCK NUMBER
	STA;	BN
	STC	CHECK+1
	STC	ADDR
	LDF	0		/CLR DF
	LDA I;
ADDR,   0
	TMA     		/AC>TMA SETUP
INST,   0
BN,     0
	LDA I;
ADDINC,	0000			/WORDS PER BLOCK
	ADM;	ADDR
	LDA I;	1
	ADM;	BN		/INCR BLOCK NUM
	XSK I	NBLOCK
	SKP
	JMP	CHECK		/TRANSFER COMPLETE
	XSK I	IBLOCK
	JMP	ADDR-2		/DO NEXT BLOCK
/
/
/
/
CHECK,	CHK;	0000		/BLOCK NUMBER
	AZE
	HLT
	LDA I;	1
	ADM;	CHECK+1
	SAE;	BN		/FINISHED?
	JMP	CHECK		/NO
	XSK	NBLOCK		/ALL DONE?
	SKP
	JMP	EXIT		/ALL DONE
/
/
	LDF	2
	STA;
BNSET,	RDEBN!D			/OR WRIBN!D
	CLR
	ADD	NBLOCK
	COM
	STA;
NUMSET,	RDENUM!D		/OR WRINUM!D
	JMP	EXIT
	LMODE

/		INPUT CONVERSION TABLES.

TABLE1,  0
         4
         40
         44
         400
         404
         440
         444
         4000
         4004
         4040
         4044
         4400
         4404
         4440
         4444
         2
         6
         42
         46
         402
         406
         442
         446
         4002
         4006
         4042
         4046
         4402
         4406
         4442
         4446
         20
         24
         60
         64
         420
         424
         460
         464
         4020
         4024
         4060
         4064
         4420
         4424
         4460
         4464
         22
         26
         62
         66
         422
         426
         462
         466
         4022
         4026
         4062
         4066
         4422
         4426
         4462
         4466
/               OUTPUT CONVERSION TABLE.
 
TABLE2,  0
         400
         20
         420
         1
         401
         21
         421
         1000
         1400
         1020
         1420
         1001
         1401
         1021
         1421
         40
         440
         60
         460
         41
         441
         61
         461
         1040
         1440
         1060
         1460
         1041
         1441
         1061
         1461
         2
         402
         22
         422
         3
         403
         23
         423
         1002
         1402
         1022
         1422
         1003
         1403
         1023
         1423
         42
         442
         62
         462
         43
         443
         63
         463
         1042
         1442
         1062
         1462
         1043
         1443
         1063
         1463
	PMODE

	*3400

/	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
	*3500

TXTINTR,TEXT 'F     "TC12-F"#H#H'
	TEXT	"   LINCTAPE/DECTAPE CONVERSION PROGRAM#F#H"
	TEXT	"   THIS PROGRAM WILL RUN SUCCESSFULLY#"
	TEXT	" ONLY ON A PDP-12 COMPUTER EQUIPPED WITH THE# "
	TEXT	"TC12-F HARDWARE OPTION.  IT WILL READ AND#"
	TEXT	" WRITE FROM TAPE UNITS 0-7 IN ANY TAPE# "
	TEXT	"FORMAT; YOU MUST SPECIFY THE CORRECT FORMAT.#F#F#H"
	TEXT	"TYPE LINEFEED TO CONTINUE\"

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	INCHAR		/STASH THE CHARACTER
	NL7775			/-3
	TAD	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	INCHAR		/GET THE CHARACTER
	JMP I	CTLCTST		/RETURN

INCHAR,	.-.			/TEMPORARY

	PAGE
	*7220

TXTPAR,	TEXT	"F CHECK PARITY<1#'#F"
	TEXT	"'0 SPECIFIES NO#' #F"
	TEXT	"'1 SPECIFIES YES#' #"
	TEXT	"'TYPE LINE FEED TO CONTINUE\"
TXTRDE, TEXT	"F  READ<4 BLOCKS#F# "
	TEXT	"       TAPE FORMAT<1 FROM UNIT<1#F#   "
	TEXT	"       STARTING WITH BLOCK<4#F#H"
	TEXT	"FORMAT A.....PDP-8  (201 WORDS/BLOCK)#H#"
	TEXT	"H       B.....PDP-12 (200/201 WDS/BLK)#H#H"
	TEXT	"       C.....OTHER  (PDP-9,10,15 WITH#H "
	TEXT	"                    600 12-BIT WORDS/BLK)# \"
TXTWRI, TEXT	"F  WRITE THE RESULT#F#"
	TEXT	"         IN TAPE FORMAT<1 ON UNIT<1#'#"
	TEXT	"           STARTING AT BLOCK<4#F#H"
	TEXT	"FORMAT A.....PDP-8  (201 WORDS/BLOCK)#H#H "
/	THE FOLLOWING WILL BE MOVED HERE AT RUN-TIME.

	NOPUNCH			/REMOVE FROM BINARY OUTPUT NOW

	TEXT	"      B.....PDP-12 (200/201 WDS/BLK)#H#H"
	TEXT	"       C.....OTHER  (PDP-9,10,15 WITH#H "
	TEXT	"                    600 WORDS/BLOCK)# \"
ANSWR1,	7400			/NUMBER OF BLOCKS
	0000			/TO BE READ IN 
	0074			/4 OCTAL DIGITS
	0074			/FORMAT CHAR;
	0074			/UNIT NUMBER;
	0000			/STARTING BLOCK
	0000			/NUMBER;
	3400			/THATS ALL!!
ANSWR2,	7400			/WRITE FORMAT;
	7400			/UNIT NUMBER;
	7400			/STARTING BLOCK
	0000			/NUMBER;
	0034			/THATS ALL!!
ANSWR3,	7400			/PARITY
	34			/THATS IT!!

	ENPUNCH			/RE-ENABLE BINARY OUTPUT
	*3200			/WHERE BINARY IS AT LOAD-TIME

	TEXT	"      B.....PDP-12 (200/201 WDS/BLK)#H#H"
	TEXT	"       C.....OTHER  (PDP-9,10,15 WITH#H "
	TEXT	"                    600 WORDS/BLOCK)# \"
	7400			/NUMBER OF BLOCKS
	0000			/TO BE READ IN 
	0074			/4 OCTAL DIGITS
	0074			/FORMAT CHAR;
	0074			/UNIT NUMBER;
	0000			/STARTING BLOCK
	0000			/NUMBER;
	3400			/THATS ALL!!
	7400			/WRITE FORMAT;
	7400			/UNIT NUMBER;
	7400			/STARTING BLOCK
	0000			/NUMBER;
	0034			/THATS ALL!!
	7400			/PARITY
	34			/THATS IT!!
P7CH,	.-.			/SEVEN-BIT PRINT ROUTINE
	DCA	P7TEMP		/STASH PASSED VALUE
P7AGN,	JMS	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	CHKUP		/CHECK FOR <^C>, ETC.
	JMP I	P7CH		/RETURN

P7TEMP,	.-.			/TEMPORARY

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 I	(INCHAR)	/OBLITERATE <^Q>, ETC.
	JMP I	CHKUP		/RETURN

	PAGE

	$			/THAT'S ALL FOLK!