lsid.asm

Dos6.0

;	temp stack: [...]
; Exit:
;	root stack: [...]
;	temp stack: [")" indexN "," ... index1 "(" typeChar oNam ...]
;
;***************************************************************************
NO_ARY_ARGS EQU 8000H

PushTempAId PROC NEAR
	call	PopAsClause		;ax = offset to [AS <type>] node
					; (0 if no AS <type> clause)
	push	ax			;list AS <type> later
	lods	WORD PTR es:[si]	;ax = count of indicies
	mov	[cLsArgs],al		;save count of indicies
	push	ax
	call	PushTempId		;consume oNam operand, push nam node
	pop	ax
.errnz	NO_ARY_ARGS - 8000H
	or	ax,ax
	js	NoAryArgs		;got an array like ERASE A
					; with no indecies
	call	PushTempLParen		;push '(' onto temp stack
	call	CharToCharTok		;convert it to a LNT_CHARS_TOK node
	call	PushCommaArgs		;copy cLsArgs from root to temp
					; and separate them by commas
	call	PushTempRParen		;push ')' onto temp stack
NoAryArgs:
	pop	ax			;ax = offset to [AS <type>] (if any)
	or	ax,ax
	je	J1_Ret			;brif no AS <type> clause  (return)
	call	PushTemp		;list after id(...)
J1_Ret:
	ret
PushTempAId ENDP

;
; push a comma onto temp stack if FBOS_DIM flag is set
; Added as part of revision [36]
PushTempIdCommaDim PROC NEAR
	test	lsBosFlags2,FBOS2_Dim
	je	NoIdComma		;brif not in DIM/AUTO etc.
	test	lsBosFlags,FBOS_NextIdComma
	je	FirstId			;brif first id in list, no leading comma
	call	PushTempCommaSpc	;output a ', '
FirstId:
	or	lsBosFlags,FBOS_NextIdComma
NoIdComma:
	ret
PushTempIdCommaDim ENDP

;***************************************************************************
; LrIdLdxxx
; Purpose:
;	List the id opcodes as follows:
;	opIdLdxxx:  [...] ==> [typeChar oNam ...]
;	opIdRfxxx:  [...] ==> [typeChar oNam ...]
; Entry:
;	mpOpLsArg[bx] = explicit type char (0 if none)
;            
;***************************************************************************
ListRule LrVtRf
	call	PushTempIdCommaDim	;list ',' if in DIM type statement
SkipCommaDim:
ListRule LrIdLd				
ListRule LrIdRf
ListRule LrIdRfTyp
	call	PushTempId		;PushTemp(<typeChar> <oNam>)
	call	PopAsClause		;ax = offset to [AS <type>] node
					; (0 if no AS <type> clause)
	or	ax,ax
	je	NoIdAsClause
	call	PushTemp		;list after id
NoIdAsClause:
PUBLIC	PushListStg1
;push temp list to root as 1 node and return to outer loop
PushListStg1:
	call	PushList		;move temp stk to root as 1 node
	jmp	Stg1Loop		;return to outer loop

ListRule LrIdSt
ListRule LrIdStTyp
	test	[lsBosFlags2],FBOS2_CONST
	je	NotInConst		;brif not listing CONST stmt
	test	[lsBosFlags2],FBOS2_CONST_COMMA
	je	Not1stConst		;brif not listing CONST stmt
	call	PushTempCommaSpc	;list ", "
Not1stConst:
	or	[lsBosFlags2],FBOS2_CONST_COMMA
NotInConst:
	call	PushTempId		;PushTemp(<typeChar> <oNam>)
ListAStType1:
	call	PushTempSpc		;surround '=' with spaces
	mov	ax,' ='
	call	PushTempChars		;push a char node (ax) onto temp stack
	call	PopRootPushTemp		;move expNode from root to temp stk
	jmp	SHORT PushListStg1	;push temp list to root as 1 node
					; and return to outer loop

