;;; -*- TI-Asm -*-
;;;
;;; Mimas - Assembly language IDE for the TI-83 Plus
;;; 
;;; Copyright (C) 2010 Benjamin Moody
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;; ParseExpr:
;;
;; Parse a string into an expression.  The result is appended to the
;; tempExprBuf.  Note that this routine may throw errors - due to
;; running out of program memory, for instance - and if so, the result
;; may not be a complete expression.  It may still contain symbol
;; references, however, so the caller should always call
;; UnrefExprList, even if an error is thrown.
;;
;; Input:
;; - IX = address of ZT string to parse (must be in RAM)
;; - A = current precedence (0 = allow none, MAX_PRECEDENCE =
;;   allow all)
;;
;; Output:
;; - Expression appended to tempExprBuf
;; - Carry flag set if parsing fails (either an invalid character was
;;   found, or the end of the string was reached and more characters
;;   were expected)
;; - IX = address of next character in string (zero if fully parsed;
;;   first character that cannot be understood otherwise)
;;
;; Destroys:
;; - F, BC, DE, HL
;; - OP1-OP6

ParseExprDefault:
	ld a,MAX_PRECEDENCE
ParseExpr:
	or a
	jr z,ParseUnaryExpr
	call GetTempExprPtr
	push hl
ParseExpr_BinaryLoop:
	 ;; Get a complete arg at the next precedence level (e.g. if
	 ;; we're currently parsing a "sum", read a complete "product"
	 ;; expression)
	 dec a
	 call StackCheck
	 call ParseExpr
	 inc a
	 jr c,ParseExpr_BinaryError
	 push af			; save current precedence
	  ;; check if the next byte of the input is an operator at
	  ;; this precedence level
	  add a,a
	  add a,low(precedenceTable - 2)
	  ld l,a
	  ld h,high(precedenceTable)
	  ld a,(hl)
	  inc l
	  ld b,(hl)		; B = # of operators at this level
	  add a,low(binaryOperatorCharTable)
	  ld l,a
	  ld h,high(binaryOperatorCharTable)
	  call GetNextNonSpaceChar
	  ld c,a
ParseExpr_CheckBinaryLoop:
	  ld a,(hl)
	  cp c
	  jr z,ParseExpr_BinaryFound
	  inc l
	  djnz ParseExpr_CheckBinaryLoop
ParseExpr_BinaryNotFound:
	  ;; binary operator not found -> we're done
	  pop af
	 or a
ParseExpr_BinaryError:
	 pop bc
	ret

ParseExpr_BinaryFound:
	  ld a,l
	  add a,X_BINARY - low(binaryOperatorCharTable)
	  ld b,a
	  pop af
	 push af

	  ;; Check for shift operators (<< and >>)
	  cp PREC_SHIFT
	  jr nz,ParseExpr_NotShift
	  ld a,c
	  cp (ix + 1)
	  jr nz,ParseExpr_BinaryNotFound
	  inc ix
	  jr ParseExpr_BinaryReallyFound

ParseExpr_NotShift:
	  ;; Check for comparison operators (< and >)
	  cp PREC_COMPARE
	  jr nz,ParseExpr_BinaryReallyFound
	  ld a,c
	  cp (ix + 1)
	  jr z,ParseExpr_BinaryNotFound
ParseExpr_BinaryReallyFound:
	  ld a,b		; new operator
	  inc ix
	  pop bc		; current precedence
	 pop de			; DE = start-of-chain pointer
	push de
	 push bc		; save precedence
	  call GetTempExprPtr

	  ;; We found a binary operator; we will append the next arg
	  ;; to this chain.  (Since we want left associativity,
	  ;; meaning "a - b - c" is parsed as "(a - b) - c", the
	  ;; entire chain so far becomes the left arg to the new
	  ;; operator.)

	  ;; DE -> start of chain, HL -> end of chain
	  ;; move chain forward one byte, and insert A at start
	  or a
	  sbc hl,de
	  ld b,h
	  ld c,l
	  add hl,de
	  ld d,h
	  ld e,l
	  dec hl
	  lddr
	  ld (de),a
	  ld hl,tempExprLength
	  inc (hl)
	  call z,Error_ExpressionOverflow
	  pop af
	 jr ParseExpr_BinaryLoop

