txtsave.asm

[随书类]Dos6.0源代码

;	gets set for the module.
; Entry:
;	none.
; Exit:
;	grs.fDirect = FALSE
;	ax = 0 for no error, else QBI standard error code.
;*************************************************************
cProc	SaveAllDeclares,<PUBLIC,FAR>
cBegin
	;For each mrs in system which has a pcode text table:
	mov	al,FE_PcodeMrs+FE_CallMrs+FE_SaveRs
	mov	bx,CPOFFSET SaveDeclares ;bx = adr of function to call
	call	ForEachCP
	mov	ax,ER_OM		;default Out of memory error
	je	SaveAllDeclaresExit	;brif out-of-memory
	sub	ax,ax
SaveAllDeclaresExit:
cEnd

;*************************************************************
; ushort AsciiSave()
; Purpose:
;	ASCII save the current module (with all its procedures)
;
; Exit:
;	grs.fDirect = FALSE
;	ps.bdpSrc is used
;	ax = 0 if no error, else Standard BASIC error code (i.e. ER_xxx)
;
; Exceptions:
;	Can cause runtime error (Out of memory, I/O errors)
;
;*************************************************************
cProc	AsciiSave,<NEAR>,<si>
cBegin
	call	AlphaBuildORs		; build sorted list of all oRs's
	or	ax,ax			;set flags based on returned value
	mov	ax,ER_OM		;prepare to return Out-of-memory error
	je	AsDone			;brif error
	call	PrsDeactivate		;make module's txt table active
	sub	ax,ax
	mov	[fLsDynArrays],al	;default state is $STATIC
	DbAssertRel ax,e,0,CP,<AsciiSave: ax!=0> ;SaveTxdCur needs ax=0

;ax = otx of 1st line in current text table to be written to file
AsLoop:
	call	SaveTxdCur		;save module/procedure text table
	test	[mrsCur.MRS_flags2],FM2_NoPcode ; document file?
	jne	NotModuleText		; brif so, never add blank line
	cmp	ax,2			;was last line a blank one?
	jbe	NotModuleText		;brif so
	call	OutCrLf 		;output a blank line so comment blocks
					;are associated with correct text tbls
NotModuleText:
	call	OtxDefTypeEot		;fill ps.tEtCur with default types
					; at end of module/procedure
	call	NextAlphaPrs		;activate next procedure in module
	or	ax,ax			;set flags
	je	AsDone			;brif no more procedures in module
	SetStartOtx ax			
	test	[prsCur.PRS_flags],FP_DEFINED
	je	ProcNotDefined		;brif no SUB/FUNCTION stmt
	push	[prsCur.PRS_otxDef]	;push offset to opStSub/opStFunction
	call	OtxBolOfOtx		;ax = text offset for 1st line of SUB
