
;;; This is a 1K Floating-Point Concentric Circle Grapher for the 8008
;;; written in March 2013 by Mark G. Arnold. 
;;; It is intended to be an example for other 1K graphing routines
;;; (e.g., Mandelbrot), but this one seems about the easiest
;;; "interesting" picture to generate with FP arithmetic.
 
;;; The Floating point routines were taken from
;;; SCELBAL by Mark G. Arnold (MGA) and Nat Wadsworth  
;;;
;;;  Copyright 1975 Scelbi Computer Consulting, Inc.
;;;  All rights reserved
;;;
;;; MGA gives permission to use SCELBAL for 
;;; educational, historical, non-commercial purposes.
;;; Versions of this have been circulating on the web since
;;; about 2000; this version is authorized by MGA (Mar 2012)
;;; with the understanding no warranty is expressed or implied.
;;; As stated in the original, "no responsibility is assumed for
;;; for inaccuracies or for the success or failure of
;;; various applications to which the information herein
;;; may be applied."
;;; 
;;; SCELBAL is the only open-source, floating-point 
;;; high-level language ever implemented on Intel's first
;;; general-purpose microprocessor, the 8008.  It was
;;; published in book form:
;;;
;;;  SCELBAL: A Higher-Level Language for 8008/8080 Systems
;;;
;;;
;;; This version is modified to assemble with the
;;; as8 assembler (using the -octal option) 
;;; for the Intel 8008 by Thomas E. Jones.
;;; 
;;; This comment must be incorporated with any version of SCELBAL
;;; downloaded, distributed, posted or disemenated.
	

;;; Here is the label originally attempting to make the code
;;; relocatable.  
	
OLDPG1:		EQU	000#000


;;; because only a little of the original SCELBAL data on page 1 is needed by this
;;; program, it has been relocated to page zero;  The first part of
;;; Page zero will contain the output Routines.  


; THE Following allow this to run with the simulator "8008.c"
;INPORT:	EQU 2
;OUTPORT: EQU 10

; The following are what would be needed to run on actual Scelbi-8H hardware:
INPORT:	EQU 5
OUTPORT: EQU 016



CRLF:      LAI 215                ;Load ASCII code for carriage-return into ACC
           CAL ECHO               ;Call user provided display driver subroutine
           LAI 212                ;Load ASCII code for line-feed into ACC

;;; This is the Scelbi RSTX Driver Program from 2013 
;;; by Mike Willegal 


;;; timing designed for 2400 baud, 8 bit data



;;; HERE IS THE USER DEFINED OUTPUT CHARACTER ROUTINE FOR A SERIAL PORT
;	input in A
;	destroys B

ECHO:
	NDI     177		; clear carry bit and MSB (make output true ASCII) if 8 bit binary, change mask
	RAL			; shift carry to LSB (save MSB in carry)
	OUT OUTPORT		; output zero, as start bit
	RAR			; shift data bits back into place

	LAA			; delay to make timing work
	LAA
	LBI	2		; delay counter
	CAL 	MORE2		
	CAL 	BITOUT		; LSB
	CAL 	BITOUT		; 1
	CAL 	BITOUT		; 2
	CAL 	BITOUT		; 3
	CAL 	BITOUT		; 4
	CAL 	BITOUT		; 5
	CAL 	BITOUT		; 6
	CAL 	BITOUT		; MSB
	LBA			; timing delay
	LAI 	001
	OUT 	OUTPORT		; stop bit
	LBI 	5
	JMP 	MORE2

BITOUT:	
	OUT 	OUTPORT
	RRC			; shift to get next bit
	LBI 	3
MORE2:
	LAA			; nop to delay 5 states to make timing work
	DCB
	JFZ 	MORE2
	LBI	0		; delay 8 states
	RET



;;        ORG 000#100  ; entry point to "8008.c" simulator (same entry as SCELBAL)
;;        JMP CONCIRC


;;; Page one of SCELBAL has many constants and variables, of which the following are
;;; needed here:
	
	ORG 000#100
	;DATA 000,000		; SIGN INDICATOR
	;DATA 000		; BITS COUNTER