ParseUnaryExpr:
	call GetNextNonSpaceChar
	SWITCH_BEGIN
	SWITCH_CASE LlParen,     ParseUnaryExpr_Paren
	SWITCH_CASE LlBrack,     ParseUnaryExpr_Bracket
	SWITCH_CASE Lneg,        ParseUnaryExpr_Minus
	SWITCH_CASE '~',         ParseUnaryExpr_Tilde
	SWITCH_CASE '!',         ParseUnaryExpr_Bang
	SWITCH_CASE '$',         ParseUnaryExpr_Dollar
	SWITCH_CASE LnewDollar,  ParseUnaryExpr_Dollar
	SWITCH_CASE '%',	 ParseUnaryExpr_Percent
	SWITCH_CASE '@',	 ParseUnaryExpr_At
	SWITCH_CASE Lapostrophe, ParseUnaryExpr_Apostrophe
	SWITCH_CASE Lquote,      ParseUnaryExpr_Apostrophe
	SWITCH_END
	call IsSymbolStartChar
	jq nc,ParseUnaryExpr_Symbol
	call IsWordChar
	jq nc,ParseUnaryExpr_Number
	push af
ParseUnaryExpr_ParenError:
	 pop af
ParseUnaryExpr_Error:
	xor a
	scf
	ret

;;; ( A )

ParseUnaryExpr_Bracket:
	ld a,LrBrack-1
ParseUnaryExpr_Paren:
	inc a
	push af
	 inc ix
	 ld a,X_PAREN
	 call AppendExprByteA
	 call StackCheck
	 call ParseExprDefault
	 jr c,ParseUnaryExpr_ParenError
	 call GetNextNonSpaceChar
	 pop hl
	or a			; allow missing )/] at end of
				; expression
	ret z
	cp h
	jr nz,ParseUnaryExpr_Error
	inc ix
	xor a
	ret

;;; - A

ParseUnaryExpr_Minus:
	ld a,X_MINUS
	jr ParseUnaryExpr_UnaryOperator

;;; ~ A

ParseUnaryExpr_Tilde:
	ld a,X_COMPLEMENT
	jr ParseUnaryExpr_UnaryOperator

;;; ! A

ParseUnaryExpr_Bang:
	ld a,X_NOT
ParseUnaryExpr_UnaryOperator:
	inc ix
ParseUnaryExpr_UnaryOperator_NoInc:
	call AppendExprByteA
	jr ParseUnaryExpr

;;; $      (current PC)
;;; $$     (current load address)
;;; $XXXX  (hex constant)

ParseUnaryExpr_Dollar:
	inc ix
	ld a,(ix)
	cp '$'
	jr z,ParseUnaryExpr_DollarDollar
	cp LnewDollar
	jr z,ParseUnaryExpr_DollarDollar
	call IsHexDigit
	jr nc,ParseUnaryExpr_Dollar_Hex
	ld a,X_EXECPC
	jr AppendExprByteA

ParseUnaryExpr_DollarDollar:
	inc ix
	ld a,X_LOADPC
	jr AppendExprByteA

ParseUnaryExpr_Dollar_Hex:
	call ParseHexValue
	ld b,X_HEX16
ParseUnaryExpr_NumericConstant:
	ld a,h
	or a
	jr z,ParseUnaryExpr_NumericByte
	ld a,b
ParseUnaryExpr_WordValue:
	ex de,hl
	call AppendExprByteA
	ld a,e
AppendExprBytesAD:
	call AppendExprByteA
