lsrules.asm

[随书类]Dos6.0源代码

	jmp	PushListStg1		;move temp stk to root
					; and return to outer loop
ListRule LrStClose
	lods	WORD PTR es:[si]	;ax = number of arguments
	mov	[cLsArgs],al
	jmp	ListStmtArgs		;pop statement args and list with ", "

;	[exp var]  ==>  [[exp = var LSET/RSET]]
;
ListRule LrStRset
ListRule LrStLset
	call	PushTempOpRwSpc		;push opcode's resword (LSET/RSET)
	call	PopRootPushTemp		;move var node from root to temp stk
	mov	ax,'= '
	call	PushTempChars		;list ' ='
	call	PushTempSpc
	call	PopRootPushTemp		;move expNode from root to temp stk
	jmp	PushListStg1		;move temp stk to root as 1 node
					; and return to outer loop

;	[exp4 exp3 exp2 lval]  ==>  [exp4 = (exp3, exp2, lval) MID$]
;	[exp3 exp2 lval]  ==>  [exp3 = (exp2, lval) MID$]
;
ListRule LrStMid_2
	mov	[cLsArgs],1
	jmp	SHORT MidCont
ListRule LrStMid_3
	mov	[cLsArgs],2
MidCont:
	call	PopRoot			;ax = lval node
	xchg	cx,ax			;cx = lval node
	call	PopRoot			;ax = exp4 node
	push	ax			;save exp4 node
	push	cx			;save lval node
	call	PushTempOpRw		;list "MID$"
	call	PushTempLParen		;push '(' onto temp stack
	pop	ax			;ax = lval node
	call	PushTemp		;list lval node
	call	PushTempCommaSpc	;list ", "
	call	PushCommaArgs		;copy cLsArgs from root to temp
					; and separate them by commas
	call	PushTempRParen		;push ')' onto temp stack
	call	PushTempSpc
	mov	ax,' ='
	call	PushTempChars		;list '= '
	pop	ax			;ax = exp4 node
	call	PushTemp		;push it to temp stack	
	jmp	PushListStg1		;move temp stk to root as 1 node
					; and return to outer loop

;	[exp2 exp1]  ==>  [[exp2 AS exp1 NAME]]
;
ListRule LrStName
	call	PopRootPushTemp		;move exp2 node from root to temp stk
	call	PushTempSpc
	mov	ax,ORW_AS
	call	PushTempRwSpc		;list AS
	call	PopRootPushTemp		;move var node from root to temp stk
	call	PushTempSpc
	call	PushTempOpRw		;push opcode's resword
	jmp	PushRevListStg1		;move temp stk to root in reverse order
					; and return to outer loop



;These constants reside in rtps.inc
;FINP_QSupress	EQU 1	;set if "prompt" was followed by a comma,
;			;not a semicolon, indicating "? " is not to be
;			;output after prompt.
;FINP_CrLf	EQU 2	;set if INPUT was followed by optional ";",
;			;meaning CrLf is not to be output when user
;			;presses return.
;FINP_Prompt	EQU 4	;set if the optional SDPrompt argument is included.


;   [ id optionalPromptExp chan]  ==>  [ id optionalPromptExp chan INPUT LINE]
;
;   [ id optionalPromptExp]  ==>  [ id optionalPromptExp INPUT LINE]
;
;   [ optionalPromptExp ]  ==>  [ optionalPromptExp INPUT ]
;
ListRule LrStLineInput
	call	PopRoot			;ax = offset to id node
	push	ax			;save it
	mov	ax,ORW_LINE
	call	PushTempRwSpc		;list "LINE "
	lods	WORD PTR es:[si]	;ax = FINP_xxx mask
	mov	cl,al			;al = FINP_xxx mask
	call	DoInputPrompt		;list "INPUT ..."
	test	[lsBosFlags],FBOS_Channel
	je	NoChan1			;brif not LINE INPUT #n,
	call	PopPushCommaSpc		;move #chan to temp stack
					;list ", "
NoChan1:
	pop	ax			;ax = offset to id node
	call	PushTemp		;list id node
	jmp	PushListStg1		;push temp list to root as 1 node
					; and return to outer loop

ListRule LrInputPrompt
	lods	WORD PTR es:[si]	;ax = byte count of opcode's operand
	inc	ax			;round up to even byte count
	and	al,0FEH
	mov	cl,BYTE PTR es:[si]	;cl = FINP_xxx mask
	add	si,ax			;advance si beyond opInputPrompt
	call	DoInputPrompt
	jmp	PushListStg1		;push temp list to root as 1 node
					; and return to outer loop

