(HP71B) ASM question

[J-F Garnier]

(08-05-2024 04:21 AM)brouhaha Wrote:  

(07-30-2024 07:54 AM)J-F Garnier Wrote:  I didn't know the connection to the Fairchild PPS 25.

See my comment in the HP 9199A thread, and Steve Simkin's reply.

Thanks for linking to this thread !
As Kim, I missed it at the time, maybe I misread "9199" as a TI 99xx thing (a completely different story too).

Quote:

Quote:Do you know where the Capricorn CPU architecture, used in the Series 80 and the 75C, comes from?

The HP Journal article KeithB mentioned explains their rationale for designing a custom architecture, namely BCD arithmetic and variable length data. It is unclear that any specific architecture(s) influenced it, other than the generalized influence of the BCD and variable length word of the calculator processors.
The earlier Fairchild F8 architecture (also used by Mostek 3870) was AFAIK the earliest microprocessor architecture to have 64 registers, but it doesn't really appear that it had a significant influence.

I can also think of the CDP 1802 with its 16 16-bit register bank (so only 32 bytes total).
As for the Capricorn, one of the register was acting as the program counter, but the subroutine mechanism was completely different and unusual.
Actually I used it for a project beginning of the '80s at about the same time I was discovering the HP-85 assembly language.
The 1802 was introduced in 1976, so I doubt it could have been a source of inspiration to HP.
The story of the 1802 is interesting too.

J-F

[floppy]

New word "X<0?" since it was not in the HP71B Forth standard word list but in the HP41. Variants of it with different P values will create the other missing X<=0? & X>0?
( the missing X#0? would be

Code:

X=0? NOT

in Forth therefore imho no urgent need so far to create an ASM Word for this ).

Code:

=XXYY   EQU #E212D            comparison of X and perhaps Y (or zero)
=CMPST  EQU #E216C            comparison operator routine
* X<0?  check if the value in X is <0 then put 0 (false) 
*   or -1 (true) into the integer stack
*   similar to HP41
*   no float stack change
*   tested 17Aug2024
       WORD 'X<0?'
       ST=1   0
       GOSBVL =CMPST
       P=     1
       GOVLNG =XXYY

UPDATE. All X comparison with 0 in a single file

Code:

* X<0?  check if the value in X is <0 then put 0 (false) 
*   or -1 (true) into the integer stack
*   similar to HP41; however use of an integer stack instead of
*   program counter jump or not (like the Forth word X=0?)
*   no float stack change
*   tested 21Aug2024
       WORD 'X<0?'
       ST=1   0
       GOSBVL =CMPST
       P=     1
       GOTO   CMP0
*
* X<=0?
       WORD 'X<=0?'
       ST=1   0
       GOSBVL =CMPST
       P=     3
       GOTO   CMP0
*
* X#0?
       WORD 'X#0?'
       ST=1   0
       GOSBVL =CMPST
       P=     5
       GOTO   CMP0
*
* X>0?
       WORD 'X>0?'
       ST=1   0
       GOSBVL =CMPST
       P=     4
CMP0   GOVLNG =XXYY

Any remarks are welcomed for improvement or shortening of such suggested Forth words.

[floppy]

Lets give more flexibility in working with the float stack in Forth.

the entry point listed in the new words..

Code:

=OX     EQU #2FBD0            X address

Code:

* X<> exchange the value in the variable with the value in X like the HP41 command
*       use: FVAR1 X<>   tested 15july2024
       WORD 'X<>'
       P=     0
       LC(5)  =OX             put X-address into C(A)
       CD0EX                 exchange data pointer address D0 with C(A)
       R2=C                  save D0
       A=DAT0 W              A = value of X from its address in C(A)
       R0=A                  R0 = X
       C=DAT1 A              copy data at address in D1 into C(A)
       CD0EX
       A=DAT0 W              copy data at address in D0 (in C(A)) into W in A
       R1=A                  R1 = Reg value
       P=     0
       LC(5)  =OX             put X-address into C(A)
       CD0EX                 exchange data pointer address D0 with C(A)
       A=R1
       DAT0=A W              X has now value of Reg
       C=DAT1 A              copy data at address in D1 into C(A)
       CD0EX                 exchange C(A) with D0
       A=R0
       DAT0=A W              value of X into reg
       C=R2
       D0=C                  restore D0
       D1=D1+ 5              return nothing on data stack
       RTNCC

Code:

* X<>Z exchange the HP41 registers. tested 12 July 2024
       WORD 'X<>Z'
       P=     0
       LC(5)  =OX             put X-address into field A of register C
*                               low order 5 nibbles
       CD0EX                 put data pointer D0 into C(A)
       R1=C                  save D0 into R1
       C=DAT0 W              C = value of X (which is in D0)
       D0=D0+ 16             D0 has now Y addr
       D0=D0+ 16             D0 has now Z addr
       A=DAT0 W              put value of Z into A via addr in D0
       DAT0=C W              Z = value of X
       D0=D0- 16
       D0=D0- 16             D0 -> X
       DAT0=A W              X = value of Z
       C=R1
       D0=C                  restore D0
       RTNCC

Code:

* X<>T exchange the HP41 registers, tested 12 July 2024
       WORD 'X<>T'
       P=     0
       LC(5)  =OX             put X-address into field A of register C
*                               low order 5 nibbles
       CD0EX                 put data pointer D0 into C(A)
       R1=C                  save D0 into R1
       C=DAT0 W              C = value of X
       D0=D0+ 16             D0 -> Y
       D0=D0+ 16             D0 -> Z
       D0=D0+ 16             D0--> T
       A=DAT0 W              put value of T into A
       DAT0=C W              T = value of X
       D0=D0- 16
       D0=D0- 16
       D0=D0- 16             D0 -> X
       DAT0=A W              X = value of T
       C=R1
       D0=C                  restore D0
       RTNCC

