Browse Source

Merge pull request #50 from b1ackmai1er/master

Forth and NASCOM BASIC updates
pull/54/head
Wayne Warthen 6 years ago
committed by GitHub
parent
commit
391997ee09
No known key found for this signature in database GPG Key ID: 4AEE18F83AFDEB23
  1. 123
      Doc/Nascom.txt
  2. 6
      Source/Forth/Build.cmd
  3. 2
      Source/Forth/Clean.cmd
  4. 69
      Source/Forth/camel80.azm
  5. 18
      Source/Forth/camel80d.azm
  6. 48
      Source/Forth/camel80h.azm
  7. 207
      Source/HBIOS/nascom.asm
  8. BIN
      Tools/cpm/bin/Z80MR.COM
  9. BIN
      Tools/cpm/bin/ZSM.COM

123
Doc/Nascom.txt

@ -0,0 +1,123 @@
NASCOM 2 BASIC (C) 1978 MICROSOFT AS IMPLEMENTED FOR RETROBREWCOMPUTERS
FUNCTIONS:
SGN
INT
ABS
USR
FRE
INP
POS
SQR
RND
LOG
EXP
COS
SIN
TAN
ATN
PEEK
DEEK
POINT
LEN
STR
VAL
ASC
CHR$
HEX$
BIN$
LEFT$
RIGHT$
MID$
RESERVED WORDS:
END
FOR
NEXT
DATA
INPUT
DIM
READ
LET
GOTO
RUN
IF
RESTORE
GOSUB
RETURN
REM
STOP
OUT
ON
NULL
WAIT
DEF
POKE
DOKE
LINES
CLS
WIDTH
BYE
SET
RESET
PRINT
CONT
LIST
CLEAR
PLAY
REM
NEW
PRINT
TAB
TO
FN
SPC
THEN
NOT
STEP
?
OPERATORS:
+ PLUS
- MINUS
* MULTIPLY
/ DIVIDE
AND LOGICAL AND
OR LOGICAL OR
> GREATER THAN
= EQUALS
< LESS THAN
^ POWER
ERROR CODE:
NF NEXT without FOR
SN Syntax error
RG RETURN without GOSUB
OD Out of DATA
FC Illegal function call
OV Overflow error
OM Out of memory
UL Undefined line
BS Bad subscript
DD Re-DIMensioned array
/0 Division by zero
ID Illegal direct
TM Type mis-match
OS Out of string space
LS String too long
ST String formula too complex
CN Can't CONTinue
UF Undefined FN function
MO Missing operand
HX HEX error
BN BIN error
LINE EDITING COMMANDS:
@ KILL CURRENT LINE
_ NONDESTRUCTIVE DELETE LAST CHARACTER

6
Source/Forth/Build.cmd

@ -11,5 +11,7 @@ set ZXBINDIR=%TOOLS%/cpm/bin/
set ZXLIBDIR=%TOOLS%/cpm/lib/
set ZXINCDIR=%TOOLS%/cpm/include/
zx z80mr camel80
zx MLOAD25 -camel80.bin=camel80.hex
zx zsm =camel80.azm
zx link -CAMEL80.BIN=CAMEL80

2
Source/Forth/Clean.cmd

@ -5,3 +5,5 @@ if exist *.bin del *.bin
if exist *.lst del *.lst
if exist *.prn del *.prn
if exist *.hex del *.hex
if exist *.rel del *.rel
if exist *.sym del *.sym

69
Source/Forth/camel80.azm

