;234567890123456789012345678901234567890123456789012345 ; ; In the Kingswood AS65 assembler some of the options ; below must be set manually. ; ; .lf vtl02ca2.lst (set -l in commandline) ; .cr 6502 (is default) ; .tf vtl02ca2.obj,ap1 (set -s2 in commandline) ;-----------------------------------------------------; ; VTL-2 for the 6502 (VTL02C) ; ; Original Altair 680b version by ; ; Frank McCoy and Gary Shannon 1977 ; ; 2012: Adapted to the 6502 by Michael T. Barry ; ; Thanks to sbprojects.com for a very nice assembler! ; ;-----------------------------------------------------; ; Copyright (c) 2012, Michael T. Barry ; Revision B (c) 2015, Michael T. Barry ; Revision C (c) 2015, Michael T. Barry ; All rights reserved. ; ; Redistribution and use in source and binary forms, ; with or without modification, are permitted, ; provided that the following conditions are met: ; ; 1. Redistributions of source code must retain the ; above copyright notice, this list of conditions ; and the following disclaimer. ; 2. Redistributions in binary form must reproduce the ; above copyright notice, this list of conditions ; and the following disclaimer in the documentation ; and/or other materials provided with the ; distribution. ; ; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ; AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED ; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS ; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT ; SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE ; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR ; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, ; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING ; IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ; ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;-----------------------------------------------------; ; Except for the differences discussed below, VTL02 was ; designed to duplicate the OFFICIALLY DOCUMENTED ; behavior of Frank's 680b version, detailed here: ; http://www.altair680kit.com/manuals/Altair_ ; 680-VTL-2%20Manual-05-Beta_1-Searchable.pdf ; These versions ignore all syntax errors and plow ; through VTL-2 programs with the assumption that ; they are "correct", but in their own unique ways, ; so any claims of compatibility are null and void ; for VTL-2 code brave (or stupid) enough to stray ; from the beaten path. ; ; Differences between the 680b and 6502 versions: ; * {&} and {*} are initialized on entry. ; * Division by zero returns 65535 for the quotient and ; the dividend for the remainder (the original 6800 ; version froze). ; * The 6502 has NO 16-bit registers (other than PC) ; and less overall register space than the 6800, ; so the interpreter reserves some obscure VTL02C ; variables {@ $ ( ) 0 1 2 3 4 5 6 7 8 9 < > : ?} ; for its internal use (the 680b version used a ; similar tactic, but differed in the details). ; The deep nesting of parentheses also puts {; < =} ; in danger of corruption. For example, executing ; the statement A=((((((((1)))))))) sets both {A} ; and {;} to the value 1. ; * Users wishing to call a machine language subroutine ; via the system variable {>} must first set the ; system variable {"} to the proper address vector ; (for example, "=768). ; * The x register is used to point to a simple VTL02C ; variable (it can't point explicitly to an array ; element like the 680b version because it's only ; 8-bits). In the comments, var[x] refers to the ; 16-bit contents of the zero-page variable pointed ; to by register x (residing at addresses x, x+1). ; * The y register is used as a pointer offset inside ; a VTL02C statement (easily handling the maximum ; statement length of about 128 bytes). In the ; comments, @[y] refers to the 16-bit address ; formed by adding register y to the value in {@}. ; * The structure and flow of this interpreter are ; similar to the 680b version, but have been ; reorganized in a more 6502-friendly format (the ; 6502 has no 'bsr' instruction, so the 'stuffing' ; of subroutines within 128 bytes of the caller is ; only advantageous for conditional branches). ; * This version is based on the original port, which ; was wound rather tightly, in a failed attempt to ; fit it into 768 bytes like the 680b version; many ; structured programming principles were sacrificed ; in that effort. The 6502 simply requires more ; instructions than the 6800 does to manipulate 16- ; bit quantities, but the overall execution speed ; should be comparable due to the 6502's slightly ; lower average clocks/instruction ratio. As it is ; now, it fits into 1KB with just a few bytes to ; spare, but is more feature-laden than the 680b ; interpreter whence it came. Beginning with ; Revision C, I tried to strike a tasteful balance ; between execution speed and code size, but I ; stubbornly kept it under 1024 ROMable bytes and ; used only documented op-codes that were supported ; by the original NMOS 6502 (without the ROR bug). ; I may have missed a few optimizations -- further ; suggestions are welcome. ; * VTL02C is my free gift (?) to the world. It may be ; freely copied, shared, and/or modified by anyone ; interested in doing so, with only the stipulation ; that any liabilities arising from its use are ; limited to the price of VTL02C (nothing). ;-----------------------------------------------------; ; 2015: Revision B included some space optimizations ; (suggested by dclxvi) and enhancements ; (suggested by mkl0815 and Klaus2m5): ; ; * Bit-wise operators & | ^ (and, or, xor) ; Example: A=$|128) Get a char and set hi-bit ; ; * Absolute addressed 8-bit memory load and store ; via the {< @} facility: ; Example: <=P) Point to the I/O port at P ; @=@&254^128) Clear low-bit & flip hi-bit ; ; * Starting with VTL02B, the space character is no ; longer a valid user variable nor a "valid" binary ; operator. It's now only significant as a numeric ; constant terminator and as a place-holder in ; strings and program listings, where it may be ; used to improve human readability (at a slight ; cost in execution speed and memory consumption). ; Example: ; * (VTL-2) ; 1000 A=1) Init loop index ; 1010 ?=A) Print index ; 1020 ?="") Newline ; 1030 A=A+1) Update index ; 1040 #=A<10*1010) Loop until done ; ; * (VTL02B) ; 1000 A = 1 ) Init loop index ; 1010 ? = A ) Print index ; 1020 ? = "" ) Newline ; 1030 A = A + 1 ) Update index ; 1040 # = A < 10 * 1010 ) Loop until done ; ; 2015: Revision C includes further enhancements ; (suggested by Klaus2m5): ; ; * "THEN" and "ELSE" operators [ ] ; A[B returns 0 if A is 0, otherwise returns B. ; A]B returns B if A is 0, otherwise returns 0. ; ; * Some effort was made to balance interpreter code ; density with interpreter performance, while ; remaining within the 1KB constraint. Structured ; programming principles remained at low priority. ; ; VTL02 for the 2m5 emulated 6502 SBC ; - released: 20-nov-2015 ; - codename: speedy Gonzales ; - based on VTL02C, changes by Klaus2m5 ; ; added a timer variable {/} with 10ms increments. ; ; added braces as shift operators. ; A}B shifts A by B bits to the right. ; A{B shifts A by B bits to the left. ; result is unpredictable if B > 16 ; ; added a statement delimiter {;} allowing multi ; statement lines. ; branch to same line is now allowed. ; {?="..."} & unmatched {)} (used for comments) can ; not be continued. ; ; line numbers >= 65280 are now reserved for the ; following fast return & goto features. ; added a gosub stack, depth = 16 address words. ; {==...} is a gosub and pushes the return address ; of the next line. ; {#==} is a return and pops the address when the ; result is the special line numer asigned to {=}. ; added a 31 line addresses acronym label array. ; lowercase characters and symbols in the $60-$7e ; range are used to address the array. the array ; is populated with the address of a line when a ; character in the allowed range preceeds the line ; number. ; ; example (prints the first 1000 prime numbers): ; 10 /=0;Q=d;V=5;U=25;X=1000 ; 20 N=2;==b ; 30 N=N+1;==b ; 40 N=N+2;==b ; a100 N=N+2;==b ; 120 N=N+4;==b ; 150 #=a ; b200 #=NV[d ; 320 A=N/D;#=%]=;D=D+4;#=D10[465;?=0 ; 465 ?=%;?=" seconds" ; ; internal changes: ; added required atomic variable fetch & store. ; replaced some jsr calls with inline code ; for skpbyte:, getbyte:, plus:, minus:. ; replaced cvbin calls to mul: & plus: with custom ; inline multiply by 10 & digit adder. ; removed simulation from startup of eval:. ; mainloop uses inline code to advance to next ; sequential program line. ; find: is now only used for true branches. ; added decimal to binary conversion on line entry ; avoiding the runtime conversion. ; abbreviated getting a simple variable in getval:. ; bypassed setting a simple variable in exec:. ; added inline divide by 10 to prnum:. ; fixed statement delimiter not overriding mismatched ; parentheses. ; merged oper: into getval: and progr: into exec: ; added a check for ctrl-c & ctrl-z during goto to ; allow user escape from a loop. ; ;-----------------------------------------------------; ; VTL02C variables occupy RAM addresses $0080 to $00ff, ; and are little-endian, in the 6502 tradition. ; The use of lower-case and some control characters for ; variable names is allowed, but not recommended; any ; attempts to do so would likely result in chaos, due ; to aliasing with upper-case and system variables. ; Variables tagged with an asterisk are used internally ; by the interpreter and may change without warning. ; {@ $ ( ) 0..9 : > ?} are (usually) intercepted by ; the interpreter, so their internal use by VTL02C is ; "safe". The same cannot be said for {; < =}, so be ; careful! at = $80 ; {@}* internal pointer / mem byte ; VTL02C standard user variable space ; {A B C .. X Y Z [ \ ] ^ _} ; VTL02C system variable space space = $c0 ; { }* gosub & return stack pointer ; Starting with VTL02B: ; the space character is no longer a valid user ; variable nor a "valid" binary operator. It is ; now only significant as a numeric constant ; terminator and as a place-holder in strings ; and program listings. bang = $c2 ; {!} return line number quote = $c4 ; {"} user ml subroutine vector pound = $c6 ; {#} current line number dolr = $c8 ; {$}* temp storage / char i/o remn = $ca ; {%} remainder of last division ampr = $cc ; {&} pointer to start of array tick = $ce ; {'} pseudo-random number lparen = $d0 ; {(}* temp line # / begin sub-exp rparen = $d2 ; {)}* temp storage / end sub-exp star = $d4 ; {*} pointer to end of free mem ; $d6 ; {+ , - .} valid variables ; (1) $fe ; {/} 10ms count up timer ; Interpreter argument stack space arg = $e0 ; {0 1 2 3 4 5 6 7 8 9}* ; Rarely used variables and argument stack overflow ; = $f4 ; {:}* array variable header semico = $f6 ; {;}* statement delimiter lthan = $f8 ; {<}* user memory byte pointer equal = $fa ; {=}* temp / gosub & return stack gthan = $fc ; {>}* temp / call ML subroutine ques = $fe ; {?}* temp / terminal i/o ; nulstk = $01ff ; system stack resides in page 1 ; (1) additional configurable variables and operators timr_var = '/' ; 10 ms count up variable timr_adr = timr_var*2|$80 ;-----------------------------------------------------; ; Equates for a 48K+ Apple 2 (original, +, e, c, gs) ;ESC = 27 ; "Cancel current input line" key ;BS = 8 ; "Delete last keypress" key ;OP_OR = '!' ; Bit-wise OR operator ;linbuf = $0200 ; input line buffer ;prgm = $0800 ; VTL02C program grows from here ;himem = $8000 ; ... up to the top of user RAM ;vtl02c = $8000 ; interpreter cold entry point ; (warm entry point is startok) ;KBD = $c000 ; 128 + keypress if waiting ;KEYIN = $fd0c ; apple monitor keyin routine ;COUT = $fded ; apple monitor charout routine ;-----------------------------------------------------; ; Equates for the 2m5 SBC emulator ESC = 27 ; "Cancel current input line" key BS = 8 ; "Delete last keypress" key OP_OR = '|' ; Bit-wise OR operator lblary = $0100 ; array with goto labels vtlstck = $0140 ; gosub stack space, 64 bytes linbuf = $0200 ; input line buffer prgm = $0280 ; VTL02C program grows from here himem = $7800 ; ... up to the top of user RAM vtl02c = $f800 ; interpreter cold entry point ; (warm entry point is startok) io_area = $bf00 ;configure emulator terminal I/O acia_tx = io_area+$f0 ;acia tx data register acia_rx = io_area+$f0 ;acia rx data register timr_ie = io_area+$fe ;timer interrupt enable bit 0 timr_fl = io_area+$ff ;timer flags, bit 0 = 10ms tick diag = io_area+$fc ;diag reg, bit 7 = exit to mon ;=====================================================; org vtl02c ;-----------------------------------------------------; ; Initialize program area pointers and start VTL02C ; lda #lo(prgm) sta ampr ; {&} -> empty program lda #hi(prgm) sta ampr+1 lda #lo(himem) sta star ; {*} -> top of user RAM lda #hi(himem) sta star+1 lda #0 ; clear label array & gosub stack ldx #95 reset1: sta lblary,x dex bpl reset1 sta space ; clear pointer to user stack startok: sec ; request "OK" message ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Start/restart VTL02C command line with program intact ; start: cld ; a sensible precaution ldx #lo(nulstk) txs ; drop whatever is on the stack bcc user ; skip "OK" if carry clear jsr outnl lda #'O' ; output \nOK\n to terminal jsr outch lda #'K' jsr outch jsr outnl user: lda #0 ; last line # = direct mode sta pound sta pound+1 jsr inln ; input a line from the user lda linbuf ; check for line label char cmp #$60 bcc user1 iny ; skip label char user1: ldx #pound ; cvbin destination = {#} jsr cvbin ; skip line number if exists jsr d2b ; convert numbers in line to binary bne stmnt ; no: execute direct statement ; populate the acronym label array lda lblary+62 ; label array populated ? bne user2 ; yes: skip polpulating it tya ; no: populate now! pha lda #lo(prgm) sta gthan lda #hi(prgm) sta gthan+1 ldaraylp: ldy #0 lda (gthan),y ; is label ? cmp #$60 bcc ldaray1 ; no: skip load and #$1f ; make index to label array asl a tax lda gthan ; line address -> array sta lblary,x lda gthan+1 sta lblary+1,x ldaray1: ldy #3 ; add offset to next line lda gthan ldx gthan+1 clc adc (gthan),y ; add offset bcc ldaray2 inx ldaray2: sta gthan stx gthan+1 cpx ampr+1 ; end of program ? bcc ldaraylp ; no: loop next line bne ldaray3 cmp ampr bcc ldaraylp ldaray3: sty lblary+62 ; mark populated pla tay user2: jmp exec ; execute a direct mode statement ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Delete/insert/replace program line or list program ; stmnt: clc lda pound ora pound+1 ; {#} = 0? bne jskp2 ; no: delete/insert/replace line ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; List program to terminal and restart "OK" prompt ; entry: Carry must be clear ; uses: findln:, outch:, prnum:, prstr:, {@ ( )} ; exit: to command line via findln: ; list_: jsr findln ; find program line >= {#} ldx #0 lda (at,x) ; print label jsr outch ldx #lparen ; line number for prnum jsr prnum ; print the line number lda #' ' ; print a space instead of the jsr outch ; line length byte lda #0 ; zero for delimiter jsr prstr ; print the rest of the line bcs list_ ; (always taken) jskp2: lda lblary+62 ; label array clear ? beq skp2 ; then skip clearing it lda #0 ; clear label array & gosub stack ldx #95 clr_ls: sta lblary,x dex bpl clr_ls sta space ; clear pointer to user stack ;-----------------------------------------------------; ; Delete/insert/replace program line and restart the ; command prompt (no "OK" means success) ; entry: Carry must be clear ; uses: find:, start:, linbuf, {@ > # & * (} ; skp2: tya ; save linbuf offset pointer pha jsr find ; point {@} to first line >= {#} bcs insrt eor pound ; if line doesn't already exist bne insrt ; then skip deletion process cpx pound+1 bne insrt tax ; x = 0 lda (at),y tay ; y = length of line to delete eor #-1 adc ampr ; {&} = {&} - y sta ampr bcs delt dec ampr+1 delt: lda at sta gthan ; {>} = {@} lda at+1 sta gthan+1 delt2: lda gthan cmp ampr ; delete the line lda gthan+1 sbc ampr+1 bcs insrt lda (gthan),y sta (gthan,x) inc gthan bne delt2 inc gthan+1 bcc delt2 ; (always taken) insrt: pla tax ; x = linbuf offset pointer lda linbuf ; push label or blank cmp #$60 bcs insrt2 lda #' ' insrt2: pha lda pound pha ; push the new line number on lda pound+1 ; the system stack pha ldy #3 cntln: inx iny ; determine new line length in y lda linbuf-1,x ; and push statement string on pha ; the system stack bne cntln cpy #5 ; if empty line then skip the bcc jstart ; insertion process tax ; x = 0 tya clc adc ampr ; calculate new program end sta gthan ; {>} = {&} + y txa adc ampr+1 sta gthan+1 lda gthan cmp star ; if {>} >= {*} then the program lda gthan+1 ; won't fit in available RAM, sbc star+1 ; so drop the stack and abort bcs jstart ; to the "OK" prompt slide: lda ampr bne slide2 dec ampr+1 slide2: dec ampr lda ampr cmp at lda ampr+1 sbc at+1 bcc move ; slide open a gap inside the lda (ampr,x) ; program just big enough to sta (ampr),y ; hold the new line bcs slide ; (always taken) move: tya tax ; x = new line length move2: pla ; pull the statement string and dey ; the new line number and store sta (at),y ; them in the program gap bne move2 ldy #3 txa sta (at),y ; store length after line number lda gthan sta ampr ; {&} = {>} lda gthan+1 sta ampr+1 jstart: jmp start ; drop stack, restart cmd prompt ;-----------------------------------------------------; ; Point @[y] to the first/next program line >= {#} ; entry: (cc): start search at beginning of program ; (cs): start search at next line ; ({@} -> beginning of current line) ; used by: list_:, progr: ; uses: find:, jstart:, prgm, {@ # & (} ; exit: if line not found then abort to "OK" prompt ; else {@} -> found line, x:a = {#} = {(} = ; actual line number, y = 2, (cc) ; 10 bytes findln: jsr find ; find first/next line >= {#} bcs jstart ; if end then restart "OK" prompt sta pound ; {#} = {(} stx pound+1 rts ;-----------------------------------------------------; ; {?="...} handler; called from exec: ; List line handler; called from list_: ; 2 bytes prstr: iny ; skip over the " or length byte tax ; x = delimiter, fall through ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Print a string at @[y] ; x holds the delimiter char, which is skipped over, ; not printed (a null byte is always a delimiter) ; If a key was pressed, it pauses for another keypress ; before returning. If either of those keys was a ; ctrl-C, it drops the stack and restarts the "OK" ; prompt with the user program intact ; entry: @[y] -> string, x = delimiter char ; uses: inch:, inkey:, jstart:, outch:, execrts: ; exit: (normal) @[y] -> null or byte after delimiter ; (ctrl-C) drop the stack & restart "OK" prompt ; prmsg: lda #0 sta arg sta arg+1 txa cmp (at),y ; found delimiter or null? beq prmsg2 ; yes: finish up lda (at),y beq prmsg2 ; insert to decode packed constant bpl prmsg1 iny ; is binary constant cmp #$fd bcs prmsg3 and #$7f ; is single byte sta arg jmp prmsg4 prmsg3: ; is word lsr a ; $00 bytes low->N, high->C ror a bpl prmsg5 ; skip low byte lda (at),y sta arg iny prmsg5: bcc prmsg4 ; skip high byte lda (at),y sta arg+1 iny prmsg4: txa pha ldx #arg ; print constant jsr prnum pla tax bpl prmsg ; end decode constant prmsg1: jsr outch ; no: print char to terminal iny ; and loop (with safety escape) bpl prmsg prmsg2: tax ; save closing delimiter jsr inkey ; any key = pause/resume? txa ; retrieve closing delimiter beq outnl ; always \n after null delimiter pro_skp: ; inline skpbyte iny lda (at),y cmp #' ' beq pro_skp ; end inline cmp #';' ; if trailing char is not ';' bne outnl ; print \n rts ; else suppress the \n outnl: lda #$0d ; \n to terminal jmp outch ;-----------------------------------------------------; ; Execute (hopefully) valid VTL02C statements at @[y] ; exec: will continue until drop to direct mode ; entry: @[y] -> left-side of statement ; uses: nearly everything ; exit: note to machine language subroutine {>=...} ; users: no registers or variables are ; required to be preserved except the system ; stack pointer, the text base pointer {@}, ; and the original line number {(} ; {>=...;..} requires {$} to be preserved ; if there is a {"} directly after the assignment ; operator, the statement will execute as {?="...}, ; regardless of the variable named on the left side ; exec: lda (at),y ; inline getbyte beq execend1 ; do nothing with a null statement cmp #')' ; same for a full-line comment beq execend1 ; the code below allows (N+1) instead of (N=N+1) ; sty dolr+1 ; save index if arg[{1}] = arg[{0}] iny cmp #' ' ; is space? beq exec ; end inline cmp #'A' ; variables < {A} ? bcc exec_byp ; simple variable asl a ; form simple variable address ora #$80 ; mapping function is (a*2)|128 sta arg lda #0 sta arg+1 exec_byp1: lda (at),y ; '=' is next iny ; skip space +1 cmp #' ' ; is space? beq exec_byp1 ldx #arg+2 jsr eval pha sty dolr+1 lda arg+2 ldy #0 exec3: sei ; force timer consistency sta (arg),y adc tick+1 ; store arg[{1}] in the left-side rol a ; variable tax iny lda arg+3 sta (arg),y cli ; force timer consistency end adc tick ; pseudo-randomize {'} rol a sta tick+1 stx tick execend: ldy dolr+1 ; restore line index pla iny cmp #';' ; statement delimiter ? beq exec ; continue with next statement execend1: lda pound ; direct mode ? ora pound+1 beq jstart4 prog_nxt: ldy #3 ; point {@} to next line address ldx at+1 ; current line address lda at clc adc (at),y ; {@} low + offset bcc prg_n1 inx ; {@} high + carry prg_n1: cpx ampr+1 ; exceeds end of program? bcc prg_n2 ; no bne jstart4 ; yes - exit to direct mode cmp ampr bcs jstart4 prg_n2: ; (cc) stx at+1 ; next line address valid! sta at ldy #1 lda (at),y sta pound ; {#} = current line number iny lda (at),y sta pound+1 ldy #4 jmp exec ; loop next line jstart4: sec jmp start ; special variables including array exec_byp: ldx #arg ; initialize argument pointer jsr convp ; arg[{0}] -> left-side variable exec_gb3: ; inline getbyte + skpbyte lda (at),y iny ; skip space +1 cmp #' ' ; is space? beq exec_gb3 ; the code below allows (N+1) instead of (N=N+1) ; cmp #'=' ; not '=' implies assigning ; beq exec_gb4 ; variable as target & 1st source ; ldy dolr+1 ; back up to arg[{1}] = arg[{0}] ; lda (at),y ; bne exec_gb5 exec_gb4: lda (at),y cmp #' ' ; is space? bne exec_gb5 iny ; skip over any space char(s) bne exec_gb4 exec_gb5: ; end inline cmp #'"' ; yes: print the string with beq exec2 ldx #arg+2 ; point eval to arg[{1}] jsr eval ; evaluate right-side in arg[{1}] pha sty dolr+1 ; save to continue same line lda arg+2 ldy #0 ldx arg+1 ; was left-side an array element? bne exec3 ; yes: skip to default actions ldx arg cpx #at ; if {@=...} statement then poke beq poke ; low half of arg[{1}] to ({<}) cpx #dolr ; if {$=...} statement then print beq joutch ; arg[{1}] as ASCII character cpx #ques ; if {?=...} statement then print beq prnum0 ; arg[{1}] as unsigned decimal cpx #gthan ; if {>=...} statement then call beq usr ; user-defined ml routine cpx #pound ; if {#=...} statement then goto beq goto ; arg[{1}] as line number cpx #equal ; if {==...} statement then gosub beq gosub ; arg[{1}] as line number jmp exec3 ; defaults to store variable exec2: jsr prstr ; trailing ';' check & return jmp execend1 gosub: lda pound ; is direct mode ? ora pound+1 beq gosub3 ; return to commandline lda at ; calculate next line address ldy #3 clc adc (at),y ; add to offset tax lda #0 adc at+1 cmp ampr+1 ; address beyond end of program ? bcc gosub2 bne gosub3 cpx ampr bcc gosub2 gosub3: lda #0 ; then return ends program tax gosub2: ldy space ; load VTL user stack pointer sta vtlstck,y ; push high txa sta vtlstck+1,y ; push low iny iny tya and #$1f ; wrap around upper linimt sta space ; save VTL user stack pointer lda #pound ; point to standard line # sta arg ldy #0 ; restore Y lda arg+2 goto: tax ; save line # low ora arg+3 ; fall through ? bne goto1 jmp execend usr: tax ; jump to user ml routine with lda arg+3 ; arg[{1}] in a:x (MSB:LSB) jsr usrq jmp execend usrq: jmp (quote) ; {"} must point to valid 6502 code poke: sta (lthan),y ; store low byte jmp execend joutch: jsr outch ; print character jmp execend prnum0: ldx #arg+2 ; x -> arg[{1}], fall through jsr prnum jmp execend goto_abort: jsr test_abort ; check for ctrl-c or ctrl-z goto1: lda acia_rx ; allow user abort bne goto_abort lda pound ; set {!} as return line # sta bang lda pound+1 sta bang+1 inc bang ; + 1 bne goto11 inc bang+1 goto11: pla ; true goto ldy arg+3 ; is physical address pointer ? cpy #$ff beq goto3 ora pound ; direct mode ? beq goto12 cpy pound+1 ; set carry flag for find bne goto2 cpx pound bne goto2 ldy #4 ; same line - start over jmp exec goto5: txa ; build address to label array and #$1f asl a tay lda lblary,y ; load address from array sta at iny lda lblary,y ; load address from array sta at+1 bne goto7 ; if initialized jstart3: sec ; print OK jmp start goto12: clc ; from start of prog goto2: stx pound ; line # goto - store target sty pound+1 jsr find bcs jstart3 ; end of program sta pound stx pound+1 iny ; y = 3 jmp exec goto3: cpx #'=' ; from stack ? bne goto5 ; else is label ldy space ; load stack pointer bne goto4 ldy #$20 ; wrap around goto4: dey ; load new address from stack lda vtlstck,y sta at dey lda vtlstck,y beq jstart3 ; if not initialized sta at+1 sty space ; save stack pointer goto7: ldy #1 ; load line # lda (at),y sta pound iny lda (at),y sta pound+1 ldy #4 jmp exec ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Print an unsigned decimal number (0..65535) in var[x] ; entry: var[x] = number to print ; uses: outch:, gthan ; exit: var[x] = 0 ; prnum: lda #0 ; null delimiter for print pha prnum2: ; divide var[x] by 10 lda #0 sta gthan+1 ; clr BCD lda #16 sta gthan ; {>} = loop counter prdiv1: asl 0,x ; var[x] is gradually replaced rol 1,x ; with the quotient rol gthan+1 ; BCD result is gradually replaced lda gthan+1 ; with the remainder sec sbc #10 ; partial BCD >= 10 ? bcc prdiv2 sta gthan+1 ; yes: update the partial result inc 0,x ; set low bit in partial quotient prdiv2: dec gthan bne prdiv1 ; loop 16 times lda gthan+1 ora #'0' ; convert BCD result to ASCII pha ; stack digits in ascending lda 0,x ; order ('0' for zero) ora 1,x bne prnum2 ; } until var[x] is 0 pla prnum3: jsr outch ; print digits in descending pla ; order until delimiter is bne prnum3 ; encountered rts ;-----------------------------------------------------; ; Evaluate a (hopefully) valid VTL02C expression at ; @[y] and place its calculated value in arg[x] ; A VTL02C expression is defined as a string of one or ; more terms, separated by operators and terminated ; with a null or an unmatched right parenthesis ; A term is defined as a variable name, a decimal ; constant, or a parenthesized sub-expression; terms ; are evaluated strictly from left to right ; A variable name is defined as a user variable, an ; array element expression enclosed in {: )}, or a ; system variable (which may have side-effects) ; entry: @[y] -> expression text, x -> argument ; uses: getval:, {@}, argument stack area ; exit: arg[x] = result, @[y] -> next text ; eval: jsr getval ; arg[x] = value of first term jmp eval_gb ; startup skipping simulation ;-----------------------------------------------------; ; Get numeric value of the term at @[y] into var[x] ; Some examples of valid terms: 123, $, H, (15-:J)/?) ; getval: lda (at),y ; get variable or constant bpl getvar iny ; get constant cmp #$fd ; constant type ? bcs getword and #$7f ; is single byte sta 0,x lda #0 sta 1,x rts getword: ; is word lsr a ; restore null bytes ror a bpl clrlow ; low byte = 0 lda (at),y ; copy constant low sta 0,x iny bcc clrhigh ; high byte = 0 gethigh: lda (at),y ; copy constant low sta 1,x iny rts clrlow: lda #0 sta 0,x beq gethigh clrhigh: lda #0 sta 1,x rts ; get variable getvar: beq getrts ; safety exit - end of banana cmp ';' beq getrts iny cmp #'@' ; peek? bcs getv_byp ; bypass variables >= @ cmp #' ' ; is space? beq getval ; loop on space cmp #':' ; array element? beq getary cmp #'(' ; sub-expression? beq eval ; yes: evaluate it recursively cmp #'=' ; return after gosub beq gotomark cmp #'$' ; user char input? beq in_chr cmp #'?' ; user line input? beq in_val getv_byp: beq peek cmp #$60 ; line # variable bcs gotomark sty dolr ; get simple variable asl a ora #$80 tay sei ; force timer consistency lda 0,y sta 0,x lda 1,y sta 1,x cli ; force timer consistency end ldy dolr rts getary: ; get array variable jsr convp_array lda (0,x) pha inc 0,x bne getval4 inc 1,x getval4: lda (0,x) sta 1,x ; store high-byte of term value pla getval5: sta 0,x ; store low-byte of term value getrts: rts peek: ; memory access? sty dolr ldy #0 lda (lthan),y ; access memory byte at ({<}) ldy dolr sta 0,x lda #0 sta 1,x rts gotomark: ; special line # 65280 + sta 0,x ; low = stack/label lda #$ff sta 1,x ; 65280 rts in_chr: ; user char input? jsr inch ; input one char sta 0,x lda #0 sta 1,x rts in_val: ; user line input tya pha lda at ; save @[y] pha ; (current expression ptr) lda at+1 pha jsr inln ; input expression from user lda linbuf ; empty ? bne in_val2 sta 0,x ; defaults to 0 sta 1,x beq in_val3 in_val2: jsr d2b ; convert numbers in line to binary jsr eval ; evaluate, var[x] = result in_val3: pla sta at+1 pla sta at ; restore @[y] pla tay rts ; skip over "?" and return ;-----------------------------------------------------; ; Set var[x] to the address of the variable named in a ; entry: a holds variable name, @[y] -> text holding ; array index expression (if a = ':') ; uses: eval, {@ &} ; exit: (eq): var[x] -> variable, @[y] unchanged ; (ne): var[x] -> array element, ; @[y] -> following text ; convp: cmp #':' ; array element? bne simple ; no: var[x] -> simple variable convp_array: jsr eval ; yes: evaluate array index at asl 0,x ; @[y] and advance y rol 1,x clc lda ampr ; var[x] -> array element adc 0,x ; at address 2*index+& sta 0,x lda ampr+1 adc 1,x sta 1,x rts ; The following section is designed to translate the ; named simple variable from its ASCII value to its ; zero-page address. In this case, 'A' translates ; to $82, '!' translates to $c2, etc. The method ; employed must correspond to the zero-page equates ; above, or strange and not-so-wonderful bugs will ; befall the weary traveller on his or her porting ; journey. simple: asl a ; form simple variable address ora #$80 ; mapping function is (a*2)|128 sta 0,x lda #0 sta 1,x rts ;-----------------------------------------------------; ; 16-bit unsigned multiply routine: var[x] *= var[x+2] ; exit: overflow is ignored/discarded, var[x+2] and ; {>} are modified, a = 0 ; op_mul: lda 0,x sta gthan lda 1,x ; {>} = var[x] sta gthan+1 lda #0 sta 0,x ; var[x] = 0 sta 1,x mul2: lda gthan ora gthan+1 beq mulrts ; exit early if {>} = 0 lsr gthan+1 ror gthan ; {>} /= 2 bcc mul3 clc ; inline plus lda 0,x adc 2,x sta 0,x lda 1,x adc 3,x sta 1,x ; end inline mul3: asl 2,x rol 3,x ; left-shift var[x+2] lda 2,x ora 3,x ; loop until var[x+2] = 0 bne mul2 mulrts: jmp eval_gb ;-----------------------------------------------------; ; var[x] += var[x+2] ; op_plus: clc lda 0,x adc 2,x sta 0,x lda 1,x adc 3,x jmp op_ret ;-----------------------------------------------------; ; expects: - ; op_else: lda 0,x ora 1,x beq else_true lda #0 sta 0,x jmp op_ret ;-----------------------------------------------------; ; var[x] -= var[x+2] ; expects: (cs) ; op_minus: lda 0,x sbc 2,x sta 0,x lda 1,x sbc 3,x jmp op_ret ;-----------------------------------------------------; ; expects: - ; op_then: lda 0,x ora 1,x beq eval_gb else_true: lda 2,x sta 0,x lda 3,x jmp op_ret ;-----------------------------------------------------; ; Apply the binary operator in a to var[x] and var[x+2] ; Valid VTL02C operators are {* + / [ ] - | ^ & < = >} ; {>} is defined as greater than _or_equal_ ; An undefined operator will be interpreted as one of ; the three comparison operators ; notdn: pha ; stack alleged operator inx ; advance the argument stack inx ; pointer jsr getval ; arg[x+2] = value of next term dex dex pla ; retrieve and apply the operator oper: cmp #'/' ; division operator? bcs op_byp1 cmp #'+' ; addition operator? beq op_plus cmp #'*' ; multiplication operator? beq op_mul cmp #'-' ; subtraction operator? beq op_minus cmp #'&' ; bit-wise and operator? beq op_and if OP_OR < '/' cmp #OP_OR ; bit-wise or operator? beq op_or endif op_byp1: beq op_div cmp #'[' ; "then" operator? bcc op_byp2 beq op_then cmp #']' ; "else" operator? beq op_else if OP_OR > '/' cmp #OP_OR ; bit-wise or operator? beq op_or endif cmp #'^' ; bit-wise xor operator? beq op_xor cmp #'}' ; shift right operator? bne skp_shr jmp op_shr skp_shr: cmp #'{' ; shift left operator bne skp_shl jmp op_shl skp_shl: op_byp2: ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Apply comparison operator in a to var[x] and var[x+2] ; and place result in var[x] (1: true, 0: false) ; expects: (cs) ; eor #'<' ; 0: '<' 1: '=' 2: '>' sta gthan ; other values in a are undefined, lda 0,x ; inline minus sbc 2,x sta 0,x lda 1,x sbc 3,x sta 1,x ; end inline dec gthan ; var[x] -= var[x+2] bne oper8b ; equality test? ora 0,x ; yes: 'or' high and low bytes beq oper8c ; (cs) if 0 clc ; (cc) if not 0 oper8b: lda gthan rol a oper8c: adc #0 and #1 ; var[x] = 1 (true), 0 (false) sta 0,x lda #0 op_ret sta 1,x ; store result high eval_gb: lda (at),y ; get next operator beq evalrts cmp #';' ; statement delimiter ? beq evalrts iny ; skip over any space char(s) cmp #' ' ; is space? beq eval_gb ; end inline cmp #')' ; no: skip over the operator bne notdn ; and continue the evaluation evalrts: rts ; yes: return with final result ;-----------------------------------------------------; ; var[x] &= var[x+2] ; expects: - ; op_and: lda 0,x and 2,x sta 0,x lda 1,x and 3,x jmp op_ret ;-----------------------------------------------------; ; var[x] |= var[x+2] ; expects: - ; op_or: lda 0,x ora 2,x sta 0,x lda 1,x ora 3,x jmp op_ret ;-----------------------------------------------------; ; var[x] ^= var[x+2] ; expects: - ; op_xor: lda 0,x eor 2,x sta 0,x lda 1,x eor 3,x jmp op_ret ;-----------------------------------------------------; ; 16-bit unsigned division routine ; var[x] /= var[x+2], {%} = remainder, {>} modified ; var[x] /= 0 produces {%} = var[x], var[x] = 65535 ; op_div: lda #0 sta remn ; {%} = 0 sta remn+1 lda #16 sta gthan ; {>} = loop counter div1: asl 0,x ; var[x] is gradually replaced rol 1,x ; with the quotient rol remn ; {%} is gradually replaced rol remn+1 ; with the remainder lda remn cmp 2,x lda remn+1 ; partial remainder >= var[x+2]? sbc 3,x bcc div2 sta remn+1 ; yes: update the partial lda remn ; remainder and set the sbc 2,x ; low bit in the partial sta remn ; quotient inc 0,x div2: dec gthan bne div1 ; loop 16 times sop_ret jmp eval_gb ;-----------------------------------------------------; ; var[x] shifted right by var[x+2] places ; op_shr: dec 2,x bmi sop_ret lsr 1,x ror 0,x jmp op_shr ;-----------------------------------------------------; ; var[x] shifted left by var[x+2] places ; op_shl: dec 2,x bmi sop_ret asl 0,x rol 1,x jmp op_shl ;-----------------------------------------------------; ; If text at @[y] is a decimal constant, translate it ; into var[x] (discarding any overflow) and update y ; entry: @[y] -> text containing possible constant; ; leading space characters are skipped, but ; any spaces encountered after a conversion ; has begun will end the conversion. ; used by: user:, d2b: ; uses: var[x], var[x+2], {@ > ?} ; exit: (ne): var[x] = constant, @[y] -> next text ; (eq): var[x] = 0, @[y] unchanged ; (cs): in all but the truly strangest cases ; cvbin: lda #0 sta 0,x ; var[x] = 0 sta 1,x cvb_gb1: ; inline getbyte sty ques ; save pointer lda (at),y iny ; skip over any space char(s) cmp #' ' ; is space? beq cvb_gb1 ; end inline cvb_gb2: ; skip multiply & add for 1st digit eor #'0' ; if char at @[y] is not a cmp #10 ; decimal digit then stop bcs cvbin1 ; the conversion sta 0,x cvbin2: lda (at),y ; grab a char eor #'0' ; if char at @[y] is not a cmp #10 ; decimal digit then stop bcs cvbin3 ; the conversion pha ; save decimal digit lda 1,x ; inline multiply by 10 sta gthan+1 lda 0,x sta gthan asl a rol 1,x asl a rol 1,x clc adc gthan sta 0,x lda 1,x adc gthan+1 asl 0,x rol a sta 1,x ; end inline pla ; retrieve decimal digit clc ; inline add digit adc 0,x sta 0,x bcc cvbin4 inc 1,x cvbin4: ; end inline iny ; loop for more digits bpl cvbin2 ; (with safety escape) cvbin1: dey cvbin3: cpy ques ; (ne) if valid, (eq) if not rts ;-----------------------------------------------------; ; Accept input line from user and store it in linbuf, ; zero-terminated (allows very primitive edit/cancel) ; entry: (jsr to inln or newln) ; used by: user:, getval: ; uses: inch:, outnl:, linbuf, {@} ; exit: @[y] -> linbuf ; inln: ldy #lo(linbuf); entry point: start a fresh line sty at ; {@} -> input line buffer ldy #hi(linbuf) sty at+1 ldy #0 inlnlp: ; main loop jsr inch ; get (and echo) one key press cmp #BS ; backspace? beq inlnbs ; yes: delete previous char cmp #ESC ; escape? beq inlnesc ; yes: discard entire line cmp #$0d ; cr? beq inlncr cmp #' ' ; do not store ctrl keys bcc inlnlp sta (at),y ; put key in linbuf iny bpl inlnlp ; loop if < len(linbuf) lda #BS ; hold at end of buffer jsr outch inlnbs: dey ; backspace bpl inlnlp lda #13 ; hold at begin of buffer jsr outch iny bpl inlnlp inlncr: lda #0 ; cr - mark end of line sta (at),y tay ; y = 0 rts inlnesc: cpy #0 ; escape - reverse all input beq inlnlp lda #BS inlnesc1: jsr outch dey bne inlnesc1 beq inlnlp ;-----------------------------------------------------; ; Find the first/next stored program line >= {#} ; entry: (cc): start search at program beginning ; (cs): start search at next line ; ({@} -> beginning of current line) ; used by: skp2:, findln: ; uses: prgm, {@ # & (} ; exit: (cs): {@}, x:a and {(} undefined, y = 3 ; (cc): {@} -> beginning of found line, y = 3, ; x:a = {(} = actual found line number ; find: ldx #hi(prgm) lda #lo(prgm) bcc find1st ; cc: search begins at first line ldx at+1 ldy #3 findnxt: lda at cmp ampr lda at+1 sbc ampr+1 ; {@} >= {&} (end of program)? bcs findrts ; yes: search failed (cs) find3: lda at adc (at),y ; no: {@} -> next line bcc find5 inx find1st: stx at+1 find5: sta at ldy #1 lda (at),y sta lparen ; {(} = current line number cmp pound ; (invalid if {@} >= {&}, but iny ; we'll catch that later...) lda (at),y sta lparen+1 sbc pound+1 ; if {(} < {#} then try the next iny ; program line bcc findnxt lda at ; {@} >= {&} (end of program)? cmp ampr ; yes: search failed (cs) lda at+1 ; no: search succeeded (cc) sbc ampr+1 lda lparen ldx lparen+1 findrts: rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Replaces decimal with binary constants in linbuf ; to avoid runtime conversion. ; < 125 = 1 byte $80-$FC ($80 + binary number) ; > 124 = 3 bytes $FF $0101-$FFFF ; if low byte is $00 then 2 bytes $FE $01-$FF ; if high byte is $00 then 2 bytes $FD $01-$FF ; d2b: php txa ; save pointer to arg pha tya pha lda #0 ; statement position counter sta dolr+1 d2blp: ; main loop inc dolr+1 ; next var, operator or constant ldx #equal ; cvbin converts to equal var jsr cvbin ; convert if decimal beq d2b1 ; if not a constant d2b6: ldx ques ; x = y before conversion inc ques ; always uses at least 1 byte lda equal+1 ; is < 125 ? bne d2b2 lda equal cmp #125 bcs d2b2 ora #$80 ; < 125 = 1 byte sta linbuf,x ; ($80 + binary number) bne d2b3 d2b2: ; >= 125 = 2 or 3 bytes inc ques ; uses at least 2 bytes lda #$ff ; mark word constant sta ques+1 lda equal ; constant low bne d2b8 dec ques+1 ; clear bit 0 in marker = $FE lda equal+1 ; store only constant high sta linbuf+1,x bne d2b19 d2b8: sta linbuf+1,x ; store constant low lda equal+1 ; constant high bne d2b9 dec ques+1 ; clear bit 1 in marker = $FD dec ques+1 bne d2b19 ; and skip store d2b9: sta linbuf+2,x ; store inc ques ; bytes used + 1 d2b19: lda ques+1 ; set marker $FD-$FF sta linbuf,x d2b3: cpy ques ; empty space ? beq d2b1 ; no offset ldx ques d2b4: lda linbuf,y ; shrink the line sta linbuf,x beq d2b7 ; exit on line end inx iny bpl d2b4 ; loop linbuf d2b7: ldy ques d2b1: lda linbuf,y ; is end of line ? beq d2bex ; exit iny cmp #';' ; new statement starts bne d2b10 lda #0 sta dolr+1 ; clear position pointer beq d2blp ; loop next d2b10: cmp #$60 ; prevent lower case on left side bcc d2b11 ldx dolr+1 ; is target variable ? cpx #1 bne d2blp and #$5f ; convert to upper case sta linbuf-1,y bne jd2blp d2b11: cmp #'"' ; potential string ? bne jd2blp lda dolr+1 ; exit on 3rd position (is string) cmp #3 bne jd2blp ; loop if not d2bex: pla ; restore pointer to arg tay pla tax plp rts jd2blp: jmp d2blp ;============ Original I/O subroutines ===============; ;-----------------------------------------------------; ; Check for user keypress and return with (cc) if none ; is pending. Otherwise, fall through to inch ; and return with (cs). ; 6 bytes ;inkey: ; lda KBD ; is there a keypress waiting? ; asl ; bcc outrts ; no: return with (cc) ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Read key from stdin into a, echo, (cs) ; drop stack and abort to "OK" prompt if ctrl-C ; 16 bytes ;inch: ; sty dolr ; save y reg ; jsr KEYIN ; get a char from keyboard ; ldy dolr ; restore y reg ; and #$7f ; strip apple's hi-bit ; cmp #$03 ; ctrl-C? ; bne outch ; no: echo to terminal ; jmp start ; yes: abort to "OK" prompt ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Print ASCII char in a to stdout, (cs) ; 9 bytes ;outch: ; pha ; save original char ; ora #$80 ; apples prefer "high" ASCII ; jsr COUT ; emit char via apple monitor ; pla ; restore original char ; sec ; (by contract with callers) ;outrts: ; rts ;-----------------------------------------------------; ;======== 2m5 SBC emulator I/O subroutines ===========; timr_adr = timr_var*2|$80 ;-----------------------------------------------------; ; Check for user keypress and return if none ; is pending. Otherwise, check for ctrl-C and ; return after next keypress. ; inkey: lda acia_rx ; Is there a character waiting? beq inkeyr ; no: return jsr test_abort inkeyp: lda acia_rx ; pause until next key beq inkeyp jsr test_abort inkeyr: rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Read key from stdin into a, echo, (cs) ; Dump stack and abort to "OK" prompt if ctrl-C ; inch: lda acia_rx ; get character from rx register beq inch ; wait for character !=0 sty dolr ; save y reg cmp #127 ; convert delete to backspace bne conv_bs2del lda #8 conv_bs2del: cmp #27 ; escape? bne skip_esc_no lda timr_adr ; wait 5*10ms clc adc #5 skip_esc_wait: cmp timr_adr ; wait loop bne skip_esc_wait ldy #0 skip_esc_discard: iny ; any data = y > 1 lda acia_rx bne skip_esc_discard cpy #1 bne inch ; discard escape sequence lda #27 ; escape only - send to vtl skip_esc_no ldy dolr ; restore y reg inch2: and #$7f ; ensure char is positive ascii jsr test_abort cmp #BS ; only echo printable, bs & cr beq outch cmp #13 beq outch cmp #' ' bcs outch sec rts test_abort: cmp #3 ; is ctrl-c beq istart ; yes: abort to OK prompt cmp #$1a ; is ctrl-z beq abort ; yes: exit to monitor rts abort: jsr outcr lda #$80 ; exit to monitor sta diag lda #ESC ; escape after continue rts istart: jmp start ; yes: abort to "OK" prompt ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Print ascii char in a to stdout, (cs) ; outch: cmp #13 ; add line feed to carriage return bne skip_cr lda #10 sta acia_tx outcr: lda #13 skip_cr: cmp #8 ; backspace? bne skip_bs sta acia_tx ; make erasing backspace lda #' ' sta acia_tx lda #8 skip_bs: sta acia_tx ; emit char via transmit register sec ; (by contract with callers) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Update a variable with the 10ms timer ; IRQ_10ms: pha inc timr_adr ; increment the variable {/} bne IRQ_exit inc timr_adr+1 IRQ_exit: lda #1 ; clear interrupt flag sta timr_fl pla rti ; Start the timer prior to VTL IRQ_start: lda #1 ; set bit 0 (10ms tick) sta timr_ie ; -> interrupt enable cli jmp vtl02c ; continue cold start ;-----------------------------------------------------; org $fffc dw IRQ_start ; reset vector -> cold start dw IRQ_10ms ; interrupt vector -> 10ms update end IRQ_start ; set start address