basiclb4.asm

proteus 仿真实例

	JMP    RPTERR
XPRINT6:	LDAA   #SEMITOK
	BSR    CHKCOMA2
	BRA    XPRINT9
*
*
CHKCOMA:	JSR    GETCHR          ; GET CHARACTER FROM INPUT BUFFER.
	CMPA   #COMMA          ; IS IT A COMMA?
	BEQ    CHKCOMA1        ; YES. PUT IT IN THE TOKEN BUFFER.
	CLC                    ; NO. FLAG NO COMMA FOUND.
	RTS                    ; RETURN.
CHKCOMA1:	LDAA   #COMMATOK       ; GET THE COMMA TOKEN.
CHKCOMA2:	JSR    PUTTOK          ; PUT THE TOKEN IN THE BUFFER.
	JSR    INCIBP          ; BUMP THE INPUT BUFFER POINTER.
	SEC
	RTS                    ; RETURN.
*
*
*/***** xinput() *****/
*
*xinput()
*{
* *tbufptr++=INPUTTOK;           /* put INPUT token in buffer */
* blanks();                      /* skip blanks */
*
*
XINPUT:	EQU    *
*        JSR    BLANKS
	BSR    XCHKDEV         ; GO CHECK FOR AN ALTERNATE DEVICE NUMBER.
*
*
* if(*ibufptr=='"')              /* is a prompt included? */
* {                      /* yes */
*  getscon();            /* get the string constant */
*  if(errcode) return;   /* if error, return */
*  if(*ibufptr!=COMMA) { errcode=SYTXERR; return; }
*  *tbufptr++=COMMATOK;
*  ++ibufptr;
* }
* inreadcm();            /* get the input variable list */
* return;
*}
*
*
XINPUT2:	JSR    BLANKS
	JSR    GETCHR
	CMPA   #'"'
	BNE    INREADCM
	JSR    GETSCON
	BSR    CHKCOMA         ; IF COMMA PRESENT, PUT IN TOKEN BUFFER.
	BCS    INREADCM
XINPUT3:	LDAA   #MCOMAERR
	JMP    RPTERR
*
*
*/***** inreadcm() *****/
*
*inreadcm()
*{
* while(1)               /* do forever */
* {
*  blanks();             /* skip blanks */
*  getvar();             /* get a variable */
*  if(errcode) return;   /* if error, return */
*  blanks();             /* skip blanks */
*  if(*ibufptr==COMMA) 
*  {
*   *tbufptr++=COMMATOK;      /* put delimiter in buffer */
*   ++ibufptr;                /* and point to the next char in the buffer */
*  }
*  else return;          /* if no delimiter return */
* }
*}
*
XDIM:	EQU    *
INREADCM:	EQU    *
XREAD:	EQU    *
*        JSR    BLANKS
	JSR    GETVAR
XREAD1:	JSR    BLANKS
	BSR    CHKCOMA
	BCS    XREAD
	RTS
*
*
*
XCHKDEV:	EQU    *
	JSR    GETCHR
	CMPA   #'#'       ; HAS AN ALTERNATE PORT BEEN SPECIFIED?
	BEQ    XCHKDEV1   ; NO. GO PROCESS THE REST OF THE PRINT STATEMENT.
	RTS               ; RETURN.
XCHKDEV1:	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.
	LDAA   #NUM       ; EXPRESSION MUST BE NUMERIC.
	JSR    XEXPRES    ; GO GET THE EXPRESSION.
	JSR    BLANKS     ; SKIP SPACES.
	BSR    CHKCOMA    ; GO GET COMMA THAT MUST FOLLOW THE EXPRESSION.
	BCC    XINPUT3    ; MISSING COMMA. GO REPORT THE ERROR.
	RTS               ; IT WAS THERE. GO PROCESS THE REST OF THE STATEMENT.
*
*
*
XINBYTE:	EQU    *
	BSR    XCHKDEV    ; GO CHECK FOR ALTERNATE DEVICE.
	JSR    BLANKS     ; SKIP BLANKS AFTER COMMA.
	JMP    GETVAR     ; GO TRY TO GET A VARIABLE.
