

; Bliss-32 10.1-416	Monday 21-AUG-1978 19:13:34	DBB3:[RTL.SRC]FASSOC.B32;4					Page 1

;

;	0001	MODULE FOR$$ASSOC	(	! Update FORTRAN associated variable

;	0002		IDENT = '0-05'

;	0003			) =

;	0004	BEGIN

;	0005	

;	0006	!

;	0007	! COPYRIGHT (C) 1977

;	0008	! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754

;	0009	!

;	0010	! THIS SOFTWARE IS FURNISHED  UNDER A LICENSE FOR USE ONLY ON A SINGLE

;	0011	! COMPUTER  SYSTEM AND  MAY BE  COPIED ONLY WITH  THE INCLUSION OF THE

;	0012	! ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANY OTHER COPIES THEREOF,

;	0013	! MAY NOT BE PROVIDED OR  OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON

;	0014	! EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE

;	0015	! TERMS.  TITLE TO AND  OWNERSHIP OF THE  SOFTWARE  SHALL AT ALL TIMES

;	0016	! REMAIN IN DEC.

;	0017	!

;	0018	! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE

;	0019	! AND SHOULD  NOT BE CONSTRUED  AS A COMMITMENT  BY DIGITAL  EQUIPMENT

;	0020	! CORPORATION.

;	0021	!

;	0022	! DEC ASSUMES  NO  RESPONSIBILITY  FOR  THE USE OR  RELIABILITY OF ITS

;	0023	! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.

;	0024	

;	0025	!++

;	0026	! FACILITY: FORTRAN Support Library - not user callable

;	0027	!

;	0028	! ABSTRACT:

;	0029	!

;	0030	!	This module contains routine FOR$$ASSOC: store record

;	0031	!	number from the LUB into the users (optional) associated variable.

;	0032	!

;	0033	! ENVIRONMENT:	User access mode; AST level or not.

;	0034	!

;	0035	! AUTHOR:	Jonathan M. Taylor;	CREATION DATE: 8-JUL-77

;	0036	!

;	0037	! MODIFIED BY:

;	0038	!

;	0039	!	Jonathan M. Taylor, 8-JUL-77 : VERSION 0

;	0040	! 0-1	- original

;	0041	! 0-2	- Make GTR comparison unsigned JMT 2-OCT-77

;	0042	! 0-3	- Modified to get rid of routine FOR$$DIR_CHKNUM, now done at

;	0043	!	  IOBEG time.  Module name changed from FOR$$DIR_ACC. JMT 16-OCT-77

;	0044	! 0-4	- Global register CCB.  JMT 8-Apr-78

;	0045	! 0-05	- Change REQUIRE files for VAX system build.  DGP 28-Apr-78

;	0046	!--



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:13:34	DBB3:[RTL.SRC]FASSOC.B32;4					Page 2

;

;	0047	!

;	0048	! LINKAGES:

;	0049	!

;	0050	LINKAGE

;	0051	    CCBR11 = CALL: GLOBAL(CCB = 11);

;	0052	

;	0053	!

;	0054	! TABLE OF CONTENTS

;	0055	!

;	0056	

;	0057	FORWARD ROUTINE

;	0058	

;	0059		FOR$$ASSOC: CCBR11 NOVALUE;	! Store users associated variable

;	0060	

;	0061	!

;	0062	! INCLUDE FILES:

;	0063	!

;	0064		REQUIRE 'RTLML:FLUB';		! Logical Unit Block (LUB) offsets

; %PRINT:	File: FLUB.MDL which produces FLUB.B32! Version 0, edit 30, TNH, 17-June-78

;	0232		REQUIRE	'RTLIN:FMAC';		! For LPSECTs only

; %PRINT:	Filename: FMAC.B32; Version 1, edit 29, TNH, 7-JUN-78

; %PRINT:	 REQUIRE FILE: LPSECT.B32, VERSION 01-5, TNH, 27-Jun-78

;65535  0412	!

;65535  0413	! MACROS:

;65535  0414	!

;65535  0415	!	NONE

;65535  0416	

;65535  0417	!

;65535  0418	! EQUATED SYMBOLS:

;65535  0419	!

;65535  0420	!	NONE

;65535  0421	

;65535  0422	!

;65535  0423	! PSECT DECLARATIONS:

;65535  0424	!

;65535  0425	

;65535  0426		DECLARE_PSECTS (FOR);	! Declare PSECTs for FOR$ facility

;65535  0427	

;65535  0428	!

;65535  0429	! OWN STORAGE

;65535  0430	!

;65535  0431	!	NONE

