ORCA-C/Scanner.asm

         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 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