Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

Comment * SIMULA specification;
OPTIONS(/E:CODE,finddirectfile);
REF(Directfile)PROCEDURE finddirectfile(filespec,update);
VALUE filespec; TEXT filespec; BOOLEAN update;
COMMENT If a Directfile according to the specification can be opened,
then return a file ref, otherwise NONE. If update is TRUE,
assume read AND write access, otherwise handle as if /ACCESS:RONLY were given;

! *;! MACRO-10 code *;!

	TITLE	finddirectfile
	SUBTTL	SIMULA utility, Lars Enderin Oct 1975

;!*** Copyright 1975 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed.					***

	ENTRY	finddirectfile
	sall
	search	simmac,simmcr,simrpa
	macinit

	result==ZBI%S
	filespec==result+1
	update==filespec+2
	.ACRED==5	;! Parameter to signify read access to CHKACC
	.ACWRI==2	;! Parameter to signify write access to CHKACC
	OPDEF	CHKACC	[CALLI	100]

finddirectfile:
	PROC
	EXEC	CPNE	;! Allocate a file object
	XWD	0,IODF	;! Directfile prototype
	IF	;! NOT update
		SKIPE	update(XCB)
		GOTO	FALSE
	THEN	;! Set /ACCESS:RONLY
		SETON	ZFIRON(XWAC1)
	FI
	SETON	ZFIFND(XWAC1)	;! Flag special case
	LD	filespec(XCB)	;! Copy the parameter
	STD	OFFSET(ZFISPC)(XWAC1)
	EXEC	CSEN
	IF	;! Found
		IFOFF	ZIFEND(XWAC1)
		GOTO	FALSE
	THEN	;! Check access rights further
		LF	XWAC4,ZFIFIL(XWAC1)
		LF	XWAC4,ZXBPT(XWAC4)
		HRLI	XWAC4,.ACRED	;! Read access to be checked
		IFOFF	ZFIRON(XWAC1)
		HRLI	XWAC4,.ACWRI	;! Write access if not RONLY
		CALLI	XWAC5,24	;! User ppn
		 CAI	;! In case of JACCT
		SKIPN	XWAC6,OFFSET(ZFIPPN)(XWAC1)	;! File ppn
		L	XWAC6,XWAC5
		LI	XWAC4
		CHKACC
		SETZ	;! Assume access allowed on error return
		JUMPN	FALSE
		ST	XWAC1,result(XCB)
		SETOFF	ZFIFND(XWAC1)
	ELSE	;! Close to get rid of core claimed etc
		EXEC	IOCL
	FI
	BRANCH	CSEP
	EPROC
	END;