ListRule LrOffALd
	call	PushTempOffAId
	jmp	SHORT PushListStg1
ListRule LrOffASt
	call	PushTempOffAId
	jmp	SHORT ListAStType1

;***************************************************************************
; PushTempOffAId
; Purpose:
;	List the array type element opcode
;	[indexN ... index1 id] ==>
;	  [[")" indexN "," ... index1 "(" typeChar oNam "." id]]
;
;***************************************************************************
PushTempOffAId PROC NEAR
	lods	WORD PTR es:[si]	;ax = cArgs
	mov	[cLsArgs],al
	call	PushTempElem		;next word is the oNam/oElem of field
					;  push "." and fieldname to temp stk
	call	PushTempLParen		;push '(' onto temp stack
	call	CharToCharTok		;convert it to a LNT_CHARS_TOK node
	call	PushCommaArgs		;copy cLsArgs from root to temp
					; and separate them by commas
	call	PushTempRParen		;push ')' onto temp stack
	call	PopRoot			;ax = node for record of which
					;  the array is an element
	push	ax			;save ptr to node
	call	PushList		;create single node for array ref
					;  of form ".id(1,2)"
	pop	ax			;recover node for record
	call	PushTemp		;push it onto Temp stack		
	call	PopRootPushTemp		;mov ".id(1,2)" to Temp stack
	ret
PushTempOffAId ENDP

;***************************************************************************
; LrAIdLd [48]
; Purpose:
;	[indexN ... index1] ==>
;	  [[")" indexN "," ... index1 "(" typeChar oNam]]
;
;***************************************************************************
ListRule LrAIdLd
	call	PushTempAId		;push array id & indicies onto temp stk
	jmp	PushListStg1		;push temp list to root as 1 node
					; and return to outer loop

;***************************************************************************
; LrAVtRf [48]
; Purpose:
;	[exp ", " exp ", ..., " exp ] ==>
;	  [[")" exp "," ... exp "(" typeChar oNam]]
;	StripOptBase called to convert every other "," to TO
;
;***************************************************************************
ListRule LrAVtRf			
	call	PushTempIdCommaDim	;list ',' if in DIM type statement
	call	PushTempAId		;push array id & indicies onto temp stk
	call	PushList		
	test	[lsBosFlags2],FBOS2_DIM	
	je	AVtRfNotDim		;brif not listing DIM/AUTO etc.			
	call	PopRoot			;ax = offset to node to be DIMed
	call	StripOptBase		;walk through list ax, eliminating
					; nodes created by opDimOptionBase
					; and converting ',' to TO.
					; ax still = offset to node to DIM
	call	PushRoot		;push array node to temp stack
AVtRfNotDim:				
	jmp	Stg1Loop		;					; and return to outer loop

;***************************************************************************
; LrAIdSt, LrAIdStTyp
; Purpose:
;	List the array id assignment opcodes
;	[indexN ... index1 exp ...] ==>
;	  [[exp = [")" indexN "," ... index1 "(" typeChar oNam]] ...]
;
;***************************************************************************
ListRule LrAIdSt
ListRule LrAIdStTyp
	call	PushTempAId		;push array id & indicies onto temp stk
	jmp	ListAStType1

;***************************************************************************
; LrOffLd, LrOffRf, LrOffLdTyp, LrOffRfTyp
; Purpose:
;	List the id opcodes as follows:
;	opIdOffLdxxx:  [id ...] ==> [[typeChar oNam '.' id] ...]
;	opIdOffRfxxx:  [id ...] ==> [[typeChar oNam '.' id] ...]
; Entry:
;	mpOpLsArg[bx] = explicit type char (0 if none)
;            
;***************************************************************************
ListRule LrOffLd
ListRule LrOffRf
ListRule LrOffLdTyp
ListRule LrOffRfTyp
	call	PushOffId
	jmp	PushListStg1		;push temp list to root as 1 node
					; and return to outer loop
	
