;BLKDSP.LIT
;
;
;4/24/84           STEVEN G. MCNAUGHTON & RICH EAKIN
;                QUAKER STATE OIL CORP. RESEARCH CENTER
;
; THIS PROGRAM IS DESIGNED FOR THE AMOS/L SYSTEM.
;
; ***********************************************************************
; *									*
; * Format for use is BLKDSP <DSKn:> BLOCK				*
; *									*
; * If no device is enter the users log in device is defaulted.		*
; *									*
; *									*
; * Enter numbers according to the current terminal attributes (either	*
; * octal or hex). If Hex is set and the number being entered begins	*
; * with a character A thru F; then that number must be proceeded with	*
; * a zero (0).								*
; *									*
; ***********************************************************************


; ***********************************************************************
; *                   BLOCK DISPLAY COMMAND LIST				*
; ***********************************************************************
; *									*
; * ^T (CNTRL T) - Scroll display to next page				*
; *									*
; * ^R (CNTRL R) - Scroll display to previous page			*
; *									*
; * ^H (CNTRL H) - Word outline left one word				*
; * Left arrow   -   "     "     "    "    "				*
; *									*
; * ^L (CNTRL L) - Word outline right one word				*
; * Right arrow  -   "     "      "    "    "				*
; *									*
; * ^J (CNTRL J) - Word outline down one line				*
; * Down arrow   -   "     "     "    "    "				*
; *									*
; * ^K (CNTRL K) - Word outline up one line				*
; * Up arrow     -   "     "    "   "   "				*
; *									*
; * Q  - Quit (exit editor - does not rewrite updates to disk)		*
; *									*
; ***********************************************************************

; ***********************************************************************
; *            Program Development and Edit History			*
; ***********************************************************************
; 100. - BASIC BLOCK PRINT TO TERMINAL  [SGM]
; 101. - UPGRADED PAGE FLIP AND EXIT ROUTINE  [SGM]
; 102. - ADDED WORD POSITIONING AND OUTLINING ROUTINE  [SGM]
; 103. - ADDED INSTANT TRANSLATION ROUTINE  [SGM]
; 104. - UPGRADED INSTANT TRANSLATION TO INCLUDE DECIMAL WORD TRANSLATION  [SGM]
; 105. - ADDED VERSION AND MODULE LOADING DISPLAY  [SGM]
; 106. - ADDED LONGWORD TRANSLATION ROUTINE  [SGM]
; 107. - UPGRADED INPUT - ALL INPUT ON COMMAND LINE  [SGM]
; 108. - HEX VERSUS OCTAL FORMAT DISPLAY UPGRADE  [SGM]
; 109. - CORRECTED BLOCK NUMBER RANGE CHECK FOR DEVICES WITH OVER 32K
;        BYTES PER DISK  [SGM]  5/18/84
; ***********************************************************************


SEARCH SYS
SEARCH SYSSYM
SEARCH TRM.UNV


.OFINI					
.OFDEF	IDDB,D.DDB			;DUMMY FILE DDB
.OFSIZ	IMPSIZ

									
; ***********************************************************************
; *									*
; *	                 MACRO DEFINITION AREA				*
; *									*
; ***********************************************************************

DEFINE	SPACE	ARG,ARG2			;PRINT ARG # OF SPACES,
	SAVE	D1,D2,D3			;  ARG2 # OF TIMES
	CLR	D1
	CLR	D2
	CLR	D3
	MOVW	#ARG2,D3
	TSTB	D5
	BNE	5$$
	SUBW	#2,D3
	TSTW	D3
	BGE	5$$
	MOVW	#0,D3
5$$:	MOVW	#ARG,D2
	MOVB	#40,D1	
10$$:
	TTY
	SUBW	#1,D2
	TSTW	D2
	BNE	10$$
20$$:
	TSTW	D3
	BEQ	30$$
	SUBW	#1,D3
	TSTW	D3
	BEQ	30$$
	MOVW	#ARG,D2
	BR	10$$

