Comment * SIMULA specification;
OPTIONS(/E:CODE,scratchfile);
BOOLEAN PROCEDURE scratchfile(filespec);
VALUE filespec; TEXT filespec;
COMMENT Attempt to delete the file specified. Return TRUE if successful;

! *;! MACRO-10 code *;!

	TITLE	scratchfile
	SUBTTL	SIMULA utility, Lars Enderin Oct 1975

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

	ENTRY	scratchfile
	sall
	search	simmac,simmcr,simrpa
	macinit

	result==ZBI%S
	filespec==result+1
	.ACREN==5	;! Parameter to signify rename access to CHKACC
	OPDEF	CHKACC	[CALLI	100]
	.TCRDF==2
	.TCRDD==5

scratchfile:
	PROC
	EXEC	CPNE	;! Allocate a file object
	XWD	0,IOIN	;! Infile prototype
	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	;! Use RENAME to delete the file
		ZF	ZFIFIL(XWAC1)
		ZF	ZFIEXT(XWAC1)
		HLLZ	OFFSET(ZFICHN)(XWAC1)
		IF	;! Not channel 0
			JUMPE	FALSE
		THEN	;! Try RENAME to delete
			HRRI	OFFSET(ZFIFIL)(XWAC1)
			TLO	(RENAME)
			XCT
			SKIPA
			SETOM	result(XCB)
		FI
	ELSE	;! May be TMP:?
		MOVSI	'TMP'
		IF	;! TMP:
			CAME	OFFSET(ZFIDVN)(XWAC1)
			GOTO	FALSE
		THEN	;! Use TMPCOR UUO
			MOVSI	X2,.TCRDF	;! Read and delete
			LF	,ZFIFIL(XWAC1)	;! File name
			CAMN	['*     ']
			MOVSI	X2,.TCRDD	;! Delete directory
			LI	X1,XWAC4	;! Zero length buffer
			TMPCOR	X2,
			SKIPA			;! Error return
			SETOM	result(XCB)	;! Ok return
		FI
	FI
	;! Close to get rid of core claimed etc
	EXEC	IOCL
	BRANCH	CSEP
	EPROC
	END;