; from CPMUG010.ARK and CPMUG002.ARK., 
; compressed versions of CPMUG disks 10 and 2 respectively
; Lawrence Livermore Labs Floating Point BASIC
; "MCS8" refers to Intel 8008 development system
;
; details at http://www.retrotechnology.com/dri/LLNL_cpm.html
; Herb Johnson Aug 2012
;
;###S
;MODIFIED BY TONY GOLD FOR NON-MACR0 ASSEMBLER
;CHANGES WITHIN ;###S AND ;###E LINES
;ALL ORIGINAL CODE RETAINED AS COMMENTS
;###E
;
 ;       ////FLOATING POINT PACKAGE FOR THE MCS8
 ;       ////BY DAVID MEAD
 ;       ////MODIFIED BY HAL BRAND 9/6/74
 ;       ////MODIFIED FOR 24 BIT MANTISSAS***********
 ;       ////PLUS ADDED I/O CONVERSION ROUTINES
 ;       ////NEW ROUTINE COMMENTS
 ;       ////ARE PRECEEDED BY /
 ;       ////OTHER CHANGES ARE NOTED BY **
;        ////MODIFIED BY FRANK OLKEN 6/28/75
 ;
 ;
;###S
;	EQUATES FOR RELOCATED PACKAGES
	ORG	10DDH
INTERP:	EQU	0100H
FPTBL:	EQU	1774H
IOJUMP:	EQU	1900H
CONIN:	EQU	IOJUMP+4
STATUS:	EQU	IOJUMP+0AH
INP:	EQU	FPTBL+33H
OUTR:	EQU	FPTBL+36H
OUTL:	EQU	INTERP+7D9H
INL:	EQU	INTERP+996H
;         ORG 110000Q
 ;
 ;
CPM:	EQU	5
;CONIN     EQU    404Q        ; JMP TABLE LOCATION OF CONSOLE INP.
;STATUS    EQU    412Q        ; JMP TABLE LOC. FOR STATUS PORT INPUT
;OUTR      EQU    113775Q            ;LINK TO BASIC
;OUTL      EQU    103726Q
;INL       EQU    104623Q
;INP       EQU    113772Q            ;LINK TO BASIC
;###E
MINCH     EQU    300Q        ;MINIMUM CHARACTERISTIC WITH SIGN EXTENDED
MAXCH     EQU    077Q        ;MAXIMUM CHARACTERISTIC WITH SIGN EXTENDED
 ;