Code:

* X<>L exchange the HP41 registers, tested 12 July 2024
       WORD 'X<>L'
       P=     0
       LC(5)  =OX             put X-address into field A of register C
*                               low order 5 nibbles
       CD0EX                 put data pointer D0 into C(A)
       R1=C                  save D0 into R1
       C=DAT0 W              C = value of X
       D0=D0- 16             D0--> L
       A=DAT0 W              put value of L into A
       DAT0=C W              L = value of X
       D0=D0+ 16             D0 -> X
       DAT0=A W              X = value of L
       C=R1
       D0=C                  restore D0(A) from C(A)
       RTNCC

More words needed like example Z<>L ?
this word is
X<>Z
X<>L
X<>Z
therefore Z<>L could be a new Forth word (lower need since this is a combination of the 3 above new words).

As usual, remarks are welcomed.

[floppy]

Since beeping is healthy, lets create the TONE word like in HP41.
Usefull? perhaps

Entry points

Code:

=ABS    EQU #E1A23            (n -- |n|)
=SAVEFP EQU #E717A            save Forth pointer
=HDFLT  EQU #1B31B            change hex integ A(A) to 12dig float in A(W) exit DEC mode
=MP2-12 EQU #0C432            12 digit * (A) * (C) result 15dig in (A,B) 
=RESD1  EQU #0E1EE            reduce (AB) in (C), dont alter D1
=AD2-12 EQU #0C35F            12 digit add = (A) + (C) 15dig result in (A,B)
=BP     EQU #0EADF            make beep float A HZ Float C duration sec pdf ids3 page 1625
=GETFP  EQU #E71A5            restore Forth pointers

Code:

* create HP41 like tone function with input 0 (low)..9 (high)
* input in the integer stack (in HP41 it is as a line command TONE x)
* ( n -- ) TONE
* 0 .. 394 Hz  >> Value 394 + (43.777 * N) 
* 1 .. 437.8
* ..
* 8 .. 744.2
* 9 .. 788 HZ
* length 0,28s
* however inputs higher than 9 will be accepted
* negative values -8 (example) will be taken as 8
* tested Aug22 2024
* use  5 TONE in Forth prompt
       WORD 'TONE'
*
       GOSBVL =ABS           for positive whatever input was
       GOSBVL =SAVEFP
*
* not tested/completed; if bigger than 9, reduce with MOD 10
*       C=0    W
*       LCHEX  100000000000001  ? Integer format in integ stack?
*       D1=D1- 5
*       DAT1=C A
*       GOSBVL =MOD 
*
       A=DAT1 A
       GOSBVL =HDFLT          change A(A) to float A(W) 12 digits for further calc. exit with DEC mode
       C=0    S
       P=     0
       LCHEX  437777777777001 
       GOSBVL =MP2-12        result into (A,B)
       GOSBVL =RESD1         result into C
       R0=C
       C=0    S              S instead of W for less size?
       P=     0
       LCHEX  394000000000002
       A=R0
       GOSBVL =AD2-12        result into (A,B)
       GOSBVL =RESD1         result into C as 12 digit
       R0=C                  R0 Hz 
       C=0    W
       P=     0
       LCHEX  280000000000999 C duration
       SETDEC
       A=R0
       GOSBVL =BP
       GOSBVL =GETFP
       D1=D1+ 5              take the value out of the stack
       RTNCC

UPDATE: missing entry points included

[floppy]

Question: what is the best method for creating PI in Forth/ASM?
Is there a memory optimized calculation procedure?

In HP71B, apart from using the BASICX command with PI as parameter in a Forth word, its possible to upload a constant; but perhaps not the best memory cautious method.

Comments/remarks are welcome.

Entry points

Code:

=SAVEFP EQU #E717A            save Forth pointer
=STKLFT EQU #E7320            Stacklift Forth OM page 609 pdf
=OX     EQU #2FBD0            X address
=GETFP  EQU #E71A5            restore Forth pointers

PI word

Code:

* PI : put PI into X in the stack. uplift the float stack. lastx not changed (like HP41)
* tested 23Aug2024
       WORD 'PI'
       GOSBVL =SAVEFP
       C=0    S
       P=     0
       LCHEX  314159265359000
       R0=C                  R0 = Result
       GOSBVL =STKLFT
       A=R0
       D0=(5) =OX
       DAT0=A W              Result into X
       GOSBVL =GETFP
       RTNCC

[floppy]

Now, here is one new word written in ASM, like the HP41 function R-P, now for for HP71B Forth.
A warning is coming during the use WRN:
However the result is fine.
If anybody has an idea how to take this away, please contact me (the word works).

Code:

************************************************************
* R-P : Rad to Polar conversion
* see HP41 manual page 92
* 1.0 2.0 R-P gives 2.2361 (SQRT(5)) in X and 26.56° or 0.4636 Rad in Y
* change the output if use of the words RADIANS or DEGREES
* WRN: coming; reason unknown; however result ok
************************************************************
       WORD 'R-P'
       GOSBVL =NUMST         GET X INTO (A,B), uMODES;SAVEFP;GETX+L
       GOSBVL =uRES12        C = (A,B)
       A=C    W
       R0=A                  X in A and R0
*
       SETDEC
       GOSBVL =MP2-12
       GOSBVL =uRES12        C = (A,B)
       A=C    W
       R2=A                  X**2 in A and R2
