.NLIST
	.IFNDF	$PAPER
	$RT11=0			;IF NOT PAPER TAPE VERSION, THEN MUST BE RT-11
	.ENDC
	.LIST
;
;	/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
;	\						   /
	.IFDF	$RT11
;	/	F  O  C  A  L    -    R  T  -  1  1        \
	.IFF
;	/	F  O  C  A  L    -    PAPER TAPE	   \
	.ENDC
;	\						   /
;	/						   \
	.IFDF	$PAPER
;	\		DEC-11-LFOCB-A-LA		   /
	.IFF
;	\		DEC-11-ORUMA-A-LA		   /
	.ENDC
;	/						   \
;	\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
;
;		*********************************
;		*  THIS IS PART IV OF THE	*
;		* FOCAL LISTINGS. FOCMAT IS THE	*
;		* MATH PACKAGE FOR FOCAL. ALL	*
;		* MATHEMATICAL OPERATIONS IN	*
;		* FOCAL ARE PERFORMED HERE.	*
;		*				*
;		*  THERE ARE TWO VERSIONS OF 	*
;		* THIS ROUTINE, ONE EACH FOR	*
;		* SINGLE AND DOUBLE PRECISION.	*
;		*				*
	.IF	EQ,$DBL
;		*  THIS IS THE SINGLE PRECISION	*
	.IFF
;		*  THIS IS THE DOUBLE PRECISION	*
	.ENDC
;		* VERSION.			*
;		*********************************
;
;
;	 ORIGINAL CODING PERFORMED:	DECEMBER 8, 1972
;			        BY:	RICHARD MERRIL
;
	.IFDF	$PAPER
;	  PAPER TAPE VERSION CODED:	JUNE 9,1974
	.IFF
;	RT-11 VERSION CONVERTED ON:	JUNE 9,1974
	.ENDC
;			        BY:	GEORGE S. KACZOWKA (HIAS)
;
	.IFDF	$RT11
;	RT-11 V4.0 UPDATE ON:		8 SEPTEMBER 1982
;				BY:	ALAN R. BALDWIN
;					KENT STATE UNIVERSITY
;					KENT, OHIO  44242
	.ENDC
