prsid.asm

Dos6.0

	call	BdShiftRight
	or	ax,ax
	jne	StoreOpBase
	call	ParseErrOm		;Error "Out of memory"
	jmp	SHORT GetComma

;store opDimOptionBase opcode in pcode buffer
StoreOpBase:
	add	[ps.PS_bdpDst.BDP_pbCur],2
	mov	bx,[ps.PS_bdpDst.BDP_pb]
	add	bx,di			;add in oDstExp
	mov	WORD PTR [bx],opDimOptionBase
GetComma:
	mov	ax,IRW_Comma
	call	TestScan_AX
	jne	NtIdEndArgs		;brif current token is not comma
	cmp	si,MAXDIM
	jae	NtIdEndArgs		;BASCOM can't handle more than 60
					; args, so we shouldn't either
	call	ScanTok			;skip comma
	jmp	NtIdArgLoop		;get next arg

NtIdEndArgs:
	or	si,si			;test cArgs
	jne	NtIdGetRParen		;brif got more than 1 index
	test	[maskLO],IDM1_EXP
	je	NtIdGetRParen		;brif we don't need any expressions
	call	PErrExpExpr		;error "Expected expression"
	jmp	SHORT NtIdExit		;return PR_BadSyntax

NtIdGetRParen:
	mov	ax,IRW_RParen
	call	ConsumeRw_AX		;consume ')'
	jc	NtIdSnErr		;brif syntax error
	test	WORD PTR [maskHI],IDM2_AS
	je	NotAryAs		;brif not expecting AS clause

	;check for AS clause
	sub	ax,ax
	lea	bx,[tokId]
	call	NtAsClause		;parse AS <type>
	jge	NotAryAs		;brif result != PR_BadSyntax
NtIdSnErr:
	mov	al,PR_BadSyntax
	jmp	SHORT NtIdExit

NotAryAs:
	lea	ax,[tokId]
	push	ax
	push	[opBase]
	push	si			;pass cArgs
	push	[flags]
	call	EmitVar			;emit pcode for array ref
	jc	NtIdSnErr		;brif syntax error
	mov	[fLastIdIndexed],TRUE
NtIdEnd:
	;this is (and must remain) the only exit point for PR_GoodSyntax
	mov	al,PR_GoodSyntax
NtIdExit:
	;Can't just bump cIdArgs, recursive calls to NtExp could have
	;bumped it, making it useless.
	
	pop	dx			;dx = caller's cIdArgs
	inc	dx
	or	al,al			;set condition codes for caller
	jle	NtIdExit1		;brif result != PR_GoodSyntax
	mov	[cIdArgs],dx		;bump cIdArgs
NtIdExit1:
cEnd


;*********************************************************************
; CopyTokScanBx
; Purpose:
;	Copy important fields from one token descriptor to another.
;	Then call ScanTok to advance to next token.
; Entry:
;	[pTokScan] points to source token
;	bx points to destination token
;
;*********************************************************************
PUBLIC	CopyTokScanBx
CopyTokScanBx PROC NEAR
	push	[pTokScan]		;pass pbSrc
	push	bx			;pass pbDst
	PUSHI	ax,<size TOK>		;pass byte count
	call	CopyBlk			;copy the token descriptor
	jmp	ScanTok			;get next token, then return to caller
CopyTokScanBx ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdAryDim()
;
; Purpose:
;	Try to parse a scalar or array element of the form:
;	   id[<type>] [(exp [TO exp], ... )] [AS <type>]
;	This can occur in the statement  DIM IdAryDim ...
;
; Exit:
;	Returns PR_NotFound, PR_GoodSyntax or PR_BadSyntax
;
;*********************************************************************
PUBLIC	NtIdAryDim
NtIdAryDim PROC NEAR
	mov	ax,IDM_INDEXED OR IDM_EXP OR IDM_DIM OR IDM_VTREF OR IDM_AS
	jmp	NtId			

