perm filename SAINUM.FAI[S,AIL]1 blob sn#102576 filedate 1974-05-22 generic text, type T, neo UTF8
COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
	  ,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.>
	  ,<LOU PAUL'S NUMBER INPUT AND CONVERSION ROUTINES>)
HERE (REALIN)
IFN ALWAYS,<BEGIN NUMIN>
	PUSHJ P,SAVE
	PUSHJ P,NUMIN;		GET NUMBER IN A AND TEN EXPONENT IN C
	MOVE LPSA,X22
	JRST REALFN
HERE (REALSCAN)
	PUSHJ P,SAVE
	PUSHJ P,STRIN
	MOVE LPSA,X33
REALFN:	SETZ D,;		POS SIGN
	JUMPE A,ADON
	JUMPG A,FPOS
	SETO D,;		NUMBER NEGATIVE
	MOVNS A
FPOS:	;WE NOW HAVE A POSITIVE NUMBER IN A WITH SIGN IN D
	JFFO A,.+1;		NUMBER OF LEADING ZEROS IN B
	ASH A,-1(B);		BIT0=0, BIT1=1
	MOVN X,B;		BIN EXPONENT -2
	JUMPE C,FLO;		IF TEN EXPONENT ZERO THEN FINISH
	JUMPL C,FNEG
	CAIL C,100;		CHECK BOUND OF EXPOENT
	JRST ERROV1
	SETZ Y,
	JRST TEST
FNEG:	MOVNS C
	CAIL C,100
	JRST ERROV1
	MOVEI Y,6
TEST:	TRNE C,1;		DEPENDING ON LOW ORDER BIT OF EXP
	JRST MULT;		EITHER MULTIPLY 
NEXT:	ASH C,-1;		OR DON'T.
	AOJA Y,TEST;		INDEX INTO MULTIPLIER TABLE
MULT:	ADD X,.CH.(Y);		EXPONENT
	MUL A,.MT.(Y)		;MULTIPLY AND NORMALIZE
	TLNE A,200000
	 JRST DTEST
	ASHC A,1
	SOJA X,.+1
DTEST:	SOJG C,NEXT
FLO:	IDIVI A,1B18
	FSC A,255
	FSC B,234
	FADR A,B
	SKIPE D
	MOVNS A
	FSC A,(X);		SCALE
	JRST ALLDON
	SUBTTL	INTIN	INTEGER NUMBER INPUT ROUTINE	LOU PAUL
HERE (INTIN)
	PUSHJ P,SAVE
	PUSHJ P,NUMIN;		GET NUMBER IN A, TEN EXPONENT IN C
	MOVE LPSA,X22
	JRST INTFN
HERE (INTSCAN)
	PUSHJ P,SAVE
	PUSHJ P,STRIN
	MOVE LPSA,X33
INTFN:	JUMPE A,ADON
	JUMPE C,ADON
	JUMPL C,DIVOUT;		IF EXPONENT NEG WE WILL DIVIDE
	CAIL C,13
	JRST ERROV1
	IMUL A,.TEN.(C)
	JRST ALLDON
DIVOUT:	MOVNS C
	CAIL C,13
	JRST [SETZ A,
		JRST ADON ]
	MOVE C,.TEN.(C)
	IDIV A,C
	ASH C,-1
	CAML B,C;		ROUND POSITIVELY
	AOJA A,ALLDON
	MOVNS B
	CAML B,C
	SOJ A,
ALLDON:	JOV ERROV1;		CHECK FOR OVERFLOW
ADON:	MOVEM A,RACS+1(USER)
	JRST RESTR
ERROV1:	PUSHJ P,ERROV
	JRST ADON
	SUBTTL	FREE FIELD NUMBER SCANNER		LOU PAUL
	DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
	HRRE X,TAB(D)
	JRST @.+2(X)
	JUMP DIG
	JRST .-4
	JUMP POINT
	JUMP MINUS
	JUMP PLUS
	JUMP E
	JUMP CHA
	JUMP EOF>
	DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
	SETZ X,
	LSHC X,3
	JRST @.+1(X)
	JUMP NULL
	JUMP POINT
	JUMP MINUS
	JUMP PLUS
	JUMP E
	JUMP CHA
	JUMP CHA>
NUMIN:	MOVE CHNL,-2(P)
	LOADI7 A,<IN>
	PUSHJ P,GETCHN;		SET UP FOR INPUT
	SETZM @ENDFL(CDB);	CLEAR EOF AND BREAK FLAGS
	SETZM @BRCHAR(CDB)
	MOVE LPSA,[JSP X,NCH]
	MOVEI Z,1;		FOR LINE NUMBER TEST
	PUSHJ P,SCAN
	MOVEM D,@BRCHAR(CDB);	FIX UP BREAK CHARACTER
	SOS	IBP(CDB)		;BACK UP TO GET IT NEXT TIME
	FOR II←1,4 <
	IBP	IBP(CDB)>
	AOS	ICOWNT(CDB)
	POPJ P,
NCH:	SOSG ICOWNT(CDB);	DECREMENT CHARACTER COUNT
	JRST NCH2
