COMMENT * SIMULA specification;
OPTIONS(/E:CODE,ZYLSAV);
INTEGER PROCEDURE save(filedef,continue);
VALUE filedef; TEXT filedef; BOOLEAN continue;
COMMENT Saves core on file specified via filedef.
Returns zero when continuing from a successful save,
1 when the saved file is executed normally, 2-16 when RUN with an
offset 1-15 relative to the start address.
The return value may be specified directly to the RUN procedure, q.v.
The RESTORE procedure causes the value 0 to be returned.
Categories may be expanded later based on experience.
Filedef is an ordinary file specification.
NOTEXT causes FREEZE to be executed. If the file spec has no extension field,
SAV is assumed.  Continue specifies, if TRUE, that the program should continue
even if SAVE was unsuccessful. If continue is FALSE, the run-time I/O dialogue
and/or SIMDDT will provide a way out. No error messages will be issued if
continue is TRUE.
The saved core image may be RUN via the RUN procedure or the RESTORE procedure,
or via the monitor commands RUN, GET - START.
;

!*;! MACRO-10 code !*;!

	TITLE	save
	ENTRY	ZYLSAV
	SUBTTL	SIMULA utility, Lars Enderin Mar 1976

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


	sall
	search	simmac,simmcr,simrpa
	macinit

	EXTERN	ZYLFRZ,.ZYLRJ,.ZYLSJ,.ZYLRS,.ZYLRT

OPDEF	LINKBUFF	[XEC	OCIND]
OPDEF	XEC		[PUSHJ	XPDP,]
OPDEF	jobsave		[JSR	.ZYLSJ]	;! Save job status
OPDEF	jobrestore	[JSR	.ZYLRJ]	;! Restore it
OPDEF	typefile	[XEC	.ZYLTF]

	DEFINE	type(t)<
	OUTSTR	[ASCIZ\
t
\]
>
	;! Local definitions ;!

	.JBREL==44
	.JBHRL==115
	.JBSA==	120
	.JBCOR==133
	.JBFF== 121
	.JBDDT==74
	.JBSDD==114
	.JB41==41
	.JBS41==122


	X17==17
	XHRL==X14
	XJBSA==X13
	XST0==X12


	DEFINE	saverr(msg)<
	IF	SKIPE	continue(XCB)
		GOTO	FALSE
	THEN	OUTSTR	[ASCIZ\
%ZYLSAV msg
\]
		RTSERR	QDSCON,214
	FI
	>

	result==2
	filedef==3
	continue==5

	OPDEF	copytobuffer [PUSHJ XPDP,copytobuffer]
	xfil==	XWAC1	;! Points to file object
	xbp==	x3	;! Pointer into output buffer
	xbe==	x4	;! Points to last word of it
	xnw==	x5	;! Next word pointer when scanning output info
	xnw1==	x6	;! Old value of xnw
	xblt==	x7	;! BLT ac
	xchn==	x10	;! Z <channel no>,0
ZYLSAV:	PROC
	LOWADR
	SETZM	bstart	;! Signifies no i/o done on save file

;! Check and modify filedef if necessary

	LD	x1,filedef(XCB)
	IF	;! NOTEXT
		JUMPN	x1,FALSE
	THEN	;! Use freeze
		Q==1B<%ZFLNTH>+<QSIMPLE>B<%ZFLAKD>+<QDTVSI>B<%ZFLDTP>
		Q==Q+<QINTEGER>B<%ZFLATP>+<QINTEGER>B<%ZFLFTP>
		MOVSI	XWAC1,(Q)
		SF	XCB,ZFLZBI(,XWAC1)
		LI	XWAC2,result
		EXEC	ZYLFRZ
		BRANCH	CSEP
	ELSE	;! Check for extension, supply .SAV if none
		EXEC	checkfiledef
	FI

	LOWADR
	LOOP	;! Check for open files
		SETOFF	SDSCLO(XLOW)	;! Do not close Sysin and Sysout now
		EXEC	IOCLA
	AS	;! Long as open files do exist
		JUMPE	FALSE
		IF	;![137] continueonerror
			SKIPN	continue(XCB)
			GOTO	FALSE
		THEN	;! Direct error return
			SETOM	result(XCB)
			BRANCH	CSEP
		FI
		type	(%ZYLSAV Files open on call to SAVE)	;![137]
		RTSERR	QDSCON,214	;![137]
		GOTO	TRUE
	SA

