

; Bliss-32 10.1-416	Monday 21-AUG-1978 19:24:15	DBB3:[RTL.SRC]FREWIN.B32;8					Page 1

;

;00100  0001	MODULE FOR$REWIND (	! FORTRAN REWIND Statement

;00200  0002		IDENT = '0-14'	! File: FREWIN.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	!	Contains routine FOR$REWIND: rewind a FORTRAN sequential

;03100  0031	!	access file.

;03200  0032	!

;03300  0033	! ENVIRONMENT: Mixture of AST level or not.

;03400  0034	!

;03500  0035	! AUTHOR: Jonathan M. Taylor, CREATION DATE: 10-OCT-77

;03600  0036	!

;03700  0037	! MODIFIED BY:

;03800  0038	!

;03900  0039	! 	Jonathan M. Taylor, 10-OCT-77 : VERSION 0

;04000  0040	! 0-1	- original 

;04100  0041	! 0-2	- changed error handler from ERR_ENDHND to OPECLO JMT 17-OCT-77

;04200  0042	! 0-3	- changed call to FOR$$CB_POP not _RET! JMT 19-OCT-77

;04300  0043	! 0-6	- Use FOR$K_abcmno6yz as E6TERNAL LITERALs.  TNH 27-Oct-77

;04400  0044	! 0-8	- Use FERR.  TNH 16-Dec-77

;04500  0045	! 0-9	- Global register CCB.  JMT 8-Apr-78

;04600  0046	! 0-10	- Change to STARLET library.  DGP 20-Apr-78

;04700  0047	! 0-11	- Change REQUIRE files for VAX system build.  DGP 28-Apr-78

;04800  0048	! 0-12	- Change STARLET to RTLSTARLE to avoid conflicts.  DGP 1-May-78

;04810  0049	! 0-13	- Use JSB linkages.  TNH 22-May-78

;04820  0050	! 0-14	- Pass OPEN$K_LUN_MIN to FOR$$CB_PUSH.  TNH 22-May-78

;04900  0051	!--



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:24:15	DBB3:[RTL.SRC]FREWIN.B32;8					Page 2

;

;00100  0052	!

;00200  0053	! LINKAGES:

;00300  0054	!

;00500  0055	REQUIRE 'RTLIN:FLNK';		! Define all linkages

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

;00600  0277	

;00700  0278	!

;00800  0279	! TABLE OF CONTENTS:

;00900  0280	!

;01000  0281	

;01100  0282	FORWARD ROUTINE

;01200  0283		FOR$REWIND: NOVALUE;		! FORTRAN REWIND statement processor

;01300  0284	

;01400  0285	!

;01500  0286	! INCLUDE FILES:

;01600  0287	!

;01700  0288	

;01800  0289		REQUIRE 'RTLML:FERR';			! FORTRAN error number definitions

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

;01900  0407		REQUIRE 'RTLIN:FOPN';			! File open parameters

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

;02000  0546		REQUIRE	'RTLML:FLUB';			! Logical Unit Block definitions

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

;02100  0714		REQUIRE 'RTLIN:FMAC';			! Macros

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

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

;02200  0894		REQUIRE 'RTLML:FISB';			! ISB definitions

; %PRINT:	File: FISB.MDL which produces FISB.B32! Version 1, EDIT 16, DGP 02-Jun-78

;02300  1103		REQUIRE 'RTLML:FPAR';			! inter-module parameters

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

;02400  1205		LIBRARY 'RTLSTARLE';		! STARLET library for macros and symbols

;02500  1206	!

;02600  1207	! MACROS:

;02700  1208	!	NONE

;02800  1209	

;02900  1210	!

;03000  1211	! EQUATED SYMBOLS:

;03100  1212	!	NONE

;03200  1213	

;03300  1214	

;03400  1215	!

;03500  1216	! OWN STORAGE:

;03600  1217	!	NONE

;03700  1218	

;03800  1219	!

;03900  1220	! EXTERNAL REFERENCES:

;04000  1221	!

;04100  1222	EXTERNAL ROUTINE

;04200  1223		FOR$$ERR_OPECLO,		! error condition handler

;04300  1224		FOR$$SIGNAL_STO: NOVALUE,	! convert error number and signal

;04400  1225		FOR$$CB_PUSH: JSB_CB_PUSH NOVALUE,	! create LUB/ISB/RAB, if needed

;04500  1226		FOR$$CB_POP: JSB_CB_POP NOVALUE;	! return I/O system to previous state

;04600  1227	

;04700  1228	!

;04800  1229	! PSECT DECLARATIONS:



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:24:15	DBB3:[RTL.SRC]FREWIN.B32;8					Page 2-1

;

;04900  1230	!

;05000  1231	

;05100  1232		DECLARE_PSECTS (FOR);		! declare PSECTS for FOR$ facility



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:24:15	DBB3:[RTL.SRC]FREWIN.B32;8					Page 3

;

;00100  1233	GLOBAL ROUTINE FOR$REWIND (

;00200  1234		UNIT)

;00300  1235		: NOVALUE =

;00400  1236	

;00500  1237	!++

;00600  1238	! FUNCTIONAL DESCRIPTION:

;00700  1239	!

;00800  1240	!	Perform RMS rewind operation on the file specified by the

;00900  1241	!	UNIT parameter.

;01000  1242	!

;01100  1243	! FORMAL PARAMETERS:

;01200  1244	!

;01300  1245	!	UNIT.rlu.v		Logical unit number

;01400  1246	!

;01500  1247	! IMPLICIT INPUTS:

;01600  1248	!

;01700  1249	!	LUB$V_DIRECT		This unit has previously been specified

;01800  1250	!				for direct access by an OPEN statement or

;01900  1251	!				DEFINE FILE.

;02000  1252	!	LUB$V_OPENED		This unit has already been opened by

;02100  1253	!				an OPEN statement or default open.

;02200  1254	!

;02300  1255	! IMPLICIT OUTPUTS:

;02400  1256	!

;02500  1257	!	LUB$L_LOG_RECNO		set to 1.

;02600  1258	!

;02700  1259	! ROUTINE VALUE: NONE

;02800  1260	! COMPLETION CODES:

;02900  1261	!

;03000  1262	!	NONE

;03100  1263	!

;03200  1264	! SIDE EFFECTS:

;03300  1265	!

;03400  1266	!	SIGNAL_STOPs FOR$_REWERR if a non-EOF error is returned from

;03500  1267	!	the RMS rewind call.

;03600  1268	!

;03700  1269	!--

;03800  1270	

;03900  1271	    BEGIN

;04000  1272	

;04100  1273	    GLOBAL REGISTER

;04200  1274		CCB = 11: REF BLOCK[, BYTE];

;04300  1275	

;04400  1276	    LOCAL

;04500  1277		L_UNWIND_ACTION: VOLATILE;	! Unwind action code (FOR$K_UNWIND{POP or NOP})

;04600  1278	

;04700  1279	    ENABLE

;04800  1280		FOR$$ERR_OPECLO (L_UNWIND_ACTION);

;04900  1281						! pass info to error handler

;05000  1282	

;05100  1283	    !+

;05200  1284	    ! Set up error handler conditions in case CB_PUSH bombs

;05300  1285	    !-

;05400  1286	

;05500  1287	    L_UNWIND_ACTION = FOR$K_UNWINDNOP;



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:24:15	DBB3:[RTL.SRC]FREWIN.B32;8					Page 3-1

;

;05600  1288	

;05700  1289	    !+

;05800  1290	    ! Get a LUB for this logical unit.

;05900  1291	    ! On return, CCB points to the current control block.

;06000  1292	    !-

;06100  1293	

;06200  1294	    FOR$$CB_PUSH (.UNIT, OPEN$K_LUN_MIN);

;06300  1295	

;06400  1296	    !+

;06500  1297	    ! Unwind action (if an error occurs) is now to pop a LUB.

;06600  1298	    !-

;06700  1299	

;06800  1300	    L_UNWIND_ACTION = FOR$K_UNWINDPOP;

;06900  1301	

;07000  1302	    !+

;07100  1303	    ! Check the LUB: file not open or random access specified

;07200  1304	    ! mean this REWIND is a no-op.

;07300  1305	    !-

;07400  1306	

;07500  1307	    IF .CCB[LUB$V_OPENED] AND .CCB[LUB$V_DIRECT] EQL 0

;07600  1308	    THEN

;07700  1309		BEGIN

;07800  1310	

;07900  1311		!+

;08000  1312		! Call RMS to REWIND the file, all failure codes returned

;08100  1313		! cause a SIGNAL_STOP to occur.

;08200  1314		!-

;08300  1315	

;08400  1316		IF NOT $REWIND (RAB = .CCB)

;08500  1317		THEN

;08600  1318		    FOR$$SIGNAL_STO (FOR$K_REWERR);

;08700  1319	

;08800  1320		!+

;08900  1321		! Clear APPEND flag - OK for backspace now

;09000  1322		!-

;09100  1323	

;09200  1324		CCB[LUB$V_APPEND] = 0;

;09300  1325	

;09400  1326		!+

;09500  1327		! Set the logical record number to 1.

;09600  1328		!-

;09700  1329	

;09800  1330		CCB[LUB$L_LOG_RECNO] = 1;

;09900  1331	

;10000  1332		END;

;10100  1333	

;10200  1334	    !+

;10300  1335	    ! Return the file system to its former state.

;10400  1336	    !-

;10500  1337	

;10600  1338	    FOR$$CB_POP ();

;10700  1339	    RETURN;

;10800  1340	    END;







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:24:15	DBB3:[RTL.SRC]FREWIN.B32;8					Page 3-2

;

							    .TITLE  FOR$REWIND

							    .IDENT  \0-14\



							    .EXTRN  FOR$$ERR_OPECLO, FOR$$SIGNAL_STO, FOR$$CB_PUSH

							    .EXTRN  FOR$$CB_POP, SYS$REWIND



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



					 0804 00000 	    .ENTRY  FOR$REWIND, Save R2,R11				      ; 1233

				       7E  D4 00002 	    CLRL    L_UNWIND_ACTION					      ; 1271

		         6D 00000037   EF  DE 00004 	    MOVAL   3$, (FP)						      ;

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

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

				       50  D4 00012 	    CLRL    R0							      ;

				     0000G 30 00014 	    BSBW    FOR$$CB_PUSH					      ;

				       6E  D4 00017 	    CLRL    L_UNWIND_ACTION					      ; 1300

		         20 	  FC   AB  E9 00019 	    BLBC    -4(CCB), 2$						      ; 1307

	   1B 	    FC   AB	       04  E0 0001D 	    BBS     #4, -4(CCB), 2$					      ;

				       5B  DD 00022 	    PUSHL   CCB							      ; 1316

	      00000000G  9F	       01  FB 00024 	    CALLS   #1, @#SYS$REWIND					      ;

		         07 	       50  E8 0002B 	    BLBS    R0, 1$						      ;

				       14  DD 0002E 	    PUSHL   #20							      ; 1318

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

		    FD   AB	       20  8A 00035 1$:     BICB2   #32, -3(CCB)					      ; 1324

		    E0   AB	       01  D0 00039 	    MOVL    #1, -32(CCB)					      ; 1330

				     0000G 30 0003D 2$:     BSBW    FOR$$CB_POP						      ; 1338

					   04 00040 	    RET     							      ; 1233

					 0000 00041 3$:     .WORD   Save nothing					      ; 1271

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

		         50 	  04   A0  D0 00047 	    MOVL    4(R0), R0						      ;

				  FC   A0  9F 0004B 	    PUSHAB  L_UNWIND_ACTION					      ;

				       01  DD 0004E 	    PUSHL   #1							      ;

				       5E  DD 00050 	    PUSHL   SP							      ;

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

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

					   04 0005B 	    RET     							      ;



; Routine Size:  92 bytes





;10900  1341	

;11000  1342	END				!End of module

;11100  1343	ELUDOM













;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

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





; Bliss-32 10.1-416	Monday 21-AUG-1978 19:24:15	DBB3:[RTL.SRC]FREWIN.B32;8					Page 3-3

;







;				LIBRARY STATISTICS

;

;					     -------- Symbols --------    Blocks

;	File				     Total    Loaded   Percent      Read

;

;  DBA4:[SYSLIB]STARLET.L32;1		      2688         2         0       109











; Size:		92 code + 0 data bytes

; Run Time:	00:08.3

; Elapsed Time:	00:17.8

; Memory Used:	171 pages

; Compilation Complete

