LIST までは動くけど、NIBL のラインパーザが追いきれていない。ほかを投げ出したままなのも何なので一旦中断して TLCS-90の方をナントカするつもり。
--- /home/seiji/cross/SCAMP/scmp3_nibl-SBC-240326.asm 2025-04-26 22:44:51.000000000 +0900
+++ nibl3.asm 2025-05-26 22:55:29.221131413 +0900
@@ -73,7 +73,7 @@
RNDNUM: EQU 0xfff4 ; DW rnd number
TMPF6: EQU 0xfff6 ; DB,DW temporary
-UNUSE1: EQU 0xfff8 ; DW unused
+TMPFGO: EQU 0xfff8 ; DW temporary used fotr GOTO parsing
TMPFB: EQU 0xfffb ; DB,DW temporary
TMPFC: EQU 0xfffc ; DB,DW temporary (overlaps TMPFB)
TMPFE: EQU 0xfffe ; DW temporary, alias
@@ -222,7 +222,8 @@
;
; does not work if
;
- DB 0x85 ; not a number, skip to DIRECT
+; DB 0x85 ; not a number, skip to DIRECT
+ DB DIRECT - $ ; not a number, skip to DIRECT
; just counldn't understand following routine
LD EA, TXTBGN ; start of program
SUB EA, ONE ; minus 1
@@ -309,7 +310,28 @@
DIRECT: LD A, 0, P2 ; get char from buffer
XOR A, =CR ; is it a CR?
BZ MAINL7 ; yes, continue in main loop
- PLI P3, =CMDTB1 ; load first CMD table
+; ADDED for FAST GOTO by efialtes_htn
+ AND A,=0x80 ; is bit8=1 then internal codes.
+ BZ DIRECT6 ; not internal -- RAW code.
+; internal code parser
+; 0x80: GO TO -- 0x80, NADDRL, NADDRH, 0x20[, 0x20]*
+;
+ LD A, @1, P2 ; restore from buffer and increment pointer
+ XOR A, =0x80 ; GOTO
+ BNZ ICODEP1
+ LD A, =1, P2 ; UPPER
+ LD E,A
+ LD A, =0, P1 ; LOWER
+ LD P2,EA
+ CALL 6 ; ENDCMD
+;
+ICODEP1:
+ICODEPE:
+ CALL 15 ; ERROR
+ DB 1
+; end ADDED
+
+DIRECT6: PLI P3, =CMDTB1 ; load first CMD table
CALL 11 ; CMPTOK
; out of memory error
@@ -337,7 +359,8 @@
ST EA, TMPFB ; save temporary
CALL 9 ; GETCHR
CALL 13 ; NUMBER
- DB 0x18 ; skip if not number to FINDL4
+; DB 0x18 ; skip if not number to FINDL4
+ DB FINDL4 - $ ; skip if not number to FINDL4
CALL 5 ; APULL
SUB EA, -2, P3 ; subtract number from the one on stack (the line number found)
XCH A, E ; is larger?
@@ -366,14 +389,19 @@
;-----------------------------------------------------------------------------------
; set of DIRECT commands
CMDTB1: DB "LIST"
- DB 0x93 ; to LIST
+; DB 0x93 ; to LIST
+ DB 0x80 + LIST - $ - 1 ; to LIST
DB "NEW"
- DB 0x8a ; to NEW2
+; DB 0x8a ; to NEW2
+ DB 0x80 + NEW2 - $ - 1 ; to NEW2
DB "RUN"
- DB 0xb5 ; to RUN
+; DB 0xb5 ; to RUN
+ DB 0x80 + RUN - $ - 1 ; to RUN
DB "CONT"
- DB 0xa7 ; to CONT
- DB 0xd2 ; default case to EXEC1
+; DB 0xa7 ; to CONT
+ DB 0x80 + CONT - $ - 1 ; to CONT
+; DB 0xd2 ; default case to EXEC1
+ DB 0x80 + EXEC1 - $ - 1 ; default case to EXEC1
;-----------------------------------------------------------------------------------
; NEW command
@@ -386,7 +414,7 @@
;-----------------------------------------------------------------------------------
; LIST command
LIST: CALL 13 ; NUMBER
- DB 3 ; if no number, skip to LIST0
+ DB LIST0 - $ ; if no number, skip to LIST0
BRA LIST1
LIST0: LD EA, ZERO ; no number given, start with line 0
CALL 4 ; APUSH put on stack
@@ -394,10 +422,12 @@
LIST2: CALL 9 ; GETCHR from location found
PUSH P2
CALL 13 ; NUMBER
- DB 0x0a ; if error, goto LIST3
+; DB 0x0c ; if error, goto LIST3
+ DB LIST3 - $ ; if error, goto LIST3
CALL 5 ; APULL
POP P2
- CALL 14 ; PRTLN
+; CALL 14 ; PRTLN
+ JSR PRTLNL ; PRTLNL
CALL 8 ; CRLF
JSR CHKBRK ; test break
BRA LIST2
@@ -436,7 +466,8 @@
ST A, INPMOD
BRA MAIN1 ; back to mainloop
RUN4: CALL 13 ; parse line NUMBER
- DB 8 ; not found: syntax error, goto SNERR1
+; DB 8 ; not found: syntax error, goto SNERR1
+ DB SNERR1 - $ ; not found: syntax error, goto SNERR1
CALL 5 ; APULL line number
ST EA, CURRNT ; set as current line
@@ -477,21 +508,21 @@
BRA GOSUB1 ; jump into GOSUB (process interrupt)
CMDTB2: DB "LET"
- DB 0xa6 ; to LET
- DB "IF"
- DB 0xf3 ; to IFCMD
- DB "LINK"
- DB 0xf7 ; to LINK
+ DB 0x80 + LET - $ - 1 ; to LET
DB "NEXT"
- DB 0x9c ; to NEXT
- DB "UNTIL"
- DB 0xdb ; to UNTIL
+ DB 0x80 + NEXT - $ - 1 ; to NEXT
DB "GO"
- DB 0x96 ; to GOCMD
+ DB 0x80 + GOCMD - $ - 1 ; to GOCMD
DB "RETURN"
- DB 0xbd ; to RETURN
+ DB 0x80 + RETURN - $ - 1 ; to RETURN
DB "REM"
- DB 0xcf ; to REMCMD
+ DB 0x80 + REMCMD - $ - 1 ; to REMCMD
+ DB "UNTIL"
+ DB 0x80 + UNTIL - $ - 1 ; to UNTIL
+ DB "IF"
+ DB 0x80 + IFCMD - $ - 1 ; to IFCMD
+ DB "LINK"
+ DB 0x80 + LINK - $ - 1 ; to LINK
DB 0x80 ; default case to EXEC2
EXEC2: PLI P3, =CMDTB7 ; load table 7
@@ -508,22 +539,43 @@
;---------------------------------------------------------------
; handle GOTO or GOSUB
GOCMD: PLI P3, =CMDTB5 ; check for TO or SUB
+ LD EA, P2
+ ST EA, TMPFGO ; save for later use
CALL 11
CMDTB5: DB "TO"
- DB 0x85 ; to GOTO
+; DB 0x85 ; to GOTO
+ DB 0x80 + GOTOX - $ - 1 ; to GOTOX
DB "SUB"
- DB 0x8d
+; DB 0x8d
+ DB 0x80 + GOSUB - $ - 1 ; to GOSUB
DB 0x80 ; default case to GOTO
;---------------------------------------------------------------
; GOTO command
+; Note: should come just after "GO TO" sequence.
GOTOX CALL 0 ; RELEXP
GOTO: LD A, =1 ;
ST A, INPMOD ; set 'running mode'
JSR FINDLN ; find line in buffer
- BZ RUN4 ; skip to line number check
- CALL 15 ; error
+; BNZ RUN4 ; skip to line number check
+ BNZ GOTOERR ; skip to line number check
+ PUSH P3
+ LD EA,TMPFGO
+ SUB EA, =2
+ LD P3, EA
+ LD A,=0x80 ; internal code "GOTO"
+ ST A,@1,P3
+ LD EA,P2
+ ST A,@1,P3
+ LD A, E
+ ST A,@1,P3
+ LD A,=0x20 ; 'SPACE'
+ ST A,@1,P3
+ POP P3
+ JMP RUN4
+
+GOTOERR: CALL 15 ; error
DB 7 ; 7 (goto target does not exist)
;---------------------------------------------------------------
@@ -600,13 +653,17 @@
;---------------------------------------------------------------
CMDTB7: DB "FOR"
- DB 0xe4 ; to FOR
+; DB 0xe4 ; to FOR
+ DB 0x80 + FOR - $ - 1 ; to FOR
DB "DO"
- DB 0xa7 ; to DO
+; DB 0xa7 ; to DO
+ DB 0xa0 + DO - $ - 1 ; to DO
DB "ON"
- DB 0x8f ; to ON
+; DB 0x8f ; to ON
+ DB 0x80 + ON - $ - 1 ; to ON
DB "CLEAR"
- DB 0x85 ; to CLEAR
+; DB 0x85 ; to CLEAR
+ DB 0x80 + CLEAR - $ - 1 ; to CLEAR
DB 0x80 ; to EXEC3
;---------------------------------------------------------------
@@ -878,20 +935,28 @@
;---------------------------------------------------------------
; several more commands
CMDTB8: DB "DELAY"
- DB 0xa4 ; to DELAY
+; DB 0xa4 ; to DELAY
+ DB 0x80 + DELAY - $ - 1 ; to DELAY
DB "INPUT"
- DB 0x98 ; to INPUT
+; DB 0x98 ; to INPUT
+ DB 0x80 + INPUT - $ - 1 ; to INPUT
DB "PRINT"
- DB 0x95 ; to PRINT
+; DB 0x95 ; to PRINT
+ DB 0x80 + PRINT - $ - 1 ; to PRINT
DB "PR"
- DB 0x92 ; to PRINT
+; DB 0x92 ; to PRINT
+ DB 0x80 + PRINT - $ - 1 ; to PRINT
DB "STOP"
- DB 0x9b ; to STOP
+; DB 0x9b ; to STOP
+ DB 0x80 + STOP - $ - 1 ; to STOP
DB "MON"
- DB 0x9a ; to MON
+; DB 0x9a ; to MON
+ DB 0x80 + MON - $ - 1 ; to MON
DB "PUTC"
- DB 0x98 ; to PRINTCHR
- DB 0xa4 ; default to ASSIGN
+; DB 0x98 ; to PRINTCHR
+ DB 0x80 + PRINTCHR - $ - 1 ; to PRINTCHR
+; DB 0xa4 ; default to ASSIGN
+ DB 0x80 + ASSIGN - $ - 1 ; default to ASSIGN
;---------------------------------------------------------------
; INPUT cmd
@@ -926,12 +991,16 @@
;---------------------------------------------------------------
; left hand side (LHS) operators for assigment
CMDTB4: DB 'S','T','A','T'
- DB 0x89 ; to STATLH
+; DB 0x89 ; to STATLH
+ DB 0x80 + STATLH - $ - 1 ; to STATLH
DB '@'
- DB 0x92 ; to ATLH
+; DB 0x92 ; to ATLH
+ DB 0x80 + ATLH - $ - 1 ; to ATLH
DB '$'
+; DB 0xb1 ; to DOLALH
DB 0xb1 ; to DOLALH
- DB 0x9e ; default case to ASSIG1
+; DB 0x9e ; default case to ASSIG1
+ DB 0x80 + ASSIG1 - $ - 1 ; default case to ASSIG1
;---------------------------------------------------------------
; handle assignments
@@ -1144,6 +1213,40 @@
BP PRTLN ; if positive, loop
PRTLN1 RET ; exit
;---------------------------------------------------------------
+; print string pointed to by P2, until CR
+PRTLNL: LD A, @1, P2 ; get next char from buffer
+ XOR A, =CR ; is CR?
+ BZ PRTLN1 ; yes exit
+ XOR A, =CR ; make original char again
+ BP PRTLNL2 ; IF bit8 = 0 then output as it is
+;
+PRTLNL5: AND A,=0x7f ; reset first bits
+ XCH E,A
+ LD A,=0x00 ; SIGN Extend A to EA
+ XCH E,A
+ SL EA ;
+ ST EA,TMPFGO
+ SL EA ;
+ ADD EA,TMPFGO ; EA = EA * 6
+ PUSH P3
+ ST EA,TMPFGO
+ LD EA,=CODENAMES
+ ADD EA,TMPFGO
+ LD P3,EA
+PRTLNL3: LD A,@1,P3
+ BZ PRTLNL4
+ CALL 7
+ BRA PRTLNL3
+;
+PRTLNL4: POP P3
+ XCH P2,EA
+ ADD EA,=2 ; SKIP 2byte
+ XCH P2,EA
+PRTLNL2: CALL 7 ; PUTC emit it
+ BP PRTLNL ; if positive, loop
+PRTLNL1: RET ; exit
+;
+;---------------------------------------------------------------
; get next char from buffer
GETNXC: LD A, @1, P2 ; advance P2
;---------------------------------------------------------------
@@ -1504,7 +1607,8 @@
;---------------------------------------------------------------
; FACTOR (call 1) get a factor: number, var, function, (RELEXP)
FACTOR: CALL 13 ; NUMBER get number in sequence
- DB 2 ; if not found continue at FACTO2
+; DB 2 ; if not found continue at FACTO2
+ DB FACTO2 - $ ; if not found continue at FACTO2
FACTO1: RET ; has numeric operand on stack, done
FACTO2: PLI P3, =CMDT12 ; load table of standard functions
@@ -2205,7 +2309,14 @@
; DW 0x00d5 ; for 300 bd
; DW 0x0252 ; for 110 bd
;
- ORG 0xc00
+CODENAMES: DB "GO TO",0
+ DB "GOSUB",0
+ DB "PRINT",0
+ DB "UNTIL",0
+
+
+; *********** FROM THIS LINE AND BELOW ARE are UNIMON SOURCE ******************
+ ORG 0x1000
; unimon
RAM_B: EQU 0xb800 ; last area would be consumed by stack.
WORK_B: EQU 0xbbc0
