

; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 1

;

;00100  0001	MODULE FOR$$REC_PROC (	! Record processing level of abstraction

;00200  0002		IDENT = '0-74'	! file: FRECPR.B32

;00300  0003			) =

;00400  0004	BEGIN

;00500  0005	

;00600  0006	!

;00700  0007	! COPYRIGHT (C) 1977

;00800  0008	! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754

;00900  0009	!

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

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

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

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

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

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

;01600  0016	! REMAIN IN DEC.

;01700  0017	!

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

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

;02000  0020	! CORPORATION.

;02100  0021	!

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

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

;02400  0024	

;02500  0025	!++

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

;02700  0027	!

;02800  0028	! ABSTRACT:

;02900  0029	!

;03000  0030	!	This module implements the record processing level of

;03100  0031	!	abstraction which is the 3rd level and is called only from

;03200  0032	!	the user data formatter level (2nd level) when the user

;03300  0033	!	portion of a record buffer is full (WRITE) or empty

;03400  0034	!	(READ). This module adds any per record formatting (as

;03500  0035	!	distinguished from per I/O statement or per I/O list element

;03600  0036	!	formatting) and then calls RMS ($PUT or $GET). RMS errors

;03700  0037	!	are converted to FORTRAN errors and are signaled.

;03800  0038	!

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

;04000  0040	!

;04100  0041	! AUTHOR:	Thomas N. Hastings;	CREATION DATE: 16-Mar-77

;04200  0042	!

;04300  0043	! MODIFIED BY:

;04400  0044	!

;04500  0045	! 	Thomas N. Hastings, 12-Mar-77 : VERSION 0

;04600  0046	!	Jonathan M. Taylor, 7-JUL-77 : VERSION 0

;04700  0047	! 0-1	- original TNH

;04800  0048	! 0-31	- Added 6 routines for formatted random access I/O JMT

;04900  0049	! 0-34	- Added 3 routines for list-directed output JMT

;05000  0050	! 0-37	- Made all PUTs print debug info.

;05100  0051	! 0-38	- Added unformatted direct read and wrtie TNH

;05200  0052	! 0-39	- Signal EOF correctly TNH

;05300  0053	! 0-40	- Signal_stop errors instead of signal JMT

;05400  0054	! 0-41	- Add unformatted sequential read and write TNH

;05500  0055	!	  and space padding FLR formatted records



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 1-1

;

;05600  0056	! 0-45	- Added 3 routines for list-directed input JMT

;05700  0057	! 0-48	- Discovered some duplicate functionality: WSL1 now

;05800  0058	!	- calls WSF1.

;05900  0059	! 0-49	- Added use of LUB$W_RBUF_SIZE record buffer size 17-SEP-77 TNH

;06000  0060	! 0-50	- Added 6 routines for ENCODE/DECODE 19-SEP-77 JMT

;06100  0061	! 0-51	- bug fixes for EN/DECODE more common routine mapping 20-SEP-77 JMT

;06200  0062	! 0-52	- more space saving and routine mapping 21-SEP-77 JMT

;06300  0063	! 0-53	- Direct access record number is now checked in IO_BEG

;06400  0064	!	  Removed all parameters from record level routines, set

;06500  0065	!	  ISB$A_BUF_PTR and ISB$BUF_END directly. JMT 16-OCT-77

;06600  0066	! 0-54	- edits in preperation for locate mode GETs JMT 17-OCT-77

;06700  0067	! 0-55	- change MORONEREC error to INPIO_LIS or OUTIO_LIS JMT 22-Oct-77

;06800  0068	! 0-56	- check for ^Z record in RSF0.  Check RMS RTB (record too big)

;06900  0069	!	  error from $GETs.  JMT 24-Oct-77

;07000  0070	! 0-57	- Use FOR$K_abcmno57yz as E57TERNAL LITERALs.  TNH 27-Oct-77

;07100  0071	! 0-58	- Change INPRECEXC to INPRECTOO; OUTIO_LIS to OUTSTAOVE;

;07200  0072	!	INPRECEXC to INPRECTOO.  TNH 29-Oct-77

;07300  0073	! 0-59	- Change V_NOSPANREC to V_SPANNED in LUB.  JMT 14-Dec-77

;07400  0074	! 0-60	- Use LIBRARY.  TNH 16-Dec-77

;07500  0075	! 0-61	- Add ATTEMPT TO READ NON-EXISTANT RECORD error to seq. reads.  JMT 2-Jan-78

;07600  0076	! 0-64	- Global register CCB.  JMT 8-Apr-78

;07700  0077	! 0-65	- Change to STARLET library.  DGP 20-Apr-78

;07800  0078	! 0-66	- Remove RMS External Literals.  DGP 24-Apr-78

;07900  0079	! 0-67	- Change REQUIRE files for VAX system build.  DGP 28-Apr-78

;08000  0080	! 0-68	- Change STARLET to RTLSTARLE to avoid conflicts.  DGP 1-May-78

;08100  0081	! 0-69	- Use JSB linkages.  TNH 21-May-78

;08200  0082	! 0-70	- Loop on record stream active.  TNH 7-June-78

;08210  0083	! 0-74	- Make FOR$$REC_WSF9 JSB.  TNH 8-AUG-78

;08300  0084	!--



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 2

;

;00100  0085	!

;00200  0086	! LINKAGES:

;00300  0087	!

;00400  0088	REQUIRE 'RTLIN:FLNK';		! define all linkages

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

;00500  0310	

;00600  0311	!

;00700  0312	! TABLE OF CONTENTS:

;00800  0313	!

;00900  0314	

;01000  0315					! write sequential formatted:

;01100  0316	FORWARD ROUTINE

;01200  0317		FOR$$REC_WSF0: JSB_REC0 NOVALUE,	! initialize output buffer

;01300  0318		FOR$$REC_WSF1: JSB_REC1 NOVALUE;	! write all but last record

;01400  0319	GLOBAL BIND

;01500  0320		FOR$$REC_WSF9  = FOR$$REC_WSF1;	! Write next = write last

;01600  0321					! read sequential formatted:

;01700  0322	FORWARD ROUTINE

;01800  0323		FOR$$REC_RSF0: JSB_REC0 NOVALUE;	! read first record

;01900  0324	GLOBAL BIND

;02000  0325		FOR$$REC_RSF1 = FOR$$REC_RSF0;	! Read first = read next

;02100  0326	FORWARD ROUTINE

;02200  0327		FOR$$REC_RSF9: JSB_REC9 NOVALUE,	! no-op

;02300  0328					! read sequential unformatted record

;02400  0329		FOR$$REC_RSU0: JSB_REC0 NOVALUE,	! read first record

;02500  0330		FOR$$REC_RSU1: JSB_REC1 NOVALUE,	! read all subsequent records

;02600  0331		FOR$$REC_RSU9: JSB_REC9 NOVALUE,	! terminate read

;02700  0332					! write sequential unformatted record:

;02800  0333		FOR$$REC_WSU0: JSB_REC0 NOVALUE,	! initialize output buffer

;02900  0334		FOR$$REC_WSU1: JSB_REC1 NOVALUE,	! write all but last record

;03000  0335		FOR$$REC_WSU9: JSB_REC9 NOVALUE,	! write last record

;03100  0336					! write direct (formatted and unformatted):

;03200  0337		FOR$$REC_WD0: JSB_REC0 NOVALUE,	! initialize output buffer

;03300  0338		FOR$$REC_WD1: JSB_REC1 NOVALUE,	! illegal: FOR$_OUTSTAOVE

;03400  0339		FOR$$REC_WD9: JSB_REC9 NOVALUE,	! write last record

;03500  0340					! read direct (formatted and unformatted):

;03600  0341		FOR$$REC_RD0: JSB_REC0 NOVALUE,	! read first record

;03700  0342		FOR$$REC_RD1: JSB_REC1 NOVALUE;	! illegal: FOR$_INPSTAREQ

;03800  0343	GLOBAL BIND

;03900  0344		FOR$$REC_RD9 = FOR$$REC_RSF9;	! no-op

;04000  0345					! write sequential list-directed

;04100  0346	FORWARD ROUTINE

;04200  0347		FOR$$REC_WSL0: JSB_REC0 NOVALUE,	! initialize output buffer

;04300  0348		FOR$$REC_WSL1: JSB_REC1 NOVALUE;	! write all but last record

;04400  0349	GLOBAL BIND

;04500  0350		FOR$$REC_WSL9 = FOR$$REC_WSF1,	! write last = write last formatted sequential

;04600  0351					! read sequential list-directed

;04700  0352		FOR$$REC_RSL0 = FOR$$REC_RSF0,	! read first = read first sequential formatted

;04800  0353		FOR$$REC_RSL1 = FOR$$REC_RSF1,	! read next = read next sequential formatted

;04900  0354		FOR$$REC_RSL9 = FOR$$REC_RSF9,	! no-op

;05000  0355					! read memory formatted (DECODE)

;05100  0356		FOR$$REC_RMF0 = FOR$$REC_RSF9;	! no-op

;05200  0357	FORWARD ROUTINE

;05300  0358		FOR$$REC_RMF1: JSB_REC1 NOVALUE;	! illegal: FOR$_MORONEREC

;05400  0359	GLOBAL BIND



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 2-1

;

;05500  0360		FOR$$REC_RMF9 = FOR$$REC_RSF9,	! no-op

;05600  0361					! write memory formatted (ENCODE)

;05700  0362		FOR$$REC_WMF0 = FOR$$REC_RSF9,	! no-op

;05800  0363		FOR$$REC_WMF1 = FOR$$REC_RMF1;	! illegal: FOR$_MORONEREC

;05900  0364	FORWARD ROUTINE

;06000  0365		FOR$$REC_WMF9: JSB_REC9 NOVALUE,	! terminate write (blank pad)

;06100  0366		FILL_BUF: CALL_CCB NOVALUE,		! fill remainder of buffer with arg

;06110  0367		PUT_ERROR: CALL_CCB NOVALUE,		! error in $PUT

;06120  0368		GET_ERROR: CALL_CCB NOVALUE;		! error in $GET

;06200  0369	

;06300  0370	!

;06400  0371	! INCLUDE FILES:

;06500  0372	!

;06600  0373	

;06700  0374		REQUIRE 'RTLML:FERR';		! FORTRAN error number definitions

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

;06800  0492		REQUIRE 'RTLML:FISB';		! I/O statement block (ISB) offsets

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

;06900  0701		REQUIRE 'RTLML:FLUB';		! Logical unit block (LUB) offsets

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

;07000  0869		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

;07100  1049		REQUIRE 'RTLML:FPAR';		! FORTRAN inter-module parameters

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

;07200  1151		REQUIRE 'RTLIN:ODBG';		! OTS debugging macros

; %PRINT:	Filename: NODBG.B32; Version 0, edit 20, JMT, 17-Jan-78

;07300  1227		LIBRARY 'RTLSTARLE';	! STARLET library for macros and symbols

;07400  1228	!

;07500  1229	! MACROS:

;07600  1230	!

;07700  1231	!	NONE

;07800  1232	

;07900  1233	!

;08000  1234	! EQUATED SYMBOLS:

;08100  1235	!	NONE

;08200  1236	

;08300  1237	!

;08400  1238	! PSECT DECLARATIONS:

;08500  1239	!

;08600  1240	

;08700  1241		DECLARE_PSECTS (FOR);	! declare PSECTs for FOR$ facility

;08800  1242	

;08900  1243	!

;09000  1244	! OWN STORAGE:

;09100  1245	!	NONE

;09200  1246	

;09300  1247	!

;09400  1248	! EXTERNAL REFERENCES:

;09500  1249	!

;09600  1250	EXTERNAL ROUTINE

;09700  1251		FOR$$SIGNAL_STO: NOVALUE,	! Convert FORTRAN err # to VAX

;09800  1252						! err # and call LIB$STOP.

;09900  1253		FOR$$ASSOC: CALL_CCB NOVALUE;		! store rec# in ass. var.

;10000  1254	



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 2-2

;

;10100  1255	! EXTERNAL LITERAL

;10200  1256	!

;10300  1257	!	NONE



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 3

;

;00100  1258	GLOBAL ROUTINE FOR$$REC_WSF0	! Write sequential formatted

;00200  1259		: JSB_REC0 NOVALUE =

;00300  1260	

;00400  1261	!++

;00500  1262	! FUNCTIONAL DESCRIPTION:

;00600  1263	!

;00700  1264	!	Initialize call for write sequential formatted.  FOR$$REC_WSF0

;00800  1265	!	initializes the output buffer and returns start and end+1 of user

;00900  1266	! 	part of record buffer to be filled by caller.

;01000  1267	!

;01100  1268	! CALLING SEQUENCE:

;01200  1269	!

;01300  1270	!	JSB FOR$$REC_WSF0 ()

;01400  1271	!

;01500  1272	! FORMAL PARAMETERS:

;01600  1273	!	NONE

;01700  1274	!

;01800  1275	! IMPLICIT INPUTS:

;01900  1276	!

;02000  1277	!	CCB			Pointer to current logical unit

;02100  1278	!	LUB$W_RBUF_SIZE		Size (bytes) allocated for record buffer at OPEN.

;02200  1279	!	LUB$A_RBUF_ADR		Address of record buffer from OPEN

;02300  1280	!

;02400  1281	! IMPLICIT OUTPUTS:

;02500  1282	!

;02600  1283	!	ISB$A_BUF_PTR		points to first char in user part of record

;02700  1284	!				buffer

;02800  1285	!	ISB$A_BUF_END		points to last char+1 in user part

;02900  1286	!				of record buffer

;03000  1287	!

;03100  1288	! ROUTINE VALUE:

;03200  1289	!

;03300  1290	!	NONE

;03400  1291	!

;03500  1292	! SIDE EFFECTS:

;03600  1293	!

;03700  1294	!	NONE

;03800  1295	!--

;03900  1296	

;04000  1297	        BEGIN

;04100  1298	

;04200  1299		EXTERNAL REGISTER

;04300  1300		    CCB: REF BLOCK[, BYTE];

;04400  1301	

;04500  1302		!+

;04600  1303		! Return start address and end+1 address of output buffer.

;04700  1304		!-

;04800  1305	

;04900  1306		CCB[ISB$A_BUF_PTR] = .CCB[LUB$A_RBUF_ADR];

;05000  1307		CCB[ISB$A_BUF_END] = .CCB[LUB$A_RBUF_ADR] + .CCB[LUB$W_RBUF_SIZE];

;05100  1308	

;05200  1309		RETURN;

;05300  1310		END;	! END OF ROUTINE







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 3-1

;

							    .TITLE  FOR$$REC_PROC

							    .IDENT  \0-74\



							    .EXTRN  FOR$$SIGNAL_STO, FOR$$ASSOC



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



		    B8   AB	  EC   AB  D0 00000 FOR$$REC_WSF0::

							    MOVL    -20(CCB), -72(CCB)					      ; 1306

		         50 	  DA   AB  3C 00005 	    MOVZWL  -38(CCB), R0					      ; 1307

		    BC   AB	  EC BB40  9E 00009 	    MOVAB   @-20(CCB)[R0], -68(CCB)				      ;

					   05 0000F 	    RSB     							      ; 1258



; Routine Size:  16 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 4

;

;00100  1311	GLOBAL ROUTINE FOR$$REC_WSF1	! Write sequential formatted

;00200  1312					! (also FOR$$REC_WSF9 and FOR$$REC_WSL9)

;00300  1313					! Called from FOR$$REC_WSU9

;00400  1314		: JSB_REC1 NOVALUE =

;00500  1315	

;00600  1316	!++

;00700  1317	! FUNCTIONAL DESCRIPTION:

;00800  1318	!

;00900  1319	!	Write one sequential formatted record and initialize for the next

;01000  1320	!	FOR$$REC_WSF1 (and FOR$$REC_WSF9) writes one output buffer and then

;01100  1321	!	initializes the output buffer and returns start and end+1 of user

;01200  1322	!	part of record buffer to be filled by caller.

;01300  1323	!	FLR records are space or null padded.

;01400  1324	!	Logical record number is incremented.

;01500  1325	!

;01600  1326	! CALLING SEQUENCE:

;01700  1327	!

;01800  1328	!	JSB FOR$$REC_WSF1 ()

;01900  1329	!

;02000  1330	! FORMAL PARAMETERS:

;02100  1331	!

;02200  1332	!	NONE

;02300  1333	!

;02400  1334	! IMPLICIT INPUTS:

;02500  1335	!

;02600  1336	!	CCB			Pointer to current logical unit

;02700  1337	!	LUB$W_RBUF_SIZE		Size (bytes) allocated for record buffer at OPEN.

;02800  1338	!	LUB$A_RBUF_ADR		Address of record buffer from OPEN

;02900  1339	!	ISB$A_BUF_END		points to last char inserted into buffer

;03000  1340	!				by UDF level I/O.

;03100  1341	!

;03200  1342	! IMPLICIT OUTPUTS:

;03300  1343	!

;03400  1344	!	LUB$L_LOG_RECNO		Incremented logical record number

;03500  1345	!	ISB$A_BUF_PTR		Address of first char in user part

;03600  1346	!				of record buffer

;03700  1347	!	ISB$A_BUF_END		Address of last+1 char in user part

;03800  1348	!				of record buffer

;03900  1349	!

;04000  1350	! ROUTINE VALUE:

;04100  1351	!

;04200  1352	!	NONE

;04300  1353	!

;04400  1354	! SIDE EFFECTS:

;04500  1355	!

;04600  1356	!	NONE

;04700  1357	!--

;04800  1358	

;04900  1359	        BEGIN

;05000  1360	

;05100  1361		EXTERNAL REGISTER

;05200  1362		    CCB: REF BLOCK[, BYTE];

;05300  1363	

;05400  1364		!+

;05500  1365		! If fixed length records (FLR), pad with trailing spaces or nulls



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

;

;05600  1366		! depending on whether formatted or unformatted.

;05700  1367		! Else (VLR) set recordsize to actual length of record

;05800  1368		!-

;05900  1369	

;06000  1370		IF .CCB[LUB$V_FIXED]

;06100  1371		THEN

;06200  1372		    BEGIN

;06300  1373		    IF .CCB[ISB$A_BUF_PTR] LSSA .CCB[ISB$A_BUF_END]

;06400  1374		    THEN

;06500  1375			FILL_BUF (IF .CCB[LUB$V_UNFORMAT] THEN 0 ELSE %C' ') 

;06600  1376		    END

;06700  1377		ELSE

;06800  1378		    CCB[RAB$W_RSZ] = .CCB[ISB$A_BUF_PTR] - .CCB[LUB$A_RBUF_ADR];

;06900  1379	

;07000  1380		!+

;07100  1381		! Output buffer to RMS and check for errors

;07200  1382		! If errors, SIGNAL_STO FOR$_ERRDURWRI (38='ERROR DURING WRITE')

;07300  1383		!-

;07400  1384	

;07500  1385		CCB[RAB$L_RBF] = .CCB[LUB$A_RBUF_ADR];

;07600  1386		IF NOT $PUT (RAB=.CCB)

;07700  1387		THEN

;07800  1388		    PUT_ERROR ();

;07900  1389	

;08000  1390		!+

;08100  1391		! increment logical record number (for backspace) after

;08200  1392		! successfully writing current record number.

;08300  1393		!-

;08400  1394	

;08500  1395		CCB[LUB$L_LOG_RECNO] = .CCB[LUB$L_LOG_RECNO] + 1;

;08600  1396	

;08700  1397		!+

;08800  1398		! Return next output buffer start and end addresses

;08900  1399		! If fixed length, use just record size, else buffer size.

;09000  1400		!-

;09100  1401	

;09200  1402		CCB[ISB$A_BUF_PTR] = .CCB[LUB$A_RBUF_ADR];

;09300  1403		CCB[ISB$A_BUF_END] = .CCB[LUB$A_RBUF_ADR] + .CCB[LUB$W_RBUF_SIZE];

;09400  1404	

;09500  1405		RETURN;

;09600  1406		END;	! END OF ROUTINE







							    .EXTRN  SYS$PUT



	   19 	    FD   AB	       02  E1 00010 FOR$$REC_WSF1::

							    BBC     #2, -3(CCB), 3$					      ; 1370

		    BC   AB	  B8   AB  D1 00015 	    CMPL    -72(CCB), -68(CCB)					      ; 1373

				       19  1E 0001A 	    BGEQU   4$							      ;

	   04 	    FD   AB	       01  E1 0001C 	    BBC     #1, -3(CCB), 1$					      ; 1375

				       7E  D4 00021 	    CLRL    -(SP)						      ;

				       02  11 00023 	    BRB     2$							      ;

				       20  DD 00025 1$:     PUSHL   #32							      ;

		  0000V  CF	       01  FB 00027 2$:     CALLS   #1, FILL_BUF					      ;



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

;

				       07  11 0002C 	    BRB     4$							      ; 1370

      22   AB	    B8   AB	  EC   AB  A3 0002E 3$:     SUBW3   -20(CCB), -72(CCB), 34(CCB)				      ; 1378

		    28   AB	  EC   AB  D0 00035 4$:     MOVL    -20(CCB), 40(CCB)					      ; 1385

				       5B  DD 0003A 	    PUSHL   CCB							      ; 1386

	      00000000G  9F	       01  FB 0003C 	    CALLS   #1, @#SYS$PUT					      ;

		         05 	       50  E8 00043 	    BLBS    R0, 5$						      ;

		  0000V  CF	       00  FB 00046 	    CALLS   #0, PUT_ERROR					      ; 1388

				  E0   AB  D6 0004B 5$:     INCL    -32(CCB)						      ; 1395

		    B8   AB	  EC   AB  D0 0004E 	    MOVL    -20(CCB), -72(CCB)					      ; 1402

		         50 	  DA   AB  3C 00053 	    MOVZWL  -38(CCB), R0					      ; 1403

		    BC   AB	  EC BB40  9E 00057 	    MOVAB   @-20(CCB)[R0], -68(CCB)				      ;

					   05 0005D 	    RSB     							      ; 1311



; Routine Size:  78 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 5

;

;00100  1407	GLOBAL ROUTINE FOR$$REC_RSF0	! Read sequential formatted

;00200  1408					! (also FOR$$REC_RSF1, FOR$$REC_RSL0 and FOR$$REC_RSL1)

;00300  1409		: JSB_REC0 NOVALUE =

;00400  1410	

;00500  1411	!++

;00600  1412	! FUNCTIONAL DESCRIPTION:

;00700  1413	!

;00800  1414	!	FOR$$REC_RSF0 (and FOR$$REC_RSF1) reads one formatted sequential record.

;00900  1415	!	Increments logical record number after successful read.

;01000  1416	!	Then return start and end+1 of user

;01100  1417	! 	part of record to be processed as input.

;01200  1418	!

;01300  1419	! CALLING SEQUENCE:

;01400  1420	!

;01500  1421	!	JSB FOR$$REC_RSF0 ()

;01600  1422	!

;01700  1423	! FORMAL PARAMETERS:

;01800  1424	!

;01900  1425	!	NONE

;02000  1426	!

;02100  1427	! IMPLICIT INPUTS:

;02200  1428	!

;02300  1429	!	CCB			Pointer to current logical unit

;02400  1430	!	LUB$W_RBUF_SIZE		Size of record buffer allocated in OPEN.

;02500  1431	!	LUB$A_RBUF_ADR		Address of record buffer from OPEN.

;02600  1432	!

;02700  1433	! IMPLICIT OUTPUTS:

;02800  1434	!

;02900  1435	!	LUB$L_LOG_RECNO		Increment logical record number

;03000  1436	!				of next record to be read.

;03100  1437	!	ISB$A_BUF_PTR		points to first char of user part of

;03200  1438	!				record buffer.

;03300  1439	!	ISB$A_BUF_END		points to end+1 of user part of

;03400  1440	!				record buffer.

;03500  1441	!

;03600  1442	! ROUTINE VALUE:

;03700  1443	!

;03800  1444	!	NONE

;03900  1445	!

;04000  1446	! SIDE EFFECTS:

;04100  1447	!

;04200  1448	!	Reads next record from file on this logical unit.

;04300  1449	!	SIGNAL_STOPs FOR$_ERRDURREA (39='ERROR DURING READ')

;04400  1450	!	SIGNAL_STOPs FOR$_ENDDURREA (24='END-OF-FILE DURING READ')

;04500  1451	!	SIGNAL_STOPs FOR$_INPRECTOO if record too big

;04600  1452	!--

;04700  1453	

;04800  1454	

;04900  1455	        BEGIN

;05000  1456	

;05100  1457		EXTERNAL REGISTER

;05200  1458		    CCB: REF BLOCK[, BYTE];

;05300  1459	

;05400  1460		!+

;05500  1461		! Read record into buffer using RMS and check for erros



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 5-1

;

;05600  1462		! If end-of-file, SIGNAL_STOP FOR$_ENDDURREA (24='END-OF-FILE DURING READ')

;05700  1463		! If record too big for record buffer, SIGNAL_STOP FOR$_INPRECTOO.

;05800  1464		! If errors, SIGNAL_STO FOR$_ERRDURREA (39='ERROR DURING READ')

;05900  1465		!-

;06000  1466	

;06100  1467		IF NOT $GET (RAB=.CCB)

;06200  1468		THEN

;06300  1469		    GET_ERROR ();

;06400  1470	

;06500  1471		!+

;06600  1472		! Check for End-of-file record in file.

;06700  1473		! Length = 1 byte and byte is a control Z.

;06800  1474		! SIGNAL_STOP FOR$_ENDDURREA if so.

;06900  1475		!-

;07000  1476	

