txtutil.asm

Dos6.0

	;In essense we are starting from the top of the prs chain each time
	;through the loop below after freeing a Def Fn. If not a Def Fn we
	;walk from prs to prs, not freeing them.
	push	[grs.GRS_oRsCur]		;remember oRsCur for reacivation
FreeDefFn_Loop:
	call	far ptr NextPrsInMrs		;activate next prs in this mrs
	inc	ax				;no more prs's in this module?
	jz	FreeDefFn_Done			;  brif so
	cmp	[prsCur.PRS_procType],PT_DEFFN
	jne	FreeDefFn_Loop			;brif not a DEF FN (must be
						; DECLARE, SUB, or FUNCTION)
	call	PrsFree 			;release DEF FN's prs entry
	jmp	short FreeDefFn_Loop		; resets grs.oRsCur to UNDEFINED
FreeDefFn_Done:
	cCall	RsActivate			;reactivate oRsCur - already
						; on stack
;end of revision [39]

	mov	al,NOT (NM_fShared OR NMSP_Variable)
	call	ResetTNamMask
FreeVarTbl:
	call	VarRudeReset		;erase module's variable & type tables
NoVarTbl:
	or	[mrsCur.MRS_flags],FM_AllSsRude ;all tables are now SS_RUDE
	SetfDirect al,FALSE		;turn off Direct mode
	mov	ax,sp			;return non-zero (for ForEachCP)
cEnd

cProc	ModuleRudeEditFar,<PUBLIC,FAR>
cBegin
	call	ModuleRudeEdit
cEnd

;**************************************************************
; TxtDescan()
; Purpose:
;	Descan the current text table to SS_PARSE in preparation
;	for an edit (i.e. a call to TxtDelete or TxtChange).
;	If it is a module's text table being descanned, all procedures
;	within the module are descanned as well, because they could
;	contain text offsets into module's text table which are now
;	invalid.  For example, RESTORE <label>, ON ERROR GOTO <label>,
;	ON <event> GOSUB <label>.
;
;**************************************************************
cProc	TxtDescanCP,<PUBLIC,NEAR>
cBegin
	mov	[descanTo],SS_PARSE
	test	[txdCur.TXD_flags],FTX_mrs
	je	ProcOnly	;brif descanning a procedure text table
	mov	al,FE_PcodePrs+FE_SaveRs
	mov	bx,CPOFFSET DoDescan
	call	ForEachCP		;DoDescan can return no error codes
ProcOnly:
	call	DoDescan
cEnd

;**************************************************************
; TxtModified()
; Purpose:
;	Descan the current text table to SS_PARSE in preparation
;	for an edit (i.e. a call to TxtDelete or TxtChange).
;	It also sets FM2_Modified bit in current module, so user
;	will be prompted to save it before next NEW or LOAD
; Exit:
;	current module's fModified bit is set TRUE
;
;**************************************************************
cProc	TxtModified,<FAR,PUBLIC>		
cBegin	TxtModified				
	test	[mrsCur.MRS_flags2],FM2_File
	je	TmExit			;brif this mrs has no FILE
TmMod:
	or	[mrsCur.MRS_flags2],FM2_Modified or FM2_ReInclude 
					;This call is always followed
					; by a call to TxtChange/TxtDelete
TmExit:
	jmp	SHORT StartTxtDescan		
TxtModified ENDP

cProc	TxtDescan,<FAR,PUBLIC>			
cBegin	TxtDescan				
StartTxtDescan:					
	call	TxtDescanCP		;far to near call gate
cEnd	TxtDescan				

;*********************************************************************
; AskCantCont()
;
; Purpose:
;  AskCantCont() is called by TextMgr when it is about to make an
;  edit which would prevent continuing program execution.
;  This routine can not be called during execution.
;  If already impossible to continue (i.e. grs.otxCONT ==
;     UNDEFINED) AskCantCont returns TRUE.  Otherwise, the user is warned
;     with a dialog box that this edit will prevent continuing.
;  If the user says OK, grs.otxCONT is set to UNDEFINED
;     and the context manager's CantCont() is called (which
;     sets grs.otxCONT to UNDEFINED among other things.
;     AskCantCont() then returns TRUE.
;  If the user says CANCEL, the Debug screen is refreshed (discarding
;     the current edit) and AskCantCont() returns FALSE.
;
; Exit:
;  Returns FALSE if user wants to abort current edit, with
;  condition codes set based on value in ax.
;
;*********************************************************************
cProc	AskCantCont_CP,<PUBLIC,NEAR>
cBegin
	call	AskCantCont
	or	ax,ax			;set condition codes for caller
