A2osX/BIN/CC.S.KW.txt
burniouf 1e404b5bcf KERNEL:IRQ mode for IIgs (not yet preemptive)
CC:most of it working, many bugs remain
DAN2ETH.DRV:broken, lot of debug code included
2023-01-11 19:34:34 +01:00

715 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 SCOPE.New
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.LookupLabelA
bcs .99
lda #$4C emit JMP else
jsr CODE.TOABSYX
bcs .99
jsr CC.GetCharNB
bcs .99
cmp #')'
bne .9
jsr STMT.New00
bcs .99
jmp STMT.SetType
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.IF.END jsr STMT.Close
bcs .99
>LDYA L.CC.KW2.IF Check allowed KW for IF....
jsr CC.LookupID
bcc .2
lda #'E' define ELSE Label
jsr SYM.NewLabelA
bcs .99
jmp SCOPE.Close
*--------------------------------------
.2 lda #'X'
jsr SYM.LookupLabelA
bcs .99
lda #$4C emit JMP exit
jsr CODE.TOABSYX
bcs .99
lda #'E' define ELSE Label
jsr SYM.NewLabelA
bcs .99
lda #KW.ELSE.ID
>STA.G CC.CmdSave
jsr STMT.New00
bcs .99
jmp STMT.SetType
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.ELSE lda #E.CSYN illegal
sec
rts
*--------------------------------------
KW.ELSE.END jsr STMT.Close
bcs .99
lda #'X' define EXIT Label
jsr SYM.NewLabelA
bcs .99
jmp SCOPE.Close
.99 rts
*--------------------------------------
KW.WHILE jsr SCOPE.New
bcs .99
lda #'C' define CONT Label
jsr SYM.NewLabelA
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.LookupLabelA
bcs .99
lda #$4C emit JMP break:
jsr CODE.TOABSYX
bcs .99
jsr CC.GetCharNB
bcs .99
cmp #')'
bne .9
jsr STMT.New00
bcs .99
jmp STMT.SetType
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.WHILE.END jsr STMT.Close
bcs .99
>LDYA L.PCC.SLEEP
jsr CODE.EmitPCC
bcs .99
lda #'C'
jsr SYM.LookupLabelA
bcs .99
lda #$4C
jsr CODE.TOABSYX emit JMP cont:
bcs .99
lda #'B' define BREAK Label
jsr SYM.NewLabelA
jmp SCOPE.Close
.99 rts
*--------------------------------------
KW.DO jsr SCOPE.New
bcs .99
lda #'C' define CONT Label
jsr SYM.NewLabelA
bcs .99
jsr STMT.New00
bcs .99
jmp STMT.SetType
.99 rts
*--------------------------------------
KW.DO.END jsr STMT.Close
bcs .99
>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 SYM.LookupLabelA
bcs .99
lda #$4C emit JMP cont
jsr CODE.TOABSYX
bcs .99
jsr CC.GetCharNB
bcs .99
cmp #')'
bne .9
jsr CORE.GetNCharNB skip ')'
bcs .9
lda #'B' define BREAK Label
jsr SYM.NewLabelA
bcs .99
jmp SCOPE.Close
.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 .19
cmp #'('
bne .29
jsr CORE.GetNCharNB skip '('
bcs .29
jsr SCOPE.New
bcs .19
>LDYA L.CC.TYPEQUAL
jsr CC.LookupID
bcs .1
jsr DECL.X
bcc .2
.19 rts
.29 lda #E.CSYN
sec
rts
*--------------------------------------
.1 jsr STMT.Get get s1
bcs .19
.2 jsr CC.GetCharNB
bcs .29
cmp #';'
bne .29
jsr CORE.GetNCharNB skip ';'
bcs .29
*--------------------------------------
lda #'L' LOOP Label
jsr SYM.NewLabelA
bcs .99
jsr EXP.Eval00 get e2
bcs .99
jsr KW.TestZero
bcs .99
lda #'B'
jsr SYM.LookupLabelA
bcs .99
lda #$4C emit JMP break:
jsr CODE.TOABSYX
lda #'S'
jsr SYM.LookupLabelA
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.NewLabelA
bcs .99
jsr STMT.Get get s3
bcs .99
jsr CC.GetCharNB
bcs .9
cmp #')'
bne .9
lda #'L'
jsr SYM.LookupLabelA
bcs .99
lda #$4C
jsr CODE.TOABSYX emit JMP loop
lda #'S' S Label
jsr SYM.NewLabelA
bcs .99
jsr STMT.New00
bcs .9
jmp STMT.SetType
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.FOR.END lda #$60
jsr CODE.EmitByte set RTS for JSR code;
bcs .99
jsr STMT.Close
bcs .99
lda #'B' define BREAK Label
jsr SYM.NewLabelA
bcs .99
jmp SCOPE.Close FOR ()
.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.ULONG
bcs .97
cpy #SYM.T.SINT+1
bcs .1
>LDYA L.PCC.8to16 make char an int
jsr CODE.EmitPCC
bcs .99
.1 >LDYAI 256
>SYSCALL GetMem
bcs .99
txa
jsr CC.Push push STMT.hMEM
lda #0
jsr CC.Push push STMT.MemPtr
bcs .99
jsr STMT.New
bcs .99
jsr CC.GetCharNB
bcs .99
cmp #')'
bne .98
jsr STMT.SetType {
bcs .99
lda #'J'
jsr SYM.LookupLabelA
bcs .99
lda #$4C emit JMP JmpTable
jmp CODE.TOABSYX
.97 lda #E.TMISMATCH
sec
rts
.98 lda #E.CSYN
sec
.99
KW.SWITCH.RTS rts
*--------------------------------------
KW.SWITCH.END lda #'J' define JMP Label
jsr SYM.NewLabelA
bcs KW.SWITCH.RTS
lda StmtPtr
clc
adc #STMT.hMEM
tay
lda (StmtStk),y
>SYSCALL GetMemPtr
>STYA ZPPtr1
lda StmtPtr
clc
adc #STMT.MemPtr
tay
lda (StmtStk),y
sta ZPPtr2+1
stz ZPPtr2
.1 ldy ZPPtr2
cpy ZPPtr2+1
beq .2
lda (ZPPtr1),y
pha
iny
lda (ZPPtr1),y
tax
pla
jsr CODE.LDAXI
bcs .99
>LDYA L.PCC.JmpOnYA
jsr CODE.EmitPCC
bcs .99
ldy ZPPtr2
iny
iny
lda (ZPPtr1),y
tax
iny
lda (ZPPtr1),y
iny
sty ZPPtr2
tay
lda #$4C emit JMP Case ...
jsr CODE.TOABSYX
bcs .99
bra .1
.2 >LDYA L.PCC.Pop16
jsr CODE.EmitPCC
bcs .99
lda #'D'
jsr SYM.LookupLabelA
bcs .3
lda #$4C emit JMP Default
jsr CODE.TOABSYX
bcs .99
.3 lda #'B' define BREAK Label
jsr SYM.NewLabelA
bcs .99
jmp STMT.Close SWITCH ()
.99 rts
*--------------------------------------
KW.CASE ldy StmtPtr
beq .98
lda (StmtStk),y
cmp #KW.SWITCH.ID SWITCH ??
bne .98
lda StmtPtr
clc
adc #STMT.hMEM
tay
lda (StmtStk),y
>SYSCALL GetMemPtr
>STYA ZPPtr1
jsr EXP.GetIntegral
bcs .99
>STYA ZPPtr2
lda StmtPtr
clc
adc #STMT.MemPtr
tay
lda (StmtStk),y
tay
lda ZPPtr2
sta (ZPPtr1),y
iny
lda ZPPtr2+1
sta (ZPPtr1),y
iny
lda ZPCCCode
sta (ZPPtr1),y
iny
lda ZPCCCode+1
sta (ZPPtr1),y
iny
beq .97
phy
lda StmtPtr
clc
adc #STMT.MemPtr
tay
pla
sta (StmtStk),y
jsr CC.GetCharNB
bcs .98
cmp #':'
bne .98
jsr CORE.GetNCharNB skip ':'
clc
rts
.97 lda #E.BUF
sec
rts
.98 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.DEFAULT ldy StmtPtr
beq .9
lda (StmtStk),y
cmp #KW.SWITCH.ID
bne .9
jsr CC.GetCharNB
bcs .9
cmp #':'
bne .9
jsr CORE.GetNCharNB skip ':'
lda #'D' define DEFAULT Label
jmp SYM.NewLabelA
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.BREAK lda #'B'
jsr SYM.LookupLabelA
bcs .99
lda #$4C emit JMP break
jmp CODE.TOABSYX
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.CONTINUE lda #'C'
jsr SYM.LookupLabelA
bcs .99
lda #$4C emit JMP cont
jmp CODE.TOABSYX
.9 lda #E.CSYN
sec
.99 rts
*--------------------------------------
KW.RETURN lda #'R'
jsr SYM.LookupLabelA
bcs .99
txa
jsr EXP.Eval
bcs .99
jsr SYM.GetYASizeOfInAX Y,A=T/Q
tax X = sizeof
jsr CODE.SetRetValue
bcs .99
lda #'X'
jsr SYM.LookupLabelA
bcs .99
lda #$4C emit JMP exit
jmp CODE.TOABSYX
.99 rts
*--------------------------------------
KW.SIZEOF
lda #E.CSYN
sec
rts
*--------------------------------------
* Input : Value on Stack, Y,A = Type/Qual
*--------------------------------------
KW.TestZero jsr EXP.GetYASizeOfInAX
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.GetYASizeOfInAX
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.RemLocal
.8 clc
.9 rts
*--------------------------------------
MAN
SAVE usr/src/bin/cc.s.kw
LOAD usr/src/bin/cc.s
ASM