lsutil.asm

[随书类]Dos6.0源代码

	TITLE	LSUTIL - utility module of 'lister' component

;======================================================================
; Module: LsUtil.asm - utility module of 'lister' component
; Subsystem:  Lister
; System:  Quick BASIC Interpreter
;
;
;=======================================================================*/

	include 	version.inc
	LSUTIL_ASM = ON
	includeOnce	architec
	includeOnce	context
	includeOnce	heap
	includeOnce	lister
	includeOnce	lsint
	includeOnce	names
	includeOnce	qblist
	includeOnce	scanner
	includeOnce	txtmgr
	includeOnce	variable

	PERIOD_ID EQU ON		;record.element, not record->element

	assumes DS,DGROUP
	assumes ES,DGROUP
	assumes SS,DGROUP

sBegin	LIST
assumes CS,LIST

subttl	List Node creation functions

;***************************************************************************
; NewChar, NewChars
; Purpose:
;	Create a new LNT_CHAR node
; Entry:
;	[al] = ASCII value for char
;	for NewChars: [ah] = ASCII value for 2nd char to list
;	di = offset to next free byte in bdNodes
; Exit:
;	di is updated
;	ax = offset to newly created node
;
;***************************************************************************
PUBLIC	NewChar
NewChar PROC NEAR
	sub	ah,ah			;only 1 char in this node
NewChar ENDP
	;fall into NewChars
PUBLIC	NewChars
NewChars PROC NEAR
	mov	bx,di			;bx = offset to new node (return value)
	add	di,[bdNodes.BD_pb]	;convert offset to ptr
	stosDsWord 0			;set LN_sib field to 0
	stosDsByte LNT_CHAR		;set LN_type field
	stosDsWord ax			;set LN_val_char field
	sub	di,[bdNodes.BD_pb]	;convert ptr to offset
	mov	ax,bx			;return offset to new node
	ret
NewChars ENDP

;***************************************************************************
; NewId
; Purpose:
;	Fetch the next 2 bytes of pcode, which represent an id
;	reference.  If scanState != SS_RUDE, convert this 16 bit
;	module-value-table offset into a name table offset.
;	Produce the following nodes:
;	->[LNT_oNam(oNam)]
; Entry:
;	es:si points to id's oNam or oVar argument
;	di = offset to next free byte in bdNodes
; Exit:
;	si points beyond id's operand
;	di is updated
;	ax = offset to newly created id node
;	bx = oNam
;
;***************************************************************************
;***************************************************************************
; NewONam
; Purpose:
;	Produce the following nodes:
;	->[LNT_oNam(oNam)]
; Entry:
;	ax = oNam operand
;	di = offset to next free byte in bdNodes
; Exit:
;	di is updated
;	ax = offset to newly created id node
;	bx = oNam
;
;***************************************************************************
PUBLIC	NewId
NewId	PROC NEAR
	lods	WORD PTR es:[si]	;ax = operand
	push	es			;save ptr to text table
	push	ax			;push variable's oNam/oVar
	call	ONamOVarRudeOrParse	;get oNam
	pop	es			;restore es
	
	; fall into NewONam		;produce an oNam node
NewId	ENDP
PUBLIC	NewONam
NewONam PROC NEAR
	DbChk	oNam,ax
	mov	dl,LNT_ONAM		;dl = LN_type field
;ax = node's value, dl = node's type
NewNodeDlAx:
	mov	bx,di			;bx = offset to new node (return value)
	add	di,[bdNodes.BD_pb]	;convert offset to ptr
	stosDsWord 0			;set LN_sib field to 0
	stosDsByte dl			;set LN_type field
	stosDsWord ax			;save oNam in LN_val_oNam field
	sub	di,[bdNodes.BD_pb]	;convert ptr to offset
	xchg	ax,bx			;return offset to new node in ax
					;bx = oNam
	ret
NewONam ENDP

