perm filename SAICVF.FAI[S,AIL] blob sn#191942 filedate 1975-12-15 generic text, type T, neo UTF8
SEARCH HDRFIL
COMPIL(CVF,<CVF,CVG,CVE>
	  ,<SAVE,STRNGC,RESTR,X22,X11,X33,.MT.,.CH.,.TEN.>
	  ,<CVF, CVG, CVE>)
HERE (CVF)	PUSHJ P,SAVE
	PUSH P,[-1]
	JRST SSCONV
HERE (CVG)	PUSHJ P,SAVE
	PUSH P,[1]
	JRST SSCONV
HERE (CVE)	PUSHJ P,SAVE
	PUSH P,[0]
	JRST SSCONV
	BEGIN NUMOUT
↑SSCONV:MOVE LPSA,X33
	PUSHJ P,BOUND
	MOVM X,DIGS(USER)	;NUMBER OF DECIMALS
	SKIPGE (P)		;IF F FORMAT
	ADD X,D			;ADD THE TEN EXPONENT
	JUMPN B,E0
	JUMPN X,E0
	MOVEI A,2
	SKIPL (P)
	MOVEM A,(P)
E0:	JUMPGE X,E1
	MOVEI	B,0		;THIS FIXES A BUG
	JRST E2
E1:	CAIL X,10
	JRST E2
	MOVEI Y,10		; 0  LEQ  X LESS THAN 8
	SUB Y,X			;Y IS THE EXPONENT OF DIVISOR
	MOVE Z,.TEN.(Y)		;Z IS THE DIVISOR
	IDIV B,Z
	ASH Z,-1
	CAML C,Z
	AOJ B,			;ROUND
	CAMGE B,.TEN.(X)		;CHECK IF ROUND CAUSED ANOTHER DIGIT
	JRST E2
	SKIPGE (P)		;IF F FORMAT
	AOJA X,E2		;INCREASE DIGIT COUNT
	IDIVI B,=10		;OTHERWISE REMOVE IT
	AOJ D,			;AND INCREASE EXPONENT
E2:	MOVM A,DIGS(USER)
	CAMGE A,X
	MOVE A,X		;A CONTAINS NUMBER OF DIGITS
	ADDI A,2		;SIGN AND DECIMAL POINT
	SKIPL (P)
	ADDI A,4		;IF NOT F FORMAT @-DD
	MOVE Z,A		;SAVE CHARACTER COUNT
	MOVM Y,WDTH(USER)	;MINIMUN STRING LENGTH
	CAMG A,Y
	MOVE A,Y
	ADDM A,REMCHR(USER)	;CHECK THERE IS ROOM
	SKIPLE REMCHR(USER)
	PUSHJ P,STRNGC		;NO ROOM
	HRRO C,A		;NON-ZERO, WITH COUNT
	PUSH SP,C
	PUSH SP,TOPBYTE(USER)
	SUB A,Z			;NUMBER OF LEADING SPACES
	MOVEI C," "
	JUMPE A,E4		;NO LEADING SPACES
	SKIPL WDTH(USER)	;F FORMAT
	JRST E3
	JUMPE FF,.+2		;LEADING ZEROS - NO SIGN, GO DO ZEROES
	MOVEI C,"-"
	IDPB C,TOPBYTE(USER)
	MOVEI C,"0"
E5:	IDPB C,TOPBYTE(USER)	;FILL WITH ZEROS
	SOJG A,E5
	JRST C1
E3:	IDPB C,TOPBYTE(USER)	;FILL WITH BLANKS
	SOJG A,E3
E4:	JUMPE FF,.+2		;NO SIGN, BLANKS ALL DONE
	MOVEI C,"-"		;THEN THE SIGN
	IDPB C,TOPBYTE(USER)
C1:	MOVEI Z,10
	SKIPL (P)
	JRST C6
	MOVE Y,X		;CVF NUMBER OF DIGITS
	MOVM A,DIGS(USER)	;NUMBER OF DECIMALS
	SUB Y,A			;POS OF DECIMAL POINT
	JUMPGE Y,C5		;IF POSITIVE
	SUB Z,Y
	MOVM X,DIGS(USER)
	SETZ Y,			;OTHERWISE ZERO
	JRST C5
C6:	SETZ Y,
	SKIPG (P)
	JRST C5
	JUMPL D,C5		;CVG IF NEG TAKE CVE
	CAMLE D,X		;IF ENOUGH DIGITS 
	JRST C5
	MOVE Y,D		;SHIFT DECIMAL POINT
	MOVEI	D,0		;AND ADJUST EXPONENT
