Purely Synthetic PCAT 1 Message #1 Posted by PeterP on 16 Apr 2009, 8:05 p.m.
Hi,
A little while ago we were asked if there is a program that can display all the CAT 1 entries. As it turns out there was none, but pretty quickly a version using the CCD (next to the Sandbox my favorite module) was written.
Nevertheless the discussion started if it would be possible to do the same without any external modules, only using synthetics. As it turns out, Dan and I found a way how it actually can be done, if one allows the use of X/F and X/M. For what its worth, the code is produced below. It uses a few functions from the PPC module, which can be typed in as separate functions so one does not need the actual modul. Needless to say, these purely focal programs are very adagio. Just in case, I have added in parenthesis the respective functions from the Sandbox, however if one were to allow the Sandbox a much faster version could be written using its NRCL function…
The concept is as follows:
 Do a GTO .., size at least 018, make sure there is at least one free register available in the main memory
 Calculate the length of program memory and add 2 registers
 lower the curtain to one register below the .END.
 using SAVERX, move the whole program area up to and including the original R00 into X/M. SAVERX normalizes only the top and bottom registers of the block that is transferred. This means the original R00 (that’s fine, its normalized anyway) and the 1 empty register below the .END. (which we don’t care about). If there is not enough room in the X/M the calc will tell you.
 Now we can use GETX, which does not normalize, to analyze the CAT 1 chain. Starting with the second register in our datafile (the first one contains the empty register below the .END.) we can decode the .END., find the distance to the next END, decode it to find the distance to the next Alpha or END, display if it is Alpha, rinse and repeat until we have reached the top end
Biggest nuisance is when ENDs or Alpha labels cross register boundaries as we have to get the next register and decode again. We use SEEKPT to move around quickly from one register to the next.
Clearly this was far more fun for me to do that it will be of use to anyone, but maybe this does interest someone.
Cheers
Peter
; **********************************
;00 – 48 (numbers are veeeeery slow on the 41)
;01 – 64
;02  7
;03 – current register pointer
;04 – prior register pointer
;05 – counter for number of alpha label chars
;06 – pointer to regs where chars are stored
;07 – temp storage
;08 – 10
;09 – 128
;10:17 – tmp register for alpha label chars
; **********************************
LBL ‘PCAT2’ ;first version uses CCD, see original post
1.2
STO 03
STO 04
48
STO 00
64
STO 01
7
STO 02
10
STO 08
128
STO 09
XROM ‘C?’ ;get abs addr of curtain
XROM ‘E?’ ;get abs addr of .END.

2
+
‘PCATDF’ ;name of temp datafile
SF 25
PURFL
CF 25
CRFLD ;create a datafile large enough for whole pgm memory + 2 regs
1

STO Y
CHS
XROM ‘CU’ ;lower the curtain to 1 reg below .END.
STO Y
1 E 3
/
SAVERX ;transfer it all including the original R00 to XM
RDN
XROM ‘CU’ ;restore curtain
LBL ‘SCH’ ;Show Catalog
RCL 03
SEEKPT ;position to next needed register
GETX ;get register without normalization
XEQ ‘NH’ ;decode. NNN>HEX from Sandbox is faster…
AOFF ;not needed with NNN>HEX
XEQ ‘ROA’ ;rotate alpha so that relevant bytes are on left side
ATOX ;get ‘C’ byte out of the way from END/Alpha structure
XEQ ‘MAD’ ;Make Alpha Distance. This calcs the distance to the next element in the chain
X=0? ;if it is 0 bytes away, we have reached the top of CAT 1
GTO ‘EXT’ ;EXiT
RCL 03
STO 04
XEQ ‘A+B’ ;calc the new register we need
STO 03
ALENG
X=0? ;did we reach the end of the register?
XEQ ‘GNR’ ;get next register
XEQ ‘CCA’ ;now check if this is an alpha lable
GTO ‘SHC’ ;rinse and repeat
;
LBL ‘EXT’ ;EXIT
ALENG
X=0? ;did we reach the end of the reg (should never happen actually)
XEQ ‘GNRE’ ;get next register
XEQ ‘CCA’ ;check for Alpha label (should be one)
BEEP
CLX
STOP
GTO ‘PCAT2’ ;just in case of trigger happy R/S finger…
;
LBL ‘ROA’ ;rotate alpha (actually clear bytes left to start of END/AlphaLabel
RCL 03
FRC ;which byte do we need to look at? (starting at 0)
CHS
.6
+ ;how many bytes do we need to delete to the left
LBL 05
X=0? ;done yet?
RTN
ATOX
ATOX ;each byte has 2 alpha chars, 1 per nybble
0.1
R^
+
GTO 05
;
LBL ‘MAD’ ;Make Alpha Distance
XEQ 14
X<>F ;need to check if we have a very long program. See structure of ENDs
FS?C 00
SF 19
X<>F
20
/
RCL 09 ;=128
FC?C 19
CLX
+
STO 07
ALENG
X=0? ;end of decoded string > get next reg
XEQ ‘GNRE’
RCL 07
LBL ‘G2’ ;decode next two nybbles from alpha
XEQ 14
16
*
R^
+
XEQ 14
R^
+
RTN
LBL 14 ;decode one alpha char
RCL 01 ;=64
ATOX
X>Y? ;is this a letter?
XEQ 13
RCL 00 ;=48

RTN
LBL 13
RCL 02 ;=7

RTN
;
LBL ‘A+B’ ;add two alpha address of form reg.byte
FRC
LastX
INT
RCL 02 ;=7
*
X<>Y
RCL 08 ;=10
*
+
X<>Y
FRC
LastX
INT
RCL 02
*
X<>Y
RCL 08
*
+
+
RCL 02
/
INT
LastX
FRC
RCL 02
*
RCL 08
/
+
RTN
;
LBL ‘CCA’ ;Check Alpha
ATOX
70
X>Y?
RTN ;this is not an F byte, so no alpha label
ATOX ;how many?
49 ;48 + 1 byte for key code if assigned. See Alpha label structure

STO 05 ;counter for number of letters in label
RCL 08
STO 06
ALENG
X=0? ;do we need next reg?
XEQ ‘GNR’
ATOX
ATOX ;delete key code
LBL 09
ALENG
X=0? ;do we need next reg?
XEQ ‘GNR’
CLST
XEQ ‘G2’ ;decode 2 alpha chars from left
STO IND 06 ;store letter code into regs 1017
ISG 06
DEG ;NOP
DSE 05 ;
GTO 09
CLA ;now build alpha label and display
RCL 08
LBL 07
RCL IND X
XTOA
X<>Y
1
+
RCL 06
X<=Y? ;are we done?
GTO 08
RDN
GTO 07
LBL 08 ;display alpha alabel
TONE 9
AVIEW
PSE
RTN
;
LBL ‘GNRE’ ;get next reg for End
RCL 03
GTO 06
LBL ‘GNR’ ;get next reg
RCL 04
LBL 06
1

SEEKPT
GETX
XEQ ‘NH’
AOFF
RTN
;
