
/LOAD ALGOL INTERPRETIVE CODE TAPES
/MAIN LIST FROM 200-2777
/FORWARD REF LIST FROM 3000-3177

FIELD 0

T1=1
T2=2
T3=3
T4=4
T5=5
SP1=10

*20;	0	/NO SYSTEM OVERLAY (YET)
	/ NON-ZERO FOR SYS (=40 UNDER OS8)
	/ BITS 8-11 USED TO SET FIELD IF NON ZERO.
	/ FIELD USED - VALUE-1
	/BIT 0=1 IF OUTPUT DEVICE FILE STRUCTURED
*21;PSYS,	7600	/ EXIT TO SYS (CAN BE PATCHED)
*30
DEV,	0
DSWIT,	0
CHAR,	0
CL,	0
RESULT, 0
VALUE,	0
SVRES,	0
EX1,	0
AC1H,	0
AC1L,	0
SIGN,	0
EXP,	0
HORD,	0
LORD,	0
X,	0
SUDOMQ, 0

INDLST,	ERR; TTI; HSI; ERR; ERR; ERR; ERR; ERR
ODLST,	ERR; TTO; HSO; ERR; ERR; ERR; ERR; ERR
ADI,	ERR	/FILE OPENING ROUTINE

INDEV,	0; CLA; TAD XINL; TAD DEV
	DCA .+1; HLT; JMP I INDEV
XINL,	JMS I INDLST
OUTDEV,	0; DCA T5; TAD XOUTL; TAD DEV
	DCA .+2; TAD T5; HLT; CLA; JMP I OUTDEV
XOUTL,	JMS I ODLST

TTI,	0; KSF; JMP .-1; KRB; JMS TTO; JMP I TTI
TTO,	0; TSF; JMP .-1; TLS; JMP I TTO
HSI,	0; RSF; JMP .-1; RRB RFC; JMP I HSI
HSO,	0; PSF; JMP .-1; PLS; JMP I HSO

ERR,	0; JMP I .+1; ERMES

MESS,	0; TAD I MESS; ISZ MESS; SNA; JMP I MESS
	JMS TTO; CLA; JMP MESS+1

FLAC=EXP
ERR0=ERR
*200
	JMP LOAD
