🚀 go-pugleaf

The following is a Z-80 square root routine for STOIC.  Sorry, it is the
best I can do, but at least the algorithm is described.  This algorithm 
is faster than a divide (so you know what you can do with Newton's 
aproximation).

% SQUARE ROOT ROUTINE

RADIX @  HEX  % SET RADIX TO HEX

ASSEMBLER< DEFINITIONS  

% Z-80 ASSEMBLER DEFINITIONS (FOR SQRT, AT LEAST)

% LET US DEFINE SOME ASSEMBLER CONTROL STRUCTURES
18 'CY CONSTANT   10 'NC CONSTANT   8 'Z CONSTANT   0 'NZ CONSTANT
28 'PE CONSTANT   20 'PO CONSTANT   38 'N CONSTANT  30 'P CONSTANT
'JMPC, : 0C2 + B, , ; % CONDITIONAL JUMP (Z80 STYLE...BETTER FOR STRUCTURES)
'IF,  : 8 XOR 0 SWAP JMPC, . 2- ;  % SUPPLY FORWARD JUMP TARGET
'BEGIN, : . ;
'END, : 8 XOR JMPC, ; % JUMP BACK TO BEGIN IF COND FALSE
'REPEAT,  : SWAP JMP,  THEN, ;  % BEGIN, ..  IF, ... REPEAT,  STRUCTURE

'RL, : 0CB B,  10 + B, ;  % DEFINE Z-80 OPS FOR RL, RR, SLA, AND SRL
'RR, : 0CB B,  18 + B, ;
'SLA, : 0CB B,  20 + B, ;
'SRL, : 0CB B,  38 + B, ;
'DSBB, : 0ED B,  8 * 42 + B, ; % SUBTRACT FROM HL WITH BORROW (Z80 AGAIN)
'DADC, : 0ED B, 8 * 4A + B,  ; % ADD TO HL WITH CARRY
'EXREGS, : 0D9 B, ;  % EXCHANGE REGISTER SETS

> DEFINITIONS 

% THE ALGORITHM USED TO TAKE THE SQUARE ROOT IS AS FOLLOWS:

% A IS ARGUMENT (N BITS), R IS ROOT ACCUMULATOR (N/2+1 BITS), 
% B IS HIGH END OF ARGUMENT (N/2+1 BITS, I THINK)

% REPEAT N/2 TIMES :	SHIFT B,A LEFT TWO BITS
%			R := R * 2 + 1
%			B := B - R
%			IF B<0 THEN B:=B+R  R:=R-1  (NO BORROW CAN OCCUR)
%				ELSE R:=R+1
%
% ROOT IS R/2, "REMAINDER" IS B.


% SINGLE PRECISION SQUARE ROOT
% IN THIS ROUTINE, DE HOLDS ROOT, BC THE ARGUMENT, AND HL THE EXTENSION
% THE COUNTER IS THE A REGISTER
ASSEMBLER<  .    % THIS IS DONE AS A SUBROUTINE
  A XRA, A D MOV, A E MOV, A H MOV, A L MOV, 8 A MVI, % INITIALIZE
	BEGIN,
	E SLA,  D RL,  E INR, % ROOT <- ROOT*2+1
	2 ( C RL,  B RL,  H DADC, ) % SHIFT DEBC LEFT BY TWO BITS
	D DSBB, % SUBTRACT PARTIAL ROOT FROM END OF ARGUMENT
	N IF,
	 D DAD, E DCR,  % WON'T FIT, RESTORE ARG AND DECREMENT PARTIAL ROOT
	ELSE,
	 E INR, % FITS -- INCREMENT PARTIAL ROOT
	THEN,
	A DCR, Z END,
	RET, >  % RETURN RESULT (*2) IN DE, REMAINDER IN HL
'(SQRT) CONSTANT

'SQRT CODE<  B POP,  (SQRT) CALL,  XCHG,
	H SRL,  L RR,   % CORRECT ROOT (DIVIDE BY 2)
	PUSH JMP, >  % RETURN



% DOUBLE PRECISION SQUARE ROOT
% ROOT IS FORMED IN REGISTERS C,D,E; COUNTER IS IN REGISTER B
% ARGUMENT EXTENSION IS STORED IN AHL
% THE ARGUMENT IS ON THE STACK IN STANDARD DOUBLE PRECISION FORMAT:
%	3 4(MSB) 1 2.  



'DSQRT  CODE<           % INITIALIZE
	B POP,  (SQRT) CALL, % TAKE PARTIAL SQUARE ROOT
	A XRA,  A C MOV,  8 B MVI,
	EXREGS, H POP, EXREGS,
	BEGIN, 
	2 ( EXREGS, H DAD, EXREGS,
	    H DADC,  A ADC, ) % SHIFT LEFT ARGUMENT&EXTENSION BY 2 BITS
	E SLA,  D RL,  C RL,  E INR, % R <- R*2+1
	D DSBB, C SBB,  % DO SUBTRACT
	N IF,
		D DAD,  C  ADC,
		E DCR,  % ADJ PARTIAL ROOT
	ELSE, % >=0 SO COMPLETE SUBTRACT
		E INR,  % ADJ PARTIAL ROOT
	THEN,
	B DCR,  Z END,
	C SRL,  D RR,  E RR,  % CORRECT RESULT BY DIVIDING BY 2
	XCHG,  	PUSH JMP, >  % FINISHED, SO RETURN


% THE FOLLOWING IS A FASTER VERSION 

'FDSQRT  CODE<           % INITIALIZE
	B POP,  (SQRT) CALL, % TAKE PARTIAL SQUARE ROOT
	A XRA,  A C MOV,  6 B MVI,
	EXREGS, H POP, EXREGS,  % GET REST OF ARGUMENT
	BEGIN, 
	2 ( EXREGS, H DAD, EXREGS, 
	    H DADC,  ) % SHIFT LEFT ARGUMENT&EXTENSION BY 2 BITS
	E SLA,  D RL,  E INR, % R <- R*2+1
	D DSBB, % DO SUBTRACT
	CY IF,
		D DAD,  
		E DCR,  % ADJ PARTIAL ROOT
	ELSE, % >=0 SO COMPLETE SUBTRACT
		E INR,  % ADJ PARTIAL ROOT
	THEN,
	B DCR,  Z END,
% DO LAST TWO ITERATION MORE LESS EFFICIENTLY
	2 B MVI, BEGIN, 
	2 ( EXREGS, H DAD, EXREGS,
	    H DADC,  A ADC, ) % SHIFT LEFT ARGUMENT&EXTENSION BY 2 BITS
	E SLA,  D RL,  C RL,  E INR, % R <- R*2+1
	D DSBB, C SBB,  % DO SUBTRACT
	N IF,
	%	D DAD,  C  ADC,    % DONT BOTHER WITH THIS IF REMAINDER NOT
		E DCR,  % ADJ PARTIAL ROOT			% WANTED
	ELSE, % >=0 SO COMPLETE SUBTRACT
		E INR,  % ADJ PARTIAL ROOT
	THEN,
	B DCR, Z END,
	
	C SRL,  D RR,  E RR,  % CORRECT RESULT BY DIVIDING BY 2
	XCHG,  	PUSH JMP, >  % FINISHED, SO RETURN


RADIX ! % RESTORE RADIX
;F      % **EOF**


Tom Almy
Tektronix, Inc