txtsave.asm

[随书类]Dos6.0源代码

	call	PrsActivateCP
	sub	ax,ax			;return no-error result
;al = error code
ShExit:
	mov	[ps.PS_bdpDst.BDP_cbLogical],0 ;release space held by temp bd
	or	al,al			;set condition codes for caller
	pop	di			;restore caller's si,di
	pop	si
	ret

ShOmErr:
	pop	ax			;discard oPrs
	mov	al,ER_OM		;return al = out-of-memory error
	jmp	SHORT ShExit
SaveProcHdr ENDP

;Cause runtime error "Out of memory"
OmErrCP:
	mov	al,ER_OM
	call	RtError

;*************************************************************
; ONamOtherOMrs
; Purpose:
;	Given an oNam in current mrs, convert it to an oNam
;	in another mrs (which has a different name table).
; Entry:
;	grs.oMrsCur = source oMrs
;	ax = source oNam
;	dx = target oMrs
; Exit:
;	ax = target oNam (0 if out of memory error)
;	flags set based upon return value.
;
;*************************************************************
cProc	ONamOtherOMrs,<NEAR>		
	localV	bufNam,CB_MAX_NAMENTRY	
cBegin
	cmp	[grs.GRS_oMrsCur],dx
	je	OnOExit			;brif source mrs = target mrs

	xchg	ax,bx			;bx = oNam (save until CopyONamPb)
	push	di
	push	[grs.GRS_oRsCur]	;save caller's oRs -for RsActivate below

	mov	di,dx			;di = target oMrs
	lea	ax,bufNam
	push	ax			;save ptr to string
					; string ptr in ax
					; oNam to CopyONamPb in bx
	cCall	CopyONamPb,<ax,bx>	; ax = byte count
	push	ax			;save byte count
	cCall	MrsActivateCP,<di>	;activate target mrs
	pop	cx			;cx = byte count
	pop	ax			;ax = ptr to bufNam
	call	ONamOfPbCb		;ax = target oNam (ax=Pb, cx=Cb)
	xchg	di,ax			;di = target oNam

	call	RsActivateCP		;re-activate caller's oRs
					; parm was pushed on entry
	xchg	ax,di			;ax = target oNam
	pop	di			;restore caller's es,di
OnOExit:
	or	ax,ax			;set condition codes
cEnd

;*************************************************************
; SaveDeclares
; Purpose:
;	Generate synthetic DECLARE stmts for forward referenced
;	SUBs and FUNCTIONs in this module as follows:
;	Pass1:
;	 For every prs in system,
;	   reset FTX_TmpDecl
;	   if prs type is FUNCTION and prs is in mrs being saved,
;	      set FTX_TmpRef bit, else reset it
;	Pass2:
;	 For every text table in this module
;	   Search text table for a reference to a SUB or FUNCTION
;	    if opStDeclare ref found
;	       set FTX_TmpDecl bit
;	    else if CALL, CALLS, implied CALL
;	       set FTX_TmpRef bit
;	Pass3:
;	 For every prs in system,
;	   if FP_DEFINED and FTX_TmpRef bit are set, and FTX_TmpDecl bit is not,
;	   copy pcode for definition to module, changing opcode to opStDeclare,
;	   and changing the oNam for each formal parm and explicitly
;	   listing the TYPE.
;
; Exit:
;	grs.fDirect = FALSE
;	ax = 0 for out of memory error.
;	flags set on value in ax
;*************************************************************

;----------------------------------------------------------------
;	 For every prs with a text table in system,
;	   reset FTX_TmpDecl
;	   if prs type is FUNCTION and prs is in mrs being saved,
;	      set FTX_TmpRef bit, else reset it
;----------------------------------------------------------------
cProc	SdPass1,<NEAR>
cBegin
	and	[txdCur.TXD_flags],NOT (FTX_TmpDecl OR FTX_TmpRef)
					;start out by turning both bits off
	cmp	[prsCur.PRS_procType],PT_FUNCTION
	jne	Sd1ResetBits		;exit if SUB
	mov	ax,[oMrsSaveDecl]
	cmp	ax,[prsCur.PRS_oMrs]
	jne	Sd1ResetBits		;exit if Func defined in another module

	;for func in module, assume it is referenced.  For external func
	;refs, even qbi requires user have a DECLARE stmt for it.
	
	or	[txdCur.TXD_flags],FTX_TmpRef ;turn on FTX_TmpRef bit
Sd1ResetBits:
	mov	ax,sp			;return TRUE for ForEachCP
cEnd

;-----------------------------------------------------------------
;	 For every text table in module being saved:
;	   Search text table for a reference to a SUB or FUNCTION
;	    if opStDeclare ref found
;	       set FTX_TmpDecl bit
;	    else if CALL, CALLS, implied CALL
;	       set FTX_TmpRef bit
;-----------------------------------------------------------------
cProc	SdPass2,<NEAR>,<si>
cBegin
	SetStartOtx si			;otxCur = start of text
