.TITLE	ODTRSX
	.SBTTL	FPODT -- FLOATING-POINT OPEN/CLOSE
	.ENABL	LC
	.LIST	CND

; Author: C J Doran
;	Sira Ltd., South Hill, Chislehurst, Kent, BR7 5EH, England.
;	Tel: +44 1 467 2636,	Telex: 896649,	 Fax: +44 1 467 6515
;
; Free of copyright, except for DEC's bits.
;
; Extends ODT to recognise two extra commands for floating-point numbers:-
;
; {<address>}[<mode>
;	opens the given <address>, or re-opens the current one
;	if omitted, as a floating-point word or words, and
;	prints according to the <mode> character:-
;	  \	Unbiassed floating-point exponent, in octal,
;	  /	1-word floating number, as used by immediate
;		instructions  LDF  #^F1.5,F0  etc.,
;	  E	2-word number (single-precision),
;	  D	4-word number (double-procision).
;
;	The following special addresses are recognised:-
;	  $0-$5	open the corresponding floating registers,
;	  $S	opens the floating-point status register,
;	  $W	opens the FP exception address and register.
;
; ]<value><terminator>
;	closes the currently open location, storing <value>
;	(if given) in the number of bytes determined by the
;	previous open mode (default 2-words), or as specified
;	by using '\', 'E', or 'D' as exponent symbol.
;	Except for exponent mode ('\') and status, which are
;	read in octal, any valid floating-point number format
;	is recognised.
;
;	The <terminator> must be carriage-return, line-feed,
;	or up-arrow, with the usual ODT effect. When opening next or
;	previous locations, the address is updated as follows:
;	  by 2 bytes	if 1-word format, or $S or $W open,
;	  by 4 or 8	if 2- or 4-word format,
;	  as previous	if exponent examined,
;	  next register	if $0-$5 opened.
;
;	Any illegal character, including embedded spaces, will be
;	treated as an error and flagged with '?' in the usual way.
;	Since it is not possible to write to FEA, or FEC, an
;	attempt to do this is illegal too.
;
;
; Define the following symbol if the largest floating-point number
; is to be recognised as 'INFINITY'.  If so, then '?' will be
; accepted for this value by the close (]) processor. This
; is a special option for the Sira modification to RMCS CORAL-66
; allowing such programs to use the FP11A and FP11F floating-point processors.
; -infinity is also recognised, for the Sira plot processor.
R$$INF=0		; If defined, recognise infinity
;
; Set the SYSTEM version number:
		; 32 for RSX V3.2
		; 40 for RSX V4.x, M+ V2.1, VAX-11 RSX V1.0
V$$RSN=50	; 50 for RSX V5.0, M+ V3.0, VAX-11 RSX V2.0
;WARNING: DO NOT enable the following line. ODTID support is not complete --
; I/D space switching for FP fetch/store is not yet implemented.
;O$$DID=0		; For ODTID, M+ V2.1
; Options other than the above are unsupported.
;
; ASSEMBLE AS:
;
;	>MAC FPODT.POB=FPODT.PAT
;
; THEN INSTALL IN ODT BY:
;
;	>PAT ODT.OBJ;2=ODT.OBJ;1,FPODT
;
; IN DIRECTORY LB:[1,1].  FOR V3.2, NOTE THAT ODT.OBJ;1 MUST BE TAKEN FROM
; THE ORIGINAL DISTRIBUTION MEDIA IF ANY PATCHES FROM "THE SOFTWARE
; DISPATCH" HAVE BEEN INCLUDED ALREADY.  THIS LISTING INCORPORATES
; ARTICLE 5.5.1.1 FROM JULY 1980 (M05A AND M05B).

F0=%0			; DEFINE THE F.P. REGISTERS
F1=%1
F2=%2
F3=%3
F4=%4
F5=%5
LF=12			; ASCII line-feed
CR=15			; ASCII carriage-return
ESC=33			; ASCII escape
CSI=233			; Multinational CSI character


; Set instruction and data space locations SYMB, according to version.
; Note: V4.0 and V5.0 addresses are identical.
.IF EQ V$$RSN-32
	.MACRO	SETLOC	SYMB	V3.2	V4.0	ID
	SYMB=$$$CDE+V3.2
	.ENDM	SETLOC
	.MACRO	SETDAT	SYMB	V3.2	V4.0	ID
	SYMB=$$$ODT+V3.2
	.ENDM	SETDAT
.IFF	; GE V$$RSN-40
  .IF DF O$$DID
	.MACRO	SETLOC	SYMB	V3.2	V4.0	ID
	SYMB=$$$CDE+ID
	.ENDM	SETLOC
	.MACRO	SETDAT	SYMB	V3.2	V4.0	ID
	SYMB=$$$ODT+ID
	.ENDM	SETDAT
  .IFF
	.MACRO	SETLOC	SYMB	V3.2	V4.0	ID
	SYMB=$$$CDE+V4.0
	.ENDM	SETLOC
	.MACRO	SETDAT	SYMB	V3.2	V4.0	ID
	SYMB=$$$ODT+V4.0
	.ENDM	SETDAT
  .ENDC
.ENDC

; DECODE changed from IOT to TRAP 0 in RSX V5.0 etc.
.IF GE V$$RSN-50
.MACRO	DECODE
	TRAP	0
.ENDM	DECODE
.IFF
.MACRO	DECODE
	IOT
.ENDM	DECODE
.ENDC

.IF DF O$$DID
	.PSECT	$ODTCD,RW,I
$$$CDE=.
	.PSECT	$ODTDT,RW,D
$$$ODT=.
.IFF
	.PSECT	$$$ODT,RW,I,GBL,REL,OVR
