

; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 1

;

;	0001	MODULE CLENUP (

;	0002			LANGUAGE (BLISS32),

;	0003			IDENT = 'A0024'

;	0004			) =

;	0005	BEGIN

;	0006	

;	0007	!

;	0008	! Copyright (c) 1977

;	0009	! Digital Equipment Corporation, Maynard, Massachusetts 01754

;	0010	!

;	0011	! This software is furnished  under a license for use only on a single

;	0012	! computer  system and  may be  copied only with  the inclusion of the

;	0013	! above copyright notice.  This software, or any other copies thereof,

;	0014	! may not be provided or  otherwise made available to any other person

;	0015	! except for use on such system and to one who agrees to these license

;	0016	! terms.  Title to and  ownership of the  software  shall at all times

;	0017	! remain in DEC.

;	0018	!

;	0019	! The information in this software is subject to change without notice

;	0020	! and should  not be construed  as a commitment  by Digital  Equipment

;	0021	! Corporation.

;	0022	!

;	0023	! DEC assumes  no  responsibility  for  the use or  reliability of its

;	0024	! software on equipment which is not supplied by DEC.

;	0025	

;	0026	!++

;	0027	!

;	0028	! FACILITY:  F11ACP Structure Level 1

;	0029	!

;	0030	! ABSTRACT:

;	0031	!

;	0032	!	This module performs the necessary cleanup after an operation.

;	0033	!

;	0034	! ENVIRONMENT:

;	0035	!

;	0036	!	STARLET operating system, including privileged system services

;	0037	!	and internal exec routines.

;	0038	!

;	0039	!--

;	0040	!

;	0041	!

;	0042	! AUTHOR:  Andrew C. Goldstein,	 CREATION DATE:  6-Jan-1977  23:53

;	0043	!

;	0044	! REVISION HISTORY:

;	0045	!

;	0046	!   Andrew C. Goldstein, 16-Feb-1977  14:51

;	0047	!   X0002 - Modify for condition handling

;	0048	!

;	0049	!   Andrew C. Goldstein, 25-Feb-1977  15:59

;	0050	!   X0003 - Add extend cleanup logic

;	0051	!

;	0052	!   Andrew C. Goldstein, 3-Mar-1977  13:39

;	0053	!   X0004 - Modify to run in exec mode

;	0054	!

;	0055	!   Andrew C. Goldstein, 23-Mar-1977  14:55



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 1-1

;

;	0056	!   X0005 - Add extend and truncate error logic

;	0057	!

;	0058	!   Andrew C. Goldstein, 4-Apr-1977  17:05

;	0059	!   X0006 - Add create cleanup and deletion logic

;	0060	!

;	0061	!   Andrew C. Goldstein, 6-Apr-1977  13:18

;	0062	!   X0007 - Add directory operation cleanups

;	0063	!

;	0064	!   Andrew C. Goldstein, 7-Apr-1977  13:11

;	0065	!   X0008 - Add create-enter-supersede cleanup logic

;	0066	!

;	0067	!   Andrew C. Goldstein, 14-Apr-1977  10:36

;	0068	!   X0009 - Repeat error cleanup for primary and secondary context

;	0069	!

;	0070	!   Andrew C. Goldstein, 19-Apr-1977  11:38

;	0071	!   X0010 - Globalize ZERO_WINDOWS, add header invalidation

;	0072	!

;	0073	!   Andrew C. Goldstein, 20-Apr-1977  13:17

;	0074	!   X0011 - Add buffer pool interlock logic

;	0075	!

;	0076	!   Andrew C. Goldstein, 22-Apr-1977  13:33

;	0077	!   X0012 - Update process file quota on DEACCESS

;	0078	!

;	0079	!   Andrew C. Goldstein, 23-May-1977  15:47

;	0080	!   X0013 - Read original file header for create cleanup

;	0081	!

;	0082	!   Andrew C. Goldstein, 10-Aug-1977  18:08

;	0083	!   X0014 - Rework deallocation of window

;	0084	!

;	0085	!   Andrew C. Goldstein, 13-Jul-1977  15:16

;	0086	!   X0015 - Checksum file header when necessary

;	0087	!

;	0088	!   Andrew C. Goldstein, 11-Aug-1977  14:39

;	0089	!   X0016 - Add multi-header file support

;	0090	!

;	0091	!   Andrew C. Goldstein, 26-Aug-1977  10:29

;	0092	!   X0017 - Add performance metering

;	0093	!

;	0094	!   Andrew C. Goldstein, 12-Dec-1977  13:11

;	0095	!   X0018 - file ID interface changes

;	0096	!

;	0097	!   Andrew C. Goldstein, 14-Dec-1977  12:50

;	0098	!   X0019 - Maintain open file count in system data base

;	0099	!

;	0100	!   Andrew C. Goldstein, 6-Jan-1978  22:07

;	0101	!   X0020 - Fix EOF in FCB on multi-header cleanup

;	0102	!

;	0103	!   Andrew C. Goldstein, 21-Jan-1978  19:43

;	0104	!   X0021 - Make all kernel routines return 1 if nothing else

;	0105	!

;	0106	!   Andrew C. Goldstein, 23-APR-78  19:49

;	0107	!   X0022 - Add multi-block arg to DIRGET

;	0108	!

;	0109	!   Andrew C. Goldstein, 12-Jun-78  20:54

;	0110	!   A0023 - PCB vector name change



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 1-2

;

;	0111	!

;	0112	!   Andrew C. Goldstein, 21-Jun-78  17:05

;	0113	!   A0024 - Add truncate interlock, move superseded file ID

;	0114	!

;	0115	!**

;	0116	

;	0117	

;	0118	LIBRARY 'SYS$LIBRARY:LIB.L32';

;	0119	REQUIRE 'SRC$:FCPDEF.B32';

;	0438	

;	0439	

;	0440	FORWARD ROUTINE

;	0441		CLEANUP,			! normal cleanup

;	0442		ZERO_WINDOWS,			! invalidate all windows of file

;	0443		ERR_CLEANUP,			! cleanup after error

;	0444		MAKE_DEACCESS,			! deaccess the file

;	0445		DEL_EXTFCB,			! deallocate extension FCB's

;	0446		ZERO_CHANNEL;			! zero user channel pointer



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 2

;

;	0447	GLOBAL ROUTINE CLEANUP =

;	0448	

;	0449	!++

;	0450	!

;	0451	! FUNCTIONAL DESCRIPTION:

;	0452	!

;	0453	!	This routine performs the cleanup needed after a successfully

;	0454	!	completed file operation.

;	0455	!

;	0456	! CALLING SEQUENCE:

;	0457	!	CLEANUP ()

;	0458	!

;	0459	! INPUT PARAMETERS:

;	0460	!	NONE

;	0461	!

;	0462	! IMPLICIT INPUTS:

;	0463	!	CLEANUP_FLAGS: indicate specific actions to do

;	0464	!	PRIMARY_FCB: FCB of file

;	0465	!	CURRENT_WINDOW: window of file

;	0466	!	DIR_FCB: FCB of directory

;	0467	!	DIR_WINDOW: window of directory

;	0468	!	CURRENT_VCB: VCB of volume in process

;	0469	!	IO_PACKET: I/O packet of request

;	0470	!

;	0471	! OUTPUT PARAMETERS:

;	0472	!	NONE

;	0473	!

;	0474	! IMPLICIT OUTPUTS:

;	0475	!	NONE

;	0476	!

;	0477	! ROUTINE VALUE:

;	0478	!	NONE

;	0479	!

;	0480	! SIDE EFFECTS:

;	0481	!	FCB's and windows deleted when appropriate

;	0482	!	header written

;	0483	!	FCB updated

;	0484	!

;	0485	!--

;	0486	

;	0487	BEGIN

;	0488	

;	0489	LOCAL

;	0490		HEADER		: REF BBLOCK;	! file header

;	0491	

;	0492	EXTERNAL

;	0493		CONTEXT_START,			! start of cleanup context area

;	0494		CONTEXT_SAVE,			! start of context save area

;	0495		CLEANUP_FLAGS	: BITVECTOR,	! cleanup action flags

;	0496		FILE_HEADER	: REF BBLOCK,	! address of last file header read

;	0497		CURRENT_FIB	: REF BBLOCK,	! address of current FIB in use

;	0498		PRIMARY_FCB	: REF BBLOCK,	! FCB of file