*
       P=     0
       LC(5)  =OY
       CD0EX
       A=DAT0 W
       R1=A                  Y in A and R1
*
       C=R0                  X in C
       SETDEC
       GOSBVL =DV2-12
       GOSBVL =ATAN15
       GOSBVL =uRES12        C = (A,B)
       A=C    W
*
       P=     0
       LC(5)  =OY
       CD0EX
       DAT0=A W              copy data of A into Y
*
       A=R1
       C=A    W
       SETDEC
       GOSBVL =MP2-12
       GOSBVL =uRES12        C = (A,B)
       A=C    W              Y**2 in A
       C=R2                  X**2 in C
       SETDEC
       GOSBVL =AD2-12
       GOSBVL =SQR15
*
       GOSBVL =PUTABX
       RTNCC
************************************************************

[floppy]

Now a try to make the ISG function in HP41 under HP71B/Forth/ASM.
An usefull use in Forth is identified? not sure since it has the I DO LOOP or +LOOP.
However, having such frankensetein HP41 function in HP71B is funny.
Comments/remarks are welcome

Code:

*
****************************************************************
* ISG ( addr -- flag ) increment value
* need? since I DO LOOP or +LOOP exists, it should cover the needs
* HP41 like "increment and skip if greater". It increment sss and would "skip", what
*   we can interpret as put a NO/false (0) in the integer stack, if it becomes equal or greater than eee
*   hp41 om en page 164 (pdf 170)
* BUT here, no truncated according display
* use.. FVAR1 ISG (FVAR1 is a float variable) ; ssss,eeeiixxx in FVAR1 will 
*         return  0 (false) if sss+ii >= eee
*         return -1 (true) if sss+ii < eee
*       ii default is 1 if not given (00)
*
*       0.0 X ISG X FV. . >> Value: 1.000000000  &  0 in Intg Stack 
*       1.01 X ISG will increase X by default 1 with 
*          result 2.01000 in X and -1 in Intg Stack
*       -10.00102345 Y STO Y ISG will increase Y by 2 with 
*          result -8.00102345 in Y  and -1 in Intg Stack 
*       10.02003 X ISG      gives  13.02003 in X, -1 in Integ Stack
*       10.020001234 X ISG  gives  11.020001234 in X, -1 in Integ stack
*       10.020001234 X ISG X FV. .  Value in X: 11.020001234 -1  OK { 0 } 
*       10.020103456 X ISG  gives  20.020103456 in X, 0 in Integ stack
*       -10.02010 X ISG     gives  0.02010 in X, -1 in Integ Stack
*       0.0201 X ISG      gives  10.02010 in X, -1 in Integ Stack
*       10.02010 X ISG      gives  20.02010 in X, 0 in Integ Stack
*       20.02010 X ISG      gives  30.02010 in X, 0 in Integ Stack
*       -1.02010 X ISG FS. .   gives 9.02010 in X, -1 in Integ stack
*       0.00005 X ISG X FV. . >> 5.00005 in X and 0 in Integ stack
*       0.010405678 X ISG X FV. . >> 40.010405678 in X and 0 in Integ stack
*       -10.02010777 X ISG FS. . >> 0.02010777 in X and -1 in integ stack
*
* tested 07.10.2024
****************************************************************
       WORD 'ISG' 
       GOSBVL =SAVEFP
       C=DAT1 A              copy data at address in D1 into C(A)
       R0=C                  copy C(A) into R0
       CD0EX                 exchange C(A) with D0 pointer
       A=DAT0 W              value ssss,eeeiixxx into A
*
* saving the original value of the float variable
*
       R1=A                  value ssss,eeeiixxx into   >> R1 <<
*
* 10000 in (C)
       C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  5              just retracting 5x 1 in X was not making it
*
       A=R1                  seems to make it better; see %OF, too
*                            = upload A after C prior MV DV ADD..
       SETDEC
       GOSBVL =MP2-12        sssseeeii,xxx into (A,B)
       GOSBVL =CLRFRC        sssseeeii,000 into (A,B)
       GOSBVL =uRESD1        into (C)
       R2=C                  sssseeeii,000 into R2
       C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  998            0,01 now in C
*
       A=R2                  sssseeeii,000 into A
       SETDEC
       GOSBVL =MP2-12        sssseee,ii000 into (A,B)
       GOSBVL =CLRFRC        sssseee,00000 into (A,B); carry set if ii=00
*
       GONC   nadd0          if 0,ii000 # 0,00 then dont add one
*
* BRANCH: ii is ZERO .. then add ONE
*
       A=R2                  sssseee00,000 into A
       C=0    W
       P=     14
       C=C+1  P              1 in Register C
       C=A    S              it makes -1 if A<0; +1 if A>0
       A=R2                  sssseee00,000 into A
       GOSBVL =AD2-12        sssseee01,000 in (A,B)
       GOSBVL =uRESD1        sssseee01,000 into (C)
       R2=C                  sssseee01,000 into (R2)
*
* BRANCH: ii IS NOT ZERO from here
*
nadd0  C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  998            0,01 now in C
       A=R2                  from here, sssseeeii,000 into A
       SETDEC
       GOSBVL =MP2-12        sssseee,ii000 into (A,B)
       GOSBVL =FRAC15        0,ii000 in (A,B). ii#00 for sure here  issue there if sssseee = 0?
       GOSBVL =uRESD1        into (C)
       A=C    W              0,ii000 into A
       P=     15
       A=0    P              +0,ii000 in (A)
       SETDEC
       R2=A                  +0,ii000 in R2 now
       C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  2              100 in C
       A=R2                  +0,ii000 in (A)
