Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/scratc.mac
There are 2 other files named scratc.mac in the archive. Click here to see a list.
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;