; the above data will overwrite the JMP CONCIRC

	DATA 000,000		; SIGN INDICATOR
	DATA 000		; INPUT DIGIT COUNTER
	DATA 000		; TEMP STORATE
	DATA 000		; OUTPUT DIGIT COUNTER
	DATA 000 		; FP MODE INDICATOR
	DATA *7			; NOT ASSIGNED (SHOULD BE 01 111-117)
	DATA 000,000,000,000	; FPACC EXTENSION
	DATA 000,000,000,000	; FPACC LSW, NSW, MSW, EXPONENT
	DATA 000,000,000,000	; FPOP  Extension
	DATA 000,000,000,000	; FPOP  LSW, NSW, MSW, EXPONENT
	DATA 000,000,000,000	; FLOATING POINT WORKING AREA
	DATA 000,000,000,000	; (SHOULD BE AT 01 140-01-167)
	DATA 000,000,000,000
	DATA 000,000,000,000
	DATA 000,000,000,000
	DATA 000,000,000,000
	DATA *8			; NOT ASSIGNED (SHOULD BE 01 170-01 177)
	DATA 000,000,000,000	; TEMPORARY REGISTER STORAGE AREA (D,E,H&L)
	DATA *4			; NOT ASSIGNED (01 204-01 207)
	DATA 000,000,120,004	; STORES FLOATING POINT CONSTANT +10.0
	DATA 147,146,146,375	; STORES FLOATING POINT CONSTANT +0.1
	DATA 000		; GETINP COUNTER

;  next are the plotting variables:
	
X1: DATA 0,0,0,0
Y1: DATA 0,0,0,0
;X:  DATA 0,0,0,0
;Y:  DATA 0,0,0,0
T:  DATA 0,0,0,0
;
;  these are chosen to make nice picture (esp. for Mandelbrot, but also for circles)
;   
STEPY:     DATA 147,146,146,375	; STORES FLOATING POINT CONSTANT +0.1
STEPX:     DATA 147,146,146,374	; STORES FLOATING POINT CONSTANT +0.05
STARTY:    DATA 000,000,300,001	; STORES FLOATING POINT CONSTANT -1.0
STARTX:    DATA 000,000,300,002	; STORES FLOATING POINT CONSTANT -2.0
;
CNTX: DATA 000 ;integer controls how mnay times X1 loop executes 
CNTY: DATA 000 ;integer controls how many times Y1 loop executes 

; here is pseudo-code for the plotting driver routine 
;
;  FOR Y1=-1 TO 1 STEP 0.1
;    PRINT ascii code letter corresponding to row 
;    FOR X1=-2.0 TO 1 STEP 0.05
;     IF floating-point-exponent(X*X+Y*Y) is odd THEN PRINT " ";
;                                                ELSE PRINT "*";
;    NEXT X1
;    PRINT
;  NEXT Y1
;

;  most of the LHIs could probably be eliminated because 
;  all the data is on the same page
	
CONCIRC:        
           LLI \LB\STARTY   ;  Y1=STARTY
           LHI \HB\STARTY
           CAL FLOAD
           LLI \LB\Y1
           LHI \HB\Y1
           CAL FSTORE
           LLI \LB\CNTY      ; CNTY = 21
           LHI \HB\CNTY
           LMI 025
Y1LOOP:
            LAM              ; print chr(64+CNTY)
           ADI 300
           CAL ECHO

           LLI \LB\STARTX    ;  X1 = STARTX
           LHI \HB\STARTX
           CAL FLOAD
           LLI \LB\X1
           LHI \HB\X1
           CAL FSTORE
           LLI \LB\CNTX     ; cntx = 61
           LHI \HB\CNTX
           LMI 075
X1LOOP:
           LLI \LB\X1       ; COMPUTE X1*X1+Y1*Y1
           LHI \HB\X1
           CAL FLOAD
           LLI \LB\X1
           LHI \HB\X1
           CAL OPLOAD
           CAL FPMULT
           LLI \LB\T
           LHI \HB\T
           CAL FSTORE
           LLI \LB\Y1
           LHI \HB\Y1
           CAL FLOAD
           LLI \LB\Y1
           LHI \HB\Y1
           CAL OPLOAD
           CAL FPMULT
           LLI \LB\T
           LHI \HB\T
           CAL OPLOAD
           CAL FPADD
           LLI 127         ; get FP exponent
           LHI \HB\OLDPG1 
           LAM
           NDI 001         ;check if it is odd or even
           LAI 240  ; ' '
           JFZ MANDONE     ;if odd print " " 
           LAI 252  ; '*'  ;otherwise, print "*"
