basiclb4.asm

该应用软件可以实现大多数单片机的仿真实验

*        title    BASICLB4
*        page
*
*
*/***** xon *****/
*
*xon()
*{
* int num;
* *tbufptr++=ONTOK;      /* put ON token in buffer */
* blanks();              /* skip any blanks */
* xexpres(NUM);          /* get the expression */
* if(errcode) return;    /* if error, return */
* blanks();              /* skip any blanks */
* if(match("GOTO")) xgoto();     /* check for GOTO */
* else if(match("GOSUB")) xgosub();      /* check for GOSUB */
* else errcode=IONSYERR;         /* if neither, flag an error */
* if(errcode) return;            /* if error, return */
* blanks();              /* skip blanks */
*
*
XON:	EQU    *
*        JSR    BLANKS
	LDAA   #NUM
	JSR    XEXPRES
XON1:	JSR    BLANKS
	LDX    #GOTO
	JSR    STREQ
	BCC    XON2
	LDAA   #GOTOTOK
	JSR    PUTTOK
	JSR    BLANKS
	JSR    XGOTO
	BRA    XON5
XON2:	LDX    #GOSUB
	JSR    STREQ
	BCS    XON4
	LDAA   #IONSYERR
	JMP    RPTERR
XON4:	LDAA   #GOSUBTOK
	JSR    PUTTOK
	JSR    BLANKS
	JSR    XGOSUB
XON5:	JSR BLANKS
*
*
* while(*ibufptr==',')   /* do until EOL */
* {
*  *tbufptr++=COMMATOK;  /* put COMMA token in buffer */
*  ++ibufptr;            /* advance the input buffer pointer */
*  blanks();             /* skip blanks */
*  *tbufptr++=LCONTOK;   /* put line number constant token in buffer */
*  num=getlinum();       /* get line number */
*  if(num==0) errcode=LINENERR;   /* if 0, line number error */
*  if(errcode) return;    /* if error, return */
*  putint(num);           /* put line number in buffer */
*  blanks();              /* skip blanks */
* }
* return;
*}
*
	JSR    CHKCOMA
	BCS    XON6
	RTS
XON6:	JSR    BLANKS
	LDAA   #LCONTOK
	JSR    PUTTOK
	JSR    GETLINUM
XON8:	JSR    PUTDTOK
	BRA    XON5
*
*
XONIRQ:	EQU    *            ; "ONIRQ" HAS A FUNCTION CODE & LINE NUMBER.
XONTIME:	EQU    *
	LDAA   #NUM         ; GO GET THE VALUE OF THE TIMER WE SHOULD GO ON.
	JSR    XEXPRES
	JSR    BLANKS       ; SKIP BLANKS.
	JSR    CHKCOMA      ; GO CHECK FOR A COMMA.
	BCS    XONTIME1     ; IF PRESENT, IT'S OK.
XONTIME2:	LDAA   #MCOMAERR    ; IF NOT, REPORT AN ERROR.
	JMP    RPTERR
XONTIME1:	JSR    BLANKS
	LDAA   #LCONTOK     ; GET THE LINE CONSTANT TOKEN.
	JSR    PUTTOK       ; PUT IT IN THE TOKEN BUFFER.
	JSR    GETLINUM     ; GO GET A LINE NUMBER.
	JMP    PUTDTOK      ; PUT THE LINE NUMBER IN THE TOKEN BUFFER.
*
*
XONPACC:	EQU    *
	BSR    GETARG       ; GET AN ARGUMENT AND A COMMA.
	BRA    XONTIME      ; GO USE SOME OTHER CODE.
*
*
GETARG:	LDAA   #NUM         ; GO GET THE "OPERATING MODE" EXPRESSION.
	JSR    XEXPRES
	JSR    BLANKS       ; SKIP BLANKS.
	JSR    CHKCOMA      ; GO CHECK FOR COMMA.
	BCC    XONTIME2     ; NO COMMA. REPORT ERROR.
	JMP    BLANKS       ; SKIP BLANKS AFTER COMMA AND RETURN.

