Ultimate Commodore 64 Reference

6502 KERNAL API ROM Disassembly Memory Map Charset · PETSCII · Keyboard pagetable.com

C64 BASIC & KERNAL ROM Disassembly

by Michael Steil, github.com/mist64/c64ref. Revision 6ce14d7, 2022-01-23

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.
Variablenadresse
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
     
.,B454 68 PLA PLA
und abspeichern
pull BASIC execute pointer high byte
     
.,B455 C8 INY INY
Zeiger erhöhen
increment index
     
.,B456 91 4E STA ($4E),Y STADY DEFPNT
2. Wert abspeichern
save to function
     
.,B458 68 PLA PLA
3. Wert vom Stapel holen
pull current variable address low byte
     
.,B459 C8 INY INY
Zeiger erhöhen
increment index
     
.,B45A 91 4E STA ($4E),Y STADY DEFPNT
und abspeichern
save to function
     
.,B45C 68 PLA PLA
4. Wert vom Stapel holen
pull current variable address high byte
     
.,B45D C8 INY INY
Zeiger erhöhen
increment index
     
.,B45E 91 4E STA ($4E),Y STADY DEFPNT
IFN ADDPRC,<
und abspeichern
save to function
     
.,B460 68 PLA PLA
5. Wert vom Stapel holen
pull ??
     
.,B461 C8 INY INY
Zeiger erhöhen
increment index
     
.,B462 91 4E STA ($4E),Y STADY DEFPNT>
und abspeichern
save to function
     
.,B464 60 RTS DEFRTS: RTS
PAGE

STRING FUNCTIONS.

;
; THE STR$ FUNCTION TAKES A NUMBER AND GIVES A STRING
; WITH THE CHARACTERS THE OUTPUT OF THE NUMBER
; WOULD HAVE GIVEN.
;
Rücksprung

BASIC-Funktion STR$

perform STR$()

"STR$" FUNCTION

 

STR$ function

.,B465 20 8D AD JSR $AD8D STR: JSR CHKNUM ;ARG HAS TO BE NUMERIC.
prüft auf numerisch
check if source is numeric, else do type mismatch
EXPRESSION MUST BE NUMERIC
   
.,B468 A0 00 LDY #$00 LDYI 0
Wert laden und
set string index
START STRING AT STACK-1 ($00FF)
SO STRLIT CAN DIFFRENTIATE STR$ CALLS
   
.,B46A 20 DF BD JSR $BDDF JSR FOUTC ;DO ITS OUTPUT.
FAC nach ASCII umwandeln
convert FAC1 to string
CONVERT FAC TO STRING
   
.,B46D 68 PLA PLA
Rücksprungadresse vom
dump return address (skip type check)
POP RETURN OFF STACK
   
.,B46E 68 PLA PLA
Stapel entfernen
dump return address (skip type check)
     
.,B46F A9 FF LDA #$FF TIMSTR: LDWDI LOFBUF
LOW-Byte
set result string low pointer
POINT TO STACK-1
   
.,B471 A0 00 LDY #$00   Startadresse des Strings=$FF
set result string high pointer
(WHICH=0)
   
.,B473 F0 12 BEQ $B487 BEQA STRLIT ;SCAN IT AND TURN IT INTO A STRING.
;
; "STRINI" GET STRING SPACE FOR THE CREATION OF A STRING AND
; CREATES A DESCRIPTOR FOR IT IN "DSCTMP".
;

Stringzeiger berechnen

print null terminated string to utility pointer

do string vector

copy descriptor pointer and make string space A bytes long
...ALWAYS, CREATE DESC &amp; MOVE STRING
GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
ADDRESS IS IN FAC+3,4 AND WHOSE LENGTH IS IN A-REG
   
.,B475 A6 64 LDX $64 STRINI: LDXY FACMO ;GET FACMO TO STORE IN DSCPNT.
Zeiger in
get descriptor pointer low byte
Y,X = STRING ADDRESS
   
.,B477 A4 65 LDY $65   $64/65 in
get descriptor pointer high byte
     
.,B479 86 50 STX $50 STXY DSCPNT ;RETAIN THE DESCRIPTOR POINTER.
Zeiger auf Stringdescriptor
save descriptor pointer low byte
     
.,B47B 84 51 STY $51   speichern
save descriptor pointer high byte

make string space A bytes long

GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
ADDRESS IS IN Y,X AND WHOSE LENGTH IS IN A-REG
 

allocate area according to A

.,B47D 20 F4 B4 JSR $B4F4 STRSPA: JSR GETSPA ;GET STRING SPACE.
Platz für String, Länge in A
make space in string memory for string A long
A HOLDS LENGTH
   
.,B480 86 62 STX $62 STXY DSCTMP+1 ;SAVE LOCATION.
Adresse LOW
save string pointer low byte
SAVE DESCRIPTOR IN FAC
   
.,B482 84 63 STY $63   Adresse HIGH
save string pointer high byte
---FAC--- --FAC+1-- --FAC+2--
   
.,B484 85 61 STA $61 STA DSCTMP ;SAVE LENGTH.
Länge
save length
<LENGTH> <ADDR-LO> <ADDR-HI>
   
.,B486 60 RTS RTS ;ALL DONE.
;
; "STRLT2" TAKES THE STRING LITERAL WHOSE FIRST CHARACTER
; IS POINTED TO BY [Y,A] AND BUILDS A DESCRIPTOR FOR IT.
; THE DESCRIPTOR IS INITIALLY BUILT IN "DSCTMP", BUT "PUTNEW"
; TRANSFERS IT INTO A TEMPORARY AND LEAVES A POINTER
; AT THE TEMPORARY IN FACMO&LO. THE CHARACTERS OTHER THAN
; ZERO THAT TERMINATE THE STRING SHOULD BE SET UP IN "CHARAC"
; AND "ENDCHR". IF THE TERMINATOR IS A QUOTE, THE QUOTE IS SKIPPED
; OVER. LEADING QUOTES SHOULD BE SKIPPED BEFORE JSR. ON RETURN
; THE CHARACTER AFTER THE STRING LITERAL IS POINTED TO
; BY [STRNG2].
;

String holen, Zeiger in A/Y

scan, set up string

print " terminated string to utility pointer
BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
AND TERMINATED BY $00 OR QUOTATION MARK
RETURN WITH DESCRIPTOR IN A TEMPORARY
AND ADDRESS OF DESCRIPTOR IN FAC+3,4
 

get description of string into float accu

.,B487 A2 22 LDX #$22 STRLIT: LDXI 34 ;ASSUME STRING ENDS ON QUOTE.
'"'-Code
set terminator to "
SET UP LITERAL SCAN TO STOP ON
  quote mark
.,B489 86 07 STX $07 STX CHARAC
nach Suchzeichen
set search character, terminator 1
QUOTATION MARK OR $00
   
.,B48B 86 08 STX $08 STX ENDCHR
und Hochkommaflag
set terminator 2
print search or alternate terminated string to utility pointer
source is AY
BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
AND TERMINATED BY $00, (CHARAC), OR (ENDCHR)
RETURN WITH DESCRIPTOR IN A TEMPORARY
AND ADDRESS OF DESCRIPTOR IN FAC+3,4
   
.,B48D 85 6F STA $6F STRLT2: STWD STRNG1 ;SAVE POINTER TO STRING.
Startadresse des Strings
store string start low byte
SAVE ADDRESS OF STRING
   
.,B48F 84 70 STY $70   nach $6F/70
store string start high byte
     
.,B491 85 62 STA $62 STWD DSCTMP+1 ;IN CASE NO STRCPY.
und $62/63
save string pointer low byte
...AGAIN
   
.,B493 84 63 STY $63   speichern
save string pointer high byte
     
.,B495 A0 FF LDY #$FF LDYI 255 ;INITIALIZE CHARACTER COUNT.
Zeiger setzen
set length to -1
     
.,B497 C8 INY STRGET: INY
Zeiger erhöhen
increment length
FIND END OF STRING
   
.,B498 B1 6F LDA ($6F),Y LDADY STRNG1 ;GET CHARACTER.
nächstes Zeichen des Strings
get byte from string
NEXT STRING CHAR
   
.,B49A F0 0C BEQ $B4A8 BEQ STRFI1 ;IF ZERO.
Endekennzeichen?
exit loop if null byte [EOS]
END OF STRING
   
.,B49C C5 07 CMP $07 CMP CHARAC ;THIS TERMINATOR?
Suchzeichen?
compare with search character, terminator 1
ALTERNATE TERMINATOR # 1?
   
.,B49E F0 04 BEQ $B4A4 BEQ STRFIN ;YES.
ja: $B4A4
branch if terminator
YES
   
.,B4A0 C5 08 CMP $08 CMP ENDCHR
= Zeichen in Hochkommaflag
compare with terminator 2
ALTERNATE TERMINATOR # 2?
   
.,B4A2 D0 F3 BNE $B497 BNE STRGET ;LOOK FURTHER.
nein: $B497
loop if not terminator 2
NO, KEEP SCANNING
   
.,B4A4 C9 22 CMP #$22 STRFIN: CMPI 34 ;QUOTE?
'"'-Code?
compare with "
IS STRING ENDED WITH QUOTE MARK?
  quote mark
.,B4A6 F0 01 BEQ $B4A9 BEQ STRFI2
ja: $B4A9
branch if " (carry set if = !)
YES, C=1 TO INCLUDE " IN STRING
   
.,B4A8 18 CLC STRFI1: CLC ;NO, BACK UP.
Carry löschen (Addition)
clear carry for add (only if [EOL] terminated string)
     
.,B4A9 84 61 STY $61 STRFI2: STY DSCTMP ;RETAIN COUNT.
Länge des Str. speichern und
save length in FAC1 exponent
SAVE LENGTH
   
.,B4AB 98 TYA TYA
in Akku holen
copy length to A
     
.,B4AC 65 6F ADC $6F ADC STRNG1 ;WISHING TO SET [TXTPTR].
und zur Startadresse addieren
add string start low byte
COMPUTE ADDRESS OF END OF STRING
   
.,B4AE 85 71 STA $71 STA STRNG2
ergibt Endadresse LOW + 1
save string end low byte
(OF 00 BYTE, OR JUST AFTER ")
   
.,B4B0 A6 70 LDX $70 LDX STRNG1+1
Übertrag
get string start high byte
     
.,B4B2 90 01 BCC $B4B5 BCC STRST2
Addition umgehen
branch if no low byte overflow
     
.,B4B4 E8 INX INX
Übertrag addieren
else increment high byte
     
.,B4B5 86 72 STX $72 STRST2: STX STRNG2+1
Endadresse HIGH + 1
save string end high byte
     
.,B4B7 A5 70 LDA $70 LDA STRNG1+1 ;IF PAGE 0, COPY SINCE IT IS EITHER
;A STRING CONSTANT IN BUF OR A STR$
;RESULT IN LOFBUF
IFN BUFPAG,<
Startadresse HIGH
get string start high byte
WHERE DOES THE STRING START?
   
.,B4B9 F0 04 BEQ $B4BF BEQ STRCP
null?
branch if in utility area
PAGE 0, MUST BE FROM STR$ FUNCTION
   
.,B4BB C9 02 CMP #$02 CMPI BUFPAG>
zwei?
compare with input buffer memory high byte
PAGE 2?
   
.,B4BD D0 0B BNE $B4CA BNE PUTNEW
nein: $B4CA
branch if not in input buffer memory
string in input buffer or utility area, move to string
memory
NO, NOT PAGE 0 OR 2
   
.,B4BF 98 TYA STRCP: TYA
Länge in Akku
copy length to A
LENGTH OF STRING
   
.,B4C0 20 75 B4 JSR $B475 JSR STRINI
Stringzeiger berechnen
copy descriptor pointer and make string space A bytes long
MAKE SPACE FOR STRING
   
.,B4C3 A6 6F LDX $6F LDXY STRNG1
LOW- und HIGH-Byte der
get string start low byte
     
.,B4C5 A4 70 LDY $70   Startadresse holen
get string start high byte
     
.,B4C7 20 88 B6 JSR $B688 JSR MOVSTR ;MOVE STRING.
;
; SOME STRING FUNCTION IS RETURNING A RESULT IN DSCTMP.
; SETUP A TEMP DESCRIPTOR WITH DSCTMP IN IT.
; PUT A POINTER TO THE DESCRIPTOR IN FACMO&LO AND FLAG THE
; RESULT AS TYPE STRING.
;
String in Bereich kopieren

Stringzeiger in

Descriptorstapel bringen

store string A bytes long from XY to utility pointer
check for space on descriptor stack then ...
put string address and length on descriptor stack and update stack pointers
MOVE IT IN
STORE DESCRIPTOR IN TEMPORARY DESCRIPTOR STACK
THE DESCRIPTOR IS NOW IN FAC, FAC+1, FAC+2
PUT ADDRESS OF TEMP DESCRIPTOR IN FAC+3,4
 

save descriptor from $61-$63 on stack

.,B4CA A6 16 LDX $16 PUTNEW: LDX TEMPPT ;POINTER TO FIRST FREE TEMP.
Stringdescriptor-Zeiger
get the descriptor stack pointer
POINTER TO NEXT TEMP STRING SLOT
   
.,B4CC E0 22 CPX #$22 CPXI TEMPST+STRSIZ*NUMTMP
Stringstapel voll?
compare it with the maximum + 1
MAX OF 3 TEMP STRINGS
   
.,B4CE D0 05 BNE $B4D5 BNE PUTNW1
nein: $B4D5
if there is space on the string stack continue
else do string too complex error
ROOM FOR ANOTHER ONE
   
.,B4D0 A2 19 LDX #$19 LDXI ERRST ;STRING TEMPORARY ERROR.
Nr für 'formula too complex'
error $19, string too complex error
TOO MANY, FORMULA TOO COMPLEX
   
.,B4D2 4C 37 A4 JMP $A437 ERRGO2: JMP ERROR ;GO TELL HIM.
Fehlermeldung ausgeben
do error #X then warm start
put string address and length on descriptor stack and update stack pointers
     
.,B4D5 A5 61 LDA $61 PUTNW1: LDA DSCTMP
Stringlänge holen und
get the string length
COPY TEMP DESCRIPTOR INTO TEMP STACK
   
.,B4D7 95 00 STA $00,X STA 0,X
Stringstapel speichern
put it on the string stack
     
.,B4D9 A5 62 LDA $62 LDA DSCTMP+1
LOW- und HIGH-Byte der
get the string pointer low byte
     
.,B4DB 95 01 STA $01,X STA 1,X
Adresse holen
put it on the string stack
     
.,B4DD A5 63 LDA $63 LDA DSCTMP+2
und in
get the string pointer high byte
     
.,B4DF 95 02 STA $02,X STA 2,X
Stringstapel bringen
put it on the string stack
     
.,B4E1 A0 00 LDY #$00 LDYI 0
Nullwert laden
clear Y
     
.,B4E3 86 64 STX $64 STXY FACMO
und Zeiger
save the string descriptor pointer low byte
ADDRESS OF TEMP DESCRIPTOR
   
.,B4E5 84 65 STY $65   jetzt auf Descriptor setzen
save the string descriptor pointer high byte, always $00
IN Y,X AND FAC+3,4
   
.,B4E7 84 70 STY $70 STY FACOV
Zeiger für Polynomauswertung
clear FAC1 rounding byte
     
.,B4E9 88 DEY DEY
Register vermindern
Y = $FF
Y=$FF
   
.,B4EA 84 0D STY $0D STY VALTYP ;TYPE IS "STRING".
Stringflag setzen $FF
save the data type flag, $FF = string
FLAG (FAC ) AS STRING
   
.,B4EC 86 17 STX $17 STX LASTPT ;SET POINTER TO LAST-USED TEMP.
Index des letzten
save the current descriptor stack item pointer low byte
INDEX OF LAST POINTER
   
.,B4EE E8 INX INX
Stringdescriptors
update the stack pointer
UPDATE FOR NEXT TEMP ENTRY
   
.,B4EF E8 INX INX
um drei erhöhen
update the stack pointer
     
.,B4F0 E8 INX INX ;POINT FURTHER.
und als
update the stack pointer
     
.,B4F1 86 16 STX $16 STX TEMPPT ;SAVE POINTER TO NEXT TEMP IF ANY.
neuen Index merken
save the new descriptor stack pointer
     
.,B4F3 60 RTS RTS ;ALL DONE.
;
; GETSPA - GET SPACE FOR CHARACTER STRING.
; MAY FORCE GARBAGE COLLECTION.
;
; # OF CHARACTERS (BYTES) IN ACCA.
; RETURNS WITH POINTER IN [Y,X]. OTHERWISE (IF CAN'T GET
; SPACE) BLOWS OFF TO "OUT OF STRING SPACE" TYPE ERROR.
; ALSO PRESERVES [ACCA] AND SETS [FRESPC]=[Y,X]=PNTR AT SPACE.
;
Rücksprung

Platz für String reservieren,

Länge in A

make space in string memory for string A long

return X = pointer low byte, Y = pointer high byte
MAKE SPACE FOR STRING AT BOTTOM OF STRING SPACE
(A)=# BYTES SPACE TO MAKE
RETURN WITH (A) SAME,
AND Y,X = ADDRESS OF SPACE ALLOCATED
 

allocate number of bytes in A

.,B4F4 46 0F LSR $0F GETSPA: LSR GARBFL ;SIGNAL NO GARBAGE COLLECTION YET.
Flag für Garbage Collection
zurücksetzen
clear garbage collected flag (b7)
make space for string A long
CLEAR SIGNBIT OF FLAG
   
.,B4F6 48 PHA TRYAG2: PHA ;SAVE FOR LATER.
Stringlänge
save string length
A HOLDS LENGTH
   
.,B4F7 49 FF EOR #$FF EORI 255
Alle Bits umdrehen
complement it
GET -LENGTH
   
.,B4F9 38 SEC SEC ;ADD ONE TO COMPLETE NEGATION.
mit HIGH-Byte des
set carry for subtract, two's complement add
     
.,B4FA 65 33 ADC $33 ADC FRETOP
Stringanfangs-Zeigers addieren
add bottom of string space low byte, subtract length
COMPUTE STARTING ADDRESS OF SPACE
   
.,B4FC A4 34 LDY $34 LDY FRETOP+1
LOW-Byte ins Y-Reg.
get bottom of string space high byte
FOR THE STRING
   
.,B4FE B0 01 BCS $B501 BCS TRYAG3
Carry gesetzt ? dann weiter
skip decrement if no underflow
     
.,B500 88 DEY DEY
ansonsten LOW-Byte erniedrigen
decrement bottom of string space high byte
     
.,B501 C4 32 CPY $32 TRYAG3: CPY STREND+1 ;COMPARE HIGH ORDERS.
Zu wenig Platz, dann
compare with end of arrays high byte
SEE IF FITS IN REMAINING MEMORY
   
.,B503 90 11 BCC $B516 BCC GARBAG ;MAKE ROOM FOR MORE.
Garbage Collection durchführen
do out of memory error if less
NO, TRY GARBAGE
   
.,B505 D0 04 BNE $B50B BNE STRFRE ;SAVE NEW FRETOP.
alles ok ?
if not = skip next test
YES, IT FITS
   
.,B507 C5 31 CMP $31 CMP STREND ;COMPARE LOW ORDERS.
Ende der Arrays, dann
compare with end of arrays low byte
HAVE TO CHECK LOWER BYTES
   
.,B509 90 0B BCC $B516 BCC GARBAG ;CLEAN UP.
Garbage Collect durchführen
do out of memory error if less
NOT ENUF ROOM YET
   
.,B50B 85 33 STA $33 STRFRE: STWD FRETOP ;SAVE NEW [FRETOP].
ansonsten
save bottom of string space low byte
THERE IS ROOM SO SAVE NEW FRETOP
   
.,B50D 84 34 STY $34   alle
save bottom of string space high byte
     
.,B50F 85 35 STA $35 STWD FRESPC ;PUT IT THERE OLD MAN.
Zeiger
save string utility ptr low byte
     
.,B511 84 36 STY $36   neu
save string utility ptr high byte
     
.,B513 AA TAX TAX ;PRESERVE A IN X.
setzen
copy low byte to X
ADDR IN Y,X
   
.,B514 68 PLA PLA ;GET COUNT BACK IN ACCA.
Stringlänge zurückholen
get string length back
LENGTH IN A
   
.,B515 60 RTS RTS ;ALL DONE.
Rücksprung
       
.,B516 A2 10 LDX #$10 GARBAG: LDXI ERROM ;"OUT OF STRING SPACE"
Nummer für 'OUT OF MEMORY'
error code $10, out of memory error
     
.,B518 A5 0F LDA $0F LDA GARBFL
Flag für Garbage Collection
get garbage collected flag
GARBAGE DONE YET?
   
.,B51A 30 B6 BMI $B4D2 BMI ERRGO2
durchgeführt? 'OUT OF MEMORY'
if set then do error code X
YES, MEMORY IS REALLY FULL
   
.,B51C 20 26 B5 JSR $B526 JSR GARBA2
Garbage Collection
else go do garbage collection
NO, TRY COLLECTING NOW
   
.,B51F A9 80 LDA #$80 LDAI 128
Flag setzen
flag for garbage collected
FLAG THAT COLLECTED GARBAGE ALREADY
   
.,B521 85 0F STA $0F STA GARBFL
und speichern
set garbage collected flag
     
.,B523 68 PLA PLA ;GET BACK STRING LENGTH.
Stringlänge
pull length
GET STRING LENGTH AGAIN
   
.,B524 D0 D0 BNE $B4F6 BNE TRYAG2 ;ALWAYS BRANCHES.
GARBA2: ;START FROM TOP DOWN.
IFE REALIO!DISKO,<
LDAI 7 ;TYPE "BELL".
JSR OUTDO>
String nochmals einbauen

Garbage Collection

go try again (loop always, length should never be = $00)

garbage collection routine

...ALWAYS
SHOVE ALL REFERENCED STRINGS AS HIGH AS POSSIBLE
IN MEMORY (AGAINST HIMEM)
FREEING UP SPACE BELOW STRING AREA DOWN TO STREND.
 

string garbage clean up

.,B526 A6 37 LDX $37 LDX MEMSIZ
LOW-Byte Basic-RAM-Zeiger
get end of memory low byte
COLLECT FROM TOP DOWN
   
.,B528 A5 38 LDA $38 LDA MEMSIZ+1
HIGH-Byte Basic-RAM-Zeiger
get end of memory high byte
re-run routine from last ending
     
.,B52A 86 33 STX $33 FNDVAR: STX FRETOP ;LIKE SO.
in Stringzeiger
set bottom of string space low byte
ONE PASS THROUGH ALL VARS
   
.,B52C 85 34 STA $34 STA FRETOP+1
speichern
set bottom of string space high byte
FOR EACH ACTIVE STRING!
   
.,B52E A0 00 LDY #$00 LDYI 0
LOW- und HIGH-Byte
clear index
     
.,B530 84 4F STY $4F STY GRBPNT+1
der FN Zeiger
clear working pointer high byte
FLAG IN CASE NO STRINGS TO COLLECT
   
.,B532 84 4E STY $4E STY GRBPNT ;BOTH BYTES SET TO ZERO (FIX BUG)
auf Null setzen
clear working pointer low byte
     
.,B534 A5 31 LDA $31 LDWX STREND
LOW- und HIGH-Byte der
get end of arrays low byte
     
.,B536 A6 32 LDX $32   Array-Zeiger laden
get end of arrays high byte
     
.,B538 85 5F STA $5F STWX GRBTOP
und in die Arithmetikregister
save as highest uncollected string pointer low byte
     
.,B53A 86 60 STX $60   speichern
save as highest uncollected string pointer high byte
START BY COLLECTING TEMPORARIES
   
.,B53C A9 19 LDA #$19 LDWXI TEMPST
Startadresse
set descriptor stack pointer
    low 0019
.,B53E A2 00 LDX #$00   der Descriptorentabelle
clear X
    high 0019
.,B540 85 22 STA $22 STWX INDEX1
als Suchzeiger nach
save descriptor stack pointer low byte
     
.,B542 86 23 STX $23   $22 und $23 bringen
save descriptor stack pointer high byte ($00)
     
.,B544 C5 16 CMP $16 TVAR: CMP TEMPPT ;DONE WITH TEMPS?
identisch mit String-Zeiger?
compare with descriptor stack pointer
FINISHED WITH TEMPS YET?
   
.,B546 F0 05 BEQ $B54D BEQ SVARS ;YEP.
wenn ja, dann weiter
branch if =
YES, NOW DO SIMPLE VARIABLES
   
.,B548 20 C7 B5 JSR $B5C7 JSR DVAR
Stringposition feststellen
check string salvageability
DO A TEMP
   
.,B54B F0 F7 BEQ $B544 BEQ TVAR ;LOOP.
unbedingter Sprung
loop always
done stacked strings, now do string variables
...ALWAYS
NOW COLLECT SIMPLE VARIABLES
   
.,B54D A9 07 LDA #$07 SVARS: LDAI 6+ADDPRC
Schrittweite für die Suche
set step size = $07, collecting variables
LENGTH OF EACH VARIABLE IS 7 BYTES
   
.,B54F 85 53 STA $53 STA FOUR6
in Variablentabelle
save garbage collection step size
     
.,B551 A5 2D LDA $2D LDWX VARTAB ;GET START OF SIMPLE VARIABLES.
Tabellenzeiger
get start of variables low byte
START AT BEGINNING OF VARTAB
   
.,B553 A6 2E LDX $2E   laden
get start of variables high byte
     
.,B555 85 22 STA $22 STWX INDEX1
und als Suchzeiger nach
save as pointer low byte
     
.,B557 86 23 STX $23   $22 und $23 bringen
save as pointer high byte
     
.,B559 E4 30 CPX $30 SVAR: CPX ARYTAB+1 ;DONE WITH SIMPLE VARIABLES?
Am Ende der Tabelle angelangt
compare end of variables high byte,
start of arrays high byte
FINISHED WITH SIMPLE VARIABLES?
   
.,B55B D0 04 BNE $B561 BNE SVARGO ;NO.
wenn nicht, dann zu $B561
branch if no high byte match
NO
   
.,B55D C5 2F CMP $2F CMP ARYTAB
ansonsten Sprung zur
else compare end of variables low byte,
start of arrays low byte
MAYBE, CHECK LO-BYTE
   
.,B55F F0 05 BEQ $B566 BEQ ARYVAR ;YEP.
Array-Behandlung
branch if = variable memory end
YES, NOW DO ARRAYS
   
.,B561 20 BD B5 JSR $B5BD SVARGO: JSR DVARS ;DO IT , AGAIN.
Stringposition feststellen
check variable salvageability
     
.,B564 F0 F3 BEQ $B559 BEQ SVAR ;LOOP.
unbedingter Sprung
loop always
done string variables, now do string arrays
...ALWAYS
NOW COLLECT ARRAY VARIABLES
   
.,B566 85 58 STA $58 ARYVAR: STWX ARYPNT ;SAVE FOR ADDITION.
Zeiger in die
save start of arrays low byte as working pointer
     
.,B568 86 59 STX $59   Array-Tabelle speichern
save start of arrays high byte as working pointer
     
.,B56A A9 03 LDA #$03 LDAI STRSIZ
Schrittweite für Suche
set step size, collecting descriptors
DESCRIPTORS IN ARRAYS ARE 3-BYTES EACH
   
.,B56C 85 53 STA $53 STA FOUR6
innerhalb des Arrays festlegen
save step size
     
.,B56E A5 58 LDA $58 ARYVA2: LDWX ARYPNT ;GET THE POINTER TO VARIABLE.
Am Ende
get pointer low byte
COMPARE TO END OF ARRAYS
   
.,B570 A6 59 LDX $59   der
get pointer high byte
     
.,B572 E4 32 CPX $32 ARYVA3: CPX STREND+1 ;DONE WITH ARRAYS?
Arraytabelle angelangt, dann
compare with end of arrays high byte
FINISHED WITH ARRAYS YET?
   
.,B574 D0 07 BNE $B57D BNE ARYVGO ;NO.
Sprung zu $B57D
branch if not at end
NOT YET
   
.,B576 C5 31 CMP $31 CMP STREND
Vergleich mit HIGH-Byte
else compare with end of arrays low byte
MAYBE, CHECK LO-BYTE
   
.,B578 D0 03 BNE $B57D JEQ GRBPAS ;YES, GO FINISH UP.
Sprung zu $B57D
branch if not at end
NOT FINISHED YET
   
.,B57A 4C 06 B6 JMP $B606   ansonsten Transfer
collect string, tidy up and exit if at end ??
FINISHED
   
.,B57D 85 22 STA $22 ARYVGO: STWX INDEX1
Zeiger auf Array-Header
save pointer low byte
SET UP PNTR TO START OF ARRAY
   
.,B57F 86 23 STX $23   stellen
save pointer high byte
     
.,B581 A0 00 LDY #$00 LDYI 1-ADDPRC
IFN ADDPRC,<
Zähler auf Null setzen
set index
POINT AT NAME OF ARRAY
   
.,B583 B1 22 LDA ($22),Y LDADY INDEX1
Variablenname erstes Zeichen
get array name first byte
     
.,B585 AA TAX TAX
ins X-Reg übertragen
copy it
1ST LETTER OF NAME IN X-REG
   
.,B586 C8 INY INY>
Zähler erhöhen
increment index
     
.,B587 B1 22 LDA ($22),Y LDADY INDEX1
Variablenname zweites Zeichen
get array name second byte
     
.,B589 08 PHP PHP
Statusregister retten
push the flags
STATUS FROM SECOND LETTER OF NAME
   
.,B58A C8 INY INY
Zähler erhöhen
increment index
     
.,B58B B1 22 LDA ($22),Y LDADY INDEX1
Die Länge
get array size low byte
OFFSET TO NEXT ARRAY
   
.,B58D 65 58 ADC $58 ADC ARYPNT
des Arrays
add start of this array low byte
(CARRY ALWAYS CLEAR)
   
.,B58F 85 58 STA $58 STA ARYPNT ;FORM POINTER TO NEXT ARRAY VAR.
zu
save start of next array low byte
CALCULATE START OF NEXT ARRAY
   
.,B591 C8 INY INY
Zeiger
increment index
     
.,B592 B1 22 LDA ($22),Y LDADY INDEX1
auf
get array size high byte
HI-BYTE OF OFFSET
   
.,B594 65 59 ADC $59 ADC ARYPNT+1
Arraytabelle
add start of this array high byte
     
.,B596 85 59 STA $59 STA ARYPNT+1
addieren
save start of next array high byte
     
.,B598 28 PLP PLP
Statusregister wiederholen
restore the flags
GET STATUS FROM 2ND CHAR OF NAME
   
.,B599 10 D3 BPL $B56E BPL ARYVA2
IFN ADDPRC,<
keine Stringvariable ?
skip if not string array
was possibly string array so ...
NOT A STRING ARRAY
   
.,B59B 8A TXA TXA
dann weitersuchen
get name first byte back
SET STATUS WITH 1ST CHAR OF NAME
   
.,B59C 30 D0 BMI $B56E BMI ARYVA2>
Stringvariable, nein, weiter
skip if not string array
NOT A STRING ARRAY
   
.,B59E C8 INY INY
Zähler erhöhen
increment index
     
.,B59F B1 22 LDA ($22),Y LDADY INDEX1
Dimensionenanzahl holen
get # of dimensions
# OF DIMENSIONS FOR THIS ARRAY
   
.,B5A1 A0 00 LDY #$00 LDYI 0 ;RESET INDEX Y.
Zähler wieder Null
clear index
     
.,B5A3 0A ASL ASL A,
mal 2
*2
PREAMBLE SIZE = 2*#DIMS + 5
   
.,B5A4 69 05 ADC #$05 ADCI 5 ;CARRY IS OFF AND OFF AFTER ADD.
plus 5
+5 (array header size)
     
.,B5A6 65 22 ADC $22 ADC INDEX1
zum Zeiger addieren
add pointer low byte
MAKE INDEX POINT AT FIRST ELEMENT
   
.,B5A8 85 22 STA $22 STA INDEX1
und speichern
save pointer low byte
IN THE ARRAY
   
.,B5AA 90 02 BCC $B5AE BCC ARYGET
wenn ungleich, dann zu $B5AE
branch if no rollover
     
.,B5AC E6 23 INC $23 INC INDEX1+1
Zeiger erhöhen
else increment pointer hgih byte
     
.,B5AE A6 23 LDX $23 ARYGET: LDX INDEX1+1
und in Array schieben
get pointer high byte
STEP THRU EACH STRING IN THIS ARRAY
   
.,B5B0 E4 59 CPX $59 ARYSTR: CPX ARYPNT+1 ;END OF THE ARRAY?
auf nächstes Feld vergleichen
compare pointer high byte with end of this array high byte
ARRAY DONE?
   
.,B5B2 D0 04 BNE $B5B8 BNE GOGO
wenn ungleich, dann zu $B5B8
branch if not there yet
NO, PROCESS NEXT ELEMENT
   
.,B5B4 C5 58 CMP $58 CMP ARYPNT
wenn gleich, dann
compare pointer low byte with end of this array low byte
MAYBE, CHECK LO-BYTE
   
.,B5B6 F0 BA BEQ $B572 BEQ ARYVA3 ;YES.
zu $B572
if at end of this array go check next array
YES, MOVE TO NEXT ARRAY
   
.,B5B8 20 C7 B5 JSR $B5C7 GOGO: JSR DVAR
Stringposition feststellen
check string salvageability
PROCESS THE ARRAY
   
.,B5BB F0 F3 BEQ $B5B0 BEQ ARYSTR ;CYCLE.
DVARS:
IFN INTPRC,<
unbedingter Sprung

prüft Beseitigungsmöglichkeit

loop
check variable salvageability
...ALWAYS
PROCESS A SIMPLE VARIABLE
 

check string area

.,B5BD B1 22 LDA ($22),Y LDADY INDEX1
Variablenname erstes Zeichen
get variable name first byte
LOOK AT 1ST CHAR OF NAME
   
.,B5BF 30 35 BMI $B5F6 BMI DVARTS>
Integer o. Funktion ?
add step and exit if not string
NOT A STRING VARIABLE
   
.,B5C1 C8 INY INY
Zähler erhöhen
increment index
     
.,B5C2 B1 22 LDA ($22),Y LDADY INDEX1
Variablenname zweites Zeichen
get variable name second byte
LOOK AT 2ND CHAR OF NAME
   
.,B5C4 10 30 BPL $B5F6 BPL DVARTS
wenn Real, dann $B5F6
add step and exit if not string
NOT A STRING VARIABLE
   
.,B5C6 C8 INY INY
Zähler erhöhen
increment index
check string salvageability
IF STRING IS NOT EMPTY, CHECK IF IT IS HIGHEST
 

check string area

.,B5C7 B1 22 LDA ($22),Y DVAR: LDADY INDEX1 ;IS LENGTH=0?
holt Stringlänge
get string length
GET LENGTH OF STRING
   
.,B5C9 F0 2B BEQ $B5F6 BEQ DVARTS ;YES, RETURN.
wenn Stringlänge=0,dann $B5F6
add step and exit if null string
IGNORE STRING IF LENGTH IS ZERO
   
.,B5CB C8 INY INY
Zähler erhöhen
increment index
     
.,B5CC B1 22 LDA ($22),Y LDADY INDEX1 ;GET LOW(ADR).
holt Startadresse des Strings
get string pointer low byte
GET ADDRESS OF STRING
   
.,B5CE AA TAX TAX
schiebt ins X-Reg
copy to X
     
.,B5CF C8 INY INY
Zähler erhöhen
increment index
     
.,B5D0 B1 22 LDA ($22),Y LDADY INDEX1
holt Sringzeiger
get string pointer high byte
     
.,B5D2 C5 34 CMP $34 CMP FRETOP+1 ;COMPARE HIGHS.
Vergleich mit $34
compare string pointer high byte with bottom of string
space high byte
CHECK IF ALREADY COLLECTED
   
.,B5D4 90 06 BCC $B5DC BCC DVAR2 ;IF THIS STRING'S PNTR .GE. [FRETOP]
wenn gleich, dann $B5DC
if bottom of string space greater go test against highest
uncollected string
NO, BELOW FRETOP
   
.,B5D6 D0 1E BNE $B5F6 BNE DVARTS ;NO NEED TO MESS WITH IT FURTHER.
wenn größer, dann $B5F6
if bottom of string space less string has been collected
so go update pointers, step to next and return
high bytes were equal so test low bytes
YES, ABOVE FRETOP
   
.,B5D8 E4 33 CPX $33 CPX FRETOP ;COMPARE LOWS.
mit $33 vergleichen
compare string pointer low byte with bottom of string
space low byte
MAYBE, CHECK LO-BYTE
   
.,B5DA B0 1A BCS $B5F6 BCS DVARTS
wenn gleich, dann $B5F6
if bottom of string space less string has been collected
so go update pointers, step to next and return
else test string against highest uncollected string so far
YES, ABOVE FRETOP
   
.,B5DC C5 60 CMP $60 DVAR2: CMP GRBTOP+1
Vergleich mit $60
compare string pointer high byte with highest uncollected
string high byte
ABOVE HIGHEST STRING FOUND?
   
.,B5DE 90 16 BCC $B5F6 BCC DVARTS ;IF THIS STRING IS BELOW PREVIOUS,
;FORGET IT.
wenn gleich, dann $B5F6
if highest uncollected string is greater then go update
pointers, step to next and return
NO, IGNORE FOR NOW
   
.,B5E0 D0 04 BNE $B5E6 BNE DVAR3
wenn größer, dann $B5E6
if highest uncollected string is less then go set this
string as highest uncollected so far
high bytes were equal so test low bytes
YES, THIS IS THE NEW HIGHEST
   
.,B5E2 E4 5F CPX $5F CPX GRBTOP ;COMPARE LOW ORDERS.
Vergleich mit $5F
compare string pointer low byte with highest uncollected
string low byte
MAYBE, TRY LO-BYTE
   
.,B5E4 90 10 BCC $B5F6 BCC DVARTS ;[X,A] .LE. [GRBTOP].
wenn gleich, dann $B5F6
if highest uncollected string is greater then go update
pointers, step to next and return
else set current string as highest uncollected string
NO, IGNORE FOR NOW
   
.,B5E6 86 5F STX $5F DVAR3: STX GRBTOP
Startadresse des
save string pointer low byte as highest uncollected string
low byte
MAKE THIS THE HIGHEST STRING
   
.,B5E8 85 60 STA $60 STA GRBTOP+1
Strings speichern
save string pointer high byte as highest uncollected
string high byte
     
.,B5EA A5 22 LDA $22 LDWX INDEX1
Stringdescriptor
get descriptor pointer low byte
SAVE ADDRESS OF DESCRIPTOR TOO
   
.,B5EC A6 23 LDX $23   laden
get descriptor pointer high byte
     
.,B5EE 85 4E STA $4E   und
save working pointer high byte
     
.,B5F0 86 4F STX $4F STWX GRBPNT
speichern
save working pointer low byte
     
.,B5F2 A5 53 LDA $53 LDA FOUR6
Tabellen Schrittweite laden
get step size
     
.,B5F4 85 55 STA $55 STA SIZE
und speichern
copy step size
ADD (DSCLEN) TO PNTR IN INDEX
RETURN WITH Y=0, PNTR ALSO IN X,A
   
.,B5F6 A5 53 LDA $53 DVARTS: LDA FOUR6
und zum
get step size
BUMP TO NEXT VARIABLE
   
.,B5F8 18 CLC CLC
Suchzeiger
clear carry for add
     
.,B5F9 65 22 ADC $22 ADC INDEX1
addieren
add pointer low byte
     
.,B5FB 85 22 STA $22 STA INDEX1
und wieder
save pointer low byte
     
.,B5FD 90 02 BCC $B601 BCC GRBRTS
speichern
branch if no rollover
     
.,B5FF E6 23 INC $23 INC INDEX1+1
Zeiger erhöhen
else increment pointer high byte
     
.,B601 A6 23 LDX $23 GRBRTS: LDX INDEX1+1
und laden
get pointer high byte
     
.,B603 A0 00 LDY #$00 LDYI 0
Zähler löschen
flag not moved
     
.,B605 60 RTS RTS ;DONE.
;
; HERE WHEN MADE ONE COMPLETE PASS THROUGH STRING VARIABLES.
;
Rücksprung

Strings zusammenfügen

collect string
FOUND HIGHEST NON-EMPTY STRING, SO MOVE IT
TO TOP AND GO BACK FOR ANOTHER
 

continuation of garbage clean up

.,B606 A5 4F LDA $4F GRBPAS: LDA GRBPNT+1 ;VARIABLE POINTER.
String zwischen Tabellenende
get working pointer low byte
     
.,B608 05 4E ORA $4E ORA GRBPNT
und dem oberen RAM-Bereich
OR working pointer high byte
     
.,B60A F0 F5 BEQ $B601 BEQ GRBRTS ;ALL DONE.
gefunden ? nein, dann RTS
exit if nothing to collect
     
.,B60C A5 55 LDA $55 LDA SIZE
Arraysuchlauf, dann $55=03
get copied step size
     
.,B60E 29 04 AND #$04 ANDI 4 ;LEAVES C OFF.
ansonsten $55=07
mask step size, $04 for variables, $00 for array or stack
     
.,B610 4A LSR LSR A,
wenn Einzelvariable, dann
>> 1
     
.,B611 A8 TAY TAY
Y-Reg =2 und 0 bei Array
copy to index
     
.,B612 85 55 STA $55 STA SIZE
Wert sichern
save offset to descriptor start
     
.,B614 B1 4E LDA ($4E),Y LDADY GRBPNT
;NOTE: GRBTOP=LOWTR SO NO NEED TO SET LOWTR.
Stringlänge holen
get string length low byte
     
.,B616 65 5F ADC $5F ADC LOWTR
zum LOW-Byte der Stringanfangs-
add string start low byte
     
.,B618 85 5A STA $5A STA HIGHTR
adresse Add., =Endadresse +1
set block end low byte
     
.,B61A A5 60 LDA $60 LDA LOWTR+1
auf gleiche
get string start high byte
     
.,B61C 69 00 ADC #$00 ADCI 0
Weise das
add carry
     
.,B61E 85 5B STA $5B STA HIGHTR+1
HIGH-Byte berechnen
set block end high byte
     
.,B620 A5 33 LDA $33 LDWX FRETOP
Zielbereich
get bottom of string space low byte
     
.,B622 A6 34 LDX $34   für den
get bottom of string space high byte
     
.,B624 85 58 STA $58 STWX HIGHDS ;WHERE IT ALL GOES.
Transfer
save destination end low byte
     
.,B626 86 59 STX $59   holen
save destination end high byte
     
.,B628 20 BF A3 JSR $A3BF JSR BLTUC
Strings verschieben
open up space in memory, don't set array end. this
copies the string from where it is to the end of the
uncollected string memory
     
.,B62B A4 55 LDY $55 LDY SIZE
LOW-Byte
restore offset to descriptor start
     
.,B62D C8 INY INY
der
increment index to string pointer low byte
     
.,B62E A5 58 LDA $58 LDA HIGHDS ;GET POSITION OF START OF RESULT.
Anfangsadresse in
get new string pointer low byte
     
.,B630 91 4E STA ($4E),Y STADY GRBPNT
Descriptor speichern
save new string pointer low byte
     
.,B632 AA TAX TAX
HIGH-Byte
copy string pointer low byte
     
.,B633 E6 59 INC $59 INC HIGHDS+1
der Anfangsadresse
increment new string pointer high byte
     
.,B635 A5 59 LDA $59 LDA HIGHDS+1
in
get new string pointer high byte
     
.,B637 C8 INY INY
Descriptor
increment index to string pointer high byte
     
.,B638 91 4E STA ($4E),Y STADY GRBPNT ;CHANGE ADDR OF STRING IN VAR.
bringen
save new string pointer high byte
     
.,B63A 4C 2A B5 JMP $B52A JMP FNDVAR ;GO TO FNDVAR WITH SOMETHING FOR
;[FRETOP].
;
; THE FOLLOWING ROUTINE CONCATENATES TWO STRINGS.
; THE FAC CONTAINS THE FIRST ONE AT THIS POINT.
; [TXTPTR] POINTS TO THE + SIGN.
;
nicht alles ?, dann weiter
Stringverknüpfung '+'
re-run routine from last ending, XA holds new bottom
of string memory pointer

concatenate

add strings, the first string is in the descriptor, the second string is in line

CONCATENATE TWO STRINGS

 

joining strings

.,B63D A5 65 LDA $65 CAT: LDA FACLO ;PSH HIGH ORDER ONTO STACK.
HIGH-Byte des Descriptors vom
get descriptor pointer high byte
SAVE ADDRESS OF FIRST DESCRIPTOR
   
.,B63F 48 PHA PHA
ersten String auf Stack
put on stack
     
.,B640 A5 64 LDA $64 LDA FACMO ;AND THE LOW.
LOW-Byte
get descriptor pointer low byte
     
.,B642 48 PHA PHA
in Stack
put on stack
     
.,B643 20 83 AE JSR $AE83 JSR EVAL ;CAN COME BACK HERE SINCE
;OPERATOR IS KNOWN.
zweiten String holen
get value from line
GET SECOND STRING ELEMENT
   
.,B646 20 8F AD JSR $AD8F JSR CHKSTR ;RESULT MUST BE STRING.
prüft auf Stringvariable
check if source is string, else do type mismatch
MUST BE A STRING
   
.,B649 68 PLA PLA
Descriptorzeiger des ersten
get descriptor pointer low byte back
RECOVER ADDRES OF 1ST DESCRIPTOR
   
.,B64A 85 6F STA $6F STA STRNG1 ;GET HIGH ORDER OF OLD DESC.
Strings wiederholen
set pointer low byte
     
.,B64C 68 PLA PLA
und
get descriptor pointer high byte back
     
.,B64D 85 70 STA $70 STA STRNG1+1
speichern
set pointer high byte
     
.,B64F A0 00 LDY #$00 LDYI 0
Zähler auf Null
clear index
     
.,B651 B1 6F LDA ($6F),Y LDADY STRNG1 ;GET LENGTH OF OLD STRING.
Länge des ersten Strings
get length of first string from descriptor
ADD LENGTHS, GET CONCATENATED SIZE
   
.,B653 18 CLC CLC
plus Länge
clear carry for add
     
.,B654 71 64 ADC ($64),Y ADCDY FACMO
des zweiten Strings
add length of second string
     
.,B656 90 05 BCC $B65D BCC SIZEOK ;RESULT IS LESS THAN 256.
kleiner als 256
branch if no overflow
OK IF < $100
   
.,B658 A2 17 LDX #$17 LDXI ERRLS ;ERROR "LONG STRING".
Nummer für 'STRING TOO LONG'
else error $17, string too long error
     
.,B65A 4C 37 A4 JMP $A437 JMP ERROR
Fehlermeldung ausgeben
do error #X then warm start
     
.,B65D 20 75 B4 JSR $B475 SIZEOK: JSR STRINI ;INITIALIZE STRING.
Platz für verknüpften String
copy descriptor pointer and make string space A bytes long
GET SPACE FOR CONCATENATED STRINGS
   
.,B660 20 7A B6 JSR $B67A JSR MOVINS ;MOVE IT.
ersten String übertragen
copy string from descriptor to utility pointer
MOVE 1ST STRING
   
.,B663 A5 50 LDA $50 LDWD DSCPNT ;GET POINTER TO SECOND.
Zeiger auf
get descriptor pointer low byte
     
.,B665 A4 51 LDY $51   zweiten Stringdescriptor
get descriptor pointer high byte
     
.,B667 20 AA B6 JSR $B6AA JSR FRETMP ;FREE IT.
FRESTR
pop (YA) descriptor off stack or from top of string space
returns with A = length, X = pointer low byte,
Y = pointer high byte
     
.,B66A 20 8C B6 JSR $B68C JSR MOVDO
2. String an 1. anhängen
store string from pointer to utility pointer
MOVE 2ND STRING
   
.,B66D A5 6F LDA $6F LDWD STRNG1
Descriptorzeiger des
get descriptor pointer low byte
     
.,B66F A4 70 LDY $70   zweiten Strings
get descriptor pointer high byte
     
.,B671 20 AA B6 JSR $B6AA JSR FRETMP
FRESTR
pop (YA) descriptor off stack or from top of string space
returns with A = length, X = pointer low byte,
Y = pointer high byte
     
.,B674 20 CA B4 JSR $B4CA JSR PUTNEW
Descriptor in Stringstack
check space on descriptor stack then put string address
and length on descriptor stack and update stack pointers
SET UP DESCRIPTOR
   
.,B677 4C B8 AD JMP $ADB8 JMP TSTOP ;"CAT" REENTERS FORM EVAL AT TSTOP.
zurück zur Formelauswertung

String in reserv. Bereich

continue evaluation

copy string from descriptor to utility pointer

FINISH EXPRESSION
GET STRING DESCRIPTOR POINTED AT BY (STRNG1)
AND MOVE DESCRIBED STRING TO (FRESPC)
 

move string

.,B67A A0 00 LDY #$00 MOVINS: LDYI 0 ;GET ADDR OF STRING.
Zähler auf Null
clear index
     
.,B67C B1 6F LDA ($6F),Y LDADY STRNG1
Stringlänge holen
get string length
     
.,B67E 48 PHA PHA
und merken
save it
LENGTH
   
.,B67F C8 INY INY
Zähler erhöhen
increment index
     
.,B680 B1 6F LDA ($6F),Y LDADY STRNG1
LOW-Byte der Stringadresse
get string pointer low byte
     
.,B682 AA TAX TAX
ins X-Reg
copy to X
PUT STRING POINTER IN X,Y
   
.,B683 C8 INY INY
Zähler erhöhen
increment index
     
.,B684 B1 6F LDA ($6F),Y LDADY STRNG1
HIGH-Byte der Stringadresse
get string pointer high byte
     
.,B686 A8 TAY TAY
ins Y-Reg und
copy to Y
     
.,B687 68 PLA PLA
Stack
get length back
RETRIEVE LENGTH
MOVE STRING AT (Y,X) WITH LENGTH (A)
TO DESTINATION WHOSE ADDRESS IS IN FRESPC,FRESPC+1
 

move string with length A, pointer in XY

.,B688 86 22 STX $22 MOVSTR: STXY INDEX
Zeiger auf
save string pointer low byte
PUT POINTER IN INDEX
   
.,B68A 84 23 STY $23   String speichern
save string pointer high byte
store string from pointer to utility pointer
     
.,B68C A8 TAY MOVDO: TAY
Länge null ?
copy length as index
LENGTH TO Y-REG
   
.,B68D F0 0A BEQ $B699 BEQ MVDONE
dann fertig
branch if null string
IF LENGTH IS ZERO, FINISHED
   
.,B68F 48 PHA PHA
wieder in Stack
save length
SAVE LENGTH ON STACK
   
.,B690 88 DEY MOVLP: DEY
Zähler erniedrigen
decrement length/index
MOVE BYTES FROM (INDEX) TO (FRESPC)
   
.,B691 B1 22 LDA ($22),Y LDADY INDEX
String
get byte from string
     
.,B693 91 35 STA ($35),Y STADY FRESPC
in den
save byte to destination
     
.,B695 98 TYA QMOVE: TYA
Stringbereich
copy length/index
TEST IF ANY LEFT TO MOVE
   
.,B696 D0 F8 BNE $B690 BNE MOVLP
übertragen
loop if not all done yet
YES, KEEP MOVING
   
.,B698 68 PLA PLA
Den
restore length
NO, FINISHED. GET LENGTH
   
.,B699 18 CLC MVDONE: CLC
Zeiger
clear carry for add
AND ADD TO FRESPC, SO
   
.,B69A 65 35 ADC $35 ADC FRESPC
um
add string utility ptr low byte
FRESPC POINTS TO NEXT HIGHER
   
.,B69C 85 35 STA $35 STA FRESPC
die
save string utility ptr low byte
BYTE. (USED BY CONCATENATION)
   
.,B69E 90 02 BCC $B6A2 BCC MVSTRT
Stringlänge
branch if no rollover
     
.,B6A0 E6 36 INC $36 INC FRESPC+1
erhöhen
increment string utility ptr high byte
     
.,B6A2 60 RTS MVSTRT: RTS
;
; "FRETMP" IS PASSED A STRING DESCRIPTOR PNTR IN [Y,A].
; A CHECK IS MADE TO SEE IF THE STRING DESCRIPTOR POINTS TO THE LAST
; TEMPORARY DESCRIPTOR ALLOCATED BY PUTNEW.
; IF SO, THE TEMPORARY IS FREED UP BY THE UPDATING OF [TEMPPT].
; IF A TEMP IS FREED UP, A FURTHER CHECK SEES IF THE STRING DATA THAT
; THAT STRING TEMP PNT'D TO IS THE LOWEST PART OF STRING SPACE IN USE.
; IF SO, [FRETOP] IS UPDATED TO REFLECT THE FACT THE FACT THAT THE SPACE
; IS NO LONGER IN USE.
; THE ADDR OF THE ACTUAL STRING IS RETURNED IN [Y,X] AND
; ITS LENGTH IN ACCA.
;
Rücksprung

Stringverwaltung FRESTR

evaluate string

IF (FAC) IS A TEMPORARY STRING, RELEASE DESCRIPTOR
 

de-allocate temporary string

.,B6A3 20 8F AD JSR $AD8F FRESTR: JSR CHKSTR ;MAKE SURE ITS A STRING.
prüft auf Stringvariable
check if source is string, else do type mismatch
pop string off descriptor stack, or from top of string space
returns with A = length, X = pointer low byte, Y = pointer high byte
LAST RESULT A STRING?
IF STRING DESCRIPTOR POINTED TO BY FAC+3,4 IS
A TEMPORARY STRING, RELEASE IT.
   
.,B6A6 A5 64 LDA $64 FREFAC: LDWD FACMO ;FREE UP STR PNT'D TO BY FAC.
Zeiger auf
get descriptor pointer low byte
GET DESCRIPTOR POINTER
   
.,B6A8 A4 65 LDY $65   Stringdescriptor
get descriptor pointer high byte
pop (YA) descriptor off stack or from top of string space
returns with A = length, X = pointer low byte, Y = pointer high byte
IF STRING DESCRIPTOR WHOSE ADDRESS IS IN Y,A IS
A TEMPORARY STRING, RELEASE IT.
   
.,B6AA 85 22 STA $22 FRETMP: STWD INDEX ;GET LENGTH FOR LATER.
nach
save string pointer low byte
SAVE THE ADDRESS OF THE DESCRIPTOR
   
.,B6AC 84 23 STY $23   $22 und $23 bringen
save string pointer high byte
     
.,B6AE 20 DB B6 JSR $B6DB JSR FRETMS ;FREE UP THE TEMPORARY DESC.
Descriptor vom Stringstack
clean descriptor stack, YA = pointer
FREE DESCRIPTOR IF IT IS TEMPORARY
   
.,B6B1 08 PHP PHP ;SAVE CODES.
Statusregister retten
save status flags
REMEMBER IF TEMP
   
.,B6B2 A0 00 LDY #$00 LDYI 0 ;PREP TO GET STUFF.
Zähler auf Null
clear index
POINT AT LENGTH OF STRING
   
.,B6B4 B1 22 LDA ($22),Y LDADY INDEX ;GET COUNT AND
Stringlänge holen
get length from string descriptor
     
.,B6B6 48 PHA PHA ;SAVE IT.
und in Stack schieben
put on stack
SAVE LENGTH ON STACK
   
.,B6B7 C8 INY INY
Zähler erhöhen
increment index
     
.,B6B8 B1 22 LDA ($22),Y LDADY INDEX
LOW-Byte der Anfangsadresse
get string pointer low byte from descriptor
     
.,B6BA AA TAX TAX ;SAVE LOW ORDER.
ins X-Reg schieben
copy to X
GET ADDRESS OF STRING IN Y,X
   
.,B6BB C8 INY INY
Zähler erhöhen
increment index
     
.,B6BC B1 22 LDA ($22),Y LDADY INDEX
HIGH-Byte der Anfangsadresse
get string pointer high byte from descriptor
     
.,B6BE A8 TAY TAY ;SAVE HIGH ORDER.
ins Y-Reg schieben
copy to Y
     
.,B6BF 68 PLA PLA
Stringlänge wieder aus Stack
get string length back
LENGTH IN A
   
.,B6C0 28 PLP PLP ;RETURN STATUS.
Statusreg. wieder aus Stack
restore status
RETRIEVE STATUS, Z=1 IF TEMP
   
.,B6C1 D0 13 BNE $B6D6 BNE FRETRT
Neustring=Altstring nein? RTS
branch if pointer <> last_sl,last_sh
NOT A TEMPORARY STRING
   
.,B6C3 C4 34 CPY $34 CPY FRETOP+1 ;STRING IS LAST ONE IN?
Stringadresse identisch mit
compare with bottom of string space high byte
IS IT THE LOWEST STRING?
   
.,B6C5 D0 0F BNE $B6D6 BNE FRETRT
Zeiger auf Stringende?
branch if <>
NO
   
.,B6C7 E4 33 CPX $33 CPX FRETOP
nein, dann
else compare with bottom of string space low byte
     
.,B6C9 D0 0B BNE $B6D6 BNE FRETRT
zu $B6D6
branch if <>
NO
   
.,B6CB 48 PHA PHA
String-Anfangszeiger
save string length
YES, PUSH LENGTH AGAIN
   
.,B6CC 18 CLC CLC
auf Länge
clear carry for add
RECOVER THE SPACE USED BY
   
.,B6CD 65 33 ADC $33 ADC FRETOP
des
add bottom of string space low byte
THE STRING
   
.,B6CF 85 33 STA $33 STA FRETOP
Strings
set bottom of string space low byte
     
.,B6D1 90 02 BCC $B6D5 BCC FREPLA
hinaufsetzen
skip increment if no overflow
     
.,B6D3 E6 34 INC $34 INC FRETOP+1
Stringlänge
increment bottom of string space high byte
     
.,B6D5 68 PLA FREPLA: PLA ;GET COUNT BACK.
holen
restore string length
RETRIEVE LENGTH AGAIN
   
.,B6D6 86 22 STX $22 FRETRT: STXY INDEX ;SAVE FOR LATER USE.
LOW-Byte der Startadresse
save string pointer low byte
ADDRESS OF STRING IN Y,X
   
.,B6D8 84 23 STY $23   HIGH-Byte der Startadresse
save string pointer high byte
LENGTH OF STRING IN A-REG
   
.,B6DA 60 RTS RTS
Rücksprung

Stringzeiger aus

Descriptorstack entfernen

clean descriptor stack, YA = pointer
checks if AY is on the descriptor stack, if so does a stack discard
RELEASE TEMPORARY DESCRIPTOR IF Y,A = LASTPT
 

check descriptor stack

.,B6DB C4 18 CPY $18 FRETMS: CPY LASTPT+1 ;LAST ENTRY TO TEMP?
Zeiger auf Stringdescriptor
compare high byte with current descriptor stack item
pointer high byte
COMPARE Y,A TO LATEST TEMP
   
.,B6DD D0 0C BNE $B6EB BNE FRERTS
identisch mit $18, nicht? RTS
exit if <>
NOT SAME ONE, CANNOT RELEASE
   
.,B6DF C5 17 CMP $17 CMP LASTPT
identisch mit 17
compare low byte with current descriptor stack item
pointer low byte
     
.,B6E1 D0 08 BNE $B6EB BNE FRERTS
wenn nicht, dann RTS
exit if <>
NOT SAME ONE, CANNOT RELEASE
   
.,B6E3 85 16 STA $16 STA TEMPPT
Zeiger nach $16 speichern
set descriptor stack pointer
UPDATE TEMPT FOR NEXT TEMP
   
.,B6E5 E9 03 SBC #$03 SBCI STRSIZ ;POINT TO LAST ONE.
Von Adresse $17
update last string pointer low byte
BACK OFF LASTPT
   
.,B6E7 85 17 STA $17 STA LASTPT ;UPDATE TEMP PNTR.
3 abziehen
save current descriptor stack item pointer low byte
     
.,B6E9 A0 00 LDY #$00 LDYI 0 ;ALSO CLEARS ZFLG SO WE DO REST OF FRETMP.
Zähler auf Null
clear high byte
NOW Y,A POINTS TO TOP TEMP
   
.,B6EB 60 RTS FRERTS: RTS ;ALL DONE.
;
; CHR$(#) CREATES A STRING WHICH CONTAINS AS ITS ONLY
; CHARACTER THE ASCII EQUIVALENT OF THE INTEGER ARGUMENT (#)
; WHICH MUST BE .LT. 255.
;
Rücksprung

BASIC-Funktion CHR$

perform CHR$()

Z=0 IF NOT TEMP, Z=1 IF TEMP

"CHR$" FUNCTION

 

CHR$ function

.,B6EC 20 A1 B7 JSR $B7A1 CHR: JSR CONINT ;GET INTEGER IN RANGE.
holt Byte-Wert (0 bis 255)
evaluate byte expression, result in X
CONVERT ARGUMENT TO BYTE IN X
   
.,B6EF 8A TXA TXA
Kode in Akku
copy to A
     
.,B6F0 48 PHA PHA
Akkuinhalt in Stack
save character
SAVE IT
   
.,B6F1 A9 01 LDA #$01 LDAI 1 ;ONE-CHARACTER STRING.
Länge des Strings gleich 1
string is single byte
GET SPACE FOR STRING OF LENGTH 1
   
.,B6F3 20 7D B4 JSR $B47D JSR STRSPA ;GET SPACE FOR STRING.
Platz für String freimachen
make string space A bytes long
     
.,B6F6 68 PLA PLA
ASCII-Kode zurückholen
get character back
RECALL THE CHARACTER
   
.,B6F7 A0 00 LDY #$00 LDYI 0
Zähler auf Null
clear index
PUT IN STRING
   
.,B6F9 91 62 STA ($62),Y STADY DSCTMP+1
als Stringzeichen speichern
save byte in string - byte IS string!
     
.,B6FB 68 PLA PLA ;GET RID OF "CHKNUM" RETURN ADDR.
Rücksprungadresse aus
dump return address (skip type check)
POP RETURN ADDRESS
   
.,B6FC 68 PLA PLA
Stack entfernen
dump return address (skip type check)
     
.,B6FD 4C CA B4 JMP $B4CA RLZRET: JMP PUTNEW ;SETUP FAC TO POINT TO DESC.
;
; THE FOLLOWING IS THE LEFT$($,#) FUNCTION.
; IT TAKES THE LEFTMOST # CHARACTERS OF THE STRING.
; IF # .GT. THE LEN OF THE STRING, IT RETURNS THE WHOLE STRING.
;
Descriptor in Stringstack

BASIC-Funktion LEFT$

check space on descriptor stack then put string address
and length on descriptor stack and update stack pointers

perform LEFT$()

MAKE IT A TEMPORARY STRING

"LEFT$" FUNCTION

 

LEFT$ function

.,B700 20 61 B7 JSR $B761 LEFT: JSR PREAM ;TEST PARAMETERS.
Stringadresse & Länge
aus Stack holen
pull string data and byte parameter from stack
return pointer in descriptor, byte in A (and X), Y=0
     
.,B703 D1 50 CMP ($50),Y CMPDY DSCPNT
Länge mit LEFT$-Parameter
vergleichen
compare byte parameter with string length
COMPARE 1ST PARAMETER TO LENGTH
   
.,B705 98 TYA TYA
LEFT$-Parameter
clear A
Y=A=0
   
.,B706 90 04 BCC $B70C RLEFT: BCC RLEFT1
kleiner als Stringlänge ?
branch if string length > byte parameter
1ST PARAMETER SMALLER, USE IT
   
.,B708 B1 50 LDA ($50),Y LDADY DSCPNT
Stringlänge holen
else make parameter = length
1ST IS LONGER, USE STRING LENGTH
   
.,B70A AA TAX TAX ;PUT LENGTH INTO X.
und ins X-Reg schieben
copy to byte parameter copy
IN X-REG
   
.,B70B 98 TYA TYA ;ZERO A, THE OFFSET.
Stringlänge und
clear string start offset
Y=A=0 AGAIN
   
.,B70C 48 PHA RLEFT1: PHA ;SAVE OFFSET.
Parameter für LEFT$
save string start offset
PUSH LEFT END OF SUBSTRING
   
.,B70D 8A TXA RLEFT2: TXA
in Stack
copy byte parameter (or string length if <)
     
.,B70E 48 PHA RLEFT3: PHA ;SAVE LENGTH.
schieben
save string length
PUSH LENGTH OF SUBSTRING
   
.,B70F 20 7D B4 JSR $B47D JSR STRSPA ;GET SPACE.
Platz für neuen String
reservieren
make string space A bytes long
MAKE ROOM FOR STRING OF (A) BYTES
   
.,B712 A5 50 LDA $50 LDWD DSCPNT
Zeiger auf Stringdescriptor
get descriptor pointer low byte
RELEASE PARAMETER STRING IF TEMP
   
.,B714 A4 51 LDY $51   laden
get descriptor pointer high byte
     
.,B716 20 AA B6 JSR $B6AA JSR FRETMP
FRESTR
pop (YA) descriptor off stack or from top of string space
returns with A = length, X = pointer low byte,
Y = pointer high byte
     
.,B719 68 PLA PLA
Länge des neuen Strings aus
get string length back
GET LENGTH OF SUBSTRING
   
.,B71A A8 TAY TAY
Stack holen und ins X-Reg
copy length to Y
IN Y-REG
   
.,B71B 68 PLA PLA
alte
get string start offset back
GET LEFT END OF SUBSTRING
   
.,B71C 18 CLC CLC
Stringadresse
clear carry for add
ADD TO POINTER TO STRING
   
.,B71D 65 22 ADC $22 ADC INDEX ;COMPUTE WHERE TO COPY.
entsprechend
add start offset to string start pointer low byte
     
.,B71F 85 22 STA $22 STA INDEX
erhöhen
save string start pointer low byte
     
.,B721 90 02 BCC $B725 BCC PULMOR
und speichern
branch if no overflow
     
.,B723 E6 23 INC $23 INC INDEX+1
HIGH-Byte erhöhen
else increment string start pointer high byte
     
.,B725 98 TYA PULMOR: TYA
neue Stringlänge holen
copy length to A
LENGTH
   
.,B726 20 8C B6 JSR $B68C JSR MOVDO ;GO MOVE IT.
neuen String in
Stringbereich übertragen
store string from pointer to utility pointer
COPY STRING INTO SPACE
   
.,B729 4C CA B4 JMP $B4CA JMP PUTNEW
Descriptor in Stringstack
bringen

BASIC-Funktion RIGHT$

check space on descriptor stack then put string address
and length on descriptor stack and update stack pointers

perform RIGHT$()

ADD TO TEMPS

"RIGHT$" FUNCTION

 

RIGHT$ function

.,B72C 20 61 B7 JSR $B761 RIGHT: JSR PREAM
Stringparameter und Länge
vom Stack holen
pull string data and byte parameter from stack
return pointer in descriptor, byte in A (and X), Y=0
     
.,B72F 18 CLC CLC ;[LENGTH DES'D]-[LENGTH]-1.
von Stringlänge
clear carry for add-1
COMPUTE LENGTH-WIDTH OF SUBSTRING
   
.,B730 F1 50 SBC ($50),Y SBCDY DSCPNT
abziehen
subtract string length
TO GET STARTING POINT IN STRING
   
.,B732 49 FF EOR #$FF EORI 255 ;NEGATE.
Nummer des ersten Elements
im alten String
invert it (A=LEN(expression$)-l)
     
.,B734 4C 06 B7 JMP $B706 JMP RLEFT
;
; MID ($,#) RETURNS STRING WITH CHARS FROM # POSITION
; ONWARD. IF # .GT. LEN ($) THEN RETURN NULL STRING.
; MID ($,#,#) RETURNS STRING WITH CHARACTERS FROM
; # POSITION FOR #2 CHARACTERS. IF #2 GOES PAST END OF STRING
; RETURN AS MUCH AS POSSIBLE.
;
weiter wie LEFT$

BASIC-Funktion MID$

go do rest of LEFT$()

perform MID$()

JOIN LEFT$

"MID$" FUNCTION

 

MID$ function

.,B737 A9 FF LDA #$FF MID: LDAI 255 ;DEFAULT.
Ersatzwert für den zweiten
set default length = 255
FLAG WHETHER 2ND PARAMETER
  default 3 parameter
.,B739 85 65 STA $65 STA FACLO ;SAVE FOR LATER COMPARE.
Zahlenparameter
save default length
     
.,B73B 20 79 00 JSR $0079 JSR CHRGOT ;GET CURRENT CHARACTER.
CHRGOT letztes Zeichen holen
scan memory
SEE IF ")" YET
   
.,B73E C9 29 CMP #$29 CMPI 41 ;IS IT A RIGHT PAREN )?
')' Klammer zu
compare with ")"
    )
.,B740 F0 06 BEQ $B748 BEQ MID2 ;NO THIRD PARAM.
wenn ja, dann kein zweiter
Parameter, weiter bei $B748
branch if = ")" (skip second byte get)
YES, NO 2ND PARAMETER
   
.,B742 20 FD AE JSR $AEFD JSR CHKCOM ;MUST HAVE COMMA.
prüft auf Komma
scan for ",", else do syntax error then warm start
NO, MUST HAVE COMMA
   
.,B745 20 9E B7 JSR $B79E JSR GETBYT ;GET THE LENGTH INTO "FACLO".
holt Byte-Wert des zweiten
Parameters
get byte parameter
GET 2ND PARAM IN X-REG
   
.,B748 20 61 B7 JSR $B761 MID2: JSR PREAM ;CHECK IT OUT.
Stringparameter und
Startposition holen
pull string data and byte parameter from stack
return pointer in descriptor, byte in A (and X), Y=0
     
.,B74B F0 4B BEQ $B798 BEQ GOFUC ;THERE IS NO POSTION 0
1. Parameter null, 'ILLEGAL
QUANTITY'
if null do illegal quantity error then warm start
     
.,B74D CA DEX DEX ;COMPUTE OFFSET.
erste Elementposition
decrement start index
1ST PARAMETER - 1
   
.,B74E 8A TXA TXA
innerhalb
copy to A
     
.,B74F 48 PHA PHA ;PRSERVE AWHILE.
des alten Strings
save string start offset
     
.,B750 18 CLC CLC
im Stack ablegen
clear carry for sub-1
     
.,B751 A2 00 LDX #$00 LDXI 0
Zähler setzen
clear output string length
     
.,B753 F1 50 SBC ($50),Y SBCDY DSCPNT ;GET LENGTH OF WHAT'S LEFT.
alte Stringlänge kleiner als
erster Parameter ?
subtract string length
     
.,B755 B0 B6 BCS $B70D BCS RLEFT2 ;GIVE NULL STRING.
wenn ja, dann zu LEFT$
if start>string length go do null string
     
.,B757 49 FF EOR #$FF EORI 255 ;IN SUB C WAS 0 SO JUST COMPLEMENT.
Berechnen der neuen Länge
complement -length
     
.,B759 C5 65 CMP $65 CMP FACLO ;GREATER THAN WHAT'S DESIRED?
wenn kleiner als zweiter
compare byte parameter
USE SMALLER OF TWO
   
.,B75B 90 B1 BCC $B70E BCC RLEFT3 ;NO, COPY THAT MUCH.
Parameter, dann zu LEFT$
if length>remaining string go do RIGHT$
     
.,B75D A5 65 LDA $65 LDA FACLO ;GET LENGTH OF WHAT'S DESIRED.
Zweitparameter als 'rechte'
Stringbegrenzung
get length byte
     
.,B75F B0 AD BCS $B70E BCS RLEFT3 ;COPY IT.
;
; USED BY RIGHT$, LEFT$, MID$ FOR PARAMETER CHECKING AND SETUP.
;
unbedingter Sprung

Stringparameter numerischer Wert

vom Stack holen

go do string copy, branch always

pull string data and byte parameter from stack

return pointer in descriptor, byte in A (and X), Y=0
...ALWAYS

COMMON SETUP ROUTINE FOR LEFT$, RIGHT$, MID$

REQUIRE ")"; POP RETURN ADRS, GET DESCRIPTOR
ADDRESS, GET 1ST PARAMETER OF COMMAND
 

get first 2 parameters for

LEFT$, RIGHT$ and MID$
.,B761 20 F7 AE JSR $AEF7 PREAM: JSR CHKCLS ;PARAM LIST SHOULD END.
prüft auf Klammer zu
scan for ")", else do syntax error then warm start
REQUIRE ")"
   
.,B764 68 PLA PLA ;GET THE RETURN ADDRESS INTO
LOW-Byte der
pull return address low byte
SAVE RETURN ADDRESS
   
.,B765 A8 TAY TAY ;[JMPER+1,Y]
Aufrufadresse merken
save return address low byte
IN Y-REG AND LENGTH
   
.,B766 68 PLA PLA
HIGH-Byte der
pull return address high byte
     
.,B767 85 55 STA $55 STA JMPER+1
Aufrufadresse merken
save return address high byte
     
.,B769 68 PLA PLA ;GET RID OF FINGO'S JSR RET ADDR.
LOW-und HIGH-Byte der
dump call to function vector low byte
POP PREVIOUS RETURN ADDRESS
   
.,B76A 68 PLA PLA
Aufrufadresse merken
dump call to function vector high byte
(FROM GOROUT).
   
.,B76B 68 PLA PLA ;GET LENGTH.
1. Parameter holen
pull byte parameter
RETRIEVE 1ST PARAMETER
   
.,B76C AA TAX TAX
und ins X-Reg
copy byte parameter to X
     
.,B76D 68 PLA PULWD DSCPNT
LOW- und HIGH-Byte
pull string pointer low byte
GET ADDRESS OF STRING DESCRIPTOR
   
.,B76E 85 50 STA $50   des
save it
     
.,B770 68 PLA   Stringdescriptors
pull string pointer high byte
     
.,B771 85 51 STA $51   nach
save it
     
.,B773 A5 55 LDA $55 LDA JMPER+1 ;PUT RETURN ADDRESS BACK ON
$51 und $52 speichern
get return address high byte
RESTORE RETURN ADDRESS
   
.,B775 48 PHA PHA
Aufrufadresse
back on stack
     
.,B776 98 TYA TYA
wieder auf
get return address low byte
     
.,B777 48 PHA PHA
Stack
back on stack
     
.,B778 A0 00 LDY #$00 LDYI 0
Zähler auf Null
clear index
     
.,B77A 8A TXA TXA
Länge, zweiter Parameter
copy byte parameter
GET 1ST PARAMETER IN A-REG
   
.,B77B 60 RTS RTS
;
; THE FUNCTION LEN($) RETURNS THE LENGTH OF THE STRING
; PASSED AS AN ARGUMENT.
;
Rücksprung

BASIC-Funktion LEN

perform LEN()

"LEN" FUNCTION

 

LEN function

.,B77C 20 82 B7 JSR $B782 LEN: JSR LEN1
FRESTR, Stringlänge holen
evaluate string, get length in A (and Y)
GET LENTGH IN Y-REG, MAKE FAC NUMERIC
   
.,B77F 4C A2 B3 JMP $B3A2 JMP SNGFLT
Byte-Wert nach
Fließkommaformat wandeln

Stringparameter holen

convert Y to byte in FAC1 and return

evaluate string, get length in Y

FLOAT Y-REG INTO FAC
IF LAST RESULT IS A TEMPORARY STRING, FREE IT
MAKE VALTYP NUMERIC, RETURN LENGTH IN Y-REG
   
.,B782 20 A3 B6 JSR $B6A3 LEN1: JSR FRESTR ;FREE UP STRING.
FRESTR, String holen, Länge
in A
evaluate string
IF LAST RESULT IS A STRING, FREE IT
   
.,B785 A2 00 LDX #$00 LDXI 0
Typeflag
set data type = numeric
MAKE VALTYP NUMERIC
   
.,B787 86 0D STX $0D STX VALTYP ;FORCE NUMERIC.
auf numerisch setzen
clear data type flag, $FF = string, $00 = numeric
     
.,B789 A8 TAY TAY ;SET CODES ON LENGTH.
Länge in Y
copy length to Y
LENGTH OF STRING TO Y-REG
   
.,B78A 60 RTS RTS ;DONE.
;
; THE FOLLOWING IS THE ASC($) FUNCTION. IT RETURNS
; AN INTEGER WHICH IS THE DECIMAL ASCII EQUIVALENT.
;
Rücksprung

BASIC-Funktion ASC

perform ASC()

"ASC" FUNCTION

 

ASC function

.,B78B 20 82 B7 JSR $B782 ASC: JSR LEN1
String holen, Zeiger in
$22/$23, Länge in Y
evaluate string, get length in A (and Y)
GET STRING, GET LENGTH IN Y-REG
   
.,B78E F0 08 BEQ $B798 BEQ GOFUC ;NULL STRING, BAD ARG.
Länge gleich null,
'ILLEGAL QUANTITY'
if null do illegal quantity error then warm start
ERROR IF LENGTH 0
   
.,B790 A0 00 LDY #$00 LDYI 0
Zähler auf Null
set index to first character
     
.,B792 B1 22 LDA ($22),Y LDADY INDEX1 ;GET CHARACTER.
erstes Zeichen holen
get byte
GET 1ST CHAR OF STRING
   
.,B794 A8 TAY TAY
ASCII-Kode
copy to Y
     
.,B795 4C A2 B3 JMP $B3A2 JMP SNGFLT
nach Fließkomma wandeln
convert Y to byte in FAC1 and return

do illegal quantity error then warm start

FLOAT Y-REG INTO FAC
   
.,B798 4C 48 B2 JMP $B248 GOFUC: JMP FCERR ;YES.
'ILLEGAL QUANTITY'

holt Byte-Wert nach X

do illegal quantity error then warm start

scan and get byte parameter

ILLEGAL QUANTITY ERROR

SCAN TO NEXT CHARACTER AND CONVERT EXPRESSION

TO SINGLE BYTE IN X-REG

 

fetch integer value in X and check range

.,B79B 20 73 00 JSR $0073 GTBYTC: JSR CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory

get byte parameter

EVALUATE EXPRESSION AT TXTPTR, AND

CONVERT IT TO SINGLE BYTE IN X-REG

   
.,B79E 20 8A AD JSR $AD8A GETBYT: JSR FRMNUM ;READ FORMULA INTO FAC.
FRMNUM numerischen Wert
nach FAC holen
evaluate expression and check is numeric, else do
type mismatch

evaluate byte expression, result in X

CONVERT (FAC) TO SINGLE BYTE INTEGER IN X-REG

   
.,B7A1 20 B8 B1 JSR $B1B8 CONINT: JSR POSINT ;CONVERT THE FAC TO A SINGLE BYTE INT.
prüft auf Bereich und
wandelt nach Integer
evaluate integer expression, sign check
CONVERT IF IN RANGE -32767 TO +32767
   
.,B7A4 A6 64 LDX $64 LDX FACMO
HIGH-Byte
get FAC1 mantissa 3
HI-BYTE MUST BE ZERO
   
.,B7A6 D0 F0 BNE $B798 BNE GOFUC ;RESULT MUST BE .LE. 255.
ungleich null, dann
'ILLEGAL QUANTITY'
if not null do illegal quantity error then warm start
VALUE > 255, ERROR
   
.,B7A8 A6 65 LDX $65 LDX FACLO
LOW-Byte des geholten
Ausdrucks ins X-Reg
get FAC1 mantissa 4
VALUE IN X-REG
   
.,B7AA 4C 79 00 JMP $0079 CHRGO2: JMP CHRGOT ;SET CONDITION CODES ON TERMINATOR.
;
; THE "VAL" FUNCTION TAKES A STRING AND TURNS IT INTO
; A NUMBER BY INTERPRETING THE ASCII DIGITS ETCQ
; EXCEPT FOR THE PROBLEM THAT A TERMINATOR MUST BE SUPPLIED
; BY REPLACING THE CHARACTER BEYOND THE STRING, VAL IS MERELY
; A CALL TO FLOATING POINT INPUT ("FIN").
;
CHRGOT letztes Zeichen holen

BASIC-Funktion VAL

scan memory and return

perform VAL()

GET NEXT CHAR IN A-REG

"VAL" FUNCTION

 

VAL function

.,B7AD 20 82 B7 JSR $B782 VAL: JSR LEN1 ;DO SETUP. SET RESULT=NUMERIC.
Stringadresse und Länge holen
evaluate string, get length in A (and Y)
GET POINTER TO STRING IN INDEX
   
.,B7B0 D0 03 BNE $B7B5 JEQ ZEROFC ;ZERO THE FAC ON A NULL STRING
Stringlänge ungleich Null ?
branch if not null string
string was null so set result = $00
LENGTH NON-ZERO
   
.,B7B2 4C F7 B8 JMP $B8F7   Null in FAC
clear FAC1 exponent and sign and return
RETURN 0 IF LENGTH=0
   
.,B7B5 A6 7A LDX $7A LDXY TXTPTR
Programmzeiger
get BASIC execute pointer low byte
SAVE CURRENT TXTPTR
   
.,B7B7 A4 7B LDY $7B   holen
get BASIC execute pointer high byte
     
.,B7B9 86 71 STX $71 STXY STRNG2 ;SAVE FOR LATER.
und
save BASIC execute pointer low byte
     
.,B7BB 84 72 STY $72   speichern
save BASIC execute pointer high byte
     
.,B7BD A6 22 LDX $22 LDX INDEX1
Stringanfangsadresse
get string pointer low byte
     
.,B7BF 86 7A STX $7A STX TXTPTR
in Stringzeiger bringen
save BASIC execute pointer low byte
POINT TXTPTR TO START OF STRING
   
.,B7C1 18 CLC CLC
LOW-Byte des
clear carry for add
     
.,B7C2 65 22 ADC $22 ADC INDEX1
ersten Zeichens
add string length
ADD LENGTH
   
.,B7C4 85 24 STA $24 STA INDEX2
nach dem String speichern
save string end low byte
POINT DEST TO END OF STRING + 1
   
.,B7C6 A6 23 LDX $23 LDX INDEX1+1
HIGH-Byte
get string pointer high byte
     
.,B7C8 86 7B STX $7B STX TXTPTR+1
des ersten
save BASIC execute pointer high byte
     
.,B7CA 90 01 BCC $B7CD BCC VAL2 ;NO CARRY, NO INC.
Zeichens
branch if no high byte increment
     
.,B7CC E8 INX INX
nach dem String
increment string end high byte
     
.,B7CD 86 25 STX $25 VAL2: STX INDEX2+1
speichern
save string end high byte
     
.,B7CF A0 00 LDY #$00 LDYI 0
Zähler auf Null
set index to $00
SAVE BYTE THAT FOLLOWS STRING
   
.,B7D1 B1 24 LDA ($24),Y LDADY INDEX2 ;PRESERVE CHARACTER.
erstes Byte nach String
get string end byte
ON STACK
   
.,B7D3 48 PHA PHA
auf Stack
push it
     
.,B7D4 98 TYA LDAI 0 ;SET A TERMINATOR.
speichern
clear A
AND STORE $00 IN ITS PLACE
   
.,B7D5 91 24 STA ($24),Y STADY INDEX2
und durch null ersetzen
terminate string with $00
<<< THAT CAUSES A BUG IF HIMEM = $BFFF, >>>
<<< BECAUSE STORING $00 AT $C000 IS NO >>>
<<< USE; $C000 WILL ALWAYS BE LAST CHAR >>>
<<< TYPED, SO FIN WON'T TERMINATE UNTIL >>>
<<< IT SEES A ZERO AT $C010! >>>
   
.,B7D7 20 79 00 JSR $0079 JSR CHRGOT ;GET CHARACTER PNT'D TO AND SET FLAGS.
CHRGOT letztes Zeichen holen
scan memory
PRIME THE PUMP
   
.,B7DA 20 F3 BC JSR $BCF3 JSR FIN
String in Fließkommazahl
umwandeln
get FAC1 from string
EVALUATE STRING
   
.,B7DD 68 PLA PLA ;GET PRES'D CHARACTER.
Zeichen nach String
restore string end byte
GET BYTE THAT SHOULD FOLLOW STRING
   
.,B7DE A0 00 LDY #$00 LDYI 0
Zähler auf Null
clear index
AND PUT IT BACK
   
.,B7E0 91 24 STA ($24),Y STADY INDEX2 ;STUFF IT BACK.
wieder zurücksetzen
put string end byte back

restore BASIC execute pointer from temp

RESTORE TXTPTR

COPY STRNG2 INTO TXTPTR

   
.,B7E2 A6 71 LDX $71 ST2TXT: LDXY STRNG2
Die
get BASIC execute pointer low byte back
     
.,B7E4 A4 72 LDY $72   Programmzeiger
get BASIC execute pointer high byte back
     
.,B7E6 86 7A STX $7A STXY TXTPTR
wieder
save BASIC execute pointer low byte
     
.,B7E8 84 7B STY $7B   zurückholen
save BASIC execute pointer high byte
     
.,B7EA 60 RTS VALRTS: RTS ;ALL DONE WITH STRINGS.
PAGE

PEEK, POKE, AND FNWAIT.

Rücksprung

GETADR und GETBYT holt

16-Bit und 8-Bit-Wert

get parameters for POKE/WAIT

EVALUATE "EXP1,EXP2"

CONVERT EXP1 TO 16-BIT NUMBER IN LINNUM
CONVERT EXP2 TO 8-BIT NUMBER IN X-REG
 

get address into $14/$15 and integer in X

.,B7EB 20 8A AD JSR $AD8A GETNUM: JSR FRMNUM ;GET ADDRESS.
FRMNUM holt numerischen Wert
evaluate expression and check is numeric, else do
type mismatch
     
.,B7EE 20 F7 B7 JSR $B7F7 JSR GETADR ;GET THAT LOCATION.
FAC in Adressformat wandlen
$14/$15
convert FAC_1 to integer in temporary integer

EVALUATE ",EXPRESSION"

CONVERT EXPRESSION TO SINGLE BYTE IN X-REG
   
.,B7F1 20 FD AE JSR $AEFD COMBYT: JSR CHKCOM ;CHECK FOR A COMMA.
CHKCOM prüft auf Komma
scan for ",", else do syntax error then warm start
MUST HAVE COMMA FIRST
   
.,B7F4 4C 9E B7 JMP $B79E JMP GETBYT ;GET SOMETHING TO STORE AND RETURN.
holt Byte-Wert nach X

GETADR FAC in positive

16-Bit-Zahl wandeln

get byte parameter and return

convert FAC_1 to integer in temporary integer

CONVERT EXPRESSION TO BYTE IN X-REG

CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM

 

convert float ti integer in $14/$15

.,B7F7 A5 66 LDA $66 GETADR: LDA FACSGN ;EXAMINE SIGN.
Vorzeichen
get FAC1 sign
FAC < 2^16?
   
.,B7F9 30 9D BMI $B798 BMI GOFUC ;FUNCTION CALL ERROR.
negativ, dann
'ILLEGAL QUANTITY'
if -ve do illegal quantity error then warm start
     
.,B7FB A5 61 LDA $61 LDA FACEXP ;EXAMINE EXPONENT.
Exponent
get FAC1 exponent
     
.,B7FD C9 91 CMP #$91 CMPI 145
Zahl mit 65536 vergleichen
compare with exponent = 2^16
     
.,B7FF B0 97 BCS $B798 BCS GOFUC ;FUNCTION CALL ERROR.
größer, dann
if >= do illegal quantity error then warm start
NO, ILLEGAL QUANTITY
   
.,B801 20 9B BC JSR $BC9B JSR QINT ;INTEGERIZE IT.
'ILLEGAL QUANTITY'
FAC in Adressformat wandeln
convert FAC1 floating to fixed
CONVERT TO INTEGER
   
.,B804 A5 64 LDA $64 LDWD FACMO
Wert
get FAC1 mantissa 3
COPY IT INTO LINNUM
   
.,B806 A4 65 LDY $65   holen
get FAC1 mantissa 4
     
.,B808 84 14 STY $14 STY POKER
und nach $14/$15
save temporary integer low byte
TO LINNUM
   
.,B80A 85 15 STA $15 STA POKER+1
speichern
save temporary integer high byte
     
.,B80C 60 RTS RTS ;IT'S DONE !.
Rücksprung

BASIC-Funktion PEEK

perform PEEK()

"PEEK" FUNCTION

 

PEEK function

.,B80D A5 15 LDA $15 PEEK: PSHWD POKER
$14 und $15
get line number high byte
SAVE (LINNUM) ON STACK DURING PEEK
   
.,B80F 48 PHA   in
save line number high byte
     
.,B810 A5 14 LDA $14   Stack
get line number low byte
     
.,B812 48 PHA   sichern
save line number low byte
     
.,B813 20 F7 B7 JSR $B7F7 JSR GETADR
FAC nach Adressformat
wandeln
convert FAC_1 to integer in temporary integer
GET ADDRESS PEEKING AT
   
.,B816 A0 00 LDY #$00 LDYI 0
IFE REALIO-3,<
CMPI ROMLOC/256 ;IF WITHIN BASIC,
BCC GETCON
CMPI LASTWR/256
BCC DOSGFL> ;GIVE HIM ZERO FOR AN ANSWER.
Zähler auf Null
clear index
     
.,B818 B1 14 LDA ($14),Y GETCON: LDADY POKER ;GET THAT BYTE.
Peek-Wert holen
read byte
TAKE A QUICK LOOK
   
.,B81A A8 TAY TAY
nach Y-Reg
copy byte to A
VALUE IN Y-REG
   
.,B81B 68 PLA DOSGFL: PULWD POKER
$14 und $15
pull byte
RESTORE LINNUM FROM STACK
   
.,B81C 85 14 STA $14   wieder
restore line number low byte
     
.,B81E 68 PLA   vom Stack
pull byte
     
.,B81F 85 15 STA $15   zurückholen
restore line number high byte
     
.,B821 4C A2 B3 JMP $B3A2 JMP SNGFLT ;FLOAT IT.
Y nach Fließkommaformat

BASIC-Befehl POKE

convert Y to byte in FAC_1 and return

perform POKE

FLOAT Y-REG INTO FAC

"POKE" STATEMENT

 

POKE command

.,B824 20 EB B7 JSR $B7EB POKE: JSR GETNUM
Poke-Adrefcse und Wert holen
get parameters for POKE/WAIT
GET THE ADDRESS AND VALUE
   
.,B827 8A TXA TXA
Poke-Wert in Akku
copy byte to A
VALUE IN A,
   
.,B828 A0 00 LDY #$00 LDYI 0
Zähler auf Null
clear index
     
.,B82A 91 14 STA ($14),Y STADY POKER ;STORE VALUE AWAY.
und in Speicher schreiben
write byte
STORE IT AWAY,
   
.,B82C 60 RTS RTS ;SCANNED EVERYTHING.
; THE WAIT LOCATION,MASK1,MASK2 STATEMENT WAITS UNTIL THE CONTENTS
; OF LOCATION IS NONZERO WHEN XORED WITH MASK2
; AND THEN ANDED WITH MASK1. IF MASK2 IS NOT PRESENT, IT
; IS ASSUMED TO BE ZERO.
Rücksprung

BASIC-Befehl WAIT

perform WAIT

AND THAT'S ALL FOR TODAY

"WAIT" STATEMENT

 

WAIT command

.,B82D 20 EB B7 JSR $B7EB FNWAIT: JSR GETNUM
Adresse und Wert holen
get parameters for POKE/WAIT
GET ADDRESS IN LINNUM, MASK IN X
   
.,B830 86 49 STX $49 STX ANDMSK
zweiter Parameter nach $49
save byte
SAVE MASK
   
.,B832 A2 00 LDX #$00 LDXI 0
Default für dritten Parameter
clear mask
     
.,B834 20 79 00 JSR $0079 JSR CHRGOT
CHRGOT letztes Zeichen
scan memory
ANOTHER PARAMETER?
   
.,B837 F0 03 BEQ $B83C BEQ ZSTORDO
kein dritter Parameter ?
skip if no third argument
NO, USE $00 FOR EXCLUSIVE-OR
   
.,B839 20 F1 B7 JSR $B7F1 JSR COMBYT ;GET MASK2.
prüft auf Komma und holt
Parameter
scan for "," and get byte, else syntax error then
warm start
GET XOR-MASK
   
.,B83C 86 4A STX $4A STORDO: STX EORMSK
dritter Parameter nach $4A
save EOR argument
SAVE XOR-MASK HERE
   
.,B83E A0 00 LDY #$00 LDYI 0
Zähler auf Null
clear index
     
.,B840 B1 14 LDA ($14),Y WAITER: LDADY POKER
Wait-Adresse
get byte via temporary integer (address)
GET BYTE AT ADDRESS
   
.,B842 45 4A EOR $4A EOR EORMSK
logisch
EOR with second argument (mask)
INVERT SPECIFIED BITS
   
.,B844 25 49 AND $49 AND ANDMSK
verknüpfen
AND with first argument (byte)
SELECT SPECIFIED BITS
   
.,B846 F0 F8 BEQ $B840 BEQ WAITER
weiter warten
loop if result is zero
LOOP TILL NOT 0
   
.,B848 60 RTS ZERRTS: RTS ;GOT A NONZERO.

FLOATING POINT MATH PACKAGE CONFIGURATION.

RADIX 8 ;!!!! ALERT !!!!
;THROUGHOUT THE MATH PACKAGE.
COMMENT %
THE FLOATING POINT FORMAT IS AS FOLLOWS:
THE SIGN IS THE FIRST BIT OF THE MANTISSA.
THE MANTISSA IS 24 BITS LONG.
THE BINARY POINT IS TO THE LEFT OF THE MSB.
NUMBER = MANTISSA * 2 ^ EXPONENT.
THE MANTISSA IS POSITIVE WITH A ONE ASSUMED TO BE WHERE THE SIGN BIT IS.
THE SIGN OF THE EXPONENT IS THE FIRST BIT OF THE EXPONENT.
THE EXPONENT IS STORED IN EXCESS 200, I.E. WITH A BIAS OF +200.
SO, THE EXPONENT IS A SIGNED 8-BIT NUMBER WITH 200 ADDED TO IT.
AN EXPONENT OF ZERO MEANS THE NUMBER IS ZERO.
THE OTHER BYTES MAY NOT BE ASSUMED TO BE ZERO.
TO KEEP THE SAME NUMBER IN THE FAC WHILE SHIFTING,
TO SHIFT RIGHT, EXP:=EXP+1
TO SHIFT LEFT, EXP:=EXP-1
IN MEMORY THE NUMBER LOOKS LIKE THIS:
[THE EXPONENT AS A SIGNED NUMBER +200]
[THE SIGN BIT IN 7, BITS 2-8 OF MANTISSA ARE IN BITS 6-0].
(REMEMBER BIT 1 OF MANTISSA IS ALWAYS A ONE.)
[BITS 9-16 OF THE MANTISSA]
[BITS 17-24] OF THE MANTISSA]
ARITHMETIC ROUTINE CALLING CONVENTIONS:
FOR ONE ARGUMENT FUNCTIONS:
THE ARGUMENT IS IN THE FAC.
THE RESULT IS LEFT IN THE FAC.
FOR TWO ARGUMENT OPERATIONS:
THE FIRST ARGUMENT IS IN ARG (ARGEXP,HO,MO,LO AND ARGSGN).
THE SECOND ARGUMENT IS IN THE FAC.
THE RESULT IS LEFT IN THE FAC.
THE "T" ENTRY POINTS TO THE TWO-ARGUMENT OPERATIONS HAVE BOTH ARGUMENTS
SETUP IN THE RESPECTIVE REGISTERS. BEFORE CALLING ARG MAY HAVE BEEN
POPPED OFF THE STACK AND INTO ARG, FOR EXAMPLE.
THE OTHER ENTRY POINT ASSUMES [Y,A] POINTS TO THE ARGUMENT
SOMEWHERE IN MEMORY. IT IS UNPACKED INTO ARG BY "CONUPK".
ON THE STACK, THE SGN IS PUSHED ON FIRST, THE LO,MO,HO AND FINALLY EXP.
NOTE ALL THINGS ARE KEPT UNPACKED IN ARG, FAC AND ON THE STACK.
IT IS ONLY WHEN SOMETHING IS STORED AWAY THAT IT IS PACKED TO FOUR
BYTES. THE UNPACKED FORMAT HAS A SGN BYTE REFLECTING THE SIGN OF THE
NUMBER (POSITIVE=0, NEGATIVE=-1) A HO,MO AND LO WITH THE HIGH BIT
OF THE HO TURNED ON. THE EXP IS THE SAME AS STORED FORMAT.
THIS IS DONE FOR SPEED OF OPERATION.
%
PAGE

FLOATING POINT ADDITION AND SUBTRACTION.

Rücksprung

Arithmetik-Routinen

FAC = FAC + 0.5

add 0.5 to FAC1 (round FAC1)

ADD 0.5 TO FAC

 

add 0.5 to float accu (rounding)

.,B849 A9 11 LDA #$11 FADDH: LDWDI FHALF ;ENTRY TO ADD 1/2.
Zeiger auf
set 0.5 pointer low byte
FAC+1/2 -> FAC
  low BF11
.,B84B A0 BF LDY #$BF   Konstante 0.5
set 0.5 pointer high byte
    high BF11
.,B84D 4C 67 B8 JMP $B867 JMP FADD ;UNPACK AND GO ADD IT.
FAC = FAC + Konstante (A/Y)

Minus FAC = Konstante

(A/Y) - FAC

add (AY) to FAC1

perform subtraction, FAC1 from (AY)

FAC = (Y,A) - FAC

 

minus operator

.,B850 20 8C BA JSR $BA8C FSUB: JSR CONUPK ;UNPACK ARGUMENT INTO ARG.
Konstante (A/Y) nach ARG

Minus FAC = ARG - FAC

unpack memory (AY) into FAC2

perform subtraction, FAC1 from FAC2

FAC = ARG - FAC

   
.,B853 A5 66 LDA $66 FSUBT: LDA FACSGN
Die
get FAC1 sign (b7)
COMPLEMENT FAC AND ADD
   
.,B855 49 FF EOR #$FF EORI 377 ;COMPLEMENT IT.
Vorzeichen
complement it
     
.,B857 85 66 STA $66 STA FACSGN
umdrehen
save FAC1 sign (b7)
     
.,B859 45 6E EOR $6E EOR ARGSGN ;COMPLEMENT ARISGN.
mit Vorzeichen von FAC
EOR with FAC2 sign (b7)
FIX SGNCPR TOO
   
.,B85B 85 6F STA $6F STA ARISGN
verknüpfen
save sign compare (FAC1 EOR FAC2)
     
.,B85D A5 61 LDA $61 LDA FACEXP ;SET CODES ON FACEXP.
Exponent von FAC
get FAC1 exponent
MAKE STATUS SHOW FAC EXPONENT
   
.,B85F 4C 6A B8 JMP $B86A JMP FADDT ;[Y]=ARGEXP..
XLIST
.XCREF
IFN REALIO-3,<ZSTORDO=STORDO>
IFE REALIO-3,<
ZSTORD:! LDA POKER
CMPI 146
BNE STORDO
LDA POKER+1
SBCI 31
BNE STORDO
STA POKER
TAY
LDAI 200
STA POKER+1
MRCHKR: LDXI 12
IF1,<
MRCHR: LDA 60000,X,>
IF2,<
MRCHR: LDA SINCON+36,X,>
ANDI 77
STADY POKER
INY
BNE PKINC
INC POKER+1
PKINC: DEX
BNE MRCHR
DEC ANDMSK
BNE MRCHKR
RTS
IF2,<PURGE ZSTORD>>
.CREF
LIST
FAC = FAC + ARG
add FAC2 to FAC1 and return
JOIN FADD

SHIFT SMALLER ARGUMENT MORE THAN 7 BITS

   
.,B862 20 99 B9 JSR $B999 FADD5: JSR SHIFTR ;DO A LONG SHIFT.
Exponenten von FAC und ARG
shift FACX A times right (>8 shifts)
ALIGN RADIX BY SHIFTING
   
.,B865 90 3C BCC $B8A3 BCC FADD4 ;CONTINUE WITH ADDITION.
angleichen

Plus FAC = Konstante (A/Y) +

FAC

go subtract mantissas

add (AY) to FAC1

...ALWAYS

FAC = (Y,A) + FAC

 

add float indexed by AY to float accu

.,B867 20 8C BA JSR $BA8C FADD: JSR CONUPK
Konstante (A/Y) nach ARG

Plus FAC = FAC + ARG

unpack memory (AY) into FAC2

add FAC2 to FAC1

FAC = ARG + FAC

 

plus operator

.,B86A D0 03 BNE $B86F FADDT: JEQ MOVFA ;IF FAC=0, RESULT IS IN ARG.
FAC ungleich null ?
branch if FAC1 is not zero
FAC IS NON-ZERO
   
.,B86C 4C FC BB JMP $BBFC   nein, dann FAC = ARG
FAC1 was zero so copy FAC2 to FAC1 and return
FAC1 is non zero
FAC = 0 + ARG
   
.,B86F A6 70 LDX $70 LDX FACOV
Rundungsbyte für FAC
get FAC1 rounding byte
     
.,B871 86 56 STX $56 STX OLDOV
in $56 speichern
save as FAC2 rounding byte
     
.,B873 A2 69 LDX #$69 LDXI ARGEXP ;DEFAULT IS SHIFT ARGUMENT.
Offset-Zeiger für ARG laden
set index to FAC2 exponent address
SET UP TO SHIFT ARG
   
.,B875 A5 69 LDA $69 LDA ARGEXP ;IF ARG=0, FAC IS RESULT.
Exponent von ARG laden
get FAC2 exponent
EXPONENT
   
.,B877 A8 TAY FADDC: TAY ;ALSO COPY ACCA INTO ACCY.
in Y-Reg schieben
copy exponent
     
.,B878 F0 CE BEQ $B848 BEQ ZERRTS ;RETURN.
wenn ARG=0, dann RTS
exit if zero
IF ARG=0, WE ARE FINISHED
   
.,B87A 38 SEC SEC
Exponent von
set carry for subtract
     
.,B87B E5 61 SBC $61 SBC FACEXP
FAC subtrahieren
subtract FAC1 exponent
GET DIFFNCE OF EXP
   
.,B87D F0 24 BEQ $B8A3 BEQ FADD4 ;NO SHIFTING.
wenn Exponent gleich, dann zu
$B8A3
if equal go add mantissas
GO ADD IF SAME EXP
   
.,B87F 90 12 BCC $B893 BCC FADDA ;BR IF ARGEXP.LT.FACEXP.
wenn Exponent von FAC größer,
dann zu $B893
if FAC2 < FAC1 then go shift FAC2 right
else FAC2 > FAC1
ARG HAS SMALLER EXPONENT
   
.,B881 84 61 STY $61 STY FACEXP ;RESULTING EXPONENT.
FAC-Exponent durch
ARG-Vorzeichen ersetzen
save FAC1 exponent
EXP HAS SMALLER EXPONENT
   
.,B883 A4 6E LDY $6E LDY ARGSGN ;SINCE ARG IS BIGGER, IT'S
FAC-Vorzeichen durch
get FAC2 sign (b7)
     
.,B885 84 66 STY $66 STY FACSGN ;SIGN IS SIGN OF RESULT.
ARG-Vorzeichen ersetzen
save FAC1 sign (b7)
     
.,B887 49 FF EOR #$FF EORI 377 ;SHIFT A NEGATIVE NUMBER OF PLACES.
Vorzeichen wechseln
complement A
COMPLEMENT SHIFT COUNT
   
.,B889 69 00 ADC #$00 ADCI 0 ;COMPLETE NEGATION. W/ C=1.
Carry ist schon 1
+1, twos complement, carry is set
CARRY WAS SET
   
.,B88B A0 00 LDY #$00 LDYI 0 ;ZERO OLDOV.
Rundungsstelle
clear Y
     
.,B88D 84 56 STY $56 STY OLDOV
löschen
clear FAC2 rounding byte
     
.,B88F A2 61 LDX #$61 LDXI FAC ;SHIFT THE FAC INSTEAD.
Offset-Zeiger für FAC laden
set index to FAC1 exponent address
SET UP TO SHIFT FAC
   
.,B891 D0 04 BNE $B897 BNE FADD1
unbedingter Sprung
branch always
FAC2 < FAC1
...ALWAYS
   
.,B893 A0 00 LDY #$00 FADDA: LDYI 0
FAC-Rundungsstelle
clear Y
     
.,B895 84 70 STY $70 STY FACOV
löschen
clear FAC1 rounding byte
     
.,B897 C9 F9 CMP #$F9 FADD1: CMPI ^D256-7 ;FOR SPEED AND NECESSITY. GETS
;MOST LIKELY CASE TO SHIFTR FASTEST
;AND ALLOWS SHIFTING OF NEG NUMS
;BY "QINT".
wenn Exponentdifferenz
compare exponent diff with $F9
SHIFT MORE THAN 7 BITS?
   
.,B899 30 C7 BMI $B862 BMI FADD5 ;SHIFT BIG.
größer als 7, dann zu $B862
branch if range $79-$F8
YES
   
.,B89B A8 TAY TAY
Akku löschen
copy exponent difference to Y
INDEX TO # OF SHIFTS
   
.,B89C A5 70 LDA $70 LDA FACOV ;SET FACOV.
FAC-Rundungsstelle
get FAC1 rounding byte
     
.,B89E 56 01 LSR $01,X LSR 1,X, ;GETS 0 IN MOST SIG BIT.
laden
shift FAC? mantissa 1
START SHIFTING...
   
.,B8A0 20 B0 B9 JSR $B9B0 JSR ROLSHF ;DO THE ROLLING.
Mantisse verschieben
shift FACX Y times right
exponents are equal now do mantissa subtract
...COMPLETE SHIFTING
   
.,B8A3 24 6F BIT $6F FADD4: BIT ARISGN ;GET RESULTING SIGN.
wenn FAC- und ARG-Vorzeichen
test sign compare (FAC1 EOR FAC2)
DO FAC AND ARG HAVE SAME SIGNS?
   
.,B8A5 10 57 BPL $B8FE BPL FADD2 ;IF POSITIVE, ADD.
;CARRY IS CLEAR.
identisch, dann zu $B8FE
if = add FAC2 mantissa to FAC1 mantissa and return
YES, ADD THE MANTISSAS
   
.,B8A7 A0 61 LDY #$61 FADD3: LDYI FACEXP
Offset-Zeiger für FAC laden
set the Y index to FAC1 exponent address
NO, SUBTRACT SMALLER FROM LARGER
   
.,B8A9 E0 69 CPX #$69 CPXI ARGEXP ;FAC IS BIGGER.
wenn Offset-Zeiger für ARG
compare X to FAC2 exponent address
WHICH WAS ADJUSTED?
   
.,B8AB F0 02 BEQ $B8AF BEQ SUBIT
initialisiert, dann zu $B8AF
if = continue, Y = FAC1, X = FAC2
IF ARG, DO FAC-ARG
   
.,B8AD A0 69 LDY #$69 LDYI ARGEXP ;ARG IS BIGGER.
Offset-Zeiger laden
else set the Y index to FAC2 exponent address
subtract the smaller from the bigger (take the sign of
the bigger)
IF FAC, DO ARG-FAC
   
.,B8AF 38 SEC SUBIT: SEC
Carryflag für Subtraktion
setzen
set carry for subtract
SUBTRACT SMALLER FROM LARGER (WE HOPE)
   
.,B8B0 49 FF EOR #$FF EORI 377
Alle Bits umdrehen
ones complement A
(IF EXPONENTS WERE EQUAL, WE MIGHT BE
   
.,B8B2 65 56 ADC $56 ADC OLDOV
Rundungsstelle addieren
add FAC2 rounding byte
SUBTRACTING LARGER FROM SMALLER)
   
.,B8B4 85 70 STA $70 STA FACOV
und speichern
save FAC1 rounding byte
     
.,B8B6 B9 04 00 LDA $0004,Y LDA 3+ADDPRC,Y
viertes Byte
get FACY mantissa 4
     
.,B8B9 F5 04 SBC $04,X SBC 3+ADDPRC,X
subtrahieren und in
subtract FACX mantissa 4
     
.,B8BB 85 65 STA $65 STA FACLO
FAC speichern
save FAC1 mantissa 4
     
.,B8BD B9 03 00 LDA $0003,Y LDA 2+ADDPRC,Y
drittes Byte
get FACY mantissa 3
     
.,B8C0 F5 03 SBC $03,X SBC 2+ADDPRC,X
subtrahieren und in
subtract FACX mantissa 3
     
.,B8C2 85 64 STA $64 STA FACMO
IFN ADDPRC,<
FAC speichern
save FAC1 mantissa 3
     
.,B8C4 B9 02 00 LDA $0002,Y LDA 2,Y
zweites Byte
get FACY mantissa 2
     
.,B8C7 F5 02 SBC $02,X SBC 2,X
subtrahieren und in
subtract FACX mantissa 2
     
.,B8C9 85 63 STA $63 STA FACMOH>
FAC speichern
save FAC1 mantissa 2
     
.,B8CB B9 01 00 LDA $0001,Y LDA 1,Y
erstes Byte
get FACY mantissa 1
     
.,B8CE F5 01 SBC $01,X SBC 1,X
subtrahieren und in
subtract FACX mantissa 1
     
.,B8D0 85 62 STA $62 STA FACHO
FAC speichern
save FAC1 mantissa 1

do ABS and normalise FAC1

NORMALIZE VALUE IN FAC

   
.,B8D2 B0 03 BCS $B8D7 FADFLT: BCS NORMAL ;HERE IF SIGNS DIFFER. IF CARRY,
;FAC IS SET OK.
wenn Übertrag negativ, dann
weiter
branch if number is +ve
     
.,B8D4 20 47 B9 JSR $B947 JSR NEGFAC ;NEGATE [FAC].
Mantisse von FAC invertieren
negate FAC1

normalise FAC1

     
.,B8D7 A0 00 LDY #$00 NORMAL: LDYI 0
Y-Reg und
clear Y
SHIFT UP SIGNIF DIGIT
   
.,B8D9 98 TYA TYA
Akku löschen
clear A
START A=0, COUNT SHIFTS IN A-REG
   
.,B8DA 18 CLC CLC
Carry löschen
clear carry for add
     
.,B8DB A6 62 LDX $62 NORM3: LDX FACHO
wenn $62=0 dann,
get FAC1 mantissa 1
LOOK AT MOST SIGNIFICANT BYTE
   
.,B8DD D0 4A BNE $B929 BNE NORM1
zu $B929
if not zero normalise FAC1
SOME 1-BITS HERE
   
.,B8DF A6 63 LDX $63 LDX FACHO+1 ;SHIFT 8 BITS AT A TIME FOR SPEED.
Das
get FAC1 mantissa 2
HI-BYTE OF MANTISSA STILL ZERO,
   
.,B8E1 86 62 STX $62 STX FACHO
IFN ADDPRC,<
gesamte
save FAC1 mantissa 1
SO DO A FAST 8-BIT SHUFFLE
   
.,B8E3 A6 64 LDX $64 LDX FACMOH+1
FAC
get FAC1 mantissa 3
     
.,B8E5 86 63 STX $63 STX FACMOH>
wieder
save FAC1 mantissa 2
     
.,B8E7 A6 65 LDX $65 LDX FACMO+1
norma-
get FAC1 mantissa 4
     
.,B8E9 86 64 STX $64 STX FACMO
lisieren
save FAC1 mantissa 3
     
.,B8EB A6 70 LDX $70 LDX FACOV
Rundungsstelle
get FAC1 rounding byte
     
.,B8ED 86 65 STX $65 STX FACLO
wieder
save FAC1 mantissa 4
     
.,B8EF 84 70 STY $70 STY FACOV
löschen
clear FAC1 rounding byte
ZERO EXTENSION BYTE
   
.,B8F1 69 08 ADC #$08 ADCI 10
Zähler um 8 Bits verschieben
add x to exponent offset
BUMP SHIFT COUNT
   
.,B8F3 C9 20 CMP #$20 CMPI 10*ADDPRC+30
wenn 32 Bits verschoben,
compare with $20, max offset, all bits would be = 0
DONE 4 TIMES YET?
   
.,B8F5 D0 E4 BNE $B8DB BNE NORM3
dann weiter
loop if not max

clear FAC1 exponent and sign

NO, STILL MIGHT BE SOME 1'S
YES, VALUE OF FAC IS ZERO

SET FAC = 0

(ONLY NECESSARY TO ZERO EXPONENT AND SIGN CELLS)
   
.,B8F7 A9 00 LDA #$00 ZEROFC: LDAI 0 ;NOT NEED BY NORMAL BUT BY OTHERS.
Mantisse =0
clear A
     
.,B8F9 85 61 STA $61 ZEROF1: STA FACEXP ;NUMBER MUST BE ZERO.
FAC =0
set FAC1 exponent

save FAC1 sign

     
.,B8FB 85 66 STA $66 ZEROML: STA FACSGN ;MAKE SIGN POSITIVE.
Exponent =0
save FAC1 sign (b7)
     
.,B8FD 60 RTS RTS ;ALL DONE.
Rücksprung

add FAC2 mantissa to FAC1 mantissa

ADD MANTISSAS OF FAC AND ARG INTO FAC

 

add fractions

.,B8FE 65 56 ADC $56 FADD2: ADC OLDOV
Rundungsstelle addieren
add FAC2 rounding byte
     
.,B900 85 70 STA $70 STA FACOV
und speichern
save FAC1 rounding byte
     
.,B902 A5 65 LDA $65 LDA FACLO
FAC
get FAC1 mantissa 4
     
.,B904 65 6D ADC $6D ADC ARGLO
und ARG
add FAC2 mantissa 4
     
.,B906 85 65 STA $65 STA FACLO
addieren
save FAC1 mantissa 4
     
.,B908 A5 64 LDA $64 LDA FACMO
FAC
get FAC1 mantissa 3
     
.,B90A 65 6C ADC $6C ADC ARGMO
und ARG
add FAC2 mantissa 3
     
.,B90C 85 64 STA $64 STA FACMO
IFN ADDPRC,<
addieren
save FAC1 mantissa 3
     
.,B90E A5 63 LDA $63 LDA FACMOH
FAC
get FAC1 mantissa 2
     
.,B910 65 6B ADC $6B ADC ARGMOH
und ARG
add FAC2 mantissa 2
     
.,B912 85 63 STA $63 STA FACMOH>
addieren
save FAC1 mantissa 2
     
.,B914 A5 62 LDA $62 LDA FACHO
FAC
get FAC1 mantissa 1
     
.,B916 65 6A ADC $6A ADC ARGHO
und ARG
add FAC2 mantissa 1
     
.,B918 85 62 STA $62 STA FACHO
addieren
save FAC1 mantissa 1
     
.,B91A 4C 36 B9 JMP $B936 JMP SQUEEZ ;GO ROUND IF SIGNS SAME.
Überlaufbit in Mantisse
zurückshiften
test and normalise FAC1 for C=0/1

FINISH NORMALIZING FAC

 

postshift

.,B91D 69 01 ADC #$01 NORM2: ADCI 1 ;DECREMENT SHIFT COUNT.
Zähler erhöhen
add 1 to exponent offset
COUNT BITS SHIFTED
   
.,B91F 06 70 ASL $70 ASL FACOV ;SHIFT ALL LEFT ONE BIT.
FAC solange
shift FAC1 rounding byte
     
.,B921 26 65 ROL $65 ROL FACLO
nach links
shift FAC1 mantissa 4
     
.,B923 26 64 ROL $64 ROL FACMO
IFN ADDPRC,<
verschieben bis das
shift FAC1 mantissa 3
     
.,B925 26 63 ROL $63 ROL FACMOH>
Bit 7
shift FAC1 mantissa 2
     
.,B927 26 62 ROL $62 ROL FACHO
gesetzt ist
shift FAC1 mantissa 1
normalise FAC1
     
.,B929 10 F2 BPL $B91D NORM1: BPL NORM2 ;IF MSB=0 SHIFT AGAIN.
nicht gesetzt ? dann nochmal
loop if not normalised
UNTIL TOP BIT = 1
   
.,B92B 38 SEC SEC
wenn Binärexponent kleiner
set carry for subtract
     
.,B92C E5 61 SBC $61 SBC FACEXP
als die Anzahl der
subtract FAC1 exponent
ADJUST EXPONENT BY BITS SHIFTED
   
.,B92E B0 C7 BCS $B8F7 BCS ZEROFC
Verschiebungen, dann wird die
Zahl als Null behandelt
branch if underflow (set result = $0)
UNDERFLOW, RETURN ZERO
   
.,B930 49 FF EOR #$FF EORI 377
Exponent um
complement exponent
     
.,B932 69 01 ADC #$01 ADCI 1 ;COMPLEMENT.
Verschiebungsanzahl
+1 (twos complement)
2'S COMPLEMENT
   
.,B934 85 61 STA $61 STA FACEXP
vermindern
save FAC1 exponent
test and normalise FAC1 for C=0/1
CARRY=0 NOW
   
.,B936 90 0E BCC $B946 SQUEEZ: BCC RNDRTS ;BITS TO SHIFT?
Carry gesetzt, nein dann RTS
exit if no overflow
normalise FAC1 for C=1
UNLESS MANTISSA CARRIED
   
.,B938 E6 61 INC $61 RNDSHF: INC FACEXP
Exponent erhöhen
increment FAC1 exponent
MANTISSA CARRIED, SO SHIFT RIGHT
   
.,B93A F0 42 BEQ $B97E BEQ OVERR
wenn Überlauf in Exponent,
dann 'OVERFLOW ERROR'
if zero do overflow error then warm start
OVERFLOW IF EXPONENT TOO BIG
   
.,B93C 66 62 ROR $62 ROR FACHO
IFN ADDPRC,<
Überlaufbit in Carry schieben
shift FAC1 mantissa 1
     
.,B93E 66 63 ROR $63 ROR FACMOH>
Das Carry-Flag
shift FAC1 mantissa 2
     
.,B940 66 64 ROR $64 ROR FACMO
erhält die
shift FAC1 mantissa 3
     
.,B942 66 65 ROR $65 ROR FACLO
Position des
shift FAC1 mantissa 4
     
.,B944 66 70 ROR $70 ROR FACOV
höchstwertigen Bits
shift FAC1 rounding byte
     
.,B946 60 RTS RNDRTS: RTS ;ALL DONE ADDING.
Rücksprung

Mantisse von FAC invertieren

negate FAC1

2'S COMPLEMENT OF FAC

 

negate float accu

.,B947 A5 66 LDA $66 NEGFAC: COM FACSGN ;COMPLEMENT FAC ENTIRELY.
FAC Vorzeichen
get FAC1 sign (b7)
     
.,B949 49 FF EOR #$FF   invertieren
complement it
     
.,B94B 85 66 STA $66   und speichern
save FAC1 sign (b7)
twos complement FAC1 mantissa

2'S COMPLEMENT OF FAC MANTISSA ONLY

   
.,B94D A5 62 LDA $62 NEGFCH: COM FACHO ;COMPLEMENT JUST THE NUMBER.
FAC
get FAC1 mantissa 1
     
.,B94F 49 FF EOR #$FF   invertieren
complement it
     
.,B951 85 62 STA $62 IFN ADDPRC,<
und speichern
save FAC1 mantissa 1
     
.,B953 A5 63 LDA $63 COM FACMOH>
FAC
get FAC1 mantissa 2
     
.,B955 49 FF EOR #$FF   invertieren
complement it
     
.,B957 85 63 STA $63   und speichern
save FAC1 mantissa 2
     
.,B959 A5 64 LDA $64 COM FACMO
FAC
get FAC1 mantissa 3
     
.,B95B 49 FF EOR #$FF   invertieren
complement it
     
.,B95D 85 64 STA $64   und speichern
save FAC1 mantissa 3
     
.,B95F A5 65 LDA $65 COM FACLO
FAC
get FAC1 mantissa 4
     
.,B961 49 FF EOR #$FF   invertieren
complement it
     
.,B963 85 65 STA $65   und speichern
save FAC1 mantissa 4
     
.,B965 A5 70 LDA $70 COM FACOV
FAC-Rundungsbyte
get FAC1 rounding byte
     
.,B967 49 FF EOR #$FF   invertieren
complement it
     
.,B969 85 70 STA $70   und speichern
save FAC1 rounding byte
     
.,B96B E6 70 INC $70 INC FACOV
Mantisse erhöhen
increment FAC1 rounding byte
START INCREMENTING MANTISSA
   
.,B96D D0 0E BNE $B97D BNE INCFRT
nicht Null? dann RTS
exit if no overflow
increment FAC1 mantissa

INCREMENT FAC MANTISSA

 

increment fraction

.,B96F E6 65 INC $65 INCFAC: INC FACLO
FAC erhöhen
increment FAC1 mantissa 4
ADD CARRY FROM EXTRA
   
.,B971 D0 0A BNE $B97D BNE INCFRT
nicht Null? dann RTS
finished if no rollover
     
.,B973 E6 64 INC $64 INC FACMO
FAC erhöhen
increment FAC1 mantissa 3
     
.,B975 D0 06 BNE $B97D BNE INCFRT ;IF NO CARRY, RETURN.
IFN ADDPRC,<
nicht Null? dann RTS
finished if no rollover
     
.,B977 E6 63 INC $63 INC FACMOH
FAC erhöhen
increment FAC1 mantissa 2
     
.,B979 D0 02 BNE $B97D BNE INCFRT>
nicht Null? dann RTS
finished if no rollover
     
.,B97B E6 62 INC $62 INC FACHO ;CARRY INCREMENT.
FAC erhöhen
increment FAC1 mantissa 1
     
.,B97D 60 RTS INCFRT: RTS
Rücksprung

do overflow error then warm start

     
.,B97E A2 0F LDX #$0F OVERR: LDXI ERROV
Nummer für 'OVERFLOW'
error $0F, overflow error
    error number
.,B980 4C 37 A4 JMP $A437 JMP ERROR ;TELL USER.
;
; "SHIFTR" SHIFTS [X+1:X+3] [-ACCA] BITS RIGHT.
; SHIFTS BYTES TO START WITH IF POSSIBLE.
;
Fehlermeldung ausgeben

Rechtsverschieben eines

Registers

do error #X then warm start

shift FCAtemp << A+8 times

SHIFT 1,X THRU 5,X RIGHT

(A) = NEGATIVE OF SHIFT COUNT
(X) = POINTER TO BYTES TO BE SHIFTED
RETURN WITH (Y)=0, CARRY=0, EXTENSION BITS IN A-REG
 

preshift

.,B983 A2 25 LDX #$25 MULSHF: LDXI RESHO-1 ;ENTRY POINT FOR MULTIPLIER.
Offset-Zeiger auf Register
set the offset to FACtemp
SHIFT RESULT RIGHT
   
.,B985 B4 04 LDY $04,X SHFTR2: LDY 3+ADDPRC,X, ;SHIFT BYTES FIRST.
FAC-
get FACX mantissa 4
SHIFT 8 BITS RIGHT
   
.,B987 84 70 STY $70 STY FACOV
IFN ADDPRC,<
Rundungsbyte
save as FAC1 rounding byte
     
.,B989 B4 03 LDY $03,X LDY 3,X
1 mal
get FACX mantissa 3
     
.,B98B 94 04 STY $04,X STY 4,X>
verschieben
save FACX mantissa 4
     
.,B98D B4 02 LDY $02,X LDY 2,X, ;GET MO.
2 mal
get FACX mantissa 2
     
.,B98F 94 03 STY $03,X STY 3,X, ;STORE LO.
verschieben
save FACX mantissa 3
     
.,B991 B4 01 LDY $01,X LDY 1,X, ;GET HO.
3 mal
get FACX mantissa 1
     
.,B993 94 02 STY $02,X STY 2,X, ;STORE MO.
verschieben
save FACX mantissa 2
     
.,B995 A4 68 LDY $68 LDY BITS
FAC-
get FAC1 overflow byte
$00 IF +, $FF IF -
   
.,B997 94 01 STY $01,X STY 1,X, ;STORE HO.
Rundungsbyte
save FACX mantissa 1
shift FACX -A times right (> 8 shifts)

MAIN ENTRY TO RIGHT SHIFT SUBROUTINE

   
.,B999 69 08 ADC #$08 SHIFTR: ADCI 10
Zähler um 8 erhöhen
add 8 to shift count
     
.,B99B 30 E8 BMI $B985 BMI SHFTR2
größer als 0?
go do 8 shift if still -ve
STILL MORE THAN 8 BITS TO GO
   
.,B99D F0 E6 BEQ $B985 BEQ SHFTR2
wenn nicht, dann weiter
verschieben
go do 8 shift if zero
EXACTLY 8 MORE BITS TO GO
   
.,B99F E9 08 SBC #$08 SBCI 10 ;C CAN BE EITHER 1,0 AND IT WORKS.
Zähler um 8 vermindern
else subtract 8 again
UNDO ADC ABOVE
   
.,B9A1 A8 TAY TAY
Zähler sichern
save count to Y
REMAINING SHIFT COUNT
   
.,B9A2 A5 70 LDA $70 LDA FACOV
FAC-Rundungsbyte laden
get FAC1 rounding byte
     
.,B9A4 B0 14 BCS $B9BA BCS SHFTRT ;EQUIV TO BEQ HERE.
IFN RORSW,<
wenn Null, dann CLC, RTS
  FINISHED SHIFTING
   
.,B9A6 16 01 ASL $01,X SHFTR3: ASL 1,X
höchstwertiges Bit =1?,
shift FACX mantissa 1
SIGN -> CARRY (SIGN EXTENSION)
   
.,B9A8 90 02 BCC $B9AC BCC SHFTR4
wenn nicht, dann zu $B9AC
branch if +ve
SIGN +
   
.,B9AA F6 01 INC $01,X INC 1,X
höchste Mantissenstelle
erhöhen
this sets b7 eventually
PUT SIGN IN LSB
   
.,B9AC 76 01 ROR $01,X SHFTR4: ROR 1,X
sämtliche
shift FACX mantissa 1 (correct for ASL)
RESTORE VALUE, SIGN STILL IN CARRY
   
.,B9AE 76 01 ROR $01,X ROR 1,X> ;YES, TWO OF THEM.
IFE RORSW,<
SHFTR3: PHA
LDA 1,X
ANDI 200
LSR 1,X
ORA 1,X
STA 1,X
SKIP1>
ROLSHF:
IFN RORSW,<
Stellen
shift FACX mantissa 1 (put carry in b7)
shift FACX Y times right
START RIGHT SHIFT, INSERTING SIGN

ENTER HERE FOR SHORT SHIFTS WITH NO SIGN EXTENSION

   
.,B9B0 76 02 ROR $02,X ROR 2,X
um ein
shift FACX mantissa 2
     
.,B9B2 76 03 ROR $03,X ROR 3,X
Bit nach
shift FACX mantissa 3
     
.,B9B4 76 04 ROR $04,X IFN ADDPRC,< ROR 4,X> ;ONE MO TIME.
>
IFE RORSW,<
PHA
LDAI 0
BCC SHFTR5
LDAI 200
SHFTR5: LSR 2,X
ORA 2,X
STA 2,X
LDAI 0
BCC SHFTR6
LDAI 200
SHFTR6: LSR 3,X
ORA 3,X
STA 3,X
IFN ADDPRC,<
LDAI 0
BCC SHFT6A
LDAI 200
SHFT6A: LSR 4,X
ORA 4,X
STA 4,X>>
rechts
shift FACX mantissa 4
     
.,B9B6 6A ROR IFN RORSW,<ROR A,> ;ROTATE ARGUMENT 1 BIT RIGHT.
IFE RORSW,<
PLA
PHP
LSR A,
PLP
BCC SHFTR7
ORAI 200>
verschieben
shift FACX rounding byte
EXTENSION
   
.,B9B7 C8 INY SHFTR7: INY
Zähler um eins erhöhen
increment exponent diff
COUNT THE SHIFT
   
.,B9B8 D0 EC BNE $B9A6 BNE SHFTR3 ;$$$ ( MOST EXPENSIVE ! )
verschieben bis Zähler =0
branch if range adjust not complete
     
.,B9BA 18 CLC SHFTRT: CLC ;CLEAR OUTPUT OF FACOV.
Carry löschen
just clear it
RETURN WITH CARRY CLEAR
   
.,B9BB 60 RTS RTS
PAGE

NATURAL LOG FUNCTION.

;
; CALCULATION IS BY:
; LN(F*2^N)=(N+LOG2(F))*LN(2)
; AN APPROXIMATION POLYNOMIAL IS USED TO CALCULATE LOG2(F).
; CONSTANTS USED BY LOG:
Rücksprung

Konstanten für LOG

constants and series for LOG(n)

   

1

.:B9BC 81 00 00 00 00 FONE: 201 ; 1.0
000
000
000
IFN ADDPRC,<0>
IFE ADDPRC,<
LOGCN2: 2 ; DEGREE-1
200 ; 0.59897437
031
126
142
200 ; 0.96147080
166
042
363
202 ; 2.88539129
070
252
100>
IFN ADDPRC,<
1
1
   

LOG polynomial table

.:B9C1 03 LOGCN2: 3 ;DEGREE-1
3 = Polynomgrad, dann 4
Koeffizienten
series counter
# OF COEFFICIENTS - 1
  degree 4
.:B9C2 7F 5E 56 CB 79 177 ;.43425594188
136
126
313
171
.434255942
.434255942
X^7 +
   
.:B9C7 80 13 9B 0B 64 200 ; .57658454134
023
233
013
144
.576584541
.576584541
X^5 +
   
.:B9CC 80 76 38 93 16 200 ; .96180075921
166
070
223
026
.961800759
.961800759
X^3 +
   
.:B9D1 82 38 AA 3B 20 202 ; 2.8853900728
070
252
073
040>
2.88539007
2.88539007
X
 

0,5 * SQR(2)

.:B9D6 80 35 04 F3 34 SQRHLF: 200 ; SQR(0.5)
065
004
363
IFN ADDPRC,<064>
.707106781 = 1/SQR(2)
.707106781 = 1/SQR(2)
SQR(1/2)
 

SQR(2)

.:B9DB 81 35 04 F3 34 SQRTWO: 201 ; SQR(2.0)
065
004
363
IFN ADDPRC,<064>
1.41421356 = SQR(2)
1.41421356 = SQR(2)
SQR(TWO)
 

-0.5

.:B9E0 80 80 00 00 00 NEGHLF: 200 ; -1/2
200
000
000
IFN ADDPRC,<0>
-.5
-.5
-1/2
 

LOG(2)

.:B9E5 80 31 72 17 F8 LOG2: 200 ; LN(2)
061
162
IFE ADDPRC,<030>
IFN ADDPRC,<027
370>
.693147181 = LOG(2)

BASIC-Funktion LOG

.693147181 = LOG(2)

perform LOG()

LOG(2)

"LOG" FUNCTION

 

LOG function

.,B9EA 20 2B BC JSR $BC2B LOG: JSR SIGN ;IS IT POSITIVE?
Vorzeichen holen
test sign and zero
GET -1,0,+1 IN A-REG FOR FAC
   
.,B9ED F0 02 BEQ $B9F1 BEQ LOGERR
null ?, dann fertig
if zero do illegal quantity error then warm start
LOG (0) IS ILLEGAL
   
.,B9EF 10 03 BPL $B9F4 BPL LOG1
positiv ?, dann ok
skip error if +ve
>0 IS OK
   
.,B9F1 4C 48 B2 JMP $B248 LOGERR: JMP FCERR ;CAN'T TOLERATE NEG OR ZERO.
'ILLEGAL QUANTITY'
do illegal quantity error then warm start
<= 0 IS NO GOOD
   
.,B9F4 A5 61 LDA $61 LOG1: LDA FACEXP ;GET EXPONENT INTO ACCA.
Exponent
get FAC1 exponent
FIRST GET LOG BASE 2
   
.,B9F6 E9 7F SBC #$7F SBCI 177 ;REMOVE BIAS. (CARRY IS OFF)
normalisieren
normalise it
SAVE UNBIASED EXPONENT
   
.,B9F8 48 PHA PHA ;SAVE AWHILE.
und merken
save it
     
.,B9F9 A9 80 LDA #$80 LDAI 200
Zahl in Bereich 0.5 bis 1
set exponent to zero
NORMALIZE BETWEEN .5 AND 1
   
.,B9FB 85 61 STA $61 STA FACEXP ;RESULT IS FAC IN RANGE [0.5,1].
bringen
save FAC1 exponent
     
.,B9FD A9 D6 LDA #$D6 LDWDI SQRHLF ;GET POINTER TO SQR(0.5).
Zeiger auf
pointer to 1/root 2 low byte
    low B9D6
.,B9FF A0 B9 LDY #$B9 ; CALCULATE (F-SQR(.5))/(F+SQR(.5))
Konstante 1/SQR(2)
pointer to 1/root 2 high byte
    high B9D6
.,BA01 20 67 B8 JSR $B867 JSR FADD ;ADD TO FAC.
zu FAC addieren
add (AY) to FAC1 (1/root2)
COMPUTE VIA SERIES OF ODD
   
.,BA04 A9 DB LDA #$DB LDWDI SQRTWO ;GET SQR(2.).
Zeiger auf
pointer to root 2 low byte
POWERS OF
  low B9DB
.,BA06 A0 B9 LDY #$B9   Konstante SQR(2)
pointer to root 2 high byte
(SQR(2)X-1)/(SQR(2)X+1)
  high B9DB
.,BA08 20 0F BB JSR $BB0F JSR FDIV
SQR(2) durch FAC dividieren
convert AY and do (AY)/FAC1 (root2/(x+(1/root2)))
     
.,BA0B A9 BC LDA #$BC LDWDI FONE
Zeiger
pointer to 1 low byte
    low B9BC
.,BA0D A0 B9 LDY #$B9   auf Konstante 1
pointer to 1 high byte
    high B9BC
.,BA0F 20 50 B8 JSR $B850 JSR FSUB
1 minus FAC
subtract FAC1 ((root2/(x+(1/root2)))-1) from (AY)
     
.,BA12 A9 C1 LDA #$C1 LDWDI LOGCN2
Zeiger auf
pointer to series for LOG(n) low byte
    low B9C1
.,BA14 A0 B9 LDY #$B9   Polynomkoeffizienten
pointer to series for LOG(n) high byte
    high B9C1
.,BA16 20 43 E0 JSR $E043 JSR POLYX ;EVALUATE APPROXIMATION POLYNOMIAL.
Polynomberechnung
^2 then series evaluation
     
.,BA19 A9 E0 LDA #$E0 LDWDI NEGHLF ;ADD IN LAST CONSTANT.
Zeiger auf
pointer to -0.5 low byte
    low B9E0
.,BA1B A0 B9 LDY #$B9   Konstante -0.5
pointer to -0.5 high byte
    high B9E0
.,BA1D 20 67 B8 JSR $B867 JSR FADD
zu FAC addieren
add (AY) to FAC1
     
.,BA20 68 PLA PLA ;GET EXPONENT BACK.
Exponent zurückholen
restore FAC1 exponent
     
.,BA21 20 7E BD JSR $BD7E JSR FINLOG ;ADD IT IN.
FAC = FAC + FAC
evaluate new ASCII digit
ADD ORIGINAL EXPONENT
   
.,BA24 A9 E5 LDA #$E5 MULLN2: LDWDI LOG2 ;MULTIPLY RESULT BY LOG(2.0).
Zeiger auf
pointer to LOG(2) low byte
MULTIPLY BY LOG(2) TO FORM
  low B9E5
.,BA26 A0 B9 LDY #$B9 ; JMP FMULT ;MULTIPLY TOGETHER.
PAGE

FLOATING MULTIPLICATION AND DIVISION.

;MULTIPLICATION FAC:=ARG*FAC.
Konstante LOG(2)

Multiplikation FAC =

Konstante (A/Y) * FAC

pointer to LOG(2) high byte

do convert AY, FCA1*(AY)

NATURAL LOG OF X

FAC = (Y,A) * FAC

  high B9E5
.,BA28 20 8C BA JSR $BA8C FMULT: JSR CONUPK ;UNPACK THE CONSTANT INTO ARG FOR USE.
Konstante nach ARG

Multiplikation FAC = ARG *

FAC

unpack memory (AY) into FAC2

FAC = ARG * FAC

 

times operator

.,BA2B D0 03 BNE $BA30 FMULTT: JEQ MULTRT ;IF FAC=0, RETURN. FAC IS SET.
nicht null ?
multiply FAC1 by FAC2 ??
FAC .NE. ZERO
   
.,BA2D 4C 8B BA JMP $BA8B   RTS
exit if zero
FAC = 0 * ARG = 0
   
.,BA30 20 B7 BA JSR $BAB7 JSR MULDIV ;FIX UP THE EXPONENTS.
Exponent berechnen
test and adjust accumulators
     
.,BA33 A9 00 LDA #$00 LDAI 0 ;TO CLEAR RESULT.
Alle
clear A
     
.,BA35 85 26 STA $26 STA RESHO
IFN ADDPRC,<
Funktions-
clear temp mantissa 1
INIT PRODUCT = 0
   
.,BA37 85 27 STA $27 STA RESMOH>
register
clear temp mantissa 2
     
.,BA39 85 28 STA $28 STA RESMO
lö-
clear temp mantissa 3
     
.,BA3B 85 29 STA $29 STA RESLO
schen
clear temp mantissa 4
     
.,BA3D A5 70 LDA $70 LDA FACOV
bitweise
get FAC1 rounding byte
     
.,BA3F 20 59 BA JSR $BA59 JSR MLTPLY
Multiplikation
go do shift/add FAC2
     
.,BA42 A5 65 LDA $65 LDA FACLO ;MLTPLY ARG BY FACLO.
bitweise
get FAC1 mantissa 4
     
.,BA44 20 59 BA JSR $BA59 JSR MLTPLY
Multiplikation
go do shift/add FAC2
     
.,BA47 A5 64 LDA $64 LDA FACMO ;MLTPLY ARG BY FACMO.
bitweise
get FAC1 mantissa 3
     
.,BA49 20 59 BA JSR $BA59 JSR MLTPLY
IFN ADDPRC,<
Multiplikation
go do shift/add FAC2
     
.,BA4C A5 63 LDA $63 LDA FACMOH
bitweise
get FAC1 mantissa 2
     
.,BA4E 20 59 BA JSR $BA59 JSR MLTPLY>
Multiplikation
go do shift/add FAC2
     
.,BA51 A5 62 LDA $62 LDA FACHO ;MLTPLY ARG BY FACHO.
bitweise
get FAC1 mantissa 1
     
.,BA53 20 5E BA JSR $BA5E JSR MLTPL1
Multiplikation
Register nach FAC,
linksbündig machen
go do shift/add FAC2
     
.,BA56 4C 8F BB JMP $BB8F JMP MOVFR ;MOVE RESULT INTO FAC,
;NORMALIZE RESULT, AND RETURN.
bitweise Multiplikation
copy temp to FAC1, normalise and return

MULTIPLY ARG BY (A) INTO RESULT

   
.,BA59 D0 03 BNE $BA5E MLTPLY: JEQ MULSHF ;SHIFT RESULT RIGHT 1 BYTE.
Rechtsverschieben
branch if byte <> zero
THIS BYTE NON-ZERO
   
.,BA5B 4C 83 B9 JMP $B983   des Registers
shift FCAtemp << A+8 times
else do shift and add
(A)=0, JUST SHIFT ARG RIGHT 8
   
.,BA5E 4A LSR MLTPL1: LSR A,
binäre Multiplikation
shift byte
SHIFT BIT INTO CARRY
   
.,BA5F 09 80 ORA #$80 ORAI 200
des Akkus
set top bit (mark for 8 times)
SUPPLY SENTINEL BIT
   
.,BA61 A8 TAY MLTPL2: TAY
mit ARG.
copy result
REMAINING MULTIPLIER TO Y
   
.,BA62 90 19 BCC $BA7D BCC MLTPL3 ;IT MULT BIT=0, JUST SHIFT.
Das Ergebnis kommt
skip next if bit was zero
THIS MULTIPLIER BIT = 0
   
.,BA64 18 CLC CLC
in das
clear carry for add
= 1, SO ADD ARG TO RESULT
   
.,BA65 A5 29 LDA $29 LDA RESLO
Register für
get temp mantissa 4
     
.,BA67 65 6D ADC $6D ADC ARGLO
Funktionen.
add FAC2 mantissa 4
     
.,BA69 85 29 STA $29 STA RESLO
Bei gesetztem Bit
save temp mantissa 4
     
.,BA6B A5 28 LDA $28 LDA RESMO
im Akku
get temp mantissa 3
     
.,BA6D 65 6C ADC $6C ADC ARGMO
wird ARG
add FAC2 mantissa 3
     
.,BA6F 85 28 STA $28 STA RESMO
IFN ADDPRC,<
zum
save temp mantissa 3
     
.,BA71 A5 27 LDA $27 LDA RESMOH
Funktionsregister
get temp mantissa 2
     
.,BA73 65 6B ADC $6B ADC ARGMOH
addiert.
add FAC2 mantissa 2
     
.,BA75 85 27 STA $27 STA RESMOH>
Zusätzlich
save temp mantissa 2
     
.,BA77 A5 26 LDA $26 LDA RESHO
werden
get temp mantissa 1
     
.,BA79 65 6A ADC $6A ADC ARGHO
die
add FAC2 mantissa 1
     
.,BA7B 85 26 STA $26 STA RESHO
Funktionsregister
save temp mantissa 1
     
.,BA7D 66 26 ROR $26 MLTPL3: ROR RESHO
IFN ADDPRC,<
noch
shift temp mantissa 1
SHIFT RESULT RIGHT 1
   
.,BA7F 66 27 ROR $27 ROR RESMOH>
verdoppelt.
shift temp mantissa 2
     
.,BA81 66 28 ROR $28 ROR RESMO
Die Routine
shift temp mantissa 3
     
.,BA83 66 29 ROR $29 ROR RESLO
arbeitet
shift temp mantissa 4
     
.,BA85 66 70 ROR $70 ROR FACOV ;SAVE FOR ROUNDING.
im selben
shift temp rounding byte
     
.,BA87 98 TYA TYA
Prinzip
get byte back
REMAINING MULTIPLIER
   
.,BA88 4A LSR LSR A, ;CLEAR MSB SO WE GET A CLOSER TO 0.
wie
shift byte
LSB INTO CARRY
   
.,BA89 D0 D6 BNE $BA61 BNE MLTPL2 ;SLOW AS A TURTLE !
bei $B34C.
loop if all bits not done
IF SENTINEL STILL HERE, MULTIPLY
   
.,BA8B 60 RTS MULTRT: RTS
;ROUTINE TO UNPACK MEMORY INTO ARG.
Rücksprung

ARG = Konstante (A/Y)

unpack memory (AY) into FAC2

8 X 32 COMPLETED

UNPACK NUMBER AT (Y,A) INTO ARG

 

move float indexed by AY into second float accu

.,BA8C 85 22 STA $22 CONUPK: STWD INDEX1
Die
save pointer low byte
USE INDEX FOR PNTR
   
.,BA8E 84 23 STY $23   Konstante,
save pointer high byte
     
.,BA90 A0 04 LDY #$04 LDYI 3+ADDPRC
auf
5 bytes to get (0-4)
FIVE BYTES TO MOVE
   
.,BA92 B1 22 LDA ($22),Y LDADY INDEX1
die
get mantissa 4
     
.,BA94 85 6D STA $6D STA ARGLO
das
save FAC2 mantissa 4
     
.,BA96 88 DEY DEY
Akku
decrement index
     
.,BA97 B1 22 LDA ($22),Y LDADY INDEX1
und
get mantissa 3
     
.,BA99 85 6C STA $6C STA ARGMO
das
save FAC2 mantissa 3
     
.,BA9B 88 DEY DEY
IFN ADDPRC,<
Y-Reg
decrement index
     
.,BA9C B1 22 LDA ($22),Y LDADY INDEX1
zeigt, nach ARG.
get mantissa 2
     
.,BA9E 85 6B STA $6B STA ARGMOH
Die
save FAC2 mantissa 2
     
.,BAA0 88 DEY DEY>
gesamten
decrement index
     
.,BAA1 B1 22 LDA ($22),Y LDADY INDEX1
Vor-
get mantissa 1 + sign
     
.,BAA3 85 6E STA $6E STA ARGSGN
zei -
save FAC2 sign (b7)
     
.,BAA5 45 66 EOR $66 EOR FACSGN
chen
EOR with FAC1 sign (b7)
SET COMBINED SIGN FOR MULT/DIV
   
.,BAA7 85 6F STA $6F STA ARISGN
von
save sign compare (FAC1 EOR FAC2)
     
.,BAA9 A5 6E LDA $6E LDA ARGSGN
FAC
recover FAC2 sign (b7)
TURN ON NORMALIZED INVISIBLE BIT
   
.,BAAB 09 80 ORA #$80 ORAI 200
und
set 1xxx xxx (set normal bit)
TO COMPLETE MANTISSA
   
.,BAAD 85 6A STA $6A STA ARGHO
ARG
save FAC2 mantissa 1
     
.,BAAF 88 DEY DEY
ver-
decrement index
     
.,BAB0 B1 22 LDA ($22),Y LDADY INDEX1
knüp-
get exponent byte
     
.,BAB2 85 69 STA $69 STA ARGEXP
fen
save FAC2 exponent
EXPONENT
   
.,BAB4 A5 61 LDA $61 LDA FACEXP ;SET CODES OF FACEXP.
FAC-Exponent
get FAC1 exponent
SET STATUS BITS ON FAC EXPONENT
   
.,BAB6 60 RTS RTS
;CHECK SPECIAL CASES AND ADD EXPONENTS FOR FMULT, FDIV.
Rücksprung

test and adjust accumulators

ADD EXPONENTS OF ARG AND FAC

(CALLED BY FMULT AND FDIV)
ALSO CHECK FOR OVERFLOW, AND SET RESULT SIGN
 

add exponents

.,BAB7 A5 69 LDA $69 MULDIV: LDA ARGEXP ;EXP OF ARG=0?
wenn Exponent von ARG=0,
get FAC2 exponent
     
.,BAB9 F0 1F BEQ $BADA MLDEXP: BEQ ZEREMV ;SO WE GET ZERO EXPONENT.
dann zu $BADA
branch if FAC2 = $00 (handle underflow)
IF ARG=0, RESULT IS ZERO
   
.,BABB 18 CLC CLC
FAC- und ARG-
clear carry for add
     
.,BABC 65 61 ADC $61 ADC FACEXP ;RESULT IS IN ACCA.
Exponent
add FAC1 exponent
     
.,BABE 90 04 BCC $BAC4 BCC TRYOFF ;FIND [C] XOR [N].
addieren
branch if sum of exponents < $0100
IN RANGE
   
.,BAC0 30 1D BMI $BADF BMI GOOVER ;OVERFLOW IF BITS MATCH.
wenn Überlauf, dann
'OVERFLOW ERROR'
do overflow error
OVERFLOW
   
.,BAC2 18 CLC CLC
Carry
clear carry for the add
     
.:BAC3 2C .BYTE $2C SKIP2
löschen
makes next line BIT $1410
TRICK TO SKIP
   
.,BAC4 10 14 BPL $BADA TRYOFF: BPL ZEREMV ;UNDERFLOW.
Wenn Unterlauf, dann zu $BADA
if +ve go handle underflow
OVERFLOW
   
.,BAC6 69 80 ADC #$80 ADCI 200 ;ADD BIAS.
ergibt
adjust exponent
RE-BIAS
   
.,BAC8 85 61 STA $61 STA FACEXP
FAC-
save FAC1 exponent
RESULT
   
.,BACA D0 03 BNE $BACF JEQ ZEROML ;ZERO THE REST OF IT.
Exponent
branch if not zero
     
.,BACC 4C FB B8 JMP $B8FB   FAC = 0
save FAC1 sign and return
RESULT IS ZERO
<<< CRAZY TO JUMP WAY BACK THERE! >>>
<<< SAME IDENTICAL CODE IS BELOW! >>>
<<< INSTEAD OF BNE .2, JMP STA.IN.FAC.SIGN >>>
<<< ONLY NEEDED BEQ .3 >>>
   
.,BACF A5 6F LDA $6F LDA ARISGN
FAC- und ARG-Vorzeichen
verknüpfen
get sign compare (FAC1 EOR FAC2)
SET SIGN OF RESULT
   
.,BAD1 85 66 STA $66 STA FACSGN ;ARISGN IS RESULT'S SIGN.
und speichern
save FAC1 sign (b7)
     
.,BAD3 60 RTS RTS ;DONE.
Rücksprung
handle overflow and underflow
IF (FAC) IS POSITIVE, GIVE "OVERFLOW" ERROR
IF (FAC) IS NEGATIVE, SET FAC=0, POP ONE RETURN, AND RTS
CALLED FROM "EXP" FUNCTION
   
.,BAD4 A5 66 LDA $66 MLDVEX: LDA FACSGN ;GET SIGN.
wenn positives
get FAC1 sign (b7)
     
.,BAD6 49 FF EOR #$FF EORI 377 ;COMPLEMENT IT.
Vorzeichen, dann
complement it
     
.,BAD8 30 05 BMI $BADF BMI GOOVER
'OVERFLOW ERROR'
do overflow error
handle underflow
ERROR IF POSITIVE #

POP RETURN ADDRESS AND SET FAC=0

   
.,BADA 68 PLA ZEREMV: PLA ;GET ADDR OFF STACK.
Einsprungadresse
pop return address low byte
     
.,BADB 68 PLA PLA
vom Stack holen
pop return address high byte
     
.,BADC 4C F7 B8 JMP $B8F7 JMP ZEROFC ;UNDERFLOW.
FAC = 0
clear FAC1 exponent and sign and return
     
.,BADF 4C 7E B9 JMP $B97E GOOVER: JMP OVERR ;OVERFLOW.
;MULTIPLY FAC BY 10.
'OVERFLOW ERROR'

FAC = FAC * 10

do overflow error then warm start

multiply FAC1 by 10

MULTIPLY FAC BY 10

 

multiply float accu by 10

.,BAE2 20 0C BC JSR $BC0C MUL10: JSR MOVAF ;COPY FAC INTO ARG.
FAC runden und nach ARG
round and copy FAC1 to FAC2
     
.,BAE5 AA TAX TAX
FAC-Exponent
copy exponent (set the flags)
TEXT FAC EXPONENT
   
.,BAE6 F0 10 BEQ $BAF8 BEQ MUL10R ;IF [FAC]=0, GOT ANSWER.
FAC gleich null, dann fertig
exit if zero
FINISHED IF FAC=0
   
.,BAE8 18 CLC CLC
Exponent + 2
clear carry for add
     
.,BAE9 69 02 ADC #$02 ADCI 2 ;AUGMENT EXP BY 2.
entspricht mal 4
add two to exponent (*4)
ADD 2 TO EXPONENT GIVES (FAC)*4
   
.,BAEB B0 F2 BCS $BADF BCS GOOVER ;OVERFLOW.
Übertrag ?
do overflow error if > $FF
FAC1 = (FAC1 + FAC2) * 2
OVERFLOW
   
.,BAED A2 00 LDX #$00 FINML6: LDXI 0
Vergleichsbyte
clear byte
     
.,BAEF 86 6F STX $6F STX ARISGN ;SIGNS ARE SAME.
löschen
clear sign compare (FAC1 EOR FAC2)
     
.,BAF1 20 77 B8 JSR $B877 JSR FADDC ;ADD TOGETHER.
FAC = FAC + ARG entspricht
mal 5
add FAC2 to FAC1 (*5)
MAKES (FAC)*5
   
.,BAF4 E6 61 INC $61 INC FACEXP ;MULTIPLY BY TWO.
Exponent erhöhen entspricht
mal 2
increment FAC1 exponent (*10)
*2, MAKES (FAC)*10
   
.,BAF6 F0 E7 BEQ $BADF BEQ GOOVER ;OVERFLOW.
Übertrag, dann 'OVERFLOW'
if exponent now zero go do overflow error
OVERFLOW
   
.,BAF8 60 RTS MUL10R: RTS
; DIVIDE FAC BY 10.
Rücksprung

10 as a floating value

   

constant 10 for division

.:BAF9 84 20 00 00 00 TENZC: 204
040
000
000
IFN ADDPRC,<0>
Fließkommakonstante 10

FAC = FAC / 10

10

divide FAC1 by 10

10

DIVIDE FAC BY 10

 

divide float by 10

.,BAFE 20 0C BC JSR $BC0C DIV10: JSR MOVAF ;MOVE FAC TO ARG.
FAC runden und nach ARG
round and copy FAC1 to FAC2
     
.,BB01 A9 F9 LDA #$F9 LDWDI TENZC ;POINT TO CONSTANT OF 10.0
Zeiger
set 10 pointer low byte
SET UP TO PUT
  low BAF9
.,BB03 A0 BA LDY #$BA   auf
set 10 pointer high byte
10 IN FAC
  high BAF9
.,BB05 A2 00 LDX #$00 LDXI 0 ;SIGNS ARE BOTH POSITIVE.
Konstante 10
clear sign

divide by (AY) (X=sign)

FAC = ARG / (Y,A)

   
.,BB07 86 6F STX $6F FDIVF: STX ARISGN
Vergleichsbyte löschen
save sign compare (FAC1 EOR FAC2)
     
.,BB09 20 A2 BB JSR $BBA2 JSR MOVFM ;PUT IT INTO FAC.
Konstante 10 nach FAC
unpack memory (AY) into FAC1
     
.,BB0C 4C 12 BB JMP $BB12 JMP FDIVT ;SKIP OVER NEXT TWO BYTES.
FAC = ARG / FAC

FAC = Konstante (A/Y) / FAC

do FAC2/FAC1
Perform divide-by

convert AY and do (AY)/FAC1

DIVIDE ARG BY FAC

FAC = (Y,A) / FAC

 

divide number indexed by AY by float accu

.,BB0F 20 8C BA JSR $BA8C FDIV: JSR CONUPK ;UNPACK CONSTANT.
Konstante (A/Y) nach ARG

FAC = ARG / FAC

unpack memory (AY) into FAC2

FAC = ARG / FAC

 

divide operator

.,BB12 F0 76 BEQ $BB8A FDIVT: BEQ DV0ERR ;CAN'T DIVIDE BY ZERO !
;(NOT ENOUGH ROOM TO STORE RESULT.)
FAC gleich null,
'DIVISION BY ZERO'
if zero go do /0 error
FAC = 0, DIVIDE BY ZERO ERROR
   
.,BB14 20 1B BC JSR $BC1B JSR ROUND ;TAKE FACOV INTO ACCT IN FAC.
FAC runden
round FAC1
     
.,BB17 A9 00 LDA #$00 LDAI 0 ;NEGATE FACEXP.
Vorzeichen
clear A
NEGATE FAC EXPONENT, SO
   
.,BB19 38 SEC SEC
von FAC-
set carry for subtract
ADD.EXPONENTS FORMS DIFFERENCE
   
.,BB1A E5 61 SBC $61 SBC FACEXP
Exponent
subtract FAC1 exponent (2s complement)
     
.,BB1C 85 61 STA $61 STA FACEXP
wechseln
save FAC1 exponent
     
.,BB1E 20 B7 BA JSR $BAB7 JSR MULDIV ;FIX UP EXPONENTS.
Exponent des Ergebnisses
bestimmen
test and adjust accumulators
     
.,BB21 E6 61 INC $61 INC FACEXP ;SCALE IT RIGHT.
wenn Exponentenüberlauf,
increment FAC1 exponent
     
.,BB23 F0 BA BEQ $BADF BEQ GOOVER ;OVERFLOW.
dann ’OVERFLOW ERROR’
if zero do overflow error
OVERFLOW
   
.,BB25 A2 FC LDX #$FC LDXI ^D256-3-ADDPRC ;SETUP PROCEDURE.
Zeiger
set index to FAC temp
INDEX FOR RESULT
   
.,BB27 A9 01 LDA #$01 LDAI 1
DIVIDE: ;THIS IS THE BEST CODE IN THE WHOLE PILE.
auf
set byte
SENTINEL
   
.,BB29 A4 6A LDY $6A LDY ARGHO ;SEE WHAT RELATION HOLDS.
Funktionsregister
get FAC2 mantissa 1
SEE IF FAC CAN BE SUBTRACTED
   
.,BB2B C4 62 CPY $62 CPY FACHO
diese
compare FAC1 mantissa 1
     
.,BB2D D0 10 BNE $BB3F BNE SAVQUO ;[C]=0,1. N(C=0)=0.
IFN ADDPRC,<
Routine
branch if <>
     
.,BB2F A4 6B LDY $6B LDY ARGMOH
vergleicht
get FAC2 mantissa 2
     
.,BB31 C4 63 CPY $63 CPY FACMOH
das
compare FAC1 mantissa 2
     
.,BB33 D0 0A BNE $BB3F BNE SAVQUO>
FAC
branch if <>
     
.,BB35 A4 6C LDY $6C LDY ARGMO
und
get FAC2 mantissa 3
     
.,BB37 C4 64 CPY $64 CPY FACMO
das
compare FAC1 mantissa 3
     
.,BB39 D0 04 BNE $BB3F BNE SAVQUO
ARG
branch if <>
     
.,BB3B A4 6D LDY $6D LDY ARGLO
byte-
get FAC2 mantissa 4
     
.,BB3D C4 65 CPY $65 CPY FACLO
weise
compare FAC1 mantissa 4
     
.,BB3F 08 PHP SAVQUO: PHP
Statusregister retten
save FAC2-FAC1 compare status
SAVE THE ANSWER, AND ALSO ROLL THE
   
.,BB40 2A ROL ROL A, ;SAVE RESULT.
Carry gelöscht,
shift byte
BIT INTO THE QUOTIENT, SENTINEL OUT
   
.,BB41 90 09 BCC $BB4C BCC QSHFT ;IF NOT DONE, CONTINUE.
dann zu $BB4C
skip next if no carry
NO SENTINEL, STILL NOT 8 TRIPS
   
.,BB43 E8 INX INX
Ergebnis
increment index to FAC temp
8 TRIPS, STORE BYTE OF QUOTIENT
   
.,BB44 95 29 STA $29,X STA RESLO,X
aufbauen
       
.,BB46 F0 32 BEQ $BB7A BEQ LD100
wenn X-Reg =0, dann zu $BB7A
  32-BITS COMPLETED
   
.,BB48 10 34 BPL $BB7E BPL DIVNRM ;NOTE THIS REQ 1 MO RAM THEN NECESS.
wenn X-Reg =1, dann zu $BB7E
  FINAL EXIT WHEN X=1
   
.,BB4A A9 01 LDA #$01 LDAI 1
wenn
  RE-START SENTINEL
   
.,BB4C 28 PLP QSHFT: PLP ;RETURN CONDITION CODES.
FAC kleiner oder gleich
restore FAC2-FAC1 compare status
GET ANSWER, CAN FAC BE SUBTRACTED?
   
.,BB4D B0 0E BCS $BB5D BCS DIVSUB ;FAC .LE. ARG.
ARG, dann zu $BB5D
if FAC2 >= FAC1 then do subtract
FAC2 = FAC2*2
YES, DO IT
   
.,BB4F 06 6D ASL $6D SHFARG: ASL ARGLO ;SHIFT ARG ONE PLACE LEFT.
Das
shift FAC2 mantissa 4
NO, SHIFT ARG LEFT
   
.,BB51 26 6C ROL $6C ROL ARGMO
IFN ADDPRC,<
ARG
shift FAC2 mantissa 3
     
.,BB53 26 6B ROL $6B ROL ARGMOH>
ver-
shift FAC2 mantissa 2
     
.,BB55 26 6A ROL $6A ROL ARGHO
doppeln
shift FAC2 mantissa 1
     
.,BB57 B0 E6 BCS $BB3F BCS SAVQUO ;SAVE A RESULT OF ONE FOR THIS POSITION
;AND DIVIDE.
wenn Überlauf, dann zu $BB3F
loop with no compare
ANOTHER TRIP
   
.,BB59 30 CE BMI $BB29 BMI DIVIDE ;IF MSB ON, GO DECIDE WHETHER TO SUB.
wenn Bit 7 gesetzt, dann
zu $BB29
loop with compare
HAVE TO COMPARE FIRST
   
.,BB5B 10 E2 BPL $BB3F BPL SAVQUO
ansonsten zu $BB3F
loop with no compare, branch always
...ALWAYS
   
.,BB5D A8 TAY DIVSUB: TAY ;NOTICE C MUST BE ON HERE.
Die
save FAC2-FAC1 compare status
SAVE QUOTIENT/SENTINEL BYTE
   
.,BB5E A5 6D LDA $6D LDA ARGLO
Mantisse
get FAC2 mantissa 4
SUBTRACT FAC FROM ARG ONCE
   
.,BB60 E5 65 SBC $65 SBC FACLO
von
subtract FAC1 mantissa 4
     
.,BB62 85 6D STA $6D STA ARGLO
ARG
save FAC2 mantissa 4
     
.,BB64 A5 6C LDA $6C LDA ARGMO
minus
get FAC2 mantissa 3
     
.,BB66 E5 64 SBC $64 SBC FACMO
der
subtract FAC1 mantissa 3
     
.,BB68 85 6C STA $6C STA ARGMO
IFN ADDPRC,<
Mantisse
save FAC2 mantissa 3
     
.,BB6A A5 6B LDA $6B LDA ARGMOH
von
get FAC2 mantissa 2
     
.,BB6C E5 63 SBC $63 SBC FACMOH
FAC
subtract FAC1 mantissa 2
     
.,BB6E 85 6B STA $6B STA ARGMOH>
sub-
save FAC2 mantissa 2
     
.,BB70 A5 6A LDA $6A LDA ARGHO
tra-
get FAC2 mantissa 1
     
.,BB72 E5 62 SBC $62 SBC FACHO
hie-
subtract FAC1 mantissa 1
     
.,BB74 85 6A STA $6A STA ARGHO
ren
save FAC2 mantissa 1
     
.,BB76 98 TYA TYA
und wieder
restore FAC2-FAC1 compare status
RESTORE QUOTIENT/SENTINEL BYTE
   
.,BB77 4C 4F BB JMP $BB4F JMP SHFARG
zu $BB4C
  GO TO SHIFT ARG AND CONTINUE
   
.,BB7A A9 40 LDA #$40 LD100: LDAI 100 ;ONLY WANT TWO MORE BITS.
unbedingter
  DO A FEW EXTENSION BITS
   
.,BB7C D0 CE BNE $BB4C BNE QSHFT ;ALWAYS BRANCHES.
Sprung
branch always
do A<<6, save as FAC1 rounding byte, normalise and return
...ALWAYS
   
.,BB7E 0A ASL DIVNRM: REPEAT 6,<ASL A> ;GET LAST TWO BITS INTO MSB AND B6.
den
  LEFT JUSTIFY THE EXTENSION BITS WE DID
   
.,BB7F 0A ASL   Akku
       
.,BB80 0A ASL   mit
       
.,BB81 0A ASL   64
       
.,BB82 0A ASL   multi -
       
.,BB83 0A ASL   plizieren
       
.,BB84 85 70 STA $70 STA FACOV
Ergeben = RundungssteLle
save FAC1 rounding byte
     
.,BB86 28 PLP PLP ;TO GET GARBAGE OFF STACK.
Statusregister aus Stack
dump FAC2-FAC1 compare status
     
.,BB87 4C 8F BB JMP $BB8F JMP MOVFR ;MOVE RESULT INTO FAC, THEN
;NORMALIZE RESULT AND RETURN.
Hilfsregister nach FAC
copy temp to FAC1, normalise and return
do "Divide by zero" error
     
.,BB8A A2 14 LDX #$14 DV0ERR: LDXI ERRDV0
Nummer für 'DIVISION BY ZERO'
error $14, divide by zero error
    error number
.,BB8C 4C 37 A4 JMP $A437 JMP ERROR
PAGE

FLOATING POINT MOVEMENT ROUTINES.

;MOVE RESULT TO FAC.
Fehlermeldung ausgeben
do error #X then warm start

COPY RESULT INTO FAC MANTISSA, AND NORMALIZE

   
.,BB8F A5 26 LDA $26 MOVFR: LDA RESHO
Hilfs-
get temp mantissa 1
     
.,BB91 85 62 STA $62 STA FACHO
IFN ADDPRC,<
register
save FAC1 mantissa 1
     
.,BB93 A5 27 LDA $27 LDA RESMOH
($26 - $29)
get temp mantissa 2
     
.,BB95 85 63 STA $63 STA FACMOH>
nach
save FAC1 mantissa 2
     
.,BB97 A5 28 LDA $28 LDA RESMO
FAC
get temp mantissa 3
     
.,BB99 85 64 STA $64 STA FACMO
über-
save FAC1 mantissa 3
     
.,BB9B A5 29 LDA $29 LDA RESLO ;MOVE LO AND SGN.
tra-
get temp mantissa 4
     
.,BB9D 85 65 STA $65 STA FACLO
gen
save FAC1 mantissa 4
     
.,BB9F 4C D7 B8 JMP $B8D7 JMP NORMAL ;ALL DONE.
;MOVE MEMORY INTO FAC (UNPACKED).
FAC linksbündig machen

Konstante (A/Y) nach FAC

übertragen

normalise FAC1 and return

unpack memory (AY) into FAC1

UNPACK (Y,A) INTO FAC

   
.,BBA2 85 22 STA $22 MOVFM: STWD INDEX1
Zeiger
save pointer low byte
USE INDEX FOR PNTR
   
.,BBA4 84 23 STY $23   setzen
save pointer high byte
     
.,BBA6 A0 04 LDY #$04 LDYI 3+ADDPRC
Zähler setzen
5 bytes to do
PICK UP 5 BYTES
   
.,BBA8 B1 22 LDA ($22),Y LDADY INDEX1
LOW-Byte
get fifth byte
     
.,BBAA 85 65 STA $65 STA FACLO
der
save FAC1 mantissa 4
     
.,BBAC 88 DEY DEY
Mantisse
decrement index
     
.,BBAD B1 22 LDA ($22),Y LDADY INDEX1
und
get fourth byte
     
.,BBAF 85 64 STA $64 STA FACMO
HIGH-
save FAC1 mantissa 3
     
.,BBB1 88 DEY DEY
IFN ADDPRC,<
Byte
decrement index
     
.,BBB2 B1 22 LDA ($22),Y LDADY INDEX1
der
get third byte
     
.,BBB4 85 63 STA $63 STA FACMOH
Mantisse
save FAC1 mantissa 2
     
.,BBB6 88 DEY DEY>
in
decrement index
     
.,BBB7 B1 22 LDA ($22),Y LDADY INDEX1
FAC
get second byte
     
.,BBB9 85 66 STA $66 STA FACSGN
holen
save FAC1 sign (b7)
FIRST BIT IS SIGN
   
.,BBBB 09 80 ORA #$80 ORAI 200
Vorzeichen
set 1xxx xxxx (add normal bit)
SET NORMALIZED INVISIBLE BIT
   
.,BBBD 85 62 STA $62 STA FACHO
der
save FAC1 mantissa 1
     
.,BBBF 88 DEY DEY
Man-
decrement index
     
.,BBC0 B1 22 LDA ($22),Y LDADY INDEX1
tisse
get first byte (exponent)
     
.,BBC2 85 61 STA $61 STA FACEXP ;LEAVE SWITCHES SET ON EXP.
Exponent
save FAC1 exponent
EXPONENT
   
.,BBC4 84 70 STY $70 STY FACOV
Rundungsstelle
clear FAC1 rounding byte
Y=0
   
.,BBC6 60 RTS RTS
;MOVE NUMBER FROM FAC TO MEMORY.
Rücksprung

pack FAC1 into $5C

ROUND FAC, STORE IN TEMP2

 

store float accu at $5C-$60

.,BBC7 A2 5C LDX #$5C MOV2F: LDXI TEMPF2
Adresse LOW
set pointer low byte
PACK FAC INTO TEMP2
  low 005C
.:BBC9 2C .BYTE $2C SKIP2
Akku #4

FAC nach Akku #3 übertragen

makes next line BIT $57A2

pack FAC1 into $57

TRICK TO BRANCH

ROUND FAC, STORE IN TEMP1

 

store float accu at $57-$5B

.,BBCA A2 57 LDX #$57 MOV1F: LDXI TEMPF1
Adresse LOW Akku #3
set pointer low byte
PACK FAC INTO TEMP1
  low 0057
.,BBCC A0 00 LDY #$00 MOVML: LDYI 0
Adresse HIGH
set pointer high byte
HI-BYTE OF TEMP1 SAME AS TEMP2
  high 0057
.,BBCE F0 04 BEQ $BBD4 BEQ MOVMF ;ALWAYS BRANCHES.
unbedingter Sprung

FAC nach Variable übertragen

pack FAC1 into (XY) and return, branch always

pack FAC1 into variable pointer

...ALWAYS

ROUND FAC, AND STORE WHERE FORPNT POINTS

 

store float accu in index at $49/$4A

.,BBD0 A6 49 LDX $49 MOVVF: LDXY FORPNT
Variablenadresse
get destination pointer low byte
     
.,BBD2 A4 4A LDY $4A   holen
get destination pointer high byte

pack FAC1 into (XY)

ROUND FAC, AND STORE AT (Y,X)

 

store float accu in index XY

.,BBD4 20 1B BC JSR $BC1B MOVMF: JSR ROUND
FAC runden
round FAC1
ROUND VALUE IN FAC USING EXTENSION
   
.,BBD7 86 22 STX $22 STXY INDEX1
Zeiger auf
save pointer low byte
USE INDEX FOR PNTR
   
.,BBD9 84 23 STY $23   Zieladresse
save pointer high byte
     
.,BBDB A0 04 LDY #$04 LDYI 3+ADDPRC
Zähler setzen
set index
STORING 5 PACKED BYTES
   
.,BBDD A5 65 LDA $65 LDA FACLO
LOW-Byte der Mantisse
get FAC1 mantissa 4
     
.,BBDF 91 22 STA ($22),Y STADY INDEX
Den
store in destination
     
.,BBE1 88 DEY DEY
FAC
decrement index
     
.,BBE2 A5 64 LDA $64 LDA FACMO
in
get FAC1 mantissa 3
     
.,BBE4 91 22 STA ($22),Y STADY INDEX
den
store in destination
     
.,BBE6 88 DEY DEY
IFN ADDPRC,<
Ziel-
decrement index
     
.,BBE7 A5 63 LDA $63 LDA FACMOH
bereich
get FAC1 mantissa 2
     
.,BBE9 91 22 STA ($22),Y STADY INDEX
über-
store in destination
     
.,BBEB 88 DEY DEY>
tragen
decrement index
     
.,BBEC A5 66 LDA $66 LDA FACSGN ;INCLUDE SIGN IN HO.
FAC-Vorzeichen
get FAC1 sign (b7)
PACK SIGN IN TOP BIT OF MANTISSA
   
.,BBEE 09 7F ORA #$7F ORAI 177
Die Bits 0 bis 6 setzen
set bits x111 1111
     
.,BBF0 25 62 AND $62 AND FACHO
Vorzeichen auf
AND in FAC1 mantissa 1
     
.,BBF2 91 22 STA ($22),Y STADY INDEX
Speicherformat
store in destination
     
.,BBF4 88 DEY DEY
bringen
decrement index
     
.,BBF5 A5 61 LDA $61 LDA FACEXP
FAC-Exponent
get FAC1 exponent
EXPONENT
   
.,BBF7 91 22 STA ($22),Y STADY INDEX
übertragen
store in destination
     
.,BBF9 84 70 STY $70 STY FACOV ;ZERO IT SINCE ROUNDED.
FAC-Rundungsstelle löschen
clear FAC1 rounding byte
ZERO THE EXTENSION
   
.,BBFB 60 RTS RTS ;[Y]=0.
;MOVE ARG INTO FAC.
Rücksprung

ARG nach FAC übertragen

copy FAC2 to FAC1

COPY ARG INTO FAC

 

move second float accu into first

.,BBFC A5 6E LDA $6E MOVFA: LDA ARGSGN
ARG-Vorzeichen
get FAC2 sign (b7)
save FAC1 sign and copy ABS(FAC2) to FAC1
COPY SIGN
   
.,BBFE 85 66 STA $66 MOVFA1: STA FACSGN
in FAC-Reg übertragen
save FAC1 sign (b7)
     
.,BC00 A2 05 LDX #$05 LDXI 4+ADDPRC
5 Bytes
5 bytes to copy
MOVE 5 BYTES
   
.,BC02 B5 68 LDA $68,X MOVFAL: LDA ARGEXP-1,X
ARG in
get byte from FAC2,X
     
.,BC04 95 60 STA $60,X STA FACEXP-1,X
FAC
save byte at FAC1,X
     
.,BC06 CA DEX DEX
übertragen
decrement count
     
.,BC07 D0 F9 BNE $BC02 BNE MOVFAL
schon alle Zeichen ?
loop if not all done
     
.,BC09 86 70 STX $70 STX FACOV
FAC-Rundungsstelle löschen
clear FAC1 rounding byte
ZERO EXTENSION
   
.,BC0B 60 RTS RTS
;MOVE FAC INTO ARG.
Rücksprung

FAC nach ARG übertragen

round and copy FAC1 to FAC2

ROUND FAC AND COPY TO ARG

 

move rounded float accu into second

.,BC0C 20 1B BC JSR $BC1B MOVAF: JSR ROUND
FAC runden
round FAC1
copy FAC1 to FAC2
ROUND FAC USING EXTENSION
   
.,BC0F A2 06 LDX #$06 MOVEF: LDXI 5+ADDPRC
6 Zeichen
6 bytes to copy
COPY 6 BYTES, INCLUDES SIGN
   
.,BC11 B5 60 LDA $60,X MOVAFL: LDA FACEXP-1,X
FAC in
get byte from FAC1,X
     
.,BC13 95 68 STA $68,X STA ARGEXP-1,X
ARG
save byte at FAC2,X
     
.,BC15 CA DEX DEX
übertragen
decrement count
     
.,BC16 D0 F9 BNE $BC11 BNE MOVAFL
schon alle Zeichen ?
loop if not all done
     
.,BC18 86 70 STX $70 STX FACOV ;ZERO IT SINCE ROUNDED.
FAC-Rundungsstelle löschen
clear FAC1 rounding byte
ZERO FAC EXTENSION
   
.,BC1A 60 RTS MOVRTS: RTS
Rücksprung

FAC runden

round FAC1

ROUND FAC USING EXTENSION BYTE

 

round float accu according to guard bit

.,BC1B A5 61 LDA $61 ROUND: LDA FACEXP ;ZERO?
Exponent null ?,
get FAC1 exponent
     
.,BC1D F0 FB BEQ $BC1A BEQ MOVRTS ;YES. DONE ROUNDING.
dann fertig
exit if zero
FAC = 0, RETURN
   
.,BC1F 06 70 ASL $70 ASL FACOV ;ROUND?
Rundungsstelle größer $7F ?
shift FAC1 rounding byte
IS FAC.EXTENSION >= 128?
   
.,BC21 90 F7 BCC $BC1A BCC MOVRTS ;NO. MSB OFF.
nein, dann fertig
exit if no overflow
round FAC1 (no check)
NO, FINISHED

INCREMENT MANTISSA AND RE-NORMALIZE IF CARRY

   
.,BC23 20 6F B9 JSR $B96F INCRND: JSR INCFAC ;YES, ADD ONE TO LSB(FAC).
Mantisse um eins erhöhen
increment FAC1 mantissa
YES, INCREMENT FAC
   
.,BC26 D0 F2 BNE $BC1A BNE MOVRTS ;NO CARRY MEANS DONE.
jetzt null ?
branch if no overflow
HIGH BYTE HAS BITS, FINISHED
   
.,BC28 4C 38 B9 JMP $B938 JMP RNDSHF ;SQUEEZ MSB IN AND RTS.
;NOTE [C]=1 SINCE INCFAC DOESNT TOUCH C.
PAGE

SIGN, SGN, FLOAT, NEG, ABS.

;PUT SIGN OF FAC IN ACCA.
nach rechts verschieben,
Exponent erhöhen

Vorzeichen von FAC holen

nornalise FAC1 for C=1 and return

get FAC1 sign

return A = $FF, Cb = 1/-ve A = $01, Cb = 0/+ve, A = $00, Cb = ?/0
HI-BYTE=0, SO SHIFT LEFT

TEST FAC FOR ZERO AND SIGN

FAC > 0, RETURN +1
FAC = 0, RETURN 0
FAC < 0, RETURN -1
 

get sign of float accu in A

.,BC2B A5 61 LDA $61 SIGN: LDA FACEXP
wenn null,
get FAC1 exponent
CHECK SIGN OF FAC AND
   
.,BC2D F0 09 BEQ $BC38 BEQ SIGNRT ;IF NUMBER IS ZERO, SO IS RESULT.
dann RTS
exit if zero (allready correct SGN(0)=0)

return A = $FF, Cb = 1/-ve A = $01, Cb = 0/+ve

no = 0 check
RETURN -1,0,1 IN A-REG
   
.,BC2F A5 66 LDA $66 FCSIGN: LDA FACSGN
FAC-Vorzeichen
else get FAC1 sign (b7)

return A = $FF, Cb = 1/-ve A = $01, Cb = 0/+ve

no = 0 check, sign in A
     
.,BC31 2A ROL FCOMPS: ROL A
holen
move sign bit to carry
MSBIT TO CARRY
   
.,BC32 A9 FF LDA #$FF LDAI ^O377 ;ASSUME NEGATIVE.
negativ?
set byte for -ve result
-1
   
.,BC34 B0 02 BCS $BC38 BCS SIGNRT
dann RTS
return if sign was set (-ve)
MSBIT = 1
   
.,BC36 A9 01 LDA #$01 LDAI 1 ;GET +1.
sonst positiv
else set byte for +ve result
+1
   
.,BC38 60 RTS SIGNRT: RTS
;SGN FUNCTION.
Rücksprung

BASIC-Funktion SGN

perform SGN()

"SGN" FUNCTION

 

SGN function

.,BC39 20 2B BC JSR $BC2B SGN: JSR SIGN
;FLOAT THE SIGNED INTEGER IN ACCA.
Vorzeichen holen
get FAC1 sign, return A = $FF -ve, A = $01 +ve

save A as integer byte

CONVERT FAC TO -1,0,1

CONVERT (A) INTO FAC, AS SIGNED VALUE -128 TO +127

 

move signed number from A into float accu

.,BC3C 85 62 STA $62 FLOAT: STA FACHO ;PUT [ACCA] IN HIGH ORDER.
und in FAC speichern
save FAC1 mantissa 1
PUT IN HIGH BYTE OF MANTISSA
   
.,BC3E A9 00 LDA #$00 LDAI 0
$63
clear A
CLEAR 2ND BYTE OF MANTISSA
   
.,BC40 85 63 STA $63 STA FACHO+1
löschen
clear FAC1 mantissa 2
     
.,BC42 A2 88 LDX #$88 LDXI 210 ;GET THE EXPONENT.
;FLOAT THE SIGNED NUMBER IN FAC.
Exponent
set exponent
set exponent = X, clear FAC1 3 and 4 and normalise
USE EXPONENT 2^9

FLOAT UNSIGNED VALUE IN FAC+1,2

(X) = EXPONENT
   
.,BC44 A5 62 LDA $62 FLOATS: LDA FACHO
Vorzeichen
get FAC1 mantissa 1
MSBIT=0, SET CARRY; =1, CLEAR CARRY
   
.,BC46 49 FF EOR #$FF EORI 377
invertieren
complement it
     
.,BC48 2A ROL ROL A, ;GET COMP OF SIGN IN CARRY.
und nach links rollen
sign bit into carry
set exponent = X, clear mantissa 4 and 3 and normalise FAC1

FLOAT UNSIGNED VALUE IN FAC+1,2

(X) = EXPONENT
C=0 TO MAKE VALUE NEGATIVE
C=1 TO MAKE VALUE POSITIVE
   
.,BC49 A9 00 LDA #$00 FLOATC: LDAI 0 ;ZERO [ACCA] BUT NOT CARRY.
Die Adressen
clear A
CLEAR LOWER 16-BITS OF MANTISSA
   
.,BC4B 85 65 STA $65 STA FACLO
IFN ADDPRC,<
$65
clear FAC1 mantissa 4
     
.,BC4D 85 64 STA $64 STA FACMO>
und $64 löschen
clear FAC1 mantissa 3
set exponent = X and normalise FAC1
     
.,BC4F 86 61 STX $61 FLOATB: STX FACEXP
Exponent
set FAC1 exponent
STORE EXPONENT
   
.,BC51 85 70 STA $70 STA FACOV
Rundungsstelle
clear FAC1 rounding byte
CLEAR EXTENSION
   
.,BC53 85 66 STA $66 STA FACSGN
löschen
clear FAC1 sign (b7)
MAKE SIGN POSITIVE
   
.,BC55 4C D2 B8 JMP $B8D2 JMP FADFLT
;ABSOLUTE VALUE OF FAC.
linksbündig machen

BASIC-Funktion ABS

do ABS and normalise FAC1

perform ABS()

IF C=0, WILL NEGATE FAC

"ABS" FUNCTION

 

ABS function

.,BC58 46 66 LSR $66 ABS: LSR FACSGN
Vorzeichenbit löschen
clear FAC1 sign, put zero in b7
CHANGE SIGN TO +
   
.,BC5A 60 RTS RTS
PAGE

COMPARE TWO NUMBERS.

;A=1 IF ARG .LT. FAC.
;A=0 IF ARG=FAC.
;A=-1 IF ARG .GT. FAC.
Rücksprung

Vergleich Konstante (A/Y) mit

FAC

compare FAC1 with (AY)

returns A=$00 if FAC1 = (AY)
returns A=$01 if FAC1 > (AY)
returns A=$FF if FAC1 < (AY)

COMPARE FAC WITH PACKED # AT (Y,A)

RETURN A=1,0,-1 AS (Y,A) IS <,=,> FAC
 

compare float accu to float indexed by XY

.,BC5B 85 24 STA $24 FCOMP: STA INDEX2
Zeiger auf
save pointer low byte
USE DEST FOR PNTR

SPECIAL ENTRY FROM "NEXT" PROCESSOR

"DEST" ALREADY SET UP
   
.,BC5D 84 25 STY $25 FCOMPN: STY INDEX2+1
Konstante
save pointer high byte
     
.,BC5F A0 00 LDY #$00 LDYI 0
Zähler setzen
clear index
GET EXPONENT OF COMPARAND
   
.,BC61 B1 24 LDA ($24),Y LDADY INDEX2 ;HAS ARGEXP.
Exponent
get exponent
     
.,BC63 C8 INY INY ;BUMP PNTR UP.
Zähler erhöhen
increment index
POINT AT NEXT BYTE
   
.,BC64 AA TAX TAX ;SAVE A IN X AND RESET CODES.
ins X-Reg
copy (AY) exponent to X
EXPONENT TO X-REG
   
.,BC65 F0 C4 BEQ $BC2B BEQ SIGN
null?, dann Vorzeichen von
FAC holen
branch if (AY) exponent=0 and get FAC1 sign
A = $FF, Cb = 1/-ve A = $01, Cb = 0/+ve
IF COMPARAND=0, "SIGN" COMPARES FAC
   
.,BC67 B1 24 LDA ($24),Y LDADY INDEX2
Konstante
get (AY) mantissa 1, with sign
GET HI-BYTE OF MANTISSA
   
.,BC69 45 66 EOR $66 EOR FACSGN ;SIGNS THE SAME.
FAC-Vorzeichen
EOR FAC1 sign (b7)
COMPARE WITH FAC SIGN
   
.,BC6B 30 C2 BMI $BC2F BMI FCSIGN ;SIGNS DIFFER SO RESULT IS
;SIGN OF FAC AGAIN.
verschiedene Vorzeichen?,
dann zu $BC2F
if signs <> do return A = $FF, Cb = 1/-ve
A = $01, Cb = 0/+ve and return
DIFFERENT SIGNS, "SIGN" GIVES ANSWER
   
.,BC6D E4 61 CPX $61 FOUTCP: CPX FACEXP
Exponenten vergleichen
compare (AY) exponent with FAC1 exponent
SAME SIGN, SO COMPARE EXPONENTS
   
.,BC6F D0 21 BNE $BC92 BNE FCOMPC
falls verschieden, dann zu
$BC92
branch if different
DIFFERENT, SO SUFFICIENT TEST
   
.,BC71 B1 24 LDA ($24),Y LDADY INDEX2
das
get (AY) mantissa 1, with sign
SAME EXPONENT, COMPARE MANTISSA
   
.,BC73 09 80 ORA #$80 ORAI 200
erste
normalise top bit
SET INVISIBLE NORMALIZED BIT
   
.,BC75 C5 62 CMP $62 CMP FACHO
Byte
compare with FAC1 mantissa 1
     
.,BC77 D0 19 BNE $BC92 BNE FCOMPC
vergleichen
branch if different
NOT SAME, SO SUFFICIENT
   
.,BC79 C8 INY INY
IFN ADDPRC,<
Zähler erhöhen
increment index
SAME, COMPARE MORE MANTISSA
   
.,BC7A B1 24 LDA ($24),Y LDADY INDEX2
das zweite
get mantissa 2
     
.,BC7C C5 63 CMP $63 CMP FACMOH
Byte
compare with FAC1 mantissa 2
     
.,BC7E D0 12 BNE $BC92 BNE FCOMPC
vergleichen
branch if different
NOT SAME, SO SUFFICIENT
   
.,BC80 C8 INY INY>
Zähler erhöhen
increment index
SAME, COMPARE MORE MANTISSA
   
.,BC81 B1 24 LDA ($24),Y LDADY INDEX2
das dritte
get mantissa 3
     
.,BC83 C5 64 CMP $64 CMP FACMO
Byte
compare with FAC1 mantissa 3
     
.,BC85 D0 0B BNE $BC92 BNE FCOMPC
vergleichen
branch if different
NOT SAME, SO SUFFICIENT
   
.,BC87 C8 INY INY
Zähler erhöhen
increment index
SAME, COMPARE REST OF MANTISSA
   
.,BC88 A9 7F LDA #$7F LDAI 177
FAC-Rundungsstelle mit
set for 1/2 value rounding byte
ARTIFICIAL EXTENSION BYTE FOR COMPARAND
   
.,BC8A C5 70 CMP $70 CMP FACOV
$7F vergleichen
compare with FAC1 rounding byte (set carry)
     
.,BC8C B1 24 LDA ($24),Y LDADY INDEX2
letzte Stellen, gemäß Ver-
get mantissa 4
     
.,BC8E E5 65 SBC $65 SBC FACLO ;GET ZERO IF EQUAL.
gleich der Rundungsstelle,
subtrahieren
subtract FAC1 mantissa 4
     
.,BC90 F0 28 BEQ $BCBA BEQ QINTRT
wenn alle Stellen gleich
sind, dann RTS
exit if mantissa 4 equal
gets here if number <> FAC1
NUMBERS ARE EQUAL, RETURN (A)=0
   
.,BC92 A5 66 LDA $66 FCOMPC: LDA FACSGN
FAC-Vorzeichen
get FAC1 sign (b7)
NUMBERS ARE DIFFERENT
   
.,BC94 90 02 BCC $BC98 BCC FCOMPD
ist die Konstante kleiner
FAC, dann zu $BC98
branch if FAC1 > (AY)
FAC IS LARGER MAGNITUDE
   
.,BC96 49 FF EOR #$FF EORI 377
Ergebnis kleiner, dann
invertieren
else toggle FAC1 sign
FAC IS SMALLER MAGNITUDE
<<< NOTE THAT ABOVE THREE LINES CAN BE SHORTENED: >>>
<<< .1 ROR PUT CARRY INTO SIGN BIT >>>
<<< EOR FAC.SIGN TOGGLE WITH SIGN OF FAC >>>
   
.,BC98 4C 31 BC JMP $BC31 FCOMPD: JMP FCOMPS ;A PART OF SIGN SETS ACCA UP.
PAGE

GREATEST INTEGER FUNCTION.

;QUICK GREATEST INTEGER FUNCTION.
;LEAVES INT(FAC) IN FACHO&MO&LO SIGNED.
;ASSUMES FAC .LT. 2^23 = 8388608
Flag für Ergebnis setzen

Umwandlung Fließkomma nach

Integer

return A = $FF, Cb = 1/-ve A = $01, Cb = 0/+ve

convert FAC1 floating to fixed

CONVERT +1 OR -1

QUICK INTEGER FUNCTION

CONVERTS FP VALUE IN FAC TO INTEGER VALUE
IN FAC+1...FAC+4, BY SHIFTING RIGHT WITH SIGN
EXTENSION UNTIL FRACTIONAL BITS ARE OUT.
THIS SUBROUTINE ASSUMES THE EXPONENT < 32.
 

convert float to a 4 byte signed integer

.,BC9B A5 61 LDA $61 QINT: LDA FACEXP
Exponent
get FAC1 exponent
LOOK AT FAC EXPONENT
   
.,BC9D F0 4A BEQ $BCE9 BEQ CLRFAC ;IF ZERO, GOT IT.
null ?
if zero go clear FAC1 and return
FAC=0, SO FINISHED
   
.,BC9F 38 SEC SEC
Integer-
set carry for subtract
GET -(NUMBER OF FRACTIONAL BITS)
   
.,BCA0 E9 A0 SBC #$A0 SBCI 8*ADDPRC+230 ;GET NUMBER OF PLACES TO SHIFT.
Exponent
subtract maximum integer range exponent
IN A-REG FOR SHIFT COUNT
   
.,BCA2 24 66 BIT $66 BIT FACSGN
wenn FAC positiv,
test FAC1 sign (b7)
CHECK SIGN OF FAC
   
.,BCA4 10 09 BPL $BCAF BPL QISHFT
dann zu $BCAF
branch if FAC1 +ve
FAC1 was -ve
POSITIVE, CONTINUE
   
.,BCA6 AA TAX TAX
FAC
copy subtracted exponent
NEGATIVE, SO COMPLEMENT MANTISSA
   
.,BCA7 A9 FF LDA #$FF LDAI 377
Rundungsbyte
overflow for -ve number
AND SET SIGN EXTENSION FOR SHIFT
   
.,BCA9 85 68 STA $68 STA BITS ;PUT 377 IN WHEN SHFTR SHIFTS BYTES.
setzen
set FAC1 overflow byte
     
.,BCAB 20 4D B9 JSR $B94D JSR NEGFCH ;TRULY NEGATE QUANTITY IN FAC.
Mantisse von FAC invertieren
twos complement FAC1 mantissa
     
.,BCAE 8A TXA TXA
Exponent in Akku
restore subtracted exponent
RESTORE BIT COUNT TO A-REG
   
.,BCAF A2 61 LDX #$61 QISHFT: LDXI FAC
FAC-Offset-Zeiger
set index to FAC1
POINT SHIFT SUBROUTINE AT FAC
   
.,BCB1 C9 F9 CMP #$F9 CMPI ^D256-7
wenn Exponent größer als
compare exponent result
MORE THAN 7 BITS TO SHIFT?
   
.,BCB3 10 06 BPL $BCBB BPL QINT1 ;IF NUMBER OF PLACES .GE. 7
;SHIFT 1 PLACE AT A TIME.
-8, dann zu BCBB
if < 8 shifts shift FAC1 A times right and return
NO, SHORT SHIFT
   
.,BCB5 20 99 B9 JSR $B999 JSR SHIFTR ;START SHIFTING BYTES, THEN BITS.
FAC rechtsverschieben
shift FAC1 A times right (> 8 shifts)
YES, USE GENERAL ROUTINE
   
.,BCB8 84 68 STY $68 STY BITS ;ZERO BITS SINCE ADDER WANTS ZERO.
FAC-Rundungsbyte löschen
clear FAC1 overflow byte
Y=0, CLEAR SIGN EXTENSION
   
.,BCBA 60 RTS QINTRT: RTS
Rücksprung

shift FAC1 A times right

     
.,BCBB A8 TAY QINT1: TAY ;PUT COUNT IN COUNTER.
Akku löschen
copy shift count
SAVE SHIFT COUNT
   
.,BCBC A5 66 LDA $66 LDA FACSGN
FAC-Vorzeichen laden
get FAC1 sign (b7)
GET SIGN BIT
   
.,BCBE 29 80 AND #$80 ANDI 200 ;GET SIGN BIT.
das
mask sign bit only (x000 0000)
     
.,BCC0 46 62 LSR $62 LSR FACHO ;SAVE FIRST SHIFTED BYTE.
FAC-
shift FAC1 mantissa 1
START RIGHT SHIFT
   
.,BCC2 05 62 ORA $62 ORA FACHO
Vorzeichen
OR sign in b7 FAC1 mantissa 1
AND MERGE WITH SIGN
   
.,BCC4 85 62 STA $62 STA FACHO
isolieren
save FAC1 mantissa 1
     
.,BCC6 20 B0 B9 JSR $B9B0 JSR ROLSHF ;SHIFT THE REST.
FAC bitweise nach rechts
verschieben
shift FAC1 Y times right
JUMP INTO MIDDLE OF SHIFTER
   
.,BCC9 84 68 STY $68 STY BITS ;ZERO [BITS].
FAC-Rundungsbyte löschen
clear FAC1 overflow byte
Y=0, CLEAR SIGN EXTENSION
   
.,BCCB 60 RTS RTS
;GREATEST INTEGER FUNCTION.
Rücksprung

BASIC-Funktion INT

perform INT()

"INT" FUNCTION

USES QINT TO CONVERT (FAC) TO INTEGER FORM,
AND THEN REFLOATS THE INTEGER.
<<< A FASTER APPROACH WOULD SIMPLY CLEAR >>>
<<< THE FRACTIONAL BITS BY ZEROING THEM >>>
 

INT function

.,BCCC A5 61 LDA $61 INT: LDA FACEXP
Exponent
get FAC1 exponent
CHECK IF EXPONENT < 32
   
.,BCCE C9 A0 CMP #$A0 CMPI 8*ADDPRC+230
ganze Zahl ?
compare with max int
BECAUSE IF > 31 THERE IS NO FRACTION
   
.,BCD0 B0 20 BCS $BCF2 BCS INTRTS ;FORGET IT.
ja, dann fertig
exit if >= (allready int, too big for fractional part!)
NO FRACTION, WE ARE FINISHED
   
.,BCD2 20 9B BC JSR $BC9B JSR QINT
FAC nach Integer wandeln
convert FAC1 floating to fixed
USE GENERAL INTEGER CONVERSION
   
.,BCD5 84 70 STY $70 STY FACOV ;CLR OVERFLOW BYTE.
Rundungsstelle löschen
save FAC1 rounding byte
Y=0, CLEAR EXTENSION
   
.,BCD7 A5 66 LDA $66 LDA FACSGN
Vorzeichen in Akku
get FAC1 sign (b7)
GET SIGN OF VALUE
   
.,BCD9 84 66 STY $66 STY FACSGN ;MAKE FAC LOOK POSITIVE.
und positiv machen
save FAC1 sign (b7)
Y=0, CLEAR SIGN
   
.,BCDB 49 80 EOR #$80 EORI 200 ;GET COMPLEMENT OF SIGN IN CARRY.
Bei
toggle FAC1 sign
TOGGLE ACTUAL SIGN
   
.,BCDD 2A ROL ROL A,
negativen Vorzeichen
shift into carry
AND SAVE IN CARRY
   
.,BCDE A9 A0 LDA #$A0 LDAI 8*ADDPRC+230
das
set new exponent
SET EXPONENT TO 32
   
.,BCE0 85 61 STA $61 STA FACEXP
Carry-
save FAC1 exponent
BECAUSE 4-BYTE INTEGER NOW
   
.,BCE2 A5 65 LDA $65 LDA FACLO
flag
get FAC1 mantissa 4
SAVE LOW 8-BITS OF INTEGER FORM
   
.,BCE4 85 07 STA $07 STA INTEGR
löschen
save FAC1 mantissa 4 for power function
FOR EXP AND POWER
   
.,BCE6 4C D2 B8 JMP $B8D2 JMP FADFLT
FAC linksbündig machen
do ABS and normalise FAC1

clear FAC1 and return

NORMALIZE TO FINISH CONVERSION
 

clear float accu

.,BCE9 85 62 STA $62 CLRFAC: STA FACHO ;MAKE IT REALLY ZERO.
Mantisse
clear FAC1 mantissa 1
FAC=0, SO CLEAR ALL 4 BYTES FOR
   
.,BCEB 85 63 STA $63 IFN ADDPRC,<STA FACMOH>
mit
clear FAC1 mantissa 2
INTEGER VERSION
   
.,BCED 85 64 STA $64 STA FACMO
Nullen
clear FAC1 mantissa 3
     
.,BCEF 85 65 STA $65 STA FACLO
füllen
clear FAC1 mantissa 4
     
.,BCF1 A8 TAY TAY
Y-Reg löschen
clear Y
Y=0 TOO
   
.,BCF2 60 RTS INTRTS: RTS
PAGE

FLOATING POINT INPUT ROUTINE.

;NUMBER INPUT IS LEFT IN FAC.
;AT ENTRY [TXTPTR] POINTS TO THE FIRST CHARACTER IN A TEXT BUFFER.
;THE FIRST CHARACTER IS ALSO IN ACCA. FIN PACKS THE DIGITS
;INTO THE FAC AS AN INTEGER AND KEEPS TRACK OF WHERE THE
;DECIMAL POINT IS. [DPTFLG] TELL WHETHER A DP HAS BEEN
;SEEN. [DECCNT] IS THE NUMBER OF DIGITS AFTER THE DP.
;AT THE END [DECCNT] AND THE EXPONENT ARE USED TO
;DETERMINE HOW MANY TIMES TO MULTIPLY OR DIVIDE BY TEN
;TO GET THE CORRECT NUMBER.
Rücksprung

Umwandlung ASCII nach

Fließkommaformat

get FAC1 from string

CONVERT STRING TO FP VALUE IN FAC

STRING POINTED TO BY TXTPTR
FIRST CHAR ALREADY SCANNED BY CHRGET
(A) = FIRST CHAR, C=0 IF DIGIT.
 

convert string to float in float accu

.,BCF3 A0 00 LDY #$00 FIN: LDYI 0 ;ZERO FACSGN&SGNFLG.
Wert festlegen
clear Y
CLEAR WORKING AREA ($99...$A3)
   
.,BCF5 A2 0A LDX #$0A LDXI 11+ADDPRC ;ZERO EXP AND HO (AND MOH).
Zähler stellen
set index
TMPEXP, EXPON, DPFLG, EXPSGN, FAC, SERLEN
   
.,BCF7 94 5D STY $5D,X FINZLP: STY DECCNT,X ;ZERO MO AND LO.
den Bereich
clear byte
     
.,BCF9 CA DEX DEX ;ZERO TENEXP AND EXPSGN
von $5D bis $66 mit
decrement index
     
.,BCFA 10 FB BPL $BCF7 BPL FINZLP ;ZERO DECCNT, DPTFLG.
Nullen füllen
loop until numexp to negnum (and FAC1) = $00
     
.,BCFC 90 0F BCC $BD0D BCC FINDGQ ;FLAGS STILL SET FROM CHRGET.
wenn erstes Zeichen eine
Ziffer, dann zu $BD0D
branch if first character is numeric
FIRST CHAR IS A DIGIT
   
.,BCFE C9 2D CMP #$2D CMPI "-" ;A NEGATIVE SIGN?
Nummer für '-'?
else compare with "-"
CHECK FOR LEADING SIGN
  minus
.,BD00 D0 04 BNE $BD06 BNE QPLUS ;NO, TRY PLUS SIGN.
wenn nicht, dann zu $BD06
branch if not "-"
NOT MINUS
   
.,BD02 86 67 STX $67 STX SGNFLG ;IT'S NEGATIVE. (X=377).
Flag für negativ
set flag for -ve n (negnum = $FF)
MINUS, SET SERLEN = $FF FOR FLAG
   
.,BD04 F0 04 BEQ $BD0A BEQ FINC ;ALWAYS BRANCHES.
unbedingter Sprung
branch always
...ALWAYS
   
.,BD06 C9 2B CMP #$2B QPLUS: CMPI "+" ;PLUS SIGN?
Nummer für ' + '
else compare with "+"
MIGHT BE PLUS
  plus
.,BD08 D0 05 BNE $BD0F BNE FIN1 ;YES, SKIP IT.
wenn nicht, dann zu $BD0F
branch if not "+"
NOT PLUS EITHER, CHECK DECIMAL POINT
   
.,BD0A 20 73 00 JSR $0073 FINC: JSR CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory
GET NEXT CHAR OF STRING
   
.,BD0D 90 5B BCC $BD6A FINDGQ: BCC FINDIG
wenn Ziffer, dann zu $BD6A
branch if numeric character
INSERT THIS DIGIT
   
.,BD0F C9 2E CMP #$2E FIN1: CMPI "." ;THE DP?
Nummer für '.'
else compare with "."
CHECK FOR DECIMAL POINT
  decimal point
.,BD11 F0 2E BEQ $BD41 BEQ FINDP ;NO KIDDING.
wenn ja, dann zu $BD41
branch if "."
YES
   
.,BD13 C9 45 CMP #$45 CMPI "E" ;EXPONENT FOLLOWS.
Nummer für 'E'
else compare with "E"
CHECK FOR EXPONENT PART
  E
.,BD15 D0 30 BNE $BD47 BNE FINE ;NO.
;HERE TO CHECK FOR SIGN OF EXP.
wenn nicht, dann zu $BD47
branch if not "E"
was "E" so evaluate exponential part
NO, END OF NUMBER
   
.,BD17 20 73 00 JSR $0073 JSR CHRGET ;YES. GET ANOTHER.
CHRGET nächstes Zeichen holen
increment and scan memory
YES, START CONVERTING EXPONENT
   
.,BD1A 90 17 BCC $BD33 BCC FNEDG1 ;IT IS A DIGIT. (EASIER THAN
;BACKING UP POINTER.)
wenn Ziffer, dann zu $BD33
branch if numeric character
EXPONENT DIGIT
   
.,BD1C C9 AB CMP #$AB CMPI MINUTK ;MINUS?
'-' BASIC-Kode
else compare with token for -
NEGATIVE EXPONENT?
  minus code
.,BD1E F0 0E BEQ $BD2E BEQ FINEC1 ;NEGATE.
wenn ja, dann zu $BD2E
branch if token for -
YES
   
.,BD20 C9 2D CMP #$2D CMPI "-" ;MINUS SIGN?
Nummer für '-'
else compare with "-"
MIGHT NOT BE TOKENIZED YET
  minus
.,BD22 F0 0A BEQ $BD2E BEQ FINEC1
wenn ja, dann zu $BD2E
branch if "-"
YES, IT IS NEGATIVE
   
.,BD24 C9 AA CMP #$AA CMPI PLUSTK ;PLUS?
'+' BASIC-Kode
else compare with token for +
OPTIONAL "+"
  plus code
.,BD26 F0 08 BEQ $BD30 BEQ FINEC
wenn ja, dann zu $BD30
branch if token for +
YES
   
.,BD28 C9 2B CMP #$2B CMPI "+" ;PLUS SIGN?
Nummer für '+'
else compare with "+"
MIGHT NOT BE TOKENIZED YET
  plus
.,BD2A F0 04 BEQ $BD30 BEQ FINEC
wenn ja, dann zu $BD30
branch if "+"
YES, FOUND "+"
   
.,BD2C D0 07 BNE $BD35 BNE FINEC2
unbedingter Sprung
branch always
...ALWAYS, NUMBER COMPLETED
   
.,BD2E 66 60 ROR $60 FINEC1: ROR EXPSGN ;TURN IT ON.
Bit 7 setzen
set exponent -ve flag (C, which=1, into b7)
C=1, SET FLAG NEGATIVE
   
.,BD30 20 73 00 JSR $0073 FINEC: JSR CHRGET ;GET ANOTHER.
CHRGET nächstes Zeichen holen
increment and scan memory
GET NEXT DIGIT OF EXPONENT
   
.,BD33 90 5C BCC $BD91 FNEDG1: BCC FINEDG ;IT IS A DIGIT.
wenn Ziffer, dann zu $BD91
branch if numeric character
CHAR IS A DIGIT OF EXPONENT
   
.,BD35 24 60 BIT $60 FINEC2: BIT EXPSGN
Bit 7 gesetzt ?
test exponent -ve flag
END OF NUMBER, CHECK EXP SIGN
   
.,BD37 10 0E BPL $BD47 BPL FINE
wenn nicht, dann zu $BD47
if +ve go evaluate exponent
else do exponent = -exponent
POSITIVE EXPONENT
   
.,BD39 A9 00 LDA #$00 LDAI 0
Vorzeichen des
clear result
NEGATIVE EXPONENT
   
.,BD3B 38 SEC SEC
Exponenten
set carry for subtract
MAKE 2'S COMPLEMENT OF EXPONENT
   
.,BD3C E5 5E SBC $5E SBC TENEXP
wechseln
subtract exponent byte
     
.,BD3E 4C 49 BD JMP $BD49 JMP FINE1
weiter bei $BD49
go evaluate exponent

FOUND A DECIMAL POINT

   
.,BD41 66 5F ROR $5F FINDP: ROR DPTFLG
Aufruf durch Dezimalpunkt
set decimal point flag
C=1, SET DPFLG FOR DECIMAL POINT
   
.,BD43 24 5F BIT $5F BIT DPTFLG
schon zweiter Dezimalpunkt
test decimal point flag
CHECK IF PREVIOUS DEC. PT.
   
.,BD45 50 C3 BVC $BD0A BVC FINC
wenn nicht, dann weiter
branch if only one decimal point so far
evaluate exponent
NO PREVIOUS DECIMAL POINT
A SECOND DECIMAL POINT IS TAKEN AS A TERMINATOR
TO THE NUMERIC STRING.
"A=11..22" WILL GIVE A SYNTAX ERROR, BECAUSE
IT IS TWO NUMBERS WITH NO OPERATOR BETWEEN.
"PRINT 11..22" GIVES NO ERROR, BECAUSE IT IS
JUST THE CONCATENATION OF TWO NUMBERS.
NUMBER TERMINATED, ADJUST EXPONENT NOW
   
.,BD47 A5 5E LDA $5E FINE: LDA TENEXP
Zahl gemäß
get exponent count byte
E-VALUE
   
.,BD49 38 SEC FINE1: SEC
Position
set carry for subtract
MODIFY WITH COUNT OF DIGITS
   
.,BD4A E5 5D SBC $5D SBC DECCNT ;GET NUMBER OF PLACES TO SHIFT.
des Dezimalpunkts
subtract numerator exponent
AFTER THE DECIMAL POINT
   
.,BD4C 85 5E STA $5E STA TENEXP
und Exponenten anpassen
save exponent count byte
COMPLETE CURRENT EXPONENT
   
.,BD4E F0 12 BEQ $BD62 BEQ FINQNG ;NEGATE?
Zahl= Null, dann zu $BD62
branch if no adjustment
NO ADJUST NEEDED IF EXP=0
   
.,BD50 10 09 BPL $BD5B BPL FINMUL ;POSITIVE SO MULTIPLY.
Zahl kleiner als $7F
else if +ve go do FAC1*10^expcnt
else go do FAC1/10^(0-expcnt)
EXP>0, MULTIPLY BY TEN
   
.,BD52 20 FE BA JSR $BAFE FINDIV: JSR DIV10
FAC = FAC / 10
divide FAC1 by 10
EXP<0, DIVIDE BY TEN
   
.,BD55 E6 5E INC $5E INC TENEXP ;DONE?
Zahl erhöhen
increment exponent count byte
UNTIL EXP=0
   
.,BD57 D0 F9 BNE $BD52 BNE FINDIV ;NO.
unbedingter
loop until all done
     
.,BD59 F0 07 BEQ $BD62 BEQ FINQNG ;YES.
Sprung
branch always
...ALWAYS, WE ARE FINISHED
   
.,BD5B 20 E2 BA JSR $BAE2 FINMUL: JSR MUL10
FAC = FAC * 10
multiply FAC1 by 10
EXP>0, MULTIPLY BKY TEN
   
.,BD5E C6 5E DEC $5E DEC TENEXP ;DONE?
Zahl gemäß
decrement exponent count byte
UNTIL EXP=0
   
.,BD60 D0 F9 BNE $BD5B BNE FINMUL ;NO
Exponenten anpassen
loop until all done
     
.,BD62 A5 67 LDA $67 FINQNG: LDA SGNFLG
wenn negativ,
get -ve flag
IS WHOLE NUMBER NEGATIVE?
   
.,BD64 30 01 BMI $BD67 BMI NEGXQS ;IF POSITIVE, RETURN.
dann Vorzeichen invertieren
if -ve do - FAC1 and return
YES
   
.,BD66 60 RTS RTS
Rücksprung

do - FAC1 and return

NO, RETURN, WHOLE JOB DONE!
   
.,BD67 4C B4 BF JMP $BFB4 NEGXQS: JMP NEGOP ;OTHERWISE, NEGATE AND RETURN.
Vorzeichenwechsel FAC = -FAC
do - FAC1
do unsigned FAC1*10+number
NEGATIVE NUMBER, SO NEGATE FAC

ACCUMULATE A DIGIT INTO FAC

   
.,BD6A 48 PHA FINDIG: PHA
Aufruf durch Mantisse
save character
SAVE DIGIT
   
.,BD6B 24 5F BIT $5F BIT DPTFLG
wenn Vorkommastelle,
test decimal point flag
SEEN A DECIMAL POINT YET?
   
.,BD6D 10 02 BPL $BD71 BPL FINDG1
dann zu $BD71
skip exponent increment if not set
NO, STILL IN INTEGER PART
   
.,BD6F E6 5D INC $5D INC DECCNT
Zähler erhöhen
else increment number exponent
YES, COUNT THE FRACTIONAL DIGIT
   
.,BD71 20 E2 BA JSR $BAE2 FINDG1: JSR MUL10
FAC = FAC * 10
multiply FAC1 by 10
FAC = FAC * 10
   
.,BD74 68 PLA PLA ;GET IT BACK.
ASCII in
restore character
CURRENT DIGIT
   
.,BD75 38 SEC SEC
Ziffer umwandeln
set carry for subtract
<<<SHORTER HERE TO JUST "AND #$0F">>>
   
.,BD76 E9 30 SBC #$30 SBCI "0"
'0' abziehen gibt hex
convert to binary
<<<TO CONVERT ASCII TO BINARY FORM>>>
  0
.,BD78 20 7E BD JSR $BD7E JSR FINLOG ;ADD IT IN.
addiert nächste Stelle zu FAC
evaluate new ASCII digit
ADD THE DIGIT
   
.,BD7B 4C 0A BD JMP $BD0A JMP FINC
nächstes Zeichen
go do next character
evaluate new ASCII digit
multiply FAC1 by 10 then (ABS) add in new digit
GO BACK FOR MORE

ADD (A) TO FAC

 

add signed integer from A to float accu

.,BD7E 48 PHA FINLOG: PHA
Wert aus Stack
save digit
SAVE ADDEND
   
.,BD7F 20 0C BC JSR $BC0C JSR MOVAF ;SAVE FAC FOR LATER.
FAC nach ARG
round and copy FAC1 to FAC2
     
.,BD82 68 PLA PLA
Wert in Stack
restore digit
GET ADDEND AGAIN
   
.,BD83 20 3C BC JSR $BC3C JSR FLOAT ;FLOAT THE VALUE IN ACCA.
Accu in höchste Stelle von FAC
save A as integer byte
CONVERT TO FP VALUE IN FAC
   
.,BD86 A5 6E LDA $6E LDA ARGSGN
FAC-Vorzeichen und
get FAC2 sign (b7)
     
.,BD88 45 66 EOR $66 EOR FACSGN
ARG-Vorzeichen
toggle with FAC1 sign (b7)
     
.,BD8A 85 6F STA $6F STA ARISGN ;RESULTANT SIGN.
verknüpfen
save sign compare (FAC1 EOR FAC2)
     
.,BD8C A6 61 LDX $61 LDX FACEXP ;SET SIGNS ON THING TO ADD.
erste Stelle von FAC holen
get FAC1 exponent
TO SIGNAL IF FAC=0
   
.,BD8E 4C 6A B8 JMP $B86A JMP FADDT ;ADD TOGETHER AND RETURN.
;HERE PACK IN THE NEXT DIGIT OF THE EXPONENT.
;MULTIPLY THE OLD EXP BY 10 AND ADD IN THE NEXT
;DIGIT. NOTE: EXP OVERFLOW IS NOT CHECKED FOR.
FAC = FAC + ARG
add FAC2 to FAC1 and return
evaluate next character of exponential part of number
PERFORM THE ADDITION

ACCUMULATE DIGIT OF EXPONENT

 

get exponent of number from string

.,BD91 A5 5E LDA $5E FINEDG: LDA TENEXP ;GET EXP SO FAR.
Aufruf durch 'E'
get exponent count byte
CHECK CURRENT VALUE
   
.,BD93 C9 0A CMP #$0A CMPI 12 ;WILL RESULT BE .GE. 100?
wenn dritte Exponentenziffer,
compare with 10 decimal
FOR MORE THAN 2 DIGITS
   
.,BD95 90 09 BCC $BDA0 BCC MLEX10
dann zu $BDA0
branch if less
NO, THIS IS 1ST OR 2ND DIGIT
   
.,BD97 A9 64 LDA #$64 LDAI 144 ;GET 100.
wenn Vorzeichen
make all -ve exponents = -100 decimal (causes underflow)
EXPONENT TOO BIG
   
.,BD99 24 60 BIT $60 BIT EXPSGN
negativ,
test exponent -ve flag
UNLESS IT IS NEGATIVE
   
.,BD9B 30 11 BMI $BDAE BMI MLEXMI ;IF NEG EXP, NO CHK FOR OVERR.
dann Unterlauf
branch if -ve
LARGE NEGATIVE EXPONENT MAKES FAC=0
   
.,BD9D 4C 7E B9 JMP $B97E JMP OVERR
zu 'OVERFLOW ERROR'
else do overflow error then warm start
LARGE POSITIVE EXPONENT IS ERROR
   
.,BDA0 0A ASL MLEX10: ASL A, ;MULT BY 2 TWICE
Den
*2
EXPONENT TIMES 10
   
.,BDA1 0A ASL ASL A
Exponenten
*4
     
.,BDA2 18 CLC CLC ;POSSIBLE SHIFT OUT OF HIGH.
mit
clear carry for add
     
.,BDA3 65 5E ADC $5E ADC TENEXP ;LIKE MULTIPLYING BY FIVE.
10
*5
     
.,BDA5 0A ASL ASL A, ;AND NOW BY TEN.
multi-
*10
     
.,BDA6 18 CLC CLC
plizieren
clear carry for add
<<< ASL ALREADY DID THIS! >>>
   
.,BDA7 A0 00 LDY #$00 LDYI 0
Zähler setzen
set index
ADD THE NEW DIGIT
   
.,BDA9 71 7A ADC ($7A),Y ADCDY TXTPTR
Exponenten-
add character (will be $30 too much!)
BUT THIS IS IN ASCII,
   
.,BDAB 38 SEC SEC
ziffer
set carry for subtract
SO ADJUST BACK TO BINARY
   
.,BDAC E9 30 SBC #$30 SBCI "0"
addie-
convert character to binary
    0
.,BDAE 85 5E STA $5E MLEXMI: STA TENEXP ;SAVE RESULT.
ren
save exponent count byte
NEW VALUE
   
.,BDB0 4C 30 BD JMP $BD30 JMP FINEC
PAGE

FLOATING POINT OUTPUT ROUTINE.

IFE ADDPRC,<
NZ0999: 221 ; 99999.9499
103
117
370
NZ9999: 224 ; 999999.499
164
043
367
NZMIL: 224 ; 10^6.
164
044
000>
IFN ADDPRC,<
nächstes Zeichen holen

Konstanten für Fließkomma

nach ASCII

go get next character

limits for scientific mode

BACK FOR MORE
 

constants for float to string conversion

.:BDB3 9B 3E BC 1F FD NZ0999: 233 ; 99999999.9499
076
274
037
375
99999999.9
99999999.90625, maximum value with at least one decimal
99,999,999.9
   
.:BDB8 9E 6E 6B 27 FD NZ9999: 236 ; 999999999.499
156
153
047
375
999999999
999999999.25, maximum value before scientific notation
999,999,999
   
.:BDBD 9E 6E 6B 28 00 NZMIL: 236 ; 10^9
156
153
050
000>
;ENTRY TO LINPRT.
1E9

Ausgabe der Zeilennummer

bei Fehlermeldung

1000000000

do " IN " line number message

1,000,000,000

PRINT "IN <LINE #>"

 

print IN followed by line number

.,BDC2 A9 71 LDA #$71 INPRT: LDWDI INTXT
Zeiger
set " IN " pointer low byte
PRINT " IN "
  low A371
.,BDC4 A0 A3 LDY #$A3   auf 'in'
set " IN " pointer high byte
    high A371
.,BDC6 20 DA BD JSR $BDDA JSR STROU2
String ausgeben
print null terminated string
     
.,BDC9 A5 3A LDA $3A LDA CURLIN+1
laufende
get the current line number high byte
     
.,BDCB A6 39 LDX $39 LDX CURLIN
Zeilennummer holen

positive Integerzahl

in A/X ausgeben

get the current line number low byte

print XA as unsigned integer

PRINT A,X AS DECIMAL INTEGER

 

print number from AX

.,BDCD 85 62 STA $62 LINPRT: STWX FACHO
für Umwandlung
save high byte as FAC1 mantissa1
PRINT A,X IN DECIMAL
   
.,BDCF 86 63 STX $63   in FAC schreiben
save low byte as FAC1 mantissa2
     
.,BDD1 A2 90 LDX #$90 LDXI 220 ;EXPONENT OF 16.
Exponent
set exponent to 16d bits
EXPONENT = 2^16
   
.,BDD3 38 SEC SEC ;NUMBER IS POSITIVE.
= 16
set integer is +ve flag
CONVERT UNSIGNED
   
.,BDD4 20 49 BC JSR $BC49 JSR FLOATC
Integer nach Fließkomma
wandeln
set exponent = X, clear mantissa 4 and 3 and normalise
FAC1
CONVERT LINE # TO FP

CONVERT (FAC) TO STRING, AND PRINT IT

   
.,BDD7 20 DF BD JSR $BDDF JSR FOUT
FAC nach ASCII wandeln
convert FAC1 to string
CONVERT (FAC) TO STRING AT STACK

PRINT STRING STARTING AT Y,A

   
.,BDDA 4C 1E AB JMP $AB1E STROU2: JMP STROUT ;PRINT AND RETURN.
String ausgeben

FAC nach ASCII-Format

wandeln und nach $100

print null terminated string

convert FAC1 to ASCII string result in (AY)

PRINT STRING AT A,Y

CONVERT (FAC) TO STRING STARTING AT STACK

RETURN WITH (Y,A) POINTING AT STRING
 

convert number in float accu to string

.,BDDD A0 01 LDY #$01 FOUT: LDYI 1
Stringzeiger
set index = 1
NORMAL ENTRY PUTS STRING AT STACK...
   
.,BDDF A9 20 LDA #$20 FOUTC: LDAI " " ;PRINT SPACE IF POSITIVE.
' ' Leerzeichen für positive
Zahl
character = " " (assume +ve)
     
.,BDE1 24 66 BIT $66 BIT FACSGN
wenn Vorzeichen
test FAC1 sign (b7)
     
.,BDE3 10 02 BPL $BDE7 BPL FOUT1
positiv ?, dann zu $BDE7
branch if +ve
     
.,BDE5 A9 2D LDA #$2D LDAI "-"
'-' Minuszeichen für
else character = "-"

"STR$" FUNCTION ENTERS HERE, WITH (Y)=0

SO THAT RESULT STRING STARTS AT STACK-1
(THIS IS USED AS A FLAG)
  minus
.,BDE7 99 FF 00 STA $00FF,Y FOUT1: STA FBUFFR-1,Y, ;STORE THE CHARACTER.
negative Zahl
in
save leading character (" " or "-")
EMIT "-"
   
.,BDEA 85 66 STA $66 STA FACSGN ;MAKE FAC POS FOR QINT.
Pufferbereich
save FAC1 sign (b7)
MAKE FAC.SIGN POSITIVE ($2D)
   
.,BDEC 84 71 STY $71 STY FBUFPT ;SAVE FOR LATER.
schreiben
save index
SAVE STRING PNTR
   
.,BDEE C8 INY INY
Zähler erhöhen
increment index
     
.,BDEF A9 30 LDA #$30 LDAI "0" ;GET ZERO TO TYPE IF FAC=0.
'0’
set character = "0"
IN CASE (FAC)=0
  0
.,BDF1 A6 61 LDX $61 LDX FACEXP
Exponent
get FAC1 exponent
NUMBER=0?
   
.,BDF3 D0 03 BNE $BDF8 JEQ FOUT19
wenn Zahl nicht null ?
branch if FAC1<>0
exponent was $00 so FAC1 is 0
NO, (FAC) NOT ZERO
   
.,BDF5 4C 04 BF JMP $BF04   dann fertig
save last character, [EOT] and exit
FAC1 is some non zero value
YES, FINISHED
   
.,BDF8 A9 00 LDA #$00 LDAI 0
FAC
clear (number exponent count)
STARTING VALUE FOR TMPEXP
   
.,BDFA E0 80 CPX #$80 CPXI 200 ;IS NUMBER .LT. 1.0 ?
mit 1 vergleichen
compare FAC1 exponent with $80 (<1.00000)
ANY INTEGER PART?
   
.,BDFC F0 02 BEQ $BE00 BEQ FOUT37 ;NO.
wenn ja ,dann zu $BE00
branch if 0.5 <= FAC1 < 1.0
NO, BTWN .5 AND .999999999
   
.,BDFE B0 09 BCS $BE09 BCS FOUT7
FAC größer 1
branch if FAC1=>1
YES
   
.,BE00 A9 BD LDA #$BD FOUT37: LDWDI NZMIL ;MULTIPLY BY 10^6.
Zeiger auf
set 1000000000 pointer low byte
MULTIPLY BY 1E9
  low BDBD
.,BE02 A0 BD LDY #$BD   Konstante 1E9
set 1000000000 pointer high byte
TO GIVE ADJUSTMENT A HEAD START
  high BDBD
.,BE04 20 28 BA JSR $BA28 JSR FMULT
Konstante (Zeiger A/Y) * FAC
do convert AY, FCA1*(AY)
     
.,BE07 A9 F7 LDA #$F7 LDAI ^D256-3*ADDPRC-6
= -9
set number exponent count
EXPONENT ADJUSTMENT
   
.,BE09 85 5D STA $5D FOUT7: STA DECCNT ;SAVE COUNT OR ZERO IT.
$ 5D = -9
save number exponent count
0 OR -9

ADJUST UNTIL 1E8 <= (FAC) <1E9

   
.,BE0B A9 B8 LDA #$B8 FOUT4: LDWDI NZ9999
Zeiger auf
set 999999999.25 pointer low byte (max before sci note)
    low BDB8
.,BE0D A0 BD LDY #$BD   Konstante 999999999
set 999999999.25 pointer high byte
    high BDB8
.,BE0F 20 5B BC JSR $BC5B JSR FCOMP ;IS NUMBER .GT. 999999.499 ?
;OR 999999999.499?
Vergleich Konstante
(Zeiger A/Y) mit FAC
compare FAC1 with (AY)
COMPARE TO 1E9-1
   
.,BE12 F0 1E BEQ $BE32 BEQ BIGGES
gleich
exit if FAC1 = (AY)
(FAC) = 1E9-1
   
.,BE14 10 12 BPL $BE28 BPL FOUT9 ;YES. MAKE IT SMALLER.
kleiner
go do /10 if FAC1 > (AY)
FAC1 < (AY)
TOO LARGE, DIVIDE BY TEN
   
.,BE16 A9 B3 LDA #$B3 FOUT3: LDWDI NZ0999
Zeiger auf
set 99999999.90625 pointer low byte
COMPARE TO 1E8-.1
  low BDB3
.,BE18 A0 BD LDY #$BD   Konstante 99999999.9
set 99999999.90625 pointer high byte
    high BDB3
.,BE1A 20 5B BC JSR $BC5B JSR FCOMP ;IS NUMBER .GT. 99999.9499 ?
; OR 99999999.9499?
Vergleich Konstante
(Zeiger A/Y) mit FAC
compare FAC1 with (AY)
COMPARE TO 1E8-.1
   
.,BE1D F0 02 BEQ $BE21 BEQ FOUT38
gleich
branch if FAC1 = (AY) (allow decimal places)
(FAC) = 1E8-.1
   
.,BE1F 10 0E BPL $BE2F BPL FOUT5 ;YES. DONE MULTIPLYING.
kleiner
branch if FAC1 > (AY) (no decimal places)
FAC1 <= (AY)
IN RANGE, ADJUSTMENT FINISHED
   
.,BE21 20 E2 BA JSR $BAE2 FOUT38: JSR MUL10 ;MAKE IT BIGGER.
FAC = FAC * 10
multiply FAC1 by 10
TOO SMALL, MULTIPLY BY TEN
   
.,BE24 C6 5D DEC $5D DEC DECCNT
Dezimalexponent erniedrigen
decrement number exponent count
KEEP TRACK OF MULTIPLIES
   
.,BE26 D0 EE BNE $BE16 BNE FOUT3 ;SEE IF THAT DOES IT.
;THIS ALWAYS GOES.
schon 0?
go test again, branch always
...ALWAYS
   
.,BE28 20 FE BA JSR $BAFE FOUT9: JSR DIV10 ;MAKE IT SMALLER.
FAC = FAC / 10
divide FAC1 by 10
TOO LARGE, DIVIDE BY TEN
   
.,BE2B E6 5D INC $5D INC DECCNT
Dezimalexponent erhöhen
increment number exponent count
KEEP TRACK OF DIVISIONS
   
.,BE2D D0 DC BNE $BE0B BNE FOUT4 ;SEE IF THAT DOES IT.
;THIS ALWAYS GOES.
Überlauf ?
go test again, branch always
now we have just the digits to do
...ALWAYS
   
.,BE2F 20 49 B8 JSR $B849 FOUT5: JSR FADDH ;ADD A HALF TO ROUND UP.
FAC = FAC + .5 , runden
add 0.5 to FAC1 (round FAC1)
ROUND ADJUSTED RESULT
   
.,BE32 20 9B BC JSR $BC9B BIGGES: JSR QINT
FAC nach Integer
convert FAC1 floating to fixed
CONVERT ADJUSTED VALUE TO 32-BIT INTEGER
FAC+1...FAC+4 IS NOW IN INTEGER FORM
WITH POWER OF TEN ADJUSTMENT IN TMPEXP
IF -10 < TMPEXP > 1, PRINT IN DECIMAL FORM
OTHERWISE, PRINT IN EXPONENTIAL FORM
   
.,BE35 A2 01 LDX #$01 LDXI 1 ;DECIMAL POINT COUNT.
FAC ist nun im Bereich von
set default digits before dp = 1
ASSUME 1 DIGIT BEFORE "."
   
.,BE37 A5 5D LDA $5D LDA DECCNT
1E8 bis 1E9, $5D hat Wert
get number exponent count
CHECK RANGE
   
.,BE39 18 CLC CLC
von Zehnerpotenz
clear carry for add
     
.,BE3A 69 0A ADC #$0A ADCI 3*ADDPRC+7 ;SHOULD NUMBER BE PRINTED IN E NOTATION?
;IE, IS NUMBER .LT. .01 ?
Zahl =0.01
up to 9 digits before point
     
.,BE3C 30 09 BMI $BE47 BMI FOUTPI ;YES.
Betrag kleiner 0.1 ?
if -ve then 1 digit before dp
< .01, USE EXPONENTIAL FORM
   
.,BE3E C9 0B CMP #$0B CMPI 3*ADDPRC+10 ;IS IT .GT. 999999 (999999999)?
wenn ja, dann
A>=$0B if n>=1E9
     
.,BE40 B0 06 BCS $BE48 BCS FOUT6 ;YES. USE E NOTATION.
Betrag größer 1E9 ?
branch if >= $0B
carry is clear
>= 1E10, USE EXPONENTIAL FORM
   
.,BE42 69 FF ADC #$FF ADCI ^O377 ;NUMBER OF PLACES BEFORE DECIMAL POINT.
die
take 1 from digit count
LESS 1 GIVES INDEX FOR "."
   
.,BE44 AA TAX TAX ;PUT INTO ACCX.
Be-
copy to X
     
.,BE45 A9 02 LDA #$02 LDAI 2 ;NO E NOTATION.
rechnung
set exponent adjust
SET REMAINING EXPONENT = 0
   
.,BE47 38 SEC FOUTPI: SEC
des
set carry for subtract
COMPUTE REMAINING EXPONENT
   
.,BE48 E9 02 SBC #$02 FOUT6: SBCI 2 ;EFFECTIVELY ADD 5 TO ORIG EXP.
Exponenten-
-2
     
.,BE4A 85 5E STA $5E STA TENEXP ;THAT IS THE EXPONENT TO PRINT.
flags
save exponent adjust
VALUE FOR "E+XX" OR "E-XX"
   
.,BE4C 86 5D STX $5D STX DECCNT ;NUMBER OF DECIMAL PLACES.
Negative Darstellung des
save digits before dp count
INDEX FOR DECIMAL POINT
   
.,BE4E 8A TXA TXA
Exponenten
copy to A
SEE IF "." COMES FIRST
   
.,BE4F F0 02 BEQ $BE53 BEQ FOUT39
wenn 0.1, dann zu $BE53
branch if no digits before dp
YES
   
.,BE51 10 13 BPL $BE66 BPL FOUT8 ;SOME PLACES BEFORE DEC PNT.
wenn nicht 0.01, dann
zu $BE66
branch if digits before dp
NO, LATER
   
.,BE53 A4 71 LDY $71 FOUT39: LDY FBUFPT ;GET POINTER TO OUTPUT.
Zeiger für Polynomauswertung
get output string index
GET INDEX INTO STRING BEING BUILT
   
.,BE55 A9 2E LDA #$2E LDAI "." ;PUT IN "."
Nummer für '.'
character "."
STORE A DECIMAL POINT
  decimal point
.,BE57 C8 INY INY
Zeiger erhöhen
increment index
     
.,BE58 99 FF 00 STA $00FF,Y STA FBUFFR-1,Y
in Stringbereich
save to output string
     
.,BE5B 8A TXA TXA
schreiben
  SEE IF NEED ".0"
   
.,BE5C F0 06 BEQ $BE64 BEQ FOUT16
wenn 0.1, dann zu $BE64
  NO
   
.,BE5E A9 30 LDA #$30 LDAI "0" ;GET THE ENSUING ZERO.
Nummer für '0'
character "0"
YES, STORE "0"
  0
.,BE60 C8 INY INY
Zeiger erhöhen
increment index
     
.,BE61 99 FF 00 STA $00FF,Y STA FBUFFR-1,Y
in Stringbereich
save to output string
     
.,BE64 84 71 STY $71 FOUT16: STY FBUFPT ;SAVE FOR LATER.
schreiben
save output string index
SAVE OUTPUT INDEX AGAIN
NOW DIVIDE BY POWERS OF TEN TO GET SUCCESSIVE DIGITS
   
.,BE66 A0 00 LDY #$00 FOUT8: LDYI 0
Zeiger
clear index (point to 100,000)
INDEX TO TABLE OF POWERS OF TEN
   
.,BE68 A2 80 LDX #$80 FOUTIM: LDXI 200 ;FIRST PASS THRU, ACCX HAS MSB SET.
stellen
  STARTING VALUE FOR DIGIT WITH DIRECTION
   
.,BE6A A5 65 LDA $65 FOUT2: LDA FACLO
Durch
get FAC1 mantissa 4
START BY ADDING -100000000 UNTIL
   
.,BE6C 18 CLC CLC
Addition
clear carry for add
OVERSHOOT. THEN ADD +10000000,
   
.,BE6D 79 19 BF ADC $BF19,Y ADC FOUTBL+2+ADDPRC,Y
und
add byte 4, least significant
THEN ADD -1000000, THEN ADD
   
.,BE70 85 65 STA $65 STA FACLO
Subtraktion
save FAC1 mantissa4
+100000, AND SO ON.
   
.,BE72 A5 64 LDA $64 LDA FACMO
der
get FAC1 mantissa 3
THE # OF TIMES EACH POWER IS ADDED
   
.,BE74 79 18 BF ADC $BF18,Y ADC FOUTBL+1+ADDPRC,Y
Werte
add byte 3
IS 1 MORE THAN CORRESPONDING DIGIT
   
.,BE77 85 64 STA $64 STA FACMO
IFN ADDPRC,<
aus
save FAC1 mantissa3
     
.,BE79 A5 63 LDA $63 LDA FACMOH
der
get FAC1 mantissa 2
     
.,BE7B 79 17 BF ADC $BF17,Y ADC FOUTBL+1,Y
Tabelle
add byte 2
     
.,BE7E 85 63 STA $63 STA FACMOH>
werden
save FAC1 mantissa2
     
.,BE80 A5 62 LDA $62 LDA FACHO
die
get FAC1 mantissa 1
     
.,BE82 79 16 BF ADC $BF16,Y ADC FOUTBL,Y
einzelnen
add byte 1, most significant
     
.,BE85 85 62 STA $62 STA FACHO
Ziffern
save FAC1 mantissa1
     
.,BE87 E8 INX INX ;IT WAS DONE YET ANOTHER TIME.
des
increment the digit, set the sign on the test sense bit
COUNT THE ADD
   
.,BE88 B0 04 BCS $BE8E BCS FOUT41
Zahlen-
if the carry is set go test if the result was positive
else the result needs to be negative
IF C=1 AND X NEGATIVE, KEEP ADDING
   
.,BE8A 10 DE BPL $BE6A BPL FOUT2
Strings
not -ve so try again
IF C=0 AND X POSITIVE, KEEP ADDING
   
.,BE8C 30 02 BMI $BE90 BMI FOUT40
be-
else done so return the digit
IF C=0 AND X NEGATIVE, WE OVERSHOT
   
.,BE8E 30 DA BMI $BE6A FOUT41: BMI FOUT2
rech-
not +ve so try again
else done so return the digit
IF C=1 AND X POSITIVE, WE OVERSHOT
   
.,BE90 8A TXA FOUT40: TXA
net
copy the digit
OVERSHOT, SO MAKE X INTO A DIGIT
   
.,BE91 90 04 BCC $BE97 BCC FOUTYP ;CAN USE ACCA AS IS.
alles addiert?, wenn nicht,
dann zu $BE97
if Cb=0 just use it
HOW DEPENDS ON DIRECTION WE WERE GOING
   
.,BE93 49 FF EOR #$FF EORI 377 ;FIND 11.-[A].
Ergebnis mit 10
else make the 2's complement ..
DIGIT = 9-X
   
.,BE95 69 0A ADC #$0A ADCI 12 ;C IS STILL ON TO COMPLETE NEGATION.
;AND WILL ALWAYS BE ON AFTER.
komplementieren
.. and subtract it from 10
     
.,BE97 69 2F ADC #$2F FOUTYP: ADCI "0"-1 ;GET A CHARACTER TO PRINT.
'0' - 1
add "0"-1 to result
MAKE DIGIT INTO ASCII
   
.,BE99 C8 INY REPEAT 3+ADDPRC,<INY> ;BUMP POINTER UP.
Zähler
increment ..
ADVANCE TO NEXT SMALLER POWER OF TEN
   
.,BE9A C8 INY   ent-
.. index to..
     
.,BE9B C8 INY   sprechend
.. next less ..
     
.,BE9C C8 INY   erhöhen
.. power of ten
     
.,BE9D 84 47 STY $47 STY FDECPT
Zähler sichern
save current variable pointer low byte
SAVE PNTR TO POWERS
   
.,BE9F A4 71 LDY $71 LDY FBUFPT
Zeiger auf Stringbereich laden
get output string index
GET OUTPUT PNTR
   
.,BEA1 C8 INY INY ;POINT TO PLACE TO STORE OUTPUT.
und erhöhen
increment output string index
STORE THE DIGIT
   
.,BEA2 AA TAX TAX
Ziffer
copy character to X
SAVE DIGIT, HI-BIT IS DIRECTION
   
.,BEA3 29 7F AND #$7F ANDI 177 ;GET RID OF MSB.
in
mask out top bit
MAKE SURE $30...$39 FOR STRING
   
.,BEA5 99 FF 00 STA $00FF,Y STA FBUFFR-1,Y
Stringbereich
save to output string
     
.,BEA8 C6 5D DEC $5D DEC DECCNT
bringen
decrement # of characters before the dp
COUNT THE DIGIT
   
.,BEAA D0 06 BNE $BEB2 BNE STXBUF ;NOT TIME FOR DP YET.
wenn Einerstelle nicht
erreicht, dann zu $BEB2
branch if still characters to do
else output the point
NOT TIME FOR "." YET
   
.,BEAC A9 2E LDA #$2E LDAI "."
Nummer für '.'
character "."
TIME, SO STORE THE DECIMAL POINT
   
.,BEAE C8 INY INY
Zähler erhöhen
increment output string index
     
.,BEAF 99 FF 00 STA $00FF,Y STA FBUFFR-1,Y, ;STORE DP.
in Stringbereich schreiben
save to output string
     
.,BEB2 84 71 STY $71 STXBUF: STY FBUFPT ;STORE PNTR FOR LATER.
Zähler speichern
save output string index
SAVE OUTPUT PNTR AGAIN
   
.,BEB4 A4 47 LDY $47 LDY FDECPT
Neuen Zähler holen
get current variable pointer low byte
GET PNTR TO POWERS
   
.,BEB6 8A TXA FOUTCM: TXA ;COMPLEMENT ACCX
FAC-
get character back
GET DIGIT WITH HI-BIT = DIRECTION
   
.,BEB7 49 FF EOR #$FF EORI 377 ;COMPLEMENT ACCA.
Um-
toggle the test sense bit
CHANGE DIRECTION
   
.,BEB9 29 80 AND #$80 ANDI 200 ;SAVE ONLY MSB.
wand-
clear the digit
$00 IF ADDING, $80 IF SUBTRACTING
   
.,BEBB AA TAX TAX
lung
copy it to the new digit
     
.,BEBC C0 24 CPY #$24 CPYI FDCEND-FOUTBL
IFN TIME,<
Tabellenende ereicht,
compare the table index with the max for decimal numbers
     
.,BEBE F0 04 BEQ $BEC4 BEQ FOULDY
dann zu $BEC4
if at the max exit the digit loop
     
.,BEC0 C0 3C CPY #$3C CPYI TIMEND-FOUTBL>
Tabellenende bei
TI$-Berechnung
compare the table index with the max for time
     
.,BEC2 D0 A6 BNE $BE6A BNE FOUT2 ;CONTINUE WITH OUTPUT.
nicht erreicht, dann zu $BE6A
loop if not at the max
now remove trailing zeroes
NOT FINISHED YET
NINE DIGITS HAVE BEEN STORED IN STRING. NOW LOOK
BACK AND LOP OFF TRAILING ZEROES AND A TRAILING
DECIMAL POINT.
   
.,BEC4 A4 71 LDY $71 FOULDY: LDY FBUFPT ;GET BACK OUTPUT PNTR.
Zähler wieder holen
restore the output string index
POINTS AT LAST STORED CHAR
   
.,BEC6 B9 FF 00 LDA $00FF,Y FOUT11: LDA FBUFFR-1,Y, ;REMOVE TRAILING ZEROES.
letzte Stelle suchen
get character from output string
SEE IF LOPPABLE
   
.,BEC9 88 DEY DEY
Zähler erniedrigen
decrement output string index
     
.,BECA C9 30 CMP #$30 CMPI "0"
Nummer für '0'
compare with "0"
SUPPRESS TRAILING ZEROES
  0
.,BECC F0 F8 BEQ $BEC6 BEQ FOUT11
wenn ja, dann zu $BEC6
loop until non "0" character found
YES, KEEP LOOPING
   
.,BECE C9 2E CMP #$2E CMPI "."
Nummer für '.'
compare with "."
SUPPRESS TRAILING DECIMAL POINT
  decimal point
.,BED0 F0 01 BEQ $BED3 BEQ FOUT12 ;RUN INTO DP. STOP.
wenn ja, dann zu $BED3
branch if was dp
restore last character
".", SO WRITE OVER IT
   
.,BED2 C8 INY INY ;SOMETHING ELSE. SAVE IT.
Zähler erhöhen
increment output string index
NOT ".", SO INCLUDE IN STRING AGAIN
   
.,BED3 A9 2B LDA #$2B FOUT12: LDAI "+"
Nummer für '+'
character "+"
PREPARE FOR POSITIVE EXPONENT "E+XX"
  plus
.,BED5 A6 5E LDX $5E LDX TENEXP
wenn Flag nicht gesetzt,
get exponent count
SEE IF ANY E-VALUE
   
.,BED7 F0 2E BEQ $BF07 BEQ FOUT17 ;NO EXPONENT TO OUTPUT.
dann zu $BF07
if zero go set null terminator and exit
exponent isn't zero so write exponent
NO, JUST MARK END OF STRING
   
.,BED9 10 08 BPL $BEE3 BPL FOUT14
wenn Exponent positiv, dann
zu $BEE3
branch if exponent count +ve
YES, AND IT IS POSITIVE
   
.,BEDB A9 00 LDA #$00 LDAI 0
Den
clear A
YES, AND IT IS NEGATIVE
   
.,BEDD 38 SEC SEC
Exponenten
set carry for subtract
COMPLEMENT THE VALUE
   
.,BEDE E5 5E SBC $5E SBC TENEXP
be-
subtract exponent count adjust (convert -ve to +ve)
     
.,BEE0 AA TAX TAX
rechnen
copy exponent count to X
GET MAGNITUDE IN X
   
.,BEE1 A9 2D LDA #$2D LDAI "-" ;EXPONENT IS NEGATIVE.
Nummer für '-'
character "-"
E SIGN
  minus
.,BEE3 99 01 01 STA $0101,Y FOUT14: STA FBUFFR-1+2,Y, ;STORE SIGN OF EXP
in Stringbereich schreiben
save to output string
STORE SIGN IN STRING
   
.,BEE6 A9 45 LDA #$45 LDAI "E"
Nummer für 'E'
character "E"
STORE "E" IN STRING BEFORE SIGN
   
.,BEE8 99 00 01 STA $0100,Y STA FBUFFR-1+1,Y, ;STORE THE "E" CHARACTER.
in Stringbereich schreiben
save exponent sign to output string
     
.,BEEB 8A TXA TXA
Zehner-
get exponent count back
EXPONENT MAGNITUDE IN A-REG
   
.,BEEC A2 2F LDX #$2F LDXI "0"-1
stelle
one less than "0" character
SEED FOR EXPONENT DIGIT
   
.,BEEE 38 SEC SEC
für
set carry for subtract
CONVERT TO DECIMAL
   
.,BEEF E8 INX FOUT15: INX ;MOVE CLOSER TO OUTPUT VALUE.
den
increment 10's character
COUNT THE SUBTRACTION
   
.,BEF0 E9 0A SBC #$0A SBCI 12 ;SUBTRACT 10.
Exponenten
subtract 10 from exponent count
TEN'S DIGIT
   
.,BEF2 B0 FB BCS $BEEF BCS FOUT15 ;NOT NEGATIVE YET.
berechnen
loop while still >= 0
MORE TENS TO SUBTRACT
   
.,BEF4 69 3A ADC #$3A ADCI "0"+12 ;GET SECOND OUTPUT CHARACTER.
'9' + 1
add character ":" ($30+$0A, result is 10 less that value)
CONVERT REMAINDER TO ONE'S DIGIT
   
.,BEF6 99 03 01 STA $0103,Y STA FBUFFR-1+4,Y, ;STORE HIGH DIGIT.
in Stringbereich schreiben
save to output string
STORE ONE'S DIGIT
   
.,BEF9 8A TXA TXA
Zehnerstelle
copy 10's character
     
.,BEFA 99 02 01 STA $0102,Y STA FBUFFR-1+3,Y, ;STORE LOW DIGIT.
in Stringbereich schreiben
save to output string
STORE TEN'S DIGIT
   
.,BEFD A9 00 LDA #$00 LDAI 0 ;PUT IN TERMINATOR.
Puffer mit $0
set null terminator
MARK END OF STRING WITH $00
   
.,BEFF 99 04 01 STA $0104,Y STA FBUFFR-1+5,Y,
abschließen
save to output string
     
.,BF02 F0 08 BEQ $BF0C BEQA FOUT20 ;RETURN. (ALWAYS BRANCHES).
unbedingter Sprung
go set string pointer (AY) and exit, branch always
save last character, [EOT] and exit
...ALWAYS
   
.,BF04 99 FF 00 STA $00FF,Y FOUT19: STA FBUFFR-1,Y, ;STORE THE CHARACTER.
Puffer
save last character to output string
set null terminator and exit
STORE "0" IN ASCII
   
.,BF07 A9 00 LDA #$00 FOUT17: LDAI 0 ;A TERMINATOR.
mit $0
set null terminator
STORE $00 ON END OF STRING
   
.,BF09 99 00 01 STA $0100,Y STA FBUFFR-1+1,Y
abschließen
save after last character
set string pointer (AY) and exit
     
.,BF0C A9 00 LDA #$00 FOUT20: LDWDI FBUFFR
Zeiger auf
set result string pointer low byte
POINT Y,A AT BEGINNING OF STRING
  low 0100
.,BF0E A0 01 LDY #$01   Puffer $100
set result string pointer high byte
(STR$ STARTED STRING AT STACK-1, BUT
  high 0100
.,BF10 60 RTS FPWRRT: RTS ;ALL DONE.
Rücksprung

constants

STR$ DOESN'T USE Y,A ANYWAY.)
 

0.5

.:BF11 80 00 00 00 00 FHALF: 200 ;1/2
000
ZERO: 000
000
IFN ADDPRC,<0>
;POWER OF TEN TABLE
IFE ADDPRC,<
FOUTBL: 376 ;-100000
171
140
000 ;10000
047
020
377 ;-1000
374
030
000 ;100
000
144
377 ;-10
377
366
000 ;1
000
001>
IFN ADDPRC,<
Konstante 0.5 für
SQR-Funktion

Konstanten für Gleitkomma

nach ASCII

(32-Bit Binärzahlen mit Vorzeichen)
0.5, first two bytes

POWERS OF 10 FROM 1E8 DOWN TO 1,

AS 32-BIT INTEGERS, WITH ALTERNATING SIGNS
 

divisors for decimal conversion

.:BF16 FA 0A 1F 00 FOUTBL: 372 ;-100,000,000
012
037
000
-100 000 000
null return for undefined variables
-100 000 000
-100000000
   
.:BF1A 00 98 96 80 000 ;10,000,000
230
226
200
10 000 000
+10 000 000
10000000
   
.:BF1E FF F0 BD C0 377 ;-1,000,000
360
275
300
-1 000 000
-1 000 000
-1000000
   
.:BF22 00 01 86 A0 000 ;100,000
001
206
240
100 000
+100 000
100000
   
.:BF26 FF FF D8 F0 377 ;-10,000
377
330
360
-10 000
-10 000
-10000
   
.:BF2A 00 00 03 E8 000 ;1000
000
003
350
1 000
+1 000
1000
   
.:BF2E FF FF FF 9C 377 ;-100
377
377
234
- 100
- 100
-100
   
.:BF32 00 00 00 0A 000 ;10
000
000
012
10
+10
10
   
.:BF36 FF FF FF FF 377 ;-1
377
377
377>
FDCEND:
IFN TIME,<
-1

Konstanten für Umwandlung

TI nach TI$

-1

jiffy counts

-1
 

divisors for time conversion

.:BF3A FF DF 0A 80 377 ; -2160000 FOR TIME CONVERTER.
337
012
200
-2 160 000
-2160000 10s hours
     
.:BF3E 00 03 4B C0 000 ; 216000
003
113
300
216 000
+216000 hours
     
.:BF42 FF FF 73 60 377 ; -36000
377
163
140
-36 000
-36000 10s mins
     
.:BF46 00 00 0E 10 000 ; 3600
000
016
020
3 600
+3600 mins
     
.:BF4A FF FF FD A8 377 ; -600
377
375
250
- 600
-600 10s secs
     
.:BF4E 00 00 00 3C 000 ; 60
000
000
074
TIMEND:>
60
+60 secs

not referenced

   

unused

is this some version id?
.:BF52 EC     checksum byte

spare bytes, not referenced

   

unused

.:BF53 AA AA AA AA AA            
.:BF58 AA AA AA AA AA AA AA AA            
.:BF60 AA AA AA AA AA AA AA AA            
.:BF68 AA AA AA AA AA AA AA AA            
.:BF70 AA PAGE

EXPONENTIATION AND SQUARE ROOT FUNCTION.

;SQUARE ROOT FUNCTION --- SQR(A)
;USE SQR(X)=X^.5

BASIC-Funktion SQR

perform SQR()

"SQR" FUNCTION

<<< UNFORTUNATELY, RATHER THAN A NEWTON-RAPHSON >>>
<<< ITERATION, MS BASIC USES EXPONENTIATION >>>
<<< SQR(X) = X^.5 >>>
 

SQR function

.,BF71 20 0C BC JSR $BC0C SQR: JSR MOVAF ;MOVE FAC INTO ARG.
FAC runden und nach ARG
round and copy FAC1 to FAC2
     
.,BF74 A9 11 LDA #$11 LDWDI FHALF
Zeiger auf
set 0.5 pointer low address
SET UP POWER OF 0.5
   
.,BF76 A0 BF LDY #$BF   Konstante 0.5

Potenzierung FAC = ARG

hoch Konstante (A/Y)

set 0.5 pointer high address
     
.,BF78 20 A2 BB JSR $BBA2 JSR MOVFM ;PUT MEMORY INTO FAC.
;LAST THING FETCHED IS FACEXP. INTO ACCX.
; JMP FPWRT ;FALL INTO FPWRT.
;EXPONENTIATION --- X^Y.
;N.B. 0^0=1
;FIRST CHECK IF Y=0. IF SO, THE RESULT IS 1.
;NEXT CHECK IF X=0. IF SO THE RESULT IS 0.
;THEN CHECK IF X.GT.0. IF NOT CHECK THAT Y IS AN INTEGER.
;IF SO, NEGATE X, SO THAT LOG DOESN'T GIVE FCERR.
;IF X IS NEGATIVE AND Y IS ODD, NEGATE THE RESULT
;RETURNED BY EXP.
;TO COMPUTE THE RESULT USE X^Y=EXP((Y*LOG(X)).
Konstante nach FAC

Potenzierung FAC = ARG

hoch FAC

unpack memory (AY) into FAC1

perform power function

EXPONENTIATION OPERATION

ARG ^ FAC = EXP( LOG(ARG) * FAC )
 

power operator

.,BF7B F0 70 BEQ $BFED FPWRT: BEQ EXP ;IF FAC=0, JUST EXPONENTIATE THAT.
wenn FAC=0, dann zu $BFED
perform EXP()
IF FAC=0, ARG^FAC=EXP(0)
   
.,BF7D A5 69 LDA $69 LDA ARGEXP ;IS X=0?
Exponent ARG = Basis
get FAC2 exponent
IF ARG=0, ARG^FAC=0
   
.,BF7F D0 03 BNE $BF84 BNE FPWRT1
nicht null ?,
branch if FAC2<>0
NEITHER IS ZERO
   
.,BF81 4C F9 B8 JMP $B8F9 JMP ZEROF1 ;ZERO FAC.
dann fertig
clear FAC1 exponent and sign and return
SET FAC = 0
   
.,BF84 A2 4E LDX #$4E FPWRT1: LDXYI TEMPF3 ;SAVE FOR LATER IN A TEMP.
Zeiger auf
set destination pointer low byte
SAVE FAC IN TEMP3
  low 004E
.,BF86 A0 00 LDY #$00   Hilfsakku
set destination pointer high byte
    high 004E
.,BF88 20 D4 BB JSR $BBD4 JSR MOVMF
;Y=0 ALREADY. GOOD IN CASE NO ONE CALLS INT.
FAC nach Hilfsakku
pack FAC1 into (XY)
     
.,BF8B A5 6E LDA $6E LDA ARGSGN
Exponent FAC = Potenzexponent
get FAC2 sign (b7)
NORMALLY, ARG MUST BE POSITIVE
   
.,BF8D 10 0F BPL $BF9E BPL FPWR1 ;NO PROBLEMS IF X.GT.0.
kleiner eins ?,
branch if FAC2>0
else FAC2 is -ve and can only be raised to an
integer power which gives an x + j0 result
IT IS POSITIVE, SO ALL IS WELL
   
.,BF8F 20 CC BC JSR $BCCC JSR INT ;INTEGERIZE THE FAC.
dann INT-Funktion
perform INT()
NEGATIVE, BUT OK IF INTEGRAL POWER
   
.,BF92 A9 4E LDA #$4E LDWDI TEMPF3 ;GET ADDR OF COMPERAND.
Zeiger auf
set source pointer low byte
SEE IF INT(FAC)=FAC
  low 004E
.,BF94 A0 00 LDY #$00   Hilfsakku
set source pointer high byte
    high 004E
.,BF96 20 5B BC JSR $BC5B JSR FCOMP ;EQUAL?
mit FAC vergleichen
compare FAC1 with (AY)
IS IT AN INTEGER POWER?
   
.,BF99 D0 03 BNE $BF9E BNE FPWR1 ;LEAVE X NEG. LOG WILL BLOW HIM OUT.
;A=-1 AND Y IS IRRELEVANT.
Exponent nicht ganzzahlig,
dann zu $BF9E
branch if FAC1 <> (AY) to allow Function Call error
this will leave FAC1 -ve and cause a Function Call
error when LOG() is called
NOT INTEGRAL, WILL CAUSE ERROR LATER
   
.,BF9B 98 TYA TYA ;NEGATE X. MAKE POSITIVE.
Akku= 4
clear sign b7
MAKE ARG SIGN + AS IT IS MOVED TO FAC
   
.,BF9C A4 07 LDY $07 LDY INTEGR ;GET EVENNESS.
Exponentenstelle
get FAC1 mantissa 4 from INT() function as sign in
Y for possible later negation, b0 only needed
INTEGRAL, SO ALLOW NEGATIVE ARG
   
.,BF9E 20 FE BB JSR $BBFE FPWR1: JSR MOVFA1 ;ALTERNATE ENTRY POINT.
ARG nach FAC
save FAC1 sign and copy ABS(FAC2) to FAC1
MOVE ARGUMENT TO FAC
   
.,BFA1 98 TYA TYA
Exponentenstelle
copy sign back ..
SAVE FLAG FOR NEGATIVE ARG (0=+)
   
.,BFA2 48 PHA PHA ;SAVE EVENNESS FOR LATER.
in Stack
.. and save it
     
.,BFA3 20 EA B9 JSR $B9EA JSR LOG ;FIND LOG.
LOG-Funktion
perform LOG()
GET LOG(ARG)
   
.,BFA6 A9 4E LDA #$4E LDWDI TEMPF3 ;MULTIPLY FAC TIMES LOG(X).
Zeiger auf
set pointer low byte
MULTIPLY BY POWER
  low 004E
.,BFA8 A0 00 LDY #$00   Hilfsakku
set pointer high byte
    high 004E
.,BFAA 20 28 BA JSR $BA28 JSR FMULT
mit FAC multiplizieren
do convert AY, FCA1*(AY)
     
.,BFAD 20 ED BF JSR $BFED JSR EXP ;EXPONENTIATE THE FAC.
EXP-Funktion
perform EXP()
E ^ LOG(FAC)
   
.,BFB0 68 PLA PLA
Exponent aus Stack
pull sign from stack
GET FLAG FOR NEGATIVE ARG
   
.,BFB1 4A LSR LSR A, ;IS IT EVEN?
wenn Exponent gradzahlig,
b0 is to be tested
<<<LSR,BCC COULD BE MERELY BPL>>>
   
.,BFB2 90 0A BCC $BFBE BCC NEGRTS ;YES. OR X.GT.0.
;NEGATE THE NUMBER IN FAC.
dann fertig

Vorzeichenwechsel

if no bit then exit
do - FAC1
NOT NEGATIVE, FINISHED
NEGATIVE ARG, SO NEGATE RESULT

NEGATE VALUE IN FAC

 

minus operator

.,BFB4 A5 61 LDA $61 NEGOP: LDA FACEXP
Exponent
get FAC1 exponent
IF FAC=0, NO NEED TO COMPLEMENT
   
.,BFB6 F0 06 BEQ $BFBE BEQ NEGRTS
Zahl gleich null, dann fertig
exit if FAC1_e = $00
YES, FAC=0
   
.,BFB8 A5 66 LDA $66 COM FACSGN
Vorzeichen
get FAC1 sign (b7)
NO, SO TOGGLE SIGN
   
.,BFBA 49 FF EOR #$FF   invertieren und
complement it
     
.,BFBC 85 66 STA $66   speichern
save FAC1 sign (b7)
     
.,BFBE 60 RTS NEGRTS: RTS
PAGE

EXPONENTIATION FUNCTION.

;FIRST SAVE THE ORIGINAL ARGUMENT AND MULTIPLY THE FAC BY
;LOG2(E). THE RESULT IS USED TO DETERMINE IF OVERFLOW
;WILL OCCUR SINCE EXP(X)=2^(X*LOG2(E)) WHERE
;LOG2(E)=LOG(E) BASE 2. THEN SAVE THE INTEGER PART OF
;THIS TO SCALE THE ANSWER AT THE END. SINCE
;2^Y=2^INT(Y)*2^(Y-INT(Y)) AND 2^INT(Y) IS EASY TO COMPUTE.
;NOW COMPUTE 2^(X*LOG2(E)-INT(X*LOG2(E)) BY
;P(LN(2)*(INT(X*LOG2(E))+1)-X) WHERE P IS AN APPROXIMATION
;POLYNOMIAL. THE RESULT IS THEN SCALED BY THE POWER OF 2
;PREVIOUSLY SAVED.
Rücksprung

Konstanten für EXP

exp(n) constant and series

   

floating point constands for EXP

1/LOG(2)
.:BFBF 81 38 AA 3B 29 LOGEB2: 201 ;LOG(E) BASE 2.
070
252
073
IFN ADDPRC,<051>
ife addprc,<
expcon: 6 ; degree -1.
164 ; .00021702255
143
220
214
167 ; .0012439688
043
014
253
172 ; .0096788410
036
224
000
174 ; .055483342
143
102
200
176 ; .24022984
165
376
320
200 ; .69314698
061
162
025
201 ; 1.0
000
000
000>
IFN ADDPRC,<
1.44269504 = 1/LOG(2)
1.44269504 = 1/LOG(2)
LOG(E) TO BASE 2
 

EXP polynomial table

.:BFC4 07 EXPCON: 7 ;DEGREE-1
7 = Polynomgrad, 8
Koeffizienten
series count
( # OF TERMS IN POLYNOMIAL) - 1
  degree 8
.:BFC5 71 34 58 3E 56 161 ; .000021498763697
064
130
076
126
2.14987637E-5
2.14987637E-5
(LOG(2)^7)/8!
   
.:BFCA 74 16 7E B3 1B 164 ; .00014352314036
026
176
263
033
1.4352314E-4
1.43523140E-4
(LOG(2)^6)/7!
   
.:BFCF 77 2F EE E3 85 167 ; .0013422634824
057
356
343
205
1.34226348E-3
1.34226348E-3
(LOG(2)^5)/6!
   
.:BFD4 7A 1D 84 1C 2A 172 ; .0096140170119
035
204
034
052
9.614011701E-3
9.61401701E-3
(LOG(2)^4)/5!
   
.:BFD9 7C 63 59 58 0A 174 ; .055505126860
143
131
130
012
.0555051269
5.55051269E-2
(LOG(2)^3)/4!
   
.:BFDE 7E 75 FD E7 C6 176 ; .24022638462
165
375
347
306
.240226385
2.40226385E-1
(LOG(2)^2)/3!
   
.:BFE3 80 31 72 18 10 200 ; .69314718608
061
162
030
020
.693147186
6.93147186E-1
LOG(2)/2!
   
.:BFE8 81 00 00 00 00 201 ; 1.0
000
000
000
000>
EXP:
1

BASIC-Funktion EXP

1.00000000

perform EXP()

1

"EXP" FUNCTION

FAC = E ^ FAC
 

EXP command

.,BFED A9 BF LDA #$BF LDWDI LOGEB2 ;MULTIPLY BY LOG(E) BASE 2.
Zeiger auf
set 1.443 pointer low byte
CONVERT TO POWER OF TWO PROBLEM
   
.,BFEF A0 BF LDY #$BF   Konstante 1/LOG(2)
set 1.443 pointer high byte
E^X = 2^(LOG2(E)*X)
   
.,BFF1 20 28 BA JSR $BA28 JSR FMULT
mit FAC multiplizieren
do convert AY, FCA1*(AY)
     
.,BFF4 A5 70 LDA $70 LDA FACOV
80 zu Rundungsstelle
get FAC1 rounding byte
NON-STANDARD ROUNDING HERE
   
.,BFF6 69 50 ADC #$50 ADCI 120
addieren
+$50/$100
ROUND UP IF EXTENSION > $AF
   
.,BFF8 90 03 BCC $BFFD BCC STOLD
wenn kleiner als $FF, dann
zu $BFFD
skip rounding if no carry
NO, DON'T ROUND UP
   
.,BFFA 20 23 BC JSR $BC23 JSR INCRND
Mantisse von FAC um
eins erhöhen
round FAC1 (no check)
     
.,BFFD 4C 00 E0 JMP $E000   weiter bei $E000
continue EXP()

start of the kernal ROM

EXP() continued
   

continuation of EXP function

.,E000 85 56 STA $56 STOLD: STA OLDOV
Rundungsstelle
save FAC2 rounding byte
STRANGE VALUE
   
.,E002 20 0F BC JSR $BC0F JSR MOVEF ;TO SAVE IN ARG WITHOUT ROUND.
FAC nach ARG bringen
copy FAC1 to FAC2
COPY FAC INTO ARG
   
.,E005 A5 61 LDA $61 LDA FACEXP
Exponent
get FAC1 exponent
MAXIMUM EXPONENT IS < 128
   
.,E007 C9 88 CMP #$88 CMPI 210 ;IF ABS(FAC) .GE. 128, TOO BIG.
Zahl größer 128 ?,
compare with EXP limit (256d)
WITHIN RANGE?
   
.,E009 90 03 BCC $E00E BCC EXP1
dann zu $E00E
branch if less
YES
   
.,E00B 20 D4 BA JSR $BAD4 GOMLDV: JSR MLDVEX ;OVERFLOW OR OVERFLOW.
falls positiv 'OVERFLOW'
handle overflow and underflow
OVERFLOW IF +, RETURN 0.0 IF -
   
.,E00E 20 CC BC JSR $BCCC EXP1: JSR INT
INTEGER-Funktion
perform INT()
GET INT(FAC)
   
.,E011 A5 07 LDA $07 LDA INTEGR ;GET LOW PART.
ganze Zahl
get mantissa 4 from INT()
THIS IS THE INETGRAL PART OF THE POWER
   
.,E013 18 CLC CLC
Zahl
clear carry for add
ADD TO EXPONENT BIAS + 1
   
.,E014 69 81 ADC #$81 ADCI 201
gleich
normalise +1
     
.,E016 F0 F3 BEQ $E00B BEQ GOMLDV ;OVERFLOW OR OVERFLOW !!
127 ?, dann zu $E00B
if $00 result has overflowed so go handle it
OVERFLOW
   
.,E018 38 SEC SEC
ansonsten
set carry for subtract
BACK OFF TO NORMAL BIAS
   
.,E019 E9 01 SBC #$01 SBCI 1 ;SUBTRACT 1.
subtrahieren
exponent now correct
     
.,E01B 48 PHA PHA ;SAVE A WHILE.
und in Stack
save FAC2 exponent
swap FAC1 and FAC2
SAVE EXPONENT
   
.,E01C A2 05 LDX #$05 LDXI 4+ADDPRC ;PREP TO SWAP FAC AND ARG.
FAC
4 bytes to do
SWAP ARG AND FAC
   
.,E01E B5 69 LDA $69,X SWAPLP: LDA ARGEXP,X
und
get FAC2,X
<<< WHY SWAP? IT IS DOING >>>
   
.,E020 B4 61 LDY $61,X LDY FACEXP,X
ARG
get FAC1,X
<<< -(A-B) WHEN (B-A) IS THE >>>
   
.,E022 95 61 STA $61,X STA FACEXP,X
ver-
save FAC1,X
<<< SAME THING! >>>
   
.,E024 94 69 STY $69,X STY ARGEXP,X
tauschen
save FAC2,X
     
.,E026 CA DEX DEX
Zähler erniedrigen
decrement count/index
     
.,E027 10 F5 BPL $E01E BPL SWAPLP
schon alle Zeichen?
loop if not all done
     
.,E029 A5 56 LDA $56 LDA OLDOV
Rundungs-
get FAC2 rounding byte
     
.,E02B 85 70 STA $70 STA FACOV
stelle
save as FAC1 rounding byte
     
.,E02D 20 53 B8 JSR $B853 JSR FSUBT
ARG - FAC
perform subtraction, FAC2 from FAC1
POWER-INT(POWER) --> FRACTIONAL PART
   
.,E030 20 B4 BF JSR $BFB4 JSR NEGOP ;NEGATE FAC.
Vorzeichenwechsel
do - FAC1
     
.,E033 A9 C4 LDA #$C4 LDWDI EXPCON
Zeiger auf
set counter pointer low byte
     
.,E035 A0 BF LDY #$BF   Polynomkoeffizienten
set counter pointer high byte
     
.,E037 20 59 E0 JSR $E059 JSR POLY
Polynom berechnen
go do series evaluation
COMPUTE F(X) ON FRACTIONAL PART
   
.,E03A A9 00 LDA #$00 CLR ARISGN ;MULTIPLY BY POSITIVE 1.0.
Vergleichsbyte
clear A
     
.,E03C 85 6F STA $6F   löschen
clear sign compare (FAC1 EOR FAC2)
     
.,E03E 68 PLA PLA ;GET SCALE FACTOR.
Zahl aus Stack
get saved FAC2 exponent
GET EXPONENT
   
.,E03F 20 B9 BA JSR $BAB9 JSR MLDEXP ;MODIFY FACEXP AND CHECK FOR OVERFLOW.
Exponenten von
FAC und ARG addieren
test and adjust accumulators
     
.,E042 60 RTS RTS ;HAS TO DO JSR DUE TO PULAS IN MULDIV.
PAGE

POLYNOMIAL EVALUATOR AND THE RANDOM NUMBER GENERATOR.

;EVALUATE P(X^2)*X
;POINTER TO DEGREE IS IN [Y,A].
;THE CONSTANTS FOLLOW THE DEGREE.
;FOR X=FAC, COMPUTE:
; C0*X+C1*X^3+C2*X^5+C3*X^7+...+C(N)*X^(2*N+1)
Rücksprung

Polynomberechnung

y=a1*x+a2*x^3+a3*x^5+...

^2 then series evaluation
<<< WASTED BYTE HERE, COULD HAVE >>>
<<< JUST USED "JMP ADD.EXPO..." >>>

ODD POLYNOMIAL SUBROUTINE

F(X) = X * P(X^2)
WHERE: X IS VALUE IN FAC
Y,A POINTS AT COEFFICIENT TABLE
FIRST BYTE OF COEFF. TABLE IS N
COEFFICIENTS FOLLOW, HIGHEST POWER FIRST
P(X^2) COMPUTED USING NORMAL POLYNOMIAL SUBROUTINE
 

compute odd degrees for SIN and ATN

.,E043 85 71 STA $71 POLYX: STWD POLYPT ;RETAIN POLYNOMIAL POINTER FOR LATER.
Zeiger auf
save count pointer low byte
SAVE ADDRESS OF COEFFICIENT TABLE
   
.,E045 84 72 STY $72   Polynomkoeffizienten
save count pointer high byte
     
.,E047 20 CA BB JSR $BBCA JSR MOV1F ;SAVE FAC IN FACTMP.
FAC nach Akku #3 bringen
pack FAC1 into $57
     
.,E04A A9 57 LDA #$57 LDAI TEMPF1
Zeiger auf Akku #3
set pointer low byte (Y already $00)
Y=0 ALREADY, SO Y,A POINTS AT TEMP1
   
.,E04C 20 28 BA JSR $BA28 JSR FMULT ;COMPUTE X^2.
FAC * Akku #3 (quadrieren)
do convert AY, FCA1*(AY)
FORM X^2
   
.,E04F 20 5D E0 JSR $E05D JSR POLY1 ;COMPUTE P(X^2).
Polynomberechnung
go do series evaluation
DO SERIES IN X^2
   
.,E052 A9 57 LDA #$57 LDWDI TEMPF1
Zeiger auf
pointer to original # low byte
GET X AGAIN
   
.,E054 A0 00 LDY #$00   Akku #3
pointer to original # high byte
     
.,E056 4C 28 BA JMP $BA28 JMP FMULT ;MULTIPLY BY FAC AGAIN.
;POLYNOMIAL EVALUATOR.
;POINTER TO DEGREE IS IN [Y,A].
;COMPUTE:
; C0+C1*X+C2*X^2+C3*X^3+C4*X^4+...+C(N-1)*X^(N-1)+C(N)*X^N.
FAC = FAC * Akku #3

Polynomberechnung

y=a0+a1*x+a2*x^2+a3*x^3+...

do convert AY, FCA1*(AY)
do series evaluation
MULTIPLY X BY P(X^2) AND EXIT

NORMAL POLYNOMIAL SUBROUTINE

P(X) = C(0)*X^N + C(1)*X^(N-1) + ... + C(N)
WHERE: X IS VALUE IN FAC
Y,A POINTS AT COEFFICIENT TABLE
FIRST BYTE OF COEFF. TABLE IS N
COEFFICIENTS FOLLOW, HIGHEST POWER FIRST
 

compute polynomials according to table indexed by AY

.,E059 85 71 STA $71 POLY: STWD POLYPT
Zeiger auf
save count pointer low byte
POINTER TO COEFFICIENT TABLE
   
.,E05B 84 72 STY $72   Polynomgrad
save count pointer high byte
do series evaluation
     
.,E05D 20 C7 BB JSR $BBC7 POLY1: JSR MOV2F ;SAVE FAC.
FAC nach Akku #4 bringen
pack FAC1 into $5C
     
.,E060 B1 71 LDA ($71),Y LDADY POLYPT
Polynomgrad
get constants count
GET N
   
.,E062 85 67 STA $67 STA DEGREE
als Zähler
save constants count
SAVE N
   
.,E064 A4 71 LDY $71 LDY POLYPT
Zeiger für Polynomauswertung
get count pointer low byte
BUMP PNTR TO HIGHEST COEFFICIENT
   
.,E066 C8 INY INY
Zeiger erhöhen,
increment it (now constants pointer)
AND GET PNTR INTO Y,A
   
.,E067 98 TYA TYA
zeigt dann
copy it
     
.,E068 D0 02 BNE $E06C BNE POLY3
auf ersten Koeffizienten
skip next if no overflow
     
.,E06A E6 72 INC $72 INC POLYPT+1
Zeiger
else increment high byte
     
.,E06C 85 71 STA $71 POLY3: STA POLYPT
für
save low byte
     
.,E06E A4 72 LDY $72 LDY POLYPT+1
Polynomauswertung
get high byte
     
.,E070 20 28 BA JSR $BA28 POLY2: JSR FMULT
FAC = FAC * Konstante
do convert AY, FCA1*(AY)
ACCUMULATE SERIES TERMS
   
.,E073 A5 71 LDA $71 LDWD POLYPT ;GET CURRENT POINTER.
Zeiger in
get constants pointer low byte
BUMP PNTR TO NEXT COEFFICIENT
   
.,E075 A4 72 LDY $72   (A/Y)
get constants pointer high byte
     
.,E077 18 CLC CLC
Zeiger
clear carry for add
     
.,E078 69 05 ADC #$05 ADCI 4+ADDPRC
um 5 erhöhen - nächste Zahl
+5 to low pointer (5 bytes per constant)
     
.,E07A 90 01 BCC $E07D BCC POLY4
wenn kleiner, dann zu $E07D
skip next if no overflow
     
.,E07C C8 INY INY
ansonsten erhöhen
increment high byte
     
.,E07D 85 71 STA $71 POLY4: STWD POLYPT
Zeiger für
save pointer low byte
     
.,E07F 84 72 STY $72   Polynomauswertung speichern
save pointer high byte
     
.,E081 20 67 B8 JSR $B867 JSR FADD ;ADD IN CONSTANT.
FAC = FAC + Konstante
add (AY) to FAC1
ADD NEXT COEFFICIENT
   
.,E084 A9 5C LDA #$5C LDWDI TEMPF2 ;MULTIPLY THE ORIGINAL FAC.
Zeiger auf
set pointer low byte to partial
POINT AT X AGAIN
   
.,E086 A0 00 LDY #$00   Akku #4
set pointer high byte to partial
     
.,E088 C6 67 DEC $67 DEC DEGREE ;DONE?
Zähler erniedrigen
decrement constants count
IF SERIES NOT FINISHED,
   
.,E08A D0 E4 BNE $E070 BNE POLY2
schon alle, nein, dann
zu $E070
loop until all done
THEN ADD ANOTHER TERM
   
.,E08C 60 RTS RANDRT: RTS ;YES.
;PSUEDO-RANDOM NUMBER GENERATOR.
;IF ARG=0, THE LAST RANDOM NUMBER GENERATED IS RETURNED.
;IF ARG .LT. 0, A NEW SEQUENCE OF RANDOM NUMBERS IS
;STARTED USING THE ARGUMENT.
; TO FORM THE NEXT RANDOM NUMBER IN THE SEQUENCE,
;MULTIPLY THE PREVIOUS RANDOM NUMBER BY A RANDOM CONSTANT
;AND ADD IN ANOTHER RANDOM CONSTANT. THE THEN HO
;AND LO BYTES ARE SWITCHED, THE EXPONENT IS PUT WHERE
;IT WILL BE SHIFTED IN BY NORMAL, AND THE EXPONENT IN THE FAC
;IS SET TO 200 SO THE RESULT WILL BE LESS THAN 1. THIS
;IS THEN NORMALIZED AND SAVED FOR THE NEXT TIME.
;THE HO AND LOW BYTES WERE SWITCHED SO THERE WILL BE A
;RANDOM CHANCE OF GETTING A NUMBER LESS THAN OR GREATER
;THAN .5 .
Rücksprung

Konstanten für RND

RND values

FINISHED
 

float numbers for RND

.:E08D 98 35 44 7A 00 RMULZC: 230
065
104
172
11879546
11879546 multiplier
RND 1
   
.:E092 68 28 B1 46 00 RADDZC: 150
050
261
106
3.92767774E-4

BASIC-Funktion RND

3.927677739E-8 offset

perform RND()

RND 2

"RND" FUNCTION

 

RND function

.,E097 20 2B BC JSR $BC2B RND: JSR SIGN ;GET SIGN INTO ACCX.
IFN REALIO-3,<
TAX> ;GET INTO ACCX, SINCE "MOVFM" USES ACCX.
Vorzeichen holen
get FAC1 sign
return A = $FF -ve, A = $01 +ve
REDUCE ARGUMENT TO -1, 0, OR +1
   
.,E09A 30 37 BMI $E0D3 BMI RND1 ;START NEW SEQUENCE IF NEGATIVE.
IFE REALIO-3,<
negativ ?, dann zu $E0D3
if n<0 copy byte swapped FAC1 into RND() seed
= -1, USE CURRENT ARGUMENT FOR SEED
   
.,E09C D0 20 BNE $E0BE BNE QSETNR
;TIMERS ARE AT 9044(L0),45(HI),48(LO),49(HI) HEX.
;FIRST TWO ARE ALWAYS FREE RUNNING.
;SECOND PAIR IS NOT. LO IS FREER THAN HI THEN.
;SO ORDER IN FAC IS 44,48,45,49.
nicht Null?, dann zu $E0BE
if n>0 get next number in RND() sequence
else n=0 so get the RND() number from VIA 1 timers
     
.,E09E 20 F3 FF JSR $FFF3 LDA CQHTIM
Basis-Adresse CIA holen
return base address of I/O devices
     
.,E0A1 86 22 STX $22 STA FACHO
als Zeiger
save pointer low byte
     
.,E0A3 84 23 STY $23 LDA CQHTIM+4
speichern
save pointer high byte
     
.,E0A5 A0 04 LDY #$04 STA FACMOH
Zähler setzen
set index to T1 low byte
     
.,E0A7 B1 22 LDA ($22),Y LDA CQHTIM+1
LOW-Byte Timer A laden
get T1 low byte
     
.,E0A9 85 62 STA $62 STA FACMO
und speichern
save FAC1 mantissa 1
     
.,E0AB C8 INY LDA CQHTIM+5
Zähler erhöhen
increment index
     
.,E0AC B1 22 LDA ($22),Y STA FACLO
HIGH-Byte Timer A laden
get T1 high byte
     
.,E0AE 85 64 STA $64 JMP STRNEX>
und speichern
save FAC1 mantissa 3
     
.,E0B0 A0 08 LDY #$08 QSETNR: LDWDI RNDX ;GET LAST ONE INTO FAC.
Zähler neu setzen
set index to T2 low byte
     
.,E0B2 B1 22 LDA ($22),Y JSR MOVFM
TOD 1/10 sec laden
get T2 low byte
     
.,E0B4 85 63 STA $63 IFN REALIO-3,<
und speichern
save FAC1 mantissa 2
     
.,E0B6 C8 INY TXA ;FAC WAS ZERO?
Zähler erhöhen
increment index
     
.,E0B7 B1 22 LDA ($22),Y BEQ RANDRT> ;RESTORE LAST ONE.
TOD sec laden
get T2 high byte
     
.,E0B9 85 65 STA $65   und speichern
save FAC1 mantissa 4
     
.,E0BB 4C E3 E0 JMP $E0E3   weiter bei $E0E3
set exponent and exit
     
.,E0BE A9 8B LDA #$8B   Zeiger auf
set seed pointer low address
USE CURRENT SEED
   
.,E0C0 A0 00 LDY #$00   letzten RND-Wert
set seed pointer high address
     
.,E0C2 20 A2 BB JSR $BBA2   nach FAC holen
unpack memory (AY) into FAC1
     
.,E0C5 A9 8D LDA #$8D LDWDI RMULZC ;MULTIPLY BY RANDOM CONSTANT.
Zeiger auf
set 11879546 pointer low byte
VERY POOR RND ALGORITHM
   
.,E0C7 A0 E0 LDY #$E0   Konstante
set 11879546 pointer high byte
     
.,E0C9 20 28 BA JSR $BA28 JSR FMULT
FAC = FAC * Konstante
do convert AY, FCA1*(AY)
     
.,E0CC A9 92 LDA #$92 LDWDI RADDZC
Zeiger auf
set 3.927677739E-8 pointer low byte
ALSO, CONSTANTS ARE TRUNCATED
   
.,E0CE A0 E0 LDY #$E0   Konstante
set 3.927677739E-8 pointer high byte
<<<THIS DOES NOTHING, DUE TO >>>
<<<SMALL EXPONENT >>>
   
.,E0D0 20 67 B8 JSR $B867 JSR FADD ;ADD RANDOM CONSTANT.
FAC = FAC + Konstante
add (AY) to FAC1
     
.,E0D3 A6 65 LDX $65 RND1: LDX FACLO
alle
get FAC1 mantissa 4
SHUFFLE HI AND LO BYTES
   
.,E0D5 A5 62 LDA $62 LDA FACHO
Stel-
get FAC1 mantissa 1
TO SUPPOSEDLY MAKE IT MORE RANDOM
   
.,E0D7 85 65 STA $65 STA FACLO
len
save FAC1 mantissa 4
     
.,E0D9 86 62 STX $62 STX FACHO ;REVERSE HO AND LO.
IFE REALIO-3,<
im
save FAC1 mantissa 1
     
.,E0DB A6 63 LDX $63 LDX FACMOH
FAC
get FAC1 mantissa 2
     
.,E0DD A5 64 LDA $64 LDA FACMO
ver-
get FAC1 mantissa 3
MAKE IT POSITIVE
   
.,E0DF 85 63 STA $63 STA FACMOH
tau-
save FAC1 mantissa 2
     
.,E0E1 86 64 STX $64 STX FACMO>
schen
save FAC1 mantissa 3
     
.,E0E3 A9 00 LDA #$00 STRNEX: CLR FACSGN ;MAKE NUMBER POSITIVE.
Vorzeichen
clear byte
A SOMEWHAT RANDOM EXTENSION
   
.,E0E5 85 66 STA $66   positiv
clear FAC1 sign (always +ve)
     
.,E0E7 A5 61 LDA $61 LDA FACEXP ;PUT EXP WHERE IT WILL
Exponent in
get FAC1 exponent
EXPONENT TO MAKE VALUE < 1.0
   
.,E0E9 85 70 STA $70 STA FACOV ;BE SHIFTED IN BY NORMAL.
Rundungsstelle
save FAC1 rounding byte
     
.,E0EB A9 80 LDA #$80 LDAI 200
Zufallszahl
set exponent = $80
     
.,E0ED 85 61 STA $61 STA FACEXP ;MAKE RESULT BETWEEN 0 AND 1.
speichern
save FAC1 exponent
     
.,E0EF 20 D7 B8 JSR $B8D7 JSR NORMAL ;NORMALIZE.
FAC linksbündig machen
normalise FAC1
     
.,E0F2 A2 8B LDX #$8B LDXYI RNDX
Zeiger auf
set seed pointer low address
MOVE FAC TO RND SEED
   
.,E0F4 A0 00 LDY #$00   letzten RND-Wert
set seed pointer high address

pack FAC1 into (XY)

     
.,E0F6 4C D4 BB JMP $BBD4 GMOVMF: JMP MOVMF ;PUT NEW ONE INTO MEMORY.
FAC runden und speichern

Fehlerauswertung nach

I/O-Routinen

pack FAC1 into (XY)

handle BASIC I/O error

   

handle errors for direct I/O

calls from basic
.,E0F9 C9 F0 CMP #$F0 EREXIT CMP #$F0 ;CHECK FOR SPECIAL CASE
RS 232 OPEN oder CLOSE ?
compare error with $F0
  test error
 
.,E0FB D0 07 BNE $E104 BNE EREXIX
; TOP OF MEMORY HAS CHANGED
nein
branch if not $F0
     
.,E0FD 84 38 STY $38 STY MEMSIZ+1
BASIC-RAM Ende
set end of memory high byte
  MEMSIZ, highest address in BASIC
 
.,E0FF 86 37 STX $37 STX MEMSIZ
neu setzen
set end of memory low byte
     
.,E101 4C 63 A6 JMP $A663 JMP CLEART ;ACT AS IF HE TYPED CLEAR
und zum CLR-Befehl
clear from start to end and return
error was not $F0
  do CLR without aborting I/O
 
.,E104 AA TAX EREXIX TAX ;SET TERMINATION FLAGS
Fehlernummer nach X
copy error #
  put error flag i (X)
 
.,E105 D0 02 BNE $E109 BNE EREXIY
nicht Null ?
branch if not $00
  if error code $00, then set error code $1e
 
.,E107 A2 1E LDX #$1E LDX #ERBRK ;BREAK ERROR
sonst Nummer für 'BREAK'
else error $1E, break error
     
.,E109 4C 37 A4 JMP $A437 EREXIY JMP ERROR ;NORMAL ERROR
CLSCHN =$FFCC
Fehlermeldung ausgeben

BASIC BSOUT

do error #X then warm start

output character to channel with error check

  do error

BCHOUT: OUTPUT CHARACTER

This routine uses the KERNAL routine CHROUT to output the
character in (A) to an available output channel. A test is
made for a possible I/O error.
 
.,E10C 20 D2 FF JSR $FFD2 OUTCH JSR $FFD2
ein Zeichen ausgeben
output character to channel
  output character in (A)
 
.,E10F B0 E8 BCS $E0F9 BCS EREXIT
Fehler ?
if error go handle BASIC I/O error
  if carry set, handle I/O error
 
.,E111 60 RTS RTS
Rücksprung

BASIC BASIN

input character from channel with error check

  else return

BCHIN: INPUT CHARACTER

This routine uses the KERNAL routine CHRIN to input a
character to (A) from an available input channel. A test
is made for a possible I/O error.
 
.,E112 20 CF FF JSR $FFCF INCHR JSR $FFCF
ein Zeichen holen
input character from channel
  input character from CHRIN
 
.,E115 B0 E2 BCS $E0F9 BCS EREXIT
Fehler ?
if error go handle BASIC I/O error
  if carry set, handle I/O error
 
.,E117 60 RTS RTS
CCALL =$FFE7
SETTIM =$FFDB
RDTIM =$FFDE
Rücksprung

BASIC CKOUT

open channel for output with error check

  else return

BCKOUT:SET UP FOR OUTPUT

This routine uses the KERNAL routine CHKOUT to open an
output channel, and tests for possible I/O error. On entry
(X) must hold the the logical file number as used in OPEN.
 
.,E118 20 AD E4 JSR $E4AD COOUT JSR PPACH ; GO OUT TO SAVE .A FOR PRINT# PATCH
Ausgabegerät setzen
open channel for output
  open output channel via CHKOUT
 
.,E11B B0 DC BCS $E0F9 BCS EREXIT
Fehler ?
if error go handle BASIC I/O error
  if carry set, handle I/O error
 
.,E11D 60 RTS RTS
Rücksprung

BASIC CHKIN

open channel for input with error check

  else return

BCKIN: SET UP FOR INPUT

This routine uses the KERNAL routine CHKIN to open an
input channel. A test as made for possible I/O error.
 
.,E11E 20 C6 FF JSR $FFC6 COIN JSR $FFC6
Eingabegerät setzen
open channel for input
  open input channel via CHKIN
 
.,E121 B0 D6 BCS $E0F9 BCS EREXIT
Fehler ?
if error go handle BASIC I/O error
  if carry set, handle I/O error
 
.,E123 60 RTS RTS
READST =$FFB7
Rücksprung

BASIC GETIN

get character from input device with error check

  else return

BGETIN: GET ONT CHARACTER

This routine uses the KERNAL routine GETIN to get a
character from the keyboard buffer into (A). A test is
made for possible I/O error.
 
.,E124 20 E4 FF JSR $FFE4 CGETL JSR $FFE4
ein Zeichen holen
get character from input device
  GETIN, get character from keyboard buffer
 
.,E127 B0 D0 BCS $E0F9 BCS EREXIT
Fehler ?
if error go handle BASIC I/O error
  if carry set, handle I/O error
 
.,E129 60 RTS RTS
RDBAS =$FFF3
SETMSG =$FF90
PLOT =$FFF0
Rücksprung

SYS-Befehl

perform SYS

  else return

SYS: PERFORM SYS

This routine enables machine language routines to be
executed from BASIC. The routine evaluates the address and
confirms that it is a numeric number. The return address
is set up, and the user routine is executed.

SYS command

.,E12A 20 8A AD JSR $AD8A CSYS JSR FRMNUM ;EVAL FORMULA
FRMNUM, numerischen
Ausdruck holen
evaluate expression and check is numeric, else do
type mismatch
  evaluate text & confirm numeric
 
.,E12D 20 F7 B7 JSR $B7F7 JSR GETADR ;CONVERT TO INT. ADDR
in Adressformat wandeln,
nach $14/$15
convert FAC_1 to integer in temporary integer
  convert fac#1 to integer in LINNUM
 
.,E130 A9 E1 LDA #$E1 LDA #>CSYSRZ ;PUSH RETURN ADDRESS
Rück-
get return address high byte
  set return address on stack to $ea46
low E146
.,E132 48 PHA PHA
sprungadresse
push as return address
     
.,E133 A9 46 LDA #$46 LDA #<CSYSRZ
auf
get return address low byte
    high E146
.,E135 48 PHA PHA
Stack
push as return address
     
.,E136 AD 0F 03 LDA $030F LDA SPREG ;STATUS REG
Status,
get saved status register
  SPREG, user flag register
 
.,E139 48 PHA PHA
in Stack
put on stack
     
.,E13A AD 0C 03 LDA $030C LDA SAREG ;LOAD 6502 REGS
Akku,
get saved A
  SAREG, user (A) register
 
.,E13D AE 0D 03 LDX $030D LDX SXREG
X-Register und
get saved X
  SXREG, user (X) register
 
.,E140 AC 0E 03 LDY $030E LDY SYREG
Y-Register übergeben
get saved Y
  SYREG, user (Y) register
 
.,E143 28 PLP PLP ;LOAD 6502 STATUS REG
Status setzen
pull processor status
     
.,E144 6C 14 00 JMP ($0014) JMP (LINNUM) ;GO DO IT
CSYSRZ =*-1 ;RETURN TO HERE
Routine aufrufen
call SYS address
tail end of SYS code
  execute user routine, exit with rts
 
.,E147 08 PHP PHP ;SAVE STATUS REG
Status speichern
save status
     
.,E148 8D 0C 03 STA $030C STA SAREG ;SAVE 6502 REGS
Akku,
save returned A
  store in SAREG, user (A) register
 
.,E14B 8E 0D 03 STX $030D STX SXREG
X-Register,
save returned X
  store in SXREG, user (X) register
 
.,E14E 8C 0E 03 STY $030E STY SYREG
Y-Register und
save returned Y
  store in SYREG, user (Y) register
 
.,E151 68 PLA PLA ;GET STATUS REG
Status
restore saved status
     
.,E152 8D 0F 03 STA $030F STA SPREG
wieder speichern
save status
  store in SPREG, user flag register
 
.,E155 60 RTS RTS ;RETURN TO SYSTEM
Rücksprung

SAVE-Befehl

perform SAVE

  back

SAVET: PERFORM SAVE

This routine is sets parameters for save, and calls the
save routine. The start and end addresses are obtained
from TXTTAB and VARTAB. Finally, a test is made if any
errors ocured.

SAVE command

.,E156 20 D4 E1 JSR $E1D4 CSAVE JSR PLSV ;PARSE PARMS
Parameter (Filenamen, Prim,
und Sek. Adresse)
get parameters for LOAD/SAVE
  get SAVE paramerters from text
 
.,E159 A6 2D LDX $2D LDX VARTAB ;END SAVE ADDR
Endadresse gleich
get start of variables low byte
  VARTAB, start of variables
 
.,E15B A4 2E LDY $2E LDY VARTAB+1
BASIC-Rücksprung
get start of variables high byte
     
.,E15D A9 2B LDA #$2B LDA #<TXTTAB ;INDIRECT WITH START ADDRESS
Startadresse gleich Zeiger
auf BASIC Anfang
index to start of program memory
  <TXTTAB, start of BASIC text
 
.,E15F 20 D8 FF JSR $FFD8 JSR $FFD8 ;SAVE IT
Save-Routine
save RAM to device, A = index to start address, XY = end
address low/high
  execute SAVE
 
.,E162 B0 95 BCS $E0F9 BCS EREXIT
Fehler ?
if error go handle BASIC I/O error
  if carry is set, handle I/O errors
 
.,E164 60 RTS RTS
Rücksprung

VERIFY-Befehl

perform VERIFY

 

VERFYT: PERFORM LOAD/SAVE

This routine is essentially the same for both LOAD and
VERIFY. The entry point determins which is performed, by
setting VERCK accordingly. The LOAD/VERIFY parameters,
filename, device etc. are obtained from text before the
KERNAL routine LOAD is called. A test is made for I/O
errors. At this point, the two functios are distiguished.
VERIFY reads the the status word and prints the message OK
or ?VERIFY error depending on the result of the test. LOAD
reads the I/O status word for a possible ?LOAD error, then
updates the pointers to text and variables, exiting via
CLR.

VERIFY command

.,E165 A9 01 LDA #$01 CVERF LDA #1 ;VERIFY FLAG
Verify-
flag verify
  flag verify
 
.:E167 2C .BYTE $2C .BYT $2C ;SKIP TWO BYTES
Flag

LOAD-Befehl

makes next line BIT $00A9

perform LOAD

  mask

LOAD command

.,E168 A9 00 LDA #$00 CLOAD LDA #0 ;LOAD FLAG
Load-Flag
flag load
     
.,E16A 85 0A STA $0A STA VERCK
speichern
set load/verify flag
  store in VRECK, LOAD/VERIFY flag
 
.,E16C 20 D4 E1 JSR $E1D4 JSR PLSV ;PARSE PARAMETERS
;
CLD10 ; JSR $FFE1 ;CHECK RUN/STOP
; CMP #$FF ;DONE YET?
; BNE CLD10 ;STILL BOUNCING
Parameter holen
get parameters for LOAD/SAVE
  get LOAD/VERIFY parameters from text
 
.,E16F A5 0A LDA $0A LDA VERCK
Flag
get load/verify flag
  get VRECK
 
.,E171 A6 2B LDX $2B LDX TXTTAB ;.X AND .Y HAVE ALT...
Startadresse gleich
get start of memory low byte
  TXTTAB, start of BASIC
 
.,E173 A4 2C LDY $2C LDY TXTTAB+1 ;...LOAD ADDRESS
BASIC-Start
get start of memory high byte
     
.,E175 20 D5 FF JSR $FFD5 JSR $FFD5 ;LOAD IT
Load-Routine
load RAM from a device
  execute LOAD, KERNAL routine
 
.,E178 B0 57 BCS $E1D1 BCS JERXIT ;PROBLEMS
;
Fehler ?
if error go handle BASIC I/O error
  if carry set, handle error
 
.,E17A A5 0A LDA $0A LDA VERCK
Load/Verify - Flag
get load/verify flag
  test VRECK for LOAD or VERIFY
 
.,E17C F0 17 BEQ $E195 BEQ CLD50 ;WAS LOAD
;
;FINISH VERIFY
;
Load ?
branch if load
  do LOAD
 
.,E17E A2 1C LDX #$1C LDX #ERVFY ;ASSUME ERROR
Offset für 'VERIFY ERROR'
error $1C, verify error
  set error $1c, VERIFY error
 
.,E180 20 B7 FF JSR $FFB7 JSR $FFB7 ;READ STATUS
Status holen
read I/O status word
  do READST, get status I/O word
 
.,E183 29 10 AND #$10 AND #$10 ;CHECK ERROR
Fehler-Bit isolieren
mask for tape read error
  %00010000, test for mismatch
 
.,E185 D0 17 BNE $E19E BNE CLD55 ;REPLACES BEQ *+5/JMP ERROR
;
;PRINT VERIFY 'OK' IF DIRECT
;
Statusbit gesetzt, dann
Fehler
branch if no read error
  data mismatch, do error
 
.,E187 A5 7A LDA $7A LDA TXTPTR
muß HIGH-Byte $7B sein
get the BASIC execute pointer low byte
is this correct ?? won't this mean the "OK" prompt
when doing a load from within a program ?
  <TXTPTR
 
.,E189 C9 02 CMP #$02 CMP #BUFPAG
Test auf Direkt-Modus
       
.,E18B F0 07 BEQ $E194 BEQ CLD20
ja, dann fertig
if ?? skip "OK" prompt
     
.,E18D A9 64 LDA #$64 LDA #<OKMSG
Zeiger auf
set "OK" pointer low byte
  set address to text OK
 
.,E18F A0 A3 LDY #$A3 LDY #>OKMSG
'OK'
set "OK" pointer high byte
  at $a364
 
.,E191 4C 1E AB JMP $AB1E JMP STROUT
;
ausgeben
print null terminated string
  output string in (A/Y)
 
.,E194 60 RTS CLD20 RTS
;
;FINISH LOAD
;
Rücksprung

do READY return to BASIC

     
.,E195 20 B7 FF JSR $FFB7 CLD50 JSR $FFB7 ;READ STATUS
Status holen
read I/O status word
  do READST, get status I/O for LOAD
 
.,E198 29 BF AND #$BF AND #$FF-$40 ;CLEAR E.O.I.
EOF-Bit löschen
mask x0xx xxxx, clear read error
  %10111111, test all but EOI
 
.,E19A F0 05 BEQ $E1A1 BEQ CLD60 ;WAS O.K.
kein Fehler
branch if no errors
  nope, no errors
 
.,E19C A2 1D LDX #$1D LDX #ERLOAD
Offset für 'LOAD ERROR'
error $1D, load error
  set error $1d, LOAD error
 
.,E19E 4C 37 A4 JMP $A437 CLD55 JMP ERROR
;
Fehlermeldung ausgeben
do error #X then warm start
  do error
 
.,E1A1 A5 7B LDA $7B CLD60 LDA TXTPTR+1
Direkt-
get BASIC execute pointer high byte
  >TXTPTR
 
.,E1A3 C9 02 CMP #$02 CMP #BUFPAG ;DIRECT?
modus testen
compare with $02xx
     
.,E1A5 D0 0E BNE $E1B5 BNE CLD70 ;NO...
;
nein, dann weiter
branch if not immediate mode
     
.,E1A7 86 2D STX $2D STX VARTAB
Endadresse gleich
set start of variables low byte
  set VARTAB, start of variables
 
.,E1A9 84 2E STY $2E STY VARTAB+1 ;END LOAD ADDRESS
Rücksprung
set start of variables high byte
     
.,E1AB A9 76 LDA #$76 LDA #<REDDY
Zeiger auf
set "READY." pointer low byte
  set address to text READY
 
.,E1AD A0 A3 LDY #$A3 LDY #>REDDY
'READY'
set "READY." pointer high byte
  at $a376
 
.,E1AF 20 1E AB JSR $AB1E JSR STROUT
String ausgeben
print null terminated string
  output string in (A/Y)
 
.,E1B2 4C 2A A5 JMP $A52A JMP FINI
;
;PROGRAM LOAD
;
Programmzeilen neu binden,
CLR
reset execution, clear variables, flush stack,
rebuild BASIC chain and do warm start
  do CLR and restart BASIC
 
.,E1B5 20 8E A6 JSR $A68E CLD70 JSR STXTPT
CHRGET-Zeiger auf
Programmstart
set BASIC execute pointer to start of memory - 1
  reset TXTPTR
 
.,E1B8 20 33 A5 JSR $A533 JSR LNKPRG
Programmzeilen neu binden
rebuild BASIC line chaining
  rechain BASIC lines
 
.,E1BB 4C 77 A6 JMP $A677 JMP FLOAD
RESTORE, BASIC initialisieren

BASIC-Befehl OPEN

rebuild BASIC line chaining, do RESTORE and return

perform OPEN

  do RESTORE and reset OLDTXT

OPENT: PERFORM OPEN

This routine extracts paramerters from text and performs
the OPEN routine in KERNAL. A test is made for I/O errors.

OPEN command

.,E1BE 20 19 E2 JSR $E219 COPEN JSR PAOC ;PARSE STATEMENT
Parameter holen
get parameters for OPEN/CLOSE
  get parameters from text
 
.,E1C1 20 C0 FF JSR $FFC0 JSR $FFC0 ;OPEN IT
OPEN-Routine
open a logical file
  execute OPEN
 
.,E1C4 B0 0B BCS $E1D1 BCS JERXIT ;BAD STUFF OR MEMSIZ CHANGE
Fehler ?
branch if error
  if carry set, handle error
 
.,E1C6 60 RTS RTS ;A.O.K.
Rücksprung

BASIC-Befehl CLOSE

perform CLOSE

 

CLOSET: PERFORM CLOSE

The parameters for CLOSE are obtained from text, and the
logical filenumber placed in (A), The KERNAL routine CLOSE
is performed, and a test is made for I/O errors.

CLOSE command

.,E1C7 20 19 E2 JSR $E219 CCLOS JSR PAOC ;PARSE STATEMENT
Parameter holen
get parameters for OPEN/CLOSE
  get parameters from text
 
.,E1CA A5 49 LDA $49 LDA ANDMSK ;GET LA
Filenummer
get logical file number
  logical file number
 
.,E1CC 20 C3 FF JSR $FFC3 JSR $FFC3 ;CLOSE IT
CLOSE-Routine
close a specified logical file
  perform CLOSE
 
.,E1CF 90 C3 BCC $E194 BCC CLD20 ;IT'S OKAY...NO MEMSIZE CHANGE
;
kein Fehler, RTS
exit if no error
  if carry set, handle error, else return
 
.,E1D1 4C F9 E0 JMP $E0F9 JERXIT JMP EREXIT
;
;PARSE LOAD AND SAVE COMMANDS
;
PLSV
;DEFAULT FILE NAME
;
zur Fehlerauswertung

Parameter für LOAD und SAVE

holen

go handle BASIC I/O error

get parameters for LOAD/SAVE

  jump to error routine

SLPARA: GET PARAMETERS FOR LOAD/SAVE

This routine gets the filename, devicenumber and secondary
address for LOAD/VERIFY and SAVE operations. The KERNAL
routines SETNAM and SETLFS are used to do this. Default
parameters are set up, then tests are made if any of the
parameters were given. If so, these are set up as wanted.

set parameters for load/verify/save

.,E1D4 A9 00 LDA #$00 LDA #0 ;LENGTH=0
Default für Länge des
Filenamen
clear file name length
  clear length of filename
 
.,E1D6 20 BD FF JSR $FFBD JSR $FFBD
;
;DEFAULT DEVICE #
;
Filenamenparameter setzen
clear the filename
  SETNAM
 
.,E1D9 A2 01 LDX #$01 LDX #1 ;DEVICE #1
Default für Gerätenummer
set default device number, cassette
  default FA, device number is #01
 
.,E1DB A0 00 LDY #$00 LDY #0 ;COMMAND 0
Sekundäradresse
set default command
  default SA, secondary address is #00
 
.,E1DD 20 BA FF JSR $FFBA JSR $FFBA
;
Fileparameter setzen
set logical, first and second addresses
  SETLFS, and device number
 
.,E1E0 20 06 E2 JSR $E206 JSR PAOC20 ;BY-PASS JUNK
weitere Zeichen ?
exit function if [EOT] or ":"
  test if "end of line", if so end here
 
.,E1E3 20 57 E2 JSR $E257 JSR PAOC15 ;GET/SET FILE NAME
Filenamen holen
set filename
  set up given filename and perform SETNAM
 
.,E1E6 20 06 E2 JSR $E206 JSR PAOC20 ;BY-PASS JUNK
weitere Zeichen ?
exit function if [EOT] or ":"
  test if "end of line", if so end here
 
.,E1E9 20 00 E2 JSR $E200 JSR PLSV7 ;GET ',FA'
Geräteadresse holen
scan and get byte, else do syntax error then warm start
  check for comma, and input one byte, FA, to (X)
 
.,E1EC A0 00 LDY #$00 LDY #0 ;COMMAND 0
Sekundäradresse
clear command
     
.,E1EE 86 49 STX $49 STX ANDMSK
Geräteadresse
save device number
     
.,E1F0 20 BA FF JSR $FFBA JSR $FFBA
Fileparameter setzen
set logical, first and second addresses
  perform new SETLFS with device number
 
.,E1F3 20 06 E2 JSR $E206 JSR PAOC20 ;BY-PASS JUNK
weitere Zeichen ?
exit function if [EOT] or ":"
  test if "end of line", if so end here
 
.,E1F6 20 00 E2 JSR $E200 JSR PLSV7 ;GET ',SA'
Sekundäradresse holen
scan and get byte, else do syntax error then warm start
  check for comma, and input one byte, SA, to (X)
 
.,E1F9 8A TXA TXA ;NEW COMMAND
in Akku schieben
copy command to A
  transfer (X) to (Y)
 
.,E1FA A8 TAY TAY
Sekundäradresse
copy command to Y
     
.,E1FB A6 49 LDX $49 LDX ANDMSK ;DEVICE #
Gerätenummer
get device number back
  get FA
 
.,E1FD 4C BA FF JMP $FFBA JMP $FFBA
;LOOK FOR COMMA FOLLOWED BY BYTE
Fileparameter setzen
set logical, first and second addresses and return

scan and get byte, else do syntax error then warm start

  perform SETLFS with both device number and secondary
address. Then exit

COMBYT: GET NEXT ONE-BYTE PARAMETER

This routine checks if the next character of text is a
comma, and then inputs the parameter following into (X).

skip comma and get integer in X

.,E200 20 0E E2 JSR $E20E PLSV7 JSR PAOC30
prüft auf Komma und weitere
Zeichen
scan for ",byte", else do syntax error then warm start
  check for comma
 
.,E203 4C 9E B7 JMP $B79E JMP GETBYT
;SKIP RETURN IF NEXT CHAR IS END
;
holt Byte-Wert nach X

prüft auf weitere Zeichen

get byte parameter and return
exit function if [EOT] or ":"
  input one byte parameter to (X)

DEFLT: CHECK DEFAULT PARAMETERS

This routine tests CHRGOT to see if a optional parameter
was included in the text. If it was, a normal exit is
performed via RTS. If not, the return address on the stack
is discarded, and the routine exits both this and the
calling routine.

get character and check for end of line

.,E206 20 79 00 JSR $0079 PAOC20 JSR CHRGOT
CHRGOT letztes Zeichen
scan memory
  get CHRGOT
 
.,E209 D0 02 BNE $E20D BNE PAOCX
weiteres Zeichen, dann
Rückkehr
branch if not [EOL] or ":"
  if last character is a character, do normal exit
 
.,E20B 68 PLA PLA
sonst Rückkehr zur
dump return address low byte
  else, remove return address
 
.,E20C 68 PLA PLA
übergeordneten Routine
dump return address high byte
  to exit this AND the calling routine.
 
.,E20D 60 RTS PAOCX RTS
;CHECK FOR COMMA AND GOOD STUFF
;
Rücksprung

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

  exit

CMMERR: CHECK FOR COMMA

This routine confirms that the next character in the text
is a comma. It also test that the comma is not immediately
ollowed by a terminator. If so, exit and do SYNTAX error.

check for comma and skip it

.,E20E 20 FD AE JSR $AEFD PAOC30 JSR CHKCOM ;CHECK COMMA
prüft auf Komma
scan for ",", else do syntax error then warm start

scan for valid byte, not [EOL] or ":", else do syntax error then warm start

  confirm comma
 
.,E211 20 79 00 JSR $0079 PAOC32 JSR CHRGOT ;GET CURRENT
CHRGOT letztes Zeichen holen
scan memory
  get CHRGOT
 
.,E214 D0 F7 BNE $E20D BNE PAOCX ;IS O.K.
weitere Zeichen, dann
Rückkehr
exit if following byte
  else than null
 
.,E216 4C 08 AF JMP $AF08 PAOC40 JMP SNERR ;BAD...END OF LINE
;PARSE OPEN/CLOSE
;
'SYNTAX ERROR'

Parameter für OPEN holen

else do syntax error then warm start

get parameters for OPEN/CLOSE

  execute SYNTAX error

OCPARA: GET PARAMETERS FOR OPEN/CLOSE

This routine gets the logical file number, device number,
secondary address and filename for OPEN/CLOSE. Initially
the default filename is set to null, and the device number
to #1. The logical filenumber is compulsory, and is
obtained from text and placed in <FORPNT. The other
parameters are optinal and are obtained if present. The
device number is stored in >FORPNT. The parameters are set
via the KERNAL routines SETNAM and SETLFS.

get open/close parameters

.,E219 A9 00 LDA #$00 PAOC LDA #0
Default für Länge des
Filenamens
clear the filename length
  default filename is null
 
.,E21B 20 BD FF JSR $FFBD JSR $FFBD ;DEFAULT FILE NAME
;
Filenamenparameter setzen
clear the filename
  SETNAM
 
.,E21E 20 11 E2 JSR $E211 JSR PAOC32 ;MUST GOT SOMETHING
weitere Zeichen ?
scan for valid byte, else do syntax error then warm start
  confirm TXTPNT is no terminator, if so - error
 
.,E221 20 9E B7 JSR $B79E JSR GETBYT ;GET LA
holt logische Filenummer
nach X-Reg
get byte parameter, logical file number
  input one byte character to (X)
 
.,E224 86 49 STX $49 STX ANDMSK
und speichern
save logical file number
  store logical filenumber in <FORPNT
 
.,E226 8A TXA TXA
logische Filenummer
copy logical file number to A
  set default parameters to
 
.,E227 A2 01 LDX #$01 LDX #1 ;DEFAULT DEVICE
Default für Geräteadresse
set default device number, cassette
  device = #1
 
.,E229 A0 00 LDY #$00 LDY #0 ;DEFAULT COMMAND
Sekundäradresse
set default command
  secondary address = #0
 
.,E22B 20 BA FF JSR $FFBA JSR $FFBA ;STORE IT
Fileparameter setzen
set logical, first and second addresses
  SETLFS
 
.,E22E 20 06 E2 JSR $E206 JSR PAOC20 ;SKIP JUNK
weitere Zeichen ?
exit function if [EOT] or ":"
  test if "end of line", if so end here
 
.,E231 20 00 E2 JSR $E200 JSR PLSV7
holt Geräteadresse
scan and get byte, else do syntax error then warm start
  check for comma, and input FA, device number
 
.,E234 86 4A STX $4A STX EORMSK
und speichern
save device number
  store in >FORPNT
 
.,E236 A0 00 LDY #$00 LDY #0 ;DEFAULT COMMAND
Sekundäradresse
clear command
  secondary address = #0
 
.,E238 A5 49 LDA $49 LDA ANDMSK ;GET LA
logische Filenummer
get logical file number
  logical file number from temp store
 
.,E23A E0 03 CPX #$03 CPX #3
Gerätenummer kleiner 3 ?
compare device number with screen
  test if serial devce
 
.,E23C 90 01 BCC $E23F BCC PAOC5
ja
branch if less than screen
  nope
 
.,E23E 88 DEY DEY ;DEFAULT IEEE TO $FF
sonst Sekundäradresse auf
255 (keine Sek-Adr)
else decrement command
  if serial, set secondary address to $ff
 
.,E23F 20 BA FF JSR $FFBA PAOC5 JSR $FFBA ;STORE THEM
Fileparameter setzen
set logical, first and second addresses
  SETLFS
 
.,E242 20 06 E2 JSR $E206 JSR PAOC20 ;SKIP JUNK
weitere Zeichen ?
exit function if [EOT] or ":"
  test if "end of line", if so end here
 
.,E245 20 00 E2 JSR $E200 JSR PLSV7 ;GET SA
holt Sekundäradresse
scan and get byte, else do syntax error then warm start
  check for comma, and input SA, secondary address
 
.,E248 8A TXA TXA
in Akku schieben
copy command to A
     
.,E249 A8 TAY TAY
Sekundäradresse
copy command to Y
  SA to (Y)
 
.,E24A A6 4A LDX $4A LDX EORMSK
Gerätenummer
get device number
  FA
 
.,E24C A5 49 LDA $49 LDA ANDMSK
logische Filenummer
get logical file number
  LA
 
.,E24E 20 BA FF JSR $FFBA JSR $FFBA ;SET UP REAL EVEYTHING
Fileparameter setzen
set logical, first and second addresses
  SETLFS
 
.,E251 20 06 E2 JSR $E206 PAOC7 JSR PAOC20
weitere Zeichen ?
exit function if [EOT] or ":"
  test if "end of line", if so end here
 
.,E254 20 0E E2 JSR $E20E JSR PAOC30
prüft auf Komma
scan for ",byte", else do syntax error then warm start

set filename

  check for comma only
 
.,E257 20 9E AD JSR $AD9E PAOC15 JSR FRMEVL
FRMEVL Ausdruck holen
evaluate expression
  evaluate expression in text
 
.,E25A 20 A3 B6 JSR $B6A3 JSR FRESTR ;LENGTH IN .A
holt Stringparameter, FRESTR
evaluate string
  do string housekeeping
 
.,E25D A6 22 LDX $22 LDX INDEX1
Adresse des
get string pointer low byte
  pointers to given filename
 
.,E25F A4 23 LDY $23 LDY INDEX1+1
Filenamens
get string pointer high byte
     
.,E261 4C BD FF JMP $FFBD JMP $FFBD
PAGE

SINE, COSINE AND TANGENT FUNCTIONS.

IFE KIMROM,<
;COSINE FUNCTION.
;USE COS(X)=SIN(X+PI/2)
Filenamenparameter setzen

BASIC-Funktion COS

set the filename and return

perform COS()

"COS" FUNCTION

SETNAM and exit

COS: PERFORM COS

This routine manipulates the input COS to be calcuated
with SIN. COS(X) = SIN(X+pi/2), where X is in radians. We
use it as Fac#1=SIN(fac#1+pi/2), ie pi/2 is added to fac#1
and the following SIN is performed.

COS function

.,E264 A9 E0 LDA #$E0 COS: LDWDI PI2 ;PNTR TO PI/2.
Zeiger auf
set pi/2 pointer low byte
COS(X)=SIN(X + PI/2)
set address to pi/2
low E2E0
.,E266 A0 E2 LDY #$E2   Konstante Pi/2
set pi/2 pointer high byte
  at $e2e0
high E2E0
.,E268 20 67 B8 JSR $B867 JSR FADD ;ADD IT IN.
;FALL INTO SIN.
;SINE FUNCTION.
;USE IDENTITIES TO GET FAC IN QUADRANTS I OR IV.
;THE FAC IS DIVIDED BY 2*PI AND THE INTEGER PART IS IGNORED
;BECAUSE SIN(X+2*PI)=SIN(X). THEN THE ARGUMENT CAN BE COMPARED
;WITH PI/2 BY COMPARING THE RESULT OF THE DIVISION
;WITH PI/2/(2*PI)=1/4.
;IDENTITIES ARE THEN USED TO GET THE RESULT IN QUADRANTS
;I OR IV. AN APPROXIMATION POLYNOMIAL IS THEN USED TO
;COMPUTE SIN(X).
zu FAC addieren

BASIC-Funktion SIN

add (AY) to FAC1

perform SIN()

"SIN" FUNCTION

add fltp at (A/Y) to fac#1

SIN: PERFORM SIN

SIN function

.,E26B 20 0C BC JSR $BC0C SIN: JSR MOVAF
FAC runden und nach ARG
round and copy FAC1 to FAC2
     
.,E26E A9 E5 LDA #$E5 LDWDI TWOPI ;GET PNTR TO DIVISOR.
Zeiger auf
set 2*pi pointer low byte
REMOVE MULTIPLES OF 2*PI
  low E2E5
.,E270 A0 E2 LDY #$E2   Konstante Pi*2
set 2*pi pointer high byte
BY DIVIDING AND SAVING
  high E2E5
.,E272 A6 6E LDX $6E LDX ARGSGN ;GET SIGN OF RESULT.
Vorzeichen von ARG
get FAC2 sign (b7)
THE FRACTIONAL PART
   
.,E274 20 07 BB JSR $BB07 JSR FDIVF
FAC durch 2*Pi dividieren
divide by (AY) (X=sign)
USE SIGN OF ARGUMENT
   
.,E277 20 0C BC JSR $BC0C JSR MOVAF ;GET RESULT INTO ARG.
FAC runden und nach ARG
round and copy FAC1 to FAC2
     
.,E27A 20 CC BC JSR $BCCC JSR INT ;INTEGERIZE FAC.
INT - Funktion
perform INT()
TAKE INTEGER PART
   
.,E27D A9 00 LDA #$00 CLR ARISGN ;ALWAYS HAVE THE SAME SIGN.
Vergleichsbyte
clear byte
<<< WASTED LINES, BECAUSE FSUBT >>>
   
.,E27F 85 6F STA $6F   löschen
clear sign compare (FAC1 EOR FAC2)
<<< CHANGES SGNCPR AGAIN >>>
   
.,E281 20 53 B8 JSR $B853 JSR FSUBT ;KEEP ONLY THE FRACTIONAL PART.
ARG minus FAC
perform subtraction, FAC2 from FAC1
SUBTRACT TO GET FRACTIONAL PART

(FAC) = ANGLE AS A FRACTION OF A FULL CIRCLE

NOW FOLD THE RANGE INTO A QUARTER CIRCLE
<<< THERE ARE MUCH SIMPLER WAYS TO DO THIS >>>
   
.,E284 A9 EA LDA #$EA LDWDI FR4 ;GET PNTR TO 1/4.
Zeiger auf
set 0.25 pointer low byte
1/4 - FRACTION MAKES
  low E2EA
.,E286 A0 E2 LDY #$E2   Konstante 0.25
set 0.25 pointer high byte
-3/4 <= FRACTION < 1/4
  high E2EA
.,E288 20 50 B8 JSR $B850 JSR FSUB ;COMPUTE 1/4-FAC.
0.25 - FAC
perform subtraction, FAC1 from (AY)
     
.,E28B A5 66 LDA $66 LDA FACSGN ;SAVE SIGN FOR LATER.
Vorzeichen laden
get FAC1 sign (b7)
TEST SIGN OF RESULT
   
.,E28D 48 PHA PHA
Vorzeichen in Stack
save FAC1 sign
SAVE SIGN FOR LATER UNFOLDING
   
.,E28E 10 0D BPL $E29D BPL SIN1 ;FIRST QUADRANT.
positiv ?
branch if +ve
FAC1 sign was -ve
ALREADY 0...1/4
   
.,E290 20 49 B8 JSR $B849 JSR FADDH ;ADD 1/2 TO FAC.
FAC + 0.5
add 0.5 to FAC1 (round FAC1)
ADD 1/2 TO SHIFT TO -1/4...1/2
   
.,E293 A5 66 LDA $66 LDA FACSGN ;SIGN IS NEGATIVE?
Vorzeichen
get FAC1 sign (b7)
TEST SIGN
   
.,E295 30 09 BMI $E2A0 BMI SIN2
negativ ?
branch if -ve
-1/4...0
0...1/2
   
.,E297 A5 12 LDA $12 COM TANSGN ;QUADRANTS II AND III COME HERE.
Vorzeichen laden
get the comparison evaluation flag
SIGNFLG INITIALIZED = 0 IN "TAN"
   
.,E299 49 FF EOR #$FF   und umdrehen
toggle flag
FUNCTION
   
.,E29B 85 12 STA $12   Vorzeichen speichern
save the comparison evaluation flag
"TAN" IS ONLY USER OF SIGNFLG TOO
IF FALL THRU, RANGE IS 0...1/2
IF BRANCH HERE, RANGE IS 0...1/4
   
.,E29D 20 B4 BF JSR $BFB4 SIN1: JSR NEGOP ;IF POSITIVE, NEGATE IT.
Vorzeichen wechseln
do - FAC1
IF FALL THRU, RANGE IS -1/2...0
IF BRANCH HERE, RANGE IS -1/4...0
   
.,E2A0 A9 EA LDA #$EA SIN2: LDWDI FR4 ;POINTER TO 1/4.
Zeiger auf
set 0.25 pointer low byte
ADD 1/4 TO SHIFT RANGE
  low E2EA
.,E2A2 A0 E2 LDY #$E2   Konstante 0.25
set 0.25 pointer high byte
TO -1/4...1/4
  high E2EA
.,E2A4 20 67 B8 JSR $B867 JSR FADD ;ADD IT IN.
FAC + 0.25
add (AY) to FAC1
     
.,E2A7 68 PLA PLA ;GET ORIGINAL QUADRANT.
Vorzeichen holen
restore FAC1 sign
GET SAVED SIGN FROM ABOVE
   
.,E2A8 10 03 BPL $E2AD BPL SIN3
positiv ?
branch if was +ve
else correct FAC1
     
.,E2AA 20 B4 BF JSR $BFB4 JSR NEGOP ;IF NEGATIVE, NEGATE RESULT.
Vorzeichen wechseln
do - FAC1
MAKE RANGE 0...1/4
   
.,E2AD A9 EF LDA #$EF SIN3: LDWDI SINCON
Zeiger auf
set pointer low byte to counter
DO STANDARD SIN SERIES
   
.,E2AF A0 E2 LDY #$E2   Polynomkoeffizienten
set pointer high byte to counter
     
.,E2B1 4C 43 E0 JMP $E043 GPOLYX: JMP POLYX ;DO APPROXIMATION POLYNOMIAL.
;TANGENT FUNCTION.
Polynom berechnen

BASIC-Funktion TAN

^2 then series evaluation and return

perform TAN()

"TAN" FUNCTION

COMPUTE TAN(X) = SIN(X) / COS(X)

TAN: PERFORM TAN

TAN function

.,E2B4 20 CA BB JSR $BBCA TAN: JSR MOV1F ;MOVE FAC INTO TEMPORARY.
FAC nach Akku#3
pack FAC1 into $57
     
.,E2B7 A9 00 LDA #$00 CLR TANSGN ;REMEMBER WHETHER TO NEGATE.
Flag
clear A
SIGNFLG WILL BE TOGGLED IF 2ND OR 3RD
   
.,E2B9 85 12 STA $12   setzen
clear the comparison evaluation flag
QUADRANT
   
.,E2BB 20 6B E2 JSR $E26B JSR SIN ;COMPUTE THE SIN.
SIN berechnen
perform SIN()
GET SIN(X)
   
.,E2BE A2 4E LDX #$4E LDXYI TEMPF3
Zeiger auf
set sin(n) pointer low byte
SAVE SIN(X) IN TEMP3
  low 004E
.,E2C0 A0 00 LDY #$00   Hilfsakku
set sin(n) pointer high byte
    high 004E
.,E2C2 20 F6 E0 JSR $E0F6 JSR GMOVMF ;PUT SIGN INTO OTHER TEMP.
FAC nach Hilfsakku
pack FAC1 into (XY)
<<<FUNNY WAY TO CALL MOVMF! >>>
   
.,E2C5 A9 57 LDA #$57 LDWDI TEMPF1
Zeiger auf
set n pointer low byte
RETRIEVE X
  low 005F
.,E2C7 A0 00 LDY #$00   Akku#3
set n pointer high byte
    high 005F
.,E2C9 20 A2 BB JSR $BBA2 JSR MOVFM ;PUT THIS MEMORY LOC INTO FAC.
Akku#3 nach FAC
unpack memory (AY) into FAC1
     
.,E2CC A9 00 LDA #$00 CLR FACSGN ;START OFF POSITIVE.
Vorzeichen
clear byte
AND COMPUTE COS(X)
   
.,E2CE 85 66 STA $66   löschen
clear FAC1 sign (b7)
     
.,E2D0 A5 12 LDA $12 LDA TANSGN
Flag
get the comparison evaluation flag
     
.,E2D2 20 DC E2 JSR $E2DC JSR COSC ;COMPUTE COSINE.
COS berechnen
save flag and go do series evaluation
WEIRD &amp; DANGEROUS WAY TO GET INTO SIN
   
.,E2D5 A9 4E LDA #$4E LDWDI TEMPF3 ;ADDRESS OF SINE VALUE.
Zeiger auf
set sin(n) pointer low byte
NOW FORM SIN/COS
  low 004E
.,E2D7 A0 00 LDY #$00   Hilfsakku (SIN)
set sin(n) pointer high byte
    high 004E
.,E2D9 4C 0F BB JMP $BB0F GFDIV: JMP FDIV ;DIVIDE SINE BY COSINE AND RETURN.
durch FAC dividieren
convert AY and do (AY)/FAC1

save comparison flag and do series evaluation

     
.,E2DC 48 PHA COSC: PHA
COS
save comparison flag
SHAME, SHAME!
   
.,E2DD 4C 9D E2 JMP $E29D JMP SIN1
berechnen

Konstanten für SIN und COS

add 0.25, ^2 then series evaluation

constants and series for SIN/COS(n)

 

PI2: TABLE OF TRIGONOMETRY CONSTANTS

The following constants are held in 5 byte flpt for
trigonometry evaluation.

float numbers for SIN, COS and TAN

0.5 * PI
.:E2E0 81 49 0F DA A2 PI2: 201 ;PI/2
111
017
333-ADDPRC
IFN ADDPRC,<242>
1.57079633 Pi/2
1.570796371, pi/2, as floating number
PI/2
; 1.570796327 (pi/2)

2 * PI

.:E2E5 83 49 0F DA A2 TWOPI: 203 ;2*PI.
111
017
333-ADDPRC
IFN ADDPRC,<242>
6.28318531 2*Pi
6.28319, 2*pi, as floating number
2*PI
; 6.28318531 (pi*2)

0,25

.:E2EA 7F 00 00 00 00 FR4: 177 ;1/4
000
000
0000
IFN ADDPRC,<0>
IFE ADDPRC,<SINCON: 4 ;DEGREE-1.
206 ;39.710899
036
327
373
207 ;-76.574956
231
046
145
207 ;81.602231
043
064
130
206 ;-41.341677
245
135
341
203 ;6.2831853
111
017
333>
IFN ADDPRC,<
.25
0.25
1/4
; 0.25

polynomial table

.:E2EF 05 SINCON: 5 ;DEGREE-1.
5 = Polynomgrad, 6
Koeffizienten
series counter
POWER OF POLYNOMIAL
; 5 (one byte counter for SIN series)
degree 6
.:E2F0 84 E6 1A 2D 1B 204 ; -14.381383816
346
032
055
033
-14.3813907
-14.3813907
(2PI)^11/11!
; -14.3813907 (SIN constant 1)
 
.:E2F5 86 28 07 FB F8 206 ; 42.07777095
050
007
373
370
42.0077971
42.0077971
(2PI)^9/9!
; 42.0077971 (SIN constant 2)
 
.:E2FA 87 99 68 89 01 207 ; -76.704133676
231
150
211
001
-76.7041703
-76.7041703
(2PI)^7/7!
; -76.7041703 (SIN constant 3)
 
.:E2FF 87 23 35 DF E1 207 ; 81.605223690
043
065
337
341
81.6052237
81.6052237
(2PI)^5/5!
; 81.6052237 (SIN constant 4)
 
.:E304 86 A5 5D E7 28 206 ; -41.34170209
245
135
347
050
-41.3147021
-41.3147021
(2PI)^3/3!
; -41.3417021 (SIN constant 5)
 
.:E309 83 49 0F DA A2 203 ; 6.2831853070
111
017
332
242
241 ; 7.2362932E7
124
106
217
23
217 ; 73276.2515
122
103
211
315>
PAGE

ARCTANGENT FUNCTION.

;USE IDENTITIES TO GET ARG BETWEEN 0 AND 1 AND THEN USE AN
;APPROXIMATION POLYNOMIAL TO COMPUTE ARCTAN(X).
6.28318531 2*Pi

BASIC-Funktion ATN

6.28318531 2*pi

perform ATN()

2PI

"ATN" FUNCTION

; 6.28318531 (SIN constant 6, pi*2)

ATN: PERFORM ATN

ATN function

.,E30E A5 66 LDA $66 ATN: LDA FACSGN ;WHAT IS SIGN?
Vorzeichen
get FAC1 sign (b7)
FOLD THE ARGUMENT RANGE FIRST
   
.,E310 48 PHA PHA ;(MEANWHILE SAVE FOR LATER.)
retten
save sign
SAVE SIGN FOR LATER UNFOLDING
   
.,E311 10 03 BPL $E316 BPL ATN1
positiv ?
branch if +ve
.GE. 0
   
.,E313 20 B4 BF JSR $BFB4 JSR NEGOP ;IF NEGATIVE, NEGATE FAC.
;USE ARCTAN(X)=-ARCTAN(-X) .
Vorzeichen vertauschen
else do - FAC1
.LT. 0, SO COMPLEMENT
   
.,E316 A5 61 LDA $61 ATN1: LDA FACEXP
Exponent
get FAC1 exponent
IF .GE. 1, FORM RECIPROCAL
   
.,E318 48 PHA PHA ;SAVE THIS TOO FOR LATER.
retten
push exponent
SAVE FOR LATER UNFOLDING
   
.,E319 C9 81 CMP #$81 CMPI 201 ;SEE IF FAC .GE. 1.0 .
Zahl mit 1 vergleichen
compare with 1
(EXPONENT FOR .GE. 1
   
.,E31B 90 07 BCC $E324 BCC ATN2 ;IT IS LESS THAN 1.
kleiner ?
branch if FAC1 < 1
X < 1
   
.,E31D A9 BC LDA #$BC LDWDI FONE ;GET PNTR TO 1.0 .
Zeiger auf
pointer to 1 low byte
FORM 1/X
  low B9BC
.,E31F A0 B9 LDY #$B9   Konstante 1
pointer to 1 high byte
    high B9BC
.,E321 20 0F BB JSR $BB0F JSR FDIV ;COMPUTE RECIPROCAL.
;USE ARCTAN(X)=PI/2-ARCTAN(1/X) .
1 durch FAC dividieren
(Kehrwert)
convert AY and do (AY)/FAC1
0 <= X <= 1
0 <= ATN(X) <= PI/8
   
.,E324 A9 3E LDA #$3E ATN2: LDWDI ATNCON ;PNTR TO ARCTAN CONSTANTS.
Zeiger auf
pointer to series low byte
COMPUTE POLYNOMIAL APPROXIMATION
  low E33E
.,E326 A0 E3 LDY #$E3   Polynomkoeffizienten
pointer to series high byte
    high E33E
.,E328 20 43 E0 JSR $E043 JSR POLYX
Polynom berechnen
^2 then series evaluation
     
.,E32B 68 PLA PLA
Exponent zurückholen
restore old FAC1 exponent
START TO UNFOLD
   
.,E32C C9 81 CMP #$81 CMPI 201 ;WAS ORIGINAL ARGUMENT .LT. 1 ?
war Zahl
compare with 1
WAS IT .GE. 1?
   
.,E32E 90 07 BCC $E337 BCC ATN3 ;YES.
kleiner 1, dann zu $E337
branch if FAC1 < 1
NO
   
.,E330 A9 E0 LDA #$E0 LDWDI PI2
Zeiger auf
pointer to (pi/2) low byte
YES, SUBTRACT FROM PI/2
  low E2E0
.,E332 A0 E2 LDY #$E2   Konstante Pi/2
pointer to (pi/2) low byte
    high E2E0
.,E334 20 50 B8 JSR $B850 JSR FSUB ;SUBTRACT ARCTAGN FROM PI/2.
Pi/2 minus FAC
perform subtraction, FAC1 from (AY)
     
.,E337 68 PLA ATN3: PLA ;WAS ORIGINAL ARGUMENT POSITIVE?
Vorzeichen holen
restore FAC1 sign
WAS IT NEGATIVE?
   
.,E338 10 03 BPL $E33D BPL ATN4 ;YES.
positiv ?
exit if was +ve
NO
   
.,E33A 4C B4 BF JMP $BFB4 JMP NEGOP ;IF NEGATIVE, NEGATE RESULT.
Vorzeichen wechseln
else do - FAC1 and return
YES, COMPLEMENT
   
.,E33D 60 RTS ATN4: RTS ;ALL DONE.
IFE ADDPRC,<
ATNCON: 10 ;DEGREE-1.
170 ;.0028498896
072
305
067
173 ;-.016068629
203
242
134
174 ;.042691519
056
335
115
175 ;-.075042945
231
260
036
175 ;.10640934
131
355
044
176 ;-.14203644
221
162
000
176 ;.19992619
114
271
163
177 ;.-33333073
252
252
123
201 ;1.0
000
000
000>
IFN ADDPRC,<
Rücksprung

Fließkommakonstanten für

ATN-Funktion

series for ATN(n)

 

ATNCON: TABLE OF ATN CONSTANTS

The table holds a 1 byte counter and the folloeing 5 byte
flpt constants.

float numbers for ATN

polynomial table
.:E33E 0B ATNCON: 13 ;DEGREE-1.
11 = Polynomgrad, dann 12
Koeffizienten
series counter
POWER OF POLYNOMIAL
; 13 (one byte counter for ATN series)
degree 12
.:E33F 76 B3 83 BD D3 166 ; -.0006847939119
263
203
275
323
-6.84793912E-04
-6.84793912E-04
  ; -0.000684793912 (ATN constant 1)
 
.:E344 79 1E F4 A6 F5 171 ; .004850942156
036
364
246
365
4.85094216E-03
4.85094216E-03
  ; 0.00485094216 (ATN constant 2)
 
.:E349 7B 83 FC B0 10 173 ; -.01611170184
203
374
260
020
-.0161117015
-.0161117015
  ; -0.161117018 (ATN constant 3)
 
.:E34E 7C 0C 1F 67 CA 174 ; .03420963805
014
037
147
312
.034209638
.034209638
  ; 0.034209638 (ATN constant 5)
 
.:E353 7C DE 53 CB C1 174 ; -.05427913276
336
123
313
301
-.054279133
-.054279133
  ; -0.0542791328 (ATN constant 6)
 
.:E358 7D 14 64 70 4C 175 ; .07245719654
024
144
160
114
.0724571965
.0724571965
  ; 0.0724571965 (ATN constant 7)
 
.:E35D 7D B7 EA 51 7A 175 ; -.08980239538
267
352
121
172
-.0898019185
-.0898019185
  ; -0.0898023954 (ATN constant 8)
 
.:E362 7D 63 30 88 7E 175 ; .1109324134
143
060
210
176
.110932413
.110932413
  ; 0.110932413 (ATN constant 9)
 
.:E367 7E 92 44 99 3A 176 ; -.1428398077
222
104
231
072
-.142839808
-.142839808
  ; -0.14283908 (ATN constant 10)
 
.:E36C 7E 4C CC 91 C7 176 ; .1999991205
114
314
221
307
.19999912
.19999912
  ; 0.19999912 (ATN constant 11)
 
.:E371 7F AA AA AA 13 177 ; -.3333333157
252
252
252
023
-.333333316
-.333333316
  ; -0.333333316 (ATN constant 12)
 
.:E376 81 00 00 00 00 201 ; 1.0
000
000
000
000>>
1

BASIC NMI-Einsprung

1

BASIC warm start entry point

  ; 1 (ATN constant 13)

BASSFT: BASIC WARM START

This is the BASIC warm start routine that is vectored at
the very start of the BASIC ROM. The routine is called by
the 6510 BRK instruction, or STOP/RESTORE being pressed.
It outputs the READY prompt via the IERROR vector at
$0300. If the error code, in (X) is larger than $80, then
only the READY text will be displayed.

warm start entry

.,E37B 20 CC FF JSR $FFCC   CLRCH
close input and output channels
  CLRCHN, close all I/O channels
 
.,E37E A9 00 LDA #$00   Eingabegerät gleich
clear A
     
.,E380 85 13 STA $13   Tastatur
set current I/O channel, flag default
  input prompt flag
 
.,E382 20 7A A6 JSR $A67A   BASIC initialisieren
flush BASIC stack and clear continue pointer
  do CLR
 
.,E385 58 CLI   Interrupt freigeben
enable the interrupts
  enable IRQ
 
.,E386 A2 80 LDX #$80   Flag für kein Fehler
set -ve error, just do warm start
  error code #$80
 
.,E388 6C 00 03 JMP ($0300)   BASIC Warmstart Vektor
JMP $E38B
go handle error message, normally $E38B
  perform error
normally E38B

handle error messages

.,E38B 8A TXA   Fehlernummer in Akku
copy the error number
  error number
 
.,E38C 30 03 BMI $E391   kein Fehler, dann 'ready.'
if -ve go do warm start
  larger than $80
 
.,E38E 4C 3A A4 JMP $A43A   Fehlermeldung ausgeben
else do error #X then warm start
  nope, print error
 
.,E391 4C 74 A4 JMP $A474   Ready - Modus

BASIC Kaltstart

do warm start

BASIC cold start entry point

  print READY

INIT: BASIC COLD START

This is the BASIC cold start routine that is vectored at
the very start of the BASIC ROM. BASIC vectors and
variables are set up, and power-up message is output, and
BASIC is restarted.

RESET routine

.,E394 20 53 E4 JSR $E453   BASIC-Vektoren setzen
initialise the BASIC vector table
     
.,E397 20 BF E3 JSR $E3BF   RAM initialisieren
initialise the BASIC RAM locations
  Initialize BASIC
 
.,E39A 20 22 E4 JSR $E422   Einschaltmeldung ausgeben
print the start up message and initialise the memory
pointers
not ok ??
  output power-up message
 
.,E39D A2 FB LDX #$FB   Stackzeiger
value for start stack
  reset stack
 
.,E39F 9A TXS   setzen
set stack pointer
     
.,E3A0 D0 E4 BNE $E386 PAGE

SYSTEM INITIALIZATION CODE.

RADIX 10 ;IN ALL NON-MATH-PACKAGE CODE.
; THIS INITIALIZES THE BASIC INTERPRETER FOR THE M6502 AND SHOULD BE
; LOCATED WHERE IT WILL BE WIPED OUT IN RAM IF CODE IS ALL IN RAM.
IFE ROMSW,<
BLOCK 1> ;SO ZEROING AT TXTTAB DOESN'T PREVENT
;RESTARTING INIT
zum Warmstart

Kopie der CHRGET-Routine

do "READY." warm start, branch always

character get subroutine for zero page

the target address for the LDA $EA60 becomes the BASIC execute pointer once the
block is copied to its destination, any non zero page address will do at assembly
time, to assemble a three byte instruction. $EA60 is RTS, NOP.
page 0 initialisation table from $0073
increment and scan memory

GENERIC COPY OF CHRGET SUBROUTINE

WHICH IS COPIED INTO $00B1...$00C8 DURING INITIALIZATION
CORNELIS BONGERS DESCRIBED SEVERAL IMPROVEMENTS
TO CHRGET IN MICRO MAGAZINE OR CALL A.P.P.L.E.
(I DON'T REMEMBER WHICH OR EXACTLY WHEN)
output READY, and restart BASIC

INITAT: CHRGET FOR ZEROPAGE

This is the CHRGET routine which is transferred to RAM
starting at $0073 on power-up or reset.

character fetch code for zero page $0073-$008F

.,E3A2 E6 7A INC $7A INITAT: INC CHRGET+7 ;INCREMENT THE WHOLE TXTPTR.
LOW-Byte Zeiger erhöhen
increment BASIC execute pointer low byte
  increment <TXTPTR
 
.,E3A4 D0 02 BNE $E3A8 BNE CHZGOT
Zeiger in BASIC-Text erhöhen
branch if no carry
else
  skip high byte
 
.,E3A6 E6 7B INC $7B INC CHRGET+8
HIGH-Byte Zeiger erhöhen
increment BASIC execute pointer high byte
page 0 initialisation table from $0079
scan memory
  increment >TXTPTR
 
.,E3A8 AD 60 EA LDA $EA60 CHZGOT: LDA 60000 ;A LOAD WITH AN EXT ADDR.
BASIC-Adresse laden
get byte to scan, address set by call routine
<<< ACTUAL ADDRESS FILLED IN LATER >>>
CHRGOT entry, read TXTPTR
 
.,E3AB C9 3A CMP #$3A CMPI ":" ;IS IT A ":"?
keine Zahl,
compare with ":"
EOS, ALSO TOP OF NUMERIC RANGE
colon (terminator), sets (Z)
colon
.,E3AD B0 0A BCS $E3B9 BCS CHZRTS ;IT IS .GE. ":"
dann fertig
exit if>=
page 0 initialisation table from $0080
clear Cb if numeric
NOT NUMBER, MIGHT BE EOS
   
.,E3AF C9 20 CMP #$20 CMPI " " ;SKIP SPACES.
' ' Leerzeichen überlesen
compare with " "
IGNORE BLANKS
space, get next character
space
.,E3B1 F0 EF BEQ $E3A2 BEQ INITAT
ja, nächstes Zeichen
if " " go do next
     
.,E3B3 38 SEC SEC
Test auf
set carry for SBC
TEST FOR NUMERIC RANGE IN WAY THAT
   
.,E3B4 E9 30 SBC #$30 SBCI "0" ;ALL CHARS .GT. "9" HAVE RET'D SO
Ziffer,
subtract "0"
CLEARS CARRY IF CHAR IS DIGIT
zero
0
.,E3B6 38 SEC SEC
dann
set carry for SBC
AND LEAVES CHAR IN A-REG
   
.,E3B7 E9 D0 SBC #$D0 SBCI ^D256-"0" ;SEE IF NUMERIC.
;TURN CARRY ON IF NUMERIC.
;ALSO, SETZ IF NULL.
C=1
subtract -"0"
clear carry if byte = "0"-"9"
     
.,E3B9 60 RTS CHZRTS: RTS ;RETURN TO CALLER.
Rücksprung

Anfangswert für RND-Funktion

spare bytes, not referenced

INITIAL VALUE FOR RANDOM NUMBER

ALSO COPIED IN ALONG WITH CHRGET, BUT ERRONEOUSLY:
<<< THE LAST BYTE IS NOT COPIED >>>

RNDSED: RANDOM SEED FOR ZEROPAGE

This is the initial value of the seed for the random
number function. It is copied into RAM from $008b-$008f.
Its fltp value is 0.811635157.

first RND seed value

.:E3BA 80 4F C7 52 58 128 ;LOADED OR FROM ROM.
79 ;THE INITIAL RANDOM NUMBER.
199
82
IFN ADDPRC,<88>
IFN REALIO-3,<
IFE KIMROM,<
TYPAUT: LDWDI AUTTXT
JSR STROUT>>
INIT:
IFN REALIO-3,<
.811635157

RAM für BASIC initialisieren

0.811635157

initialise BASIC RAM locations

APPROX. = .811635157

INITCZ: INITIALISE BASIC RAM

This routine sets the USR jump instruction to point to
?ILLEGAL QUANTITY error, sets ADRAY1 and ADRAY2, copies
CHRGET and RNDSED to zeropage, sets up the start and end
locations for BASIC text and sets the first text byte to
zero.

initialisation of basic

.,E3BF A9 4C LDA #$4C LDXI 255 ;MAKE IT LOOK DIRECT IN CASE OF
JMP
opcode for JMP
  ; opcode for JMP
 
.,E3C1 85 54 STA $54 STX CURLIN+1> ;ERROR MESSAGE.
für Funktionen
save for functions vector jump
  ; store in JMPER
 
.,E3C3 8D 10 03 STA $0310 IFN STKEND-511,<
für USR-Funktion
save for USR() vector jump
set USR() vector to illegal quantity error
  ; USRPOK, set USR JMP instruction
 
.,E3C6 A9 48 LDA #$48 LDXI STKEND-256>
Zeiger auf
set USR() vector low byte
    low B248
.,E3C8 A0 B2 LDY #$B2 TXS
'ILLEGAL QUANTITY'
set USR() vector high byte
  ; vector to $b248, ?ILLEGAL QUANTITY
high B248
.,E3CA 8D 11 03 STA $0311 IFN REALIO-3,<
als USR-Vektor
save USR() vector low byte
     
.,E3CD 8C 12 03 STY $0312 LDWDI INIT ;ALLOW RESTART.
speichern
save USR() vector high byte
  ; store in USRADD
 
.,E3D0 A9 91 LDA #$91 STWD START+1
Adresse
set fixed to float vector low byte
    lowh B391
.,E3D2 A0 B3 LDY #$B3 STWD RDYJSR+1 ;RTS HERE ON ERRORS.
$B391
set fixed to float vector high byte
  ; vector to $b391
high B391
.,E3D4 85 05 STA $05 LDWDI AYINT
als Vektor für
save fixed to float vector low byte
     
.,E3D6 84 06 STY $06 STWD ADRAYI
Fest-/Fließkomma-Wandlung
save fixed to float vector high byte
  ; store in ADRAY2
 
.,E3D8 A9 AA LDA #$AA LDWDI GIVAYF
Adresse
set float to fixed vector low byte
POINT "USR" TO ILLEGAL QUANTITY
  low B1AA
.,E3DA A0 B1 LDY #$B1 STWD ADRGAY>
$B1AA
set float to fixed vector high byte
ERROR, UNTIL USER SETS IT UP
; vector to $b1aa
high B1AA
.,E3DC 85 03 STA $03 LDAI 76 ;JMP INSTRUCTION.
als Vektor für
save float to fixed vector low byte
     
.,E3DE 84 04 STY $04 IFE REALIO,<HRLI 1,^O1000> ;MAKE AN INST.
IFN REALIO-3,<
STA START
STA RDYJSR>
STA JMPER
IFN ROMSW,<
STA USRPOK
LDWDI FCERR
STWD USRPOK+1>
LDAI LINLEN ;THESE MUST BE NON-ZERO SO CHEAD WILL
STA LINWID ;WORK AFTER MOVING A NEW LINE IN BUF
;INTO THE PROGRAM
LDAI NCMPOS
STA NCMWID
Fließ-/Festkomma-Wandlung
save float to fixed vector high byte
copy the character get subroutine from $E3A2 to $0074

MOVE GENERIC CHRGET AND RANDOM SEED INTO PLACE

<<< NOTE THAT LOOP VALUE IS WRONG! >>>
<<< THE LAST BYTE OF THE RANDOM SEED IS NOT >>>
<<< COPIED INTO PAGE ZERO! >>>
; store in ADRAY1
 
.,E3E0 A2 1C LDX #$1C LDXI RNDX+4-CHRGET
Zähler setzen
set the byte count
  ; copy the CHRGET routine and RNDSED to RAM
 
.,E3E2 BD A2 E3 LDA $E3A2,X MOVCHG: LDA INITAT-1,X,
CHRGET-Routine
get a byte from the table
  ; source address
 
.,E3E5 95 73 STA $73,X STA CHRGET-1,X, ;MOVE TO RAM.
ins
save the byte in page zero
  ; destination address
 
.,E3E7 CA DEX DEX
RAM kopieren
decrement the count
  ; next byte
 
.,E3E8 10 F8 BPL $E3E2 BNE MOVCHG
schon alles?
loop if not all done
clear descriptors, strings, program area and mamory pointers
  ; till ready
 
.,E3EA A9 03 LDA #$03 LDAI STRSIZ
Schrittweise
set the step size, collecting descriptors
SET LENGTH OF TEMP. STRING DESCRIPTORS
   
.,E3EC 85 53 STA $53 STA FOUR6
für Garbage Collection
save the garbage collection step size
FOR GARBAGE COLLECTION SUBROUTINE
; store #3 in FOUR6, garbage collection
 
.,E3EE A9 00 LDA #$00 TXA ;SET CONST IN RAM.
FAC-Rundungsbyte
clear A
     
.,E3F0 85 68 STA $68 STA BITS
löschen
clear FAC1 overflow byte
  ; init BITS, fac#1 overflow
 
.,E3F2 85 13 STA $13 IFN EXTIO,<
Eingabegerät gleich
clear the current I/O channel, flag default
  ; init input prompt flag
 
.,E3F4 85 18 STA $18 STA CHANNL>
Tastatur
clear the current descriptor stack item pointer high byte
  ; init LASTPT
 
.,E3F6 A2 01 LDX #$01 STA LASTPT+1
Dummys
set X
SET UP FAKE FORWARD LINK
   
.,E3F8 8E FD 01 STX $01FD IFN NULCMD,<
für Linkadresse beim
set the chain link pointer low byte
     
.,E3FB 8E FC 01 STX $01FC STA NULCNT>
Zeileneinbau
set the chain link pointer high byte
     
.,E3FE A2 19 LDX #$19 PHA ;PUT ZERO AT THE END OF THE STACK
Zeiger für
initial the value for descriptor stack
INIT INDEX TO TEMP STRING DESCRIPTORS
   
.,E400 86 16 STX $16 ;SO FNDFOR WILL STOP
Stringverwaltung
set descriptor stack pointer
  ; TEMPPT, pointer to descriptor stack
 
.,E402 38 SEC IFN REALIO,<
RAM-
set Cb = 1 to read the bottom of memory
  ; set carry to indicate read mode
 
.,E403 20 9C FF JSR $FF9C STA CNTWFL> ;BE TALKATIVE.
Start holen
read/set the bottom of memory
  ; read MEMBOT
 
.,E406 86 2B STX $2B IFN BUFPAG,<
als BASIC-Start
save the start of memory low byte
  ; set TXTTAB, bottom of RAM
 
.,E408 84 2C STY $2C INX ;MAKE [X]=1
speichern
save the start of memory high byte
     
.,E40A 38 SEC STX BUF-3 ;SET PRE-BUF BYTES NON-ZERO FOR CHEAD
RAM-
set Cb = 1 to read the top of memory
  ; set carry to indicate read mode
 
.,E40B 20 99 FF JSR $FF99 STX BUF-4>
Ende holen
read/set the top of memory
  ; read MEMTOP
 
.,E40E 86 37 STX $37 IFN REALIO-3,<
als
save the end of memory low byte
  ; set MEMSIZ, top of RAM
 
.,E410 84 38 STY $38 JSR CRDO> ;TYPE A CR.
BASIC-
save the end of memory high byte
     
.,E412 86 33 STX $33 LDXI TEMPST
Ende
set the bottom of string space low byte
  ; set FRETOP = MEMTOP
 
.,E414 84 34 STY $34 STX TEMPPT ;SET UP STRING TEMPORARIES.
speichern
set the bottom of string space high byte
     
.,E416 A0 00 LDY #$00 IFN REALIO!LONGI,<
$00
clear the index
     
.,E418 98 TYA IFN REALIO-3,<
an
clear the A
     
.,E419 91 2B STA ($2B),Y LDWDI MEMORY
BASIC-Start
clear the the first byte of memory
  ; store zero at start of BASIC
 
.,E41B E6 2B INC $2B JSR STROUT
den
increment the start of memory low byte
  ; increment TXTTAB to next memory position
 
.,E41D D0 02 BNE $E421 JSR QINLIN ;GET A LINE OF INPUT.
BASIC-
if no rollover skip the high byte increment
  ; skip msb
 
.,E41F E6 2C INC $2C STXY TXTPTR ;READ THIS !
Start + 1
increment start of memory high byte
     
.,E421 60 RTS JSR CHRGET ;GET THE FIRST CHARACTER.
Programmnde

print the start up message and initialise the memory pointers

  ; return

INITMS: OUTPUT POWER-UP MESSAGE

This routine outputs the startup message. It then
calcuates the number of BASIC bytes free by subatracting
the TXTTAB from MEMSIZ, and outputs this number. The
routine exits via NEW.

print BASIC start up messages

.,E422 A5 2B LDA $2B IFE KIMROM,<
Zeiger auf
get the start of memory low byte
  read TXTTAB, start of BASIC
 
.,E424 A4 2C LDY $2C CMPI "A" ;IS IT AN "A"?
BASIC-RAM Start
get the start of memory high byte
     
.,E426 20 08 A4 JSR $A408 BEQ TYPAUT> ;YES TYPE AUTHOR'S NAME.
prüft auf Platz im Speicher
check available memory, do out of memory error if no room
  check for memory overlap
 
.,E429 A9 73 LDA #$73 TAY ;NULL INPUT?
Zeiger auf
set "**** COMMODORE 64 BASIC V2 ****" pointer low byte
  $e473, startup message
low E473
.,E42B A0 E4 LDY #$E4 BNE USEDE9> ;NO.
Einschaltmeldung
set "**** COMMODORE 64 BASIC V2 ****" pointer high byte
    high E473
.,E42D 20 1E AB JSR $AB1E IFE REALIO-3,<
String ausgeben
print a null terminated string
  output (A/Y)
 
.,E430 A5 37 LDA $37 LDYI RAMLOC/^D256>
BASIC-
get the end of memory low byte
  MEMSIZ, highest address in BASIC
 
.,E432 38 SEC IFN REALIO-3,<
Ende
set carry for subtract
  prepare for substract
 
.,E433 E5 2B SBC $2B IFE ROMSW,<
minus
subtract the start of memory low byte
  substract TXTTAB
 
.,E435 AA TAX LDWDI LASTWR> ;YES GET PNTR TO LAST WORD.
BASIC-Start
copy the result to X
  move to (X)
 
.,E436 A5 38 LDA $38 IFN ROMSW,<
gleich
get the end of memory high byte
  and highbyte
 
.,E438 E5 2C SBC $2C LDWDI RAMLOC>>
Bytes free
subtract the start of memory high byte
     
.,E43A 20 CD BD JSR $BDCD IFN ROMSW,<
Anzahl ausgeben
print XA as unsigned integer
  output number in (A/X)
 
.,E43D A9 60 LDA #$60 STWD TXTTAB> ;SET UP START OF PROGRAM LOCATION
Zeiger auf
set " BYTES FREE" pointer low byte
  $e460
low E460
.,E43F A0 E4 LDY #$E4 STWD LINNUM
'BASIC BYTES FREE'
set " BYTES FREE" pointer high byte
  pointer to 'BASIC BYTES FREE'
high E460
.,E441 20 1E AB JSR $AB1E IFE REALIO-3,<
String ausgeben
print a null terminated string
  output (A/Y)
 
.,E444 4C 44 A6 JMP $A644 TAY>
zum NEW-Befehl

Tabelle der BASIC-Vektoren

do NEW, CLEAR, RESTORE and return

BASIC vectors, these are copied to RAM from $0300 onwards

  perform NEW

VECTORS

This table contains jump vectors that are transfered to
$0300-$030b.

vectors for $0300-$030B

.:E447 8B E3 83 A4 7C A5 1A A7 IFN REALIO-3,<
  error message $0300
  IERROR VEC, print basic error message ($e38b)
 
.:E44F E4 A7 86 AE LDYI 0>
  BASIC warm start $0302
crunch BASIC tokens $0304
uncrunch BASIC tokens $0306
start new BASIC code $0308
  IMAIN VECTOR, basic warm start ($a483)
ICRNCH VECTOR, tokenise basic text ($a57c)
IQPLOP VECTOR, list basic text ($a7a1)
IGONE VEXTOR, basic character dispatch ($a7e4)
 
.,E453 A2 0B LDX #$0B LOOPMM: INC LINNUM
Die
get arithmetic element $030A

initialise the BASIC vectors

set byte count
  IEVAL VECTOR, evaluate basic token ($ae86)

INIT VECTORS

This routine transfers the vectors $0300-$030b.
6 vectors to be copied

initialise vectors

.,E455 BD 47 E4 LDA $E447,X BNE LOOPM1
BASIC-
get byte from table
     
.,E458 9D 00 03 STA $0300,X INC LINNUM+1
Vektoren
save byte to RAM
     
.,E45B CA DEX IFE REALIO-3,<
laden
decrement index
  next byte
 
.,E45C 10 F7 BPL $E455 BMI USEDEC>
schon alle?
loop if more to do
  ready
 
.,E45E 60 RTS LOOPM1: LDAI 85 ;PUT RANDOM INFO INTO MEM.
STADY LINNUM
CMPDY LINNUM ;WAS IT SAVED?
BNE USEDEC ;NO. THAT IS END OF MEMORY.
ASL A, ;LOOKS LIKE IT. TRY ANOTHER.
STADY LINNUM
CMPDY LINNUM ;WAS IT SAVED?
IFN REALIO-3,<
BNE USEDEC> ;NO. THIS IS THE END.
IFN REALIO-2,<
BEQ LOOPMM>
IFE REALIO-2,<
BNE USEDEC
CMP 0 ;SEE IF HITTING PAGE 0
BNE LOOPMM
LDAI 76
STA 0
BNEA USEDEC>
IFN REALIO-3,<
USEDE9: JSR CHRGOT ;GET CURRENT CHARACTER.
JSR LINGET ;GET DECIMAL ARGUMENT.
TAY ;MAKE SURE A TERMINATOR EXISTS.
BEQ USEDEC ;IT DOES.
JMP SNERR> ;IT DOESN'T.
USEDEC: LDWD LINNUM ;GET SIZE OF MEMORY INPUT.
USEDEF: > ;HIGHEST ADDRESS.
IFE REALIO!LONGI,<
LDWDI 16190> ;A STRANGE NUMBER.
STWD MEMSIZ ;THIS IS THE SIZE OF MEMORY.
STWD FRETOP ;TOP OF STRINGS TOO.
TTYW:
IFN REALIO-3,<
IFN REALIO!LONGI,<
LDWDI TTYWID
JSR STROUT
JSR QINLIN ;GET LINE OF INPUT.
STXY TXTPTR ;READ THIS !
JSR CHRGET ;GET FIRST CHARACTER.
TAY ;TEST ACCA BUT DON'T AFFECT CARRY.
BEQ ASKAGN
JSR LINGET ;GET ARGUMENT.
LDA LINNUM+1
BNE TTYW ;WIDTH MUST BE .LT. 256.
LDA LINNUM
CMPI 16 ;WIDTH MUST BE GREATER THAN 16.
BCC TTYW
STA LINWID ;THAT IS THE LINE WIDTH.
MORCPS: SBCI CLMWID ;COMPUTE POSITION BEYOND WHICH
BCS MORCPS ;THERE ARE NO MORE FIELDS.
EORI 255
SBCI CLMWID-2
CLC
ADC LINWID
STA NCMWID>
ASKAGN:
IFE ROMSW,<
IFN REALIO!LONGI,<
LDWDI FNS
JSR STROUT
JSR QINLIN
STXY TXTPTR ;READ THIS !
JSR CHRGET
LDXYI INITAT ;DEFAULT.
CMPI "Y"
BEQ HAVFNS ;SAVE ALL FUNCTIONS.
CMPI "A"
BEQ OKCHAR ;SAVE ALL BUT ATN.
CMPI "N"
BNE ASKAGN ;BAD INPUT.
;SAVE NOTHING.
OKCHAR: LDXYI FCERR
STXY ATNFIX ;GET RID OF ATN FUNCTION.
LDXYI ATN ;UNTIL WE KNOW THAT WE SHOULD DEL MORE.
CMPI "A"
BEQ HAVFNS ;JUST GET RID OF ATN.
LDXYI FCERR
STXY COSFIX ;GET RID OF THE REST.
STXY TANFIX
STXY SINFIX
LDXYI COS ;AND GET RID OF ALL BACK TO "COS".
HAVFNS:>
IFE REALIO!LONGI,<
LDXYI INITAT-1>>> ;GET RID OF ALL UP TO "INITAT".
IFN ROMSW,<
LDXYI RAMLOC
STXY TXTTAB>
LDYI 0
TYA
STADY TXTTAB ;SET UP TEXT TABLE.
INC TXTTAB
IFN REALIO-3,<
BNE QROOM
INC TXTTAB+1>
QROOM: LDWD TXTTAB ;PREPARE TO USE "REASON".
JSR REASON
IFE REALIO-3,<
LDWDI FREMES
JSR STROUT>
IFN REALIO-3,<
JSR CRDO>
LDA MEMSIZ ;COMPUTE [MEMSIZ]-[VARTAB].
SEC
SBC TXTTAB
TAX
LDA MEMSIZ+1
SBC TXTTAB+1
JSR LINPRT ;TYPE THIS VALUE.
LDWDI WORDS ;MORE BULLSHIT.
JSR STROUT
JSR SCRTCH ;SET UP EVERYTHING ELSE.
IFE REALIO-3,<
JMP READY>
IFN REALIO-3,<
LDWDI STROUT
STWD RDYJSR+1
LDWDI READY
STWD START+1
JMPD START+1
IFE ROMSW,<
FNS: DT"WANT SIN-COS-TAN-ATN"
0>
IFE KIMROM,<
AUTTXT: ACRLF
12 ;ANOTHER LINE FEED.
DT"WRITTEN "
DT"BY WEILAND & GATES"
ACRLF
0>
MEMORY: DT"MEMORY SIZE"
0
TTYWID:
IFE KIMROM,<
DT"TERMINAL ">
DT"WIDTH"
0>
WORDS: DT" BYTES FREE"
IFN REALIO-3,<
ACRLF
ACRLF>
IFE REALIO-3,<
EXP ^O15
0
FREMES: >
IFE REALIO,< DT"SIMULATED BASIC FOR THE 6502 V1.1">
IFE REALIO-1,< DT"KIM BASIC V1.1">
IFE REALIO-2,< DT"OSI 6502 BASIC VERSION 1.1">
IFE REALIO-3,< DT"### COMMODORE BASIC ###"
EXP ^O15
EXP ^O15>
IFE REALIO-4,<DT"APPLE BASIC V1.1">
IFE REALIO-5,<DT"STM BASIC V1.1">
IFN REALIO-3,<
ACRLF
DT"COPYRIGHT 1978 MICROSOFT"
ACRLF>
0
LASTWR::
BLOCK 100 ;SPACE FOR TEMP STACK.
IFE REALIO,<
TSTACK::BLOCK 13600>
IF2,<
PURGE A,X,Y>
IFNDEF START,<START==0>
END $Z+START
ERNAL ROM Disassembly (English, "CBM")
rom
rce by Commodore (901227-03)
bmsrc
p=894
y a complete copy of the original
version in the C64 ROM.
mes are intact.
hael Steil <mist64@mac.com>
g up) welcome at:
ef
----------------------------
ted so that it can be automatically
s-references etc.
op-level information. The first line
with "--" are separators.
internal comments.
icate code to be disassembled.
icate bytes to be dumped.
olumn.
indicate a heading.
indicate an overflow comment.

.LIB DISCLAIMER

;****************************************
;* *
;* KK K EEEEE RRRR NN N AAA LL *
;* KK KK EE RR R NNN N AA A LL *
;* KKK EE RR R NNN N AA A LL *
;* KKK EEEE RRRR NNNNN AAAAA LL *
;* KK K EE RR R NN NN AA A LL *
;* KK KK EE RR R NN NN AA A LL *
;* KK KK EEEEE RR R NN NN AA A LLLLL *
;* *
;***************************************
;
;***************************************
;* PET KERNAL *
;* MEMORY AND I/O DEPENDENT ROUTINES *
;* DRIVING THE HARDWARE OF THE *
;* FOLLOWING CBM MODELS: *
;* COMMODORE 64 OR MODIFED VIC-40 *
;* COPYRIGHT (C) 1982 BY *
;* COMMODORE BUSINESS MACHINES (CBM) *
;***************************************
;****LISTING DATE --1200 14 MAY 1982****
;***************************************
;* THIS SOFTWARE IS FURNISHED FOR USE *
;* USE IN THE VIC OR COMMODORE COMPUTER*
;* SERIES ONLY. *
;* *
;* COPIES THEREOF MAY NOT BE PROVIDED *
;* OR MADE AVAILABLE FOR USE ON ANY *
;* OTHER SYSTEM. *
;* *
;* THE INFORMATION IN THIS DOCUMENT IS *
;* SUBJECT TO CHANGE WITHOUT NOTICE. *
;* *
;* NO RESPONSIBILITY IS ASSUMED FOR *
;* RELIABILITY OF THIS SOFTWARE. RSR *
;* *
;***************************************
.END

.LIB DECLARE

*=$0000 ;DECLARE 6510 PORTS
D6510 *=*+1 ;6510 DATA DIRECTION REGISTER
R6510 *=*+1 ;6510 DATA REGISTER
*=$0002 ;MISS 6510 REGS
;VIRTUAL REGS FOR MACHINE LANGUAGE MONITOR
PCH *=*+1
PCL *=*+1
FLGS *=*+1
ACC *=*+1
XR *=*+1
YR *=*+1
SP *=*+1
INVH *=*+1 ;USER MODIFIABLE IRQ
INVL *=*+1
* =$90
STATUS *=*+1 ;I/O OPERATION STATUS BYTE
; CRFAC *=*+2 ;CORRECTION FACTOR (UNUSED)
STKEY *=*+1 ;STOP KEY FLAG
SVXT *=*+1 ;TEMPORARY
VERCK *=*+1 ;LOAD OR VERIFY FLAG
C3P0 *=*+1 ;IEEE BUFFERED CHAR FLAG
BSOUR *=*+1 ;CHAR BUFFER FOR IEEE
SYNO *=*+1 ;CASSETTE SYNC #
XSAV *=*+1 ;TEMP FOR BASIN
LDTND *=*+1 ;INDEX TO LOGICAL FILE
DFLTN *=*+1 ;DEFAULT INPUT DEVICE #
DFLTO *=*+1 ;DEFAULT OUTPUT DEVICE #
PRTY *=*+1 ;CASSETTE PARITY
DPSW *=*+1 ;CASSETTE DIPOLE SWITCH
MSGFLG *=*+1 ;OS MESSAGE FLAG
PTR1 ;CASSETTE ERROR PASS1
T1 *=*+1 ;TEMPORARY 1
TMPC
PTR2 ;CASSETTE ERROR PASS2
T2 *=*+1 ;TEMPORARY 2
TIME *=*+3 ;24 HOUR CLOCK IN 1/60TH SECONDS
R2D2 ;SERIAL BUS USAGE
PCNTR *=*+1 ;CASSETTE STUFF
; PTCH *=*+1 (UNUSED)
BSOUR1 ;TEMP USED BY SERIAL ROUTINE
FIRT *=*+1
COUNT ;TEMP USED BY SERIAL ROUTINE
CNTDN *=*+1 ;CASSETTE SYNC COUNTDOWN
BUFPT *=*+1 ;CASSETTE BUFFER POINTER
INBIT ;RS-232 RCVR INPUT BIT STORAGE
SHCNL *=*+1 ;CASSETTE SHORT COUNT
BITCI ;RS-232 RCVR BIT COUNT IN
RER *=*+1 ;CASSETTE READ ERROR
RINONE ;RS-232 RCVR FLAG FOR START BIT CHECK
REZ *=*+1 ;CASSETE READING ZEROES
RIDATA ;RS-232 RCVR BYTE BUFFER
RDFLG *=*+1 ;CASSETTE READ MODE
RIPRTY ;RS-232 RCVR PARITY STORAGE
SHCNH *=*+1 ;CASSETTE SHORT CNT
SAL *=*+1
SAH *=*+1
EAL *=*+1
EAH *=*+1
CMP0 *=*+1
TEMP *=*+1
TAPE1 *=*+2 ;ADDRESS OF TAPE BUFFER #1Y.
BITTS ;RS-232 TRNS BIT COUNT
SNSW1 *=*+1
NXTBIT ;RS-232 TRNS NEXT BIT TO BE SENT
DIFF *=*+1
RODATA ;RS-232 TRNS BYTE BUFFER
PRP *=*+1
FNLEN *=*+1 ;LENGTH CURRENT FILE N STR
LA *=*+1 ;CURRENT FILE LOGICAL ADDR
SA *=*+1 ;CURRENT FILE 2ND ADDR
FA *=*+1 ;CURRENT FILE PRIMARY ADDR
FNADR *=*+2 ;ADDR CURRENT FILE NAME STR
ROPRTY ;RS-232 TRNS PARITY BUFFER
OCHAR *=*+1
FSBLK *=*+1 ;CASSETTE READ BLOCK COUNT
MYCH *=*+1
CAS1 *=*+1 ;CASSETTE MANUAL/CONTROLLED SWITCH
TMP0
STAL *=*+1
STAH *=*+1
MEMUSS ;CASSETTE LOAD TEMPS (2 BYTES)
TMP2 *=*+2
;
;VARIABLES FOR SCREEN EDITOR
;
LSTX *=*+1 ;KEY SCAN INDEX
; SFST *=*+1 ;KEYBOARD SHIFT FLAG (UNUSED)
NDX *=*+1 ;INDEX TO KEYBOARD Q
RVS *=*+1 ;RVS FIELD ON FLAG
INDX *=*+1
LSXP *=*+1 ;X POS AT START
LSTP *=*+1
SFDX *=*+1 ;SHIFT MODE ON PRINT
BLNSW *=*+1 ;CURSOR BLINK ENAB
BLNCT *=*+1 ;COUNT TO TOGGLE CUR
GDBLN *=*+1 ;CHAR BEFORE CURSOR
BLNON *=*+1 ;ON/OFF BLINK FLAG
CRSW *=*+1 ;INPUT VS GET FLAG
PNT *=*+2 ;POINTER TO ROW
; POINT *=*+1 (UNUSED)
PNTR *=*+1 ;POINTER TO COLUMN
QTSW *=*+1 ;QUOTE SWITCH
LNMX *=*+1 ;40/80 MAX POSITON
TBLX *=*+1
DATA *=*+1
INSRT *=*+1 ;INSERT MODE FLAG
LDTB1 *=*+26 ;LINE FLAGS+ENDSPACE
USER *=*+2 ;SCREEN EDITOR COLOR IP
KEYTAB *=*+2 ;KEYSCAN TABLE INDIRECT
;RS-232 Z-PAGE
RIBUF *=*+2 ;RS-232 INPUT BUFFER POINTER
ROBUF *=*+2 ;RS-232 OUTPUT BUFFER POINTER
FREKZP *=*+4 ;FREE KERNAL ZERO PAGE 9/24/80
BASZPT *=*+1 ;LOCATION ($00FF) USED BY BASIC
*=$100
BAD *=*+1
*=$200
BUF *=*+89 ;BASIC/MONITOR BUFFER
; TABLES FOR OPEN FILES
;
LAT *=*+10 ;LOGICAL FILE NUMBERS
FAT *=*+10 ;PRIMARY DEVICE NUMBERS
SAT *=*+10 ;SECONDARY ADDRESSES
; SYSTEM STORAGE
;
KEYD *=*+10 ;IRQ KEYBOARD BUFFER
MEMSTR *=*+2 ;START OF MEMORY
MEMSIZ *=*+2 ;TOP OF MEMORY
TIMOUT *=*+1 ;IEEE TIMEOUT FLAG
; SCREEN EDITOR STORAGE
;
COLOR *=*+1 ;ACTIV COLOR NYBBLE
GDCOL *=*+1 ;ORIGINAL COLOR BEFORE CURSOR
HIBASE *=*+1 ;BASE LOCATION OF SCREEN (TOP)
XMAX *=*+1
RPTFLG *=*+1 ;KEY REPEAT FLAG
KOUNT *=*+1
DELAY *=*+1
SHFLAG *=*+1 ;SHIFT FLAG BYTE
LSTSHF *=*+1 ;LAST SHIFT PATTERN
KEYLOG *=*+2 ;INDIRECT FOR KEYBOARD TABLE SETUP
MODE *=*+1 ;0-PET MODE, 1-CATTACANNA
AUTODN *=*+1 ;AUTO SCROLL DOWN FLAG(=0 ON,<>0 OFF)
; RS-232 STORAGE
;
M51CTR *=*+1 ;6551 CONTROL REGISTER
M51CDR *=*+1 ;6551 COMMAND REGISTER
M51AJB *=*+2 ;NON STANDARD (BITTIME/2-100)
RSSTAT *=*+1 ; RS-232 STATUS REGISTER
BITNUM *=*+1 ;NUMBER OF BITS TO SEND (FAST RESPONSE)
BAUDOF *=*+2 ;BAUD RATE FULL BIT TIME (CREATED BY OPEN)
;
; RECIEVER STORAGE
;
; INBIT *=*+1 ;INPUT BIT STORAGE
; BITCI *=*+1 ;BIT COUNT IN
; RINONE *=*+1 ;FLAG FOR START BIT CHECK
; RIDATA *=*+1 ;BYTE IN BUFFER
; RIPRTY *=*+1 ;BYTE IN PARITY STORAGE
RIDBE *=*+1 ;INPUT BUFFER INDEX TO END
RIDBS *=*+1 ;INPUT BUFFER POINTER TO START
;
; TRANSMITTER STORAGE
;
; BITTS *=*+1 ;# OF BITS TO BE SENT
; NXTBIT *=*+1 ;NEXT BIT TO BE SENT
; ROPRTY *=*+1 ;PARITY OF BYTE SENT
; RODATA *=*+1 ;BYTE BUFFER OUT
RODBS *=*+1 ;OUTPUT BUFFER INDEX TO START
RODBE *=*+1 ;OUTPUT BUFFER INDEX TO END
;
IRQTMP *=*+2 ;HOLDS IRQ DURING TAPE OPS
;
; TEMP SPACE FOR VIC-40 VARIABLES ****
;
ENABL *=*+1 ;RS-232 ENABLES (REPLACES IER)
CASTON *=*+1 ;TOD SENSE DURING CASSETTES
KIKA26 *=*+1 ;TEMP STORAGE FOR CASSETTE READ ROUTINE
STUPID *=*+1 ;TEMP D1IRQ INDICATOR FOR CASSETTE READ
LINTMP *=*+1 ;TEMPORARY FOR LINE INDEX
*=$0300 ;REM PROGRAM INDIRECTS(10)
*=$0300+20 ;REM KERNAL/OS INDIRECTS(20)
CINV *=*+2 ;IRQ RAM VECTOR
CBINV *=*+2 ;BRK INSTR RAM VECTOR
NMINV *=*+2 ;NMI RAM VECTOR
IOPEN *=*+2 ;INDIRECTS FOR CODE
ICLOSE *=*+2 ; CONFORMS TO KERNAL SPEC 8/19/80
ICHKIN *=*+2
ICKOUT *=*+2
ICLRCH *=*+2
IBASIN *=*+2
IBSOUT *=*+2
ISTOP *=*+2
IGETIN *=*+2
ICLALL *=*+2
USRCMD *=*+2
ILOAD *=*+2
ISAVE *=*+2 ;SAVESP
*=$0300+60
TBUFFR *=*+192 ;CASSETTE DATA BUFFER
* =$400
VICSCN *=*+1024
RAMLOC
; I/O DEVICES
;
* =$D000
VICREG =* ;VIC REGISTERS
* =$D400
SIDREG =* ;SID REGISTERS
* =$D800
VICCOL *=*+1024 ;VIC COLOR NYBBLES
* =$DC00 ;DEVICE1 6526 (PAGE1 IRQ)
COLM ;KEYBOARD MATRIX
D1PRA *=*+1
ROWS ;KEYBOARD MATRIX
D1PRB *=*+1
D1DDRA *=*+1
D1DDRB *=*+1
D1T1L *=*+1
D1T1H *=*+1
D1T2L *=*+1
D1T2H *=*+1
D1TOD1 *=*+1
D1TODS *=*+1
D1TODM *=*+1
D1TODH *=*+1
D1SDR *=*+1
D1ICR *=*+1
D1CRA *=*+1
D1CRB *=*+1
* =$DD00 ;DEVICE2 6526 (PAGE2 NMI)
D2PRA *=*+1
D2PRB *=*+1
D2DDRA *=*+1
D2DDRB *=*+1
D2T1L *=*+1
D2T1H *=*+1
D2T2L *=*+1
D2T2H *=*+1
D2TOD1 *=*+1
D2TODS *=*+1
D2TODM *=*+1
D2TODH *=*+1
D2SDR *=*+1
D2ICR *=*+1
D2CRA *=*+1
D2CRB *=*+1
TIMRB =$19 ;6526 CRB ENABLE ONE-SHOT TB
;TAPE BLOCK TYPES
;
EOT =5 ;END OF TAPE
BLF =1 ;BASIC LOAD FILE
BDF =2 ;BASIC DATA FILE
PLF =3 ;FIXED PROGRAM TYPE
BDFH =4 ;BASIC DATA FILE HEADER
BUFSZ =192 ;BUFFER SIZE
;
;SCREEN EDITOR CONSTANTS
;
LLEN =40 ;SINGLE LINE 40 COLUMNS
LLEN2 =80 ;DOUBLE LINE = 80 COLUMNS
NLINES =25 ;25 ROWS ON SCREEN
WHITE =$01 ;WHITE SCREEN COLOR
BLUE =$06 ;BLUE CHAR COLOR
CR =$D ;CARRIAGE RETURN
.END
*=$E500 ;START OF VIC-40 KERNAL

.LIB EDITOR.1

MAXCHR=80
NWRAP=2 ;MAX NUMBER OF PHYSICAL LINES PER LOGICAL LINE
;
;UNDEFINED FUNCTION ENTRY
;
; UNDEFD LDX #0
; UNDEF2 LDA UNMSG,X
; JSR PRT
; INX
; CPX #UNMSG2-UNMSG
; BNE UNDEF2
; SEC
; RTS
;
; UNMSG .BYT $D,'?ADVANCED FUNCTION NOT AVAILABLE',$D
; UNMSG2
;
;RETURN ADDRESS OF 6526
;
Rücksprung

Betriebssystem

System-Meldungen

BASIC startup messages

  return

WORDS: POWER UP MESSAGE

This is the power up message displayed on the screen when
the 'Commie' is switched on or reset. The strings are
seperated by a zero byte.

startup messages

.:E45F 00 20 42 41 53 49 43 20   basic bytes free
basic bytes free
  basic bytes free
basic bytes free
.:E467 42 59 54 45 53 20 46 52            
.:E46F 45 45 0D 00 93 0D 20 20            
.:E473 93 0D 20 20 20 20 2A 2A   (clr) **** commodore 64 basic v2 ****
(clr) **** commodore 64 basic v2 ****
  (clr) **** commodore 64 basic v2 ****
(clr) **** commodore 64 basic v2 ****
.:E47B 2A 2A 20 43 4F 4D 4D 4F   (cr) (cr) 64k ram system
(cr) (cr) 64k ram system
  (cr) (cr) 64k ram system
(cr) (cr) 64k ram system
.:E483 44 4F 52 45 20 36 34 20            
.:E48B 42 41 53 49 43 20 56 32            
.:E493 20 2A 2A 2A 2A 0D 0D 20            
.:E49B 36 34 4B 20 52 41 4D 20            
.:E4A3 53 59 53 54 45 4D 20 20            
.:E4AB 00    

unused

     
.:E4AC 5C  

BASIC-CKOUT Routine

open channel for output

 

PATCH FOR BASIC CHKOUT CALL

This is a short patch added for the KERNAL ROM to preserv
(A) when there was no error returned from BASIC calling
the CHKOUT routine. This corrects a bug in the early
versions of PRINT# and CMD.

set output device

.,E4AD 48 PHA   Akkuinhalt in Stack
save the flag byte
  temp store (A)
 
.,E4AE 20 C9 FF JSR $FFC9   CKOUT Ausgabegerät setzen
open channel for output
  CHKOUT
 
.,E4B1 AA TAX   Fehlernummer nach X
copy the returned flag byte
     
.,E4B2 68 PLA   Akkuinhalt zurückholen
restore the alling flag byte
  retrieve (A)
 
.,E4B3 90 01 BCC $E4B6   kein Fehler ?
if there is no error skip copying the error flag
     
.,E4B5 8A TXA   Fehlernummer wieder in Akku
else copy the error flag
     
.,E4B6 60 RTS   Rücksprung

unused bytes

   

unused

.:E4B7 AA AA AA AA AA AA AA AA            
.:E4BF AA AA AA AA AA AA AA AA            
.:E4C7 AA AA AA AA AA AA AA AA            
.:E4CF AA AA AA AA AA AA AA AA    

flag the RS232 start bit and set the parity

 

RS232 PATCH

This patch has been added to the RS232 input routine in
KERNAL v.3. It initialises the RS232 parity byte, RIPRTY,
on reception of a start bit.
 
.:E4D7 AA AA AA  

Hintergrundfarbe setzen

save the start bit check flag, set start bit received
set the initial parity state
save the receiver parity bit
  RINONE, check for start bit
RIPRTY, RS232 input parity
 
.,E4DA AD 21 D0 LDA $D021   Farbe holen

save the current colour to the colour RAM

get the current colour code
 

RESET CHARACTER COLOUR

This routine is a patch in KERNAL version 3 to fix a bug
with the colour code. The routine is called by 'clear a
screen line', and sets the character colour to COLOR.
get COLOR

clear byte in color ram

.,E4DD 91 F3 STA ($F3),Y   ins Farbram schreiben
save it to the colour RAM
  and store in current screen position
 
.,E4DF 60 RTS   Rücksprung

wartet auf Commodore-Taste

wait ~8.5 seconds for any key from the STOP key column

 

PAUSE AFTER FINDING TAPE FILE

This routine continues tape loading without pressing C=
when a file was found.

pause after finding a file on casette

.,E4E0 69 02 ADC #$02   2*256/60 = 8.5 Sekunden
warten
set the number of jiffies to wait
     
.,E4E2 A4 91 LDY $91   Flag testen
read the stop key column
     
.,E4E4 C8 INY   und erhöhen
test for $FF, no keys pressed
     
.,E4E5 D0 04 BNE $E4EB   Taste gedrückt ?
if any keys were pressed just exit
     
.,E4E7 C5 A1 CMP $A1   Zeit noch nicht um ?,
compare the wait time with the jiffy clock mid byte
     
.,E4E9 D0 F7 BNE $E4E2   dann warten
if not there yet go wait some more
     
.,E4EB 60 RTS   Rücksprung

Timerkonstanten für RS 232

Baud Rate, PAL-Version

baud rate tables for PAL C64

baud rate word is calculated from ..
(system clock / baud rate) / 2 - 100
system clock
------------
PAL 985248 Hz
NTSC 1022727 Hz
 

RS232 TIMING TABLE - PAL

Timingtable for RS232 NMI for use with PAL machines. This
table contains the prescaler values for setting up the
RS232 baudrates. The table containe 10 entries which
corresponds to one of the fixed RS232 rates, starting with
lowest (50 baud) and finishing with the highest (2400
baud). Since the clock frequency is different between NTSC
and PAL systems, there is another table for NTSC machines
at $fec2.

baud rate factor table

.:E4EC 19 26   $2619 = 9753 50 Baud
50 baud 985300
  50 baud
50
.:E4EE 44 19   $1944 = 6468 75 Baud
75 baud 985200
  75 baud
75
.:E4F0 1A 11   $111A = 4378 110 Baud
110 baud 985160
  110 baud
110
.:E4F2 E8 0D   $0DE8 = 3560 134.5 Baud
134.5 baud 984540
  134.5 baud
134.5
.:E4F4 70 0C   $0C70 = 3184 150 Baud
150 baud 985200
  150 baud
150
.:E4F6 06 06   $0606 = 1542 300 Baud
300 baud 985200
  300 baud
300
.:E4F8 D1 02   $02D1 = 736 600 Baud
600 baud 985200
  600 baud
600
.:E4FA 37 01   $0137 = 311 1200 Baud
1200 baud 986400
  1200 baud
1200
.:E4FC AE 00   $00AE = 174 1800 Baud
1800 baud 986400
  (1800) 2400 baud
1800
.:E4FE 69 00   $0069 = 105 2400 Baud

Basis-Adresse des CIAs holen

2400 baud 984000

return the base address of the I/O devices

  2400 baud

IOBASE: GET I/O ADDRESS

The KERNAL routine IOBASE ($fff3) jumps to this routine.
It returns the base address $dc00 in (X/Y)
2400

read base address of I/O device into XY

.,E500 A2 00 LDX #$00 IOBASE LDX #<D1PRA
Adresse
get the I/O base address low byte
  set (X/Y) to $dc00
low DC00
.,E502 A0 DC LDY #$DC LDY #>D1PRA
$DC00
get the I/O base address high byte
    high DC00
.,E504 60 RTS RTS
;
;RETURN MAX ROWS,COLS OF SCREEN
;
Rücksprung

holt Anzahl der Zeilen und

Spalten

return the x,y organization of the screen

 

SCREEN: GET SCREEN SIZE

The KERNAL routine SCREEN ($ffed) jumps to this routine.
It returns the screen size; columns in (X) and rows in
(Y).

read screen size

.,E505 A2 28 LDX #$28 SCRORG LDX #LLEN
40 Spalten
get the x size
  40 columns
40 columns
.,E507 A0 19 LDY #$19 LDY #NLINES
25 Zeilen
get the y size
  25 rows
25 rows
.,E509 60 RTS RTS
;
;READ/PLOT CURSOR POSITION
;
Rücksprung

Cursor setzen (C=0) / holen

(C=1)

read/set the x,y cursor position

 

PLOT: PUT/GET ROW AND COLUMN

The KERNAL routine PLOT ($fff0) jumps to this routine. The
option taken depends on the state of carry on entry. If it
is set, the column is placed in (Y) and the row placed in
(X). If carry is clear, the cursor position is read from
(X/Y) and the screen pointers are set.

read/set XY cursor position

.,E50A B0 07 BCS $E513 PLOT BCS PLOT10
Carry gesetzt, dann zu $E513
if read cursor go do read
  if carry set, jump
 
.,E50C 86 D6 STX $D6 STX TBLX
Zeile
save the cursor row
  store TBLX, current row
 
.,E50E 84 D3 STY $D3 STY PNTR
Spalte
save the cursor column
  store PNTR, current column
 
.,E510 20 6C E5 JSR $E56C JSR STUPT
Cursor setzen
set the screen pointers for the cursor row, column
  set screen pointers
 
.,E513 A6 D6 LDX $D6 PLOT10 LDX TBLX
Zeile
get the cursor row
  read TBLX
 
.,E515 A4 D3 LDY $D3 LDY PNTR
Spalte
get the cursor column
  read PNTR
 
.,E517 60 RTS RTS
;INITIALIZE I/O
;
CINT
;
; ESTABLISH SCREEN MEMORY
;
Rücksprung

Bildschirm Reset

initialise the screen and keyboard

 

CINT1: INITIALISE I/O

This routine is part of the KERNAL CINT init routine. I/O
default values are set, <shift+cbm> keys are disabled, and
cursor is switched off. The vector to the keyboard table
is set up, and the length of the keyboardbuffer is set to
10 characters. The cursor color is set to lightblue, and
the key-repeat parameters are set up.

initialise screen and keyboard

.,E518 20 A0 E5 JSR $E5A0 JSR PANIC ;SET UP VIC
;
Videocontroller
initialisieren
initialise the vic chip
  set I/O defaults
 
.,E51B A9 00 LDA #$00 LDA #0 ;MAKE SURE WE'RE IN PET MODE
Shift-
clear A
     
.,E51D 8D 91 02 STA $0291 STA MODE
Commodore ermöglichen
clear the shift mode switch
  disable <SHIFT + CBM> by writing zero into MODE
 
.,E520 85 CF STA $CF STA BLNON ;WE DONT HAVE A GOOD CHAR FROM THE SCREEN YET
Cursor nicht in Blinkphase
clear the cursor blink phase
  the cursor blink flag, set BLNON on
 
.,E522 A9 48 LDA #$48 LDA #<SHFLOG ;SET SHIFT LOGIC INDIRECTS
Adresse
get the keyboard decode logic pointer low byte
    low EB48
.,E524 8D 8F 02 STA $028F STA KEYLOG
($028F) = $EB48
save the keyboard decode logic pointer low byte
     
.,E527 A9 EB LDA #$EB LDA #>SHFLOG
setzen
get the keyboard decode logic pointer high byte
  set the KEYLOG vector to point at $eb48
high EB48
.,E529 8D 90 02 STA $0290 STA KEYLOG+1
= Zeiger auf Adressen für
Tastaturdekodierung
save the keyboard decode logic pointer high byte
     
.,E52C A9 0A LDA #$0A LDA #10
10
set the maximum size of the keyboard buffer
  set max number of character is keyboard buffer to 10
 
.,E52E 8D 89 02 STA $0289 STA XMAX ;MAXIMUM TYPE AHEAD BUFFER SIZE
max. Länge des
Tastaturpuffers
save the maximum size of the keyboard buffer
  XMAX
 
.,E531 8D 8C 02 STA $028C STA DELAY
Zähler für
Repeat-Geschwindigkeit
save the repeat delay counter
  How many 1/60 of a second to wait before key is repeated.
Used togeather with $028b
 
.,E534 A9 0E LDA #$0E LDA #$E ;INIT COLOR TO LIGHT BLUE<<<<<<<<<<
hellblau
set light blue
  set character colour to light blue
 
.,E536 8D 86 02 STA $0286 STA COLOR
Augenblickliche Farbe
save the current colour code
  COLOR
 
.,E539 A9 04 LDA #$04 LDA #4
Repeat-
speed 4
  How many $028c before a new entry is
 
.,E53B 8D 8B 02 STA $028B STA KOUNT ;DELAY BETWEEN KEY REPEATS
Geschwindigkeit
save the repeat speed counter
  put in the keyboard buffer, KOUNT
 
.,E53E A9 0C LDA #$0C LDA #$C
Cursor
set the cursor flash timing
     
.,E540 85 CD STA $CD STA BLNCT
Blinkzeit
save the cursor timing countdown
  store in BLCNT, cursor toggle timer
 
.,E542 85 CC STA $CC STA BLNSW
Cursor Blinkflag

Bildschirm löschen

save the cursor enable, $00 = flash cursor

clear the screen

  store in BLNSW, cursor enable

CLEAR SCREEN

This routine sets up the screen line link table ($d9 -
$f2), LDTB1, which is used to point out the address to the
screen. The later part of the routine performs the screen
clear, line by line, starting at the bottom line. It
continues to the next routine which is used to home the
cursor.
 
.,E544 AD 88 02 LDA $0288 CLSR LDA HIBASE ;FILL HI BYTE PTR TABLE
Speicherseite für
Bildschirm-RAM
get the screen memory page
  get HIBASE, top of screen memory
 
.,E547 09 80 ORA #$80 ORA #$80
Adressen
set the high bit, flag every line is a logical line start
  fool around
 
.,E549 A8 TAY TAY
der
copy to Y
     
.,E54A A9 00 LDA #$00 LDA #0
Bild-
clear the line start low byte
     
.,E54C AA TAX TAX
schirm-
clear the index
     
.,E54D 94 D9 STY $D9,X LPS1 STY LDTB1,X
zeilen
save the start of line X pointer high byte
  store in screen line link table, LDTB1
 
.,E54F 18 CLC CLC
40 addieren
clear carry for add
     
.,E550 69 28 ADC #$28 ADC #LLEN
(eine Zeile)
add the line length to the low byte
  add #40 to next line
 
.,E552 90 01 BCC $E555 BCC LPS2
kein Übertrag, dann
HIGH-Byte nicht erhöhen
if no rollover skip the high byte increment
     
.,E554 C8 INY INY ;CARRY BUMP HI BYTE
HIGH-Byte erhöhen
else increment the high byte
  inc page number
 
.,E555 E8 INX LPS2 INX
LOW-Byte erhöhen
increment the line index
  next
 
.,E556 E0 1A CPX #$1A CPX #NLINES+1 ;DONE # OF LINES?
26, alle Zeilen ?
compare it with the number of lines + 1
  till all 26?? is done
 
.,E558 D0 F3 BNE $E54D BNE LPS1 ;NO...
nein, dann weiter
loop if not all done
     
.,E55A A9 FF LDA #$FF LDA #$FF ;TAG END OF LINE TABLE
Kennzeichnung der
set the end of table marker
     
.,E55C 95 D9 STA $D9,X STA LDTB1,X
26, Zeile
mark the end of the table
  last pointer is $ff
 
.,E55E A2 18 LDX #$18 LDX #NLINES-1 ;CLEAR FROM THE BOTTOM LINE UP
24, Anzahl der Zeilen minus 1
set the line count, 25 lines to do, 0 to 24
  start clear screen with line $18 (bottom line)
 
.,E560 20 FF E9 JSR $E9FF CLEAR1 JSR CLRLN ;SEE SCROLL ROUTINES
Bildschirmzeile löschen
clear screen line X
  erase line (X)
 
.,E563 CA DEX DEX
Zähler erniedrigen
decrement the count
  next
 
.,E564 10 FA BPL $E560 BPL CLEAR1
;HOME FUNCTION
;
schon alle?

Cursor Home

loop if more to do

home the cursor

  till screen is empty

HOME CURSOR

This routine puts the cursor in the top left corner by
writing its column and line to zero.
 
.,E566 A0 00 LDY #$00 NXTD LDY #0
Löschen der
clear Y
     
.,E568 84 D3 STY $D3 STY PNTR ;LEFT COLUMN
Cursorspalte und
clear the cursor column
  write to PNTR, cursor column
 
.,E56A 84 D6 STY $D6 STY TBLX ;TOP LINE
;
;MOVE CURSOR TO TBLX,PNTR
;
STUPT
Cursorzeile

Cursorpos. berechnen,

Bildschirmzeiger setzen

clear the cursor row

set screen pointers for cursor row, column

  write to TBLX, line number

SET SCREEN POINTERS

This routine positions the cursor on the screen and sets
up the screen pointers. On entry, TBLX must hold the line
number, and PNTR the column number of the cursor position.

set address of curent screen line

.,E56C A6 D6 LDX $D6 LDX TBLX ;GET CURENT LINE INDEX
Cursorzeile
get the cursor row
  read TBLX
 
.,E56E A5 D3 LDA $D3 LDA PNTR ;GET CHARACTER POINTER
Cursorspalte
get the cursor column
  read PNTR
 
.,E570 B4 D9 LDY $D9,X FNDSTR LDY LDTB1,X ;FIND BEGINING OF LINE
HIGH-Bytes für Doppelzeilen
get start of line X pointer high byte
  read value from screen line link table, LDTB1
 
.,E572 30 08 BMI $E57C BMI STOK ;BRANCH IF START FOUND
einfache Zeile, dann zu $E57C
if it is the logical line start continue
  heavy calcuations??? jump when ready
 
.,E574 18 CLC CLC
Spalte
else clear carry for add
     
.,E575 69 28 ADC #$28 ADC #LLEN ;ADJUST POINTER
+40
add one line length
     
.,E577 85 D3 STA $D3 STA PNTR
und speichern
save the cursor column
  PNTR
 
.,E579 CA DEX DEX
nächste Zeile
decrement the cursor row
     
.,E57A 10 F4 BPL $E570 BPL FNDSTR
;
schon alle?
loop, branch always
     
.,E57C 20 F0 E9 JSR $E9F0 STOK JSR SETPNT ;SET UP PNT INDIRECT 901227-03**********
;
Zeiger auf Video-RAM setzen
fetch a screen address
  set start of line (X)
 
.,E57F A9 27 LDA #$27 LDA #LLEN-1
39 Spalten
set the line length
     
.,E581 E8 INX INX
Zeiger auf Bildschirmtabelle
erhöhen
increment the cursor row
     
.,E582 B4 D9 LDY $D9,X FNDEND LDY LDTB1,X
HIGH-Byte Startadresse der
Zeile in Y-REG schreiben
get the start of line X pointer high byte
  LDTB1
 
.,E584 30 06 BMI $E58C BMI STDONE
Verzweige falls größer,
gleich 128
if logical line start exit
     
.,E586 18 CLC CLC
Cursor eine Zeile
else clear carry for add
     
.,E587 69 28 ADC #$28 ADC #LLEN
tiefer setzen (+40 Spalten)
add one line length to the current line length
     
.,E589 E8 INX INX
Zeiger auf Bildschirmtabelle
erhöhen
increment the cursor row
     
.,E58A 10 F6 BPL $E582 BPL FNDEND
STDONE
unbedingter Sprung
loop, branch always
     
.,E58C 85 D5 STA $D5 STA LNMX
Zeilenlänge speichern
save current screen line length
  store in LMNX, physical screen line length
 
.,E58E 4C 24 EA JMP $EA24 JMP SCOLOR ;MAKE COLOR POINTER FOLLOW 901227-03**********
; THIS IS A PATCH FOR INPUT LOGIC 901227-03**********
; FIXES INPUT"XXXXXXX-40-XXXXX";A$ PROBLEM
;
Zeiger auf Farb-RAM berechnen
Rücksprung
calculate the pointer to colour RAM and return
  sync color pointer
 
.,E591 E4 C9 CPX $C9 FINPUT CPX LSXP ;CHECK IF ON SAME LINE
wenn Cursorzeile
compare it with the input cursor row
  read LXSP, chech cursor at start of input
 
.,E593 F0 03 BEQ $E598 BEQ FINPUX ;YES..RETURN TO SEND
gleich null, dann Rücksprung
if there just exit
     
.,E595 4C ED E6 JMP $E6ED JMP FINDST ;CHECK IF WE WRAPPED DOWN...
Adresse für zugehörige
Zeilennummer nach $D1/$D2
else go ??
  retreat cursor
 
.,E598 60 RTS FINPUX RTS
Rücksprung

orphan bytes ??

     
.,E599 EA NOP NOP ;KEEP THE SPACE THE SAME...
;PANIC NMI ENTRY
;
no operation
huh
  A free byte!!!

SET I/O DEFAULTS

The default output device is set to 3 (screen), and the
default input device is set to 0 (keyboard). The VIC chip
registers are set from the video chip setup table. The
cursor is then set to the home position.

this code is unused by kernel

since no other part of the
rom jumps to this location!
.,E59A 20 A0 E5 JSR $E5A0 VPAN JSR PANIC ;FIX VIC SCREEN
Videocontroller
initialisieren
initialise the vic chip
  set I/O defaults
 
.,E59D 4C 66 E5 JMP $E566 JMP NXTD ;HOME CURSOR
Cursor Home

Videocontroller

initialisieren

home the cursor and return

initialise the vic chip

  home cursor and exit routine

initialise vic chip

.,E5A0 A9 03 LDA #$03 PANIC LDA #3 ;RESET DEFAULT I/O
Ausgabe auf
set the screen as the output device
     
.,E5A2 85 9A STA $9A STA DFLTO
Bildschirm
save the output device number
  DFLTO, default output device - screen
 
.,E5A4 A9 00 LDA #$00 LDA #0
Eingabe von
set the keyboard as the input device
     
.,E5A6 85 99 STA $99 STA DFLTN
;INIT VIC
;
Tastatur
save the input device number
  DFLTN, default input device - keyboard
 
.,E5A8 A2 2F LDX #$2F INITV LDX #47 ;LOAD ALL VIC REGS ***
47
set the count/index
     
.,E5AA BD B8 EC LDA $ECB8,X PX4 LDA TVIC-1,X
Konstanten
get a vic ii chip initialisation value
  VIC chip setup table
 
.,E5AD 9D FF CF STA $CFFF,X STA VICREG-1,X
in Videokontroller schreiben
save it to the vic ii chip
  VIC chip I/O registers
 
.,E5B0 CA DEX DEX
Zähler erniedrigen
decrement the count/index
  next
 
.,E5B1 D0 F7 BNE $E5AA BNE PX4
schon alle?
loop if more to do
  till ready
 
.,E5B3 60 RTS RTS
;
;REMOVE CHARACTER FROM QUEUE
;
Rücksprung

Zeichen aus Tastaturpuffer

holen

input from the keyboard buffer

 

LP2: GET CHARACTER FROM KEYBOARD BUFFER

It is assumed that there is at leaset one character in the
keyboard buffer. This character is obtained and the rest
of the queue is moved up one by one to overwrite it. On
exit, the character is in (A).

get character from keyboard buffer

.,E5B4 AC 77 02 LDY $0277 LP2 LDY KEYD
erstes Zeichen holen
get the current character from the buffer
  read KEYD, first character in keyboard buffer queue
 
.,E5B7 A2 00 LDX #$00 LDX #0
Zähler auf Null
clear the index
     
.,E5B9 BD 78 02 LDA $0278,X LP1 LDA KEYD+1,X
Puffer nach
get the next character,X from the buffer
  overwrite with next in queue
 
.,E5BC 9D 77 02 STA $0277,X STA KEYD,X
vorne aufrücken
save it as the current character,X in the buffer
     
.,E5BF E8 INX INX
Zähler erhöhen
increment the index
     
.,E5C0 E4 C6 CPX $C6 CPX NDX
mit Anzahl der
compare it with the keyboard buffer index
  compare with NDX, number of characters in queue
 
.,E5C2 D0 F5 BNE $E5B9 BNE LP1
Zeichen vergleichen
loop if more to do
  till all characters are moved
 
.,E5C4 C6 C6 DEC $C6 DEC NDX
Zeichenzahl erniedrigen
decrement keyboard buffer index
  decrement NDX
 
.,E5C6 98 TYA TYA
Zeichen in Akku holen
copy the key to A
  transfer read character to (A)
 
.,E5C7 58 CLI CLI
Interrupt freigeben
enable the interrupts
  enable interrupt
 
.,E5C8 18 CLC CLC ;GOOD RETURN
Carry löschen
flag got byte
     
.,E5C9 60 RTS RTS
;
Rücksprung

Warteschleife für

Tastatureingabe

write character and wait for key

 

INPUT FROM KEYBOARD

This routine uses the previous routine to get characters
from the keyboard buffer. Each character is output to the
screen, unless it is <shift/RUN>. If so, the contents of
the keyboard buffer is replaced with LOAD <CR> RUN <CR>.
The routine ends when a carriage routine is encountered.

wait for return for keyboard

.,E5CA 20 16 E7 JSR $E716 LOOP4 JSR PRT
LOOP3
Zeichen auf Bildschirm
ausgeben
output character

wait for a key from the keyboard

  output to screen
 
.,E5CD A5 C6 LDA $C6 LDA NDX
Anzahl der
get the keyboard buffer index
  read NDX, number of characters in keyboard queue
 
.,E5CF 85 CC STA $CC STA BLNSW
gedrückten
cursor enable, $00 = flash cursor, $xx = no flash
  BLNSW, cursor blink enable
 
.,E5D1 8D 92 02 STA $0292 STA AUTODN ;TURN ON AUTO SCROLL DOWN
Tasten
screen scrolling flag, $00 = scroll, $xx = no scroll
this disables both the cursor flash and the screen scroll
while there are characters in the keyboard buffer
  AUTODN, auto scroll down flag
 
.,E5D4 F0 F7 BEQ $E5CD BEQ LOOP3
keine Taste gedrückt ?,
dann warten
loop if the buffer is empty
  loop till key is pressed
 
.,E5D6 78 SEI SEI
Interrupt verhindern
disable the interrupts
  disable interrupt
 
.,E5D7 A5 CF LDA $CF LDA BLNON
Cursor in Blink-Phase ?
get the cursor blink phase
  BLNON, last cursor blink (on/off)
 
.,E5D9 F0 0C BEQ $E5E7 BEQ LP21
nein
if cursor phase skip the overwrite
else it is the character phase
     
.,E5DB A5 CE LDA $CE LDA GDBLN
Zeichen unter dem Cursor
get the character under the cursor
  GDBLN, character under cursor
 
.,E5DD AE 87 02 LDX $0287 LDX GDCOL ;RESTORE ORIGINAL COLOR
Farbe unter dem Cursor
get the colour under the cursor
  GDCOL, background color under cursor
 
.,E5E0 A0 00 LDY #$00 LDY #0
Cursor nicht
clear Y
     
.,E5E2 84 CF STY $CF STY BLNON
in Blinkphase
clear the cursor blink phase
  clear BLNON
 
.,E5E4 20 13 EA JSR $EA13 JSR DSPP
Zeichen und Farbe setzen
print character A and colour X
  print to screen
 
.,E5E7 20 B4 E5 JSR $E5B4 LP21 JSR LP2
Zeichen aus Tastaturpuffer
holen
input from the keyboard buffer
  Get character from keyboard buffer
 
.,E5EA C9 83 CMP #$83 CMP #$83 ;RUN KEY?
Kode für
compare with [SHIFT][RUN]
  test if <shift/RUN> is pressed
 
.,E5EC D0 10 BNE $E5FE BNE LP22
'SHIFT RUN' ?
if not [SHIFT][RUN] skip the buffer fill
keys are [SHIFT][RUN] so put "LOAD",$0D,"RUN",$0D into
the buffer
  nope
 
.,E5EE A2 09 LDX #$09 LDX #9
9 Zeichen
set the byte count
  transfer 'LOAD <CR> RUN <CR>' to keyboard buffer
 
.,E5F0 78 SEI SEI
Interrupt verhindern
disable the interrupts
     
.,E5F1 86 C6 STX $C6 STX NDX
Zeichenzahl merken
set the keyboard buffer index
  store #9 in NDX, characters in buffer
 
.,E5F3 BD E6 EC LDA $ECE6,X LP23 LDA RUNTB-1,X
'LOAD (cr) RUN (cr)'
get byte from the auto load/run table
  'LOAD <CR> RUN <CR>' message in ROM
 
.,E5F6 9D 76 02 STA $0276,X STA KEYD-1,X
in Tastaturpuffer holen
save it to the keyboard buffer
  store in keyboard buffer
 
.,E5F9 CA DEX DEX
nächstes Zeichen
decrement the count/index
     
.,E5FA D0 F7 BNE $E5F3 BNE LP23
schon alle ?
loop while more to do
  all nine characters
 
.,E5FC F0 CF BEQ $E5CD BEQ LOOP3
und auswerten
loop for the next key, branch always
was not [SHIFT][RUN]
  allways jump
 
.,E5FE C9 0D CMP #$0D LP22 CMP #$D
'CR'
compare the key with [CR]
  carriage return pressed?
 
.,E600 D0 C8 BNE $E5CA BNE LOOP4
nein ?, dann zurück zur
Warteschleife
if not [CR] print the character and get the next key
else it was [CR]
  nope, go to start
 
.,E602 A4 D5 LDY $D5 LDY LNMX
Länge der Bildschirmzeile
get the current screen line length
  get LNMX, screen line length
 
.,E604 84 D0 STY $D0 STY CRSW
CR-Flag setzen
input from keyboard or screen, $xx = screen,
$00 = keyboard
  CRSV, flag input/get from keyboard
 
.,E606 B1 D1 LDA ($D1),Y CLP5 LDA (PNT)Y
Zeichen vom Bildschirm holen
get the character from the current screen line
  PNT, screen address
 
.,E608 C9 20 CMP #$20 CMP #'
Leerzeichen
compare it with [SPACE]
  space?
 
.,E60A D0 03 BNE $E60F BNE CLP6
am Ende
if not [SPACE] continue
  nope
 
.,E60C 88 DEY DEY
der
else eliminate the space, decrement end of input line
     
.,E60D D0 F7 BNE $E606 BNE CLP5
Zeile
loop, branch always
  next
 
.,E60F C8 INY CLP6 INY
eliminieren
increment past the last non space character on line
     
.,E610 84 C8 STY $C8 STY INDX
Position als Index merken
save the input [EOL] pointer
  store in INDX, end of logical line for input
 
.,E612 A0 00 LDY #$00 LDY #0
Cursorspalte
clear A
     
.,E614 8C 92 02 STY $0292 STY AUTODN ;TURN OFF AUTO SCROLL DOWN
gleich Null
clear the screen scrolling flag, $00 = scroll
  AUTODN
 
.,E617 84 D3 STY $D3 STY PNTR
Cursorposition auf Null
clear the cursor column
  PNTR, cursor column
 
.,E619 84 D4 STY $D4 STY QTSW
Hochkommaflag löschen
clear the cursor quote flag, $xx = quote, $00 = no quote
  QTSW, reset quoute mode
 
.,E61B A5 C9 LDA $C9 LDA LSXP
wenn Cursorzeile schon durch
get the input cursor row
  LXSP, corsor X/Y position
 
.,E61D 30 1B BMI $E63A BMI LOP5
scrollen verschwunden, dann
zu $E63A
       
.,E61F A6 D6 LDX $D6 LDX TBLX
Cursorzeile
get the cursor row
  TBLX, cursor line number
 
.,E621 20 ED E6 JSR $E6ED JSR FINDST ;FIND 1ST PHYSICAL LINE
Adresse für Startzeile setzen
find and set the pointers for the start of logical line
  retreat cursor
 
.,E624 E4 C9 CPX $C9 CPX LSXP
Fehler bei Eingabe ?,
compare with input cursor row
  LXSP
 
.,E626 D0 12 BNE $E63A BNE LOP5
dann nochmal lesen
       
.,E628 A5 CA LDA $CA LDA LSTP
letzte Spalte
get the input cursor column
     
.,E62A 85 D3 STA $D3 STA PNTR
in Spaltenzeiger bringen
save the cursor column
  PNTR
 
.,E62C C5 C8 CMP $C8 CMP INDX
mit Index vergleichen
compare the cursor column with input [EOL] pointer
  INDX
 
.,E62E 90 0A BCC $E63A BCC LOP5
wenn kleiner, dann Zeile
auswerten
if less, cursor is in line, go ??
     
.,E630 B0 2B BCS $E65D BCS CLP2
;INPUT A LINE UNTIL CARRIAGE RETURN
;
wenn größer oder gleich, dann
keine Eingabe

Ein Zeichen vom Bildschirm

holen

else the cursor is beyond the line end, branch always

input from screen or keyboard

 

INPUT FROM SCREEN OR KEYBOARD

This routine is used by INPUT to input data from devices
not on the serial bus, ie. from screen or keyboard. On
entry (X) and (Y) registers are preserved. A test is made
to determine which device the input is to be from. If it
is the screen, then quotes and <RVS> are tested for and
the character is echoed on the screen. Keyboard inputs
make use of the previous routine.

get character from device 0 or 3

.,E632 98 TYA LOOP5 TYA
die
copy Y
  preserve (X) and (Y) registers
 
.,E633 48 PHA PHA
Re-
save Y
     
.,E634 8A TXA TXA
gister
copy X
     
.,E635 48 PHA PHA
retten
save X
     
.,E636 A5 D0 LDA $D0 LDA CRSW
CR-Flag
input from keyboard or screen, $xx = screen,
$00 = keyboard
  CRSW, INPUT/GET from keyboard or screen
 
.,E638 F0 93 BEQ $E5CD BEQ LOOP3
nein, dann zur Warteschleife
if keyboard go wait for key
  input from keyboard

get character from current screen line

.,E63A A4 D3 LDY $D3 LOP5 LDY PNTR
Spalte
get the cursor column
  PNTR, cursor column
 
.,E63C B1 D1 LDA ($D1),Y LDA (PNT)Y
NOTONE
Zeichen vom Bildschirm holen
get character from the current screen line
  read from current screen address
 
.,E63E 85 D7 STA $D7 STA DATA
und
save temporary last character
  temp store
 
.,E640 29 3F AND #$3F LOP51 AND #$3F
nach
mask key bits
     
.,E642 06 D7 ASL $D7 ASL DATA
ASCII
<< temporary last character
     
.,E644 24 D7 BIT $D7 BIT DATA
wandeln
test it
     
.,E646 10 02 BPL $E64A BPL LOP54
wenn Bit 6 nicht gesetzt,
dann zu $E64A
branch if not [NO KEY]
     
.,E648 09 80 ORA #$80 ORA #$80
Bit 7 setzen
       
.,E64A 90 04 BCC $E650 LOP54 BCC LOP52
Zeichen nicht revers ?, dann
zu $E650
       
.,E64C A6 D4 LDX $D4 LDX QTSW
Hochkommaflag nicht
get the cursor quote flag, $xx = quote, $00 = no quote
  QTSW, editor in quotes mode
 
.,E64E D0 04 BNE $E654 BNE LOP53
gesetzt ?, dann zu $E654
if in quote mode go ??
  yepp
 
.,E650 70 02 BVS $E654 LOP52 BVS LOP53
wenn ja, dann zu $E654
       
.,E652 09 40 ORA #$40 ORA #$40
Bit 6 im Zeichen setzen
       
.,E654 E6 D3 INC $D3 LOP53 INC PNTR
Cursor eins weiter setzen
increment the cursor column
  PNTR
 
.,E656 20 84 E6 JSR $E684 JSR QTSWC
auf Hochkomma testen
if open quote toggle the cursor quote flag
  do quotes test
 
.,E659 C4 C8 CPY $C8 CPY INDX
Cursor in letzter Spalte ?
compare ?? with input [EOL] pointer
  INDX, end of logical line for input
 
.,E65B D0 17 BNE $E674 BNE CLP1
wenn nicht, dann zu $E674
if not at line end go ??
     
.,E65D A9 00 LDA #$00 CLP2 LDA #0
Zeile
clear A
     
.,E65F 85 D0 STA $D0 STA CRSW
vollständig gelesen
clear input from keyboard or screen, $xx = screen,
$00 = keyboard
  CRSW
 
.,E661 A9 0D LDA #$0D LDA #$D
'CR'
set character [CR]
     
.,E663 A6 99 LDX $99 LDX DFLTN ;FIX GETS FROM SCREEN
ans Ende der Zeile setzen
get the input device number
  DFLTN, default input device
 
.,E665 E0 03 CPX #$03 CPX #3 ;IS IT THE SCREEN?
Eingabe vom Bildschirm ?
compare the input device with the screen
  screen
 
.,E667 F0 06 BEQ $E66F BEQ CLP2A
ja, dann zu $E66F
if screen go ??
  yes
 
.,E669 A6 9A LDX $9A LDX DFLTO
Ausgabe auf Bildschirm
get the output device number
  DFLTO, default output device
 
.,E66B E0 03 CPX #$03 CPX #3
ja, dann
compare the output device with the screen
  screen
 
.,E66D F0 03 BEQ $E672 BEQ CLP21
zu $E672
if screen go ??
  yes
 
.,E66F 20 16 E7 JSR $E716 CLP2A JSR PRT
Zeichen auf Bildschirm
schreiben
output the character
  output to screen
 
.,E672 A9 0D LDA #$0D CLP21 LDA #$D
Wert für
set character [CR]
     
.,E674 85 D7 STA $D7 CLP1 STA DATA
'CR'
save character
     
.,E676 68 PLA PLA
die
pull X
     
.,E677 AA TAX TAX
Register
restore X
  restore (X) and (Y) registers
 
.,E678 68 PLA PLA
zürück-
pull Y
     
.,E679 A8 TAY TAY
holen
restore Y
     
.,E67A A5 D7 LDA $D7 LDA DATA
Bildschirm-Kode
restore character
     
.,E67C C9 DE CMP #$DE CMP #$DE ;IS IT <PI> ?
mit Kode für Pi vergleichen
      screen PI code
.,E67E D0 02 BNE $E682 BNE CLP7
nein ?, dann fertig
       
.,E680 A9 FF LDA #$FF LDA #$FF
ja ?, durch BASIC-Kode
für Pi ersetzen
      petscii PI code
.,E682 18 CLC CLP7 CLC
Carry löschen
flag ok
     
.,E683 60 RTS RTS
Rücksprung

auf Hochkomma testen

if open quote toggle cursor quote flag

 

QUOTES TSET

On entry, (A) holds the character to be tested. If (A)
holds ASCII quotes, then the quotes flag is toggled.

check for quote mark and set flag

.,E684 C9 22 CMP #$22 QTSWC CMP #$22
'"' ?
comapre byte with "
  ASCII quotes (")
quote mark
.,E686 D0 08 BNE $E690 BNE QTSWL
nein ?, dann fertig
exit if not "
  nope, return
 
.,E688 A5 D4 LDA $D4 LDA QTSW
Hochkomma-
get cursor quote flag, $xx = quote, $00 = no quote
  QTSW, quotes mode flag
 
.,E68A 49 01 EOR #$01 EOR #$1
Flag
toggle it
  toggle on/off
 
.,E68C 85 D4 STA $D4 STA QTSW
umdrehen
save cursor quote flag
  store
 
.,E68E A9 22 LDA #$22 LDA #$22
Hochkomma-Code wieder-
herstellen
restore the "
  restore (A) to #$22
quote mark
.,E690 60 RTS QTSWL RTS
Rücksprung

Zeichen auf Bildschirm

ausgeben

insert uppercase/graphic character

 

SET UP SCREEN PRINT

The RVS flag is tested to see if reversed characters are
to be printed. If insert mode is on, the insert counter is
decremented by one. When in insert mode, all characters
will be displayd, ie. DEL RVS etc. The character colour is
placed in (X) and the character is printed to the scrren
and the cursor advanced.

fill screen at current position

.,E691 09 40 ORA #$40 NXT33 ORA #$40
Bit 6 im Zeichen setzen
change to uppercase/graphic
     
.,E693 A6 C7 LDX $C7 NXT3 LDX RVS
RVS ?
get the reverse flag
  test RVS, flag for reversed characters
 
.,E695 F0 02 BEQ $E699 BEQ NVS
Umwandlung in Bildschirmcode
branch if not reverse
else ..
insert reversed character
  nope
 
.,E697 09 80 ORA #$80 NC3 ORA #$80
ja, dann Bit 7 setzen
reverse character
  set bit 7 to reverse character
 
.,E699 A6 D8 LDX $D8 NVS LDX INSRT
wenn Einfügzähler Null,
get the insert count
  test INSRT, flag for insert mode
 
.,E69B F0 02 BEQ $E69F BEQ NVS1
dann zu $E69F
branch if none
  nope
 
.,E69D C6 D8 DEC $D8 DEC INSRT
Zähler erniedrigen
else decrement the insert count
  decrement number of characters left to insert
 
.,E69F AE 86 02 LDX $0286 NVS1 LDX COLOR PUT COLOR ON SCREEN
Farbkode
get the current colour code
  get COLOR, current character colour code
 
.,E6A2 20 13 EA JSR $EA13 JSR DSPP
Zeichen in Bildschirm-RAM
schreiben
print character A and colour X
  print to screen
 
.,E6A5 20 B6 E6 JSR $E6B6 JSR WLOGIC ;CHECK FOR WRAPAROUND
Tabelle der Zeilenanfänge
aktualisieren
advance the cursor
restore the registers, set the quote flag and exit
  advance cursor

return from output to the screen

.,E6A8 68 PLA LOOP2 PLA
Y-Reg
pull Y
     
.,E6A9 A8 TAY TAY
aus Stack
restore Y
     
.,E6AA A5 D8 LDA $D8 LDA INSRT
wenn Einfügzähler Null,
get the insert count
  INSRT
 
.,E6AC F0 02 BEQ $E6B0 BEQ LOP2
dann zu $E6B0
skip quote flag clear if inserts to do
     
.,E6AE 46 D4 LSR $D4 LSR QTSW
Hochkommamodus löschen
clear cursor quote flag, $xx = quote, $00 = no quote
     
.,E6B0 68 PLA LOP2 PLA
X-Reg
pull X
     
.,E6B1 AA TAX TAX
aus Stack
restore X
     
.,E6B2 68 PLA PLA
Akku aus Stack
restore A
     
.,E6B3 18 CLC CLC ;GOOD RETURN
Carry löschen
       
.,E6B4 58 CLI CLI
Interrupt freigeben
enable the interrupts
     
.,E6B5 60 RTS RTS
WLOGIC
Rücksprung

HIGH-Byte für Zeilenanfänge

neu berechnen

advance the cursor

 

ADVANCE CURSOR

The cursor is advanced one position on the screen. If this
puts it beyond the 40th column, then it is placed at the
beginning of the next line. If the length of that line is
less than 80, then this new line is linked to the previous
one. A space is opened if data already exists on the new
line. If the cursor has reached the bottom of the screen,
then the screen is scrolled down.

get/insert new line

.,E6B6 20 B3 E8 JSR $E8B3 JSR CHKDWN ;MAYBE WE SHOULD WE INCREMENT TBLX
Zeilenzeiger erhöhen
test for line increment
  check line increment
 
.,E6B9 E6 D3 INC $D3 INC PNTR ;BUMP CHARCTER POINTER
Cursorspalte erhöhen
increment the cursor column
  increment PNTR, cursor column on current line
 
.,E6BB A5 D5 LDA $D5 LDA LNMX ;
Zeilenlänge holen
get current screen line length
  LNMX, physical screen line length
 
.,E6BD C5 D3 CMP $D3 CMP PNTR ;IF LNMX IS LESS THAN PNTR
Vergleich mit Cursorspalte
compare ?? with the cursor column
  compare to PNTR
 
.,E6BF B0 3F BCS $E700 BCS WLGRTS ;BRANCH IF LNMX>=PNTR
nicht überschritten, dann RTS
exit if line length >= cursor column
  not beyond end of line, exit
 
.,E6C1 C9 4F CMP #$4F CMP #MAXCHR-1 ;PAST MAX CHARACTERS
79 Zeichen (Doppelzeile) ?
compare with max length
  $4f = 79
 
.,E6C3 F0 32 BEQ $E6F7 BEQ WLOG10 ;BRANCH IF SO
wenn ja, dann zu $E6F7
if at max clear column, back cursor up and do newline
  put cursor on new logical line
 
.,E6C5 AD 92 02 LDA $0292 LDA AUTODN ;SHOULD WE AUTO SCROLL DOWN?
Zeilenübergang nicht
get the autoscroll flag
  AUTODN, auto scroll down flag
 
.,E6C8 F0 03 BEQ $E6CD BEQ WLOG20 ;BRANCH IF NOT
im Editmodus, dann zu $E6CD
branch if autoscroll on
  auto scroll is on
 
.,E6CA 4C 67 E9 JMP $E967 JMP BMT1 ;ELSE DECIDE WHICH WAY TO SCROLL
WLOG20
neue Zeile einfügen
else open space on screen
  open a space on the screen
 
.,E6CD A6 D6 LDX $D6 LDX TBLX ;SEE IF WE SHOULD SCROLL DOWN
Zeile
get the cursor row
  read TBLX, current line number
 
.,E6CF E0 19 CPX #$19 CPX #NLINES
25 ?
compare with max + 1
  $19 = 25
 
.,E6D1 90 07 BCC $E6DA BCC WLOG30 ;BRANCH IF NOT
wenn ja, dann zu $E6DA
if less than max + 1 go add this row to the current
logical line
  less than 25
 
.,E6D3 20 EA E8 JSR $E8EA JSR SCROL ;ELSE DO THE SCROL UP
SCROLL
else scroll the screen
  scroll down
 
.,E6D6 C6 D6 DEC $D6 DEC TBLX ;AND ADJUST CURENT LINE#
Cursorzeilenzeiger
erniedrigen
decrement the cursor row
  place cursor on line 24
 
.,E6D8 A6 D6 LDX $D6 LDX TBLX
Zähler holen
get the cursor row
add this row to the current logical line
     
.,E6DA 16 D9 ASL $D9,X WLOG30 ASL LDTB1,X ;WRAP THE LINE
Zeile
shift start of line X pointer high byte
  clear bit7 in LDTB1 to indicate that it is line 2
 
.,E6DC 56 D9 LSR $D9,X LSR LDTB1,X
markieren
shift start of line X pointer high byte back,
make next screen line start of logical line, increment line length and set pointers
clear b7, start of logical line
  in the logical line
 
.,E6DE E8 INX INX ;INDEX TO NEXT LLINE
Zähler erhöhen
increment screen row
  next line
 
.,E6DF B5 D9 LDA $D9,X LDA LDTB1,X ;GET HIGH ORDER BYTE OF ADDRESS
Startzeile
get start of line X pointer high byte
  set bit7 in LDTB1 to indicate that it is line 1
 
.,E6E1 09 80 ORA #$80 ORA #$80 ;MAKE IT A NON-CONTINUATION LINE
markieren
mark as start of logical line
  in the logical line
 
.,E6E3 95 D9 STA $D9,X STA LDTB1,X ;AND PUT IT BACK
und speichern
set start of line X pointer high byte
     
.,E6E5 CA DEX DEX ;GET BACK TO CURRENT LINE
Zähler erniedrigen
restore screen row
     
.,E6E6 A5 D5 LDA $D5 LDA LNMX ;CONTINUE THE BYTES TAKEN OUT
Zeilenlänge
get current screen line length
add one line length and set the pointers for the start of the line
  add $28 (40) to LNMX to allow 80 characters
 
.,E6E8 18 CLC CLC
mit
clear carry for add
  on the logical line
 
.,E6E9 69 28 ADC #$28 ADC #LLEN
40 addieren
add one line length
     
.,E6EB 85 D5 STA $D5 STA LNMX
FINDST
und speichern
save current screen line length
 

RETREAT CURSOR

The screen line link table is searched, and then the start
of line is set. The rest of the routine sets the cursor
onto the next line for the previous routine.
 
.,E6ED B5 D9 LDA $D9,X LDA LDTB1,X ;IS THIS THE FIRST LINE?
keine Doppelzeile,
get start of line X pointer high byte
  LDTB1, screen line link table
 
.,E6EF 30 03 BMI $E6F4 BMI FINX ;BRANCH IF SO
dann zu $E6F4
exit loop if start of logical line
  test bit7
 
.,E6F1 CA DEX DEX ;ELSE BACKUP 1
Zähler erniedrigen
else back up one line
  next line
 
.,E6F2 D0 F9 BNE $E6ED BNE FINDST
FINX
noch nicht alle?, dann weiter
loop if not on first line
  till all are done
 
.,E6F4 4C F0 E9 JMP $E9F0 JMP SETPNT ;MAKE SURE PNT IS RIGHT
Zeiger auf Farb-RAM
für Zeile X
fetch a screen address
  set start of line
 
.,E6F7 C6 D6 DEC $D6 WLOG10 DEC TBLX
Cursorzeile erniedrigen
decrement the cursor row
  decrement TBLX, cursor line
 
.,E6F9 20 7C E8 JSR $E87C JSR NXLN
und initialisieren
do newline
  goto next line
 
.,E6FC A9 00 LDA #$00 LDA #0
Spalte
clear A
     
.,E6FE 85 D3 STA $D3 STA PNTR ;POINT TO FIRST BYTE
auf Null
clear the cursor column
  set PNTR, the cursor column, to zero
 
.,E700 60 RTS WLGRTS RTS
Rücksprung

Rückschritt in vorhergehende

Zeile

back onto the previous line if possible

 

BACK ON TO PREVIOUS LINE

This routine is called when using <DEL> and <cursor LEFT>.
The line number is tested, and if the cursor is already on
the top line, then no further action is taken. The screen
pointers are set up and the cursor placed at the end of
the previous line.

move backwards over a line boundary

.,E701 A6 D6 LDX $D6 BKLN LDX TBLX
Cursorzeile
get the cursor row
  test TBLX, physical line number
 
.,E703 D0 06 BNE $E70B BNE BKLN1
wenn null, dann zu $E70B
branch if not top row
  if not on top line, branch
 
.,E705 86 D3 STX $D3 STX PNTR
Cursorspalte
clear cursor column
  set PNTR to zero as well
 
.,E707 68 PLA PLA
Sprungadresse
dump return address low byte
     
.,E708 68 PLA PLA
aus Stack holen
dump return address high byte
     
.,E709 D0 9D BNE $E6A8 BNE LOOP2
;
unbedingter Sprung
restore registers, set quote flag and exit, branch always
  allways jump
 
.,E70B CA DEX BKLN1 DEX
Zeilennummer
decrement the cursor row
  decrement TBLX
 
.,E70C 86 D6 STX $D6 STX TBLX
erniedrigen
save the cursor row
  and store
 
.,E70E 20 6C E5 JSR $E56C JSR STUPT
Cursorposition berechnen
set the screen pointers for cursor row, column
  set screen pointers
 
.,E711 A4 D5 LDY $D5 LDY LNMX
Zeilenlänge
get current screen line length
  get LNMX
 
.,E713 84 D3 STY $D3 STY PNTR
speichern
save the cursor column
  and store in PNTR
 
.,E715 60 RTS RTS
;PRINT ROUTINE
;
Rücksprung

Ausgabe auf Bildschirm

output a character to the screen

 

OUTPUT TO SCREEN

This routine is part of the main KERNAL CHROUT routine. It
prints CBM ASCII characters to the screen and takes care
of all the screen editing characters. The cursor is
automatically updated and scrolling occurs if necessary.
On entry, (A) must hold the character to be output. On
entry all registers are stored on the stack. For
convinience, the routine is slpit into sections showing
the processing of both shifted and unshifted character.

put a character to screen

.,E716 48 PHA PRT PHA
Zeichen
save character
  store (A), (X) and (Y) on stack
 
.,E717 85 D7 STA $D7 STA DATA
merken
save temporary last character
  temp store
 
.,E719 8A TXA TXA
die
copy X
     
.,E71A 48 PHA PHA
Re-
save X
     
.,E71B 98 TYA TYA
gister
copy Y
     
.,E71C 48 PHA PHA
retten
save Y
     
.,E71D A9 00 LDA #$00 LDA #0
Eingabeflag
clear A
     
.,E71F 85 D0 STA $D0 STA CRSW
löschen
clear input from keyboard or screen, $xx = screen,
$00 = keyboard
  store in CRSW
 
.,E721 A4 D3 LDY $D3 LDY PNTR
Cursorspalte
get cursor column
  PNTR, cursor positions on line
 
.,E723 A5 D7 LDA $D7 LDA DATA
Zeichen
restore last character
  retrieve from temp store
 
.,E725 10 03 BPL $E72A BPL *+5
wenn kleiner 128, dann
zu $E72A
branch if unshifted
  do unshifted characters
 
.,E727 4C D4 E7 JMP $E7D4 JMP NXTX
Zeichen größer $7F behandeln
do shifted characters and return
  do shifted characters
UNSHIFTED CHARACTERS. Ordinary unshifted ASCII characters
and PET graphics are output directly to the screen. The
following control codes are trapped and precessed:
<RETURN>, <DEL>, <CRSR RIGHT>, <CRSR DOWN>. If either
insert mode is on or quotes are open (except for <DEL>)
then the control characters are not processed, but output
as reversed ASCII literals.
 
.,E72A C9 0D CMP #$0D CMP #$D
'CARRIAGE RETURN' ?
compare with [CR]
  <RETURN>?
return code
.,E72C D0 03 BNE $E731 BNE NJT1
wenn nicht, dann zu $E731
branch if not [CR]
  nope
 
.,E72E 4C 91 E8 JMP $E891 JMP NXT1
Return ausgeben
else output [CR] and return
  execute return
 
.,E731 C9 20 CMP #$20 NJT1 CMP #'
' '
compare with [SPACE]
  <SPACE>?
 
.,E733 90 10 BCC $E745 BCC NTCN
druckendes Zeichen ?
branch if < [SPACE], not a printable character
     
.,E735 C9 60 CMP #$60 CMP #$60 ;LOWER CASE?
Zahl kleiner $60,
    #$60, first PET graphic character?
 
.,E737 90 04 BCC $E73D BCC NJT8 ;NO...
dann keine Graphikzeichen
branch if $20 to $5F
character is $60 or greater
     
.,E739 29 DF AND #$DF AND #$DF ;YES...MAKE SCREEN LOWER
Umwandlung in BS-Kode
conversion of PETSCII character to screen code
  %11011111
 
.,E73B D0 02 BNE $E73F BNE NJT9 ;ALWAYS
unbedingter Sprung
branch always
character is $20 to $5F
     
.,E73D 29 3F AND #$3F NJT8 AND #$3F
Umwandlung in BS-Kode
conversion of PETSCII character to screen code
  %00111111
 
.,E73F 20 84 E6 JSR $E684 NJT9 JSR QTSWC
Test auf Hochkomma
if open quote toggle cursor direct/programmed flag
  do quotes test
 
.,E742 4C 93 E6 JMP $E693 JMP NXT3
zur Ausgabe, ASCII-Kode
in BS-Code
character was < [SPACE] so is a control character
of some sort
  setup screen print
 
.,E745 A6 D8 LDX $D8 NTCN LDX INSRT
wenn Einfügzähler =0,
get the insert count
  INSRT, insert mode flag
 
.,E747 F0 03 BEQ $E74C BEQ CNC3X
dann zu $E74C
if no characters to insert continue
  mode not set
 
.,E749 4C 97 E6 JMP $E697 JMP NC3
ASCII-Kode in BS-Code
insert reversed character
  output reversed charcter
 
.,E74C C9 14 CMP #$14 CNC3X CMP #$14
nicht 'DEL' ?,
compare the character with [INSERT]/[DELETE]
  <DEL>?
delete code
.,E74E D0 2E BNE $E77E BNE NTCN1
dann zu $E77E
if not [INSERT]/[DELETE] go ??
  nope
 
.,E750 98 TYA TYA
erste Spalte =0
    (Y) holds cursor column
 
.,E751 D0 06 BNE $E759 BNE BAK1UP
dann zu $E759
    not start of line
 
.,E753 20 01 E7 JSR $E701 JSR BKLN
zurück in vorherige Zeile
back onto the previous line if possible
  back on previous line
 
.,E756 4C 73 E7 JMP $E773 JMP BK2
Zeichen in Cursorposition
eliminieren
       
.,E759 20 A1 E8 JSR $E8A1 BAK1UP JSR CHKBAK ;SHOULD WE DEC TBLX
Rückschritt prüfen
test for line decrement
now close up the line
  check line decrement
 
.,E75C 88 DEY DEY
Zeiger erniedrigen
decrement index to previous character
  decrement cursor column
 
.,E75D 84 D3 STY $D3 STY PNTR
und speichern
save the cursor column
  and store in PNTR
 
.,E75F 20 24 EA JSR $EA24 BK1 JSR SCOLOR ;FIX COLOR PTRS
Zeiger auf Farb-RAM berechnen
calculate the pointer to colour RAM
  syncronise colour pointer
 
.,E762 C8 INY BK15 INY
Zeiger erhöhen
increment index to next character
  copy character at cursor position (Y+1) to (Y)
 
.,E763 B1 D1 LDA ($D1),Y LDA (PNT)Y
Zeichen vom Bildschirm
get character from current screen line
  read character
 
.,E765 88 DEY DEY
Zeiger erniedrigen
decrement index to previous character
     
.,E766 91 D1 STA ($D1),Y STA (PNT)Y
eins nach links schieben
save character to current screen line
  and store it one position back
 
.,E768 C8 INY INY
Zeiger erhöhen
increment index to next character
     
.,E769 B1 F3 LDA ($F3),Y LDA (USER)Y
Farbe
get colour RAM byte
  read character colour
 
.,E76B 88 DEY DEY
Zeiger erniedrigen
decrement index to previous character
     
.,E76C 91 F3 STA ($F3),Y STA (USER)Y
eins nach links schieben
save colour RAM byte
  and store it one position back
 
.,E76E C8 INY INY
Zeiger erhöhen
increment index to next character
  more characters to move
 
.,E76F C4 D5 CPY $D5 CPY LNMX
Endspalte nicht
compare with current screen line length
  compare with LNMX, length of physical screen line
 
.,E771 D0 EF BNE $E762 BNE BK15
erreicht, dann weiter
loop if not there yet
  if not equal, move more characters
 
.,E773 A9 20 LDA #$20 BK2 LDA #'
Blank
set [SPACE]
    space
.,E775 91 D1 STA ($D1),Y STA (PNT)Y
einfügen
clear last character on current screen line
  store <SPACE> at end of line
 
.,E777 AD 86 02 LDA $0286 LDA COLOR
Farbcode
get the current colour code
  COLOR, current character colour
 
.,E77A 91 F3 STA ($F3),Y STA (USER)Y
setzen
save to colour RAM
  store colour at end of line
 
.,E77C 10 4D BPL $E7CB BPL JPL3
fertig
branch always
  allways jump
 
.,E77E A6 D4 LDX $D4 NTCN1 LDX QTSW
Hochkomma-Modus ?
get cursor quote flag, $xx = quote, $00 = no quote
  QTSW, editor in quotes mode
 
.,E780 F0 03 BEQ $E785 BEQ NC3W
nein
branch if not quote mode
  no
 
.,E782 4C 97 E6 JMP $E697 CNC3 JMP NC3
Zeichen revers ausgeben
insert reversed character
  output reversed character
 
.,E785 C9 12 CMP #$12 NC3W CMP #$12
'RVS ON' ?
compare with [RVS ON]
  <RVS>?
reverse code
.,E787 D0 02 BNE $E78B BNE NC1
nein, dann
if not [RVS ON] skip setting the reverse flag
  no
 
.,E789 85 C7 STA $C7 STA RVS
Flag für RVS setzen
else set the reverse flag
  RVS, reversed character output flag
 
.,E78B C9 13 CMP #$13 NC1 CMP #$13
'HOME' ?
compare with [CLR HOME]
  <HOME>?
home code
.,E78D D0 03 BNE $E792 BNE NC2
nein
if not [CLR HOME] continue
  no
 
.,E78F 20 66 E5 JSR $E566 JSR NXTD
ja, Cursor Home
home the cursor
  home cursor
 
.,E792 C9 1D CMP #$1D NC2 CMP #$1D
'Cursor right' ?
compare with [CURSOR RIGHT]
  <CRSR RIGHT>?
csr right
.,E794 D0 17 BNE $E7AD BNE NCX2
nein
if not [CURSOR RIGHT] go ??
  nope
 
.,E796 C8 INY INY
Zeiger erhöhen
increment the cursor column
  increment (Y), internal counter for column
 
.,E797 20 B3 E8 JSR $E8B3 JSR CHKDWN
Cursorposition prüfen
test for line increment
  check line increment
 
.,E79A 84 D3 STY $D3 STY PNTR
neuer Zeiger
save the cursor column
  store (Y) in PNTR
 
.,E79C 88 DEY DEY
Zeiger erniedrigen
decrement the cursor column
  decrement (Y)
 
.,E79D C4 D5 CPY $D5 CPY LNMX
keine neue Zeile ?,
compare cursor column with current screen line length
  and compare to LNMX
 
.,E79F 90 09 BCC $E7AA BCC NCZ2
dann fertig
exit if less
else the cursor column is >= the current screen line
length so back onto the current line and do a newline
  not exceeded line length
 
.,E7A1 C6 D6 DEC $D6 DEC TBLX
Zeiger erniedrigen
decrement the cursor row
  TBLX, current physical line number
 
.,E7A3 20 7C E8 JSR $E87C JSR NXLN
Zeile initialisieren
do newline
  goto next line
 
.,E7A6 A0 00 LDY #$00 LDY #0
Spalte
clear cursor column
     
.,E7A8 84 D3 STY $D3 JPL4 STY PNTR
gleich null
save the cursor column
  set PNTR to zero, cursor to the left
 
.,E7AA 4C A8 E6 JMP $E6A8 NCZ2 JMP LOOP2
fertig
restore the registers, set the quote flag and exit
  finish screen print
 
.,E7AD C9 11 CMP #$11 NCX2 CMP #$11
'Cursor down' ?
compare with [CURSOR DOWN]
  <CRSR DOWN>?
csr down
.,E7AF D0 1D BNE $E7CE BNE COLR1
nein
if not [CURSOR DOWN] go ??
  no
 
.,E7B1 18 CLC CLC
plus
clear carry for add
  prepare for add
 
.,E7B2 98 TYA TYA
40,
copy the cursor column
  (Y) holds cursor column
 
.,E7B3 69 28 ADC #$28 ADC #LLEN
eine Zeile
add one line
  add 40 to next line
 
.,E7B5 A8 TAY TAY
tiefer
copy back to Y
  to (Y)
 
.,E7B6 E6 D6 INC $D6 INC TBLX
Zeiger erhöhen
increment the cursor row
  increment TBLX, physical line number
 
.,E7B8 C5 D5 CMP $D5 CMP LNMX
neue Zeile erreicht?
compare cursor column with current screen line length
  compare to LNMX
 
.,E7BA 90 EC BCC $E7A8 BCC JPL4
nein, dann zu $E7A8
if less go save cursor column and exit
  finish screen print
 
.,E7BC F0 EA BEQ $E7A8 BEQ JPL4
Ja, dann zu $E7A8
if equal go save cursor column and exit
else the cursor has moved beyond the end of this line
so back it up until it's on the start of the logical line
  finish screen print
 
.,E7BE C6 D6 DEC $D6 DEC TBLX
Zeiger erniedrigen
decrement the cursor row
  restore TBLX
 
.,E7C0 E9 28 SBC #$28 CURS10 SBC #LLEN
40 abziehen
subtract one line
     
.,E7C2 90 04 BCC $E7C8 BCC GOTDWN
genügend abgezogen, dann
zu $E7C8
if on previous line exit the loop
     
.,E7C4 85 D3 STA $D3 STA PNTR
Spalte setzen
else save the cursor column
  store PNTR
 
.,E7C6 D0 F8 BNE $E7C0 BNE CURS10
noch mal
loop if not at the start of the line
     
.,E7C8 20 7C E8 JSR $E87C GOTDWN JSR NXLN
Zeile initialisieren
do newline
  go to next line
 
.,E7CB 4C A8 E6 JMP $E6A8 JPL3 JMP LOOP2
fertig
restore the registers, set the quote flag and exit
  finish screen print
 
.,E7CE 20 CB E8 JSR $E8CB COLR1 JSR CHKCOL ;CHECK FOR A COLOR
prüft auf Farbcodes
set the colour code
  set colour code
 
.,E7D1 4C 44 EC JMP $EC44 JMP LOWER ;WAS JMP LOOP2
;CHECK COLOR
;
;SHIFTED KEYS
;
NXTX
KEEPIT
Test auf weitere
Sonderzeichen

Zeichen größer $127

go check for special character codes
  do graphics/text control
SHIFTED CHARACTERS. These are dealt with in the following
order: Shifted ordinart ASCII and PET graphics characters,
<shift RETURN>, <INST>, <CRSR UP>, <RVS OFF>, <CRSR LEFT>,
<CLR>. If either insert mode is on, or quotes are open,
then the control character is not processed but reversed
ASCII literal is printed.

put shifted chars to screen

.,E7D4 29 7F AND #$7F AND #$7F
Kode größer 127,
Bit 7 löschen
mask 0xxx xxxx, clear b7
  clear bit7
remove shift bit
.,E7D6 C9 7F CMP #$7F CMP #$7F
nicht 'Pi' ?
was it $FF before the mask
  compare to #$7f
code for PI
.,E7D8 D0 02 BNE $E7DC BNE NXTX1
dann zu $E7DC
branch if not
  not equal
 
.,E7DA A9 5E LDA #$5E LDA #$5E
NXTX1
NXTXA
Bildschirmkode für Pi
else make it $5E
  if #$7f, load #$5e
screen PI
.,E7DC C9 20 CMP #$20 CMP #$20 ;IS IT A FUNCTION KEY
Steuerzeichen ?
compare the character with [SPACE]
  ASCII <SPACE>?
 
.,E7DE 90 03 BCC $E7E3 BCC UHUH
ja
if < [SPACE] go ??
     
.,E7E0 4C 91 E6 JMP $E691 JMP NXT33
UHUH
druckendes Zeichen ausgeben
insert uppercase/graphic character and return
character was $80 to $9F and is now $00 to $1F
  set up screen print
 
.,E7E3 C9 0D CMP #$0D CMP #$D
nicht 'Shift return' ?
compare with [CR]
  <RETURN>?
shift return
.,E7E5 D0 03 BNE $E7EA BNE UP5
dann zu $E7EA
if not [CR] continue
  nope
 
.,E7E7 4C 91 E8 JMP $E891 JMP NXT1
neue Zeile
else output [CR] and return
was not [CR]
  do return
 
.,E7EA A6 D4 LDX $D4 UP5 LDX QTSW
Hochkomma-Hodus ?
get the cursor quote flag, $xx = quote, $00 = no quote
  read QTSW
 
.,E7EC D0 3F BNE $E82D BNE UP6
ja, Steuerzeichen revers
ausgeben
branch if quote mode
  if quotes mode, jump
 
.,E7EE C9 14 CMP #$14 CMP #$14
nicht 'INS' ?,
compare with [INSERT DELETE]
  <INST>?
insert
.,E7F0 D0 37 BNE $E829 BNE UP9
dann zu $E829
if not [INSERT DELETE] go ??
  nope
 
.,E7F2 A4 D5 LDY $D5 LDY LNMX
Zeilenlänge
get current screen line length
  LNMX
 
.,E7F4 B1 D1 LDA ($D1),Y LDA (PNT)Y
letztes Zeichen in Zeile
get character from current screen line
  get screen character
 
.,E7F6 C9 20 CMP #$20 CMP #'
gleich Leerzeichen ?
compare the character with [SPACE]
  space?
 
.,E7F8 D0 04 BNE $E7FE BNE INS3
nein, dann zu $E7FE
if not [SPACE] continue
  nope
 
.,E7FA C4 D3 CPY $D3 CPY PNTR
Cursor in letzter Spalte ?
compare the current column with the cursor column
  PNTR equal to LNMX
 
.,E7FC D0 07 BNE $E805 BNE INS1
nein, dann zu $E805
if not cursor column go open up space on line
  nope
 
.,E7FE C0 4F CPY #$4F INS3 CPY #MAXCHR-1
79 ? maximale Zeilenlänge
compare current column with max line length
  #$4f=79, last character
 
.,E800 F0 24 BEQ $E826 BEQ INSEXT ;EXIT IF LINE TOO LONG
letzte Spalte, dann keine
Aktion
if at line end just exit
  end of logical line, can not insert
 
.,E802 20 65 E9 JSR $E965 JSR NEWLIN ;SCROLL DOWN 1
Leerzeile einfügen
else open up a space on the screen
now open up space on the line to insert a character
  open space on line
 
.,E805 A4 D5 LDY $D5 INS1 LDY LNMX
Zeilenlänge
get current screen line length
  LNMX
 
.,E807 20 24 EA JSR $EA24 JSR SCOLOR
Zeiger auf Farbram berechnen
calculate the pointer to colour RAM
  syncronise colour pointer
 
.,E80A 88 DEY INS2 DEY
Zeiger erniedrigen
decrement the index to previous character
  prepare for move
 
.,E80B B1 D1 LDA ($D1),Y LDA (PNT)Y
Zeichen vom Bildschirm
get the character from the current screen line
  read character at pos (Y)
 
.,E80D C8 INY INY
Zeiger erhöhen
increment the index to next character
     
.,E80E 91 D1 STA ($D1),Y STA (PNT)Y
eins nach rechts schieben
save the character to the current screen line
  and move one step to the right
 
.,E810 88 DEY DEY
Zeiger erniedrigen
decrement the index to previous character
     
.,E811 B1 F3 LDA ($F3),Y LDA (USER)Y
und Farbe
get the current screen line colour RAM byte
  read character colour
 
.,E813 C8 INY INY
Zeiger erhöhen
increment the index to next character
     
.,E814 91 F3 STA ($F3),Y STA (USER)Y
verschieben
save the current screen line colour RAM byte
  move one step to the right
 
.,E816 88 DEY DEY
Zeiger erniedrigen
decrement the index to the previous character
  decrement counter
 
.,E817 C4 D3 CPY $D3 CPY PNTR
bis zur aktuellen Position
aufrücken
compare the index with the cursor column
  compare with PNTR
 
.,E819 D0 EF BNE $E80A BNE INS2
nicht ?, dann weiter
loop if not there yet
  till all characters right of cursor are moved
 
.,E81B A9 20 LDA #$20 LDA #$20
Leerzeichen
set [SPACE]
  <SPACE>, ASCII #$20
 
.,E81D 91 D1 STA ($D1),Y STA (PNT)Y
an augenblickliche Position
schreiben
clear character at cursor position on current screen line
  store at new character position
 
.,E81F AD 86 02 LDA $0286 LDA COLOR
Farbe
get current colour code
  COLOR, current character colour
 
.,E822 91 F3 STA ($F3),Y STA (USER)Y
setzen
save to cursor position on current screen line colour RAM
  store at new colour position
 
.,E824 E6 D8 INC $D8 INC INSRT
Anzahl der Inserts erhöhen
increment insert count
  INSRT FLAG
 
.,E826 4C A8 E6 JMP $E6A8 INSEXT JMP LOOP2
Ende der Zeichenausgabe
restore the registers, set the quote flag and exit
  finish screen print
 
.,E829 A6 D8 LDX $D8 UP9 LDX INSRT
Zähler Null?
get the insert count
  INSRT FLAG
 
.,E82B F0 05 BEQ $E832 BEQ UP2
dann zu $E832
branch if no insert space
  insert mode is off
 
.,E82D 09 40 ORA #$40 UP6 ORA #$40
Bit 6 setzen
change to uppercase/graphic
     
.,E82F 4C 97 E6 JMP $E697 JMP NC3
und Zeichen ausgeben
insert reversed character
  set up screen print
 
.,E832 C9 11 CMP #$11 UP2 CMP #$11
nicht Cursor up ?,
compare with [CURSOR UP]
  <CRSR UP>?
csr up
.,E834 D0 16 BNE $E84C BNE NXT2
dann zu $E84C
branch if not [CURSOR UP]
  nope
 
.,E836 A6 D6 LDX $D6 LDX TBLX
Zeile
get the cursor row
  read TBLX
 
.,E838 F0 37 BEQ $E871 BEQ JPL2
null, dann fertig
if on the top line go restore the registers, set the
quote flag and exit
  at topline, do nothing
 
.,E83A C6 D6 DEC $D6 DEC TBLX
Zeilennummer um eins erniedrigen
decrement the cursor row
  else decrement TBLX
 
.,E83C A5 D3 LDA $D3 LDA PNTR
Spalte
get the cursor column
  PNTR
 
.,E83E 38 SEC SEC
40
set carry for subtract
  prepare for substract
 
.,E83F E9 28 SBC #$28 SBC #LLEN
abziehen
nicht in Doppelzeile ?,
subtract one line length
  back 40 columns for double line
 
.,E841 90 04 BCC $E847 BCC UPALIN
dann zu $E847
branch if stepped back to previous line
  skip
 
.,E843 85 D3 STA $D3 STA PNTR
Cursorspalte
else save the cursor column ..
  store PNTR
 
.,E845 10 2A BPL $E871 BPL JPL2
positiv, ok
.. and exit, branch always
  finish screen print
 
.,E847 20 6C E5 JSR $E56C UPALIN JSR STUPT
Bildschirmzeiger neu setzen
set the screen pointers for cursor row, column ..
  set screen pointer
 
.,E84A D0 25 BNE $E871 BNE JPL2
unbedingter Sprung
.. and exit, branch always
  finish screen print
 
.,E84C C9 12 CMP #$12 NXT2 CMP #$12
nicht 'RVS OFF' ?,
compare with [RVS OFF]
  <RVS OFF>?
reverse off
.,E84E D0 04 BNE $E854 BNE NXT6
dann zu $E854
if not [RVS OFF] continue
  nope
 
.,E850 A9 00 LDA #$00 LDA #0
RVS-Flag
else clear A
     
.,E852 85 C7 STA $C7 STA RVS
löschen
clear the reverse flag
  RVS, disable reverse print
 
.,E854 C9 1D CMP #$1D NXT6 CMP #$1D
nicht ’Cursor left' ?,
compare with [CURSOR LEFT]
  <CRSR LEFT>?
csr left
.,E856 D0 12 BNE $E86A BNE NXT61
dann zu $E86A
if not [CURSOR LEFT] go ??
  nope
 
.,E858 98 TYA TYA
wenn erste Spalte,
copy the cursor column
  (Y) holds cursor column
 
.,E859 F0 09 BEQ $E864 BEQ BAKBAK
dann zu $E864
if at start of line go back onto the previous line
  at first position
 
.,E85B 20 A1 E8 JSR $E8A1 JSR CHKBAK
Cursorzeile erniedrigen
test for line decrement
  check line decrement
 
.,E85E 88 DEY DEY
Zähler erniedrigen
decrement the cursor column
  one position left
 
.,E85F 84 D3 STY $D3 STY PNTR
Cursorspalte
save the cursor column
  store in PNTR
 
.,E861 4C A8 E6 JMP $E6A8 JMP LOOP2
fertig
restore the registers, set the quote flag and exit
  finish screen print
 
.,E864 20 01 E7 JSR $E701 BAKBAK JSR BKLN
Rückschritt in vorherige
Zeile
back onto the previous line if possible
  back to previous line
 
.,E867 4C A8 E6 JMP $E6A8 JMP LOOP2
fertig
restore the registers, set the quote flag and exit
  finish screen print
 
.,E86A C9 13 CMP #$13 NXT61 CMP #$13
nicht 'CLR SCREEN' ?,
compare with [CLR]
  <CLR>?
clr code
.,E86C D0 06 BNE $E874 BNE SCCL
dann zu $E874
if not [CLR] continue
  nope
 
.,E86E 20 44 E5 JSR $E544 JSR CLSR
Bildschirm löschen
clear the screen
  clear screen
 
.,E871 4C A8 E6 JMP $E6A8 JPL2 JMP LOOP2
SCCL
fertig
restore the registers, set the quote flag and exit
  finish screen print
 
.,E874 09 80 ORA #$80 ORA #$80 ;MAKE IT UPPER CASE
Bit 7 wiederherstellen
restore b7, colour can only be black, cyan, magenta
or yellow
     
.,E876 20 CB E8 JSR $E8CB JSR CHKCOL ;TRY FOR COLOR
auf Farbcode prüfen
set the colour code
  set colour code
 
.,E879 4C 4F EC JMP $EC4F JMP UPPER ;WAS JMP LOOP2
;
prüft auf Umschaltung
Text/Grafik
go check for special character codes except fro switch
to lower case

do newline

  set graphics/text mode

GO TO NEXT LINE

The cursor is placed at the start of the next logical
screen line. This involves moving down two lines for a
linked line. If this places the cursor below the bottom of
the screen, then the screen is scrolled.

set next line number

.,E87C 46 C9 LSR $C9 NXLN LSR LSXP
Flag für Zeilenwechsel
shift >> input cursor row
  LXSP, cursor X-Y position
 
.,E87E A6 D6 LDX $D6 LDX TBLX
Cursorzeilenzeiger
get the cursor row
  TBLX, current line number
 
.,E880 E8 INX NXLN2 INX
Zeiger erhöhen
increment the row
  next line
 
.,E881 E0 19 CPX #$19 CPX #NLINES ;OFF BOTTOM?
noch nicht letzte Zeile ?,
compare it with last row + 1
  26th line
 
.,E883 D0 03 BNE $E888 BNE NXLN1 ;NO...
dann zu $E888
if not last row + 1 skip the screen scroll
  nope, scroll is not needed
 
.,E885 20 EA E8 JSR $E8EA JSR SCROL ;YES...SCROLL
Bildschirm scrollen
else scroll the screen
  scroll down
 
.,E888 B5 D9 LDA $D9,X NXLN1 LDA LDTB1,X ;DOUBLE LINE?
nächste Zeile, dann
get start of line X pointer high byte
  test LTDB1, screen line link table if first of two
 
.,E88A 10 F4 BPL $E880 BPL NXLN2 ;YES...SCROLL AGAIN
wieder scrollen
loop if not start of logical line
  yes, jump down another line
 
.,E88C 86 D6 STX $D6 STX TBLX
neue Zeile
save the cursor row
  store in TBLX
 
.,E88E 4C 6C E5 JMP $E56C JMP STUPT
NXT1
Cursorposition berechnen
set the screen pointers for cursor row, column and return

output [CR]

  set screen pointers

OUTPUT <CARRIAGE RETURN>

All editor modes are swithed off and the cursor placed at
the start of the next line.

action for return

.,E891 A2 00 LDX #$00 LDX #0
Einfüg-
clear X
     
.,E893 86 D8 STX $D8 STX INSRT
zähler löschen
clear the insert count
  INSRT, disable insert mode
 
.,E895 86 C7 STX $C7 STX RVS
Flag für RVS löschen
clear the reverse flag
  RVS, disable reversed mode
 
.,E897 86 D4 STX $D4 STX QTSW
Quote-Modus löschen
clear the cursor quote flag, $xx = quote, $00 = no quote
  QTSW, disable quotes mode
 
.,E899 86 D3 STX $D3 STX PNTR
Cursor in erste Spalte
save the cursor column
  PNTR, put cursor at first column
 
.,E89B 20 7C E8 JSR $E87C JSR NXLN
Zeile initialisieren
do newline
  go to next line
 
.,E89E 4C A8 E6 JMP $E6A8 JPL5 JMP LOOP2
;
;
; CHECK FOR A DECREMENT TBLX
;
fertig
restore the registers, set the quote flag and exit

test for line decrement

  finish screen print

CHECK LINE DECREMENT

When the cursor is at the beginning of a screen line, if
it is moved backwards, this routine places the cursor at
the end of the line above. It tests both column 0 and
column 40.

move cursor to previous line if

at start of line
.,E8A1 A2 02 LDX #$02 CHKBAK LDX #NWRAP
maximale Zeilenanzahl
set the count
  test if PNTR is at the first column
 
.,E8A3 A9 00 LDA #$00 LDA #0
wenn Cursorspalte
set the column
  yepp
 
.,E8A5 C5 D3 CMP $D3 CHKLUP CMP PNTR
gleich Akku,
compare the column with the cursor column
  add $28 (40)
 
.,E8A7 F0 07 BEQ $E8B0 BEQ BACK
dann zu $E8B0
if at the start of the line go decrement the cursor row
and exit
  to test if cursor is at line two in the logical line
 
.,E8A9 18 CLC CLC
40 addieren,
else clear carry for add
     
.,E8AA 69 28 ADC #$28 ADC #LLEN
eine Zeile
increment to next line
  test two lines
 
.,E8AC CA DEX DEX
schon zweimal addiert ?,
decrement loop count
     
.,E8AD D0 F6 BNE $E8A5 BNE CHKLUP
ja, dann weiter
loop if more to test
  decrement line number
 
.,E8AF 60 RTS RTS
;
Rücksprung
       
.,E8B0 C6 D6 DEC $D6 BACK DEC TBLX
Zeiger auf Cursorzeile
erniedrigen
else decrement the cursor row
     
.,E8B2 60 RTS RTS
;
; CHECK FOR INCREMENT TBLX
;
Rücksprung

test for line increment

if at end of the line, but not at end of the last line, increment the cursor row
 

CHECK LINE INCREMENT

When the cursor is at the end of the screen, if it is
moved forward, this routine places the cursor at the start
of the line below.

move cursor to next line if

at end of line
.,E8B3 A2 02 LDX #$02 CHKDWN LDX #NWRAP
maximale Zeilenanzahl
set the count
  start by testing position $27 (39)
 
.,E8B5 A9 27 LDA #$27 LDA #LLEN-1
39, letzte Spalte
set the column
  compare with PNTR
 
.,E8B7 C5 D3 CMP $D3 DWNCHK CMP PNTR
wenn Cursorspalte gleich
compare the column with the cursor column
  brach if equal, and move cursor down
 
.,E8B9 F0 07 BEQ $E8C2 BEQ DNLINE
akku ?, dann zu $E8C2
if at end of line test and possibly increment cursor row
  else, add $28 to test next physical line
 
.,E8BB 18 CLC CLC
40
else clear carry for add
     
.,E8BC 69 28 ADC #$28 ADC #LLEN
addieren
increment to the next line
  two lines to test
 
.,E8BE CA DEX DEX
schon zweimal ?,
decrement the loop count
     
.,E8BF D0 F6 BNE $E8B7 BNE DWNCHK
ja, dann weiter
loop if more to test
  return here without moving cursor down
 
.,E8C1 60 RTS RTS
;
Rücksprung
cursor is at end of line
  get TBLX
 
.,E8C2 A6 D6 LDX $D6 DNLINE LDX TBLX
wenn Cursorzeile
get the cursor row
  and test if at the 25th line
 
.,E8C4 E0 19 CPX #$19 CPX #NLINES
gleich 25,
compare it with the end of the screen
  yepp, return without moving down
 
.,E8C6 F0 02 BEQ $E8CA BEQ DWNBYE
dann fertig
if at the end of screen just exit
  increment TBLX
 
.,E8C8 E6 D6 INC $D6 INC TBLX
;
Zeiger auf Cursorzeile
erhöhen
else increment the cursor row
     
.,E8CA 60 RTS DWNBYE RTS
CHKCOL
Rücksprung

prüft auf Farbcodes

set the colour code. enter with the colour character in A. if A does not contain a

colour character this routine exits without changing the colour
 

SET COLOUR CODE

This routine is called by the output to screen routine.
The Commodore ASCII code in (A) is compared with the ASCII
colout code table. If a match is found, then the table
offset (and hence the colour value) is stored in COLOR.

check for colour change codes

.,E8CB A2 0F LDX #$0F LDX #15 ;THERE'S 15 COLORS
Anzahl der Kodes
set the colour code count
  16 values to be tested
 
.,E8CD DD DA E8 CMP $E8DA,X CHK1A CMP COLTAB,X
mit Farbcodetabelle
vergleichen
compare the character with a table code
  compare with colour code table
 
.,E8D0 F0 04 BEQ $E8D6 BEQ CHK1B
wenn gefunden, dann farbe
setzen
if a match go save the colour and exit
  found, jump
 
.,E8D2 CA DEX DEX
nächster Farbcode
else decrement the index
  next colour in table
 
.,E8D3 10 F8 BPL $E8CD BPL CHK1A
schon alle ?
loop if more to do
  till all 16 are tested
 
.,E8D5 60 RTS RTS
;
CHK1B
Rücksprung
    if not found, return
 
.,E8D6 8E 86 02 STX $0286 STX COLOR ;CHANGE THE COLOR
Farbcode setzen
save the current colour code
  if found, store code in COLOR
 
.,E8D9 60 RTS RTS
COLTAB
;BLK,WHT,RED,CYAN,MAGENTA,GRN,BLUE,YELLOW
Rücksprung

Tabelle der Farb-Kodes

ASCII colour code table

CHR$() colour
------ ------
 

COLOUR CODE TABLE

This is a table containing 16 Commodore ASCII codes
representing the 16 available colours. Thus red is
represented as $1c in the table, and would be obtained by
PRINT CHR$(28), or poke 646,2.

colour key codes

.:E8DA 90 05 1C 9F 9C 1E 1F 9E .BYT $90,$05,$1C,$9F,$9C,$1E,$1F,$9E
  144 black
  color0, black
 
.:E8E2 81 95 96 97 98 99 9A 9B .BYT $81,$95,$96,$97,$98,$99,$9A,$9B
.END
;.LIB CONKAT (JAPAN CONVERSION TABLES)

.LIB EDITOR.2

;SCREEN SCROLL ROUTINE
;

Bildschirm scrollen

5 white
28 red
159 cyan
156 purple
30 green
31 blue
158 yellow
129 orange
  color1, white
color2, red
color3, cyan
color4, purple
color5, green
color6, blue
color7, yellow
color8, orange

scroll screen

.,E8EA A5 AC LDA $AC SCROL LDA SAL
Alle
149 brown
150 light red
151 dark grey
152 medium grey
153 light green
154 light blue
155 light grey

scroll the screen

copy the tape buffer start pointer
  color9, brown
colorA, pink
colorB, grey1
colorC, grey2
colorD, light green
colorE, light blue
colorF, grey3

SCROLL SCREEN

This routine scrolls the screen down by one line. If the
top two lines are linked togeather, then the scroll down
is repeated. The screen line link pointers are updated,
each screen line is cleared and the line below is moved
up. The keyboard is directly read from CIA#1, and the
routine tests if <CTRL> is pressed.
temp store SAL on stack
 
.,E8EC 48 PHA PHA
wichtigen
save it
     
.,E8ED A5 AD LDA $AD LDA SAH
Zeiger
copy the tape buffer start pointer
     
.,E8EF 48 PHA PHA
in
save it
     
.,E8F0 A5 AE LDA $AE LDA EAL
den
copy the tape buffer end pointer
  temp store EAL on stack
 
.,E8F2 48 PHA PHA
Stack
save it
     
.,E8F3 A5 AF LDA $AF LDA EAH
schie-
copy the tape buffer end pointer
     
.,E8F5 48 PHA PHA
;
; S C R O L L U P
;
ben
save it
     
.,E8F6 A2 FF LDX #$FF SCRO0 LDX #$FF
ab Zeile Null beginnen
set to -1 for pre increment loop
     
.,E8F8 C6 D6 DEC $D6 DEC TBLX
Cursorzeiger
decrement the cursor row
  decrement TBLX
 
.,E8FA C6 C9 DEC $C9 DEC LSXP
erniedrigen
decrement the input cursor row
  decrement LXSP
 
.,E8FC CE A5 02 DEC $02A5 DEC LINTMP
Fortsetzungszeile erniedrigen
decrement the screen row marker
  temp store for line index
 
.,E8FF E8 INX SCR10 INX ;GOTO NEXT LINE
Zeilennummer erhöhen
increment the line number
     
.,E900 20 F0 E9 JSR $E9F0 JSR SETPNT ;POINT TO 'TO' LINE
Zeiger auf Video-RAM für
Zeile X
fetch a screen address, set the start of line X
  set start of line (X)
 
.,E903 E0 18 CPX #$18 CPX #NLINES-1 ;DONE?
24
compare with last line
     
.,E905 B0 0C BCS $E913 BCS SCR41 ;BRANCH IF SO
;
schon alle Zeilen ?
branch if >= $16
     
.,E907 BD F1 EC LDA $ECF1,X LDA LDTB2+1,X ;SETUP FROM PNTR
LOW-Byte holen
get the start of the next line pointer low byte
  read low-byte screen addresses
 
.,E90A 85 AC STA $AC STA SAL
und speichern
save the next line pointer low byte
     
.,E90C B5 DA LDA $DA,X LDA LDTB1+1,X
HIGH-Byte
get the start of the next line pointer high byte
     
.,E90E 20 C8 E9 JSR $E9C8 JSR SCRLIN ;SCROLL THIS LINE UP1
Bildschirmzeile nach oben
schieben
shift the screen line up
  move a screen line
 
.,E911 30 EC BMI $E8FF BMI SCR10
;
SCR41
nächste Zeile
loop, branch always
     
.,E913 20 FF E9 JSR $E9FF JSR CLRLN
;
unterste Bildschirmzeile
löschen
clear screen line X
now shift up the start of logical line bits
  clear a screen line
 
.,E916 A2 00 LDX #$00 LDX #0 ;SCROLL HI BYTE POINTERS
HIGH-
clear index
     
.,E918 B5 D9 LDA $D9,X SCRL5 LDA LDTB1,X
Bytes
get the start of line X pointer high byte
  calcuate new screen line link table
 
.,E91A 29 7F AND #$7F AND #$7F
und
clear the line X start of logical line bit
  clear bit7
 
.,E91C B4 DA LDY $DA,X LDY LDTB1+1,X
die
get the start of the next line pointer high byte
     
.,E91E 10 02 BPL $E922 BPL SCRL3
Doppel-
if next line is not a start of line skip the start set
     
.,E920 09 80 ORA #$80 ORA #$80
zeilen
set line X start of logical line bit
  set bit7
 
.,E922 95 D9 STA $D9,X SCRL3 STA LDTB1,X
ver-
set start of line X pointer high byte
  store new value in table
 
.,E924 E8 INX INX
schieben
increment line number
  next line
 
.,E925 E0 18 CPX #$18 CPX #NLINES-1
nicht 24 ?,
compare with last line
  till all 25 are done
 
.,E927 D0 EF BNE $E918 BNE SCRL5
;
dann nochmal
loop if not last line
     
.,E929 A5 F1 LDA $F1 LDA LDTB1+NLINES-1
Zeile
get start of last line pointer high byte
  bottom line link
 
.,E92B 09 80 ORA #$80 ORA #$80
als einfache Zeile
mark as start of logical line
  unlink it
 
.,E92D 85 F1 STA $F1 STA LDTB1+NLINES-1
auszeichnen
set start of last line pointer high byte
  and store back
 
.,E92F A5 D9 LDA $D9 LDA LDTB1 ;DOUBLE LINE?
wenn Fortsetzungszeile,
get start of first line pointer high byte
  test top line link
 
.,E931 10 C3 BPL $E8F6 BPL SCRO0 ;YES...SCROLL AGAIN
;
dann nochmal
if not start of logical line loop back and
scroll the screen up another line
  line is linked, scroll again
 
.,E933 E6 D6 INC $D6 INC TBLX
Zeiger auf Cursor erhöhen
increment the cursor row
  increment TBLX
 
.,E935 EE A5 02 INC $02A5 INC LINTMP
Fortsetzungszeile erhöhen
increment screen row marker
     
.,E938 A9 7F LDA #$7F LDA #$7F ;CHECK FOR CONTROL KEY
Kode
set keyboard column c7
     
.,E93A 8D 00 DC STA $DC00 STA COLM ;DROP LINE 2 ON PORT B
für
save VIA 1 DRA, keyboard column drive
     
.,E93D AD 01 DC LDA $DC01 LDA ROWS
Tastaturabfrage
read VIA 1 DRB, keyboard row port
  read keyboard decode column
 
.,E940 C9 FB CMP #$FB CMP #$FB ;SLOW SCROLL KEY?(CONTROL)
CTRL-Taste gedrückt ?
compare with row r2 active, [CTL]
  <CTRL> pressed
 
.,E942 08 PHP PHP ;SAVE STATUS. RESTORE PORT B
Statusregister retten
save status
     
.,E943 A9 7F LDA #$7F LDA #$7F ;FOR STOP KEY CHECK
code für
set keyboard column c7
     
.,E945 8D 00 DC STA $DC00 STA COLM
Tastaturabfrage
save VIA 1 DRA, keyboard column drive
     
.,E948 28 PLP PLP
Statusregister holen
restore status
     
.,E949 D0 0B BNE $E956 BNE MLP42
;
nicht gedrückt ?
skip delay if ??
first time round the inner loop X will be $16
  nope, exit
 
.,E94B A0 00 LDY #$00 LDY #0
Ver-
clear delay outer loop count, do this 256 times
     
.,E94D EA NOP MLP4 NOP ;DELAY
zö-
waste cycles
     
.,E94E CA DEX DEX
geru-
decrement inner loop count
     
.,E94F D0 FC BNE $E94D BNE MLP4
ngs-
loop if not all done
     
.,E951 88 DEY DEY
sch-
decrement outer loop count
     
.,E952 D0 F9 BNE $E94D BNE MLP4
leife
loop if not all done
     
.,E954 84 C6 STY $C6 STY NDX ;CLEAR KEY QUEUE BUFFER
;
Anzahl der gedrückten
Tasten gleich null
clear the keyboard buffer index
  clear NDX
 
.,E956 A6 D6 LDX $D6 MLP42 LDX TBLX
;
alle
get the cursor row
restore the tape buffer pointers and exit
  read TBLX
 
.,E958 68 PLA PULIND PLA ;RESTORE OLD INDIRECTS
benö-
pull tape buffer end pointer
  retrieve EAL
 
.,E959 85 AF STA $AF STA EAH
tigten
restore it
     
.,E95B 68 PLA PLA
Zei-
pull tape buffer end pointer
     
.,E95C 85 AE STA $AE STA EAL
ger
restore it
     
.,E95E 68 PLA PLA
zu-
pull tape buffer pointer
  retrieve SAL
 
.,E95F 85 AD STA $AD STA SAH
rück-
restore it
     
.,E961 68 PLA PLA
ho-
pull tape buffer pointer
     
.,E962 85 AC STA $AC STA SAL
len
restore it
     
.,E964 60 RTS RTS
NEWLIN
Rücksprung

Einfügen einer

Fortsetzungszeile

open up a space on the screen

  exit

OPEN A SPACE ON THE SCREEN

This routine opens a space on the screen for use with
<INST>. If needed, the screen is then scrolled down,
otherwise the screen line is moved and cleared. Finally
the screen line link table is adjusted and updated.

insert blank line in screen

.,E965 A6 D6 LDX $D6 LDX TBLX
Zeiger auf Cursorzeile
get the cursor row
  TBLX, current cursor line number
 
.,E967 E8 INX BMT1 INX
; CPX #NLINES ;EXCEDED THE NUMBER OF LINES ???
; BEQ BMT2 ;VIC-40 CODE
Zeiger erhöhen
increment the row
  test next
 
.,E968 B5 D9 LDA $D9,X LDA LDTB1,X ;FIND LAST DISPLAY LINE OF THIS LINE
untere Zeile gleich
get the start of line X pointer high byte
  LDTB1, screen line link table
 
.,E96A 10 FB BPL $E967 BPL BMT1 ;TABLE END MARK=>$FF WILL ABORT...ALSO
Cursorzeile, dann zu $E967
loop if not start of logical line
     
.,E96C 8E A5 02 STX $02A5 BMT2 STX LINTMP ;FOUND IT
;GENERATE A NEW LINE
Zeilennummer
save the screen row marker
  temp line for index
 
.,E96F E0 18 CPX #$18 CPX #NLINES-1 ;IS ONE LINE FROM BOTTOM?
gleich
compare it with the last line
  bottom of screen
 
.,E971 F0 0E BEQ $E981 BEQ NEWLX ;YES...JUST CLEAR LAST
24
if = last line go ??
  yes
 
.,E973 90 0C BCC $E981 BCC NEWLX ;<NLINES...INSERT LINE
dann zu $E981
if < last line go ??
else it was > last line
  above bottom line
 
.,E975 20 EA E8 JSR $E8EA JSR SCROL ;SCROLL EVERYTHING
Bildschirm scrollen
scroll the screen
  scroll screen down
 
.,E978 AE A5 02 LDX $02A5 LDX LINTMP
Zeilennummer
get the screen row marker
  temp line for index
 
.,E97B CA DEX DEX
erniedrigen
decrement the screen row marker
     
.,E97C C6 D6 DEC $D6 DEC TBLX
Zeiger auf Cursorzeile
erniedrigen
decrement the cursor row
  TBLX
 
.,E97E 4C DA E6 JMP $E6DA JMP WLOG30
Zeile initialisieren
add this row to the current logical line and return
  adjust link table and end
 
.,E981 A5 AC LDA $AC NEWLX LDA SAL
Alle
copy tape buffer pointer
  push SAL, scrolling pointer
 
.,E983 48 PHA PHA
benötigten
save it
     
.,E984 A5 AD LDA $AD LDA SAH
Zeiger
copy tape buffer pointer
     
.,E986 48 PHA PHA
in
save it
     
.,E987 A5 AE LDA $AE LDA EAL
den
copy tape buffer end pointer
  push EAL, end of program
 
.,E989 48 PHA PHA
Stack
save it
     
.,E98A A5 AF LDA $AF LDA EAH
schie-
copy tape buffer end pointer
     
.,E98C 48 PHA PHA
ben
save it
     
.,E98D A2 19 LDX #$19 LDX #NLINES
25
set to end line + 1 for predecrement loop
     
.,E98F CA DEX SCD10 DEX
Zeilennummer
decrement the line number
     
.,E990 20 F0 E9 JSR $E9F0 JSR SETPNT ;SET UP TO ADDR
Zeilen-Zeiger berechnen
fetch a screen address
  set start of line
 
.,E993 EC A5 02 CPX $02A5 CPX LINTMP
alle Zeilen verschoben ?,
compare it with the screen row marker
  temp line for index
 
.,E996 90 0E BCC $E9A6 BCC SCR40
wenn ja,
if < screen row marker go ??
     
.,E998 F0 0C BEQ $E9A6 BEQ SCR40 ;BRANCH IF FINISHED
dann zu $E9A6
if = screen row marker go ??
     
.,E99A BD EF EC LDA $ECEF,X LDA LDTB2-1,X ;SET FROM ADDR
LOW-Byte des Zeilenanfangs
else get the start of the previous line low byte from the
ROM table
  screen line address table
 
.,E99D 85 AC STA $AC STA SAL
setzen
save previous line pointer low byte
  SAL
 
.,E99F B5 D8 LDA $D8,X LDA LDTB1-1,X
HIGH-Byte setzen
get the start of the previous line pointer high byte
  LDTB1
 
.,E9A1 20 C8 E9 JSR $E9C8 JSR SCRLIN ;SCROLL THIS LINE DOWN
Zeile nach oben schieben
shift the screen line down
  move screen line
 
.,E9A4 30 E9 BMI $E98F BMI SCD10
SCR40
Unbedingter Sprung
loop, branch always
     
.,E9A6 20 FF E9 JSR $E9FF JSR CLRLN
Bildschirmzeile löschen
clear screen line X
  clear screen line
 
.,E9A9 A2 17 LDX #$17 LDX #NLINES-2
SCRD21
HIGH-Byte-Tabelle
    fix screen line link table
 
.,E9AB EC A5 02 CPX $02A5 CPX LINTMP ;DONE?
verschieben
compare it with the screen row marker
  temp line for index
 
.,E9AE 90 0F BCC $E9BF BCC SCRD22 ;BRANCH IF SO
alles verschoben ?
       
.,E9B0 B5 DA LDA $DA,X LDA LDTB1+1,X
HIGH-
    LDTB1+1
 
.,E9B2 29 7F AND #$7F AND #$7F
Byte-
       
.,E9B4 B4 D9 LDY $D9,X LDY LDTB1,X ;WAS IT CONTINUED
und
get start of line X pointer high byte
  LDTB1
 
.,E9B6 10 02 BPL $E9BA BPL SCRD19 ;BRANCH IF SO
Doppelzeilen-
       
.,E9B8 09 80 ORA #$80 ORA #$80
Tabelle
       
.,E9BA 95 DA STA $DA,X SCRD19 STA LDTB1+1,X
nach
       
.,E9BC CA DEX DEX
unten schieben
    next line
 
.,E9BD D0 EC BNE $E9AB BNE SCRD21
SCRD22
schon alles ?
    till line zero
 
.,E9BF AE A5 02 LDX $02A5 LDX LINTMP
Zeilennummer
get the screen row marker
  temp line for index
 
.,E9C2 20 DA E6 JSR $E6DA JSR WLOG30
;
MSB neu berechnen
add this row to the current logical line
  adjust link table
 
.,E9C5 4C 58 E9 JMP $E958 JMP PULIND ;GO PUL OLD INDIRECTS AND RETURN
;
; SCROLL LINE FROM SAL TO PNT
; AND COLORS FROM EAL TO USER
;
SCRLIN
Register zurückholen, RTS

Zeile nach oben schieben

restore the tape buffer pointers and exit

shift screen line up/down

  pull SAL and EAL

MOVE A SCREEN LINE

This routine synchronises colour transfer, and then moves
the screen line pointed to down, character by character.
The colour codes for each character are also moved in the
same way.

move one screen line

.,E9C8 29 03 AND #$03 AND #$03 ;CLEAR ANY GARBAGE STUFF
Bildschirmzeiger
mask 0000 00xx, line memory page
     
.,E9CA 0D 88 02 ORA $0288 ORA HIBASE ;PUT IN HIORDER BITS
für neue Zeile
OR with screen memory page
  HIBASE, top of screen page
 
.,E9CD 85 AD STA $AD STA SAL+1
berechnen
save next/previous line pointer high byte
  store >SAL, screen scroll pointer
 
.,E9CF 20 E0 E9 JSR $E9E0 JSR TOFROM ;COLOR TO & FROM ADDRS
Zeiger für neue Zeile
berechnen
calculate pointers to screen lines colour RAM
  synchronise colour transfer
 
.,E9D2 A0 27 LDY #$27 LDY #LLEN-1
SCD20
39 Zeichen
set the column count
  offset for character on screen line
 
.,E9D4 B1 AC LDA ($AC),Y LDA (SAL)Y
alle
get character from next/previous screen line
  move screen character
 
.,E9D6 91 D1 STA ($D1),Y STA (PNT)Y
Zeichen
save character to current screen line
     
.,E9D8 B1 AE LDA ($AE),Y LDA (EAL)Y
und
get colour from next/previous screen line colour RAM
  move character colour
 
.,E9DA 91 F3 STA ($F3),Y STA (USER)Y
Farbe übertragen
save colour to current screen line colour RAM
     
.,E9DC 88 DEY DEY
nächstes Zeichen
decrement column index/count
  next character
 
.,E9DD 10 F5 BPL $E9D4 BPL SCD20
schon alle ?
loop if more to do
  till all 40 are done
 
.,E9DF 60 RTS RTS
;
; DO COLOR TO AND FROM ADDRESSES
; FROM CHARACTER TO AND FROM ADRS
;
TOFROM
Rücksprung

Bildschirmzeile für

Scrollzeile berechnen

calculate pointers to screen lines colour RAM

 

SYNCHRONISE COLOUR TRANSFER

This routine setd up a temporary pointer in EAL to the
colour RAM address that corresponts to the temporary
screen address held in EAL.

set colour and screen addresses

.,E9E0 20 24 EA JSR $EA24 JSR SCOLOR
Zeiger auf Farb-RAM berechnen
calculate the pointer to the current screen line colour
RAM
  synchronise colour pointer
 
.,E9E3 A5 AC LDA $AC LDA SAL ;CHARACTER FROM
Zeiger
get the next screen line pointer low byte
  SAL, pointer for screen scroll
 
.,E9E5 85 AE STA $AE STA EAL ;MAKE COLOR FROM
für Zeile
save the next screen line colour RAM pointer low byte
  EAL
 
.,E9E7 A5 AD LDA $AD LDA SAL+1
speichern
get the next screen line pointer high byte
     
.,E9E9 29 03 AND #$03 AND #$03
Startadresse
mask 0000 00xx, line memory page
     
.,E9EB 09 D8 ORA #$D8 ORA #>VICCOL
des Video-RAM
set 1101 01xx, colour memory page
  setup colour ram to $d800
 
.,E9ED 85 AF STA $AF STA EAL+1
berechnen
save the next screen line colour RAM pointer high byte
     
.,E9EF 60 RTS RTS
;
; SET UP PNT AND Y
; FROM .X
;
Rücksprung

Zeiger auf Video-RAM für

Zeile X

fetch a screen address

 

SET START OF LINE

On entry, (X) holds the line number. The low byte of the
address is set from the ROM table, and the highbyte
derived from the screen link and HIBASE.

fetch screen addresses

.,E9F0 BD F0 EC LDA $ECF0,X SETPNT LDA LDTB2,X
LOW-Byte
get the start of line low byte from the ROM table
  table of screen line to bytes
 
.,E9F3 85 D1 STA $D1 STA PNT
holen
set the current screen line pointer low byte
  <PNT, current screen line address
 
.,E9F5 B5 D9 LDA $D9,X LDA LDTB1,X
HIGH-Byte
get the start of line high byte from the RAM table
  LDTB1, screen line link table
 
.,E9F7 29 03 AND #$03 AND #$03
des
mask 0000 00xx, line memory page
     
.,E9F9 0D 88 02 ORA $0288 ORA HIBASE
Video-
OR with the screen memory page
  HIBASE, page of top screen
 
.,E9FC 85 D2 STA $D2 STA PNT+1
RAM
save the current screen line pointer high byte
  >PNT
 
.,E9FE 60 RTS RTS
;
; CLEAR THE LINE POINTED TO BY .X
;
Rücksprung

Bildschirmzeile X löschen

clear screen line X

 

CLEAR SCREEN LINE

The start of line is set and the screen line is cleared by
filloing it with ASCII spaces. The corresponding line of
colour RAM is also cleared to the value held in COLOR.

clear one screen line

.,E9FF A0 27 LDY #$27 CLRLN LDY #LLEN-1
40-1 Spalten
set number of columns to clear
     
.,EA01 20 F0 E9 JSR $E9F0 JSR SETPNT
Zeilenpointer (D1/D2) setzen
fetch a screen address
  set start of line
 
.,EA04 20 24 EA JSR $EA24 JSR SCOLOR
Pointer (F3/F4) für Farb-RAM
berechnen
calculate the pointer to colour RAM
  synchronise colour pointer
 
.,EA07 A9 20 LDA #$20 CLR10 JSR CPATCH ;REVERSED ORDER FROM 901227-02
Leerzeichen
save the current colour to the colour RAM
  reset character colour, to COLOR
 
.,EA09 91 D1 STA ($D1),Y   ins Video-RAM schreiben
       
.,EA0B 20 DA E4 JSR $E4DA LDA #$20 ;STORE A SPACE
Hintergrundfarbe setzen
set [SPACE]
  ASCII space
 
.,EA0E EA NOP STA (PNT)Y ;TO DISPLAY
DEY
  clear character in current screen line
decrement index
  store character on screen
next
 
.,EA0F 88 DEY BPL CLR10
schon 40 Zeichen gelöscht?
loop if more to do
  till hole line is done
 
.,EA10 10 F5 BPL $EA07   wenn nicht, fortfahren
       
.,EA12 60 RTS RTS
NOP
;
;PUT A CHAR ON THE SCREEN
;
Rücksprung zum Hauptprogramm

orphan byte

unused

print character A and colour X

  free byte

PRINT TO SCREEN

The colour pointer is synchronised, and the character in
(A) directly stored in the screen RAM. The character
colour in (X) is stored at the equivalent point in the
colour RAM.

set cursor flash timing and colour memory addresses

.,EA13 A8 TAY DSPP TAY ;SAVE CHAR
Akku retten
copy the character
  put print character in (Y)
 
.,EA14 A9 02 LDA #$02 LDA #2
  count to $02, usually $14 ??
     
.,EA16 85 CD STA $CD STA BLNCT ;BLINK CURSOR
Blinkzähler bei
Repeatfunktion setzen
save the cursor countdown
  store in BLNCT, timer to toggle cursor
 
.,EA18 20 24 EA JSR $EA24 JSR SCOLOR ;SET COLOR PTR
Pointer für Farb-RAM
berechnen
calculate the pointer to colour RAM
  synchronise colour pointer
 
.,EA1B 98 TYA TYA ;RESTORE COLOR
Akku wieder holen

Zeichen und Farbe auf

Bildschirm setzen

get the character back

save the character and colour to the screen @ the cursor

  print character back to (A)

put a char on the screen

.,EA1C A4 D3 LDY $D3 DSPP2 LDY PNTR ;GET COLUMN
Spaltenposition
get the cursor column
  PNTR, cursor column on line
 
.,EA1E 91 D1 STA ($D1),Y STA (PNT)Y ;CHAR TO SCREEN
Zeichen in Akku auf
Bildschirm
save the character from current screen line
  store character on screen
 
.,EA20 8A TXA TXA
Farb-Code von x in Akku
copy the colour to A
     
.,EA21 91 F3 STA ($F3),Y STA (USER)Y ;COLOR TO SCREEN
in Farb-RAM schreiben
save to colour RAM
  stor character colour
 
.,EA23 60 RTS RTS
Rücksprung zum Hauptprogramm

Zeiger auf Farb-RAM berechnen

calculate the pointer to colour RAM

 

SYNCHRONISE COLOUR POINTER

The pointer to the colour RAM is set up according to the
current screen line address. This is done by reading the
current screen line address and modefying it to colour RAM
pointers and write it to USER at $f3/$f4

set colour memory adress parallel to screen

.,EA24 A5 D1 LDA $D1 SCOLOR LDA PNT ;GENERATE COLOR PTR
$D1/$D2 = Zeiger auf
Video-RAM-Position
get current screen line pointer low byte
  copy screen line low byte
 
.,EA26 85 F3 STA $F3 STA USER
LOW-Byte auf Zeichenposition
= LOW-Byte auf Farbposition
save pointer to colour RAM low byte
  to colour RAM low byte
 
.,EA28 A5 D2 LDA $D2 LDA PNT+1
HIGH-Byte der Zeichenposition
get current screen line pointer high byte
  read'n modify the hi byte
 
.,EA2A 29 03 AND #$03 AND #$03
mit HIGH-Byte der Farb-RAM-
mask 0000 00xx, line memory page
     
.,EA2C 09 D8 ORA #$D8 ORA #>VICCOL ;VIC COLOR RAM
Position = $D8 verknüpfen und
set 1101 01xx, colour memory page
     
.,EA2E 85 F4 STA $F4 STA USER+1
in $F4 = speichern
save pointer to colour RAM high byte
  to suite the colour RAM
 
.,EA30 60 RTS RTS
Rücksprung zum Hauptprogramm

Interrupt-Routine

IRQ vector

 

MAIN IRQ ENTRY POINT

This routine services the normal IRQ that jumps through
the hardware vector to $ff48, and then continues to the
CINV vector at $0314. First it checks if the <STOP> key
was pressed and updates the realtime clock. Next, the
cursor is updated (if it is enabled, BLNSW). The blink
counter, BLNCT, is decremented. When this reaches zero,
the cursor is toggled (blink on/off). Finally it scans
the keyboard. The processor registers are then restored
on exit.

normal IRQ interrupt

.,EA31 20 EA FF JSR $FFEA KEY JSR $FFEA ;UPDATE JIFFY CLOCK
Stop-Taste, Zeit erhöhen
increment the real time clock
  update realtime clock, routine UDTIM
do clock
.,EA34 A5 CC LDA $CC LDA BLNSW ;BLINKING CRSR ?
Blink-Flag für Cursor
get the cursor enable, $00 = flash cursor
  read BLNSW to see if cursor is enabled
flash cursor
.,EA36 D0 29 BNE $EA61 BNE KEY4 ;NO
nicht blinkend, dann weiter
if flash not enabled skip the flash
  nope
 
.,EA38 C6 CD DEC $CD DEC BLNCT ;TIME TO BLINK ?
Blinkzähler erniedrigen
decrement the cursor timing countdown
  read BLNCT
 
.,EA3A D0 25 BNE $EA61 BNE KEY4 ;NO
nicht Null, dann weiter
if not counted out skip the flash
  if zero, toggle cursor - else jump
 
.,EA3C A9 14 LDA #$14 LDA #20 ;RESET BLINK COUNTER
Blinkzähler wieder auf 20
setzen
set the flash count
  blink speed
 
.,EA3E 85 CD STA $CD REPDO STA BLNCT
und speichern
save the cursor timing countdown
  restore BLCNT
 
.,EA40 A4 D3 LDY $D3 LDY PNTR ;CURSOR POSITION
Cursorspalte
get the cursor column
  get PNTR, cursor column
 
.,EA42 46 CF LSR $CF LSR BLNON ;CARRY SET IF ORIGINAL CHAR
Blinkschalter eins dann C=1
shift b0 cursor blink phase into carry
  BLNON, flag last cursor blink on/off
 
.,EA44 AE 87 02 LDX $0287 LDX GDCOL ;GET CHAR ORIGINAL COLOR
Farbe unter Cursor
get the colour under the cursor
  get background colour under cursor, GDCOL
 
.,EA47 B1 D1 LDA ($D1),Y LDA (PNT)Y ;GET CHARACTER
Zeichen-Kode holen
get the character from current screen line
  get screen character
 
.,EA49 B0 11 BCS $EA5C BCS KEY5 ;BRANCH IF NOT NEEDED
;
Blinkschalter war ein, dann
weiter
branch if cursor phase b0 was 1
  ?
 
.,EA4B E6 CF INC $CF INC BLNON ;SET TO 1
Blinkschalter ein
set the cursor blink phase to 1
  increment BLNON
 
.,EA4D 85 CE STA $CE STA GDBLN ;SAVE ORIGINAL CHAR
Zeichen unter Cursor merken
save the character under the cursor
  temporary store character under cursor
 
.,EA4F 20 24 EA JSR $EA24 JSR SCOLOR
Zeiger in Farb-RAM berechnen
calculate the pointer to colour RAM
  synchronise colour pointer
 
.,EA52 B1 F3 LDA ($F3),Y LDA (USER)Y ;GET ORIGINAL COLOR
Farb-Code holen
get the colour RAM byte
  get colour under character
 
.,EA54 8D 87 02 STA $0287 STA GDCOL ;SAVE IT
und merken
save the colour under the cursor
  store in GDCOL
 
.,EA57 AE 86 02 LDX $0286 LDX COLOR ;BLINK IN THIS COLOR
Farb-Code unter Cursor
get the current colour code
  get current COLOR
 
.,EA5A A5 CE LDA $CE LDA GDBLN ;WITH ORIGINAL CHARACTER
;
Zeichen unter Cursor holen
get the character under the cursor
  retrieve character under cursor
 
.,EA5C 49 80 EOR #$80 KEY5 EOR #$80 ;BLINK IT
RVS-Bit umdrehen
toggle b7 of character under cursor
  toggle cursor by inverting character
 
.,EA5E 20 1C EA JSR $EA1C JSR DSPP2 ;DISPLAY IT
;
Zeichen und Farbe setzen
save the character and colour to the screen @ the cursor
  print to screen by using part of 'print to screen'
display cursor
.,EA61 A5 01 LDA $01 KEY4 LDA R6510 ;GET CASSETTE SWITCHES
Prozessorport laden
read the 6510 I/O port
    checl cassette sense
.,EA63 29 10 AND #$10 AND #$10 ;IS SWITCH DOWN ?
prüft Rekorder-Taste
mask 000x 0000, the cassette switch sense
     
.,EA65 F0 0A BEQ $EA71 BEQ KEY3 ;BRANCH IF SO
;
gedrückt, dann verzweige
if the cassette sense is low skip the motor stop
the cassette sense was high, the switch was open, so turn
off the motor and clear the interlock
     
.,EA67 A0 00 LDY #$00 LDY #0
Wert für keine Taste gedrückt
clear Y
     
.,EA69 84 C0 STY $C0 STY CAS1 ;CASSETTE OFF SWITCH
;
Rekorder-Flag setzen
clear the tape motor interlock
     
.,EA6B A5 01 LDA $01 LDA R6510
Prozessorport laden
read the 6510 I/O port
     
.,EA6D 09 20 ORA #$20 ORA #$20
Rekoder-Motor ausschalten
mask xxxx xx1x, turn off the motor
     
.,EA6F D0 08 BNE $EA79 BNE KL24 ;BRANCH IF MOTOR IS OFF
;
unbedingter Sprung
go save the port value, branch always
the cassette sense was low so turn the motor on, perhaps
     
.,EA71 A5 C0 LDA $C0 KEY3 LDA CAS1
lade Rekorder-Flag
get the tape motor interlock
     
.,EA73 D0 06 BNE $EA7B BNE KL2
;
verzweige, wenn Motor läuft
if the cassette interlock <> 0 don't turn on motor
     
.,EA75 A5 01 LDA $01 LDA R6510
Prozessorport laden
read the 6510 I/O port
     
.,EA77 29 1F AND #$1F AND #%011111 ;TURN MOTOR ON
;
KL24
Rekorder-Motor einschalten
mask xxxx xx0x, turn on the motor
     
.,EA79 85 01 STA $01 STA R6510
;
und wieder speichern
save the 6510 I/O port
     
.,EA7B 20 87 EA JSR $EA87 KL2 JSR SCNKEY ;SCAN KEYBOARD
;
Tastaturabfrage
scan the keyboard
  scan keyboard
scan keyboard
.,EA7E AD 0D DC LDA $DC0D KPREND LDA D1ICR ;CLEAR INTERUPT FLAGS
IRQ-Flag löschen
read VIA 1 ICR, clear the timer interrupt flag
  clear CIA#1 I.C.R to enable next IRQ
 
.,EA81 68 PLA PLA ;RESTORE REGISTERS
Accu aus dem Stapel holen
pull Y
  restore (Y), (X), (A)
 
.,EA82 A8 TAY TAY
und in Y-Register schieben
restore Y
     
.,EA83 68 PLA PLA
Accu aus dem Stapel holen
pull X
     
.,EA84 AA TAX TAX
und in X-Register schieben
restore X
     
.,EA85 68 PLA PLA
und Rückkehr vom Interrupt
restore A
     
.,EA86 40 RTI RTI ;EXIT FROM IRQ ROUTINES
; ****** GENERAL KEYBOARD SCAN ******
;

Tastaturabfrage

scan keyboard performs the following ..

1) check if key pressed, if not then exit the routine
2) init I/O ports of VIA ?? for keyboard scan and set pointers to decode table 1.
clear the character counter
3) set one line of port B low and test for a closed key on port A by shifting the
byte read from the port. if the carry is clear then a key is closed so save the
count which is incremented on each shift. check for shift/stop/cbm keys and
flag if closed
4) repeat step 3 for the whole matrix
5) evaluate the SHIFT/CTRL/C= keys, this may change the decode table selected
6) use the key count saved in step 3 as an index into the table selected in step 5
7) check for key repeat operation
8) save the decoded key to the buffer if first press or repeat
scan the keyboard
  back to normal

SCNKEY: SCAN KEYBOARD

The KERNAL routine SCNKEY ($ff9f) jumps to this routine.
First, the shift-flag, SHFLAG, is cleared, and the
keyboard tested for nokey. The keyboard is set up as a
8 * 8 matrix, and is read one row at a time. $ff indicates
that no key has been pressed, and a zerobit, that one key
has been pressed.

scan keyboard

.,EA87 A9 00 LDA #$00 SCNKEY LDA #$00
  clear A
     
.,EA89 8D 8D 02 STA $028D STA SHFLAG
Shift/CTRL Flag rücksetzen
clear the keyboard shift/control/c= flag
  clear SHFLAG
 
.,EA8C A0 40 LDY #$40 LDY #64 ;LAST KEY INDEX
$40 = keine Taste gedrückt
set no key
     
.,EA8E 84 CB STY $CB STY SFDX ;NULL KEY FOUND
Kode für gedrückte Taste
save which key
     
.,EA90 8D 00 DC STA $DC00 STA COLM ;RAISE ALL LINES
alle Bits des Port A löschen
clear VIA 1 DRA, keyboard column drive
  store in keyboard write register
 
.,EA93 AE 01 DC LDX $DC01 LDX ROWS ;CHECK FOR A KEY DOWN
Port B laden
read VIA 1 DRB, keyboard row port
  keyboard read register
 
.,EA96 E0 FF CPX #$FF CPX #$FF ;NO KEYS DOWN?
keine Taste gedrückt ?
compare with all bits set
  no key pressed
 
.,EA98 F0 61 BEQ $EAFB BEQ SCNOUT ;BRANCH IF NONE
dann beenden
if no key pressed clear current key and exit (does
further BEQ to $EBBA)
  skip
 
.,EA9A A8 TAY TAY ;.A=0 LDY #0
Y-Register löschen
clear the key count
     
.,EA9B A9 81 LDA #$81 LDA #<MODE1
  get the decode table low byte
  point KEYTAB vector to $eb81
 
.,EA9D 85 F5 STA $F5 STA KEYTAB
$F5/$F6 = Zeiger auf
save the keyboard pointer low byte
     
.,EA9F A9 EB LDA #$EB LDA #>MODE1
Tastaturtabelle setzen
get the decode table high byte
     
.,EAA1 85 F6 STA $F6 STA KEYTAB+1
  save the keyboard pointer high byte
     
.,EAA3 A9 FE LDA #$FE LDA #$FE ;START WITH 1ST COLUMN
erstes Bit für erste
Matrixzeile löschen
set column 0 low
  bit0 = 0
 
.,EAA5 8D 00 DC STA $DC00 STA COLM
und in Port A schreiben
save VIA 1 DRA, keyboard column drive
  will test first row in matrix
 
.,EAA8 A2 08 LDX #$08 SCN20 LDX #8 ;8 ROW KEYBOARD
8 Matrixzeilen
set the row count
  scan 8 rows in matrix
 
.,EAAA 48 PHA PHA ;SAVE COLUMN OUTPUT INFO
Bitstellung für Matrix retten
save the column
  temp store
 
.,EAAB AD 01 DC LDA $DC01 SCN22 LDA ROWS
Port B laden und
read VIA 1 DRB, keyboard row port
  read
 
.,EAAE CD 01 DC CMP $DC01 CMP ROWS ;DEBOUNCE KEYBOARD
Tastatur entprellen
compare it with itself
  wait for value to settle (key bouncing)
 
.,EAB1 D0 F8 BNE $EAAB BNE SCN22
noch nicht entprellt ?
loop if changing
     
.,EAB3 4A LSR SCN30 LSR A ;LOOK FOR KEY DOWN
Bits nacheinander ins Carry
schieben
shift row to Cb
  test bit0
 
.,EAB4 B0 16 BCS $EACC BCS CKIT ;NONE
'1' gleich nicht gedrückt
if no key closed on this row go do next row
  no key pressed
 
.,EAB6 48 PHA PHA
Bitstelung retten
save row
     
.,EAB7 B1 F5 LDA ($F5),Y LDA (KEYTAB),Y ;GET CHAR CODE
ASCII-Kode aus Tabelle holen
get character from decode table
  get key from KEYTAB
 
.,EAB9 C9 05 CMP #$05 CMP #$05
größer als 4, dann keine
Control-Taste
compare with $05, there is no $05 key but the control
keys are all less than $05
  value less than 5
 
.,EABB B0 0C BCS $EAC9 BCS SPCK2 ;IF NOT SPECIAL KEY GO ON
verzweige bei größer/gleich 5
if not shift/control/c=/stop go save key count
else was shift/control/c=/stop key
  nope
 
.,EABD C9 03 CMP #$03 CMP #$03 ;COULD IT BE A STOP KEY?
Kode für STOP-Taste ?
compare with $03, stop
  value = 3
 
.,EABF F0 08 BEQ $EAC9 BEQ SPCK2 ;BRANCH IF SO
falls ja, dann verzweige
if stop go save key count and continue
character is $01 - shift, $02 - c= or $04 - control
  nope
 
.,EAC1 0D 8D 02 ORA $028D ORA SHFLAG
entsprechendes Flag für SHIFT
OR it with the keyboard shift/control/c= flag
     
.,EAC4 8D 8D 02 STA $028D STA SHFLAG ;PUT SHIFT BIT IN FLAG BYTE
COMMOD.-Taste oder CTRL
setzen
save the keyboard shift/control/c= flag
  store in SHFLAG
 
.,EAC7 10 02 BPL $EACB BPL CKUT
SPCK2
unbedingter Sprung
skip save key, branch always
     
.,EAC9 84 CB STY $CB STY SFDX ;SAVE KEY NUMBER
Nummer der Taste merken
save key count
  store keynumber we pressed in SFDX
 
.,EACB 68 PLA CKUT PLA
Akku holen
restore row
     
.,EACC C8 INY CKIT INY
Zähler für Taste erhöhen
increment key count
  key counter
 
.,EACD C0 41 CPY #$41 CPY #65
schon alle Tasten?
compare with max+1
  all 64 keys (8*8)
 
.,EACF B0 0B BCS $EADC BCS CKIT1 ;BRANCH IF FINISHED
wenn ja, verzweige
exit loop if >= max+1
else still in matrix
  jump if ready
 
.,EAD1 CA DEX DEX
nächste Matrix-Spalte
decrement row count
  next key in row
 
.,EAD2 D0 DF BNE $EAB3 BNE SCN30
unbedingter Sprung
loop if more rows to do
  row ready
 
.,EAD4 38 SEC SEC
Carry setzen
set carry for keyboard column shift
  prepare for rol
 
.,EAD5 68 PLA PLA ;RELOAD COLUMN INFO
gespeicherte Bitfolge holen
restore the column
     
.,EAD6 2A ROL ROL A
verschieben und
shift the keyboard column
  next row
 
.,EAD7 8D 00 DC STA $DC00 STA COLM ;NEXT COLUMN ON KEYBOARD
in Port A schreiben
save VIA 1 DRA, keyboard column drive
  store bit
 
.,EADA D0 CC BNE $EAA8 BNE SCN20 ;ALWAYS BRANCH
unbedingter Sprung
loop for next column, branch always
  always jump
 
.,EADC 68 PLA CKIT1 PLA ;DUMP COLUMN OUTPUT...ALL DONE
Stapel normalisieren
dump the saved column
  clean up

PROCESS KEY IMAGE

This routine decodes the pressed key, and calcuates its
ASCII value, by use of the four tables. If the pressed key
is the same key as in the former interrupt, then the key-
repeat-section is entered. The routine tests the RPTFLG if
he key shall repeat. The new key is stored in the keyboard
buffer, and all pointers are uppdated.
 
.,EADD 6C 8F 02 JMP ($028F) JMP (KEYLOG) ;EVALUATE SHIFT FUNCTIONS
JMP $EB48 setzt Zeiger auf
Tabelle
evaluate the SHIFT/CTRL/C= keys, $EBDC
key decoding continues here after the SHIFT/CTRL/C= keys are evaluated
  jump through KEYLOG vector, points to $eae0
 
.,EAE0 A4 CB LDY $CB REKEY LDY SFDX ;GET KEY INDEX
Nummer der Taste
get saved key count
  SFDX, number of the key we pressed
 
.,EAE2 B1 F5 LDA ($F5),Y LDA (KEYTAB)Y ;GET CHAR CODE
ASCII-Wert aus Tabelle
holen
get character from decode table
  get ASCII value from decode table
 
.,EAE4 AA TAX TAX ;SAVE THE CHAR
Tastenwert retten
copy character to X
  temp store
 
.,EAE5 C4 C5 CPY $C5 CPY LSTX ;SAME AS PREV CHAR INDEX?
mit letzter Taste
vergleichen
compare key count with last key count
  same key as former interrupt
 
.,EAE7 F0 07 BEQ $EAF0 BEQ RPT10 ;YES
verzweige wenn gleiche Taste
if this key = current key, key held, go test repeat
  yepp
 
.,EAE9 A0 10 LDY #$10 LDY #$10 ;NO - RESET DELAY BEFORE REPEAT
Wert für Repeatverzögerung
set the repeat delay count
  restore the repeat delay counter
 
.,EAEB 8C 8C 02 STY $028C STY DELAY
in Repeat-Verzögerungszähler
save the repeat delay count
  DELAY
 
.,EAEE D0 36 BNE $EB26 BNE CKIT2 ;ALWAYS
unbedingter Sprung
go save key to buffer and exit, branch always
  always jump
 
.,EAF0 29 7F AND #$7F RPT10 AND #$7F ;UNSHIFT IT
Bit 7 löschen
clear b7
     
.,EAF2 2C 8A 02 BIT $028A BIT RPTFLG ;CHECK FOR REPEAT DISABLE
Repeat-Funktion für alle
Tasten ?
test key repeat
  RPTFLG, test repeat mode
 
.,EAF5 30 16 BMI $EB0D BMI RPT20 ;YES
Bit 7 gesetzt, dann alle
Tasten wiederholen
if repeat all go ??
  repeat all keys
 
.,EAF7 70 49 BVS $EB42 BVS SCNRTS
Bit 6 gesetzt, dann
keine Wiederholung
if repeat none go ??
  repeat none - exit routine
 
.,EAF9 C9 7F CMP #$7F CMP #$7F ;NO KEYS ?
keine Taste?
compare with end marker
     
.,EAFB F0 29 BEQ $EB26 SCNOUT BEQ CKIT2 ;YES - GET OUT
ja, dann verzweige
if $00/end marker go save key to buffer and exit
     
.,EAFD C9 14 CMP #$14 CMP #$14 ;AN INST/DEL KEY ?
'DEL', 'INST' Kode
compare with [INSERT]/[DELETE]
  <DEL> key pressed
delete
.,EAFF F0 0C BEQ $EB0D BEQ RPT20 ;YES - REPEAT IT
wenn ja, verzweige
if [INSERT]/[DELETE] go test for repeat
  yepp...
 
.,EB01 C9 20 CMP #$20 CMP #$20 ;A SPACE KEY ?
Leerzeichen
compare with [SPACE]
  <space> key pressed
space
.,EB03 F0 08 BEQ $EB0D BEQ RPT20 ;YES
wenn ja, verzweige
if [SPACE] go test for repeat
  yepp...
 
.,EB05 C9 1D CMP #$1D CMP #$1D ;A CRSR LEFT/RIGHT ?
Cursor right, left
compare with [CURSOR RIGHT]
  <CRSR LEFT/RIGHT>
csr right/left
.,EB07 F0 04 BEQ $EB0D BEQ RPT20 ;YES
wenn ja, verzweige
if [CURSOR RIGHT] go test for repeat
  yepp..
 
.,EB09 C9 11 CMP #$11 CMP #$11 ;A CRSR UP/DWN ?
Cursor down, up
compare with [CURSOR DOWN]
  <CRSRS DOWN/UP>
csr up/down
.,EB0B D0 35 BNE $EB42 BNE SCNRTS ;NO - EXIT
verzweige wenn keine Taste
zu wiederholen ist
if not [CURSOR DOWN] just exit
was one of the cursor movement keys, insert/delete
key or the space bar so always do repeat tests
  yepp..
 
.,EB0D AC 8C 02 LDY $028C RPT20 LDY DELAY ;TIME TO REPEAT ?
Repeatverzögerungszähler
get the repeat delay counter
  DELAY
 
.,EB10 F0 05 BEQ $EB17 BEQ RPT40 ;YES
wenn abgelaufen, so verzweige
if delay expired go ??
  skip
 
.,EB12 CE 8C 02 DEC $028C DEC DELAY
herunterzählen
else decrement repeat delay counter
  decrement DELAY
 
.,EB15 D0 2B BNE $EB42 BNE SCNRTS
0? nein dann verzweige
if delay not expired go ??
repeat delay counter has expired
  end
 
.,EB17 CE 8B 02 DEC $028B RPT40 DEC KOUNT ;TIME FOR NEXT REPEAT ?
Repeatgeschwindigkeitszähler
decrement the repeat speed counter
  decremant KOUNT, repeat speed counter
 
.,EB1A D0 26 BNE $EB42 BNE SCNRTS ;NO
0? nein dann verzweige
branch if repeat speed count not expired
  end
 
.,EB1C A0 04 LDY #$04 LDY #4 ;YES - RESET CTR
Repeatgeschwindigkeits-
set for 4/60ths of a second
     
.,EB1E 8C 8B 02 STY $028B STY KOUNT
zähler neu setzen
save the repeat speed counter
  init KOUNT
 
.,EB21 A4 C6 LDY $C6 LDY NDX ;NO REPEAT IF QUEUE FULL
Anzahl der Zeichen im
Tastaturpuffer
get the keyboard buffer index
  read NDX, number of keys in keyboard queue
 
.,EB23 88 DEY DEY
herunterzählen
decrement it
     
.,EB24 10 1C BPL $EB42 BPL SCNRTS
CKIT2
mehr als ein Zeichen im
Puffer, dann ignorieren
if the buffer isn't empty just exit
else repeat the key immediately
possibly save the key to the keyboard buffer. if there was no key pressed or the key
was not found during the scan (possibly due to key bounce) then X will be $FF here
  end
 
.,EB26 A4 CB LDY $CB LDY SFDX ;GET INDEX OF KEY
Tastennummermatrixcode
get the key count
  read SFDX
 
.,EB28 84 C5 STY $C5 STY LSTX ;SAVE THIS INDEX TO KEY FOUND
umspeichern
save it as the current key count
  store in LSTX
 
.,EB2A AC 8D 02 LDY $028D LDY SHFLAG ;UPDATE SHIFT STATUS
sowie die Flags für SHIFT
get the keyboard shift/control/c= flag
  read SHFLAG
 
.,EB2D 8C 8E 02 STY $028E STY LSTSHF
COMMOD.-Taste und CTRL
save it as last keyboard shift pattern
  store in LSTSHF, last keyboard shift pattern
 
.,EB30 E0 FF CPX #$FF CKIT3 CPX #$FF ;A NULL KEY OR NO KEY ?
Tastatur-Kode ungültig ?
compare the character with the table end marker or no key
  no valid key pressed
 
.,EB32 F0 0E BEQ $EB42 BEQ SCNRTS ;BRANCH IF SO
ja, dann ignorieren
if it was the table end marker or no key just exit
  end
 
.,EB34 8A TXA TXA ;NEED X AS INDEX SO...
gerettete Taste wieder holen
copy the character to A
     
.,EB35 A6 C6 LDX $C6 LDX NDX ;GET # OF CHARS IN KEY QUEUE
Anzahl der Zeichen im
Tastaturpuffer
get the keyboard buffer index
  NDX, number of keys in buffer
 
.,EB37 EC 89 02 CPX $0289 CPX XMAX ;IRQ BUFFER FULL ?
mit Haximalzahl vergleichen
compare it with the keyboard buffer size
  compare to XMAX, max numbers oc characters in buffer
 
.,EB3A B0 06 BCS $EB42 BCS SCNRTS ;YES - NO MORE INSERT
PUTQUE
Puffer voll, dann Zeichen
ignorieren
if the buffer is full just exit
  buffer is full, end
 
.,EB3C 9D 77 02 STA $0277,X STA KEYD,X ;PUT RAW DATA HERE
Zeichen in Tastaturpuffer
schreiben
save the character to the keyboard buffer
  store new character in keyboard buffer
 
.,EB3F E8 INX INX
Zeichenanzahl erhöhen und
increment the index
  increment counter
 
.,EB40 86 C6 STX $C6 STX NDX ;UPDATE KEY QUEUE COUNT
abspeichern
save the keyboard buffer index
  and store in NDX
 
.,EB42 A9 7F LDA #$7F SCNRTS LDA #$7F ;SETUP PB7 FOR STOP KEY SENSE
Tastatur-Matrix Abfrage
enable column 7 for the stop key
     
.,EB44 8D 00 DC STA $DC00 STA COLM
auf Normalwert
save VIA 1 DRA, keyboard column drive
  keyboard write register
 
.,EB47 60 RTS RTS
;
; SHIFT LOGIC
;
SHFLOG
Rücksprung

Prüft auf Shift, CTRL,

Commodore

evaluate the SHIFT/CTRL/C= keys

  exit
 
.,EB48 AD 8D 02 LDA $028D LDA SHFLAG
Flag für Shift/CTRL
get the keyboard shift/control/c= flag
  SHFLAG
 
.,EB4B C9 03 CMP #$03 CMP #$03 ;COMMODORE SHIFT COMBINATION?
SHIFT und COMMOD.-Taste
gedrückt?
compare with [SHIFT][C=]
  <SHIFT> and <CBM> at the same time
 
.,EB4D D0 15 BNE $EB64 BNE KEYLG2 ;BRANCH IF NOT
nein dann zum Dekodieren
if not [SHIFT][C=] go ??
  nope
 
.,EB4F CD 8E 02 CMP $028E CMP LSTSHF ;DID I DO THIS ALREADY
waren beide Tasten vorher
schon vorher gedrückt
compare with last
  same as LSTSHF
 
.,EB52 F0 EE BEQ $EB42 BEQ SCNRTS ;BRANCH IF SO
ja, dann zum Ende
exit if still the same
  if so, end
 
.,EB54 AD 91 02 LDA $0291 LDA MODE
Shift-Commodore erlaubt ?
get the shift mode switch $00 = enabled, $80 = locked
  read MODE, shift key enable flag
 
.,EB57 30 1D BMI $EB76 BMI SHFOUT ;DONT SHIFT IF ITS MINUS
nein, zurück zur
Dekodierung
if locked continue keyboard decode
toggle text mode
  end
 
.,EB59 AD 18 D0 LDA $D018 SWITCH LDA VICREG+24 ;**********************************:
Zeichensatzzeiger laden
get the start of character memory address
  VIC memory control register
 
.,EB5C 49 02 EOR #$02 EOR #$02 ;TURN ON OTHER CASE
Umschaltung Klein
-Großschreibung und
toggle address b1
  toggle character set, upper/lower case
 
.,EB5E 8D 18 D0 STA $D018 STA VICREG+24 ;POINT THE VIC THERE
wieder speichern
save the start of character memory address
  and store
 
.,EB61 4C 76 EB JMP $EB76 JMP SHFOUT
;
KEYLG2
fertig
continue the keyboard decode
select keyboard table
  process key image

select keyboard table

.,EB64 0A ASL ASL A
Wert mit 2 multiplizieren,
da jede Adresse 2 Bytes hat
<< 1
     
.,EB65 C9 08 CMP #$08 CMP #$08 ;WAS IT A CONTROL KEY
vergleiche mit CTRL
compare with [CTRL]
  test <CTRL>
 
.,EB67 90 02 BCC $EB6B BCC NCTRL ;BRANCH IF NOT
nein dann verzweige
if [CTRL] is not pressed skip the index change
  nope
 
.,EB69 A9 06 LDA #$06 LDA #6 ;ELSE USE TABLE #4
;
NCTRL
NOTKAT
Tabellenpointer für CTRL
else [CTRL] was pressed so make the index = $06
  set offset for ctrl
 
.,EB6B AA TAX TAX
in X Register übertragen
copy the index to X
  to (X)
 
.,EB6C BD 79 EB LDA $EB79,X LDA KEYCOD,X
LOW-Byte der Tabellenadresse
laden
get the decode table pointer low byte
  read keyboard select vectors, low byte
 
.,EB6F 85 F5 STA $F5 STA KEYTAB
und in die Zeigeradresse
LOW schreiben
save the decode table pointer low byte
  store in KEYTAB, decode table vector
 
.,EB71 BD 7A EB LDA $EB7A,X LDA KEYCOD+1,X
HIGH-Byte der Tabellenadresse
laden
get the decode table pointer high byte
  read keyboard select vectors, high byte
 
.,EB74 85 F6 STA $F6 STA KEYTAB+1
SHFOUT
und in die Zeigeradresse
HIGH schreiben
save the decode table pointer high byte
  KEYTAB+1
 
.,EB76 4C E0 EA JMP $EAE0 JMP REKEY
.END

.LIB EDITOR.3

KEYCOD ;KEYBOARD MODE 'DISPATCH'
.WORD MODE1
.WORD MODE2
.WORD MODE3
zurück zur Dekodierung

Zeiger auf Tastatur-

Dekodiertabellen

continue the keyboard decode

table addresses

  process key image

KEYBOARD SELECT VECTORS

This is a table of vectors pointing to the start of the
four keyboard decode tables.

table addresses

.:EB79 81 EB C2 EB 03 EC 78 EC .WORD CONTRL ;CONTROL KEYS
;
; COTTACONNA MODE
;
;.WORD MODE1 ;PET MODE1
;.WORD MODE2 ;PET MODE2
;.WORD CCTTA3 ;DUMMY WORD
;.WORD CONTRL
;
; EXTENDED KATAKANA MODE
;
;.WORD CCTTA2 ;KATAKANA CHARACTERS
;.WORD CCTTA3 ;LIMITED GRAPHICS
;.WORD CCTTA3 ;DUMMY
;.WORD CONTRL
MODE1
;DEL,3,5,7,9,+,YEN SIGN,1

Tastatur-Dekodiertabelle 1

ungeshifted

standard
  vector to unshifted keyboard, $eb81
standard
.:EB81 14 0D 1D 88 85 86 87 11 .BYT $14,$0D,$1D,$88,$85,$86,$87,$11
;RETURN,W,R,Y,I,P,*,LEFT ARROW
  shift
commodore
control

standard keyboard table

  vector to shifted keyboard, $ebc2
vector to cbm keyboard, $ec03
vector to ctrl keyboard, $ec78

KEYBOARD 1 - UNSHIFTED

This is the first of four keybboard decode tables. The
ASCII code for the key pressed is at the intersection of
the row (written to $dc00) and the column (read from
$dc01). The matrix values are shown below. Note that left
and right shift keys are seperated.
shift
commodore key
control

standard keyboard table

.:EB89 33 57 41 34 5A 53 45 01 .BYT $33,$57,$41,$34,$5A,$53,$45,$01
;RT CRSR,A,D,G,J,L,;,CTRL
         
.:EB91 35 52 44 36 43 46 54 58 .BYT $35,$52,$44,$36,$43,$46,$54,$58
;F4,4,6,8,0,-,HOME,2
         
.:EB99 37 59 47 38 42 48 55 56 .BYT $37,$59,$47,$38,$42,$48,$55,$56
;F1,Z,C,B,M,.,R.SHIFTT,SPACE
         
.:EBA1 39 49 4A 30 4D 4B 4F 4E .BYT $39,$49,$4A,$30,$4D,$4B,$4F,$4E
;F2,S,F,H,K,:,=,COM.KEY
         
.:EBA9 2B 50 4C 2D 2E 3A 40 2C .BYT $2B,$50,$4C,$2D,$2E,$3A,$40,$2C
;F3,E,T,U,O,@,EXP,Q
         
.:EBB1 5C 2A 3B 13 01 3D 5E 2F .BYT $5C,$2A,$3B,$13,$01,$3D,$5E,$2F
;CRSR DWN,L.SHIFT,X,V,N,,,/,STOP
         
.:EBB9 31 5F 04 32 20 02 51 03 .BYT $31,$5F,$04,$32,$20,$02,$51,$03
         
.:EBC1 FF .BYT $FF ;END OF TABLE NULL
MODE2 ;SHIFT
;INS,%,',),+,YEN,!

Tastatur-Dekodierung,

Tabelle 2 geshifted

shifted keyboard table

  free byte

KEYBOARD 2 - SHIFTED

This is the second of four keyboard decode tables. The
ASCII code for the key pressed is at the intersection of
the row (written to $dc00) and the column (read from
$dc01). The matrix values are shown below.

shift keyboard table

.:EBC2 94 8D 9D 8C 89 8A 8B 91 .BYT $94,$8D,$9D,$8C,$89,$8A,$8B,$91
;SRETURN,W,R,Y,I,P,*,SLEFT ARROW
         
.:EBCA 23 D7 C1 24 DA D3 C5 01 .BYT $23,$D7,$C1,$24,$DA,$D3,$C5,$01
;LF.CRSR,A,D,G,J,L,;,CTRL
         
.:EBD2 25 D2 C4 26 C3 C6 D4 D8 .BYT $25,$D2,$C4,$26,$C3,$C6,$D4,$D8
;,$,&,(, ,"
         
.:EBDA 27 D9 C7 28 C2 C8 D5 D6 .BYT $27,$D9,$C7,$28,$C2,$C8,$D5,$D6
;F5,Z,C,B,M,.,R.SHIFT,SSPACE
         
.:EBE2 29 C9 CA 30 CD CB CF CE .BYT $29,$C9,$CA,$30,$CD,$CB,$CF,$CE
;F6,S,F,H,K,:,=,SCOM.KEY
         
.:EBEA DB D0 CC DD 3E 5B BA 3C .BYT $DB,$D0,$CC,$DD,$3E,$5B,$BA,$3C
;F7,E,T,U,O,@,PI,G
         
.:EBF2 A9 C0 5D 93 01 3D DE 3F .BYT $A9,$C0,$5D,$93,$01,$3D,$DE,$3F
;CRSR DWN,L.SHIFT,X,V,N,,,/,RUN
         
.:EBFA 21 5F 04 22 A0 02 D1 83 .BYT $21,$5F,$04,$22,$A0,$02,$D1,$83
         
.:EC02 FF .BYT $FF ;END OF TABLE NULL
;
MODE3 ;LEFT WINDOW GRAHPICS
;INS,C10,C12,C14,9,+,POUND SIGN,C8

Tastatur-Dekodierung,

Tabelle 3, mit 'C='-Taste

CBM key keyboard table

  free byte

KEYBOARD 3 - COMMODORE

This is the third of four keyboard decode tables. The
ASCII code for the key pressed is at the intersection of
the ro (written to $dc00) and hte column (read from
$dc01). The matrix values are shown below.

commodore key keyboard table

.:EC03 94 8D 9D 8C 89 8A 8B 91 .BYT $94,$8D,$9D,$8C,$89,$8A,$8B,$91
;RETURN,W,R,Y,I,P,*,LFT.ARROW
         
.:EC0B 96 B3 B0 97 AD AE B1 01 .BYT $96,$B3,$B0,$97,$AD,$AE,$B1,$01
;LF.CRSR,A,D,G,J,L,;,CTRL
         
.:EC13 98 B2 AC 99 BC BB A3 BD .BYT $98,$B2,$AC,$99,$BC,$BB,$A3,$BD
;F8,C11,C13,C15,0,-,HOME,C9
         
.:EC1B 9A B7 A5 9B BF B4 B8 BE .BYT $9A,$B7,$A5,$9B,$BF,$B4,$B8,$BE
;F2,Z,C,B,M,.,R.SHIFT,SPACE
         
.:EC23 29 A2 B5 30 A7 A1 B9 AA .BYT $29,$A2,$B5,$30,$A7,$A1,$B9,$AA
;F4,S,F,H,K,:,=,COM.KEY
         
.:EC2B A6 AF B6 DC 3E 5B A4 3C .BYT $A6,$AF,$B6,$DC,$3E,$5B,$A4,$3C
;F6,E,T,U,O,@,PI,Q
         
.:EC33 A8 DF 5D 93 01 3D DE 3F .BYT $A8,$DF,$5D,$93,$01,$3D,$DE,$3F
;CRSR.UP,L.SHIFT,X,V,N,,,/,STOP
         
.:EC3B 81 5F 04 95 A0 02 AB 83 .BYT $81,$5F,$04,$95,$A0,$02,$AB,$83
         
.:EC43 FF .BYT $FF ;END OF TABLE NULL
;CCTTA2 ;WAS CCTTA2 IN JAPANESE VERSION
LOWER

prüft auf Steuerzeichen

check for special character codes

  free byte

GRAPHICS / TEXT CONTROL

This routine is used to toggle between text and graphics
character set, and to enable/disable the <shift-CBM> keys.
The routine is called by the main 'output to screen'
routine, and (A) holds a CBM ASCII code on entry.

check for special petscii codes

.,EC44 C9 0E CMP #$0E CMP #$0E ;DOES HE WANT LOWER CASE?
chr$(14) Großschrift
compare with [SWITCH TO LOWER CASE]
  <switch to lower case>
 
.,EC46 D0 07 BNE $EC4F BNE UPPER ;BRANCH IF NOT
verzweige wenn nein
if not [SWITCH TO LOWER CASE] skip the switch
  nope
 
.,EC48 AD 18 D0 LDA $D018 LDA VICREG+24 ;ELSE SET VIC TO POINT TO LOWER CASE
Character-Generator
get the start of character memory address
  VIC memory control register
 
.,EC4B 09 02 ORA #$02 ORA #$02
auf Großschrift-Modus
mask xxxx xx1x, set lower case characters
  set bit1
 
.,EC4D D0 09 BNE $EC58 BNE ULSET ;JMP
UPPER
unbedingter Sprung
go save the new value, branch always
check for special character codes except fro switch to lower case
  allways branch
 
.,EC4F C9 8E CMP #$8E CMP #$8E ;DOES HE WANT UPPER CASE
chr$(142) Kleinschrift
compare with [SWITCH TO UPPER CASE]
  <switch to upper case>
 
.,EC51 D0 0B BNE $EC5E BNE LOCK ;BRANCH IF NOT
verzweige wenn nein
if not [SWITCH TO UPPER CASE] go do the [SHIFT]+[C=] key
check
  nope
 
.,EC53 AD 18 D0 LDA $D018 LDA VICREG+24 ;MAKE SURE VIC POINT TO UPPER/PET SET
Character-Generator
get the start of character memory address
  VIC memory control register
 
.,EC56 29 FD AND #$FD AND #$FF-$02
Kleinschrift-Modus
mask xxxx xx0x, set upper case characters
  clear bit1
 
.,EC58 8D 18 D0 STA $D018 ULSET STA VICREG+24
setzen
save the start of character memory address
  and store
 
.,EC5B 4C A8 E6 JMP $E6A8 OUTHRE JMP LOOP2
LOCK
Ausgabe abschließen
restore the registers, set the quote flag and exit
do the [SHIFT]+[C=] key check
  finish screen print

shift + commodore key check

.,EC5E C9 08 CMP #$08 CMP #8 ;DOES HE WANT TO LOCK IN THIS MODE?
chr$(8) Code zur Blockierung
SHIFT und COMMOD.-Taste
compare with disable [SHIFT][C=]
  <disable <shift-CBM>>
 
.,EC60 D0 07 BNE $EC69 BNE UNLOCK ;BRANCH IF NOT
verzweige wenn nein
if not disable [SHIFT][C=] skip the set
  nope
 
.,EC62 A9 80 LDA #$80 LDA #$80 ;ELSE SET LOCK SWITCH ON
oberstes Bit des
set to lock shift mode switch
     
.,EC64 0D 91 02 ORA $0291 ORA MODE ;DON'T HURT ANYTHING - JUST IN CASE
Shift-Commodore Flags setzen
OR it with the shift mode switch
  disable MODE
 
.,EC67 30 09 BMI $EC72 BMI LEXIT
UNLOCK
unbedingter Sprung
go save the value, branch always
  allways jump
 
.,EC69 C9 09 CMP #$09 CMP #9 ;DOES HE WANT TO UNLOCK THE KEYBOARD?
chr$(9) Code zur Freigabe von
SHIFT und COMMOD.-Taste
compare with enable [SHIFT][C=]
  <enable <shift-CBM>>
 
.,EC6B D0 EE BNE $EC5B BNE OUTHRE ;BRANCH IF NOT
verzweige wenn nein
exit if not enable [SHIFT][C=]
  nope, exit
 
.,EC6D A9 7F LDA #$7F LDA #$7F ;CLEAR THE LOCK SWITCH
oberstes Bit des
set to unlock shift mode switch
     
.,EC6F 2D 91 02 AND $0291 AND MODE ;DONT HURT ANYTHING
Shift-Commodore Flags löschen
AND it with the shift mode switch
  enable MODE
 
.,EC72 8D 91 02 STA $0291 LEXIT STA MODE
Wert speichern
save the shift mode switch $00 = enabled, $80 = locked
  store MODE, enable/disable shift keys
 
.,EC75 4C A8 E6 JMP $E6A8 JMP LOOP2 ;GET OUT
;CCTTA3
;.BYT $04,$FF,$FF,$FF,$FF,$FF,$E2,$9D
;RUN-K24-K31
;.BYT $83,$01,$FF,$FF,$FF,$FF,$FF,$91
;K32-K39.F5
;.BYT $A0,$FF,$FF,$FF,$FF,$EE,$01,$89
;CO.KEY,K40-K47.F6
;.BYT $02,$FF,$FF,$FF,$FF,$E1,$FD,$8A
;K48-K55
;.BYT $FF,$FF,$FF,$FF,$FF,$B0,$E0,$8B
;K56-K63
;.BYT $F2,$F4,$F6,$FF,$F0,$ED,$93,$8C
;.BYT $FF ;END OF TABLE NULL
CONTRL
;NULL,RED,PURPLE,BLUE,RVS ,NULL,NULL,BLACK
Ausgabe abschließen

Tastaturdekodierung,

Tabelle 4, mit CTRL-Taste

restore the registers, set the quote flag and exit

control keyboard table

  finish screen print

KEYBOARD 4 - CONTROL

This is the last keyboard decode table. The ASCII code for
the key pressed is at the intersection of the row (written
to $dc00) and the column (read from $dc01). The matrix
values are shown below.
A few special function are found in this table ie.
<ctrl H> - disables the upper/lower case switch
<ctrl I> - enables the upper/lower case switch
<ctrl S> - homes the cursor
<ctrl T> - delets character
Note that the italic keys only represent a ASCII code, and
not a CBM character.

control keyboard table

.:EC78 FF FF FF FF FF FF FF FF .BYT $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
;NULL, W ,REVERSE, Y , I , P ,NULL,MUSIC
         
.:EC80 1C 17 01 9F 1A 13 05 FF .BYT $1C,$17,$01,$9F,$1A,$13,$05,$FF
         
.:EC88 9C 12 04 1E 03 06 14 18 .BYT $9C,$12,$04,$1E,$03,$06,$14,$18
;NULL,CYAN,GREEN,YELLOW,RVS OFF,NULL,NULL,WHITE
         
.:EC90 1F 19 07 9E 02 08 15 16 .BYT $1F,$19,$07,$9E,$02,$08,$15,$16
         
.:EC98 12 09 0A 92 0D 0B 0F 0E .BYT $12,$09,$0A,$92,$0D,$0B,$0F,$0E
         
.:ECA0 FF 10 0C FF FF 1B 00 FF .BYT $FF,$10,$0C,$FF,$FF,$1B,$00,$FF
         
.:ECA8 1C FF 1D FF FF 1F 1E FF .BYT $1C,$FF,$1D,$FF,$FF,$1F,$1E,$FF
         
.:ECB0 90 06 FF 05 FF FF 11 FF .BYT $90,$06,$FF,$05,$FF,$FF,$11,$FF
         
.:ECB8 FF .BYT $FF ;END OF TABLE NULL
TVIC
.BYT 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ;SPRITES (0-16)
.BYT $1B,0,0,0,0,$08,0,$14,0,0,0,0,0,0,0 ;DATA (17-31)

Konstanten für

Videocontroller

vic ii chip initialisation values

  free byte

VIDEO CHIP SET UP TABLE

This is a table of the initial values for the VIC chip
registers at start up.

default values for VIC chip

.:ECB9 00 00 00 00 00 00 00 00 .BYT 14,6,1,2,3,4,0,1,2,3,4,5,6,7 ;32-46
;
  sprite 0 x,y
  $d000/1, sprite0 - x,y cordinate
sprite 1 x,y
.:ECC1 00 00 00 00 00 00 00 00     sprite 1 x,y
sprite 2 x,y
sprite 3 x,y
sprite 4 x,y
  $d002/3, sprite1 - x,y cordinate
$d004/5, sprite2 - x,y cordinate
$d006/7, sprite3 - x,y cordinate
$d008/9, sprite4 - x,y cordinate
sprite 2 x,y
sprite 3 x,y
sprite 4 x,y
sprite 5 x,y
.:ECC9 00 9B 37 00 00 00 08 00     sprite 5 x,y
sprite 6 x,y
sprite 7 x,y
sprites 0 to 7 x bit 8
  $d00a/b, sprite5 - x,y cordinate
$d00c/d, sprite6 - x,y cordinate
$d00e/f, sprite7 - x,y cordinate
$d010, sprite MSB
sprite 6 x,y
sprite 7 x,y
sprite 8 x,y
.:ECD1 14 0F 00 00 00 00 00 00     enable screen, enable 25 rows
vertical fine scroll and control
bit function
--- -------
7 raster compare bit 8
6 1 = enable extended color text mode
5 1 = enable bitmap graphics mode
4 1 = enable screen, 0 = blank screen
3 1 = 25 row display, 0 = 24 row display
2-0 vertical scroll count
raster compare
light pen x
light pen y
sprite 0 to 7 enable
enable 40 column display
horizontal fine scroll and control
bit function
--- -------
7-6 unused
5 1 = vic reset, 0 = vic on
4 1 = enable multicolor mode
3 1 = 40 column display, 0 = 38 column display
2-0 horizontal scroll count
sprite 0 to 7 y expand
memory control
bit function
--- -------
7-4 video matrix base address
3-1 character data base address
0 unused
  $d011, VIC control register
$d012,
$d013/4, light pen x/y position
$d015, sprite enable
$d016, VIC control register 2
$d017, sprite y-expansion
$d018, VIC memory control register
sprite Y expand
.:ECD9 0E 06 01 02 03 04 00 01     clear all interrupts
interrupt flags
7 1 = interrupt
6-4 unused
3 1 = light pen interrupt
2 1 = sprite to sprite collision interrupt
1 1 = sprite to foreground collision interrupt
0 1 = raster compare interrupt
all vic IRQs disabeld
IRQ enable
bit function
--- -------
7-4 unused
3 1 = enable light pen
2 1 = enable sprite to sprite collision
1 1 = enable sprite to foreground collision
0 1 = enable raster compare
sprite 0 to 7 foreground priority
sprite 0 to 7 multicolour
sprite 0 to 7 x expand
sprite 0 to 7 sprite collision
sprite 0 to 7 foreground collision
border colour
  $d019, VIC irq flag register
$d01a, VIC irq mask register
$d01b, sprite/background priority
$d01c, sprite multicolour mode
$d01d, sprite x-expansion
$d01e, sprite/sprite collision
$d01f, sprite/background collision
$d020, border colour (light blue)
sprite multi-colour
sprite X expand
boarder colour
.:ECE1 02 03 04 05 06 07  

Text nach Drücken von SHIFT

RUN/STOP

background colour 0
background colour 1
background colour 2
background colour 3
sprite multicolour 0
sprite multicolour 1
sprite 0 colour
sprite 1 colour
  $d021, background colour 0 (blue)
$d022, background colour 1
$d023, background colour 2
$d024, background colour 3
$d025, sprite multicolour register 0
$d026, sprite multicolour register 1
$d027, sprite0 colour
$d028, sprite1 colour
background colour
sprite colour
sprite colour
sprite colour
.:ECE7 4C 4F 41 44 0D 52 55 4E RUNTB .BYT 'LOAD',$D,'RUN',$D
;
LINZ0 = VICSCN
LINZ1 = LINZ0+LLEN
LINZ2 = LINZ1+LLEN
LINZ3 = LINZ2+LLEN
LINZ4 = LINZ3+LLEN
LINZ5 = LINZ4+LLEN
LINZ6 = LINZ5+LLEN
LINZ7 = LINZ6+LLEN
LINZ8 = LINZ7+LLEN
LINZ9 = LINZ8+LLEN
LINZ10 = LINZ9+LLEN
LINZ11 = LINZ10+LLEN
LINZ12 = LINZ11+LLEN
LINZ13 = LINZ12+LLEN
LINZ14 = LINZ13+LLEN
LINZ15 = LINZ14+LLEN
LINZ16 = LINZ15+LLEN
LINZ17 = LINZ16+LLEN
LINZ18 = LINZ17+LLEN
LINZ19 = LINZ18+LLEN
LINZ20 = LINZ19+LLEN
LINZ21 = LINZ20+LLEN
LINZ22 = LINZ21+LLEN
LINZ23 = LINZ22+LLEN
LINZ24 = LINZ23+LLEN
;****** SCREEN LINES LO BYTE TABLE ******
;
LDTB2
.BYTE <LINZ0
.BYTE <LINZ1
.BYTE <LINZ2
.BYTE <LINZ3
.BYTE <LINZ4
.BYTE <LINZ5
.BYTE <LINZ6
.BYTE <LINZ7
.BYTE <LINZ8
.BYTE <LINZ9
.BYTE <LINZ10
.BYTE <LINZ11
.BYTE <LINZ12
.BYTE <LINZ13
.BYTE <LINZ14
.BYTE <LINZ15
.BYTE <LINZ16
.BYTE <LINZ17
.BYTE <LINZ18
.BYTE <LINZ19
.BYTE <LINZ20
.BYTE <LINZ21
.BYTE <LINZ22
.BYTE <LINZ23
'load (cr) run (cr)'
sprite 2 colour
sprite 3 colour
sprite 4 colour
sprite 5 colour
sprite 6 colour
sprite 7 colour is actually the first character of "LOAD" ($4C)

keyboard buffer for auto load/run

'load (cr) run (cr)'
  $d029, sprite2 colour
$d02a, sprite3 colour
$d02b, sprite4 colour
$d02c, sprite5 colour
$d02d, sprite6 colour

SHIFT-RUN EQUIVALENT

This is the message LOAD <CR> RUN <CR>, which is placed in
the keyboard buffer when <shift-RUN> is pressed.
LOAD <CR> RUN <CR>
sprite colour
sprite colour
sprite colour
sprite colour
sprite colour

load

run

.:ECEA 44 0D 52 55 4E 0D  

Tabelle der LSB der

Bildschirmzeilen-Anfänge

low bytes of screen line addresses

     
.:ECF0 00 28 50 78 A0 C8 F0 18 .BYTE <LINZ24
.END

.LIB SERIAL4.0

;COMMAND SERIAL BUS DEVICE TO TALK
;
     

LOW BYTE SCREEN LINE ADDRESSES

This is a table of the low bytes of screen line addresses.
The high byte of the addresses is obtained by derivation
from the page on which the screen starts. There was an
additional table of high byte addresses on the fixed
screen PETs.

low bytes of screen line addresses

.:ECF8 40 68 90 B8 E0 08 30 58            
.:ED00 80 A8 D0 F8 20 48 70 98            
.:ED08 C0  

IEC-Bus Routinen

TALK senden

command serial bus device to TALK

 

TALK: SEND 'TALK' / 'LISTEN'

The KERNAL routine TALK ($ffb4) and LISTEN ($ffb1) are
vectored here. The routine sends the command 'TALK' or
'LISTEN' on the serial bus. On entry (A) must hold the
device number to which the command will be sent. The two
entry points differ only in that to TALK, (A) is ORed with
#$40, and to LISTEN, (A) is ORed with #$20. The UNTALK
(#$3f) and UNLISTEN (#$5f) are also sent via this routine,
but their values are set on entry. If there is a character
waiting to go out on the bus, then this is output.
Handshaking is performed, and ATN (attension) is set low
so that the byte is interpreted as a command. The routine
drops through to the next one to output the byte on the
serial bus. Note that on conclusion, ATN must be set high.

send talk on serial bus

.,ED09 09 40 ORA #$40 TALK ORA #$40 ;MAKE A TALK ADR
Bit für Talk setzen
OR with the TALK command
  set TALK flag
 
.:ED0B 2C .BYTE $2C .BYT $2C ;SKIP TWO BYTES
;COMMAND SERIAL BUS DEVICE TO LISTEN
;
Skip nach $ED0E

LISTEN senden

makes next line BIT $2009

command devices on the serial bus to LISTEN

  bit $2009, mask ORA command

send listen on serial bus

.,ED0C 09 20 ORA #$20 LISTN ORA #$20 ;MAKE A LISTEN ADR
Bit für Listen setzen
OR with the LISTEN command
  set LISTEN flag
 
.,ED0E 20 A4 F0 JSR $F0A4 JSR RSP232 ;PROTECT SELF FROM RS232 NMI'S
Ende der RS 232 Übertragung
abwarten
check RS232 bus idle

send a control character

  check serial bus idle
 
.,ED11 48 PHA LIST1 PHA
;
;
Akku merken
save device address
     
.,ED12 24 94 BIT $94 BIT C3P0 ;CHARACTER LEFT IN BUF?
Noch Zeichen im Puffer ?
test deferred character flag
  C3PO, character in serial buffer
 
.,ED14 10 0A BPL $ED20 BPL LIST2 ;NO...
;
;SEND BUFFERED CHARACTER
;
verzweige wenn nein
if no defered character continue
  nope
 
.,ED16 38 SEC SEC ;SET EOI FLAG
Carry setzen
else flag EOI
  prepare for ROR
 
.,ED17 66 A3 ROR $A3 ROR R2D2
;
Bit für EOI setzen
rotate into EOI flag byte
  temp data area
 
.,ED19 20 40 ED JSR $ED40 JSR ISOUR ;SEND LAST CHARACTER
;
Byte auf IEC-Bus ausgeben
Tx byte on serial bus
  send data to serial bus
 
.,ED1C 46 94 LSR $94 LSR C3P0 ;BUFFER CLEAR FLAG
Flag für Zeichen im Puffer
löschen
clear deferred character flag
  3CPO
 
.,ED1E 46 A3 LSR $A3 LSR R2D2 ;CLEAR EOI FLAG
;
;
Flag für EOI löschen
clear EOI flag
     
.,ED20 68 PLA LIST2 PLA ;TALK/LISTEN ADDRESS
Akku wiederholen und
restore the device address

defer a command

     
.,ED21 85 95 STA $95 STA BSOUR
im Puffer speichern
save as serial defered character
  BSOUR, buffered character for bus
 
.,ED23 78 SEI SEI
Interruptflag setzen
disable the interrupts
     
.,ED24 20 97 EE JSR $EE97 JSR DATAHI
DATA auf LOW setzen
set the serial data out high
  set data 1, and clear serial bit count
 
.,ED27 C9 3F CMP #$3F CMP #$3F ;CLKHI ONLY ON UNLISTEN
Akku kann nicht $3F sein
compare read byte with $3F
  UNTALK?
 
.,ED29 D0 03 BNE $ED2E BNE LIST5
unbedingter Sprung
branch if not $3F, this branch will always be taken as
after VIA 2's PCR is read it is ANDed with $DF, so the
result can never be $3F ??
  nope
 
.,ED2B 20 85 EE JSR $EE85 JSR CLKHI
;
CLOCK auf LOW setzen
set the serial clock out high
  set CLK 1
 
.,ED2E AD 00 DD LDA $DD00 LIST5 LDA D2PRA ;ASSERT ATTENTION
Port A laden
read VIA 2 DRA, serial port and video address
  serial bus I/O port
 
.,ED31 09 08 ORA #$08 ORA #$08
ATN HIGH setzen und
mask xxxx 1xxx, set serial ATN low
  clear ATN, prepare for command
 
.,ED33 8D 00 DD STA $DD00 STA D2PRA
;
ausgeben
save VIA 2 DRA, serial port and video address
if the code drops through to here the serial clock is low and the serial data has been
released so the following code will have no effect apart from delaying the first byte
by 1ms
set the serial clk/data, wait and Tx byte on the serial bus
  store
 
.,ED36 78 SEI ISOURA SEI
InterruptfLag setzen
disable the interrupts
  disable interrupts
 
.,ED37 20 8E EE JSR $EE8E JSR CLKLO ;SET CLOCK LINE LOW
CLOCK auf HIGH setzen
set the serial clock out low
  set CLK 1
 
.,ED3A 20 97 EE JSR $EE97 JSR DATAHI
DATA auf LOW setzen
set the serial data out high
  set data 1
 
.,ED3D 20 B3 EE JSR $EEB3 JSR W1MS ;DELAY 1 MS
eine Millisekunde warten

ein Byte auf IEC-Bus

ausgeben

1ms delay

Tx byte on serial bus

  delay 1 ms

SEND DATA ON SERIAL BUS

The byte of data to be output on the serial bus must have
been previously stored in the serial buffer, BSOUR. An
initial test is made for bus activity, and if none is
detected then ST is set to #$80, ie. ?DEVICE NOT PRESENT.
The byte is output by rotating it right and sending the
state of the carry flag. This is done eight times until
the whole byte was sent. The CIA timer is set to 65 ms and
the bus is checked for 'data accepted'. If timeout occurs
before this happens then ST is set to #$03, ie. write
timeout.

send byte from $95 on serial bus

.,ED40 78 SEI ISOUR SEI ;NO IRQ'S ALLOWED
Interruptflag setzen
disable the interrupts
  disable interrupts
 
.,ED41 20 97 EE JSR $EE97 JSR DATAHI ;MAKE SURE DATA IS RELEASED
DATA auf LOW setzen
set the serial data out high
  set data 1
 
.,ED44 20 A9 EE JSR $EEA9 JSR DEBPIA ;DATA SHOULD BE LOW
Hardware-Rückmeldung aus
DATA holen
get the serial data status in Cb
  get serial in and clock
 
.,ED47 B0 64 BCS $EDAD BCS NODEV
DATA LOW, dann 'DEVICE NOT
PRESENT'
if the serial data is high go do 'device not present'
  no activity, device not present.
 
.,ED49 20 85 EE JSR $EE85 JSR CLKHI ;CLOCK LINE HIGH
CLOCK auf LOW setzen
set the serial clock out high
  set CLK 1
 
.,ED4C 24 A3 BIT $A3 BIT R2D2 ;EOI FLAG TEST
Bit für EOI gesetzt?
test the EOI flag
  temp data area
 
.,ED4E 10 0A BPL $ED5A BPL NOEOI
; DO THE EOI
nein, dann verzweige
if not EOI go ??
I think this is the EOI sequence so the serial clock has been released and the serial
data is being held low by the peripheral. first up wait for the serial data to rise
     
.,ED50 20 A9 EE JSR $EEA9 ISR02 JSR DEBPIA ;WAIT FOR DATA TO GO HIGH
DATA ins Carry
get the serial data status in Cb
  get serial in and clock
 
.,ED53 90 FB BCC $ED50 BCC ISR02
;
warten bis Listener bereit
loop if the data is low
now the data is high, EOI is signalled by waiting for at least 200us without pulling
the serial clock line low again. the listener should respond by pulling the serial
data line low
  wait for indata = 0
 
.,ED55 20 A9 EE JSR $EEA9 ISR03 JSR DEBPIA ;WAIT FOR DATA TO GO LOW
DATA ins Carry
get the serial data status in Cb
  get serial in and clock
 
.,ED58 B0 FB BCS $ED55 BCS ISR03
;
warten auf DATA HIGH
loop if the data is high
the serial data has gone low ending the EOI sequence, now just wait for the serial
data line to go high again or, if this isn't an EOI sequence, just wait for the serial
data to go high the first time
  wait for indata = 1
 
.,ED5A 20 A9 EE JSR $EEA9 NOEOI JSR DEBPIA ;WAIT FOR DATA HIGH
DATA ins Carry
get the serial data status in Cb
  get serial in and clock
 
.,ED5D 90 FB BCC $ED5A BCC NOEOI
warten bis bereit für Daten
loop if the data is low
serial data is high now pull the clock low, preferably within 60us
  wait for indata = 0
 
.,ED5F 20 8E EE JSR $EE8E JSR CLKLO ;SET CLOCK LOW
;
; SET TO SEND DATA
;
CLOCK auf HIGH setzen
set the serial clock out low
now the C64 has to send the eight bits, LSB first. first it sets the serial data line
to reflect the bit in the byte, then it sets the serial clock to high. The serial
clock is left high for 26 cycles, 23us on a PAL Vic, before it is again pulled low
and the serial data is allowed high again
  set CLK 0
 
.,ED62 A9 08 LDA #$08 LDA #$08 ;COUNT 8 BITS
Bitzähler für serielle
eight bits to do
  output 8 bits
 
.,ED64 85 A5 STA $A5 STA COUNT
;
ISR01
Ausgabe setzen ($08 Bits)
set serial bus bit count
     
.,ED66 AD 00 DD LDA $DD00 LDA D2PRA ;DEBOUNCE THE BUS
Port A lesen
read VIA 2 DRA, serial port and video address
     
.,ED69 CD 00 DD CMP $DD00 CMP D2PRA
und entprellen
compare it with itself
     
.,ED6C D0 F8 BNE $ED66 BNE ISR01
verzweige wenn Änderung
if changed go try again
     
.,ED6E 0A ASL ASL A ;SET THE FLAGS
Datenbit ins Carry
shift the serial data into Cb
     
.,ED6F 90 3F BCC $EDB0 BCC FRMERR ;DATA MUST BE HI
;
DATA HIGH, dann 'TIME OUT'
if the serial data is low go do serial bus timeout
     
.,ED71 66 95 ROR $95 ROR BSOUR ;NEXT BIT INTO CARRY
nächstes Bit zur Ausgabe
bereitstellen
rotate the transmit byte
  BSOUR, buffered character for bus
 
.,ED73 B0 05 BCS $ED7A BCS ISRHI
verzweige wenn Bit gesetzt
if the bit = 1 go set the serial data out high
  prepare to output 1
 
.,ED75 20 A0 EE JSR $EEA0 JSR DATALO
DATA auf HIGH setzen
else set the serial data out low
  else, serial output 0
 
.,ED78 D0 03 BNE $ED7D BNE ISRCLK
unbedingter Sprung
continue, branch always
     
.,ED7A 20 97 EE JSR $EE97 ISRHI JSR DATAHI
DATA auf LOW setzen
set the serial data out high
     
.,ED7D 20 85 EE JSR $EE85 ISRCLK JSR CLKHI ;CLOCK HI
CLOCK auf LOW setzen
set the serial clock out high
     
.,ED80 EA NOP NOP
Listener
waste ..
     
.,ED81 EA NOP NOP
8 Microsekunden Zeit zur
.. a ..
     
.,ED82 EA NOP NOP
Verarbeitung der
.. cycle ..
     
.,ED83 EA NOP NOP
Daten geben
.. or two
     
.,ED84 AD 00 DD LDA $DD00 LDA D2PRA
Port A laden
read VIA 2 DRA, serial port and video address
     
.,ED87 29 DF AND #$DF AND #$FF-$20 ;DATA HIGH
DATA auf LOW
mask xx0x xxxx, set the serial data out high
     
.,ED89 09 10 ORA #$10 ORA #$10 ;CLOCK LOW
und CLOCK auf HIGH
mask xxx1 xxxx, set the serial clock out low
     
.,ED8B 8D 00 DD STA $DD00 STA D2PRA
setzen
save VIA 2 DRA, serial port and video address
     
.,ED8E C6 A5 DEC $A5 DEC COUNT
nächstes Bit
decrement the serial bus bit count
  decrement bit counter
 
.,ED90 D0 D4 BNE $ED66 BNE ISR01
mache weiter wenn noch nicht
alle Bits gesendet
loop if not all done
now all eight bits have been sent it's up to the peripheral to signal the byte was
received by pulling the serial data low. this should be done within one milisecond
  next bit till all 8 are done
 
.,ED92 A9 04 LDA #$04 LDA #$04 ;SET TIMER FOR 1MS
$04 als Timerwert setzen
wait for up to about 1ms
     
.,ED94 8D 07 DC STA $DC07 STA D1T2H
Timer B HIGH, ca. eine ms
save VIA 1 timer B high byte
  CIA timer B, high byte
 
.,ED97 A9 19 LDA #$19 LDA #TIMRB ;TRIGGER TIMER
und Timer B
load timer B, timer B single shot, start timer B
     
.,ED99 8D 0F DC STA $DC0F STA D1CRB
starten
save VIA 1 CRB
  set 1 shot, load and start CIA timer B
 
.,ED9C AD 0D DC LDA $DC0D LDA D1ICR ;CLEAR THE TIMER FLAGS<<<<<<<<<<<<<
Interrupt control register
read VIA 1 ICR
  CIA ICR
 
.,ED9F AD 0D DC LDA $DC0D ISR04 LDA D1ICR
laden
read VIA 1 ICR
     
.,EDA2 29 02 AND #$02 AND #$02
Timer B abgelaufen ?
mask 0000 00x0, timer A interrupt
  timeout
 
.,EDA4 D0 0A BNE $EDB0 BNE FRMERR
ja, dann 'TIME OUT'
if timer A interrupt go do serial bus timeout
  yep, flag write timeout
 
.,EDA6 20 A9 EE JSR $EEA9 JSR DEBPIA
DATA ins Carry
get the serial data status in Cb
  get serial in and clock
 
.,EDA9 B0 F4 BCS $ED9F BCS ISR04
warten auf DATA HIGH
if the serial data is high go wait some more
     
.,EDAB 58 CLI CLI ;LET IRQ'S CONTINUE
Interruptflag löschen
enable the interrupts
  enable interrupts
 
.,EDAC 60 RTS RTS
;
NODEV ;DEVICE NOT PRESENT ERROR
Rücksprung
device not present
 

FLAG ERRORS

(A) is loaded with one of the two error flags, depending
on the entry point. #$80 signifies the device was not
present, and #$03 signifies a write timeout. The value is
then set into the I/O status word, ST. The routine exits
by clearing ATN and giving the final handshake.
 
.,EDAD A9 80 LDA #$80 LDA #$80
'DEVICE NOT PRESENT'
error $80, device not present
  flag ?DEVICE NOT PRESENT
 
.:EDAF 2C .BYTE $2C .BYT $2C
FRMERR ;FRAMING ERROR
Skip nach $EDB2
makes next line BIT $03A9
timeout on serial bus
  mask LDA #$03
 
.,EDB0 A9 03 LDA #$03 LDA #$03
'TIME OUT'
error $03, read timeout, write timeout
  flag write timeout
 
.,EDB2 20 1C FE JSR $FE1C CSBERR JSR UDST ;COMMODORE SERIAL BUSS ERROR ENTRY
Status setzen
OR into the serial status byte
  set I/O status word
 
.,EDB5 58 CLI CLI ;IRQ'S WERE OFF...TURN ON
Interruptflag löschen
enable the interrupts
     
.,EDB6 18 CLC CLC ;MAKE SURE NO KERNAL ERROR RETURNED
Carry setzen
clear for branch
     
.,EDB7 90 4A BCC $EE03 BCC DLABYE ;TURN ATN OFF ,RELEASE ALL LINES
;
;SEND SECONDARY ADDRESS AFTER LISTEN
;
unbedingter Sprung

Sekundäradresse nach LISTEN

senden

ATN high, delay, clock high then data high, branch always

send secondary address after LISTEN

  allways jump, do final handshake

SECOND: SEND LISTEN SA

The KERNAL routine SECOND ($ff93) is vectored here. On
entry, (A) holds the secondary address. This is placed in
the serial buffer and sent to the serial bus "under
attension". Finally the routine drops through to the next
routine to set ATN false.

send secondary address (listen) on serial bus

.,EDB9 85 95 STA $95 SECND STA BSOUR ;BUFFER CHARACTER
Sekundäradresse speichern
save the defered Tx byte
  store (A) in BSOUT, buffer for the serial bus
 
.,EDBB 20 36 ED JSR $ED36 JSR ISOURA ;SEND IT
;RELEASE ATTENTION AFTER LISTEN
;
mit ATN HIGH ausgeben
set the serial clk/data, wait and Tx the byte

set serial ATN high

  handshake and send byte.

CLEAR ATN

The ATN, attension, line on the serial bus is set to 1,
ie. ATN is now false and data sent on the serial bus will
not be interpreted as a command.
 
.,EDBE AD 00 DD LDA $DD00 SCATN LDA D2PRA
Port A laden
read VIA 2 DRA, serial port and video address
  serial bus I/O port
 
.,EDC1 29 F7 AND #$F7 AND #$FF-$08
ATN rücksetzen, LOW
mask xxxx 0xxx, set serial ATN high
  clear bit4, ie. ATN 1
 
.,EDC3 8D 00 DD STA $DD00 STA D2PRA ;RELEASE ATTENTION
und ausgeben
save VIA 2 DRA, serial port and video address
  store to port
 
.,EDC6 60 RTS RTS
;TALK SECOND ADDRESS
;
Rücksprung

Sekundäradresse nach TALK

ausgeben

send secondary address after TALK

 

TKSA: SEND TALK SA

The KERNAL routine TKSA ($ff96) is vectored here. On
entry, (A) holds the secondary address. This is placed in
the serial buffer and sent out to the serial bus "under
attension". The routine drops through to the next routine
to wait for CLK and clear ATN.

send secondary address (talk) on serial bus

.,EDC7 85 95 STA $95 TKSA STA BSOUR ;BUFFER CHARACTER
Sekundäradresse speichern
save the defered Tx byte
  BSOUR, the serial bus buffer
 
.,EDC9 20 36 ED JSR $ED36 JSR ISOURA ;SEND SECOND ADDR
TKATN ;SHIFT OVER TO LISTENER
mit ATN ausgeben
set the serial clk/data, wait and Tx the byte

wait for the serial bus end after send

return address from patch 6
  handshake and send byte to the bus

WAIT FOR CLOCK

This routine sets data = 0, ATN = 1 and CLK = 1. It then
waits to recieve CLK = 0 from the serial bus.
 
.,EDCC 78 SEI SEI ;NO IRQ'S HERE
Interruptflag setzen
disable the interrupts
  disable interrupts
 
.,EDCD 20 A0 EE JSR $EEA0 JSR DATALO ;DATA LINE LOW
DATA auf HIGH setzen
set the serial data out low
  set data 0
 
.,EDD0 20 BE ED JSR $EDBE JSR SCATN
ATN rücksetzen, LOW
set serial ATN high
  set ATN 1
 
.,EDD3 20 85 EE JSR $EE85 JSR CLKHI ;CLOCK LINE HIGH JSR/RTS
CLOCK auf LOW setzen
set the serial clock out high
  set CLK 1
 
.,EDD6 20 A9 EE JSR $EEA9 TKATN1 JSR DEBPIA ;WAIT FOR CLOCK TO GO LOW
CLOCK-IN holen
get the serial data status in Cb
  read serial bus I/O port
 
.,EDD9 30 FB BMI $EDD6 BMI TKATN1
auf CLOCK HIGH warten
loop if the clock is high
  test bit6, and wait for CLK = 0
 
.,EDDB 58 CLI CLI ;IRQ'S OKAY NOW
Interruptflag löschen
enable the interrupts
  enable interrupt
 
.,EDDC 60 RTS RTS
;BUFFERED OUTPUT TO SERIAL BUS
;
Rücksprung

IECOUT ein Byte auf IEC-Bus

ausgeben

output a byte to the serial bus

 

CIOUT: SEND SERIAL DEFERRED

The KERNAL routine CIOUT ($ffa8) jumps to this routine.
The output flag, C3PO is set (ie. bit 7 = 1) and the
contents of (A) is placed in the serial buffer.

output byte on serial bus

.,EDDD 24 94 BIT $94 CIOUT BIT C3P0 ;BUFFERED CHAR?
noch ein Byte auszugeben ?
test the deferred character flag
  C3PO flag, character in serial buffer
 
.,EDDF 30 05 BMI $EDE6 BMI CI2 ;YES...SEND LAST
;
verzweige wenn ja
if there is a defered character go send it
  yes
 
.,EDE1 38 SEC SEC ;NO...
Carry setzen
set carry
  prepare for ROR
 
.,EDE2 66 94 ROR $94 ROR C3P0 ;SET BUFFERED CHAR FLAG
Flag für gepuffertes Byte
setzen
shift into the deferred character flag
  set C3PO
 
.,EDE4 D0 05 BNE $EDEB BNE CI4 ;BRANCH ALWAYS
;
unbedingter Sprung
save the byte and exit, branch always
  always jump
 
.,EDE6 48 PHA CI2 PHA ;SAVE CURRENT CHAR
Byte merken
save the byte
  temp store
 
.,EDE7 20 40 ED JSR $ED40 JSR ISOUR ;SEND LAST CHAR
gepuffertes Byte auf Bus
ausgeben
Tx byte on serial bus
  send data to serial bus
 
.,EDEA 68 PLA PLA ;RESTORE CURRENT CHAR
Byte zurückholen und
restore the byte
     
.,EDEB 85 95 STA $95 CI4 STA BSOUR ;BUFFER CURRENT CHAR
in Ausgaberegister holen
save the defered Tx byte
  store character in BSOUR
 
.,EDED 18 CLC CLC ;CARRY-GOOD EXIT
Carry löschen
flag ok
  clear carry to indicate no errors
 
.,EDEE 60 RTS RTS
;SEND UNTALK COMMAND ON SERIAL BUS
;
Rücksprung

UNTALK senden

command serial bus to UNTALK

 

UNTLK: SEND 'UNTALK'/'UNLISTEN'

The KERNAL routine UNTALK ($ffab)and UNLISTEN ($ffae) are
vectored here. ATN is set to 0, and CLK is set to 0. (A)
is loaded with #$5f for 'UNTALK' and #$3f for 'UNLISTEN'.
The command is sent to the serial bus via the 'send TALK/
LISTEN' routine. Finally ATN is set to 1, and after s
short delay, CLK and data are both set to 1.

send talk on serial bus

.,EDEF 78 SEI UNTLK SEI
Interruptflag setzen
disable the interrupts
  disable interrupts
 
.,EDF0 20 8E EE JSR $EE8E JSR CLKLO
CLOCK auf HIGH setzen
set the serial clock out low
  serial bus I/O
 
.,EDF3 AD 00 DD LDA $DD00 LDA D2PRA ;PULL ATN
Poar A laden
read VIA 2 DRA, serial port and video address
  set bit4
 
.,EDF6 09 08 ORA #$08 ORA #$08
ATN HIGH setzen und
mask xxxx 1xxx, set the serial ATN low
  and store, set ATN 0
 
.,EDF8 8D 00 DD STA $DD00 STA D2PRA
ausgeben
save VIA 2 DRA, serial port and video address
  set CLK 0
 
.,EDFB A9 5F LDA #$5F LDA #$5F ;UNTALK COMMAND
Kennzeichnung für UNTALK
set the UNTALK command
  flag UNTALK
 
.:EDFD 2C .BYTE $2C .BYT $2C ;SKIP TWO BYTES
;SEND UNLISTEN COMMAND ON SERIAL BUS
;
Skip nach $EE00

UNLISTEN senden

makes next line BIT $3FA9

command serial bus to UNLISTEN

  mask LDA #$3f with BIT $3fa9

send unlisten on serial bus

.,EDFE A9 3F LDA #$3F UNLSN LDA #$3F ;UNLISTEN COMMAND
Kennzeichnung für UNLISTEN
set the UNLISTEN command
  flag UNLISTEN
 
.,EE00 20 11 ED JSR $ED11 JSR LIST1 ;SEND IT
;
; RELEASE ALL LINES
ausgeben
send a control character
  send command to serial bus
 
.,EE03 20 BE ED JSR $EDBE DLABYE JSR SCATN ;ALWAYS RELEASE ATN
; DELAY THEN RELEASE CLOCK AND DATA
;
ATN rücksetzen, LOW
set serial ATN high
1ms delay, clock high then data high
  clear ATN
 
.,EE06 8A TXA DLADLH TXA ;DELAY APPROX 60 US
X-Register merken
save the device number
     
.,EE07 A2 0A LDX #$0A LDX #10
Warteschleife von
short delay
  init delay
 
.,EE09 CA DEX DLAD00 DEX
ca. 40 Mikrosekunden
decrement the count
  decrement counter
 
.,EE0A D0 FD BNE $EE09 BNE DLAD00
abwarten
loop if not all done
  till ready
 
.,EE0C AA TAX TAX
X-Register wiederholen
restore the device number
     
.,EE0D 20 85 EE JSR $EE85 JSR CLKHI
CLOCK auf LOW setzen
set the serial clock out high
  set CLK 1
 
.,EE10 4C 97 EE JMP $EE97 JMP DATAHI
;INPUT A BYTE FROM SERIAL BUS
;
ACPTR
DATA auf LOW setzen

IECIN ein Zeichen vom

IEC-Bus holen

set the serial data out high and return

input a byte from the serial bus

  set data 1

ACPTR: RECIEVE FROM SERIAL BUS

The KERNAL routine ACPTR ($ffa5) points to this routine. A
timing loop is enteredusing the CIA timer, and if a byte
is not received in 65 ms, ST is set to #$02, ie. a read
timeout. A test is made for EOI and if this occurs, ST is
set to #$40, indicating end of file. The byte is then
received from the serial bus and built up bit by bit in
the temporary stora at #$a4. This is transfered to (A) on
exit, unless EOI has occured.

input byte on serial bus

.,EE13 78 SEI SEI ;NO IRQ ALLOWED
Interruptflag setzen
disable the interrupts
     
.,EE14 A9 00 LDA #$00 LDA #$00 ;SET EOI/ERROR FLAG
$00 laden
set 0 bits to do, will flag EOI on timeour
     
.,EE16 85 A5 STA $A5 STA COUNT
und Zähler löschen
save the serial bus bit count
  CNTDN, counter
 
.,EE18 20 85 EE JSR $EE85 JSR CLKHI ;MAKE SURE CLOCK LINE IS RELEASED
CLOCK auf LOW setzen
set the serial clock out high
  set CLK 1
 
.,EE1B 20 A9 EE JSR $EEA9 ACP00A JSR DEBPIA ;WAIT FOR CLOCK HIGH
CLOCK-IN LOW ?
get the serial data status in Cb
  get serial in and clock
 
.,EE1E 10 FB BPL $EE1B BPL ACP00A
;
EOIACP
nein, dann warten
loop if the serial clock is low
  wait for CLK = 1
 
.,EE20 A9 01 LDA #$01 LDA #$01 ;SET TIMER 2 FOR 256US
$01
set the timeout count high byte
     
.,EE22 8D 07 DC STA $DC07 STA D1T2H
in Timer B HIGH schreiben
save VIA 1 timer B high byte
  setup CIA#1 timer B, high byte
 
.,EE25 A9 19 LDA #$19 LDA #TIMRB
Timer
load timer B, timer B single shot, start timer B
     
.,EE27 8D 0F DC STA $DC0F STA D1CRB
starten
save VIA 1 CRB
  set 1 shot, load and start CIA timer B
 
.,EE2A 20 97 EE JSR $EE97 JSR DATAHI ;DATA LINE HIGH (MAKES TIMMING MORE LIKE VIC-20
DATA auf LOW setzen
set the serial data out high
  set data 1
 
.,EE2D AD 0D DC LDA $DC0D LDA D1ICR ;CLEAR THE TIMER FLAGS<<<<<<<<<<<<
Interrupt Control Register
read VIA 1 ICR
     
.,EE30 AD 0D DC LDA $DC0D ACP00 LDA D1ICR
laden
read VIA 1 ICR
  read CIA#1 ICR
 
.,EE33 29 02 AND #$02 AND #$02 ;CHECK THE TIMER
Timer B abgelaufen ?
mask 0000 00x0, timer A interrupt
  test if timer B reaches zero
 
.,EE35 D0 07 BNE $EE3E BNE ACP00B ;RAN OUT.....
ja, 'TIME OUT'
if timer A interrupt go ??
  timeout
 
.,EE37 20 A9 EE JSR $EEA9 JSR DEBPIA ;CHECK THE CLOCK LINE
CLOCK-IN HIGH ?
get the serial data status in Cb
  get serial in and clock
 
.,EE3A 30 F4 BMI $EE30 BMI ACP00 ;NO NOT YET
nein, dann warten
loop if the serial clock is low
  CLK 1
 
.,EE3C 10 18 BPL $EE56 BPL ACP01 ;YES.....
;
unbedingter Sprung
else go set 8 bits to do, branch always
timer A timed out
  CLK 0
 
.,EE3E A5 A5 LDA $A5 ACP00B LDA COUNT ;CHECK FOR ERROR (TWICE THRU TIMEOUTS)
lade Zähler
get the serial bus bit count
  CNTDN
 
.,EE40 F0 05 BEQ $EE47 BEQ ACP00C
verzweige wenn $00
if not already EOI then go flag EOI
     
.,EE42 A9 02 LDA #$02 LDA #2
'TIME OUT'
else error $02, read timeour
  flag read timeout
 
.,EE44 4C B2 ED JMP $EDB2 JMP CSBERR ; ST = 2 READ TIMEOUT
;
; TIMER RAN OUT DO AN EOI THING
;
Status setzen
set the serial status and exit
  set I/O status word
 
.,EE47 20 A0 EE JSR $EEA0 ACP00C JSR DATALO ;DATA LINE LOW
DATA auf HIGH setzen
set the serial data out low
  set data 1
 
.,EE4A 20 85 EE JSR $EE85 JSR CLKHI ; DELAY AND THEN SET DATAHI (FIX FOR 40US C64)
CLOCK auf LOW setzen
set the serial clock out high
  set CLK 1
 
.,EE4D A9 40 LDA #$40 LDA #$40
Bit 6 für 'END OR IDENTIFY'
set EOI
  flag EOI
 
.,EE4F 20 1C FE JSR $FE1C JSR UDST ;OR AN EOI BIT INTO STATUS
Status setzen
OR into the serial status byte
  set I/O status word
 
.,EE52 E6 A5 INC $A5 INC COUNT ;GO AROUND AGAIN FOR ERROR CHECK ON EOI
Zähler erhöhen
increment the serial bus bit count, do error on the next
timeout
  increment CNTDN, counter
 
.,EE54 D0 CA BNE $EE20 BNE EOIACP
;
; DO THE BYTE TRANSFER
;
unbedingter Sprung
go try again, branch always
  again
 
.,EE56 A9 08 LDA #$08 ACP01 LDA #08 ;SET UP COUNTER
$08 als
set 8 bits to do
  set up CNTDN to receive 8 bits
 
.,EE58 85 A5 STA $A5 STA COUNT
;
Bitzähler setzen
save the serial bus bit count
     
.,EE5A AD 00 DD LDA $DD00 ACP03 LDA D2PRA ;WAIT FOR CLOCK HIGH
Port A laden
read VIA 2 DRA, serial port and video address
  serial bus I/O port
 
.,EE5D CD 00 DD CMP $DD00 CMP D2PRA ;DEBOUNCE
Änderung ?
compare it with itself
  compare
 
.,EE60 D0 F8 BNE $EE5A BNE ACP03
verzweige wenn ja
if changing go try again
  wait for serial bus to settle
 
.,EE62 0A ASL ASL A ;SHIFT DATA INTO CARRY
Datenbit ins Carry schieben
shift the serial data into the carry
     
.,EE63 10 F5 BPL $EE5A BPL ACP03 ;CLOCK STILL LOW...
erneut holen wenn CLOCK = 1
loop while the serial clock is low
  wait for data in =1
 
.,EE65 66 A4 ROR $A4 ROR BSOUR1 ;ROTATE DATA IN
;
Datenbit in $A4 schieben
shift the data bit into the receive byte
  roll in received bit in temp data area
 
.,EE67 AD 00 DD LDA $DD00 ACP03A LDA D2PRA ;WAIT FOR CLOCK LOW
Port A laden
read VIA 2 DRA, serial port and video address
  serial bus I/O port
 
.,EE6A CD 00 DD CMP $DD00 CMP D2PRA ;DEBOUNCE
Änderung ?
compare it with itself
  compare
 
.,EE6D D0 F8 BNE $EE67 BNE ACP03A
verzweige wenn ja
if changing go try again
  wait for bus to settle
 
.,EE6F 0A ASL ASL A
Datenbit ins Carry schieben
shift the serial data into the carry
     
.,EE70 30 F5 BMI $EE67 BMI ACP03A
erneut wenn CLOCK = 0
loop while the serial clock is high
  wait for data in =0
 
.,EE72 C6 A5 DEC $A5 DEC COUNT
Bitzähler veringerrn
decrement the serial bus bit count
  one bit received
 
.,EE74 D0 E4 BNE $EE5A BNE ACP03 ;MORE BITS.....
;...EXIT...
verzweige wenn noch nicht
alle 8 Bits gesendet
loop if not all done
  repeat for all 8 bits
 
.,EE76 20 A0 EE JSR $EEA0 JSR DATALO ;DATA LOW
DATA auf HIGH setzen
set the serial data out low
  set data 1
 
.,EE79 24 90 BIT $90 BIT STATUS ;CHECK FOR EOI
Status
test the serial status byte
  STATUS, I/O status word
 
.,EE7B 50 03 BVC $EE80 BVC ACP04 ;NONE...
;
verzweige wenn kein 'EOI' ?
if EOI not set skip the bus end sequence
  not EOI
 
.,EE7D 20 06 EE JSR $EE06 JSR DLADLH ;DELAY THEN SET DATA HIGH
;
warten und Bits 101 senden
1ms delay, clock high then data high
  handshake and exit without byte
 
.,EE80 A5 A4 LDA $A4 ACP04 LDA BSOUR1
Datenbyte in Akku holen
get the receive byte
  read received byte
 
.,EE82 58 CLI CLI ;IRQ IS OK
Interruptflag löschen
enable the interrupts
  enable interrupts
 
.,EE83 18 CLC CLC ;GOOD EXIT
Carry löschen
flag ok
  clear carry, no errors
 
.,EE84 60 RTS RTS
;
CLKHI ;SET CLOCK LINE HIGH (INVERTED)
Rücksprung

CLOCK auf LOW setzen

set the serial clock out high

 

SERIAL CLOCK ON

This routine sets the clock outline on the serial bus to
1. This means writing a 0 to the port. This value is
reversed by hardware on the bus.

set serial clock line low

.,EE85 AD 00 DD LDA $DD00 LDA D2PRA
Port A laden
read VIA 2 DRA, serial port and video address
  serial port I/O register
 
.,EE88 29 EF AND #$EF AND #$FF-$10
Bit 4 löschen
mask xxx0 xxxx, set serial clock out high
  clear bit4, ie. CLK out =1
 
.,EE8A 8D 00 DD STA $DD00 STA D2PRA
und wieder speichern
save VIA 2 DRA, serial port and video address
  store
 
.,EE8D 60 RTS RTS
;
CLKLO ;SET CLOCK LINE LOW (INVERTED)
Rücksprung

CLOCK auf HIGH setzen

set the serial clock out low

 

SERIAL CLOCK OFF

This routine sets the clock outline on the serial bus to
0. This means writing a 1 to the port. This value is
reversed by hardware on the bus.

set serial clock line high

.,EE8E AD 00 DD LDA $DD00 LDA D2PRA
Port A laden
read VIA 2 DRA, serial port and video address
  serial port I/O register
 
.,EE91 09 10 ORA #$10 ORA #$10
Bit 4 setzen
mask xxx1 xxxx, set serial clock out low
  set bit4, ie. CLK out =0
 
.,EE93 8D 00 DD STA $DD00 STA D2PRA
und wieder speichern
save VIA 2 DRA, serial port and video address
  store
 
.,EE96 60 RTS RTS
;
;
DATAHI ;SET DATA LINE HIGH (INVERTED)
Rücksprung

DATA auf LOW setzen

set the serial data out high

 

SERIAL OUTPUT 1

This routine sets the data out line on the serial bus to
1. This means writing a 0 to the port. This value is
reversed by hardware on the bus.

set serial data line low

.,EE97 AD 00 DD LDA $DD00 LDA D2PRA
Port A laden
read VIA 2 DRA, serial port and video address
  serial bus I/O register
 
.,EE9A 29 DF AND #$DF AND #$FF-$20
Bit 5 löschen
mask xx0x xxxx, set serial data out high
  clear bit5
 
.,EE9C 8D 00 DD STA $DD00 STA D2PRA
und wieder speichern
save VIA 2 DRA, serial port and video address
  store
 
.,EE9F 60 RTS RTS
;
DATALO ;SET DATA LINE LOW (INVERTED)
Rücksprung

DATA auf HIGH setzen

set the serial data out low

 

SERIAL OUTPUT 0

This routine sets the data out line on the serial bus to
0. This means writing a 1 to the port. This value is
reversed by hardware on the bus.

set serial data line high

.,EEA0 AD 00 DD LDA $DD00 LDA D2PRA
Port A laden
read VIA 2 DRA, serial port and video address
  serial bus I/O resister
 
.,EEA3 09 20 ORA #$20 ORA #$20
Bit 5 setzen
mask xx1x xxxx, set serial data out low
  set bit 5
 
.,EEA5 8D 00 DD STA $DD00 STA D2PRA
und wieder speichern
save VIA 2 DRA, serial port and video address
  store
 
.,EEA8 60 RTS RTS
;
Rücksprung

Bit vom IEC-Bus ins

Carry-Flag holen

get the serial data status in Cb

 

GET SERIAL DATA AND CLOCK IN

The serial port I/O register is stabilised and read. The
data is shifteed into carry and CLK into bit 7. This way,
both the data and clock can bee determined by flags in the
processor status register. Note that the values read are
true, and do not nead to be reversed in the same way as
the outuput line do.
 
.,EEA9 AD 00 DD LDA $DD00 DEBPIA LDA D2PRA ;DEBOUNCE THE PIA
Port A laden
read VIA 2 DRA, serial port and video address
  serial port I/O register
 
.,EEAC CD 00 DD CMP $DD00 CMP D2PRA
Änderung ?
compare it with itself
  compare
 
.,EEAF D0 F8 BNE $EEA9 BNE DEBPIA
verzweige wenn ja
if changing got try again
  wait for bus to settle
 
.,EEB1 0A ASL ASL A ;SHIFT THE DATA BIT INTO THE CARRY...
Datenbit ins Carry schieben
shift the serial data into Cb
  shift data into carry, and CLK into bit 7
 
.,EEB2 60 RTS RTS ;...AND THE CLOCK INTO NEG FLAG
;
W1MS ;DELAY 1MS USING LOOP
Rücksprung

Verzögerung 1 Millisekunde

1ms delay

 

DELAY 1 MS

This routine is a software delay loop where (X) is used as
counter, and are decremented for a period of 1
millisecond. The original (X) is stored on entry and (A)
is messed up.

delay 1 millisecond

.,EEB3 8A TXA TXA ;SAVE .X
X-Register retten
save X
  move (X) to (A)
 
.,EEB4 A2 B8 LDX #$B8 LDX #200-16 ;1000US-(1000/500*8=#40US HOLDS)
X-Register mit $B8 laden
set the loop count
  start value
 
.,EEB6 CA DEX W1MS1 DEX ;5US LOOP
herunterzählen
decrement the loop count
  decrement
 
.,EEB7 D0 FD BNE $EEB6 BNE W1MS1
verzweige wenn nicht fertig
loop if more to do
  untill zero
 
.,EEB9 AA TAX TAX ;RESTORE .X
X-Register wiederherstellen
restore X
  (A) to (X)
 
.,EEBA 60 RTS RTS
.END

.LIB RS232TRANS

; RSTRAB - ENTRY FOR NMI CONTINUE ROUTINE
; RSTBGN - ENTRY FOR START TRANSMITTER
;
; RSR - 8/18/80
;
; VARIABLES USED
; BITTS - # OF BITS TO BE SENT (<>0 NOT DONE)
; NXTBIT - BYTE CONTAINS NEXT BIT TO BE SENT
; ROPRTY - BYTE CONTAINS PARITY BIT CALCULATED
; RODATA - STORES DATA BYTE CURRENTLY BEING TRANSMITTED
; RODBS - OUTPUT BUFFER INDEX START
; RODBE - OUTPUT BUFFER INDEX END
; IF RODBS=RODBE THEN BUFFER EMPTY
; ROBUF - INDIRECT POINTER TO DATA BUFFER
; RSSTAT - RS-232 STATUS BYTE
;
; XXX US - NORMAL BIT PATH
; XXX US - WORST CASE PARITY BIT PATH
; XXX US - STOP BIT PATH
; XXX US - START BIT PATH
;
Rücksprung

RS 232 Ausgabe

RS232 Tx NMI routine

 

RS232 SEND

This routine is concerned with sending a byte on the RS232
port. The data is actually written to the port under NMI
interrupt control. The CTS line generates an NMI when the
port is ready for data. If all the bits in the byte have
been sent, then a new RS232 byte is set up. Otherwise,
this routine calculates parity and number of stop bits set
up in the OPEN command. These bits are added to the end of
the byte being sent.

set next bit to transmit on RS-232

.,EEBB A5 B4 LDA $B4 RSTRAB LDA BITTS ;CHECK FOR PLACE IN BYTE...
Anzahl Bits zu senden
get RS232 bit count
  BITTS, RS232 out bit count
 
.,EEBD F0 47 BEQ $EF06 BEQ RSTBGN ;...DONE, =0 START NEXT
;
verzweige wenn Byte schon
komplett übertragen
if zero go setup next RS232 Tx byte and return
  send new RS232 byte
 
.,EEBF 30 3F BMI $EF00 BMI RST050 ;...DOING STOP BITS
;
verzweige falls Stopbit
erforderlich
if -ve go do stop bit(s)
else bit count is non zero and +ve
     
.,EEC1 46 B6 LSR $B6 LSR RODATA ;SHIFT DATA INTO CARRY
nächstes Bit ins Carry
schieben
shift RS232 output byte buffer
  RODATA, RS232 out byte buffer
 
.,EEC3 A2 00 LDX #$00 LDX #00 ;PREPARE FOR A ZERO
'0' falls Datenbit = 0
set $00 for bit = 0
     
.,EEC5 90 01 BCC $EEC8 BCC RST005 ;YES...A ZERO
verzweige wenn Datenbit
gelöscht
branch if bit was 0
     
.,EEC7 CA DEX DEX ;NO...MAKE AN $FF
nein, dann X-Register =$FF
set $FF for bit = 1
     
.,EEC8 8A TXA RST005 TXA ;READY TO SEND
;
X-Register in Akku
copy bit to A
     
.,EEC9 45 BD EOR $BD EOR ROPRTY ;CALC INTO PARITY
mit Register für Paritybit
verknüpfen
EOR with RS232 parity byte
  ROPRTY, RS232 out parity
 
.,EECB 85 BD STA $BD STA ROPRTY
;
und abspeichern
save RS232 parity byte
     
.,EECD C6 B4 DEC $B4 DEC BITTS ;BIT COUNT DOWN
Bitzähler erniedrigen
decrement RS232 bit count
  BITTS
 
.,EECF F0 06 BEQ $EED7 BEQ RST010 ;WANT A PARITY INSTEAD
;
verzweige wenn alle Bits
übertragen
if RS232 bit count now zero go do parity bit
save bit and exit
     
.,EED1 8A TXA RSTEXT TXA ;CALC BIT WHOLE TO SEND
alten Akku wiederherstellen
copy bit to A
     
.,EED2 29 04 AND #$04 AND #$04 ;GOES OUT D2PA2
Bit 2 isolieren
mask 0000 0x00, RS232 Tx DATA bit
     
.,EED4 85 B5 STA $B5 STA NXTBIT
und ins Ausgaberegister
bringen
save the next RS232 data bit to send
  NXTBIT, next RS232 bit to send
 
.,EED6 60 RTS RTS
; CALCULATE PARITY
; NXTBIT =0 UPON ENTRY
;
Rücksprung

do RS232 parity bit, enters with RS232 bit count = 0

     
.,EED7 A9 20 LDA #$20 RST010 LDA #$20 ;CHECK 6551 REG BITS
Bit 5 (Parity)
mask 00x0 0000, parity enable bit
     
.,EED9 2C 94 02 BIT $0294 BIT M51CDR
RS 232 Befehlsregister
abfragen
test the pseudo 6551 command register
  M51CDR, 6551 command register immage
 
.,EEDC F0 14 BEQ $EEF2 BEQ RSPNO ;...NO PARITY, SEND A STOP
verzweige wenn ohne Parity
if parity disabled go ??
  no patity
 
.,EEDE 30 1C BMI $EEFC BMI RST040 ;...NOT REAL PARITY
verzweige wenn feste Parität
if fixed mark or space parity go ??
  mark/space transmit
 
.,EEE0 70 14 BVS $EEF6 BVS RST030 ;...EVEN PARITY
;
verzweige wenn ungerade
Parität
if even parity go ??
else odd parity
  even parity
 
.,EEE2 A5 BD LDA $BD LDA ROPRTY ;CALC ODD PARITY
verzweige wenn Parity
gleich eins
get RS232 parity byte
  ROPRTY, out parity
 
.,EEE4 D0 01 BNE $EEE7 BNE RSPEXT ;CORRECT GUESS
;
verzweige wenn ja
if parity not zero leave parity bit = 0
     
.,EEE6 CA DEX RSWEXT DEX ;WRONG GUESS...ITS A ONE
;
Parity $FF
make parity bit = 1
     
.,EEE7 C6 B4 DEC $B4 RSPEXT DEC BITTS ;ONE STOP BIT ALWAYS
Bitzähler auf $FF
decrement RS232 bit count, 1 stop bit
  BITTS, out bit count
 
.,EEE9 AD 93 02 LDA $0293 LDA M51CTR ;CHECK # OF STOP BITS
RS 232 Kontrollregister laden
get pseudo 6551 control register
  M51CTR, 6551 control register image
 
.,EEEC 10 E3 BPL $EED1 BPL RSTEXT ;...ONE
verzweige wenn zwei Stopbits
if 1 stop bit save parity bit and exit
else two stop bits ..
  one stop bit only
 
.,EEEE C6 B4 DEC $B4 DEC BITTS ;...TWO
Bitzähler auf $FE
decrement RS232 bit count, 2 stop bits
  BITTS
 
.,EEF0 D0 DF BNE $EED1 BNE RSTEXT ;JUMP
;
RSPNO ;LINE TO SEND CANNOT BE PB0
unbedingter Sprung zur
Berechnung der Stopbits
save bit and exit, branch always
parity is disabled so the parity bit becomes the first,
and possibly only, stop bit. to do this increment the bit
count which effectively decrements the stop bit count.
     
.,EEF2 E6 B4 INC $B4 INC BITTS ;COUNTS AS ONE STOP BIT
Bitzähler erhöhen, keine
Parity
increment RS232 bit count, = -1 stop bit
  BITTS
 
.,EEF4 D0 F0 BNE $EEE6 BNE RSWEXT ;JUMP TO FLIP TO ONE
;
unbedingter Sprung zur
Berechnung der Stopbits
set stop bit = 1 and exit
do even parity
     
.,EEF6 A5 BD LDA $BD RST030 LDA ROPRTY ;EVEN PARITY
Parity
get RS232 parity byte
  ROPRTY
 
.,EEF8 F0 ED BEQ $EEE7 BEQ RSPEXT ;CORRECT GUESS...EXIT
verzweige wenn gleich 0,
dann Null-Bit ausgeben
if parity zero leave parity bit = 0
     
.,EEFA D0 EA BNE $EEE6 BNE RSWEXT ;WRONG...FLIP AND EXIT
;
unbedingter Sprung 1-Bit
ausgeben
else make parity bit = 1, branch always
fixed mark or space parity
     
.,EEFC 70 E9 BVS $EEE7 RST040 BVS RSPEXT ;WANTED SPACE
Null-Bit ausgeben
if fixed space parity leave parity bit = 0
     
.,EEFE 50 E6 BVC $EEE6 BVC RSWEXT ; WANTED MARK
; STOP BITS
;
sonst 1-Bit ausgeben (feste
Parität)
else fixed mark parity make parity bit = 1, branch always
decrement stop bit count, set stop bit = 1 and exit. $FF is one stop bit, $FE is two
stop bits
     
.,EF00 E6 B4 INC $B4 RST050 INC BITTS ;STOP BIT COUNT TOWARDS ZERO
Bitzähler erhöhen
decrement RS232 bit count
  BITTS
 
.,EF02 A2 FF LDX #$FF LDX #$FF ;SEND STOP BIT
Wert für Stopbit
set stop bit = 1
     
.,EF04 D0 CB BNE $EED1 BNE RSTEXT ;JUMP TO EXIT
;
; RSTBGN - ENTRY TO START BYTE TRANS
;
unbedingter Sprung
save stop bit and exit, branch always

setup next RS232 Tx byte

 

SEND NEW RS232 BYTE

This routine sets up the system variables ready to send a
new byte to the RS232 port. A test is made for 3-line or
X-line modus. In X-line mode, DSR and CTS are checked.
 
.,EF06 AD 94 02 LDA $0294 RSTBGN LDA M51CDR ;CHECK FOR 3/X LINE
RS 232 Befehlsregister laden
read the 6551 pseudo command register
  M51CDR, 6551 command register
 
.,EF09 4A LSR LSR A
Bit 0 ins Carry
handshake bit inot Cb
  test handshake mode
 
.,EF0A 90 07 BCC $EF13 BCC RST060 ;3 LINE...NO CHECK
verzweige wenn 3-Line
Handshake, Abfrage übergehen
if 3 line interface go ??
  3-line mode (no handshake)
 
.,EF0C 2C 01 DD BIT $DD01 BIT D2PRB ;CHECK FOR...
Port B abfragen
test VIA 2 DRB, RS232 port
  RS232 port
 
.,EF0F 10 1D BPL $EF2E BPL DSRERR ;...DSR ERROR
verzweige wenn DSR fehlt
if DSR = 0 set DSR signal not present and exit
  no DSR, error
 
.,EF11 50 1E BVC $EF31 BVC CTSERR ;...CTS ERROR
;
; SET UP TO SEND NEXT BYTE
;
verzweige wenn CTS fehlt
if CTS = 0 set CTS signal not present and exit
was 3 line interface
  no CTS, error
 
.,EF13 A9 00 LDA #$00 RST060 LDA #0
0 laden und
clear A
     
.,EF15 85 BD STA $BD STA ROPRTY ;ZERO PARITY
Parity-Register löschen
clear the RS232 parity byte
  ROPRTY, RS232 out parity
 
.,EF17 85 B5 STA $B5 STA NXTBIT ;SEND START BIT
Register für zu sendendes
Bit (Startbit)
clear the RS232 next bit to send
  NXTBIT, next bit to send
 
.,EF19 AE 98 02 LDX $0298 LDX BITNUM ;GET # OF BITS
Anzahl der zu übertragenden
Bits
get the number of bits to be sent/received
  BITNUM, number of bits left to send
 
.,EF1C 86 B4 STX $B4 RST070 STX BITTS ;BITTS=#OF BITTS+1
;
als Bitzähler merken
set the RS232 bit count
  BITTS, RS232 out bit count
 
.,EF1E AC 9D 02 LDY $029D RST080 LDY RODBS ;CHECK BUFFER POINTERS
lade Zeiger für übertragenes
Byte
get the index to the Tx buffer start
  RODBS, start page of out buffer
 
.,EF21 CC 9E 02 CPY $029E CPY RODBE
alle Bytes übertragen ?
compare it with the index to the Tx buffer end
  RODBE, index to end if out buffer
 
.,EF24 F0 13 BEQ $EF39 BEQ RSODNE ;ALL DONE...
;
ja, dann abschließen
if all done go disable T?? interrupt and return
  disable timer
 
.,EF26 B1 F9 LDA ($F9),Y LDA (ROBUF)Y ;GET DATA...
Datenbyte aus RS 232 Puffer
holen
else get a byte from the buffer
  RS232 out buffer
 
.,EF28 85 B6 STA $B6 STA RODATA ;...INTO BYTE BUFFER
zum Senden übergeben
save it to the RS232 output byte buffer
  RODATA, RS232 out byte buffer
 
.,EF2A EE 9D 02 INC $029D INC RODBS ;MOVE POINTER TO NEXT
Pufferzeiger erhöhen
increment the index to the Tx buffer start
  RODBS
 
.,EF2D 60 RTS RTS
; SET ERRORS
;
Rücksprung

set DSR signal not present

 

NO DSR / CTS ERROR

(A) is loaded with the error flag - $40 for no DSR, and
$10 for no CTS. This is then ORed with 6551 status image
and stored in RSSTAT.

handle RS-232 errors

.,EF2E A9 40 LDA #$40 DSRERR LDA #$40 ;DSR GONE ERROR
DSR (Data Set Ready) fehlt
set DSR signal not present
  entrypoint for 'NO DSR'
 
.:EF30 2C .BYTE $2C .BYT $2C
Skip nach $EF33
makes next line BIT $10A9

set CTS signal not present

  mask next LDA-command
 
.,EF31 A9 10 LDA #$10 CTSERR LDA #$10 ;CTS GONE ERROR
CTS (Clear To Send) fehlt
set CTS signal not present
  entrypoint for 'NO CTS'
 
.,EF33 0D 97 02 ORA $0297 ORA RSSTAT
mit Status verknüpfen
OR it with the RS232 status register
  RSSTAT, 6551 status register image
 
.,EF36 8D 97 02 STA $0297 STA RSSTAT
;
; ERRORS TURN OFF T1
;
und setzen
save the RS232 status register

disable timer A interrupt

 

DISABLE TIMER

This routine set the interrupt mask on CIA#2 timer B. It
also clears the NMI flag.
 
.,EF39 A9 01 LDA #$01 RSODNE LDA #$01 ;KILL T1 NMI
;ENTRY TO TURN OFF AN ENABLED NMI...
NMI für
disable timer A interrupt

set VIA 2 ICR from A

  ; CIA#2 interrupt control register
 
.,EF3B 8D 0D DD STA $DD0D OENABL STA D2ICR ;TOSS BAD/OLD NMI
Timer A löschen
save VIA 2 ICR
  ; ENABL, RS232 enables
 
.,EF3E 4D A1 02 EOR $02A1 EOR ENABL ;FLIP ENABLE
Flag für
EOR with the RS-232 interrupt enable byte
     
.,EF41 09 80 ORA #$80 ORA #$80 ;ENABLE GOOD NMI'S
RS 232 umdrehen
set the interrupts enable bit
  ; ENABL
 
.,EF43 8D A1 02 STA $02A1 STA ENABL
und speichern
save the RS-232 interrupt enable byte
  ; CIA#2 interrupt control register
 
.,EF46 8D 0D DD STA $DD0D STA D2ICR
IRR setzen, alle übrigen
zulassen NMIs
save VIA 2 ICR
     
.,EF49 60 RTS RTS
; BITCNT - CAL # OF BITS TO BE SENT
; RETURNS #OF BITS+1
;
Rücksprung

Anzahl der RS 232 Datenbits

berechnen

compute bit count

 

COMPUTE BIT COUNT

This routine computes the number of bits in the word to be
sent. The word length information is held in bits 5 & 6 of
M51CTR. Bit 7 of this register indicates the number of
stop bits. On exit, the number of bits is held in (X).

check control register

.,EF4A A2 09 LDX #$09 BITCNT LDX #9 ;CALC WORD LENGTH
Zähler für Wortlänge
set bit count to 9, 8 data + 1 stop bit
     
.,EF4C A9 20 LDA #$20 LDA #$20
Maskenwert für Bit 5
mask for 8/7 data bits
     
.,EF4E 2C 93 02 BIT $0293 BIT M51CTR
Testen vom RS-232
Kontrollregister
test pseudo 6551 control register
  M51CTR, 6551 control register image
 
.,EF51 F0 01 BEQ $EF54 BEQ BIT010
verzweige wenn Bit 5 gelöscht
branch if 8 bits
     
.,EF53 CA DEX DEX ;BIT 5 HIGH IS A 7 OR 5
Zähler für Wortlänge
vermindern
else decrement count for 7 data bits
     
.,EF54 50 02 BVC $EF58 BIT010 BVC BIT020
verzweige wenn Bit 6 gelöscht
branch if 7 bits
     
.,EF56 CA DEX DEX ;BIT 6 HIGH IS A 6 OR 5
Wortlänge um zwei
else decrement count ..
     
.,EF57 CA DEX DEX
vermindern
.. for 5 data bits
     
.,EF58 60 RTS BIT020 RTS
.END

.LIB RS232RCVR

; RSRCVR - NMI ROUTINE TO COLLECT
; DATA INTO BYTES
;
; RSR 8/18/80
;
; VARIABLES USED
; INBIT - INPUT BIT VALUE
; BITCI - BIT COUNT IN
; RINONE - FLAG FOR START BIT CHECK <>0 START BIT
; RIDATA - BYTE INPUT BUFFER
; RIPRTY - HOLDS BYTE INPUT PARITY
; RIBUF - INDIRECT POINTER TO DATA BUFFER
; RIDBE - INPUT BUFFER INDEX TO END
; RIDBS - INPUT BUFFER POINTER TO START
; IF RIDBE=RIDBS THEN INPUT BUFFER EMPTY
;
Rücksprung

empfangenes Bit verarbeiten

RS232 Rx NMI

 

RS232 RECEIVE

This routine builds up the input byte from the RS232 port
in RIDATA. Each bit is input from the port under NMI
interrupt control. The bit is placed in INBIT before being
passed to this routine, where it is shifted into the carry
flag and then rotated into RIDATA. The bit count is
decremented and parity updated.

add bit input on RS-232 bus to word being input

.,EF59 A6 A9 LDX $A9 RSRCVR LDX RINONE ;CHECK FOR START BIT
Startbit ?
get start bit check flag
  RINONE, check for start bit?
 
.,EF5B D0 33 BNE $EF90 BNE RSRTRT ;WAS START BIT
;
verzweige wenn ja
if no start bit received go ??
     
.,EF5D C6 A8 DEC $A8 DEC BITCI ;CHECK WHERE WE ARE IN INPUT...
Bitzähler erniedrigen
decrement receiver bit count in
  BITC1, RS232 in bit count
 
.,EF5F F0 36 BEQ $EF97 BEQ RSR030 ;HAVE A FULL BYTE
verzweige wenn alle Bits
empfangen
if the byte is complete go add it to the buffer
  process received byte
 
.,EF61 30 0D BMI $EF70 BMI RSR020 ;GETTING STOP BITS
;
; CALC PARITY
;
verzweige wenn noch Stopbits
zu erwarten
       
.,EF63 A5 A7 LDA $A7 LDA INBIT ;GET DATA UP
empfangenes Bit
get the RS232 received data bit
  INBIT, RS232 in bits
 
.,EF65 45 AB EOR $AB EOR RIPRTY ;CALC NEW PARITY
mit Register für Parity
verknüpfen
EOR with the receiver parity bit
  RIPRTY, RS232 in parity
 
.,EF67 85 AB STA $AB STA RIPRTY
;
; SHIFT DATA BIT IN
;
und abspeichern
save the receiver parity bit
     
.,EF69 46 A7 LSR $A7 LSR INBIT ;IN BIT POS 0
empfangenes Bit ins Carry
shift the RS232 received data bit
  INBIT, put input bit into carry
 
.,EF6B 66 AA ROR $AA ROR RIDATA ;C INTO DATA
;
; EXIT
;
und in Empfangsregister
schieben
    RIDATA,
 
.,EF6D 60 RTS RSREXT RTS
; HAVE STOP BIT, SO STORE IN BUFFER
;
Rücksprung
     

handle end of word for RS-232 input

.,EF6E C6 A8 DEC $A8 RSR018 DEC BITCI ;NO PARITY, DEC SO CHECK WORKS
Bitzähler erniedrigen
decrement receiver bit count in
  BITC1
 
.,EF70 A5 A7 LDA $A7 RSR020 LDA INBIT ;GET DATA...
Stopbit
get the RS232 received data bit
  INBIT
 
.,EF72 F0 67 BEQ $EFDB BEQ RSR060 ;...ZERO, AN ERROR?
;
verzweige wenn gleich Null
       
.,EF74 AD 93 02 LDA $0293 LDA M51CTR ;CHECK FOR CORRECT # OF STOP BITS
Kontrollregister laden
get pseudo 6551 control register
  M51CTR, 6551 control register image
 
.,EF77 0A ASL ASL A ;CARRY TELL HOW MAY STOP BITS
Bit 7 (Anzahl Stopbits) ins
Carry
shift the stop bit flag to Cb
     
.,EF78 A9 01 LDA #$01 LDA #01
1 laden und mit der Anzahl
+ 1
     
.,EF7A 65 A8 ADC $A8 ADC BITCI
von Bits und Stopbits
addieren
add receiver bit count in
  BITC1
 
.,EF7C D0 EF BNE $EF6D BNE RSREXT ;NO..EXIT
;
; RSRABL - ENABLE TO RECIEVE A BYTE
;
verzweige wenn noch nicht
alle Stopbits empfangen
exit, branch always

setup to receive an RS232 bit

  end

SET UP TO RECEIVE

This routine sets up the I.C.R. to wait for the receiver
edge, and flags this into ENABL. It then flags the check
for a start bit.

enable byte reception

.,EF7E A9 90 LDA #$90 RSRABL LDA #$90 ;ENABLE FLAG FOR NEXT BYTE
Wert für Freigabe von NMI
über die Flagleitung
enable FLAG interrupt
     
.,EF80 8D 0D DD STA $DD0D STA D2ICR ;TOSS BAD/OLD NMI
Wert NMI freigeben
save VIA 2 ICR
  CIA#2 I.C.R.
 
.,EF83 0D A1 02 ORA $02A1 ORA ENABL ;MARK IN ENABLE REGISTER***********
auch im NMI Register
OR with the RS-232 interrupt enable byte
  ENABL, RS232 enables
 
.,EF86 8D A1 02 STA $02A1 STA ENABL ;RE-ENABLED BY JMP OENABL
für RS 232 NMIs vermerken
save the RS-232 interrupt enable byte
     
.,EF89 85 A9 STA $A9 STA RINONE ;FLAG FOR START BIT
;
und Flag für Startbit setzen
set start bit check flag, set no start bit received
  RINONE, check for start bit
 
.,EF8B A9 02 LDA #$02 RSRSXT LDA #$02 ;DISABLE T2
Bitwert für
disable timer B interrupt
     
.,EF8D 4C 3B EF JMP $EF3B JMP OENABL ;FLIP-OFF ENABL***************
; RECIEVER START BIT CHECK
;
NMI für Timer B löschen
set VIA 2 ICR from A and return

no RS232 start bit received

  disable timer and exit

PROCESS RS232 BYTE

The byte recieved from the RS232 port is checked against
parity. This involvs checking the input parity options
selected, and then verifying the parity bit calculated
against that input. If the test is passed, then the byte
is stored in the in-buffer. Otherwise an error is flagged
into RSSTAT.
A patch in KERNAL version 3, has been added to the input
routine at $ef94 to initialise the RS232 parity byte,
RIPRTY, on reception of a start bit.

receiver start bit test

.,EF90 A5 A7 LDA $A7 RSRTRT LDA INBIT ;CHECK IF SPACE
Startbit laden
get the RS232 received data bit
  INBIT, RS232 in bits
 
.,EF92 D0 EA BNE $EF7E BNE RSRABL ;BAD...TRY AGAIN
verzweige wenn ungleich Null
if ?? go setup to receive an RS232 bit and return
  set up to receive
 
.,EF94 85 A9 STA $A9 STA RINONE ;GOOD...DISABLE FLAG
Flag für Startbit
rücksetzen
flag the RS232 start bit and set the parity

received a whole byte, add it to the buffer

  patch, init parity byte

put received data into RS-232 buffer

.,EF96 60 RTS RTS ;AND EXIT
;
; PUT DATA IN BUFFER (AT PARITY TIME)
;
Rücksprung

Empfangenes Byte

weiterverarbeiten

       
.,EF97 AC 9B 02 LDY $029B RSR030 LDY RIDBE ;GET END
Pufferzeiger laden
get index to Rx buffer end
  RIDBE, index to the end of in buffer
 
.,EF9A C8 INY INY
und erhöhen
increment index
     
.,EF9B CC 9C 02 CPY $029C CPY RIDBS ;HAVE WE PASSED START?
mit Empfangspuffer
vergleichen
compare with index to Rx buffer start
  RIDBS, start page of in buffer
 
.,EF9E F0 2A BEQ $EFCA BEQ RECERR ;YES...ERROR
;
verzweige wenn voll, dann
Status setzen
if buffer full go do Rx overrun error
  receive overflow error
 
.,EFA0 8C 9B 02 STY $029B STY RIDBE ;MOVE RIDBE FOWARD
Pufferzeiger abspeichern
save index to Rx buffer end
  RIDBE
 
.,EFA3 88 DEY DEY
;
und normalisieren
decrement index
     
.,EFA4 A5 AA LDA $AA LDA RIDATA ;GET BYTE BUFFER UP
empfangenes Byte laden
get assembled byte
  RIDATA, RS232 in byte buffer
 
.,EFA6 AE 98 02 LDX $0298 LDX BITNUM ;SHIFT UNTILL FULL BYTE
Anzahl Datenbits laden
get bit count
  BITNUM, number of bits left to send
 
.,EFA9 E0 09 CPX #$09 RSR031 CPX #9 ;ALWAYS 8 BITS
8 Bits plus ein Stopbit?
compare with byte + stop
  full word to come?
 
.,EFAB F0 04 BEQ $EFB1 BEQ RSR032
verzweige wenn ja, ok
branch if all nine bits received
  yes
 
.,EFAD 4A LSR LSR A ;FILL WITH ZEROS
sonst Bits in richtige
Position schieben
else shift byte
     
.,EFAE E8 INX INX
Datenbitzähler um 1 erhöhen
increment bit count
     
.,EFAF D0 F8 BNE $EFA9 BNE RSR031
;
unbedingter Sprung
loop, branch always
     
.,EFB1 91 F7 STA ($F7),Y RSR032 STA (RIBUF)Y ;DATA TO PAGE BUFFER
;
; PARITY CHECKING
;
Byte in RS 232 Puffer
schreiben
save received byte to Rx buffer
  RIBUF, RS232 in buffer
 
.,EFB3 A9 20 LDA #$20 LDA #$20 ;CHECK 6551 COMMAND REGISTER
Maskenwert für
Paritätsprüfung
mask 00x0 0000, parity enable bit
     
.,EFB5 2C 94 02 BIT $0294 BIT M51CDR
Bit 5 im Kommandregister
prüfen
test the pseudo 6551 command register
  M51CDR, 6551 command register image
 
.,EFB8 F0 B4 BEQ $EF6E BEQ RSR018 ;NO PARITY BIT SO STOP BIT
verzweige wenn Übertragung
ohne Parity
branch if parity disabled
  parity disabled
 
.,EFBA 30 B1 BMI $EF6D BMI RSREXT ;NO PARITY CHECK
;
; CHECK CALC PARITY
;
verzweige wenn festes Bit
anstelle Parity
branch if mark or space parity
  parity check disabled, TRS
 
.,EFBC A5 A7 LDA $A7 LDA INBIT
empfangenes Paritybit laden
get the RS232 received data bit
  INBIT, parity check
 
.,EFBE 45 AB EOR $AB EOR RIPRTY ;PUT IN WITH PARITY
mit berechneter Parity
vergleichen
EOR with the receiver parity bit
  RIPRTY, RS232 in parity
 
.,EFC0 F0 03 BEQ $EFC5 BEQ RSR050 ;EVEN PARITY
verzweige wenn gleich, ok
    receive parity error
 
.,EFC2 70 A9 BVS $EF6D BVS RSREXT ;ODD...OKAY SO EXIT
gerade Parity, dann ok
if ?? just exit
     
.:EFC4 2C .BYTE $2C .BYT $2C ;SKIP TWO
Skip nach $EFC7
makes next line BIT $A650
  mask
 
.,EFC5 50 A6 BVC $EF6D RSR050 BVC RSREXT ;EVEN...OKAY SO EXIT
;
; ERRORS REPORTED
verzweige wenn ungerade
Parity, dann ok
if ?? just exit
     
.,EFC7 A9 01 LDA #$01 LDA #1 ;PARITY ERROR
sonst Parity-Fehler
set Rx parity error
  receive parity error
 
.:EFC9 2C .BYTE $2C .BYT $2C
Skip nach EFCC
makes next line BIT $04A9
  mask
 
.,EFCA A9 04 LDA #$04 RECERR LDA #$4 ;RECIEVER OVERRUN
Empfängerpuffer voll
set Rx overrun error
  receive overflow
 
.:EFCC 2C .BYTE $2C .BYT $2C
Skip nach $EFCF
makes next line BIT $80A9
  mask
 
.,EFCD A9 80 LDA #$80 BREAKE LDA #$80 ;BREAK DETECTED
Break-Befehl empfangen
set Rx break error
  framing break
 
.:EFCF 2C .BYTE $2C .BYT $2C
Skip nach $EFD2
makes next line BIT $02A9
  mask
 
.,EFD0 A9 02 LDA #$02 FRAMEE LDA #$02 ;FRAME ERROR
Rahmen-Fehler
set Rx frame error
  framing error
 
.,EFD2 0D 97 02 ORA $0297 ERR232 ORA RSSTAT
mit Code für RS-232 Status
verknüpfen
OR it with the RS232 status byte
  RSSTAT, 6551 status register image
 
.,EFD5 8D 97 02 STA $0297 STA RSSTAT
und speichern
save the RS232 status byte
     
.,EFD8 4C 7E EF JMP $EF7E JMP RSRABL ;BAD EXIT SO HANG ##????????##
;
; CHECK FOR ERRORS
;
zum Empfang des nächsten
Bytes springen
setup to receive an RS232 bit and return
  set up to receive
 
.,EFDB A5 AA LDA $AA RSR060 LDA RIDATA ;EXPECTING STOP...
empfangenes Byte
    RIDATA
 
.,EFDD D0 F1 BNE $EFD0 BNE FRAMEE ;FRAME ERROR
ungleich 0, dann zu Rahmen-
Fehler
if ?? do frame error
  framing error
 
.,EFDF F0 EC BEQ $EFCD BEQ BREAKE ;COULD BE A BREAK
.END

.LIB RS232INOUT

; OUTPUT A FILE OVER USR PORT
; USING RS232
;
sonst zu Break-Befehl
empfangen

RS-232 CKOUT, Ausgabe auf

RS-232

else do break error, branch always

open RS232 channel for output

  receive break

SUBMIT TO RS232

This routine is called when data is required from the
RS232 port. Its function is to perform the handshaking on
the poort needed to receive the data. If 3 line mode is
used, then no handshaking is implemented and the routine
exits.

output of RS-232 device

.,EFE1 85 9A STA $9A CKO232 STA DFLTO ;SET DEFAULT OUT
Gerätenummer abspeichern
save the output device number
  DFLTO, default output device
 
.,EFE3 AD 94 02 LDA $0294 LDA M51CDR ;CHECK FOR 3/X LINE
RS 232 Kommandregister laden
read the pseudo 6551 command register
  M51CDR, 6551 command register image
 
.,EFE6 4A LSR LSR A
Bit 0 (Handshake) ins Carry
shift handshake bit to carry
     
.,EFE7 90 29 BCC $F012 BCC CKO100 ;3LINE...NO TURN AROUND
;
;*TURN AROUND LOGIC
;
; CHECK FOR DSR AND RTS
;
verzweige wenn 3-Line-
Handshake
if 3 line interface go ??
  3 line mode, no handshaking, exit
 
.,EFE9 A9 02 LDA #$02 LDA #$02 ;BIT RTS IS ON
Haske für DATA SET READY
mask 0000 00x0, RTS out
     
.,EFEB 2C 01 DD BIT $DD01 BIT D2PRB
Port B auslesen
test VIA 2 DRB, RS232 port
  RS232 I/O port
 
.,EFEE 10 1D BPL $F00D BPL CKDSRX ;NO DSR...ERROR
kein DSR, dann Fehler
if DSR = 0 set DSR not present and exit
  no DRS, error
 
.,EFF0 D0 20 BNE $F012 BNE CKO100 ;RTS...OUTPUTING OR FULL DUPLEX
;
; CHECK FOR ACTIVE INPUT
; RTS WILL BE LOW IF CURRENTLY INPUTING
;
verzweige wenn kein Request
To Send
if RTS = 1 just exit
     
.,EFF2 AD A1 02 LDA $02A1 CKO020 LDA ENABL
RS-232 NMI Status Laden
get the RS-232 interrupt enable byte
  ENABL, RS232 enables
 
.,EFF5 29 02 AND #$02 AND #$02 ;LOOK AT IER FOR T2
verknüpfe mit Bit für
Datenempfang aktiv
mask 0000 00x0, timer B interrupt
     
.,EFF7 D0 F9 BNE $EFF2 BNE CKO020 ;HANG UNTILL INPUT DONE
;
; WAIT FOR CTS TO BE OFF AS SPEC REQS
;
warten bis Empfang beendet
loop while the timer B interrupt is enebled
     
.,EFF9 2C 01 DD BIT $DD01 CKO030 BIT D2PRB
Port B der NMI-CIA auslesen
test VIA 2 DRB, RS232 port
  RS232 I/O port
 
.,EFFC 70 FB BVS $EFF9 BVS CKO030
;
; TURN ON RTS
;
und auf Clear To Send warten
loop while CTS high
  wait for no CTS
 
.,EFFE AD 01 DD LDA $DD01 LDA D2PRB
Port B lesen
read VIA 2 DRB, RS232 port
     
.,F001 09 02 ORA #$02 ORA #$02
Bit für Request To Send setzen
mask xxxx xx1x, set RTS high
     
.,F003 8D 01 DD STA $DD01 STA D2PRB
;
; WAIT FOR CTS TO GO ON
;
und wieder zurückschreiben
save VIA 2 DRB, RS232 port
  set RTS
 
.,F006 2C 01 DD BIT $DD01 CKO040 BIT D2PRB
Port B holen und
test VIA 2 DRB, RS232 port
     
.,F009 70 07 BVS $F012 BVS CKO100 ;DONE...
auf Clear To Send warten
exit if CTS high
  CTS set
 
.,F00B 30 F9 BMI $F006 BMI CKO040 ;WE STILL HAVE DSR
;
verzweige wenn nicht Data Set
Ready
loop while DSR high
set no DSR and exit
  wait for no DSR

NO DSR ERROR

This routine sets the 6551 status register image to #40
when a no DSR error has occurred.
 
.,F00D A9 40 LDA #$40 CKDSRX LDA #$40 ;A DATA SET READY ERROR
Bit für fehlendes DSR
set DSR signal not present
     
.,F00F 8D 97 02 STA $0297 STA RSSTAT ;MAJOR ERROR....WILL REQUIRE REOPEN
;
Status setzen
save the RS232 status register
  RSSTAT, 6551 status register image
 
.,F012 18 CLC CKO100 CLC ;NO ERROR
Carry für ok Kennzeichen
setzen
flag ok
     
.,F013 60 RTS RTS
;
; BSO232 - OUTPUT A CHAR RS232
; DATA PASSED IN T1 FROM BSOUT
;
; HANG LOOP FOR BUFFER FULL
;
Rücksprung

Ausgabe in RS 232 Puffer

send byte to the RS232 buffer

 

SEND TO RS232 BUFFER

Note: The entry point to the routine is at

buffer char to output on RS-232

.,F014 20 28 F0 JSR $F028 BSOBAD JSR BSO100 ;KEEP TRYING TO START SYSTEM...
;
; BUFFER HANDLER
;
falls erforderlich Übertragung starten
setup for RS232 transmit
send byte to the RS232 buffer, no setup
     
.,F017 AC 9E 02 LDY $029E BSO232 LDY RODBE
Zeiger auf Ausgabepuffer
laden
get index to Tx buffer end
     
.,F01A C8 INY INY
und erhöhen
+ 1
     
.,F01B CC 9D 02 CPY $029D CPY RODBS ;CHECK FOR BUFFER FULL
und mit Lesezeiger
vergleichen
compare with index to Tx buffer start
     
.,F01E F0 F4 BEQ $F014 BEQ BSOBAD ;HANG IF SO...TRYING TO RESTART
Puffer voll, dann warten
loop while buffer full
     
.,F020 8C 9E 02 STY $029E STY RODBE ;INDICATE NEW START
neuen Wert für
Schreibzeiger merken
set index to Tx buffer end
     
.,F023 88 DEY DEY
und wieder normalisieren
index to available buffer byte
     
.,F024 A5 9E LDA $9E LDA T1 ;GET DATA...
auszugebendes Byte holen und
read the RS232 character buffer
     
.,F026 91 F9 STA ($F9),Y STA (ROBUF)Y ;STORE DATA
;
; SET UP IF NECESSARY TO OUTPUT
;
in Puffer schreiben
save the byte to the buffer

setup for RS232 transmit

     
.,F028 AD A1 02 LDA $02A1 BSO100 LDA ENABL ;CHECK FOR A T1 NMI ENABLE
RS 232 NMI Status laden
get the RS-232 interrupt enable byte
     
.,F02B 4A LSR LSR A ;BIT 0
Bit 0 testen (läuft
Sendebetrieb)
shift the enable bit to Cb
     
.,F02C B0 1E BCS $F04C BCS BSO120 ;RUNNING....SO EXIT
;
; SET UP T1 NMI'S
;
verzweige wenn ja
if interrupts are enabled just exit
     
.,F02E A9 10 LDA #$10 BSO110 LDA #$10 ;TURN OFF TIMER TO PREVENT FALSE START...
Bitwert für Timer starten
start timer A
     
.,F030 8D 0E DD STA $DD0E STA D2CRA
Timer A starten
save VIA 2 CRA
     
.,F033 AD 99 02 LDA $0299 LDA BAUDOF ;SET UP TIMER1
Timer für
get the baud rate bit time low byte
     
.,F036 8D 04 DD STA $DD04 STA D2T1L
Sende-Baud-Rate
save VIA 2 timer A low byte
     
.,F039 AD 9A 02 LDA $029A LDA BAUDOF+1
neu
get the baud rate bit time high byte
     
.,F03C 8D 05 DD STA $DD05 STA D2T1H
setzen
save VIA 2 timer A high byte
     
.,F03F A9 81 LDA #$81 LDA #$81
Code für Timer-Unterlauf NMI
Timer A
enable timer A interrupt
     
.,F041 20 3B EF JSR $EF3B JSR OENABL
in IC-Register schreiben
set VIA 2 ICR from A
     
.,F044 20 06 EF JSR $EF06 JSR RSTBGN ;SET UP TO SEND (WILL STOP ON CTS OR DSR ERROR)
CTS und DSR prüfen und
Übertragung freigeben
setup next RS232 Tx byte
     
.,F047 A9 11 LDA #$11 LDA #$11 ;TURN ON TIMER
Bitwert Timer A starten
load timer A, start timer A
     
.,F049 8D 0E DD STA $DD0E STA D2CRA
Timer A starten
save VIA 2 CRA
     
.,F04C 60 RTS BSO120 RTS
; INPUT A FILE OVER USER PORT
; USING RS232
;
Rücksprung

RS-232 CHKIN, Eingabe auf

RS-232 setzen

input from RS232 buffer

 

INPUT FROM RS232

initalise RS-232 input

.,F04D 85 99 STA $99 CKI232 STA DFLTN ;SET DEFAULT INPUT
;
Gerätenummer speichern
save the input device number
     
.,F04F AD 94 02 LDA $0294 LDA M51CDR ;CHECK FOR 3/X LINE
RS 232 Befehlsregister laden
get pseudo 6551 command register
     
.,F052 4A LSR LSR A
Bit 0 ins Carry schieben
shift the handshake bit to Cb
     
.,F053 90 28 BCC $F07D BCC CKI100 ;3 LINE...NO HANDSHAKE
;
verzweige wenn 3-Line-
Handshake
if 3 line interface go ??
     
.,F055 29 08 AND #$08 AND #$08 ;FULL/HALF CHECK (BYTE SHIFTED ABOVE)
Bit für Dupex Mode isolieren
mask the duplex bit, pseudo 6551 command is >> 1
     
.,F057 F0 24 BEQ $F07D BEQ CKI100 ;FULL...NO HANDSHAKE
;
;*TURN AROUND LOGIC
;
; CHECK IF DSR AND NOT RTS
;
verzweige wenn voll Dupex
if full duplex go ??
     
.,F059 A9 02 LDA #$02 LDA #$02 ;BIT RTS IS ON
Maske für 'RTS OUT'
mask 0000 00x0, RTS out
     
.,F05B 2C 01 DD BIT $DD01 BIT D2PRB
Data Set Ready abfragen
test VIA 2 DRB, RS232 port
     
.,F05E 10 AD BPL $F00D BPL CKDSRX ;NO DSR...ERROR
verzweige wenn nein
if DSR = 0 set no DSR and exit
     
.,F060 F0 22 BEQ $F084 BEQ CKI110 ;RTS LOW...IN CORRECT MODE
;
; WAIT FOR ACTIVE OUTPUT TO BE DONE
;
Ready To Send abfragen
if RTS = 0 just exit
     
.,F062 AD A1 02 LDA $02A1 CKI010 LDA ENABL
RS 232 NMI Status laden
get the RS-232 interrupt enable byte
     
.,F065 4A LSR LSR A ;CHECK T1 (BIT 0)
Bit 0 ins Carry
(Sendebetrieb aktiv)
shift the timer A interrupt enable bit to Cb
     
.,F066 B0 FA BCS $F062 BCS CKI010
;
; TURN OFF RTS
;
ja, warten bis beendet
loop while the timer A interrupt is enabled
     
.,F068 AD 01 DD LDA $DD01 LDA D2PRB
Port B laden
read VIA 2 DRB, RS232 port
     
.,F06B 29 FD AND #$FD AND #$FF-02
Request To Send
mask xxxx xx0x, clear RTS out
     
.,F06D 8D 01 DD STA $DD01 STA D2PRB
;
; WAIT FOR DCD TO GO HIGH (IN SPEC)
;
und wieder speichern
save VIA 2 DRB, RS232 port
     
.,F070 AD 01 DD LDA $DD01 CKI020 LDA D2PRB
Port B holen
read VIA 2 DRB, RS232 port
     
.,F073 29 04 AND #$04 AND #$04
Bit für Data Terminal Ready
mask xxxx x1xx, DTR in
     
.,F075 F0 F9 BEQ $F070 BEQ CKI020
;
; ENABLE FLAG FOR RS232 INPUT
;
verzweige wenn nein, warten
loop while DTR low
     
.,F077 A9 90 LDA #$90 CKI080 LDA #$90
NMI-Maske für 'Flag' laden
enable the FLAG interrupt
     
.,F079 18 CLC CLC ;NO ERROR
Carry löschen (ok Kennzeichen)
flag ok
     
.,F07A 4C 3B EF JMP $EF3B JMP OENABL ;FLAG IN ENABL**********
;
; IF NOT 3 LINE HALF THEN...
; SEE IF WE NEED TO TURN ON FLAG
;
NMI freigeben

RS-232 CHKIN bei 3-Line

Handshake

set VIA 2 ICR from A and return
     
.,F07D AD A1 02 LDA $02A1 CKI100 LDA ENABL ;CHECK FOR FLAG OR T2 ACTIVE
RS-232 NMI Status laden
get the RS-232 interrupt enable byte
     
.,F080 29 12 AND #$12 AND #$12
wenn RS-232 nicht aktiv
mask 000x 00x0
     
.,F082 F0 F3 BEQ $F077 BEQ CKI080 ;NO NEED TO TURN ON
dann starten
if FLAG or timer B bits set go enable the FLAG inetrrupt
     
.,F084 18 CLC CKI110 CLC ;NO ERROR
Carry löschen (ok
Kenneichen)
flag ok
     
.,F085 60 RTS RTS
; BSI232 - INPUT A CHAR RS232
;
; BUFFER HANDLER
;
Rücksprung

GET von RS-232

get byte from RS232 buffer

  F086 GET FROM RS232

get next character from RS-232 input buffer

.,F086 AD 97 02 LDA $0297 BSI232 LDA RSSTAT ;GET STATUS UP TO CHANGE...
RS-232 Status holen
get the RS232 status register
     
.,F089 AC 9C 02 LDY $029C LDY RIDBS ;GET LAST BYTE ADDRESS
Zeiger auf Ende des
Eingabepuffers
get index to Rx buffer start
     
.,F08C CC 9B 02 CPY $029B CPY RIDBE ;SEE IF BUFFER EMPTY
mit Zeiger auf Anfang
vergleichen
compare with index to Rx buffer end
     
.,F08F F0 0B BEQ $F09C BEQ BSI010 ;RETURN A NULL IF NO CHAR
;
verzweige wenn gleich (Puffer
leer)
return null if buffer empty
     
.,F091 29 F7 AND #$F7 AND #$FF-$08 ;CLEAR BUFFER EMPTY STATUS
Bit 3 (Puffer leer)
clear the Rx buffer empty bit
     
.,F093 8D 97 02 STA $0297 STA RSSTAT
im Status löschen (Zeichen
im Puffer)
save the RS232 status register
     
.,F096 B1 F7 LDA ($F7),Y LDA (RIBUF)Y ;GET LAST CHAR
Byte aus Puffer holen
get byte from Rx buffer
     
.,F098 EE 9C 02 INC $029C INC RIDBS ;INC TO NEXT POS
;
; RECEIVER ALWAYS RUNS
;
Pufferzeiger erhöhen
increment index to Rx buffer start
     
.,F09B 60 RTS RTS
;
Rücksprung
       
.,F09C 09 08 ORA #$08 BSI010 ORA #$08 ;SET BUFFER EMPTY STATUS
Bitwert für Puffer leer
set the Rx buffer empty bit
     
.,F09E 8D 97 02 STA $0297 STA RSSTAT
Status setzen
save the RS232 status register
     
.,F0A1 A9 00 LDA #$00 LDA #$0 ;RETURN A NULL
Null übergeben
return null
     
.,F0A3 60 RTS RTS
; RSP232 - PROTECT SERIAL/CASS FROM RS232 NMI'S
;
Rücksprung

Ende der RS-232 Übertragung

abwarten

check RS232 bus idle

 

SERIAL BUS IDLE

This routine checks the RS232 bus for data transmission/
reception. The routine waits for any activity on the bus
to end before setting I.C.R. The routine is called by
serial bus routines, since these devices use IRQ generated
timing, and conflicts may occur if they are all used at
once.

protect serial/casette routine from RS-232 NMI's

.,F0A4 48 PHA RSP232 PHA ;SAVE .A
Akku auf Stack retten
save A
  store (A)
 
.,F0A5 AD A1 02 LDA $02A1 LDA ENABL ;DOES RS232 HAVE ANY ENABLES?
RS-232 NMI Status laden
get the RS-232 interrupt enable byte
  ENABL, RS232 enables
 
.,F0A8 F0 11 BEQ $F0BB BEQ RSPOK ;NO...
nicht gesetzt, dann ok
if no interrupts enabled just exit
  bus not in use
 
.,F0AA AD A1 02 LDA $02A1 RSPOFF LDA ENABL ;WAIT UNTILL DONE
RS-232 NMI Status laden
get the RS-232 interrupt enable byte
  ENABL
 
.,F0AD 29 03 AND #$03 AND #%00000011 ; WITH T1 & T2
Bit 0 = senden und Bit 1 =
empfangen
mask 0000 00xx, the error bits
  test RS232
 
.,F0AF D0 F9 BNE $F0AA BNE RSPOFF
warten bis beide Bits
gelöscht
if there are errors loop
  yes, wait for port to clear
 
.,F0B1 A9 10 LDA #$10 LDA #%00010000 ; DISABLE FLAG (NEED TO RENABLE IN USER CODE)
Bitwert für Interrupt durch
disable FLAG interrupt
     
.,F0B3 8D 0D DD STA $DD0D STA D2ICR ;TURN OF ENABL************
'Flag'-Leitung setzen
save VIA 2 ICR
  set up CIA#2 I.C.R
 
.,F0B6 A9 00 LDA #$00 LDA #0
RS-232 NMI Status
clear A
  clear
 
.,F0B8 8D A1 02 STA $02A1 STA ENABL ;CLEAR ALL ENABLS
zurücksetzen
clear the RS-232 interrupt enable byte
  ENABL
 
.,F0BB 68 PLA RSPOK PLA ;ALL DONE
Akku wieder holen
restore A
  retrieve (A)
 
.,F0BC 60 RTS RTS
.END

.LIB MESSAGES

MS1 .BYT $D,'I/O ERROR ',$A3
MS5 .BYT $D,'SEARCHING',$A0
MS6 .BYT 'FOR',$A0
MS7 .BYT $D,'PRESS PLAY ON TAP',$C5
MS8 .BYT 'PRESS RECORD & PLAY ON TAP',$C5
MS10 .BYT $D,'LOADIN',$C7
MS11 .BYT $D,'SAVING',$A0
MS21 .BYT $D,'VERIFYIN',$C7
MS17 .BYT $D,'FOUND',$A0
MS18 .BYT $D,'OK',$8D
; MS34 .BYT $D,'MONITOR',$8D
Rücksprung

Systemmeldungen

kernel I/O messages

 

TABLE OF KERNAL I/O MESSAGES 1

This is a table of messages used by the KERNAL in
conjunction with its I/O routines. Bit 7 is set in the
last character in each message as a terminator.

kernal I/O messages

.:F0BD 0D 49 2F 4F 20 45 52 52 ; MS36 .BYT $D,'BREA',$CB
;PRINT MESSAGE TO SCREEN ONLY IF
;OUTPUT ENABLED
;
I/O ERROR #
I/O ERROR #
  I/O error
I/O error
.:F0C6 52 20 A3 0D 53 45 41 52            
.:F0C9 0D 53 45 41 52 43 48 49   SEARCHING
SEARCHING
  searching for
searching for
.:F0D1 4E 47 A0 46 4F 52 A0 0D            
.:F0D4 46 4F 52 A0 0D 50 52 45   FOR
FOR
     
.:F0D8 0D 50 52 45 53 53 20 50   PRESS PLAY ON TAPE
PRESS PLAY ON TAPE
  press play on tape
press play on tape
.:F0E0 4C 41 59 20 4F 4E 20 54            
.:F0E8 41 50 C5 50 52 45 53 53            
.:F0EB 50 52 45 53 53 20 52 45   PRESS RECORD & PLAY ON TAPE
PRESS RECORD & PLAY ON TAPE
  press record and play on tape
press record and play on tape
.:F0F3 43 4F 52 44 20 26 20 50            
.:F0FB 4C 41 59 20 4F 4E 20 54            
.:F103 41 50 C5 0D 4C 4F 41 44            
.:F106 0D 4C 4F 41 44 49 4E C7   LOADING
LOADING
  loading
loading
.:F10E 0D 53 41 56 49 4E 47 A0   SAVING
SAVING
  saving
saving
.:F116 0D 56 45 52 49 46 59 49   VERIFYING
VERIFYING
  verifying
verifying
.:F11E 4E C7 0D 46 4F 55 4E 44            
.:F120 0D 46 4F 55 4E 44 A0 0D   FOUND
FOUND
  found
found
.:F127 0D 4F 4B 8D   OK

Systemmeldungen ausgeben

OK

display control I/O message if in direct mode

  ok

PRINT MESSAGE IF DIRECT

This is a routine to output a message from the I/O
messages table at $f0bd. On entry, (Y) holds the offset to
control which message is printed. The routine tests if we
are in program mode or direct mode. If in program mode,
the routine exits. Else, the routine prints character
after caracter untill it reaches a character with bit7
set.
ok

print kernal message indexed by Y

.,F12B 24 9D BIT $9D SPMSG BIT MSGFLG ;PRINTING MESSAGES?
Direkt-Modus Flag
test message mode flag
  MSGFLG, test if direct or program mode
 
.,F12D 10 0D BPL $F13C BPL MSG10 ;NO...
Programm, dann überspringen
exit if control messages off
display kernel I/O message
  program mode, don't print message
 
.,F12F B9 BD F0 LDA $F0BD,Y MSG LDA MS1,Y
Zeichen holen mit Offset der
Meldung in Y-Register
get byte from message table
  get output character from table
 
.,F132 08 PHP PHP
Status-Register retten
save status
  store processor registers
 
.,F133 29 7F AND #$7F AND #$7F
Bit 7 löschen
clear b7
  clear bit7
 
.,F135 20 D2 FF JSR $FFD2 JSR BSOUT
und Zeichen ausgeben
output character to channel
  output character using CHROUT
 
.,F138 C8 INY INY
Zeiger erhöhen
increment index
  increment pointer to next character
 
.,F139 28 PLP PLP
Status wiederholen
restore status
  retrieve message
 
.,F13A 10 F3 BPL $F12F BPL MSG
verzweige wenn noch weitere
Buchstaben
loop if not end of message
  untill bit7 was set
 
.,F13C 18 CLC MSG10 CLC
Carry löschen, ok
    clear carry to indicate no error
 
.,F13D 60 RTS RTS
.END

.LIB CHANNELIO

;***************************************
;* GETIN -- GET CHARACTER FROM CHANNEL *
;* CHANNEL IS DETERMINED BY DFLTN.*
;* IF DEVICE IS 0, KEYBOARD QUEUE IS *
;* EXAMINED AND A CHARACTER REMOVED IF *
;* AVAILABLE. IF QUEUE IS EMPTY, Z *
;* FLAG IS RETURNED SET. DEVICES 1-31 *
;* ADVANCE TO BASIN. *
;***************************************
;
Rücksprung

GETIN

get character from the input device

 

GETIN: GET a BYTE

The KERNAL routine GETIN ($ffe4) is vectored to this
routine. It load a character into fac#1 from the external
device indicated by DFLTN. Thus, if device = 0, GET is
from the keyboard buffer. If device = 2, GET is from the
RS232 port. If neither of these devices then GET is
further handled by the next routine, INPUT.

get a character

.,F13E A5 99 LDA $99 NGETIN LDA DFLTN ;CHECK DEVICE
Eingabegerät laden
get the input device number
  DFLTN, default input device.
 
.,F140 D0 08 BNE $F14A BNE GN10 ;NOT KEYBOARD
;
verzweige wenn nicht Tastatur
if not the keyboard go handle other devices
the input device was the keyboard
  not keyboard
 
.,F142 A5 C6 LDA $C6 LDA NDX ;QUEUE INDEX
Anzahl der Zeichen im
Tastaturpuffer laden
get the keyboard buffer index
  NDX, number of keys in keyboard queue
 
.,F144 F0 0F BEQ $F155 BEQ GN20 ;NOBODY THERE...EXIT
;
verzweige wenn kein Zeichen
if the buffer is empty go flag no byte and return
  buffer empty, exit
 
.,F146 78 SEI SEI
Interruptflag setzen
disable the interrupts
  disable interrupts
 
.,F147 4C B4 E5 JMP $E5B4 JMP LP2 ;GO REMOVE A CHARACTER
;
Zeichen aus Tastaturpuffer
holen
get input from the keyboard buffer and return
the input device was not the keyboard
  get character from keyboard buffer, and exit
 
.,F14A C9 02 CMP #$02 GN10 CMP #2 ;IS IT RS-232
Geräteadresse für RS-232
compare the device with the RS232 device
  RS232
 
.,F14C D0 18 BNE $F166 BNE BN10 ;NO...USE BASIN
;
nein dann zur BASIN-Routine
if not the RS232 device go ??
the input device is the RS232 device
  nope, try next device
 
.,F14E 84 97 STY $97 GN232 STY XSAV ;SAVE .Y, USED IN RS232
Y-Register merken
save Y
  temp store
 
.,F150 20 86 F0 JSR $F086 JSR BSI232
Get von RS 232
get a byte from RS232 buffer
  get character from RS232
 
.,F153 A4 97 LDY $97 LDY XSAV ;RESTORE .Y
Y-Register wiederholen
restore Y
  retrieve (Y)
 
.,F155 18 CLC GN20 CLC ;GOOD RETURN
Carry löschen, ok
flag no error
     
.,F156 60 RTS RTS
;***************************************
;* BASIN-- INPUT CHARACTER FROM CHANNEL*
;* INPUT DIFFERS FROM GET ON DEVICE*
;* #0 FUNCTION WHICH IS KEYBOARD. THE *
;* SCREEN EDITOR MAKES READY AN ENTIRE *
;* LINE WHICH IS PASSED CHAR BY CHAR *
;* UP TO THE CARRIAGE RETURN. OTHER *
;* DEVICES ARE: *
;* 0 -- KEYBOARD *
;* 1 -- CASSETTE #1 *
;* 2 -- RS232 *
;* 3 -- SCREEN *
;* 4-31 -- SERIAL BUS *
;***************************************
;
Rücksprung

BASIN Eingabe eines

Zeichens

input a character from channel

 

CHRIN: INPUT A BYTE

The KERNAL routine CHRIN ($ffcf) is vectored to this
routine. It is similar in function to the GET routine
above, and also provides a continuation to that routine.
If the input device is 0 or 3, ie. keyboard or screen,
then input takes place from the screen. INPUT/GET from
other devices are performed by calls to the next routine.
Two bytes are input from the device so that end of file
can be set if necessary (ie. ST = #40)

input a character

.,F157 A5 99 LDA $99 NBASIN LDA DFLTN ;CHECK DEVICE
Gerätenummer laden
get the input device number
  DFLTN, default input
 
.,F159 D0 0B BNE $F166 BNE BN10 ;IS NOT KEYBOARD...
;
;INPUT FROM KEYBOARD
;
verzweige wenn nicht Tastatur
if not the keyboard continue
the input device was the keyboard
  not keyboard, next device
 
.,F15B A5 D3 LDA $D3 LDA PNTR ;SAVE CURRENT...
Cursorposition holen
get the cursor column
  PNTR, cursor column on screen
 
.,F15D 85 CA STA $CA STA LSTP ;... CURSOR COLUMN
und für
set the input cursor column
  >LXSP, cursor position at start
 
.,F15F A5 D6 LDA $D6 LDA TBLX ;SAVE CURRENT...
Tastatureingabe
get the cursor row
  TBLX, cursor line number
 
.,F161 85 C9 STA $C9 STA LSXP ;... LINE NUMBER
setzen
set the input cursor row
  <LXSP
 
.,F163 4C 32 E6 JMP $E632 JMP LOOP5 ;BLINK CURSOR UNTIL RETURN
;
Eingabe vom Bildschirm
input from screen or keyboard
the input device was not the keyboard
  input from screen or keyboard
 
.,F166 C9 03 CMP #$03 BN10 CMP #3 ;IS INPUT FROM SCREEN?
Eingabekanal 3 = Bildschirm
compare device number with screen
  screen
 
.,F168 D0 09 BNE $F173 BNE BN20 ;NO...
;
wenn nicht verzweige

vom Bildschirm

if not screen continue
the input device was the screen
  nope, next device
 
.,F16A 85 D0 STA $D0 STA CRSW ;FAKE A CARRIAGE RETURN
Flag auf Eingabe von Bild-
schimrstelle
input from keyboard or screen, $xx = screen,
$00 = keyboard
  CRSW, flag INPUT/GET from keyboard
 
.,F16C A5 D5 LDA $D5 LDA LNMX ;SAY WE ENDED...
Cursorzeile laden
get current screen line length
  LNMX, physical screen line length
 
.,F16E 85 C8 STA $C8 STA INDX ;...UP ON THIS LINE
als Pointer für Ende der
Zeile speichern
save input [EOL] pointer
  INDX, end of logical line for input
 
.,F170 4C 32 E6 JMP $E632 JMP LOOP5 ;PICK UP CHARACTERS
;
zu Eingabe vom Bildschirm
input from screen or keyboard
the input device was not the screen
  input from screen of keyboard
 
.,F173 B0 38 BCS $F1AD BN20 BCS BN30 ;DEVICES >3
verzweige zu Eingabe vom
IEC-Bus
if input device > screen go do IEC devices
the input device was < screen
     
.,F175 C9 02 CMP #$02 CMP #2 ;RS232?
Eingabe von RS-232 ?
compare the device with the RS232 device
  RS232
 
.,F177 F0 3F BEQ $F1B8 BEQ BN50
;
;INPUT FROM CASSETTE BUFFERS
;
ja, so verzweige

Eingabe vom Band

if RS232 device go get a byte from the RS232 device
only the tape device left ..
  yes, get data from RS232 port
 
.,F179 86 97 STX $97 STX XSAV
X-Register merken
save X
     
.,F17B 20 99 F1 JSR $F199 JSR JTGET
ein Zeichen vom Band holen
get a byte from tape
     
.,F17E B0 16 BCS $F196 BCS JTG37 ;STOP KEY/ERROR
verzweige bei Fehler
if error just exit
     
.,F180 48 PHA PHA
Akku retten
save the byte
     
.,F181 20 99 F1 JSR $F199 JSR JTGET
ein Zeichen vom Band holen
get the next byte from tape
     
.,F184 B0 0D BCS $F193 BCS JTG36 ;STOP KEY/ERROR
verzweige bei Fehler
if error just exit
     
.,F186 D0 05 BNE $F18D BNE JTG35 ;NOT AN END OF FILE
letzes Zeichen ?
if end reached ??
     
.,F188 A9 40 LDA #$40 LDA #64 ;TELL USER EOF
Code für 'End of Identify'
set EOI
     
.,F18A 20 1C FE JSR $FE1C JSR UDST ;IN STATUS
Status setzen
OR into the serial status byte
     
.,F18D C6 A6 DEC $A6 JTG35 DEC BUFPT
Bandpuffer Zeiger erniedrigen
decrement tape buffer index
     
.,F18F A6 97 LDX $97 LDX XSAV ;.X PRESERVED
X-Register zurückholen
restore X
     
.,F191 68 PLA PLA ;CHARACTER RETURNED
;C-CLEAR FROM JTGET
geholtes Zeichen in Akku
restore the saved byte
     
.,F192 60 RTS RTS ;ALL DONE
;
Rücksprung
       
.,F193 AA TAX JTG36 TAX ;SAVE ERROR INFO
Fehlernummer ins X-Register
copy the error byte
     
.,F194 68 PLA PLA ;TOSS DATA
Stack normalisieren
dump the saved byte
     
.,F195 8A TXA TXA ;RESTORE ERROR
Fehlernummer in Akku
restore error byte
     
.,F196 A6 97 LDX $97 JTG37 LDX XSAV ;RETURN
X-Register zurückholen
restore X
     
.,F198 60 RTS RTS ;ERROR RETURN C-SET FROM JTGET
;GET A CHARACTER FROM APPROPRIATE
;CASSETTE BUFFER
;
Rücksprung

ein Zeichen vom Band holen

get byte from tape

   

read a byte from cassette buffer

.,F199 20 0D F8 JSR $F80D JTGET JSR JTP20 ;BUFFER POINTER WRAP?
Bandpuffer Zeiger erhöhen
bump tape pointer
     
.,F19C D0 0B BNE $F1A9 BNE JTG10 ;NO...
verzweige wenn noch Zeichen
im Puffer
if not end get next byte and exit
     
.,F19E 20 41 F8 JSR $F841 JSR RBLK ;YES...READ NEXT BLOCK
sonst nächsten Block vom
Band holen
initiate tape read
     
.,F1A1 B0 11 BCS $F1B4 BCS BN33 ;STOP KEY PRESSED
STOP-Taste, dann Abbruch
exit if error flagged
     
.,F1A3 A9 00 LDA #$00 LDA #0
Pufferzeiger
clear A
     
.,F1A5 85 A6 STA $A6 STA BUFPT ;POINT TO BEGIN.
auf Null
clear tape buffer index
     
.,F1A7 F0 F0 BEQ $F199 BEQ JTGET ;BRANCH ALWAYS
;
unbedingter Sprung
loop, branch always
     
.,F1A9 B1 B2 LDA ($B2),Y JTG10 LDA (TAPE1)Y ;GET CHAR FROM BUF
Zeichen aus Puffer lesen
get next byte from buffer
     
.,F1AB 18 CLC CLC ;GOOD RETURN
Carry =0 (ok Kennzeichen)
flag no error
     
.,F1AC 60 RTS RTS
;INPUT FROM SERIAL BUS
;
Rücksprung

Eingabe vom IEC-Bus

input device was serial bus
 

GET FROM SERIAL/RS232

These routines, actually two different, is entered from
the previous routine. The serial sectionchecks the state
of ST. If zero, then the data is recieved from the bus,
otherwise carriage return (#0d) is returned in (A). In the
second section, the recieved byte is read from the RS232
port.
 
.,F1AD A5 90 LDA $90 BN30 LDA STATUS ;STATUS FROM LAST
Status testen
get the serial status byte
  STATUS, I/O status word
 
.,F1AF F0 04 BEQ $F1B5 BEQ BN35 ;WAS GOOD
verzweige wenn ok
if no errors flagged go input byte and return
  status OK
 
.,F1B1 A9 0D LDA #$0D BN31 LDA #$D ;BAD...ALL DONE
'CR' Kode ausgeben
else return [EOL]
  else return <CR> and exit
 
.,F1B3 18 CLC BN32 CLC ;VALID DATA
Carry =0 (ok Kennzeichen)
flag no error
     
.,F1B4 60 RTS BN33 RTS
;
Rücksprung
     

read a byte from serial bus

.,F1B5 4C 13 EE JMP $EE13 BN35 JMP ACPTR ;GOOD...HANDSHAKE
;
;INPUT FROM RS232
;
ein Byte vom IEC-Bus holen

RS 232 Eingabe

input byte from serial bus and return
input device was RS232 device
  ACPTR, get byte from serial bus

read a byte from RS-232 bus

.,F1B8 20 4E F1 JSR $F14E BN50 JSR GN232 ;GET INFO
ein Byte von RS 232 holen
get byte from RS232 device
  receive from RS232
 
.,F1BB B0 F7 BCS $F1B4 BCS BN33 ;ERROR RETURN
verzweige wenn Fehler
branch if error, this doesn't get taken as the last
instruction in the get byte from RS232 device routine
is CLC ??
  end with carry set
 
.,F1BD C9 00 CMP #$00 CMP #00
vergleiche mit Nullbyte
compare with null
     
.,F1BF D0 F2 BNE $F1B3 BNE BN32 ;GOOD DATA...EXIT
nein, dann ok
exit if not null
  end with carry clear
 
.,F1C1 AD 97 02 LDA $0297 LDA RSSTAT ;CHECK FOR DSR OR DCD ERROR
Status laden
get the RS232 status register
  RSSTAT, 6551 status register
 
.,F1C4 29 60 AND #$60 AND #$60
fehlt DSR ?
mask 0xx0 0000, DSR detected and ??
  mask
 
.,F1C6 D0 E9 BNE $F1B1 BNE BN31 ;AN ERROR...EXIT WITH C/R
ja, 'CR' zurückgeben
if ?? return null
  return with <CR>
 
.,F1C8 F0 EE BEQ $F1B8 BEQ BN50 ;NO ERROR...STAY IN LOOP
;***************************************
;* BSOUT -- OUT CHARACTER TO CHANNEL *
;* DETERMINED BY VARIABLE DFLTO: *
;* 0 -- INVALID *
;* 1 -- CASSETTE #1 *
;* 2 -- RS232 *
;* 3 -- SCREEN *
;* 4-31 -- SERIAL BUS *
;***************************************
;
nein, neuer Versuch

BSOUT Ausgabe eines

Zeichens

else loop, branch always

output character to channel

  get from RS232

CHROUT: OUTPUT ONE CHARACTER

The KERNAL routine CHROUT ($ffd2) is vectored to this
routine. On entry, (A) must hold the character to be
output. The default output device number is examined, and
output directed to relevant device. The screen, serial bus
and RS232 all use previously described routines for their
output.

output a character

.,F1CA 48 PHA NBSOUT PHA ;PRESERVE .A
Datenbyte retten
save the character to output
  temp store on stack
 
.,F1CB A5 9A LDA $9A LDA DFLTO ;CHECK DEVICE
Gerätenummer für Ausgabe
get the output device number
  DFLTO, default output device
 
.,F1CD C9 03 CMP #$03 CMP #3 ;IS IT THE SCREEN?
vergleiche mit Bildschirm
compare the output device with the screen
  screen?
 
.,F1CF D0 04 BNE $F1D5 BNE BO10 ;NO...
;
;PRINT TO CRT
;
verzweige wenn nein
if not the screen go ??
  nope, test next device
 
.,F1D1 68 PLA PLA ;RESTORE DATA
Datenbyte wiederholen
else restore the output character
  retrieve (A)
 
.,F1D2 4C 16 E7 JMP $E716 JMP PRT ;PRINT ON CRT
;
BO10
ein Zeichen auf Bildschirm
ausgeben
go output the character to the screen
  output to screen
 
.,F1D5 90 04 BCC $F1DB BCC BO20 ;DEVICE 1 OR 2
;
;PRINT TO SERIAL BUS
;
verzweige wenn keine Ausgabe
IEC-Bus

Ausgabe auf IEC-Bus

if < screen go ??
  device <3
 
.,F1D7 68 PLA PLA
Datenbyte retten
else restore the output character
  retrieve (A)
 
.,F1D8 4C DD ED JMP $EDDD JMP CIOUT
;
;PRINT TO CASSETTE DEVICES
;
ein Byte auf IEC-Bus ausgeben
go output the character to the serial bus
  send serial deferred
 
.,F1DB 4A LSR BO20 LSR A ;RS232?
Bit 0 der Ausgabekanal-
Nummer ins Carry
shift b0 of the device into Cb
     
.,F1DC 68 PLA PLA ;GET DATA OFF STACK...
;
Datenbyte wiederholen
restore the output character

output the character to the cassette or RS232 device

     
.,F1DD 85 9E STA $9E CASOUT STA T1 ;PASS DATA IN T1
; CASOUT MUST BE ENTERED WITH CARRY SET!!!
;PRESERVE REGISTERS
;
auszugebendes Zeichen merken
save the character to the character buffer
  PTR1
 
.,F1DF 8A TXA TXA
X-Register
copy X
     
.,F1E0 48 PHA PHA
und Y-Register
save X
     
.,F1E1 98 TYA TYA
auf Stack
copy Y
     
.,F1E2 48 PHA PHA
retten
save Y
     
.,F1E3 90 23 BCC $F208 BCC BO50 ;C-CLR MEANS DFLTO=2 (RS232)
;
RS-232 Ausgabe

Ausgabe auf Band

if Cb is clear it must be the RS232 device
output the character to the cassette
  RS232
 
.,F1E5 20 0D F8 JSR $F80D JSR JTP20 ;CHECK BUFFER POINTER
Bandpuffer Zeiger erhöhen
bump the tape pointer
     
.,F1E8 D0 0E BNE $F1F8 BNE JTP10 ;HAS NOT REACHED END
verzweige wenn Puffer
nicht voll
if not end save next byte and exit
     
.,F1EA 20 64 F8 JSR $F864 JSR WBLK ;WRITE FULL BUFFER
Puffer auf Band schreiben
initiate tape write
     
.,F1ED B0 0E BCS $F1FD BCS RSTOR ;ABORT ON STOP KEY
;
;PUT BUFFER TYPE BYTE
;
STOP-Taste, dann Abbruch
exit if error
     
.,F1EF A9 02 LDA #$02 LDA #BDF
Kontrollbyte für Datenblock
set data block type ??
     
.,F1F1 A0 00 LDY #$00 LDY #0
Pufferzeiger auf 0
clear index
     
.,F1F3 91 B2 STA ($B2),Y STA (TAPE1)Y
;
;RESET BUFFER POINTER
;
Akku in Puffer schreiben
save type to buffer ??
     
.,F1F5 C8 INY INY ;MAKE .Y=1
Zeiger erhöhen
increment index
     
.,F1F6 84 A6 STY $A6 STY BUFPT ;BUFPT=1
;
und merken
save tape buffer index
     
.,F1F8 A5 9E LDA $9E JTP10 LDA T1
Datenbyte holen
restore character from character buffer
     
.,F1FA 91 B2 STA ($B2),Y STA (TAPE1)Y ;DATA TO BUFFER
;
;RESTORE .X AND .Y
;
Zeichen in Puffer schreiben
save to buffer
     
.,F1FC 18 CLC RSTOA CLC ;GOOD RETURN
Carry =0 (ok Kennzeichen)
flag no error
     
.,F1FD 68 PLA RSTOR PLA
X-Register
pull Y
     
.,F1FE A8 TAY TAY
und Y-Register
restore Y
     
.,F1FF 68 PLA PLA
aus Stack
pull X
     
.,F200 AA TAX TAX
holen
restore X
     
.,F201 A5 9E LDA $9E LDA T1 ;GET .A FOR RETURN
Datenbyte zurückholen
get the character from the character buffer
     
.,F203 90 02 BCC $F207 BCC RSTOR1 ;NO ERROR
verzweige wenn ok
exit if no error
     
.,F205 A9 00 LDA #$00 LDA #00 ;STOP ERROR IF C-SET
Flag für 'STOP-Taste
gedrückt'
else clear A
     
.,F207 60 RTS RSTOR1 RTS
;
;OUTPUT TO RS232
;
Rücksprung

RS-232 Ausgabe

output the character to the RS232 device
     
.,F208 20 17 F0 JSR $F017 BO50 JSR BSO232 ;PASS DATA THROUGH VARIABLE T1
ein Zeichen in RS-232
Puffer schreiben
send byte to the RS232 buffer, no setup
  send to RS232
 
.,F20B 4C FC F1 JMP $F1FC JMP RSTOA ;GO RESTORE ALL..ALWAYS GOOD
.END

.LIB OPENCHANNEL

;***************************************
;* CHKIN -- OPEN CHANNEL FOR INPUT *
;* *
;* THE NUMBER OF THE LOGICAL FILE TO BE*
;* OPENED FOR INPUT IS PASSED IN .X. *
;* CHKIN SEARCHES THE LOGICAL FILE *
;* TO LOOK UP DEVICE AND COMMAND INFO. *
;* ERRORS ARE REPORTED IF THE DEVICE *
;* WAS NOT OPENED FOR INPUT ,(E.G. *
;* CASSETTE WRITE FILE), OR THE LOGICAL*
;* FILE HAS NO REFERENCE IN THE TABLES.*
;* DEVICE 0, (KEYBOARD), AND DEVICE 3 *
;* (SCREEN), REQUIRE NO TABLE ENTRIES *
;* AND ARE HANDLED SEPARATE. *
;***************************************
;
CHROUT

CHKIN Eingabegerät setzen

do no error exit

open channel for input

  end output

CHKIN: SET INPUT DEVICE

The KERNAL routine CHKIN ($ffc6) is vectored to this
routine. On entry, (X) must hold the logical file number.
A test is made to see if the file is open, or ?FILE NOT
OPEN. If the file is not an input file then ?NOT INPUT
FILE. If the device is on the serial bus then it is
commanded to TALK and secondary address is sent. ST is
then checked, and if non-zero, ?DEVICE NOT PRESENT.
Finally, the device number is stored in DLFTN.

set input device

.,F20E 20 0F F3 JSR $F30F NCHKIN JSR LOOKUP ;SEE IF FILE KNOWN
sucht logische Filenummer
find a file
  find file number
 
.,F211 F0 03 BEQ $F216 BEQ JX310 ;YUP...
;
verzweige wenn gefunden
if the file is open continue
  ok, skip next command
 
.,F213 4C 01 F7 JMP $F701 JMP ERROR3 ;NO...FILE NOT OPEN
;
sonst 'file not open'
else do 'file not open' error and return
  I/O error #3, file not open
 
.,F216 20 1F F3 JSR $F31F JX310 JSR JZ100 ;EXTRACT FILE INFO
;
setzt Fileparameter
set file details from table,X
  set file variables
 
.,F219 A5 BA LDA $BA LDA FA
Gerätenummer laden
get the device number
  FA, current device number
 
.,F21B F0 16 BEQ $F233 BEQ JX320 ;IS KEYBOARD...DONE.
;
;COULD BE SCREEN, KEYBOARD, OR SERIAL
;
0, Tastatur
if the device was the keyboard save the device #, flag
ok and exit
  keyboard
 
.,F21D C9 03 CMP #$03 CMP #3
vergleiche mit Bildschirm
compare the device number with the screen
  screen
 
.,F21F F0 12 BEQ $F233 BEQ JX320 ;IS SCREEN...DONE.
verzweige zu Bildschirm
if the device was the screen save the device #, flag ok
and exit
  yes
 
.,F221 B0 14 BCS $F237 BCS JX330 ;IS SERIAL...ADDRESS IT
verzweige zu IEC-Bus
if the device was a serial bus device go ??
  larger than 3, serial bus device
 
.,F223 C9 02 CMP #$02 CMP #2 ;RS232?
vergleiche mit RS-232
else compare the device with the RS232 device
  RS232
 
.,F225 D0 03 BNE $F22A BNE JX315 ;NO...
;
nein, dann Band
if not the RS232 device continue
  nope
 
.,F227 4C 4D F0 JMP $F04D JMP CKI232
;
;SOME EXTRA CHECKS FOR TAPE
;
ja, dann RS-232

Band als Eingabegerät setzen

else go get input from the RS232 buffer and return
  input from RS232
 
.,F22A A6 B9 LDX $B9 JX315 LDX SA
Sekundäradresse laden
get the secondary address
  SA, current secondart address
 
.,F22C E0 60 CPX #$60 CPX #$60 ;IS COMMAND A READ?
vergleichemit 'Null'
       
.,F22E F0 03 BEQ $F233 BEQ JX320 ;YES...O.K....DONE
;
verzweige wenn 'Null'
       
.,F230 4C 0A F7 JMP $F70A JMP ERROR6 ;NOT INPUT FILE
;
sonst 'not input file'
go do 'not input file' error and return
  I/O error #6, not output file
 
.,F233 85 99 STA $99 JX320 STA DFLTN ;ALL INPUT COME FROM HERE
;
Gerätenummer für Ausgabe
speichern
save the input device number
  DFLTN, default input device
 
.,F235 18 CLC CLC ;GOOD EXIT
Carry =0 (ok Kennzeichen)
flag ok
     
.,F236 60 RTS RTS
;
;AN SERIAL DEVICE HAS TO BE A TALKER
;
Rücksprung

IEC-Bus als Eingabegerät

the device was a serial bus device
   

set serial bus input device

.,F237 AA TAX JX330 TAX ;DEVICE # FOR DFLTO
Geräteadresse retten
copy device number to X
     
.,F238 20 09 ED JSR $ED09 JSR TALK ;TELL HIM TO TALK
;
TALK senden
command serial bus device to TALK
  send TALK to serial device
 
.,F23B A5 B9 LDA $B9 LDA SA ;A SECOND?
Sekundäradresse laden
get the secondary address
  SA
 
.,F23D 10 06 BPL $F245 BPL JX340 ;YES...SEND IT
verzweige wenn kleiner 128
    send SA
 
.,F23F 20 CC ED JSR $EDCC JSR TKATN ;NO...LET GO
wartet auf Takt-Signal
wait for the serial bus end after send
  wait for clock
 
.,F242 4C 48 F2 JMP $F248 JMP JX350
;
nächsten Befehl überspringen
       
.,F245 20 C7 ED JSR $EDC7 JX340 JSR TKSA ;SEND SECOND
;
Sekundäradresse für TALK
senden
send secondary address after TALK
  send talk secondary address
 
.,F248 8A TXA JX350 TXA
Geräteadresse wiederholen
copy device back to A
     
.,F249 24 90 BIT $90 BIT STATUS ;DID HE LISTEN?
Status abfragen
test the serial status byte
  STATUS, I/O status word
 
.,F24B 10 E6 BPL $F233 BPL JX320 ;YES
;
verzweige wenn ok
if device present save device number and exit
  store DFLTN, and exit
 
.,F24D 4C 07 F7 JMP $F707 JMP ERROR5 ;DEVICE NOT PRESENT
;***************************************
;* CHKOUT -- OPEN CHANNEL FOR OUTPUT *
;* *
;* THE NUMBER OF THE LOGICAL FILE TO BE*
;* OPENED FOR OUTPUT IS PASSED IN .X. *
;* CHKOUT SEARCHES THE LOGICAL FILE *
;* TO LOOK UP DEVICE AND COMMAND INFO. *
;* ERRORS ARE REPORTED IF THE DEVICE *
;* WAS NOT OPENED FOR INPUT ,(E.G. *
;* KEYBOARD), OR THE LOGICAL FILE HAS *
;* REFERENCE IN THE TABLES. *
;* DEVICE 0, (KEYBOARD), AND DEVICE 3 *
;* (SCREEN), REQUIRE NO TABLE ENTRIES *
;* AND ARE HANDLED SEPARATE. *
;***************************************
;
sonst 'DEVICE NOT PRESENT'

CKOUT Ausgabegerät setzen

do 'device not present' error and return

open channel for output

  I/O error #5, device not present

CHKOUT: SET OUTPUT DEVICE

The KERNAL routine CHKOUT ($ffc9) is vectored to this
routinr. On entry (X) must hold the logical filenumber. A
test is made to see if the file is open, or ?FILE NOT OPEN
error. If the device is 0, ie. the keyboard, or the file
is not an output file, then ?FILE OUTPUT FILE error is
generated. If the device is on the serial bus, then it
commanded to LISTEN and the secondary address is sent. ST
is then checked and if non-zero, then ?DEVICE NOT PRESENT
error. Finally, the device number is stored in DFLTO.

set output device

.,F250 20 0F F3 JSR $F30F NCKOUT JSR LOOKUP ;IS FILE IN TABLE?
sucht logische Filenummer
find a file
  fine file number (X)
 
.,F253 F0 03 BEQ $F258 BEQ CK5 ;YES...
;
verzweige wenn gefunden
if file found continue
  OK
 
.,F255 4C 01 F7 JMP $F701 JMP ERROR3 ;NO...FILE NOT OPEN
;
sonst 'FILE NOT OPEN'
else do 'file not open' error and return
  I/O error #3, file not open
 
.,F258 20 1F F3 JSR $F31F CK5 JSR JZ100 ;EXTRACT TABLE INFO
;
setzt Fileparameter
set file details from table,X
  set file values
 
.,F25B A5 BA LDA $BA LDA FA ;IS IT KEYBOARD?
Gerätenummer holen
get the device number
  FA, current device number
 
.,F25D D0 03 BNE $F262 BNE CK10 ;NO...SOMETHING ELSE.
;
verzweige wenn ungleich Null
if the device is not the keyboard go ??
  not keyboard
 
.,F25F 4C 0D F7 JMP $F70D CK20 JMP ERROR7 ;YES...NOT OUTPUT FILE
;
;COULD BE SCREEN,SERIAL,OR TAPES
;
sonst 'NOT INPUT FILE'
go do 'not output file' error and return
  I/O error #7, not output file
 
.,F262 C9 03 CMP #$03 CK10 CMP #3
vergleiche mit Bildschirm ?
compare the device with the screen
  screen?
 
.,F264 F0 0F BEQ $F275 BEQ CK30 ;IS SCREEN...DONE
verzweige wenn Bildschirm
if the device is the screen go save output the output
device number and exit
  yes
 
.,F266 B0 11 BCS $F279 BCS CK40 ;IS SERIAL...ADDRESS IT
verzweige wenn IEC-Bus
if > screen then go handle a serial bus device
  serial bus device
 
.,F268 C9 02 CMP #$02 CMP #2 ;RS232?
vergleiche mit RS-232
compare the device with the RS232 device
  RS232
 
.,F26A D0 03 BNE $F26F BNE CK15
;
verzweige wenn nein
if not the RS232 device then it must be the tape device
  nope
 
.,F26C 4C E1 EF JMP $EFE1 JMP CKO232
;
;
;SPECIAL TAPE CHANNEL HANDLING
;
Ausgabe auf RS-232
vorbereiten

Band als Ausgabegerät setzen

else go open RS232 channel for output
open a tape channel for output
  submit to RS232
 
.,F26F A6 B9 LDX $B9 CK15 LDX SA
Sekundäradresse laden
get the secondary address
  SA, current secondary address
 
.,F271 E0 60 CPX #$60 CPX #$60 ;IS COMMAND READ?
mit 'Null' vergleichen
       
.,F273 F0 EA BEQ $F25F BEQ CK20 ;YES...ERROR
;
Bandfile zum Lesen, 'NOT
OUTPUT FILE'
if ?? do not output file error and return
  not output file error
 
.,F275 85 9A STA $9A CK30 STA DFLTO ;ALL OUTPUT GOES HERE
;
Nummer des Ausgabegeräts
setzen
save the output device number
  DFLTO, default output device
 
.,F277 18 CLC CLC ;GOOD EXIT
Carry =0 (ok Kennzeichen)
flag ok
  clear carry to incicate no errors
 
.,F278 60 RTS RTS
;
Rücksprung

Ausgabe auf IEC-Bus legen

     

set serial bus output device

.,F279 AA TAX CK40 TAX ;SAVE DEVICE FOR DFLTO
Geräteadresse retten
copy the device number
  file (X) to (A)
 
.,F27A 20 0C ED JSR $ED0C JSR LISTN ;TELL HIM TO LISTEN
;
LISTEN senden
command devices on the serial bus to LISTEN
  send LISTEN to serial device
 
.,F27D A5 B9 LDA $B9 LDA SA ;IS THERE A SECOND?
Sekundäradresse laden
get the secondary address
  SA
 
.,F27F 10 05 BPL $F286 BPL CK50 ;YES...
;
verzweige wenn kleiner 128
if address to send go ??
  send SA
 
.,F281 20 BE ED JSR $EDBE JSR SCATN ;NO...RELEASE LINES
ATN zurücksetzen
else set serial ATN high
  clear ATN
 
.,F284 D0 03 BNE $F289 BNE CK60 ;BRANCH ALWAYS
;
unbedingter Sprung
go ??, branch always
     
.,F286 20 B9 ED JSR $EDB9 CK50 JSR SECND ;SEND SECOND...
;
Sekundäradresse für LISTEN
senden
send secondary address after LISTEN
  send listen secondary address
 
.,F289 8A TXA CK60 TXA
Geräteadresse wiederholen
copy device number back to A
     
.,F28A 24 90 BIT $90 BIT STATUS ;DID HE LISTEN?
Status abfragen
test the serial status byte
  STATUS, I/O status word
 
.,F28C 10 E7 BPL $F275 BPL CK30 ;YES...FINISH UP
;
verzweige wenn ok
if the device is present go save the output device number
and exit
  OK, set output device
 
.,F28E 4C 07 F7 JMP $F707 JMP ERROR5 ;NO...DEVICE NOT PRESENT
.END

.LIB CLOSE

;***************************************
;* CLOSE -- CLOSE LOGICAL FILE *
;* *
;* THE LOGICAL FILE NUMBER OF THE*
;* FILE TO BE CLOSED IS PASSED IN .A.*
;* KEYBOARD, SCREEN, AND FILES NOT *
;* OPEN PASS STRAIGHT THROUGH. TAPE *
;* FILES OPEN FOR WRITE ARE CLOSED BY*
;* DUMPING THE LAST BUFFER AND *
;* CONDITIONALLY WRITING AN END OF *
;* TAPE BLOCK.SERIAL FILES ARE CLOSED*
;* BY SENDING A CLOSE FILE COMMAND IF*
;* A SECONDARY ADDRESS WAS SPECIFIED *
;* IN ITS OPEN COMMAND. *
;***************************************
;
'device not present'

CLOSE logische Filenummer

im Akku

else do 'device not present error' and return

close a specified logical file

  I/O error #5, device not present

CLOSE: CLOSE FILE, PART 1

The KERNAL routine CLOSE ($ffc3) is vectored here. The
file parameters are fetched, and if not found, the routine
exits without any action. It checks the device number
associated with the file. If it is RS232, then the RS232
port is reset. If it is a serial device, the device is
UNTALKed, or UNLISTENed. Finally the number of open
logical files are decremented, and the table of active
file numbers are updated. On entry (A) holds the file
number to close.

close a file

.,F291 20 14 F3 JSR $F314 NCLOSE JSR JLTLK ;LOOK FILE UP
sucht logische Filenummer
find file A
  find logical file, (X) holds location i table
 
.,F294 F0 02 BEQ $F298 BEQ JX050 ;OPEN...
verzweige wenn gefunden
if file found go close it
  OK
 
.,F296 18 CLC CLC ;ELSE RETURN
File nicht vorhanden, dann
fertig
else the file was closed so just flag ok
  file not found
 
.,F297 60 RTS RTS
;
Rücksprung
file found so close it
  and exit
 
.,F298 20 1F F3 JSR $F31F JX050 JSR JZ100 ;EXTRACT TABLE DATA
Fileparameter setzen
set file details from table,X
  get file values from table, position (X)
 
.,F29B 8A TXA TXA ;SAVE TABLE INDEX
Zeiger auf Parametereintrag
in Filetabelle
copy file index to A
     
.,F29C 48 PHA PHA
;
retten
save file index
  temp store
 
.,F29D A5 BA LDA $BA LDA FA ;CHECK DEVICE NUMBER
Geräteadresse laden
get the device number
  FA, current device number
 
.,F29F F0 50 BEQ $F2F1 BEQ JX150 ;IS KEYBOARD...DONE
verzweige wenn Tastatur
if it is the keyboard go restore the index and close the
file
  keyboard?, update file table
 
.,F2A1 C9 03 CMP #$03 CMP #3
vergleiche mit Bildschirm
compare the device number with the screen
  screen
 
.,F2A3 F0 4C BEQ $F2F1 BEQ JX150 ;IS SCREEN...DONE
verzweige wenn Bildschirm
if it is the screen go restore the index and close the
file
  yepp, update file table
 
.,F2A5 B0 47 BCS $F2EE BCS JX120 ;IS SERIAL...PROCESS
verzweige wenn IEC-Bus
if > screen go do serial bus device close
  Serial bus
 
.,F2A7 C9 02 CMP #$02 CMP #2 ;RS232?
vergleiche mit RS-232
compare the device with the RS232 device
  RS232
 
.,F2A9 D0 1D BNE $F2C8 BNE JX115 ;NO...
;
; RS-232 CLOSE
;
; REMOVE FILE FROM TABLES
nein, dann Band

RS-232 File schließen

if not the RS232 device go ??
else close RS232 device
  nope, serial
 
.,F2AB 68 PLA PLA
Zeiger auf Parametereintrag
restore file index
  retrieve (A)
 
.,F2AC 20 F2 F2 JSR $F2F2 JSR JXRMV
;
Fileeintrag in Tabelle
löschen
close file index X
  remove entry (A) from file table
 
.,F2AF 20 83 F4 JSR $F483 JSR CLN232 ;CLEAN UP RS232 FOR CLOSE
;
; DEALLOCATE BUFFERS
;
CIAs für I/O rücksetzen
initialise RS232 output
  init RS232 port by using part of RS232OPEN
 
.,F2B2 20 27 FE JSR $FE27 JSR GETTOP ;GET MEMSIZ
Memory-Top holen
read the top of memory
  MEMTOP, read top of memory (X/Y)
 
.,F2B5 A5 F8 LDA $F8 LDA RIBUF+1 ;CHECK INPUT ALLOCATION
RS-232 Eingabepuffer
HIGH-Byte laden
get the RS232 input buffer pointer high byte
  >RIBUF, RS232 input buffer
 
.,F2B7 F0 01 BEQ $F2BA BEQ CLS010 ;NOT...ALLOCATED
verzweige wenn 0
if no RS232 input buffer go ??
     
.,F2B9 C8 INY INY
HIGH-Byte von Memory-Top
erhöhen
else reclaim RS232 input buffer memory
     
.,F2BA A5 FA LDA $FA CLS010 LDA ROBUF+1 ;CHECK OUTPUT ALLOCATION
RS-232 Ausgabepuffer
HIGH-Byte laden
get the RS232 output buffer pointer high byte
  >ROBUF, RS232 output buffer
 
.,F2BC F0 01 BEQ $F2BF BEQ CLS020
verzweige wenn 0
if no RS232 output buffer skip the reclaim
     
.,F2BE C8 INY INY
sonst HIGH-Byte von Memory-
Top erhöhen
else reclaim the RS232 output buffer memory
     
.,F2BF A9 00 LDA #$00 CLS020 LDA #00 ;DEALLOCATE
0 laden
clear A
  Clear RS232 input/output buffers
 
.,F2C1 85 F8 STA $F8 STA RIBUF+1
und Puffer
clear the RS232 input buffer pointer high byte
     
.,F2C3 85 FA STA $FA STA ROBUF+1
; FLAG TOP OF MEMORY CHANGE
freigeben
clear the RS232 output buffer pointer high byte
     
.,F2C5 4C 7D F4 JMP $F47D JMP MEMTCF ;GO SET NEW TOP
;
;CLOSE CASSETTE FILE
;
Memory Top neu setzen

Band File schließen

go set the top of memory to F0xx
is not the RS232 device
  Set new ROBOF values and set new MEMTOP

close cassette device

.,F2C8 A5 B9 LDA $B9 JX115 LDA SA ;WAS IT A TAPE READ?
Sekundäradresse laden
get the secondary address
     
.,F2CA 29 0F AND #$0F AND #$F
Bits 0 bis 3 isolieren
mask the device #
     
.,F2CC F0 23 BEQ $F2F1 BEQ JX150 ;YES
;
verzweige wenn File zum Lesen
if ?? restore index and close file
     
.,F2CE 20 D0 F7 JSR $F7D0 JSR ZZZ ;NO. . .IT IS WRITE
Band-Puffer Startadresse
holen
get tape buffer start pointer in XY
     
.,F2D1 A9 00 LDA #$00 LDA #0 ;END OF FILE CHARACTER
Markierung für letztes
Zeichen im Datenpuffer
character $00
     
.,F2D3 38 SEC SEC ;NEED TO SET CARRY FOR CASOUT (ELSE RS232 OUTPUT!)
Flag für Ausgabe auf Recorder
flag the tape device
     
.,F2D4 20 DD F1 JSR $F1DD JSR CASOUT ;PUT IN END OF FILE
Zeichen in Kassettenpuffer
output the character to the cassette or RS232 device
     
.,F2D7 20 64 F8 JSR $F864 JSR WBLK
Puffer auf Band schreiben
initiate tape write
     
.,F2DA 90 04 BCC $F2E0 BCC JX117 ;NO ERRORS...
verzweige wenn alles ok
       
.,F2DC 68 PLA PLA ;CLEAN STACK FOR ERROR
Zeiger auf Fileeintrag holen
       
.,F2DD A9 00 LDA #$00 LDA #0 ;BREAK KEY ERROR
0 für Break
       
.,F2DF 60 RTS RTS
;
Rücksprung
       
.,F2E0 A5 B9 LDA $B9 JX117 LDA SA
Sekundäradresse laden
get the secondary address
     
.,F2E2 C9 62 CMP #$62 CMP #$62 ;WRITE END OF TAPE BLOCK?
vergleiche auf Open mit EOT
       
.,F2E4 D0 0B BNE $F2F1 BNE JX150 ;NO...
;
verzweige wenn kein EOT
if not ?? restore index and close file
     
.,F2E6 A9 05 LDA #$05 LDA #EOT
Kontrollbyte für EOT-Header
set logical end of the tape
     
.,F2E8 20 6A F7 JSR $F76A JSR TAPEH ;WRITE END OF TAPE BLOCK
Block auf Band schreiben
write tape header
     
.,F2EB 4C F1 F2 JMP $F2F1 JMP JX150
;
;CLOSE AN SERIAL FILE
;
Überspringe nächsten Befehl
restore index and close file

serial bus device close

 

CLOSE: CLOSE FILE, PART 2

close serial bus device

.,F2EE 20 42 F6 JSR $F642 JX120 JSR CLSEI
;
;ENTRY TO REMOVE A GIVE LOGICAL FILE
;FROM TABLE OF LOGICAL, PRIMARY,
;AND SECONDARY ADDRESSES
;
IEC-File schließen
close serial bus device
  UNTALK/UNLISTEN serial device
 
.,F2F1 68 PLA JX150 PLA ;GET TABLE INDEX OFF STACK
;
; JXRMV - ENTRY TO USE AS AN RS-232 SUBROUTINE
;
Zeiger auf Fileeintrag holen
restore file index

close file index X

   

reorganise file tables

.,F2F2 AA TAX JXRMV TAX
ins X-Register schieben
copy index to file to close
     
.,F2F3 C6 98 DEC $98 DEC LDTND
Anzahl der offenen Files
erniedrigen
decrement the open file count
  decrement LDTND, number of open files
 
.,F2F5 E4 98 CPX $98 CPX LDTND ;IS DELETED FILE AT END?
und mit Zeiger auf
Fileeintrag vergleichen
compare the index with the open file count
  compare LDTND to (X)
 
.,F2F7 F0 14 BEQ $F30D BEQ JX170 ;YES...DONE
;
;DELETE ENTRY IN MIDDLE BY MOVING
;LAST ENTRY TO THAT POSITION.
;
gleich, dann fertig
exit if equal, last entry was closing file
else entry was not last in list so copy last table entry
file details over the details of the closing one
  equal, closed file = last file in table
 
.,F2F9 A4 98 LDY $98 LDY LDTND
Anzahl der offenen Files
get the open file count as index
  else, move last entry to position of closed entry
 
.,F2FB B9 59 02 LDA $0259,Y LDA LAT,Y
Letzten Fileeintrag
get last+1 logical file number from logical file table
  LAT, active filenumbers
 
.,F2FE 9D 59 02 STA $0259,X STA LAT,X
an die
save logical file number over closed file
     
.,F301 B9 63 02 LDA $0263,Y LDA FAT,Y
freigewordene
get last+1 device number from device number table
  FAT, active device numbers
 
.,F304 9D 63 02 STA $0263,X STA FAT,X
Stelle in der
save device number over closed file
     
.,F307 B9 6D 02 LDA $026D,Y LDA SAT,Y
Filetabelle
get last+1 secondary address from secondary address table
  SAT, active secondary addresses
 
.,F30A 9D 6D 02 STA $026D,X STA SAT,X
;
schreiben
save secondary address over closed file
     
.,F30D 18 CLC JX170 CLC ;CLOSE EXIT
Carry =0 (ok Kennzeichnung)
flag ok
     
.,F30E 60 RTS JX175 RTS
;LOOKUP TABLIZED LOGICAL FILE DATA
;
Rücksprung

sucht logische Filenummer

(in X)

find a file

  return

FIND FILE

This routine finds a logical file from it's file number.
On entry, (X) must hold the logical file number to be
found. LAT, the table of file numbers is searched, and if
found (X) contains the offset to the position of the file
in the table, and the Z flag is set. If not found, Z=0.

check X against logical file table

.,F30F A9 00 LDA #$00 LOOKUP LDA #0
Status
clear A
     
.,F311 85 90 STA $90 STA STATUS
löschen
clear the serial status byte
  clear STATUS
 
.,F313 8A TXA TXA
Filenummer in Akku schieben
copy the logical file number to A

find file A

  file number to search for
 
.,F314 A6 98 LDX $98 JLTLK LDX LDTND
Anzahl der offenen Files
get the open file count
  LDTND, number of open files
 
.,F316 CA DEX JX600 DEX
Anzahl um eins verringern
decrememnt the count to give the index
     
.,F317 30 15 BMI $F32E BMI JZ101
verzweige wenn kein File
offen oder Filenummer nicht
gefunden
if no files just exit
  end of table, return
 
.,F319 DD 59 02 CMP $0259,X CMP LAT,X
sucht Eintrag in Tabelle
compare the logical file number with the table logical
file number
  compare file number with LAT, table of open files
 
.,F31C D0 F8 BNE $F316 BNE JX600
verzweige wenn noch nicht
gefunden
if no match go try again
  not equal, try next
 
.,F31E 60 RTS RTS
;ROUTINE TO FETCH TABLE ENTRIES
;
Rücksprung

setzt Fileparameter

set file details from table,X

  back with Z flag set

SEET FILE VALUES

This routine sets the current logical file number, device
number and secondary address from the file parameter
tables. On entry (X) must hold the offset to the position
of the file in the table.

set file parameters depending on X

.,F31F BD 59 02 LDA $0259,X JZ100 LDA LAT,X
logische Filenummer aus
get logical file from logical file table
  LAT, table of active logical files
 
.,F322 85 B8 STA $B8 STA LA
Tabelle holen und speichern
save the logical file
  store in LA
 
.,F324 BD 63 02 LDA $0263,X LDA FAT,X
Geräteadresse aus Tabelle
get device number from device number table
  FAT, table of active device numbers
 
.,F327 85 BA STA $BA STA FA
holen und speichern
save the device number
  store in FA
 
.,F329 BD 6D 02 LDA $026D,X LDA SAT,X
Sekundäradresse aus Tabelle
get secondary address from secondary address table
  SAT, table of active secondary addresses
 
.,F32C 85 B9 STA $B9 STA SA
holen und speichern
save the secondary address
  store in SAT
 
.,F32E 60 RTS JZ101 RTS
.END

.LIB CLALL

;***************************************
;* CLALL -- CLOSE ALL LOGICAL FILES *
;* DELETES ALL TABLE ENTRIES AND*
;* RESTORES DEFAULT I/O CHANNELS *
;* AND CLEARS IEEE PORT DEVICES *
;*************************************
;
Rücksprung

CLALL schließt alle

Ein-/Ausgabe Kanäle

close all channels and files

  return

CLALL: ABORT ALL FILES

The KERNAL routine CLALL ($ffe7) is vectored here. The
number of open files are set to zero, and the next routine
is performed.

close all files

.,F32F A9 00 LDA #$00 NCLALL LDA #0
Anzahl der offenen Files
clear A
     
.,F331 85 98 STA $98 STA LDTND ;FORGET ALL FILES
;********************************************
;* CLRCH -- CLEAR CHANNELS *
;* UNLISTEN OR UNTALK IEEE DEVICES, BUT *
;* LEAVE OTHERS ALONE. DEFAULT CHANNELS *
;* ARE RESTORED. *
;********************************************
;
auf Null stellen

CLRCH schließt aktiven

I/O-Kanal

clear the open file count

close input and output channels

  clear LDTND, no open files

CLRCHN: RESTORE TO DEFAULT I/O

The KERNAL routine CLRCHN ($ffcc) is vectored here. The
default output device is UNLISTENed, if it is on the
serial bus, and the default output is set to the screen.
The default input device is UNTALKed, if it is on the
serial bus, and the default input device is set to
keyboard.

restore I/O to default devices

.,F333 A2 03 LDX #$03 NCLRCH LDX #3
Vergleichswert in X
set the screen device
  check if device > 3 (serial bus is 4,5...)
 
.,F335 E4 9A CPX $9A CPX DFLTO ;IS OUTPUT CHANNEL IEEE?
vergleiche mit Nummer des
Ausgabegeräts
compare the screen with the output device number
  test DFLTO, default output device
 
.,F337 B0 03 BCS $F33C BCS JX750 ;NO...
;
verzweige wenn kleiner als 3
if <= screen skip the serial bus unlisten
  nope, no serial device
 
.,F339 20 FE ED JSR $EDFE JSR UNLSN ;YES...UNLISTEN IT
;
IEC, UNLISTEN senden
else command the serial bus to UNLISTEN
  send UNLISTEN to serial bus
 
.,F33C E4 99 CPX $99 JX750 CPX DFLTN ;IS INPUT CHANNEL IEEE?
vergleiche mit Nummer des
Eingabegeräts
compare the screen with the input device number
  test DFLTI, default input device
 
.,F33E B0 03 BCS $F343 BCS CLALL2 ;NO...
;
verzweige wenn kleiner als 3
if <= screen skip the serial bus untalk
  nope, no serial device
 
.,F340 20 EF ED JSR $EDEF JSR UNTLK ;YES...UNTALK IT
;
;RESTORE DEFAULT VALUES
;
;
IEC, UNTALK senden
else command the serial bus to UNTALK
  send UNTALK to serial bus
 
.,F343 86 9A STX $9A CLALL2 STX DFLTO ;OUTPUT CHAN=3=SCREEN
Ausgabe wieder auf Bildschirm
save the screen as the output device number
  store screen as DFLTO
 
.,F345 A9 00 LDA #$00 LDA #0
Eingabe wieder
set the keyboard as the input device
     
.,F347 85 99 STA $99 STA DFLTN ;INPUT CHAN=0=KEYBOARD
von Tastatur
save the input device number
  store keyboard as DFLTI
 
.,F349 60 RTS RTS
.END

.LIB OPEN

;***********************************
;* *
;* OPEN FUNCTION *
;* *
;* CREATES AN ENTRY IN THE LOGICAL *
;* FILES TABLES CONSISTING OF *
;* LOGICAL FILE NUMBER--LA, DEVICE *
;* NUMBER--FA, AND SECONDARY CMD-- *
;* SA. *
;* *
;* A FILE NAME DESCRIPTOR, FNADR & *
;* FNLEN ARE PASSED TO THIS ROUTINE*
;* *
;***********************************
;
Rücksprung

OPEN

open a logical file

 

OPEN: OPEN FILE

The KERNAL routine OPEN ($ffc0) is vectored here. The file
paramerters must be set before entry. The routine reads
the LAT, to see if file already exists, which will result
in I/O error #2, ?FILE OPEN. A test is made to see if more
than 10 files are open. If so, I/O error #1, ?TOO MANY
FiLES, will occur. The file parameters are set, and put in
their respective tables. The device number is checked, and
each kind of device jumps to their own routine. Keyboard
and screen will exit here with no further actions. RS232
is opened via a seperate routine. SA, secondary address,
and filename will be sent on the serial bus.

open a file

.,F34A A6 B8 LDX $B8 NOPEN LDX LA ;CHECK FILE #
Filenummer in X
get the logical file
  LA, current logical number
 
.,F34C D0 03 BNE $F351 BNE OP98 ;IS NOT THE KEYBOARD
;
verzweige wenn ungleich Null
if there is a file continue
     
.,F34E 4C 0A F7 JMP $F70A JMP ERROR6 ;NOT INPUT FILE...
;
'not input file' (??)
else do 'not input file error' and return
  I/O error #6, not input file
 
.,F351 20 0F F3 JSR $F30F OP98 JSR LOOKUP ;SEE IF IN TABLE
sucht logische Filenummer
find a file
  find file (X)
 
.,F354 D0 03 BNE $F359 BNE OP100 ;NOT FOUND...O.K.
;
nicht gefunden, kann neu
angelegt werden
if file not found continue
     
.,F356 4C FE F6 JMP $F6FE JMP ERROR2 ;FILE OPEN
;
sonst 'file open'
else do 'file already open' error and return
  I/O error #2, file exists
 
.,F359 A6 98 LDX $98 OP100 LDX LDTND ;LOGICAL DEVICE TABLE END
Anzahl der offenen Files
get the open file count
  LDTND, number of open files
 
.,F35B E0 0A CPX #$0A CPX #10 ;MAXIMUM # OF OPEN FILES
mit 10 vergleichen
compare it with the maximum + 1
  more than ten
 
.,F35D 90 03 BCC $F362 BCC OP110 ;LESS THAN 10...O.K.
;
kleiner 10 dann ok
if less than maximum + 1 go open the file
  nope
 
.,F35F 4C FB F6 JMP $F6FB JMP ERROR1 ;TOO MANY FILES
;
'too many files'
else do 'too many files error' and return
  I/O error #1, too many files
 
.,F362 E6 98 INC $98 OP110 INC LDTND ;NEW FILE
Anzahl erhöhen
increment the open file count
  increment LDTND
 
.,F364 A5 B8 LDA $B8 LDA LA
logische Filenummer laden
get the logical file
  LA
 
.,F366 9D 59 02 STA $0259,X STA LAT,X ;STORE LOGICAL FILE #
und in die Tabelle schreiben
save it to the logical file table
  store in LAT, table of active file numbers
 
.,F369 A5 B9 LDA $B9 LDA SA
Sekundäradresse laden
get the secondary address
  SA
 
.,F36B 09 60 ORA #$60 ORA #$60 ;MAKE SA AN SERIAL COMMAND
Bit 5 und 6 setzen
OR with the OPEN CHANNEL command
  fixx
 
.,F36D 85 B9 STA $B9 STA SA
wieder speichern
save the secondary address
  store in SA
 
.,F36F 9D 6D 02 STA $026D,X STA SAT,X ;STORE COMMAND #
und in die Tabelle schreiben
save it to the secondary address table
  store in SAT, table of active secondary addresses
 
.,F372 A5 BA LDA $BA LDA FA
Gerätenummer laden
get the device number
  FA
 
.,F374 9D 63 02 STA $0263,X STA FAT,X ;STORE DEVICE #
;
;PERFORM DEVICE SPECIFIC OPEN TASKS
;
und in die Tabelle schreiben
save it to the device number table
  store in FAT, table of active device numbers
 
.,F377 F0 5A BEQ $F3D3 BEQ OP175 ;IS KEYBOARD...DONE.
verzweige wenn Gerätenummer
für Tastatur
if it is the keyboard go do the ok exit
  keyboard, end
 
.,F379 C9 03 CMP #$03 CMP #3
Code für Bildschirm
compare the device number with the screen
  screen
 
.,F37B F0 56 BEQ $F3D3 BEQ OP175 ;IS SCREEN...DONE.
ja, so verzweige
if it is the screen go do the ok exit
  yep, end
 
.,F37D 90 05 BCC $F384 BCC OP150 ;ARE CASSETTES 1 & 2
;
verzweige wenn nicht IEC-Bus
if tape or RS232 device go ??
else it is a serial bus device
  less than 3, not serial bus
 
.,F37F 20 D5 F3 JSR $F3D5 JSR OPENI ;IS ON SERIAL...OPEN IT
File auf IEC-Bus eröffnen
send the secondary address and filename
  send SA
 
.,F382 90 4F BCC $F3D3 BCC OP175 ;BRANCH ALWAYS...DONE
;
;PERFORM TAPE OPEN STUFF
;
unbedingter Sprung
go do ok exit, branch always
  end
 
.,F384 C9 02 CMP #$02 OP150 CMP #2
Code für Band
    TAPE
 
.,F386 D0 03 BNE $F38B BNE OP152
;
verzweige wenn nein
    I/O error #5, device not present
 
.,F388 4C 09 F4 JMP $F409 JMP OPN232
;
RS-232 open
go open RS232 device and return
  open RS232 file

open for cassette device

.,F38B 20 D0 F7 JSR $F7D0 OP152 JSR ZZZ ;SEE IF TAPE BUFFER
Bandpuffer Startadresse in X
und Y holen
get tape buffer start pointer in XY
     
.,F38E B0 03 BCS $F393 BCS OP155 ;YES
;
verzweige wenn HIGH-Byte
größer als 2
if >= $0200 go ??
     
.,F390 4C 13 F7 JMP $F713 JMP ERROR9 ;NO...DEALLOCATED
;
'illegal device number'
else do 'illegal device number' and return
     
.,F393 A5 B9 LDA $B9 OP155 LDA SA
Sekundäradresse laden
get the secondary address
     
.,F395 29 0F AND #$0F AND #$F ;MASK OFF COMMAND
Bits 0 bis 3 isolieren
       
.,F397 D0 1F BNE $F3B8 BNE OP200 ;NON ZERO IS TAPE WRITE
;
;OPEN CASSETE TAPE FILE TO READ
;
ungleich Null dann schreiben
       
.,F399 20 17 F8 JSR $F817 JSR CSTE1 ;TELL "PRESS PLAY"
wartet auf Play-Taste
wait for PLAY
     
.,F39C B0 36 BCS $F3D4 BCS OP180 ;STOP KEY PRESSED
;
verzweige wenn Play Taste
gedrückt
exit if STOP was pressed
     
.,F39E 20 AF F5 JSR $F5AF JSR LUKING ;TELL USER "SEARCHING"
;
'SEARCHING' ('for name')
ausgeben
print "Searching..."
     
.,F3A1 A5 B7 LDA $B7 LDA FNLEN
Länge des Filenamens
get file name length
     
.,F3A3 F0 0A BEQ $F3AF BEQ OP170 ;LOOKING FOR ANY FILE
;
kein Filename, dann weiter
if null file name just go find header
     
.,F3A5 20 EA F7 JSR $F7EA JSR FAF ;LOOKING FOR NAMED FILE
sucht gewünschen Bandheader
find specific tape header
     
.,F3A8 90 18 BCC $F3C2 BCC OP171 ;FOUND IT!!!
verzweige wenn gefunden
branch if no error
     
.,F3AA F0 28 BEQ $F3D4 BEQ OP180 ;STOP KEY PRESSED
;
verzweige wenn STOP-Taste
exit if ??
     
.,F3AC 4C 04 F7 JMP $F704 OP160 JMP ERROR4 ;FILE NOT FOUND
;
EOT, 'FILE NOT FOUND'
ausgeben
do file not found error and return
     
.,F3AF 20 2C F7 JSR $F72C OP170 JSR FAH ;GET ANY OLD HEADER
nächsten Bandheader suchen
find tape header, exit with header in buffer
     
.,F3B2 F0 20 BEQ $F3D4 BEQ OP180 ;STOP KEY PRESSED
EOT, Fehler
exit if end of tape found
     
.,F3B4 90 0C BCC $F3C2 BCC OP171 ;ALL O.K.
verzweige wenn gefunden
       
.,F3B6 B0 F4 BCS $F3AC BCS OP160 ;FILE NOT FOUND...
;
;OPEN CASSETTE TAPE FOR WRITE
;
sonst PRG-File, weiter suchen
     

open cassette for input

.,F3B8 20 38 F8 JSR $F838 OP200 JSR CSTE2 ;TELL "PRESS PLAY AND RECORD"
wartet auf Record & Play
Taste
wait for PLAY/RECORD
     
.,F3BB B0 17 BCS $F3D4 BCS OP180 ;STOP KEY PRESSED
STOP-Taste, dann Abbruch
exit if STOP was pressed
     
.,F3BD A9 04 LDA #$04 LDA #BDFH ;DATA FILE HEADER TYPE
Kontrollbyte für Datenheader
set data file header
     
.,F3BF 20 6A F7 JSR $F76A JSR TAPEH ;WRITE IT
;
;FINISH OPEN FOR TAPE READ/WRITE
;
Header auf Band schreiben
write tape header
     
.,F3C2 A9 BF LDA #$BF OP171 LDA #BUFSZ-1 ;ASSUME FORCE READ
;
Zeiger auf Ende des
Bandpuffers
       
.,F3C4 A4 B9 LDY $B9 LDY SA
Sekundäradresse laden
get the secondary address
     
.,F3C6 C0 60 CPY #$60 CPY #$60 ;OPEN FOR READ?
vergleiche mit $60 für Band
lesen
       
.,F3C8 F0 07 BEQ $F3D1 BEQ OP172
;
;SET POINTERS FOR BUFFERING DATA
;
lesen, dann verzweige
       
.,F3CA A0 00 LDY #$00 LDY #0
Zeiger auf 0 setzen
clear index
     
.,F3CC A9 02 LDA #$02 LDA #BDF ;TYPE FLAG FOR BLOCK
Kontrollbyte für Datenblock
       
.,F3CE 91 B2 STA ($B2),Y STA (TAPE1)Y ;TO BEGIN OF BUFFER
in Bandpuffer schreiben
save to tape buffer
     
.,F3D0 98 TYA TYA
;
Zeiger in Akku
clear A
     
.,F3D1 85 A6 STA $A6 OP172 STA BUFPT ;POINT TO DATA
Zeiger in Bandpuffer setzen
save tape buffer index
     
.,F3D3 18 CLC OP175 CLC ;FLAG GOOD OPEN
Carry =0 (ok Kennzeichen)
flag ok
     
.,F3D4 60 RTS OP180 RTS ;EXIT IN PEACE
Rücksprung

File auf IEC-Bus eröffnen

send secondary address and filename

 

SEND SA

This routine exits if there is no secondary address or
filename specifyed. The I/O status word, ST, is reset, and
the serial device is commanded to LISTEN. A check is made
for a possible ?DEVICE NOT PRESENT error. Finally, the
filename is sent to the device.

open for serial bus devices

.,F3D5 A5 B9 LDA $B9 OPENI LDA SA
Sekundäradresse laden
get the secondary address
  SA, current secondary address
 
.,F3D7 30 FA BMI $F3D3 BMI OP175 ;NO SA...DONE
;
Rücksprung wenn größer,
gleich 128
ok exit if -ve
  exit
 
.,F3D9 A4 B7 LDY $B7 LDY FNLEN
Länge des Filenamens laden
get file name length
  FNLEN, length of filename
 
.,F3DB F0 F6 BEQ $F3D3 BEQ OP175 ;NO FILE NAME...DONE
;
gleich Null, dann fertig
ok exit if null
  exit
 
.,F3DD A9 00 LDA #$00 LDA #0 ;CLEAR THE SERIAL STATUS
Status
clear A
     
.,F3DF 85 90 STA $90 STA STATUS
;
löschen
clear the serial status byte
  clear STATUS, I/O status word
 
.,F3E1 A5 BA LDA $BA LDA FA
Geräteadressse laden
get the device number
  FA, current device number
 
.,F3E3 20 0C ED JSR $ED0C JSR LISTN ;DEVICE LA TO LISTEN
;
LISTEN
command devices on the serial bus to LISTEN
  send LISTEN to serial bus
 
.,F3E6 A5 B9 LDA $B9 LDA SA
Sekundäradresse laden
get the secondary address
  SA
 
.,F3E8 09 F0 ORA #$F0 ORA #$F0
Bits 4 bis 7 setzen (Open
Kennzeichnung)
OR with the OPEN command
     
.,F3EA 20 B9 ED JSR $EDB9 JSR SECND
;
Sekundäradresse senden
send secondary address after LISTEN
  send LISTEN SA
 
.,F3ED A5 90 LDA $90 LDA STATUS ;ANYBODY HOME?
Status testen
get the serial status byte
  STATUS
 
.,F3EF 10 05 BPL $F3F6 BPL OP35 ;YES...CONTINUE
;
;THIS ROUTINE IS CALLED BY OTHER
;KERNAL ROUTINES WHICH ARE CALLED
;DIRECTLY BY OS. KILL RETURN
;ADDRESS TO RETURN TO OS.
;
verzweige wenn ok
if device present skip the 'device not present' error
  ok
 
.,F3F1 68 PLA PLA
Stack
else dump calling address low byte
  remove two stack entries for RTS command
 
.,F3F2 68 PLA PLA
rücksetzen
dump calling address high byte
     
.,F3F3 4C 07 F7 JMP $F707 JMP ERROR5 ;DEVICE NOT PRESENT
;
'device not present'
do 'device not present' error and return
  I/O error #5, device not present
 
.,F3F6 A5 B7 LDA $B7 OP35 LDA FNLEN
Länge des Filenamens
get file name length
  FNLEN
 
.,F3F8 F0 0C BEQ $F406 BEQ OP45 ;NO NAME...DONE SEQUENCE
;
;SEND FILE NAME OVER SERIAL
;
kein Filename, dann fertig
branch if null name
  unlisten and exit
 
.,F3FA A0 00 LDY #$00 LDY #0
Zeiger auf Null setzen
clear index
  clear offset
 
.,F3FC B1 BB LDA ($BB),Y OP40 LDA (FNADR)Y
Filenamen holen
get file name byte
  FNADR, pointer to filename
 
.,F3FE 20 DD ED JSR $EDDD JSR CIOUT
auf IEC-Bus ausgeben
output byte to serial bus
  send byte on serial bus
 
.,F401 C8 INY INY
Zeiger erhöhen
increment index
  next character
 
.,F402 C4 B7 CPY $B7 CPY FNLEN
mit Länge des Filenamens
vergleichen
compare with file name length
  until entire filename is sent
 
.,F404 D0 F6 BNE $F3FC BNE OP40
;
verzweige wenn noch nicht
alle Zeichen
loop if not all done
  again
 
.,F406 4C 54 F6 JMP $F654 OP45 JMP CUNLSN ;JSR UNLSN: CLC: RTS
; OPN232 - OPEN AN RS-232 OR PARALLEL PORT FILE
;
; VARIABLES INITILIZED
; BITNUM - # OF BITS TO BE SENT CALC FROM M51CTR
; BAUDOF - BAUD RATE FULL
; RSSTAT - RS-232 STATUS REG
; M51CTR - 6551 CONTROL REG
; M51CDR - 6551 COMMAND REG
; M51AJB - USER BAUD RATE (CLOCK/BAUD/2-100)
; ENABL - 6526 NMI ENABLES (1-NMI BIT ON)
;
UNLISTEN, return

RS-232 Open

command serial bus to UNLISTEN and return

open RS232 device

  unlisten and exit

OPEN RS232

open RS-232 device

.,F409 20 83 F4 JSR $F483 OPN232 JSR CLN232 ;SET UP RS232, .Y=0 ON RETURN
;
; PASS PRAMS TO M51REGS
;
CIAs setzen
initialise RS232 output
     
.,F40C 8C 97 02 STY $0297 STY RSSTAT ;CLEAR STATUS
;
RS-232 Status löschen
save the RS232 status register
     
.,F40F C4 B7 CPY $B7 OPN020 CPY FNLEN ;CHECK IF AT END OF FILENAME
Länge des "Filenamens"
compare with file name length
     
.,F411 F0 0A BEQ $F41D BEQ OPN025 ;YES...
;
verzweige wenn kein Filename
exit loop if done
     
.,F413 B1 BB LDA ($BB),Y LDA (FNADR)Y ;MOVE DATA
die ersten
get file name byte
     
.,F415 99 93 02 STA $0293,Y STA M51CTR,Y ;TO M51REGS
vier
copy to 6551 register set
     
.,F418 C8 INY INY
Zeichen
increment index
     
.,F419 C0 04 CPY #$04 CPY #4 ;ONLY 4 POSSIBLE PRAMS
speichern
compare with $04
     
.,F41B D0 F2 BNE $F40F BNE OPN020
;
; CALC # OF BITS
;
verzweige wenn noch nicht
alle vier Zeichen
loop if not to 4 yet
     
.,F41D 20 4A EF JSR $EF4A OPN025 JSR BITCNT
Anzahl der Datenbits
berechnen
compute bit count
     
.,F420 8E 98 02 STX $0298 STX BITNUM
;
; CALC BAUD RATE
;
und speichern
save bit count
     
.,F423 AD 93 02 LDA $0293 LDA M51CTR
Kontrollregister holen
get pseudo 6551 control register
     
.,F426 29 0F AND #$0F AND #$0F
Bits für Baud-Rate isolieren
mask 0000 xxxx, baud rate
     
.,F428 F0 1C BEQ $F446 BNE OPN010
;
; CALCULATE START-TEST RATE...
; DIFFERENT THAN ORIGINAL RELEASE 901227-01
;
verzweige wenn User-Baud-Rate
if zero skip the baud rate setup
     
.,F42A 0A ASL ASL A ;GET OFFSET INTO TABLES
mal 2 für Tabelle
* 2 bytes per entry
     
.,F42B AA TAX TAX
als Zeiger merken
copy to the index
     
.,F42C AD A6 02 LDA $02A6 LDA PALNTS ;GET TV STANDARD
NTSC-Version
get the PAL/NTSC flag
     
.,F42F D0 09 BNE $F43A BNE OPN026
verzweige wenn nein
if PAL go set PAL timing
     
.,F431 BC C1 FE LDY $FEC1,X LDY BAUDO-1,X ;NTSC STANDARD
Baud-Rate, HIGH für
NTSC-Timing
get the NTSC baud rate value high byte
     
.,F434 BD C0 FE LDA $FEC0,X LDA BAUDO-2,X
Baud-Rate, LOW
get the NTSC baud rate value low byte
     
.,F437 4C 40 F4 JMP $F440 JMP OPN027
;
überspringe zwei Befehle
go save the baud rate values
     
.,F43A BC EB E4 LDY $E4EB,X OPN026 LDY BAUDOP-1,X ;PAL STANDARD
Baud-Rate, HIGH für
PAL-Timing
get the PAL baud rate value high byte
     
.,F43D BD EA E4 LDA $E4EA,X LDA BAUDOP-2,X
Baud-Rate, LOW
get the PAL baud rate value low byte
     
.,F440 8C 96 02 STY $0296 OPN027 STY M51AJB+1 ;HOLD START RATE IN M51AJB
HIGH-Byte speichern
save the nonstandard bit timing high byte
     
.,F443 8D 95 02 STA $0295 STA M51AJB
LOW-Byte speichern
save the nonstandard bit timing low byte
     
.,F446 AD 95 02 LDA $0295 OPN028 LDA M51AJB ;CALCULATE BAUD RATE
Timerwert = Baud-Rate *
zwei + $C8 (200)
get the nonstandard bit timing low byte
     
.,F449 0A ASL ASL
Timer LOW * zwei
* 2
     
.,F44A 20 2E FF JSR $FF2E JSR POPEN ;GOTO PATCH AREA
;
; CHECK FOR 3/X LINE RESPONSE
;
Timerwert für Baud-Rate
ermitteln
       
.,F44D AD 94 02 LDA $0294 OPN030 LDA M51CDR ;BIT 0 OF M51CDR
Kommandoregister laden
read the pseudo 6551 command register
     
.,F450 4A LSR LSR A
Prüfe ob 3-Line-Handshake
shift the X line/3 line bit into Cb
     
.,F451 90 09 BCC $F45C BCC OPN050 ;...3 LINE
;
; CHECK FOR X LINE PROPER STATES
;
verzweige wenn ja
if 3 line skip the DRS test
     
.,F453 AD 01 DD LDA $DD01 LDA D2PRB
Prüfe ob Data Set Ready
read VIA 2 DRB, RS232 port
     
.,F456 0A ASL ASL A
Bit 7 ins Carry
shift DSR in into Cb
     
.,F457 B0 03 BCS $F45C BCS OPN050
verzweige wenn DSR vorhanden
if DSR present skip the error set
     
.,F459 20 0D F0 JSR $F00D JMP CKDSRX ;NO DATA SET...DSR ERROR EXIT
;
; SET UP BUFFER POINTERS (DBE=DBS)
;
Status für DSR setzen
set no DSR
     
.,F45C AD 9B 02 LDA $029B OPN050 LDA RIDBE
Anfang RS-232 Eingabepuffer
get index to Rx buffer end
     
.,F45F 8D 9C 02 STA $029C STA RIDBS
mit Ende des Eingabepuffers
gleichsetzen
set index to Rx buffer start, clear Rx buffer
     
.,F462 AD 9E 02 LDA $029E LDA RODBE
Anfang des RS-232
Ausgabepuffers
get index to Tx buffer end
     
.,F465 8D 9D 02 STA $029D STA RODBS
;
; ALLOCATE BUFFERS
;
mit Ende des Ausgabepuffers
gleichsetzen
set index to Tx buffer start, clear Tx buffer
     
.,F468 20 27 FE JSR $FE27 OPN055 JSR GETTOP ;GET MEMSIZ
Memory Top holen
read the top of memory
     
.,F46B A5 F8 LDA $F8 LDA RIBUF+1 ;IN ALLOCATION...
HIGH-Byte des Zeigers auf
RS-232 Eingabepuffer
get the RS232 input buffer pointer high byte
     
.,F46D D0 05 BNE $F474 BNE OPN060 ;ALREADY
ungleich Null, so Eingabe-
puffer bereits angelegt
if buffer already set skip the save
     
.,F46F 88 DEY DEY ;THERE GOES 256 BYTES
HIGH-Byte Memory Top -1
decrement top of memory high byte, 256 byte buffer
     
.,F470 84 F8 STY $F8 STY RIBUF+1
als Zeiger für RS-232
Eingabepuffer speichern
save the RS232 input buffer pointer high byte
     
.,F472 86 F7 STX $F7 STX RIBUF
LOW-Byte Memory Top als LOW-
Byte Eingabepuffer setzen
save the RS232 input buffer pointer low byte
     
.,F474 A5 FA LDA $FA OPN060 LDA ROBUF+1 ;OUT ALLOCATION...
HIGH-Byte des Zeigers auf
RS-232 Ausgabepuffer
get the RS232 output buffer pointer high byte
     
.,F476 D0 05 BNE $F47D BNE MEMTCF ;ALREAY
verzweige wenn Ausgabepuffer
bereits angelegt
if ?? go set the top of memory to F0xx
     
.,F478 88 DEY DEY ;THERE GOES 256 BYTES
HIGH-Byte des Memory Top -1
       
.,F479 84 FA STY $FA STY ROBUF+1
und als Zeiger für RS-232
Ausgabepuffer setzen
save the RS232 output buffer pointer high byte
     
.,F47B 86 F9 STX $F9 STX ROBUF
LOW-Byte Memory Top als LOW-
Byte Ausgabepuffer setzen
save the RS232 output buffer pointer low byte

set the top of memory to F0xx

     
.,F47D 38 SEC MEMTCF SEC ;SIGNAL TOP OF MEMORY CHANGE
Carry =1 (Fehlerkennzeichen)
read the top of memory
     
.,F47E A9 F0 LDA #$F0 LDA #$F0
Ftag für Puffer schützen/
freigeben setzen
set $F000
     
.,F480 4C 2D FE JMP $FE2D JMP SETTOP ;TOP CHANGED
;
; CLN232 - CLEAN UP 232 SYSTEM FOR OPEN/CLOSE
; SET UP DDRB AND CB2 FOR RS-232
;
Memory-Top neu setzen

CIAs nach RS 232 rücksetzen

set the top of memory and return

initialise RS232 output

   

initialise CIA2

.,F483 A9 7F LDA #$7F CLN232 LDA #$7F ;CLEAR NMI'S
Bitwert für alle
disable all interrupts
     
.,F485 8D 0D DD STA $DD0D STA D2ICR
NMIs blockieren setzen
save VIA 2 ICR
     
.,F488 A9 06 LDA #$06 LDA #%00000110 ;DDRB
Bit 1 und 2 Ausgang
set RS232 DTR output, RS232 RTS output
     
.,F48A 8D 03 DD STA $DD03 STA D2DDRB
PORT B Richtung
save VIA 2 DDRB, RS232 port
     
.,F48D 8D 01 DD STA $DD01 STA D2PRB ;DTR,RTS HIGH
PORT A Richtung
save VIA 2 DRB, RS232 port
     
.,F490 A9 04 LDA #$04 LDA #$04 ;OUTPUT HIGH PA2
Bit 2 setzen
mask xxxx x1xx, set RS232 Tx DATA high
     
.,F492 0D 00 DD ORA $DD00 ORA D2PRA
Bit 2 = TXD
OR it with VIA 2 DRA, serial port and video address
     
.,F495 8D 00 DD STA $DD00 STA D2PRA
Ausgeben
save VIA 2 DRA, serial port and video address
     
.,F498 A0 00 LDY #$00 LDY #00
RS-232
clear Y
     
.,F49A 8C A1 02 STY $02A1 STY ENABL ;CLEAR ENABLS
NMI-Flag löschen
clear the RS-232 interrupt enable byte
     
.,F49D 60 RTS RTS
.END

.LIB LOAD

;**********************************
;* LOAD RAM FUNCTION *
;* *
;* LOADS FROM CASSETTE 1 OR 2, OR *
;* SERIAL BUS DEVICES >=4 TO 31 *
;* AS DETERMINED BY CONTENTS OF *
;* VARIABLE FA. VERIFY FLAG IN .A *
;* *
;* ALT LOAD IF SA=0, NORMAL SA=1 *
;* .X , .Y LOAD ADDRESS IF SA=0 *
;* .A=0 PERFORMS LOAD,<> IS VERIFY*
;* *
;* HIGH LOAD RETURN IN X,Y. *
;* *
;**********************************
Rücksprung

LOAD - Routine

load RAM from a device

 

LOAD: LOAD RAM

The kernal routine LOAD ($ffd5) is vectoed here. If a
relocated load is desired, then the start address is set
in MEMUSS. The load/verify flag is set, and the I/O status
word is reset. A test is done on the device number, less
than 3 results in illegal device number.

load ram from a device

.,F49E 86 C3 STX $C3 LOADSP STX MEMUSS ;.X HAS LOW ALT START
Startadresse
set kernal setup pointer low byte
  MEMUSS, relocated load address
 
.,F4A0 84 C4 STY $C4 STY MEMUSS+1
speichern
set kernal setup pointer high byte
     
.,F4A2 6C 30 03 JMP ($0330) LOAD JMP (ILOAD) ;MONITOR LOAD ENTRY
;
JMP $F4A5 LOAD-Vektor
do LOAD vector, usually points to $F4A5

load

  ILOAD vector. Points to $f4a5
normally F4A5

standard load ram entry

.,F4A5 85 93 STA $93 NLOAD STA VERCK ;STORE VERIFY FLAG
Load/Verify Flag
save load/verify flag
  VRECK, load/verify flag
 
.,F4A7 A9 00 LDA #$00 LDA #0
Status
clear A
     
.,F4A9 85 90 STA $90 STA STATUS
;
löschen
clear the serial status byte
  clear STATUS, I/O status
 
.,F4AB A5 BA LDA $BA LDA FA ;CHECK DEVICE NUMBER
Geräteadresse laden
get the device number
  get FA, current device
 
.,F4AD D0 03 BNE $F4B2 BNE LD20
;
ungleich Null, dann weiter
if not the keyboard continue
do 'illegal device number'
  keyboard
 
.,F4AF 4C 13 F7 JMP $F713 LD10 JMP ERROR9 ;BAD DEVICE #-KEYBOARD
;
'ILLEGAL DEVICE NUMBER'
else do 'illegal device number' and return
  I/O error #9, illegal device
 
.,F4B2 C9 03 CMP #$03 LD20 CMP #3
vergleiche mit Code für
Bildschirm
    screen?
 
.,F4B4 F0 F9 BEQ $F4AF BEQ LD10 ;DISALLOW SCREEN LOAD
verzweige wenn ja, Fehler
    yes, illegal device

LOAD FROM SERIAL BUS

The message 'SEARCHING' is printed and the filename is
sent with the TALK command and secondary address to the
serial bus. If EOI occurs at this point, then ?FILE NOT
FOUND is displayed. The message 'LOADING' or 'VERIFYING'
is output and a loop is entered, which recieves a byte
from the serial bus, checks the <STOP> key and either
stores the received byte, or compares it to the memory,
depending on the state of VERCK. Finally the bus is
UNTALKed.
 
.,F4B6 90 7B BCC $F533 BCC LD100 ;HANDLE TAPES DIFFERENT
;
;LOAD FROM CBM IEEE DEVICE
;
kleiner 3, dann vom Band

IEC-Load

    device < 3, eg tape or RS232, illegal device
 
.,F4B8 A4 B7 LDY $B7 LDY FNLEN ;MUST HAVE FILE NAME
Länge des Filenamens laden
get file name length
  FNLEN, length of filename
 
.,F4BA D0 03 BNE $F4BF BNE LD25 ;YES...OK
;
ungleich Null, dann ok
if not null name go ??
  if length not is zero
 
.,F4BC 4C 10 F7 JMP $F710 JMP ERROR8 ;MISSING FILE NAME
;
'MISSING FILENAME'
else do 'missing file name' error and return
  'MISSING FILENAME'
 
.,F4BF A6 B9 LDX $B9 LD25 LDX SA ;SAVE SA IN .X
Sekundäradresse laden
get the secondary address
  SA, current secondary address
 
.,F4C1 20 AF F5 JSR $F5AF JSR LUKING ;TELL USER LOOKING
'SEARCHING FOR' (filename)
print "Searching..."
  print "SEARCHING"
 
.,F4C4 A9 60 LDA #$60 LDA #$60 ;SPECIAL LOAD COMMAND
Sekundäradresse Null laden
(für OPEN)
       
.,F4C6 85 B9 STA $B9 STA SA
und speichern
save the secondary address
  set SA to $60
 
.,F4C8 20 D5 F3 JSR $F3D5 JSR OPENI ;OPEN THE FILE
;
File auf IEC-Bus eröffnen
send secondary address and filename
  send SA and filename
 
.,F4CB A5 BA LDA $BA LDA FA
Gerätenummer laden
get the device number
  FA, current devicenumber
 
.,F4CD 20 09 ED JSR $ED09 JSR TALK ;ESTABLISH THE CHANNEL
und TALK senden
command serial bus device to TALK
  send TALK to serial bus
 
.,F4D0 A5 B9 LDA $B9 LDA SA
Sekundäradresse laden
get the secondary address
  SA
 
.,F4D2 20 C7 ED JSR $EDC7 JSR TKSA ;TELL IT TO LOAD
;
und senden
send secondary address after TALK
  send TALK SA
 
.,F4D5 20 13 EE JSR $EE13 JSR ACPTR ;GET FIRST BYTE
Byte vom IEC-Bus holen
input byte from serial bus
  receive from serial bus
 
.,F4D8 85 AE STA $AE STA EAL
;
als Startadresse LOW spei
chern
save program start address low byte
  load address, <EAL
 
.,F4DA A5 90 LDA $90 LDA STATUS ;TEST STATUS FOR ERROR
Status laden
get the serial status byte
  check STATUS
 
.,F4DC 4A LSR LSR A
Bit 1
shift time out read ..
     
.,F4DD 4A LSR LSR A
ins Carry schieben
.. into carry bit
     
.,F4DE B0 50 BCS $F530 BCS LD90 ;FILE NOT FOUND...
falls gesetzt, dann Time out
(Fehler)
if timed out go do file not found error and return
  EOI set, file not found
 
.,F4E0 20 13 EE JSR $EE13 JSR ACPTR
Startadresse HIGH holen
input byte from serial bus
  recieve from serial bus
 
.,F4E3 85 AF STA $AF STA EAH
;
und speichern
save program start address high byte
  load address, >EAL
 
.,F4E5 8A TXA TXA ;FIND OUT OLD SA
Sekundäradresse laden
copy secondary address
  retrieve SA and test relocated load
 
.,F4E6 D0 08 BNE $F4F0 BNE LD30 ;SA<>0 USE DISK ADDRESS
verzweige falls ungleich Null
load location not set in LOAD call, so continue with the
load
     
.,F4E8 A5 C3 LDA $C3 LDA MEMUSS ;ELSE LOAD WHERE USER WANTS
Startadresse LOW laden
get the load address low byte
  use MEMUSS as load address
 
.,F4EA 85 AE STA $AE STA EAL
und speichern
save the program start address low byte
  store in <EAL
 
.,F4EC A5 C4 LDA $C4 LDA MEMUSS+1
Startadresse HIGH laden
get the load address high byte
     
.,F4EE 85 AF STA $AF STA EAH
und speichern
save the program start address high byte
  store in >EAL
 
.,F4F0 20 D2 F5 JSR $F5D2 LD30 JSR LODING ;TELL USER LOADING
;
'LOADING'/'VERIFYING'
ausgeben
       
.,F4F3 A9 FD LDA #$FD LD40 LDA #$FD ;MASK OFF TIMEOUT
Time-out
mask xxxx xx0x, clear time out read bit
  mask %11111101
 
.,F4F5 25 90 AND $90 AND STATUS
Bit
mask the serial status byte
  read ST
 
.,F4F7 85 90 STA $90 STA STATUS
;
löschen
set the serial status byte
     
.,F4F9 20 E1 FF JSR $FFE1 JSR STOP ;STOP KEY?
Stop-Taste abfragen
scan stop key, return Zb = 1 = [STOP]
  scan <STOP>
 
.,F4FC D0 03 BNE $F501 BNE LD45 ;NO...
;
nicht gedrückt, dann weiter
if not [STOP] go ??
  not stopped
 
.,F4FE 4C 33 F6 JMP $F633 JMP BREAK ;STOP KEY PRESSED
;
File schließen
else close the serial bus device and flag stop
     
.,F501 20 13 EE JSR $EE13 LD45 JSR ACPTR ;GET BYTE OFF IEEE
Programmbyte vom Bus holen
input byte from serial bus
  CPTR, recrive from serial bus
 
.,F504 AA TAX TAX
Akku in X-REG retten
copy byte
     
.,F505 A5 90 LDA $90 LDA STATUS ;WAS THERE A TIMEOUT?
Status testen
get the serial status byte
     
.,F507 4A LSR LSR A
Time-out
shift time out read ..
     
.,F508 4A LSR LSR A
Bit ins Carry schieben
.. into carry bit
     
.,F509 B0 E8 BCS $F4F3 BCS LD40 ;YES...TRY AGAIN
falls Fehler, dann abbrechen
if timed out go try again
     
.,F50B 8A TXA TXA
ansonsten Akku wiederholen
copy received byte back
     
.,F50C A4 93 LDY $93 LDY VERCK ;PERFORMING VERIFY?
Load/Verify Flag testen
get load/verify flag
     
.,F50E F0 0C BEQ $F51C BEQ LD50 ;NO...LOAD
gleich Null, dann LOAD
if load go load
else is verify
  jump to LOAD
 
.,F510 A0 00 LDY #$00 LDY #0
Zähler auf Null setzen
clear index
     
.,F512 D1 AE CMP ($AE),Y CMP (EAL)Y ;VERIFY IT
Verify, Vergleich
compare byte with previously loaded byte
  compare with memory
 
.,F514 F0 08 BEQ $F51E BEQ LD60 ;O.K....
verzweige falls gleich
if match go ??
  veryfied byte OK
 
.,F516 A9 10 LDA #$10 LDA #SPERR ;NO GOOD...VERIFY ERROR
Bit 4 für Status setzen
flag read error
     
.,F518 20 1C FE JSR $FE1C JSR UDST ;UPDATE STATUS
Status setzen
OR into the serial status byte
     
.:F51B 2C .BYTE $2C .BYT $2C ;SKIP NEXT STORE
;
Skip nach $F51E
makes next line BIT $AE91
  mask next write command
 
.,F51C 91 AE STA ($AE),Y LD50 STA (EAL)Y
Byte abspeichern
save byte to memory
  store in memory
 
.,F51E E6 AE INC $AE LD60 INC EAL ;INCREMENT STORE ADDR
LOW-Byte der Adresse erhöhen
increment save pointer low byte
  increment <EAL, next address
 
.,F520 D0 02 BNE $F524 BNE LD64
verzweige falls kein Übertrag
if no rollover go ??
  skip MSB
 
.,F522 E6 AF INC $AF INC EAH
ansonsten HIGH-Byte erhöhen
else increment save pointer high byte
  increment >EAL
 
.,F524 24 90 BIT $90 LD64 BIT STATUS ;EOI?
Status prüfen
test the serial status byte
  test STATUS
 
.,F526 50 CB BVC $F4F3 BVC LD40 ;NO...CONTINUE LOAD
;
verzweige wenn noch kein EOI
loop if not end of file
close file and exit
  get next byte
 
.,F528 20 EF ED JSR $EDEF JSR UNTLK ;CLOSE CHANNEL
UNTALK senden
command serial bus to UNTALK
  send UNTALK to serial bus
 
.,F52B 20 42 F6 JSR $F642 JSR CLSEI ;CLOSE THE FILE
File schließen
close serial bus device
     
.,F52E 90 79 BCC $F5A9 BCC LD180 ;BRANCH ALWAYS
;
vezweige wenn kein Fehler
if ?? go flag ok and exit
  end routine
 
.,F530 4C 04 F7 JMP $F704 LD90 JMP ERROR4 ;FILE NOT FOUND
;
;LOAD FROM TAPE
;
'FILE NOT FOUND'
do file not found error and return

??

  I/O error #4, file not found
 
.,F533 4A LSR LD100 LSR A
Gerätenummer feststellen
       
.,F534 B0 03 BCS $F539 BCS LD102 ;IF C-SET THEN IT'S CASSETTE
;
eins (Band) , dann weiter
       
.,F536 4C 13 F7 JMP $F713 JMP ERROR9 ;BAD DEVICE #
;
RS 232, 'ILLEGAL DEVICE
NUMBER'
else do 'illegal device number' and return
     
.,F539 20 D0 F7 JSR $F7D0 LD102 JSR ZZZ ;SET POINTERS AT TAPE
Bandpuffer Startadresse holen
get tape buffer start pointer in XY
     
.,F53C B0 03 BCS $F541 BCS LD104
verzweige wenn HIGH-Byte der
Bandpufferstartadresse größer/
gleich 2
if ??
     
.,F53E 4C 13 F7 JMP $F713 JMP ERROR9 ;DEALLOCATED...
sonst 'ILLEGAL DEVICE NUMBER'
else do 'illegal device number' and return
     
.,F541 20 17 F8 JSR $F817 LD104 JSR CSTE1 ;TELL USER ABOUT BUTTONS
wartet auf Play-Taste
wait for PLAY
     
.,F544 B0 68 BCS $F5AE BCS LD190 ;STOP KEY PRESSED?
STOP-Taste, dann Abbruch
exit if STOP was pressed
     
.,F546 20 AF F5 JSR $F5AF JSR LUKING ;TELL USER SEARCHING
;
'SEARCHING' ('for name')
ausgeben
print "Searching..."
     
.,F549 A5 B7 LDA $B7 LD112 LDA FNLEN ;IS THERE A NAME?
Länge des Filenamens laden
get file name length
     
.,F54B F0 09 BEQ $F556 BEQ LD150 ;NONE...LOAD ANYTHING
verzweige wenn Null
       
.,F54D 20 EA F7 JSR $F7EA JSR FAF ;FIND A FILE ON TAPE
gewünschten Bandheader suchen
find specific tape header
     
.,F550 90 0B BCC $F55D BCC LD170 ;GOT IT!
verzweige wenn gefunden
if no error continue
     
.,F552 F0 5A BEQ $F5AE BEQ LD190 ;STOP KEY PRESSED
STOP-Taste, dann Abbruch
exit if ??
     
.,F554 B0 DA BCS $F530 BCS LD90 ;NOPE...END OF TAPE
;
EOT, dann 'FILE NOT FOUND'
, branch always
     
.,F556 20 2C F7 JSR $F72C LD150 JSR FAH ;FIND ANY HEADER
nächsten Bandheader suchen
find tape header, exit with header in buffer
     
.,F559 F0 53 BEQ $F5AE BEQ LD190 ;STOP KEY PRESSED
STOP-Taste, dann Abbruch
exit if ??
     
.,F55B B0 D3 BCS $F530 BCS LD90 ;NO HEADER
;
'EOT', dann 'FILE NOT FOUND'
       
.,F55D A5 90 LDA $90 LD170 LDA STATUS
Status holen
get the serial status byte
     
.,F55F 29 10 AND #$10 AND #SPERR ;MUST GOT HEADER RIGHT
EOF-Bit ausblenden
mask 000x 0000, read error
     
.,F561 38 SEC SEC
Carry =1 (Fehlerkennzeichen)
flag fail
     
.,F562 D0 4A BNE $F5AE BNE LD190 ;IS BAD
;
verzweige falls Fehler
if read error just exit
     
.,F564 E0 01 CPX #$01 CPX #BLF ;IS IT A MOVABLE PROGRAM...
Header-Typ 1 = BASIC-
Programm (verschiebbar)
       
.,F566 F0 11 BEQ $F579 BEQ LD178 ;YES
;
verzweige wenn Header-Typ =1
       
.,F568 E0 03 CPX #$03 CPX #PLF ;IS IT A PROGRAM
3 = Maschinen-Programm
(absolut)
       
.,F56A D0 DD BNE $F549 BNE LD112 ;NO...ITS SOMETHING ELSE
;
verzweige wenn nicht 3
(falscher Header)
       
.,F56C A0 01 LDY #$01 LD177 LDY #1 ;FIXED LOAD...
Zeiger setzen
       
.,F56E B1 B2 LDA ($B2),Y LDA (TAPE1)Y ;...THE ADDRESS IN THE...
LOW-Byte Startadresse holen
       
.,F570 85 C3 STA $C3 STA MEMUSS ;...BUFFER IS THE START ADDRESS
und speichern
       
.,F572 C8 INY INY
Zeiger erhöhen
       
.,F573 B1 B2 LDA ($B2),Y LDA (TAPE1)Y
HIGH-Byte Startadresse holen
       
.,F575 85 C4 STA $C4 STA MEMUSS+1
und speichern
       
.,F577 B0 04 BCS $F57D BCS LD179 ;JMP ..CARRY SET BY CPX'S
;
unbedingter Sprung
       
.,F579 A5 B9 LDA $B9 LD178 LDA SA ;CHECK FOR MONITOR LOAD...
Sekundär-Adresse
get the secondary address
     
.,F57B D0 EF BNE $F56C BNE LD177 ;...YES WE WANT FIXED TYPE
;
ungleich Null, dann nicht
verschiebbar laden
       
.,F57D A0 03 LDY #$03 LD179 LDY #3 ;TAPEA - TAPESTA
;CARRY SET BY CPX'S
Zeiger setzen
       
.,F57F B1 B2 LDA ($B2),Y LDA (TAPE1)Y
LOW-Byte der Endadresse+1 des
Programms holen
       
.,F581 A0 01 LDY #$01 LDY #1
Zeiger auf LOW-Byte Anfangs
adresse setzen
       
.,F583 F1 B2 SBC ($B2),Y SBC (TAPE1)Y
von Endadresse subtrahieren
       
.,F585 AA TAX TAX ;LOW TO .X
Ergebnis ins X-REG schieben
       
.,F586 A0 04 LDY #$04 LDY #4
Zeiger auf HIGH-Byte der
Endadresse setzen
       
.,F588 B1 B2 LDA ($B2),Y LDA (TAPE1)Y
Endadresse holen
       
.,F58A A0 02 LDY #$02 LDY #2
Zeiger auf Startadresse
setzen
       
.,F58C F1 B2 SBC ($B2),Y SBC (TAPE1)Y
und von Endadresse subtrahie
ren
       
.,F58E A8 TAY TAY ;HIGH TO .Y
;
Ergebnis ins Y-REG schieben
       
.,F58F 18 CLC CLC ;EA = STA+(TAPEA-TAPESTA)
Carry für Addition löschen
       
.,F590 8A TXA TXA
LOW-Byte der Programmlänge
in Akku schieben
       
.,F591 65 C3 ADC $C3 ADC MEMUSS ;
mit LOW-Byte der Anfangs
adresse addieren
       
.,F593 85 AE STA $AE STA EAL
als LOW-Byte der Endadresse
speichern
       
.,F595 98 TYA TYA
HIGH-Byte der Programmlänge
in Akku schieben
       
.,F596 65 C4 ADC $C4 ADC MEMUSS+1
mit HIGH-Byte Anfangsadresse
addieren
       
.,F598 85 AF STA $AF STA EAH
als HIGH-Byte Endadresse
speichern
       
.,F59A A5 C3 LDA $C3 LDA MEMUSS ;SET UP STARTING ADDRESS
Startadresse
       
.,F59C 85 C1 STA $C1 STA STAL
nach $C1
set I/O start addresses low byte
     
.,F59E A5 C4 LDA $C4 LDA MEMUSS+1
und $C2
       
.,F5A0 85 C2 STA $C2 STA STAH
bringen
set I/O start addresses high byte
     
.,F5A2 20 D2 F5 JSR $F5D2 JSR LODING ;TELL USER LOADING
'LOADING' / 'VERIFYING'
ausgeben
display "LOADING" or "VERIFYING"
     
.,F5A5 20 4A F8 JSR $F84A JSR TRD ;DO TAPE BLOCK LOAD
Programm vom Band laden
do the tape read
     
.:F5A8 24 .BYTE $24 .BYT $24 ;CARRY FROM TRD
;
Skip nach $F5AA
makes next line BIT $18, keep the error flag in Cb
 

LOAD END

This is the last part of the loader routine which sets the
(X/Y) register with the endaddress of the loaded program,
clears carry and exit.
 
.,F5A9 18 CLC LD180 CLC ;GOOD EXIT
;
; SET UP END LOAD ADDRESS
;
Carry =0 (ok Kennzeichen)
flag ok
     
.,F5AA A6 AE LDX $AE LDX EAL
Endadresse
get the LOAD end pointer low byte
     
.,F5AC A4 AF LDY $AF LDY EAH
;
nach X/Y
get the LOAD end pointer high byte
     
.,F5AE 60 RTS LD190 RTS
;SUBROUTINE TO PRINT TO CONSOLE:
;
;SEARCHING [FOR NAME]
;
Rücksprung

'SEARCHING FOR' (Filename)

ausgeben

print "Searching..."

 

PRINT "SEARCHING"

If MSGFLG indicates program mode then the message is not
printed, otherwise the message "SEARCHING" is printed from
the KERNAL I/O message table. If the length of
filename >0 then the message "FOR" is printed, and the
routine drops through to print the filename.

handle messages for loading

.,F5AF A5 9D LDA $9D LUKING LDA MSGFLG ;SUPPOSED TO PRINT?
Direkt-Modus-Flag laden
get message mode flag
  MSGFLG, direct or program mode?
 
.,F5B1 10 1E BPL $F5D1 BPL LD115 ;...NO
verzweige wenn Bit 7 =0
(Programm-Mode)
exit if control messages off
  program mode, don´t print, exit
 
.,F5B3 A0 0C LDY #$0C LDY #MS5-MS1 ;"SEARCHING"
Offset für 'SEARCHING'
index to "SEARCHING "
     
.,F5B5 20 2F F1 JSR $F12F JSR MSG
Meldung ausgeben
display kernel I/O message
  print "SEARCHING"
 
.,F5B8 A5 B7 LDA $B7 LDA FNLEN
Länge des Filenamens
get file name length
  FNLEN, length of current filename
 
.,F5BA F0 15 BEQ $F5D1 BEQ LD115
gleich Null, dann fertig
exit if null name
  no name, exit
 
.,F5BC A0 17 LDY #$17 LDY #MS6-MS1 ;"FOR"
Offset für 'FOR'
else index to "FOR "
     
.,F5BE 20 2F F1 JSR $F12F JSR MSG
;SUBROUTINE TO OUTPUT FILE NAME
;
Meldung ausgeben
display kernel I/O message

print file name

  print "FOR"

PRINT FILENAME

Filename is pointed to by FNADR, and length in FNLEN. The
KERNAL routine CHROUT is used to print filename.
 
.,F5C1 A4 B7 LDY $B7 OUTFN LDY FNLEN ;IS THERE A NAME?
Länge des Filenamens
get file name length
  FNLEN, length of current filename
 
.,F5C3 F0 0C BEQ $F5D1 BEQ LD115 ;NO...DONE
gleich Null, dann fertig
exit if null file name
  exit
 
.,F5C5 A0 00 LDY #$00 LDY #0
Zähler setzen
clear index
     
.,F5C7 B1 BB LDA ($BB),Y LD110 LDA (FNADR)Y
Filenamen holen
get file name byte
  get character in filename
 
.,F5C9 20 D2 FF JSR $FFD2 JSR BSOUT
und ausgeben
output character to channel
  output
 
.,F5CC C8 INY INY
Zähler erhöhen
increment index
  next character
 
.,F5CD C4 B7 CPY $B7 CPY FNLEN
mit Länge des Filenamens ver-
gleichen
compare with file name length
  ready?
 
.,F5CF D0 F6 BNE $F5C7 BNE LD110
;
verzweige wenn noch nicht
alle Buchstaben
loop if more to do
     
.,F5D1 60 RTS LD115 RTS
;SUBROUTINE TO PRINT:
;
;LOADING/VERIFING
;
Rücksprung

'LOADING/VERIFYING' ausgeben

display "LOADING" or "VERIFYING"

  back

PRINT "LOADING/VERIFYING"

The load/verify flag is checked, and if the message to be
output is flagged according to the result. This message is
printed from the KERNAL I/O messages table.

do load/verify message

.,F5D2 A0 49 LDY #$49 LODING LDY #MS10-MS1 ;ASSUME 'LOADING'
Offset für 'LOADING'
point to "LOADING"
  offset to verify message
 
.,F5D4 A5 93 LDA $93 LDA VERCK ;CHECK FLAG
Load/Verify-Flag laden
get load/verify flag
  VERCK, load/verify flag
 
.,F5D6 F0 02 BEQ $F5DA BEQ LD410 ;ARE DOING LOAD
Load wenn 0, dann ausgeben
branch if load
  verify
 
.,F5D8 A0 59 LDY #$59 LDY #MS21-MS1 ;ARE 'VERIFYING'
sonst Offset für 'VERIFYING'
point to "VERIFYING"
  offset to load message
 
.,F5DA 4C 2B F1 JMP $F12B LD410 JMP SPMSG
.END

.LIB SAVE

;***********************************
;* SAVE *
;* *
;* SAVES TO CASSETTE 1 OR 2, OR *
;* IEEE DEVICES 4>=N>=31 AS SELECT-*
;* ED BY VARIABLE FA. *
;* *
;*START OF SAVE IS INDIRECT AT .A *
;*END OF SAVE IS .X,.Y *
;***********************************
Meldung ausgeben, Rücksprung

SAVE - Routine

display kernel I/O message if in direct mode and return

save RAM to device, A = index to start address, XY = end address low/high

  output message flagged by (Y)

SAVE: SAVE RAM

The KERNAL routine SAVE ($ffd8) jumps to this routine. On
entry, (X/Y) must hold the end address+1 of the area of
memory to be saved. (A) holds the pointer to the start
address of the block, held in zeropage. The current device
number is checked to ensure that it is niether keyboard
(0) or screen (3). Both of these result in ?ILLEGAL DEVICE
NUMBER.

save ram to a device

.,F5DD 86 AE STX $AE SAVESP STX EAL
LOW-Byte der Endadresse
speichern
save end address low byte
  EAL , end address of block +1
 
.,F5DF 84 AF STY $AF STY EAH
High-Byte der Endadresse
speichern
save end address high byte
     
.,F5E1 AA TAX TAX ;SET UP START
Zeiger auf Anfangsadress-
tabelle ins X-REG schieben
copy index to start pointer
  move start pointer to (X)
 
.,F5E2 B5 00 LDA $00,X LDA $00,X
LOW-Byte der Startadresse
get start address low byte
     
.,F5E4 85 C1 STA $C1 STA STAL
holen und speichern
set I/O start addresses low byte
  STAL, start address of block
 
.,F5E6 B5 01 LDA $01,X LDA $01,X
HIGH-Byte der Startadresse
get start address high byte
     
.,F5E8 85 C2 STA $C2 STA STAH
;
holen und speichern
set I/O start addresses high byte
     
.,F5EA 6C 32 03 JMP ($0332) SAVE JMP (ISAVE)
SAVE-Vektor, JMP $F5ED
go save, usually points to $F685

save

  vector ISAVE, points to $f5ed
normally F5ED

standard save ram entry

.,F5ED A5 BA LDA $BA NSAVE LDA FA ***MONITOR ENTRY
Geräteadresse laden
get the device number
  FA, current device number
 
.,F5EF D0 03 BNE $F5F4 BNE SV20
;
verzweige wenn nicht gleich 0
if not keyboard go ??
else ..
  ok
 
.,F5F1 4C 13 F7 JMP $F713 SV10 JMP ERROR9 ;BAD DEVICE #
;
sonst 'ILLEGAL DEVICE NUMBER'
else do 'illegal device number' and return
  I/O error #9, illegal device number
 
.,F5F4 C9 03 CMP #$03 SV20 CMP #3
mit Code für Bildschirm
vergleichen
compare device number with screen
  screen?
 
.,F5F6 F0 F9 BEQ $F5F1 BEQ SV10
wenn Bildschirm, dann Fehler
if screen do illegal device number and return
  yep, output error
 
.,F5F8 90 5F BCC $F659 BCC SV100
kleiner 3, dann verzweige

Speichern auf IEC-Bus

branch if < screen
is greater than screen so is serial bus
  less than 3, ie. tape, output error

SAVE TO SERIAL BUS

A filename is assumed by the routine, or ?MISSING FILENAME
error is called. The serial device is commanded to LISTEN,
and the filename is sent along with the secondary address.
The message 'SAVING' is printed, and a loop sends a byte
to the serial bus and checks <STOP> key until the whole
specifyed block of memory has been saved. Note that the
first two bytes sent are the start address of the block.
Finally the serial bus is UNLISTENed.
 
.,F5FA A9 61 LDA #$61 LDA #$61
Sekundäradresse 1
set secondary address to $01
when a secondary address is to be sent to a device on
the serial bus the address must first be ORed with $60
     
.,F5FC 85 B9 STA $B9 STA SA
setzen
save the secondary address
  set SA, secondary address, to #1
 
.,F5FE A4 B7 LDY $B7 LDY FNLEN
Länge des Filenamens laden
get the file name length
  FNLEN, length of current filename
 
.,F600 D0 03 BNE $F605 BNE SV25
;
ungleich Null, dann ok
if filename not null continue
  ok
 
.,F602 4C 10 F7 JMP $F710 JMP ERROR8 ;MISSING FILE NAME
;
sonst 'MISSING FILENAME'
else do 'missing file name' error and return
  I/O error #8, missing filename
 
.,F605 20 D5 F3 JSR $F3D5 SV25 JSR OPENI
Filenamen auf IEC-Bus
send secondary address and filename
  send SA & filename
 
.,F608 20 8F F6 JSR $F68F JSR SAVING
'SAVING' ausgeben
print saving <file name>
  print 'SAVING' and filename
 
.,F60B A5 BA LDA $BA LDA FA
Geräteadresse laden
get the device number
  FA, current device number
 
.,F60D 20 0C ED JSR $ED0C JSR LISTN
und LISTEN senden
command devices on the serial bus to LISTEN
  send LISTEN
 
.,F610 A5 B9 LDA $B9 LDA SA
Sekundäradresse laden
get the secondary address
  SA
 
.,F612 20 B9 ED JSR $EDB9 JSR SECND
und für LISTEN senden
send secondary address after LISTEN
  send LISTEN SA
 
.,F615 A0 00 LDY #$00 LDY #0
Zähler auf Null setzen
clear index
     
.,F617 20 8E FB JSR $FB8E JSR RD300
Startadresse nach $AC/$AD
copy I/O start address to buffer address
  reset pointer
 
.,F61A A5 AC LDA $AC LDA SAL
Startadresse LOW-
get buffer address low byte
  SAL, holds start address
 
.,F61C 20 DD ED JSR $EDDD JSR CIOUT
Byte senden
output byte to serial bus
  send low byte of start address
 
.,F61F A5 AD LDA $AD LDA SAH
und HIGH-
get buffer address high byte
     
.,F621 20 DD ED JSR $EDDD JSR CIOUT
senden
output byte to serial bus
  send high byte of start address
 
.,F624 20 D1 FC JSR $FCD1 SV30 JSR CMPSTE ;COMPARE START TO END
Endadresse schon erreicht ?
check read/write pointer, return Cb = 1 if pointer >= end
  check read/write pointer
 
.,F627 B0 16 BCS $F63F BCS SV50 ;HAVE REACHED END
ja, dann fertig
go do UNLISTEN if at end
     
.,F629 B1 AC LDA ($AC),Y LDA (SAL)Y
Programmbyte laden
get byte from buffer
  get character from memory
 
.,F62B 20 DD ED JSR $EDDD JSR CIOUT
auf IEC-Bus ausgeben
output byte to serial bus
  send byte to serial device
 
.,F62E 20 E1 FF JSR $FFE1 JSR STOP
STOP-Taste abfragen
scan stop key
  test <STOP> key
 
.,F631 D0 07 BNE $F63A BNE SV40
;
nicht gedrückt, dann
weitermachen
if stop not pressed go increment pointer and loop for next
else ..
close the serial bus device and flag stop
  not pressed
 
.,F633 20 42 F6 JSR $F642 BREAK JSR CLSEI
IEC-Bus Kanal schließen
close serial bus device
  exit and unlisten
 
.,F636 A9 00 LDA #$00 LDA #0
Kennzeichnung für 'BREAK'
    flag break
 
.,F638 38 SEC SEC
Carry =1 (Fehlerkennzeichen)
flag stop
     
.,F639 60 RTS RTS
;
Rücksprung
       
.,F63A 20 DB FC JSR $FCDB SV40 JSR INCSAL ;INCREMENT CURRENT ADDR.
laufende Adresse erhöhen
increment read/write pointer
  bump r/w pointer
 
.,F63D D0 E5 BNE $F624 BNE SV30
unbedingter Sprung
loop, branch always
  save next byte
 
.,F63F 20 FE ED JSR $EDFE SV50 JSR UNLSN
UNLISTEN senden

File auf IEC-Bus schließen

command serial bus to UNLISTEN
close serial bus device
  send UNLISTEN

close serial bus device

.,F642 24 B9 BIT $B9 CLSEI BIT SA
Sekundäradresse testen
test the secondary address
  SA
 
.,F644 30 11 BMI $F657 BMI CLSEI2
verzweige falls keine
Sekundäradresse
if already closed just exit
     
.,F646 A5 BA LDA $BA LDA FA
Geräteadresse laden
get the device number
  FA
 
.,F648 20 0C ED JSR $ED0C JSR LISTN
und LISTEN senden
command devices on the serial bus to LISTEN
  send LISTEN
 
.,F64B A5 B9 LDA $B9 LDA SA
Sekundäradresse laden
get the secondary address
     
.,F64D 29 EF AND #$EF AND #$EF
Sekundäradresse
mask the channel number
     
.,F64F 09 E0 ORA #$E0 ORA #$E0
für CLOSE berechnen
OR with the CLOSE command
     
.,F651 20 B9 ED JSR $EDB9 JSR SECND
;
und ausgeben
send secondary address after LISTEN
  send UNLISTEN SA
 
.,F654 20 FE ED JSR $EDFE CUNLSN JSR UNLSN ;ENTRY FOR OPENI
;
UNLISTEN senden
command serial bus to UNLISTEN
  send UNLISTEN
 
.,F657 18 CLC CLSEI2 CLC
Carry =0 (ok Kennzeichen)
flag ok
     
.,F658 60 RTS RTS
Rücksprung
       
.,F659 4A LSR SV100 LSR A
Bit 0 ins Carry schieben
       
.,F65A B0 03 BCS $F65F BCS SV102 ;IF C-SET THEN IT'S CASSETTE
;
falls gesetzt, dann zu Band
if not RS232 device ??
     
.,F65C 4C 13 F7 JMP $F713 JMP ERROR9 ;BAD DEVICE #
;
sonst RS-232, 'ILLEGAL DIVICE
NUMBER'
else do 'illegal device number' and return
   

save ram to cassette

.,F65F 20 D0 F7 JSR $F7D0 SV102 JSR ZZZ ;GET ADDR OF TAPE
Bandpuffer Startadresse holen
get tape buffer start pointer in XY
     
.,F662 90 8D BCC $F5F1 BCC SV10 ;BUFFER IS DEALLOCATED
falls HIGH-Byte der Band
Pufferstartadresse kleiner 2
dann 'ILLEGAL DEVICE NUMBER'
if < $0200 do illegal device number and return
     
.,F664 20 38 F8 JSR $F838 JSR CSTE2
wartet auf Record & Play-
Taste
wait for PLAY/RECORD
     
.,F667 B0 25 BCS $F68E BCS SV115 ;STOP KEY PRESSED
STOP, dann Abbruch
exit if STOP was pressed
     
.,F669 20 8F F6 JSR $F68F JSR SAVING ;TELL USER 'SAVING'
'SAVING' (Name) ausgeben
print saving <file name>
     
.,F66C A2 03 LDX #$03 SV105 LDX #PLF ;DECIDE TYPE TO SAVE
Header-Typ 3 = Maschinen
programm (absolut)
set header for a non relocatable program file
     
.,F66E A5 B9 LDA $B9 LDA SA ;1-PLF 0-BLF
Sekundäradresse laden
get the secondary address
     
.,F670 29 01 AND #$01 AND #01
Bit 0 gesetzt (1 oder 3)
mask non relocatable bit
     
.,F672 D0 02 BNE $F676 BNE SV106
falls ja, dann Maschinen
programm
if non relocatable program go ??
     
.,F674 A2 01 LDX #$01 LDX #BLF
Header-Typ 1 = BASIC-
Programm (verschiebbar)
else set header for a relocatable program file
     
.,F676 8A TXA SV106 TXA
Header in Akku schieben
copy header type to A
     
.,F677 20 6A F7 JSR $F76A JSR TAPEH
Header auf Band schreiben
write tape header
     
.,F67A B0 12 BCS $F68E BCS SV115 ;STOP KEY PRESSED
Aussprung bei Stop-Taste
exit if error
     
.,F67C 20 67 F8 JSR $F867 JSR TWRT
Programm auf Band schreiben
do tape write, 20 cycle count
     
.,F67F B0 0D BCS $F68E BCS SV115 ;STOP KEY PRESSED
Aussprung bei Stop-Taste
exit if error
     
.,F681 A5 B9 LDA $B9 LDA SA
Sekundäradresse laden
get the secondary address
     
.,F683 29 02 AND #$02 AND #2 ;WRITE END OF TAPE?
Bit 1 gesetzt (2 oder 3)
mask end of tape flag
     
.,F685 F0 06 BEQ $F68D BEQ SV110 ;NO...
;
falls nicht, dann fertig
if not end of tape go ??
     
.,F687 A9 05 LDA #$05 LDA #EOT
EOT Kontrollbyte
else set logical end of the tape
     
.,F689 20 6A F7 JSR $F76A JSR TAPEH
Block auf Band schreiben
write tape header
     
.:F68C 24 .BYTE $24 .BYT $24 ;SKIP 1 BYTE
;
Skip zu $F68E
makes next line BIT $18 so Cb is not changed
     
.,F68D 18 CLC SV110 CLC
Carry =0 (ok Kennzeichen)
flag ok
     
.,F68E 60 RTS SV115 RTS
;SUBROUTINE TO OUTPUT:
;'SAVING <FILE NAME>'
;
Rücksprung

'SAVING' ausgeben

print saving <file name>

 

PRINT 'SAVING'

MSGFLG is checked, and if direct mode is on, then the
message 'SAVING' is flagged and printed from the KERNAL
I/O message table.

do saving message and filename

.,F68F A5 9D LDA $9D SAVING LDA MSGFLG
Flag für Direktmodus laden
get message mode flag
  MSGFLG
 
.,F691 10 FB BPL $F68E BPL SV115 ;NO PRINT
;
Bit 7 gelöscht, dann
Programm-Mode
exit if control messages off
  not in direct mode, exit
 
.,F693 A0 51 LDY #$51 LDY #MS11-MS1 ;'SAVING'
Offset für 'SAVING'
index to "SAVING "
  offset to message in table
 
.,F695 20 2F F1 JSR $F12F JSR MSG
Meldung ausgeben
display kernel I/O message
  output 'SAVING'
 
.,F698 4C C1 F5 JMP $F5C1 JMP OUTFN ;<FILE NAME>
.END

.LIB TIME

;***********************************
;* *
;* TIME *
;* *
;*CONSISTS OF THREE FUNCTIONS: *
;* (1) UDTIM-- UPDATE TIME. USUALLY*
;* CALLED EVERY 60TH SECOND. *
;* (2) SETTIM-- SET TIME. .Y=MSD, *
;* .X=NEXT SIGNIFICANT,.A=LSD *
;* (3) RDTIM-- READ TIME. .Y=MSD, *
;* .X=NEXT SIGNIFICANT,.A=LSD *
;* *
;***********************************
;INTERRUPTS ARE COMING FROM THE 6526 TIMERS
;
Filenamen ausgeben,
Rücksprung

UDTIM Time erhöhen und

STOP-Taste abfragen

print file name and return

increment the real time clock

  output filename

UDTIM: BUMP CLOCK

The KERNAL routine UDTIM ($ffea) jumps to this routine.
The three byte jiffy clock in RAM is incremented. If it
has reached $4f1a01, then it is reset to zero. this number
represents 5184001 jiffies (each jiffy is 1/60 sec) or 24
hours. finally, the next routine is used to log the CIA
key reading.

increment real time clock

.,F69B A2 00 LDX #$00 UDTIM LDX #0 ;PRE-LOAD FOR LATER
;
;HERE WE PROCEED WITH AN INCREMENT
;OF THE TIME REGISTER.
;
X-REG auf Null setzen
clear X
     
.,F69D E6 A2 INC $A2 UD20 INC TIME+2
Sekundenzeiger erhöhen
increment the jiffy clock low byte
  low byte of jiffy clock
 
.,F69F D0 06 BNE $F6A7 BNE UD30
verzweige falls kein Überlauf
if no rollover ??
     
.,F6A1 E6 A1 INC $A1 INC TIME+1
Minutenzeiger erhöhen
increment the jiffy clock mid byte
  mid byte of jiffy clock
 
.,F6A3 D0 02 BNE $F6A7 BNE UD30
verzweige falls kein Überlauf
branch if no rollover
     
.,F6A5 E6 A0 INC $A0 INC TIME
;
;HERE WE CHECK FOR ROLL-OVER 23:59:59
;AND RESET THE CLOCK TO ZERO IF TRUE
;
Stundenzeiger erhöhen
increment the jiffy clock high byte
now subtract a days worth of jiffies from current count
and remember only the Cb result
  high byte of jiffy clock
 
.,F6A7 38 SEC UD30 SEC
Carry für Subtraktion löschen
set carry for subtract
     
.,F6A8 A5 A2 LDA $A2 LDA TIME+2
Stundenzeiger laden
get the jiffy clock low byte
  substract $4f1a01
 
.,F6AA E9 01 SBC #$01 SBC #$01
feststellen
subtract $4F1A01 low byte
     
.,F6AC A5 A1 LDA $A1 LDA TIME+1
ob
get the jiffy clock mid byte
     
.,F6AE E9 1A SBC #$1A SBC #$1A
24
subtract $4F1A01 mid byte
     
.,F6B0 A5 A0 LDA $A0 LDA TIME
Stunden
get the jiffy clock high byte
     
.,F6B2 E9 4F SBC #$4F SBC #$4F
erreicht
subtract $4F1A01 high byte
     
.,F6B4 90 06 BCC $F6BC BCC UD60
;
;TIME HAS ROLLED--ZERO REGISTER
;
falls kleiner, dann verzweige
if less than $4F1A01 jiffies skip the clock reset
else ..
  and test carry if 24 hours
 
.,F6B6 86 A0 STX $A0 STX TIME
alle
clear the jiffy clock high byte
  yepp, reset jiffy clock
 
.,F6B8 86 A1 STX $A1 STX TIME+1
Zeiger
clear the jiffy clock mid byte
     
.,F6BA 86 A2 STX $A2 STX TIME+2
;
;SET STOP KEY FLAG HERE
;
auf Null setzen

Abfrage auf STOP-Taste direkt

vom Port

clear the jiffy clock low byte
this is wrong, there are $4F1A00 jiffies in a day so
the reset to zero should occur when the value reaches
$4F1A00 and not $4F1A01. this would give an extra jiffy
every day and a possible TI value of 24:00:00
 

LOG CIA KEY READING

This routine tests the keyboard for either <STOP> or <RVS>
pressed. If so, the keypress is stored in STKEY.
 
.,F6BC AD 01 DC LDA $DC01 UD60 LDA ROWS ;WAIT FOR IT TO SETTLE
Port B laden
read VIA 1 DRB, keyboard row port
  keyboard read register
 
.,F6BF CD 01 DC CMP $DC01 CMP ROWS
und
compare it with itself
     
.,F6C2 D0 F8 BNE $F6BC BNE UD60 ;STILL BOUNCING
entprellen
loop if changing
  wait for value to settle
 
.,F6C4 AA TAX TAX ;SET FLAGS...
Wert ins X-REG schieben
       
.,F6C5 30 13 BMI $F6DA BMI UD80 ;NO STOP KEY...EXIT STOP KEY=$7F
verzweige falls STOP-Taste
nicht gedrückt
       
.,F6C7 A2 BD LDX #$BD LDX #$FF-$42 ;CHECK FOR A SHIFT KEY (C64 KEYBOARD)
Bitmuster zur Abrage der
Reihe mit SHIFT-Tasten
set c6
     
.,F6C9 8E 00 DC STX $DC00 STX COLM
in Port A schreiben
save VIA 1 DRA, keyboard column drive
  keyboard write register
 
.,F6CC AE 01 DC LDX $DC01 UD70 LDX ROWS ;WAIT TO SETTLE...
Port B laden
read VIA 1 DRB, keyboard row port
  keyboard read register
 
.,F6CF EC 01 DC CPX $DC01 CPX ROWS
und
compare it with itself
     
.,F6D2 D0 F8 BNE $F6CC BNE UD70
entprellen
loop if changing
  wiat for value to settle
 
.,F6D4 8D 00 DC STA $DC00 STA COLM ;!!!!!WATCH OUT...STOP KEY .A=$7F...SAME AS COLMS WAS...
Akku in Port A schreiben
save VIA 1 DRA, keyboard column drive
     
.,F6D7 E8 INX INX ;ANY KEY DOWN ABORTS
inhalt von Port B erhöhen
       
.,F6D8 D0 02 BNE $F6DC BNE UD90 ;LEAVE SAME AS BEFORE...
verzweige falls ungleich Null
(SHIFT-Taste gedrückt)
       
.,F6DA 85 91 STA $91 UD80 STA STKEY ;SAVE FOR OTHER ROUTINES
Flag für Stop-Taste setzen
save the stop key column
  STKEY, flag STOP/RVS
 
.,F6DC 60 RTS UD90 RTS
Rücksprung

TIME holen

read the real time clock

 

RDTIM: GET TIME

The KERNAL routine RDTIM ($ffde) jumps to this routine.
The three byte jiffy clock is read into (A/X/Y) in the
format high/mid/low. The routine exits, setting the time
to its existing value in the next routine. The clock
resolution is 1/60 second. SEI is included since part of
the IRQ routine is to update the clock.

read real time clock

.,F6DD 78 SEI RDTIM SEI ;KEEP TIME FROM ROLLING
Interrupt verhindern um Uhr
anzuhalten
disable the interrupts
  disable interrupt
 
.,F6DE A5 A2 LDA $A2 LDA TIME+2 ;GET LSD
Stunden
get the jiffy clock low byte
  read TIME
 
.,F6E0 A6 A1 LDX $A1 LDX TIME+1 ;GET NEXT MOST SIG.
Minuten
get the jiffy clock mid byte
     
.,F6E2 A4 A0 LDY $A0 LDY TIME ;GET MSD
Sekunden holen

TIME setzen

get the jiffy clock high byte

set the real time clock

 

SETTIM: SET TIME

The KERNAL routine SETTIM ($ffdb) jumps to this routine.
On entry, (A/X/Y) must hold the value to be stored in the
clock. The forman is high/mid/low, and clock resolution is
1/60 second. SEI is included since part of the IRQ routine
is to update the clock.

set real time clock

.,F6E4 78 SEI SETTIM SEI ;KEEP TIME FROM CHANGING
Interrupt verhindern um Uhr
anzuhalten
disable the interrupts
  disable interrupt
 
.,F6E5 85 A2 STA $A2 STA TIME+2 ;STORE LSD
Stunden
save the jiffy clock low byte
  wrine TIME
 
.,F6E7 86 A1 STX $A1 STX TIME+1 ;NEXT MOST SIGNIFICANT
Minuten
save the jiffy clock mid byte
     
.,F6E9 84 A0 STY $A0 STY TIME ;STORE MSD
Sekunden schreiben
save the jiffy clock high byte
     
.,F6EB 58 CLI CLI
Interrupt wieder ermöglichen
enable the interrupts
  enable interrupts
 
.,F6EC 60 RTS RTS
.END

.LIB ERRORHANDLER

;***************************************
;* STOP -- CHECK STOP KEY FLAG AND *
;* RETURN Z FLAG SET IF FLAG TRUE. *
;* ALSO CLOSES ACTIVE CHANNELS AND *
;* FLUSHES KEYBOARD QUEUE. *
;* ALSO RETURNS KEY DOWNS FROM LAST *
;* KEYBOARD ROW IN .A. *
;***************************************
Rücksprung

STOP-Taste abfragen

scan the stop key, return Zb = 1 = [STOP]

 

STOP: CHECK <STOP> KEY

The KERNAL routine STOP ($ffe1) is vectored here. If STKEY
=#7f, then <STOP> was pressed and logged whilest the jiffy
clock was being updated, so all I/O channels are closed
and the keyboard buffer reset.

test STOP key

.,F6ED A5 91 LDA $91 NSTOP LDA STKEY ;VALUE OF LAST ROW
STOP-Flag laden
read the stop key column
  STKEY
 
.,F6EF C9 7F CMP #$7F CMP #$7F ;CHECK STOP KEY POSITION
auf Code für STOP testen
compare with [STP] down
  <STOP> ?
 
.,F6F1 D0 07 BNE $F6FA BNE STOP2 ;NOT DOWN
verzweige falls nicht
if not [STP] or not just [STP] exit
just [STP] was pressed
  nope
 
.,F6F3 08 PHP PHP
Statusregister retten
save status
     
.,F6F4 20 CC FF JSR $FFCC JSR CLRCH ;CLEAR CHANNELS
Ein-Ausgabe zurücksetzen
CLRCH
close input and output channels
  CLRCHN, close all I/O channels
 
.,F6F7 85 C6 STA $C6 STA NDX ;FLUSH QUEUE
Anzahl der gedrückten Tasten
save the keyboard buffer index
  NDX, number of characters in keyboard buffer
 
.,F6F9 28 PLP PLP
Statusregister holen
restore status
     
.,F6FA 60 RTS STOP2 RTS
;************************************
;* *
;* ERROR HANDLER *
;* *
;* PRINTS KERNAL ERROR MESSAGE IF *
;* BIT 6 OF MSGFLG SET. RETURNS *
;* WITH ERROR # IN .A AND CARRY. *
;* *
;************************************
;
Rücksprung

Meldungen des Betriebs

systems ausgeben

file error messages

 

OUTPUT KERNAL ERROR MESSAGES

The error message to be output is flagged into (A)
depending on the entry point. I/O channels are closed, and
then if KERNAL messages are enabled, "I/O ERROR #" is
printed along with the error number.

handle I/O errors

.,F6FB A9 01 LDA #$01 ERROR1 LDA #1 ;TOO MANY FILES
'TOO MANY FILES'
'too many files' error
  error #1, too many files
too many files
.:F6FD 2C .BYTE $2C .BYT $2C
Skip zu $F700
makes next line BIT $02A9
     
.,F6FE A9 02 LDA #$02 ERROR2 LDA #2 ;FILE OPEN
'FILE OPEN'
'file already open' error
  error #2, file open
file open
.:F700 2C .BYTE $2C .BYT $2C
Skip zu $F703
makes next line BIT $03A9
     
.,F701 A9 03 LDA #$03 ERROR3 LDA #3 ;FILE NOT OPEN
'FILE NOT OPEN'
'file not open' error
  error #3, file not open
file not open
.:F703 2C .BYTE $2C .BYT $2C
Skip zu $F706
makes next line BIT $04A9
     
.,F704 A9 04 LDA #$04 ERROR4 LDA #4 ;FILE NOT FOUND
'FILE NOT FOUND'
'file not found' error
  error #4, file not found
file not found
.:F706 2C .BYTE $2C .BYT $2C
Skip zu $F709
makes next line BIT $05A9
     
.,F707 A9 05 LDA #$05 ERROR5 LDA #5 ;DEVICE NOT PRESENT
'DIVICE NOT PRESENT'
'device not present' error
  error #5, device not found
device not present
.:F709 2C .BYTE $2C .BYT $2C
Skip zu $F70C
makes next line BIT $06A9
     
.,F70A A9 06 LDA #$06 ERROR6 LDA #6 ;NOT INPUT FILE
'NOT INPUT FILE'
'not input file' error
  error #6, not input file
not input file
.:F70C 2C .BYTE $2C .BYT $2C
Skip zu $F70F
makes next line BIT $07A9
     
.,F70D A9 07 LDA #$07 ERROR7 LDA #7 ;NOT OUTPUT FILE
'NOT OUTPUT FILE'
'not output file' error
  error #7, not output file
not output file
.:F70F 2C .BYTE $2C .BYT $2C
Skip zu $F712
makes next line BIT $08A9
     
.,F710 A9 08 LDA #$08 ERROR8 LDA #8 ;MISSING FILE NAME
'MISSING FILENAME'
'missing file name' error
  error #8, missing filename
file name missing
.:F712 2C .BYTE $2C .BYT $2C
Skip zu $F715
makes next line BIT $09A9
     
.,F713 A9 09 LDA #$09 ERROR9 LDA #9 ;BAD DEVICE #
;
'ILLEGAL DEVICE NUMBER'
do 'illegal device number'
  error #9, illegal device number
illegal device no.
.,F715 48 PHA PHA ;ERROR NUMBER ON STACK
Fehlernummer merken
save the error #
     
.,F716 20 CC FF JSR $FFCC JSR CLRCH ;RESTORE I/O CHANNELS
;
Ein-Ausgabe zurücksetzen
CLRCH
close input and output channels
  CLRCHN, close all I/O channels
 
.,F719 A0 00 LDY #$00 LDY #MS1-MS1
  index to "I/O ERROR #"
     
.,F71B 24 9D BIT $9D BIT MSGFLG ;ARE WE PRINTING ERROR?
Flag auf Direkt-Mode testen
test message mode flag
  test MSGFLAG, KERNAL messages enabled
 
.,F71D 50 0A BVC $F729 BVC EREXIT ;NO...
;
nicht gesetzt, dann übergehen
exit if kernal messages off
  no
 
.,F71F 20 2F F1 JSR $F12F JSR MSG ;PRINT "CBM I/O ERROR #"
'I/O ERROR #' ausgeben
display kernel I/O message
  print "I/O ERROR #"
 
.,F722 68 PLA PLA
Fehlernummer holen
restore error #
     
.,F723 48 PHA PHA
und wieder merken
copy error #
     
.,F724 09 30 ORA #$30 ORA #$30 ;MAKE ERROR # ASCII
nach ASCII wandeln
convert to ASCII
  convert (A) to ASCII number
 
.,F726 20 D2 FF JSR $FFD2 JSR BSOUT ;PRINT IT
;
und ausgeben
output character to channel
  use CHROUT to print number in (A)
 
.,F729 68 PLA EREXIT PLA
Fehlernummer holen
pull error number
     
.,F72A 38 SEC SEC
Carry =1 (Fehlerkennzeichen)
flag error
     
.,F72B 60 RTS RTS
.END

.LIB TAPEFILE

;FAH -- FIND ANY HEADER
;
;READS TAPE DEVICE UNTIL ONE OF FOLLOWING
;BLOCK TYPES FOUND: BDFH--BASIC DATA
;FILE HEADER, BLF--BASIC LOAD FILE
;FOR SUCCESS CARRY IS CLEAR ON RETURN.
;FOR FAILURE CARRY IS SET ON RETURN.
;IN ADDITION ACCUMULATOR IS 0 IF STOP
;KEY WAS PRESSED.
;
Rücksprung

Programm Header vom Band

lesen

find the tape header, exit with header in buffer

   

get next file header from cassette

.,F72C A5 93 LDA $93 FAH LDA VERCK ;SAVE OLD VERIFY
Load/Verify Flag laden
get load/verify flag
     
.,F72E 48 PHA PHA
und retten
save load/verify flag
     
.,F72F 20 41 F8 JSR $F841 JSR RBLK ;READ TAPE BLOCK
Block vom Band lesen
initiate tape read
     
.,F732 68 PLA PLA
L/V Flag wiederholen
restore load/verify flag
     
.,F733 85 93 STA $93 STA VERCK ;RESTORE VERIFY FLAG
und speichern
save load/verify flag
     
.,F735 B0 32 BCS $F769 BCS FAH40 ;READ TERMINATED
;
Fehler, dann beenden
exit if error
     
.,F737 A0 00 LDY #$00 LDY #0
Zähler auf Null stellen
clear the index
     
.,F739 B1 B2 LDA ($B2),Y LDA (TAPE1)Y ;GET HEADER TYPE
;
Header-Typ testen
read first byte from tape buffer
     
.,F73B C9 05 CMP #$05 CMP #EOT ;CHECK END OF TAPE?
EOT ?
compare with logical end of the tape
     
.,F73D F0 2A BEQ $F769 BEQ FAH40 ;YES...FAILURE
;
verzweige falls ja
if end of the tape exit
     
.,F73F C9 01 CMP #$01 CMP #BLF ;BASIC LOAD FILE?
BASIC-Programm ?
compare with header for a relocatable program file
     
.,F741 F0 08 BEQ $F74B BEQ FAH50 ;YES...SUCCESS
;
verzweige falls ja
if program file header go ??
     
.,F743 C9 03 CMP #$03 CMP #PLF ;FIXED LOAD FILE?
Maschinenprogramm ?
compare with header for a non relocatable program file
     
.,F745 F0 04 BEQ $F74B BEQ FAH50 ;YES...SUCCESS
;
verzweige falls ja
if program file header go ??
     
.,F747 C9 04 CMP #$04 CMP #BDFH ;BASIC DATA FILE?
Daten-Header ?
compare with data file header
     
.,F749 D0 E1 BNE $F72C BNE FAH ;NO...KEEP TRYING
;
kein Header gefunden, dann
erneut suchen
if data file loop to find the tape header
was a program file header
     
.,F74B AA TAX FAH50 TAX ;RETURN FILE TYPE IN .X
Kennzeichen merken
copy header type
     
.,F74C 24 9D BIT $9D BIT MSGFLG ;PRINTING MESSAGES?
Direktmodus ?
get message mode flag
     
.,F74E 10 17 BPL $F767 BPL FAH45 ;NO...
;
nein, dann weiter
exit if control messages off
     
.,F750 A0 63 LDY #$63 LDY #MS17-MS1 ;PRINT "FOUND"
Offset für 'FOUND'
index to "FOUND "
     
.,F752 20 2F F1 JSR $F12F JSR MSG
;
;OUTPUT COMPLETE FILE NAME
;
Meldung ausgeben
display kernel I/O message
     
.,F755 A0 05 LDY #$05 LDY #5
Zeiger auf Filenamen
index to the tape filename
     
.,F757 B1 B2 LDA ($B2),Y FAH55 LDA (TAPE1)Y
Filenamen holen
get byte from tape buffer
     
.,F759 20 D2 FF JSR $FFD2 JSR BSOUT
und ausgeben
output character to channel
     
.,F75C C8 INY INY
Zeiger erhöhen
increment the index
     
.,F75D C0 15 CPY #$15 CPY #21
schon alle Buchstaben
compare it with end+1
     
.,F75F D0 F6 BNE $F757 BNE FAH55
;
verzweige wenn nein
loop if more to do
     
.,F761 A5 A1 LDA $A1 FAH56 LDA STKEY ;KEY DOWN ON LAST ROW...
Akku mit mittelwertigem
Time-Byte laden
get the jiffy clock mid byte
     
.,F763 20 E0 E4 JSR $E4E0 JSR FPATCH ;GOTO PATCH...
wartet auf Commodore-Taste
oder Zeitschleife
wait ~8.5 seconds for any key from the STOP key column
     
.,F766 EA NOP NOP
;
no operation
waste cycles
     
.,F767 18 CLC FAH45 CLC ;SUCCESS FLAG
Carry =0 (ok Kennzeichen)
flag no error
     
.,F768 88 DEY DEY ;MAKE NONZERO FOR OKAY RETURN
;
Y-REG auf $FF zur Kennzeich
nung, daß kein EOT
decrement the index
     
.,F769 60 RTS FAH40 RTS
;TAPEH--WRITE TAPE HEADER
;ERROR IF TAPE BUFFER DE-ALLOCATED
;CARRY CLEAR IF O.K.
;
Rücksprung

Header generieren und auf

Band schreiben

write the tape header

   

write a special block to cassette with code in A

.,F76A 85 9E STA $9E TAPEH STA T1
;
;DETERMINE ADDRESS OF BUFFER
;
Header-Typ speichern
save header type
     
.,F76C 20 D0 F7 JSR $F7D0 JSR ZZZ
Bandpufferadresse holen
get tape buffer start pointer in XY
     
.,F76F 90 5E BCC $F7CF BCC TH40 ;BUFFER WAS DE-ALLOCATED
;
;PRESERVE START AND END ADDRESSES
;FOR CASE OF HEADER FOR LOAD FILE
;
verzweige falls Adresse
ungültig
if < $0200 just exit ??
     
.,F771 A5 C2 LDA $C2 LDA STAH
Startadresse
get I/O start address high byte
     
.,F773 48 PHA PHA
laden
save it
     
.,F774 A5 C1 LDA $C1 LDA STAL
und in
get I/O start address low byte
     
.,F776 48 PHA PHA
Stack schreiben
save it
     
.,F777 A5 AF LDA $AF LDA EAH
Endadresse
get tape end address high byte
     
.,F779 48 PHA PHA
laden
save it
     
.,F77A A5 AE LDA $AE LDA EAL
und in
get tape end address low byte
     
.,F77C 48 PHA PHA
;
;PUT BLANKS IN TAPE BUFFER
;
Stack schreiben
save it
     
.,F77D A0 BF LDY #$BF LDY #BUFSZ-1
Pufferlänge für Schleife
holen
index to header end
     
.,F77F A9 20 LDA #$20 LDA #'
Code für ' ' laden
clear byte, [SPACE]
     
.,F781 91 B2 STA ($B2),Y BLNK2 STA (TAPE1)Y
und speichern
clear header byte
     
.,F783 88 DEY DEY
Zähler verringern
decrement index
     
.,F784 D0 FB BNE $F781 BNE BLNK2
;
;PUT BLOCK TYPE IN HEADER
;
verzweige falls Puffer noch
nicht alles gelöscht
loop if more to do
     
.,F786 A5 9E LDA $9E LDA T1
gespeicherten Header-Typ
holen
get the header type back
     
.,F788 91 B2 STA ($B2),Y STA (TAPE1)Y
;
;PUT START LOAD ADDRESS IN HEADER
;
und in Puffer schreiben
write it to header
     
.,F78A C8 INY INY
Zähler erhöhen
increment the index
     
.,F78B A5 C1 LDA $C1 LDA STAL
Startadresse LOW holen
get the I/O start address low byte
     
.,F78D 91 B2 STA ($B2),Y STA (TAPE1)Y
und in Puffer schreiben
write it to header
     
.,F78F C8 INY INY
Zähler erhöhen
increment the index
     
.,F790 A5 C2 LDA $C2 LDA STAH
Startadesse HIGH holen
get the I/O start address high byte
     
.,F792 91 B2 STA ($B2),Y STA (TAPE1)Y
;
;PUT END LOAD ADDRESS IN HEADER
;
und in Puffer schreiben
write it to header
     
.,F794 C8 INY INY
Zähler erhöhen
increment the index
     
.,F795 A5 AE LDA $AE LDA EAL
Endadresse LOW holen
get the tape end address low byte
     
.,F797 91 B2 STA ($B2),Y STA (TAPE1)Y
und in Puffer schreiben
write it to header
     
.,F799 C8 INY INY
Zähler erhöhen
increment the index
     
.,F79A A5 AF LDA $AF LDA EAH
Endadresse HIGH holen
get the tape end address high byte
     
.,F79C 91 B2 STA ($B2),Y STA (TAPE1)Y
;
;PUT FILE NAME IN HEADER
;
und in Puffer schreiben
write it to header
     
.,F79E C8 INY INY
Zähler erhöhen
increment the index
     
.,F79F 84 9F STY $9F STY T2
Zähler speichern
save the index
     
.,F7A1 A0 00 LDY #$00 LDY #0
Zähler für Filenamen auf Null
setzen
clear Y
     
.,F7A3 84 9E STY $9E STY T1
und speichern
clear the name index
     
.,F7A5 A4 9E LDY $9E TH20 LDY T1
Zähler holen
get name index
     
.,F7A7 C4 B7 CPY $B7 CPY FNLEN
und mit Länge des Filenamens
vergleichen
compare with file name length
     
.,F7A9 F0 0C BEQ $F7B7 BEQ TH30
verzweige falls alle Buchsta-
ben geholt
if all done exit the loop
     
.,F7AB B1 BB LDA ($BB),Y LDA (FNADR)Y
Filenamen holen
get file name byte
     
.,F7AD A4 9F LDY $9F LDY T2
Pufferzeiger laden
get buffer index
     
.,F7AF 91 B2 STA ($B2),Y STA (TAPE1)Y
und Zeichen in Puffer schrei-
ben
save file name byte to buffer
     
.,F7B1 E6 9E INC $9E INC T1
Zähler für Filenamen erhöhen
increment file name index
     
.,F7B3 E6 9F INC $9F INC T2
Zeiger auf Bandpuffer erhöhen
increment tape buffer index
     
.,F7B5 D0 EE BNE $F7A5 BNE TH20
;
;SET UP START AND END ADDRESS OF HEADER
;
unbedingter Sprung
loop, branch always
     
.,F7B7 20 D7 F7 JSR $F7D7 TH30 JSR LDAD1
;
;SET UP TIME FOR LEADER
;
Start- und Endadresse auf
Bandpuffer holen
set tape buffer start and end pointers
     
.,F7BA A9 69 LDA #$69 LDA #$69
  set write lead cycle count
     
.,F7BC 85 AB STA $AB STA SHCNH
;
Checksumme für Header bzw.
Datenblock = $69
save write lead cycle count
     
.,F7BE 20 6B F8 JSR $F86B JSR TWRT2 ;WRITE HEADER ON TAPE
;
;RESTORE START AND END ADDRESS OF
;LOAD FILE.
;
Block auf Band schreiben
do tape write, no cycle count set
     
.,F7C1 A8 TAY TAY ;SAVE ERROR CODE IN .Y
Akku retten
       
.,F7C2 68 PLA PLA
Endadresse
pull tape end address low byte
     
.,F7C3 85 AE STA $AE STA EAL
vom Stack
restore it
     
.,F7C5 68 PLA PLA
holen und
pull tape end address high byte
     
.,F7C6 85 AF STA $AF STA EAH
in $AE/SAF speichern
restore it
     
.,F7C8 68 PLA PLA
Startadresse
pull I/O start addresses low byte
     
.,F7C9 85 C1 STA $C1 STA STAL
vom Stack
restore it
     
.,F7CB 68 PLA PLA
holen und
pull I/O start addresses high byte
     
.,F7CC 85 C2 STA $C2 STA STAH
in $C1/C2 speichern
restore it
     
.,F7CE 98 TYA TYA ;RESTORE ERROR CODE FOR RETURN
;
Akku wiederholen
       
.,F7CF 60 RTS TH40 RTS
;FUNCTION TO RETURN TAPE BUFFER
;ADDRESS IN TAPE1
;
Rücksprung

Bandpuffer Startadresse holen

und prüfen ob gültig

get the tape buffer start pointer

   

set tape buffer pointer in XY

.,F7D0 A6 B2 LDX $B2 ZZZ LDX TAPE1 ;ASSUME TAPE1
Anfang Bandpuffer LOW in X
get tape buffer start pointer low byte
     
.,F7D2 A4 B3 LDY $B3 LDY TAPE1+1
Anfang Bandpuffer HIGH in Y
get tape buffer start pointer high byte
     
.,F7D4 C0 02 CPY #$02 CPY #>BUF ;CHECK FOR ALLOCATION...
;...[TAPE1+1]=0 OR 1 MEANS DEALLOCATED
;...C CLR => DEALLOCATED
Adresse kleiner $200 ?
compare high byte with $02xx
     
.,F7D6 60 RTS RTS
Rücksprung

Bandpufferendadresse = Puf-

ferstartadresse + $C0 (192)

set the tape buffer start and end pointers

   

set cassette buffer to I/O area

.,F7D7 20 D0 F7 JSR $F7D0 LDAD1 JSR ZZZ ;GET PTR TO CASSETTE
BandpufferaAdresse holen
get tape buffer start pointer in XY
     
.,F7DA 8A TXA TXA
Pufferanfang LOW in Akku
copy tape buffer start pointer low byte
     
.,F7DB 85 C1 STA $C1 STA STAL ;SAVE START LOW
und speichern
save as I/O address pointer low byte
     
.,F7DD 18 CLC CLC
Carry für Addition löschen
clear carry for add
     
.,F7DE 69 C0 ADC #$C0 ADC #BUFSZ ;COMPUTE POINTER TO END
Endadresse = Startadresse +
Länge $C0 (192)
add buffer length low byte
     
.,F7E0 85 AE STA $AE STA EAL ;SAVE END LOW
und Endadresse speichern
save tape buffer end pointer low byte
     
.,F7E2 98 TYA TYA
Pufferanfang HIGH in Akku
copy tape buffer start pointer high byte
     
.,F7E3 85 C2 STA $C2 STA STAH ;SAVE START HIGH
und speichern
save as I/O address pointer high byte
     
.,F7E5 69 00 ADC #$00 ADC #0 ;COMPUTE POINTER TO END
mit Übertrag addieren
add buffer length high byte
     
.,F7E7 85 AF STA $AF STA EAH ;SAVE END HIGH
und speichern
save tape buffer end pointer high byte
     
.,F7E9 60 RTS RTS
Rücksprung

Bandheader nach Namen suchen

find specific tape header

   

search tape for a file name

.,F7EA 20 2C F7 JSR $F72C FAF JSR FAH ;FIND ANY HEADER
nächsten Bandheader suchen
find tape header, exit with header in buffer
     
.,F7ED B0 1D BCS $F80C BCS FAF40 ;FAILED
;
;SUCCESS...SEE IF RIGHT NAME
;
verzweige falls EOT (fertig)
just exit if error
     
.,F7EF A0 05 LDY #$05 LDY #5 ;OFFSET INTO TAPE HEADER
Offset für Filenamen im
Header
index to name
     
.,F7F1 84 9F STY $9F STY T2
und speichern
save as tape buffer index
     
.,F7F3 A0 00 LDY #$00 LDY #0 ;OFFSET INTO FILE NAME
Zähler für Länge des Filena-
mens auf Null setzen
clear Y
     
.,F7F5 84 9E STY $9E STY T1
und Zähler speichern
save as name buffer index
     
.,F7F7 C4 B7 CPY $B7 FAF20 CPY FNLEN ;COMPARE THIS MANY
mit Länge des gesuchten
Namens vergleichen
compare with file name length
     
.,F7F9 F0 10 BEQ $F80B BEQ FAF30 ;DONE
;
gleich, dann gefunden
ok exit if match
     
.,F7FB B1 BB LDA ($BB),Y LDA (FNADR)Y
Buchstaben des Filenamens
get file name byte
     
.,F7FD A4 9F LDY $9F LDY T2
Position im Header laden
get index to tape buffer
     
.,F7FF D1 B2 CMP ($B2),Y CMP (TAPE1)Y
mit Filenamen im Header
vergleichen
compare with tape header name byte
     
.,F801 D0 E7 BNE $F7EA BNE FAF ;MISMATCH--TRY NEXT HEADER
verzweige falls ungleich,
dann nächsten Header testen
if no match go get next header
     
.,F803 E6 9E INC $9E INC T1
Zähler für Filenamen erhöhen
else increment name buffer index
     
.,F805 E6 9F INC $9F INC T2
Zeiger auf Position im Header
erhöhen
increment tape buffer index
     
.,F807 A4 9E LDY $9E LDY T1
Zähler für Filenamen laden
get name buffer index
     
.,F809 D0 EC BNE $F7F7 BNE FAF20 ;BRANCH ALWAYS
;
unbedingter Sprung
loop, branch always
     
.,F80B 18 CLC FAF30 CLC ;SUCCESS FLAG
Carry =0 (ok Kennzeichen)
flag ok
     
.,F80C 60 RTS FAF40 RTS
.END

.LIB TAPECONTROL

Rücksprung

Bandpufferzeiger erhöhen

bump tape pointer

   

add 1 to tape index and test for overflow

.,F80D 20 D0 F7 JSR $F7D0 JTP20 JSR ZZZ
Bandpufferadresse holen
get tape buffer start pointer in XY
     
.,F810 E6 A6 INC $A6 INC BUFPT
Zeiger erhöhen
increment tape buffer index
     
.,F812 A4 A6 LDY $A6 LDY BUFPT
und laden um
get tape buffer index
     
.,F814 C0 C0 CPY #$C0 CPY #BUFSZ
mit Maximalwert (192) zu
vergleichen
compare with buffer length
     
.,F816 60 RTS RTS
;STAYS IN ROUTINE D2T1LL PLAY SWITCH
;
Rücksprung

Wartet auf Bandtaste

wait for PLAY

   

handle messages and

test cassette buttons for read
.,F817 20 2E F8 JSR $F82E CSTE1 JSR CS10
fragt BandtTaste ab
return cassette sense in Zb
     
.,F81A F0 1A BEQ $F836 BEQ CS25
gedrückt, dann fertig
if switch closed just exit
cassette switch was open
     
.,F81C A0 1B LDY #$1B LDY #MS7-MS1 ;"PRESS PLAY..."
Offset für 'PRESS PLAY ON
TAPE'
index to "PRESS PLAY ON TAPE"
     
.,F81E 20 2F F1 JSR $F12F CS30 JSR MSG
und ausgeben
display kernel I/O message
     
.,F821 20 D0 F8 JSR $F8D0 CS40 JSR TSTOP ;WATCH FOR STOP KEY
testet auf STOP-Taste
scan stop key and flag abort if pressed
note if STOP was pressed the return is to the
routine that called this one and not here
     
.,F824 20 2E F8 JSR $F82E JSR CS10 ;WATCH CASSETTE SWITCHES
fragt BandtTaste ab
return cassette sense in Zb
     
.,F827 D0 F8 BNE $F821 BNE CS40
nicht gedrückt so erneut
abfragen
loop if the cassette switch is open
     
.,F829 A0 6A LDY #$6A LDY #MS18-MS1 ;"OK"
Offset für 'OK'
index to "OK"
     
.,F82B 4C 2F F1 JMP $F12F JMP MSG
;SUBR RETURNS <> FOR CASSETTE SWITCH
;
und ausgeben, Rücksprung

Abfrage ob Band-Taste

gedrückt

display kernel I/O message and return

return cassette sense in Zb

   

test sense line for a button

depressed on cassette
.,F82E A9 10 LDA #$10 CS10 LDA #$10 ;CHECK PORT
Bit 4 testen
set the mask for the cassette switch
     
.,F830 24 01 BIT $01 BIT R6510 ;CLOSED?...
mit Port vergleichen
test the 6510 I/O port
     
.,F832 D0 02 BNE $F836 BNE CS25 ;NO. . .
verzweige wenn Bandtaste
nicht gedrückt
branch if cassette sense high
     
.,F834 24 01 BIT $01 BIT R6510 ;CHECK AGAIN TO DEBOUNCE
nochmal abfragen (Entprellen)
test the 6510 I/O port
     
.,F836 18 CLC CS25 CLC ;GOOD RETURN
Carry =0 (ok Kennzeichen)
       
.,F837 60 RTS RTS
;CHECKS FOR PLAY & RECORD
;
Rücksprung

Wartet auf Bandtaste für

Schreiben

wait for PLAY/RECORD

   

set messages and test cassette line

for input
.,F838 20 2E F8 JSR $F82E CSTE2 JSR CS10
fragt Bandtaste ab
return the cassette sense in Zb
     
.,F83B F0 F9 BEQ $F836 BEQ CS25
gedrückt, dann fertig
exit if switch closed
cassette switch was open
     
.,F83D A0 2E LDY #$2E LDY #MS8-MS1 ;"RECORD"
Offset für 'PRESS RECORD &
PLAY ON TAPE'
index to "PRESS RECORD & PLAY ON TAPE"
     
.,F83F D0 DD BNE $F81E BNE CS30
;READ HEADER BLOCK ENTRY
;
unbedingter Sprung

Block vom Band lesen

display message and wait for switch, branch always

initiate a tape read

   

read a block from cassette

.,F841 A9 00 LDA #$00 RBLK LDA #0
Status
clear A
     
.,F843 85 90 STA $90 STA STATUS
und Verify-Flag
clear serial status byte
     
.,F845 85 93 STA $93 STA VERCK
löschen
clear the load/verify flag
     
.,F847 20 D7 F7 JSR $F7D7 JSR LDAD1
;READ LOAD BLOCK ENTRY
;
Bandpufferadresse holen

Programm vom Band laden

set the tape buffer start and end pointers
     
.,F84A 20 17 F8 JSR $F817 TRD JSR CSTE1 ;SAY 'PRESS PLAY'
wartet auf Play-Taste
wait for PLAY
     
.,F84D B0 1F BCS $F86E BCS TWRT3 ;STOP KEY PRESSED
STOP-Taste gedrückt ?
exit if STOP was pressed, uses a further BCS at the
target address to reach final target at $F8DC
     
.,F84F 78 SEI SEI
Interrupt verhindern
disable interrupts
     
.,F850 A9 00 LDA #$00 LDA #0 ;CLEAR FLAGS...
Arbeitsspeicher für IRQ-
Routine löschen
clear A
     
.,F852 85 AA STA $AA STA RDFLG
Eingabebytespeicher (read)
       
.,F854 85 B4 STA $B4 STA SNSW1
Band Hilfszeiger
       
.,F856 85 B0 STA $B0 STA CMP0
Kassetten Zeitkonstante
clear tape timing constant min byte
     
.,F858 85 9E STA $9E STA PTR1
Korrekturzähler Pass 1
clear tape pass 1 error log/char buffer
     
.,F85A 85 9F STA $9F STA PTR2
Korrekturzähler Pass 2
clear tape pass 2 error log corrected
     
.,F85C 85 9C STA $9C STA DPSW
Flag für Byte emfngen
clear byte received flag
     
.,F85E A9 90 LDA #$90 LDA #$90 ;ENABLE FOR CA1 IRQ...READ LINE
Bitwert IRQ an Pin 'Flag'
enable CA1 interrupt ??
     
.,F860 A2 0E LDX #$0E LDX #14 ;POINT IRQ VECTOR TO READ
Nummer des IRQ-Vektors, $F92C
set index for tape read vector
     
.,F862 D0 11 BNE $F875 BNE TAPE ;JMP
;WRITE HEADER BLOCK ENTRY
;
unbedingter Sprung

Bandpuffer auf Band schreiben

go do tape read/write, branch always

initiate a tape write

   

write a block from cassette

.,F864 20 D7 F7 JSR $F7D7 WBLK JSR LDAD1
;
;WRITE LOAD BLOCK ENTRY
;
Bandpufferadresse holen
set tape buffer start and end pointers
do tape write, 20 cycle count
     
.,F867 A9 14 LDA #$14 TWRT LDA #20 ;BETWEEN BLOCK SHORTS
Länge des Vorspanns vor WRITE
set write lead cycle count
     
.,F869 85 AB STA $AB STA SHCNH
speichern

Block bzw. Programm auf Band

schreiben

save write lead cycle count
do tape write, no cycle count set
     
.,F86B 20 38 F8 JSR $F838 TWRT2 JSR CSTE2 ;SAY 'PRESS PLAY & RECORD'
wartet auf Record & Play
Taste
wait for PLAY/RECORD
     
.,F86E B0 6C BCS $F8DC TWRT3 BCS STOP3 ;STOP KEY PRESSED
verzweige falls STOP-Taste
gedrückt
if STOPped clear save IRQ address and exit
     
.,F870 78 SEI SEI
Interrupt verhindern
disable interrupts
     
.,F871 A9 82 LDA #$82 LDA #$82 ;ENABLE T2 IRQS...WRITE TIME
Bitwert für IRQ bei Unterlauf
von Timer B
enable ?? interrupt
     
.,F873 A2 08 LDX #$08 LDX #8 ;VECTOR IRQ TO WRTZ
;START TAPE OPERATION ENTRY POINT
;
Nummer des IRQ-Vektors, $FC6A
set index for tape write tape leader vector

tape read/write

   

common code for cassette read and write

.,F875 A0 7F LDY #$7F TAPE LDY #$7F ;KILL UNWANTED IRQ'S
Bitwert für alle IRQs sperren
disable all interrupts
     
.,F877 8C 0D DC STY $DC0D STY D1ICR
Wert schreiben
save VIA 1 ICR, disable all interrupts
     
.,F87A 8D 0D DC STA $DC0D STA D1ICR ;TURN ON WANTED
und neu setzen
save VIA 1 ICR, enable interrupts according to A
check RS232 bus idle
     
.,F87D AD 0E DC LDA $DC0E LDA D1CRA ;CALC TIMER ENABLES
Control Register A laden
read VIA 1 CRA
     
.,F880 09 19 ORA #$19 ORA #$19
Bitwert für one shot, starten
load timer B, timer B single shot, start timer B
     
.,F882 8D 0F DC STA $DC0F STA D1CRB ;TURN ON T2 IRQ'S FOR CASS WRITE(ONE SHOT)
und ins Steuerregister für
Timer B
save VIA 1 CRB
     
.,F885 29 91 AND #$91 AND #$91 ;SAVE TOD 50/60 INDICATION
Vergleichszeiger für Bandope-
mask x00x 000x, TOD clock, load timer A, start timer A
     
.,F887 8D A2 02 STA $02A2 STA CASTON ;PLACE IN AUTO MODE FOR T1
; WAIT FOR RS-232 TO FINISH
rationen entsprechend setzen
save VIA 1 CRB shadow copy
     
.,F88A 20 A4 F0 JSR $F0A4 JSR RSP232
; DISABLE SCREEN DISPLAY
auf Ende RS-232 Übertragung
warten
       
.,F88D AD 11 D0 LDA $D011 LDA VICREG+17
Bildschirm
read the vertical fine scroll and control register
     
.,F890 29 EF AND #$EF AND #$FF-$10 ;DISABLE SCREEN
dunkel
mask xxx0 xxxx, blank the screen
     
.,F892 8D 11 D0 STA $D011 STA VICREG+17
; MOVE IRQ TO IRQTEMP FOR CASS OPS
Tasten
save the vertical fine scroll and control register
     
.,F895 AD 14 03 LDA $0314 LDA CINV
IRQ-Vector
get IRQ vector low byte
     
.,F898 8D 9F 02 STA $029F STA IRQTMP
nach $029F
save IRQ vector low byte
     
.,F89B AD 15 03 LDA $0315 LDA CINV+1
und $02A0
get IRQ vector high byte
     
.,F89E 8D A0 02 STA $02A0 STA IRQTMP+1
speichern
save IRQ vector high byte
     
.,F8A1 20 BD FC JSR $FCBD JSR BSIV ;GO CHANGE IRQ VECTOR
IRQ-Vektor für Band I/O
setzen (X-indiziert)
set the tape vector
     
.,F8A4 A9 02 LDA #$02 LDA #2 ;FSBLK STARTS AT 2
Anzahl der
set copies count. the first copy is the load copy, the
second copy is the verify copy
     
.,F8A6 85 BE STA $BE STA FSBLK
zu lesenden Blöcke
save copies count
     
.,F8A8 20 97 FB JSR $FB97 JSR NEWCH ;PREP LOCAL COUNTERS AND FLAGS
serielle Ausgabe vorbereiten
Bit-Zähler setzen
new tape byte setup
     
.,F8AB A5 01 LDA $01 LDA R6510 ;TURN MOTOR ON
Prozessorport laden
read the 6510 I/O port
     
.,F8AD 29 1F AND #$1F AND #%011111 ;LOW TURNS ON
Bandmotor einschalten
mask 000x xxxx, cassette motor on ??
     
.,F8AF 85 01 STA $01 STA R6510
und wieder speichern
save the 6510 I/O port
     
.,F8B1 85 C0 STA $C0 STA CAS1 ;FLAG INTERNAL CONTROL OF CASS MOTOR
Flag für Bandmotor setzen
set the tape motor interlock
326656 cycle delay, allow tape motor speed to stabilise
     
.,F8B3 A2 FF LDX #$FF LDX #$FF ;DELAY BETWEEN BLOCKS
HIGH-Byte für Zähler
outer loop count
     
.,F8B5 A0 FF LDY #$FF TP32 LDY #$FF
LOW-Byte für Zähler
inner loop count
     
.,F8B7 88 DEY TP35 DEY
Verzögerungsschleife
decrement inner loop count
     
.,F8B8 D0 FD BNE $F8B7 BNE TP35
für Bandhochlaufzeit
loop if more to do
     
.,F8BA CA DEX DEX
HIGH-Byte veringern
decrement outer loop count
     
.,F8BB D0 F8 BNE $F8B5 BNE TP32
verzweige falls nicht Null
loop if more to do
     
.,F8BD 58 CLI CLI
Interrupt für Band I/O
freigeben

I/O Abschluß abwarten

enable tape interrupts
     
.,F8BE AD A0 02 LDA $02A0 TP40 LDA IRQTMP+1 ;CHECK FOR INTERRUPT VECTOR...
Band IRQ Vector mit normalem
get saved IRQ high byte
     
.,F8C1 CD 15 03 CMP $0315 CMP CINV+1 ;...POINTING AT KEY ROUTINE
IRQ Vector vergleichen
compare with the current IRQ high byte
     
.,F8C4 18 CLC CLC
Carry =0 (ok Kennzeichen)
flag ok
     
.,F8C5 F0 15 BEQ $F8DC BEQ STOP3 ;...YES RETURN
verzweige falls ja (fertig)
if tape write done go clear saved IRQ address and exit
     
.,F8C7 20 D0 F8 JSR $F8D0 JSR TSTOP ;...NO CHECK FOR STOP KEY
;
; 60 HZ KEYSCAN IGNORED
;
Testen auf Stop-Taste
scan stop key and flag abort if pressed
note if STOP was pressed the return is to the
routine that called this one and not here
     
.,F8CA 20 BC F6 JSR $F6BC JSR UD60 ; STOP KEY CHECK
bei gedrückter Stop-Taste
Flag setzen
increment real time clock
     
.,F8CD 4C BE F8 JMP $F8BE JMP TP40 ;STAY IN LOOP UNTILL TAPES ARE DONE
weiter warten

testet auf Stop-Taste

loop

scan stop key and flag abort if pressed

   

handle stop key during cassette operations

.,F8D0 20 E1 FF JSR $FFE1 TSTOP JSR STOP ;STOP KEY DOWN?
Stop-Taste abfragen
scan stop key
     
.,F8D3 18 CLC CLC ;ASSUME NO STOP
Carry =0 (ok Kennzeichen)
flag no stop
     
.,F8D4 D0 0B BNE $F8E1 BNE STOP4 ;WE WERE RIGHT
;
;STOP KEY DOWN...
;
verzweige wenn Taste nein
gedrückt
exit if no stop
     
.,F8D6 20 93 FC JSR $FC93 JSR TNIF ;TURN OFF CASSETTES
Band-Motor aus, normalen
IRQ wiederherstellen
restore everything for STOP
     
.,F8D9 38 SEC SEC ;FAILURE FLAG
Kennzeichen für Abbruch
flag stopped
     
.,F8DA 68 PLA PLA ;BACK ONE SQUARE...
Rücksprung
dump return address low byte
     
.,F8DB 68 PLA PLA
;
; LDA #0 ;STOP KEY FLAG
;
Adresse löschen
dump return address high byte

clear saved IRQ address

     
.,F8DC A9 00 LDA #$00 STOP3 LDA #0 ;DEALLOCATE IRQTMP
Kennzeichen für normalen
clear A
     
.,F8DE 8D A0 02 STA $02A0 STA IRQTMP+1 ;IF C-SET THEN STOP KEY
IRQ setzen
clear saved IRQ address high byte
     
.,F8E1 60 RTS STOP4 RTS
;
; STT1 - SET UP TIMEOUT WATCH FOR NEXT DIPOLE
;
Rücksprung

Band für Lesen vorbereiten

# set timing

   

schedule CIA1 timer A depending on X

.,F8E2 86 B1 STX $B1 STT1 STX TEMP ;.X HAS CONSTANT FOR TIMEOUT
X-Register speichern
save tape timing constant max byte
     
.,F8E4 A5 B0 LDA $B0 LDA CMP0 ;CMP0*5
Timing-Konstante laden
get tape timing constant min byte
     
.,F8E6 0A ASL ASL A
mit vier
*2
     
.,F8E7 0A ASL ASL A
multiplizieren
*4
     
.,F8E8 18 CLC CLC
zur Addition Carry löschen
clear carry for add
     
.,F8E9 65 B0 ADC $B0 ADC CMP0
mit altem Wert addieren (*5)
add tape timing constant min byte *5
     
.,F8EB 18 CLC CLC
zur Addition Carry löschen
clear carry for add
     
.,F8EC 65 B1 ADC $B1 ADC TEMP ;ADJUST LONG BYTE COUNT
alten X Wert dazuaddieren
add tape timing constant max byte
     
.,F8EE 85 B1 STA $B1 STA TEMP
und im Hilfszeiger speichern
save tape timing constant max byte
     
.,F8F0 A9 00 LDA #$00 LDA #0
Akku löschen
       
.,F8F2 24 B0 BIT $B0 BIT CMP0 ;CHECK CMP0 ...
prüfe Timing-Konstante
test tape timing constant min byte
     
.,F8F4 30 01 BMI $F8F7 BMI STT2 ;...MINUS, NO ADJUST
verzweige, falls größer 128
branch if b7 set
     
.,F8F6 2A ROL ROL A ;...PLUS SO ADJUST POS
Carry in die unterste
Position des Akkus schieben
else shift carry into ??
     
.,F8F7 06 B1 ASL $B1 STT2 ASL TEMP ;MULTIPLY CORRECTED VALUE BY 4
und Timer A
shift tape timing constant max byte
     
.,F8F9 2A ROL ROL A
Initialisierung
       
.,F8FA 06 B1 ASL $B1 ASL TEMP
mit vier
shift tape timing constant max byte
     
.,F8FC 2A ROL ROL A
multiplizieren
       
.,F8FD AA TAX TAX
Akku ins X-Register
       
.,F8FE AD 06 DC LDA $DC06 STT3 LDA D1T2L ;WATCH OUT FOR D1T2H ROLLOVER...
LOW-Byte Timer B laden
get VIA 1 timer B low byte
     
.,F901 C9 16 CMP #$16 CMP #22 ;...TIME FOR ROUTINE...!!!...
mit $16 vergleichen
compare with ??
     
.,F903 90 F9 BCC $F8FE BCC STT3 ;...TOO CLOSE SO WAIT UNTILL PAST
verzweige, wenn kleiner
loop if less
     
.,F905 65 B1 ADC $B1 ADC TEMP ;CALCULATE AND...
LOW-Byte für Initialisierung
addieren
add tape timing constant max byte
     
.,F907 8D 04 DC STA $DC04 STA D1T1L ;...STORE ADUSTED TIME COUNT
Timer A LOW speichern
save VIA 1 timer A low byte
     
.,F90A 8A TXA TXA
HIGH-Byte für Initialisierung
       
.,F90B 6D 07 DC ADC $DC07 ADC D1T2H ;ADJUST FOR HIGH TIME COUNT
zu Timer B HIGH addieren
add VIA 1 timer B high byte
     
.,F90E 8D 05 DC STA $DC05 STA D1T1H
und in Timer A HIGH schreiben
save VIA 1 timer A high byte
     
.,F911 AD A2 02 LDA $02A2 LDA CASTON ;ENABLE TIMERS
Init. Wert für Band Zeitkon.
read VIA 1 CRB shadow copy
     
.,F914 8D 0E DC STA $DC0E STA D1CRA
zum Starten von Timer A
save VIA 1 CRA
     
.,F917 8D A4 02 STA $02A4 STA STUPID ;NON-ZERO MEANS AN T1 IRQ HAS NOT OCCURED YET
Timer A Flag zurücksetzten
save VIA 1 CRA shadow copy
     
.,F91A AD 0D DC LDA $DC0D LDA D1ICR ;CLEAR OLD T1 INTERRUPT
ICR laden
read VIA 1 ICR
     
.,F91D 29 10 AND #$10 AND #$10 ;CHECK FOR OLD-FLAG IRQ
Bit isolieren
mask 000x 0000, FLAG interrupt
     
.,F91F F0 09 BEQ $F92A BEQ STT4 ;NO...NORMAL EXIT
verzweige wenn IRQ nicht vom
Pin Flag
if no FLAG interrupt just exit
else first call the IRQ routine
     
.,F921 A9 F9 LDA #$F9 LDA #>STT4 ;PUSH SIMULATED RETURN ADDRESS ON STACK
Rücksprungadresse
set the return address high byte
     
.,F923 48 PHA PHA
auf
push the return address high byte
     
.,F924 A9 2A LDA #$2A LDA #<STT4
Stack
set the return address low byte
     
.,F926 48 PHA PHA
schieben
push the return address low byte
     
.,F927 4C 43 FF JMP $FF43 JMP SIMIRQ
zum Interrupt
save the status and do the IRQ routine
     
.,F92A 58 CLI STT4 CLI ;ALLOW FOR RE-ENTRY CODE
alle Interrupts freigeben
enable interrupts
     
.,F92B 60 RTS RTS
.END

.LIB READ

; VARIABLES USED IN CASSETTE READ ROUTINES
;
; REZ - COUNTS ZEROS (IF Z THEN CORRECT # OF DIPOLES)
; RER - FLAGS ERRORS (IF Z THEN NO ERROR)
; DIFF - USED TO PRESERVE SYNO (OUTSIDE OF BIT ROUTINES)
; SYNO - FLAGS IF WE HAVE BLOCK SYNC (16 ZERO DIPOLES)
; SNSW1 - FLAGS IF WE HAVE BYTE SYNC (A LONGLONG)
; DATA - HOLDS MOST RECENT DIPOLE BIT VALUE
; MYCH - HOLDS INPUT BYTE BEING BUILT
; FIRT - USED TO INDICATE WHICH HALF OF DIPOLE WE'RE IN
; SVXT - TEMP USED TO ADJUST SOFTWARE SERVO
; TEMP - USED TO HOLD DIPOLE TIME DURING TYPE CALCULATIONS
; PRTY - HOLDS CURRENT CALCULATED PARITY BIT
; PRP - HAS COMBINED ERROR VALUES FROM BIT ROUTINES
; FSBLK - INDICATE WHICH BLOCK WE'RE LOOKING AT (0 TO EXIT)
; SHCNL - HOLDS FSBLK, USED TO DIRECT ROUTINES, BECAUSE OF EXIT CASE
; RDFLG - HOLDS FUNCTION MODE
; MI - WAITING FOR BLOCK SYNC
; VS - IN DATA BLOCK READING DATA
; NE - WAITING FOR BYTE SYNC
; SAL - INDIRECT TO DATA STORAGE AREA
; SHCNH - LEFT OVER FROM DEBUGGING
; BAD - STORAGE SPACE FOR BAD READ LOCATIONS (BOTTOM OF STACK)
; PTR1 - COUNT OF READ LOCATIONS IN ERROR (POINTER INTO BAD, MAX 61)
; PTR2 - COUNT OF RE-READ LOCATIONS (POINTER INTO BAD, DURING RE-READ)
; VERCHK - VERIFY OR LOAD FLAG (Z - LOADING)
; CMP0 - SOFTWARE SERVO (+/- ADJUST TO TIME CALCS)
; DPSW - IF NZ THEN EXPECTING LL/L COMBINATION THAT ENDS A BYTE
; PCNTR - COUNTS DOWN FROM 8-0 FOR DATA THEN TO FF FOR PARITY
; STUPID - HOLD INDICATOR (NZ - NO T1IRQ YET) FOR T1IRQ
; KIKA26 - HOLDS OLD D1ICR AFTER CLEAR ON READ
;
Rücksprung

Interrupt-Routine für Band

lesen

On Commodore computers, the streams consist of four kinds of symbols

that denote different kinds of low-to-high-to-low transitions on the
read or write signals of the Commodore cassette interface.
A A break in the communications, or a pulse with very long cycle
time.
B A short pulse, whose cycle time typically ranges from 296 to 424
microseconds, depending on the computer model.
C A medium-length pulse, whose cycle time typically ranges from
440 to 576 microseconds, depending on the computer model.
D A long pulse, whose cycle time typically ranges from 600 to 744
microseconds, depending on the computer model.
The actual interpretation of the serial data takes a little more work to explain.
The typical ROM tape loader (and the turbo loaders) will initialize a timer with a
specified value and start it counting down. If either the tape data changes or the
timer runs out, an IRQ will occur. The loader will determine which condition caused
the IRQ. If the tape data changed before the timer ran out, we have a short pulse,
or a "0" bit. If the timer ran out first, we have a long pulse, or a "1" bit. Doing
this continuously and we decode the entire file.
read tape bits, IRQ routine
read T2C which has been counting down from $FFFF. subtract this from $FFFF
   

cassette read IRQ routine

.,F92C AE 07 DC LDX $DC07 READ LDX D1T2H ;GET TIME SINCE LAST INTERRUPT
Timer B HIGH laden
read VIA 1 timer B high byte
     
.,F92F A0 FF LDY #$FF LDY #$FF ;COMPUTE COUNTER DIFFERENCE
Y-Register mit $FF laden (für
Timer)
set $FF
     
.,F931 98 TYA TYA
in Akku schieben
A = $FF
     
.,F932 ED 06 DC SBC $DC06 SBC D1T2L
Timer B von $FF abziehen
subtract VIA 1 timer B low byte
     
.,F935 EC 07 DC CPX $DC07 CPX D1T2H ;CHECK FOR TIMER HIGH ROLLOVER...
Timer B mit altem Wert
vergleichen
compare it with VIA 1 timer B high byte
     
.,F938 D0 F2 BNE $F92C BNE READ ;...YES THEN RECOMPUTE
verzweige, falls vermindert
if timer low byte rolled over loop
     
.,F93A 86 B1 STX $B1 STX TEMP
Timer B HIGH ablegen
save tape timing constant max byte
     
.,F93C AA TAX TAX
und in Akku schieben
copy $FF - T2C_l
     
.,F93D 8C 06 DC STY $DC06 STY D1T2L ;RELOAD TIMER2 (COUNT DOWN FROM $FFFF)
Timer B LOW und
save VIA 1 timer B low byte
     
.,F940 8C 07 DC STY $DC07 STY D1T2H
Timer B HIGH auf $FF setzen
save VIA 1 timer B high byte
     
.,F943 A9 19 LDA #$19 LDA #$19 ;ENABLE TIMER
Arbeitsmodus für Timer B
load timer B, timer B single shot, start timer B
     
.,F945 8D 0F DC STA $DC0F STA D1CRB
festlegen und starten
save VIA 1 CRB
     
.,F948 AD 0D DC LDA $DC0D LDA D1ICR ;CLEAR READ INTERRUPT
Interrupt Control Register
read VIA 1 ICR
     
.,F94B 8D A3 02 STA $02A3 STA KIKA26 ;SAVE FOR LATTER
laden und nach $02A3
save VIA 1 ICR shadow copy
     
.,F94E 98 TYA TYA
Y-REG in Akku ($FF)
y = $FF
     
.,F94F E5 B1 SBC $B1 SBC TEMP ;CALCULATE HIGH
Errechnung von vergangener
Zeit seit letzter Flanke
subtract tape timing constant max byte
A = $FF - T2C_h
     
.,F951 86 B1 STX $B1 STX TEMP
vergangene Zeit LOW nach $B1
save tape timing constant max byte
$B1 = $FF - T2C_l
     
.,F953 4A LSR LSR A ;MOVE TWO BITS FROM HIGH TO TEMP
vergangene Zeit
A = $FF - T2C_h >> 1
     
.,F954 66 B1 ROR $B1 ROR TEMP
HIGH
shift tape timing constant max byte
$B1 = $FF - T2C_l >> 1
     
.,F956 4A LSR LSR A
geteilt
A = $FF - T2C_h >> 1
     
.,F957 66 B1 ROR $B1 ROR TEMP
durch vier
shift tape timing constant max byte
$B1 = $FF - T2C_l >> 1
     
.,F959 A5 B0 LDA $B0 LDA CMP0 ;CALC MIN PULSE VALUE
Timingkonstante laden
get tape timing constant min byte
     
.,F95B 18 CLC CLC
und mit
clear carry for add
     
.,F95C 69 3C ADC #$3C ADC #60
$3C addiert
       
.,F95E C5 B1 CMP $B1 CMP TEMP ;IF PULSE LESS THAN MIN...
errechnete Zeit größer als
die Zeit bei letzten Flanken
compare with tape timing constant max byte
compare with ($FFFF - T2C) >> 2
     
.,F960 B0 4A BCS $F9AC BCS RDBK ;...THEN IGNORE AS NOISE
verzweige, wenn größer
branch if min + $3C >= ($FFFF - T2C) >> 2
min + $3C < ($FFFF - T2C) >> 2
     
.,F962 A6 9C LDX $9C LDX DPSW ;CHECK IF LAST BIT...
Flag für empfangenes Byte
laden
get byte received flag
     
.,F964 F0 03 BEQ $F969 BEQ RJDJ ;...NO THEN CONTINUE
verzweige, falls Null (Byte
nicht geladen)
if not byte received ??
     
.,F966 4C 60 FA JMP $FA60 JMP RADJ ;...YES THEN GO FINISH BYTE
ansonsten nach $FA60
store the tape character
     
.,F969 A6 A3 LDX $A3 RJDJ LDX PCNTR ;IF 9 BITS READ...
Byte vollständig gelesen
get EOI flag byte
     
.,F96B 30 1B BMI $F988 BMI JRAD2 ;... THEN GOTO ENDING
verzweige, falls ja
       
.,F96D A2 00 LDX #$00 LDX #0 ;SET BIT VALUE TO ZERO
Code für kurzer Impuls (X=0)
       
.,F96F 69 30 ADC #$30 ADC #48 ;ADD UP TO HALF WAY BETWEEN...
zu errechneter Zeit mit $30
       
.,F971 65 B0 ADC $B0 ADC CMP0 ;...SHORT PULSE AND SYNC PULSE
und mit Zeitkonstante
addieren
add tape timing constant min byte
     
.,F973 C5 B1 CMP $B1 CMP TEMP ;CHECK FOR SHORT...
größer als Zeit beim letztem
Flanken ?
compare with tape timing constant max byte
     
.,F975 B0 1C BCS $F993 BCS RADX2 ;...YES IT'S A SHORT
verzweige wenn größer
       
.,F977 E8 INX INX ;SET BIT VALUE TO ONE
sonst langer Impuls (X=1)
       
.,F978 69 26 ADC #$26 ADC #38 ;MOVE TO MIDDLE OF HIGH
und wieder $26 und
       
.,F97A 65 B0 ADC $B0 ADC CMP0
Zeitkonstanten addieren
add tape timing constant min byte
     
.,F97C C5 B1 CMP $B1 CMP TEMP ;CHECK FOR ONE...
jetzt größer ?
compare with tape timing constant max byte
     
.,F97E B0 17 BCS $F997 BCS RADL ;...YES IT'S A ONE
verzweige, falls ja
       
.,F980 69 2C ADC #$2C ADC #44 ;MOVE TO LONGLONG
sonst wieder $2C und
       
.,F982 65 B0 ADC $B0 ADC CMP0
Zeitkonstante addieren
add tape timing constant min byte
     
.,F984 C5 B1 CMP $B1 CMP TEMP ;CHECK FOR LONGLONG...
vergangene Zeit noch länger ?
compare with tape timing constant max byte
     
.,F986 90 03 BCC $F98B BCC SRER ;...GREATER THAN IS ERROR
verzweige, wenn jetzt kürzer
       
.,F988 4C 10 FA JMP $FA10 JRAD2 JMP RAD2 ;...IT'S A LONGLONG
zu empfangenes Byte verarbeiten
       
.,F98B A5 B4 LDA $B4 SRER LDA SNSW1 ;IF NOT SYNCRONIZED...
Flag für Timer A laden
get the bit count
     
.,F98D F0 1D BEQ $F9AC BEQ RDBK ;...THEN NO ERROR
verzweige, wenn Timer A nicht
freigegeben
if all done go ??
     
.,F98F 85 A8 STA $A8 STA RER ;...ELSE FLAG RER
Zeiger auf 'READ ERROR'
setzen
save receiver bit count in
     
.,F991 D0 19 BNE $F9AC BNE RDBK ;JMP
unbedingter Sprung
branch always
     
.,F993 E6 A9 INC $A9 RADX2 INC REZ ;COUNT REZ UP ON ZEROS
Zeiger auf Impulswechsel +1
increment ?? start bit check flag
     
.,F995 B0 02 BCS $F999 BCS RAD5 ;JMP
unbedingter Sprung
       
.,F997 C6 A9 DEC $A9 RADL DEC REZ ;COUNT REZ DOWN ON ONES
Zeiger auf Impulswechsel -1
decrement ?? start bit check flag
     
.,F999 38 SEC RAD5 SEC ;CALC ACTUAL VALUE FOR COMPARE STORE
Carry für Subtraktion setzen
       
.,F99A E9 13 SBC #$13 SBC #19
Anfangswert ($13) und
       
.,F99C E5 B1 SBC $B1 SBC TEMP ;SUBTRACT INPUT VALUE FROM CONSTANT...
vergangene Zeit subtrahieren
subtract tape timing constant max byte
     
.,F99E 65 92 ADC $92 ADC SVXT ;...ADD DIFFERENCE TO TEMP STORAGE...
und mit Flag für Timing
Korrektur addieren
add timing constant for tape
     
.,F9A0 85 92 STA $92 STA SVXT ;...USED LATER TO ADJUST SOFT SERVO
Ergebnis dort speichern
save timing constant for tape
     
.,F9A2 A5 A4 LDA $A4 LDA FIRT ;FLIP DIPOLE FLAG
Flag für Empfang beider
get tape bit cycle phase
     
.,F9A4 49 01 EOR #$01 EOR #1
Impulse invertieren
       
.,F9A6 85 A4 STA $A4 STA FIRT
und abspeichern
save tape bit cycle phase
     
.,F9A8 F0 2B BEQ $F9D5 BEQ RAD3 ;SECOND HALF OF DIPOLE
verzweige wenn beide Impulse
empfangen
       
.,F9AA 86 D7 STX $D7 STX DATA ;FIRST HALF SO STORE ITS VALUE
empfangenes Signal speichern
       
.,F9AC A5 B4 LDA $B4 RDBK LDA SNSW1 ;IF NO BYTE START...
Flag für Timer A laden
get the bit count
     
.,F9AE F0 22 BEQ $F9D2 BEQ RADBK ;...THEN RETURN
verzweige wenn Timer gesperrt
if all done go ??
     
.,F9B0 AD A3 02 LDA $02A3 LDA KIKA26 ;CHECK TO SEE IF TIMER1 IRQD US...
ICR in Akku
read VIA 1 ICR shadow copy
     
.,F9B3 29 01 AND #$01 AND #$01
Bit 0 isolieren
mask 0000 000x, timer A interrupt enabled
     
.,F9B5 D0 05 BNE $F9BC BNE RADKX ;...YES
verzweige wenn Interrupt von
Timer A
if timer A is enabled go ??
     
.,F9B7 AD A4 02 LDA $02A4 LDA STUPID ;CHECK FOR OLD T1IRQ
Timer A abgelaufen
read VIA 1 CRA shadow copy
     
.,F9BA D0 16 BNE $F9D2 BNE RADBK ;NO...SO EXIT
;
nein, dann zum Interruptende
if ?? just exit
     
.,F9BC A9 00 LDA #$00 RADKX LDA #0 ;...YES, SET DIPOLE FLAG FOR FIRST HALF
Impulszähler
clear A
     
.,F9BE 85 A4 STA $A4 STA FIRT
löschen und
clear the tape bit cycle phase
     
.,F9C0 8D A4 02 STA $02A4 STA STUPID ;SET T1IRQ FLAG
Zeiger auf Timeout setzen
save VIA 1 CRA shadow copy
     
.,F9C3 A5 A3 LDA $A3 LDA PCNTR ;CHECK WHERE WE ARE IN BYTE...
prüfe ob Byte vollständig
gelesen
get EOI flag byte
     
.,F9C5 10 30 BPL $F9F7 BPL RAD4 ;...DOING DATA
verzweige falls nein
       
.,F9C7 30 BF BMI $F988 BMI JRAD2 ;...PROCESS PARITY
unbedingter Sprung
       
.,F9C9 A2 A6 LDX #$A6 RADP LDX #166 ;SET UP FOR LONGLONG TIMEOUT
Initialisierungswert für
Timer A
set timimg max byte
     
.,F9CB 20 E2 F8 JSR $F8E2 JSR STT1
Band zum Lesen vorbereiten
set timing
     
.,F9CE A5 9B LDA $9B LDA PRTY ;IF PARITY NOT EVEN...
Paritätsbyte in Akku
       
.,F9D0 D0 B9 BNE $F98B BNE SRER ;...THEN GO SET ERROR
verzweige falls parit. Fehler
       
.,F9D2 4C BC FE JMP $FEBC RADBK JMP PREND ;GO RESTORE REGS AND RTI
Rückkehr vom Interrupt
restore registers and exit interrupt
     
.,F9D5 A5 92 LDA $92 RAD3 LDA SVXT ;ADJUST THE SOFTWARE SERVO (CMP0)
Timing Korrekturzeiger laden
get timing constant for tape
     
.,F9D7 F0 07 BEQ $F9E0 BEQ ROUT1 ;NO ADJUST
verzweige wenn Flag gelöscht
       
.,F9D9 30 03 BMI $F9DE BMI ROUT2 ;ADJUST FOR MORE BASE TIME
verzweige wenn kleiner Null
       
.,F9DB C6 B0 DEC $B0 DEC CMP0 ;ADJUST FOR LESS BASE TIME
Timing Konstante -1
decrement tape timing constant min byte
     
.:F9DD 2C .BYTE $2C .BYT $2C ;SKIP TWO BYTES
Skip zu $F9E0
makes next line BIT $B0E6
     
.,F9DE E6 B0 INC $B0 ROUT2 INC CMP0
Timing Konstante +1
increment tape timing constant min byte
     
.,F9E0 A9 00 LDA #$00 ROUT1 LDA #0 ;CLEAR DIFFERENCE VALUE
Timing
       
.,F9E2 85 92 STA $92 STA SVXT
;CHECK FOR CONSECUTIVE LIKE VALUES IN DIPOLE...
Korrekturzeiger löschen
clear timing constant for tape
     
.,F9E4 E4 D7 CPX $D7 CPX DATA
Vergleiche empfangenen Impuls
mit vorherigem
       
.,F9E6 D0 0F BNE $F9F7 BNE RAD4 ;...NO, GO PROCESS INFO
verzweige falls ungleich
       
.,F9E8 8A TXA TXA ;...YES SO CHECK THE VALUES...
Prüfe ob kurzer Impuls
empfangen
       
.,F9E9 D0 A0 BNE $F98B BNE SRER ;IF THEY WERE ONES THEN ERROR
; CONSECUTIVE ZEROS
falls nein, verzweige
       
.,F9EB A5 A9 LDA $A9 LDA REZ ;...CHECK HOW MANY ZEROS HAVE HAPPENED
Impulswechselzeiger laden
get start bit check flag
     
.,F9ED 30 BD BMI $F9AC BMI RDBK ;...IF MANY DON'T CHECK
verzweige wenn negativ
       
.,F9EF C9 10 CMP #$10 CMP #16 ;... DO WE HAVE 16 YET?...
vergleiche mit $10
       
.,F9F1 90 B9 BCC $F9AC BCC RDBK ;....NO SO CONTINUE
verzweige wenn kleiner $10
       
.,F9F3 85 96 STA $96 STA SYNO ;....YES SO FLAG SYNO (BETWEEN BLOCKS)
sonst EOB Flag empfangen
save cassette block synchronization number
     
.,F9F5 B0 B5 BCS $F9AC BCS RDBK ;JMP
unbedingter Sprung
       
.,F9F7 8A TXA RAD4 TXA ;MOVE READ DATA TO .A
Empfangenes Bit in Akku
       
.,F9F8 45 9B EOR $9B EOR PRTY ;CALCULATE PARITY
mit Band-Parität verknüpfen
       
.,F9FA 85 9B STA $9B STA PRTY
in Band-Parität speichern
       
.,F9FC A5 B4 LDA $B4 LDA SNSW1 ;REAL DATA?...
Flag für Timer A laden
       
.,F9FE F0 D2 BEQ $F9D2 BEQ RADBK ;...NO SO FORGET BY EXITING
verzweige wenn nicht frei ge-
geben
       
.,FA00 C6 A3 DEC $A3 DEC PCNTR ;DEC BIT COUNT
Speicher für Bitzähler -1
decrement EOI flag byte
     
.,FA02 30 C5 BMI $F9C9 BMI RADP ;IF MINUS THEN TIME FOR PARITY
verzweige wenn Paritätsbit
empfangen
       
.,FA04 46 D7 LSR $D7 LSR DATA ;SHIFT BIT FROM DATA...
gelesenes Bit ins Carry und
       
.,FA06 66 BF ROR $BF ROR MYCH ;...INTO BYTE STORAGE (MYCH) BUFFER
dann in $BF rollen
parity count
     
.,FA08 A2 DA LDX #$DA LDX #218 ;SET UP FOR NEXT DIPOLE
Initialisierungswert für
Timer A ins X-Register
set timimg max byte
     
.,FA0A 20 E2 F8 JSR $F8E2 JSR STT1
zur Kassettensynchronisation
set timing
     
.,FA0D 4C BC FE JMP $FEBC JMP PREND ;RESTORE REGS AND RTI
; RAD2 - LONGLONG HANDLER (COULD BE A LONG ONE)
Rückkehr vom Interrupt
restore registers and exit interrupt
     
.,FA10 A5 96 LDA $96 RAD2 LDA SYNO ;HAVE WE GOTTEN BLOCK SYNC...
Prüfe ob EOB empfangen
get cassette block synchronization number
     
.,FA12 F0 04 BEQ $FA18 BEQ RAD2Y ;...NO
falls nein, verzweige
       
.,FA14 A5 B4 LDA $B4 LDA SNSW1 ;CHECK IF WE'VE HAD A REAL BYTE START...
Prüfe ob Timer A freige.
       
.,FA16 F0 07 BEQ $FA1F BEQ RAD2X ;...NO
wenn nein, überspringe Bit
Zähler Test
       
.,FA18 A5 A3 LDA $A3 RAD2Y LDA PCNTR ;ARE WE AT END OF BYTE...
Bitzähler laden
get EOI flag byte
     
.,FA1A 30 03 BMI $FA1F BMI RAD2X ;YES...GO ADJUST FOR LONGLONG
verzweige falls negatv
       
.,FA1C 4C 97 F9 JMP $F997 JMP RADL ;...NO SO TREAT IT AS A LONG ONE READ
langen Impuls verarbeiten
       
.,FA1F 46 B1 LSR $B1 RAD2X LSR TEMP ;ADJUST TIMEOUT FOR...
vergangene Zeit seit letztem
Flangen halbieren
shift tape timing constant max byte
     
.,FA21 A9 93 LDA #$93 LDA #147 ;...LONGLONG PULSE VALUE
und diesen Wert
       
.,FA23 38 SEC SEC
von $93
       
.,FA24 E5 B1 SBC $B1 SBC TEMP
abziehen
subtract tape timing constant max byte
     
.,FA26 65 B0 ADC $B0 ADC CMP0
dazu dann Timing-Konstante
addieren
add tape timing constant min byte
     
.,FA28 0A ASL ASL A
und Ergebnis verdoppeln
       
.,FA29 AA TAX TAX ;AND SET TIMEOUT FOR LAST BIT
Ergebnis ins X-Register
copy timimg high byte
     
.,FA2A 20 E2 F8 JSR $F8E2 JSR STT1
Timing initialisieren
set timing
     
.,FA2D E6 9C INC $9C INC DPSW ;SET BIT THROW AWAY FLAG
Flag für Byte empfangen
setzen
       
.,FA2F A5 B4 LDA $B4 LDA SNSW1 ;IF BYTE SYNCRONIZED....
Flag für Timer A laden
       
.,FA31 D0 11 BNE $FA44 BNE RADQ2 ;...THEN SKIP TO PASS CHAR
verzweige falls freigegeben
       
.,FA33 A5 96 LDA $96 LDA SYNO ;THROWS OUT DATA UNTILL BLOCK SYNC...
wurde EOB emfangen ?
get cassette block synchronization number
     
.,FA35 F0 26 BEQ $FA5D BEQ RDBK2 ;...NO BLOCK SYNC
verzweige wenn nicht
empfangen
       
.,FA37 85 A8 STA $A8 STA RER ;FLAG DATA AS ERROR
Flag für Lesefehler setzen
save receiver bit count in
     
.,FA39 A9 00 LDA #$00 LDA #0 ;KILL 16 SYNC FLAG
Flag für
clear A
     
.,FA3B 85 96 STA $96 STA SYNO
EOB rücksetzen
clear cassette block synchronization number
     
.,FA3D A9 81 LDA #$81 LDA #$81 ;SET UP FOR TIMER1 INTERRUPTS
Interrupt für
enable timer A interrupt
     
.,FA3F 8D 0D DC STA $DC0D STA D1ICR
Timer A freigeben
save VIA 1 ICR
     
.,FA42 85 B4 STA $B4 STA SNSW1 ;FLAG THAT WE HAVE BYTE SYNCRONIZED
;
und Flag für Timer A setzen
       
.,FA44 A5 96 LDA $96 RADQ2 LDA SYNO ;SAVE SYNO STATUS
Flag für EOB laden
get cassette block synchronization number
     
.,FA46 85 B5 STA $B5 STA DIFF
und nach $B5 kopieren
       
.,FA48 F0 09 BEQ $FA53 BEQ RADK ;NO BLOCK SYNC, NO BYTE LOOKING
verzweige wenn kein EOB
       
.,FA4A A9 00 LDA #$00 LDA #0 ;TURN OFF BYTE SYNC SWITCH
Flag für Timer A
       
.,FA4C 85 B4 STA $B4 STA SNSW1
löschen und auch
       
.,FA4E A9 01 LDA #$01 LDA #$01 ;DISABLE TIMER1 INTERRUPTS
Interruptflag
disable timer A interrupt
     
.,FA50 8D 0D DC STA $DC0D STA D1ICR
wieder löschen
save VIA 1 ICR
     
.,FA53 A5 BF LDA $BF RADK LDA MYCH ;PASS CHARACTER TO BYTE ROUTINE
Shift Register für Read laden
parity count
     
.,FA55 85 BD STA $BD STA OCHAR
und nach $BD bringen
save RS232 parity byte
     
.,FA57 A5 A8 LDA $A8 LDA RER ;COMBINE ERROR VALUES WITH ZERO COUNT...
Flag für Lesefehler laden
get receiver bit count in
     
.,FA59 05 A9 ORA $A9 ORA REZ
mit Impulswechselzeiger
OR with start bit check flag
     
.,FA5B 85 B6 STA $B6 STA PRP ;...AND SAVE IN PRP
verknüpfen und in Fehlercode
des Bytes ablegen
       
.,FA5D 4C BC FE JMP $FEBC RDBK2 JMP PREND ;GO BACK AND GET LAST BYTE
Rückkehr vom Interrupt
restore registers and exit interrupt

# store character

   

receive next byte from cassette

.,FA60 20 97 FB JSR $FB97 RADJ JSR NEWCH ;FINISH BYTE, CLR FLAGS
Bitzähler für serielle
Ausgabe setzen
new tape byte setup
     
.,FA63 85 9C STA $9C STA DPSW ;CLEAR BIT THROW AWAY FLAG
Zeiger auf Byte empfangen
rücksetzen
clear byte received flag
     
.,FA65 A2 DA LDX #$DA LDX #218 ;INITILIZE FOR NEXT DIPOLE
Initialisierungswert Timer A
set timimg max byte
     
.,FA67 20 E2 F8 JSR $F8E2 JSR STT1
Kassettensynchronisation
set timing
     
.,FA6A A5 BE LDA $BE LDA FSBLK ;CHECK FOR LAST VALUE
Anzahl der verbliebenen
Blöcke laden
get copies count
     
.,FA6C F0 02 BEQ $FA70 BEQ RD15
verzweige wenn Null
       
.,FA6E 85 A7 STA $A7 STA SHCNL
;*************************************************
;* BYTE HANDLER OF CASSETTE READ *
;* *
;* THIS PORTION OF IN LINE CODE IS PASSED THE *
;* BYTE ASSEMBLED FROM READING TAPE IN OCHAR. *
;* RER IS SET IF THE BYTE READ IS IN ERROR. *
;* REZ IS SET IF THE INTERRUPT PROGRAM IS READING*
;* ZEROS. RDFLG TELLS US WHAT WE ARE DOING. *
;* BIT 7 SAYS TO IGNORE BYTES UNTIL REZ IS SET *
;* BIT 6 SAYS TO LOAD THE BYTE. OTHERWISE RDFLG *
;* IS A COUNTDOWN AFTER SYNC. IF VERCK IS SET *
;* WE DO A COMPARE INSTEAD OF A STORE AND SET *
;* STATUS. FSBLK COUNTS THE TWO BLOCKS. PTR1 IS *
;* INDEX TO ERROR TABLE FOR PASS1. PTR2 IS INDEX*
;* TO CORRECTION TABLE FOR PASS2. *
;*************************************************
;
SPERR=16
CKERR=32
SBERR=4
LBERR=8
;
Blockanzahl neu setzen
save receiver input bit temporary storage
     
.,FA70 A9 0F LDA #$0F RD15 LDA #$F
;
Maskenwert für Zählung vor
dem Lesen
       
.,FA72 24 AA BIT $AA BIT RDFLG ;TEST FUNCTION MODE
Prüfe Zeiger für Lesen von
Band
       
.,FA74 10 17 BPL $FA8D BPL RD20 ;NOT WAITING FOR ZEROS
;
verzweige wenn alle Zeichen
empfangen (Ende)
       
.,FA76 A5 B5 LDA $B5 LDA DIFF ;ZEROS YET?
Flag für EOB laden
       
.,FA78 D0 0C BNE $FA86 BNE RD12 ;YES...WAIT FOR SYNC
verzweige wenn gültiges EOB
empfangen
       
.,FA7A A6 BE LDX $BE LDX FSBLK ;IS PASS OVER?
Anzahl der verbliebenen
Blöcke laden
get copies count
     
.,FA7C CA DEX DEX ;...IF FSBLK ZERO THEN NO ERROR (FIRST GOOD)
Anzahl -1
       
.,FA7D D0 0B BNE $FA8A BNE RD10 ;NO...
;
verzweige wenn nicht Null
if ?? restore registers and exit interrupt
     
.,FA7F A9 08 LDA #$08 LDA #LBERR
'LONG BLOCK' error
set short block
     
.,FA81 20 1C FE JSR $FE1C JSR UDST ;YES...LONG BLOCK ERROR
Status setzen
OR into serial status byte
     
.,FA84 D0 04 BNE $FA8A BNE RD10 ;BRANCH ALWAYS
;
unbedingter Sprung zum
normalen IRQ
restore registers and exit interrupt, branch always
     
.,FA86 A9 00 LDA #$00 RD12 LDA #0
Flag für Lesen vom Band auf
       
.,FA88 85 AA STA $AA STA RDFLG ;NEW MODE IS WAIT FOR SYNC
Abtastung setzen
       
.,FA8A 4C BC FE JMP $FEBC RD10 JMP PREND ;EXIT...DONE
;
Rückkehr vom Interrupt
restore registers and exit interrupt
     
.,FA8D 70 31 BVS $FAC0 RD20 BVS RD60 ;WE ARE LOADING
verzweige wenn Bandzeiger auf
lesen
       
.,FA8F D0 18 BNE $FAA9 BNE RD200 ;WE ARE SYNCING
;
verzweige wenn Bandzeiger
auf Zählen
       
.,FA91 A5 B5 LDA $B5 LDA DIFF ;DO WE HAVE BLOCK SYNC...
Flag für EOB laden
       
.,FA93 D0 F5 BNE $FA8A BNE RD10 ;...YES, EXIT
verzweige wenn EOB empfangen
       
.,FA95 A5 B6 LDA $B6 LDA PRP ;IF FIRST BYTE HAS ERROR...
Flag für Lesefehler laden
       
.,FA97 D0 F1 BNE $FA8A BNE RD10 ;...THEN SKIP (EXIT)
verzweige falls Fehler
aufgetreten
       
.,FA99 A5 A7 LDA $A7 LDA SHCNL ;MOVE FSBLK TO CARRY...
Anzahl der noch zu lesenden
Blöcke holen
get receiver input bit temporary storage
     
.,FA9B 4A LSR LSR A
Bit 0 ins Carry schieben
       
.,FA9C A5 BD LDA $BD LDA OCHAR ; SHOULD BE A HEADER COUNT CHAR
hole gelesenes Byte
get RS232 parity byte
     
.,FA9E 30 03 BMI $FAA3 BMI RD22 ;IF NEG THEN FIRSTBLOCK DATA
verzweige wenn es Zählbyte
ist
       
.,FAA0 90 18 BCC $FABA BCC RD40 ;...EXPECTING FIRSTBLOCK DATA...YES
verzweige wenn mehr als ein
Block zu lesen
       
.,FAA2 18 CLC CLC
lösche Carry um nicht zu
verzweigen
       
.,FAA3 B0 15 BCS $FABA RD22 BCS RD40 ;EXPECTING SECOND BLOCK?...YES
verzweige falls nur ein Block
zu lesen
       
.,FAA5 29 0F AND #$0F AND #$F ;MASK OFF HIGH STORE HEADER COUNT...
Bits 0 bis 3 isolieren
       
.,FAA7 85 AA STA $AA STA RDFLG ;...IN MODE FLAG (HAVE CORRECT BLOCK)
und für Zählung speichern
       
.,FAA9 C6 AA DEC $AA RD200 DEC RDFLG ;WAIT UNTILL WE GET REAL DATA...
alle Synchrrnisationsbytes
empfangen
       
.,FAAB D0 DD BNE $FA8A BNE RD10 ;...9876543210 REAL
wenn nein verzweige
       
.,FAAD A9 40 LDA #$40 LDA #$40 ;NEXT UP IS REAL DATA...
Bandzeiger auf
       
.,FAAF 85 AA STA $AA STA RDFLG ;...SET DATA MODE
lesen stellen
       
.,FAB1 20 8E FB JSR $FB8E JSR RD300 ;GO SETUP ADDRESS POINTERS
Ein/Ausgabe Adresse kopieren
copy I/O start address to buffer address
     
.,FAB4 A9 00 LDA #$00 LDA #0 ;DEBUG CODE##################################################
Flag für
       
.,FAB6 85 AB STA $AB STA SHCNH
Leseprüfsumme löschen
       
.,FAB8 F0 D0 BEQ $FA8A BEQ RD10 ;JMP TO CONTINUE
unbedingter Sprung
       
.,FABA A9 80 LDA #$80 RD40 LDA #$80 ;WE WANT TO...
Bandzeiger
       
.,FABC 85 AA STA $AA STA RDFLG ;IGNORE BYTES MODE
auf Ende stellen
       
.,FABE D0 CA BNE $FA8A BNE RD10 ;JMP
unbedingter Sprung
restore registers and exit interrupt, branch always
     
.,FAC0 A5 B5 LDA $B5 RD60 LDA DIFF ;CHECK FOR END OF BLOCK...
Flag für EOB laden
       
.,FAC2 F0 0A BEQ $FACE BEQ RD70 ;...OKAY
;
verzweige wenn nicht gesetzt
       
.,FAC4 A9 04 LDA #$04 LDA #SBERR ;SHORT BLOCK ERROR
'SHORT BLOCK’ error
       
.,FAC6 20 1C FE JSR $FE1C JSR UDST
Status setzen
OR into serial status byte
     
.,FAC9 A9 00 LDA #$00 LDA #0 ;FORCE RDFLG FOR AN END
Code für Lesezeiger auf
"Abtasten"
       
.,FACB 4C 4A FB JMP $FB4A JMP RD161
setzen, unbedingter Sprung
       
.,FACE 20 D1 FC JSR $FCD1 RD70 JSR CMPSTE ;CHECK FOR END OF STORAGE AREA
Endadresse schon erreicht ?
check read/write pointer, return Cb = 1 if pointer >= end
     
.,FAD1 90 03 BCC $FAD6 BCC *+5 ;NOT DONE YET
nein dann verzweige
       
.,FAD3 4C 48 FB JMP $FB48 JMP RD160
zu Read Ende für Block
       
.,FAD6 A6 A7 LDX $A7 LDX SHCNL ;CHECK WHICH PASS...
nur noch
get receiver input bit temporary storage
     
.,FAD8 CA DEX DEX
ein Block zu lesen
       
.,FAD9 F0 2D BEQ $FB08 BEQ RD58 ;...SECOND PASS
verzweige wenn ja (Pass 2)
       
.,FADB A5 93 LDA $93 LDA VERCK ;CHECK IF LOAD OR VERIFY...
Load/Verify-Flag
get load/verify flag
     
.,FADD F0 0C BEQ $FAEB BEQ RD80 ;...LOADING
verzweige wenn Load
if load go ??
     
.,FADF A0 00 LDY #$00 LDY #0 ;...JUST VERIFYING
Zähler auf Null setzen
clear index
     
.,FAE1 A5 BD LDA $BD LDA OCHAR
gelesenes Byte
get RS232 parity byte
     
.,FAE3 D1 AC CMP ($AC),Y CMP (SAL)Y ;COMPARE WITH DATA IN PET
vergleichen
       
.,FAE5 F0 04 BEQ $FAEB BEQ RD80 ;...GOOD SO CONTINUE
verzweige wenn Übereinstim-
mung
       
.,FAE7 A9 01 LDA #$01 LDA #1 ;...BAD SO FLAG...
Fehlerflag
       
.,FAE9 85 B6 STA $B6 STA PRP ;...AS AN ERROR
; STORE BAD LOCATIONS FOR SECOND PASS RE-TRY
setzen
       
.,FAEB A5 B6 LDA $B6 RD80 LDA PRP ;CHK FOR ERRORS...
Fehlerflag laden
       
.,FAED F0 4B BEQ $FB3A BEQ RD59 ;...NO ERRORS
verzweige wenn kein Fehler
aufgetreten
       
.,FAEF A2 3D LDX #$3D LDX #61 ;MAX ALLOWED IS 30
bereits 31 Fehler
       
.,FAF1 E4 9E CPX $9E CPX PTR1 ;ARE WE AT MAX?...
aufgetreten
       
.,FAF3 90 3E BCC $FB33 BCC RD55 ;...YES, FLAG AS SECOND PASS ERROR
verzweige wenn weniger Fehler
       
.,FAF5 A6 9E LDX $9E LDX PTR1 ;GET INDEX INTO BAD...
Index für Lesefehler
       
.,FAF7 A5 AD LDA $AD LDA SAH ;...AND STORE THE BAD LOCATION
laufender Adressbyte HIGH
       
.,FAF9 9D 01 01 STA $0101,X STA BAD+1,X ;...IN BAD TABLE
im Stack speichern
       
.,FAFC A5 AC LDA $AC LDA SAL
Adressbyte LOW
       
.,FAFE 9D 00 01 STA $0100,X STA BAD,X
für spätere Korrektur
ebenfalls im Stack speichern
       
.,FB01 E8 INX INX ;ADVANCE POINTER TO NEXT
Zeiger auf nachfolgende
       
.,FB02 E8 INX INX
freie Stelle setzen
       
.,FB03 86 9E STX $9E STX PTR1
und abspeichern
       
.,FB05 4C 3A FB JMP $FB3A JMP RD59 ;GO STORE CHARACTER
; CHECK BAD TABLE FOR RE-TRY (SECOND PASS)
weitermachen
       
.,FB08 A6 9F LDX $9F RD58 LDX PTR2 ;HAVE WE DONE ALL IN THE TABLE?...
bereits alle Lesefehler
       
.,FB0A E4 9E CPX $9E CPX PTR1
korrigiert ?
       
.,FB0C F0 35 BEQ $FB43 BEQ RD90 ;...YES
verzweige falls ja
       
.,FB0E A5 AC LDA $AC LDA SAL ;SEE IF THIS IS NEXT IN THE TABLE...
Adressbyte LOW laden
       
.,FB10 DD 00 01 CMP $0100,X CMP BAD,X
mit fehlerhaftem Adressbyte
LOW vergleichen
       
.,FB13 D0 2E BNE $FB43 BNE RD90 ;...NO
verzweige falls nicht
gefunden
       
.,FB15 A5 AD LDA $AD LDA SAH
Adressbyte HIGH laden
       
.,FB17 DD 01 01 CMP $0101,X CMP BAD+1,X
mit fehlerhaftem Adressbyte
HIGH vergleichen
       
.,FB1A D0 27 BNE $FB43 BNE RD90 ;...NO
verzweige wenn nicht gefunden
       
.,FB1C E6 9F INC $9F INC PTR2 ;WE FOUND NEXT ONE, SO ADVANCE POINTER
Korrekturzähler
       
.,FB1E E6 9F INC $9F INC PTR2
Pass 2 um zwei erhöhen
       
.,FB20 A5 93 LDA $93 LDA VERCK ;DOING A LOAD OR VERIFY?...
Verify-Flag gesetzt
get load/verify flag
     
.,FB22 F0 0B BEQ $FB2F BEQ RD52 ;...LOADING
verzweige wenn nicht gesetzt
if load ??
     
.,FB24 A5 BD LDA $BD LDA OCHAR ;...VERIFYING, SO CHECK
gelesenes Byte laden
get RS232 parity byte
     
.,FB26 A0 00 LDY #$00 LDY #0
Zähler auf Null setzen
       
.,FB28 D1 AC CMP ($AC),Y CMP (SAL)Y
mit Speicherinhalt verglei-
chen
       
.,FB2A F0 17 BEQ $FB43 BEQ RD90 ;...OKAY
verzweige wenn gleich, dann
nächstes Byte
       
.,FB2C C8 INY INY ;MAKE .Y= 1
Flag für
       
.,FB2D 84 B6 STY $B6 STY PRP ;FLAG IT AS AN ERROR
Fehler setzen
       
.,FB2F A5 B6 LDA $B6 RD52 LDA PRP ;A SECOND PASS ERROR?...
Fehlerflag testen
       
.,FB31 F0 07 BEQ $FB3A BEQ RD59 ;...NO
;SECOND PASS ERR
verzweige wenn kein Fehler
       
.,FB33 A9 10 LDA #$10 RD55 LDA #SPERR
'SECOND PASS' error
       
.,FB35 20 1C FE JSR $FE1C JSR UDST
Status setzen
OR into serial status byte
     
.,FB38 D0 09 BNE $FB43 BNE RD90 ;JMP
und nächstes Byte verarbeiten
       
.,FB3A A5 93 LDA $93 RD59 LDA VERCK ;LOAD OR VERIFY?...
Verify-Flag laden
get load/verify flag
     
.,FB3C D0 05 BNE $FB43 BNE RD90 ;...VERIFY, DON'T STORE
verzweige wenn gesetzt
if verify go ??
     
.,FB3E A8 TAY TAY ;MAKE Y ZERO
Zeiger löschen
       
.,FB3F A5 BD LDA $BD LDA OCHAR
gelesenes Byte
get RS232 parity byte
     
.,FB41 91 AC STA ($AC),Y STA (SAL)Y ;STORE CHARACTER
speichern
       
.,FB43 20 DB FC JSR $FCDB RD90 JSR INCSAL ;INCREMENT ADDR.
Adresszeiger erhöhen
increment read/write pointer
     
.,FB46 D0 43 BNE $FB8B BNE RD180 ;BRANCH ALWAYS
Rückkehr vom Interrupt
restore registers and exit interrupt, branch always
     
.,FB48 A9 80 LDA #$80 RD160 LDA #$80 ;SET MODE SKIP NEXT DATA
Flag für Lesen
       
.,FB4A 85 AA STA $AA RD161 STA RDFLG
;
; MODIFY FOR C64 6526'S
;
auf Ende
       
.,FB4C 78 SEI SEI ;PROTECT CLEARING OF T1 INFORMATION
Interrupt verhindern
       
.,FB4D A2 01 LDX #$01 LDX #$01
IRQ vom
disable timer A interrupt
     
.,FB4F 8E 0D DC STX $DC0D STX D1ICR ;CLEAR T1 ENABLE...
Timer A verhindern
save VIA 1 ICR
     
.,FB52 AE 0D DC LDX $DC0D LDX D1ICR ;CLEAR THE INTERRUPT
IRQ-Flag löschen
read VIA 1 ICR
     
.,FB55 A6 BE LDX $BE LDX FSBLK ;DEC FSBLK FOR NEXT PASS...
Pass-Zähler
get copies count
     
.,FB57 CA DEX DEX
erniedrigen
       
.,FB58 30 02 BMI $FB5C BMI RD167 ;WE ARE DONE...FSBLK=0
verzweige wenn Null gewesen
       
.,FB5A 86 BE STX $BE STX FSBLK ;...ELSE FSBLK=NEXT
Passzähler merken
save copies count
     
.,FB5C C6 A7 DEC $A7 RD167 DEC SHCNL ;DEC PASS CALC...
Blockzähler vermindern
decrement receiver input bit temporary storage
     
.,FB5E F0 08 BEQ $FB68 BEQ RD175 ;...ALL DONE
verzweige wenn Null
       
.,FB60 A5 9E LDA $9E LDA PTR1 ;CHECK FOR FIRST PASS ERRORS...
Fehler in Pass 1 aufgetre-
ten ?
       
.,FB62 D0 27 BNE $FB8B BNE RD180 ;...YES SO CONTINUE
ja, Rückkehr vom Interrupt
if ?? restore registers and exit interrupt
     
.,FB64 85 BE STA $BE STA FSBLK ;CLEAR FSBLK IF NO ERRORS...
kein Block mehr zu verarbei-
ten
save copies count
     
.,FB66 F0 23 BEQ $FB8B BEQ RD180 ;JMP TO EXIT
Rückkehr vom Interrupt
restore registers and exit interrupt, branch always
     
.,FB68 20 93 FC JSR $FC93 RD175 JSR TNIF ;READ IT ALL...EXIT
ein Pass beendet
restore everything for STOP
     
.,FB6B 20 8E FB JSR $FB8E JSR RD300 ;RESTORE SAL & SAH
Adresse wieder auf Programm-
anfang
copy I/O start address to buffer address
     
.,FB6E A0 00 LDY #$00 LDY #0 ;SET SHCNH TO ZERO...
Zähler auf Null setzen
clear index
     
.,FB70 84 AB STY $AB STY SHCNH ;...USED TO CALC PARITY BYTE
;
;COMPUTE PARITY OVER LOAD
;
Checksumme löschen
clear checksum
     
.,FB72 B1 AC LDA ($AC),Y VPRTY LDA (SAL)Y ;CALC BLOCK BCC
Programm
get byte from buffer
     
.,FB74 45 AB EOR $AB EOR SHCNH
Checksumme berechnen
XOR with checksum
     
.,FB76 85 AB STA $AB STA SHCNH
und speichern
save new checksum
     
.,FB78 20 DB FC JSR $FCDB JSR INCSAL ;INCREMENT ADDRESS
Adresszeiger erhöhen
increment read/write pointer
     
.,FB7B 20 D1 FC JSR $FCD1 JSR CMPSTE ;TEST AGAINST END
Endadresse schon erreicht ?
check read/write pointer, return Cb = 1 if pointer >= end
     
.,FB7E 90 F2 BCC $FB72 BCC VPRTY ;NOT DONE YET...
nein, weiter vergleichen
loop if not at end
     
.,FB80 A5 AB LDA $AB LDA SHCNH ;CHECK FOR BCC CHAR MATCH...
berechnete Checksumme
get computed checksum
     
.,FB82 45 BD EOR $BD EOR OCHAR
mit Checksumme vom Band
vergleichen
compare with stored checksum ??
     
.,FB84 F0 05 BEQ $FB8B BEQ RD180 ;...YES, EXIT
;CHKSUM ERROR
Checksumme gleich , dann ok
if checksum ok restore registers and exit interrupt
     
.,FB86 A9 20 LDA #$20 LDA #CKERR
'CHECKSUM' error
else set checksum error
     
.,FB88 20 1C FE JSR $FE1C JSR UDST
Status setzen
OR into the serial status byte
     
.,FB8B 4C BC FE JMP $FEBC RD180 JMP PREND
Rückkehr vom Interrupt

laufenden Zeiger auf

Programmstart

restore registers and exit interrupt

copy I/O start address to buffer address

   

move save/load address into $AC/$AD

.,FB8E A5 C2 LDA $C2 RD300 LDA STAH ; RESTORE STARTING ADDRESS...
Startadresse
get I/O start address high byte
     
.,FB90 85 AD STA $AD STA SAH ;...POINTERS (SAH & SAL)
$C1/$C2
set buffer address high byte
     
.,FB92 A5 C1 LDA $C1 LDA STAL
nach $AC/$AD
get I/O start address low byte
     
.,FB94 85 AC STA $AC STA SAL
speichern
set buffer address low byte
     
.,FB96 60 RTS RTS
Rücksprung

Bitzähler für serielle

Ausgabe setzen

new tape byte setup

   

initalise cassette read/write variables

.,FB97 A9 08 LDA #$08 NEWCH LDA #8 ;SET UP FOR 8 BITS+PARITY
Zähler für 8 Bits
eight bits to do
     
.,FB99 85 A3 STA $A3 STA PCNTR
Nach $A3
set bit count
     
.,FB9B A9 00 LDA #$00 LDA #0 ;INITILIZE...
Akku mit $00 laden
clear A
     
.,FB9D 85 A4 STA $A4 STA FIRT ;..DIPOLE COUNTER
Bit-Impuls-Flag löschen
clear tape bit cycle phase
     
.,FB9F 85 A8 STA $A8 STA RER ;..ERROR FLAG
Lesefehler Byte löschen
clear start bit first cycle done flag
     
.,FBA1 85 9B STA $9B STA PRTY ;..PARITY BIT
Parity-Bit löschen
clear byte parity
     
.,FBA3 85 A9 STA $A9 STA REZ ;..ZERO COUNT
Impulswechsel-Flag löschen
clear start bit check flag, set no start bit yet
     
.,FBA5 60 RTS RTS ;.A=0 ON RETURN
.END

.LIB WRITE

; CASSETTE INFO - FSBLK IS BLOCK COUNTER FOR RECORD
; FSBLK = 2 -FIRST HEADER
; = 1 -FIRST DATA
; = 0 -SECOND DATA
;
; WRITE - TOGGLE WRITE BIT ACCORDING TO LSB IN OCHAR
;
Rücksprung

Ein Bit auf Band schreiben

send lsb from tape write byte to tape

this routine tests the least significant bit in the tape write byte and sets VIA 2 T2
depending on the state of the bit. if the bit is a 1 a time of $00B0 cycles is set, if
the bot is a 0 a time of $0060 cycles is set. note that this routine does not shift the
bits of the tape write byte but uses a copy of that byte, the byte itself is shifted
elsewhere
   

schedule CIA1 timer B and

invert casette write line
.,FBA6 A5 BD LDA $BD WRITE LDA OCHAR ;SHIFT BIT TO WRITE INTO CARRY
Bit in $BD
get tape write byte
     
.,FBA8 4A LSR LSR A
Bit 0 in Carry
shift lsb into Cb
     
.,FBA9 A9 60 LDA #$60 LDA #96 ;...C CLR WRITE SHORT
Zeit für '0' Bit
set time constant low byte for bit = 0
     
.,FBAB 90 02 BCC $FBAF BCC WRT1
verzweige falls Carry=0
branch if bit was 0
set time constant for bit = 1 and toggle tape
     
.,FBAD A9 B0 LDA #$B0 WRTW LDA #176 ;...C SET WRITE LONG
Zeit für '1' Bit
set time constant low byte for bit = 1
write time constant and toggle tape
     
.,FBAF A2 00 LDX #$00 WRT1 LDX #0 ;SET AND STORE TIME
HIGH-Byte Timerwert laden
set time constant high byte
write time constant and toggle tape
     
.,FBB1 8D 06 DC STA $DC06 WRTX STA D1T2L
Timer B LOW
save VIA 1 timer B low byte
     
.,FBB4 8E 07 DC STX $DC07 STX D1T2H
Timer B HIGH
save VIA 1 timer B high byte
     
.,FBB7 AD 0D DC LDA $DC0D LDA D1ICR ;CLEAR IRQ
Interrupt-Flag löschen
read VIA 1 ICR
     
.,FBBA A9 19 LDA #$19 LDA #$19 ;ENABLE TIMER (ONE-SHOT)
Timer
load timer B, timer B single shot, start timer B
     
.,FBBC 8D 0F DC STA $DC0F STA D1CRB
B starten
save VIA 1 CRB
     
.,FBBF A5 01 LDA $01 LDA R6510 ;TOGGLE WRITE BIT
Tape-Write-Bit laden
read the 6510 I/O port
     
.,FBC1 49 08 EOR #$08 EOR #$08
Ausgabe-Bit für Band
invertieren
toggle tape out bit
     
.,FBC3 85 01 STA $01 STA R6510
und speichern
save the 6510 I/O port
     
.,FBC5 29 08 AND #$08 AND #$08 ;LEAVE ONLY WRITE BIT
augenblicklichen Pegel merken
mask tape out bit
     
.,FBC7 60 RTS RTS
;
 

flag block done and exit interrupt

   

IRQ routine for cassette write B

.,FBC8 38 SEC WRTL3 SEC ;FLAG PRP FOR END OF BLOCK
Block-Write-Flag
set carry flag
     
.,FBC9 66 B6 ROR $B6 ROR PRP
Negativ
set buffer address high byte negative, flag all sync,
data and checksum bytes written
     
.,FBCB 30 3C BMI $FC09 BMI WRT3 ; JMP
;
; WRTN - CALLED AT THE END OF EACH BYTE
; TO WRITE A LONG RER REZ
; HHHHHHLLLLLLHHHLLL...
;
Rückkehr vom Interrupt

Interrupt-Routine für Band

schreiben

restore registers and exit interrupt, branch always

tape write IRQ routine

this is the routine that writes the bits to the tape. it is called each time VIA 2 T2
times out and checks if the start bit is done, if so checks if the data bits are done,
if so it checks if the byte is done, if so it checks if the synchronisation bytes are
done, if so it checks if the data bytes are done, if so it checks if the checksum byte
is done, if so it checks if both the load and verify copies have been done, if so it
stops the tape
     
.,FBCD A5 A8 LDA $A8 WRTN LDA RER ;CHECK FOR ONE LONG
falls 'Byte'-Impuls ge-
get start bit first cycle done flag
     
.,FBCF D0 12 BNE $FBE3 BNE WRTN1
schrieben, dann verzweige
if first cycle done go do rest of byte
each byte sent starts with two half cycles of $0110 ststem clocks and the whole block
ends with two more such half cycles
     
.,FBD1 A9 10 LDA #$10 LDA #16 ;WRITE A LONG BIT
Timer auf
set first start cycle time constant low byte
     
.,FBD3 A2 01 LDX #$01 LDX #1
$110 (272)
set first start cycle time constant high byte
     
.,FBD5 20 B1 FB JSR $FBB1 JSR WRTX
Takt auf Band schreiben
write time constant and toggle tape
     
.,FBD8 D0 2F BNE $FC09 BNE WRT3
Rückkehr vom Interrupt
if first half cycle go restore registers and exit
interrupt
     
.,FBDA E6 A8 INC $A8 INC RER
'1' Byte-Write-Flag setzen
set start bit first start cycle done flag
     
.,FBDC A5 B6 LDA $B6 LDA PRP ;IF END OF BLOCK(BIT SET BY WRTL3)...
falls Block-Write-Flag
positiv, dann
get buffer address high byte
     
.,FBDE 10 29 BPL $FC09 BPL WRT3 ;...NO END CONTINUE
Rückkehr vom Interrupt
if block not complete go restore registers and exit
interrupt. the end of a block is indicated by the tape
buffer high byte b7 being set to 1
     
.,FBE0 4C 57 FC JMP $FC57 JMP WRNC ;...END ...FINISH OFF
;
zweiten Block schreiben
else do tape routine, block complete exit
continue tape byte write. the first start cycle, both half cycles of it, is complete
so the routine drops straight through to here
     
.,FBE3 A5 A9 LDA $A9 WRTN1 LDA REZ ;CHECK FOR A ONE BIT
falls '1' Bit gesezt
get start bit check flag
     
.,FBE5 D0 09 BNE $FBF0 BNE WRTN2
dann verzweige
if the start bit is complete go send the byte bits
after the two half cycles of $0110 ststem clocks the start bit is completed with two
half cycles of $00B0 system clocks. this is the same as the first part of a 1 bit
     
.,FBE7 20 AD FB JSR $FBAD JSR WRTW
'1' Bit schreiben
set time constant for bit = 1 and toggle tape
     
.,FBEA D0 1D BNE $FC09 BNE WRT3
Rückkehr vom Interrupt
if first half cycle go restore registers and exit
interrupt
     
.,FBEC E6 A9 INC $A9 INC REZ
'1' Bit-Flag setzen
set start bit check flag
     
.,FBEE D0 19 BNE $FC09 BNE WRT3
;
Rückkehr vom Interrupt
restore registers and exit interrupt, branch always
continue tape byte write. the start bit, both cycles of it, is complete so the routine
drops straight through to here. now the cycle pairs for each bit, and the parity bit,
are sent
     
.,FBF0 20 A6 FB JSR $FBA6 WRTN2 JSR WRITE
Bit auf Band schreiben
send lsb from tape write byte to tape
     
.,FBF3 D0 14 BNE $FC09 BNE WRT3 ;ON BIT LOW EXIT
Rückkehr vom Interrupt
if first half cycle go restore registers and exit
interrupt
else two half cycles have been done
     
.,FBF5 A5 A4 LDA $A4 LDA FIRT ;CHECK FOR FIRST OF DIPOLE
Bit-Impulsflag laden
get tape bit cycle phase
     
.,FBF7 49 01 EOR #$01 EOR #1
Bit 0 invertieren
toggle b0
     
.,FBF9 85 A4 STA $A4 STA FIRT
und speichern
save tape bit cycle phase
     
.,FBFB F0 0F BEQ $FC0C BEQ WRT2 ;DIPOLE DONE
falls null, dann verzweige
if bit cycle phase complete go setup for next bit
each bit is written as two full cycles. a 1 is sent as a full cycle of $0160 system
clocks then a full cycle of $00C0 system clocks. a 0 is sent as a full cycle of $00C0
system clocks then a full cycle of $0160 system clocks. to do this each bit from the
write byte is inverted during the second bit cycle phase. as the bit is inverted it
is also added to the, one bit, parity count for this byte
     
.,FBFD A5 BD LDA $BD LDA OCHAR ;FLIPS BIT FOR COMPLEMENTARY RIGHT
Bit-SHIFT-Register laden
get tape write byte
     
.,FBFF 49 01 EOR #$01 EOR #1
Bit für Ausgabe invertieren
invert bit being sent
     
.,FC01 85 BD STA $BD STA OCHAR
und speichern
save tape write byte
     
.,FC03 29 01 AND #$01 AND #1 ;TOGGLE PARITY
Bit holen und mit
mask b0
     
.,FC05 45 9B EOR $9B EOR PRTY
Parity-Bit verknüpfen
EOR with tape write byte parity bit
     
.,FC07 85 9B STA $9B STA PRTY
und speichern
save tape write byte parity bit
     
.,FC09 4C BC FE JMP $FEBC WRT3 JMP PREND ;RESTORE REGS AND RTI EXIT
;
Rückkehr vom Interrupt
restore registers and exit interrupt
the bit cycle phase is complete so shift out the just written bit and test for byte
end
     
.,FC0C 46 BD LSR $BD WRT2 LSR OCHAR ;MOVE TO NEXT BIT
nächstes Bit in Position 0
shift bit out of tape write byte
     
.,FC0E C6 A3 DEC $A3 DEC PCNTR ;DEC COUNTER FOR # OF BITS
Bitzähler erniedrigen
decrement tape write bit count
     
.,FC10 A5 A3 LDA $A3 LDA PCNTR ;CHECK FOR 8 BITS SENT...
und laden
get tape write bit count
     
.,FC12 F0 3A BEQ $FC4E BEQ WRT4 ;...IF YES MOVE IN PARITY
nächstes Bit ausgeben
if all the data bits have been written go setup for
sending the parity bit next and exit the interrupt
     
.,FC14 10 F3 BPL $FC09 BPL WRT3 ;...ELSE SEND REST
;
Rückkehr vom Interrupt
if all the data bits are not yet sent just restore the
registers and exit the interrupt
do next tape byte
the byte is complete. the start bit, data bits and parity bit have been written to
the tape so setup for the next byte
     
.,FC16 20 97 FB JSR $FB97 WRTS JSR NEWCH ;CLEAN UP COUNTERS
Bitzähler wieder auf 8 setzen
new tape byte setup
     
.,FC19 58 CLI CLI ;ALLOW FOR INTERRUPTS TO NEST
Interrupt freigeben
enable the interrupts
     
.,FC1A A5 A5 LDA $A5 LDA CNTDN ;ARE WE WRITING HEADER COUNTERS?...
Falls Synchronbytes geschrie-
ben
get cassette synchronization character count
     
.,FC1C F0 12 BEQ $FC30 BEQ WRT6 ;...NO
; WRITE HEADER COUNTERS (9876543210 TO HELP WITH READ)
dann verzweige
if synchronisation characters done go do block data
at the start of each block sent to tape there are a number of synchronisation bytes
that count down to the actual data. the commodore tape system saves two copies of all
the tape data, the first is loaded and is indicated by the synchronisation bytes
having b7 set, and the second copy is indicated by the synchronisation bytes having b7
clear. the sequence goes $09, $08, ..... $02, $01, data bytes
     
.,FC1E A2 00 LDX #$00 LDX #0 ;CLEAR BCC
Prüfsumme
clear X
     
.,FC20 86 D7 STX $D7 STX DATA
löschen
clear checksum byte
     
.,FC22 C6 A5 DEC $A5 WRTS1 DEC CNTDN
Zähler vermindern
decrement cassette synchronization byte count
     
.,FC24 A6 BE LDX $BE LDX FSBLK ;CHECK FOR FIRST BLOCK HEADER
noch zu schreibende
Blockanzahl laden
get cassette copies count
     
.,FC26 E0 02 CPX #$02 CPX #2
falls erster Block nicht
compare with load block indicator
     
.,FC28 D0 02 BNE $FC2C BNE WRT61 ;...NO
geschrieben, dann verzweige
branch if not the load block
     
.,FC2A 09 80 ORA #$80 ORA #$80 ;...YES MARK FIRST BLOCK HEADER
Bit 7 setzen
this is the load block so make the synchronisation count
go $89, $88, ..... $82, $81
     
.,FC2C 85 BD STA $BD WRT61 STA OCHAR ;WRITE CHARACTERS IN HEADER
und speichern
save the synchronisation byte as the tape write byte
     
.,FC2E D0 D9 BNE $FC09 BNE WRT3
;
Rückkehr vom Interrupt
restore registers and exit interrupt, branch always
the synchronization bytes have been done so now check and do the actual block data
     
.,FC30 20 D1 FC JSR $FCD1 WRT6 JSR CMPSTE ;COMPARE START:END
Endadresse schon erreicht ?
check read/write pointer, return Cb = 1 if pointer >= end
     
.,FC33 90 0A BCC $FC3F BCC WRT7 ;NOT DONE
falls kleiner, dann
weiterschreiben
if not all done yet go get the byte to send
     
.,FC35 D0 91 BNE $FBC8 BNE WRTL3 ;GO MARK END
falls ungleich, dann
Block-Write-Flag setzen
if pointer > end go flag block done and exit interrupt
else the block is complete, it only remains to write the
checksum byte to the tape so setup for that
     
.,FC37 E6 AD INC $AD INC SAH
HIGH-Byte ungleich machen
increment buffer pointer high byte, this means the block
done branch will always be taken next time without having
to worry about the low byte wrapping to zero
     
.,FC39 A5 D7 LDA $D7 LDA DATA ;WRITE OUT BCC
Prüfsumme laden
get checksum byte
     
.,FC3B 85 BD STA $BD STA OCHAR
und in SHIFT-Flag speichern
save checksum as tape write byte
     
.,FC3D B0 CA BCS $FC09 BCS WRT3 ;JMP
;
Rückkehr vom Interrupt
restore registers and exit interrupt, branch always
the block isn't finished so get the next byte to write to tape
     
.,FC3F A0 00 LDY #$00 WRT7 LDY #0 ;GET NEXT CHARACTER
Zähler auf Null
clear index
     
.,FC41 B1 AC LDA ($AC),Y LDA (SAL)Y
zu schreibendes Byte laden
get byte from buffer
     
.,FC43 85 BD STA $BD STA OCHAR ;STORE IN OUTPUT CHARACTER
in SHIFT-Flag bringen
save as tape write byte
     
.,FC45 45 D7 EOR $D7 EOR DATA ;UPDATE BCC
Prüfsumme
XOR with checksum byte
     
.,FC47 85 D7 STA $D7 STA DATA
bilden
save new checksum byte
     
.,FC49 20 DB FC JSR $FCDB JSR INCSAL ;INCREMENT FETCH ADDRESS
Adresszeiger erhöhen
increment read/write pointer
     
.,FC4C D0 BB BNE $FC09 BNE WRT3 ;BRANCH ALWAYS
;
Rückkehr vom Interrupt
restore registers and exit interrupt, branch always
set parity as next bit and exit interrupt
     
.,FC4E A5 9B LDA $9B WRT4 LDA PRTY ;MOVE PARITY INTO OCHAR...
Parity-Bit
get parity bit
     
.,FC50 49 01 EOR #$01 EOR #1
invertieren
toggle it
     
.,FC52 85 BD STA $BD STA OCHAR ;...TO BE WRITTEN AS NEXT BIT
und ins SHIFT-Flag speichern
save as tape write byte
     
.,FC54 4C BC FE JMP $FEBC WRTBK JMP PREND ;RESTORE REGS AND RTI EXIT
;
Rückkehr vom Interrupt
restore registers and exit interrupt
tape routine, block complete exit
     
.,FC57 C6 BE DEC $BE WRNC DEC FSBLK ;CHECK FOR END
Zähler für Blocks erniedrigen
decrement copies remaining to read/write
     
.,FC59 D0 03 BNE $FC5E BNE WREND ;...BLOCK ONLY
falls noch ein Block,
branch if more to do
     
.,FC5B 20 CA FC JSR $FCCA JSR TNOF ;...WRITE, SO TURN OFF MOTOR
dann Bandmotor aus
stop the cassette motor
     
.,FC5E A9 50 LDA #$50 WREND LDA #80 ;PUT 80 CASSETTE SYNCS AT END
80
set tape write leader count
     
.,FC60 85 A7 STA $A7 STA SHCNL
Zähler für Impulse
save tape write leader count
     
.,FC62 A2 08 LDX #$08 LDX #8
Offset für IRQ
set index for write tape leader vector
     
.,FC64 78 SEI SEI
Interrupt verhindern
disable the interrupts
     
.,FC65 20 BD FC JSR $FCBD JSR BSIV ;SET VECTOR TO WRITE ZEROS
IRQ auf $FC6A
set the tape vector
     
.,FC68 D0 EA BNE $FC54 BNE WRTBK ;JMP
;
Rückkehr vom Interrupt

Interrupt-Routine für Band

schreiben

restore registers and exit interrupt, branch always

write tape leader IRQ routine

   

IRQ routine for cassette write A

.,FC6A A9 78 LDA #$78 WRTZ LDA #120 ;WRITE LEADING ZEROS FOR SYNC
120
set time constant low byte for bit = leader
     
.,FC6C 20 AF FB JSR $FBAF JSR WRT1
Bit auf Band schreiben
write time constant and toggle tape
     
.,FC6F D0 E3 BNE $FC54 BNE WRTBK
Rückkehr vom Interrupt
if tape bit high restore registers and exit interrupt
     
.,FC71 C6 A7 DEC $A7 DEC SHCNL ;CHECK IF DONE WITH LOW SYNC...
Zähler erniedrigen
decrement cycle count
     
.,FC73 D0 DF BNE $FC54 BNE WRTBK ;...NO
nicht null, dann Rückkehr
vom Interrupt
if not all done restore registers and exit interrupt
     
.,FC75 20 97 FB JSR $FB97 JSR NEWCH ;...YES CLEAR UP COUNTERS
Bitzähler für serielle
Ausgabe setzen
new tape byte setup
     
.,FC78 C6 AB DEC $AB DEC SHCNH ;CHECK IF DONE WITH SYNC...
falls Datenende nicht er-
reicht, dann
decrement cassette leader count
     
.,FC7A 10 D8 BPL $FC54 BPL WRTBK ;...NO
Rückkehr vom Interrupt
if not all done restore registers and exit interrupt
     
.,FC7C A2 0A LDX #$0A LDX #10 ;...YES SO SET VECTOR FOR DATA
IRQ
set index for tape write vector
     
.,FC7E 20 BD FC JSR $FCBD JSR BSIV
IRQ auf $FBCD
set the tape vector
     
.,FC81 58 CLI CLI
Interrupt ermöglichen
enable the interrupts
     
.,FC82 E6 AB INC $AB INC SHCNH ;ZERO SHCNH
Shortdauer
clear cassette leader counter, was $FF
     
.,FC84 A5 BE LDA $BE LDA FSBLK ;IF DONE THEN...
Zähler für Anzahl der Blocks
get cassette block count
     
.,FC86 F0 30 BEQ $FCB8 BEQ STKY ;...GOTO SYSTEM RESTORE
alle Blocks geschrieben ?
if all done restore everything for STOP and exit the
interrupt
     
.,FC88 20 8E FB JSR $FB8E JSR RD300
Adresse wieder auf Anfang
setzen
copy I/O start address to buffer address
     
.,FC8B A2 09 LDX #$09 LDX #9 ;SET UP FOR HEADER COUNT
Zähler für
set nine synchronisation bytes
     
.,FC8D 86 A5 STX $A5 STX CNTDN
Synchronisation
save cassette synchronization byte count
     
.,FC8F 86 B6 STX $B6 STX PRP ;CLEAR ENDOF BLOCK FLAG
Flag für Block geschrieben
       
.,FC91 D0 83 BNE $FC16 BNE WRTS ;JMP
;
unbedingter Sprung

Rekorderbetrieb beenden

go do the next tape byte, branch always

restore everything for STOP

   

switch from cassette IRQ to default IRQ

.,FC93 08 PHP TNIF PHP ;CLEAN UP INTERRUPTS AND RESTORE PIA'S
Status merken
save status
     
.,FC94 78 SEI SEI
Interrupt verhindern
disable the interrupts
     
.,FC95 AD 11 D0 LDA $D011 LDA VICREG+17 ;UNLOCK VIC
Bildschirm
read the vertical fine scroll and control register
     
.,FC98 09 10 ORA #$10 ORA #$10 ;ENABLE DISPLAY
wieder
mask xxx1 xxxx, unblank the screen
     
.,FC9A 8D 11 D0 STA $D011 STA VICREG+17
einschalten
save the vertical fine scroll and control register
     
.,FC9D 20 CA FC JSR $FCCA JSR TNOF ;TURN OFF MOTOR
Rekordermotor ausschalten
stop the cassette motor
     
.,FCA0 A9 7F LDA #$7F LDA #$7F ;CLEAR INTERRUPTS
Interruptmöglichkeiten
disable all interrupts
     
.,FCA2 8D 0D DC STA $DC0D STA D1ICR
löschen
save VIA 1 ICR
     
.,FCA5 20 DD FD JSR $FDDD JSR IOKEYS ;RESTORE KEYBOARD IRQ FROM TIMMER1
CIA wieder auf Standardwerte,
1/60 s Timing
       
.,FCA8 AD A0 02 LDA $02A0 LDA IRQTMP+1 ;RESTORE KEYBOARD INTERRUPT VECTOR
Interruptvektor schon auf
Standardwert ?
get saved IRQ vector high byte
     
.,FCAB F0 09 BEQ $FCB6 BEQ TNIQ ;NO IRQ (IRQ VECTOR CANNOT BE Z-PAGE)
falls ja, dann fertig
branch if null
     
.,FCAD 8D 15 03 STA $0315 STA CINV+1
ansonsten zurücksetzen
restore IRQ vector high byte
     
.,FCB0 AD 9F 02 LDA $029F LDA IRQTMP
geretteten lRQ zurückholen
get saved IRQ vector low byte
     
.,FCB3 8D 14 03 STA $0314 STA CINV
und speichern
restore IRQ vector low byte
     
.,FCB6 28 PLP TNIQ PLP
Status zurückholen
restore status
     
.,FCB7 60 RTS RTS
;
Rücksprung

IRQ-Vektor setzen,

X-indiziert

reset vector

   

terminate cassette I/O

.,FCB8 20 93 FC JSR $FC93 STKY JSR TNIF ;GO RESTORE SYSTEM INTERRUPTS
IRQ auf Standard
restore everything for STOP
     
.,FCBB F0 97 BEQ $FC54 BEQ WRTBK ;CAME FOR CASSETTE IRQ SO RTI
;
; BSIV - SUBROUTINE TO CHANGE IRQ VECTORS
; ENTRYS - .X = 8 WRITE ZEROS TO TAPE
; .X = 10 WRITE DATA TO TAPE
; .X = 12 RESTORE TO KEYSCAN
; .X = 14 READ DATA FROM TAPE
;
Abschluß IRQ
restore registers and exit interrupt, branch always

set tape vector

   

set IRQ vector depending on X

.,FCBD BD 93 FD LDA $FD93,X BSIV LDA BSIT-8,X ;MOVE IRQ VECTORS, TABLE TO INDIRECT
IRQ-Vektor
get tape IRQ vector low byte
     
.,FCC0 8D 14 03 STA $0314 STA CINV
aus Tabelle setzen
set IRQ vector low byte
     
.,FCC3 BD 94 FD LDA $FD94,X LDA BSIT+1-8,X
lRQ-Vektor
get tape IRQ vector high byte
     
.,FCC6 8D 15 03 STA $0315 STA CINV+1
aus Tabelle setzen
set IRQ vector high byte
     
.,FCC9 60 RTS RTS
;
Rücksprung

stop the cassette motor

   

stop cassette motor

.,FCCA A5 01 LDA $01 TNOF LDA R6510 ;TURN OFF CASSETTE MOTOR
Rekorder-
read the 6510 I/O port
     
.,FCCC 09 20 ORA #$20 ORA #$20 ;
motor
mask xxxx xx1x, turn the cassette motor off
     
.,FCCE 85 01 STA $01 STA R6510
ausschalten
save the 6510 I/O port
     
.,FCD0 60 RTS RTS
;COMPARE START AND END LOAD/SAVE
;ADDRESSES. SUBROUTINE CALLED BY
;TAPE READ, SAVE, TAPE WRITE
;
Rücksprung

prüft auf Erreichen der

Endadresse

check read/write pointer

return Cb = 1 if pointer >= end
   

compare $AC/$AD with $AE/$AF

.,FCD1 38 SEC CMPSTE SEC
Carry für Subtraktion
vorbereiten
set carry for subtract
     
.,FCD2 A5 AC LDA $AC LDA SAL
laufende Adresse
get buffer address low byte
     
.,FCD4 E5 AE SBC $AE SBC EAL
$AC/$AD
subtract buffer end low byte
     
.,FCD6 A5 AD LDA $AD LDA SAH
Endadresse
get buffer address high byte
     
.,FCD8 E5 AF SBC $AF SBC EAH
$AE/$AF
subtract buffer end high byte
     
.,FCDA 60 RTS RTS
;INCREMENT ADDRESS POINTER SAL
;
Rücksprung

increment read/write pointer

   

increment $AC/$AD

.,FCDB E6 AC INC $AC INCSAL INC SAL
Adreßzeiger
increment buffer address low byte
     
.,FCDD D0 02 BNE $FCE1 BNE INCR
er-
branch if no overflow
     
.,FCDF E6 AD INC $AD INC SAH
höhen
increment buffer address low byte
     
.,FCE1 60 RTS INCR RTS
.END

.LIB INIT

; START - SYSTEM RESET
; WILL GOTO ROM AT $8000...
; IF LOCS $8004-$8008
; = 'CBM80'
; ^^^ > THESE HAVE MSB SET
; KERNAL EXPECTS...
; $8000- .WORD INITILIZE (HARD START)
; $8002- .WORD PANIC (WARM START)
; ... ELSE BASIC SYSTEM USED
; ******************TESTING ONLY***************
; USE AUTO DISK/CASSETTE LOAD WHEN DEVELOPED...
;
Rücksprung

RESET

RESET, hardware reset starts here

 

POWER RESET ENTRY POINT

The system hardware reset vector ($FFFC) points here. This
is the first routine executed when the computer is
switched on. The routine firstly sets the stackpointer to
#ff, disables interrupts and clears the decimal flag. It
jumps to a routine at $fd02 which checks for autostart-
cartridges. If so, an indirectjump is performed to the
cartridge coldstart vector at $8000. I/O chips are
initiated, and system constants are set up. Finaly the IRQ
is enabled, and an indirect jump is performed to $a000,
the basic cold start vector.

RESET routine

.,FCE2 A2 FF LDX #$FF START LDX #$FF
Wert für Stapelzeiger
set X for stack
     
.,FCE4 78 SEI SEI
Interrupt setzen
disable the interrupts
     
.,FCE5 9A TXS TXS
Stapelzeiger initialisieren
clear stack
  Set stackpointer to #ff
 
.,FCE6 D8 CLD CLD
Dezimalflag zurücksetzen
clear decimal mode
     
.,FCE7 20 02 FD JSR $FD02 JSR A0INT ;TEST FOR $A0 ROM IN
prüft auf ROM in $8000
scan for autostart ROM at $8000
  Check ROM at $8000
 
.,FCEA D0 03 BNE $FCEF BNE START1
kein Autostart-Modul ?
if not there continue startup
     
.,FCEC 6C 00 80 JMP ($8000) JMP ($8000) ; GO INIT AS $A000 ROM WANTS
Sprung auf Modul-Start
else call ROM start code
  Jump to autostartvector
start cartridge
.,FCEF 8E 16 D0 STX $D016 START1 STX VICREG+22 ;SET UP REFRESH (.X=<5)
Videocontroller Steuerreg. 2
read the horizontal fine scroll and control register
     
.,FCF2 20 A3 FD JSR $FDA3 JSR IOINIT ;GO INITILIZE I/O DEVICES
Interrupt vorbereiten
initialise SID, CIA and IRQ
  Init I/O
 
.,FCF5 20 50 FD JSR $FD50 JSR RAMTAS ;GO RAM TEST AND SET
Arbeitsspeicher initialisieren
RAM test and find RAM end
  Init system constants
 
.,FCF8 20 15 FD JSR $FD15 JSR RESTOR ;GO SET UP OS VECTORS
;
Hardware und I/O Vekt. setzen
restore default I/O vectors
  KERNAL reset
 
.,FCFB 20 5B FF JSR $FF5B JSR CINT ;GO INITILIZE SCREEN
Video-Reset
initialise VIC and screen editor
  Setup PAL/NTSC
 
.,FCFE 58 CLI CLI ;INTERRUPTS OKAY NOW
  enable the interrupts
     
.,FCFF 6C 00 A0 JMP ($A000) JMP ($A000) ;GO TO BASIC SYSTEM
; A0INT - TEST FOR AN $8000 ROM
; RETURNS Z - $8000 IN
;
zum BASIC Kaltstart

prüft auf ROM in $8000

execute BASIC

scan for autostart ROM at $8000, returns Zb=1 if ROM found

  Basic coldstart

CHECK FOR 8-ROM

Checks for the ROM autostartparametrar at $8004-$8008. It
compares data with $fd10, and if equal, set Z=1.
start basic

check for a cartridge

.,FD02 A2 05 LDX #$05 A0INT LDX #TBLA0E-TBLA0R ;CHECK FOR $8000
Zeiger setzen
five characters to test
  5 bytes to check
 
.,FD04 BD 0F FD LDA $FD0F,X A0IN1 LDA TBLA0R-1,X
Wert aus Tabelle holen und
get test character
  Identifyer at $fd10
 
.,FD07 DD 03 80 CMP $8003,X CMP $8004-1,X
ab $8000 vergleichen (CBM80)
compare wiith byte in ROM space
  Compare with $8004
 
.,FD0A D0 03 BNE $FD0F BNE A0IN2
verzweige wenn ungleich
exit if no match
  NOT equal!
 
.,FD0C CA DEX DEX
Zeiger vermindern
decrement index
     
.,FD0D D0 F5 BNE $FD04 BNE A0IN1
weiter wenn nicht 5 Bytes
loop if not all done
  until Z=1
 
.,FD0F 60 RTS A0IN2 RTS
;
Rücksprung

ROM-Modul Identifizierung

autostart ROM signature

 

8-ROM IDENTIFYER

The following 5 bytes contains the 8-ROM identifyer,
reading "CBM80" with CBM ASCII. It is used with
autostartcartridges. See $fd02.

CBM80

.:FD10 C3 C2 CD 38 30 TBLA0R .BYT $C3,$C2,$CD,'80' ;..CBM80..
TBLA0E
; RESTOR - SET KERNAL INDIRECTS AND VECTORS (SYSTEM)
;
'CBM80’

Hardware und I/O Vektoren

setzen/holen

'CBM80’

restore default I/O vectors

  CBM80

RESTOR: KERNAL RESET

The KERNAL routine RESTOR ($ff8a) jumps to this routine.
It restores (copys) the KERNAL vectors at $fd30 to $0314-
$0333. Continues through VECTOR.

restore I/O vectors

.,FD15 A2 30 LDX #$30 RESTOR LDX #<VECTSS
LOW- und HIGH-Byte des
pointer to vector table low byte
  $fd30 - table of KERNAL vectors
low FD30
.,FD17 A0 FD LDY #$FD LDY #>VECTSS
Zeigers auf Tabelle $FD30
pointer to vector table high byte
  Clear carry to SET values.
high FD30
.,FD19 18 CLC CLC
;
; VECTOR - SET KERNAL INDIRECT AND VECTORS (USER)
;
Flag für 'Vektoren setzen'
flag set vectors

set/read vectored I/O from (XY), Cb = 1 to read, Cb = 0 to set

 

VECTOR: KERNAL MOVE

The KERNAL routine VECTOR ($ff8d) jumps to this routine.
It reads or sets the vactors at $0314-$0333 depending on
state of carry. X/Y contains the adress to read/write
area, normally $fd30. See $fd15.
A problem is that the RAM under the ROM at $fd30 always
gets a copy of the contents in the ROM then you perform
the copy.

set I/O vectors depending on XY

.,FD1A 86 C3 STX $C3 VECTOR STX TMP2
LOW- und HIGH-Byte
save pointer low byte
  MEMUSS - c3/c4 temporary used for adress
 
.,FD1C 84 C4 STY $C4 STY TMP2+1
des Zeigers setzen
save pointer high byte
     
.,FD1E A0 1F LDY #$1F LDY #VECTSE-VECTSS-1
Zeiger setzen (16 Vektoren)
set byte count
  Number of bytes to transfer
 
.,FD20 B9 14 03 LDA $0314,Y MOVOS1 LDA CINV,Y ;GET FROM STORAGE
Wert aus Tabelle holen
read vector byte from vectors
     
.,FD23 B0 02 BCS $FD27 BCS MOVOS2 ;C...WANT STORAGE TO USER
C=1 holen,C=0 setzen
branch if read vectors
  Read or Write the vectors
 
.,FD25 B1 C3 LDA ($C3),Y LDA (TMP2)Y ;...WANT USER TO STORAGE
Tabellenwert holen
read vector byte from (XY)
     
.,FD27 91 C3 STA ($C3),Y MOVOS2 STA (TMP2)Y ;PUT IN USER
Tabellenwert setzen
save byte to (XY)
     
.,FD29 99 14 03 STA $0314,Y STA CINV,Y ;PUT IN STORAGE
Wert in Tabelle ablegen
save byte to vector
     
.,FD2C 88 DEY DEY
Zähler vermindern
decrement index
     
.,FD2D 10 F1 BPL $FD20 BPL MOVOS1
Fertig? nein: nächster Wert
loop if more to do
  Again...
 
.,FD2F 60 RTS RTS
;
VECTSS .WOR KEY,TIMB,NNMI
.WOR NOPEN,NCLOSE,NCHKIN
.WOR NCKOUT,NCLRCH,NBASIN
.WOR NBSOUT,NSTOP,NGETIN
.WOR NCLALL,TIMB ;GOTO BREAK ON A USRCMD JMP
Rücksprung

Tabelle der Hardware

und I/O-Vektoren

The above code works but it tries to write to the ROM. while this is usually harmless
systems that use flash ROM may suffer. Here is a version that makes the extra write
to RAM instead but is otherwise identical in function. ##
set/read vectored I/O from (XY), Cb = 1 to read, Cb = 0 to set
STX $C3 ; save pointer low byte
STY $C4 ; save pointer high byte
LDY #$1F ; set byte count
LDA ($C3),Y ; read vector byte from (XY)
BCC $FD29 ; branch if set vectors
LDA $0314,Y ; else read vector byte from vectors
STA ($C3),Y ; save byte to (XY)
STA $0314,Y ; save byte to vector
DEY ; decrement index
BPL $FD20 ; loop if more to do
RTS

kernal vectors

 

KERNAL RESET VECTORS

These are the vectors that is copyed to $0314-$0333 when
RESTOR is called.

vectors for OS at $0314-$0333

.:FD30 31 EA 66 FE 47 FE 4A F3 .WOR NLOAD,NSAVE
VECTSE
; RAMTAS - MEMORY SIZE CHECK AND SET
;
  $0314 IRQ vector
  CINV VECTOR: hardware interrupt ($ea31)
IRQ
.:FD38 91 F2 0E F2 50 F2 33 F3     $0316 BRK vector
$0318 NMI vector
$031A open a logical file
$031C close a specified logical file
  CBINV VECTOR: software interrupt ($fe66)
NMINV VECTOR: hardware nmi interrupt ($fe47)
IOPEN VECTOR: KERNAL open routine ($f3a4)
ICLOSE VECTOR: KERNAL close routine ($f291)
BRK
NMI
open
close
.:FD40 57 F1 CA F1 ED F6 3E F1     $031E open channel for input
$0320 open channel for output
$0322 close input and output channels
$0324 input character from channel
  ICHKIN VECTOR: KERNAL chkin routine ($f20e)
ICKOUT VECTOR: KERNAL chkout routine ($f250)
ICLRCH VECTOR: KERNAL clrchn routine ($f333)
IBASIN VECTOR: KERNAL chrin routine ($f157)
set input dev
set output dev
restore I/O
input
.:FD48 2F F3 66 FE A5 F4 ED F5  

Arbeitsspei. initialisieren

$0326 output character to channel
$0328 scan stop key
$032A get character from the input device
$032C close all channels and files
  IBSOUT VECTOR: KERNAL chrout routine ($f1ca)
ISTOP VECTOR: KERNAL stop routine ($f6ed)
IGETIN VECTOR: KERNAL getin routine ($f13e)
ICLALL VECTOR: KERNAL clall routine ($f32f)
output
test stop key
get
abort I/O
.,FD50 A9 00 LDA #$00 RAMTAS LDA #0 ;ZERO LOW MEMORY
Wert zum Löschen laden
$032E user function
Vector to user defined command, currently points to BRK.
This appears to be a holdover from PET days, when the built-in machine language monitor
would jump through the $032E vector when it encountered a command that it did not
understand, allowing the user to add new commands to the monitor.
Although this vector is initialized to point to the routine called by STOP/RESTORE and
the BRK interrupt, and is updated by the kernal vector routine at $FD57, it no longer
has any function.
$0330 load
$0332 save

test RAM and find RAM end

clear A
  USRCMD VECTOR: user defined ($fe66)
ILOAD VECTOR: KERNAL load routine ($f4a5)
ISAVE VECTOR: KERNAL save routine ($f5ed)

RAMTAS: INIT SYSTEM CONSTANTS

The KERNAL routine RAMTAS($ff87) jumps to this routine. It
clears the pages 0,2 and 3 by writing 00 into them. It
also sets the start of the cassette buffer - $033c, and
determins how much free RAM-memory there is. The
memorycheck is performed by writing two different bytes
into all memory positions, starting at $0400, till it
reaches the ROM (the byte read is not the same as the one
you wrote.) Note that the contents of the memory is
restored afterwards. Finally, bottom of the memory, and
top of screen-pointers are set.
unused (BRK)
load ram
save ram

initalise memory pointers

.,FD52 A8 TAY TAY ;START AT 0002
als Zähler nach Y
clear index
     
.,FD53 99 02 00 STA $0002,Y RAMTZ0 STA $0002,Y ;ZERO PAGE
Zeropage,
clear page 0, don't do $0000 or $0001
  Fill pages 0,2,3 with zeros
 
.,FD56 99 00 02 STA $0200,Y STA $0200,Y ;USER BUFFERS AND VARS
Page 2 und
clear page 2
     
.,FD59 99 00 03 STA $0300,Y STA $0300,Y ;SYSTEM SPACE AND USER SPACE
Page 3 löschen
clear page 3
     
.,FD5C C8 INY INY
Zähler vermindern
increment index
     
.,FD5D D0 F4 BNE $FD53 BNE RAMTZ0
;
;ALLOCATE TAPE BUFFERS
;
weiter wenn nicht fertig
loop if more to do
  all 256 bytes
 
.,FD5F A2 3C LDX #$3C LDX #<TBUFFR
Werte für Startadresse
set cassette buffer pointer low byte
     
.,FD61 A0 03 LDY #$03 LDY #>TBUFFR
des Bandpuffers laden
set cassette buffer pointer high byte
  Set tapebuffer to $033c
 
.,FD63 86 B2 STX $B2 STX TAPE1
Bandpuffer Zeiger
save tape buffer start pointer low byte
  Variables TAPE1 is used.
 
.,FD65 84 B3 STY $B3 STY TAPE1+1
;
; SET TOP OF MEMORY
;
RAMTBT
auf $033C setzen
save tape buffer start pointer high byte
     
.,FD67 A8 TAY TAY ;MOVE $00 TO .Y
Zeiger in Y auf 0 setzen
clear Y
     
.,FD68 A9 03 LDA #$03 LDA #3 ;SET HIGH INITAL INDEX
Wert für RAM testen ($04-1)
set RAM test pointer high byte
     
.,FD6A 85 C2 STA $C2 STA TMP0+1
;
Startadresse (HIGH) des RAM
save RAM test pointer high byte
     
.,FD6C E6 C2 INC $C2 RAMTZ1 INC TMP0+1 ;MOVE INDEX THRU MEMORY
setzen und auf $0400 erhöhen
increment RAM test pointer high byte
     
.,FD6E B1 C1 LDA ($C1),Y RAMTZ2 LDA (TMP0)Y ;GET PRESENT DATA
Wert holen
    Perform memorytest. Starting at $0400 and upwards.
 
.,FD70 AA TAX TAX ;SAVE IN .X
Wert merken
    Store temporary in X-reg
 
.,FD71 A9 55 LDA #$55 LDA #$55 ;DO A $55,$AA TEST
%01010101 ($55)
       
.,FD73 91 C1 STA ($C1),Y STA (TMP0)Y
abspeichern und über-
    Write #$55 into memory
 
.,FD75 D1 C1 CMP ($C1),Y CMP (TMP0)Y
prüfen, ob Wert drin ist
    and compare.
 
.,FD77 D0 0F BNE $FD88 BNE SIZE
ungleich dann kein RAM
    if not equal... ROM
 
.,FD79 2A ROL ROL A
%10101010
       
.,FD7A 91 C1 STA ($C1),Y STA (TMP0)Y
Wert abspeichern und
    Write #$AA into same memory
 
.,FD7C D1 C1 CMP ($C1),Y CMP (TMP0)Y
überprüfen, ob Wert drin ist
    and compare again.
 
.,FD7E D0 08 BNE $FD88 BNE SIZE
ungleich dann kein RAM
    if not equal... ROM
 
.,FD80 8A TXA TXA ;RESTORE OLD DATA
Wert wieder zurückholen
       
.,FD81 91 C1 STA ($C1),Y STA (TMP0)Y
und wieder zurückschreiben
    Restore stored value
 
.,FD83 C8 INY INY
Zeiger erhöhen
       
.,FD84 D0 E8 BNE $FD6E BNE RAMTZ2
Pageende? nein: weiter
    Next memorypos
 
.,FD86 F0 E4 BEQ $FD6C BEQ RAMTZ1
;
sonst Zeiger-HIGH erhöhen
    New page in memory
 
.,FD88 98 TYA SIZE TYA ;SET TOP OF MEMORY
Zeiger-LOW ins
    The memorytest always exits when reaching a ROM
 
.,FD89 AA TAX TAX
X-Register bringen
       
.,FD8A A4 C2 LDY $C2 LDY TMP0+1
Zeiger-HIGH holen
       
.,FD8C 18 CLC CLC
C=0 (Flag für setzen)
       
.,FD8D 20 2D FE JSR $FE2D JSR SETTOP
Memory (RAM) Top setzen
set the top of memory
  Set top of memory. X and Y holds address.
 
.,FD90 A9 08 LDA #$08 LDA #$08 ;SET BOTTOM OF MEMORY
HIGH-Byte der Startadresse
       
.,FD92 8D 82 02 STA $0282 STA MEMSTR+1 ;ALWAYS AT $0800
Memory (RAM) Start auf $800
save the OS start of memory high byte
  Set pointer to bottom of memory ($0800)
 
.,FD95 A9 04 LDA #$04 LDA #$04 ;SCREEN ALWAYS AT $400
HIGH-Byte der Startadresse
       
.,FD97 8D 88 02 STA $0288 STA HIBASE ;SET BASE OF SCREEN
Video-RAM auf $400
save the screen memory page
  Set pointer to bottom of screen ($0400)
 
.,FD9A 60 RTS RTS
Rücksprung

IRQ Vektoren

tape IRQ vectors

 

TAPE IRQ VECTORS

This table contains the vectors to the four tape-IRQ
routines.

IRQ vectors

.:FD9B 6A FC CD FB 31 EA 2C F9 BSIT .WOR WRTZ,WRTN,KEY,READ ;TABLE OF INDIRECTS FOR CASSETTE IRQ'S
; IOINIT - INITILIZE IO DEVICES
;
$FC6A, $FBCD, $EA31, $F92C

Interrupt Initialisierung

$08 write tape leader IRQ routine
  $fc6a - tape write
cassette write A
.,FDA3 A9 7F LDA #$7F IOINIT LDA #$7F ;KILL INTERRUPTS
Interrupt löschen
$0A tape write IRQ routine
$0C normal IRQ vector
$0E read tape bits IRQ routine

initialise SID, CIA and IRQ

disable all interrupts
  $fbcd - tape write II
$ea31 - normal IRQ
$f92c - tape read

IOINIT: INIT I/O

The KERNAL routine IOINIT ($ff84) jumps to this routine.
It sets the init-values for the CIAs (IRQ, DDRA, DRA
etc.), the SID-volume, and the processor onboard I/O port.
cassette write B
standard IRQ
cassette read

initaliase I/O devices

.,FDA5 8D 0D DC STA $DC0D STA D1ICR
ICR CIA 1
save VIA 1 ICR
  CIA#1 IRQ control register
 
.,FDA8 8D 0D DD STA $DD0D STA D2ICR
ICR CIA 2
Port A CIA 1
save VIA 2 ICR
  CIA#2 IRQ control register
 
.,FDAB 8D 00 DC STA $DC00 STA D1PRA ;TURN ON STOP KEY
Tastatur Matrixzeile 0
save VIA 1 DRA, keyboard column drive
  CIA#1 data port $ (keyboard)
 
.,FDAE A9 08 LDA #$08 LDA #%00001000 ;SHUT OFF TIMERS
Wert laden
set timer single shot
     
.,FDB0 8D 0E DC STA $DC0E STA D1CRA
CRA CIA 1 Timer A 'one shot'
save VIA 1 CRA
  CIA#1 control register timer A
 
.,FDB3 8D 0E DD STA $DD0E STA D2CRA
CRA CIA 2 Timer A 'one shot'
save VIA 2 CRA
  CIA#2 control register timer A
 
.,FDB6 8D 0F DC STA $DC0F STA D1CRB
CRB CIA 1 Timer B 'one shot'
save VIA 1 CRB
  CIA#1 control register timer B
 
.,FDB9 8D 0F DD STA $DD0F STA D2CRB
; CONFIGURE PORTS
CRB CIA 2 Timer B 'one shot'
save VIA 2 CRB
  CIA#2 control register timer B
 
.,FDBC A2 00 LDX #$00 LDX #$00 ;SET UP KEYBOARD INPUTS
Eingangs-Modus
set all inputs
     
.,FDBE 8E 03 DC STX $DC03 STX D1DDRB ;KEYBOARD INPUTS
Datenrichtungsreg. B CIA 1
save VIA 1 DDRB, keyboard row
  CIA#1 DDRB. Port B is input
 
.,FDC1 8E 03 DD STX $DD03 STX D2DDRB ;USER PORT (NO RS-232)
Datenrichtungsreg. B CIA 2
save VIA 2 DDRB, RS232 port
  CIA#2 DDRB. Port B is input
 
.,FDC4 8E 18 D4 STX $D418 STX SIDREG+24 ;TURN OFF SID
Lautstärke für SID auf Null
clear the volume and filter select register
  No sound from SID
 
.,FDC7 CA DEX DEX
Ausgabe-Modus
set X = $FF
     
.,FDC8 8E 02 DC STX $DC02 STX D1DDRA ;KEYBOARD OUTPUTS
Datenrichtungsreg. A CIA 1
save VIA 1 DDRA, keyboard column
  CIA#1 DDRA. Port A is output
 
.,FDCB A9 07 LDA #$07 LDA #%00000111 ;SET SERIAL/VA14/15 (CLKHI)
Videocontroller auf
unterste 16 K
DATA out high, CLK out high, ATN out high, RE232 Tx DATA
high, video address 15 = 1, video address 14 = 1
  %00000111
 
.,FDCD 8D 00 DD STA $DD00 STA D2PRA
Port A CIA 2, ATN löschen
save VIA 2 DRA, serial port and video address
  CIA#2 dataport A. Set Videobank to $0000-$3fff
 
.,FDD0 A9 3F LDA #$3F LDA #%00111111 ;SET SERIAL IN/OUT, VA14/15OUT
Bit 0 bis 5 auf Ausgabe
set serial DATA input, serial CLK input
  %00111111
 
.,FDD2 8D 02 DD STA $DD02 STA D2DDRA
;
; SET UP THE 6510 LINES
;
Datenrichtungsreg. A CIA 2
save VIA 2 DDRA, serial port and video address
  CIA#2 DDRA. Serial bus and videobank
 
.,FDD5 A9 E7 LDA #$E7 LDA #%11100111 ;MOTOR ON, HIRAM LOWRAM CHAREN HIGH
Normalwert laden und
set 1110 0111, motor off, enable I/O, enable KERNAL,
enable BASIC
  6510 I/O port - %XX100111
 
.,FDD7 85 01 STA $01 STA R6510
Speicheraufteilung neu setzen
save the 6510 I/O port
     
.,FDD9 A9 2F LDA #$2F LDA #%00101111 ;MTR OUT,SW IN,WR OUT,CONTROL OUT
Bit 0-3 und 5 Ausgang,
Bit 4 Eingang
set 0010 1111, 0 = input, 1 = output
  6510 I/O DDR - %00101111
 
.,FDDB 85 00 STA $00 STA D6510
Datenrichtung Prozessorport
save the 6510 I/O port direction register
 

ENABLE TIMER

This routine inits and starts the CIA#1 timer A according
to the PAL/NTSC flag. Different system clocks rates are
used in PAL/NTSC systems.

initalise TAL1/TAH1 fpr 1/60 of a second

.,FDDD AD A6 02 LDA $02A6 IOKEYS LDA PALNTS ;PAL OR NTSC
NTSC-Version ?
get the PAL/NTSC flag
  PAL/NTSC flag
 
.,FDE0 F0 0A BEQ $FDEC BEQ I0010 ;NTSC
ja
if NTSC go set NTSC timing
else set PAL timing
  NTSC setup
 
.,FDE2 A9 25 LDA #$25 LDA #<SIXTYP
Wert für PAL-Version
       
.,FDE4 8D 04 DC STA $DC04 STA D1T1L
Timer für PAL-Version setzen
save VIA 1 timer A low byte
  CIA#1 timer A - lowbyte
 
.,FDE7 A9 40 LDA #$40 LDA #>SIXTYP
$4025 = 16421 Zyklen
    PAL-setup #4025
 
.,FDE9 4C F3 FD JMP $FDF3 JMP I0020
NTSC-Version übergehen
       
.,FDEC A9 95 LDA #$95 I0010 LDA #<SIXTY ;KEYBOARD SCAN IRQ'S
Wert für NTSC-Version
       
.,FDEE 8D 04 DC STA $DC04 STA D1T1L
Timer für NTSC-Version setzen
save VIA 1 timer A low byte
  CIA#1 timer A - lowbyte
 
.,FDF1 A9 42 LDA #$42 LDA #>SIXTY
$4295 = 17045 Zyklen
    NTSC-setup #4295
 
.,FDF3 8D 05 DC STA $DC05 I0020 STA D1T1H
Timer-HIGH setzen
save VIA 1 timer A high byte
  CIA#1 timer A - highbyte
 
.,FDF6 4C 6E FF JMP $FF6E JMP PIOKEY
; LDA #$81 ;ENABLE T1 IRQ'S
; STA D1ICR
; LDA D1CRA
; AND #$80 ;SAVE ONLY TOD BIT
; ORA #%00010001 ;ENABLE TIMER1
; STA D1CRA
; JMP CLKLO ;RELEASE THE CLOCK LINE
;
; SIXTY HERTZ VALUE
;
SIXTY = 16667
Interrupt durch Timer setzen

Parameter f. Filenamen setzen

set filename

  start timer

SETNAM: SAVE FILENAME DATA

The KERNAL routine SETNAM ($ffbd) jumps to this routine.
On entry, A-reg holds the length of the filename, and X/Y
the address in mem to the filename.

initalise file name parameters

.,FDF9 85 B7 STA $B7 SETNAM STA FNLEN
Länge speichern
set file name length
  store length of filename in FNLEN
 
.,FDFB 86 BB STX $BB STX FNADR
Adresse-LOW speichern
set file name pointer low byte
  store pointer to filename in FNADDR
 
.,FDFD 84 BC STY $BC STY FNADR+1
Adresse-HIGH speichern
set file name pointer high byte
     
.,FDFF 60 RTS RTS
Rücksprung

Parameter für aktives

File setzen

set logical, first and second addresses

 

SETLFS: SAVE FILE DETAILS

The KERNAL routine SETLFS ($ffba) jumps to this routine.
On entry A-reg holds the logical filenumber, X the device
number, and Y the secondary address.

inatalise file parameters

.,FE00 85 B8 STA $B8 SETLFS STA LA
logische Filenummer
save the logical file
  store logical filenumber in LA
 
.,FE02 86 BA STX $BA STX FA
Geräteadresse
save the device number
  store devicenumber in FA
 
.,FE04 84 B9 STY $B9 STY SA
Sekundäradresse
save the secondary address
  store secondary address in SA
 
.,FE06 60 RTS RTS
Rücksprung

Status holen

read I/O status word

 

READST: READ STATUS

The KERNAL routine READST ($ffb7) jumps to this routine.
The routine checks if the current devicenumber is 2, (ie
RS232) then the value of RSSTAT (the ACIA 6551 status)is
returned in (A), and RSSTAT is cleared. Else it reads and
returnes the value of STATUS.

read I/O status word

.,FE07 A5 BA LDA $BA READSS LDA FA ;SEE WHICH DEVICES' TO READ
Gerätenummer holen
get the device number
  read current device number from FA
 
.,FE09 C9 02 CMP #$02 CMP #2 ;IS IT RS-232?
gleich 2 ? (RS 232)
compare device with RS232 device
  device = RS232?
 
.,FE0B D0 0D BNE $FE1A BNE READST ;NO...READ SERIAL/CASS
nein
if not RS232 device go ??
get RS232 device status
  nope, read STATUS
 
.,FE0D AD 97 02 LDA $0297 LDA RSSTAT ;YES...GET RS-232 UP
RS 232-Status holen
get the RS232 status register
  RSSTAT
 
.,FE10 48 PHA PHA
und auf Stapel retten
save the RS232 status value
  temp store
 
.,FE11 A9 00 LDA #$00 LDA #00 ;CLEAR RS232 STATUS WHEN READ
Status
clear A
     
.,FE13 8D 97 02 STA $0297 STA RSSTAT
löschen
clear the RS232 status register
  clear RSSTAT
 
.,FE16 68 PLA PLA
und Statuswert zurückholen
restore the RS232 status value
     
.,FE17 60 RTS RTS
Rücksprung

Flag für Betriebssystem-

meldungen setzen

control kernal messages

 

SETMSG: FLAG STATUS

The KERNAL routine SETMSG ($ff90) jumps to this routine.
On entry, the value in (A) is stored in MSGFLG, then the
I/O status is placed in (A). If routine is entered at
$fe1c the contents in (A) will be stored in STATUS.

control kernel messages

.,FE18 85 9D STA $9D SETMSG STA MSGFLG
Ausgabeflag (Direktmodus)
set message mode flag
  store MSGFLG

read ST

.,FE1A A5 90 LDA $90 READST LDA STATUS
Statusflag holen

Status setzen

read the serial status byte

OR into the serial status byte

  read STATUS

add A to ST

.,FE1C 05 90 ORA $90 UDST ORA STATUS
Statusflag testen und
OR with the serial status byte
     
.,FE1E 85 90 STA $90 STA STATUS
wieder abspeichern
save the serial status byte
     
.,FE20 60 RTS RTS
Rücksprung

Timeout-Flag für IEC setzen

set timeout on serial bus

 

SETTMO: SET TIMEOUT

The KERNAL routine SETTMO ($ffa2) jumps to this routine.
On entry the value in (A) is stored in the IEEE timeout
flag. (Who uses IEEE nowadays?)

set timeout on serail bus

.,FE21 8D 85 02 STA $0285 SETTMO STA TIMOUT
Timeout-disable
save serial bus timeout flag
  store in TIMOUT
 
.,FE24 60 RTS RTS
Rücksprung

MEMTOP, Obergrenze des

BASIC-RAM holen/setzen

read/set the top of memory, Cb = 1 to read, Cb = 0 to set

 

MEMTOP: READ/SET TOP OF MEMORY

The KERNAL routine MEMTOP ($ffa9) jumps to this routine.
If carry is set on entry, the top of memory address will
be loaded into (X/Y). If carry is clear on entry, the top
of memory will be set according to the contents in (X/Y)

read/set top of memory

.,FE25 90 06 BCC $FE2D MEMTOP BCC SETTOP
;
;CARRY SET--READ TOP OF MEMORY
;
C=0: Adresse setzen
if Cb clear go set the top of memory

read the top of memory

  carry clear?
 
.,FE27 AE 83 02 LDX $0283 GETTOP LDX MEMSIZ
Carry gesetzt
get memory top low byte
  read memtop from MEMSIZ
 
.,FE2A AC 84 02 LDY $0284 LDY MEMSIZ+1
;
;CARRY CLEAR--SET TOP OF MEMORY
;
Adresse nach X/Y holen
get memory top high byte

set the top of memory

     
.,FE2D 8E 83 02 STX $0283 SETTOP STX MEMSIZ
Carry gelöscht
set memory top low byte
  store memtop in MEMSIZ
 
.,FE30 8C 84 02 STY $0284 STY MEMSIZ+1
X/Y nach Adresse setzen
set memory top high byte
     
.,FE33 60 RTS RTS
;MANAGE BOTTOM OF MEMORY
;
Rücksprung

MEMBOT, Untergrenze des

BASIC-RAM holen/setzen

read/set the bottom of memory, Cb = 1 to read, Cb = 0 to set

 

MEMBOT: READ/SET BOTTOM OF MEMORY

The KERNAL routine MEMBOT ($ff9c) jumps to this routine.
If carry is set on entry, the bottom of memory address
will be loaded into (X/Y). If carry is clear on entry, the
bottom of memory will set according to the contents in
(X/Y)

read/set bottom of memory

.,FE34 90 06 BCC $FE3C MEMBOT BCC SETBOT
;
;CARRY SET--READ BOTTOM OF MEMORY
;
C=0: Adresse setzen
if Cb clear go set the bottom of memory
  carry clear?
 
.,FE36 AE 81 02 LDX $0281 LDX MEMSTR
Carry gesetzt
get the OS start of memory low byte
  read membot from MEMSTR
 
.,FE39 AC 82 02 LDY $0282 LDY MEMSTR+1
;
;CARRY CLEAR--SET BOTTOM OF MEMORY
;
Adresse nach X/Y holen
get the OS start of memory high byte
     
.,FE3C 8E 81 02 STX $0281 SETBOT STX MEMSTR
Carry gelöscht
save the OS start of memory low byte
  store membot in MEMSTR
 
.,FE3F 8C 82 02 STY $0282 STY MEMSTR+1
Adresse aus X/Y setzen
save the OS start of memory high byte
     
.,FE42 60 RTS RTS
.END

.LIB RS232NMI

Rücksprung

NMI Einsprung

NMI vector

 

NMI ENTRY POINT

The processor jumps to this routine every time a NMI
occurs (see jump vector at $fffa). On entry all processor
registers will be put on the stack. The routine will check
the presents of a ROM cartridge at $8000 with autostart,
and warm start it. Otherwise, the following warm start
routine is called.

NMI entry

.,FE43 78 SEI NMI SEI ;NO IRQ'S ALLOWED...
Interrupt setzen
disable the interrupts
  disable interrupts
 
.,FE44 6C 18 03 JMP ($0318) JMP (NMINV) ;...COULD MESS UP CASSETTES
JMP $FE47, NMI-Vektor
do NMI vector

NMI handler

  jump to NMINV, points normally to $fe47
normally FE47

standard NMI routine

.,FE47 48 PHA NNMI PHA
Akku auf Stapel retten
save A
  store (A), (X), (Y) on the stack
 
.,FE48 8A TXA TXA
X nach Akku
copy X
     
.,FE49 48 PHA PHA
X retten
save X
     
.,FE4A 98 TYA TYA
Y nach Akku
copy Y
     
.,FE4B 48 PHA PHA
Y retten
save Y
     
.,FE4C A9 7F LDA #$7F NNMI10 LDA #$7F ;DISABLE ALL NMI'S
Wert laden
disable all interrupts
  CIA#2 interrupt control register
 
.,FE4E 8D 0D DD STA $DD0D STA D2ICR
NMI-Möglichkeiten löschen
save VIA 2 ICR
     
.,FE51 AC 0D DD LDY $DD0D LDY D2ICR ;CHECK IF REAL NMI...
Flags lesen und löschen
save VIA 2 ICR
     
.,FE54 30 1C BMI $FE72 BMI NNMI20 ;NO...RS232/OTHER
;
RS 232 aktiv ?
    NMI caused by RS232? If so - jump
 
.,FE56 20 02 FD JSR $FD02 NNMI18 JSR A0INT ;CHECK IF $A0 IN...NO .Y
Prüft auf ROM-Modul in $8000
scan for autostart ROM at $8000
  check for autostart at $8000
 
.,FE59 D0 03 BNE $FE5E BNE NNMI19 ;...NO
nein: weiter
branch if no autostart ROM
     
.,FE5B 6C 02 80 JMP ($8002) JMP ($8002) ;...YES
;
; CHECK FOR STOP KEY DOWN
;
NNMI19
ja: Sprung auf Modul-NMI
else do autostart ROM break entry
  Jump to warm start vector
cartridge warm start
.,FE5E 20 BC F6 JSR $F6BC JSR UD60 ;NO .Y
Flag für Stop-Taste setzen
increment real time clock
  Scan 1 row in keymatrix and store value in $91
 
.,FE61 20 E1 FF JSR $FFE1 JSR STOP ;NO .Y
Stop-Taste abfragen
scan stop key
  Check $91 to see if <STOP> was pressed
 
.,FE64 D0 0C BNE $FE72 BNE NNMI20 ;NO STOP KEY...TEST FOR RS232
;
; TIMB - WHERE SYSTEM GOES ON A BRK INSTRUCTION
;
nicht gedrückt ?
if not [STOP] restore registers and exit interrupt

user function default vector

BRK handler
  <STOP> not pressed, skip part of following routine

WARM START BASIC

This routine is called from the NMI routine above. If
<STOP> was pressed, then KERNAL vectors are restored to
default values, I/O vectors initialised and a jump to
($a002), the Basic warm start vector.
The NMI routine continues at $fe72 by checking the RS232,
if there is anyting to send.

BRK routine

.,FE66 20 15 FD JSR $FD15 TIMB JSR RESTOR ;RESTORE SYSTEM INDIRECTS
Standard-Vektoren für
Interrupt und I/O setzen
restore default I/O vectors
  KERNAL reset
 
.,FE69 20 A3 FD JSR $FDA3 JSR IOINIT ;RESTORE I/O FOR BASIC
I/O initialisieren
initialise SID, CIA and IRQ
  init I/O
 
.,FE6C 20 18 E5 JSR $E518 JSR CINT ;RESTORE SCREEN FOR BASIC
Bildschirmreset
initialise the screen and keyboard
  init I/O
 
.,FE6F 6C 02 A0 JMP ($A002) JMP ($A002) ;...NO, SO BASIC WARM START
; DISABLE NMI'S UNTILL READY
; SAVE ON STACK
;
zum BASIC-Warmstart

NMI-Routine für RS 232

do BASIC break entry

RS232 NMI routine

  jump to Basic warm start vector

NMI RS232 HANDLING

internal NMI

.,FE72 98 TYA NNMI20 TYA ;.Y SAVED THROUGH RESTORE
ICR-Register
    Read CIA#2 interrupt control register
 
.,FE73 2D A1 02 AND $02A1 AND ENABL ;SHOW ONLY ENABLES
mit RS 232 NMI-Flag verknüp.
AND with the RS-232 interrupt enable byte
  mask with ENABL, RS232 enable
 
.,FE76 AA TAX TAX ;SAVE IN .X FOR LATTER
;
; T1 NMI CHECK - TRANSMITT A BIT
;
nach X retten
    temp store in (X)
 
.,FE77 29 01 AND #$01 AND #$01 ;CHECK FOR T1
Sendebetrieb aktiv ?
    test if sending (%00000001)
 
.,FE79 F0 28 BEQ $FEA3 BEQ NNMI30 ;NO...
;
nein
    nope, jump to recieve test
 
.,FE7B AD 00 DD LDA $DD00 LDA D2PRA
Datenport lesen
read VIA 2 DRA, serial port and video address
  load CIA#1 DRA
 
.,FE7E 29 FB AND #$FB AND #$FF-$04 ;FIX FOR CURRENT I/O
Bit 2 TXD löschen
mask xxxx x0xx, clear RS232 Tx DATA
  mask bit2 (RS232 send)
 
.,FE80 05 B5 ORA $B5 ORA NXTBIT ;LOAD DATA AND...
zu sendendes Bit übergeben
OR in the RS232 transmit data bit
  NXTBIT, next bit to send
 
.,FE82 8D 00 DD STA $DD00 STA D2PRA ;...SEND IT
;
und wieder in Datenport spei.
save VIA 2 DRA, serial port and video address
  and write to port
 
.,FE85 AD A1 02 LDA $02A1 LDA ENABL ;RESTORE NMI'S
RS-232 NMI-Flag
get the RS-232 interrupt enable byte
     
.,FE88 8D 0D DD STA $DD0D STA D2ICR ;READY FOR NEXT...
;
; BECAUSE OF 6526 ICR STRUCTURE...
; HANDLE ANOTHER NMI AS A SUBROUTINE
;
wieder in ICR schreiben
save VIA 2 ICR
  write ENABL to CIA#2 I.C.R
 
.,FE8B 8A TXA TXA ;TEST FOR ANOTHER NMI
Wert aus X zurückholen
    get temp
 
.,FE8C 29 12 AND #$12 AND #$12 ;TEST FOR T2 OR FLAG
Bit 1 und 4 isolieren
    test if recieving (bit1), or waiting for reciever
edge (bit4) ($12 = %00010010)
 
.,FE8E F0 0D BEQ $FE9D BEQ NNMI25
Bit 1 und 4=0: Bit empfangen
    nope, skip reciever routine
 
.,FE90 29 02 AND #$02 AND #$02 ;CHECK FOR T2
Bit 1, Aufruf von Timer B
    test if recieving
 
.,FE92 F0 06 BEQ $FE9A BEQ NNMI22 ;MUST BE A FLAG
;
nein: verzweige zu Startbit
    nope
 
.,FE94 20 D6 FE JSR $FED6 JSR T2NMI ;HANDLE A NORMAL BIT IN...
empfangenes Bit verarbeiten
    jump to NMI RS232 in
 
.,FE97 4C 9D FE JMP $FE9D JMP NNMI25 ;...THEN CONTINUE OUTPUT
;
Vorbereitung für Byte umgehen
       
.,FE9A 20 07 FF JSR $FF07 NNMI22 JSR FLNMI ;HANDLE A START BIT...
;
Vorbereitung für Empfang
des nächsten Bytes
    jump to NMI RS232 out
 
.,FE9D 20 BB EE JSR $EEBB NNMI25 JSR RSTRAB ;GO CALC INFO (CODE COULD BE IN LINE)
Empfang des nächsten Bits v.
    RS232 send byte
 
.,FEA0 4C B6 FE JMP $FEB6 JMP NMIRTI
;
; T2 NMI CHECK - RECIEVE A BIT
;
Rückkehr vom Interrupt
    goto exit
 
.,FEA3 8A TXA NNMI30 TXA
X nach Akku
get active interrupts back
  get temp
 
.,FEA4 29 02 AND #$02 AND #$02 ;MASK TO T2
Datenempfang ?
mask ?? interrupt
  test bit1
 
.,FEA6 F0 06 BEQ $FEAE BEQ NNMI40 ;NO...
;
verzweige wenn kein Empfang
branch if not ?? interrupt
was ?? interrupt
  nope
 
.,FEA8 20 D6 FE JSR $FED6 JSR T2NMI ;HANDLE INTERRUPT
empfangenes Bit verarbeiten
    NMI RS232 in???
 
.,FEAB 4C B6 FE JMP $FEB6 JMP NMIRTI
; FLAG NMI HANDLER - RECIEVE A START BIT
;
Rückkehr vom Interrupt
    goto exit
 
.,FEAE 8A TXA NNMI40 TXA ;CHECK FOR EDGE
X nach Akku
get active interrupts back
  set temp
 
.,FEAF 29 10 AND #$10 AND #$10 ;ON FLAG...
warten auf Startbit ?
mask CB1 interrupt, Rx data bit transition
  test bit4
 
.,FEB1 F0 03 BEQ $FEB6 BEQ NMIRTI ;NO...
;
verzweige wenn kein Startbit
if no bit restore registers and exit interrupt
  nope, exit
 
.,FEB3 20 07 FF JSR $FF07 JSR FLNMI ;START BIT ROUTINE
Vorbereitung für Empfang
des nächsten Bytes
    NMI RS232 out
 
.,FEB6 AD A1 02 LDA $02A1 NMIRTI LDA ENABL ;RESTORE NMI'S
RS-232 NMI-Flag
get the RS-232 interrupt enable byte
  ENABL
 
.,FEB9 8D 0D DD STA $DD0D STA D2ICR
wieder in ICR
save VIA 2 ICR
  CIA#2 interrupt control register
 
.,FEBC 68 PLA PREND PLA ;BECAUSE OF MISSING SCREEN EDITOR
Y-Register vom Stapel
pull Y
  restore registers (Y),(X),(A)
 
.,FEBD A8 TAY TAY
zurückholen
restore Y
     
.,FEBE 68 PLA PLA
X-Register
pull X
     
.,FEBF AA TAX TAX
zurückholen
restore X
     
.,FEC0 68 PLA PLA
Akku zurückholen
restore A
     
.,FEC1 40 RTI RTI
; BAUDO TABLE CONTAINS VALUES
; FOR 1E6/BAUD RATE/2
;
Rücksprung

Timerkonstanten für RS 232 Baud-Rate,

NTSC-Version

baud rate word is calculated from ..

(system clock / baud rate) / 2 - 100
system clock
------------
PAL 985248 Hz
NTSC 1022727 Hz
baud rate tables for NTSC C64
  back from NMI

RS232 TIMING TABLE - NTSC

Timingtable for RS232 NMI for use with NTSC machines. The
table containe 10 entries which corresponds to one of the
fixed RS232 rates, starting with lowest (50 baud) and
finishing with the highest (2400 baud). Since the clock
frequency is different between NTSC and PAL systems, there
is another table for PAL machines at $e4ec.

baud rate tables

.:FEC2 C1 27 BAUDO .WOR 10000-CBIT ; 50 BAUD
$27C1 = 10177 50 Baud
50 baud 1027700
  50 baud
50
.:FEC4 3E 1A .WOR 6667-CBIT ; 75 BAUD
$1A3E = 6718 75 Baud
75 baud 1022700
  75 baud
75
.:FEC6 C5 11 .WOR 4545-CBIT ; 110 BAUD
$11C5 = 4549 110 Baud
110 baud 1022780
  110 baud
110
.:FEC8 74 0E .WOR 3715-CBIT ; 134.6 BAUD
$0E74 = 3700 134.5 Baud
134.5 baud 1022200
  134.5 baud
134.5
.:FECA ED 0C .WOR 3333-CBIT ; 150 BAUD
$0CED = 3309 150 Baud
150 baud 1022700
  150 baud
150
.:FECC 45 06 .WOR 1667-CBIT ; 300 BAUD
$0645 = 1605 300 Baud
300 baud 1023000
  300 baud
300
.:FECE F0 02 .WOR 833-CBIT ; 600 BAUD
$02F0 = 752 600 Baud
600 baud 1022400
  600 baud
600
.:FED0 46 01 .WOR 417-CBIT ; 1200 BAUD
$0146 = 326 1200 Baud
1200 baud 1022400
  1200 baud
1200
.:FED2 B8 00 .WOR 278-CBIT ; 1800 BAUD
$00B8 = 184 1800 Baud
1800 baud 1022400
  (1800) 2400 baud
1800
.:FED4 71 00 .WOR 208-CBIT ; 2400 BAUD
;
; CBIT - AN ADJUSTMENT TO MAKE NEXT T2 HIT NEAR CENTER
; OF THE NEXT BIT.
; APROX THE TIME TO SERVICE A CB1 NMI
CBIT =100 ;CYCLES
; T2NMI - SUBROUTINE TO HANDLE AN RS232
; BIT INPUT.
;
$0071 = 113 2400 Baud

NMI-Routine für RS-232

Eingabe

2400 baud 1022400

??

  2400 baud

NMI RS232 IN

This routine inputs a bit from the RS232 port and sets the
baudrate timing for the next bit. Continues to the RS232
recieve routine.
2400

input next bit on RS-232 and schedule TB2

.,FED6 AD 01 DD LDA $DD01 T2NMI LDA D2PRB ;GET DATA IN
Port Register B
read VIA 2 DRB, RS232 port
  RS232 I/O port
 
.,FED9 29 01 AND #$01 AND #01 ;MASK OFF...
Bit für Receive Data isolie-
ren
mask 0000 000x, RS232 Rx DATA
  test bit0, received data
 
.,FEDB 85 A7 STA $A7 STA INBIT ;...SAVE FOR LATTER
;
; UPDATE T2 FOR MID BIT CHECK
; (WORST CASE <213 CYCLES TO HERE)
; (CALC 125 CYCLES+43-66 DEAD)
;
und speichern
save the RS232 received data bit
  store in INBIT
 
.,FEDD AD 06 DD LDA $DD06 LDA D2T2L ;CALC NEW TIME & CLR NMI
Timer B LOW
get VIA 2 timer B low byte
  lowbyte of timer B
 
.,FEE0 E9 1C SBC #$1C SBC #22+6
minus 28
       
.,FEE2 6D 99 02 ADC $0299 ADC BAUDOF
+ LOW-Byte der Baudrate
    <BAUDOF
 
.,FEE5 8D 06 DD STA $DD06 STA D2T2L
wieder abspeichern
save VIA 2 timer B low byte
  store timer B
 
.,FEE8 AD 07 DD LDA $DD07 LDA D2T2H
RS 232 Timerkon. für Baudrate
get VIA 2 timer B high byte
  highbyte of timer B
 
.,FEEB 6D 9A 02 ADC $029A ADC BAUDOF+1
HIGH-Byte addieren
    >BAUDOF
 
.,FEEE 8D 07 DD STA $DD07 STA D2T2H
;
in Timer schreiben
save VIA 2 timer B high byte
  store timer B
 
.,FEF1 A9 11 LDA #$11 LDA #$11 ;ENABLE TIMER
Timer B starten
set timer B single shot, start timer B
     
.,FEF3 8D 0F DD STA $DD0F STA D2CRB
;
Control Register B
save VIA 2 CRB
  CIA#2 control register B
 
.,FEF6 AD A1 02 LDA $02A1 LDA ENABL ;RESTORE NMI'S EARLY...
CIA 2 NMI-Flag holen
get the RS-232 interrupt enable byte
  ENABL
 
.,FEF9 8D 0D DD STA $DD0D STA D2ICR
;
Interrupt Control Register
save VIA 2 ICR
  CIA#2 interrupt control register
 
.,FEFC A9 FF LDA #$FF LDA #$FF ;ENABLE COUNT FROM $FFFF
Wert laden
       
.,FEFE 8D 06 DD STA $DD06 STA D2T2L
und damit
save VIA 2 timer B low byte
     
.,FF01 8D 07 DD STA $DD07 STA D2T2H
;
Timer setzen
save VIA 2 timer B high byte
     
.,FF04 4C 59 EF JMP $EF59 JMP RSRCVR ;GO SHIFT IN...
FLNMI
;
; GET HALF BIT RATE VALUE
;
Bit holen

NMI-Routine RS 232 Ausgabe

    jump to RS232 receive routine

NMI RS232 OUT

This routine sets up the baudrate for sending the bits
out, and adjusts the number of bits remaining to send.

schedule TB2 using baud rate factor

.,FF07 AD 95 02 LDA $0295 LDA M51AJB
LOW- und HIGH-Byte
nonstandard bit timing low byte
  M51AJB - non standard BPS time
 
.,FF0A 8D 06 DD STA $DD06 STA D2T2L
holen und in
save VIA 2 timer B low byte
  timer B low
 
.,FF0D AD 96 02 LDA $0296 LDA M51AJB+1
RS 232 Timerkonstanten für
nonstandard bit timing high byte
     
.,FF10 8D 07 DD STA $DD07 STA D2T2H
;
Baudrate
save VIA 2 timer B high byte
  timer B high
 
.,FF13 A9 11 LDA #$11 LDA #$11 ;ENABLE TIMER
Timer B starten
set timer B single shot, start timer B
     
.,FF15 8D 0F DD STA $DD0F STA D2CRB
;
Control Register B
save VIA 2 CRB
  CIA#2 control register B
 
.,FF18 A9 12 LDA #$12 LDA #$12 ;DISABLE FLAG, ENABLE T2
Bit 1 und 4 für Verknüpfung
       
.,FF1A 4D A1 02 EOR $02A1 EOR ENABL
mit NMI-Flag für CIA 2
EOR with the RS-232 interrupt enable byte
     
.,FF1D 8D A1 02 STA $02A1 STA ENABL
;ORA #$82
;STA D2ICR
;
Wert wieder speichern
save the RS-232 interrupt enable byte
  ENABL, RS232 enables
 
.,FF20 A9 FF LDA #$FF LDA #$FF ;PRESET FOR COUNT DOWN
höchsten Wert laden
       
.,FF22 8D 06 DD STA $DD06 STA D2T2L
und in Latch von
save VIA 2 timer B low byte
     
.,FF25 8D 07 DD STA $DD07 STA D2T2H
;
Timer B laden
save VIA 2 timer B high byte
  timer B
 
.,FF28 AE 98 02 LDX $0298 LDX BITNUM ;GET #OF BITS IN
Anzahl der zu sendenden Bits
    BITNUM, number of bits still to send in this byte
 
.,FF2B 86 A8 STX $A8 STX BITCI ;PUT IN RCVRCNT
in Zähler für Wortlänge
    BITC1, RS232 bitcount
 
.,FF2D 60 RTS RTS
;
; POPEN - PATCHES OPEN RS232 FOR UNIVERSAL KERNAL
;
Rücksprung

Timerwert für Sendebaudrate

ermitteln

??

   

continuation of baud rate calculation

.,FF2E AA TAX POPEN TAX ;WE'RE CALCULATING BAUD RATE
Baudrate aus Tabelle nach X
       
.,FF2F AD 96 02 LDA $0296 LDA M51AJB+1 ; M51AJB=FREQ/BAUD/2-100
HIGH-Byte holen
nonstandard bit timing high byte
     
.,FF32 2A ROL ROL A
mal 2
       
.,FF33 A8 TAY TAY
nach Y retten
       
.,FF34 8A TXA TXA
LOW-Byte holen
       
.,FF35 69 C8 ADC #$C8 ADC #CBIT+CBIT
plus 200
       
.,FF37 8D 99 02 STA $0299 STA BAUDOF
nach Timerwert LOW
       
.,FF3A 98 TYA TYA
HIGH-Byte zurückholen
       
.,FF3B 69 00 ADC #$00 ADC #0
Übertrag addieren
add any carry
     
.,FF3D 8D 9A 02 STA $029A STA BAUDOF+1
nach Timerwert HIGH
       
.,FF40 60 RTS RTS
Rücksprung

unused bytes

     
.,FF41 EA NOP NOP
No OPeration
waste cycles
     
.,FF42 EA NOP NOP
.END

.LIB IRQFILE

; SIMIRQ - SIMULATE AN IRQ (FOR CASSETTE READ)
; ENTER BY A JSR SIMIRQ
;
No OPeration

Einsprung aus Bandroutine

waste cycles

save the status and do the IRQ routine

 

FAKE IRQ TAPE

 
.,FF43 08 PHP SIMIRQ PHP
Statusregister auf Stapel
save the processor status
  store processor reg.
 
.,FF44 68 PLA PLA ;FIX THE BREAK FLAG
Statusregister in Akku
pull the processor status
  get reg
 
.,FF45 29 EF AND #$EF AND #$EF
Break-Flag löschen
mask xxx0 xxxx, clear the break bit
  clear bit4
 
.,FF47 48 PHA PHA
; PULS - CHECKS FOR REAL IRQ'S OR BREAKS
;
und wieder auf Stapel legen

IRQ-Einsprung

save the modified processor status

IRQ vector

  store reg

IRQ ENTRY

This routine is pointed to by the hardware IRQ vector at
$fffe. This routine is able to distinguish between a
hardware IRQ, and a software BRK. The two types of
interrupts are processed by its own routine.

IRQ entry point

.,FF48 48 PHA PULS PHA
Akku auf Stapel retten
save A
  Store Acc
 
.,FF49 8A TXA TXA
X nach Akku
copy X
     
.,FF4A 48 PHA PHA
X-Register retten
save X
  Store X-reg
 
.,FF4B 98 TYA TYA
Y nach Akku
copy Y
     
.,FF4C 48 PHA PHA
Y-Register retten
save Y
  Store Y-reg
 
.,FF4D BA TSX TSX
Stapelzeiger als Zähler in X
copy stack pointer
     
.,FF4E BD 04 01 LDA $0104,X LDA $104,X ;GET OLD P STATUS
Break-Flag vom Stapel holen
get stacked status register
  Read byte on stack written by processor?
 
.,FF51 29 10 AND #$10 AND #$10 ;BREAK FLAG?
und testen
mask BRK flag
  check bit 4 to determine HW or SW interrupt
 
.,FF53 F0 03 BEQ $FF58 BEQ PULS1 ;...NO
nicht gesetzt
branch if not BRK
     
.,FF55 6C 16 03 JMP ($0316) JMP (CBINV) ;...YES...BREAK INSTR
BREAK - Routine
else do BRK vector (iBRK)
  jump to CBINV. Points to FE66, basic warm start
normally FE66
.,FF58 6C 14 03 JMP ($0314) PULS1 JMP (CINV) ;...IRQ
.END

.LIB VECTORS

Interrupt - Routine

Video-Reset

do IRQ vector (iIRQ)

initialise VIC and screen editor

  jump to CINV. Points to EA31, main IRQ entry point

CINT: INIT SCREEN EDITOR

The KERNAL routine CINT ($FF81) jumps to this routine. It
sets up VIC for operation. The original CINT is at $e518,
and this patch checks out if this is a PAL or NTSC
machine. This is done by setting the raster compare
register to 311, which is the number of scanlines in a PAL
machine. If no interrupt occurs, then it's a NTSC machine.
normally EA31

addition to I/O device initalisation

.,FF5B 20 18 E5 JSR $E518 *=$FF8A-9
Videocontroller initialisie-
ren
initialise the screen and keyboard
  original I/O init
 
.,FF5E AD 12 D0 LDA $D012   Rasterzeile
read the raster compare register
  wait for top of screen
 
.,FF61 D0 FB BNE $FF5E   wartet auf Ende Videozeile
loop if not raster line $00
  at line zero
 
.,FF63 AD 19 D0 LDA $D019   Interrupt durch Rasterzeile?
read the vic interrupt flag register
  Check IRQ flag register if interrupt occured
 
.,FF66 29 01 AND #$01   Bit 0 isolieren und als Flag
mask the raster compare flag
  only first bit
 
.,FF68 8D A6 02 STA $02A6   PAL/NTSC-Version merken
save the PAL/NTSC flag
  store in PAL/NTSC flag
 
.,FF6B 4C DD FD JMP $FDDD   Interrupttimer setzen

Timer für Interrupt setzen

??

  jump to ENABLE TIMER

START TIMER

This routine starts the CIA#1 timer and jumps into a
routine that handles the serial clock.

end of scheduling TA for 1/60 second IRQ's

.,FF6E A9 81 LDA #$81   Timer A Unterlauf
enable timer A interrupt
  Enable IRQ when timer B reaches zero
 
.,FF70 8D 0D DC STA $DC0D   Interrupt Control Register
save VIA 1 ICR
  CIA#1 interrupt controll register
 
.,FF73 AD 0E DC LDA $DC0E   Control Register A
read VIA 1 CRA
  CIA#1 control register A
 
.,FF76 29 80 AND #$80   Bit 7 retten
Uhrzeittrigger (50/60 Hz)
mask x000 0000, TOD clock
     
.,FF78 09 11 ORA #$11   Timer A starten
mask xxx1 xxx1, load timer A, start timer A
  Force load of timer A values -bit4, and start -bit0
 
.,FF7A 8D 0E DC STA $DC0E   Control Register A
save VIA 1 CRA
  Action!
 
.,FF7D 4C 8E EE JMP $EE8E   seriellen Takt aus
set the serial clock out low and return

unused

  Continue to 'serial clock off'

KERNAL VERSION ID

This byte contains the version number of the KERNAL.
 
.,FF80 00 BRK   BReaK

Sprungtabelle für

Betriebssystem-Routinen

initialise VIC and screen editor

 

KERNAL JUMP TABLE

This table contains jump vectors to the I/O routines. This
is a Commodore standard, so no matter what system you are
using (VIC20, C64, C128, Plus4 etc) the jump vectors are
always located at this position.
kernal version number

kernal vectors

.,FF81 4C 5B FF JMP $FF5B JMP CINT
Video-Reset
initialise VIC and screen editor

initialise SID, CIA and IRQ, unused

  CINT, init screen editor
initalise screen and keyboard
.,FF84 4C A3 FD JMP $FDA3 JMP IOINIT
CIAs initialisieren
initialise SID, CIA and IRQ

RAM test and find RAM end

  IOINT, init input/output
initalise I/O devices
.,FF87 4C 50 FD JMP $FD50 JMP RAMTAS
*=$FF8A ;NEW VECTORS FOR BASIC
RAM löschen bzw. testen
RAM test and find RAM end

restore default I/O vectors

this routine restores the default values of all system vectors used in KERNAL and
BASIC routines and interrupts.
  RAMTAS, init RAM, tape screen
initalise memory pointers
.,FF8A 4C 15 FD JMP $FD15 JMP RESTOR ;RESTORE VECTORS TO INITIAL SYSTEM
I/O initialisieren
restore default I/O vectors

read/set vectored I/O

this routine manages all system vector jump addresses stored in RAM. Calling this
routine with the carry bit set will store the current contents of the RAM vectors
in a list pointed to by the X and Y registers. When this routine is called with
the carry bit clear, the user list pointed to by the X and Y registers is copied
to the system RAM vectors.
NOTE: This routine requires caution in its use. The best way to use it is to first
read the entire vector contents into the user area, alter the desired vectors and
then copy the contents back to the system vectors.
  RESTOR, restore default I/O vector
restore I/O vectors
.,FF8D 4C 1A FD JMP $FD1A JMP VECTOR ;CHANGE VECTORS FOR USER
* =$FF90
I/O Vektoren initialisieren
read/set vectored I/O

control kernal messages

this routine controls the printing of error and control messages by the KERNAL.
Either print error messages or print control messages can be selected by setting
the accumulator when the routine is called.
FILE NOT FOUND is an example of an error message. PRESS PLAY ON CASSETTE is an
example of a control message.
bits 6 and 7 of this value determine where the message will come from. If bit 7
is set one of the error messages from the KERNAL will be printed. If bit 6 is set
a control message will be printed.
  VECTOR, read/set I/O vector
set I/O vectors from XY
.,FF90 4C 18 FE JMP $FE18 JMP SETMSG ;CONTROL O.S. MESSAGES
Status setzen
control kernal messages

send secondary address after LISTEN

this routine is used to send a secondary address to an I/O device after a call to
the LISTEN routine is made and the device commanded to LISTEN. The routine cannot
be used to send a secondary address after a call to the TALK routine.
A secondary address is usually used to give set-up information to a device before
I/O operations begin.
When a secondary address is to be sent to a device on the serial bus the address
must first be ORed with $60.
  SETMSG, control KERNAL messages
control kernal messages
.,FF93 4C B9 ED JMP $EDB9 JMP SECND ;SEND SA AFTER LISTEN
Sekundäradresse nach LISTEN senden
send secondary address after LISTEN

send secondary address after TALK

this routine transmits a secondary address on the serial bus for a TALK device.
This routine must be called with a number between 4 and 31 in the accumulator.
The routine will send this number as a secondary address command over the serial
bus. This routine can only be called after a call to the TALK routine. It will
not work after a LISTEN.
  SECOND, send SA after LISTEN
read secondary address after listen
.,FF96 4C C7 ED JMP $EDC7 JMP TKSA ;SEND SA AFTER TALK
Sekundäradresse nach TALK senden
send secondary address after TALK

read/set the top of memory

this routine is used to read and set the top of RAM. When this routine is called
with the carry bit set the pointer to the top of RAM will be loaded into XY. When
this routine is called with the carry bit clear XY will be saved as the top of
memory pointer changing the top of memory.
  TKSA, send SA after TALK
read secondary address after talk
.,FF99 4C 25 FE JMP $FE25 JMP MEMTOP ;SET/READ TOP OF MEMORY
RAM-Ende setzen/holen
read/set the top of memory

read/set the bottom of memory

this routine is used to read and set the bottom of RAM. When this routine is
called with the carry bit set the pointer to the bottom of RAM will be loaded
into XY. When this routine is called with the carry bit clear XY will be saved as
the bottom of memory pointer changing the bottom of memory.
  MEMTOP, read/set top of memory
read/set top of memory
.,FF9C 4C 34 FE JMP $FE34 JMP MEMBOT ;SET/READ BOTTOM OF MEMORY
RAM-Anfang setzen/holen
read/set the bottom of memory

scan the keyboard

this routine will scan the keyboard and check for pressed keys. It is the same
routine called by the interrupt handler. If a key is down, its ASCII value is
placed in the keyboard queue.
  MEMBOT, read/set bottom of memory
read/set bottom of memory
.,FF9F 4C 87 EA JMP $EA87 JMP SCNKEY ;SCAN KEYBOARD
Tastatur abfragen
scan keyboard

set timeout on serial bus

this routine sets the timeout flag for the serial bus. When the timeout flag is
set, the computer will wait for a device on the serial port for 64 milliseconds.
If the device does not respond to the computer's DAV signal within that time the
computer will recognize an error condition and leave the handshake sequence. When
this routine is called and the accumulator contains a 0 in bit 7, timeouts are
enabled. A 1 in bit 7 will disable the timeouts.
NOTE: The the timeout feature is used to communicate that a disk file is not found
on an attempt to OPEN a file.
  SCNKEY, scan keyboard
scan keyboard
.,FFA2 4C 21 FE JMP $FE21 JMP SETTMO ;SET TIMEOUT IN IEEE
Time-out-Flag für IEC-Bus setzen
set timeout on serial bus

input byte from serial bus

this routine reads a byte of data from the serial bus using full handshaking. the
data is returned in the accumulator. before using this routine the TALK routine,
$FFB4, must have been called first to command the device on the serial bus to
send data on the bus. if the input device needs a secondary command it must be sent
by using the TKSA routine, $FF96, before calling this routine.
errors are returned in the status word which can be read by calling the READST
routine, $FFB7.
  SETTMO, set IEEE timeout
set timout for serial bus
.,FFA5 4C 13 EE JMP $EE13 JMP ACPTR ;HANDSHAKE IEEE BYTE IN
Eingabe vom IEC-Bus
input byte from serial bus

output a byte to serial bus

this routine is used to send information to devices on the serial bus. A call to
this routine will put a data byte onto the serial bus using full handshaking.
Before this routine is called the LISTEN routine, $FFB1, must be used to
command a device on the serial bus to get ready to receive data.
the accumulator is loaded with a byte to output as data on the serial bus. A
device must be listening or the status word will return a timeout. This routine
always buffers one character. So when a call to the UNLISTEN routine, $FFAE,
is made to end the data transmission, the buffered character is sent with EOI
set. Then the UNLISTEN command is sent to the device.
  ACPTR, input byte from serial bus
input on serial bus
.,FFA8 4C DD ED JMP $EDDD JMP CIOUT ;HANDSHAKE IEEE BYTE OUT
Ausgabe vom IEC-Bus
output byte to serial bus

command serial bus to UNTALK

this routine will transmit an UNTALK command on the serial bus. All devices
previously set to TALK will stop sending data when this command is received.
  CIOUT, output byte to serial bus
output byte on serial bus
.,FFAB 4C EF ED JMP $EDEF JMP UNTLK ;SEND UNTALK OUT IEEE
UNTALK senden
command serial bus to UNTALK

command serial bus to UNLISTEN

this routine commands all devices on the serial bus to stop receiving data from
the computer. Calling this routine results in an UNLISTEN command being transmitted
on the serial bus. Only devices previously commanded to listen will be affected.
This routine is normally used after the computer is finished sending data to
external devices. Sending the UNLISTEN will command the listening devices to get
off the serial bus so it can be used for other purposes.
  UNTALK, command serial bus UNTALK
send untalk on serial bus
.,FFAE 4C FE ED JMP $EDFE JMP UNLSN ;SEND UNLISTEN OUT IEEE
UNLISTEN senden
command serial bus to UNLISTEN

command devices on the serial bus to LISTEN

this routine will command a device on the serial bus to receive data. The
accumulator must be loaded with a device number between 4 and 31 before calling
this routine. LISTEN convert this to a listen address then transmit this data as
a command on the serial bus. The specified device will then go into listen mode
and be ready to accept information.
  UNLSN, command serial bus UNLSN
send unlisten on serial bus
.,FFB1 4C 0C ED JMP $ED0C JMP LISTN ;SEND LISTEN OUT IEEE
LISTEN senden
command devices on the serial bus to LISTEN

command serial bus device to TALK

to use this routine the accumulator must first be loaded with a device number
between 4 and 30. When called this routine converts this device number to a talk
address. Then this data is transmitted as a command on the Serial bus.
  LISTEN, command serial bus LISTEN
send listen on serial bus
.,FFB4 4C 09 ED JMP $ED09 JMP TALK ;SEND TALK OUT IEEE
TALK senden
command serial bus device to TALK

read I/O status word

this routine returns the current status of the I/O device in the accumulator. The
routine is usually called after new communication to an I/O device. The routine
will give information about device status, or errors that have occurred during the
I/O operation.
  TALK, command serial bus TALK
send talk on serial bus
.,FFB7 4C 07 FE JMP $FE07 JMP READSS ;RETURN I/O STATUS BYTE
Status holen
read I/O status word

set logical, first and second addresses

this routine will set the logical file number, device address, and secondary
address, command number, for other KERNAL routines.
the logical file number is used by the system as a key to the file table created
by the OPEN file routine. Device addresses can range from 0 to 30. The following
codes are used by the computer to stand for the following CBM devices:
ADDRESS DEVICE
======= ======
0 Keyboard
1 Cassette #1
2 RS-232C device
3 CRT display
4 Serial bus printer
8 CBM Serial bus disk drive
device numbers of four or greater automatically refer to devices on the serial
bus.
a command to the device is sent as a secondary address on the serial bus after
the device number is sent during the serial attention handshaking sequence. If
no secondary address is to be sent Y should be set to $FF.
  READST, read I/O status word
read I/O status word
.,FFBA 4C 00 FE JMP $FE00 JMP SETLFS ;SET LA, FA, SA
Fileparameter setzen
set logical, first and second addresses

set the filename

this routine is used to set up the file name for the OPEN, SAVE, or LOAD routines.
The accumulator must be loaded with the length of the file and XY with the pointer
to file name, X being th low byte. The address can be any valid memory address in
the system where a string of characters for the file name is stored. If no file
name desired the accumulator must be set to 0, representing a zero file length,
in that case XY may be set to any memory address.
  SETLFS, set logical file parameters
set file parameters
.,FFBD 4C F9 FD JMP $FDF9 JMP SETNAM ;SET LENGTH AND FN ADR
Filenamenparameter setzen
set the filename

open a logical file

this routine is used to open a logical file. Once the logical file is set up it
can be used for input/output operations. Most of the I/O KERNAL routines call on
this routine to create the logical files to operate on. No arguments need to be
set up to use this routine, but both the SETLFS, $FFBA, and SETNAM, $FFBD,
KERNAL routines must be called before using this routine.
  SETNAM, set filename
set filename parameters
.,FFC0 6C 1A 03 JMP ($031A) OPEN JMP (IOPEN) ;OPEN LOGICAL FILE
$F34A OPEN
do open a logical file

close a specified logical file

this routine is used to close a logical file after all I/O operations have been
completed on that file. This routine is called after the accumulator is loaded
with the logical file number to be closed, the same number used when the file was
opened using the OPEN routine.
  OPEN, open file
(F34A) open a file
.,FFC3 6C 1C 03 JMP ($031C) CLOSE JMP (ICLOSE) ;CLOSE LOGICAL FILE
$F291 CLOSE
do close a specified logical file

open channel for input

any logical file that has already been opened by the OPEN routine, $FFC0, can be
defined as an input channel by this routine. the device on the channel must be an
input device or an error will occur and the routine will abort.
if you are getting data from anywhere other than the keyboard, this routine must be
called before using either the CHRIN routine, $FFCF, or the GETIN routine,
$FFE4. if you are getting data from the keyboard and no other input channels are
open then the calls to this routine and to the OPEN routine, $FFC0, are not needed.
when used with a device on the serial bus this routine will automatically send the
listen address specified by the OPEN routine, $FFC0, and any secondary address.
possible errors are:
3 : file not open
5 : device not present
6 : file is not an input file
  CLOSE, close file
(F291) close a file
.,FFC6 6C 1E 03 JMP ($031E) CHKIN JMP (ICHKIN) ;OPEN CHANNEL IN
$F20E CHKIN Eingabeg. setzen
do open channel for input

open channel for output

any logical file that has already been opened by the OPEN routine, $FFC0, can be
defined as an output channel by this routine the device on the channel must be an
output device or an error will occur and the routine will abort.
if you are sending data to anywhere other than the screen this routine must be
called before using the CHROUT routine, $FFD2. if you are sending data to the
screen and no other output channels are open then the calls to this routine and to
the OPEN routine, $FFC0, are not needed.
when used with a device on the serial bus this routine will automatically send the
listen address specified by the OPEN routine, $FFC0, and any secondary address.
possible errors are:
3 : file not open
5 : device not present
7 : file is not an output file
  CHKIN, prepare channel for input
(F20E) set input device
.,FFC9 6C 20 03 JMP ($0320) CKOUT JMP (ICKOUT) ;OPEN CHANNEL OUT
$F250 CKOUT Ausgabegerät set.
do open channel for output

close input and output channels

this routine is called to clear all open channels and restore the I/O channels to
their original default values. It is usually called after opening other I/O
channels and using them for input/output operations. The default input device is
0, the keyboard. The default output device is 3, the screen.
If one of the channels to be closed is to the serial port, an UNTALK signal is sent
first to clear the input channel or an UNLISTEN is sent to clear the output channel.
By not calling this routine and leaving listener(s) active on the serial bus,
several devices can receive the same data from the VIC at the same time. One way to
take advantage of this would be to command the printer to TALK and the disk to
LISTEN. This would allow direct printing of a disk file.
  CHKOUT, prepare channel for output
(F250) set output device
.,FFCC 6C 22 03 JMP ($0322) CLRCH JMP (ICLRCH) ;CLOSE I/O CHANNEL
$F333 CLRCH Ein-Ausgabe zurücksetzen
do close input and output channels

input character from channel

this routine will get a byte of data from the channel already set up as the input
channel by the CHKIN routine, $FFC6.
If CHKIN, $FFC6, has not been used to define another input channel the data is
expected to be from the keyboard. the data byte is returned in the accumulator. the
channel remains open after the call.
input from the keyboard is handled in a special way. first, the cursor is turned on
and it will blink until a carriage return is typed on the keyboard. all characters
on the logical line, up to 80 characters, will be stored in the BASIC input buffer.
then the characters can be returned one at a time by calling this routine once for
each character. when the carriage return is returned the entire line has been
processed. the next time this routine is called the whole process begins again.
  CLRCHN, close all I/O
(F333) restore I/O devices to default
.,FFCF 6C 24 03 JMP ($0324) BASIN JMP (IBASIN) ;INPUT FROM CHANNEL
$F157 BASIN Eingabe eines Zeichens
do input character from channel

output character to channel

this routine will output a character to an already opened channel. Use the OPEN
routine, $FFC0, and the CHKOUT routine, $FFC9, to set up the output channel
before calling this routine. If these calls are omitted, data will be sent to the
default output device, device 3, the screen. The data byte to be output is loaded
into the accumulator, and this routine is called. The data is then sent to the
specified output device. The channel is left open after the call.
NOTE: Care must be taken when using routine to send data to a serial device since
data will be sent to all open output channels on the bus. Unless this is desired,
all open output channels on the serial bus other than the actually intended
destination channel must be closed by a call to the KERNAL close channel routine.
  CHRIN, inpup byte from channel
(F157) input char on current device
.,FFD2 6C 26 03 JMP ($0326) BSOUT JMP (IBSOUT) ;OUTPUT TO CHANNEL
$F1CA BSOUT Ausgabe eines Zeichens
do output character to channel

load RAM from a device

this routine will load data bytes from any input device directly into the memory
of the computer. It can also be used for a verify operation comparing data from a
device with the data already in memory, leaving the data stored in RAM unchanged.
The accumulator must be set to 0 for a load operation or 1 for a verify. If the
input device was OPENed with a secondary address of 0 the header information from
device will be ignored. In this case XY must contain the starting address for the
load. If the device was addressed with a secondary address of 1 or 2 the data will
load into memory starting at the location specified by the header. This routine
returns the address of the highest RAM location which was loaded.
Before this routine can be called, the SETLFS, $FFBA, and SETNAM, $FFBD,
routines must be called.
  CHROUT, output byte to channel
(F1CA) output char on current device
.,FFD5 4C 9E F4 JMP $F49E JMP LOADSP ;LOAD FROM FILE
LOAD
load RAM from a device

save RAM to a device

this routine saves a section of memory. Memory is saved from an indirect address
on page 0 specified by A, to the address stored in XY, to a logical file. The
SETLFS, $FFBA, and SETNAM, $FFBD, routines must be used before calling this
routine. However, a file name is not required to SAVE to device 1, the cassette.
Any attempt to save to other devices without using a file name results in an error.
NOTE: device 0, the keyboard, and device 3, the screen, cannot be SAVEd to. If
the attempt is made, an error will occur, and the SAVE stopped.
  LOAD, load from serial device
load ram from device
.,FFD8 4C DD F5 JMP $F5DD JMP SAVESP ;SAVE TO FILE
SAVE
save RAM to device

set the real time clock

the system clock is maintained by an interrupt routine that updates the clock
every 1/60th of a second. The clock is three bytes long which gives the capability
to count from zero up to 5,184,000 jiffies - 24 hours plus one jiffy. At that point
the clock resets to zero. Before calling this routine to set the clock the new time,
in jiffies, should be in YXA, the accumulator containing the most significant byte.
  SAVE, save to serial device
save ram to device
.,FFDB 4C E4 F6 JMP $F6E4 JMP SETTIM ;SET INTERNAL CLOCK
Time setzen
set real time clock

read the real time clock

this routine returns the time, in jiffies, in AXY. The accumulator contains the
most significant byte.
  SETTIM, set realtime clock
set real time clock
.,FFDE 4C DD F6 JMP $F6DD JMP RDTIM ;READ INTERNAL CLOCK
Time holen
read real time clock

scan the stop key

if the STOP key on the keyboard is pressed when this routine is called the Z flag
will be set. All other flags remain unchanged. If the STOP key is not pressed then
the accumulator will contain a byte representing the last row of the keyboard scan.
The user can also check for certain other keys this way.
  RDTIM, read realtime clock
read real time clock
.,FFE1 6C 28 03 JMP ($0328) STOP JMP (ISTOP) ;SCAN STOP KEY
$F6ED STOP-Taste abfragen
do scan stop key

get character from input device

in practice this routine operates identically to the CHRIN routine, $FFCF,
for all devices except for the keyboard. If the keyboard is the current input
device this routine will get one character from the keyboard buffer. It depends
on the IRQ routine to read the keyboard and put characters into the buffer.
If the keyboard buffer is empty the value returned in the accumulator will be zero.
  STOP, check <STOP> key
(F6ED) check stop key
.,FFE4 6C 2A 03 JMP ($032A) GETIN JMP (IGETIN) ;GET CHAR FROM Q
$F13E GET
do get character from input device

close all channels and files

this routine closes all open files. When this routine is called, the pointers into
the open file table are reset, closing all files. Also the routine automatically
resets the I/O channels.
  GETIN, get input from keyboard
(F13E) get a character
.,FFE7 6C 2C 03 JMP ($032C) CLALL JMP (ICLALL) ;CLOSE ALL FILES
$F32F CLALL
do close all channels and files

increment real time clock

this routine updates the system clock. Normally this routine is called by the
normal KERNAL interrupt routine every 1/60th of a second. If the user program
processes its own interrupts this routine must be called to update the time. Also,
the STOP key routine must be called if the stop key is to remain functional.
  CLALL, close all files and channels
(F32F) close all channels and files
.,FFEA 4C 9B F6 JMP $F69B JMP UDTIM ;INCREMENT CLOCK
Time erhöhen
increment real time clock

return X,Y organization of screen

this routine returns the x,y organisation of the screen in X,Y
  UDTIM, increment realtime clock
increment real time clock
.,FFED 4C 05 E5 JMP $E505 JSCROG JMP SCRORG ;SCREEN ORG
SCREEN Anzahl Zeilen und Spalten holen
return X,Y organization of screen

read/set X,Y cursor position

this routine, when called with the carry flag set, loads the current position of
the cursor on the screen into the X and Y registers. X is the column number of
the cursor location and Y is the row number of the cursor. A call with the carry
bit clear moves the cursor to the position determined by the X and Y registers.
  SCREEN, return screen organisation
read organisation of screen into XY
.,FFF0 4C 0A E5 JMP $E50A JPLOT JMP PLOT ;READ/SET X,Y COORD
Cursor setzen / Cursorposition holen
read/set X,Y cursor position

return the base address of the I/O devices

this routine will set XY to the address of the memory section where the memory
mapped I/O devices are located. This address can then be used with an offset to
access the memory mapped I/O devices in the computer.
  PLOT, read/set cursor X/Y position
read/set XY cursor position
.,FFF3 4C 00 E5 JMP $E500 JIOBAS JMP IOBASE ;RETURN I/O BASE
Startadresse des I/O-Bausteins holen
return the base address of the I/O devices

  IOBASE, return IOBASE address
read base address of I/O devices

unused

.:FFF6 52 52 42 59 *=$FFFA

Hardware Vektoren

RRBY

hardware vectors

 

SYSTEM HARDWARE VECTORS

This table contains jumpvectors for system reset, IRQ, and
NMI. The IRQ and NMI vectors points to addresses which
contains an indirect jump to RAM, to provide user defined
routines.
 
.:FFFA 43 FE .WOR NMI ;PROGRAM DEFINEABLE
NMI Vektor
NMI Vektor
    NMI vector
.:FFFC E2 FC .WOR START ;INITIALIZATION CODE
RESET Vektor
RESET Vektor
    RESET vector
.:FFFE 48 FF .WOR PULS ;INTERRUPT HANDLER
IRQ Vektor
IRQ Vektor
    IRQ/BRK vector