;	0499		CURRENT_WINDOW	: REF BBLOCK,	! window of file

;	0500		DIR_FCB		: REF BBLOCK,	! FCB of directory

;	0501		DIR_WINDOW	: REF BBLOCK,	! window of directory



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 2-1

;

;	0502		CURRENT_VCB	: REF BBLOCK,	! VCB of volume

;	0503		IO_PACKET	: REF BBLOCK;	! I/O packet in process

;	0504	

;	0505	EXTERNAL LITERAL

;	0506		CONTEXT_SIZE;			! length of context area

;	0507	

;	0508	EXTERNAL ROUTINE

;	0509		FLUSH_BUFFERS,			! write all dirty buffers

;	0510		FLUSH_FID,			! flush a file from buffer pool

;	0511		READ_HEADER,			! read file header

;	0512		INIT_FCB,			! initialize FCB

;	0513		DEALLOCATE;			! deallocate dynamic memory

;	0514	

;	0515	

;	0516	! Switch back to the primary context area if necessary (no normal cleanup

;	0517	! is ever necessary on secondary context).

;	0518	!

;	0519	

;	0520	IF .CONTEXT_SAVE NEQ 0

;	0521	THEN

;	0522	    BEGIN

;	0523	    CH$MOVE (CONTEXT_SIZE, CONTEXT_SAVE, CONTEXT_START);

;	0524	    CONTEXT_SAVE = 0;

;	0525	    END;

;	0526	

;	0527	! ***** Note: The primary header of the current file is not necessarily

;	0528	! resident at this point.

;	0529	!

;	0530	! If an FCB is left about with no use, dispose of it.

;	0531	!

;	0532	

;	0533	IF .PRIMARY_FCB NEQ 0

;	0534	THEN

;	0535	    BEGIN

;	0536	    IF .PRIMARY_FCB[FCB$W_ACNT] EQL 0

;	0537	    AND NOT .PRIMARY_FCB[FCB$V_DIR]

;	0538	    THEN

;	0539		BEGIN

;	0540		KERNEL_CALL (DEALLOCATE, .PRIMARY_FCB);

;	0541		PRIMARY_FCB = 0;

;	0542		END;

;	0543	    END;

;	0544	

;	0545	! If a directory FCB and window are left about with no use, dispose of them.

;	0546	! If the directory file is write accessed, flush the buffer pool of any

;	0547	! blocks that might be resident.

;	0548	!

;	0549	

;	0550	IF .DIR_FCB NEQ 0

;	0551	THEN

;	0552	    BEGIN

;	0553	    IF .DIR_FCB[FCB$W_ACNT] EQL 0

;	0554	    THEN

;	0555		BEGIN

;	0556		IF NOT .DIR_FCB[FCB$V_DIR]



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 2-2

;

;	0557		THEN

;	0558		    BEGIN

;	0559		    KERNEL_CALL (DEALLOCATE, .DIR_FCB);

;	0560		    DIR_FCB = 0;

;	0561		    END;

;	0562		END

;	0563	    ELSE

;	0564		BEGIN

;	0565		IF .DIR_FCB[FCB$W_WCNT] NEQ 0

;	0566		THEN FLUSH_FID (DIR_FCB[FCB$W_FID]);

;	0567		END;

;	0568	    END;

;	0569	

;	0570	IF .DIR_WINDOW NEQ 0

;	0571	THEN

;	0572	    BEGIN

;	0573	    KERNEL_CALL (DEALLOCATE, .DIR_WINDOW);

;	0574	    DIR_WINDOW = 0;

;	0575	    END;

;	0576	

;	0577	! Invalidate any windows on the file, if requested.

;	0578	!

;	0579	

;	0580	IF TESTBITSC (CLEANUP_FLAGS[CLF_INVWINDOW])

;	0581	AND .PRIMARY_FCB NEQ 0

;	0582	THEN KERNEL_CALL (ZERO_WINDOWS, .PRIMARY_FCB);

;	0583	

;	0584	! If the index file or storage map is write accessed, flush the buffer pool

;	0585	! of any of their blocks.

;	0586	!

;	0587	

;	0588	IF .CURRENT_VCB[VCB$V_WRITE_IF]

;	0589	THEN FLUSH_FID (UPLIT WORD (1, 1, 0));

;	0590	IF .CURRENT_VCB[VCB$V_WRITE_SM]

;	0591	THEN FLUSH_FID (UPLIT WORD (2, 2, 0));

;	0592	

;	0593	! Flush all dirty buffers.

;	0594	!

;	0595	

;	0596	FLUSH_BUFFERS ();

;	0597	

;	0598	RETURN 1;

;	0599	

;	0600	END;					! end of routine CLEANUP





							    .TITLE  CLENUP

							    .IDENT  \A0024\



							    .PSECT  $CODE$,NOWRT,2



			    0000  0001  0001  00000 P.AAA:  .WORD   1, 1, 0						      ;

					      00006	    .BLKB   2

			    0000  0002  0002  00008 P.AAB:  .WORD   2, 2, 0						      ;

					      0000E	    .BLKB   2



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 2-3

;



							    .EXTRN  CONTEXT_START, CONTEXT_SAVE, CLEANUP_FLAGS, FILE_HEADER

							    .EXTRN  CURRENT_FIB, PRIMARY_FCB, CURRENT_WINDOW, DIR_FCB

							    .EXTRN  DIR_WINDOW, CURRENT_VCB, IO_PACKET, CONTEXT_SIZE

							    .EXTRN  FLUSH_BUFFERS, FLUSH_FID, READ_HEADER, INIT_FCB

							    .EXTRN  DEALLOCATE, SYS$CMKRNL



					 07FC 00010 	    .ENTRY  CLEANUP, Save R2,R3,R4,R5,R6,R7,R8,R9,R10		      ; 0447

		         5A 	0000G  CF  9E 00012 	    MOVAB   CONTEXT_SAVE, R10					      ;

		         59 	0000G  CF  9E 00017 	    MOVAB   FLUSH_FID, R9					      ;

		         58 	0000G  CF  9E 0001C 	    MOVAB   DEALLOCATE, R8					      ;

		         57 	0000G  CF  9E 00021 	    MOVAB   PRIMARY_FCB, R7					      ;

		         56 00000000G  9F  9E 00026 	    MOVAB   @#SYS$CMKRNL, R6					      ;

				       6A  D5 0002D 	    TSTL    CONTEXT_SAVE					      ; 0520

				       0A  13 0002F 	    BEQL    1$							      ;

    0000G  CF	         6A 	0000G  8F  28 00031 	    MOVC3   #CONTEXT_SIZE, CONTEXT_SAVE, CONTEXT_START		      ; 0523

				       6A  D4 00039 	    CLRL    CONTEXT_SAVE					      ; 0524

		         50 	       67  D0 0003B 1$:     MOVL    PRIMARY_FCB, R0					      ; 0533

				       16  13 0003E 	    BEQL    2$							      ;

				  18   A0  B5 00040 	    TSTW    24(R0)						      ; 0536

				       11  12 00043 	    BNEQ    2$							      ;

		         0D 	  1E   A0  E8 00045 	    BLBS    30(R0), 2$						      ; 0537

				       50  DD 00049 	    PUSHL   R0							      ; 0540

				       01  DD 0004B 	    PUSHL   #1							      ;

				4100   8F  BB 0004D 	    PUSHR   #^M<R8,SP>						      ;

		         66 	       04  FB 00051 	    CALLS   #4, SYS$CMKRNL					      ;

				       67  D4 00054 	    CLRL    PRIMARY_FCB						      ; 0541

		         50 	0000G  CF  D0 00056 2$:     MOVL    DIR_FCB, R0						      ; 0550

				       25  13 0005B 	    BEQL    4$							      ;

				  18   A0  B5 0005D 	    TSTW    24(R0)						      ; 0553

				       15  12 00060 	    BNEQ    3$							      ;

		         1C 	  1E   A0  E8 00062 	    BLBS    30(R0), 4$						      ; 0556

				       50  DD 00066 	    PUSHL   R0							      ; 0559

				       01  DD 00068 	    PUSHL   #1							      ;

				4100   8F  BB 0006A 	    PUSHR   #^M<R8,SP>						      ;

		         66 	       04  FB 0006E 	    CALLS   #4, SYS$CMKRNL					      ;

				0000G  CF  D4 00071 	    CLRL    DIR_FCB						      ; 0560

				       0B  11 00075 	    BRB     4$							      ; 0553

				  1C   A0  B5 00077 3$:     TSTW    28(R0)						      ; 0565

				       06  13 0007A 	    BEQL    4$							      ;

				  20   A0  9F 0007C 	    PUSHAB  32(R0)						      ; 0566

		         69 	       01  FB 0007F 	    CALLS   #1, FLUSH_FID					      ;

		         50 	0000G  CF  D0 00082 4$:     MOVL    DIR_WINDOW, R0					      ; 0570

				       0F  13 00087 	    BEQL    5$							      ;

				       50  DD 00089 	    PUSHL   R0							      ; 0573

				       01  DD 0008B 	    PUSHL   #1							      ;

				4100   8F  BB 0008D 	    PUSHR   #^M<R8,SP>						      ;

		         66 	       04  FB 00091 	    CALLS   #4, SYS$CMKRNL					      ;

				0000G  CF  D4 00094 	    CLRL    DIR_WINDOW						      ; 0574

	   11 	  0000G  CF	       04  E5 00098 5$:     BBCC    #4, CLEANUP_FLAGS, 6$				      ; 0580

				       67  D5 0009E 	    TSTL    PRIMARY_FCB						      ; 0581

				       0D  13 000A0 	    BEQL    6$							      ;

				       67  DD 000A2 	    PUSHL   PRIMARY_FCB						      ; 0582

				       01  DD 000A4 	    PUSHL   #1							      ;

				       5E  DD 000A6 	    PUSHL   SP							      ;



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 2-4

