txtthr.asm

Dos6.0

; Exit:
;	no error or exception is possible.
;
;**************************************************************

;DoInsThread
;Entry:
;	ax = adr of head of linked list (in DS)
;	bx = adr of local thread descriptor used to remember previous link
;	si = adr of 1st byte inserted
;	di = # bytes inserted
;
DoInsThread PROC NEAR
	push	ax			;pass DS offset to head of linked list
	push	bx			;pass offset to thread descriptor
	push	si			;pass otxInsStart
	push	di			;pass cbIns
	call	TxtInsThread		;update linked list for inserted pcode
	ret
DoInsThread ENDP

cProc	NoWalkUpdateLinks,<PUBLIC,NEAR> 
cBegin
	mov	al, 00h
	SKIP2_PSW
cEnd	<nogen>

cProc	UpdateLinks,<PUBLIC,NEAR>	
cBegin
	mov	al, 01h
cEnd	<nogen>

cProc	UpdateCommon,<PUBLIC,NEAR>,<si,di>  
	parmW	otxInsStart
	parmW	otxInsEnd
	localV	thrLab,<size THR_DSC>
	localV	thrReParse,<size THR_DSC>
	localV	thrType,<size THR_DSC>
	localV	thrDefType,<size THR_DSC>
	localV	thrDefFn,<size THR_DSC>
	localB	fWalkNew		; !0 => walk inserted pcode
cBegin
	mov	fWalkNew, al		; save flag for later

	DbChk	Otx,[otxInsStart]
	DbChk	Otx,[otxInsEnd]
	mov	si,[otxInsStart]	;si = offset to 1st byte to delete

	DbAssertRel si,be,otxInsEnd,CP,<UpdateLinks err 1>
	mov	di,[otxInsEnd]		;di = offset to last byte to delete
	sub	di,si			;di = cbIns

;Traverse all linked lists through the text table,
;updating the linked lists for the insert
;
	mov	ax,dataOFFSET txdCur.TXD_otxLabLink
	lea	bx,[thrLab]
	call	DoInsThread

	mov	ax,dataOFFSET txdCur.TXD_otxReParseLink
	lea	bx,[thrReParse]
	call	DoInsThread

	mov	ax,dataOFFSET txdCur.TXD_otxTypeLink
	lea	bx,[thrType]
	call	DoInsThread

	mov	ax,dataOFFSET txdCur.TXD_otxDefTypeLink
	lea	bx,[thrDefType]
	call	DoInsThread

	test	[txdCur.TXD_flags],FTX_mrs
	je	UpdNotMod		;brif we're not looking at module text

	;fix linked lists which can only occur in a module text table
	mov	ax,dataOFFSET mrsCur.MRS_otxDefFnLink
	lea	bx,[thrDefFn]
	call	DoInsThread

	; The linked list of opcodes headed by mrsCur.MRS_data_otxFirst
	; only needs to be maintained while in SS_EXECUTE state, so
	; we don't need to fix it up here

UpdNotMod:
	mov	al, fWalkNew		; check if we need to walk new pcode
	or	al, al			
	jz	UpdDone 		; brif no need to walk inserted pcode

	push	si			;pass otxInsStart
	PUSHI	ax,<CODEOFFSET tOpUpdl>
	call	TxtFindOp		;ax = offset to 1st interesting opcode
UpdLoop:
	mov	si,ax			;si = otxCur (offset to cur opcode)
	cmp	ax,[otxInsEnd]
	jae	UpdDone			;brif beyond end of inserted pcode
	mov	al,[txtFindIndex]
	cmp	al,UPDL_labMax
	ja	UpdNotLab		;brif not a label opcode

	lea	ax,[thrLab]
	push	ax
	lea	ax,[si+2]		;ax = offset to link field
	push	ax
	call	TxtAddThread
	jmp	SHORT UpdNext

UpdNotLab:
	;OpBol is in the UPDL_SkipMax range to cause us to terminate
	; the TxtFindOp Calls before opEot if no threads are after
	; oTxInsEnd.  This significantly speeds up generic edits.
	
	cmp	al,UPDL_SkipMax 	;should we skip this opcode?
	jbe	UpdNext 		;brif so, get next opcode
	sub	al,UPDL_opReParse
	sub	ah,ah			;ax = dispatch index
	shl	ax,1			;ax = dispatch offset
	xchg	ax,bx			;bx = dispatch offset
	jmp	WORD PTR cs:UpdDisp[bx]