MANDONE:
           CAL ECHO
 
           LLI \LB\X1      ; X1 = X1 + STEPX
           LHI \HB\X1
           CAL FLOAD
           LLI \LB\STEPX
           LHI \HB\STEPX
           CAL OPLOAD 
           CAL FPADD
           LLI \LB\X1
           LHI \HB\X1
           CAL FSTORE
           LLI \LB\CNTX    ; CNTX--
           LHI \HB\CNTX
           LAM
           SUI 001
           LMA
           JFZ X1LOOP      ; inner loop until CNTX == 0

           CAL CRLF        ; print CR and LF
           LLI \LB\Y1      ; Y1 = Y1 + STEPY
           LHI \HB\Y1
           CAL FLOAD
           LLI \LB\STEPY
           LHI \HB\STEPY
           CAL OPLOAD 
           CAL FPADD
           LLI \LB\Y1
           LHI \HB\Y1
           CAL FSTORE
           LLI \LB\CNTY   ; CNTY-- 
           LHI \HB\CNTY
           LAM
           SUI 001
           LMA
           JFZ Y1LOOP     ; outer loop until CNTY==0
          HLT 
          JMP CONCIRC     ; do it again

FPFLT:     LBI 027                ;For fixed to float set CPU register B to 23 decimal
FPNORM:    LAB                    ;Get CPU register B into ACC to check for special case
           LHI \HB\OLDPG1         ;** Set H to page of FPACC
           LLI 127                ;Set L to FPACC Exponent byte
           NDA                    ;Set CPU flags to test what was in CPU register B
           JTZ NOEXC0             ;If B was zero then do standard normalization
           LMB                    ;Else set Exponent of FPACC to 23 decimal
NOEXC0:    DCL                    ;Change pointer to MSW of FPACC
           LAM                    ;Fetch MSW of FPACC into accumulator
           LLI 100                ;Change pointer to SIGN indicator storage location
           LMA                    ;Place the MSW of FPACC there for future reference
           NDA                    ;Set CPU flags to test MSW of FPACC
           JFS ACZERT             ;If sign bit not set then jump ahead to do next test
           LBI 004                ;If sign bit set, number in FPACC is negative. Set up
           LLI 123                ;For two's complement operation
           CAL COMPLM             ;And negate the value in the FPACC to make it positive
ACZERT:    LLI 126                ;Reset pointer to MSW of FPACC
           LBI 004                ;Set precision counter to number of bytes in FPACC
LOOK0:     LAM                    ;Plus one. Fetch a byte of the FPACC.
           NDA                    ;Set CPU flags
           JFZ ACNONZ             ;If find anything then FPACC is not zero
           DCL                    ;Else decrement pointer to NSW of FPACC
           DCB                    ;Decrement precision counter
           JFZ LOOK0              ;Continue checking to see if FPACC contains anything
           LLI 127                ;Until precision counter is zero. If reach here then
           XRA                    ;Reset pointer to FPACC Exponent. Clear the ACC and
           LMA                    ;Clear out the FPACC Exponent. Value of FPACC is zip!
           RET                    ;Exit to calling routine
ACNONZ:    LLI 123                ;If FPACC has any value set pointer to LSW minus one
           LBI 004                ;Set precision counter to number of bytes in FPACC
           CAL ROTATL             ;Plus one for special cases. Rotate the contents of the
           LAM                    ;FPACC to the LEFT. Pointer will be set to MSW after
           NDA                    ;Rotate ops. Fetch MSW and see if have anything in
           JTS ACCSET             ;Most significant bit position. If so, have rotated enough
           INL                    ;If not, advance pointer to FPACC Exponent. Fetch
           LBM                    ;The value of the Exponent and decrement it by one
           DCB                    ;To compensate for the rotate left of the mantissa
           LMB                    ;Restore the new value of the Exponent
           JMP ACNONZ             ;Continue rotating ops to normalize the FPACC
ACCSET:    LLI 126                ;Set pntr to FPACC MSW. Now must provide room for
           LBI 003                ;Sign bit in nonnalized FPACC. Set precision counter.
           CAL ROTATR             ;Rotate the FPACC once to the right now.