NCH1:	ILDB D,IBP(CDB);	LOAD BYTE
	TDNE Z,@IBP(CDB);	CHECK FOR LINE NUMBER
	JRST NCH5
	SKIPN	LINNUM(CDB)	;WANT SETPL STUFF???
	JRST (X) 		;NO, RETURN
	CAIN	D,12		;YES, IS THIS A LF?
	AOS	@LINNUM(CDB)	;YES, BUMP LINE COUNT
	CAIE	D,14		;A FF?
	JRST	(X)		;NOPE
	SKIPN	PAGNUM(CDB)	;BUG TRAP
	JRST    [ ERR	<DRYROT -- SETPL LOSSAGE DETECTED BY NUMIN>,1
		JRST	(X) ]
	AOS	@PAGNUM(CDB)	;BUMP PAGE COUNT
	SETZM	@LINNUM(CDB)	;ZERO LINE COUNT
	JRST	(X)		;RETURN
NCH2:	XCT IOIN,SIMIO;		INPUT
	JRST NCH1		;ALL OK
NCH7:	MOVEI D,200		;EOF OR DATA ERROR.
	JRST (X)
NCH5:	
	SKIPE	SOSNUM(CDB)	;DOES THE LOSER WANT IT??
	JRST	[ MOVE	D,@IBP(CDB)	;YES, GET IT
		MOVEM	D,@SOSNUM(CDB)	;WHERE HE SAID TO PUT IT
		JRST	.+1]
	AOS IBP(CDB);		WE HAVE A LINE NUMBER
	MOVNI D,5;		MOVE OVER IT
	ADDB D,ICOWNT(CDB)
	SKIPLE D;		NOTHING LEFT
	JRST NCH;		DO ANOTHER INPUT
	XCT IOIN,SIMIO
NCH6:	SOSG ICOWNT(CDB);	REMOVE TAB
	JRST NCH7		;NONE THERE OR ERROR
	IBP IBP(CDB)
	JRST NCH
STRIN:	MOVE LPSA,[JSP X,NCHA]
	HRRZ Z,-3(P)
	HRRZ Z,-1(Z)
	HRRZS -3(P)		;SO CAN INDIRECT THROUGH IT.
	PUSHJ P,SCAN
	HRRZ X,-3(P)
	SOS (X)			;BACK UP BYTE POINTER
	FOR II←1,4<
	IBP (X)>
	AOJ Z,
	HRRM Z,-1(X)
	MOVEM D,@-2(P)		;STORE BREAK CHARACTER
	POPJ P,
NCHA:	SOJL Z,NCH7
	ILDB D,@-4(P)
	JRST (X)
SCAN:	JOV .+1
	SETO TEMP,		;FLAG REGISTER.
	SETZ	Y,
	SETZB A,C;		NUMBER		EXPOENT
MORE:	XCT LPSA;		THIS GETS A CHARACTER IN D,200 IF FO EOF
	AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
STACK:	LSHC X,-3;		PUSH SYMBOL ONTO STACK "AC Y"
	JRST MORE
DIG1:	SETZ TEMP,;		FLAG REG.
	ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)
SIG1:	TRO TEMP,4;		NEGATIVE SIGN
SIG2:	ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)
EXP1:	MOVEI A,1
	ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)
SIG3:	MOVNS A
SIG4:	ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)
FRA1:	TRO TEMP,1;		DECIMAL POINT
	SOJ C,
	ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)
SIG5:	TRO TEMP,4;		NEGATIVE SIGN
SIG6:	ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)
EXP2:	HLRE FF,TAB(D);		FIRST DIGIT
EXP5:	XCT LPSA;		GET NEXT CHARACTER
EXP9:	HLRE B,TAB(D)
	JUMPL B,EEXP;		NEGATIVE IF NOT A DIGIT
	IMULI FF,12
	ADD FF,B
	JRST EXP5
	XCT LPSA
EEXP:	AHEAD(EXP9,ERR2,DONE5,DONE5,ERR1,EN,EN)
EN:	TRNE TEMP,4;		SIGN OF EXPONENT
	MOVNS FF
	ADD C,FF;		FIX UP EXPONENT
	JOV ERR3
DONE5:
DONE:	ANDI D,177
	JUMPGE TEMP,.+2
	SETO D,
	POPJ P,
INT1:	HLRE A,TAB(D);		FIRST DIGIT
	TRNE TEMP,4
	MOVNS A;		NEGATE IF NECESSARY
INT2:	XCT LPSA;		GET NEXT CHARACTER
INT5:	HLRE B,TAB(D)
	JUMPL B,EON;		NEGATIVE IF NOT A NUMBER
	TRNE TEMP,1;		IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
	SOJ C,
	TRNE TEMP,2;		IF ENOUGH DIGITS THEN INC EXP BY ONE
INT3:	AOJA C,INT2
	MOVE X,A
	IMULI A,12
	TRNE TEMP,4;		NEGATE DIGIT IS SIGN NEGATIVE
	MOVNS B
	ADD A,B
	JOV INT4;		CHECK FOR OVERFLOW
	JRST INT2;		IF SO USE LAST VALUE
INT4:	TRO TEMP,2
	MOVE A,X
	JRST INT3
	XCT LPSA
EON:	AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)
DP1:	TROE TEMP,1
	JRST ERR2
	XCT LPSA
	AHEAD(INT5,ERR2,DONE5,DONE5,EXP6,DONE,DONE)
EXP6:	SETZ TEMP,
	XCT LPSA
	AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)
EXP7:	TRO TEMP,4
EXP8:	XCT LPSA
	AHEAD(EXP2,ERR2,DONE5,DONE5,ERR1,ERR1,ERR1)
ERR1:	ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)
ERR2:	ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)
ERR3:	ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)
ERR5:	ERR(<NUMIN: MISPLACED SIGN>,1,RZ)
ERROV:	ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)
RZ:	SETZ A,
	JRST DONE
TAB:	FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,0,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
>
	FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
>
	FOR A IN (5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	XWD -1,6
ENDCOM(NUM)