MACLNG.ASM

; [ This translation created 10-Feb-83 by Version 4.3 ]

	.RADIX  8		; To be safe

CSEG	SEGMENT PUBLIC 'CODESG' 
	ASSUME  CS:CSEG

INCLUDE	OEM.H

	TITLE   MACLNG - MACRO LANGUAGE DRIVER
;
; MICROSOFT GRAPHICS AND SOUND MACRO LANGUAGES
;
TSHIBA=0
ALPCPM=0



	PUBLIC	FETCHR,FETCHZ,DECFET
	PUBLIC	VALSCN,VALSC2,VARGET,NEGD

	EXTRN	FCERR:NEAR,FRESTR:NEAR,FRCINT:NEAR,FRMEVL:NEAR,ISVAR:NEAR

DSEG	SEGMENT PUBLIC 'DATASG'
	ASSUME DS:DSEG
	EXTRN	MCLLEN:WORD,MCLPTR:WORD,BUF:WORD,MCLTAB:WORD
DSEG	ENDS

	PUBLIC	MACLNG,MCLXEQ
	EXTRN	GETBCD:NEAR

MACLNG:	MOV	MCLTAB,DX	;SAVE POINTER TO COMMAND TABLE
	CALL	FRMEVL		;EVALUATE STRING ARGUMENT
	PUSH	BX		;SAVE TXTPTR TILL DONE
	MOV	DX,0		;PUSH DUMMY ENTRY TO MARK END OF STK
	PUSH	DX		;DUMMY ADDR
	PUSH	AX		;DUMMY LENGTH

MCLNEW:	CALL	FRESTR
	CALL	GETBCD		;GET LENGTH & POINTER
	MOV	AL,CH
	OR	AL,CL
	JZ	SHORT MCLOOP	;Don't Push if addr is 0
	MOV	AL,DH
	OR	AL,AL
	JZ	SHORT MCLOOP	; or if Len is 0...
	PUSH	CX		;PUSH ADDR OF STRING
	MOV	AL,DH		;PUT IN [AL]
	PUSH	AX

MCLOOP:	POP	AX		;GET LENGTH OFF STACK
	MOV	BYTE PTR MCLLEN,AL
	POP	BX		;GET ADDR
	OR	BX,BX		;SEE IF LAST ENTRY
	JNZ	SHORT ??L000
	JMP	POPTRT
??L000:				;ALL FINISHED IF ZERO
	MOV	MCLPTR,BX	;SET UP POINTER

MCLSCN:	CALL	FETCHR		;GET A CHAR FROM STRING
	JZ	SHORT MCLOOP	;END OF STRING - SEE IF MORE ON STK
	ADD	AL,AL		;PUT CHAR * 2 INTO [C]
	MOV	CL,AL
	MOV	BX,MCLTAB	;POINT TO COMMAND TABLE
MSCNLP:
	INS86	56		;CS OVERRIDE
	MOV	AL,BYTE PTR [BX]	;GET CHAR FROM COMMAND TABLE
	ADD	AL,AL		;CHAR = CHAR * 2 (CLR HI BIT FOR CMP)
GOFCER:	JNZ	SHORT ??L001
	CALL	FCERR		;END OF TABLE.
??L001:
	CMP	AL,CL		;HAVE WE GOT IT?
	JZ	SHORT MISCMD	;YES.
	INC	BX		;MOVE TO NEXT ENTRY
	INC	BX
	INC	BX
	JMP	SHORT MSCNLP

MISCMD:
	MOV	CX,OFFSET MCLSCN	;RETURN TO TOP OF LOOP WHEN DONE
	PUSH	CX
	INS86	56		;CS OVERRIDE
	MOV	AL,BYTE PTR [BX]	;SEE IF A VALUE NEEDED
	MOV	CL,AL		;PASS GOTTEN CHAR IN [C]
	ADD	AL,AL
	JAE	SHORT MNOARG	;COMMAND DOESN'T REQUIRE ARGUMENT
	OR	AL,AL		;CLEAR CARRY
	RCR	AL,1		;MAKE IT A CHAR AGAIN
	MOV	CL,AL		;PUT IN [C]
	PUSH	CX
	PUSH	BX		;SAVE PTR INTO CMD TABLE
	CALL	FETCHR		;GET A CHAR
	MOV	DX,1		;DEFAULT ARG=1
	JNZ	SHORT ??L002
	JMP	VSNAR0		;NO ARG IF END OF STRING
