

; Bliss-32 10.1-416	Monday 21-AUG-1978 19:17:05	DBB3:[RTL.SRC]FFIND.B32;6					Page 1

;

;00100  0001	MODULE FOR$FIND (	! Implements FORTRAN FIND statement

;00200  0002		IDENT = '2-08'	! File: FFIND.B32

;00300  0003			) =

;00400  0004	BEGIN

;00500  0005	

;00600  0006	!

;00700  0007	!			  COPYRIGHT (c) 1977 BY

;00800  0008	!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;00900  0009	!

;01000  0010	! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED

;01100  0011	! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE

;01200  0012	! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER

;01300  0013	! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY

;01400  0014	! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY

;01500  0015	! TRANSFERRED.

;01600  0016	!

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

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

;01900  0019	! CORPORATION.

;02000  0020	!

;02100  0021	! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS

;02200  0022	! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

;02300  0023	!

;02400  0024	

;02500  0025	!++

;02600  0026	! FACILITY: FORTRAN Support Library - User Callable

;02700  0027	!

;02800  0028	! ABSTRACT:

;02900  0029	!

;03000  0030	!	This module implements the FORTRAN FIND statement.

;03100  0031	!	This is performed by doing everything a READ Direct

;03200  0032	!	I/O statement would do, except actually doing the I/O.

;03300  0033	!

;03400  0034	! ENVIRONMENT: User access mode; mixture of AST level or not.

;03500  0035	!

;03600  0036	! AUTHOR: Jonathan M. Taylor, CREATION DATE: 1-OCT-77 : Version 0

;03700  0037	!

;03800  0038	! MODIFIED BY:

;03900  0039	!

;04000  0040	!	JMT, 24-OCT-77: VERSION 2

;04100  0041	! 2-0	- original

;04200  0042	! 2-1	- Use FOR$K_abcmnoxyz as EXTERNAL LITERALs.  TNH 27-Oct-77

;04300  0043	! 2-2	- Change MIXADDMOD to OPEDEFREQ; INVRECNUM to RECNUMOUT.  TNH 29-Oct-77

;04400  0044	! 2-4	- Use FERR.  TNH 16-Dec-77

;04500  0045	! 2-5	- Global register CCB.  JMT 8-Apr-78

;04600  0046	! 2-06	- Change REQUIRE files for VAX system build.  DGP 28-Apr-78

;04610  0047	! 2-07	- Use JSB linkages.  TNH 22-May-78

;04620  0048	! 2-08	- Pass OPEN$K_LUN_MIN to FOR$$CB_PUSH.  TNH 22-May-78

;04700  0049	!--



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:17:05	DBB3:[RTL.SRC]FFIND.B32;6					Page 2

;

;00100  0050	!

;00200  0051	! LINKAGES:

;00300  0052	!

;00500  0053	REQUIRE 'RTLIN:FLNK';		! define all linkages

; %PRINT:	File: FLNK.B32; Version 1, edit 12, TNH 2-Aug-78

;00600  0275	

;00700  0276	!

;00800  0277	! TABLE OF CONTENTS:

;00900  0278	!

;01000  0279	

;01100  0280	FORWARD ROUTINE

;01200  0281		FOR$FIND: NOVALUE;	! FORTRAN FIND statement

;01300  0282	

;01400  0283	!

;01500  0284	! INCLUDE FILES:

;01600  0285	!

;01700  0286		REQUIRE 'RTLML:FERR';		! FORTRAN error number definitions

; %PRINT:	Filename: FERR.MDL! Version 0, edit 36, TNH 19-June-78

;01800  0404		REQUIRE 'RTLML:FPAR';		! Inter-module constants

; %PRINT:	File: FPAR.MDL! version 0, edit 11, TNH, 30-May-78

;01900  0506		REQUIRE 'RTLIN:FOPN';		! Get I/O statement codes

; %PRINT:	Filename: FOPN.B32; version 0, edit 22, TNH, 30-May-78

