+- HP Forums (https://www.hpmuseum.org/forum)
+-- Forum: HP Calculators (and very old HP Computers) (/forum-3.html)
+--- Forum: General Forum (/forum-4.html)
+--- Thread: (HP71B) ASM question (/thread-22037.html)
Pages: 1 2
RE: (HP71B) ASM question - J-F Garnier - 08-05-2024 02:12 PM
(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
RE: (HP71B) ASM question - floppy - 08-17-2024 08:46 AM
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? NOTCode:
=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 =XXYYUPDATE. 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 =XXYYAny remarks are welcomed for improvement or shortening of such suggested Forth words.
RE: (HP71B) ASM question - floppy - 08-17-2024 01:40 PM
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 addressCode:
* 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
RTNCCCode:
* 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
RTNCCCode:
* 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
RTNCCCode:
* 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)
RTNCCMore 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.
RE: (HP71B) ASM question - floppy - 08-22-2024 09:32 AM
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 pointersCode:
* 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
RTNCCUPDATE: missing entry points included
RE: (HP71B) ASM question - floppy - 08-23-2024 07:37 AM
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 pointersCode:
* 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
RTNCCRE: (HP71B) ASM question - floppy - 09-03-2024 03:36 PM
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
************************************************************RE: (HP71B) ASM question - floppy - 09-24-2024 12:00 PM
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)
RE: (HP71B) ASM question - J-F Garnier - 09-25-2024 07:18 AM
(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 stackThe 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
RE: (HP71B) ASM question - floppy - 10-07-2024 11:24 AM
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,CARRYComments/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
*
****************************************************************RE: (HP71B) ASM question - floppy - 10-16-2024 10:00 AM
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
*
****************************************************************RE: (HP71B) ASM question - floppy - 10-18-2024 08:55 AM
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 1591Code:
****************************************************************
* 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
****************************************************************