The Museum of HP Calculators

HP Forum Archive 19

[ Return to Index | Top of Index ]

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:

  1. Do a GTO .., size at least 018, make sure there is at least one free register available in the main memory
  2. Calculate the length of program memory and add 2 registers
  3. lower the curtain to one register below the .END.
  4. 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.
  5. Now we can use GETX, which does not normalize, to analyze the CAT 1 chain. Starting with the second register in our data-file (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 data-file
  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 10-17
    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
;------------------------------------

      
Re: Purely Synthetic PCAT 1
Message #2 Posted by Dan Grelinger on 16 Apr 2009, 11:09 p.m.,
in response to message #1 by PeterP

Great work! I think the decoding of the absolute memory addresses stored with each end and lable was the hard part.


[ Return to Index | Top of Index ]

Go back to the main exhibit hall