(One of) Abe Kornelis' many web pages of IBM assembler 'stuff'.
http://www.bixoft.nl/english/intro.htm
2 of the 4 exercises from his Assembler Proficiency Self-test.
Kind of fun to do. Took way more than the 3 hour time limit.
This page is to remind me where his stuff is.
* ASMLG C:\USERS\LIN\DOCUMENTS\Z390CODE\ASSIGN2
* HTTP://WWW.BIXOFT.NL/ENGLISH/INTRO.HTM
* ASMLG C:\USERS\LIN\DOCUMENTS\Z390CODE\ASSIGN2 TIME(1) PARM('12')
*
MACRO
DEFREGS &START,&END,&SPEC,&PREF=R ASSIGNMENT #4
LCLA &R
LCLC &RH
.*** MNOTE ,'&SYSLIST, &SYSLIST(2) &SYSLIST(3) ' ???
AIF ('&PREF' EQ 'R' OR '&PREF' EQ 'GPR').A
AIF ('&PREF' EQ 'CR' OR '&PREF' EQ 'AR').A
AIF ('&PREF' EQ 'FPR').A
MNOTE 12,'INVALID PREF=&PREF MUST BE R GPR CR AR OR FPR'
MEXIT
.A AIF (T'&START NE 'N').AERR
AIF (T'&END EQ 'N').B
.AERR MNOTE 12,'FROM/TO REG SPECIFICATIONS MUST BE NUMERIC'
MEXIT
.B AIF (T'&SPEC EQ 'O').C
AIF ('&SPEC' EQ 'DEC').C
AIF ('&SPEC' EQ 'HEX').C
MNOTE 12,'REG SPEC/TYPE MUST BE DEC OR HEX'
MEXIT
.C AIF (&END GT 15).CERR
AIF (&END GE &START).D
.CERR MNOTE 12,'START/END REGS MUST BE ##, EG 0,15'
MEXIT
.D ANOP
&R SETA &START
.*
.LOOP AIF (&R GT 9 AND '&SPEC' EQ 'HEX').DOHEX
&PREF&R EQU &R
AGO .NEXT
.DOHEX ANOP
.* SUBSTR('ABC',2,4)
MNOTE ,'&R '
&RH SETC '123456789ABCDEF'(&R,1)
&PREF&RH EQU &R
.*
.NEXT ANOP
.* MNOTE ,'&R &START &END &SPEC &PREF '
&R SETA 1+&R
AIF (&R LE &END).LOOP
MEND
*
* NOTE, ASSIGN2 IS VERY CLOSE TO REENTRANT, AND COULD BE.
*
ASSIGN2 START 0 ASSIGNMENT #2
DEFREGS 0,6
DEFREGS 12,15
* DEFREGS 13,15,HEX
* DEFREGS 4,2
* DEFREGS A,2
* DEFREGS 3,B
* *** DEFREGS 4,5,HEX,JUNK
* DEFREGS 4,5,HEX,PREF=YUCK
* DEFREGS 7,8,HEX,PREF=CR
* DEFREGS 9,10,PREF=AR
* DEFREGS 11,12,PREF=FPR
*
USING *,12 I'M GOING TO ASSUME THAT THE PASSED
B BEG-ASSIGN2(15) PARM IS IN THE FORMAT OF THE PARM
DC AL1(L'NAME) FIELD.
NAME DC C'ASIGN2, 01.01, &SYSDATE &SYSTIME'
*
BEG STM 14,12,12(13) NOW I DON'T NEED MY OWN SAVEAREA,
LR 12,15 SO SHOULD I WASTE TIME AND GET ONE?
LR R6,R1 YOU'LL PROBABLY BEAT ME UP IF NOT.
* BUT IF I WAS WRITING FOR REAL, NOPE!
*
LA R6,PARMLIST TESTCODE
*
* LA R0,72
* GETMAIN R,LV=(0) AND, OF COURSE, YOU COULD COMMENT
* ST R1,8(R13) ALL THIS OUT, AND THE ONLY EFFECT
* ST R13,4(R1) WOULD BE THAT IT WOULD RUN FASTER.
* LR R13,R1
*
TSTAGAIN L R2,0(R6) YOU'LL PROBABLY BEAT ME UP IF NOT.
LA R4,MSG1
LH R3,0(R2) # OF CHARS
LTR R3,R3
BNP ERR 0 = ERROR
SR R5,R5 START WITH RC=0
LA R4,MSG2 (INVALID DIGIT ERR MSG)
*
LOOP CLI 2(R2),C'0' Q. #
BL ERR2 NO, ERR
CLI 2(R2),C'9' ALRIGHT, ALRIGHT, CHECK HIGH TOO
BH ERR2
IC R0,2(R2) LOAD DIGIT, THEN CLEAR ZONE BITS.
N R0,=F'15' SAME CLEAR FOR ASCII + EBCDIC. :-)
MH R5,=H'10' MULT RC SO FAR BY 10
AR R5,R0 AND ADD DIGIT
LA R2,1(R2) BUMP INDEX
BCT R3,LOOP LOOP
*
LA R4,MSG3
C R5,=F'4095' Q. ## BEEN SMOKING WEED OR SUMPIN?
BH ERR YEAH, TOO HIGH, ERROR.
*
MVC MSG0+13(6),6(R6) TESTCODE
CVD R5,DW TESTCODE
OI DW+7,X'0F' TESTCODE
UNPK MSG0+24(5),DW+5(3) TESTCODE
LA R4,MSG0 TESTCODE
B ERR TESTCODE
DW DC D'0' TESTCODE
MSG0 DC F'000',H'40,0',CL36'PARM= RC=' TESTCODE
*
* LR 1,13
* L 13,4(13) OOPS, ALMOST FORGOT.
* LA 0,72
* FREEMAIN R,LV=(0),A=(1)
*
EXIT LR R15,R5 'CAUSE FREEM LIKELY MESSES UP R15.
L 14,12(13)
LM 0,12,20(13)
OI 15(13),1 INDICATE RETURN FROM PGM.
BR 14 (OR IS IT 19(13) I FORGET)
*
ERR2 MVC MSG2+8+29(1),2(R2)
ERR LA R1,4(R4)
WTO MF=(E,(1))
L R5,0(R4)
*** ABEND (5) TESTCODE
* TESTCODE
LA R6,12(R6) TESTCODE
CLI 0(R6),0 TESTCODE
BE TSTAGAIN TESTCODE
B EXIT TESTCODE
* TESTCODE
PARMLIST DC A(*+4),H'3',CL6'123',A(*+4),H'5',CL6'12345' TESTCODE
DC A(*+4),H'3',CL6'ABD',A(*+4),H'1',CL6'1' TESTCODE
DC A(*+4),H'1',CL6'0',A(*+4),H'0',CL6'FINI',F'-1' TESTCODE
*
MSG1 DC F'101',H'40,0',CL36'ABEND 101, NO PARAM VALUE FOUND'
MSG2 DC F'102',H'40,0',CL36'ABEND 102, INVALID NUMERIC ='
MSG3 DC F'103',H'40,0',CL36'ABEND 103, PARAM VALUE EXCEEDS 4095'
LTORG
END ASSIGN2