basiclb1.asm

在单片机内嵌BASIC语言解释程序的完整代码

* c=c&127;
* return((c>='A')&(c<='Z'));
*}
*
ALPHA:	EQU    *
	CMPA   #'A'
	BLO    ALPHA1
	CMPA   #'Z'
	BLS    ALPHA2
	CMPA   #'a'
	BLO    ALPHA1
	CMPA   #'z'
	BHI    ALPHA1
ALPHA2:	SEC
	RTS
ALPHA1:	CLC
	RTS
	
*        /***** alphanum *****/
	
*alphanum(c)
*char c;
*{ return ((alpha(c)) | (numeric(c))); }
*
ALPHANUM:	EQU    *
	BSR    ALPHA
	BCC    ALPHANU1
	RTS
ALPHANU1:	BRA    NUMERIC
*
*/*****************************************
*              xlate()
* translate the input buffer into tokenized
* form placing the results into tknbuf
******************************************/
*
*xlate()
*{
* while(*ibufptr!=EOL)
* {
*  ifwhflag=0;              /* set IF flag to zero */
*  blanks();              /* skip all blanks */
*  if(match("DATA")) xdata();
*  else if(match("LET")) xlet();
*  else if(match("READ")) xread();
*  else if(match("RESTORE")) xrestore();
*  else if(match("GOSUB")) xgosub();
*  else if(match("GOTO")) xgoto();
*  else if(match("ON")) xon();
*  else if(match("RETURN")) xreturn();
*  else if(match("IF")) xif();
*  else if(match("INPUT")) xinput();
*  else if(match("PRINT")) xprint();
*  else if(match("FOR")) xfor();
*  else if(match("NEXT")) xnext();
*  else if(match("STOP")) xstop();
*  else if(match("ENDWH")) xendwh();
*  else if(match("END")) xend();
*  else if(match("REM")) xrem();
*/*else if(match("SWAP")) xswap();*/
*  else if(match("TRON")) xtron();
*  else if(match("TROFF")) xtroff();
*  else if(match("WHILE")) xwhile();
*/*else if(match("ONIRQ")) xonirq();*/
*  else ximplet();                 /* if no keyword, assume implied LET */
*  if(errcode) return;
*  blanks();
*  if(*ibufptr==MIDEOL) { xmideol(); continue; }
*  if(*ibufptr!=EOL) { errcode=SYTXERR; return; }
*  }
* *tbufptr=EOLTOK;               /* put token eol in token buffer */
* tknbuf[2]=tbufptr-tknbuf+1;    /* put line length into tokenized line */
* return;
*}
*
XLATE:	EQU    *
	JSR    GETCHR      ; GET NEXT CHAR.
	CMPA   #EOL        ; AT THE END OF THE LINE?
	BEQ    XLATE1      ; YES.
	CLR    IFWHFLAG    ; NOT XLATING "IF" OR "WHILE"
	JSR    BLANKS      ; SKIP BLANKS.
	LDX    #KEYWORDS   ; POINT TO KEYWORD TABLE.
XLATE4:	JSR    STREQ       ; IS KEYWORD IS IN THE INPUT BUFFER?
	BCS    XLATE2      ; YES GO PROCESS IT.
XLATE3:	INX                ; NO. POINT TO NEXT CHAR.
	LDAA   0,X         ; AT THE END OF THIS KEYWORD?
	BNE    XLATE3      ; NO.
	LDAB   #4          ; NUMBER OF BYTES TO SKIP.
	ABX
	TST    0,X         ; AT THE END OF THE TABLE?
	BNE    XLATE4      ; NO. CHCK FOR NEXT KEYWORD.
	LDAA   #IMLETTOK   ; ASSUME AN IMPLIED LET.
*        JSR    PUTTOK       ; PUT TOKEN IN BUFFER.
	LDX    #XIMPLET    ; GET ADDR OF XLATION ROUTINE.
