[comp.sys.cbm] fixed float1.a for C Power 128

prindle@NADC.ARPA (11/03/87)

From: prindle@nadc.arpa (Frank Prindle)

Here is the library routine float1.a with a repair to the function c$cnvfi
(convert float to int) which will cause statements such as "i=f;" to work
properly where f is float (or double) and i is int.  Note that with this
implementation, truncation occurs toward negative infinity, not zero.  This
is permissible by the current K&R C standard, though it will not be by the
ANSI C standard, once it is released.  Also included, for those who do not
have the Rinfret/Zarling C Power assembler, is a uuencoded version of the 
assembled object file float1.obj.  Note that this all applies only to C Power
*128*!  C Power 64 does not have this problem and this library routine does
not apply to C Power 64!
Sincerely, 
Frank Prindle
Prindle@NADC.arpa
-------------------------------------float1.a---------------------------------
;--------------------
 .def c$fadd
 .ref c$kernin
 .ref c$kernout
c$fadd
 lda #$01
 jsr c$kernin
 lda $68
 eor $6f
 sta $70
 ldx #$af
 ldy #$1b
 jmp c$kernout

;--------------------
 .def c$fsub
c$fsub
 jsr c$kernin
 lda $68
 eor $6f
 sta $70
 ldx #$af
 ldy #$15
 jmp c$kernout

;--------------------
 .def c$fmul
c$fmul
 lda #$01
 jsr c$kernin
 lda $68
 eor $6f
 sta $70
 ldx #$af
 ldy #$21
 jmp c$kernout

;--------------------
 .def c$fdiv
c$fdiv
 lda #$01
 jsr c$kernin
 lda $68
 eor $6f
 sta $70
 ldx #$af
 ldy #$27
 jmp c$kernout

;--------------------
 .def c$fneg
c$fneg
 jsr c$kernin
 ldx #$af
 ldy #$33
 jmp c$kernout

;--------------------
 .def c$fcmp
c$fcmp
 sta $e0
 sty $e1
 ldy #$04
lab1 lda ($e0),Y
 sta $0100,Y
 dey 
 bpl lab1
 lda #$00
 ldy #$01
 jsr c$kernin
 ldx #$af
 ldy #$54
 jmp c$kernout

;--------------------
 .def c$movmf1
c$movmf1
 sta $e0
 sty $e1
 ldy #$04
lab2 lda ($e0),Y
 sta $0100,Y
 dey 
 bpl lab2
 lda #$00
 ldy #$01
 jsr c$kernin
 lda #$00
 ldx #$02
 jsr $0135
 lda #$00
 ldx #$04
 jsr $0135
 ldx #$af
 ldy #$60
 jmp c$kernout

;--------------------
 .def c$movmf2
c$movmf2
 sta $e0
 sty $e1
 ldy #$04
lab3 lda ($e0),Y
 sta $0100,Y
 dey 
 bpl lab3
 lda #$00
 ldy #$01
 jsr c$kernin
 lda #$00
 ldx #$02
 jsr $0135
 lda #$00
 ldx #$04
 jsr $0135
 ldx #$af
 ldy #$5a
 jmp c$kernout

;--------------------
 .def c$movf1m
c$movf1m
 stx $e0
 sty $e1
 ldx #$00
 ldy #$01
 jsr c$kernin
 lda #$00
 ldx #$02
 jsr $0135
 lda #$00
 ldx #$04
 jsr $0135
 ldx #$af
 ldy #$66
 jsr c$kernout
 ldy #$04
lab4 lda $0100,Y
 sta ($e0),Y
 dey 
 bpl lab4
 rts 

;--------------------
 .def c$cnvfi
c$cnvfi

; There is probably a better fix
; but this gets the job done! (FCP)

 jsr c$kernin  ; fix 10/8/87 FCP
 ldx #$af      ; (call BASIC INT)
 ldy #$2d      ; "
 jsr c$kernout ; "
 jsr c$kernin
 ldx #$af
 ldy #$00
 jsr c$kernout ; fix 10/8/87 FCP
 ldx #$00      ; (move F1 to BNK 1)
 ldy #$01      ; "
 jsr c$movf1m  ; "
 lda $0103     ; (put into A, Y)
 ldy $0104     ; "
 rts           ; "

;--------------------
 .def c$cnvfu
c$cnvfu
 jsr c$kernin
 ldx #$af
 ldy #$0c
 jmp c$kernout

;--------------------
 .def c$cnvif
c$cnvif
 jsr c$kernin
 ldx #$af
 ldy #$03
 jmp c$kernout

;--------------------
 .def c$movf1f2
c$movf1f2
 jsr c$kernin
 ldx #$af
 ldy #$6c
 jmp c$kernout

-------------------------------------float1.obj---------------------------------
begin 600 float1.obj
M*P&I`2```*5H16^%<**OH!M,```@``"E:$5OA7"BKZ`53```J0$@``"E:$5O
MA7"BKZ`A3```J0$@``"E:$5OA7"BKZ`G3```(```HJ^@,TP``(7@A.&@!+'@
MF0`!B!#XJ0"@`2```**OH%1,``"%X(3AH`2QX)D``8@0^*D`H`$@``"I`*("
M(#4!J0"B!"`U`:*OH&!,``"%X(3AH`2QX)D``8@0^*D`H`$@``"I`*("(#4!
MJ0"B!"`U`:*OH%I,``"&X(3AH@"@`2```*D`H@(@-0&I`*($(#4!HJ^@9B``
M`*`$N0`!D>"($/A@(```HJ^@+2```"```**OH``@``"B`*`!(,``K0,!K`0!
M8"```**OH`Q,```@``"BKZ`#3```(```HJ^@;$P```$``P$-"@!#)$9!1$0`
M`0``0R1&4U5"``$2`$,D1DU53``!(@!#)$9$258``30`0R1&3D5'``%&`$,D
M1D--4``!4`!#)$U/5DU&,0`!;`!#)$U/5DU&,@`!E@!#)$U/5D8Q30`!P`!#
M)$-.5D9)``'K`$,D0TY61E4``0T*`4,D0TY6248``1<!0R1-3U9&,48R``$A
M`1P`0R1+15).24X````"`$,D2T523D]55`````\`0R1+15).24X````2`$,D
M2T523D]55````!\`0R1+15).24X````D`$,D2T523D]55````#$`0R1+15).
M24X````V`$,D2T523D]55````$,`0R1+15).24X```!&`$,D2T523D]55```
M`$T`0R1+15).24X```!B`$,D2T523D]55````&D`0R1+15).24X```!^`$,D
M2T523D]55````),`0R1+15).24X```"H`$,D2T523D]55````+T`0R1+15).
M24X```#(`$,D2T523D]55````-T`0R1+15).24X```#K`$,D2T523D]55```
M`/(`0R1+15).24X```#U`$,D2T523D]55````/P`0R1+15).24X````-"@%#
M)$M%4DY/550````4`4,D2T523DE.````%P%#)$M%4DY/550````>`4,D2T52
83DE.````(0%#)$M%4DY/550````H`0``
`
end