RESIGN:    LLI 100                ;Set the pointer to SIGN indicator storage location
           LAM                    ;Fetch the original sign of the FPACC
           NDA                    ;Set CPU flags
           RFS                    ;If original sign of FPACC was positive, can exit now.

FPCOMP:    LLI 124                ; However, if original sign was negative, must now restore
           LBI 003                ;The FPACC to negative by performing two's comple-
           JMP COMPLM             ;Ment on FPACC. Return to caring rtn via COMPLM.

                                  ;Floating point ADDITION. Adds contents of FPACC to
                                  ;FPOP and leaves result in FPACC. Routine first checks
                                  ;to see if either register contains zero. If so addition
                                  ;result is already present!

FPADD:     LLI 126                ;Set L to point to MSW of FPACC
           LHI \HB\OLDPG1         ;** Do same for register H
           LAM                    ;Fetch MSW of FPACC to accumulator
           NDA                    ;Set CPU flags after loading op
           JFZ NONZAC             ;If accumulator non-zero then FPACC has some value
MOVOP:     LLI 124                ;But, if accumulator was zero then normalized FPACC
           LDH                    ;Must also be zero. Thus answer to addition is simply the
           LEL                    ;Value in FPOP. Set up pointers to transfer contents of
           LLI 134                ;FPOP to FPACC by pointing to the LSW of both
           LBI 004                ;Registers and perform the transfer. Then exit to calling
           JMP MOVEIT             ;Routine with answer in FPACC via MOVEIT.
NONZAC:    LLI 136                ;If FPACC was non-zero then check to see if FPOP has
           LAM                    ;Some value by obtaining MSW of FPOP
           NDA                    ;Set CPU flags after loading op. If MSW zero then
           RTZ                    ;Normalized FPOP must be zero. Answer is in FPACC!

                                  ;If neither FPACC or FPOP was zero then must perform
                                  ;addition operation. Must first check to see if two num-
                                  ;bers are within significant mnge. If not, largest number
                                  ;is answer. If numbers within range, then must align ex-
                                  ;ponents before perforrning the addition of the man-
                                  ;tissa.

CKEQEX:    LLI 127                ;Set pointer to FPACC Exponent storage location.
           LAM                    ;Fetch the Exponent value to the accumulator.
           LLI 137                ;Change the pointer to the FPOP Exponent
           CPM                    ;Compare the values of the exponents. If they are the
           JTZ SHACOP             ;Same then can immediately proceed to add operations.
           LBA                    ;If not the same, store FPACC Exponent size in regis B
           LAM                    ;Fetch the FPOP Exponent size into the ACC
           SBB                    ;Subtract the FPACC Exponent from the FPOP Exp.
           JFS SKPNEG             ;If result is positive jump over the next few instructions
           LBA                    ;If result was negative, store the result in B
           XRA                    ;Clear the accumulator
           SBB                    ;Subtract register B to negate the original value
SKPNEG:    CPI 030                ;See if difference is less than 24 decimal.
           JTS LINEUP             ;If so, can align exponents. Go do it.
           LAM                    ;If not, find out which number is largest. Fetch FPOP
           LLI 127                ;Exponent into ACC. Change pointer to FPACC Exp.
           SUM                    ;Subtract FPACC from FPOP. If result is negative then
           RTS                    ;was larger. Return with answer in FPACC.
           LLI 124                ;If result was positive, larger value in FPOP. Set pointers
           JMP MOVOP              ;To transfer FPOP into FPACC and then exit to caller.
LINEUP:    LAM                    ;Fetch FPOP Exponent into accumulator.
           LLI 127                ;Change pointer to FPACC Exponent.
           SUM                    ;Subtract FPACC Exponent from FPOP Exponent. If
           JTS SHIFT0             ;Result is negative FPACC is larger. Go shift FPOP.
           LCA                    ;If result positive FPOP larger, must shift FPACC. Store
MORACC:    LLI 127                ;Difference count in C. Reset pointer to FPACC Exp
           CAL SHLOOP             ;Call the SHift LOOP to rotate FPACC mantissa RIGHT
           DCC                    ;And INCREMENT Exponent. Decr difference counter
           JFZ MORACC             ;Continue rotate operations until diff counter is zero
           JMP SHACOP             ;Go do final alignment and perform addition process
