HP50G - Library ROMID question

[DavidM]

The below version is definitely overkill for an application like this, and is almost twice the size of Joe's excellent (definitely not fugly) program. But since I know you (Jeff) are experimenting with SysRPL/Saturn/Debug4x right now, I thought I'd show an example that uses a SysRPL wrapper around a Saturn code object to directly extract the number from the library on the stack. The exact location of the library number is dependent on the length of the library title, so the program has to assess the title field before extracting it:

Code:

RPL

::
   ( must have at least one object on stack )
   CK1NOLASTWD

   CK&DISPATCH1
   # 8F ( SL1 must be a library ) ::

      ( put a placeholder BINT in SL1 )
      BINT0 TOTEMPOB

      ( obtain the library number directly from the library [now in SL2] )
      CODEM
         % save the RPL environment registers
         GOSBVL =SAVPTR

         % make a backup copy of SL1 pointer in R0.A for later use
         AD1EX
         D1=A
         R0=A A

         % D1 -> SL2
         D1+5

         % A.A -> SL2 object
         A=DAT1 A

         % A.A & D1 -> start of library name field
         A+10 A
         D1=A

         % C.A = size of library name (in *characters*, not nibbles)
         C=0 A
         C=DAT1 B

         % if library name has no characters, field length is 2 nibbles
         ?C=0 B ->{
            LC 2
         }
         SKELSE % otherwise, determine field name length from char count
         {
            % convert char count to nibble count by doubling it
            C+C A

            % increment field length by 4 (for size nibbles at beg/end of field)
            C+4 A
         }

         % skip name field in A.A based on nibble count determined above
         A+C A

         % C.A = library number
         D1=A
         C=0 A
         C=DAT1 X

         % D1 -> SL1
         A=R0 A
         D1=A

         % D1 -> SL1 object data
         A=DAT1 A
         D1=A
         D1+5

         % write the library number to the BINT data field
         DAT1=C A

         % restore the RPL registers
         GOSBVL =GETPTR

         % drop the library object currently in SL2 (equiv. to SWAPDROP)
         A=DAT1 A
         D1+5
         D+1 A
         DAT1=A A

         % return to RPL
         GOVLNG =Loop
      ENDCODE

      ( convert BINT result to real number )
      UNCOERCE
   ;
;

It shows several techniques that are common to this type of coding, including:
- checking the stack for appropriate arguments
- allocating memory for results prior to executing a Saturn code object
- use of MASD skip structure for conditional execution
- simple stack manipulation in Saturn code