$$$ODT=.
$$$CDE=.
.ENDC

.IF EQ V$$RSN-32
.PAGE
	.SBTTL	PATCHES FROM THE SOFTWARE DISPATCH

; COPYRIGHT (C) 1979, 1980
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
; MODIFICATIONS:
;
;       MO5A - WAIT FOR I/O TO COMPLETE IF CONTEXT SWITCHING
;              HAS BEEN DISABLED
;
;       MO5B - DON'T DETACH TERMINAL IF IT WAS ATTACHED UPON ENTRY
;
         .IDENT  /M05A/

.=$$$ODT+4750

	JMP	PAT1

.=$$$ODT+5646
PAT1:	EMT	377		;EXECUTE WAIT DIRECTIVE
10$:	TST	IOSTAT		;HAS I/O COMPLETED?
	BEQ	10$		;NO
	RTS	PC		;

.=$$$ODT

	.IDENT	/M05B/

	.PSECT	$$$ODT,RW,I,GBL,REL,OVR

$$$ODT=.

.=$$$ODT+3516
	JSR	PC,O.DET	;ATTEMPT TO DETACH THE TERMINAL

.=$$$ODT+3740
	JSR	PC,O.ATT	;ATTEMPT TO ATTACH THE TERMINAL

.=$$$ODT+3754
	JSR	PC,O.DET	;ATTEMPT TO DETACH THE TERMINAL

.=$$$ODT+4640
ATDFLG:	.WORD	0		;SAVE ATTACH STATUS HERE
O.DET:	MOV	#IO.DET,DPBIOF	;SET DETACH FUNCTION
	TSTB	ATDFLG		;SEE IF WE WANT TO DO IT
	BLE	O.RET		;IF LE THEN DON'T DO IT

O.ATDT=$$$ODT+4656

O.RET=$$$ODT+4676

.=$$$ODT+5660
O.ATT:	MOV	#IO.ATT,DPBIOF	;SET ATTACH FUNCTION
	CALL	O.ATDT		;ATTEMPT THE ATTACH
	MOVB	IOSTAT,ATDFLG	;SAVE ATTACH STATUS
	RTS	PC		;

PATEND=.-$$$ODT			; END OF DEC'S PATCHES
.=$$$ODT
.PAGE
.IFF	; i.e. V4.0 or later
  .IF DF O$$DID
O.DET=$$$CDE+4436		; DETACH TI:
PATEND=5426			; END OF OLD CODE
  .IFF
O.DET=$$$CDE+4642		; DETACH TI:
PATEND=5700			; END OF OLD CODE
  .ENDC
.ENDC	; V3.2
	.SBTTL	FLOATING-POINT ADDITIONS

; FREE OF COPYRIGHT AGAIN.

.IF EQ V$$RSN-32
	.IDENT	/M05F/
.IFF
  .IF DF O$$DID
	.IDENT	/M02.1F/
  .IFF
	.IDENT	/M06F/
  .ENDC
.ENDC

; ODT'S WORKSPACE.
SETDAT	O.UR0	 60	 60	 60	; USER REGISTER 0 STORED HERE
SETDAT	O.UR5	 72	 72	 72	; USER REGISTER 5
SETDAT	O.USP	 74	 74	 74	; USER SP
SETDAT	O.UST	100	100	100	; USER PS
SETDAT	O.DSW	102	102	102	; USER $DSW
SETDAT	O.CAD	326	326	332	; ADDRESS CURRENTLY OPEN
SETDAT	O.DOT	330	330	334	; LAST EXPLICITLY OPENED ADDRESS
SETDAT	O.BW	332	332	336	; LAST OPEN MODE, 1=BYTE, 2=WORD,
					; 4 = SINGLE-PRECISION F.P., 8=DOUBLE
SETDAT	O.OBW	354	356	360	; SAME, BUT A BYTE
SETDAT	DPBIOF	364	366	464	; TI: QIO function
SETDAT	DPBCNT	400	402	500	; TI: QIO byte count
SETDAT	IOSTAT	404	406	504	; QIO I/O status block
SETDAT	CHRBUF	410	412	510	; TI: character buffer
.IF DF O$$DID
O.LOOK=$$$ODT+420			; TABLE ADDRESS FOR LOOKUP

	.PSECT	$ODTCD,RW,I
.ENDC

; OVERLAY MAIN COMMAND DECODER TO GIVE US A TRAP FOR AN UNKNOWN
; COMMAND (UNKNOWN, THAT IS TO THE ORIGINAL ODT).

SETLOC	.	1630	1632	754

O.USR:	JSR	PC,O.USER	; ERROR -- TRY USER COMMAND

SETLOC	O.NEWC	1666	1670	1012 ; COME HERE FOR NEW COMMAND

SETLOC	.	1720	1722	1050
	BCS	O.USR		; TRY USER IF NOT KNOWN

; EXTEND REGISTER SAVE AND RESTORE TO INCLUDE F.P. REGS TOO.
SETLOC	.	3706	3710	3144
	JMP	O.SVF		; SAVE THE FLOATING REGISTERS
O.SVRR:				; COME BACK HERE
SETLOC	.	3754	3756	3212
	JSR	PC,O.RSF	; RESTORE FLOATING REGS

SETLOC	.	4754	5006	4550	; GET A CHAR FROM TERMINAL TO %0
O.GET:	CLRB	CHRBUF		; Look at hi byte of CHRBUF
	SWAB	CHRBUF		; clearing it for next time
	MOVB	CHRBUF,R0	; to see if anything saved (after esc)
	BNE	2$		; Yes, use it
	MOV	#IO.RAL!TF.RNE,DPBIOF ; Read all bits (for CSI), but never echo
	JSR	PC,O.V200	; Look for VT2xx escape sequences
