This sample was assembled and tested on an OS/390 V2.R9 system during May 2002 and on a z/OS V1.R3 system during November 2002. (Note that because the LINK macro passes control to a separate Load Module, two routines are listed.)

PRINT

NOGEN

TITLE

'EX7C - EXERCISE IN SUBROUTINE LINKAGE - LINK METHOD'

EX7C

CSECT

USING

*,R15

INITIAL BASE REGISTER

BEGIN

B

START

DC

AL1(8),CL8'EX7C'

PROGRAM NAME FOR DEBUGGING

SAVEAREA

DS

0F

MY SAVE AREA

DC

AL4(*-*)

PRESAVE

DC

AL4(*-*)

ADDR OF PREVIOUS SAVE AREA

NEXTSAVE

DC

AL4(*-*)

ADDR OF NEXT SAVE AREA

SREG14

DC

AL4(*-*)

GENERAL

SREG15

DC

AL4(*-*)

- - - -> PURPOSE

SREG0

DC

13AL4(*-*)

- - - - - - - -> REGISTER SAVE

SAVEEND

DS

0H

END OF MY SAVE AREA

SPACE

1

START

EQU

*

DROP

R15

DUMP INITIAL BASE REGISTER

STM

R14,R12,12(R13)

SAVE THE REGISTERS ON ENTRY.

LR

R12,R15

SET UP MY

USING

BEGIN,R12

- - - -> BASE REGISTER

ST

R13,PRESAVE

PERFORM SAVE

LA

R15,SAVEAREA

- - - -> AREA

ST

R15,8(R13)

- - - - - - - -> CHAINING

LR

R13,R15

R13 = ADDR OF MY SAVE AREA.

OPEN

(INDCB,INPUT,OUTDCB,OUTPUT) OPEN THE FILES.

EJECT

*

*

PREPARE TO BUILD A LIST OF NAMES IN OUTAREA.

*

LA

R4,NAMETAB

R4 = START OF ARRAY.

READREC

GET

INDCB,INAREA

READ A RECORD

*

*

RETRIEVE THE NAMES AND SORT THEM!

*

MVC

0(8,R4),INAREA

NO - SLOT NAME IN ARRAY,

LA

R4,8(,R4)

POINT TO NEXT ARRAY SLOT,

B

READREC

AND REPEAT TILL EXHAUSTED.

READDONE

LINK

EP=EX7CSUB,PARAM=(NAMETAB) GO SORT LIST

MVC

OUTAREA+1(80),NAMETAB MOVE SORTED LIST TO RECORD,

PUT

OUTDCB,OUTAREA

- - - -> AND OUTPUT IT.

SPACE

3

EXIT

CLOSE

(INDCB,,OUTDCB)

CLOSE BOTH FILES

L

R13,PRESAVE

R13 = PREVIOUS SAVE AREA ADDR.

RETURN

(14,12),RC=0

RESTORE REGISTERS

EJECT

LTORG

SPACE

1

INDCB

DCB

MACRF=GM,EODAD=READDONE,DDNAME=INDD,LRECL=80,DSORG=PS

INAREA

DS

CL80

SPACE

1

OUTDCB

DCB

MACRF=PM,RECFM=F,LRECL=133,DDNAME=OUTDD,DSORG=PS

OUTAREA

DC

CL133' '

SPACE

1

NAMETAB

DC

8X'FF'

FIRST ENTRY - HIGH VALUES

DC

8XL10'FFFFFFFFFFFFFFFF' FURTHER 8 ENTRIES.

NAMETABE

DC

XL1'FF'

END OF NAME TABLE.

SPACE

1

R0

EQU

0

R1

EQU

1

R2

EQU

2

R3

EQU

3

R4

EQU

4

R5

EQU

5

R6

EQU

6

R7

EQU

7

R8

EQU

8

R9

EQU

9

R10

EQU

10

R11

EQU

11

R12

EQU

12

R13

EQU

13

R14

EQU

14

R15

EQU

15

END

The routine invoked by the EX7C Sample follows

PRINT

NOGEN

TITLE

'EX7CSUB - SUBROUTINE INVOKED BY EX7C'

EX7CSUB

CSECT

USING

*,R15

INITIAL BASE REGISTER

BEGIN

B

START

DC

AL1(8),CL8'EX7CSUB'

PROGRAM NAME FOR DEBUGGING

SAVEAREA

DS

0F

MY SAVE AREA

DC

AL4(*-*)

PRESAVE

DC

AL4(*-*)

ADDR OF PREVIOUS SAVE AREA

DC

AL4(*-*)

ADDR OF NEXT SAVE AREA

DC

AL4(*-*)

GENERAL

DC

AL4(*-*)

- - - -> PURPOSE

DC

13AL4(*-*)

- - - - - - - -> REGISTER SAVE

SAVEEND

DS

0H

END OF MY SAVE AREA

SPACE

1

START

EQU

*

DROP

R15

DUMP INITIAL BASE REGISTER

STM

R14,R12,12(R13)

SAVE THE REGISTERS ON ENTRY.

LR

R12,R15

SET UP MY

USING

BEGIN,R12

- - - -> BASE REGISTER

ST

R13,PRESAVE

PERFORM SAVE

LA

R15,SAVEAREA

- - - -> AREA

ST

R15,8(R13)

- - - - - - - -> CHAINING

LR

R13,R15

R13 = ADDR OF MY SAVE AREA.

L

R2,0(R1)

R2 = NAME TABLE ADDRESS

SORT

LR

R4,R2

R4 = START OF ARRAY.

LA

R3,8(,R2)

R3 = START OF ARRAY + 1.

TM

FLAG,SORTED

ARE NAMES IN ORDER?

BO

INFORM

YEP - GO TELL ABOUT IT.

OI

FLAG,SORTED

NO - INDICATE IT IS.

SORT1

CLI

0(R4),X'FF'

END OF ARRAY?

BE

SORT

YEP - CHECK ALL DONE,

CLC

0(8,R4),0(R3)

NO - IS FIRST > SECOND?

BH

SWAP

YEP - SWAP THEM

SORT2

LA

R4,8(,R4)

NO - MOVE TO

LA

R3,8(,R3)

- - - -> NEXT

B

SORT1

- - - - - - - -> PAIR.

SWAP

MVC

TEMP,0(R4)

SAVE FIRST NAME, THEN

MVC

0(8,R4),0(R3)

MOVE SECOND NAME FORWARD,

MVC

0(8,R3),TEMP

RETURN FIRST NAME TO ARRAY.

NI

FLAG,255-SORTED

INDICATE NOT SORTED.

B

SORT2

GO GET NEXT PAIR.

SPACE

1

INFORM

L

R13,PRESAVE

R13 = PREVIOUS SAVE AREA ADDR.

RETURN

(14,12),RC=0

RESTORE REGISTERS

TEMP

DS

CL8

SWITCH NAME AREA.

FLAG

DC

X'00'

SORTED/UNSORTED INDICATOR

SORTED

EQU

X'01'

INDICATE SORTED.

R0

EQU

0

R1

EQU

1

R2

EQU

2

R3

EQU

3

R4

EQU

4

R5

EQU

5

R6

EQU

6

R7

EQU

7

R8

EQU

8

R9

EQU

9

R10

EQU

10

R11

EQU

11

R12

EQU

12

R13

EQU

13

R14

EQU

14

R15

EQU

15

END

Copyright © KMS-IT Limited 2002