cEnd	;AskCantCont_CP


;**************************************************************
; AskRudeEdit
; Purpose:
;	Ask if user wants to back out of what will be a RUDE edit
; Note:
;	This function can cause heap movement
; Exit:
;	If user wants to back out, ax = 0
;	else ModuleRudeEdit is performed, ax = nonzero
;	condition codes set based on value in ax
;
;**************************************************************
cProc	AskRudeEdit,<PUBLIC,NEAR>
cBegin
	call	AskCantCont_CP		;ask user "Want to back out?"
	je	AskRudeExit		;brif user wants to back out of edit
	call	ModuleRudeEdit		;descan module to SS_RUDE, discard
					; module's variable & type tables
	mov	ax,sp
AskRudeExit:
	or	ax,ax			;set condition codes for caller
cEnd

;Far gateway to AskRudeEdit
cProc	AskRudeEditFar,<PUBLIC,FAR>
cBegin
	call	AskRudeEdit
cEnd

;**************************************************************
; UpdatePcs(otxEditStart, cbIns, cbDel, fTestOnly)
; Purpose:
;	Update program counter due to the insertion or deletion of text.
;	If pc is deleted, AskCantCont.
;	If pc moves (because of insert/delete),
;	   and fTestOnly=FALSE, update the pc.
; Entry:
;	grs.oRsCur identifies text table being edited
;	otxEditStart = offset into text table to 1st byte inserted/deleted
;	cbIns = # bytes inserted
;	cbDel = # bytes deleted
;	fTestOnly = non-zero if we're testing for Edit & Continue
;	   not really updating pc
;
; Exit:
;	Carry is set if edit would prevent CONT
;
;NOTE: exit conditions of UpdatePcs never return
; with carry set.  Some code could be saved.
;
;**************************************************************
cProc	UpdatePcs,<PUBLIC,NEAR>,<si>
	parmW	otxEditStart
	parmW	cbIns
	parmW	cbDel
	parmW	fTestOnly
cBegin
	call	ORsCurTxtTbl		;ax = oRs of current text table
	cmp	ax,[grs.GRS_oRsContTxtTbl]
	jne	UpcUnaffected		;brif edit didn't affect PC
	mov	ax,[grs.GRS_otxCONT]	;ax = current program counter
	inc	ax			;test for UNDEFINED
	je	UpcUnaffected		;brif can't continue
	dec	ax			;restore ax = otxCONT
	mov	dx,[otxEditStart]
	cmp	dx,ax
	je	SetToBol
	ja	UpcUnaffected		;brif PC was below edit (unaffected)

	;This edit is having an effect on the current instruction pointer
	add	dx,[cbDel]		;dx points beyond end of delete
	cmp	dx,ax
	jbe	UpcNotDel		;brif PC wasn't deleted by edit
SetToBol:
	mov	ax,[otxEditStart]	;Reset program counter to start
					; of edited line
	jmp	SHORT UpcUpdated

;line with program counter has been moved up or down in memory
UpcNotDel:
	add	ax,[cbIns]
	sub	ax,[cbDel]
UpcUpdated:
	cmp	[fTestOnly],FALSE
	jne	UpcUnaffected		;brif just testing for Edit & Cont
	mov	[grs.GRS_otxCONT],ax
UpcUnaffected:
	clc				;indicate no error
UpcExit:
cEnd