;***************************************************************************
; LrOffSt, LrOffStTyp
; Purpose:
;	List the id opcodes as follows:
;	opOffStxxx:  [id exp ...] ==> [exp = [typeChar oNam '.' id] ...]
; Entry:
;	mpOpLsArg[bx] = explicit type char (0 if none)
;            
;***************************************************************************
ListRule LrOffSt
ListRule LrOffStTyp
	call	PushOffId
	jmp	SHORT ListAStType1

;Table for mapping ET_xxx to INTEGER, LONG, ..., STRING
tRwET LABEL WORD
	DW	ORW_ANY			;res word for ET_I2
	DW	ORW_INTEGER		;res word for ET_I2
	DW	ORW_LONG		;res word for ET_I4
	DW	ORW_SINGLE		;res word for ET_R4
	DW	ORW_DOUBLE		;res word for ET_R8
	DW	ORW_STRING		;res word for ET_SD
	DW	ORW_STRING		;res word for ET_TX

;***************************************************************************
; PushTempAsClause
;	rewritten for revision [11]
; Purpose:
;	Called for opAsType, opAsTypeExp, opAsType2 and for proc. parameters
;	to push a spaces node, "AS " and <type> to temp stack.
; Entry:
;	ax = column to advance to (0 if 1 space)
;	bx = if <= ET_MAX then
;		it is a predefined "ET_" type 
;	     or if high bit not set 
;		it is the oNam of a user defined type
;	     otw if high bit is set it is a command equivalent [EB]
;		
;***************************************************************************
PushTempAsClause PROC NEAR
	push	bx			;save Type
	or	ax,ax
	je	OneSpace
	call	NewCol1			;ax = "advance to column(ax)" node
	call	PushTemp		;list it
	jmp	SHORT OneSpace1

OneSpace:
	call	PushTempSpc		;list " "
OneSpace1:

	mov	ax,ORW_As
	call	PushTempRwSpc		;list "AS "
	pop	ax			;ax = Type
	cmp	ax,ET_MAX
	jbe	AsExplicitType		;brif AS INTEGER...STRING
	call	NewONam			;ax = offset to oNam's node
	jmp	SHORT FinishAsClause


AsExplicitType:
	xchg	bx,ax
	shl	bx,1			;bx = type * 2
	mov	ax,tRwET[bx]		;ax = ORW_ANY,ORW_INTEGER .. ORW_DOUBLE
	call	NewRw			;ax = offset to reserved word node
FinishAsClause:
	call	PushTemp
	ret
PushTempAsClause ENDP

;***************************************************************************
; PopAsClause
; Purpose:
;	See if PushTempAsClause has been called since the last PopAsClause,
;	If so, return with ax = offset to [ AS <type>] node.
;	Else, ax = 0
;
;***************************************************************************
PopAsClause PROC NEAR
	sub	ax,ax			;0 = default return value
	test	[lsBolFlags],FBOL_AsClause
	je	NoAryType		;brif not A(...) AS <type>
	and	[lsBolFlags],0FFH - FBOL_AsClause
	call	PopRoot			;ax = offset to [AS <type>] node
NoAryType:
	ret
PopAsClause ENDP


;	[id] ==> [[type AS id]]
;
ListRule LrAsTypeFixed
	lods	WORD PTR es:[si]	;ax = oTyp operand
	xchg	bx,ax			;bx = oTyp operand
	lods	WORD PTR es:[si]	;ax = cb or oNam
	push	ax			;preserve cb or oNam
	sal	bx,1			;carry = 1 means its an oNam
	pushf				;save carry to test later
	shr	bx,1			;restore bx = oTyp
	lods	WORD PTR es:[si]	;ax = column for AS
	call	PushTempAsClause	;push "AS " and <type>
	mov	al,' '
	call	PushTempChar		;push " " to temp stack
	mov	ax,' *'
	call	PushTempChars		;push "* " to temp stack
	popf				;restore flags word
	pop	ax			;restore ax = cb or oNam
	jc	ItsAnONam		;brif its an oNam
	push	si			;preserve text pointer
	xchg	si,ax			;si = string length constant
	mov	ax,LIT_LINENUM * 256 + 2;al = length, ah = constant type
	call	NewNum			;ax = offset to numeric constant node
	pop	si			;restore text pointer
	jmp	SHORT AT2PushTemp	