*
       SETDEC                dont forget this before MP DV .. 2-12
       GOSBVL =MP2-12        +ii,000 into (A,B)
       GOSBVL =uRESD1        +ii,000 into (C)
*
       R2=C                  +ii,000 into (R2)
*
* ssss could be zero and could make an issue later with the use of FRAC15
* which is not necessary in case this is already 0,eeeiixxxx
*
       A=R1                  ssss,eeeiixxx into A
       GOSBVL =IF12A
       ?P#    14             test if A is like 0,eeeiixxx which means ssss = 0
       GOYES  SNZ            ssss is NOT ZERO (tested)
*
* BRANCH: ssss is ZERO; -ii is from here definitively NOT ZERO
*
       C=R1                  0,eeeiixxx is in C now (ssss is Zero tested before)
       A=R2                  +ii,000 (which is NOT ZERO) into A
       C=A    S              (C) should have the same sign than (A)
       GOSBVL =AD2-12        value (ssss=zero)+ii,eeeiixx in (A,B)
       GOSBVL =uRESD1        in C
       R1=C
       GOTO WEI
*
* Branch: ssss is not ZERO (tested)
*
SNZ    A=R1                  A is like ssss,eeeiixxx
       GOSBVL =SPLITA        A into (A,B)
       GOSBVL =CLRFRC        ssss,00 into (A,B)
       GOSBVL =uRESD1        ssss,00 into (C)
       A=R2                  +ii,000 into (A)
       SETDEC                dont forget this before MP DV .. 2-12
       GOSBVL =AD2-12        value ssss+ii,00 in (A,B)
       GOSBVL =uRESD1        ssss+ii,00 in C
       A=C    W              ssss+ii,00 in A
       R2=C                  ssss+ii,00 in R2
*
       ?A#0   M              (ssss+ii) not ZERO ?
       GOYES  WEIT           goto WEIT if (ssss+ii) not zero
*
* BRANCH: (ssss+ii) is ZERO
*
       A=0    W              necessary(?)
       R2=A                  necessary(?)
*
       A=R1                  ssss,eeeiixxx (NOT like 0,eeeiixxx) in A
       GOSBVL =SPLITA        A into (A,B)
       GOSBVL =FRAC15        0,eeeiixxx in (A,B)
       GOSBVL =uRESD1        into (C)
       C=0    S              +0,eeeiixxx (= ssss+ii,eeeiixxx) in (C)
       R1=C                  +0,eeeiixxx (= ssss+ii,eeeiixxx) in (R1)
       GOTO   WEI
*
*
* BRANCH: (ssss+ii) and (ssss) are both NOT ZERO
*
WEIT   A=R1                  ssss,eeeiixxx into A
       GOSBVL =SPLITA        ssss,eeeiixxx into (A,B)
       GOSBVL =FRAC15        0,eeeiixxx in (A,B)
       GOSBVL =uRESD1        0,eeeiixxx into (C)
       A=R2                  ssss+ii,00 into (A)
       C=A    S
       GOSBVL =AD2-12        value ssss+ii,eeeiixxx in (A,B)
       GOSBVL =uRESD1        ssss+ii,eeeiixxx into C
       R1=C                  ssss+ii,eeeiixxx in (R1)
*
* Upload the ISG action back into the variable
*
WEI    A=R1
       C=R0
       CD0EX                 exchange C(A) with D0
       DAT0=A W              Store increased value ssss+ii,eeeiixxx back into variable
*
* Now upload the TRUE FALSE into the integer stack
* So far, R2 has ssss+ii,00
* So far, R1 has ssss+ii,eeeiixxx
*
* isolate eee
*
       A=R1                  ssss+ii,eeeiixxx in (A)
*
       GOSBVL =IF12A
       ?P=    14             test if A like 0,eeeiixxx
       GOYES  SIZ            ssss+ii is ZERO (tested)
*
* BRANCH (again) ssss+ii IS NOT ZERO
*
       A=R1 
       GOSBVL =SPLITA        A into (A,B)
       GOSBVL =FRAC15        0,eeeiixxx into (A,B)
       GOSBVL =uRESD1        0,eeeiixxx (A,B) into C
       R1=C                  0,eeeiixxx in R1
*
* BRANCH (again) ssss-ii IS ZERO
* 0,eeeiixxx
*
SIZ    C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  3              1000 in (C)
       A=R1                  0,eeeiixxx into A
       SETDEC                dont forget this before MP2-12
       GOSBVL =MP2-12        eee,iixxx into (A,B)
       GOSBVL =CLRFRC        eee,00000 into (A,B)
       GOSBVL =uRESD1        eee,00 into (C)
       C=0    S              +eee,00 in (C)
       R1=C                  +eee,00 in (R1)
*
       C=R1                  +eee,00    in C
       A=R2                  ssss+ii,00 in A
       P=     1
       GOSBVL =uTEST
       SETHEX
       A=0    A
       GONC   TRO1
       A=A-1  A
TRO1   GOSBVL =GETFP
       DAT1=A A
       RTNCC
*
****************************************************************

AND: an overtaking of the GAMMA function of the Math module is currently analyzed: however, the BASIC ASM function I got from JF Garnier seems to use stack mechanisms I could not reconduct on Forth/ASM (for sure, the Forth has stack mechanisms). So, the idea is to have a GAMMA Forth/ASM (low prio); however the path to it is still not found. Any hints are welcomed.
GAMMA in pure FORTH is there https://rosettacode.org/wiki/Gamma_function#Forth and is the plan B.

UPDATED 25Sept2024: the code above
UPDATED 07Oct2024: the code above (with entry 0,xxxx it was not correctly working)

