/FLOATING POINT INPUT/OUTPUT ROUTINES:
/ 8NFIO.PA
/ FOR PDP8I OR PDP12 WITHOUT EAE
/ BASED ON 8XFIO.PA  NEW NON-EAE EMULATION 2025-10
/ BY BILL CATTEY, CHATGPT, AND CLAUDE.
/ DVI EMULATION A FURTHER REFINEMENT OF DECUS 8-436.

/===============================================================
/ NON-EAE EMULATION SUPPORT FOR U/W FOCAL 4E
/ TARGET RANGE: 13200-14177
/---------------------------------------------------------------
/ THIS MODULE HOLDS LONGER NON-EAE ROUTINES SO 8NFPP/8NFIO
/ CAN REMAIN FOOTPRINT-IDENTICAL TO THE ORIGINAL 8X MODULES.
/
/ THE EMULATION IS HERE IN THE FIO MODULE TO STAY COMPATIBLE
/ WITH THE LEGACY LAYOUT OF U/W FOCAL V4E OF 1978
/ AS BEST WE COULD FIND IT.
/ 
/ CURRENTLY IMPLEMENTED EMULATIONS:
/   MUY - MULTIPLY (AC × MQ → 24-BIT PRODUCT)
/   DVI - DIVIDE (MQ:AC ÷ OPERAND → QUOTIENT/REMAINDER)
/   SWP - SWAP AC ↔ MQ (VIA PAGE-ZERO JUMP TABLE)
/---------------------------------------------------------------
/ NOTES:
/   MQL IS REDEFINED INLINE AS "DCA SAVMQ"
/   ALL OTHER EAE OPS (MQA, MQR, ACL, CAM, SCA, ETC.)
/   WERE VERIFIED AS UNUSED IN 8XFPP/8XFIO.
/===============================================================

/ THIS MODULE INCORPORATES TWO LEVELS SELF-TEST LOGIC
/ 
/ DEFINE "EMTEST=1" IF YOU WANT A POST-HOC 
/ REPEAT EVERY EMULATION WITH THE EAE AND HALT
/ ON ANY DISCREPENCY.
/
/ THERE IS ALSO A STAND-ALONE TEST MODE.
/ WHEN 8NFIO IS ASSEMBLED WITHOUT U/W FOCAL,
/ THE VIRTUAL MQ SAVMQ STORED IN 10010 ISN'T DEFINED.
/ WE DETECT THAT AND DEFINE SATEST=1.
/ 
/ SATEST IS A SHORT PROGRAM THAT PERFORMS
/ TESTS RECORDED IN THE TABLE APTLY NAMED
/ "TABLE".  HERE AGAIN, THE EMULATION AND
/ THE EAE PERFORM BOTH TESTS AND HALTS
/ ON ANY DISCREPANCY.

/---------------------------------------------------------------
/ PAGE-ZERO “INSTRUCTION” VECTORS.  APPENDING TO THOSE DEFINED
/ IN 16KCPR.PA IN SPACE LEFT FOR "FOR SOFTWARE MULTIPLY"

/ DEFINING SATEST ENABLES STAND ALONE TESTING
/ AUTO-DETECT BY NO SAVMQ.

IFNDEF SAVMQ <
        *10
SAVMQ,  0

SATEST=1

IFNDEF EMTEST <
EMTEST=1	/ WE USE EMTEST STAND ALONE
>
>

IFNDEF SATEST <XLIST>
IFDEF SATEST <
/================================================================
/ PAL-8 TEST HARNESS — EAE vs EMULATION (MODE A)
/ 8 TEST CASES, HALT AFTER EACH SUBTEST
/ Inspect AC & MQ (hardware) vs AC & SAVMQ (emulation) at each HLT
/================================================================

/ Combined instructions

L0001=CLL CLA IAC
L0002=CLL CLA CML RTL
L0003=CLL CLA CML IAC RAL
L0006=CLL CLA CML IAC RTL
L2000=CLL CLA CML RTR