30$$:	REST	D1,D2,D3
ENDM

; ***********************************************************************
; *									*
; *	                   SYMBOL EQUATE AREA				*
; *									*
; ***********************************************************************

WDSPC=4				;WORD DISPLAY COUNT     (6 FOR OCTAL)
BTRNC=2				;TRANSLATION DSP COUNT  (3 FOR OCTAL)
ARG2=2				;SPACE LOOP TALLY       (0 FOR OCTAL)


VMAJOR=1.			;PROGRAM HEADER (VERSION NUMBER)
VMINOR=1.
VSUB=1.
VEDIT=109.
VWHO=1.

HEADER:
	PHDR	-1,PV$RSM!PV$WSM,PH$REE!PH$REU

TOP:
	GETIMP	IMPSIZ,A5,EXIT		;GET SOME IMPURE SPACE
	JOBIDX	A3
	MOVW	JOBTYP(A3),D1
	ANDW	#J.HEX,D1
	BEQ	OCTPTH

;DEFINE HEX SCREEN FORMAT
HEXPTH:
	MOVB	#1,D5			;QUICK STORAGE FOR DSPFLG
	BR	RESPRG

	
;DEFINE OCTAL SCREEN FORMAT
OCTPTH:
	MOVB	#0,D5			;QUICK STORAGE FOR DSPFLG

RESPRG:
	MOVW	#177435,D1		;CURSOR OFF
	TCRT
	CLRW	D1
	CTRLC	EXIT
	LEA	A3,PAGENO
	MOVW	#1,(A3)
	MOV	A2,D2
	LEA	A3,ASCBUF		;A3 POINTS TO ASCII BUFFER SPACE
	BYP				;BYPASS ANY BLANKS ON COMMAND LINE
	LIN				;END OF LINE?
	JEQ	CERROR			;YES ! *ERROR* ALL INFO ON COMMAND LINE

NUMCHK:
	CTRLC	EXIT
	NUM				;IS THE FIRST CHAR NUMERIC?
	JEQ	INPBLK			;YES ! GET THE BLOCK NUMBER
INLINE:					;NO ! GET THE DEVICE AND DRIVE INFO NOW
	CTRLC	EXIT
	MOVB	(A2)+,(A3)+		;FIRST BYTE ON COMMAND LINE TO ASCII BUFFER
	MOVB	(A2)+,(A3)+		;SECOND BYTE ON COMMAND LINE
	MOVB	(A2)+,(A3)		;THIRD BYTE ON COMMAND LINE
	LEA	A3,INDRV		;LOAD THE DRIVE STORAGE AREA
	MOVB	(A2)+,(A3)+		;FOURTH BYTE ON COMMAND LINE TO DRIVE
	BYP				;BYPASS ANY BLANKS
	LIN				;END OF LINE?
	JEQ	CERROR			;*ERROR* WHERE'S THE COLON?
	MOVB	(A2),D1			;CHECK THE COMMAND LINE FOR A COLON
	CMPB	D1,#':			;IS IT A COLON (END OF DEV AND DRV)
	JEQ	PCKIT			;YES ! GO PACK THE DEVICE NAME
	MOVB	(A2)+,(A3)		;GET FINAL CHARACTER OF DRIVE #
	MOVB	(A2),D1			;TEST THE NEXT BYTE ON THE COMMAND LINE
	CMPB	D1,#':			;IS IT A COLON?
	JEQ	PCKIT			;YES - GO PACK THE DEV AND DRV
					;*ERROR* DEV AND DRV MUST END IN COLON
	SUB	#2,A2
	JMP	CERROR
PCKIT:
	CTRLC	EXIT
	ADD	#1,A2			;MOVE TO NEXT BYTE ON COMMAND LINE
	BYP				;BYPASS ANY BLANKS
	LIN				;END OF LINE?
	JEQ	CERROR			;YES ! - *ERROR* ALL INFO ON COMMAND LINE
	NUM				;IS THIS CHARACTER NUMERIC?
	JNE	CERROR			;*ERROR* - THIS MUST BE A NUMBER!
	CLR	D1			;CLEAR OUT ANY JUNK
	GTOCT				;GET AN OCTAL NUMBER FROM THE COMMAND LINE
	LEA	A3,BLOCK		;STORE THAT OCTAL NUMBER IN THE BLOCK
	MOVW	D1,(A3)			;  TO BE SEARCHED AREA
