basic11.sdi

proteus 仿真实例

E123,08,,         INX
E124,20 F6,,         BRA    PL1
E126,39,PL2:, PL2:    RTS
,,, *
,,,
,,, *        /***** parse() *****/
,,,
,,, *parse()
,,, *{
,,, * int num;
,,, * tbufptr=tknbuf;                /* initalize the token buffer pointer */
,,, *
,,, PARSE:  EQU    *
E127,DE 4B,,         LDX    TKNBUFS          ; Get the start of the token buffer
E129,DF 02,,         STX    TBUFPTR
,,, *
,,, * if(num=getlinum())             /* get line number if present */
,,, * {
,,, *  if(*ibufptr==EOL)             /* was line # followed by CR? */
,,, *  {                             /* yes. */
,,, *   delline(num);                /* go delete the line from the prog buffer */
,,, *   return;
,,, *  }
,,, *  immid=0;                      /* flag as not immidiate */
,,, *  putlinum(num);                /* put line number in buffer */
,,, * }
,,, *  else immid=1;                  /* if no line # flag as immidiate*/
,,, *
E12B,8D 3F,,         BSR    GETLINUM
E12D,24 19,,         BCC    PARSE2
E12F,36,,         PSHA
E130,BD E3 C3,,         JSR    GETCHR
E133,81 0D,,         CMPA   #EOL
E135,32,,         PULA
E136,26 09,,         BNE    PARSE1
E138,BD EB A1,,         JSR    DELLINE
E13B,DE 0A,,         LDX    VAREND
E13D,08,,         INX
E13E,DF 2D,,         STX    STRASTG
E140,39,PARSE7:, PARSE7: RTS
E141,7F 00 19,PARSE1:, PARSE1: CLR    IMMID
E144,8D 6E,PARSE8:, PARSE8: BSR    PUTLINUM
E146,20 10,,         BRA    PARSE3
E148,BD E3 C3,PARSE2:, PARSE2: JSR    GETCHR
E14B,81 0D,,         CMPA   #EOL
E14D,27 F1,,         BEQ    PARSE7
E14F,86 01,,         LDAA   #1
E151,97 19,,         STAA   IMMID
E153,CC 00 00,,         LDD    #0
E156,20 EC,,         BRA    PARSE8
,,, *
,,, * if(errcode) return;             /* if line number error, return */
,,, * xlate();                        /* if translation error, return */
,,, * if(errcode) return;
,,, * if(immid) runline();            /* if immidiate mode run 1 line */
,,, *  else storlin();                /* if not store pgm line */
,,, * return;                         /* go get next line */
,,, *}
,,, *
E158,BD E1 E2,PARSE3:, PARSE3: JSR    XLATE
E15B,7D 00 19,,         TST    IMMID
E15E,27 03,,         BEQ    PARSE5
E160,7E F2 2E,,         JMP    RUNLINE      ; GO RUN THE LINE & RETURN.
E163,BD EB 7A,PARSE5:, PARSE5: JSR    STORLIN      ; GO STORE LINE & RETURN.
E166,DE 0A,,         LDX    VAREND
E168,08,,         INX
E169,DF 2D,,         STX    STRASTG
E16B,39,,         RTS
,,, *
,,,
,,, *        /***** getlinum *****/
,,,
,,, *getlinum()
,,, *{
,,, * int num;
,,, * num=0;
,,, *
,,, GETLINUM:       EQU    *
,,, *
,,, *
E16C,18 3C,,         PSHY
E16E,4F,,         CLRA
E16F,36,,         PSHA
E170,36,,         PSHA
E171,18 30,,         TSY
,,, *
,,, * if(numeric(*ibufptr)==0) return(0);    /* if 1st char not numeric, rtn 0 */
,,, *
E173,DE 00,,         LDX    IBUFPTR
E175,A6 00,,         LDAA   0,X
E177,8D 42,,         BSR    NUMERIC
E179,24 10,,         BCC    GTLNUM4
,,, *
,,, * while(numeric(*ibufptr))       /* while *ibufptr is numeric */
,,, * {
,,, *  num=num*10+(*ibufptr-'0');    /* get a digit */
,,, *  ibufptr++;                    /* advance input buffer pointer */
,,, *  if(num<=0) { errcode=LINRANG; return(0); }
,,, * }
,,, * return(num);
,,, *}
,,, *
E17B,A6 00,GTLNUM2:, GTLNUM2:        LDAA   0,X
E17D,8D 3C,,         BSR    NUMERIC
E17F,25 11,,         BCS    GTLNUM3
E181,0D,,         SEC
E182,18 EC 00,GTLNUM1:, GTLNUM1:        LDD    0,Y
E185,26 04,,         BNE    GTLNUM4
E187,86 12,,         LDAA   #LINENERR
E189,20 0D,,         BRA    GTLNUM5
E18B,31,GTLNUM4:, GTLNUM4:        INS
E18C,31,,         INS
E18D,18 38,,         PULY
E18F,DF 00,,         STX    IBUFPTR
E191,39,,         RTS
E192,8D 07,GTLNUM3:, GTLNUM3:        BSR    ADDDIG
E194,2A E5,,         BPL    GTLNUM2
E196,86 01,,         LDAA   #LINRANG
E198,7E EA 98,GTLNUM5:, GTLNUM5:        JMP    RPTERR
,,, *
,,, *
,,, ADDDIG: EQU    *
E19B,18 EC 00,,         LDD    0,Y
E19E,05,,         ASLD
E19F,05,,         ASLD
E1A0,18 E3 00,,         ADDD   0,Y
E1A3,05,,         ASLD
E1A4,18 ED 00,,         STD    0,Y
E1A7,E6 00,,         LDAB   0,X
E1A9,08,,         INX
E1AA,C0 30,,         SUBB   #'0'
E1AC,4F,,         CLRA
E1AD,18 E3 00,,         ADDD   0,Y
E1B0,18 ED 00,,         STD    0,Y
E1B3,39,,         RTS
,,, *
,,, *
,,, *        /***** putlinum *****/
,,,
,,, *putlinum(lnum)
,,, *int lnum;
,,, *{
,,, * putint(lnum);          /* put line # in token buffer */
,,, * *tbufptr++=0;          /* hold place for length of line */
,,, * return;
,,, *}
,,, *
,,, PUTLINUM:       EQU    *
E1B4,BD E3 D4,,         JSR    PUTDTOK
E1B7,4F,,         CLRA
E1B8,7E E3 D7,,         JMP    PUTTOK
,,, *
,,, *        /***** numeric() *****/
,,,
,,, *numeric(c)
,,, *char c;
,,, *{
,,, * c=c&127;
,,, * return((c>='0')&(c<='9'));
,,, *}
,,, *
,,, NUMERIC:        EQU    *
E1BB,81 30,,         CMPA   #'0'
E1BD,25 06,,         BLO    NUMERIC1
E1BF,81 39,,         CMPA   #'9'
E1C1,22 02,,         BHI    NUMERIC1
E1C3,0D,,         SEC
E1C4,39,,         RTS
E1C5,0C,NUMERIC1:, NUMERIC1:       CLC
E1C6,39,,         RTS
,,,
,,, *        /***** alpha() *****/
,,,
,,, *alpha(c)
,,, *char c;
,,, *{
,,, * c=c&127;
,,, * return((c>='A')&(c<='Z'));
,,, *}
,,, *
,,, ALPHA:  EQU    *
E1C7,81 41,,         CMPA   #'A'
E1C9,25 0E,,         BLO    ALPHA1
E1CB,81 5A,,         CMPA   #'Z'
E1CD,23 08,,         BLS    ALPHA2
E1CF,81 61,,         CMPA   #'a'
E1D1,25 06,,         BLO    ALPHA1
E1D3,81 7A,,         CMPA   #'z'
E1D5,22 02,,         BHI    ALPHA1
E1D7,0D,ALPHA2:, ALPHA2: SEC
E1D8,39,,         RTS
E1D9,0C,ALPHA1:, ALPHA1: CLC
E1DA,39,,         RTS
,,,
,,, *        /***** alphanum *****/
,,,
,,, *alphanum(c)
,,, *char c;
,,, *{ return ((alpha(c)) | (numeric(c))); }
,,, *
,,, ALPHANUM:       EQU    *
E1DB,8D EA,,         BSR    ALPHA
E1DD,24 01,,         BCC    ALPHANU1
E1DF,39,,         RTS
E1E0,20 D9,ALPHANU1:, 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    *
E1E2,BD E3 C3,,         JSR    GETCHR      ; GET NEXT CHAR.
E1E5,81 0D,,         CMPA   #EOL        ; AT THE END OF THE LINE?
E1E7,27 4F,,         BEQ    XLATE1      ; YES.
E1E9,7F 00 1A,,         CLR    IFWHFLAG    ; NOT XLATING "IF" OR "WHILE"
E1EC,BD E3 7A,,         JSR    BLANKS      ; SKIP BLANKS.
E1EF,CE E2 46,,         LDX    #KEYWORDS   ; POINT TO KEYWORD TABLE.
E1F2,BD E3 A5,XLATE4:, XLATE4: JSR    STREQ       ; IS KEYWORD IS IN THE INPUT BUFFER?
E1F5,25 13,,         BCS    XLATE2      ; YES GO PROCESS IT.
E1F7,08,XLATE3:, XLATE3: INX                ; NO. POINT TO NEXT CHAR.
E1F8,A6 00,,         LDAA   0,X         ; AT THE END OF THIS KEYWORD?
E1FA,26 FB,,         BNE    XLATE3      ; NO.
E1FC,C6 04,,         LDAB   #4          ; NUMBER OF BYTES TO SKIP.
E1FE,3A,,         ABX
E1FF,6D 00,,         TST    0,X         ; AT THE END OF THE TABLE?
E201,26 EF,,         BNE    XLATE4      ; NO. CHCK FOR NEXT KEYWORD.
E203,86 02,,         LDAA   #IMLETTOK   ; ASSUME AN IMPLIED LET.
,,, *        JSR    PUTTOK       ; PUT TOKEN IN BUFFER.
E205,CE E4 1C,,         LDX    #XIMPLET    ; GET ADDR OF XLATION ROUTINE.
,,, *        JSR    0,X          ; GO DO IT.
,,, *        BRA    XLATE6       ; GO FINISH UP.
E208,20 04,,         BRA    XLATE9
E20A,A6 01,XLATE2:, XLATE2: LDAA   1,X         ; GET KEYWORD TOKEN.
E20C,EE 02,,         LDX    2,X         ; GET ADDR OF XLATION ROUTINE.
E20E,BD E3 D7,XLATE9:, XLATE9: JSR    PUTTOK      ; PUT TOKEN IN BUFFER.
E211,81 0C,,         CMPA   #DATATOK    ; SPECIAL CASE, DONT SKIP BLANKS AFTER KEYWORD.
E213,27 07,,         BEQ    XLATE5
E215,81 0A,,         CMPA   #REMTOK     ; SAME SPECIAL CASE AS FOR DATA.
E217,27 03,,         BEQ    XLATE5
E219,BD E3 7A,,         JSR    BLANKS      ; SKIP BLANKS BETWEEN KEYWORD & NEXT OBJECT.
E21C,AD 00,XLATE5:, XLATE5: JSR    0,X         ; GO DO IT.
E21E,BD E3 7A,XLATE6:, XLATE6: JSR    BLANKS      ; SKIP BLANKS.
E221,BD E3 CA,,         JSR    GETNXCHR    ; GET NEXT CHAR.
E224,81 3A,,         CMPA   #MIDEOL     ; IS IT A MID EOL?
E226,26 07,,         BNE    XLATE7      ; NO. CHCK FOR EOL.
E228,86 7A,,         LDAA   #MEOLTOK    ; GET MID EOL TOKEN.
E22A,BD E3 D7,,         JSR    PUTTOK      ; PUT IT IN BUFFER.
E22D,20 B3,,         BRA    XLATE       ; CONTINUE.
E22F,81 0D,XLATE7:, XLATE7: CMPA   #EOL        ; EOL?
E231,27 05,,         BEQ    XLATE1      ; YES. FINISH UP.
E233,86 02,,         LDAA   #SYTXERR    ; NO. SYNTAX ERROR.
E235,7E EA 98,,         JMP    RPTERR      ; REPORT XLATION ERROR.
E238,86 7D,XLATE1:, XLATE1: LDAA   #EOLTOK     ; GET EOL TOKEN.
E23A,BD E3 D7,,         JSR    PUTTOK      ; PUT IT IN BUFFER.
E23D,DC 02,,         LDD    TBUFPTR     ; GET TOKEN BUFFER POINTER.
E23F,93 4B,,         SUBD   TKNBUFS     ; Compute the TOKEN BUFFER LENGTH.
E241,DE 4B,,         LDX    TKNBUFS     ; POINT TO BUFFER.
E243,E7 02,,         STAB   2,X         ; STORE LENGTH.
E245,39,,         RTS                ; RETURN.
,,, *
,,, *
,,, *        KEYWORD LOOK UP TABLE
,,, *
,,, *
,,, KEYWORDS:       EQU    *
E246,44 41 54 41,DATA:, DATA:   FCC    "DATA"
E24A,00,,         FCB    0
E24B,0C,,         FCB    DATATOK
E24C,E3 FC,,         FDB    XDATA
E24E,4C 45 54,LET:, LET:    FCC    "LET"
E251,00,,         FCB    0
E252,01,,         FCB    LETTOK
E253,E4 1C,,         FDB    XLET
E255,52 45 41 44,READ:, READ:   FCC    "READ"
E259,00,,         FCB    0
E25A,0D,,         FCB    READTOK
E25B,EA 58,,         FDB    XREAD
E25D,52 45 53 54 4F 52,RESTORE:, RESTORE:        FCC    "RESTORE"
,,, RESTORE:        FCC    "RESTORE"
E264,00,,         FCB    0
E265,0E,,         FCB    RESTRTOK
E266,E3 FB,,         FDB    XRESTORE
E268,47 4F 53 55 42,GOSUB:, GOSUB:  FCC    "GOSUB"
E26D,00,,         FCB    0
E26E,0F,,         FCB    GOSUBTOK
E26F,E3 F2,,         FDB    XGOSUB
E271,47 4F 54 4F,GOTO:, GOTO:   FCC    "GOTO"
E275,00,,         FCB    0
E276,12,,         FCB    GOTOTOK
E277,E3 F2,,         FDB    XGOTO
E279,4F 4E 54 49 4D 45,ONTIME:, ONTIME: FCC    "ONTIME"
E27F,00,,         FCB    0
E280,25,,         FCB    ONTIMTOK
E281,E8 D3,,         FDB    XONTIME
E283,4F 4E 49 52 51,ONIRQ:, ONIRQ:  FCC    "ONIRQ"
E288,00,,         FCB    0
E289,26,,         FCB    ONIRQTOK
E28A,E8 D3,,         FDB    XONIRQ
E28C,4F 4E 50 41 43 43,ONPACC:, ONPACC: FCC    "ONPACC"
E292,00,,         FCB    0
E293,28,,         FCB    ONPACTOK
E294,E8 F3,,         FDB    XONPACC
E296,4F 4E,ON:, ON:     FCC    "ON"
E298,00,,         FCB    0
E299,13,,         FCB    ONTOK
E29A,E8 85,,         FDB    XON
E29C,52 45 54 55 52 4E,RETURN:, RETURN: FCC    "RETURN"
E2A2,00,,         FCB    0
E2A3,14,,         FCB    RETNTOK
E2A4,E3 FB,,         FDB    XRETURN
E2A6,49 46,IIF:, IIF:    FCC    "IF"
E2A8,00,,         FCB    0