mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-11-05 02:07:22 +00:00
721 lines
18 KiB
NASM
721 lines
18 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
|
|
|
|
****************************************************************
|
|
*
|
|
* Convertsll - Convert a string to a long long integer
|
|
*
|
|
* Inputs:
|
|
* qval - pointer to location to save value
|
|
* str - pointer to the string
|
|
*
|
|
* Outputs:
|
|
* Saves the value to [qval].
|
|
*
|
|
* Notes:
|
|
* Assumes the string is valid.
|
|
*
|
|
****************************************************************
|
|
*
|
|
Convertsll start scanner
|
|
disp equ 0 displacement into the string
|
|
count equ 2 number of characters remaining to read
|
|
|
|
subroutine (4:qval,4:str),4
|
|
|
|
lda [str] set count to length of string
|
|
and #$00FF
|
|
sta count
|
|
lda #1 start reading from character 1
|
|
sta disp
|
|
ph8 #0 initialize the number to zero
|
|
bra lb1a
|
|
lb1 ph8 #10 multiply by 10
|
|
jsl ~UMUL8
|
|
lb1a pea $0000
|
|
pea $0000
|
|
pea $0000
|
|
ldy disp
|
|
lda [str],Y add in the new digit
|
|
and #$000F
|
|
pha
|
|
jsl ~ADD8
|
|
lb2 inc disp next character
|
|
dec count
|
|
bne lb1
|
|
|
|
pl8 [qval] save the value
|
|
|
|
return
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* KeyPress - Has a key been pressed?
|
|
*
|
|
* 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 (ch_backslash,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 doingStringOrCharacter) and (ch = '/') and (chPtr <> eofPtr)
|
|
! and ((chr(chPtr^) = '*')
|
|
! or ((chr(chPtr^) = '/') and allowSlashSlashComments))then begin
|
|
lda doingStringOrCharacter
|
|
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
|