;07100  1477		IF .CCB[RAB$W_RSZ] EQLU 1 AND .(.CCB[RAB$L_RBF])<0,8> EQLU FOR$K_CONTROL_Z

;07200  1478		THEN

;07300  1479		    FOR$$SIGNAL_STO (FOR$K_ENDDURREA);

;07400  1480	

;07500  1481		!+

;07600  1482		! Increment logical record number (for backspace)

;07700  1483		! so it is the number of the next record to be read.

;07800  1484		! Do this only after the record has been successfully read.

;07900  1485		!-

;08000  1486	

;08100  1487		CCB[LUB$L_LOG_RECNO] = .CCB[LUB$L_LOG_RECNO] + 1;

;08200  1488	

;08300  1489		!+

;08400  1490		! Return start and end+1 address of record just read

;08500  1491		!-

;08600  1492	

;08700  1493		CCB[ISB$A_BUF_PTR] = .CCB[RAB$L_RBF];

;08800  1494		CCB[ISB$A_BUF_END] = .CCB[RAB$L_RBF] + .CCB[RAB$W_RSZ];

;08900  1495	

;09000  1496		RETURN;

;09100  1497		END;	! End of FOR$$REC_RSF0 and FOR$$REC_RSF1







							    .EXTRN  SYS$GET



				       5B  DD 0005E FOR$$REC_RSF0::

							    PUSHL   CCB							      ; 1467

	      00000000G  9F	       01  FB 00060 	    CALLS   #1, @#SYS$GET					      ;

		         05 	       50  E8 00067 	    BLBS    R0, 1$						      ;

		  0000V  CF	       00  FB 0006A 	    CALLS   #0, GET_ERROR					      ; 1469

		         01 	  22   AB  B1 0006F 1$:     CMPW    34(CCB), #1						      ; 1477

				       0D  12 00073 	    BNEQ    2$							      ;

		         1A 	  28   BB  91 00075 	    CMPB    @40(CCB), #26					      ;

				       07  12 00079 	    BNEQ    2$							      ;

				       18  DD 0007B 	    PUSHL   #24							      ; 1479

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

				  E0   AB  D6 00082 2$:     INCL    -32(CCB)						      ; 1487

		    B8   AB	  28   AB  D0 00085 	    MOVL    40(CCB), -72(CCB)					      ; 1493

		         50 	  22   AB  3C 0008A 	    MOVZWL  34(CCB), R0						      ; 1494



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 5-2

;

		    BC   AB	  28 BB40  9E 0008E 	    MOVAB   @40(CCB)[R0], -68(CCB)				      ;

					   05 00094 	    RSB     							      ; 1407



; Routine Size:  55 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 6

;

;00100  1498	GLOBAL ROUTINE FOR$$REC_RSF9	! Read sequential formatted

;00200  1499					! (also RSL9, RMF0, RMF9, WMF0, RD9)

;00300  1500		: JSB_REC9 NOVALUE =

;00400  1501	

;00500  1502	!++

;00600  1503	! FUNCTIONAL DESCRIPTION:

;00700  1504	!

;00800  1505	!	FOR$$REC_RSF9 is a no-op!

;00900  1506	!

;01000  1507	! CALLING SEQUENCE:

;01100  1508	!

;01200  1509	!	JSB FOR$$REC_RSF9 ()

;01300  1510	!

;01400  1511	! FORMAL PARAMETERS:

;01500  1512	!

;01600  1513	!	NONE

;01700  1514	!

;01800  1515	! IMPLICIT INPUTS:

;01900  1516	!

;02000  1517	!	NONE

;02100  1518	!

;02200  1519	! IMPLICIT OUTPUTS:

;02300  1520	!

;02400  1521	! ROUTINE VALUE:

;02500  1522	!

;02600  1523	!	NONE

;02700  1524	!

;02800  1525	! SIDE EFFECTS:

;02900  1526	!

;03000  1527	!--

;03100  1528	

;03200  1529		RETURN;











					   05 00095 	    RSB     							      ; 1498



; Routine Size:  1 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 7

;

;00100  1530	GLOBAL ROUTINE FOR$$REC_WSU0	! Write sequential unformatted

;00200  1531		: JSB_REC0 NOVALUE =

;00300  1532	

;00400  1533	!++

;00500  1534	! FUNCTIONAL DESCRIPTION:

;00600  1535	!

;00700  1536	!	Initialize call for write sequential unformatted.  FOR$$REC_WSU0

;00800  1537	!	initializes the output buffer and returns start and end+1 of user

;00900  1538	! 	part of record buffer to be filled by caller.

;01000  1539	!	Handles segmented and unsegmented records.

;01100  1540	!

;01200  1541	! CALLING SEQUENCE:

;01300  1542	!

;01400  1543	!	JSB FOR$$REC_WSU0 ()

;01500  1544	!

;01600  1545	! FORMAL PARAMETERS:

;01700  1546	!

;01800  1547	!	NONE

;01900  1548	!

;02000  1549	! IMPLICIT INPUTS:

;02100  1550	!

;02200  1551	!	CCB			Pointer to current logical unit

;02300  1552	!	LUB$W_RBUF_SIZE		Size (bytes) allocated for record buffer at OPEN.

;02400  1553	!	LUB$A_RBUF_ADR		Address of record buffer from OPEN

;02500  1554	!

;02600  1555	! IMPLICIT OUTPUTS:

;02700  1556	!

;02800  1557	!	ISB$A_BUF_PTR		Points to start of user part of record buffer

;02900  1558	!	ISB$A_BUF_END		Points to end+1 of user part of record buffer

;03000  1559	!

;03100  1560	! ROUTINE VALUE:

;03200  1561	!

;03300  1562	!	NONE

;03400  1563	!

;03500  1564	! SIDE EFFECTS:

;03600  1565	!

;03700  1566	!	NONE

;03800  1567	!--

;03900  1568	

;04000  1569	        BEGIN

;04100  1570	

;04200  1571		EXTERNAL REGISTER

;04300  1572		    CCB: REF BLOCK[, BYTE];

;04400  1573	

;04500  1574		!+

;04600  1575		! Setup first output buffer.  If segmented record control

;04700  1576		! then set first word to 1 as a flag that this is first record

;04800  1577		! in segmented logical record record.  Set first user address

;04900  1578		! to third byte in output buffer.

;05000  1579		! Else (unsegmented) set first user address to first byte in output buffer.

;05100  1580		!-

;05200  1581	

;05300  1582		CCB[ISB$A_BUF_PTR] = (IF .CCB[LUB$V_SEGMENTED]

;05400  1583			    THEN

;05500  1584				BEGIN



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 7-1

;

;05600  1585				(.CCB[LUB$A_RBUF_ADR])<0,16> = 1;

;05700  1586				.CCB[LUB$A_RBUF_ADR] + 2

;05800  1587				END

;05900  1588			    ELSE

;06000  1589				.CCB[LUB$A_RBUF_ADR]);

;06100  1590	

;06200  1591		CCB[ISB$A_BUF_END] = .CCB[LUB$A_RBUF_ADR] + .CCB[LUB$W_RBUF_SIZE];

;06300  1592	

;06400  1593		RETURN;

;06500  1594		END;	! End of FOR$$REC_WSU0 routine.











	   0D 	    FD   AB	       03  E1 00096 FOR$$REC_WSU0::

							    BBC     #3, -3(CCB), 1$					      ; 1582

		         51 	  EC   AB  D0 0009B 	    MOVL    -20(CCB), R1					      ; 1585

		         61 	       01  B0 0009F 	    MOVW    #1, (R1)						      ;

		         50 	  02   A1  9E 000A2 	    MOVAB   2(R1), R0						      ; 1586

				       07  11 000A6 	    BRB     2$							      ; 1582

		         51 	  EC   AB  D0 000A8 1$:     MOVL    -20(CCB), R1					      ; 1589

		         50 	       51  D0 000AC 	    MOVL    R1, R0						      ; 1582

		    B8   AB	       50  D0 000AF 2$:     MOVL    R0, -72(CCB)					      ;

		         50 	  DA   AB  3C 000B3 	    MOVZWL  -38(CCB), R0					      ; 1591

      BC   AB	         51 	       50  C1 000B7 	    ADDL3   R0, R1, -68(CCB)					      ;

					   05 000BC 	    RSB     							      ; 1530



; Routine Size:  39 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 8

;

;00100  1595	GLOBAL ROUTINE FOR$$REC_WSU1	! Write sequential unformatted 

;00200  1596		: JSB_REC1 NOVALUE =

;00300  1597	

;00400  1598	!++

;00500  1599	! FUNCTIONAL DESCRIPTION:

;00600  1600	!

;00700  1601	!	Write one sequential unformatted record and initialize for the next

;00800  1602	!	FOR$$REC_WSU1 writes one output buffer and then

;00900  1603	!	initializes the output buffer and returns start and end+1 of user

;01000  1604	!	part of record buffer to be filled by caller.

;01100  1605	!	FLR records are null padded.

;01200  1606	!	If unsegmented, signal error since only one record allowed per

;01300  1607	!	I/O statement. 

;01400  1608	!	Do not increment logical record number since this is only

;01500  1609	!	part of logical record (FOR$$REC_WFU9 will increment).

;01600  1610	!

;01700  1611	! CALLING SEQUENCE:

;01800  1612	!

;01900  1613	!	JSB FOR$$REC_WSU1 ()

;02000  1614	!

;02100  1615	! FORMAL PARAMETERS:

;02200  1616	!

;02300  1617	!	NONE

;02400  1618	!

;02500  1619	! IMPLICIT INPUTS:

;02600  1620	!

;02700  1621	!	CCB			Pointer to current logical unit

;02800  1622	!	LUB$W_RBUF_SIZE		Size (bytes) allocated for record buffer at OPEN.

;02900  1623	!	LUB$A_RBUF_ADR		Address of record buffer from OPEN

;03000  1624	!	ISB$A_BUF_PTR		Pointer to end+1 of data in uer buffer

;03100  1625	!

;03200  1626	! IMPLICIT OUTPUTS:

;03300  1627	!

;03400  1628	!	ISB$A_BUF_PTR		Points to first char in user part of

;03500  1629	!				record buffer.

;03600  1630	!	ISB$A_BUF_END		Points to last+1 char in user part of

;03700  1631	!				record buffer.

;03800  1632	!

;03900  1633	! ROUTINE VALUE:

;04000  1634	!

;04100  1635	!	NONE

;04200  1636	!

;04300  1637	! SIDE EFFECTS:

;04400  1638	!

;04500  1639	!	SIGNAL_STOPs FOR$_OUTSTAOVE if unsegmented record

;04600  1640	!--

;04700  1641	

;04800  1642	        BEGIN

;04900  1643	

;05000  1644		EXTERNAL REGISTER

;05100  1645		    CCB: REF BLOCK[, BYTE];

;05200  1646	

;05300  1647		!+

;05400  1648		! If unsegmented, SIGNAL_STOP FOR$_OUTSTAOVE (66 = 'OUTPUT STATEMENT OVERFLOWED RECORD')

;05500  1649		! since can't go on to next record without segment control.



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 8-1

;

;05600  1650		!-

;05700  1651	

;05800  1652		IF .CCB[LUB$V_SEGMENTED] EQL 0

;05900  1653		THEN

;06000  1654		    FOR$$SIGNAL_STO (FOR$K_OUTSTAOVE);

;06100  1655	

;06200  1656		!+

;06300  1657		! If fixed length records (FLR), pad with trailing nulls.

;06400  1658		! Else (VLR) set recordsize to actual length of record

;06500  1659		!-

;06600  1660	

;06700  1661		IF .CCB[LUB$V_FIXED]

;06800  1662		THEN

;06900  1663		    BEGIN

;07000  1664		    IF .CCB[ISB$A_BUF_PTR] LSSA .CCB[ISB$A_BUF_END] THEN FILL_BUF (0)

;07100  1665		    END

;07200  1666		ELSE

;07300  1667		    CCB[RAB$W_RSZ] = .CCB[ISB$A_BUF_PTR] - .CCB[LUB$A_RBUF_ADR];

;07400  1668	

;07500  1669		!+

;07600  1670		! Output buffer to RMS and check for errors

;07700  1671		! If errors, SIGNAL_STO FOR$_ERRDURWRI (38='ERROR DURING WRITE')

;07800  1672		!-

;07900  1673	

;08000  1674		CCB[RAB$L_RBF] = .CCB[LUB$A_RBUF_ADR];

;08100  1675		IF NOT $PUT (RAB=.CCB)

;08200  1676		THEN

;08300  1677		    PUT_ERROR ();

;08400  1678	

;08500  1679		!+

;08600  1680		! Setup a subsequent output buffer.  If segmented record control

;08700  1681		! then set first word to 0 as a flag that this is a subsquent record

;08800  1682		! in segmented logical record (FOR$$REC_WSU9 will set bit 1 to 1 on last record);  

;08900  1683		! then set first user address to third byte in output buffer.

;09000  1684		! Else (unsegmented) set first user address to first byte in output buffer.

;09100  1685		!-