ItsAnONam:
	call	NewONam			;ax = new ONam node
AT2PushTemp:
	call	PushTemp		;push the new node
	jmp	SHORT EndAsClause

;	[id] ==> [[type AS id]]
;
ListRule LrAsTypeExp
ListRule LrAsType
	lods	WORD PTR es:[si]	;ax = oTyp operand
	xchg	bx,ax			;bx = oTyp operand
	lods	WORD PTR es:[si]	;ax = column for AS
	call	PushTempAsClause	;Push [ AS <type>] to temp stack
EndAsClause:
	or	[lsBolFlags],FBOL_AsClause;remember to call PopAsClause
	jmp	PushListStg1		;return to outer loop

;	[...]  =>  [id]
;
ListRule LrElemRef
	lods	WORD PTR es:[si]	;ax = id's oNam
	call	PushRootONam		;list id
	jmp	Stg1Loop		;return to outer loop

;	[...]  =>  [id()]
;
ListRule LrAElemRef
	inc	si			;until static arrays are allowed
	inc	si			; the index count is ignored
	lods	WORD PTR es:[si]	;ax = id's oNam
	call	NewONam 		;ax = offset to new ONam node
	call	PushTemp		;push oNam note onto temp stack
	mov	ax,')('	
	call	PushTempChars		;push "()" onto temp stack
	jmp	PushListStg1		;push temp list to root as 1 node

;	[...]  ==>  [<id> TYPE]
;
ListRule LrStType
	call	PushRootOpRwSpc		;list "TYPE "
	inc	si			;skip opStType's link operand
	inc	si
	lods	WORD PTR es:[si]	;ax = opStType's oNam operand
	call	PushRootONam		;list type's id
	jmp	Stg1Loop		;return to outer loop


subttl Declarative opcodes

;---------------------------------------------------------------------------
;			Declarative opcodes
;---------------------------------------------------------------------------

;---------------------------------------------------------------------------
; DIM related opcodes
;	Original ASCII Text:
;	  DIM x,a(x),b(y TO z)
;	pcode:
;	  opVtRfImp(x),opStDimScalar,
;	  opDimOptionBase,opIdLdImp(x),opAVtRfImp(2,a),opStDimTo,
;	  opIdLdImp(y),opIdLdImp(z),opAVtRfImp(2,b),opStDimTo
;
;---------------------------------------------------------------------------
ListRule LrDimOptionBase
	mov	al,'?'
	call	PushRootChar		;for now, just list a "?"
	jmp	Stg1Loop		;return to outer loop

; The stmt "DIM SHARED a,b" produces the pcode
; opShared, opIdRef(a), opStDimScalar, opIdRef(b), opStDimScalar
; When opShared is seen, it sets a flag telling opStDimScalar (or
; similar opcode) to list SHARED after DIM.
;
ListRule LrShared
	or	[lsBolFlags],FBOL_Shared
	jmp	Stg1Loop		;return to outer loop

; If opShared has been seen, push SHARED to temp stack
PushTempShared PROC NEAR		
	mov	bx,LISTOFFSET PushTempRwSpc 
	jmp	SHORT PushSharedCommon
PushTempShared ENDP

; If opShared has been seen, push SHARED to root stack
PushRootShared PROC NEAR		
	mov	bx,LISTOFFSET PushRootRwSpc 
PushSharedCommon:
	test	[lsBolFlags],FBOL_Shared
	je	NoShared
	and	[lsBolFlags],0FFH - FBOL_Shared
	mov	ax,ORW_SHARED
	jmp	bx			;push reserved word ax
NoShared:
	ret
PushRootShared ENDP