REF  XMLLNK            THEN INVERT FIRST WORDNER BYTENEEDEDom FAC
ARG    EQU  >8356
FAC    EQU  >834A
PAD    EQU  >8300             ; >F000 FOR GENEVE?
ERRNIP DATA >0520
EXTRTN DATA 0
ERRSQR DATA >0460
CBHA   BYTE >0A
CBH80  BYTE >80
CBD50  BYTE 50
       EVEN
ERRLOG DATA >06A0
CW100  DATA 100
P$     DATA 0
Q$     DATA 0
FORBUF
PLYBUF DATA 0,0,0,0
PLWBUF DATA 0,0,0,0
CW03   DATA 3
CW08   DATA 8
CW128  DATA 128
WSM6   DATA 6
STK1   DATA 0,0,0,0
STK2   DATA 0,0,0,0
STK3   DATA 0,0,0,0
STK4   DATA 0,0,0,0
SGNBIT EQU  >8000
EXP    EQU  ARG+16
SIGN   EQU  EXP+2
       COPY "DSK5.TRINSIC1"
       COPY "DSK5.TRINSIC2"
CFI    BLWP @XMLLNK
       DATA >1200
       RT
FMULT  BLWP @XMLLNK
       DATA >0800
       RT
FDIV   BLWP @XMLLNK
       DATA >0900
       RT
FSUB   BLWP @XMLLNK
       DATA >0700
       RT
FADD   BLWP @XMLLNK
       DATA >0600
       RT
OVEXP1 EQU  $
OVEXP  MOVB @EXP,R2
       CLR  @FAC
       CLR  @FAC+2
       RT
TRINRT MOVB @FAC+10,@1(R13)   return error code
       STST R15               routines do an RT to return float from FAC
       MOV  @2(R13),R3
       MOV  R3,R4
       SRL  R4,13
*      MOVB @TSKMAP(R4),@MAPPER+5
       INC  R4
       ANDI R4,>0007
*      MOVB @TSKMAP(R4),@MAPPER+6
       ANDI R3,>1FFF
       AI   R3,>A000
*
       LI   R4,FAC
       MOV  *R4+,*R3+
       MOV  *R4+,*R3+
       MOV  *R4+,*R3+
       MOV  *R4,*R3
*
       RTWP                   return to caller...
FCOMP
FCOMP1 LI   R7,ARG
FCOMP7 LI   R5,FAC            ENTRY FOR COMPARE NUM R7*
       C    *R7,*R5+          COMPARE THE FIRST WORDS
       JNE  FCOMRT            DONE COMPARING IF NOT EQUAL
       MOV  *R7+,R6           SIGN OF THE NUMBERS
       JEQ  FCOMRT            NUMBERS ARE ZERO AND EQUAL
       JGT  FCOM01            BOTH NEGATIVE
       MOV  R5,R6
       MOV  R7,R5
       MOV  R6,R7
FCOM01 C    *R7+,*R5+         BOTH POSITIVE
       JNE  FCOMRT            CONTINUE COMPARING UNITL UNEQUAL
       C    *R7+,*R5+         OR END OF NUMBER
       JNE  FCOMRT
       C    *R7,*R5           THE LAST !
FCOMRT RT                     EXIT AS SPECIFIED
ROUND
ROUN1
       CB   @FAC+8,@CBD50      IS ROUNDING NECESSARY
       JL   PACKUP            NO PUT EXPONENT BACK
       LI   R1,7              ROUND UP, GET NUMBER OF BYTES NEEDED
ROUNUP LI   R2,1*256          ONE FOR BYTE INSTRUCTION
       LI   R0,100*256        SAME
ROUN02 AB   R2,@FAC(R1)       ADD ONE TO A BYTE OF FAC
       CB   @FAC(R1),R0       IF BYTE NOT GREATER THAN RADIX
       JL   PACKUP            THEN PUT EXPONENT IN FAC
       SB   R0,@FAC(R1)       BRING DIGIT BACK IN RANGE
       DEC  R1                IF CARRY PAST HIGH BYTE OF FAC
       JGT  ROUN02            THEN CARRY TO NEXT HIGHER BYTE
       INC  @EXP              FRACTION HAS OVERFLOWED
       MOVB R2,@FAC+1         MAKE THE HIGH BYTE A ONE
 
PACKUP C    @EXP,@CW128
       JHE  OVEXP1
       MOVB @EXP+1,@FAC        PUT EXPONENT IN FAC
       MOVB @SIGN,R2
       INV  R2                IF SIGN IS NEGATIVE
       JLT  PACK01
       NEG  @FAC              THEN INVERT FIRST WORD
 
PACK01
       RT
       END