;cl = FINP_xxx mask
DoInputPrompt PROC NEAR
	call	PushTempOpRwOrComma	;list "INPUT ", and set flag so
					; opStInput lists as ", "
	or	[lsBosFlags],FBOS_InputPrompt
					;tell LrStInput not to list INPUT
	test	cl,FINP_CrLf
	je	No_CrLf			;brif INPUT not followed by 
	mov	al,';'
	call	PushTempCharSpc		;list "; "
No_CrLf:				;brif INPUT not followed by 
	test	cl,FINP_Prompt
	je	No_Prompt		;brif INPUT not followed by "prompt"
	call	PopRootPushTemp		;move "prompt" from temp to root stack
	mov	al,';'
	test	cl,FINP_QSupress
	je	No_QSupress		;brif prompt not followed by ,
	mov	al,','
No_QSupress:
	call	PushTempCharSpc		;list "; " or ", "
No_Prompt:
	ret
DoInputPrompt ENDP

;	[exp chan]  ==>  [exp ,chan# INPUT]
;	[exp]  ==>  [exp INPUT]
;	[exp]  ==>  [exp ,]
;
ListRule LrStInput
	test	[lsBosFlags],FBOS_InputPrompt
	jne	NoInpPrompt		;brif opInputPrompt has already
					; been scanned in this stmt
	call	PopRoot			;ax = offset to exp node
	push	ax
	call	PushTempOpRwOrComma	;list "INPUT " or ", "
	test	[lsBosFlags],FBOS_Channel
	je	NoChan			;brif not INPUT #n,
	and	[lsBosFlags],0FFH - FBOS_Channel
	call	PopPushCommaSpc		;move #chan to temp stack
					;list ", "
NoChan:
	pop	ax			;ax = offset to exp node
	call	PushTemp		;list it
	jmp	PushListStg1		;push temp list to root
					; and return to outer loop

NoInpPrompt:
	and	[lsBosFlags],0FFH - FBOS_InputPrompt
	jmp	Stg1Loop


;	[expLast exp1st expFileNum] ==>
;	 [expLast TO expFirst , expFileNum LOCK/UNLOCK]
;	or if LOCK_1stToLast bit is not set in operand:
;	[expFileNum] ==> [expFileNum LOCK/UNLOCK]
;
ListRule LrStLock
ListRule LrStUnLock
	lods	WORD PTR es:[si]	;ax = operand for opStLock/opStUnlock
.errnz	LOCK_1stToLast AND 0FF00H	;if error, test ah
	test	al,LOCK_1stToLast	
	je	LockAll			;brif no 1st/last arg
	xchg	cx,ax			;cx = operand
	test	ch,LOCK_DefLastArg/256
	jne	DefLastArg		;brif last arg was defaulted
	call	PopRoot			;ax = offset to expLast node
.errnz	LOCK_DefLastArg AND 0FFH	;if error, test cl
	call	PushTemp		;push expLast to temp stack
	call	PushTempSpc
	mov	ax,ORW_TO
	call	PushTempRw		;list TO
DefLastArg:
	call	PopRoot			;ax = offset to exp1st node
.errnz	LOCK_Def1stArg AND 0FFH		;if error, test cl
	test	ch,LOCK_Def1stArg/256
	jne	Def1stArg		;brif 1st arg was defaulted
	push	ax			;save exp1st
	call	PushTempSpc		;list a SPACE between TO and exp1st
	pop	ax			;ax = exp1st
	call	PushTemp		;push exp1st to temp stack
Def1stArg:
	call	PushTempCommaSpc	;list ", "
LockAll:
	call	PopRootPushTemp		;move filenum from root to temp stk
	call	PushTempSpc
	call	PushTempOpRw		;list LOCK/UNLOCK
	jmp	PushRevListStg1		;move temp stk to root in reverse order
					; and return to outer loop

;	[exp3 exp2 exp1] ==> [exp3 , exp2 , exp1 OPEN]
;
ListRule LrStOpenOld3
	mov	al,3			;list 3 expressions separated by ", "
	jmp	SHORT ListExps

;	[exp4 exp3 exp2 exp1] ==> [exp4, exp3, exp2, exp1 OPEN]
;
ListRule LrStOpenOld4
	mov	al,4
ListExps:
	mov	[cLsArgs],al		;setup for call to PushCommaArgs
	call	PushTempOpRwSpc		;list OPEN
	call	PushCommaArgs		;list open arguments
	jmp	PushListStg1		;push temp list to root as 1 node
					; and return to outer loop

MASK_INPUT	EQU 01H
MASK_OUTPUT	EQU 02H
MASK_APPEND	EQU 04H
MASK_RANDOM	EQU 08H
MASK_BINARY	EQU 10H
MASK_FOR	EQU 20H
tRwMode:
	DW  ORW_INPUT, ORW_OUTPUT, ORW_APPEND, ORW_RANDOM, ORW_BINARY, ORW_FOR

MASK_WRITE	EQU 01H
MASK_READ	EQU 02H
MASK_SHARED	EQU 04H
MASK_LOCK	EQU 08H
MASK_ACCESS	EQU 10H
tRwAccess:
	DW	ORW_WRITE, ORW_READ, ORW_SHARED, ORW_LOCK, ORW_ACCESS

;This table says, if <mode> == MD_SQI, list FOR INPUT,
;                 if <mode> == MD_SQO, list FOR OUTPUT, etc.
tMaskMode:
	DB	MD_SQI, MASK_INPUT  + MASK_FOR
	DB	MD_SQO, MASK_OUTPUT + MASK_FOR
	DB	MD_APP, MASK_APPEND + MASK_FOR
	DB	MD_RND, MASK_RANDOM + MASK_FOR
	DB	MD_BIN, MASK_BINARY + MASK_FOR
	DB	0	;end of list

;This table says, if <access> == ACCESS_BOTH, list READ WRITE, etc.
tMaskAccess:
	DB	ACCESS_READ, MASK_ACCESS + MASK_READ
	DB	ACCESS_WRITE, MASK_ACCESS + MASK_WRITE
	DB	ACCESS_BOTH, MASK_ACCESS + MASK_WRITE + MASK_READ
	DB	0	;end of list

;This table says, if <lock> == LOCK_BOTH, list LOCK READ WRITE, etc.
tMaskLock:
	DB	LOCK_READ, MASK_READ + MASK_LOCK
	DB	LOCK_WRITE, MASK_WRITE + MASK_LOCK
	DB	LOCK_BOTH, MASK_WRITE + MASK_READ + MASK_LOCK
	DB	LOCK_SHARED, MASK_SHARED
	DB	0	;end of list

;*************************************************************************
; OutRwMask
; Purpose:
;	Output 1 or more reserved words based on a mask value and tables
; Entry:
;	al = value to search for
;	bx = offset to ORW_xxx table (in cs:)
;	dx = offset to mask table (in cs:)
;
;*************************************************************************
OutRwMask PROC NEAR
	push	si			;save caller's si
	push	cx			;save caller's cx
	mov	cl,al			;cl = mode we're looking for
	mov	si,dx			;si points to mask table (in cs)
OpnMdLoop:
	lods	BYTE PTR cs:[si]	;al = comparison value
	or	al,al
	je	OpnMdExit		;brif end of table
	cmp	al,cl
	lods	BYTE PTR cs:[si]	;al = mask of res words to output
	jne	OpnMdLoop		;brif al is not value of interest (cl)
	mov	cl,al			;cl = mask of res words to output
	mov	si,bx			;si points to ORW_xxx table (in cs)
OpnRwLoop:
	or	cl,cl
	je	OpnMdExit		;brif end of reserved word mask
	lods	WORD PTR cs:[si]	;ax = ORW_xxx to be listed
	shr	cl,1
	jnc	OpnRwLoop		;brif this res word not to be listed
	call	PushTempRwSpc		;list it
	jmp	SHORT OpnRwLoop

OpnMdExit:
	pop	cx
	pop	si
	ret
OutRwMask ENDP

;	[exp3 exp2 exp1] ==> [exp3 = LEN, exp2 AS <mode> FOR exp1 OPEN]
;
ListRule LrStOpen3
	call	PopRootPushTemp		;move exp3 node from root to temp stk
	mov	ax,' ='
	call	PushTempChars		;list "= "
	call	PushTempSpc
	mov	ax,ORW_LEN
	call	PushTempRwSpc		;list "LEN "
	;fall into LrStOpen2
;	[exp2 exp1] ==> [exp2 AS <mode> FOR exp1 OPEN]
;
ListRule LrStOpen2
	call	PopRootPushTemp		;move exp2 node from root to temp stk
	call	PushTempSpc		;list " "
	mov	ax,ORW_AS
	call	PushTempRwSpc		;list "AS "
	lods	WORD PTR es:[si]	;ax = opStOpen's operand
	xchg	cx,ax			;save copy in cx

	mov	al,ch			;al = access/locking bits
	and	al,0F0H			;al = locking bits
	mov	bx,LISTOFFSET tRwAccess
	mov	dx,LISTOFFSET tMaskLock
	call	OutRwMask		;list LOCK READ/WRITE/READ WRITE  or
					;     SHARED

	mov	al,ch			;al = access/locking bits
	and	al,0FH			;al = access bits
	mov	bx,LISTOFFSET tRwAccess
	mov	dx,LISTOFFSET tMaskAccess
	call	OutRwMask		;list ACCESS READ/WRITE/READ WRITE

	mov	al,cl			;al = mode bits
	mov	bx,LISTOFFSET tRwMode
	mov	dx,LISTOFFSET tMaskMode
	call	OutRwMask		;list FOR INPUT/OUTPUT/APPEND/
					;         RANDOM/BINARY

	call	PopRootPushTemp		;move exp1 node from root to temp stk
	call	PushTempSpc
	call	PushTempOpRw		;list "OPEN"
	jmp	PushRevListStg1		;move temp stk to root in reverse order
					; and return to outer loop

; source: FIELD #1 ...
; pcode: opLit1 opLbs opFieldInit ...
;	[ expChan ...] ==> expChan FIELD]
;
ListRule LrFieldInit
	call	PopRootPushTemp		;copy #n to temp stack
	call	PushRootOpRwSpc		;list "FIELD "
	jmp	PushRevListStg1 	;return to outer loop
	