[J-F Garnier]

(09-24-2024 12:00 PM)floppy Wrote:  AND: an overtaking of the GAMMA function of the Math module is currently analyzed: however, the BASIC ASM function I got from JF Garnier seems to use stack mechanisms I could not reconduct on Forth/ASM (for sure, the Forth has stack mechanisms). So, the idea is to have a GAMMA Forth/ASM (low prio); however the path to it is still not found. Any hints are welcomed.

The gamma asm code from the Math ROM (the dogam subroutine) should be useable in a Forth primitive, rewriting only the wrapper code to interface with the Forth environment.

The code is referring to a "math scratch stack", like:

Code:

     GOSUB  =stscr+   store it to math scratch stack
     GOSUB  =rcscr+   recall from math scratch stack

The HP naming is confusing, because there is also a "Math stack", specific to BASIC, to hold parameters and results during BASIC expression evaluation.
The "math scratch stack" is different, it's a reserved fixed place in the system memory implementing a 4-level stack to hold temporary extended precision values during numeric calculations.
So I believe it's perfectly useable in Forth too.

J-F

[floppy]

Information: new word for the "HP41&71" community "DSE"
That was a hard nut: FRAC15 dont like a number like 0,xxxxxx therefore it must be tested if it is a number of type 0,xxxxxx instead of using FRAC15 for all numbers.

Code:

=IF12A  EQU #0C739           return where the decimal point is. Out is the number in P. Page 1412 If E<0, P =14 etc.
*                              alter A,B,C(A),P,CARRY

Comments/remarks are welcome.

Code:

****************************************************************
* DSE : decrement value  
* HP41 like; manual page 163; decrement and skip if equal
* It decrement sss and would "skip", what we can interpret as 
*   put a NO/false (0) in the integer stack, if it becomes equal or less than eee
* (ssss,eeeii in X) X DSE return  0  (false) if ssss <= eee
*                                 -1 (true) if ssss > eee
* use: 20.01001 X DSE  >> output .. X: 19.010010000  ..  0  OK { 0 } 
*   this value can be saved into any variable Z T or FVARX
*   then FVARX DSE can be used
*
* use cases for testing:
*   0.0 X DSE            -1.0 in X    & 0 in integ stack
*   20.00020 X DSE       0.00020 in X & 0 in integ stack
*   20.010010000 X DSE   19.010010000 in X & -1 in integer stack
*   20.010001234 X DSE   19.010001234 in X & -1 in integer stack
*   20.010023456 X DSE   18.010023456 in X & -1 in integer stack
*   0.010023456 X DSE   -2.010023456 in X & 0 in integer stack
*   1.010023456 X DSE   -1.010023456 in X & 0 in integer stack
*   20.010103456 X DSE   10.010103456 in X & 0 in integer stack
*   10.010103456 X DSE   0.010103456 in X & 0 in integer stack
*   -10.0000566666 X DSE   -15.000056667 in X & 0  OK { 0 }
*   -10.000000000  X DSE FS. .  >> X: -11.000000000 >> 0  OK { 0 } 
*   0.010003456 X DSE FS. .     >> -1.010003456 .. 0  OK { 0 }
*   1.0200234567 X DSE FS. .    >> -1.020023457 .. 0  OK { 0 } 
*   0.00000345678 X DSE FS. .   >> -1.00000345678 .. 0  OK { 0 } 
*   0.01002 X DSE FS. .         >> -2.01002        0
*   0.01 X DSE FS. .  >> -1.01                    0 
*   0.00002 X DSE FS. . >> -2.00002               0
*
* tested 07 Oct 2024
****************************************************************
       WORD 'DSE'
*       GOSBVL =uMODES        necessary?
       GOSBVL =SAVEFP
       C=DAT1 A              copy data at address in D1 into C(A)
       R0=C                  copy C(A) into R0
       CD0EX                 exchange C(A) with D0 pointer
       A=DAT0 W              value ssss,eeeiixxx into A
*
* saving the original value of the float variable
*
       R1=A                  value ssss,eeeiixxx into   >> R1 <<
*
* ssss or sssseee or sssseeeii = 0 seems to be an issue because the numbers after ii , are gone. 
*               lets consider that case to bypass later calculations
*               >> FRAC15 dont like something like 0,xxxx
*
* 10000 in (C)
       C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  5              just retracting 5x 1 in X was not making it
*
       A=R1                  seems to make it better; see %OF, too
*                            = upload A after C prior MV DV ADD..
       SETDEC
       GOSBVL =MP2-12        sssseeeii,xxx into (A,B)
       GOSBVL =CLRFRC        sssseeeii,000 into (A,B)
       GOSBVL =uRESD1        into (C)
       R2=C                  sssseeeii,000 into R2
       C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  998            0,01 now in C
*
       A=R2                  sssseeeii,000 into A
       SETDEC
       GOSBVL =MP2-12        sssseee,ii000 into (A,B)
       GOSBVL =CLRFRC        sssseee,00000 into (A,B); carry set if ii=00
*
       GONC   nadd0          if 0,ii000 # 0,00 then dont add one
*
* BRANCH: ii is ZERO .. then add ONE
*
       A=R2                  sssseee00,000 into A
       C=0    W
       P=     14
       C=C+1  P              1 in Register C
       C=A    S              it makes -1 if A<0; +1 if A>0
       A=R2                  sssseee00,000 into A
       GOSBVL =AD2-12        sssseee01,000 in (A,B)
       GOSBVL =uRESD1        sssseee01,000 into (C)
       R2=C                  sssseee01,000 into (R2)