*
*
*
*/***** xif() *****/
*
*xif()
*{
*int num;
* *tbufptr++=IFTOK;              /* put if token in the buffer */
* blanks();                      /* skip any blanks */
* ifwhflag=1;                    /* let xexpres() know we are doing an IF */
* xexpres(NULL);                 /* get relational expression */
* if(errcode) return;            /* if error, return */
* blanks();                      /* if not, skip blanks */
*
*
XIF:	EQU    *
*        JSR    BLANKS
	INC    IFWHFLAG
	LDAA   #NUM
	JSR    XEXPRES
XIF1:	JSR    BLANKS
*
*
* if(match("THEN"))              /* check for "THEN" clause */
* {
*  *tbufptr++=THENTOK;           /* put THEN token in the buffer */
*  blanks();                     /* skip any blanks after "THEN" */
*
*
	LDX    #THENS
	JSR    STREQ
	BCS    XIF2
	LDAA   #MTHENERR
	JMP    RPTERR
*
*
*  if(numeric(*ibufptr))         /* is a line number present after THEN? */
*  {                             /* yes */
*   *tbufptr++=LCONTOK;          /* put line # const. token in buffer */
*   num=getlinum();              /* get the line # */
*   if(num==0) errcode=LINENERR;
*   if(errcode) return;          /* if error, return */
*   putint(num);                 /* put number in buffer */
*  }
*  else                          /* not a line #, check for statement */
*  {
*   xlate();             /* try to make a statement out of what follows */
*   if(errcode) return;          /* if error, return */
*  }
* }
*
*
XIF2:	EQU    *
	LDAA   #THENTOK
	JSR    PUTTOK
	JSR    BLANKS
	JSR    GETCHR
	JSR    NUMERIC
	BCC    XIF9
*
XIF3:	LDAA   #LCONTOK
	JSR    PUTTOK
	JSR    GETLINUM
XIF6:	JSR    PUTDTOK
*
*
* else                   /* if "THEN" not present */
* {
*  errcode=MTHENERR;             /* flag a missing THEN error */
*  return;
* }
*
*
* blanks();                      /* skip any blanks after object of THEN */
* if(match("ELSE"))              /* is "ELSE" clause present? */
* {                              /* yes */
*  *tbufptr++=ELSETOK;           /* put ELSE token in the buffer */
*  blanks();                     /* skip any blanks after ELSE */
*
*
XIF4:	EQU    *
	JSR    BLANKS
	LDX    #ELSES
	JSR    STREQ
	BCS    XIF7
	RTS
XIF7:	LDAA   #ELSETOK
	JSR    PUTTOK
	JSR    BLANKS
*
*
*  if(numeric(*ibufptr))         /* is a line # present after ELSE */
*  {                     /* yes */
*   *tbufptr++=LCONTOK;          /* put line # const. token in buffer */
*   num=getlinum();              /* get the line # */
*   if(num==0) errcode=LINENERR;
*   if(errcode) return;          /* if error, return */
*   putint(num);                 /* put number in buffer */
*  }
*  else          /* line # not present, try to xlate a statement */
*  {
*   xlate();
*  }
* }
*
*
	JSR    GETCHR
	JSR    NUMERIC
	BCS    XIF8
XIF9:	LDAA   #LINENERR
	JMP    RPTERR
XIF8:	LDAA   #LCONTOK
	JSR    PUTTOK
	JSR    GETLINUM
XIF10:	JMP    PUTDTOK
*
* return;                /* in any case, return */
*}
*
*
THENS:	FCC    "THEN"
	FCB    0
ELSES:	FCC    "ELSE"
	FCB   0
*
*
*/***** xfor() *****/
*
*xfor()
*{
* short type;
* *tbufptr++=FORTOK;             /* put for token in buffer */
* blanks();              /* skip blanks between FOR & assignment statement */
* type=getvar();         /* get variable */
* if((type!=NUM)|(*ibufptr++!='='))      /* is it a numerical variable? */
* { errcode=IVEXPERR; return; }  /* no. flag error & return */
*
*
XFOR:	EQU    *
*        JSR    BLANKS
	JSR    GETVAR
	CMPA   #NUM
	BEQ    XFOR1
XFOR2:	LDAA   #IVEXPERR
	JMP    RPTERR
XFOR1:	JSR    GETNXCHR
	CMPA   #'='
	BNE    XFOR2
*
*
* *tbufptr++=EQUALTOK;   /* put equals token in buffer */
* xexpres(NUM);          /* go get a numerical expression */
* if(errcode) return;    /* if error, return */
* blanks();              /* skip blanks */
*
*
	LDAA   #EQUALTOK
	JSR    PUTTOK
	LDAA   #NUM
	JSR    XEXPRES
	JSR    BLANKS
*
*
* if(match("TO"))        /* is TO present? */
* {                      /* yes */
*  *tbufptr++=TOTOK;     /* put TO token in buffer */
*  blanks();             /* skip blanks */
*  xexpres(NUM);         /* get the "TO" expression */
*  if(errcode) return;   /* return if error */
* }
* else                   /* "TO" not present */
* {
*  errcode=MTOERR;       /* set error flag & return */
*  return;
* }
*
*
	LDX    #TO
	JSR    STREQ
	BCS    XFOR4
	LDAA   #MTOERR
	JMP    RPTERR
XFOR4:	LDAA   #TOTOK
	JSR    PUTTOK
	JSR    BLANKS
	LDAA   #NUM
	JSR    XEXPRES
*
*
* blanks();              /* skip blanks */
* if(match("STEP"))      /* is optional "STEP" clause present? */
* {                      /* yes */
*  *tbufptr++=STEPTOK;   /* put STEP token in buffer */
*  blanks();             /* skip blanks */
*  xexpres(NUM);         /* get expression */
* }
* return;
*}
*
*
	JSR    BLANKS
	LDX    #STEP
	JSR    STREQ
	BCS    XFOR3
	RTS