;
;
;	COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION
;				MAYNARD, MASSACHUSETTS 01754
;
;
; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
; DEC ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT
; MAY APPEAR IN THIS DOCUMENT.
;
; THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A
; LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND
; CAN BE COPIED (WITH INCLUSION OF DEC'S COPYRIGHT
; NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY
; OTHERWISE BE PROVIDED IN WRITING BY DEC.
;
; DEC ASSUMES NO RESPONSIBILITY FOR THE USE 
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DEC.
;
;---	IF "$PAPER" IS DEFINED, FOCAL WILL ASSEMBLE AS A PAPER-TAPE
;	VERSION. DEFAULT IS RT-11 VERSION.
;
;	IF "$TRAP" IS DEFINED, INTERNAL CALLS WILL BE VIA
;	A TRAP INSTRUCTION. THIS WILL TAKE LONGER, BUT CORE
;	SIZE WILL BE REDUCED BY APPROXIMATELY 350 WORDS.
;
;	IF "$SMALL" IS DEFINED, FOCAL-11 WILL ASSEMBLE MINUS
;	THE FOLLOWING FEATURES:
;
;		1. ERROR INTERCEPTION
;
;		2. EXTENDED VIRTUAL FILES
;
;		3. FLN,FLOG,FEXP ARE NOT AVAILABLE
;
;		4. SCHEDULING BY EITHER TIME OR INTERRUPT
;
;		5. USE OF QUOTES IN LIBRARY COMMAND
;
	.GLOBL	$DBL		;DOUBLE PRECISION SWITCH
;
;---	NOTE: THIS VARIABLE ($DBL) SHOULD BE DEFINED IN THIS
;	MODULE. ALL ASSEMBLY CONDITIONALS BASED ON THIS
;	VARIABLE SHOULD BE IN THIS MODULE.
;
	.IFDF	$PAPER
	.IFDF	$SMALL
	.TITLE	FOCMAT(SP) - 4K PAPER-TAPE	
	.IFF
	.IFEQ	$DBL
	.TITLE	FOCMAT(SP) - 8K PAPER-TAPE
	.IFF
	.TITLE	FOCMAT(DP) - 8K PAPER-TAPE
	.ENDC
	.ENDC
;
;---	PAPER TAPE VERSION:
	.IFF
	.IFDF	$SMALL
	.IFEQ	$DBL
	.TITLE	FOCMAT(SP) - 8K RT-11 VERSION		
	.IFF
	.TITLE	FOCMAT(DP) - 8K RT-11 VERSION		
	.ENDC
	.IFF
	.IFEQ	$DBL
	.TITLE	FOCMAT(SP) - 12K RT-11 VERSION		
	.IFF
	.TITLE	FOCMAT(DP) - 12K RT-11 VERSION		
	.ENDC
	.ENDC
;
;---	RT-11 VERSION
	.ENDC
;
;		OPTIONS USED:
.IIF DF,$PAPER,;		$PAPER
.IIF DF,$TRAP,;			$TRAP
.IIF DF,$SMALL,;		$SMALL
;
;		SUPPORTS:
;			UP TO 28K CORE
	.IFDF	$TRAP
;			INTERNAL CALLS VIA TRAP INSTRUCTION
	.IFF
;			INTERNAL CALLS VIA JSR INSTRUCTION
	.ENDC
	.IFNDF	$SMALL
;			EITHER SINGLE OR DOUBLE PRECISION PACKAGE
;				(LINKAGE OPTION)
	.IFF
;			SINGLE PRECISION ARITMETIC ONLY
	.ENDC
	.IFDF	$RT11
;			DYNAMIC MEMORY ALLOCATION
;			FULL LIBRARY CAPABILITIES
;			VIRTUAL FILES
;			UP TO 8 USER FILES ACCESSED AT ONE TIME
	.ENDC
	.IFNDF	$SMALL
;			FOCAL INTERRUPT SCHEDULING PROVIDED
;			ASYNCHRONOUS TASK SCHEDULING BY TIME
	.ENDC

;DOCUMENTATION NOTES:
;DOUBLE QUOTE MARKS DENOTE TRAP-INSTRUCTION MODULES
;(X) MEANS THE CONTENT-OF-X.
;ASTERISKS DENOTE COMMAND MODULES.
;"C.R."MEANS "CARRIAGE RETURN".
;SINGLE QUOTE MARKS DENOTE A SUBROUTINE.
	.SBTTL	ASSIGNMENTS OF REGISTERS



;AS USED GENERALLY
	TEMP=%0			;SCRATCH
	AC=%1			;ACCUMULATOR
	PTR=%2			;VARIABLE POINTER
	AXOUT=%3		;TEXT READER
	CHAR=%4			;CHARACTER
	R5=%5			;EXCEPTIONAL USE REGISTER AND RUBOUT PROTECTION
	R4=%4
	R3=%3
	R2=%2
	R1=%1
	R0=%0			;TEMP REG USED BY RT-11 PATCH ROUTINES..
	SP=%6			;STACK POINTER
	PC=%7			;PROGRAM COUNTER PDP-11

;AS USED BY OUTPUT CONVERSION
	P=TEMP			;PLACES BEFORE "."
	AC=AC			;TOTAL NO. OF DIGITS.
	E=PTR			;NO. OF INTEGER DIGITS
	F=AXOUT			;TOTAL NO. OF PLACES.
	CHAR=CHAR		;NO. OF DECIMAL POINTS
	R5=R5			;SCRATCH


;AS USED BY MAIN FLOATING POINT
	TEMP=TEMP		;SCRATCH
	AC=AC			;INPUT EXP;MAY CONTAIN OP-CODES
	BH=PTR			;FLAC HORD;MAY CONTAIN ADDRESS
	BL=AXOUT		;FLAC LORD;MAY BE NEEDED BY FREAD
	AH=CHAR			;INPUT HORD;MAY BE NEEDED BY FREAD
	AL=R5			;INPUT LORD


	ONE=200			;SWITCH ASSIGNMENTS
	ALL=1
	NALPHA=20		;0=TERMINATE ON ASCII CODES
				;1=TERMINATE ON ;;C.R.ALSO

	CR=216			;INTERNAL CODE
	CRLF=05015		;FOR USE IN "PRINT2, CRLF"

	.IFDF	$PAPER		;PAPER-TAPE VERSION ONLY
	TKS=177560		;TELETYPE KEYBOARD
	TPS=177564		;TELETYPE PRINTER
	LPS=177514		;LINE PRINTER
	PRS=177550		;H.S. READER
	PPS=177554		;H.S. PUNCH
	.IFF
	TKS=0
	TPS=0
	LPS=1
	PRS=2
	PPS=3			;THESE VALUES INDICATE VECTOR ENTRY
	.ENDC
	STATUS=177776
	PSW=STATUS		;PDP-11 PEOPLE ARE FAMILIAR WITH THIS...
	.SBTTL	GLOBAL VARIABLES
;
;
	.GLOBL	SORTJ,SORTC,PRINTC,READC,OUTCH,INCH,GETC,PACKC,TESTC
	.GLOBL	GETLN,FINDLN,PRNTLN,COPYLN,START,SPNOR,ERASEV,ERASET
	.GLOBL	PRINT2,DIGTST,PARTST,GROOVY,SKPLPR,SKPNON,TASK
	.GLOBL	EVAL.X,FPMP,FINT,FREAD,FPRINT,PATCH1,PATCH2
	.GLOBL	FLAC,FSIN,FCOS,FEXP,FLOG,FLN,FSQT,XITR,FATAN
	.IF	DF,$RT11
	.GLOBL	$VGET,$VPUT,VIRTUL,V.NAME,L.CHAN,VINDEX,VCHAN
	.ENDC
;
;---	NOW FOR GLOBAL ADDRESSES
;
	.GLOBL	$FPMPX		;FLOATING POINT CALL ENTRY
;
;
	ERROR=104400		;ERROR TRAP CALL
;
;
	POPJ=207		;RTS PC
;
;
	POLRET=134		;JMP @(R4)+  (POLISH RETURN)
;
;
	MAXCOD=6*2		;MAX FPMP OPERATION CODE
;
;
	NGCODE=201+37.+37.	;ILLEGAL FLOATING POINT CALL
	.SBTTL	$FPMPX - FPMP TRAP CALL ENTRY POINT
;
;---	$FPMPX - FOCAL TRAP CALL TO INVOKE FPMP CALLS.
;
;	FOCAL TRAPS LEAVE SYSTEM IN STATE AS IF JSR R5,$FPMPX
;	WAS PERFORMED. AT ENTRY, SAVE ALL REGISTERS EXCEPT R5.
;
;	DECODE WORD FOLLOWING CALL FOR CORRECT ADDRESSING MODE OF
;	ARGUEMENT. AFTER ESTABLISHED, INDEX TO CORRECT
;	FPMP DRIVER CODE TO PERFORM OPERATION. R0 WILL THEN
;	POINT TO THE SOURCE OPERAND, AND R1 WILL CONTAIN
;	AN INDEX OF VECTR2 WHICH WILL BE USED BY THE
;	EXEC ROUTINE TO PERFORM THE MATH FUNCTION.
;
;	CONTINUE THIS PROCEDURE UNTIL NEXT INSTRUCTION DOES NOT HAVE THE
;	FLOATING POINT CODE OF 016 IN THE HIGH BYTE. (007000-007377)
;
;	THEN RESTORE REGISTERS AND PERFORM A RTS R5 TO THE MAINLINE CODE.
;
	.GLOBL	FSW		;FLOATING POINT ERROR SWITCH
				;WHEN NOT ZERO, TRAPS ARE DECODED AS
				;FLOATING POINT ERRORS. SEE RT-11
				;FORTRAN MANUAL FOR DETAILS OF ERRORS.
;
$FPMPX:	MOV	R0,-(SP)	;SAVE REGISTERS R0-R3
	MOV	R1,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	INCB	FSW		;SET IN FLOATING POINT
;
;---	ENTRY POINT #2 - VERIFY FPMP CODE TO BE PERFORMED
;
$FPMP2:	CMPB	1(R5),#16	;SPECIAL CODE?
	BNE	$FPMPE		;NO  - EXIT
	MOVB	(R5)+,R0	;GET THE CODE
	BPL	1$		;SKIP IF WE ARE TO GEN CODE
	MOVB	4(SP),R0	;GET CODE
1$:	MOV	R0,R1		;AND ESTABLISH IT!
	INC	R5		;UPDATE THE POINTER
	BIC	#-10,R0		;SAVED IN R0
	BIC	R0,R1		;REMOVE IT
	ASR	R1		;GET OTHER BITS SHIFTED DOWN
	ASR	R1		;FINISHED... CONSTRUCT DATA POINTER IN PTR
	ASL	R0		;MAKE A WORD INDEX
	CMP	R1,#MAXCOD	;FPMP FUNCTION CALL?
	BLE	$FEXEC		;NO - EXECUTE
	JSR	PC,@VECTR3(R0)	;CALL ROUTINE
	BR	$FPMP2		;CONTINUE
;
$FPMPE:	DECB	FSW		;RESET FLOATING POINT SWITCH
	MOV	(SP)+,R2
	MOV	(SP)+,R3	;RESTORE REGISTERS R3-R0
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	R5		;RETURN TO THE USER
	.SBTTL	ADDRESS MODE DECODING TABLE
;
;
;
$FEXEC:	JMP	@VECTOR(R0)	;GO TO IT!
;
;---	VECTOR TABLE FOR RETRIEVING THE DATA
;
;
;---	DIRECT MODE	(0) - ADDRESS FOLLOWS CALL
;
VECTOR:	.WORD	DIRECT		;DIRECT CALL
;
;
;---	IPTR MODE	(1) - PTR POINTS TO THE DATA (WHAT WE WANT TO DO!)
;
	.WORD	IPTR		;NULL ROUTINE
;
;
;---	XPTR MODE	(2) - PTR POINTS TO DATA, THEN INDEX BY CORRECT AMOUNT
;
	.WORD	XPTR		;SET UP INDEX
;
;
;---	STACK MODE	(3) - STACK HAS DATA PUSHED ON IT
;
	.WORD	STACK		;SET UP PTR TO POINT AT STACK
;
;
;---	ISTACK MODE	(4) - STACK HOLDS THE POINTER TO THE DATA
;
	.WORD	ISTACK		;LOAD UP PTR WITH THE POINTER
;
;
;---	IMMEDIATE MODE	(5) - DATA FOLLOWS THE CALL (ALWAYS 4 WORDS)
;
	.WORD	IMMED		;HANDLE THE CASE OF IMMEDIATE MODE
;
;
;---	RELATIVE MODE	(6) - (PIC) - OFFSET FROM PC TO DATA FOLLOWS CODE
;
	.WORD	RELTIV		;HANDLE RELATIVE OFFSET CASE
;
;
;---	ERROR CODE	(7) - ILLEGAL
;
	.WORD	CODERR
	.SBTTL	ADDRESSING MODE PROCESSING ROUTINES
;
;---	ADDRESSING ROUTINES:
;
;(0)
;
DIRECT:	MOV	(R5)+,R0	;LOAD ADDRESS
	BR	EXEC		;EXECUTE FPMP FUNCTION
;
;(1)
;
IPTR:	MOV	(SP),R0		;GET VALUE
	BR	EXEC		;GO!!!
;
;(2)
;
XPTR:	MOV	(SP),R0		;RECOVER ORIGINAL VALUE
	.IF	EQ,$DBL
	ADD	#4,(SP)		;INDEX BY SINGLE LENGTH
	.IFF
	ADD	#8.,4(SP)	;INDEX BY DOUBLE LENGTH
	.ENDC
	BR	EXEC		;EXECUTE THE FUNCTION
;
;(3)
;
STACK:	MOV	SP,R0		;GET POSITION OF THE STACK
	ADD	#12,R0		;POINT AT STACK POSITION BEFORE CALL
	BR	EXEC		;GO DO OUR THING!
;
;(4)
;
ISTACK:	MOV	12(SP),R0	;POINT THROUGH STACK
	BR	EXEC		;PERFORM FUNCTION
;
;(5)
;
IMMED:	MOV	R5,R0		;POINT AT THE LOCATION
	ADD	#10,R5		;POINT OVER 4 WORDS
	BR	EXEC		;PERFORM THE FUNCTION
;
;(6)
;
RELTIV:	MOV	R5,R0		;GET WORD FOLLOWING
	ADD	(R5)+,R0	;ADD PC TO OFFSET
	BR	EXEC		;DO IT
;
;(7)
;
CODERR:	CLRB	FSW		;RESET ERROR SWITCH
	ERROR+NGCODE		;SEND ERROR (INTERNAL)
	.SBTTL	FPMP OPERATION CODE DECODE TABLES
;
;---	EXEC - THIS SECTION INDEXES FOR CORRECT CODE
;
EXEC:
;
;---	INDEX DOWN ON CODE IN R1
;
;
	JSR	R4,@VECTR2(R1)	;CALL ROUTINE IN POLISH MODE
1$:	FLAC			;POINT TO FLAC FOR MEMORY OPERATIONS
	.+2			;RETURN FROM POLISH MODE
POWXIT:	MOV	(SP)+,R4	;RESTORE R4
	BR	$FPMP2		;CONTINUE TO CHECK
;
;---	FPMP OPERATION VECTOR TABLE
;
VECTR2:	.WORD	MOV$AM		;GET IT INTO THE FLAC
;
;
	.IF	EQ,$DBL
	.WORD	ADF$AM		;SINGLE PRECISION ADD
;
;
	.WORD	SUF$AM		;SINGLE PRECISION SUBTRACT
;
;
	.WORD	DIF$AM		;SINGLE PRECISION DIVIDE
;
;
	.WORD	MUF$AM		;SINGLE PRECISION MULTIPLY
	.IFF
	.WORD	ADD$AM		;DOUBLE PRECISION ADD
	.WORD	SUD$AM		;DOUBLE PRECISION SUBTRACT
;
;
	.WORD	DID$AM		;DOUBLE PRECISION DIVIDE
;
;
	.WORD	MUD$AM		;DOUBLE PRECISION MULTIPLY
	.ENDC
;
;
	.WORD	FPOW		;RAISE THE FLAC TO THIS POWER
;
;
	.WORD	MOV$MA		;PUT IT OUT OF THE FLAC
;
;
;---	T..T...T...T...THAT'S ALL FOLKS!
;
;
	.SBTTL	OPERATION EXECUTION ROUTINES
;
;
	.IF	EQ,$DBL
ADF$AM:	JSR	R4,@(PC)+	;ENTER POLISH
	.IFF
ADD$AM:	JSR	R4,@(PC)+	;ENTER POLISH
	.IFTF
	MOV$MS			;MOVE FROM MEMORY TO STACK
	FLAC			;FROM THE FLAC
	MOV$AS			;MOVE OPERAND TO STACK
	.IFT
	.GLOBL	ADF$SS
	ADF$SS			;PERFORM THE ADDITION
	.IFF
	.GLOBL	ADD$SS
	ADD$SS			;PERFORM THE ADDITION IN DOUBLE PRECISION
	.IFTF
	MOV$SM			;RESTORE THE
	FLAC			;FLOATING ACCUMULATOR
	BYEBYE			;EXIT FROM OUR POLISH AND RETURN
;
;
	.IFT
SUF$AM:	JSR	R4,@(PC)+	;ENTER POLISH
	.IFF
SUD$AM:	JSR	R4,@(PC)+	;CALL POLISH
	.IFTF
	MOV$MS			;MOVE FROM MEMORY TO STACK
	FLAC			;FROM THE FLAC
	MOV$AS			;MOVE OPERAND TO STACK
	.IFT
	.GLOBL	SUF$SS
	SUF$SS			;PERFORM THE SUBTRACTION
	.IFF
	.GLOBL	SUD$SS
	SUD$SS			;PERFORM THE SUBTRACTION IN DOUBLE PRECISION
	.IFTF
	MOV$SM			;RESTORE THE
	FLAC			;FLOATING ACCUMULATOR
	BYEBYE			;EXIT FROM OUR POLISH AND RETURN
;
;
	.IFT
DIF$AM:	JSR	R4,@(PC)+	;ENTER POLISH
	.IFF
DID$AM:	JSR	R4,@(PC)+
	.IFTF
	MOV$MS			;MOVE FROM MEMORY TO STACK
	FLAC			;FROM THE FLAC
	MOV$AS			;MOVE OPERAND TO STACK
	.IFT
	.GLOBL	DIF$SS
	DIF$SS			;PERFORM THE DIVISION
	.IFF
	.GLOBL	DID$SS
	DID$SS			;PERFORM THE DIVISION IN DOUBLE PRECISION
	.IFTF
	MOV$SM			;RESTORE THE
	FLAC			;FLOATING ACCUMULATOR
	BYEBYE			;EXIT FROM OUR POLISH AND RETURN
;
;
	.IFT
MUF$AM:	JSR	R4,@(PC)+	;ENTER POLISH
	.IFF
MUD$AM:	JSR	R4,@(PC)+	;ENTER POLISH
	.IFTF
	MOV$MS			;MOVE FROM MEMORY TO STACK
	FLAC			;FROM THE FLAC
	MOV$AS			;MOVE OPERAND TO STACK
	.IFT
	.GLOBL	MUF$SS
	MUF$SS			;PERFORM THE MULTIPLICATION
	.IFF
	.GLOBL	MUD$SS
	MUD$SS			;PERFORM THE MULTIPLICATION IN DOUBLE PRECISION
	.IFTF
	MOV$SM			;RESTORE THE
	FLAC			;FLOATING ACCUMULATOR
	BYEBYE			;EXIT FROM OUR POLISH AND RETURN
;
;
	.ENDC
;
BYEBYE:	MOV	(SP)+,R4	;RESTORE OLD POLISH PC
	TST	(R4)+		;POP THE WORD
	POLRET			;CONTINUE ALONG
	.SBTTL	FPOW - SPECIAL ROUTINE TO RAISE TO THE POWER
;
;
FPOW:	JSR	R4,$POLSH	;CHECK ON POWER FUNCTION
	POWCHK			;CALL IT
	NOLOG			;BRANCH TO NOLOG IF NO LOG OR EXP FUNCTION
	NEGFLC			;BRANCH TO NEGFLC IF FLAC IS NEGATIVE
POSFLC:	CALFLN			;RETURN HERE IS ALL IS OK
	.IF	EQ,$DBL
	MUF$AM			;MULTIPLY
	.IFF
	MUD$AM			;DOUBLE PRECISION MULTIPLY
	.ENDC
	FLAC			;MUL THE FLAC
	CALEXP			;TAKE THE EXP
	POWXIT			;AND EXIT
;
NEGFLC:	CALABS			;GET ABS OF FLAC
	SAV$A			;SAVE R0
	MOV$AS
	.IF	EQ,$DBL
	.GLOBL	$RI
	$RI			;GET INTEGER ON STACK
	.IFF
	.GLOBL	$DI
	$DI			;MAKE AN INTEGER
	.ENDC
	GET$A			;GET R0 BACK
	CALFLN			;TAKE LOG
	.IF	EQ,$DBL
	MUF$AM
	.IFF
	MUD$AM
	.ENDC
	FLAC
	CALEXP			;TAKE EXP OF IT
	CALFIX			;FIX IT UP
	POWXIT			;EXIT
;
NOLOG:	MOV$AS			;COPY TO THE STACK
	.IF	EQ,$DBL
	$RI
	.IFF
	$DI
	.ENDC
	SETLP			;SET LOOP PARAMETER
	MOV$MS			;STACK
	FLAC			;THE FLAC
	SET$SA			;POINT R0 AT THE STACK
	SAV$A			;SAVE IT
	MOV$1M			;SET A ONE IN THE FLAC
	FLAC
	LOOP			;CHECK FOR LOOP
	1$			;KEEP IT UP
	POWXIT			;EXIT
1$:	GET$A			;RESTORE R0
	.IF	EQ,$DBL
	MUF$AM
	.IFF
	MUD$AM
	.ENDC
	FLAC			;WITH THE FLAC
	LOOP			;LOOP BACK
	1$			;UNTIL COUNT IS EXHAUSTED
	POWXIT			;EXIT
;
;
SAV$A:	MOV	R0,SAVER0	;SAVE IT
	POLRET
;
;
GET$A:	MOV	SAVER0,R0	;RESTORE IT
	POLRET
;
;
SAVER0:	.WORD	0		;SAVE AREA
;
;	POWCHK AND POWXIT - ROUTINES IN POLISH FOR POWER CODE
;
POWCHK:				;THIS ROUTINE IS TO DETERMINE HOW WE DO IT!
	TST	@R0		;IS THE POWER EQUAL TO ZERO?
	BEQ	3$		;YES - ALWAYS RETURN A ONE...
	.IF	EQ,$DBL
;
	.GLOBL	ALOG,EXP	;LOG FUNCTIONS
;
	TST	#ALOG		;IS IT DEFINED?
	BEQ	1$		;NO - HANDLE THE EXIT
	TST	#EXP		;IS THIS DEFINED TOO?
	BEQ	1$		;NO - WE MUST USE OLD WAY
	.IFF
;
	.GLOBL	DLOG,DEXP	;DOUBLE PRECISION LOG FUNCTIONS
;
	TST	#DLOG		;LOG AVAILABLE?
	BEQ	1$		;NO - REPETATIVE MULTIPLICATION
	TST	#DEXP		;HOW ABOUT THE EXPONENTIAL FUNCTION?
	BEQ	1$		;NO - USE SLOW METHOD. WE NEED BOTH
	.ENDC
	TST	(R4)+		;SKIP THE POINTER FOR NO LOG/EXP FUNCTION
	TST	FLAC		;IS THE BASE NEGATIVE?
	BMI	2$		;YES - THIS IS SPECIAL
	BEQ	POWXIT		;IF ZERO,EXIT...
	TST	(R4)+		;SKIP POINTER
	POLRET			;RETURN TO POLISH
;
1$:	TST	@R0		;IS THE OPERAND NEGATIVE?
	BMI	ERR15		;CAN'T DO IT..
2$:	MOV	@R4,R4		;PERFORM A POLISH JUMP (USUALLY BACKWARDS)
	POLRET			;CONTINUE AT NEW LOCATION
;
3$:	MOV	#FLAC,R1	;POINT AT THE RESULT FIELD
	JSR	PC,FSGN2	;FORCE A +1 INTO THE FIELD
	BR	POWXIT		;AND RETURN WITH THE PROPER RESULT
;
ERR15:	CLRB	FSW		;RESET FLOATING POINT SWITCH
	ERROR+201+15.+15.	;SEND ERROR
;
;	CALFIX - POWER FIX ROUTINE FOR THE NEGATICE FLAC CASE
;
CALFIX:	ROR	(SP)+		;SEE IF AN ODD NUMBER OF POWERS
	BCC	1$		;SKIP IF EVEN
	BIS	#100000,FLAC	;SET THE FLAC AS NEGATIVE
1$:	POLRET			;POLISH RETURN
	.SBTTL	POLISH UTILITY ROUTINES
;
;
;---	UTILITY POLISH ROUTINES
;
;	MOVES...
;	MOVE FROM MEMORY TO THE STACK
;
;
MOV$MS:	MOV	(R4)+,R2	;POINT AT THE MEMORY
	BR	MOV$XS		;CONTINUE
;
;	MOVE THE OPERAND TO THE STACK
;
MOV$AS:	MOV	R0,R2		;SET THE VALUE
	.IF	EQ,$DBL
MOV$XS:	ADD	#4,R2		;POINT TO THE END
	.IFF
MOV$XS:	ADD	#8.,R2		;POINT AT THE END
	MOV	-(R2),-(SP)	;STACK
	MOV	-(R2),-(SP)
	.ENDC
	MOV	-(R2),-(SP)	;PUSH THE VALUE ON THE STACK
	MOV	-(R2),-(SP)
	POLRET			;RETURN
;
;	SET THE OPERAND TO BE THE STACK (NON-POP STACK MODE)
;
SET$SA:	MOV	SP,R0		;POINT AT THE STACK POSITION
	POLRET			;RETURN
;
;	MOVE OPERAND TO MEMORY
;
MOV$AM:	MOV	(R4)+,R1
	MOV	R0,R2		;SAVE IT
;
;	GENERAL MOVE FROM R2 TO R1
;
MOV$:	MOV	(R2)+,(R1)+
	MOV	(R2)+,(R1)+
	.IF	NE,$DBL
	MOV	(R2)+,(R1)+	;CONTINUE
	MOV	(R2)+,(R1)+
	.ENDC
	POLRET			;RETURN
;
;	MOVE MEMORY TO OPERAND
;
MOV$MA:	MOV	(R4)+,R2
	MOV	R0,R1		;SET POINTERS
	BR	MOV$		;MOVE IT AND EXIT
;
;	CALL THE FABS FUNCTION
;
CALABS:	JSR	PC,FABS		;GET ABS
	POLRET			;RETURN
;
;	CALL THE EXPONENTIAL FUNCTION
;
CALEXP:	JSR	PC,FEXP		;GET EXP FUNCTION
	POLRET			;RETURN
;
;	CALL THE NATURAL LOGARITHM ROUTINE
;
CALFLN:	JSR	PC,FLN		;CALL LOG FUNCTION
	POLRET			;CONTINUE
;
;	SET UP FOR A REPEAT LOOP (COUNTER IS @R5 WHEN THROUGH)
;
SETLP:	MOV	@SP,-(SP)	;OPEN SPACE BY COPYING VALUE TO BE COUNTED
	BMI	ERR15		;SEND ERROR IN CASE IT IS NEGATIVE
	MOV	R5,2(SP)	;SAVE R5
	MOV	SP,R5		;REMEMBER WHERE WE WERE
				; THIS IS ALSO USED TO REINSTATE THE STACK
				; WHEN WE ARE THROUGH
	POLRET			;CONTINUE
;
;	EXECUTE THE LOOP CONTROL ROUTINE. WORD FOLLOWING CALL
;	 IS USED IF THE COUNTER IS GREATER THAN OR EQUAL TO ZERO.
;
LOOP:	DEC	@R5		;COUNT IT OUT
	BMI	1$		;SKIP IF WE ARE TO EXIT
	MOV	(R4)+,R4	;POINT TO WHERE WE ARE GOING
	POLRET			;CONTINUE AT NEW LOCATION
;
1$:	MOV	R5,SP		;RESET THE STACK
	TST	(SP)+		;POP IT
	MOV	(SP)+,R5	;GET R5 BACK
	TST	(R4)+		;SKIP BRANCH LOCATION
	POLRET			;FALL THROUGH
;
;	MOVE STACK TO MEMORY
;
MOV$SM:	MOV	(R4)+,R2
	MOV	(SP)+,(R2)+
	MOV	(SP)+,(R2)+
	.IF	NE,$DBL
	MOV	(SP)+,(R2)+
	MOV	(SP)+,(R2)+
	.ENDC
	POLRET			;RETURN
;
;	MOVE ONE TO MEMORY
;
MOV$1M:	MOV	(R4)+,R1	;POINT AT THE MEMORY
	JSR	PC,FSGN2	;FIX IT UP
	POLRET			;CONTINUE
;
;	$POLSH - ROUTINE TO ENTER POLISH MODE SIMPLY
;
$POLSH:	TST	(SP)+		;POP THE STACK
	POLRET			;CONTINUE
	.SBTTL	FUNCTION CODE (7X) TABLES
;
;
VECTR3:	.WORD	FEXIT		;NORMALIZE IS A NOP
;
;
	.WORD	FINT		;INTEGER ROUTINE
;
;
	.WORD	FSGN		;GET SIGN FUNCTION
;
;
	.WORD	FABS		;GET ABS FUNCTION
;
;
	.WORD	FNEG		;NEGATE THE FLAC
;
;
	.WORD	FLOAT		;FLOAT THE INTEGER (AC)
;
;
	.WORD	FEXIT		;NOP FOR NOW
;
;
	.WORD	FZER		;CLEAR THE FLAC
;
;
;--------------------------------
;
;
FINT:	CMP	FLAC,#^F-32768	;SEE IF SPECIAL VALUE
	BNE	1$		;NO - EXIT
	BIT	#170000,FLAC+2	;SEE IF CORRECT
	BNE	1$		;NO...EXIT
	MOV	#100000,R1	;SET VALUE
	BR	2$		;GET OUT
1$:	JSR	R4,MOV$MS	;LOAD FLAC AND ENTER POLISH MODE
	FLAC
	.IF	EQ,$DBL
	.WORD	$RI
	.IFF
	.WORD	$DI
	.ENDC
	.WORD	.+2		;EXIT POLISH
	MOV	(SP)+,R1	;GET VALUE
	MOV	(SP)+,R4	;RESTORE R4
2$:	MOV	R1,6(SP)	;PLACE INTO THE RETURN LOC
	POPJ			;RETURN
;
;
FSGN:	MOV	#FLAC,R1	;POINT TO IT
	TST	@R1		;SET CONDITION CODES
	BGT	FSGN2		;HANDLE GREATER THAN
	BEQ	FSGN1		;HANDLE ZERO
	MOV	#^F-1,(R1)+	;SET IT
	BR	FSGN3		;SKIP
FSGN1:	CLR	(R1)+		;CLEAR IT
	BR	FSGN3		;SKIP
FSGN2:	MOV	#^F1,(R1)+	;SET FIRST WORD
FSGN3:	CLR	(R1)+		;ZAP SECOND WORD
	.IF	NE,$DBL
	CLR	(R1)+
	CLR	(R1)+		;AND THE REST TOO
	.ENDC
	POPJ			;EXIT
;
;
;	ABSOLUTE VALUE FUNCTION
;
FABS:	BIC	#100000,FLAC	;RESET BIT ON FLAC
FEXIT:	POPJ			;RETURN
;
;
FNEG:	TST	FLAC		;NEG?
	BEQ	FEXIT		;-0=+0 !!!
	BMI	FABS		;NEGATE BY ABS VAL
	BIS	#100000,FLAC	;SET MINUS IF NOW POS
	POPJ			;RETURN
;
;	FLOAT THE CONTENTS OF R1 INTO THE FLAC
;
FLOAT:	MOV	6(SP),R1	;RECOVER ORIG
	MOV	R4,-(SP)	;SAVE R4
	MOV	R1,-(SP)	;PLACE ONTO THE STACK
	JSR	R4,$POLSH	;ENTER POLISH 
	.IF	EQ,$DBL
	.GLOBL	$IR
	.WORD	$IR
	.IFF
	.GLOBL	$ID
	.WORD	$ID
	.ENDC
	MOV$SM			;RESTORE IT
	FLAC
	.+2			;EXIT POLISH
	MOV	(SP)+,R4	;GET IT BACK
	POPJ			;RETURN
;
;
FZER:	MOV	#FLAC,R1
	BR	FSGN1		;ZERO IT
	.SBTTL	FOCAL FUNCTIONS ENTERED VIA A JSR PC,FXXXX
;
;
;	FITR - GET INTEGER PART
;
XITR:
	.IF	EQ,$DBL
	.GLOBL	AINT
	MOV	#AINT,-(SP)	;STACK
	.IFF
	.GLOBL	DINT
	MOV	#DINT,-(SP)	;STACK IT
	.ENDC
	BR	FUNCT
;
;	FSQT - SQUARE ROOT FUNCTION
;
FSQT:
	.IF	EQ,$DBL
	.GLOBL	SQRT
	MOV	#SQRT,-(SP)
	.IFF
	.GLOBL	DSQRT
	MOV	#DSQRT,-(SP)
	.ENDC
	BR	FUNCT
;
;	FSIN - SINE FUNCTION
;
FSIN:
	.IF	EQ,$DBL
	.GLOBL	SIN
	MOV	#SIN,-(SP)
	.IFF
	.GLOBL	DSIN
	MOV	#DSIN,-(SP)
	.ENDC
	BR	FUNCT
;
;	FCOS - COSINE FUNCTION
;
FCOS:
	.IF	EQ,$DBL
	.GLOBL	COS
	MOV	#COS,-(SP)
	.IFF
	.GLOBL	DCOS
	MOV	#DCOS,-(SP)
	.ENDC
	BR	FUNCT
;
;	FLN - NATURAL LOGARITHM FUNCTION
;
FLN:
	.IF	EQ,$DBL
	.GLOBL	ALOG
	MOV	#ALOG,-(SP)
	.IFF
	.GLOBL	DLOG
	MOV	#DLOG,-(SP)
	.ENDC
	BR	FUNCT
;
;	FLOG - LOG BASE 10 ROUTINE
;
FLOG:
	.IF	EQ,$DBL
	.GLOBL	ALOG10
	MOV	#ALOG10,-(SP)
	.IFF
	.GLOBL	DLOG10
	MOV	#DLOG10,-(SP)
	.ENDC
	BR	FUNCT
;
;	FEXP - EXPONENTIAL FUNCTION
;
FEXP:
	.IF	EQ,$DBL
	.GLOBL	EXP
	MOV	#EXP,-(SP)
	.IFF
	.GLOBL	DEXP
	MOV	#DEXP,-(SP)
	.ENDC
	BR	FUNCT
;
;	FATAN - ARCTANGENT FUNCTION
;
FATAN:
	.IF	EQ,$DBL
	.GLOBL	ATAN
	MOV	#ATAN,-(SP)
	.IFF
	.GLOBL	DATAN
	MOV	#DATAN,-(SP)
	.ENDC

	.IF	NE,$DBL
;
	BR	FUNCT		;ENTER FUNCTION CODE
;
DINT:	MOV	#FLAC+8.,R0		;POINT FOR $DINT
	MOV	-(R0),-(SP)		;PLACE THE FLAC ON THE STACK
	MOV	-(R0),-(SP)
	MOV	-(R0),-(SP)
	MOV	-(R0),-(SP)		;COMPLETE - NOW CALL $DINT
	JSR	R4,$POLSH		;ENTER POLISH
	.GLOBL	$DINT
	.WORD	$DINT
	.WORD	.+2
	MOV	(SP)+,R0
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	RTS	PC			;RETURN LIKE A FORTRAN FUNCTION
	.ENDC
	.SBTTL	GENERAL FUNCTION INTERFACE
;
;
FUNCT:	TST	@SP		;ROUTINE HERE?
	BEQ	3$		;NO - SEND ERROR
	MOV	R0,-(SP)	;SAVE R0-R4
	MOV	R1,-(SP)	;SAVED
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	JSR	R5,2$		;CALL ROUTINE, SAVING R5 AND POINTING
	BR	1$		;AT THIS ARGUEMENT LIST
	.WORD	FLAC		;OPERAND IS IN THE FLAC
1$:	MOV	#FLAC,R4	;POINT AT IT
	MOV	R0,(R4)+	;PASS THE RESULT
	MOV	R1,(R4)+	;CONTINUE
	.IF	NE,$DBL		;IF DBL PRCSN
	MOV	R2,(R4)+	;THIRD WORD
	MOV	R3,(R4)+	;FINAL WORD
	.ENDC
	MOV	(SP)+,R4	;RESTORE THE
	MOV	(SP)+,R3
	MOV	(SP)+,R2	;REGISTERS SAVED
	MOV	(SP)+,R1
	MOV	(SP)+,R0	;ABOVE
	TST	(SP)+		;POP THE ROUTINE ADDRESS
	POPJ			;RETURN TO THE CALLER
;
;	CALL TO DESIGNATED FUNCTION - R5 IS ALL SET UP
;
2$:	INCB	FSW		;SET FLOATING POINT
	JSR	PC,@12.(SP)	;CALL THE ROUTINE
	DECB	FSW		;RESET THE SWITCH
	RTS	R5		;REENTER THE CODE AND RESTORE R5
;
;	ERROR - ROUTINE NOT AVAILABLE
;
3$:	CLRB	FSW		;RESET FORTRAN SWITCH
	ERROR+201+2+2		;ILLEGAL FUNCTION
	.IFDF	$RT11		;RT-11 VERSION
	.SBTTL	$VGET/$VPUT - ROUTINE TO HANDLE A VARIABLE FROM A VIRTUAL FILE
;
	.GLOBL	C.BUF,C.OFF,C.BLK,C.FIL,L.WRT
;
	.GLOBL	GCHAN,DMPBLK,NXTBLK
;
$VPUT:	MOV	#1,AC		;POINT TO TRANSFER TABLE
	BR	$VGO		;DO IT
;
$VGET:	CLR	AC		;POINT TO TRANSFER TABLE
$VGO:	MOV	L.CHAN,-(SP)	;GET CHANNEL INTO THE STACK
	MOV	VCHAN,L.CHAN	;LOOK UP VIRTUAL FILE CHANNEL
	GCHAN			;GET THE CHANNEL POINTER
	MOV	R5,-(SP)	;SAVE R5 ALSO
	MOV	TEMP,R5		;HANG ONTO THE CHANNEL POINTER
	TSTB	@R5		;IS THE CHANNEL OPEN?
	BNE	1$		;YES - CONTINUE
	ERROR+201+36.+36.	;INTERNAL VIRTUAL FILE ERROR
1$:	MOVB	1(R5),TEMP	;GET FORMAT INFO
	ASL	TEMP		;*2 FOR WORD OFFSET
	MOV	#2$,-(SP)	;SET RETURN ADDRESS
	MOV	AC,-(SP)	;IN/OUT SWITCH
	JMP	@V.XFER(TEMP)	;GO DO IT
2$:	MOV	(SP)+,R5	;RECOVER R5
	MOV	(SP)+,L.CHAN	;RESET CHANNEL
	MOV	#VIRTUL,PTR	;SET PTR FOR VIRTUAL FILES
	POPJ			;RETURN
;
V.XFER:	V.DFLT			;USE DEFAULT OF SINGLE OR DOUBLE PRCSN
	V.DBL			;USE DOUBLE PRECISION
	V.SNG			;USE SINGLE PRECISION
	V.XTND			;USE EXTENDED 16 BIT INTEGER
	V.INT			;USE STANDARD SIGNED INTEGER
	V.BYTE			;USE STANDARD UNSIGNED INTEGER BYTE
	V.TEXT			;USE 7 BIT ASCII
;
	.SBTTL	DEFAULT INPUT AND OUTPUT CONVERSION
;
	.MACRO	FIND	.A
	.LIST	MEB
	MOV	VINDEX,AC	;GET SUBSCRIPT
	MOV	#'.A',TEMP		;SET '.A' OCTAL BYTES/ENTRY
	JSR	PC,V.FIND	;LOOK UP THE ENTRY
	.NLIST	MEB
	.ENDM	FIND
;
	.IF	NE,$DBL
V.DFLT:	FIND	10		;GET THE INDEX ENTRY
	.IFF
V.DFLT:	FIND	4
	.ENDC
	MOV	#VIRTUL,AC	;POINT AT OUTPUT FIELD
	TST	(SP)+		;SEE IF WE ARE TO READ OR WRITE
	BNE	2$		;WRITE
	MOV	(PTR)+,(AC)+
	MOV	(PTR)+,(AC)+
	.IF	NE,$DBL
	MOV	(PTR)+,(AC)+
	MOV	(PTR)+,(AC)+
	.ENDC
	BR	3$		;EXIT NOW
2$:	MOV	(AC)+,(PTR)+
	MOV	(AC)+,(PTR)+	;COPY OUT
	.IF	NE,$DBL
	MOV	(AC)+,(PTR)+
	MOV	(AC)+,(PTR)+
	.ENDC
	BIS	#L.WRT,@R5	;SET THE CORRECT BIT
3$:	POPJ			;RETURN
;
;
	.IF	NDF,$SMALL		;8K VERSION DOESN'T HAVE THIS
	.IF	EQ,$DBL
	V.SNG=V.DFLT
;
V.DBL:	FIND	10
	.IFF
	V.DBL=V.DFLT
;
V.SNG:	FIND	4
	.IFTF
	MOV	#VIRTUL,AC	;POINT AT THE AREA
	TST	(SP)+		;READ?
	BNE	1$		;NO - SKIP
	MOV	(PTR)+,(AC)+	;READ THE VARIABLE
	MOV	(PTR)+,(AC)+	;DITTO
	.IFT
	TST	@PTR		;SHOULD WE ROUND?
	BPL	2$		;NO - EXIT
	INC	-(AC)		;UPDATE IT
	ADC	-(AC)		;PASS POSSIBLE CARRY
	.IFF
	CLR	(AC)+		;ZAP IT
	CLR	(AC)+		;AGAIN
	.IFTF
	BR	2$		;EXIT
;
1$:	MOV	(AC)+,(PTR)+	;COPY THE WORDS
	MOV	(AC)+,(PTR)+	;DITTO
	.IFT
	CLR	(PTR)+		;AND ZERO OTHERS
	CLR	(PTR)+
	.IFTF
	BIS	#L.WRT,@R5	;SET WRITTEN INTO
2$:	POPJ			;RETURN
	.ENDC
	.ENDC
	.SBTTL	V.FIND - ROUTINE TO LOCATE THE VIRT. FILE VARIABLE
;
;
;---	ON ENTRY: R0 CONTAINS THE NUMBER OF BYTES/ENTRY. THIS VALUE
;	** M U S T ** BE A POWER OF TWO!!!!!! (OR 1 WHICH IS 2^0)
;
;	R1 HOLDS THE SUBSCRIPT VALUE (POSITIVE PLEASE!!!)
;
;---	ON EXIT, CORRECT BUFFER IS IN CORE, AND "PTR" POINTS TO THE
;	FIRST BYTE OF THE ENTRY.
;
V.FIND:	MOV	AC,PTR		;COPY THE SUBSCRIPT
	BIC	#377,AC		;CLEAR LOW BYTE
	BIC	AC,PTR		;REMAINDER
	SWAB	AC		;FAST DIVIDE BY 256
;
1$:	CMP	TEMP,#1		;IS THIS THE END?
	BLOS	2$		;YES - NOW AS A BYTE QUANTITY
	ROLB	PTR		;A FANCY SHIFT
	ROL	AC		;PLACE IT
	ROR	TEMP		;UPDATE WHERE WE GO
	BCC	1$		;CONTINUE IF A POWER OF TWO
	ERROR+201+36.+36.	;INTERNAL V. F. ERROR
;
2$:	ROR	AC		;RESTORE BYTES (512 BYTES/BLOCK)
	BCC	3$		;SKIP IF ZERO
	BIS	#400,PTR	;SET THE BYTE
3$:	CMP	AC,C.BLK(R5)	;ARE WE ON THE RIGHT BLOCK?
	BEQ	4$		;YES - EXIT
	MOV	VCHAN,TEMP	;CHECK OUT EXPONENT
	ASL	TEMP		;*2 FOR WORDS
	ASL	TEMP		;*4 (2 WORDS/ENTRY)
	.GLOBL	V.NAME
	ADD	#V.NAME,TEMP	;POINT TO THE ENTRY
	CMP	AC,2(TEMP)	;SEE IF WITHIN THE MAX SIZE
	BHIS	5$		;NO - SEND ERROR
	MOV	R5,TEMP		;SET UP
	DMPBLK			;DUMP IT OUT
	MOV	AC,C.BLK(R5)	;SET NEW ONE
	NXTBLK			;GET NEW BLOCK
4$:	ADD	C.BUF(R5),PTR	;POINT AT THE BUFFER
	MOV	PTR,AC		;AC NOW POINTS TO THE FIRST
				; BYTE OF THE ENTRY
	POPJ			;RETURN
;
5$:	ERROR+201+19.+19.	;SUBSCRIPT OUT OF RANGE
	.SBTTL	FLAC SAVE AND RESTORE ROUTINES
;
$FSAVE:	MOV	(SP)+,AC	;SAVE RETURN ADDRESS
	MOV	#FLAC,R0	;POINT AT THE FLAC
	MOV	(R0)+,-(SP)	;SAVE IT
	MOV	(R0)+,-(SP)
	.IF	NE,$DBL
	MOV	(R0)+,-(SP)
	MOV	(R0)+,-(SP)
	.ENDC
	MOV	AC,PC		;SET RETURN ADDRESS
;
$FREST:	MOV	(SP)+,AC
	.IF	EQ,$DBL
	MOV	#FLAC+4,R0
	.IFF
	MOV	#FLAC+8.,R0
	.ENDC
	MOV	(SP)+,-(R0)
	MOV	(SP)+,-(R0)
	.IF	NE,$DBL
	MOV	(SP)+,-(R0)
	MOV	(SP)+,-(R0)
	.ENDC
	MOV	AC,PC		;RETURN
	.IF	NDF,$SMALL
	.SBTTL	ONE WORD INTEGER CONVERSION ROUTINES
;
;
V.XTND:	FIND	2		;GET LOCATION
	TST	(SP)+		;INPUT?
	BEQ	I.XTND
	JSR	PC,$FSAVE	;SAVE THE FLAC
	JSR	R5,$FPMPX	;ENTER FLT PT MODE
	007000			;FGET+DIRECT
	VIRTUL			;VIRTUL;
	007073			;FABS;
	007020			;FSUB+DIRECT
	V.MAX			;V.MAX;
	BR	V.IGO		;CONTINUE
;
V.INT:	FIND	2		;LOCATE THE VARIABLE
	TST	(SP)+		;INPUT?
	BEQ	I.INT		;YES - GO TO IT
	JSR	PC,$FSAVE	;SAVE FLAC
	JSR	R5,$FPMPX	;ENTER FLT PT MODE
	007000			;FGET+DIRECT
	VIRTUL			;VIRTUL;
V.IGO:	JSR	R5,$FPMPX	;RE-ENTER FLOATING POINT MODE
	007071			;FINT
	MOV	AC,@PTR		;SET IT IN
V.OUT:	JSR	PC,$FREST	;RESTORE THE FLAC
	BIS	#L.WRT,@R5	;SET WRITTEN INTO
	POPJ			;RETURN
;
I.XTND:	JSR	PC,$FSAVE
	MOV	@PTR,AC		;GET IT
	JSR	R5,$FPMPX	;ENTER FLT PT MODE
	007075			;FLOAT;
	007010			;FADD+DIRECT
	V.MAX			;MAX NUMBER
	BR	I.IGO		;CONTINUE
;
I.INT:	JSR	PC,$FSAVE
	MOV	@PTR,AC		;GET THE VARIABLE
I.BGO:	JSR	R5,$FPMPX	;ENTER FLOATING POINT MODE
	007075			;FLOAT;
I.IGO:	JSR	R5,$FPMPX	;ENTER FLOATING POINT AGAIN
	007060			;FPUT+DIRECT
	VIRTUL			;PLACE IN THE AREA
	JSR	PC,$FREST	;RESTORE THE FLAC
	POPJ			;RETURN
;
V.MAX:	.FLT4	32768
	.SBTTL	BYTE TRANSFER CONVERSION ROUTINES
;
V.BYTE:	FIND	1
	TST	(SP)+		;SEE IF INPUT OR OUTPUT
	BEQ	I.BYTE		;HANDLE INPUT
	JSR	PC,$FSAVE	;SAVE FLAC
	JSR	R5,$FPMPX	;ENTER FLOATING POINT MODE
	007071			;FINT
	MOVB	AC,@PTR		;SAVE IT
	BR	V.OUT		;GET OUT
;
I.BYTE:	JSR	PC,$FSAVE	;SAVE THE FLAC
	MOVB	@PTR,AC		;GET IT
	BR	I.BGO		;CONTINUE IT
;
;
V.TEXT:	FIND	1
	TST	(SP)+		;IN OR OUT?
	BEQ	I.TEXT		;HANDLE INPUT
	JSR	PC,$FSAVE
	JSR	R5,$FPMPX
	007071			;FINT
	BIC	#177600,AC	;SET TEXT
	MOVB	AC,@PTR		;PLACE INTO THE FILE
	BR	V.OUT		;GET OUT
;
I.TEXT:	JSR	PC,$FSAVE
	MOVB	@PTR,AC
	BIC	#177600,AC
	BR	I.BGO
	.IFF
	V.SNG=V.DFLT
	V.DBL=V.DFLT
	V.XTND=V.DFLT
	V.INT=V.DFLT
	V.BYTE=V.DFLT
	V.TEXT=V.DFLT
	.ENDC
	.ENDC
;
	.END