;! Have RTS prepare the file for output

	EXEC	CPNE	;! Allocate file obj
	XWD	0,IOOU	;! Outfile
	L	[1B<%ZFIBNW>]	;! No buffers wanted
	SKIPE	continue(XCB)
	SETONA	ZFIFND	;! No error dialogue if continuing on errors
	IORM	OFFSET(ZFIFND)(xfil)
	LD	X0,filedef(XCB)
	STD	X0,OFFSET(ZFISPC)(xfil)	;! Pass the parameter
	LI	.IODPR		;! Dump mode
	SF	,ZFIDMO(xfil)
	EXEC	CSEN
	IF	;! No luck or not DSK
		IFOFF	ZIFEND(xfil)
		GOTO	TRUE
		LF	,ZFICHN(xfil)
		DEVCHR
		TLNE	DV.DSK
		GOTO	FALSE
	THEN	;! Close channel etc
		SETON	ZFIFND(xfil)
		EXEC	IOCL
openerr:
luerror:	saverr	(Cannot OPEN/ENTER SAVE file)
		SETOM	result(XCB)	;! [206]
		BRANCH	CSEP		;! [206]
	FI
	LF	xchn,ZFICHN(xfil)	;! Remove file ref
	ADDI	xchn,YIOCHT(XLOW)	;! from channel table
	SETZM	(xchn)
	HLLZ	xchn,OFFSET(ZFICHN)(xfil);! Channel no in ac position
	SETZ
	EXEC	SAGC	;! Collect garbage
	jobsave
	;! Allocate buffer at end of low seg
	;! [137] Code reordered up to OUTSTR ...

	L	xbp,YSATOP(XLOW)
	TRO	xbp,777	;! Adjust to page boundary
	ADDI	xbp,1
	ST	xbp,bstart
L1():!	L	xbe,.JBREL
	TRO	xbe,777		;! Last word in buffer at end of a page
	IF	;! Not even one page
		CAIL	xbe,777(xbp)	;![137]
		GOTO	FALSE
	THEN	;! Get more core
		LI	xbe,2*1000-1(xbp)
		CORE	xbe,
		EXEC	corerror
		GOTO	L1
	FI
	LI	restart
	HRLM	.ZYLRS

	;! Start looking for zeros, move words to buffer

	LI	xnw,.JBSDD-1	;! 1st word - 1
	LI	1(xnw)
	SUB	bstart
	HRLM	xnw
	LI	-1(xbp)
	SUBI	(xbe)
	HRLI	-1(xbp)
	MOVSM	IOWL		;! IOWD buflen,(bstart)
	GOTO	L3		;! Go look for first non-zero word

	LOOP	;! Until core is covered up to buffer start
		HRRM	xnw,(xbp)	;! right half of IOWD for save file segment
		AOBJN	xnw,.+1
		L	xnw1,xnw	;! Save loc of 1st word of chunk
		LOOP	;! Until next zero word
			SKIPE	1(xnw)
		AS
			AOBJN	xnw,TRUE
		SA
		LI	(xnw1)	;! Number of words
		SUBI	1(xnw)	;!  skipped - negated
		HRLM	(xbp)	;! Make IOWD complete
		copytobuffer
		JUMPG	xnw,FALSE
L3():!		LOOP	;! Find next non-zero word
			SKIPN	xblt,1(xnw)
		AS
			AOBJN	xnw,TRUE
		SA
	AS
		JUMPL	xnw,TRUE
	SA

	;! All info copied, form transfer word and append

	MOVSI	(JRST)
	HRR	.JBSA
	ST	(xbp)
	L	bstart
	SUBI	1(xbp)
	HRLM	IOWL	;! Adjust count
	JSR	outbuf
	L	xchn
	TLO	(CLOSE)
	XCT
	;! Check for errors
	L	xchn
	TLO	(STATO)
	HRRI	740000
	XCT
	IF	;! Error
		GOTO	FALSE
	THEN
		saverr	(Cannot close save file)
	FI
	GOTO	L4
errcont:SETOM	.ZYLRS	;! Failure, modify value later?
	IF	;! Channel active
		LDB	[POINT	4,xchn,23]	;! ac field
		DEVCHR
		JUMPE	FALSE
	THEN	;! Release device
L4():!		L	xchn
		TLO	(RELEASE)
		XCT
	FI
	IF	;! Buffer was used
		SKIPN	x1,bstart
		GOTO	FALSE
	THEN	;! Clear used area
		SETZM	(x1)
		HRLI	(x1)
		HRRI	1(x1)
		BLT	(xbe)
	FI
	SETZM	.ZYLRS	;! Signal immediate continuation
restart:	;! We get here via .ZYLRT on restart
	LOWADR
	jobrestore
	HRRE	.ZYLRS
	ST	result(XCB)
	;![206] No message
	BRANCH	CSEP
	EPROC

corerr:	PROC
	SETZM	continue(XCB)
	saverr	(CORE UUO failed in SAVE)
	BRANCH	errcont
	EPROC
	SUBTTL	checkfiledef