SHIFT0:    LCA                    ;Routine to shift FPOP. Set difference count into reg. C
MOROP:     LLI 137                ;Set pointer to FPOP Exponent.
           CAL SHLOOP             ;Call the SHift LOOP to rotate FPOP mantissa RIGHT
           INC                    ;And INCREMENT Exponent. Then incr difference cntr
           JFZ MOROP              ;Continue rotate opemtions until diff counter is zero
;;; The below two instructions are changed by PATCH NR.1
;;;SHACOP:    LLI 123                ;Set pointer to FPACC LSW minus one to provide extra
;;;           LMI 000                ;Byte for addition ops. Clear that location to zero.
SHACOP:	   CAL PATCH1		; patch 1 inserts a few lines at 30-000
	   LAA
	
;;;           LLI 133
;;;           LMI 000                ;THIS IS PATCH #1
           LLI 127                ;Change pointer to FPACC Exponent
           CAL SHLOOP             ;Rotate FPACC mantissa RIGHT & Increment Exponent
           LLI 137                ;Change pointer to FPOP Exponent
           CAL SHLOOP             ;Rotate FPOP mantissa RIGHT & Increment Exponent
           LDH                    ;Rotate ops provide room for overflow. Now set up
           LEI 123                ;Pointers to LSW minus one for both FPACC & FPOP
           LBI 004                ;(FPOP already set after SHLOOP). Set precision counter
           CAL ADDER              ;Call quad precision ADDITION subroutine.
           LBI 000                ;Set CPU register B to indicate standard normalization
           JMP FPNORM             ;Go normalize the result and exit to caller.
SHLOOP:    LBM                    ;Shifting loop. First fetch Exponent currently being
           INB                    ;Pointed to and Increment the value by one.
           LMB                    ;Return the updated Exponent value to memory.
           DCL                    ;Decrement the pointer to mantissa portion MSW
           LBI 004                ;Set precision counter
FSHIFT:    LAM                    ;Fetch MSW of mantissa
           NDA                    ;Set CPU flags after load ops
           JFS ROTATR             ;If MSB not a one can do normal rotate ops
BRING1:    RAL                    ;If MSB is a one need to set up carrv bit for the negative
           JMP ROTR               ;Number case. Then make special entry to ROTATR sub

PATCH1:	LLI 123
	LMI 000
	LLI 133
	LMI 000
	RET

                                  ;The following subroutine moves the contents of a string
                                  ;of memory locations from the address pointed to by
                                  ;CPU registers H & L to the address specified by the con-
                                  ;tents of registers D & E when the routine is entered. The
                                  ;process continues until the counter in register B is zero.

MOVEIT:    LAM                    ;Fetch a word from memory string A
           INL                    ;Advance A string pointer
           CAL SWITCH             ;Switch pointer to string B
           LMA                    ;Put word from string A into string B
           INL                    ;Advance B string pointer
           CAL SWITCH             ;Switch pointer back to string A
           DCB                    ;Decrement loop counter
           RTZ                    ;Return to calling routine when counter reaches zero
           JMP MOVEIT             ;Else continue transfer operations

                                  ;The following subroutine SUBTRACTS the
                                  ;contents of the FLOATING POINT ACCUMULATOR from the
                                  ;contents of the FLOATING POINT OPERAND and
                                  ;leaves the result in the FPACC. The routine merely
                                  ;negates the value in the FPACC and then goes to the
                                  ;FPADD subroutine just presented.

FPSUB:     LLI 124                ;Set L to address of LSW of FPACC
           LHI \HB\OLDPG1         ;** Set H to page of FPACC
           LBI 003                ;Set precision counter
           CAL COMPLM             ;Two's complement the value in the FPACC
           JMP FPADD              ;Now go add the negated value to perform subtraction!

                                  ;The first part of the FLOATING POINT MULTIPLI-
                                  ;CATION subroutine calls a subroutine to check the
                                  ;original signs of the numbers that are to be multi-
                                  ;plied and perform working register clearing functions.
                                  ;Next the exponents of the numbers to be multiplied
                                  ;are added together.

