Inform2 or similar for 50g

[Eric Rechlin]

I thought this would be a good challenge to port to the 50g. I'm so close, but so far. It seems to be referencing a missing ROMPTR. It was ROMPTR B1 1C on the 48, which corresponds to library 177 command 28. But that must be different on the 49/50, because it's failing for me when I try to run the below code after compiling it.

In case anyone else wants to take a stab at it, my code follows (ready to assemble on Jazz on the 50g, followed by a call to CRLIB).

Code:


%%HP: T(3)A(D)F(.);
DIR
  INFORM2
"::
 CK5&Dispatch
 # 35555
 ID x006
 # 35155
 ::
  ROT
  ONE{}N
  UNROT
  ID x006
 ;
;"
  x001
"::
 CK1
 DUPTYPELIST?
 NOT?SEMI
 DUPLENCOMP
 THREE
 #<
 ?SEMI
 INNERCOMP
 OVER
 TRUE
 EQUAL
 3PICK
 FALSE
 EQUAL
 OR
 ITE
 ::
  SWAP
  IT
  ::
   DUP
   ROLLDROP
   #1-
  ;
  SWAP
  ITE
  DROP
  ::
   #2-
   {}N
  ;
 ;
 {}N
;"
  x002
"::
 DUP
 CARCOMP
 DUP
 TYPECSTR?
 ITE
 ::
  DROP
  FALSE
  >TCOMP
  FALSE
  >TCOMP
 ;
 ::
  DO>STR
  SWAP
  INNERCOMP
  #1+
  {}N
  FALSE
  >TCOMP
  TRUE
  >TCOMP
 ;
;"
  x003
"::
 INNERCOMP
 DUP
 ZERO
 DO
 INDEX@
 #2+
 ROLL
 DUPTYPELIST?
 ITE
 ID x002
 ::
  DUP
  DO>STR
  SWAP
  TRUE
  TRUE
  FOUR
  {}N
 ;
 INDEX@
 #2+
 UNROLL
 LOOP
 {}N
;"
  x004
"::
 INNERCOMP
 DUP
 ZERO
 DO
 INDEX@
 #2+
 ROLL
 DUP
 FALSE
 EQUAL
 OVER
 TRUE
 EQUAL
 OR
 IT
 ::
  ITE
  %1
  %0
 ;
 ID x001
 INDEX@
 #2+
 UNROLL
 LOOP
 {}N
;"
  x005
C$ 1387 ::
 3PICK
 ZERO
 DO
 ZERO
 ID x007
 ROLL
 DUP
 TAG CHECK
 %1
 EQUAL
 OVER
 TAG CHECK
 %0
 EQUAL
 OR
 ITE
 ::
  TAG CHECK
  %1
  EQUAL
  ZERO
  ID x007
  UNROLL
  ONE
  ID x007
  ROLL
  DROP
  ZERO
  ID x007
  PICK
  ONE
  ID x007
  UNROLL
  FIVE
  ID x007
  ROLL
  DROP
  MINUSONE
  FIVE
  ID x007
  UNROLL
  SIX
  ID x007
  ROLL
  DROP
  MINUSONE
  SIX
  ID x007
  UNROLL
  SEVEN
  ID x007
  ROLL
  DROP
  THIRTYTWO
  SEVEN
  ID x007
  UNROLL
  NINE
  ID x007
  ROLL
  SIX
  #MIN
  NINE
  ID x007
  UNROLL
 ;
 ::
  DUPTYPETAG?
  ITE
  ::
   DUP
   '
   xOBJ>
   EvalNoCK
   $ "CHOOSE"
   EQUAL
   OVER
   TYPELIST?
   AND
   OVER
   NULL{}
   EQUAL
   NOT
   AND
   ITE
   ::
    ID x003
    FOUR
    ID x007
    UNROLL
    THREE
    ID x007
    ROLLDROP
    SEVENTEEN
    THREE
    ID x007
    UNROLL
    TWO
    ID x007
    ROLL
    FOUR
    ID x007
    PICK
    CARCOMP
    SWAPDROP
    TWO
    ID x007
    UNROLL
    ONE
    ID x007
    ROLL
    FOUR
    ID x007
    PICK
    CARCOMP
    SWAPDROP
    ONE
    ID x007
    UNROLL
    DROP
    FIVE
    ID x007
    ROLLDROP
    SEVENTEEN
    FIVE
    ID x007
    UNROLL
    SIX
    ID x007
    ROLLDROP
    MINUSONE
    SIX
    ID x007
    UNROLL
    SEVEN
    ID x007
    ROLLDROP
    TWELVE
    SEVEN
    ID x007
    UNROLL
   ;
   ::
    DROP
    ZERO
    ID x007
    UNROLL
   ;
  ;
  ::
   ZERO
   ID x007
   UNROLL
  ;
 ;
 LOOP
;
  x006
"::
 '
 ROMPTR B1 1C
 ROMPTR@
 NOT?SEMI
 DUP
 '
 DoInputForm
 EQUALPOSCOMP
 #1-
 ONE
 SWAP
 SUBCOMP
 EVAL
 ID x005
 '
 ROMPTR B1 1C
 ROMPTR@
 DROP
 DUP
 '
 DoInputForm
 EQUALPOSCOMP
 OVER
 LENCOMP
 SUBCOMP
 EVAL
 DUP
 %1
 %=
 IT
 ::
  SWAP
  ID x004
  SWAP
 ;
;"
  x007
"::
 FIVE
 INDEX@
 THIRTEEN
 #*
 #+
 #+
;"
  $CONFIG
"::
 # 67B
 TOSRRP
;"
  $VISIBLE {
INFORM2 }
  $HIDDEN {
x001 x002 x003 x004 x005 x006 x007 }
  $ROMID 1659
  $TITLE
"INFORM/EXTRA - MBW"
END