*        JSR    0,X          ; GO DO IT.
*        BRA    XLATE6       ; GO FINISH UP.
	BRA    XLATE9
XLATE2:	LDAA   1,X         ; GET KEYWORD TOKEN.
	LDX    2,X         ; GET ADDR OF XLATION ROUTINE.
XLATE9:	JSR    PUTTOK      ; PUT TOKEN IN BUFFER.
	CMPA   #DATATOK    ; SPECIAL CASE, DONT SKIP BLANKS AFTER KEYWORD.
	BEQ    XLATE5
	CMPA   #REMTOK     ; SAME SPECIAL CASE AS FOR DATA.
	BEQ    XLATE5
	JSR    BLANKS      ; SKIP BLANKS BETWEEN KEYWORD & NEXT OBJECT.
XLATE5:	JSR    0,X         ; GO DO IT.
XLATE6:	JSR    BLANKS      ; SKIP BLANKS.
	JSR    GETNXCHR    ; GET NEXT CHAR.
	CMPA   #MIDEOL     ; IS IT A MID EOL?
	BNE    XLATE7      ; NO. CHCK FOR EOL.
	LDAA   #MEOLTOK    ; GET MID EOL TOKEN.
	JSR    PUTTOK      ; PUT IT IN BUFFER.
	BRA    XLATE       ; CONTINUE.
XLATE7:	CMPA   #EOL        ; EOL?
	BEQ    XLATE1      ; YES. FINISH UP.
	LDAA   #SYTXERR    ; NO. SYNTAX ERROR.
	JMP    RPTERR      ; REPORT XLATION ERROR.
XLATE1:	LDAA   #EOLTOK     ; GET EOL TOKEN.
	JSR    PUTTOK      ; PUT IT IN BUFFER.
	LDD    TBUFPTR     ; GET TOKEN BUFFER POINTER.
	SUBD   TKNBUFS     ; Compute the TOKEN BUFFER LENGTH.
	LDX    TKNBUFS     ; POINT TO BUFFER.
	STAB   2,X         ; STORE LENGTH.
	RTS                ; RETURN.
*
*
*        KEYWORD LOOK UP TABLE
*
*
KEYWORDS:	EQU    *
DATA:	FCC    "DATA"
	FCB    0
	FCB    DATATOK
	FDB    XDATA
LET:	FCC    "LET"
	FCB    0
	FCB    LETTOK
	FDB    XLET
READ:	FCC    "READ"
	FCB    0
	FCB    READTOK
	FDB    XREAD
RESTORE:	FCC    "RESTORE"
	FCB    0
	FCB    RESTRTOK
	FDB    XRESTORE
GOSUB:	FCC    "GOSUB"
	FCB    0
	FCB    GOSUBTOK
	FDB    XGOSUB
GOTO:	FCC    "GOTO"
	FCB    0
	FCB    GOTOTOK
	FDB    XGOTO
ONTIME:	FCC    "ONTIME"
	FCB    0
	FCB    ONTIMTOK
	FDB    XONTIME
ONIRQ:	FCC    "ONIRQ"
	FCB    0
	FCB    ONIRQTOK
	FDB    XONIRQ
ONPACC:	FCC    "ONPACC"
	FCB    0
	FCB    ONPACTOK
	FDB    XONPACC
ON:	FCC    "ON"
	FCB    0
	FCB    ONTOK
	FDB    XON
RETURN:	FCC    "RETURN"
	FCB    0
	FCB    RETNTOK
	FDB    XRETURN
IIF:	FCC    "IF"
	FCB    0
	FCB    IFTOK
	FDB    XIF
INPUT:	FCC    "INPUT"
	FCB    0
	FCB    INPUTTOK
	FDB    XINPUT
PRINT:	FCC    "PRINT"
	FCB    0
	FCB    PRINTTOK
	FDB    XPRINT
	FCC    "?"
	FCB    0
	FCB    PRINTTOK
	FDB    XPRINT
FOR:	FCC    "FOR"
	FCB    0
	FCB    FORTOK
	FDB    XFOR