*
* BRANCH: ii IS NOT ZERO from here
*
nadd0  C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  998            0,01 now in C
       A=R2                  from here, sssseeeii,000 into A
       SETDEC
       GOSBVL =MP2-12        sssseee,ii000 into (A,B)
       GOSBVL =FRAC15        0,ii000 in (A,B). ii#00 for sure here  issue there if sssseee = 0?
       GOSBVL =uRESD1        into (C)
       A=C    W              0,ii000 into A
       P=     15
       A=0    P              +0,ii000 in (A)
       SETDEC
       A=-A-1 S              A = -0,ii000
       R2=A                  -0,ii000 in R2 now
       C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  2              100 in C
       A=R2                  -0,ii000 in (A)
*
       SETDEC                dont forget this before MP DV .. 2-12
       GOSBVL =MP2-12        -ii,000 into (A,B)
       GOSBVL =uRESD1        -ii,000 into (C)
*
       R2=C                  -ii,000 into (R2)
*
* ssss could be zero and could make an issue later with the use of FRAC15
* which is not necessary in case this is already 0,eeeiixxxx
*
       A=R1                  ssss,eeeiixxx into A
       GOSBVL =IF12A
       ?P#    14             test if A is like 0,eeeiixxx which means ssss = 0
       GOYES  SNZ            ssss is NOT ZERO (tested)
*
* BRANCH: ssss is ZERO; -ii is from here definitively NOT ZERO
*
       C=R1                  0,eeeiixxx is in C now (ssss is Zero tested before)
       A=R2                  -ii,000 (which is NOT ZERO) into A
       C=A    S              (C) should have the same sign than (A)
       GOSBVL =AD2-12        value (ssss=zero)-ii,eeeiixx in (A,B)
       GOSBVL =uRESD1        in C
       R1=C
       GOTO WEI
*
* Branch: ssss is not ZERO (tested)
*
SNZ    A=R1                  A is like ssss,eeeiixxx
       GOSBVL =SPLITA        A into (A,B)
       GOSBVL =CLRFRC        ssss,00 into (A,B)
       GOSBVL =uRESD1        ssss,00 into (C)
       A=R2                  -ii,000 into (A)
       SETDEC                dont forget this before MP DV .. 2-12
       GOSBVL =AD2-12        value ssss-ii,00 in (A,B)
       GOSBVL =uRESD1        ssss-ii,00 in C
       A=C    W              ssss-ii,00 in A
       R2=C                  ssss-ii,00 in R2
*
       ?A#0   M              (ssss-ii) not ZERO ?
       GOYES  WEIT           goto WEIT if (ssss-ii) not zero
*
* BRANCH: (ssss-ii) is ZERO
*
       A=0    W              necessary(?)
       R2=A                  necessary(?)
*
       A=R1                  ssss,eeeiixxx (NOT like 0,eeeiixxx) in A
       GOSBVL =SPLITA        A into (A,B)
       GOSBVL =FRAC15        0,eeeiixxx in (A,B)
       GOSBVL =uRESD1        into (C)
       C=0    S              +0,eeeiixxx (= ssss-ii,eeeiixxx) in (C)
       R1=C                  +0,eeeiixxx (= ssss-ii,eeeiixxx) in (R1)
       GOTO   WEI
*
*
* BRANCH: (ssss-ii) and (ssss) are both NOT ZERO
*
WEIT   A=R1                  ssss,eeeiixxx into A
       GOSBVL =SPLITA        ssss,eeeiixxx into (A,B)
       GOSBVL =FRAC15        0,eeeiixxx in (A,B)
       GOSBVL =uRESD1        0,eeeiixxx into (C)
       A=R2                  ssss-ii,00 into (A)
       C=A    S
       GOSBVL =AD2-12        value ssss-ii,eeeiixxx in (A,B)
       GOSBVL =uRESD1        ssss-ii,eeeiixxx into C
       R1=C                  ssss-ii,eeeiixxx in (R1)
*
* Upload the DSE action back into the variable
*
WEI    A=R1
       C=R0
       CD0EX                 exchange C(A) with D0
       DAT0=A W              Store increased value ssss-ii,eeeiixxx back into variable
*
* Now upload the TRUE FALSE into the integer stack
* So far, R2 has ssss-ii,00
* So far, R1 has ssss-ii,eeeiixxx
*
* isolate eee
*
       A=R1                  ssss-ii,eeeiixxx in (A)
*
       GOSBVL =IF12A
       ?P=    14             test if A like 0,eeeiixxx
       GOYES  SIZ            ssss-ii is ZERO (tested)
*
* BRANCH (again) ssss-ii IS NOT ZERO
*
       A=R1 
       GOSBVL =SPLITA        A into (A,B)
       GOSBVL =FRAC15        0,eeeiixxx into (A,B)
       GOSBVL =uRESD1        0,eeeiixxx (A,B) into C
       R1=C                  0,eeeiixxx in R1
*
* BRANCH (again) ssss-ii IS ZERO
* 0,eeeiixxx
*
SIZ    C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  3              1000 in (C)
       A=R1                  0,eeeiixxx into A
       SETDEC                dont forget this before MP2-12
       GOSBVL =MP2-12        eee,iixxx into (A,B)
       GOSBVL =CLRFRC        eee,00000 into (A,B)
       GOSBVL =uRESD1        eee,00 into (C)
       C=0    S              +eee,00 in (C)
       R1=C                  +eee,00 in (R1)
*
       C=R2                  ssss-ii,00 in C
       A=R1                  +eee,00    in A
       P=     1
       GOSBVL =uTEST
       SETHEX
       A=0    A
       GONC   TRO1
       A=A-1  A