*3200
LOAD,	TLS; PLS; KCC; JMS MESS
	"B;"I;"N;"A;"L;"G;"O;"L;" ;0
	TAD 20; SNA CLA; JMP NOSYS
	IAC; JMS I ADI	/OPEN FILES ON MASS STORAGE
	TAD (3; DCA INDN; TAD (3; DCA OUTDN
	JMP CLEAR
NOSYS,	JMS MESS; "I; "N; "-; 0; JMS TTI; TAD (-260; DCA INDN
	JMS MESS; " ;"O; "U; "T; "-; 0
	JMS TTI; TAD (-260; DCA OUTDN
CLEAR,	RFC; TAD INDN; DCA DEV
	TAD (200-2777; DCA MLSIZE
	TAD (177; DCA SP1; TAD (177-3177; DCA CL
	DCA I SP1; ISZ CL; JMP .-2	/CLEAR LISTS
	TAD (202; DCA CL; JMS FDIG	/SKIP TO *1
LOOP,	CLA CMA; DCA SIGN
	JMS IN; JMS DIGTST; SKP; JMP CONST
	TAD (-"-; SNA; JMP NCONST
	TAD ("--";; SNA; JMP LOOP	/IGNORE MULTIPLE :
	TAD (";-"*; SNA; JMP END
	TAD ("*-"L; SNA; JMP LABEL
	TAD ("L-"F; SNA; JMP FCON; JMS ERR
END,	CLA CMA; TAD CL; DCA CL /ADDRESS OF FIXED SPACE
	CDF 10; TAD I CL; DCA I (176 /SAVE IT
	TAD CL; IAC; DCA I (175	/NEXT FREE SPACE
	TAD (JMP I 177; DCA I (201; CDF
	JMS MESS; 215;212;"E;"N;"D;"S;" ;0
	JMP PUNCH
INDN,	0
OUTDN,	0

*3400
PUNCH,	TAD CL; JMS OCTOUT; TAD OUTDN; DCA DEV
	CDF 10; TAD (614; DCA I (177
	TAD (CDF CIF 10; DCA I (200; CDF
/ NOW CHECK IF OPTION 0 - 7 USED FOR FIELD SETTING
	TAD 20; AND (17; TAD (-1; SMA
	JMP PUNCH2; CLA
	JMS MESS; 215;212; "F;"I;"E;"L;"D;"?; 0
	JMS TTI; TAD (-260; AND (7
PUNCH2,	CLL RTL; RAL; TAD (300; DCA T1 /FIELD SETTING
	TAD 20; SPA CLA; TAD (175; TAD (-200; DCA T2
PLOOP1,	TAD (200; JMS OUTDEV; ISZ T2; JMP PLOOP1
	TAD T1; JMS OUTDEV
	TAD (101; JMS OUTDEV; TAD (75; JMS OUTDEV /ORIGIN 175
	TAD (176; DCA SUM; TAD (174; DCA SP1
PLOOP2,	CDF 10; TAD I SP1; CDF; DCA EXP
	TAD EXP; CLL RTR; RTR; RTR
	AND (77; DCA T1; TAD T1; JMS OUTDEV
	TAD T1; TAD SUM; DCA SUM
	TAD EXP; AND (77; DCA T1
	TAD T1; JMS OUTDEV; TAD T1; TAD SUM; DCA SUM
	TAD SP1; CIA; TAD CL; SZA CLA; JMP PLOOP2
	TAD SUM; CLL RTR; RTR; RTR; AND (77; JMS OUTDEV
	TAD SUM; AND (77; JMS OUTDEV
	TAD 20; SPA CLA; TAD (175; TAD (-200; DCA T2
PLOOP3,	TAD (200; JMS OUTDEV; ISZ T2; JMP PLOOP3
	TAD 20; SNA CLA; HLT	/STOP IF NO SYSTEM
	TAD (232; JMS OUTDEV; JMP I PSYS /ELSE CLOSE O/P FILE
SUM,	0

*3600

MAXLOC,	7577	/CAN USE ALL OF F1
LABEL,	JMS IN; JMS DIGTST; JMS ERR
	DCA RESULT; JMS RCON; DCA CHAR; JMS CHKLNO	/LABEL NUMBER TO RESULT
	TAD CHAR; TAD (-",; SNA; JMP DECLAB
	TAD (",-"=; SNA; JMP DEFLAB
	TAD ("=-";; SZA; JMS ERR
STLAB,	JMS LOOKUP; JMP NOTDECL	/STORE LABEL. DECLARED?
	JMS STORE; JMP LOOP	/YES STORE IT
NOTDEC,	JMS STORE; CMA; TAD CL	/STORE LAST ADDRESS USED IN PROG
	DCA I T5	/AND THIS ADDRESS IN MAIN TABLE
	TAD RESULT; JMS SFWD	/SEE IF ITS IN FORWARD LIST
	JMP LOOP	/FINISHED IF ALREADY THERE
	JMS SFWD; SKP; JMS ERR	/ELSE LOOK FOR SLOT
	TAD RESULT; DCA I T1; JMP LOOP	/AND MAKE ENTRY
DECLAB,	TAD CL; DCA VALUE; JMP LABVAL	/VALUE IS CURRENT ADDRESS
DEFLAB,	TAD RESULT; DCA SVRES	/SAVE LABEL BEING DEFINED
	JMS IN; JMS DIGTST; JMP DEFL1	/ANOTHER LABEL?
	DCA RESULT; JMS RCON	/NO, READ CONSTANT
	CLA; TAD RESULT
DEFL2,	DCA VALUE; TAD SVRES; DCA RESULT	/RESTORE LABEL
	JMP LABVAL
DEFL1,	TAD PL; SZA CLA; JMS ERR	/CHECK FOR L
	DCA RESULT; JMS RCON; JMS CHKLNO	/READ DEFINING LABEL
	JMS LOOKUP; JMS ERR; JMP DEFL2	/CHECK DECLARED, VALUE IN AC
LABVAL,	JMS LOOKUP; SKP; JMS ERR	/FAIL IF ALREADY DECLARED
	DCA T4; DCA I T1	/SAVE ADDRESS LAST USE, CLEAR FREF ENTRY
	TAD VALUE; DCA I T5	/PUT VALUE IN MAIN TABLE
DFR,	TAD T4; SNA CLA; JMP LOOP	/FREFS TO FILL IN?
	CDF 10; TAD I T4; DCA T3	/YES, SAVE LINK
	TAD VALUE; DCA I T4; CDF	/REPLACE BY VALUE
	TAD T3; DCA T4; JMP DFR	/CHECK IF ANY MORE
PL,	-"L

STORE,	0
	CDF 10; DCA I CL; CDF; ISZ CL
	TAD CL; CIA; TAD MAXLOC; SNA CLA; JMS ERR; JMP I STORE

DIGTST, 0
	TAD (-260; SPA; JMP NOT1
	TAD (260-272; SMA; JMP NOT2
	TAD (272-260; ISZ DIGTST; JMP I DIGTST
NOT1,	TAD (260-272
NOT2,	TAD (272; JMP I DIGTST

FDIG,	0; JMS IN; JMS DIGTST; JMP .-2; JMP I FDIG

*4000

RCON,	0
	JMS IN; JMS DIGTST; JMP I RCON
	DCA IN; TAD RESULT; CLL RTL; TAD RESULT
	CLL RAL; TAD IN; DCA RESULT; JMP RCON+1

IN,	0
	JMS INDEV; TAD PM215; SNA; TAD (";-215
	TAD PM212; SNA; JMP IN+1
	TAD PM240; SNA; JMP IN+1
	TAD PM377; SNA; JMP IN+1
	TAD PM211; SNA; JMP IN+1
	TAD P211; SNA; JMP IN+1; JMP I IN
PM215,	-215
PM212,	215-212
PM240,	212-240
PM377,	240-377
PM211,	377-211
P211,	211

SFWD,	0	/SEARCH FORWARD LIST, LABEL NO. IN AC
	CIA; DCA T2; TAD (-200; DCA T3
	TAD (2777; DCA T1
SFWD1,	ISZ T1; TAD I T1; TAD T2
	SNA CLA; JMP I SFWD	/EXIT 1 IF FOUND, T1^ENTRY
	ISZ T3; JMP SFWD1	/IF NOT CHECK IF EXHAUSTED
	ISZ SFWD; JMP I SFWD	/AND EXIT 2 IF SO

LOOKUP,	0	/LOOKUP LABEL NO. IN RESULT, AC=0
	TAD RESULT; TAD (200; DCA T5	/POINT AT MAIN ENTRY
	TAD RESULT; JMS SFWD; JMP INFWD	/SEARCH FORWARD LIST
	TAD I T5; SZA; ISZ LOOKUP	/EXIT 2 IF DECLARED
	JMP I LOOKUP	/ELSE EXIT 1, NO PREVIOUS USE
INFWD,	TAD I T5; JMP I LOOKUP	/ADDRESS OF PREVIOUS USE

FCON,	JMS FINPUT; TAD DSWIT; SNA CLA; JMP FCON
	TAD FLAC; JMS STORE; TAD FLAC+1; JMS STORE
	TAD FLAC+2; JMS STORE
FC1,	JMS IN; TAD (-";; SZA CLA; JMP FC1; JMP LOOP
NCONST,	DCA SIGN
CONST,	DCA RESULT; JMS RCON; CLA; TAD RESULT
	ISZ SIGN; CIA; JMS STORE; JMP LOOP

DIX,	0; TAD 77; TAD (-ERR; SNA CLA; JMS ERR /IS DIX0 THERE?
	CLA IAC; JMS I 77; JMP I DIX /YES, DO IT

CHKLNO,	0; CLA; TAD RESULT; TAD MLSIZE; SZA SMA CLA; JMS ERR
	JMP I CHKLNO

MLSIZE,	0
/NEW FLOATING POINT ROUTINES. WRITTEN TO USE EAE, FOR NON-EAE
/MACHINES ADD INTEGER MULTIPLY AND DIVIDE AND SHIFT RIGHT LOGICAL.

*4200

FGET,	0; SNA; TAD I FGET; ISZ FGET; TAD M1; DCA 11
	TAD I 11; DCA EXP
	TAD I 11; DCA HORD
	TAD I 11; DCA LORD; JMP I FGET

GETOP,	0; TAD M1; DCA 11
	TAD I 11; DCA EX1
	TAD I 11; DCA AC1H
	TAD I 11; DCA AC1L; JMP I GETOP

FADD,	0; SNA; TAD I FADD; ISZ FADD
	JMS GETOP; JMS ADD; JMP I FADD

FMUL,	0; SNA; TAD I FMUL; ISZ FMUL; JMS GETOP
	JMS FMULT; JMP I FMUL

XORSGN,	0	/SET SIGN FOR MULTIPLY AND DIVIDE
	CLA CLL CML RAR; AND EXP; TAD EX1
	RAL; CLA RAR; DCA SIGN
	CLA CLL CMA RAR; AND EXP; DCA EXP
	CLA CLL CMA RAR; AND EX1; DCA EX1; JMP I XORSGN

FPUT,	0; SNA; TAD I FPUT; ISZ FPUT
	TAD M1; DCA 11
	TAD EXP; DCA I 11; TAD HORD; DCA I 11
	TAD LORD; DCA I 11; JMP I FPUT

FDIV,	0; SNA; TAD I FDIV; ISZ FDIV; JMS GETOP
	JMS DIV; JMP I FDIV

FINVD,	0; SNA; TAD I FINVD; DCA DIVOP; ISZ FINVD
	JMS FPUT; EX1	/FLAC TO OPERAND
	JMS FGET
DIVOP,	0	/OPERAND TO FLAC
	JMS DIV; JMP I FINVD

FINVS,	0; SNA; TAD I FINVS; ISZ FINVS; JMS GETOP
	CLA CLL CML RAR; TAD EXP; DCA EXP /NEGATE FLAC
	JMS ADD; JMP I FINVS

FSUB,	0; SNA; TAD I FSUB; ISZ FSUB; JMS GETOP
	CLA CLL CML RAR; TAD EX1; DCA EX1	/NEGATE OPERAND
	JMS ADD; JMP I FSUB

SQUARE,	0; JMS FMUL; EXP; JMP I SQUARE

FLOAT, 0; CLA CLL CML RAR; AND EXP; DCA SIGN
	TAD EXP; SPA; CML CIA
	DCA HORD; DCA LORD
	TAD FLO2; TAD SIGN; DCA EXP /ADD SIGN BIT
	JMS NORM; JMP I FLOAT
FLO2,	2014

M1,	-1
*4400

ADD,	0
	CLA CLL CML RAR; AND EXP; TAD EX1
	SPA CLA; JMP SUB	/SUBTRACT IF SIGNS DIFFER
	RAR; DCA SIGN	/ELSE RESULT SAME SIGN
	JMS ALIGN; JMP I ADD
	TAD LORD; TAD AC1L; DCA LORD
	RAL; TAD HORD; TAD AC1H
	SZL; JMP ADDOV	/MUST SHIFT IF OVERFLOWED
	DCA HORD; JMP I ADD /IF NOT MUST BE NORMALISED
ADDOV,	RAR; DCA HORD; TAD LORD; RAR; DCA LORD
	ISZ EXP; JMP I ADD; JMS ERR0
SUB,	CLA CLL CML RAR; AND EXP; DCA SIGN
	JMS ALIGN; JMP I ADD
	TAD AC1L; CIA; TAD LORD; DCA LORD
	TAD AC1H; CMA; SZL; CLL IAC
	TAD HORD; DCA HORD
	SZL; JMP SUBOK	/DID WE SUBTRACT SMALLER?
	TAD LORD; CIA; DCA LORD	/NO SO NEGATE RESULT
	TAD HORD; CMA; SZL; IAC; DCA HORD
	CLA CLL CML RAR; TAD EXP; DCA EXP
SUBOK,	JMS NORM; JMP I ADD


NORM,	0
	CLA CLL CML RAR; AND EXP; DCA SIGN
	CLA CLL CMA RAR; AND EXP; DCA EXP
	TAD HORD; SZA CLA; JMP HORNZ
	TAD LORD; SZA; JMP LORNZ
RZERO,	DCA EXP; JMP I NORM
LORNZ,	DCA HORD; DCA LORD	/SHIFT 12 PLACES
	TAD (-14; TAD EXP; SPA; JMP UFLO
	DCA EXP
HORNZ,	TAD HORD; SPA CLA; JMP ENORM
	TAD LORD; CLL RAL; DCA LORD
	TAD HORD; RAL; DCA HORD
	CMA; TAD EXP; SPA; JMP UFLO
	DCA EXP; JMP HORNZ
ENORM,	TAD EXP; TAD SIGN; DCA EXP; JMP I NORM
UFLO,	CLA; TAD SIGN; DCA EXP
	CLA CLL CML RAR; DCA HORD; DCA LORD /MAKE SMALLEST NO.
	JMP I NORM

MQLAUY, 0 /SIMULATE MQL MQA MUY
	DCA MQL2; TAD SUDOMQ; DCA MQL1
	TAD MQL2; DCA SUDOMQ
	TAD I MQLAUY; ISZ MQLAUY; DCA MQL3
	TAD MQL1; JMS PSDMUY
MQL3,	0; JMP I MQLAUY
MQL1,	0
MQL2,	0

*4600
DIV,	0; TAD HORD; SNA CLA; JMP I DIV /DIVIDEND ZERO
	TAD AC1H; SNA CLA; JMS ERR0	/ERROR DIVISOR ZERO
	JMS XORSGN	/SET SIGN AND REMOVE SIGN BITS
	TAD EX1; CIA; TAD EXP; TAD (2001 /SUBTRACT
	SPA; JMS ERR0; TAD SIGN; DCA EXP /FAIL OVER/UNDERFLOW
	DCA X; TAD AC1L; DCA DV3; TAD AC1H; DCA DV4
	TAD DV4; DCA DV2
	TAD HORD; CLL RAR; DCA HORD
	TAD LORD; RAR; DCA SUDOMQ; TAD HORD; JMS PSDDVI
DV2,	0; DCA DV2; TAD SUDOMQ; DCA HORD; JMS PSDMUY
DV3,	0; CLL CIA; TAD DV2; SNA; JMP DV5
	SNL; JMP DV6; DCA DV3
	CMA; DCA X; TAD SUDOMQ; CLL CIA; DCA SUDOMQ
	SNL; CMA; TAD DV3; JMS PSDDVI
DV4,	0; CLA; TAD SUDOMQ; CLL CML; ISZ X; CLL CIA
DV5,	DCA LORD; SNL; CMA; TAD HORD; SMA; JMP DV7
	DCA HORD; JMP I DIV
DV6,	CIA; DCA DV2; TAD DV4; CLL CIA; TAD DV2
	SNL; JMP .+5; DCA DV2; CMA; TAD HORD; DCA HORD
	CLA; TAD DV2; SZA; JMP DV4-1; JMP DV5-1
DV7,	DCA HORD; TAD LORD; CLL RAL; DCA LORD
	TAD HORD; RAL; DCA HORD /SHIFT RESULT LEFT IF NOT NORMALISED
	CMA; TAD EXP; DCA EXP; JMP I DIV

PSDMUY,	0; DCA MUYAC; TAD (-15; DCA MUYC
	TAD I PSDMUY; DCA MUYOP; ISZ PSDMUY
	CLL; JMP MUYST
MUYL,	SNL; JMP .+3
	CLL; TAD MUYOP; RAR; DCA MUYAC
MUYST,	TAD SUDOMQ; RAR; DCA SUDOMQ
	TAD MUYAC; ISZ MUYC; JMP MUYL; CLL; JMP I PSDMUY
MUYOP,	0
MUYAC,	0
MUYC,	0

*5000

ALIGN,	0
	TAD AC1H; SNA CLA; JMP I ALIGN	/ZERO OPERAND
	TAD HORD; SZA CLA; JMP NOTZ	/ZERO FLAC
RESOP,	CLA CLL; TAD EX1; DCA EXP
	TAD AC1H; DCA HORD
	TAD AC1L; DCA LORD; JMP I ALIGN	/ADDITION DONE
NOTZ,	CLA CLL CMA RAR; AND EXP; DCA EXP
	CLA CLL CMA RAR; AND EX1; CIA
	TAD EXP; SNA; JMP DONE
	SMA; JMP SHOP	/JMP IF FLAC LARGER
	TAD (27; SPA; JMP RESOP /TOO MUCH SHIFT OF FLAC
	TAD (-27; DCA SHFT
	CLA CLL CMA RAR; AND EX1; DCA EXP /TRANSFER EXPONENT
	TAD LORD; DCA SUDOMQ; TAD HORD; JMS DLSR
	DCA HORD; TAD SUDOMQ; DCA LORD
DONE,	ISZ ALIGN
RESAC,	CLA CLL; TAD EXP; TAD SIGN; DCA EXP; JMP I ALIGN
SHOP,	TAD (-27; SMA SZA; JMP RESAC /TOO MUCH OPERAND SHIFT
	TAD (26; CMA; DCA SHFT
	TAD AC1L; DCA SUDOMQ; TAD AC1H; JMS DLSR
	DCA AC1H; TAD SUDOMQ; DCA AC1L; JMP DONE
SHFT,	0

DLSR,	0; DCA DLSR1
	TAD SHFT; TAD (14; SPA SNA; JMP MTH11
	CLA; TAD DLSR1
SHRL,	CLL RAR; DCA DLSR1
	TAD SUDOMQ; RAR; DCA SUDOMQ; TAD DLSR1
SHTEST,	ISZ SHFT; JMP SHRL; CLL; JMP I DLSR
MTH11,	TAD (-1; DCA SHFT	/MABE NO EXTRA ONES NEEDED
	TAD DLSR1; DCA SUDOMQ; JMP SHTEST
DLSR1,	0

FNEG,	0; TAD EXP; SZA; TAD (4000; DCA EXP; JMP I FNEG

ERMES,	JMS MESS; 215; 212;"?; 0
	TAD ERR; JMS OCTOUT; JMP PLOOP3+4

*5200
OCTOUT,	0; RAL; DCA T1; TAD (-4; DCA T2
OCTO,	TAD T1; RAL; RTL; DCA T1
	TAD T1; AND (7; TAD (260; JMS TTO; CLA
	ISZ T2; JMP OCTO; JMP I OCTOUT

FMULT,	0; TAD HORD; SZA CLA; TAD AC1H; SZA CLA; JMP DOMUL
	DCA EXP; DCA HORD; DCA LORD; JMP I FMULT
DOMUL,	JMS XORSGN	/EXTRACT SIGN BITS
	TAD EXP; TAD EX1; TAD (-2000; SPA; JMS ERR0 /OVERFLOW
	TAD SIGN; DCA EXP	/ADD EXPONENTS
	TAD LORD; DCA MP1; TAD AC1H; DCA SUDOMQ; JMS PSDMUY
MP1,	0; DCA MP1	/2ND POSITION
	TAD AC1L; DCA M2; TAD HORD; JMS MQLAUY
M2,	0; TAD MP1	/ADD PREVIOUS 2ND POSITION BITS
	DCA SUDOMQ; RAL; DCA M2	/PUT THEM IN MQ, SAVE CARRY
	TAD HORD; DCA M3; TAD AC1H; JMS MQLAUY
M3,	0; TAD M2	/ADD CARRY FROM 2ND POSITION
	DCA HORD; TAD SUDOMQ; DCA LORD
	TAD HORD; SPA CLA; JMP I FMULT
	CLA CLL; TAD LORD; RAL; DCA LORD
	TAD HORD; RAL; DCA HORD
	CMA; TAD EXP; DCA EXP; JMP I FMULT
	/MINIMUM POSSIBLE PRODUCT IS 0.25

PSDDVI,	0
	DCA DVIAC; TAD I PSDDVI; ISZ PSDDVI
	DCA PLUSOP; TAD PLUSOP; CLL CIA; DCA DVIOP
	TAD (-15; DCA DVIC; JMP DIVST
DIVL,	TAD DVIAC; RAL; TAD DVIOP
	SNL; JMP NO
YES,	DCA DVIAC
DIVST,	TAD SUDOMQ; RAL; DCA SUDOMQ
	ISZ DVIC; JMP DIVL; TAD DVIAC; CLL; JMP I PSDDVI
NO,	TAD PLUSOP; CML; JMP YES
PLUSOP,	0
DVIAC,	0
DVIC,	0
DVIOP,	0


*5400
FINPUT,	0
	CLA CMA; DCA PERSW; CMA; DCA NEGMKR
	DCA DSWIT; DCA EXP; DCA HORD; DCA LORD
DPART,	DCA FRACD	/ZERO DIGITS AFTER POINT
NDIG,	JMS DIGIN; JMP NOTDIG; ISZ DSWIT; ISZ FRACD
	JMS FMUL; TEN; JMS FPUT; TEM; JMS FGET; DIG-1
	JMS NORM; JMS FADD; TEM; JMP NDIG	/RESULT*10+DIGIT
NOTDIG,	ISZ PERSW; JMP CONT1	/SECOND PERIOD?
	ISZ DIG; ISZ DIG; CLA SKP; JMP DPART	/NO, IF PERIOD READ ON
	DCA FRACD	/IF NOT ANY PERIOD NO FRACTIONAL DIGITS
CONT1,	ISZ NEGMKR; JMS FNEG
	CLA CMA; DCA NEGMKR	/SET UP FOR EXPONENT
	TAD CHAR; TAD (-"E; SNA CLA
NEXD,	JMS DIGIN; JMP ENDEXP
	TAD X; CLL RTL; TAD X; CLL RAL; TAD DIG; JMP NEXD /ACCUMULATE EXPONENT
ENDEXP,	TAD X; ISZ NEGMKR; CIA; CIA; TAD FRACD /-(DECIMAL EXPONENT)
	CLL CIA; SPA; CLL CML CIA; CMA; DCA FRACD /-(DEC EXP. + 1)
	RAL; TAD JMSI; DCA FLINS	/MAKE JMS FMUL OR JMS FDIV
MORE,	ISZ FRACD; JMP FLINS; JMP I FINPUT
FLINS,	0; TEN; JMP MORE	/*10 OR /10
JMSI,	JMS I .+1; FMUL; FDIV
	2014
DIG,	0; 0
TEN,	2004; 5000; 0
NEGMKR,	0
PERSW,	0
FRACD,	0
TEM,	0; 0; 0

DIGIN,	0
	DCA X; JMS FLIN; TAD CHAR; TAD (-"+; SNA; JMP NOTPL
	TAD ("+-"-; SZA CLA; JMP NOTPL+1; DCA NEGMKR
NOTPL,	JMS FLIN; TAD CHAR; TAD (-272; CLL
	TAD (12; DCA DIG; SZL; ISZ DIGIN; JMP I DIGIN /EXIT2 IF DIGIT

FLIN,	0; JMS INDEV; DCA CHAR; TAD CHAR; SNA; JMP FLIN+1
	TAD (-377; SNA CLA; JMP FINPUT+1; JMP I FLIN

$
