2RD8D8|DR<(8x
0($ ||
R<	.TITLE READID	; BY PAUL KONING , 3-FEB-74
	R0=%0
	R1=%1
	R2=%2
	R3=%3
	R4=%4
	R5=%5
	SP=%6
	PC=%7
	KBS=177560
	KBB=177562
	TPS=177564
	TPB=177566	; DEFINITIONS OF  CONSOLE REGISTERS
	RKCS=177404
	RKWC=177406
	RKMA=177410
	RKDA=177412	; SAME FOR RK REGISTERS
	RKER=177402
	BTDISK=177462	; ADDRESS OF DISK TO BOOT FROM ON EXIT (RF)
	.ASECT
	.=4		; LOCATION OF VECTOR
	.WORD TRAP,340	; GO TO "TRAP" IF NON-EXISTENT MEMORY TRAP HAPPENS
;
	.CSECT READID	; START THE RELOCATABLE PART HERE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                                                                     ;
;      READID VERSION 1-A             A PROGRAM FOR READING DISK      ;
;      ID'S OFF A RK DISK PACK WITHOUT DAMAGING IT                    ;
;              WRITTEN BY PAUL KONING OF THE LAWRENCE UNIVERSITY      ;
;                      COMPUTER CENTER                                ;
;                                                                     ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
START:	RESET		; GET RID OF ALL POSSIBLE TROUBLE
	MOV #START,SP	; INITIALIZE THE STACK POINTER
	MOV #TRAP,@#4
	MOV #340,@#6
	MOV #TRAP,@#10
	MOV #340,@#12	; SET UP VECTORS FOR THE FATAL TRAPS
	JSR PC,CARRET	; START ON A FRESH BLANK LINE
	JSR R5,TEXOUT	; PRINT NAME ETC.
	.ASCII \READID VERSION 1-A LAWRENCE%\
	.EVEN		; TO PLEASE THE ASSEMBLER
ASK:	JSR PC,CARRET	; AND A CARRIAGE RETURN
	JSR R5,TEXOUT	; ASK WHICH DRIVE HE/SHE WANTS
	.ASCII \WHICH DRIVE DO YOU USE (0-7)?%\
	.EVEN
	JSR R5,TEXIN	; READ THE ANSWER
	.WORD DRIVE	; HERE THE DRIVE NUMBER WILL APPEAR
	BIC #177600,DRIVE; THROW OUT CRAP IN THE HIGH BYTE OF "DRIVE"
	CMP R3,#1	; ONE CHARACTER ONLY IS ALLOWED
	BNE NODRIV	; THIS IS WRONG!
	SUB #'0,DRIVE	; GO DOWN TO 0-7
	BLT NODRIV	; A NEGATIVE DRIVE IS NO GOOD
	CMP DRIVE,#7	; IS DRIVE NUMBER WITHIN RANGE?
	BLE OKDRIV	; YES, OK THEN
NODRIV:	JSR PC,CARRET
	JSR R5,TEXOUT	; GIVE A NASTY MESSAGE
	.ASCII \INVALID DRIVE NUMBER!%\
	.EVEN
	BR ASK		; TRY AGAIN FOR A REASONABLE ANSWER
OKDRIV:	JSR R5,TEXOUT	; TELL HIM OR HER TO GET THE DRIVE READY
	.ASCII \READY DISK THEN HIT "RETURN"%\
	.EVEN
	JSR R5,TEXIN	; WAIT FOR THE "RETURN"
	.WORD CRET	; HERE IT GOES
	TST R3		; REALLY ONLY A "RETURN"?
	BNE OKDRIV	; NO, THEN ASK AGAIN TO GET GOING
	MOV #BUFF,R0
	MOV #300.,R1	; FOR A FANATIC ZEROING ACTION!
	CLR (R0)+	; WIPE CORE
	DEC R1		; COUNT THOSE LITTLE RINGS TOO
	BPL .-4		; LOOP IF NOT DONE
	MOV #BUFF,@#RKMA; SET THE BUS ADDRESS FOR THE TRANSFER
	MOV #-256.,@#RKWC; WE WILL READ 256. WORDS FROM THE DISK
	CLR R4		; JUST A MATTER OF INITIALIZING
	MOVB DRIVE,R4	; GET THE DRIVE NUMBER
	CLC
	ROR R4
	ROR R4
	ROR R4
	ROR R4		; GET THE DRIVE # BITS IN THE RIGHT PLACE
	INC R4		; SET TO BLOCK #1
 	MOV R4,@#RKDA	; LOAD DISK ADDRESS
	MOV #5,@#RKCS	; START THE READING
	TSTB @#RKCS	; DONE ALREADY?
	BPL .-4		; NO, WAIT LONGER
	TST @#RKCS	; DID ANY ERRORS OCCUR IN THE PROCESS?
	BPL NOERR	; NO, OK THEN!
		MOV @#RKER,R2	; GET THE ERROR STATUS FIRST
	RESET		; NO HARM DONE WE SAY THEN
	JSR PC,CARRET	; GET A CLEAN LINE FOR THE MESSAGE
	JSR R5,TEXOUT	; PRINT HEADER FOR ERROR MESSAGE
	.ASCII \RKER = %\
	.EVEN
	MOV #16.,R0	; COUNT BITS
	CLC
NEX:	ROL R2		; GET MSB
	BCC PRZERO	; IF NO CARRY, PRINT "0"
	JSR R5,TEXOUT	; ELSE PRINT A "1"
	.ASCII \1%\
	.EVEN
	BR NEX2		; TEST FOR DONE
PRZERO:	JSR R5,TEXOUT	; NOW PRINT A "0"
	.ASCII \0%\
	.EVEN
NEX2:	DEC R0		; COUNT BITS
	BPL NEX		; MORE TO DO
	JSR R5,TEXOUT	; THEN PRINT IT
	.BYTE 7		; RING THE BELL FOR THIS ONE
	.ASCII \DISK ERROR - RESTART%\
	.EVEN
	JMP START	; TRY AGAIN NEXT TIME
NOERR:	JSR R5,TEXOUT	; PRINT THE TITLE LINE
	.ASCII \DISK ID IS : %\
	MOV ID,R2	; GET FIRST PART OF ID
	JSR PC,PRRADX	; PRINT IN RADIX-50
	MOV ID+2,R2	; NOW THE SECOND HALF
	JSR PC,PRRADX	; GET IT OUT TO PAPER
	JSR PC,CARRET	; FOR A BLANK LINE
	JMP ASK		; NEXT DRIVE PLEASE!
TRAP:	RESET		; HERE WE COME IN CASE OF NEM TRAP
	JSR PC,CARRET	; GET A NEW LINE
	JSR R5,TEXOUT	; THEN TELL THE BAD NEWS
	.BYTE 7		; RING THE BELL HERE TOO!!!!
	.ASCII \FATAL ERROR TRAP OCCURED - RESTART%\
	.EVEN
	JSR PC,CARRET	; NEW LINE PLEASE
	JMP START	; START FROM SCRATCH
;
TEXOUT:	TSTB @#TPS	; PRINTER READY NOW?
	BPL TEXOUT	; NO, WAIT FOR THE SLOW THING
	MOVB (R5)+,R1	; GET A CHARACTER
	CMPB R1,#'%	; IS IT A "%" (TO END)?
	BEQ EXITPR	; YES, STOP POUNDING
	MOV R1,@#TPB	; PRINT THE CHARACTER
	BR TEXOUT	; GET MORE OF THEM
EXITPR:	INC R5
	BIC #1,R5	; PERFORM A .EVEN ON R5
	RTS R5		; ONLY THEN IT IS SAFE TO EXIT
;
TEXIN:	MOV (R5),R3	; GET OUTPUT AREA POINTER
LOOP:	TSTB @#KBS	; IS A CHARACTER READY YET?
	BPL LOOP	; WAIT MORE TILL DONE
	MOV @#KBB,R2	; GET THE CHARACTER FROM THE BUFFER
	BIC #177600,R2	; STRIP EXTRANEOUS BITS
	BEQ LOOP	; IGNORE NULLS OF COURSE
	CMPB R2,#3	; WAS IT A ^C (TO QUIT)?
	BNE TEST2	; NO, MORE TESTING TO BE DONE
	MOV #BTDISK,R1	; PREPARE TO BOOT FROM THE DISK
	JMP @#173104	; DO A HARDWARE BOOT (SAVES ME THE TROUBLE OF
			;   WRITING ONE)
TEST2:	CMPB R2,#25	; ^U?
	BNE CRQ		; NO, MAYBE IT'S A CR
	MOV (R5),R3	; RESET BUFFER
	JSR R5,TEXOUT	; PRINT "^U"
	.ASCII \^U%\	; THERE IT IS!
	.EVEN		; VERY NEEDED HERE
	JSR PC,CARRET	; THEN CR
	BR LOOP		; GET MORE DOPE
CRQ:	CMPB R2,#15	; NOW IS IT A CARRIAGE RETURN?
	BNE TEST3	; NOT EVEN THAT!
	JSR PC,CARRET	; RETURN CARRIAGE
	SUB (R5),R3	; MAKE R3 INTO THE # OF CHARACTERS
	TST (R5)+	; POINT TO THE NEXT INSTRUCTION
	RTS R5		; THEN RETURN
TEST3:	CMPB R2,#32	; IS IT "^Z" FOR RESTART?
	BNE .+6		; NO
	JMP START	; YES, RESTART
	CMPB R2,#177	; RUBOUT?
	BNE NORMAL	; NO, JUST A PLAIN ORDINARY CHARACTER
	CMP R3,(R5)	; ANYTHING IN THE BUFFER?
	BEQ EMPTY	; NO NOTHING LEFT
	MOVB -(R3),@#TPB; ECHO CHARACTER THAT IS ERASED
	BR LOOP		; THEN GET MORE
EMPTY:	MOV #134,@#TPB	; IF EMPTY, ECHO A "\"
	BR LOOP		; GET MORE AS BEFORE
NORMAL:	MOVB R2,(R3)+	; STORE THAT CHARACTER
	MOV R2,@#TPB	; ECHO IT TOO
	BR LOOP		; I WANT MORE!
;
CARRET:	JSR R5,TEXOUT	; GO PRINT A CARRIAGE RETURN
	.BYTE 15,0,0,0,0,0,12,0,'%	; AND SOME EXTRA STUFF
	.EVEN
	RTS PC		; THAT'S ALL FOLKS!
DIV50:	MOV R2,R0	; COPY R2
	CLR R1		; R1 IS THE COUNTER
LOOPDV:	CMP R0,#50	; DIVISION POSSIBLE?
	BLO ENDIT	; NOT ANY MORE
	SUB #50,R0	; ELSE DO A SUBSTRACTION
	INC R1		; COUNT IT TOO
	BR LOOPDV	; TRY SOME MORE
ENDIT:	TST R0		; IS THE RESULT A SPACE?
	BNE NOSP	; NOT A SPACE
	MOV #40,R0	; PUT A DECENT ASCII SPACE THERE
	RTS PC		; AND GET OUTTA THERE
NOSP:	CMP R0,#32	; IS IT ALPHA?
	BGT NOAL	; NOT THIS TIME
	ADD #100,R0	; MAKE REAL CHARACTER
	RTS PC		; THAT'S IT
NOAL:	CMP R0,#35	; FUNNY CHARACTER????
	BLE FUNNY	; YES!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	ADD #22,R0	; ELSE MAKE IT INTO A DIGIT
	RTS PC		; AND EXIT
FUNNY:	MOV #'?,R0	; INDICATE FUNNY CHARACTER
	RTS PC		; LAST ONE TO LEAVE
;
PRRADX:	JSR PC,DIV50	; DIVIDE THE CRUMMY WAY
	MOVB R0,RX3	; LAST CHARACTER FIRST PLEASE
	MOV R1,R2	; GET QUOTIENT
	JSR PC,DIV50
	MOVB R0,RX2	; SAME AS ABOVE
	MOV R1,R2
	JSR PC,DIV50
	MOVB R0,RX1	; DONE FOR NOW
	JSR R5,TEXOUT	; PRINT THE RESULT
RX1:	.BYTE 0
RX2:	.BYTE 0
RX3:	.BYTE 0		; HERE WE WILL GET THE RESULT
	.BYTE '%	; TO END THE TYPING
	.EVEN		; REDUNDANT, BUT WHY WORRY ABOUT IT??
;
;
DRIVE:	0		; STORE THE DRIVE NUMBER HERE
CRET:			; HERE COMES THE CARRIAGE RETURN
BUFF:	0,0,0,0,0,0	; FIRST SECTION OF THE BUFFER
ID:	0,0		; ID WILL LAND HERE
	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
ID2:	0,0		; SECOND ID ENTRY COMES HERE
			;  NAMELY THE PASSWORD OF [0,1]
	.=BUFF+600.	; THE REST OF THE BUFFER WITH A LITTLE EXTRA
	.END START	; GO GALA GO!!!!!!!