FPMULT:    CAL CKSIGN             ;Call routine to set up registers & ck signs of numbers
ADDEXP:    LLI 137                ;Set pointer to FPOP Exponent
           LAM                    ;Fetch FPOP Exponent into the accumulator
           LLI 127                ;Change pointer to FPACC Exponent
           ADM                    ;Add FPACC Exponent to FPOP Exponent
           ADI 001                ;Add one more to total for algorithm compensation
           LMA                    ;Store result in FPACC Exponent location
SETMCT:    LLI 102                ;Change pointer to bit counter storage location
           LMI 027                ;Initialize bit counter to 23 decimal

                                  ;Next portion of the FPMULT routine is the iinplernen-
                                  ;tation of the algorithm illustrated in the flow chart
                                  ;above. This portion multiplies the values of the two
                                  ;mantissas. The final value is rounded off to leave the
                                  ;23 most significant bits as the answer that is stored
                                  ;back in the FPACC.

MULTIP:    LLI 126                ;Set pointer to MSW of FPACC mantissa
           LBI 003                ;Set precision counter
           CAL ROTATR             ;Rotate FPACC (multiplier) RIGHT into carry bit
           CTC ADOPPP             ;If carry is a one, add multiplicand to partial-product
           LLI 146                ;Set pointer to partial-product most significant byte
           LBI 006                ;Set precision counter (p-p register is double length)
           CAL ROTATR             ;Shift partial-product RIGHT
           LLI 102                ;Set pointer to bit counter storage location
           LCM                    ;Fetch current value of bit counter
           DCC                    ;Decrement the value of the bit counter
           LMC                    ;Restore the updated bit counter to its storage location
           JFZ MULTIP             ;If have not multiplied for 23 (deciinal) bits, keep going
           LLI 146                ;If have done 23 (decimal) bits, set pntr to p-p MSW
           LBI 006                ;Set precision counter (for double length)
           CAL ROTATR             ;Shift partial-product once more to the RIGHT
           LLI 143                ;Set pointer to access 24'th bit in partial-product
           LAM                    ;Fetch the byte containing the 24'th bit
           RAL                    ;Position the 24'th bit to be MSB in the accumulator
           NDA                    ;Set the CPU flags after to rotate operation and test to
           CTS MROUND             ;See if 24'th bit of p-p is a ONE. If so, must round-off
           LLI 123                ;Now set up pointers
           LEL                    ;To perform transfer
           LDH                    ;Of the multiplication results
           LLI 143                ;From the partial-product location
           LBI 004                ;To the FPACC

	
EXMLDV:    CAL MOVEIT             ;Perform the transfer from p-p to FPACC
           LBI 000                ;Set up CPU register B to indicate regular normalization
           CAL FPNORM             ;Normalize the result of multiplication
           LLI 101                ;Now set the pointer to the original SIGNS indicator
           LAM                    ;Fetch the indicator
           NDA                    ;Exercise the CPU flags
           RFZ                    ;If indicator is non-zero, answer is positive, can exit her
           JMP FPCOMP             ;If not, answer must be negated, exit via 2's complement.

                                  ;The following portions of the FPMULT
                                  ;routine set up working locations in memory by clearing
                                  ;locations for an expanded FPOP area and the partial-produc
                                  ;area. Next, the signs of the two numbers to be multiplied
                                  ;are examined. Negative numbers are negated
                                  ;in preparation for the multiplication
                                  ;algorithm. A SIGNS indicator register is set up during
                                  ;this process to indicate whether the final result of the
                                  ;multiplication should be positive or negative. (Negative
                                  ;if original signs of the two numbers to be multiplied are
                                  ;different.)

CKSIGN:    LLI 140                ;Set pointer to start of partial-product working area
           LHI \HB\OLDPG1         ;** Set H to proper page
           LBI 010                ;Set up a loop counter in CPU register B
           XRA                    ;Clear the accumulator

CLRNEX:    LMA                    ;Now clear out locations for the partial-product
           INL                    ;Working registers
           DCB                    ;Until the loop counter
           JFZ CLRNEX             ;Is zero
CLROPL:    LBI 004                ;Set a loop counter
           LLI 130                ;Set up pointer
CLRNX1:    LMA                    ;Clear out some extra registers so that the
           INL                    ;FPOP may be extended in length
           DCB                    ;Perform clearing ops until loop counter
           JFZ CLRNX1             ;Is zero
           LLI 101                ;Set pointer to M/D SIGNS indicator storage location
           LMI 001                ;Set initial value of SIGNS indicator to plus one
           LLI 126                ;Change pointer to MSW of FPACC
           LAM                    ;Fetch MSW of mantissa into accumulator
           NDA                    ;Test flags
           JTS NEGFPA             ;If MSB in MSW of FPACC is a one, number is negative