GOPCK:
	CTRLC	EXIT
	CLR	D1			;CLEAR OUT ANY JUNK
	LEA	A2,ASCBUF		;A2 MUST POINT TO ASCII CHARACTERS
	LEA	A1,INDEV		;PACK AND STORE THE DEVICE NAME
	PACK				;
	LEA	A2,INDRV		;GET THE INPUTED DRIVE NUMBER
	GTDEC				;MAKE SURE ITS DECIMAL
	LEA	A2,INDRV		;PUT IT BACK INTO DRIVE # STORAGE
	MOVW	D1,(A2)
	BR	INITDB			;

INPBLK:
	CTRLC	EXIT
	CLR	D1			;GET THE BLOCK - DSK MUST HAVE BEEN
	GTOCT				;DEFAULTED TO GET HERE!
	LEA	A3,BLOCK		;STORE THE BLOCK NUMBER 
	MOVW	D1,(A3)
DEFAUL:
	LEA	A3,INDEV		;DEVICE DEFAULT AREA
	MOVW	#0,(A3)			;MOVE A ZERO FOR DEVICE NAME (FOR IDDB)
	LEA	A3,INDRV		;MOVE A -1 FOR DRIVE NUMBER (FOR IDDB)
	MOVW	#-1,(A3)

INITDB:					;SET UP AND INIT A DUMMY IDDB
	CTRLC	EXIT
	MOVW	#177400,D1
	TCRT
	CLR	D1
	MOVB	#1,D1
	LSLW	D1,#10
	MOVB	#68.,D1
	TCRT
	TYPE	<Page>
	CLRW	D1
	MOVB	#1,D1
	LSLW	D1,#10
	MOVB	#73.,D1
	TCRT
	LEA	A3,PAGENO
	MOVW	(A3),D1
	DCVT	2,OT$TRM
	MOVW	#177402,D1
	TCRT
	CLR	D1
	LEA	A2,SCRAT		;LOAD A DUMMY FILESPEC IN
	MOV	A2,D0
	MOVW	#377,(A2)+
	MOVW	#377,(A2)+
	MOVW	#377,(A2)
	MOV	D0,A2	
	FSPEC	IDDB(A5)			;PROCESS THE FILESPEC (POINTED BY A2)
	LEA	A3,IDDB+D.DEV(A5)	;PUT THE PROPER DEVICE NAME IN
	LEA	A2,INDEV
	MOVW	(A2),(A3)
	LEA	A3,IDDB+D.DRV(A5)	;PUT THE PROPER DRIVE NUMBER IN
	LEA	A2,INDRV
	MOVW	(A2),(A3)
	INIT	IDDB(A5)			;INITIALIZE THE IDDB
	CTRLC	EXIT
	CLR	D1
	TYPESP	<Block Display of:>
	LEA	A3,IDDB+D.DEV(A5)	;GET THE IDDB'S DEVICE NAME
	MOVW	(A3),D1			;MOVE THE PACKED WORD TO D1
	TST	D1			;IS IT A ZERO?
	BNE	UNPCK			;NOPE - GO UNPACK THE WORD
	JOBIDX	A3			;DEFAULT DEVICE - DETERMINE LOG IN 
	LEA	A2,JBDEV		;   STATUS AND TYPE IT OUT
	CLR	D1
	MOVW	JOBDEV(A3),D1		;GET THE PACKED DEVICE NAME
	LEA	A1,SCRAT		;  AND UNPACK IT
	MOVW	D1,(A1)
	LEA	A2,ASCBUF	
	UNPACK
	LEA	A2,ASCBUF
	TTYL	(A2)			;PRINT THE DEFAULT DEVICE NAME
	CLR	D1
	MOVW	JOBDRV(A3),D1		;GET THE DEFAULT DRIVE NUMBER
	DCVT	0,OT$TRM		;CONVERT AND TYPE IT
	TYPE	<:>
	JMP	PUTBLK