; source: , a as b, c as d
; pcode: opId(a) opId(b) opFieldItem opId(c) opId(d) opFieldItem
;	[ idAs2 expCnt2 ] ==> [idAs2 AS expCnt2 ,]
;
ListRule LrFieldItem
	call	PopRootPushTemp		;copy idAsN to temp stack
	call	PushTempSpc		;list " "
	call	PushTempOpRwSpc		;list "AS "
	call	PopPushCommaSpc		;copy expCntN to temp stack
					;list ", "
	jmp	PushRevListStg1		;return to outer loop


;	opStGetRec2: [exp2 exp1]  ==>  [exp2,,exp1 GET]
;	opStGetRec3: [exp3 exp2 exp1]  ==>  [exp3,exp2,exp1 GET]
;	opStPutRec2: [exp2 exp1]  ==>  [exp2,,exp1 PUT]
;	opStPutRec3: [exp3 exp2 exp1]  ==>  [exp3,exp2,exp1 PUT]
;
ListRule LrStGetRec2
ListRule LrStPutRec2
	call	PopPushCommaSpc		;move exp2 node from root to temp stk
					;list ", "
	jmp	SHORT GetPut1

ListRule LrStGetRec3
ListRule LrStPutRec3
	call	PopPushCommaSpc		;move exp3 node from root to temp stk
					;list ", "
	call	PopRootPushTemp		;move exp2 node from root to temp stk
