mirror of
https://github.com/dschmenk/VM02.git
synced 2024-06-07 18:29:28 +00:00
2732 lines
67 KiB
Plaintext
2732 lines
67 KiB
Plaintext
|
;
|
||
|
; Global constants
|
||
|
;
|
||
|
const FALSE = 0
|
||
|
const TRUE = !FALSE
|
||
|
;
|
||
|
; Data and code buffer variables
|
||
|
;
|
||
|
const iobuffer = $0800
|
||
|
const compbuff = $6000
|
||
|
const compbuffsz = $4000
|
||
|
const func_dict = $5000
|
||
|
const fixup_tbl = $4000
|
||
|
const argbuff = $2006
|
||
|
const inbuff = $0200
|
||
|
const instr = $01FF
|
||
|
byte ioref
|
||
|
word filename
|
||
|
;
|
||
|
; REL file tables
|
||
|
;
|
||
|
word datalen, codelen
|
||
|
word fixup = fixup_tbl
|
||
|
word numfuncs = 1
|
||
|
;
|
||
|
; Symbol table variables
|
||
|
;
|
||
|
const idglobal_tblsz = $0800
|
||
|
const idlocal_tblsz = $0200
|
||
|
const idglobal_tbl = $1000
|
||
|
const idlocal_tbl = $1800
|
||
|
const ctag_max = 768
|
||
|
const ctag_value = $1A00
|
||
|
const ctag_flags = $0D00
|
||
|
const idval = 0
|
||
|
const idtype = 2
|
||
|
const idname = 3
|
||
|
const idrecsz = 4
|
||
|
word globals = 0
|
||
|
word datasize = 0
|
||
|
word lastglobal
|
||
|
byte locals = 0
|
||
|
word framesize = 0
|
||
|
word lastlocal
|
||
|
const resolved = 1
|
||
|
const is_ctag = $8000
|
||
|
const mask_ctag = $7FFF
|
||
|
word codetag = -1
|
||
|
;
|
||
|
; Symbol types
|
||
|
;
|
||
|
const EXTERN_SYM = $10
|
||
|
const EXPORT_SYM = $08
|
||
|
;
|
||
|
; Compiler pointers
|
||
|
;
|
||
|
word codeptr
|
||
|
word entrypoint = 0
|
||
|
byte lastop = $FF
|
||
|
byte perr
|
||
|
;
|
||
|
; String variables
|
||
|
;
|
||
|
byte version[] = "PLASMA ][ COMPILER VERSION 0.8 "
|
||
|
byte badfile[] = "FILE NOT FOUND"
|
||
|
;
|
||
|
; Tokens
|
||
|
;
|
||
|
const ID_TKN = $D6 ; V
|
||
|
const CHR_TKN = $C3 ; C
|
||
|
const INT_TKN = $C9 ; I
|
||
|
const STR_TKN = $D3 ; S
|
||
|
const EOL_TKN = $02
|
||
|
const EOF_TKN = $01
|
||
|
const ERR_TKN = $00
|
||
|
;
|
||
|
; Binary operand operators
|
||
|
;
|
||
|
const SET_TKN = $BD ; =
|
||
|
const SETLIST_TKN = $B9 ; =,
|
||
|
const ADD_TKN = $AB ; +
|
||
|
const SUB_TKN = $AD ; -
|
||
|
const MUL_TKN = $AA ; *
|
||
|
const DIV_TKN = $AF ; /
|
||
|
const MOD_TKN = $A5 ; %
|
||
|
const OR_TKN = $BF ; ?
|
||
|
const EOR_TKN = $DE ; ^
|
||
|
const AND_TKN = $A6 ; &
|
||
|
const SHR_TKN = $D2 ; R
|
||
|
const SHL_TKN = $CC ; L
|
||
|
const GT_TKN = $BE ; >
|
||
|
const GE_TKN = $C8 ; H
|
||
|
const LT_TKN = $BC ; <
|
||
|
const LE_TKN = $C2 ; B
|
||
|
const NE_TKN = $D5 ; U
|
||
|
const EQ_TKN = $C5 ; E
|
||
|
const LOGIC_AND_TKN = $CE ; N
|
||
|
const LOGIC_OR_TKN = $CF ; O
|
||
|
;
|
||
|
; Unary operand operators
|
||
|
;
|
||
|
const AT_TKN = $C0 ; @
|
||
|
const DOT_TKN = $AE ; .
|
||
|
const COLON_TKN = $BA ; :
|
||
|
const NEG_TKN = $AD ; -
|
||
|
const COMP_TKN = $A3 ; #
|
||
|
const LOGIC_NOT_TKN = $A1 ; !
|
||
|
const BPTR_TKN = $DE ; ^
|
||
|
const WPTR_TKN = $AA ; *
|
||
|
const INC_TKN = $C1 ; A
|
||
|
const DEC_TKN = $C4 ; D
|
||
|
;
|
||
|
; Enclosure tokens
|
||
|
;
|
||
|
const OPEN_PAREN_TKN = $A8 ; (
|
||
|
const CLOSE_PAREN_TKN = $A9 ; )
|
||
|
const OPEN_BRACKET_TKN = $DB ; [
|
||
|
const CLOSE_BRACKET_TKN = $DD ; ]
|
||
|
;
|
||
|
; Misc. tokens
|
||
|
;
|
||
|
const COMMA_TKN = $AC ; ,
|
||
|
const COMMENT_TKN = $BB ; ;
|
||
|
;
|
||
|
; Keyword tokens
|
||
|
;
|
||
|
const CONST_TKN = $80
|
||
|
const BYTE_TKN = $81
|
||
|
const WORD_TKN = $82
|
||
|
const IF_TKN = $83
|
||
|
const ELSEIF_TKN = $84
|
||
|
const ELSE_TKN = $85
|
||
|
const FIN_TKN = $86
|
||
|
const END_TKN = $87
|
||
|
const WHILE_TKN = $88
|
||
|
const LOOP_TKN = $89
|
||
|
const CASE_TKN = $8A
|
||
|
const OF_TKN = $8B
|
||
|
const DEFAULT_TKN = $8C
|
||
|
const ENDCASE_TKN = $8D
|
||
|
const FOR_TKN = $8E
|
||
|
const TO_TKN = $8F
|
||
|
const DOWNTO_TKN = $90
|
||
|
const STEP_TKN = $91
|
||
|
const NEXT_TKN = $92
|
||
|
const REPEAT_TKN = $93
|
||
|
const UNTIL_TKN = $94
|
||
|
const DEF_TKN = $95
|
||
|
const OPT_TKN = $96
|
||
|
const DROP_TKN = $97
|
||
|
const DONE_TKN = $98
|
||
|
const RETURN_TKN = $99
|
||
|
const BREAK_TKN = $9A
|
||
|
const EVAL_TKN = $9D
|
||
|
const FUNC_TKN = $9E
|
||
|
const EXTERN_TKN = $9F
|
||
|
const ENTRY_TKN = $A0
|
||
|
const IMPORT_TKN = $A1
|
||
|
const INCLUDE_TKN = $A2
|
||
|
;
|
||
|
; Types
|
||
|
;
|
||
|
const CONST_TYPE = $01
|
||
|
const BYTE_TYPE = $02
|
||
|
const WORD_TYPE = $04
|
||
|
const VAR_TYPE = $06 ; (WORD_TYPE | BYTE_TYPE)
|
||
|
const FUNC_TYPE = $08
|
||
|
const FUNC_CONST_TYPE = $09
|
||
|
const ADDR_TYPE = $0E ; (VAR_TYPE | FUNC_TYPE)
|
||
|
const LOCAL_TYPE = $10
|
||
|
const BPTR_TYPE = $20
|
||
|
const WPTR_TYPE = $40
|
||
|
const PTR_TYPE = $60 ; (BPTR_TYPE | WPTR_TYPE)
|
||
|
const XBYTE_TYPE = $22 ; (BPTR_TYPE | BYTE_TYPE)
|
||
|
const XWORD_TYPE = $44 ; (WPTR_TYPE | WORD_TYPE)
|
||
|
const STR_TYPE = $80
|
||
|
;
|
||
|
; Keywords
|
||
|
;
|
||
|
byte keywrds[]
|
||
|
byte = "IF", IF_TKN
|
||
|
byte = "TO", TO_TKN
|
||
|
byte = "IS", OF_TKN
|
||
|
byte = "OR", LOGIC_OR_TKN
|
||
|
byte = "FOR", FOR_TKN
|
||
|
byte = "FIN", FIN_TKN
|
||
|
byte = "DEF", DEF_TKN
|
||
|
byte = "END", END_TKN
|
||
|
byte = "AND", LOGIC_AND_TKN
|
||
|
byte = "NOT", LOGIC_NOT_TKN
|
||
|
byte = "BYTE", BYTE_TKN
|
||
|
byte = "WORD", WORD_TKN
|
||
|
byte = "DROP", DROP_TKN
|
||
|
byte = "ELSE", ELSE_TKN
|
||
|
byte = "NEXT", NEXT_TKN
|
||
|
byte = "WHEN", CASE_TKN
|
||
|
byte = "LOOP", LOOP_TKN
|
||
|
byte = "FUNC", FUNC_TKN
|
||
|
byte = "STEP", STEP_TKN
|
||
|
byte = "DONE", DONE_TKN
|
||
|
byte = "WEND", ENDCASE_TKN
|
||
|
byte = "ENTRY", ENTRY_TKN
|
||
|
byte = "CONST", CONST_TKN
|
||
|
byte = "ELSIF", ELSEIF_TKN
|
||
|
byte = "WHILE", WHILE_TKN
|
||
|
byte = "UNTIL", UNTIL_TKN
|
||
|
byte = "BREAK", BREAK_TKN
|
||
|
byte = "OTHER", DEFAULT_TKN
|
||
|
byte = "DOWNTO", DOWNTO_TKN
|
||
|
byte = "REPEAT", REPEAT_TKN
|
||
|
byte = "RETURN", RETURN_TKN
|
||
|
byte = "EXTERN", EXTERN_TKN
|
||
|
byte = "IMPORT", IMPORT_TKN
|
||
|
byte = "INCLUDE", INCLUDE_TKN
|
||
|
byte = $FF
|
||
|
;
|
||
|
; Mathematical ops
|
||
|
;
|
||
|
const bops_tblsz = 18 ; minus 1
|
||
|
byte bops_tbl[] ; Highest precedence
|
||
|
byte = MUL_TKN, DIV_TKN, MOD_TKN
|
||
|
byte = ADD_TKN, SUB_TKN
|
||
|
byte = SHR_TKN, SHL_TKN
|
||
|
byte = AND_TKN
|
||
|
byte = EOR_TKN
|
||
|
byte = OR_TKN
|
||
|
byte = GT_TKN, GE_TKN, LT_TKN, LE_TKN
|
||
|
byte = EQ_TKN, NE_TKN
|
||
|
byte = LOGIC_AND_TKN
|
||
|
byte = LOGIC_OR_TKN
|
||
|
byte = COMMA_TKN
|
||
|
; Lowest precedence
|
||
|
byte bops_prec[] ; Highest precedence
|
||
|
byte = 1, 1, 1
|
||
|
byte = 2, 2
|
||
|
byte = 3, 3
|
||
|
byte = 4
|
||
|
byte = 5
|
||
|
byte = 6
|
||
|
byte = 7, 7, 7, 7
|
||
|
byte = 8, 8
|
||
|
byte = 9
|
||
|
byte = 10
|
||
|
byte = 11
|
||
|
; Lowest precedence
|
||
|
byte opstack[16]
|
||
|
byte precstack[16]
|
||
|
word opsp = -1
|
||
|
;
|
||
|
; Scanner variables
|
||
|
;
|
||
|
byte token, tknlen
|
||
|
word scanptr, tknptr
|
||
|
word constval
|
||
|
word lineno = 0
|
||
|
;
|
||
|
; Compiler output messages
|
||
|
;
|
||
|
byte dup_id[] = "DUPLICATE IDENTIFIER"
|
||
|
byte undecl_id[] = "UNDECLARED IDENTIFIER"
|
||
|
byte bad_cnst[] = "BAD CONSTANT"
|
||
|
byte bad_offset[] = "BAD STRUCT OFFSET"
|
||
|
byte bad_decl[] = "BAD DECLARATION"
|
||
|
byte bad_op[] = "BAD OPERATION"
|
||
|
byte bad_stmnt[] = "BAD STATMENT"
|
||
|
byte bad_expr[] = "BAD EXPRESSION"
|
||
|
byte bad_syntax[] = "BAD SYNTAX"
|
||
|
byte estk_overflw[] = "EVAL STACK OVERFLOW"
|
||
|
byte estk_underflw[] = "EVAL STACK UNDERFLOW"
|
||
|
byte local_overflw[] = "LOCAL FRAME OVERFLOW"
|
||
|
byte global_sym_overflw[] = "GLOBAL SYMBOL TABLE OVERFLOW"
|
||
|
byte local_sym_overflw[] = "LOCAL SYMBOL TABLE OVERFLOW"
|
||
|
byte ctag_full[] = "CODE LABEL OVERFLOW"
|
||
|
byte no_close_paren[] = "MISSING CLOSING PAREN"
|
||
|
byte no_close_bracket[] = "MISSING CLOSING BRACKET"
|
||
|
byte missing_op[] = "MISSING OPERAND"
|
||
|
byte no_fin[] = "MISSING FIN"
|
||
|
byte no_loop[] = "MISSING LOOP"
|
||
|
byte no_until[] = "MISSING UNTIL"
|
||
|
byte no_done[] = "MISSING DONE"
|
||
|
byte no_local_init[] = "NO INITIALIZED LOCALS"
|
||
|
;
|
||
|
; Runtime functions
|
||
|
;
|
||
|
byte runtime0[] = "romcall"
|
||
|
byte RUNTIME0[] = "ROMCALL"
|
||
|
byte runtime1[] = "syscall"
|
||
|
byte RUNTIME1[] = "SYSCALL"
|
||
|
byte runtime2[] = "memset"
|
||
|
byte RUNTIME2[] = "MEMSET"
|
||
|
byte runtime3[] = "memcpy"
|
||
|
byte RUNTIME3[] = "MEMCPY"
|
||
|
byte runtime4[] = "cout"
|
||
|
byte RUNTIME4[] = "COUT"
|
||
|
byte runtime5[] = "cin"
|
||
|
byte RUNTIME5[] = "CIN"
|
||
|
byte runtime6[] = "prstr"
|
||
|
byte RUNTIME6[] = "PRSTR"
|
||
|
byte runtime7[] = "rdstr"
|
||
|
byte RUNTIME7[] = "RDSTR"
|
||
|
;
|
||
|
; Parser variables
|
||
|
;
|
||
|
byte infunc = 0
|
||
|
byte stack_loop = 0
|
||
|
byte prevstmnt = 0
|
||
|
word retfunc_tag = 0
|
||
|
word break_tag = 0
|
||
|
func parse_expr_01, parse_module_01
|
||
|
;
|
||
|
; Defines for ASM routines
|
||
|
;
|
||
|
asm equates
|
||
|
TMP EQU $F0
|
||
|
TMPL EQU TMP
|
||
|
TMPH EQU TMP+1
|
||
|
SRC EQU TMP
|
||
|
SRCL EQU SRC
|
||
|
SRCH EQU SRC+1
|
||
|
DST EQU SRC+2
|
||
|
DSTL EQU DST
|
||
|
DSTH EQU DST+1
|
||
|
ESP EQU DST+2
|
||
|
SAVEESP EQU ESP+1
|
||
|
SAVESP EQU SAVEESP+1
|
||
|
SAVEFP EQU SAVESP+1
|
||
|
SAVETMR EQU SAVEFP+2
|
||
|
SAVEINT EQU SAVETMR+2
|
||
|
TMRVEC EQU $03E8
|
||
|
INTVEC EQU $03EA
|
||
|
JMPTMP: JMP (TMP)
|
||
|
end
|
||
|
;
|
||
|
; CALL 6502 ROUTINE
|
||
|
; ROMCALL(AREG, XREG, YREG, STATUS, ADDR)
|
||
|
;
|
||
|
asm romcall
|
||
|
PHP
|
||
|
LDA ESTKL,X
|
||
|
STA TMPL
|
||
|
LDA ESTKH,X
|
||
|
STA TMPH
|
||
|
INX
|
||
|
LDA ESTKL,X
|
||
|
PHA
|
||
|
INX
|
||
|
LDA ESTKL,X
|
||
|
TAY
|
||
|
INX
|
||
|
LDA ESTKL+1,X
|
||
|
PHA
|
||
|
LDA ESTKL,X
|
||
|
INX
|
||
|
STX ESP
|
||
|
TAX
|
||
|
PLA
|
||
|
BIT ROMIN
|
||
|
PLP
|
||
|
JSR JMPTMP
|
||
|
PHP
|
||
|
BIT LCBNK2
|
||
|
STA REGVALS+0
|
||
|
STX REGVALS+1
|
||
|
STY REGVALS+2
|
||
|
PLA
|
||
|
STA REGVALS+3
|
||
|
LDX ESP
|
||
|
LDA #<REGVALS
|
||
|
LDY #>REGVALS
|
||
|
STA ESTKL,X
|
||
|
STY ESTKH,X
|
||
|
PLP
|
||
|
RTS
|
||
|
REGVALS: DS 4
|
||
|
end
|
||
|
;
|
||
|
; CALL PRODOS
|
||
|
; SYSCALL(CMD, PARAMS)
|
||
|
;
|
||
|
asm syscall
|
||
|
LDA ESTKL,X
|
||
|
LDY ESTKH,X
|
||
|
STA PARAMS
|
||
|
STY PARAMS+1
|
||
|
INX
|
||
|
LDA ESTKL,X
|
||
|
STA CMD
|
||
|
STX ESP
|
||
|
BIT ROMIN
|
||
|
JSR $BF00
|
||
|
CMD: DB 00
|
||
|
PARAMS: DW 0000
|
||
|
BIT LCBNK2
|
||
|
LDX ESP
|
||
|
STA ESTKL,X
|
||
|
LDY #$00
|
||
|
STY ESTKH,X
|
||
|
end
|
||
|
;
|
||
|
; SET MEMORY TO VALUE
|
||
|
; MEMSET(VALUE, ADDR, SIZE)
|
||
|
;
|
||
|
asm memset
|
||
|
LDY #$00
|
||
|
LDA ESTKL+1,X
|
||
|
STA DSTL
|
||
|
LDA ESTKH+1,X
|
||
|
STA DSTH
|
||
|
INC ESTKL,X
|
||
|
INC ESTKH,X
|
||
|
SETMEM: DEC ESTKL,X
|
||
|
BNE :+
|
||
|
DEC ESTKH,X
|
||
|
BEQ MEMEXIT
|
||
|
: LDA ESTKL+2,X
|
||
|
STA (DST),Y
|
||
|
INY
|
||
|
BNE :+
|
||
|
INC DSTH
|
||
|
: DEC ESTKL,X
|
||
|
BNE :+
|
||
|
DEC ESTKH,X
|
||
|
BEQ MEMEXIT
|
||
|
: LDA ESTKH+2,X
|
||
|
STA (DST),Y
|
||
|
INY
|
||
|
BNE SETMEM
|
||
|
INC DSTH
|
||
|
BNE SETMEM
|
||
|
MEMEXIT: INX
|
||
|
INX
|
||
|
INX
|
||
|
end
|
||
|
;
|
||
|
; COPY MEMORY
|
||
|
; MEMCPY(SRCADDR, DSTADDR, SIZE)
|
||
|
;
|
||
|
asm memcpy
|
||
|
LDY #$00
|
||
|
LDA ESTKL,X
|
||
|
BNE :+
|
||
|
LDA ESTKH,X
|
||
|
BEQ MEMEXIT
|
||
|
: LDA ESTKL+1,X
|
||
|
STA DSTL
|
||
|
LDA ESTKH+1,X
|
||
|
STA DSTH
|
||
|
LDA ESTKL+2,X
|
||
|
STA SRCL
|
||
|
LDA ESTKH+2,X
|
||
|
STA SRCH
|
||
|
CMP DSTH
|
||
|
BCC REVCPY
|
||
|
BNE FORCPY
|
||
|
LDA SRCL
|
||
|
CMP DSTL
|
||
|
BCS FORCPY
|
||
|
REVCPY: ; REVERSE DIRECTION COPY
|
||
|
; CLC
|
||
|
LDA ESTKL,X
|
||
|
ADC DSTL
|
||
|
STA DSTL
|
||
|
LDA ESTKH,X
|
||
|
ADC DSTH
|
||
|
STA DSTH
|
||
|
CLC
|
||
|
LDA ESTKL,X
|
||
|
ADC SRCL
|
||
|
STA SRCL
|
||
|
LDA ESTKH,X
|
||
|
ADC SRCH
|
||
|
STA SRCH
|
||
|
INC ESTKH,X
|
||
|
REVCPYLP:
|
||
|
LDA DSTL
|
||
|
BNE :+
|
||
|
DEC DSTH
|
||
|
: DEC DSTL
|
||
|
LDA SRCL
|
||
|
BNE :+
|
||
|
DEC SRCH
|
||
|
: DEC SRCL
|
||
|
LDA (SRC),Y
|
||
|
STA (DST),Y
|
||
|
DEC ESTKL,X
|
||
|
BNE REVCPYLP
|
||
|
DEC ESTKH,X
|
||
|
BNE REVCPYLP
|
||
|
BEQ MEMEXIT
|
||
|
FORCPY: INC ESTKH,X
|
||
|
FORCPYLP:
|
||
|
LDA (SRC),Y
|
||
|
STA (DST),Y
|
||
|
INC DSTL
|
||
|
BNE :+
|
||
|
INC DSTH
|
||
|
: INC SRCL
|
||
|
BNE :+
|
||
|
INC SRCH
|
||
|
: DEC ESTKL,X
|
||
|
BNE FORCPYLP
|
||
|
DEC ESTKH,X
|
||
|
BNE FORCPYLP
|
||
|
BEQ MEMEXIT
|
||
|
end
|
||
|
;
|
||
|
; CHAR OUT
|
||
|
; COUT(CHAR)
|
||
|
;
|
||
|
asm cout
|
||
|
LDA ESTKL,X
|
||
|
INX
|
||
|
ORA #$80
|
||
|
BIT ROMIN
|
||
|
JSR $FDED
|
||
|
BIT LCBNK2
|
||
|
end
|
||
|
;
|
||
|
; CHAR IN
|
||
|
; RDKEY()
|
||
|
;
|
||
|
asm cin
|
||
|
BIT ROMIN
|
||
|
STX ESP
|
||
|
JSR $FD0C
|
||
|
LDX ESP
|
||
|
BIT LCBNK2
|
||
|
DEX
|
||
|
AND #$7F
|
||
|
STA ESTKL,X
|
||
|
LDY #$00
|
||
|
STY ESTKH,X
|
||
|
end
|
||
|
;
|
||
|
; PRINT STRING
|
||
|
; PRSTR(STR)
|
||
|
;
|
||
|
asm prstr
|
||
|
LDY #$00
|
||
|
LDA ESTKL,X
|
||
|
STA SRCL
|
||
|
LDA ESTKH,X
|
||
|
STA SRCH
|
||
|
BIT ROMIN
|
||
|
LDA (SRC),Y
|
||
|
STA ESTKL,X
|
||
|
BEQ :+
|
||
|
_PRS1: INY
|
||
|
LDA (SRC),Y
|
||
|
ORA #$80
|
||
|
JSR $FDED
|
||
|
TYA
|
||
|
CMP ESTKL,X
|
||
|
BNE _PRS1
|
||
|
: INX
|
||
|
BIT LCBNK2
|
||
|
end
|
||
|
;
|
||
|
; READ STRING
|
||
|
; STR = RDSTR(PROMPTCHAR)
|
||
|
;
|
||
|
asm rdstr
|
||
|
LDA ESTKL,X
|
||
|
STA $33
|
||
|
STX ESP
|
||
|
BIT ROMIN
|
||
|
JSR $FD6A
|
||
|
BIT LCBNK2
|
||
|
STX $01FF
|
||
|
: LDA $01FF,X
|
||
|
AND #$7F
|
||
|
STA $01FF,X
|
||
|
DEX
|
||
|
BPL :-
|
||
|
LDX ESP
|
||
|
LDA #$FF
|
||
|
STA ESTKL,X
|
||
|
LDA #$01
|
||
|
STA ESTKH,X
|
||
|
end
|
||
|
;def toupper_11(c)
|
||
|
; if c >= 'a'
|
||
|
; if c <= 'z'
|
||
|
; return c - $20
|
||
|
; fin
|
||
|
; fin
|
||
|
; return c
|
||
|
;end
|
||
|
asm toupper_11
|
||
|
LDA ESTKL,X
|
||
|
CMP #'a'
|
||
|
BCC :+
|
||
|
CMP #'z'+1
|
||
|
BCS :+
|
||
|
SEC
|
||
|
SBC #$20
|
||
|
STA ESTKL,X
|
||
|
:
|
||
|
end
|
||
|
;
|
||
|
; EXIT
|
||
|
;
|
||
|
asm exit
|
||
|
JSR $BF00
|
||
|
DB $65
|
||
|
DW EXITTBL
|
||
|
EXITTBL:
|
||
|
DB 4
|
||
|
DB 0
|
||
|
end
|
||
|
;
|
||
|
; ProDOS routines
|
||
|
;
|
||
|
def getpfx_11(path)
|
||
|
byte params[3]
|
||
|
|
||
|
^path = 0
|
||
|
params.0 = 1
|
||
|
params:1 = path
|
||
|
perr = syscall($C7, @params)
|
||
|
return path
|
||
|
end
|
||
|
def setpfx_11(path)
|
||
|
byte params[3]
|
||
|
|
||
|
params.0 = 1
|
||
|
params:1 = path
|
||
|
perr = syscall($C6, @params)
|
||
|
return path
|
||
|
end
|
||
|
def open_21(path, buff)
|
||
|
byte params[6]
|
||
|
|
||
|
params.0 = 3
|
||
|
params:1 = path
|
||
|
params:3 = buff
|
||
|
params.5 = 0
|
||
|
perr = syscall($C8, @params)
|
||
|
return params.5
|
||
|
end
|
||
|
def close_11(refnum)
|
||
|
byte params[2]
|
||
|
|
||
|
params.0 = 1
|
||
|
params.1 = refnum
|
||
|
perr = syscall($CC, @params)
|
||
|
return perr
|
||
|
end
|
||
|
def read_31(refnum, buff, len)
|
||
|
byte params[8]
|
||
|
|
||
|
params.0 = 4
|
||
|
params.1 = refnum
|
||
|
params:2 = buff
|
||
|
params:4 = len
|
||
|
params:6 = 0
|
||
|
perr = syscall($CA, @params)
|
||
|
return params:6
|
||
|
end
|
||
|
def write_31(refnum, buff, len)
|
||
|
byte params[8]
|
||
|
|
||
|
params.0 = 4
|
||
|
params.1 = refnum
|
||
|
params:2 = buff
|
||
|
params:4 = len
|
||
|
params:6 = 0
|
||
|
perr = syscall($CB, @params)
|
||
|
return params:6
|
||
|
end
|
||
|
def create_41(path, access, type, aux)
|
||
|
byte params[12]
|
||
|
|
||
|
params.0 = 7
|
||
|
params:1 = path
|
||
|
params.3 = access
|
||
|
params.4 = type
|
||
|
params:5 = aux
|
||
|
params.7 = $1
|
||
|
params:8 = 0
|
||
|
params:10 = 0
|
||
|
perr = syscall($C0, @params)
|
||
|
return perr
|
||
|
end
|
||
|
def destroy_11(path)
|
||
|
byte params[12]
|
||
|
|
||
|
params.0 = 1
|
||
|
params:1 = path
|
||
|
perr = syscall($C1, @params)
|
||
|
return perr
|
||
|
end
|
||
|
def newline_31(refnum, emask, nlchar)
|
||
|
byte params[4]
|
||
|
|
||
|
params.0 = 3
|
||
|
params.1 = refnum
|
||
|
params.2 = emask
|
||
|
params.3 = nlchar
|
||
|
perr = syscall($C9, @params)
|
||
|
return perr
|
||
|
end
|
||
|
def crout
|
||
|
cout($0D)
|
||
|
end
|
||
|
def prbyte_10(h)
|
||
|
cout('$')
|
||
|
drop romcall(h, 0, 0, 0, $FDDA)
|
||
|
end
|
||
|
def prword_10(h)
|
||
|
cout('$')
|
||
|
drop romcall(h >> 8, h, 0, 0, $F941)
|
||
|
end
|
||
|
def print_10(i)
|
||
|
byte numstr[7]
|
||
|
byte place, sign
|
||
|
|
||
|
place = 6
|
||
|
if i < 0
|
||
|
sign = 1
|
||
|
i = -i
|
||
|
else
|
||
|
sign = 0
|
||
|
fin
|
||
|
while i >= 10
|
||
|
i =, numstr[place] = i % 10 + '0'
|
||
|
place = place - 1
|
||
|
loop
|
||
|
numstr[place] = i + '0'
|
||
|
place = place - 1
|
||
|
if sign
|
||
|
numstr[place] = '-'
|
||
|
place = place - 1
|
||
|
fin
|
||
|
numstr[place] = 6 - place
|
||
|
prstr(@numstr[place])
|
||
|
end
|
||
|
def nametostr_30(namestr, len, strptr)
|
||
|
^strptr = len
|
||
|
memcpy(namestr, strptr + 1, len)
|
||
|
end
|
||
|
|
||
|
;=====================================
|
||
|
;
|
||
|
; PLASMA Compiler
|
||
|
;
|
||
|
;=====================================
|
||
|
|
||
|
;
|
||
|
; Error handler
|
||
|
;
|
||
|
def parse_err_11(err)
|
||
|
word i
|
||
|
|
||
|
drop close_11(0)
|
||
|
crout()
|
||
|
print_10(lineno)
|
||
|
cout(':')
|
||
|
prstr(err)
|
||
|
crout()
|
||
|
prstr(instr)
|
||
|
crout()
|
||
|
for i = inbuff to tknptr - 1
|
||
|
cout(' ')
|
||
|
next
|
||
|
cout('^')
|
||
|
cin()
|
||
|
exit()
|
||
|
return ERR_TKN
|
||
|
end
|
||
|
;
|
||
|
; Fixup table and function directory
|
||
|
;
|
||
|
def fixupword_add10(addr)
|
||
|
end
|
||
|
def fixupbyte_add10(addr)
|
||
|
end
|
||
|
def func_add(offset, len, flags)
|
||
|
end
|
||
|
;
|
||
|
; Emit bytecode
|
||
|
;
|
||
|
def ctag_new_01
|
||
|
if codetag >= ctag_max
|
||
|
return parse_err_11(@ctag_full)
|
||
|
fin
|
||
|
codetag = codetag + 1
|
||
|
ctag_value:[codetag] = 0
|
||
|
ctag_flags.[codetag] = 0
|
||
|
return codetag ? is_ctag
|
||
|
end
|
||
|
defopt ctag_resolve_21(tag, addr)
|
||
|
word updtptr, nextptr
|
||
|
|
||
|
tag = tag & mask_ctag
|
||
|
if ctag_flags.[tag] & resolved
|
||
|
return parse_err_11(@dup_id)
|
||
|
fin
|
||
|
updtptr = ctag_value:[tag]
|
||
|
while updtptr
|
||
|
;
|
||
|
; Update list of addresses needing resolution
|
||
|
;
|
||
|
nextptr = *updtptr
|
||
|
*updtptr = addr
|
||
|
updtptr = nextptr
|
||
|
loop
|
||
|
ctag_value:[tag] = addr
|
||
|
ctag_flags.[tag] = ctag_flags.[tag] ? resolved
|
||
|
return 0
|
||
|
end
|
||
|
defopt emit_byte_10(bval)
|
||
|
^codeptr = bval
|
||
|
codeptr = codeptr + 1
|
||
|
end
|
||
|
defopt emit_word_10(wval)
|
||
|
*codeptr = wval
|
||
|
codeptr = codeptr + 2
|
||
|
end
|
||
|
def emit_fill_10(size)
|
||
|
memset(0, codeptr, size)
|
||
|
codeptr = codeptr + size
|
||
|
end
|
||
|
def emit_codetag_10(tag)
|
||
|
drop ctag_resolve_21(tag, codeptr)
|
||
|
end
|
||
|
defopt emit_op_10(op)
|
||
|
lastop = op
|
||
|
^codeptr = op
|
||
|
codeptr = codeptr + 1
|
||
|
end
|
||
|
def emit_tag_10(tag)
|
||
|
word updtptr
|
||
|
|
||
|
if tag & is_ctag
|
||
|
tag = tag & mask_ctag
|
||
|
updtptr = ctag_value:[tag]
|
||
|
if !(ctag_flags.[tag] & resolved)
|
||
|
;
|
||
|
; Add to list of tags needing resolution
|
||
|
;
|
||
|
ctag_value:[tag] = codeptr
|
||
|
fin
|
||
|
emit_word_10(updtptr)
|
||
|
else
|
||
|
emit_word_10(tag + compbuff)
|
||
|
fin
|
||
|
end
|
||
|
def emit_iddata_30(value, size, namestr)
|
||
|
emit_fill_10(size)
|
||
|
end
|
||
|
def emit_data_41(vartype, consttype, constval, constsize)
|
||
|
byte i
|
||
|
word size, chrptr
|
||
|
|
||
|
if consttype == 0
|
||
|
size = constsize
|
||
|
emit_fill_10(constsize)
|
||
|
elsif consttype == STR_TYPE
|
||
|
size = constsize
|
||
|
chrptr = constval
|
||
|
constsize = constsize - 1
|
||
|
emit_byte_10(constsize)
|
||
|
while constsize > 0
|
||
|
emit_byte_10(^chrptr)
|
||
|
chrptr = chrptr + 1
|
||
|
constsize = constsize - 1
|
||
|
loop
|
||
|
else
|
||
|
if vartype == WORD_TYPE
|
||
|
size = 2
|
||
|
emit_word_10(constval)
|
||
|
else
|
||
|
size = 1
|
||
|
emit_byte_10(constval)
|
||
|
fin
|
||
|
fin
|
||
|
return size
|
||
|
end
|
||
|
def emit_const_10(cval)
|
||
|
if cval == 0
|
||
|
emit_op_10($00)
|
||
|
elsif cval > 0 and cval < 256
|
||
|
emit_op_10($2A)
|
||
|
emit_byte_10(cval)
|
||
|
else
|
||
|
emit_op_10($2C)
|
||
|
emit_word_10(cval)
|
||
|
fin
|
||
|
end
|
||
|
def emit_lb
|
||
|
emit_op_10($60)
|
||
|
end
|
||
|
def emit_lw
|
||
|
emit_op_10($62)
|
||
|
end
|
||
|
def emit_llb_10(index)
|
||
|
emit_op_10($64)
|
||
|
emit_byte_10(index)
|
||
|
end
|
||
|
def emit_llw_10(index)
|
||
|
emit_op_10($66)
|
||
|
emit_byte_10(index)
|
||
|
end
|
||
|
def emit_lab_10(tag)
|
||
|
emit_op_10($68)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_law_10(tag)
|
||
|
emit_op_10($6A)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_sb
|
||
|
emit_op_10($70)
|
||
|
end
|
||
|
def emit_sw
|
||
|
emit_op_10($72)
|
||
|
end
|
||
|
def emit_slb_10(index)
|
||
|
emit_op_10($74)
|
||
|
emit_byte_10(index)
|
||
|
end
|
||
|
def emit_slw_10(index)
|
||
|
emit_op_10($76)
|
||
|
emit_byte_10(index)
|
||
|
end
|
||
|
def emit_dlb_10(index)
|
||
|
emit_op_10($6C)
|
||
|
emit_byte_10(index)
|
||
|
end
|
||
|
def emit_dlw_10(index)
|
||
|
emit_op_10($6E)
|
||
|
emit_byte_10(index)
|
||
|
end
|
||
|
def emit_sab_10(tag)
|
||
|
emit_op_10($78)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_saw_10(tag)
|
||
|
emit_op_10($7A)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_dab_10(tag)
|
||
|
emit_op_10($7C)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_daw_10(tag)
|
||
|
emit_op_10($7E)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_call_10(tag)
|
||
|
emit_op_10($54)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_ical
|
||
|
emit_op_10($56)
|
||
|
end
|
||
|
def emit_push
|
||
|
emit_op_10($34)
|
||
|
end
|
||
|
def emit_pull
|
||
|
;
|
||
|
; Skip if last op was push
|
||
|
;
|
||
|
if lastop == $34
|
||
|
codeptr = codeptr - 1
|
||
|
lastop = $FF
|
||
|
else
|
||
|
emit_op_10($36)
|
||
|
fin
|
||
|
end
|
||
|
def emit_localaddr_10(index)
|
||
|
emit_op_10($28)
|
||
|
emit_byte_10(index)
|
||
|
end
|
||
|
def emit_globaladdr_10(tag)
|
||
|
emit_op_10($26)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_indexbyte
|
||
|
emit_op_10($02)
|
||
|
end
|
||
|
def emit_indexword
|
||
|
emit_op_10($1E)
|
||
|
end
|
||
|
defopt emit_unaryop_11(op)
|
||
|
when op
|
||
|
is NEG_TKN
|
||
|
emit_op_10($10)
|
||
|
is COMP_TKN
|
||
|
emit_op_10($12)
|
||
|
is LOGIC_NOT_TKN
|
||
|
emit_op_10($20)
|
||
|
is INC_TKN
|
||
|
emit_op_10($0C)
|
||
|
is DEC_TKN
|
||
|
emit_op_10($0E)
|
||
|
is BPTR_TKN
|
||
|
emit_op_10($60)
|
||
|
is WPTR_TKN
|
||
|
emit_op_10($62)
|
||
|
otherwise
|
||
|
return FALSE
|
||
|
wend
|
||
|
return TRUE
|
||
|
end
|
||
|
defopt emit_binaryop_11(op)
|
||
|
when op
|
||
|
is MUL_TKN
|
||
|
;
|
||
|
; Replace MUL 2 with SHL 1
|
||
|
;
|
||
|
if lastop == $2A and ^(codeptr - 1) == 2 ; CB 2
|
||
|
codeptr = codeptr - 1
|
||
|
emit_byte_10(1) ; CB 1
|
||
|
emit_op_10($1A) ; SHL
|
||
|
else
|
||
|
emit_op_10($06)
|
||
|
fin
|
||
|
is DIV_TKN
|
||
|
;
|
||
|
; Replace DIV 2 with SHR 1
|
||
|
;
|
||
|
if lastop == $2A and ^(codeptr - 1) == 2 ; CB 2
|
||
|
codeptr = codeptr - 1
|
||
|
emit_byte_10(1) ; CB 1
|
||
|
emit_op_10($1C) ; SHR
|
||
|
else
|
||
|
emit_op_10($08)
|
||
|
fin
|
||
|
is MOD_TKN
|
||
|
emit_op_10($0A)
|
||
|
is ADD_TKN
|
||
|
;
|
||
|
; Replace ADD 1 with INCR
|
||
|
;
|
||
|
if lastop == $2A and ^(codeptr - 1) == 1 ; CB 1
|
||
|
codeptr = codeptr - 2
|
||
|
emit_op_10($0C) ; INC_OP
|
||
|
else
|
||
|
emit_op_10($02)
|
||
|
fin
|
||
|
is SUB_TKN
|
||
|
;
|
||
|
; Replace SUB 1 with DECR
|
||
|
;
|
||
|
if lastop == $2A and ^(codeptr - 1) == 1 ; CB 1
|
||
|
codeptr = codeptr - 2
|
||
|
emit_op_10($0E) ; DEC_OP
|
||
|
else
|
||
|
emit_op_10($04)
|
||
|
fin
|
||
|
is SHL_TKN
|
||
|
emit_op_10($1A)
|
||
|
is SHR_TKN
|
||
|
emit_op_10($1C)
|
||
|
is AND_TKN
|
||
|
emit_op_10($14)
|
||
|
is OR_TKN
|
||
|
emit_op_10($16)
|
||
|
is EOR_TKN
|
||
|
emit_op_10($18)
|
||
|
is EQ_TKN
|
||
|
emit_op_10($40)
|
||
|
is NE_TKN
|
||
|
emit_op_10($42)
|
||
|
is GE_TKN
|
||
|
emit_op_10($48)
|
||
|
is LT_TKN
|
||
|
emit_op_10($46)
|
||
|
is GT_TKN
|
||
|
emit_op_10($44)
|
||
|
is LE_TKN
|
||
|
emit_op_10($4A)
|
||
|
is LOGIC_OR_TKN
|
||
|
emit_op_10($22)
|
||
|
is LOGIC_AND_TKN
|
||
|
emit_op_10($24)
|
||
|
is COMMA_TKN
|
||
|
; Do nothing except move to next stanza in expression
|
||
|
otherwise
|
||
|
return FALSE
|
||
|
wend
|
||
|
return TRUE
|
||
|
end
|
||
|
def emit_brtru_10(tag)
|
||
|
emit_op_10($4E)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_brfls_10(tag)
|
||
|
emit_op_10($4C)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_brgt_10(tag)
|
||
|
emit_op_10($3A)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_brlt_10(tag)
|
||
|
emit_op_10($38)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_brne_10(tag)
|
||
|
emit_op_10($3E)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_jump_10(tag)
|
||
|
emit_op_10($50)
|
||
|
emit_tag_10(tag)
|
||
|
end
|
||
|
def emit_drop
|
||
|
emit_op_10($30)
|
||
|
end
|
||
|
def emit_swap
|
||
|
emit_op_10($2E)
|
||
|
end
|
||
|
def emit_leave_10(framesize)
|
||
|
if framesize > 2
|
||
|
emit_op_10($5A)
|
||
|
else
|
||
|
emit_op_10($5C)
|
||
|
fin
|
||
|
end
|
||
|
def emit_enter_20(framesize, cparams)
|
||
|
emit_byte_10($20)
|
||
|
emit_byte_10($D0)
|
||
|
emit_byte_10($03)
|
||
|
if framesize > 2
|
||
|
emit_op_10($58)
|
||
|
emit_byte_10(framesize)
|
||
|
emit_byte_10(cparams)
|
||
|
fin
|
||
|
end
|
||
|
def emit_start
|
||
|
;
|
||
|
; Save address
|
||
|
;
|
||
|
entrypoint = codeptr
|
||
|
emit_byte_10(emit_start.[0])
|
||
|
emit_byte_10(emit_start.[1])
|
||
|
emit_byte_10(emit_start.[2])
|
||
|
end
|
||
|
;
|
||
|
; Lexical anaylzer
|
||
|
;
|
||
|
;def isalpha_11(c)
|
||
|
; if c >= 'A' and c <= 'Z'
|
||
|
; return TRUE
|
||
|
; elsif c >= 'a' and c <= 'z'
|
||
|
; return TRUE
|
||
|
; elsif c == '_'
|
||
|
; return TRUE
|
||
|
; fin
|
||
|
; return FALSE
|
||
|
;end
|
||
|
asm isalpha_11
|
||
|
LDY #$00
|
||
|
LDA ESTKL,X
|
||
|
CMP #'A'
|
||
|
BCC ISALRET
|
||
|
CMP #'Z'+1
|
||
|
BCS :+
|
||
|
DEY
|
||
|
BNE ISALRET
|
||
|
: CMP #'a'
|
||
|
BCC ISALRET
|
||
|
CMP #'z'+1
|
||
|
BCS :+
|
||
|
DEY
|
||
|
BNE ISALRET
|
||
|
: CMP #'_'
|
||
|
BNE ISALRET
|
||
|
DEY
|
||
|
ISALRET:
|
||
|
STY ESTKL,X
|
||
|
STY ESTKH,X
|
||
|
RTS
|
||
|
end
|
||
|
;def isnum_11(c)
|
||
|
; if c >= '0' and c <= '9'
|
||
|
; return TRUE
|
||
|
; fin
|
||
|
; return FALSE
|
||
|
;end
|
||
|
asm isnum_11
|
||
|
LDY #$00
|
||
|
LDA ESTKL,X
|
||
|
CMP #'0'
|
||
|
BCC :+
|
||
|
CMP #'9'+1
|
||
|
BCS :+
|
||
|
DEY
|
||
|
: STY ESTKL,X
|
||
|
STY ESTKH,X
|
||
|
RTS
|
||
|
end
|
||
|
;def isalphanum_11(c)
|
||
|
; if c >= 'A' and c <= 'Z'
|
||
|
; return TRUE
|
||
|
; elsif c >= '0' and c <= '9'
|
||
|
; return TRUE
|
||
|
; elsif c >= 'a' and c <= 'z'
|
||
|
; return TRUE
|
||
|
; elsif c == '_'
|
||
|
; return TRUE
|
||
|
; fin
|
||
|
; return FALSE
|
||
|
;end
|
||
|
asm isalphanum_11
|
||
|
LDY #$00
|
||
|
LDA ESTKL,X
|
||
|
CMP #'0'
|
||
|
BCC ISANRET
|
||
|
CMP #'9'+1
|
||
|
BCS :+
|
||
|
DEY
|
||
|
BNE ISANRET
|
||
|
: CMP #'A'
|
||
|
BCC ISANRET
|
||
|
CMP #'Z'+1
|
||
|
BCS :+
|
||
|
DEY
|
||
|
BNE ISANRET
|
||
|
: CMP #'a'
|
||
|
BCC :+
|
||
|
CMP #'z'+1
|
||
|
BCS ISANRET
|
||
|
DEY
|
||
|
BNE ISANRET
|
||
|
: CMP #'_'
|
||
|
BNE ISANRET
|
||
|
DEY
|
||
|
ISANRET:
|
||
|
STY ESTKL,X
|
||
|
STY ESTKH,X
|
||
|
RTS
|
||
|
end
|
||
|
defopt keymatch_21(chrptr, len)
|
||
|
byte i, keypos
|
||
|
|
||
|
keypos = 0
|
||
|
while keywrds[keypos] < len
|
||
|
keypos = keypos + keywrds[keypos] + 2
|
||
|
loop
|
||
|
while keywrds[keypos] == len
|
||
|
for i = 1 to len
|
||
|
if toupper_11((chrptr).[i - 1]) <> keywrds[keypos + i]
|
||
|
break
|
||
|
fin
|
||
|
next
|
||
|
if i > len
|
||
|
return keywrds[keypos + keywrds[keypos] + 1]
|
||
|
fin
|
||
|
keypos = keypos + keywrds[keypos] + 2
|
||
|
loop
|
||
|
return ID_TKN
|
||
|
end
|
||
|
defopt scan_01
|
||
|
;
|
||
|
; Scan for token based on first character
|
||
|
;
|
||
|
while ^scanptr and ^scanptr <= ' '
|
||
|
scanptr = scanptr + 1
|
||
|
loop
|
||
|
tknptr = scanptr
|
||
|
if !^scanptr or ^scanptr == ';'
|
||
|
if token <> EOF_TKN
|
||
|
token = EOL_TKN
|
||
|
fin
|
||
|
elsif isalpha_11(^scanptr)
|
||
|
;
|
||
|
; ID, either variable name or reserved word
|
||
|
;
|
||
|
repeat
|
||
|
scanptr = scanptr + 1
|
||
|
until !isalphanum_11(^scanptr)
|
||
|
tknlen = scanptr - tknptr;
|
||
|
token = keymatch_21(tknptr, tknlen)
|
||
|
elsif isnum_11(^scanptr)
|
||
|
;
|
||
|
; Number constant
|
||
|
;
|
||
|
token = INT_TKN
|
||
|
constval = 0
|
||
|
repeat
|
||
|
constval = constval * 10 + ^scanptr - '0'
|
||
|
scanptr = scanptr + 1
|
||
|
until !isnum_11(^scanptr)
|
||
|
elsif ^scanptr == '$'
|
||
|
;
|
||
|
; Hexadecimal constant
|
||
|
;
|
||
|
token = INT_TKN;
|
||
|
constval = 0
|
||
|
repeat
|
||
|
scanptr = scanptr + 1
|
||
|
if ^scanptr >= '0' and ^scanptr <= '9'
|
||
|
constval = (constval << 4) + ^scanptr - '0'
|
||
|
elsif ^scanptr >= 'A' and ^scanptr <= 'F'
|
||
|
constval = (constval << 4) + ^scanptr - '7'; 'A'-10
|
||
|
elsif ^scanptr >= 'a' and ^scanptr <= 'f'
|
||
|
constval = (constval << 4) + ^scanptr - 'W'; 'a'-10
|
||
|
else
|
||
|
break;
|
||
|
fin
|
||
|
until !^scanptr
|
||
|
elsif ^scanptr == $27 ; '
|
||
|
;
|
||
|
; Character constant
|
||
|
;
|
||
|
token = CHR_TKN
|
||
|
if ^(scanptr + 1) <> $5C ; \
|
||
|
constval = ^(scanptr + 1)
|
||
|
if ^(scanptr + 2) <> $27 ; '
|
||
|
return parse_err_11(@bad_cnst)
|
||
|
fin
|
||
|
scanptr = scanptr + 3
|
||
|
else
|
||
|
when ^(scanptr + 2)
|
||
|
is 'n'
|
||
|
constval = $0D
|
||
|
is 'r'
|
||
|
constval = $0A
|
||
|
is 't'
|
||
|
constval = $09
|
||
|
otherwise
|
||
|
constval = ^(scanptr + 2)
|
||
|
wend
|
||
|
if ^(scanptr + 3) <> $27 ; '
|
||
|
return parse_err_11(@bad_cnst)
|
||
|
fin
|
||
|
scanptr = scanptr + 4
|
||
|
fin
|
||
|
elsif ^scanptr == '"'
|
||
|
;
|
||
|
; String constant
|
||
|
;
|
||
|
token = STR_TKN
|
||
|
scanptr = scanptr + 1
|
||
|
constval = scanptr
|
||
|
while ^scanptr and ^scanptr <> '"'
|
||
|
scanptr = scanptr + 1
|
||
|
loop
|
||
|
if !^scanptr
|
||
|
return parse_err_11(@bad_cnst)
|
||
|
fin
|
||
|
scanptr = scanptr + 1
|
||
|
else
|
||
|
;
|
||
|
; Potential two and three character tokens
|
||
|
;
|
||
|
when ^scanptr
|
||
|
is '>'
|
||
|
if ^(scanptr + 1) == '>'
|
||
|
token = SHR_TKN
|
||
|
scanptr = scanptr + 2
|
||
|
elsif ^(scanptr + 1) == '='
|
||
|
token = GE_TKN
|
||
|
scanptr = scanptr + 2
|
||
|
else
|
||
|
token = GT_TKN
|
||
|
scanptr = scanptr + 1
|
||
|
fin
|
||
|
is '<'
|
||
|
if ^(scanptr + 1) == '<'
|
||
|
token = SHL_TKN
|
||
|
scanptr = scanptr + 2
|
||
|
elsif ^(scanptr + 1) == '='
|
||
|
token = LE_TKN
|
||
|
scanptr = scanptr + 2
|
||
|
elsif ^(scanptr + 1) == '>'
|
||
|
token = NE_TKN
|
||
|
scanptr = scanptr + 2
|
||
|
else
|
||
|
token = LT_TKN
|
||
|
scanptr = scanptr + 1
|
||
|
fin
|
||
|
is '='
|
||
|
if ^(scanptr + 1) == '='
|
||
|
token = EQ_TKN
|
||
|
scanptr = scanptr + 2;
|
||
|
elsif ^(scanptr + 1) == ','
|
||
|
token = SETLIST_TKN
|
||
|
scanptr = scanptr + 2;
|
||
|
else
|
||
|
token = SET_TKN;
|
||
|
scanptr = scanptr + 1
|
||
|
fin
|
||
|
otherwise
|
||
|
;
|
||
|
; Simple single character tokens
|
||
|
;
|
||
|
token = ^scanptr ? $80
|
||
|
scanptr = scanptr + 1
|
||
|
wend
|
||
|
fin
|
||
|
tknlen = scanptr - tknptr
|
||
|
return token
|
||
|
end
|
||
|
def rewind_10(ptr)
|
||
|
scanptr = ptr
|
||
|
end
|
||
|
;
|
||
|
; Get next line of input
|
||
|
;
|
||
|
def nextln_01
|
||
|
byte i, chr
|
||
|
|
||
|
scanptr = inbuff
|
||
|
^instr = read_31(ioref, inbuff, $7F)
|
||
|
inbuff[^instr] = $00
|
||
|
if ^instr
|
||
|
lineno = lineno + 1
|
||
|
if !(lineno & $0F)
|
||
|
cout('.')
|
||
|
fin
|
||
|
; cout('>')
|
||
|
; prstr(instr)
|
||
|
; crout
|
||
|
drop scan_01()
|
||
|
else
|
||
|
^instr = 0
|
||
|
^inbuff = $00
|
||
|
token = DONE_TKN
|
||
|
fin
|
||
|
return ^instr
|
||
|
end
|
||
|
;
|
||
|
; Alebraic op to stack op
|
||
|
;
|
||
|
def push_op_21(op, prec)
|
||
|
opsp = opsp + 1
|
||
|
if opsp == 16
|
||
|
return parse_err_11(@estk_overflw)
|
||
|
fin
|
||
|
opstack[opsp] = op
|
||
|
precstack[opsp] = prec
|
||
|
return 0
|
||
|
end
|
||
|
def pop_op_01
|
||
|
if opsp < 0
|
||
|
return parse_err_11(@estk_underflw)
|
||
|
fin
|
||
|
opsp = opsp - 1
|
||
|
return opstack[opsp + 1]
|
||
|
end
|
||
|
def tos_op_01
|
||
|
if opsp < 0
|
||
|
return 0
|
||
|
fin
|
||
|
return opstack[opsp]
|
||
|
end
|
||
|
def tos_op_prec_11(tos)
|
||
|
if opsp <= tos
|
||
|
return 100
|
||
|
fin
|
||
|
return precstack[opsp]
|
||
|
end
|
||
|
;
|
||
|
; Symbol table
|
||
|
;
|
||
|
defopt idmatch_41(nameptr, len, idptr, idcnt)
|
||
|
byte i
|
||
|
|
||
|
while idcnt
|
||
|
if len == (idptr).idname
|
||
|
for i = 1 to len
|
||
|
if (nameptr).[i - 1] <> (idptr).idname.[i]
|
||
|
break
|
||
|
fin
|
||
|
next
|
||
|
if i > len
|
||
|
return idptr
|
||
|
fin
|
||
|
fin
|
||
|
idptr = idptr + (idptr).idname + idrecsz
|
||
|
idcnt = idcnt - 1
|
||
|
loop
|
||
|
return 0
|
||
|
end
|
||
|
;def dumpsym_20(idptr, idcnt)
|
||
|
; while idcnt
|
||
|
; prword_10((idptr):idval)
|
||
|
; cout(' ')
|
||
|
; prbyte_10((idptr).idtype)
|
||
|
; cout(' ')
|
||
|
; prstr(@(idptr).idname)
|
||
|
; cout('=')
|
||
|
; if (idptr).idtype & ADDR_TYPE
|
||
|
; if (idptr):idval & is_ctag
|
||
|
; prword_10(ctag_value:[(idptr):idval & mask_ctag])
|
||
|
; else
|
||
|
; prword_10((idptr):idval + compbuff)
|
||
|
; fin
|
||
|
; else
|
||
|
; prword_10((idptr):idval)
|
||
|
; fin
|
||
|
; crout()
|
||
|
; idptr = idptr + (idptr).idname + idrecsz
|
||
|
; idcnt = idcnt - 1
|
||
|
; loop
|
||
|
;end
|
||
|
def id_lookup_21(nameptr, len)
|
||
|
word idptr
|
||
|
|
||
|
idptr = idmatch_41(nameptr, len, idlocal_tbl, locals)
|
||
|
if idptr
|
||
|
return idptr
|
||
|
fin
|
||
|
idptr = idmatch_41(nameptr, len, idglobal_tbl, globals)
|
||
|
if idptr
|
||
|
return idptr
|
||
|
fin
|
||
|
return parse_err_11(@undecl_id)
|
||
|
end
|
||
|
def idglobal_lookup_21(nameptr, len)
|
||
|
return idmatch_41(nameptr, len, idglobal_tbl, globals)
|
||
|
end
|
||
|
def idlocal_add_41(namestr, len, type, size)
|
||
|
if idmatch_41(namestr, len, @idlocal_tbl, locals)
|
||
|
return parse_err_11(@dup_id)
|
||
|
fin
|
||
|
(lastlocal):idval = framesize
|
||
|
(lastlocal).idtype = type ? LOCAL_TYPE
|
||
|
nametostr_30(namestr, len, lastlocal + idname)
|
||
|
locals = locals + 1
|
||
|
lastlocal = lastlocal + idrecsz + len
|
||
|
if lastlocal > idlocal_tbl + idlocal_tblsz
|
||
|
prstr(@local_sym_overflw)
|
||
|
exit
|
||
|
fin
|
||
|
framesize = framesize + size
|
||
|
if framesize > 255
|
||
|
prstr(@local_overflw)
|
||
|
return FALSE
|
||
|
fin
|
||
|
return TRUE
|
||
|
end
|
||
|
def iddata_add_41(namestr, len, type, size)
|
||
|
if idmatch_41(namestr, len, idglobal_tbl, globals)
|
||
|
return parse_err_11(@dup_id)
|
||
|
fin
|
||
|
(lastglobal):idval = datasize
|
||
|
(lastglobal).idtype = type
|
||
|
nametostr_30(namestr, len, lastglobal + idname)
|
||
|
emit_iddata_30(datasize, size, lastglobal + idname)
|
||
|
globals = globals + 1
|
||
|
lastglobal = lastglobal + idrecsz + len
|
||
|
if lastglobal > idglobal_tbl + idglobal_tblsz
|
||
|
prstr(@global_sym_overflw)
|
||
|
exit
|
||
|
fin
|
||
|
datasize = datasize + size
|
||
|
return TRUE
|
||
|
end
|
||
|
def iddata_size_30(type, varsize, initsize)
|
||
|
if varsize > initsize
|
||
|
datasize = datasize + emit_data_41(0, 0, 0, varsize - initsize)
|
||
|
else
|
||
|
datasize = datasize + initsize
|
||
|
fin
|
||
|
; if datasize <> codeptr - compbuff
|
||
|
; prstr(@emiterr)
|
||
|
; keyin_01()
|
||
|
; fin
|
||
|
end
|
||
|
def idglobal_add_41(namestr, len, type, value)
|
||
|
if idmatch_41(namestr, len, idglobal_tbl, globals)
|
||
|
return parse_err_11(@dup_id)
|
||
|
fin
|
||
|
(lastglobal):idval = value
|
||
|
(lastglobal).idtype = type
|
||
|
nametostr_30(namestr, len, lastglobal + idname)
|
||
|
globals = globals + 1
|
||
|
lastglobal = lastglobal + idrecsz + len
|
||
|
if lastglobal > idglobal_tbl + idglobal_tblsz
|
||
|
prstr(@global_sym_overflw)
|
||
|
exit
|
||
|
fin
|
||
|
return TRUE
|
||
|
end
|
||
|
def idfunc_add_31(namestr, len, tag)
|
||
|
return idglobal_add_41(namestr, len, FUNC_TYPE, tag)
|
||
|
end
|
||
|
def idconst_add_31(namestr, len, value)
|
||
|
return idglobal_add_41(namestr, len, CONST_TYPE, value)
|
||
|
end
|
||
|
def idglobal_init
|
||
|
word ctag
|
||
|
|
||
|
lineno = 0
|
||
|
codeptr = compbuff
|
||
|
lastop = $FF
|
||
|
entrypoint = 0
|
||
|
datasize = 0
|
||
|
globals = 0
|
||
|
lastglobal = idglobal_tbl
|
||
|
codetag = -1
|
||
|
ctag = ctag_new_01()
|
||
|
drop idfunc_add_31(@runtime0 + 1, runtime0, ctag)
|
||
|
drop idfunc_add_31(@RUNTIME0 + 1, RUNTIME0, ctag)
|
||
|
drop ctag_resolve_21(ctag, @romcall)
|
||
|
ctag = ctag_new_01()
|
||
|
drop idfunc_add_31(@runtime1 + 1, runtime1, ctag)
|
||
|
drop idfunc_add_31(@RUNTIME1 + 1, RUNTIME1, ctag)
|
||
|
drop ctag_resolve_21(ctag, @syscall)
|
||
|
ctag = ctag_new_01()
|
||
|
drop idfunc_add_31(@runtime2 + 1, runtime2, ctag)
|
||
|
drop idfunc_add_31(@RUNTIME2 + 1, RUNTIME2, ctag)
|
||
|
drop ctag_resolve_21(ctag, @memset)
|
||
|
ctag = ctag_new_01()
|
||
|
drop idfunc_add_31(@runtime3 + 1, runtime3, ctag)
|
||
|
drop idfunc_add_31(@RUNTIME3 + 1, RUNTIME3, ctag)
|
||
|
drop ctag_resolve_21(ctag, @memcpy)
|
||
|
ctag = ctag_new_01()
|
||
|
drop idfunc_add_31(@runtime4 + 1, runtime4, ctag)
|
||
|
drop idfunc_add_31(@RUNTIME4 + 1, RUNTIME4, ctag)
|
||
|
drop ctag_resolve_21(ctag, @cout)
|
||
|
ctag = ctag_new_01()
|
||
|
drop idfunc_add_31(@runtime5 + 1, runtime5, ctag)
|
||
|
drop idfunc_add_31(@RUNTIME5 + 1, RUNTIME5, ctag)
|
||
|
drop ctag_resolve_21(ctag, @cin)
|
||
|
ctag = ctag_new_01()
|
||
|
drop idfunc_add_31(@runtime6 + 1, runtime6, ctag)
|
||
|
drop idfunc_add_31(@RUNTIME6 + 1, RUNTIME6, ctag)
|
||
|
drop ctag_resolve_21(ctag, @prstr)
|
||
|
ctag = ctag_new_01()
|
||
|
drop idfunc_add_31(@runtime7 + 1, runtime7, ctag)
|
||
|
drop idfunc_add_31(@RUNTIME7 + 1, RUNTIME7, ctag)
|
||
|
drop ctag_resolve_21(ctag, @rdstr)
|
||
|
end
|
||
|
def idlocal_init
|
||
|
locals = 0
|
||
|
framesize = 2
|
||
|
lastlocal = idlocal_tbl
|
||
|
end
|
||
|
;
|
||
|
; Parser
|
||
|
;
|
||
|
def parse_term_01
|
||
|
when scan_01()
|
||
|
is ID_TKN
|
||
|
return TRUE
|
||
|
is INT_TKN
|
||
|
return TRUE
|
||
|
is CHR_TKN
|
||
|
return TRUE
|
||
|
is STR_TKN
|
||
|
return TRUE
|
||
|
is OPEN_PAREN_TKN
|
||
|
if !parse_expr_01()
|
||
|
return FALSE
|
||
|
fin
|
||
|
if token <> CLOSE_PAREN_TKN
|
||
|
return parse_err_11(@no_close_paren)
|
||
|
fin
|
||
|
return TRUE
|
||
|
wend
|
||
|
return FALSE
|
||
|
end
|
||
|
def parse_constval_21(valptr, sizeptr)
|
||
|
byte mod, type
|
||
|
word idptr
|
||
|
|
||
|
mod = 0
|
||
|
type = 0
|
||
|
*valptr = 0
|
||
|
while !parse_term_01()
|
||
|
when token
|
||
|
is SUB_TKN
|
||
|
mod = mod ? 1
|
||
|
is COMP_TKN
|
||
|
mod = mod ? 2
|
||
|
is LOGIC_NOT_TKN
|
||
|
mod = mod ? 4
|
||
|
is AT_TKN
|
||
|
mod = mod ? 8
|
||
|
otherwise
|
||
|
return 0
|
||
|
wend
|
||
|
loop
|
||
|
when token
|
||
|
is STR_TKN
|
||
|
*valptr = constval
|
||
|
^sizeptr = tknlen - 1
|
||
|
type = STR_TYPE
|
||
|
if mod
|
||
|
return parse_err_11(@bad_op)
|
||
|
fin
|
||
|
is CHR_TKN
|
||
|
*valptr = constval
|
||
|
^sizeptr = 1
|
||
|
type = BYTE_TYPE
|
||
|
is INT_TKN
|
||
|
*valptr = constval
|
||
|
^sizeptr = 2
|
||
|
type = WORD_TYPE
|
||
|
is ID_TKN
|
||
|
^sizeptr = 2
|
||
|
idptr = id_lookup_21(tknptr, tknlen)
|
||
|
if !idptr
|
||
|
return parse_err_11(@bad_cnst)
|
||
|
fin
|
||
|
type = (idptr).idtype
|
||
|
*valptr = (idptr):idval
|
||
|
if type & VAR_TYPE and !(mod & 8)
|
||
|
return parse_err_11(@bad_cnst)
|
||
|
fin
|
||
|
otherwise
|
||
|
return parse_err_11(@bad_cnst)
|
||
|
wend
|
||
|
if mod & 1
|
||
|
*valptr = -*valptr
|
||
|
fin
|
||
|
if mod & 2
|
||
|
*valptr = #*valptr
|
||
|
fin
|
||
|
if mod & 4
|
||
|
*valptr = !*valptr
|
||
|
fin
|
||
|
return type
|
||
|
end
|
||
|
def ispostop_01
|
||
|
when token
|
||
|
is OPEN_PAREN_TKN
|
||
|
return TRUE
|
||
|
is OPEN_BRACKET_TKN
|
||
|
return TRUE
|
||
|
is DOT_TKN
|
||
|
return TRUE
|
||
|
is COLON_TKN
|
||
|
return TRUE
|
||
|
wend
|
||
|
return FALSE
|
||
|
end
|
||
|
def parse_value_11(rvalue)
|
||
|
byte cparams, deref, type, emit_val
|
||
|
word optos, idptr, value
|
||
|
byte elem_type, elem_size
|
||
|
word elem_offset
|
||
|
|
||
|
deref = rvalue
|
||
|
optos = opsp
|
||
|
type = 0
|
||
|
emit_val = 0
|
||
|
value = 0
|
||
|
|
||
|
;
|
||
|
; Parse pre-ops
|
||
|
;
|
||
|
while !parse_term_01()
|
||
|
when token
|
||
|
is ADD_TKN
|
||
|
is BPTR_TKN
|
||
|
if deref
|
||
|
drop push_op_21(token, 0)
|
||
|
else
|
||
|
type = type ? BPTR_TYPE
|
||
|
deref = deref + 1
|
||
|
fin
|
||
|
is WPTR_TKN
|
||
|
if deref
|
||
|
drop push_op_21(token, 0)
|
||
|
else
|
||
|
type = type ? WPTR_TYPE
|
||
|
deref = deref + 1
|
||
|
fin
|
||
|
is AT_TKN
|
||
|
deref = deref - 1
|
||
|
is SUB_TKN
|
||
|
drop push_op_21(token, 0)
|
||
|
is COMP_TKN
|
||
|
drop push_op_21(token, 0)
|
||
|
is LOGIC_NOT_TKN
|
||
|
drop push_op_21(token, 0)
|
||
|
otherwise
|
||
|
return 0
|
||
|
wend
|
||
|
loop
|
||
|
;
|
||
|
; Determine terminal type
|
||
|
;
|
||
|
when token
|
||
|
is INT_TKN
|
||
|
type = type ? CONST_TYPE
|
||
|
value = constval
|
||
|
is CHR_TKN
|
||
|
type = type ? CONST_TYPE
|
||
|
value = constval
|
||
|
is ID_TKN
|
||
|
idptr = id_lookup_21(tknptr, tknlen)
|
||
|
if !idptr
|
||
|
return 0
|
||
|
fin
|
||
|
if !(idptr).idtype
|
||
|
return 0
|
||
|
fin
|
||
|
type = type ? (idptr).idtype
|
||
|
value = (idptr):idval
|
||
|
is CLOSE_PAREN_TKN
|
||
|
type = type ? WORD_TYPE
|
||
|
emit_val = 1
|
||
|
otherwise
|
||
|
return 0
|
||
|
wend
|
||
|
;
|
||
|
; Constant optimizations
|
||
|
;
|
||
|
if type & CONST_TYPE
|
||
|
cparams = TRUE
|
||
|
while optos < opsp and cparams
|
||
|
when tos_op_01()
|
||
|
is NEG_TKN
|
||
|
drop pop_op_01()
|
||
|
value = -value
|
||
|
is COMP_TKN
|
||
|
drop pop_op_01()
|
||
|
value = #value
|
||
|
is LOGIC_NOT_TKN
|
||
|
drop pop_op_01()
|
||
|
value = !value
|
||
|
otherwise
|
||
|
cparams = FALSE
|
||
|
wend
|
||
|
loop
|
||
|
fin
|
||
|
;
|
||
|
; Parse post-ops
|
||
|
;
|
||
|
drop scan_01()
|
||
|
while ispostop_01()
|
||
|
if token == OPEN_BRACKET_TKN
|
||
|
;
|
||
|
; Array
|
||
|
;
|
||
|
if !emit_val
|
||
|
if type & ADDR_TYPE
|
||
|
if type & LOCAL_TYPE
|
||
|
emit_localaddr_10(value)
|
||
|
else
|
||
|
emit_globaladdr_10(value)
|
||
|
fin
|
||
|
elsif type & CONST_TYPE
|
||
|
emit_const_10(value)
|
||
|
fin
|
||
|
emit_val = 1
|
||
|
fin ; !emit_val
|
||
|
if type & PTR_TYPE
|
||
|
emit_lw()
|
||
|
fin
|
||
|
if !parse_expr_01()
|
||
|
return 0
|
||
|
fin
|
||
|
if token <> CLOSE_BRACKET_TKN
|
||
|
return parse_err_11(@no_close_bracket)
|
||
|
fin
|
||
|
if type & WORD_TYPE
|
||
|
type = WPTR_TYPE
|
||
|
emit_indexword()
|
||
|
else
|
||
|
type = BPTR_TYPE
|
||
|
emit_indexbyte()
|
||
|
fin
|
||
|
drop scan_01()
|
||
|
elsif token == DOT_TKN or token == COLON_TKN
|
||
|
;
|
||
|
; Dot and Colon
|
||
|
;
|
||
|
if token == DOT_TKN
|
||
|
elem_type = BPTR_TYPE
|
||
|
else
|
||
|
elem_type = WPTR_TYPE
|
||
|
fin
|
||
|
if parse_constval_21(@elem_offset, @elem_size)
|
||
|
;
|
||
|
; Constant structure offset
|
||
|
;
|
||
|
if !emit_val
|
||
|
if type & VAR_TYPE
|
||
|
if type & LOCAL_TYPE
|
||
|
emit_localaddr_10(value + elem_offset)
|
||
|
else
|
||
|
; emit_globaladdr_10(value + elem_offset)
|
||
|
emit_globaladdr_10(value)
|
||
|
emit_const_10(elem_offset)
|
||
|
drop emit_binaryop_11(ADD_TKN)
|
||
|
fin
|
||
|
elsif type & CONST_TYPE
|
||
|
value = value + elem_offset
|
||
|
emit_const_10(value)
|
||
|
else ; FUNC_TYPE
|
||
|
emit_globaladdr_10(value)
|
||
|
emit_const_10(elem_offset)
|
||
|
drop emit_binaryop_11(ADD_TKN)
|
||
|
fin
|
||
|
emit_val = 1
|
||
|
else
|
||
|
if elem_offset <> 0
|
||
|
emit_const_10(elem_offset)
|
||
|
drop emit_binaryop_11(ADD_TKN)
|
||
|
fin
|
||
|
fin ; !emit_val
|
||
|
drop scan_01()
|
||
|
elsif token == OPEN_BRACKET_TKN
|
||
|
;
|
||
|
; Array of arrays
|
||
|
;
|
||
|
if !emit_val
|
||
|
if type & ADDR_TYPE
|
||
|
if type & LOCAL_TYPE
|
||
|
emit_localaddr_10(value)
|
||
|
else
|
||
|
emit_globaladdr_10(value)
|
||
|
fin
|
||
|
elsif type & CONST_TYPE
|
||
|
emit_const_10(value)
|
||
|
fin
|
||
|
emit_val = 1
|
||
|
fin ; !emit_val
|
||
|
repeat
|
||
|
if emit_val > 1
|
||
|
emit_indexword()
|
||
|
emit_lw()
|
||
|
fin
|
||
|
emit_val = emit_val + 1
|
||
|
if !parse_expr_01()
|
||
|
return parse_err_11(@bad_expr)
|
||
|
fin
|
||
|
if token <> CLOSE_BRACKET_TKN
|
||
|
return parse_err_11(@no_close_bracket)
|
||
|
fin
|
||
|
until scan_01() <> OPEN_BRACKET_TKN
|
||
|
if elem_type & WPTR_TYPE
|
||
|
emit_indexword()
|
||
|
else
|
||
|
emit_indexbyte()
|
||
|
fin
|
||
|
else
|
||
|
return parse_err_11(@bad_offset)
|
||
|
fin
|
||
|
type = elem_type
|
||
|
elsif token == OPEN_PAREN_TKN
|
||
|
;
|
||
|
; Function call
|
||
|
;
|
||
|
if !emit_val and type & VAR_TYPE
|
||
|
if type & LOCAL_TYPE
|
||
|
emit_localaddr_10(value)
|
||
|
else
|
||
|
emit_globaladdr_10(value)
|
||
|
fin
|
||
|
fin
|
||
|
if !(type & FUNC_CONST_TYPE)
|
||
|
emit_push()
|
||
|
fin
|
||
|
drop parse_expr_01()
|
||
|
if token <> CLOSE_PAREN_TKN
|
||
|
return parse_err_11(@no_close_paren)
|
||
|
fin
|
||
|
if type & FUNC_CONST_TYPE
|
||
|
emit_call_10(value)
|
||
|
else
|
||
|
emit_pull()
|
||
|
emit_ical()
|
||
|
fin
|
||
|
emit_val = 1
|
||
|
type = WORD_TYPE
|
||
|
drop scan_01()
|
||
|
fin
|
||
|
loop
|
||
|
if emit_val
|
||
|
if rvalue
|
||
|
if deref and type & PTR_TYPE
|
||
|
if type & BPTR_TYPE
|
||
|
emit_lb()
|
||
|
else
|
||
|
emit_lw()
|
||
|
fin
|
||
|
fin
|
||
|
fin
|
||
|
else ; emit_val
|
||
|
if type & CONST_TYPE
|
||
|
emit_const_10(value)
|
||
|
elsif deref
|
||
|
if type & FUNC_TYPE
|
||
|
emit_call_10(value)
|
||
|
elsif type & VAR_TYPE
|
||
|
if type & LOCAL_TYPE
|
||
|
if type & BYTE_TYPE
|
||
|
emit_llb_10(value)
|
||
|
else
|
||
|
emit_llw_10(value)
|
||
|
fin
|
||
|
else
|
||
|
if type & BYTE_TYPE
|
||
|
emit_lab_10(value)
|
||
|
else
|
||
|
emit_law_10(value)
|
||
|
fin
|
||
|
fin
|
||
|
elsif type & PTR_TYPE
|
||
|
if type & BPTR_TYPE
|
||
|
emit_lb()
|
||
|
else
|
||
|
emit_lw()
|
||
|
fin
|
||
|
fin
|
||
|
else
|
||
|
if type & LOCAL_TYPE
|
||
|
emit_localaddr_10(value)
|
||
|
else
|
||
|
emit_globaladdr_10(value)
|
||
|
fin
|
||
|
fin
|
||
|
fin ; emit_val
|
||
|
while optos < opsp
|
||
|
if !emit_unaryop_11(pop_op_01())
|
||
|
return parse_err_11(@bad_op)
|
||
|
fin
|
||
|
loop
|
||
|
return type
|
||
|
end
|
||
|
def parse_constexpr_21(valptr, sizeptr)
|
||
|
byte type, size1, size2
|
||
|
word val1, val2
|
||
|
|
||
|
type = parse_constval_21(@val1, @size1)
|
||
|
if !type
|
||
|
return 0
|
||
|
fin
|
||
|
size2 = 0
|
||
|
when scan_01()
|
||
|
is ADD_TKN
|
||
|
type = parse_constval_21(@val2, @size2)
|
||
|
if !type
|
||
|
return 0
|
||
|
fin
|
||
|
*valptr = val1 + val2
|
||
|
is SUB_TKN
|
||
|
type = parse_constval_21(@val2, @size2)
|
||
|
if !type
|
||
|
return 0
|
||
|
fin
|
||
|
*valptr = val1 - val2
|
||
|
is MUL_TKN
|
||
|
type = parse_constval_21(@val2, @size2)
|
||
|
if !type
|
||
|
return 0
|
||
|
fin
|
||
|
*valptr = val1 * val2
|
||
|
is DIV_TKN
|
||
|
type = parse_constval_21(@val2, @size2)
|
||
|
if !type
|
||
|
return 0
|
||
|
fin
|
||
|
*valptr = val1 + val2
|
||
|
is MOD_TKN
|
||
|
type = parse_constval_21(@val2, @size2)
|
||
|
if !type
|
||
|
return 0
|
||
|
fin
|
||
|
*valptr = val1 % val2
|
||
|
drop
|
||
|
is AND_TKN
|
||
|
type = parse_constval_21(@val2, @size2)
|
||
|
if !type
|
||
|
return 0
|
||
|
fin
|
||
|
*valptr = val1 & val2
|
||
|
is OR_TKN
|
||
|
type = parse_constval_21(@val2, @size2)
|
||
|
if !type
|
||
|
return 0
|
||
|
fin
|
||
|
*valptr = val1 ? val2
|
||
|
is EOR_TKN
|
||
|
type = parse_constval_21(@val2, @size2)
|
||
|
if !type
|
||
|
return 0
|
||
|
fin
|
||
|
*valptr = val1 ^ val2
|
||
|
otherwise
|
||
|
*valptr = val1
|
||
|
wend
|
||
|
if size1 > size2
|
||
|
^sizeptr = size1
|
||
|
else
|
||
|
^sizeptr = size2
|
||
|
fin
|
||
|
return type
|
||
|
end
|
||
|
def parse_expr_01
|
||
|
byte prevmatch, matchop, i
|
||
|
word optos
|
||
|
|
||
|
matchop = 0
|
||
|
optos = opsp
|
||
|
repeat
|
||
|
prevmatch = matchop
|
||
|
matchop = 0
|
||
|
if parse_value_11(1)
|
||
|
matchop = 1
|
||
|
for i = 0 to bops_tblsz
|
||
|
if token == bops_tbl[i]
|
||
|
matchop = 2
|
||
|
if bops_prec[i] >= tos_op_prec_11(optos)
|
||
|
if !emit_binaryop_11(pop_op_01())
|
||
|
return parse_err_11(@bad_op)
|
||
|
fin
|
||
|
fin
|
||
|
drop push_op_21(token, bops_prec[i])
|
||
|
break
|
||
|
fin
|
||
|
next
|
||
|
fin
|
||
|
until matchop <> 2
|
||
|
if matchop == 0 and prevmatch == 2
|
||
|
return parse_err_11(@missing_op)
|
||
|
fin
|
||
|
while optos < opsp
|
||
|
if !emit_binaryop_11(pop_op_01())
|
||
|
return parse_err_11(@bad_op)
|
||
|
fin
|
||
|
loop
|
||
|
return matchop or prevmatch
|
||
|
end
|
||
|
def parse_setlist_21(addr, type)
|
||
|
word nexttype, nextaddr, idptr, saveptr
|
||
|
|
||
|
if !(type & VAR_TYPE)
|
||
|
emit_push()
|
||
|
fin
|
||
|
nexttype = 0
|
||
|
nextaddr = 0
|
||
|
if scan_01() == ID_TKN
|
||
|
idptr = id_lookup_21(tknptr, tknlen)
|
||
|
if !idptr
|
||
|
return FALSE
|
||
|
fin
|
||
|
nexttype = (idptr).idtype
|
||
|
if type & VAR_TYPE
|
||
|
nextaddr = (idptr):idval
|
||
|
fin
|
||
|
fin
|
||
|
saveptr = tknptr
|
||
|
drop scan_01()
|
||
|
if nexttype & VAR_TYPE and token == SET_TKN
|
||
|
drop parse_expr_01()
|
||
|
if type & LOCAL_TYPE
|
||
|
if type & BYTE_TYPE
|
||
|
emit_slb_10(nextaddr)
|
||
|
else
|
||
|
emit_slw_10(nextaddr)
|
||
|
fin
|
||
|
else
|
||
|
if type & BYTE_TYPE
|
||
|
emit_sab_10(nextaddr)
|
||
|
else
|
||
|
emit_saw_10(nextaddr)
|
||
|
fin
|
||
|
fin
|
||
|
elsif nexttype & VAR_TYPE and token == SETLIST_TKN
|
||
|
if !parse_setlist_21(nextaddr, nexttype)
|
||
|
return FALSE
|
||
|
fin
|
||
|
else
|
||
|
tknptr = saveptr
|
||
|
rewind_10(tknptr)
|
||
|
nexttype = parse_value_11(0)
|
||
|
if nexttype <> 0
|
||
|
if token == SET_TKN
|
||
|
emit_push()
|
||
|
drop parse_expr_01()
|
||
|
emit_pull()
|
||
|
emit_swap()
|
||
|
if nexttype & (BYTE_TYPE ? BPTR_TYPE)
|
||
|
emit_sb()
|
||
|
else
|
||
|
emit_sw()
|
||
|
fin
|
||
|
fin
|
||
|
elsif token == SETLIST_TKN
|
||
|
if !parse_setlist_21(0, nexttype)
|
||
|
return FALSE
|
||
|
fin
|
||
|
else
|
||
|
return parse_err_11(@bad_syntax)
|
||
|
fin
|
||
|
fin
|
||
|
if type & VAR_TYPE
|
||
|
if type & LOCAL_TYPE
|
||
|
if type & BYTE_TYPE
|
||
|
emit_slb_10(addr)
|
||
|
else
|
||
|
emit_slw_10(addr)
|
||
|
fin
|
||
|
else
|
||
|
if type & BYTE_TYPE
|
||
|
emit_sab_10(addr)
|
||
|
else
|
||
|
emit_saw_10(addr)
|
||
|
fin
|
||
|
fin
|
||
|
else
|
||
|
emit_pull()
|
||
|
emit_swap()
|
||
|
if type & (BYTE_TYPE ? BPTR_TYPE)
|
||
|
emit_sb()
|
||
|
else
|
||
|
emit_sw()
|
||
|
fin
|
||
|
fin
|
||
|
return TRUE
|
||
|
end
|
||
|
def parse_stmnt_01
|
||
|
byte type, i
|
||
|
word tag_prevbrk, tag_else, tag_endif, tag_while, tag_wend
|
||
|
word tag_repeat, tag_for, tag_choice, idptr, saveptr, addr, stepdir
|
||
|
|
||
|
if token <> END_TKN and token <> DONE_TKN
|
||
|
prevstmnt = token
|
||
|
fin
|
||
|
when token
|
||
|
is IF_TKN
|
||
|
drop parse_expr_01()
|
||
|
tag_else = ctag_new_01()
|
||
|
tag_endif = ctag_new_01()
|
||
|
emit_brfls_10(tag_else)
|
||
|
drop scan_01()
|
||
|
repeat
|
||
|
while parse_stmnt_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
if token <> ELSEIF_TKN
|
||
|
break
|
||
|
fin
|
||
|
emit_jump_10(tag_endif)
|
||
|
emit_codetag_10(tag_else)
|
||
|
if !parse_expr_01()
|
||
|
return 0
|
||
|
fin
|
||
|
tag_else = ctag_new_01()
|
||
|
emit_brfls_10(tag_else)
|
||
|
until FALSE
|
||
|
if token == ELSE_TKN
|
||
|
emit_jump_10(tag_endif)
|
||
|
emit_codetag_10(tag_else)
|
||
|
drop scan_01()
|
||
|
while parse_stmnt_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
emit_codetag_10(tag_endif)
|
||
|
else
|
||
|
emit_codetag_10(tag_else)
|
||
|
emit_codetag_10(tag_endif)
|
||
|
fin
|
||
|
if token <> FIN_TKN
|
||
|
return parse_err_11(@no_fin)
|
||
|
fin
|
||
|
is FOR_TKN
|
||
|
stack_loop = stack_loop + 1
|
||
|
tag_for = ctag_new_01()
|
||
|
tag_prevbrk = break_tag
|
||
|
break_tag = ctag_new_01()
|
||
|
if scan_01() <> ID_TKN
|
||
|
return parse_err_11(@bad_stmnt)
|
||
|
fin
|
||
|
idptr = id_lookup_21(tknptr, tknlen)
|
||
|
if idptr
|
||
|
type = (idptr).idtype
|
||
|
addr = (idptr):idval
|
||
|
else
|
||
|
return FALSE
|
||
|
fin
|
||
|
if scan_01() <> SET_TKN
|
||
|
return parse_err_11(@bad_stmnt)
|
||
|
fin
|
||
|
if !parse_expr_01()
|
||
|
return parse_err_11(@bad_stmnt)
|
||
|
fin
|
||
|
emit_codetag_10(tag_for)
|
||
|
if type & LOCAL_TYPE
|
||
|
if type & BYTE_TYPE
|
||
|
emit_dlb_10(addr)
|
||
|
else
|
||
|
emit_dlw_10(addr)
|
||
|
fin
|
||
|
else
|
||
|
if type & BYTE_TYPE
|
||
|
emit_dab_10(addr)
|
||
|
else
|
||
|
emit_daw_10(addr)
|
||
|
fin
|
||
|
fin
|
||
|
stepdir = 1
|
||
|
if token == TO_TKN
|
||
|
drop parse_expr_01()
|
||
|
elsif token == DOWNTO_TKN
|
||
|
drop parse_expr_01()
|
||
|
stepdir = -1
|
||
|
fin
|
||
|
if stepdir > 0
|
||
|
emit_brgt_10(break_tag)
|
||
|
else
|
||
|
emit_brlt_10(break_tag)
|
||
|
fin
|
||
|
if token == STEP_TKN
|
||
|
drop parse_expr_01()
|
||
|
if stepdir > 0
|
||
|
drop emit_binaryop_11(ADD_TKN)
|
||
|
else
|
||
|
drop emit_binaryop_11(SUB_TKN)
|
||
|
fin
|
||
|
else
|
||
|
if stepdir > 0
|
||
|
drop emit_unaryop_11(INC_TKN)
|
||
|
else
|
||
|
drop emit_unaryop_11(DEC_TKN)
|
||
|
fin
|
||
|
fin
|
||
|
while parse_stmnt_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
if token <> NEXT_TKN
|
||
|
return parse_err_11(@bad_stmnt)
|
||
|
fin
|
||
|
emit_jump_10(tag_for)
|
||
|
emit_codetag_10(break_tag)
|
||
|
emit_drop()
|
||
|
break_tag = tag_prevbrk
|
||
|
stack_loop = stack_loop - 1
|
||
|
is WHILE_TKN
|
||
|
tag_while = ctag_new_01()
|
||
|
tag_wend = ctag_new_01()
|
||
|
tag_prevbrk = break_tag
|
||
|
break_tag = tag_wend
|
||
|
emit_codetag_10(tag_while)
|
||
|
drop parse_expr_01()
|
||
|
emit_brfls_10(tag_wend)
|
||
|
while parse_stmnt_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
if token <> LOOP_TKN
|
||
|
return parse_err_11(@no_loop)
|
||
|
fin
|
||
|
emit_jump_10(tag_while)
|
||
|
emit_codetag_10(tag_wend)
|
||
|
break_tag = tag_prevbrk
|
||
|
is REPEAT_TKN
|
||
|
tag_repeat = ctag_new_01()
|
||
|
tag_prevbrk = break_tag
|
||
|
break_tag = ctag_new_01()
|
||
|
emit_codetag_10(tag_repeat)
|
||
|
drop scan_01()
|
||
|
while parse_stmnt_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
if token <> UNTIL_TKN
|
||
|
return parse_err_11(@no_until)
|
||
|
fin
|
||
|
drop parse_expr_01()
|
||
|
emit_brfls_10(tag_repeat)
|
||
|
emit_codetag_10(break_tag)
|
||
|
break_tag = tag_prevbrk
|
||
|
is CASE_TKN
|
||
|
stack_loop = stack_loop + 1
|
||
|
tag_choice = ctag_new_01()
|
||
|
tag_prevbrk = break_tag
|
||
|
break_tag = ctag_new_01()
|
||
|
drop parse_expr_01()
|
||
|
drop nextln_01()
|
||
|
while token <> ENDCASE_TKN
|
||
|
when token
|
||
|
is OF_TKN
|
||
|
if !parse_expr_01()
|
||
|
return parse_err_11(@bad_stmnt)
|
||
|
fin
|
||
|
emit_brne_10(tag_choice)
|
||
|
while parse_stmnt_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
emit_jump_10(break_tag)
|
||
|
emit_codetag_10(tag_choice)
|
||
|
tag_choice = ctag_new_01()
|
||
|
is DEFAULT_TKN
|
||
|
drop scan_01()
|
||
|
while parse_stmnt_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
if token <> ENDCASE_TKN
|
||
|
return parse_err_11(@bad_stmnt)
|
||
|
fin
|
||
|
otherwise
|
||
|
return parse_err_11(@bad_stmnt)
|
||
|
wend
|
||
|
loop
|
||
|
emit_codetag_10(break_tag)
|
||
|
emit_drop()
|
||
|
break_tag = tag_prevbrk
|
||
|
stack_loop = stack_loop - 1
|
||
|
is BREAK_TKN
|
||
|
if break_tag
|
||
|
emit_jump_10(break_tag)
|
||
|
else
|
||
|
return parse_err_11(@bad_stmnt)
|
||
|
fin
|
||
|
is RETURN_TKN
|
||
|
if infunc
|
||
|
for i = 1 to stack_loop
|
||
|
emit_drop()
|
||
|
next
|
||
|
drop parse_expr_01()
|
||
|
emit_leave_10(framesize)
|
||
|
else
|
||
|
return parse_err_11(@bad_stmnt)
|
||
|
fin
|
||
|
is DROP_TKN
|
||
|
drop parse_expr_01()
|
||
|
emit_drop()
|
||
|
is ELSE_TKN
|
||
|
return FALSE
|
||
|
is ELSEIF_TKN
|
||
|
return FALSE
|
||
|
is FIN_TKN
|
||
|
return FALSE
|
||
|
is LOOP_TKN
|
||
|
return FALSE
|
||
|
is UNTIL_TKN
|
||
|
return FALSE
|
||
|
is NEXT_TKN
|
||
|
return FALSE
|
||
|
is OF_TKN
|
||
|
return FALSE
|
||
|
is DEFAULT_TKN
|
||
|
return FALSE
|
||
|
is ENDCASE_TKN
|
||
|
return FALSE
|
||
|
is END_TKN
|
||
|
return FALSE
|
||
|
is DONE_TKN
|
||
|
return FALSE
|
||
|
is FUNC_TKN
|
||
|
return FALSE
|
||
|
is EOF_TKN
|
||
|
return FALSE
|
||
|
is EOL_TKN
|
||
|
return TRUE
|
||
|
otherwise
|
||
|
if token == ID_TKN
|
||
|
saveptr = tknptr
|
||
|
idptr = id_lookup_21(tknptr, tknlen)
|
||
|
if !idptr
|
||
|
return FALSE
|
||
|
fin
|
||
|
type = (idptr).idtype
|
||
|
if type & ADDR_TYPE
|
||
|
addr = (idptr):idval
|
||
|
if scan_01() == SET_TKN
|
||
|
if type & VAR_TYPE
|
||
|
drop parse_expr_01()
|
||
|
if type & LOCAL_TYPE
|
||
|
if type & BYTE_TYPE
|
||
|
emit_slb_10(addr)
|
||
|
else
|
||
|
emit_slw_10(addr)
|
||
|
fin
|
||
|
else
|
||
|
if type & BYTE_TYPE
|
||
|
emit_sab_10(addr)
|
||
|
else
|
||
|
emit_saw_10(addr)
|
||
|
fin
|
||
|
fin
|
||
|
return TRUE
|
||
|
fin
|
||
|
elsif token == SETLIST_TKN and type & VAR_TYPE
|
||
|
return parse_setlist_21(addr, type);
|
||
|
elsif token == EOL_TKN and type & FUNC_TYPE
|
||
|
emit_call_10(addr)
|
||
|
return TRUE
|
||
|
fin
|
||
|
fin
|
||
|
tknptr = saveptr
|
||
|
fin
|
||
|
rewind_10(tknptr)
|
||
|
type = parse_value_11(0)
|
||
|
if type
|
||
|
if token == SET_TKN
|
||
|
drop parse_expr_01()
|
||
|
if type & XBYTE_TYPE
|
||
|
emit_sb()
|
||
|
else
|
||
|
emit_sw()
|
||
|
fin
|
||
|
elsif token == SETLIST_TKN
|
||
|
return parse_setlist_21(0, type);
|
||
|
else
|
||
|
if type & BPTR_TYPE
|
||
|
emit_lb()
|
||
|
elsif type & WPTR_TYPE
|
||
|
emit_lw()
|
||
|
fin
|
||
|
fin
|
||
|
else
|
||
|
return parse_err_11(@bad_syntax)
|
||
|
fin
|
||
|
wend
|
||
|
if scan_01() <> EOL_TKN
|
||
|
return parse_err_11(@bad_syntax)
|
||
|
fin
|
||
|
return TRUE
|
||
|
end
|
||
|
def parse_var_11(type)
|
||
|
byte consttype, constsize, idlen
|
||
|
word idptr, constval, arraysize, size
|
||
|
|
||
|
idlen = 0
|
||
|
size = 1
|
||
|
if scan_01() == ID_TKN
|
||
|
idptr = tknptr
|
||
|
idlen = tknlen
|
||
|
if scan_01() == OPEN_BRACKET_TKN
|
||
|
size = 0
|
||
|
drop parse_constexpr_21(@size, @constsize)
|
||
|
if token <> CLOSE_BRACKET_TKN
|
||
|
return parse_err_11(@no_close_bracket)
|
||
|
fin
|
||
|
drop scan_01()
|
||
|
fin
|
||
|
fin
|
||
|
if type == WORD_TYPE
|
||
|
size = size * 2
|
||
|
fin
|
||
|
if token == SET_TKN
|
||
|
if infunc
|
||
|
return parse_err_11(@no_local_init)
|
||
|
fin
|
||
|
if idlen
|
||
|
drop iddata_add_41(idptr, idlen, type, 0)
|
||
|
fin
|
||
|
consttype = parse_constexpr_21(@constval, @constsize)
|
||
|
if consttype
|
||
|
arraysize = emit_data_41(type, consttype, constval, constsize)
|
||
|
while token == COMMA_TKN
|
||
|
consttype = parse_constexpr_21(@constval, @constsize)
|
||
|
if consttype
|
||
|
arraysize = arraysize + emit_data_41(type, consttype, constval, constsize)
|
||
|
else
|
||
|
return parse_err_11(@bad_decl)
|
||
|
fin
|
||
|
loop
|
||
|
if token <> EOL_TKN
|
||
|
return parse_err_11(@no_close_bracket)
|
||
|
fin
|
||
|
iddata_size_30(PTR_TYPE, size, arraysize);
|
||
|
else
|
||
|
return parse_err_11(@bad_decl)
|
||
|
fin
|
||
|
elsif idlen
|
||
|
if infunc
|
||
|
drop idlocal_add_41(idptr, idlen, type, size)
|
||
|
else
|
||
|
drop iddata_add_41(idptr, idlen, type, size)
|
||
|
fin
|
||
|
fin
|
||
|
return TRUE
|
||
|
end
|
||
|
def parse_vars_01
|
||
|
byte idlen, type, size
|
||
|
word value, idptr
|
||
|
|
||
|
when token
|
||
|
is CONST_TKN
|
||
|
if scan_01() <> ID_TKN
|
||
|
return parse_err_11(@bad_cnst)
|
||
|
fin
|
||
|
idptr = tknptr;
|
||
|
idlen = tknlen
|
||
|
if scan_01() <> SET_TKN
|
||
|
return parse_err_11(@bad_cnst)
|
||
|
fin
|
||
|
if !parse_constexpr_21(@value, @size)
|
||
|
return parse_err_11(@bad_cnst)
|
||
|
fin
|
||
|
drop idconst_add_31(idptr, idlen, value)
|
||
|
is BYTE_TKN
|
||
|
type = BYTE_TYPE
|
||
|
repeat
|
||
|
if !parse_var_11(type)
|
||
|
return FALSE
|
||
|
fin
|
||
|
until token <> COMMA_TKN
|
||
|
is WORD_TKN
|
||
|
type = WORD_TYPE
|
||
|
repeat
|
||
|
if !parse_var_11(type)
|
||
|
return FALSE
|
||
|
fin
|
||
|
until token <> COMMA_TKN
|
||
|
is FUNC_TKN
|
||
|
repeat
|
||
|
if scan_01() == ID_TKN
|
||
|
drop idfunc_add_31(tknptr, tknlen, ctag_new_01())
|
||
|
else
|
||
|
return parse_err_11(@bad_decl)
|
||
|
fin
|
||
|
until scan_01() <> COMMA_TKN
|
||
|
is EOL_TKN
|
||
|
return TRUE
|
||
|
otherwise
|
||
|
return FALSE
|
||
|
wend
|
||
|
return TRUE
|
||
|
end
|
||
|
def parse_func_01
|
||
|
byte opt, cfnparms
|
||
|
word func_tag, idptr
|
||
|
|
||
|
if token == FUNC_TKN
|
||
|
opt = token - FUNC_TKN
|
||
|
if scan_01() <> ID_TKN
|
||
|
return parse_err_11(@bad_decl)
|
||
|
fin
|
||
|
cfnparms = 0
|
||
|
infunc = TRUE
|
||
|
idptr = idglobal_lookup_21(tknptr, tknlen)
|
||
|
if idptr
|
||
|
func_tag = (idptr):idval
|
||
|
else
|
||
|
func_tag = ctag_new_01()
|
||
|
drop idfunc_add_31(tknptr, tknlen, func_tag)
|
||
|
fin
|
||
|
emit_codetag_10(func_tag)
|
||
|
retfunc_tag = ctag_new_01()
|
||
|
idlocal_init()
|
||
|
if scan_01() == OPEN_PAREN_TKN
|
||
|
repeat
|
||
|
if scan_01() == ID_TKN
|
||
|
cfnparms = cfnparms + 1
|
||
|
drop idlocal_add_41(tknptr, tknlen, WORD_TYPE, 2)
|
||
|
drop scan_01()
|
||
|
fin
|
||
|
until token <> COMMA_TKN
|
||
|
if token <> CLOSE_PAREN_TKN
|
||
|
return parse_err_11(@bad_decl)
|
||
|
fin
|
||
|
drop scan_01()
|
||
|
fin
|
||
|
while parse_vars_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
emit_enter_20(framesize, cfnparms)
|
||
|
prevstmnt = 0
|
||
|
while parse_stmnt_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
infunc = FALSE
|
||
|
if token <> END_TKN
|
||
|
return parse_err_11(@bad_syntax)
|
||
|
fin
|
||
|
if scan_01() <> EOL_TKN
|
||
|
return parse_err_11(@bad_syntax)
|
||
|
fin
|
||
|
if prevstmnt <> RETURN_TKN
|
||
|
emit_leave_10(framesize)
|
||
|
fin
|
||
|
return TRUE
|
||
|
elsif token == EOL_TKN
|
||
|
return TRUE
|
||
|
fin
|
||
|
return FALSE
|
||
|
end
|
||
|
def parse_module_01
|
||
|
entrypoint = 0
|
||
|
idglobal_init()
|
||
|
idlocal_init()
|
||
|
if nextln_01()
|
||
|
while parse_vars_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
while parse_func_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
if token <> DONE_TKN
|
||
|
emit_start()
|
||
|
prevstmnt = 0
|
||
|
while parse_stmnt_01()
|
||
|
drop nextln_01()
|
||
|
loop
|
||
|
if token <> DONE_TKN
|
||
|
drop parse_err_11(@no_done)
|
||
|
fin
|
||
|
fin
|
||
|
; dumpsym(idglobal_tbl, globals)
|
||
|
; prstr(@entrypt_str)
|
||
|
; prword(entrypoint)
|
||
|
; crout()
|
||
|
; keyin_01()
|
||
|
return TRUE
|
||
|
fin
|
||
|
return FALSE
|
||
|
end
|
||
|
;
|
||
|
; Compile PLASMA file to REL file
|
||
|
;
|
||
|
prstr(@version)
|
||
|
crout()
|
||
|
if ^argbuff
|
||
|
filename = argbuff
|
||
|
else
|
||
|
filename = rdstr($BA)
|
||
|
fin
|
||
|
ioref = open_21(filename, iobuffer)
|
||
|
if ioref
|
||
|
drop newline_31(ioref, $7F, $0D)
|
||
|
if parse_module_01()
|
||
|
drop close_11(ioref)
|
||
|
;
|
||
|
; Save REF file
|
||
|
;
|
||
|
|
||
|
else
|
||
|
drop close_11(ioref)
|
||
|
crout()
|
||
|
prstr(@badfile)
|
||
|
cin()
|
||
|
fin
|
||
|
; crout
|
||
|
; dumpsym(@idglobal_tbl, globals)
|
||
|
; crout
|
||
|
fin
|
||
|
done
|