;

				0000V  CF  9F 000A8 	    PUSHAB  ZERO_WINDOWS					      ;

		         66 	       04  FB 000AC 	    CALLS   #4, SYS$CMKRNL					      ;

		         50 	0000G  CF  D0 000AF 6$:     MOVL    CURRENT_VCB, R0					      ; 0588

		         07 	  0B   A0  E9 000B4 	    BLBC    11(R0), 7$						      ;

				FF44   CF  9F 000B8 	    PUSHAB  P.AAA						      ; 0589

		         69 	       01  FB 000BC 	    CALLS   #1, FLUSH_FID					      ;

		         50 	0000G  CF  D0 000BF 7$:     MOVL    CURRENT_VCB, R0					      ; 0590

	   07 	    0B   A0	       01  E1 000C4 	    BBC     #1, 11(R0), 8$					      ;

				FF3B   CF  9F 000C9 	    PUSHAB  P.AAB						      ; 0591

		         69 	       01  FB 000CD 	    CALLS   #1, FLUSH_FID					      ;

		  0000G  CF	       00  FB 000D0 8$:     CALLS   #0, FLUSH_BUFFERS					      ; 0596

		         50 	       01  D0 000D5 	    MOVL    #1, R0						      ; 0598

					   04 000D8 	    RET     							      ; 0447



; Routine Size:  201 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 3

;

;	0601	GLOBAL ROUTINE ZERO_WINDOWS (FCB) =

;	0602	

;	0603	!++

;	0604	!

;	0605	! FUNCTIONAL DESCRIPTION:

;	0606	!

;	0607	!	This routine invalidates all windows currently in use on the

;	0608	!	indicated FCB. This routine must be executed in kernel mode.

;	0609	!

;	0610	! CALLING SEQUENCE:

;	0611	!	ZERO_WINDOWS (ARG1)

;	0612	!

;	0613	! INPUT PARAMETERS:

;	0614	!	ARG1: address of FCB

;	0615	!

;	0616	! IMPLICIT INPUTS:

;	0617	!	CURRENT_WINDOW: address of caller's window, if any

;	0618	!

;	0619	! OUTPUT PARAMETERS:

;	0620	!	NONE

;	0621	!

;	0622	! IMPLICIT OUTPUTS:

;	0623	!	NONE

;	0624	!

;	0625	! ROUTINE VALUE:

;	0626	!	NONE

;	0627	!

;	0628	! SIDE EFFECTS:

;	0629	!	all windows marked empty, caller's turned

;	0630	!

;	0631	!--

;	0632	

;	0633	BEGIN

;	0634	

;	0635	MAP

;	0636		FCB		: REF BBLOCK;

;	0637	

;	0638	LOCAL

;	0639		P		: REF BBLOCK;	! window pointer

;	0640	

;	0641	

;	0642	! Loop through the window list off the FCB, zeroing all the retrieval pointer

;	0643	! counts. Then turn the user's window to VBN 1 if it exists.

;	0644	!

;	0645	

;	0646	P = .FCB[FCB$L_WLFL];

;	0647	

;	0648	UNTIL .P EQL FCB[FCB$L_WLFL] DO

;	0649	    BEGIN

;	0650	    P[WCB$W_NMAP] = 0;

;	0651	    P = .P[WCB$L_WLFL];

;	0652	    END;

;	0653	

;	0654	! ***** Note: When handling of window misses goes into its final form,

;	0655	! this routine must also scan the I/O queue on the UCB and look for I/O



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 3-1

;

;	0656	! into the blocks just deallocated. All such requests must be yanked out

;	0657	! of the queue and routed to the ACP for error processing.

;	0658	

;	0659	RETURN 1;

;	0660	

;	0661	END;					! end of routine ZERO_WINDOWS











					 0004 000D9 	    .ENTRY  ZERO_WINDOWS, Save R2				      ; 0601

		         51 	  04   AC  D0 000DB 	    MOVL    FCB, R1						      ; 0646

		         50 	  10   A1  D0 000DF 	    MOVL    16(R1), P						      ;

		         52 	  10   A1  9E 000E3 1$:     MOVAB   16(R1), R2						      ; 0648

		         52 	       50  D1 000E7 	    CMPL    P, R2						      ;

				       08  13 000EA 	    BEQL    2$							      ;

				  16   A0  B4 000EC 	    CLRW    22(P)						      ; 0650

		         50 	       60  D0 000EF 	    MOVL    (P), P						      ; 0651

				       EF  11 000F2 	    BRB     1$							      ; 0648

		         50 	       01  D0 000F4 2$:     MOVL    #1, R0						      ; 0659

					   04 000F7 	    RET     							      ; 0601



; Routine Size:  31 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 4

;

;	0662	GLOBAL ROUTINE ERR_CLEANUP =

;	0663	

;	0664	!++

;	0665	!

;	0666	! FUNCTIONAL DESCRIPTION:

;	0667	!

;	0668	!	This routine performs the cleanup needed after a file

;	0669	!	operation that has terminated in an error.

;	0670	!

;	0671	! CALLING SEQUENCE:

;	0672	!	ERR_CLEANUP ()

;	0673	!

;	0674	! INPUT PARAMETERS:

;	0675	!	NONE

;	0676	!

;	0677	! IMPLICIT INPUTS:

;	0678	!	CLEANUP_FLAGS: indicate specific actions to do

;	0679	!

;	0680	! OUTPUT PARAMETERS:

;	0681	!	NONE

;	0682	!

;	0683	! IMPLICIT OUTPUTS:

;	0684	!	NONE

;	0685	!

;	0686	! ROUTINE VALUE:

;	0687	!	NONE

;	0688	!

;	0689	! SIDE EFFECTS:

;	0690	!	file deaccessed if necessary

;	0691	!	channel window pointer cleared

;	0692	!

;	0693	!--

;	0694	

;	0695	BEGIN

;	0696	

;	0697	EXTERNAL

;	0698		PMS_SUB_NEST,			! depth count on subfunction metering

;	0699		CONTEXT_START,			! start of active context area

;	0700		CONTEXT_SAVE,			! start of context save area

;	0701		CLEANUP_FLAGS	: BITVECTOR,	! cleanup action flags

;	0702		UNREC_COUNT,			! count of unrecorded but allocated blocks

;	0703		UNREC_LBN,			! LBN of above

;	0704		NEW_FID,			! file number of unrecorded file ID

;	0705		USER_STATUS	: VECTOR,	! user I/O status block

;	0706		SUPER_FID	: BBLOCK,	! file ID of superseded file

;	0707		SECOND_FIB	: BBLOCK,	! FIB for secondary file operation

;	0708		CURRENT_FIB	: REF BBLOCK,	! pointer to FIB currently in use

;	0709		FILE_HEADER	: REF BBLOCK,	! current file header

;	0710		PRIMARY_FCB	: REF BBLOCK,	! FCB of this file