??L002:
	CALL	ISLET2		;SEE IF POSSIBLE LETTER
	JNAE	SHORT ??L003
	JMP	VSNARG
??L003:
	CALL	VALSC3		;GET THE VALUE
	STC			;SET CARRY TO FLAG USING NON-DEFAULT
	JMP	SHORT ISCMD3
VSNARG:	CALL	DECFET		;PUT CHAR BACK INTO STRING
VSNAR0:	OR	AL,AL		;CLEAR CARRY
ISCMD3:	POP	BX
	POP	CX		;GET BACK COMMAND CHAR
MNOARG:	INC	BX		;POINT TO DISPATCH ADDR
	INS86	56		;CS OVERRIDE
	MOV	BX,[BX]		;GET ADDRESS INTO HL
	JMP	BX		;DISPATCH

FETCHZ:	CALL	FETCHR		;GET A CHAR FROM STRING
	JZ	SHORT GOFCER	;GIVE ERROR IF END OF LINE
	RET	

FETCHR:	PUSH	BX
FETCH2:	MOV	BX,OFFSET MCLLEN	;POINT TO STRING LENGTH
	MOV	AL,BYTE PTR [BX]
	OR	AL,AL
	JZ	SHORT POPTRT	;RETURN Z=0 IF END OF STRING
	DEC	BYTE PTR [BX]	;UPDATE COUNT FOR NEXT TIME
	MOV	BX,MCLPTR	;GET PTR TO STRING
	MOV	AL,BYTE PTR [BX]	;GET CHARACTER FROM STRING
	INC	BX		;UPDATE PTR FOR NEXT TIME
	MOV	MCLPTR,BX
	CMP	AL,LOW " "	;SKIP SPACES
	JZ	SHORT FETCH2
	CMP	AL,LOW 96D	;CONVERT LOWER CASE TO UPPER
	JB	SHORT POPTRT
	SUB	AL,LOW 32D	;DO CONVERSION
POPTRT:	POP	BX
	RET	

DECFET:	PUSH	BX
	MOV	BX,OFFSET MCLLEN	;INCREMENT LENGTH
	INC	BYTE PTR [BX]
	MOV	BX,MCLPTR	;BACK UP POINTER
	DEC	BX
	MOV	MCLPTR,BX
	POP	BX
	RET	

VALSCN:	CALL	FETCHZ		;GET FIRST CHAR OF ARGUMENT
VALSC3:	CMP	AL,LOW "="	;NUMERIC?
	JNZ	SHORT ??L004
	JMP	VARGET
??L004:
	CMP	AL,LOW "+"	;PLUS SIGN?
	JZ	SHORT VALSCN	;THEN SKIP IT
	CMP	AL,LOW "-"	;NEGATIVE VALUE?
	JNZ	SHORT VALSC2
	MOV	DX,OFFSET NEGD	;IF SO, NEGATE BEFORE RETURNING
	PUSH	DX
	JMP	SHORT VALSCN	;EAT THE "-"
VALSC2:
	MOV	DX,0		;INITIAL VALUE OF ZERO
NUMLOP:
	CMP	AL,LOW 54O	;COMMA
	JZ	SHORT DECFET	;YES, BACK UP AND RETURN
	CMP	AL,LOW 73O	;SEMICOLON?
	JNZ	SHORT $+3
	RET			;YES, JUST RETURN
	CMP	AL,LOW OFFSET "9"+1	;NOW SEE IF ITS A DIGIT
	JAE	SHORT DECFET	;IF NOT, BACK UP AND RETURN
	CMP	AL,LOW "0"
	JB	SHORT DECFET
	MOV	BX,0		;[HL] is accumulator
	MOV	CH,LOW 10D	;[HL]=[DE]*10
