matt/pdp11-bbcbasic
1
0
Fork 0
mirror of https://github.com/MajenkoProjects/pdp11-bbcbasic.git synced 2026-08-23 12:11:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

Original import of base code

Browse Source
This commit is contained in:
Matt Jenkins
2026-05-12 14:27:05 +01:00
parent 87cdfeaf9a
commit 70995430ac
60 changed files with 15628 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
README.md
+9
View File
@@ -1,2 +1,11 @@
# pdp11-bbcbasic # pdp11-bbcbasic
BBC Basic for the PDP-11 BBC Basic for the PDP-11
This is a fork of the excellent BBC Basic interpreter for
PDP-11 by J. G. Harston. All credit for this work must
go to them. This is merely a few bugfixes and improvements.
Original code and information can be found here:
https://mdfs.net/Software/PDP11/BBCBasic/
bbc/basic.rom
BIN
View File
Binary file not shown.
bin/ansi
BIN
View File
Binary file not shown.
bin/basic
+1
View File
@@ -0,0 +1 @@
bbcbasic </dev/tty8 | ansi
bin/bbcbasic
BIN
View File
Binary file not shown.
bsd/ansi
BIN
View File
Binary file not shown.
bsd/basic
+1
View File
@@ -0,0 +1 @@
bbcbasic $@ | ansi
bsd/bbcbasic
BIN
View File
Binary file not shown.
demos/8queens
BIN
View File
Binary file not shown.
demos/clocksp
BIN
View File
Binary file not shown.
demos/colourgrid
BIN
View File
Binary file not shown.
demos/colours
BIN
View File
Binary file not shown.
demos/kbdtest
BIN
View File
Binary file not shown.
demos/mathspeed
BIN
View File
Binary file not shown.
demos/neobbc
BIN
View File
Binary file not shown.
demos/tinypdp
BIN
View File
Binary file not shown.
docs/bbcbasic.txt
+1200
View File
File diff suppressed because it is too large Load Diff
docs/keymap
+51
View File
@@ -0,0 +1,51 @@
PDP11 BBC BASIC Keymap
======================
Where it is possible to read function and editing keys, on non-Acorn systems they are
returned using a regular keymapping. Where keypad keys can be read they will be returned
as &100+x if read with ADVAL.
+===+=====+=====+===+====+===+====+====+====+=====+====+=====+=====+====+====+====+====+
| | x0 | x1 | x2| x3 | x4| x5 | x6 | x7 | x8 | x9 | xA | xB | xC | xD | xE | xF |
+===+=====+=====+===+====+===+====+====+====+=====+====+=====+=====+====+====+====+====+
|10x| | | | | | | | | | | | | |KPentr| | |
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
|12x| | | | | | | | | | | KP* | KP+ | KP,| KP-| KP.| KP/|
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
|13x| KP0 | KP1 |KP2| KP3|KP4| KP5| KP6| KP7| KP8 | KP9| | | | | | |
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
|18x| F0 | F1 | F2| F3 | F4| F5 | F6 | F7 | F8 | F9 | F10 | F11 | F12| F13| F14| F15|
| | Prnt| | | | | | | | | | | | | Num| Scr| Brk|
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
|19x| sF0 | sF1 |sF2|sF3 |sF4|sF5 | sF6| sF7| sF8 | sF9| sF10| sF11|sF12|sF13|sF14|sF15|
| |sPrnt| | | | | | | | | | | | |sNum|sScr|sBrk|
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
|1Ax| cF0 | cF1 |cF2|cF3 |cF4|cF5 | cF6| cF7| cF8 | cF9| cF10| cF11|cF12|cF13|cF14|cF15|
| |cPrnt| | | | | | | | | | | | |cNum|cScr|cBrk|
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
|1Bx| aF0 | aF1 |aF2|aF3 |aF4|aF5 | aF6| aF7| aF8 | aF9| aF10| aF11|aF12|aF13|aF14|aF15|
| |aPrnt| | | | | | | | | | | | |aNum|aScr|aBrk|
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
|1Cx| WinL| Menu| | | | | Ins| Del| Home| End| PgDn| PgUp| <- | -> | Dn | Up |
| |sWinR| | | | | | | | | | | | | | | |
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
|1Dx|sWinL|sMenu| | | |sTAB|sIns|sDel|sHome|sEnd|sPgDn|sPgUp| s<-| s->| sDn| sUp|
| | WinR| | | | | | | | | | | | | | | |
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
|1Ex|cWinL|cMenu| | | |cTAB|cIns|cDel|cHome|cEnd|cPgDn|cPgUp| c<-| c->| cDn| cUp|
| |aWinR| | | | | | | | | | | | | | | |
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
|1Fx|aWinL|aMenu| | | |aTAB|aIns|aDel|aHome|aEnd|aPgDn|aPgUp| a<-| a->| aDn| aUp|
| |cWinR| | | | | | | | | | | | | | | |
+---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+
INKEY and GET return an 8-bit value, ADVAL(127) returns a 16-bit value &100+key.
Whether particular keypresses are passed to BASIC depends on the particular platform. In
particular, some systems don't return distinct values for shift or ctrl pressed with a
key. For example, on some systems Shift-f1 onwards returns f11 onwards. This results in
the extension of the function keys from f11 onwards being duplicated as Shift-f1 onwards:
+-----+-----+-----+-----+ +-----+-----+-----+-----+ +-----+-----+-----+-----+ +-----+-----+-----+
key | f1 | f2 | f3 | f4 | | f5 | f6 | f7 | f8 | | f9 | f10 | f11 | f12 | |Print|Scrl |Break|
sft | f11 | f12 |Print|Scrl | |Break| Win | Menu|Japan| |Japan|Japan| f11 | f12 | |Print|Scrl |Break|
+-----+-----+-----+-----+ +-----+-----+-----+-----+ +-----+-----+-----+-----+ +-----+-----+-----+
docs/read.me
+32
View File
@@ -0,0 +1,32 @@
BBC BASIC for the PDP11
=======================
J.G.Harston, 70 Camm Street, Walkley, Sheffield, S6 3TR
mdfs.net/Software/PDP11/BBCBasic
Date: 10-May-2025
This is a PDP11 implementation of the BBC BASIC programming language. It
implements BBC BASIC IV, with a few additions from BBC BASIC V.
Communication with the host system is via Unix TRAP, RT11/RSTS EMT or Tube
EMT instructions.
BBC BASIC is started with 'bbcbasic', 'RUN BASIC' or 'BASIC'. *QUIT will
return to the calling process, *HELP will report the current host interface
version.
A filename may be passed on the command line, where it is loaded and run as
though CHAINed. If the first byte of a loaded file is '#' any following
bytes up to a control character are ignored, and any following data is
loaded as untokenised program code. This allows a text file to start with,
for example:
#! bbcbasic
On Unix you can pipe the output through a supplied 'ansi' command which will
translate output sequences to ANSI terminal control sequences, for example:
bbcbasic | ansi
Calls to BBC MOS entries at &FF00-&FFFF are translated to appropriate host
calls. [NOP] assembles a &A0 to identify the CPU as a PDP11.
docs/read2.me
+187
View File
@@ -0,0 +1,187 @@
BBC BASIC for the PDP11
=======================
Implementation Notes
Date: 10-May-2025
This is a PDP11 implementation of the BBC BASIC programming language. It
implements BBC BASIC IV, with a few additions from BBC BASIC V. It requires
a PDP11 with the MUL, XOR and SXT instructions, such as PDP11/23 or better.
BASIC V extensions
------------------
The following extensions are implemented:
=END =GET$#chn =MODE =QUIT
=REPORT$ =VDU n =^variable BPUT#chn,s$[;]
%binary &oOctal @Octal ERROR [EXT] n,s$
=STR$= =STR$/ COLOUR l,p COLOUR l,r,g,b
OFF ON SOUND OFF SOUND ON
GCOL c PLOT x,y QUIT [n] RUN s$
Implementation notes, v0.45
---------------------------
The following are not yet implemented:
* Negative and non-integer exponents (eg A=2E-4 and A=3^2.5)
* All Trig/Log: SIN COS TAN ASN ACS ATN DEG RAD EXP LOG LN real^ realSQR
* @% is ignored when converting numbers to string, float conversion is fixed
at &000009xx, that is General to 9 significant figures, integer is fixed
at &00000Axx, that is General to 10 digits.
* Real numbers larger than 999999999 do not print correctly.
LOCAL ERROR/DATA cannot be used inside FOR/NEXT or REPEAT/UNTIL loops. It
can only be used within PROC/FN immediately after any LOCAL variables. INPUT
acts the same as INPUT LINE.
The binary image ends with a &0000 word. An embedded BASIC program can be
appended to the binary image by replacing the &0000 word with the length of
the BASIC program, appending the empty workspace and the BASIC program to
the end of the image, and setting the "Initialised Data" word in the Unix
header to the size of the whole image including the BASIC program. This is
currently not implemented on RSTS/RT11.
Platform-Specific Information
=============================
All platform-specific operations are passed to a Host module. This can be
rewritten to target any other platform without touching the interpreter
itself.
PDP11 Unix
----------
When running on PDP11 Unix:
* OSBYTE 0,1 returns X=8, indicating filenames are '/directory/file.ext'.
* INKEY-256 returns &Bx to indicate a PDP11, with:
&B4 for Unix v4 &B5 for Unix v5 &B6 for Unix v6
&B7 for Unix v7 &B9 for BSD2.9 &BB for BSD2.11
* When using a Unix filing system OSARGS 0,0 returns 24.
The 'ansi' tool translates BBC VDU sequences to ANSI text positioning and
colour codes, so running 'bbcbasic | ansi' will allow ANSI text control
where supported. To support a graphics display a similar piped output tool
can be used.
Unix before version 7 does not return information from the seek() call, so
consequently, reading PTR, EXT and EOF do not work from BASIC.
Currently the BSD2.9 keyboard queue is not detected, so function/editing
keys are not correctly returned.
PDP11 RT11/RSTS
---------------
When running on RSTS/RT11/UKNC:
* INKEY-256 returns &B0 for "Generic PDP11" or &B1 for UKNC.
* OSBYTE 0,1 returns &2B to indicate 'd:fname.ext' filenames.
The RT11 HostIO interface includes a driver for ANSI text positioning and
colour supports the VT52, VT100 and UKNC/Electronica.
The RT11/RSTS OS interface currently only implements:
* LOAD, SAVE, CHAIN - implemented
* OPENIN, OPENOUT, OPENUP, CLOSE - implemented
* BGET, BPUT, GBPB - not yet implemented
* PTR, EXT, EOF - not yet implemented
* The only OSCLI/*command currently implemented is '*.'
VDU implementation
------------------
With BBC BASIC, VDU commands are send straight to the host's VDU driver. On
RT11/RSTS, or on Unix piping output through 'ansi', VDU control codes are
translated to the appropriate ANSI sequences to select text positioning and
colours. A lot of testing and experimentation has been done to work out the
best translation of VDU code to native control sequences to get as close an
implementation as possible.
VDU 0 - Null VDU 12 - CLS VDU 24
VDU 1,n - Raw output VDU 13 - Carriage return VDU 25
VDU 2 VDU 14 VDU 26
VDU 3 VDU 15 VDU 27
VDU 4 VDU 16 VDU 28
VDU 5 VDU 17,n - COLOUR n VDU 29
VDU 6 VDU 18 VDU 30 - HOME
VDU 7 - BELL VDU 19 VDU 31,x,y - TAB(x,y)
VDU 8 - LEFT VDU 20 - Select default colours VDU 127 - DELETE
VDU 9 - RIGHT VDU 21
VDU 10 - DOWN VDU 22,n - MODE n
VDU 11 - UP VDU 23
Where supported:
COLOUR &00+n sets the text foreground colour
COLOUR &40+n sets any extension colour
COLOUR &80+n sets the text background colour
COLOUR &C0+n sets the border colour
Colour numbers are the standard %LxxFIBGR.
VDU 1,n sends the character n directly to the host's TTYOUT output, bypassing
any VDU driver. VDU 27 can be used to introduce a host CSI sequence.
UKNC VDU driver
~~~~~~~~~~~~~~~
MODE n selects a 80x24, 40x24 or 20x24 screen mode:
0: 80x24 3: 80x24 6: 40x24
1: 40x24 4: 40x24 7: 40x24
2: 20x24 5: 20x24
The UKNC has 8 colours in every screen mode.
COLOUR &40+n sets the cursor colour.
VDU 14 selects Cyrillic characters, VDU 15 selects Latin characters.
Top-bit-set characters are sent directly to CONOUT bypassing the 7-bit filter
on TTYOUT, allowing the full character set and top-bit CSI sequences to be
used, eg VDU 27,164 to turn underline on.
Keyboard input
--------------
The keyboard mapping is that indicated by the Host OS value returned by
OSBYTE 0,1 and INKEY-256.
* For Hosts OS 0-7 it is the RISC OS "semi-regular" mapping:
function keys f0-f9 are &80-&89
function keys f10-f12 are &CA-&CC
editing keys are &8B-&8F for Copy,Left,Right,Down,Up
* For other hosts it is the "regular" mapping:
function keys are &80-&8F for f0 to f15
editing keys are &C6-&CF for Ins,Del,Home,End,PgDn,PgUp,Left,Right,Down,Up
* Shift and Ctrl modify the top-bit keycodes by XORing with &10 and &20.
Where supported by the hardware/operating system:
* EOF#0 returns FALSE if there are keypresses pending.
* ADVAL(-1) will return non-zero if there are entries in the keyboard buffer.
* ADVAL(127) will wait for and return a 16-bit keypress.
* INKEY(&8000+n) will wait up to n centiseconds and return a 16-bit keypress.
16-bit keypresses return &100+n for function and editing keys.
Escape processing
-----------------
Testing for the Escape key can be disabled with *ESC OFF and enabled with
*ESC ON. Only Unix v7 allows the Escape key to be tested in the background.
On Unix v6, Unix v5 and RT11 the Escape key has to be polled in the
foreground. To avoid slowing the interpreter excessively, this polling is
only done once every 256 tests. Testing has shown this slows the interpreter
down about 1%-2% compared to never checking for Escape. LIST checks for
Escape at the end of every displayed line.
Porting to other platforms
--------------------------
PDP11 BBC BASIC will run on any PDP11 platform. The interpreter communicates
with the platform it is running on via a platform-dependant Host module. BBC
BASIC can be ported to another platform by simply writing an appropriate
IOHost module and, if neccessary, a target-specific header. See the existing
UnixIO, TubeIO and RT11IO modules and headers as a starting point.
PDP11 CPU Requirements
----------------------
PDP11 BBC BASIC requires the PDP11 instructions: XOR, MUL, SXT, so this
requires a PDP11/23 or better. The Unix version of BASIC is written to run
on a minimum of PDP11 Unix Version 4, as it needs the indir() and signal()
system calls.
Machine code interface
----------------------
MOS calls to &FFxx are translated to the correct EMT or TRAP calls for the
host being run on. There is currently no built-in way to directly make EMT
or SYS calls, but you can do so by manually building a bit of code in memory
and calling it. For example, to call EMT 0 (OSQUIT) you could do:
!END=&878800:CALL END
This pokes EMT 0:RTS PC into memory just above the heap, then calls it. As
long as you do not create any new variables or strings between poking and
reading, data poked at END is unchanged between statements.
rt11/basic.sav
BIN
View File
Binary file not shown.
src/!MkAnsi
+8
View File
@@ -0,0 +1,8 @@
| Makes ansi VDU driver PDP11 Unix
|
*Dir <Obey$Dir>
*X Access ^.ansi wr/r
*/net::Software.PDP11.Assembler.AsmPDP ansi/mac ^.ansi ansi/lst
*Access ^.ansi r/r
*SetType ^.ansi FE6
*IfRetVal Error Assembly error
src/!MkAnsi.bat
+3
View File
@@ -0,0 +1,3 @@
cd /D %0\..
..\..\Assembler\AsmPDP ansi.mac ..\ansi ansi.lst
if ERRORLEVEL 1 pause
src/!MkAnsiBSD.bat
+3
View File
@@ -0,0 +1,3 @@
cd /D %0\..
..\..\Assembler\AsmPDP -DBSD ansi.mac ..\bsdansi ansi.lst
if ERRORLEVEL 1 pause
src/!MkBSD.bat
+6
View File
@@ -0,0 +1,6 @@
@rem Makes PDP-11 BBC BASIC for BSD2.11
@rem
@cd /D %0\..
..\..\Assembler\AsmPDP -DBSD211 MakeUnix ..\bsdbasic basic.lst
if ERRORLEVEL 1 pause
if NOT ERRORLEVEL 1 UpdSize ..\bsdbasic. logBSD.log
src/!MkRT11
+8
View File
@@ -0,0 +1,8 @@
| Makes PDP11 BBC BASIC with RT11 I/O, with listing output
|
*Dir <Obey$Dir>
*X Access ^.basicRT11 wr/r
*/net::Software.PDP11.Assembler.AsmPDP MakeRT11 ^.basic/sav basic/lst
*Access ^.basic/sav r/r
*SetType ^.basic/sav 1C5
*IfRetVal Error Assembly error
src/!MkRT11.bat
+6
View File
@@ -0,0 +1,6 @@
rem Makes PDP11 BBC BASIC with RT11 I/O
rem
cd /D %0\..
..\..\Assembler\AsmPDP MakeRT11 ..\basic.sav basic.lst -a
if ERRORLEVEL 1 pause
if NOT ERRORLEVEL 1 UpdSize ..\basic.sav logRT11.log
src/!MkTube
+8
View File
@@ -0,0 +1,8 @@
| Makes PDP11 BBC BASIC ROM for PDP11 Tube system, with BBC I/O only
|
*Dir <Obey$Dir>
*X Access ^.basic/rom wr/r
*/net::Software.PDP11.Assembler.AsmPDP MakeTube ^.basic/rom basic/lst
*Access ^.basic/rom r/r
*SetType ^.basic/rom BBC
*IfRetVal Error Assembly error
src/!MkTube.bat
+7
View File
@@ -0,0 +1,7 @@
rem Makes PDP11 BBC BASIC ROM for PDP11 Tube system, with BBC I/O
rem
cd /D %0\..
..\..\Assembler\AsmPDP MakeTube ..\basic.rom basic.lst
if ERRORLEVEL 1 pause
if NOT ERRORLEVEL 1 UpdSize ..\basic.rom logROM.log
exit
src/!MkUnix
+8
View File
@@ -0,0 +1,8 @@
| Makes PDP11 BBC BASIC with Unix I/O and BBC fall-back, with listing output
|
*Dir <Obey$Dir>
*X Access ^.bbcbasic wr/r
*/net::Software.PDP11.Assembler.AsmPDP MakeUnix ^.bbcbasic basic/lst
*Access ^.bbcbasic r/r
*SetType ^.bbcbasic FE6
*IfRetVal Error Assembly error
src/!MkUnix.bat
+6
View File
@@ -0,0 +1,6 @@
rem Makes PDP11 BBC BASIC with Unix I/O
rem
cd /D %0\..
..\..\Assembler\AsmPDP MakeUnix ..\bbcbasic basic.lst -a
if ERRORLEVEL 1 pause
if NOT ERRORLEVEL 1 UpdSize ..\bbcbasic. logUnix.log
src/AnsiKBD
+221
View File
@@ -0,0 +1,221 @@
; > AnsiKBD
; 28-Jul-2023 Seperating out and optimising ANSI keypress processing.
; 30-Jul-2023 New KBDTest routines, IO_Escape calls them.
; 31-Jul-2023 Optimised ANSI keypress processing.
; 01-Aug-2023 KBD_Test returns R0=pending, EQ/NE set.
; 10-Mar-2024 Tweeks for oddities in various PuTTY setttings and fkey overlaps.
#ifndef UKNCOK
#define UKNCOK 0
#endif
; Low-level read from TTYIN
; -------------------------
; Read from local key buffer and TTYIN, translate extended keypress sequences
; On exit: VS=No keypress
; VC=Key press returned
; R0=16-bit character code
;
;.KBD_TESTKEYBUF
;jsr pc,KBD_TestKey ; Test for keypress or get pending keypress
;beq KBD_GETKEYnokey ; No key pressed
.KBD_GETKEYBUF
jsr pc,KBD_WaitKey ; Get the pending keypress
cmpb r0,#27
beq KBD_GETKEYext ; <esc>, test for extended keypress
#ifdef KBDUPPER
cmpb r0,#ASC"a"
bcs KBD_GETKEYcheck
cmpb r0,#ASC"z"+1
bcc KBD_GETKEYcheck
bic #32,r0 ; Force to upper case
.KBD_GETKEYcheck
#endif
#ifdef KBDCRLF
cmpb r0,#13
beq KBD_GETKEYcr ; <cr>, swallow following <lf>
#endif
#ifdef UKNCADDR
cmp r0,#25 ; Test for UKNC cursor keys
bcs KBD_GETKEYok
cmp r0,#30
bcc KBD_GETKEYok
#if UKNCOK<0
tst @#UKNCADDR ; Look inside host's workspace
beq KBD_GETKEYok ; EQ=not UKNC
#else
cmp @#UKNCADDR,#UKNCOK ; Look inside host's workspace
bne KBD_GETKEYok ; NE=not UKNC
#endif
movb KBD_KEYUKNC-25(r0),r0 ; Translate cursor keys
#endif
.KBD_GETKEYok
bic #&FF00,r0 ; Remove any sign extension, V cleared, C unchanged
rts pc
#ifdef KBDCRLF
.KBD_GETKEYcr
jsr pc,KBD_WaitKey ; Swallow following <lf>, returns CC
mov #13,r0 ; Clears V
rts pc
#endif
.KBD_GETKEYesc
mov #27,r0 ; Clears V
rts pc
.KBD_GETKEYext ; <esc> - check for <nochar> or <char>
jsr pc,KBD_TestKeyDelay ; Test for keypress or get pending keypress
beq KBD_GETKEYesc ; <esc> <nochar>, return <esc>
jsr pc,KBD_WaitKey ; Get the keypress
cmpb r0,#27
beq KBD_GETKEYext ; <esc><esc> - doubled prefix, keep waiting
;
; Could be:
; <esc> '?' <@-7F> -> upper/lower case translation
; <esc> 'O' <@-7F> -> upper/lower case translation
; <esc> '[' (<nums>) <@-7F> -> parse sequence
; <esc> '[' '[' <@-4F> -> offset upper case translation
; <esc> <@-7F> -> upper case translation
;
mov r1,-(sp) ; Save R1
clr r1 ; Modifiers=0
cmpb r0,#ASC"["
beq KBD_GETKEYopen ; <esc>[(<nums>)<letter>
cmpb r0,#ASC"O"
beq KBD_GETKEYtwo ; <esc>O<letter>
cmpb r0,#ASC"?"
beq KBD_GETKEYtwo ; <esc>?<letter>
bcc KBD_GETKEYone ; <esc><letter>
.KBD_GETKEYnokeyPop
mov (sp)+,r1 ; Restore R1
.KBD_GETKEYnokey
sev
rts pc ; No keypress
.KBD_GETKEYsemi
swab r1 ; Swap key and modifier
; nb: <esc>[Z is sTAB via here
.KBD_GETKEYopen
jsr pc,KBD_WaitKey
cmpb r0,#ASC"["
beq KBD_GETKEYtwice ; <esc>[[A-E -> P-T
cmpb r0,#&3B
beq KBD_GETKEYsemi ; <num>;<num>
;cmpb r0,#ASC"0"
;bcs KBD_GETKEYnokeyPop ; <'0' - no key
cmpb r0,#ASC"9"+1
bcc KBD_GETKEYone ; >'9' - end of <num>
bic #&FFF0,r0 ; Reduce digit to 0-9
cmp r1,#&0100
bcc KBD_GETKEYadd
add r1,r1 ; *2
mov r1,-(sp)
add r1,r1 ; *4
add r1,r1 ; *8
add (sp)+,r1 ; r1=r1*10
.KBD_GETKEYadd
add r0,r1 ; r1=r1*10+r0
br KBD_GETKEYopen ; Get another digit
.KBD_GETKEYtwice
jsr pc,KBD_WaitKey
add #15,r0 ; Convert 'A'+ to 'P'+
.KBD_GETKEYone
;cmpb r0,#ASC"@"
;bcs KBD_GETKEYnokeyPop ; <'@' - no key
;cmpb r0,#&80
;bcc KBD_GETKEYnokeyPop ; >7F - no key
cmp r0,#ASC"~"
bne KBD_GETKEYctrl ; Not <esc>...~
;
; <esc>[~ - r1=0
; <esc>[<key>~ - r1=%0000 0000 00nn nnnn - 00 <key>
; <esc>[<key>;<mod>~ - r1=%00nn nnnn 0000 nnnn - <key> <mod>
cmp r1,#&0100
bcs KBD_GETKEYswap ; r1 is 00 <key>
swab r1 ; r1 now <mod> <key>
.KBD_GETKEYswap
movb r1,r0 ; r0=<key>
swab r1 ; r1 is <key> <mod>
add #KBD_KEYTABLE2-KBD_KEYTABLE1,r0
br KBD_GETKEYtable ; Translate and add modifiers
; nb: <esc>OZ is f11 via here
.KBD_GETKEYtwo
jsr pc,KBD_WaitKey ; <esc>O<letter> and <esc>?<letter>
cmp r0,#ASC"Z" ; Special case for <esc>OZ
bne KBD_GETKEYletter
movb #ASC"O",r0 ; Can't get 'O' via this route, so use it
;
; <esc><letter> - r1=0000
; <esc>[<mod><letter> - r1=%0000 0000 00nn nnnn - 00 <mod>
.KBD_GETKEYletter
bic #&FFC0,r0 ; Reduce to 0-63
cmp r0,#ASC" "
bcc KBD_GETKEYchar ; <esc>?<lowercase> -> keypad digit
.KBD_GETKEYctrl
bic #&FFE0,r0 ; Reduce to 0-31
.KBD_GETKEYtable
movb KBD_KEYTABLE1(r0),r0 ; Fetch from table
beq KBD_GETKEYnokeyPop ; No translation
bic #&FFF8,r1 ; Reduce modifier to 0-7
movb KBD_KEYTABLE3(r1),r1 ; Convert to XOR value
xor r1,r0 ; Modify keypress
.KBD_GETKEYchar
bic #&FF00,r0 ; Drop any sign extension
bis #&0100,r0 ; Return &0100+keycode
mov (sp)+,r1 ; Restore R1
rts pc
#ifdef UKNCADDR
.KBD_KEYUKNC
;UKNC Rgt Lft
EQUB &CD,&CC ; Overlaps next table
#endif
;
; <esc> x <esc> ? x <esc> O x <esc> [ x
.KBD_KEYTABLE1
; Up Dwn Rgt Lft Bgn End KP5
; @ A B C D E F G
EQUB &00,&CF,&CE,&CD,&CC,&C5,&C9,&07
;
; Hme cDn cRt KPent f11
; H I J K L M N O
EQUB &C8,&00,&EE,&ED,&0C,&0D,&00,&8B
;
; f1 f2 f3 f4 f5 f6 f6 f8
; P Q R S T U V W
EQUB &81,&82,&83,&84,&85,&86,&87,&88
;
; f9 f10 sTAB f12 f6 f8
; X Y Z [ \ ] ^~ _7F
EQUB &89,&8A,&D5,&8C,&8D,&8E,&86,&88
; nb: OZ is f11, [Z is sTAB
;
; <esc> [ num ~
.KBD_KEYTABLE2
; f6
; Del Hme Ins Del End PgUpPgDnHme End Num
; 00 01 02 03 04 05 06 07 08 09
EQUB &86,&C8,&C6,&C7,&C9,&CB,&CA,&C8,&C9,&8D
;
; f0 f1 f2 f3 f4 f5 f6 f7 f8
; 10 11 12 13 14 15 16 17 18 19
EQUB &80,&81,&82,&83,&84,&85,&00,&86,&87,&88
;
; Prn Scr Brk
; f9 f10 f11 f12 f13 f14 f15 f16
; 20 21 22 23 24 25 26 27 28 29
EQUB &89,&8A,&00,&8B,&8C,&80,&8E,&00,&8F,&C0
;
; Menu
; f17 f18 f19 f20
; 30 31 32 33 34
EQUB &00,&C1,&C2,&C3,&C4
;
.KBD_KEYTABLE3
; 0 1 2 3 4 5 6 7 modifier
; 0 1 2 3 4 5 6 bitmap
; non sft alt s+a ctl c+s c+a
EQUB &00,&00,&10,&30,&10,&20,&30,&20 ; XOR value
ALIGN
src/Assembler
+69
View File
@@ -0,0 +1,69 @@
; > Assembler
; BASIC assembler for the PDP11
; Any assembly code just assembles a NOP to identify the BASIC.
.cmdAssem
mov SV_INT_P,r0 ; Get P% to store assembly code
;bic #1,r0 ; Ensure even address
;mov #160,(r0) ; Just store a NOP for identification
movb #160,(r0)+ ; Just store a NOP for identification
clrb (r0)
.cmdAssemLp
movb (r5)+,r0 ; Step to ] or <cr>
cmpb r0,#ASC"]"
beq cmdAssemExit
cmpb r0,#13
bne cmdAssemLp
dec r5
.cmdAssemExit
rts pc
;; Only assembly implemented is:
;; NOP
;; EQUD &nnnn
;; OPT &nn - ignored
;
;.AssemCR
;dec r5
;.cmdAssem
;jsr pc,UpdateLPTR
;bcc AssemExit ; End of program
;movb (r5)+,r0
;cmpb r0,#13
;beq AssemCR ; Step to next line
;cmpb r0,#ASC"]"
;beq AssemExit ; ] - end of assembly
;bic #32,r0 ; Force to upper case
;clr r4 ; r4=0 - EQUW
;cmpb r0,#ASC"E" ; EQUW
;beq AssemWord
;dec r4 ; r4=-1 - OPT
;cmpb r0,#ASC"O" ; OPT
;beq AssemWord
;mov #160,r4 ; r4=160 - anything else is NOP
;.AssemWord
;movb (r5)+,r0
;cmpb r0,#ASC"A"
;bcc AssemWord ; Skip to non-letter
;dec r5
;cmp r4,#160
;beq AssemStore ; Store NOP
;.AssemEqu
;mov r4,-(sp) ; Save -1/0
;jsr pc,Evaluate
;mov (sp)+,r3
;bne cmdAssem ; EQ - OPT, skip
;.AssemStore
;mov SV_INT_P,r0 ; Get P% to store assembly code
;bic #1,r0
;mov r4,(r0)+ ; Store assembled word
;mov r0,SV_INT_P
;cmpb (r5)+,#ASC","
;bne AssemCR ; Not comma, step to next statement
;clr r4
;br AssemEqu ; Do another EQUW
;.AssemExit
;rts pc
src/Commands
+1967
View File
File diff suppressed because it is too large Load Diff
src/CommonIO
+424
View File
@@ -0,0 +1,424 @@
; > CommonIO
; Common host interface routines for hosts that do not implement BBC API functionality.
; 09-Apr-2024 Added *BASIC command
; OSCLI - Execute command
; =======================
; Built-in *commands
; ------------------
.IO_CLIcmds
;.UX_CLIcmds
equb &FF
equb "basic",&8E
equb "chdir",&86
equb "cd" ,&86
equb "esc" ,&8C
equb "fx" ,&80
equb "help" ,&82
equb "load" ,&88
equb "quit" ,&84
equb "save" ,&8A
;"run",&90
equb 0
align
.IO_CLIaddrs
equw IO_CLIhost ; *fx
equw CLIhelp ; *help
equw IO_QUIT0 ; *quit
equw CLIchdir ; *chdir, *cd
equw CLIload ; *load
equw CLIsave ; *save
equw CLIesc ; *esc
equw CLIbasic ; *basic
; OSCLI - Execute command
; =======================
; On entry, r0=>command string
; On exit, r0=return status
;
.IO_OSCLI
mov r1,-(sp) ; Save R1
.IO_CLIlp1
movb (r0)+,r1
cmpb r1,#ASC"*" ; Skip stars
beq IO_CLIlp1
cmpb r1,#ASC" " ; Skip spaces
beq IO_CLIlp1
cmpb r1,#13
beq IO_CLInull ; Null string
cmpb r1,#ASC"|"
beq IO_CLInull ; Comment
cmpb r1,#ASC"/"
beq IO_CLIexternal ; */filename
dec r0 ; Point back to non-space non-star char
mov r0,-(sp) ; Save address after '*'s and ' 's
mov r2,-(sp) ; Save R2
mov #IO_CLIcmds,r2 ; Point to command table
.IO_CLIlp2
tstb (r2)+
bpl IO_CLIlp2 ; Look for start of table entry
tstb (r2) ; End of command table?
bne IO_CLIcmd ; Not end, check if matching command
mov (sp)+,r2 ; Restore R2
mov (sp)+,r0 ; r0=>command string
.IO_CLIexternal
cmpb (r0)+,#ASC" " ; Skip any spaces after */
beq IO_CLIexternal
dec r0
jmp IO_CLIslash ; End of table or */, try passing to system()
.IO_CLIcmd
mov 2(sp),r0 ; Get start of command line
.IO_CLIlp3
movb (r0)+,r1 ; Get command line character
bis #&20,r1 ; Force to lower case
cmpb (r2)+,r1 ; Compare with table
beq IO_CLIlp3 ; Characters match, check next
dec r0 ; Point to non-matching command char
dec r2 ; Point to non-matching table char
cmpb (r0),#ASC"A" ; Check last character tested
bcc IO_CLIlp2 ; Not end of command string, try next command
movb (r2),r1
bpl IO_CLIlp2 ; Not end of table entry, try next one
mov (sp)+,r2 ; Restore R2
.IO_CLIlp4
cmpb (r0)+,#ASC" " ; Skip trailing spaces
beq IO_CLIlp4
dec r0
; Command matched
; r0=><cr> or <non-spc> after command
; r1=&80+n command number
; sp=>R0, R1
bic #&FF80,r1 ; Drop bit 7 and bit 0
mov IO_CLIaddrs(r1),r1
jsr pc,(r1) ; Errors never return
;bvs IO_CLIerror ; Restore and return with error
tst (sp)+ ; Drop start of command
.IO_CLInull
mov (sp)+,r1 ; Restore R1
clr r0 ; Return R0=Ok
rts pc
;.IO_CLIerror
;tst (sp)+ ; Drop start of command
;mov (sp)+,r1 ; Restore R1
;setv ; Set V
;rts pc
; Common commands
; ===============
; *help
; -----
.CLIhelp
mov #StartupMessage,r1
jsr pc,PrintR1
#ifdef RT11VER
jsr pc,PrintInline
equs "RT11 Host v"
equb ((RT11VER >> 8) AND 15)+48
equb "."
equb ((RT11VER >> 4) AND 15)+48
equb (RT11VER AND 15)+48
equb 13,0
align
#endif
.IO_CLIhost
#if OSNAME$="Unix"
#ifndef NOEMT
mov 2(sp),r0 ; Get R0=>command
emt 1 ; Pass on to host
#endif
#endif
rts pc
; *esc (on|off)
; -------------
.CLIesc
cmpb (r0)+,#ASC"@" ; Check for 'O'...
bcs CLIescOn
movb (r0),r1 ; Check for 'oN'.. or 'oF'...
; %1110 or %0110
.CLIescOn
rol r1 ; Move to bit 4
add #FLG_ESCAPE,r1 ; Toggle bit 4
bic #-FLG_ESCAPE-1,r1 ; Keep bit 4, N/F
bicb #FLG_ESCAPE,SV_SYS ; Remove bit 4 from flags
bisb r1,SV_SYS ; Insert into system flags
rts pc
; *basic
; ------
.CLIbasic
adr SV_STRING,r1
mov r0,r5
jsr pc,InsAddLine ; Copy any command line
mov SV_MEMTOP,r1 ; Get memory limits
mov SV_MEMBOT,r0
jmp Restart ; Restart
; *quit
; -----
;.CLIquit
;jmp IO_QUIT0
; *load
; -----
.CLIload
jsr pc,ScanAddrsR0
dec r0
bmi CLILoad1 ; *load name
beq CLILoad1 ; *load name addr
.jmpBadAddress
jmp errBadAddress
.CLILoad1
movb r0,MOS_BUF+6 ; &FF=use file's addr or &00=use supplied addr
mov #&FF,r0 ; R0=LOAD
.CLIFile
mov #MOS_BUF,r1
jmp IO_FILE ; Error will be caught before return
; *save
; -----
.CLIsave
jsr pc,ScanAddrsR0
cmp r0,#2 ; *save name
bcs jmpBadAddress ; *save name addr
cmp r0,#5
bcc jmpBadAddress ; *save too many addresses
clr r0 ; R0=SAVE
br CLIFile
; Scan a list of file addresses
; -----------------------------
.ScanHex2
mov #MOS_BUF+2,r1
.ScanHex
; Would this be smaller to do manually?
mov r0,-(sp)
mov r1,-(sp)
jsr pc,CheckHexNext
bcs jmpBadAddress
;
;; Call BASIC's evaluator
;; R0= first hex digit
;; R1=4 -> 4 bits per digit
;; R3=0 -> accumulator
;; R4=0 -> accululator
;; R5=> first digit, already checked
;mov #4,r1
;clr r3
;clr r4
;jsr pc,EvalHexGo
;; R3/R4=hex value
;; R5=>first non-hex character
;
; Call BASIC's evaluator
; R3=0 -> accumulator
; R4=0 -> accululator
; R5=> first digit, already checked
clr r3 ; Clear accumulator
clr r4
dec r5 ; Back up R5 to first digit
jsr pc,EvalHexGo
; R0/R1/R2 corrupted
; R3/R4=hex value
; R5=>first non-hex character
;
mov (sp)+,r1
mov r4,(r1)+
mov r3,(r1)
mov (sp)+,r0
.ScanHexSpc
cmpb (r5)+,#ASC" "
beq ScanHexSpc
dec r5
cmpb (r5),#13
rts pc
.ScanAddrsR0
mov r0,r1 ; r0=>command line
.ScanAddrs
mov r5,-(sp)
mov r4,-(sp)
mov r3,-(sp)
mov r2,-(sp)
mov r1,r5 ; r1=>command line
mov r1,MOS_BUF ; filename
jsr pc,SkipWord
clr r0
cmpb (r5),#13
beq ScanAddrsDone ; No addresses
inc r0
jsr pc,ScanHex2 ; BUF+2 = load
mov r4,MOS_BUF+6 ; BUF+6 = exec
mov r3,MOS_BUF+8
mov r4,MOS_BUF+10 ; BUF+10= start
mov r3,MOS_BUF+12
cmpb (r5),#13
beq ScanAddrsDone ; One address
inc r0
mov #MOS_BUF+14,r1
cmpb (r5),#ASC"+"
bne ScanHexEnd
inc r5
jsr pc,ScanHexSpc
jsr pc,ScanHex ; BUF+14=length
add MOS_BUF+10,r4
adc r3
add MOS_BUF+12,r3
mov r4,MOS_BUF+14
mov r3,MOS_BUF+16
cmpb (r5),#13
br ScanHexEnd2
.ScanHexEnd
jsr pc,ScanHex ; BUF+14=end
.ScanHexEnd2
beq ScanAddrsDone ; Two address
inc r0
mov #MOS_BUF+6,r1
jsr pc,ScanHex ; BUF+6 = exec
beq ScanAddrsDone ; Three address
inc r0
jsr pc,ScanHex2 ; BUF+2 = load
beq ScanAddrsDone ; Four address
inc r0 ; Five or more addresses
.ScanAddrsDone
mov (sp)+,r2
mov (sp)+,r3
mov (sp)+,r4
mov (sp)+,r5
rts pc
.SkipWord
cmpb (r5)+,#ASC"!"
bcc SkipWord
dec r5
br ScanHexSpc
; Support routines
; ================
; Get word from control block at r2 and add r3 to it, return r2=r2+4
; ------------------------------------------------------------------
.FetchAddStore
jsr pc,FetchWord
add r3,r1
adc r0 ; Continue into StoreWord
; Store &r0:r1 to unaligned buffer at r2, r1=lo r0=hi, corrupts r0/r1, return r2=r2+4
; -----------------------------------------------------------------------------------
.StoreWord
movb r1,(r2)+
swab r1
movb r1,(r2)+
movb r0,(r2)+
swab r0
movb r0,(r2)+
rts pc
; Fetch &r0:r1 from unaligned buffer at r2, r1=lo r0=hi, return r2=r2+4
; ---------------------------------------------------------------------
.FetchWord
jsr pc,FetchHalfWord
mov r0,-(sp)
jsr pc,FetchHalfWord
mov (sp)+,r1
rts pc
; Get 16-bit half-word from unaligned r2 to r0, return r2=r2+2
; ------------------------------------------------------------
.FetchHalfWord
movb (r2)+,r1
bic #&FF00,r1
movb (r2)+,r0
bic #&FF00,r0
swab r0
bis r1,r0
rts pc
; Read line of text
; -----------------
; On entry, R1=>address of memory to read string to
; On exit, R2=length of string
; CC=ok, CS=Escape pressed
;
; Could do in-line cursor movement
;
.IO_WORD0
mov r1,-(sp) ; Save pointer to control block
mov r3,-(sp) ; Save R3
mov r1,r2 ; r2=>control block
jsr pc,FetchWord ; Get pointer to text buffer to r1
clr r2 ; Zero number of characters read
.RdLnLoop
jsr pc,IO_RDCH ; Get a character
bcs RdLnEsc ; Escape state
cmp r0,#13
beq RdLnCR ; <CR> - End of line
cmp r0,#10
beq RdLnCR ; <LF> - End of line
cmp r0,#21
beq RdLnU ; Ctrl-U - delete line
cmp r0,#&C7
beq RdLnDel ; <DEL> - del a character
cmp r0,#127
beq RdLnDel ; <DEL> - del a character
cmp r0,#8
beq RdLnDel ; <BS> - del a character
cmp r0,#ASC" "
;bcs RdLnLoop ; Ignore other control characters
bcs RdLnIgnore ; Just echo other control characters
cmp r2,#240
bcc RdLnLoop ; No more room for characters
movb r0,(r1)+ ; Put character into memory
inc r2 ; Inc. number of characters
.RdLnIgnore
jsr pc,IO_WRCH ; Output the character
br RdLnLoop ; Go back for another
;
.RdLnU
mov r2,r3 ; We want to delete all characters
br RdLnDelete
.RdLnDel
mov #1,r3 ; We only want to delete one char
.RdLnDelete
mov #&2008,r0 ; Output <DEL> by backspacing
.RdLnDeleteLp
tst r2 ; Check line length
beq RdLnLoop ; Length=0, jump back to main loop
jsr pc,IO_WRCH ; <bs>
swab r0
jsr pc,IO_WRCH ; <spc>
swab r0
jsr pc,IO_WRCH ; <bs> again
;mov #8,r0 ; Output <DEL> by backspacing
;jsr pc,IO_WRCH
;mov #32,r0
;jsr pc,IO_WRCH
;mov #8,r0
;jsr pc,IO_WRCH
dec r1 ; Back address pointer
dec r2 ; Dec character counter
dec r3 ; Dec. number of DELs to do
bne RdLnDeleteLp ; Loop for each to delete
br RdLnLoop ; Go back into ReadLine loop
;
.RdLnCR
jsr pc,IO_NEWL ; Returns with r0=<cr>
movb r0,(r1) ; Put <CR> terminator in
clr r0 ; Restore R0, clear C
.RdLnEsc
.RdLnExit
mov (sp)+,r3 ; Restore R3
mov (sp)+,r1 ; Get buffer address back, clear V
rts pc ; r0=0, r1=buffer, r2=length
src/Debug
+306
View File
@@ -0,0 +1,306 @@
; > Debug
; Debug routines
; All registers preserved (except flags)
; Debug_Byte Output byte in R0 in hex
; Debug_Hex Output R0 in hex
; Debug_Oct Output R0 in octal
; Debug_Char Output R0 as character or dot
; Debug_DumpRegsOct Dump all registers in octal
; Debug_DumpRegsHex Dump all registers in hex
; Debug_DumpRegsFlags Dump flags and registers in hex (preserves flags)
; Debug_DumpLine Dump line at R5
; Debug_DumpMem Dump three lines of memory at R5 in hex
; Debug_DumpMemOne Dump one line of memory at R5 in hex
; Debug_DumpStack Dump one line of memory at SP in hex
; Requires:
; IO_WRCH - output character in R0
; IO_NEWL - output newline
; Print R0 as hex byte
; --------------------
.Debug_Byte
mov r0,-(sp)
jsr pc,Debug_hex1
br Debug_done
; Print R0 as hex word
; --------------------
.Debug_Hex
mov r0,-(sp)
jsr pc,Debug_hex2
br Debug_done
; Print R0 as octal word
; ----------------------
.Debug_Oct
mov r0,-(sp)
jsr pc,Debug_oct
br Debug_done
; Print R0 as character or dot
; ----------------------------
.Debug_Char
mov r0,-(sp)
bic #&FF80,r0
cmp r0,#127
beq Debug_CharDot
cmp r0,#32
bcc Debug_CharOk
.Debug_CharDot
mov #ASC".",r0
.Debug_CharOk
jsr pc,IO_WRCH
.Debug_done
mov (sp)+,r0
rts pc
; Dump registers
; --------------
.Debug_DumpRegsOct
mov r0,-(sp)
jsr pc,Debug_octSpc
mov r1,r0
jsr pc,Debug_octSpc
mov r2,r0
jsr pc,Debug_octSpc
mov r3,r0
jsr pc,Debug_octSpc
mov r4,r0
jsr pc,Debug_octSpc
mov r5,r0
jsr pc,Debug_octSpc
mov r6,r0
add #4,r0
jsr pc,Debug_oct
.Debug_newl
jsr pc,IO_NEWL
mov (sp)+,r0
rts pc
; Dump registers and flags
; ------------------------
.Debug_DumpRegsFlags
mfps -(sp)
mov r0,-(sp)
;
mov #ASC"M",r0
bit #8,2(sp)
jsr pc,Debug_flag
;
mov #ASC"Z",r0
bit #4,2(sp)
jsr pc,Debug_flag
;
mov #ASC"V",r0
bit #2,2(sp)
jsr pc,Debug_flag
;
mov #ASC"C",r0
bit #1,2(sp)
jsr pc,Debug_flag
;
jsr pc,Debug_spc
mov (sp)+,r0
jsr pc,Debug_DumpRegsHex
mtps (sp)+
rts pc
.Debug_flag
bne Debug_flag2
mov #ASC"-",r0
.Debug_flag2
jmp IO_WRCH
; Dump registers
; --------------
.Debug_DumpRegsHex
mov r0,-(sp)
jsr pc,Debug_hexSpc
mov r1,r0
jsr pc,Debug_hexSpc
mov r2,r0
jsr pc,Debug_hexSpc
mov r3,r0
jsr pc,Debug_hexSpc
mov r4,r0
jsr pc,Debug_hexSpc
mov r5,r0
jsr pc,Debug_hexSpc
mov r6,r0
add #4,r0
jsr pc,Debug_hex2
br Debug_newl
; Dump line at R5
; ---------------
.Debug_DumpLine
mov r0,-(sp) ; push r0
mov r5,-(sp) ; push r5
;
.Debug_LineLp1
movb (r5)+,r0
jsr pc,Debug_hex1
jsr pc,Debug_spc
cmpb -3(r5),#13
bne Debug_LineLp1
jsr pc,IO_NEWL
;
mov (sp),r5 ; get r5 back
.Debug_LineLp2
jsr pc,Debug_spc
movb (r5)+,r0
jsr pc,Debug_Char
jsr pc,Debug_spc
cmpb -3(r5),#13
bne Debug_LineLp2
jsr pc,IO_NEWL
;
mov (sp)+,r5 ; restore R5
mov (sp)+,r0 ; restore R0
rts pc
; Dump stack
; ----------
.Debug_DumpStack
mov r5,-(sp)
mov sp,r5
add #4,r5
jsr pc,Debug_DumpMemOne
mov (sp)+,r5
rts pc
; Dump one line of memory at R5
; -----------------------------
.Debug_DumpMemOne
mov r0,-(sp) ; push r0
mov r1,-(sp) ; push r1
mov r2,-(sp) ; push r2
mov r5,-(sp) ; push r5
mov r5,-(sp) ; push r5
mov #1,r2 ; Dump one line
br Debug_MemLp0
; Dump three lines of memory at R5
; --------------------------------
.Debug_DumpMem
mov r0,-(sp) ; push r0
mov r1,-(sp) ; push r1
mov r2,-(sp) ; push r2
mov r5,-(sp) ; push r5
mov r5,-(sp) ; push r5
;
mov #3,r2 ; Dump three lines
.Debug_MemLp0
mov r5,r0
jsr pc,Debug_hexSpc
mov #16,r1 ; Dump 16 bytes
.Debug_MemLp1
movb (r5)+,r0
jsr pc,Debug_hex1
jsr pc,Debug_spc
dec r1
bne Debug_MemLp1
jsr pc,IO_NEWL
;
jsr pc,Debug_spc
jsr pc,IO_WRCH
jsr pc,IO_WRCH
jsr pc,IO_WRCH
jsr pc,IO_WRCH
mov (sp),r5 ; get r5 back
mov #16,r1
.Debug_MemLp2
jsr pc,Debug_spc
movb (r5)+,r0
jsr pc,Debug_Char
jsr pc,Debug_spc
dec r1
bne Debug_MemLp2
jsr pc,IO_NEWL
;
mov r5,(sp)
dec r2
bne Debug_MemLp0
mov (sp)+,r5 ; pop R5
mov (sp)+,r5 ; pop R5
mov (sp)+,r2 ; pop R2
mov (sp)+,r1 ; pop R1
mov (sp)+,r0 ; pop R0
rts pc
; Print R0 in oct, followed by a space
; ------------------------------------
.Debug_octSpc
jsr pc,Debug_oct
br Debug_spc
; Print R0 in hex, followed by a space
; ------------------------------------
.Debug_hexSpc
jsr pc,Debug_hex2
; Print a space
; -------------
.Debug_spc
mov #32,r0
jmp IO_WRCH
.Debug_hex2
mov r0,-(sp)
swab r0
jsr pc,Debug_hex1
mov (sp)+,r0
.Debug_hex1
mov r0,-(sp)
ror r0
ror r0
ror r0
ror r0
jsr pc,Debug_nybble
mov (sp)+,r0
.Debug_nybble
bic #&FFF0,r0
cmp #9,r0
bcc Debug_digit
add #7,r0
br Debug_digit
.Debug_octdigit6
ror r0
ror r0
.Debug_octdigit4
ror r0
.Debug_octdigit3
ror r0
ror r0
.Debug_octdigit1
ror r0
.Debug_octdigit
bic #&FFF8,r0
.Debug_digit
add #48,r0
jmp IO_WRCH
.Debug_oct
mov r0,-(sp)
bic #&8000,r0
rol r0
rol r0
jsr pc,Debug_octdigit ; %Dxxxxxxxxxxxxxxx
mov (sp),r0
swab r0
jsr pc,Debug_octdigit4 ; %xDDDxxxxxxxxxxxx
mov (sp),r0
swab r0
jsr pc,Debug_octdigit1 ; %xxxxDDDxxxxxxxxx
mov (sp),r0
jsr pc,Debug_octdigit6 ; %xxxxxxxDDDxxxxxx
mov (sp),r0
jsr pc,Debug_octdigit3 ; %xxxxxxxxxxDDDxxx
mov (sp)+,r0
br Debug_octdigit ; %xxxxxxxxxxxxxDDD
src/Errors
+68
View File
@@ -0,0 +1,68 @@
; > Errors
; Error numbers and messages
; Not used
; 0 No room
; 0 STOP
; 1 Branch out of range
; 2 Bad immediate/address/shift
; 3 Bad index/register/label
; 4 Mistake
; 4 Missing =
; 5 Missing ,
; 6 Type mismatch
; 7 Not in a function
; 8 $ range
; 9 Missing "
; 10 Bad DIM
; 11 DIM space
; 12 Not LOCAL
; 13 Not in a PROC
; 14 Array
; 15 Subscript
; 16 Syntax error
; 17 Escape
; 18 Division by zero
; 19 String too long
; 20 Too big
; 21 -ve root
; 22 Log range
; 23 Accuracy lost
; 24 Exp range
; 25 Bad MODE
; 26 No such variable
; 27 Missing )
; 28 Bad HEX, OCT or BIN
; 29 No such FN/PROC
; (30 Bad call)
; 31 Arguments
; 32 Not in a FOR loop
; 33 Can't match FOR
; 34 Bad FOR variable
; (35 Bad STEP) 35 Too many FORs
; 36 Missing TO
; 37 Too many GOSUBs, No room for FN/PROC call
; 38 No GOSUB
; 39 ON syntax
; 40 ON range
; 41 No such line
; 42 Out of DATA
; 43 No REPEAT
; 44 Too many REPEATs, Too many nested structures
; 45 Missing #
; (54 ERROR/DATA not LOCAL)
; 192 C0 Can't save file
; 198 C6 Disk full
; 202 CA Data lost (Read error, Write error)
; 214 D6 File not found
; 223 DF End of file
; 240 F0 Undefined instruction
; 241 F1 Breakpoint (Abort on instruction fetch)
; 242 F2 Bad memory access (Abort on data transfer)
; 243 F3 Bad word access (Address exception)
; 244 F4 Unknown IRQ
;(245 F5 Branch through zero)
; 252 FC Bad address
; 254 FE Bad command
src/Evaluate
+869
View File
@@ -0,0 +1,869 @@
; > Evaluate
; BASIC expression evaluator
; 30-Aug-2008: Recursive Expression Evaluator and binary operator dispatch written
; 01-Sep-2008: Hex values, double quotes, octal values
; 03-Mar-2009: 31-bit decimal numbers working
; 15-Jun-2010: Parsing comparisons done
; 25-Jun-2013: FloatToInteger written, convert to &80000000 working.
; Bug: FloatToInt should round negative numbers down, INT(-PI) should be -4.
; 15-Aug-2013: ABS moved here with speeded up Negate
; 20-Nov-2013: Evaluate checks free memory before starting
; 09-Dec-2013: AddressOf skips any following () to allow ^PROCname(), ^FNname()
; 28-Jul-2016: Evaluator uses some (r5)+ instead of (r5)/inc, optimised bne/rts pairs
; 29-Jul-2016: INT(negative) rounds down, INT(-PI) is -4.
; 31-Jul-2016: Scanning fractional decimals and exponential decimals implemented.
; E<num> scanned but fnPower only implements positive exponents.
; 07-Aug-2016: EnsureInt preserves r0/r1, -0 to -1 correctly rounds to -1.
; Bug: now causes A=-7/2:A%=A to round incorrectly.
; 09-Jul-2016: EnsureInteger truncates, INT rounds downwards.
; Bug: EvalDecimal fails with num>10e9 unless E format used.
; 16-Mar-2021: EvalDecimalVAL correctly returns 0 for non-numbers.
; EvalDecimalPrefix and EvalDecimalVAL can't merge as VAL allows spaces, E+num doesn't.
; 18-Mar-2024: EvalHash corrected to EvalHashVal. Added @octal.
; 10-May-2025: Optimised Bin/Oct/Hex constants.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Check for syntax character and evaluate following expression ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Check for and step past ')'
; ===========================
.CheckClose
jsr pc,SkipSpaceNext ; This ; Next
.CheckClose1
cmpb r0,#ASC")"
beq CheckOk
.errMissingClose
jsr pc,Error
equb 27,tknMissing,")",0
align
; Check for and step past ','
; ===========================
.CheckComma
jsr pc,SkipSpaceNext ; This ; Next
cmpb r0,#ASC","
beq CheckOk
.errMissingComma
jsr pc,Error
equb 5,tknMissing,44,0
align
; Check for ',' evaluate and return following integer
; ===================================================
.EvalComma
jsr pc,CheckComma
br EvalInteger
; Check for and step past '='
; ===========================
.CheckEqual
jsr pc,SkipSpaceNext ; This ; Next
.CheckEqual1
cmpb r0,#ASC"="
beq CheckOk
;bne errMissingEqual
;.CheckOk
;inc r5
;rts pc
.errMissingEqual
jsr pc,Error
equb 4,tknMissing,"=",0
align
; Fetch next and check for <,=,>
; ==============================
.CheckCompare
movb (r5),r0
cmpb r0,#ASC"<"
beq ChkCmpOk
cmpb r0,#ASC"="
beq ChkCmpOk
cmpb r0,#ASC">"
.ChkCmpOk
.CheckOk
rts pc
; Check for '=', evaluate and return following integer
; ====================================================
.EvalEqual
jsr pc,CheckEqual
br EvalInteger
; Check for '#', evaluate and return following integer expression
; ===============================================================
;.EvalHash
;jsr pc,SkipSpaceNext
;cmpb r0,#ASC"#"
;beq EvalInteger
;.errMissingHash
;jsr pc,Error
;equb 45,tknMissing,"#",0
;align
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Evaluate expression and check for expected returned type ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; INT - convert to integer, rounding down if negative
; ===================================================
.fnINT
jsr pc,EvalNumVal ; Evaluate numeric value
beq EnsureIntOk ; Already an integer
tst -(sp) ; Stack dummy value
mov #&7FFF,r1 ; r1=nothing to round yet
br EnsureInteger2 ; Convert and round down
; EvalInteger - Evaluate numeric expression and return integer
; ============================================================
.EvalInteger1
inc r5 ; Step past prefix character
.EvalInteger
jsr pc,EvalNumeric ; Call expression evaluator
; Fall through to convert float to integer
; EnsureInteger - If float, denormalise into an integer
; =====================================================
; On entry, r2/r3/r3=value
; On exit, r2/r3/r4=integer value, flags set from r2
; r0/r1 preserved
;
; Conversion to integer truncates, so +3.5 -> +3, -3.5 -> -3
; The INT function rounds downwards, so +3.5 -> +3, -3.5 -> -4
;
.EnsureInteger
tst r2 ; Check if float
beq EnsureIntOk ; Already an integer
bmi errTypeMismatch ; Error if a string
mov r1,-(sp) ; Save R1
clr r1 ; r1=fraction count, prevent rounding
.EnsureInteger2
;
; To convert float to integer we repeatedly divide the mantissa by 2
; while incrementing the exponent, which multiplies the number by 2,
; so the value remains the same. This loops until the mantissa is &9F,
; which is an exponent of +31. At this point the mantissa will be the
; binary value of the integer version of the float.
;
sub #&9F,r2 ; Reduce exponent
bcs EnsureIntNotBig ; Exponent<&9F, 2^31+x or smaller, ok
bne EnsureIntTooBig ; Exponent>&9F, 2^32 or bigger, too big to convert
tst r4 ; Exponent=&9F, check for mantissa=&80000000
bne EnsureIntTooBig ; &9F,&....XXXX, too big
cmp r3,#&8000
beq EnsureIntDone ; &9F,&80000000 is only convertable &9F value
.EnsureIntTooBig
jmp errTooBig ; ABS(float) is 2^32 or bigger, too big to convert
.EnsureIntNotBig
mov r3,-(sp) ; Save sign bit
bis #&8000,r3 ; Put top bit in
clc
.EnsureIntLp
ror r3 ; Will always divide at least once
ror r4 ; Divide mantissa by two
adc r1 ; Add fractional bits, clear carry
inc r2 ; Increment exponent to multiply by two
bne EnsureIntLp ; Loop until exp=+32
tst (sp)+ ; Test sign bit
bpl EnsureIntDone ; Positive number, return it
jsr pc,NegateInteger ; Negate negative number
cmp #&8000,r1 ; Is there anything to round
sbc r4 ; Round negative number down for INT
sbc r3
.EnsureIntDone
mov (sp)+,r1 ; Restore R1
tst r2 ; Set flags from type=int
.EnsureIntOk
rts pc
; EvalFloatVal - Evaluate real value
; ==================================
.EvalFloatVal
jsr pc,EvalNumVal ; Call level 1 expression evaluator
;br EnsureFloat ; Fall through to convert to float
; EnsureFloat - If integer, normalise into a float
; ================================================
; On entry, r2/r3/r3=value
; On exit, r2/r3/r4=float value, flags set from r2, EQ=zero, NE=non-zero
; r0/r1 preserved
;
.EnsureFloat
tst r2
bne EnsureFloatDone ; Already a float
.IntegerToFloat
bis r3,r2
bis r4,r2
beq EnsureFloatDone ; Zero, no float representation, return
;
; int 00, 00 00 00 01
; float 80, 80 00 00 00, then remove sign
;
; int 00, 00 00 01 00
; float 88, 80 00 00 00, then remove sign
;
; int 00, 40 00 00 00
; float 9F, 80 00 00 00, then remove sign
;
; int 00, FF FF FF FF
; float 80, 80 00 00 00, then remove sign
;
mov r3,-(sp) ; Test and stack sign
bpl EnsureFloatPlus ; Positive number, convert it
jsr pc,NegateInteger ; Negate negative number
.EnsureFloatPlus
mov #&9F,r2 ; Initial exponent
.EnsureFloatLp
;bit #&8000,r3 ; Has top bit moved to top?
;bne EnsureFloat2
tst r3 ; Has top bit moved to top?
bmi EnsureFloat2
clc ; previous TST clears Carry
rol r4 ; Double mantissa
rol r3
dec r2 ; Decrement exponent
br EnsureFloatLp ; Loop until top bit set
.EnsureFloat2
tst (sp)+ ; Unstack and test sign
bmi EnsureFloat3 ; Negative, leave top bit set
bic #&8000,r3 ; Remove implied top bit
.EnsureFloat3
tst r2 ; Set flags
.EnsureFloatDone
rts pc
; EvalNumeric - Evaluate numeric expression
; =========================================
.EvalNumeric
jsr pc,Evaluate ; Call expression evaluator
bmi errTypeMismatch ; Returned string, we wanted a number
rts pc
; EvalString - Evaluate string expression
; =======================================
.EvalString
jsr pc,Evaluate ; Call expression evaluator
bpl errTypeMismatch ; Returned number, we wanted a string
rts pc
; EvalStringCR - Evaluate string expression and return CR-terminated
; ==================================================================
; On exit, r4=>cr-string with leading spaces skipped
; r3=string length with <cr>
;
.EvalStringCR
jsr pc,EvalString ; Call expression evaluator
.EvalStoreCR
bit #&0100,r2
bne EvalStringCRlp ; Already <cr>-string
.EvalStoreCRString
mov r3,-(sp) ; Save length
;mov r3,r2 ; r2=length
;mov r4,r3 ; r3=source string
;jsr pc,CopyString ; Copy to string buffer
jsr pc,EnsureString ; Copy to string buffer
mov (sp)+,r3 ; Get length back
add r4,r3 ; r3=>end of string
movb #13,(r3) ; Put terminating CR in
sub r4,r3 ; Restore r3=length
.EvalStringCRlp
dec r3 ; Decrement length for leading spaces
cmpb (r4)+,#ASC" "
beq EvalStringCRlp ; Skip leading spaces
dec r4 ; Point back to first non-space character
inc r3 ; Balance extra dec r3
inc r3 ; Add <cr> to length
rts pc
; EvalStrValCR - Evaluate string value and return CR-terminated
; =============================================================
.EvalStrValCR
jsr pc,EvalLevel1 ; Call level 1 expression evaluator
bmi EvalStoreCR ; Returned string, put terminating CR in
.errTypeMismatch
jsr pc,Error
equb 6,"Type mismatch",0
align
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; Evaluate value and check for expected returned type ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Check for '#', evaluate and return following integer value
; ==========================================================
; Handles are a value, not an expression, so that PTR#n+1 is
; (PTR#n)+1 and not PTR#(n+1).
;
.EvalHashVal
jsr pc,SkipSpaceNext
cmpb r0,#ASC"#"
beq EvalIntVal
.errMissingHash
jsr pc,Error
equb 45,tknMissing,"#",0
align
; EvalIntVal - Evaluate integer value
; ===================================
.EvalHashInt1
inc r5 ; Step past '#'
.EvalIntVal
jsr pc,EvalNumVal ; Call level 1 expression evaluator
br EnsureInteger ; If float, convert to integer
; EvalNumVal - Evaluate numeric value
; ====================================
.EvalNumVal
jsr pc,EvalLevel1 ; Call level 1 expression evaluator
bmi errTypeMismatch ; Returned string, we wanted a number
rts pc
; EvalStrVal - Evaluate string value
; ==================================
.EvalStrVal
jsr pc,EvalLevel1 ; Call level 1 expression evaluator
bpl errTypeMismatch ; Returned number, we wanted a string
rts pc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; EXPRESSION EVALUATOR ;;
;; -------------------- ;;
;; Recursively calls seven expression levels, evaluating expressions at ;;
;; each level, looping within each level until all operators at that ;;
;; level are exhausted. ;;
;; ;;
;; On entry, r5=>start of expression to evaluate ;;
;; On exit, r5=>first character after evaluated expression ;;
;; r4/r3/r2=returned value, flags set from r2 ;;
;; MI, r2=&80xx - dynamic string, r3=length, r4=start ;;
;; MI, r2=&81xx - <cr>-string, r3=length, r4=start ;;
;; MI, r2=&82xx - <null>-string, r3=length, r4=start ;;
;; PL, r2=&00xx - number ;;
;; PL, EQ, r2=&0000 - integer, r3=b31-b16, b4=b15-b0 ;;
;; PL, NE, r2=&00xx - real, r2=exponent, ;;
;; r3=mantissa b31-b16, r4=mantissa b15-b0 ;;
;; ;;
;; Within the evaluator, r0 and (r5)=next matched character ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
.Evaluate1
inc r5 ; Step past current character
.Evaluate
jsr pc,CheckFreeMemory
; Evaluator Level 7 - OR, EOR
; ===========================
.EvalLevel7
jsr pc,EvalLevel6 ; Call level 6 - AND
.EvalLevel7More
movb (r5),r0
cmpb r0,#tknOR
beq EvalOR
cmpb r0,#tknEOR
beq EvalEOR
tst r2 ; Set flags from result type
rts pc
.EvalOR
.EvalEOR
inc r5 ; Step past current character
jsr pc,StackIntAndOp
jsr pc,EvalLevel6 ; Evaluate RHS parameter
jsr pc,UnstackIntAndCallOp
;movb (r5),r0
br EvalLevel7More ; Loop to check for more OR/EOR
; Evaluator Level 6 - AND
; =======================
.EvalLevel6
jsr pc,EvalLevel5 ; Call level 5 - < <= = >= > <>
.EvalLevel6More
;movb (r5),r0
movb (r5)+,r0
cmpb r0,#tknAND
;bne EvalDone
bne EvalDoneDec
;beq EvalAND
;rts pc
;.EvalAND
;inc r5 ; Step past current character
jsr pc,StackIntAndOp
jsr pc,EvalLevel5 ; Evaluate RHS parameter
jsr pc,UnstackIntAndCallOp
;movb (r5),r0
br EvalLevel6More ; Loop to check for more AND
; Evaluator Level 5 - < <= = >= > <>
; ==================================
.EvalLevel5
jsr pc,EvalLevel4 ; Check for +, -
jsr pc,CheckCompare ; Fetch character and check for <,=,>
bne EvalDone
;beq EvalCompare
;rts pc
;.EvalCompare
mov r0,r1 ; Save first character in R1
inc r5 ; Step to next character
jsr pc,CheckCompare ; Fetch and check for <,=,>
bne EvalCompare1 ; Not <=, >=, <>, jump to to <,=,>
cmp r0,r1 ; Is it <<, ==, >>
beq errSyntax2
inc r5 ; Step past second character
add r0,r1 ; Combine to form offset value
.EvalCompare1
bis #&70,r1 ; r1=79..7E for <=..>
mov r1,r0 ; r0=operator
jsr pc,StackValAndOp
jsr pc,EvalLevel4 ; Evaluate RHS paraneter
jsr pc,UnstackValAndCallOp
rts pc
.errSyntax2
jmp errSyntax
; Evaluator Level 4 - + -
; =======================
.EvalLevel4
jsr pc,EvalLevel3 ; Call level 3 - * / DIV MOD
.EvalLevel4More
;movb (r5),r0 ; Get current character
movb (r5)+,r0 ; Get current character
cmpb r0,#ASC"+"
beq EvalPlus
cmpb r0,#ASC"-"
;bne EvalDone
bne EvalDoneDec
;beq EvalMinus
;rts pc ; Return
.EvalPlus
.EvalMinus
;inc r5 ; Step past current character
jsr pc,StackValAndOp
jsr pc,EvalLevel3 ; Evaluate RHS parameter
jsr pc,UnstackValAndCallOp
;movb (r5),r0 ; Get current character
br EvalLevel4More ; Loop to check for more + -
; Evaluator Level 3 - * / DIV MOD
; ===============================
.EvalLevel3
jsr pc,EvalLevel2 ; Call level 2 - ^
.EvalLevel3More
;movb (r5),r0 ; Get current character
movb (r5)+,r0 ; Get current character
cmpb r0,#ASC"*"
beq EvalTimes
cmpb r0,#ASC"/"
beq EvalDivide
cmpb r0,#tknDIV
beq EvalDIV
cmpb r0,#tknMOD
bne EvalDoneDec
;bne EvalDone
;beq EvalMOD
;rts pc ; Return
.EvalTimes
.EvalDivide
.EvalDIV
.EvalMOD
;inc r5 ; Step past current character
jsr pc,StackValAndOp
jsr pc,EvalLevel2 ; Evaluate RHS parameter
jsr pc,UnstackValAndCallOp
;movb (r5),r0 ; Get current character
br EvalLevel3More ; Loop to check for more * / DIV MOD
; Evaluator Level 2 - ^
; =====================
.EvalLevel2
jsr pc,EvalLevel1 ; Call level 1 - eveything else
.EvalLevel2More
movb (r5)+,r0 ; Get current character
cmpb r0,#32
beq EvalLevel2More ; Skip spaces
cmpb r0,#ASC"^"
bne EvalDoneDec
;beq EvalPower
;dec r5
;rts pc
.EvalPower
jsr pc,StackValAndOp
jsr pc,EvalLevel1 ; Evaluate RHS parameter
jsr pc,UnstackValAndCallOp
br EvalLevel2More ; Loop to check for more ^
.EvalDoneDec
dec r5
.EvalDone
rts pc
.errMissingQuote
jsr pc,Error
equb 9,tknMissing,34,0
align
; EvalBracket - bracketed expression
; ----------------------------------
.EvalBracket1
inc r5 ; Step past '('
.EvalBracket
jsr pc,Evaluate ; Evalute everything within brackets
jsr pc,CheckClose ; Check closing bracket
tst r2 ; Set flags from returned type
rts pc
; EvalUnaryMinus - -<value>
; -------------------------
.EvalUnaryMinus
jsr pc,EvalNumVal ; Get numeric value
; Negate number
; -------------
; Preserves r0/r1 as called from elsewhere
.NegateNumber
tst r2 ; Check if integer or float
beq NegateInteger
;mov r0,-(sp) ; Save r0
;mov #&8000,r0
;xor r0,r3 ; Toggle mantissa sign bit
;mov (sp)+,r0 ; Restore r0
sub #&8000,r3 ; Toggle mantissa sign bit
tst r2 ; Set flags
rts pc
.fnABS
jsr pc,EvalNumVal
beq fnABSint ; Jump if integer
bic #&8000,r3 ; Ensure float sign bit=0
.fnABS1
tst r2 ; Set flags
rts pc
.fnABSint
tst r3 ; Check integer b31
bpl fnABS1 ; Positive, exit with flags set
.NegateInteger
sub #1,r4 ; Do abs=NOT(num-1)
sbc r3
com r4
com r3
tst r2 ; Set flags
rts pc
; EvalQuote - an immediate string
; -------------------------------
.EvalQuote
adr SV_STRING,r4 ; Point to string buffer
clr r3 ; Length=0
.EvalQuoteLp
movb (r5)+,r0 ; Get character
cmpb r0,#13
beq errMissingQuote
movb r0,(r4)+ ; Store in string buffer
inc r3 ; Increment length
cmpb r0,#34 ; Is this a quote?
bne EvalQuoteLp ; Loop until terminating quote
movb (r5)+,r0
cmpb r0,#34 ; Double quote?
beq EvalQuoteLp
dec r5
adr SV_STRING,r4 ; Point to string buffer
dec r3 ; Balance final inc
mov #&8000,r2 ; Type=string, set flags
rts pc
; ^<variable> - address of identifier
; -----------------------------------
.EvalAddrOf
jsr pc,SkipSpaceThis
jsr pc,VarFindCreateAddress ; Search for variable/FN/PROC, creating if nonexistant
clr r3
cmpb (r5)+,#ASC"(" ; Is it ^PROCname()
bne EvalHexDone ; If no following (), jump to return
jsr pc,CheckClose ; Ensure closing bracket present
br EvalHexOk ; Jump to return
; Evaluator Level 1 - & - + () " ? ! | $ function variable
; ========================================================
; Called by other functions, so must set flags on exit
; EvalLevel1 doesn't check free memory as uses very little stack
; Free memory checked on entry to Level7Eval
;
.EvalLevel1
clr r4 ; Set initial accumulator to 0
clr r3
clr r2
; EvalUnaryPlus - +<value>
; ------------------------
.EvalUnaryPlus
.EvalLevel1Spc
movb (r5)+,r0 ; Get current character, step to next
cmp r0,#32
beq EvalLevel1Spc ; Skip spaces
cmpb r0,#ASC"("
beq EvalBracket
cmpb r0,#ASC"^"
beq EvalAddrOf
cmpb r0,#&22
beq EvalQuote
;mov #&6F,r1 ; Highest hex digit+flags
cmpb r0,#ASC"&"
beq EvalHex
cmpb r0,#ASC"@"
beq EvalOct
mov #&31,r1 ; Highest binary digit+flags
cmpb r0,#ASC"%"
beq EvalBinary
cmpb r0,#&8D
bcc EvalFunction1 ; Token, jump via dispatch table
jsr pc,CheckDigit
bcc EvalDecimal ; '0'..'9', decimal digit
cmpb r0,#ASC"-"
beq EvalUnaryMinus
cmpb r0,#ASC"+"
beq EvalUnaryPlus
cmpb r0,#ASC"."
beq EvalFraction ; .<frac>
; Must be !, $, ?, |, variable, variable!offset or variable?offset
; ----------------------------------------------------------------
.EvalVariable
dec r5 ; Point to first character of variable
jmp VarFindVal ; Returns full value, including length with $addr, $$addr
.EvalFunction1
jmp EvalFunction ; Within 'Stack' module
; EvalOct - @<octnumber>
; ----------------------
.EvalOct
movb (r5),r0
jsr pc,CheckDigit
bcs EvalVariable ; @varname - not octal constant
br EvalOct2
; EvalHex - &<hexnumber>
; also &o<octnumber>
; ----------------------
.EvalHexGo ; Call here from OSCLI to scan addresses
.EvalHex
mov #&6F,r1 ; Highest hex digit+flags
movb (r5),r0
bic #&20,r0 ; Force upper case
cmpb r0,#ASC"O"
bne EvalHexEtc ; Scan hex value
inc r5 ; Step past 'o'
.EvalOct2
mov #&37,r1 ; Highest octal digit+flags
;asr r1 ; Becomes &37, highest octal digit+flags
;
; EvalBinary - %<number>, r1 already set
; --------------------------------------
.EvalBinary
.EvalHexEtc
jsr pc,GetHexOctBin ; Get and check first digit
bcc EvalHexEtc3 ; Starts with an valid digit
jsr pc,Error
equb 28,"Bad HEX, OCT or BIN",0
align
.EvalHexEtc1
jsr pc,GetHexOctBin ; Get and check another digit
bcs EvalHexDone ; Not bin/oct/hex, exit all done
.EvalHexEtc3
mov r1,r2 ; Use max valid char as bitcounter
br EvalHexEtc5
.EvalEvalHexEtc4
asl r4 ; Multiply current value by 2
rol r3
bcs jmpTooBig ; Overflowed out of b31
.EvalHexEtc5
ror r2
bcs EvalEvalHexEtc4 ; Loop to multiply by 2, 8 or 16
bic #&FFF0,r0 ; Reduce to binary
bis r0,r4 ; Add in current digit
br EvalHexEtc1 ; Loop for more
; EvalDecimalPrefix - read integer decimal exponent
; -------------------------------------------------
; Called to read E<decimal> from Decimal parser.
; Reads 31-bit decimal number checking for +/- prefix
; r5=>first character
;
.EvalDecimalNeg
jsr pc,EvalDecimalNext ; Step past '-' and evaluate
jmp NegateNumber ; Negate number and return
.EvalDecimalPrefix
movb (r5),r0
cmpb r0,#ASC"-"
beq EvalDecimalNeg ; -number
cmpb r0,#ASC"+" ; +number
bne EvalDecimalInt
.EvalDecimalNext
inc r5 ; Step past '+' or '-'
; EvalDecimalInt - read integer decimal number
; --------------------------------------------
; Reads 31-bit decimal number to r4:r3
; r5=>first character
; Generates error if number too big
;
.EvalDecimalInt
clr r4
clr r3 ; Clear accumulator
.EvalDecimalLp
jsr pc,FetchCheckDigit
bcs EvalDecimalDone ; CS=no more digits
jsr pc,EvalTimes10 ; r3:r4=r3:r4*10
.EvalDecimalDigit
bic #&FFF0,r0
add r0,r4
adc r3 ; r3:r4=r3:r4*10+n
bpl EvalDecimalLp ; Decimal number only up to b30
.jmpTooBig
jmp errTooBig
;rts pc ; MI=Number too big
.EvalDecimalDone
.EvalHexDone
dec r5 ; Point to terminating non-digit
.EvalHexOk
clr r2 ; Type=integer, set flags, PL, VC, EQ, CC
rts pc
; EvalDecimalVAL - called from VAL to deal with +/- prefix
; --------------------------------------------------------
.EvalDecimalVALNeg
jsr pc,EvalDecimalVALNext
jmp NegateNumber
.EvalDecimalVAL
jsr pc,SkipSpaceThis ; Next ; Skip spaces and get character
cmpb r0,#ASC"-"
beq EvalDecimalVALNeg ; VAL"- number"
cmpb r0,#ASC"+"
bne EvalDecimal2 ; VAL"number"
.EvalDecimalVALNext
jsr pc,FetchNextChar ; Step past '-' or '+'
inc r5 ; Balance next dec
; EvalDecimal - <int> <int>.<frac> <int>E<exp> <int>.<frac>E<exp>
; ---------------------------------------------------------------
; r5=>after first digit
; NB: E<exp> parsed correctly, but fnPower only does positive powers.
;
.EvalDecimal
dec r5 ; Point back to first digit
.EvalDecimal2
jsr pc,EvalDecimalInt ; Evaluate decimal string
cmpb r0,#ASC"."
bne EvalCheckExponent ; Not '.', check for 'E'
inc r5 ; Step past '.'
jsr pc,EnsureFloat
; Parse fractional digits
; -----------------------
.EvalFraction
mov r3,-(sp)
mov r4,-(sp)
mov r2,-(sp) ; acc=num sp=>num
clr r4
clr r3
mov #&80,r2 ; acc=1 sp=>num
.EvalFractionLp ; acc=1 sp=>num
mov r3,-(sp)
mov r4,-(sp)
mov r2,-(sp) ; stack: acc=1 sp=>1, num
mov #&CCCD,r4
mov #&4CCC,r3
mov #&007C,r2 ; acc=1/10 sp=>1, num
jsr pc,fnMultiply ; multiply: acc=1/10 sp=>num
tst -(sp) ; acc=1/10 sp=>xxx, num
jsr pc,SwapStack ; swap: acc=num sp=>xxx, 1/10
mov 6(sp),-(sp)
mov 6(sp),-(sp)
mov 6(sp),-(sp)
tst -(sp) ; dup: acc=num sp=>xxx, 1/10, xxx, 1/10
jsr pc,SwapStack ; swap: acc=1/10 sp=>xxx, num, xxx, 1/10
tst (sp)+ ; sp=>num, xxx, 1/10
mov r3,-(sp) ; sp=>x, num, xxx, 1/10
;mov r3,(sp)
mov r4,-(sp) ; sp=>xx, num, xxx, 1/10
mov r2,-(sp) ; stack: acc=1/10 sp=>1/10, num, xxx, 1/10
jsr pc,FetchCheckDigit ; Get next digit
bcs EvalFractionDone
bic #&FFF0,r0
mov r0,r4
clr r3
clr r2 ; acc=d sp=>1/10, num, xxx, 1/10
jsr pc,fnMultiply ; multiply: acc=d/10 sp=>num, xxx, 1/10
mov #&80,r0 ; b7=1, not compare
jsr pc,fnAdd ; add: acc=num+d/10 sp=>xxx, 1/10
jsr pc,SwapStack ; swap: acc=1/10 sp=>xxx, num+d/10
tst (sp)+ ; acc=1/10 sp=>num+d/10
br EvalFractionLp
.EvalFractionDone ; acc=1/10 sp=>1/10, num, xxx, 1/10
add #6,sp ; Drop 1/10
mov (sp)+,r2 ; Pop stacked number
mov (sp)+,r4
mov (sp)+,r3
add #8,sp ; Drop xxx and 1/10
dec r5 ; Point to terminating character
.EvalCheckExponent
bic #&20,r0
cmpb r0,#ASC"E" ; Check for E<num>
bne EvalExponentDone ; Return with <num>
;.EvalExponent
inc r5 ; Step past 'E'
jsr pc,EnsureFloat ; Ensure floating point format
mov r3,-(sp)
mov r4,-(sp)
mov r2,-(sp) ; Stack number
jsr pc,EvalDecimalPrefix ; Evalute integer exponent
clr -(sp)
mov #10,-(sp)
clr -(sp) ; Stack 10
jsr pc,fnPower ; Do 10^(exponent) - NB Power currently only does +ve powers
jsr pc,fnMultiply ; Do 10^(exponent) * <decimal>
.EvalExponentDone
tst r2 ; Set flags
rts pc
.EvalTimes10 ; r3:r4=r3:r4*10, corrupts r1,r2
mov r4,r2
mov r3,r1
clc
rol r4
rol r3 ; r3:r4=*2
rol r4
rol r3 ; r3:r4=*4
add r2,r4
adc r3
add r1,r3 ; r3:r4=*5
rol r4
rol r3 ; r3:r4=*10
;.EvalTimes10Over
rts pc ; CC=number ok, CS=too big
src/Execute
+305
View File
@@ -0,0 +1,305 @@
; > Execute
; Program execute dispatch loop
; CHANGES
; =======
; 17-Jan-2009: Line continuation character within SkipSpaces.
; 25-Oct-2009: Places zero word at top of stack so 2(sp) can be examined.
; 15-May-2010: End-Of-Program doesn't check for TOP.
; 21-Jan-2012: TRACE output works, END quits if run-quit flag set.
; 13-Dec-2013: Error scans program to find line where error occured.
; ON ERROR LOCAL works, continuing with local stack.
; 24-Dec-2013: On untrapped error, if QUIT=TRUE, jumps to IO_QUIT.
; 03-Jan-2013: Don't SkipSpace before jumping to VarAssign, fixes "a =1" bug.
; 31-Aug-2015: Low numbered commands use lookup table instead of loads of CMPs.
; Moved call to OSBYTE &7E to error handler.
; 29-Sep-2015: Low command token lookup made position independent.
; 25-Jul-2015: Speeded up SkipSpace by removing bic #&FF00.
; 12-Aug-2023: Optimised execution loop and line scanning.
; Generate inline error
; =====================
; On entry, sp=>inline error address
;
.Error
.ErrorHandler1
mov (sp)+,r0 ; Pop return address to inline error block
;
; Error handler
; =============
; On entry, r0=>inline error
; LINE=BASIC line when error occured
; We have to use LINE as we will have lost r5 when going through BRKV
;
.ErrorHandler
mov SV_LINE,SV_ERL ; Save current error line
clr SV_TRACE ; TRACE OFF
mov r0,SV_FAULT ; Save current error
movb (r0),SV_ERR ; Save current error number
beq ErrorNotLocal ; If ERR=0, ignore ON ERROR (won't be Escape)
mov #126,r0
jsr pc,IO_BYTE ; Acknowledge any Escape state
clrb SV_ESCFLG ; Clear local Escape flag
mov SV_ONERR,r5 ; Get ON ERROR handler
beq ErrorNotLocal ; No error handler
mov SV_STACK,sp ; Point to local stack
cmpb (r5)+,#tknLOCAL ; Is it ON ERROR LOCAL ?
beq Execute ; Jump to execute with local stack
dec r5 ; Step back to non-existant LOCAL
mov SV_HIMEM,sp ; Clear BASIC stack
clr -(sp) ; Put zero at top of stack
mov sp,SV_STACK ; Reset error stack
br Execute ; Jump to execute with empty stack
.ErrorNotLocal
mov SV_HIMEM,sp ; Clear machine stack
jsr pc,cmdREPORT ; Display error message
tstb SV_SYS ; Check run-quit flag
bmi ErrorNoErl ; QUIT=TRUE, don't print line number
mov SV_ERL,r4 ; Get error line
beq ErrorNoErl ; Avoid printing 'at line 0'
jsr pc,PrintInline
equb " at line ",0
align
jsr pc,PrintLineNum ; Print line number with no space padding
.ErrorNoErl
jsr pc,IO_NEWL
movb SV_ERR,r0 ; r0=ERR if QUIT=TRUE
bic #&FF00,r0
br cmdEND3
; END
; ===
.cmdEND
jsr pc,FindTOP ; Check program, R5=>end
.cmdEND2
clr r0 ; Return value=0
.cmdEND3
tstb SV_SYS ; Check run-quit flag
bmi cmdENDQuit
clr SV_AUTO ; Turn off AUTO
jmp ImmediateLoop ; Drop to immediate mode
.cmdENDQuit
jmp IO_QUIT ; Jump to QUIT
;tstb SV_SYS ; Check run-quit flag
;bmi cmdENDQuit ; QUIT=TRUE, exit
;.ErrorImmediate
;clr SV_AUTO ; Turn off AUTO
;jmp ImmediateLoop ; Drop to immediate mode
;;br cmdEND ; Check for TOP and drop to immediate mode
; ; Jumping to cmdEND causes repeated errors if
; ; FindTOP walks into invalid memory
; RUN [str$]
; ==========
; Run program in memory or chain program from file
.cmdRUN
jsr pc,CheckEndStatement ; Any parameters?
beq RunProgram ; No, RUN program
; CHAIN str$
; ==========
; Fetch CR-string
; Call LoadProgram
; Continue into RUN
.cmdCHAIN
jsr pc,EvalStringCR ; Get cr-string parameter
; ChainStartup
; ------------
; Chain program, name already at R4
.ChainStartup
jsr pc,LoadProgram ; Load file as a program (should also clear heap)
; RUN - Run program in memory
; ===========================
; LOMEM=TOP
; VAREND=TOP
; DATAPTR=PAGE
; STACK=HIMEM
; Clear dynamic variables
; Clear error handler
; LPTR=PAGE
; Enter Execution loop
.RunProgram
jsr pc,VarsHeapInit ; LOMEM=TOP, VAREND=TOP, DATAPTR=PAGE, STACK=HIMEM, stack zero
clr SV_ONERR ; Clear error handler
mov SV_PAGE,r5 ; Point to <cr> at start of program
;
; Execute program code
; =====================
; R5=BASIC program pointer
; R4/R3=32-bit accumulator
; R2=value type/exponent
; R1/R0=working
;
.Execute
jsr pc,UpdateLPTRnext ; R0=char, R5=>next char, skipping spc, colon, cr
cmpb r0,#tknTHEN
beq Execute ; Step past THEN
jsr pc,ExecByte ; Execute this byte
jsr pc,IO_Escape ; Check Escape state
br Execute ; Execute next statement
; Execute command represented by the current byte
; -----------------------------------------------
; This is a subroutine so command routines can end with RTS
; On entry, R0=&FFxx for tokens >&7F
; R0=&00xx for characters <&80
; R5=>next byte
.ExecByte
sub #&FFC6,r0 ; Reduce range
bcs ExecLowCommand ; Not a command token, check for low numbered commands
.ExecByteCommand
asl r0 ; Offset into command table
adr CommandTable,r1 ; Point to command address table
add r0,r1 ; Index into command table
add (r1),r1 ; Calculate routine address
jmp (r1) ; Jump to command routine, (r5)=>current char
.ExecLowCommand
mov r0,r1 ; Move byte-&FFC6 into R1
mov #&101-&C6,r0 ; R0=effective token number &101+
adr CommandBytes,r2 ; R2=>command translation table
.ExecLowCommandLp
cmpb (r2)+,r1 ; Byte compare, so ignores b8-b15
beq ExecByteCommand ; Low token matches, use translated token
inc r0
cmp r0,#&10A-&C6
bne ExecLowCommandLp ; Loop through low numbered tokens
dec r5 ; Point to start of variable
jmp cmdAssign ; Must be variable assignment
; Update LPTR to skip null code, spaces, colons, end of line
; ----------------------------------------------------------
; On entry, r5=>current character
; On exit, r0= current character
; r5=>next character
; Flags corrupted
;
.UpdateLPTRnext
movb (r5)+,r0
cmpb r0,#ASC" "
beq UpdateLPTRnext ; Step past spaces
cmpb r0,#&3A
beq UpdateLPTRnext ; Step past colons
cmpb r0,#13
bne SkipLineDoneX ; Return with character
movb (r5)+,r0 ; Get byte after <cr>
cmpb r0,#&FF ; Program terminator?
beq cmdEND2 ; End of program, do END
movb r0,SV_LINE+1 ; Store current line number high byte
movb (r5)+,SV_LINE+0 ; Store current line number low byte
inc r5 ; Step past line length, r5=>line text
mov SV_TRACE,r1 ; Get TRACE status
beq UpdateLPTRnext ; TRACE OFF, do next line
mov SV_LINE,r4
cmp r4,r1 ; Compare line number with trace line
bcs UpdateLPTRnext ; line<trace line, do next line
mov #ASC"[",r0 ; Print trace line number
jsr pc,IO_WRCH
jsr pc,PrintLineNum ; Prints line number with no padding
mov #ASC"]",r0
jsr pc,IO_WRCH
mov #ASC" ",r0
jsr pc,IO_WRCH
br UpdateLPTRnext ; Continue scanning next line
; *command
; ========
.cmdStar
mov r5,r0 ; Point to *command
jsr pc,IO_CLI ; Pass to CLI
; ; Fall though to skip line
;
; Skip past a line, *command, REM, etc
; ------------------------------------
.cmdELSE
.cmdREM
.cmdDEF
.cmdDATA
.SkipLine
cmpb (r5)+,#13 ; Get character
bne SkipLine ; Loop until <cr>
br SkipLineDone ; Point to <cr>
; Fetch next non-space character
; ------------------------------
.FetchNextChar
inc r5 ; Step past current character
;
.SkipSpaceThis
jsr pc,SkipSpaceNext
.SkipLineDone
dec r5 ; R0=this char, R5=>this char
.SkipLineDoneX
rts pc
; Skip past any spaces, and return current character
; --------------------------------------------------
; Returns r0=current char, r5=>next char
;
.SkipSpaceNext ; return r5=>this char
movb (r5)+,r0
cmpb r0,#ASC" "
beq SkipSpaceNext ; Loop until non-space
rts pc
; Check for end of statement, returns Z if end of statement
; ---------------------------------------------------------
.CheckEndStatement
movb (r5)+,r0
cmpb r0,#ASC" "
beq CheckEndStatement ; Skip any spaces
dec r5
.CheckEndToken
cmpb r0,#tknELSE
bcc CheckEndStRet
;.CheckColon
cmp r0,#&3A
bcc CheckEndStRet
cmp r0,#&0D
.CheckEndStRet
rts pc
; Check for numeric characters
; ----------------------------
; Needs optimising
; Returns CC=Ok digit, R0=&30-&3F
; CS=Not digit
.GetHexOctBin
movb (r5)+,r0 ; Get next digit
cmpb r0,#ASC"0"
bcs CheckDigitExit ; Exit with CS if <'0'
cmpb r0,r1
bls CheckHexDigit ; Check digit
sec
rts pc
.CheckHexNext
movb (r5)+,r0 ; Get next hex digit
.CheckHexDigit
jsr pc,CheckDigit ; Is it decimal digit?
bcc CheckDigitExit ; CC=digit
bic #&20,r0
cmp r0,#ASC"A"
bcs CheckDigitExit
cmp #ASC"F",r0
bcs CheckDigitExit ; CS=not digit
sub #7,r0 ; Reduce to &3A-&3F
rts pc ; CC=digit
; Returns CC if digit, CS if nondigit
.FetchCheckDigit
movb (r5)+,r0 ; Get character
.CheckDigit
cmp r0,#ASC"0" ; r0<'0' C=1, r0>='0' C=0
bcs CheckDigitExit ; Exit with CS if <'0'
cmp #ASC"9",r0 ; '9'<r0 C=1, '9'>=r0 C=0
; r0>'9' C=1, r0<='9' C=0
.CheckDigitExit ; Exit with CS if >'9'
rts pc
src/Functions
+2068
View File
File diff suppressed because it is too large Load Diff
src/GeneralIO
+81
View File
@@ -0,0 +1,81 @@
; > GeneralIO
; General I/O routines
; 31-Aug-2015 v0.21a: cmdREPORT moved here to drop into PrintR1.
; 04-Jul-2018 v0.27: IO_ReadLine uses stack for control block.
; Print inline text
; =================
; Corrupts r0,r1
;
.PrintInline ; Print inline text
mov (sp)+,r1 ; Get return address to r1
jsr pc,PrintR1 ; Print text at r1, corrupts r0,r2
inc r1 ; increment return address
bic #1,r1 ; clear bit zero
mov r1,pc ; jump to return address
; REPORT - Display current error message
; ======================================
.cmdREPORT
jsr pc,IO_NEWL ; Print newline
mov SV_FAULT,r1 ; Get current error block
inc r1 ; Step past error number
; ; Continue to print via token expansion
; Print text at R1
; ================
; On entry, R1=>zero-terminated string
;
.PrintR1 ; Print text pointed to by R1, term. by &00
movb (r1)+,r0 ; Get byte from r1, inc r1
beq PrintR1End ; Exit if final byte
jsr pc,PrintR0Token ; Print expandable character
br PrintR1 ; Loop back
; Print character, checking COUNT and WIDTH
; =========================================
; Preserves all registers, returns r0=13 if automatic NEWLINE output
;
.PrintAscii
jsr pc,IO_ASCI ; Output character
br PrintR0Check
.PrintR0
jsr pc,IO_WRCH ; Output character
.PrintR0Check
cmp r0,#13
beq PrintR0Clear ; If <cr>, clear COUNT
cmp r0,#32
bcs PrintR0Ret ; Control codes, ignore count
incb SV_COUNT ; Increment COUNT
tstb SV_WIDTH ; Check WIDTH
beq PrintR0Ret ; WIDTH=0, ignore
cmpb SV_WIDTH,SV_COUNT ; Has COUNT reached WIDTH?
bne PrintR0Ret ; No, exit
jsr pc,IO_NEWL ; Print newline
.PrintR0Clear
clrb SV_COUNT ; Set COUNT to zero
.PrintR0Ret
.PrintR1End
rts pc
; Read line of text
; =================
; On entry, R1=>memory to read string to
; On exit, R2=length of string
; Other regs preserved
; If Escape state, Escape error generated
;
.IO_ReadLine
mov #&00FF,-(sp) ; Highest character, padding
mov #&20FF,-(sp) ; Max line length, lowest character
mov r1,-(sp) ; Address of text buffer
mov sp,r1 ; R1=>control block
clr r0
jsr pc,IO_WORD ; OSWORD 0 - read a line of text
bcc IO_ReadLineOk
jmp errEscape
.IO_ReadLineOk
add #6,sp ; Drop control block from stack
br PrintR0Clear ; Zero COUNT, and clear Carry flag
src/Interface
+873
View File
@@ -0,0 +1,873 @@
; > Interface
; Interface to host system
; IO commands/functions/queries/etc
; Done, tested:
; CLS, CLG, COLOUR, MODE, =MODE, =POS, =VPOS, OSCLI, DRAW, MOVE, PLOT, GCOL, VDU
; =POINT, =VDU, TIME=, TIME$=, =TIME, =TIME$, SOUND ON|OFF, =TIME$ checks for null return
; GET$#chn, BPUT#chn,s$, GCOL c, COLOUR l,[p|r,g,b], PLOT x,y, SOUND, ENVELOPE, LOAD s$,n
; 09-Mar-2009 LoadProgram can load and tokenise text file
; 24-Jun-2010 SAVE name$,start,end[,exec[,load]]
; 02-Jul-2010 QUIT [retval]
; 16-Aug-2013 TextLoad calls LineTokeniser and LineInsert
; 07-Dec-2013 SAVE <cr> saves with inline filename
; 16-Aug-2015 v0.20a VDU(n) returns 8-bit value
; 26-Aug-2015 v0.20b Optimised some common OSBYTE-calling code
; 14-Jul-2017 Optimised TextLoad with modified Tokeniser API
; 04-Jul-2018 v0.27 Optimised various I/O calls by using token in R0
; Merged a lot of common code in OSBYTE calls and some OSWRCH calls
; 15-Apr-2020 Optimised POINT by using stack for control block
; 18-Mar-2024 LOAD/SAVE checks for end-of-statement if immediate command, tweeked
; textload and FindTOP.
; On entry to command subroutines,
; r5=>character after command token, no spaces skipped
; r0=(token-&C6)*2
; r1=dispatch address
;
; On entry to function subroutines,
; r5=>character after function token, no spaces skipped
; r0=function token
; r1=dispatch address
;
; On exit from function subroutines,
; r4=b0-b15 or string start
; r3=b16-b31 or string length
; r2=type with flags set
; VDU Commands
; ============
; CLS - Clear Text Window
; =======================
.cmdCLS
clrb SV_COUNT
mov #36,r0 ; R0=12+24
; CLG - Clear graphics window
; ===========================
.cmdCLG
sub #24,r0 ; R0=16 or 12
jmp IO_WRCH
; DRAW x,y - Send DRAW command, entered with R0=&32
; MOVE x,y - Send MOVE command, entered with R0=&4C
; =================================================
.cmdDRAW
mov #5,r0 ; DRAW is PLOT 5
.cmdMOVE
bic #&FFF8,r0 ; MOVE is PLOT 4
mov r0,-(sp)
jsr pc,EvalInteger
mov r4,-(sp) ; Save X coord
br cmdPLOTetc
; PLOT [k,]x,y - Send PLOT command
; ================================
.cmdPLOT
mov #69,-(sp) ; PLOT is PLOT 69
jsr pc,EvalInteger
mov r4,-(sp) ; Save X coord or PLOT command
jsr pc,EvalComma ; Get Y coord or X coord
jsr pc,CheckEndStatement
beq cmdPLOTxy ; Jump to do PLOT 69,x,y
mov (sp),2(sp) ; Move first param to command
mov r4,(sp) ; Save second param as X coord
.cmdPLOTetc
jsr pc,EvalComma ; Get Y coord
.cmdPLOTxy
mov #25,r0
jsr pc,IO_WRCH ; PLOT
mov (sp)+,r3 ; R3=X coord
mov (sp)+,r0 ; R0=command
jsr pc,IO_WRCH ; k
mov r3,r0
jsr pc,WrchWord ; X low byte, high byte
mov r4,r0 ; Y low byte, high byte
.WrchWord
jsr pc,IO_WRCH ; low byte
swab r0
jmp IO_WRCH ; high byte
; MODE m - Set screen mode
; ========================
.cmdMODE
jsr pc,EvalInteger
clrb SV_COUNT
mov #22,r3
br WrchR3R4
; GCOL [a,]c - Set graphics colour
; ================================
.cmdGCOL
clr -(sp) ; Prepare for GCOL c
jsr pc,EvalInteger
jsr pc,CheckEndStatement
beq cmdGCOL2
mov r4,(sp) ; Overwrite action on stack
jsr pc,EvalComma
.cmdGCOL2
mov (sp)+,r3 ; r3=action, r4=colour
mov #18,r0
jsr pc,IO_WRCH
.WrchR3R4
mov r3,r0
jsr pc,IO_WRCH
.WrchR4
mov r4,r0
jmp IO_WRCH
; COLOUR l[,p|,r,g,b] - Set text or palette colour
; =================================================
.cmdCOLOUR
jsr pc,EvalInteger
mov #17,r3
jsr pc,CheckEndStatement
beq WrchR3R4 ; Jump with COLOUR l
mov r4,-(sp) ; Save logical colour
jsr pc,EvalComma ; Get p or r
mov r4,r1 ; R1=P
clr r2 ; R2=R=0
clr r3 ; R3=G=0
clr r4 ; R4=B=0
jsr pc,CheckEndStatement
beq cmdCOLOURrgb ; Jump to do COLOUR l,p with VDU 19,l,p,0,0,0
mov r1,-(sp) ; Save R, SP=>R,L
jsr pc,EvalComma
mov r4,-(sp) ; Save G, SP=>G,R,L
jsr pc,EvalComma ; R4=B, SP=>G,R,L
mov (sp)+,r3 ; R3=G
mov (sp)+,r2 ; R2=R
mov #16,r1 ; R1=P=16 for screen colour
tst (sp) ; Test logical colour
bpl cmdCOLOURrgb ; L>=0 - set screen colour
mov #24,r1 ; R1=P=24 for border colour
;
.cmdCOLOURrgb
; (sp)=LOGICAL, R1=PHYSICAL, R2=RED, R3=GREEN, R4=BLUE
mov (sp)+,r0 ; Get logical colour
swab r0 ; Move to top byte
bic #&00FF,r0
bis #&0013,r0 ; Make bottom byte=19
jsr pc,WrchWord ; VDU 19,L
mov r1,r0
jsr pc,IO_WRCH ; VDU 19,L,P
mov r2,r0
jsr pc,IO_WRCH ; VDU 19,L,P,R
br WrchR3R4 ; VDU 19,L,P,R,G,B
; VDU n[,|;[n]] - Send to VDU stream
; ==================================
.cmdVDUsemi
mov r4,r0
swab r0
jsr pc,IO_WRCH ; Send top byte
.cmdVDU
jsr pc,CheckEndStatement
beq cmdVDUexit ; End of statement, exit
jsr pc,EvalInteger
jsr pc,WrchR4 ; Send low byte to output
;jsr pc,SkipSpaceThis ; Next
;inc r5 ; Step past comma, semi or bar
jsr pc,SkipSpaceNext
cmp r0,#ASC","
beq cmdVDU ; Loop back if comma
cmp r0,#&3B ; Semicolon
beq cmdVDUsemi ; Loop back to send high byte for semi
mov #9,r1 ; Prepare to send 9 zeros
cmp r0,#ASC"|"
beq cmdOFFzero ; Jump to send zeros if bar
dec r5 ; Point back to current character
.cmdVDUexit
rts pc
; OFF - turn cursor off
; ON - turn cursor on
; =====================
; OFF entered with R0=&7E
.cmdONvdu
mov #1,r0 ; ON is VDU 23,1,1,...
.cmdOFF
bic #-2,r0 ; OFF is VDU 23,1,0,...
mov r0,r4
;mov r0,r1
mov #&0117,r0
jsr pc,WrchWord ; VDU 23,1
;mov r1,r0
;jsr pc,IO_WRCH ; Send ON/OFF byte
jsr pc,WrchR4 ; Send ON/OFF byte
mov #7,r1 ; Finish VDU sequence with 7 NULLs
.cmdOFFzero
clr r0
.cmdOFFlp
jsr pc,IO_WRCH
dec r1
bne cmdOFFlp
rts pc
; Character Input Functions
; =========================
; =POINT(x,y) - read colour at point
; ==================================
.fnPOINT
jsr pc,EvalInteger ; Get X parameter
mov #-1,-(sp) ; Stack default result
mov r4,-(sp) ; Put X on the stack
jsr pc,EvalComma ; Step past ',', get Y parameter
jsr pc,CheckClose ; Step past ')'
mov (sp),-(sp) ; Copy X lower down on stack
mov r4,2(sp) ; Put Y on stack
mov sp,r1 ; r1=>control block on stack
mov #9,r0
jsr pc,IO_WORD ; OSWORD 9 - call POINT routine
cmp (sp)+,(sp)+ ; Drop X and Y from stack
mov (sp)+,r4 ; Get pixel value from stack
br fnReturnExtendR4 ; Return value, extending &xx80+x to &FFFFFF80+x
; =GET$[#chn] - wait for character from input or string from channel
; ==================================================================
; Also =GET$(x,y) - read char from screen
.fnGETs
CMPB (R5),#ASC"#"
BNE fnGETrdch
JSR PC,EvalHashVal ; Get channel number
MOV R4,R1 ; R1=channel
ADR SV_STRING,R4 ; Point to string buffer
CLR R3 ; String length=0
.fnGETlp
JSR PC,IO_BGET
BCS fnGETend ; End of file
CMP R0,#10
BEQ fnGETend ; LF - end of line
CMP R0,#13
BEQ fnGETend ; CR - end of line
MOVB R0,(R4)+ ; Store in string buffer
INC R3
CMP R3,#255
BCS fnGETlp ; Loop for up to 255 characters
.fnGETend
ADR SV_STRING,R4 ; R4=string start, R3=length
MOV #&8000,R2 ; R2=string
RTS PC
.fnGETrdch
JSR PC,IO_RDCH ; Wait for key
MOV #1,R3 ; R3=string length
.fnReadChar
ADR SV_STRING,R4 ; R4=>string buffer
MOV R0,(R4) ; Put character into buffer
MOV #&8000,R2 ; R2=string type
RTS PC
; =INKEY$ time - wait specified time for character
; ================================================
.fnINKEYs
JSR PC,fnINKEY ; call INKEY routine
MOV R4,R0 ; Move result to R0
INC R3 ; Change -1/0 to 0/1
BR fnReadChar ; Jump to store 0 or 1 characters
; =INKEY time - wait specified time for character
; ===============================================
.fnINKEY
mov #&81,r0
jsr pc,CallOsbyte16 ; Make OSBYTE call
tst r4
.fnReturnExtend
sxt r3 ; Sign extend into r3
clr r2 ; Type=Integer
rts pc
; =MODE - read current screen mode
; ================================
.fnMODE
jsr pc,fnMODEcall
.fnReturnExtendR4
movb r4,r4
br fnReturnExtend
; =ADVAL device - read device status
; ==================================
.fnADVAL
mov #&80,r0 ; R0=ADVAL
;
.CallOsbyte16
mov r0,-(sp) ; Save OSBYTE function
jsr pc,EvalIntVal ; Evaluate parameter
mov r4,r1 ; R1=<b15-b8><b7-b0> of parameter
mov r4,r2
swab r2 ; R2=<b7-b0><b15-b8> of parameter
bic #&FF00,r2 ; R2=<00000><b15-b8> of parameter
mov (sp)+,r0 ; Get OSBYTE function back
jsr pc,IO_BYTE ; Make the OSBYTE call, returns:
; ; R1= <b15-b8><b7-b0> of result
; ; R2=<b23-b16><b15-b8> of result
mov r1,r4 ; Get b0-b15 from R1
br fnReturnR4 ; Return 16-bit result
; =VDU n - read VDU variable
; ==========================
.fnVDU
mov #&A0,r0
jsr pc,CallOsbyte16 ; Returns flags from R4
br fnReturn8bitR1 ; Reduce to 8-bit result
; =POS - read horizontal cursor position
; ======================================
.fnPOS
jsr pc,fnVPOS ; Read POS and VPOS
.fnReturn8bitR1
mov r1,r0
br fnReturn8bitR0
; =VPOS - read vertical cursor position
; =====================================
.fnVPOS
mov #&86+&64,r0 ; R0=&86 for =VPOS
.fnMODEcall
sub #&64,r0 ; R0=&87 for =MODE
clr r1 ; Prepare R1=0 for default, R2 already 0
jsr pc,IO_BYTE
mov r2,r0
br fnReturn8bitR0
; =GET - wait for character from input
; ====================================
; Also =GET(port), =GET(x,y) - read char from screen
.fnGET
JSR pc,IO_RDCH ; Wait for key
.fnReturn8bitR0
bic #&FF00,r0
.fnReturnR0
mov r0,r4 ; R4=returned result from R0
.fnReturnR4
clr r3 ; R3=b16-b31=0
clr r2 ; R2=integer type
rts pc
; Time Commands and Functions
; ===========================
; TIME=val, TIME$=s$ - set TIME or TIME$
; ======================================
.cmdTIME
cmpb (r5),#ASC"$" ; Check for '$'
beq cmdTIMEs ; TIME$
;
jsr pc,EvalEqual ; Step past '=', get integer
clr -(sp) ; Use control block on stack
mov r3,-(sp) ; Stack value to write
mov r4,-(sp)
mov sp,r1 ; R1=>control block
mov #2,r0 ; R0=2 - write TIME
jsr pc,IO_WORD
add #6,sp ; Drop control block
rts pc
;
.cmdTIMEs
inc r5 ; Step past '$'
jsr pc,CheckEqual ; Check for '='
jsr pc,EvalString ; Get string
jsr pc,EvalStoreCRString ; Copy to string buffer
dec r4 ; R4=>byte before the string
dec r3 ; R3=string length minus <cr>
movb r3,(r4) ; Store string length
mov r4,r1 ; R4=>control block
mov #15,r0 ; TIME$ is OSWORD 15
jmp IO_WORD ; Set TIME$
; =TIME, =TIME$ - read TIME or TIME$
; ==================================
.fnTIME
cmpb (r5),#ASC"$"
beq fnTIMEs ; =TIME$
;
sub #6,sp ; Use control block on stack
mov sp,r1 ; R1=>control block
mov #1,r0 ; R0=1 - read TIME
jsr pc,IO_WORD
br fnReturnArgs ; Pop from stack and return
;
.fnTIMEs
inc r5 ; Step past '$'
adr SV_STRING,r1 ; Point to control block
clr (r1) ; Read time as string
mov #14,r0
jsr pc,IO_WORD ; Read TIME$
adr SV_STRING,r4 ; Start=SV_STRING
mov (r4),r3 ; Check returned string
beq fnTIMEnull ; Still zero, nothing returned
mov #24,r3 ; Length=24
.fnTIMEnull
mov #&8000,r2 ; Type=String
rts pc
; File Functions
; ==============
; =EOF#chn - read end-of-file status
; ==================================
.fnEOF
jsr pc,EvalHashVal ; Step past '#', get handle
mov r4,r1
mov #127,r0 ; OSBYTE 127,channel to read EOF
jsr pc,IO_BYTE
clr r4 ; Prepare R4=0
cmp #1,r1 ; If R1=0, Cy=0 if R1>0, Cy=1
sbc r4 ; R4=0-0=0 R4=0-1=FFFF
br fnReturnExtend ; Return 32-bit sign extended value
; =BGET#chn - read byte from channel
; ==================================
.fnBGET
jsr pc,EvalHashVal ; Step past '#', get integer handle
mov r4,r1 ; R1=handle
jsr pc,IO_BGET ; Call MOS to read on this channel
br fnReturn8bitR0
; OSCLI - Execute command
; =======================
#ifdef NOEXTRAFN
.cmdOSCLI
jsr pc,EvalStringCR
mov r4,r0
jmp IO_CLI
#else
.cmdOSCLI
jsr pc,EvalStringCR
br fnOSCLI2
.fnOSCLI
jsr pc,EvalStrValCR
.fnOSCLI2
mov r4,r0
jsr pc,IO_CLI
br fnReturnR0
#endif
; =OPEN(IN|OUT|UP) f$ - open file
; ===============================
; On entry, R0=AD - OPENUP
; R0=AE - OPENOUT
; R0=8E - OPENIN
.fnOPENUP
mov #&CE,r0
.fnOPENIN
.fnOPENOUT
asl r0 ; R0=11C,15C,19C
sub #&DC,r0 ; R0=40,80,C0
mov r0,-(sp) ; Save OPEN function
jsr pc,EvalStrValCR ; Get cr-string
mov r4,r1 ; r1=>filename
mov (sp)+,r0 ; r0=function
jsr pc,IO_FIND
br fnReturnR0
; Open file information
; =====================
; =PTR#chn - Read file pointer
; =EXT#chn - read file extent
; PTR#chn=val - Set file pointer
; EXT#chn=val - Set file extent
; =============================
; On entry, R0=8F - =PTR
; R0=12 - PTR=
; R0=A2 - =EXT
; R0=86 - EXT=
.cmdPTR
clr r0 ; Becomes R0=1 for =PTR
.cmdEXT
.fnPTR
inc r0 ; Becomes R0=7 for EXT=, R0=0 for =PTR
.fnEXT
bic #&FFFC,r0 ; Reduce to OSARGS action 0-3
mov r0,-(sp) ; Save OSARGS action
jsr pc,EvalHashVal ; Step past '#', get integer handle
mov (sp),r0 ; Get OSARGS action
mov r4,-(sp) ; Save handle
asr r0 ; Check bit 0 of action, read/write
bcc callARGS2 ; b0=0, read function
jsr pc,EvalEqual ; Step past '=', get integer
.callARGS2
mov (sp)+,r1 ; R1=handle
mov (sp),r0 ; R0=function, leave on stack as padding
mov r3,-(sp) ; sp=>data word
mov r4,-(sp)
mov sp,r2 ; R2=>data word
jsr pc,IO_ARGS ; Make the OSARGS call
.fnReturnArgs
mov (sp)+,r4 ; R3/R3=returned data word
mov (sp)+,r3
tst (sp)+ ; Drop padding/byte 5
clr r2 ; R2=integer
.cmdBPUTend
rts pc
; File Commands
; =============
; CLOSE#chn - Close channel
; =========================
.cmdCLOSE
jsr pc,EvalHashVal ; Step past '#', get integer
mov r4,r1 ; Pass handle to R1
clr r0
jmp IO_FIND
; BPUT#chn,[byte|string(;)] - Write byte or string to channel
; ===========================================================
.cmdBPUT
jsr pc,EvalHashVal ; Step past '#', get integer handle
mov r4,-(sp) ; Save handle
jsr pc,CheckComma ; Step past ','
jsr pc,Evaluate ; Get data to send
bmi cmdBPUTs ; Send string
jsr pc,EnsureInteger ; Convert float
mov (sp)+,r1 ; Get handle to R1
mov r4,r0 ; Move byte to R0
jmp IO_BPUT ; Call MOS to write byte
.cmdBPUTs
mov (sp)+,r1 ; Get handle to R1
tst r3
beq cmdBPUTzero ; Zero-length string
.cmdBPUTlp
movb (r4)+,r0
jsr pc,IO_BPUT ; Send character
dec r3
bne cmdBPUTlp ; Loop until all sent
.cmdBPUTzero
;jsr pc,SkipSpaceThis ; Next
;inc r5 ; Step past ';'
jsr pc,SkipSpaceNext
cmp r0,#&3B ; Terminating ';'?
beq cmdBPUTend ; Don't output end-of-line
dec r5 ; No ';', step back again
mov #10,r0
jmp IO_BPUT ; Write line-feed terminator
; QUIT [num] - Quit interpreter
; =============================
.cmdQUIT
clr r4 ; Prepare to use zero as return value
inc r5 ; Step past double token
jsr pc,CheckEndStatement
;jsr pc,FetchNextChar ; Step past second token byte
;jsr pc,CheckEndToken
beq cmdQUIT2 ; End of statement, use zero
jsr pc,EvalInteger ; Get return value
.cmdQUIT2
mov r4,r0 ; Pass to R0
jmp IO_QUIT
; LOAD str$[,addr] - Load program/data
; ====================================
; Fetch CR-string parameter
; Call LoadProgram (finding TOP)
; Jump to Immediate mode
.cmdLOAD
cmpb (r5),#tknQUIT
beq cmdQUIT ; C898 - QUIT
; cmpb r0,#tknSYS
; beq cmdSYS ; C899 - SYS
jsr pc,EvalStringCR ; Get filename to R4
#ifdef FILEEXTN
jsr pc,SkipSpaceNext
cmp r0,#ASC","
beq cmdLoadData
dec r5
#endif
jsr pc,EnsureEndStatement
jsr pc,LoadProgram ; Load program, check TOP
jmp ImmediateClear ; Clear heap, drop to immediate mode
#ifdef FILEEXTN
; LOAD str$,addr - load data
; --------------------------
.cmdLoadData
jsr pc,StackStringAndOp
jsr pc,EvalInteger
mov r4,FILE_LOAD+0
mov r3,FILE_LOAD+2
jsr pc,UnstackStringDropOp
br LoadData
#endif
; Load program named at R4 to memory at R1
; ----------------------------------------
.LoadProgFile
mov r1,FILE_LOAD+0 ; Address to load to
mov #&82,r0
jsr pc,IO_BYTE
mov r1,FILE_LOAD+2 ; High word of address
; Load data named at R4 to address in FILE_LOAD
; ---------------------------------------------
.LoadData
mov #255,r0 ; r0=&FF - LOAD
clr FILE_EXEC ; Load to specified address
.FileData
mov r4,FILE_NAME ; Point to filename
adr FILE_NAME,r1 ; r1=>control block
jmp IO_FILE ; Perform file action
; Load program named at R4
; ------------------------
.LoadProgram
mov SV_PAGE,r1
jsr pc,LoadProgFile
mov SV_PAGE,r1
;movb (r1),r0
;cmpb r0,#13
cmpb (r1),#13
beq FindTopLp ; Starts with <cr>, assume 6502 BASIC
; Should also check for Z80/8086 BASIC
;
; Check for loaded text and tokenise
; ----------------------------------
; Need to reload higher up in memory to prevent overwriting itself
mov r4,FILE_NAME ; Don't rely on being preserved
mov #5,r0
adr FILE_NAME,r1
jsr pc,IO_FILE ; Get file length, can't depend on return from OSFILE_LOAD
mov FILE_LENGTH,r0 ; If OSFILE 5 not implemented, will use length left by initial LOAD
; Load text file to PAGE+256
mov SV_PAGE,r1
add #256,r1
;
; Load text file to SP-length-256
;mov sp,r1
;sub r0,r1 ; r1=stack-length
;sub #256,r1 ; r1=stack-length-256
;bic #1,r1 ; Ensure even address
;
mov r0,-(sp) ; Save length
mov r1,-(sp) ; Save start
jsr pc,LoadProgFile ; Load program file
mov (sp)+,r5 ; Point to start of loaded text source
mov (sp)+,r0 ; Get length
mov SV_PAGE,-(sp) ; Stack start of dest
add r5,r0 ; Point to end of loaded data
clrb (r0) ; Put zero terminator after loaded text
clr SV_LINE ; Start at line zero before incrementing
mov (r5),r0 ; Get first two characters
cmp r0,#ASC"#"+256*ASC"!" ; Program starts with #!
bne LoadText
.LoadTextSkip
movb (r5)+,r0 ; Skip past first line
cmp r0,#32
bcc LoadTextSkip
.LoadText
add #10,SV_LINE ; Step to next line number
.LoadTextNext
; r5=>source
; (sp)=>dest
tstb (r5) ; r5=>source text
beq LoadTextEnd ; End of source text
jsr pc,TokeniseLine
;
; R5=>after end of untokenised line
; R4=>start of tokenised line
; R3= length of tokenised line excluding <cr>
; R2= linenum
;
tst r3 ; Check tokenised line length
beq LoadTextNext ; Zero-length line, skip to next
add #4,r3 ; r3=BASIC line length
mov (sp)+,r1 ; r1=>insertion point
movb #13,(r1)+ ; Insert <cr>
mov r5,-(sp)
mov r4,r5 ; R5=tokenised source
mov r2,r4 ; R4=linenum
jsr pc,InsertLine ; Insert the tokenised line
mov (sp)+,r5
dec r1 ; Point dest to <cr>
mov r1,-(sp) ; Restack dest for next line
br LoadText ; Loop for another line
.LoadTextEnd
mov (sp)+,r1 ; Get insertion point back
movb #13,(r1)+ ; Put final <cr> in
movb #&FF,(r1) ; Put terminator in place
;
; Check program consistancy, set TOP, return R1=TOP, R0=corrupted
; ---------------------------------------------------------------
.FindTOP
mov SV_PAGE,r1 ; Start at PAGE
.FindTopLp
mov r1,r0 ; r0=>start of this line
cmpb (r1)+,#13
bne BadProgram
cmpb (r1)+,#&FF
beq FindTopFound
inc r1 ; Step past line number
movb (r1),r1 ; Get length byte
bic #&FF00,r1 ; Ensure 8-bit value
cmp r1,#4
bcs BadProgram ; If len<4, invalid
add r0,r1 ; Point to next CR
br FindTopLp ; Loop to check next line
;bcc FindTopLp ; Loop if not past end of memory
.BadProgram
jsr pc,PrintInline
equs "Bad program",13,0
align
jmp ImmediateClearStop
.FindTopFound
mov r1,SV_TOP ; r1=>byte after end of program
rts pc
; SAVE str$[,start,end[,exec[,load]] - Save program/data
; ======================================================
.cmdSAVE
jsr pc,CheckEndStatement
bne cmdSAVE1 ; Not SAVE<cr>
mov r5,-(sp) ; Save LPTR
mov SV_PAGE,r5
inc r5
cmpb (r5)+,#&FF
bcc cmdSAVE0 ; Null program
inc r5
jsr pc,FetchNextChar
cmpb r0,#tknREM
bne cmdSAVE0 ; First line not REM
jsr pc,FetchNextChar
cmpb r0,#ASC">"
bne cmdSAVE0 ; First line not REM >
inc r5
mov r5,r4 ; Point to inline filename
mov (sp)+,r5 ; Restore LPTR
br cmdSAVEprog ; Save program
.cmdSAVE0
mov (sp)+,r5 ; Restore LPTR
.cmdSAVE1
jsr pc,EvalStringCR ; Get filename to R4
#ifdef FILEEXTN
jsr pc,SkipSpaceNext
cmp r0,#ASC","
beq cmdSaveData
dec r5
#endif
jsr pc,EnsureEndStatement
.cmdSAVEprog
mov SV_PAGE,FILE_START+0
mov SV_TOP,FILE_END+0
mov #&82,r0
jsr pc,IO_BYTE
mov r1,FILE_START+2 ; High word of address
mov r1,FILE_END+2
mov #&FB00,FILE_LOAD+0
mov #&FFFF,FILE_LOAD+2
clr FILE_EXEC+0
clr FILE_EXEC+2
clr r0
jsr pc,FileData ; Perform OSFILE with R0=action, R4=>filename
jmp ImmediateLoop
#ifdef FILEEXTN
; SAVE str$,start,end[,exec[,load]] - save data
; ---------------------------------------------
.cmdSaveData
jsr pc,StackStringAndOp
; inc r5 ; Step past comma
jsr pc,EvalInteger
mov r3,-(sp)
mov r4,-(sp) ; Save start
jsr pc,EvalComma
mov r3,-(sp)
mov r4,-(sp) ; Save end
cmp r0,#ASC","
bne cmdSave2 ; SAVE str$,start,end
inc r5
jsr pc,EvalInteger
mov r3,-(sp)
mov r4,-(sp) ; Save exec
cmp r0,#ASC","
bne cmdSave3 ; SAVE str$,start,end,exec
inc r5
jsr pc,EvalInteger
br cmdSave4
.cmdSave2 ; sp=>end, start
mov 6(sp),-(sp) ; sp=>start.hi, end, start
mov 6(sp),-(sp) ; sp=>start, end, start
.cmdSave3 ; sp=>exec, end, start
mov 8(sp),r4
mov 10(sp),r3 ; r3/r4=load, sp=>exec, end, start
.cmdSave4 ; r3/r4=load, sp=>exec, end, start
mov r4,FILE_LOAD+0
mov r3,FILE_LOAD+2
mov (sp)+,FILE_EXEC+0
mov (sp)+,FILE_EXEC+2
mov (sp)+,FILE_END+0
mov (sp)+,FILE_END+2
mov (sp)+,FILE_START+0
mov (sp)+,FILE_START+2
jsr pc,UnstackStringDropOp
clr r0 ; OSFILE 0 - Save
jmp FileData ; Save data and return
#endif
; SOUND commands
; ==============
; ENVELOPE a,b,c,d,e,f,g,h,i,j,k,l,m,n
; ====================================
.cmdENVELOPE
jsr pc,EvalInteger ; Get first parameter
adr MOS_BUF,r1
movb r4,(r1)+
mov #13,-(sp) ; Stack remaining number of parameters
mov r1,-(sp) ; Stack pointer to paramter block
.cmdENVlp
jsr pc,EvalComma
mov (sp),r1 ; Get pointer to parameter block
movb r4,(r1)+ ; Store parameter
mov r1,(sp) ; Save updated pointer
dec 2(sp) ; Decrement number of remaining parameters
bne cmdENVlp
mov #8,r0 ; R0=8 for ENVELOPE
br cmdSOUNDdo
; SOUND [ON|OFF|c,a,p,d] - Issue SOUND command
; ============================================
.cmdSOUND
;jsr pc,SkipSpaceThis ; could be Next, swap inc for dec
jsr pc,SkipSpaceNext
clr r1 ; SOUND ON is *FX210,0
cmpb r0,#tknON
beq cmdSOUNDon ; Jump to do SOUND ON
dec r1 ; SOUND OFF is *FX210,255
cmpb r0,#tknOFF
bne cmdSOUND2 ; Not SOUND OFF, jump past
.cmdSOUNDon
;inc r5 ; Step past ON/OFF
mov #210,r0
clr r2
jmp IO_BYTE
.cmdSOUND2 ; SOUND c,a,p,d
dec r5
jsr pc,EvalInteger ; Get first parameter
adr MOS_BUF,r1
mov r4,(r1)+
mov #3,-(sp) ; Stack remaining number of parameters
mov r1,-(sp) ; Stack pointer to parameter block
.cmdSOUNDlp
jsr pc,EvalComma ; If this evaluation calls something that uses MOS_BUF,
mov (sp),r1 ; MOS_BUF will get overwritten
mov r4,(r1)+ ; Store in parameter block
mov r1,(sp) ; Save updated pointer
dec 2(sp) ; Decrement number of remaining parameters
bne cmdSOUNDlp
mov #7,r0 ; R0=7 for SOUND
.cmdSOUNDdo
cmp (sp)+,(sp)+ ; Drop pointer and count from stack
adr MOS_BUF,r1
jmp IO_WORD
src/MakeMain
+27
View File
@@ -0,0 +1,27 @@
; > MakeMain
; BBC BASIC for the PDP11
; (C)J.G.Harston 1988-2022
; Global "insert" file
;
; Version ; Version information
; Header ; Host-specific header
#include "Startup" ; Program header, startup, immediate mode, etc.
#include "TokenEqus" ; Token values
#include "Tokens" ; Token table, errors, tokeniser, detokeniser
#include "GeneralIO"
#include "Execute" ; Program execution dispatch loop
#include "Commands" ; BASIC program commands
#include "Assembler"
#include "Evaluate" ; Expression evaluator
#include "Stack" ; BASIC stack manipulation
#include "Functions" ; BASIC program functions
#include "TrigLog"
#include "Variables"
#include "Interface"
#ifdef DEBUG
#include <Debug>
#endif
; HostIO ; Host-specific I/O
; SysVars ; Workspace
src/MakeRT11
+15
View File
@@ -0,0 +1,15 @@
; > MakeRT11
; BBC BASIC for the PDP11 running RT11
; (C)J.G.Harston 1988-2024
OSNAME$: EQU "RT11" ; Target platform
KBDEMT: EQU 224 ; KBD read with EMT 224
#define NODIV ; Don't use DIV instruction
#include "Version" ; Version settings
#include "RT11Hdr" ; RT11 host header
#include "MakeMain" ; Main BASIC code
#include "CommonIO" ; Common non-Tube I/O interface code
#include "AnsiKBD" ; ANSI keyboard parsing
#include "RT11IO" ; Interface to RT11 host I/O system
#include "SysVars" ; System variables and data buffers
src/MakeTube
+10
View File
@@ -0,0 +1,10 @@
; > MakeTube
; BBC BASIC ROM for the PDP-11 Tube CoPro
; (C)J.G.Harston 1988-2020
#define NODIV ; Don't use DIV instruction
#include "Version" ; Version settings
#include "ROMHdr" ; ROM header
#include "MakeMain" ; Main BASIC code
#include "TubeIO" ; Interface to host I/O system
#include "SysVars" ; System variables and data buffers
src/MakeUnix
+18
View File
@@ -0,0 +1,18 @@
; > MakeUnix
; PDP11 BBC BASIC on Unix
; (C)J.G.Harston 1988-2023
OSNAME$: EQU "Unix"
#define NODIV ; Don't use DIV instruction
#ifdef BSD211
OSNAME$: EQU "BSD2.11"
#define APISTK ; API calls use stack (not inline)
#define NOEMT ; Remove all EMT calls
#endif
#include "Version" ; Version settings
#include "MakeMain" ; Main BASIC code
#include "CommonIO" ; Common non-Tube I/O interface code
#include "AnsiKBD" ; ANSI keyboard parsing
#include "UnixIO" ; Interface to Unix host I/O system
#include "SysVars" ; System variables and data buffers
src/ROMHdr
+61
View File
@@ -0,0 +1,61 @@
; > ROMHdr
; --------
; 18-Jan-2001 v0.01 Service code matches *help and *command with ROM title.
; *Help prints ROM title and whole version string.
; 15-Aug-2005 v0.02 *Help prints ROM title and version number only.
; 28-Nov-2008 v0.03 *Help optimised slightly.
; 15-Aug-2015 v0.04 Simple non-matched *Help, claims *BASIC command.
; 03-Oct-2015 v0.05 Watches for Tube being set up to disable other ROMs if
; not for this CPU and claim *BASIC, checks for Master
; giving 'Not a language' on Reset.
; 17-Oct-2015 v0.06 Checks the CPU on the other side of the Tube.
; 23-Aug-2025 v0.07 Check Electron Tube and ROM table.
ORG &8000
.HeaderStart
BR HeaderEnter ; Allows entry at first byte
EQUB 0
EQUB &4C ; 6502 RTS for service entry
EQUW HeaderService
EQUB &E0+TUBECPU ; Service+Language+Tube+PDP11
EQUB HeaderCopyright-HeaderStart
EQUB 4 ; Compatible with 6502 BASIC IV
EQUS "PDP11 BASIC",0 ; ROM title
EQUB ((VERSION >> 8) AND 15)+48 ; Version string
EQUS "."
EQUB ((VERSION >> 4) AND 15)+48
EQUB (VERSION AND 15)+48
#ifdef DEBUG
EQUS " (DEBUG ",YEAR$,")" ; Version date
#else
EQUS " (",DATE$,")" ; Version date
#endif
.HeaderCopyright
EQUB 0,"(C)J.G.Harston",0 ; Copyright message
EQUD &0000B000 ; Tube transfer address
EQUD HeaderCode-HeaderStart ; Offset to Tube execution address
ALIGN
.HeaderEnter
BR HeaderCode ; Allows entry at first byte
;
.TUBECPU EQU &07
.TUBEMATCH EQU &77
.HeaderService
EQUB &48,&C9,&01,&F0,&31,&C9,&11,&F0,&68,&C9,&27,&F0,&64,&C9,&06,&F0
EQUB &40,&C9,&09,&D0,&3A,&B1,&F2,&C9,&0D,&D0,&34,&20,&E7,&FF,&A2,&00
EQUB &BD,&09,&80,&D0,&02,&A9,&20,&C9,&28,&F0,&06,&20,&EE,&FF,&E8,&D0
EQUB &EF,&20,&E7,&FF,&68,&60,&AD,&7A,&02,&30,&14,&98,&48,&A6,&F4,&2C
EQUB &B3,&FF,&30,&01,&E8,&BD,&A0,&02,&29,&BF,&9D,&A0,&02,&68,&A8,&68
EQUB &60,&A6,&F0,&BD,&02,&01,&4A,&B0,&F6,&A0,&00,&B1,&FD,&D0,&F0,&71
EQUB &FD,&C8,&C0,&17,&D0,&F9,&C9,&EA,&D0,&E5,&A6,&F4,&A9,&8E,&4C,&F4
EQUB &FF,&AD,&03,&02,&D0,&D9,&98,&48,&A9,&FF,&20,&06,&04,&90,&F9,&A9
EQUB &00,&48,&48,&A9,&F8,&48,&BA,&A0,&01,&A9,&00,&48,&20,&06,&04,&68
EQUB &68,&68,&68,&A2,&07,&CA,&D0,&FD,&AE,&E5,&FE,&2C,&B3,&FF,&10,&03
EQUB &AE,&E5,&FC,&A9,&BF,&20,&06,&04,&E0,TUBEMATCH,&D0,&91,&A0,&0F
EQUB &A2,&0F,&2C,&B3,&FF,&30,&01,&E8,&BD,&A0,&02,&29,&4F,&C9,&40+TUBECPU
EQUB &F0,&08,&BD,&A0,&02,&29,&BF,&9D,&A0,&02,&CA,&88,&10,&EB,&A4,&F4
EQUB &AE,&8C,&02,&30,&0F,&2C,&B3,&FF,&30,&01,&E8,&BD,&A0,&02,&29,&4F
EQUB &C9,&47,&F0,&03,&8C,&8C,&02,&8C,&4B,&02,&68,&A8,&68,&60
ALIGN
;
.HeaderCode
src/RT11Hdr
+76
View File
@@ -0,0 +1,76 @@
; > RT11Hdr
; RT11 header for BBC BASIC for the PDP-11
; (C)J.G.Harston 2014-2023
; 01-Jan-2014 v0.19: Initial version.
; 29-Jul-2023 v0.40: Magic values replaced with EQUs.
; Machine test values
; -------------------
.UKNCADDR equ &013E ; Are we running on UKNC?
;.UKNCOK equ &00E0 ; =&00E0 -> UKNC
.UKNCOK equ -1 ; TST NEQ -> UKNC
.VT52ADDR equ &0070 ; Are we using a VT52?
.VT52OK equ &0100 ; <&100 -> VT52
.KBDCRLF equ 1 ; Keyboard <cr> always followed by <lf>
ORG 0
; The header overlaps the RT11 header, which is overwitten later
.word 0 ; 000000 VIR in Radix-50
.word 0 ; 000002 Virtual high limit
.word 0 ; 000004 Job definition word ($JSX)
.word 0 ; 000006 Reserved
.word 0 ; 000010 Reserved
.word 0 ; 000012 Reserved
.word 0 ; 000014 BPT trap PC
.word 0 ; 000016 BPT trap PSW
.word 0 ; 000020 IOT trap PC
.word 0 ; 000022 IOT trap PSW
.word 0 ; 000024 Reserved
.word 0 ; 000026 Reserved
.word 0 ; 000030 Reserved
.word 0 ; 000032 Overlay definition word
.word 0 ; 000034 Trap vector PC (TRAP)
.word 0 ; 000036 Trap vector PSW (TRAP)
; RT-11 startup info at &0020 (&o0040)
; ------------------------------------
.word RtCode ; 000040 - RT-11 entry point
.word RtStackTop ; 000042 - RT-11 top of stack
.word (2^6)+(2^12)+(2^14) ; 000044 - Job Status Word: NOWAIT+NOECHO+NOUPPER
.word 0 ; 000046 - USR swap address
.word RtCode+BasicEnd ; 000050 - Loader sets to Initial program high memory limit
.word 0 ; 000052 - Reserved
.word 0 ; 000054 - Reserved
.word 0 ; 000056 - Reserved
; Normally ignored by RT-11
; -------------------------
.word 0 ; 000060 - Reserved
.word 0 ; 000062 - Reserved
.word 0 ; 000064 - Overlay handler address
.word 0 ; 000066 - Window definition blocks
.blkb 240-$ ; 000070
; to - Reserved
; 000356
; RT-11 code bitmap
; -----------------
.byte %11111111 ; First 4K used
.byte %11111111 ; Second 4K used
.byte %11111111 ; Third 4K used
.byte %11111111 ; Fourth 4K used
.byte %11111111 ; Fifth 4K used
.blkb 256-$ ; Pad to end of bitmap
; RT-11 initial stack space
; -------------------------
.align &200 ; Pad to end of RT-11 header
.RtStackTop ; RT-11 usually has stack here
; &o1000 : RT-11 loads code from here onwards into memory at &o1000
; -----------------------------------------------------------------
RtCode:
STARTADDR: ; Main code at this fixed address
src/RT11IO
+1564
View File
File diff suppressed because it is too large Load Diff
src/Stack
+254
View File
@@ -0,0 +1,254 @@
; > Stack
; BASIC stack manipulation and function dispatch
;
; 20-Nov-2013: Added UnstackDropStringOp.
; 23-Dec-2013: String type and length compressed to one word on stack.
; 25-Dec-2013: EvalStringCR copied to string buffer if not CR-string.
; 01-Sep-2015: High numbered functions use lookup table instead of long dispatch table.
; 29-Sep-2015: High Function lookup made postition independent.
; 28-Jul-2016: Squeezed some instructions out of Function Dispatch.
; 07-Apr-2024: Stacking strings checks for 256 bytes free space.
; StackValAndOp - Push a value and operator onto stack
; ====================================================
.StackValAndOp
tst r2
bpl StackNumAndOp ; Jump to stack number
; StackStringAndOp - Push a string and operator onto stack
; ========================================================
; On entry, sp=> retaddr
; r4=string start, r3=string length, r2=8nxx, r0=operation
; On exit, sp=> operation, type+length, string...
;
.StackStringAndOp
jsr pc,CheckFreeMemory ; Check 256 bytes available on stack, corrupts R1
mov (sp)+,r1 ; Get return address
mov r3,r2 ; Copy string length to byte count
inc r2
bic #1,r2 ; Pad to ensure even number
sub r2,sp ; Drop stack to fit string
mov sp,r2 ; Point to string space on stack
mov r3,-(sp) ; Stack length
; should this be whatever r2 on entry was to stack defprocfred($addr, etc.)
; merge with type done in cmdSub - faster as cmdSub is only place that needs it
bis #&8000,(sp) ; Merge stacked length with type, is now &8xnn
mov r0,-(sp) ; Stack operation
tst r3
beq StackStrDone ; Zero-length string
.StackStrLp
movb (r4)+,(r2)+ ; Copy byte to stack
dec r3
bne StackStrLp ; Loop to 'push' all characters
.StackStrDone
jmp (r1) ; Return via r1
; StackIntAndOp - Push integer and operator onto stack
; ====================================================
; On entry, r2/r3/r4=current value
; sp=> <empty>
; On exit, r2/r3/r4 may be corruputed
; sp=> operator, exponent, b0-b15, b16-b31
; r0 r2 r4 r3
; We stack this way around so arithmetic is easier, pop&add b0-b15, pop&add b16-b31, etc.
;
.StackIntAndOp
jsr pc,EnsureInteger ; If float, convert to integer
.StackNumAndOp ; sp=> retaddr
mov r4,-(sp) ; sp=> r4, retaddr
mov 2(sp),r4 ; sp=> r4, retaddr r4=retaddr
mov r3,2(sp) ; sp=> r4, r3 r4=retaddr
mov r2,-(sp) ; sp=> r2, r4, r3 r4=retaddr
mov r0,-(sp) ; sp=> r0, r2, r4, r3 r4=retaddr
jmp (r4) ; Return via r4
; UnstackIntAndCallOp
; ===================
.UnstackIntAndCallOp
; On entry, r2/r3/r4=RHS value
; sp=> retaddr, operator, type, b0-b15, b16-b31
; sp=> retaddr, operator, type+length, string...
;
jsr pc,EnsureInteger ; If RHS value float, convert to integer
; UnstackValAndCallOp
; ===================
; Name is slightly wrong, doesn't actually unstack, the called function does the unstacking
;
.UnstackValAndCallOp
; sp=> retaddr, operator, type, b0-b15, b16-b31
; sp=> retaddr, operator, type+length, string...
;mov 2(sp),r0 ; Get operator to r0
;mov (sp)+,r1 ; sp=> operator, type, b0-b15, b16-b31 r1=retaddr
mov (sp)+,r1 ; sp=> operator, type, b0-b15, b16-b31 r1=retaddr
mov (sp),r0 ; Get operator to r0
mov r1,(sp) ; sp=> retaddr, type, b0-b15, b16-b31
; sp=> retaddr, type+length, string
mov 2(sp),r1 ; r1=LHS type
bic #&7FFF,r1 ; Keep string/number bit
xor r2,r1 ; Is it same as RHS type
bmi errTypeMis2 ; Error if different types
;bit #&80,r0
;bne EvalChkNums ; b7 operators must be <num> <op> <num>
tstb r0
bmi EvalChkNums ; b7 operators must be <num> <op> <num>
cmp r0,#&79
bcc EvalFuncPlus ; Comparisons allowed to operate on strings
cmp r0,#ASC"+"
beq EvalFuncPlus ; '+' allowed to operate on strings
.EvalChkNums
tst r2 ; Test RHS type, will be same as LHS type
bmi errTypeMis2 ; Other operations must be <number> <op> <number>
.EvalFuncPlus
cmp r0,#&79
bcc EvalFunctionX ; Dispatch comparisons and AND/DIV/EOR/MOD/OR
;sub #3,r0 ; Reduce range for '*+,-^/'
;bic #&FFF0,r0 ; Reduce to 7..12
;bis #&80,r0 ; Move to &87..&8C
add #&5D,r0 ; Convert '*+,-^/' to &87/88/89/8a/bb/8c
bic #&70,r0 ; Convert '*+,-^/' to &87/88/89/8a/8b/8c
.EvalFunctionX
; EvalFunction - dispatch a function token
; ----------------------------------------
; r0=&FF80-&FFFF from Evaluate
; or r0=&0070-&007F from binary-op
; or r0=&FF80-&FF8F from binary-op
;
; r2/r3/r4 will be 0 if called from evaluator for tail functions
; r2/r3/r4 will be RHS for binary functions
;
.EvalFunction
bic #&FF00,r0 ; Wish I could get rid of this
mov r0,-(sp) ; Save token
cmp r0,#&C6
bcc EvalHighFunction
.EvalFunctionByte
;add r0,r0 ; Offset into command table
asl r0 ; Offset into command table
adr FunctionTable-256,r1 ; Point to command address table
add r0,r1 ; Index into command table
add (r1),r1 ; Calculate routine address
mov (sp)+,r0 ; r0=function/operator token
jmp (r1) ; Jump to routine, r0=token, (r5)=>next char
; Mustn't skipspaces, as that means 'TO P'='TOP' and 'LOAD ATN'='LOADATN'='QUIT'
.EvalHighFunction
adr FunctionBytes,r1 ; R1=>translation table
mov #&C6,r0 ; R0=effective token number &C6+
.EvalHighFunctionLp
cmpb (r1)+,(sp) ; Compare with stacked token byte
beq EvalFunctionByte ; High token matches, use translated token
inc r0
tstb (r1) ; Look for zero terminator
bne EvalHighFunctionLp ; Loop through high numbered tokens
jmp errNoSuchVar
; UnstackStringDropOp - Pop a stacked string
; ==========================================
.UnstackStringDropOp
; On entry, sp=> retaddr, op, type+length, string...
mov (sp)+,(sp) ; Overwrite op with return address
; UnstackString - Pop a stacked string
; ====================================
; On entry, sp=> retaddr, type+length, string...
; On exit, r4=string start
; r3=string length
; r2=type+length
; r1=preserved
; r0=preserved
;
.UnstackString
mov sp,r3 ; Point to stack
add #4,r3 ; Point to stacked string
; Must prevent SP from being odd
mov 2(sp),r2 ; Get type+length
jsr pc,CopyString ; Copy string from r3 to string buffer
mov 2(sp),r2 ; r2=string type+length
mov (sp)+,-(r3) ; Get return address and restack it
mov r3,sp ; Update SP
mov r2,r3 ; Copy type+length to r3
bic #&FF00,r3 ; r3=length of string
rts pc ; r1=preserved, r0=preserved
; Ensure string R4=>string R3=length is in string buffer
; ------------------------------------------------------
.EnsureString
mov r3,r2 ; r2=length
mov r4,r3 ; r3=string start
; Copy string to string buffer
; ----------------------------
.CopyString
adr SV_STRING,r4 ; Point to string buffer
bic #&FF00,r2 ; Remove type from type+length
beq CopyStringDone ; Zero-length string
.CopyStringLp
movb (r3)+,(r4)+ ; Copy bytes from stack
dec r2
bne CopyStringLp ; Loop to 'pop' all characters
inc r3
bic #1,r3 ; Align stack pointer
.CopyStringDone
adr SV_STRING,r4 ; r4=start of string
rts pc
; UnstackDropStringOp - Drop a stacked string
; ===========================================
; On entry, sp=> retaddr, dummy, type+length, string...
; On exit, r4=preserved
; r3=corrupted
; r2=corrupted
; r1=preserved
; r0=preserved
;
.UnstackDropStringOp
mov (sp)+,r2 ; Get return address
mov 2(sp),r3 ; Get stack string type+length
bic #&FF00,r3 ; Remove type
add #5,r3 ; Point past stacked data
bic #1,r3 ; Ensure even address
add r3,sp ; Point stack past stacked string
jmp (r2) ; Return to caller
; SwapStack/SwapStackMin
; ======================
; On entry, sp=>retadr, retadr, r2, r4, r3
; r2/r3/r4=value
; r0=token
; On exit, r2/r3/r4 and stacked values swapped
;
.SwapStackInt
cmp r3,8(sp)
bcs SwapStack ; Swap smallest integer into registers
rts pc
.SwapStackMin
cmp r2,4(sp) ; Compare exponents
bcs SwapStackDone ; r2/r3/r4 value already smallest
.SwapStack
mov 4(sp),r1
mov r2,4(sp)
mov r1,r2 ; Swap r2 and stacked r2
mov 8(sp),r1
mov r3,8(sp)
mov r1,r3 ; Swap r3 and stacked r3
mov 6(sp),r1
mov r4,6(sp)
mov r1,r4 ; Swap r4 and stacked r4
.SwapStackDone
rts pc
.errTypeMis2
jmp errTypeMismatch
src/Startup
+322
View File
@@ -0,0 +1,322 @@
; > Startup
; BBC BASIC for the pdp11
; (C)J.G.Harston 1988, 1989, 2005-2018
; Program header and BASIC startup, etc.
; 18-Mar-2024 Restructured ImmLineNum and InsLine to use new return from Tokeniser.
#ifdef STARTADDR
ORG STARTADDR ; If start address specified, use it
#else
ORG 0 ; Otherwise, position independent code
EQUW &0107 ; Magic number &o000407, also branch to Startup
EQUW CodeEnd-Startup ; size of text
EQUW DataEnd-CodeEnd ; size of initialised data
EQUW BasicEnd-DataEnd ; size of uninitialised data
EQUW &0000 ; size of symbol data
EQUW Startup-Startup ; entry point
EQUW &0000 ; not used
EQUW &0001 ; no relocation info
;
ORG 0 ; Position independent code
#endif
#ifdef UNIXBASE
ORG UNIXBASE ; If start address specified, use it
#endif
._TEXT%
._ENTRY%
.Startup
; On entry, SP=>initial stack, R7=Startup
; Unix: R0-R5=0
; R6=>pointers to command line strings, terminated with 0,
; then command line strings
; R5= Environment flag
; Normally, header will not have been loaded and memory will
; be mapped so Startup=&0000
; RT11: R2=stack top?
; R5=top of memory?
;
; When run in BBC environment,
; R5=&0BBC
; R0=1 if entered as a language
; If R0=1, CC=RESET, CS=OSCLI
;
; Unix Loader clears system variables. Not strictly needed as all system
; variables are initialised at some point (eg CLEAR, etc.).
; CALL 0 will not re-enter BASIC, as it will look for another filename on
; the stack.
;
jsr pc,IO_Init ; Initialise I/O, find memory limits, command line, etc.
.Restart
mov r0,SV_PAGE ; Put initial PAGE at bottom of memory
mov r1,SV_HIMEM ; Put initial HIMEM at top of memory
mov r1,sp ; Put stack at top of memory
mov #&090A,SV_VARS ; @%=&90A
adr StartupCopyright-1,r0 ; Get location of (C) message
mov r0,SV_FAULT ; Point REPORT to it
;jsr pc,IO_ReadTime ; Read raw system time to R0:R1
;mov r0,SV_RAND+0 ; Set RND seed
;mov r1,SV_RAND+2
mov #1,r0 ; R0=1 - Read TIME
adr SV_RAND,r1
jsr pc,IO_WORD ; Set RND seed from system time
clr SV_WIDTH ; Clear WIDTH and COUNT
clr SV_OPTIONS ; Clear OPTIONS and ERR
clr SV_TRACE ; Turn TRACE off
tstb SV_SYS ; Test QUIT flag
bmi jmpRunProgram ; QUIT set, run embedded program
adr SV_STRING,r4
cmpb (r4),#13 ; Get first character from string buffer
beq StartupNull ; Command line="", nothing to chain
bisb #&80,SV_SYS ; Set QUIT flag
jmp ChainStartup ; Jump to do CHAIN "filename"
; *NB* need to ensure R5=><cr> for endofstatement check to work when added
.jmpRunProgram
jsr pc,FindTOP ; Set program pointers, R5=>end of program
jmp RunProgram ; Run program
.StartupNull
jsr pc,PrintInline
.StartupMessage
EQUS "PDP11 BBC BASIC IV Version "
EQUB ((VERSION >> 8) AND 15)+48
EQUS "."
EQUB ((VERSION >> 4) AND 15)+48
EQUB (VERSION AND 15)+48
#ifdef BUILD
#if BUILD
EQUB 96+BUILD
#endif
#endif
#ifdef OSNAME$
EQUS " (",OSNAME$,")"
#endif
#ifdef DEBUG
EQUS " debug"
#endif
EQUB 13
.StartupCopyright
EQUS "(C) Copyright J.G.Harston 1989-",YEAR$,13
EQUB 0
ALIGN
; NEW - Terminate program in memory
; ---------------------------------
; PAGE?0=13
; PAGE?1=255
; TOP=PAGE+2
; Clear heap: LOMEM=TOP, VAREND=TOP, DATAPTR=PAGE
; Clear dynamic variables
; STACK=HIMEM
; Continue into immediate mode
.cmdNEW
mov SV_PAGE,r0 ; Get start of program
mov #&FF0D,(r0)+ ; Put in program terminator
mov r0,SV_TOP ; Set TOP
; Immediate mode
; --------------
.ImmediateClearStop
clr SV_AUTO ; Clear AUTO line
.ImmediateClear ; Clear heap and initialise variable addresses
jsr pc,VarsHeapInit ; LOMEM=TOP, VAREND=TOP, DATAPTR=PAGE, STACK=HIMEM
.ImmediateLoop
mov SV_HIMEM,sp ; Put system stack at top of memory
clr SV_ONERR ; Cancel ON ERROR, before OSWRCH in case it errors
clr SV_LINE ; Clear current line
mov #ASC">",r0
;jsr pc,IO_WRCH ; Print ">" prompt
mov SV_AUTO,r4 ; Get current line
beq ImmNotAuto ; No AUTO line
mov r4,-(sp) ; Save line number
movb SV_STEP,r1 ; Get AUTO STEP
bic #&FF00,r1 ; Ensure 8-bit value
add r1,r4 ; Add STEP to AUTO line
cmp #&FF00,r4
bcs ImmediateClearStop ; Run out of line numbers
;bcs errTooBig ; Run out of line numbers
mov r4,SV_AUTO ; Store updated AUTO line
mov (sp)+,r4 ; Get line number back
mov r4,SV_LINE ; Set current line number
mov #5,r1 ; Print 5 digits
jsr pc,PrintLineNumber ; Output r4 as line number
mov #ASC" ",r0
.ImmNotAuto
jsr pc,IO_WRCH ; Print a space or ">" prompt
;.ImmNotAuto
adr SV_STRING,r1 ; Point to string buffer
mov r1,r5 ; Prepare r5=>input line in case error occurs
; above prob. no longer needed as Error doesn't use R5
jsr pc,IO_ReadLine ; Read a line of input and zero COUNT
;adr SV_STRING,r5 ; Point to entered string in buffer
jsr pc,TokeniseLine ; Tokenise entered line
bne ImmLineNum ; Line number, enter line
mov r4,r5 ; Get start of tokenised line to line pointer
clr -(sp) ; Push zero word at top of stack
jmp Execute ; Execute immediate line
; OLD - Attempt to recover program in memory
; ------------------------------------------
; PAGE?0=13
; PAGE?1=0
; Find TOP
; Clear heap: LOMEM=TOP, VAREND=TOP, DATAPTR=PAGE
; Clear dynamic variables
; STACK=HIMEM
; Continue into immediate mode
.cmdOLD
mov SV_PAGE,r0 ; Get start of program
mov #&000D,(r0) ; Remove program terminator
jsr pc,FindTOP ; Check program, R5=>end of program
br ImmediateClear ; Clear heap, jump to immediate mode
; Check amount of free memory
; ---------------------------
; CheckFreeMemory - check for more than 256 bytes between heap and stack
; CheckFreeMemR1 - check for more than 256 bytes between heap and R1
;
.CheckFreeMemory
;mov sp,r0
mov sp,r1
;.CheckFreeMemR0
;sub #256,r0
;sub SV_VAREND,r0
.CheckFreeMemR1
sub #256,r1
sub SV_VAREND,r1
bcc InsAddDone
.errNoRoom
jsr pc,Error
equb 0,"No room",0
align
; Enter line into program
; -----------------------
.ImmLineNum
; R4=>start of tokenised line
; R3= length of tokenised line excluding <cr>
; R2= linenum
;
mov r4,r5
mov r2,r4 ; R5=>source, R4=linenum, R3=length
jsr pc,FindTOP ; Ensure program consistancy, R1=TOP, R0=corrupted
add r3,r1 ; R1=TOP+linelength
add #64,r1 ; Plus a bit of overhead
sub sp,r1 ; Enough space to add line?
bcc errNoRoom ; No, generate error
jsr pc,LineFind ; Find line number, R1=insert point, R5/4/3=preserved
bne InsNewLine ; No existing line to be removed
;
; Remove existing line
; R5=>start of tokenised line to insert
; R4=line number
; R3=line length
; R2=corrupted
; R1=>insert point
; R0=corrupted
;
mov r1,-(sp) ; Save insertion point
movb 3(r1),r2 ; r2=line length
bic #&FF00,r2
add r1,r2 ; r2=start of next line
br InsRemLineLp2 ; Branch to start by copying <cr>
.InsRemLineLp1
movb (r2)+,(r1)+ ; Copy line number low byte
movb (r2)+,(r1)+ ; Copy line length
.InsRemLineLp2
movb (r2)+,r0 ; Copy character from line
movb r0,(r1)+
cmpb r0,#13
bne InsRemLineLp2 ; Copy until <cr> byte
movb (r2)+,r0 ; Copy line number high byte
movb r0,(r1)+
cmpb r0,#&FF ; Is it end-of-prog marker?
bne InsRemLineLp1 ; Not end of program, loop to copy more
mov r1,SV_TOP ; Update TOP, byte after &FF terminator
mov (sp)+,r1 ; Get insertion point back
;
; R5=>start of tokenised line to insert
; R4=line number
; R3=line length
; R2=xxxx
; R1=>insert point
; R0=xxxx
.InsNewLine
tst r3
beq InsLineDone ; No new line, done
add #4,r3 ; R3=number of bytes needed to insert
mov SV_TOP,r2
mov r2,r0 ; R0=TOP
add r3,r2 ; R2=TOP+length
mov r2,SV_TOP ; New TOP
.InsInsLine
movb -(r0),-(r2) ; Move bytes upwards
cmp r0,r1
bne InsInsLine ; Loop until insertion point
inc r1 ; Step past initial <cr>
jsr pc,InsertLine ; Copy line at R5 into program at R1
.InsLineDone
br ImmediateClear ; Clear heap as program modified
; R5=>start of tokenised line to insert
; R4=line number
; R3=line length
; R2=xxxx
; R1=>insert point - return updated
; R0=xxxx
.InsertLine
swab r4
movb r4,(r1)+ ; Line number high byte
swab r4
movb r4,(r1)+ ; Line number low byte
movb r3,(r1)+ ; Line length
.InsAddLine
movb (r5)+,r0 ; Copy byte from input line
movb r0,(r1)+ ; to program space
cmpb r0,#13
bne InsAddLine ; Loop until <cr>
.InsAddDone
rts pc
.errTooBig
jsr pc,Error
equb 20,"Too big",0
align
; Parse line number parameters
; ----------------------------
; On entry, r4=default first parameter
; r3=default second parameter
; On exit, r4=first parameter
; r3=second parameter
; CC=only one parameter
; CS=zero or two parameters
;
.ParseLines10
mov #10,r4
mov r4,r3 ; Default to 10,10
.ParseLines
jsr pc,CheckEndStatement ; Any parameters?
beq ParseLinesDone ; No, use defaults
mov r3,-(sp) ; Save second default
jsr pc,ReadLineNumber ; r4/r3=start line number
bcs errTooBig ; *NB* 6502 BASIC gives Syntax error here
mov (sp)+,r3 ; Get second default back
jsr pc,SkipSpaceThis
cmpb r0,#ASC","
clc ; CC=one parameter
bne ParseLinesOne ; No second parameter
inc r5 ; Step past comma
mov r4,-(sp)
jsr pc,ReadLineNumber ; r4/r3=end line number/step
bcs errTooBig ; *NB* 6502 BASIC gives Syntax error here
mov r4,r3
mov (sp)+,r4
.ParseLinesDone
sec ; CS=zero or two parameters
.ParseLinesOne
rts pc
src/SysVars
+112
View File
@@ -0,0 +1,112 @@
; > SysVars
; System Variables
;
; 10-Feb-2013: Unix vectors moved to UnixIO
; 15-Aug 2018: MOS_BUF moved to fix alignment
.SV_PAD equm 256-((SV_PAD+6)AND255) ; 6=SV_STRING-SV_PAD, forward reference
; Misc. put here to align PAGE-SV_VARS
; ------------------------------------
.SV_RAND equd &00000000 ; RND seed Startup
.SV_RAND4 equb &00 ; Fifth byte of RND seed Startup
.SV_STEP equb &00 ; AUTO step, SV_STRING-1 used for TIME$= call AUTO
; String buffers
; --------------
.SV_STRING equm 256 ; String accumulator, immediate entry buffer, fixed at PAGE-&300
.SV_INPUT equm 256 ; Command buffer, tokenised immediate entry written here
.MOS_BUF equ SV_INPUT+256-18 ; Put at top of command buffer
.FILE_NAME equ MOS_BUF+0
.FILE_LOAD equ MOS_BUF+2
.FILE_EXEC equ MOS_BUF+6
.FILE_LENGTH equ MOS_BUF+10
.FILE_START equ MOS_BUF+10
.FILE_ATTR equ MOS_BUF+14
.FILE_END equ MOS_BUF+14
; Static variables and heap pointers
; ----------------------------------
.SV_VARS equd &00000000 ; @%
equm 26*4 ; A%-Z%
.SV_INT_O equ SV_VARS+&3C ; O%
.SV_INT_P equ SV_VARS+&40 ; P%
.SV_VARPTR equm 26*2 ; A-Z pointers
.SV_PROCPTR equw &0000 ; [ -> PROC pointer
.SV_FNPTR equw &0000 ; \ -> FN pointer
.SV_STRPTR equw &0000 ; ] -> Unused strings pointer
.SV_SYSPTR equw &0000 ; ^ -> unused pointer - could point to something
equw &0000 ; _ pointer
equw &0000 ; ` pointer
equm 26*2 ; a-z pointers
.SV_ENDPTR
; Memory structure Initialised by
; ----------------
.SV_PAGE equw &0000 ; PAGE - start of BASIC program Startup
.SV_TOP equw &0000 ; End of BASIC program VarHeapInit
.SV_LOMEM equw &0000 ; Start of BASIC variable area VarHeapInit
.SV_VAREND equw &0000 ; End of BASIC variable area VarHeapInit
.SV_STACK equw &0000 ; Bottom of BASIC stack - restored SP on local error Immediate
.SV_HIMEM equw &0000 ; Top of BASIC stack/memory Startup
; Program lines
; -------------
.SV_LINE equw &0000 ; Current line number Immediate
.SV_TRACE equw &0000 ; TRACE line number ErrorHandler
.SV_AUTO equw &0000 ; AUTO line number Startup
.SV_ERL equw &0000 ; Line number error occured in ErrorHandler
; Program pointers
; ----------------
.SV_FAULT equw &0000 ; Last error Startup
.SV_ONERR equw &0000 ; Points to after ON ERROR Immediate
.SV_DATA equw &0000 ; DATA pointer NEW/RUN
; Misc.
; -----
.SV_WIDTH equb &00 ; WIDTH Startup
.SV_COUNT equb &00 ; COUNT Startup
.SV_OPTIONS equb &00 ; LISTO and OPT options Startup
.SV_ERR equb &00 ; ERR Startup
.SV_SYS equb &00 ; System flags IO_Init
; b7-b4 generic flags
; b7=quit after running program
; b6=embedded program
; b5=BBC EMT calls available
; b4=Escape disabled
; b3-b0 platform specific flags
; Unix RT11
; b3 \ b3=
; b2 } (Unix version)-5 b2=
; b1 / b1=
; b0=fd0 stdin not a tty b0=
; b3-b1=00x - no Unix v7 calls:
; 16-bit seek(), no ioctl() use stty(), one-second timer
; <>00x - Unix v7 calls:
; 32-bit seek(), ioctl() available, millisecond timer
; <>11x - Bell Unix API (inline parameters)
; 11x - BSD Unix API (stacked parameters)
; 00x - inline API, 16-bit seek, stty, raw, one-second time, polled escape
; 01x - inline API, 24-bit seek, ioctrl, cooked, millisecond timer, background escape
; 10x - inline API, 24-bit seek, ioctrl, cooked, millisecond timer, background escape
; 11x - stacked API, 24-bit seek, ioctrl, cooked, millisecond timer, background escape
;
.FLG_QUIT equ &80
.FLG_EMBED equ &40
.FLG_BBCEMT equ &20
.FLG_ESCAPE equ &10
.SV_ESCFLG equb &00 ; Escape flag IO_Init
ALIGN
; end of 'bss' section
.BasicEnd ; End of 'uninitialised data' section
._END%
.DefaultPAGE
#if DefaultPAGE-SV_VARS<>&100 #error PAGE must be SV_VARS+&100
#if DefaultPAGE-SV_STRING<>&300 #error PAGE must be SV_STRING+&300
#ifdef SV_PAD #if (DefaultPAGE AND &FF)<>0 #error PAGE not page aligned
src/TokenEqus
+148
View File
@@ -0,0 +1,148 @@
; > TokenEqus
; Token Value Equates
; Binary operators
.tknAND equ &80
.tknDIV equ &81
.tknEOR equ &82
.tknMOD equ &83
.tknOR equ &84
; Punctuation
.tknERROR equ &85
.tknLINE equ &86
.tknOFF equ &87
.tknSTEP equ &88
.tknSPC equ &89
.tknTAB equ &8A
.tknELSE equ &8B
.tknTHEN equ &8C
.tknMissing equ &8D
; Numeric Functions
.tknLINENUM equ &8D
.tknOPENIN equ &8E
; Pseudo-variable functions
.tknPTRfn equ &8F
.tknPAGEfn equ &90
.tknTIMEfn equ &91
.tknLOMEMfn equ &92
.tknHIMEMfn equ &93
; Numeric functions
.tknABS equ &94
.tknACS equ &95
.tknADVAL equ &96
.tknASC equ &97
.tknASN equ &98
.tknATN equ &99
.tknBGET equ &9A
.tknCOS equ &9B
.tknCOUNT equ &9C
.tknDEG equ &9D
.tknERL equ &9E
.tknERR equ &9F
.tknEVAL equ &A0
.tknEXP equ &A1
.tknEXT equ &A2
.tknFALSE equ &A3
.tknFN equ &A4
.tknGET equ &A5
.tknINKEY equ &A6
.tknINSTR equ &A7
.tknINT equ &A8
.tknLEN equ &A9
.tknLN equ &AA
.tknLOG equ &AB
.tknNOT equ &AC
.tknOPENUP equ &AD
.tknOPENOUT equ &AE
.tknPI equ &AF
.tknPOINT equ &B0
.tknPOS equ &B1
.tknRAD equ &B2
.tknRND equ &B3
.tknSGN equ &B4
.tknSIN equ &B5
.tknSQR equ &B6
.tknTAN equ &B7
.tknTO equ &B8
.tknTRUE equ &B9
.tknUSR equ &BA
.tknVAL equ &BB
.tknVPOS equ &BC
; String functions
.tknCHRs equ &BD
.tknGETs equ &BE
.tknINKEYs equ &BF
.tknLEFTs equ &C0
.tknMIDs equ &C1
.tknRIGHTs equ &C2
.tknSTRs equ &C3
.tknSTRINGs equ &C4
;
.tknEOF equ &C5
; Immediate commands
.tknAUTO equ &C6
.tknDELETE equ &C7
.tknLOAD equ &C8
.tknLIST equ &C9
.tknNEW equ &CA
.tknOLD equ &CB
.tknRENUMBER equ &CC
.tknSAVE equ &CD
.tknEDIT equ &CE
; Pseudo variable commands
.tknPTRcmd equ &CF
.tknPAGEcmd equ &D0
.tknTIMEcmd equ &D1
.tknLOMEMcmd equ &D2
.tknHIMEMcmd equ &D3
; Commands
.tknSOUND equ &D4
.tknBPUT equ &D5
.tknCALL equ &D6
.tknCHAIN equ &D7
.tknCLEAR equ &D8
.tknCLOSE equ &D9
.tknCLG equ &DA
.tknCLS equ &DB
.tknDATA equ &DC
.tknDEF equ &DD
.tknDIM equ &DE
.tknDRAW equ &DF
.tknEND equ &E0
.tknENDPROC equ &E1
.tknENVELOPE equ &E2
.tknFOR equ &E3
.tknGOSUB equ &E4
.tknGOTO equ &E5
.tknGCOL equ &E6
.tknIF equ &E7
.tknINPUT equ &E8
.tknLET equ &E9
.tknLOCAL equ &EA
.tknMODE equ &EB
.tknMOVE equ &EC
.tknNEXT equ &ED
.tknON equ &EE
.tknVDU equ &EF
.tknPLOT equ &F0
.tknPRINT equ &F1
.tknPROC equ &F2
.tknREAD equ &F3
.tknREM equ &F4
.tknREPEAT equ &F5
.tknREPORT equ &F6
.tknRESTORE equ &F7
.tknRETURN equ &F8
.tknRUN equ &F9
.tknSTOP equ &FA
.tknCOLOUR equ &FB
.tknCOLOR equ &FB
.tknTRACE equ &FC
.tknUNTIL equ &FD
.tknWIDTH equ &FE
.tknOSCLI equ &FF
; &C8,&xx double-byte tokens
.tknQUIT equ &98
.tknSYS equ &99
src/Tokens
+626
View File
@@ -0,0 +1,626 @@
; > Tokens
; Token table - ok
; Tokeniser - ok
; Detokeniser - ok
; 08-Mar-2009: Tokeniser sped up using offsets for each initial letter, linenums tokenised.
; 09-Mar-2009: LineFind written.
; Tokeniser can be sped up if search terminates when initial letter no longer matches
; 24-Jul-2013: Fixed bug where '*' turned off tokenising in middle of statement
; 07-Dec-2013: TokenFind written.
; 14-Jul-2017: Tokeniser optimised, returns R3=length, R4=>string to match rest of interpreter
; 08-May-2020: TokenFind doesn't skip <cr> at end of zero-length lines.
; 09-May-2020: PROC@LOAD, FN@SAVE allowed - @ is valid identifier character.
; IF thing THEN var=1:IF thing THEN =1 doesn't tokenise the number
; Tokeniser optimised by calling EvalCheckDigit and VarCheckChar.
; 18-Mar-2024: Added SLOWTOKEN option, spaces don't reset tokeniser so ON ERROR PAGE= works.
; 27-Apr-2025: End of hex string steps back so, eg &12OR3 tokenises correctly.
; 25-Nov-2025: Bit of optimisation of tokeniser when token matched.
; REM/DATA only turn tokeniser off at start of statement, allows LOCAL DATA:...
; Two-byte tokens possible.
; Acorn-style token table
; =======================
; string, token, flag
;
; Token flag:
; Bit 0 - Conditional tokenisation (don't tokenise if followed by an alphabetic character).
; Bit 1 - Not start of statement.
; Bit 2 - Now middle of statement (command with parameters)
; Bit 3 - Expect a line number (after a GOTO, etc...).
; Bit 4 - Pseudo variable - add &40 token if at start of statement (external: hex number).
; Bit 5 - FN/PROC keyword - don't tokenise name of the subroutine.
; Bit 6 - Don't tokenise rest of line (REM, DATA, etc...)
; Bit 7 - 2-byte token (external: quote toggle)
.TokenTable
.tknA EQUB "AND" ,&80,&02 ; 00000010
EQUB "ABS" ,&94,&02 ; 00000010
EQUB "ACS" ,&95,&02 ; 00000010
EQUB "ADVAL" ,&96,&02 ; 00000010
EQUB "ASC" ,&97,&02 ; 00000010
EQUB "ASN" ,&98,&02 ; 00000010
EQUB "ATN" ,&99,&02 ; 00000010
EQUB "AUTO" ,&C6,&02 ; 00000010 ; was &0A
.tknB EQUB "BGET" ,&9A,&03 ; 00000011
EQUB "BPUT" ,&D5,&07 ; 00000111
.tknC EQUB "COLOUR" ,&FB,&06 ; 00000110
EQUB "CALL" ,&D6,&06 ; 00000110
EQUB "CHAIN" ,&D7,&06 ; 00000110
EQUB "CHR$" ,&BD,&02 ; 00000010
EQUB "CLEAR" ,&D8,&03 ; 00000011
EQUB "CLOSE" ,&D9,&07 ; 00000111
EQUB "CLG" ,&DA,&03 ; 00000011
EQUB "CLS" ,&DB,&03 ; 00000011
EQUB "COS" ,&9B,&02 ; 00000010
EQUB "COUNT" ,&9C,&03 ; 00000011
EQUB "COLOR" ,&FB,&06 ; 00000110
.tknD EQUB "DATA" ,&DC,&42 ; 01000010
EQUB "DEG" ,&9D,&02 ; 00000010
EQUB "DEF" ,&DD,&02 ; 00000010
EQUB "DELETE" ,&C7,&02 ; 00000010 ; was &0A
EQUB "DIV" ,&81,&02 ; 00000010
EQUB "DIM" ,&DE,&06 ; 00000110
EQUB "DRAW" ,&DF,&06 ; 00000110
.tknE EQUB "ENDPROC" ,&E1,&03 ; 00000011
EQUB "END" ,&E0,&03 ; 00000011
EQUB "ENVELOPE",&E2,&06 ; 00000110
EQUB "ELSE" ,&8B,&08 ; 00001000
EQUB "EVAL" ,&A0,&02 ; 00000010
EQUB "ERL" ,&9E,&03 ; 00000011
EQUB "ERROR" ,&85,&00 ; 00000000
EQUB "EOF" ,&C5,&03 ; 00000011
EQUB "EOR" ,&82,&02 ; 00000010
EQUB "ERR" ,&9F,&03 ; 00000011
EQUB "EXP" ,&A1,&02 ; 00000010
EQUB "EXT" ,&A2,&03 ; 00000011
; EQUB "EDIT" ,&CE,&02 ; 00000010 ; was &0A
.tknF EQUB "FOR" ,&E3,&06 ; 00000110
EQUB "FALSE" ,&A3,&03 ; 00000011
EQUB "FN" ,&A4,&22 ; 00100010
.tknG EQUB "GOTO" ,&E5,&0E ; 00001110
EQUB "GET$" ,&BE,&02 ; 00000010
EQUB "GET" ,&A5,&02 ; 00000010
EQUB "GOSUB" ,&E4,&0E ; 00001110
EQUB "GCOL" ,&E6,&06 ; 00000110
.tknH EQUB "HIMEM" ,&93,&17 ; 00010111
.tknI EQUB "INPUT" ,&E8,&06 ; 00000110
EQUB "IF" ,&E7,&06 ; 00000110
EQUB "INKEY$" ,&BF,&02 ; 00000010
EQUB "INKEY" ,&A6,&02 ; 00000010
EQUB "INT" ,&A8,&02 ; 00000010
EQUB "INSTR(" ,&A7,&02 ; 00000010
.tknJ
.tknK
.tknL EQUB "LIST" ,&C9,&02 ; 00000010 ; was &0A
EQUB "LINE" ,&86,&02 ; 00000010
EQUB "LOAD" ,&C8,&06 ; 00000110
EQUB "LOMEM" ,&92,&17 ; 00010111
EQUB "LOCAL" ,&EA,&06 ; 00000110
EQUB "LEFT$(" ,&C0,&02 ; 00000010
EQUB "LEN" ,&A9,&02 ; 00000010
EQUB "LET" ,&E9,&00 ; 00000000
EQUB "LOG" ,&AB,&02 ; 00000010
EQUB "LN" ,&AA,&02 ; 00000010
.tknM EQUB "MID$(" ,&C1,&02 ; 00000010
EQUB "MODE" ,&EB,&06 ; 00000110
EQUB "MOD" ,&83,&02 ; 00000010
EQUB "MOVE" ,&EC,&06 ; 00000110
.tknN EQUB "NEXT" ,&ED,&06 ; 00000110
EQUB "NEW" ,&CA,&03 ; 00000011
EQUB "NOT" ,&AC,&02 ; 00000010
.tknO EQUB "OLD" ,&CB,&03 ; 00000011
EQUB "ON" ,&EE,&06 ; 00000110
EQUB "OFF" ,&87,&02 ; 00000010
EQUB "OR" ,&84,&02 ; 00000010
EQUB "OPENIN" ,&8E,&02 ; 00000010
EQUB "OPENOUT" ,&AE,&02 ; 00000010
EQUB "OPENUP" ,&AD,&02 ; 00000010
EQUB "OSCLI" ,&FF,&06 ; 00000110
.tknP EQUB "PRINT" ,&F1,&06 ; 00000110
EQUB "PAGE" ,&90,&17 ; 00010111
EQUB "PTR" ,&8F,&17 ; 00010111
EQUB "PI" ,&AF,&03 ; 00000011
EQUB "PLOT" ,&F0,&06 ; 00000110
EQUB "POINT(" ,&B0,&02 ; 00000010
EQUB "PROC" ,&F2,&26 ; 00100110
EQUB "POS" ,&B1,&03 ; 00000011
EQUB "PUT" ,&CE,&02 ; 00000010
.tknQ
; EQUB "QUIT" ,&98,&86 ; 10000110
.tknR EQUB "RETURN" ,&F8,&03 ; 00000011
EQUB "REPEAT" ,&F5,&02 ; 00000010
EQUB "REPORT" ,&F6,&03 ; 00000011
EQUB "READ" ,&F3,&06 ; 00000110
EQUB "REM" ,&F4,&42 ; 01000010
EQUB "RUN" ,&F9,&03 ; 00000011
EQUB "RAD" ,&B2,&02 ; 00000010
EQUB "RESTORE" ,&F7,&0E ; 00001110
EQUB "RIGHT$(" ,&C2,&02 ; 00000010
EQUB "RND" ,&B3,&03 ; 00000011
EQUB "RENUMBER",&CC,&02 ; 00000010 ; was &0A
.tknS EQUB "STEP" ,&88,&02 ; 00000010
EQUB "SAVE" ,&CD,&06 ; 00000110
EQUB "SGN" ,&B4,&02 ; 00000010
EQUB "SIN" ,&B5,&02 ; 00000010
EQUB "SQR" ,&B6,&02 ; 00000010
EQUB "SPC" ,&89,&02 ; 00000010
EQUB "STR$" ,&C3,&02 ; 00000010
EQUB "STRING$(",&C4,&02 ; 00000010
EQUB "SOUND" ,&D4,&06 ; 00000110
EQUB "STOP" ,&FA,&03 ; 00000011
; EQUB "SYS" ,&99,&86 ; 10000110
.tknT EQUB "TAN" ,&B7,&02 ; 00000010
EQUB "THEN" ,&8C,&08 ; 00001000
EQUB "TO" ,&B8,&02 ; 00000010
EQUB "TAB(" ,&8A,&02 ; 00000010
EQUB "TRACE" ,&FC,&0E ; 00001110
EQUB "TIME" ,&91,&17 ; 00010111
EQUB "TRUE" ,&B9,&03 ; 00000011
.tknU EQUB "UNTIL" ,&FD,&06 ; 00000110
EQUB "USR" ,&BA,&02 ; 00000010
.tknV EQUB "VDU" ,&EF,&06 ; 00000110
EQUB "VAL" ,&BB,&02 ; 00000010
EQUB "VPOS" ,&BC,&03 ; 00000011
.tknW EQUB "WIDTH" ,&FE,&06 ; 00000110
EQUB "PAGE" ,&D0,&02 ; 00000010
EQUB "PTR" ,&CF,&02 ; 00000010
EQUB "TIME" ,&D1,&02 ; 00000010
EQUB "LOMEM" ,&D2,&02 ; 00000010
EQUB "HIMEM" ,&D3,&02 ; 00000010
EQUB "Missing ",&8D,&00 ; 00000000
EQUB &00
ALIGN
#ifndef SLOWTOKEN
.TokenOffsets
EQUW tknA-TokenTable
EQUW tknB-TokenTable
EQUW tknC-TokenTable
EQUW tknD-TokenTable
EQUW tknE-TokenTable
EQUW tknF-TokenTable
EQUW tknG-TokenTable
EQUW tknH-TokenTable
EQUW tknI-TokenTable
EQUW tknJ-TokenTable
EQUW tknK-TokenTable
EQUW tknL-TokenTable
EQUW tknM-TokenTable
EQUW tknN-TokenTable
EQUW tknO-TokenTable
EQUW tknP-TokenTable
EQUW tknQ-TokenTable
EQUW tknR-TokenTable
EQUW tknS-TokenTable
EQUW tknT-TokenTable
EQUW tknU-TokenTable
EQUW tknV-TokenTable
EQUW tknW-TokenTable
#endif
.TokeniseEVAL
mov r4,-(sp) ; Save destination
mov #2,r2 ; Set flags to 'within statement'
br TokenLoop
; Tokenise entered line and line number
; -------------------------------------
; On entry, r5=>untokenised source, may have leading spaces
; On exit, R5=>after <cr> at end of input line
; R4=>start of tokenised line
; R3= length of tokenised line excluding <cr>
; R2= line number, EQ/NE set
;
.TokeniseLine
jsr pc,ReadLineNumber ; r4=line number (CC) or zero (CS)
bcs TokeniseLineNoNum ; No line number entered
mov r4,SV_LINE ; Set current input line number
.TokeniseLineNoNum ; r5=>start or line or after line number
adr SV_INPUT,r4 ; r4=>dest in input buffer
; Fall through into tokeniser
; Tokeniser
; =========
; On entry, R5=>untokenised text
; R4=>destination buffer
; Enter at Tokenise - use LISTO options
; TokenStrip - strip leading spaces
; TokenNoStrip - keep leading spaces
; Uses R3=>token table address
; R2= current tokeniser flags
; R1= new tokeniser flags
; R0= character
; On exit, R5=>after <cr> at end of input line
; R4=>start of tokenised line
; R3= length of tokenised line excluding <cr>
; R2= line number, EQ/NE
;
.Tokenise
movb SV_OPTIONS,r0
beq TokenNoStrip ; LISTO=0, don't strip leading spaces
.TokeniseStrip
cmpb (r5)+,#ASC" "
beq TokeniseStrip ; Skip leading spaces
dec r5
.TokenNoStrip
mov r4,-(sp) ; Save destination
.TokenZero
clr r2 ; Clear tokeniser flags
.TokenNext
.TokenLoop
movb (r5)+,r0 ; Get current character
cmp r0,#9
beq TokenNext ; Skip any embedded TABs
dec r5 ; Point to current character
bit #&F0,r2 ; Any skip flags set?
bne TokenByte ; Inside quote/REM/PROCFN/hex
bit #&08,r2 ; Is a line number expected?
beq TokenNotLine ; No, try to tokenise
jsr pc,TokeniseNumber ; Tokenise line number
; CC=not a number, r5=>this character, r0=character
; CS=number entered, r5=>next character
bcs TokenLoop
.TokenNotLine
cmp r0,#ASC"A" ; Tokens start with a letter
bcs TokenByte ; <'A', enter character
cmp r0,#ASC"X"
bcc TokenByte ; >'W', enter character
jsr pc,TokenSearch ; Search token table
; Returns r5=>before next character
; r4= unchanged, output pointer
; r2= unchanged, current tokeniser flags
; r1= new tokeniser flag
; r0= byte to enter, token or char
;bpl TokenWord0 ; Not a two-byte token
;movb #&C8,(r4)+ ; Insert prefix byte
;bic #128,r1
;.TokenWord0
bit #2,r2 ; Are we at the start of statement?
bne TokenWord1 ; No, enter token/char
bit #16,r1 ; Is this a pseudo-variable?
beq TokenWord2 ; No, enter unchanged
add #&40,r0 ; Convert token to command token
.TokenWord1
bic #&40,r2 ; Middle of statement, don't turn tokeniser off
.TokenWord2
mov r1,r2 ; Copy new flags to current flags
.TokenByte
inc r5 ; Increment input pointer
movb r0,(r4)+ ; Enter byte in output buffer
bmi TokenLoop ; Token entered, loop back
cmp r0,#ASC" " ; At end of line?
beq TokenSpace ; Terminate PROC/FN, hex, LineNum
bcc TokenNotCR ; Not end of line, jump to check character
;movb SV_OPTIONS,r0
;beq TokenLineEnd ; LISTO=0, don't strip trailing spaces
;strip trailing spaces
;
.TokenLineEnd
movb #&FF,(r4) ; Put &FF after <cr>
movb #13,-(r4) ; Ensure <cr> terminator
; R5=>after <cr> at end of source, for textload
mov r4,r3 ; R3=>end of string
mov (sp)+,r4 ; R4=>start of string
sub r4,r3 ; R3=length of string
mov SV_LINE,r2 ; R2=line number, EQ/NE set
rts pc
.TokenNotCR
cmp r0,#34 ; Is char quote?
bne TokenNotQuote ; No, jump to next check
add #128,r2 ; Toggle quote flag
br TokenLoop ; Loop back to continue tokenising
.TokenNotQuote
bit #&C0,r2 ; Inside quotes or REM/DATA/*cmd?
bne TokenLoop ; Loop back, ignoring character
cmp r0,#&3A ; Is char colon?
beq TokenZero ; Loop back to reset to start of statement
cmp r0,#ASC"*" ; Is char star?
bne TokenNotStar ; No, jump to next check
bit #&02,r2 ; At start of statement?
bne TokenLoop ; No, treat as normal character
mov #&40,r2 ; Treat rest of line as comment
br TokenLoop ; Jump back to continue scanning line
.TokenNotStar
bis #&02,r2 ; Set 'not at start of statement'
cmp r0,#ASC"&" ; Is char hex number?
bne TokenNotHex ; No, jump to next check
mov #&10,r2 ; Set 'scanning hex number'
br TokenLoop ; Continue scanning line
.TokenNotHex
bit #&20,r2 ; Scanning PROC/FN?
bne TokenPROCFN
bit #&10,r2 ; Scanning hex?
bne TokenHex
cmp #ASC"@",r0 ; Digits and punctuation, continue scanning
br TokenCheckEnd
.TokenHex
jsr pc,CheckHexDigit ; Keep going through hex digits
bcc TokenLoop ; Still a hex character
dec r5 ; Step back so eg &12OR3 tokenises
dec r4
br TokenSpace
.TokenPROCFN
jsr pc,VarChkChar ; Still identifier, continue scanning
.TokenCheckEnd
bcc TokenLoop ; Loop for next PROC/FN, Hex, LineNum character
.TokenSpace
bic #&30,r2 ; Clear PROC/FN, Hex flags
br TokenLoop
.TokeniseNumber
mov r4,-(sp) ; Save output pointer
jsr pc,ReadLineNumberHere ; Read number to R3/R4, already skipped spaces
mov r4,r1 ; R1=line number
mov (sp)+,r4 ; Get output pointer back
bcs TokenNotNumber ; Not a valid line number, not a digit or too big
mov r1,r2
movb #&8D,(r4)+ ; Line number marker
swab r2
ror r2
ror r2
bic #&FFCF,r2
mov r1,r0
bic #&FF3F,r0
bis r0,r2
ror r2
ror r2
mov #&14,r0
xor r0,r2
mov #3,r0
swab r1
br TokenNumLp2
.TokenNumLp1
mov r1,r2
bic #&FFC0,r2
.TokenNumLp2
bis #&40,r2
movb r2,(r4)+
swab r1
dec r0
bne TokenNumLp1
;mov r4,r4 ; Update output pointer
mov #8,r2 ; Still expecting numbers
sec ; CS=line number returned
rts pc
.TokenNotNumber
clc ; CC=no line number
rts pc
; Search token table
; ==================
; On entry, R5=>input string to match
; R4=>dest
; R2= current flags
; R0= current char
; On exit, R5=>last char
; R4=unchanged
; R3 corrupted
; R2=old flags
; R1=new flags
; R0=token or character
; if token matched, R0=token, R5=>end of matched string, MI/EQ from new flags
; if not matched, R0=byte, R5=>current char, MI/EQ from current flags
; Caller doesn't check C/NC or other flags
.TokenSearch
#ifndef SLOWTOKEN
adr TokenOffsets-2*ASC"A",r3
asl r0
add r0,r3 ; r3=>offset for initial character
mov (r3),r0
adr TokenTable,r3
add r0,r3 ; r3=>start of tokens for this character
#else
adr TokenTable,r3 ; r3=>start of token table
#endif
;
.SearchTable
mov r5,r1 ; Save source pointer
.SearchLoop
movb (r5),r0 ; Get source character
cmpb r0,(r3) ; Compare with token character
beq SearchMatch ; Match, check if full match
cmp r0,#ASC"." ; Abbreviation?
beq SearchDot ; Jump to match abbreviation
.SearchNext
inc r3 ; Step past this token
movb (r3),r0
bpl SearchNext ; Loop until token byte
inc r3 ; Step past token byte
.SearchNextBack
mov r1,r5 ; Restore source pointer
inc r3 ; Step past flag to next token
cmpb (r5),(r3) ; Do initial characters still match?
#ifndef SLOWTOKEN
beq SearchLoop ; Yes, search next token
#else
bcc SearchLoop ; Yes, search next token
#endif
movb (r5),r0 ; Get first char back
mov r2,r1 ; new flags=old flags
rts pc
; R0=char, R1=old flag, R2=old flag, R3=corrupted, R4=preserved, R5=>current char
; flags=set from token flags
.SearchFound
dec r5 ; Point to last character of source
.SearchDot
;inc r3 ; Step to end of token
;movb (r3),r0
movb (r3)+,r0 ; Step to end of token
bpl SearchDot ; Loop until token byte fetched
;inc r3 ; Step to flag byte
movb (r3),r1 ; Get new flags
;sec ; Caller never checks C/NC
rts pc
; R0=token, R1=new flag, R2=old flag, R3=corrupted, R4=preserved, R5=>last char
; flags=CS, flags set from token flag
.SearchMatch
inc r5 ; Step to next source char
inc r3 ; Step to next token char
;movb (r3),r0 ; Get next byte
tstb (r3) ; Test next byte
bpl SearchLoop ; Not a token, loop to check next character
;inc r3 ; Point to flag
;bitb #1,(r3) ; Needs nonalpha terminator?
bitb #1,1(r3) ; Needs nonalpha terminator?
beq SearchFound ; No nonalpha needed, token matched
movb (r5),r0 ; Get following source character
cmp r0,#ASC"A"
bcs SearchFound ; <'A', matched
cmp r0,#ASC"Z"+1
bcc SearchFound ; >'Z', matched
; copy source to dest
; r4=>dest
; r5=>last source char+1
; r1=>first source char
.SearchAlpha
movb (r1)+,(r4)+
cmp r1,r5
bne SearchAlpha
dec r4
movb (r4),r0 ; is this needed?
dec r5
mov r2,r1
clc
rts pc
;.SearchFound
;dec r5 ; Point to last character of source
;movb (r3),r1 ; Get new token flag
;dec r3 ; Point to token byte
;movb (r3),r0 ; Get token byte
;sec
;rts pc
; R0=token, R1=new flag, R5=last matched char
; flags=CS
; Print character or token
; ========================
; On entry, r0=character
; On exit, r0,r2 corrupted
;
.PrintR0TokenChar
tstb r3 ; Within a string?
bne PrintAscii ; Print via OSASCI
.PrintR0Token
tstb r0 ; Is it a token?
bpl PrintAscii ; No, print via OSASCI
mov r1,-(sp)
adr TokenTable,r2
.DetokeniseLp1
mov r2,r1 ; Save start of this token string
.DetokeniseLp2
tstb (r2)+ ; Loop to find b7=1
bpl DetokeniseLp2
inc r2 ; Step past tokeniser flags
cmpb r0,-2(r2)
bne DetokeniseLp1 ; No match, loop back
.DetokeniseLp3
movb (r1)+,r0
bmi DetokeniseDone ; Exit if b7 set
jsr pc,PrintR0 ; Print character
br DetokeniseLp3
.DetokeniseDone
mov (sp)+,r1
rts pc
; Read line number
; ================
; On entry, r5=>start of number
;
.ReadLineNumber ; r5=>may be leading spaces
jsr pc,SkipSpaceThis
;
.ReadLineNumberHere
; On entry, r5=>start of number
; r0= first character, not yet checked
; On exit, CS: not a line number
; r5=>unchanged, first character, not a digit
; r0= character at (R5)
; CC: a line number
; r4=line number
; r5=>first non-digit character
; r0= character at (R5)
jsr pc,CheckDigit
bcs ReadLineNotNum2 ; Not a decimal number
mov r5,-(sp) ; Save line pointer
jsr pc,EvalDecimalInt ; Read integer number to R3/R4, r5=>non-digit, r0=(R5)
tst r3
sec
bne ReadLineNotNum1 ; Number>65535
cmp #&FF00,r4 ; SC if number>&FF00
bcs ReadLineNotNum1
tst (sp)+ ; Drop saved line pointer, clear Carry
rts pc ; CC=valid line number
.ReadLineNotNum1
mov (sp)+,r5 ; Restore line pointer
movb (r5),r0 ; R0=character at (R5)
.ReadLineNotNum2
rts pc ; CS=invalid line number
; Find line in program
; ====================
; On entry, r4=line number
; On exit, r1=><cr> just before line to execute, to pass to r5
; CC+EQ, line found
; CC+NE, line not found
; MI+CS+NE, end of program
; Corrupts r0, r2
;
.LineFind
mov SV_PAGE,r1
.LineFindLp
movb 1(r1),r0 ; Get line number high
cmpb r0,#&FF
beq LineFindEnd ; End of program
movb 2(r1),r2 ; Get line number low
swab r0
bic #&00FF,r0
bic #&FF00,r2
bis r2,r0 ; r0=line number
cmp r0,r4 ; Got to matching or higher line number?
bcc LineFindFound ; r1=><cr> before matching line
movb 3(r1),r0
bic #&FF00,r0
add r0,r1 ; Step to next line
br LineFindLp
.LineFindEnd
tst r0 ; NE
sec
.LineFindFound
; If line found, CC+EQ, r1=><cr> before matching line
; If line not found, CC+NE, r1=><cr> before next line
; If end of program, MI+CS+NE, r1=><cr> before &FF end marker
rts pc
; TokenFind - Look for a line starting with a token
; =================================================
; On entry, r0= token to look for, eg DEF, DATA
; r1=>current search point
; On exit, r1=>after matching token
; CC= Line not found
; CS= Line found
.TokenFindLp1
dec r1 ; Step back to current character
.TokenFind
cmpb (r1)+,#13 ; Skip until <cr>
bne TokenFind
cmpb (r1)+,#&FF
beq TokenFindEnd ; CC=End of program
inc r1 ; Step past <linelo>
.TokenFindLp2
inc r1 ; Step past <len>
cmpb (r1),#ASC" "
beq TokenFindLp2 ; Skip any leading spaces
cmpb (r1)+,r0 ; Check if matching token
bne TokenFindLp1 ; No match, skip this line
sec ; CS=Line found
.TokenFindEnd
rts pc
src/TrigLog
+46
View File
@@ -0,0 +1,46 @@
; > TrigLog
; Trigonometric and logarithmic functions
; 16-Aug-2018: DEG and RAD done, PI moved here.
; Trigonometrical functions
; =========================
.fnPI
mov #&DAA2,r4 ; mantissa=&xxxxDAA2
mov #&490F,r3 ; mantissa=&490Fxxxx
mov #&0081,r2 ; real exponent=&81
rts pc
.fnDEG
jsr pc,Eval180PI ; Stack 180/PI and evaluate float
jsr pc,fnMultiplyFloat ; DEG=(180/PI)*RAD
rts pc ; Note, stack adjusted so can't JMP
.fnRAD
jsr pc,Eval180PI ; Stack 180/PI and evaluate float
jsr pc,fnDivideSwap ; RAD=(180/PI)/DEG
rts pc ; Note, stack adjusted so can't JMP
.Eval180PI
mov (sp),r1 ; Get return address
mov #&652E,(sp) ; Push 180/PI
mov #&E0D3,-(sp)
mov #&0085,-(sp)
mov r1,-(sp) ; Push return address back
jmp EvalFloatVal ; Evaluate parameter as a float
.fnACS
.fnASN
.fnATN
.fnCOS
.fnSIN
.fnTAN
; Logarithmic functions
; =====================
.fnEXP
.fnLN
.fnLOG
jmp EvalFloatVal ; Get float, return it
src/TubeIO
+154
View File
@@ -0,0 +1,154 @@
; > TubeIO
; Minimal interface to Tube system
; 26-Jan-2014 v0.19b IO_CommandLine combined with IO_Init
; 11-Aug-2015 v0.20a IO_Init doesn't look for Unix stack frame in BBC environment
; 31-Aug-2015 v0.21a IO_Init tidied up, assumes caller sets default handlers
; 16-Jul-2017 v0.26c Bugfix for bug in Tube Client v0.25
;TUBEBUG: EQU 1 ; Bug in Tube Client
; Initialise Host I/O system
; ==========================
; On entry, r6=>top of memory-2, bottom of stack, startup parameters
; stacked parameters end with -1 or 0 (documented as 0, actually -1)
; r5=&0BBC for BBC environment or <>&0BBC otherwise
; r1=>command line if r0=1
; r0=1 entered as a language
; r0=0 entered as raw code or Unix code that has had header stripped
; CC=entered from RESET, CS=entered from OSCLI
; On exit, r0=bottom of memory
; r1=top of memory
;
.IO_Init
bcs IO_Init1 ; Not Cy=0 on entry, not RESET entry
asr r0
bne IO_Init2 ; Not R0=0 or R0=1 on entry, not language entry
mov #11,r0 ; If RESET, move up two lines to overwrite ROM title
emt 4
emt 4
; Copy any command line to string buffer
; --------------------------------------
.IO_Init1
.IO_Init2
;movb #13,SV_STRING ; Store null string as command line
adr SV_STRING,r2 ; Point to string buffer
.IO_CommandLine
movb (r1)+,r0 ; Copy command line to string buffer
movb r0,(r2)+
cmpb r0,#13
bne IO_CommandLine ; Loop until <cr> copied
; Set BBC handlers
; ----------------
mov #1,r0
emt 13 ; Create new program environment
mov #-2,r0 ; r0=-2 = Escape handler
clr r1 ; r1=Keep default handler routine
adr SV_ESCFLG,r2 ; r2=New handler address
emt 14 ; Set Escape flag
dec r0 ; r0=-3 = Error handler
adr ErrorHandler,r1 ; r1=New handler routine
clr r2 ; r2=Keep default buffer address
emt 14 ; Set Error handler
mov #&20,SV_SYS ; Clear SYS and ESCFLG, set BBC EMTs available
#ifdef TUBEBUG
mov #-10,r0 ; Bugfix for broken Tube Client
adr Startup,r1 ; Set PROG to me
clr r2
emt 14
#endif
; Return memory limits
; --------------------
mov #&84,r0
jsr pc,IO_BYTE ; r1=top of memory
mov r1,-(sp)
dec r0 ; r0=&83
jsr pc,IO_BYTE ; r1=bottom of memory
adr DefaultPAGE,r0 ; r0=end of code
cmp r1,r0
bcs IO_Init4 ; End of code is higher than bottom of memory, use it instead
mov r1,r0 ; Bottom of memory is higher than end of code, use it
.IO_Init4
mov (sp)+,r1
.IO_NoError
.IO_NoEscape
rts pc
; Check for Escape state
; ======================
.IO_EscapeFast
.IO_Escape
tstb SV_ESCFLG ; Check local Escape flag
bpl IO_NoEscape ; Return with no Escape state
.errEscape
jsr pc,Error ; Generate Escape error
equb 17,"Escape",0
align
; Direct calls to BBC MOS I/O calls
; =================================
.IO_QUIT0 clr r0
.IO_QUIT mov r0,-(sp) ; Save return value
mov #2,r0
emt 13 ; Set default handlers
mov (sp)+,r0 ; Get return value back
emt 0 ; Won't actually get back!
BR IO_Return ; But just in case
.IO_CLI emt 1 ; r0=>command string
BR IO_Return
.IO_BYTE emt 2 ; Osbyte r0,r1,r2
BR IO_Return
.IO_WORD emt 3 ; Osword r0,r1=>block
BR IO_Return
.IO_WRCR mov #13,r0
br IO_WRCH
.IO_ASCI cmp r0,#13
beq IO_NEWL
.IO_WRCH emt 4 ; Oswrch r0=char
BR IO_Return
.IO_NEWL emt 5 ; Print NEWLINE
BR IO_Return
.IO_RDCH emt 6 ; Osrdch r0=char
BR IO_Return
.IO_FILE emt 7 ; Osfile r0=action, r1=>block
BR IO_Return
.IO_ARGS emt 8 ; Osargs r0=action, r1=>block, r2=handle
BR IO_Return
.IO_BGET emt 9 ; Osbget r1=handle
BR IO_Return
.IO_BPUT emt 10 ; Osbput r0=byte, r1=handle
BR IO_Return
.IO_GBPB emt 11 ; Osgbpb r0=action, r1=>block
BR IO_Return
.IO_FIND emt 12 ; Osfind r0=action, r1=>filename or handle
; BR IO_Return
;.IO_SYST emt 13
; BR IO_Return
;.IO_CTRL emt 14
; BR IO_Return
;.IO_ERROR emt 15 ; Generate inline error
.IO_Return BVC IO_NoError
; BVS IO_Error
;.IO_ReadTime rts pc ; Dummy read system time to R1:R0
.IO_Error jmp ErrorHandler; R0=>error block byte,string,zero byte
EQUW 0 ; No extra embedded data
.CodeEnd ; End of 'text/code' section
; end of 'text' section
; +++++++++++++++++++++++
; +++++++++++++++++++++++
; start of 'data' section
.DataEnd ; End of 'data' section
; end of 'data' section
; +++++++++++++++++++++++
; +++++++++++++++++++++++
; start of 'bss' section
BSS ; End of saved portion
src/UnixIO
+2002
View File
File diff suppressed because it is too large Load Diff
src/Variables
+743
View File
@@ -0,0 +1,743 @@
; > Variables
; Handle BASIC variables
; 24-Feb-2009: Static integer variables and indirection
; 25-Feb-2009: Reading $<addr> and $$<addr>
; 15-May-2010: VarFind returns combined type/size in r3, <base><ind><off> works
; 31-Jan-2012: Finds and creates dynamic variables, all heap items now word aligned
; cmdCLEAR now here, VarFind now never returns "invalid name", always gives an error
; 23-Nov-2012: address|offset allowed
; 09-Dec-2013: FindSubroutine moved to here so callable by AddrOf, VarFind tweeked to not
; store terminating bracket with PROCname(, FNname(
; 02-Feb-2014: Array variables returned
; 31-Aug-2015: fnREPORT moved here to return via FindStringVal
; CLEAR - Clear heap
; ==================
; LOMEM=TOP
; VAREND=TOP
; DATAPTR=PAGE
; STACK=HIMEM
; Clear dynamic variables
.cmdCLEAR ; Fall through
.VarsHeapInit
mov SV_PAGE,SV_DATA ; DATAPTR=PAGE, start of program
mov (sp),r1 ; Get return address
mov SV_HIMEM,sp ; Clear BASIC stack
clr -(sp) ; Put zero at top of stack
mov sp,SV_STACK ; Clear error stack
mov r1,-(sp) ; Stack return address
mov SV_TOP,r4 ; r4=TOP
br VarsClear
; LOMEM= - Set heap start, clearing heap
; ======================================
; Check for '=', evaluate integer
; Set LOMEM
; Set VAREND=LOMEM
; Clear dynamic variables
.cmdLOMEM
jsr pc,EvalEqual ; Check for '=', get integer
.VarsClear
inc r4 ; Pad upwards, if LOMEM=TOP and TOP is odd
bic #1,r4 ; Ensure word aligned
mov r4,SV_LOMEM ; Set new LOMEM, start of heap
mov r4,SV_VAREND ; Set new VAREND, end of heap
adr SV_VARPTR,r1 ; Point to variables pointers
mov #(SV_ENDPTR-SV_VARPTR)/2,r0 ; Number of pointers
.VarsClearLp
clr (r1)+ ; Clear this pointer
dec r0
bne VarsClearLp ; Loop for all pointers
.VarFindExit1
rts pc
; VarFindCreateAddress
; ====================
; Called from AddrOf function
; r0= first character
; r5=>first character
;
.VarFindCreateAddress
tstb r0
bpl VarFindCreate ; Not FN/PROC, scan for variable
; VarFindSubroutine - Find a FN/PROC in the heap, or in the program
; =================================================================
; On entry, r0= FN/PROC token
; r5=>FN/PROC at start of name
; On exit, Error if doesn't exist
; r5=>after end of variable name
; r4=address of data block
; r3/r2/r1/r0=corrupted
;
.VarFindSubroutine
inc r5 ; r5=>FN/PROC name
; FindSubroutine - called here from FN/PROC dispatch
; --------------------------------------------------
; On entry, r0= FN/PROC token
; r5=>first character of name
;
.FindSubroutine
mov r0,-(sp) ; Save FN/PROC token
jsr pc,VarFindPROC ; Look for FN/PROC in heap
bne FindSubFound ; In heap, jump to call it
; Look for DEFPROC/DEFFN in program
; r4=>heap pointer to add to
; r5=>1st char of name
;
mov SV_PAGE,r1
.FindSubSearch
mov #tknDEF,r0
jsr pc,TokenFind ; Look for a line starting with DEF
bcc errNoSuchPROC ; End of program with no match found
.FindSubSpace
movb (r1)+,r0
cmpb r0,#ASC" "
beq FindSubSpace ; Skip spaces after DEF
cmpb r0,(sp) ; Is it a FN/PROC
bne FindSubSearch ; No, keep looking
; We've now found a DEFPROC or a DEFFN
; r5=>start of FN/PROC name in call
; r4=>heap pointer to add to
; r1=>start of FN/PROC name in definition
mov r5,r3
mov r1,r2
.FindSubLp
movb (r1)+,r0 ; Get character from definition name
jsr pc,VarChkChar ; End of definition name?
bcs FindSubMatch ; Yes, check for end of calling name
cmpb r0,(r3)+ ; Does it match call name?
beq FindSubLp ; Yes, loop to check more characters
bne FindSubSearch ; No match, look for another DEF
.FindSubMatch
movb (r3)+,r0 ; Get character from call name
jsr pc,VarChkChar ; End of name calling name?
bcc FindSubSearch ; Not end of calling name, look for another
dec r3
dec r1
; We've now found a matching DEFPROC or a DEFFN
; r5=>start of FN/PROC name in call
; r4=>heap pointer to add to
; r3=>end of FN/PROC name in call
; r1=>end of FN/PROC name in definition
mov (sp),r2 ; r2=FN/PROC token
mov r1,-(sp) ; Save destination address
jsr pc,VarCreate ; Create entry in heap
; r0= terminating calling character
; r2= FN/PROC token
; r3= corrupted
; r4=>data block
; r5=>just after calling FN/PROC name
; (sp)= destination address
mov (sp)+,(r4) ; Store dest address in heap
.FindSubFound
mov (sp)+,r0
rts pc
.errNoSuchPROC
jsr pc,Error
equb 29,"No such ",tknFN,"/",tknPROC,0
align
; VarFindCreate - Find a variable, and create it if non-existant
; ==============================================================
; On entry, r5=>first character of name
; On exit, CS=bad variable name - error generated
; CC=valid variable name
; NE=variable found
; r5=>after end of variable name
; r4=address of data block
; r3=size/type of variable
; 0001 - byte
; 0004 - integer
; 0005 - real
; 8000 - dynamic string
; 8100 - $string
; 8200 - $$string
; 4xxx - array of number
; Cxxx - array of string
; r2/r1/r0=corrupted
;
.VarFindCreate
jsr pc,SkipSpaceThis
.VarFindCreate1
jsr pc,VarFindExist ; Look for variable
bne VarFindExit1 ; NE - Variable found
clr r2 ; r2=0 - not FN/PROC
; Valid variable name, but doesn't exist
; r4=>last link, aligned
; r5=>second character of variable name
; r2=0 - not FN/PROC or array - don't create entry ending with '('
; r2<>0 - FN/PROC or array - ok to create entry ending with '('
; r2<&80 - array - include '(' in entry name
; r2>&7F - FN/PROC - don't include '(' in entry name
; Variable info block layout:
; <link><name><00><aa><bb><cc><dd><ee>
; <link><name>%<00><aa><bb><cc><dd>
; <link><name>$<00><ll><hh><len><max>
; <link><name>(<00><ll><hh>
; <link><name>%(<00><ll><hh>
; <link><name>$(<00><ll><hh>
; <link><procname><00><ll><hh>
; <link><fnname><00><ll><hh>
.VarCreate
mov r5,-(sp) ; Save pointer to variable name
mov #16+256,r1 ; Size of info block plus some overhead
.VarCreateLp1
inc r1 ; Count length of variable name
movb (r5)+,r0 ; Get variable name character
jsr pc,VarChkChar
bcc VarCreateLp1 ; Loop for valid characters
;This is wrong place for this test
;tst r2
;bne VarCreate0 ; PROC/FN, terminating '(' allowed
;cmpb r0,#ASC"("
;bne VarCreate0
;jmp errArray ; Arrays must already exist
;.VarCreate0
mov SV_VAREND,r0 ; End of heap, will be aligned if not manually messed with
add r0,r1 ; Add length of variable name and info block
cmp r1,sp ; Would this overlap stack?
bcs VarCreate1
jmp errNoRoom
.VarCreate1
mov (sp)+,r5 ; Get pointer to variable name
mov r0,(r4) ; Point current link to new info block at VAREND
mov r0,r4 ; r4=>new variable info block
clr (r4)+ ; Set next link to zero
.VarCreateLp2
movb (r5)+,r0 ; Get variable name character
movb r0,(r4)+ ; Store in info block
jsr pc,VarChkChar
bcc VarCreateLp2 ; Loop to end of variable name
;
; r5=v
; a
; a(
; a%
; a$
; a%(
; a$(
; ab
; ab%
; ab$
; ab(
; ab%(
; ab$(
mov #&4000,r3 ; r3=&4000 - FN/PROC
tstb r2
bmi VarCreatePROC ; FN/PROC, don't add '(' to name
;mov #&8000,r3 ; r3=&8000 - dynamic string
asl r3 ; r3=&8000 - dynamic string
cmpb r0,#ASC"$"
beq VarCreateIntStr
mov #&0004,r3 ; r3=&0004 - integer
cmpb r0,#ASC"%"
beq VarCreateIntStr
inc r3 ; r3=&0005 - real
cmpb r0,#ASC"("
beq VarCreateArray ; Array or PROC(/FN(
.VarCreatePROC
dec r5 ; Point program back to terminating character
dec r4 ; Step back to terminator
br VarCreateInfo
.VarCreateIntStr
movb (r5),r0
cmpb r0,#ASC"("
bne VarCreateInfo
inc r5 ; Step past '('
movb r0,(r4)+ ; Store '(' in info block
.VarCreateArray
bis #&4000,r3 ; Array
.VarCreateInfo
clrb (r4)+ ; Store terminator
clrb (r4)+ ; Pad to align
bic #1,r4 ; Ensure aligned
mov r4,r1 ; r4=>data block
clr (r1)+ ; Clear first two bytes for array
bit #&4000,r3
bne VarCreateDone ; Array
clr (r1)+ ; Clear two more bytes for String or Integer
bit #&0001,r3
beq VarCreateDone ; Not real
clr (r1)+ ; Clear two more bytes for real
.VarCreateDone
mov r1,SV_VAREND ; Update end of heap
rts pc ; r4=>data block
; r3= data type/size
; VarFindExist - Find an existing variable
; ========================================
; On entry, r5=>first character of name
; On exit, CS=bad variable name - error generated
; r5=preserved
; CC=valid variable name
; EQ=variable not found
; r5=>first character of variable name
; r4=address of previous linked list
; NE=variable found
; r5=>after end of variable name
; r4=address of data block
; r3=size/type of variable
; 0001 - byte
; 0004 - integer
; 0005 - real
; 8000 - dynamic string
; 8100 - $string
; 8200 - $$string
; 4xxx - array of number
; Cxxx - array of string
; r2/r1/r0=corrupted
;
.VarFindExist
movb (r5),r0 ; Get first character
clr r4 ; Zero base for !x, ?x, |x
cmpb r0,#ASC"!"
beq VarFindIndirect ; Evaluate !x as 0!x
cmpb r0,#ASC"?"
beq VarFindIndirect ; Evaluate ?x as 0?x
cmpb r0,#ASC"|"
beq VarFindIndirect ; Evaluate |x as 0|x
cmpb r0,#ASC"$"
beq VarFindChkDol ; Evaluate $<addr> and $$<addr>
cmpb r0,#ASC"@"
bcs VarBadName ; Bad variable name, r5 preserved
; VarFindVariable - Find a variable ignoring indirections
; -------------------------------------------------------
.VarFindVariable
movb (r5)+,r0 ; Get first character
cmp r0,#ASC"["
bcc VarFindDyn ; --> needs to call, then check for |?!
cmpb (r5),#ASC"%" ; Is it <uc>% ?
bne VarFindDyn ; No, look for dynamic variable --> indir
cmpb 1(r5),#ASC"(" ; Is it <uc>%( ?
beq VarFindDyn ; Yes, look for dynamic array entry --> indir
inc r5 ; Step past <uc>%
add r0,r0
add r0,r0 ; r0=ASC"<uc>"*4
adr SV_VARS-4*ASC"@",r4
add r0,r4 ; r4=><data block>
mov #4,r3 ; r3=&0004, integer - number, four bytes
.VarFindCheckIndir
movb (r5),r0
cmpb r0,#ASC"!" ; Is it var!offset ?
beq VarFindIndir
cmpb r0,#ASC"?" ; Is it var?offset ?
beq VarFindIndir
cmpb r0,#ASC"|" ; Is it var|offset ?
;;clc
bne VarFindExit ; NE=found
mov r5,r1 ; Save program pointer in R1
inc r5 ; Step past |
jsr pc,CheckEndStatement
bne VarFindIndirReal ; Not expression|
mov r1,r5 ; Restore program pointer, also NE=found
;;clc ; CC=ok, NE=found
;;.VarBadName
.VarFindExit
rts pc
.VarBadName
jmp errSyntax
;
.VarFindIndirReal
movb #ASC"|",r0 ; Restore r0="|"
mov r1,r5 ; Point back to indir operator
.VarFindIndir ; A%?num or A%!num
mov r0,-(sp) ; Stack indirection operator
jsr pc,VarFindValNum ; Get value of <uc>% to r4
br VarFindInd2
.VarFindChkDol
cmpb 1(r5),#ASC"$" ; Is it $$<addr> ?
bne VarFindIndirect ; No, jump for $<addr>
inc r5 ; Step past first '$'
inc r0 ; Make operator '%'
.VarFindIndirect
mov r0,-(sp) ; Stack indirection operator
.VarFindInd2
mov r4,-(sp) ; Stack base address
inc r5 ; Step past indirection operator
jsr pc,EvalIntVal ; Evaluate following numeric
add (sp)+,r4 ; Add stacked base to numeric
mov (sp)+,r3 ; Get indirection operator back
cmpb r3,#ASC"!"
beq VarFindPling ; Return with size=4
cmpb r3,#ASC"$"
beq VarFindDollar ; Return fixed cr-string
cmpb r3,#ASC"%"
beq VarFindDouble ; Return fixed null-string
cmpb r3,#ASC"?"
beq VarFindQuery ; CC=ok, return with size=1
mov #5,r3 ; |offset, float - number, five bytes
;;clc ; CC=ok, NE=found (clc not needed)
rts pc
.VarFindPling
mov #4,r3 ; name?offset - four bytes, sets NE=found
rts pc
.VarFindQuery
mov #1,r3 ; name?offset - single byte, sets NE=found
rts pc
.VarFindDollar
mov #&8100,r3 ; type=cr-string, sets NE=found
rts pc
.VarFindDouble
mov #&8200,r3 ; type=null-string, sets NE=found
rts pc
; Look for a FN/PROC in the heap
; ------------------------------
; On entry, r0= first character of name, FN/PROC
; r5=>second character
;
.VarFindPROC
mov #SV_PROCPTR-SV_VARPTR,r1
cmpb r0,#tknPROC
beq VarFindDyn1 ; Look through PROC list
mov #SV_FNPTR-SV_VARPTR,r1
br VarFindDyn1 ; Look through FN list
; Look for a variable in the heap
; -------------------------------
; On entry, r0= first character of variable
; r5=>second character
;
.VarFindDyn
jsr pc,VarChkLetter
bcs VarBadName ; Starts with invalid character
add r0,r0 ; r0=initial letter * 2
.VarFindDyn1
adr SV_VARPTR-2*ASC"A",r4
add r0,r4 ; r4=pointer to linked list
;
.VarFindNext
;;clc
mov (r4),r0 ; Get pointer to next item
beq VarFindExit ; End of linked list, exit with EQ, r4=>pointer, r5=>2nd char of name
mov r0,r4 ; r4=>current information block
mov r5,r3 ; r3=>second character of variable name
mov r4,r2
add #2,r2 ; r2=>start of stored variable name
.VarFindLp
movb (r2)+,r0 ; Get character from stored variable name
cmpb r0,(r3)+ ; Does it match program variable name
beq VarFindLp ; Yes, loop to check more characters
tst r0 ; End of stored variable name?
bne VarFindNext ; No, look for another name
;
dec r3 ; Point back to nonmatching character
dec r3 ; Point back to last matching character
movb (r3),r1 ; Get last matching character
cmpb r1,#ASC"("
beq VarFindArray ; It's an array
inc r3
movb (r3),r0 ; Get nonmatching character
jsr pc,VarChkType ; Check if valid variable name or suffix character
bcs VarFindArray ; No more characters, check for array
tstb -1(r5) ; Check first character of name
bpl VarFindNext ; Not a FN/PROC, look for another name
jsr pc,VarChkChar ; Test for middle character
bcc VarFindNext ; More characters in FN/PROC name, look for another name
br VarProcFound ; FN/PROC name found
.VarFindArray
dec r3 ; Step back to type character
movb (r3)+,r0 ; Get type character, step past character
inc r3 ; Step past '('
sbc r3 ; Step back if not '('
.VarProcFound
mov r3,r5 ; r5=>character after end of name
mov r2,r4 ; r4=>variable data block
inc r4
bic #1,r4 ; Align data block
mov #&8000,r3 ; Type=string
cmpb r0,#ASC"$"
beq VarFound
mov #&0004,r3 ; Type=integer
cmpb r0,#ASC"%"
beq VarFound
inc r3 ; Type=real
.VarFound
cmpb r1,#ASC"("
beq VarArrayFound ; Check for array references
tst r3 ; NE=found, MI=string, PL=number
bmi VarFindExit3 ; Exit with string
jmp VarFindCheckIndir ; Number - test for indirection
; matching variable name found
; name<00>
; name%<00>
; name$<00>
.VarArrayFound
cmpb (r5),#ASC")" ; Is it array()
bne VarArrayIndex
inc r5 ; Step past ')'
bis #&4000,r3 ; NE=found, &40=array, MI=string, PL=number
.VarFindExit3
;;clc ; CC=ok
rts pc
; name(<00>
; name%(<00>
; name$(<00>
.VarArrayIndex
; r5=>m,n,o,p)
; r4=>pointer to array info
;mov (r4),r4 ; r4=>array info
;beq errArray ; Array undefined
;
; r4=>dims, dim1, dim2, dim3, dim4
; r3=object type &8000, &0005, &0004
;
mov r3,-(sp) ; Save object type
mov (r4)+,-(sp) ; Save number of dimensions
clr -(sp) ; Save initial index into array
mov r4,-(sp) ; Save address of dimensions list
br VarArrayParse
.VarArrayLp
cmpb (r5)+,#ASC","
bne errBadSubscript
mov r3,-(sp) ; Stack current index
mov r1,-(sp) ; Stack pointer to current dimension
.VarArrayParse
jsr pc,EvalInteger ; Evaluate dimension
tst r3
bne errBadSubscript ; sub>65535 - too big
mov (sp)+,r1 ; r1=>current dimension
mov (r1)+,r3 ; r3= current dimension
inc r3 ; Add one to get dimension size
cmp r4,r3 ; Is subscript larger than dimension?
bcc errBadSubscript
mov (sp)+,r2 ; r2=current index
;
; sp=>num, type
; r4=subscript
; r3=current dimension max
; r2=current index
; r1=>next dimension
;
#ifndef NOMUL
mul r2,r3 ; r3=r2*r3 - offset=offset*size
#else
jsr pc,R2timesR3toR3 ; r3=r2*r3 - offset=offset*size
#endif
add r4,r3 ; offset=offset*size+subscript
dec (sp) ; Decrement number of dimensions
bne VarArrayLp ; Parse next subscript
jsr pc,CheckClose
tst (sp)+ ; Pop num
;
mov (sp)+,r2 ; Get object type
mov r3,r4
asl r4
asl r4 ; r4=index*4
bit r2,#1
beq VarArrayAdd
add r3,r4 ; r4=index*5
.VarArrayAdd
add r1,r4 ; r4=>data item
mov r2,r3 ; r3=object size, NE=variable found
rts pc
.errArray
jsr pc,Error
equb 14,"Array",0
align
.errBadSubscript
jsr pc,Error
equb 15,"Subscript",0
align
; VarFindVal - Find a variable and return its value
; =================================================
; On entry, r5=>first character of name
; On exit, r4/r3/r2=value
; r1/r0=corrupted
;
.VarFindVal
jsr pc,VarFindExist ; Find existing variable
;;bcs jmpNoSuchVar ; Bad variable name
; test here for OPT 2 in assembler
beq errNoSuchVar ; Variable not found
.VarFindValFetch
bit #&4000,r3
bne errArray ; Can't do =array() like this
tst r3 ; r3=1/4/5 int/byte/float, r3=8xxx string
bmi VarFindString ; If string, pointing to string descriptor
.VarFindValNum
clr r2 ; Prepare for integer
movb (r4)+,r0 ; Get first byte
bic #&FF00,r0
dec r3
beq VarFindByte ; Single byte
movb (r4)+,r1 ; Get second byte
bic #&FF00,r1
swab r1
bis r1,r0 ; r0=1st/2nd bytes
movb (r4)+,r1 ; Get third byte
movb (r4)+,r2 ; Get fourth byte
bic #&FF00,r1
bic #&FF00,r2
swab r2
bis r2,r1 ; r1=3rd/4th bytes
clr r2 ; Prepare for word
cmp r3,#3
beq VarFindWord
movb (r4),r2 ; Get fifth byte for float
bic #&FF00,r2
.VarFindWord
mov r1,r3
.VarFindByte
mov r0,r4
;;clc
tst r2
rts pc
.fnREPORT
cmpb (r5)+,#ASC"$" ; Check for '$'
bne errNoSuchVar
mov SV_FAULT,r4
inc r4 ; r4=>error string
mov #&8200,r3 ; r3=null-string
; Fall through to find length of null-string
; VarFindString - convert string description into full string
; -----------------------------------------------------------
; If a string found, registers will hold:
; r3=&8000, r4=>aligned string descriptor block = addr.lo, addr.hi, length, allocated
; r3=&8100, r4=>start of cr-string
; r3=&8200, r4=>start of null-string
.VarFindString
mov r3,r2 ; r2=string type
clr r3 ; Set length to zero
clr r0 ; Look for CHR$0
bit #&0200,r2 ; A null-string?
bne VarFindStrCount
mov #13,r0 ; Look for CHR$13
bit #&0100,r2 ; A cr-string?
bne VarFindStrCount
movb 2(r4),r3 ; Get string length
bic #&FF00,r3 ; 8-bit length
mov (r4),r4 ; Get string start address
clc ; CLC=OK
tst r2 ; Set flags from string type, also clears Carry
rts pc
.VarFindStrCount
mov r4,r1 ; Copy start address to r1
.VarFindStrLp
inc r3 ; Increment length
cmp r3,#256 ; String too long?
bcc VarFindStrZero ; No terminator, return null
cmpb (r1)+,r0 ; Terminator found?
bne VarFindStrLp ; No, loop until found or too long
dec r3 ; Remove terminator from count
clc ; CLC=OK
tst r2 ; Set flags from string type, also clears Carry
rts pc
.VarFindStrZero
clr r3 ; Return zero-length string
;;clc ; CLC=OK
tst r2 ; Set flags from string type, also clears Carry
rts pc
.errNoSuchVar
jsr pc,Error
equb 26,"No such variable",0
align
; Array function
; ==============
; =DIM(array()) - returns number of dimensions
; =DIM(array(),n) - return size of dimension n
;
#ifndef NOEXTRAFN
.fnDIM
cmpb (r5)+,#ASC"(" ; Check for opening bracket
bne errArray
jsr pc,VarFindExist ; Look up array
beq errNoSuchVar ; Array doesn't exist
bit #&4000,r3
beq errArray ; Not an array variable
;mov (r4),r4 ; Get start of array data
;beq errArray ; Array Undimensioned
jsr pc,SkipSpaceThis
cmpb r0,#ASC","
bne fnDIM2 ; Jump with DIM(array()) to return number of dimensions
; =DIM(array(),n)
; ---------------
mov r4,-(sp) ; Save address of array info
jsr pc,EvalComma
tst r3
bne errBadSubscript ; =DIM(array(),>65535)
tst r4
beq errBadSubscript ; =DIM(array(),0)
mov (sp)+,r3 ; r3=>array info
cmp (r3),r4
bcs errBadSubscript ; =DIM(array(),n) where n is too large
add r4,r4 ; Double r4
add r3,r4 ; Add to base of array info
.fnDIM2
jsr pc,CheckClose
;.fnDIM3
mov (r4),r4 ; Get number of dimensions or dimension size
clr r3
clr r2
;.fnDIMexit
rts pc
#endif
; Check if char is valid for a variable name
; ------------------------------------------
; CS - invalid variable name character
; CC - valid variable name character
; CC EQ - valid terminating character $ % (
;
.VarChkType ; Test for any character
cmpb r0,#ASC"("
beq VarChkCharOk ; '(' - exit with CC, EQ
cmpb r0,#ASC"$"
beq VarChkCharOk ; '$' - exit with CC, EQ
cmpb r0,#ASC"%"
beq VarChkCharOk ; '%' - exit with CC, EQ
;
.VarChkChar ; Test for middle character
cmpb r0,#ASC"0"
bcs VarChkCharOk ; <'0' - exit with CS
cmpb #ASC"9",r0
bcc VarChkCharCC ; '0'-'9' - exit with CC, NE
;
.VarChkLetter ; Test for starting character
cmpb r0,#ASC"A"
bcs VarChkCharOk ; ':'-'@' - exit with CS
cmpb #ASC"Z",r0
bcc VarChkCharCC ; 'A'-'[' - exit with CC, NE
cmpb r0,#ASC"_"
bcs VarChkCharOk ; '['-'^' - exit with CS
cmpb #ASC"z",r0
bcs VarChkCharOk ; >'z' - exit with CS
; '_'-'z' - exit with CC, NE
.VarChkCharCC
tst r0 ; NE, also clears carry
clc ; CC
.VarChkCharOk
rts pc
src/Version
+150
View File
@@ -0,0 +1,150 @@
; > Version
; BBC BASIC for the PDP11
; (C)J.G.Harston 1988-2023
;
; Set version information
; -----------------------
; 24-May-2006 v0.10 Added skeleton error handler
; 28-Jan-2008 v0.11
; 25-Feb-2009 v0.13
; 25-Oct-2009 v0.14 Places zero word at top of stack so 2(sp) can be examined
; 25-Jan-2012 v0.15 Program can be edited from immediate mode
; 12-Jul-2013 v0.16 Floating point addition, multiplication, division
; 16-Aug-2013 Tokenising and inserting lines into program callable from TextLoad
; 20-Nov-2013 FOR/NEXT, INSTR()
; 07-Dec-2013 READ, SAVE (noname), PROC/FN (no params), ENDPROC/=.
; 09-Dec-2013 v0.17 AddrOf PROC/FN, PROC/FN(params).
; 25-Dec-2013 v0.18 LOCAL ERROR/DATA/variables, ON ERROR LOCAL, RESTORE +<offset>
; 30-Dec-2013 v0.19 Tidied up TTY settings in UnixIO, notes istty() on stdin/stdout,
; fixed Unix6 problems, generalised OSCLI command table.
; INPUT, INPUT# implemented, Unix7 reads centisecond TIME.
; Remove Line doesn't match OSCLI token as end-of-prog marker.
; 05-Feb-2014 v0.20 DIM array() implemented, DEFFNname(A$):A$=something:=A$ works.
; 16-Aug-2015 VDU(n) returns 8-bit values.
; 26-Aug-2015 EVAL evaluates string on stack to protect string buffer.
; 31-Aug-2015 v0.21 Low numbered commands and high numbered functons use
; lookup table instead of dispatch table.
; 09-Sep-2015 v0.22 ON GOTO/GOSUB implemented. Bug where FN(addr)+num called
; '(addr)+num' instead of '(addr)' fixed. Real DIMs now
; work. RND(n) works, correctly giving reals 0..1 and
; integers 1..n. RND seed updated as per 6502 BASIC, conversion
; to user value matches BASIC 2, different from BASIC 4.
; 18-Oct-2015 v0.23 ROMHeader checks if Tube CPU is a PDP11.
; 22-Jul-2016 v0.24 Signal handlers set up from a table, removed double-vectoring.
; Trimmed stty() calls on startup, tweeked CmdLine scanning.
; 31-Jul-2016 Scanning fractional and exponential decimals implemented.
; 21-Aug-2016 v0.25 Multiplication rounding corrected, 0.5 = 1/2.
; 09-Jul-2016 v0.26 EnsureInteger truncates, INT rounds downwards.
; 04-Jul-2018 v0.27 Various optimisations to Interface routines.
; 19-Aug-2018 v0.30 Anchored @% at PAGE-&100 to ensure ProgEnv can read command string.
; 26-Aug-2018 v0.31 NumberToString float support, currently fixed at 9 digits General
; format. ScanDecimal generates error if numbers larger than 10^9
; unless E format.
; 09-May-2020 v0.32 MultiplyInt checks for <&8000 x <&8000, TokenFind doesn't skip
; zero-length lines. PROC@LOAD, FN@SAVE allowed, IF x THEN var=1
; doesn't tokenise the number, STRING$(n,MID$(...)) works.
; 11-May-2020 Various work to UnixIO and RT11IO.
; 20-Jun-2020 Added *ESC (ON|OFF), merged ANSI and UKNC VDU driver code.
; 22-Jun-2020 v0.33 RT11 and UKNC extended key handler working, initial INKEY() code.
; 28-Jun-2020 v0.34 Unix v6,v7 keyboard interface recognises function/editing keys.
; Unix v6 does pseudo-background Escape polling.
; 30-Jun-2020 Optimised extended keypress reading. InitTTY recognises Unix v5,
; Unix v5 extended keypresses and pseudo-background Escape work.
; 30-Jun-2020 Optimised RT11 extended keypress reading.
; 12-Jul-2020 v0.35 Added delay to TTYtest to cope with telnet delays. Searches for kbdQ.
; 13-Mar-2021 LIST doesn't detokenise within strings.
; 16-Mar-2021 v0.36 DIV 32bit corrected, VAL"nonnum" fixed, error within EVAL fixed.
; 16-Sep-2021 RT11 polls Escape on a ticker as with Unix pre v7.
; 28-Dec-2021 UKNC reworked COLOUR to use shorter sequences, implemented MODE.
; RT11 GETKEY swallows <lf> after <cr>, faster Escape check, tweeked
; GETtty, tweeks to VDU 127,8,9,10,11.
; 31-Dec-2021 Cursor control selects appropriate VT52 or VT100 control sequences.
; Avoids sending colours to VT52.
; 05-Jan-2022 v0.37 RT11 <esc> doesn't lose characters, sent via vduraw, tweeked Escape.
; 07-Jan-2022 Bugfix added to LOCAL to avoid bug in RT11Em.
; 19-Jan-2022 UKNC reads 8-bit chars from CONIN. Looking for POS/VPOS.
; 27-Jul-2002 Starting to work out BSD2.9 API.
; 29-Jul-2022 Switches stack out of stack segment for BSD.
; 01-Aug-2022 v0.38 Detects and runs on BSD2.9 - can't find kbdQ at the moment.
; Added ADVAL(-1). BSD2.11: load/save, =TIME.
; FloatDivide uses fixed 32-bit SUB, NumToString checks for overflow
; to 1.0. Optimised by using FloatToString for IntToString.
; 25-Sep-2022 v0.39 Rewritten and optimised DivideFloat.
; 28-Sep-2022 v0.40 UKNC should be able to read POS/VPOS/MODE from VDU system, but can't
; work out how to, so in interim fakes via local variables.
; 14-Apr-2023 v0.41 Common API code moved to IOCommon from IOUnix and IORT11.
; 02-Aug-2023 v0.42 Moved common keyboard code from IOUnix and IORT11 to AnsiKBD.
; 08-Aug-2023 v0.43 OSCLI calling external works on BSD211, *chdir works.
; 14-Aug-2023 Optimised and refactored execution loop and line scanning.
; 16-Aug-2023 Working on BSD211 KBD_Wait, etc.
; 19-Aug-2023 Combined fopen and data transfer from OSGBPB and OSFILE.
; 20-Aug-2023 BSD211 OSARGS and EOF done.
; 15-Sep-2023 v0.44 Shell command wrapped in VDU0 to signal LF conversion, RT11 munged
; VDU10 and VDU 11 to work on various terminals.
; 03-Oct-2023 Unwinding FN drops subroutines addresses when resetting SV_STACK.
; 01-Mar-2024 v0.45 RT11 shell() calls a command via EXIT and and returns, so *. works.
; If command generates an error, drops to KMON. Tweeked tests for
; VT52/UKNC for RT11v5.7 on UKNC.
; 10-Mar-2024 Tweeks for oddities in various PuTTY setttings and fkey overlaps.
; 12-Mar-2024 CallSub/RetSub pushes/pops SV_STACK - optimised code and fixed
; FN unwinding bug.
; 18-Mar-2024 LOAD/SAVE checks for end-of-statement if immediate command, tweeked
; textload and FindTOP. Restructured ImmLineNum and InsLine to use new
; return from Tokeniser. HIMEM= sets SV_STACK, lots of small misc.
; optimisations. Channels use HashVal instead of HashExpression.
; 27-Mar-2024 v0.46 RT11IO optimised IO_xxx entries, all errors generate errors.
; 07-Apr-2024 Stacking strings checks for free memory.
; 09-Apr-2024 UnixIO optimised IO_xxx entries, all errors generate errors.
; 12-Apr-2024 BGET/BPUT merged code, BGET checks for EOF, better EOF routine.
; 19-Apr-2024 BSD211 signals now working, tidied up and optimised.
; 30-Apr-2024 BSD2.9 tests keyboard buffer so function keys work.
; 30 Jul 2024 v0.47 NumberToString uses IntegerToString again, FloatToString loses
; accuracy over 999999999. Uses fast/compact DIV-based routine.
; 31-Dec-2024 Fixed EOF handling on BGET never resetting EOF flag, also BSD clearing
; EOF flag on BPUT/WRCH.
; 27-Apr-2025 Tweeked tokeniser to correctly tokenise eg &123OR5.
; 10-May-2025 Optimised Bin/Oct/Hex constants.
; 23-Aug-2025 ROMHdr checks for Electron Tube and ROM table. REM/DATA only stops
; tokenising at start of statement, 2-byte tokenising possible.
; 01 Jan 2026 v0.48 Some tweeking with initial startup system checking.
; Notes
; -----
; This source uses the 'ADR label,dst' pseudo-opcode. The assembler needs to implement this
; or expand this in the manner of this macro, or uncomment this macro:
;.MACRO ADR label,dst
; MOV pc,dst
; ADD #label-$,dst
;.ENDM
; Build options
; -------------
; DEBUG Include Debug module
; VERSION Major build version in hex
; BUILD Minor build number, 1/2/3/etc becomes eg v0.00a/b/c/etc
; SKIPLINE Allows \ line continuation character
; VECTORS Calls to &FFxx use vectors in BASIC workspace
; NOMUL Assume MUL instruction absent, multiply manually (needs MulR2byR3toR3)
; NODIV Assume DIV instruction absent, IntToString manually divides.
; MUL16 Use fast checks and restrict hardware MUL to 16-bit ints
; TUBEBUG Bypasses bug in early Tube code
; FILEEXTN Include LOAD "file",addr and SAVE "file",start,end,exec,load
; NOEXTRAFN Omit =DIM, =WIDTH, =OSCLI
; SLOWTOKEN Slower but smaller tokeniser
MUL16: EQU 1 ; Restrict fast hardware MUL to 16-bit ints
NOEXTRAFN: EQU 1 ; Omit function extensions
SLOWTOKEN: EQU 1 ; Smaller tokeniser
; Version information
; -------------------
; Strings have to be defined before the first pass so their length is correct
;DATE$: EQU MID$(TIME$,5,11)
DATE$: EQU "01 Jan 2026"
YEAR$: EQU RIGHT$(DATE$,4)
VERSION: EQU &0048
BUILD: EQU 0
src/ansi.mac
+505
View File
@@ -0,0 +1,505 @@
; > ansi.mac
; ANSI BBC VDU driver for PDP11 Unix
; Implements BBC VDU text control codes
;
; 14-Sep-2015 v0.01 Initial version
; 25-Dec-2015 v0.02 Optimised MOV #STDOUT,R0 and COLOUR
; 20-Jun-2020 v0.03 COLOUR &C0+n filtered out, COLOUR &88+n sets ANSI bright background
; 15-Jan-2022 CHR$127 jumps directly to vdu127.
; 06-Aug-2022 Added build options for BSD stack API.
; 15-Sep-2023 v0.04 Toggle VDU 10 between DOWN and NEWL.
;
; Notes:
; Some platforms support seperate bright foreground and bright background
; Some platforms only set both background and foreground bright
; Some platforms only set foreground bright
; User should set background before foreground to be most compatible, using:
; COLOUR &80+bg:COLOUR &00+fg
VERSION: EQU &0004
BUILD: EQU 0
ORG 0 ; position independent code
HOSTIO: EQU 1 ; HOSTIO=1 for Unix
EQUW &0107 ; magic number, also branch to Startup
EQUW _DATA%-_TEXT% ; size of text
EQUW _BSS%-_DATA% ; size of initialised data
EQUW _END%-_BSS% ; size of uninitialised data
EQUW &0000 ; size of symbol data
EQUW _ENTRY%-_TEXT% ; entry point (v7 only, must be zero for pre-v7)
EQUW &0000 ; not used
EQUW &0001 ; no relocation info
ORG 0 ; position independent code
._TEXT%
;
._ENTRY%
#ifndef BSD
TRAP 48 ; signal()
EQUW 2 ; SIGINT - User interupt (Escape)
EQUW 1 ; SIGIGNORE - only terminate when read() ends
#endif
.loop
#ifdef BSD
mov #1,-(sp) ; 1 byte
mov #charbuf,-(sp) ; data buffer
clr -(sp) ; fd=STDIN
clr -(sp) ; padding
TRAP 3 ; SYS read
rol r0 ; Save Carry flag
add #8,sp ; Drop from stack
ror r0 ; Get Carry back
#else
CLR R0 ; fd=STDIN
TRAP 3 ; SYS read
EQUW charbuf ; data buffer
EQUW 1 ; 1 byte
#endif
BCS exit ; End of file, exit
TST R0
BEQ exit ; Nothing read, exit
JSR PC,wrch
BR loop
.exit
JSR PC,vdu20reset ; Reset colours
CLR R0
#ifdef BSD
CLR -(SP)
#endif
TRAP 1 ; SYS exit
HALT
; Process output character
; ------------------------
.wrch
MOVB charbuf,R0
MOVB vduQ,R1
BNE pending ; VDU queue pending
CMP R0,#32
BCS control ; Control character
CMP R0,#127
;BEQ delete ; VDU 127
BEQ vdu127 ; VDU 127
; Send raw character in buffer to STDOUT
; --------------------------------------
.vduraw
MOV #1,R0 ; fd=STDOUT
.vdu02 ; Printer On
.vdu03 ; Printer Off
.vdu04 ; Text
.vdu05 ; Graphics
.vdu06 ; Enable
.vdu07 ; Bell
.vdu08 ; Left
.vdu13 ; CR
.vdu14 ; Page On
.vdu15 ; Page Off
.vdu16 ; CLG
.vdu21 ; Disable
.vdu27 ; Escape
#ifdef BSD
mov #1,-(sp) ; 1 byte
mov #charbuf,-(sp) ; data buffer
jmp bsd_output
#else
TRAP 4 ; SYS write
EQUW charbuf ; data buffer
EQUW 1 ; 1 byte
#endif
;.vdu00 ; NULL
.vdu18 ; GCOL
.vdu19 ; Palette
.vdu23 ; DEFCHR
.vdu24 ; Graphics window
.vdu25 ; PLOT
.vdu26 ; Reset windows
.vdu28 ; Text window
.vdu29 ; Origin
.return
RTS PC
; VDU queue pending
; -----------------
.pending
MOVB R0,vduQueue(R1) ; Store in VDU queue
INCB vduQ
BNE return ; Waiting for more parameters
MOVB vduChar,R0 ; Get current control character
ASL R0
MOV vduAddrs(R0),R1 ; R1=dispatch address+parameters
BIC #&F000,R1 ; Mask off parameters
.dispatch
MOV #1,R0 ; Prepare R0 handle=STDOUT
JMP (R1) ; Jump to control routine
; Control characters
; ------------------
;.delete
;MOV #32,R0 ; Convert VDU 127 to 32
.control
MOVB R0,vduChar
ASL R0 ; R0 will be <128, so Cy will become 0
RORB vduflags ; Use CC to also clear VDU10 flag
MOV vduAddrs(R0),R1 ; R1=dispatch address+parameters
BIT R1,#&F000
BEQ dispatch ; No parameters, dispatch
SWAB R1
ASR R1
ASR R1
ASR R1
ASR R1 ; Number of parameters in b0-b3
BIS #&F0,R1
MOVB R1,vduQ ; 256-(Number of params to wait for)
RTS PC
; VDU 127 - Delete
; ----------------
.vdu127
#ifdef BSD
mov #3,-(sp) ; 3 bytes
mov #ANSdelete,-(sp) ; ANSI delete
jmp bsd_output
#else
TRAP 4 ; SYS write
EQUW ANSdelete ; ANSI delete
EQUW 3 ; 3 bytes
RTS PC
#endif
; VDU 0 - NULL, but toggle VDU 10 flag
; ------------------------------------
.vdu00
ROLB vduflags ; Move flag back to b7
ADD #&80,vduflags ; And toggle it
RTS PC
; VDU 1 - Next as raw character
; -----------------------------
.vdu01
#ifdef BSD
mov #1,-(sp) ; 1 byte
mov #vduQueue-1,-(sp) ; data buffer
jmp bsd_output
#else
TRAP 4 ; SYS write
EQUW vduQueue-1 ; The byte in the queue
EQUW 1 ; 1 byte
rts pc
#endif
; VDU 9 - Right
; -------------
.vdu09
#ifdef BSD
mov #ANSdown-ANSright,-(sp) ; length of sequence
mov #ANSright,-(sp) ; ANSI right
jmp bsd_output
#else
TRAP 4 ; SYS write
EQUW ANSright ; ANSI right
EQUW ANSdown-ANSright ; length of sequence
rts pc
#endif
; VDU 10 - Down
; -------------
; Must translate to newline, otherwise OSCLI("command") doesn't newline properly.
.vdu10
ROLB vduflags ; Restore and test VDU10 flag
#ifdef BSD
bmi vdu10newl ; Force VDU10 to NEWLINE
mov #ANSup-ANSdown,-(sp) ; length of sequence
mov #ANSdown,-(sp) ; ANSI down
jmp bsd_output
.vdu10newl
mov #2,-(sp) ; 2 bytes
mov #RAWnewl,-(sp) ; NEWLINE
jmp bsd_output
#else
BMI vdu10newl ; Force VDU10 to NEWLINE
TRAP 4 ; SYS write
EQUW ANSdown ; ANSI down
EQUW ANSup-ANSdown ; length of sequence
RTS PC
.vdu10newl
TRAP 4 ; SYS write
EQUW RAWnewl ; NEWLINE
EQUW 2 ; 2 bytes
RTS PC
#endif
; VDU 11 - Up
; -----------
.vdu11
#ifdef BSD
mov #ANScls-ANSup,-(sp) ; length of sequence
mov #ANSup,-(sp) ; ANSI up
jmp bsd_output
#else
TRAP 4 ; SYS write
EQUW ANSup ; ANSI up
EQUW ANScls-ANSup ; length of sequence
rts pc
#endif
; VDU 22,n - MODE
; ---------------
.vdu22
JSR PC,vdu20 ; Reset colours
MOV #1,R0 ; handle=STDOUT
; Then clear screen
; VDU 12 - CLS
; ------------
.vdu12
#ifdef BSD
mov #4,-(sp) ; 4 bytes
mov #ANScls,-(sp) ; ANSI cls
jsr pc,bsd_callout
#else
TRAP 4 ; SYS write
EQUW ANScls ; ANSI cls
EQUW 4 ; 4 bytes
#endif
; Then HOME cursor
; VDU 30 - Home
; VDU 31,x,y - TAB
; -----------------
.vdu30
CLR vduQueue-2 ; Preload TAB(0,0)
.vdu31
ADD #&0101,vduQueue-2 ; ANSI starts from (1,1)
MOV #ANStab+2,R1
MOVB vduQueue-1,R0 ; Y coordinate
JSR PC,vduDecimal ; Output as decimal
MOVB #59,(R1)+
MOVB vduQueue-2,R0 ; X coordinate
JSR PC,vduDecimal ; Output as decimal
#ifdef BSD
mov #10,-(sp) ; 10 bytes
mov #ANStab,-(sp) ; ANSI tab
jmp bsd_output
#else
MOV #1,R0 ; fd=STDOUT
TRAP 4 ; SYS write
EQUW ANStab ; ANSI tab
EQUW 10 ; 10 bytes
RTS PC
#endif
.vduDecimal
MOVB #ASC"0"-1,(R1) ; Start with '0'-1 for hundreds
.vduDecLp1
INCB (R1) ; Increment hundreds digit
SUB #100,R0 ; Subtract 100 from R0
BCC vduDecLp1 ; Loop until <0
INC R1 ; Step past hundreds digit
ADD #100,R0 ; Balance last SUB #100
MOVB #ASC"0"-1,(R1) ; Start with '0'-1 for tens
.vduDecLp2
INCB (R1) ; Increment tens digit
SUB #10,R0 ; Subtract 10 from R0
BCC vduDecLp2 ; Loop until <0
INC R1 ; Step past tens digit
ADD #ASC"0"+10,R0 ; Convert back to units
MOVB R0,(R1)+
RTS PC
; VDU 20 - Reset colours
; ----------------------
.vdu20reset
MOV #1,R0 ; handle=STDOUT
.vdu20
MOV #&3037,txtFGD ; Set current colours
#ifdef BSD
mov #4,-(sp) ; 4 bytes
mov #ANSreset,-(sp) ; ANSI default colours
jmp bsd_output
#else
TRAP 4 ; SYS write
EQUW ANSreset ; ANSI default colours
EQUW 4 ; 4 bytes
RTS PC
#endif
; VDU 17,n - COLOUR
; -----------------
; PRINTCHR$27;"[0";
; IF (A AND 16):PRINT";5"; :REM flash
; IF (A AND 32):PRINT";4"; :REM underline
; IF (A AND 64):PRINT";7"; :REM inverse
; IF (A AND 128)=0:PRINT";";30+(A AND 7);:IF (A AND 8):PRINT";1"; :REM foreground colour
; IF (A AND 128) :PRINT";";40+(A AND 7);:IF (A AND 8):PRINT";";100+(A AND 7); :REM background colour
; PRINT"m";
; NB: Some platforms [21m is not the opposite of [1m so cannot optimise further. The consistant way to
; turn bright off is [0m, so need to remember colours and reselect them. On some platforms even [22m
; does not turn bright off.
;
.vdu17
MOVB vduQueue-1,R0 ; Get COLOUR parameter
BISB #ASC"0",R0 ; Convert to digit
BPL vdu17_setfgd ; COLOUR &00+n, set foreground
CMPB R0,#&C0
BCC vdu17_exit ; COLOUR &C0+n, set border, unimplemented
MOVB R0,txtBGD ; Set as current background
BR vdu17_colour
.vdu17_setfgd
MOVB R0,txtFGD ; Set as current foreground
.vdu17_colour
;
MOVB vduQueue-1,R0 ; Get COLOUR parameter again
MOV #ANScolour+3,R1 ; R1=>output string after initial [0
MOVB #&3B,(R1)+ ; Insert semicolon, R1 is now aligned
BIT #64,R0
BEQ vdu17_noinvert
MOV #&3B00+ASC"7",(R1)+; Invert on "7;" ALIGNED
.vdu17_noinvert
BIT #32,R0
BEQ vdu17_nounderline
MOV #&3B00+ASC"4",(R1)+; Underline on "4;" ALIGNED
.vdu17_nounderline
BIT #16,R0
BEQ vdu17_noflash
MOV #&3B00+ASC"5",(R1)+; Flash on "5;" ALIGNED
.vdu17_noflash
;
MOVB txtFGD,R0 ; Get current foreground
BIT #8,R0
BEQ vdu17_nobright ; Not bright foreground
MOV #&3B00+ASC"1",(R1)+; Bright on "1;" ALIGNED
.vdu17_nobright
MOVB #ASC"3",(R1)+ ; Prefix for foreground ALIGNED
BIC #&FFC8,R0 ; Reduce to '0'-'7'
MOVB R0,(R1)+ ; Foreground colour
MOVB #&3B,(R1)+ ; ";" ALIGNED
;
MOVB txtBGD,R0 ; Get current background
MOVB #ASC"4",(R1)+ ; Prefix for foreground
BIC #&FFC8,R0 ; Reduce to '0'-'7'
MOVB R0,(R1)+ ; Background colour ALIGNED
BITB #8,txtBGD
BEQ vdu17_write ; Not bright background
MOVB #&3B,(R1)+ ; ";"
MOV #&3031,(R1)+ ; Prefix for bright background ALIGNED
MOVB R0,(R1)+ ; Bright background colour ALIGNED
;
.vdu17_write
MOVB #ASC"m",(R1)+ ; Terminator
MOV #ANScolour,R0
SUB R0,R1 ; R1=length of character stream
MOV R1,trapColour+4
#ifdef BSD
mov trapColour+4,-(sp) ; count
mov trapColour+2,-(sp) ; address
jmp bsd_output
#else
MOV #1,R0 ; handle=STDOUT
TRAP 0 ; SYS indirect
EQUW trapColour
#endif
.vdu17_exit
RTS PC
#ifdef BSD
.bsd_callout
; On entry: SP=>ret, address, length
mov (sp)+,r0 ; SP=>address, length
mov (sp),-(sp) ; SP=>address, address, length
mov 4(sp),2(sp) ; SP=>address, length, length
mov r0,4(sp) ; SP=>address, length, ret
;
.bsd_output
; On entry: SP=>address, length, ret
mov #1,-(sp) ; SP=>stdout, address, length, ret
clr -(sp) ; SP=>padding, stdout, address, length, ret
TRAP 4 ; SYS write
add #8,sp ; Drop from stack
rts pc
#endif
; Dispatch addresses and parameters
; ---------------------------------
.vduAddrs
EQUW (vdu00 AND &FFF) OR &0000 ; NULL
EQUW (vdu01 AND &FFF) OR &F000 ; Printer
EQUW (vdu02 AND &FFF) OR &0000 ; Printer On
EQUW (vdu03 AND &FFF) OR &0000 ; Printer Off
EQUW (vdu04 AND &FFF) OR &0000 ; Graphics
EQUW (vdu05 AND &FFF) OR &0000 ; Graphics
EQUW (vdu06 AND &FFF) OR &0000 ; Enable
EQUW (vdu07 AND &FFF) OR &0000 ; BELL
EQUW (vdu08 AND &FFF) OR &0000 ; Left
EQUW (vdu09 AND &FFF) OR &0000 ; Right
EQUW (vdu10 AND &FFF) OR &0000 ; Down
EQUW (vdu11 AND &FFF) OR &0000 ; Up
EQUW (vdu12 AND &FFF) OR &0000 ; CLS
EQUW (vdu13 AND &FFF) OR &0000 ; CR
EQUW (vdu14 AND &FFF) OR &0000 ; Page On
EQUW (vdu15 AND &FFF) OR &0000 ; Page Off
EQUW (vdu16 AND &FFF) OR &0000 ; CLG
EQUW (vdu17 AND &FFF) OR &F000 ; COLOUR
EQUW (vdu18 AND &FFF) OR &E000 ; GCOL
EQUW (vdu19 AND &FFF) OR &B000 ; Set Palette
EQUW (vdu20 AND &FFF) OR &0000 ; Reset Colours
EQUW (vdu21 AND &FFF) OR &0000 ; Disable VDU
EQUW (vdu22 AND &FFF) OR &F000 ; MODE
EQUW (vdu23 AND &FFF) OR &7000 ; DEFCHR$
EQUW (vdu24 AND &FFF) OR &8000 ; Define Graphics Window
EQUW (vdu25 AND &FFF) OR &B000 ; PLOT
EQUW (vdu26 AND &FFF) OR &0000 ; Clear Windows
EQUW (vdu27 AND &FFF) OR &0000 ; Escape
EQUW (vdu28 AND &FFF) OR &C000 ; Define Text Window
EQUW (vdu29 AND &FFF) OR &C000 ; ORIGIN
EQUW (vdu30 AND &FFF) OR &0000 ; HOME
EQUW (vdu31 AND &FFF) OR &E000 ; TAB
; EQUW (vdu127 AND &FFF) OR &0000 ; Delete
; Initialised data
; ----------------
._DATA%
.RAWnewl EQUS 10,13 ; Newline
.ANSdelete EQUS 8,32,8 ; Delete
;.ANSleft EQUS 27,"[D" ; Left
.ANSright EQUS 27,"[C" ; Right
;.ANSdown EQUS 27,"[B" ; Down, fails on bottom line
.ANSdown EQUS 27,"D" ; Down, works on bottom line
;.ANSup EQUS 27,"[A" ; Up, fails on top line
.ANSup EQUS 27,"M" ; Up, works on top line
.ANScls EQUS 27,"[2J" ; CLS
.ANSreset EQUS 27,"[0m" ; Default colours
; EQUS 27,"[000,000H" ; Home/TAB
.ANStab EQUS 27,"[Ver"
EQUB ASC"0"+((VERSION AND &F00) DIV 256)
EQUB "."
EQUB ASC"0"+((VERSION AND &0F0) DIV 16)
EQUB ASC"0"+((VERSION AND &00F) DIV 1)
EQUS "H" ; Home/TAB
ALIGN
.ANScolour EQUS 27,"[0,5,4,7,30,1,40,100m" ; COLOUR
; 0 101010101010101010101
ALIGN
.trapColour TRAP 4
EQUW ANScolour
EQUW 18
.txtFGD EQUS "7"
.txtBGD EQUS "0"
; Uninitialised data
; ------------------
._BSS% BSS
.vduChar EQUB 0
EQUB 0,0,0,0,0,0,0,0,0
ALIGN
.vduQueue
.vduQ EQUB 0
ALIGN
.vduflags EQUB 0
.charbuf EQUB 0
._END%