;	0711		CURRENT_WINDOW	: REF BBLOCK,	! window for this file

;	0712		DIR_RECORD;			! record number of directory entry

;	0713	

;	0714	EXTERNAL LITERAL

;	0715		CONTEXT_SIZE;			! length of context area

;	0716	



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 4-1

;

;	0717	EXTERNAL ROUTINE

;	0718		PMS_END_SUB,			! end metering of current subfunction

;	0719		DEALLOCATE,			! deallocate dynamic memory

;	0720		DIRGET,				! read directory record

;	0721		DIRPUT,				! write directory record

;	0722		DELETE_FILE,			! delete a file

;	0723		DELETE_FID,			! delete a file number

;	0724		RETURN_BLOCKS,			! return blocks to storage map

;	0725		TRUNCATE,			! file truncate routine

;	0726		INVALIDATE,			! invalidate a buffer

;	0727		READ_HEADER,			! read file header

;	0728		INIT_FCB,			! initialize FCB

;	0729		UPDATE_FCB,			! update FCB contents

;	0730		NEXT_HEADER,			! read next extension file header

;	0731		MAKE_EXTFCB,			! create extension FCB

;	0732		CHECKSUM;			! checksum file header

;	0733	

;	0734	

;	0735	! If a subfunction was being executed, turn off metering now.

;	0736	!

;	0737	

;	0738	IF .PMS_SUB_NEST NEQ 0

;	0739	THEN

;	0740	    BEGIN

;	0741	    PMS_SUB_NEST = 1;

;	0742	    PMS_END_SUB ();

;	0743	    END;

;	0744	

;	0745	! We repeat the entire procedure twice if a secondary file operation was

;	0746	! in progress (indicated by non-zero saved context).

;	0747	!

;	0748	

;	0749	WHILE 1 DO

;	0750	BEGIN

;	0751	

;	0752	! Locals are declared here to prevent their scope from extending around the

;	0753	! entire main loop and raising havoc with register assignment.

;	0754	!

;	0755	

;	0756	LOCAL

;	0757		HEADER		: REF BBLOCK,	! address of file header

;	0758		FCB		: REF BBLOCK,	! FCB pointer

;	0759		RECADDR		: REF BBLOCK,	! address of directory record

;	0760		T1,				! random temps

;	0761		T2,

;	0762		T3;

;	0763	

;	0764	! Deaccess the file if requested.

;	0765	!

;	0766	

;	0767	IF TESTBITSC (CLEANUP_FLAGS[CLF_DEACCESS])

;	0768	THEN KERNEL_CALL (MAKE_DEACCESS);

;	0769	

;	0770	! Deallocate the window block if called for.

;	0771	!



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 4-2

;

;	0772	

;	0773	IF TESTBITSC (CLEANUP_FLAGS[CLF_DELWINDOW])

;	0774	THEN

;	0775	    IF .CURRENT_WINDOW NEQ 0

;	0776	    THEN

;	0777		BEGIN

;	0778		KERNEL_CALL (DEALLOCATE, .CURRENT_WINDOW);

;	0779		CURRENT_WINDOW = 0;

;	0780		END;

;	0781	

;	0782	! Clean out the window pointer in the user's channel if necessary.

;	0783	!

;	0784	

;	0785	IF TESTBITSC (CLEANUP_FLAGS[CLF_ZCHANNEL])

;	0786	THEN KERNEL_CALL (ZERO_CHANNEL);

;	0787	

;	0788	! If there is a file header resident, it probably needs to be checksummed,

;	0789	! except in the case of a failed truncate, where we discard the header.

;	0790	! Then read back the primary file header.

;	0791	!

;	0792	

;	0793	IF .FILE_HEADER NEQ 0

;	0794	THEN

;	0795	    BEGIN

;	0796	    IF .CLEANUP_FLAGS[CLF_CLEANTRUNC]

;	0797	    THEN INVALIDATE (.FILE_HEADER)

;	0798	    ELSE CHECKSUM (.FILE_HEADER);

;	0799	    HEADER = READ_HEADER (CURRENT_FIB[FIB$W_FID], .PRIMARY_FCB);

;	0800	    END;

;	0801	

;	0802	! If a directory entry needs to be re-entered, do so.

;	0803	!

;	0804	

;	0805	IF TESTBITSC (CLEANUP_FLAGS[CLF_REENTER])

;	0806	THEN

;	0807	    BEGIN

;	0808	    RECADDR = DIRGET (.DIR_RECORD, 0);

;	0809	    CH$MOVE (FIB$S_FID, SUPER_FID, RECADDR[NMB$W_FID]);

;	0810	    DIRPUT (.RECADDR);

;	0811	    CLEANUP_FLAGS[CLF_REMOVE] = 0;

;	0812	    END;

;	0813	

;	0814	! If a directory entry needs to be removed, do so.

;	0815	!

;	0816	

;	0817	IF TESTBITSC (CLEANUP_FLAGS[CLF_REMOVE])

;	0818	THEN

;	0819	    BEGIN

;	0820	    RECADDR = DIRGET (.DIR_RECORD, 0);

;	0821	    RECADDR[NMB$W_FID_NUM] = 0;

;	0822	    DIRPUT (.RECADDR);

;	0823	    END;

;	0824	

;	0825	! If there are unrecorded blocks allocated from the storage map, return them.

;	0826	!



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 4-3

;

;	0827	

;	0828	IF .UNREC_COUNT NEQ 0

;	0829	THEN

;	0830	    BEGIN

;	0831	    RETURN_BLOCKS (.UNREC_LBN, .UNREC_COUNT);

;	0832	    UNREC_COUNT = 0;

;	0833	    END;

;	0834	

;	0835	! If a file deletion is called for, do it. This is either a create that

;	0836	! failed later on, or a real delete.

;	0837	!

;	0838	

;	0839	IF TESTBITSC (CLEANUP_FLAGS[CLF_DELFILE])

;	0840	THEN

;	0841	    BEGIN

;	0842	    CLEANUP_FLAGS[CLF_TRUNCATE] = 0;	! no truncate necessary after a delete

;	0843	    CLEANUP_FLAGS[CLF_DELFID] = 0;	! leave header behind if failure

;	0844	    DELETE_FILE (.CURRENT_FIB, .HEADER);

;	0845	    END;

;	0846	

;	0847	! If an extend operation failed, truncate the file.

;	0848	!

;	0849	

;	0850	IF TESTBITSC (CLEANUP_FLAGS[CLF_TRUNCATE])

;	0851	THEN

;	0852	    BEGIN

;	0853	    T1 = .CURRENT_FIB[FIB$L_EXSZ];	! save the data returned by EXTEND

;	0854	    T2 = .CURRENT_FIB[FIB$L_EXVBN];	! so it won't be smashed by TRUNCATE

;	0855	    T3 = .USER_STATUS[1];

;	0856	    CURRENT_FIB[FIB$L_EXSZ] = 0;

;	0857	    TRUNCATE (.CURRENT_FIB, .HEADER, DEALLOC_BLOCKS);

;	0858	    HEADER = .FILE_HEADER;			! follow buffer shuffling

;	0859	    CURRENT_FIB[FIB$L_EXSZ] = .T1;

;	0860	    CURRENT_FIB[FIB$L_EXVBN] = .T2;

;	0861	    USER_STATUS[1] = .T3;

;	0862	    CLEANUP_FLAGS[CLF_INVWINDOW] = 0;	! windows were never extended, so no need

;	0863	    CLEANUP_FLAGS[CLF_CLEANTRUNC] = 0;

;	0864	    CHECKSUM (.HEADER);

;	0865	    END;

;	0866	

;	0867	! If a truncate has failed, redo the operation to produce a correct file

;	0868	! header, but don't return blocks to the storage map. We assume the header

;	0869	! was nfg and contained bogus retrieval pointers.

;	0870	!

;	0871	

;	0872	IF TESTBITSC (CLEANUP_FLAGS[CLF_CLEANTRUNC])

;	0873	THEN

;	0874	    BEGIN

;	0875	    CURRENT_FIB[FIB$L_EXSZ] = 0;

;	0876	    TRUNCATE (.CURRENT_FIB, .HEADER, 0);

;	0877	    HEADER = .FILE_HEADER;			! follow buffer shuffling

;	0878	    END;

;	0879	

;	0880	! Various errors leave the file control block screwed up. If needed,

;	0881	! rebuild it and its extensions from scratch.



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 4-4

