%%HP: T(3)A(D)F(.);
DIR
SETUP
\<< CCD \->RPL EVAL
\>>
Cst
C$ 1169 (Cst)
{
ROMPTR 4D2 0 (RPL\->)
ROMPTR 4D2 1 (\->RPL)
{
::
TakeOver
$ "5/7" 63
TestUserFlag
Box/StdLabel
;
::
TakeOver
63 DUP TestUserFlag
ITE
ClrUserFlag
SetUserFlag
;
}
{
::
TakeOver
$ "Disassembler On/Off"
DROP
4 SysITE
GROB 3A 8000051000000000FFFFF118B30114440114550114440118B301FFFFF1
GROB 3A 8000051000000000FFFFF11000011000011000011CB701100001FFFFF1
;
:: PTR 3ED84 4
SetDA12NoCh
;
}
{
::
TakeOver
$ "S-ED" 61
TestUserFlag
Box/StdLabel
;
::
TakeOver
61 DUP TestUserFlag
ITE
ClrUserFlag
SetUserFlag
SetDA12NoCh
;
}
ROMPTR 4D2 5 (\->OB)
{ $ "EC"
:: TakeOver
ROMPTR 4D2 C (EC)
; }
ROMPTR 4C5 20 (PGLIB)
{
$ "SEND"
::
CK1NoBlame
BlankDA12
xSEND
xKERRM
xCLOSEIO
%0 InitMenu%
DUPNULL$? caseDROP
;
}
{
$ "RECV"
::
AtUserStack
BlankDA12
xRECV
xKERRM
xCLOSEIO
%0 InitMenu%
DUPNULL$? caseDROP
;
}
{
:: PTR 3ECD0
$ "RPRT" 13
;
:: PTR 3ED84 13
SetDA12NoCh
;
}
{
$ "CF1-8"
::
TakeOver
8
#1+_ONE_DO
INDEX@ ClrUserFlag
LOOP
SetDA2NoCh
SetDA3NoCh
;
}
}
LIBMENU
C$ 1675 (LIBMENU)
{
$ "\\<-LIB\\->"
::
MenuMaker
::
PTR 3F036 PTR 3EFE6
{
{ $ "\\->OB\\->"
:: TakeOver
{
ROMPTR 4C5 5 (OB\->)
ROMPTR 4C5 6 (\->DIR)
ROMPTR 4C5 7 (\->PRG)
ROMPTR 4C5 8 (\->XLIB)
ROMPTR 4C5 9 (\->ARR)
ROMPTR 4C5 A (\->ALG)
ROMPTR 4C5 B (\->LD)
ROMPTR 4C5 C (\->BAK)
ROMPTR 4C5 D (\->ID)
}
InitMenu
;
}
{ $ "\\->LIB\\->"
:: TakeOver
{
ROMPTR 4C5 0 (D\->LIB)
ROMPTR 4C5 1 (L\->DIR)
ROMPTR 4C5 2 (MCFG)
ROMPTR 4C5 3 (ML\->D)
ROMPTR 4C5 4 (MD\->L)
}
InitMenu
;
}
{ $ "VARS"
:: TakeOver
{
ROMPTR 4C5 F ($romid)
ROMPTR 4C5 10 ($visible)
ROMPTR 4C5 11 ($title)
ROMPTR 4C5 12 ($config)
ROMPTR 4C5 13 ($vars)
ROMPTR 4C5 14 ($hidden)
ROMPTR 4C5 15 ($message)
}
InitMenu
;
}
{ $ "RCL"
:: TakeOver
{
ROMPTR 4C5 1F (RLIB)
ROMPTR 4C5 1D (RTITLE)
ROMPTR 4C5 1B (RCFG)
ROMPTR 4C5 1C (RMSG)
ROMPTR 4C5 1A (RLINK)
ROMPTR 4C5 19 (RHASH)
ROMPTR 4C5 1E (RPORT)
}
InitMenu
;
}
{ $ "TOOLS"
:: TakeOver
{
ROMPTR 4C5 16 (LBCRC)
ROMPTR 4C5 17 (RNLIB)
ROMPTR 4C5 18 (CHLID)
ROMPTR 4C5 E (ADRp)
ROMPTR 4C5 26 (fEVAL)
}
InitMenu
;
}
{ $ "CTRL"
:: TakeOver
{
ROMPTR 4C5 21 (STLIB)
ROMPTR 4C5 22 (ACLIB)
ROMPTR 4C5 20 (PGLIB)
ROMPTR 4C5 25 (LIBSp)
ROMPTR 4C5 24 (INSTp)
ROMPTR 4C5 23 (LIBp)
}
InitMenu
;
}
}
;
PTR 40DC0
;
}
\->Rpl
C$ 538 (\->Rpl,$ \-> o)
ASSEMBLE
EvalNoCK: EQU #18F6A
RPL
::
CK1NoBlame
BEGIN
1LAMBIND
ERRSET
::
1GETLAM
ROMPTR 4D2 1 (\->RPL)
TRUE
;
ERRTRAP
:: DropSysObs FALSE
;
1GETABND SWAP
ITE
DROPTRUE
::
ERROR@
DUP#0=csedrp TRUE
DUP GETTHEMESG SWAP
# 70000 #=case
::
DUP DISPSTATUS2
DUPUNROT
SEP$NL SWAPDROP
DUP $ ":" OVERLEN$
POS$REV #1+
OVERLEN$ SUB$
DOSTR> TWO{}N
EvalNoCK: xINPUT
FALSE
;
$ "\\->RPL Error:\\010"
SWAP&$ DISPSTATUS2
SetDA1Temp
TRUE
;
UNTIL
;
DCD
C$ 521 (DCD,d \-> d')
::
CK1NoBlame
DUPTYPERRP? NcaseTYPEERR
ROMPTR 4C5 5 (OB\->)
COERCE
DUP#0=case SETSIZEERR
DUP #2* 1LAMBIND
BlankDA2
$ "Processing:\\010"
DISPSTATUS2
#1+_ONE_DO
1GETLAM ROLL
1GETLAM ROLL
DUP ID>$ DISPROW2
SWAP
::
DUPTYPERRP? ?SEMI
XEQTYPE %25 %=
ITE
::
ROMPTR 4D2 3 (COD\->)
OVER ID>$ CHR_*
;
::
ROMPTR 4D2 0 (RPL\->)
OVER ID>$
CHR_RightPar >T$
CHR_LeftPar
;
>H$ NEWLINE$&$
!insert$
;
SWAP
LOOP
1GETABND #2/
UNCOERCE
ROMPTR 4C5 6 (\->DIR)
;
CCD
C$ 451 (CCD, \-> d)
::
AtUserStack
$ "Processing:\\010"
DISPSTATUS2
ZERO
DOVARS DUP1LAMBIND
LENCOMP
#1+_ONE_DO
1GETLAM INDEX@
NTHCOMPDROP
DUP ID>$ DISPROW2
DUP XEQRCL
::
DUPTYPERRP? case2DROP
DUPTYPECSTR?
IT
::
DUP DUPNULL$?
ITE
DROPZERO
CAR$
CHR>#
40 #=casedrop
ROMPTR 4D2 1 (\->RPL)
42 #<> ?SEMI
ROMPTR 4D2 4 (\->COD)
DROP
;
SWAPROT #1+
;
LOOP
ABND
UNCOERCE
ROMPTR 4C5 6 (\->DIR)
;
DAR
C$ 626 (DAR,h \-> $)
::
CK1NoBlame
DUPTYPEHSTR?
NcaseTYPEERR '
:: 8
#1+_ONE_DO
INDEX@ ClrUserFlag
LOOP
;
' ROMPTR 4D2 7 (DA1)
ROMPTR@ NOTcase
PTR 11056
OVER
' NULLLAM DUPTWO DOBIND
EVAL DUPDUP BlankDA12
$ "Press <ENTER> to see next line"
DispCoord1
BEGIN
2GETLAM EvalNoCK
SWAP
ABUFF 0 8 131 64
SUBGROB
ABUFF ZEROZERO GROB!
DISPROW7
WaitForKey
DROP 45 #=casedrop
:: 1GETABND EVAL
ABORT
;
25 #<>
UNTIL
1GETABND EVAL
OVER HXS>$ $ "From: "
!insert$ NEWLINE$&$
OVER HXS>$ $ "To : "
!insert$ !append$
DISPSTATUS2
ROMPTR 4D2 8 (DAXY)
SWAP HXS>$ $ "* "
!insert$ NEWLINE$&$
!insert$
;
DBG
"(DBG, \-> )
::
63 TestUserFlag
1LAMBIND
63 SetUserFlag
ROMPTR 4D2 13 (DispStack)
WaitForKey DROP
63 1GETABND
ITE_DROP ClrUserFlag
25 (kcEnter) #= ?SEMI
AtUserStack ABORT
;"
Types
"(Types, \-> )
::
AtUserStack BlankDA2
13 18
GROB 398 320008600020003D00003E6E0EE4400776AE500805100801AA082011051AAA50083510080D6A0E688007366E5A2825100809AA082440041AA22A283D00003EAE0E20110716A2000000000000000000000000003208312118172E0AE85402726E2800215B1822510A24011512A42400117518227D0E64880732A4220801511822590824440512A47808075118125E082811151E64000000000000000000000000007C28300008359A3EE4C6037EA6428825200805B21224440512A4724830000815F21E6444033644122825200805D21824440512A47C8830100837921E2CD6031EAE000000000000000000000000007C38321E09351D0CE85D067EAE4A0825118A05151224451112A87C18371D8A121D0E64CD01364E482025198A05151A24451112A27E18357E09057D0E2855161EAE0000000000000000000000000056301656893A000EE8DD037EAE52282151090F100824451512A872283221091A0004644515364E42282421090F100224451512A8463823268B0A000228DD031EAE000000000000000000000000007C6815568B33370EE443077EAA144825510A05550A24450112AA76C817228B13370E644303364E444825548805510A24450112A87C6815538B05510E2C53071EA8
XYGROBDISP
SetDA2OKTemp
;"
tEVAL
C$ 179 (tEVAL,o \-> ?)
::
CK1NoBlame
GARBAGE
CLKTICKS 1LAMBIND
xEVAL
CLKTICKS 1GETABND
bit- HXS>%
% 8.192 DUPUNROT %/
SWAP %- %3 RNDXY
UNIT
%1 CHR m $ "s" umP
umEND
;
UM>U
;
MON
"(MON, \-> ?)
::
AtUserStack
{
18 16 17 11 49 44
39 34 29 28 27 26
}
{
#1 #FFFFF
#10 #FFFF0
#100 #FFF00
#1000 #FF000
#10000 #F0000
#70 #FFF90
}
' NULLLAM DUPTWO DOBIND
NULL$ #142 EXPAND
ID MONpar
DUPTYPEHSTR? ?SKIP
::
DROP' ID MONpar
HXS 5 00100
OVER STO EVAL
;
BEGIN
BEGIN
CODE
GOSBVL =SAVPTR
A=DAT1 A
A=A+CON A,10
R0=A
D0=A
A=DAT0 A
R1=A
D1=D1+ 5
A=DAT1 A
D1=A
D1=D1+ 10
LC(5) 6
B=C A
LBEDB6
LC(5) 4
D=C A
A=R0
D0=A
D1=D1+ 8
LBEDC8
GOSUB LBEE33
D1=D1- 2
D=D-1 A
GONC LBEDC8
D1=D1+ 12
LCASC ':'
DAT1=C B
D1=D1+ 2
LC(5) #F
D=C A
D0=D0- 5
A=DAT0 A
D0=A
LBEDF3
GOSUB LBEE33
D1=D1+ 2
D=D-1 A
GONC LBEDF3
LC(2) #A
DAT1=C B
D1=D1+ 2
A=R0
D0=A
A=DAT0 A
A=A+CON A,16
DAT0=A A
B=B-1 A
GONC LBEDB6
A=R0
D0=A
A=R1
DAT0=A A
GOVLNG =GETPTRLOOP
LBEE33
C=0 B
C=DAT0 1
LAASC '0'
C=C+A B
LAASC '9'
?C<=A B
GOYES LBEE5A
LA(2) 7
C=C+A B
LBEE5A
DAT1=C B
D0=D0+ 1
RTN
ENDCODE
OVER 1 7 Disp5x7
?ATTNQUIT
GETTOUCH
UNTIL
H/W>KeyCode
1GETLAM 2GETLAM ROT
#=POSCOMP NTHELCOMP
ITE
CODE
GOSBVL =POP#
GOSBVL =SAVPTR
C=DAT1 A
CD1EX
D1=D1+ 10
C=DAT1 A
C=C+A A
DAT1=C A
GOVLNG =GPPushFLoop
ENDCODE
TRUE
UNTIL
DROP ABND
;"
PBYTES
"(PBYTES,% \-> %')
ASSEMBLE
PORTDUMP EQU #21922
RPL
::
CK1NoBlame CKREAL
COERCE
PORTDUMP
DUP#0=csedrp
:: DROP %0
;
ZEROSWAP
ZERO_DO
SWAP OSIZE #+
LOOP
SWAPDROP
UNCOERCE %2 %/
;"
FIXIT
C$ 369 (FIXIT,$ \-> o)
::
CK1NoBlame
DUPTYPECSTR?
NcaseTYPEERR
DUPONE 7 SUB$
$ "HPHP48-" EQUAL
NcaseSIZEERR
DUPLEN$ 8 #- #2*
SWAP GARBAGE
CODE
C=DAT1 A
CD1EX
D1=D1+ 10
D1=D1+ 16
CD1EX
DAT1=C A
LOOP
ENDCODE
DUP XEQTYPE %27 %=
casedrop
::
# 304 ERRORSTO
ERRJMP
;
DUP OSIZE ROT #>
casedrop
::
# 12C ERRORSTO
ERRJMP
;
AtUserStack
TOTEMPOB
;
GetKO
C$ 130 (GtKO, \-> o %)
::
AtUserStack BlankDA2
$ "Perform a keystroke\\031"
DISPROW5
WaitForKey
2DUP Key>U/SKeyOb
UNROT CodePl>%rc.p
;
Strip
"(Strip,o \-> o')
::
CK1NoBlame
'
::
?ATTNQUIT
DUPTYPELIST? case
:: 1GETLAM EVAL {}N
;
DUPTYPESYMB? case
:: 1GETLAM EVAL SYMBN
;
DUPTYPECOL? NOT?SEMI
DUPLENCOMP #0=?SEMI
DUP CARCOMP
' x<< EQ IT CDRCOMP
DUP DUPLENCOMP
NTHELCOMP NOT?SEMI
' x>> EQ IT
::
DUPLENCOMP #1-
ONESWAP SUBCOMP
;
1GETLAM EVAL ::N
;
DUP
'
::
INNERDUP
DUP#0=csDROP
ZERO_DO
ROLL
BEGIN
{ xENDTIC
xIF xUNTIL
}
OVER ' EQ POSCOMP
#0<>
WHILE
::
DROP
ISTOP@
#1-DUP ISTOPSTO
INDEX@
OVER#=case DROP
ROLL
;
REPEAT
INHARDROM?
?SKIP 2GETEVAL
ISTOP@
LOOP
;
' NULLLAM DUPTWO
DOBIND EVAL ABND
;"
F&R
"(F&R,$ $f $r \-> $')
::
CK3NOLASTWD
0LASTOWDOB!
CK&DISPATCH1
# 333 ($$$)
::
UNROT 2DUP 1 POS$
DUP#0=case
:: 2DROP SWAPDROP
;
SWAP DUPLEN$
5UNROLL 5UNROLL
NULL$ UNROT
BEGIN
2DUP 7PICK #+
OVERLEN$ SUB$
5UNROLL
#1-1SWAP SUB$ &$
OVER &$ ROTDUP
6PICK 1 POS$
DUP#0=
UNTIL
DROP &$
4UNROLL3DROP
;
;"
DIFF
"(DIFF,{} {} \-> {}')
ASSEMBLE
Fast EQU 1
RPL
::
0LASTOWDOB!
CK2NOLASTWD
CK&DISPATCH1
#55 ({} {})
::
DUPNULL{}? caseDROP
SWAP DUPNULL{}?
case SWAPDROP
INNERDUP #2+ROLL
ZERO ROT
ZERO_DO
DUP #3+PICK
3PICKSWAP
ASSEMBLE
IFEQ Fast
CON(5) =EQUALPOSCOMP
ELSE
CON(5) =DOCODE
REL(5) len
INCLUDE EPC
len
ENDIF
RPL
#0=ITE
#1+
:: DUP #3+ ROLLDROP
;
LOOP
SWAPDROP {}N
;
;"
EPC
"
* EqualPosComp
A=DAT1 A
R1=A
AD1EX
C=DAT1 A
R2=C
D1=A
D1=D1+ 5
D=D+1 A
A=DAT1 A
D1=D1+ 5
D=D+1 A
GOSBVL =SAVPTR
D0=A
D0=D0+ 5
C=0 A
GONC EqLpEn
NotFnd
A=0 A
R0=A
GOTO P#Lp
EqLp
GOSBVL =SKIPOB
C=R0.F A
EqLpEn
C=C+1 A
R0=C.F A
A=DAT0 A
LC(5) =SEMI
?C=A A
GOYES NotFnd
D1=A
A=DAT1 A
LC(5) =PRLG
?C#A A
GOYES InDir
AD0EX
D0=A
D1=A
A=DAT1 A
InDir
C=R2.F A
?C#A A
GOYES EqLp
CD0EX
R3=C.F A
A=R1.F A
D0=A
B=A A
GOSBVL =SKIPOB
C=B A
CD1EX
D=C A
CD0EX
C=C-B A
B=C A
GOSBVL =SKIPOB
C=D A
A=C A
AD0EX
C=A-C A
?B=C A
GOYES EqLen
NotEq
P= 0
C=R3.F A
D0=C
GOTO EqLp
EqLen
BSR A
P=C 0
Ck16
B=B-1 A
GOC CkP
A=DAT0 W
C=DAT1 W
?C#A W
GOYES NotEq
D0=D0+ 16
D1=D1+ 16
GONC Ck16
CkP
P=P-1
GOC IsEq
A=DAT0 WP
C=DAT1 WP
?C#A WP
GOYES NotEq
IsEq
P= 0
P#Lp
GOVLNG =PUSH#LOOP"
Time
"(Time, \-> )
ASSEMBLE
SetDA1NoCh EQU #393D3
RPL
::
AtUserStack
#FFFFF DUPDUP
'
::
SWAP 10 #/
ROTSWAP #1+
1GETSWAP
NTHCOMPDROP
HARDBUFF 3PICK 28
GROB!
SWAP#1+
1GETSWAP
NTHCOMPDROP
HARDBUFF
ROT 11 #+ 28
GROB!
;
{
GROB 42 E0000A0000CF00CF00303030303C303C3033303330F030F03030303030CF00CF00
GROB 42 E0000A000003000300C300C30003000300030003000300030003000300CF00CF00
GROB 42 E0000A0000CF00CF0030303030003000300F000F00C000C00030003000FF30FF30
GROB 42 E0000A0000CF00CF003030303000300030CF00CF000030003030303030CF00CF00
GROB 42 E0000A00000C000C000F000F00CC00CC003C003C00FF30FF300C000C000C000C00
GROB 42 E0000A0000FF30FF3030003000FF00FF00003000300030003030303030CF00CF00
GROB 42 E0000A00000F000F00C000C00030003000FF00FF003030303030303030CF00CF00
GROB 42 E0000A0000FF30FF30003000300C000C0003000300C000C000C000C000C000C000
GROB 42 E0000A0000CF00CF003030303030303030CF00CF003030303030303030CF00CF00
GROB 42 E0000A0000CF00CF003030303030303030CF30CF30003000300C000C00C300C300
}
' NULLLAM 5 NDUPN
DOBIND
BlankDA2
49 28
GROB 22 C000040000000060F0F060000060F0F060
78 3PICK3PICK
XYGROBDISP XYGROBDISP
BEGIN
GARBAGE
TOD DUP %IP>#
3GETLAM OVER#=
ITE_DROP
:: DUP 3PUTLAM
26 2GETEVAL
;
%FP %10* %10*
DUP %IP>#
4GETLAM OVER#=
ITE_DROP
:: DUP 4PUTLAM
55 2GETEVAL
;
%FP %10* %10* %IP>#
5GETLAM OVER#=
ITE_DROP
:: DUP 5PUTLAM
84 2GETEVAL
;
?ATTNQUIT
GETTOUCH
UNTIL
DROP
ABND
SetDA1NoCh
SetDA3NoCh
;"
LBLD
C$ 2936 (LBLD, \-> ?)
ASSEMBLE
Repeater EQU #51735
RPL
::
AtUserStack
POLSaveUI
ERRSET
::
FALSE 4 11 FALSE'
::
5GETLAM 21 #+
6GETLAM 55 #+OVER
44 #+OVER
2DUP PIXON?
IT 2SWAP
PIXON PIXOFF
;
'
::
7GETLAM IT
:: 3GETLAM EVAL
;
GROB 12 400004000090606090
TOTEMPOB
5GETLAM 21 #+
6GETLAM 55 #+
PIXON? ?SKIP INVGROB
HARDBUFF
5GETLAM
#1- 5 #* #1+
6GETLAM
#1- 5 #* 11 #+
GROB!
;
'
::
4 4 MAKEGROB
5GETLAM 21 #+
6GETLAM 55 #+
PIXON? IT INVGROB
HARDBUFF
5GETLAM
#1- 5 #* #1+
6GETLAM
#1- 5 #* 11 #+
GROB!
;
' NULLLAM 7 NDUPN
DOBIND
ClrDA1IsStat
RECLAIMDISP
3 0
$ "HP-48 GRAPHIC MENU LABEL MAKER"
$>grob XYGROBDISP
110 $ "EXIT"
MakeStdLabel
88 $ "\\->STK"
MakeStdLabel
66 8 21 MAKEGROB
INVGROB
44 $ "SBGR"
MakeStdLabel
0 $ "TOG"
MakeStdLabel
TURNMENUOFF
5 ZERO_DO
56 SWAP XYGROBDISP
LOOP
45 ZERO_DO
INDEX@ #10+
110 ZERO_DO
INDEX@ OVER PIXON
5
+LOOP
DROP 5
+LOOP
2GETEVAL
'
::
$ "Y: "
6GETLAM #>$ &$
MakeInvLabel
HARDBUFF
109 36
$ "X: "
5GETLAM #>$ &$
MakeInvLabel
HARDBUFF
4PICK 16
GROB! GROB!
;
'
::
1 #=casedrop
::
11 ?CaseKeyDef
::
TakeOver
Repeater 11
::
1GETLAM EVAL
6GETLAM #1-
DUP#0=IT
:: DROP 8
;
6PUTLAM 2GETEVAL
;
;
16 ?CaseKeyDef
::
TakeOver
Repeater 16
::
1GETLAM EVAL
5GETLAM #1-
DUP#0=IT
:: DROP 21
;
5PUTLAM 2GETEVAL
;
;
17 ?CaseKeyDef
::
TakeOver
Repeater 17
::
1GETLAM EVAL
6GETLAM #1+DUP
9 #= IT DROPONE
6PUTLAM 2GETEVAL
;
;
18 ?CaseKeyDef
::
TakeOver
Repeater 18
::
1GETLAM EVAL
5GETLAM #1+DUP
22 #= IT DROPONE
5PUTLAM 2GETEVAL
;
;
25 ?CaseKeyDef
::
TakeOver
7GETLAM ?SKIP
:: 3GETLAM EVAL
;
2GETEVAL
;
1 ?CaseKeyDef
::
TakeOver
0 56 $ "TOG"
7GETLAM NOT
DUP 7PUTLAM
Box/StdLabel
XYGROBDISP
2GETEVAL
;
3 ?CaseKeyDef
::
TakeOver
HARDBUFF
22 56 OVER
5GETLAM #+OVER
6GETLAM #+
SUBGROB
DUP TOTEMPOB
INVGROB
$ "Inv" >TAG
SWAP
$ "Reg" >TAG
;
5 ?CaseKeyDef
::
TakeOver
HARDBUFF
22 56 43 64
SUBGROB
DUP TOTEMPOB
INVGROB
$ "Inv" >TAG
SWAP
$ "Reg" >TAG
;
6 ?CaseKeyDef
::
TakeOver
TRUE 4PUTLAM
;
45 ?CaseKeyDef
::
TakeOver
TRUE 4PUTLAM
;
40 #=casedrpfls
DROPDEADTRUE
;
3 #=casedrop
::
45 #=casedrpfls
DROPDEADTRUE
;
2DROP 'DoBadKeyT
;
TrueTrue FALSE
ONEFALSE' 4GETLAM
'ERRJMP
POLSetUI
POLKeyUI
ABND
TURNMENUON
RECLAIMDISP
ClrDAsOK
;
ERRTRAP
POLResUI&Err
POLRestoreUI
;
END