UpdDisp:
	DW	UpdOpReParse
	DW	UpdOpStDefType
	DW	UpdOpStType
	DW	UpdOpStEndType
	DW	UpdOpStDefFn
	DW	UpdOpStEndDef
	DW	UpdOpEndSingleDef
	DW	UpdDone			;for opEot (caller can pass
					;txdCur.cbLogical which would allow
					;opEot to be found by TxtFind...
UpdNext:
	push	si			;pass otxCur
	PUSHI	ax,<CODEOFFSET tOpUpdl>
	call	TxtFindNextOp
	jmp	SHORT UpdLoop

UpdDone:
	DbChk	TxdThr			;check all threads through cur txt table
cEnd	;UpdLinks

;for opReParse, the 1st operand is a byte count,
;               the 2nd operand is the link field
;
UpdOpReParse:
	lea	ax,[thrReParse]
	jmp	SHORT UpdAdd4

UpdOpStDefType:
	lea	ax,[thrDefType]
	push	ax
	lea	ax,[si+2]		;ax = offset to link field
	push	ax
	jmp	SHORT UpdAdd

UpdOpStType:
UpdOpStEndType:
	lea	ax,[thrType]
	push	ax
	lea	ax,[si+2]		;ax = offset to link field
	push	ax
	call	TxtAddThread
	jmp	SHORT UpdNext

;for these opcodes, the 1st operand is a byte count,
;                   the 2nd operand is the link field
;
UpdOpStDefFn:
UpdOpStEndDef:
UpdOpEndSingleDef:
	lea	ax,[thrDefFn]
UpdAdd4:
	push	ax
	lea	ax,[si+4]		;ax = offset to link field
	push	ax
UpdAdd:
	call	TxtAddThread
	jmp	UpdNext

;**************************************************************
; ushort ScanTypeBlock
; Purpose:
;	This function goes through the a TYPE block in the current text table
; NOTE:
;	Parse->Execute Scanner prevents   id AS type   statement outside
;	TYPE/END TYPE block.
; Entry:
;	si = text offset beyond opStType opcode
; Exit:
;	If no error occurred
;	   returns 0
;	   si points beyond opStEndType's operands
;	Else returns standard qbi error message code in ax (see qbimsgs.h):
;	   MSG_UndType if "x AS foo" was seen, but either foo is not defined
;	     or it is defined beyond the reference (forward refs are illegal
;	     because BASCOM doesn't know how to handle them)
;	   ER_DD if either "TYPE x" has already been defined, or
;	     2 elements within 1 type record have the same name
;	   MSG_InvInTypeBlk if some statement which is illegal within
;	     a TYPE block was seen
;	   ER_OM if out-of-memory
;	   si points to 1st byte of opcode which caused error
;
;**************************************************************
cProc	ScanTypeBlock,<PUBLIC,FAR>,<di> 
	localW	oNamElem
	localW	oTypType
cBegin
	xor	ax,ax			;ax = 0
	mov	[oNamElem],ax		;initialize [oNamElem] to zero
	lea	ax,[si+2]		;ax points to oNam field
	call	GetWOtx			;ax = oNam field
	push	ax
	call	DefineTyp
	or	ax,ax
	js	J1_StExit		;brif got some error
	mov	[oTypType],ax
	dec	si
	dec	si			;si points to opStType's opcode

	;now try to define each element within the type block
	;Element definitions in the type block have the form:
	;  foo AS bar	   ==>	opElemRef(oNam<foo>) opAsType(oNam<bar>,column)
	;  foo AS INTEGER  ==>	opElemRef(oNam<foo>) opAsTypeExp(ET_I2,column)
	;  foo AS STRING * 6 ==> opElemRef(oNam<foo>) opAsTypeExp(0x8006,column)
	
StLoop:
	mov	di,si			;di points to opStType's opcode
	mov	ax,di			;pass otxPrev in ax
	call	TxtSkipOp		;ax = offset to next opcode
	xchg	si,ax			;si = text offset
	push	di			;pass otxPrev
	PUSHI	ax,<CODEOFFSET tOpTypes>
	call	TxtFindNextOp
	cmp	ax,si
	mov	ax,MSG_InvInTypeBlk
	jne	StExit			;brif invalid opcode was found in line
	cmp	dl,TYPES_DispatchMax	
	ja	StLoop			;brif no special processing required

	lea	ax,[si+2]		;ax points to opcode's 1st operand
	push	dx			;save [txtFindIndex]
	call	GetWOtx			;ax = 1st operand
	pop	dx			;dl = [txtFindIndex]

	xor	dh,dh
	shl	dx,1			;dx = dispatch offset
	mov	bx,dx			;bx = dispatch offset
	jmp	WORD PTR CP:AsTypeDispatch[bx] ;dispatch to handler	

AsTypeDispatch:				
	DW	CPOFFSET TyOpElemRef	
	DW	CPOFFSET TyOpAsType	
	DW	CPOFFSET TyOpAsTypeExp	
	DW	CPOFFSET TyOpAsTypeFixed
	DW	CPOFFSET TyOpStEndType	

TyOpStEndType:
	mov	ax,MSG_UndElem		;prepare for no elements in type
	mov	bx,[oTypType]		; bx = ptr to type entry
	add	bx,[mrsCur.MRS_bdVar.BD_pb] ;[4] get type table base
	cmp	[bx.TYP_oElementFirst],0 ;were any elements defined?
	je	StExit			;brif not, generate error

	lodsw				;skip opStEndType opcode
	lodsw				;skip opStEndType's operand
	sub	ax,ax			;no error occurred
J1_StExit:
	jmp	SHORT StExit

; id AS within a TYPE/END TYPE block - save oNam in oNamElem
; ax = oNam field
;
TyOpElemRef:
	mov	[oNamElem],ax
StLoop2:				;fix jump out of range
	jmp	SHORT StLoop

; saw an AS <user type> within a TYPE/END TYPE block
; call DefineElem to define the element
;
TyOpAsType:
	push	ax			;pass oNam of element's user type
	push	si			;pass text offset
	call	RefTyp			;ax = oTyp for element's oNam
CheckError:
	or	ax,ax
	js	StExit			; brif RefTyp returned error code
	; Fall into dispatch routine for TyOpAsTypeExp

; saw an AS <explicit type> within a TYPE/END TYPE block -
; call DefineElem to define the element
;
TyOpAsTypeExp:
	mov	bx,CPOFFSET DefineElem	;prepare to call DefineElem
CallDefineElemxxx:
	xor	cx,cx			;cx = 0
	xchg	cx,[oNamElem]		;cx = oNam; zero [oNamElem]
	jcxz	GotADim			;brif oNam is zero
	push	cx			;pass oNam given by opElemRef
	push	[oTypType]		;pass oTyp for TYPE block being built
	push	ax			;pass oTyp for element
	call	bx			;call DefineElem[Exp]
	or	ax,ax
	je	StLoop2 		;brif no error
StExit:
	and	ah,7FH			;mask off high bit set by Variable Mgr
cEnd

; saw an AS STRING*[oNam | cb] within a TYPE/END TYPE block - 
; call DefineElemFixed to define the element
;
TyOpAsTypeFixed:			
	xchg	di,ax			;save oTyp in di
	lea	ax,[si+4]		;ax -> opcode's second operand
	call	GetWOtx 		;ax = byte count or oNam of constant
	push	ax			;pass as 1st arg to DefineElemFixed
	xchg	ax,di			;restore ax = oTyp
	mov	bx,CPOFFSET DefineElemFixed ;bx = routine to define element
	jmp	SHORT CallDefineElemxxx	

;we've encountered an AsTypexxx opcode which was not preceeded by an
; opElemRef opcode. This can occur in a Dim statement and perhaps other places.
GotADim:				
	mov	ax,MSG_InvInTypeBlk	;message "invalid in type block"
	jmp	SHORT StExit		;exit

sEnd	CP

end