;

;	0882	!

;	0883	

;	0884	IF TESTBITSC (CLEANUP_FLAGS[CLF_FIXFCB])

;	0885	AND .PRIMARY_FCB NEQ 0

;	0886	THEN

;	0887	    IF .PRIMARY_FCB[FCB$V_DIR]

;	0888	    OR .PRIMARY_FCB[FCB$W_ACNT] NEQ 0

;	0889	    THEN

;	0890		BEGIN

;	0891		FCB = .PRIMARY_FCB;

;	0892		KERNEL_CALL (DEL_EXTFCB, .FCB);

;	0893		KERNEL_CALL (INIT_FCB, .FCB, .HEADER);

;	0894		WHILE 1 DO

;	0895		    BEGIN

;	0896		    HEADER = NEXT_HEADER (.HEADER, .FCB);

;	0897		    IF .HEADER EQL 0 THEN EXITLOOP;

;	0898		    FCB = KERNEL_CALL (MAKE_EXTFCB, .HEADER, .FCB, 1);

;	0899		    END;

;	0900		IF .FCB NEQ .PRIMARY_FCB

;	0901		THEN

;	0902		    BEGIN

;	0903		    HEADER = READ_HEADER (0, .PRIMARY_FCB);

;	0904		    KERNEL_CALL (UPDATE_FCB, .HEADER);

;	0905		    END;

;	0906		END;

;	0907	

;	0908	! If there is a dangling file ID (from a partial create or header extension),

;	0909	! dispose of it.

;	0910	!

;	0911	

;	0912	IF .NEW_FID NEQ 0

;	0913	THEN DELETE_FID (.NEW_FID);

;	0914	

;	0915	! Copy the saved context, if any back into the primary context and repeat

;	0916	! the cleanup.

;	0917	!

;	0918	

;	0919	IF .CONTEXT_SAVE EQL 0 THEN EXITLOOP;

;	0920	CH$MOVE (CONTEXT_SIZE, CONTEXT_SAVE, CONTEXT_START);

;	0921	CONTEXT_SAVE = 0;

;	0922	

;	0923	END;					! end of major loop

;	0924	

;	0925	RETURN 1;

;	0926	

;	0927	END;					! end of routine ERR_CLEANUP







							    .EXTRN  PMS_SUB_NEST, UNREC_COUNT, UNREC_LBN, NEW_FID

							    .EXTRN  USER_STATUS, SUPER_FID, SECOND_FIB, DIR_RECORD

							    .EXTRN  PMS_END_SUB, DIRGET, DIRPUT, DELETE_FILE, DELETE_FID

							    .EXTRN  RETURN_BLOCKS, TRUNCATE, INVALIDATE, UPDATE_FCB

							    .EXTRN  NEXT_HEADER, MAKE_EXTFCB, CHECKSUM





; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 4-5

;

					 0FFC 000F8 	    .ENTRY  ERR_CLEANUP, Save R2,R3,R4,R5,R6,R7,R8,R9,R10,R11	      ; 0662

		         5B 	0000G  CF  9E 000FA 	    MOVAB   CURRENT_FIB, R11					      ;

		         5A 	0000G  CF  9E 000FF 	    MOVAB   PRIMARY_FCB, R10					      ;

		         59 	0000G  CF  9E 00104 	    MOVAB   CLEANUP_FLAGS, R9					      ;

		         58 00000000G  9F  9E 00109 	    MOVAB   @#SYS$CMKRNL, R8					      ;

				0000G  CF  D5 00110 	    TSTL    PMS_SUB_NEST					      ; 0738

				       0A  13 00114 	    BEQL    1$							      ;

		  0000G  CF	       01  D0 00116 	    MOVL    #1, PMS_SUB_NEST					      ; 0741

		  0000G  CF	       00  FB 0011B 	    CALLS   #0, PMS_END_SUB					      ; 0742

	   0B 	         69 	       10  E5 00120 1$:     BBCC    #16, CLEANUP_FLAGS, 2$				      ; 0767

				       7E  D4 00124 	    CLRL    -(SP)						      ; 0768

				       5E  DD 00126 	    PUSHL   SP							      ;

				0000V  CF  9F 00128 	    PUSHAB  MAKE_DEACCESS					      ;

		         68 	       03  FB 0012C 	    CALLS   #3, SYS$CMKRNL					      ;

	   18 	         69 	       1A  E5 0012F 2$:     BBCC    #26, CLEANUP_FLAGS, 3$				      ; 0773

		         50 	0000G  CF  D0 00133 	    MOVL    CURRENT_WINDOW, R0					      ; 0775

				       11  13 00138 	    BEQL    3$							      ;

				       50  DD 0013A 	    PUSHL   R0							      ; 0778

				       01  DD 0013C 	    PUSHL   #1							      ;

				       5E  DD 0013E 	    PUSHL   SP							      ;

				0000G  CF  9F 00140 	    PUSHAB  DEALLOCATE						      ;

		         68 	       04  FB 00144 	    CALLS   #4, SYS$CMKRNL					      ;

				0000G  CF  D4 00147 	    CLRL    CURRENT_WINDOW					      ; 0779

	   0B 	         69 	       11  E5 0014B 3$:     BBCC    #17, CLEANUP_FLAGS, 4$				      ; 0785

				       7E  D4 0014F 	    CLRL    -(SP)						      ; 0786

				       5E  DD 00151 	    PUSHL   SP							      ;

				0000V  CF  9F 00153 	    PUSHAB  ZERO_CHANNEL					      ;

		         68 	       03  FB 00157 	    CALLS   #3, SYS$CMKRNL					      ;

		         50 	0000G  CF  D0 0015A 4$:     MOVL    FILE_HEADER, R0					      ; 0793

				       23  13 0015F 	    BEQL    7$							      ;

	   09 	    02   A9	       03  E1 00161 	    BBC     #3, CLEANUP_FLAGS+2, 5$				      ; 0796

				       50  DD 00166 	    PUSHL   R0							      ; 0797

		  0000G  CF	       01  FB 00168 	    CALLS   #1, INVALIDATE					      ;

				       07  11 0016D 	    BRB     6$							      ; 0796

				       50  DD 0016F 5$:     PUSHL   R0							      ; 0798

		  0000G  CF	       01  FB 00171 	    CALLS   #1, CHECKSUM					      ;

				       6A  DD 00176 6$:     PUSHL   PRIMARY_FCB						      ; 0799

	   7E 	         6B 	       04  C1 00178 	    ADDL3   #4, CURRENT_FIB, -(SP)				      ;

		  0000G  CF	       02  FB 0017C 	    CALLS   #2, READ_HEADER					      ;

		         57 	       50  D0 00181 	    MOVL    R0, HEADER						      ;

	   20 	         69 	       17  E5 00184 7$:     BBCC    #23, CLEANUP_FLAGS, 8$				      ; 0805

				       7E  D4 00188 	    CLRL    -(SP)						      ; 0808

				0000G  CF  DD 0018A 	    PUSHL   DIR_RECORD						      ;

		  0000G  CF	       02  FB 0018E 	    CALLS   #2, DIRGET						      ;

		         56 	       50  D0 00193 	    MOVL    R0, RECADDR						      ;

	   66 	  0000G  CF	       06  28 00196 	    MOVC3   #6, SUPER_FID, (RECADDR)				      ; 0809

				       56  DD 0019C 	    PUSHL   RECADDR						      ; 0810

		  0000G  CF	       01  FB 0019E 	    CALLS   #1, DIRPUT						      ;

		    02   A9	  40   8F  8A 001A3 	    BICB2   #64, CLEANUP_FLAGS+2				      ; 0811

	   17 	         69 	       16  E5 001A8 8$:     BBCC    #22, CLEANUP_FLAGS, 9$				      ; 0817

				       7E  D4 001AC 	    CLRL    -(SP)						      ; 0820

				0000G  CF  DD 001AE 	    PUSHL   DIR_RECORD						      ;

		  0000G  CF	       02  FB 001B2 	    CALLS   #2, DIRGET						      ;

		         56 	       50  D0 001B7 	    MOVL    R0, RECADDR						      ;

				       66  B4 001BA 	    CLRW    (RECADDR)						      ; 0821



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 4-6

