/FUNCTION EXPANSION PACKAGE FOR LDF-V5D	  MAY-83

/THE FUNCTION-EXPANSION PACKAGE FOR LAB-FOCAL WAS ORIG-
/INALLY DESIGNED BY DON MOORE OF NORTHWEST DIGITAL SYS-
/TEMS, SEATTLE, WASHINGTON.  THANKS FOR THE EFFORT DON!
XLIST
/KE8E=	1		/DEFINE FOR EAE 'MULT10'
MUY=	7405
DVI=	7407
SHL=	7413
ASR=	7415
SWAB=	7431
DAD=	7443
DST=	7445
SWBA=	7447
DPSZ=	7451
SAM=	7457
DPIC=	7573
DCM=	7575
CAM=	7621
DLD=	7663
XLIST

	CDI=CDF CIF
	FIXTAB

	EXIT=31		/FIELD 0
	GOSW=36
	MPUSHF=5250
	IOCMDS=6614
	NIGHT=20070	/FIELD 2

	PDLXR=13	/FIELD 1
	FORLVL=25
	FIRSTV=31
	SPACSW=61
	XGETLN=312
	CERR=636
	COMGO=731
	P237=1672
	EVAL=2010
	ELPAR=2152
	EFUN3=2155
	F1=376
	F2=2366
	F3=6326

	S=00		/DATA FIELD FOR STACK
	P=10		/DATA FIELD FOR PROCESSOR
IFNDEF	X   <X=30>	/DATA FIELD FOR EXPANSION
IFNDEF	SLOT<SLOT=3600>	/FIELD 1 SUPPORT FOR FIELD X
	FIELD 0
	*100
IFNZRO	X-30 <X%10>	/RESERVE HIGHEST FIELD

	*4542		/MAKE 'Z 1' THE DEFAULT
/	CMA
/	DCA I 4552	/'MAXVF'
/	IAC
/	DCA I 4551	/'NUMVF'

	FIELD P%10
	*FIRSTV
IFZERO	X-30   <STVAR>	/REDUCE THE SYMBOL TABLE SIZE

	*COMGO+"@-"@	/EXPAND THE COMMAND TABLE...
	EXPAND
	*COMGO+"K-"@
	EXPAND
	*COMGO+"P-"@
	EXPAND

	*P237+2		/IMPLEMENT 'USER' COMMANDS
	CIF X
	JMP I .+1	/WAS 'CDI;JMP I .+1;IOCMDS'
	TEST4U

	*ELPAR-6	/PATCH FUNCTION TABLE SORT
	CDI X
	JMP I .+1	/WAS 'SNA;JMP I .-1;CLL RAR'
	FNCTN+1

	*SLOT&7600
EXPAND,	TAD LASTC	/COMMAND EXPANSION
	CDI X
	JMP I .+1
	XPAND
APUSHX,	0		/IMPLEMENT 'PUSHA' FOR FIELD X
	PUSHA
	CDI X
	JMP I APUSHX

JPUSHX,	0		/DO A PUSHJ IN FIELD P
	DCA .+2
	PUSHJ
	    0
	TAD SORTCN
	CDI X		/AND RETURN TO FIELD X
	JMP I JPUSHX

TESTX1,	0		/IMPLEMENT 'TESTX' FOR FIELD X
	TESTX
	ISZ TESTX1	/REVERSE THE SKIP
	TAD SORTCN
	CDI X
	JMP I TESTX1

FIXNOR,	0
	SNL
	FIXIT		/IMPLEMENT 'FIXIT' FOR FIELD X
	SZL
	NORMALIZE	/IMPLEMENT 'NORMALIZE' FOR FIELD X
	CDI X
	JMP I FIXNOR

CGET,	0		/IMPLEMENT 'GETC' FOR FIELD X
	GETC
	TAD CHAR
	CDI X
	JMP I CGET

CPRINT,	0		/IMPLEMENT 'PRINTC' FOR FIELD X
	PRINTC
	CDI X
	JMP I CPRINT

NPRINT,	0		/IMPLEMENT 'PRINTN' FOR FIELD X
	TAD SPACSW
	PRINTN
	CDI X
	JMP I NPRINT
	FIELD X%10
	*1
P7,	7
P25,	FORLVL
P14,	14
P12,	12
P15,	15
P70,	NAGSW
FENT=	JMS I .
	16400		/POINTER TO F.P.P.
FEXT=	0
	*14
XRT,	0

	*33