;******************************************************
 ;       //// SUBTRACTION SUBROUTINE
 ;******************************************************
 ;
 ;
 LSUB:   MVI A,200Q        ;/****SET UP TO SUBTRACT
 ;                       SUBROUTINE LADS
 ;                       FLOATING POINT ADD OR SUB
 ;                       A[128 ON ENTRY[SUB
 ;                       A[0 ON ENTRY[ADD
 ;                       F-S[F,FIRST OPER DESTROYED
 ;                       BASE \11 USED FOR SCRATCH
 LADS:   CALL ACPR         ;SAVE ENTRY PNT AT BASE \6
         CALL    BCHK        ;CHECK ADDEND/SUBTRAHEND = ZERO
         RZ                  ;IF SO, RESULT=ARG SO RETURN
                             ;THIS WILL PREVENT UNDERFLOW INDICATION ON
                             ;ZERO + OR - ZERO
         CALL CCMP
         JZ  EQ02          ;IF EQUAL, GO ON
         MOV D,A           ;SAVE LPTR CHAR IN D
         JC  LLTB
         SUB E             ;L.GT.B IF HERE
         ANI 127
         MOV D,A           ;DIFFERENCE TO D
         MOV E,L           ;SAVE BASE IN E
         MOV L,C           ;C PTR TO L
         INR L             ;C PTR\1 TO L
         MOV M,E           ;SAVE BASE IN C PTR\1
         MOV L,B           ;B PTR TO L
         JMP NCHK
 LLTB:   MOV A,E           ;L.LT.B IF HERE,BPTR TO A
         SUB D             ;SUBTRACT LPTR CHAR FROM BPTR CHAR
         ANI 127
         MOV D,A           ;DIFFERENCE TO D
 NCHK:   MVI A,24
         CMP D
         JNC SH10
         MVI D,24
 SH10:   ORA A
         CALL DRST
         DCR D
         JNZ SH10
 EQUL:   MOV A,L
         CMP B
         JNZ EQ02          ;F.GT.S IF L.NE.B
         MOV L,C           ;C PTR TO L
         INR L             ;C PTR\1 TO L
         MOV L,M           ;RESTORE L
 EQ02:   CALL LASD         ;CHECK WHAT TO
         CALL ACPR         ;SAVE ANSWER
         CPI 2             ;TEST FOR ZERO ANSWER
         JNZ NOT0
         JMP     WZER        ;WRITE FLOATING ZERO AND RETURN
;
 NOT0:   MVI D,1           ;WILL TEST FOR SUB
         ANA D
         JZ  ADDZ          ;LSB[1 INPLIES SUB
         CALL TSTR         ;CHECK NORMAL/REVERSE
         JZ  SUBZ          ;IF NORMAL,GO SUBZ
         MOV A,L           ;OTHERWISE REVERSE
         MOV L,B           ;ROLES
         MOV B,A           ;OF L AND B
;
SUBZ:    CALL    DSUB        ;SUBTRACT SMALLER FROM BIGGER
         CALL    MANT        ;SET UP SIGN OF RESULT
         CALL    TSTR        ;SEE IF WE NEED TO INTERCHANGE
                             ;BPTR AND LPTR
         JZ      NORM        ;NO INTERCHANGE NECESSARY, SO NORMALIZE
                             ;AND RETURN
         MOV A,L           ;INTERCHANGE
         MOV L,B           ;L
         MOV B,A           ;AND B
         MOV A,C           ;CPTR  TO A
         MOV C,B           ;BPTR TO C
         MOV E,L           ;LPTR TO E
         MOV B,A           ;CPTR TO B
         CALL LXFR         ;MOVE_BPTR> TO _LPTR>
         MOV A,B
         MOV B,C
         MOV C,A
         MOV L,E
         JMP     NORM        ;NORMALIZE RESULT AND RETURN
;
;   COPY THE LARGER CHARACTERISTIC TO THE RESULT
;
ADDZ:    CALL    CCMP        ;COMPARE THE CHARACTERISTICS
         JNC     ADD2        ;IF CHAR(H,L) .GE. CHAR(H,B) CONTINUE
         CALL    BCTL        ;IF CHAR(H,L) .LT. CHAR(H,B) THE COPY
                             ;CHAR(H,B) TO CHAR(H,L)
ADD2:    CALL    MANT        ;COMPUTE SIGN OF RESULT
         CALL    DADD        ;ADD MANTISSAS
          JNC    SCCFG            ;IF THERE IS NO OVFLW - DONE
         CALL    DRST        ;IF OVERFLOW SHIFT RIGHT
         CALL    INCR        ;AND INCREMENT CHARACTERISTIC
         RET                 ;ALL DONE, SO RETURN
;
;   THIS ROUTINE STORES THE MANTISSA SIGN IN THE RESULT
;   THE SIGN HAS PREVIOUSLY BEEN COMPUTED BY LASD.
;
 MANT:   MOV E,L           ;SAVE L PTR
         MOV L,C           ;C PTR TO L
         MOV A,M           ;LOAD INDEX WORD
         ANI 128           ;SCARF SIGN
         MOV L,E           ;RESTORE L PTR
         INR L             ;L PTR\2
         INR L
         INR L             ;TO L
         MOV E,A           ;SAVE SIGN IN E
         MOV A,M
         ANI 127           ;SCARF CHAR
         ADD E             ;ADD SIGN
         MOV M,A           ;STORE IT
         DCR L             ;RESTORE
         DCR L
         DCR L             ;L PTR
         RET
;
;
 ;                       SUBROUTINE LASD
 ;                       UTILITY ROUTINE FOR LADS
 ;                       CALCULATES TRUE OPER AND SGN
 ;                       RETURNS ANSWER IN
 LASD:   CALL MSFH         ;FETCH MANT SIGNS, F IN A,D
         CMP E             ;COMPARE SIGNS
         JC  ABCH          ;F\,S- MEANS GO TO A BRANCH
         JNZ BBCH          ;F- S\ MEANS GO TO B BRANCH
         ADD E             ;SAME SIGN IF HERE, ADD SIGNS
         JC  BMIN          ;IF BOTH MINUS, WILL OVERFLOW
         CALL AORS         ;BOTH POS IF HERE
         JP  L000          ;IF AN ADD, LOAD 0
 COM1:   CALL DCMP         ;COMPARE F WITH S
         JC  L131          ;S.GT.F,SO LOAD 131
         JNZ L001          ;F.GT.S,SO LOAD 1
 L002:   MVI A,2           ;ERROR CONDITION, ZERO ANSWER
         RET
 BMIN:   CALL AORS         ;CHECK FOR ADD OR SUB
         JP  L128          ;ADD, SO LOAD 128
 COM2:   CALL DCMP         ;COMPARE F WITH S
         JC  L003          ;S.GT.F,SO LOAD 3
         JNZ L129          ;FGT.S.SO LOAD 129
         JMP L002          ;ERROR
 ABCH:   CALL AORS         ;FT,S- SO TEST FOR A/S
         JM  L000          ;SUBTRACT, SO LOAD 0
         JMP COM1          ;ADD, SO GO TO DCMP
 BBCH:   CALL AORS         ;F-,S\,SO TEST FOR A/S
         JM  L128          ;SUB
         JMP COM2          ;ADD
 L000:   XRA A
         RET
 L001:   MVI A,1
         RET
 L003:   MVI A,3
         RET
 L128:   MVI A,128
         RET
 L129:   MVI A,129
         RET
 L131:   MVI A,131
         RET
 ;