UNPCK:
	LEA	A1,INDEV		;GET AND UNPACK THE DEVICE NAME
	LEA	A2,ASCBUF
	UNPACK
	LEA	A2,ASCBUF
	MOVB	(A2)+,D1		;PRINT THE DEVICE NAME
	TTY
	MOVB	(A2)+,D1
	TTY
	MOVB	(A2)+,D1
	TTY
	LEA	A2,INDRV		;GET THE DRIVE NUMBER
	CLR	D1
	MOVB	(A2),D1
	DCVT	0,OT$TRM		;CONVERT AND TYPE IT
	TYPE	<:>
	CLR	D1

PUTBLK:
	CLR	D1
	LEA	A1,BLOCK		;GET THE BLOCK NUMBER
	MOVW	(A1),D1
	OCVT	6,OT$TRM		;CONVERT TO OCTAL AND TYPE IT
	CRLF
	CTRLC	EXIT

GETMFD:
	CLR	D1
	MOV	IDDB+D.DVR(A5),A3	;GET THE DISK DRIVER ADDRESS
	MOV	24(A3),D2		;GET THE TOTAL NUMBER OF BLOCKS/DISK
	SUB	#1,D2			;SUB 1 - BLOCK ZERO IS FIRST BLOCK	
	LEA	A3,BLOCK		;GET THE INPUTED BLOCK NUMBER
	MOVW	(A3),D1
	CMP	D1,D2			;IS THE INPUTED BLOCK LESS THAN BLOCK   [109]
	BLOS	GOMFD			;   PER DISK?
BIGERR:	TYPECR	<?Block number specified is too large for this device>	
	CLR	D1			;CLEAR THE OUTPUT REGISTER FOR EXIT
	JMP	EXIT

GOMFD:
	CTRLC	EXIT
	JOBIDX	A3
	MOV	JOBTRM(A3),A0
	ORW	#3,(A0)			;SET FORCED IMAGE MODE NO ECHO
	LEA	A1,IDDB+D.REC(A5)	;LOAD BLOCK AREA IN DDB
	MOV	D1,(A1)
        READ	IDDB(A5)		;READ THE BLOCK
	CTRLC	EXIT

PBLK:
	CTRLC	EXIT
	MOV	IDDB+D.BUF(A5),A1	;ADDRESS THE READ BUFFER AREA
	CLR	D1
	MOVB	#3,D1
	LSLW	D1,#10
	MOVB	#1,D1
	TCRT
	MOVW	#177412,D1
	TCRT
	MOV	#0,D0
	MOV	#0,D2
	MOV	D0,D1
PLP:
	MOV	A1,A3			;SAVE START OF LINE
	CTRLC	EXIT
	OCVT	3,OT$TRM
	TYPE	<:>
	SPACE	1,ARG2
PLP1:
	CLR	D1
	MOVW	(A1)+,D1
	TSTB	D5
	BNE	HEX1
OCT1:	OCVT	<WDSPC+2>,OT$TRM
	BR	CON1
HEX1:	OCVT	WDSPC,OT$TRM

CON1:	SPACE	1,ARG2
	ADD	#2,D2	
	CMP	D2,#16.
	CTRLC	EXIT
	BNE	PLP1
	LEA	A2,BYTTRN
	CLR	D1
	MOVW	#16.,D4
PTRNLP:
	CTRLC	EXIT
	CLRW	D1
	MOVB	(A3)+,D1
	CMPB	D1,#41
	BLT	PUTDOT
	CMPB	D1,#176
	BGT	PUTDOT
	BR	PBYTTR
PUTDOT:
	MOVB	#'.,D1