RTL6=	JMS I .		/ROTATE AC LEFT 6
	XRTL6
CONTINUE=JMP I .	/COMMAND RETURN
	CONT
NORMALIZE=JMS I .	/NORMALIZE C(FLAC)
	NORM
ABSOL,	ABSOLV		/TAKE THE ABSOLUTE VALUE
RESOL,	RESOLV		/RESTORE THE PROPER SIGN
SIGN=.			/FOR ABS VALUE

	*44
FLAC=.
EXP,	0		/FLOATING ACCUMULATOR
HORD,	0
LORD,	0
OVER,	0

FLOP=.
EX1,	0		/FLOATING OPERAND
AC1H,	0
AC1L,	0
OVR1,	0

	*65
SORTCN,	0
CHAR,	0
LINENO,	0		/SET BY 'GETLN'
NAGSW,	0		/ "   "    "
LASTC,	0

	*.+2
P13,	PDLXR		/USEFUL CONSTANTS
P17,	17
P43,	43
P7600,	7600
P77,	77
C100,	100
P177,	177
	*.+1
M4,	-4
M5,	-5
M10,	-10		/NOT IN FIELD P
M14,	-14
M15,	-15
P27,	27; ZBLOCK 3	/FOR D.P. FLOAT

/ NEW INSTRUCTIONS

	*120
PUSHA=	JMS I .		/SAVE THE AC ON THE STACK
	XPUSHA
POPA=	JMS I .		/UNLOAD THE STACK
	XPOPA
PUSHJ=	JMS I .		/CALL A SUBROUTINE IN FIELD P
	XPUSHJ
POPJ=	JMP I .		/RETURN FROM A SUBROUTINE
	XPOPJ
PUSHF=	JMS I .		/SAVE 4 WORDS
	XPUSHF
POPF=	JMS I .		/RESTORE THEM
	XPOPF
PUSHJX=	JMS I .		/CALL A SUBROUTINE IN FIELD X
	JXPUSH
SORTJ=	JMS I .		/SORT AND BRANCH ON AC OR CHAR
	SORTB
TESTC=	JMS I .		/TEST FOR TERM, FN, NO., OR VAR
	CTEST
TESTX=	JMS I .		/TEST FOR TERM AND SET SORTCN
	XTEST
TESTN=	JMS I .		/TEST FOR PERIOD, NUMBER
	NTEST
ADDF2F=	JMS I .		/ADD FLOP TO FLAC (NOT IN FIELD P)
	DUBLAD
PRINTN=	JMS I .		/CONVERT BINARY TO ASCII (MAYBE PRINT)
	FLOUTP
SORTC=	JMS I .		/MULTI-LETTER COMMAND SORT
	CSORT
PRINTC=	JMS I .		/PRINT C(AC) OR 'CHAR' (IF AC = 0)
	CHOUT
GETC=	JMS I .		/UNPACK A CHARACTER
	GETCF
GETCHAR=JMS I .		/MAKE FIELD X CHAR & AC = FIELD P CHAR
	CHRGET
SPNOR=	JMS I .		/IGNORE LEADING SPACES
	XSPNOR
TESTLP=	JMS I .		/TEST FOR A -LEFT- PARENTHESIS
	LPRTST
TSTCMA=	JMS I .		/SKIP IF CHAR=COMMA & MOVE PAST IT
	CMATST
TESTCR=	JMS I .		/SKIP IF CHAR = CR
	CRTEST
GETLN=	JMS I .		/COMPUTE A LINE NUMBER (RECURSIVE)
	GETLNX
/ SPECIAL FIELD X ROUTINES

GETFLAC=JMS I .		/MAKE LOCAL COPY OF FIELD P FLAC
	FLACGT
PUTFLAC=JMS I .		/SET FIELD P FLAC = FIELD X FLAC
	FLACPT
	*.+2

/ FLOATING-POINT ROUTINES

FLOAT=	JMS I .		/FLOAT THE AC
	FLOT
FLOATR=	JMP I .		/FLOAT THE AC AND RETURN
	FLOATX
FL0ATR=	JMP I .		/UNSIGNED FLOAT AND RETURN
	FL0ATX
RETURN=	JMP I .		/REGULAR FUNCTION RETURN
	RTN
SHIFTL=	JMS I .		/MULTIPLY FLAC BY 2
	MULT2
NEGATE=	JMS I .		/COMPLEMENT & INCREMENT THE FLAC
	INVERT