@ -60,6 +60,12 @@ FTH_LOC EQU 0200h
; 05 Nov 18 v1.02 Initial ROMWBW HBIOS version.
; 10-Nov 18 v1.02 New org address.
; b1ackmai1er difficultylevelhigh@gmail.com
; 19-Oct 19 v1.02 Convert to zsm assembler which
; identified and fixed incorrect
; case conversion when lowercase
; keywords are being passed in a
; macro.
; b1ackmai1er difficultylevelhigh@gmail.com
; ===============================================
; Macros to define Forth headers
; HEAD label,length,name,action
@ -75,25 +81,25 @@ FTH_LOC EQU 0200h
DOCODE EQU 0 ; flag to indicate CODE words
link DEFL 0 ; link to previous Forth word
head MACRO #label,#length,#name,#action
head MACRO label,length,name,action
DW link
DB 0
link DEFL $
DB #length,'#name'
#label:
IF .NOT.(#action=DOCODE)
call #action
DB length,"&name"
label:
IFF (action EQ DOCODE)
call action
ENDIF
ENDM
immed MACRO #label,#length,#name,#action
immed MACRO label,length,name,action
DW link
DB 1
link DEFL $
DB #length,'#name'
#label:
IF .NOT.(#action=DOCODE)
call #action
DB length,"&name"
label:
IFF (action EQ DOCODE)
call action
ENDIF
ENDM
@ -123,8 +129,10 @@ nexthl MACRO
; ...are not used in the CP/M implementation
; Instead, we have the...
; CP/M ENTRY POINT
org FTH_LOC ; Execute address
; RELOCATED ENTRY POINT
.PHASE 0200H
reset: ld hl,0FDFFh ; HBIOS address, rounded down
ld l,0 ; = end of avail.mem (EM)
dec h ; EM-100h
@ -384,7 +392,7 @@ poptos: pop bc
DW SWOP,OVER,EXIT
;C >R x -- R: -- x push to return stack
head TOR,2,>R,docode
head TOR,2,!>R,docode
dec ix ; push TOS onto rtn stk
ld (ix+0),b
dec ix
@ -393,7 +401,7 @@ poptos: pop bc
next
;C R> -- x R: x -- pop from return stack
head RFROM,2,R>,docode
head RFROM,2,R!>,docode
push bc ; push old TOS
ld c,(ix+0) ; pop top rtn stk item
inc ix ; to TOS
@ -418,7 +426,7 @@ poptos: pop bc
next
;Z SP! a-addr -- set data stack pointer
head SPSTORE,3,SP!,docode
head SPSTORE,3,SP!!,docode
ld h,b
ld l,c
ld sp,hl
@ -433,7 +441,7 @@ poptos: pop bc
next
;Z RP! a-addr -- set return stack pointer
head RPSTORE,3,RP!,docode
head RPSTORE,3,RP!!,docode
push bc
pop ix
pop bc
@ -442,7 +450,7 @@ poptos: pop bc
; MEMORY AND I/O OPERATIONS =====================
;C ! x a-addr -- store cell in memory
head STORE,1,!,docode
head STORE,1,!!,docode
ld h,b ; address in hl
ld l,c
pop bc ; data in bc
@ -453,7 +461,7 @@ poptos: pop bc
next
;C C! char c-addr -- store char in memory
head CSTORE,2,C!,docode
head CSTORE,2,C!!,docode
ld h,b ; address in hl
ld l,c
pop bc ; data in bc
@ -478,7 +486,7 @@ poptos: pop bc
next
;Z PC! char c-addr -- output char to port
head PCSTORE,3,PC!,docode
head PCSTORE,3,PC!!,docode
pop hl ; char in L
out (c),l ; to port (BC)
pop bc ; pop new TOS
@ -588,7 +596,7 @@ mplus1: pop de ; restore saved IP
next
;Z >< x1 -- x2 swap bytes (not ANSI)
head swapbytes,2,><,docode
head swapbytes,2,!>!<,docode
ld a,b
ld b,c
ld c,a
@ -632,7 +640,7 @@ rsh2: djnz rsh1
next
;C +! n/u a-addr -- add cell to memory
head PLUSSTORE,2,+!,docode
head PLUSSTORE,2,+!!,docode
pop hl
ld a,(bc) ; low byte
add a,l
@ -657,7 +665,7 @@ rsh2: djnz rsh1
next
;C 0< n -- flag true if TOS negative
head ZEROLESS,2,0<,docode
head ZEROLESS,2,0!<,docode
sla b ; sign bit -> cy flag
sbc a,a ; propagate cy through A
ld b,a ; put 0000 or FFFF in TOS
@ -674,11 +682,11 @@ tosfalse: ld bc,0
next
;X <> x1 x2 -- flag test not eq (not ANSI)
head NOTEQUAL,2,<>,docolon
head NOTEQUAL,2,!<!>,docolon
DW EQUAL,ZEROEQUAL,EXIT
;C < n1 n2 -- flag test n1<n2, signed
head LESS,1,<,docode
head LESS,1,!<,docode
pop hl
or a
sbc hl,bc ; n1-n2 in HL, SZVC valid
@ -695,11 +703,11 @@ revsense: jp m,tosfalse ; OV: if -ve, reslt false
jr tostrue ; if +ve, result true
;C > n1 n2 -- flag test n1>n2, signed
head GREATER,1,>,docolon
head GREATER,1,!>,docolon
DW SWOP,LESS,EXIT
;C U< u1 u2 -- flag test u1<n2, unsigned
head ULESS,2,U<,docode
head ULESS,2,U!<,docode
pop hl
or a
sbc hl,bc ; u1-u2 in HL, SZVC valid
@ -709,7 +717,7 @@ revsense: jp m,tosfalse ; OV: if -ve, reslt false
next
;X U> u1 u2 -- flag u1>u2 unsgd (not ANSI)
head UGREATER,2,U>,docolon
head UGREATER,2,U!>,docolon
DW SWOP,ULESS,EXIT
; LOOP AND BRANCH OPERATIONS ====================
@ -949,7 +957,7 @@ cmovedone: exx
;X CMOVE> c-addr1 c-addr2 u -- move from top
; as defined in the ANSI optional String word set
head CMOVEUP,6,CMOVE>,docode
head CMOVEUP,6,CMOVE!>,docode
push bc
exx
pop bc ; count
@ -1048,8 +1056,8 @@ sdiff: ; mismatch! undo last 'cpi' increment
ld c,a
snext: next
*INCLUDE camel80d.azm ; CPU Dependencies
*INCLUDE camel80h.azm ; High Level words
INCLUDE camel80d.azm ; CPU Dependencies
INCLUDE camel80h.azm ; High Level words
lastword EQU link ; nfa of last word in dict.
enddict EQU $ ; user's code starts here
@ -1057,6 +1065,7 @@ enddict EQU $ ; user's code starts here
ds (FTH_SIZ-(enddict-reset)-1)
nop
.DEPHASE
END

18
Source/Forth/camel80d.azm

@ -74,7 +74,7 @@ noop: next
;C >BODY xt -- a-addr adrs of param field
; 3 + ; Z80 (3 byte CALL)
head TOBODY,5,>BODY,docolon
head TOBODY,5,!>BODY,docolon
DW LIT,3,PLUS,EXIT
;X COMPILE, xt -- append execution token
@ -82,7 +82,7 @@ noop: next
; it is defined in the ANSI standard as COMPILE,.
; On a DTC Forth this simply appends xt (like , )
; but on an STC Forth this must append 'CALL xt'.
head COMMAXT,8,'COMPILE,',docode
head COMMAXT,8,COMPILE!,,docode
jp COMMA
;Z !CF adrs cfa -- set code action of a word
@ -90,13 +90,13 @@ noop: next
; 1+ ! ; Z80 VERSION
; Depending on the implementation this could
; append CALL adrs or JUMP adrs.
head STORECF,3,!CF,docolon
head STORECF,3,!!CF,docolon
DW LIT,0CDH,OVER,CSTORE
DW ONEPLUS,STORE,EXIT
;Z ,CF adrs -- append a code field
; HERE !CF 3 ALLOT ; Z80 VERSION (3 bytes)
head COMMACF,3,',CF',docolon
head COMMACF,3,!,CF,docolon
DW HERE,STORECF,LIT,3,ALLOT,EXIT
;Z !COLON -- change code field to docolon
@ -104,7 +104,7 @@ noop: next
; This should be used immediately after CREATE.
; This is made a distinct word, because on an STC
; Forth, colon definitions have no code field.
head STORCOLON,6,'!COLON',docolon
head STORCOLON,6,!!COLON,docolon
DW LIT,-3,ALLOT
DW LIT,docolon,COMMACF,EXIT
@ -112,7 +112,7 @@ noop: next
; ['] EXIT ,XT ;
; This is made a distinct word, because on an STC
; Forth, it appends a RET instruction, not an xt.
head CEXIT,5,',EXIT',docolon
head CEXIT,5,!,EXIT,docolon
DW LIT,EXIT,COMMAXT,EXIT
; CONTROL STRUCTURES ============================
@ -123,21 +123,21 @@ noop: next
; xt is the branch operator to use, e.g. qbranch
; or (loop). It does NOT append the destination
; address. On the Z80 this is equivalent to ,XT.
head COMMABRANCH,7,',BRANCH',docode
head COMMABRANCH,7,!,BRANCH,docode
jp COMMA
;Z ,DEST dest -- append a branch address
; This appends the given destination address to
; the branch instruction. On the Z80 this is ','
; ...other CPUs may use relative addressing.
head COMMADEST,5,',DEST',docode
head COMMADEST,5,!,DEST,docode
jp COMMA
;Z !DEST dest adrs -- change a branch dest'n
; Changes the destination address found at 'adrs'
; to the given 'dest'. On the Z80 this is '!'
; ...other CPUs may need relative addressing.
head STOREDEST,5,'!DEST',docode
head STOREDEST,5,!!DEST,docode
jp STORE
; HEADER STRUCTURE ==============================

48
Source/Forth/camel80h.azm

@ -56,7 +56,7 @@
;C >IN -- a-addr holds offset into TIB
; 2 USER >IN
head TOIN,3,>IN,douser
head TOIN,3,!>IN,douser
dw 2
;C BASE -- a-addr holds conversion radix
@ -132,7 +132,7 @@ TICKSOURCE: call douser ; in name!
;C S>D n -- d single -> double prec.
; DUP 0< ;
head STOD,3,S>D,docolon
head STOD,3,S!>D,docolon
dw DUP,ZEROLESS,EXIT
;Z ?NEGATE n1 n2 -- n3 negate n1 if n2 negative
@ -254,7 +254,7 @@ MIN1: dw DROP,EXIT
;C 2! x1 x2 a-addr -- store 2 cells
; SWAP OVER ! CELL+ ! ;
; the top of stack is stored at the lower adrs
head TWOSTORE,2,2!,docolon
head TWOSTORE,2,2!!,docolon
dw SWOP,OVER,STORE,CELLPLUS,STORE,EXIT
;C 2DROP x1 x2 -- drop 2 cells
@ -348,25 +348,25 @@ TYP5: DW EXIT
;Z (S") -- c-addr u run-time code for S"
; R> COUNT 2DUP + ALIGNED >R ;
head XSQUOTE,4,(S"),docolon
head XSQUOTE,4,(S""!),docolon
DW RFROM,COUNT,TWODUP,PLUS,ALIGNED,TOR
DW EXIT
;C S" -- compile in-line string
; COMPILE (S") [ HEX ]
; 22 WORD C@ 1+ ALIGNED ALLOT ; IMMEDIATE
immed SQUOTE,2,S",docolon
immed SQUOTE,2,S"",docolon
DW LIT,XSQUOTE,COMMAXT
DW LIT,22H,WORD,CFETCH,ONEPLUS
DW ALIGNED,ALLOT,EXIT
;C ." -- compile string to print
; POSTPONE S" POSTPONE TYPE ; IMMEDIATE
immed DOTQUOTE,2,.",docolon
immed DOTQUOTE,2,."",docolon
DW SQUOTE
DW LIT,TYPE,COMMAXT
DW EXIT
; NUMERIC OUTPUT ================================
; Numeric conversion is done l.s.digit first, so
; the output buffer is built backwards in memory.
@ -394,12 +394,12 @@ TYP5: DW EXIT
;C <# -- begin numeric conversion
; PAD HP ! ; (initialize Hold Pointer)
head LESSNUM,2,<#,docolon
head LESSNUM,2,!<#,docolon
DW PAD,HP,STORE,EXIT
;Z >digit n -- c convert to 0..9A..Z
; [ HEX ] DUP 9 > 7 AND + 30 + ;
head TODIGIT,6,>DIGIT,docolon
head TODIGIT,6,!>DIGIT,docolon
DW DUP,LIT,9,GREATER,LIT,7,AND,PLUS
DW LIT,30H,PLUS,EXIT
@ -417,7 +417,7 @@ NUMS1: DW NUM,TWODUP,OR,ZEROEQUAL,qbranch,NUMS1
;C #> ud1 -- c-addr u end conv., get string
; 2DROP HP @ PAD OVER - ;
head NUMGREATER,2,#>,docolon
head NUMGREATER,2,#!>,docolon
DW TWODROP,HP,FETCH,PAD,OVER,MINUS,EXIT
;C SIGN n -- add minus sign if n<0
@ -434,7 +434,7 @@ SIGN1: DW EXIT
;C . n -- display n signed
; <# DUP ABS 0 #S ROT SIGN #> TYPE SPACE ;
head DOT,1,'.',docolon
head DOT,1,.,docolon
DW LESSNUM,DUP,ABS,LIT,0,NUMS
DW ROT,SIGN,NUMGREATER,TYPE,SPACE,EXIT
@ -465,12 +465,12 @@ SIGN1: DW EXIT
;C , x -- append cell to dict
; HERE ! 1 CELLS ALLOT ;
head COMMA,1,',',docolon
head COMMA,1,!,,docolon
dw HERE,STORE,lit,1,CELLS,ALLOT,EXIT
;C C, char -- append char to dict
; HERE C! 1 CHARS ALLOT ;
head CCOMMA,2,'C,',docolon
head CCOMMA,2,C!,,docolon
dw HERE,CSTORE,lit,1,CHARS,ALLOT,EXIT
; INTERPRETER ===================================
@ -491,7 +491,7 @@ SIGN1: DW EXIT
;Z >counted src n dst -- copy to counted str
; 2DUP C! CHAR+ SWAP CMOVE ;
head TOCOUNTED,8,>COUNTED,docolon
head TOCOUNTED,8,!>COUNTED,docolon
DW TWODUP,CSTORE,CHARPLUS,SWOP,CMOVE,EXIT
;C WORD char -- c-addr n word delim'd by char
@ -516,12 +516,12 @@ WORD1: DW RFROM,RFROM,ROT,MINUS,TOIN,PLUSSTORE
;Z NFA>LFA nfa -- lfa name adr -> link field
; 3 - ;
head NFATOLFA,7,NFA>LFA,docolon
head NFATOLFA,7,NFA!>LFA,docolon
DW LIT,3,MINUS,EXIT
;Z NFA>CFA nfa -- cfa name adr -> code field
; COUNT 7F AND + ; mask off 'smudge' bit
head NFATOCFA,7,NFA>CFA,docolon
head NFATOCFA,7,NFA!>CFA,docolon
DW COUNT,LIT,07FH,AND,PLUS,EXIT
;Z IMMED? nfa -- f fetch immediate flag
@ -599,7 +599,7 @@ QSIGN1: DW EXIT
; R> M+ 2SWAP
; 1 /STRING
; REPEAT ;
head TONUMBER,7,>NUMBER,docolon
head TONUMBER,7,!>NUMBER,docolon
TONUM1: DW DUP,qbranch,TONUM3
DW OVER,CFETCH,DIGITQ
DW ZEROEQUAL,qbranch,TONUM2,DROP,EXIT
@ -701,7 +701,7 @@ QABO1: DW TWODROP,EXIT
;C ABORT" i*x 0 -- i*x R: j*x -- j*x x1=0
;C i*x x1 -- R: j*x -- x1<>0
; POSTPONE S" POSTPONE ?ABORT ; IMMEDIATE
immed ABORTQUOTE,6,ABORT",docolon
immed ABORTQUOTE,6,ABORT"",docolon
DW SQUOTE
DW LIT,QABORT,COMMAXT
DW EXIT
@ -753,14 +753,14 @@ TICK: call docolon
; R> adrs of headless DOES> def'n
; LATEST @ NFA>CFA code field to fix up
; !CF ;
head XDOES,7,(DOES>),docolon
head XDOES,7,(DOES!>),docolon
DW RFROM,LATEST,FETCH,NFATOCFA,STORECF
DW EXIT
;C DOES> -- change action of latest def'n
; COMPILE (DOES>)
; dodoes ,CF ; IMMEDIATE
immed DOES,5,DOES>,docolon
immed DOES,5,DOES!>,docolon
DW LIT,XDOES,COMMAXT
DW LIT,dodoes,COMMACF,EXIT
@ -807,7 +807,7 @@ TICK: call docolon
;C ;
; REVEAL ,EXIT
; POSTPONE [ ; IMMEDIATE
immed SEMICOLON,1,';',docolon
immed SEMICOLON,1,!;,docolon
DW REVEAL,CEXIT
DW LEFTBRACKET,EXIT
@ -911,12 +911,12 @@ POST2: DW EXIT
;Z >L x -- L: -- x move to leave stack
; CELL LP +! LP @ ! ; (L stack grows up)
head TOL,2,>L,docolon
head TOL,2,!>L,docolon
DW CELL,LP,PLUSSTORE,LP,FETCH,STORE,EXIT
;Z L> -- x L: x -- move from leave stack
; LP @ @ CELL NEGATE LP +! ;
head LFROM,2,L>,docolon
head LFROM,2,L!>,docolon
DW LP,FETCH,FETCH
DW CELL,NEGATE,LP,PLUSSTORE,EXIT
@ -1020,7 +1020,7 @@ DOTS2: DW EXIT
DW UINIT,U0,NINIT,CMOVE
; DW LIT,80h,COUNT,INTERPRET
DW XSQUOTE
DB 55,'Z80 CamelForth v1.02 25 Jan 1995, ROMWBW 10 Nov 2018'
DB 55,'Z80 CamelForth v1.02 25 Jan 1995, ROMWBW 19 Oct 2019'
DB 0dh,0ah
DW TYPE,ABORT ; ABORT never returns
; DON'T FORGET TO UPDATE THE BYTE COUNT IF YOU CHANCGE THE SIZE OF THE BOOT MSG

207
Source/HBIOS/nascom.asm

@ -19,13 +19,23 @@
; Adapted for the freeware Zilog Macro Assembler 2.10 to produce
; the original ROM code (checksum A934H). PA
;
; SBC V2 BOOTROM VERSION 27/10/2018
; difficultylevelhigh@gmail.com
;==================================================================================
; SBC V2 BOOTROM VERSION
;
; 20181027 - Initial retrobrewcomputer SBC V2 version - difficultylevelhigh@gmail.com
; 20191012 - Add PLAY command for SBC-V2-004 Sound support.
; 20191013 - Add option for long error messages.
; - Add option to use VT100 escape codes for screen controls.
;
#INCLUDE "std.asm"
;
; CUSTOMIZATION
;
ABBRERR .EQU FALSE ; Choose between long error message and abbreviated error messages.
VT100 .EQU TRUE ; Use VT100 escape codes for CLS
;
; GENERAL EQUATES
;
CTRLC .EQU 03H ; Control "C"
CTRLG .EQU 07H ; Control "G"
BKSP .EQU 08H ; Back space
@ -40,8 +50,9 @@ CTRLU .EQU 15H ; Control "U"
ESC .EQU 1BH ; Escape
DEL .EQU 7FH ; Delete
;
; BASIC WORK SPACE LOCATIONS
;
; 0200H - 2000H BASIC EXECUTABLE
; 2000H - 2090H STACK
; 2090H - 20F8H BASIC EXECUTABLE VARAIABLES / WORKSPACE
@ -274,43 +285,43 @@ FNCTAB: .WORD SGN
; RESERVED WORD LIST
WORDS: .BYTE 'E'+80H,"ND"
.BYTE 'F'+80H,"OR"
.BYTE 'N'+80H,"EXT"
.BYTE 'D'+80H,"ATA"
.BYTE 'I'+80H,"NPUT"
.BYTE 'D'+80H,"IM"
.BYTE 'R'+80H,"EAD"
.BYTE 'L'+80H,"ET"
.BYTE 'G'+80H,"OTO"
.BYTE 'R'+80H,"UN"
.BYTE 'I'+80H,"F"
.BYTE 'R'+80H,"ESTORE"
.BYTE 'G'+80H,"OSUB"
.BYTE 'R'+80H,"ETURN"
.BYTE 'R'+80H,"EM"
.BYTE 'S'+80H,"TOP"
.BYTE 'O'+80H,"UT"
.BYTE 'O'+80H,"N"
.BYTE 'N'+80H,"ULL"
.BYTE 'W'+80H,"AIT"
.BYTE 'D'+80H,"EF"
.BYTE 'P'+80H,"OKE"
.BYTE 'D'+80H,"OKE"
.BYTE 'S'+80H,"CREEN"
.BYTE 'L'+80H,"INES"
.BYTE 'C'+80H,"LS"
.BYTE 'W'+80H,"IDTH"
.BYTE 'B'+80H,"YE"
.BYTE 'S'+80H,"ET"
.BYTE 'R'+80H,"ESET"
.BYTE 'P'+80H,"RINT"
.BYTE 'C'+80H,"ONT"
.BYTE 'L'+80H,"IST"
.BYTE 'C'+80H,"LEAR"
.BYTE 'P'+80H,"LAY"
.BYTE 'C'+80H,"SAVE"
.BYTE 'N'+80H,"EW"
WORDS: .BYTE 'E'+80H,"ND" ; PEND:
.BYTE 'F'+80H,"OR" ; FOR:
.BYTE 'N'+80H,"EXT" ; NEXT:
.BYTE 'D'+80H,"ATA" ; DATA:
.BYTE 'I'+80H,"NPUT" ; INPUT:
.BYTE 'D'+80H,"IM" ; DIM:
.BYTE 'R'+80H,"EAD" ; READ:
.BYTE 'L'+80H,"ET" ; SET:
.BYTE 'G'+80H,"OTO" ; GOTO:
.BYTE 'R'+80H,"UN" ; RUN:
.BYTE 'I'+80H,"F" ; IF:
.BYTE 'R'+80H,"ESTORE" ; RESTOR:
.BYTE 'G'+80H,"OSUB" ; GOSUB:
.BYTE 'R'+80H,"ETURN" ; RETURN:
.BYTE 'R'+80H,"EM" ; REM:
.BYTE 'S'+80H,"TOP" ; STOP:
.BYTE 'O'+80H,"UT" ; POUT:
.BYTE 'O'+80H,"N" : ON:
.BYTE 'N'+80H,"ULL" ; NULL:
.BYTE 'W'+80H,"AIT" : WAIT:
.BYTE 'D'+80H,"EF" : DEF:
.BYTE 'P'+80H,"OKE" : POKE:
.BYTE 'D'+80H,"OKE" : DOKE:
.BYTE 'S'+80H,"CREEN" : REM: NOT IMPLEMENTED
.BYTE 'L'+80H,"INES" : LINES
.BYTE 'C'+80H,"LS" : CLS:
.BYTE 'W'+80H,"IDTH" : WIDTH:
.BYTE 'B'+80H,"YE" : MONITR:
.BYTE 'S'+80H,"ET" : PSET:
.BYTE 'R'+80H,"ESET" ; RESET:
.BYTE 'P'+80H,"RINT" : PRINT:
.BYTE 'C'+80H,"ONT" : CONT:
.BYTE 'L'+80H,"IST" : LIST:
.BYTE 'C'+80H,"LEAR" : CLEAR:
.BYTE 'P'+80H,"LAY" : PLAY: WAS CLOAD
.BYTE 'C'+80H,"SAVE" : REM: NOT IMPLEMENTED
.BYTE 'N'+80H,"EW" : NEW
.BYTE 'T'+80H,"AB("
.BYTE 'T'+80H,"O"
@ -426,7 +437,7 @@ ZTIMES .EQU 0AEH ; *
ZDIV .EQU 0AFH ; /
ZOR .EQU 0B2H ; OR
ZGTR .EQU 0B3H ; >
ZEQUAL .EQU 0B4H ; M
ZEQUAL .EQU 0B4H ; =
ZLTH .EQU 0B5H ; <
ZSGN .EQU 0B6H ; SGN
ZPOINT .EQU 0C7H ; POINT
@ -457,27 +468,51 @@ PRITAB: .BYTE 79H ; Precedence value
; BASIC ERROR CODE LIST
ERRORS: .BYTE "NF" ; NEXT without FOR
.BYTE "SN" ; Syntax error
.BYTE "RG" ; RETURN without GOSUB
.BYTE "OD" ; Out of DATA
.BYTE "FC" ; Illegal function call
.BYTE "OV" ; Overflow error
.BYTE "OM" ; Out of memory
.BYTE "UL" ; Undefined line
.BYTE "BS" ; Bad subscript
.BYTE "DD" ; Re-DIMensioned array
.BYTE "/0" ; Division by zero
.BYTE "ID" ; Illegal direct
.BYTE "TM" ; Type mis-match
.BYTE "OS" ; Out of string space
.BYTE "LS" ; String too long
.BYTE "ST" ; String formula too complex
.BYTE "CN" ; Can't CONTinue
.BYTE "UF" ; Undefined FN function
.BYTE "MO" ; Missing operand
.BYTE "HX" ; HEX error
.BYTE "BN" ; BIN error
#IF ABBRERR
ERRORS: .BYTE "NF" ; NEXT without FOR
.BYTE "SN" ; Syntax error
.BYTE "RG" ; RETURN without GOSUB
.BYTE "OD" ; Out of DATA
.BYTE "FC" ; Illegal function call
.BYTE "OV" ; Overflow error
.BYTE "OM" ; Out of memory
.BYTE "UL" ; Undefined line
.BYTE "BS" ; Bad subscript
.BYTE "DD" ; Re-DIMensioned array
.BYTE "/0" ; Division by zero
.BYTE "ID" ; Illegal direct
.BYTE "TM" ; Type mis-match
.BYTE "OS" ; Out of string space
.BYTE "LS" ; String too long
.BYTE "ST" ; String formula too complex
.BYTE "CN" ; Can't CONTinue
.BYTE "UF" ; Undefined FN function
.BYTE "MO" ; Missing operand
.BYTE "HX" ; HEX error
.BYTE "BN" ; BIN error
#ELSE
ERRORS: .BYTE "NEXT without FOR",0
.BYTE "Syntax",0
.BYTE "RETURN without GOSUB",0
.BYTE "Out of DATA",0
.BYTE "Illegal function call",0
.BYTE "Overflow",0
.BYTE "Out of memory",0
.BYTE "Undefined line",0
.BYTE "Bad subscript",0
.BYTE "Re-DIMensioned array",0
.BYTE "Division by zero",0
.BYTE "Illegal direct",0
.BYTE "Type mis-match",0
.BYTE "Out of string space",0
.BYTE "String too long",0
.BYTE "String formula too complex",0
.BYTE "Can't CONTinue",0
.BYTE "Undefined FN function",0
.BYTE "Missing operand",0
.BYTE "HEX",0
.BYTE "BIN",0
#ENDIF
; INITIALISATION TABLE -------------------------------------------------------
@ -614,11 +649,25 @@ ERROR: CALL CLREG ; Clear registers and stack
LD D,A ; D = 0 (A is 0)
LD A,'?'
CALL OUTC ; Output '?'
ADD HL,DE ; Offset to correct error code
LD A,(HL) ; First character
CALL OUTC ; Output it
CALL GETCHR ; Get next character
CALL OUTC ; Output it
#IF ABBRERR
ADD HL,DE ; Offset to correct error code
LD A,(HL) ; First character
CALL OUTC ; Output it
CALL GETCHR ; Get next character
CALL OUTC ; Output it
#ELSE
PUSH BC ; Count through
LD B,E ; the error list
SRL B ; until we get
JR Z,CHRZRO ; error message
NXCHR: LD A,(HL) ;
OR A ; E/2 = entry
INC HL ; number in the
JR NZ,NXCHR ; list.
DJNZ NXCHR
CHRZRO: CALL PRS ; Display message.
POP BC
#ENDIF
LD HL,ERRMSG ; "Error" message
ERRIN: CALL PRS ; Output message
LD HL,(LINEAT) ; Get line of error
@ -4165,9 +4214,19 @@ GETINP:
POP DE
POP BC
RET
CLS:
LD A,CS ; ASCII Clear screen
JP MONOUT ; Output character
CLS:
#IF VT100
LD HL,VT_CLS ; Output zero terminated
VT0OUT: LD A,(HL) ; VT100 escape sequence
INC HL ; directly to console.
OR A
CALL NZ,MONOUT ; clear screen
JR NZ,VT0OUT ; and home cursor
RET
#ELSE
LD A,CS ; ASCII Clear screen
JP MONOUT ; Output character
#ENDIF
WIDTH: CALL GETINT ; Get integer 0-255
LD A,E ; Width to A
@ -4668,7 +4727,11 @@ FRQDURTBL:
.DW $1EDE, $0 ; B
;
FDTBSIZ .EQU ($-FRQDURTBL)/4
;
#IF VT100
VT_CLS .BYTE ESC,"[2J",ESC,"[H",0 ; vt100 clear screen & home
#ENDIF
;
SLACK .EQU (BAS_END - $)
.FILL SLACK,00H
;

BIN
Tools/cpm/bin/Z80MR.COM

Binary file not shown.

BIN
Tools/cpm/bin/ZSM.COM

Binary file not shown.
Loading…
Cancel
Save