AppendExprByteD:
	ld a,d
	jr AppendExprByteA

ParseUnaryExpr_NumericByte:
	ld a,b
	add a,X_BYTE - X_WORD
	cp X_DEC8
	jr nz,ParseUnaryExpr_ByteValue
	ld a,l
	cp 40h
	jr c,ParseUnaryExpr_Dec6Value
	ld a,X_DEC8
ParseUnaryExpr_ByteValue:
	ld d,l
	jr AppendExprBytesAD

ParseUnaryExpr_Dec6Value:
	or X_DEC6
	;; fall through

;; AppendExprByteA:
;;
;; Append a byte to the temporary expression buffer.  An error is
;; thrown if the buffer is full.
;;
;; Input:
;; - A = value to append to buffer
;;
;; Destroys:
;; - AF, HL

AppendExprByteA:
	push bc
	 ld hl,tempExprLength
	 ld c,(hl)
	 inc (hl)
	 ld b,0
	 add hl,bc
	 pop bc
	ld (hl),a
	call z,Error_ExpressionOverflow
	xor a
	ret


;;; %BBBBBBBB  (binary constant)

ParseUnaryExpr_Percent:
	inc ix
	ld a,(ix)
	cp '0'
ParseUnaryExpr_PrefixedNumericError1:
	jq c,ParseUnaryExpr_Error
	cp '1'+1
ParseUnaryExpr_PrefixedNumericError2:
	jq nc,ParseUnaryExpr_Error
	call ParseBinaryValue
	ld b,X_BIN16
	jr ParseUnaryExpr_NumericConstant

;;; @OOO (octal constant)

ParseUnaryExpr_At:
	inc ix
	ld a,(ix)
	cp '0'
	jr c,ParseUnaryExpr_PrefixedNumericError1
	cp '7'+1
	jr nc,ParseUnaryExpr_PrefixedNumericError2
	call ParseOctalValue
	ld b,X_OCT16
	jr ParseUnaryExpr_NumericConstant

;;; 'c' (character constant)

ParseUnaryExpr_Apostrophe:
	ld d,a
	inc ix
	ld a,(ix)
	or a
	jq z,ParseUnaryExpr_Error
	cp d
	jq z,ParseUnaryExpr_Error
	call ParseQuotedChar
	ld a,(ix)
	cp d
	jq nz,ParseUnaryExpr_Error
	inc ix
	ld a,X_CHAR
	jr ParseUnaryExpr_ByteValue

;;; DDDD   (decimal constant)
;;; DXXXh  (hexadecimal constant)
;;; OOOOo  (octal constant)
;;; BBBBb  (binary constant)

ParseUnaryExpr_Number:
	push ix
	 pop hl
ParseUnaryExpr_NumberCheckLoop:
	ld b,a
	inc hl
	ld a,(hl)
	call IsHexDigit
	jr nc,ParseUnaryExpr_NumberCheckLoop
	cp 'H'
	jr z,ParseUnaryExpr_NumberHex
	cp 'O'
	jr z,ParseUnaryExpr_NumberOctal
	ld a,b
	cp 'B'
	jr z,ParseUnaryExpr_NumberBinary
ParseUnaryExpr_NumberDecimal:
	ld a,(ix)
	push hl
	 call ParseDecimalValue
	 ld a,X_DEC16
	 pop bc
ParseUnaryExpr_NumberVerify:
	;; verify that BC == IX
	push af
	 push ix
	  pop de
	 ld a,e
	 cp c
	 jr nz,ParseExp_NumberError
	 ld a,d
	 cp b
	 jr nz,ParseExp_NumberError
	 pop bc
	jq_ ParseUnaryExpr_NumericConstant
ParseExp_NumberError:
	 pop bc
	xor a
	scf
	ret

ParseUnaryExpr_NumberBinary:
	ld a,(ix)
	dec hl
	push hl
	 call ParseBinaryValue
	 ld a,X_BIN16