FIXIT=	JMS I .		/CONVERT FLAC TO A 24-BIT INTEGER
	FIXER
MULT10=	JMS I .		/MULTIPLY FLAC BY 10 & ADD THE AC
	XTEN
CHKSGN=	JMS I .		/TAKE ABSOLUTE VALUE & CHECK FOR 0
	SGNCHK
GETNXT=	JMS I .		/NON-RECURSIVE ARGUMENT FETCH
	GTNEXT

SP1=	CLA STL RAL
SP2=	CLA STL RTL
SP3=	CLA STL IAC RAL
SP4=	CLA CLL IAC RTL
SP6=	CLA STL IAC RTL
SM0=	CLA STL RAR
SM1=	CMA STL RAL	/NO CLA
SM2=	STA CLL RAL
SM3=	STA CLL RTL

	*176
ERROR2=	JMS I .
	ERR
P7610,	SKP CLA
	PAGE 1		/FUNCTION NAME TABLE
FNTBL,	-1
	0		/1-LETTER NAMES
	"A^2-F1
	0		/2-LETTER NAMES
	"B^4+"C^2-F2
	0		/3-LETTER NAMES
	"D^4+"E^4+"F^2-F3
	0

	0
	0
	0
	0
	0
	0
	0
	0

	0
	0
	0
	0
	0
	0
	0
	0

	0
	0
	0
	0
	0
	0
	0
	0

	0
	0
	0
	0
	0
	0
	0
	0

	0
	0
	0
	0
	0
	0
	0
	0
FL0ATX,	CDI 20		/NEGATIVE NUMBER ENDS FNTBL
	JMP NIGHT	/UNSIGNED FUNCTION RETURN

FLOT,	0		/'FLOAT'
	DCA HORD
	DCA LORD
	DCA OVER
/	TAD HORD	/FIX '0'
/	SZA CLA
	TAD P13
	DCA EXP
	JMP I FLOT
/////

LPRTST,	0		/DECIDE IF CHAR IS A LEFT PAREN
	TAD SORTCN
	TAD M10
	AND M4
	SZA CLA
	ISZ LPRTST	/CHAR IS A LEFT PAREN
	JMP I LPRTST	/NOT A LEFT PAREN
/////

