(49G+) IBM Check Digit Programme

[Gerald H]

For positive integer input the programme returns the original input and the check digit.

eg For input

18081953

the programme returns

18081953
4

For more info on IBM check digit see

http://en.wikipedia.org/wiki/Luhn_algorithm

Edit: Programme faulty, see next posting.

Code:


::
  CK1&Dispatch
  # FF
  ::
    DUP
    {
      BINT0
      BINT2
      BINT4
      BINT6
      BINT8
      BINT1
      BINT3
      BINT5
      BINT7
      BINT9
    }
    SWAPDUP
    PTR 2F3A3
    COERCEDUP
    BINT2
    #<case
    DROPSWAPDROP
    BINT0
    3UNROLL
    ZERO_DO
    Z10_
    FPTR2 ^ZDIVext
    FPTR2 ^Z2BIN
    INDEX@
    BINT2
    #/
    DROP
    #0=
    IT
    ::
      #1+
      4PICKSWAP
      NTHCOMPDROP
    ;
    ROT#+
    BINT10
    #/
    DROP
    SWAPLOOP
    DROPSWAPDROP
    BINT10
    SWAP#-
    FPTR2 ^#>Z
  ;
;

[Gerald H]

Sorry, error in above programme, corrected here:

Code:

::
  CK1&Dispatch
  # FF
  ::
    DUP
    {
      BINT0
      BINT2
      BINT4
      BINT6
      BINT8
      BINT1
      BINT3
      BINT5
      BINT7
      BINT9
    }
    SWAPDUP
    ID x010
    DUP
    BINT2
    #<case
    DROPSWAPDROP
    BINT0
    3UNROLL
    ZERO_DO
    Z10_
    FPTR2 ^ZDIVext
    FPTR2 ^Z2BIN
    INDEX@
    BINT2
    #/
    DROP
    #0=
    IT
    ::
      #1+
      4PICKSWAP
      NTHCOMPDROP
    ;
    ROT#+
    BINT10
    #/
    DROP
    SWAPLOOP
    DROPSWAPDROP
    DUP#0=csedrp
    Z0_
    BINT10
    SWAP#-
    FPTR2 ^#>Z
  ;
;