ParseUnaryExpr_NumberVerifySuffix:
	 inc ix
	 pop bc
	inc bc
	jr ParseUnaryExpr_NumberVerify

ParseUnaryExpr_NumberOctal:
	ld a,(ix)
	push hl
	 call ParseOctalValue
	 ld a,X_OCT16
	 jr ParseUnaryExpr_NumberVerifySuffix

ParseUnaryExpr_NumberHex:
	ld a,(ix)
	push hl
	 call ParseHexValue
	 ld a,X_HEX16
	 jr ParseUnaryExpr_NumberVerifySuffix

;;; Symbols

ParseUnaryExpr_Symbol:
	push ix
	 call ParseSymbol_FirstCharValid
	 pop de
	jq c,ParseUnaryExpr_Error
	cp 4
	jr nc,ParseUnaryExpr_Symbol_Long
	;; check if string matches an operator name
	ld hl,LSBStr
	call CompareWords
	jr z,ParseUnaryExpr_LSB
	ld hl,MSBStr
	call CompareWords
	ld a,X_MSB
	jr z,ParseUnaryExpr_LSB_MSB
	;; check if string matches a register name
	ld hl,PCStr
	call CompareWords
	jr z,ParseUnaryExpr_PC
	ld hl,LPCStr
	call CompareWords
	ld a,X_LOADPC
	jr z,ParseUnaryExpr_PC_LPC
	push ix
	 ld hl,regNameStrings
	 ld bc,regNameStringsDefaultEnd
	 ld ix,SeekCompare_pI8ZStr_pWStr
	 call BSearchS
	 pop ix
	jr z,ParseUnaryExpr_Register
ParseUnaryExpr_Symbol_Long:
	ex de,hl
	call NameToSymbolExpr
	xor a
	ret

ParseUnaryExpr_LSB:
	ld a,X_LSB
ParseUnaryExpr_LSB_MSB:
	jq_ ParseUnaryExpr_UnaryOperator_NoInc

ParseUnaryExpr_Register:
	ld a,(ix)
	cp Lapostrophe
	jr nz,ParseUnaryExpr_Register_NotAF2
	ld a,(hl)
	cp X_REG_AF
	jr nz,ParseUnaryExpr_Register_NotAF2
	inc ix
	ld hl,regNameAF2
ParseUnaryExpr_Register_NotAF2:
	ld d,(hl)
	ld a,X_REGVAL
	jq_ AppendExprBytesAD

ParseUnaryExpr_PC:
	ld a,X_EXECPC
ParseUnaryExpr_PC_LPC:
	jq_ AppendExprByteA

;; GetTempExprPtr:
;;
;; Get the address of the end of the current temporary expression.
;;
;; Output:
;; - HL = end of expression
;;
;; Destroys:
;; - F, BC

GetTempExprPtr:
	ld hl,tempExprLength
	ld c,(hl)
	ld b,0
	add hl,bc
	ret

;; GetNextNonSpaceChar:
;;
;; Skip any number of whitespace characters at the start of a string.
;;
;; Input:
;; - IX = address of string
;;
;; Output:
;; - A = first non-space character in string (might be a zero)
;; - IX = address of first non-space character
;;
;; Destroys:
;; - F

GetNextNonSpaceCharAfter:
	inc ix
GetNextNonSpaceChar:
	ld a,(ix)
	call IsSpaceChar
	jr z,GetNextNonSpaceCharAfter
	ret


;; ParseBinaryValue:
;;
;; Parse a binary number written in ASCII.
;;
;; Input:
;; - IX = address of first character
;;
;; Output:
;; - HL = value
;; - A = next character that is not a binary digit
;; - IX = address of next character that is not a binary digit
;;
;; Destroys:
;; - F

ParseBinaryValue:
	ld hl,0
	jr ParseBinaryValue_Begin
ParseBinaryValue_Loop:
	inc ix
	rra
	adc hl,hl
