Data commit

Task/Roman-numerals-Decode/360-Assembly/roman-numerals-decode.360

@@ -0,0 +1,68 @@
+*        Roman numerals Decode -   17/04/2019
+ROMADEC  CSECT
+         USING  ROMADEC,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,=A(NV))   do i=1 to hbound(vals)
+         LR     R1,R6                i
+         SLA    R1,3                 ~
+         LA     R4,VALS-L'VALS(R1)   @vals(i)
+         MVC    X,0(R4)              x=vals(i)
+         SR     R9,R9                prev=0
+         ST     R9,Y                 y=0
+         LA     R7,L'X               j=1
+       DO WHILE=(C,R7,GE,=A(1))      do j=length(x) to 1 by -1
+         LA     R4,X-1                 @x
+         AR     R4,R7                  +j
+         MVC    C,0(R4)                c=substr(x,j,1)
+       IF   CLI,C,NE,C' ' THEN         if c^=' ' then
+         SR     R1,R1                  r1=0
+         LA     R2,1                   k=1
+       DO WHILE=(C,R2,LE,=A(L'ROMAN))   do k=1 to length(roman)
+         LA     R3,ROMAN-1               @roman
+         AR     R3,R2                    +k
+       IF   CLC,0(L'C,R3),EQ,C THEN      if substr(roman,k,1)=c
+         LR     R1,R2                      index=k
+         B      REINDEX                    leave k
+       ENDIF    ,                        endif
+         LA     R2,1(R2)                 k=k+1
+       ENDDO    ,                      enddo k
+REINDEX  EQU    *                      r1=index(roman,c)
+         SLA    R1,2                   ~
+         L      R8,DECIM-4(R1)         n=decim(index(roman,c))
+       IF    CR,R8,LT,R9 THEN          if n<prev then
+         LCR    R8,R8                    n=-n
+       ENDIF    ,                      endif
+         L      R2,Y                     y
+         AR     R2,R8                    +n
+         ST     R2,Y                     y=y+n
+         LR     R9,R8                    prev=n
+       ENDIF    ,                      endif
+         BCTR   R7,0                   j--
+       ENDDO    ,                    enddo j
+         MVC    PG(8),X              x
+         L      R1,Y                 y
+         XDECO  R1,XDEC              edit y
+         MVC    PG+12(4),XDEC+8      output y
+         XPRNT  PG,L'PG              print buffer
+         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
+NV       EQU    (X-VALS)/L'VALS
+ROMAN    DC     CL7'MDCLXVI'
+DECIM    DC     F'1000',F'500',F'100',F'50',F'10',F'5',F'1'
+VALS     DC     CL8'XIV',CL8'CMI',CL8'MIC',CL8'MCMXC',CL8'MDCLXVI'
+         DC     CL8'MMVIII',CL8'MMXIX',CL8'MMMCMXCV'
+X        DS     CL(L'VALS)
+Y        DS     F
+C        DS     CL1
+PG       DC     CL80'........ -> ....'
+XDEC     DS     CL12
+         REGEQU
+         END    ROMADEC