RE: (HP71B) ASM question
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)
HP71B 4TH/ASM/Multimod, HP41CV/X/Y & Nov64d, PILBOX, HP-IL 821.62A & 64A & 66A, Deb11 64b-PC & PI2 3 4 w/ ILPER, VIDEO80, V41 & EMU71, DM41X
|
Search
Member List
Calendar
Help