2$:	

SETLOC	.	5036	5070	4636
	BCS	DOECHO		; No substitution if not escape
SETLOC	DOECHO	5044	5076	4644

; ADDRESSES OF SOME USEFUL ODT SUBROUTINES.

SETLOC	O.EXIT	3512	3514	2750	; Exit to MCR
SETLOC	EXPCOM	4400	4402	3730	; COMPUTE EXPRESSION
SETLOC	GETNUM	4462	4464	4012	; GET A NUMBER FROM THE KEYBOARD
SETLOC	LOOKUP	4526	4530	4056	; LOOK UP CHAR IN %0 IN TABLE
SETLOC	O.CRLF	4700	4724	4466	; TYPE CR/LF
SETLOC	O.TYPE	4704	4730	4472	; TYPE 2 CHARS IN %0
SETLOC	O.FTYP	4712	4736	4500	; TYPE 1 CHAR IN %0
SETLOC	DOAQIO	4724	4750	4512	; Execute TI: QIO function
SETLOC	O.RORA	5112	5144	4704	; TYPE %0 AS AN ADDRESS
SETLOC	O.CADW	5266	5320	5066	; TYPE %0 AS AN OCTAL WORD
SETLOC	O.CADB	5304	5336	5104	; TYPE %0 AS AN OCTAL BYTE

; NOW START THE FLOATING-POINT THING PROPERLY

