FIND [>" 0=
[IF]
 CF" MicroFORTH/OUTILS/asmmicro.txt"
[THEN]

[>" MicroFORTH/NOYAU/Commun/sqrt.txt"
( Extraction de racine carree d'un entier de 16 ou 32 bits en assembleur.
  Version 0.10 du 25 Aout 2013.
  Ecrit par jpb.forth .
)

TELECHARGEMENT

( n, n', nh ou nl representent des mots de 16 bits.
)

HEX

: SQRT ( n --> n' )
 [ ASSEMBLEUR
	PIC24F
; Le sommet de la pile est dans le registre W0
SQRT	PUSH	W3
	PUSH	W2
	PUSH	W1
; W1; W2 et W3 sont sauvegardes dans la pile de retour
	CLR	[--W14]
; La racine initialisee a 0 est empile au deuxieme niveau de la pile des donnees
	MOV	#$0080,W1
; Le registre W1 est initialise a 128
SQRT1	ADD	W1,[W14],W2
; La racine et W1 sont additionnes dans W2
	MUL.UU	W2,W2,W2
; W2 est eleve au carre dans (W2,W3)
	CP	W0,W2
; W2 est compare a W0
	BRA	C,SQRT2
; La retenue est testee
	ADD	W1,[W14],[W14]
; Si il n'y a pas de retenue, W1 est additionne a la racine
SQRT2	LSR	W1,W1
; W1 est divise par 2
	BRA	NC,SQRT1
; Le calcul est termine lorsque C est egal a 1
	INC	[W14],W2
	MUL.UU	W2,[W14],W2
; La racine est multipliee par racine + 1 dans (W2,W3)
	CP	W2,W0
; W2 est compare a W0
	BRA	NC,SQRT3
; La retenue est testee
	INC	[W14],[W14]
; Si il y a une retenue, la racine est incrementee (arrondie)
SQRT3	POP	W1
	POP	W2
	POP	W3
; W1, W2 et W3 sont restaures depuis la pile de retour
	MOV	[W14++],W0
; Le nombre initial est depile
	END ]
;

: DU* ( n,n' --> nh,nl )
 [ ASSEMBLEUR
	PIC24F
; Le sommet de la pile, W0, contient lee 16 bits de poids faibles du nombre
DUMUL	PUSH	W1
; W1 est sauvegarde dans la pile de retour
	MUL.UU	W0,[W14],W0
; W0 est eleve au multiplie par le contenu de [W14] dans (W0,W1)
	MOV	W1,[W14]
; W1 est stocke dans [W14]
	POP	W1
; W1 est restaure depuis la pile de retour
	END ]
;

: DSQRT ( nh,nl --> n' )
 [ ASSEMBLEUR
	PIC24F
; Le sommet de la pile, W0, contient lee 16 bits de poids faibles du nombre
DSQRT	PUSH	W4
	PUSH	W3
	PUSH	W2
	PUSH	W1
; W1, W2, W3 et W4 sont sauvegardes dans la pile de retour
	CLR	W1
; W1 est initialise avec la racine a 0
	MOV	#$8000,W4
; W4 est initialise a 32768
DSQRT1	ADD	W1,W4,W2
; La racine et W4 sont additionne dans W1
	MUL.UU	W2,W2,W2
; W1 est eleve au carre dans (W2,W3)
	CP	W0,W2
	MOV	[W14],W2
	CPB	W2,W3
; (W3,W2) sont compares a ([W14],W0)
	BRA	C,DSQRT2
; La retenue est testee
	ADD	W1,W4,W1
; Si il n'y a pas de retenue, W1 est additionne a la racine
DSQRT2	LSR	W4,W4
; W4 est divise par 2
	BRA	NC,DSQRT1
; La boucle est terminee lorsque C est egal a 1
	INC	W1,W2
	BRA	C,DSQRT3
; Si il y a une retenue, la racine n'est pas arrondie (65535)
	MUL.UU	W2,W1,W2
; La racine est multipliee par racine + 1 dans (W2,W3)
	CP	W2,W0
	MOV	[W14],W2
	CPB	W3,W2
; (W3,W2) sont compares a ([W14],W0)
	BRA	NC,DSQRT3
; La retenue est testee
	INC	W1,W1
; Si il y a une retenue, la racine est incrementee (arrondie)
DSQRT3	MOV	W1,W0
	ADD	#2,W14
; La racine est placee au sommet de la pile des donnees
	POP	W1
	POP	W2
	POP	W3
	POP	W4
; W1, W2, W3 et W4 sont restaures depuis la pile de retour
	END ]
;

DECIMAL

: TEST
 ." Debut du test de l'instruction SQRT." CR
 ." n" 9 EMIT ." n*n" 9 EMIT ." sqrt(n*n)" CR
 256 0 DO
  I DUP U. 9 EMIT DUP U* DUP U. 9 EMIT SQRT DUP . 9 EMIT I -
  IF
   ." KO" CR
  ELSE
   ." OK" I 255 -
   IF
    40 0 DO
     8 EMIT
    LOOP
   ELSE
    CR
   THEN
  THEN
 LOOP
 ." Fin du test de l'instruction SQRT." CR CR
 ." Debut du test de l'instruction DSQRT." CR
 ." n" 9 EMIT ." (n*n)h" 9 EMIT ." (n*n)l" 9 EMIT ." sqrt(n*n)" CR
 256 0 DO
  256 0 DO
   I J 8 LSH + DUP U. 9 EMIT DUP DU* OVER U. 9 EMIT DUP U. 9 EMIT
   DSQRT DUP U. 9 EMIT I J 8 LSH + -
  IF
   ." KO" CR
  ELSE
   ." OK" I J 8 LSH + 1+
   IF
    60 0 DO
     8 EMIT
    LOOP
   ELSE
    CR
   THEN
  THEN
  LOOP
 LOOP
 ." Fin du test de l'instruction DSQRT." CR
;

( FIN
)