ParseBinaryValue_Begin:
	ld a,(ix)
	cp '0'
	ret c
	cp '1'+1
	jr c,ParseBinaryValue_Loop
	ret


;; ParseQuotedChar:
;;
;; Parse a (possibly quoted) character constant.
;;
;; Input:
;; - A = first character
;; - IX = address of first character
;;
;; Output:
;; - IX = address of next character
;; - L = parsed character value
;;
;; Destroys:
;; - AF, H

ParseQuotedChar:
	cp Lbackslash
	jr z,ParseQuotedChar_Backslash
ParseQuotedChar_Backslash_NotDigit:
	ld l,a
	inc ix
	ret
ParseQuotedChar_Backslash:
	inc ix
	ld a,(ix)
	ld l,a
	cp 'x'
	jr z,ParseQuotedChar_Backslash_X
	cp 'X'
	jr z,ParseQuotedChar_Backslash_X
	cp '0'
	jr c,ParseQuotedChar_Backslash_NotDigit
	cp '7'+1
	jr nc,ParseQuotedChar_Backslash_NotDigit
	jr ParseOctalValue
ParseQuotedChar_Backslash_X:
	inc ix
	ld a,(ix)
	call IsHexDigit
	ret c
; 	cp '0'
; 	ret c
; 	cp '9'+1
; 	jr c,ParseQuotedChar_Backslash_X_Digit
; 	and ~20h
; 	cp 'A'
; 	ret c
; 	cp 'F'+1
; 	ret nc
; ParseQuotedChar_Backslash_X_Digit:
	;; fall through

;; ParseHexValue:
;;
;; Parse a hexadecimal number written in ASCII.
;;
;; Input:
;; - A = first character (must be between '0' and '9', 'A' and 'F', or
;;   'a' and 'f')
;; - IX = address of first character
;;
;; Output:
;; - HL = value
;; - IX = address of first character that is not a hex digit
;;
;; Destroys:
;; - AF

ParseHexValue:
	ld hl,0
	jr ParseHexValue_Begin
ParseHexValue_Loop:
	add hl,hl
	add hl,hl
	add hl,hl
	add hl,hl
ParseHexValue_Begin:
	inc ix
	cp 40h
	jr c,ParseHexValue_NotAlpha
	add a,9
ParseHexValue_NotAlpha:
	and 0Fh
	or l
	ld l,a
	ld a,(ix)
	call IsHexDigit
	jr nc,ParseHexValue_Loop
; 	cp '0'
; 	ret c
; 	cp '9'+1
; 	jr c,ParseHexValue_Loop
; 	and ~20h
; 	cp 'A'
; 	ret c
; 	cp 'F'+1
; 	jr c,ParseHexValue_Loop
	ret

;; ParseOctalValue:
;;
;; Parse a octal number written in ASCII.
;;
;; Input:
;; - IX = address of first character
;;
;; Output:
;; - HL = value
;; - A = next character that is not an octal digit
;; - IX = address of next character that is not an octal digit
;;
;; Destroys:
;; - F

ParseOctalValue:
	ld hl,0
	jr ParseOctalValue_Begin
ParseOctalValue_Loop:
	add hl,hl
	add hl,hl
	add hl,hl
	inc ix
	and 7
	or l
	ld l,a
ParseOctalValue_Begin:
	ld a,(ix)
	cp '0'
	ret c
	cp '7'+1
	jr c,ParseOctalValue_Loop
	ret

;; ParseDecimalValue:
;;
;; Parse a decimal number written in ASCII.
;;
;; Input:
;; - A = first character (must be between '0' and '9')
;; - IX = address of first character
;;
;; Output:
;; - HL = value
;; - A = next character that is not a decimal digit
;; - IX = address of next character that is not a decimal digit
;;
;; Destroys:
;; - F, BC

ParseDecimalValue:
	ld hl,0
	jr ParseDecimalValue_Begin