.=$$$CDE+PATEND		; END OF OLD CODE [ + DEC'S LAST PATCH]

; O.USER IS NOW CALLED ON ANY ERROR, WITH %0 CONTAINING THE
; UNRECOGNISABLE BYTE TYPED IF THE ERROR WAS DETECTED AT COMMAND
; LEVEL, " ?" FOR ANY OTHER (E.G. MP TRAP).

O.USER:	CMPB	%0,#'[		; OPEN FLOATING?
	BEQ	O.FOPN		; YES, GO DO IT
	CMPB	%0,#']		; CLOSE FLOATING?
	BNE	O.FERR		; NO, REALLY AN ERROR
; (OTHER USER COMMAND CHARS COULD BE DETECTED HERE.)

; CLOSE FLOATING LOCATION, ENTERING NEW VALUE, IF GIVEN.
O.FCLS:	JSR	PC,O.FCAD	; GET OPEN ADDRESS
	BVS	O.FERR		; FEA/FEC CAN'T BE CHANGED
	BCC	10$		; BRANCH IF NOT STATUS
	JSR	PC,GETNUM	; CARRY => STATUS, GET OCTAL NO
	TST	%2		; WAS THERE ONE?
	BEQ	O.FNXT		; NO, JUST CLOSE
	MOV	%4,@%5		; YES, STORE NEW STATUS
	BR	O.FNXT		; AND CLOSE
10$:	TSTB	O.FFM		; TEST MODE
	BNE	20$		; BRANCH UNLESS EXPONENT
	JSR	PC,GETNUM	; GET NEW EXPONENT
	TST	%2		; MAKE SURE THERE WAS ONE
	BEQ	O.FNXT		; NO, DO NEXT THING
	ADD	#200,%4		; YES, BIAS THE EXPONENT
	SWAB	%4		; PUT IT IN THE HIGH BYTE
	ASR	%4		; SHIFT RIGHT ONCE
	BIC	#100177,%4	; AND GET RID OF THE UNWANTED BITS
	BIC	#77600,@%5	; HERE AND IN DESTINATION
	BIS	%4,@%5		; PUT IN THE NEW EXPONENT
	BR	O.FNXT		; ALL DONE
20$:	JSR	PC,GETFLO	; GET AN F.P. NUMBER
	TST	%2		; IF ANY?
	BEQ	O.FNXT		; NONE GIVEN, JUST CLOSE
	MOVB	O.FFM,%1	; LOAD I/O MODE (1,2, OR 3)
	DECB	%1		; MAKE IT 0,1, OR 2
	CMPB	%1,#2		; DOUBLE-PRECISION MODE?
	BNE	30$		; NO, BRANCH
	STD	F0,@%5		; YES, STORE DP
	BR	O.FNXT		; DONE
30$:	BHI	O.FERR		; BUG IF MODE OUT OF RANGE
; 1-WORD OR SINGLE-PRECISION. DON'T USE STCDF BECAUSE IT CHANGES INFINITY TO 0!
	STD	F0,-(SP)	; PUSH 4 WORDS
	MOV	(SP)+,(%5)+	; STORE AT LEAST 1
	DECB	%1		; 1-WORD (%1 NOW 0)?
	BMI	40$		; YES, DONE
	MOV	@SP,@%5		; NO, STORE SECOND TOO
40$:	CMP	(SP)+,(SP)+	; PURGE STACK OF 3 WORDS
	CMP	(SP)+,-(%5)	; AND RESET RESULT POINTER, %5

; EXIT STORE MODE.
; VALID TERMINATORS (IN %0) ARE CR=CLOSE, LF=CLOSE-OPEN NEXT, AND
; '^'=CLOSE-OPEN PREVIOUS.
O.FNXT:	JSR	PC,O.UPBW	; UPDATE O.BW & O.OBW
	CMPB	%0,#CR		; CARRIAGE-RETURN TERMINATOR?
	BEQ	O.FDCD		; YES, GO GET ANOTHER COMMAND
	CMPB	%0,#LF		; LINE-FEED?
	BEQ	10$		; YES, BRANCH
	CMPB	%0,#'^		; NO, MUST BE UP-ARROW
	BNE	O.FERR		; BUG IF NOT
	SUB	O.BW,O.CAD	; SETUP PREVIOUS ADDRESS
	BR	20$		; CONTINUE IN COMMON WITH LF
10$:	ADD	O.BW,O.CAD	; LF -- SETUP NEXT ADDRESS
20$:	JSR	PC,O.CRLF	; NEW LINE ANYWAY
	MOV	O.CAD,%0	; GET CURRENT ADDRESS
	MOV	%0,O.DOT	; SET UP DOT
	JSR	PC,O.RORA	; PRINT CURRENT ADDRESS
	MOVB	#'[,%0		; LOAD THE OPEN SYMBOL
	JSR	PC,O.FTYP	; AND TYPE IT
	JSR	PC,O.FCAD	; GET NEXT ADDRESS
	BVS	O.FOPE		; BRANCH SPECIALLY FOR FEC/FEA
	BCS	O.FOPS		; OR STATUS
	MOVB	O.FFM,%1	; NEITHER, GET FLOATING I/O MODE
	MOVB	FLOCHR(%1),%0	; CHARACTER
	JSR	PC,O.FTYP	; TYPE IT AND GO FOR
	BR	O.FOPG		; GENERAL CASE, BYPASSING GET CHAR

; ERROR.  TYPE " ?" AND GO BACK TO COMMAND LEVEL
O.FERR:	MOV	#" ?,%0		; LOAD 2 CHARS
	JSR	PC,O.TYPE	; TYPE THEM
O.FDCD:	DECODE			; BACK HOME

; '[' PROCESSOR -- TYPE AN F.P. NUMBER AT CURRENT ADDRESS.

O.FOPN:	TST	%2		; WAS AN ADDRESS GIVEN?
	BEQ	10$		; NO, BRANCH
	JSR	PC,EXPCOM	; YES, COMPLETE EXPRESSION
	MOV	%4,O.CAD	; SET UP CAD
	MOV	%4,O.DOT	; AND DOT
10$:	JSR	PC,O.FCAD	; GET FLOATING ADDRESS
	BCS	O.FOPS		; CARRY SET MEANS F.P. STATUS
	BVC	O.FOPQ		; V MEANS FEA/FEC, BRANCH IF NOT
O.FOPE:	MOV	(%5)+,%0	; ELSE GET FEC & ADDRESS FEA
	CMP	%0,#14.		; MAKE SURE IT'S A VALID FEC
	BHI	10$		; NO, PRINT AN OCTAL NUMBER
	BIT	#1,%0		; VALID ONES ARE EVEN
	BNE	10$		; PRINT ODD ONES IN OCTAL
	MOV	FECOND(%0),%0	; GET A 2-CHAR MNEMONIC
	JSR	PC,O.TYPE	; FOR THE GOOD ONES
	MOV	#": ,%0		; FINISH WITH COLON
	JSR	PC,O.TYPE	; AND SPACE
	BR	20$		; THEN THE FEA
10$:	JSR	PC,O.CADW	; PRINT THE STRANGE ONES
20$:	MOV	@%5,%0		; GET FEA
	JSR	PC,O.RORA	; PRINT THAT AS AN ADDRESS
	MOVB	#'],%0		; CAN'T WRITE TO FEA/FEC, SO
	JMP	O.FTYP		;   SAY CLOSED AND RTS TO O.DCD
O.FOPS:	MOV	@%5,%0		; PRINT STATUS
	JSR	PC,O.CADW
O.FOS1:	JSR	PC,O.UPBW	; UPDATE O.BW & O.OBW
	BR	O.FOD1		; SPECIAL CASES DONE

; IF NEITHER OF THE SPECIAL CASES, GET ANOTHER CHARACTER TO SEE
; WHICH FLOATING MODE IT IS.
O.FOPQ:	JSR	PC,O.GET	; GET A CHAR
.IF DF O$$DID
	MOV	#FLOCHR,O.LOOK	; SET TABLE '\', '/', 'E', 'D'
	JSR	PC,LOOKUP	; LOOK IT UP
.IFF
	JSR	%5,LOOKUP	; LOOK IT UP
	+	FLOCHR		; IN THE TABLE '\', '/', 'E', 'D'
.ENDC
	BCS	O.FERR		; ERROR IF NOT THERE
	ASR	%1		; REMOVE LOOKUP'S *2
	MOVB	%1,O.FFM	; STORE FLOATING MODE
O.FOPG:	JSR	PC,O.SPCE	; TYPE A SPACE
	MOVB	FLOSIZ(%1),%1	; GET NO OF BYTES
	BEQ	10$		; UNLESS EXPONENT ONLY,
	JSR	PC,O.UPBW	;   UPDATE O.BW & O.OBW

; MAKE SURE THE LOCATION CONTAINS A CORRECT FORMAT F.P. NUMBER,
; SINCE WE MUSTN'T LOAD AN UNDEFINED VALUE INTO AN F.P. REGISTER.
10$:	MOV	@%5,%0		; GET 1ST WORD OF NO
	BIC	#177,%0		; STRIP THE TOP BITS OF MANTISSA
	CMP	%0,#100000	; DOES THAT LEAVE US WITH SIGN SET,
	BNE	20$		; EXPONENT=0?  BRANCH IF NOT
	MOV	#O.FUND,%1	; IF IT DOES, WE HAVE AN UNDEFINED
	BR	O.TEXT		; SO PRINT 'undefined'

20$:	TSTB	%1		; EXPONENT MODE?
	BNE	40$		; NO, BRANCH
	ASL	%0		; YES, SHIFT THE HI WORD 1 LEFT
	SWAB	%0		; THEN DOWN TO LO BYTE
	BEQ	30$		; UNLESS SPECIAL CASE OF F.P. 0.0,
	SUB	#200,%0		;   GET RID OF THE BIAS
30$:	JSR	PC,O.CADB	; PRINT AN UNBIASSED EXPONENT BYTE
	BR	O.FOD1		; DONE

; PRINT 1-, 2-, OR 4-WORD FLOATING VALUE.
40$:	ASR	%1		; HALVE BYTE COUNT FOR WORDS
	CLRD	-(SP)		; CLEAR 4 WORDS ON STACK
	MOV	SP,%2		; ADDRESS THE STACK
42$:	MOV	(%5)+,(%2)+	; AND COPY MEMORY THERE
	DECB	%1		; %1 GIVES NO OF NON-ZERO WORDS
	BNE	42$		; (1, 2, OR 4)
	LDD	(SP)+,F0	; GET ALL 4 INTO F0
	CFCC			; CHECK SIGN
	BPL	45$		; OK IF POSITIVE
	JSR	PC,MINUS	; OUTPUT - SIGN IF -VE
	ABSD	F0		; AND CONTINUE WITH ABSOLUTE VALUE
45$:
.IF DF R$$INF			; IF RECOGNISING INFINITY
	CMPD	O.DINF,F0	; COMPARE WITH D.P. INFINITY
.IFTF
	MOV	#16.,%2		; LOAD THE NUMBER OF DIGITS
	CMPB	O.FFM,#3	; ASSUMED D.P., BUT WAS IT?
	BEQ	50$		; YES, BRANCH
	ASR	%2		; NO, HALVE NO OF DIGITS
.IFT
	CMPD	O.SINF,F0	; RECOMPARE WITH S.P. INFINITY
50$:	CFCC			; IS IT INFINITY?
	BEQ	O.TYPI		; YES, PRINT 'infinity'
.IFF
50$:				; REF LABEL
.ENDC
	JSR	PC,TYPFLO	; TYPE FLOATING NO

; FLOATING OPEN DONE, TELL ODT THAT NOTHING HAPPENED TO CONCERN
; IT, AND RETURN FOR A NEW COMMAND.
O.FODN:	JSR	PC,O.SPCE	; FINISH WITH A SPACE
O.FOD1:	CLR	%2		; SAY NOTHING TYPED
	TST	(SP)+		; IGNORE RETURN ADDRESS
	JMP	O.NEWC		; GO FOR NEW COMMAND

; TYPE MESSAGE "Undefined" OR "Infinity".
.IIF DF R$$INF,O.TYPI:	MOV	#O.FINF,%1	; ADDRESS "Infinity"
O.TEXT:	MOVB	(%1)+,%0	; GET NEXT CHAR
	BEQ	O.FODN		; DONE IF NULL
	JSR	PC,O.FTYP	; ELSE TYPE IT
	BR	O.TEXT		; AND GET ANOTHER


; SUBROUTINES.

; SET %5 TO POINT TO ADDRESS OF CURRENTLY-OPEN CELL, GIVEN BY
; ODT IN LOCATION O.CAD, NOTING THE SPECIAL CASES:-
;    O.UR0 TO O.UR5	MUST BE MAPPED TO F.P. EQVTS,
;			O.UF0 TO O.UF5 (GIVEN BY $0-$5),
;    O.DSW		MAPS TO O.FEC/O.FEA (GIVEN BY $W),
;    O.UST		MAPS TO O.FPS (GIVEN BY $S).
;
; SET FLAGS TO INDICATE:
; CARRY SET	LOCATION IS FPS,
; V SET		LOCATION IS FEC/FEA.

O.FCAD:	MOV	O.CAD,%5	; GET CURRENT ADDRESS
	BIT	#1,%5		; IS IT ODD?
	BNE	O.FERR		; ERROR IF SO
	CLRB	O.FBW		; CLEAR FORCE MODE BYTE
	CMP	%5,#O.DSW	; $W?
	BHI	30$		; NORMAL ADDRESS IF HIGHER
	BNE	10$		; TRY AGAIN IF NOT $W
	MOV	#O.FEC,%5	; IT WAS, MAP ONTO FEC
	MOVB	#2,O.FBW	; FORCE 2-WORD ADVANCE
	SEV			; FLAG $W BY SETTING V
	RTS	PC		; ON EXIT
10$:	CMP	%5,#O.UST	; $S?
	BNE	20$		; NO, TRY REGISTERS
	MOV	#O.FPS,%5	; YES, MAP TO FPS
	MOVB	#2,O.FBW	; FORCE WORD MODE AGAIN
	SEC			; FLAG $S BY SETTING CARRY
	RTS	PC		; ON EXIT
20$:	CMP	%5,#O.UR5	; USER %5?
	BHI	30$		; HIGHER MEANS NORMAL ADDRESS
	CMP	%5,#O.UR0	; AS DOES LOWER THAN USER %0
	BLO	30$
	SUB	#O.UR0,%5	; USER REGISTER, FIND WHICH
	ASL	%5		; WORD OFFSET FROM U.UR0
	ASL	%5		; *4 IS OFFSET FROM U.UF0
	SUB	#O.UF0,%5	; ADDRESS REQD IS #U.UF0-OFFSET
	NEG	%5		; = -(OFFSET-U.UF0)
	MOVB	#2,O.FBW	; 2-BYTES TO NEIGHBOURS
30$:	.WORD	CLC!CLV		; CLEAR CARRY & V FOR GENERAL CASES
	RTS	PC		; AND RETURN


; UPDATE O.BW AND O.OBW BY THE NUMBER OF BYTES CORRESPONDING TO
; THE CURRENTLY-OPEN FLOATING MODE, UNLESS FORCING TO SOME
; SPECIAL VALUE, GIVEN BY O.FBW<>0 = NUMBER REQD.
O.UPBW:	MOVB	O.FBW,%4	; SPECIAL BYTE UPDATE?
	BNE	10$		; YES, BRANCH
	MOVB	O.FFM,%4	; NO, GET OPEN MODE
	MOVB	FLOSIZ(%4),%4	; AND SO NO OF BYTES
10$:	MOVB	%4,O.OBW	; YES, ADJUST O.OBW
	MOV	%4,O.BW		; AND ITS WORD COUNTERPART
	RTS	PC		; AND RETURN


; GET A FLOATING-POINT NUMBER FROM THE TERMINAL TO F0, AND
; WITH TERMINATOR (CR, LF, OR '^') IN %0.  %2 GIVES THE
; NUMBER OF CHARACTERS TYPED (LESS TERMINATOR).  IF AN EXPONENT
; SYMBOL ('/', 'E', OR 'D') IS GIVEN, O.FFM IS SET TO 1, 2, OR 3,
; RESPECTIVELY.
;
; DEVELOPED FROM DECUS 11-113, SUBROUTINE FREAD.

GETFLO:	CLR	%3		; EXPONENT COUNTER
	MOV	#-1,%2		; DIGITS COUNTER LESS TERMINATOR
	CLR	-(SP)		; CLEAR SIGN FLAG
	CLR	-(SP)		; CLEAR SWITCH (SET BY E OR.)
	CLR	-(SP)		; SET BY E IN INPUT STRING
	CLR	-(SP)		; EXPONENT SIGN
; FLAGS ARE ON STACK:
EXPSGN=0	; TOP OF STACK
SWE=2		; 2ND WORD
SWITCH=4	; 3RD WORD
SIGN=6		; 4TH WORD
	CLRD	F0		; CLEAR F0
	LDD	#^F1,F2		; SET F2 TO 1
	JSR	PC,GET		; FETCH FIRST CHARACTER
L0:	CMPB	%0,#'+		; + SIGN?
	BEQ	L1		; YES, IGNORE IT
	CMPB	%0,#'-		; MINUS SIGN?
	BNE	L1A		; BRANCH IF NOT
	INC	SIGN(SP)	; ELSE SET SIGN FLAG
L1:	JSR	PC,GET		; GET NEXT CHARACTER
L1A:
.IF DF R$$INF			; IF RECOGNISING INFINITY
	CMPB	%0,#'?		; '?' ?
	BNE	L1B		; NO, NOT INFINITY
	LDD	O.DINF,F0	; YES, LOAD INFINITY
	JSR	PC,GET		; NEXT CHAR IS TERMINATOR
	BR	FINB		; DONE
.ENDC
L1B:	CMPB	#'E,%0		; LOOK FOR AN 'E'
	BEQ	EE2		; SINGLE-PRECISION MODE
	CMPB	#'/,%0		; '/' IS ALSO EXPONENT SYMBOL
	BEQ	EE1		; 1-WORD MODE
	CMPB	#'D,%0		; SO IS 'D'
	BEQ	EE3		; DOUBLE-PRECISION
	CMPB	#'.,%0		; LOOK FOR A DECIMAL POINT
	BEQ	DP
	CMPB	#'-,%0		; LOOK FOR A MINUS
	BEQ	MINA
	CMPB	#'+,%0		; LOOK FOR A PLUS
	BEQ	L1		; IGNORE IT
	CMPB	%0,#'0		; LESS THAN '0'
	BLT	FINB		; IS A TERMINATOR
	CMPB	%0,#'9		; AS IS >'9'
	BGT	FINB		; BRANCH IF TERMINATOR
	BIC	#177760,%0	; SET RANGE 0-9
	TST	SWITCH(SP)
	BNE	SVAL		; BRANCH IF SWITCH IS SET
	LDCID	%0,F1		; MUST BE A NUMBER, PUT IN F1
	MULD	#^F10,F0	; MULTIPLY F0 BY 10
	ADDD	F1,F0		; AND ADD C(F1)
	BR	L1		; CONTINUE
FINB:	CMPB	%0,#CR		; MAKE SURE TERMINATOR
	BEQ	FINC		; IS A LEGAL ONE
	CMPB	%0,#LF
	BEQ	FINC
	CMPB	%0,#'^
	BNE	ERRF		; FATAL ERROR IF NOT
FINC:	DIVD	F2,F0		; SCALE VALUE
	TST	SWE(SP)		; IS E SWITCH SET?
	BNE	EXP		; SET EXPONENT IF SET
L4:	TST	SIGN(SP)	; CHECK SIGN OF NUMBER
	BEQ	L3
	NEGD	F0
L3:	ADD	#10,SP		; PURGE STACK
	RTS	PC		; EXIT

DP:	TST	SWITCH(SP)	; HAVE E OR . ALREADY?
	BNE	FINB		; ANOTHER . IS TERMINATOR
	INC	SWITCH(SP)	; SET SWITCH NE 0
	BR	L1
EE1:	MOV	#1,%0		; RECORD 1-WORD MODE
	BR	EE
EE2:	MOV	#2,%0		; SINGLE-PRECISION MODE
	BR	EE
EE3:	MOV	#3,%0		; OR DOUBLE-PRECISION
EE:	MOVB	%0,O.FFM	; SET UP MODE
	INC	SWITCH(SP)
	INC	SWE(SP)		; INCREMENT E SWITCH
	BR	L1
MINA:	TST	SWE(SP)		; ANOTHER '-', IS E SWITCH SET?
	BEQ	ERRF		; ERROR IF NOT
	INC	(SP)		; INDICATE SIGN TO BE NEGATIVE
	BR	L1
SVAL:	TST	SWE(SP)		; CHECK SWITCHES
	BNE	SE		; BRANCH IF E SWITCH IS SET
	LDCID	%0,F1		; HANDLE NUMBER NORMALLY
	MULD	#^F10,F2	; BUT KEEP TRACK OF FRACTION IN F2
	MULD	#^F10,F0
	ADDD	F1,F0
	BR	L1
SE:	MOV	%3,-(SP)	; ADD DIGIT TO EXPONENT.
	ASL	%3		; MULTIPLY %3 BY 10
	ASL	%3		; BY THE SHIFT-AND-ADD METHOD
	ADD	(SP)+,%3	; TO AVOID AN EIS INSTRUCTION
	ASL	%3
	ADD	%0,%3		; THEN ADD NEXT DIGIT
	BR	L1
EXP:	TST	%3		; SEE IF EXPONENT IS ZERO
	BEQ	L4		; SKIP NEXT PART IF IT IS
	TST	(SP)		; CHECK SIGN OF E PART
	BEQ	L6
FL1:	DIVD	#^F10,F0	; DIVIDE BY TEN
	DEC	%3
	BNE	FL1
	BR	L4
L6:	MULD	#^F10,F0	; MULTIPLY BY TEN
	CFCC			; CHECK FOR OVERFLOW
	BVS	ERRF		; WHICH IS ERROR
	DEC	%3
	BNE	L6
	BR	L4

; GET CHARACTER, COUNTING THEM IN %2.
GET:	INC	%2		; INCREMENT DIGITS COUNT
	JMP	O.GET		; GET CHARACTER

ERRF:	JMP	O.FERR		; JUMP ON ERROR


; TYPE THE FLOATING-POINT VALUE IN F0 IN EXPONENT FORMAT, WITH A
; MAXIMUM NUMBER OF DIGITS GIVEN BY THE ENTRY VALUE OF %2.
; SIGN IS PRINTED SEPARATELY -- F0 MUST BE POSITIVE.

TYPFLO:	MOV	#"0.,%0		; LOAD "0."
	JSR	PC,O.TYPE	; TYPE 2 CHARS
	CLR	%3		; CLEAR EXPONENT COUNTER
	ABSD	F0		; TAKE ABSOLUTE VALUE ONLY
	CFCC			; ZERO?
	BEQ	40$		; NO SCALING IF 0.0
; SCALE NUMBER TO LIE BETWEEN 0.1 AND 0.999...
	CMPF	#^F1.0,F0	; >1.0?
	CFCC
	BGT	30$		; NO, BRANCH
; NUMBER IS >=1.0, DIVIDE BY 10.0 UNTIL IT IS LESS
20$:	DIVD	#^F10.0,F0	; DIVIDE BY 10.0
	INC	%3		; NOTE IN EXPONENT
	CMPD	#^F1.0,F0	; IN RANGE NOW?
	CFCC
	BLE	20$		; NO, TRY AGAIN
	BR	40$		; YES, GO PRINT
; NUMBER IS <1.0, GET IT INTO RANGE 0.1 TO 0.999...
30$:	CMPD	TENTH,F0	; C.F. 1/10
	CFCC
	BLE	40$		; BRANCH IF IN RANGE
	MULD	#^F10.0,F0	; ELSE SCALE UP
	DEC	%3		; COUNT IN EXPONENT
	BR	30$		; AND SCALE AGAIN
; NUMBER IS IN RANGE, PRINT %2 DIGITS
40$:	MODD	#^F10.0,F0	; GET DIGIT TO F1
	STCDI	F1,%0		; FETCH INTEGER PART
	JSR	PC,DIGIT	; TYPE AS ASCII DIGIT
	TSTD	F0		; TEST REMAINDER
	CFCC			; ONLY TRAILING ZEROES LEFT?
	BEQ	45$		; YES, TYPE EXPONENT
	DEC	%2		; NO, CONTINUE COUNTING DIGITS
	BNE	40$
; NOW PRINT EXPONENT IN %3
45$:	MOVB	O.FFM,%0	; GET F.P. MODE
	MOVB	FLOCHR(%0),%0	; AND THUS EXPONENT SYMBOL
	JSR	PC,O.FTYP	; TYPE IT
	TST	%3		; IS EXPONENT NEGATIVE?
	BPL	50$		; NO, BRANCH
	JSR	PC,MINUS	; YES, PRINT - SIGN
	NEG	%3		; AND MAKE EXPONENT +VE
; TYPE EXPONENT AS 1 OR 2 DECIMAL DIGITS
50$:	CLR	%0		; CLEAR TENS
52$:	CMP	%3,#10.		; ANY TENS LEFT?
	BLT	55$		; NO, GO PRINT
	SUB	#10.,%3		; YES, TAKE OUT A 10
	INC	%0		; REMEMBERING IT
	BR	52$		; AND TEST AGAIN
55$:	TST	%0		; ANY TENS?
	BEQ	57$		; NO, SUPPRESS LEADING 0
	JSR	PC,DIGIT	; YES, TYPE TENS DIGIT
57$:	MOV	%3,%0		; LOAD UNITS DIGIT
DIGIT:	ADD	#'0,%0		; CONVERT TO AN ASCII DIGIT
	JSR	PC,O.FTYP	; TYPE DIGIT
	RTS	PC		; AND EXIT

MINUS:	MOVB	#'-,%0		; LOAD '-' SIGN
	JMP	O.FTYP		; TYPE IT AND RETURN

O.SPCE:	MOVB	#' ,%0		; LOAD SPACE
	JMP	O.FTYP		; TYPE IT AND RETURN

; EXTRA CODE EXECUTED BY O.SVR ON ENTRY TO ODT TO SAVE F.P.
; REGISTERS ETC.

O.SVF:	MOV	#O.FEA+2,SP	; USE SP TO ADDRESS F.P. REGS
	STST	-(SP)		; SAVE FEC/FEA
	STFPS	-(SP)		; SAVE F.P. STATUS
	LDFPS	#40200		; SET FPU MODE=D.P., NO INTERRUPTS
	STD	F0,-(SP)	; SAVE USER'S F.P. REGS
	STD	F1,-(SP)
	STD	F2,-(SP)
	STD	F3,-(SP)
	LDD	F4,F0		; COPY F4
	STD	F0,-(SP)	; TO SAVE IT
	LDD	F5,F0		; AND F5 SIMILARLY
	STD	F0,-(SP)	; SINCE CAN'T PUSH THEM DIRECTLY
	MOV	#O.USP,SP	; LOAD CPU REGISTER SAVE AREA PTR
	JMP	O.SVRR		; FOR USE BY O.SVR

; EXTRA CODE CALLED FROM O.RSR TO RESTORE F.P. REGISTERS ETC. ON
; EXIT FROM ODT.

O.RSF:	JSR	PC,O.DET	; DETACH TERMINAL
	MOV	#O.UF5,%0	; ADDRESS FLOATING SAVE AREA
	LDD	(%0)+,F0	; GET F5
	STD	F0,F5		; THE ROUND-ABOUT WAY
	LDD	(%0)+,F0	; AND F4
	STD	F0,F4		; THE SAME WAY
	LDD	(%0)+,F3	; PICK UP THE REST DIRECTLY
	LDD	(%0)+,F2
	LDD	(%0)+,F1
	LDD	(%0)+,F0
	LDFPS	@%0		; FINALLY FPS (CAN'T DO FEA/FEC)
	RTS	PC		; BACK TO O.RSR
 .PAGE
	.SBTTL	VT2XX FUNCTION KEY RECOGNITION

O.V200:	JSR	PC,DOAQIO	; Read a char			}
	TSTB	IOSTAT		; All OK?			} replaced
	BPL	1$		; If PL yes			}
	JMP	O.EXIT		; Assume EOF and get out	} instructions