checkfiledef:
	PROC
	ADD	x1,[POINT 7,2]
	LF	x2,ZTVLNG(,x1)	;! Byte count
	LOOP	;! Until "." found or no more there
		ILDB	x1
		CAIN	"."
		GOTO	L9
	AS
		SOJG	x2,TRUE
	SA
	;! No dot, make new text with .SAV extension
	LF	xfil,ZTVLNG(XCB,filedef)
	ADDI	xfil,4	;! Allow for ".SAV"
	EXEC	TXBL
	XWD	0,0
	;! Copy, splicing in ".SAV"
	LF	x2,ZTVLNG(XCB,filedef)
	LF	x1,ZTVZTE(XCB,filedef)
	ADD	x1,[POINT 7,2]
	LF	xnw,ZTVZTE(,xfil)
	ADD	xnw,[POINT 7,2]
	LOOP	;! till filename has been found
		ILDB	x1
		CAIE	"["
		CAIN	"/"
		GOTO	FALSE
		CAIN	"<"
		GOTO	FALSE
		CAIE	" "
		CAIN	"	"
		SKIPA		;! Skip blanks and tabs
		IDPB	xnw	;! Copy all other char's
	AS
		SOJG	x2,TRUE
	SA
	;! Extension should be right here
	LI	"."
	IDPB	xnw
	LI	"S"
	IDPB	xnw
	LI	"A"
	IDPB	xnw
	LI	"V"
	IDPB	xnw
	IF	;! Original had more char's
		JUMPLE	x2,FALSE
	THEN	;! Copy those also
		LDB	x1	;! Retrieve last byte
		LOOP
			IDPB	xnw
			ILDB	x1
		AS
			SOJG	x2,TRUE
		SA
	FI
	STD	xfil,filedef(XCB)	;! Replace original spec
L9():!	RETURN
	EPROC
	SUBTTL	typefile

.ZYLTF:	PROC	;! File obj address in x2
	SAVE	x2
	LF	x1,ZTVZTE(x2)
	L	x2,x1
	ADD	x2,1(x1)
	SETZ
	EXCH	(x2)
	OUTSTR	2(x1)
	EXCH	(x2)
	OUTSTR	[ASCIZ\]
\]
	RETURN
	EPROC
copytobuffer:
	PROC
	IF	;! We are near the limit
		CAIGE	xbp,-2(xbe)
		GOTO	FALSE
	THEN	;! Must handle last words carefully
		IF	;! 2 words still free
			CAIE	xbp,-2(xbe)
			GOTO	FALSE
		THEN	;! Store first word of chunk, load next
			ST	xblt,1(xbp)
			ADDI	xbp,1
			AOBJP	xnw1,L9		;! [235]
			SKIPN	xblt,(xnw1)	;! [235]
			AOJA	xbp,L9		;! [235] Next free buf wd
		FI
		IF	;! 1 free word left in buffer
			CAIE	xbp,-1(xbe)
			GOTO	FALSE
		THEN	;! Store next (first) word of data
			ST	xblt,1(xbp)
			JSR	outbuf
		ELSE	;! Buffer was just filled
			JSR	outbuf
			ST	xblt,(xbp)
			ADDI	xbp,1
		FI
	ELSE	;! In the middle of the buffer, store 1st word and update xbp
		ST	xblt,1(xbp)
		ADDI	xbp,2
	FI
	IF	;! More than one word
		CAMG	xnw,xnw1
		GOTO	FALSE
	THEN	;! Use BLT
		LOOP
			HRLI	xblt,1(xnw1)
			HRRI	xblt,(xbp)
			LI	x2,(xbp)
			ADDI	x2,-1(xnw)
			SUBI	x2,(xnw1)
			L	xnw1,xblt
			IF	;! Data does not fill buffer
				CAIL	x2,(xbe)
				GOTO	FALSE
			THEN	;! Move once, return
				BLT	xblt,(x2)
				LI	xbp,1(x2)
				GOTO	L9
			FI
			BLT	xblt,(xbe)
			JSR	outbuf
			HLRZ	xnw1
			SUBI	(xnw1)
			ADDI	(xbe)
			HRRM	xnw1
		AS
			GOTO	TRUE
		SA
	FI
L9():!	RETURN
	EPROC
outbuf:	PROC
	Z	;! JSR entry
	L	IOWL
	SETZ	x1,
	L	x2,xchn
	TLO	x2,(OUT)
	XCT	x2
	IF	;! OUT did not work
		GOTO	FALSE
	THEN	;! Error
		saverr	(Output error in SAVE)
		BRANCH	errcont
	FI
	L	xbp,bstart	;! Reset buffer pointer
	BRANCH	@outbuf
	EPROC


IOWL:	BLOCK	1
	Z
bstart:	BLOCK	1
	LIT
	END;