PBYTTR:
	MOVB	D1,(A2)+
	SUBW	#1,D4
	TST	D4
	BNE	PTRNLP

POUTL:
	CTRLC	EXIT
	CLRW	D1
	LEA	A2,BYTTRN
	TTYL	(A2)
PCRLF:
	CRLF
	CMP	D0,#496.
	JEQ	WDPRT
	CMP	D0,#360
	BNE	PPAGE
	JEQ	WDPRT

PPAGE:
	CTRLC	EXIT
	ADD	D2,D0
	MOV	D0,D1
	CLR	D2
	JMP	PLP		


WDPRT:
	CTRLC	EXIT
	CLR	D1
	TSTB	D5
	JNE	HEXHED
OCTHED:
	MOVB	#20.,D1
	LSLW	D1,#10
	MOVB	#6,D1
	TCRT
	TYPECR	< Octal   Decimal    Octal     Decimal     Ascii     RAD 50    Decimal>
	TYPE	<      Word #   Word #   MSB LSB   MSB  LSB   MSB  LSB                Word>
	MOVB	#3,D1
	LSLW	D1,#10
	MOVB	#1,D1
	TCRT
	JMP	CINIT

HEXHED:
	MOVB	#20.,D1
	LSLW	D1,#10
	MOVB	#6,D1
	TCRT
	TYPECR	<  Hex    Decimal     Hex      Decimal     Ascii     RAD 50    Decimal>
	TYPE	<      Word #   Word #   MSB LSB   MSB  LSB   MSB  LSB                Word>
	MOVB	#3,D1
	LSLW	D1,#10
	MOVB	#1,D1
	TCRT

CINIT:
	CTRLC	EXIT
	CLR	D0
	CLR	D1
	CLR	D2
	CLR	D3
	CLR	D4

CPRNT:
	CTRLC	EXIT
	MOV	IDDB+D.BUF(A5),A1
	CLR	D1
	CLR	D2
	CLR	D3
	TSTB	D5
	BNE	CHEX1
COCT1:	MOVW	D0,D3
	MOVB	#3,D1
	LSRW	D0,#10
	ADDB	D0,D1
	LSLW	D1,#10
	MOVW	D3,D0
	MOVB	#<ARG2-2>,D2
	ADDB	#5,D2
	MOVB	D2,D1
	CLRW	D2
	ADDB	D0,D1
	BR	CCON1
CHEX1:	MOVW	D0,D3
	MOVB	#3,D1
	LSRW	D0,#10
	ADDB	D0,D1
	LSLW	D1,#10
	MOVW	D3,D0
	MOVB	#<ARG2-1>,D2
	ADDB	#5,D2
	MOVB	D2,D1
	CLRW	D2
	ADDB	D0,D1
CCON1:	TCRT
	MOV	A1,D2
	MOV	D4,D3
	LEA	A3,PAGENO
	MOVW	(A3),D1
	CMPW	D1,#1
	BEQ	ADOFST
	ADD	#400,D3	
ADOFST:	ADD	D3,D2
	MOV	D2,A1
	MOVW	#177440,D1
	TCRT
	MOVW	(A1),D1
	TSTB	D5
	BNE	HEX2
OCT2:	OCVT	<WDSPC+2>,OT$TRM
	BR	CON2
HEX2:	OCVT	WDSPC,OT$TRM
CON2:	MOVW	#177441,D1
	TCRT
	CLR	D2
WDTRNS:
	CTRLC	EXIT
	MOVB	#22.,D1		
	LSLW	D1,#10
	MOVB	#10,D1
	TCRT
	MOV	D3,D1
	OCVT	3,OT$TRM
	TYPE	<      >
	DCVT	3,OT$TRM
	CLR	D1
	MOVW	(A1),D1
	LEA	A3,LSB
	MOVB	D1,(A3)
	LSRW	D1,#10
	LEA	A3,MSB
	MOVB	D1,(A3)
	TYPE	<     >
	TSTB	D5
	BNE	BHEX2
BOCT2:
	OCVT	<BTRNC+1>,OT$TRM
	BR	BCON2