1$:	MOVB	CHRBUF,R0	; Fetch character		}
	CMPB	R0,#CSI		; Escape sequence introducer?
	BEQ	5$		; Yes, expect '2'
	CMPB	R0,#ESC		; Escape?
	BNE	15$		; No, handle it normally, whatever it is
	JSR	PC,DOAQIO	; Yes, get next char
	BIC	#177600,CHRBUF	; Strip parity bit
	CMPB	CHRBUF,#'[	; Is it '['?
	BEQ	5$		; Yes, esc [ is same as CSI
	SWAB	CHRBUF		; Else save char for next time
	BR	20$		; Return with ESC this time
5$:	JSR	PC,DOAQIO	; Get next char
	BICB	#200,CHRBUF	; Strip parity bit
	CMPB	CHRBUF,#'2	; Should be '2'
	BNE	10$		; Error if it isn't
	INC	DPBCNT		; 2 bytes to finish up
	JSR	PC,DOAQIO	; Get the important digit
	DEC	DPBCNT		; All other QIOs do 1 byte at a time
	BIC	#100200,CHRBUF	; Strip parity bits
	CMP	CHRBUF,#"3~	; Did we get 3~?
	BEQ	15$		; Yes, let O.GET change 233 to 33
	MOV	#LF,R0		; No, try for an LF
	CMP	CHRBUF,#"5~	; Given by 5~
	BEQ	15$		; Exit if so
10$:	MOVB	#'U&37,R0	; Anything else becomes control/U
15$:	CLRB	CHRBUF+1	; Nothing saved
20$:	RTS	PC		; Exit with char or substitute
.PAGE
	.SBTTL DATA AREA

.IF DF O$$DID
	.PSECT	$ODTDT,RW,D
.=$$$ODT+1020

.ENDC

O.FUND:	.ASCIZ	"Undefined"
.IIF DF R$$INF,O.FINF:	.ASCIZ	"Infinity"
FLOCHR:	.BYTE	'\, '/, 'E, 'D	; (END OF TABLE MARKED BY FLOSIZ'S 0)
FLOSIZ:	.BYTE	 0,  2,  4,  8.
O.FFM:	.BYTE	2		; FLOATING PRECISION, DEFAULT SINGLE
O.FBW:	.BYTE	0		; FORCE O.BW IN SPECIAL CASES
	.EVEN
.IF DF R$$INF
O.DINF:	.WORD	077777,177777,177777,177777 ; D.P. INFINITY
O.SINF:	.WORD	077777,177777,000000,000000 ; S.P. INFINITY
.ENDC
TENTH:	.FLT4	0.1		; 0.1, FOR USE BY TYPFLO
FECOND:	.WORD	"OK,"OP,"DZ,"IC,"OF,"UF,"UV,"MT ; EXCEPTION NMEMONICS


; USER F.P. REGISTERS AND STATUS -- ORDER IS IMPORTANT!
O.UF5:	.BLKW	4		; USER F5
O.UF4:	.BLKW	4		; USER F4
O.UF3:	.BLKW	4		; USER F3
O.UF2:	.BLKW	4		; USER F2
O.UF1:	.BLKW	4		; USER F1
O.UF0:	.BLKW	4		; USER F0
O.FPS:	.WORD	0		; FLOATING POINT STATUS
O.FEC:	.WORD	0		; FLOATING EXCEPTION CODE
O.FEA:	.WORD	0		; FLOATING EXCEPTION ADDRESS

.=$$$ODT

	.END