NUML01:	ADD	BX,DX
	JB	SHORT SCNFC	;overflow - JMP Function Call Error
	DEC	CH
	JNZ	SHORT NUML01
	SUB	AL,LOW "0"	;ADD IN THE DIGIT
	MOV	DL,AL
	MOV	DH,LOW 0
	ADD	BX,DX
	JB	SHORT SCNFC	;overflow - JMP Function Call Error
	XCHG	BX,DX		;VALUE SHOULD BE IN [DE]
	CALL	FETCHR		;GET NEXT CHAR
	JNZ	SHORT NUMLOP	;branch if not end of string
	RET	


SCNVAR:
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	VALTYP:WORD
DSEG	ENDS
	EXTRN	RETVAR:NEAR
;Allow VARPTR$(variable) for BASCOM compatibility
;
	MOV	BX,MCLPTR	;Get string pntr
	MOV	AL,BYTE PTR [BX]	;possible VALTYP if string created by VARPTR$
	CMP	AL,LOW 9D	;If .gt. 8 then not VARPTR$ string
	JAE	SHORT SCNVR2	;Brif not VARPTR$ candidate
	MOV	AL,BYTE PTR MCLLEN	;Get str len
	SUB	AL,LOW 3D	;at least 3 bytes if it was created by VARPTR$
	JB	SHORT SCNVR2	;else let SCNVAR generate FCERR for bad var name
	MOV	BYTE PTR MCLLEN,AL	;len -3
	MOV	AL,BYTE PTR [BX]	;assume Byte 1 is Type
	MOV	BYTE PTR VALTYP,AL	;so store in FAC
	INC	BX
	MOV	DL,BYTE PTR [BX]
	INC	BX
	MOV	DH,BYTE PTR [BX]	;[DE] = Var address.
	INC	BX
	MOV	MCLPTR,BX	;New pntr
	JMP	RETVAR		;Go return value in FAC
SCNVR2:
	CALL	FETCHZ		;MAKE SURE FIRST CHAR IS LETTER
	MOV	DX,OFFSET BUF	;PLACE TO COPY NAME FOR PTRGET
	PUSH	DX		;SAVE ADDR OF BUF FOR "ISVAR"
	MOV	CH,LOW 40D	;COPY MAX OF 40 CHARACTERS
	CALL	ISLET2		;MAKE SURE IT'S A LETTER
	JB	SHORT SCNFC	;FC ERROR IF NOT LETTER

SCNVLP:	MOV	DI,DX
	STOSB			;STORE CHAR IN BUF
	INC	DX
	CMP	AL,LOW 73O	;A SEMICOLON?
	JZ	SHORT SCNV2	;YES - END OF VARIABLE NAME
	CALL	FETCHZ		;GET NEXT CHAR
	DEC	CH
	JNZ	SHORT SCNVLP

SCNFC:	CALL	FCERR		;ERROR - VARIABLE TOO LONG
SCNV2:	POP	BX		;GET PTR TO BUF
	JMP	ISVAR		;GO GET ITS VALUE

VARGET:	CALL	SCNVAR		;SCAN & EVALUATE VARIABLE
	CALL	FRCINT		;MAKE IT AN INTEGER
	XCHG	BX,DX		;IN [DE]
	RET	

	EXTRN	GETSTK:NEAR
MCLXEQ:	CALL	SCNVAR		;SCAN VARIABLE NAME
	MOV	AL,BYTE PTR MCLLEN	;SAVE CURRENT STRING POS & LENGTH
	MOV	BX,MCLPTR
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;POP OFF RET ADDR, PUSH MCLPTR
	PUSH	AX
	MOV	CL,LOW 2	;MAKE SURE OF ROOM ON STACK
	CALL	GETSTK
	JMP	MCLNEW

NEGD:
	INS86	367,332		;NEG DX,DX
	RET	

ISLET2:	CMP	AL,LOW "A"
	JB	SHORT ISLETX	;TOO SMALL FOR LETTER
	CMP	AL,LOW OFFSET "Z"+1
	CMC			;SET CARRY IF NOT LETTER
ISLETX:	RET	

CSEG	ENDS
	END