NtIdAryDim ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdAryRedim()
;
; Purpose:
;	Try to parse a scalar or array element of the form:
;	   id[<type>] [(exp [TO exp], ... )] [AS <type>]
;	This can occur in the statement  REDIM IdAryDim ...
;
; Exit:
;	Returns PR_NotFound, PR_GoodSyntax or PR_BadSyntax
;
;*********************************************************************
PUBLIC	NtIdAryRedim
NtIdAryRedim PROC NEAR
	mov ax,IDM_INDEXED OR IDM_EXP OR IDM_DIM OR IDM_AS OR IDM_NOSCALAR
	call	NtId
	jle	AryDimExit		;brif result != PR_GoodSyntax
	cmp	[fLastIdIndexed],FALSE
	je	AryDimExit		; Brif NtId emitted a scalar
	mov	ax,opStRedimTo
	call	Emit16_AX
	mov	al,PR_GoodSyntax
AryDimExit:
	or	al,al			; Set flags for caller
	ret	
NtIdAryRedim ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtImpliedLetOrCall(fCantBeCall)
;
; Purpose:
;	Parse implied LET or CALL or TYPE/AS statement
;	   id = exp
;	   id [argList]
;	   id AS (INTEGER | LONG | SINGLE | DOUBLE | STRING * const | id)
;	A complicated example is:
;	   a(x).b=c(y).d which produces:
;	opIdLd(y) opAIdRf(1,c) opOffLd(d) opIdLd(x) opAIdRf(1,a) opOffSt(b)
;
; Entry:
;	It is assumed that pTokScan points to an id token
;	fCantBeCall is TRUE if it MUST be a LET statement
;
; Exit:
;	Never returns PR_NotFound, only PR_GoodSyntax or PR_BadSyntax
;	Condition codes set based on value in al
;
;*********************************************************************
cProc	NtImpliedLetOrCall,<PUBLIC,NEAR>,<si,di>
	parmW	fCantBeCall		;can't be parmB because some caller's
					; do a push sp to pass TRUE
	localB	fGotScalar
	localW	cArgs
	;reg si = oDstLvalStart
	localW	oDstLvalEnd
	localV	tokId,%(size TOK)
	localW	cbShift
cBegin
	call	Peek1Tok		;look at token past id
	mov	ax,IRW_AS
	call	TestPeek_AX
	jne	NotAsType1		;brif id not followed by AS

	;got  id AS type  statement, presumably within TYPE/END TYPE block
	call	IdTokNoPeriodImp	;parse id token with no period in it
					;error if not implicit
	jl	J1_LetExit		;brif PR_BadSyntax
	lea	bx,tokId
	call	CopyTokScanBx		;copy [pTokScan] to [bx], ScanTok
	mov	ax,opElemRef
PrsAsClause:
	call	Emit16_AX
	mov	ax,[tokId.TOK_id_oNam]	;ax = oNam of variable in as clause
	call	Emit16_AX

	;now parse 'AS <type>' and emit opAsType(oNam)
; if FV_FARSTR is TRUE but that would be nearly unreadable
	mov	al,FAS_fNoVarLenStr + FAS_fDontBind + FAS_fDontSetONam
					;AS STRING is not allowed within
					; a TYPE stmt.  AS STRING * N is
					;Don't call RefType(x) for id as x
	lea	bx,tokId
	call	NtAsClause		;parse "AS <type>" clause
J1_LetExit:
	jmp	LetExit			

NotAsType1:
	lea	bx,tokId
	call	CopyTokScanBx		;copy [pTokScan] to [bx], ScanTok
	mov	si,[ps.PS_bdpDst.BDP_cbLogical]
					;si = oDstLvalStart]
	mov	[fGotScalar],TRUE
	call	NtExprList		;try to parse "(exp, exp, ..., exp)"
	mov	[cArgs],cx		;record number of args found
	je	LetNotAry		;brif not found
	jl	J1_LetExit		;brif syntax error
LetGotAry:
	mov	[fGotScalar],FALSE
	