BHEX2:
	TYPE	< >
	OCVT	BTRNC,OT$TRM
BCON2:	
	LEA	A3,LSB
	MOVB	(A3),D1
	TYPESP
	TSTB	D5
	BNE	BHEX3
BOCT3:
	OCVT	<BTRNC+1>,OT$TRM
	BR	BCON3
BHEX3:
	TYPE	< >
	OCVT	BTRNC,OT$TRM
BCON3:	
	TYPE	<   >
	LEA	A3,MSB
	MOVB	(A3),D1
	DCVT	3,OT$TRM
	TYPE    <  >
	LEA	A3,LSB
	MOVB	(A3),D1
	DCVT	3,OT$TRM
	TYPE	<    >
	LEA	A3,MSB
	MOVB	(A3),D1
	CMPB	D1,#40
	BGT	UPPCHK
	MOVB	#'.,D1
	BR	TYPASC
UPPCHK:
	CTRLC	EXIT
	CMPB	D1,#176
	BLT	TYPASC
	MOVB	#'.,D1
TYPASC:
	TTY
	TYPE	<    >
	LEA	A3,LSB
	MOVB	(A3),D1
	CMPB	D1,#40
	BGT	UPLCHK
	MOVB	#'.,D1
	BR	TYPASL
UPLCHK:
	CMPB	D1,#176
	BLT	TYPASL
	MOVB	#'.,D1
TYPASL:
	TTY
	TYPE	<     >
UNPKWD:
	MOV	A1,D2				;SAVE A1
	LEA	A2,ASCBUF
	UNPACK
	MOVB	#'[,D1
	TTY
	LEA	A2,ASCBUF
	MOVB	(A2)+,D1
	TTY
	MOVB	(A2)+,D1
	TTY
	MOVB	(A2)+,D1
	TTY
	MOVB	#'],D1
	TTY
	MOV	D2,A1
	TYPE	<      >
	MOVW	(A1),D1
	DCVT	5,OT$TRM	
	CTRLC	EXIT
QUEST:
	CLR	D1
	CLR	D2
	MOVB	#23.,D1
	LSLW	D1,#10
	MOVB	#1,D1
	TCRT
	MOVW	#177412,D1
	TCRT
	CLRW	D1
	MOVB	#'>,D1
	TTY
	LEA	A2,SCRAT
	CTRLC	EXIT
	KBD
	UCS
	CMPB	D1,#24			;IS IT A ^T
	JEQ	NXTPG	
	CMPB	D1,#22			;IS IT A ^R
	JEQ	PRVPG
	CMPB	D1,#'Q			;IS IT A "Q" (QUIT NO UPDATE)
	JEQ	EXIT
	CMPB	D1,#14			;IS IT A ->
	JEQ	ADDLSB
	CMPB	D1,#10			;<-
	JEQ	SUBLSB
	CMPB	D1,#13			;^
	JEQ	SUBMSB
	CMPB	D1,#12			;v
	JEQ	ADDMSB
	CMPB	D1,#'L			;IS IT A "L" (LONG WORD DISPLAY)
	JEQ	LWDDSP
	CTRLC	EXIT
	JMP	QUEST


LWDDSP:
	CTRLC	EXIT
	MOV	IDDB+D.BUF(A5),D2
	MOV	D4,D3
	LEA	A3,PAGENO
	MOVW	(A3),D1
	CMPW	D1,#1
	BEQ	ADOFLW
	ADD	#400,D3	
ADOFLW:	ADD	D3,D2
	MOV	D2,A1
	MOVB	#24.,D1
	LSLW	D1,#10
	MOVB	#5,D1
	TCRT
	CMP	D3,#510.
	BEQ	BNDERR
	TSTB	D5
	BNE	TYPHXL
TYPOCL:
	TYPESP	<Octal Longword>
	BR	TYPCN1
TYPHXL:
	TYPESP	< Hex  Longword>