Sd2Loop:
	push	si
	PUSHI	ax,<CODEOFFSET tOpDecl>
	call	TxtFindNextOp		;ax = otx to next opStDeclare opcode
	cmp	dl,DECL_opEot
	je	Sd2Exit
	xchg	si,ax			;si = new otxCur
	GetSegTxtTblCur			;es = seg addr of text table
	mov	ax,es:4[si]		;ax = oPrs field
	call	PPrsOPrs		; es:bx points to prs structure
					;all other regs preserved
	test	BPTRRS[bx.PRS_flags],FP_DEFINED 
	je	Sd2Loop			;don't count references to native-code
					; procedures, only those defined with
					; a SUB/FUNCTION stmt
	mov	al,FTX_TmpRef
	.errnz	DECL_opStDeclare
	or	dl,dl			;dl = 0 for DECLARE, non-zero for CALL
	jne	Sd2SetBit		;brif CALL
	mov	al,FTX_TmpDecl
Sd2SetBit:
	or	BPTRRS[bx.PRS_txd.TXD_flags],al 
	jmp	SHORT Sd2Loop

Sd2Exit:
	mov	ax,sp			;return TRUE for ForEachCP
cEnd

;***
;GetWord
;Purpose:
;	This header block added as part of revision [5]
;Preserves:
;	All but ES, BX, and SI
;******************************************************************************
GetWord PROC NEAR
	GetSegTxtTblCur			;es = seg addr of text table
	lods	WORD PTR es:[si]	;ax = cntEos
	ret
GetWord ENDP

MoveWord PROC NEAR
	call	GetWord
	jmp	Emit16_AX		;emit cntEos operand
					; and return to caller
MoveWord ENDP

;------------------------------------------------------------------------------
;	 For every prs with a text table in system,
;	   if FP_DEFINED and FTX_TmpRef bit are set, and FTX_TmpDecl bit is not,
;	   copy pcode for definition to module, changing opcode to opStDeclare,
;	   and changing the oNam for each formal parm and explicitly
;	   listing the TYPE.
;
;------------------------------------------------------------------------------
cProc	SdPass3,<NEAR>,<si,di>
	localW	oNamParm
cBegin
	test	[prsCur.PRS_flags],FP_DEFINED
	je	J1_Sd3Exit		; don't count references to
					; undefined procedures

	test	[txdCur.TXD_flags],FTX_TmpRef
	je	J1_Sd3Exit		;don't generate DECLARE for text tbl
					; with no references in this module
	test	[txdCur.TXD_flags],FTX_TmpDecl
	je	EmitDecl		;don't generate DECLARE for prs which
J1_Sd3Exit:
	jmp	Sd3Exit			; already has a declare in this prs

EmitDecl:
	mov	ax,[prsCur.PRS_otxDef]	; ax = otx to opStSub/Function
	mov	si,ax			;ax = si = text offset
	call	OtxDefTypeCur		;fill ps.tEtCur with default types
					; at definition of procedure
	mov	ax,opBol
	call	Emit16_AX

	mov	ax,opStDeclare
	call	Emit16_AX

	lodsw				;si=si+2 (points to cntEos parm)
	.errnz DCL_cntEos
	call	MoveWord		;move cntEos from es:[si] to ps.bdpDst

	.errnz DCL_oPrs	- 2
	call	MoveWord		;move oPrs from es:[si] to ps.bdpDst

	.errnz DCL_atr - 4
	call	GetWord			;ax = procAtr from es:[si]
	push	ax			;save proc atr
	.errnz	DCLA_procType - 0300h
	and	ah,DCLA_procType / 100h	;ah = procType
	cmp	ah,PT_FUNCTION
	jne	NoProcType		;brif this is not a FUNCTION
  	.errnz DCLA_Explicit - 0080h
	or	al,al
	js	NoProcType		;brif it was explicitly typed
	push	[prsCur.PRS_ogNam]	
	call	ONamOfOgNam		; ax = oNam of this prs
	DbAssertRel  ax,nz,0,CP,<txtsave.asm: ONamOfOgNam returned ax = 0>
	cCall	OTypOfONamDefault,<ax>	; ax = default oTyp (ax)
  	or	al,DCLA_Explicit	;remember this was Explicitly typed
	pop	dx
	mov	ah,dh			;ax = new procAtr
	push	ax
;top of stack = procAtr
NoProcType:
	call	Emit16			;emit proc atr operand

	.errnz DCL_cParms - 6
	call	GetWord			;ax = cParms operand from es:[si]
	mov	di,ax			;di = cParms
	call	Emit16_AX		;emit cParms operand
	inc	di