;02000  0645		REQUIRE 'RTLIN:FMAC';		! Get DECLARE_PSECTS definition

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

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

;02100  0825		REQUIRE 'RTLML:FLUB';		! Get LUB offsets

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

;02200  0993	

;02300  0994	!

;02400  0995	! MACROS:

;02500  0996	!

;02600  0997	!	NONE

;02700  0998	

;02800  0999	!

;02900  1000	! EQUATED SYMBOLS:

;03000  1001	!

;03100  1002	!	NONE

;03200  1003	

;03300  1004	!

;03400  1005	! OWN STORAGE:

;03500  1006	!

;03600  1007	!	NONE

;03700  1008	

;03800  1009	!

;03900  1010	! EXTERNAL REFERENCES:

;04000  1011	!

;04100  1012	

;04200  1013	EXTERNAL ROUTINE

;04300  1014		FOR$$ERR_OPECLO,			! Error handler

;04400  1015		FOR$$OPEN_DEFLT: CALL_CCB NOVALUE,	! FORTRAN default file opener

;04500  1016		FOR$$SIGNAL_STO: NOVALUE,		! convert error code and signal

;04600  1017		FOR$$ASSOC: CALL_CCB NOVALUE,		! store rec. # in assoc. variable

;04700  1018		FOR$$CB_PUSH: JSB_CB_PUSH NOVALUE,		! Get a control block

;04800  1019		FOR$$CB_POP: JSB_CB_POP NOVALUE;		! Return a control block

;04900  1020	



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:17:05	DBB3:[RTL.SRC]FFIND.B32;6					Page 2-1

;

;05000  1021	!

;05100  1022	! PSECT DECLARATIONS:

;05200  1023	!

;05300  1024		DECLARE_PSECTS (FOR);	! Declare PSECTS for FOR$ facility



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:17:05	DBB3:[RTL.SRC]FFIND.B32;6					Page 3

;

;00100  1025	GLOBAL ROUTINE FOR$FIND (

;00200  1026		UNIT,

;00300  1027		REC_NO )

;00400  1028		: NOVALUE =

;00500  1029	

;00600  1030	!++

;00700  1031	! FUNCTIONAL DESCRIPTION:

;00800  1032	!

;00900  1033	!	Call CB_PUSH to get a control block for this UNIT.

;01000  1034	!	If has not been declared to be direct access then ERROR.

;01100  1035	!	If not already open then open ad direct-access, OLD, unformatted.

;01200  1036	!	Set the record number into the LUB and (optionally) into the

;01300  1037	!	users associated variable.  Return the I/O system to its previous state.

;01400  1038	!

;01500  1039	! FORMAL PARAMETERS:

;01600  1040	!

;01700  1041	!	UNIT.rlu.v		Unit number (call by value)

;01800  1042	!	REC_NO.rl.v		Record number to seek (call by value)

;01900  1043	!

;02000  1044	! IMPLICIT INPUTS:

;02100  1045	!

;02200  1046	!	LUB$V_DIRECT		1 if DEFINE FILE done or OPEN with access='DIRECT'

;02300  1047	!	LUB$V_OPENED		1 if file previously opened

;02400  1048	!

;02500  1049	! IMPLICIT OUTPUTS:

;02600  1050	!

;02700  1051	!	LUB$L_LOG_RECNO		Gets set to the record number passed as

;02800  1052	!				a parameter.

;02900  1053	!	ass. var.		Users associated variable gets new LOG_RECNO

;03000  1054	!

;03100  1055	! ROUTINE VALUE:

;03200  1056	!	NONE

;03300  1057	!

;03400  1058	! COMPLETION CODES:

;03500  1059	!

;03600  1060	!	NONE

;03700  1061	!

;03800  1062	! SIDE EFFECTS:

;03900  1063	!

;04000  1064	!	Users associated variable (if present) takes the value of

;04100  1065	!	the new record number.  The file is opened if it was never opened before.

