Calendar - for "REAL" programmers: Difference between revisions
→{{header|360 Assembly}}: Section added
(→{{header|zkl}}: added zkl code) |
PatGarrett (talk | contribs) (→{{header|360 Assembly}}: Section added) |
||
Line 33:
'''Trivia:''' The terms uppercase and lowercase date back to the early days of the mechanical printing press. Individual metal alloy casts of each needed letter, or punctuation symbol, were meticulously added to a press block, by hand, before rolling out copies of a page. These metal casts were stored and organized in wooden cases. The more often needed ''miniscule'' letters were placed closer to hand, in the lower cases of the work bench. The less often needed, capitalized, ''majiscule'' letters, ended up in the harder to reach upper cases.
<br><br>
=={{header|360 Assembly}}==
<!-- Calendar for real programmers -->
This is for real programmers who code only in assembler :). The code could have been run in april 1964, punched on
80-column cards, read on a card reader, and printed with a 132-column line printer on fan-folded paper with perforated edges.
<!-- IBM 029, IBM 2501, IBM 1403 -->
<lang 360asm>
* CALENDAR FOR REAL PROGRAMMERS 05/03/2017
CALENDAR CSECT
USING CALENDAR,R13 BASE REGISTER
B 72(R15) SKIP MY SAVEAREA
DC 17F'0' MY SAVEAREA
STM R14,R12,12(R13) SAVE CALLER'S REGISTERS
ST R13,4(R15) LINK BACKWARD
ST R15,8(R13) LINK FORWARD
LR R13,R15 SET ADDRESSABILITY
L R4,YEAR YEAR
SRDA R4,32 .
D R4,=F'4' YEAR//4
LTR R4,R4 IF YEAR//4=0
BNZ LYNOT
L R4,YEAR YEAR
SRDA R4,32 .
D R4,=F'100' YEAR//100
LTR R4,R4 IF YEAR//100=0
BNZ LY
L R4,YEAR YEAR
SRDA R4,32 .
D R4,=F'400' IF YEAR//400
LTR R4,R4 IF YEAR//400=0
BNZ LYNOT
LY MVC ML+2,=H'29' ML(2)=29 LEAPYEAR
LYNOT SR R10,R10 LTD1=0
LA R6,1 I=1
LOOPI1 C R6,=F'31' DO I=1 TO 31
BH ELOOPI1
XDECO R6,XDEC EDIT I
LA R14,TD1 TD1
AR R14,R10 TD1+LTD1
MVC 0(3,R14),XDEC+9 SUB(TD1,LTD1+1,3)=PIC(I,3)
LA R10,3(R10) LTD1+3
LA R6,1(R6) I=I+1
B LOOPI1
ELOOPI1 LA R6,1 I=1
LOOPI2 C R6,=F'12' DO I=1 TO 12
BH ELOOPI2
ST R6,M M=I
MVC D,=F'1' D=1
MVC YY,YEAR YY=YEAR
L R4,M M
C R4,=F'3' IF M<3
BNL GE3
L R2,M M
LA R2,12(R2) M+12
ST R2,M M=M+12
L R2,YY YY
BCTR R2,0 YY-1
ST R2,YY YY=YY-1
GE3 L R2,YY YY
LR R1,R2 YY
SRA R1,2 YY/4
AR R2,R1 YY+(YY/4)
L R4,YY YY
SRDA R4,32 .
D R4,=F'100' YY/100
SR R2,R5 YY+(YY/4)-(YY/100)
L R4,YY YY
SRDA R4,32 .
D R4,=F'400' YY/400
AR R2,R5 YY+(YY/4)-(YY/100)+(YY/400)
A R2,D R2=YY+(YY/4)-(YY/100)+(YY/400)+D
LA R5,153 153
M R4,M 153*M
LA R5,8(R5) 153*M+8
D R4,=F'5' (153*M+8)/5
AR R5,R2 ((153*M+8)/5+R2
LA R4,0 .
D R4,=F'7' R4=MOD(R5,7) 0=SUN 1=MON ... 6=SAT
LTR R4,R4 IF J=0
BNZ JNE0
LA R4,7 J=7
JNE0 BCTR R4,0 J-1
MH R4,=H'3' J*3
LR R10,R4 J1=J*3
LR R1,R6 I
SLA R1,1 *2
LH R11,ML-2(R1) ML(I)
MH R11,=H'3' J2=ML(I)*3
MVC TD2,BLANK TD2=' '
LA R4,TD1 @TD1
LR R5,R11 J2
LA R2,TD2 @TD2
AR R2,R10 @TD2+J1
LR R3,R5 J2
MVCL R2,R4 SUB(TD2,J1+1,J2)=SUB(TD1,1,J2)
LR R1,R6 I
MH R1,=H'144' *144
LA R14,DA-144(R1) @DA(I)
MVC 0(144,R14),TD2 DA(I)=TD2
LA R6,1(R6) I=I+1
B LOOPI2
ELOOPI2 XPRNT SNOOPY,132 PRINT SNOOPY
L R1,YEAR YEAR
XDECO R1,PG+56 EDIT YEAR
XPRNT PG,L'PG PRINT YEAR
MVC WDLINE,BLANK WDLINE=' '
LA R10,1 LWDLINE=1
LA R8,1 K=1
LOOPK3 C R8,=F'6' DO K=1 TO 6
BH ELOOPK3
LA R4,WDLINE @WDLINE
AR R4,R10 +LWDLINE
MVC 0(20,R4),WDNA SUB(WDLINE,LWDLINE+1,20)=WDNA
LA R10,20(R10) LWDLINE=LWDLINE+20
C R8,=F'6' IF K<6
BNL ITERK3
LA R10,2(R10) LWDLINE=LWDLINE+2
ITERK3 LA R8,1(R8) K=K+1
B LOOPK3
ELOOPK3 LA R6,1 I=1
LOOPI4 C R6,=F'12' DO I=1 TO 12 BY 6
BH ELOOPI4
MVC MOLINE,BLANK MOLINE=' '
LA R10,6 LMOLINE=6
LR R8,R6 K=I
LOOPK4 LA R2,5(R6) I+5
CR R8,R2 DO K=I TO I+5
BH ELOOPK4
LR R1,R8 K
MH R1,=H'10' *10
LA R3,MO-10(R1) MO(K)
LA R4,MOLINE @MOLINE
AR R4,R10 +LMOLINE
MVC 0(10,R4),0(R3) SUB(MOLINE,LMOLINE+1,10)=MO(K)
LA R10,22(R10) LMOLINE=LMOLINE+22
LA R8,1(R8) K=K+1
B LOOPK4
ELOOPK4 XPRNT MOLINE,L'MOLINE PRINT MONTHS
XPRNT WDLINE,L'WDLINE PRINT DAYS OF WEEK
LA R7,1 J=1
LOOPJ4 C R7,=F'106' DO J=1 TO 106 BY 21
BH ELOOPJ4
MVC PG,BLANK CLEAR BUFFER
LA R9,PG PGI=0
LR R8,R6 K=I
LOOPK5 LA R2,5(R6) I+5
CR R8,R2 DO K=I TO I+5
BH ELOOPK5
LR R1,R8 K
MH R1,=H'144' *144
LA R4,DA-144(R1) DA(K)
BCTR R4,0 -1
AR R4,R7 +J
MVC 0(21,R9),0(R4) SUBSTR(DA(K),J,21)
LA R9,22(R9) PGI=PGI+22
LA R8,1(R8) K=K+1
B LOOPK5
ELOOPK5 XPRNT PG,L'PG PRINT BUFFER
LA R7,21(R7) J=J+21
B LOOPJ4
ELOOPJ4 LA R6,6(R6) I=I+6
B LOOPI4
ELOOPI4 L R13,4(0,R13) RESTORE PREVIOUS SAVEAREA POINTER
LM R14,R12,12(R13) RESTORE CALLER'S REGISTERS
XR R15,R15 SET RETURN CODE TO 0
BR R14 RETURN TO CALLER
SNOOPY DC CL57' ',CL18'INSERT SNOOPY HERE',CL57' '
YEAR DC F'1969' <== 1969
MO DC CL10' JANUARY ',CL10' FEBRUARY ',CL10' MARCH '
DC CL10' APRIL ',CL10' MAY ',CL10' JUNE '
DC CL10' JULY ',CL10' AUGUST ',CL10'SEPTEMBER '
DC CL10' OCTOBER ',CL10' NOVEMBER ',CL10' DECEMBER '
ML DC H'31',H'28',H'31',H'30',H'31',H'30'
DC H'31',H'31',H'30',H'31',H'30',H'31'
WDNA DC CL20'MO TU WE TH FR SA SU'
M DS F
D DS F
YY DS F
TD1 DS CL93
TD2 DS CL144
MOLINE DS CL132
WDLINE DS CL132
PG DC CL132' ' BUFFER FOR THE LINE PRINTER
XDEC DS CL12
BLANK DC CL144' '
DA DS 12CL144
YREGS
END CALENDAR
</lang>
{{out}}
<pre>
INSERT SNOOPY HERE
1969
JANUARY FEBRUARY MARCH APRIL MAY JUNE
MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU
1 2 3 4 5 1 2 1 2 1 2 3 4 5 6 1 2 3 4 1
6 7 8 9 10 11 12 3 4 5 6 7 8 9 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8
13 14 15 16 17 18 19 10 11 12 13 14 15 16 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15
20 21 22 23 24 25 26 17 18 19 20 21 22 23 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22
27 28 29 30 31 24 25 26 27 28 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29
31 30
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER
MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU
1 2 3 4 5 6 1 2 3 1 2 3 4 5 6 7 1 2 3 4 5 1 2 1 2 3 4 5 6 7
7 8 9 10 11 12 13 4 5 6 7 8 9 10 8 9 10 11 12 13 14 6 7 8 9 10 11 12 3 4 5 6 7 8 9 8 9 10 11 12 13 14
14 15 16 17 18 19 20 11 12 13 14 15 16 17 15 16 17 18 19 20 21 13 14 15 16 17 18 19 10 11 12 13 14 15 16 15 16 17 18 19 20 21
21 22 23 24 25 26 27 18 19 20 21 22 23 24 22 23 24 25 26 27 28 20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28
28 29 30 31 25 26 27 28 29 30 31 29 30 27 28 29 30 31 24 25 26 27 28 29 30 29 30 31
</pre>
=={{header|Ada}}==
| |||