;***************************************************************************
; NewRw
; Purpose:
;	Create a new LNT_RW node
; Entry:
;	[ax] = ORW_xxx (offset into res word table for res word to list)
;	di = offset to next free byte in bdNodes
; Exit:
;	di is updated
;	ax = offset to newly created node
;
;***************************************************************************
PUBLIC	NewRw
NewRw	PROC NEAR
	mov	dl,LNT_RW		;dl = LN_type field
	jmp	SHORT NewNodeDlAx	;create new node and return offset in ax
NewRw	ENDP


;***************************************************************************
; NewCsStr
; Purpose:
;	Create a new LNT_CSSTR node
; Entry:
;	[ax] = offset into LIST segment to string constant to list
;	di = offset to next free byte in bdNodes
; Exit:
;	di is updated
;	ax = offset to newly created node
;
;***************************************************************************
PUBLIC	NewCsStr
NewCsStr PROC NEAR
	mov	dl,LNT_CSSTR		;dl = LN_type field
	jmp	SHORT NewNodeDlAx	;create new node and return offset in ax
NewCsStr ENDP

;***************************************************************************
; NewSpaces
; Purpose:
;	Create a new LNT_SPACES node
; Entry:
;	[ax] = count of spaces
;	di = offset to next free byte in bdNodes
; Exit:
;	di is updated
;	ax = offset to newly created node
;
;***************************************************************************
PUBLIC	NewSpaces
NewSpaces PROC NEAR
	mov	dl,LNT_SPACES		;dl = LN_type field
	jmp	SHORT NewNodeDlAx	;create new node and return offset in ax
NewSpaces ENDP

;***************************************************************************
; NewCol, NewCol1
; Entry:
;	ax = column to advance to
; NewCol1 is the same as NewCol, but it always lists at least 1 column,
; even if we're beyond the specified column.
;
;***************************************************************************
PUBLIC NewCol1
NewCol1 PROC NEAR
	or	ah,80h			;always list at least 1 column, even if
					; we're beyond the specified column.
NewCol1 ENDP
PUBLIC NewCol
NewCol PROC NEAR
	mov	dl,LNT_COL		;dl = LN_type field
	jmp	SHORT NewNodeDlAx	;create new node and return offset in ax
NewCol ENDP

;***************************************************************************
; NewStr/NewEnStr/NewLitStr
; Purpose:
;	Consume a string literal and produce a LNT_STR/LNT_ENSTR/LNT_LITSTR node
; Entry:
;	ax = byte count
;	es:si points to 1st byte
; Exit:
;	si is advanced beyond the string constant
;	ax = offset to newly created node
;
;***************************************************************************
PUBLIC	NewEnStr
NewEnStr PROC NEAR
	mov	dl,LNT_ENSTR		;produce an encoded string node
	SKIP2_PSW
NewEnStr ENDP

PUBLIC	NewStr
NewStr	PROC NEAR
	mov	dl,LNT_STR		;produce an standard string node

NewStrCommon:
	mov	bx,di			;bx = offset to new node (return value)
	add	di,[bdNodes.BD_pb]	;convert offset to ptr
	mov	cx,ax			;cx = length of string
	sub	ax,ax			;ax = 0
	stosDsWord ax			;set LN_sib field to 0
	stosDsByte dl			;set LN_type field
	stosDsWord cx			;save offset in LN_val_cbStr field
	stosDsWord si			;save count in LN_val_oStr field
	inc	cx			;round up to even byte count
	and	cl,0FEH
	add	si,cx			;skip past string literal
	sub	di,[bdNodes.BD_pb]	;convert ptr to offset
	mov	ax,bx			;return offset to new node
	ret
NewStr	ENDP

