prsctl.asm

[随书类]Dos6.0源代码

	TITLE	prsctl.asm - Parser Control-Flow NonTerminal Functions

;==========================================================================
;
;  Module:  prsctl.asm - Parser Control-Flow NonTerminal Functions
;  Subsystem:  Parser
;  System:  Quick BASIC Interpreter
;  Copyright <C> 1985, Microsoft Corporation
;
;  NOTE:
;	See prsnt.asm for general comments
;
;=========================================================================

	include version.inc
	PRSCTL_ASM = ON
	includeOnce architec
	includeOnce context
	includeOnce names
	includeOnce opcontrl
	includeOnce parser
	includeOnce prsirw
	includeOnce prstab
	includeOnce psint
	includeOnce qbimsgs

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

sBegin	DATA

fLastWasLabel DB 0	;flag which gets set by IfClause 
			;non-zero if last call emitted a label,
			;zero if last call emitted a statement list
sEnd	DATA

sBegin	CP
assumes	CS,CP

;===========================================================================
;                  C O N T R O L    F L O W
;    P A R S E R    R E C O G N I Z I N G    F U N C T I O N S
;
;=======================================================================

;**********************************************************************
; ushort NEAR TestLn()
;
; Purpose:
;	See if the current token could be considered a line number
;	or numeric label.  A line number is any integer from 0 to 65529.
;	A numeric label is any number other than an integer from 0 to 65529
;	that does not use E or D notation.
; Entry:
;	pTokScan points to current token
; Exit:
;	If an error (like OVERFLOW or Out-Of-Memory) occurs
;	   error is logged, al = PR_BadSyntax, carry is set
;	Else
;	   carry is clear
;	   if lineNumber was found (i.e. 0 to 65529)
;	      ax its oNam, cx=0
;	   else if numeric label was found (i.e. any num other than 0 to 65529)
;	      ax its oNam, cx=non-zero
;	   else, return 0 (with condition codes set).
;	The token is not consumed in any case.
;
;******************************************************************
cProc	TestLn <PUBLIC,NODATA,NEAR>
cBegin	TestLn
	mov	bx,[pTokScan]		;di points to current token
	cmp	[bx.TOK_class],CL_lit
	jne	NotLn			;branch if token is not a literal
	mov	ax,[bx.TOK_lit_value_I2];ax = potential line number
	mov	cl,[bx.TOK_lit_litType]	;cl = literal type
	cmp	cl,LIT_I2
	jne	NotI2			;branch if we got an integer
	or	ax,ax
	js	NotLn			;branch if literal was -1 .. -32768
;ax = integer line number (0..65529)
TlExit2:
	call	ONamOfLn		;ax = offset in name table for linenum
	je	TlOmErr			;brif out-of-memory
	sub	cx,cx			;return lineNumber indication
;ax = oNam for line number or numeric label
TlExit1:
	or	ax,ax			;set condition codes for caller
;ax = error code if carry set, oNam if carry clear
TlExit:
cEnd	TestLn

NotLn:
	sub	ax,ax
	jmp	SHORT TlExit1

;bx = pointer to token descriptor
;ax = integer constant value, cl = literal type
NotI2:
	cmp	cl,LIT_I4
	jne	NotI4			;branch if not a long integer
	cmp	[bx.TOK_lit_value_I2+2],0
	jnz	GotNum			;branch if high word was not 0
					; it is still a numeric label
	cmp	ax,MAX_LN
	jbe	TlExit2			;branch if 0..65529
	jmp	SHORT GotNum		;I4's are valid numeric labels

;bx = pointer to token descriptor
;cl = literal type.  See if its an R4 or R8 numeric label
NotI4:
	cmp	cl,LIT_R4
	je	GotNum
	cmp	cl,LIT_R8
	jne	NotLn			;brif it is not I2,I4,R4 or R8