;09200  1686	

;09300  1687		CCB[ISB$A_BUF_PTR] = (IF .CCB[LUB$V_SEGMENTED]

;09400  1688			    THEN

;09500  1689				BEGIN

;09600  1690				(.CCB[LUB$A_RBUF_ADR])<0,16> = 0;

;09700  1691				.CCB[LUB$A_RBUF_ADR] + 2

;09800  1692				END

;09900  1693			    ELSE

;10000  1694				.CCB[LUB$A_RBUF_ADR]);

;10100  1695		CCB[ISB$A_BUF_END] = .CCB[LUB$A_RBUF_ADR] + .CCB[LUB$W_RBUF_SIZE];

;10200  1696	

;10300  1697		RETURN;

;10400  1698		END;	! End of FOR$$REC_WSU1











	   09 	    FD   AB	       03  E0 000BD FOR$$REC_WSU1::



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 8-2

;

							    BBS     #3, -3(CCB), 1$					      ; 1652

		         7E 	  42   8F  9A 000C2 	    MOVZBL  #66, -(SP)						      ; 1654

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

	   10 	    FD   AB	       02  E1 000CB 1$:     BBC     #2, -3(CCB), 2$					      ; 1661

		    BC   AB	  B8   AB  D1 000D0 	    CMPL    -72(CCB), -68(CCB)					      ; 1664

				       10  1E 000D5 	    BGEQU   3$							      ;

				       7E  D4 000D7 	    CLRL    -(SP)						      ;

		  0000V  CF	       01  FB 000D9 	    CALLS   #1, FILL_BUF					      ;

				       07  11 000DE 	    BRB     3$							      ; 1661

      22   AB	    B8   AB	  EC   AB  A3 000E0 2$:     SUBW3   -20(CCB), -72(CCB), 34(CCB)				      ; 1667

		    28   AB	  EC   AB  D0 000E7 3$:     MOVL    -20(CCB), 40(CCB)					      ; 1674

				       5B  DD 000EC 	    PUSHL   CCB							      ; 1675

	      00000000G  9F	       01  FB 000EE 	    CALLS   #1, @#SYS$PUT					      ;

		         05 	       50  E8 000F5 	    BLBS    R0, 4$						      ;

		  0000V  CF	       00  FB 000F8 	    CALLS   #0, PUT_ERROR					      ; 1677

	   0C 	    FD   AB	       03  E1 000FD 4$:     BBC     #3, -3(CCB), 5$					      ; 1687

		         51 	  EC   AB  D0 00102 	    MOVL    -20(CCB), R1					      ; 1690

				       61  B4 00106 	    CLRW    (R1)						      ;

		         50 	  02   A1  9E 00108 	    MOVAB   2(R1), R0						      ; 1691

				       07  11 0010C 	    BRB     6$							      ; 1687

		         51 	  EC   AB  D0 0010E 5$:     MOVL    -20(CCB), R1					      ; 1694

		         50 	       51  D0 00112 	    MOVL    R1, R0						      ; 1687

		    B8   AB	       50  D0 00115 6$:     MOVL    R0, -72(CCB)					      ;

		         50 	  DA   AB  3C 00119 	    MOVZWL  -38(CCB), R0					      ; 1695

      BC   AB	         51 	       50  C1 0011D 	    ADDL3   R0, R1, -68(CCB)					      ;

					   05 00122 	    RSB     							      ; 1595



; Routine Size:  102 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 9

;

;00100  1699	GLOBAL ROUTINE FOR$$REC_WSU9	! Write sequential unformatted

;00200  1700		: JSB_REC9 NOVALUE =

;00300  1701	

;00400  1702	!++

;00500  1703	! FUNCTIONAL DESCRIPTION:

;00600  1704	!

;00700  1705	!	Write last sequential unformatted record.

;00800  1706	!	FOR$$REC_WSU9 writes the output buffer

;00900  1707	!	If segmented, the first control word is set to 1 as a flag

;01000  1708	!	that record is last record of logical segmented record.

;01100  1709	!	Otherwise an ordinary write sequential write last record is done.

;01200  1710	!	The logical record number is incremented once for entire segmented

;01300  1711	!	logical record.

;01400  1712	!

;01500  1713	! CALLING SEQUENCE:

;01600  1714	!

;01700  1715	!	JSB FOR$$REC_WSU9 ()

;01800  1716	!

;01900  1717	! FORMAL PARAMETERS:

;02000  1718	!

;02100  1719	!	NONE

;02200  1720	!

;02300  1721	! IMPLICIT INPUTS:

;02400  1722	!

;02500  1723	!	CCB			Pointer to current logical unit

;02600  1724	!

;02700  1725	! IMPLICIT OUTPUTS:

;02800  1726	!

;02900  1727	!	LUB$L_LOG_RECNO		Logical record number is incremented

;03000  1728	!				after write is done to be next record.

;03100  1729	!

;03200  1730	! ROUTINE VALUE:

;03300  1731	!

;03400  1732	!	NONE

;03500  1733	!

;03600  1734	! SIDE EFFECTS:

;03700  1735	!

;03800  1736	!	NONE

;03900  1737	!--

;04000  1738	

;04100  1739	        BEGIN

;04200  1740	

;04300  1741		EXTERNAL REGISTER

;04400  1742		    CCB: REF BLOCK[, BYTE];

;04500  1743	

;04600  1744		!+

;04700  1745		! If unsegmented, write this one record as a sequential record.

;04800  1746		! (Fill with trailing nulls if short FLR record).

;04900  1747		!-

;05000  1748	

;05100  1749		IF .CCB[LUB$V_SEGMENTED] EQL 0

;05200  1750		THEN

;05300  1751		    JSB_REC9 (FOR$$REC_WSF9)		! Force JSB linkage on BIND symbol

;05400  1752		ELSE

;05500  1753	



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 9-1

;

;05600  1754		    !+

;05700  1755		    ! Else (segmented control), set bit 1 of first word in buffer as

;05800  1756		    ! a mark that this is the last record of segmented record.

;05900  1757		    ! Note: bit 0 says whether this record is first or subsequent record.

;06000  1758		    !-

;06100  1759	

;06200  1760		    BEGIN

;06300  1761		    (.CCB[LUB$A_RBUF_ADR])<1,1> = 1;

;06400  1762	

;06500  1763		    !+

;06600  1764		    ! Write record, check for errors (do not increment logical record number)

;06700  1765		    !-

;06800  1766	

;06900  1767		    FOR$$REC_WSU1 ();

;07000  1768	

;07100  1769		    !+

;07200  1770		    ! Update logical record number (after error check)

;07300  1771		    ! once for entire logical segmented record.

;07400  1772		    !-

;07500  1773	

;07600  1774		    CCB[LUB$L_LOG_RECNO] = .CCB[LUB$L_LOG_RECNO] + 1;

;07700  1775		    END;

;07800  1776	

;07900  1777		RETURN;

;08000  1778		END;	! End of FOR$$REC_WSU9











	   04 	    FD   AB	       03  E0 00123 FOR$$REC_WSU9::

							    BBS     #3, -3(CCB), 1$					      ; 1749

				     FEE5  30 00128 	    BSBW    FOR$$REC_WSF9					      ; 1751

					   05 0012B 	    RSB     							      ; 1749

		    EC   BB	       02  88 0012C 1$:     BISB2   #2, @-20(CCB)					      ; 1761

				       8B  10 00130 	    BSBB    FOR$$REC_WSU1					      ; 1767

				  E0   AB  D6 00132 	    INCL    -32(CCB)						      ; 1774

					   05 00135 	    RSB     							      ; 1699



; Routine Size:  19 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 10

;

;00100  1779	GLOBAL ROUTINE FOR$$REC_RSU0	! Read sequential unformatted 

;00200  1780					! Called from FOR$$REC_RSU1 if segmented.

;00300  1781		: JSB_REC0 NOVALUE =

;00400  1782	

;00500  1783	!++

;00600  1784	! FUNCTIONAL DESCRIPTION:

;00700  1785	!

;00800  1786	!	FOR$$REC_RSU0 reads one unformatted sequential record.

;00900  1787	!	Then return start and end+1 of user

;01000  1788	!	part of record to be processed as input.

;01100  1789	!	Check for end of file.  If segmented, check for ENDFILE record.

;01200  1790	!

;01300  1791	! CALLING SEQUENCE:

;01400  1792	!

;01500  1793	!	JSB FOR$$REC_RSU0 ()

;01600  1794	!

;01700  1795	! FORMAL PARAMETERS:

;01800  1796	!

;01900  1797	!	NONE

;02000  1798	!

;02100  1799	! IMPLICIT INPUTS:

;02200  1800	!

;02300  1801	!	CCB			Pointer to current logical unit

;02400  1802	!	LUB$A_RBUF_ADR		Address of record buffer set up on OPEN

;02500  1803	!

;02600  1804	! IMPLICIT OUTPUTS:

;02700  1805	!

;02800  1806	!	ISB$V_LAST_REC		Set to 1 if last record of segmented record read.

;02900  1807	!				Do not increment logical record number

;03000  1808	!				since segmented is one record.

;03100  1809	!	ISB$A_BUF_PTR		Pointer to start of user data in buffer

;03200  1810	!				(This routine may bump the pointer over

;03300  1811	!				segmented record control info).

;03400  1812	!

;03500  1813	! ROUTINE VALUE:

;03600  1814	!

;03700  1815	!	NONE

;03800  1816	!

;03900  1817	! SIDE EFFECTS:

;04000  1818	!

;04100  1819	!	Reads next record from file on this logical unit.

;04200  1820	!	SIGNAL_STOPs FOR$_ERRDURREA (39='ERROR DRUING READ')

;04300  1821	!	SIGNAL_STOPs FOR$_ENDDURREA (24='END-OF-FILE DURING READ')

;04400  1822	!	SIGNAL_STOPs FOR$_INPRECTOO (22) if RMS record too big

;04500  1823	!--

;04600  1824	

;04700  1825	

;04800  1826	        BEGIN

;04900  1827	

;05000  1828		EXTERNAL REGISTER

;05100  1829		    CCB: REF BLOCK[, BYTE];

;05200  1830	

;05300  1831		!+

;05400  1832		! Read record into buffer using RMS and check for erros

;05500  1833		! If end-of-file, SIGNAL_STOP FOR$_ENDDURREA (24='END-OF-FILE DURING READ')



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 10-1

;

;05600  1834		! If record too big for record buffer, SIGNAL_STOP FOR$_INPRECTOO.

;05700  1835		! If errors, SIGNAL_STO FOR$_ERRDURREA (39='ERROR DURING READ')

;05800  1836		!-

;05900  1837	

;06000  1838		IF NOT $GET (RAB=.CCB)

;06100  1839		THEN

;06200  1840			GET_ERROR ();

;06300  1841	

;06400  1842		!+

;06500  1843		! Increment logical record number (for backspace)

;06600  1844		! so it is the number of the next record to be read.

;06700  1845		! Do this only after the record has been successfully read.

;06800  1846		!-

;06900  1847	

;07000  1848		CCB[LUB$L_LOG_RECNO] = .CCB[LUB$L_LOG_RECNO] + 1;

;07100  1849	

;07200  1850		!+

;07300  1851		! Return start and end+1 address of record just read

;07400  1852		!-

;07500  1853	

;07600  1854		CCB[ISB$A_BUF_PTR] = .CCB[RAB$L_RBF];

;07700  1855		CCB[ISB$A_BUF_END] = .CCB[RAB$L_RBF] + .CCB[RAB$W_RSZ];

;07800  1856	

;07900  1857		!+

;08000  1858		! If segmented record, check record format

;08100  1859		!-

;08200  1860	

;08300  1861		IF .CCB[LUB$V_SEGMENTED]

;08400  1862		THEN

;08500  1863	

;08600  1864		    !+

;08700  1865		    ! If (segmented) record is an ENDFILE record (one byte long and control Z)

