A2osX/BIN/CC.S.KW.txt
burniouf 127ebe266a CC: wired to libgui
SH: bugfix
BIN/*, DRV/*:bugfix, API change
2022-10-09 23:22:46 +02:00

730 lines
11 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
*--------------------------------------
* Built in Keywords
*--------------------------------------
KW.IF jsr KW.BEGIN00
bcs .99
jsr CC.GetCharNB
bcs .9
cmp #'('
bne .9
jsr CORE.GetNCharNB
bcs .9
jsr EXP.Eval00 Any var type
bcs .99
jsr KW.TestZero Y,A=T/Q
lda #'E'
jsr SYM.LookupA
bcs .99
lda #$4C emit JMP else
jsr CODE.TOABSYX
bcs .99
jsr CC.GetCharNB
bcs .99
cmp #')'
bne .9
jmp KW.STMT
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.IF.END jsr CORE.GetCharNBNL
bcs .1
cmp #';'
beq .1
>LDYA L.CC.KW2.IF Check allowed KW for IF....
jsr CC.LookupID
bcc .2
.1 lda #'E' define ELSE Label
jsr KW.NewLabel
bcs .99
clv pop context
rts
*--------------------------------------
.2 lda #'X'
jsr SYM.LookupA
bcs .99
lda #$4C emit JMP exit
jsr CODE.TOABSYX
bcs .99
lda #'E' define ELSE Label
jsr KW.NewLabel
bcs .99
inc CStackPtr pop ; or }
lda #4 replace IF by ELSE keyword
ldy CStackPtr
sta (ZPCCStack),y
jsr KW.STMT
bcs .99
bit .99 set V : DONT pop context
rts
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.ELSE lda #E.CSYN illegal
sec
rts
*--------------------------------------
KW.ELSE.END lda #'X' define EXIT Label
jsr KW.NewLabel
bcs .99
clv pop context
.99 rts
*--------------------------------------
KW.WHILE jsr KW.BEGIN00
bcs .99
lda #'C' define CONT Label
jsr SYM.NewA
bcs .99
jsr CC.GetCharNB
bcs .9
cmp #'('
bne .9
jsr CORE.GetNCharNB
bcs .9
jsr EXP.Eval00 Any var type
bcs .99
jsr KW.TestZero
lda #'B'
jsr SYM.LookupA
bcs .99
lda #$4C emit JMP break:
jsr CODE.TOABSYX
bcs .99
jsr CC.GetCharNB
bcs .99
cmp #')'
bne .9
jmp KW.STMT
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.WHILE.END >LDYA L.PCC.SLEEP
jsr CODE.EmitPCC
bcs .99
lda #'C'
jsr KW.GetLabel
bcs .99
lda #$4C
jsr CODE.TOABSYX emit JMP cont:
bcs .99
lda #'B' define BREAK Label
jsr KW.NewLabel
bcs .99
clv pop context
.99 rts
*--------------------------------------
KW.DO jsr KW.BEGIN00
bcs .99
lda #'C' define CONT Label
jsr SYM.NewA
bcs .99
jmp KW.STMT
.99 rts
*--------------------------------------
KW.DO.END >LDYA L.CC.KW2.DO Check allowed KW for DO....
jsr CC.LookupID
bcs .9
jsr CC.GetCharNB
bcs .9
cmp #'('
bne .9
jsr CORE.GetNCharNB
bcs .9
jsr EXP.Eval00 Any var type
bcs .99
jsr KW.TestnZero
lda #'C'
jsr KW.GetLabel
bcs .99
lda #$4C emit JMP cont
jsr CODE.TOABSYX
bcs .99
lda #'B' define BREAK Label
jsr KW.NewLabel
bcs .99
jsr CC.GetCharNB
bcs .99
cmp #')'
bne .9
jsr CORE.GetNCharNB
bcs .9
clv pop context
clc
rts
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
* for (s1;e2;s3) s;
*
* { <- new scope : allows for(int i=1; ....)
* s1;
* loop:
* while (e2) jmp break:
* {
* s; jsr s:
* cont:
* s3; jmp loop:
* }
* s:
* <s>;
* break:
* }
*--------------------------------------
KW.FOR jsr CC.GetCharNB
bcs .29
cmp #'('
bne .29
jsr KW.BEGIN00
bcs .29
jsr CORE.GetNCharNB skip '('
bcs .29
>LDYA L.CC.TYPEQUAL
jsr CC.LookupID
bcs .1
jsr DECL.X
bcc .2
.19 rts
.1 jsr STMT.Get get s1
bcs .19
* jsr KW.StackDiscard
.2 jsr CC.GetCharNB
bcs .9
cmp #';'
bne .9
jsr CORE.GetNCharNB skip ';'
bcs .9
*--------------------------------------
lda #'L' LOOP Label
jsr SYM.NewA
bcs .99
jsr EXP.Eval00 get e2
.29 bcs .99
jsr KW.TestZero
bcs .99
lda #'B'
jsr SYM.LookupA
bcs .99
lda #$4C emit JMP break:
jsr CODE.TOABSYX
lda #'S'
jsr SYM.LookupA
bcs .99
lda #$20 emit JSR s:
jsr CODE.TOABSYX
jsr CC.GetCharNB
bcs .9
cmp #';'
bne .9
jsr CORE.GetNCharNB skip ';'
bcs .9
*--------------------------------------
lda #'C' CONT Label
jsr SYM.NewA
bcs .99
jsr STMT.Get get s3
bcs .99
* jsr KW.StackDiscard
jsr CC.GetCharNB
bcs .9
cmp #')'
bne .9
lda #'L'
jsr SYM.LookupA
bcs .99
lda #$4C
jsr CODE.TOABSYX emit JMP loop
lda #'S' S Label
jsr SYM.NewA
bcs .99
jmp KW.STMT
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.FOR.END lda #$60
jsr CODE.EmitByte set RTS for JSR code;
bcs .99
lda #'B' define BREAK Label
jsr KW.NewLabel
bcs .99
clv pop context
.99 rts
*--------------------------------------
KW.SWITCH jsr CC.GetCharNB
bcs .98
cmp #'('
bne .98
jsr CORE.GetNCharNB
bcs .98
jsr EXP.Eval00 Any var type
bcs .99 Y,A=T/Q
tax
bne .97
cpy #SYM.T.UCHAR
bcc .97
cpy #SYM.T.FLOAT
bcs .97
phy
tya
jsr CC.Push push integral type
ply
bcs .99
lda CC.TYPESIZE-1,y
jsr CC.Push push SizeOf(type)
bcs .99
jsr KW.BEGIN
bcs .99
jsr CC.GetCharNB
bcs .99
cmp #')'
bne .98
jmp KW.STMT
.97 lda #E.TMISMATCH
sec
rts
.98 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.SWITCH.END
lda #'B' define BREAK Label
jsr KW.NewLabel
bcs .99
clv pop context
.99 rts
*--------------------------------------
KW.CASE ldy CStackPtr
beq .9
iny skip ; or }
lda (ZPCCStack),y
cmp #10 SWITCH ??
bne .9
lda CStackPtr
clc
adc #7
tay
lda (ZPCCStack),y type
tay
lda #0 for integral type
jsr EXP.Eval
bcs .99
jsr CC.GetCharNB
bcs .9
cmp #':'
bne .9
jsr CORE.GetNCharNB skip ':'
clc
rts
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.DEFAULT ldy CStackPtr
beq .9
iny skip ; or }
lda (ZPCCStack),y
cmp #10 SWITCH ??
bne .9
jsr CC.GetCharNB
bcs .9
cmp #':'
bne .9
jsr CORE.GetNCharNB skip ':'
clc
rts
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.BREAK lda #'B'
jsr KW.LookupLabel
bcs .9
lda #$4C emit JMP break
jmp CODE.TOABSYX
.9 lda #E.CSYN
sec
rts
*--------------------------------------
KW.CONTINUE lda #'C'
jsr KW.LookupLabel
bcs .9
lda #$4C emit JMP cont
jmp CODE.TOABSYX
.9 lda #E.CSYN
sec
rts
*--------------------------------------
KW.RETURN ldy CStackPtr
beq .9
.1 iny skip ; or }
lda (ZPCCStack),y
bmi .7 f()
tya
clc
adc #5 skip CPStmt (6 bytes)
tay
bcc .1
.9 lda #E.STACKERROR
sec
.99 rts
.7 iny skip bState
iny skip Locals
iny
iny skip CPSID
iny get SYM.T
lda (ZPCCStack),y
pha
iny get SYM.Q
lda (ZPCCStack),y
ply
jsr EXP.Eval
bcs .99
jsr SYM.GetYASizeOfInAXC Y,A=T/Q
tax X = sizeof
jsr CODE.SetRetValue
bcs .99
>LDYA L.PCC.LEAVE
jmp CODE.EmitPCC
*--------------------------------------
KW.SIZEOF
lda #E.CSYN
sec
rts
*--------------------------------------
KW.BEGIN00 lda #0
jsr CC.Push no T/Q
bcs KW.BEGIN.RTS
jsr CC.Push
bcs KW.BEGIN.RTS
KW.BEGIN jsr SYM.NewCPSID
bcs .99
>LDA.G CC.CPSPFX+3
jsr CC.Push
bcs .99
>LDA.G CC.CPSPFX+2
jsr CC.Push
bcs .99
lda LocalPtr Locals
jsr CC.Push
bcs .99
lda #0 bState
jsr CC.Push
bcs .99
>LDA.G CC.CmdSave
jmp CC.Push
.99
KW.BEGIN.RTS rts
*--------------------------------------
KW.STMT jsr CORE.GetNCharNBNL
bcs .9
cmp #'{'
bne .1
jsr CORE.GetNCharNB skip '{'
bcs .99
lda #'}'
jmp CC.Push
.1 lda #';'
jmp CC.Push
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.NewLabel pha
lda CStackPtr
clc
adc #4
tay
lda (ZPCCStack),y
pha
iny
lda (ZPCCStack),y
ply
>STYA.G CC.CPSPFX+2
pla
jmp SYM.NewA
*--------------------------------------
KW.GetLabel pha
lda CStackPtr
clc
adc #4
tay
lda (ZPCCStack),y
pha
iny
lda (ZPCCStack),y
ply
>STYA.G CC.CPSPFX+2
pla
jmp SYM.LookupA
*--------------------------------------
KW.LookupLabel pha
ldy CStackPtr
sty ArgIndex
.1 ldy ArgIndex
beq .9
iny skip ; or }
lda (ZPCCStack),y
bmi .9 f()
iny
iny
iny
lda (ZPCCStack),y
pha
iny
lda (ZPCCStack),y
iny
iny
iny
sty ArgIndex
ply
>STYA.G CC.CPSPFX+2
pla
pha
jsr SYM.LookupA
bcs .1
pla
.8 rts
.9 pla
lda #E.CSYN
sec
.99 rts
*--------------------------------------
* Input : Value on Stack, Y,A = Type/Qual
*--------------------------------------
KW.TestZero jsr EXP.GetYASizeOfInAXC
tax
cpx #1
bne .1
>LDYA L.PCC.TestZero1
jmp CODE.EmitPCC
.1 cpx #2
bne .2
>LDYA L.PCC.TestZero2
jmp CODE.EmitPCC
.2 jsr CODE.LDXI
bcs .9
>LDYA L.PCC.TestZeroX
jmp CODE.EmitPCC
.9 rts
*--------------------------------------
* Input : Value on Stack, Y,A = Type/Qual
*--------------------------------------
KW.TestnZero jsr EXP.GetYASizeOfInAXC
tax
cpx #1
bne .1
>LDYA L.PCC.TestnZero1
jmp CODE.EmitPCC
.1 cpx #2
bne .2
>LDYA L.PCC.TestnZero2
jmp CODE.EmitPCC
.2 jsr CODE.LDXI
bcs .9
>LDYA L.PCC.TestnZeroX
jmp CODE.EmitPCC
.9 rts
*--------------------------------------
* Input : Value on Stack, Y,A = Type/Qual
*--------------------------------------
KW.StackDiscard jsr TYPE.SizeOf
txa
beq .8 void
jsr CODE.AddLocal
.8 clc
.9 rts
*--------------------------------------
MAN
SAVE usr/src/bin/cc.s.kw
LOAD usr/src/bin/cc.s
ASM