LetNotAry:
	call	FElements		;see if cur token is record separator
	je	ItsALet			;brif we got .elem (it can't be CALL)
	cmp	cx,1			
	ja	ItsALet			;brif got x(y,...)... (can't be CALL)
	mov	ax,IRW_EQ
	call	TestScan_AX
	je	ItsALet			;brif got '=' (can't be CALL)
	jmp	ImpliedCall		;brif didn't get an implied LET stmt

;we're looking at an implied LET statement, not an implied CALLstatement
ItsALet:
	or	[tokId.TOK_id_vmFlags],FVI_LVAL
	cmp	[fGotScalar],FALSE
	je	LetAry
	lea	ax,[tokId]
	push	ax			;pass ptr to id's token
	PUSHI	ax,opId_St		;emit a Store id variant
	PUSHI	ax,0			;cArgs = 0
	PUSHI	ax,FEM_ElemOk		;.elem may follow variable
	jmp	SHORT LetEmitVar

;lvalue is an array element
LetAry:
LetAryGood:
	lea	ax,[tokId]
	push	ax
	PUSHI	ax,opId_St		;emit a Store id variant
	push	[cArgs]			;arg count
	PUSHI	ax,<FEM_Ary OR FEM_ElemOk> ;.elem may follow variable
LetEmitVar:
	call	EmitVar			;emit an array store opcode
	jc	LetSnErr		;brif EmitVar got error
	mov	ax,[ps.PS_bdpDst.BDP_cbLogical]
	mov	[oDstLvalEnd],ax	;save offset to end of lval's pcode
	mov	ax,IRW_EQ
	call	ConsumeRw_AX		;parse '='
	jc	LetSnErr		;brif error
	call	NtConsumeExp		;parse an expression
	jl	LetSnErr		;brif result == PR_BadSyntax
	mov	ax,[ps.PS_bdpDst.BDP_cbLogical]
	sub	ax,[oDstLvalEnd]
	mov	[cbShift],ax

	;for assignments like A(X,Y)=Z, the pcode buffer contains:
	;           <id(X)> <id(Y)> <id(A)> <id(Z)>
	;         1^                      2^      3^
	; where 1^=oDstLvalStart, 2^=oDstLvalEnd, 3^=cbLogical
	; The next few lines swap argument and expression pcode to be:
	;             <id(Z)> <id(X)> <id(Y)> <id(A)>
	
	PUSHI	ax,<DATAOFFSET ps.PS_bdpDst>
	push	si
	push	[cbShift]
	call	BdShiftRight
	or	ax,ax
	jne	RightOk
	call	ParseErrOm		;Error "Out of memory"
	jmp	SHORT J1_LetGoodSyntax

RightOk:
	mov	ax,[oDstLvalEnd]
	add	ax,[cbShift]
	add	ax,[ps.PS_bdpDst.BDP_pb] ;ax points to source
	push	ax
	xchg	ax,si			;ax = oDstLvalStart
	add	ax,[ps.PS_bdpDst.BDP_pb] ;ax points to destination
	push	ax
	push	[cbShift]		;pass byte count
	call	CopyBlk
	mov	ax,[cbShift]
	sub	[ps.PS_bdpDst.BDP_cbLogical],ax
J1_LetGoodSyntax:
	jmp	SHORT LetGoodSyntax


InvalidCall:
	mov	ax,MSG_ExpAssignment	;Error "Expected var=expression"

LetExpErr:
	call	PErrExpMsg_AX
	;tell user-interface what column error really occured in
	mov	ax,[tokId.TOK_oSrc]
	mov	[ps.PS_oSrcErr],ax
LetSnErr:
	mov	al,PR_BadSyntax
	jmp	SHORT LetExit		


;we're looking at an implied CALL statement, not an implied LET statement
;If [cArgs] == 1, we've already consumed the 1st argument, because we
;   weren't sure if it was an array lval.
;   idProc ( expression ) [, arg2 [, arg3 ...]]
;          current token ^
;If [cArgs] == 0, we've just consumed the idProc
;            idProc [arg1 [, arg2 ...]]
;    current token ^
;
ImpliedCall:
	cmp	[fCantBeCall],FALSE
	jne	InvalidCall		;brif implied CALL is invalid here
	cmp	[tokId.TOK_id_oTyp],ET_IMP
	jne	InvalidCall		;brif sub id is explicitly typed
	cmp	[cArgs],0
	je	CallArg1		;brif no args consumed yet

; We've got IdProc (arg) [, ...] --- 
GotPassByVal:
	mov	ax,opLParen		;already consumed 1st arg,
	call	Emit16_AX		;it was a parend expression
	jmp	SHORT CallArg2		;get 2nd CALL arg (if any)

CallArgLoop:
	call	ScanTok			;skip ','
	call	NtIdCallArg		;consume 1st arg (if any)
	jg	CallArgNext		;brif result is PR_GoodSyntax
	jl	J4_LetSnErr		;brif result == PR_BadSyntax
	call	PErrExpExpr		;error "Expected expression"
J4_LetSnErr:
	jmp	LetSnErr		;return al = PR_BadSyntax

;so far, we've just seen idProc.  Try to parse 1st arg.
;
CallArg1:
	call	NtIdCallArg		;consume 1st arg (if any)
	je	CallArgEnd		;brif no args
CallArgNext:
	inc	[cArgs]			;bump arg count
	cmp	[cArgs],MAXARG		
	jae	CallArgEnd		;don't parse more args if got max
					; this will generate "expected EOL"
CallArg2:
	mov	ax,IRW_Comma
	call	TestScan_AX
	je	CallArgLoop		;brif got a comma
CallArgEnd:
	mov	ax,opStCallLess
CallEmitOp:
	call	Emit16_AX		;emit opcode
	mov	ax,[cArgs]
	call	Emit16_AX		;emit arg count
	mov	ax,[tokId.TOK_id_oNam]	;ax = oNam for sub
	call	SubRef			;ax = oPrs for sub
	jc	LetGoodSyntax		;brif couldn't define prs
					;ps.errCode set, so pcode won't be
					;emitted - line will be opReParse

	call	Emit16_AX		;emit oPrs for sub (parm pushed above)
LetGoodSyntax:
	mov	al,PR_GoodSyntax
LetExit:
	or	al,al			;set condition codes for caller
cEnd

;*********************************************************************
; PARSE_RESULT NEAR NtIdNamCom()
;
; Purpose:
;	Try to parse an identifier of the form:  id <with no explicit type>
;	The id can have a period, regardless of 'x AS' elsewhere in module.
;	This can occur in the following statements:
;	   COMMON [/IdNamCom/] ...
;
; Exit:
;	If good syntax, Emits id's 16-bit oNam and returns PR_GoodSyntax
;	Otherwise, an error is generated and PR_BadSyntax is returned.
;	Never returns PR_NotFound because no callers have other options
;
;*********************************************************************
PUBLIC	NtIdNamCom
NtIdNamCom PROC NEAR
	call	IdTokPeriodImp1
	jmp	SHORT NtIdImp1
NtIdNamCom ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdType()
;
; Purpose:
;	Try to parse an identifier of the form:  id <with no explicit type>
;	The id can have no periods.
;	This can occur in the following statements:
;	   DIM a AS IdType
;	   TYPE IdType
;	     Id AS IdType  'element definition in TYPE block
;
; Exit:
;	If good syntax, Emits id's 16-bit oNam and returns PR_GoodSyntax
;	If token is not an id, returns PR_NotFound
;	Else PR_BadSyntax after generating error
;
;*********************************************************************
PUBLIC	NtIdType
NtIdType PROC NEAR
	call	IdTok
	mov	al,PR_NotFound
	jne	NtIdImpExit		;brif not an id token
	call	IdTokNoPeriodImp	;parse id token with no period in it
					;error if not implicit
NtIdImp1:
	jl	NtIdImpExit		;brif PR_BadSyntax
;Jumped to from other procedures
NtIdImp2:
	mov	ax,[bx.TOK_id_oNam]
	call	Emit16_AX		;e