

; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 1

;

;00100  0001	MODULE FOR$$CB (	! Push, Pop, Allocate, and deallocate LUB/ISB/RAB

;00200  0002		IDENT = '0-51'	! File: FCB.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

;02700  0027	!

;02800  0028	! ABSTRACT:

;02900  0029	!

;03000  0030	!	This module performs all of the operations on LUB/ISB/RAB

;03100  0031	!	control blocks, including pushing, popping,

;03200  0032	!	allocating, and deallocating at the beginning and end

;03300  0033	!	of I/O statements.

;03400  0034	!

;03500  0035	! ENVIRONMENT: User mode, AST level or not or mixed

;03600  0036	!

;03700  0037	! AUTHOR:  Thomas N. Hastings, CREATION DATE: 01-June-77

;03800  0038	!

;03900  0039	! MODIFIED BY:

;04000  0040	!

;04100  0041	! 	Thoams N. Hastings, 01-June-77: VERSION 01

;04200  0042	! 01	-  original

;04300  0043	! 0-26	- Set RMS RAB$V_UIF bit TNH 19-SEP-77

;04400  0044	! 0-27	- Set RMS RAB$V_TPT bit (truncate on sequential $PUT not at EOF TNH 24-SEP-77

;04500  0045	! 0-28	- Use FOR$$SIG_NO_LUB since no LUB.  TNH 24-SEP-77

;04600  0046	! 0-30	- Set RAB bits for read-ahead, write-behind, locate mode JMT 21-OCT-77

;04700  0047	! 0-31	- Use FOR$K_abcmnoxyz as EXTERNAL LITERALs.  TNH 27-Oct-77

;04800  0048	! 0-32	- Made second arg optional.  TNH 9-Nov-77

;04900  0049	! 0-33	- Use OTS$_FATINTERR.  TNH 01-Dec-77

;05000  0050	! 0-34	- Clear FAB after call to LIB$GET_VM.  TNH 9-Dec-77

;05100  0051	! 0-35	- Call FOR$SIG_FATINT.  TNH 30-Dec-77

;05200  0052	! 0-36	- Have CB_POP signal FATINT if LUB not active;

;05300  0053	!	  Add routine CB_CND_POP to conditionally pop if LUB active,

;05400  0054	!	  otherwise NO-OP (OTS exit handler calls this).  JMT 10-Jan-78

;05500  0055	! 0-37	- Remove CB_CND_POP; I didn't really want it, anyway...  JMT 11-Jan-78



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 1-1

;

;05600  0056	! 0-37	- Global register CCB.  JMT 8-Apr-78

;05700  0057	! 0-39	- Change to STARLET library.  DGP 20-Apr-78

;05800  0058	! 0-40	- Change REQUIRE files for VAX system build.  DGP 28-Apr-78

;05900  0059	! 0-41	- Change STARLET to RTLSTARLE to avoid conflicts.  DGP 1-May-78

;06000  0060	! 0-42	- Make JSB linkage.  TNH 19-May-78

;06100  0061	! 0-46	- Use FOR$$GET_VM with new optional 2nd arg.  TNH 21-May-78

;06200  0062	! 0-47	- Remove setting ISB to -1.  TNH 30-May-78.

;06300  0063	! 0-48	- Add sanity check of data base.  TNH 10-June-78

;06400  0064	! 0-49	- Add call to FOR$$SIG_DATCOR.  TNH 10-June-78

;06500  0065	! 0-50	- Add FOR$$CB_GET entry for non-shared access to OTS$$A_CUR_LUB. TNH 2-Aug-78

;06600  0066	!--



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 2

;

;00100  0067	!

;00200  0068	! LINKAGES:

;00300  0069	!

;00400  0070	REQUIRE 'RTLIN:FLNK';			! Define LINKAGEs

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

;00500  0292	

;00600  0293	!

;00700  0294	! TABLE OF CONTENTS:

;00800  0295	!

;00900  0296	

;01000  0297	FORWARD ROUTINE

;01100  0298		FOR$$CB_PUSH: JSB_CB_PUSH NOVALUE,	! Allocate or find  LUB/ISB/RAB - beg of each I/O statment

;01200  0299		FOR$$CB_POP: JSB_CB_POP NOVALUE,	! Pop LUB/ISB/RAB - end of each I/O statement

;01300  0300		FOR$$CB_RET: JSB_CB_RET NOVALUE,	! Pop and Deallocate LUB/ISB/RAB - CLOSE

;01400  0301		ZERO_CCB: CALL_CCB NOVALUE,		! Clear LUB/RAB but not ISB.

;01450  0302		FOR$$CB_GET: JSB_CB_GET NOVALUE;	! Get current LUB/ISB/RAB (called by non-shared code only)

;01500  0303	

;01600  0304	!

;01700  0305	! INCLUDE FILES:

;01800  0306	!

;01900  0307		REQUIRE 'RTLML:FERR';		! FORTRAN error number definitions

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

;02000  0425		REQUIRE 'RTLML:FISB';		! get length of ISB

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

;02100  0634		REQUIRE 'RTLML:FLUB';		! get length of LUB

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

;02200  0802		REQUIRE 'RTLIN:FMAC';		! FORTRAN 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

;02300  0982		REQUIRE 'RTLIN:FOPN';		! LUN symbols (OPEN$K_xxx)

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

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

;02500  1122	

;02600  1123	!

;02700  1124	! MACROS:

;02800  1125	!

;02900  1126	

;03000  1127	!

;03100  1128	! EQUATED SYMBOLS:

;03200  1129	!

;03300  1130	

;03400  1131	LITERAL

;03500  1132		K_TOTAL_CCB_LEN = LUB$K_LUB_LEN + ISB$K_ISB_LEN + RAB$C_BLN;	! length of LUB+ISB+RAB

;03600  1133	

;03700  1134	!

;03800  1135	! PSECT DECLARATIONS:

;03900  1136	!

;04000  1137	

;04100  1138		DECLARE_PSECTS (FOR);	! declare PSECTs for FOR$ facility

;04200  1139	

;04300  1140	!

;04400  1141	! GLOBAL STORAGE:

;04500  1142	!

;04600  1143	

;04700  1144	GLOBAL



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 2-1

;

;04800  1145		OTS$$A_CUR_LUB;	! Contains the address of the current I/O

;04900  1146				! statement Logical unit block (LUB)

;05000  1147				! I/O statement block (ISB), and RMS record

;05100  1148				! access block (RAB)

;05200  1149	

;05300  1150	STRUCTURE			! Define vector with negative offsets for default LUNs

;05400  1151	    VECTOR_NEG[I;N] =

;05500  1152		[N*4]

;05600  1153		(VECTOR_NEG + (I-OPEN$K_DLUN_MIN)*%UPVAL);

;05700  1154	GLOBAL				! \\\ for debugging only, then make OWN \\\

;05800  1155		OTS$$AA_LUB_TAB: VECTOR_NEG[OPEN$K_LUN_MAX-OPEN$K_DLUN_MIN+1]

;05900  1156		    INITIAL (REP OPEN$K_LUN_MAX-OPEN$K_DLUN_MIN+1 OF (0));

;06000  1157				! table of LUBs, one for each LUN

;06100  1158	

;06200  1159	!

;06300  1160	! EXTERNAL REFERENCES:

;06400  1161	!

;06500  1162	

;06600  1163	EXTERNAL ROUTINE

;06700  1164		FOR$$SIG_NO_LUB: NOVALUE,	! convert FORTRAN err # to 32-bit code

;06800  1165						! Pass LUN explicitly since no current LUB.

;06900  1166						! and call LIB$STOP. should never return

;07000  1167		FOR$$SIG_DATCOR: NOVALUE,	! SIGNAL_STOP OTS$_INTDATCOR (INTERNAL

;07100  1168						! DATA CORRUPTED IN RUN-TIME LIBRARY)

;07200  1169		FOR$$GET_VM,			! Allocate virtual memory and signal errors

;07300  1170		FOR$$FREE_VM: NOVALUE;		! Deallocate virtual memory and signal errors

;07400  1171	

;07500  1172	EXTERNAL LITERAL

;07600  1173	    OTS$_INTDATCOR: UNSIGNED (%BPVAL);	! conditional value for INTERNAL DATA CORRUPTED

;07700  1174						! IN RUN-TIME LIBRARY error.

;07800  1175	

;07900  1176	BUILTIN

;08000  1177		TESTBITSS,			! Test bit for set and set uninterruptibly

;08100  1178						! so no AST program can call this module between the test

;08200  1179						! and the set

;08300  1180		TESTBITCC;			! Test bit for clear and clear ...



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 3

;

;00100  1181	GLOBAL ROUTINE FOR$$CB_PUSH (	! Allocate or find LUB/ISB/RAB - beg of each I/O statement

;00200  1182		LOGICAL_UNIT,		! Logical unit no. (by-value)

;00300  1183		LUN_MIN)		! OPTIONAL Minimum logical unit number (by-value)

;00400  1184		: JSB_CB_PUSH NOVALUE =

;00500  1185	

;00600  1186	!++

;00700  1187	! FUNCTIONAL DESCRIPTION:

;00800  1188	!

;00900  1189	!	FOR$$CB_PUSH checks for legal logical UNIT number

;01000  1190	!	which varyies depending on whether this is OPEN or

;01100  1191	!	default open.  If logical_unit already has

;01200  1192	!	a LUB/ISB/RAB allocated, only part of the per I/O statement part

;01300  1193	!	of LUB/ISB/RAB is cleared, namely just the status bits in ISB.

;01400  1194	!	Otherwise virtual memory is allocated for this logical_unit

;01500  1195	!	and the entire block is initialized to 0.  Then the allocated address

;01600  1196	!	is remembered in OWN table OTS$$A_LUB_TAB indexed by

;01700  1197	!	logical_unit.  The RAB is initialized to constants which

;01800  1198	!	do not change during execution.

;01900  1199	!

;02000  1200	!	If an I/O statement on another unit is already in progress,

;02100  1201	!	push it down by storing the address

;02200  1202	!	in the new current LUB/ISB/RAB.  Finally set GLOBAL OTS$$a_CUR_LUB

;02300  1203	!	to the address of the new current LUB/ISB/RAB.

;02400  1204	!

;02500  1205	! CALLING SEQUENCE:

;02600  1206	!

;02700  1207	!	JSB FOR$$CB_PUSH (R2=logical_unit.rl.v [, R0=lun_min.rl.v])

;02800  1208	!

;02900  1209	! FORMAL PARAMETERS:

;03000  1210	!

;03100  1211	!	LOGICAL_UNIT.rl.v	Value of logical unit for which LUB/ISB/RAB is desired (signed)

;03200  1212	!				May be negative for TYPE, ACCEPT, READ, PRINT

;03300  1213	!	LUN_MIN.rl.v		Value of minimum legal logical unit number (signed)

;03400  1214	!				Since in a register, must be present.

;03500  1215	!

;03600  1216	! IMPLICIT INPUTS:

;03700  1217	!

;03800  1218	!	OTS$$AA_LUB_TAB[logical_unit]	Adr. of LUB/ISB/RAB or 0 for

;03900  1219	!					this unit

;04000  1220	!

;04100  1221	! IMPLICIT OUTPUTS:

;04200  1222	!

;04300  1223	!	CCB				Base pointer set to adr. of LUB/ISB/RAB for logical_unit.

;04400  1224	!	OTS$$AA_LUB_TAB[logical_unit]	Adr. of LUB/ISB/RAB for logical_unit

;04500  1225	!	LUB$B_LUN			signed logical unit number

;04600  1226	!	RAB$B_BID

;04700  1227	!	RAB$B_BLN

;04800  1228	!	RAB$V_UIF			1

;04900  1229	!	RAB$V_TPT			1

;05000  1230	!	RAB$V_RAH			1

;05100  1231	!	RAB$V_WBH			1

;05200  1232	!	RAB$V_LOC			1

;05300  1233	!

;05400  1234	! ROUTINE VALUE:

;05500  1235	!



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 3-1

;

;05600  1236	!	None

;05700  1237	!

;05800  1238	! SIDE EFFECTS:

;05900  1239	!

;06000  1240	!	Allocates virtual memory if needed.

;06100  1241	!	SIGNAL_STOPs FOR$_RECIO_OPE (40='RECURSIVE I/O OPERATION') if

;06200  1242	!	logical_unit already is in the middle of anI/O statement (LUB$V_IO_ACTIVE = 1).

;06300  1243	!	SIGNAL_STOPs FOR$_INVLOGUNI (32='INVALID LOGICAL UNIT NUMBER') if logical_unit

;06400  1244	!	is out of range.

;06500  1245	!	SIGNAL_STOPs FOR$_INSVIRMEM (41='INSUFFICIENT VIRTUAL MEMORY') if cannot

;06600  1246	!	expand program region if needed.

;06700  1247	!--

;06800  1248	

;06900  1249	    BEGIN

;07000  1250	

;07100  1251	    EXTERNAL REGISTER

;07200  1252		CCB: REF BLOCK[, BYTE];

;07300  1253	

;07400  1254	    !+

;07500  1255	    ! Check range of logical_unit.  If out of range,

;07600  1256	    ! SIGNAL_STOP FOR$_INVLOGUNI (32='INVALID LOGICAL UNIT NUMBER")

;07700  1257	    !-

;07800  1258	

;07900  1259	    IF .LOGICAL_UNIT GTR OPEN$K_LUN_MAX OR .LOGICAL_UNIT LSS .LUN_MIN

;08000  1260	    THEN

;08100  1261		FOR$$SIG_NO_LUB (FOR$K_INVLOGUNI, .LOGICAL_UNIT);

;08200  1262	

;08300  1263	    !+

;08400  1264	    ! Check if this logical_unit does not yet have a LUB/ISB/RAB allocated

;08500  1265	    !-

;08600  1266	

;08700  1267	    IF (CCB = .OTS$$AA_LUB_TAB[.LOGICAL_UNIT]) EQL 0

;08800  1268	    THEN

;08900  1269	

;09000  1270		!+

;09100  1271		! This logical_unit does not yet have a LUB/ISB/RAB allocated.

;09200  1272		! Allocate virtual memory using logical unit passed as optional

;09300  1273		! 2nd arg to signal errors since no LUB/ISB/RAB setup yet!

;09400  1274		! If cannot allocate virtual memory, SIGNAL_STOP FOR$_INSVIRMEM

;09500  1275		! (41='INSUFFICIENT VIRTUAL MEMORY').

;09600  1276		! Then clear LUB and RAB, but not ISB (let each UDF level init ISB

;09700  1277		! in order to speed up per-statement processing).

;09800  1278		! Set constants in newly

;09900  1279		! allocated RAB, logical unit no. in newly allocated LUB,

;10000  1280		! flag LUB has having an active I/O statement,

;10100  1281		! adjust contents of control block pointer (CCB) so that

;10200  1282		! it points to beginning of RAB (ISB and LUB precede RAB

;10300  1283		! using negative offsets with respect to CCB,

;10400  1284		! and remember adr. of this allocation in ots OWN table

;10500  1285		! indexed by logical_unit (OTS$$AA_LUB_TAB).

;10600  1286		!-

;10700  1287	

;10800  1288		BEGIN

;10900  1289		CCB = FOR$$GET_VM (K_TOTAL_CCB_LEN, .LOGICAL_UNIT);

;11000  1290		ZERO_CCB ();



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 3-2

;

;11100  1291		CCB = .CCB + ISB$K_ISB_LEN + LUB$K_LUB_LEN;

;11200  1292		CCB[LUB$B_LUN] = .LOGICAL_UNIT;

;11300  1293		CCB[LUB$V_IO_ACTIVE] = 1;

;11400  1294		OTS$$AA_LUB_TAB[.LOGICAL_UNIT] = .CCB;

;11500  1295	

;11600  1296		!+

;11700  1297		! Initialize RAB to constants which never change for FORTRAN

;11800  1298		! Block ID, block length, and bit to make $PUT do $UPDATE if

;11900  1299		! record exists.  Also truncate on sequential $PUT not at EOF.

;12000  1300		! Note: TPT bit depends on FOP TRN bit being set in order to take effect.

;12100  1301		! Set read-ahead, write-behind and locate mode for GETs.

;12200  1302		!-

;12300  1303	

;12400  1304		CCB[RAB$B_BID] = RAB$C_BID;

;12500  1305		CCB[RAB$B_BLN] = RAB$C_BLN;

;12600  1306		CCB[RAB$V_UIF] = 1;

;12700  1307		CCB[RAB$V_TPT] = 1;

;12800  1308		CCB[RAB$V_RAH] = 1;

;12900  1309		CCB[RAB$V_WBH] = 1;

;13000  1310		CCB[RAB$V_LOC] = 1;

;13100  1311		END

;13200  1312	

;13300  1313	    ELSE

;13400  1314	

;13500  1315		!+

;13600  1316		! This logical_unit already has a LUB/ISB/RAB allocated.

;13700  1317		! Perform quick data base sanity check to catch user clobering

;13800  1318		! data base (which isn't protected).  If cloberred, SIGNAL_STOP

;13900  1319		! OTS$_INTDATCOR (INTERNAL DATA CORRUPTED IN RUN-TIME LIBRARY).

;14000  1320		! If this logical_unit is already in the middle of an I/O

;14100  1321		! statement, SIGNAL_STOP FOR$_RECIO_OPE (40='RECURSIVE I/O OPERATION').

;14200  1322		! If not, flag logical_unit as active by setting LUB$V_IO_ACTIVE.

;14300  1323		! Do test and set in one instruction since an AST interrupt can

;14400  1324		! re-enter this routine between any two instrucitons.

;14500  1325		!-

;14600  1326	

;14700  1327		BEGIN

;14800  1328		IF .CCB[LUB$B_LUN] NEQU .LOGICAL_UNIT OR .CCB[RAB$B_BID] NEQU RAB$C_BID

;14900  1329		THEN

;15000  1330		    FOR$$SIG_DATCOR ();

;15100  1331		IF TESTBITSS (CCB[LUB$V_IO_ACTIVE])

;15200  1332		THEN

;15300  1333		    FOR$$SIG_NO_LUB (FOR$K_RECIO_OPE, .LOGICAL_UNIT);

;15400  1334		END;

;15500  1335	

;15600  1336	    !+

;15700  1337	    ! Always clear just ISB status bits (ISB$B_STTM_STAT).

;15800  1338	    ! For speed, each UDF and REC level init routine can init rest if needed (not generally needed).

;15900  1339	    !-

;16000  1340	

;16100  1341	    CCB[ISB$B_STTM_STAT] = 0;

;16200  1342	

;16300  1343	    !+

;16400  1344	    ! Push down current (old) LUB/ISB/RAB by copying OTS$$A_CUR_LUB

;16500  1345	    ! to new LUB/ISB/RAB.  Usually OTS$$A_CUR_LUB is 0 since usually



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 3-3

;

;16600  1346	    ! no I/O statement is currently in progress.

;16700  1347	    ! Then set OTS GLOBAL location OTS$$A_CUR_LUB to adr. of LUB/ISB/RAB

;16800  1348	    ! for logical_unit.

;16900  1349	    !-

;17000  1350	

;17100  1351	    CCB[ISB$A_PUSH_LUB] = .OTS$$A_CUR_LUB;

;17200  1352	    OTS$$A_CUR_LUB = .CCB;

;17300  1353	    RETURN;

;17400  1354	    END;			!End of FOR$$CB_PUSH





							    .TITLE  FOR$$CB

							    .IDENT  \0-51\



							    .PSECT  FOR$DATA,NOEXE,  PIC,2



					      00000 OTS$$A_CUR_LUB::

							    .BLKB   4

				    00000000# 00004 OTS$$AA_LUB_TAB::

							    .LONG   0[104]						      ;



							    .EXTRN  FOR$$SIG_NO_LUB, FOR$$SIG_DATCOR, FOR$$GET_VM

							    .EXTRN  FOR$$FREE_VM, OTS$_INTDATCOR



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



	      00000063   8F	       52  D1 00000 FOR$$CB_PUSH::

							    CMPL    LOGICAL_UNIT, #99					      ; 1259

				       05  14 00007 	    BGTR    1$							      ;

		         50 	       52  D1 00009 	    CMPL    LOGICAL_UNIT, LUN_MIN				      ;

				       09  18 0000C 	    BGEQ    2$							      ;

				       52  DD 0000E 1$:     PUSHL   LOGICAL_UNIT					      ; 1261

				       20  DD 00010 	    PUSHL   #32							      ;

		  0000G  CF	       02  FB 00012 	    CALLS   #2, FOR$$SIG_NO_LUB					      ;

		         5B 00000000'EF42  D0 00017 2$:     MOVL    OTS$$AA_LUB_TAB+16[LOGICAL_UNIT], CCB		      ; 1267

				       39  12 0001F 	    BNEQ    3$							      ;

				       52  DD 00021 	    PUSHL   LOGICAL_UNIT					      ; 1289

		         7E 	  C0   8F  9A 00023 	    MOVZBL  #192, -(SP)						      ;

		  0000G  CF	       02  FB 00027 	    CALLS   #2, FOR$$GET_VM					      ;

		         5B 	       50  D0 0002C 	    MOVL    R0, CCB						      ;

		  0000V  CF	       00  FB 0002F 	    CALLS   #0, ZERO_CCB					      ; 1290

		         5B 	  7C   AB  9E 00034 	    MOVAB   124(R11), CCB					      ; 1291

		    F6   AB	       52  90 00038 	    MOVB    LOGICAL_UNIT, -10(CCB)				      ; 1292

		    FC   AB	       02  88 0003C 	    BISB2   #2, -4(CCB)						      ; 1293

	      00000000'EF42	       5B  D0 00040 	    MOVL    CCB, OTS$$AA_LUB_TAB+16[LOGICAL_UNIT]		      ; 1294

		         6B 	4401   8F  B0 00048 	    MOVW    #17409, (CCB)					      ; 1304

		         50 	  04   AB  9E 0004D 	    MOVAB   4(CCB), R0						      ; 1306

		         60 00010612   8F  C8 00051 	    BISL2   #67090, (R0)					      ; 1310

				       20  11 00058 	    BRB     6$							      ; 1267

      F6   AB	         08 	       00  EC 0005A 3$:     CMPV    #0, #8, -10(CCB), LOGICAL_UNIT			      ; 1328

				       52     0005F									      ;

				       05  12 00060 	    BNEQ    4$							      ;

		         01 	       6B  91 00062 	    CMPB    (CCB), #1						      ;

				       05  13 00065 	    BEQL    5$							      ;

		  0000G  CF	       00  FB 00067 4$:     CALLS   #0, FOR$$SIG_DATCOR					      ; 1330



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 3-4

;

	   09 	    FC   AB	       01  E3 0006C 5$:     BBCS    #1, -4(CCB), 6$					      ; 1331

				       52  DD 00071 	    PUSHL   LOGICAL_UNIT					      ; 1333

				       28  DD 00073 	    PUSHL   #40							      ;

		  0000G  CF	       02  FB 00075 	    CALLS   #2, FOR$$SIG_NO_LUB					      ;

				  D7   AB  94 0007A 6$:     CLRB    -41(CCB)						      ; 1341

		    A8   AB 00000000'  EF  D0 0007D 	    MOVL    OTS$$A_CUR_LUB, -88(CCB)				      ; 1351

	      00000000'  EF	       5B  D0 00085 	    MOVL    CCB, OTS$$A_CUR_LUB					      ; 1352

					   05 0008C 	    RSB     							      ; 1181



; Routine Size:  141 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 4

;

;00100  1355	ROUTINE ZERO_CCB		! Clear LUB and RAB, but not ISB

;00200  1356		: CALL_CCB NOVALUE =

;00300  1357	

;00400  1358	!++

;00500  1359	! FUNCTIONAL DESCRIPTION:

;00600  1360	!

;00700  1361	!	Clear LUB and RAB, but not ISB.

;00800  1362	!	ISB locations can be initialized by each UDF or REC init

;00900  1363	!	routine if needed (usually not needed).

;01000  1364	!	NOTE: This is a CALL interface, since it uses more registers

;01100  1365	!	than its JSB caller is allowed to.

;01200  1366	!

;01300  1367	! CALLING SEQUENCE:

;01400  1368	!

;01500  1369	!	CALL ZERO_CCB ()		Use CALL so can use MOVC5 in CH$FILL

;01600  1370	!

;01700  1371	! FORMAL PARAMETERS:

;01800  1372	!

;01900  1373	!	NONE

;02000  1374	!

;02100  1375	! IMPLICIT INPUTS:

;02200  1376	!

;02300  1377	!	CCB				Contains adr. if LUB/ISB/RAB

;02400  1378	!

;02500  1379	! IMPLICIT OUTPUTS:

;02600  1380	!

;02700  1381	!	NONE

;02800  1382	!

;02900  1383	! SIDE EFFECTS:

;03000  1384	!

;03100  1385	!	Clears LUB and RAB, but not ISB.

;03200  1386	!--

;03300  1387	

;03400  1388	    BEGIN

;03500  1389	

;03600  1390	    EXTERNAL REGISTER

;03700  1391		CCB: REF BLOCK[, BYTE];

;03800  1392	

;03900  1393	    CH$FILL (0, LUB$K_LUB_LEN + RAB$C_BLN, .CCB + ISB$K_ISB_LEN);

;04000  1394	    RETURN

;04100  1395	    END;











					 003C 0008D ZERO_CCB:

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

	   00 	         6E 	       00  2C 0008F 	    MOVC5   #0, (SP), #0, #108, 84(CCB)				      ; 1393

		    54   AB	006C   8F     00093									      ;

					   04 00098 	    RET     							      ; 1355



; Routine Size:  12 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 4-1

;



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 5

;

;00100  1396	GLOBAL ROUTINE FOR$$CB_POP	! Pop current LUB/ISB/RAB - end of I/O statement

;00200  1397		: JSB_CB_POP NOVALUE =

;00300  1398	

;00400  1399	!++

;00500  1400	! FUNCTIONAL DESCRIPTION:

;00600  1401	!

;00700  1402	!	FOR$$CB_POP pops the curents LUB/ISB/RAB and restores the

;00800  1403	!	previous pushed doen LUB/ISB/RAB, if any (usually none).

;00900  1404	!	Flags old current LUB/ISB/RAB as no longer having as active I/O statement

;01000  1405	!

;01100  1406	! CALLING SEQUENCE:

;01200  1407	!

;01300  1408	!	JSB FOR$$CB_POP ()

;01400  1409	!

;01500  1410	! FORMAL PARAMETERS:

;01600  1411	!

;01700  1412	!	NONE

;01800  1413	!

;01900  1414	! IMPLICIT INPUTS:

;02000  1415	!

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

;02200  1417	!	ISB$A_PUSH_LUB		Adr. of pushed doen LUB/ISB/RAB, or 0

;02300  1418	!

;02400  1419	! IMPLICIT OUTPUTS:

;02500  1420	!

;02600  1421	!	CCB			Set to 0 (to catch attempt to reference after a pop).

;02700  1422	!	LUB$V_IO_ACTIVE		Clear I/O active bit to indicate

;02800  1423	!				that this logical unit no longer has

;02900  1424	!				an I/O statement in progress

;03000  1425	!

;03100  1426	! COMPLETION CODES:

;03200  1427	! RETURN VALUE:

;03300  1428	!

;03400  1429	!	NONE

;03500  1430	!

;03600  1431	! SIDE EFFECTS:

;03700  1432	!

;03800  1433	!	Changes entire I/O system to another logical unit or none at all

;03900  1434	!	SIGNAL_STOPs FORTRAN INTERNAL ERROR if CB was not active.

;04000  1435	!--

;04100  1436	



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 6

;

;00100  1437	    BEGIN

;00200  1438	

;00300  1439	    !+

;00400  1440	    ! Maintenance note: to save space and time, FOR$$CB_RET contains

;00500  1441	    ! the same code as FOR$$CB_POP.  So if FOR$$CB_POP is changed,

;00600  1442	    ! so should FOR$$CB_RET.

;00700  1443	    !-

;00800  1444	

;00900  1445	    EXTERNAL REGISTER

;01000  1446		CCB: REF BLOCK[, BYTE];

;01100  1447	

;01200  1448	    !+

;01300  1449	    ! Flag old current LUB/ISB/RAB as no longer having

;01400  1450	    ! an I/O statement in progress.

;01500  1451	    ! If LUB was not active, then signal OTS$_INTDATCOR (INTERNAL DATA

;01600  1452	    ! CORRUPTED IN RUN-TIME LIBRARY).

;01700  1453	    !-

;01800  1454	

;01900  1455	    IF TESTBITCC (CCB[LUB$V_IO_ACTIVE])

;02000  1456	    THEN

;02100  1457		FOR$$SIG_DATCOR ();

;02200  1458	

;02300  1459	    !+

;02400  1460	    ! Pop current LUB/SIB/RAB and restore previous LUB/ISB/RAB to OTS$$AA_CUR_LUB

;02500  1461	    ! OWN storage table indexed by logical unit number.

;02600  1462	    ! But set CCB to 0 in order to catch attempts to access LUB/ISB/RAB after pop.

;02700  1463	    !-

;02800  1464	

;02900  1465	    OTS$$A_CUR_LUB = .CCB[ISB$A_PUSH_LUB];

;03000  1466	    CCB = 0;

;03100  1467	    RETURN;

;03200  1468	    END;			! End of FOR$$CB_POP routine











	   05 	    FC   AB	       01  E4 00099 FOR$$CB_POP::

							    BBSC    #1, -4(CCB), 1$					      ; 1455

		  0000G  CF	       00  FB 0009E 	    CALLS   #0, FOR$$SIG_DATCOR					      ; 1457

	      00000000'  EF	  A8   AB  D0 000A3 1$:     MOVL    -88(CCB), OTS$$A_CUR_LUB				      ; 1465

				       5B  D4 000AB 	    CLRL    CCB							      ; 1466

					   05 000AD 	    RSB     							      ; 1396



; Routine Size:  21 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 7

;

;00100  1469	GLOBAL ROUTINE FOR$$CB_RET	! Pop and deallocate  LUB/ISB/RAB

;00200  1470		: JSB_CB_RET NOVALUE =

;00300  1471	

;00400  1472	!++

;00500  1473	! FUNCTIONAL DESCRIPTION:

;00600  1474	!

;00700  1475	!	Indicate that current logical-unit no longer has

;00800  1476	!	a LUB/ISB/RAB by clearing OWN array entry OTS$$AA_LUB_TAB[logical_unit].

;00900  1477	!	Then pop current LUB/ISB/RAB and restore previous

;01000  1478	!	pushed down one, if any.  Then deallocate the old

;01100  1479	!	current LUB/ISB/RAb.

;01200  1480	!

;01300  1481	! CALLING SEQUENCE:

;01400  1482	!

;01500  1483	!	JSB FOR$$CB_RET ()

;01600  1484	!

;01700  1485	! FORMAL PARAMETERS:

;01800  1486	!

;01900  1487	!	NONE

;02000  1488	!

;02100  1489	! IMPLICIT INPUTS:

;02200  1490	!

;02300  1491	!	CCB			Contains adr. of current LUB/ISB/RAB to be deallocated

;02400  1492	!	LUB$B_LUN		Logical unit number in current LUB/ISB/RAB

;02500  1493	!

;02600  1494	! IMPLICIT OUTPUTS:

;02700  1495	!

;02800  1496	!	CCB			Set to 0 (to catch inadvertant references after)

;02900  1497	!	OTS$$AA_LUB_TAB[.LUB_ADR[LUB$B_LUN]]	is set to 0 to

;03000  1498	!				indicate that no LUB/ISB/RAB is allocated for this LUN

;03100  1499	!	OTS$$A_CUR_LUB		Adr. of previous LUB/ISB/RAB or 0 (usually).

;03200  1500	!

;03300  1501	! ROUTINE VALUE:

;03400  1502	! COMPLETION CODES:

;03500  1503	!

;03600  1504	!	NONE

;03700  1505	!

;03800  1506	! SIDE EFFECTS:

;03900  1507	!

;04000  1508	!	Deallocates current LUB/ISB/RAB and makes the previous

;04100  1509	!	pushed doen LUB/ISB/RAB, if any be the current LUB/ISB/RAB.

;04200  1510	!	SIGNAL_STOPs OTS$_FATINTERR ('FATAL INTERNAL ERROR IN RUN-TIME LIBRARY')

;04300  1511	!	if error returning VM to free storage.

;04400  1512	!--

;04500  1513	

;04600  1514	    BEGIN

;04700  1515	

;04800  1516	    EXTERNAL REGISTER

;04900  1517		CCB: REF BLOCK[, BYTE];

;05000  1518	

;05100  1519	    !+

;05200  1520	    ! Indicate that this logical unit number (LUN) no longer has

;05300  1521	    ! a LUB/ISB/RAB allocated to it.

;05400  1522	    !-

;05500  1523	



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 7-1

;

;05600  1524	    OTS$$AA_LUB_TAB[.CCB[LUB$B_LUN]] = 0;

;05700  1525	

;05800  1526	    !+

;05900  1527	    ! Make the old previous pushed down LUB/ISB/RAB be the current one, if any

;06000  1528	    ! This code should be identical to FOR$$CB_POP, except that CCB is not cleared here

;06100  1529	    ! until the end in order to be fast.

;06200  1530	    !-

;06300  1531	

;06400  1532	    BEGIN		! Start duplicate of FOR$$CB_POP code.

;06500  1533	

;06600  1534	    !+

;06700  1535	    ! Flag old current LUB/ISB/RAB as no longer having

;06800  1536	    ! an I/O statement in progress.

;06900  1537	    ! If LUB was not active, then signal OTS$_INTDATCOR (INTERNAL

;07000  1538	    ! DATA CORRUPTED IN RUN-TIME LIBRARY).

;07100  1539	    !-

;07200  1540	

;07300  1541	    IF TESTBITCC (CCB[LUB$V_IO_ACTIVE])

;07400  1542	    THEN

;07500  1543		FOR$$SIG_DATCOR ();

;07600  1544	

;07700  1545	    !+

;07800  1546	    ! Pop current LUB/ISB/RAB and restore previous LUB/ISB/RAB to OTS$$AA_CUR_LUB

;07900  1547	    ! But don't set CCB to 0 yet (in order to catch attempts to access after pop).

;08000  1548	    !-

;08100  1549	

;08200  1550	    OTS$$A_CUR_LUB = .CCB[ISB$A_PUSH_LUB];

;08300  1551	    END;		! end of duplicate FOR$$CB_POP code (except CCB = 0)

;08400  1552	

;08500  1553	    !+

;08600  1554	    ! Now deallocate storage for old current LUB/ISB/RAB

;08700  1555	    ! SIGNAL_STOP OTS$_FATINTERR if error returning virtual memory.

;08800  1556	    !-

;08900  1557	

;09000  1558	    FOR$$FREE_VM (K_TOTAL_CCB_LEN, .CCB - (ISB$K_ISB_LEN + LUB$K_LUB_LEN));

;09100  1559	

;09200  1560	    !+

;09300  1561	    ! Finally clear CCB (to catch inadvertant references after LUB/ISB/RAB deallocated).

;09400  1562	    !-

;09500  1563	

;09600  1564	    CCB = 0;

;09700  1565	

;09800  1566	    RETURN;		! return from FOR$$CB_RET

;09900  1567	    END;		! end of FOR$$CB_RET routine











		         50 	  F6   AB  98 000AE FOR$$CB_RET::

							    CVTBL   -10(CCB), R0					      ; 1524

			    00000000'EF40  D4 000B2 	    CLRL    OTS$$AA_LUB_TAB+16[R0]				      ;

	   05 	    FC   AB	       01  E4 000B9 	    BBSC    #1, -4(CCB), 1$					      ; 1541

		  0000G  CF	       00  FB 000BE 	    CALLS   #0, FOR$$SIG_DATCOR					      ; 1543

	      00000000'  EF	  A8   AB  D0 000C3 1$:     MOVL    -88(CCB), OTS$$A_CUR_LUB				      ; 1550



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 7-2

;

				  84   AB  9F 000CB 	    PUSHAB  -124(CCB)						      ; 1558

		         7E 	  C0   8F  9A 000CE 	    MOVZBL  #192, -(SP)						      ;

		  0000G  CF	       02  FB 000D2 	    CALLS   #2, FOR$$FREE_VM					      ;

				       5B  D4 000D7 	    CLRL    CCB							      ; 1564

					   05 000D9 	    RSB     							      ; 1469



; Routine Size:  44 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 8

;

;00100  1568	GLOBAL ROUTINE FOR$$CB_GET	! GET current LUB/ISB/RAB - called only from non-shared code

;00200  1569		: JSB_CB_GET NOVALUE =

;00300  1570	

;00400  1571	!++

;00500  1572	! FUNCTIONAL DESCRIPTION:

;00600  1573	!

;00700  1574	!	FOR$$CB_GET gets the curents LUB/ISB/RAB.

;00800  1575	!	This routine is only called from non-shared procedures which

;00900  1576	!	can't access OTS$$A_CUR_LUB directly.  (Entry vectors for

;01000  1577	!	data would mean that the code would have to change when the

;01100  1578	!	decision to make a module shared or non-shared is changed.

;01200  1579	!	Unless the LINKER got smarter and changed the level of indirection

;01300  1580	!	on data references which were vectored.)

;01400  1581	!

;01500  1582	! CALLING SEQUENCE:

;01600  1583	!

;01700  1584	!	JSB FOR$$CB_GET ()

;01800  1585	!

;01900  1586	! FORMAL PARAMETERS:

;02000  1587	!

;02100  1588	!	NONE

;02200  1589	!

;02300  1590	! IMPLICIT INPUTS:

;02400  1591	!

;02500  1592	!	OTS$$A_CUR_LUB		Adr. of current LUB/ISB/RAB

;02600  1593	!

;02700  1594	! IMPLICIT OUTPUTS:

;02800  1595	!

;02900  1596	!	CCB			Set to adr. of current LUB/ISB/RAB.

;03000  1597	!

;03100  1598	! COMPLETION CODES:

;03200  1599	! RETURN VALUE:

;03300  1600	!

;03400  1601	!	NONE

;03500  1602	!

;03600  1603	! SIDE EFFECTS:

;03700  1604	!

;03800  1605	!	NONE

;03900  1606	!--

;04000  1607	

;04100  1608	    BEGIN

;04200  1609	

;04300  1610	    EXTERNAL REGISTER

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

;04500  1612	

;04600  1613	    CCB = .OTS$$A_CUR_LUB;

;04700  1614	    RETURN

;04800  1615	    END;		! End of FOR$$CB_GET routine











		         5B 00000000'  EF  D0 000DA FOR$$CB_GET::

							    MOVL    OTS$$A_CUR_LUB, CCB					      ; 1613



; Bliss-32 10.1-416	Monday 21-AUG-1978 19:14:10	DBB3:[RTL.SRC]FCB.B32;17					Page 8-1

;

					   05 000E1 	    RSB     							      ; 1568



; Routine Size:  8 bytes





;00200  1617	END			!End of module FOR$$CB

;00300  1618	ELUDOM













;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

;  FOR$DATA       	   420    WRT,  RD ,NOEXE,NOSHR,  LCL,  REL,  CON,  PIC,ALIGN(2)

;  FOR$CODE       	   226  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         9         0       110











; Size:		226 code + 420 data bytes

; Run Time:	00:12.4

; Elapsed Time:	00:27.4

; Memory Used:	192 pages

; Compilation Complete