XFOR3:	LDAA   #STEPTOK
	JSR    PUTTOK
	JSR    BLANKS
	LDAA   #NUM
	JMP    XEXPRES
*
*
TO:	FCC    "TO"
	FCB    0
STEP:	FCC    "STEP"
	FCB    0
*
*
*/***** xnext() *****/
*
*xnext()
*{
* *tbufptr++=NEXTTOK;    /* put NEXT token in buffer */
* blanks();              /* skip blanks */
* if(getvar()!=NUM) errcode=SYTXERR;     /* get variable, must be numeric */
* return;
*}
*
*
XNEXT:	EQU    *
*        JSR    BLANKS
	JSR    GETVAR
	CMPA   #NUM
	BEQ    XNEXT1
	LDAA   #SYTXERR
	JMP    RPTERR
XNEXT1:	RTS
*
*
*/***** xprint() *****/
*
*xprint()
*{
* *tbufptr++=PRINTTOK;   /* put PRINT token in buffer */
* blanks();             /* skip blanks */
*
*
XPRINT:	EQU    *
*        JSR    BLANKS
	JSR    GETCHR
	CMPA   #'#'       ; HAS AN ALTERNATE PORT BEEN SPECIFIED?
	BNE    XPRINT9    ; NO. GO PROCESS THE REST OF THE PRINT STATEMENT.
	LDAA   #PNUMTOK   ; YES. PUT THE TOKEN INTO THE BUFFER.
	JSR    PUTTOK     ; DO IT.
	JSR    INCIBP     ; POINT PAST THE "#".
	JSR    BLANKS     ; SKIP SPACES BETWEEN '#' AND EXPRESION.
	BRA    XPRINT7    ; GO GET EXPRESSION & CONTINUE.
*
*
	
* while((*ibufptr!=EOL)|(*ibufptr!=MIDEOL))    /* do until end of line */
* {
*  xexpres(NULL);        /* get expression */
*  if(errcode) return;   /* if error, return */
*  blanks();             /* skip blanks */
*  if(*ibufptr==COMMA) *tbufptr=COMMATOK;        /* check for comma */
*  else if(*ibufptr==SEMI) *tbufptr=SEMITOK;     /* check for semicolin */
*  else return;          /* if neither, return */
*  ++ibufptr;            /* advance input buffer pointer */
*  ++tbufptr;            /* advance token buffer pointer */
*  blanks();             /* skip blanks after delimeter */
* }
* return;
*}
XPRINT9:	JSR    BLANKS
	JSR    GETCHR
	CMPA   #EOL
	BEQ    XPRINT2
	CMPA   #MIDEOL
	BNE    XPRINT3
XPRINT2:	RTS
XPRINT3:	JSR    GETCHR       ; GET THE NEXT CHARACTER IN THE BUFFER.
	CMPA   #'"'         ; IS IT A STRING CONSTANT?
	BNE    XPRINT7
	JSR    GETSCON      ; YES. GO GET A STRING CONSTANT.
	BRA    XPRINT8      ; CONTINUE.
XPRINT7:	LDAA   #NUM
	JSR    XEXPRES
XPRINT8:	JSR    BLANKS
	JSR    GETCHR
	CMPA   #EOL
	BEQ    XPRINT2
	CMPA   #MIDEOL
	BEQ    XPRINT2
	BSR    CHKCOMA
	BCS    XPRINT9
XPRINT4:	CMPA   #SEMI
	BEQ    XPRINT6
	LDAA   #MCMSMERR