GetPut1:
	call	PushTempCommaSpc	;list ", "
	call	PopRootPushTemp		;move exp1 node from root to temp stk
	call	PushRootOpRwSpc		;list "GET/PUT "
	inc	si			;skip size operand
	inc	si
	jmp	PushRevListStg1 	;move temp stk to root in reverse order
					; and return to outer loop


;	[exp2 exp1] ==> [exp2, exp1 WIDTH]
;
ListRule LrStWidth2
ListRule LrStWidthfile
	call	PopNilExp		;copy exp2 and "," to temp stack
	call	PopRootPushTemp		;copy exp1 from root to temp stk
	call	PushRootOpRwSpc		;list "WIDTH "
	jmp	PushRevListStg1		;move temp stk to root in reverse order
					; and return to outer loop

;copy exp from root to temp stack
; if exp is opUndef or opNull, don't copy anything to temp stack.
; If an expression is seen, all subsequent calls for this
; statement list at least ", "
;
PopNilExp PROC NEAR
	call	PopRoot			;ax = offset to exp node
	call	ListOffToPtr		;bx = ptr to node ax
	cmp	BYTE PTR [bx.LN_type],LNT_CHAR
	jne	NotNilExp		;brif not nil expression
	cmp	BYTE PTR [bx.LN_val_char],0
	jne	NotNilExp		;brif this arg's value is defaulted
					;i.e. if node produced by opNull or
					;opUndef
	test	[lsBosFlags2],FBOS2_NonNilExp
	je	GotNilExp
	jmp	SHORT NonNilExp

NotNilExp:
	call	PushTemp		;push node ax onto temp stack
	or	[lsBosFlags2],FBOS2_NonNilExp
NonNilExp:
	call	PushTempCommaSpc	;list ", "
GotNilExp:
	ret
PopNilExp ENDP



subttl PRINT related opcodes

;------------------------------------------------------------------
;			PRINT related opcodes
;------------------------------------------------------------------

;-----------------------------------------------------------------------
; Print related opcodes
;
; The statement:
;	PRINT USING a$; x, TAB(5); y
; produces the pcode:
;	(a$)opUsing
;       (x)opPrintItemComma