;08800  1866		    ! SIGNAL_STOP (FOR$_ENDDURREA (24='END-FO-FILE DURING READ').

;08900  1867		    !-

;09000  1868	

;09100  1869		    BEGIN

;09200  1870		    IF .CCB[RAB$W_RSZ] EQL 1 AND .(.CCB[RAB$L_RBF])<0,8> EQLU FOR$K_CONTROL_Z

;09300  1871		    THEN

;09400  1872			FOR$$SIGNAL_STO (FOR$K_ENDDURREA);

;09500  1873	

;09600  1874		    !+

;09700  1875		    ! Check format of segmented record.

;09800  1876		    ! If bits 15:2 are not zero or record is less than 2 bytes long,

;09900  1877		    ! SIGNAL_STOPs FOR$_SEGRECFOR (35='SEGMENTED RECORD FORMAT ERROR')

;10000  1878		    !-

;10100  1879	

;10200  1880		    IF .(.CCB[RAB$L_RBF])<2,14> NEQU 0 OR .CCB[RAB$W_RSZ] LSSU 2

;10300  1881		    THEN

;10400  1882			FOR$$SIGNAL_STO (FOR$K_SEGRECFOR);

;10500  1883	

;10600  1884		    !+

;10700  1885		    ! Set buffer pointer beyond end of control word.

;10800  1886		    ! Check for last record control word (bit 1=1).

;10900  1887		    ! If last record, set last record of segmented record flag (ISB$V_LAST_REC)

;11000  1888		    ! and leave logical record number incremented.



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 10-2

;

;11100  1889		    ! If not last record, decrement logical record number so not advanced

;11200  1890		    ! since a segmented logical record is a single record (for backspace).

;11300  1891		    !-

;11400  1892	

;11500  1893		    CCB[ISB$A_BUF_PTR] = .CCB[ISB$A_BUF_PTR] + 2;

;11600  1894		    IF .(.CCB[RAB$L_RBF])<1,1>

;11700  1895		    THEN

;11800  1896			CCB[ISB$V_LAST_REC] = 1

;11900  1897		    ELSE

;12000  1898			CCB[LUB$L_LOG_RECNO] = .CCB[LUB$L_LOG_RECNO] - 1;

;12100  1899		    END;	! End of segmented processing

;12200  1900	

;12300  1901		RETURN;

;12400  1902		END;	! End of FOR$$REC_RSU0 











		         5E 	       04  C2 00136 FOR$$REC_RSU0::

							    SUBL2   #4, SP						      ; 1779

				       5B  DD 00139 	    PUSHL   CCB							      ; 1838

	      00000000G  9F	       01  FB 0013B 	    CALLS   #1, @#SYS$GET					      ;

		         05 	       50  E8 00142 	    BLBS    R0, 1$						      ;

		  0000V  CF	       00  FB 00145 	    CALLS   #0, GET_ERROR					      ; 1840

				  E0   AB  D6 0014A 1$:     INCL    -32(CCB)						      ; 1848

		         6E 	  28   AB  D0 0014D 	    MOVL    40(CCB), (SP)					      ; 1854

		    B8   AB	       6E  D0 00151 	    MOVL    (SP), -72(CCB)					      ;

		         50 	  22   AB  3C 00155 	    MOVZWL  34(CCB), R0						      ; 1855

      BC   AB	         6E 	       50  C1 00159 	    ADDL3   R0, (SP), -68(CCB)					      ;

	   3A 	    FD   AB	       03  E1 0015E 	    BBC     #3, -3(CCB), 6$					      ; 1861

		         01 	  22   AB  B1 00163 	    CMPW    34(CCB), #1						      ; 1870

				       0D  12 00167 	    BNEQ    2$							      ;

		         1A 	  00   BE  91 00169 	    CMPB    @0(SP), #26						      ;

				       07  12 0016D 	    BNEQ    2$							      ;

				       18  DD 0016F 	    PUSHL   #24							      ; 1872

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

		  FFFC   8F	  00   BE  B3 00176 2$:     BITW    @0(SP), #65532					      ; 1880

				       06  12 0017C 	    BNEQ    3$							      ;

		         02 	  22   AB  B1 0017E 	    CMPW    34(CCB), #2						      ;

				       07  1E 00182 	    BGEQU   4$							      ;

				       23  DD 00184 3$:     PUSHL   #35							      ; 1882

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

		    B8   AB	       02  C0 0018B 4$:     ADDL2   #2, -72(CCB)					      ; 1893

	   06 	    00   BE	       01  E1 0018F 	    BBC     #1, @0(SP), 5$					      ; 1894

		    D7   AB	       08  88 00194 	    BISB2   #8, -41(CCB)					      ; 1896

				       03  11 00198 	    BRB     6$							      ; 1894

				  E0   AB  D7 0019A 5$:     DECL    -32(CCB)						      ; 1898

		         5E 	       04  C0 0019D 6$:     ADDL2   #4, SP						      ; 1779

					   05 001A0 	    RSB     							      ;



; Routine Size:  107 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 11

;

;00100  1903	GLOBAL ROUTINE FOR$$REC_RSU1	! Read sequential unformatted 

;00200  1904		: JSB_REC1 NOVALUE =

;00300  1905	

;00400  1906	!++

;00500  1907	! FUNCTIONAL DESCRIPTION:

;00600  1908	!

;00700  1909	!	FOR$$REC_RSU1 reads one unformatted sequential record.

;00800  1910	!	Then return start and end+1 of user

;00900  1911	! 	part of record to be processed as input.

;01000  1912	!	If no segmented record, then error since only one record allowed.

;01100  1913	!	per I/O statement.

;01200  1914	!

;01300  1915	! CALLING SEQUENCE:

;01400  1916	!

;01500  1917	!	JSB FOR$$REC_RSU1 ()

;01600  1918	!

;01700  1919	! FORMAL PARAMETERS:

;01800  1920	!

;01900  1921	!	NONE

;02000  1922	!

;02100  1923	! IMPLICIT INPUTS:

;02200  1924	!

;02300  1925	!	CCB			Pointer to current logical unit

;02400  1926	!

;02500  1927	! IMPLICIT OUTPUTS:

;02600  1928	!

;02700  1929	!	LUB$L_LOG_RECNO		Increment logical record number

;02800  1930	!				of next record to be read.

;02900  1931	!

;03000  1932	! ROUTINE VALUE:

;03100  1933	!

;03200  1934	!	NONE

;03300  1935	!

;03400  1936	! SIDE EFFECTS:

;03500  1937	!

;03600  1938	!	Reads next record from file on this logical unit.

;03700  1939	!	SIGNAL_STOs FOR$_ERRDURREA (39='ERROR DURING READ')

;03800  1940	!	SIGNAL_STOPs FOR$_ENDDURREA (24='END-OF-FILE DURING READ')

;03900  1941	!	SIGNAL_STOPs FOR$_SEGRECFOR (35='SEGMENTED RECORD FORMAT ERROR').

;04000  1942	!--

;04100  1943	

;04200  1944	

;04300  1945	

;04400  1946		BEGIN

;04500  1947	

;04600  1948		EXTERNAL REGISTER

;04700  1949		    CCB: REF BLOCK[, BYTE];

;04800  1950	

;04900  1951		!+

;05000  1952		! If no segmented records, SIGNAL_STOP FOR$_INPSTAREQ (67 ='INPUT STATEMENT REQUIRED TOO MUCH DATA')

;05100  1953		! since cannot on to next record without segmented control.

;05200  1954		! If segmented record, go read next record.

;05300  1955		!-

;05400  1956	

;05500  1957		IF .CCB[LUB$V_SEGMENTED] EQL 0



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 11-1

;

;05600  1958		THEN

;05700  1959		    FOR$$SIGNAL_STO (FOR$K_INPSTAREQ);

;05800  1960		FOR$$REC_RSU0 ();

;05900  1961	

;06000  1962		RETURN;

;06100  1963		END;	! End of FOR$$REC_RSU1











	   09 	    FD   AB	       03  E0 001A1 FOR$$REC_RSU1::

							    BBS     #3, -3(CCB), 1$					      ; 1957

		         7E 	  43   8F  9A 001A6 	    MOVZBL  #67, -(SP)						      ; 1959

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

				       85  10 001AF 1$:     BSBB    FOR$$REC_RSU0					      ; 1960

					   05 001B1 	    RSB     							      ; 1903



; Routine Size:  17 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 12

;

;00100  1964	GLOBAL ROUTINE FOR$$REC_RSU9	! Read sequential unformatted

;00200  1965		: JSB_REC9 NOVALUE =

;00300  1966	

;00400  1967	!++

;00500  1968	! FUNCTIONAL DESCRIPTION:

;00600  1969	!

;00700  1970	!	FOR$$REC_RSU9 performs termination after last

;00800  1971	!	sequential unformmatted record has been read.

;00900  1972	!	If segmented record and not at last record of segmented record,

;01000  1973	!	keep reading until read last record of segmented record.

;01100  1974	!

;01200  1975	! CALLING SEQUENCE:

;01300  1976	!

;01400  1977	!	JSB FOR$$REC_RSU9 ()

;01500  1978	!

;01600  1979	! FORMAL PARAMETERS:

;01700  1980	!

;01800  1981	!	NONE

;01900  1982	!

;02000  1983	! IMPLICIT INPUTS:

;02100  1984	!

;02200  1985	!	CCB			Pointer to current logical unit

;02300  1986	!	LUB$V_SEGMENTED		1 = segmented record info is present

;02400  1987	!	ISB$V_LAST_REC		Set to 1 when last record of

;02500  1988	!				segmented record has been read.

;02600  1989	!

;02700  1990	! IMPLICIT OUTPUTS:

;02800  1991	!

;02900  1992	! ROUTINE VALUE:

;03000  1993	!

;03100  1994	!	NONE

;03200  1995	!

;03300  1996	! SIDE EFFECTS:

;03400  1997	!

;03500  1998	!--

;03600  1999	

;03700  2000	        BEGIN

;03800  2001	

;03900  2002		EXTERNAL REGISTER

;04000  2003		    CCB: REF BLOCK[, BYTE];

;04100  2004	

;04200  2005		!+

;04300  2006		! If segmented record and if not already read last record of segmented record

;04400  2007		! (ISB$V_LAST_REC = 0) then keep reading records until find last record

;04500  2008		! (and increment logical record number once).

;04600  2009		!-

;04700  2010	

;04800  2011		IF .CCB[LUB$V_SEGMENTED]

;04900  2012		THEN

;05000  2013		    UNTIL .CCB[ISB$V_LAST_REC] DO FOR$$REC_RSU1 ();

;05100  2014	

;05200  2015		RETURN;

;05300  2016		END;	! End of FOR$$REC_RSU9







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 12-1

;







	   09 	    FD   AB	       03  E1 001B2 FOR$$REC_RSU9::

							    BBC     #3, -3(CCB), 2$					      ; 2011

	   04 	    D7   AB	       03  E0 001B7 1$:     BBS     #3, -41(CCB), 2$					      ; 2013

				       E3  10 001BC 	    BSBB    FOR$$REC_RSU1					      ;

				       F7  11 001BE 	    BRB     1$							      ;

					   05 001C0 2$:     RSB     							      ; 1964



; Routine Size:  15 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 13

;

;00100  2017	GLOBAL ROUTINE FOR$$REC_WD0	! Write direct (formatted and unformatted)

;00200  2018		: JSB_REC0 NOVALUE =

;00300  2019	

;00400  2020	!++

;00500  2021	! FUNCTIONAL DESCRIPTION:

;00600  2022	!

;00700  2023	!	Initialize for FORTRAN direct access (RMS sequential by rec. #) I/O.

;00800  2024	!	Both formatted and unformatted.  Return buffer pointers.

;00900  2025	!

;01000  2026	! CALLING SEQUENCE:

;01100  2027	!

;01200  2028	!	JSB FOR$$REC_WD0 ()

;01300  2029	!

;01400  2030	! FORMAL PARAMETERS:

;01500  2031	!

;01600  2032	!	NONE

;01700  2033	!

;01800  2034	! IMPLICIT INPUTS:

;01900  2035	!

;02000  2036	!	CCB			Pointer to current logical unit

;02100  2037	!	LUB$A_RBUF_ADR		Address of record buffer allocated at OPEN

;02200  2038	!	LUB$W_RBUF_SIZE		Size (bytes) allocated for record buffer at OPEN.

;02300  2039	!

;02400  2040	! IMPLICIT OUTPUTS:

;02500  2041	!

;02600  2042	!	ISB$A_BUF_PTR		Pointer to start of user part of record

;02700  2043	!				buffer

;02800  2044	!	ISB$A_BUF_END		Pointer to END+! of user part of record

;02900  2045	!				buffer

;03000  2046	!

;03100  2047	! ROUTINE VALUE:

;03200  2048	!

;03300  2049	!	NONE

;03400  2050	!

;03500  2051	! SIDE EFFECTS:

;03600  2052	!

;03700  2053	!	NONE

;03800  2054	!--

;03900  2055	

;04000  2056		BEGIN

;04100  2057	

;04200  2058		EXTERNAL REGISTER

;04300  2059		    CCB: REF BLOCK[, BYTE];

;04400  2060	

;04500  2061		!+

;04600  2062		! Return pointers to the record buffer

;04700  2063		!-

;04800  2064	

;04900  2065		CCB[ISB$A_BUF_PTR] = .CCB[LUB$A_RBUF_ADR];

;05000  2066		CCB[ISB$A_BUF_END] = .CCB[LUB$A_RBUF_ADR] + .CCB[LUB$W_RBUF_SIZE];

;05100  2067	

;05200  2068		RETURN;

;05300  2069		END;	! end of routine







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 13-1

;







		    B8   AB	  EC   AB  D0 001C1 FOR$$REC_WD0::

							    MOVL    -20(CCB), -72(CCB)					      ; 2065

		         50 	  DA   AB  3C 001C6 	    MOVZWL  -38(CCB), R0					      ; 2066

		    BC   AB	  EC BB40  9E 001CA 	    MOVAB   @-20(CCB)[R0], -68(CCB)				      ;

					   05 001D0 	    RSB     							      ; 2017



; Routine Size:  16 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 14

;

;00100  2070	GLOBAL ROUTINE FOR$$REC_WD1	! Write direct (formatted and unformatted)

;00200  2071		: JSB_REC1 NOVALUE =

;00300  2072	

;00400  2073	!++

;00500  2074	! FUNCTIONAL DESCRIPTION:

;00600  2075	!

;00700  2076	!	Since only one record may be written per direct I/O statement,

;00800  2077	!	a call to this routine is an error.

;00900  2078	!

;01000  2079	! CALLING SEQUENCE:

;01100  2080	!

;01200  2081	!	JSB FOR$$REC_WD1 ()

;01300  2082	!

;01400  2083	! FORMAL PARAMETERS:

;01500  2084	!

;01600  2085	!	NONE

;01700  2086	!

;01800  2087	! IMPLICIT INPUTS:

;01900  2088	!

;02000  2089	!	NONE

;02100  2090	!

;02200  2091	! IMPLICIT OUTPUTS:

;02300  2092	!

;02400  2093	! ROUTINE VALUE:

;02500  2094	!

;02600  2095	!	NONE

;02700  2096	!

;02800  2097	! SIDE EFFECTS:

;02900  2098	!

;03000  2099	!	SIGNALSTOPs FOR$_OUTSTAOVE since next record request due to

;03100  2100	!	format reversion or slash in format got caught in UDF level.

;03200  2101	!--

;03300  2102	

;03400  2103		FOR$$SIGNAL_STO (FOR$K_OUTSTAOVE);











		         7E 	  42   8F  9A 001D1 FOR$$REC_WD1::

							    MOVZBL  #66, -(SP)						      ; 2103

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

					   05 001DA 	    RSB     							      ; 2070



; Routine Size:  10 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 15

;

;00100  2104	GLOBAL ROUTINE FOR$$REC_WD9	! Write direct (formatted and unformatted)

;00200  2105		: JSB_REC9 NOVALUE =

;00300  2106	

;00400  2107	!++

;00500  2108	! FUNCTIONAL DESCRIPTION:

;00600  2109	!

;00700  2110	!	Write a FORTRAN direct access record (RMS sequential by rec. #).

;00800  2111	!	Formatted and unformatted.  Pad out buffer with spaces or nulls

;00900  2112	!	depending on whether formatted or unformatted.

;01000  2113	!

;01100  2114	! CALLING SEQUENCE:

;01200  2115	!

;01300  2116	!	JSB FOR$$REC_WD9 ()

;01400  2117	!

;01500  2118	! FORMAl PARAMETERS:

;01600  2119	!

;01700  2120	!	NONE

;01800  2121	!

;01900  2122	!	CCB			Pointer to current logical unit

;02000  2123	!	LUB$V_UNFORMAT		1 if unformatted, 0 if formatted.

;02100  2124	!	LUB$L_LOG_RECNO		Record number to write

;02200  2125	!	LUB$W_RBUF_SIZE		Size (bytes) allocated for record buffer at OPEN.

;02300  2126	!	LUB$A_RBUF_ADR		Address of record buffer allocated at OPEN

;02400  2127	!	ISB$A_BUF_PTR		Pointer to end+1 of user data in record buffer

;02500  2128	!

;02600  2129	! IMPLICIT OUTPUTS:

;02700  2130	!

;02800  2131	!	LUB$L_LOG_RECNO		Updated record number

;02900  2132	!	Ass. Var.		Updated associated variable if present

;03000  2133	!

;03100  2134	! ROUTINE VALUE:

;03200  2135	!

;03300  2136	!	NONE

;03400  2137	!

;03500  2138	! SIDE EFFECTS:

;03600  2139	!

;03700  2140	!	SIGNALSTOPs FOR$_ERRDURWRI if RMS write error.

;03800  2141	!--

;03900  2142	

;04000  2143		BEGIN

;04100  2144	

;04200  2145		EXTERNAL REGISTER

;04300  2146		    CCB: REF BLOCK[, BYTE];

;04400  2147	

;04500  2148		!+

;04600  2149		! Pad buffer with blanks  or nulls to bring record length up to

;04700  2150		! LUB$W_RBUF_SIZE if not already.

;04800  2151		!-

;04900  2152	

;05000  2153		IF .CCB[ISB$A_BUF_PTR] LSSA .CCB[ISB$A_BUF_END]

;05100  2154		THEN

;05200  2155		    FILL_BUF (IF .CCB[LUB$V_UNFORMAT] THEN 0 ELSE %C' ');

;05300  2156	

;05400  2157		!+

;05500  2158		! Set RAB record pointer to the record.



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 15-1

;

;05600  2159		!-

;05700  2160	

;05800  2161		CCB[RAB$L_RBF] = .CCB[LUB$A_RBUF_ADR];

;05900  2162	

;06000  2163		!+

;06100  2164		! Call RMS to perform the record PUT.

;06200  2165		! SIGNAL any errors.

;06300  2166		!-

;06400  2167	

;06500  2168		IF NOT $PUT (RAB = .CCB)

;06600  2169		THEN

;06700  2170		    PUT_ERROR ();

;06800  2171	

;06900  2172		!+

;07000  2173		! Increment the record number in the LUB and store

;07100  2174		! into the associated variable.

;07200  2175		!-

;07300  2176	

;07400  2177		CCB[LUB$L_LOG_RECNO] = .CCB[LUB$L_LOG_RECNO] + 1;

;07500  2178		FOR$$ASSOC();

;07600  2179	

;07700  2180		RETURN;

;07800  2181		END;	! end of routine











		    BC   AB	  B8   AB  D1 001DB FOR$$REC_WD9::

							    CMPL    -72(CCB), -68(CCB)					      ; 2153

				       10  1E 001E0 	    BGEQU   3$							      ;

	   04 	    FD   AB	       01  E1 001E2 	    BBC     #1, -3(CCB), 1$					      ; 2155

				       7E  D4 001E7 	    CLRL    -(SP)						      ;

				       02  11 001E9 	    BRB     2$							      ;

				       20  DD 001EB 1$:     PUSHL   #32							      ;

		  0000V  CF	       01  FB 001ED 2$:     CALLS   #1, FILL_BUF					      ;

		    28   AB	  EC   AB  D0 001F2 3$:     MOVL    -20(CCB), 40(CCB)					      ; 2161

				       5B  DD 001F7 	    PUSHL   CCB							      ; 2168

	      00000000G  9F	       01  FB 001F9 	    CALLS   #1, @#SYS$PUT					      ;

		         05 	       50  E8 00200 	    BLBS    R0, 4$						      ;

		  0000V  CF	       00  FB 00203 	    CALLS   #0, PUT_ERROR					      ; 2170

				  E0   AB  D6 00208 4$:     INCL    -32(CCB)						      ; 2177

		  0000G  CF	       00  FB 0020B 	    CALLS   #0, FOR$$ASSOC					      ; 2178

					   05 00210 	    RSB     							      ; 2104



; Routine Size:  54 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 16

;

;00100  2182	GLOBAL ROUTINE FOR$$REC_RD0	! Read direct (formatted and unformatted)

;00200  2183		: JSB_REC0 NOVALUE =

;00300  2184	

;00400  2185	!++

;00500  2186	! FUNCTIONAL DESCRIPTION:

;00600  2187	!

;00700  2188	!	Perform a FORTRAN direct access READ (RMS sequential by rec. #).

;00800  2189	!	Formatted and unformatted.  Read record and store

;00900  2190	!	ASSOCIATED variable if any.

;01000  2191	!

;01100  2192	! CALLING SEQUENCE:

;01200  2193	!

;01300  2194	!	JSB FOR$$REC_RD0 ()

;01400  2195	!

;01500  2196	! FORMAl PARAMETERS:

;01600  2197	!

;01700  2198	!	NONE

;01800  2199	!

;01900  2200	! IMPLICIT INPUTS:

;02000  2201	!

;02100  2202	!	CCB			Pointer to current logical unit

;02200  2203	!	RAB$W_RSZ		record size set by open (should

;02300  2204	!				never change)

;02400  2205	!	LUB$A_RBUF_ADR		Address of record buffer allocated at OPEN

;02500  2206	!	LUB$W_RBUF_SIZE		Size of record buffer allocated at OPEN

;02600  2207	!

;02700  2208	! IMPLICIT OUTPUTS:

;02800  2209	!

;02900  2210	!	ISB$A_BUF_PTR		Pointer to user data in record buffer

;03000  2211	!	ISB$A_BUF_END		Pointer to end+1 of user data in record buffer

;03100  2212	!	LUB$L_LOG_RECNO		updated record number

;03200  2213	!	ass. var.		updated associated variable (if any)

;03300  2214	!

;03400  2215	! ROUTINE VALUE:

;03500  2216	!

;03600  2217	!	NONE

;03700  2218	!

;03800  2219	! SIDE EFFECTS:

;03900  2220	!

;04000  2221	!	SIGNALSTOPs FOR$_ERRDUREA if RMS read error

;04100  2222	!--

;04200  2223	

;04300  2224	

;04400  2225		BEGIN

;04500  2226	

;04600  2227		EXTERNAL REGISTER

;04700  2228		    CCB: REF BLOCK[, BYTE];

;04800  2229	

;04900  2230		!+

;05000  2231		! Call RMS to do the record GET.

;05100  2232		! SIGNAL_STOP EOF and RNF errors as ATTEMPT TO READ NON-EXISTANT RECORD.

;05200  2233		!-

;05300  2234	

;05400  2235		IF NOT $GET (RAB = .CCB)

;05500  2236		THEN



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 16-1

;

;05600  2237		    BEGIN

;05700  2238		    WHILE .CCB[RAB$L_STS] EQL RMS$_RSA DO

;05750  2239		        BEGIN

;05800  2240			$WAIT (RAB=.CCB);

;05900  2241			$GET (RAB=.CCB)

;05950  2242			END;

;06000  2243		    IF NOT .CCB[RAB$L_STS] THEN FOR$$SIGNAL_STO (

;06100  2244			SELECTONEU .CCB[RAB$L_STS] OF

;06200  2245			SET

;06300  2246	

;06400  2247			[RMS$_EOF, RMS$_RNF]:	FOR$K_ATTREANON;

;06500  2248			[OTHERWISE]:		FOR$K_ERRDURREA;

;06600  2249	

;06700  2250			TES);

;06800  2251		    END;

;06900  2252	

;07000  2253		!+

;07100  2254		! Return pointers to the record just read.

;07200  2255		!-

;07300  2256	

;07400  2257		CCB[ISB$A_BUF_PTR] = .CCB[RAB$L_RBF];

;07500  2258		CCB[ISB$A_BUF_END] = .CCB[RAB$L_RBF] + .CCB[RAB$W_RSZ];

;07600  2259	

;07700  2260		!+

;07800  2261		! Increment the record number in the LUB and

;07900  2262		! store it in the associated variable.

;08000  2263		!-

;08100  2264	

;08200  2265		CCB[LUB$L_LOG_RECNO] = .CCB[LUB$L_LOG_RECNO] + 1;

;08300  2266		FOR$$ASSOC();

;08400  2267	

;08500  2268		RETURN;

;08600  2269		END;	! end of routine







							    .EXTRN  SYS$WAIT



				       5B  DD 00211 FOR$$REC_RD0::

							    PUSHL   CCB							      ; 2235

	      00000000G  9F	       01  FB 00213 	    CALLS   #1, @#SYS$GET					      ;

		         42 	       50  E8 0021A 	    BLBS    R0, 6$						      ;

	      000182DA   8F	  08   AB  D1 0021D 1$:     CMPL    8(CCB), #99034					      ; 2238

				       14  12 00225 	    BNEQ    2$							      ;

				       5B  DD 00227 	    PUSHL   CCB							      ; 2240

	      00000000G  9F	       01  FB 00229 	    CALLS   #1, @#SYS$WAIT					      ;

				       5B  DD 00230 	    PUSHL   CCB							      ; 2241

	      00000000G  9F	       01  FB 00232 	    CALLS   #1, @#SYS$GET					      ;

				       E2  11 00239 	    BRB     1$							      ; 2238

		         50 	  08   AB  D0 0023B 2$:     MOVL    8(CCB), R0						      ; 2243

		         1D 	       50  E8 0023F 	    BLBS    R0, 6$						      ;

	      0001827A   8F	       50  D1 00242 	    CMPL    R0, #98938						      ; 2244

				       09  13 00249 	    BEQL    3$							      ;

	      000182B2   8F	       50  D1 0024B 	    CMPL    R0, #98994						      ;

				       04  12 00252 	    BNEQ    4$							      ;



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 16-2

;

				       24  DD 00254 3$:     PUSHL   #36							      ;

				       02  11 00256 	    BRB     5$							      ;

				       27  DD 00258 4$:     PUSHL   #39							      ;

		  0000G  CF	       01  FB 0025A 5$:     CALLS   #1, FOR$$SIGNAL_STO					      ; 2243

		    B8   AB	  28   AB  D0 0025F 6$:     MOVL    40(CCB), -72(CCB)					      ; 2257

		         50 	  22   AB  3C 00264 	    MOVZWL  34(CCB), R0						      ; 2258

		    BC   AB	  28 BB40  9E 00268 	    MOVAB   @40(CCB)[R0], -68(CCB)				      ;

				  E0   AB  D6 0026E 	    INCL    -32(CCB)						      ; 2265

		  0000G  CF	       00  FB 00271 	    CALLS   #0, FOR$$ASSOC					      ; 2266

					   05 00276 	    RSB     							      ; 2182



; Routine Size:  102 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 17

;

;00100  2270	GLOBAL ROUTINE FOR$$REC_RD1	! read next direct access record

;00200  2271		: JSB_REC1 NOVALUE =

;00300  2272	

;00400  2273	!++

;00500  2274	! FUNCTIONAL DESCRIPTION:

;00600  2275	!

;00700  2276	!	Since only one record may be read per direct access

;00800  2277	!	I/O statement, any call to this routine is an error.

;00900  2278	!

;01000  2279	! CALLING SEQUENCE:

;01100  2280	!

;01200  2281	!	JSB FOR$$REC_RD1 ()

;01300  2282	!

;01400  2283	! FORMAL PARAMETERS:

;01500  2284	!

;01600  2285	!	NONE

;01700  2286	!

;01800  2287	! ROUTINE VALUE:

;01900  2288	!

;02000  2289	!	NONE

;02100  2290	!

;02200  2291	! SIDE EFFECTS:

;02300  2292	!

;02400  2293	!	SIGNAL_STOPs FOR$_INPSTAREQ since a record request caused

;02500  2294	!	by format reversion or slash gets caught at UDF level.

;02600  2295	!--

;02700  2296	

;02800  2297	    FOR$$SIGNAL_STO (FOR$K_INPSTAREQ);











		         7E 	  43   8F  9A 00277 FOR$$REC_RD1::

							    MOVZBL  #67, -(SP)						      ; 2297

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

					   05 00280 	    RSB     							      ; 2270



; Routine Size:  10 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 18

;

;00100  2298	GLOBAL ROUTINE FOR$$REC_WSL0	! Write list-directed

;00200  2299		: JSB_REC0 NOVALUE =

;00300  2300	

;00400  2301	!++

;00500  2302	! FUNCTIONAL DESCRIPTION:

;00600  2303	!

;00700  2304	!	FOR$$REC_WSL0 prepares a record for list-directed output.

;00800  2305	!	Then return start and end+1 of user

;00900  2306	!	part of record to be processed.

;01000  2307	!

;01100  2308	! CALLING SEQUENCE:

;01200  2309	!

;01300  2310	!	JSB FOR$$REC_WSL0 ()

;01400  2311	!

;01500  2312	! FORMAL PARAMETERS:

;01600  2313	!

;01700  2314	!	NONE

;01800  2315	!

;01900  2316	! IMPLICIT INPUTS:

;02000  2317	!

;02100  2318	!	CCB			Adr. of current LUB/ISB/RAB

;02200  2319	!	LUB$W_RBUF_SIZE		Size (bytes) allocated for record buffer at OPEN.

;02300  2320	!	LUB$A_RBUF_ADR		Address of record buffer allocated at OPEN

;02400  2321	!	LUB$V_FIXED		 1 if fixed-length records

;02500  2322	!

;02600  2323	! IMPLICIT OUTPUTS:

;02700  2324	!

;02800  2325	! ROUTINE VALUE:

;02900  2326	!

;03000  2327	!	NONE

;03100  2328	!

;03200  2329	! SIDE EFFECTS:

;03300  2330	!

;03400  2331	!--

;03500  2332	

;03600  2333	

;03700  2334	        BEGIN

;03800  2335	

;03900  2336		EXTERNAL REGISTER

;04000  2337		    CCB: REF BLOCK[, BYTE];

;04100  2338	

;04200  2339		!+

;04300  2340		! initialize the buffer for list-directed output by writing a leading blank for carriage control.

;04400  2341		!-

;04500  2342	

;04600  2343		CH$WCHAR (%C' ', CH$PTR(.CCB[LUB$A_RBUF_ADR]));

;04700  2344	

;04800  2345		!+

;04900  2346		! return start and end+1 pointers to caller

;05000  2347		!-

;05100  2348	

;05200  2349		CCB[ISB$A_BUF_PTR] = .CCB[LUB$A_RBUF_ADR] + 1;

;05300  2350		CCB[ISB$A_BUF_END] = .CCB[LUB$A_RBUF_ADR] +

;05400  2351		    (IF .CCB[LUB$V_FIXED] THEN .CCB[LUB$W_RBUF_SIZE] ELSE 73);

;05500  2352	



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 18-1

;

;05600  2353		RETURN;

;05700  2354		END;	! END OF ROUTINE











		    EC   BB	       20  90 00281 FOR$$REC_WSL0::

							    MOVB    #32, @-20(CCB)					      ; 2343

      B8   AB	    EC   AB	       01  C1 00285 	    ADDL3   #1, -20(CCB), -72(CCB)				      ; 2349

	   06 	    FD   AB	       02  E1 0028B 	    BBC     #2, -3(CCB), 1$					      ; 2351

		         50 	  DA   AB  3C 00290 	    MOVZWL  -38(CCB), R0					      ;

				       04  11 00294 	    BRB     2$							      ;

		         50 	  49   8F  9A 00296 1$:     MOVZBL  #73, R0						      ;

		    BC   AB	  EC BB40  9E 0029A 2$:     MOVAB   @-20(CCB)[R0], -68(CCB)				      ; 2350

					   05 002A0 	    RSB     							      ; 2298



; Routine Size:  32 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 19

;

;00100  2355	GLOBAL ROUTINE FOR$$REC_WSL1	! Write list-directed

;00200  2356					! (Also FOR$$REC_WSL9)

;00300  2357		: JSB_REC1 NOVALUE =

;00400  2358	

;00500  2359	!++

;00600  2360	! FUNCTIONAL DESCRIPTION:

;00700  2361	!

;00800  2362	!	Write one list-directed record and initialize for the next

;00900  2363	!	FOR$$REC_WSL1 writes one output buffer and then

;01000  2364	!	initializes the output buffer and returns start and end+1 of user

;01100  2365	!	part of record buffer to be filled by caller.

;01200  2366	!

;01300  2367	! CALLING SEQUENCE:

;01400  2368	!

;01500  2369	!	JSB FOR$$REC_WSL1 ()

;01600  2370	!

;01700  2371	! FORMAL PARAMETERS:

;01800  2372	!

;01900  2373	!	NONE

;02000  2374	!

;02100  2375	! IMPLICIT INPUTS:

;02200  2376	!

;02300  2377	!	CCB			Pointer to current logical unit

;02400  2378	!	LUB$W_RBUF_SIZE		Size (bytes) allocated for record buffer at OPEN.

;02500  2379	!	LUB$A_RBUF_ADR		Address of record buffer allocated at OPEN

;02600  2380	!

;02700  2381	! IMPLICIT OUTPUTS:

;02800  2382	!

;02900  2383	!	ISB$A_BUF_PTR		Pointer to start of user part of record buffer

;03000  2384	!	ISB$A_BUF_END		Pointer to end+1 of user part of record buffer

;03100  2385	! ROUTINE VALUE:

;03200  2386	!

;03300  2387	!	NONE

;03400  2388	!

;03500  2389	! SIDE EFFECTS:

;03600  2390	!

;03700  2391	!	Writes one RMS sequential record.

;03800  2392	!	SIGNAL_STOs FOR$_ERRDURWRI on PUT error.

;03900  2393	!--

;04000  2394	

;04100  2395	        BEGIN

;04200  2396	

;04300  2397		EXTERNAL REGISTER

;04400  2398		    CCB: REF BLOCK[, BYTE];

;04500  2399	

;04600  2400		!+

;04700  2401		! Call FOR$$REC_WSF1 to perform the record write.

;04800  2402		!-

;04900  2403	

;05000  2404		FOR$$REC_WSF1 ();

;05100  2405	

;05200  2406		!+

;05300  2407		! Initialize record buffer for another list-directed write

;05400  2408		! by inserting a blank for the carriage control character.

;05500  2409		!-



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 19-1

;

;05600  2410	

;05700  2411		CH$WCHAR (%C' ', CH$PTR(.CCB[LUB$A_RBUF_ADR]));

;05800  2412	

;05900  2413		!+

;06000  2414		! return record buffer pointers to caller

;06100  2415		!-

;06200  2416	

;06300  2417		CCB[ISB$A_BUF_PTR] = .CCB[LUB$A_RBUF_ADR] + 1;

;06400  2418		CCB[ISB$A_BUF_END] = .CCB[LUB$A_RBUF_ADR] +

;06500  2419		    (IF .CCB[LUB$V_FIXED] THEN .CCB[LUB$W_RBUF_SIZE] ELSE 73);

;06600  2420	

;06700  2421		RETURN;

;06800  2422		END;	! END OF ROUTINE











				     FD6C  30 002A1 FOR$$REC_WSL1::

							    BSBW    FOR$$REC_WSF1					      ; 2404

		    EC   BB	       20  90 002A4 	    MOVB    #32, @-20(CCB)					      ; 2411

      B8   AB	    EC   AB	       01  C1 002A8 	    ADDL3   #1, -20(CCB), -72(CCB)				      ; 2417

	   06 	    FD   AB	       02  E1 002AE 	    BBC     #2, -3(CCB), 1$					      ; 2419

		         50 	  DA   AB  3C 002B3 	    MOVZWL  -38(CCB), R0					      ;

				       04  11 002B7 	    BRB     2$							      ;

		         50 	  49   8F  9A 002B9 1$:     MOVZBL  #73, R0						      ;

		    BC   AB	  EC BB40  9E 002BD 2$:     MOVAB   @-20(CCB)[R0], -68(CCB)				      ; 2418

					   05 002C3 	    RSB     							      ; 2355



; Routine Size:  35 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 20

;

;00100  2423	GLOBAL ROUTINE FOR$$REC_RMF1	! DECODE entry point for next record

;00200  2424					! also called as FOR$$REC_WMF1

;00300  2425		: JSB_REC1 NOVALUE =

;00400  2426	

;00500  2427	!++

;00600  2428	! FUNCTIONAL DESCRIPTION:

;00700  2429	!

;00800  2430	!	Since only one "record" is allowed per ENCODE or DECODE statement,

;00900  2431	!	any request for "get next record" is an error.

;01000  2432	!

;01100  2433	! CALLING SEQUENCE:

;01200  2434	!

;01300  2435	!	JSB FOR$$REC_RMF1 ()

;01400  2436	!

;01500  2437	! FORMAL PARAMETERS:

;01600  2438	!

;01700  2439	!	NONE

;01800  2440	!

;01900  2441	! ROUTINE VALUE:

;02000  2442	!

;02100  2443	!	NONE

;02200  2444	!

;02300  2445	! SIDE EFFECTS:

;02400  2446	!

;02500  2447	!	SIGNAL_STOPs FOR$_MORONEREC always.

;02600  2448	!--

;02700  2449	

;02800  2450	    FOR$$SIGNAL_STO (FOR$K_MORONEREC);











				       1B  DD 002C4 FOR$$REC_RMF1::

							    PUSHL   #27							      ; 2450

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

					   05 002CB 	    RSB     							      ; 2423



; Routine Size:  8 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 21

;

;00100  2451	GLOBAL ROUTINE FOR$$REC_WMF9	! ENCODE wrap-up

;00200  2452		: JSB_REC9 NOVALUE =

;00300  2453	

;00400  2454	!++

;00500  2455	! FUNCTIONAL DESCRIPTION:

;00600  2456	!

;00700  2457	!	Termination call for ENCODE.

;00800  2458	!	Blank pad the end of the users buffer.

;00900  2459	!

;01000  2460	! FORMAL PARAMETERS:

;01100  2461	! CALLING SEQUENCE:

;01200  2462	!

;01300  2463	!	JSB FOR$$REC_WMF9 ()

;01400  2464	!

;01500  2465	!

;01600  2466	!	NONE

;01700  2467	!

;01800  2468	! IMPLICIT INPUTS:

;01900  2469	!

;02000  2470	!	CCB			Adr. of current LUB/ISB/RAB

;02100  2471	!	ISB$A_BUF_PTR		Pointer to end+1 of user data in buffer

;02200  2472	!	ISB$A_BUF_END		Pointer to end+1 of buffer

;02300  2473	!

;02400  2474	! IMPLICIT OUTPUTS:

;02500  2475	!

;02600  2476	! ROUTINE VALUE:

;02700  2477	!

;02800  2478	!	NONE

;02900  2479	!

;03000  2480	! SIDE EFFECTS:

;03100  2481	!

;03200  2482	!	NONE

;03300  2483	!--

;03400  2484	

;03500  2485	    BEGIN

;03600  2486	

;03700  2487	    EXTERNAL REGISTER

;03800  2488		CCB: REF BLOCK[, BYTE];

;03900  2489	

;04000  2490	    !+

;04100  2491	    ! Fill rest of buffer supplied by user if necessary (with spaces).

;04200  2492	    !-

;04300  2493	    IF .CCB[ISB$A_BUF_PTR] LSSA .CCB[ISB$A_BUF_END] THEN FILL_BUF (%C' ');

;04400  2494	

;04500  2495	    RETURN;

;04600  2496	    END;











		    BC   AB	  B8   AB  D1 002CC FOR$$REC_WMF9::

							    CMPL    -72(CCB), -68(CCB)					      ; 2493

				       07  1E 002D1 	    BGEQU   1$							      ;

				       20  DD 002D3 	    PUSHL   #32							      ;



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 21-1

;

		  0000V  CF	       01  FB 002D5 	    CALLS   #1, FILL_BUF					      ;

					   05 002DA 1$:     RSB     							      ; 2451



; Routine Size:  15 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 22

;

;00100  2497	ROUTINE FILL_BUF	(	! Fill rest of buffer with arg

;00200  2498		FILL_CHAR)		! Fill character [by-value]

;00300  2499		: CALL_CCB NOVALUE =

;00400  2500	

;00500  2501	!++

;00600  2502	! FUNCTIONAL DESCRIPTION:

;00700  2503	!

;00800  2504	!	Fill rest of buffer with argument (space or null).

;00900  2505	!	This CALL entry point is provided for JSB routines

;01000  2506	!	to conditionally CALL which are not using R2:R5.

;01100  2507	!

;01200  2508	! CALLING SEQUENCE:

;01300  2509	!

;01400  2510	!	CALL FILL_BUF (fill_char.rbu.v)

;01500  2511	!

;01600  2512	! FORMAL PARAMETERS:

;01700  2513	!

;01800  2514	!	fill_char.rbu.v		Fill character

;01900  2515	!

;02000  2516	! IMPLICIT INPUTS:

;02100  2517	!

;02200  2518	!	CCB			Adr. of current LUB/ISB/RAB

;02300  2519	!	ISB$A_BUF_PTR		Pointer to end+1 of user data in buffer

;02400  2520	!	ISB$A_BUF_END		Pointer to end+1 of buffer

;02500  2521	!

;02600  2522	! IMPLICIT OUTPUTS:

;02700  2523	!

;02800  2524	! ROUTINE VALUE:

;02900  2525	!

;03000  2526	!	NONE

;03100  2527	!

;03200  2528	! SIDE EFFECTS:

;03300  2529	!

;03400  2530	!	NONE

;03500  2531	!--

;03600  2532	

;03700  2533	

;03800  2534	    BEGIN

;03900  2535	

;04000  2536	    EXTERNAL REGISTER

;04100  2537		CCB: REF BLOCK [, BYTE];

;04200  2538	

;04300  2539	    CH$FILL (.FILL_CHAR, .CCB[ISB$A_BUF_END] - .CCB[ISB$A_BUF_PTR], .CCB[ISB$A_BUF_PTR]);

;04400  2540	    RETURN;

;04500  2541	    END;		! End of FILL_BUF











					 003C 002DB FILL_BUF:

							    .WORD   Save R2,R3,R4,R5					      ; 2497

	   50 	    BC   AB	  B8   AB  C3 002DD 	    SUBL3   -72(CCB), -68(CCB), R0				      ; 2539

      04   AC	         6E 	       00  2C 002E3 	    MOVC5   #0, (SP), FILL_CHAR, R0, @-72(CCB)			      ;

		    B8   BB	       50     002E8									      ;



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 22-1

;

					   04 002EB 	    RET     							      ; 2497



; Routine Size:  17 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 23

;

;00100  2542	ROUTINE PUT_ERROR		! Here on error in $PUT

;00200  2543		: CALL_CCB NOVALUE =

;00300  2544	

;00400  2545	!++

;00500  2546	! FUNCTIONAL DESCRIPTION:

;00600  2547	!

;00700  2548	!	Here on $PUT errors, check for Record stream active error (RMS$_RSA)

;00800  2549	!	If this error, WAIT until not active and try $PUT again.

;00900  2550	!	This recovers from AST I/O which can occur out of the middle

;01000  2551	!	of synchronous I/O at non-AST level.

;01100  2552	!	If any other type of error, SIGNAL_STOP (FOR$_ERRDURWRI).

;01200  2553	!

;01300  2554	! CALLING SEQUENCE:

;01400  2555	!

;01500  2556	!	JSB PUT_ERROR ()

;01600  2557	!

;01700  2558	! FORMAL PARAMETERS:

;01800  2559	!

;01900  2560	!	NONE

;02000  2561	!

;02100  2562	! IMPLICIT INPUTS:

;02200  2563	!

;02300  2564	!	CCB			Adr. of current LUB/ISB/RAB

;02400  2565	!

;02500  2566	! IMPLICIT OUTPUTS:

;02600  2567	!

;02700  2568	! ROUTINE VALUE:

;02800  2569	!

;02900  2570	!	NONE

;03000  2571	!

;03100  2572	! SIDE EFFECTS:

;03200  2573	!

;03300  2574	!	$WAITs and then tries $PUT again, until success or any error

;03400  2575	!	except record streanm active.

;03500  2576	!--

;03600  2577	

;03700  2578	

;03800  2579	    BEGIN

;03900  2580	

;04000  2581	    EXTERNAL REGISTER

;04100  2582		CCB: REF BLOCK [, BYTE];

;04200  2583	

;04210  2584	    WHILE .CCB[RAB$L_STS] EQL RMS$_RSA DO

;04220  2585		BEGIN

;04400  2586		$WAIT (RAB=.CCB);

;04410  2587		$PUT (RAB=.CCB)

;04420  2588		END;

;04600  2589	    IF NOT .CCB[RAB$L_STS] THEN FOR$$SIGNAL_STO (FOR$K_ERRDURWRI);

;04700  2590	    RETURN;

;04800  2591	    END;		! End of PUT_ERROR













; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 23-1

;

					 0000 002EC PUT_ERROR:

							    .WORD   Save nothing					      ; 2542

	      000182DA   8F	  08   AB  D1 002EE 1$:     CMPL    8(CCB), #99034					      ; 2584

				       14  12 002F6 	    BNEQ    2$							      ;

				       5B  DD 002F8 	    PUSHL   CCB							      ; 2586

	      00000000G  9F	       01  FB 002FA 	    CALLS   #1, @#SYS$WAIT					      ;

				       5B  DD 00301 	    PUSHL   CCB							      ; 2587

	      00000000G  9F	       01  FB 00303 	    CALLS   #1, @#SYS$PUT					      ;

				       E2  11 0030A 	    BRB     1$							      ; 2584

		         07 	  08   AB  E8 0030C 2$:     BLBS    8(CCB), 3$						      ; 2589

				       26  DD 00310 	    PUSHL   #38							      ;

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

					   04 00317 3$:     RET     							      ; 2542



; Routine Size:  44 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 24

;

;00100  2592	ROUTINE GET_ERROR	! Here on error on $GET

;00200  2593		: CALL_CCB NOVALUE =

;00300  2594	

;00400  2595	!++

;00500  2596	! FUNCTIONAL DESCRIPTION:

;00600  2597	!

;00700  2598	!	Here on $GET errors, check for Record stream active error (RMS$_RSA)

;00800  2599	!	If this error, WAIT until not active and try $GET again.

;00900  2600	!	This recovers from AST I/O which can occur out of the middle

;01000  2601	!	of synchronous I/O at non-AST level.

;01100  2602	!	If any other type of error, SIGNAL_STOP (FOR$_ERRDURRED, FOR$_ENDDURREA,

;01200  2603	!	or FOR$_INPRECTOO) depending on RMS error codes.

;01300  2604	!

;01400  2605	! CALLING SEQUENCE:

;01500  2606	!

;01600  2607	!	JSB GET_ERROR ()

;01700  2608	!

;01800  2609	! FORMAL PARAMETERS:

;01900  2610	!

;02000  2611	!	NONE

;02100  2612	!

;02200  2613	! IMPLICIT INPUTS:

;02300  2614	!

;02400  2615	!	CCB			Adr. of current LUB/ISB/RAB

;02500  2616	!

;02600  2617	! IMPLICIT OUTPUTS:

;02700  2618	!

;02800  2619	! ROUTINE VALUE:

;02900  2620	!

;03000  2621	!	NONE

;03100  2622	!

;03200  2623	! SIDE EFFECTS:

;03300  2624	!

;03400  2625	!	$WAITs and then tries $GET again, until success or any error

;03500  2626	!	except record streanm active.

;03600  2627	!--

;03700  2628	

;03800  2629	

;03900  2630	    BEGIN

;04000  2631	

;04100  2632	    EXTERNAL REGISTER

;04200  2633		CCB: REF BLOCK [, BYTE];

;04300  2634	

;04310  2635	    WHILE .CCB[RAB$L_STS] EQL RMS$_RSA DO

;04320  2636		BEGIN

;04500  2637		$WAIT (RAB=.CCB);

;04510  2638		$GET (RAB=.CCB)

;04520  2639		END;

;04700  2640	    IF NOT .CCB[RAB$L_STS] THEN FOR$$SIGNAL_STO (

;04800  2641			SELECTONEU .CCB[RAB$L_STS] OF

;04900  2642			SET

;05000  2643	

;05100  2644			[RMS$_EOF]:	FOR$K_ENDDURREA;

;05200  2645			[RMS$_RTB]:	FOR$K_INPRECTOO;

;05300  2646			[OTHERWISE]:	FOR$K_ERRDURREA;



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 24-1

;

;05400  2647	

;05500  2648			TES);

;05600  2649	    RETURN;

;05700  2650	    END;			! End of GET_ERROR











					 0000 00318 GET_ERROR:

							    .WORD   Save nothing					      ; 2592

	      000182DA   8F	  08   AB  D1 0031A 1$:     CMPL    8(CCB), #99034					      ; 2635

				       14  12 00322 	    BNEQ    2$							      ;

				       5B  DD 00324 	    PUSHL   CCB							      ; 2637

	      00000000G  9F	       01  FB 00326 	    CALLS   #1, @#SYS$WAIT					      ;

				       5B  DD 0032D 	    PUSHL   CCB							      ; 2638

	      00000000G  9F	       01  FB 0032F 	    CALLS   #1, @#SYS$GET					      ;

				       E2  11 00336 	    BRB     1$							      ; 2635

		         50 	  08   AB  D0 00338 2$:     MOVL    8(CCB), R0						      ; 2640

		         21 	       50  E8 0033C 	    BLBS    R0, 6$						      ;

	      0001827A   8F	       50  D1 0033F 	    CMPL    R0, #98938						      ; 2641

				       04  12 00346 	    BNEQ    3$							      ;

				       18  DD 00348 	    PUSHL   #24							      ;

				       0F  11 0034A 	    BRB     5$							      ;

	      000181A8   8F	       50  D1 0034C 3$:     CMPL    R0, #98728						      ;

				       04  12 00353 	    BNEQ    4$							      ;

				       16  DD 00355 	    PUSHL   #22							      ;

				       02  11 00357 	    BRB     5$							      ;

				       27  DD 00359 4$:     PUSHL   #39							      ;

		  0000G  CF	       01  FB 0035B 5$:     CALLS   #1, FOR$$SIGNAL_STO					      ; 2640

					   04 00360 6$:     RET     							      ; 2592



; Routine Size:  73 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:23:12	DBB3:[RTL.SRC]FRECPR.B32;13					Page 25

;

;00100  2651	END

;00200  2652	ELUDOM











						    FOR$$REC_WMF1==	FOR$$REC_RMF1

						    FOR$$REC_WMF0==	FOR$$REC_RSF9

						    FOR$$REC_RMF9==	FOR$$REC_RSF9

						    FOR$$REC_RMF0==	FOR$$REC_RSF9

						    FOR$$REC_RSL9==	FOR$$REC_RSF9

						    FOR$$REC_RSL1==	FOR$$REC_RSF0

						    FOR$$REC_RSL0==	FOR$$REC_RSF0

						    FOR$$REC_WSL9==	FOR$$REC_WSF1

						    FOR$$REC_RD9==	FOR$$REC_RSF9

						    FOR$$REC_RSF1==	FOR$$REC_RSF0

						    FOR$$REC_WSF9==	FOR$$REC_WSF1



;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

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









;				LIBRARY STATISTICS

;

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

;	File				     Total    Loaded   Percent      Read

;

;  DBA4:[SYSLIB]STARLET.L32;1		      2688        11         0       115











; Size:		865 code + 0 data bytes

; Run Time:	00:29.2

; Elapsed Time:	01:00.5

; Memory Used:	197 pages

; Compilation Complete