NTEST,	0		/TEST FOR PERIOD, NUMBER - 'TESTN'
	GETCHAR
	TAD (200-".
	SZA
	ISZ NTEST
	TAD M14		/TEST FOR 0-9
	CLL
	TAD P12
	DCA SORTCN	/FIELD X ONLY
	SZL
	ISZ NTEST
	JMP I NTEST

GETCF,	0		/GET CHAR FROM TEXT BUFFER - 'GETC'
	CIF P
	JMS I (CGET
	DCA CHAR
	JMP I GETCF
/////

GETLNX,	0		/GET A LINE NUMBER - 'GETLN'
	PUSHJ
	    XGETLN+3
	CDF P
	TAD I (LINENO
	DCA LINENO
	TAD I P70	/(NAGSW
	DCA NAGSW
	CDF X
	JMP I GETLNX
/////
ABSOLV,	0		/TAKE THE ABSOLUTE VALUE
	TAD HORD
	DCA SIGN
	JMS RESOLV
	JMP I ABSOLV

RESOLV,	0		/RESTORE THE PROPER SIGN
	TAD SIGN
	SPA CLA
	JMS INVERT
	JMP I RESOLV

INVERT,	0		/COMPLEMENT FLAC - 'NEGATE'
	TAD OVER
	CLL CIA
	DCA OVER
	CML RAL
	TAD LORD
	CIA
	DCA LORD
	CML RAL
	TAD HORD
	CIA
	DCA HORD
	JMP I INVERT

SGNCHK,	0		/DOESN'T SET LINK OR T3 - 'CHKSGN'
	JMS ABSOLV
	PUTFLAC		/SAVE MODIFIED FLAC (LIKE 'FLARG')
	TAD SIGN
	SZA
	ISZ SGNCHK	/FIRST RETURN IF ZERO
	JMP I SGNCHK
/////
	PAGE
FNTBF,	ERROR3		/FUNCTION ADDRESS TABLE
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3

	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3

	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3

	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3

	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3

	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
	ERROR3
/	CHARACTER TESTS

CTEST,	0		/TEST THE NEXT CHARACTER - 'TESTC'
	JMS XSPNOR	/IGNORE SPACES
	JMS XTEST	/CHECK FOR A TERMINATOR
	SKP
	JMP I CTEST	/IT WAS A TERM - 'SORTCN' IS SET
	ISZ CTEST
	TAD CHAR
	AND XMSP+1	/EITHER CASE
	TAD (200-"F
	SNA CLA
	JMP I CTEST	/FUNCTION
	TESTN
	SKP		/PERIOD
	ISZ CTEST	/OTHER
	ISZ CTEST	/NUMBER
	JMP I CTEST	/RETURNS: T;F;N;V
/////

XTEST,	0		/IS CHAR A TERMINATOR? - 'TESTX'
	CDI P
	JMS I (TESTX1
	ISZ XTEST	/YES: TAKE 2ND RETURN
	DCA SORTCN
	JMP I XTEST
/////

XSPNOR,	0		/IGNORE INTERVENING SPACES - 'SPNOR'
	JMS CHRGET	/COPY FIELD P CHAR TO FIELD X CHAR
	TAD XMSP
	SZA CLA
	JMP I XSPNOR
	GETC
	JMP XSPNOR+1
/////

CMATST,	0		/TEST FOR A COMMA - 'TSTCMA'
	JMS CHRGET
	TAD (200-",
	SZA CLA
	JMP I CMATST	/FIRST RETURN IF IT'S NOT
	GETC
	ISZ CMATST
	JMP I CMATST	/REMOVE IT AND TAKE 2ND RETURN
/////

CRTEST,	0		/SKIP IF CHAR IS A CR - 'TESTCR'
	JMS CHRGET
	TAD M15
	SNA CLA
	ISZ CRTEST
	JMP I CRTEST
/////
CHRGET,	0		/COPY FIELD P CHAR TO FIELD X CHAR
	CLA
	CDF P
	TAD I XMSP-2	/(CHAR)
	DCA CHAR
	CDF X
	TAD CHAR
	JMP I CHRGET
/////

CSORT,	0		/COMMAND SORT - 'SORTC'
	JMS XSPNOR
	TAD XMSP+1
	AND CHAR	/MASK LOWER CASE AND SAVE
	DCA LASTC
XMSP,	SMA SZA CLA
	GETC		/LOWER-CASE MASK ('4537')
	JMS XTEST
	JMP XMSP+1	/SCAN TO END OF WORD
	TAD LASTC
	JMP I CSORT	/ALL READY FOR A 'SORTJ'
/////

TEST4U,	SPA SNA		/TEST FOR A 'U' COMMAND
	JMP IOCMDX
	SP2		/DROP THE STACK 5 WORDS
	STL RAL
	TAD I P13	/(PDLXR
	DCA I P13
	ISZ I P25	/(FORLVL
	JMS CSORT
	SORTJ		/TEST SECOND LETTER
	    ULIST-1
	    UGO-ULIST
	IAC		/SET ERROR FLAG
IOCMDX,	CDI 0
	JMP I (IOCMDS	/CONTINUE 'I','O','U'
/////
	PAGE
CMNLST,	"@&177		/SINGLE-LETTER TABLE OMITS
	"K&177
	"P&177		/'V' BECAUSE IT FITS IN F1

XPAND,	JMS SORTB	/ENDS THE LIST
	    CMNLST-1
X20,	    CMNDGO-CMNLST
CMDER,	CDI P
	JMP CERR	/COMMAND NOT IMPLEMENTED...

ULIST,	0&177		/SECOND-LETTER TABLE FOR 'U'
	0
	0
	0
	0
	0

CONT,	CDI 0		/COMMAND EXIT - 'CONTINUE'
	JMP EXIT

CMNDGO,	CMDER		/@
	CMDER		/K
	CMDER		/P

UGO,	CMDER		/RELOCATE IF NECESSARY
	CMDER
	CMDER
	CMDER
	CMDER
	CMDER
/////

XRTL6,	0		/ROTATE AC LEFT SIX - 'RTL6'
	CLL RTL
	RTL
	RTL
	JMP I XRTL6
/////

FNCTN,	ELPAR-3		/RETURN TO F1 FUNCTION SORT
	SNA
	JMP FSFXIT	/FSF CALL
	CLL RAR
	GETFLAC
	JMS SORTB	/DO FIELD X FIRST!
	   FNTBL-1
	   FNTBF-FNTBL
ERROR3,	TAD I PUTFLA&177/NOT IN FIELD X LIST
	CDI P
	JMP I FNCTN	/SO TRY FIELD P
FSFXIT,	CDI P
	JMP I FNCTN+1	/EXECUTE A F.S.F.
/////
IFNDEF	KE8E	    <
XTEN,	0		/MULTIPLY FLAC BY 10 (DECIMAL)
	DCA TEMP	/AND ADD IN THE C(AC) AT THE END
	TAD OVER
	DCA OVR1
	TAD LORD	/TRIPLE PRECISION MULTIPLY
	DCA AC1L	/BY TEN (DECIMAL)
	TAD HORD
	DCA AC1H
	JMS MULT2	/MULTIPLY FLAC BY 2 TWICE
	JMS MULT2
	JMS DUBLAD	/ADD ORIGINAL TO GET 5X
	JMS MULT2
	TAD TEMP	/ADD LAST DIGIT RECEIVED
	DCA OVR1
	DCA AC1L
	DCA AC1H
	JMS DUBLAD
	DCA EX1		/CLEAR OVERFLOW WORD
	JMP I XTEN
	*.+1	  >	/EXECUTION TIME = 200 MICROSECONDS
/////

IFDEF	KE8E	    <
XTEN,	0		/EAE (MODE B) VERSION IS 4X FASTER!
	SWP
	DCA TEMP	/SAVE MQ
	TAD OVER
	SWP MUY
	    P12
	SWP
	DCA OVER
	TAD LORD
	SWP MUY
	    P12
	SWP
	DCA LORD
	TAD HORD
	SWP MUY
	    P12
	TAD TEMP	/RESTORE MQ (UNLESS OVERFLOW)
	SWP
	DCA HORD
	JMP I XTEN  >	/EXECUTION TIME = 50 MICROSECONDS
/////
TEMP,
DIV2,	0		/SHIFT FLAC RIGHT
	CLA CLL
	TAD HORD
	SPA
	CML
	RAR
	DCA HORD
	TAD LORD
	RAR
	DCA LORD
	TAD OVER
	RAR
	DCA OVER
	ISZ EXP
	JMP I DIV2
	JMP I DIV2
/////

MULT2,	0		/MULTIPLY FLAC BY 2 - 'SHIFTL'
	TAD OVER
	CLL RAL
	DCA OVER
	TAD LORD
	RAL
	DCA LORD
	TAD HORD
	RAL
	DCA HORD
/	TAD EX1		/NOT USED IN FIELD X
/	RAL
/	DCA EX1
	JMP I MULT2	/DOES NOT CHANGE 'EXP'
/////

DUBLAD,	0		/TRIPLE PRECISION ADDITION
	CLL
	TAD OVR1
	TAD OVER
	DCA OVER
	RAL
	TAD AC1L
	TAD LORD
	DCA LORD
	RAL
	TAD AC1H
	TAD HORD
	DCA HORD
	JMP I DUBLAD
/////
SORTB,	0		/SORT AND BRANCH ROUTINE - 'SORTJ'
	SNA
	GETCHAR		/COPY FIELD P CHAR TO FIELD X
	CIA
	DCA TEMP
	TAD I SORTB	/FIRST ARGUMENT IS LIST-1
	ISZ SORTB
	DCA XRT
	TAD I XRT
	SPA		/LISTS ARE ENDED BY NEGATIVE #'S
	JMP SEX		/NOT THERE!
	TAD TEMP
	SZA CLA		/MATCH?
	JMP .-5		/NOT REALLY
	TAD XRT
	TAD I SORTB	/COMPUTE ADDRESS
	DCA SORTB
	TAD I SORTB	/DEBUG: AC= ADDRESS
	DCA SORTB
SEX,	SZA CLA		/CLEAR AC IF NO MATCH
	ISZ SORTB	/TAKE THE SECOND EXIT
	JMP I SORTB
/////

FLOATX,	FLOAT		/SIGNED FUNCTION RETURN
RTN,	PUTFLAC		/REGULAR    "       "
	CDI P
	JMP I (EFUN3
/////

GTNEXT,	0		/NON-RECURSIVE ARGUMENT FETCH
/	TAD GTNEXT
/	PUSHA		/(THE COMMENTED CODE
	PUSHJ
	    EVAL
/	POPA		/MAKES IT RECURSIVE)
/	DCA GTNEXT
	FIXIT
	JMP I GTNEXT	/FOR COMMANDS, SOME FUNCTIONS
////
JXPUSH,	0		/RECURSIVE CALL FOR FIELD X
	TAD I JXPUSH	/GET THE TARGET ADDRESS
	DCA XPUSHA	/SAVE FOR THE INDIRECT JUMP
	TAD JXPUSH	/GET THE RETURN ADDRESS
	IAC		/BUMP IT
	SKP		/AND PUSH IT ON THE STACK

XPUSHA,	0		/SAVE AC ON STACK
	CDI P
	JMS I (APUSHX
	JMP I XPUSHA
/////

XPUSHJ,	0		/RECURSIVE CALL FOR FIELD P
	CLA IAC
	TAD XPUSHJ	/BUMP AND SAVE RETURN
	JMS XPUSHA
	TAD I XPUSHJ	/GET THE TARGET ADDRESS
	CDI P
	JMS I (JPUSHX	/GO DO SOMETHING IN FIELD P
	DCA SORTCN

XPOPJ,	JMS XPOPA	/GET THE RETURN ADDRESS
	DCA XPOPA
	JMP I XPOPA	/BRANCH
/////

XPOPA,	0		/PULL SOMETHING OFF THE STACK
	DCA XPUSHA	/SAVE THE AC
	CDF P
	ISZ I P13	/INCREMENT STACK POINTER
	TAD I P13	/GET STACK POINTER
	DCA JXPUSH	/HANDY LOCATION
	TAD XPUSHA	/RESTORE AC
	CDF S
	TAD I JXPUSH	/ADD IN STACK ELEMENT
	CDF X
	JMP I XPOPA
/////

XPUSHF,	0		/SAVE A FLOATING-POINT NUMBER
	TAD XPUSHF
	CDI S		/USE FIELD 0 ROUTINE FOR THIS
	DCA I (MPUSHF
	CDF X		/RESET THE CALLING FIELD
	TAD .-1		/FORCE A RETURN TO FIELD X
	JMP I (MPUSHF+3
/////
XPOPF,	0		/RESTORE A FLOATING-POINT NUMBER
	CLA CMA
	TAD I XPOPF	/BACKUP DATA POINTER
	ISZ XPOPF	/AND ADVANCE THE RETURN
	DCA XRT
	JMS XPOPA	/DUMP FOUR WORDS
	DCA I XRT
	JMS XPOPA
	DCA I XRT
	JMS XPOPA
	DCA I XRT
	JMS XPOPA
	DCA I XRT
	JMP I XPOPF
/////

FLACGT,	0		/MAKE LOCAL COPY OF FIELD P FLAC
	DCA FLACPT
	CDF P
	TAD I (EXP
	DCA EXP
	TAD I (HORD
	DCA HORD
	TAD I (LORD
	DCA LORD
	TAD I (OVER
	DCA OVER
	CDF X
	TAD FLACPT
	JMP I FLACGT
/////

FLACPT,	0		/SET FIELD P FLAC = LOCAL FLAC
	DCA FLACGT
	CDF P
	TAD EXP
	DCA I (EXP
	TAD HORD
	DCA I (HORD
	TAD LORD
	DCA I (LORD
	TAD OVER
	DCA I (OVER
	CDF X
/	TAD FLACGT	/LEAVE AC=0
	JMP I FLACPT
/////
NORM,	0		/NORMALIZES BOTH FLACS
	CLA STL
	TAD NORM
	DCA FIXER
	JMS FLACPT	/COPY FLAC TO FIELD P
	JMP FIXER+2
/////

FIXER,	0		/FIXES THE 'REAL' FLAC - 'FIXIT'
	CLL
	CDI P		/('PUTFLAC;FIXIT' DOES FIELD X)
	JMS I (FIXNOR
	JMS FLACGT	/NOW COPY IT BACK UP
	JMP I FIXER
/////

ERR,	0		/PRINT AN ERROR MESSAGE - 'ERROR2'
	CLA CMA
	AND ERR
	CDI 0
	JMP GOSW+3	/USE LOWER FIELD CALL TO SAVE LOC
/////

CHOUT,	0		/OUTPUT A CHARACTER - 'PRINTC'
	SNA
	TAD CHAR
	CDI P
	JMS I (CPRINT
	JMP I CHOUT
/////

FLOUTP,	0		/CONVERT BINARY TO ASCII - 'PRINTN'
	CDI P
	JMS I (NPRINT
	JMP I FLOUTP
/////
	PAGE
STVAR=.			/KEEP AT END FOR FIELD 3
	$