;*************************************************************************
; ORsCurTxtTbl
; Purpose:
;	Get oRs of current text table.  Only time this is different from
;	grs.oRsCur is when grs.oRsCur is for a DEF FN (which uses module's
;	text table).
;
; Exit:
;	ax = oRs of current text table.
;
;*************************************************************************
cProc	ORsCurTxtTbl,<PUBLIC,NEAR>
cBegin
	mov	ax,[grs.GRS_oMrsCur]	;ax = oRs of module's text table
	test	[txdCur.TXD_flags],FTX_mrs
	jne	OctExit			;brif module's txt tbl is active
	mov	ax,[grs.GRS_oRsCur]	;ax = oRs of procedure's text table
OctExit:
cEnd

;*************************************************************************
; OtxDefType(otx), OtxDefTypeCur, OtxDefType0, OtxDefTypeEot
;
; Purpose:
;	This causes  the text  manager to  traverse the linked
;	list of  DEFxxx statements  for the current text table
;	and accumulate	the current  state  for  a  particular
;	offset into  the  text	table.	  If  the  text  table
;	contains no  DEFxxx statements,  on exit, the array is
;	filled with 26 * ET_R4 (ET_R8 for EB).
;	A opStDefType opcode looks like:
;
;		<opStDefType><link field><high-word><low-word>
;	where
;		<high-word> has 1 bit set for each letter from A..P
;		<low-word> has 1 bit set for each letter from Q..Z in the
;			high bits, and type (ET_I2..ET_SD) in the low 3 bits.
;
; Entry:
;	OtxDefType, OtxDefTypeCur: ax = otx - byte offset into text table
;	OtxDefType: bx = pointer to table of 26 bytes to be filled
;
; Exit:
;	OtxDefType: parm2's table is filled with result
;	OtxDefTypeCur: fills tEtCur with result
;	OtxDefType0: fills tEtCur with ET_R4 (ET_R8 for EB)
;	OtxDefTypeEot: fills tEtCur with the default types at the end
;	   of the current text table.
;	grs.fDirect is preserved in all cases
;
;*************************************************************************
PUBLIC	OtxDefTypeEot
OtxDefTypeEot PROC NEAR
	mov	ax,[txdCur.TXD_bdlText_cbLogical] ;go until end-of-text
	SKIP2_PSW			;skip following sub ax,ax
OtxDefTypeEot ENDP

OtxDefType0 PROC NEAR
	SetStartOtx ax			;ax = start of text
OtxDefType0 ENDP

PUBLIC	OtxDefTypeCur
OtxDefTypeCur PROC NEAR
	mov	bx,dataOFFSET ps.PS_tEtCur
OtxDefTypeCur ENDP

PUBLIC	OtxDefType

cProc	OtxDefType,<NEAR>,<si,di>
	localW	EndOtx
	localW	EtTable
cBegin	OtxDefType
	mov	[EndOtx],ax		;initialize Endotx for loop
	mov	[EtTable],bx		;init ptr to top of table for loop


; Initialize table to all ET_R4 (ET_R8 for EB)
	mov	di,bx	 		;di -> type table
	push	ds			;need es=ds for rep stosb
	pop	es

	mov	cx,26			;26 letters in alphabet
	mov	al,ET_R4		;default type is single precision
	rep stosb


	DbChk	TxdCur			;perform sanity check on txdCur

	;Now go through text table, altering table for each DEFxxx
	; NOTE: this need not be done if parser never builds var table entries
	
	GETSEG	es,[txdCur.TXD_bdlText_Seg],,<SIZE,LOAD>
	mov	bx,[txdCur.TXD_otxDefTypeLink]
					;bx points to start of this text
					; table's linked list of DEFxxx stmts
					; or = FFFF if linked list is empty
;bx = otxCur
DefLoop1:
	mov	ax,[EndOtx]		;ax = otx parm
	mov	di,[EtTable]		;di = ptr to table
	cmp	bx,ax			;see if we're beyond place of interest
	jae	DefTypeEnd		;branch if so

	mov	si,bx			;si points to next DefType link
					; or FFFF if end of linked list
	lods	WORD PTR es:[si]	;ax points to next DefType link
					; or = FFFF if end of linked list
	xchg	bx,ax			;bx points to next DefType link
	mov	dl,es:[si]		;dl = low byte of args
	and	dl,02FH			;dl = type (ET_I2..ET_SD)
	mov	cx,16			;examine 16 bits in 1st word
	mov	dh,1			;go through DefLoop2 twice
	mov	ax,es:[si+2]		;ax = high mask of bits
	jmp	SHORT DefLoop3

