Ultimate Commodore 64 BASIC & KERNAL ROM Disassembly

by Michael Steil, github.com/mist64/c64disasm. Revision 10947d8, 2019-05-04

This allows you to view different commentaries side-by-side. You can enable/disable individual columns:

Microsoft/Commodore SourceThe original M6502 BASIC source by Microsoft (KIM-1 version, not everything lines up, Commodore extensions are missing, but lots of comments by the original authors)
and the original C64 KERNAL source by Commodore (lots of comments by the original authors)
Data Becker [German]German-language comments from Das neue Commodore-64-intern-Buch by Data Becker, ISBN 3890113079. Some minor corrections have been made.
Lee DavisonComments from The almost completely commented C64 ROM disassembly V1.01 by Lee Davison. Some minor corrections have been made.
Bob Sander-Cederlof [BASIC only]Comments adapted from S-C DocuMentor for Applesoft by Bob Sander-Cederlof, for the version of Microsoft BASIC that shipped with the Apple II.
Magnus Nyman [KERNAL only]Comments from JIFFYDOS version 6.01/version 6.02 by Magnus Nyman (Harlekin/FairLight), which were written for the JiffyDOS KERNAL, so some serial code and all tape code is missing comments.
Marko MäkeläComments from the Commodore 64 BASIC/KERNAL ROM Disassembly Version 1.0 (June 1994) by Marko Mäkelä.
Disassembly Microsoft/Commodore Source Data Becker [German] Lee Davison Bob Sander-Cederlof [BASIC only] Magnus Nyman [KERNAL only] Marko Mäkelä
.:A000 94 E3   Start-Vektor $E394
BASIC cold start entry point
    RESET
.:A002 7B E3   NMI-Vektor $E37B
BASIC warm start entry point
    Warm Start

CBMBASIC

.:A004 43 42 4D 42 41 53 49 43 PAGE

DISPATCH TABLES, RESERVED WORDS, AND ERROR TEXTS.

ORG ROMLOC
'cbmbasic'

Adressen der BASIC-Befehle -1

(Interpreterkode Adresse Befehl)

'cbmbasic', ROM name, unreferenced

action addresses for primary commands

these are called by pushing the address onto the stack and doing an RTS so the
actual address -1 needs to be pushed
'cbmbasic'

BRANCH TABLE FOR TOKENS

 

address table for commands

(address minus 1 used)
.:A00C 30 A8 STMDSP: ADR(END-1)
$80 $A831 END
perform END $80
$80 $A831 END
  end
.:A00E 41 A7 ADR(FOR-1)
$81 $A742 FOR
perform FOR $81
$81 $A742 FOR
  for
.:A010 1D AD ADR(NEXT-1)
$82 $AD1E NEXT
perform NEXT $82
$82 $AD1E NEXT
  next
.:A012 F7 A8 ADR(DATA-1)
IFN EXTIO,<
$83 $A8F8 DATA
perform DATA $83
$83 $A8F8 DATA
  data
.:A014 A4 AB ADR(INPUTN-1)>
$84 $ABA5 INPUT#
perform INPUT# $84
$84 $ABA5 INPUT#
  input#
.:A016 BE AB ADR(INPUT-1)
$85 $ABBF INPUT
perform INPUT $85
$85 $ABBF INPUT
  input
.:A018 80 B0 ADR(DIM-1)
$86 $B081 DIM
perform DIM $86
$86 $B081 DIM
  dim
.:A01A 05 AC ADR(READ-1)
$87 $AC06 READ
perform READ $87
$87 $AC06 READ
  read
.:A01C A4 A9 ADR(LET-1)
$88 $A9A5 LET
perform LET $88
$88 $A9A5 LET
  let
.:A01E 9F A8 ADR(GOTO-1)
$89 $A8A0 GOTO
perform GOTO $89
$89 $A8A0 GOTO
  goto
.:A020 70 A8 ADR(RUN-1)
$8A $A871 RUN
perform RUN $8A
$8A $A871 RUN
  run
.:A022 27 A9 ADR(IF-1)
$8B $A928 IF
perform IF $8B
$8B $A928 IF
  if
.:A024 1C A8 ADR(RESTORE-1)
$8C $A81D RESTORE
perform RESTORE $8C
$8C $A81D RESTORE
  restore
.:A026 82 A8 ADR(GOSUB-1)
$8D $A883 GOSUB
perform GOSUB $8D
$8D $A883 GOSUB
  gosub
.:A028 D1 A8 ADR(RETURN-1)
$8E $A8D2 RETURN
perform RETURN $8E
$8E $A8D2 RETURN
  return
.:A02A 3A A9 ADR(REM-1)
$8F $A93B REM
perform REM $8F
$8F $A93B REM
  rem
.:A02C 2E A8 ADR(STOP-1)
$90 $A82F STOP
perform STOP $90
$90 $A82F STOP
  stop
.:A02E 4A A9 ADR(ONGOTO-1)
IFN NULCMD,<
ADR(NULL-1)>
$91 $A94B ON
perform ON $91
$91 $A94B ON
  on
.:A030 2C B8 ADR(FNWAIT-1)
IFN DISKO,<
IFE REALIO-3,<
$92 $B82D WAIT
perform WAIT $92
$92 $B82D WAIT
  wait
.:A032 67 E1 ADR(CQLOAD-1)
$93 $E168 LOAD
perform LOAD $93
$93 $E168 LOAD
  load
.:A034 55 E1 ADR(CQSAVE-1)
$94 $E156 SAVE
perform SAVE $94
$94 $E156 SAVE
  save
.:A036 64 E1 ADR(CQVERF-1)>
IFN REALIO,<
IFN REALIO-2,<
IFN REALIO-3,<
IFN REALIO-5,<
ADR(LOAD-1)
ADR(SAVE-1)>>>>
IFN REALIO-1,<
IFN REALIO-3,<
IFN REALIO-4,<
ADR(511) ;ADDRESS OF LOAD
ADR(511)>>>> ;ADDRESS OF SAVE
$95 $E165 VERIFY
perform VERIFY $95
$95 $E165 VERIFY
  verify
.:A038 B2 B3 ADR(DEF-1)
$96 $B3B3 DEF
perform DEF $96
$96 $B3B3 DEF
  def
.:A03A 23 B8 ADR(POKE-1)
IFN EXTIO,<
$97 $B824 POKE
perform POKE $97
$97 $B824 POKE
  poke
.:A03C 7F AA ADR(PRINTN-1)>
$98 $AA80 PRINT#
perform PRINT# $98
$98 $AA80 PRINT#
  print#
.:A03E 9F AA ADR(PRINT-1)
$99 $AAA0 PRINT
perform PRINT $99
$99 $AAA0 PRINT
  print
.:A040 56 A8 ADR(CONT-1)
IFE REALIO,<
ADR(DDT-1)>
$9A $A857 CONT
perform CONT $9A
$9A $A857 CONT
  cont
.:A042 9B A6 ADR(LIST-1)
$9B $A69C LIST
perform LIST $9B
$9B $A69C LIST
  list
.:A044 5D A6 ADR(CLEAR-1)
IFN EXTIO,<
$9C $A65E CLR
perform CLR $9C
$9C $A65E CLR
  clr
.:A046 85 AA ADR(CMD-1)
$9D $AA86 CMD
perform CMD $9D
$9D $AA86 CMD
  cmd
.:A048 29 E1 ADR(CQSYS-1)
$9E $E12A SYS
perform SYS $9E
$9E $E12A SYS
  sys
.:A04A BD E1 ADR(CQOPEN-1)
$9F $E1BE OPEN
perform OPEN $9F
$9F $E1BE OPEN
  open
.:A04C C6 E1 ADR(CQCLOS-1)>
IFN GETCMD,<
$A0 $E1C7 CLOSE
perform CLOSE $A0
$A0 $E1C7 CLOSE
  close
.:A04E 7A AB ADR(GET-1)> ;FILL W/ GET ADDR.
$A1 $AB7B GET
perform GET $A1
$A1 $AB7B GET
  get
.:A050 41 A6 ADR(SCRATH-1)
$A2 $A642 NEW

Adressen der BASIC-Funktionen

perform NEW $A2

action addresses for functions

$A2 $A642 NEW
  new

address table for functions

.:A052 39 BC FUNDSP: ADR(SGN)
$B4 $BC39 SGN
perform SGN $B4
$B4 $BC39 SGN
  sgn
.:A054 CC BC ADR(INT)
$B5 $BCCC INT
perform INT $B5
$B5 $BCCC INT
  int
.:A056 58 BC ADR(ABS)
IFE ROMSW,<
USRLOC: ADR(FCERR)> ;INITIALLY NO USER ROUTINE.
IFN ROMSW,<
$B6 $BC58 ABS
perform ABS $B6
$B6 $BC58 ABS
  abs
.:A058 10 03 USRLOC: ADR(USRPOK)>
$B7 $0310 USR
perform USR $B7
$B7 $0310 USR
  usr
.:A05A 7D B3 ADR(FRE)
$B8 $B37D FRE
perform FRE $B8
$B8 $B37D FRE
  fre
.:A05C 9E B3 ADR(POS)
$B9 $B39E POS
perform POS $B9
$B9 $B39E POS
  pos
.:A05E 71 BF ADR(SQR)
$BA $BF71 SQR
perform SQR $BA
$BA $BF71 SQR
  sqr
.:A060 97 E0 ADR(RND)
$BB $E097 RND
perform RND $BB
$BB $E097 RND
  rnd
.:A062 EA B9 ADR(LOG)
$BC $B9EA LOG
perform LOG $BC
$BC $B9EA LOG
  log
.:A064 ED BF ADR(EXP)
IFN KIMROM,<
REPEAT 4,<
ADR(FCERR)>>
IFE KIMROM,<
$BD $BFED EXP
perform EXP $BD
$BD $BFED EXP
  exp
.:A066 64 E2 COSFIX: ADR(COS)
$BE $E264 COS
perform COS $BE
$BE $E264 COS
  cos
.:A068 6B E2 SINFIX: ADR(SIN)
$BF $E26B SIN
perform SIN $BF
$BF $E26B SIN
  sin
.:A06A B4 E2 TANFIX: ADR(TAN)
$C0 $E2B4 TAN
perform TAN $C0
$C0 $E2B4 TAN
  tan
.:A06C 0E E3 ATNFIX: ADR(ATN)>
$C1 $E30E ATN
perform ATN $C1
$C1 $E30E ATN
  atn
.:A06E 0D B8 ADR(PEEK)
$C2 $B80D PEEK
perform PEEK $C2
$C2 $B80D PEEK
  peek
.:A070 7C B7 ADR(LEN)
$C3 $B77C LEN
perform LEN $C3
$C3 $B77C LEN
  len
.:A072 65 B4 ADR(STR)
$C4 $B465 STR$
perform STR$ $C4
$C4 $B465 STR$
  str$
.:A074 AD B7 ADR(VAL)
$C5 $B7AD VAL
perform VAL $C5
$C5 $B7AD VAL
  val
.:A076 8B B7 ADR(ASC)
$C6 $B78B ASC
perform ASC $C6
$C6 $B78B ASC
  asc
.:A078 EC B6 ADR(CHR)
$C7 $B6EC CHR$
perform CHR$ $C7
$C7 $B6EC CHR$
  chr$
.:A07A 00 B7 ADR(LEFT)
$C8 $B700 LEFT$
perform LEFT$ $C8
$C8 $B700 LEFT$
  left$
.:A07C 2C B7 ADR(RIGHT)
$C9 $B72C RIGHT$
perform RIGHT$ $C9
$C9 $B72C RIGHT$
  right$
.:A07E 37 B7 ADR(MID)
$CA $B737 MID$

Hierarchiecodes und

Adressen-1 der Operatoren

perform MID$ $CA

precedence byte and action addresses for operators

like the primary commands these are called by pushing the address onto the stack
and doing an RTS, so again the actual address -1 needs to be pushed
$CA $B737 MID$

MATH OPERATOR BRANCH TABLE

ONE-BYTE PRECEDENCE CODE
TWO-BYTE ADDRESS
  mid$

priority and address table for operators

(address minus 1 used)
.:A080 79 69 B8 OPTAB: 121
$79, $B86A Addition
+
$79, $B86A +
  plus
.:A083 79 52 B8 ADR(FADDT-1)
121
$79, $B853 Subtraktion
-
$79, $B853 -
  minus
.:A086 7B 2A BA ADR(FSUBT-1)
123
$7B, $BA2B Multiplikation
*
$7B, $BA2B *
  multiply
.:A089 7B 11 BB ADR(FMULTT-1)
123
$7B, $BB12 Division
/
$7B, $BB12 /
  divide
.:A08C 7F 7A BF ADR(FDIVT-1)
127
$7F, $BF7B Potenzierung
^
$7F, $BF7B ^
  power
.:A08F 50 E8 AF ADR(FPWRT-1)
80
$50, $AFE9 AND
AND
$50, $AFE9 AND
  AND
.:A092 46 E5 AF ADR(ANDOP-1)
70
$46, $AFE6 OR
OR
$46, $AFE6 OR (LOWEST PRECEDENCE)
  OR
.:A095 7D B3 BF ADR(OROP-1)
NEGTAB: 125
$7D, $BFB4 Vorzeichenwechsel
>
$7D, $BFB4 >
  negative
.:A098 5A D3 AE ADR(NEGOP-1)
NOTTAB: 90
$5A, $AED4 NOT
=
$5A, $AED4 =
  NOT
.:A09B 64 15 B0 ADR(NOTOP-1)
PTDORL: 100 ;PRECEDENCE.
$64, $B016 Vergleich

BASIC-Befehlsworte

<

BASIC keywords

each word has b7 set in it's last character as an end marker, even
the one character keywords such as "<" or "="
first are the primary command keywords, only these can start a statement
$64, $B016 <

TOKEN NAME TABLE

  greater / equal / less

table of commands

each ended with a +$80
.:A09E 45 4E ADR (DOREL-1) ;OPERATOR ADDRESS.
;
; TOKENS FOR RESERVED WORDS ALWAYS HAVE THE MOST
; SIGNIFICANT BIT ON.
; THE LIST OF RESERVED WORDS:
;
Q=128-1
DEFINE DCI(A),<Q=Q+1
DC(A)>
RESLST: DCI"END"
end
end
end
  end
.:A0A0 C4 46 4F D2 4E 45 58 D4 ENDTK==Q
for next
for next
for next
   
.:A0A8 44 41 54 C1 49 4E 50 55 DCI"FOR"
data input#
data input#
data input#
  for
next
data
.:A0B0 54 A3 49 4E 50 55 D4 44 FORTK==Q
input dim
input dim
input dim
  input#
.:A0B8 49 CD 52 45 41 C4 4C 45 DCI"NEXT"
read let
read let
read let
  input
dim
.:A0C0 D4 47 4F 54 CF 52 55 CE DCI"DATA"
goto run
goto run
goto run
  read
let
.:A0C8 49 C6 52 45 53 54 4F 52 DATATK==Q
if restore
if restore
if restore
  goto
run
if
.:A0D0 C5 47 4F 53 55 C2 52 45 IFN EXTIO,<
gosub return
gosub return
gosub return
  restore
.:A0D8 54 55 52 CE 52 45 CD 53 DCI"INPUT#">
rem stop
rem stop
rem stop
  gosub
return
.:A0E0 54 4F D0 4F CE 57 41 49 DCI"INPUT"
on wait
on wait
on wait
  rem
stop
.:A0E8 D4 4C 4F 41 C4 53 41 56 DCI"DIM"
load save
load save
load save
  on
wait
.:A0F0 C5 56 45 52 49 46 D9 44 DCI"READ"
verify def
verify def
verify def
  load
save
.:A0F8 45 C6 50 4F 4B C5 50 52 DCI"LET"
poke print#
poke print#
poke print#
  verify
def
.:A100 49 4E 54 A3 50 52 49 4E DCI"GOTO"
print
print
print
  poke
print#
.:A108 D4 43 4F 4E D4 4C 49 53 GOTOTK==Q
cont list
cont list
cont list
  print
.:A110 D4 43 4C D2 43 4D C4 53 DCI"RUN"
clr cmd sys
clr cmd sys
clr cmd sys
  cont
list
.:A118 59 D3 4F 50 45 CE 43 4C DCI"IF"
open close
open close
open close
  clr
cmd
sys
.:A120 4F 53 C5 47 45 D4 4E 45 DCI"RESTORE"
get new
get new
next are the secondary command keywords, these can not start a statement
get new
  open
close
.:A128 D7 54 41 42 A8 54 CF 46 DCI"GOSUB"
tab( to
tab( to
tab( to
  get
new

table of functions

each ended with a +$80
.:A130 CE 53 50 43 A8 54 48 45 GOSUTK=Q
spc( then
spc( then
spc( then
  tab(
to
fn
.:A138 CE 4E 4F D4 53 54 45 D0 DCI"RETURN"
not step
not step
next are the operators
not step
  spc(
then
.:A140 AB AD AA AF DE 41 4E C4 DCI"REM"
+ - * / ' and
+ - * / ' and
+ - * / ' and
  not
step
plus
.:A148 4F D2 BE BD BC 53 47 CE REMTK=Q
or <=> sgn
or <=>
or <=>
  minus
multiply
divide
power
and
on
.:A150 49 4E D4 41 42 D3 55 53 DCI"STOP"
int abs usr
sgn
and finally the functions
int abs usr
sgn
int abs usr
  greater
equal
less
sgn
int
.:A158 D2 46 52 C5 50 4F D3 53 DCI"ON"
fre pos sqr
fre pos sqr
fre pos sqr
  abs
usr
.:A160 51 D2 52 4E C4 4C 4F C7 IFN NULCMD,<
rnd log
rnd log
rnd log
  fre
pos
sqr
.:A168 45 58 D0 43 4F D3 53 49 DCI"NULL">
exp cos sin
exp cos sin
exp cos sin
  rnd
log
exp
.:A170 CE 54 41 CE 41 54 CE 50 DCI"WAIT"
tan atn peek
tan atn peek
tan atn peek
  cos
sin
.:A178 45 45 CB 4C 45 CE 53 54 IFN DISKO,<
len str$
len str$
len str$
  tan
atn
peek
.:A180 52 A4 56 41 CC 41 53 C3 DCI"LOAD"
val asc
val asc
val asc
  len
str$
.:A188 43 48 52 A4 4C 45 46 54 DCI"SAVE"
chr$ left$
chr$ left$
chr$ left$
  val
asc
chr$
.:A190 A4 52 49 47 48 54 A4 4D IFE REALIO-3,<
right$ mid$
right$ mid$
lastly is GO, this is an add on so that GO TO, as well as GOTO, will work
right$ mid$
  left$
.:A198 49 44 A4 47 CF 00 DCI"VERIFY">>
go

BASIC-Fehlermeldungen

go
go
  right$
mid$

other commands

.:A1A0 54 4F DCI"DEF"
DCI"POKE"
IFN EXTIO,<
DCI"PRINT#">
DCI"PRINT"
PRINTK==Q
DCI"CONT"
IFE REALIO,<
DCI"DDT">
DCI"LIST"
IFN REALIO-3,<
DCI"CLEAR">
IFE REALIO-3,<
DCI"CLR">
IFN EXTIO,<
DCI"CMD"
DCI"SYS"
DCI"OPEN"
DCI"CLOSE">
IFN GETCMD,<
DCI"GET">
DCI"NEW"
SCRATK=Q
; END OF COMMAND LIST.
"T"
"A"
"B"
"("+128
Q=Q+1
TABTK=Q
DCI"TO"
TOTK==Q
DCI"FN"
FNTK==Q
"S"
"P"
"C"
"("+128 ;MACRO DOESNT LIKE ('S IN ARGUMENTS.
Q=Q+1
SPCTK==Q
DCI"THEN"
THENTK=Q
DCI"NOT"
NOTTK==Q
DCI"STEP"
STEPTK=Q
DCI"+"
PLUSTK=Q
DCI"-"
MINUTK=Q
DCI"*"
DCI"/"
DCI"^"
DCI"AND"
DCI"OR"
190 ;A GREATER THAN SIGN
Q=Q+1
GREATK=Q
DCI"="
EQULTK=Q
188
Q=Q+1 ;A LESS THAN SIGN
LESSTK=Q
;
; NOTE DANGER OF ONE RESERVED WORD BEING A PART
; OF ANOTHER:
; IE . . IF 2 GREATER THAN F OR T=5 THEN...
; WILL NOT WORK!!! SINCE "FOR" WILL BE CRUNCHED!!
; IN ANY CASE MAKE SURE THE SMALLER WORD APPEARS
; SECOND IN THE RESERVED WORD TABLE ("INP" AND "INPUT")
; ANOTHER EXAMPLE: IF T OR Q THEN ... "TO" IS CRUNCHED
;
DCI"SGN"
ONEFUN=Q
DCI"INT"
DCI"ABS"
DCI"USR"
DCI"FRE"
DCI"POS"
DCI"SQR"
DCI"RND"
DCI"LOG"
DCI"EXP"
DCI"COS"
DCI"SIN"
DCI"TAN"
DCI"ATN"
DCI"PEEK"
DCI"LEN"
DCI"STR$"
DCI"VAL"
DCI"ASC"
DCI"CHR$"
LASNUM==Q ;NUMBER OF LAST FUNCTION
;THAT TAKES ONE ARG
DCI"LEFT$"
DCI"RIGHT$"
DCI"MID$"
DCI"GO"
GOTK==Q
0 ;MARKS END OF RESERVED WORD LIST
IFE LNGERR,<
Q=0-2
DEFINE DCE(X),<Q=Q+2
DC(X)>
ERRTAB: DCE"NF"
ERRNF==Q ;NEXT WITHOUT FOR.
DCE"SN"
ERRSN==Q ;SYNTAX
DCE"RG"
ERRRG==Q ;RETURN WITHOUT GOSUB.
DCE"OD"
ERROD==Q ;OUT OF DATA.
DCE"FC"
ERRFC==Q ;ILLEGAL QUANTITY.
DCE"OV"
ERROV==Q ;OVERFLOW.
DCE"OM"
ERROM==Q ;OUT OF MEMORY.
DCE"US"
ERRUS==Q ;UNDEFINED STATEMENT.
DCE"BS"
ERRBS==Q ;BAD SUBSCRIPT.
DCE"DD"
ERRDD==Q ;REDIMENSIONED ARRAY.
DCE"/0"
ERRDV0==Q ;DIVISION BY ZERO.
DCE"ID"
ERRID==Q ;ILLEGAL DIRECT.
DCE"TM"
ERRTM==Q ;TYPE MISMATCH.
DCE"LS"
ERRLS==Q ;STRING TOO LONG.
IFN EXTIO,<
DCE"FD" ;FILE DATA.
ERRBD==Q>
DCE"ST"
ERRST==Q ;STRING FORMULA TOO COMPLEX.
DCE"CN"
ERRCN==Q ;CAN'T CONTINUE.
DCE"UF"
ERRUF==Q> ;UNDEFINED FUNCTION.
IFN LNGERR,<
Q=0
; NOTE: THIS ERROR COUNT TECHNIQUE WILL NOT WORK IF THERE ARE MORE
; THAN 256 CHARACTERS OF ERROR MESSAGES
ERRTAB: DC"NEXT WITHOUT FOR"
1 too many files
end marker

BASIC error messages

1 too many files
END OF TOKEN NAME TABLE

ERROR MESSAGES

1 too many files
 

table of error messages

each ended with a +$80
too many files
.:A1A0 4F 20 4D 41 4E 59 20 46            
.:A1A8 49 4C 45 D3 46 49 4C 45 ERRNF==Q
2 file open
2 file open
2 file open
   
.:A1B0 20 4F 50 45 CE 46 49 4C Q=Q+16
3 file not open
3 file not open
3 file not open
  file open
.:A1B8 45 20 4E 4F 54 20 4F 50 DC"SYNTAX"
        file not open
.:A1C0 45 CE 46 49 4C 45 20 4E ERRSN==Q
4 file not found
4 file not found
4 file not found
   
.:A1C8 4F 54 20 46 4F 55 4E C4 Q=Q+6
5 device not present
5 device not present
5 device not present
  file not found
.:A1D0 44 45 56 49 43 45 20 4E DC"RETURN WITHOUT GOSUB"
        device not present
.:A1D8 4F 54 20 50 52 45 53 45 ERRRG==Q
         
.:A1E0 4E D4 4E 4F 54 20 49 4E Q=Q+20
6 not input file
6 not input file
6 not input file
   
.:A1E8 50 55 54 20 46 49 4C C5 DC"OUT OF DATA"
        not input file
.:A1F0 4E 4F 54 20 4F 55 54 50 ERROD==Q
7 not output file
7 not output file
7 not output file
  not output file
.:A1F8 55 54 20 46 49 4C C5 4D Q=Q+11
         
.:A200 49 53 53 49 4E 47 20 46 DC"ILLEGAL QUANTITY"
8 missing filename
8 missing filename
8 missing filename
  missing file name
.:A208 49 4C 45 20 4E 41 4D C5 ERRFC==Q
         
.:A210 49 4C 4C 45 47 41 4C 20 Q=Q+16
9 illegal device number
9 illegal device number
9 illegal device number
  illegal device number
.:A218 44 45 56 49 43 45 20 4E DC"OVERFLOW"
         
.:A220 55 4D 42 45 D2 4E 45 58 ERROV==Q
10 next without for
10 next without for
10 next without for
   
.:A228 54 20 57 49 54 48 4F 55 Q=Q+8
        next without for
.:A230 54 20 46 4F D2 53 59 4E DC"OUT OF MEMORY"
11 syntax
11 syntax
11 syntax
   
.:A238 54 41 D8 52 45 54 55 52 ERROM==Q
12 return without gosub
12 return without gosub
12 return without gosub
  syntax
.:A240 4E 20 57 49 54 48 4F 55 Q=Q+13
        return without gosub
.:A248 54 20 47 4F 53 55 C2 4F DC"UNDEF'D STATEMENT"
13 out of data
13 out of data
13 out of data
   
.:A250 55 54 20 4F 46 20 44 41 ERRUS==Q
        out of data
.:A258 54 C1 49 4C 4C 45 47 41 Q=Q+17
14 illegal quantity
14 illegal quantity
14 illegal quantity
   
.:A260 4C 20 51 55 41 4E 54 49 DC"BAD SUBSCRIPT"
        illegal quantity
.:A268 54 D9 4F 56 45 52 46 4C ERRBS==Q
15 overflow
15 overflow
15 overflow
   
.:A270 4F D7 4F 55 54 20 4F 46 Q=Q+13
16 out of memory
16 out of memory
16 out of memory
  overflow
.:A278 20 4D 45 4D 4F 52 D9 55 DC"REDIM'D ARRAY"
17 undef'd statement
17 undef'd statement
17 undef'd statement
  out of memory
.:A280 4E 44 45 46 27 44 20 53 ERRDD==Q
        undef'd statement
.:A288 54 41 54 45 4D 45 4E D4 Q=Q+13
         
.:A290 42 41 44 20 53 55 42 53 DC"DIVISION BY ZERO"
18 bad subscript
18 bad subscript
18 bad subscript
  bad subscript
.:A298 43 52 49 50 D4 52 45 44 ERRDV0==Q
19 redim'd array
19 redim'd array
19 redim'd array
   
.:A2A0 49 4D 27 44 20 41 52 52 Q=Q+16
        redim'd array
.:A2A8 41 D9 44 49 56 49 53 49 DC"ILLEGAL DIRECT"
20 division by zero
20 division by zero
20 division by zero
   
.:A2B0 4F 4E 20 42 59 20 5A 45 ERRID==Q
        division by zero
.:A2B8 52 CF 49 4C 4C 45 47 41 Q=Q+14
21 illegal direct
21 illegal direct
21 illegal direct
   
.:A2C0 4C 20 44 49 52 45 43 D4 DC"TYPE MISMATCH"
        illegal direct
.:A2C8 54 59 50 45 20 4D 49 53 ERRTM==Q
22 type mismatch
22 type mismatch
22 type mismatch
  type mismatch
.:A2D0 4D 41 54 43 C8 53 54 52 Q=Q+13
23 string too long
23 string too long
23 string too long
   
.:A2D8 49 4E 47 20 54 4F 4F 20 DC"STRING TOO LONG"
        string to long
.:A2E0 4C 4F 4E C7 46 49 4C 45 ERRLS==Q
24 file data
24 file data
24 file data
   
.:A2E8 20 44 41 54 C1 46 4F 52 Q=Q+15
25 formula too complex
25 formula too complex
25 formula too complex
  file data
.:A2F0 4D 55 4C 41 20 54 4F 4F IFN EXTIO,<
        formula too complex
.:A2F8 20 43 4F 4D 50 4C 45 D8 DC"FILE DATA"
         
.:A300 43 41 4E 27 54 20 43 4F ERRBD==Q
26 can't continue
26 can't continue
26 can't continue
  can't continue
.:A308 4E 54 49 4E 55 C5 55 4E Q=Q+9>
27 undef'd function
27 undef'd function
27 undef'd function
   
.:A310 44 45 46 27 44 20 46 55 DC"FORMULA TOO COMPLEX"
        undef'd function
.:A318 4E 43 54 49 4F CE 56 45 ERRST==Q
28 verify
28 verify
28 verify
   
.:A320 52 49 46 D9 4C 4F 41 C4 Q=Q+19
DC"CAN'T CONTINUE"
ERRCN==Q
Q=Q+14
DC"UNDEF'D FUNCTION"
ERRUF==Q>
29 load

Adressen der Fehlermeldungen

29 load

error message pointer table

29 load
  verify
.:A328 9E A1 AC A1 B5 A1 C2 A1           load

error message address locations

01 too many files
.:A330 D0 A1 E2 A1 F0 A1 FF A1           02 file open
03 file not open
04 file not found
05 device not present
.:A338 10 A2 25 A2 35 A2 3B A2           06 not input file
07 not output file
08 missing file name
09 illegal device number
.:A340 4F A2 5A A2 6A A2 72 A2           0A next without for
0B syntax
0C return without gosub
0D out of data
.:A348 7F A2 90 A2 9D A2 AA A2           0E illegal quantity
0F overflow
10 out of memory
11 undef'd statment
.:A350 BA A2 C8 A2 D5 A2 E4 A2           12 bad subscript
13 redim'd array
14 devision by zero
15 illegal direct
.:A358 ED A2 00 A3 0E A3 1E A3           16 type mismatch
17 string too long
18 file data
19 formula too complex
.:A360 24 A3 83 A3 ;
; NEEDED FOR MESSAGES IN ALL VERSIONS.
;

Meldungen des Interpreters

BASIC messages

    1A can't continue
1B undef'd function
1C verify
1D load
.:A364 0D 4F 4B 0D ERR: DT" ERROR"
OK
OK
OK
  1E break

other messages

ok
.:A368 00 20 20 45 52 52 4F 52 0
ERROR
ERROR
ERROR
   
.:A370 00 20 49 4E 20 00 0D 0A INTXT: DT" IN "
IN
IN
IN
  error
.:A378 52 45 41 44 59 2E 0D 0A 0
READY.
READY.
READY.
  in
ready.
.:A380 00 0D 0A 42 52 45 41 4B REDDY: ACRLF
BREAK
BREAK
BREAK
   
.:A388 00 A0 IFE REALIO-3,<
DT"READY.">
IFN REALIO-3,<
DT"OK">
ACRLF
0
BRKTXT: ACRLF
DT"BREAK"
0
PAGE

GENERAL STORAGE MANAGEMENT ROUTINES.

;
; FIND A "FOR" ENTRY ON THE STACK VIA "VARPNT".
;
FORSIZ==2*ADDPRC+16

Stapelsuch-Routine für

FOR-NEXT- und GOSUB-Befehl

spare byte, not referenced

    break
.,A38A BA TSX FNDFOR: TSX ;LOAD XREG WITH STK PNTR.
Stapelzeiger in X-Register
unused

search the stack for FOR or GOSUB activity

return Zb=1 if FOR variable found
copy stack pointer

CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH

THE STACK FOR A FRAME WITH THE SAME VARIABLE.

(FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT"
= $XXFF IF CALLED FROM "RETURN"
<<< BUG: SHOULD BE $FFXX >>>
RETURNS .NE. IF VARIABLE NOT FOUND,
(X) = STACK PNTR AFTER SKIPPING ALL FRAMES
.EQ. IF FOUND
(X) = STACK PNTR OF FRAME FOUND
 

search for "for" blocks on stack

.,A38B E8 INX REPEAT 4,<INX> ;IGNORE ADR(NEWSTT) AND RTS ADDR.
4 mal erhöhen
+1 pass return address
     
.,A38C E8 INX   (nächsten zwei Rücksprung-
+2 pass return address
     
.,A38D E8 INX   adressen, Interpreter und
+3 pass calling routine return address
     
.,A38E E8 INX   Routine, übergehen)
+4 pass calling routine return address
     
.,A38F BD 01 01 LDA $0101,X FFLOOP: LDA 257,X ;GET STACK ENTRY.
nächstes Byte hoten
get the token byte from the stack
"FOR" FRAME HERE?
   
.,A392 C9 81 CMP #$81 CMPI FORTK ;IS IT A "FOR" TOKEN?
Ist es FOR-Code ?
is it the FOR token
    for block code
.,A394 D0 21 BNE $A3B7 BNE FFRTS ;NO, NO "FOR" LOOPS WITH THIS PNTR.
Nein: dann RTS
if not FOR token just exit
it was the FOR token
NO
   
.,A396 A5 4A LDA $4A LDA FORPNT+1 ;GET HIGH.
Variablenzeiger holen
get FOR/NEXT variable pointer high byte
YES -- "NEXT" WITH NO VARIABLE?
   
.,A398 D0 0A BNE $A3A4 BNE CMPFOR
keine Variable (NEXT):$A3A4
branch if not null
NO, VARIABLE SPECIFIED
   
.,A39A BD 02 01 LDA $0102,X LDA 258,X ;PNTR IS ZERO, SO ASSUME THIS ONE.
Variablenzeiger aus
get FOR variable pointer low byte
YES, SO USE THIS FRAME
   
.,A39D 85 49 STA $49 STA FORPNT
Stapel nach $49/4A
save FOR/NEXT variable pointer low byte
     
.,A39F BD 03 01 LDA $0103,X LDA 259,X
(Variablenzeiger)
get FOR variable pointer high byte
     
.,A3A2 85 4A STA $4A STA FORPNT+1
holen
save FOR/NEXT variable pointer high byte
     
.,A3A4 DD 03 01 CMP $0103,X CMPFOR: CMP 259,X
Mit Zeiger im Stapel vergl.
compare variable pointer with stacked variable pointer
high byte
IS VARIABLE IN THIS FRAME?
   
.,A3A7 D0 07 BNE $A3B0 BNE ADDFRS ;NOT THIS ONE.
Ungleich: nächste Schleife
branch if no match
NO
   
.,A3A9 A5 49 LDA $49 LDA FORPNT ;GET DOWN.
Zeiger wieder holen
get FOR/NEXT variable pointer low byte
LOOK AT 2ND BYTE TOO
   
.,A3AB DD 02 01 CMP $0102,X CMP 258,X
Mit Zeiger im Stapel vergl.
compare variable pointer with stacked variable pointer
low byte
SAME VARIABLE?
   
.,A3AE F0 07 BEQ $A3B7 BEQ FFRTS ;WE GOT IT! WE GOT IT!
Gleich: Schleife gefunden,RTS
exit if match found
YES
   
.,A3B0 8A TXA ADDFRS: TXA
Suchzeiger in Akku
copy index
NO, SO TRY NEXT FRAME (IF ANY)
   
.,A3B1 18 CLC CLC ;ADD 16 TO X.
Carry für Addition löschen
clear carry for add
18 BYTES PER FRAME
   
.,A3B2 69 12 ADC #$12 ADCI FORSIZ
Suchzeiger um 18 erhöhen
add FOR stack use size
     
.,A3B4 AA TAX TAX ;RESULT BACK INTO X.
und wieder zurück ins X-Rg.
copy back to index
     
.,A3B5 D0 D8 BNE $A38F BNE FFLOOP
nächste Schleife prüfen
loop if not at start of stack
...ALWAYS?
   
.,A3B7 60 RTS FFRTS: RTS ;RETURN TO CALLER.
;
; THIS IS THE BLOCK TRANSFER ROUTINE.
; IT MAKES SPACE BY SHOVING EVERYTHING FORWARD.
;
; ON ENTRY:
; [Y,A]=[HIGHDS] (FOR REASON).
; [HIGHDS]= DESTINATION OF [HIGH ADDRESS].
; [LOWTR]= LOWEST ADDR TO BE TRANSFERRED.
; [HIGHTR]= HIGHEST ADDR TO BE TRANSFERRED.
;
; A CHECK IS MADE TO ASCERTAIN THAT A REASONABLE
; AMOUNT OF SPACE REMAINS BETWEEN THE BOTTOM
; OF THE STRINGS AND THE HIGHEST LOCATION TRANSFERRED INTO.
;
; ON EXIT:
; [LOWTR] ARE UNCHANGED.
; [HIGHTR]=[LOWTR]-200 OCTAL.
; [HIGHDS]=LOWEST ADDR TRANSFERRED INTO MINUS 200 OCTAL.
;
Rücksprung

Block-Verschiebe-Routine

open up a space in the memory, set the end of arrays

MOVE BLOCK OF MEMORY UP

ON ENTRY:
(Y,A) = (HIGHDS) = DESTINATION END+1
(LOWTR) = LOWEST ADDRESS OF SOURCE
(HIGHTR) = HIGHEST SOURCE ADDRESS+1
 

move bytes after check for space

.,A3B8 20 08 A4 JSR $A408 BLTU: JSR REASON ;ASCERTAIN THAT STRING SPACE WON'T
;BE OVERRUN.
prüft auf Platz im Speicher
check available memory, do out of memory error if no room
BE SURE (Y,A) < FRETOP
   
.,A3BB 85 31 STA $31 STWD STREND
Ende des Arraybereichs
set end of arrays low byte
NEW TOP OF ARRAY STORAGE
   
.,A3BD 84 32 STY $32   als Beginn für freien Platz
set end of arrays high byte
open up a space in the memory, don't set the array end
   

move bytes routine

$5F/$60 source start address
$5A/$5B source end address
$58/$59 destination end address
.,A3BF 38 SEC BLTUC: SEC ;PREPARE TO SUBTRACT.
Carry setzen (Subtraktion)
set carry for subtract
     
.,A3C0 A5 5A LDA $5A LDA HIGHTR
Startadresse von Endad. des
get block end low byte
COMPUTE # OF BYTES TO BE MOVED
   
.,A3C2 E5 5F SBC $5F SBC LOWTR ;COMPUTE NUMBER OF THINGS TO MOVE.
Bereichs abziehen (LOW)
subtract block start low byte
(FROM LOWTR THRU HIGHTR-1)
   
.,A3C4 85 22 STA $22 STA INDEX ;SAVE FOR LATER.
Ergebnis (=Länge) speichern
save MOD(block length/$100) byte
PARTIAL PAGE AMOUNT
   
.,A3C6 A8 TAY TAY
Gleiches System für HIGH:
copy MOD(block length/$100) byte to Y
     
.,A3C7 A5 5B LDA $5B LDA HIGHTR+1
Altes Blockende (HIGH) und
get block end high byte
     
.,A3C9 E5 60 SBC $60 SBC LOWTR+1
davon alter Blockanfang sub
subtract block start high byte
     
.,A3CB AA TAX TAX ;PUT IT IN A COUNTER REGISTER.
Länge nach X bringen
copy block length high byte to X
# OF WHOLE PAGES IN X-REG
   
.,A3CC E8 INX INX ;SO THAT COUNTER ALGORITHM WORKS.
Ist ein Rest ( Länge nicht
+1 to allow for count=0 exit
     
.,A3CD 98 TYA TYA ;SEE IF LOW PART OF COUNT IS ZERO.
256 Bytes)?
copy block length low byte to A
# BYTES IN PARTIAL PAGE
   
.,A3CE F0 23 BEQ $A3F3 BEQ DECBLT ;YES, GO START MOVING BLOCKS.
Nein: dann nur ganze Blöcke
branch if length low byte=0
block is (X-1)*256+Y bytes, do the Y bytes first
NO PARTIAL PAGE
   
.,A3D0 A5 5A LDA $5A LDA HIGHTR ;NO, MUST MODIFY BASE ADDR.
Alte Endadresse (LOW) und
get block end low byte
BACK UP HIGHTR # BYTES IN PARTIAL PAGE
   
.,A3D2 38 SEC SEC
davon Länge des Restab-
set carry for subtract
     
.,A3D3 E5 22 SBC $22 SBC INDEX ;BORROW IS OFF SINCE [HIGHTR].GT.[LOWTR].
schnitts subtrahieren ergibt
Adresse des
subtract MOD(block length/$100) byte
     
.,A3D5 85 5A STA $5A STA HIGHTR ;SAVE MODIFIED BASE ADDR.
Restabschnitts
save corrected old block end low byte
     
.,A3D7 B0 03 BCS $A3DC BCS BLT1 ;IF NO BORROW, GO SHOVE IT.
Berechnung für HIGH umgehen
branch if no underflow
     
.,A3D9 C6 5B DEC $5B DEC HIGHTR+1 ;BORROW IMPLIES SUB 1 FROM HIGH ORDER.
Dasselbe System für HIGH
else decrement block end high byte
     
.,A3DB 38 SEC SEC
Carry setzen (Subtraktion)
set carry for subtract
     
.,A3DC A5 58 LDA $58 BLT1: LDA HIGHDS ;MOD BASE OF DEST ADDR.
Alte Endadresse (HIGH) und
get destination end low byte
BACK UP HIGHDS # BYTES IN PARTIAL PAGE
   
.,A3DE E5 22 SBC $22 SBC INDEX
davon Länge des Rests sub-
subtract MOD(block length/$100) byte
     
.,A3E0 85 58 STA $58 STA HIGHDS
trahieren ergibt neue Adresse
save modified new block end low byte
     
.,A3E2 B0 08 BCS $A3EC BCS MOREN1 ;NO BORROW.
Unbedingter Sprung zur
branch if no underflow
     
.,A3E4 C6 59 DEC $59 DEC HIGHDS+1 ;DECREMENT HIGH ORDER BYTE.
Kopierroutine für ganze
else decrement block end high byte
     
.,A3E6 90 04 BCC $A3EC BCC MOREN1 ;ALWAYS SKIP.
Blöcke
branch always
...ALWAYS
   
.,A3E8 B1 5A LDA ($5A),Y BLTLP: LDADY HIGHTR ;FETCH BYTE TO MOVE
Kopierroutine für Rest-
get byte from source
MOVE THE BYTES
   
.,A3EA 91 58 STA ($58),Y STADY HIGHDS ;MOVE IT IN, MOVE IT OUT.
abschnitt
copy byte to destination
     
.,A3EC 88 DEY MOREN1: DEY
Zähler vermindern
decrement index
     
.,A3ED D0 F9 BNE $A3E8 BNE BLTLP
Alles? wenn nicht: weiter
loop until Y=0
now do Y=0 indexed byte
LOOP TO END OF THIS 256 BYTES
   
.,A3EF B1 5A LDA ($5A),Y LDADY HIGHTR ;MOVE LAST OF THE BLOCK.
Kopierroutine für ganze
get byte from source
MOVE ONE MORE BYTE
   
.,A3F1 91 58 STA ($58),Y STADY HIGHDS
Blöcke
save byte to destination
     
.,A3F3 C6 5B DEC $5B DECBLT: DEC HIGHTR+1
Adresszähler vermindern
decrement source pointer high byte
DOWN TO NEXT BLOCK OF 256
   
.,A3F5 C6 59 DEC $59 DEC HIGHDS+1 ;START ON NEW BLOCKS.
Adresszähler vermindern
decrement destination pointer high byte
     
.,A3F7 CA DEX DEX
Zähler vermindern
decrement block count
ANOTHER BLOCK OF 256 TO MOVE?
   
.,A3F8 D0 F2 BNE $A3EC BNE MOREN1
Alles? Wenn nicht: weiter
loop until count = $0
YES
   
.,A3FA 60 RTS RTS ;RETURN TO CALLER.
;
; THIS ROUTINE IS USED TO ASCERTAIN THAT A GIVEN
; NUMBER OF LOCS REMAIN AVAILABLE FOR THE STACK.
; THE CALL IS:
; LDAI NUMBER OF 2-BYTE ENTRIES NEEDED.
; JSR GETSTK
;
; THIS ROUTINE MUST BE CALLED BY ANY ROUTINE WHICH PUTS
; AN ARBITRARY AMOUNT OF STUFF ON THE STACK,
; I.E., ANY RECURSIVE ROUTINE LIKE "FRMEVL".
; IT IS ALSO CALLED BY ROUTINES SUCH AS "GOSUB" AND "FOR"
; WHICH MAKE PERMANENT ENTRIES ON THE STACK.
;
; ROUTINES WHICH MERELY USE AND FREE UP THE GUARANTEED
; NUMLEV LOCATIONS NEED NOT CALL THIS.
;
;
; ON EXIT:
; [A] AND [X] HAVE BEEN MODIFIED.
;
sonst Rücksprung

Prüfung auf Platz im Stapel

check room on stack for A bytes

if stack too deep do out of memory error
NO, FINISHED

CHECK IF ENOUGH ROOM LEFT ON STACK

FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION

 

test for 2 * A bytes free on stack

.,A3FB 0A ASL GETSTK: ASL A, ;MULT [A] BY 2. NB, CLEARS C BIT.
Akku muß die halbe Zahl an
*2
     
.,A3FC 69 3E ADC #$3E ADCI 2*NUMLEV+<3*ADDPRC>+13 ;MAKE SURE 2*NUMLEV+13 LOCS
;(13 BECAUSE OF FBUFFR)
erforderlichem Platz haben
need at least $3E bytes free
     
.,A3FE B0 35 BCS $A435 BCS OMERR ;WILL REMAIN IN STACK.
gibt 'OUT OF MEMORY'
if overflow go do out of memory error then warm start
...MEM FULL ERR
   
.,A400 85 22 STA $22 STA INDEX
Wert merken
save result in temp byte
     
.,A402 BA TSX TSX ;GET STACKED.
Ist Stapelzeiger kleiner
copy stack
     
.,A403 E4 22 CPX $22 CPX INDEX ;COMPARE.
(2 * Akku + 62)?
compare new limit with stack
     
.,A405 90 2E BCC $A435 BCC OMERR ;IF STACK.LE.INDEX1, OM.
Wenn ja, dann OUT OF MEMORY
if stack < limit do out of memory error then warm start
...MEM FULL ERR
   
.,A407 60 RTS RTS
;
; [Y,A] IS A CERTAIN ADDRESS. "REASON" MAKES SURE
; IT IS LESS THAN [FRETOP].
;
Rücksprung

Schafft Platz im Speicher

check available memory, do out of memory error if no room

CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS

(Y,A) = ADDR ARRAYS NEED TO GROW TO
 

array area overflow check

.,A408 C4 34 CPY $34 REASON: CPY FRETOP+1
für Zeileneinfügung
compare with bottom of string space high byte
HIGH BYTE
   
.,A40A 90 28 BCC $A434 BCC REARTS
und Variablen
if less then exit (is ok)
PLENTY OF ROOM
   
.,A40C D0 04 BNE $A412 BNE TRYMOR ;GO GARB COLLECT.
A/Y = Adresse, bis zu der
skip next test if greater (tested <)
high byte was =, now do low byte
NOT ENOUGH, TRY GARBAGE COLLECTION
   
.,A40E C5 33 CMP $33 CMP FRETOP
Platz benötigt wird.
compare with bottom of string space low byte
LOW BYTE
   
.,A410 90 22 BCC $A434 BCC REARTS
Kleiner als Stringzeiger
if less then exit (is ok)
address is > string storage ptr (oops!)
ENOUGH ROOM
   
.,A412 48 PHA TRYMOR: PHA
Akku Zwischenspeichern
push address low byte
SAVE (Y,A), TEMP1, AND TEMP2
   
.,A413 A2 09 LDX #$09 LDXI 8+ADDPRC ;IF TEMPF2 HAS ZERO IN BETWEEN.
Zähler setzen
set index to save $57 to $60 inclusive
     
.,A415 98 TYA TYA
Y-Register auf
copy address high byte (to push on stack)
save misc numeric work area
     
.,A416 48 PHA REASAV: PHA
Stapel retten
push byte
     
.,A417 B5 57 LDA $57,X LDA HIGHDS-1,X ;SAVE HIGHDS ON STACK.
Ab $57 Zwischenspeichern
get byte from $57 to $60
     
.,A419 CA DEX DEX
Zähler vermindern
decrement index
     
.,A41A 10 FA BPL $A416 BPL REASAV ;PUT 8 OF THEM ON STK.
Alle? sonst weiter
loop until all done
     
.,A41C 20 26 B5 JSR $B526 JSR GARBA2 ;GO GARB COLLECT.
Garbage Collection
do garbage collection routine
restore misc numeric work area
MAKE AS MUCH ROOM AS POSSIBLE
   
.,A41F A2 F7 LDX #$F7 LDXI 256-8-ADDPRC
Zähler setzen, um
set index to restore bytes
RESTORE TEMP1 AND TEMP2
   
.,A421 68 PLA REASTO: PLA
Akku, Y-Register und andere
pop byte
AND (Y,A)
   
.,A422 95 61 STA $61,X STA HIGHDS+8+ADDPRC,X ;RESTORE AFTER GARB COLLECT.
Register zurückholen
save byte to $57 to $60
     
.,A424 E8 INX INX
Zähler vermindern
increment index
     
.,A425 30 FA BMI $A421 BMI REASTO
Fertig? Nein, dann weiter
loop while -ve
     
.,A427 68 PLA PLA
Y-Register von Stapel
pop address high byte
     
.,A428 A8 TAY TAY
zurückholen
copy back to Y
     
.,A429 68 PLA PLA ;RESTORE A AND Y.
Akku holen
pop address low byte
DID WE FIND ENOUGH ROOM?
   
.,A42A C4 34 CPY $34 CPY FRETOP+1 ;COMPARE HIGHS
Ist jetzt genügend Platz?
compare with bottom of string space high byte
HIGH BYTE
   
.,A42C 90 06 BCC $A434 BCC REARTS
Ja, dann Rücksprung
if less then exit (is ok)
YES, AT LEAST A PAGE
   
.,A42E D0 05 BNE $A435 BNE OMERR ;HIGHER IS BAD.
kein Platz, dann Fehler-
if greater do out of memory error then warm start
high byte was =, now do low byte
NO, MEM FULL ERR
   
.,A430 C5 33 CMP $33 CMP FRETOP ;AND THE LOWS.
meldung 1 out of memory 1
compare with bottom of string space low byte
LOW BYTE
   
.,A432 B0 01 BCS $A435 BCS OMERR
ausgeben
if >= do out of memory error then warm start
ok exit, carry clear
NO, MEM FULL ERR
   
.,A434 60 RTS REARTS: RTS
PAGE

ERROR HANDLER, READY, TERMINAL INPUT, COMPACTIFY, NEW, REINIT.

Rücksprung

do out of memory error then warm start

YES, RETURN
 

out of memory error

.,A435 A2 10 LDX #$10 OMERR: LDXI ERROM
Fehlernummer 'out of memory'

Fehlereinsprung

error code $10, out of memory error
do error #X then warm start

HANDLE AN ERROR

(X)=OFFSET IN ERROR MESSAGE TABLE
(ERRFLG) > 128 IF "ON ERR" TURNED ON
(CURLIN+1) = $FF IF IN DIRECT MODE

WARM RESTART ENTRY

COME HERE FROM MONITOR BY CTL-C, 0G, 3D0G, OR E003G
  error number

handle error messages

.,A437 6C 00 03 JMP ($0300) ERROR:
Zum BASIC-Warmstart ($E38B)

Fehlermeldung ausgeben

do error message

do error #X then warm start, the error message vector is initialised to point here

    normally A43A

standard error message handler

.,A43A 8A TXA IFN REALIO,<
Fehlernummer im X-Register
copy error number
     
.,A43B 0A ASL LSR CNTWFL> ;FORCE OUTPUT.
Akku * 2
*2
     
.,A43C AA TAX IFN EXTIO,<
Akku als Zeiger nach X
copy to index
     
.,A43D BD 26 A3 LDA $A326,X LDA CHANNL ;CLOSE NON-TERMINAL CHANNEL.
und Adresse der
get error message pointer low byte
     
.,A440 85 22 STA $22 BEQ ERRCRD
Fehlernummer aus Tabelle
save it
     
.,A442 BD 27 A3 LDA $A327,X JSR CQCCHN ;CLOSE IT.
holen und
get error message pointer high byte
     
.,A445 85 23 STA $23 LDAI 0
abspeichern
save it
     
.,A447 20 CC FF JSR $FFCC STA CHANNL>
I/O Kanäle zurücksetzen
close input and output channels
     
.,A44A A9 00 LDA #$00   und Eingabekanal auf
clear A
     
.,A44C 85 13 STA $13   Tastatur setzen
clear current I/O channel, flag default
     
.,A44E 20 D7 AA JSR $AAD7 ERRCRD: JSR CRDO ;OUTPUT CRLF.
(CR) und (LF) ausgeben
print CR/LF
     
.,A451 20 45 AB JSR $AB45 JSR OUTQST ;PRINT A QUESTION MARK
IFE LNGERR,<
LDA ERRTAB,X, ;GET FIRST CHR OF ERR MSG.
JSR OUTDO ;OUTPUT IT.
LDA ERRTAB+1,X, ;GET SECOND CHR.
JSR OUTDO> ;OUTPUT IT.
'?' ausgeben
print "?"
     
.,A454 A0 00 LDY #$00 IFN LNGERR,<
Zeiger setzen
clear index
     
.,A456 B1 22 LDA ($22),Y GETERR: LDA ERRTAB,X
Fehlermeldungstext holen
get byte from message
     
.,A458 48 PHA PHA
Akku retten
save status
     
.,A459 29 7F AND #$7F ANDI 127 ;GET RID OF HIGH BIT.
Bit 7 löschen und
mask 0xxx xxxx, clear b7
     
.,A45B 20 47 AB JSR $AB47 JSR OUTDO ;OUTPUT IT.
Fehlermeldung ausgeben
output character
     
.,A45E C8 INY INX
Zähler vermindern
increment index
     
.,A45F 68 PLA PLA ;LAST CHAR OF MESSAGE?
Akku zurückholen
restore status
     
.,A460 10 F4 BPL $A456 BPL GETERR> ;NO. GO GET NEXT AND OUTPUT IT.
Fertig? Nein, dann weiter
loop if character was not end marker
     
.,A462 20 7A A6 JSR $A67A TYPERR: JSR STKINI ;RESET THE STACK AND FLAGS.
BASIC-Zeiger initialisieren
flush BASIC stack and clear continue pointer
     
.,A465 A9 69 LDA #$69 LDWDI ERR ;GET PNTR TO " ERROR".
Zeiger A/Y auf Error-
set " ERROR" pointer low byte
    low A369
.,A467 A0 A3 LDY #$A3   meldung stellen
set " ERROR" pointer high byte

print string and do warm start, break entry

    high A369
.,A469 20 1E AB JSR $AB1E ERRFIN: JSR STROUT ;OUTPUT IT.
String ausgeben
print null terminated string
     
.,A46C A4 3A LDY $3A LDY CURLIN+1
Auf Programmodus
get current line number high byte
     
.,A46E C8 INY INY ;WAS NUMBER 64000?
(prog/direkt) prüfen
increment it
     
.,A46F F0 03 BEQ $A474 BEQ READY ;YES, DON'T TYPE LINE NUMBER.
Direkt: dann ausgeben
branch if was in immediate mode
     
.,A471 20 C2 BD JSR $BDC2 JSR INPRT
READY:
IFN REALIO,<
LSR CNTWFL> ;TURN OUTPUT BACK ON IF SUPRESSED
'in Zeilennummer' ausgeben
do " IN " line number message

do warm start

     
.,A474 A9 76 LDA #$76 LDWDI REDDY ;SAY "OK".
Zeiger auf Ready-Modus
set "READY." pointer low byte
    low A376
.,A476 A0 A3 LDY #$A3 IFN REALIO-3,<
JSR RDYJSR> ;OR GO TO INIT IF INIT ERROR.
IFE REALIO-3,<
setzen und
set "READY." pointer high byte
    low A376
.,A478 20 1E AB JSR $AB1E JSR STROUT> ;NO INIT ERRORS POSSIBLE.
String ausgeben
print null terminated string
     
.,A47B A9 80 LDA #$80   Wert für Direktmodus laden
set for control messages only
     
.,A47D 20 90 FF JSR $FF90   und Flag setzen

Eingabe-Warteschleife

control kernal messages
     
.,A480 6C 02 03 JMP ($0302)   JMP $A483
do BASIC warm start

BASIC warm start, the warm start vector is initialised to point here

    normally A483

standard warm start routine

.,A483 20 60 A5 JSR $A560 MAIN: JSR INLIN ;GET A LINE FROM TERMINAL.
BASIC-Zeile nach
Eingabepuffer
call for BASIC input
READ A LINE
   
.,A486 86 7A STX $7A STXY TXTPTR
CHRGET Zeiger auf
save BASIC execute pointer low byte
SET UP CHRGET TO SCAN THE LINE
   
.,A488 84 7B STY $7B   Eingabepuffer
save BASIC execute pointer high byte
     
.,A48A 20 73 00 JSR $0073 JSR CHRGET
nächstes Zeichen holen
increment and scan memory
     
.,A48D AA TAX TAX ;SET ZERO FLAG BASED ON [A]
;THIS DISTINGUISHES ":" AND 0
Puffer leer?
copy byte to set flags
     
.,A48E F0 F0 BEQ $A480 BEQ MAIN ;IF BLANK LINE, GET ANOTHER.
Ja: dann weiter warten
loop if no input
got to interpret the input line now ....
EMPTY LINE
   
.,A490 A2 FF LDX #$FF LDXI 255 ;SET DIRECT LINE NUMBER.
Wert für
current line high byte to -1, indicates immediate mode
$FF IN HI-BYTE OF CURLIN MEANS
   
.,A492 86 3A STX $3A STX CURLIN+1
Kennzeichen für Direktmodus
set current line number high byte
WE ARE IN DIRECT MODE
   
.,A494 90 06 BCC $A49C BCC MAIN1 ;IS A LINE NUMBER. NOT DIRECT.
Ziffer? als Zeile einfügen
if numeric character go handle new BASIC line
no line number .. immediate mode
CHRGET SAW DIGIT, NUMBERED LINE
   
.,A496 20 79 A5 JSR $A579 JSR CRUNCH ;COMPACTIFY.
BASIC-Zeile in Code wandeln
crunch keywords into BASIC tokens
NO NUMBER, SO PARSE IT
   
.,A499 4C E1 A7 JMP $A7E1 JMP GONE ;EXECUTE IT.
Befehl ausführen

Löschen und Einfügen von

Programmzeilen

go scan and interpret code

handle new BASIC line

AND TRY EXECUTING IT

HANDLE NUMBERED LINE

 

handle insert/delete basic lines

.,A49C 20 6B A9 JSR $A96B MAIN1: JSR LINGET ;READ LINE NUMBER INTO "LINNUM".
Zeilenr. nach Adressformat
get fixed-point number into temporary integer
     
.,A49F 20 79 A5 JSR $A579 JSR CRUNCH
BASIC-Zeile in Code wandeln
crunch keywords into BASIC tokens
     
.,A4A2 84 0B STY $0B STY COUNT ;RETAIN CHARACTER COUNT.
Zeiger in Eingabepuffer
save index pointer to end of crunched line
SAVE INDEX TO INPUT BUFFER
   
.,A4A4 20 13 A6 JSR $A613 JSR FNDLIN
Zeilenadresse berechnen
search BASIC for temporary integer line number
IS THIS LINE # ALREADY IN PROGRAM?
   
.,A4A7 90 44 BCC $A4ED BCC NODEL ;NO MATCH, SO DON'T DELETE.
Vorhanden? Ja: löschen

Programmzeile löschen

if not found skip the line delete
line # already exists so delete it
NO
 

delete old line

.,A4A9 A0 01 LDY #$01 LDYI 1
Zeiger setzen
set index to next line pointer high byte
YES, SO DELETE IT
   
.,A4AB B1 5F LDA ($5F),Y LDADY LOWTR
Startadresse der nächsten
get next line pointer high byte
LOWTR POINTS AT LINE
   
.,A4AD 85 23 STA $23 STA INDEX1+1
Zeile (HIGH) setzen
save it
GET HIGH BYTE OF FORWARD PNTR
   
.,A4AF A5 2D LDA $2D LDA VARTAB
Variablenanfangszeiger
get start of variables low byte
     
.,A4B1 85 22 STA $22 STA INDEX1
(LOW) setzen
save it
     
.,A4B3 A5 60 LDA $60 LDA LOWTR+1 ;SET TRANSFER TO.
Startadresse der zu
get found line pointer high byte
     
.,A4B5 85 25 STA $25 STA INDEX2+1
löschenden Zeile (HIGH)
save it
     
.,A4B7 A5 5F LDA $5F LDA LOWTR
Startadresse der zu
get found line pointer low byte
     
.,A4B9 88 DEY DEY
löschenden Zeile (LOW)
decrement index
     
.,A4BA F1 5F SBC ($5F),Y SBCDY LOWTR ;COMPUTE NEGATIVE LENGTH.
Startadresse der nächsten
subtract next line pointer low byte
     
.,A4BC 18 CLC CLC
Zeile (LOW)
clear carry for add
     
.,A4BD 65 2D ADC $2D ADC VARTAB ;COMPUTE NEW VARTAB.
Variablenanfangszeiger (LOW)
add start of variables low byte
     
.,A4BF 85 2D STA $2D STA VARTAB
ergibt neuen Variablenan-
set start of variables low byte
     
.,A4C1 85 24 STA $24 STA INDEX2 ;SET LOW OF TRANS TO.
fangszeiger (LOW)
save destination pointer low byte
     
.,A4C3 A5 2E LDA $2E LDA VARTAB+1
Gleiches System für
get start of variables high byte
     
.,A4C5 69 FF ADC #$FF ADCI 255
HIGH-Byte des Variablenan-
-1 + carry
     
.,A4C7 85 2E STA $2E STA VARTAB+1 ;COMPUTE HIGH OF VARTAB.
fangszeigers
set start of variables high byte
     
.,A4C9 E5 60 SBC $60 SBC LOWTR+1 ;COMPUTE NUMBER OF BLOCKS TO MOVE.
minus Startadresse der zu
subtract found line pointer high byte
     
.,A4CB AA TAX TAX
löschenden Zeile (LOW) ergibt
copy to block count
     
.,A4CC 38 SEC SEC
die zu verschiebenden Blöcke
set carry for subtract
     
.,A4CD A5 5F LDA $5F LDA LOWTR
Startadresse (LOW) minus
get found line pointer low byte
     
.,A4CF E5 2D SBC $2D SBC VARTAB ;COMPUTE OFFSET.
Variablenanfangszeiger (LOW)
subtract start of variables low byte
     
.,A4D1 A8 TAY TAY
ergibt Länge des Restabschn.
copy to bytes in first block count
     
.,A4D2 B0 03 BCS $A4D7 BCS QDECT1 ;IF VARTAB.LE.LOWTR,
Größer als 255? Nein: $A4D7
branch if no underflow
     
.,A4D4 E8 INX INX ;DECR DUE TO CARRY, AND
Zähler für Blöcke erhöhen
increment block count, correct for = 0 loop exit
     
.,A4D5 C6 25 DEC $25 DEC INDEX2+1 ;DECREMENT STORE SO CARRY WORKS.
Transportzeiger vermindern
decrement destination high byte
     
.,A4D7 18 CLC QDECT1: CLC
Carry löschen
clear carry for add
     
.,A4D8 65 22 ADC $22 ADC INDEX1
Anfangszeiger (LOW)
add source pointer low byte
     
.,A4DA 90 03 BCC $A4DF BCC MLOOP
Verminderung überspringen
branch if no overflow
     
.,A4DC C6 23 DEC $23 DEC INDEX1+1
Zeiger um 1 vermindern
else decrement source pointer high byte
     
.,A4DE 18 CLC CLC ;FOR LATER ADCQ
Carry löschen
clear carry
close up memory to delete old line
     
.,A4DF B1 22 LDA ($22),Y MLOOP: LDADY INDEX1
Verschiebeschleife
get byte from source
MOVE HIGHER LINES OF PROGRAM
   
.,A4E1 91 24 STA ($24),Y STADY INDEX2
Wert abspeichern
copy to destination
DOWN OVER THE DELETED LINE.
   
.,A4E3 C8 INY INY
Zähler um 1 erhöhen
increment index
     
.,A4E4 D0 F9 BNE $A4DF BNE MLOOP ;BLOCK DONE?
Block fertig? Nein: weiter
while <> 0 do this block
     
.,A4E6 E6 23 INC $23 INC INDEX1+1
1.Adreßzeiger erhöhen (LOW)
increment source pointer high byte
     
.,A4E8 E6 25 INC $25 INC INDEX2+1
2.Adreßzeiger erhöhen (LOW)
increment destination pointer high byte
     
.,A4EA CA DEX DEX
Blockzähter um 1 vermindern
decrement block count
     
.,A4EB D0 F2 BNE $A4DF BNE MLOOP ;DO ANOTHER BLOCK. ALWAYS.
Alle Blöcke? Nein: weiter

Programmzeile einfügen

loop until all done
got new line in buffer and no existing same #
   

insert new line

.,A4ED 20 59 A6 JSR $A659 NODEL: JSR RUNC ;RESET ALL VARIABLE INFO SO GARBAGE
;COLLECTION CAUSED BY REASON WILL WORK
CLR-Befehl
reset execution to start, clear variables, flush stack
and return
     
.,A4F0 20 33 A5 JSR $A533 JSR LNKPRG ;FIX UP THE LINKS
Programmzeilen neu binden
rebuild BASIC line chaining
     
.,A4F3 AD 00 02 LDA $0200 LDA BUF ;SEE IF ANYTHNG THERE
Zeichen im Puffer ?
get first byte from buffer
ANY CHARACTERS AFTER LINE #?
   
.,A4F6 F0 88 BEQ $A480 BEQ MAIN
nein, dann zur Warteschleife
if no line go do BASIC warm start
else insert line into memory
NO, SO NOTHING TO INSERT.
   
.,A4F8 18 CLC CLC
Carry löschen
clear carry for add
     
.,A4F9 A5 2D LDA $2D LDA VARTAB
Variablenanfangszeiger (LOW)
get start of variables low byte
SET UP BLTU SUBROUTINE
   
.,A4FB 85 5A STA $5A STA HIGHTR ;SETUP HIGHTR.
als Endadresse (Quellbereich)
save as source end pointer low byte
INSERT NEW LINE.
   
.,A4FD 65 0B ADC $0B ADC COUNT ;ADD LENGTH OF LINE TO INSERT.
+ Länge der Zeile als End-
add index pointer to end of crunched line
     
.,A4FF 85 58 STA $58 STA HIGHDS ;THIS GIVES DEST ADDR.
adresse des Zielbereichs LOW
save as destination end pointer low byte
     
.,A501 A4 2E LDY $2E LDY VARTAB+1
Variablenanfangszeiger als
get start of variables high byte
     
.,A503 84 5B STY $5B STY HIGHTR+1 ;SAME FOR HIGH ORDERS.
Endadr. des Quellbereichs LOW
save as source end pointer high byte
     
.,A505 90 01 BCC $A508 BCC NODELC
Kein Übertrag? dann $A508
branch if no carry to high byte
     
.,A507 C8 INY INY
Übertrag addieren
else increment high byte
     
.,A508 84 59 STY $59 NODELC: STY HIGHDS+1
Als Endadresse
des Zielbereichs
save as destination end pointer high byte
     
.,A50A 20 B8 A3 JSR $A3B8 JSR BLTU
IFN BUFPAG,<
BASIC-Zeilen verschieben
open up space in memory
most of what remains to do is copy the crunched line into the space opened up in memory,
however, before the crunched line comes the next line pointer and the line number. the
line number is retrieved from the temporary integer and stored in memory, this
overwrites the bottom two bytes on the stack. next the line is copied and the next line
pointer is filled with whatever was in two bytes above the line number in the stack.
this is ok because the line pointer gets fixed in the line chain re-build.
MAKE ROOM FOR THE LINE
   
.,A50D A5 14 LDA $14 LDWD LINNUM ;POSITION THE BINARY LINE NUMBER
Zeilennummer aus
get line number low byte
PUT LINE NUMBER IN LINE IMAGE
   
.,A50F A4 15 LDY $15   $14/15 vor
get line number high byte
     
.,A511 8D FE 01 STA $01FE STWD BUF-2> ;IN FRONT OF BUF
BASIC-Eingabepuffer setzen
save line number low byte before crunched line
     
.,A514 8C FF 01 STY $01FF   (ab $0200)
save line number high byte before crunched line
     
.,A517 A5 31 LDA $31 LDWD STREND
Neuer Variablen-
get end of arrays low byte
     
.,A519 A4 32 LDY $32   endzeiger
get end of arrays high byte
     
.,A51B 85 2D STA $2D STWD VARTAB
als Zeiger auf Programm-
set start of variables low byte
     
.,A51D 84 2E STY $2E   ende speichern
set start of variables high byte
     
.,A51F A4 0B LDY $0B LDY COUNT
Zeilenlänge holen
get index to end of crunched line
     
.,A521 88 DEY DEY
und um 1 vermindern
-1
COPY LINE INTO PROGRAM
   
.,A522 B9 FC 01 LDA $01FC,Y STOLOP: LDA BUF-4,Y
Zeile aus Eingabepuffer
get byte from crunched line
     
.,A525 91 5F STA ($5F),Y STADY LOWTR
ins Programm kopieren
save byte to memory
     
.,A527 88 DEY DEY
Schon alle Zeichen?
decrement index
     
.,A528 10 F8 BPL $A522 BPL STOLOP
Nein: dann weiterkopieren
loop while more to do
reset execution, clear variables, flush stack, rebuild BASIC chain and do warm start

CLEAR ALL VARIABLES

RE-ESTABLISH ALL FORWARD LINKS
   
.,A52A 20 59 A6 JSR $A659 FINI: JSR RUNC ;DO CLEAR & SET UP STACK.
;AND SET [TXTPTR] TO [TXTTAB]-1.
CLR-Befehl
reset execution to start, clear variables and flush stack
CLEAR ALL VARIABLES
   
.,A52D 20 33 A5 JSR $A533 JSR LNKPRG ;FIX UP PROGRAM LINKS
Programmzeilen neu binden
rebuild BASIC line chaining
     
.,A530 4C 80 A4 JMP $A480 JMP MAIN
zur Eingabe-Warteschleife

BASIC-Zeilen neu binden

go do BASIC warm start

rebuild BASIC line chaining

   

relink basic program

.,A533 A5 2B LDA $2B LNKPRG: LDWD TXTTAB ;SET [INDEX] TO [TXTTAB].
Zeiger auf BASIC-Programm-
get start of memory low byte
POINT INDEX AT START OF PROGRAM
   
.,A535 A4 2C LDY $2C   start holen und
get start of memory high byte
     
.,A537 85 22 STA $22 STWD INDEX
und als Suchzeiger nach
set line start pointer low byte
     
.,A539 84 23 STY $23   $22/23 speichern
set line start pointer high byte
     
.,A53B 18 CLC CLC
;
; CHEAD GOES THROUGH PROGRAM STORAGE AND FIXES
; UP ALL THE LINKS. THE END OF EACH LINE IS FOUND
; BY SEARCHING FOR THE ZERO AT THE END.
; THE DOUBLE ZERO LINK IS USED TO DETECT THE END OF THE PROGRAM.
;
Carry löschen
clear carry for add
     
.,A53C A0 01 LDY #$01 CHEAD: LDYI 1
Zeiger laden
set index to pointer to next line high byte
HI-BYTE OF NEXT FORWARD PNTR
   
.,A53E B1 22 LDA ($22),Y LDADY INDEX ;ARRIVED AT DOUBLE ZEROES?
Zeilenadresse holen
get pointer to next line high byte
END OF PROGRAM YET?
   
.,A540 F0 1D BEQ $A55F BEQ LNKRTS
=0? Ja: dann RTS
exit if null, [EOT]
     
.,A542 A0 04 LDY #$04 LDYI 4
Zeiger auf erstes BASIC-
point to first code byte of line
there is always 1 byte + [EOL] as null entries are deleted
FIND END OF THIS LINE
   
.,A544 C8 INY CZLOOP: INY ;THERE IS AT LEAST ONE BYTE.
zeichen setzen
next code byte
(NOTE MAXIMUM LENGTH < 256)
   
.,A545 B1 22 LDA ($22),Y LDADY INDEX
Zeichen holen
get byte
     
.,A547 D0 FB BNE $A544 BNE CZLOOP ;NO, CONTINUE SEARCHING.
=0? (Zeilenende) nein: weiter
loop if not [EOL]
     
.,A549 C8 INY INY ;GO ONE BEYOND.
Zeilenlänge nach
point to byte past [EOL], start of next line
COMPUTE ADDRESS OF NEXT LINE
   
.,A54A 98 TYA TYA
Akku schieben
copy it
     
.,A54B 65 22 ADC $22 ADC INDEX
+ Zeiger auf aktuelle Zeile
add line start pointer low byte
     
.,A54D AA TAX TAX
(LOW) ins X-Register
copy to X
     
.,A54E A0 00 LDY #$00 LDYI 0
Zeiger laden
clear index, point to this line's next line pointer
STORE FORWARD PNTR IN THIS LINE
   
.,A550 91 22 STA ($22),Y STADY INDEX
Akku als Adr.zeiger (LOW)
set next line pointer low byte
     
.,A552 A5 23 LDA $23 LDA INDEX+1
Zeiger auf aktuelle
Zeile (HIGH)
get line start pointer high byte
     
.,A554 69 00 ADC #$00 ADCI 0
Übertrag addieren
add any overflow
(NOTE: THIS CLEARS CARRY)
   
.,A556 C8 INY INY
Zähler um 1 erhöhen
increment index to high byte
     
.,A557 91 22 STA ($22),Y STADY INDEX
Adresszeiger (HIGH) speichern
set next line pointer high byte
     
.,A559 86 22 STX $22 STX INDEX
Startadresse der nächsten
set line start pointer low byte
     
.,A55B 85 23 STA $23 STA INDEX+1
Zeile abspeichern
set line start pointer high byte
     
.,A55D 90 DD BCC $A53C BCCA CHEAD ;ALWAYS BRANCHES.
Zum Zeilenanfang
go do next line, branch always
...ALWAYS
   
.,A55F 60 RTS LNKRTS: RTS
;
; THIS IS THE LINE INPUT ROUTINE.
; IT READS CHARACTERS INTO BUF USING BACKARROW (UNDERSCORE, OR
; SHIFT O) AS THE DELETE CHARACTER AND @ AS THE
; LINE DELETE CHARACTER. IF MORE THAN BUFLEN CHARACTERS
; ARE TYPED, NO ECHOING IS DONE UNTIL A BACKARROW OR @ OR CR
; IS TYPED. CONTROL-G WILL BE TYPED FOR EACH EXTRA CHARACTER.
; THE ROUTINE IS ENTERED AT INLIN.
;
IFE REALIO-4,<
INLIN: LDXI 128 ;NO PROMPT CHARACTER
STX CQPRMP
JSR CQINLN ;GET A LINE ONTO PAGE 2
CPXI BUFLEN-1
BCS GDBUFS ;NOT TOO MANY CHARACTERS
LDXI BUFLEN-1
GDBUFS: LDAI 0 ;PUT A ZERO AT THE END
STA BUF,X
TXA
BEQ NOCHR
LOPBHT: LDA BUF-1,X
ANDI 127
STA BUF-1,X
DEX
BNE LOPBHT
NOCHR: LDAI 0
LDXYI <BUF-1> ;POINT AT THE BEGINNING
RTS>
IFN REALIO-4,<
IFN REALIO-3,<
LINLIN: IFE REALIO-2,<
JSR OUTDO> ;ECHO IT.
DEX ;BACKARROW SO BACKUP PNTR AND
BPL INLINC ;GET ANOTHER IF COUNT IS POSITIVE.
INLINN: IFE REALIO-2,<
JSR OUTDO> ;PRINT THE @ OR A SECOND BACKARROW
;IF THERE WERE TOO MANY.
JSR CRDO>
Rücksprung

Eingabe einer Zeile

call for BASIC input
   

get statement into buffer

.,A560 A2 00 LDX #$00 INLIN: LDXI 0
Zeiger setzen
set channel $00, keyboard
     
.,A562 20 12 E1 JSR $E112 INLINC: JSR INCHR ;GET A CHARACTER.
IFN REALIO-3,<
CMPI 7 ;IS IT BOB ALBRECHT RINGING THE BELL
;FOR SCHOOL KIDS?
BEQ GOODCH>
ein Zeichen holen
input character from channel with error check
     
.,A565 C9 0D CMP #$0D CMPI 13 ;CARRIAGE RETURN?
RETURN-Taste ?
compare with [CR]
     
.,A567 F0 0D BEQ $A576 BEQ FININ1 ;YES, FINISH UP.
IFN REALIO-3,<
CMPI 32 ;CHECK FOR FUNNY CHARACTERS.
BCC INLINC
CMPI 125 ;IS IT TILDA OR DELETE?
BCS INLINC ;BIG BAD ONES TOO.
CMPI "@" ;LINE DELETE?
BEQ INLINN ;YES.
CMPI "_" ;CHARACTER DELETE?
BEQ LINLIN> ;YES.
GOODCH:
IFN REALIO-3,<
CPXI BUFLEN-1 ;LEAVE ROOM FOR NULL.
;COMMO ASSURES US NEVER MORE THAN BUFLEN.
BCS OUTBEL>
ja, dann Eingabe beenden
if [CR] set XY to $200 - 1, print [CR] and exit
character was not [CR]
     
.,A569 9D 00 02 STA $0200,X STA BUF,X
Zeichen nach Eingabepuffer
save character to buffer
     
.,A56C E8 INX INX
Zeiger um 1 erhöhen
increment buffer index
     
.,A56D E0 59 CPX #$59 IFE REALIO-2,<SKIP2>
89. Zeichen ?
compare with max+1
     
.,A56F 90 F1 BCC $A562 IFN REALIO-2,<BNE INLINC>
nein, weitere Zeichen holen
branch if < max+1
     
.,A571 A2 17 LDX #$17 IFN REALIO-3,<
Nummer für 'string too long'
error $17, string too long error
    error number
.,A573 4C 37 A4 JMP $A437 OUTBEL: LDAI 7
Fehlermeldung ausgeben
do error #X then warm start
     
.,A576 4C CA AA JMP $AACA IFN REALIO,<
Puffer mit $0 abschließen, CR

Umwandlung einer Zeile in den

Interpreter-Code

set XY to $200 - 1 and print [CR]

crunch BASIC tokens vector

    goto end of line

crunch tokens

.,A579 6C 04 03 JMP ($0304) JSR OUTDO> ;ECHO IT.
BNE INLINC> ;CYCLE ALWAYS.
FININ1: JMP FININL> ;GO TO FININL FAR, FAR AWAY.
INCHR:
IFE REALIO-3,<
JSR CQINCH> ;FOR COMMODORE.
IFE REALIO-2,<
INCHRL: LDA ^O176000
REPEAT 4,<NOP>
LSR A,
BCC INCHRL
LDA ^O176001 ;GET THE CHARACTER.
REPEAT 4,<NOP>
ANDI 127>
IFE REALIO-1,<
JSR ^O17132> ;1E5A FOR MOS TECH.
IFE REALIO-4,<
JSR CQINCH ;FD0C FOR APPLE COMPUTER.
ANDI 127>
IFE REALIO,<
TJSR INSIM##> ;GET A CHARACTER FROM SIMULATOR
IFN REALIO,<
IFN EXTIO,<
LDY CHANNL ;CNT-O HAS NO EFFECT IF NOT FROM TERM.
BNE INCRTS>
CMPI CONTW ;SUPPRESS OUTPUT CHARACTER (^W).
BNE INCRTS ;NO, RETURN.
PHA
COM CNTWFL ;COMPLEMENT ITS STATE.
PLA>
INCRTS: RTS ;END OF INCHR.
;
; ALL "RESERVED" WORDS ARE TRANSLATED INTO SINGLE
; BYTES WITH THE MSB ON. THIS SAVES SPACE AND TIME
; BY ALLOWING FOR TABLE DISPATCH DURING EXECUTION.
; THEREFORE ALL STATEMENTS APPEAR TOGETHER IN THE
; RESERVED WORD LIST IN THE SAME ORDER THEY
; APPEAR IN STMDSP.
;
BUFOFS=0 ;THE AMOUNT TO OFFSET THE LOW BYTE
;OF THE TEXT POINTER TO GET TO BUF
;AFTER TXTPTR HAS BEEN SETUP TO POINT INTO BUF
IFN BUFPAG,<
BUFOFS=<BUF/256>*256>
JMP $A57C
do crunch BASIC tokens

crunch BASIC tokens, the crunch BASIC tokens vector is initialised to point here

TOKENIZE THE INPUT LINE

  normally A57C

standard token cruncher

.,A57C A6 7A LDX $7A CRUNCH: LDX TXTPTR ;SET SOURCE POINTER.
Zeiger setzen, erstes Zeichen
get BASIC execute pointer low byte
INDEX INTO UNPARSED LINE
   
.,A57E A0 04 LDY #$04 LDYI 4 ;SET DESTINATION OFFSET.
Wert für codierte Zeile
set save index
INDEX TO PARSED OUTPUT LINE
   
.,A580 84 0F STY $0F STY DORES ;ALLOW CRUNCHING.
Flag für Hochkomma
clear open quote/DATA flag
CLEAR SIGN-BIT OF DATAFLG
   
.,A582 BD 00 02 LDA $0200,X KLOOP: LDA BUFOFS,X
IFE REALIO-3,<
Zeichen aus Puffer holen
get a byte from the input buffer
     
.,A585 10 07 BPL $A58E BPL CMPSPC ;GO LOOK AT SPACES.
kein BASIC-Code ? kleiner 128
if b7 clear go do crunching
     
.,A587 C9 FF CMP #$FF CMPI PI ;PI??
Code für Pi ?
compare with the token for PI, this toke is input
directly from the keyboard as the PI character
    PI
.,A589 F0 3E BEQ $A5C9 BEQ STUFFH ;GO SAVE IT.
Ja: dann speichern
if PI save byte then continue crunching
this is the bit of code that stops you being able to enter
some keywords as just single shifted characters. If this
dropped through you would be able to enter GOTO as just
[SHIFT]G
     
.,A58B E8 INX INX ;SKIP NO PRINTING.
Zeiger erhöhen
increment read index
     
.,A58C D0 F4 BNE $A582 BNE KLOOP> ;ALWAYS GOES.
nächstes Zeichen überprüfen
loop if more to do, branch always
     
.,A58E C9 20 CMP #$20 CMPSPC: CMPI " " ;IS IT A SPACE TO SAVE?
' ' Leerzeichen?
compare with [SPACE]
IGNORE BLANKS
  space
.,A590 F0 37 BEQ $A5C9 BEQ STUFFH ;YES, GO SAVE IT.
Ja: dann speichern
if [SPACE] save byte then continue crunching
     
.,A592 85 08 STA $08 STA ENDCHR ;IF IT'S A QUOTE, THIS WILL
;STOP LOOP WHEN OTHER QUOTE APPEARS.
in Hochkomma-Flag speichern
save buffer byte as search character
     
.,A594 C9 22 CMP #$22 CMPI 34 ;QUOTE SIGN?
"'" Hochkomma?
compare with quote character
START OF QUOTATION?
  quote mark
.,A596 F0 56 BEQ $A5EE BEQ STRNG ;YES, DO SPECIAL STRING HANDLING.
Ja: dann speichern
if quote go copy quoted string
     
.,A598 24 0F BIT $0F BIT DORES ;TEST FLAG.
Überprüft auf Bit 6
get open quote/DATA token flag
     
.,A59A 70 2D BVS $A5C9 BVS STUFFH ;NO CRUNCH, JUST STORE.
gesetzt: ASCII speichern
branch if b6 of Oquote set, was DATA
go save byte then continue crunching
BRANCH IF IN "DATA" STATEMENT
   
.,A59C C9 3F CMP #$3F CMPI "?" ;A QMARK?
'?' Fragezeichen?
compare with "?" character
SHORTHAND FOR "PRINT"?
  question mark
.,A59E D0 04 BNE $A5A4 BNE KLOOP1
Nein: dann weiter prüfen
if not "?" continue crunching
NO
   
.,A5A0 A9 99 LDA #$99 LDAI PRINTK ;YES, STUFF A "PRINT" TOKEN.
PRINT-Code für ? laden
else the keyword token is $99, PRINT
YES, REPLACE WITH "PRINT" TOKEN
  PRINT code
.,A5A2 D0 25 BNE $A5C9 BNE STUFFH ;ALWAYS GO TO STUFFH.
und abspeichern
go save byte then continue crunching, branch always
...ALWAYS
   
.,A5A4 C9 30 CMP #$30 KLOOP1: CMPI "0" ;SKIP NUMERICS.
Kleiner $30 ? (Code für 0)
compare with "0"
IS IT A DIGIT, COLON, OR SEMI-COLON?
  0
.,A5A6 90 04 BCC $A5AC BCC MUSTCR
Ja: dann $A5AC
branch if <, continue crunching
NO, PUNCTUATION !"#$%&amp;'()*+,-./
   
.,A5A8 C9 3C CMP #$3C CMPI 60 ;":" AND ";" ARE ENTERED STRAIGHTAWAY.
Mit $3C vergleichen
compare with "<"
     
.,A5AA 90 1D BCC $A5C9 BCC STUFFH
wenn größer, dann $A5C9
if <, 0123456789:; go save byte then continue crunching
gets here with next character not numeric, ";" or ":"
YES, NOT A TOKEN

SEARCH TOKEN NAME TABLE FOR MATCH STARTING

WITH CURRENT CHAR FROM INPUT LINE

   
.,A5AC 84 71 STY $71 MUSTCR: STY BUFPTR ;SAVE BUFFER POINTER.
Zeiger Zwischenspeichern
copy save index
SAVE INDEX TO OUTPUT LINE
   
.,A5AE A0 00 LDY #$00 LDYI 0 ;LOAD RESLST POINTER.
Zähler für Tokentabelle
clear table pointer
USE Y-REG WITH (FAC) TO ADDRESS TABLE
   
.,A5B0 84 0B STY $0B STY COUNT ;ALSO CLEAR COUNT.
initialisieren
clear word index
HOLDS CURRENT TOKEN-$80
   
.,A5B2 88 DEY DEY
  adjust for pre increment loop
PREPARE FOR "INY" A FEW LINES DOWN
   
.,A5B3 86 7A STX $7A STX TXTPTR ;SAVE TEXT POINTER FOR LATER USE.
Zeiger auf Eingabepuffer
save BASIC execute pointer low byte, buffer index
SAVE POSITION IN INPUT LINE
   
.,A5B5 CA DEX DEX
zwischenspeichern
adjust for pre increment loop
PREPARE FOR "INX" A FEW LINES DOWN
   
.,A5B6 C8 INY RESER: INY
X- und Y-Register
next table byte
ADVANCE POINTER TO TOKEN TABLE
   
.,A5B7 E8 INX RESPUL: INX
um 1 erhöhen
next buffer byte
     
.,A5B8 BD 00 02 LDA $0200,X RESCON: LDA BUFOFS,X
Zeichen aus Puffer laden
get byte from input buffer
NEXT CHAR FROM INPUT LINE
   
.,A5BB 38 SEC SEC ;PREPARE TO SUBSTARCT.
Carry für Subtr. löschen
set carry for subtract
NO, COMPARE TO CHAR IN TABLE
   
.,A5BC F9 9E A0 SBC $A09E,Y SBC RESLST,Y ;CHARACTERS EQUAL?
Zeichen mit Befehlswort vergleichen
subtract table byte
SAME AS NEXT CHAR OF TOKEN NAME?
   
.,A5BF F0 F5 BEQ $A5B6 BEQ RESER ;YES, CONTINUE SEARCH.
Gefunden? Ja: nächstes Zeich.
go compare next if match
YES, CONTINUE MATCHING
   
.,A5C1 C9 80 CMP #$80 CMPI 128 ;NO BUT MAYBE THE END IS HERE.
mit $80 (128) vergleichen
was it end marker match ?
MAYBE; WAS IT SAME EXCEPT FOR BIT 7?
   
.,A5C3 D0 30 BNE $A5F5 BNE NTHIS ;NO, TRULY UNEQUAL.
Befehl nicht gefunden: $A5F5
branch if not, not found keyword
actually this works even if the input buffer byte is the
end marker, i.e. a shifted character. As you can't enter
any keywords as a single shifted character, see above,
you can enter keywords in shorthand by shifting any
character after the first. so RETURN can be entered as
R[SHIFT]E, RE[SHIFT]T, RET[SHIFT]U or RETU[SHIFT]R.
RETUR[SHIFT]N however will not work because the [SHIFT]N
will match the RETURN end marker so the routine will try
to match the next character.
else found keyword
NO, SKIP TO NEXT TOKEN
   
.,A5C5 05 0B ORA $0B ORA COUNT
BASIC-Code gleich Zähler +$80
OR with word index, +$80 in A makes token
YES, END OF TOKEN; GET TOKEN #
   
.,A5C7 A4 71 LDY $71 GETBPT: LDY BUFPTR ;GET BUFFER PNTR.
Zeiger auf cod. Zeile holen
restore save index
save byte then continue crunching
GET INDEX TO OUTPUT LINE IN Y-REG
   
.,A5C9 E8 INX STUFFH: INX
  increment buffer read index
ADVANCE INPUT INDEX
   
.,A5CA C8 INY INY
Zeiger erhöhen
increment save index
ADVANCE OUTPUT INDEX
   
.,A5CB 99 FB 01 STA $01FB,Y STA BUF-5,Y
BASIC-Code speichern
save byte to output
STORE CHAR OR TOKEN
   
.,A5CE B9 FB 01 LDA $01FB,Y LDA BUF-5,Y
und Statusregister setzen
get byte from output, set flags
TEST FOR EOL OR EOS
   
.,A5D1 F0 36 BEQ $A609 BEQ CRDONE ;NULL IMPLIES END OF LINE.
=0 (Ende): dann fertig
branch if was null [EOL]
A holds the token here
END OF LINE
   
.,A5D3 38 SEC SEC ;PREPARE TO SUBSTARCT.
Carry setzen (Subtraktion)
set carry for subtract
     
.,A5D4 E9 3A SBC #$3A SBCI ":" ;IS IT A ":"?
':' Trennzeichen?
subtract ":"
END OF STATEMENT?
  colon
.,A5D6 F0 04 BEQ $A5DC BEQ COLIS ;YES, ALLOW CRUNCHING AGAIN.
Ja: dann $A5DC
branch if it was (is now $00)
A now holds token-':'
YES, CLEAR DATAFLG
   
.,A5D8 C9 49 CMP #$49 CMPI DATATK-":" ;IS IT A DATATK?
DATA-Code ?
compare with the token for DATA-':'
"DATA" TOKEN?
  DATA code
.,A5DA D0 02 BNE $A5DE BNE NODATT ;NO, SEE IF IT IS REM TOKEN.
Nein: Speichern überspringen
if not DATA go try REM
token was : or DATA
NO, LEAVE DATAFLG ALONE
   
.,A5DC 85 0F STA $0F COLIS: STA DORES ;SETUP FLAG.
nach Hochkomma-Flag speichern
save the token-$3A
DATAFLG = 0 OR $83-$3A = $49
   
.,A5DE 38 SEC NODATT: SEC ;PREP TO SBCQ
Carry setzen
set carry for subtract
IS IT A "REM" TOKEN?
   
.,A5DF E9 55 SBC #$55 SBCI REMTK-":" ;REM ONLY STOPS ON NULL.
REM-Code ?
subtract the token for REM-':'
    REM code
.,A5E1 D0 9F BNE $A582 BNE KLOOP ;NO, CONTINUE CRUNCHING.
Nein: zum Schleifenanfang
if wasn't REM crunch next bit of line
NO, CONTINUE PARSING LINE
   
.,A5E3 85 08 STA $08 STA ENDCHR ;REM STOPS ONLY ON NULL, NOT : OR ".
0 in Hochkomma-Flag
else was REM so set search for [EOL]
loop for "..." etc.
YES, CLEAR LITERAL FLAG

HANDLE LITERAL (BETWEEN QUOTES) OR REMARK,

BY COPYING CHARS UP TO ENDCHR.

   
.,A5E5 BD 00 02 LDA $0200,X STR1: LDA BUFOFS,X
nächstes Zeichen holen
get byte from input buffer
     
.,A5E8 F0 DF BEQ $A5C9 BEQ STUFFH ;YES, END OF LINE, SO DONE.
=0 (Ende)? Ja: dann $A5C9
if null [EOL] save byte then continue crunching
END OF LINE
   
.,A5EA C5 08 CMP $08 CMP ENDCHR ;END OF GOBBLE?
Als ASCII speichern?
compare with stored character
     
.,A5EC F0 DB BEQ $A5C9 BEQ STUFFH ;YES, DONE WITH STRING.
Nein: dann $A5C9
if match save byte then continue crunching
FOUND ENDCHR
   
.,A5EE C8 INY STRNG: INY ;INCREMENT BUFFER POINTER.
Zeiger erhöhen
increment save index
NEXT OUTPUT CHAR
   
.,A5EF 99 FB 01 STA $01FB,Y STA BUF-5,Y
Code abspeichern
save byte to output
     
.,A5F2 E8 INX INX
Zeiger erhöhen
increment buffer index
NEXT INPUT CHAR
   
.,A5F3 D0 F0 BNE $A5E5 BNE STR1 ;PROCESS NEXT CHARACTER.
Zum Schleifenanfang
loop while <> 0, should never reach 0
not found keyword this go
...ALWAYS

ADVANCE POINTER TO NEXT TOKEN NAME

   
.,A5F5 A6 7A LDX $7A NTHIS: LDX TXTPTR ;RESTORE TEXT POINTER.
Zeiger wieder auf Eingabep.
restore BASIC execute pointer low byte
GET POINTER TO INPUT LINE IN X-REG
   
.,A5F7 E6 0B INC $0B INC COUNT ;INCREMENT RES WORD COUNT.
Suchzähler erhöhen
increment word index (next word)
now find end of this word in the table
BUMP (TOKEN # - $80)
   
.,A5F9 C8 INY NTHIS1: INY
Zähler erhöhen
increment table index
NEXT TOKEN ONE BEYOND THAT
   
.,A5FA B9 9D A0 LDA $A09D,Y LDA RESLST-1,Y, ;GET RES CHARACTER.
nächsten Befehl suchen
get table byte
YES, AT NEXT NAME. END OF TABLE?
   
.,A5FD 10 FA BPL $A5F9 BPL NTHIS1 ;END OF ENTRY?
Gefunden? Nein: weitersuchen
loop if not end of word yet
     
.,A5FF B9 9E A0 LDA $A09E,Y LDA RESLST,Y, ;YES. IS IT THE END?
Ende der Tabelle?
get byte from keyword table
     
.,A602 D0 B4 BNE $A5B8 BNE RESCON ;NO, TRY THE NEXT WORD.
Nein: dann weiter
go test next word if not zero byte, end of table
reached end of table with no match
NO, NOT END OF TABLE
   
.,A604 BD 00 02 LDA $0200,X LDA BUFOFS,X ;YES, END OF TABLE. GET 1ST CHR.
nächstes Zeichen holen
restore byte from input buffer
YES, SO NOT A KEYWORD
   
.,A607 10 BE BPL $A5C7 BPL GETBPT ;STORE IT AWAY (ALWAYS BRANCHES).
kleiner $80? Ja: $A5C7
branch always, all unmatched bytes in the buffer are
$00 to $7F, go save byte in output and continue crunching
reached [EOL]
...ALWAYS, COPY CHAR AS IS
END OF LINE
   
.,A609 99 FD 01 STA $01FD,Y CRDONE: STA BUF-3,Y, ;SO THAT IF THIS IS A DIR STATEMENT
;ITS END WILL LOOK LIKE END OF PROGRAM.
IFN <<BUF+BUFLEN>/256>-<<BUF-1>/256>,<
im Eingabepuffer speichern
save [EOL]
STORE ANOTHER 00 ON END
   
.,A60C C6 7B DEC $7B DEC TXTPTR+1>
CHRGET-Zeiger zurücksetzen
decrement BASIC execute pointer high byte
SET TXTPTR = INPUT.BUFFER-1
   
.,A60E A9 FF LDA #$FF LDAI <BUF&255>-1 ;MAKE TXTPTR POINT TO
Zeiger auf Eingabepuffer -1
point to start of buffer-1
     
.,A610 85 7A STA $7A STA TXTPTR ;CRUNCHED LINE.
setzen (LOW)
set BASIC execute pointer low byte
     
.,A612 60 RTS LISTRT: RTS ;RETURN TO CALLER.
;
; FNDLIN SEARCHES THE PROGRAM TEXT FOR THE LINE
; WHOSE NUMBER IS PASSED IN "LINNUM".
; THERE ARE TWO POSSIBLE RETURNS:
;
; 1) CARRY SET.
; LOWTR POINTS TO THE LINK FIELD IN THE LINE
; WHICH IS THE ONE SEARCHED FOR.
;
; 2) CARRY NOT SET.
; LINE NOT FOUND. [LOWTR] POINTS TO THE LINE IN THE
; PROGRAM GREATER THAN THE ONE SOUGHT AFTER.
;
Rücksprung

Startadresse einer

Programmzeile berechnen

search BASIC for temporary integer line number

SEARCH FOR LINE

(LINNUM) = LINE # TO FIND
IF NOT FOUND: CARRY = 0
LOWTR POINTS AT NEXT LINE
IF FOUND: CARRY = 1
LOWTR POINTS AT LINE
 

search for a line in a program

.,A613 A5 2B LDA $2B FNDLIN: LDWX TXTTAB ;LOAD [X,A] WITH [TXTTAB]
Zeiger auf BASIC-
get start of memory low byte
SEARCH FROM BEGINNING OF PROGRAM
   
.,A615 A6 2C LDX $2C   Programmstart laden
get start of memory high byte

search Basic for temp integer line number from AX

returns carry set if found
     
.,A617 A0 01 LDY #$01 FNDLNC: LDYI 1
Zähler setzen
set index to next line pointer high byte
SEARCH FROM (X,A)
   
.,A619 85 5F STA $5F STWX LOWTR ;STORE [X,A] INTO LOWTR
BASIC-Programmstart als
save low byte as current
     
.,A61B 86 60 STX $60   Zeiger nach $5F/60
save high byte as current
     
.,A61D B1 5F LDA ($5F),Y LDADY LOWTR ;SEE IF LINK IS 0
Link-Adresse holen (HIGH)
get next line pointer high byte from address
     
.,A61F F0 1F BEQ $A640 BEQ FLINRT
gleich null: dann Ende
pointer was zero so done, exit
END OF PROGRAM, AND NOT FOUND
   
.,A621 C8 INY INY
Zähler 2 mal erhöhen ( LOW-
increment index ...
     
.,A622 C8 INY INY
Byte übergehen)
... to line # high byte
     
.,A623 A5 15 LDA $15 LDA LINNUM+1 ;COMP HIGH ORDERS OF LINE NUMBERS.
gesuchte Zeilennummer (HIGH)
get temporary integer high byte
     
.,A625 D1 5F CMP ($5F),Y CMPDY LOWTR
mit aktueller vergleichen
compare with line # high byte
     
.,A627 90 18 BCC $A641 BCC FLNRTS ;NO SUCH LINE NUMBER.
kleiner: dann nicht gefunden
exit if temp < this line, target line passed
IF NOT FOUND
   
.,A629 F0 03 BEQ $A62E BEQ FNDLO1
gleich: Nummer LOW prüfen
go check low byte if =
     
.,A62B 88 DEY DEY
Zähler um 1 vermindern
else decrement index
     
.,A62C D0 09 BNE $A637 BNE AFFRTS ;ALWAYS BRANCH.
unbedingter Sprung
branch always
     
.,A62E A5 14 LDA $14 FNDLO1: LDA LINNUM
gesuchte Zeilennummer (LOW)
get temporary integer low byte
     
.,A630 88 DEY DEY
Zeiger um 1 vermindern
decrement index to line # low byte
     
.,A631 D1 5F CMP ($5F),Y CMPDY LOWTR ;COMPARE LOW ORDERS.
Zeilennummer LOW vergleichen
compare with line # low byte
     
.,A633 90 0C BCC $A641 BCC FLNRTS ;NO SUCH NUMBER.
kleiner: Zeile nicht gefunden
exit if temp < this line, target line passed
PAST LINE, NOT FOUND
   
.,A635 F0 0A BEQ $A641 BEQ FLNRTS ;GO TIT.
oder gleich: C=1 und RTS
exit if temp = (found line#)
not quite there yet
IF FOUND
   
.,A637 88 DEY AFFRTS: DEY
Y-Register auf 1 setzen
decrement index to next line pointer high byte
     
.,A638 B1 5F LDA ($5F),Y LDADY LOWTR ;FETCH LINK.
Adresse der nächsten Zeile
get next line pointer high byte
     
.,A63A AA TAX TAX
in das X-Register laden
copy to X
     
.,A63B 88 DEY DEY
Register vermindern (auf 0)
decrement index to next line pointer low byte
     
.,A63C B1 5F LDA ($5F),Y LDADY LOWTR
Link-Adresse holen (LOW)
get next line pointer low byte
     
.,A63E B0 D7 BCS $A617 BCS FNDLNC ;ALWAYS BRANCHES.
weiter suchen
go search for line # in temporary integer
from AX, carry always set
ALWAYS
   
.,A640 18 CLC FLINRT: CLC ;C MAY BE HIGH.
Carry löschen
clear found flag
RETURN CARRY = 0
   
.,A641 60 RTS FLNRTS: RTS ;RETURN TO CALLER.
;
; THE "NEW" COMMAND CLEARS THE PROGRAM TEXT AS WELL
; AS VARIABLE SPACE.
;
Rücksprung

BASIC-Befehl NEW

perform NEW

"NEW" STATEMENT

 

NEW command

.,A642 D0 FD BNE $A641 SCRATH: BNE FLNRTS ;MAKE SURE THERE IS A TERMINATOR.
Kein Trennzeichen: SYNTAX
ERROR
exit if following byte to allow syntax error
IGNORE IF MORE TO THE STATEMENT
   
.,A644 A9 00 LDA #$00 SCRTCH: LDAI 0 ;GET A CLEARER.
Nullcode laden
clear A
     
.,A646 A8 TAY TAY ;SET UP INDEX.
und als Zähler ins Y-Reg.
clear index
     
.,A647 91 2B STA ($2B),Y STADY TXTTAB ;CLEAR FIRST LINK.
Nullcode an Programmanfang
clear pointer to next line low byte
     
.,A649 C8 INY INY
Zähler erhöhen
increment index
     
.,A64A 91 2B STA ($2B),Y STADY TXTTAB
noch einen Nullcode dahinter
clear pointer to next line high byte, erase program
     
.,A64C A5 2B LDA $2B LDA TXTTAB
Zeiger auf Programmst. (LOW)
get start of memory low byte
     
.,A64E 18 CLC CLC
Carry löschen
clear carry for add
     
.,A64F 69 02 ADC #$02 ADCI 2
Programmstart + 2 ergibt
add null program length
     
.,A651 85 2D STA $2D STA VARTAB ;SETUP [VARTAB].
neuen Variablenstart (LOW)
set start of variables low byte
     
.,A653 A5 2C LDA $2C LDA TXTTAB+1
Zeiger auf Programmst. (HIGH)
get start of memory high byte
     
.,A655 69 00 ADC #$00 ADCI 0
+ Übertrag ergibt neuen
add carry
     
.,A657 85 2E STA $2E STA VARTAB+1
Variablenstart (HIGH)
set start of variables high byte

reset execute pointer and do CLR

     
.,A659 20 8E A6 JSR $A68E RUNC: JSR STXTPT
CHRGET, Routine neu setzen
set BASIC execute pointer to start of memory - 1
SET TXTPTR TO TXTTAB - 1
   
.,A65C A9 00 LDA #$00 LDAI 0 ;SET ZERO FLAG
;
; THIS CODE IS FOR THE CLEAR COMMAND.
;
Zero-Flag für CLR = 1 setzen

BASIC-Befehl CLR

set Zb for CLR entry

perform CLR

(THIS COULD HAVE BEEN ".HS 2C")

"CLEAR" STATEMENT

 

CLR command

.,A65E D0 2D BNE $A68D CLEAR: BNE STKRTS ;SYNTAX ERROR IF NO TERMINATOR.
;
; CLEAR INITIALIZES THE VARIABLE AND
; ARRAY SPACE BY RESETING ARYTAB (THE END OF SIMPLE VARIABLE SPACE)
; AND STREND (THE END OF ARRAY STORAGE). IT FALLS INTO "STKINI"
; WHICH RESETS THE STACK.
Kein Trennzeichen: SYNTAX
ERROR
exit if following byte to allow syntax error
IGNORE IF NOT AT END OF STATEMENT
   
.,A660 20 E7 FF JSR $FFE7 ;
alle I/O Kanäle zurücksetzen
close all channels and files
     
.,A663 A5 37 LDA $37 CLEARC: LDWD MEMSIZ ;FREE UP STRING SPACE.
Zeiger auf BASIC-RAM-Ende
get end of memory low byte
CLEAR STRING AREA
   
.,A665 A4 38 LDY $38   (LOW/HIGH) laden
get end of memory high byte
     
.,A667 85 33 STA $33 STWD FRETOP
String-Start auf BASIC-
set bottom of string space low byte, clear strings
     
.,A669 84 34 STY $34 IFN EXTIO,<
JSR CQCALL> ;CLOSE ALL OPEN FILES.
RAM-Ende setzen
set bottom of string space high byte
     
.,A66B A5 2D LDA $2D LDWD VARTAB ;LIBERATE THE
Zeiger auf Variablen-
get start of variables low byte
CLEAR ARRAY AREA
   
.,A66D A4 2E LDY $2E   start laden
get start of variables high byte
     
.,A66F 85 2F STA $2F STWD ARYTAB ;VARIABLES AND
und in Array-Anfangs-
set end of variables low byte, clear variables
     
.,A671 84 30 STY $30   zeiger setzen
set end of variables high byte
     
.,A673 85 31 STA $31 STWD STREND ;ARRAYS.
und in Zeiger auf Array-
set end of arrays low byte, clear arrays
LOW END OF FREE SPACE
   
.,A675 84 32 STY $32   Ende speichern
set end of arrays high byte

do RESTORE and clear stack

     
.,A677 20 1D A8 JSR $A81D FLOAD: JSR RESTOR ;RESTORE DATA.
;
; STKINI RESETS THE STACK POINTER ELIMINATING
; GOSUB AND FOR CONTEXT. STRING TEMPORARIES ARE FREED
; UP, SUBFLG IS RESET. CONTINUING IS PROHIBITED.
; AND A DUMMY ENTRY IS LEFT AT THE BOTTOM OF THE STACK SO "FNDFOR" WILL ALWAYS
; FIND A NON-"FOR" ENTRY AT THE BOTTOM OF THE STACK.
;
RESTORE-Befehl
perform RESTORE

flush BASIC stack and clear the continue pointer

SET "DATA" POINTER TO BEGINNING
 

reset stack and program pointers

.,A67A A2 19 LDX #$19 STKINI: LDXI TEMPST ;INITIALIZE STRING TEMPORARIES.
Wert laden und String-
get the descriptor stack start
     
.,A67C 86 16 STX $16 STX TEMPPT
Descriptor-Index zurücksetzen
set the descriptor stack pointer
     
.,A67E 68 PLA PLA ;SETUP RETURN ADDRESS.
2 Bytes vom Stapel in das
pull the return address low byte
SAVE RETURN ADDRESS
   
.,A67F A8 TAY TAY
Y-Register und den
copy it
     
.,A680 68 PLA PLA
Akku holen
pull the return address high byte
     
.,A681 A2 FA LDX #$FA LDXI STKEND-257
Wert laden und damit
set the cleared stack pointer
START STACK AT $F8,
   
.,A683 9A TXS TXS
Stapelzeiger initialisieren
set the stack
LEAVING ROOM FOR PARSING LINES
   
.,A684 48 PHA PHA
2 Bytes aus dem Y-Register
push the return address high byte
RESTORE RETURN ADDRESS
   
.,A685 98 TYA TYA
und dem Akku wieder auf
restore the return address low byte
     
.,A686 48 PHA PHA
den Stapel schieben
push the return address low byte
     
.,A687 A9 00 LDA #$00 LDAI 0
Wert laden und damit
clear A
     
.,A689 85 3E STA $3E STA OLDTXT+1 ;DISALLOWING CONTINUING
CONT sperren
clear the continue pointer high byte
     
.,A68B 85 10 STA $10 STA SUBFLG ;ALLOW SUBSCRIPTS.
und in FN-Flag speichern
clear the subscript/FNX flag
     
.,A68D 60 RTS STKRTS: RTS
Rücksprung

Programmzeiger auf

BASIC-Start

set BASIC execute pointer to start of memory - 1

SET TXTPTR TO BEGINNING OF PROGRAM

 

set current character pointer to start of basic - 1

.,A68E 18 CLC STXTPT: CLC
Carry löschen (Addition)
clear carry for add
TXTPTR = TXTTAB - 1
   
.,A68F A5 2B LDA $2B LDA TXTTAB
Zeiger auf Programmstart (LOW)
get start of memory low byte
     
.,A691 69 FF ADC #$FF ADCI 255
minus 1 ergibt
add -1 low byte
     
.,A693 85 7A STA $7A STA TXTPTR
neuen CHRGET-Zeiger (LOW)
set BASIC execute pointer low byte
     
.,A695 A5 2C LDA $2C LDA TXTTAB+1
Programmstart (HIGH)
get start of memory high byte
     
.,A697 69 FF ADC #$FF ADCI 255
minus 1 ergibt
add -1 high byte
     
.,A699 85 7B STA $7B STA TXTPTR+1 ;SETUP TEXT POINTER.
CHRGET-Zeiger (HIGH)
save BASIC execute pointer high byte
     
.,A69B 60 RTS RTS
PAGE

THE "LIST" COMMAND.

Rücksprung

BASIC Befehl LIST

perform LIST

"LIST" STATEMENT

 

LIST command

.,A69C 90 06 BCC $A6A4 LIST: BCC GOLST ;IT IS A DIGIT.
Ziffer ? (Zeilennummer)
branch if next character not token (LIST n...)
NO LINE # SPECIFIED
   
.,A69E F0 04 BEQ $A6A4 BEQ GOLST ;IT IS A TERMINATOR.
nur LIST ?
branch if next character [NULL] (LIST)
---DITTO---
   
.,A6A0 C9 AB CMP #$AB CMPI MINUTK ;DASH PRECEDING?
Code für '-'?
compare with token for -
IF DASH OR COMMA, START AT LINE 0
   
.,A6A2 D0 E9 BNE $A68D BNE STKRTS ;NO, SO SYNTAX ERROR.
anderer Code, dann SYNTAX ERR
exit if not - (LIST -m)
LIST [[n][-m]]
this bit sets the n , if present, as the start and end
NO, ERROR
   
.,A6A4 20 6B A9 JSR $A96B GOLST: JSR LINGET ;GET LINE NUMBER INTO NUMLIN.
Zeilennummer holen
get fixed-point number into temporary integer
CONVERT LINE NUMBER IF ANY
   
.,A6A7 20 13 A6 JSR $A613 JSR FNDLIN ;FIND LINE .GE. [NUMLIN].
Startadresse berechnen
search BASIC for temporary integer line number
POINT LOWTR TO 1ST LINE
   
.,A6AA 20 79 00 JSR $0079 JSR CHRGOT ;GET LAST CHARACTER.
CHRGOT letztes Zeichen holen
scan memory
RANGE SPECIFIED?
   
.,A6AD F0 0C BEQ $A6BB BEQ LSTEND ;IF END OF LINE, # IS THE END.
keine Zeilennummer
branch if no more chrs
this bit checks the - is present
NO
   
.,A6AF C9 AB CMP #$AB CMPI MINUTK ;DASH?
Code für '-'?
compare with token for -
     
.,A6B1 D0 8E BNE $A641 BNE FLNRTS ;IF NOT, SYNTAX ERROR.
nein: SYNTAX ERROR
return if not "-" (will be SN error)
LIST [n]-m
the - was there so set m as the end value
     
.,A6B3 20 73 00 JSR $0073 JSR CHRGET ;GET NEXT CHAR.
CHRGET nächstes Zeichen holen
increment and scan memory
GET NEXT CHAR
   
.,A6B6 20 6B A9 JSR $A96B JSR LINGET ;GET END #.
Zeilennummer holen
get fixed-point number into temporary integer
CONVERT SECOND LINE #
   
.,A6B9 D0 86 BNE $A641 BNE FLNRTS ;IF NOT TERMINATOR, ERROR.
kein Trennzeichen: SYNTAX ERR
exit if not ok
BRANCH IF SYNTAX ERR
   
.,A6BB 68 PLA LSTEND: PLA
2 Bytes von Stapel holen
dump return address low byte, exit via warm start
POP RETURN ADRESS
   
.,A6BC 68 PLA PLA ;GET RID OF "NEWSTT" RTS ADDR.
(Rücksprungadresse übergehen)
dump return address high byte
(GET BACK BY "JMP NEWSTT")
   
.,A6BD A5 14 LDA $14 LDA LINNUM ;SEE IF IT WAS EXISTENT.
zweite Zeilennummer laden
get temporary integer low byte
IF NO SECOND NUMBER, USE $FFFF
   
.,A6BF 05 15 ORA $15 ORA LINNUM+1
gleich null ?
OR temporary integer high byte
     
.,A6C1 D0 06 BNE $A6C9 BNE LIST4 ;IT WAS TYPED.
Nein: $A6C9
branch if start set
THERE WAS A SECOND NUMBER
   
.,A6C3 A9 FF LDA #$FF LDAI 255
Wert laden und
set for -1
MAX END RANGE
   
.,A6C5 85 14 STA $14 STA LINNUM
zweite Zeilennummer Maximal-
set temporary integer low byte
     
.,A6C7 85 15 STA $15 STA LINNUM+1 ;MAKE IT HUGE.
wert $FFFF (65535)
set temporary integer high byte
   

list lines from $5F/$60 to $14/$15

.,A6C9 A0 01 LDY #$01 LIST4: LDYI 1
IFE REALIO-3,<
Zeiger setzen
set index for line
     
.,A6CB 84 0F STY $0F STY DORES>
und Quote Modus abschalten
clear open quote flag
     
.,A6CD B1 5F LDA ($5F),Y LDADY LOWTR ;IS LINK ZERO?
Linkadresse HIGH holen
get next line pointer high byte
HIGH BYTE OF LINK
   
.,A6CF F0 43 BEQ $A714 BEQ GRODY ;YES, GO TO READY.
IFN REALIO,<
Ja: dann fertig
if null all done so exit
END OF PROGRAM
   
.,A6D1 20 2C A8 JSR $A82C JSR ISCNTC> ;LISTEN FOR CONT-C.
prüft auf Stop-Taste
do CRTL-C check vector
CHECK IF CONTROL-C HAS BEEN TYPED
   
.,A6D4 20 D7 AA JSR $AAD7 JSR CRDO ;PRINT CRLF TO START WITH.
"CR" ausgeben, neue Zeile
print CR/LF
NO, PRINT <RETURN>
   
.,A6D7 C8 INY INY
Zeiger erhöhen
increment index for line
     
.,A6D8 B1 5F LDA ($5F),Y LDADY LOWTR
Zeilenadresse holen (LOW)
get line number low byte
GET LINE #, COMPARE WITH END RANGE
   
.,A6DA AA TAX TAX
und in das X-Reg. schieben
copy to X
     
.,A6DB C8 INY INY
Zeiger erhöhen
increment index
     
.,A6DC B1 5F LDA ($5F),Y LDADY LOWTR ;GET LINE NUMBER.
Zeilenadresse holen (HIGH)
get line number high byte
     
.,A6DE C5 15 CMP $15 CMP LINNUM+1 ;SEE IF BEYOND LAST.
mit Endnummer vergleichen
compare with temporary integer high byte
     
.,A6E0 D0 04 BNE $A6E6 BNE TSTDUN ;GO DETERMINE RELATION.
Gleich? Nein: $A6E6
branch if no high byte match
     
.,A6E2 E4 14 CPX $14 CPX LINNUM ;WAS EQUAL SO TEST LOW ORDER.
LOW-Nummer vergleichen
compare with temporary integer low byte
     
.,A6E4 F0 02 BEQ $A6E8 BEQ TYPLIN ;EQUAL, SO LIST IT.
Gleich? Ja: $A6E8
branch if = last line to do, < will pass next branch
else
ON LAST LINE OF RANGE
   
.,A6E6 B0 2C BCS $A714 TSTDUN: BCS GRODY ;IF LINE IS GR THAN LAST, THEN DUNE.
Größer: dann fertig
if greater all done so exit
FINISHED THE RANGE
LIST ONE LINE
   
.,A6E8 84 49 STY $49 TYPLIN: STY LSTPNT
Y-Reg. Zwischenspeichern
save index for line
     
.,A6EA 20 CD BD JSR $BDCD JSR LINPRT ;PRINT AS INT WITHOUT LEADING SPACE.
Zeilennnummer ausgeben
print XA as unsigned integer
PRINT LINE # FROM X,A
   
.,A6ED A9 20 LDA #$20 LDAI " " ;ALWAYS PRINT SPACE AFTER NUMBER.
' ' Leerzeichen
space is the next character
PRINT SPACE AFTER LINE #
   
.,A6EF A4 49 LDY $49 PRIT4: LDY LSTPNT ;GET POINTER TO LINE BACK.
Y-Reg. wiederholen
get index for line
     
.,A6F1 29 7F AND #$7F ANDI 127
Bit 7 löschen
mask top out bit of character
     
.,A6F3 20 47 AB JSR $AB47 PLOOP: JSR OUTDO ;PRINT CHAR.
IFE REALIO-3,<
Zeichen ausgeben
go print the character
     
.,A6F6 C9 22 CMP #$22 CMPI 34
'"' Hochkomma ?
was it " character
     
.,A6F8 D0 06 BNE $A700 BNE PLOOP1
Nein: $A700
if not skip the quote handle
we are either entering or leaving a pair of quotes
     
.,A6FA A5 0F LDA $0F COM DORES> ;IF QUOTE, COMPLEMENT FLAG.
Hochkomma-Flag laden,
get open quote flag
     
.,A6FC 49 FF EOR #$FF   umdrehen (NOT)
toggle it
     
.,A6FE 85 0F STA $0F   und wieder abspeichern
save it back
     
.,A700 C8 INY PLOOP1: INY
Zeilenende nach 255 Zeichen ?
increment index
     
.,A701 F0 11 BEQ $A714 BEQ GRODY ;IF WE HAVE PRINTED 256 CHARACTERS
;THE PROGRAM MUST BE MISFORMATED IN
;MEMORY DUE TO A BAD LOAD OR BAD
;HARDWARE. LET THE GUY RECOVER
Nein: dann aufhören
line too long so just bail out and do a warm start
     
.,A703 B1 5F LDA ($5F),Y LDADY LOWTR ;GET NEXT CHAR. IS IT ZERO?
Zeichen holen
get next byte
     
.,A705 D0 10 BNE $A717 BNE QPLOP ;YES. END OF LINE.
kein Zeilenende, dann listen
if not [EOL] (go print character)
was [EOL]
NOT END OF LINE YET
   
.,A707 A8 TAY TAY
Akku als Zeiger nach Y
else clear index
END OF LINE
   
.,A708 B1 5F LDA ($5F),Y LDADY LOWTR
Startadresse der nächsten
get next line pointer low byte
GET LINK TO NEXT LINE
   
.,A70A AA TAX TAX
Zeile holen (LOW) und nach X
copy to X
     
.,A70B C8 INY INY
Zeiger erhöhen
increment index
     
.,A70C B1 5F LDA ($5F),Y LDADY LOWTR
Adresse der Zeile (HIGH)
get next line pointer high byte
     
.,A70E 86 5F STX $5F STX LOWTR
als Zeiger merken
set pointer to line low byte
POINT TO NEXT LINE
   
.,A710 85 60 STA $60 STA LOWTR+1
(speichern nach $5F/60) und
set pointer to line high byte
     
.,A712 D0 B5 BNE $A6C9 BNE LIST4 ;BRANCH IF SOMETHING TO LIST.
weitermachen
go do next line if not [EOT]
else ...
BRANCH IF NOT END OF PROGRAM
   
.,A714 4C 86 E3 JMP $E386 GRODY: JMP READY
zum BASIC-Warmstart

BASIC Code in Klartext

umwandlen

do warm start
TO NEXT STATEMENT
 

print tokens routine

.,A717 6C 06 03 JMP ($0306) ;IS IT A TOKEN?
JMP $A71A
do uncrunch BASIC tokens

uncrunch BASIC tokens, the uncrunch BASIC tokens vector is initialised to point here

    normally A71A

standard token printer

.,A71A 10 D7 BPL $A6F3 QPLOP: BPL PLOOP ;NO, HEAD FOR PRINTER.
IFE REALIO-3,<
kein Interpretercode:ausgeben
just go print it if not token byte
else was token byte so uncrunch it
BRANCH IF NOT A TOKEN
   
.,A71C C9 FF CMP #$FF CMPI PI
Code für Pi?
compare with the token for PI. in this case the token
is the same as the PI character so it just needs printing
     
.,A71E F0 D3 BEQ $A6F3 BEQ PLOOP
Ja: so ausgeben
just print it if so
     
.,A720 24 0F BIT $0F BIT DORES ;INSIDE QUOTE MARKS?
Hochkommamodus ?
test the open quote flag
     
.,A722 30 CF BMI $A6F3 BMI PLOOP> ;YES, JUST TYPE THE CHARACTER.
dann Zeichen so ausgeben
just go print character if open quote set
     
.,A724 38 SEC SEC
Carry setzen (Subtraktion)
else set carry for subtract
     
.,A725 E9 7F SBC #$7F SBCI 127 ;GET RID OF SIGN BIT AND ADD 1.
Offset abziehen
reduce token range to 1 to whatever
CONVERT TOKEN TO INDEX
   
.,A727 AA TAX TAX ;MAKE IT A COUNTER.
Code nach X
copy token # to X
     
.,A728 84 49 STY $49 STY LSTPNT ;SAVE POINTER TO LINE.
Zeichenzeiger merken
save index for line
SAVE LINE POINTER
   
.,A72A A0 FF LDY #$FF LDYI 255 ;LOOK AT RES'D WORD LIST.
Zeiger auf Befehlstabelle
start from -1, adjust for pre increment
     
.,A72C CA DEX RESRCH: DEX ;IS THIS THE RES'D WORD?
erstes Befehlswort?
decrement token #
SKIP KEYWORDS UNTIL REACH THIS ONE
   
.,A72D F0 08 BEQ $A737 BEQ PRIT3 ;YES, GO TOSS IT UP..
Ja: ausgeben
if now found go do printing
     
.,A72F C8 INY RESCR1: INY
Zeiger erhöhen
else increment index
     
.,A730 B9 9E A0 LDA $A09E,Y LDA RESLST,Y, ;END OF ENTRY?
Offset für X-tes Befehlswort
get byte from keyword table
     
.,A733 10 FA BPL $A72F BPL RESCR1 ;NO, CONTINUE PASSING.
alle Zeichen bis zum letzen
loop until keyword end marker
NOT AT END OF KEYWORD YET
   
.,A735 30 F5 BMI $A72C BMI RESRCH
überlesen (Bit 7 gesetzt)
go test if this is required keyword, branch always
found keyword, it's the next one
END OF KEYWORD, ALWAYS BRANCHES
 

print keyword

.,A737 C8 INY PRIT3: INY
Zeiger erhöhen
increment keyword table index
     
.,A738 B9 9E A0 LDA $A09E,Y LDA RESLST,Y
Befehlswort aus Tabelle holen
get byte from table
     
.,A73B 30 B2 BMI $A6EF BMI PRIT4 ;END OF RESERVED WORD.
letzter Buchstabe: fertig
go restore index, mask byte and print if
byte was end marker
LAST CHAR OF KEYWORD
   
.,A73D 20 47 AB JSR $AB47 JSR OUTDO ;PRINT IT.
Zeichen ausgeben
else go print the character
     
.,A740 D0 F5 BNE $A737 BNE PRIT3 ;END OF ENTRY? NO, TYPE REST.
PAGE

THE "FOR" STATEMENT.

;
; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS
; TOKEN (FORTK) 1 BYTE
; A POINTER TO THE LOOP VARIABLE 2 BYTES
; THE STEP 4+ADDPRC BYTES
; A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
; THE UPPER VALUE 4+ADDPRC BYTES
; THE LINE NUMBER OF THE "FOR" STATEMENT 2 BYTES
; A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
; HIGH ADDRESS
;
; TOTAL 16+2*ADDPRC BYTES.
;
nächsten Buchstaben ausgeben

BASIC-Befehl FOR

go get next character, branch always

perform FOR

...ALWAYS

"FOR" STATEMENT

FOR PUSHES 18 BYTES ON THE STACK:
2 -- TXTPTR
2 -- LINE NUMBER
5 -- INITIAL (CURRENT) FOR VARIABLE VALUE
1 -- STEP SIGN
5 -- STEP VALUE
2 -- ADDRESS OF FOR VARIABLE IN VARTAB
1 -- FOR TOKEN ($81)
 

FOR command

.,A742 A9 80 LDA #$80 FOR: LDAI 128 ;DON'T RECOGNIZE
Wert laden und
set FNX
     
.,A744 85 10 STA $10 STA SUBFLG ;SUBSCRIPTED VARIABLES.
Integer sperren
set subscript/FNX flag
SUBSCRIPTS NOT ALLOWED
   
.,A746 20 A5 A9 JSR $A9A5 JSR LET ;READ THE VARIABLE AND ASSIGN IT
;THE CORRECT INITIAL VALUE AND STORE
;A POINTER TO THE VARIABLE IN VARPNT.
LET, setzt FOR-Variable
perform LET
DO <VAR> = <EXP>, STORE ADDR IN FORPNT
   
.,A749 20 8A A3 JSR $A38A JSR FNDFOR ;PNTR IS IN VARPNT, AND FORPNT.
sucht offene FOR-NEXT-Schlei.
search the stack for FOR or GOSUB activity
IS THIS FOR VARIABLE ACTIVE?
   
.,A74C D0 05 BNE $A753 BNE NOTOL ;IF NO MATCH, DON'T ELIMINATE ANYTHING.
nicht gefunden: $A753
branch if FOR, this variable, not found
FOR, this variable, was found so first we dump the old one
NO
   
.,A74E 8A TXA TXA ;MAKE IT ARITHMETICAL.
X-Reg. nach Akku
copy index
YES, CANCEL IT AND ENCLOSED LOOPS
   
.,A74F 69 0F ADC #$0F ADCI FORSIZ-3 ;ELIMINATE ALMOST ALL.
Stapelzejger erhöhen
add FOR structure size-2
CARRY=1, THIS ADDS 16
   
.,A751 AA TAX TAX ;NOTE C=1, THEN PLA, PLA.
Akku zurück nach X-Reg. und
copy to index
X WAS ALREADY S+2
   
.,A752 9A TXS TXS ;MANIFEST.
in den Stapelzeiger
set stack (dump FOR structure (-2 bytes))
     
.,A753 68 PLA NOTOL: PLA ;GET RID OF NEWSTT RETURN ADDRESS
Rücksprungadresse vom Stapel
pull return address
POP RETURN ADDRESS TOO
   
.,A754 68 PLA PLA ;IN CASE THIS IS A TOTALLY NEW ENTRY.
holen (LOW und HIGH)
pull return address
     
.,A755 A9 09 LDA #$09 LDAI 8+ADDPRC
Wert für Prüfung laden
we need 18d bytes !
BE CERTAIN ENOUGH ROOM IN STACK
   
.,A757 20 FB A3 JSR $A3FB JSR GETSTK ;MAKE SURE 16 BYTES ARE AVAILABLE.
prüft auf Platz im Stapel
check room on stack for 2*A bytes
     
.,A75A 20 06 A9 JSR $A906 JSR DATAN ;GET A COUNT IN [Y] OF THE NUMBER OF
;CHACRACTERS LEFT IN THE "FOR" STATEMENT
;[TXTPTR] IS UNAFFECTED.
sucht nächstes BAS.-Statement
scan for next BASIC statement ([:] or [EOL])
SCAN AHEAD TO NEXT STATEMENT
   
.,A75D 18 CLC CLC ;PREP TO ADD.
Carry löschen (Addition)
clear carry for add
PUSH STATEMENT ADDRESS ON STACK
   
.,A75E 98 TYA TYA ;SAVE IT FOR PUSHING.
CHRGET-Zeiger und Offset
copy index to A
     
.,A75F 65 7A ADC $7A ADC TXTPTR
= Startadresse der Schleife
add BASIC execute pointer low byte
     
.,A761 48 PHA PHA
auf Stapel speichern
push onto stack
     
.,A762 A5 7B LDA $7B LDA TXTPTR+1
HIGH-Byte holen und
get BASIC execute pointer high byte
     
.,A764 69 00 ADC #$00 ADCI 0
Übertrag addieren und
add carry
     
.,A766 48 PHA PHA
auf den Stapel legen
push onto stack
     
.,A767 A5 3A LDA $3A PSHWD CURLIN ;PUT LINE NUMBER ON STACK.
Aktuelle
get current line number high byte
PUSH LINE NUMBER ON STACK
   
.,A769 48 PHA   Zeilennummer laden und auf
push onto stack
     
.,A76A A5 39 LDA $39   den Stapel schieben
get current line number low byte
     
.,A76C 48 PHA   (LOW und HIGH-Byte)
push onto stack
     
.,A76D A9 A4 LDA #$A4 SYNCHK TOTK ;"TO" IS NECESSARY.
'TO' - Code
set "TO" token
     
.,A76F 20 FF AE JSR $AEFF   prüft auf Code
scan for CHR$(A), else do syntax error then warm start
REQUIRE "TO"
   
.,A772 20 8D AD JSR $AD8D JSR CHKNUM ;VALUE MUST BE A NUMBER.
prüft ob numerische Variable
check if source is numeric, else do type mismatch
<VAR> = <EXP> MUST BE NUMERIC
   
.,A775 20 8A AD JSR $AD8A JSR FRMNUM ;GET UPPER VALUE INTO FAC.
numerischer Ausdruck nach FAC
evaluate expression and check is numeric, else do
type mismatch
GET FINAL VALUE, MUST BE NUMERIC
   
.,A778 A5 66 LDA $66 LDA FACSGN ;PACK FAC.
Vorzeichenbyte von FAC holen
get FAC1 sign (b7)
PUT SIGN INTO VALUE IN FAC
   
.,A77A 09 7F ORA #$7F ORAI 127
Bit 0 bis 6 setzen
set all non sign bits
     
.,A77C 25 62 AND $62 AND FACHO
mit $62 angleichen
and FAC1 mantissa 1
     
.,A77E 85 62 STA $62 STA FACHO ;SET PACKED SIGN BIT.
und abspeichern
save FAC1 mantissa 1
     
.,A780 A9 8B LDA #$8B LDWDI LDFONE
Rücksprungadresse laden
set return address low byte
SET UP FOR RETURN
  low A78B
.,A782 A0 A7 LDY #$A7   (LOW und HIGH)
set return address high byte
TO STEP
  high A78B
.,A784 85 22 STA $22 STWD INDEX1
und Zwischenspeichern
save return address low byte
     
.,A786 84 23 STY $23   (LOW und HIGH)
save return address high byte
     
.,A788 4C 43 AE JMP $AE43 JMP FORPSH ;PUT FAC ONTO STACK, PACKED.
Schleifenendwert auf Stapel
round FAC1 and put on stack, returns to next instruction
RETURNS BY "JMP (INDEX)"

"STEP" PHRASE OF "FOR" STATEMENT

   
.,A78B A9 BC LDA #$BC LDFONE: LDWDI FONE ;PUT 1.0 INTO FAC.
Zeiger auf Konstante 1 setzen
set 1 pointer low address, default step size
STEP DEFAULT=1
  low B9BC
.,A78D A0 B9 LDY #$B9   (Ersatzwert für STEP)
set 1 pointer high address
    high B9BC
.,A78F 20 A2 BB JSR $BBA2 JSR MOVFM
als Default-STEP-Wert in FAC
unpack memory (AY) into FAC1
     
.,A792 20 79 00 JSR $0079 JSR CHRGOT
CHRGOT: letztes Zeichen holen
scan memory
     
.,A795 C9 A9 CMP #$A9 CMPI STEPTK ;A STEP IS GIVEN?
'STEP' - Code?
compare with STEP token
     
.,A797 D0 06 BNE $A79F BNE ONEON ;NO. ASSUME 1.0.
kein STEP-Wert: $A79F
if not "STEP" continue
was step so ....
USE DEFAULT VALUE OF 1.0
   
.,A799 20 73 00 JSR $0073 JSR CHRGET ;YES. ADVANCE POINTER.
CHRGET nächstes Zeichen holen
increment and scan memory
STEP SPECIFIED, GET IT
   
.,A79C 20 8A AD JSR $AD8A JSR FRMNUM ;READ THE STEP.
numerischer Ausdruck nach FAC
evaluate expression and check is numeric, else do
type mismatch
     
.,A79F 20 2B BC JSR $BC2B ONEON: JSR SIGN ;GET SIGN IN ACCA.
holt Vorzeichenbyte
get FAC1 sign, return A = $FF -ve, A = $01 +ve
     
.,A7A2 20 38 AE JSR $AE38 JSR PUSHF ;PUSH FAC ONTO STACK (THRU A).
Vorz. und STEP-Wert auf Stack
push sign, round FAC1 and put on stack
     
.,A7A5 A5 4A LDA $4A PSHWD FORPNT ;PUT PNTR TO VARIABLE ON STACK.
Zeiger auf Variablenwert
get FOR/NEXT variable pointer high byte
     
.,A7A7 48 PHA   (LOW) auf den Stapel
push on stack
     
.,A7A8 A5 49 LDA $49   Zeiger (HIGH)
get FOR/NEXT variable pointer low byte
     
.,A7AA 48 PHA   auf den Stapel
push on stack
     
.,A7AB A9 81 LDA #$81 NXTCON: LDAI FORTK ;PUT A FORTK ONTO STACK.
und FOR-Code
get FOR token
    FOR block code
.,A7AD 48 PHA PHA
; BNEA NEWSTT ;SIMULATE BNE TO NEWSTT. JUST FALL IN.
PAGE

NEW STATEMENT FETCHER.

;
; BACK HERE FOR NEW STATEMENT. CHARACTER POINTED TO BY TXTPTR
; IS ":" OR END-OF-LINE. THE ADDRESS OF THIS LOC IS LEFT
; ON THE STACK WHEN A STATEMENT IS EXECUTED SO THAT
; IT CAN MERELY DO A RTS WHEN IT IS DONE.
;
NEWSTT: IFN REALIO,<
auf den Stapel legen

Interpreterschleife

push on stack

interpreter inner loop

PERFORM NEXT STATEMENT

 

execute next statement

.,A7AE 20 2C A8 JSR $A82C JSR ISCNTC> ;LISTEN FOR CONTROL-C.
prüft auf Stop-Taste
do CRTL-C check vector
SEE IF CONTROL-C HAS BEEN TYPED
   
.,A7B1 A5 7A LDA $7A LDWD TXTPTR ;LOOK AT CURRENT CHARACTER.
CHRGET Zeiger (LOW und HIGH)
get the BASIC execute pointer low byte
NO, KEEP EXECUTING
   
.,A7B3 A4 7B LDY $7B IFN BUFPAG,<
laden
get the BASIC execute pointer high byte
     
.,A7B5 C0 02 CPY #$02 CPYI BUFPAG> ;SEE IF IT WAS DIRECT BY CHECK FOR BUF'S PAGE NUMBER
Direkt-Modus?
compare the high byte with $02xx
     
.,A7B7 EA NOP   No OPeration
unused byte
     
.,A7B8 F0 04 BEQ $A7BE BEQ DIRCON
ja: $A7BE
if immediate mode skip the continue pointer save
IN DIRECT MODE
   
.,A7BA 85 3D STA $3D STWD OLDTXT ;SAVE IN CASE OF RESTART BY INPUT.
als Zeiger für CONT
save the continue pointer low byte
IN RUNNING MODE
   
.,A7BC 84 3E STY $3E IFN BUFPAG,<DIRCON:>
merken
save the continue pointer high byte
     
.,A7BE A0 00 LDY #$00 LDYI 0
IFE BUFPAG,<DIRCON:>
Zeiger setzen
clear the index
     
.,A7C0 B1 7A LDA ($7A),Y LDADY TXTPTR
laufendes Zeichen holen
get a BASIC byte
END OF LINE YET?
   
.,A7C2 D0 43 BNE $A807 BNE MORSTS ;NOT NULL -- CHECK WHAT IT IS
nicht Zeilenende?
if not [EOL] go test for ":"
NO
   
.,A7C4 A0 02 LDY #$02 LDYI 2 ;LOOK AT LINK.
Zeiger neu setzen
else set the index
YES, SEE IF END OF PROGRAM
   
.,A7C6 B1 7A LDA ($7A),Y LDADY TXTPTR ;IS LINK 0?
Programmende?
get next line pointer high byte
     
.,A7C8 18 CLC CLC ;CLEAR CARRY FOR ENDCON AND MATH THAT FOLLOWS
Flag für END setzen
clear carry for no "BREAK" message
     
.,A7C9 D0 03 BNE $A7CE JEQ ENDCON ;YES - RAN OFF THE END.
Kein Programmende: $A7CE
branch if not end of program
     
.,A7CB 4C 4B A8 JMP $A84B   ja: dann END ausführen
else go to immediate mode,was immediate or [EOT] marker
YES, END OF PROGRAM
   
.,A7CE C8 INY INY ;PUT LINE NUMBER IN CURLIN.
Zeiger erhöhen
increment index
     
.,A7CF B1 7A LDA ($7A),Y LDADY TXTPTR
laufende Zeilennummer
get line number low byte
GET LINE # OF NEXT LINE
   
.,A7D1 85 39 STA $39 STA CURLIN
(LOW) nach $39
save current line number low byte
     
.,A7D3 C8 INY INY
Zeiger auf nächstes Byte
increment index
     
.,A7D4 B1 7A LDA ($7A),Y LDADY TXTPTR
laufende Zeilennummer
get line # high byte
     
.,A7D6 85 3A STA $3A STA CURLIN+1
(HIGH) nach $3A
save current line number high byte
     
.,A7D8 98 TYA TYA
Zeiger nach Akku
A now = 4
ADJUST TXTPTR TO START
   
.,A7D9 65 7A ADC $7A ADC TXTPTR
Programmzeiger auf
add BASIC execute pointer low byte, now points to code
OF NEW LINE
   
.,A7DB 85 7A STA $7A STA TXTPTR
Programmzeile setzen
save BASIC execute pointer low byte
     
.,A7DD 90 02 BCC $A7E1 BCC GONE
C=0: Erhöhung umgehen
branch if no overflow
     
.,A7DF E6 7B INC $7B INC TXTPTR+1
Programmzeiger (HIGH) erhöhen
else increment BASIC execute pointer high byte
     
.,A7E1 6C 08 03 JMP ($0308)   Statement ausführen
do start new BASIC code

start new BASIC code, the start new BASIC code vector is initialised to point here

    normally A7E4

execute a statement

.,A7E4 20 73 00 JSR $0073 GONE: JSR CHRGET ;GET THE STATEMENT TYPE.
CHRGET nächstes Zeichen holen
increment and scan memory
GET FIRST CHR OF STATEMENT
   
.,A7E7 20 ED A7 JSR $A7ED JSR GONE3
Statement ausführen
go interpret BASIC code from BASIC execute pointer
AND START PROCESSING
   
.,A7EA 4C AE A7 JMP $A7AE JMP NEWSTT
zurück zur Interpreterschlei.

BASIC-Statement ausführen

loop

go interpret BASIC code from BASIC execute pointer

BACK FOR MORE

EXECUTE A STATEMENT

(A) IS FIRST CHAR OF STATEMENT
CARRY IS SET
 

execute command in A

.,A7ED F0 3C BEQ $A82B GONE3: BEQ ISCRTS ;IF TERMINATOR, TRY AGAIN.
;NO NEED TO SET UP CARRY SINCE IT WILL
;BE ON IF NON-NUMERIC AND NUMERICS
;WILL CAUSE A SYNTAX ERROR LIKE THEY SHOULD
Zeilenende, dann fertig
if the first byte is null just exit
END OF LINE, NULL STATEMENT
   
.,A7EF E9 80 SBC #$80 GONE2: SBCI ENDTK ;" ON ... GOTO AND GOSUB" COME HERE.
Token?
normalise the token
FIRST CHAR A TOKEN?
   
.,A7F1 90 11 BCC $A804 BCC GLET
nein: dann zum LET-Befehl
if wasn't token go do LET
NOT TOKEN, MUST BE "LET"
   
.,A7F3 C9 23 CMP #$23 CMPI SCRATK-ENDTK+1
NEW?
compare with token for TAB(-$80
STATEMENT-TYPE TOKEN?
   
.,A7F5 B0 17 BCS $A80E BCS SNERRX ;SOME RES'D WORD BUT NOT
;A STATEMENT RES'D WORD.
Funktions-Token oder GO TO
branch if >= TAB(
NO, SYNTAX ERROR
   
.,A7F7 0A ASL ASL A, ;MULTIPLY BY TWO.
BASIC-Befehl, Code mal 2
*2 bytes per vector
DOUBLE TO GET INDEX
   
.,A7F8 A8 TAY TAY ;MAKE AN INDEX.
als Zeiger ins Y-Reg.
copy to index
INTO ADDRESS TABLE
   
.,A7F9 B9 0D A0 LDA $A00D,Y LDA STMDSP+1,Y
Befehlsadresse (LOW und
get vector high byte
     
.,A7FC 48 PHA PHA
HIGH) aus Tabelle
push on stack
PUT ADDRESS ON STACK
   
.,A7FD B9 0C A0 LDA $A00C,Y LDA STMDSP,Y
holen und als
get vector low byte
     
.,A800 48 PHA PHA ;PUT DISP ADDR ONTO STACK.
Rücksprungadresse auf Stapel
push on stack
     
.,A801 4C 73 00 JMP $0073 JMP CHRGET
Zeichen und Befehl ausführen
increment and scan memory and return. the return in
this case calls the command code, the return from
that will eventually return to the interpreter inner
loop above
GET NEXT CHR &amp; RTS TO ROUTINE
   
.,A804 4C A5 A9 JMP $A9A5 GLET: JMP LET ;MUST BE A LET
zum LET-Befehl
perform LET
was not [EOL]
MUST BE <VAR> = <EXP>
   
.,A807 C9 3A CMP #$3A MORSTS: CMPI ":"
':' ist es Doppelpunkt?
comapre with ":"
    colon
.,A809 F0 D6 BEQ $A7E1 BEQ GONE ;IF A ":" CONTINUE STATEMENT
ja: $A7E1
if ":" go execute new code
else ...
     
.,A80B 4C 08 AF JMP $AF08 SNERR1: JMP SNERR ;NEITHER 0 OR ":" SO SYNTAX ERROR
sonst 'SYNTAX ERROR'

prüft auf 'GO' 'TO' Code

do syntax error then warm start
token was >= TAB(
     
.,A80E C9 4B CMP #$4B SNERRX: CMPI GOTK-ENDTK
'GO' (minus $80)
compare with the token for GO
    GO code
.,A810 D0 F9 BNE $A80B BNE SNERR1
nein: 'SYNTAX ERROR'
if not "GO" do syntax error then warm start
else was "GO"
     
.,A812 20 73 00 JSR $0073 JSR CHRGET ;READ IN THE CHARACTER AFTER "GO "
nächstes Zeichen holen
increment and scan memory
     
.,A815 A9 A4 LDA #$A4 SYNCHK TOTK
'TO'
set "TO" token
    TO code
.,A817 20 FF AE JSR $AEFF   prüft auf Code
scan for CHR$(A), else do syntax error then warm start
     
.,A81A 4C A0 A8 JMP $A8A0 JMP GOTO
PAGE

RESTORE,STOP,END,CONTINUE,NULL,CLEAR.

zum GOTO-Befehl

BASIC-Befehl RESTORE

perform GOTO

perform RESTORE

"RESTORE" STATEMENT

  do GOTO

RESTORE command

.,A81D 38 SEC RESTOR: SEC
Carry setzen (Subtraktion)
set carry for subtract
SET DATPTR TO BEGINNING OF PROGRAM
   
.,A81E A5 2B LDA $2B LDA TXTTAB
Programmstartzeiger (LOW)
get start of memory low byte
     
.,A820 E9 01 SBC #$01 SBCI 1
laden und davon 1 abziehen
-1
     
.,A822 A4 2C LDY $2C LDY TXTTAB+1
und HIGH-Byte holen
get start of memory high byte
     
.,A824 B0 01 BCS $A827 BCS RESFIN
  branch if no rollunder
     
.,A826 88 DEY DEY
LOW-Byte -1
else decrement high byte
SET DATPTR TO Y,A
   
.,A827 85 41 STA $41 RESFIN: STWD DATPTR ;READ FINISHES COME TO "RESFIN".
als DATA-Zeiger
set DATA pointer low byte
     
.,A829 84 42 STY $42   abspeichern
set DATA pointer high byte
     
.,A82B 60 RTS ISCRTS: RTS
IFE REALIO-1,<
ISCNTC: LDAI 1
BIT ^O13500
BMI ISCRTS
LDXI 8
LDAI 3
CMPI 3>
IFE REALIO-2,<
ISCNTC: LDA ^O176000
REPEAT 4,<NOP>
LSR A,
BCC ISCRTS
JSR INCHR ;EAT CHAR THAT WAS TYPED
CMPI 3> ;WAS IT A CONTROL-C??
IFE REALIO-4,<
ISCNTC: LDA ^O140000 ;CHECK THE CHARACTER
CMPI ^O203
BEQ ISCCAP
RTS
ISCCAP: JSR INCHR
Rücksprung

prüft auf Stop-Taste

do CRTL-C check vector

SEE IF CONTROL-C TYPED

   
.,A82C 20 E1 FF JSR $FFE1 CMPI ^O203>
Stop-Taste abfragen

BASIC-Befehl STOP

scan stop key

perform STOP

"STOP" STATEMENT

  test stop key

STOP command

.,A82F B0 01 BCS $A832 STOP: BCS STOPC ;MAKE [C] NONZERO AS A FLAG.
C=1: Flag für STOP

BASIC-Befehl END

if carry set do BREAK instead of just END

perform END

CARRY=1 TO FORCE PRINTING "BREAK AT.."

"END" STATEMENT

 

END command

.,A831 18 CLC END: CLC
C=0 Flag für END
clear carry
CARRY=0 TO AVOID PRINTING MESSAGE
   
.,A832 D0 3C BNE $A870 STOPC: BNE CONTRT ;RETURN IF NOT CONT-C OR
;IF NO TERMINATOR FOR STOP OR END.
;[C]=0 SO WILL NOT PRINT "BREAK".
RUN/STOP nicht gedrückt: RTS
return if wasn't CTRL-C
IF NOT END OF STATEMENT, DO NOTHING
   
.,A834 A5 7A LDA $7A LDWD TXTPTR
Programmzeiger laden
get BASIC execute pointer low byte
     
.,A836 A4 7B LDY $7B IFN BUFPAG,<
(LOW und HIGH-Byte)
get BASIC execute pointer high byte
     
.,A838 A6 3A LDX $3A LDX CURLIN+1
Direkt-Modus?
get current line number high byte
     
.,A83A E8 INX INX>
(Zeilennummer -1)
increment it
RUNNING?
   
.,A83B F0 0C BEQ $A849 BEQ DIRIS
ja: $A849
branch if was immediate mode
NO, DIRECT MODE
   
.,A83D 85 3D STA $3D STWD OLDTXT
als Zeiger für CONT setzen
save continue pointer low byte
     
.,A83F 84 3E STY $3E   (LOW und HIGH)
save continue pointer high byte
     
.,A841 A5 39 LDA $39 STPEND: LDWD CURLIN
Nummer der laufenden Zeile
get current line number low byte
     
.,A843 A4 3A LDY $3A   holen (LOW und HIGH)
get current line number high byte
     
.,A845 85 3B STA $3B STWD OLDLIN
und als Zeilennummer für
save break line number low byte
     
.,A847 84 3C STY $3C   CONT merken
save break line number high byte
     
.,A849 68 PLA DIRIS: PLA ;POP OFF NEWSTT ADDR.
Rücksprungadresse
dump return address low byte
     
.,A84A 68 PLA PLA
vom Stapel entfernen
dump return address high byte
     
.,A84B A9 81 LDA #$81 ENDCON: LDWDI BRKTXT
Zeiger auf Startadresse
set [CR][LF]"BREAK" pointer low byte
" BREAK" AND BELL
  low A381
.,A84D A0 A3 LDY #$A3 IFN REALIO,<
LDXI 0
STX CNTWFL>
BREAK setzen
set [CR][LF]"BREAK" pointer high byte
    high A381
.,A84F 90 03 BCC $A854 BCC GORDY ;CARRY CLEAR SO DON'T PRINT "BREAK".
END Flag?
if was program end skip the print string
     
.,A851 4C 69 A4 JMP $A469 JMP ERRFIN
nein: 'BREAK IN XXX' ausgeben
print string and do warm start
     
.,A854 4C 86 E3 JMP $E386 GORDY: JMP READY ;TYPE "READY".
IFE REALIO,<
DDT: PLA ;GET RID OF NEWSTT RETURN.
PLA
HRRZ 14,.JBDDT##
JRST 0(14)>
zum BASIC-Warmstart

BASIC-Befehl CONT

do warm start

perform CONT

"CONT" COMMAND

 

CONT command

.,A857 D0 17 BNE $A870 CONT: BNE CONTRT ;MAKE SURE THERE IS A TERMINATOR.
Kein Trennzeichen: SYNTAX ERR
exit if following byte to allow syntax error
IF NOT END OF STATEMENT, DO NOTHING
   
.,A859 A2 1A LDX #$1A LDXI ERRCN ;CONTINUE ERROR.
Fehlernr. für 'CAN'T CONTINUE
error code $1A, can't continue error
    error number
.,A85B A4 3E LDY $3E LDY OLDTXT+1 ;A STORED TXTPTR OF ZERO IS SETUP
;BY STKINI AND INDICATES THERE IS
;NOTHING TO CONTINUE.
CONT gesperrt?
get continue pointer high byte
MEANINGFUL RE-ENTRY?
   
.,A85D D0 03 BNE $A862 JEQ ERROR ;"STOP", "END", TYPING CRLF TO
nein: $A862
go do continue if we can
YES
   
.,A85F 4C 37 A4 JMP $A437 ;"INPUT" AND ^C SETUP OLDTXT.
Fehlermeldung ausgeben
else do error #X then warm start
we can continue so ...
NO
   
.,A862 A5 3D LDA $3D LDA OLDTXT
CONT-Zeiger (LOW) laden
get continue pointer low byte
RESTORE TXTPTR
   
.,A864 85 7A STA $7A STWD TXTPTR
und CONT-Zeiger als Programm-
save BASIC execute pointer low byte
     
.,A866 84 7B STY $7B   zeiger abspeichern
save BASIC execute pointer high byte
     
.,A868 A5 3B LDA $3B LDWD OLDLIN
und
get break line low byte
RESTORE LINE NUMBER
   
.,A86A A4 3C LDY $3C   Zeilennummer wieder
get break line high byte
     
.,A86C 85 39 STA $39 STWD CURLIN
setzen
set current line number low byte
     
.,A86E 84 3A STY $3A   (LOW- und HIGH-Byte)
set current line number high byte
     
.,A870 60 RTS CONTRT: RTS ;RETURN TO CALLER.
IFN NULCMD,<
NULL: JSR GETBYT
BNE CONTRT ;MAKE SURE THERE IS TERMINATOR.
INX
CPXI 240 ;IS THE NUMBER REASONABLE?
BCS FCERR1 ;"FUNCTION CALL" ERROR.
DEX ;BACK -1
STX NULCNT
RTS
FCERR1: JMP FCERR>
PAGE

LOAD AND SAVE SUBROUTINES.

IFE REALIO-1,< ;KIM CASSETTE I/O
SAVE: TSX ;SAVE STACK POINTER
STX INPFLG
LDAI STKEND-256-200
STA ^O362 ;SETUP DUMMY STACK FOR KIM MONITOR
LDAI 254 ;MAKE ID BYTE EQUAL TO FF HEX
STA ^O13771 ;STORE INTO KIM ID
LDWD TXTTAB ;START DUMPING FROM TXTTAB
STWD ^O13765 ;SETUP SAL,SAH
LDWD VARTAB ;STOP AT VARTAB
STWD ^O13767 ;SETUP EAL,EAH
JMP ^O14000
RETSAV: LDX INPFLG ;RESORE THE REAL STACK POINTER
TXS
LDWDI TAPMES ;SAY IT WAS DONE
JMP STROUT
GLOAD: DT"LOADED"
0
TAPMES: DT"SAVED"
ACRLF
0
PATSAV: BLOCK 20
LOAD: LDWD TXTTAB ;START DUMPING IN AT TXTTAB
STWD ^O13765 ;SETUP SAL,SAH
LDAI 255
STA ^O13771
LDWDI RTLOAD
STWD ^O1 ;SET UP RETURN ADDRESS FOR LOAD
JMP ^O14163 ;GO READ THE DATA IN
RTLOAD: LDXI STKEND-256 ;RESET THE STACK
TXS
LDWDI READY
STWD ^O1
LDWDI GLOAD ;TELL HIM IT WORKED
JSR STROUT
LDXY ^O13755 ;GET LAST LOCATION
TXA ;ITS ONE TOO BIG
BNE DECVRT ;DECREMENT [X,Y]
NOP
DECVRT: NOP
STXY VARTAB ;SETUP NEW VARIABLE LOCATION
JMP FINI> ;RELINK THE PROGRAM
IFE REALIO-4,<
SAVE: SEC ;CALCLUATE PROGRAM SIZE IN POKER
LDA VARTAB
SBC TXTTAB
STA POKER
LDA VARTAB+1
SBC TXTTAB+1
STA POKER+1
JSR VARTIO
JSR CQCOUT ;WRITE PROGRAM SIZE [POKER]
JSR PROGIO
JMP CQCOUT ;WRITE PROGRAM.
LOAD: JSR VARTIO
JSR CQCSIN ;READ SIZE OF PROGRAM INTO POKER
CLC
LDA TXTTAB ;CALCULATE VARTAB FROM SIZE AND
ADC POKER ;TXTTAB
STA VARTAB
LDA TXTTAB+1
ADC POKER+1
STA VARTAB+1
JSR PROGIO
JSR CQCSIN ;READ PROGRAM.
LDWDI TPDONE
JSR STROUT
JMP FINI
TPDONE: DT"LOADED"
0
VARTIO: LDWDI POKER
STWD ^O74
LDAI POKER+2
STWD ^O76
RTS
PROGIO: LDWD TXTTAB
STWD ^O74
LDWD VARTAB
STWD ^O76
RTS>
PAGE

RUN,GOTO,GOSUB,RETURN.

Rücksprung

BASIC-Befehl RUN

perform RUN

"RUN" COMMAND

 

RUN command

.,A871 08 PHP   Statusregister retten
save status
SAVE STATUS WHILE SUBTRACTING
   
.,A872 A9 00 LDA #$00   Wert laden und
no control or kernal messages
     
.,A874 20 90 FF JSR $FF90   Flag für Programmodus setzen
control kernal messages
     
.,A877 28 PLP   Statusregister zurückholen
restore status
GET STATUS AGAIN (FROM CHRGET)
   
.,A878 D0 03 BNE $A87D RUN: JEQ RUNC ;IF NO LINE # ARGUMENT.
weitere Zeichen (Zeilennr.)?
branch if RUN n
PROBABLY A LINE NUMBER
   
.,A87A 4C 59 A6 JMP $A659   Programmzeiger setzen, CLR
reset execution to start, clear variables, flush stack
and return
START AT BEGINNING OF PROGRAM
   
.,A87D 20 60 A6 JSR $A660 JSR CLEARC ;CLEAN UP -- RESET THE STACK.
CLR-Befehl
go do "CLEAR"
CLEAR VARIABLES
  do CLR
.,A880 4C 97 A8 JMP $A897 JMP RUNC2 ;MUST REPLACE RTS ADDR.
;
; A GOSUB ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS:
; THE GOSUTK ONE BYTE
; THE LINE NUMBER OF THE GOSUB STATEMENT TWO BYTES
; A POINTER INTO THE TEXT OF THE GOSUB TWO BYTES
;
; HIGH ADDRESS.
;
; TOTAL FIVE BYTES.
;
GOTO-Befehl

BASIC-Befehl GOSUB

get n and do GOTO n

perform GOSUB

JOIN GOSUB STATEMENT

"GOSUB" STATEMENT

LEAVES 7 BYTES ON STACK:
2 -- RETURN ADDRESS (NEWSTT)
2 -- TXTPTR
2 -- LINE #
1 -- GOSUB TOKEN ($B0)
  do GOTO

GOSUB command

.,A883 A9 03 LDA #$03 GOSUB: LDAI 3
Wert für Prüfung
need 6 bytes for GOSUB
BE SURE ENOUGH ROOM ON STACK
   
.,A885 20 FB A3 JSR $A3FB JSR GETSTK ;MAKE SURE THERE IS ROOM.
prüft auf Platz im Stapel
check room on stack for 2*A bytes
     
.,A888 A5 7B LDA $7B PSHWD TXTPTR ;PUSH ON THE TEXT POINTER.
Programmzeiger (LOW-
get BASIC execute pointer high byte
     
.,A88A 48 PHA   und HIGH-Byte) laden
save it
     
.,A88B A5 7A LDA $7A   und auf den
get BASIC execute pointer low byte
     
.,A88D 48 PHA   Stapel retten
save it
     
.,A88E A5 3A LDA $3A PSHWD CURLIN ;PUSH ON THE CURRENT LINE NUMBER.
Zeilennummer laden (HIGH)
get current line number high byte
     
.,A890 48 PHA   und auf den Stapel legen
save it
     
.,A891 A5 39 LDA $39   Zeilennummer LOW laden
get current line number low byte
     
.,A893 48 PHA   und auf den Stapel legen
save it
     
.,A894 A9 8D LDA #$8D LDAI GOSUTK
'GOSUB'-Code laden
token for GOSUB
     
.,A896 48 PHA PHA ;PUSH ON A GOSUB TOKEN.
und auf den Stapel legen
save it
     
.,A897 20 79 00 JSR $0079 RUNC2: JSR CHRGOT ;GET CHARACTER AND SET CODES FOR LINGET.
CHRGOT: letztes Zeichen holen
scan memory
     
.,A89A 20 A0 A8 JSR $A8A0 JSR GOTO ;USE RTS SCHEME TO "NEWSTT".
GOTO-Befehl
perform GOTO
     
.,A89D 4C AE A7 JMP $A7AE JMP NEWSTT
zur Interpreterschleife

BASIC-Befehl GOTO

go do interpreter inner loop

perform GOTO

"GOTO" STATEMENT

ALSO USED BY "RUN" AND "GOSUB"
 

GOTO command

.,A8A0 20 6B A9 JSR $A96B GOTO: JSR LINGET ;PICK UP THE LINE NUMBER IN "LINNUM".
Zeilennummer nach $14/$15
get fixed-point number into temporary integer
GET GOTO LINE
   
.,A8A3 20 09 A9 JSR $A909 JSR REMN ;SKIP TO END OF LINE.
nächsten Zeilenanfang suchen
scan for next BASIC line
POINT Y TO EOL
   
.,A8A6 38 SEC   Carry setzen (Subtraktion)
set carry for subtract
     
.,A8A7 A5 39 LDA $39   aktuelle Zeilennummer (LOW)
get current line number low byte
     
.,A8A9 E5 14 SBC $14   kleiner als laufende Zeile?
subtract temporary integer low byte
     
.,A8AB A5 3A LDA $3A LDA CURLIN+1
aktuelle Zeilennummer (HIGH)
get current line number high byte
IS CURRENT PAGE < GOTO PAGE?
   
.,A8AD E5 15 SBC $15 CMP LINNUM+1
kleiner als laufende Zeile?
subtract temporary integer high byte
     
.,A8AF B0 0B BCS $A8BC BCS LUK4IT
nein: $A8BC
if current line number >= temporary integer, go search
from the start of memory
SEARCH FROM PROG START IF NOT
   
.,A8B1 98 TYA TYA
Differenz in Akku
else copy line index to A
OTHERWISE SEARCH FROM NEXT LINE
   
.,A8B2 38 SEC SEC
Carry setzen (Addition)
set carry (+1)
     
.,A8B3 65 7A ADC $7A ADC TXTPTR
Programmzeiger addieren
add BASIC execute pointer low byte
     
.,A8B5 A6 7B LDX $7B LDX TXTPTR+1
sucht ab laufender Zeile
get BASIC execute pointer high byte
     
.,A8B7 90 07 BCC $A8C0 BCC LUKALL
unbedingter
branch if no overflow to high byte
     
.,A8B9 E8 INX INX
Sprung
increment high byte
     
.,A8BA B0 04 BCS $A8C0 BCSA LUKALL ;ALWAYS GOES.
zu $A8C0
branch always (can never be carry)

search for line number in temporary integer from start of memory pointer

     
.,A8BC A5 2B LDA $2B LUK4IT: LDWX TXTTAB
sucht ab Programmstart
get start of memory low byte
GET PROGRAM BEGINNING
   
.,A8BE A6 2C LDX $2C     get start of memory high byte

search for line # in temporary integer from (AX)

     
.,A8C0 20 17 A6 JSR $A617 LUKALL: JSR FNDLNC ;[X,A] ARE ALL SET UP.
sucht Programmzeile
search Basic for temp integer line number from AX
SEARCH FOR GOTO LINE
   
.,A8C3 90 1E BCC $A8E3 QFOUND: BCC USERR ;GOTO LINE IS NONEXISTANT.
nicht gefunden: 'undef'd st.'
if carry clear go do unsdefined statement error
carry all ready set for subtract
ERROR IF NOT THERE
   
.,A8C5 A5 5F LDA $5F LDA LOWTR
von der Startadresse (Zeile)
get pointer low byte
TXTPTR = START OF THE DESTINATION LINE
   
.,A8C7 E9 01 SBC #$01 SBCI 1
eins subtrahieren und als
-1
     
.,A8C9 85 7A STA $7A STA TXTPTR
Programmzeiger (LOW)
save BASIC execute pointer low byte
     
.,A8CB A5 60 LDA $60 LDA LOWTR+1
HIGH-Byte der Zeile laden
get pointer high byte
     
.,A8CD E9 00 SBC #$00 SBCI 0
Übertrag berücksichtigen
subtract carry
     
.,A8CF 85 7B STA $7B STA TXTPTR+1
und als Programmzeiger
save BASIC execute pointer high byte
     
.,A8D1 60 RTS GORTS: RTS ;PROCESS THE STATEMENT.
;
; "RETURN" RESTORES THE LINE NUMBER AND TEXT PNTR FROM THE STACK
; AND ELIMINATES ALL THE "FOR" ENTRIES IN FRONT OF THE "GOSUB" ENTRY.
;
Rücksprung

BASIC-Befehl RETURN

perform RETURN

RETURN TO NEWSTT OR GOSUB

"POP" AND "RETURN" STATEMENTS

 

RETURN command

.,A8D2 D0 FD BNE $A8D1 RETURN: BNE GORTS ;NO TERMINATOR=BLOW HIM UP.
Kein Trennzeichen: SYNTAX ERR
exit if following token to allow syntax error
     
.,A8D4 A9 FF LDA #$FF LDAI 255
Wert laden und
set byte so no match possible
     
.,A8D6 85 4A STA $4A STA FORPNT+1 ;MAKE SURE THE VARIABLE'S PNTR
;NEVER GETS MATCHED.
FOR-NEXT-ZEIGER neu setzen
save FOR/NEXT variable pointer high byte
     
.,A8D8 20 8A A3 JSR $A38A JSR FNDFOR ;GO PAST ALL THE "FOR" ENTRIES.
GOSUB-Datensatz suchen
search the stack for FOR or GOSUB activity,
get token off stack
TO CANCEL FOR/NEXT IN SUB
   
.,A8DB 9A TXS TXS
  correct the stack
     
.,A8DC C9 8D CMP #$8D CMPI GOSUTK ;RETURN WITHOUT GOSUB?
'GOSUB'-Code?
compare with GOSUB token
LAST GOSUB FOUND?
   
.,A8DE F0 0B BEQ $A8EB BEQ RETU1
ja: $A8E8
if matching GOSUB go continue RETURN
     
.,A8E0 A2 0C LDX #$0C LDXI ERRRG
Nr für 'return without gosub’
else error code $04, return without gosub error
     
.:A8E2 2C .BYTE $2C SKIP2
BIT-Befehl um folgenden Befehl auszulassen
makes next line BIT $11A2
FAKE
   
.,A8E3 A2 11 LDX #$02 USERR: LDXI ERRUS ;NO MATCH SO "US" ERROR.
Nr für 'undef'd statement'
error code $11, undefined statement error
     
.,A8E5 4C 37 A4 JMP $A437 JMP ERROR ;YES.
Fehlermeldung ausgeben
do error #X then warm start
     
.,A8E8 4C 08 AF JMP $AF08 SNERR2: JMP SNERR
'syntax error' ausgeben
do syntax error then warm start
was matching GOSUB token
   

remove GOSUB block from stack

.,A8EB 68 PLA RETU1: PLA ;REMOVE GOSUTK.
GOSUB-Code vom Stapel holen
dump token byte
DISCARD GOSUB TOKEN
   
.,A8EC 68 PLA PULWD CURLIN ;GET LINE NUMBER "GOSUB" WAS FROM.
Zeilennummer (LOW) wieder-
pull return line low byte
     
.,A8ED 85 39 STA $39   holen und abspeichern
save current line number low byte
PULL LINE #
   
.,A8EF 68 PLA   Zeilennummer (HIGH) holen
pull return line high byte
     
.,A8F0 85 3A STA $3A   und abspeichern
save current line number high byte
     
.,A8F2 68 PLA PULWD TXTPTR ;GET TEXT PNTR FROM "GOSUB".
Programmzeiger (LOW) wieder-
pull return address low byte
     
.,A8F3 85 7A STA $7A   holen und abspeichern
save BASIC execute pointer low byte
PULL TXTPTR
   
.,A8F5 68 PLA   Programmzeiger (HIGH) holen
pull return address high byte
     
.,A8F6 85 7B STA $7B   abspeichern

BASIC-Befehl DATA

save BASIC execute pointer high byte

perform DATA

"DATA" STATEMENT

EXECUTED BY SKIPPING TO NEXT COLON OR EOL
 

DATA command

.,A8F8 20 06 A9 JSR $A906 DATA: JSR DATAN ;SKIP TO END OF STATEMENT,
;SINCE WHEN "GOSUB" STUCK THE TEXT PNTR
;ONTO THE STACK, THE LINE NUMBER ARG
;HADN'T BEEN READ YET.
nächstes Statement suchen
scan for next BASIC statement ([:] or [EOL])

add Y to the BASIC execute pointer

MOVE TO NEXT STATEMENT

ADD (Y) TO TXTPTR

   
.,A8FB 98 TYA ADDON: TYA
Offset
copy index to A
     
.,A8FC 18 CLC CLC
Carry löschen (Addition)
clear carry for add
     
.,A8FD 65 7A ADC $7A ADC TXTPTR
Programmzeiger addieren
add BASIC execute pointer low byte
     
.,A8FF 85 7A STA $7A STA TXTPTR
und wieder abspeichern
save BASIC execute pointer low byte
     
.,A901 90 02 BCC $A905 BCC REMRTS
Verminderung übergehen
skip increment if no carry
     
.,A903 E6 7B INC $7B INC TXTPTR+1
Programmzeiger vermindern
else increment BASIC execute pointer high byte
     
.,A905 60 RTS REMRTS: RTS ;"NEWSTT" RTS ADDR IS STILL THERE.
Rücksprung

Offset des nächsten

Trennzeichens finden

scan for next BASIC statement ([:] or [EOL])

returns Y as index to [:] or [EOL]

SCAN AHEAD TO NEXT ":" OR EOL

 

get end of statement

.,A906 A2 3A LDX #$3A DATAN: LDXI ":" ;"DATA" TERMINATES ON ":" AND NULL.
':' Doppelpunkt
set look for character = ":"
GET OFFSET IN Y TO EOL OR ":"
  colon
.:A908 2C .BYTE $2C SKIP2
  makes next line BIT $00A2

scan for next BASIC line

returns Y as index to [EOL]
FAKE
 

get end of line

.,A909 A2 00 LDX #$00 REMN: LDXI 0 ;THE ONLY TERMINATOR IS NULL.
$0 Zeilenende
set alternate search character = [EOL]
TO EOL ONLY
   
.,A90B 86 07 STX $07 STX CHARAC ;PRESERVE IT.
als Suchzeichen
store alternate search character
     
.,A90D A0 00 LDY #$00 LDYI 0 ;THIS MAKES CHARAC=0 AFTER SWAP.
Zähler
set search character = [EOL]
     
.,A90F 84 08 STY $08 STY ENDCHR
initialisieren
save the search character
     
.,A911 A5 08 LDA $08 EXCHQT: LDA ENDCHR
Speicherzelle $7
get search character
TRICK TO COUNT QUOTE PARITY
   
.,A913 A6 07 LDX $07 LDX CHARAC
gesuchtes Zeichen
get alternate search character
     
.,A915 85 07 STA $07 STA CHARAC
mit $8
make search character = alternate search character
     
.,A917 86 08 STX $08 STX ENDCHR
vertauschen
make alternate search character = search character
     
.,A919 B1 7A LDA ($7A),Y REMER: LDADY TXTPTR
Zeichen holen
get BASIC byte
     
.,A91B F0 E8 BEQ $A905 BEQ REMRTS ;NULL ALWAYS TERMINATES.
Zeilenende, dann fertig
exit if null [EOL]
END OF LINE
   
.,A91D C5 08 CMP $08 CMP ENDCHR ;IS IT THE OTHER TERMINATOR?
= Suchzeichen?
compare with search character
     
.,A91F F0 E4 BEQ $A905 BEQ REMRTS ;YES, IT'S FINISHED.
ja: $A905
exit if found
COLON IF LOOKING FOR COLONS
   
.,A921 C8 INY INY ;PROGRESS TO NEXT CHARACTER.
Zeiger erhöhen
else increment index
     
.,A922 C9 22 CMP #$22 CMPI 34 ;IS IT A QUOTE?
"" Hochkomma?
compare current character with open quote
    quote mark
.,A924 D0 F3 BNE $A919 BNE REMER ;NO, JUST CONTINUE.
nein: $A919
if found go swap search character for alternate search
character
     
.,A926 F0 E9 BEQ $A911 BEQA EXCHQT ;YES, TIME TO TRADE.
PAGE

"IF ... THEN" CODE.

sonst $7 und $8 vertauschen

BASIC-Befehl IF

loop for next character, branch always

perform IF

...ALWAYS

"IF" STATEMENT

 

IF command

.,A928 20 9E AD JSR $AD9E IF: JSR FRMEVL ;EVALUATE A FORMULA.
FRMEVL Ausdruck berechnen
evaluate expression
     
.,A92B 20 79 00 JSR $0079 JSR CHRGOT ;GET CURRENT CHARACTER.
CHRGOT letztes Zeichen
scan memory
     
.,A92E C9 89 CMP #$89 CMPI GOTOTK ;IS TERMINATING CHARACTER A GOTOTK?
'GOTO'-Code?
compare with "GOTO" token
     
.,A930 F0 05 BEQ $A937 BEQ OKGOTO ;YES.
ja: $A937
if it was the token for GOTO go do IF ... GOTO
wasn't IF ... GOTO so must be IF ... THEN
     
.,A932 A9 A7 LDA #$A7 SYNCHK THENTK ;NO, IT MUST BE "THEN".
'THEN'-Code
set "THEN" token
     
.,A934 20 FF AE JSR $AEFF   prüft auf Code
scan for CHR$(A), else do syntax error then warm start
     
.,A937 A5 61 LDA $61 OKGOTO: LDA FACEXP ;0=FALSE. ALL OTHERS TRUE.
Ergebnis des IF-Ausdrucks
get FAC1 exponent
CONDITION TRUE OR FALSE?
   
.,A939 D0 05 BNE $A940 BNE DOCOND ;TRUE !
Ausdruck wahr?

BASIC-Befehl REM

if result was non zero continue execution
else REM rest of line

perform REM

BRANCH IF TRUE

"REM" STATEMENT, OR FALSE "IF" STATEMENT

 

REM command

.,A93B 20 09 A9 JSR $A909 REM: JSR REMN ;SKIP REST OF STATEMENT.
nein, Zeilenanfang suchen
scan for next BASIC line
SKIP REST OF LINE
   
.,A93E F0 BB BEQ $A8FB BEQA ADDON ;WILL ALWAYS BRANCH.
Programmz. auf nächste Zeile
add Y to the BASIC execute pointer and return, branch
always
result was non zero so do rest of line
...ALWAYS
 

THEN part of IF

.,A940 20 79 00 JSR $0079 DOCOND: JSR CHRGOT ;TEST CURRENT CHARACTER.
CHRGOT: letztes Zeichen holen
scan memory
COMMAND OR NUMBER?
   
.,A943 B0 03 BCS $A948 BCS DOCO ;IF A NUMBER, GOTO IT.
keine Ziffer?
branch if not numeric character, is variable or keyword
COMMAND
   
.,A945 4C A0 A8 JMP $A8A0 JMP GOTO
zum GOTO-Befehl
else perform GOTO n
is variable or keyword
NUMBER
  do GOTO
.,A948 4C ED A7 JMP $A7ED DOCO: JMP GONE3 ;INTERPRET NEW STATEMENT.
PAGE

"ON ... GO TO ..." CODE.

Befehl dekodieren, ausführen

BASIC-Befehl ON

interpret BASIC code from BASIC execute pointer

perform ON

"ON" STATEMENT

ON <EXP> GOTO <LIST>
ON <EXP> GOSUB <LIST>
 

ON command

.,A94B 20 9E B7 JSR $B79E ONGOTO: JSR GETBYT ;GET VALUE IN FACLO.
Byte-Wert (0 bis 255) holen
get byte parameter
EVALUATE <EXP>, AS BYTE IN FAC+4
   
.,A94E 48 PHA PHA ;SAVE FOR LATER.
Code merken
push next character
SAVE NEXT CHAR ON STACK
   
.,A94F C9 8D CMP #$8D CMPI GOSUTK ;AN "ON ... GOSUB" PERHAPS?
'GOSUB'-Code?
compare with GOSUB token
    GOSUB code
.,A951 F0 04 BEQ $A957 BEQ ONGLOP ;YES.
ja: $A957
if GOSUB go see if it should be executed
     
.,A953 C9 89 CMP #$89 SNERR3: CMPI GOTOTK ;MUST BE "GOTOTK".
'GOTO'-Code?
compare with GOTO token
    GOTO code
.,A955 D0 91 BNE $A8E8 BNE SNERR2
nein: dann 'SYNTAX ERROR'
if not GOTO do syntax error then warm start
next character was GOTO or GOSUB, see if it should be executed
     
.,A957 C6 65 DEC $65 ONGLOP: DEC FACLO
Zähler vermindern
decrement the byte value
COUNTED TO RIGHT ONE YET?
   
.,A959 D0 04 BNE $A95F BNE ONGLP1 ;SKIP ANOTHER LINE NUMBER.
noch nicht null?
if not zero go see if another line number exists
NO, KEEP LOOKING
   
.,A95B 68 PLA PLA ;GET DISPATCH CHARACTER.
ja: Code zurückholen
pull keyword token
YES, RETRIEVE CMD
   
.,A95C 4C EF A7 JMP $A7EF JMP GONE2
und Befehl ausführen
go execute it
AND GO.
   
.,A95F 20 73 00 JSR $0073 ONGLP1: JSR CHRGET ;ADVANCE AND SET CODES.
CHRGET nächstes Zeichen holen
increment and scan memory
PRIME CONVERT SUBROUTINE
   
.,A962 20 6B A9 JSR $A96B JSR LINGET
Zeilennummer holen
get fixed-point number into temporary integer
skip this n
CONVERT LINE #
   
.,A965 C9 2C CMP #$2C CMPI 44 ;IS IT A COMMA?
',' Komma?
compare next character with ","
TERMINATE WITH COMMA?
  comma
.,A967 F0 EE BEQ $A957 BEQ ONGLOP
ja: dann weiter
loop if ","
YES
   
.,A969 68 PLA PLA ;REMOVE STACK ENTRY (TOKEN).
kein Sprung: Code zurückholen
else pull keyword token, ran out of options
NO, END OF LIST, SO IGNORE
   
.,A96A 60 RTS ONGRTS: RTS ;EITHER END-OF-LINE OR SYNTAX ERROR.
PAGE

LINGET -- READ A LINE NUMBER INTO LINNUM

;
; "LINGET" READS A LINE NUMBER FROM THE CURRENT TEXT POSITION.
;
; LINE NUMBERS RANGE FROM 0 TO 64000-1.
;
; THE ANSWER IS RETURNED IN "LINNUM".
; "TXTPTR" IS UPDATED TO POINT TO THE TERMINATING CHARCTER
; AND [A] = THE TERMINATING CHARACTER WITH CONDITION
; CODES SET UP TO REFLECT ITS VALUE.
;
Rücksprung

Zeilennummer nach $14/$15

get fixed-point number into temporary integer

CONVERT LINE NUMBER

 

get decimal number into $14/$15

.,A96B A2 00 LDX #$00 LINGET: LDXI 0
Wert Laden und
clear X
ASC # TO HEX ADDRESS
   
.,A96D 86 14 STX $14 STX LINNUM ;INITIALIZE LINE NUMBER TO ZERO.
Vorsetzen
clear temporary integer low byte
IN LINNUM.
   
.,A96F 86 15 STX $15 STX LINNUM+1
(für Zeilennummer gleich 0)
clear temporary integer high byte
     
.,A971 B0 F7 BCS $A96A MORLIN: BCS ONGRTS ;IT IS NOT A DIGIT.
keine Ziffer, dann fertig
return if carry set, end of scan, character was not 0-9
NOT A DIGIT
   
.,A973 E9 2F SBC #$2F SBCI "0"-1 ;-1 SINCE C=0.
'0'-1 abziehen, gibt Hexwert
subtract $30, $2F+carry, from byte
CONVERT DIGIT TO BINARY
   
.,A975 85 07 STA $07 STA CHARAC ;SAVE CHARACTER.
merken
store #
SAVE THE DIGIT
   
.,A977 A5 15 LDA $15 LDA LINNUM+1
HIGH-Byte holen
get temporary integer high byte
CHECK RANGE
   
.,A979 85 22 STA $22 STA INDEX
Zwischenspeichern
save it for now
     
.,A97B C9 19 CMP #$19 CMPI 25 ;LINE NUMBER WILL BE .LT. 64000?
Zahl bereits größer 6400?
compare with $19
LINE # TOO LARGE?
   
.,A97D B0 D4 BCS $A953 BCS SNERR3
dann 'SYNTAX ERROR'
branch if >= this makes the maximum line number 63999
because the next bit does $1900 * $0A = $FA00 = 64000
decimal. the branch target is really the SYNTAX error
at $A8E8 but that is too far so an intermediate
compare and branch to that location is used. the problem
with this is that line number that gives a partial result
from $8900 to $89FF, 35072x to 35327x, will pass the new
target compare and will try to execute the remainder of
the ON n GOTO/GOSUB. a solution to this is to copy the
byte in A before the branch to X and then branch to
$A955 skipping the second compare
YES, > 63999, GO INDIRECTLY TO
"SYNTAX ERROR".
<<<<<DANGEROUS CODE>>>>>
NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC
JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
FOR OTHER CALLS TO LINGET.
YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
THEN TYPE "GO TO 437761".
ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
THE PROBLEM. ($AB00 - $ABFF)
<<<<<DANGEROUS CODE>>>>>
   
.,A97F A5 14 LDA $14 LDA LINNUM
Zahl * 10 (= *2*2+Zahl*2)
get temporary integer low byte
MULTIPLY BY TEN
   
.,A981 0A ASL ASL A, ;MULTIPLY BY 10.
Wert und Zwischenwert je
*2 low byte
    times 2
.,A982 26 22 ROL $22 ROL INDEX
2 mal um 1 Bit nach
*2 high byte
     
.,A984 0A ASL ASL A
links rollen
*2 low byte
    times 2
.,A985 26 22 ROL $22 ROL INDEX
(entspricht 2 * 2)
*2 high byte (*4)
     
.,A987 65 14 ADC $14 ADC LINNUM
plus ursprünglicher Wert
+ low byte (*5)
    add original
.,A989 85 14 STA $14 STA LINNUM
und abspeichern
save it
     
.,A98B A5 22 LDA $22 LDA INDEX
Zwischenwert zu
get high byte temp
     
.,A98D 65 15 ADC $15 ADC LINNUM+1
zweitem Wert addieren
+ high byte (*5)
     
.,A98F 85 15 STA $15 STA LINNUM+1
und wieder abspeichern
save it
     
.,A991 06 14 ASL $14 ASL LINNUM
Speicherzelle $14 und
*2 low byte (*10d)
    times 2
.,A993 26 15 ROL $15 ROL LINNUM+1
$15 verdoppeln
*2 high byte (*10d)
    = times 10 overall
.,A995 A5 14 LDA $14 LDA LINNUM
Wert wieder laden
get low byte
     
.,A997 65 07 ADC $07 ADC CHARAC ;ADD IN DIGIT.
und Einerziffer addieren
add #
ADD DIGIT
   
.,A999 85 14 STA $14 STA LINNUM
wieder speichern
save low byte
     
.,A99B 90 02 BCC $A99F BCC NXTLGC
Carry gesetzt? (Übertrag)
branch if no overflow to high byte
     
.,A99D E6 15 INC $15 INC LINNUM+1
Übertrag addieren
else increment high byte
     
.,A99F 20 73 00 JSR $0073 NXTLGC: JSR CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory
GET NEXT CHAR
   
.,A9A2 4C 71 A9 JMP $A971 JMP MORLIN
PAGE

"LET" CODE.

und weiter machen

BASIC-Befehl LET

loop for next character

perform LET

MORE CONVERTING

"LET" STATEMENT

LET <VAR> = <EXP>
<VAR> = <EXP>
 

LET command

.,A9A5 20 8B B0 JSR $B08B LET: JSR PTRGET ;GET PNTR TO VARIABLE INTO "VARPNT".
sucht Variable hinter LET
get variable address
GET <VAR>
   
.,A9A8 85 49 STA $49 STWD FORPNT ;PRESERVE POINTER.
und Variablenadresse
save variable address low byte
     
.,A9AA 84 4A STY $4A   merken (LOW- und HIGH-Byte)
save variable address high byte
     
.,A9AC A9 B2 LDA #$B2 SYNCHK EQULTK ;"=" IS NECESSARY.
'=' - Code
$B2 is "=" token
    equals code
.,A9AE 20 FF AE JSR $AEFF IFN INTPRC,<
prüft auf Code
scan for CHR$(A), else do syntax error then warm start
     
.,A9B1 A5 0E LDA $0E LDA INTFLG ;SAVE FOR LATER.
Integer-Flag
get data type flag, $80 = integer, $00 = float
SAVE VARIABLE TYPE
   
.,A9B3 48 PHA PHA>
auf Stapel retten
push data type flag
     
.,A9B4 A5 0D LDA $0D LDA VALTYP ;RETAIN THE VARIABLE'S VALUE TYPE.
und Typ-Flag
get data type flag, $FF = string, $00 = numeric
     
.,A9B6 48 PHA PHA
(String/numerisch) retten
push data type flag
     
.,A9B7 20 9E AD JSR $AD9E JSR FRMEVL ;GET VALUE OF FORMULA INTO "FAC".
FRMEVL: Ausdruck holen
evaluate expression
EVALUATE <EXP>
   
.,A9BA 68 PLA PLA
Typ-Flag wiederholen
pop data type flag
     
.,A9BB 2A ROL ROL A, ;CARRY SET FOR STRING, OFF FOR
;NUMERIC.
und Bit 7 ins Carry schieben
string bit into carry
     
.,A9BC 20 90 AD JSR $AD90 JSR CHKVAL ;MAKE SURE "VALTYP" MATCHES CARRY.
;AND SET ZERO FLAG FOR NUMERIC.
auf richtigen Typ prüfen
do type match check
     
.,A9BF D0 18 BNE $A9D9 BNE COPSTR ;IF NUMERIC, COPY IT.
COPNUM:
IFN INTPRC,<
String? ja: $A9D9
branch if string
     
.,A9C1 68 PLA PLA ;GET NUMBER TYPE.
Integer-Flag zurückholen
pop integer/float data type flag
assign value to numeric variable
     
.,A9C2 10 12 BPL $A9D6 QINTGR: BPL COPFLT ;STORE A FLTING NUMBER.
INTEGER? ja: $A9D6

Wertzuweisung INTEGER

branch if float
expression is numeric integer
REAL VARIABLE
 

assign to integer

.,A9C4 20 1B BC JSR $BC1B JSR ROUND ;ROUND INTEGER.
FAC runden
round FAC1
INTEGER VAR: ROUND TO 32 BITS
   
.,A9C7 20 BF B1 JSR $B1BF JSR AYINT ;MAKE 2-BYTE NUMBER.
und nach INTEGER wandlen
evaluate integer expression, no sign check
TRUNCATE TO 16-BITS
   
.,A9CA A0 00 LDY #$00 LDYI 0
Zeiger setzen
clear index
     
.,A9CC A5 64 LDA $64 LDA FACMO ;GET HIGH.
HIGH-Byte holen und
get FAC1 mantissa 3
     
.,A9CE 91 49 STA ($49),Y STADY FORPNT ;STORE IT.
Wert in Variable bringen
save as integer variable low byte
     
.,A9D0 C8 INY INY
Zeiger erhöhen
increment index
     
.,A9D1 A5 65 LDA $65 LDA FACLO ;GET LOW.
LOW-Byte holen und
get FAC1 mantissa 4
     
.,A9D3 91 49 STA ($49),Y STADY FORPNT
Wert in Variable bringen
save as integer variable high byte
     
.,A9D5 60 RTS RTS>
Rücksprung

Wertzuweisung REAL

 

REAL VARIABLE = EXPRESSION

 

assign to float

.,A9D6 4C D0 BB JMP $BBD0 COPFLT: JMP MOVVF ;PUT NUMBER @FORPNT.
COPSTR:
FAC nach Variable bringen

Wertzuweisung String

pack FAC1 into variable pointer and return
assign value to numeric variable
   

assign to string

.,A9D9 68 PLA IFN INTPRC,<PLA> ;IF STRING, NO INTFLG.
INPCOM:
IFN TIME,<
Akku vom Stapel holen
dump integer/float data type flag

INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4

   
.,A9DA A4 4A LDY $4A LDY FORPNT+1 ;TI$?
Variablenadresse (HIGH) holen
get variable pointer high byte
STRING DATA ALREADY IN STRING AREA?
   
.,A9DC C0 BF CPY #$BF CPYI ZERO/256 ;ONLY TI$ CAN BE THIS ON ASSIG.
ist Variable TI$?
was it TI$ pointer
     
.,A9DE D0 4C BNE $AA2C BNE GETSPT ; WAS NOT TI$.
nein: $AA2C
branch if not
else it's TI$ = <expr$>
   

assign to TI$

.,A9E0 20 A6 B6 JSR $B6A6 JSR FREFAC ;WE WONT NEEDIT.
FRESTR
pop string off descriptor stack, or from top of string
space returns with A = length, X = pointer low byte,
Y = pointer high byte
     
.,A9E3 C9 06 CMP #$06 CMPI 6 ;LENGTH CORRECT?
Stringlänge gleich 6
compare length with 6
    length 6
.,A9E5 D0 3D BNE $AA24 BNE FCERR2
nein: 'illegal quantity'
if length not 6 do illegal quantity error then warm start
     
.,A9E7 A0 00 LDY #$00 LDYI 0 ;YES. DO SETUP.
Wert holen
clear index
     
.,A9E9 84 61 STY $61 STY FACEXP ;ZERO FAC TO START WITH.
und damit FAC
clear FAC1 exponent
     
.,A9EB 84 66 STY $66 STY FACSGN
initialisieren
clear FAC1 sign (b7)
     
.,A9ED 84 71 STY $71 TIMELP: STY FBUFPT ;SAVE POSOTION.
(Akku, Vorzeichen und Zeiger)
save index
     
.,A9EF 20 1D AA JSR $AA1D JSR TIMNUM ;GET A DIGIT.
prüft nächstes Z. auf Ziffer
check and evaluate numeric digit
     
.,A9F2 20 E2 BA JSR $BAE2 JSR MUL10 ;WHOLE QTY BY 10.
FAC = FAC * 10
multiply FAC1 by 10
     
.,A9F5 E6 71 INC $71 INC FBUFPT
Stellenzähler erhöhen
increment index
     
.,A9F7 A4 71 LDY $71 LDY FBUFPT
und ins Y-Reg. bringen
restore index
     
.,A9F9 20 1D AA JSR $AA1D JSR TIMNUM
prüft nächstes Z. auf Ziffer
check and evaluate numeric digit
     
.,A9FC 20 0C BC JSR $BC0C JSR MOVAF
FAC nach ARG kopieren
round and copy FAC1 to FAC2
     
.,A9FF AA TAX TAX ;IF NUM=0 THEN NO MULT.
FAC gleich 0?
copy FAC1 exponent
     
.,AA00 F0 05 BEQ $AA07 BEQ NOML6 ;IF =0, GO TIT.
ja: $AA07
branch if FAC1 zero
     
.,AA02 E8 INX INX ;MULT BY TWO.
Exponent von FAC erhöhen
increment index, * 2
     
.,AA03 8A TXA TXA
(FAC *2) und in den Akku
copy back to A
     
.,AA04 20 ED BA JSR $BAED JSR FINML6 ;ADD IN AND MULT BY 2 GIVES *6.
FAC = FAC + ARG
FAC1 = (FAC1 + (FAC2 * 2)) * 2 = FAC1 * 6
     
.,AA07 A4 71 LDY $71 NOML6: LDY FBUFPT
Stellenzähler
get index
     
.,AA09 C8 INY INY
erhöhen
increment index
     
.,AA0A C0 06 CPY #$06 CPYI 6 ;DONE ALL SIX?
schon 6 Stellen?
compare index with 6
     
.,AA0C D0 DF BNE $A9ED BNE TIMELP
nein: nächstes Zeichen
loop if not 6
     
.,AA0E 20 E2 BA JSR $BAE2 JSR MUL10 ;ONE LAST TIME.
FAC = FAC * 10
multiply FAC1 by 10
     
.,AA11 20 9B BC JSR $BC9B JSR QINT ;SHIFT IT OVER TO THE RIGHT.
FAC rechtsbündig machen
convert FAC1 floating to fixed
     
.,AA14 A6 64 LDX $64 LDXI 2
Werte für
get FAC1 mantissa 3
     
.,AA16 A4 63 LDY $63 SEI ;DISALLOW INTERRUPTS.
eingegebene Uhrzeit
get FAC1 mantissa 2
     
.,AA18 A5 65 LDA $65 TIMEST: LDA FACMOH,X
holen und
get FAC1 mantissa 4
     
.,AA1A 4C DB FF JMP $FFDB STA CQTIMR,X
DEX
BPL TIMEST ;LOOP 3 TIMES.
CLI ;TURN ON INTS AGAIN.
RTS
Time setzen

Zeichen auf Ziffer prüfen

set real time clock and return

check and evaluate numeric digit

   

add next digit to float accum

.,AA1D B1 22 LDA ($22),Y TIMNUM: LDADY INDEX ;INDEX SET UP BY FREFAC.
Zeichen holen (aus String)
get byte from string
     
.,AA1F 20 80 00 JSR $0080 JSR QNUM
auf Ziffer prüfen
clear Cb if numeric. this call should be to $84
as the code from $80 first comapres the byte with
[SPACE] and does a BASIC increment and get if it is
     
.,AA22 90 03 BCC $AA27 BCC GOTNUM
Ziffer: $AA27
branch if numeric
     
.,AA24 4C 48 B2 JMP $B248 FCERR2: JMP FCERR ;MUST BE NUMERIC STRING.
sonst: 'illegal quantity'
do illegal quantity error then warm start
     
.,AA27 E9 2F SBC #$2F GOTNUM: SBCI "0"-1 ;C IS OFF.
von ASCII nach HEX umwandeln
subtract $2F + carry to convert ASCII to binary
     
.,AA29 4C 7E BD JMP $BD7E JMP FINLOG> ;ADD IN DIGIT TO FAC.
in FAC und ARG übertragen

Wertzuweisung an normalen

String

evaluate new ASCII digit and return

assign value to numeric variable, but not TI$

   

assign to string variable

.,AA2C A0 02 LDY #$02 GETSPT: LDYI 2 ;GET PNTR TO DESCRIPTOR.
Zeiger setzen
index to string pointer high byte
     
.,AA2E B1 64 LDA ($64),Y LDADY FACMO
Stringadresse HIGH mit
get string pointer high byte
(STRING AREA IS BTWN FRETOP
   
.,AA30 C5 34 CMP $34 CMP FRETOP+1 ;SEE IF IT POINTS INTO STRING SPACE.
Stringanfangsadr. vergleichen
compare with bottom of string space high byte
HIMEM)
   
.,AA32 90 17 BCC $AA4B BCC DNTCPY ;IF [FRETOP],GT.[2&3,FACMO], DON'T COPY.
kleiner: String im Programm
branch if string pointer high byte is less than bottom
of string space high byte
YES, DATA ALREADY UP THERE
   
.,AA34 D0 07 BNE $AA3D BNE QVARIA ;IT IS LESS.
größer: $AA3D
branch if string pointer high byte is greater than
bottom of string space high byte
else high bytes were equal
NO
   
.,AA36 88 DEY DEY
Zeiger vermindern
decrement index to string pointer low byte
MAYBE, TEST LOW BYTE OF POINTER
   
.,AA37 B1 64 LDA ($64),Y LDADY FACMO
Stringadresse (LOW) holen
get string pointer low byte
     
.,AA39 C5 33 CMP $33 CMP FRETOP ;COMPARE LOW ORDERS.
und vergleichen
compare with bottom of string space low byte
     
.,AA3B 90 0E BCC $AA4B BCC DNTCPY
kleiner: String im Programm
branch if string pointer low byte is less than bottom
of string space low byte
YES, ALREADY THERE
   
.,AA3D A4 65 LDY $65 QVARIA: LDY FACLO
Zeiger auf Stringdescriptor
get descriptor pointer high byte
NO. DESCRIPTOR ALREADY AMONG VARIABLES?
   
.,AA3F C4 2E CPY $2E CPY VARTAB+1 ;IF [VARTAB].GT.[FACMO], DON'T COPY.
mit Variablenstart vergl.
compare with start of variables high byte
     
.,AA41 90 08 BCC $AA4B BCC DNTCPY
kleiner: $AA4B
branch if less, is on string stack
NO
   
.,AA43 D0 0D BNE $AA52 BNE COPY ;IT IS LESS.
größer: $AA52
if greater make space and copy string
else high bytes were equal
YES
   
.,AA45 A5 64 LDA $64 LDA FACMO
Stringdiscriptorzeiger (LOW)
get descriptor pointer low byte
MAYBE, COMPARE LO-BYTE
   
.,AA47 C5 2D CMP $2D CMP VARTAB ;COMPARE LOW ORDERS.
mit Variablenstart vergl.
compare with start of variables low byte
     
.,AA49 B0 07 BCS $AA52 BCS COPY
größer: $AA52
if greater or equal make space and copy string
YES, DESCRIPTOR IS AMONG VARIABLES
   
.,AA4B A5 64 LDA $64 DNTCPY: LDWD FACMO
Zeiger in Akku und Y-Reg.
get descriptor pointer low byte
EITHER STRING ALREADY ON TOP, OR
   
.,AA4D A4 65 LDY $65   auf Stringdescriptor setzen
get descriptor pointer high byte
DESCRIPTOR IS NOT A VARIABLE
   
.,AA4F 4C 68 AA JMP $AA68 JMP COPYZC
bis $AA68 überspringen
go copy descriptor to variable
SO JUST STORE THE DESCRIPTOR

STRING NOT YET IN STRING AREA,

AND DESCRIPTOR IS A VARIABLE

   
.,AA52 A0 00 LDY #$00 COPY: LDYI 0
Zeiger setzen
clear index
POINT AT LENGTH IN DESCRIPTOR
   
.,AA54 B1 64 LDA ($64),Y LDADY FACMO
Länge des Strings holen
get string length
GET LENGTH
   
.,AA56 20 75 B4 JSR $B475 JSR STRINI ;GET ROOM TO COPY STRING INTO.
prüft Platz, setzt Stringz.
copy descriptor pointer and make string space A bytes long
MAKE A STRING THAT LONG UP ABOVE
   
.,AA59 A5 50 LDA $50 LDWD DSCPNT ;GET POINTER TO OLD DESCRIPTOR, SO
Zeiger auf Stringdescriptor
copy old descriptor pointer low byte
SET UP SOURCE PNTR FOR MONINS
   
.,AA5B A4 51 LDY $51   holen (LOW- und HIGH-Byte)
copy old descriptor pointer high byte
     
.,AA5D 85 6F STA $6F STWD STRNG1 ;MOVINS CAN FIND STRING.
und
save old descriptor pointer low byte
     
.,AA5F 84 70 STY $70   speichern
save old descriptor pointer high byte
     
.,AA61 20 7A B6 JSR $B67A JSR MOVINS ;COPY IT.
String in Bereich übertragen
copy string from descriptor to utility pointer
MOVE STRING DATA TO NEW AREA
   
.,AA64 A9 61 LDA #$61 LDWDI DSCTMP ;GET POINTER TO OLD DESCRIPTOR.
Werte laden
get descriptor pointer low byte
ADDRESS OF DESCRIPTOR IS IN FAC
  low 0061
.,AA66 A0 00 LDY #$00   und damit
get descriptor pointer high byte
    high 0061

move descriptor into variable

.,AA68 85 50 STA $50 COPYZC: STWD DSCPNT ;REMEMBER POINTER TO DESCRIPTOR.
Stringdiscriptor
save descriptor pointer low byte
     
.,AA6A 84 51 STY $51   neu setzen
save descriptor pointer high byte
     
.,AA6C 20 DB B6 JSR $B6DB JSR FRETMS ;FREE UP THE TEMPORARY WITHOUT
;FREEING UP ANY STRING SPACE.
Descriptor löschen
clean descriptor stack, YA = pointer
DISCARD DESCRIPTOR IF 'TWAS TEMPORARY
   
.,AA6F A0 00 LDY #$00 LDYI 0
Zeiger setzen
clear index
COPY STRING DESCRIPTOR
   
.,AA71 B1 50 LDA ($50),Y LDADY DSCPNT
Länge des Descriptors holen
get string length from new descriptor
     
.,AA73 91 49 STA ($49),Y STADY FORPNT
und abspeichern
copy string length to variable
     
.,AA75 C8 INY INY ;POINT TO STRING PNTR.
Zeiger erhöhen
increment index
     
.,AA76 B1 50 LDA ($50),Y LDADY DSCPNT
Adresse (LOW) holen
get string pointer low byte from new descriptor
     
.,AA78 91 49 STA ($49),Y STADY FORPNT
und speichern
copy string pointer low byte to variable
     
.,AA7A C8 INY INY
Zeiger erhöhen
increment index
     
.,AA7B B1 50 LDA ($50),Y LDADY DSCPNT
und Adresse (HIGH)
get string pointer high byte from new descriptor
     
.,AA7D 91 49 STA ($49),Y STADY FORPNT
in Variable bringen
copy string pointer high byte to variable
     
.,AA7F 60 RTS RTS
PAGE

PRINT CODE.

IFN EXTIO,<
Rücksprung

BASIC-Befehl PRINT#

perform PRINT#

   

PRINT# comand

.,AA80 20 86 AA JSR $AA86 PRINTN: JSR CMD ;DOCMD
CMD-Befehl
perform CMD
     
.,AA83 4C B5 AB JMP $ABB5 JMP IODONE ;RELEASE CHANNEL.
und CLRCH

BASIC-Befehl CMD

close input and output channels and return

perform CMD

   

CMD command

.,AA86 20 9E B7 JSR $B79E CMD: JSR GETBYT
holt Byte-Ausdruck
get byte parameter
     
.,AA89 F0 05 BEQ $AA90 BEQ SAVEIT
Trennzeichen: $AA90
branch if following byte is ":" or [EOT]
     
.,AA8B A9 2C LDA #$2C SYNCHK 44 ;COMMA?
',', Wert laden
set ","
    comma
.,AA8D 20 FF AE JSR $AEFF   prüft auf Komma
scan for CHR$(A), else do syntax error then warm start
     
.,AA90 08 PHP SAVEIT: PHP
Statusregister merken
save status
     
.,AA91 86 13 STX $13 JSR CQOOUT ;CHECK AND OPEN OUTPUT CHANNL.
Nr. des Ausgabegeräts merken
set current I/O channel
     
.,AA93 20 18 E1 JSR $E118 STX CHANNL ;CHANNL TO OUTPUT ON.
CKOUT, Ausgabegerät setzen
open channel for output with error check
     
.,AA96 28 PLP PLP ;GET STATUS BACK.
Statusregister wiederholen
restore status
     
.,AA97 4C A0 AA JMP $AAA0 JMP PRINT>
zum PRINT-Befehl
perform PRINT
    do PRINT
.,AA9A 20 21 AB JSR $AB21 STRDON: JSR STRPRT
String drucken
print string from utility pointer
     
.,AA9D 20 79 00 JSR $0079 NEWCHR: JSR CHRGOT ;REGET LAST CHARACTER.
CHRGOT letztes Zeichen

BASIC-Befehl PRINT

scan memory

perform PRINT

"PRINT" STATEMENT

 

PRINT command

.,AAA0 F0 35 BEQ $AAD7 PRINT: BEQ CRDO ;TERMINATOR SO TYPE CRLF.
Trennzeichen: $AAD7
if nothing following just print CR/LF
NO MORE LIST, PRINT <RETURN>
   
.,AAA2 F0 43 BEQ $AAE7 PRINTC: BEQ PRTRTS ;HERE AFTER SEEING TAB(X) OR , OR ;
;IN WHICH CASE A TERMINATOR DOES NOT
;MEAN TYPE A CRLF BUT JUST RTS.
Trennz. (TAB, SPC): RTS
exit if nothing following, end of PRINT branch
NO MORE LIST, DON'T PRINT <RETURN>
   
.,AAA4 C9 A3 CMP #$A3 CMPI TABTK ;TAB FUNCTION?
'TAB('-Code?
compare with token for TAB(
    TAB( code
.,AAA6 F0 50 BEQ $AAF8 BEQ TABER ;YES.
ja: $AAF8
if TAB( go handle it
C=1 FOR TAB(
   
.,AAA8 C9 A6 CMP #$A6 CMPI SPCTK ;SPACE FUNCTION?
'SPC('-Code?
compare with token for SPC(
    SPC( code
.,AAAA 18 CLC CLC
Flag für SPC setzen
flag SPC(
     
.,AAAB F0 4B BEQ $AAF8 BEQ TABER
SPC-Code: $AAF8
if SPC( go handle it
C=0 FOR SPC(
   
.,AAAD C9 2C CMP #$2C CMPI 44 ;A COMMA?
','-Code? (Komma)
compare with ","
    comma
.,AAAF F0 37 BEQ $AAE8 BEQ COMPRT ;YES.
ja: $AAE8
if "," go skip to the next TAB position
     
.,AAB1 C9 3B CMP #$3B CMPI 59 ;A SEMICOLON?
';'-Code? (Semikolon)
compare with ";"
    semi-colon
.,AAB3 F0 5E BEQ $AB13 BEQ NOTABR ;YES.
ja: nächstes Zeichen, weiter
if ";" go continue the print loop
     
.,AAB5 20 9E AD JSR $AD9E JSR FRMEVL ;EVALUATE THE FORMULA.
FRMEVL: Term holen
evaluate expression
EVALUATE EXPRESSION
   
.,AAB8 24 0D BIT $0D BIT VALTYP ;A STRING?
Typflag
test data type flag, $FF = string, $00 = numeric
STRING OR FP VALUE?
   
.,AABA 30 DE BMI $AA9A BMI STRDON ;YES.
String?
if string go print string, scan memory and continue PRINT
STRING
   
.,AABC 20 DD BD JSR $BDDD JSR FOUT
FAC in ASCII-String wandeln
convert FAC1 to ASCII string result in (AY)
FP: CONVERT INTO BUFFER
   
.,AABF 20 87 B4 JSR $B487 JSR STRLIT ;BUILD DESCRIPTOR.
IFN REALIO-3,<
LDYI 0 ;GET THE POINTER.
LDADY FACMO
CLC
ADC TRMPOS ;MAKE SURE LEN+POS.LT.WIDTH.
CMP LINWID ;GREATER THAN LINE LENGTH?
;REMEMBER SPACE PRINTED AFTER NUMBER.
BCC LINCHK ;GO TYPE.
JSR CRDO> ;YES, TYPE CRLF FIRST.
Stringparameter holen
print " terminated string to utility pointer
MAKE BUFFER INTO STRING
   
.,AAC2 20 21 AB JSR $AB21 LINCHK: JSR STRPRT ;PRINT THE NUMBER.
String drucken
print string from utility pointer
     
.,AAC5 20 3B AB JSR $AB3B JSR OUTSPC ;PRINT A SPACE
Cursor right bzw. Leerzeichen
print [SPACE] or [CURSOR RIGHT]
     
.,AAC8 D0 D3 BNE $AA9D BNEA NEWCHR ;ALWAYS GOES.
IFN REALIO-4,<
IFN BUFPAG,<
weiter machen
go scan memory and continue PRINT, branch always

set XY to $0200 - 1 and print [CR]

PRINT THE STRING
 

end statement in buffer and screen

.,AACA A9 00 LDA #$00 FININL: LDAI 0
Eingabepuffer
clear A
     
.,AACC 9D 00 02 STA $0200,X STA BUF,X
mit $0 abschließen
clear first byte of input buffer
     
.,AACF A2 FF LDX #$FF LDXYI BUF-1>
Zeiger auf
$0200 - 1 low byte
     
.,AAD1 A0 01 LDY #$01 IFE BUFPAG,<
FININL: LDYI 0 ;PUT A ZERO AT END OF BUF.
STY BUF,X
LDXI BUF-1> ;SETUP POINTER.
IFN EXTIO,<
Eingabepuffer ab $0200 setzen
$0200 - 1 high byte
     
.,AAD3 A5 13 LDA $13 LDA CHANNL ;NO CRDO IF NOT TERMINAL.
Nummer des Ausgabegeräts
get current I/O channel
     
.,AAD5 D0 10 BNE $AAE7 BNE PRTRTS>>
CRDO:
IFE EXTIO,<
LDAI 13 ;MAKE TRMPOS LESS THAN LINE LENGTH.
STA TRMPOS>
IFN EXTIO,<
IFN REALIO-3,<
LDA CHANNL
BNE GOCR
STA TRMPOS>
Tastatur? nein: RTS
exit if not default channel

print CR/LF

   

end line on CMD output file

.,AAD7 A9 0D LDA #$0D GOCR: LDAI 13> ;X AND Y MUST BE PRESERVED.
'CR' carriage return
set [CR]
PRINT <RETURN>
   
.,AAD9 20 47 AB JSR $AB47 JSR OUTDO
ausgeben
print the character
     
.,AADC 24 13 BIT $13 LDAI 10
logische Filenummer
test current I/O channel
     
.,AADE 10 05 BPL $AAE5 JSR OUTDO
kleiner 128?
if ?? toggle A, EOR #$FF and return
     
.,AAE0 A9 0A LDA #$0A CRFIN:
'LF' line feed
set [LF]
     
.,AAE2 20 47 AB JSR $AB47 IFN EXTIO,<
ausgeben
print the character
toggle A
     
.,AAE5 49 FF EOR #$FF IFN REALIO-3,<
NOT
invert A
<<< WHY??? >>>
   
.,AAE7 60 RTS LDA CHANNL
BNE PRTRTS>>
IFE NULCMD,<
IFN REALIO-3,<
LDAI 0
STA TRMPOS>
EORI 255>
IFN NULCMD,<
TXA ;PRESERVE [ACCX]. SOME NEED IT.
PHA
LDX NULCNT ;GET NUMBER OF NULLS.
BEQ CLRPOS
LDAI 0
PRTNUL: JSR OUTDO
DEX ;DONE WITH NULLS?
BNE PRTNUL
CLRPOS: STX TRMPOS
PLA
TAX>
PRTRTS: RTS
COMPRT: LDA TRMPOS
NCMPOS==<<<LINLEN/CLMWID>-1>*CLMWID> ;CLMWID BEYOND WHICH THERE ARE
IFN REALIO-3,<
;NO MORE COMMA FIELDS.
CMP NCMWID ;SO ALL COMMA DOES IS "CRDO".
Rücksprung
was ","
   

routine for printing TAB( and SPC(

.,AAE8 38 SEC BCC MORCOM
Zehner-Tabulator mit Komma
set Cb for read cursor position
     
.,AAE9 20 F0 FF JSR $FFF0 JSR CRDO ;TYPE CRLF.
Cursorposition holen
read/set X,Y cursor position
     
.,AAEC 98 TYA JMP NOTABR> ;AND QUIT IF BEYOND LAST FIELD.
Spalte ins Y-Reg.
copy cursor Y
     
.,AAED 38 SEC MORCOM: SEC
Carry setzen (Subtr.)
set carry for subtract
     
.,AAEE E9 0A SBC #$0A MORCO1: SBCI CLMWID ;GET [A] MODULUS CLMWID.
10 abziehen
subtract one TAB length
     
.,AAF0 B0 FC BCS $AAEE BCS MORCO1
nicht negativ?
loop if result was +ve
     
.,AAF2 49 FF EOR #$FF EORI 255 ;FILL PRINT POS OUT TO EVEN CLMWID SO
invertieren
complement it
     
.,AAF4 69 01 ADC #$01 ADCI 1
+1 (Zweierkomplement)
+1, twos complement
     
.,AAF6 D0 16 BNE $AB0E BNE ASPAC ;PRINT [A] SPACES.
unbedingter Sprung

TAB( (C=1) und SPC( (C=0)

always print A spaces, result is never $00
     
.,AAF8 08 PHP TABER: PHP ;REMEMBER IF SPC OR TAB FUNCTION.
Flags merken
save TAB( or SPC( status
C=0 FOR SPC(, C=1 FOR TAB(
   
.,AAF9 38 SEC JSR GTBYTC ;GET VALUE INTO ACCX.
Carry setzen
set Cb for read cursor position
     
.,AAFA 20 F0 FF JSR $FFF0   Cursorposition holen
read/set X,Y cursor position
     
.,AAFD 84 09 STY $09   und Spalte merken
save current cursor position
     
.,AAFF 20 9B B7 JSR $B79B   Byte-Wert holen
scan and get byte parameter
GET VALUE
   
.,AB02 C9 29 CMP #$29 CMPI 41
')' Klammer zu?
compare with ")"
TRAILING PARENTHESIS
  )
.,AB04 D0 59 BNE $AB5F BNE SNERR4
nein: 'SYNTAX ERROR'
if not ")" do syntax error
NO, SYNTAX ERROR
   
.,AB06 28 PLP PLP
Flags wiederherstellen
restore TAB( or SPC( status
TAB( OR SPC(
   
.,AB07 90 06 BCC $AB0F BCC XSPAC ;PRINT [X] SPACES.
zu SPC(
branch if was SPC(
else was TAB(
SPC(
   
.,AB09 8A TXA TXA
TAB-Wert in Akku
copy TAB() byte to A
CALCULATE SPACES NEEDED FOR TAB(
   
.,AB0A E5 09 SBC $09 SBC TRMPOS
mit Cursorspalte vergleichen
subtract current cursor position
     
.,AB0C 90 05 BCC $AB13 BCC NOTABR ;NEGATIVE, DON'T PRINT ANY.
kleiner Cursor-Position: RTS
go loop for next if already past requited position
ALREADY PAST THAT COLUMN
   
.,AB0E AA TAX ASPAC: TAX
Schritte bis zum Tabulator
copy [SPACE] count to X
NOW DO A SPC( TO THE SPECIFIED COLUMN
   
.,AB0F E8 INX XSPAC: INX
aus Zähler initialisieren
increment count
     
.,AB10 CA DEX XSPAC2: DEX ;DECREMENT THE COUNT.
um 1 vermindern
decrement count
     
.,AB11 D0 06 BNE $AB19 BNE XSPAC1
=0? nein: Cursor right
branch if count was not zero
was ";" or [SPACES] printed
MORE SPACES TO PRINT
   
.,AB13 20 73 00 JSR $0073 NOTABR: JSR CHRGET ;REGET LAST CHARACTER.
nächstes Zeichen holen
increment and scan memory
     
.,AB16 4C A2 AA JMP $AAA2 JMP PRINTC ;DON'T CALL CRDO.
und weitermachen
continue print loop
CONTINUE PARSING PRINT LIST
   
.,AB19 20 3B AB JSR $AB3B XSPAC1: JSR OUTSPC
Cursor right bzw. Leerzeichen
print [SPACE] or [CURSOR RIGHT]
     
.,AB1C D0 F2 BNE $AB10 BNEA XSPAC2
;
; PRINT THE STRING POINTED TO BY [Y,A] WHICH ENDS WITH A ZERO.
; IF THE STRING IS BELOW DSCTMP IT WILL BE COPIED INTO STRING SPACE.
;
zum Schleifenanfang

String ausgeben

loop, branch always

print null terminated string

...ALWAYS

PRINT STRING AT (Y,A)

 

print string form AY

.,AB1E 20 87 B4 JSR $B487 STROUT: JSR STRLIT ;GET A STRING LITERAL.
;
; PRINT THE STRING WHOSE DESCRIPTOR IS POINTED TO BY FACMO.
;
Stringparameter holen
print " terminated string to utility pointer

print string from utility pointer

MAKE (Y,A) PRINTABLE

PRINT STRING AT (FACMO,FACLO)

 

print string from $22/$23

.,AB21 20 A6 B6 JSR $B6A6 STRPRT: JSR FREFAC ;RETURN TEMP POINTER.
FRESTR
pop string off descriptor stack, or from top of string
space returns with A = length, X = pointer low byte,
Y = pointer high byte
GET ADDRESS INTO INDEX, (A)=LENGTH
   
.,AB24 AA TAX TAX ;PUT COUNT INTO COUNTER.
Stringlänge
copy length
USE X-REG FOR COUNTER
   
.,AB25 A0 00 LDY #$00 LDYI 0
Zeiger für Stringausgabe
clear index
USE Y-REG FOR SCANNER
   
.,AB27 E8 INX INX ;MOVE ONE AHEAD.
erhöhen
increment length, for pre decrement loop
     
.,AB28 CA DEX STRPR2: DEX
vermindern
decrement length
     
.,AB29 F0 BC BEQ $AAE7 BEQ PRTRTS ;ALL DONE.
String zu Ende?
exit if done
FINISHED
   
.,AB2B B1 22 LDA ($22),Y LDADY INDEX ;PNTR TO ACT STRNG SET BY FREFAC.
Zeichen des Strings
get byte from string
NEXT CHAR FROM STRING
   
.,AB2D 20 47 AB JSR $AB47 JSR OUTDO
ausgeben
print the character
PRINT THE CHAR
   
.,AB30 C8 INY INY
Zeiger erhöhen
increment index
<<< NEXT THREE LINES ARE USELESS >>>
   
.,AB31 C9 0D CMP #$0D CMPI 13
'CR' carriage return?
compare byte with [CR]
WAS IT <RETURN>?
   
.,AB33 D0 F3 BNE $AB28 BNE STRPR2
nein: weiter
loop if not [CR]
NO
   
.,AB35 20 E5 AA JSR $AAE5 JSR CRFIN ;TYPE REST OF CARRIAGE RETURN.
Fehler ! Test auf LF-Ausgabe
toggle A, EOR #$FF. what is the point of this ??
EOR #$FF WOULD DO IT, BUT WHY?
<<< ABOVE THREE LINES ARE USELESS >>>
   
.,AB38 4C 28 AB JMP $AB28 JMP STRPR2 ;AND ON AND ON.
;
; OUTDO OUTPUTS THE CHARACTER IN ACCA, USING CNTWFL
; (SUPPRESS OR NOT), TRMPOS (PRINT HEAD POSITION),
; TIMING, ETCQ. NO REGISTERS ARE CHANGED.
;
OUTSPC:
IFN REALIO-3,<
LDAI " ">
IFE REALIO-3,<
und weitermachen

Ausgabe eines Leerzeichens

bzw. Cursor right

loop

print [SPACE] or [CURSOR RIGHT]

   

print character on CMD output file

.,AB3B A5 13 LDA $13 LDA CHANNL
Ausgabe in File?
get current I/O channel
     
.,AB3D F0 03 BEQ $AB42 BEQ CRTSKP
Bildschirm: dann Cursor right
if default channel go output [CURSOR RIGHT]
     
.,AB3F A9 20 LDA #$20 LDAI " "
' ' Leerzeichencode laden
else output [SPACE]
PRINT A SPACE
  space
.:AB41 2C .BYTE $2C SKIP2
  makes next line BIT $1DA9
SKIP OVER NEXT LINE
   
.,AB42 A9 1D LDA #$1D CRTSKP: LDAI 29> ;COMMODORE'S SKIP CHARACTER.
Cursor right Code laden
set [CURSOR RIGHT]
    csr right
.:AB44 2C .BYTE $2C SKIP2
  makes next line BIT $3FA9

print "?"

SKIP OVER NEXT LINE
   
.,AB45 A9 3F LDA #$3F OUTQST: LDAI "?"
OUTDO: IFN REALIO,<
BIT CNTWFL ;SHOULDN'T AFFECT CHANNEL I/O!
BMI OUTRTS>
IFN REALIO-3,<
PHA
CMPI 32 ;IS THIS A PRINTING CHAR?
BCC TRYOUT ;NO, DON'T INCLUDE IT IN TRMPOS.
LDA TRMPOS
CMP LINWID ;LENGTH = TERMINAL WIDTH?
BNE OUTDO1
JSR CRDO ;YES, TYPE CRLF
OUTDO1:
IFN EXTIO,<
LDA CHANNL
BNE TRYOUT>
INCTRM: INC TRMPOS ;INCREMENT COUNT.
TRYOUT: PLA> ;RESTORE THE A REGISTER
IFE REALIO-1,<
STY KIMY> ;PRESERVE Y.
IFE REALIO-4,<ORAI ^O200> ;TURN ON B7 FOR APPLE.
IFN REALIO,<
'?' Fragezeichencode laden
set "?"

print character

PRINT QUESTION MARK
  question mark
.,AB47 20 0C E1 JSR $E10C OUTLOC: JSR OUTCH> ;OUTPUT THE CHARACTER.
IFE REALIO-1,<
LDY KIMY> ;GET Y BACK.
IFE REALIO-2,<REPEAT 4,<NOP>>
IFE REALIO-4,<ANDI ^O177> ;GET [A] BACK FROM APPLE.
IFE REALIO,<
TJSR OUTSIM##> ;CALL SIMULATOR OUTPUT ROUTINE
Code ausgeben
output character to channel with error check
     
.,AB4A 29 FF AND #$FF OUTRTS: ANDI 255 ;SET Z=0.
Flags setzen
set the flags on A

PRINT CHAR FROM (A)

NOTE: POKE 243,32 ($20 IN $F3) WILL CONVERT
OUTPUT TO LOWER CASE. THIS CAN BE CANCELLED
BY NORMAL, INVERSE, OR FLASH OR POKE 243,0.
   
.,AB4C 60 RTS GETRTS: RTS
PAGE

INPUT AND READ CODE.

;
; HERE WHEN THE DATA THAT WAS TYPED IN OR IN "DATA" STATEMENTS
; IS IMPROPERLY FORMATTED. FOR "INPUT" WE START AGAIN.
; FOR "READ" WE GIVE A SYNTAX ERROR AT THE DATA LINE.
;
Rücksprung

Fehlerbehandlung bei Eingabe

bad input routine

INPUT CONVERSION ERROR

ILLEGAL CHARACTER IN NUMERIC FIELD.
MUST DISTINGUISH BETWEEN INPUT, READ, AND GET
 

read errors

.,AB4D A5 11 LDA $11 TRMNOK: LDA INPFLG
Flag für INPUT / GET / READ
get INPUT mode flag, $00 = INPUT, $40 = GET, $98 = READ
     
.,AB4F F0 11 BEQ $AB62 BEQ TRMNO1 ;IF INPUT TRY AGAIN.
IFN GETCMD,<
INPUT: $AB62
branch if INPUT
TAKEN IF INPUT
   
.,AB51 30 04 BMI $AB57 BMI GETDTL
READ: $AB57
branch if READ
else was GET
TAKEN IF READ
   
.,AB53 A0 FF LDY #$FF LDYI 255 ;MAKE IT LOOK DIRECT.
GET:
set current line high byte to -1, indicate immediate mode
FROM A GET
   
.,AB55 D0 04 BNE $AB5B BNEA STCURL ;ALWAYS GOES.
GETDTL:>
unbedingter Sprung

Fehler bei READ

branch always
...ALWAYS
   
.,AB57 A5 3F LDA $3F LDWD DATLIN ;GET DATA LINE NUMBER.
DATA-Zeilennummer
get current DATA line number low byte
TELL WHERE THE "DATA" IS, RATHER
   
.,AB59 A4 40 LDY $40   holen (LOW- und HIGH-Byte)

Fehler bei GET

get current DATA line number high byte
THAN THE "READ"
   
.,AB5B 85 39 STA $39 STCURL: STWD CURLIN ;MAKE IT CURRENT LINE.
gleiche Zeilennummer
set current line number low byte
     
.,AB5D 84 3A STY $3A   des Fehlers
set current line number high byte
     
.,AB5F 4C 08 AF JMP $AF08 SNERR4: JMP SNERR
TRMNO1:
IFN EXTIO,<
'SYNTAX ERROR'

Fehler bei INPUT

do syntax error then warm start
was INPUT
     
.,AB62 A5 13 LDA $13 LDA CHANNL ;IF NOT TERMINAL, GIVE BAD DATA.
Nummer des Eingabegeräts
get current I/O channel
     
.,AB64 F0 05 BEQ $AB6B BEQ DOAGIN
Tastatur: 'REDO FROM START'
branch if default channel
     
.,AB66 A2 18 LDX #$18 LDXI ERRBD
Nummer für 'FILE DATA'
else error $18, file data error
ERROR CODE = 254
   
.,AB68 4C 37 A4 JMP $A437 JMP ERROR>
Fehlermeldung ausgeben
do error #X then warm start
     
.,AB6B A9 0C LDA #$0C DOAGIN: LDWDI TRYAGN
Zeiger in Akku und Y-Reg.
set "?REDO FROM START" pointer low byte
"?REENTER"
  low AD0C
.,AB6D A0 AD LDY #$AD   auf '?REDO FROM START'
set "?REDO FROM START" pointer high byte
    high AD0C
.,AB6F 20 1E AB JSR $AB1E JSR STROUT ;PRINT "?REDO FROM START".
String ausgeben
print null terminated string
     
.,AB72 A5 3D LDA $3D LDWD OLDTXT ;POINT AT START
Werte holen und
get continue pointer low byte
RE-EXECUTE THE WHOLE INPUT STATEMENT
   
.,AB74 A4 3E LDY $3E   Programmzeiger
get continue pointer high byte
     
.,AB76 85 7A STA $7A STWD TXTPTR ;OF THIS CURRENT LINE.
zurücksetzen
save BASIC execute pointer low byte
     
.,AB78 84 7B STY $7B   auf INPUT-Befehl
save BASIC execute pointer high byte
     
.,AB7A 60 RTS RTS ;GO TO "NEWSTT".
IFN GETCMD,<
Rücksprung

BASIC-Befehl GET

perform GET

"GET" STATEMENT

 

GET command

.,AB7B 20 A6 B3 JSR $B3A6 GET: JSR ERRDIR ;DIRECT IS NOT OK.
IFN EXTIO,<
Testet auf Direkt-Modus
check not Direct, back here if ok
ILLEGAL IF IN DIRECT MODE
   
.,AB7E C9 23 CMP #$23 CMPI "#" ;SEE IF "GET#".
folgt '#’?
compare with "#"
    #
.,AB80 D0 10 BNE $AB92 BNE GETTTY ;NO, JUST GET TTY INPUT.
nein: $AB92
branch if not GET#
     
.,AB82 20 73 00 JSR $0073 JSR CHRGET ;MOVE UP TO NEXT BYTE.
CHRGET nächstes Zeichen holen
increment and scan memory
     
.,AB85 20 9E B7 JSR $B79E JSR GETBYT ;GET CHANNEL INTO X
Byte-Wert holen
get byte parameter
     
.,AB88 A9 2C LDA #$2C SYNCHK 44 ;COMMA?
',' Komma
set ","
    comma
.,AB8A 20 FF AE JSR $AEFF   prüft auf Code
scan for CHR$(A), else do syntax error then warm start
     
.,AB8D 86 13 STX $13 JSR CQOIN ;GET CHANNEL OPEN FOR INPUT.
Filenummer
set current I/O channel
     
.,AB8F 20 1E E1 JSR $E11E STX CHANNL>
CHKIN, Eingabe vorbereiten
open channel for input with error check
     
.,AB92 A2 01 LDX #$01 GETTTY: LDXYI BUF+1 ;POINT TO 0.
Zeiger auf
set pointer low byte
SIMULATE INPUT
   
.,AB94 A0 02 LDY #$02 IFN BUFPAG,<
Pufferende = $201 ein Zeichen
set pointer high byte
     
.,AB96 A9 00 LDA #$00 LDAI 0 ;TO STUFF AND TO POINT.
Wert laden und
clear A
     
.,AB98 8D 01 02 STA $0201 STA BUF+1>
IFE BUFPAG,<
STY BUF+1> ;ZERO IT.
Puffer mit $0 abschließen
ensure null terminator
     
.,AB9B A9 40 LDA #$40 LDAI 64 ;TURN ON V-BIT.
GET-Flag
input mode = GET
SET UP INPUTFLG
  GET code
.,AB9D 20 0F AC JSR $AC0F JSR INPCO1 ;DO THE GET.
IFN EXTIO,<
Wertzuweisung an Variable
perform the GET part of READ
     
.,ABA0 A6 13 LDX $13 LDX CHANNL
Eingabegerät
get current I/O channel
     
.,ABA2 D0 13 BNE $ABB7 BNE IORELE> ;RELEASE.
nicht Tastatur, dann CLRCH
if not default channel go do channel close and return
     
.,ABA4 60 RTS RTS>
IFN EXTIO,<
Rücksprung

BASIC-Befehl INPUT#

perform INPUT#

   

INPUT# command

.,ABA5 20 9E B7 JSR $B79E INPUTN: JSR GETBYT ;GET CHANNEL NUMBER.
holt Byte-Wert
get byte parameter
     
.,ABA8 A9 2C LDA #$2C SYNCHK 44 ;A COMMA?
',' Code für Komma
set ","
    comma
.,ABAA 20 FF AE JSR $AEFF   prüft auf Komma
scan for CHR$(A), else do syntax error then warm start
     
.,ABAD 86 13 STX $13 JSR CQOIN ;GO WHERE COMMODORE CHECKS IN OPEN.
Eingabegerät
set current I/O channel
     
.,ABAF 20 1E E1 JSR $E11E STX CHANNL
CHKIN, Eingabe vorbereiten
open channel for input with error check
     
.,ABB2 20 CE AB JSR $ABCE JSR NOTQTI ;DO INPUT TO VARIABLES.
INPUT ohne Dialogstring
perform INPUT with no prompt string

close input and output channels

     
.,ABB5 A5 13 LDA $13 IODONE: LDA CHANNL ;RELEASE CHANNEL.
Eingabegerät im Akku
get current I/O channel
     
.,ABB7 20 CC FF JSR $FFCC IORELE: JSR CQCCHN
setzt Eingabegerät zurück
close input and output channels
     
.,ABBA A2 00 LDX #$00 LDXI 0 ;RESET CHANNEL TO TERMINAL.
Wert laden und
clear X
     
.,ABBC 86 13 STX $13 STX CHANNL
Eingabegerät wieder Tastatur
clear current I/O channel, flag default
     
.,ABBE 60 RTS RTS>
INPUT: IFN REALIO,<
LSR CNTWFL> ;BE TALKATIVE.
Rücksprung

BASIC-Befehl INPUT

perform INPUT

"INPUT" STATEMENT

 

INPUT command

.,ABBF C9 22 CMP #$22 CMPI 34 ;A QUOTE?
'"' Hochkomma?
compare next byte with open quote
CHECK FOR OPTIONAL PROMPT STRING
  quote mark
.,ABC1 D0 0B BNE $ABCE BNE NOTQTI ;NO MESSAGE.
nein: $ABDE
if no prompt string just do INPUT
NO, PRINT "?" PROMPT
   
.,ABC3 20 BD AE JSR $AEBD JSR STRTXT ;LITERALIZE THE STRING IN TEXT
Dialogstring holen
print "..." string
MAKE A PRINTABLE STRING OUT OF IT
   
.,ABC6 A9 3B LDA #$3B SYNCHK 59 ;MUST END WITH SEMICOLON.
';' Semikolon
load A with ";"
MUST HAVE ; NOW
  semi-colon
.,ABC8 20 FF AE JSR $AEFF   prüft auf Code
scan for CHR$(A), else do syntax error then warm start
     
.,ABCB 20 21 AB JSR $AB21 JSR STRPRT ;PRINT IT OUT.
String ausgeben
print string from utility pointer
done with prompt, now get data
PRINT THE STRING
   
.,ABCE 20 A6 B3 JSR $B3A6 NOTQTI: JSR ERRDIR ;USE COMMON ROUTINE SINCE DEF DIRECT
prüft auf Direkt-Modus
check not Direct, back here if ok
ILLEGAL IF IN DIRECT MODE
   
.,ABD1 A9 2C LDA #$2C LDAI 44 ;GET COMMA.
',' Komma
set ","
PRIME THE BUFFER
  comma
.,ABD3 8D FF 01 STA $01FF STA BUF-1
;IS ALSO ILLEGAL.
an Pufferstart
save to start of buffer - 1
     
.,ABD6 20 F9 AB JSR $ABF9 GETAGN: JSR QINLIN ;TYPE "?" AND INPUT A LINE OF TEXT.
IFN EXTIO,<
Fragezeichen ausgeben
print "? " and get BASIC input
NO STRING, PRINT "?"
   
.,ABD9 A5 13 LDA $13 LDA CHANNL
Nummer des Eingabegeräts
get current I/O channel
     
.,ABDB F0 0D BEQ $ABEA BEQ BUFFUL
Tastatur? ja: $ABEA
branch if default I/O channel
     
.,ABDD 20 B7 FF JSR $FFB7 LDA CQSTAT ;GET STATUS BYTE.
Status holen
read I/O status word
     
.,ABE0 29 02 AND #$02 ANDI 2
Bit 1 isolieren (Tineout R.)
mask no DSR/timeout
     
.,ABE2 F0 06 BEQ $ABEA BEQ BUFFUL ;A-OK.
Time-out?
branch if not error
     
.,ABE4 20 B5 AB JSR $ABB5 JSR IODONE ;BAD. CLOSE CHANNEL.
ja: CLRCH,Tastatur aktivieren
close input and output channels
     
.,ABE7 4C F8 A8 JMP $A8F8 JMP DATA ;SKIP REST OF INPUT.
BUFFUL:>
nächstes Statement ausführen
perform DATA
    do DATA
.,ABEA AD 00 02 LDA $0200 LDA BUF ;ANYTHING INPUT?
erstes Zeichen holen
get first byte in input buffer
     
.,ABED D0 1E BNE $AC0D BNE INPCON ;YES, CONTINUE.
IFN EXTIO,<
Ende?
branch if not null
else ..
     
.,ABEF A5 13 LDA $13 LDA CHANNL ;BLANK LINE MEANS GET ANOTHER.
ja: Eingabegerät
get current I/O channel
     
.,ABF1 D0 E3 BNE $ABD6 BNE GETAGN> ;IF NOT TERMINAL.
nicht Tastatur: $ABD6
if not default channel go get BASIC input
     
.,ABF3 20 06 A9 JSR $A906 CLC ;MAKE SURE DONT PRINT BREAK
Offset (Statement) suchen
scan for next BASIC statement ([:] or [EOL])
     
.,ABF6 4C FB A8 JMP $A8FB JMP STPEND ;NO, STOP.
QINLIN:
IFN EXTIO,<
Programmzeiger auf Statement
add Y to the BASIC execute pointer and return

print "? " and get BASIC input

   

get line into input buffer

.,ABF9 A5 13 LDA $13 LDA CHANNL
Eingabegerät holen
get current I/O channel
     
.,ABFB D0 06 BNE $AC03 BNE GINLIN>
nicht Tastatur: $AC03
skip "?" prompt if not default channel
     
.,ABFD 20 45 AB JSR $AB45 JSR OUTQST
'?' ausgeben
print "?"
     
.,AC00 20 3B AB JSR $AB3B JSR OUTSPC
' ' Leerzeichen ausgeben
print [SPACE] or [CURSOR RIGHT]
     
.,AC03 4C 60 A5 JMP $A560 GINLIN: JMP INLIN
Eingabezeile holen

BASIC-Befehl READ

call for BASIC input and return

perform READ

"READ" STATEMENT

 

READ command

.,AC06 A6 41 LDX $41 READ: LDXY DATPTR ;GET LAST DATA LOCATION.
DATA-Zeiger nach
get DATA pointer low byte
Y,X POINTS AT NEXT DATA STATEMENT
   
.,AC08 A4 42 LDY $42   $41/42 holen
get DATA pointer high byte
     
.,AC0A A9 98 LDA #$98 XWD ^O1000,^O251 ;LDAI TYA TO MAKE IT NONZERO.
IFE BUFPAG,<
INPCON: >
TYA
IFN BUFPAG,<
READ-Flag
set input mode = READ
SET INPUTFLG = $98
  READ code
.:AC0C 2C .BYTE $2C SKIP2
  makes next line BIT $00A9
     
.,AC0D A9 00 LDA #$00 INPCON: LDAI 0> ;SET FLAG THAT THIS IS INPUT
Flagwert laden
set input mode = INPUT

perform GET

SET INPUTFLG = $00

PROCESS INPUT LIST

(Y,X) IS ADDRESS OF INPUT DATA STRING
(A) = VALUE FOR INPUTFLG: $00 FOR INPUT
$40 FOR GET
$98 FOR READ
   
.,AC0F 85 11 STA $11 INPCO1: STA INPFLG ;STORE THE FLAG.
;
; IN THE PROCESSING OF DATA AND READ STATEMENTS:
; ONE POINTER POINTS TO THE DATA (IE, THE NUMBERS BEING FETCHED)
; AND ANOTHER POINTS TO THE LIST OF VARIABLES.
;
; THE POINTER INTO THE DATA ALWAYS STARTS POINTING TO A
; TERMINATOR -- A , : OR END-OF-LINE.
;
; AT THIS POINT TXTPTR POINTS TO LIST OF VARIABLES AND
; [Y,X] POINTS TO DATA OR INPUT LINE.
;
und INPUT-Zeiger setzen
set input mode flag, $00 = INPUT, $40 = GET, $98 = READ
     
.,AC11 86 43 STX $43 STXY INPPTR
INPUT-Zeiger auf
save READ pointer low byte
ADDRESS OF INPUT STRING
   
.,AC13 84 44 STY $44   Eingabequelle setzen
save READ pointer high byte
READ, GET or INPUT next variable from list
     
.,AC15 20 8B B0 JSR $B08B INLOOP: JSR PTRGET ;READ VARIABLE LIST.
sucht Variable
get variable address
GET ADDRESS OF VARIABLE
   
.,AC18 85 49 STA $49 STWD FORPNT ;SAVE POINTER FOR "LET" STRING STUFFING.
Vari ablenadresse
save address low byte
     
.,AC1A 84 4A STY $4A ;RETURNS PNTR TOP VAR IN VARPNT.
speichern
save address high byte
     
.,AC1C A5 7A LDA $7A LDWD TXTPTR ;SAVE TEXT PNTR.
LOW- und HIGH-Byte des
get BASIC execute pointer low byte
SAVE CURRENT TXTPTR,
   
.,AC1E A4 7B LDY $7B   Programmzeigers
get BASIC execute pointer high byte
WHICH POINTS INTO PROGRAM
   
.,AC20 85 4B STA $4B STWD VARTXT
in $4B/$4C
save BASIC execute pointer low byte
     
.,AC22 84 4C STY $4C   Zwischenspeichern
save BASIC execute pointer high byte
     
.,AC24 A6 43 LDX $43 LDXY INPPTR
INPUT-Zeiger
get READ pointer low byte
SET TXTPTR TO POINT AT INPUT BUFFER
   
.,AC26 A4 44 LDY $44   (LOW und HIGH)
get READ pointer high byte
OR "DATA" LINE
   
.,AC28 86 7A STX $7A STXY TXTPTR
als Programmzeiger
save as BASIC execute pointer low byte
     
.,AC2A 84 7B STY $7B   abspeichern
save as BASIC execute pointer high byte
     
.,AC2C 20 79 00 JSR $0079 JSR CHRGOT ;GET IT AND SET Z IF TERM.
CHRGOT letztes Zeichen holen
scan memory
GET CHAR AT PNTR
   
.,AC2F D0 20 BNE $AC51 BNE DATBK1
Endzeichen? nein: $AC51
branch if not null
pointer was to null entry
NOT END OF LINE OR COLON
   
.,AC31 24 11 BIT $11 BIT INPFLG
IFN GETCMD,<
Eingabeflag
test input mode flag, $00 = INPUT, $40 = GET, $98 = READ
DOING A "GET"?
   
.,AC33 50 0C BVC $AC41 BVC QDATA
kein GET: $AC41
branch if not GET
else was GET
NO
   
.,AC35 20 24 E1 JSR $E124 JSR CZGETL ;DON'T WANT INCHR. JUST ONE.
IFE REALIO-4,<
ANDI 127>
GETIN
get character from input device with error check
YES, GET CHAR
   
.,AC38 8D 00 02 STA $0200 STA BUF ;MAKE IT FIRST CHARACTER.
Zeichen in Puffer schreiben
save to buffer
     
.,AC3B A2 FF LDX #$FF LDXYI <BUF-1> ;POINT JUST BEFORE IT.
Zeiger auf
set pointer low byte
     
.,AC3D A0 01 LDY #$01 IFE BUFPAG,<
Puffer setzen
set pointer high byte
     
.,AC3F D0 0C BNE $AC4D BEQA DATBK>
unbedingter Sprung
go interpret single character
...ALWAYS
   
.,AC41 30 75 BMI $ACB8 IFN BUFPAG,<
BNEA DATBK>> ;GO PROCESS.
QDATA: BMI DATLOP ;SEARCH FOR ANOTHER DATA STATEMENT.
IFN EXTIO,<
READ: $ACB8
branch if READ
else was INPUT
DOING A "READ"
   
.,AC43 A5 13 LDA $13 LDA CHANNL
Eingabegerät holen
get current I/O channel
     
.,AC45 D0 03 BNE $AC4A BNE GETNTH>
nicht Tastatur: $AC4A
skip "?" prompt if not default channel
     
.,AC47 20 45 AB JSR $AB45 JSR OUTQST
Fragezeichen ausgeben
print "?"
DOING AN "INPUT", PRINT "?"
   
.,AC4A 20 F9 AB JSR $ABF9 GETNTH: JSR QINLIN ;GET ANOTHER LINE.
zweites Fragezeichen ausgeben
print "? " and get BASIC input
PRINT ANOTHER "?", AND INPUT A LINE
   
.,AC4D 86 7A STX $7A DATBK: STXY TXTPTR ;SET FOR "CHRGET".
Programmzeiger setzen
save BASIC execute pointer low byte
     
.,AC4F 84 7B STY $7B   (LOW und HIGH)
save BASIC execute pointer high byte
     
.,AC51 20 73 00 JSR $0073 DATBK1: JSR CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory, execute pointer now points to
start of next data or null terminator
GET NEXT INPUT CHAR
   
.,AC54 24 0D BIT $0D BIT VALTYP ;GET VALUE TYPE.
Typ-Flag
test data type flag, $FF = string, $00 = numeric
STRING OR NUMERIC?
   
.,AC56 10 31 BPL $AC89 BPL NUMINS ;INPUT A NUMBER IF NUMERIC.
IFN GETCMD,<
kein String: $AC89
branch if numeric
type is string
NUMERIC
   
.,AC58 24 11 BIT $11 BIT INPFLG ;GET?
Eingabeflag
test INPUT mode flag, $00 = INPUT, $40 = GET, $98 = READ
STRING -- NOW WHAT INPUT TYPE?
   
.,AC5A 50 09 BVC $AC65 BVC SETQUT ;NO, GO SET QUOTE.
kein GET: $AC65
branch if not GET
else do string GET
NOT A "GET"
   
.,AC5C E8 INX INX
Programmzeiger erhöhen
clear X ??
"GET"
   
.,AC5D 86 7A STX $7A STX TXTPTR
und neu setzen ($0200)
save BASIC execute pointer low byte
     
.,AC5F A9 00 LDA #$00 LDAI 0 ;ZERO TERMINATORS.
Wert laden und
clear A
     
.,AC61 85 07 STA $07 STA CHARAC
Trennzeichen setzen
clear search character
NO OTHER TERMINATORS THAN $00
   
.,AC63 F0 0C BEQ $AC71 BEQA RESETC>
unbedingter Sprung
branch always
is string INPUT or string READ
...ALWAYS
   
.,AC65 85 07 STA $07 SETQUT: STA CHARAC ;ASSUME QUOTED STRING.
nächstes Zeichen
save search character
     
.,AC67 C9 22 CMP #$22 CMPI 34 ;TERMINATORS OK?
'"' Hochkomma?
compare with "
TERMINATE ON $00 OR QUOTE
  quote mark
.,AC69 F0 07 BEQ $AC72 BEQ NOWGET ;YES.
ja: $AC72
branch if quote
string is not in quotes so ":", "," or $00 are the
termination characters
     
.,AC6B A9 3A LDA #$3A LDAI ":" ;SET TERMINATORS TO ":" AND
':' Doppelpunktcode laden
set ":"
TERMINATE ON $00, COLON, OR COMMA
  colon
.,AC6D 85 07 STA $07 STA CHARAC
und abspeichern
set search character
     
.,AC6F A9 2C LDA #$2C LDAI 44 ;COMMA.
',' Kommacode (Endzeichen
set ","
    comma
.,AC71 18 CLC RESETC: CLC
für Stringübertragung)
clear carry for add
     
.,AC72 85 08 STA $08 NOWGET: STA ENDCHR
abspeichern
set scan quotes flag
     
.,AC74 A5 7A LDA $7A LDWD TXTPTR
Programmzeiger laden
get BASIC execute pointer low byte
     
.,AC76 A4 7B LDY $7B   (LOW und HIGH)
get BASIC execute pointer high byte
     
.,AC78 69 00 ADC #$00 ADCI 0 ;C IS SET PROPERLY ABOVE.
und Übertrag addieren
add to pointer low byte. this add increments the pointer
if the mode is INPUT or READ and the data is a "..."
string
SKIP OVER QUOTATION MARK, IF
   
.,AC7A 90 01 BCC $AC7D BCC NOWGE1
C = 0: $AC7D
branch if no rollover
THERE WAS ONE
   
.,AC7C C8 INY INY
bei "'" um 1 erhöhen
else increment pointer high byte
     
.,AC7D 20 8D B4 JSR $B48D NOWGE1: JSR STRLT2 ;MAKE A STRING DESCRIPTOR FOR THE VALUE
;AND COPY IF NECESSARY.
String übernehmen
print string to utility pointer
BUILD STRING STARTING AT (Y,A)
TERMINATED BY $00, (CHARAC), OR (ENDCHR)
   
.,AC80 20 E2 B7 JSR $B7E2 JSR ST2TXT ;SET TEXT POINTER.
Programmzeiger hinter String
restore BASIC execute pointer from temp
SET TXTPTR TO POINT AT STRING
   
.,AC83 20 DA A9 JSR $A9DA JSR INPCOM ;DO ASSIGNMENT.
String an Variable zuweisen
perform string LET
STORE STRING IN VARIABLE
   
.,AC86 4C 91 AC JMP $AC91 JMP STRDN2
weiter machen
continue processing command
GET, INPUT or READ is numeric
     
.,AC89 20 F3 BC JSR $BCF3 NUMINS: JSR FIN
IFE INTPRC,<
JSR MOVVF>
IFN INTPRC,<
Ziffernstring in FAC holen
get FAC1 from string
GET FP NUMBER AT TXTPTR
   
.,AC8C A5 0E LDA $0E LDA INTFLG ;SET CODES ON FLAG.
INTEGER/REAL-Flag
get data type flag, $80 = integer, $00 = float
     
.,AC8E 20 C2 A9 JSR $A9C2 JSR QINTGR> ;GO DECIDE ON FLOAT.
FAC an numerische Variable
assign value to numeric variable
STORE RESULT IN VARIABLE
   
.,AC91 20 79 00 JSR $0079 STRDN2: JSR CHRGOT ;READ LAST CHARACTER.
CHRGOT: letztes Zeichen holen
scan memory
     
.,AC94 F0 07 BEQ $AC9D BEQ TRMOK ;":" OR EOL IS OK.
Ende?
branch if ":" or [EOL]
END OF LINE OR COLON
   
.,AC96 C9 2C CMP #$2C CMPI 44 ;A COMMA?
',' Code?
comparte with ","
COMMA IN INPUT?
  comma
.,AC98 F0 03 BEQ $AC9D JNE TRMNOK
ja: $AC9D
branch if ","
YES
   
.,AC9A 4C 4D AB JMP $AB4D   zur Fehlerbehandlung
else go do bad input routine
string terminated with ":", "," or $00
NOTHING ELSE WILL DO
   
.,AC9D A5 7A LDA $7A TRMOK: LDWD TXTPTR
Programmzeiger
get BASIC execute pointer low byte
SAVE POSITION IN INPUT BUFFER
   
.,AC9F A4 7B LDY $7B   holen und
get BASIC execute pointer high byte
     
.,ACA1 85 43 STA $43 STWD INPPTR ;SAVE FOR MORE READS.
in DATA-Zeiger
save READ pointer low byte
     
.,ACA3 84 44 STY $44   abspeichern
save READ pointer high byte
     
.,ACA5 A5 4B LDA $4B LDWD VARTXT
ursprüngliche
get saved BASIC execute pointer low byte
RESTORE PROGRAM POINTER
   
.,ACA7 A4 4C LDY $4C   Programmzeiger
get saved BASIC execute pointer high byte
     
.,ACA9 85 7A STA $7A STWD TXTPTR ;POINT TO VARIABLE LIST.
wieder zurückholen
restore BASIC execute pointer low byte
     
.,ACAB 84 7B STY $7B   und speichern
restore BASIC execute pointer high byte
     
.,ACAD 20 79 00 JSR $0079 JSR CHRGOT ;LOOK AT LAST VARIABLE LIST CHARACTER.
CHRGOT: letztes Zeichen holen
scan memory
NEXT CHAR FROM PROGRAM
   
.,ACB0 F0 2D BEQ $ACDF BEQ VAREND ;THAT'S THE END OF THE LIST.
Trennzeichen: $ACDF
branch if ":" or [EOL]
END OF STATEMENT
   
.,ACB2 20 FD AE JSR $AEFD JSR CHKCOM ;NOT END. CHECK FOR COMMA.
CKCOM: prüft auf Komma
scan for ",", else do syntax error then warm start
BETTER BE A COMMA THEN
   
.,ACB5 4C 15 AC JMP $AC15 JMP INLOOP
;
; SUBROUTINE TO FIND DATA
; THE SEARCH IS MADE BY USING THE EXECUTION CODE FOR DATA TO
; SKIP OVER STATEMENTS. THE START WORD OF EACH STATEMENT
; IS COMPARED WITH "DATATK". EACH NEW LINE NUMBER
; IS STORED IN "DATLIN" SO THAT IF AN ERROR OCCURS
; WHILE READING DATA THE ERROR MESSAGE CAN GIVE THE LINE
; NUMBER OF THE ILL-FORMATTED DATA.
;
weiter
go READ or INPUT next variable from list
was READ
     
.,ACB8 20 06 A9 JSR $A906 DATLOP: JSR DATAN ;SKIP SOME TEXT.
nächstes Statement suchen
scan for next BASIC statement ([:] or [EOL])
GET OFFSET TO NEXT COLON OR EOL
   
.,ACBB C8 INY INY
Offset erhöhen
increment index to next byte
TO FIRST CHAR OF NEXT LINE
   
.,ACBC AA TAX TAX ;END OF LINE?
Zeilenende?
copy byte to X
WHICH: EOL OR COLON?
   
.,ACBD D0 12 BNE $ACD1 BNE NOWLIN ;SHO AIN'T.
nein: $ACD1
branch if ":"
COLON
   
.,ACBF A2 0D LDX #$0D LDXI ERROD ;YES = "NO DATA" ERROR.
'OUT OF DATA' Code
else set error $0D, out of data error
EOL: MIGHT BE OUT OF DATA
  error number
.,ACC1 C8 INY INY
Zeiger erhöhen
increment index to next line pointer high byte
CHECK HI-BYTE OF FORWARD PNTR
   
.,ACC2 B1 7A LDA ($7A),Y LDADY TXTPTR
Programmende?
get next line pointer high byte
END OF PROGRAM?
   
.,ACC4 F0 6C BEQ $AD32 BEQ ERRGO5
ja: 'OUT OF DATA', X = 0
branch if program end, eventually does error X
YES, WE ARE OUT OF DATA
   
.,ACC6 C8 INY INY
Zeiger erhöhen
increment index
PICK UP THE LINE #
   
.,ACC7 B1 7A LDA ($7A),Y LDADY TXTPTR ;GET HIGH BYTE OF LINE NUMBER.
Zeilennummer (LOW) holen
get next line # low byte
     
.,ACC9 85 3F STA $3F STA DATLIN
und abspeichern
save current DATA line low byte
     
.,ACCB C8 INY INY
Zeiger erhöhen
increment index
     
.,ACCC B1 7A LDA ($7A),Y LDADY TXTPTR ;GET LOW BYTE.
Zeilenummer (HIGH)
get next line # high byte
     
.,ACCE C8 INY INY
Zeiger erhöhen
increment index
POINT AT FIRST TEXT CHAR IN LINE
   
.,ACCF 85 40 STA $40 STA DATLIN+1
Zeilennummer speichern
save current DATA line high byte
     
.,ACD1 20 FB A8 JSR $A8FB NOWLIN: LDADY TXTPTR ;HOW IS IT?
Programmz. auf Statement
add Y to the BASIC execute pointer
GET 1ST TOKEN OF STATEMENT
   
.,ACD4 20 79 00 JSR $0079 TAX
CHRGOT letztes Zeichen holen
scan memory
     
.,ACD7 AA TAX JSR ADDON ;ADD [Y] TO [TXTPTR].
und ins X-Reg.
copy the byte
SAVE TOKEN IN X-REG
   
.,ACD8 E0 83 CPX #$83 CPXI DATATK ;IS IT A "DATA" STATEMENT.
'DATA' Code?
compare it with token for DATA
DID WE FIND A "DATA" STATEMENT?
  DATA code
.,ACDA D0 DC BNE $ACB8 BNE DATLOP ;NOT QUITE RIGHT. KEEP LOOKING.
nein: weitersuchen
loop if not DATA
NOT YET
   
.,ACDC 4C 51 AC JMP $AC51 JMP DATBK1 ;THIS IS THE ONE !
Daten lesen
continue evaluating READ
YES, READ IT
NO MORE INPUT REQUESTED
   
.,ACDF A5 43 LDA $43 VAREND: LDWD INPPTR ;PUT AWAY A NEW DATA PNTR MAYBE.
LOW- und HIGH-Byte des
get READ pointer low byte
GET POINTER IN CASE IT WAS "READ"
   
.,ACE1 A4 44 LDY $44   Input-Zeigers
get READ pointer high byte
     
.,ACE3 A6 11 LDX $11 LDX INPFLG
Eingabe-Flag
get INPUT mode flag, $00 = INPUT, $40 = GET, $98 = READ
"READ" OR "INPUT"?
   
.,ACE5 10 03 BPL $ACEA BPL VARY0
kein DATA: $ACEA
branch if INPUT or GET
"INPUT"
   
.,ACE7 4C 27 A8 JMP $A827 JMP RESFIN
DATA-Zeiger setzen
else set data pointer and exit
"DATA", SO STORE (Y,X) AT DATPTR
   
.,ACEA A0 00 LDY #$00 VARY0: LDYI 0
Zeiger setzen
clear index
"INPUT": ANY MORE CHARS ON LINE?
   
.,ACEC B1 43 LDA ($43),Y LDADY INPPTR ;LAST DATA CHR COULD HAVE BEEN
;COMMA OR COLON BUT SHOULD BE NULL.
nächstes Zeichen holen
get READ byte
     
.,ACEE F0 0B BEQ $ACFB BEQ INPRTS ;IT IS NULL.
IFN EXTIO,<
Endzeichen: $ACFB
exit if [EOL]
NO, ALL IS WELL
   
.,ACF0 A5 13 LDA $13 LDA CHANNL ;IF NOT TERMINAL, NO TYPE.
Eingabe über Tastatur?
get current I/O channel
YES, ERROR
   
.,ACF2 D0 07 BNE $ACFB BNE INPRTS>
nein: $ACFB
exit if not default channel
     
.,ACF4 A9 FC LDA #$FC LDWDI EXIGNT
Zeiger auf
set "?EXTRA IGNORED" pointer low byte
    low ACFC
.,ACF6 A0 AC LDY #$AC   '?extra ignored' setzen
set "?EXTRA IGNORED" pointer high byte
"EXTRA IGNORED"
  high ACFC
.,ACF8 4C 1E AB JMP $AB1E JMP STROUT ;TYPE "?EXTRA IGNORED"
String ausgeben
print null terminated string
     
.,ACFB 60 RTS INPRTS: RTS ;DO NEXT STATEMENT.
Rücksprung

input error messages

   

messages used dring READ

.:ACFC 3F 45 58 54 52 41 20 49 EXIGNT: DT"?EXTRA IGNORED"
'?extra ignored'
'?extra ignored'
'?extra ignored'
  ?EXTRA IGNORED
.:AD04 47 4E 4F 52 45 44 0D 00 ACRLF
         
.:AD0C 3F 52 45 44 4F 20 46 52 0
'?redo from start'
'?redo from start'
'?redo from start'
  ?REDO FROM START
.:AD14 4F 4D 20 53 54 41 52 54 TRYAGN: DT"?REDO FROM START"
         
.:AD1C 0D 00 ACRLF
0
PAGE

THE NEXT CODE IS THE "NEXT CODE"

;
; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS
; TOKEN (FORTK) 1 BYTE
; A POINTER TO THE LOOP VARIABLE 2 BYTES
; THE STEP 4+ADDPRC BYTES
; A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
; THE UPPER VALUE (PACKED) 4+ADDPRC BYTES
; THE LINE NUMBER OF THE "FOR" STATEMENT 2 BYTES
; A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
; HIGH ADDRESS
;
; TOTAL 16+2*ADDPRC BYTES.
;

BASIC-Befehl NEXT

perform NEXT

"NEXT" STATEMENT

 

NEXT command

.,AD1E D0 04 BNE $AD24 NEXT: BNE GETFOR
folgt Variablenname? ja:$AD24
branch if NEXT variable
VARIABLE AFTER "NEXT"
   
.,AD20 A0 00 LDY #$00 LDYI 0 ;WITHOUT ARG CALL "FNDFOR" WITH
Variablenzeiger = 0
else clear Y
FLAG BY SETTING FORPNT+1 = 0
   
.,AD22 F0 03 BEQ $AD27 BEQA STXFOR ;[FORPNT]=0.
unbedingter Sprung
branch always
NEXT variable
...ALWAYS
   
.,AD24 20 8B B0 JSR $B08B GETFOR: JSR PTRGET ;GET A POINTER TO LOOP VARIABLE
sucht Variable
get variable address
GET PNTR TO VARIABLE IN (Y,A)
   
.,AD27 85 49 STA $49 STXFOR: STWD FORPNT ;INTO "FORPNT".
Adresse der
save FOR/NEXT variable pointer low byte
     
.,AD29 84 4A STY $4A   Variablen speichern
save FOR/NEXT variable pointer high byte
(high byte cleared if no variable defined)
     
.,AD2B 20 8A A3 JSR $A38A JSR FNDFOR ;FIND THE MATCHING ENTRY IF ANY.
sucht FOR-NEXT-Schleife
search the stack for FOR or GOSUB activity
FIND FOR-FRAME FOR THIS VARIABLE
   
.,AD2E F0 05 BEQ $AD35 BEQ HAVFOR
gefunden: $AD35
branch if FOR, this variable, found
FOUND IT
   
.,AD30 A2 0A LDX #$0A LDXI ERRNF ;"NEXT WITHOUT FOR".
Nummer für 'next without for'
else set error $0A, next without for error
NOT THERE, ABORT
  error number
.,AD32 4C 37 A4 JMP $A437 ERRGO5: BEQ ERRGO4
Fehlermeldung ausgeben
do error #X then warm start
found this FOR variable
...ALWAYS
   
.,AD35 9A TXS HAVFOR: TXS ;SETUP STACK. CHOP FIRST.
X-Reg. retten
update stack pointer
SET STACK PTR TO POINT TO THIS FRAME,
   
.,AD36 8A TXA TXA
X-Register nach Akku
copy stack pointer
     
.,AD37 18 CLC CLC
Carry löschen (Addition)
clear carry for add
     
.,AD38 69 04 ADC #$04 ADCI 4 ;POINT TO INCREMENT
Zeiger auf Exponenten des
point to STEP value
     
.,AD3A 48 PHA PHA ;SAVE THIS POINTER TO RESTORE TO [A]
STEP-Wert + 4 und retten
save it
     
.,AD3B 69 06 ADC #$06 ADCI 5+ADDPRC ;POINT TO UPPER LIMIT
Zeiger auf Exponent des TO-
point to TO value
     
.,AD3D 85 24 STA $24 STA INDEX2 ;SAVE AS INDEX
Wert und retten
save pointer to TO variable for compare
     
.,AD3F 68 PLA PLA ;RESTORE POINTER TO INCREMENT
Akku wieder vom Stapel holen
restore pointer to STEP value
     
.,AD40 A0 01 LDY #$01 LDYI 1 ;SET HI ADDR OF THING TO MOVE.
Zeiger für Konstante setzen
point to stack page
(Y,A) IS ADDRESS OF STEP VALUE
   
.,AD42 20 A2 BB JSR $BBA2 JSR MOVFM ;GET QUANTITY INTO THE FAC.
Variable vom Stapel nach FAC
unpack memory (AY) into FAC1
STEP TO FAC
   
.,AD45 BA TSX TSX
Stapelzeiger als Zeiger h.
get stack pointer back
     
.,AD46 BD 09 01 LDA $0109,X LDA 257+7+ADDPRC,X, ;SET SIGN CORRECTLY.
Vorzeichenbyte holen und
get step sign
     
.,AD49 85 66 STA $66 STA FACSGN
für FAC speichern
save FAC1 sign (b7)
     
.,AD4B A5 49 LDA $49 LDWD FORPNT
Variablenadresse für
get FOR/NEXT variable pointer low byte
     
.,AD4D A4 4A LDY $4A   FOR-NEXT holen
get FOR/NEXT variable pointer high byte
     
.,AD4F 20 67 B8 JSR $B867 JSR FADD ;ADD INC TO LOOP VARIABLE.
addiert STEP-Wert zu FAC
add FOR variable to FAC1
ADD TO FOR VALUE
   
.,AD52 20 D0 BB JSR $BBD0 JSR MOVVF ;PACK THE FAC INTO MEMORY.
FAC nach Variable bringen
pack FAC1 into FOR variable
PUT NEW VALUE BACK
   
.,AD55 A0 01 LDY #$01 LDYI 1
Zeiger auf Konstante setzen
point to stack page
(Y,A) IS ADDRESS OF END VALUE
   
.,AD57 20 5D BC JSR $BC5D JSR FCOMPN ;COMPARE FAC WITH UPPER VALUE.
FAC mit Schleifenendwert vergleichen
compare FAC1 with TO value
COMPARE TO END VALUE
   
.,AD5A BA TSX TSX
Stapelzeiger als Zeiger h.
get stack pointer back
     
.,AD5B 38 SEC SEC
Carry setzen (Subtraktion)
set carry for subtract
     
.,AD5C FD 09 01 SBC $0109,X SBC 257+7+ADDPRC,X, ;SUBTRACT SIGN OF INC FROM SIGN OF
;OF (CURRENT VALUE-FINAL VALUE).
Stapelwert größer?
subtract step sign
SIGN OF STEP
   
.,AD5F F0 17 BEQ $AD78 BEQ LOOPDN ;IF SIGN (FINAL-CURRENT)-SIGN STEP=0
;THEN LOOP IS DONE.
ja: Schleife verlassen
branch if =, loop complete
loop back and do it all again
BRANCH IF FOR COMPLETE
   
.,AD61 BD 0F 01 LDA $010F,X LDA 2*ADDPRC+12+257,X
Zeilennummer des Schleifen-
get FOR line low byte
OTHERWISE SET UP
   
.,AD64 85 39 STA $39 STA CURLIN ;STORE LINE NUMBER OF "FOR" STATEMENT.
anfangs holen (LOW- und
save current line number low byte
FOR LINE #
   
.,AD66 BD 10 01 LDA $0110,X LDA 257+13+<2*ADDPRC>,X
HIGH-Byte) und als aktuelle
get FOR line high byte
     
.,AD69 85 3A STA $3A STA CURLIN+1
BASIC-Zeilennummer speichern
save current line number high byte
     
.,AD6B BD 12 01 LDA $0112,X LDA 2*ADDPRC+15+257,X
Schleifenanfang holen (LOW-
get BASIC execute pointer low byte
AND SET TXTPTR TO JUST
   
.,AD6E 85 7A STA $7A STA TXTPTR ;STORE TEXT PNTR INTO "FOR" STATEMENT.
und HIGH-Byte) und
save BASIC execute pointer low byte
AFTER FOR STATEMENT
   
.,AD70 BD 11 01 LDA $0111,X LDA 2*ADDPRC+14+257,X
als neuen Programmzeiger
get BASIC execute pointer high byte
     
.,AD73 85 7B STA $7B STA TXTPTR+1
abspeichern
save BASIC execute pointer high byte
     
.,AD75 4C AE A7 JMP $A7AE NEWSGO: JMP NEWSTT ;PROCESS NEXT STATEMENT.
zur Interpreterschleife
go do interpreter inner loop
NEXT loop comlete
     
.,AD78 8A TXA LOOPDN: TXA
Zeiger in Akku holen
stack copy to A
POP OFF FOR-FRAME, LOOP IS DONE
   
.,AD79 69 11 ADC #$11 ADCI 2*ADDPRC+15 ;ADDS 16 WITH CARRY.
(Werte der Schleife aus
add $12, $11 + carry, to dump FOR structure
CARRY IS SET, SO ADDS 18
   
.,AD7B AA TAX TAX
Stapel entfernen)
copy back to index
     
.,AD7C 9A TXS TXS ;NEW STACK PNTR.
neuen Stapelzeiger setzen
copy to stack pointer
     
.,AD7D 20 79 00 JSR $0079 JSR CHRGOT
CHRGOT letztes Zeichen holen
scan memory
CHAR AFTER VARIABLE
   
.,AD80 C9 2C CMP #$2C CMPI 44 ;COMMA AT END?
',' Komma?
compare with ","
ANOTHER VARIABLE IN NEXT?
  comma
.,AD82 D0 F1 BNE $AD75 BNE NEWSGO
nein: dann fertig
if not "," go do interpreter inner loop
was "," so another NEXT variable to do
NO, GO TO NEXT STATEMENT
   
.,AD84 20 73 00 JSR $0073 JSR CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory
YES, PRIME FOR NEXT VARIABLE
   
.,AD87 20 24 AD JSR $AD24 JSR GETFOR ;DO NEXT BUT DON'T ALLOW BLANK VARIABLE
;PNTR. [VARPNT] IS THE STK PNTR WHICH
;NEVER MATCHES ANY POINTER.
;JSR TO PUT ON DUMMY NEWSTT ADDR.

FORMULA EVALUATION CODE.

;
; THESE ROUTINES CHECK FOR CERTAIN "VALTYP".
; [C] IS NOT PRESERVED.
;
nächste NEXT-Variable

FRMNUM Ausdruck holen und

auf numerisch prüfen

do NEXT variable

evaluate expression and check type mismatch

(DOES NOT RETURN)

EVALUATE EXPRESSION, MAKE SURE IT IS NUMERIC

 

get next non-string value

.,AD8A 20 9E AD JSR $AD9E FRMNUM: JSR FRMEVL
FRMEVL Term holen

prüft auf numerisch

evaluate expression
check if source and destination are numeric

MAKE SURE (FAC) IS NUMERIC

   
.,AD8D 18 CLC CHKNUM: CLC
Flag für Test auf numerisch
       
.:AD8E 24 .BYTE $24 SKIP1
BIT-Befehl um folgenden Befehl auszulassen

prüft auf String

makes next line BIT $38
check if source and destination are string
DUMMY FOR SKIP

MAKE SURE (FAC) IS STRING

 

check value to be string

.,AD8F 38 SEC CHKSTR: SEC ;SET CARRY.
Flag für Test auf String
destination is string
type match check, set C for string, clear C for numeric

MAKE SURE (FAC) IS CORRECT TYPE

IF C=0, TYPE MUST BE NUMERIC
IF C=1, TYPE MUST BE STRING
 

check value according to C flag

.,AD90 24 0D BIT $0D CHKVAL: BIT VALTYP ;WILL NOT F UP "VALTYP".
Typflag testen
test data type flag, $FF = string, $00 = numeric
$00 IF NUMERIC, $FF IF STRING
   
.,AD92 30 03 BMI $AD97 BMI DOCSTR
gesetzt: $AD97
branch if string
TYPE IS STRING
   
.,AD94 B0 03 BCS $AD99 BCS CHKERR
C=1: 'TYPE MISMATCH'
if destiantion is numeric do type missmatch error
NOT STRING, BUT WE NEED STRING
   
.,AD96 60 RTS CHKOK: RTS
Rücksprung
  TYPE IS CORRECT
   
.,AD97 B0 FD BCS $AD96 DOCSTR: BCS CHKOK
C=1: RTS
exit if destination is string
do type missmatch error
IS STRING AND WE WANTED STRING
   
.,AD99 A2 16 LDX #$16 CHKERR: LDXI ERRTM
Nummer für 'TYPE MISMATCH'
error code $16, type missmatch error
TYPE MISMATCH
   
.,AD9B 4C 37 A4 JMP $A437 ERRGO4: JMP ERROR
;
; THE FORMULA EVALUATOR STARTS WITH
; [TXTPTR] POINTING TO THE FIRST CHARACTER OF THE FORMULA.
; AT THE END [TXTPTR] POINTS TO THE TERMINATOR.
; THE RESULT IS LEFT IN THE FAC.
; ON RETURN [A] DOES NOT REFLECT THE TERMINATOR.
;
; THE FORMULA EVALUATOR USES THE OPERATOR LIST (OPTAB)
; TO DETERMINE PRECEDENCE AND DISPATCH ADDRESSES FOR
; EACH OPERATOR.
; A TEMPORARY RESULT ON THE STACK HAS THE FOLLOWING FORMAT.
; THE ADDRESS OF THE OPERATOR ROUTINE.
; THE FLOATING POINT TEMPORARY RESULT.
; THE PRECEDENCE OF THE OPERATOR.
;
Fehlermeldung ausgeben

FRMEVL auswerten eines

beliebigen Ausdrucks

do error #X then warm start

evaluate expression

EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE

RESULT IN FAC.

WORKS FOR BOTH STRING AND NUMERIC EXPRESSIONS.
 

evaluate expression

.,AD9E A6 7A LDX $7A FRMEVL: LDX TXTPTR
Programmzeiger (LOW) = 0?
get BASIC execute pointer low byte
DECREMENT TXTPTR
   
.,ADA0 D0 02 BNE $ADA4 BNE FRMEV1
ja: HIGH-B. nicht vermindern
skip next if not zero
     
.,ADA2 C6 7B DEC $7B DEC TXTPTR+1
HIGH-Byte vermindern
else decrement BASIC execute pointer high byte
     
.,ADA4 C6 7A DEC $7A FRMEV1: DEC TXTPTR
LOW-Byte vermindern
decrement BASIC execute pointer low byte
     
.,ADA6 A2 00 LDX #$00 LDXI 0 ;INITIAL DUMMY PRECEDENCE IS 0.
Prioritätswert laden
set null precedence, flag done
START WITH PRECEDENCE = 0
   
.:ADA8 24 .BYTE $24 SKIP1
  makes next line BIT $48
TRICK TO SKIP FOLLOWING "PHA"
   
.,ADA9 48 PHA LPOPER: PHA ;SAVE LOW PRECEDENCE. (MASK.)
Operatormaske retten
push compare evaluation byte if branch to here
PUSH RELOPS FLAGS
   
.,ADAA 8A TXA TXA
Prioritätswert in Akku
copy precedence byte
     
.,ADAB 48 PHA PHA ;SAVE HIGH PRECEDENCE.
schieben und retten
push precedence byte
SAVE LAST PRECEDENCE
   
.,ADAC A9 01 LDA #$01 LDAI 1
2 Bytes
2 bytes
     
.,ADAE 20 FB A3 JSR $A3FB JSR GETSTK ;MAKE SURE THERE IS ROOM FOR
;RECURSIVE CALLS.
prüft auf Platz im Stapel
check room on stack for A*2 bytes
CHECK IF ENOUGH ROOM ON STACK
   
.,ADB1 20 83 AE JSR $AE83 JSR EVAL ;EVALUATE SOMETHING.
Nächstes Element holen
get value from line
GET AN ELEMENT
   
.,ADB4 A9 00 LDA #$00 CLR OPMASK ;PREPARE TO BUILD MASK MAYBE.
Wert laden und
clear A
     
.,ADB6 85 4D STA $4D   Maske für Vergleichsoperator
clear comparrison evaluation flag
CLEAR COMPARISON OPERATOR FLAGS
   
.,ADB8 20 79 00 JSR $0079 TSTOP: JSR CHRGOT ;REGET LAST CHARACTER.
CHRGOT letztes Zeichen holen
scan memory
CHECK FOR RELATIONAL OPERATORS
   
.,ADBB 38 SEC LOPREL: SEC ;PREP TO SUBTRACT.
Carry setzen (Subtraktion)
set carry for subtract
> IS $CF, = IS $D0, < IS $D1
   
.,ADBC E9 B1 SBC #$B1 SBCI GREATK ;IS CURRENT CHARACTER A RELATION?
$B1 von Operatorcode subtr.
subtract the token for ">"
> IS 0, = IS 1, < IS 2
  code for greater than
.,ADBE 90 17 BCC $ADD7 BCC ENDREL ;NO. RELATIONS ALL THROUGH.
C=0: $ADD7
branch if < ">"
NOT RELATIONAL OPERATOR
   
.,ADC0 C9 03 CMP #$03 CMPI LESSTK-GREATK+1 ;REALLY RELATIONAL?
mit $3 vergleichen
compare with ">" to +3
     
.,ADC2 B0 13 BCS $ADD7 BCS ENDREL ;NO -- JUST BIG.
=3: $ADD7
branch if >= 3
was token for ">" "=" or "<"
NOT RELATIONAL OPERATOR
   
.,ADC4 C9 01 CMP #$01 CMPI 1 ;RESET CARRY FOR ZERO ONLY.
  compare with token for =
SET CARRY IF "=" OR "<"
   
.,ADC6 2A ROL ROL A, ;0 TO 1, 1 TO 2, 2 TO 4.
Maske für kleiner
*2, b0 = carry (=1 if token was = or <)
NOW > IS 0, = IS 3, < IS 5
   
.,ADC7 49 01 EOR #$01 EORI 1
gleich und größer
toggle b0
NOW > IS 1, = IS 2, < IS 4
   
.,ADC9 45 4D EOR $4D EOR OPMASK ;BRING IN THE OLD BITS.
für Bits 0,1 und 2
EOR with comparrison evaluation flag
SET BITS OF CPRTYP: 00000<=>
   
.,ADCB C5 4D CMP $4D CMP OPMASK ;MAKE SURE THE NEW MASK IS BIGGER.
in $40 erstellen
compare with comparrison evaluation flag
CHECK FOR ILLEGAL COMBINATIONS
   
.,ADCD 90 61 BCC $AE30 BCC SNERR5 ;SYNTAX ERROR. BECAUSE TWO OF THE SAME.
(Wenn Codes von 177
if < saved flag do syntax error then warm start
IF LESS THAN, A RELOP WAS REPEATED
   
.,ADCF 85 4D STA $4D STA OPMASK ;SAVE MASK.
bis 179 folgen)
save new comparrison evaluation flag
     
.,ADD1 20 73 00 JSR $0073 JSR CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory
ANOTHER OPERATOR?
   
.,ADD4 4C BB AD JMP $ADBB JMP LOPREL ;GET THE NEXT CANDIDATE.
nächstes Zeichen auswerten
go do next character
CHECK FOR <,=,> AGAIN
   
.,ADD7 A6 4D LDX $4D ENDREL: LDX OPMASK ;WERE THERE ANY?
Operatormaske holen
get comparrison evaluation flag
DID WE FIND A RELATIONAL OPERATOR?
   
.,ADD9 D0 2C BNE $AE07 BNE FINREL ;YES, HANDLE AS SPECIAL OP.
gleich 0? nein: $AE07
branch if compare function
YES
   
.,ADDB B0 7B BCS $AE58 BCS QOP ;NOT AN OPERATOR.
Code größer oder gleich 180?
go do functions
else was < TK_GT so is operator or lower
NO, AND NEXT TOKEN IS > $D1
   
.,ADDD 69 07 ADC #$07 ADCI GREATK-PLUSTK
Code kleiner 170?
add # of operators (+, -, *, /, ^, AND or OR)
NO, AND NEXT TOKEN < $CF
   
.,ADDF 90 77 BCC $AE58 BCC QOP ;NOT AN OPERATOR.
ja: $AE58
branch if < + operator
carry was set so token was +, -, *, /, ^, AND or OR
IF NEXT TOKEN < "+"
   
.,ADE1 65 0D ADC $0D ADC VALTYP ;[C]=1.
Stringaddition?
add data type flag, $FF = string, $00 = numeric
+ AND LAST RESULT A STRING?
   
.,ADE3 D0 03 BNE $ADE8 JEQ CAT ;ONLY IF [A]=0 AND [VALTYP]=-1 (A STR).
nein: Verkettung umgehen
branch if not string or not + token
will only be $00 if type is string and token was +
BRANCH IF NOT
   
.,ADE5 4C 3D B6 JMP $B63D   Stringverkettung
add strings, string 1 is in the descriptor, string 2
is in line, and return
CONCATENATE IF SO.
   
.,ADE8 69 FF ADC #$FF ADCI ^O377 ;GET BACK ORIGINAL [A].
Code-$AA (wiederherstellen)
-1 (corrects for carry add)
+-*/ IS 0123
   
.,ADEA 85 22 STA $22 STA INDEX1
und speichern
save it
     
.,ADEC 0A ASL ASL A, ;MULTIPLY BY 2.
verdoppeln
*2
MULTIPLY BY 3
   
.,ADED 65 22 ADC $22 ADC INDEX1 ;BY THREE.
+ Wert (also mal 3)
*3
+-*/ IS 0,3,6,9
   
.,ADEF A8 TAY TAY ;SET UP FOR LATER.
als Zeiger ins Y-Register
copy to index
     
.,ADF0 68 PLA QPREC: PLA ;GET PREVIOUS PRECEDENCE.
bisheriger Prioritätswert
pull previous precedence
GET LAST PRECEDENCE
   
.,ADF1 D9 80 A0 CMP $A080,Y CMP OPTAB,Y ;IS OLD PRECEDENCE GREATER OR EQUAL?
mit Prioritätsw. vergleichen
compare with precedence byte
     
.,ADF4 B0 67 BCS $AE5D BCS QCHNUM ;YES, GO OPERATE.
größer: $AE5D
branch if A >=
DO NOW IF HIGHER PRECEDENCE
   
.,ADF6 20 8D AD JSR $AD8D JSR CHKNUM ;CAN'T BE STRING HERE.
prüft auf numerisch
check if source is numeric, else do type mismatch
WAS LAST RESULT A #?
   
.,ADF9 48 PHA DOPREC: PHA ;SAVE OLD PRECEDENCE.
Prioritätswert retten
save precedence
YES, SAVE PRECEDENCE ON STACK
   
.,ADFA 20 20 AE JSR $AE20 NEGPRC: JSR DOPRE1 ;SET A RETURN ADDRESS FOR OP.
Operatoradr. und Operanden r.
get vector, execute function then continue evaluation
SAVE REST, CALL FRMEVL RECURSIVELY
   
.,ADFD 68 PLA PLA ;PULL OFF PREVIOUS PRECEDENCE.
  restore precedence
     
.,ADFE A4 4B LDY $4B LDY OPPTR ;GET POINTER TO OP.
Operator?
get precedence stacked flag
     
.,AE00 10 17 BPL $AE19 BPL QPREC1 ;THAT'S A REAL OPERATOR.
ja: $AE19
branch if stacked values
     
.,AE02 AA TAX TAX ;DONE ?
weitere Operation?
copy precedence, set flags
     
.,AE03 F0 56 BEQ $AE5B BEQ QOPGO ;DONE !
nein: RTS
exit if done
EXIT IF NO MATH IN EXPRESSION
   
.,AE05 D0 5F BNE $AE66 BNE PULSTK
ARG vom Stapel holen
else pop FAC2 and return, branch always
...ALWAYS
FOUND ONE OR MORE RELATIONAL OPERATORS <,=,>
   
.,AE07 46 0D LSR $0D FINREL: LSR VALTYP ;GET VALUE TYPE INTO "C".
Stringflag löschen
clear data type flag, $FF = string, $00 = numeric
(VALTYP) = 0 (NUMERIC), = $FF (STRING)
   
.,AE09 8A TXA TXA
Operatormaske nach
copy compare function flag
SET CPRTYP TO 0000<=>C
   
.,AE0A 2A ROL ROL A, ;PUT VALTYP INTO LOW ORDER BIT OF MASK.
links schieben
<<1, shift data type flag into b0, 1 = string, 0 = num
WHERE C=0 IF #, C=1 IF STRING
   
.,AE0B A6 7A LDX $7A LDX TXTPTR ;DECREMENT TEXT POINTER.
Programmzeiger holen (LOW)
get BASIC execute pointer low byte
BACK UP TXTPTR
   
.,AE0D D0 02 BNE $AE11 BNE FINRE2
=0: HIGH-Byte vermindern
branch if no underflow
     
.,AE0F C6 7B DEC $7B DEC TXTPTR+1
HIGH-Byte vermindern
else decrement BASIC execute pointer high byte
     
.,AE11 C6 7A DEC $7A FINRE2: DEC TXTPTR
LOW-Byte vermindern
decrement BASIC execute pointer low byte
     
.,AE13 A0 1B LDY #$1B LDYI PTDORL-OPTAB ;MAKE [YREG] POINT AT OPERATOR ENTRY.
Offset des Hierarchieflags
set offset to = operator precedence entry
POINT AT RELOPS ENTRY
   
.,AE15 85 4D STA $4D STA OPMASK ;SAVE THE OPERATION MASK.
Flag setzen
save new comparrison evaluation flag
     
.,AE17 D0 D7 BNE $ADF0 BNE QPREC ;SAVE IT ALL. BR ALWAYS.
;NOTE B7(VALTYP)=0 SO CHKNUM CALL IS OK.
unbedingter Sprung
branch always
...ALWAYS
   
.,AE19 D9 80 A0 CMP $A080,Y QPREC1: CMP OPTAB,Y ;LAST PRECEDENCE IS GREATER?
mit Hierarchieflag vergl.
compare with stacked function precedence
     
.,AE1C B0 48 BCS $AE66 BCS PULSTK ;YES, GO OPERATE.
größer: $AE66
if A >=, pop FAC2 and return
DO NOW IF HIGHER PRECEDENCE
   
.,AE1E 90 D9 BCC $ADF9 BCC DOPREC ;NO SAVE ARGUMENT AND GET OTHER OPERAND.
sonst weiter
else go stack this one and continue, branch always

get vector, execute function then continue evaluation

...ALWAYS
STACK THIS OPERATION AND CALL FRMEVL FOR
ANOTHER ONE
 

recursive entry for evaluation of expressions

.,AE20 B9 82 A0 LDA $A082,Y DOPRE1: LDA OPTAB+2,Y
Operationsadresse (HIGH)
get function vector high byte
     
.,AE23 48 PHA PHA ;DISP ADDR GOES ONTO STACK.
auf Stapel retten
onto stack
PUSH ADDRESS OF OPERATION PERFORMER
   
.,AE24 B9 81 A0 LDA $A081,Y LDA OPTAB+1,Y
Operationsadresse (LOW)
get function vector low byte
     
.,AE27 48 PHA PHA
auf Stapel retten
onto stack
now push sign, round FAC1 and put on stack
     
.,AE28 20 33 AE JSR $AE33 JSR PUSHF1 ;SAVE FAC ON STACK UNPACKED.
Operanden auf Stapel retten
function will return here, then the next RTS will call
the function
STACK FAC.SIGN AND FAC
   
.,AE2B A5 4D LDA $4D LDA OPMASK ;[ACCA] MAY BE MASK FOR REL.
Operatormaske laden
get comparrison evaluation flag
A=RELOP FLAGS, X=PRECEDENCE BYTE
   
.,AE2D 4C A9 AD JMP $ADA9 JMP LPOPER
zum Schleifenanfang
continue evaluating expression
RECURSIVELY CALL FRMEVL
   
.,AE30 4C 08 AF JMP $AF08 SNERR5: JMP SNERR ;GO TO AN ERROR.
gibt 'SYNTAX ERROR'
do syntax error then warm start

STACK (FAC)

THREE ENTRY POINTS:
.1, FROM FRMEVL
.2, FROM "STEP"
.3, FROM "FOR"
 

save rounded value of left operand

.,AE33 A5 66 LDA $66 PUSHF1: LDA FACSGN
Vorzeichen von FAC
get FAC1 sign (b7)
GET FAC.SIGN TO PUSH IT
   
.,AE35 BE 80 A0 LDX $A080,Y LDX OPTAB,Y, ;GET HIGH PRECEDENCE.
Hierarchieflag
get precedence byte

push sign, round FAC1 and put on stack

PRECEDENCE BYTE FROM MATHTBL
ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE
   
.,AE38 A8 TAY PUSHF: TAY ;GET POINTER INTO STACK.
Vorzeichen ins Y-Reg.
copy sign
FAC.SIGN OR SGN(STEP VALUE)
   
.,AE39 68 PLA PLA
Rücksprungadresse holen
get return address low byte
PULL RETURN ADDRESS AND ADD 1
  pull return address
.,AE3A 85 22 STA $22 STA INDEX1
und merken
save it
<<< ASSUMES NOT ON PAGE BOUNDARY! >>>
   
.,AE3C E6 22 INC $22 INC INDEX1
Rücksprungadresse erhöhen
increment it as return-1 is pushed
note, no check is made on the high byte so if the calling
routine ever assembles to a page edge then this all goes
horribly wrong!
PLACE BUMPED RETURN ADDRESS IN
   
.,AE3E 68 PLA PLA
nächstes Adressbyte holen
get return address high byte
INDEX,INDEX+1
  and store in $22/$23
.,AE3F 85 23 STA $23 STA INDEX1+1
und speichern
save it
     
.,AE41 98 TYA TYA
;STORE FAC ON STACK UNPACKED.
Vorzeichen wieder in Akku
restore sign
FAC.SIGN OR SGN(STEP VALUE)
   
.,AE42 48 PHA PHA ;START WITH SIGN SET UP.
und auf Stapel legen
push sign

round FAC1 and put on stack

PUSH FAC.SIGN OR SGN(STEP VALUE)
ENTER HERE FROM "FOR", WITH (INDEX) = STEP,
TO PUSH INITIAL VALUE OF "FOR" VARIABLE
   
.,AE43 20 1B BC JSR $BC1B FORPSH: JSR ROUND ;PUT ROUNDED FAC ON STACK.
FAC runden
round FAC1
ROUND TO 32 BITS
   
.,AE46 A5 65 LDA $65 LDA FACLO ;ENTRY POINT TO SKIP STORING SIGN.
FAC auf Stapel legen
get FAC1 mantissa 4
PUSH (FAC)
   
.,AE48 48 PHA PHA
1. Byte retten
save it
     
.,AE49 A5 64 LDA $64 LDA FACMO
2. Byte holen
get FAC1 mantissa 3
     
.,AE4B 48 PHA PHA
IFN ADDPRC,<
und retten
save it
     
.,AE4C A5 63 LDA $63 LDA FACMOH
3. Byte holen
get FAC1 mantissa 2
     
.,AE4E 48 PHA PHA>
und retten
save it
     
.,AE4F A5 62 LDA $62 LDA FACHO
4. Byte holen
get FAC1 mantissa 1
     
.,AE51 48 PHA PHA
und retten
save it
     
.,AE52 A5 61 LDA $61 LDA FACEXP
5. Byte holen
get FAC1 exponent
     
.,AE54 48 PHA PHA
und retten
save it
     
.,AE55 6C 22 00 JMP ($0022) JMPD INDEX1 ;RETURN.
Sprung auf Operation
return, sort of

do functions

DO RTS FUNNY WAY
  return to caller

apply operator

.,AE58 A0 FF LDY #$FF QOP: LDYI 255
Flagwert für Operator
flag function
SET UP TO EXIT ROUTINE
   
.,AE5A 68 PLA PLA ;GET HIGH PRECEDENCE OF LAST OP.
Prioritätsflag retten
pull precedence byte
     
.,AE5B F0 23 BEQ $AE80 QOPGO: BEQ QOPRTS ;DONE !
=0? ja: $AE80
exit if done
EXIT IF NO MATH TO DO

PERFORM STACKED OPERATION

(A) = PRECEDENCE BYTE
STACK: 1 -- CPRMASK
5 -- (ARG)
2 -- ADDR OF PERFORMER
   
.,AE5D C9 64 CMP #$64 QCHNUM: CMPI 100 ;RELATIONAL OPERATOR?
=$64?
compare previous precedence with $64
WAS IT RELATIONAL OPERATOR?
   
.,AE5F F0 03 BEQ $AE64 BEQ UNPSTK ;YES, DON'T CHECK OPERAND.
ja: $AE64
branch if was $64 (< function)
YES, ALLOW STRING COMPARE
   
.,AE61 20 8D AD JSR $AD8D JSR CHKNUM ;MUST BE NUMBER.
prüft auf numerisch
check if source is numeric, else do type mismatch
MUST BE NUMERIC VALUE
   
.,AE64 84 4B STY $4B UNPSTK: STY OPPTR ;SAVE OPERATOR'S POINTER FOR NEXT TIME.
flag fur Operator
save precedence stacked flag
pop FAC2 and return
     
.,AE66 68 PLA PULSTK: PLA ;GET MASK FOR REL OP IF IT IS ONE.
Akku vom Stapel holen
pop byte
GET 0000<=>C FROM STACK
   
.,AE67 4A LSR LSR A, ;SETUP [C] FOR DOREL'S "CHKVAL".
halbieren
shift out comparison evaluation lowest bit
SHIFT TO 00000<=> FORM
   
.,AE68 85 12 STA $12 STA DOMASK ;SAVE FOR "DOCMP".
und abspeichern
save the comparison evaluation flag
00000<=>
   
.,AE6A 68 PLA PLA ;UNPACK STACK INTO ARG.
ARG von Stapel holen
pop exponent
     
.,AE6B 85 69 STA $69 STA ARGEXP
1. Byte speichern
save FAC2 exponent
GET FLOATING POINT VALUE OFF STACK,
   
.,AE6D 68 PLA PLA
2. Byte holen
pop mantissa 1
AND PUT IT IN ARG
   
.,AE6E 85 6A STA $6A STA ARGHO
IFN ADDPRC,<
und speichern
save FAC2 mantissa 1
     
.,AE70 68 PLA PLA
3. Byte holen
pop mantissa 2
     
.,AE71 85 6B STA $6B STA ARGMOH>
und speichern
save FAC2 mantissa 2
     
.,AE73 68 PLA PLA
4. Byte holen
pop mantissa 3
     
.,AE74 85 6C STA $6C STA ARGMO
und speichern
save FAC2 mantissa 3
     
.,AE76 68 PLA PLA
5. Byte holen
pop mantissa 4
     
.,AE77 85 6D STA $6D STA ARGLO
und speichern
save FAC2 mantissa 4
     
.,AE79 68 PLA PLA
6. Byte (Vorzeichen holen
pop sign
     
.,AE7A 85 6E STA $6E STA ARGSGN
und speichern
save FAC2 sign (b7)
     
.,AE7C 45 66 EOR $66 EOR FACSGN ;GET PROBABLE RESULT SIGN.
Vorzeichen von ARG und FAC
EOR FAC1 sign (b7)
SAVE EOR OF SIGNS OF THE OPERANDS,
   
.,AE7E 85 6F STA $6F STA ARISGN ;ARITHMETIC SIGN. USED BY
;ADD, SUB, MULT, DIV.
verknüpfen und speichern
save sign compare (FAC1 EOR FAC2)
IN CASE OF MULTIPLY OR DIVIDE
   
.,AE80 A5 61 LDA $61 QOPRTS: LDA FACEXP ;GET IT AND SET CODES.
Exponentbyte von FAC laden
get FAC1 exponent
FAC EXPONENT IN A-REG
   
.,AE82 60 RTS UNPRTS: RTS ;RETURN.
Rücksprung

Nächstes Element eines

Ausdrucks holen

get value from line

STATUS .EQ. IF (FAC)=0
RTS GOES TO PERFORM OPERATION

GET ELEMENT IN EXPRESSION

GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT
TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC.
 

get arithmetic element routine

.,AE83 6C 0A 03 JMP ($030A)   JMP $AE86
get arithmetic element

get arithmetic element, the get arithmetic element vector is initialised to point here

    normally AE86

standard arithmetic element

.,AE86 A9 00 LDA #$00 EVAL: CLR VALTYP ;ASSUME VALUE WILL BE NUMERIC.
Wert laden und damit
clear byte
ASSUME NUMERIC
   
.,AE88 85 0D STA $0D   Typflag auf numerisch setzen
clear data type flag, $FF = string, $00 = numeric
     
.,AE8A 20 73 00 JSR $0073 EVAL0: JSR CHRGET ;GET A CHARACTER.
CHRGET nächstes Zeichen holen
increment and scan memory
     
.,AE8D B0 03 BCS $AE92 BCS EVAL2
Ziffer? nein: $AE92
branch if not numeric character
else numeric string found (e.g. 123)
NOT A DIGIT
   
.,AE8F 4C F3 BC JMP $BCF3 EVAL1: JMP FIN ;IT IS A NUMBER.
Variable nach FAC holen
get FAC1 from string and return
get value from line .. continued
wasn't a number so ...
NUMERIC CONSTANT
   
.,AE92 20 13 B1 JSR $B113 EVAL2: JSR ISLETC ;VARIABLE NAME?
Buchstabe?
check byte, return Cb = 0 if<"A" or >"Z"
VARIABLE NAME?
   
.,AE95 90 03 BCC $AE9A BCS ISVAR ;YES.
nein: JMP umgehen
branch if not variable name
     
.,AE97 4C 28 AF JMP $AF28 IFE REALIO-3,<
Variable holen
variable name set-up and return
YES
   
.,AE9A C9 FF CMP #$FF CMPI PI
BASIC-Code für Pi?
compare with token for PI
    PI
.,AE9C D0 0F BNE $AEAD BNE QDOT
nein: $AEAD
branch if not PI
     
.,AE9E A9 A8 LDA #$A8 LDWDI PIVAL
Zeiger auf Konstante Pi
get PI pointer low byte
    low AEA8
.,AEA0 A0 AE LDY #$AE   (LOW und HIGH-Byte)
get PI pointer high byte
    high AEA8
.,AEA2 20 A2 BB JSR $BBA2 JSR MOVFM ;PUT VALUE IN FOR PI.
Konstante in FAC holen
unpack memory (AY) into FAC1
     
.,AEA5 4C 73 00 JMP $0073 JMP CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory and return

PI as floating number

   

float value of PI

.:AEA8 82 49 0F DA A1 PIVAL: ^O202
^O111
^O017
^O332
^O241>
Konstante Pi 3.14159265
3.141592653

get value from line .. continued

wasn't variable name so ...
     
.,AEAD C9 2E CMP #$2E QDOT: CMPI "." ;LEADING CHARACTER OF CONSTANT?
'.' Dezimalpunkt?
compare with "."
DECIMAL POINT
  decimal point
.,AEAF F0 DE BEQ $AE8F BEQ EVAL1
ja: $AE8F
if so get FAC1 from string and return, e.g. was .123
wasn't .123 so ...
YES, NUMERIC CONSTANT
   
.,AEB1 C9 AB CMP #$AB CMPI MINUTK ;NEGATION?
'-'?
compare with token for -
UNARY MINUS?
  plus code
.,AEB3 F0 58 BEQ $AF0D BEQ DOMIN ;SHO IS.
zum Vorzeichenwechsel
branch if - token, do set-up for functions
wasn't -123 so ...
YES
   
.,AEB5 C9 AA CMP #$AA CMPI PLUSTK
'+'?
compare with token for +
UNARY PLUS
  times code
.,AEB7 F0 D1 BEQ $AE8A BEQ EVAL0
ja: $Ae8A
branch if + token, +1 = 1 so ignore leading +
it wasn't any sort of number so ...
YES
   
.,AEB9 C9 22 CMP #$22 CMPI 34 ;A QUOTE? A STRING?
'"'?
compare with "
STRING CONSTANT?
  quote mark
.,AEBB D0 0F BNE $AECC BNE EVAL3
nein: $AECC
branch if not open quote
was open quote so get the enclosed string

print "..." string to string utility area

NO

STRING CONSTANT ELEMENT

SET Y,A = (TXTPTR)+CARRY
   
.,AEBD A5 7A LDA $7A STRTXT: LDWD TXTPTR
LOW- und HIGH-Byte des
get BASIC execute pointer low byte
ADD (CARRY) TO GET ADDRESS OF 1ST CHAR
   
.,AEBF A4 7B LDY $7B   Programmzeigers holen
get BASIC execute pointer high byte
OF STRING IN Y,A
   
.,AEC1 69 00 ADC #$00 ADCI 0 ;TO INC, ADD C=1.
und Übertrag addieren
add carry to low byte
     
.,AEC3 90 01 BCC $AEC6 BCC STRTX2
C=0: $AEC6
branch if no overflow
     
.,AEC5 C8 INY INY
HIGH-Byte erhöhen
increment high byte
     
.,AEC6 20 87 B4 JSR $B487 STRTX2: JSR STRLIT ;YES. GO PROCESS IT.
String übertragen
print " terminated string to utility pointer
BUILD DESCRIPTOR TO STRING
GET ADDRESS OF DESCRIPTOR IN FAC
   
.,AEC9 4C E2 B7 JMP $B7E2 JMP ST2TXT
Programmz. auf Stringende +1
restore BASIC execute pointer from temp and return
get value from line .. continued
wasn't a string so ...
POINT TXTPTR AFTER TRAILING QUOTE
   
.,AECC C9 A8 CMP #$A8 EVAL3: CMPI NOTTK ;CHECK FOR "NOT" OPERATOR.
'NOT'-Code?
compare with token for NOT
    NOT code
.,AECE D0 13 BNE $AEE3 BNE EVAL4
nein: $AEE3
branch if not token for NOT
was NOT token
NOT "NOT", TRY "FN"
   
.,AED0 A0 18 LDY #$18 LDYI NOTTAB-OPTAB ;"NOT" HAS PRECEDENCE 90.
Offset des H.Flags in Tabelle
offset to NOT function
POINT AT = COMPARISON
   
.,AED2 D0 3B BNE $AF0F BNE GONPRC ;GO DO ITS EVALUATION.
unbedingter Sprung

BASIC-Befehl NOT

do set-up for function then execute, branch always
do = compare
...ALWAYS

"NOT" FUNCTION

IF FAC=0, RETURN FAC=1
IF FAC<>0, RETURN FAC=0
 

NOT operator

.,AED4 20 BF B1 JSR $B1BF NOTOP: JSR AYINT ;INTEGERIZE.
FAC nach INTEGER wandeln
evaluate integer expression, no sign check
     
.,AED7 A5 65 LDA $65 LDA FACLO ;GET THE ARGUMENT.
HIGH-Byte holen
get FAC1 mantissa 4
     
.,AED9 49 FF EOR #$FF EORI 255
alle Bits umdrehen
invert it
     
.,AEDB A8 TAY TAY
und ins Y-Reg.
copy it
     
.,AEDC A5 64 LDA $64 LDA FACMO
LOW-Byte holen
get FAC1 mantissa 3
     
.,AEDE 49 FF EOR #$FF EORI 255
alle Bits invertieren
invert it
     
.,AEE0 4C 91 B3 JMP $B391 JMP GIVAYF ;FLOAT [Y,A] AS RESULT IN FAC.
;AND RETURN.
nach Fließkomma wandeln
convert fixed integer AY to float FAC1 and return
get value from line .. continued
wasn't a string or NOT so ...

COMPARISON FOR EQUALITY (= OPERATOR)

ALSO USED TO EVALUATE "NOT" FUNCTION
 

GET operand

.,AEE3 C9 A5 CMP #$A5 EVAL4: CMPI FNTK ;USER-DEFINED FUNCTION?
'FN'-Code?
compare with token for FN
     
.,AEE5 D0 03 BNE $AEEA JEQ FNDOER
nein: $AEEA
branch if not token for FN
     
.,AEE7 4C F4 B3 JMP $B3F4   FN ausführen
else go evaluate FNx
get value from line .. continued
wasn't a string, NOT or FN so ...
     
.,AEEA C9 B4 CMP #$B4 CMPI ONEFUN ;A FUNCTION NAME?
'SGN'-Code
compare with token for SGN
    SGN code or higher
.,AEEC 90 03 BCC $AEF1 BCC PARCHK ;FUNCTIONS ARE THE HIGHEST NUMBERED
kleiner (keine Stringfunkt.)?
if less than SGN token evaluate expression in parentheses
else was a function token
     
.,AEEE 4C A7 AF JMP $AFA7 JMP ISFUN ;CHARACTERS SO NO NEED TO CHECK
;AN UPPER-BOUND.
holt String ,ersten Parameter

holt Term in Klammern

go set up function references, branch always
get value from line .. continued
if here it can only be something in brackets so ....
evaluate expression within parentheses

EVALUATE "(EXPRESSION)"

   
.,AEF1 20 FA AE JSR $AEFA PARCHK: JSR CHKOPN ;ONLY POSSIBILITY LEFT IS
prüft auf Klammer auf
scan for "(", else do syntax error then warm start
IS THERE A '(' AT TXTPTR?
   
.,AEF4 20 9E AD JSR $AD9E JSR FRMEVL ;A FORMULA IN PARENTHESIS.
;RECURSIVELY EVALUATE THE FORMULA.
FRMEVL holt Term

prüft auf Zeichen im B.-Text

evaluate expression
all the 'scan for' routines return the character after the sought character
scan for ")", else do syntax error then warm start
YES, EVALUATE EXPRESSION
 

check and skip characters

.,AEF7 A9 29 LDA #$29 CHKCLS: LDAI 41 ;CHECK FOR A RIGHT PARENTHESE
')' Klammer zu
load A with ")"
CHECK FOR ')'
  )
.:AEF9 2C .BYTE $2C SKIP2
  makes next line BIT $28A9
scan for "(", else do syntax error then warm start
TRICK
   
.,AEFA A9 28 LDA #$28 CHKOPN: LDAI 40
'(' Klammer auf
load A with "("
    (
.:AEFC 2C .BYTE $2C SKIP2
  makes next line BIT $2CA9
scan for ",", else do syntax error then warm start
TRICK
   
.,AEFD A9 2C LDA #$2C CHKCOM: LDAI 44
;
; "SYNCHK" LOOKS AT THE CURRENT CHARACTER TO MAKE SURE IT
; IS THE SPECIFIC THING LOADED INTO ACCA JUST BEFORE THE CALL TO
; "SYNCHK". IF NOT, IT CALLS THE "SYNTAX ERROR" ROUTINE.
; OTHERWISE IT GOBBLES THE NEXT CHAR AND RETURNS,
;
; [A]=NEW CHAR AND TXTPTR IS ADVANCED BY "CHRGET".
;
',' Komma
load A with ","
scan for CHR$(A), else do syntax error then warm start
COMMA AT TXTPTR?

UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR

  comma
.,AEFF A0 00 LDY #$00 SYNCHR: LDYI 0
Zeiger setzen
clear index
     
.,AF01 D1 7A CMP ($7A),Y CMPDY TXTPTR ;CHARACTERS EQUAL?
mit laufendem Zeichen vergl.
compare with BASIC byte
     
.,AF03 D0 03 BNE $AF08 BNE SNERR
keine Übereinstimmung?
if not expected byte do syntax error then warm start
     
.,AF05 4C 73 00 JMP $0073 CHRGO5: JMP CHRGET
CHRGET nächstes Zeichen holen
else increment and scan memory and return
syntax error then warm start
MATCH, GET NEXT CHAR &amp; RETURN
   
.,AF08 A2 0B LDX #$0B SNERR: LDXI ERRSN ;"SYNTAX ERROR"
Nummer für 'SYNTAX ERROR'
error code $0B, syntax error
    error number
.,AF0A 4C 37 A4 JMP $A437 JMP ERROR
Fehlermeldung ausgeben
do error #X then warm start
   

recursive geet value

.,AF0D A0 15 LDY #$15 DOMIN: LDYI NEGTAB-OPTAB ;A PRECEDENCE BELOW "^".
Offset Hierachie-Code für VZW
set offset from base to > operator
POINT AT UNARY MINUS
   
.,AF0F 68 PLA GONPRC: PLA ;GET RID OF RTS ADDR.
nächsten 2 Bytes vom
dump return address low byte
     
.,AF10 68 PLA PLA
Stapel entfernen
dump return address high byte
     
.,AF11 4C FA AD JMP $ADFA JMP NEGPRC ;EVALUTE FOR NEGATION.
zur Auswertung

prüft auf Variable

execute function then continue evaluation

check address range, return Cb = 1 if address in BASIC ROM

   

check variable pointer range

.,AF14 38 SEC   innerhalb des BASICs
set carry for subtract
     
.,AF15 A5 64 LDA $64   Carry setzen (Subtr.)
get variable address low byte
     
.,AF17 E9 00 SBC #$00   Descriptor holen
subtract $A000 low byte
     
.,AF19 A5 65 LDA $65   liegt Descriptor ($64/$65)
get variable address high byte
     
.,AF1B E9 A0 SBC #$A0   zwischen $A000 und $E32A?
subtract $A000 high byte
     
.,AF1D 90 08 BCC $AF27   ja: dann C=1, sonst RTS
exit if address < $A000
     
.,AF1F A9 A2 LDA #$A2   1. Wert laden
get end of BASIC marker low byte
     
.,AF21 E5 64 SBC $64   1. Descriptorbyte abziehen
subtract variable address low byte
     
.,AF23 A9 E3 LDA #$E3   2. Wert laden
get end of BASIC marker high byte
     
.,AF25 E5 65 SBC $65   und Descriptorwert abziehen
subtract variable address high byte
     
.,AF27 60 RTS   Rücksprung

Variable holen

variable name set-up

   

get value of variable

.,AF28 20 8B B0 JSR $B08B ISVAR: JSR PTRGET ;GET A PNTR TO VARIABLE.
Variable suchen
get variable address
     
.,AF2B 85 64 STA $64 ISVRET: STWD FACMO
Zeiger auf Variable
save variable pointer low byte
ADDRESS OF VARIABLE
   
.,AF2D 84 65 STY $65 IFN TIME!EXTIO,<
bzw. Stringdescriptor
save variable pointer high byte
     
.,AF2F A6 45 LDX $45 LDWD VARNAM> ;CHECK TIME,TIME$,STATUS.
als
get current variable name first character
NUMERIC OR STRING?
   
.,AF31 A4 46 LDY $46 LDX VALTYP
Variablenname speichern
get current variable name second character
     
.,AF33 A5 0D LDA $0D   Typflag holen
get data type flag, $FF = string, $00 = numeric
     
.,AF35 F0 26 BEQ $AF5D BEQ GOOO ;THE STRING IS SET UP.
numerisch?
branch if numeric
variable is string
NUMERIC
   
.,AF37 A9 00 LDA #$00 LDXI 0
Wert laden und
else clear A
     
.,AF39 85 70 STA $70 STX FACOV
IFN TIME,<
in Rundungsbyte fur FAC
clear FAC1 rounding byte
     
.,AF3B 20 14 AF JSR $AF14 BIT FACLO ;AN ARRAY?
Descriptor im Interpreter?
check address range
     
.,AF3E 90 1C BCC $AF5C BPL STRRTS ;YES.
nein
exit if not in BASIC ROM
     
.,AF40 E0 54 CPX #$54 CMPI "T" ;TI$?
'T'? (von TI$)
compare variable name first character with "T"
    T
.,AF42 D0 18 BNE $AF5C BNE STRRTS
nein: $AF5C
exit if not "T"
     
.,AF44 C0 C9 CPY #$C9 CPYI "I"+128
'I$'? (von TI$)
compare variable name second character with "I$"
    I$
.,AF46 D0 14 BNE $AF5C BNE STRRTS
nein: $AF5C
exit if not "I$"
variable name was "TI$"
     
.,AF48 20 84 AF JSR $AF84 JSR GETTIM ;YES. PUT TIME IN FACMOH-LO.
Zeit nach FAC holen
read real time clock into FAC1 mantissa, 0HML
     
.,AF4B 84 5E STY $5E STY TENEXP ;Y=0.
Flag für Exponentialdarst. =0
clear exponent count adjust
     
.,AF4D 88 DEY DEY
vermindern (=$FF)
Y = $FF
     
.,AF4E 84 71 STY $71 STY FBUFPT
Zeiger für Stringstartadresse
set output string index, -1 to allow for pre increment
     
.,AF50 A0 06 LDY #$06 LDYI 6 ;SIX DIGITS TO PRINT.
Länge 6 für TI$
HH:MM:SS is six digits
     
.,AF52 84 5D STY $5D STY DECCNT
speichern
set number of characters before the decimal point
     
.,AF54 A0 24 LDY #$24 LDYI FDCEND-FOUTBL
Zeiger auf Stellenwert
index to jiffy conversion table
     
.,AF56 20 68 BE JSR $BE68 JSR FOUTIM ;CONVERT TO ASCII.
erzeugt String TI$
convert jiffy count to string
     
.,AF59 4C 6F B4 JMP $B46F JMP TIMSTR>
bringt String in Str.bereich
exit via STR$() code tail
     
.,AF5C 60 RTS STRRTS: RTS
GOOO:
IFN INTPRC,<
Rücksprung
variable name set-up, variable is numeric
     
.,AF5D 24 0E BIT $0E LDX INTFLG
INTEGER/ REAL Flag
test data type flag, $80 = integer, $00 = float
     
.,AF5F 10 0D BPL $AF6E BPL GOOOOO
REAL? ja: $AF6E

Integervariable holen

branch if float
FLOATING POINT
   
.,AF61 A0 00 LDY #$00 LDYI 0
Zeiger setzen
clear index
INTEGER
   
.,AF63 B1 64 LDA ($64),Y LDADY FACMO ;FETCH HIGH.
Intgerzahl holen (1. Byte)
get integer variable low byte
     
.,AF65 AA TAX TAX
ins X-Reg.
copy to X
GET VALUE IN A,Y
   
.,AF66 C8 INY INY
Zeiger erhöhen
increment index
     
.,AF67 B1 64 LDA ($64),Y LDADY FACMO
2. Byte holen
get integer variable high byte
     
.,AF69 A8 TAY TAY ;PUT LOW IN Y.
ins Y-Register
copy to Y
     
.,AF6A 8A TXA TXA ;GET HIGH IN A.
1. Byte in Akku holen
copy loa byte to A
     
.,AF6B 4C 91 B3 JMP $B391 JMP GIVAYF> ;FLOAT AND RETURN.
GOOOOO:
IFN TIME,<
und nach Fließkomma wandeln

REAL-Variable holen

convert fixed integer AY to float FAC1 and return
variable name set-up, variable is float
CONVERT A,Y TO FLOATING POINT
   
.,AF6E 20 14 AF JSR $AF14 BIT FACLO ;AN ARRAY?
Descriptor im Interpreter?
check address range
     
.,AF71 90 2D BCC $AFA0 BPL GOMOVF ;YES.
nein
if not in BASIC ROM get pointer and unpack into FAC1
     
.,AF73 E0 54 CPX #$54 CMPI "T"
'T'? (von TI)
compare variable name first character with "T"
    T
.,AF75 D0 1B BNE $AF92 BNE QSTATV
nein: $AF92
branch if not "T"
     
.,AF77 C0 49 CPY #$49 CPYI "I"
'I'? (von TI)
compare variable name second character with "I"
    I
.,AF79 D0 25 BNE $AFA0 BNE GOMOVF
nein: $AFA0
branch if not "I"
variable name was "TI"
     
.,AF7B 20 84 AF JSR $AF84 JSR GETTIM
TIME in FAC holen
read real time clock into FAC1 mantissa, 0HML
     
.,AF7E 98 TYA TYA ;FOR FLOATB.
Akku =0 setzen
clear A
     
.,AF7F A2 A0 LDX #$A0 LDXI 160 ;SET EXPONNENT.
Exponentbyte für FAC
set exponent to 32 bit value
     
.,AF81 4C 4F BC JMP $BC4F JMP FLOATB
FAC linksbündig machen

Zeit holen

set exponent = X and normalise FAC1

read real time clock into FAC1 mantissa, 0HML

   

get time in float accu

.,AF84 20 DE FF JSR $FFDE GETTIM: LDWDI <CQTIMR-2>
TIME holen
read real time clock
     
.,AF87 86 64 STX $64 SEI ;TURN OF INT SYS.
1. Byte nach FAC
save jiffy clock mid byte as FAC1 mantissa 3
     
.,AF89 84 63 STY $63 JSR MOVFM
2. Byte nach FAC
save jiffy clock high byte as FAC1 mantissa 2
     
.,AF8B 85 65 STA $65 CLI ;BACK ON.
3. Byte nach FAC
save jiffy clock low byte as FAC1 mantissa 4
     
.,AF8D A0 00 LDY #$00   Wert laden (0) und
clear Y
     
.,AF8F 84 62 STY $62 STY FACHO ;ZERO HIGHEST.
als 4. Byte nach FAC
clear FAC1 mantissa 1
     
.,AF91 60 RTS RTS>
QSTATV:
IFN EXTIO,<
Rücksprung
variable name set-up, variable is float and not "Tx"
   

continue of get value of variable

.,AF92 E0 53 CPX #$53 CMPI "S"
'S'?
compare variable name first character with "S"
    S
.,AF94 D0 0A BNE $AFA0 BNE GOMOVF
nein: $AFA0
if not "S" go do normal floating variable
     
.,AF96 C0 54 CPY #$54 CPYI "T"
'T'?
compare variable name second character with "
    T
.,AF98 D0 06 BNE $AFA0 BNE GOMOVF
nein: $AFA0
if not "T" go do normal floating variable
variable name was "ST"
     
.,AF9A 20 B7 FF JSR $FFB7 LDA CQSTAT
Status holen
read I/O status word
     
.,AF9D 4C 3C BC JMP $BC3C JMP FLOAT
GOMOVF:>
IFN TIME!EXTIO,<
Byte in Fließkommaformat

REAL-Variable holen

save A as integer byte and return
variable is float
     
.,AFA0 A5 64 LDA $64 LDWD FACMO>
LOW- und HIGH-Byte der
get variable pointer low byte
     
.,AFA2 A4 65 LDY $65   Variablenadresse
get variable pointer high byte
     
.,AFA4 4C A2 BB JMP $BBA2 JMP MOVFM ;MOVE ACTUAL VALUE IN.
;AND RETURN.
Variable in FAC holen

Funktionsberechnung

unpack memory (AY) into FAC1

get value from line continued

only functions left so ..
set up function references

PROCESS UNARY OPERATORS (FUNCTIONS)

 

apply function

.,AFA7 0A ASL ISFUN: ASL A, ;MULTIPLY BY TWO.
Funktionscode mal 2
*2 (2 bytes per function address)
DOUBLE TOKEN TO GET INDEX
   
.,AFA8 48 PHA PHA
auf den Stapel retten
save function offset
     
.,AFA9 AA TAX TAX
und ins X-Register
copy function offset
     
.,AFAA 20 73 00 JSR $0073 JSR CHRGET ;SET UP FOR SYNCHK.
CHRGET nächstes Zeichen
increment and scan memory
     
.,AFAD E0 8F CPX #$8F CPXI 2*LASNUM-256+1 ;IS IT PAST "LASNUM"?
numerische Funktion?
compare function offset to CHR$ token offset+1
LEFT$, RIGHT$, AND MID$
   
.,AFAF 90 20 BCC $AFD1 BCC OKNORM ;NO, MUST BE NORMAL FUNCTION.
;
; MOST FUNCTIONS TAKE A SINGLE ARGUMENT.
; THE RETURN ADDRESS OF THESE FUNCTIONS IS "CHKNUM"
; WHICH ASCERTAINS THAT [VALTYP]=0 (NUMERIC).
; NORMAL FUNCTIONS THAT RETURN STRING RESULTS
; (E.G., CHR$) MUST POP OFF THAT RETURN ADDR AND
; RETURN DIRECTLY TO "FRMEVL".
;
; THE SO-CALLED "FUNNY" FUNCTIONS CAN TAKE MORE THAN ONE ARGUMENT,
; THE FIRST OF WHICH MUST BE STRING AND THE SECOND OF WHICH
; MUST BE A NUMBER BETWEEN 0 AND 255.
; THE CLOSED PARENTHESIS MUST BE CHECKED AND RETURN IS DIRECTLY
; TO "FRMEVL" WITH THE TEXT PNTR POINTING BEYOND THE ")".
; THE POINTER TO THE DESCRIPTOR OF THE STRING ARGUMENT
; IS STORED ON THE STACK UNDERNEATH THE VALUE OF THE
; INTEGER ARGUMENT.
;
ja: $AFD1

Stringfunktion, String und

ersten Parameter

branch if < LEFT$ (can not be =)
get value from line .. continued
was LEFT$, RIGHT$ or MID$ so..
NOT ONE OF THE STRING FUNCTIONS
   
.,AFB1 20 FA AE JSR $AEFA JSR CHKOPN ;CHECK FOR AN OPEN PARENTHESE
prüft auf Klammer auf
scan for "(", else do syntax error then warm start
STRING FUNCTION, NEED "("
   
.,AFB4 20 9E AD JSR $AD9E JSR FRMEVL ;EAT OPEN PAREN AND FIRST ARG.
FRMEVL holen beliebigen Term
evaluate, should be string, expression
EVALUATE EXPRESSION FOR STRING
   
.,AFB7 20 FD AE JSR $AEFD JSR CHKCOM ;TWO ARGS SO COMMA MUST DELIMIT.
prüft auf Komma
scan for ",", else do syntax error then warm start
REQUIRE A COMMA
   
.,AFBA 20 8F AD JSR $AD8F JSR CHKSTR ;MAKE SURE FIRST WAS STRING.
prüft auf String
check if source is string, else do type mismatch
MAKE SURE EXPRESSION IS A STRING
   
.,AFBD 68 PLA PLA ;GET FUNCTION NUMBER.
Funktionstoken left$, r$, m$
restore function offset
     
.,AFBE AA TAX TAX
Akku nach X holen
copy it
RETRIEVE ROUTINE POINTER
   
.,AFBF A5 65 LDA $65 PSHWD FACMO ;SAVE POINTER AT STRING DESCRIPTOR
Adresse des
get descriptor pointer high byte
STACK ADDRESS OF STRING
   
.,AFC1 48 PHA   Stringdescriptors
push string pointer high byte
     
.,AFC2 A5 64 LDA $64   holen und auf den Stapel
get descriptor pointer low byte
     
.,AFC4 48 PHA   retten (LOW und HIGH)
push string pointer low byte
     
.,AFC5 8A TXA TXA
Akku wiederholen
restore function offset
     
.,AFC6 48 PHA PHA ;RESAVE FUNCTION NUMBER.
;THIS MUST BE ON STACK SINCE RECURSIVE.
Token auf den Stapel retten
save function offset
STACK DOUBLED TOKEN
   
.,AFC7 20 9E B7 JSR $B79E JSR GETBYT ;[X]=VALUE OF FORMULA.
holt Byte-Wert (2. Parameter)
get byte parameter
CONVERT NEXT EXPRESSION TO BYTE IN X-REG
   
.,AFCA 68 PLA PLA ;GET FUNCTION NUMBER.
Token zurückholen
restore function offset
GET DOUBLED TOKEN OFF STACK
   
.,AFCB A8 TAY TAY
und ins Y-Reg.
copy function offset
USE AS INDEX TO BRANCH
   
.,AFCC 8A TXA TXA
2. Bytewert in den Akku laden
copy byte parameter to A
VALUE OF SECOND PARAMETER
   
.,AFCD 48 PHA PHA
und auf den Stapel retten
push byte parameter
PUSH 2ND PARAM
   
.,AFCE 4C D6 AF JMP $AFD6 JMP FINGO ;DISPATCH TO FUNCTION.
Routine ausführen

numerische Funktion auswerten

go call function
get value from line .. continued
was SGN() to CHR$() so..
JOIN UNARY FUNCTIONS
   
.,AFD1 20 F1 AE JSR $AEF1 OKNORM: JSR PARCHK ;READ A FORMULA SURROUNDED BY PARENS.
holt Term in Klammern
evaluate expression within parentheses
REQUIRE "(EXPRESSION)"
   
.,AFD4 68 PLA PLA ;GET DISPATCH FUNCTION.
BASIC-Code für Funktion holen
restore function offset
     
.,AFD5 A8 TAY TAY
und als Zeiger ins Y-Reg.
copy to index
INDEX INTO FUNCTION ADDRESS TABLE
   
.,AFD6 B9 EA 9F LDA $9FEA,Y FINGO: LDA FUNDSP-2*ONEFUN+256,Y, ;MODIFY DISPATCH ADDRESS.
Vektor für Funktionsbe-
get function jump vector low byte
     
.,AFD9 85 55 STA $55 STA JMPER+1
rechnung holen und speichern
save functions jump vector low byte
PREPARE TO JSR TO ADDRESS
   
.,AFDB B9 EB 9F LDA $9FEB,Y LDA FUNDSP-2*ONEFUN+257,Y
2.Byte holen
get function jump vector high byte
     
.,AFDE 85 56 STA $56 STA JMPER+2
und speichern
save functions jump vector high byte
     
.,AFE0 20 54 00 JSR $0054 JSR JMPER ;DISPATCH!
;STRING FUNCTIONS REMOVE THIS RET ADDR.
Funktion ausführen
do function call
DOES NOT RETURN FOR
CHR$, LEFT$, RIGHT$, OR MID$
   
.,AFE3 4C 8D AD JMP $AD8D JMP CHKNUM ;CHECK IT FOR NUMERICNESS AND RETURN.
prüft auf numerisch

BASIC-Befehl OR

check if source is numeric and RTS, else do type mismatch
string functions avoid this by dumping the return address

perform OR

this works because NOT(NOT(x) AND NOT(y)) = x OR y
REQUIRE NUMERIC RESULT
 

OR operator

.,AFE6 A0 FF LDY #$FF OROP: LDYI 255 ;MUST ALWAYS COMPLEMENT..
Flag für OR
set Y for OR
     
.:AFE8 2C .BYTE $2C SKIP2

BASIC-Befehl AND

makes next line BIT $00A0

perform AND

   

AND operator

.,AFE9 A0 00 LDY #$00 ANDOP: LDYI 0
Flag fur AND
clear Y for AND
     
.,AFEB 84 0B STY $0B STY COUNT ;OPERATOR.
Flag setzen
set AND/OR invert value
     
.,AFED 20 BF B1 JSR $B1BF JSR AYINT ;[FACMO&LO]=INT VALUE AND CHECK SIZE.
FAC nach INTEGER wandeln
evaluate integer expression, no sign check
     
.,AFF0 A5 64 LDA $64 LDA FACMO ;USE DEMORGAN'S LAW ON HIGH
ersten Wert holen
get FAC1 mantissa 3
     
.,AFF2 45 0B EOR $0B EOR COUNT
mit Flag verknüpfen
EOR low byte
     
.,AFF4 85 07 STA $07 STA INTEGR
und speichern
save it
     
.,AFF6 A5 65 LDA $65 LDA FACLO ;AND LOW.
zweiten Wert holen
get FAC1 mantissa 4
     
.,AFF8 45 0B EOR $0B EOR COUNT
mit Flag verknüpfen
EOR high byte
     
.,AFFA 85 08 STA $08 STA INTEGR+1
und speichern
save it
     
.,AFFC 20 FC BB JSR $BBFC JSR MOVFA
ARG nach FAC
copy FAC2 to FAC1, get 2nd value in expression
     
.,AFFF 20 BF B1 JSR $B1BF JSR AYINT ;[FACMO&LO]=INT OF ARG.
FAC nach Integer
evaluate integer expression, no sign check
     
.,B002 A5 65 LDA $65 LDA FACLO
zweites Byte holen
get FAC1 mantissa 4
     
.,B004 45 0B EOR $0B EOR COUNT
mit Flag verknüpfen
EOR high byte
     
.,B006 25 08 AND $08 AND INTEGR+1
logische AND-Verknüpfung
AND with expression 1 high byte
     
.,B008 45 0B EOR $0B EOR COUNT ;FINISH OUT DEMORGAN.
mit Flag verknüpfen
EOR result high byte
     
.,B00A A8 TAY TAY ;SAVE HIGH.
ins Y-Reg. retten
save in Y
     
.,B00B A5 64 LDA $64 LDA FACMO
erstes Byte holen
get FAC1 mantissa 3
     
.,B00D 45 0B EOR $0B EOR COUNT
mit Flag verknüpfen
EOR low byte
     
.,B00F 25 07 AND $07 AND INTEGR
logische AND-Verknüpfung
AND with expression 1 low byte
     
.,B011 45 0B EOR $0B EOR COUNT
mit Flag verknüpfen
EOR result low byte
     
.,B013 4C 91 B3 JMP $B391 JMP GIVAYF ;FLOAT [A.Y] AND RET TO USER.
;
; TIME TO PERFORM A RELATIONAL OPERATOR.
; [DOMASK] CONTAINS THE BITS AS TO WHICH RELATIONAL
; OPERATOR IT WAS. CARRY BIT ON=STRING COMPARE.
;
wieder in Fließkomma wandeln

Vergleich

convert fixed integer AY to float FAC1 and return

perform comparisons

do < compare

PERFORM RELATIONAL OPERATIONS

 

greater/equal/less operator

.,B016 20 90 AD JSR $AD90 DOREL: JSR CHKVAL ;CHECK FOR MATCH.
prüft auf identischen Typ
type match check, set C for string
MAKE SURE FAC IS CORRECT TYPE
   
.,B019 B0 13 BCS $B02E BCS STRCMP ;IT IS A STRING.
String: dann weiter
branch if string
do numeric < compare
TYPE MATCHES, BRANCH IF STRINGS
   
.,B01B A5 6E LDA $6E LDA ARGSGN ;PACK ARG FOR FCOMP.
Wert holen
get FAC2 sign (b7)
NUMERIC COMPARISON
   
.,B01D 09 7F ORA #$7F ORAI 127
ARG in Speicherformat
set all non sign bits
RE-PACK VALUE IN ARG FOR FCOMP
   
.,B01F 25 6A AND $6A AND ARGHO
wandeln und
and FAC2 mantissa 1 (AND in sign bit)
     
.,B021 85 6A STA $6A STA ARGHO
wieder abspeichern
save FAC2 mantissa 1
     
.,B023 A9 69 LDA #$69 LDWDI ARGEXP
Adresse von ARG
set pointer low byte to FAC2
     
.,B025 A0 00 LDY #$00   (LOW- und HIGH-Byte)
set pointer high byte to FAC2
     
.,B027 20 5B BC JSR $BC5B JSR FCOMP
Vergleich ARG mit FAC
compare FAC1 with (AY)
RETURN A-REG = -1,0,1
   
.,B02A AA TAX TAX
  copy the result
AS ARG <,=,> FAC
   
.,B02B 4C 61 B0 JMP $B061 JMP QCOMP
Ergebnis in FAC holen

Stringvergleich

go evaluate result
do string < compare

STRING COMPARISON

   
.,B02E A9 00 LDA #$00 STRCMP: CLR VALTYP ;RESULT WILL BE NUMERIC.
Wert laden und damit
clear byte
SET RESULT TYPE TO NUMERIC
   
.,B030 85 0D STA $0D   Stringflag löschen
clear data type flag, $FF = string, $00 = numeric
     
.,B032 C6 4D DEC $4D DEC OPMASK ;TURN OFF VALTYP WHICH WAS STRING.
Operatormaske - 1
clear < bit in comparrison evaluation flag
MAKE CPRTYP 0000<=>0
   
.,B034 20 A6 B6 JSR $B6A6 JSR FREFAC ;FREE THE FACLO STRING.
FRLSTR
pop string off descriptor stack, or from top of string
space returns with A = length, X = pointer low byte,
Y = pointer high byte
     
.,B037 85 61 STA $61 STA DSCTMP ;SAVE FOR LATER.
Stringlänge holen
save length
STRING LENGTH
   
.,B039 86 62 STX $62 STXY DSCTMP+1
LOW- und HIGH-Byte der
save string pointer low byte
     
.,B03B 84 63 STY $63   Stringadresse speichern
save string pointer high byte
     
.,B03D A5 6C LDA $6C LDWD ARGMO ;GET POINTER TO OTHER STRING.
LOW- und HIGH-Byte des
get descriptor pointer low byte
     
.,B03F A4 6D LDY $6D   Zeigers auf zweiten String
get descriptor pointer high byte
     
.,B041 20 AA B6 JSR $B6AA JSR FRETMP ;FREES FIRST DESC POINTER.
FRESTR
pop (YA) descriptor off stack or from top of string space
returns with A = length, X = pointer low byte,
Y = pointer high byte
     
.,B044 86 6C STX $6C STXY ARGMO
Adresse des
save string pointer low byte
     
.,B046 84 6D STY $6D   2. Strings
save string pointer high byte
     
.,B048 AA TAX TAX ;COPY COUNT INTO X.
Länge des 2.Strings merken
copy length
LEN (ARG) STRING
   
.,B049 38 SEC SEC
Carry setzen (Subtraktion)
set carry for subtract
     
.,B04A E5 61 SBC $61 SBC DSCTMP ;WHICH IS GREATER. IF 0, ALL SET UP.
Längen vergleichen
subtract string 1 length
SET X TO SMALLER LEN
   
.,B04C F0 08 BEQ $B056 BEQ STASGN ;JUST PUT SIGN OF DIFFERENCE AWAY.
gleich: $B056
branch if str 1 length = string 2 length
     
.,B04E A9 01 LDA #$01 LDAI 1
Wert für: 1.String länger
set str 1 length > string 2 length
     
.,B050 90 04 BCC $B056 BCC STASGN ;SIGN IS POSITIVE.
2.String kürzer
branch if so
     
.,B052 A6 61 LDX $61 LDX DSCTMP ;LENGTH OF FAC IS SHORTER.
Länge des 1.Strings
get string 1 length
     
.,B054 A9 FF LDA #$FF LDAI ^O377 ;GET A MINUS 1 FOR NEGATIVES.
Wert für: 1.String kürzer
set str 1 length < string 2 length
     
.,B056 85 66 STA $66 STASGN: STA FACSGN ;KEEP FOR LATER.
Flag für gleichen String,
save length compare
FLAG WHICH SHORTER
   
.,B058 A0 FF LDY #$FF LDYI 255 ;SET POINTER TO FIRST STRING. (ARG.)
wenn beide Strings identisch aber
set index
     
.,B05A E8 INX INX ;TO LOOP PROPERLY.
ungleich lang sind
adjust for loop
     
.,B05B C8 INY NXTCMP: INY
Zeiger erhöhen
increment index
     
.,B05C CA DEX DEX ;ANY CHARACTERS LEFT TO COMPARE?
Stringende?
decrement count
     
.,B05D D0 07 BNE $B066 BNE GETCMP ;NOT DONE YET.
nein: weiter
branch if still bytes to do
MORE CHARS IN BOTH STRINGS
   
.,B05F A6 66 LDX $66 LDX FACSGN ;USE SIGN OF LENGTH DIFFERENCE
;SINCE ALL CHARACTERS ARE THE SAME.
Vorzeichenbyte holen
get length compare back
IF = SO FAR, DECIDE BY LENGTH
   
.,B061 30 0F BMI $B072 QCOMP: BMI DOCMP ;C IS ALWAYS SET THEN.
negativ: $B072
branch if str 1 < str 2
     
.,B063 18 CLC CLC
Carry löschen
flag str 1 <= str 2
     
.,B064 90 0C BCC $B072 BCC DOCMP ;ALWAYS BRANCH.
unbedingter Sprung
go evaluate result
...ALWAYS
   
.,B066 B1 6C LDA ($6C),Y GETCMP: LDADY ARGMO ;GET NEXT CHAR TO COMPARE.
Vergleich der Strings
get string 2 byte
     
.,B068 D1 62 CMP ($62),Y CMPDY DSCTMP+1 ;SAME?
zeichenweise
compare with string 1 byte
     
.,B06A F0 EF BEQ $B05B BEQ NXTCMP ;YEP. TRY FURTHER.
gleiche Zeichen: weiter
loop if bytes =
SAME, KEEP COMPARING
   
.,B06C A2 FF LDX #$FF LDXI ^O377 ;SET A POSITIVE DIFFERENCE.
Wert laden
set str 1 < string 2
IN CASE ARG GREATER
   
.,B06E B0 02 BCS $B072 BCS DOCMP ;PUT STACK BACK TOGETHER.
und Vergleich beenden
branch if so
IT IS
   
.,B070 A2 01 LDX #$01 LDXI 1 ;SET A NEGATIVE DIFFERENCE.
Wert laden
set str 1 > string 2
FAC GREATER
   
.,B072 E8 INX DOCMP: INX ;-1 TO 1, 0 TO 2, 1 TO 4.
und um 1 erhöhen
x = 0, 1 or 2
CONVERT FF,0,1 TO 0,1,2
   
.,B073 8A TXA TXA
Wert in den Akku
copy to A
     
.,B074 2A ROL ROL A
linksverschieben, Bit 1, 2=$1
* 2 (1, 2 or 4)
AND TO 0,2,4 IF C=0, ELSE 1,2,5
   
.,B075 25 12 AND $12 AND DOMASK
mit Vorzeichen verknüpfen
AND with the comparison evaluation flag
00000<=>
   
.,B077 F0 02 BEQ $B07B BEQ GOFLOT
=0: $B07B
branch if 0 (compare is false)
IF NO MATCH: FALSE
   
.,B079 A9 FF LDA #$FF LDAI ^O377 ;MAP 0 TO 0. ALL OTHERS TO -1.
  else set result true
AT LEAST ONE MATCH: TRUE
   
.,B07B 4C 3C BC JMP $BC3C GOFLOT: JMP FLOAT ;FLOAT THE ONE-BYTE RESULT INTO FAC.
PAGE

DIMENSION AND VARIABLE SEARCHING.

;
; THE "DIM" CODE SETS [DIMFLG] AND THEN FALLS INTO THE VARIABLE SEARCH
; ROUTINE, WHICH LOOKS AT DIMFLG AT THREE DIFFERENT POINTS.
; 1) IF AN ENTRY IS FOUND, "DIMFLG" BEING ON INDICATES
; A "DOUBLY" DIMENSIONED VARIABLE.
; 2) WHEN A NEW ENTRY IS BEING BUILT "DIMFLG" BEING ON
; INDICTAES THE INDICES SHOULD BE USED FOR THE
; SIZE OF EACH INDEX. OTHERWISE THE DEFAULT OF TEN
; IS USED.
; 3) WHEN THE BUILD ENTRY CODE FINISHES, ONLY IF "DIMFLG" IS OFF
; WILL INDEXING BE DONE.
;
Ergebnis nach FAC holen
save A as integer byte and return

"DIM" STATEMENT

 

DIM command

.,B07E 20 FD AE JSR $AEFD DIM3: JSR CHKCOM ;MUST BE A COMMA
CHKCOM prüft auf Komma

BASIC-Befehl DIM

scan for ",", else do syntax error then warm start

perform DIM

SEPARATED BY COMMAS
   
.,B081 AA TAX DIM: TAX ;SET [ACCX] NONZERO.
;[ACCA] MUST BE NONZERO TO WORK RIGHT.
nächstes Zeichen
copy "DIM" flag to X
NON-ZERO, FLAGS PTRGET DIM CALLED
   
.,B082 20 90 B0 JSR $B090 DIM1: JSR PTRGT1
Variable dimensionieren
search for variable
ALLOCATE THE ARRAY
   
.,B085 20 79 00 JSR $0079 DIMCON: JSR CHRGOT ;GET LAST CHARACTER.
CHRGOT letztes Zeichen holen
scan memory
NEXT CHAR
   
.,B088 D0 F4 BNE $B07E BNE DIM3
nicht Ende: zur nächsten Var.
scan for "," and loop if not null
NOT END OF STATEMENT
   
.,B08A 60 RTS RTS
;
; ROUTINE TO READ THE VARIABLE NAME AT THE CURRENT TEXT POSITION
; AND PUT A POINTER TO ITS VALUE IN VARPNT. [TXTPTR]
; POINTS TO THE TERMINATING CHARCTER.. NOT THAT EVALUATING SUBSCRIPTS
; IN A VARIABLE NAME CAN CAUSE RECURSIVE CALLS TO "PTRGET" SO AT
; THAT POINT ALL VALUES MUST BE STORED ON THE STACK.
;
Rücksprung

Variable holen

search for variable

PTRGET -- GENERAL VARIABLE SCAN

SCANS VARIABLE NAME AT TXTPTR, AND SEARCHES THE
VARTAB AND ARYTAB FOR THE NAME.
IF NOT FOUND, CREATE VARIABLE OF APPROPRIATE TYPE.
RETURN WITH ADDRESS IN VARPNT AND Y,A
ACTUAL ACTIVITY CONTROLLED SOMEWHAT BY TWO FLAGS:
DIMFLG -- NONZERO IF CALLED FROM "DIM"
ELSE = 0
SUBFLG -- = $00
= $40 IF CALLED FROM "GETARYPT"
= $80 IF CALLED FROM "DEF FN"
= $C1-DA IF CALLED FROM "FN"
 

get name and pointer to a variable

.,B08B A2 00 LDX #$00 PTRGET: LDXI 0 ;MAKE [ACCX]=0.
Flag für nicht dimensionieren
set DIM flag = $00
     
.,B08D 20 79 00 JSR $0079 JSR CHRGOT ;RETRIEVE LAST CHARACTER.
CHRGOT letztes Zeichen holen
scan memory, 1st character
GET FIRST CHAR OF VARIABLE NAME
   
.,B090 86 0C STX $0C PTRGT1: STX DIMFLG ;STORE FLAG AWAY.
DIM-Flag setzen
save DIM flag
X IS NONZERO IF FROM DIM
   
.,B092 85 45 STA $45 PTRGT2: STA VARNAM
Variablenname
save 1st character
     
.,B094 20 79 00 JSR $0079 JSR CHRGOT ;GET CURRENT CHARACTER
;MAYBE WITH FUNCTION BIT OFF.
CHRGOT letztes Zeichen holen
scan memory
     
.,B097 20 13 B1 JSR $B113 JSR ISLETC ;CHECK FOR LETTER.
prüft auf Buchstabe
check byte, return Cb = 0 if<"A" or >"Z"
IS IT A LETTER?
   
.,B09A B0 03 BCS $B09F BCS PTRGT3 ;MUST HAVE A LETTER.
ja: $B09F
branch if ok
YES, OKAY SO FAR
   
.,B09C 4C 08 AF JMP $AF08 INTERR: JMP SNERR
'SYNTAX ERROR'
else syntax error then warm start
was variable name so ...
NO, SYNTAX ERROR
   
.,B09F A2 00 LDX #$00 PTRGT3: LDXI 0 ;ASSUME NO SECOND CHARACTER.
Wert laden und damit
clear 2nd character temp
     
.,B0A1 86 0D STX $0D STX VALTYP ;DEFAULT IS NUMERIC.
IFN INTPRC,<
Stringflag löschen
clear data type flag, $FF = string, $00 = numeric
     
.,B0A3 86 0E STX $0E STX INTFLG> ;ASSUME FLOATING.
Integerflag löschen
clear data type flag, $80 = integer, $00 = float
     
.,B0A5 20 73 00 JSR $0073 JSR CHRGET ;GET FOLLOWING CHARACTER.
CHRGET nächstes Zeichen holen
increment and scan memory, 2nd character
SECOND CHAR OF VARIABLE NAME
   
.,B0A8 90 05 BCC $B0AF BCC ISSEC ;CARRY RESET BY CHRGET IF NUMERIC.
Ziffer?
if character = "0"-"9" (ok) go save 2nd character
2nd character wasn't "0" to "9" so ...
NUMERIC
   
.,B0AA 20 13 B1 JSR $B113 JSR ISLETC ;SET CARRY IF NOT ALPHABETIC.
prüft auf Buchstabe
check byte, return Cb = 0 if<"A" or >"Z"
LETTER?
   
.,B0AD 90 0B BCC $B0BA BCC NOSEC ;ALLOW ALPHABETICS.
nein: $B0BA
branch if <"A" or >"Z" (go check if string)
NO, END OF NAME
   
.,B0AF AA TAX ISSEC: TAX ;IT IS A NUMBER -- SAVE IN ACCX.
zweiter Buchstabe des Names
copy 2nd character
ignore further (valid) characters in the variable name
SAVE SECOND CHAR OF NAME IN X
   
.,B0B0 20 73 00 JSR $0073 EATEM: JSR CHRGET ;LOOK AT NEXT CHARACTER.
CHRGET nächstes Zeichen holen
increment and scan memory, 3rd character
SCAN TO END OF VARIABLE NAME
   
.,B0B3 90 FB BCC $B0B0 BCC EATEM ;SKIP NUMERICS.
Ziffer?
loop if character = "0"-"9" (ignore)
NUMERIC
   
.,B0B5 20 13 B1 JSR $B113 JSR ISLETC
prüft auf Buchstabe
check byte, return Cb = 0 if<"A" or >"Z"
     
.,B0B8 B0 F6 BCS $B0B0 BCS EATEM ;SKIP ALPHABETICS.
ja: weitere Zeichen überlesen
loop if character = "A"-"Z" (ignore)
check if string variable
ALPHA
   
.,B0BA C9 24 CMP #$24 NOSEC: CMPI "$" ;IS IT A STRING?
'$' Code?
compare with "$"
STRING?
  $
.,B0BC D0 06 BNE $B0C4 BNE NOTSTR ;IF NOT, [VALTYP]=0.
nein: $B0C4
branch if not string
type is string
NO
   
.,B0BE A9 FF LDA #$FF LDAI ^O377 ;SET [VALTYP]=255 (STRING !).
Wert laden und
set data type = string
     
.,B0C0 85 0D STA $0D STA VALTYP
IFN INTPRC,<
Stringflag setzen
set data type flag, $FF = string, $00 = numeric
     
.,B0C2 D0 10 BNE $B0D4 BNEA TURNON ;ALWAYS GOES.
Sprung
branch always
...ALWAYS
   
.,B0C4 C9 25 CMP #$25 NOTSTR: CMPI "%" ;INTEGER VARIABLE?
'%' Code?
compare with "%"
INTEGER?
  %
.,B0C6 D0 13 BNE $B0DB BNE STRNAM ;NO.
nein: $B0DB
branch if not integer
NO
   
.,B0C8 A5 10 LDA $10 LDA SUBFLG
Integer erlaubt?
get subscript/FNX flag
YES; INTEGER VARIABLE ALLOWED?
   
.,B0CA D0 D0 BNE $B09C BNE INTERR
nein: 'SYNTAX ERROR'
if ?? do syntax error then warm start
NO, SYNTAX ERROR
   
.,B0CC A9 80 LDA #$80 LDAI 128
Wert für Integer laden
set integer type
YES
   
.,B0CE 85 0E STA $0E STA INTFLG ;SET FLAG.
und Integerflag setzen
set data type = integer
FLAG INTEGER MODE
   
.,B0D0 05 45 ORA $45 ORA VARNAM ;TURN ON BOTH HIGH BITS.
Bit 7 im 1.Zeichen setzen und
OR current variable name first byte
     
.,B0D2 85 45 STA $45 STA VARNAM>
speichern (Bit7=1: Integer)
save current variable name first byte
SET SIGN BIT ON VARNAME
   
.,B0D4 8A TXA TURNON: TXA
X nach Akku speichern
get 2nd character back
SECOND CHAR OF NAME
   
.,B0D5 09 80 ORA #$80 ORAI 128 ;TURN ON MSB OF SECOND CHARACTER.
Bit 7 im 2.Buchstaben setzen
set top bit, indicate string or integer variable
SET SIGN
   
.,B0D7 AA TAX TAX
X-Reg. zurückholen
copy back to 2nd character temp
     
.,B0D8 20 73 00 JSR $0073 JSR CHRGET ;GET CHARACTER AFTER $.
IFE INTPRC,<
NOTSTR:>
CHRGET nächstes Zeichen holen
increment and scan memory
GET TERMINATING CHAR
   
.,B0DB 86 46 STX $46 STRNAM: STX VARNAM+1 ;STORE AWAY SECOND CHARACTER.
zweiten Buchstaben speichern
save 2nd character
STORE SECOND CHAR OF NAME
   
.,B0DD 38 SEC SEC
Feldvariablen erlaubt?
set carry for subtract
     
.,B0DE 05 10 ORA $10 ORA SUBFLG ;ADD FLAG WHETHER TO ALLOW ARRAYS.
wenn nicht, Bit7 setzen
or with subscript/FNX flag - or FN name
$00 OR $40 IF SUBSCRIPTS OK, ELSE $80
   
.,B0E0 E9 28 SBC #$28 SBCI 40 ;(CHECK FOR "(") WON'T MATCH IF SUBFLG SET.
'('-Wert abziehen
subtract "("
IF SUBFLG=$00 AND CHAR="("...
  (
.,B0E2 D0 03 BNE $B0E7 JEQ ISARY ;IT IS!
nicht Klammer auf?
branch if not "("
NOPE
   
.,B0E4 4C D1 B1 JMP $B1D1   dimensionierte Variable holen
go find, or make, array
either find or create variable
variable name wasn't xx(.... so look for plain variable
YES
   
.,B0E7 A0 00 LDY #$00 CLR SUBFLG ;ALLOW SUBSCRIPTS AGAIN.
Wert laden und
clear A
     
.,B0E9 84 10 STY $10   FN-Flag = 0 setzen
clear subscript/FNX flag
     
.,B0EB A5 2D LDA $2D LDA VARTAB ;PLACE TO START SEARCH.
Zeiger auf Variablenanfang
get start of variables low byte
START LOWTR AT SIMPLE VARIABLE TABLE
   
.,B0ED A6 2E LDX $2E LDX VARTAB+1
LDYI 0
holen (LOW und HIGH)
get start of variables high byte
     
.,B0EF 86 60 STX $60 STXFND: STX LOWTR+1
und zum
save search address high byte
     
.,B0F1 85 5F STA $5F LOPFND: STA LOWTR
Suchen merken
save search address low byte
     
.,B0F3 E4 30 CPX $30 CPX ARYTAB+1 ;AT END OF TABLE YET?
Suchzeiger = Variablenanfang
compare with end of variables high byte
END OF SIMPLE VARIABLES?
   
.,B0F5 D0 04 BNE $B0FB BNE LOPFN
nein: $B0FB
skip next compare if <>
high addresses were = so compare low addresses
NO, GO ON
   
.,B0F7 C5 2F CMP $2F CMP ARYTAB
Ende der Variablen erreicht?
compare low address with end of variables low byte
YES; END OF ARRAYS?
   
.,B0F9 F0 22 BEQ $B11D BEQ NOTFNS ;YES. WE COULDN'T FIND IT.
ja: nicht gefunden, anlegen
if not found go make new variable
YES, MAKE ONE
   
.,B0FB A5 45 LDA $45 LOPFN: LDA VARNAM
ersten Buchstaben des Namens
get 1st character of variable to find
SAME FIRST LETTER?
   
.,B0FD D1 5F CMP ($5F),Y CMPDY LOWTR ;COMPARE HIGH ORDERS.
mit Tabelle vergleichen
compare with variable name 1st character
     
.,B0FF D0 08 BNE $B109 BNE NOTIT ;NO COMPARISON.
nein: weitersuchen
branch if no match
1st characters match so compare 2nd character
NOT SAME FIRST LETTER
   
.,B101 A5 46 LDA $46 LDA VARNAM+1
zweiten Buchstaben
get 2nd character of variable to find
SAME SECOND LETTER?
   
.,B103 C8 INY INY
Zeiger erhöhen
index to point to variable name 2nd character
     
.,B104 D1 5F CMP ($5F),Y CMPDY LOWTR ;AND THE LOW PART?
vergleichen
compare with variable name 2nd character
     
.,B106 F0 7D BEQ $B185 BEQ FINPTR ;THAT'S IT ! THAT'S IT !
gleich: gefunden
branch if match (found variable)
YES, SAME VARIABLE NAME
   
.,B108 88 DEY DEY
Zeiger vermindern
else decrement index (now = $00)
NO, BUMP TO NEXT NAME
   
.,B109 18 CLC NOTIT: CLC
Carry setzen (Addition)
clear carry for add
     
.,B10A A5 5F LDA $5F LDA LOWTR
Zeiger um 7
get search address low byte
     
.,B10C 69 07 ADC #$07 ADCI 6+ADDPRC ;MAKES NO DIF AMONG TYPES.
erhöhen (2+5 Byte REAL Var.)
+7, offset to next variable name
     
.,B10E 90 E1 BCC $B0F1 BCC LOPFND
(Länge eines V.-Eintrags)
loop if no overflow to high byte
     
.,B110 E8 INX INX
Übertrag addieren
else increment high byte
     
.,B111 D0 DC BNE $B0EF BNEA STXFND ;ALWAYS BRANCHES.
;
; TEST FOR A LETTER. / CARRY OFF= NOT A LETTER.
; CARRY ON= A LETTER.
;
weiter suchen

prüft auf Buchstabe

loop always, RAM doesn't extend to $FFFF
check byte, return Cb = 0 if<"A" or >"Z"
...ALWAYS

CHECK IF (A) IS ASCII LETTER A-Z

RETURN CARRY = 1 IF A-Z
= 0 IF NOT
<<<NOTE FASTER AND SHORTER CODE: >>>
<<< CMP #'Z'+1 COMPARE HI END
<<< BCS .1 ABOVE A-Z
<<< CMP #'A' COMPARE LO END
<<< RTS C=0 IF LO, C=1 IF A-Z
<<<.1 CLC C=0 IF HI
<<< RTS
 

check character in A

C=1 if alphabetic, C=0 if not
.,B113 C9 41 CMP #$41 ISLETC: CMPI "A"
'A'-Code? (Buchstabencode)
compare with "A"
COMPARE LO END
  A
.,B115 90 05 BCC $B11C BCC ISLRTS ;IF LESS THAN "A", RET.
wenn kleiner: RTS mit C = 0
exit if less
carry is set
C=0 IF LOW
   
.,B117 E9 5B SBC #$5B SBCI "Z"+1
'Z' + 1
subtract "Z"+1
PREPARE HI END TEST
  Z
.,B119 38 SEC SEC
wenn größer 'Z': C = 0
set carry
TEST HI END, RESTORING (A)
   
.,B11A E9 A5 SBC #$A5 SBCI 256-"Z"-1 ;RESET CARRY IF [A] .GT. "Z".
sonst: C = 1 = Buchstabe
subtract $A5 (restore byte)
carry clear if byte > $5A
C=0 IF LO, C=1 IF A-Z
   
.,B11C 60 RTS ISLRTS: RTS ;RETURN TO CALLER.
Rücksprung

Variable anlegen

reached end of variable memory without match
... so create new variable

VARIABLE NOT FOUND, SO MAKE ONE

 

variable not found

.,B11D 68 PLA NOTFNS: PLA ;CHECK WHO'S CALLING.
  pop return address low byte
LOOK AT RETURN ADDRESS ON STACK TO
   
.,B11E 48 PHA PHA ;RESTORE IT.
Aufrufadresse prüfen
push return address low byte
SEE IF CALLED FROM FRM.VARIABLE
   
.,B11F C9 2A CMP #$2A CMPI ISVRET-1-<ISVRET-1>/256*256 ;IS EVAL CALLING?
Aufruf von FRMEVL?
compare with expected calling routine return low byte
     
.,B121 D0 05 BNE $B128 BNE NOTEVL ;NO, CARRY ON.
IFN REALIO-3,<
TSX
LDA 258,X
CMPI <<ISVRET-1>/256>
BNE NOTEVL>
nein: dann neu anlegen
if not get variable go create new variable
this will only drop through if the call was from $AF28 and is only called
from there if it is searching for a variable from the right hand side of a LET a=b
statement, it prevents the creation of variables not assigned a value.
value returned by this is either numeric zero, exponent byte is $00, or null string,
descriptor length byte is $00. in fact a pointer to any $00 byte would have done.
else return dummy null value
NO
   
.,B123 A9 13 LDA #$13 LDZR: LDWDI ZERO ;SET UP PNTR TO SIMULATED ZERO.
Zeiger auf Konstante 0
set result pointer low byte
YES, CALLED FROM FRM.VARIABLE
   
.,B125 A0 BF LDY #$BF   (LOW und HIGH)
set result pointer high byte
POINT TO A CONSTANT ZERO
   
.,B127 60 RTS RTS ;FOR STRINGS OR NUMERIC.
;AND FOR INTEGERS TOO.
NOTEVL:
IFN TIME!EXTIO,<
Rücksprung
create new numeric variable
NEW VARIABLE USED IN EXPRESSION = 0

MAKE A NEW SIMPLE VARIABLE

MOVE ARRAYS UP 7 BYTES TO MAKE ROOM FOR NEW VARIABLE
ENTER 7-BYTE VARIABLE DATA IN THE HOLE
   
.,B128 A5 45 LDA $45 LDWD VARNAM>
LOW- und HIGH-Byte
get variable name first character
     
.,B12A A4 46 LDY $46 IFN TIME,<
des Variablennames
get variable name second character
     
.,B12C C9 54 CMP #$54 CMPI "T"
'T'-Code?
compare first character with "T"
    T
.,B12E D0 0B BNE $B13B BNE QSTAVR
nein: $B13B
branch if not "T"
     
.,B130 C0 C9 CPY #$C9 CPYI "I"+128
'I$'-Code?
compare second character with "I$"
    I$
.,B132 F0 EF BEQ $B123 BEQ LDZR
ja: TI$
if "I$" return null value
     
.,B134 C0 49 CPY #$49 CPYI "I"
'I'-Code?
compare second character with "I"
    I
.,B136 D0 03 BNE $B13B BNE QSTAVR>
IFN EXTIO!TIME,<
nein: $B13B
branch if not "I"
if name is "TI" do syntax error
     
.,B138 4C 08 AF JMP $AF08 GOBADV: JMP SNERR>
QSTAVR:
IFN EXTIO,<
'SYNTAX ERROR'
do syntax error then warm start
     
.,B13B C9 53 CMP #$53 CMPI "S"
'S'-Code?
compare first character with "S"
    S
.,B13D D0 04 BNE $B143 BNE VAROK
nein: $B143
branch if not "S"
     
.,B13F C0 54 CPY #$54 CPYI "T"
'T'-Code?
compare second character with "T"
    T
.,B141 F0 F5 BEQ $B138 BEQ GOBADV>
ST, dann 'SYNTAX ERROR'
if name is "ST" do syntax error
     
.,B143 A5 2F LDA $2F VAROK: LDWD ARYTAB
LOW- und HIGH-Byte des
get end of variables low byte
SET UP CALL TO BLTU TO
   
.,B145 A4 30 LDY $30   Zeigers auf Arraytabelle
get end of variables high byte
TO MOVE FROM ARYTAB THRU STREND-1
   
.,B147 85 5F STA $5F STWD LOWTR ;LOWEST THING TO MOVE.
laden und
save old block start low byte
7 BYTES HIGHER
   
.,B149 84 60 STY $60   merken
save old block start high byte
     
.,B14B A5 31 LDA $31 LDWD STREND ;GET HIGHEST ADDR TO MOVE.
LOW- und HIGH-Byte des
get end of arrays low byte
     
.,B14D A4 32 LDY $32   Zeigers auf Ende der
get end of arrays high byte
     
.,B14F 85 5A STA $5A STWD HIGHTR
Arraytabelle
save old block end low byte
     
.,B151 84 5B STY $5B   merken
save old block end high byte
     
.,B153 18 CLC CLC
Carry für Addition setzen
clear carry for add
     
.,B154 69 07 ADC #$07 ADCI 6+ADDPRC
um 7 verschieben für Anlage
+7, space for one variable
     
.,B156 90 01 BCC $B159 BCC NOTEVE
einer neuen Variablen
branch if no overflow to high byte
     
.,B158 C8 INY INY
Übertrag addieren
else increment high byte
     
.,B159 85 58 STA $58 NOTEVE: STWD HIGHDS ;PLACE TO STUFF IT.
LOW- und HIGH-Byte des
set new block end low byte
     
.,B15B 84 59 STY $59   neuen Blockendes speichern
set new block end high byte
     
.,B15D 20 B8 A3 JSR $A3B8 JSR BLTU ;MOVE IT ALL.
;NOTE [Y,A] HAS [HIGHDS] FOR REASON.
Block verschieben
open up space in memory
MOVE ARRAY BLOCK UP
   
.,B160 A5 58 LDA $58 LDWD HIGHDS ;AND SET UP
Werte
get new start low byte
STORE NEW START OF ARRAYS
   
.,B162 A4 59 LDY $59   wiederholen
get new start high byte (-$100)
     
.,B164 C8 INY INY
und damit
correct high byte
     
.,B165 85 2F STA $2F STWD ARYTAB ;NEW START OF ARRAY TABLE.
Zeiger auf Arraytabelle
set end of variables low byte
     
.,B167 84 30 STY $30   neu setzen
set end of variables high byte
     
.,B169 A0 00 LDY #$00 LDYI 0 ;GET ADDR OF VARIABLE ENTRY.
Zeiger setzen
clear index
     
.,B16B A5 45 LDA $45 LDA VARNAM
erster Buchstabe des Namens
get variable name 1st character
FIRST CHAR OF NAME
   
.,B16D 91 5F STA ($5F),Y STADY LOWTR
und speichern
save variable name 1st character
     
.,B16F C8 INY INY
Zeiger erhöhen,
increment index
     
.,B170 A5 46 LDA $46 LDA VARNAM+1
zweiten Buchstaben holen
get variable name 2nd character
SECOND CHAR OF NAME
   
.,B172 91 5F STA ($5F),Y STADY LOWTR ;STORE NAME OF VARIABLE.
und abspeichern
save variable name 2nd character
     
.,B174 A9 00 LDA #$00 LDAI 0
Nullwert laden
clear A
SET FIVE-BYTE VALUE TO 0
   
.,B176 C8 INY INY
Zeiger erhöhen
increment index
     
.,B177 91 5F STA ($5F),Y STADY LOWTR
nächsten 5 Werte
initialise variable byte
     
.,B179 C8 INY INY
der Variable auf 0 setzen
increment index
     
.,B17A 91 5F STA ($5F),Y STADY LOWTR
2. Byte speichern
initialise variable byte
     
.,B17C C8 INY INY
Zeiger erhöhen
increment index
     
.,B17D 91 5F STA ($5F),Y STADY LOWTR
3. Byte speichern
initialise variable byte
     
.,B17F C8 INY INY
Zeiger erhöhen
increment index
     
.,B180 91 5F STA ($5F),Y STADY LOWTR ;FOURTH ZERO FOR DEF FUNC.
IFN ADDPRC,<
4. Byte speichern
initialise variable byte
     
.,B182 C8 INY INY
Zeiger erhöhen
increment index
     
.,B183 91 5F STA ($5F),Y STADY LOWTR>
5. Byte speichern
initialise variable byte
found a match for variable

PUT ADDRESS OF VALUE OF VARIABLE IN VARPNT AND Y,A

 

variable found

.,B185 A5 5F LDA $5F FINPTR: LDA LOWTR
Zeiger auf Variablenwert
get variable address low byte
LOWTR POINTS AT NAME OF VARIABLE,
   
.,B187 18 CLC CLC
Carry löschen (Addition)
clear carry for add
SO ADD 2 TO GET TO VALUE
   
.,B188 69 02 ADC #$02 ADCI 2
zwei für Namen addieren
+2, offset past variable name bytes
     
.,B18A A4 60 LDY $60 LDY LOWTR+1
in Zeiger auf Variable
get variable address high byte
     
.,B18C 90 01 BCC $B18F BCC FINNOW
Zeiger auf erstes Byte
branch if no overflow from add
     
.,B18E C8 INY INY
High-Byte $48 erhöhen
else increment high byte
     
.,B18F 85 47 STA $47 FINNOW: STWD VARPNT ;THIS IS IT.
als Variablenzeiger
save current variable pointer low byte
ADDRESS IN VARPNT AND Y,A
   
.,B191 84 48 STY $48   nach $47/48 speichern
save current variable pointer high byte
     
.,B193 60 RTS RTS
PAGE

MULTIPLE DIMENSION CODE.

Rücksprung

berechnet Zeiger auf erstes

Arrayelement

set-up array pointer to first element in array

COMPUTE ADDRESS OF FIRST VALUE IN ARRAY

ARYPNT = (LOWTR) + #DIMS*2 + 5
 

compute pointer to array body

.,B194 A5 0B LDA $0B FMAPTR: LDA COUNT
Anzahl der Dimensionen
get # of dimensions (1, 2 or 3)
GET # OF DIMENSIONS
   
.,B196 0A ASL ASL A,
mal 2
*2 (also clears the carry !)
#DIMS*2 (SIZE OF EACH DIM IN 2 BYTES)
   
.,B197 69 05 ADC #$05 ADCI 5 ;POINT TO ENTRIES. C CLR'D BY ASL.
plus 5
+5 (result is 7, 9 or 11 here)
+ 5 (2 FOR NAME, 2 FOR OFFSET TO NEXT
ARRAY, AND 1 FOR #DIMS
   
.,B199 65 5F ADC $5F ADC LOWTR
zu $5F und
add array start pointer low byte
ADDRESS OF TH IS ARRAY IN ARYTAB
   
.,B19B A4 60 LDY $60 LDY LOWTR+1
$60 addieren
get array pointer high byte
     
.,B19D 90 01 BCC $B1A0 BCC JSRGM
Erhöhung umgehen
branch if no overflow
     
.,B19F C8 INY INY
Übertrag addieren
else increment high byte
     
.,B1A0 85 58 STA $58 JSRGM: STWD ARYPNT
Ergebnis-Zeiger nach
save array data pointer low byte
ADDRESS OF FIRST VALUE IN ARRAY
   
.,B1A2 84 59 STY $59   $58/59 speichern
save array data pointer high byte
     
.,B1A4 60 RTS RTS
Rücksprung

-32768 as floating value

   

float number for conversion to integer

.:B1A5 90 80 00 00 00 N32768: EXP 144,128,0,0 ;-32768.
Konstante -32768

Umwandlung FAC nach Integer

-32768

convert float to fixed

-32768 IN FLOATING POINT
 

routine to convert float to fixed point

.,B1AA 20 BF B1 JSR $B1BF   FAC nach Integer wandeln
evaluate integer expression, no sign check
     
.,B1AD A5 64 LDA $64   LOW-Byte
get result low byte
     
.,B1AF A4 65 LDY $65   HIGH-Byte
get result high byte
     
.,B1B1 60 RTS ;
; INTIDX READS A FORMULA FROM THE CURRENT POSITION AND
; TURNS IT INTO A POSITIVE INTEGER
; LEAVING THE RESULT IN FACMO&LO. NEGATIVE ARGUMENTS
; ARE NOT ALLOWED.
;
Rücksprung

Ausdruck holen und

nach Integer

evaluate integer expression

EVALUATE NUMERIC FORMULA AT TXTPTR

CONVERTING RESULT TO INTEGER 0 <= X <= 32767
IN FAC+3,4
 

convert value from statement to integer

.,B1B2 20 73 00 JSR $0073 INTIDX: JSR CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory
     
.,B1B5 20 9E AD JSR $AD9E JSR FRMEVL ;GET A NUMBER
FRMEVL, Ausdruck auswerten
evaluate expression
evaluate integer expression, sign check
     
.,B1B8 20 8D AD JSR $AD8D POSINT: JSR CHKNUM
prüft auf numerisch
check if source is numeric, else do type mismatch

CONVERT FAC TO INTEGER

MUST BE POSITIVE AND LESS THAN 32768
   
.,B1BB A5 66 LDA $66 LDA FACSGN
Vorzeichen?
get FAC1 sign (b7)
ERROR IF -
   
.,B1BD 30 0D BMI $B1CC BMI NONONO ;IF NEGATIVE, BLOW HIM OUT.
negativ: dann 'ILLEGAL QUANT'
do illegal quantity error if -ve
evaluate integer expression, no sign check

CONVERT FAC TO INTEGER

MUST BE -32767 <= FAC <= 32767
 

convert float number to integer

.,B1BF A5 61 LDA $61 AYINT: LDA FACEXP
Exponent
get FAC1 exponent
EXPONENT OF VALUE IN FAC
   
.,B1C1 C9 90 CMP #$90 CMPI 144 ;FAC .GT. 32767?
Betrag größer 32768?
compare with exponent = 2^16 (n>2^15)
ABS(VALUE) < 32768?
   
.,B1C3 90 09 BCC $B1CE BCC QINTGO
nein: $B1CE
if n<2^16 go convert FAC1 floating to fixed and return
YES, OK FOR INTEGER
   
.,B1C5 A9 A5 LDA #$A5 LDWDI N32768 ;GET ADDR OF -32768.
Zeiger auf
set pointer low byte to -32768
NO; NEXT FEW LINES ARE SUPPOSED TO
  low B1A5
.,B1C7 A0 B1 LDY #$B1   Konstante -32768 setzen
set pointer high byte to -32768
ALLOW -32768 ($8000)
  high B1A5
.,B1C9 20 5B BC JSR $BC5B JSR FCOMP ;SEE IF FAC=[[Y,A]].
Vergleich FAC mit Konstante
compare FAC1 with (AY)
     
.,B1CC D0 7A BNE $B248 NONONO: BNE FCERR ;NO, FAC IS TOO BIG.
ungleich: 'ILLEGAL QUANT'
if <> do illegal quantity error then warm start
ILLEGAL QUANTITY
   
.,B1CE 4C 9B BC JMP $BC9B QINTGO: JMP QINT ;GO TO QINT AND SHOVE IT.
;
; FORMAT OF ARRAYS IN CORE.
;
; DESCRIPTOR:
; LOWBYTE = FIRST CHARACTER.
; HIGHBYTE = SECOND CHARACTER (200 BIT IS STRING FLAG).
; LENGTH OF ARRAY IN CORE IN BYTES (INCLUDES EVERYTHING).
; NUMBER OF DIMENSIONS.
; FOR EACH DIMENSION STARTING WITH THE FIRST A LIST
; (2 BYTES EACH) OF THE MAX INDICE+1
; THE VALUES
;
wandelt Fließkomma in Integer

dimensionierte Variable holen

convert FAC1 floating to fixed and return

find or make array

an array is stored as follows
array name two bytes with the following patterns for different types
1st char 2nd char
b7 b7 type element size
-------- -------- ----- ------------
0 0 floating point 5
0 1 string 3
1 1 integer 2
offset to next array word
dimension count byte
1st dimension size word, this is the number of elements including 0
2nd dimension size word, only here if the array has a second dimension
2nd dimension size word, only here if the array has a third dimension
note: the dimension size word is in high byte low byte
format, not like most 6502 words
then for each element the required number of bytes given as the element size above
CONVERT TO INTEGER

LOCATE ARRAY ELEMENT OR CREATE AN ARRAY

PARSE THE SUBSCRIPT LIST

 

get pointer to dimensioned variable

.,B1D1 A5 0C LDA $0C ISARY: LDA DIMFLG
IFN INTPRC,<
DIM Flag
get DIM flag
YES
   
.,B1D3 05 0E ORA $0E ORA INTFLG>
Integer Flag
OR with data type flag
SET HIGH BIT IF %
   
.,B1D5 48 PHA PHA ;SAVE [DIMFLG] FOR RECURSION.
auf Stapel retten
push it
SAVE VALTYP AND DIMFLG ON STACK
   
.,B1D6 A5 0D LDA $0D LDA VALTYP
String Flag
get data type flag, $FF = string, $00 = numeric
     
.,B1D8 48 PHA PHA ;SAVE [VALTYP] FOR RECURSION.
auf Stapel retten
push it
     
.,B1D9 A0 00 LDY #$00 LDYI 0 ;SET NUMBER OF DIMENSIONS TO ZERO.
Anzahl der Indizes
clear dimensions count
now get the array dimension(s) and stack it (them) before the data type and DIM flag
COUNT # DIMENSIONS IN Y-REG
   
.,B1DB 98 TYA INDLOP: TYA ;SAVE NUMBER OF DIMS.
in Akku und
copy dimensions count
SAVE #DIMS ON STACK
   
.,B1DC 48 PHA PHA
auf Stapel retten
save it
     
.,B1DD A5 46 LDA $46 PSHWD VARNAM ;SAVE LOOKS.
2. Buchstabe des Variablenn.
get array name 2nd byte
SAVE VARIABLE NAME ON STACK
   
.,B1DF 48 PHA   und retten
save it
     
.,B1E0 A5 45 LDA $45   1. Buchstabe der Variablenn.
get array name 1st byte
     
.,B1E2 48 PHA   retten
save it
     
.,B1E3 20 B2 B1 JSR $B1B2 JSR INTIDX ;EVALUATE INDICE INTO FACMO&LO.
Index holen und nach Integer
evaluate integer expression
EVALUATE SUBSCRIPT AS INTEGER
   
.,B1E6 68 PLA PULWD VARNAM ;GET BACK ALL... WE'RE HOME.
die zwei
pull array name 1st byte
RESTORE VARIABLE NAME
   
.,B1E7 85 45 STA $45   Bytes des
restore array name 1st byte
     
.,B1E9 68 PLA   Variablennamens zurückholen
pull array name 2nd byte
     
.,B1EA 85 46 STA $46   und wieder abspeichern
restore array name 2nd byte
     
.,B1EC 68 PLA PLA ;(# OF DIMS).
Anzahl der Indizes
pull dimensions count
RESTORE # DIMS TO Y-REG
   
.,B1ED A8 TAY TAY
holen und ins Y-Reg.
restore it
     
.,B1EE BA TSX TSX
Stapelzeiger als Zeiger setzen
copy stack pointer
COPY VALTYP AND DIMFLG ON STACK
   
.,B1EF BD 02 01 LDA $0102,X LDA 258,X
Variablenflags
get DIM flag
TO LEAVE ROOM FOR THE SUBSCRIPT
   
.,B1F2 48 PHA PHA ;PUSH DIMFLG AND VALTYP FURTHER.
aus dem Stapel kopieren
push it
     
.,B1F3 BD 01 01 LDA $0101,X LDA 257,X
und oben auf den
get data type flag
     
.,B1F6 48 PHA PHA
Stapel legen
push it
     
.,B1F7 A5 64 LDA $64 LDA INDICE ;PUT INDICE ONTO STACK.
anstelle der
get this dimension size high byte
GET SUBSCRIPT VALUE AND PLACE IN THE
   
.,B1F9 9D 02 01 STA $0102,X STA 258,X, ;UNDER DIMFLG AND VALTYP.
Variablenflags
stack before flag bytes
STACK WHERE VALTYP &amp; DIMFLG WERE
   
.,B1FC A5 65 LDA $65 LDA INDICE+1
Index LOW und HIGH in
get this dimension size low byte
     
.,B1FE 9D 01 01 STA $0101,X STA 257,X
den Stapel kopieren
stack before flag bytes
     
.,B201 C8 INY INY ;INCREMENT # OF DIMS.
Anzahl der Indizes erhöhen
increment dimensions count
COUNT THE SUBSCRIPT
   
.,B202 20 79 00 JSR $0079 JSR CHRGOT ;GET TERMINATING CHARACTER.
CHRGOT letztes Zeichen holen
scan memory
NEXT CHAR
   
.,B205 C9 2C CMP #$2C CMPI 44 ;A COMMA?
',' Komma?
compare with ","
    comma
.,B207 F0 D2 BEQ $B1DB BEQ INDLOP ;YES.
ja: dann nächsten Index
if found go do next dimension
COMMA, PARSE ANOTHER SUBSCRIPT
   
.,B209 84 0B STY $0B STY COUNT ;SAVE COUNT OF DIMS.
Anzahl der Indizes speichern
store dimensions count
NO MORE SUBSCRIPTS, SAVE #
   
.,B20B 20 F7 AE JSR $AEF7 JSR CHKCLS ;MUST BE CLOSED PAREN.
prüft auf Klammer zu
scan for ")", else do syntax error then warm start
NOW NEED ")"
   
.,B20E 68 PLA PLA
Flags vom
pull data type flag
RESTORE VALTYPE AND DIMFLG
   
.,B20F 85 0D STA $0D STA VALTYP ;GET VALTYP AND
Stapel
restore data type flag, $FF = string, $00 = numeric
     
.,B211 68 PLA PLA
IFN INTPRC,<
zurückholen
pull data type flag
     
.,B212 85 0E STA $0E STA INTFLG
und abspeichern
restore data type flag, $80 = integer, $00 = float
     
.,B214 29 7F AND #$7F ANDI 127>
Integerflag herstellen
mask dim flag
ISOLATE DIMFLG
   
.,B216 85 0C STA $0C STA DIMFLG ;DIMFLG OFF STACK.
und abspeichern
restore DIM flag

SEARCH ARRAY TABLE FOR THIS ARRAY NAME

   
.,B218 A6 2F LDX $2F LDX ARYTAB ;PLACE TO START SEARCH.
LOW- und HIGH-Byte des
set end of variables low byte
(array memory start low byte)
(A,X) = START OF ARRAY TABLE
   
.,B21A A5 30 LDA $30 LDA ARYTAB+1
Zeigers auf Arraytabelle
set end of variables high byte
(array memory start high byte)
now check to see if we are at the end of array memory, we would be if there were
no arrays.
     
.,B21C 86 5F STX $5F LOPFDA: STX LOWTR
holen und
save as array start pointer low byte
USE LOWTR FOR RUNNING POINTER
   
.,B21E 85 60 STA $60 STA LOWTR+1
Zeiger merken
save as array start pointer high byte
     
.,B220 C5 32 CMP $32 CMP STREND+1 ;END OF ARRAYS?
Ende erreicht?
compare with end of arrays high byte
DID WE REACH THE END OF ARRAYS YET?
   
.,B222 D0 04 BNE $B228 BNE LOPFDV
nein: weiter
branch if not reached array memory end
NO, KEEP SEARCHING
   
.,B224 E4 31 CPX $31 CPX STREND
mit Tabellenende vergleichen
else compare with end of arrays low byte
     
.,B226 F0 39 BEQ $B261 BEQ NOTFDD ;A FINE THING! NO ARRAY!.
ja: nicht gefunden, anlegen
go build array if not found
search for array
YES, THIS IS A NEW ARRAY NAME
   
.,B228 A0 00 LDY #$00 LOPFDV: LDYI 0
Zeiger setzen
clear index
POINT AT 1ST CHAR OF ARRAY NAME
   
.,B22A B1 5F LDA ($5F),Y LDADY LOWTR
Namen aus Tabelle holen
get array name first byte
GET 1ST CHAR OF NAME
   
.,B22C C8 INY INY
Zeiger erhöhen
increment index to second name byte
POINT AT 2ND CHAR
   
.,B22D C5 45 CMP $45 CMP VARNAM ;COMPARE HIGH ORDERS.
mit ges. Namen vergleichen
compare with this array name first byte
1ST CHAR SAME?
   
.,B22F D0 06 BNE $B237 BNE NMARY1 ;NO WAY IS IT THIS. GET OUT OF HERE.
ungleich: $B237
branch if no match
NO, MOVE TO NEXT ARRAY
   
.,B231 A5 46 LDA $46 LDA VARNAM+1
Vergleich mit
else get this array name second byte
YES, TRY 2ND CHAR
   
.,B233 D1 5F CMP ($5F),Y CMPDY LOWTR ;LOW ORDERS?
zweitem Buchstaben
compare with array name second byte
SAME?
   
.,B235 F0 16 BEQ $B24D BEQ GOTARY ;WELL, HERE IT IS !!
gefunden: $B24D
array found so branch
no match
YES, ARRAY FOUND
   
.,B237 C8 INY NMARY1: INY
Zeiger erhöhen
increment index
POINT AT OFFSET TO NEXT ARRAY
   
.,B238 B1 5F LDA ($5F),Y LDADY LOWTR ;GET LENGTH.
Suchzeiger zur
get array size low byte
ADD OFFSET TO RUNNING POINTER
   
.,B23A 18 CLC CLC
Feldlänge
clear carry for add
     
.,B23B 65 5F ADC $5F ADC LOWTR
Addieren
add array start pointer low byte
     
.,B23D AA TAX TAX
ergibt Zeiger auf
copy low byte to X
     
.,B23E C8 INY INY
nächstes Array
increment index
     
.,B23F B1 5F LDA ($5F),Y LDADY LOWTR
gleiches System
get array size high byte
     
.,B241 65 60 ADC $60 ADC LOWTR+1
mit zweitem Byte
add array memory pointer high byte
     
.,B243 90 D7 BCC $B21C BCC LOPFDA ;ALWAYS BRANCHES.
und weiter suchen
if no overflow go check next array

do bad subscript error

...ALWAYS

ERROR: BAD SUBSCRIPTS

   
.,B245 A2 12 LDX #$12 BSERR: LDXI ERRBS ;GET BAD SUB ERROR NUMBER.
Nummer für 'bad subscript'
error $12, bad subscript error
    error number
.:B247 2C .BYTE $2C SKIP2
  makes next line BIT $0EA2

do illegal quantity error

TRICK TO SKIP NEXT LINE

ERROR: ILLEGAL QUANTITY

   
.,B248 A2 0E LDX #$0E FCERR: LDXI ERRFC ;TOO BIG. "FUNCTION CALL" ERROR.
Nummer für 'illegal quanti.'
error $0E, illegal quantity error
    error number
.,B24A 4C 37 A4 JMP $A437 ERRGO3: JMP ERROR
Fehlermeldung ausgeben
do error #X then warm start

found the array

FOUND THE ARRAY

   
.,B24D A2 13 LDX #$13 GOTARY: LDXI ERRDD ;PERHAPS A "RE-DIMENSION" ERROR
Nummer für 'redim'd array'
set error $13, double dimension error
SET UP FOR REDIM'D ARRAY ERROR
  error number
.,B24F A5 0C LDA $0C LDA DIMFLG ;TEST THE DIMFLG
DIM-Flag null?
get DIM flag
CALLED FROM "DIM" STATEMENT?
   
.,B251 D0 F7 BNE $B24A BNE ERRGO3
nein: dann Fehlermeldung
if we are trying to dimension it do error #X then warm
start
found the array and we're not dimensioning it so we must find an element in it
YES, ERROR
   
.,B253 20 94 B1 JSR $B194 JSR FMAPTR
Zeiger auf 1.Arrayelement
set-up array pointer to first element in array
SET (ARYPNT) = ADDR OF FIRST ELEMENT
   
.,B256 A5 0B LDA $0B LDA COUNT ;GET NUMBER OF DIMS INPUT.
Zahl der gefundenen Dimensio.
get dimensions count
COMPARE NUMBER OF DIMENSIONS
   
.,B258 A0 04 LDY #$04 LDYI 4
Zeiger setzen
set index to array's # of dimensions
     
.,B25A D1 5F CMP ($5F),Y CMPDY LOWTR ;# OF DIMS THE SAME?
mit Dimensionen des Arrays
vergleichen
compare with no of dimensions
     
.,B25C D0 E7 BNE $B245 BNE BSERR ;SAME SO GO GET DEFINITION.
ungleich: 'bad subscript'
if wrong do bad subscript error
NOT SAME, SUBSCRIPT ERROR
   
.,B25E 4C EA B2 JMP $B2EA JMP GETDEF
;
; HERE WHEN VARIABLE IS NOT FOUND IN THE ARRAY TABLE.
;
; BUILDING AN ENTRY.
;
; PUT DOWN THE DESCRIPTOR.
; SETUP NUMBER OF DIMENSIONS.
; MAKE SURE THERE IS ROOM FOR THE NEW ENTRY.
; REMEMBER "VARPNT".
; TALLY=4.
; SKIP 2 LOCS FOR LATER FILL IN OF SIZE.
; LOOP: GET AN INDICE
; PUT DOWN NUMBER+1 AND INCREMENT VARPTR.
; TALLY=TALLY*NUMBER+1.
; DECREMENT NUMBER-DIMS.
; BNE LOOP
; CALL "REASON" WITH [Y,A] REFLECTING LAST LOC OF VARIABLE.
; UPDATE STREND.
; ZERO ALL.
; MAKE TALLY INCLUDE MAXDIMS AND DESCRIPTOR.
; PUT DOWN TALLY.
; IF CALLED BY DIMENSION, RETURN.
; OTHERWISE INDEX INTO THE VARIABLE AS IF IT
; WERE FOUND ON THE INITIAL SEARCH.
;
sucht gewünschtes Element

Arrayvariable anlegen

found array so go get element
array not found, so build it

CREATE A NEW ARRAY, UNLESS CALLED FROM GETARYPT

 

allocate array

.,B261 20 94 B1 JSR $B194 NOTFDD: JSR FMAPTR ;FORM ARYPNT.
Länge des Arraykopfs
set-up array pointer to first element in array
PUT ADDR OF 1ST ELEMENT IN ARYPNT
   
.,B264 20 08 A4 JSR $A408 JSR REASON
prüft auf genügend Platz
check available memory, do out of memory error if no room
MAKE SURE ENOUGH MEMORY LEFT
   
.,B267 A0 00 LDY #$00 LDAI 0
TAY
Zeiger für Polynom-
clear Y
POINT Y-REG AT VARIABLE NAME SLOT
   
.,B269 84 72 STY $72 STA CURTOL+1
IFE ADDPRC,<
LDXI 4>
IFN ADDPRC,<
auswertung neu setzen
clear array data size high byte
START SIZE COMPUTATION
   
.,B26B A2 05 LDX #$05 LDXI 5>
Wert für Variablenlänge(REAL)
set default element size
ASSUME 5-BYTES PER ELEMENT
   
.,B26D A5 45 LDA $45 LDA VARNAM ;THIS CODE ONLY WORKS FOR INTPRC=1
erster Buchstabe des Namens
get variable name 1st byte
STUFF VARIABLE NAME IN ARRAY
   
.,B26F 91 5F STA ($5F),Y STADY LOWTR ;IF ADDPRC=1.
IFN ADDPRC,<
in Arraytabelle
save array name 1st byte
     
.,B271 10 01 BPL $B274 BPL NOTFLT
kein Integer?
branch if not string or floating point array
NOT INTEGER ARRAY
   
.,B273 CA DEX DEX>
bei Integerzahl
decrement element size, $04
INTEGER ARRAY, DECR. SIZE TO 4-BYTES
   
.,B274 C8 INY NOTFLT: INY
Bytes vermindern
increment index
POINT Y-REG AT NEXT CHAR OF NAME
   
.,B275 A5 46 LDA $46 LDA VARNAM+1
zweiter Buchstabe
get variable name 2nd byte
REST OF ARRAY NAME
   
.,B277 91 5F STA ($5F),Y STADY LOWTR
in Tabelle schreiben
save array name 2nd byte
     
.,B279 10 02 BPL $B27D BPL STOMLT
kein String oder Integer?
branch if not integer or string
REAL ARRAY, STICK WITH SIZE = 5 BYTES
   
.,B27B CA DEX DEX
IFN ADDPRC,<
entgültige
decrement element size, $03
INTEGER OR STRING ARRAY, ADJUST SIZE
   
.,B27C CA DEX DEX>
Variablenlänge herstellen
decrement element size, $02
TO INTEGER=3, STRING=2 BYTES
   
.,B27D 86 71 STX $71 STOMLT: STX CURTOL
und speichern (2, 3 oder 5)
save element size
STORE LOW-BYTE OF ARRAY ELEMENT SIZE
   
.,B27F A5 0B LDA $0B LDA COUNT
Anzahl der Dimensionen holen
get dimensions count
STORE NUMBER OF DIMENSIONS
   
.,B281 C8 INY REPEAT 3,<INY>
Zeiger
increment index ..
IN 5TH BYTE OF ARRAY
   
.,B282 C8 INY   um 3
.. to array ..
     
.,B283 C8 INY   erhöhen
.. dimension count
     
.,B284 91 5F STA ($5F),Y STADY LOWTR ;SAVE NUMBER OF DIMENSIONS.
im Arrayheader speichern
save array dimension count
     
.,B286 A2 0B LDX #$0B LOPPTA: LDXI 11 ;DEFAULT SIZE.
11, Defaultwert für
set default dimension size low byte
DEFAULT DIMENSION = 11 ELEMENTS
   
.,B288 A9 00 LDA #$00 LDAI 0
Dimensionierung
set default dimension size high byte
FOR HI-BYTE OF DIMENSION IF DEFAULT
   
.,B28A 24 0C BIT $0C BIT DIMFLG
Aufruf durch DIM-Befehl?
test DIM flag
DIMENSIONED ARRAY?
   
.,B28C 50 08 BVC $B296 BVC NOTDIM ;NOT IN A DIM STATEMENT.
nein: $B296
branch if default to be used
NO, USE DEFAULT VALUE
   
.,B28E 68 PLA PLA ;GET LOW ORDER OF INDICE.
Dimension vom Stapel holen
pull dimension size low byte
GET SPECIFIED DIM IN A,X
   
.,B28F 18 CLC CLC
Carry löschen (Addition)
clear carry for add
# ELEMENTS IS 1 LARGER THAN
   
.,B290 69 01 ADC #$01 ADCI 1
eins addieren
add 1, allow for zeroeth element
DIMENSION VALUE
   
.,B292 AA TAX TAX
und ins X-Reg.
copy low byte to X
     
.,B293 68 PLA PLA ;GET HIGH PART OF INDICE.
2.Wert holen
pull dimension size high byte
     
.,B294 69 00 ADC #$00 ADCI 0
Übertrag addieren
add carry to high byte
     
.,B296 C8 INY NOTDIM: INY
Zeiger erhöhen
incement index to dimension size high byte
ADD THIS DIMENSION TO ARRAY DESCRIPTOR
   
.,B297 91 5F STA ($5F),Y STADY LOWTR ;STORE HIGH PART OF INDICE.
und speichern
save dimension size high byte
     
.,B299 C8 INY INY
Zeiger erhöhen
incement index to dimension size low byte
     
.,B29A 8A TXA TXA
1.Wert wieder in den Akku
copy dimension size low byte
     
.,B29B 91 5F STA ($5F),Y STADY LOWTR ;STORE LOW ORDER OF INDICE.
und ebenfalls speichern
save dimension size low byte
     
.,B29D 20 4C B3 JSR $B34C JSR UMULT ;[X,A]=[CURTOL]*[LOWTR,Y]
Platz für Dimensionen berech.
compute array size
MULTIPLY THIS
DIMENSION BY RUNNING SIZE
((LOWTR)) * (STRNG2) --> A,X
   
.,B2A0 86 71 STX $71 STX CURTOL ;SAVE NEW TALLY.
LOW- und HIGH-Byte des
save result low byte
STORE RUNNING SIZE IN STRNG2
   
.,B2A2 85 72 STA $72 STA CURTOL+1
Variablenende-Zeigers merken
save result high byte
     
.,B2A4 A4 22 LDY $22 LDY INDEX
Zeiger auf Arrayheader
restore index
RETRIEVE Y SAVED BY MULTIPLY.SUBSCRIPT
   
.,B2A6 C6 0B DEC $0B DEC COUNT ;ANY MORE INDICES LEFT?
weitere Dimensionen?
decrement dimensions count
COUNT DOWN # DIMS
   
.,B2A8 D0 DC BNE $B286 BNE LOPPTA ;YES.
ja: $B286 (Schleifenbeginn)
loop if not all done
LOOP TILL DONE
NOW A,X HAS TOTAL # BYTES OF ARRAY ELEMENTS
   
.,B2AA 65 59 ADC $59 ADC ARYPNT+1
Feldlänge plus Startadresse
add array data pointer high byte
COMPUTE ADDRESS OF END OF THIS ARRAY
   
.,B2AC B0 5D BCS $B30B BCS OMERR1 ;OVERFLOW.
Überlauf: 'OUT OF MEMORY'
if overflow do out of memory error then warm start
...TOO LARGE, ERROR
   
.,B2AE 85 59 STA $59 STA ARYPNT+1 ;COMPUTE WHERE TO ZERO.
Wert wieder speichern
save array data pointer high byte
     
.,B2B0 A8 TAY TAY
und ins Y-Reg. bringen
copy array data pointer high byte
     
.,B2B1 8A TXA TXA
Variablenendzeiger in Akku
copy array size low byte
     
.,B2B2 65 58 ADC $58 ADC ARYPNT
2.Zeichen addieren
add array data pointer low byte
     
.,B2B4 90 03 BCC $B2B9 BCC GREASE
Überlauf: Platz prüfen
branch if no rollover
     
.,B2B6 C8 INY INY
Endadresse erhöhen
else increment next array pointer high byte
     
.,B2B7 F0 52 BEQ $B30B BEQ OMERR1
Überlauf: 'OUT OF MEMORY'
if rolled over do out of memory error then warm start
...TOO LARGE, ERROR
   
.,B2B9 20 08 A4 JSR $A408 GREASE: JSR REASON ;GET ROOM.
prüft auf Speicherplatz
check available memory, do out of memory error if no room
MAKE SURE THERE IS ROOM UP TO Y,A
   
.,B2BC 85 31 STA $31 STWD STREND ;NEW END OF STORAGE.
Zeiger auf Ende
set end of arrays low byte
THERE IS ROOM SO SAVE NEW END OF TABLE
   
.,B2BE 84 32 STY $32   der Arraytabelle setzen
set end of arrays high byte
now the aray is created we need to zero all the elements in it
AND ZERO THE ARRAY
   
.,B2C0 A9 00 LDA #$00 LDAI 0 ;STORING [ACCA] IS FASTER THAN CLEAR.
Array mit Nullen füllen
clear A for array clear
     
.,B2C2 E6 72 INC $72 INC CURTOL+1
Schleifenzähler high um 1 erhöhen
increment array size high byte, now block count
PREPARE FOR FAST ZEROING LOOP
   
.,B2C4 A4 71 LDY $71 LDY CURTOL
Schleifenzähler low
get array size low byte, now index to block
# BYTES MOD 256
   
.,B2C6 F0 05 BEQ $B2CD BEQ DECCUR
wenn null: $B2CD
branch if $00
FULL PAGE
   
.,B2C8 88 DEY ZERITA: DEY
Zeiger vermindern
decrement index, do 0 to n-1
CLEAR PAGE FULL
   
.,B2C9 91 58 STA ($58),Y STADY ARYPNT
Nullwert setzen
clear array element byte
     
.,B2CB D0 FB BNE $B2C8 BNE ZERITA ;NO. CONTINUE.
solang Y <>0: $B2C8
loop until this block done
     
.,B2CD C6 59 DEC $59 DECCUR: DEC ARYPNT+1
High-Byte STA-Ziel verringern
decrement array pointer high byte
POINT TO NEXT PAGE
   
.,B2CF C6 72 DEC $72 DEC CURTOL+1
Schleifenzähler high verringern
decrement block count high byte
COUNT THE PAGES
   
.,B2D1 D0 F5 BNE $B2C8 BNE ZERITA ;DO ANOTHER BLOCK.
solang <>0: $B2C8
loop until all blocks done
STILL MORE TO CLEAR
   
.,B2D3 E6 59 INC $59 INC ARYPNT+1 ;BUMP BACK UP. WILL USE LATER.
High-Byte STA-Ziel erhöhen
correct for last loop
RECOVER LAST DEC, POINT AT 1ST ELEMENT
   
.,B2D5 38 SEC SEC
Carry setzen (Subtr.)
set carry for subtract
     
.,B2D6 A5 31 LDA $31 LDA STREND ;RESTORE [ACCA].
Zeiger auf Feldende
get end of arrays low byte
COMPUTE OFFSET TO END OF ARRAYS
   
.,B2D8 E5 5F SBC $5F SBC LOWTR ;DETERMINE LENGTH.
- Zeiger auf Arrayheader
subtract array start low byte
AND STORE IN ARRAY DESCRIPTOR
   
.,B2DA A0 02 LDY #$02 LDYI 2
Zeiger setzen
index to array size low byte
     
.,B2DC 91 5F STA ($5F),Y STADY LOWTR ;LOW.
Arraylänge LOW
save array size low byte
     
.,B2DE A5 32 LDA $32 LDA STREND+1
Zeiger auf Feldende
get end of arrays high byte
     
.,B2E0 C8 INY INY
Zeiger erhöhen
index to array size high byte
     
.,B2E1 E5 60 SBC $60 SBC LOWTR+1
- Zeiger auf Arrayheader
subtract array start high byte
     
.,B2E3 91 5F STA ($5F),Y STADY LOWTR ;HIGH.
Arraylänge HIGH
save array size high byte
     
.,B2E5 A5 0C LDA $0C LDA DIMFLG
Aufruf vom DIM-Befehl?
get default DIM flag
WAS THIS CALLED FROM "DIM" STATEMENT?
   
.,B2E7 D0 62 BNE $B34B BNE DIMRTS ;BYE.
ja: RTS

Arrayelement suchen

exit if this was a DIM command
else, find element
YES, WE ARE FINISHED
   
.,B2E9 C8 INY INY
;
; AT THIS POINT [LOWTR,Y] POINTS BEYOND THE SIZE TO THE NUMBER OF
; DIMENSIONS. STRATEGY:
; NUMDIM=NUMBER OF DIMENSIONS.
; CURTOL=0.
; INLPNM:GET A NEW INDICE.
; MAKE SURE INDICE IS NOT TOO BIG.
; MULTIPLY CURTOL BY CURMAX.
; ADD INDICE TO CURTOL.
; NUMDIM=NUMDIM-1.
; BNE INLPNM.
; USE [CURTOL]*4 AS OFFSET.
;
Zeiger erhöhen
set index to # of dimensions, the dimension indeces
are on the stack and will be removed as the position
of the array element is calculated
NO, NOW NEED TO FIND THE ELEMENT

FIND SPECIFIED ARRAY ELEMENT

(LOWTR),Y POINTS AT # OF DIMS IN ARRAY DESCRIPTOR
THE SUBSCRIPTS ARE ALL ON THE STACK AS INTEGERS
 

compute reference to array element

.,B2EA B1 5F LDA ($5F),Y GETDEF: LDADY LOWTR
Zahl der Dimensionen
get array's dimension count
GET # OF DIMENSIONS
   
.,B2EC 85 0B STA $0B STA COUNT ;SAVE A COUNTER.
speichern
save it
     
.,B2EE A9 00 LDA #$00 LDAI 0 ;ZERO [CURTOL].
Nullwert laden und
clear byte
ZERO SUBSCRIPT ACCUMULATOR
   
.,B2F0 85 71 STA $71 STA CURTOL
Zeiger auf Polynom-
clear array data pointer low byte
     
.,B2F2 85 72 STA $72 INLPNM: STA CURTOL+1
auswertung löschen
save array data pointer high byte
     
.,B2F4 C8 INY INY
Zeiger erhöhen
increment index, point to array bound high byte
     
.,B2F5 68 PLA PLA ;GET LOW INDICE.
1. Indexwert vom Stapel
pull array index low byte
PULL NEXT SUBSCRIPT FROM STACK
   
.,B2F6 AA TAX TAX
holen und ins X-Reg. bringen
copy to X
SAVE IN FAC+3,4
   
.,B2F7 85 64 STA $64 STA INDICE
Wert speichern
save index low byte to FAC1 mantissa 3
AND COMPARE WITH DIMENSIONED SIZE
   
.,B2F9 68 PLA PLA ;AND THE HIGH PART
2. Indexwert holen
pull array index high byte
     
.,B2FA 85 65 STA $65 STA INDICE+1
und speichern
save index high byte to FAC1 mantissa 4
     
.,B2FC D1 5F CMP ($5F),Y CMPDY LOWTR ;COMPARE WITH MAX INDICE.
mit Wert im Array vergleichen
compare with array bound high byte
     
.,B2FE 90 0E BCC $B30E BCC INLPN2
kleiner?
branch if within bounds
SUBSCRIPT NOT TOO LARGE
   
.,B300 D0 06 BNE $B308 BNE BSERR7 ;IF GREATER, "BAD SUBSCRIPT" ERROR.
größer: 'bad subscript'
if outside bounds do bad subscript error
else high byte was = so test low bytes
SUBSCRIPT IS TOO LARGE
   
.,B302 C8 INY INY
Zeiger erhöhen
index to array bound low byte
CHECK LOW-BYTE OF SUBSCRIPT
   
.,B303 8A TXA TXA
1.Wert zurückholen
get array index low byte
     
.,B304 D1 5F CMP ($5F),Y CMPDY LOWTR
LOW-Byte vergleichen
compare with array bound low byte
     
.,B306 90 07 BCC $B30F BCC INLPN1
kleiner: dann weiter
branch if within bounds
NOT TOO LARGE
   
.,B308 4C 45 B2 JMP $B245 BSERR7: JMP BSERR
'bad subscript'
do bad subscript error
BAD SUBSCRIPTS ERROR
   
.,B30B 4C 35 A4 JMP $A435 OMERR1: JMP OMERR
'out of memory'

Berechnung der Adresse

eines Arrayelements

do out of memory error then warm start
MEM FULL ERROR
   
.,B30E C8 INY INLPN2: INY
Zeiger erhöhen
index to array bound low byte
BUMP POINTER INTO DESCRIPTOR
   
.,B30F A5 72 LDA $72 INLPN1: LDA CURTOL+1 ;DON'T MULTIPLY IF CURTOL=0.
Zeiger auf Polynomausw.(HIGH)
get array data pointer high byte
BYPASS MULTIPLICATION IF VALUE SO
   
.,B311 05 71 ORA $71 ORA CURTOL
Zeiger auf Polynomausw.(LOW)
OR with array data pointer low byte
FAR = 0
   
.,B313 18 CLC CLC ;PREPARE TO GET INDICE BACK.
Carry löschen
clear carry for either add, carry always clear here ??
     
.,B314 F0 0A BEQ $B320 BEQ ADDIND ;GET HIGH PART OF INDICE BACK.
Multiplikation umgehen
branch if array data pointer = null, skip multiply
IT IS ZERO SO FAR
   
.,B316 20 4C B3 JSR $B34C JSR UMULT ;MULTIPLY [CURTOL] BY [LOWTR,Y,Y+1].
Multiplikation
compute array size
NOT ZERO, SO MULTIPLY
   
.,B319 8A TXA TXA
(X/Y)=($71/72)*(($5F/60),Y)
get result low byte
ADD CURRENT SUBSCRIPT
   
.,B31A 65 64 ADC $64 ADC INDICE ;ADD IN [INDICE].
  add index low byte from FAC1 mantissa 3
     
.,B31C AA TAX TAX
Akku zurück ins X-Reg.
save result low byte
     
.,B31D 98 TYA TYA
  get result high byte
     
.,B31E A4 22 LDY $22 LDY INDEX1
Zeiger in Arrayheader
restore index
RETRIEVE Y SAVED BY MULTIPLY.SUBSCRIPT
   
.,B320 65 65 ADC $65 ADDIND: ADC INDICE+1
  add index high byte from FAC1 mantissa 4
FINISH ADDING CURRENT SUBSCRIPT
   
.,B322 86 71 STX $71 STX CURTOL
  save array data pointer low byte
STORE ACCUMULATED OFFSET
   
.,B324 C6 0B DEC $0B DEC COUNT ;ANY MORE?
Anzahl der Dimensionen
decrement dimensions count
LAST SUBSCRIPT YET?
   
.,B326 D0 CA BNE $B2F2 BNE INLPNM ;YES.
mit nächstem Index weiter
loop if dimensions still to do
NO, LOOP TILL DONE
   
.,B328 85 72 STA $72 STA CURTOL+1 ;FIX ARRAY BUG ****
IFE ADDPRC,<
LDXI 4>
IFN ADDPRC,<
  save array data pointer high byte
YES, NOW MULTIPLY BE ELEMENT SIZE
   
.,B32A A2 05 LDX #$05 LDXI 5 ;THIS CODE ONLY WORKS FOR INTPRC=1
Variablenlänge (5, REAL)
set default element size
START WITH SIZE = 5
   
.,B32C A5 45 LDA $45 LDA VARNAM ;IF ADDPRC=1.
erster Buchstabe des Namens
get variable name 1st byte
DETERMINE VARIABLE TYPE
   
.,B32E 10 01 BPL $B331 BPL NOTFL1
Integer? nein: $B331
branch if not string or floating point array
NOT INTEGER
   
.,B330 CA DEX DEX>
Länge vermindern
decrement element size, $04
INTEGER, BACK DOWN SIZE TO 4 BYTES
   
.,B331 A5 46 LDA $46 NOTFL1: LDA VARNAM+1
zweiter Buchstabe des Namens
get variable name 2nd byte
DISCRIMINATE BETWEEN REAL AND STR
   
.,B333 10 02 BPL $B337 BPL STOML1
FLP? ja: $B337
branch if not integer or string
IT IS REAL
   
.,B335 CA DEX DEX
IFN ADDPRC,<
Länge 2 mal
decrement element size, $03
SIZE = 3 IF STRING, =2 IF INTEGER
   
.,B336 CA DEX DEX>
vermindern
decrement element size, $02
     
.,B337 86 28 STX $28 STOML1: STX ADDEND
Länge der Variablen 2,3 oder5
save dimension size low byte
SET UP MULTIPLIER
   
.,B339 A9 00 LDA #$00 LDAI 0
Wert laden und damit
clear dimension size high byte
HI-BYTE OF MULTIPLIER
   
.,B33B 20 55 B3 JSR $B355 JSR UMULTD ;ON RTS, A&Y=HI . X=LO.
Offset im Array berechnen
compute array size
(STRNG2) BY ELEMENT SIZE
   
.,B33E 8A TXA TXA
zur Adresse des ersten
copy array size low byte
ADD ACCUMULATED OFFSET
   
.,B33F 65 58 ADC $58 ADC ARYPNT
Elements addieren
add array data start pointer low byte
TO ADDRESS OF 1ST ELEMENT
   
.,B341 85 47 STA $47 STA VARPNT
ergibt Variablenadresse
save as current variable pointer low byte
TO GET ADDRESS OF SPECIFIED ELEMENT
   
.,B343 98 TYA TYA
2.Byte in Akku holen
copy array size high byte
     
.,B344 65 59 ADC $59 ADC ARYPNT+1
addieren, ergibt
add array data start pointer high byte
     
.,B346 85 48 STA $48 STA VARPNT+1
HIGH-Byte der Adresse
save as current variable pointer high byte
     
.,B348 A8 TAY TAY
ins Y-Reg. bringen und
copy high byte to Y
RETURN WITH ADDR IN VARPNT
   
.,B349 A5 47 LDA $47 LDA VARPNT
1.Byte wieder in Akku holen
get current variable pointer low byte
pointer to element is now in AY
AND IN Y,A
   
.,B34B 60 RTS DIMRTS: RTS ;RETURN TO CALLER.

INTEGER ARITHMETIC ROUTINES.

;TWO BYTE UNSIGNED INTEGER MULTIPLY.
;THIS IS FOR MULTIPLY DIMENSIONED ARRAYS.
; [X,Y]=[X,A]=[CURTOL]*[LOWTR,Y,Y+1].
Rücksprung

Hilfsroutine für

Arrayberechnung

compute array size, result in XY

MULTIPLY (STRNG2) BY ((LOWTR),Y)

LEAVING PRODUCT IN A,X.

(HI-BYTE ALSO IN Y.)
USED ONLY BY ARRAY SUBSCRIPT ROUTINES
 

XY = XA = length * limit from array data

.,B34C 84 22 STY $22 UMULT: STY INDEX
Register merken
save index
SAVE Y-REG
   
.,B34E B1 5F LDA ($5F),Y LDADY LOWTR
1. Wert holen
get dimension size low byte
GET MULTIPLIER
   
.,B350 85 28 STA $28 STA ADDEND ;LOW, THEN HIGH.
und abspeichern
save dimension size low byte
SAVE IN RESULT+2,3
   
.,B352 88 DEY DEY
Zeiger vermindern
decrement index
     
.,B353 B1 5F LDA ($5F),Y LDADY LOWTR ;PUT [LOWTR,Y,Y+1] IN FASTER MEMORY.
2. Wert holen
get dimension size high byte
     
.,B355 85 29 STA $29 UMULTD: STA ADDEND+1
und abspeichern
save dimension size high byte
LOW BYTE OF MULTIPLIER
   
.,B357 A9 10 LDA #$10 LDAI 16
Wert laden und damit
count = $10 (16 bit multiply)
MULTIPLY 16 BITS
   
.,B359 85 5D STA $5D STA DECCNT
Verschiebezähler setzen
save bit count
     
.,B35B A2 00 LDX #$00 LDXI 0 ;CLR THE ACCS.
LOW- und HIGH-Byte des Er-
clear result low byte
PRODUCT = 0 INITIALLY
   
.,B35D A0 00 LDY #$00 LDYI 0 ;RESULT INITIALLY ZERO.
gebnisregisters auf 0 setzen
clear result high byte
     
.,B35F 8A TXA UMULTC: TXA
LOW-Byte in Akku holen und
get result low byte
DOUBLE PRODUCT
   
.,B360 0A ASL ASL A, ;MULTIPLY BY TWO.
um 1 Bit nach links schieben
*2
LOW BYTE
   
.,B361 AA TAX TAX
Byte zurück ins X-Reg.
save result low byte
     
.,B362 98 TYA TYA
HIGH-Byte in den Akku holen,
get result high byte
HIGH BYTE
   
.,B363 2A ROL ROL A,
um 1 Bit nach links rotieren
*2
IF TOO LARGE, SET CARRY
   
.,B364 A8 TAY TAY
und zurückbringen
save result high byte
     
.,B365 B0 A4 BCS $B30B BCS OMERR1 ;TWO MUCH !
Überlauf: 'out of memory'
if overflow go do "Out of memory" error
TOO LARGE, "MEM FULL ERROR"
   
.,B367 06 71 ASL $71 ASL CURTOL
nächstes Bit aus
shift element size low byte
NEXT BIT OF MUTLPLICAND
   
.,B369 26 72 ROL $72 ROL CURTOL+1
$71/72 herausholen
shift element size high byte
INTO CARRY
   
.,B36B 90 0B BCC $B378 BCC UMLCNT ;NOTHING IN THIS POSITION TO MULTIPLY.
=0? ja: Addition umgehen
skip add if no carry
BIT=0, DON'T NEED TO ADD
   
.,B36D 18 CLC CLC
Carry setzen (Addition)
else clear carry for add
BIT=1, ADD INTO PARTIAL PRODUCT
   
.,B36E 8A TXA TXA
LOW-Byte holen
get result low byte
     
.,B36F 65 28 ADC $28 ADC ADDEND
1. Wert addieren
add dimension size low byte
     
.,B371 AA TAX TAX
LOW-Byte zurückbringen
save result low byte
     
.,B372 98 TYA TYA
HIGH-Byte holen
get result high byte
     
.,B373 65 29 ADC $29 ADC ADDEND+1
2. Wert addieren
add dimension size high byte
     
.,B375 A8 TAY TAY
HIGH-Byte zurückholen
save result high byte
     
.,B376 B0 93 BCS $B30B BCS OMERR1 ;MAN, JUST TOO MUCH !
Überlauf: 'out of memory'
if overflow go do "Out of memory" error
TOO LARGE, "MEM FULL ERROR"
   
.,B378 C6 5D DEC $5D UMLCNT: DEC DECCNT ;DONE?
nächstes Bit holen
decrement bit count
16-BITS YET?
   
.,B37A D0 E3 BNE $B35F BNE UMULTC ;KEEP IT UP.
alle 16 Bits? nein: weiter
loop until all done
NO, KEEP SHUFFLING
   
.,B37C 60 RTS UMLRTS: RTS ;YES, ALL DONE.
PAGE

FRE FUNCTION AND INTEGER TO FLOATING ROUTINES.

Rücksprung

BASIC-Funktion FRE

perform FRE()
YES, PRODUCT IN Y,X AND A,X

"FRE" FUNCTION

COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT
 

FRE function

.,B37D A5 0D LDA $0D FRE: LDA VALTYP
Typflag
get data type flag, $FF = string, $00 = numeric
LOOK AT VALUE OF ARGUMENT
   
.,B37F F0 03 BEQ $B384 BEQ NOFREF
kein String
branch if numeric
=0 MEANS REAL, =$FF MEANS STRING
   
.,B381 20 A6 B6 JSR $B6A6 JSR FREFAC
FRESTR
pop string off descriptor stack, or from top of string
space returns with A = length, X=$71=pointer low byte,
Y=$72=pointer high byte
FRE(n) was numeric so do this
STRING, SO SET IT FREE IS TEMP
   
.,B384 20 26 B5 JSR $B526 NOFREF: JSR GARBA2
Garbage Collection
go do garbage collection
COLLECT ALL THE GARBAGE IN SIGHT
   
.,B387 38 SEC SEC
Carry setzen (Subtr.)
set carry for subtract
COMPUTE SPACE BETWEEN ARRAYS AND
   
.,B388 A5 33 LDA $33 LDA FRETOP ;WE WANT
Stringanfang (LOW)
get bottom of string space low byte
STRING TEMP AREA
   
.,B38A E5 31 SBC $31 SBC STREND ;[FRETOP]-[STREND].
- Variablenende (LOW)
subtract end of arrays low byte
     
.,B38C A8 TAY TAY
ergibt freien Speicher
copy result to Y
     
.,B38D A5 34 LDA $34 LDA FRETOP+1
Stringanfang (HIGH)
get bottom of string space high byte
     
.,B38F E5 32 SBC $32 SBC STREND+1
- Variablenende (HIGH)
subtract end of arrays high byte

convert fixed integer AY to float FAC1

FREE SPACE IN Y,A
FALL INTO GIVAYF TO FLOAT THE VALUE
NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE

FLOAT THE SIGNED INTEGER IN A,Y

 

routine to convert integer to float

.,B391 A2 00 LDX #$00 GIVAYF: LDXI 0
Wert laden und
set type = numeric
MARK FAC VALUE TYPE REAL
   
.,B393 86 0D STX $0D STX VALTYP
Flag auf numerisch setzen
clear data type flag, $FF = string, $00 = numeric
     
.,B395 85 62 STA $62 STWD FACHO
LOW- und HIGH-Byte des
save FAC1 mantissa 1
SAVE VALUE FROM A,Y IN MANTISSA
   
.,B397 84 63 STY $63   Ergebnisses merken
save FAC1 mantissa 2
     
.,B399 A2 90 LDX #$90 LDXI 144 ;SET EXPONENT TO 2^16.
und nach
set exponent=2^16 (integer)
SET EXPONENT TO 2^16
   
.,B39B 4C 44 BC JMP $BC44 JMP FLOATS ;TURN IT TO A FLOATING PNT #.
Fließkomma wandlen

BASIC-Funktion POS

set exp = X, clear FAC1 3 and 4, normalise and return

perform POS()

CONVERT TO SIGNED FP

"POS" FUNCTION

RETURNS CURRENT LINE POSITION FROM MON.CH
 

POS function

.,B39E 38 SEC POS: LDY TRMPOS ;GET POSITION.
C=1 Cursorposition holen
set Cb for read cursor position
     
.,B39F 20 F0 FF JSR $FFF0   Cursorposition holen
read/set X,Y cursor position

FLOAT (Y) INTO FAC, GIVING VALUE 0-255

   
.,B3A2 A9 00 LDA #$00 SNGFLT: LDAI 0
Z=1
clear high byte
MSB = 0
   
.,B3A4 F0 EB BEQ $B391 BEQA GIVAYF ;FLOAT IT.
PAGE

SIMPLE-USER-DEFINED-FUNCTION CODE.

;
; NOTE ONLY SINGLE ARGUMENTS ARE ALLOWED TO FUNCTIONS
; AND FUNCTIONS MUST BE OF THE SINGLE LINE FORM:
; DEF FNA(X)=X^2+X-2
; NO STRINGS CAN BE INVOLVED WITH THESE FUNCTIONS.
;
; IDEA: CREATE A SIMPLE VARIABLE ENTRY
; WHOSE FIRST CHARACTER HAS THE 200 BIT SET.
; THE VALUE WILL BE:
;
; A TEXT PNTR TO THE FORMULA.
; A PNTR TO THE ARGUMENT VARIABLE.
;
; FUNCTION NAMES CAN BE LIKE "FNA4".
;
;
; SUBROUTINE TO SEE IF WE ARE IN DIRECT MODE.
; AND COMPLAIN IF SO.
;
unbedingter Sprung

Test auf Direkt-Modus

convert fixed integer AY to float FAC1, branch always
check not Direct, used by DEF and INPUT
...ALWAYS

CHECK FOR DIRECT OR RUNNING MODE

GIVING ERROR IF DIRECT MODE

 

check for non-direct mode

.,B3A6 A6 3A LDX $3A ERRDIR: LDX CURLIN+1 ;DIR MODE HAS [CURLIN]=0,255
Flag laden (Direktm. = $FF)
get current line number high byte
=$FF IF DIRECT MODE
   
.,B3A8 E8 INX INX ;SO NOW, IS RESULT ZERO?
testen
increment it
MAKES $FF INTO ZERO
   
.,B3A9 D0 A0 BNE $B34B BNE DIMRTS ;YES.
nein: dann RTS
return if not direct mode
else do illegal direct error
RETURN IF RUNNING MODE
   
.,B3AB A2 15 LDX #$15 LDXI ERRID ;INPUT DIRECT ERROR CODE.
Nummer für 'illegal direct'
error $15, illegal direct error
DIRECT MODE, GIVE ERROR
  error number
.:B3AD 2C .BYTE $2C SKIP2
  makes next line BIT $1BA2
TRICK TO SKIP NEXT 2 BYTES
   
.,B3AE A2 1B LDX #$1B ERRGUF: LDXI ERRUF ;USER DEFINED FUNCTION NEVER DEFINED
Nummer für 'undef'd function'
error $1B, undefined function error
UNDEFINDED FUNCTION ERROR
  error number
.,B3B0 4C 37 A4 JMP $A437 ERRGO1: JMP ERROR
Fehlermeldung ausgeben

BASIC-Befehl DEF FN

do error #X then warm start

perform DEF

"DEF" STATEMENT

 

DEF command

.,B3B3 20 E1 B3 JSR $B3E1 DEF: JSR GETFNM ;GET A PNTR TO THE FUNCTION.
prüft FN-Syntax
check FNx syntax
PARSE "FN", FUNCTION NAME
   
.,B3B6 20 A6 B3 JSR $B3A6 JSR ERRDIR
testet auf Direkt-Modus
check not direct, back here if ok
ERROR IF IN DIRECT MODE
   
.,B3B9 20 FA AE JSR $AEFA JSR CHKOPN ;MUST HAVE "(".
prüft auf 'Klammer auf
scan for "(", else do syntax error then warm start
NEED "("
   
.,B3BC A9 80 LDA #$80 LDAI 128
Wert laden
set flag for FNx
FLAG PTRGET THAT CALLED FROM "DEF FN"
   
.,B3BE 85 10 STA $10 STA SUBFLG ;PROHIBIT SUBSCRIPTED VARIABLES.
sperrt INTEGER-Variable
save subscript/FNx flag
ALLOW ONLY SIMPLE FP VARIABLE FOR ARG
   
.,B3C0 20 8B B0 JSR $B08B JSR PTRGET ;GET PNTR TO ARGUMENT.
sucht Variable
get variable address
GET PNTR TO ARGUMENT
   
.,B3C3 20 8D AD JSR $AD8D JSR CHKNUM ;IS IT A NUMBER?
prüft auf numerisch
check if source is numeric, else do type mismatch
MUST BE NUMERIC
   
.,B3C6 20 F7 AE JSR $AEF7 JSR CHKCLS ;MUST HAVE ")"
prüft auf 'Klammer zu'
scan for ")", else do syntax error then warm start
MUST HAVE ")" NOW
   
.,B3C9 A9 B2 LDA #$B2 SYNCHK EQULTK ;MUST HAVE "=".
'=' BASIC-Code
get = token
NOW NEED "="
   
.,B3CB 20 FF AE JSR $AEFF   prüft auf '='
scan for CHR$(A), else do syntax error then warm start
OR ELSE SYNTAX ERROR
   
.,B3CE 48 PHA IFN ADDPRC,<PHA> ;PUT CRAZY BYTE ON.
erstes Zeichen auf Stapel
push next character
SAVE CHAR AFTER "="
   
.,B3CF A5 48 LDA $48 PSHWD VARPNT
LOW- und HIGH-Byte der
get current variable pointer high byte
SAVE PNTR TO ARGUMENT
   
.,B3D1 48 PHA   FN-Variablen-Adresse
push it
     
.,B3D2 A5 47 LDA $47   auf den Stapel
get current variable pointer low byte
     
.,B3D4 48 PHA   legen
push it
     
.,B3D5 A5 7B LDA $7B PSHWD TXTPTR
LOW- und HIGH-Byte
get BASIC execute pointer high byte
SAVE TXTPTR
   
.,B3D7 48 PHA   des Programmzeigers
push it
     
.,B3D8 A5 7A LDA $7A   auf den Stapel
get BASIC execute pointer low byte
     
.,B3DA 48 PHA   legen
push it
     
.,B3DB 20 F8 A8 JSR $A8F8 JSR DATA
Programmzeiger auf Statement
perform DATA
SCAN TO NEXT STATEMENT
   
.,B3DE 4C 4F B4 JMP $B44F JMP DEFFIN
;
; SUBROUTINE TO GET A PNTR TO A FUNCTION NAME.
;
FN-Variable vom Stapel holen

prüft FN-Syntax

put execute pointer and variable pointer into function
and return

check FNx syntax

STORE ABOVE 5 BYTES IN "VALUE"

COMMON ROUTINE FOR "DEFFN" AND "FN", TO

PARSE "FN" AND THE FUNCTION NAME

 

get function name

.,B3E1 A9 A5 LDA #$A5 GETFNM: SYNCHK FNTK ;MUST START WITH FN.
FN-Code
set FN token
MUST NOW SEE "FN" TOKEN
   
.,B3E3 20 FF AE JSR $AEFF   prüft auf FN-Code
scan for CHR$(A), else do syntax error then warm start
OR ELSE SYNTAX ERROR
   
.,B3E6 09 80 ORA #$80 ORAI 128 ;PUT FUNCTION BIT ON.
Wert laden
set FN flag bit
SET SIGN BIT ON 1ST CHAR OF NAME,
   
.,B3E8 85 10 STA $10 STA SUBFLG
sperrt INTEGER-Variable
save FN name
MAKING $C0 < SUBFLG < $DB
   
.,B3EA 20 92 B0 JSR $B092 JSR PTRGT2 ;GET POINTER TO FUNCTION OR CREATE ANEW.
sucht Variable
search for FN variable
WHICH TELLS PTRGET WHO CALLED
   
.,B3ED 85 4E STA $4E STWD DEFPNT
LOW- und HIGH-Byte
save function pointer low byte
FOUND VALID FUNCTION NAME, SO
   
.,B3EF 84 4F STY $4F   FN-Variablenzeiger setzen
save function pointer high byte
SAVE ADDRESS
   
.,B3F1 4C 8D AD JMP $AD8D JMP CHKNUM ;MAKE SURE IT'S NOT A STRING AND RETURN.
prüft auf numerisch

BASIC-Funktion FN

check if source is numeric and return, else do type
mismatch

Evaluate FNx

MUST BE NUMERIC

"FN" FUNCTION CALL

 

expand FN call

.,B3F4 20 E1 B3 JSR $B3E1 FNDOER: JSR GETFNM ;GET THE FUNCTION'S NAME.
prüft FN-Syntax
check FNx syntax
PARSE "FN", FUNCTION NAME
   
.,B3F7 A5 4F LDA $4F PSHWD DEFPNT
LOW- und HiGH-Byte des
get function pointer high byte
STACK FUNCTION ADDRESS
   
.,B3F9 48 PHA   FN-Variablenzeigers
push it
IN CASE OF A NESTED FN CALL
   
.,B3FA A5 4E LDA $4E   auf den Stapel
get function pointer low byte
     
.,B3FC 48 PHA   legen
push it
     
.,B3FD 20 F1 AE JSR $AEF1 JSR PARCHK ;EVALUATE PARAMETER.
holt Term in Klammern
evaluate expression within parentheses
MUST NOW HAVE "(EXPRESSION)"
   
.,B400 20 8D AD JSR $AD8D JSR CHKNUM
prüft auf numerisch
check if source is numeric, else do type mismatch
MUST BE NUMERIC EXPRESSION
   
.,B403 68 PLA PULWD DEFPNT
LOW- und HIGH-Byte
pop function pointer low byte
GET FUNCTION ADDRESS BACK
   
.,B404 85 4E STA $4E   des
restore it
     
.,B406 68 PLA   FN-Variablenzeigers wieder-
pop function pointer high byte
     
.,B407 85 4F STA $4F   holen und speichern
restore it
     
.,B409 A0 02 LDY #$02 LDYI 2
Zeiger setzen
index to variable pointer high byte
POINT AT ADD OF ARGUMENT VARIABLE
   
.,B40B B1 4E LDA ($4E),Y LDADY DEFPNT ;GET POINTER TO VARIABLE.
Zeiger (LOW) auf FN-Variable
get variable address low byte
     
.,B40D 85 47 STA $47 STA VARPNT ;SAVE VARIABLE POINTER.
in Variablenadresszeiger
save current variable pointer low byte
     
.,B40F AA TAX TAX
und ins X-Reg.
copy address low byte
     
.,B410 C8 INY INY
Zeiger erhöhen
index to variable address high byte
     
.,B411 B1 4E LDA ($4E),Y LDADY DEFPNT
Zeiger (HIGH) laden
get variable pointer high byte
     
.,B413 F0 99 BEQ $B3AE BEQ ERRGUF
gibt 'undef'd function'
branch if high byte zero
UNDEFINED FUNCTION
   
.,B415 85 48 STA $48 STA VARPNT+1
in Variablenadresse
save current variable pointer high byte
     
.,B417 C8 INY IFN ADDPRC,<INY> ;SINCE DEF USES ONLY 4.
Zeiger erhöhen
index to mantissa 3
now stack the function variable value before use
Y=4 NOW
   
.,B418 B1 47 LDA ($47),Y DEFSTF: LDADY VARPNT
FN-Variablenwert holen
get byte from variable
SAVE OLD VALUE OF ARGUMENT VARIABLE
   
.,B41A 48 PHA PHA ;PUSH IT ALL ON STACK.
und auf Stapel retten
stack it
ON STACK, IN CASE ALSO USED AS
   
.,B41B 88 DEY DEY ;SINCE WE ARE RECURSING MAYBE.
Zeiger vermindern
decrement index
A NORMAL VARIABLE!
   
.,B41C 10 FA BPL $B418 BPL DEFSTF
fertig? nein: nächster Wert
loop until variable stacked
     
.,B41E A4 48 LDY $48 LDY VARPNT+1
  get current variable pointer high byte
(Y,X)= ADDRESS, STORE FAC IN VARIABLE
   
.,B420 20 D4 BB JSR $BBD4 JSR MOVMF ;PUT CURRENT FAC INTO OUR ARG VARIABLE.
FAC in FN-Variable übertragen
pack FAC1 into (XY)
     
.,B423 A5 7B LDA $7B PSHWD TXTPTR ;SAVE TEXT POINTER.
Programmzeiger (LOW)
get BASIC execute pointer high byte
REMEMBER TXTPTR AFTER FN CALL
   
.,B425 48 PHA   auf Stapel
push it
     
.,B426 A5 7A LDA $7A   Programmzeiger (HIGH)
get BASIC execute pointer low byte
     
.,B428 48 PHA   auf Stapel
push it
     
.,B429 B1 4E LDA ($4E),Y LDADY DEFPNT ;PNTR TO FUNCTION.
LOW und HIGH-Byte
get function execute pointer low byte
Y=0 FROM MOVMF
   
.,B42B 85 7A STA $7A STA TXTPTR
des
save BASIC execute pointer low byte
POINT TO FUNCTION DEF'N
   
.,B42D C8 INY INY
Programmzeigers auf
index to high byte
     
.,B42E B1 4E LDA ($4E),Y LDADY DEFPNT
FN-Ausdruck
get function execute pointer high byte
     
.,B430 85 7B STA $7B STA TXTPTR+1
speichern
save BASIC execute pointer high byte
     
.,B432 A5 48 LDA $48 PSHWD VARPNT ;SAVE VARIABLE POINTER.
Zeiger auf FN-Variable
get current variable pointer high byte
SAVE ADDRESS OF ARGUMENT VARIABLE
   
.,B434 48 PHA   holen und
push it
     
.,B435 A5 47 LDA $47   auf den Stapel
get current variable pointer low byte
     
.,B437 48 PHA   retten
push it
     
.,B438 20 8A AD JSR $AD8A JSR FRMNUM ;EVALUATE FORMULA AND CHECK NUMERIC.
numerischen Ausdruck holen
evaluate expression and check is numeric, else do
type mismatch
EVALUATE THE FUNCTION EXPRESSION
   
.,B43B 68 PLA PULWD DEFPNT
LOW- und HIGH-Byte
pull variable address low byte
GET ADDRESS OF ARGUMENT VARIABLE
   
.,B43C 85 4E STA $4E   des Zeigers auf FN-
save variable address low byte
AND SAVE IT
   
.,B43E 68 PLA   Variable vom Stapel holen
pull variable address high byte
     
.,B43F 85 4F STA $4F   und in FN-Zeiger speichern
save variable address high byte
     
.,B441 20 79 00 JSR $0079 JSR CHRGOT
CHRGOT letztes Zeichen holen
scan memory
MUST BE AT ":" OR EOL
   
.,B444 F0 03 BEQ $B449 JNE SNERR ;IT DIDN'T TERMINATE. HUH?
keine weiteren Zeichen?
branch if null (should be [EOL] marker)
WE ARE
   
.,B446 4C 08 AF JMP $AF08   gibt 'SYNTAX ERROR'
else syntax error then warm start

restore BASIC execute pointer and function variable from stack

WE ARE NOT, SLYNTAX ERROR
   
.,B449 68 PLA PULWD TXTPTR ;RESTORE TEXT PNTR.
LOW- und HIGH-Byte
pull BASIC execute pointer low byte
RETRIEVE TXTPTR AFTER "FN" CALL
   
.,B44A 85 7A STA $7A   des
save BASIC execute pointer low byte
     
.,B44C 68 PLA   Programmzeigers
pull BASIC execute pointer high byte
     
.,B44D 85 7B STA $7B   zurückholen
save BASIC execute pointer high byte
put execute pointer and variable pointer into function
STACK NOW HAS 5-BYTE VALUE
OF THE ARGUMENT VARIABLE,
AND FNCNAM POINTS AT THE VARIABLE

STORE FIVE BYTES FROM STACK AT (FNCNAM)

   
.,B44F A0 00 LDY #$00 DEFFIN: LDYI 0
Zeiger setzen
clear index
     
.,B451 68 PLA PLA ;GET OLD ARG VALUE OFF STACK
FN-Variable vom Stapel
pull BASIC execute pointer low byte
     
.,B452 91 4E STA ($4E),Y STADY DEFPNT ;AND PUT IT BACK IN VARIABLE.
zurückholen
save to function