;04200  1066	!	SIGNAL_STOPs FOR$_OPEDEFREQ (26 = 'OPEN OR DEFINE FILE REQUIRED FOR DIRECT ACCESS')

;04300  1067	!	SIGNAL_STOPs FOR$_RECNUMOUT (25 = 'RECORD NUMBER OUT OF RANGE')

;04400  1068	!

;04500  1069	!--

;04600  1070	

;04700  1071	    BEGIN

;04800  1072	

;04900  1073	    GLOBAL REGISTER

;05000  1074		CCB = 11: REF BLOCK[, BYTE];

;05100  1075	

;05200  1076	    LOCAL

;05300  1077		L_UNWIND_ACTION: VOLATILE;

;05400  1078	

;05500  1079	    ENABLE



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:17:05	DBB3:[RTL.SRC]FFIND.B32;6					Page 3-1

;

;05600  1080		FOR$$ERR_OPECLO (L_UNWIND_ACTION);

;05700  1081	

;05800  1082	    L_UNWIND_ACTION = FOR$K_UNWINDNOP;

;05900  1083	

;06000  1084	    !+

;06100  1085	    ! Get a LUB for this unit.

;06200  1086	    ! On return, CCB points to the current control block.

;06300  1087	    !-

;06400  1088	

;06500  1089	    FOR$$CB_PUSH (.UNIT, OPEN$K_LUN_MIN);

;06600  1090	

;06700  1091	    !+

;06800  1092	    ! Error action is now to pop the LUB.

;06900  1093	    !-

;07000  1094	

;07100  1095	    L_UNWIND_ACTION = FOR$K_UNWINDPOP;

;07200  1096	

;07300  1097	    !+

;07400  1098	    ! If file not specified for direct access, then SIGNAL_STOP FOR$_OPEDEFREQ 