DefLoop2:
	lods	WORD PTR es:[si]	;ax = low mask of bits
DefLoop3:
	shl	ax,1
	jnc	BitNotSet		;brif bit not set for this letter
	mov	[di],dl 		;save type in type table
BitNotSet:
	inc	di			;advance to next entry in type table
	loop	DefLoop3		;advance to next bit in mask
	mov	cx,10			;examine 10 bits in 2nd word
	dec	dh			;test DefLoop2 flag
	je	DefLoop2		;brif need to do 2nd word
	jmp	SHORT DefLoop1		;advance to next DEFxxx stmt

DefTypeEnd:
cEnd	OtxDefType


cProc	OtxDefType0Far,<PUBLIC,FAR>	;added as part of revison [20]
cBegin
	call	OtxDefType0
cEnd

cProc	OtxDefTypeCurFar,<PUBLIC,FAR>	;added as part of revison [20]
	parmW	oTx
cBegin
	mov	ax,[oTx]
	call	OtxDefTypeCur
cEnd

;**********************************************************************
; EtDiff
; Purpose:
;	Determine the difference between two tables of ET_xxx's
;	Used by ASCII Load and ASCII Save for inserting DEFxxx statements
;	which let each procedure text table appear to be independant of
;	the module's text table's DEFxxx statements.
; Entry:
;	parm1 points to a table of 26 bytes, on ET_xxx for each letter
;	parm2 points to another table of 26 bytes, on ET_xxx for each letter
;	parm3 = ET_xxx
; Exit:
;	ax:dx = DEFTYPE bit mask, as would appear in opStDefType's operand,
;	representing the difference between table 1 and table2 with
;	respect to parm3's type.
; Example:
;	parm1 contains ET_I2, ET_I4, ET_I2, ET_R4, ..., ET_R8
;	parm2 contains ET_I4, ET_I4, ET_I4, ET_R4, ..., ET_R8
;	parm3 contains ET_I4
;	result = 0xA0000002
;
;**********************************************************************
cProc	EtDiff, <NEAR, PUBLIC, NODATA>,<si,di>
	parmW	tEtBase
	parmW	tEtNew
	parmB	etNew
cBegin	EtDiff
	DbChk	TxdCur			;perform sanity check on txdCur
	mov	di,[tEtBase]		;di points to old deftype table
	mov	si,[tEtNew]		;si points to new deftype table
	mov	cx,26			;cx = repeat count (1 for each letter)
	sub	bx,bx			;init mask dx:bx to 0
	sub	dx,dx
EtCmpLoop:
	lodsb				;al = base type
	cmp	al,[di] 		;compare with new type
	je	NoDiff			;branch if no difference
	cmp	al,[etNew]		;compare with type we're interested in
	jne	NoDiff			;branch if we don't care about this type
	or	bl,20H			;set bit which represents Z+1
NoDiff:
	inc	di
	shl	bx,1			;shift dx:bx left 1
	rcl	dx,1
	loop	EtCmpLoop		;repeat for all letters a..z
	mov	ax,bx			;dx:ax = result
	or	bx,dx			;bx = high word ORed with low word
	je	EtDiffX 		;brif no difference between 2 tables
					; with respect to type etNew
	or	al,[etNew]		;dx:ax = opStDefType's operand
EtDiffX:
cEnd	EtDiff



;--------------------------------------------------------------
;	Re-Parsing Functions
;
; Many errors are ignored at edit-time, on the assumption that
; the user will repair the problem before attempting to execute.
; The general solution when one of these errors are encountered
; at edit time is to store the entire source line in the pcode
; within an opReParse opcode.  Then, when the user is about to
; execute, we re-parse these lines and report any errors encountered
; with the following call-tree:
;
;                       ReParseTbl
;                           |
;                      +----+-----+
;                      |          |
;                  DoReParse  PreScanAsChg
;                      |
;                 TxtReEnter
;                      |
;                  +---+---+
;                  |       |
;              ListLine TxtChange
;
;--------------------------------------------------------------