*
*
*
*
*/***** xread *****/
*
*xread()
*{
* *tbufptr++=READTOK;    /* put read token in buffer */
* inreadcm();            /* get the variable list */
* return;
*}
*
*/***** xrestore() *****/
*
*xrestore()
*{
* *tbufptr++=RESTRTOK;   /* put RESTORE token in buffer */
* return;
*}
*
*/***** xwhile() *****/
*
*xwhile()
*{
* *tbufptr++=WHILETOK;   /* put WHILE token in buffer */
* blanks();              /* skip blanks */
* ifwhflag=1;            /* indicate we are going to get a WHILE expression */
* xexpres(NULL);         /* get expression */
* return;
*}
*
*
XWHILE:	EQU    *
*        JSR    BLANKS
	INC    IFWHFLAG
	LDAA   #NULL
	JMP    XEXPRES
*
*
*/***** xendwh() *****/
*
*xendwh()
*{
* *tbufptr++=ENDWHTOK;   /* put ENDWH token in buffer */
* return;
*}
*
*
XPACC:	EQU    *
XTIME:	EQU    *
	LDAB   #NUM         ; SETUP TO USE CODE IN "ASIGNMT".
	JMP    ASIGNMT1     ; GO DO ASSIGNMENT STATEMENT.
*
*
*
*/***** rpterr() *****/
*
*rpterr()
*{
*char *ptr,c;
* ptr=inbuff;    /* point to start of input buffer */
* nl();
* nl();
* while((c=*ptr++)!=EOL) outbyte(c);     /* print the input buffer */
*
*
RPTERR:	EQU    *
	STAA   ERRCODE
	JSR    NL2
	LDX    INBUFFS
RPTERR1:	LDAA   0,X
	CMPA   #EOL
	BEQ    RPTERR2
	JSR    OUTBYTE
	INX
	BRA    RPTERR1
*
*
* nl();          /* go to next line */
* ptr=inbuff;    /* point to begining of input buffer */
* while(ptr++ < ibufptr-2) outbyte('*');    /* output '*' to point of error */
* pl("^^^");  /* point to error */
* nl();
*
*
RPTERR2:	EQU    *
	JSR    NL
	LDX    IBUFPTR
	DEX
	DEX
	CPX    INBUFFS
	BLS    RPTERR4
	STX    IBUFPTR
	LDX    INBUFFS
	LDAA   #'*'
RPTERR3:	JSR    OUTBYTE
	INX
	CPX    IBUFPTR
	BNE    RPTERR3
RPTERR4:	LDX    #ARROWS
	JSR    PL
	JSR    NL
	BSR    RPTERR5
RPTERR6:	LDAA   #1
	STAA   CONTFLAG
	JMP    MAIN3
*
*
* pl("ERROR # ");
* outdeci(errcode);
* return;
*}
*
*
RPTERR5:	LDX    #ERRORS
	JSR    PL
	LDAB   ERRCODE
	CLRA
	JMP    OUTDECI
*
*
ARROWS:	FCC    "^^^"
	FCB    0
ERRORS:	FCC    "ERROR # "
	FCB    0
*
*
RPTRERR:	EQU    *             ; REPORT A RUN TIME ERROR.
	STAA   ERRCODE
	JSR    RPTERR5
RPTRERR1:	LDX    #INLINE
	JSR    PL
	LDD    CURLINE
	JSR    OUTDECI
	JSR    NL
	LDAA   #1
	STAA   CONTFLAG
	JMP    MAINW
*
*
BREAKS:	FCC    "BREAK"
INLINE:	FCC    " IN LINE # "
	FCB    0
        $IF     HC11 = 0