;07500  1099	    ! (26 = 'DIRECT ACCESS NOT SPECIFIED WHEN UNIT OPENED")

;07600  1100	    !-

;07700  1101	

;07800  1102	    IF .CCB[LUB$V_DIRECT] EQL 0

;07900  1103	    THEN

;08000  1104		FOR$$SIGNAL_STO (FOR$K_OPEDEFREQ);

;08100  1105	

;08200  1106	    !+

;08300  1107	    ! If file has not been previously OPENed, default-open it.

;08400  1108	    !-

;08500  1109	

;08600  1110	    IF .CCB[LUB$V_OPENED] EQL 0

;08700  1111	    THEN

;08800  1112		FOR$$OPEN_DEFLT (OPEN$K_ACC_DIR,

;08900  1113					OPEN$K_TYP_OLD,

;09000  1114					OPEN$K_FOR_UNF);

;09100  1115	

;09200  1116	    !+

;09300  1117	    ! If the logical record number passed is illegal then SIGNAL_STOP,

;09400  1118	    ! else store in the LUB and users associated variable.

;09500  1119	    !-

;09600  1120	

;09700  1121	    IF .REC_NO EQLU 0 OR

;09800  1122		(.CCB[LUB$L_REC_MAX] NEQ 0 AND .REC_NO GTRU .CCB[LUB$L_REC_MAX])

;09900  1123	    THEN

;10000  1124		FOR$$SIGNAL_STO (FOR$K_RECNUMOUT);

;10100  1125	

;10200  1126	    CCB[LUB$L_LOG_RECNO] = .REC_NO;

;10300  1127	    FOR$$ASSOC ();

;10400  1128	

;10500  1129	    !+

;10600  1130	    ! Return the I/O system to its last state.

;10700  1131	    !-

;10800  1132	

;10900  1133	    FOR$$CB_POP();

;11000  1134	



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:17:05	DBB3:[RTL.SRC]FFIND.B32;6					Page 3-2

;

;11100  1135	    END;





							    .TITLE  FOR$FIND

							    .IDENT  \2-08\



							    .EXTRN  FOR$$ERR_OPECLO, FOR$$OPEN_DEFLT, FOR$$SIGNAL_STO

							    .EXTRN  FOR$$ASSOC, FOR$$CB_PUSH, FOR$$CB_POP



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



					 0804 00000 	    .ENTRY  FOR$FIND, Save R2,R11				      ; 1025

				       7E  D4 00002 	    CLRL    L_UNWIND_ACTION					      ; 1071

		         6D 0000004F   EF  DE 00004 	    MOVAL   5$, (FP)						      ;

		         6E 	       01  D0 0000B 	    MOVL    #1, L_UNWIND_ACTION					      ; 1082

		         52 	  04   AC  D0 0000E 	    MOVL    UNIT, R2						      ; 1089

				       50  D4 00012 	    CLRL    R0							      ;

				     0000G 30 00014 	    BSBW    FOR$$CB_PUSH					      ;

				       6E  D4 00017 	    CLRL    L_UNWIND_ACTION					      ; 1095

	   07 	    FC   AB	       04  E0 00019 	    BBS     #4, -4(CCB), 1$					      ; 1102

				       1A  DD 0001E 	    PUSHL   #26							      ; 1104

		  0000G  CF	       01  FB 00020 	    CALLS   #1, FOR$$SIGNAL_STO					      ;

		         0B 	  FC   AB  E8 00025 1$:     BLBS    -4(CCB), 2$						      ; 1110

				       02  DD 00029 	    PUSHL   #2							      ; 1112

				       01  DD 0002B 	    PUSHL   #1							      ;

				       01  DD 0002D 	    PUSHL   #1							      ;

		  0000G  CF	       03  FB 0002F 	    CALLS   #3, FOR$$OPEN_DEFLT					      ;

		         52 	  08   AC  D0 00034 2$:     MOVL    REC_NO, R2						      ; 1121

				       0B  13 00038 	    BEQL    3$							      ;

				  E4   AB  D5 0003A 	    TSTL    -28(CCB)						      ; 1122

				       0D  13 0003D 	    BEQL    4$							      ;

		    E4   AB	       52  D1 0003F 	    CMPL    R2, -28(CCB)					      ;

				       07  1B 00043 	    BLEQU   4$							      ;

				       19  DD 00045 3$:     PUSHL   #25							      ; 1124

		  0000G  CF	       01  FB 00047 	    CALLS   #1, FOR$$SIGNAL_STO					      ;

		    E0   AB	       52  D0 0004C 4$:     MOVL    R2, -32(CCB)					      ; 1126

		  0000G  CF	       00  FB 00050 	    CALLS   #0, FOR$$ASSOC					      ; 1127

				     0000G 30 00055 	    BSBW    FOR$$CB_POP						      ; 1133

					   04 00058 	    RET     							      ; 1025

					 0000 00059 5$:     .WORD   Save nothing					      ; 1071

		         50 	  08   AC  D0 0005B 	    MOVL    8(AP), R0						      ;

		         50 	  04   A0  D0 0005F 	    MOVL    4(R0), R0						      ;

				  FC   A0  9F 00063 	    PUSHAB  L_UNWIND_ACTION					      ;

				       01  DD 00066 	    PUSHL   #1							      ;

				       5E  DD 00068 	    PUSHL   SP							      ;

		         7E 	  04   AC  7D 0006A 	    MOVQ    4(AP), -(SP)					      ;

		  0000G  CF	       03  FB 0006E 	    CALLS   #3, FOR$$ERR_OPECLO					      ;

					   04 00073 	    RET     							      ;



; Routine Size:  116 bytes





;11200  1136	

;11300  1137	END				!End of module

;11400  1138	ELUDOM



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:17:05	DBB3:[RTL.SRC]FFIND.B32;6					Page 3-3

;













;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

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











; Size:		116 code + 0 data bytes

; Run Time:	00:07.3

; Elapsed Time:	00:13.9

; Memory Used:	60 pages

; Compilation Complete