C5:	PUSH P,[D1]		;RECURSIVE NUMBER PRINTER
C2:	CAIE X,(Y)		;DECIMAL POINT NOW 
	JRST C3
	SOJ Z,
	MOVEI C,"."		;YES
	SKIPE DIGS(USER)	;IF ZERO DIGITS
	JRST C4
	JUMPN B,C4
	MOVEI C," "
	SKIPL -1(P)
	JRST C9
	SOJA X,C3
C9:	MOVE Y,-1(P)
	CAIE Y,2
	JRST C4
	POP P,Y
	MOVE Y,[ASCII/ 0   /]
	JRST D8
C3:	CAILE X,(Z)		;IF MORE THAN 8 DIGITS
	JRST	[MOVEI C,"0"	;PUSH A ZERO
		JRST C4]
	IDIVI B,=10
	IORI C,"0"
C4:	HRLM C,(P)
	SOSL X
C8:	PUSHJ P,C2
C7:	HLRZ C,(P)		;PUSH NUMBER OUT
	IDPB C,TOPBYTE(USER)
	POPJ P,
D1:	SKIPGE (P)
	JRST D7
	SKIPN DIGS(USER)
	SOJA D,D2
	JUMPE D,	[MOVE Y,[ASCIZ /    /] ;EXPONENT ZERO SO STORE 
			JRST D8]		;FOUR BLANKS
D2:	SETZ Y,			;ACCUMULATE EXPONENT STRING
	SETZ FF,		;EXPONENT SIGN
	JUMPL D,	[SETO FF,	;NEGATIVE
			MOVN D,D	;MAKE POSITIVE
			JRST D4]
	HRLI Y," "⊗=11		;NUMBER POS SO TRILING BLANK
D4:	CAIGE D,=10
	JRST 		[MOVEI X," "
			LSHC X,-7
			JRST D5]
D5:	IDIVI D,=10
	IORI X,"0"
	LSHC X,-7		;PUSH INTO Y
	JUMPG D,D5
	MOVEI X,"@"		;PUSH @
	IDPB X,TOPBYTE(USER)
	MOVEI X,"-"		;MINUS SIGN
	SKIPE FF
D6:	IDPB X,TOPBYTE(USER)	;AND EXPONENT
	JUMPE Y,D7
D8:	LSHC X,7
	JRST D6
D7:	JRST RESTR		; RETURN
BOUND:	SETZB FF,D		;TENS EXPONENT
	MOVE B,-3(P)		;INPUT NUMBER
	JUMPE B,ZERO
	JUMPG B,POS
	SETOB FF,A		;NUM IS NEG
	LSHC A,11		;SEPERATE BIN EXPONENT
	LSH B,-1
	SETCA A,		;BIN EXPONENT + 200
	JUMPE B,LARN		;LARGEST NEGATIVE???
	TLO B,400000		;
	MOVNS B
	JRST OK
LARN:	HRLOI B,177777		; LARGEST NEG SHIFTED RIGHT 1 BIT
	AOJA A,OK
POS:	SETZ A,
	LSHC A,11		;SEPERATE BIN EXPONENT
	LSH B,-1
OK:	SUBI A,200		;BIN EXP IN A, ABS (BIN FRACT) IN B,
	CAIL A,34
	JRST MULTI		;USE NEGATIVE POWERS OF TEN
	CAIG A,27		;N LESS THAN 34
	JRST FRACT		;USE POSITIVE POWERS OF TEN
	CAIL A,33		;30.2 LEQ N LESS THAN 34
	JRST TOPQ
	CAIG A,30		;30.2 LEQ N LESS THAN 33
	JRST BOT
DONE:	SUBI A,43		;31.2 LEQ N LESS THAN 33
	ASHC B,(A)
	TLNE C,200000		;ROUND
	AOJ B,
	ADDI D,10
ZERO:	POPJ P,
TOPQ:	CAMLE B,MF		;33.2 LEQ N LESS THAN 34
	JRST MULTI 		;33.276 LESS THAN N LESS THAN 34
	JRST DONE		;33.2 LEQ N LEQ 33.276
BOT:	CAMGE B,LF		;30.2 LEQ N LEQ 30
	JRST FRACT		;30.2 LEQ N LESS THAN 30.230
	JRST DONE		;30.230 LEQ N LESS THAN 30