TRO1   GOSBVL =GETFP
       DAT1=A A
       RTNCC
*
****************************************************************

[floppy]

In order to initiate a float variable for the ISG and DSE words, here is a new word: it uses the integer stack for this. Questions/remarks are welcomed.

Code:

****************************************************************
* CLCV : control looping creation in variable
* use IIIII FFF CC FVAR CLCR where 
*       IIIII is the counter value integer
*       FFF   is the counter test value integer
*       CC    is the increment value integer
*       FVAR  is the float variable where IIII.FFFCC will be stored
*     IIIII FFF CC 
*         1     22    3    X    CLCV  will put  1.02203  into X
*   D1+20 D1+15 D1+10 D1+5 D1 (?)
*
* tested 2024 Oct 16
* 777 888 11 Y CLCV FS.   result  Y: 77.888110000 
****************************************************************
       WORD 'CLCV'
       GOSBVL =SAVEFP
*
       P= 0                  Set to 0 made it.
       D1=D1+ 5              CC; go to the first address of the variable in the integ stack 
       A=DAT1 A              copy data at address in D1 into A(A)
       GOSBVL =HDFLT         change A(A) to float A(W) 12 digits for further calc. exit with DEC mode
       R0=A
       C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  995            0,00001 now in (C)
       A=R0
       SETDEC
       GOSBVL =MP2-12        0,000CC into (A,B)
       GOSBVL =uRESD1        into (C)
       R1=C
*
       D1=D1+ 5
       A=DAT1 A              copy data at address in D1 into A(A)
       GOSBVL =HDFLT         change A(A) to float A(W) 12 digits for further calc. exit with DEC mode
       R0=A
       C=0    W
       P=     14
       C=C+1  P
       P=     0
       LCHEX  3              1000 in (C)
       A=R0
       SETDEC
       GOSBVL =DV2-12        0,FFF into (A,B)
       GOSBVL =uRESD1        into (C)
       A=R1
       SETDEC
       GOSBVL =AD2-12        0,FFFCC into (A,B)
       GOSBVL =uRESD1        into (C)
       R1=C
*
       D1=D1+ 5              IIIII
       A=DAT1 A              copy data at address in D1 into A(A)
       GOSBVL =HDFLT         change A(A) to float A(W) 12 digits for further calc. exit with DEC mode
       R0=A
       C=R1
       A=R0
       SETDEC
       GOSBVL =AD2-12        IIIII,FFFCC into (A,B)
       SETHEX
       GOSBVL =uRESD1        into (C)
       R1=C                  IIIII,FFFCC into R1
*
       D1=D1- 15
       C=DAT1 A              copy data at address in D1 into C(A)
       CD0EX                 Put it into D0
       A=R1                  IIIII,FFFCC into A
       DAT0=A W              Store value IIIII,FFFCC into variable
       D0=C
*
       GOSBVL =GETFP
       D1=D1+ 15
       D1=D1+ 5
       RTNCC
*
****************************************************************

[floppy]

Now here is the good old FACT function from HP41. Same behaviour now in HP71B Forth.

Entry point new to be used (see other entry points in previous posts)

Code:

=FAC15S EQU #0E72B           factorial 15digit (A,B) into (A,B), v3 page 1591

Code:

****************************************************************
* FACT : factorial function (see HP41)
* tested 18 Oct 2024
* use: 6.0 FACT
* > X: 720.000000000 
* > L: 6.000000000 
       WORD 'FACT'
       GOSBVL =NUMST
       SB=0                  issue gone when included
       XM=0                  same
       SETDEC                same
       GOSBVL =FAC15S
       GOSBVL =PUTABX
       RTNCC
****************************************************************

[floppy]

(09-25-2024 07:18 AM)J-F Garnier Wrote:  

(09-24-2024 12:00 PM)floppy Wrote:  AND: an overtaking of the GAMMA function of the Math module is currently analyzed: however, the BASIC ASM function I got from JF Garnier seems to use stack mechanisms I could not reconduct on Forth/ASM (for sure, the Forth has stack mechanisms). So, the idea is to have a GAMMA Forth/ASM (low prio); however the path to it is still not found. Any hints are welcomed.

The gamma asm code from the Math ROM (the dogam subroutine) should be useable in a Forth primitive, rewriting only the wrapper code to interface with the Forth environment.

The code is referring to a "math scratch stack", like:

Code:

     GOSUB  =stscr+   store it to math scratch stack
     GOSUB  =rcscr+   recall from math scratch stack

The HP naming is confusing, because there is also a "Math stack", specific to BASIC, to hold parameters and results during BASIC expression evaluation.
The "math scratch stack" is different, it's a reserved fixed place in the system memory implementing a 4-level stack to hold temporary extended precision values during numeric calculations.
So I believe it's perfectly useable in Forth too.

J-F

+1
it looks like there are several RAM scratch area which could be usefull in case ASM code is getting short in CPU registers.

comments/remarks are welcome.

Code:

2F599 =MTHSTK    5Nibs address of [b]math stack. Or called AVMEME see v3p3086. Available RAM depending of ROM or RAM modules in the ports[/b]

manipulation with following entry points