;

				       56  DD 001BC 	    PUSHL   RECADDR						      ; 0822

		  0000G  CF	       01  FB 001BE 	    CALLS   #1, DIRPUT						      ;

		         50 	0000G  CF  D0 001C3 9$:     MOVL    UNREC_COUNT, R0					      ; 0828

				       0F  13 001C8 	    BEQL    10$							      ;

				       50  DD 001CA 	    PUSHL   R0							      ; 0831

				0000G  CF  DD 001CC 	    PUSHL   UNREC_LBN						      ;

		  0000G  CF	       02  FB 001D0 	    CALLS   #2, RETURN_BLOCKS					      ;

				0000G  CF  D4 001D5 	    CLRL    UNREC_COUNT						      ; 0832

	   0D 	         69 	       15  E5 001D9 10$:    BBCC    #21, CLEANUP_FLAGS, 11$				      ; 0839

		    02   A9	       14  8A 001DD 	    BICB2   #20, CLEANUP_FLAGS+2				      ; 0843

				       57  DD 001E1 	    PUSHL   HEADER						      ; 0844

				       6B  DD 001E3 	    PUSHL   CURRENT_FIB						      ;

		  0000G  CF	       02  FB 001E5 	    CALLS   #2, DELETE_FILE					      ;

	   39 	         69 	       12  E5 001EA 11$:    BBCC    #18, CLEANUP_FLAGS, 12$				      ; 0850

		         50 	       6B  D0 001EE 	    MOVL    CURRENT_FIB, R0					      ; 0853

		         52 	  18   A0  7D 001F1 	    MOVQ    24(R0), T1						      ;

		         54 	0000G  CF  D0 001F5 	    MOVL    USER_STATUS+4, T3					      ; 0855

				  18   A0  D4 001FA 	    CLRL    24(R0)						      ; 0856

				       01  DD 001FD 	    PUSHL   #1							      ; 0857

				0081   8F  BB 001FF 	    PUSHR   #^M<R0,R7>						      ;

		  0000G  CF	       03  FB 00203 	    CALLS   #3, TRUNCATE					      ;

		         57 	0000G  CF  D0 00208 	    MOVL    FILE_HEADER, HEADER					      ; 0858

		         50 	       6B  D0 0020D 	    MOVL    CURRENT_FIB, R0					      ; 0859

		    18   A0	       52  7D 00210 	    MOVQ    T1, 24(R0)						      ;

		  0000G  CF	       54  D0 00214 	    MOVL    T3, USER_STATUS+4					      ; 0861

		         69 00080010   8F  CA 00219 	    BICL2   #524304, CLEANUP_FLAGS				      ; 0863

				       57  DD 00220 	    PUSHL   HEADER						      ; 0864

		  0000G  CF	       01  FB 00222 	    CALLS   #1, CHECKSUM					      ;

	   16 	         69 	       13  E5 00227 12$:    BBCC    #19, CLEANUP_FLAGS, 13$				      ; 0872

		         50 	       6B  D0 0022B 	    MOVL    CURRENT_FIB, R0					      ; 0875

				  18   A0  D4 0022E 	    CLRL    24(R0)						      ;

				       7E  D4 00231 	    CLRL    -(SP)						      ; 0876

				0081   8F  BB 00233 	    PUSHR   #^M<R0,R7>						      ;

		  0000G  CF	       03  FB 00237 	    CALLS   #3, TRUNCATE					      ;

		         57 	0000G  CF  D0 0023C 	    MOVL    FILE_HEADER, HEADER					      ; 0877

	   71 	         69 	       01  E5 00241 13$:    BBCC    #1, CLEANUP_FLAGS, 17$				      ; 0884

				       6A  D5 00245 	    TSTL    PRIMARY_FCB						      ; 0885

				       6D  13 00247 	    BEQL    17$							      ;

		         50 	       6A  D0 00249 	    MOVL    PRIMARY_FCB, R0					      ; 0887

		         05 	  1E   A0  E8 0024C 	    BLBS    30(R0), 14$						      ;

				  18   A0  B5 00250 	    TSTW    24(R0)						      ; 0888

				       61  13 00253 	    BEQL    17$							      ;

		         52 	       50  D0 00255 14$:    MOVL    R0, FCB						      ; 0891

				       52  DD 00258 	    PUSHL   FCB							      ; 0892

				       01  DD 0025A 	    PUSHL   #1							      ;

				       5E  DD 0025C 	    PUSHL   SP							      ;

				0000V  CF  9F 0025E 	    PUSHAB  DEL_EXTFCB						      ;

		         68 	       04  FB 00262 	    CALLS   #4, SYS$CMKRNL					      ;

				0084   8F  BB 00265 	    PUSHR   #^M<R2,R7>						      ; 0893

				       02  DD 00269 	    PUSHL   #2							      ;

				       5E  DD 0026B 	    PUSHL   SP							      ;

				0000G  CF  9F 0026D 	    PUSHAB  INIT_FCB						      ;

		         68 	       05  FB 00271 	    CALLS   #5, SYS$CMKRNL					      ;

				       52  DD 00274 15$:    PUSHL   FCB							      ; 0896

				       57  DD 00276 	    PUSHL   HEADER						      ;



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 4-7

;

		  0000G  CF	       02  FB 00278 	    CALLS   #2, NEXT_HEADER					      ;

		         57 	       50  D0 0027D 	    MOVL    R0, HEADER						      ;

				       16  13 00280 	    BEQL    16$							      ; 0897

				       01  DD 00282 	    PUSHL   #1							      ; 0898

				       52  DD 00284 	    PUSHL   FCB							      ;

				       57  DD 00286 	    PUSHL   HEADER						      ;

				       03  DD 00288 	    PUSHL   #3							      ;

				       5E  DD 0028A 	    PUSHL   SP							      ;

				0000G  CF  9F 0028C 	    PUSHAB  MAKE_EXTFCB						      ;

		         68 	       06  FB 00290 	    CALLS   #6, SYS$CMKRNL					      ;

		         52 	       50  D0 00293 	    MOVL    R0, FCB						      ;

				       DC  11 00296 	    BRB     15$							      ; 0894

		         6A 	       52  D1 00298 16$:    CMPL    FCB, PRIMARY_FCB					      ; 0900

				       19  13 0029B 	    BEQL    17$							      ;

				       6A  DD 0029D 	    PUSHL   PRIMARY_FCB						      ; 0903

				       7E  D4 0029F 	    CLRL    -(SP)						      ;

		  0000G  CF	       02  FB 002A1 	    CALLS   #2, READ_HEADER					      ;

		         57 	       50  D0 002A6 	    MOVL    R0, HEADER						      ;

				       57  DD 002A9 	    PUSHL   HEADER						      ; 0904

				       01  DD 002AB 	    PUSHL   #1							      ;

				       5E  DD 002AD 	    PUSHL   SP							      ;

				0000G  CF  9F 002AF 	    PUSHAB  UPDATE_FCB						      ;

		         68 	       04  FB 002B3 	    CALLS   #4, SYS$CMKRNL					      ;

		         50 	0000G  CF  D0 002B6 17$:    MOVL    NEW_FID, R0						      ; 0912

				       07  13 002BB 	    BEQL    18$							      ;

				       50  DD 002BD 	    PUSHL   R0							      ; 0913

		  0000G  CF	       01  FB 002BF 	    CALLS   #1, DELETE_FID					      ;

				0000G  CF  D5 002C4 18$:    TSTL    CONTEXT_SAVE					      ; 0919

				       11  13 002C8 	    BEQL    19$							      ;

    0000G  CF	  0000G  CF	0000G  8F  28 002CA 	    MOVC3   #CONTEXT_SIZE, CONTEXT_SAVE, CONTEXT_START		      ; 0920

				0000G  CF  D4 002D4 	    CLRL    CONTEXT_SAVE					      ; 0921

				     FE45  31 002D8 	    BRW     1$							      ; 0749

		         50 	       01  D0 002DB 19$:    MOVL    #1, R0						      ; 0925

					   04 002DE 	    RET     							      ; 0662



; Routine Size:  487 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 5

;

;	0928	ROUTINE MAKE_DEACCESS =

;	0929	

;	0930	!++

;	0931	!

;	0932	! FUNCTIONAL DESCRIPTION:

;	0933	!

;	0934	!	This routine performs the machinery for deaccessing a file.

;	0935	!

;	0936	! CALLING SEQUENCE:

;	0937	!	MAKE_DEACCESS ()

;	0938	!

;	0939	! INPUT PARAMETERS:

;	0940	!	NONE

;	0941	!

