00001 *************************
00002 *
00003 * XIC.ASM
00004 * MDJ 09-24-90
00005 *
00006 * CONVERTS A FLOATING
00007 * POINT NUMBER TO A
00008 * TWO-BYTE SIGNED INTEGER
00009 *
00010 *************************
00011 *
00012 * U AND S STACKS MUST
00013 * ALREADY BE INITIALIZED
00014 *
00015 * MUST BE ENTERED WITH 
00016 * FLOATING POINT NUMBER
00017 * IN FPA0
00018 *
00019 * RETURNS SIGNED INTEGER
00020 * IN REGISTER D
00021 *
00022 *************************
00023 *
00024 * REF. PAGE A64 AND
00025 * SURROUNDING PAGES
00026 * COLOR BASIC UNRAVELLED
00027 *
00028 *************************
00029 *
00030 FPA0    EQU     $50     FLOATING POINT ACCUM. #0 MANTISSA
00031 FP0EXP  EQU     $4F     FLOATING POINT ACCUM. #0 EXPONENT
00032 FP0SGN  EQU     $54     FLOATING POINT ACCUM. #0 SIGN
00033 FPSBYT  EQU     $63     FLOATING POINT SUB-BYTE
00034 FPCARY  EQU     $5B     FLOATING POINT CARRY BYTE
00035 VALTYP  EQU     6       TYPE FLAG
00036         ORG     $3D5B
00037 XIC     ANDCC   #$FE    CLEAR CARRY FLAG
00038         FCB     $7D     OP CODE OF TST - SKIP TWO BYTES
00039         ORCC    #1      SET CARRY
00040         TST     VALTYP  TEST TYPE FLAG
00041         BCS     XIC2    GO IF STRING
00042         BPL     XIC2    GO ON PLUS
00043         FCB     $8C     SKIP TWO BYTES
00044 XIC2    LDA     FP0EXP  GET FPA0 EXPONENT
00045         CMPA    #$90
00046         BCS     XIC3    GO IF FPA0 < 32768
00047         JSR     XIC4
00048 XIC3    JSR     XIC6
00049         LDD     FPA0+2  GET THE INTEGER
00050         RTS
00051 XIC4    LDB     ,X      CHECK EXPONENT
00052         BEQ     XICA    GO IF FPA=0
00053         LDB     1,X     GET MSB OF MANTISSA
00054         EORB    FP0SGN  EOR WITH SIGN OF FPA0
00055         BMI     XICB    GO IF SIGNS NOT EQUAL
00056         LDB     FP0EXP  GET EXPONENT
00057         CMPB    ,X      IS IT = X
00058         BNE     XIC5    GO IF NO
 
 
 
 
 
 
 
 
00059         LDB     1,X     GET MSB
00060         ORB     #$7F    THE SIGN BIT AND THE BOTTOM 7
00061         ANDB    FPA0    BITS OF FPA0 INTO ACCB
00062         CMPB    1,X     BOTTOM 7 BITS = MSB?
00063         BNE     XIC5    GO IF NO
00064         LDB     FPA0+1  GET SECOND BYTE
00065         CMPB    2,X     EQUAL?
00066         BNE     XIC5    GO IF NO
00067         LDB     FPA0+2  GET THIRD BYTE
00068         CMPB    3,X     EQUAL?
00069         BNE     XIC5    GO IF NO
00070         LDB     FPA0+3  GET LSB
00071         SUBB    4,X     SUBTRACT LSB OF X
00072         BNE     XIC5    GO IF NOT = 0
00073         RTS
00074 XIC5    RORB            SHIFT CARRY TO BIT 7
00075         EORB    FP0SGN  TOGGLE IF FPA0 IS NEGATIVE
00076         BRA     XICC    GO SET ACCB
00077 XIC6    LDB     FP0EXP  GET EXPONENT
00078         BEQ     XIC9    ZERO MANTISSA IF FPA0=0
00079         SUBB    #$A0    GET NUMBER OF SHIFTS REQUIRED
00080         LDA     FP0SGN  TEST SIGN
00081         BPL     XIC7    GO IF POSITIVE
00082         COM     FPCARY  COMPLEMENT THE CARRY
00083         JSR     XICE    NEGATE MANTISSA OF FPA0
00084 XIC7    LDX     #FP0EXP POINT X TO FPA0
00085         CMPB    #$F8    EXPONENT DIFFERENCE < -8?
00086         BGT     XIC8    GO IF YES
00087         JSR     XICH    SHIFT FPA0 RIGHT
00088         CLR     FPCARY  CLEAR THE CARRY BYTE
00089         RTS
00090 XIC8    CLR     FPCARY
00091         LDA     FP0SGN  GET SIGN
00092         ROLA            ROTOTA IT INTO THE CARRY FLAG
00093         ROR     FPA0    ROTATE CARRY INTO MANTISSA BIT 7
00094         JMP     XICJ    DE-NORMALIZE FPA0
00095 XIC9    STB     FPA0    LOAD MANTISSA WITH ACCB CONTENTS
00096         STB     FPA0+1
00097         STB     FPA0+2
00098         STB     FPA0+3
00099         RTS
00100 XICA    LDB     FP0EXP  GET EXPONENT
00101         BEQ     XICD    GO IF FPA0=0
00102 XICB    LDB     FP0SGN  GET SIGN
00103 XICC    ROLB            BIT 7 TO CARRY
00104         LDB     #$FF    NEGATIVE FLAG
00105         BCS     XICD    GO IF NEGATIVE MANTISSA
00106         NEGB            ACCB=1 IF POSITIVE MANTISSA
00107 XICD    RTS
00108 XICE    COM     FPA0    NEGATE MANTISSA
00109         COM     FPA0+1
00110         COM     FPA0+2
00111         COM     FPA0+3
00112         LDX     FPA0+2
00113         LEAX    1,X
00114         STX     FPA0+2
00115         BNE     XICF
00116         LDX     FPA0
 
 
 
 
 
 
 
 
00117         LEAX    1,X
00118         STX     FPA0
00119 XICF    RTS
00120 XICG    LDA     4,X     SHIFT MANTISSA RIGHT
00121         STA     FPSBYT
00122         LDA     3,X
00123         STA     4,X
00124         LDA     2,X
00125         STA     3,X
00126         LDA     1,X
00127         STA     2,X
00128         LDA     FPCARY
00129         STA     1,X
00130 XICH    ADDB    #8      ADD 8 TO DIFFERENCE OF EXPONENTS
00131         BLE     XICG    GO SHIFT MANTISSA
00132         LDA     FPSBYT  GET SUB-BYTE
00133         SUBB    #8      CAST OUT THE 8 ADDED ABOVE
00134         BEQ     XICK    GO IF EXPONENTS NOT EQUAL
00135 XICI    ASR     1,X     SHIFT MANTISSA
00136 XICJ    ROR     2,X
00137         ROR     3,X
00138         ROR     4,X
00139         RORA
00140         INCB
00141         BNE     XICI
00142 XICK    RTS
00143         END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