;65535  0432	

;65535  0433	!

;65535  0434	! EXTERNAL REFERENCES:

;65535  0435	!



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:13:34	DBB3:[RTL.SRC]FASSOC.B32;4					Page 3

;

;65535  0436	GLOBAL ROUTINE FOR$$ASSOC 	! Store users associated variable

;65535  0437	    : CCBR11 NOVALUE =

;65535  0438	

;65535  0439	!++

;65535  0440	! FUNCTIONAL DESCRIPTION:

;65535  0441	!

;65535  0442	!	If an associated variable is present, store the

;65535  0443	!	logical record number from the LUB into it.

;65535  0444	!

;65535  0445	! FORMAL PARAMETERS:

;65535  0446	!

;65535  0447	! IMPLICIT INPUTS:

;65535  0448	!

;65535  0449	!	OTS$$A_CUR_LUB		Pointer to current logical unit

;65535  0450	!				block (LUB) used to setup LUB 

;65535  0451	!				base pointer.

;65535  0452	!	LUB$A_ASSOC_VAR		Address of assoc. var. or zero if none

;65535  0453	!	LUB$V_ASS_VAR_L		TRUE iff assoc. var. is a longword value

;65535  0454	!	LUB$L_RECNO		Current record number

;65535  0455	!

;65535  0456	! IMPLICIT OUTPUTS:

;65535  0457	!

;65535  0458	!	assoc. var.		Updated associated variable (if present)

;65535  0459	!

;65535  0460	! ROUTINE VALUE:

;65535  0461	!

;65535  0462	!	NONE

;65535  0463	!

;65535  0464	! SIDE EFFECTS:

;65535  0465	!

;65535  0466	!	NONE

;65535  0467	!--

;65535  0468	

;65535  0469		BEGIN

;65535  0470	

;65535  0471		EXTERNAL REGISTER

;65535  0472		    CCB: REF BLOCK[, BYTE];

;65535  0473	

;65535  0474		!+

;65535  0475		! If an associated variable is used with this file, store the

;65535  0476		! record number into it.

;65535  0477		!-

;65535  0478	

;65535  0479		IF .CCB[LUB$A_ASSOC_VAR] NEQA 0

;65535  0480		THEN

;65535  0481	

;65535  0482		    BEGIN

;65535  0483		    !+

;65535  0484		    ! If associated variable is a longword, store 32-bits

;65535  0485		    !-

;65535  0486	

;65535  0487		    IF .CCB[LUB$V_ASS_VAR_L]

;65535  0488		    THEN

;65535  0489			.CCB[LUB$A_ASSOC_VAR] = .CCB[LUB$L_LOG_RECNO]

;65535  0490		    ELSE



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:13:34	DBB3:[RTL.SRC]FASSOC.B32;4					Page 3-1

;

;65535  0491	

;65535  0492		    !+

;65535  0493		    ! Else store 16-bits

;65535  0494		    !-

;65535  0495	

;65535  0496			(.CCB[LUB$A_ASSOC_VAR])<0,16,0> = .CCB[LUB$L_LOG_RECNO];

;65535  0497		    END;

;65535  0498	

;65535  0499		RETURN;

;65535  0500		END;	! end of routine





							    .TITLE  FOR$$ASSOC

							    .IDENT  \0-05\







							    .PSECT  FOR$CODE,NOWRT,  SHR,  PIC,2



					 0000 00000 	    .ENTRY  FOR$$ASSOC, Save nothing				      ; 0436

		         50 	  DC   AB  D0 00002 	    MOVL    -36(CCB), R0					      ; 0479

				       0E  13 00006 	    BEQL    2$							      ;

	   05 	    FD   AB	       04  E1 00008 	    BBC     #4, -3(CCB), 1$					      ; 0487

		         60 	  E0   AB  D0 0000D 	    MOVL    -32(CCB), (R0)					      ; 0489

					   04 00011 	    RET     							      ; 0487

		         60 	  E0   AB  B0 00012 1$:     MOVW    -32(CCB), (R0)					      ; 0496

					   04 00016 2$:     RET     							      ; 0436



; Routine Size:  23 bytes





;65535  0501	

;65535  0502	END	! END OF MODULE

;65535  0503	ELUDOM













;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

;  FOR$CODE       	    23  NOWRT,  RD ,  EXE,  SHR,  LCL,  REL,  CON,  PIC,ALIGN(2)











; Size:		23 code + 0 data bytes

; Run Time:	00:03.0

; Elapsed Time:	00:05.6

; Memory Used:	28 pages

; Compilation Complete



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:13:34									Page 3-2

;

