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

Original import of base code

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