;***************************************************************************
; NewNum
; Purpose:
;	Consume a numeric literal and produce a LNT_NUM node
; Entry:
;	al = constant value size (2, 4, or 8)
;	ah = constant type
;	     (LIT_D2, LIT_O2, LIT_H2,
;	      LIT_D4, LIT_O4, LIT_H4,
;	      LIT_R4, LIT_R8,
;	      LIT_LINENUM)
;	if ah = LIT_LINENUM,
;	   si = value of line number (16 bit unsigned number)
;	else
;	   es:si points to 1st byte of value
; Exit:
;	if ah = LIT_LINENUM,
;	   si contains garbage
;	else
;	   si is advanced beyond the string constant
;	ax = offset to newly created node
;
;***************************************************************************
PUBLIC	NewNum
NewNum	PROC NEAR
	mov	bx,di			;bx = return value
	add	di,[bdNodes.BD_pb]	;convert offset to ptr
	stosDsWord 0			;set LN_sib field to 0
	stosDsByte LNT_NUM		;set LN_type field
	stosDsWord ax			;set LN_val_cbNum, LN_val_clNum fields
	stosDsWord si			;set LN_val_otxNum
	sub	di,[bdNodes.BD_pb]	;convert ptr to offset
	sub	ah,ah			;ax = size of constant in bytes
	add	si,ax			;advance past constant's value
	mov	ax,bx			;ax = return value (offset to new node)
	ret
NewNum	ENDP

;***************************************************************************
; NewLabel, NewModLabel
; Purpose:
;	Fetch the  next 2 bytes of pcode, which represent a label
;	reference.  If scanState = SS_EXECUTE, convert this 16 bit
;	text offset into a name table offset.  If name mgr says this
;	is a line-number oNam, create an LNT_NUM node, else create an
;	LNT_ONAM node.
; 	NewModLabel is the same, except the referenced label is known
;	to exist in module level code.  This is used to list the statements
;	ON ERROR GOTO <label>,  ON <event> GOSUB <label>,  RESTORE <label>.
; Entry:
;	es:si points to oNam or otx argument
; Exit:
;	si bumped by 2
;	dl = 0 if it was an alphanumeric label, 1 if it was a line number
;	ax = offset to newly created node
;
;***************************************************************************
PUBLIC	NewModLabel
NewModLabel PROC NEAR
	cmp	[txdCur.TXD_scanState],SS_EXECUTE
	jne	NewLabel		;brif table isn't in execute state
					; in this case, operand is an oNam
	test	[txdCur.TXD_flags],FTX_mrs
	jne	NewLabel		;brif not within a procedure txt tbl

;It would be an error for a procedure to be in SS_EXECUTE state, and
;a module to be in SS_PARSE state, because the procedure could contain
;invalid otx operands to module level code.  Assert this is not the case.
;
DbAssertRelB[mrsCur.MRS_txd.TXD_scanState],e,SS_EXECUTE,LIST,<NewModLabel err1>
	;convert oTxt to module level label's oNam
	lods	WORD PTR es:[si]	;ax = operand
	xchg	bx,ax			;bx = offset to opBolLab's opcode
	push	ds
	mov	ds,[mrsCur.MRS_txd.TXD_bdlText_seg]
					;ds points to module level pcode seg
	mov	ax,[bx + 4]		;ax = opBolLab's oNam operand
	pop	ds
	jmp	SHORT NewLabelONam
NewModLabel ENDP

PUBLIC	NewLabel
NewLabel PROC NEAR
	lods	WORD PTR es:[si]	;ax = operand
	cmp	[txdCur.TXD_scanState],SS_EXECUTE
	jne	NewLabelONam		;brif table isn't in execute state
	;convert oTxt to oNam for referenced label
	mov	bx,ax			;bx = offset to opBolLab's opcode
	mov	ax,es:[bx + 4]		;ax = opBolLab's oNam operand
NewLabel ENDP
	;fall into NewLabelONam
