perm filename SAINUM.FAI[S,AIL] blob
sn#248589 filedate 1976-11-26 generic text, type T, neo UTF8
SEARCH HDRFIL
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,EN,EN,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
JOV INT4
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
AOJA C,INT2
XCT LPSA ;GET HERE FROM THE AHEAD MACRO
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)