OPSGNT:    LLI 136                ;Set pointer to MSW of FPOP
           LAM                    ;Fetch MSW of mantissa into accumulator
           NDA                    ;Test flags
           RFS                    ;Return to caller if number in FPOP is positive
           LLI 101                ;Else change pointer to M/D SIGNS indicator
           LCM                    ;Fetch the value in the SIGNS indicator
           DCC                    ;Decrement the value by one
           LMC                    ;Restore the new value back to storage location
           LLI 134                ;Set pointer to LSW of FPOP
           LBI 003                ;Set precision counter
           JMP COMPLM             ;Two's complement value of FPOP & return to caller
NEGFPA:    LLI 101                ;Set pointer to M/D SIGNS indicator
           LCM                    ;Fetch the value in the SIGNS indicator
           DCC                    ;Decrement the value by one
           LMC                    ;Restore the new value back to storage location
           LLI 124                ;Set pointer to LSW of FPACC
           LBI 003                ;Set precision counter
           CAL COMPLM             ;Two's complement value of FPACC
           JMP OPSGNT             ;Proceed to check sign of FPOP

                                  ;The following subroutine adds the double length (six regis
                                  ;multiplicand in FPOP to the partial-product register when
                                  ;called on by the multiplication algorithm.

ADOPPP:    LEI 141                ;Pointer to LSW of partial-product
           LDH                    ;On same page as FPOP
           LLI 131                ;LSIV of FPOP which contains extended multiplicand
           LBI 006                ;Set precision counter (double length working registers)
           JMP ADDER              ;Add multiplicand to partial-product & return to caller

MROUND:    LBI 003                ;Set up precision counter
           LAI 100                ;Prepare to add one to 24'th bit of partial-product
           ADM                    ;Add one to the 24'th bit of the partial-product
CROUND:    LMA                    ;Restore the updated byte to memory
           INL                    ;Advance the memory pointer to next most significant
           LAI 000                ;Byte of partial-product, then clear ACC without
           ACM                    ;Disturbing carry bit. Now perform add with carry to
           DCB                    ;Propagate any rounding in the partial-product registers.
           JFZ CROUND             ;If cotinter is not zero continue propagating any carry
           LMA                    ;Restore final byte to memory
           RET                    ;Exit to calling routine

















ADDER:     NDA                    ;Initialize the carry bit to zero upon entry
ADDMOR:    LAM                    ;Fetch byte from register group A
           CAL SWITCH             ;Switch memory pointer to register group B
           ACM                    ;Add byte from A to byte from B with carry
           LMA                    ;Leave result in register group B
           DCB                    ;Decrement number of bytes (precision) counter
           RTZ                    ;Return to caller when all bytes in group processed
           INL                    ;Else advance pointer for register group B
           CAL SWITCH             ;Switch memory pointer back to register group A
           INL                    ;Advance the pointer for register group A
           JMP ADDMOR             ;Continue the multi-byte addition operation

                                  ;N'th precision two's complement (negate)
                                  ;subroutine. Performs a two's complement on the multi-byte
                                  ;registers tarting at the address pointed
                                  ; to by H & L (least significant byte) upon entry.

COMPLM:    LAM                    ;Fetch the least significant byte of the number to ACC
           XRI 377                ;Exclusive OR to complement the byte
           ADI 001                ;Add one to form two's complement of byte
MORCOM:    LMA                    ;Restore the negated byte to memory
           RAR                    ;Save the carry bit
           LDA                    ;In CPU register D
           DCB                    ;Decrement number of bytes (precision) counter
           RTZ                    ;Return to caller when all bytes in number processed
           INL                    ;Else advance the pointer
           LAM                    ;Fetch the next byte of the number to ACC
           XRI 377                ;Exclusive OR to complement the byte
           LEA                    ;Save complemented value in register E temporarily
           LAD                    ;Restore previous carry status to ACC
           RAL                    ;And rotate it out to the carry bit
           LAI 000                ;Clear ACC without disturbing carry status
           ACE                    ;Add in any carry to complemented value
           JMP MORCOM             ;Continue the two's complement procedure as req'd

                                  ;N'th precision rotate left subroutine. Rotates a multi-
                                  ;byte number left starting at the address initially
                                  ;specified by the contents of CPU registers H & L upon
                                  ;subroutine entry (LSW). First entry point will clear
                                  ;the carry bit before beginning rotate operations. Second
                                  ;entry point does not clear the carry bit.

ROTATL:    NDA                    ;Clear the carry bit at this entry point
ROTL:      LAM                    ;Fetch a byte from memory
           RAL                    ;Rotate it left (bring carry into LSB, push MSB to carry)
           LMA                    ;Restore rotated word to memory
           DCB                    ;Decrement precision counter
           RTZ                    ;Exit to caller when finished
           INL                    ;Else advance pointer to next byte
           JMP ROTL               ;Continue rotate left operations


                                  ;N'th precision rotate
                                  ;right subroutine. Opposite of
                                  ;above subroutine.

ROTATR:    NDA                    ;Clear the carry bit at this entry point
ROTR:      LAM                    ;Fetch a byte from memory
           RAR                    ;Rotate it right (carry into MSB, LSB to carry)
           LMA                    ;Restore rotated word to memory
           DCB                    ;Decrement precision counter
           RTZ                    ;Exit to caller when finished
           DCL                    ;Else decrement pointer to next byte
           JMP ROTR               ;Continue rotate right operations

                                  ;N'th precision subtraction subroutine.
                                  ;Number starting at location pointed to by D & E (least
                                  ;significant byte) is subtracted from number starting at
                                  ;address specified by contents of H & L.

SUBBER:    NDA                    ;Initialize the carry bit to zero upon entry
SUBTRA:    LAM                    ;Fetch byte from register group A
           CAL SWITCH             ;Switch memory pointer to register group B
           SBM                    ;Subtract byte from group B ftom that in group A
           LMA                    ;Leave result in register group B
           DCB                    ;Decrement number of bytes (precision) counter
           RTZ                    ;Return to caller when all bytes in group processed
           INL                    ;Else advance pointer for register group B
           CAL SWITCH             ;Switch memory pointer back to register group A
           INL                    ;Advance the pointer for register group A
           JMP SUBTRA             ;Continue the multi-byte subtraction operation

                                  ;The next subroutine will transfer the four byte
                                  ;register string (generally a number in floating point
                                  ;format) from the starting address pointed to by CPU
                                  ;registers H & L when the subroutine is entered to
                                  ;the FPACC (floating point accumulator registers).

FLOAD:     LDI \HB\OLDPG1         ;** Set page address of FPACC
           LEI 124                ;Set address of least signficant byte of FPACC
           LBI 004                ;Set precision counter to four bytes (mantissa bytes
           JMP MOVEIT             ;Plus Exponent) and exit via the transfer routine

                                  ;The next several subroutines are used to perform
                                  ;floating pojnt register loading and transfer operations.

FSTORE:    LEL                    ;Transfer contents of register L to E
           LDH                    ;Transfer contents of register H to D
           LLI 124                ;Set L to least significant byte of FPACC mantissa
           LHI \HB\OLDPG1         ;** Set page to FPACC storage area
           JMP SETIT              ;Go transfer FPACC contents to area pointed to by D&E
OPLOAD:    LDI \HB\OLDPG1         ;** Set page to FPOP storage area
           LEI 134                ;Set pointer to least significant byte of FPOP
SETIT:     LBI 004                ;Set precision counter. Transfer from H & L area to
           JMP MOVEIT             ;Locations pointed to by D & E

                                  ;The next subroutine perforins a double transfer opera-
                                  ;tion. It first transfers the contents of the FPACC into
                                  ;the FPOP. It then transfers new data (as pointed to by
                                  ;H & L upon entry to the subroutine) into the FPACC.


                                  ;Subroutine to exchange the contents of H & L with
                                  ;D & E.

SWITCH:    LCH                    ;Transfer register H to C temporarily
           LHD                    ;Place value of D into H
           LDC                    ;Now put former H from C into D
           LCL                    ;Transfer register L to C temporarily
           LLE                    ;Place value of E into L
           LEC                    ;Now put former L from C into E
           RET                    ;Exit to calling routine





