

; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 1

;

;	0001	MODULE TRUNC (

;	0002			LANGUAGE (BLISS32),

;	0003			IDENT = 'A0011'

;	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 routine truncates a file by deallocating the indicated blocks.

;	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:  21-Mar-1977  10:41

;	0043	!

;	0044	! REVISION HISTORY:

;	0045	!

;	0046	!   Andrew C. Goldstein, 23-Mar-1977  15:10

;	0047	!   X0002 - Turn off cleanup at successful completion

;	0048	!

;	0049	!   Andrew C. Goldstein, 6-Apr-1977  18:07

;	0050	!   X0003 - Condition header write back on pointer erasing

;	0051	!

;	0052	!   Andrew C. Goldstein, 12-Apr-1977  15:40

;	0053	!   X0004 - Modify for buffer manager

;	0054	!

;	0055	!   Andrew C. Goldstein, 13-Jul-1977  15:47



; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 1-1

;

;	0056	!   X0005 - Rework file header checksumming

;	0057	!

;	0058	!   Andrew C. Goldstein, 9-Aug-1977  15:54

;	0059	!   X0006 - Add multi-header support, including TRUNCATE_HEADER routine

;	0060	!

;	0061	!   Andrew C. Goldstein, 26-Aug-1977  10:55

;	0062	!   X0007 - Add performance metering

;	0063	!

;	0064	!   Andrew C. Goldstein, 12-Dec-1977  14:33

;	0065	!   X0008 - file ID interface changes

;	0066	!

;	0067	!   Andrew C. Goldstein, 14-Mar-1978  19:30

;	0068	!   X0009 - I/O status contains round up, not final size

;	0069	!

;	0070	!   Andrew C. Goldstein, 2-May-78  14:55

;	0071	!   X0010 - Update HIBLK in record attributes

;	0072	!

;	0073	!   Andrew C. Goldstein, 29-May-78  23:47

;	0074	!   A0011 - Get correct file size for FCB

;	0075	!

;	0076	!**

;	0077	

;	0078	

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

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

;	0399	

;	0400	

;	0401	FORWARD ROUTINE

;	0402		TRUNCATE	: NOVALUE,	! truncate file

;	0403		TRUNCATE_HEADER	: NOVALUE;	! truncate individual file header



; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 2

;

;	0404	GLOBAL ROUTINE TRUNCATE (FIB, FILE_HEADER, DEALLOCATE) : NOVALUE =

;	0405	

;	0406	!++

;	0407	!

;	0408	! FUNCTIONAL DESCRIPTION:

;	0409	!

;	0410	!	This routine truncates a file to the size indicated in the FIB by

;	0411	!	deallocating the necessary blocks. The erase flag controls whether

;	0412	!	the retrieval pointers are erased in the header. The deallocate flag

;	0413	!	controls whether or not the blocks are actually returned to the

;	0414	!	storage map.

;	0415	!

;	0416	! CALLING SEQUENCE:

;	0417	!	TRUNCATE (ARG1, ARG2, ARG3)

;	0418	!

;	0419	! INPUT PARAMETERS:

;	0420	!	ARG1: address of FIB for operation

;	0421	!	ARG2: address of file header

;	0422	!	ARG3: = 1 to return space to storage map

;	0423	!	      = 0 to just clean out header

;	0424	!

;	0425	! IMPLICIT INPUTS:

;	0426	!	CURRENT_VCB: VCB of volume

;	0427	!

;	0428	! OUTPUT PARAMETERS:

;	0429	!	NONE

;	0430	!

;	0431	! IMPLICIT OUTPUTS:

;	0432	!	NONE

;	0433	!

;	0434	! ROUTINE VALUE:

;	0435	!	NONE

;	0436	!

;	0437	! SIDE EFFECTS:

;	0438	!	storage bitmap altered

;	0439	!	file header altered

;	0440	!

;	0441	!--

;	0442	

;	0443	BEGIN

;	0444	

;	0445	MAP

;	0446		FIB		: REF BBLOCK,	! FIB for operation

;	0447		FILE_HEADER	: REF BBLOCK;	! file header

;	0448	

;	0449	LOCAL

;	0450		FCB		: REF BBLOCK,	! FCB of current file header

;	0451		HEADER		: REF BBLOCK,	! address of current file header

;	0452		NEW_HEADER	: REF BBLOCK,	! address of extension file header

;	0453		MAP_AREA	: REF BBLOCK,	! file header map area

;	0454		MAP_POINTER	: REF BBLOCK,	! pointer to scan map

;	0455		MAP_COUNT,			! retrieval pointer count

;	0456		VBN,				! relative VBN of operation

;	0457		COUNT,				! count of blocks returned

;	0458		EXT_FID		: BBLOCK [FID$C_LENGTH], ! file ID of extension header



; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 2-1

;

;	0459		EX_SEGNUM,			! segment number of ext header

;	0460		REREAD;				! flag to reread primary file header

;	0461	

;	0462	LABEL

;	0463		VBN_LOOP;			! main loop to scan for starting VBN

;	0464	

;	0465	EXTERNAL

;	0466		CLEANUP_FLAGS	: BITVECTOR,	! cleanup action flags

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

;	0468		CURRENT_VCB	: REF BBLOCK,	! VCB of volume

;	0469		PRIMARY_FCB	: REF BBLOCK;	! FCB of file

;	0470	

;	0471	EXTERNAL ROUTINE

;	0472		PMS_START_SUB,			! start subfunction metering

;	0473		PMS_END_SUB,			! end subfunction metering

;	0474		MARK_DIRTY,			! mark buffer for write-back

;	0475		CHECKSUM,			! checksum file header

;	0476		NEXT_HEADER,			! read next extension header

;	0477		UPDATE_FILESIZE,		! update file size in primary FCB

;	0478		INIT_FCB,			! initialize FCB

;	0479		WRITE_HEADER,			! write file header

;	0480		READ_HEADER,			! read file header

;	0481		DEL_EXTFCB,			! delete extension FCB's

;	0482		DELETE_FILE;			! delete remainder of file

;	0483	

;	0484	

;	0485	! Start metering for this subfunction.

;	0486	!

;	0487	

;	0488	PMS_START_SUB (PMS_ALLOC);

;	0489	

;	0490	! Establish the basic pointers. Round up the starting VBN to the next cluster

;	0491	! boundary and adjust it to a zero start. The block count must be zero (default).

;	0492	!

;	0493	

;	0494	HEADER = .FILE_HEADER;

;	0495	FCB = .PRIMARY_FCB;

;	0496	VBN = ((.FIB[FIB$L_EXVBN] - 1 + .CURRENT_VCB[VCB$W_CLUSTER] - 1)

;	0497		 / .CURRENT_VCB[VCB$W_CLUSTER]) * .CURRENT_VCB[VCB$W_CLUSTER];

;	0498	

;	0499	IF .FIB[FIB$L_EXSZ] NEQ 0 THEN ERR_EXIT (SS$_BADPARAM);

;	0500	

;	0501	! Init the user's return parameters.

;	0502	!

;	0503	

;	0504	USER_STATUS[1] = .VBN + 1 - .FIB[FIB$L_EXVBN];

;	0505	FIB[FIB$L_EXVBN] = .VBN + 1;

;	0506	FIB[FIB$L_EXSZ] = 0;

;	0507	REREAD = 0;

;	0508	

;	0509	! Now scan the file headers for the retrieval pointer containing the starting

;	0510	! VBN. If the VBN is off the end of file, report the error; if it coincides,

;	0511	! the operation is a noop.

;	0512	!

;	0513	



; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 2-2

;

;	0514	VBN_LOOP:

;	0515	BEGIN

;	0516	WHILE 1 DO

;	0517	    BEGIN

;	0518	    MAP_AREA = .HEADER + .HEADER[FH1$B_MPOFFSET]*2;

;	0519	    MAP_POINTER = .MAP_AREA + FM1$C_POINTERS;

;	0520	    MAP_COUNT = .MAP_AREA[FM1$B_INUSE] / 2;

;	0521	

;	0522	    WHILE .MAP_COUNT GTR 0 DO

;	0523		BEGIN

;	0524		COUNT = .MAP_POINTER[FM1$B_COUNT] + 1;

;	0525		IF .COUNT GTRU .VBN THEN LEAVE VBN_LOOP;

;	0526		VBN = .VBN - .COUNT;

;	0527		MAP_POINTER = .MAP_POINTER + 4;

;	0528		MAP_COUNT = .MAP_COUNT - 1;

;	0529		END;

;	0530	

;	0531	! We have scanned through an entire header. Chain to the next header if it

;	0532	! exists. First check for the boundary condition of starting the truncate

;	0533	! at the header boundary to avoid leaving an empty header.

;	0534	!

;	0535	

;	0536	    IF .VBN EQL 0

;	0537	    THEN

;	0538		BEGIN

;	0539		IF .MAP_AREA[FM1$W_EX_FILNUM] EQL 0

;	0540		THEN RETURN			! truncate coincides with EOF

;	0541		ELSE LEAVE VBN_LOOP;		! dump the extension headers

;	0542		END;

;	0543	

;	0544	    NEW_HEADER = NEXT_HEADER (.HEADER, .FCB);

;	0545	    IF .NEW_HEADER EQL 0 THEN EXITLOOP;

;	0546	    REREAD = 1;

;	0547	    HEADER = .NEW_HEADER;

;	0548	    IF .FCB NEQ 0 THEN FCB = .FCB[FCB$L_EXFCB];

;	0549	    END;				! end of header scan loop

;	0550	

;	0551	ERR_EXIT (SS$_ENDOFFILE)

;	0552	END;					! end of VBN_LOOP

;	0553	

;	0554	! We are now pointing at the retrieval pointer in which the truncation starts.

;	0555	! Clean out the rest of this header. If there are extension headers, use

;	0556	! the delete routine to dispose of them. Also flush extension FCB's, if they

;	0557	! exist.

;	0558	!

;	0559	

;	0560	MARK_DIRTY (.HEADER);

;	0561	CLEANUP_FLAGS[CLF_FIXFCB] = 1;

;	0562	CLEANUP_FLAGS[CLF_INVWINDOW] = 1;

;	0563	CLEANUP_FLAGS[CLF_CLEANTRUNC] = 1;

;	0564	KERNEL_CALL (UPDATE_FILESIZE, .FIB[FIB$L_EXVBN] - 1);

;	0565	

;	0566	! Update the HIBLK field in the record attributes to reflect the new file

;	0567	! size.

;	0568	!



; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 2-3

;

;	0569	

;	0570	BBLOCK [HEADER[FH1$W_RECATTR], FAT$L_HIBLK] = ROT (.FIB[FIB$L_EXVBN]-1, 16);

;	0571	

;	0572	TRUNCATE_HEADER (.FIB, .HEADER, .DEALLOCATE, .MAP_POINTER, .VBN);

;	0573	EX_SEGNUM = .MAP_AREA[FM1$B_EX_SEGNUM] + 1;

;	0574	EXT_FID[FID$W_NUM] = .MAP_AREA[FM1$W_EX_FILNUM];

;	0575	EXT_FID[FID$W_SEQ] = .MAP_AREA[FM1$W_EX_FILSEQ];

;	0576	EXT_FID[FID$W_RVN] = 0;

;	0577	MAP_AREA[FM1$W_EX_FILNUM] = 0;

;	0578	MAP_AREA[FM1$W_EX_FILSEQ] = 0;

;	0579	

;	0580	IF .FCB NEQ 0 AND .FCB NEQ .PRIMARY_FCB

;	0581	THEN KERNEL_CALL (INIT_FCB, .FCB, .HEADER);

;	0582	

;	0583	CHECKSUM (.HEADER);

;	0584	WRITE_HEADER ();

;	0585	

;	0586	IF .DEALLOCATE AND (.EXT_FID[FID$W_NUM] NEQ 0)

;	0587	THEN

;	0588	    BEGIN

;	0589	    REREAD = 1;

;	0590	    HEADER = NEXT_HEADER (0, .FCB, EXT_FID, .EX_SEGNUM);

;	0591	    KERNEL_CALL (DEL_EXTFCB, .FCB);

;	0592	    DELETE_FILE (.FIB, .HEADER);

;	0593	    END;

;	0594	

;	0595	IF .REREAD

;	0596	THEN HEADER = READ_HEADER (FIB[FIB$W_FID], .PRIMARY_FCB);

;	0597	

;	0598	

;	0599	! Stop metering of this subfunction

;	0600	!

;	0601	

;	0602	PMS_END_SUB ();

;	0603	

;	0604	END;					! end of routine TRUNCATE





							    .TITLE  TRUNC

							    .IDENT  \A0011\



							    .EXTRN  CLEANUP_FLAGS, USER_STATUS, CURRENT_VCB, PRIMARY_FCB

							    .EXTRN  PMS_START_SUB, PMS_END_SUB, MARK_DIRTY, CHECKSUM

							    .EXTRN  NEXT_HEADER, UPDATE_FILESIZE, INIT_FCB, WRITE_HEADER

							    .EXTRN  READ_HEADER, DEL_EXTFCB, DELETE_FILE, SYS$CMKRNL



							    .PSECT  $CODE$,NOWRT,2



					 0FFC 00000 	    .ENTRY  TRUNCATE, Save R2,R3,R4,R5,R6,R7,R8,R9,R10,R11	      ; 0404

		         5B 00000000G  9F  9E 00002 	    MOVAB   @#SYS$CMKRNL, R11					      ;

		         5E 	       08  C2 00009 	    SUBL2   #8, SP						      ;

				       08  DD 0000C 	    PUSHL   #8							      ; 0488

		  0000G  CF	       01  FB 0000E 	    CALLS   #1, PMS_START_SUB					      ;

		         54 	  08   AC  D0 00013 	    MOVL    FILE_HEADER, HEADER					      ; 0494

		         55 	0000G  CF  D0 00017 	    MOVL    PRIMARY_FCB, FCB					      ; 0495



; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 2-4

;

		         51 	  04   AC  D0 0001C 	    MOVL    FIB, R1						      ; 0496

		         50 	0000G  CF  D0 00020 	    MOVL    CURRENT_VCB, R0					      ;

		         52 	  3C   A0  3C 00025 	    MOVZWL  60(R0), R2						      ;

		         52 	  1C   A1  C0 00029 	    ADDL2   28(R1), R2						      ;

		         52 	       02  C2 0002D 	    SUBL2   #2, R2						      ;

		         53 	  3C   A0  3C 00030 	    MOVZWL  60(R0), R3						      ;

		         52 	       53  C6 00034 	    DIVL2   R3, R2						      ;

		         58 	  3C   A0  3C 00037 	    MOVZWL  60(R0), VBN						      ; 0497

		         58 	       52  C4 0003B 	    MULL2   R2, VBN						      ;

				  18   A1  D5 0003E 	    TSTL    24(R1)						      ; 0499

				       02  13 00041 	    BEQL    1$							      ;

				       14  BF 00043 	    CHMU    #20							      ;

		         50 	  04   AC  D0 00045 1$:     MOVL    FIB, R0						      ; 0504

	   51 	         58 	  1C   A0  C3 00049 	    SUBL3   28(R0), VBN, R1					      ;

		  0000G  CF	  01   A1  9E 0004E 	    MOVAB   1(R1), USER_STATUS+4				      ;

		    1C   A0	  01   A8  9E 00054 	    MOVAB   1(R8), 28(R0)					      ; 0505

				  18   A0  D4 00059 	    CLRL    24(R0)						      ; 0506

				       5A  D4 0005C 	    CLRL    REREAD						      ; 0507

		         50 	  01   A4  9A 0005E 2$:     MOVZBL  1(HEADER), R0					      ; 0518

		         52 	     6440  3E 00062 	    MOVAW   (HEADER)[R0], MAP_AREA				      ;

		         56 	  0A   A2  9E 00066 	    MOVAB   10(R2), MAP_POINTER					      ; 0519

		         57 	  08   A2  9A 0006A 	    MOVZBL  8(MAP_AREA), MAP_COUNT				      ; 0520

		         57 	       02  C6 0006E 	    DIVL2   #2, MAP_COUNT					      ;

				       15  15 00071 3$:     BLEQ    4$							      ; 0522

		         59 	  01   A6  9A 00073 	    MOVZBL  1(MAP_POINTER), COUNT				      ; 0524

				       59  D6 00077 	    INCL    COUNT						      ;

		         58 	       59  D1 00079 	    CMPL    COUNT, VBN						      ; 0525

				       34  1A 0007C 	    BGTRU   7$							      ;

		         58 	       59  C2 0007E 	    SUBL2   COUNT, VBN						      ; 0526

		         56 	       04  C0 00081 	    ADDL2   #4, MAP_POINTER					      ; 0527

				       57  D7 00084 	    DECL    MAP_COUNT						      ; 0528

				       E9  11 00086 	    BRB     3$							      ; 0522

				       58  D5 00088 4$:     TSTL    VBN							      ; 0536

				       06  12 0008A 	    BNEQ    5$							      ;

				  02   A2  B5 0008C 	    TSTW    2(MAP_AREA)						      ; 0539

				       21  12 0008F 	    BNEQ    7$							      ;

					   04 00091 	    RET     							      ; 0540

				       30  BB 00092 5$:     PUSHR   #^M<R4,R5>						      ; 0544

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

		         53 	       50  D0 00099 	    MOVL    R0, NEW_HEADER					      ;

				       10  13 0009C 	    BEQL    6$							      ; 0545

		         5A 	       01  D0 0009E 	    MOVL    #1, REREAD						      ; 0546

		         54 	       53  D0 000A1 	    MOVL    NEW_HEADER, HEADER					      ; 0547

				       55  D5 000A4 	    TSTL    FCB							      ; 0548

				       B6  13 000A6 	    BEQL    2$							      ;

		         55 	  0C   A5  D0 000A8 	    MOVL    12(FCB), FCB					      ;

				       B0  11 000AC 	    BRB     2$							      ; 0516

				0870   8F  BF 000AE 6$:     CHMU    #2160						      ; 0551

				       54  DD 000B2 7$:     PUSHL   HEADER						      ; 0560

		  0000G  CF	       01  FB 000B4 	    CALLS   #1, MARK_DIRTY					      ;

		  0000G  CF 00080012   8F  C8 000B9 	    BISL2   #524306, CLEANUP_FLAGS				      ; 0563

		         59 	  04   AC  D0 000C2 	    MOVL    FIB, R9						      ; 0564

	   53 	    1C   A9	       01  C3 000C6 	    SUBL3   #1, 28(R9), R3					      ;

				       53  DD 000CB 	    PUSHL   R3							      ;

				       01  DD 000CD 	    PUSHL   #1							      ;



; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 2-5

;

				       5E  DD 000CF 	    PUSHL   SP							      ;

				0000G  CF  9F 000D1 	    PUSHAB  UPDATE_FILESIZE					      ;

		         6B 	       04  FB 000D5 	    CALLS   #4, SYS$CMKRNL					      ;

      12   A4	         53 	       10  9C 000D8 	    ROTL    #16, R3, 18(HEADER)					      ; 0570

				0140   8F  BB 000DD 	    PUSHR   #^M<R6,R8>						      ; 0572

				  0C   AC  DD 000E1 	    PUSHL   DEALLOCATE						      ;

				       54  DD 000E4 	    PUSHL   HEADER						      ;

				       59  DD 000E6 	    PUSHL   R9							      ;

		  0000V  CF	       05  FB 000E8 	    CALLS   #5, TRUNCATE_HEADER					      ;

		         53 	       62  9A 000ED 	    MOVZBL  (MAP_AREA), EX_SEGNUM				      ; 0573

				       53  D6 000F0 	    INCL    EX_SEGNUM						      ;

		         6E 	  02   A2  D0 000F2 	    MOVL    2(MAP_AREA), EXT_FID				      ; 0574

				  04   AE  B4 000F6 	    CLRW    EXT_FID+4						      ; 0576

				  02   A2  D4 000F9 	    CLRL    2(MAP_AREA)						      ; 0577

				       55  D5 000FC 	    TSTL    FCB							      ; 0580

				       16  13 000FE 	    BEQL    8$							      ;

		  0000G  CF	       55  D1 00100 	    CMPL    FCB, PRIMARY_FCB					      ;

				       0F  13 00105 	    BEQL    8$							      ;

				       54  DD 00107 	    PUSHL   HEADER						      ; 0581

				       55  DD 00109 	    PUSHL   FCB							      ;

				       02  DD 0010B 	    PUSHL   #2							      ;

				       5E  DD 0010D 	    PUSHL   SP							      ;

				0000G  CF  9F 0010F 	    PUSHAB  INIT_FCB						      ;

		         6B 	       05  FB 00113 	    CALLS   #5, SYS$CMKRNL					      ;

				       54  DD 00116 8$:     PUSHL   HEADER						      ; 0583

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

		  0000G  CF	       00  FB 0011D 	    CALLS   #0, WRITE_HEADER					      ; 0584

		         2E 	  0C   AC  E9 00122 	    BLBC    DEALLOCATE, 9$					      ; 0586

				       6E  B5 00126 	    TSTW    EXT_FID						      ;

				       2A  13 00128 	    BEQL    9$							      ;

		         5A 	       01  D0 0012A 	    MOVL    #1, REREAD						      ; 0589

				       53  DD 0012D 	    PUSHL   EX_SEGNUM						      ; 0590

				  04   AE  9F 0012F 	    PUSHAB  EXT_FID						      ;

				       55  DD 00132 	    PUSHL   FCB							      ;

				       7E  D4 00134 	    CLRL    -(SP)						      ;

		  0000G  CF	       04  FB 00136 	    CALLS   #4, NEXT_HEADER					      ;

		         54 	       50  D0 0013B 	    MOVL    R0, HEADER						      ;

				       55  DD 0013E 	    PUSHL   FCB							      ; 0591

				       01  DD 00140 	    PUSHL   #1							      ;

				       5E  DD 00142 	    PUSHL   SP							      ;

				0000G  CF  9F 00144 	    PUSHAB  DEL_EXTFCB						      ;

		         6B 	       04  FB 00148 	    CALLS   #4, SYS$CMKRNL					      ;

				       54  DD 0014B 	    PUSHL   HEADER						      ; 0592

				       59  DD 0014D 	    PUSHL   R9							      ;

		  0000G  CF	       02  FB 0014F 	    CALLS   #2, DELETE_FILE					      ;

		         0F 	       5A  E9 00154 9$:     BLBC    REREAD, 10$						      ; 0595

				0000G  CF  DD 00157 	    PUSHL   PRIMARY_FCB						      ; 0596

				  04   A9  9F 0015B 	    PUSHAB  4(R9)						      ;

		  0000G  CF	       02  FB 0015E 	    CALLS   #2, READ_HEADER					      ;

		         54 	       50  D0 00163 	    MOVL    R0, HEADER						      ;

		  0000G  CF	       00  FB 00166 10$:    CALLS   #0, PMS_END_SUB					      ; 0602

					   04 0016B 	    RET     							      ; 0404



; Routine Size:  364 bytes





; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 2-6

;





; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 3

;

;	0605	GLOBAL ROUTINE TRUNCATE_HEADER (FIB, HEADER, DEALLOCATE, POINTER, LAST_COUNT) : NOVALUE =

;	0606	

;	0607	!++

;	0608	!

;	0609	! FUNCTIONAL DESCRIPTION:

;	0610	!

;	0611	!	This routine returns the indicated retrieval pointers in the given

;	0612	!	file header to the storage map and erases them in the file header.

;	0613	!

;	0614	!

;	0615	! CALLING SEQUENCE:

;	0616	!	TRUNCATE_HEADER (ARG1, ARG2, ARG3, ARG4, ARG5)

;	0617	!

;	0618	! INPUT PARAMETERS:

;	0619	!	ARG1: address of FIB of operation

;	0620	!	ARG2: address of file header

;	0621	!	ARG3: = 1 to return space to the storage map

;	0622	!	      = 0 to just erase the retrieval pointers

;	0623	!	ARG4: address of first retrieval pointer to process, if present

;	0624	!	ARG5: new count field of first pointer, if present

;	0625	!

;	0626	! IMPLICIT INPUTS:

;	0627	!	NONE

;	0628	!

;	0629	! OUTPUT PARAMETERS:

;	0630	!	NONE

;	0631	!

;	0632	! IMPLICIT OUTPUTS:

;	0633	!	NONE

;	0634	!

;	0635	! ROUTINE VALUE:

;	0636	!	NONE

;	0637	!

;	0638	! SIDE EFFECTS:

;	0639	!	file header altered, storage map altered

;	0640	!

;	0641	!--

;	0642	

;	0643	BEGIN

;	0644	

;	0645	MAP

;	0646		FIB		: REF BBLOCK,	! user FIB

;	0647		HEADER		: REF BBLOCK;	! file header

;	0648	

;	0649	LOCAL

;	0650		MAP_AREA	: REF BBLOCK,	! address of file header map area

;	0651		MAP_POINTER	: REF BBLOCK,	! pointer to map pointers

;	0652		MAP_END,			! address of end of map area

;	0653		COUNT,				! count field of current retrieval pointer

;	0654		LBN,				! LBN field of current retrieval pointer

;	0655		RP_COUNT;			! new count field for retrieval pointer

;	0656	

;	0657	EXTERNAL ROUTINE

;	0658		RETURN_BLOCKS;			! return blocks to storage map

;	0659	



; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 3-1

;

;	0660	

;	0661	! Establish pointers into the file header. If explicit args are supplied, use

;	0662	! them; else default to releasing the entire file header.

;	0663	!

;	0664	

;	0665	MAP_AREA = .HEADER + .HEADER[FH1$B_MPOFFSET]*2;

;	0666	MAP_POINTER = .MAP_AREA + FM1$C_POINTERS;

;	0667	MAP_END = .MAP_POINTER + .MAP_AREA[FM1$B_INUSE]*2;

;	0668	RP_COUNT = 0;

;	0669	

;	0670	IF ACTUALCOUNT GEQ 4

;	0671	THEN

;	0672	    BEGIN

;	0673	    MAP_POINTER = .POINTER;

;	0674	    RP_COUNT = .LAST_COUNT;

;	0675	    END;

;	0676	

;	0677	! Now scan the map area, cleaning out pointers and releasing blocks.

;	0678	!

;	0679	

;	0680	UNTIL .MAP_POINTER GEQA .MAP_END DO

;	0681	    BEGIN

;	0682	    COUNT = .MAP_POINTER[FM1$B_COUNT] + 1;

;	0683	    LBN = .MAP_POINTER[FM1$W_LOWLBN];

;	0684	    LBN<16,8> = .MAP_POINTER[FM1$B_HIGHLBN];

;	0685	    IF .RP_COUNT NEQ 0

;	0686	    THEN

;	0687		MAP_POINTER[FM1$B_COUNT] = .RP_COUNT - 1

;	0688	    ELSE

;	0689		BEGIN

;	0690		MAP_POINTER[FM1$B_HIGHLBN] = 0;

;	0691		MAP_POINTER[FM1$B_COUNT] = 0;

;	0692		MAP_POINTER[FM1$W_LOWLBN] = 0;

;	0693		MAP_AREA[FM1$B_INUSE] = .MAP_AREA[FM1$B_INUSE] - 2;

;	0694		END;

;	0695	

;	0696	    IF .DEALLOCATE THEN RETURN_BLOCKS (.LBN + .RP_COUNT, .COUNT - .RP_COUNT);

;	0697	    FIB[FIB$L_EXSZ] = .FIB[FIB$L_EXSZ] + .COUNT - .RP_COUNT;

;	0698	    RP_COUNT = 0;

;	0699	    MAP_POINTER = .MAP_POINTER + 4;

;	0700	    END;

;	0701	

;	0702	END;					! end of routine TRUNCATE_HEADER







							    .EXTRN  RETURN_BLOCKS



					 01FC 0016C 	    .ENTRY  TRUNCATE_HEADER, Save R2,R3,R4,R5,R6,R7,R8		      ; 0605

		         51 	  08   AC  D0 0016E 	    MOVL    HEADER, R1						      ; 0665

		         50 	  01   A1  9A 00172 	    MOVZBL  1(R1), R0						      ;

		         53 	     6140  3E 00176 	    MOVAW   (R1)[R0], MAP_AREA					      ;

		         52 	  0A   A3  9E 0017A 	    MOVAB   10(R3), MAP_POINTER					      ; 0666

		         50 	  08   A3  9A 0017E 	    MOVZBL  8(MAP_AREA), R0					      ; 0667

		         58 	     6240  3E 00182 	    MOVAW   (MAP_POINTER)[R0], MAP_END				      ;



; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 3-2

;

				       55  D4 00186 	    CLRL    RP_COUNT						      ; 0668

		         04 	       6C  91 00188 	    CMPB    (AP), #4						      ; 0670

				       08  1F 0018B 	    BLSSU   1$							      ;

		         52 	  10   AC  D0 0018D 	    MOVL    POINTER, MAP_POINTER				      ; 0673

		         55 	  14   AC  D0 00191 	    MOVL    LAST_COUNT, RP_COUNT				      ; 0674

	   56 	    04   AC	       18  C1 00195 1$:     ADDL3   #24, FIB, R6					      ; 0697

		         58 	       52  D1 0019A 2$:     CMPL    MAP_POINTER, MAP_END				      ; 0680

				       3F  1E 0019D 	    BGEQU   6$							      ;

		         57 	  01   A2  9A 0019F 	    MOVZBL  1(MAP_POINTER), COUNT				      ; 0682

				       57  D6 001A3 	    INCL    COUNT						      ;

		         54 	  02   A2  3C 001A5 	    MOVZWL  2(MAP_POINTER), LBN					      ; 0683

	   08 	         10 	       62  F0 001A9 	    INSV    (MAP_POINTER), #16, #8, LBN				      ; 0684

				       54     001AD									      ;

				       55  D5 001AE 	    TSTL    RP_COUNT						      ; 0685

				       07  13 001B0 	    BEQL    3$							      ;

      01   A2	         55 	       01  83 001B2 	    SUBB3   #1, RP_COUNT, 1(MAP_POINTER)			      ; 0687

				       06  11 001B7 	    BRB     4$							      ; 0685

				       62  D4 001B9 3$:     CLRL    (MAP_POINTER)					      ; 0690

		    08   A3	       02  82 001BB 	    SUBB2   #2, 8(MAP_AREA)					      ; 0693

		         0C 	  0C   AC  E9 001BF 4$:     BLBC    DEALLOCATE, 5$					      ; 0696

	   7E 	         57 	       55  C3 001C3 	    SUBL3   RP_COUNT, COUNT, -(SP)				      ;

				     6544  9F 001C7 	    PUSHAB  (RP_COUNT)[LBN]					      ;

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

	   50 	         66 	       57  C1 001CF 5$:     ADDL3   COUNT, (R6), R0					      ; 0697

	   66 	         50 	       55  C3 001D3 	    SUBL3   RP_COUNT, R0, (R6)					      ;

				       55  D4 001D7 	    CLRL    RP_COUNT						      ; 0698

		         52 	       04  C0 001D9 	    ADDL2   #4, MAP_POINTER					      ; 0699

				       BC  11 001DC 	    BRB     2$							      ; 0680

					   04 001DE 6$:     RET     							      ; 0605



; Routine Size:  115 bytes





;	0703	

;	0704	END

;	0705	ELUDOM













;				       PSECT SUMMARY

;

;	Name		 Bytes			       Attributes

;

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









;				LIBRARY STATISTICS

;

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

;	File				     Total    Loaded   Percent      Read



; Bliss-32 10.1-416	Monday 21-AUG-1978 23:06:03	DBB3:[F11A.SRC]TRUNC.B32;15					Page 3-3

;

;

;  DBA4:[SYSLIB]LIB.L32;1		      5582        23         0       240











; Size:		479 code + 0 data bytes

; Run Time:	00:12.0

; Elapsed Time:	00:22.6

; Memory Used:	344 pages

; Compilation Complete

