/FLOATING POINT INPUT/OUTPUT ROUTINES:
/ 8XFPP.PA
/ FOR PDP8I OR PDP12 WITH EAE
/ REVISIONS:
/   PRINTC CHANGED TO CLA AT 15666 TO DELETE LEADING SPACE
/	

/NOTE: THESE ROUTINES HAVE BEEN EXTENSIVELY REVISED!

	*5400		/AFTER THE FUNCTIONS
FLINTP,	0		/CONVERT ASCII TO BINARY - 'READN'
	JMS FIGO5	/CHECK LEADING CHARACTERS
	JMS FIGO4	/READ FIRST DIGIT GROUP
	SNL		/ENDED BY A PERIOD?
	JMS FETCH	/SKIP IT & READ 2ND GROUP
	JMS FIGO7	/AND SET NEW DIGIT COUNT
	JMS I RESOL	/FIX UP THE SIGN
	TAD CHAR
	TAD (-"E	/DID WE READ AN 'E'?
	SZA CLA
	JMP FIGO2	/NO

FIGO1,	JMS FETCH	/YES, PASS THE 'E'
	FENT
	FPUT I FLARGP	/SAVE THE MANTISSA & DEC. PT.
	FEXT
	JMS FIGO4	/READ THE DECIMAL EXPONENT
	TAD OVER
	ISZ SIGN	/CHECK THE SIGN
	CIA
	DCA FIGO4	/SAVE THE RESULT
	FENT
	FGET I FLARGP	/RESTORE WHAT WE HAD
	FEXT
	TAD FIGO4	/COMBINE THE SCALE FACTORS

FIGO2,	TAD EXP		/SET UP THE LOOP COUNTER
	CLL
	SPA
	STL CIA		/WITH -(ABS. VALUE+1)
	CMA
	DCA FIGO4
	SZL		/TEST DIRECTION
	TAD FL10
	TAD (FMUL FLP1	/OR 'FMUL FL10'
	DCA FIGO3+1
	TAD P43		/INSERT THE PROPER EXPONENT
	DCA EXP
	NORMALIZE
	JMP FIGO3+3

FIGO3,	FENT		/SCALE LEFT OR RIGHT
	FMUL FL10
	FEXT
	ISZ FIGO4
	JMP FIGO3
	JMP I FLINTP	/***RETURN***
FIGO4,	0		/READ A GROUP OF DIGITS
	JMS FIGO6	/START WITH ZERO
	SM1
	DCA SIGN	/INITIALIZE SIGN
	TAD CHAR
	TAD (-"-
	SZA
	ISZ SIGN	/RESET IF POSITIVE
	CMA CLL RAL	/SET CODE FOR "+"
	CMA CLL RAR	/"+" -> 0000(1)
	SNA CLA		/NOT "+" OR "-"
	IAC		/SKIP THE SIGN
	JMS FIGO5	/AND IGNORE SPACES
	JMS FIGO7	/DO ALL THE WORK
	JMP I FIGO4
/////

FIGO5,	0		/PROCESS LEADING CHARACTERS
	SMA SZA		/-240, ONLY 'SZA' OCCURS
	JMS FETCH	/GET FIRST OR NEXT
	TAD CHAR
	TAD .-3		/IS IT A SPACE?
	SNA CLA
	JMP .-4		/IGNORE LEADING SPACES
	JMP I FIGO5
/////

FIGO6,	0		/'FLOAT'
	DCA HORD
	DCA LORD
	DCA OVER
	TAD P13
	DCA EXP
	JMP I FIGO6
/////

/READ A CHARACTER FROM TEXT OR THE INPUT DEVICE:

FETCH,	0
	TAD I FLINTP	/CHECK THE NEXT INSTRUCTION
	SMA CLA
	JMP ACCEPT
	GETC		/READ FROM THE TEXT BUFFER
	JMP I FETCH
/////
	PRINTC		/IN CASE WE WANT TO ECHO FF
ACCEPT,	READC		/READ FROM THE INPUT DEVICE
	SORTJ		/TEST FOR SPECIAL ACTION
	    SPECIAL-1
	    ACTION-SPECIAL
	JMP I FETCH
/////
FIGO7,	0		/DECIMAL-TO-BINARY CONVERSION
	DCA EXP		/CLEAR DIGIT COUNTER
	TESTN
	JMP I FIGO7	/PERIOD, L=0
	JMP FIGO9	/OTHER,  L=0
	TAD SORTCN	/GET THE NUMBER
FIGO8,	MULT10		/ADD IT IN
	SZA CLA
	JMP .+3
	TAD HORD	/CHECK FOR OVERFLOW
	SPA CLA
	ERROR2		/INPUT OVERFLOW ERROR
	ISZ EXP		/COUNT THE DIGITS
	JMS FETCH	/GET ANOTHER ONE
	JMP FIGO7+2
/////
FIGO9,	TAD CHAR	/ALLOW A-Z
	TAD (-"E
	SNA
	JMP I FIGO7	/'E' IS SPECIAL AND L=1
	TAD ("E-"Z-1
	STL IAC
	TAD ("Z-"A+1
	SNL SZA
	JMP FIGO8	/TREAT A-Z LIKE NUMBERS
	STL CLA
	JMP I FIGO7	/L=1
/////

/THESE TWO CONSTANTS MUST NOT BE SEPARATED

FLP1,	-3;3146;3146;3147
FL10,	+4;2400;0000;0000

ECHOGO=.		/BRANCH LIST FOR 'READC'
	IECHO-2		/FF
	IECHO+1		/LF
	IECHO+1		/RO

	*PRODUCT
SPECIAL,233		/ESCAPE
	375		/ALTMODE
	"_		/RESTART
ECHOLST,FF		/IGNORE  (KEYBOARD ONLY)
	LF		/IGNORE
	RO		/IGNORE
/THIS ROUTINE EXTENDS THE FORMAT SPECIFICATIONS (%W.DD) TO
/ALLOW THE NUMBER OF DIGITS PRINTED IN SCIENTIFIC NOTATION
/TO BE CONTROLLED.  A FORMAT OF '0' MEANS 'ALL SIGNIFICANT
/DIGITS' WHILE '.05' MEANS 'JUST PRINT 5' WITH APPROPRIATE
/ROUNDING.  THIS FORMAT PRINTS A LEADING DIGIT FOLLOWED BY
/A DECIMAL POINT, MORE DIGITS AND THEN THE EXPONENT.

/ANOTHER IMPROVEMENT IS THAT THE MINUS SIGN IS ALWAYS OUT-
/PUT JUST AHEAD OF THE FIRST SIGNIFICANT DIGIT.

	*5600		/A RATHER SPECIAL LOCATION!
PD,	DIGITS		/DEFAULT

TGO,	0		/CALLED BY 'PRINTN'
	DCA XRT2	/SAVE BUFFER ADDRESS
	TAD FISW	/GET FORMAT SAVED BY % TRAP
	AND P7600	/ISOLATE THE FIELD LENGTH
	RTL6
	STL CIA		/NEGATE AND TEST FOR ZERO
	DCA FLAC	/SAVE MINUS FIELD LENGTH

	TAD FISW	/GET NO. OF DECIMAL PLACES
	SNA
	TAD PD		/USE DEFAULT IF NONE SPEC.
ESGN,	AND P177	/A REASONABLE LIMIT!
	SNL		/SCIENTIFIC?
	JMP SPM0+1	/YES, ROUND TO D PLACES

	TAD FLAC	/COMPARE FIELD SIZE
	SNL		/ D-F < 0 ?
	STA STL		/NO, TAKE D = F-1
	TAD T3		/COMPARE DECIMAL EXPONENT
	SNL SMA SZA	/ E > F-D ?
SPM0,	SNL SMA SZA CLA	/ROUND OFF TO F PLACES
	CIA		/ENTER HERE FOR SCI. NOT.
	DCA T2		/SAVE F-D-E (OR 0 OR -D)

	TAD T2		/THIS IS TRICKY BUSINESS!
	STL		/EXTEND THE SIGN
	TAD FLAC	/ -(E+D), -F OR -D (-D-F)
	TAD PD		/COMPARE WITH LIMIT
	SZL		/SKIPS FOR 0 < AC < PD+1
	CLA		/LIMIT ROUNDOFF TO DIGITS+1
	TAD EX1		/ADD -PD-1 (MDM1) TO RESTORE
	STL CIA		/(E+D),  F,  D,  DIGITS (+1)

BUMP,	TAD XRT2	/SET UP BUFFER ADDRESS
	DCA OUTA
	ISZ I OUTA	/INCREMENT THIS DIGIT
	TAD I OUTA	/NOW TEST IT
	SNL		/LITTLE EXTRA THE FIRST TIME
	TAD M4
	TAD M5
	SPA SNA CLA	/CARRY REQUIRED?
	JMP RNDC+4	/NO: GO TO OUTPUT
	DCA I OUTA	/YES: MAKE CURRENT DIGIT ZERO
	STL IAC		/SET UP LINK FOR NEXT CYCLE &
	DCA I START	/ANTICIPATE CARRY FROM 999...
	TAD OUTA	/DECR AND CHECK THE POINTER
	TAD RNDC	/-(START OF BUFFER)
	SZA		/BEGINNING OF BUFFER REACHED?
	JMP BUMP	/NO:  BUMP THE NEXT DIGIT

	ISZ T3		/YES: INCR. DECIMAL EXPONENT
RNDC,	-BUFFER-1	/'NOP'
	CMA		/AND SET THE MANTISSA TO 0.1
	TAD XRT2	/BY DECREMENTING THE POINTER
	JMP TGO+1	/RECOMPUTE THE DECIMAL POINT

	SM1		/SET SIGN COUNTER
	DCA T1
	TAD C240	/'TAD ESGN' IF YOU WISH
	CLA	/PRINTC TO PRINT A LEADING SPACE BEFORE #

	TAD FLAC	/GET FIELD SIZE
	SNA		/FLOATING OUTPUT ?
	JMP FLOUT	/YES
	TAD T3		/COMPARE WITH EXPONENT
	SMA SZA CLA	/ E > F ?
	JMP FLOUT+2	/YES: USE FLOATING FORMAT
	TAD T2		/ F-D-E (OR 0 IF E > F-D)
	TAD T3		/ F-D OR E
	CIA		/CALCULATE -NO. OF POSITIONS
	DCA T2		/TO PRINT BEFORE DECIMAL PT.

BACK,	TAD T2		/PRINT DD.DDD
	TAD T3
	SNA CLA		/ P = E ?
	JMP DIG		/YES: PRINT DIGIT
	IAC		/NO ('376' TO SUPPRESS 1ST ZERO)
	TAD T2
	SPA CLA		/ P < 1 ?
	TAD SPM0	/YES: PRINT SPACE
AGAIN,	JMS OUTA	/PRINT CHARACTER
	ISZ T2		/P CHARACTERS PRINTED?
	JMP BACK	/NO
	SM2		/YES ('TAD 376')
	PRINTD		/PRINT DECIMAL POINT
	JMP BACK

FLOUT,	TAD T2		/SET FIELD SIZE
	DCA FLAC	/ -D
	SM1		/SET FLAG
	DCA OUTA
	ISZ TGO		/SET SECOND RETURN
DIG,	CLA SM1		/POINTS TO 'TERM'
	TAD T3		/REDUCE E BY 1
	DCA T3
	JMS GETD	/GET NEXT DIGIT
	ISZ OUTA	/TEST FLAG
	JMP AGAIN	/NORMAL RETURN

	PRINTD		/PRINT FIRST FLOATING DIGIT
	SM2		/CREATE A PERIOD (256-260)
	SKP		/DON'T FETCH & DON'T COUNT
	JMS GETD	/FETCH NEXT DIGIT
	JMS OUTA	/PRINT IT
	JMP .-2		/AND REPEAT

OUTA,	0
	PRINTD		/PRINT CHARACTER
	ISZ FLAC	/F CHARACTERS PRINTED?
	JMP I OUTA	/NO: RETURN
	JMP I TGO	/YES: NUMBER FINISHED
/////

GETD,	0		/ROUTINE TO UNLOAD BUFFER
	TAD I XRT2	/AUTO-INDEX REG. SETUP UPON ENTRY
	ISZ EX1		/TEST FOR END OF SIGNIFICANT FIG.
	JMP I GETD
	CLA CMA		/FORCE -1 IN ORDER TO
	DCA EX1		/OUTPUT EXTRA ZEROS
	JMP I GETD	/LEAVE C(AC)=0
/////
FTRM,	TAD I DIG	/GET THE INPUT TERMINATOR
	FLOATR
/////

DBLSUB,	0		/CHECK FOR A SECOND SUBSCRIPT
	TSTCMA
	JMP I DBLSUB	/ONLY ONE
	PUSHF
	    FLAC	/SAVE THE FIRST ONE
	PUSHJ
	    EVAL	/GET THE SECOND ONE
	POPF
	    FLARG	/TEMPORARY STORAGE
	TAD DIMEN
	DCA PT1		/SET THE VARIABLE POINTER
	FENT
	FSUB I FP1	/THE SECOND MINUS ONE
	FMULIPT1	/TIMES THE DIMENSION
	FADD I FLARGP	/PLUS OFFSET OF FIRST
	FEXT
	JMP I DBLSUB	/CALLED BY 'GETARG'
DIMEN,	STVAR+2+WORDS+2	/DATA POINTER FOR (!)
	PAGE

LNFEED=	(0&(1&(2	/RESERVE 3 LOCATIONS
XLIST;	NOPUNCH;  PAGE 30;  ENPUNCH;  XLIST
/FLOATING POINT OUTPUT CONVERSION: 'PRINTN'

/REWRITTEN TO PROVIDE THREE NEW FEATURES: (1) A 'FLOATING'
/MINUS SIGN WHICH APPEARS BEFORE THE FIRST DIGIT; (2) A
/MEANS FOR 'TDUMP' TO OUTPUT 3-DIGIT SUBSCRIPTS (+/-999);
/(3) A PROVISION FOR NON-PRINTING CALLS WHICH JUST SET UP
/THE OUTPUT BUFFER BUT DO NOT DO ANY PRINTING.

/THANKS TO JIM CRAPUCHETTES FOR TWELVE LOCATIONS!

MDM1,	-DIGITS-1	/START FLOUTP AT PAGE+1

FLOUTP,	0		/CONVERT BINARY TO ASCII
	DCA T2		/SET THE NON-PRINT FLAG
	STL IAC
	DCA T3		/INITIALIZE THE EXPONENT
	JMS I ABSOL	/TAKE THE ABSOLUTE VALUE
	CMA RAR		/LINK WILL BE ZERO IF NEGATIVE
	DCA FGO6	/SET THE SIGN FLAG
	TAD SIGN
	SNA CLA		/ZERO?
	JMP FGO3

FGO1,	FENT		/NUMBER TOO LARGE
	FMUL I (FLP1	/MULTIPLY BY .1
	FEXT
	ISZ T3		/INCREASE DECIMAL EXPONENT
	TAD EXP
	SMA SZA CLA	/CHECK THE BINARY EXPONENT
	JMP FGO1

FGO2,	FENT		/NUMBER TOO SMALL
	FMUL I (FL10	/MULTIPLY BY 10
	FEXT
	CMA		/DECREASE DECIMAL EXPONENT
	TAD T3
	DCA T3
	TAD EXP		/CHECK THE BINARY EXPONENT
	SPA SNA
	JMP FGO2

FGO3,	CMA		/NEGATE THE BIT COUNT
	DCA EXP
	TAD MDM1	/INITIALIZE DIGIT COUNT
	DCA OUTDG
	TAD START	/INITIALIZE BUFFER POINTER
	DCA XRT2

FGO4,	DCA EX1		/SHIFT OUT THE FIRST DIGIT
	SHIFTL
	TAD EX1
	RAL
	ISZ EXP
	JMP FGO4
	SKP
FGO5,	MULT10		/IE. 0.672 X 10 = 6 + 0.72.. ETC.
	DCA I XRT2
	ISZ OUTDG	/ALL DIGITS OUTPUT?
	JMP FGO5	/NO: CONTINUE

	TAD MDM1
	DCA EX1		/SAVE NO. OF DIGITS
	TAD START	/GET BUFFER POINTER
	ISZ T2		/TEST PRINT FLAG
	JMS I .+1	/OUTPUT MANTISSA
	JMP I FLOUTP	/FIXED POINT DONE

	TAD ("E		/PRINT 'E'
	PRINTC
	JMS FGO6	/OUTPUT THE EXPONENT
	JMP I FLOUTP	/FLOATING POINT DONE
/////

OUTDG,	0		/MULTI-PURPOSE ROUTINE - 'PRINTD'
	SMA		/IGNORE SPACES AND THE LIKE OR
	ISZ T1		/DIGITS OTHER THAN THE FIRST !
	JMP DGOUT
	DCA T1		/SAVE THE FIRST DIGIT
	ISZ FGO6	/CHECK THE SIGN FLAG
	TAD C255	/MAKE A '-'
	TAD C240	/'SZA' TO OMIT THIS SPACE
	PRINTC
	TAD T1		/RESTORE AC

DGOUT,	TAD ("0		/FORM ASCII
	PRINTC
	JMP I OUTDG
C255,	15		/'255'
/////

FGO6,	0		/ALSO CALLED BY 'TDUMP'
	TAD T3		/GET EXPONENT
	SPA CLA		/TEST SIGN
	SP2		/+2 -> -3
	TAD M5
	JMS OUTDG	/PRINT SIGN
	TAD T3
	SPA
	CIA
	MQL DVI		/DIVIDE BY ONE HUNDRED
	    144
	DCA T2
	SWP		/PRINT QUOTIENT
	SZA		/UNLESS IT'S ZERO
	JMS OUTDG
	TAD T2		/NOW PRINT REMAINDER
	JMS PRNT
	JMP I FGO6
PRNT,	0		/PRINT TWO DECIMAL DIGITS
	AND P177
	MQL DVI		/DIVIDE BY TEN
	    12
	DCA T2
	SWP		/GET QUOTIENT
	JMS OUTDG
	TAD T2		/GET REMAINDER
	JMS OUTDG
	DCA T1		/RESET SWITCH
	JMP I PRNT	/CALLED BY 'FGO6' & 'PRNTLN'
/////

MPLY,	0		/CONTINUATION OF EAE MULTIPLY
	TAD LORD
	DCA .+3
	TAD AC1L	/B*E
	SWP MUY
	0
	TAD EX1
	MQL		/DISCARD FOUR
	RAL
	DCA EX1		/INITIALIZE TWO

	TAD HORD
	DCA .+3
	TAD AC1L	/A*E
	SWP MUY
	0
	TAD EX1		/ADD TO TWO
	DCA EX1

	TAD LORD
	DCA .+3
	TAD AC1H	/B*D
	SWP MUY
	0
	TAD EX1		/BUILD UP TWO
	JMP I MPLY	/FINISH ONE & TWO

	FIELD 1		/FORGET LITERALS

	*LNFEED
	TAD I TABCNT	/WHERE ARE WE?
	SNA CLA
	JMP I CFF	/IGNORE THE LF AFTER A CR
	TAD LASTC
	DCAIAXIN	/SAVE THE LAST CHARACTER
	JMP I .+1
	LFCONT-7	/RETYPE THE INPUT LINE
/THIS IS A VERY HANDY ROUTINE FOR CONVERTING BCD DATA TO
/BINARY FLOATING POINT FORM.  JUST SET EXP=43 AT THE END.

	*6204
XTEN,	0		/MULTIPLY THE FLAC BY 10 (DECIMAL)
	SWP		/AND ADD IN C(AC)
	DCA CPRNT	/SAVE THE MQ
	TAD OVER
	SWP MUY		/THANKS TO REV. GEOFFREY CHASE
	    12		/FOR SUGGESTING AN EAE VERSION
	SWP
	DCA OVER
	TAD LORD
	SWP MUY
	    12
	SWP
	DCA LORD
	TAD HORD
	SWP MUY
	    12
	SWP
	DCA HORD
	TAD CPRNT	/RESTORE MQ
	SWP		/AC=OVERFLOW
	JMP I XTEN	/EXECUTION TIME = 60 MICROSECONDS
/////

MULT2,	0		/MULTIPLY FLAC BY 2 - 'SHIFTL'
	TAD OVER
	CLL RAL
	DCA OVER
	TAD LORD
	RAL
	DCA LORD
	TAD HORD
	RAL
	DCA HORD
	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
/CHARACTER INPUT/OUTPUT ROUTINES:   'READC' AND 'PRINTC'

/THE INPUT ROUTINE MAY ALSO BE USED TO ECHO A CHARACTER.

CHIN,	0		/INPUT A CHARACTER
	CDF P
	SNA		/'ECHOC' IF AC#0
	JMS I INDEV	/'READC' IF AC=0
	DCA CHAR
	SORTJ		/TAKE CARE OF SPECIAL CHARACTERS
	    ECHOLST-1
	    ECHOGO-ECHOLST
	JMP IECHO
	TAD INDEV	/ONLY ECHO FF TO A FILE
	SPA CLA
IECHO,	PRINTC		/'ZERO' IF NOT ECHOING
	JMP I CHIN
/////

CHOUT,	0		/OUTPUT A CHARACTER - 'PRINTC'
	SNA		/USE AC IF NON-ZERO
	TAD CHAR	/OTHERWISE USE CHAR
	TAD MCR
	CIF L
	JMP TAB		/ADJUST TAB COUNTER
CROUT,	TAD CCR
	JMS I OUTDEV	/CARRIAGE RETURNS
	TAD CLF
	JMS I OUTDEV	/NORMAL RETURNS
	JMP I CHOUT
/////

/CALLS TO AND FROM THE TAB ROUTINES IN FIELD 0:

TABX,	PUSHJ		/EVALUATE THE COLUMN NO.
	    EVAL-3
	FIXIT
	CIF L
	JMP ZER+1	/SAME PAGE, FIELD 0

SKPX,	JMS CHIN	/NEGATIVE COL. NO.
	CIF L
	JMP NEG+2	/RETURN TO LOWER FIELD
/////

FILIN,	ICHAR0		/FILE INPUT
ECODEV,	XOUTL		/DEFAULT OUTPUT
/FILE INPUT/OUTPUT ROUTINES:

ICHAR,  0               /FILE INPUT VIA (INDEV)
        CDI L
        JMP I FILIN     /CALL LOWER FIELD
        JMP I ICHAR

FLEN,   CLA IAC         /CHECK THE FILE LENGTH
        AND EXP         /0=OUTPUT, 1=INPUT
        CLL RTL         /*4
        TAD (XLEN
        DCA CPRNT
        JMP CPRNT+2     /OFF TO THE LOWER FIELD

OCHAR,  0               /FILE OUTPUT VIA (OUTDEV)
        CDI L
        JMS I (OCHAR0
        JMS I ECODEV    /ECHO RETURN
        JMP I OCHAR     /NO-ECHO RETURN

EOF,    0               /TRAPS ATTEMPT TO READ BEYOND
        TAD (XI33       /THE 'END-OF-FILE' CHARACTER
        DCA INDEV       /RESETS POINTERS TO THE TTY:
        TAD ECODEV
        DCA OUTDEV
        TAD CPRNT+1     /AND TURNS ON THE ECHO, TOO
        DCA IECHO
        TAD P337        /RETURN A '_' TO CLEAR THE '^Z'
        JMP I EOF       /'EOF' IS ALSO USED BY 'RECOVR'

CPRNT,  0               /'PRINTC' FOR DOWN BELOW
        PRINTC
        CDI L
        JMP I CPRNT

FBLK,   CDF L           /READ THE INPUT BLOCK NUMBER
        TAD I ATSW      /SAME PLACE!
        FL0ATR

FIND,   FIXIT           /CHARACTER SEARCH FUNCTION
        DCA I TESTC&177 /SAVE IN 'CTEST'
        JMS I INDEV     /READ A CHARACTER
        DCA CHAR
        SORTJ           /CHECK FOR EOF, MATCH
            C232-1
            FINISH-CTEST
        TAD CHAR        /AND ECHO AS DIRECTED
        ECHOC
        JMP FIND+2      /EOF->0, MATCH->CHAR

        PAGE
