How to resolve the algorithm CUSIP step by step in the 360 Assembly programming language

Published on 12 May 2024 09:40 PM

How to resolve the algorithm CUSIP step by step in the 360 Assembly programming language

Table of Contents

Problem Statement

A   CUSIP   is a nine-character alphanumeric code that identifies a North American financial security for the purposes of facilitating clearing and settlement of trades. The CUSIP was adopted as an American National Standard under Accredited Standards X9.6.

Ensure the last digit   (i.e., the   check digit)   of the CUSIP code (the 1st column) is correct, against the following:

Let's start with the solution:

Step by Step solution about How to resolve the algorithm CUSIP step by step in the 360 Assembly programming language

Source code in the 360 programming language

*        CUSIP                     07/06/2018
CUSIP    CSECT
         USING  CUSIP,R13          base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R6,1               i=1
       DO WHILE=(C,R6,LE,=F'6')    do i=1 to 6
         LR     R1,R6                i
         MH     R1,=H'9'             *9
         LA     R4,T-9(R1)           @t(i)
         MVC    X,0(R4)              x=t(i)
         SR     R10,R10              w=0
         LA     R7,1                 j=1
       DO WHILE=(C,R7,LE,=F'8')      do j=1 to 8
         LA     R14,X-1                x
         AR     R14,R7                 j
         MVC    Y(1),0(R14)            y=substr(x,j,1)
         LA     R9,L'XX                z=length(xx)
         LA     R8,1                   k=1
       DO WHILE=(C,R8,LE,=A(L'XX))     do k=1 to length(xx)
         LA     R4,XX-1                  xx
         AR     R4,R8                    k
         MVC    C(1),0(R4)               c=substr(xx,k,1)
       IF CLC,Y(1),EQ,C THEN             if y=c then
         LR     R9,R8                      k
         BCTR   R9,0                       z=k-1
       ENDIF    ,                        endif
         LA     R8,1(R8)                 k++
       ENDDO    ,                      enddo k
         LR     R4,R7                  j
         LA     R1,2                   2
         SRDA   R4,32                  ~
         DR     R4,R1                  j/2=0
       IF LTR,R4,Z,R4 THEN             if j//2=0 then
         AR     R9,R9                    z=z+z
       ENDIF    ,                      endif
         LR     R4,R9                  z
         LA     R1,10                  10
         SRDA   R4,32                  ~
         DR     R4,R1                  r4=z//10 ; r5=z/10
         AR     R10,R5                 w+z/10
         AR     R10,R4                 w=w+z/10+z//10
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         LR     R4,R10               w
         LA     R1,10                10
         SRDA   R4,32                ~
         DR     R4,R1                w/10
         LA     R2,10                10
         SR     R2,R4                10-w//10
         SRDA   R2,32                ~
         DR     R2,R1                /10
         STC    R2,U                 u=(10-w//10)//10
         OI     U,X'F0'              bin to char
       IF CLC,U,EQ,X+8 THEN          if u=substr(x,9,1) then
         MVC    OK,=CL3' '             ok=' '
       ELSE     ,                    else
         MVC    OK,=C'n''t'            ok='n''t'
       ENDIF    ,                    endif
         MVC    PG+6(9),X            output x
         MVC    PG+18(3),OK          output ok
         XPRNT  PG,L'PG              print
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling sav
XX       DC     CL39'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ*@#'
U        DS     CL1
Y        DS     CL1
C        DS     CL1
T        DC     CL9'037833100',CL9'17275R102',CL9'38259P508'
         DC     CL9'594918104',CL9'68389X106',CL9'68389X105'
X        DS     CL9
OK       DS     CL3
PG       DC     CL80'CUSIP ......... is... valid'
         YREGS
         END    CUSIP

  

You may also check:How to resolve the algorithm Return multiple values step by step in the Fōrmulæ programming language
You may also check:How to resolve the algorithm Find common directory path step by step in the Visual Basic programming language
You may also check:How to resolve the algorithm Partition function P step by step in the Perl programming language
You may also check:How to resolve the algorithm Quoting constructs step by step in the Nim programming language
You may also check:How to resolve the algorithm Multiplication tables step by step in the ARM Assembly programming language