Sd3ParmLoop:
	dec	di			;decrement parm count
	jz	Sd3Exit			;brif done with parms
	.errnz	DCLP_id - 0	
	call	GetWord			;ax = parm's oNam or oVar
	cCall	oNamoVarRudeOrParse,<ax>;if we text not in rude map oVar
					; to oNam
	mov	[oNamParm],ax
	mov	dx,[oMrsSaveDecl]
	call	ONamOtherOMrs		;ax = equivalent oNam in module dx
					; (es is preserved)
	je	Sd3OmExit		;brif OM error (AX=0) to stop ForEach
	call	Emit16_AX		; oVar in SS_PARSE or SS_EXECUTE

 	.errnz DCLP_atr - 2		;Formal parm attributes (PATR_xxx)
	call	GetWord			;ax = formal parm atr
	push	ax			;save parmAtr
	.errnz	PATR_asClause AND 0FFh
	test	ah,PATR_asClause / 100h
	jne	Sd3AsClause		;brif 'id AS xxx'
	.errnz	PATR_explicit AND 0FFh
	or	ah,PATR_explicit / 100h	;in DECLARE, force it to be explicit
Sd3AsClause:
	call	Emit16_AX

	; if not SS_RUDE, it is oTyp of user type.
	
	.errnz DCLP_oTyp - 4		;Type of the formal parm
	call	GetWord			;ax = oNam for <user type> if > ET_MAX

	pop	bx			;bx = parmAtr
	.errnz	PATR_asClause AND 0FFh
	.errnz	PATR_explicit AND 0FFh
	test	bh,(PATR_explicit OR PATR_asClause) / 100h
	jne	NotImpl			;brif not implicitly typed
	push	[oNamParm]		
	call	OTypOfONamDefault	;ax = default oTyp for parm (ax)
NotImpl:
	cmp	ax,ET_MAX
	jbe	NotUserTyp		;brif it is a primitive type

	;Since declares are inserted before any type declarations, we cannot
	;insert any references to a type name in the declare.  SOOO, we
	;just always use as ANY for synthetic declares with user defined
	;types.
	sub	ax,ax			;ax = AS ANY
NotUserTyp:
	call	Emit16_AX
	jmp	SHORT Sd3ParmLoop

Sd3Exit:
	mov	ax,sp			;return TRUE for ForEachCP
Sd3OmExit:
cEnd

;-------------------------------------------------------------
; SaveDeclares - main code
;-------------------------------------------------------------
PUBLIC	SaveDeclares			;for debugging only
cProc	SaveDeclares,<NEAR>,<si>
cBegin
DbAssertRelB [txdCur.TXD_scanState],e,SS_RUDE,CP,<SaveDeclares:TxdCur not in SS_RUDE>
	call	PrsDeactivate		;make module's txt tbl active
	mov	ax,[grs.GRS_oMrsCur]
	mov	[oMrsSaveDecl],ax

	test	[mrsCur.MRS_flags2],FM2_Include ;is this an include mrs?
	jne	SdGoodExit		;don't insert decls into include
					;mrs's.  Re-Including could break
					;a previously running program.

	;For each prs in system which has a text table:
	mov	al,FE_PcodeMrs+FE_PcodePrs+FE_SaveRs
	mov	bx,CPOFFSET SdPass1	;bx = adr of function to call
	call	ForEachCP

	;For each text table in module being saved:
	mov	al,FE_CallMrs+FE_PcodePrs+FE_SaveRs
	mov	bx,CPOFFSET SdPass2	;bx = adr of function to call
	call	ForEachCP

	sub	ax,ax			
	mov	[ps.PS_bdpDst.BDP_cbLogical],ax
	call	SetDstPbCur

	;For each prs in system which has a text table:
	mov	al,FE_PcodeMrs+FE_PcodePrs+FE_SaveRs
	mov	bx,CPOFFSET SdPass3	;bx = adr of function to call
	call	ForEachCP
	je	SdExit			;brif out-of-memory

	SetStartOtx si			;insert DECLAREs at start of module
	call	TxtInsert
	je	SdExit			;brif out-of-memory

	SetStartOtx si			;otxInsert = start of text
	mov	bx,[ps.PS_bdpDst.BDP_cbLogical] ;pass cbInserted in bx
	or	bx,bx			;was any pcode inserted?
	je	NoDeclaresInserted	;brif not
	or	[mrsCur.MRS_flags2],FM2_Modified ;set modified bit so compiler
					;will compile same source as QBI for
					;MakeExe.
	push	bx			;save cbInsert
	call	DrawDebugScrFar		;update list windows for inserted text
	pop	bx			;restore bx=cbInsert
NoDeclaresInserted:
	call	TxtInsUpdate
SdGoodExit:				
	mov	ax,sp			;return non-zero (not out-of-memory)
SdExit:
	or	ax,ax			;set condition codes
cEnd


;*************************************************************
; SaveAllDeclares
; Purpose:
;	Generate synthetic DECLARE stmts for forward referenced
;	SUBs and FUNCTIONs for every module in the system.
;	Called by UI before MakeExe to ensure that Compiler
;	will compile same source as interpreter.  This solves
;	the situation for a QB2/3 program is loaded and works
;	correctly for QBI, but will not compile in BC.	If we
;	have inserted synthetic declares, or altered the pcode
;	in some way, we need to make sure that the dirty bit