TYPCN1:	MOV	(A1),D1	
	OCVT	11.,OT$TRM
	TYPE	<                >
	TYPESP	<Decimal Longword>
	DCVT	11.,OT$TRM
	CLR	D1
	BR	TCMD
BNDERR:
	TYPE	<Longword boundry violation>	
TCMD:	MOVB	#23.,D1
	LSLW	D1,#10
	MOVB	#3,D1
	TCRT
	MOVW	#177440,D1
	TCRT
	TYPESP	< Any key to continue>
	MOVW	#177441,D1
	TCRT
	CTRLC	EXIT
	KBD
	CTRLC	EXIT
	CLR	D2
	JMP	CPRNT

ADDLSB:
	CTRLC	EXIT
	CALL	NORPT
	TSTB	D5
	BNE	HPTHA
OPTHA:	CMPB	D0,#49.
	BNE	COLOKA
	BR	CPTHA
HPTHA:
	CMPB	D0,#42.
	BNE	COLOKA
CPTHA:	MOVB	#0,D0
	SUB	#14.,D4
	JMP	CPRNT
COLOKA:
	TSTB	D5
	BNE	ALHEX1
ALOCT1:
	ADDB	#7,D0
	BR	ALCON1
ALHEX1:
	ADDB	#6,D0

ALCON1:	ADD	#2,D4
	JMP	CPRNT

SUBLSB:
	CTRLC	EXIT
	CALL	NORPT
	CMPB	D0,#0
	BNE	COLOKS	
	TSTB	D5
	BNE	HPTHS
OPTHS:
	MOVB	#49.,D0
	ADD	#14.,D4
	JMP	CPRNT	
HPTHS:
	MOVB	#42.,D0
	ADD	#14.,D4
	JMP	CPRNT
COLOKS:
	TSTB	D5
	BNE	SLHEX1
SLOCT1:
	SUBB	#7,D0
	BR	SLCON1
SLHEX1:
	SUBB	#6,D0

SLCON1:	SUB	#2,D4
	JMP	CPRNT

ADDMSB:
	CTRLC	EXIT
	CALL 	NORPT
	CLR	D2
	MOVW	D0,D2
	LSRW	D0,#10
	CMPB	D0,#15.
	BNE	ROWOKA
	MOVB	#0,D0
	SUB	#240.,D4
	LSLW	D0,#10
	MOVB	D2,D0
	JMP	CPRNT
ROWOKA:
	ADDB	#1,D0
	LSLW	D0,#10
	MOVB	D2,D0
	ADD	#20,D4
	JMP	CPRNT

SUBMSB:
	CTRLC	EXIT
	CALL 	NORPT
	CLR	D2
	MOVW	D0,D2
	LSRW	D0,#10
	CMPB	D0,#0
	BNE	ROWOKS
	MOVB	#15.,D0
	ADD	#240.,D4
	LSLW	D0,#10
	MOVB	D2,D0
	JMP	CPRNT
ROWOKS:
	SUBB	#1,D0
	LSLW	D0,#10
	MOVB	D2,D0
	SUB	#20,D4
	JMP	CPRNT

NORPT:
	CTRLC	EXIT
	MOV	IDDB+D.BUF(A5),A1
	CLR	D1
	CLR	D2
	CLR	D3
	TSTB	D5
	BNE	NHEX1
NOCT1:	MOVW	D0,D3
	MOVB	#3,D1
	LSRW	D0,#10
	ADDB	D0,D1
	LSLW	D1,#10
	MOVW	D3,D0
	MOVB	#<ARG2-2>,D2
	ADDB	#5,D2
	MOVB	D2,D1
	CLRW	D2
	ADDB	D0,D1
	BR	NCON1
NHEX1:	MOVW	D0,D3
	MOVB	#3,D1
	LSRW	D0,#10
	ADDB	D0,D1
	LSLW	D1,#10
	MOVW	D3,D0
	MOVB	#<ARG2-1>,D2
	ADDB	#5,D2
	MOVB	D2,D1
	CLRW	D2
	ADDB	D0,D1