;***************************************************************************
; NewLabelONam
; Purpose:
;	Given an oNam which represent a label reference, create
;	an LNT_ONAM node if its an alpha-label, else a LNT_NUM
;	node if its a line-number.
; Entry:
;	ax = oNam for this label
; Exit:
;	dl = 0 if it was an alphanumeric label, 1 if it was a line number
;	ax = offset to newly created node
;
;***************************************************************************
PUBLIC NewLabelONam
NewLabelONam PROC NEAR
	DbChk	oNam,ax
	push	ax			;save oNam
	push	es			;LnOfONam destroys es
	cCall	LnOfONam,<ax>		; ax = linenum or UNDEFINED
					;dl = 1st letter if alpha name
	pop	es			;restore es = text table seg
	inc	ax			;test for UNDEFINED
	je	GotAlphaLabel		;brif not a line number
	pop	dx			;discard stacked oNam
	dec	ax			;ax = linenum
	push	si			;save caller's si
	mov	si,ax			;si = linenum
	mov	ax,LIT_LINENUM * 256 + 2
	call	NewNum			;ax = create LNT_NUM node
	pop	si			;restore caller's si
NlLineNum:
	mov	dl,1			;tell caller its a line number
NlExit:
	ret

;dl = 1st letter of label
GotAlphaLabel:
	pop	ax			;ax = oNam
	push	dx			;preserve 1st letter of label
	call	NewONam 		;ax = new node for this label
	pop	bx
	sub	dx,dx
	cmp	bl,'0'
	jb	NlExit			;brif not line num > 65529
	cmp	bl,'9'
	jbe	NlLineNum		;brif line num > 65529
	jmp	SHORT NlExit
NewLabelONam ENDP

;***************************************************************************
; ListOffToPtr
; Purpose:
;	Convert a node offset to a node ptr.  This means that list rules
;	need not know about bdNodes or include heap.inc
; Entry:
;	ax = offset to node
; Exit:
;	bx = pointer to node
;
;***************************************************************************
;bx = sibbling(bx)
PUBLIC ListSibPtr
ListSibPtr PROC NEAR
	mov	ax,[bx.LN_sib]		;ax = offset to si's sibbling node
ListSibPtr ENDP
	;fall into ListOffToPtr to convert ax from offset to pointer
PUBLIC ListOffToPtr
ListOffToPtr PROC NEAR
	mov	bx,ax			;bx = offset to node
	add	bx,[bdNodes.BD_pb]	;convert offset to ptr
	ret
ListOffToPtr ENDP


subttl	Root and Temp list manipulation functions

;***************************************************************************
; PushRoot
; Purpose:
;	Push a node onto oNodeRoot's list, for example:
;	[x y z]  ==>  [newNode x y z]
; Entry:
;	ax = offset to new root
; Preserves:
;	cx (depended on by some callers)
;
;***************************************************************************
PUBLIC	PushRoot
PushRoot PROC NEAR
	mov	bx,ax			;bx = offset for new root node
	add	bx,[bdNodes.BD_pb]	;convert offset to ptr (new root)
	xchg	ax,[oNodeRoot]		;save offset for new root
					;ax = offset for old root
	mov	LN_sib[bx],ax		;new.sib = old
	ret
PushRoot ENDP

;***************************************************************************
; PopRoot
; Purpose:
;	Pop a node from oNodeRoot's list, for example:
;	[x y z]  ==>  [y z]
; Exit:
;	ax = offset to popped node
;	bx = pointer to the popped node 
;	popped node's LN_sib field is set to NULL
; Preserves:
;	cx (depended on by some callers)
;
;***************************************************************************
PUBLIC	PopRoot
PopRoot PROC NEAR
	mov	ax,[oNodeRoot]		;ax = offset to current root node
					; (return value)
	mov	bx,ax			;bx = offset to current root node
	add	bx,[bdNodes.BD_pb]	;convert offset to ptr
	mov	dx,LN_sib[bx]		;dx points to new root
	mov	[oNodeRoot],dx
	mov	LN_sib[bx],NULL 	;unlink old root
	ret
PopRoot ENDP

;***************************************************************************
; PushTemp
; Purpose:
;	Push a node onto oNodeTemp's list, for example:
;	[x y z]  ==>  [newNode x y z]
; Entry:
;	ax = offset to node to push onto oNodeTemp's stack
;
;***************************************************************************
;***************************************************************************
; PopRootPushTemp