TITLE	ARGS FOR LIBOL
SUBTTL	PICK UP ARGUMENTS FOR SUBPROGRAM ENTRY		CHUCK MCCOMAS



;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, 1981 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
;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:	AOS	PA		;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

	CAIE	TB,DISP		;DISPLAY ARG?
	JRST	ARG2		;NO, BINARY

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

ARG2:	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:	TTCALL	3,[ASCIZ "?INDEXED ARG POINTERS NOT SUPPORTED
"]
	JRST	KILL.

	END