Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/args.mac
There are 7 other files named args.mac in the archive. Click here to see a list.
; UPD ID= 91 on 11/16/81 at 5:53 PM by NIXON                            
TITLE	ARGS FOR LIBOL
SUBTTL	PICK UP ARGUMENTS FOR SUBPROGRAM ENTRY		CHUCK MCCOMAS

	SEARCH COPYRT
	SALL


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


ENTRY	ARGS.

;USED BY SUBPROGRAM ENTRY POINTS
;  TO PICK UP BASE ADDRESSES OF ARGS PASSED TO THE ENTRY BY A CALL,
;  AND TO STORE THEM IN DUMMY ARG INDEX LOCATIONS

;CALLING SEQUENCE:
;	MOVEI	16,ARGLST
;	PUSHJ	17,ARGS.
;	<RETURN HERE>
;
;WITH ARGUMENT LIST AS FOLLOWS:
;	XWD	-(ARG-COUNT),0
;ARGLST: EXP	ADDR OF PTR TO ARGS PASSED BY CALL
;	EXP	ADDR OF LOC TO STORE BASE ADDR OF 1ST ARG
;	EXP	ADDR OF LOC TO STORE BASE ADDR OF 2ND ARG
;		...
;	EXP	ADDR OF LOC TO STORE BASE ADDR OF LAST ARG
;
;NOTE:  ARG-COUNT = NUMBER OF ARGS WANTED AT ENTRY PLUS 1 (FOR THE
;		   PTR TO THE ARGS PASSED TO THE ENTRY BY THE CALL)
;ACCUMULATORS

TA==1
TB==2
TC==3
TD==4
CA==15		;PTR TO ARGS PASSED BY CALL
PA==16		;ARG PTR
PP==17		;PDL PTR

;ARG TYPES

COMP==0		;SINGLE PRECISION BINARY
COMP1==4	;SINGLE PRECISION FLOATING POINT
DISP==15	;CHARACTER STRING
DBCOMP==11	;DOUBLE PRECISION BINARY
PROC==7		;PROCEDURE ADDRESS (ILLEGAL FOR COBOL SUBPROGRAMS)

	HISEG

	.COPYRIGHT		;Put standard copyright statement in REL file
;ENTRY POINT -- MAIN ROUTINE

ARGS.:	HLRE	TC,-1(PA)	;GET ARG COUNT
	JUMPGE	TC,BADLST	;REQUIRE AT LEAST THE PTR TO CALLER'S ARGS

	MOVE	CA,@(PA)	;GET ADDR OF ARGS PASSED BY CALL

	ADDI	TC,1		;GET # OF ARGS WANTED AT ENTRY
	HLRE	TD,-1(CA)	;GET # ARGS PASSED BY CALL
	CAMLE	TD,TC		;ENOUGH PASSED?
	JRST	NOTNUF		;NO

ARG0:	ADDI	PA,1		;BUMP DUMMY ARG PTR
	AOJG	TC,CPOPJ	;RETURN AFTER ALL WANTED ARGS PICKED UP

	MOVE	TA,(CA)		;GET ARG LIST ITEM
	LDB	TB,[POINT 4,TA,12]	;GET TYPE CODE
	CAIN	TB,PROC		;PROCEDURE-NAME ARG?
	JRST	BADARG		;YES

	TLNE	TA,17		;ANYTHING IN INDEX FIELD OF ARG PTR?
	JRST	IDXARG		;YES, THAT'S ILLEGAL

	MOVEI	TA,@TA		;CONVERT POSSIBLE INDIRECT ADDR TO DIRECT

	CAIN	TB,DISP		;DISPLAY ARG?

	HRRZ	TA,(TA)		;YES, GET THE BYTE PTR

	HRRZ	TB,(PA)		;GET ADDR OF DUMMY ARG
	HRRZM	TA,(TB)		;STORE BASE ADDR OF ARG

	AOJA	CA,ARG0		;BUMP ARG PTR

CPOPJ:	POPJ	PP,		;ALL ARGS SET UP, RETURN TO ENTRY
;ERROR MESSAGES

NOTNUF:	OUTSTR	[ASCIZ /?Not enough args passed to subprogram
/]
	JRST	KILL.##

BADARG:	OUTSTR	[ASCIZ /?Bad arg type passed to subprogram
/]
	JRST	KILL.

BADLST:	OUTSTR	[ASCIZ /?ARGS. called with improper arg list
/]
	JRST	KILL.

IDXARG:	OUTSTR	[ASCIZ "?Indexed arg pointers not supported
"]
	JRST	KILL.

	END