NEXT:	FCC    "NEXT"
	FCB    0
	FCB    NEXTTOK
	FDB    XNEXT
STOPSS:	FCC    "STOP"
	FCB    0
	FCB    STOPTOK
	FDB    XSTOP
ENDWH:	FCC    "ENDWH"
	FCB    0
	FCB    ENDWHTOK
	FDB    XENDWH
ENDS:	FCC    "END"
	FCB    0
	FCB    ENDTOK
	FDB    XEND
REM:	FCC    "REM"
	FCB    0
	FCB    REMTOK
	FDB    XREM
TRON:	FCC    "TRON"
	FCB    0
	FCB    TRONTOK
	FDB    XTRON
TROFF:	FCC    "TROFF"
	FCB    0
	FCB    TROFFTOK
	FDB    XTROFF
WHILE:	FCC    "WHILE"
	FCB    0
	FCB    WHILETOK
	FDB    XWHILE
POKE:	FCC    "POKE"
	FCB    0
	FCB    POKETOK
	FDB    XPOKE
DIM:	FCC    "DIM"
	FCB    0
	FCB    DIMTOK
	FDB    XDIM
EEP:	FCC    "EEP"
	FCB    0
	FCB    EEPTOK
	FDB    XEEP
PORTA:	FCC    "PORTA"
	FCB    0
	FCB    PORTATOK
	FDB    XPORTA
PORTB:	FCC    "PORTB"
	FCB    0
	FCB    PORTBTOK
	FDB    XPORTB
PORTC:	FCC    "PORTC"
	FCB    0
	FCB    PORTCTOK
	FDB    XPORTC
PORTD:	FCC    "PORTD"
	FCB    0
	FCB    PORTDTOK
	FDB    XPORTD
INBYTES:	FCC    "INBYTE"
	FCB    0
	FCB    INBYTTOK
	FDB    XINBYTE
TIME:	FCC    "TIME"
	FCB    0
	FCB    TIMETOK
	FDB    XTIME
RETI:	FCC    "RETI"
	FCB    0
	FCB    RETITOK
	FDB    XRETI
PACC:	FCC    "PACC"
	FCB    0
	FCB    PACCTOK
	FDB    XPACC
SLEEP:	FCC    "SLEEP"
	FCB    0
	FCB    SLEEPTOK
	FDB    XSLEEP
RTIMES:	FCC    "RTIME"
	FCB    0
	FCB    RTIMETOK
	FDB    XRTIME
	FCB    0           ; END OF TABLE MARKER.

*blanks()
*{
* short spcnt;
* spcnt=0;
* while(*ibufptr==SPC) { ibufptr++; spcnt++; }
*
BLANKS:	EQU    *
	PSHX
	LDX    IBUFPTR
	CLRB
BLANKS1:	LDAA   0,X
	CMPA   #SPC
	BNE    BLANKS2
	INCB
	INX
	BRA    BLANKS1
*
* if(spcnt==0) return;
*
BLANKS2:	TSTB
	BNE    BLANKS3
	PULX
	RTS
*
* if(spcnt>1)
*  {
*   *tbufptr++=MSCNTOK;
*   *tbufptr++=spcnt;
*  }
*
BLANKS3:	STX    IBUFPTR
	LDX    TBUFPTR
	CMPB   #1
	BEQ    BLANKS4
	LDAA   #MSCNTOK
	STAA   0,X
	INX
BLANKS5:	STAB   0,X
	INX
	STX    TBUFPTR
	PULX
	RTS
*
* else
*  {
*   *tbufptr++=SSCNTOK;
*  }
* return;
*}
*
BLANKS4:	LDAB   #SSCNTOK
	BRA    BLANKS5