;	0942	! IMPLICIT INPUTS:

;	0943	!	PRIMARY_FCB: FCB of file

;	0944	!	CURRENT_WINDOW: window of file

;	0945	!	CURRENT_VCB: VCB of volume in process

;	0946	!

;	0947	! OUTPUT PARAMETERS:

;	0948	!	NONE

;	0949	!

;	0950	! IMPLICIT OUTPUTS:

;	0951	!	NONE

;	0952	!

;	0953	! ROUTINE VALUE:

;	0954	!	NONE

;	0955	!

;	0956	! SIDE EFFECTS:

;	0957	!	file deaccessed

;	0958	!

;	0959	!--

;	0960	

;	0961	BEGIN

;	0962	

;	0963	LOCAL

;	0964		DUMMY;				! dummy local to receive REMQUE

;	0965	

;	0966	EXTERNAL

;	0967		PRIMARY_FCB	: REF BBLOCK,	! FCB of file

;	0968		CURRENT_WINDOW	: REF BBLOCK,	! window of file

;	0969		CURRENT_VCB	: REF BBLOCK,	! VCB of volume

;	0970		PMS$GL_OPEN	: ADDRESSING_MODE (ABSOLUTE);

;	0971						! system count of currently open files

;	0972	

;	0973	

;	0974	! Unlink the window from the FCB. Clear the applicable access conditions

;	0975	! in the FCB.

;	0976	!

;	0977	

;	0978	REMQUE (.CURRENT_WINDOW, DUMMY);

;	0979	

;	0980	IF .CURRENT_WINDOW[WCB$V_NOREAD]

;	0981	THEN PRIMARY_FCB[FCB$V_EXCL] = 0;

;	0982	



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 5-1

;

;	0983	IF .CURRENT_WINDOW[WCB$V_NOWRITE]

;	0984	THEN PRIMARY_FCB[FCB$W_LCNT] = .PRIMARY_FCB[FCB$W_LCNT] - 1;

;	0985	

;	0986	IF .CURRENT_WINDOW[WCB$V_NOTRUNC]

;	0987	THEN PRIMARY_FCB[FCB$W_TCNT] = .PRIMARY_FCB[FCB$W_TCNT] - 1;

;	0988	

;	0989	! For a write access, bump down the writer count. If this is the

;	0990	! last write, and the file is the index file or the storage map, clear

;	0991	! the appropriate flag in the VCB.

;	0992	!

;	0993	

;	0994	IF .CURRENT_WINDOW[WCB$V_WRITE]

;	0995	THEN

;	0996	    BEGIN

;	0997	    PRIMARY_FCB[FCB$W_WCNT] = .PRIMARY_FCB[FCB$W_WCNT] - 1;

;	0998	    IF .PRIMARY_FCB[FCB$W_WCNT] EQL 0

;	0999	    THEN

;	1000		BEGIN

;	1001		IF .PRIMARY_FCB[FCB$W_FID_NUM] EQL 1

;	1002		    THEN CURRENT_VCB[VCB$V_WRITE_IF] = 0;

;	1003		IF .PRIMARY_FCB[FCB$W_FID_NUM] EQL 2

;	1004		    THEN CURRENT_VCB[VCB$V_WRITE_SM] = 0;

;	1005		END;

;	1006	    END;

;	1007	

;	1008	PRIMARY_FCB[FCB$W_ACNT] = .PRIMARY_FCB[FCB$W_ACNT] - 1;

;	1009	

;	1010	! If this was the last access, yank the FCB out of the FCB list and dump its

;	1011	! extensions, if any.

;	1012	!

;	1013	

;	1014	IF .PRIMARY_FCB[FCB$W_ACNT] EQL 0

;	1015	THEN

;	1016	    BEGIN

;	1017	    REMQUE (.PRIMARY_FCB, DUMMY);

;	1018	    DEL_EXTFCB (.PRIMARY_FCB);

;	1019	    END;

;	1020	

;	1021	PMS$GL_OPEN = .PMS$GL_OPEN - 1;		! bump down count of open files

;	1022	CURRENT_VCB[VCB$W_TRANS] = .CURRENT_VCB[VCB$W_TRANS] - 1;

;	1023	

;	1024	RETURN 1;

;	1025	

;	1026	END;					! end of routine MAKE_DEACCESS







							    .EXTRN  PMS$GL_OPEN



					 001C 002DF MAKE_DEACCESS:

							    .WORD   Save R2,R3,R4					      ; 0928

		         54 	0000G  CF  9E 002E1 	    MOVAB   CURRENT_VCB, R4					      ;

		         53 	0000G  CF  9E 002E6 	    MOVAB   PRIMARY_FCB, R3					      ;

		         52 	0000G  DF  0F 002EB 	    REMQUE  @CURRENT_WINDOW, DUMMY				      ; 0978

		         51 	0000G  CF  D0 002F0 	    MOVL    CURRENT_WINDOW, R1					      ; 0980



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 5-2

;

	   07 	    15   A1	       02  E1 002F5 	    BBC     #2, 21(R1), 1$					      ;

		         50 	       63  D0 002FA 	    MOVL    PRIMARY_FCB, R0					      ; 0981

		    1E   A0	       08  8A 002FD 	    BICB2   #8, 30(R0)						      ;

		         06 	  14   A1  E9 00301 1$:     BLBC    20(R1), 2$						      ; 0983

		         50 	       63  D0 00305 	    MOVL    PRIMARY_FCB, R0					      ; 0984

				  1A   A0  B7 00308 	    DECW    26(R0)						      ;

	   06 	    15   A1	       03  E1 0030B 2$:     BBC     #3, 21(R1), 3$					      ; 0986

		         50 	       63  D0 00310 	    MOVL    PRIMARY_FCB, R0					      ; 0987

				  46   A0  B7 00313 	    DECW    70(R0)						      ;

	   22 	    0B   A1	       01  E1 00316 3$:     BBC     #1, 11(R1), 5$					      ; 0994

		         50 	       63  D0 0031B 	    MOVL    PRIMARY_FCB, R0					      ; 0997

				  1C   A0  B7 0031E 	    DECW    28(R0)						      ;

				       1A  12 00321 	    BNEQ    5$							      ; 0998

		         01 	  20   A0  B1 00323 	    CMPW    32(R0), #1						      ; 1001

				       07  12 00327 	    BNEQ    4$							      ;

		         51 	       64  D0 00329 	    MOVL    CURRENT_VCB, R1					      ; 1002

		    0B   A1	       01  8A 0032C 	    BICB2   #1, 11(R1)						      ;

		         02 	  20   A0  B1 00330 4$:     CMPW    32(R0), #2						      ; 1003

				       07  12 00334 	    BNEQ    5$							      ;

		         50 	       64  D0 00336 	    MOVL    CURRENT_VCB, R0					      ; 1004

		    0B   A0	       02  8A 00339 	    BICB2   #2, 11(R0)						      ;

		         50 	       63  D0 0033D 5$:     MOVL    PRIMARY_FCB, R0					      ; 1008

				  18   A0  B7 00340 	    DECW    24(R0)						      ;

				       0A  12 00343 	    BNEQ    6$							      ; 1014

		         52 	       60  0F 00345 	    REMQUE  (R0), DUMMY						      ; 1017

				       63  DD 00348 	    PUSHL   PRIMARY_FCB						      ; 1018

		  0000V  CF	       01  FB 0034A 	    CALLS   #1, DEL_EXTFCB					      ;

			    00000000G  9F  D7 0034F 6$:     DECL    @#PMS$GL_OPEN					      ; 1021

		         50 	       64  D0 00355 	    MOVL    CURRENT_VCB, R0					      ; 1022

				  0C   A0  B7 00358 	    DECW    12(R0)						      ;

		         50 	       01  D0 0035B 	    MOVL    #1, R0						      ; 1024

					   04 0035E 	    RET     							      ; 0928



; Routine Size:  128 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 6

;

;	1027	GLOBAL ROUTINE DEL_EXTFCB (START_FCB) =

;	1028	

;	1029	!++

;	1030	!

;	1031	! FUNCTIONAL DESCRIPTION:

;	1032	!

;	1033	!	This routine removes and deallocates all extension FCB's, if any,

;	1034	!	linked to the indicated FCB.

;	1035	!

;	1036	! CALLING SEQUENCE:

;	1037	!	DEL_EXTFCB (ARG1)

;	1038	!

