mirror of
https://github.com/MajenkoProjects/pdp11-bbcbasic.git
synced 2026-08-23 12:11:34 +01:00
Original import of base code
This commit is contained in:
@@ -1,2 +1,11 @@
|
||||
# pdp11-bbcbasic
|
||||
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/
|
||||
|
||||
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
+1200
File diff suppressed because it is too large
Load Diff
+51
@@ -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|
|
||||
+-----+-----+-----+-----+ +-----+-----+-----+-----+ +-----+-----+-----+-----+ +-----+-----+-----+
|
||||
@@ -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.
|
||||
|
||||
+187
@@ -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.
|
||||
Binary file not shown.
@@ -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
|
||||
@@ -0,0 +1,3 @@
|
||||
cd /D %0\..
|
||||
..\..\Assembler\AsmPDP ansi.mac ..\ansi ansi.lst
|
||||
if ERRORLEVEL 1 pause
|
||||
@@ -0,0 +1,3 @@
|
||||
cd /D %0\..
|
||||
..\..\Assembler\AsmPDP -DBSD ansi.mac ..\bsdansi ansi.lst
|
||||
if ERRORLEVEL 1 pause
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
+221
@@ -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
|
||||
|
||||
@@ -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
|
||||
+1967
File diff suppressed because it is too large
Load Diff
+424
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+68
@@ -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
|
||||
+869
@@ -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
|
||||
|
||||
|
||||
+305
@@ -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
|
||||
|
||||
+2068
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
|
||||
+873
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
+61
@@ -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
|
||||
+76
@@ -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
|
||||
|
||||
+1564
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
|
||||
+322
@@ -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
|
||||
|
||||
+112
@@ -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
|
||||
+148
@@ -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
|
||||
|
||||
+626
@@ -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
|
||||
|
||||
+46
@@ -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
|
||||
+154
@@ -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
|
||||
|
||||
+2002
File diff suppressed because it is too large
Load Diff
+743
@@ -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
|
||||
|
||||
+150
@@ -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
|
||||
|
||||
+505
@@ -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%
|
||||
Reference in New Issue
Block a user