Code:

    0BD8D    MPOP1N    entry: D1 to Math Stack
                    uMODES before POP1N+ v3p1366
    0BD1C     POP1N    entry: D1 to Math Stack
                    Put number from stack into A v3p1362
    0BD91     POP1N+    entry: D1 to Math Stack
                    to POP1N v3p1366
    0BC8C    POP2N    entry: D1 to Math Stack
                    Put 2x number from stack into A and C v3p1360
    (0E8FD    POP1R    entry: D1 to Math Stack
                    Same as POP1N, v3p1605)    
    0E8F7        pop2n+    v3p1604
    0BD58        POP2N+    entry: D1 to Math Stack
                    to POP2N v3p1365
    0BD54        MPOP2N    entry: D1 to Math Stack
                    uMODES .. before POP2N v3p1365
    0E25B     pshstk         entry: D1 to current top of Math Stack
                    push math stack by 16nibs v3 p1558 
                    (NOT like PSHSTK stack pointer, 
                    preserve math stack, v3 p1078)
                    exit: new D1

    (13DB3    STK16?    Check free space for 16nibs v3 p2095)
    (13DB6    CHKSTK)      ??

    13E21        D1MST+          Set D1 to MTHSTK and clear all ST, set S8?.. v3 p2096
    145FC        D1mstk    link to D1MSTK v3p2120
    1954E        D1MSTK       Set D1 to MTHSTK (AVMEME)  v2p226  v3p2503
    1953C        MSTKD1         Set MTHSTK to D1 v3p2503, use p2494

    1B3DB    POPMTH       skip item on MTHSTK (for counting/finding MTHSTK items)

    18BB8        =AVE=D1     v3p2457
    18BBB    =AVE=C     C(A) new value for AVMEME v3p2457
    10489        =C=RAME    read in RAMEND v3p1788
    18651        =D1=AVE    set D1 at AVMEME v3p2436
    18658        D1=@D1    v3p2436
    1864D        GETAVM    reads (AVMEME) into C(A)&D1 
                        and (AVMEMS) into D(A) v3p2435    
    1A476        =D=AVME    v3p2552 read AVMEME into D(A)
    1A460        =D=AVMS    v3p2552 read AVMEMS into D(A)
    1A46A        D=@D1    v3p2552 keep carry

other reserved RAM area..

Code:

2F871     STMTR0     16Nibs (*4 = 64bits) like A or B or C or D

Code:

    2F871        S-R0-0        5nibs
    2F876        .. -1        5
    2F87B        .. -2        5
    2F880        .. -3        1

words

Code:

    0E04F        D0=SR0    D0 linked to S-R0-0 v3p1539
    07F7D        D1=SR0          D1 linked to S-R0-0 .. D1(5) = STMTRO  v3p989
    0E05F        D1=SR1    D1 linked to S-R0-1 v3p1539

another area..

Code:

2F881    STMTR1     16Nibs
    2F881        S-R1-0        5Nibs
    2F886        .. -1        5
    2F88B        .. -2        5
    2F890        .. -3        1

words

Code:

    none identified for immediate use in Forth ASM

Code:

2F891    STMTD0     5Nibs (20bits) like D0 or D1

words

Code:

    1129D        RESTD0    restore D0 from STMTD0

another area..

Code:

2F896    STMTD1     5Nibs

another big area..

Code:

2F8C5    TRFMBF     60Nibs (16+16+16+12) see page v3p2281 p2306

another area..

Code:

2F89B FUNCR0    16Nibs
    2F89B        F-R0-0        5Nibs
    2F8A0        .. -1        5
    2F8A5        .. -2        5
    2F8AA    .. -3        1

words for manipulation

Code:


    1C587        SAVD0    save D0 in address stored in F-R0-0 v3p2820    
    1C578        SAVD1    .. in F-R0-1
    1C596        RSTD1            v3p2821    D1 from address in F-R0-1
        08C44        rstd1        GOVLNG  RSTD1
    06832        RSTD0    restore D0 from F-R0-0     v3p822

another area..

Code:

2F8AB     FUNCR1    16Nibs
    2F8AB        F-R1-0        5Nibs
    2F8B0        .. -1        5
    2F8B5        .. -2        5
    2F8BA        .. -3        1
2F8BB     FUNCD0    5Nibs (20bits) which has same size like D0 or D1
2F8C0    FUNCD1    5Nibs

the scratsch area from the gamma word..

Code:

2F901 SCRTCH with entry points for storing/recovering 4* A/B-data in it
    the first 4x16 Nibs are OK for storing data.
    The next Nibs have area for exponent storage and could interfer with other scratch area for 
    timer or display or .. see below, if the area are not selected carefully

words to manipulate

Code:

    (2F901        SCRSTO)
    0E954        RCSCR     pops 15form from math scratch stack into (C,D)  
                        v3p1608 (call GSCPTR,..) uses C(A), P, D0
    0E24D        stscr         GOTO STSCR, v3p1557
    0E92C        STSCR    push 15form (A,B)  into math scratch stack  (call GSCPTR,..) 
                        v3p1607, update data pointer
    0E251        rclw1+        save D0 in R3 and exit with RCLW1 v3p1557
    0E257        rclw1        GOTO RCLW1, v3p1557
    0E981        RCLW1     move A/B to C/D and math stack entry into A/B v3p1557
                    uses A,B,C,D, P, D0
    0E9B2        RCLW2          ..
    0E9C4        RCLW3          ..
    0E983        RCL*         (P=0 RCL* == RCLW1.. P=3 RCL* == RCLW4)
    12AAC    ST01          save R0 R1 in RAM SCRTCH v3p1988 SCRTCH(0-15)=R0, 
                        ..(16-31) = R1
    12AC6        RC01        restore v3p1989
    1AF5D    STRALL    save A-D D0 D1,mode,P,SB in SCRTCH v3p2610
    1AFBF    RCLALL    rcl .. v3p2612

and perhaps more here..

Code:

2F986 RESERV    48*2    „HP-71B Resource Allocations“ = 6*16 = 3* (double float)
            define a new word STO2 for save R2 R3 in RESERV ? Or in .. ?