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