1  
     2  !Original grotty faulty version
     3  !%systemrealfn stor(%string(255)input)
     4  !  !reads a real from the string, assuming string starts with the real
     5  !  !(or blank spaces followed by a real)
     6  !  %integer sign=0,sym,pos=0
     7  !  %real value,exp
     8  !  !
     9  !  input=input."!";         !check that there is a finish character
    10  !  %cycle
    11  !    sym = charno(input,pos+1)
    12  !    %exit %if sym > ' '
    13  !    pos=pos+1
    14  !  %repeat
    15  !  %if sym = '-' %start
    16  !    sign = 1
    17  !    pos=pos+1;  sym = charno(input,pos+1)
    18  !  %finish
    19  !  value = 0
    20  !  %if sym # '.' %start
    21  !    %signal 6,5,pos %unless '0' <= sym <= '9';  !charno out of range
    22  !    %cycle
    23  !      value = value*10.0+(sym-'0')
    24  !      pos=pos+1;  sym = charno(input,pos+1)
    25  !    %repeat %until %not '0' <= sym <= '9'
    26  !  %finish
    27  !  %if sym = '.' %start
    28  !    exp = 10.0
    29  !    %cycle
    30  !      pos=pos+1;  sym = charno(input,pos+1)
    31  !      %exit %unless '0' <= sym <= '9'
    32  !      value = value+(sym-'0')/exp
    33  !      exp = exp*10.0
    34  !    %repeat
    35  !  %finish
    36  !  %if sym = '@' %start
    37  !    pos = pos+1
    38  !    sym = charno(input,pos+1); pos = pos+1
    39  !    value = value*10.0\(sym-'0')
    40  !  %finish
    41  !  value = -value %if sign # 0
    42  !  %result = value
    43  !%end;  !stor
    44  
    45  !Working version, courtesy of RMM (as if it wasn't obvious
    46  !from the grotesque 'aesthetic' source layout)
    47  
    48  %systemintegerfnspec stoi(%string(255) S)
        O LINE   48 "regression-bugs-tmp/stor.imp"
        $ DEF    STOI (_STOI) p1=V_00ad a/tf=18 b/format=1 c/ostate=3c  type=1 (integer) form=8 (function) special=0 (<special:0>) linkage=4 (system) spec=1 indirect=1 unass=1
        { START  ( FORMAL PARAMETERS  {lev=0 --> 1, nested=0 --> 1}
           $ DEF    S p1=V_00ae a/tf=31 b/format=ff c/ostate=0  type=3 (string) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
        } FINISH ) {lev=0}

    49  %system %real %function S To R (%string (255) Input)
        O LINE   49 "regression-bugs-tmp/stor.imp"
        $ DEF    STOR (_STOR) p1=V_00ae a/tf=28 b/format=1 c/ostate=34  type=2 (real) form=8 (function) special=0 (<special:0>) linkage=4 (system) spec=0 indirect=1 unass=1
           { START  ( FORMAL PARAMETERS  {lev=1 --> 2, nested=0 --> 1}
              $ DEF    INPUT p1=V_00af a/tf=31 b/format=ff c/ostate=0  type=3 (string) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
           } FINISH ) {lev=1}

    50    %integer Sign = 0,
    51             Sym,
    52             Pos = 1
           O LINE   50 "regression-bugs-tmp/stor.imp"
           $ DEF    SIGN p1=V_00b0 a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
           @ PUSH   SIGN
           N PUSHI  #0x00000000
           S ASSVAL
           $ DEF    SYM p1=V_00b1 a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
           $ DEF    POS p1=V_00b2 a/tf=11 b/format=1 c/ostate=0  type=1 (integer) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
           @ PUSH   POS
           N PUSHI  #0x00000001
           S ASSVAL

    53    %long %real Value,
    54                Exp
    55  
           O LINE   53 "regression-bugs-tmp/stor.imp"
           $ DEF    VALUE p1=V_00b3 a/tf=21 b/format=4 c/ostate=0  type=2 (real) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
           $ DEF    EXP p1=V_00b4 a/tf=21 b/format=4 c/ostate=0  type=2 (real) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0

    56     %routine Next
           O LINE   56 "regression-bugs-tmp/stor.imp"
           $ DEF    NEXT (_STOR_NEXT) p1=V_00b5 a/tf=7 b/format=0 c/ostate=0  type=0 (<type:0>) form=7 (routine) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
              { START  ( FORMAL PARAMETERS  {lev=2 --> 3, nested=0 --> 1}
              } FINISH ) {lev=2}

    57        Pos = Pos + 1
              O LINE   57 "regression-bugs-tmp/stor.imp"
              @ PUSH   POS
              @ PUSH   POS
              N PUSHI  #0x00000001
              + ADD   
              S ASSVAL

    58        %if Pos > Length (Input) %start
              O LINE   58 "regression-bugs-tmp/stor.imp"
              @ PUSH   POS
              @ PUSH   LENGTH
              @ PUSH   INPUT
              p ASSPAR
              E CALL  
              ? JUMPIF <= L_0004

    59           Sym = 0
              O LINE   59 "regression-bugs-tmp/stor.imp"
              @ PUSH   SYM
              N PUSHI  #0x00000000
              S ASSVAL

    60        %else
              O LINE   60 "regression-bugs-tmp/stor.imp"
              F GOTO   L_0003
              : LOCATE L_0004

    61           Sym = Char No (Input, Pos)
              O LINE   61 "regression-bugs-tmp/stor.imp"
              @ PUSH   SYM
              @ PUSH   CHARNO
              @ PUSH   INPUT
              p ASSPAR
              @ PUSH   POS
              p ASSPAR
              E CALL  
              S ASSVAL

    62        %finish
              O LINE   62 "regression-bugs-tmp/stor.imp"
              : LOCATE L_0003

    63     %end
    64  
              O LINE   63 "regression-bugs-tmp/stor.imp"
           ; END    _STOR_NEXT {lev=2 --> 1}

    65     Sym = Char No (Input, Pos)
           O LINE   65 "regression-bugs-tmp/stor.imp"
           @ PUSH   SYM
           @ PUSH   CHARNO
           @ PUSH   INPUT
           p ASSPAR
           @ PUSH   POS
           p ASSPAR
           E CALL  
           S ASSVAL

    66     %if Sym = '-' %start
           O LINE   66 "regression-bugs-tmp/stor.imp"
           @ PUSH   SYM
           N PUSHI  #0x0000002d
           ? JUMPIF # L_0004

    67        Sign = 1
           O LINE   67 "regression-bugs-tmp/stor.imp"
           @ PUSH   SIGN
           N PUSHI  #0x00000001
           S ASSVAL

    68        Next
           O LINE   68 "regression-bugs-tmp/stor.imp"
           @ PUSH   NEXT
           E CALL  

    69     %finish
           O LINE   69 "regression-bugs-tmp/stor.imp"
           : LOCATE L_0004

    70     Value = 0
           O LINE   70 "regression-bugs-tmp/stor.imp"
           @ PUSH   VALUE
           N PUSHI  #0x00000000
           S ASSVAL

    71     %if Sym # '.' %start
           O LINE   71 "regression-bugs-tmp/stor.imp"
           @ PUSH   SYM
           N PUSHI  #0x0000002e
           ? JUMPIF = L_0004

    72        %signal 6, 5, Pos %unless '0' <= Sym <= '9'           {Char No out of range}
           O LINE   72 "regression-bugs-tmp/stor.imp"
           N PUSHI  #0x00000030
           @ PUSH   SYM
           " JUMPIFD > L_0008
           N PUSHI  #0x00000039
           ? JUMPIF <= L_0007
           : LOCATE L_0008
           N PUSHI  #0x00000005
           @ PUSH   POS
           e EVENT  0006
           : LOCATE L_0007

    73        %cycle
           O LINE   73 "regression-bugs-tmp/stor.imp"
           : LOCATE L_0006

    74           Value = Value*10.0 + (Sym - '0')
           O LINE   74 "regression-bugs-tmp/stor.imp"
           @ PUSH   VALUE
           @ PUSH   VALUE
           D PUSHR  code=0 len=4 "10.0"
           * MUL   
           @ PUSH   SYM
           N PUSHI  #0x00000030
           - SUB   
           + ADD   
           S ASSVAL

    75           Next
           O LINE   75 "regression-bugs-tmp/stor.imp"
           @ PUSH   NEXT
           E CALL  

    76        %repeat %until %not '0' <= Sym <= '9'
           O LINE   76 "regression-bugs-tmp/stor.imp"
           N PUSHI  #0x00000030
           @ PUSH   SYM
           " JUMPIFD > L_0007
           N PUSHI  #0x00000039
           ? JUMPIF > L_0007
           B REPEAT L_0006
           : LOCATE L_0007

    77     %finish
           O LINE   77 "regression-bugs-tmp/stor.imp"
           : LOCATE L_0004

    78     %if Sym = '.' %start
           O LINE   78 "regression-bugs-tmp/stor.imp"
           @ PUSH   SYM
           N PUSHI  #0x0000002e
           ? JUMPIF # L_0004

    79        Exp = 10.0
           O LINE   79 "regression-bugs-tmp/stor.imp"
           @ PUSH   EXP
           D PUSHR  code=0 len=4 "10.0"
           S ASSVAL

    80        %cycle
           O LINE   80 "regression-bugs-tmp/stor.imp"
           : LOCATE L_0006

    81           Next
           O LINE   81 "regression-bugs-tmp/stor.imp"
           @ PUSH   NEXT
           E CALL  

    82           %exit %unless '0' <= Sym <= '9'
           O LINE   82 "regression-bugs-tmp/stor.imp"
           N PUSHI  #0x00000030
           @ PUSH   SYM
           " JUMPIFD > L_000b
           N PUSHI  #0x00000039
           ? JUMPIF <= L_000a
           : LOCATE L_000b
           F GOTO   L_0007
           : LOCATE L_000a

    83           Value = Value + (Sym - '0')/Exp
           O LINE   83 "regression-bugs-tmp/stor.imp"
           @ PUSH   VALUE
           @ PUSH   VALUE
           @ PUSH   SYM
           N PUSHI  #0x00000030
           - SUB   
           @ PUSH   EXP
           Q DIVIDE
           + ADD   
           S ASSVAL

    84           Exp = Exp * 10.0
           O LINE   84 "regression-bugs-tmp/stor.imp"
           @ PUSH   EXP
           @ PUSH   EXP
           D PUSHR  code=0 len=4 "10.0"
           * MUL   
           S ASSVAL

    85        %repeat
           O LINE   85 "regression-bugs-tmp/stor.imp"
           B REPEAT L_0006
           : LOCATE L_0007

    86     %finish
           O LINE   86 "regression-bugs-tmp/stor.imp"
           : LOCATE L_0004

    87     %if Sym = '@' %start
           O LINE   87 "regression-bugs-tmp/stor.imp"
           @ PUSH   SYM
           N PUSHI  #0x00000040
           ? JUMPIF # L_0004

    88        Sym = S To I (Sub String (Input, Pos + 1, Length (Input)))
           O LINE   88 "regression-bugs-tmp/stor.imp"
           @ PUSH   SYM
           @ PUSH   STOI
           @ PUSH   SUBSTRING
           @ PUSH   INPUT
           p ASSPAR
           @ PUSH   POS
           N PUSHI  #0x00000001
           + ADD   
           p ASSPAR
           @ PUSH   LENGTH
           @ PUSH   INPUT
           p ASSPAR
           E CALL  
           p ASSPAR
           E CALL  
           p ASSPAR
           E CALL  
           S ASSVAL

    89        Value = Value * 10.0\Sym
           O LINE   89 "regression-bugs-tmp/stor.imp"
           @ PUSH   VALUE
           @ PUSH   VALUE
           D PUSHR  code=0 len=4 "10.0"
           @ PUSH   SYM
           x REXP  
           * MUL   
           S ASSVAL

    90     %finish
           O LINE   90 "regression-bugs-tmp/stor.imp"
           : LOCATE L_0004

    91     Value = -Value %if Sign # 0
           O LINE   91 "regression-bugs-tmp/stor.imp"
           @ PUSH   SIGN
           N PUSHI  #0x00000000
           ? JUMPIF = L_0004
           @ PUSH   VALUE
           @ PUSH   VALUE
           U NEGATE
           S ASSVAL
           : LOCATE L_0004

    92     %result = Value
           O LINE   92 "regression-bugs-tmp/stor.imp"
           @ PUSH   VALUE
           V RESULT

    93  %end {S To R}
    94  
           O LINE   93 "regression-bugs-tmp/stor.imp"
        ; END    _STOR {lev=1 --> 0}

    95  %systemrealfn ftor(%string(255)s)
        O LINE   95 "regression-bugs-tmp/stor.imp"
        $ DEF    FTOR (_FTOR) p1=V_00af a/tf=28 b/format=1 c/ostate=34  type=2 (real) form=8 (function) special=0 (<special:0>) linkage=4 (system) spec=0 indirect=1 unass=1
           { START  ( FORMAL PARAMETERS  {lev=1 --> 2, nested=0 --> 1}
              $ DEF    S p1=V_00b0 a/tf=31 b/format=ff c/ostate=0  type=3 (string) form=1 (simple) special=0 (<special:0>) linkage=0 (auto) spec=0 indirect=0 unass=0
           } FINISH ) {lev=1}

    96    %result = stor(s)
           O LINE   96 "regression-bugs-tmp/stor.imp"
           @ PUSH   STOR
           @ PUSH   S
           p ASSPAR
           E CALL  
           V RESULT

    97  %end
    98  
           O LINE   97 "regression-bugs-tmp/stor.imp"
        ; END    _FTOR {lev=1 --> 0}

    99  %endoffile
        O LINE   99 "regression-bugs-tmp/stor.imp"
        ; END     {lev=0 --> -1}