ProcNotDefined:
	mov	si,ax			;si = ax = otxProcDef
	call	SaveProcHdr		;save proc hdr(ax) (may contain some
					; synthetically generated statements
	jne	AsDone			;brif error
	xchg	ax,si			;ax = otxProcDef
	jmp	SHORT AsLoop

;al = 0 if no error, else standard QBI error code
AsDone:
cEnd	;AsciiSave

;****************************************************************************
;SaveModName - save the name of the current module to the file
;
;Purpose:
;	Used by Save to save the name of each module in a .MAK file.
;Entry:
;	The .MAK file is open to current channel
;	si points to static buffer holding name of the MAK file's directory.
;	di points to static buffer which can be used to hold module's name
;Exceptions:
;	Assumes caller called RtSetTrap to trap runtime errors.
;
;****************************************************************************
SaveModName PROC NEAR
	mov	ax,di			; pDest (parm to CopyOgNamPbNear)
	mov	bx,[mrsCur.MRS_ogNam]	; ogNam (parm to CopyOgNamPbNear)
	call	CopyOgNamPbNear		; copies name to buffer, returns 
					;   ax = cbName
	mov	bx,di			
	add	bx,ax			; add cbName
	mov	BYTE PTR [bx],0		; zero terminate

	;MakeRelativeFileSpec(szFilename, szMakDirectory)
	cCall	MakeRelativeFileSpec,<di,si> ;convert szFilename to relative
					; path from szMakDirectory if possible
	cCall	CbSz,<di>		;ax = length of result path
					;ax = size of line to output
	mov	bx,di			;bx points to start of line to output
	call	OutLine			;output the line
	ret
SaveModName	ENDP

;****************************************************************************
; FNotMainModule
; Purpose:
;	Called via ForEachCP to see if there is any pcode module
;	that is not the main module (i.e. to see if this is a
;	multiple-module program.
; Exit:
;	Return 0 in ax if current module is not main-module
;	else return non-zero in ax
;
;****************************************************************************
FNotMainModule PROC NEAR
	mov	ax,[grs.GRS_oMrsCur]
	cmp	ax,[grs.GRS_oMrsMain]
	mov	ax,sp			;prepare to return non-zero
	je	FNotMainExit
	sub	ax,ax			;return 0 (not main module)
FNotMainExit:
	ret
FNotMainModule ENDP

;*************************************************************
; SaveMakFile
; Purpose:
;	Called by SaveFile to see if we're saving the main module
;	of a multi-module program.  If so, this creates <filename>.MAK
;	file and writes the names of all modules in the program.
; Entry:
;	mrsCur.ogNam is current module's filename
; Exit:
;	ax = error code (0 if none), condition codes set
; Exceptions:
;	assumes caller has called SetRtTrap to trap runtime errors
;
;*************************************************************
cProc	SaveMakFile,<NEAR>,<si,di>
	localV	szDir,FILNAML		
	localV	filenameNew,FILNAML	; size expected by runtime routines
					; used for filename normalization
	localV	sdFilenameNew,<SIZE SD>
cBegin
	mov	ax,[grs.GRS_oMrsMain]
	cmp	ax,[grs.GRS_oMrsCur]
	jne	SmfGood			;brif this isn't main module

	mov	bx,si			;bx = psdFilename
	lea	si,[sdFilenameNew]	;si = &sdFilenameNew
	lea	di,[filenameNew]	
	mov	[si.SD_pb],di		; set up string descr.
	call	MakFilename		;fill di with <moduleName>.MAK
	jne	SmfExit 		;brif Bad File Name

	mov	al,FE_PcodeMrs+FE_CallMrs+FE_SaveRs
	mov	bx,CPOFFSET FNotMainModule ;bx = adr of function to call
	call	ForEachCP		;ax=0 if multi-module program
	je	MultiModules		;brif multi-module program is loaded
	push	di			;pass ptr to szFilenameNew
	call	DelFile			;delete filename.MAK
	jmp	SHORT SmfGood		;exit if not multi-module program

;Open filename in sdFilename (si) (.MAK file) and write all module names to it
MultiModules:
	;If we could assume DOS 3.0 or greater, (we can't yet) we could set
	;dx to (ACCESS_WRITE OR LOCK_BOTH) SHL 8 OR MD_SQO
	
	mov	dx,MD_SQO
	call	OpenChan		;al = error code (0 if no error)
	jne	SmfExit			;brif errors

	;fill si with sz for directory of .MAK file
	lea	si,szDir		;si points to working static buffer
	push	di			;pass pbSrc (filenameNew)
	push	si			;pass pbDst (szDir)
	mov	bx,[sdFilenameNew.SD_cb]
	push	bx			;pass byte count
	mov	BYTE PTR [bx+si],0	;0-terminate destination
	call	CopyBlk			;copy module name to static buffer
	push	si			;pass szDir
	call	FileSpec		;ax points beyond pathname
	xchg	bx,ax			;bx points beyond pathname
	mov	BYTE PTR [bx-1],0	;0-terminate szDir

	;Save the name of the Main Module first, so it will be loaded first
	;si points to szDir
	;di points to filenameNew (will be used for temp buffer)
	
	call	SaveModName		;write main module's relative path
	call	MrsDeactivate		;start writing other module names
SmLoop:
	call	NextMrsFile_All 	;make next mrs active
	inc	ax			;test for UNDEFINED (end of mrs list)
	je	SmDone			;brif done with all mrs's
	dec	ax			;restore ax = module's name
	cmp	ax,[grs.GRS_oMrsMain]
	je	SmLoop			;brif this is MAIN mod (already output)
	test	[mrsCur.MRS_flags2],FM2_NoPcode OR FM2_Include
	jne	SmLoop			;skip document and include mrs's
	call	SaveModName
	jmp	SHORT SmLoop

SmDone:
	push	[grs.GRS_oMrsMain]	;we know the main module was active
	call	MrsActivateCP		; on entry - reactivate it on exit

	call	CloseChan		;close [chanCur]
SmfGood:
	sub	ax,ax
SmfExit:
	or	ax,ax			;set condition codes for caller
cEnd

;*************************************************************
; ushort SaveFile()
; Purpose:
;	Open the specified file and save program to it.
;
; Entry:
;	mrsCur.ogNam = filename to be saved.
;	   (the filename need not be 0-byte terminated)
;	mrsCur.flags2 FM2_AsciiLoaded is TRUE for ASCII Save
;	FOR EB: parm1 = mode for opening file
;
; Exit:
;	ps.bdpSrc is used
;	grs.fDirect = FALSE
;	ax = 0 if no error, else Standard BASIC error code (i.e. ER_xxx)
;
;*************************************************************
cProc	SaveFile,<PUBLIC,FAR,NODATA>,<si>
	localV	FileName,FILNAML	
	localV	sdFileName,<SIZE SD>	
cBegin
	mov	ax,-MSG_Saving		;display Saving msg in intense video
	call	StatusMsgCP		; to tell user we're loading
	call	AlphaORsFree		;release table of sorted oRs's
					; (user interface may have chosen
					;  a new name for this mrs)
	push	[grs.GRS_oRsCur]	;save mrs/prs - restored on exit

	call	RtPushHandler		;save caller's runtime error handler
					; could be called by LoadFile->NewStmt
					; (NOTE: alters stack pointer)
	SetfDirect al,FALSE		;turn off direct mode
	mov	ax,CPOFFSET SfDone	;if any runtime errors occur,
	call	RtSetTrap		;branch to SfDone with sp,di =
					;current values

					; doesn't have to be recompiled
	call	ModuleRudeEdit		
	call	SaveDeclares		;generate synthetic DECLARE stmts
					; for forward-referenced
	mov	ax,ER_OM		;default to OM error
	je	SfDone			;brif error

	lea	si,[sdFileName]		;cant use buffers here used for
	lea	ax,[FileName]  		;load because we may need to save
	mov	[si.SD_pb],ax		;current module during fileopen
	mov	bx,[mrsCur.MRS_ogNam]	
	call	CopyOgNamPbNear		; ax = number of chars copied
	mov	[si.SD_cb],ax		
	call	SaveMakFile		;create <filename>.MAK if main
					; program of multi-module program.
	jne	SfDone			;brif errors

	;If we could assume DOS 3.0 or greater, (we can't yet) we could set
	;dx to (ACCESS_WRITE OR LOCK_BOTH) SHL 8 OR MD_SQO
	
	mov	dx,MD_SQO
	call	OpenChan		;[chanCur] = channel #
	jne	SfDone			;brif error


DoAsciiSave:
	call	AsciiSave		;al = errCode

;We're done trying to write the file, now try to close it.
;Closing the file can cause I/O errors when close flushes the buffer.
;al = 0 if no error, else standard QBI error code
SfDone:
	sub	ah,ah			;ax = error code
SfDone2:				
	xchg	si,ax			;si = return value
	test	[flagsTM],FTM_SaveProcHdr
	je	NoShCleanup		;brif SaveProcHdr was not in critical
					; section.
	call	RelShBuf		;release temp text tbl used by
					; SaveProcHdr
NoShCleanup:
	call	RtFreeTrap		;free previous trap address
	mov	ax,CPOFFSET SfGotErr	;if any runtime errors occur,
	call	RtSetTrap		;branch to SfGotErr with sp,bp,si,di
					;set to current values
	call	CloseChan		;close file before kill
					; (sets ChanCur = 0)
	cCall	RtFreeTrap		; release error handler
	test	si,7FFFh		; test low 15 bits for error code
	je	SfNoErr			;brif no error before close

	xor	ax, ax			; no error during close

;If we got an error during save, delete partially created file
SfGotErr:

	test	si, 7fffh		; do we already have an error
	jnz	SfTestDelFile		; brif so, use it
	or	si, ax			; else add in new error


;	Only delete the file if we actually created and started to save
;	a binary file.	We don't want to delete an existing file if we
;	got an error on or before the open, and we also don't want to
;	delete a partially written ascii file.

SfTestDelFile:
	or	si,si			; got to BinarySave?
	jns	SfExit			; no, then don't kill the file

	push	di			
	mov	ax,CPOFFSET SfKillErr	; trap & ignore any runtime errors
	cCall	RtSetTrap		; in KILL 
	sub	sp,((FILNAML+SIZE SD+2)+1) AND 0FFFEh ;[3] create a fake sd
						      ;    on the stack
	mov	di,sp			
	add	di,6			; pnt to strt of where string will be
	mov	[di-2],di		; setup pb part of fake sd
	mov	ax,di			; parm to CopyOgNamPbNear
	mov	bx,[mrsCur.MRS_ogNam]	; parm to CopyOgNamPbNear
	call	CopyOgNamPbNear		; copy name onto stack, ax = cbName
	sub	di,4			; di = pFakeSd
	mov	[di],ax			; set up cb part of fake sd
	cCall	B$KILL,<di>		; call rt to delete file
	add	sp,((FILNAML+SIZE SD+2)+1) AND 0FFFEh ;[3] restore stack ptr

SfKillErr:				; branched to if error during KILL
	pop	di			

	jmp	SHORT SfExit

SfNoErr:
	and	[mrsCur.MRS_flags2],NOT (FM2_Modified or FM2_ReInclude) 
	and	[mrsCur.MRS_flags3],NOT FM3_NotFound ;If the user told
					;us to save the file, we have
					;found it.
	test	[mrsCur.MRS_flags2],FM2_Include
	je	SfExit			;brif this is not an $INCLUDE file
	or	[flagsTm],FTM_reInclude	;re-parse all $INCLUDE lines in
					;all modules before next RUN
SfExit:
	and	[flagsTM],NOT FTM_SaveProcHdr ;reset critical section flag
	call	RtPopHandler		;restore caller's runtime error handler
					; (saved on stack by RtPushHandler)
	call	RsActivateCP		;restore caller's mrs/prs
	call	StatusMsg0CP		;tell user interface we're done saving
	xchg	ax,si			;restore ax = error code
	and	ah,7Fh			; clear BinarySave flag bit
cEnd


sEnd	CP

end