MULTI:	MOVEI X,13		;33.276 LESS THAN N
M2:	ASH D,1
	ADD A,.CH.(X)		;NEGATIVE POWERS OF TEN
	CAIG A,31
	JRST M1			;N LESS THAN 32
	PUSHJ P,LFMP		;31.2 LESS THAN N
M6:	IORI D,1		;SET EXPONENT BIT
	CAIL A,34
	SOJA X,M2		;35.2 LESS THAN N STILL TOO LARGE
	CAIE A,33		;31.2 LESS THAN N LESS THAN 34
	JRST M3			;31.2 LESS THAN N LESS THAN 33
	CAMLE B,MF		;33.2 LESS THAN N LESS THAN 34
	JRST M4			;33.276 LESS THAN N LESS THAN 34
M3:	ASH D,-6(X)		;33.2 LESS THAN N LEQ 33.276
	JRST DONE
M1:	CAIL A,30		;N LESS THAN 32
	JRST M5			;29.2 LESS THAN N LESS THAN 32
M8:	SUB A,.CH.(X)		;N LESS THAN 30 NO GOOD
	SOJA X,M2		;TRY NEXT POWER
M4:	CAIE X,6		;33.276 LESS THAN N LESS THAN 34
	SOJA X,M2
	MOVE B,MF		;33.276=N
	JRST DONE
M5:	MOVE Y,B		;SAVE B AND A
	MOVE Z,A
	PUSHJ P,LFMP
	CAIL A,31		;29.2 LESS THAN N LESS THAN 32
	JRST M6			;31.2 LESS THAN N LESS THAN 32
	CAIG A,27		;29.2 LESS THAN N LESS THAN 31
	JRST M7			;29.2 LESS THAN N LESS THAN 30
	CAML B,LF		;30.2 LESS THAN N LESS THAN 31
	JRST M6			;30.230 LESS THAN N LESS THAN 31
	CAILE X,6		;30.2 LESS THAN N LESS THAN 30.230
	JRST M7			;STILL SOME TO GO
	MOVE B,LF		;B=30.230
	JRST M6
M7:	MOVE B,Y		;RESTORE
	MOVE A,Z
	JRST M8
FRACT:	MOVEI X,5		;N LESS THAN 30.230
L2:	ASH D,1
	ADD A,.CH.(X)
	CAIL A,33
	JRST L1			;32.2 LEQ N
	PUSHJ P,LFMP		;N LESS THAN 33
L6:	IORI D,1
	CAIGE A,30
	SOJA X,L2		;N LESS THAN 30
	CAIE A,30		;30.2 LEQ N LESS THAN 33
	JRST L3			;31.2 LEQ N LESS THAN 33
	CAMGE B,LF		;30.2 LEQ N LESS THAN 31
	JRST L4			;30.2 LEQ N LESS THAN 30.230
L3:	ASH D,(X)		;30.2300 LEQ N LESS THAN 31
L9:	MOVNS D
	JRST DONE
L1:	CAIG A,34		;32.2 LEQ N
	JRST L5			;32.2 LEQ N LESS THAN 35
L8:	SUB A,.CH.(X)		;34.2 LEQ N
	SOJA X,L2
L4:	SOJGE X,L2		;30.230 LEQ N LESS THAN 31
	MOVE B,LF		;N30.230
	JRST L9
L5:	MOVE Y,B		;SAVE B AND A
	MOVE Z,A
	PUSHJ P,LFMP
	CAIG A,32		;32.2 LEQ N LESS THAN 35
	JRST L6			;32.2 LEQ N LESS THAN 33
	CAIL A,34		;33.2 LEQ N LESS THAN 35
	JRST L7			;34.2 LEQ N LESS THAN 35
	CAMG B,MF		;33.2 LEQ N LESS THAN 34
	JRST L6			;33.2 LEQ N LESS THAN 34
	JUMPG X,L7		;33.276 LESS THAN N LESS THAN 34
	MOVE B,MF		;N=33.276
	JRST L6
L7:	MOVE B,Y		;RESTORE
	MOVE A,Z
	JRST L8
LFMP:	MUL B,.MT.(X)
	TLNE B,200000
	POPJ P,
	ASHC B,1
	SOJA A,.+1
	POPJ P,
LF:	230455000000
MF:	276570177400
	BEND
ENDCOM(CVF)
END