;	1039	! INPUT PARAMETERS:

;	1040	!	ARG1: address of primary FCB or 0

;	1041	!

;	1042	! IMPLICIT INPUTS:

;	1043	!	NONE

;	1044	!

;	1045	! OUTPUT PARAMETERS:

;	1046	!	NONE

;	1047	!

;	1048	! IMPLICIT OUTPUTS:

;	1049	!	NONE

;	1050	!

;	1051	! ROUTINE VALUE:

;	1052	!	NONE

;	1053	!

;	1054	! SIDE EFFECTS:

;	1055	!	FCB's deallocated

;	1056	!

;	1057	!--

;	1058	

;	1059	BEGIN

;	1060	

;	1061	MAP

;	1062		START_FCB	: REF BBLOCK;	! FCB argument

;	1063	

;	1064	LOCAL

;	1065		FCB		: REF BBLOCK,	! running FCB pointer

;	1066		NEXT_FCB	: REF BBLOCK,	! next extension FCB

;	1067		DUMMY;				! dummy local to receive REMQUE

;	1068	

;	1069	EXTERNAL ROUTINE

;	1070		DEALLOCATE;			! deallocate dynamic memory

;	1071	

;	1072	! Checking for null pointers, find the first extension FCB. Follow the extension

;	1073	! list and remove and deallocate the extension FCB's, cleaning out the pointers

;	1074	! on the way.

;	1075	!

;	1076	

;	1077	IF .START_FCB EQL 0 THEN RETURN;

;	1078	FCB = .START_FCB[FCB$L_EXFCB];

;	1079	START_FCB[FCB$L_EXFCB] = 0;

;	1080	UNTIL .FCB EQL 0 DO

;	1081	    BEGIN



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 6-1

;

;	1082	    NEXT_FCB = .FCB[FCB$L_EXFCB];

;	1083	    FCB[FCB$L_EXFCB] = 0;

;	1084	    REMQUE (.FCB, DUMMY);

;	1085	    DEALLOCATE (.FCB);

;	1086	    FCB = .NEXT_FCB;

;	1087	    END;

;	1088	

;	1089	RETURN 1;

;	1090	

;	1091	END;					! end of routine DEL_EXTFCB











					 001C 0035F 	    .ENTRY  DEL_EXTFCB, Save R2,R3,R4				      ; 1027

		         50 	  04   AC  D0 00361 	    MOVL    START_FCB, R0					      ; 1077

				       25  13 00365 	    BEQL    3$							      ;

		         52 	  0C   A0  D0 00367 	    MOVL    12(R0), FCB						      ; 1078

				  0C   A0  D4 0036B 	    CLRL    12(R0)						      ; 1079

				       52  D5 0036E 1$:     TSTL    FCB							      ; 1080

				       16  13 00370 	    BEQL    2$							      ;

		         53 	  0C   A2  D0 00372 	    MOVL    12(FCB), NEXT_FCB					      ; 1082

				  0C   A2  D4 00376 	    CLRL    12(FCB)						      ; 1083

		         54 	       62  0F 00379 	    REMQUE  (FCB), DUMMY					      ; 1084

				       52  DD 0037C 	    PUSHL   FCB							      ; 1085

		  0000G  CF	       01  FB 0037E 	    CALLS   #1, DEALLOCATE					      ;

		         52 	       53  D0 00383 	    MOVL    NEXT_FCB, FCB					      ; 1086

				       E6  11 00386 	    BRB     1$							      ; 1080

		         50 	       01  D0 00388 2$:     MOVL    #1, R0						      ; 1089

					   04 0038B 	    RET     							      ;

				       50  D4 0038C 3$:     CLRL    R0							      ; 1027

					   04 0038E 	    RET     							      ;



; Routine Size:  48 bytes







; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 7

;

;	1092	ROUTINE ZERO_CHANNEL =

;	1093	

;	1094	!++

;	1095	!

;	1096	! FUNCTIONAL DESCRIPTION:

;	1097	!

;	1098	!	This routine zeroes out the window pointer being returned to

;	1099	!	the user for his channel control block. It also credits one to the

;	1100	!	user's open file quota.

;	1101	!	This routine must be executed in kernel mode.

;	1102	!

;	1103	! CALLING SEQUENCE:

;	1104	!	ZERO_CHANNEL ()

;	1105	!

;	1106	! INPUT PARAMETERS:

;	1107	!	NONE

;	1108	!

;	1109	! IMPLICIT INPUTS:

;	1110	!	IO_PACKET: I/O packet of request

;	1111	!

;	1112	! OUTPUT PARAMETERS:

;	1113	!	NONE

;	1114	!

;	1115	! IMPLICIT OUTPUTS:

;	1116	!	NONE

;	1117	!

;	1118	! ROUTINE VALUE:

;	1119	!	NONE

;	1120	!

;	1121	! SIDE EFFECTS:

;	1122	!	channel window pointer cleared, file quota bumped

;	1123	!

;	1124	!--

;	1125	

;	1126	BEGIN

;	1127	

;	1128	LOCAL

;	1129		ABD		: REF BBLOCKVECTOR [,ABD$C_LENGTH],

;	1130						! buffer descriptors

;	1131		PCB		: REF BBLOCK;	! address of user process control block

;	1132	

;	1133	EXTERNAL

;	1134		IO_PACKET	: REF BBLOCK,	! I/O packet in process

;	1135		SCH$GL_PCBVEC	: REF VECTOR ADDRESSING_MODE (ABSOLUTE);

;	1136						! system PCB vector

;	1137	

;	1138	

;	1139						! pointer to buffer descriptors

;	1140	ABD = .BBLOCK [.IO_PACKET[IRP$L_SVAPTE], AIB$L_DESCRIPT];

;	1141	ABD[ABD$C_WINDOW, ABD$W_COUNT] = 4;

;	1142	.ABD[ABD$C_WINDOW, ABD$W_TEXT] + ABD[ABD$C_WINDOW, ABD$W_TEXT] + 1 = 0;

;	1143	

;	1144	PCB = .SCH$GL_PCBVEC[.(IO_PACKET[IRP$L_PID])<0,16>];

;	1145	PCB[PCB$W_FILCNT] = .PCB[PCB$W_FILCNT] + 1;

;	1146	



; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 7-1

;

;	1147	RETURN 1;

;	1148	

;	1149	END;					! end of routine ZERO_CHANNEL







							    .EXTRN  SCH$GL_PCBVEC



					 0004 0038F ZERO_CHANNEL:

							    .WORD   Save R2						      ; 1092

		         52 	0000G  CF  D0 00391 	    MOVL    IO_PACKET, R2					      ; 1140

		         51 	  2C   B2  D0 00396 	    MOVL    @44(R2), ABD					      ;

		    02   A1	       04  B0 0039A 	    MOVW    #4, 2(ABD)						      ; 1141

		         50 	       61  3C 0039E 	    MOVZWL  (ABD), R0						      ; 1142

				  01 A140  9F 003A1 	    PUSHAB  1(ABD)[R0]						      ;

				       9E  D4 003A5 	    CLRL    @(SP)+						      ;

		         51 00000000G  9F  D0 003A7 	    MOVL    @#SCH$GL_PCBVEC, R1					      ; 1144

		         50 	  0C   A2  3C 003AE 	    MOVZWL  12(R2), R0						      ;

		         50 	     6140  D0 003B2 	    MOVL    (R1)[R0], PCB					      ;

				  48   A0  B6 003B6 	    INCW    72(PCB)						      ; 1145

		         50 	       01  D0 003B9 	    MOVL    #1, R0						      ; 1147

					   04 003BC 	    RET     							      ; 1092



; Routine Size:  46 bytes





;	1150	

;	1151	END

;	1152	ELUDOM













;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

;  $CODE$         	   957  NOWRT,  RD ,  EXE,NOSHR,  LCL,  REL,  CON,NOPIC,ALIGN(2)









;				LIBRARY STATISTICS

;

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

;	File				     Total    Loaded   Percent      Read

;

;  DBA4:[SYSLIB]LIB.L32;1		      5582        34         0       247













; Bliss-32 10.1-416	Monday 21-AUG-1978 22:50:27	DBB3:[F11A.SRC]CLENUP.B32;10					Page 7-2

;

; Size:		941 code + 16 data bytes

; Run Time:	00:19.7

; Elapsed Time:	00:39.4

; Memory Used:	365 pages

; Compilation Complete

