mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-12-22 07:30:54 +00:00
9036a98e1c
Specifically, the following six punctuator tokens are now supported:
<: :> <% %> %: %:%:
These behave the same as the existing tokens [, ], {, }, #, and ## (respectively), apart from their spelling.
This can be useful when the full ASCII character set cannot easily be displayed or input (e.g. on the IIgs text screen with certain language settings).
673 lines
16 KiB
NASM
673 lines
16 KiB
NASM
mcopy scanner.macros
|
|
datachk off
|
|
****************************************************************
|
|
*
|
|
* Convertsl - Convert a string to a long integer
|
|
*
|
|
* Inputs:
|
|
* str - pointer to the string
|
|
*
|
|
* Outputs:
|
|
* Returns the value.
|
|
*
|
|
* Notes:
|
|
* Assumes the string is valid.
|
|
*
|
|
****************************************************************
|
|
*
|
|
Convertsl start scanner
|
|
|
|
val equ 0 return value
|
|
|
|
subroutine (4:str),4
|
|
|
|
stz val initialize the number to zero
|
|
stz val+2
|
|
lda [str] set X to the number of characters
|
|
and #$00FF
|
|
tax
|
|
ldy #1 Y is the disp into the string
|
|
lb1 asl val val := val*10
|
|
rol val+2
|
|
ph2 val+2
|
|
lda val
|
|
asl val
|
|
rol val+2
|
|
asl val
|
|
rol val+2
|
|
adc val
|
|
sta val
|
|
pla
|
|
adc val+2
|
|
sta val+2
|
|
lda [str],Y add in the new digit
|
|
and #$000F
|
|
adc val
|
|
sta val
|
|
bcc lb2
|
|
inc val+2
|
|
lb2 iny next character
|
|
dex
|
|
bne lb1
|
|
|
|
return 4:val
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* KeyPress - Has a key been presed?
|
|
*
|
|
* If a key has not been pressed, this function returns
|
|
* false. If a key has been pressed, it clears the key
|
|
* strobe. If the key was an open-apple ., a terminal exit
|
|
* is performed; otherwise, the function returns true.
|
|
*
|
|
****************************************************************
|
|
*
|
|
KeyPress start
|
|
|
|
KeyPressGS kpRec
|
|
lda kpAvailable
|
|
beq rts
|
|
ReadKeyGS rkRec
|
|
lda rkKey
|
|
cmp #'.'
|
|
bne lb1
|
|
lda rkModifiers
|
|
and #$0100
|
|
beq lb1
|
|
ph2 #4
|
|
jsl TermError
|
|
|
|
lb1 lda #1
|
|
rts rtl
|
|
|
|
kpRec dc i'3'
|
|
kpKey ds 2
|
|
kpModifiers ds 2
|
|
kpAvailable ds 2
|
|
|
|
rkRec dc i'2'
|
|
rkKey ds 2
|
|
rkModifiers ds 2
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* NextCh - Read the next character from the file, skipping comments
|
|
*
|
|
* Outputs:
|
|
* ch - character read
|
|
*
|
|
****************************************************************
|
|
*
|
|
NextCh start scanner
|
|
eofChar equ 0 end of file character
|
|
eolChar equ 13 end of line character
|
|
|
|
stackFrameSize equ 14 size of the work space
|
|
maxPath equ 255 max length of a path name
|
|
|
|
fp equ 1 file record pointer; work pointer
|
|
p1 equ 5 work pointer
|
|
p2 equ 9
|
|
cch equ 13
|
|
|
|
enum (illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc),0
|
|
enum (ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string)
|
|
enum (ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,ch_colon)
|
|
enum (letter,digit)
|
|
|
|
tsc create stack frame
|
|
sec
|
|
sbc #stackFrameSize
|
|
tcs
|
|
phd
|
|
tcd
|
|
! {flag for preprocessor check}
|
|
! if lastWasReturn then
|
|
! lastWasReturn := charKinds[ord(ch)] in [ch_eol,ch_white]
|
|
! else
|
|
! lastWasReturn := charKinds[ord(ch)] = ch_eol;
|
|
lda ch
|
|
asl A
|
|
tax
|
|
lda charKinds,X
|
|
ldy #1
|
|
cmp #ch_eol
|
|
beq pf2
|
|
ldx lastWasReturn
|
|
beq pf1
|
|
cmp #ch_white
|
|
beq pf2
|
|
pf1 dey
|
|
pf2 sty lastWasReturn
|
|
! 1:
|
|
lab1 anop
|
|
! if chPtr = eofPtr then begin {flag end of file if we're there}
|
|
lda chPtr
|
|
cmp eofPtr
|
|
bne la1
|
|
lda chPtr+2
|
|
cmp eofPtr+2
|
|
beq la2
|
|
la1 brl lb5
|
|
la2 anop
|
|
! if not lastWasReturn then begin
|
|
! lastWasReturn := true;
|
|
! needWriteLine := true;
|
|
! ch := chr(eolChar);
|
|
! goto le2;
|
|
! end; {if}
|
|
lda lastWasReturn
|
|
bne la3
|
|
lda #1
|
|
sta lastWasReturn
|
|
sta needWriteLine
|
|
lda #eolChar
|
|
sta ch
|
|
brl le2
|
|
! ch := chr(eofChar);
|
|
la3 stz ch
|
|
|
|
! if needWriteLine then begin {do eol processing}
|
|
! WriteLine;
|
|
! wroteLine := false;
|
|
! lineNumber := lineNumber+1;
|
|
! firstPtr := chPtr;
|
|
! end; {if}
|
|
lda needWriteLine
|
|
beq lb1
|
|
jsl WriteLine
|
|
stz wroteLine
|
|
inc lineNumber
|
|
move4 chPtr,firstPtr
|
|
lb1 anop
|
|
|
|
! if fileList = nil then begin
|
|
lda fileList
|
|
ora fileList+2
|
|
bne lb3
|
|
lb2 anop
|
|
! skipping := false;
|
|
sta skipping
|
|
! end {if}
|
|
brl le2
|
|
! else begin
|
|
lb3 anop
|
|
! {purge the current source file}
|
|
! with ffDCBGS do begin
|
|
! pCount := 5;
|
|
lda #5
|
|
sta ffDCBGS
|
|
! action := 7;
|
|
lda #7
|
|
sta ffDCBGS+2
|
|
! name := @includeFileGS.theString
|
|
lla ffDCBGS+12,includeFileGS+2
|
|
! end; {with}
|
|
! FastFileGS(ffDCBGS);
|
|
FastFileGS ffDCBGS
|
|
! fp := fileList; {open the file that included this one}
|
|
move4 fileList,fp
|
|
! fileList := fp^.next;
|
|
ldy #2
|
|
lda [fp]
|
|
sta fileList
|
|
lda [fp],Y
|
|
sta fileList+2
|
|
! includeFileGS := fp^.name;
|
|
! sourceFileGS := fp^.sname;
|
|
add4 fp,#4,p1
|
|
add4 fp,#4+maxPath+4,p2
|
|
short M
|
|
ldy #maxPath+3
|
|
lb4 lda [p1],Y
|
|
sta includeFileGS,Y
|
|
lda [p2],Y
|
|
sta sourceFileGS,Y
|
|
dey
|
|
bpl lb4
|
|
long M
|
|
! lineNumber := fp^.lineNumber;
|
|
ldy #4+maxPath+4+maxPath+4
|
|
lda [fp],Y
|
|
sta lineNumber
|
|
! ReadFile;
|
|
jsl ReadFile
|
|
! eofPtr := pointer(ord4(bofPtr) + ffDCBGS.fileLength);
|
|
add4 bofPtr,ffDCBGS+46,eofPtr
|
|
! chPtr := pointer(ord4(bofPtr) + fp^.disp);
|
|
! includeChPtr := chPtr;
|
|
! firstPtr := chPtr;
|
|
ldy #4+maxPath+4+maxPath+4+2
|
|
clc
|
|
lda bofPtr
|
|
adc [fp],Y
|
|
sta chPtr
|
|
sta firstPtr
|
|
sta includeChPtr
|
|
lda bofPtr+2
|
|
iny
|
|
iny
|
|
adc [fp],Y
|
|
sta chPtr+2
|
|
sta firstPtr+2
|
|
sta includeChPtr+2
|
|
! needWriteLine := false;
|
|
stz needWriteLine
|
|
! dispose(fp);
|
|
ph4 fp
|
|
jsl ~Dispose
|
|
! includeCount := includeCount + 1;
|
|
inc includeCount
|
|
! goto 1;
|
|
brl lab1
|
|
! end; {if}
|
|
! end {if}
|
|
|
|
! else begin
|
|
lb5 anop
|
|
! ch := chr(chPtr^); {fetch the character}
|
|
move4 chPtr,p1
|
|
lda [p1]
|
|
and #$00FF
|
|
sta ch
|
|
|
|
! if needWriteLine then begin {do eol processing}
|
|
! WriteLine;
|
|
! wroteLine := false;
|
|
! lineNumber := lineNumber+1;
|
|
! firstPtr := chPtr;
|
|
! end; {if}
|
|
lda needWriteLine
|
|
beq lb6
|
|
jsl WriteLine
|
|
stz wroteLine
|
|
inc lineNumber
|
|
move4 chPtr,firstPtr
|
|
lb6 anop
|
|
! needWriteLine := charKinds[ord(ch)] = ch_eol;
|
|
stz needWriteLine
|
|
lda ch
|
|
asl A
|
|
tax
|
|
lda charKinds,X
|
|
cmp #ch_eol
|
|
bne lb7
|
|
inc needWriteLine
|
|
lb7 anop
|
|
! chPtr := pointer(ord4(chPtr) + 1);
|
|
inc4 chPtr
|
|
! 2: if (ch = '\') and (charKinds[chPtr^] = ch_eol) then begin
|
|
! chPtr := pointer(ord4(chPtr) + 1);
|
|
! DebugCheck;
|
|
! needWriteLine := true;
|
|
! goto 1;
|
|
! end; {if}
|
|
lab2 lda ch
|
|
cmp #'\'
|
|
bne lb8
|
|
move4 chPtr,p1
|
|
lda [p1]
|
|
and #$00FF
|
|
asl A
|
|
tax
|
|
lda charKinds,X
|
|
cmp #ch_eol
|
|
bne lb8
|
|
inc4 chPtr
|
|
jsr DebugCheck
|
|
lda #1
|
|
sta needWriteLine
|
|
brl lab1
|
|
lb8 anop
|
|
! {check for debugger code}
|
|
! if needWriteLine then
|
|
! DebugCheck;
|
|
lda needWriteLine
|
|
beq lb9
|
|
jsr DebugCheck
|
|
lb9 anop
|
|
!
|
|
! {if it's a comment, skip the comment }
|
|
! {characters and return a space. }
|
|
! if (not doingstring) and (ch = '/') and (chPtr <> eofPtr)
|
|
! and ((chr(chPtr^) = '*')
|
|
! or ((chr(chPtr^) = '/') and allowSlashSlashComments))then begin
|
|
lda doingstring
|
|
jne lc6
|
|
lda ch
|
|
cmp #'/'
|
|
jne lc7
|
|
lda chPtr
|
|
cmp eofPtr
|
|
bne lc1
|
|
lda chPtr+2
|
|
cmp eofPtr+2
|
|
jeq lc6
|
|
lc1 move4 chPtr,p1
|
|
lda [p1]
|
|
and #$00FF
|
|
cmp #'*'
|
|
beq lc1a
|
|
cmp #'/'
|
|
jne lc6
|
|
ldx allowSlashSlashComments
|
|
jeq lc6
|
|
! cch := chr(chPtr^);
|
|
lc1a sta cch
|
|
! chPtr := pointer(ord4(chPtr)+1); {skip the '*' or '/'}
|
|
inc4 chPtr
|
|
! done := false;
|
|
! repeat
|
|
lc2 anop
|
|
! if chPtr = eofPtr then {if at eof, we're done}
|
|
! done := true
|
|
lda chPtr
|
|
cmp eofPtr
|
|
bne lc2a
|
|
lda chPtr+2
|
|
cmp eofPtr+2
|
|
jeq lc5
|
|
! else if (cch = '/') and (chPtr^ = return) then begin
|
|
lc2a lda cch
|
|
cmp #'/'
|
|
bne lc2b
|
|
! if charKinds[ord(ch)] = ch_eol then
|
|
! done := true
|
|
! else
|
|
! chPtr := pointer(ord4(chPtr)+1);
|
|
move4 chPtr,p1
|
|
lda [p1]
|
|
and #$00FF
|
|
asl A
|
|
tax
|
|
lda charKinds,X
|
|
cmp #ch_eol
|
|
jeq lc5
|
|
inc4 chPtr
|
|
bra lc2
|
|
! end {else if}
|
|
! else begin
|
|
! ch := chr(chPtr^); {check for terminating */}
|
|
lc2b move4 chPtr,p1
|
|
lda [p1]
|
|
and #$00FF
|
|
sta ch
|
|
! if charKinds[ord(ch)] = ch_eol then begin
|
|
! WriteLine;
|
|
! wroteLine := false;
|
|
! lineNumber := lineNumber+1;
|
|
! firstPtr := pointer(ord4(chPtr)+1);
|
|
! end; {if}
|
|
asl A
|
|
tax
|
|
lda charKinds,X
|
|
cmp #ch_eol
|
|
bne lc3
|
|
jsl WriteLine
|
|
stz wroteLine
|
|
inc lineNumber
|
|
add4 chPtr,#1,firstPtr
|
|
lc3 anop
|
|
! chPtr := pointer(ord4(chPtr)+1);
|
|
inc4 chPtr
|
|
! if ch = '*' then
|
|
! if (chr(chPtr^) = '/') and (chPtr <> eofPtr) then begin
|
|
! chPtr := pointer(ord4(chPtr)+1);
|
|
! done := true;
|
|
! end; {if}
|
|
lda ch
|
|
cmp #'*'
|
|
jne lc2
|
|
lda chPtr
|
|
cmp eofPtr
|
|
bne lc4
|
|
lda chPtr+2
|
|
cmp eofPtr+2
|
|
jeq lc2
|
|
lc4 move4 chPtr,p1
|
|
lda [p1]
|
|
and #$00FF
|
|
cmp #'/'
|
|
jne lc2
|
|
inc4 chPtr
|
|
! end; {else}
|
|
! until done;
|
|
lc5 anop
|
|
! {return a space as the result}
|
|
! ch := ' ';
|
|
lda #' '
|
|
sta ch
|
|
! end {if}
|
|
brl le2
|
|
! else if (ch = '?') and (chPtr <> eofPtr) and (chr(chPtr^) = '?') then begin
|
|
lc6 lda ch
|
|
lc7 cmp #'?'
|
|
jne le2
|
|
lda chPtr
|
|
cmp eofPtr
|
|
bne lc8
|
|
lda chPtr+2
|
|
cmp eofPtr+2
|
|
jeq le2
|
|
lc8 move4 chPtr,p1
|
|
lda [p1]
|
|
and #$00FF
|
|
cmp #'?'
|
|
jne le2
|
|
! chPtr2 := pointer(ord4(chPtr) + 1);
|
|
inc4 p1
|
|
! if (chPtr2 <> eofPtr)
|
|
lda p1
|
|
cmp eofPtr
|
|
bne ld1
|
|
lda p1+2
|
|
cmp eofPtr+2
|
|
beq le2
|
|
ld1 anop
|
|
! and (chr(chPtr2^) in ['(','<','/','''','=',')','>','!','-']) then begin
|
|
! case chr(chPtr2^) of
|
|
! '(': ch := '[';
|
|
lda [p1]
|
|
and #$00FF
|
|
cmp #'('
|
|
bne ld2
|
|
lda #'['
|
|
bra le1
|
|
! '<': ch := '{';
|
|
ld2 cmp #'<'
|
|
bne ld3
|
|
lda #'{'
|
|
bra le1
|
|
! '/': ch := '\';
|
|
ld3 cmp #'/'
|
|
bne ld4
|
|
lda #'\'
|
|
bra le1
|
|
! '''': ch := '^';
|
|
ld4 cmp #''''
|
|
bne ld5
|
|
lda #'^'
|
|
bra le1
|
|
! '=': ch := '#';
|
|
ld5 cmp #'='
|
|
bne ld6
|
|
lda #'#'
|
|
bra le1
|
|
! ')': ch := ']';
|
|
ld6 cmp #')'
|
|
bne ld7
|
|
lda #']'
|
|
bra le1
|
|
! '>': ch := '}';
|
|
ld7 cmp #'>'
|
|
bne ld8
|
|
lda #'}'
|
|
bra le1
|
|
! '!': ch := '|';
|
|
ld8 cmp #'!'
|
|
bne ld9
|
|
lda #'|'
|
|
bra le1
|
|
! '-': ch := '~';
|
|
ld9 cmp #'-'
|
|
bne le2
|
|
lda #'~'
|
|
! end; {case}
|
|
le1 sta ch
|
|
! chPtr := pointer(ord4(chPtr2) + 1);
|
|
add4 chPtr,#2
|
|
! goto 2;
|
|
brl lab2
|
|
! end; {if}
|
|
! end; {if}
|
|
! end; {else}
|
|
le2 anop
|
|
pld
|
|
tsc
|
|
clc
|
|
adc #stackFrameSize
|
|
tcs
|
|
rtl
|
|
! end; {NextCh}
|
|
|
|
;
|
|
; Local subroutine
|
|
;
|
|
enum (stop,break,autogo),0 line number debug types
|
|
! procedure DebugCheck;
|
|
!
|
|
! {Check for debugger characters; process if found }
|
|
!
|
|
! begin {DebugCheck}
|
|
DebugCheck anop
|
|
! if chPtr = eofPtr then
|
|
! debugType := stop
|
|
lda chPtr
|
|
ldx chPtr+2
|
|
cmp eofPtr
|
|
bne db1
|
|
cpx eofPtr+2
|
|
bne db1
|
|
stz debugType
|
|
bra db5
|
|
! else if ord(chPtr^) = $07 then begin
|
|
db1 sta p1
|
|
stx p1+2
|
|
lda [p1]
|
|
and #$00FF
|
|
cmp #$07
|
|
bne db2
|
|
! debugType := break
|
|
lda #break
|
|
sta debugType
|
|
bra db3
|
|
! else if ord(chPtr^) = $06 then
|
|
db2 cmp #$06
|
|
bne db4
|
|
! debugType := autoGo;
|
|
lda #autoGo
|
|
sta debugType
|
|
! chPtr := pointer(ord4(chPtr) + 1);
|
|
db3 inc4 chPtr
|
|
! end {if}
|
|
bra db5
|
|
! else
|
|
! debugType := stop;
|
|
db4 stz debugType
|
|
! end; {DebugCheck}
|
|
db5 rts
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* SetDateTime - set up the date/time strings
|
|
*
|
|
* Outputs:
|
|
* dateStr - date
|
|
* timeStr - time string
|
|
*
|
|
****************************************************************
|
|
*
|
|
SetDateTime private
|
|
|
|
pha get the date/time
|
|
pha
|
|
pha
|
|
pha
|
|
_ReadTimeHex
|
|
lda 1,S set the minutes
|
|
xba
|
|
jsr convert
|
|
sta time+5
|
|
pla set the seconds
|
|
jsr convert
|
|
sta time+8
|
|
lda 1,S set the hour
|
|
jsr convert
|
|
sta time+2
|
|
pla set the year
|
|
xba
|
|
and #$00FF
|
|
ldy #19
|
|
yearloop sec
|
|
sbc #100
|
|
bmi yeardone
|
|
iny
|
|
bra yearloop
|
|
yeardone clc
|
|
adc #100
|
|
jsr convert
|
|
sta date+11
|
|
tya
|
|
jsr convert
|
|
sta date+9
|
|
lda 1,S set the day
|
|
inc A
|
|
jsr convert
|
|
short M
|
|
cmp #'0'
|
|
bne dateOK
|
|
lda #' '
|
|
dateOK long M
|
|
sta date+6
|
|
pla set the month
|
|
xba
|
|
and #$00FF
|
|
asl A
|
|
asl A
|
|
tax
|
|
lda month,X
|
|
sta date+2
|
|
lda month+1,X
|
|
sta date+3
|
|
pla
|
|
lla timeStr,time set the addresses
|
|
lla dateStr,date
|
|
rtl
|
|
|
|
month dc c'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec'
|
|
date dc i'12',c'mmm dd YYyy',i1'0'
|
|
time dc i'9',c'hh:mm:ss',i1'0'
|
|
|
|
convert and #$00FF
|
|
ldx #0
|
|
cv1 sec
|
|
sbc #10
|
|
bcc cv2
|
|
inx
|
|
bra cv1
|
|
cv2 clc
|
|
adc #10
|
|
ora #'0'
|
|
xba
|
|
pha
|
|
txa
|
|
ora #'0'
|
|
ora 1,S
|
|
plx
|
|
rts
|
|
end
|