*
*
*<><><><><><><> NOTE: THIS FUNCTION NOT NEEDED <><><><><><><>
*
*/**************************************
*             match()
* try to find match between *lit and
* *ibufptr. if match found, ibufptr is
* advanced to point beyond *lit. the
* string pointed to by lit must be null
* terminated.
***************************************/
*
*match(lit)
*char *lit;
*{
* int k;
* if(k=streq(ibufptr,lit))
* {
*  ibufptr+=k;
*  return(1);
* }
* return(0);
*}
	
*/****************************************
*               streq()
* compare srt1 to str2. str2 must be null
* terminated.
*****************************************/
*
*streq(str1,str2)
*char *str1,*str2;
*{
* int k;
* k=0;
* while(str2[k])         /* we're not at the end of string2 */
* {
*  if((str1[k])!=(str2[k])) return(0);
*  k++;
* }
* return(k);
*}
*
STREQ:	EQU    *
	LDD    IBUFPTR     ; SAVE VALUE OF POINTER.
*        PSHD
	PSHB
	PSHA
STREQU4:	LDAA   0,X
	BEQ    STREQU2
STREQU1:	BSR    GETNXCHR
	jsr    ToUpper	; Make the character upper case.
	CMPA   0,X
	BEQ    STREQU3
*        PULD
	PULA
	PULB
	STD    IBUFPTR
	CLC
	RTS
STREQU3:	INX
	BRA    STREQU4
STREQU2:	PULA
	PULB
	SEC
	RTS
*
*
*        THIS ROUTINE GETS THE NEXT CHARACTER FROM THE INPUT BUFFER.
*
*
GETCHR:	PSHX               ; SAVE THE X REGISTER.
	LDX    IBUFPTR     ; GET POINTER.
	LDAA   0,X         ; GET A CHARACTER.
	PULX               ; RESTORE X.
	RTS                ; RETURN.
*
*
*        THIS ROUTINE GETS THE NEXT CHARACTER FROM THE INPUT BUFFER
*        AND ADVANCES THE POINTER TO POINT TO THE NEXT CHARACTER.
*
*
GETNXCHR:	BSR    GETCHR
*                       FALL THROUGH TO INCIBP.
*
*
*        THIS ROUTINE JUST INCREMENTS THE INPUT BUFFER POINTER.
*
*
INCIBP:	PSHX               ; SAVE X.
	LDX    IBUFPTR     ; GET POINTER.
INCIBP1:	INX                ; ADVANCE POINTER.
	STX    IBUFPTR     ; UPDATE POINTER.
INCIBP2:	PULX               ; RESTORE X
	RTS                ; RETURN.
*
*
*        THIS ROUTINE PUTS THE WORD IN THE D-REG. INTO THE TOKEN BUFFER
*        AND ADVANCES THE TOKEN BUFFER POINTER.
*
*
PUTDTOK:	BSR    PUTTOK      ; PUT THE FIRST BYTE INTO THE TOKEN BUFFER.
	TBA                ; PUT THE 2ND BYTE INTO A.
*                            ; FALL THROUGH TO PUTTOK.
*
*
*        THIS ROUTINE PUTS THE CHARACTER IN THE A-REG. INTO THE TOKEN
*        BUFFER AND ADVANCES THE TOKEN BUFFER POINTER.
*
*
PUTTOK:	PSHX               ; SAVE X.
	pshb
	psha					; (9/12/89).
	LDX    TBUFPTR     ; GET POINTER.
	STAA   0,X         ; PUT CHARACTER.
PUTTOK1:	INX                ; ADVANCE POINTER.
	STX    TBUFPTR     ; SAVE POINTER.
	 
	LDD    TKNBUFS     ; get the starting address of the token buffer.
	ADDD   #TBUFLEN    ; add the length of the buffer to it.
	CPD    TBUFPTR     ; IS THE TOKEN BUFFER FULL?
	pula					; (9/12/89).
	pulb               ; restore the b reg.
	BHI    INCIBP2     ; NO. RESTORE X AND RETURN.
	LDAA   #EXPCXERR   ; YES. FLAG THE ERROR.
	JMP    RPTERR      ; GO REPORT IT.