.title deletefid Delete File by File Id

;
; Author:	Rodrick A. Eldridge
;		104 Computer Science
;		Iowa State University
;		Ames, IA 50011
;		(515) 294-5659
;
; Created:	Winter 1984
;
; Modification History:
;
;		Summer 1986
;		Converted to use the MLR Macro Language
;
; Description:	If a non-zero directory id is specified, the file name must be
;		specified, and it will remove the file name entry from the
;		directory.
;
;		If the file id points to a directory, it will be deleted even
;		if the directory contains other files or sub-directories.
;
; Format:	external module delete_fid -
;		<work_area,device,file>
;
; Arguments:	work_area:		record structure
;					(passed by reference)
;
;			io_chan:	word
;
;				I/O channel.
;				If io_chan = 0 then assign channel.
;
;			fid:		3 word
;
;				File id.
;				If fid = 0 then deassign channel.
;
;			did:		3 words
;
;				Directory id.
;
;		device:			character string
;					(passed by descriptor)
;
;				Device name.
;
;		file:			character string
;					(passed by descriptor)
;
;				File name.
;


global module delete_fid <work_area,device_descr,file_descr> -
	mask=<r6,r7,r8,r9,r10,r11> -
	psect=delete_fid

const
	$atrdef			; file attribute definitions
	$dscdef			; descriptor definitions
	$fibdef			; file information block definitions
	$fiddef			; file id definitions
	$fchdef			; file characteristics definitions
	$iodef			; i/o definitions
	$ssdef			; system status definitions

record delete_fid

	work_area.io_chan:	.blkw	1	; i/o channel
	work_area.fid:		.blkw	3	; file id
	work_area.did:		.blkw	3	; directory id

end

var
	fib_descr:		descr	.blkb fib$k_length fib    *

	fib_list:		item	atr$s_uchar,atr$c_uchar,uchar
				.long	0

	uchar:			.blkb	atr$s_uchar

	io_status:		.blkq	1


procedure assign_channel -
  psect=delete_fid

begin

	$assign_s -
		chan=   work_area.io_chan(r11),-
		devnam= @delete_fid.device_descr(ap)

	exit_if_error

	return

end


procedure deassign_channel -
	psect=delete_fid

begin

	$dassgn_s -
		chan= work_area.io_chan(r11)

	exit_if_error

	clrw	work_area.io_chan(r11)

	return

end


procedure access_file -
	psect=delete_fid

begin

	movc5	#0,(r0),#0,#fib$k_length,(r10)

	movc3	#fid$s_fiddef,work_area.fid(r11),fib$w_fid(r10)

	$qiow_s -
		chan= work_area.io_chan(r11),-
		func= #io$_access,-
		iosb= io_status,-
		p1=   fib_descr,-
		p5=   #fib_list

	exit_if_error

	movzwl	io_status,r0

	exit_if_error

	return

end


procedure modify_file -
	psect=delete_fid

begin

	bisl	#fib$m_writethru,fib$l_acctl(r10)

	$qiow_s -
		chan= work_area.io_chan(r11),-
		func= #io$_modify,-
		iosb= io_status,-
		p1=   fib_descr,-
		p5=   #fib_list

	exit_if_error

	movzwl	io_status,r0

	exit_if_error

	return

end


procedure delete_file -
	psect=delete_fid

begin

	movc3	#fid$s_fiddef,work_area.did(r11),fib$w_did(r10)

	$qiow_s -
		chan= work_area.io_chan(r11),-
		func= #io$_delete!io$m_delete,-
		iosb= io_status,-
		p1=   fib_descr,-
		p2=   delete_fid.file_descr(ap)

	exit_if_error

	movzwl	io_status,r0

	exit_if_error

	return

end


begin

	if <cmpl #3,delete_fid.narg(ap)> lss then
		movl	#ss$_insfarg,r0		; not enough arguments
		goto	exit			; exit
	end

	movab	fib,r10				; r10=fib address
	movl	delete_fid.work_area(ap),r11	; r11=work area address

	if <tstw work_area.io_chan(r11)> eql then

		assign_channel

	elseif <tstl work_area.fid(r11)> eql then

		deassign_channel
		goto	exit

	end

	access_file

	if <bitl #fch$m_directory,uchar> neq then

		bicl	#fch$m_directory,uchar
		modify_file

	end

	delete_file

exit:

	return

.end