/EAE INSTRUCTIONS TO BE EMULATED

	MUY=7405
	DVI=7407
	MQL=7421

        *0200             / origin for harness (pick a safe page

/ TABLE OF TESTS:
/ EMUOP, OPERAND, MQ, AC

START, 	CLA CLL
	TAD TSTART
	DCA TABLEP
	DCA TNUM
REP,	TAD I TABLEP
	SNA
	HLT
	DCA EMUOP
	ISZ TABLEP
	TAD I TABLEP
	DCA EMUOP+1
	ISZ TABLEP
	TAD I TABLEP
	DCA SAVMQ
	ISZ TABLEP
	TAD I TABLEP
EMUOP,	0
	0
	ISZ TABLEP
	ISZ TNUM
	CLA CLL
	JMP REP

TABLEP,	0
TNUM,	0

TSTART,	TABLE

/ EM: OP; MQ; AC. SWP: AC and MQ swap

PAGE

TABLE,	EMMUY; 5; 3; 0	/ T0: 3 * 5; AC=0 MQ=17
	EMMUY; 12; 0; 3	/ T1: 0 * 12 + 3: AC=0 MQ=3
	EMMUY; 2; 7777; 0  / T2: 7777 * 2: AC=1 MQ=7776
	EMMUY; 7; 6; 0	/ T3: 6 * 7: AC=0 MQ=52
	EMDVI; 3; 2000; 1  / T4: 12000 / 3: AC=2 MQ=3252
	EMDVI; 4; 14; 0	/ T5: 14 / 4: AC=2 MQ=3
	EMDVI; 400; 0; 2000 /T6: 20000000 / 400:AC=2000;MQ=1;L=1
	EMDVI; 4; 12; 0	/ T7: 12 / 4: AC=2 MQ=2
	EMDVI; 6; 5; 0	/ T10: 6 /5: AC=5 MQ=0
	SWPMUY; 0; 0; 3146 / T11: 0 * 3146 + 0 = 0 NO ADD
	SWPMUY; 0; 1000; 3146 / T12: 0 * 3146 + 1000 AC=1147 MQ=1000
	SWPMUY; 6316; 4000; 2400 / T13: 6316 * 2400 + 4000 AC=2000 MQ=7000
	EMMUY; 0; 0; 3 / T14 0 * 0 + 3 AC=0 MQ=3
	EMMUY; 3110; 2400; 0 / T 15 3110 * 2400 AC=766 MQ=0
	EMMUY; 6650; 2400; 0 / T 16 6650 * 2400 AC=2104 MQ=4000
	SWPMUY; 3000; 4000; 3147 /T 17: 3000 * 3147 + 4000: AC=1147 MQ=1000
	SWPMUY; 3000; 1000; 3146 /T 20 3000 * 3146 + 1000 AC=1146 MQ=3000
	SWPMUY; 6316; 7000; 2400 	/ T 21 6316 * 2400 + 7000 AC=2001 MQ=2000
	EMDVI; 6000; 0; 2400 	/T 22 24000000 / 6000 AC=4000 MQ=3252
	EMDVI; 6000; 0; 2200       /T 23 22000000 / 6000 AC=0 MQ=3000
	EMDVI; 5000; 0; 0	/T24 0 / 6000 AC=0 MQ=0 ZERO DIVIDEND IS NOT OVERFLOW.
	0

/ END OF HARNESS

>
IFNDEF SATEST <XLIST>

/FLOATING POINT INPUT/OUTPUT ROUTINES:
/ 8NFIO.PA
/ FOR PDP8I OR PDP12 WITHOUT EAE
/ BASED ON 8XFIO.PA  NEW NON-EAE EMULATION 2025-09
/ BY BILL CATTEY AND CHATGPT

/===============================================================
/ NON-EAE EMULATION SUPPORT FOR U/W FOCAL 4E
/ TARGET RANGE: 13200-14177
/---------------------------------------------------------------
/ THIS MODULE HOLDS LONGER NON-EAE ROUTINES SO 8NFPP/8NFIO
/ CAN REMAIN FOOTPRINT-IDENTICAL TO THE ORIGINAL 8X MODULES.
/
/ THE EMULATION IS HERE IN THE FIO MODULE TO STAY COMPATIBLE
/ WITH THE LEGACY LAYOUT OF U/W FOCAL V4E OF 1978
/ AS BEST WE COULD FIND IT.
/ 
/ CURRENTLY IMPLEMENTED EMULATIONS:
/   MUY - MULTIPLY (AC × MQ → 24-BIT PRODUCT)
/   DVI - DIVIDE (MQ:AC ÷ OPERAND → QUOTIENT/REMAINDER)
/   SWP - SWAP AC ↔ MQ (VIA PAGE-ZERO JUMP TABLE)
/---------------------------------------------------------------
/ NOTES:
/   MQL IS REDEFINED INLINE AS "DCA SAVMQ"
/   ALL OTHER EAE OPS (MQA, MQR, ACL, CAM, SCA, ETC.)
/   WERE VERIFIED AS UNUSED IN 8XFPP/8XFIO.
/===============================================================

/---------------------------------------------------------------
/ PAGE-ZERO “INSTRUCTION” VECTORS.  APPENDING TO THOSE DEFINED
/ IN 16KCPR.PA IN SPACE LEFT FOR "FOR SOFTWARE MULTIPLY"

IFDEF EMTEST <

/ IF WE HAVE EMTEST, AND ARE INSIDE U/W FOCAL
/ WE NEED TO DEFINE THE EAE OPS FOR TESTING.
/ THEY NORMALLY DONT GET DEFINED IN NON-EAE U/W FOCAL

IFNDEF MUY <
	MUY=7405
	DVI=7407
	MQL=7421
>

IFNDEF SATEST <
	*PRODUCT-2	/ EAT 2ND FROM LAST LOC FOR AUTO TEST
>

IFDEF SATEST <
	*100
>

CMPEAE= JMS I .
	EAECMP
>

IFNDEF SATEST <
	*PRODUCT-1	/ EAT LAST PATCH LOC
>

IFDEF SATEST <
	*101
>

EMSWP= JMS I .		/ EMULATE EAE SWP
	SWPEM

IFNDEF SATEST <
	*GINC+1		/ CONSUME ALL USER CONSTANTS
>

EMMUY= JMS I .		/ EMULATE EAE MUY
	MUYEM
MQLMUY= JMS I .	/ EMULATE EAE MQL MUY
	MUYMQL
SWPMUY= JMS I .	/ EMULATE EAE SWP MUY
	MUYSWP
EMDVI= JMS I .		/ EMULATE EAE DVI
	DVIEM
MQLDVI= JMS I .	/ EMULATE EAE DVI
	DVIMQL

/---------------------------------------------------------------


/==========================================================
/ EAE MODE A EMULATORS FOR U/W FOCAL 4E (PAL-8)
/ 5 ROUTINES: SWPEM, MUYEM, MUYMQL, DVIEM, DVIMQL
/ TEMP LOCS: EMOP..EMAC

/ SAVMQ USED AS SOFTWARE MQ
/==========================================================

IFNDEF SATEST <
	*14500
>

IFDEF SATEST <
	*700
>

/ ONE COMBINED INSTRUCTION NOT DEFINED IN UWF

L0002=CLL CLA CML RTL
L4000=CLL CLA CML RAR
L7777=CLL CLA CMA

IFNDEF SATEST <
	*13200
>

IFDEF SATEST <
	*1000
>

/--------------------- SWPEM --------------------------------
/ SWP EMULATOR (SINGLE WORD ENTRY)
/ SWP: SWAP AC and SAVMQ
SWPEM, 0
	DCA RMDPHI	/ SAVE AC to SWPET1
	TAD SAVMQ
	DCA EMAC	/ SAVE OLD MQ to SWPET2
	TAD RMDPHI
	DCA SAVMQ	/ NEW MQ := OLD AC
	TAD EMAC
	JMP I SWPEM	/ RETURN (AC := OLD MQ)

MUYSWP, 0		/ RELIES ON USE OF EMAC TO DO THE SWAP
	DCA EMAC		/ SAVE AC
	TAD MUYSWP	/ FIX RETURN ADDRESS
	DCA MUYEM
	TAD EMAC		/ RESTORE AC AND SWAP
	EMSWP		/ CALL OUT TO DISTANT EMSWP
	JMP MUYEM+1	/ JUMP INTO MUYEM

/============================================================
/ MUY EMULATION FAMILY (MODE A)
/  MUYEM  - MUY (PLAIN)   : MULTIPLICAND IS SAVMQ (MQ EMULATED)
/      IF AC NON-ZERO ON ENTRY, ADD IT TO PRODUCT
/  MUYMQL - MQL + MUY     : MULTIPLICAND IS AC (MQL STORES AC IN SAVMQ)
/  MULTIPLICAND IS IN NEXT WORD AFTER CALL
/  MUYCORE - COMMON KERNEL : 12-ITER SHIFT/ADD to 24-BIT PRODUCT
/  RESULTS: AC = HIGH 12 BITS, SAVMQ = LOW 12 BITS
/  TEMPS: MDCNT, EMOP, EMAC, AND RMDPHI,
/  ALGORITHM:  REUSE SAVMQ AS BOTH MULTIPLIER AND LO RESULT
/     INITIALIZATION: LINK IS CLEAR; MULTIPLIER IN MQ;
/         MDCNT -14; MULTIPLICAND IN EMOP; HI PROD IN RMDPHI
/      IF LSB OF PRODUCT IS 1 ADD EMOP TO SAVMQ
/  CONSTANTS: NEG14 -14 OCTAL FOR 12 WAY SHIFT
/============================================================

/---------------- MUYEM (PLAIN MUY) -------------------------
MUYEM,	0
	DCA EMAC	/ SAVE ORIGINAL AC to EMAC
	DCA RMDPHI	/ IN CASE WE DO FAST EXIT
	TAD MUYEM
	DCA MUYMQL
IFNDEF EMTEST <XLIST>
IFDEF EMTEST <
	TAD SAVMQ	/ PRESERVE MQ ACROSS QUICK EXIT
	MQL
>
IFNDEF EMTEST <XLIST>
	TAD SAVMQ	/ TEST MULTIPLIER (MQ EMULATED IN SAVMQ)
	SZA CLA		/ MUYMQL WILL FETCH SAVMQ WHEN NEEDED.
	JMP MUYMQL+3	/ IF NONZERO MULTIPLICAND, DO FETCH PATH
	JMP MPEXIT	/ IF ZERO, ADD TO MQ AND EXIT

/---------------- MUYMQL (MQL + MUY) -----------------------
MUYMQL, 0
	DCA SAVMQ	/ MOVE AC to SAVMQ (MQL EFFECT)
	DCA EMAC		/ MQL MUY CLEARS AC
	DCA RMDPHI		/ PRODUCT HIGH := 0
IFNDEF EMTEST <XLIST>
IFDEF EMTEST <		/ PRESERVE ORIGINAL SAVMQ
	TAD SAVMQ
	MQL
>
IFNDEF EMTEST <XLIST>
	TAD I MUYMQL	/ FETCH MULTIPLIER (LITERAL)
	SNA
	JMP EXMQ0	/ FAST EXIT IF MULTIPLIER = 0
	DCA EMOP		/ EMOP := MULTIPLIER NEVER CHANGES
	TAD NEG14
	DCA MDCNT		/ MDCNT := -14  (COUNT FOR 12 ITERATIONS)
MPLOOP, CLL
	TAD SAVMQ
	RAR		/ SHIFT MULTIPLIER RIGHT, LSB to LINK
	DCA SAVMQ
	SZL		/ IF LINK = 1 (LSB WAS 1) DO ADD
	TAD EMOP
	CLL		/ ADD MAY HAVE SIGNIFICANT CARRY
	TAD RMDPHI
	RAR		/ AND ROTATE IT
	/ PROD LO HAS MULTIPLIER RIGHT SHIFTED 
	/ PROD HI IS RIGHT SHIFTED
	/ MAYBE WITH MULTIPLICAND ADDED
	DCA RMDPHI
	/ IF HI SHIFTED A RIGHT BIT
	/ ADD IT TO HI BIT OF SAVMQ
	SZL
	L4000
	TAD SAVMQ
	DCA SAVMQ
	ISZ MDCNT
	JMP MPLOOP
/ --- ADD ORIGINAL AC (EMAC) INTO PRODUCT LOW, PROPAGATE CARRY ---
MPEXIT,	CLA CLL		/ LINK MIGHT HAVE BEEN SET ON ENTRY.
IFNDEF EMTEST <XLIST>
IFDEF EMTEST <
	TAD I MUYMQL	/ FAST EXIT NEEDS TO INITIALIZE
	DCA EMOP	/ OP FOR TESTING.
>
IFNDEF EMTEST <XLIST>
	TAD EMAC	/ GET SAVED AC
	TAD SAVMQ	/ ADD TO PRODUCT
	DCA SAVMQ	/ AND SAVE IT
	SZL
	IAC		/ IF ADDING TO SAVMQ OVERFLOWED
	TAD RMDPHI		/ PUT PRODUCT INTO AC
	ISZ MUYMQL
	CLL
IFNDEF EMTEST <XLIST>
IFDEF EMTEST <
	CMPEAE
>
IFNDEF EMTEST <XLIST>
MPRET,	JMP I MUYMQL	/ RETURN TO CALLER (MUYEM OR MUYMQL)
EXMQ0,	DCA SAVMQ
	JMP MPEXIT

/---------------- TEMP & CONSTS -----------------------------
MDCNT,	0	/ COUNTER
EMOP,	0	/ OPERAND -- MULTIPLIER OR DIVISOR
RMDPHI,	0	/ PROD HIGH OR DIVIDEND HI
EMAC,	0	/ SAVE OF AC AT ENTRY
MINDIV,	0	/ NEGATED DIVISOR
NEG14,	-14

/=============================================================
/ DVIEM - MODE A DVI NONRESTORING UNSIGNED DIVIDE
/ ENTRY: EMDVI, NEXT WORD = DIVISOR LITERAL
/ INPUT: AC = HIGH 12 BITS OF DIVIDEND
/	SAVMQ = LOW 12 BITS OF DIVIDEND
/ OUTPUT: NORMAL: AC = REMAINDER, SAVMQ = QUOTIENT, LINK = 0
/	OVERFLOW: AC UNCHANGED, SAVMQ = (SAVMQ LEFT SHIFT 1)+1, LINK=1
/=============================================================

/ EMULATE COMBINATION OF MQL DVI
/ WHICH FILLS SAVMQ WITH AC AND CLEARS AC

DVIMQL, 0
	DCA SAVMQ
	TAD DVIMQL
	DCA DVIEM
	SKP

/ REGULAR DVI 
DVIEM,	0
	/ SAVE DIVIDEND
	DCA RMDPHI	/ RMDPHI := AC

	/ FETCH DIVISOR
	TAD I DVIEM
	CIA
	DCA MINDIV
IFNDEF EMTEST <XLIST>
IFDEF EMTEST <
	TAD SAVMQ	/ PRESERVE ORIGINAL SAVMQ
	MQL
	TAD RMDPHI		/ PRESERVE AC ORIGINALLY CALLED
	DCA EMAC
	TAD I DVIEM
	DCA EMOP	
>
IFNDEF EMTEST <XLIST>	
	ISZ DVIEM

	/ TEST FOR OVERFLOW: IF AC GREATER OR EQUAL TO EMOP
	CLL
	TAD MINDIV
	TAD RMDPHI	/ AC = EMOP - RMDPHI
	SNL CLA
	JMP DVNORM

/---------------- OVERFLOW CASE ------------------------------
DVIOVF,	TAD SAVMQ	/ MQ = (MQ  LEFT SHIFT  1) + 1
	RAL
	DCA SAVMQ
	TAD RMDPHI	/ RESTORE AC = ORIGINAL HIGH HALF
	STL	/ SET LINK
IFNDEF EMTEST <XLIST>
IFDEF EMTEST <
	CMPEAE
>
IFNDEF EMTEST <XLIST>
	JMP I DVIEM

/ DIVISION ALGORITHM FROM DECUS 8-436
/ WITH A BIT MORE OPTIMIZATION

/---------------- NORMAL DIVISION ----------------------------

DVNORM,	L7777
	TAD NEG14
	DCA MDCNT	/ 13 ITERATIONS 15 OCTAL

DVIS1,  CLA CLL
        SKP
DVIS2,  DCA RMDPHI
        TAD SAVMQ
        RAL
        DCA SAVMQ
        TAD RMDPHI
	ISZ MDCNT
        SKP
        JMP DVDONE
        RAL
        DCA RMDPHI
        TAD RMDPHI
        TAD MINDIV
        SNL
        JMP DVIS1
        JMP DVIS2	/ COMMIT THE SUBTRACTION	
DVDONE, CLL
IFNDEF EMTEST <XLIST>
IFDEF EMTEST <
	CMPEAE
>
IFNDEF EMTEST <XLIST>
        JMP I DVIEM

IFNDEF EMTEST <XLIST>
IFDEF EMTEST <

PAGE

/ IN-LINE EMULATION TESTING 
/ HALT IF THE EAE ACTION IS DIFFERENT
/ MQ SET TO PRE EMULATION SAVMQ BY CALLER
/ FROM THE EMULATED ACTION

EAECMP,	0
	DCA ACEM	/ SAVE AC EMULATION RETURN
	RAR
	DCA LINKEM	/ SAVE LINK EMULATION RETURN
	TAD I EMOPPT	/ FETCH EMOP (MULTIPLICAND/DIVISOR)
	DCA EMOPCP
	TAD I EMACPT	/ FETCH EMAC (ORIGINAL AC)
	DCA EMACP
	MQA		/ FETCH MQ FROM BEFORE ACTION
	DCA MQSAVE
	TAD MULPTR	/ CALLED FROM MULTIPLY?
	CIA
	TAD EAECMP
	SZA CLA		/ OR ONE OF THE DIV CALLS
	L0002		/ DVI = MUL + 2
	TAD KMUY
	DCA TESTOP
DOTEST,	TAD EMOPCP
	DCA EAEARG
	TAD MQSAVE
	MQL
	TAD EMACP
TESTOP,	0
EAEARG,	0		/ THE OPERATION TO TEST
	DCA ACREPL
	RAR		/ FIRST TEST THE LINK REPLY		
	TAD LINKEM
	SZA CLA
	HLT		/ LINK DOESN'T MATCH. HALT
	TAD ACREPL
	CIA
	TAD ACEM
	SZA CLA
	HLT		/ AC DOESN'T MATCH HALT
	MQA		/ COMPARE EAE MQ WITH EMULATION
	CIA
	TAD SAVMQ
	SZA CLA
	HLT
	TAD LINKEM
	RAL		/ RESTORE LINK REPLY
	TAD ACEM	/ RESTORE AC REPLY
	JMP I EAECMP	/ TAKE IT ON HOME!	

/ ARGS TO THE EMULATION 
/ HERE IN ORDER OF PLACEMENT IN THE TEST TABLE
/ OP, MQ, AC

EMOPCP,	0		/ COPY OF EMOP FROM EMULATION
MQSAVE,	0		/ COPY OF PRESERVED MQ BEFORE EMULATION
EMACP,	0		/ COPY OF EMAC FROM EMULATION

/ RESULTS TO COMPARE:
/ AC FROM EMULATION THEN AC FROM EAE
/ LINK FROM EMULATION THEN LINKL FROM EAE
/ WE COMPARE SAVEMQ WITH MQ REGISTER.

ACEM,	0		/ COPY OF AC REPLY FROM EMULATION
ACREPL,	0		/ AC REPLY FROM EAE
LINKEM,	0		/ COPY OF LINK REPLY FROM EMULATION
LREPL,	0		/ LINK REPLY FROM EAE

/ POINTERS TO STUFF IN THE EMULATION

EMOPPT,	EMOP
EMACPT,	EMAC
MULPTR, MPRET	/ WHERE WE WOULD REURN TO IF MPY
KMUY, 	MUY


>
IFNDEF EMTEST <XLIST>

IFDEF SATEST <XLIST>
IFNDEF SATEST <
/ CODE IMPORTED FROM 8XFIO.PA

	*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	/"+" to 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 LESS THAN 0 ?
	STA STL		/NO, TAKE D = F-1
	TAD T3		/COMPARE DECIMAL EXPONENT
	SNL SMA SZA	/ E GREATER THAN 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 LESS THAN AC LESS THAN 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 GREATER THAN F ?
	JMP FLOUT+2	/YES: USE FLOATING FORMAT
	TAD T2		/ F-D-E (OR 0 IF E GREATER THAN 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 LESS THAN 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
IFDEF SATEST <XLIST>
XLIST;	NOPUNCH;  PAGE 30;  ENPUNCH;  XLIST
IFDEF SATEST <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 to -3
	TAD M5
	JMS OUTDG	/PRINT SIGN
	TAD T3
	SPA
	CIA
	MQLDVI		/DIVIDE BY ONE HUNDRED
	    144
	DCA T2
	EMSWP		/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
	MQLDVI		/DIVIDE BY TEN
	    12
	DCA T2
	EMSWP		/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
	SWPMUY
	0
	TAD EX1
	DCA SAVMQ		/DISCARD FOUR
	RAL
	DCA EX1		/INITIALIZE TWO

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

	TAD LORD
	DCA .+3
	TAD AC1H	/B*D
	SWPMUY
	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)
	EMSWP		/AND ADD IN C(AC)
	DCA CPRNT	/SAVE THE MQ
	TAD OVER
	SWPMUY		/THANKS TO REV. GEOFFREY CHASE
	    12		/FOR SUGGESTING AN EAE VERSION
	EMSWP
	DCA OVER
	TAD LORD
	SWPMUY
	    12
	EMSWP
	DCA LORD
	TAD HORD
	SWPMUY
	    12
	EMSWP
	DCA HORD
	TAD CPRNT	/RESTORE MQ
	EMSWP		/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 to 0, MATCH to CHAR

        PAGE
>
IFDEF SATEST <XLIST>