NCON1:	TCRT
	MOV	A1,D2
	MOV	D4,D3
	LEA	A3,PAGENO
	MOVW	(A3),D1
	CMPW	D1,#1
	BEQ	ADOFNP
	ADD	#400,D3	
ADOFNP:	ADD	D3,D2
	MOV	D2,A1
	MOVW	#177441,D1
	TCRT
	MOVW	(A1),D1

	TSTB	D5
	BNE	HEX3
OCT3:	OCVT	<WDSPC+2>,OT$TRM
	BR	CON3
HEX3:	OCVT	WDSPC,OT$TRM
CON3:	MOVW	#177441,D1
	TCRT
	CLR	D2
	RTN

PRVPG:
	CTRLC	EXIT
	CLR	D1
	LEA	A3,PAGENO
	MOVW	(A3),D1
	CMPW	D1,#1
	JEQ	QUEST
	SUBW	#1,(A3)
	CTRLC	EXIT
	CLR	D1
	MOVB	#1,D1
	LSLW	D1,#10
	MOVB	#73.,D1
	TCRT
	TYPESP	< >
	TCRT				;D1 ALREADY HAS THE POSIT 
	CLR	D1
	MOVW	(A3),D1
	DCVT	2,OT$TRM
	CLRW	D1
	MOVB	#3,D1
	LSLW	D1,#10
	MOVB	#1,D1
	TCRT
	MOVW	#177412,D1
	TCRT
	CLRW	D1
PRVDO:
	CTRLC	EXIT
	CLR	D2
	CLR	D0
	CLR	D1
	MOV	IDDB+D.BUF(A5),A1
	JMP	PLP		

NXTPG:
	CLR	D1
	LEA	A3,PAGENO
	MOVW	(A3),D1
	CMPW	D1,#2
	JEQ	QUEST
	CTRLC	EXIT
	ADDW	#1,(A3)
	MOVB	#1,D1
	LSLW	D1,#10
	MOVB	#73.,D1
	TCRT
	TYPESP	< >
	TCRT				;D1 ALREADY HAS THE POSIT 
	CLR	D1
	MOVW	(A3),D1
	DCVT	2,OT$TRM
	CLRW	D1
	MOVB	#3,D1
	LSLW	D1,#10
	MOVB	#1,D1
	TCRT
	MOVW	#177412,D1
	TCRT
	CLRW	D1
NEXDO:
	CTRLC	EXIT
	CLR	D2
	MOV	#400,D0
	MOV	IDDB+D.BUF(A5),D1
	ADD	#400,D1
	MOV	D1,A1
	MOV	D0,D1
	JMP	PLP		


BLOCK:	BLKB	2			;STORAGE FOR THE INPUT BLOCK NUMBER
SCRAT:	BLKB	6			;SCRATCH AREA
JBDEV:	BLKB	2			;JOB DEVICE STORAGE
JBDRV:  BLKB	2			;JOB DRIVE STORAGE
PACBUF:	BLKB	2
ASCBUF: BLKB	4			;ASCII BUFFER 
INDEV:  BLKB	6
INDRV:  BLKB	2
PAGENO:	BLKB	2			;PAGE NUMBER
BYTTRN:	BLKB	17.			;ASCII BYTE INTERPRETATION
MSB:	BLKB	1
LSB:	BLKB	1
DSPFLG:	BLKB	1


EVEN

CERROR:
	CLR	D1
	MOV	A2,D1
	SUB	D2,D1
	MOV	D1,D2
	ADD	#10,D2
	CLR	D1
ELOOP:
	TST	D2
	BEQ	PERROR
	MOVB	#40,D1
	TTY
	SUB	#1,D2
	BR	ELOOP


PERROR:
	CLR	D1
	MOVB	#'^,D1
	TTY
	TYPECR	<Specification error>
	CLRW	D1
EXIT:
	TTY				;CARRY FROM Q 
	CRLF
	MOVW	#177434,D1		;CURSOR ON
	TCRT	
	EXIT
END

.