diff --git a/AppleII/FP MUL/Conv3p.asm b/AppleII/FP MUL/Conv3p.asm new file mode 100644 index 0000000..9cbc2c0 --- /dev/null +++ b/AppleII/FP MUL/Conv3p.asm @@ -0,0 +1,143 @@ +* @com.wudsn.ide.asm.hardware=APPLE2 +************************************ +* BASIC TO FAC TO FP1 * +* X=NUMBER * +* CALL 32768,X 768,X * +************************************ + org $8000 + +CHKCOM equ $DEBE +FRMNUM equ $DD67 +PTRGET equ $DFE3 +MOVMF equ $EB2B +MOVFM equ $EAF9 + +** Woz FP Accumulator 4 Byte + 1 Byte Extra + 1 Byte SIGN** +FP1 equ $FA ;Translate F8 --> FA +E equ $FE ;Translate FC --> FE +SIGN equ $EB + +FP2 equ $EC + +** Applesoft FP Accumulator 5 Byte + 1 Byte Sign ** +FAC equ $9D + +RSLT equ $7000 + + *************************** + +ENTRY1 jsr CHKCOM + jsr FRMNUM ;VARIABLE X ->FAC (6 Byte Unpacked) + +** FPC to FP1 conversion ** + + lda FAC + dec A ; dec the EXP + sta FP1 + sta FP2 ; Copy + + lda FAC+5 + bmi NEG ; chk the Hi bit of 1 byte Mantissa + +POS clc ; Hi bit 0 for negative + lda FAC+5 + + ora #$80 ; Set Hi Bit 1 byte Mantissa (change Sign only if is positive) + ror ; Didide for 2^1 + + sta FP1+1 + sta FP2+1 ; Copy + + jmp CONT + +NEG clc ; Hi bit 1 for positive + lda FAC+5 + + ror ; Didide for 2^1 + + eor #$FF ; One's complement, NOT + clc + adc #01 ; Two's complement, +1 + + sta FP1+1 + sta FP2+1 ; Copy + +CONT lda FAC+2 + ror + sta FP1+2 + sta FP2+2 ; Copy + + lda FAC+3 + ror + sta FP1+3 + sta FP2+3 ; Copy FP2=FP1 X2=X1 + + lda FAC+4 + ror + sta E + + ;brk + rts + +************************************ +* FP1 TO FAC TO BASIC * +* CALL 32831,Y 831,Y * +* PRINT Y * +************************************ + +* +** FP1 to FAC conversion ** +* +ENTRY2 lda RSLT ; X1 1 Byte --> 9D FAC + inc A ; 2^(FP1+1) inc EXP + sta FAC + + lda RSLT+1 + bmi NEG2 ; chk the Hi bit of 1 byte Mantissa + + +POS2 clc + lda RSLT+1 ; M1 Hi 2 Byte --> 9E FAC + rol ; Multiply for 2^1 + + ora #$80 ; Set Hi Bit 1 byte Mantissa (change Sign only if is positive) + sta FAC+1 ; To 6^ Byte of FAC Unpacked + + ;sta FAC+5 ; To 1^ Byte Mantissa of FAC UnPacked + jmp CONT2 + +NEG2 lda RSLT+1 + + sec + sbc #01 ; One's complement inv -1 + eor #$FF ; Two's complement inv NOT + + rol ; Multiply for 2^1 + + sta FAC+1 ; To 1^ Byte Mantissa of FAC Packed + sta FAC+5 ; To 6^ Byte of FAC Unpacked + + +CONT2 lda RSLT+2 ; M1 3 Byte --> 9F FAC + rol + sta FAC+2 + + lda RSLT+3 ; M1 Lo 4 Byte --> A0 FAC + rol + sta FAC+3 + + lda E ; Extra 5 Byte --> A1 FAC + rol + sta FAC+4 + + ;brk + *************************** +* + jsr CHKCOM + jsr PTRGET ; Return the Y and A pointing to the specific variabile + tax + jsr MOVMF ;FAC->VARIABLE Y (5 Bytes Packed) + + ;brk + rts + chk \ No newline at end of file diff --git a/AppleII/FP MUL/UNI5.BAS b/AppleII/FP MUL/UNI5.BAS new file mode 100644 index 0000000..a786a61 --- /dev/null +++ b/AppleII/FP MUL/UNI5.BAS @@ -0,0 +1,13 @@ + 2 PRINT CHR$ (4);"BLOAD UNIDRIVE4P" + 5 PRINT CHR$ (4);"BLOAD CONV3P" + 6 X = 1 + 10 CALL 32768,X + 15 CALL 24576 + 17 PRINT CHR$ (4);"BLOAD UNIDRIVE4P2" + 18 HGR2 : HCOLOR= 3 + 20 FOR X = - 10 TO 10 STEP .2 + 25 CALL 32768,X + 30 CALL 24576 + 35 CALL 32831,Y + 40 HPLOT X * 5 + 140,Y + 10 + 50 NEXT \ No newline at end of file diff --git a/AppleII/FP MUL/Unidrive4p.asm b/AppleII/FP MUL/Unidrive4p.asm new file mode 100644 index 0000000..3064f2a --- /dev/null +++ b/AppleII/FP MUL/Unidrive4p.asm @@ -0,0 +1,519 @@ +* +* Unidisk 3.5 Driver +* +* The target of this project is to use the Unidisk 3.5 drive to perform +* specific numerical routines (integers and floating point numbers) +* calculation in order to use it as a Apple II co-processor unit. +* +* Copyright (C) 2015 Riccardo Greco . +* +* This program is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* You should have received a copy of the GNU General Public License +* along with this program. If not, see . +* +* +* @com.wudsn.ide.asm.hardware=APPLE2 +* +* Protocol Converter Call + XC +ZPTempL equ $0006 ;Temporary zero page storage +ZPTempH equ $0007 +** Zero page storage ** +N1 equ $FA ;25 4 Byte FP FA--FD (FP1) +N2 equ $EC ;27 4 Byte FP EC--EF (FP2) +RSLT equ $7000 ;29 +*** Monitor routines *** +COut equ $FDED ;Console output ASCII +CROut equ $FD8E ;Carriage return +** Command Code ** +StatusCmd equ 0 +** Status Code ** +* StatusDIB equ 3 +StatusUNI equ 5 +* +ControlCmd equ 4 +** Control Codes ** +Eject equ 4 +Run equ 5 +SetDWLoad equ 6 +DWLoad equ 7 +* + org $6000 +***************************************************** + +* +* Find a Protocol Converter in one of the slots. +START jsr FindPC + bcs Error +*** Eject *** + jsr Dispatch + dfb ControlCmd + dw E_JECT +*** Set Address *** + jsr Dispatch + dfb ControlCmd + dw SET_ADD +* + jsr EXEC ; Jump the Error routine + rts +********************************************* +Error equ * +* +* There is either no PC around, or there was no give message +* + ldx #0 +err1 equ * + lda Message,x + beq errout + jsr COut + inx + bne err1 +* +errout equ * + rts +* +Message asc 'NO PC OR NO DEVICE' + dfb $8D,0 +********************************************* +* + +** Set the Input Value first in Dynamic data ** + ** 4 Byte N1 to FP1 ** +EXEC lda N1 ;X1 + sta $6238 ; Absolute addressing + lda N1+1 ;M1 (1) + sta $6239 + lda N1+2 ;M1 (2) + sta $623A + lda N1+3 ;M1 (3) + sta $623B + + ** 4 Byte N2 to FP2 ** + lda N2 ;X2 + sta $623C + lda N2+1 ;M2 (1) + sta $623D + lda N2+2 ;M2 (2) + sta $623E + lda N2+3 ;M2 (3) + sta $623F + +*** Download *** + jsr Dispatch + dfb ControlCmd + dw DOWNLOAD +** Set Unidisk Registers ** +* ;First time execution + lda #$00 ; Target the first time entry point + sta LowPC_reg ; First time set init value of PC, just for the next execution +* The program begin to PC preset to $0500 * +* +** Execute ** + jsr Dispatch + dfb ControlCmd + dw EXE +** Read ** +READ jsr Dispatch + dfb StatusCmd + dw DParms + bcs Error +* +**** Store Output results in //c **** + +* First time execute * + lda UNIAcc_reg + sta RSLT + lda UNIX_reg + sta RSLT+1 ; Store the result + lda UNIY_reg + sta RSLT+2 + +** Second time execute ** + lda #$3C ; Target the secont time entry point + sta LowPC_reg ; Second time set new value of PC +** Execute ** + jsr Dispatch + dfb ControlCmd + dw EXE +** Read ** + jsr Dispatch + dfb StatusCmd + dw DParms +* bcs Error + +* Second time execute only to read the latest Byte of FP1* + lda UNIAcc_reg + sta RSLT+3 +* + rts + +****************************************************** +FindPC equ * +* +* Search slot 7 to slot 1 looking for signature bytes +* + ldx #7 ;Do for seven slots + lda #$C7 + sta ZPTempH + lda #$00 + sta ZPTempL +* +newslot equ * + ldy #7 +* +again equ * + lda (ZPTempL),y + cmp sigtab,y ;One for byte signature + beq maybe ;Found one signature byte + dec ZPTempH + dex + bne newslot +* +* if we get here, no PC find + sec + rts +* +* if we get here, no byte find on PC +maybe equ * + dey + dey ;if N=1 then all sig bytes OK + bpl again +* Found PC interface. Set up call address. +* we already have high byte ($CN), we need low byte +* +foundPC equ * + lda #$FF + sta ZPTempL + ldy #0 ;For indirect load + lda (ZPTempL),y ;Get the byte +* +* Now the Acc has the low oreder ProDOS entry point. +* The PC entry is three locations past this ... +* + clc + adc #3 + sta ZPTempL +* +* Now ZPTempL has PC entry point. +* Return with carry clear. +* + clc + rts +*********************************************************** +* +* There are the PC signature bytes in their relative order. +* The $FF bytes are filler bytes and are not compared. +* +sigtab dfb $FF,$20,$FF,$00 + dfb $FF,$03,$FF,$00 +* +Dispatch equ * + jmp (ZPTempL) ;Simulate an indirect JSR to PC +* +*** Status Parameter Set for UNI *** +DParms equ * +DPParmsCt dfb 3 ;Status calls have three parameters +DPUnit dfb 1 +DPBuffer dw UNI +DPStatCode dfb StatusUNI +* +* +* +*** Status List UNI *** +UNI equ * + dfb 0 +UNIError dfb 0 +UNIRetries dfb 0 +UNIAcc_reg dfb 0 +UNIX_reg dfb 0 +UNIY_reg dfb 0 +UNIP_val dfb 0 +HHH dfb 0 +* +*** Set Address *** +SET_ADD equ * + dfb 3 + dfb 1 + dw CNTL_LIST3 + dfb SetDWLoad +* +*** Download *** +DOWNLOAD equ * + dfb 3 + dfb 1 + dw CNTL_LIST4 + dfb DWLoad +* +*** Execute *** +EXE equ * + dfb 3 + dfb 1 + dw CNTL_LIST2 + dfb Run +*** Eject *** +E_JECT equ * + dfb 3 + dfb 1 + dw CNTL_LIST1 + dfb Eject +* +******** CONTROL LISTS ******** +* +* +*** Eject *** +CNTL_LIST1 equ * + dw $0000 +* +*** Execute *** +CNTL_LIST2 equ * +Clow_byte dfb $06 +Chigh_byte dfb $00 +AccValue dfb $00 ; Init Value Unidisk Accumulator Register +X_reg dfb $00 ; Init Value Unidisk X Register +Y_reg dfb $00 ; Init Value Unidisk Y Register +ProStatus dfb $00 ; Init Value Unidisk Status Register +LowPC_reg dfb $00 ; Init Value Unidisk Program Counter $0500 at eny dowload +HighPC_reg dfb $05 ; $05 first execution, $3C second execution +* +*** Set Address *** +CNTL_LIST3 equ * +CountL_byte dfb $02 +CountH_byte dfb $00 +LByte_Addr dfb $00 ; ORG of Unidisk program, set begin program address $0500 +HByte_Addr dfb $05 +* +*** Download *** +CNTL_LIST4 equ * +LenghtL_byte dfb $34 ;<----- Lenght of Unidisk program Lo - Byte 312 byte +LenghtH_byte dfb $01 ;<----- Lenght of Unidisk program Hi Byte +* +**************** Start UNIDISK Program **************** +* + org $0500 ; Start Unidisk program address + +SIGN EQU $C0 ;$EB ; $F3 + + ** FP2 4 Bytes ** +X2 EQU $C1 ;$EC ; $F4 +M2 EQU $C2 ;$ED ; $F5 - $F7 + + ** FP1 4 Bytes + E extension ** +X1 EQU $C5 ;$FA ; $F8 +M1 EQU $C6 ;$FB ; $F9 - $FB +E EQU $C9 ;$FE ; $FC + +OVLOC EQU $C10 ;$3F5 ;Overflow routine is not implemented at now) + +* +** Main program ** +* +** Input data to Zero Page ** + + ** FP1 ** + lda FP1 + sta X1 + + lda FP1+1 + sta M1 + lda FP1+2 + sta M1+1 + lda FP1+3 + sta M1+2 + + ** FP2 ** + lda FP2 + sta X2 + + lda FP2+1 + sta M2 + lda FP2+2 + sta M2+1 + lda FP2+3 + sta M2+2 + +************************** Target Function *********************** +* Y=N1+N2 * +****************************************************************** +* +** Simple ADD ** + jsr FMUL ;FADD ; Call FP routine + +*** Output Data result FP1 to Unidisk registers First Time first 3 Byte out *** + lda X1 + ldx M1 + ldy M1+1 + + rts +*** Output Data result FP1 to Unidisk registers Second Time latest 1 Byte out *** +SECOND lda M1+2 ; Entry point by Program Counter set + + rts +*************************************************** +* +***************** FP Routine ***************** +* + *********************** + * * + * APPLE-II FLOATING * + * POINT ROUTINES * + * * + * COPYRIGHT 1977 BY * + * APPLE COMPUTER INC. * + * * + * ALL RIGHTS RESERVED * + * * + * S. WOZNIAK * + * * + *********************** +* TITLE "FLOATING POINT ROUTINES for Unidisk memory" +* + +ADD CLC ;CLEAR CARRY + LDX #$2 ;INDEX FOR 3-BYTE ADD. +ADD1 LDA M1,X + ADC M2,X ;ADD A BYTE OF MANT2 TO MANT1 + STA M1,X + DEX ;INDEX TO NEXT MORE SIGNIF. BYTE. + BPL ADD1 ;LOOP UNTIL DONE. + RTS ;RETURN +MD1 ASL SIGN ;CLEAR LSB OF SIGN. + JSR ABSWAP ;ABS VAL OF M1, THEN SWAP WITH M2 +ABSWAP BIT M1 ;MANT1 NEGATIVE? + BPL ABSWAP1 ;NO, SWAP WITH MANT2 AND RETURN. + JSR FCOMPL ;YES, COMPLEMENT IT. + INC SIGN ;INCR SIGN, COMPLEMENTING LSB. +ABSWAP1 SEC ;SET CARRY FOR RETURN TO MUL/DIV. +SWAP LDX #$4 ;INDEX FOR 4 BYTE SWAP. +SWAP1 STY E-1,X + LDA X1-1,X ;SWAP A BYTE OF EXP/MANT1 WITH + LDY X2-1,X ;EXP/MANT2 AND LEAVE A COPY OF + STY X1-1,X ;MANT1 IN E (3 BYTES). E+3 USED + STA X2-1,X + DEX ;ADVANCE INDEX TO NEXT BYTE + BNE SWAP1 ;LOOP UNTIL DONE. + RTS ;RETURN +FLOAT LDA #$8E ;INIT EXP1 TO 14, <--------------- int to fp + STA X1 ;THEN NORMALIZE TO FLOAT. +NORM1 LDA M1 ;HIGH-ORDER MANT1 BYTE. + CMP #$C0 ;UPPER TWO BITS UNEQUAL? + BMI RTS1 ;YES, RETURN WITH MANT1 NORMALIZED + DEC X1 ;DECREMENT EXP1. + ASL M1+2 + ROL M1+1 ;SHIFT MANT1 (3 BYTES) LEFT. + ROL M1 +NORM LDA X1 ;EXP1 ZERO? + BNE NORM1 ;NO, CONTINUE NORMALIZING. +RTS1 RTS ;RETURN. +FSUB JSR FCOMPL ;CMPL MANT1,CLEARS CARRY UNLESS 0 <---- sub +SWPALGN JSR ALGNSWP ;RIGHT SHIFT MANT1 OR SWAP WITH +FADD LDA X2 ;<------------------------------------- add + CMP X1 ;COMPARE EXP1 WITH EXP2. + BNE SWPALGN ;IF #,SWAP ADDENDS OR ALIGN MANTS. + JSR ADD ;ADD ALIGNED MANTISSAS. +ADDEND BVC NORM ;NO OVERFLOW, NORMALIZE RESULT. + BVS RTLOG ;OV: SHIFT M1 RIGHT, CARRY INTO SIGN +ALGNSWP BCC SWAP ;SWAP IF CARRY CLEAR, + * ELSE SHIFT RIGHT ARITH. +RTAR LDA M1 ;SIGN OF MANT1 INTO CARRY FOR + ASL ;RIGHT ARITH SHIFT. +RTLOG INC X1 ;INCR X1 TO ADJUST FOR RIGHT SHIFT + BEQ OVFL ;EXP1 OUT OF RANGE. +RTLOG1 LDX #$FA ;INDEX FOR 6:BYTE RIGHT SHIFT. +ROR1 ROR E+3,X + INX ;NEXT BYTE OF SHIFT. + BNE ROR1 ;LOOP UNTIL DONE. + RTS ;RETURN. +FMUL JSR MD1 ;ABS VAL OF MANT1, MANT2 <-------------- mul + ADC X1 ;ADD EXP1 TO EXP2 FOR PRODUCT EXP + JSR MD2 ;CHECK PROD. EXP AND PREP. FOR MUL + CLC ;CLEAR CARRY FOR FIRST BIT. +MUL1 JSR RTLOG1 ;M1 AND E RIGHT (PROD AND MPLIER) + BCC MUL2 ;IF CARRY CLEAR, SKIP PARTIAL PROD + JSR ADD ;ADD MULTIPLICAND TO PRODUCT. +MUL2 DEY ;NEXT MUL ITERATION. + BPL MUL1 ;LOOP UNTIL DONE. +MDEND LSR SIGN ;TEST SIGN LSB. +NORMX BCC NORM ;IF EVEN,NORMALIZE PROD,ELSE COMP +FCOMPL SEC ;SET CARRY FOR SUBTRACT. <--------------- not + LDX #$3 ;INDEX FOR 3 BYTE SUBTRACT. +COMPL1 LDA #$0 ;CLEAR A. + SBC X1,X ;SUBTRACT BYTE OF EXP1. + STA X1,X ;RESTORE IT. + DEX ;NEXT MORE SIGNIFICANT BYTE. + BNE COMPL1 ;LOOP UNTIL DONE. + BEQ ADDEND ;NORMALIZE (OR SHIFT RT IF OVFL). +FDIV JSR MD1 ;TAKE ABS VAL OF MANT1, MANT2. <--------- div + SBC X1 ;SUBTRACT EXP1 FROM EXP2. + JSR MD2 ;SAVE AS QUOTIENT EXP. +DIV1 SEC ;SET CARRY FOR SUBTRACT. + LDX #$2 ;INDEX FOR 3-BYTE SUBTRACTION. +DIV2 LDA M2,X + SBC E,X ;SUBTRACT A BYTE OF E FROM MANT2. + PHA ;SAVE ON STACK. + DEX ;NEXT MORE SIGNIFICANT BYTE. + BPL DIV2 ;LOOP UNTIL DONE. + LDX #$FD ;INDEX FOR 3-BYTE CONDITIONAL MOVE +DIV3 PLA ;PULL BYTE OF DIFFERENCE OFF STACK + BCC DIV4 ;IF M2 +* +* The target of this project is to use the Unidisk 3.5 drive to perform +* specific numerical routines (integers and floating point numbers) +* calculation in order to use it as a Apple II co-processor unit. +* +* Copyright (C) 2015 Riccardo Greco . +* +* This program is free software: you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* You should have received a copy of the GNU General Public License +* along with this program. If not, see . +* +* +* @com.wudsn.ide.asm.hardware=APPLE2 + XC +** CHKSUM Pointer * +PTR equ $08 +** Protocol Converter Call +ZPTempL equ $0006 ;Temporary zero page storage +ZPTempH equ $0007 +** Zero page storage ** +N1 equ $FA ;25 4 Byte FP FA--FD (FP1) +N2 equ $EC ;27 4 Byte FP EC--EF (FP2) +RSLT equ $7000 ;29 +*** Monitor routines *** +COut equ $FDED ;Console output ASCII +CROut equ $FD8E ;Carriage return +** Command Code ** +StatusCmd equ 0 +** Status Code ** +StatusUNI equ 5 +* +ControlCmd equ 4 +** Control Codes ** +Run equ 5 +SetDWLoad equ 6 +DWLoad equ 7 +* + org $6000 +***************************************************** +************** CHKSUM MAIN Routine ****************** +* +;STARTCHK lda #STARTCHK +; sta PTR+1 +; ldy #$00 +; lda #$00 +; pha +;LOOP pla +; eor (PTR),y +; pha +; inc PTR +; bne CHK +; inc PTR+1 +;CHK lda PTR+1 +; cmp #>PROGEND +; bcc LOOP +; lda PTR +; cmp #