Self-describing numbers: Difference between revisions
Content added Content deleted
PatGarrett (talk | contribs) (→{{header|360 Assembly}}: Section added) |
|||
Line 27: | Line 27: | ||
* [[Spelling of ordinal numbers]] |
* [[Spelling of ordinal numbers]] |
||
<br><br> |
<br><br> |
||
=={{header|360 Assembly}}== |
|||
<lang 360asm>* Self-describing numbers 26/04/2020 |
|||
SELFDESC CSECT |
|||
USING SELFDESC,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 R8,1 k=1 |
|||
DO WHILE=(C,R8,LE,=A(NN)) do k=1 to nn |
|||
CVD R8,DBLK binary to packed decimal (PL8) |
|||
MVC CK,MAK load mask |
|||
EDMK CK,DBLK+2 packed dec (PL5) to char (CL10) |
|||
S R1,=A(CK) number of blanks |
|||
LR R3,R1 " |
|||
LA R9,L'CK length(ck)=8 |
|||
SR R9,R1 length of the number |
|||
LA R6,1 i=1 |
|||
DO WHILE=(CR,R6,LE,R9) do i=1 to l |
|||
LA R10,0 n=0 |
|||
LA R7,1 j=1 |
|||
DO WHILE=(CR,R7,LE,R9) do j=1 to l |
|||
LA R1,CK-1 @ck |
|||
AR R1,R3 +space(k) |
|||
AR R1,R7 +j |
|||
MVC CJ,0(R1) substr(k,j,1) |
|||
IC R1,CJ ~ |
|||
SLL R1,28 shift left 28 |
|||
SRL R1,28 shift right 28 |
|||
LR R2,R6 i |
|||
BCTR R2,0 i-1 |
|||
IF CR,R1,EQ,R2 THEN if substr(k,j,1)=i-1 then |
|||
LA R10,1(R10) n++ |
|||
ENDIF , endif |
|||
LA R7,1(R7) j++ |
|||
ENDDO , enddo j |
|||
LA R1,CK-1 @ck |
|||
AR R1,R3 +space(k) |
|||
AR R1,R6 +i |
|||
MVC CI,0(R1) substr(k,i,1) |
|||
IC R1,CI ~ |
|||
SLL R1,28 shift left 28 |
|||
SRL R1,28 shift right 28 |
|||
IF CR,R1,NE,R10 THEN if substr(k,i,1)<>n then |
|||
B ITERK iterate k |
|||
ENDIF , endif |
|||
LA R6,1(R6) i++ |
|||
ENDDO , enddo i |
|||
XPRNT CK,L'CK print ck |
|||
ITERK LA R8,1(R8) k++ |
|||
ENDDO , enddo k |
|||
L R13,4(0,R13) restore previous savearea pointer |
|||
RETURN (14,12),RC=0 restore registers from calling save |
|||
NN EQU 5000000 nn |
|||
DBLK DS PL8 double word 15num |
|||
MAK DC X'402020202020202020202020' mask CL12 11num |
|||
CK DS CL12 ck 12num |
|||
CI DS C ci |
|||
CJ DS C cj |
|||
PG DS CL80 buffer |
|||
XDEC DS CL12 temp fo xdeco |
|||
REGEQU |
|||
END SELFDESC </lang> |
|||
{{out}} |
|||
<pre> |
|||
1210 |
|||
2020 |
|||
21200 |
|||
3211000 |
|||
</pre> |
|||
=={{header|Ada}}== |
=={{header|Ada}}== |