ParseDecimalValue_Loop:
	ld b,h
	ld c,l
	add hl,hl
	add hl,hl
	add hl,bc
	add hl,hl
ParseDecimalValue_Begin:
	inc ix
	sub '0'
	add a,l
	ld l,a
	jr nc,ParseDecimalValue_NC
	inc h
ParseDecimalValue_NC:
	ld a,(ix)
	cp '0'
	ret c
	cp '9'+1
	jr c,ParseDecimalValue_Loop
	ret

;; ParseSymbol:
;;
;; Skip up to MAX_SYMBOL_LENGTH valid symbol characters.
;;
;; Input:
;; - A = first character
;; - IX = address of first character
;;
;; Output:
;; - Carry flag set if symbol invalid
;; - A = length of symbol if valid
;; - IX = address of next non-symbol character
;;
;; Destroys:
;; - AF, B

ParseSymbol:
	call IsSymbolStartChar
	ret c
ParseSymbol_FirstCharValid:
	ld b,MAX_SYMBOL_LENGTH + 1
ParseSymbol_Loop:
	dec b
	scf
	ret z
	inc ix
	ld a,(ix)
	call IsWordChar
	jr nc,ParseSymbol_Loop
ParseSymbol_Done:
	ld a,MAX_SYMBOL_LENGTH + 1
	sub b
	ret

;; IsSpaceChar:
;;
;; Test if a given character is a space character (ASCII space or TI
;; small-font wide space.)
;;
;; Input:
;; - A = character
;;
;; Output:
;; - Zero flag set if character is a space
;;
;; Destroys:
;; - F

IsSpaceChar:
	cp ' '
	ret z
	cp SFourSpaces
	ret

;; IsWordChar:
;;
;; Test if a given character is a word-constituent character.  Word
;; constituents are digits (0-9), ASCII letters (A-Z and a-z),
;; underscore, and theta.
;;
;; Input:
;; - A = character
;;
;; Output:
;; - Carry flag clear if A is a word constituent, set otherwise
;;
;; Destroys:
;; - F

IsWordChar:
	cp '0'
	ret c
	cp '9'+1
	ccf
	ret nc
	;; fall through

;; IsSymbolStartChar:
;;
;; Test if a given character is a legal starting character for a
;; symbol.  Symbols are permitted to start with the characters A-Z,
;; a-z, _, theta, and . (note that . is the prefix for local labels
;; and is not classified as a word constituent.)
;;
;; Input:
;; - A = character
;;
;; Output:
;; - Carry flag clear if A is a symbol-starting character, set
;;   otherwise
;;
;; Destroys:
;; - F

IsSymbolStartChar:
	cp 'z'+1
	ccf
	ret c
	cp 'a'
	ret nc
	cp '_'
	ret z
	cp '.'
	ret z
	;; fall through

;; IsFileNameStartChar:
;;
;; Test if a given character is a legal starting character for a user
;; file name.  User file names are permitted to start with the
;; characters A-Z and theta (other starting characters may not work
;; properly with the system menus.)
;;
;; Input:
;; - A = character
;;
;; Output:
;; - Carry flag clear if A is a legal starting character, set
;;   otherwise
;;
;; Destroys:
;; - F

IsFileNameStartChar:
	cp 'A'
	ret c
	cp 'Z'+2
	ccf
	ret

;; IsHexDigit:
;;
;; Test if a given character is a hexadecimal digit (ASCII characters
;; 0-9, A-F, or a-f.)
;;
;; Input:
;; - A = character
;;
;; Output:
;; - Carry flag clear if A is a hex digit, set otherwise
;; - A = uppercase version of digit, if valid
;;
;; Destroys:
;; - AF

IsHexDigit:
	cp '0'
	ret c
	cp '9'+1
	ccf
	ret nc
	and ~20h
	cp 'A'
	ret c
	cp 'F'+1
	ccf
	ret