;bx = pointer to token descriptor, scan numeric label
GotNum:
	sub	ax,ax
	or	al,[bx.TOK_lit_errCode]	;ax = lexical analyzer's error code
	jne	TlErr			;brif lexical analyzer found an error
					; in literal's format
	test	[bx.TOK_lit_flags],FLIT_exp
	jne	NotLn			;brif E+nnn or D+nnn exponent seen
	mov	ax,[ps.PS_bdpSrc.BDP_pb] ;ax points to start of parser buffer
	add	ax,[bx.TOK_oSrc]	;ax points to 1st byte of id
					;  (parm to ONamOfPbCb)
	mov	cx,[ps.PS_bdpSrc.BDP_pbCur] ;cx = pointer beyond end of number
	sub	cx,ax			;cx = byte count of number (parm)
	cmp	cx,CB_IDNAM_MAX		
	ja	NotLn			;brif more than 40 chars long
	call	ONamOfPbCb		;nammgr returns ax = oNam, dl = flags
	mov	cl,1
	jne	TlExit1			;brif not out-of-memory
TlOmErr:
	call	ParseErrOm		;Error "Out of memory"
	jmp	SHORT TlErr1
TlErr:
	call	PErrMsg_AX		; al = PR_BadSyntax
TlErr1:
	mov	al,PR_BadSyntax
	stc				;return error code
	jmp	SHORT TlExit

;**********************************************************************
; PARSE_RESULT NEAR NtLn()
;
; Purpose:
;	Parse a Line Number.
; Exit:
;	If line number is found,
;	   consume the token, emit the 16 bit name table offset
;	   for the label/line number, and return al=PR_GoodSyntax.
;	Otherwise,
;	   return al=PR_NotFound.
;	Condition codes set based on value in al
;
;******************************************************************
cProc	NtLn <PUBLIC,NODATA,NEAR>
cBegin	NtLn
	call	TestLn			;ax = value of pTokScan's line number
	jc	NtLnExit		;brif error (Overflow, out-of-memory)
	je	NoLineNum		;branch if token isn't a line number
	call	Emit16_AX		;emit oNam
	call	ScanTok			;consume the line number
	or	[ps.PS_flags],PSF_fRef+PSF_fLabelRef ;so text mgr knows
					; to scan program if in direct mode 
	mov	al,PR_GoodSyntax
	SKIP2_PSW
NoLineNum:
	sub	ax,ax			;return PR_NotFound
NtLnExit:
	or	al,al			;set condition codes for caller
cEnd	NtLn

;**********************************************************************
; PARSE_RESULT NEAR NtLabLn()
;
; Purpose:
;	Parse a Label or Line Number.
;
; Exit:
;	If it is found, consume the token, emit the 16 bit name table offset
;	   for the label/line number, and return PR_GoodSyntax.
;	Otherwise,
;	   return PR_NotFound.
;	Condition codes set based on value in al
;
;******************************************************************
cProc	NtLabLn <PUBLIC,NODATA,NEAR>
cBegin	NtLabLn
	call	NtLn			;see if current token is line num
	jne	GotLn			;branch if parsed a line number

	;we're not looking at a line number, maybe its a label 
	call	IdTokPeriodImp		;next token can have "." in it
					; but must have no explicit type char
	je	NtLabExit		;branch if PR_NotFound
	mov	ax,[bx.TOK_id_oNam]	;emit its oNam
	call	Emit16_AX
	call	ScanTok			;consume the label
	or	[ps.PS_flags],PSF_fRef+PSF_fLabelRef ;so text mgr knows
					; to scan program if in direct mode 
GotLn:
	mov	al,PR_GoodSyntax	;return PR_GoodSyntax
	SKIP2_PSW
NtLabExit:
	or	al,al			;set condition codes for caller
cEnd	NtLabLn