*
*
*/***** outdeci() *****/
*
*outdeci(num)
*short num;
*{
* int k,zs;
* char c;
* zs=0;
* k=10000;
* if(num<0)
* {
*  num=(-num);
*  outbyte('-');
* }
*
*
OUTDECI:	EQU    *
	CPD    #0
	BNE    OUTDECI7
	LDAA   #'0'
	JMP    OUTBYTE
OUTDECI7:	PSHY
*        PSHD
	PSHB
	PSHA
	CLRB
	PSHB
	PSHB
	TSY
	LDD    2,Y
	BPL    OUTDECI1
	COMA
	COMB
	ADDD   #1
	STD    2,Y
	LDAA   #'-'
	JSR    OUTBYTE
*
*
* while(k>=1)
* {
*  c=num/k+'0';
*  if((c!='0') | (k==1) | (zs)) { zs=1; outbyte(c); }
*  num=num%k;
*  k=k/10;
* }
* return;
*}
*
*
OUTDECI1:	EQU    *
	LDX    #PWRTEN
OUTDECI2:	LDD    2,Y
	CLR    1,Y
OUTDECI3:	SUBD   0,X
	BMI    OUTDECI5
	INC    1,Y
	BRA    OUTDECI3
OUTDECI5:	ADDD   0,X
	STD    2,Y
	LDAA   1,Y
	BNE    OUTDECI6
	TST    0,Y
	BEQ    OUTDECI4
OUTDECI6:	ADDA   #$30
	LDAB   #1
	STAB   0,Y
	JSR    OUTBYTE
OUTDECI4:	INX
	INX
	TST    1,X
	BNE    OUTDECI2
	INS
	INS
	INS
	INS
	PULY
	RTS
	
*
*
PWRTEN:	FDB    10000
	FDB    1000
	FDB    100
	FDB    10
	FDB    1
	FDB    0
*
        $ELSE
*
OUTDECI:	EQU    *
	CPD    #0
	BNE    OUTDECI1
	LDAA   #'0'
	JMP    OUTBYTE
OUTDECI1:	EQU    *
	PSHY
*        PSHD                ; SAVE THE NUMBER TO PRINT.
	PSHB
	PSHA
	LDD    #10000       ; NUMBER TO START DIVIDING BY.
*        PSHD
	PSHB
	PSHA
	CLRB                ; SET INITAL VALUE OF LEADING ZERO SUPRESS FLAG.
	PSHB
	TSY
	LDD    3,Y          ; IS THE NUMBER NEGATIVE?
	BPL    OUTDECI2     ; NO. GO PRINT THE NUMBER.
	COMA                ; YES. MAKE THE NUMBER POSITIVE.
	COMB                ; (TWO'S COMPLEMENT)
	ADDD   #1
	STD    3,Y          ; SAVE THE RESULT.
	LDAA   #'-'         ; PRINT A MINUS SIGN TO SHOW IT'S NEGATIVE.
	JSR    OUTBYTE
OUTDECI2:	LDD    3,Y          ; GET THE DIVIDEND.
	LDX    1,Y          ; GET THE DIVISOR.
	IDIV                ; DO THE DIVIDE.
	STD    3,Y          ; SAVE THE REMAINDER.
	XGDX                ; PUT QUOTIENT IN D.
	CPD    #0           ; IS THE QUOTIENT 0?
	BNE    OUTDECI3     ; NO. GO OUTPUT THE NUMBER.
	TST    0,Y          ; YES. ARE WE STILL SUPRESSING LEADING ZEROS?
	BEQ    OUTDECI4     ; YES. DON'T PRINT THE NUMBER.
OUTDECI3:	TBA                 ; PUT THE NUMBER IN THE A-REG.
	ADDA   #$30         ; MAKE THE NUMBER ASCII.
	LDAB   #1           ; MAKE THE ZERO SUPRESS FLAG NON-ZERO.
	STAB   0,Y
	JSR    OUTBYTE      ; OUTPUT THE NUMBER.
OUTDECI4:	LDD    1,Y          ; GET CURRENT DIVISOR.
	LDX    #10          ; DIVIDE IT BY 10.
	IDIV
	STX    1,Y          ; SAVE RESULT. ARE WE DONE?
	BNE    OUTDECI2     ; NO KEEP GOING.
	LDAB   #5           ; DEALLOCATE LOCALS.
	ABY
	TYS
	PULY                ; RESTORE Y.
	RTS                 ; RETURN.
*
*
        $ENDIF
*
*