;**********************************************************************
; PARSE_RESULT NEAR NtIfStmt()
;
; Purpose:
;	Parse a block or single line IF statement
;
; Entry:
;	IF <exp> has just been parsed.
;	'pTokScan' points to the current token, which may be THEN/GOTO
;
; Exit:
;	If a Block THEN is recognized, the next token is scanned,
;	   and the return value is PR_GoodSyntax.
;	else
;	   the return value is PR_NotFound.
;
;   Runtime behavior of IF-THEN-ELSE opcodes:
;   ----------------------------------------
;      <exp> opStIf(oText) - branch to oText if exp is zero (false)
;      <exp> opStIfLab(label) - branch to label if exp is non-zero (true)
;      <exp> opStIfLabDirect(label) - branch to label if exp is non-zero (true)
;      opStElse(oText) - unconditionally branch to oText
;      opStElseLab(label) - unconditionally branch to label
;      opStElseLabDirect(label) - unconditionally branch to label
;      opStElseNop - nop
;      <exp> opStIfBlock(oText) - branch to oText if exp is zero (false)
;      <exp> opStElseIf(oText) - branch to oText if exp is zero (false)
;      opStEndIfBlock - nop
;
;   NOTE: When in direct mode, Parser emits opStIfLabDirect instead of
;         opStIfLab, and opStElseLabDirect instead of opStElseLab.
;
;   BASICA allows IF <exp> ,THEN ... ,ELSE ...
;   Since BASCOM does not allow the comma, neither does QBI
;   
;   Single line IF statement syntax to pcode mappings:
;   -------------------------------------------------
;
;      Syntax:  IF <exp> GOTO <label>
;   
;      Pcode:   <exp> opStIfLabDirect(label)  (if direct mode)
;               <exp> opStIfGotoLab(label)    (if not direct mode - for listing)
;
;      ============================================================
;      Syntax:  IF <exp> THEN <label>
;   
;      Pcode:   <exp> opStIfLab(label)
;   
;      ============================================================
;      Syntax:  IF <exp> THEN <stmt list>
;   
;                            +--------------+
;      Pcode:   <exp> opStIf(|) <stmt list> |
;   
;      ============================================================
;      Syntax:  IF <exp> THEN <label> ELSE <label>
;   
;      Pcode:   <exp> opStIfLab(label) opStElseNop opStElseLab(label)
;
;      NOTE:    Lister emits no 'ELSE' for opStElseLab, just the ASCII label
;   
;      ============================================================
;      Syntax:  IF <exp> THEN <label> ELSE <stmt list>
;   
;      Pcode:   <exp> opStIfLab(label) opStElseNop <stmt list>
;
;      NOTE:    <stmt list> can contain more single line IF stmts
;   
;      ============================================================
;      Syntax:  IF <exp> THEN <stmt list> ELSE <label>
;   
;                            +--------------------------+
;      Pcode:   <exp> opStIf(|) <stmt list> opStElse(|) | opStElseLab(label) |
;                                                    +-----------------------+
;
;      NOTE:    Lister emits no 'ELSE' for opStElseLab, just the ASCII label
;   
;      ============================================================
;      Syntax:  IF <exp> THEN <stmt list> ELSE <stmt list>
;   
;                            +--------------------------+
;      Pcode:   <exp> opStIf(|) <stmt list> opStElse(|) | <stmt list> |
;                                                    +----------------+
;   
;   Block IF statement syntax to pcode mappings:
;   -------------------------------------------
;      Syntax:  IF <exp> THEN
;   
;      Pcode:   <exp> opStIfBlock(oText to beyond ELSEIF/ELSE/END IF opcode)
;   
;      ============================================================
;      Syntax:  ELSEIF <exp> THEN
;   
;      Pcode:   <exp> opStElseIf(oText to beyond next ELSEIF/ELSE/END IF opcode)
;
;      NOTE:    Scanner inserts exBranch(oText to beyond END IF opcode)
;               after the opBol and before <exp>, so code falling into the
;               ELSEIF will branch beyond END IF without evaluating <exp>.
;   
;      ============================================================
;      Syntax:  ELSE 
;