; ; Copyright (c) 1991-1995 Paul Campbell ; (for the monitor) ; All Rights Reserved ; THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF Paul Campbell ; The copyright notice above does not evidence any ; actual or intended publication of such source code. ; ; Basic and EForth are (as far as I know) in the public ; domain ; NL = 0xd LF = 0xa BS = 8 DEL = 0x7f ;; ;; lo-core data memory ;; vint0l = 0x30 ;; interrupt 0 vector vint0h = 0x31 vint1l = 0x32 ;; interrupt 1 vector vint1h = 0x33 vtint0l = 0x34 ;; timer interrupt 0 vector vtint0h = 0x35 vtint1l = 0x36 ;; timer interrupt 1 vector vtint1h = 0x37 vtint2l = 0x38 ;; timer interrupt 1 vector vtint2h = 0x39 vserl = 0x3a ;; serial interrupt vector vserh = 0x3b timel = 0x3c ;; time counter timem = 0x3d timeh = 0x3e buffp = 0x3f ;; pointer to buffer base tcountl = 0x40 ;; down counter tcounth = 0x41 ;; ;; Main memory addresses ;; poll_vector = 0x80 ;; pointer to serial poll routine idle_vector = 0x82 ;; pointer to idle routine cli_vector = 0x84 ;; pointer to cli routine send_vector = 0x86 ;; pointer to send routine prompt_vector = 0x88 ;; pointer to prompt routine utility_vector = 0x8a ;; pointer to generic utility vector ;; to be used for adding drivers for external hardware old_addr = 0x8c ;; previous display address old_type = 0x8e ;; previous display type (0 = ram, 1 = ext) buff = 0x8f ;; ;; Interrupt vectors ;; . = 0x0000 ajmp reset nop push vint0l ; vector through low core pointers without push vint0h ; trashing any registers ret nop nop nop push vtint0l push vtint0h ret nop nop nop push vint1l push vint1h ret nop nop nop push vtint1l push vtint1h ret nop nop nop push vserl push vserh ret nop nop nop push vtint2l push vtint2h ret ; nop ; nop ; nop reset: mov p3, #0xc3 ;; turn off pyro channels asap ; ; p2 is always 0 (so software can depend on it) ; mov ie, #0 mov p2, #0 mov psw, #0 mov pcon, #0x00 mov ip, #0 ; ; set up default vectors ; mov r2, #noint&0xff mov r3, #noint>>8 mov r0, #vint0l mov r4, #(vtint2h-vint0l+1)>>1 l1: mov @r0, r2_0 inc r0 mov @r0, r3_0 inc r0 djnz r4, l1 ; ; set up OS dependant vectors ; mov timel, #0 mov timem, #0 mov timeh, #0 mov tcountl, #0 mov tcounth, #0 mov 0x20, #0 ; interupt flags mov r0, #idle_vector mov a, #idle&0xff mov @r0, a inc r0 mov a, #idle>>8 mov @r0, a mov r0, #poll_vector mov a, #pollv&0xff mov @r0, a inc r0 mov a, #pollv>>8 mov @r0, a mov r0, #send_vector mov a, #sendv&0xff mov @r0, a inc r0 mov a, #sendv>>8 mov @r0, a mov r0, #prompt_vector mov a, #promptv&0xff mov @r0, a inc r0 mov a, #promptv>>8 mov @r0, a mov r0, #utility_vector mov a, #utilityv&0xff mov @r0, a inc r0 mov a, #utilityv>>8 mov @r0, a mov r0, #cli_vector mov a, #cliv&0xff mov @r0, a inc r0 mov a, #cliv>>8 mov @r0, a clr a mov r0, #old_addr mov @r0, a inc r0 mov @r0, a inc r0 mov @r0, a ; ; ; set up watch-dog timer interrupt, tick counter ; ; mov vtint2l, #timer2&0xff mov vtint2h, #timer2>>8 ; ; set up the serial port ; mov tmod, #0x0 mov tcon, #0x0 mov t2con, #0x00 mov tl1, #0xfd ; 9600 baud @11MHz mov th1, #0xfd mov tmod, #0x22 mov tcon, #0x40 mov scon, #0x50 ; xmit only mov rcap2h, #0xfc ; 1mS mov rcap2l, #0x6c mov t2mod, #0x00 mov t2con, #0x04 setb ti mov buffp, #buff ; reset buffer ; ; set up sp ; mov sp, #0xd0 ; ; turn on interrupts ; mov ie, #0xa0 ; ; see if we should be calling to another external ROM ; ; mov dptr, #0x4002 ; clr a ; movc a, @a+dptr ; cjne a, #0xa5, L98 ; mov a, #1 ; movc a, @a+dptr ; cjne a, #0x5a, L98 ; mov a, #2 ; lcall L97 ; ljmp L98 ;L97: jmp @a+dptr L98: ; ; Print startup message ; mov dptr, #DO_NL acall DisplayC mov dptr, #RESET_MSG acall DisplayC ; ; Now start main loop ; acall prompt main: acall poll M1: jz M2 mov r2, a acall send ; echo the char mov r0, buffp ; put it in a buffer mov a, r2 mov @r0, a cjne a, #':', M4 ; is it a ':'? mov a, buffp cjne a, #buff, M3 acall i_hex acall prompt ajmp main M4: cjne a, #BS, M6 ; is it a BS? M8: mov r6, a cjne r0, #buff, M9 ajmp M2 M9: dec r0 mov buffp, r0 mov a, #' ' acall send mov a, r6 acall send ajmp M2 M6: cjne a, #DEL, M7 ; is it a DEL? ajmp M8 M7: cjne a, #LF, M10 ; is it a DEL? ajmp M2 M10: cjne a, #NL, M3 ; is it a CR? mov a, #LF ; echo a LF acall send mov r0, buffp mov @r0, #0 ; 0 terminate it mov buffp, #buff ; reset buffer acall cli acall prompt ajmp M2 M3: inc r0 mov buffp, r0 M2: mov r0, #idle_vector acall icall ajmp main icall: mov a, @r0 mov dpl, a inc r0 mov a, @r0 mov dph, a clr a jmp @a+dptr timer2: clr tf2 xch a, timel inc a jnz noover xch a, timel xch a, timem inc a jnz noover2 inc timeh noover2: xch a, timem ajmp noover3 noover: xch a, timel noover3: ; ; Do the down counter - note nothing here touches C ; xch a, tcounth ; is the high byte 0? jz t0_1 xch a, tcounth ; no then check out then low byte xch a, tcountl jnz t0_3 dec a ; if it's 0 decrement the low byte to 0xff xch a, tcountl ; and the high byte dec tcounth reti t0_1: xch a, tcounth ; if the high byte is 0 ... xch a, tcountl jz t0_2 ; if the low byte is non-zero t0_3: dec a ; decrement it t0_2: xch a, tcountl ; and put it back noint: ; come here to do nothing reti idle: ret poll: mov r0, #poll_vector ajmp icall pollv: jb ri, got1 clr a ret got1: mov a, sbuf clr ri ret ; ; here's where we will add drivers for stuff like A/D and NVRAM in the future ; ; you enter here with registers a and r0 available for use ; other registers may contain parameters - it's routine specific ; unless specified utilioty routines must preserve all registers ; r2 contains the routine selector ; c is set on return if the selected utility was present ; utilityv: clr c cjne r2, #0, ut1 ; is it the NULL routine? ret ; yes just return ut1: utbad: setb c ; not a registered selector? bugout with an error ret prompt: mov r0, #prompt_vector ajmp icall promptv: mov a, #':' acall send mov a, #'-' acall send mov a, #')' acall send mov a, #' ' send: mov r1, a mov r0, #send_vector ajmp icall sendv: jnb ti, sendv clr ti mov sbuf, r1 ret ; ; Simple CLI: ; ; Commands: ; ; D addr - display address ; S addr val - set address ; G addr - goto address ; :intelhex - load intel hex ; cli: mov r0, #cli_vector ajmp icall cliv: mov r1, #buff mov a, @r1 cjne a, #0, C0 mov r0, #old_addr mov a, @r0 mov r6, a inc r0 mov a, @r0 mov r7, a inc r0 mov a, @r0 cjne a, #2, CX13 ajmp do_dis CX13: cjne a, #3, CX14 ajmp do_disl CX14: cjne a, #4, CX15 ajmp do_code CX15: jz do_ram ajmp do_ext C1a: ajmp C1 C0: cjne a, #'d', C1a C3: ;; do display inc r1 mov a, @r1 cjne a, #'r', CA1 ;; do DR addr CA2: acall get_addr jc fail_addr mov a, r7 jnz fail_addr do_ram: mov a, r6 acall disp_byte mov a, #':' acall send mov a, #' ' acall send mov r5, #8 CB1: mov r1_0, r6 inc r6 mov a, @r1 acall disp_byte mov a, #' ' acall send djnz r5, CB1 mov a, #'"' acall send mov a, r6 add a, #0xf8 mov r6, a mov r5, #8 CB2: mov r1_0, r6 inc r6 mov a, @r1 acall disp_char djnz r5, CB2 mov a, #'"' acall send mov a, #NL acall send mov a, #LF acall send mov r0, #old_addr mov a, r6 mov @r0, a inc r0 inc r0 clr a mov @r0, a ret fail_addr: mov dptr, #ERR2 ajmp DisplayC CA1: cjne a, #'R', CA3 ajmp CA2 CA3: cjne a, #'b', CCA4 CCA2: acall get_addr jc fail_addr mov r5, #0 CCB3: mov dpl, r6 mov dph, r7 movx a, @dptr inc dptr mov r6, dpl mov r7, dph acall disp_byte djnz r5, CCB3 mov a, #NL acall send mov a, #LF acall send ret CCA4: cjne a, #'B', CCA3 ajmp CCA2 CCA3: cjne a, #'i', CIA4 CIA2: acall get_addr jc fail_addr mov a, #':' acall send mov a, #0x20 acall disp_byte mov a, #0x00 acall disp_byte mov a, #0x20 add a, r6 add a, r7 mov r4, a mov a, r7 acall disp_byte mov a, r6 acall disp_byte mov r5, #0x20 CIB3: mov dpl, r6 mov dph, r7 movx a, @dptr add a, r4 mov r4, a movx a, @dptr inc dptr mov r6, dpl mov r7, dph acall disp_byte djnz r5, CIB3 clr a clr c subb a, r4 acall disp_byte mov a, #NL acall send mov a, #LF acall send ret CIA4: cjne a, #'I', CIA3 ajmp CIA2 CIA3: cjne a, #'m', CA4 ;; do DM addr CA5: acall get_addr jc fail_addr2y do_ext: mov a, r7 acall disp_byte mov a, r6 acall disp_byte mov a, #':' acall send mov a, #' ' acall send mov r5, #8 push r6_0 push r7_0 CB3: mov dpl, r6 mov dph, r7 movx a, @dptr inc dptr mov r6, dpl mov r7, dph acall disp_byte mov a, #' ' acall send djnz r5, CB3 mov a, #'"' acall send pop r7_0 pop r6_0 mov r5, #8 CB4: mov dpl, r6 mov dph, r7 movx a, @dptr inc dptr mov r6, dpl mov r7, dph acall disp_char djnz r5, CB4 mov a, #'"' acall send mov a, #NL acall send mov a, #LF acall send mov r0, #old_addr mov a, r6 mov @r0, a inc r0 mov a, r7 mov @r0, a inc r0 mov a, #1 mov @r0, a ret CA4: cjne a, #'M', CD3 ajmp CA5 fail_addr2y: ajmp fail_addr CD3: cjne a, #'c', CD4 ;; do DM addr CD5: acall get_addr jc fail_addr2y do_code: mov a, r7 acall disp_byte mov a, r6 acall disp_byte mov a, #':' acall send mov a, #' ' acall send mov r5, #8 push r6_0 push r7_0 CE3: mov dpl, r6 mov dph, r7 clr a movc a, @a+dptr inc dptr mov r6, dpl mov r7, dph acall disp_byte mov a, #' ' acall send djnz r5, CE3 mov a, #'"' acall send pop r7_0 pop r6_0 mov r5, #8 CE4: mov dpl, r6 mov dph, r7 clr a movc a, @a+dptr inc dptr mov r6, dpl mov r7, dph acall disp_char djnz r5, CE4 mov a, #'"' acall send mov a, #NL acall send mov a, #LF acall send mov r0, #old_addr mov a, r6 mov @r0, a inc r0 mov a, r7 mov @r0, a inc r0 mov a, #4 mov @r0, a ret CD4: cjne a, #'C', fail2 ajmp CD5 C1: cjne a, #'D', C2 ajmp C3 fail2: ajmp fail C2: cjne a, #'s', C4 C5: ;; do set inc r1 mov a, @r1 cjne a, #'r', CC1 ;; do SR addr byte byte byte CC2: acall get_addr jc fail_addr2 mov a, r7 jnz fail_addr2 mov r0, #old_addr ; save address mov a, r6 mov @r0, a inc r0 inc r0 clr a mov @r0, a mov r3_0, r6 ; move address registers to saved location CD1: acall get_addr jnc CD0 mov a, r6 jnz fail_data ret CD0: dec r1 mov r0_0, r3 mov a, r6 mov @r0, a inc r3 ajmp CD1 CC1: cjne a, #'R', CC3 ajmp CC2 CC3: cjne a, #'m', CC4 ;; do SM addr byte byte byte CC5: acall get_addr jc fail_addr2 mov r0, #old_addr ; save address mov a, r6 mov @r0, a inc r0 mov a, r7 mov @r0, a inc r0 mov a, #1 mov @r0, a mov r3_0, r6 ; move address registers to saved location mov r4_0, r7 CD11: acall get_addr jnc CD10 mov a, r6 jnz fail_data ret CD10: dec r1 mov dpl, r3 mov dph, r4 mov a, r6 movx @dptr, a inc dptr mov r3, dpl mov r4, dph ajmp CD11 CC4: cjne a, #'M', failx ajmp CC5 failx: ajmp fail fail_addrx: ajmp fail_addr fail_data: mov dptr, #ERR3 ajmp DisplayC C4: cjne a, #'S', C6 ajmp C5 fail_addr2: ajmp fail_addr C6: cjne a, #'r', CF6 CF5: ljmp registers CF6:cjne a, #'R', CF7 ajmp CF5 CF7: cjne a, #'g', C7 C8: ;; do go acall get_addr jc fail_addr2 mov dpl, r6 mov dph, r7 mov r6_3, #0x00 ; SP for compiler mov r7_3, #0xff ; SP for compiler clr a jmp @a+dptr C7: cjne a, #'G', C9 ajmp C8 C9: cjne a, #'?', C11 C10: mov dptr, #HELP1 acall DisplayC mov dptr, #HELP2 acall DisplayC mov dptr, #HELP3 acall DisplayC mov dptr, #HELP4 acall DisplayC mov dptr, #HELP5 acall DisplayC mov dptr, #HELP6 acall DisplayC mov dptr, #HELP7 acall DisplayC mov dptr, #HELP8 acall DisplayC mov dptr, #HELP9 acall DisplayC mov dptr, #HELP10 acall DisplayC mov dptr, #HELP11 acall DisplayC mov dptr, #HELP12 ajmp DisplayC C11:cjne a, #'h', C12 ajmp C10 C12:cjne a, #'H', C13 ajmp C10 C13: CX0:cjne a, #'i', CX1 CX2: inc r1 mov a, @r1 cjne a, #0, CX7 ajmp fail_addrx CX7: cjne a, #'l', CX4 ajmp do_disli CX4: cjne a, #'L', CX5 ajmp do_disli CX5: dec r1 acall get_addr jc fail_addrx2 mov r0, #old_addr+2 mov @r0, #2 do_dis: lcall decode CX8: mov r0, #old_addr mov a, r6 mov @r0, a inc r0 mov a, r7 mov @r0, a ret do_disli: acall get_addr jc fail_addrx2 mov r0, #old_addr+2 mov @r0, #3 do_disl: mov r2_1, #15 CX6: lcall decode djnz r2_1, CX6 ajmp CX8 CX1: cjne a, #'I', CG3 ajmp CX2 CG3: cjne a, #'T', CG4 ljmp START_BASIC CG4: cjne a, #'t', CG5 ljmp START_BASIC CG5: cjne a, #'F', CG6 ljmp EFORTH_START CG6: cjne a, #'f', fail ljmp EFORTH_START fail_addrx2: ajmp fail_addr xgetc: fail: mov dptr, #ERR1 ajmp DisplayC DisplayC: dc: clr a movc a, @a+dptr jz disp_done inc dptr mov r6, dpl mov r7, dph acall send mov dpl, r6 mov dph, r7 ajmp dc disp_done: mov a, #NL acall send mov a, #LF ajmp send get_addr: mov r6, #0 mov r7, #0 gnxt1: inc r1 mov a, @r1 cjne a, #' ', G1 ajmp gnxt1 G1: cjne a, #8, G2 ajmp gnxt1 G2: cjne a, #0, G3 G30: setb c mov r6, a ret G3: cjne a, #'9'+1, G7 G7: jc G4 cjne a, #'A', G8 G8: jc G6 cjne a, #'F'+1, G11 G11: jnc G12 clr c subb a, #'A' add a, #10 ajmp G5 G12: cjne a, #'a', G13 G13: jc G6 cjne a, #'f'+1, G14 G14: jnc G6 clr c subb a, #'a' add a, #10 ajmp G5 G4: cjne a, #'0', G10 G10:jc G6 clr c subb a, #'0' G5: mov r2, a ; save the new nibble mov a, r7 ; shift nibble 2 to nibble 3, discard old nibble 3 swap a anl a, #0xf0 mov r7, a mov a, r6 ; shift nibble 1 to nibble 2 swap a anl a, #0x0f orl a, r7 mov r7, a mov a, r6 ; shift nibble 0 to nibble 1 swap a anl a, #0xf0 orl a, r2 ; insert nibble 0 mov r6, a inc r1 mov a, @r1 ajmp G3 G6: cjne a, #0, G20 G21: dec dpl mov a, dpl cjne a, #0xff, G23 dec dph G23:clr c ; return success ret G20:cjne a, #' ', G22 ajmp G21 G22:cjne a, #8, G30 ajmp G21 disp_byte: push acc swap a acall disp_b pop acc disp_b: anl a, #0x0f cjne a, #0xa, DB1 DB1:jc DB2 add a, #('A'-'0')-0xa DB2:add a, #'0' ajmp send disp_char: cjne a, #' ', DB3 DB3:jc DB4 cjne a, #0x7f, DB5 DB5:jc DB6 DB4:mov a, #'.' DB6:ajmp send i_hex: acall get_hex_byte ; read length jc hexbad mov r5, a mov r3, a acall get_hex_byte ; read 1st address byte jc hexbad mov r7, a add a, r3 mov r3, a acall get_hex_byte ; read 2nd address byte jc hexbad mov r6, a add a, r3 mov r3, a acall get_hex_byte ; read flag byte jc hexbad jz loop add a, r3 mov r3, a acall get_hex_byte ; read sum byte jc hexbad add a, r3 jnz hexbad acall get_char cjne a, #NL, el3 el4: mov dptr, #DO_NL ajmp DisplayC el3: cjne a, #LF, hexbad ajmp el4 loop: mov a, r5 jz end_loop acall get_hex_byte ; read sum byte jc hexbad mov dpl, r6 mov dph, r7 movx @dptr, a add a, r3 mov r3, a inc dptr dec r5 mov r6, dpl mov r7, dph ajmp loop end_loop: acall get_hex_byte ; read sum byte jc hexbad add a, r3 jnz hexbad el6: acall get_char cjne a, #NL, el1 ajmp el6 el1: cjne a, #LF, el2 ajmp el6 el2: cjne a, #':', hexbad ajmp i_hex hexbad: mov dptr, #ERR4 ajmp DisplayC get_hex_byte: acall get_hex jc gbad swap a anl a, #0xf0 mov r2, a acall get_hex jc gbad orl a, r2 gbad:ret get_char: acall poll jz get_char ret get_hex: acall poll jz get_hex cjne a, #'0', Z1 Z1: jc Zbad cjne a, #'9'+1, Z2 Z2: jc Z3 cjne a, #'A', Z4 Z4: jc Zbad cjne a, #'F'+1, Z5 Z5: jnc Z6 Z9: add a, #9 Z3: anl a, #0xf clr c ret Z6: cjne a, #'a', Z7 Z7: jc Zbad cjne a, #'f'+1, Z8 Z8: jc Z9 Zbad:setb c ret ex0_handler: clr ex0 reti tab5: word t_p0, t_sp, t_dpl, t_dph, 0, 0, 0, t_pcon word t_tcon, t_tmod, t_tl0, t_tl1, t_th0, t_th1, t_auxr, 0 word t_p1, 0, 0, 0, 0, 0, 0, t_acon word t_scon, t_sbuf, 0, 0, 0, 0, 0, t_c1mod word t_p2, 0, 0, 0, 0, 0, 0, 0 word t_ie, t_saddr,0, 0, 0, 0, 0, t_cl1 word t_p3, 0, 0, 0, 0, 0, 0, 0 word t_ip, t_saden,0, 0, 0, 0, 0, t_ch1 word 0, 0, 0, 0, 0, 0, t_exicon,t_acmp word t_t2con,t_t2mod,t_rcap2l,t_rcap2h,t_tl2,t_th2, 0, 0 word t_psw, 0, 0, 0, 0, 0, 0, 0 word t_ccon, t_cmod, 0, 0, 0, 0, 0, 0 word t_acc, 0, 0, 0, 0, 0, 0, 0 word 0, t_cl, 0, 0, 0, 0, 0, 0 word t_b, 0, 0, 0, 0, 0, 0, 0 word 0, t_ch, 0, 0, 0, 0, 0, 0 tab6: word 0, 0, 0, 0, 0, 0, 0, 0 word t_it0, t_ie0, t_it1, t_ie1, t_tr0, t_tf0, t_tr1, t_tf1 word 0, 0, 0, 0, 0, 0, 0, 0 word t_ri, t_ti, t_rb8, t_tb8, t_ren, t_sm2, t_sm1, t_sm0_fe word 0, 0, 0, 0, 0, 0, 0, 0 word t_ex0, t_et0, t_ex1, t_et1, t_es, t_et2, t_ec, t_ez word 0, 0, 0, 0, 0, 0, 0, 0 word t_px0, t_pt0, t_px1, t_pt1, t_ps, t_pt2, t_pc, 0 word 0, 0, 0, 0, 0, 0, 0, 0 word t_cp_rl2,t_c_t2,t_tr2, t_exen2,t_tclk, t_rclk, t_exf2, t_tf2 word t_p, 0, t_ov, t_rs0, t_rs1, t_f0, t_ac, t_cy word 0, 0, 0, 0, 0, 0, 0, 0 word 0, 0, 0, 0, 0, 0, 0, 0 word 0, 0, 0, 0, 0, t_cre, t_cr1, t_cf1 word 0, 0, 0, 0, 0, 0, 0, 0 word 0, 0, 0, 0, 0, 0, 0, 0 t_it0: byte "IT0" t_ie0: byte "IE0" t_it1: byte "IT1" t_ie1: byte "IE1" t_tr0: byte "TR0" t_tf0: byte "TF0" t_tr1: byte "TR1" t_tf1: byte "TF1" t_ri: byte "RI" t_ti: byte "TI" t_rb8: byte "RB8" t_tb8: byte "TB8" t_ren: byte "REN" t_sm2: byte "SM2" t_sm1: byte "SM1" t_sm0_fe: byte "SM0/FE" t_ex0: byte "EX0" t_et0: byte "ET0" t_ex1: byte "EX1" t_et1: byte "ET1" t_es: byte "ES" t_et2: byte "ET2" t_ec: byte "EC" t_ez: byte "EZ" t_px0: byte "PX0" t_pt0: byte "PT0" t_px1: byte "PX1" t_pt1: byte "PT1" t_ps: byte "PS" t_pt2: byte "PT2" t_pc: byte "PC" t_cp_rl2: byte "CP/RL2" t_c_t2: byte "C/T2" t_tr2: byte "TR2" t_exen2: byte "EXEN2" t_tclk: byte "TCLK" t_rclk: byte "RCLK" t_exf2: byte "EXF2" t_tf2: byte "TF2" t_p: byte "P" t_ov: byte "OV" t_rs0: byte "RS0" t_rs1: byte "RS1" t_f0: byte "F0" t_ac: byte "AC" t_cy: byte "CY" t_cre: byte "CRE" t_cr1: byte "CR1" t_cf1: byte "CF1" t_p0: byte "P0" t_sp: byte "SP" t_dpl: byte "DPL" t_dph: byte "DPH" t_pcon: byte "PCON" t_tcon: byte "TCON" t_tmod: byte "TMOD" t_tl0: byte "TL0" t_tl1: byte "TL1" t_th0: byte "TH0" t_th1: byte "TH1" t_auxr: byte "AUXR" t_p1: byte "P1" t_acon: byte "ACON" t_scon: byte "SCON" t_sbuf: byte "SBUF" t_c1mod: byte "C1MOD" t_p2: byte "P2" t_ie: byte "IE" t_saddr: byte "SADDR" t_cl1: byte "CL1" t_p3: byte "P3" t_ip: byte "IP" t_saden: byte "SADEN" t_ch1: byte "CH1" t_exicon: byte "EXICON" t_acmp: byte "ACMP" t_t2con: byte "T2CON" t_t2mod: byte "T2MOD" t_rcap2l: byte "RCAP2L" t_rcap2h: byte "RCAP2H" t_tl2: byte "TL2" t_th2: byte "TH2" t_psw: byte "PSW" t_ccon: byte "CCON" t_cmod: byte "CMOD" t_acc: byte "ACC" t_cl: byte "CL" t_b: byte "B" t_ch: byte "CH" t_dptr: byte "dptr" t_acall: byte "acall " t_add: byte "add " t_addc: byte "addc " t_ajmp: byte "ajmp " t_anl: byte "anl " t_cjne: byte "cjne " t_clr: byte "clr " t_cpl: byte "cpl " t_da: byte "da " t_dec: byte "dec " t_mul_ab: byte "mul ab" t_div_ab: byte "div ab" t_djnz: byte "djnz " t_invalid: byte "invalid" t_inc: byte "inc " t_jb: byte "jb " t_jbc: byte "jbc " t_jc: byte "jc " t_jmp: byte "jmp " t_jnb: byte "jnb " t_jnc: byte "jnc " t_jnz: byte "jnz " t_jz: byte "jz " t_lcall: byte "lcall " t_ljmp: byte "ljmp " t_mov: byte "mov " t_nop: byte "nop" t_orl: byte "orl " t_pop: byte "pop " t_push: byte "push " t_ret: byte "ret" t_reti: byte "reti" t_rl: byte "rl " t_rlc: byte "rlc " t_rr: byte "rr " t_rrc: byte "rrc " t_setb: byte "setb " t_sjmp: byte "sjmp " t_subb: byte "subb " t_swap: byte "swap " t_xch: byte "xch " t_xrl: byte "xrl " tab1: word t_inc word t_dec word t_add word t_addc word t_orl word t_anl word t_xrl word t_mov word t_mov word t_subb word t_mov word t_cjne word t_xch word t_djnz word t_mov word t_mov ; ; 0: 'op' indexed by top nibble ; 1: ajmp ; 2: ljmp ; 3: 'op a' indexed by top nibble ; 4: 'op a' indexed by top nibble (same op as 5) ; 5: 'op a, ??' indexed by top nibble ; 6: 'j? bit, addr' indexed by top nibble ; 7: acall ; 8: lcall ; 9: 'j? addr' indexed by top nibble ; 10: 'op data, a' indexed by top nibble ; 11: 'op data, #data' indexed by top nibble ; 12: 'op c, addr' indexed by top nibble ; 13: 'jmp @a+dptr' ; 14: 'mov ??, #data' ; 15: 'mov data, ??' ; 16: 'movc a,@a+pc' ; 17: 'mov a, #data' ; 18: 'mov dptr, #data' ; 19: 'mov addr, c' ; 20: 'movc a,@a+dptr' ; 21: 'op c,/bitaddr' ; 22: 'inc dptr' ; 23: 'mov ??, data' ; 24: 'op bitaddr' ; 25: 'op c' ; 26: 'cjne ??, #data, addr' ; 27: 'cjne a, data, addr' ; 28: 'push/pop data' ; 29: 'djnz ??, addr' ; 30: 'xchd @??' ; 31: 'movx a,@a+dptr' ; 32: 'movx a,@r?' ; 33: 'movx @a+dptr,a' ; 34: 'movx @r?,a' ; 35: 'mov ??, a' ; 36: 'op ??' indexed by top nibble ; 37: 'cjne a, #data, addr' ; 38: 'mov data, data' ; tab0: byte 0, 1, 2, 3, 4, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36 byte 6, 7, 8, 3, 4, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36 byte 6, 1, 0, 3, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 byte 6, 7, 0, 3, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 byte 9, 1, 10, 11, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 byte 9, 7, 10, 11, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 byte 9, 1, 10, 11, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 byte 9, 7, 12, 13, 17, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14 byte 9, 1, 12, 16, 0, 38, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15 byte 18, 7, 19, 20, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 byte 21, 1, 12, 22, 0, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23 byte 21, 7, 24, 25, 37, 26, 27, 26, 26, 26, 26, 26, 26, 26, 26, 26 byte 28, 1, 24, 25, 3, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 byte 28, 7, 24, 25, 3, 29, 30, 30, 29, 29, 29, 29, 29, 29, 29, 29 byte 31, 1, 32, 32, 3, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 byte 33, 7, 34, 34, 3, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35 tab2: word t_rr, t_rrc, t_rl, t_rlc word 0, 0, 0, 0 word 0, 0, 0, 0 word t_swap, t_da, t_clr, t_cpl RESET_MSG: byte NL, LF, "Monitor V2.00 'Plugh' Copyright Taniwha Systems 1991-1995" HELP1: byte "Commands: DC - display program memory" HELP2: byte " DM - display external memory" HELP3: byte " DR - display internal memory" HELP4: byte " SM - set external memory" HELP5: byte " SR - set internal memory" HELP6: byte " G - call subroutine at address" HELP7: byte " I - disassemble code at address" HELP8: byte " IL - disassemble page of code at address" HELP9: byte " R - display selected registers" HELP10: byte " : - load an Intel Hex record" HELP11: byte " T - Enter Tiny Basic" HELP12: byte " F - Enter EForth" ERR1: byte "?Unknown command" ERR2: byte "?Bad address" ERR3: byte "?Bad data" ERR4: byte NL, LF, "?Bad download" DO_NL: byte 0 do_DisplayC: acall Display mov a, #NL acall Send mov a, #LF ajmp Send Display: clr a movc a, @a+dptr inc dptr cjne a, #0, DD0 ret DD0: acall Send ajmp Display Send: mov r1, a mov a, dpl mov r0_1, a mov a, dph mov r1_1, a mov r0, #send_vector mov a, @r0 inc r0 mov dpl, a mov a, @r0 mov dph, a clr a acall s2 mov a, r0_1 mov dpl, a mov a, r1_1 mov dph, a ret s2: jmp @a+dptr X18_0: byte "mov dptr, #" X5_0: byte "a, " X13_0: byte "jmp @a+dptr" X16_0: byte "movc a, @a+pc" X17_0: byte "mov a, " X20_0: byte "movc a, @a+dptr" X21_0: byte "c, /" X22_0: byte "inc dptr" X30_0: byte "xchd a, @r" X31_0: byte "movx a, @a+dptr" X32_0: byte "movx a, @r" X33_0: byte "movx @a+dptr, a" X34_0: byte "movx @r" decode: mov r3_0, r6 mov r4_0, r7 lcall put16 mov a, #':' acall Send mov a, #' ' acall Send lcall get_next mov r5, a mov dptr, #tab0 ; get type movc a, @a+dptr rl a mov b, a mov dptr, #jump_tab movc a, @a+dptr xch a, b inc dptr movc a, @a+dptr mov dpl, b mov dph, a clr a jmp @a+dptr .even jump_tab: dw X0 dw X1 dw X2 dw X3 dw X4 dw X5 dw X6 dw X7 dw X8 dw X9 dw X10 dw X11 dw X12 dw X13 dw X14 dw X15 dw X16 dw X17 dw X18 dw X19 dw X20 dw X21 dw X22 dw X23 dw X24 dw X25 dw X26 dw X27 dw X28 dw X29 dw X30 dw X31 dw X32 dw X33 dw X34 dw X35 dw X36 dw X37 dw X38 ; 0: 'op' indexed by top nibble X0: mov a, r5 cjne a, #0x00, X0_0 mov dptr, #t_nop ajmp do_DisplayC X0_0: cjne a, #0x22, X0_1 mov dptr, #t_ret ajmp do_DisplayC X0_1: cjne a, #0x32, X0_2 mov dptr, #t_reti ajmp do_DisplayC X0_2: cjne a, #0xa4, X0_3 mov dptr, #t_mul_ab ajmp do_DisplayC X0_3: cjne a, #0xa5, X0_4 mov dptr, #t_invalid ajmp do_DisplayC X0_4: mov dptr, #t_div_ab ajmp do_DisplayC ; ; 1: ajmp ; X1: mov dptr, #t_ajmp X1_0: acall Display mov a, r5 swap a rr a anl a, #0x07 mov r5, a lcall get_next mov r3, a mov a, r7 anl a, #0xf8 orl a, r5 mov r4, a lcall put16 idone: mov dptr, #DO_NL ajmp do_DisplayC ; ; 2: ljmp ; X2: mov dptr, #t_ljmp X2_0: acall Display lcall get_next mov r4, a lcall get_next mov r3, a lcall put16 ajmp idone ; ; 3: 'op a' indexed by top nibble ; X3: mov dptr, #tab2 X3_1: mov a, r5 swap a anl a, #0x0f rl a mov r0, a movc a, @a+dptr mov r1, a mov a, r0 add a, #1 movc a, @a+dptr mov dph, a mov dpl, r1 acall Display mov a, #'a' acall Send ajmp idone ; ; 4: 'op a' indexed by top nibble (same op as 5) ; X4: mov dptr, #tab1 ajmp X3_1 ; ; 5: 'op a, ??' indexed by top nibble ; X5: mov dptr, #tab1 mov a, r5 swap a anl a, #0x0f rl a mov r0, a movc a, @a+dptr mov r1, a mov a, r0 inc a movc a, @a+dptr mov dph, a mov dpl, r1 acall Display mov dptr, #X5_0 acall Display lcall operand ajmp idone ; ; 6: 'j? bit, addr' indexed by top nibble ; X6: cjne r5, #0x10, X6_0 mov dptr, #t_jbc ajmp X6_1 X6_0: cjne r5, #0x20, X6_2 mov dptr, #t_jb ajmp X6_1 X6_2: mov dptr, #t_jnb X6_1: acall Display lcall directb lcall comma lcall put_rel ajmp idone ; ; 7: acall ; X7: mov dptr, #t_acall ajmp X1_0 ; ; 8: lcall ; X8: mov dptr, #t_lcall ajmp X2_0 ; ; 9: 'j? addr' indexed by top nibble ; X9: cjne r5, #0x40, X9_0 mov dptr, #t_jc ajmp X9_1 X9_0: cjne r5, #0x50, X9_2 mov dptr, #t_jnc ajmp X9_1 X9_2: cjne r5, #0x60, X9_3 mov dptr, #t_jz ajmp X9_1 X9_3: cjne r5, #0x70, X9_4 mov dptr, #t_jnz ajmp X9_1 X9_4: mov dptr, #t_sjmp X9_1: acall Display lcall put_rel ajmp idone ; ; 10: 'op data, a' indexed by top nibble ; X10: mov r2, #0 X10_0: mov a, r5 anl a, #0xfe cjne a, #0x52, X10_5 mov dptr, #t_anl ajmp X10_1 X10_5: cjne a, #0x42, X10_2 mov dptr, #t_orl ajmp X10_1 X10_2: mov dptr, #t_xrl X10_1: acall Display lcall direct lcall comma cjne r2, #0, X10_3 mov a, #'a' acall Send ajmp idone X10_3: lcall immed ljmp idone ; ; 11: 'op data, #data' indexed by top nibble ; X11: mov r2, #1 ljmp X10_0 ; ; 12: 'op c, addr' indexed by top nibble ; X12: cjne r5, #0x82, X12_5 mov dptr, #t_anl ajmp X12_1 X12_5: cjne r5, #0x72, X12_4 mov dptr, #t_orl ajmp X12_1 X12_4: mov dptr, #t_mov X12_1: lcall Display mov a, #'c' lcall Send acall comma acall directb ljmp idone ; ; 13: 'jmp @a+dptr' ; X13: mov dptr, #X13_0 ljmp do_DisplayC ; ; 14: 'mov ??, #data' ; X14: mov dptr, #t_mov lcall Display acall operand acall comma acall immed ljmp idone ; ; 15: 'mov data, ??' ; X15: mov dptr, #t_mov lcall Display acall direct acall comma acall operand ljmp idone ; ; 16: 'movc a,@a+pc' ; X16: mov dptr, #X16_0 ljmp do_DisplayC ; ; 17: 'mov a,#data' ; X17: mov dptr, #X17_0 lcall Display acall immed ljmp idone ; ; 18: 'mov dptr, #data' ; X18: mov dptr, #X18_0 lcall Display acall get_next mov r4, a acall get_next mov r3, a acall put16 ljmp idone ; ; 19: 'mov addr, c' ; X19: mov dptr, #t_mov lcall Display acall directb acall comma mov a, #'c' lcall Send ljmp idone ; ; 20: 'movc a,@a+dptr' ; X20: mov dptr, #X20_0 ljmp do_DisplayC ; ; 21: 'op c,/bitaddr' ; X21: cjne r5, #0xa0, X21_2 mov dptr, #t_orl ajmp X21_1 X21_2: mov dptr, #t_anl X21_1: lcall Display mov dptr, #X21_0 lcall Display acall directb ljmp idone ; ; 22: 'inc dptr' ; X22: mov dptr, #X22_0 ljmp do_DisplayC ; ; 23: 'mov ??, data' ; X23 mov dptr, #t_mov lcall Display acall operand acall comma acall direct ljmp idone ; ; 24: 'op bitaddr' ; X24: mov r2, #0 x24_9: mov a, r5 anl a, #0xfe cjne a, #0xc2, X24_5 mov dptr, #t_clr ajmp X24_1 X24_5: cjne a, #0xd2, X24_2 mov dptr, #t_setb ajmp X24_1 X24_2: mov dptr, #t_cpl X24_1: lcall Display cjne r2, #1, X24_3 mov a, #'c' lcall Send ljmp idone X24_3: acall directb ljmp idone ; ; 25: 'op c' ; X25: mov r2, #1 ajmp x24_9 ; ; 26: 'cjne ??, #data, addr' ; X26: mov dptr, #t_cjne lcall Display acall operand acall comma acall immed acall comma acall put_rel ljmp idone ; ; 27: 'cjne a, data, addr' ; X27: mov dptr, #t_cjne lcall Display mov a, #'a' lcall Send acall comma acall direct acall comma acall put_rel ljmp idone ; ; 28: 'push/pop data' ; X28: cjne r5, #0xc0, X28_2 mov dptr, #t_push ajmp X28_1 X28_2: mov dptr, #t_pop X28_1: lcall Display acall direct ljmp idone ; ; 29: 'djnz ??, addr' ; X29: mov dptr, #t_djnz lcall Display acall operand acall comma acall put_rel ljmp idone ; ; 30: 'xchd @??' ; X30: mov dptr, #X30_0 X30_1: lcall Display mov a, r5 anl a, #1 add a, #'0' lcall Send ljmp idone ; ; 31: 'movx a,@a+dptr' ; X31: mov dptr, #X31_0 ljmp do_DisplayC ; ; 32: 'movx a,@r?' ; X32: mov dptr, #X32_0 ajmp X30_1 ; ; 33: 'movx @a+dptr,a' ; X33: mov dptr, #X33_0 ljmp do_DisplayC ; ; 34: 'movx @r?,a' ; X34: mov dptr, #X34_0 lcall Display mov a, r5 anl a, #1 add a, #'0' lcall Send acall comma mov a, #'a' lcall Send ljmp idone ; ; 35: 'mov ??, a' ; X35: mov dptr, #t_mov lcall Display acall operand acall comma mov a, #'a' lcall Send ljmp idone ; ; 36: 'op ??' indexed by top nibble ; X36: mov dptr, #tab1 mov a, r5 swap a anl a, #0x0f rl a mov r0, a movc a, @a+dptr mov r1, a mov a, r0 inc a movc a, @a+dptr mov dph, a mov dpl, r1 lcall Display acall operand ljmp idone ; ; 37: 'cjne a, #data, addr' ; X37: mov dptr, #t_cjne lcall Display mov a, #'a' lcall Send acall comma acall immed acall comma acall put_rel ljmp idone ; ; 38: 'mov data, data' ; X38: mov dptr, #t_mov lcall Display acall get_next push acc acall direct acall comma pop acc acall direct2 ljmp idone operand: mov a, r5 anl a, #0x0f cjne a, #4, op1 op3: mov a, #'#' lcall Send acall get_next ajmp put8 op1: cjne a, #5, op2 ajmp direct op2: cjne a, #6, op4 mov r5, #0 op5: mov a, #'@' lcall Send op7: mov a, #'r' lcall Send mov a, r5 add a, #'0' ljmp Send op4: cjne a, #7, op6 mov r5, #1 ajmp op5 op6: anl a, #0x07 mov r5, a ajmp op7 get_next: clr a mov dpl, r6 mov dph, r7 movc a, @a+dptr inc dptr mov r6, dpl mov r7, dph ret put16: mov a, r4 acall put8 mov a, r3 put8: mov r0, a push r0_0 swap a acall xhex pop r0_0 mov a, r0 xhex: anl a, #0x0f cjne a, #10, xh2 xh2: jnc xh1 add a, #'0' ljmp Send xh1: add a, #'A'-10 ljmp Send comma: mov a, #',' lcall Send mov a, #' ' ljmp Send immed: mov a, #'#' lcall Send acall get_next ajmp put8 direct: acall get_next direct2: mov r0, a rlc a jnc dok anl a, #0xfe dname: mov dptr, #tab5 mov r1, a movc a, @a+dptr mov r3, a mov a, r1 inc a movc a, @a+dptr mov r4, a cjne r3, #0, dcont cjne r4, #0, dcont ajmp dfail dcont: mov dpl, r3 mov dph, r4 ljmp Display dok: dfail: mov a, r0 ajmp put8 directb: acall get_next mov r0, a rlc a jnc dok push r0_0 anl a, #0xf0 acall dname mov a, #'.' lcall Send pop r0_0 mov a, r0 rl a anl a, #0xfe mov dptr, #tab6 mov r1, a movc a, @a+dptr mov r3, a mov a, r1 inc a movc a, @a+dptr mov r4, a cjne r3, #0, dcont2 cjne r4, #0, dcont2 ajmp dc1 dcont2: mov dpl, r3 mov dph, r4 ljmp Display dc1: mov a, r0 anl a, #7 add a, #'0' ljmp Send put_rel: acall get_next mov r5, a add a, r6 mov r3, a mov a, r5 rlc a jc prl2 rrc a clr a ajmp prl1 prl2: rrc a mov a, #0xff prl1: addc a, r7 mov r4, a ajmp put16 rdisp: lcall Display mov a, #':' lcall Send mov a, #' ' lcall Send mov a, r7 acall put8 mov a, #' ' ljmp Send registers: mov dptr, #DO_NL lcall do_DisplayC ; ; ; ; mov dptr, #t_p0 ; mov r7, p0 ; lcall rdisp mov dptr, #t_sp mov r7, sp acall rdisp mov dptr, #t_b mov r7, b acall rdisp mov dptr, #t_dptr lcall Display mov a, #':' lcall Send mov a, #' ' lcall Send mov r3, dpl mov r4, dph acall put16 mov dptr, #DO_NL lcall do_DisplayC mov dptr, #t_p1 mov r7, p1 acall rdisp mov dptr, #t_psw mov r7, psw acall rdisp mov dptr, #t_scon mov r7, scon acall rdisp mov dptr, #t_sbuf mov r7, sbuf acall rdisp mov dptr, #DO_NL lcall do_DisplayC mov dptr, #t_p2 mov r7, p2 acall rdisp mov dptr, #t_tcon mov r7, tcon acall rdisp mov dptr, #t_tmod mov r7, tmod acall rdisp ; mov dptr, #t_sepcon ; mov r7, sepcon ; lcall rdisp mov dptr, #DO_NL lcall do_DisplayC mov dptr, #t_p3 mov r7, p3 acall rdisp mov dptr, #t_t2con mov r7, t2con acall rdisp mov dptr, #t_t2mod mov r7, t2mod acall rdisp ; mov dptr, #t_sepsta ; mov r7, sepsta ; lcall rdisp mov dptr, #DO_NL lcall do_DisplayC ; mov dptr, #t_p4 ; mov r7, p4 ; lcall rdisp mov dptr, #t_ip mov r7, ip acall rdisp mov dptr, #t_ie mov r7, ie acall rdisp ; mov dptr, #t_iea ; mov r7, iea ; lcall rdisp mov dptr, #DO_NL lcall do_DisplayC ; mov dptr, #t_p5 ; mov r7, p5 ; lcall rdisp ; mov dptr, #t_ipa ; mov r7, ipa ; lcall rdisp ; mov dptr, #t_ipa1 ; mov r7, ipa1 ; lcall rdisp ; mov dptr, #t_ipl ; mov r7, ipl ; lcall rdisp mov dptr, #DO_NL lcall do_DisplayC mov dptr, #t_pcon mov r7, pcon acall rdisp ; mov dptr, #t_exicon ; mov r7, exicon ; lcall rdisp ; mov dptr, #t_acon ; mov r7, acon ; lcall rdisp ; mov dptr, #t_acmp ; mov r7, acmp ; lcall rdisp mov dptr, #DO_NL lcall do_DisplayC ; mov dptr, #t_adres0 ; mov r7, adres0 ; lcall rdisp ; mov dptr, #t_adres1 ; mov r7, adres1 ; lcall rdisp ; mov dptr, #t_adres2 ; mov r7, adres2 ; lcall rdisp ; mov dptr, #t_adres3 ; mov r7, adres3 ; lcall rdisp ; mov dptr, #DO_NL ; lcall do_DisplayC ; mov dptr, #t_adres4 ; mov r7, adres4 ; lcall rdisp ; mov dptr, #t_adres5 ; mov r7, adres5 ; lcall rdisp ; mov dptr, #t_adres6 ; mov r7, adres6 ; lcall rdisp ; mov dptr, #t_adres7 ; mov r7, adres7 ; lcall rdisp ; mov dptr, #DO_NL ; lcall do_DisplayC ; mov dptr, #t_ccon ; mov r7, ccon ; lcall rdisp ; mov dptr, #t_cmod ; mov r7, cmod ; lcall rdisp ; mov dptr, #t_c1con ; mov r7, c1con ; lcall rdisp ; mov dptr, #t_c1mod ; mov r7, c1mod ; lcall rdisp ; mov dptr, #DO_NL ; lcall do_DisplayC mov dptr, #DO_NL ljmp do_DisplayC ;; ;; Next - Intel's Basic ;; ; December 18, 1986 ; MS-DOS compatible Source code for MCS BASIC-52 (tm) ; Assembles with ASM51 Macro Assembler Version 2.2 ; ; The following source code does not include the floating point math ; routines. These are seperately compiled using FP52.SRC. ; ; Both the BASIC.SRC and FP52.SRC programs assemble into ABSOLUTE ; object files, and do not need to be relocated or linked. The FP52 ; object code and the BASIC object code, when compiled without modification ; of the source listings, create the same object code that is found on ; the MCS BASIC-52 Version 1.1 microcontrollers. ; ; The original source code had 7 "include" files that have been incorporated ; into this file for ease of assembly. ; These 7 files are: LOOK52.SRC, BAS52.RST, BAS52.PGM, BAS52.TL, BAS52.OUT, ; BAS52.PWM, and BAS52.CLK. ; ; ; Intel Corporation, Embedded Controller Operations ;$EJECT ;; ;; NOTE: in this environment (embedded in the flight computer) ;; this stuff doesn't exist .... all references to it ;; have been commented out ;; ;************************************************************** ; ; TRAP VECTORS TO MONITOR ; ; RESET TAG (0AAH) ---------2001H ; ; TAG LOCATION (5AH) ------ 2002H ; ; EXTERNAL INTERRUPT 0 ---- 2040H ; ; COMMAND MODE ENTRY ------ 2048H ; ; SERIAL PORT ------------- 2050H ; ; MONITOR (BUBBLE) OUTPUT - 2058H ; ; MONITOR (BUBBLE) INPUT -- 2060H ; ; MONITOR (BUBBLE) CSTS --- 2068H ; ; GET USER JUMP VECTOR ---- 2070H ; ; GET USER LOOKUP VECTOR -- 2078H ; ; PRINT AT VECTOR --------- 2080H ; ; INTERRUPT PWM ----------- 2088H ; ; EXTERNAL RESET ---------- 2090H ; ; USER OUTPUT-------------- 4030H ; ; USER INPUT -------------- 4033H ; ; USER CSTS --------------- 4036H ; ; USER RESET -------------- 4039H ; ; USER DEFINED PRINT @ --- 403CH ; ;*************************************************************** ; ;$INCLUDE(:F2:LOOK52.SRC) ; INCLUDED BELOW ; ;************************************************************** ; ; This is the equate table for 8052 basic. ; ;************************************************************** ; ; The register to direct equates for cjne instructions. ; R0B0 = 0 R1B0 = 1 R2B0 = 2 R3B0 = 3 R4B0 = 4 R5B0 = 5 R6B0 = 6 R7B0 = 7 ; ; Register bank 1 contains the text pointer ; and the arg stack pointer. ; TXAL = 8 ;r0 BANK 1 = TEXT POINTER LOW ASTKA = 9 ;r1 BANK 1 = ARG STACK TXAH = 10 ;r2 BANK 1 = TEXT POINTER HIGH ; ; Now five temporary locations that are used by basic. ; TEMP1 = 11 TEMP2 = 12 TEMP3 = 13 TEMP4 = 14 TEMP5 = 15 ; ;$EJECT ; Register bank 2 contains the read text pointer ; and the control stack pointer. ; RTXAL = 16 ;r0 BANK 2 = READ TEXT POINTER LOW CSTKA = 17 ;r1 BANK 2 = CONTROL STACK POINTER RTXAH = 18 ;r2 BANK 2 = READ TEXT POINTER HIGH ; ; Now some internal system equates. ; BOFAH = 19 ;START OF THE BASIC PROGRAM, HIGH BYTE BOFAL = 20 ;START OF THE BASIC PROGRAM, LOW BYTE NULLCT = 21 ;NULL COUNT PHEAD = 22 ;PRINT HEAD POSITION FORMAT = 23 ; ; Register bank 3 is for the user and can be loaded ; by basic ; ; ; ; Now everything else is used by basic. ; First the bit locations, these use bytes 34, 35, 36, 37 and 38 ; ;$EJECT OTS = 34.0 ;34.0-ON TIME INSTRUCTION EXECUTED INPROG = 34.1 ;34.1-INTERRUPT IN PROCESS INTBIT = 34.2 ;34.2-INTERRUPT SET BIT ON_ERR = 34.3 ;34.3-ON ERROR EXECUTED OTI = 34.4 ;34.4-ON TIME INTERRUPT IN PROGRESS LINEB = 34.5 ;34.5-LINE CHANGE OCCURED INTPEN = 34.6 ;34.6-INTERRUPT PENDING BIT CONB = 34.7 ;34.7-CAN CONTINUE IF SET GTRD = 35.0 ;35.0-READ GET LOCATION LPB = 35.1 ;35.1-PRINT TO LINE PRINTER PORT CKS_B = 35.2 ;35.2-FOR PWM INTERRUPT COB = 35.3 ;35.3-CONSOLE OUT BIT ; 0 = SERIAL PORT ; 1 = LINE PRINTER COUB = 35.4 ;35.4-USER CONSOLE OUT BIT ; 0 = SERIAL PORT ; 1 = USER DRIVER INBIT = 35.5 ;35.5-INITIALIZATION BIT CIUB = 35.6 ;35.6-USER CONSOLE IN BIT ; 0 = SERIAL PORT ; 1 = USER ROUTINE SPINT = 35.7 ;35.7-SERIAL PORT INTERRUPT STOPBIT = 36.0 ;36.0-PROGRAM STOP ENCOUNTERED U_IDL = 36.1 ;36.1-USER IDLE BREAK INP_B = 36.2 ;36.2-SET DURING INPUT INSTRUCTION ;DCMPXZ = 36.3 ;36.3-DCMPX ZERO FLAG ARGF = 36.4 ;36.4-ARG STACK HAS a VALUE RETBIT = 36.5 ;36.5-ret FROM INTERRUPT EXECUTED I_T0 = 36.6 ;36.6-TRAP INTERRUPT ZERO TO MON UPB = 36.7 ;36.7-SET WHEN @ IS VALID JKBIT = 37.0 ;37.0-WB TRIGGER ENDBIT = 37.1 ;37.1-GET END OF PROGRAM UBIT = 37.2 ;37.2-FOR DIM STATEMENT ISAV = 37.3 ;37.3-SAVE INTERRUPT STATUS BO = 37.4 ;37.4-BUBBLE OUTPUT XBIT = 37.5 ;37.5-EXTERNAL PROGRAM PRESENT C_BIT = 37.6 ;37.6-SET WHEN CLOCK RUNNING DIRF = 37.7 ;37.7-DIRECT INPUT MODE NO_C = 38.0 ;38.0-NO CONTROL c DRQ = 38.1 ;38.1-DMA ENABLED BI = 38.2 ;38.2-BUBBLE INPUT INTELB = 38.3 ;38.3-INTELLIGENT PROM PROGRAMMING C0ORX1 = 38.4 ;38.4-PRINT FROM ROM OR RAM CNT_S = 38.5 ;38.5-CONTROL S ENCOUNTERED ZSURP = 38.6 ;38.6-ZERO SUPRESS HMODE = 38.7 ;38.7-HEX MODE PRINT LP = P1.7 ;SOFTWARE LINE PRINTER DACK = P1.6 ;DMA ACK PROMV = P1.5 ;TURN ON PROM VOLTAGE PROMP = P1.4 ;PROM PULSE ALED = P1.3 ;ALE DISABLE T_BIT = P1.2 ;I/O TOGGLE BIT ; ;$EJECT ; ; The next location is a bit addressable byte counter ; BABC = 39 ; ; Now floating point and the other temps ; ; FP Uses to locations 03CH ; ; Now the stack designators. ; SPSAV = 0x3e S_LEN = 0x3f T_HH = 0x40 T_LL = 0x41 INTXAH = 0x42 INTXAL = 0x43 MT1 = 0x45 MT2 = 0x46 MILLIV = 0x47 ;TIMER LOCATIONS TVH = 0x48 TVL = 0x49 SAVE_T = 0x4a SP_H = 0x4b ;SERIAL PORT TIME OUT SP_L = 0x4C CMNDSP = 0x4D ;SYSTEM STACK POINTER IRAMTOP = 0xff ;TOP OF RAM STACKTP = 0xfe ;ARG AND CONTROL STACK TOPS ; ; The character equates ; SCR = 0x0d ;CARRIAGE RETURN LF = 0x0a ;LINE FEED BELL = 0x07 ;BELL CHARACTER BS = 0x08 ;BACK SPACE CNTRLC = 0x03 ;CONTROL c CNTRLD = 0x04 ;CONTROL D NULL = 0x00 ;NULL ; ;$EJECT ; ; The internal system equates ; LINLEN = 73 ;THE LENGTH OF AN INPUT LINE EOF = 01 ;END OF FILE CHARACTER ASTKAH = 0x81 ;ASTKA IS IN PAGE 1 OF RAM CSTKAH = 0x80 ;CSTKA IS IN PAGE 0 OF RAM FTYPE = 01 ;CONTROL STACK "FOR" GTYPE = 02 ;CONTROL STACK "GOSUB" DTYPE = 03 ;DO-WHILE/UNTIL TYPE ROMADR = 0x8000 ;LOCATION OF ROM RAM_TOP = 0xff00 ; ; The floating point equates ; FPSIZ = 6 ;NO. OF BYTES IN a FLOATING NUM XDIGIT = FPSIZ-2 ;THE MANTISSA OF a FLOATING NUM STESIZ = FPSIZ+3 ;SIZE OF SYMBOL ADJUSTED TABLE ELEMENT ;FP_BASE = 0x1993 ;BASE OF FLOATING POINT ROUTINES PSTART = 0x8200 ;START OF a PROGRAM IN RAM FSIZE = FPSIZ+FPSIZ+2+2+1 ; ;$EJECT ;*************************************************************** ; ; MCS - 51 - 8K BASIC VERSION 1.1 ; ;*************************************************************** ; ; ljmp CRST ;START THE PROGRAM ; ; ORG 3H ; ;*************************************************************** ; ;EXTERNAL INTERRUPT 0 ; ;*************************************************************** ; BINT0: ajmp STQ ; jb DRQ,STQ ;SEE IF DMA IS SET ; push PSW ;SAVE THE STATUS ; ljmp 0x4003 ;JUMP TO USER IF NOT SET ; ; ORG 0BH ; ;*************************************************************** ; ;TIMER 0 OVERFLOW INTERRUPT ; ;*************************************************************** ; BTINT0: push PSW ;SAVE THE STATUS ljmp I_DR ; jb C_BIT,STJ ;SEE IF USER WANTS INTERRUPT ; ljmp 0x400B ;EXIT IF USER WANTS INTERRUPTS ; ; ORG 0x13 ; ;*************************************************************** ; ;EXTERNAL INTERRUPT 1 ; ;*************************************************************** ; BINT1: ajmp STK ; jb INTBIT,STK ; push PSW ; ljmp 0x4013 ; ;$EJECT ; ; ORG 1BH ; ;*************************************************************** ; ;TIMER 1 OVERFLOW INTERRUPT ; ;*************************************************************** ; ; push PSW ; ljmp CKS_I ; ;STJ: ljmp I_DR ;DO THE INTERRUPT ; ;*************************************************************** ; ;SERIAL PORT INTERRUPT ; ;*************************************************************** ; ; ORG 0x23 ; ; push PSW ; jb SPINT,STU ;SEE IF MONITOR EANTS INTERRUPT ; ljmp 0x4023 ; ; ORG 2BH ; ;************************************************************** ; ;TIMER 2 OVERFLOW INTERRUPT ; ;************************************************************** ; ; push PSW ; ljmp 0x402B ; ;$EJECT ;************************************************************** ; ;USER ENTRY ; ;************************************************************** ; ; ORG 30H ; ; ljmp IBLK ;LINK TO USER BLOCK ; STQ: ;jb I_T0,STS ;SEE IF MONITOR WANTS IT clr DACK jnb p3.2, . ;WAIT FOR DMA TO END setb DACK reti ; ;STS: ljmp 0x2040 ;GO TO THE MONITOR ; STK: setb INTPEN ;TELL BASIC AN INTERRUPT WAS RECEIVED reti ; ;STU: ljmp 0x2050 ;SERIAL PORT INTERRUPT ; ;$EJECT ;$EJECT ;************************************************************** ; USENT: ; User entry jump table ; ;************************************************************** ; dx CMND1 ;(00, 0x00)COMMAND MODE JUMP dx IFIX ;(01, 0x01)CONVERT FP TO INT dx PUSHAS ;(02, 0x02)push VALUE ONTO ARG STACK dx POPAS ;(03, 0x03)pop VALUE OFF ARG STACK dx CNULL;PG1 ;(04, 0x04)PROGRAM a PROM dx INLINE ;(05, 0x05)INPUT a LINE dx UPRNT ;(06, 0x06)PRINT a LINR dx CRLF ;(07, 0x07)OUTPUT a CRLF ; ;************************************************************** ; ; This is the operation jump table for arithmetics ; ;************************************************************** ; OPTAB: dx ALPAR ;(08, 0x08)LEFT PAREN dx AEXP ;(09, 09H)EXPONENTAION dx AMUL ;(10, 0x0a)FP mul dx AADD ;(11, 0BH)FLOATING POINT add dx ADIV ;(12, 0CH)FLOATING POINT DIVIDE dx ASUB ;(13, 0DH)FLOATING POINT SUBTRACTION dx Axrl ;(14, 0EH)XOR dx AANL ;(15, 0x0f)AND dx AORL ;(16, 0x10)OR dx ANEG ;(17, 11H)NEGATE dx AEQ ;(18, 0x12)EQUAL dx AGE ;(19, 0x13)GREATER THAN OR EQUAL dx ALE ;(20, 14H)LESS THAN OR EQUAL dx ANE ;(21, 15H)NOT EQUAL dx ALT ;(22, 0x16)LESS THAN dx AGT ;(23, 0x17)GREATER THAN ; ;$EJECT ;*************************************************************** ; ; This is the jump table for unary operators ; ;*************************************************************** ; dx AABS ;(24, 18H)ABSOLUTE VALUE dx AINT ;(25, 0x19)INTEGER OPERATOR dx ASGN ;(26, 1AH)SIGN OPERATOR dx ANOT ;(27, 1BH)ONE"S COMPLEMENT dx ACOS ;(28, 1CH)COSINE dx ATAN ;(29, 1DH)TANGENT dx ASIN ;(30, 1EH)SINE dx ASQR ;(31, 1FH)SQUARE ROOT dx ACBYTE ;(32, 20H)READ CODE dx AETOX ;(33, 0x21)E TO THE X dx AATAN ;(34, 0x22)ARC TANGENT dx ALN ;(35, 0x23)NATURAL LOG dx AP3B ; read p3 bit dx AP1B ; read p1 bit dx ADBYTE ;(36, 24H)READ DATA MEMORY dx AXBYTE ;(37, 0x25)READ EXTERNAL MEMORY dx PIPI ;(38, 26H)PI dx ARND ;(39, 0x27)RANDOM NUMBER dx AGET ;(40, 0x28)GET INPUT CHARACTER dx AFREE ;(41, 29H)COMPUTE #BYTES FREE dx ALEN ;(42, 2AH) COMPUTE LEN OF PORGRAM dx AXTAL ;(43, 2BH) CRYSTAL dx PMTOP ;(44, 2CH)TOP OF MEMORY dx ATIME ;(45, 2DH) TIME dx A_IE ;(46, 2EH) IE dx A_IP ;(47, 2FH) IP dx ATIM0 ;(48, 30H) TIMER 0 dx ATIM1 ;(49, 31H) TIMER 1 dx ATIM2 ;(50, 32H) TIMER 2 dx AT2CON ;(51, 0x33) T2CON dx ATCON ;(52, 34H) TCON dx ATMOD ;(53, 0x35) ATMOD dx ARCAP2 ;(54, 36H) RCAP2 dx AP1 ;(55, 0x37) P1 dx APCON ;(56, 38H) PCON dx AP3 ; P3 dx EXPRB ;(57, 39H) EVALUATE AN EXPRESSION dx AXTAL1 ;(58, 3AH) CALCULATE CRYSTAL dx LINE ;(59, 3BH) EDIT a LINE dx PP ;(60, 3CH) PROCESS a LINE dx UPPL_3 ;(61, 3DH) UNPROCESS a LINE dx VAR ;(62, 0x3e) FIND a VARIABLE dx GC ;(63, 0x3f) GET a CHARACTER dx GCI ;(64, 40H) GET CHARACTER AND INCREMENT dx INCHAR ;(65, 41H) INPUT a CHARACTER dx CRUN ;(66, 42H) RUN a PROGRAM ;$EJECT OPBOL: db 1 ; ; db 15 ;LEFT PAREN db 14 ;EXPONENTIAN ** db 10 ;mul db 8 ;add db 10 ;DIVIDE db 8 ;SUB db 3 ;XOR db 5 ;AND db 4 ;OR db 12 ;NEGATE db 6 ;EQ db 6 ;GT db 6 ;LT db 6 ;NE db 6 ;LE db 6 ;GE ; UOPBOL: db 15 ;AABS db 15 ;AAINT db 15 ;ASGN db 15 ;ANOT db 15 ;ACOS db 15 ;ATAN db 15 ;ASIN db 15 ;ASQR db 15 ;ACBYTE db 15 ;E TO THE X db 15 ;AATAN db 15 ;NATURAL LOG db 15 ;P1B db 15 ;P3B db 15 ;DBYTE db 15 ;XBYTE ; ;$EJECT ;*************************************************************** ; ; The ASCII printed messages. ; ;*************************************************************** ; STP: db "STOP" ; IAN: db "TRY AGAIN" ; RDYS: db "READY" ; INS: db " - IN LINE " ; ;************************************************************** ; ; This is the command jump table ; ;************************************************************** ; CMNDD: dx CRUN ;RUN dx CLIST ;LIST dx CNULL ;NULL dx CNEW ;NEW dx CCONT ;CONTINUE dx CNULL;CPROG ;PROGRAM a PROM dx CNULL;CXFER ;TRANSFER FROM ROM TO RAM dx CNULL;CRAM ;RAM MODE dx CNULL;CROM ;ROM MODE dx CNULL;CIPROG ;INTELLIGENT PROM PROGRAMMING ; ;$EJECT ;*************************************************************** ; ; This is the statement jump table. ; ;************************************************************** ; STATD: ; dx SLET ;LET 0x80 dx SCLR ;CLEAR 0x81 dx SPUSH ;push VAR 0x82 dx SGOTO ;GO TO 0x83 dx STONE ;TONE 0x84 dx SPH0 ;PRINT MODE 0 0x85 dx CNULL;SUI ;USER INPUT 0x86 ;dx CNULL;SUO ;USER OUTPUT 0x87 dx SBYE ;quit 0x87 dx SPOP ;pop VAR 0x88 dx SPRINT ;PRINT 0x89 dx SCALL ;lcall 0x8a dx SDIMX ;DIMENSION 0x8b dx STRING ;STRING ALLO 0x8c dx SBAUD ;SET BAUD 0x8d dx SCLOCK ;CLOCK 0x8e dx SPH1 ;PRINT MODE 1 0x8f ; ; No direct mode from here on ; dx SSTOP ;STOP 0x90 dx SOT ;ON TIME 0x91 dx SONEXT ;ON EXT INT 0x92 dx SRETI ;ret FROM INT 0x93 dx S_DO ;DO 0x94 dx SRESTR ;RESTOR 0x95 dx WCR ;REM 0x96 dx SNEXT ;NEXT 0x97 dx SONERR ;ON ERROR 0x98 dx S_ON ;ON 0x99 dx SINPUT ;INPUT 0x9a dx SREAD ;READ 0x9b dx FINDCR ;DATA 0x9c dx SRETRN ;RETURN 0x9d dx SIF ;IF 0x9e dx SGOSUB ;GOSUB 0x9f dx SFOR ;FOR 0xa0 dx SWHILE ;WHILE 0xa1 dx SUNTIL ;UNTIL 0xa2 dx CMND1 ;END 0xa3 dx I_DL ;IDLE 0xa4 dx ST_A ;STORE AT 0xa5 dx LD_A ;LOAD AT 0xa6 dx CNULL;PGU ;PGM 0xa7 dx CNULL;RROM ;RUN a ROM 0xa9 ; ;$EJECT ;************************************************************** ; TOKTAB: ; This is the basic token table ; ;************************************************************** ; ; First the tokens for statements ; db 0x80 ;LET TOKEN db "LET\z" ; db 0x81 ;CLEAR TOKEN db "CLEAR\z" ; db 0x82 ;push TOKEN db "PUSH\z" ; T_GOTO = 0x83 ; db 0x83 ;GO TO TOKEN db "GOTO\z" ; db 0x84 ;TOGGLE TOKEN db "PWM\z" ; db 0x85 ;PRINT HEX MODE 0 db "PH0.\z" ; ; db 0x86 ;USER IN TOKEN ; db "UI\z" ; ; db 0x87 ;USER OUT TOKEN ; db "UO\z" ; db 0x87 ;quit back to monitor db "BYE\z" ; db 0x88 ;pop TOKEN db "POP\z" ; ;$EJECT db 0x89 ;PRINT TOKEN db "PRINT\z" db 0x89 db "P.\z" ;P. ALSO MEANS PRINT db 0x89 ;? ALSO db "?\z" ; db 0x8a ;lcall TOKEN db "LCALL\z" ; db 0x8b ;DIMENSION TOKEN db "DIM\z" ; db 0x8c ;STRING TOKEN db "STRING\z" ; db 0x8d ;SET BAUD RATE db "BAUD\z" ; db 0x8e ;CLOCK db "CLOCK\z" ; db 0x8f ;PRINT HEX MODE 1 db "PH1.\z" ; T_STOP = 0x90 ;STOP TOKEN db T_STOP db "STOP\z" ; T_DIR = T_STOP ;NO DIRECT FROM HERE ON ; db T_STOP+1 ;ON TIMER INTERRUPT db "ONTIME\z" ; db T_STOP+2 ;ON EXTERNAL INTERRUPT db "ONEX1\z" ; db T_STOP+3 ;RETURN FROM INTERRUPT db "RETI\z" ; db T_STOP+4 ;DO TOKEN db "DO\z" ; db T_STOP+5 ;RESTORE TOKEN db "RESTORE\z" ; ;$EJECT T_REM = T_STOP+6 ;REMARK TOKEN db T_REM db "REM\z" ; db T_REM+1 ;NEXT TOKEN db "NEXT\z" ; db T_REM+2 ;ON ERROR TOKEN db "ONERR\z" ; db T_REM+3 ;ON TOKEN db "ON\z" ; db T_REM+4 ;INPUT db "INPUT\z" ; db T_REM+5 ;READ db "READ\z" ; T_DATA = T_REM+6 ;DATA db T_DATA db "DATA\z" ; db T_DATA+1 ;RETURN db "RETURN\z" ; db T_DATA+2 ;IF db "IF\z" ; T_GOSB = T_DATA+3 ;GOSUB db T_GOSB db "GOSUB\z" ; db T_GOSB+1 ;FOR db "FOR\z" ; db T_GOSB+2 ;WHILE db "WHILE\z" ; db T_GOSB+3 ;UNTIL db "UNTIL\z" ; db T_GOSB+4 ;END db "END\z" ; ;$EJECT T_LAST = T_GOSB+5 ;LAST INITIAL TOKEN ; T_TAB = T_LAST ;TAB TOKEN db T_TAB db "TAB\z" ; T_THEN = T_LAST+1 ;THEN TOKEN db T_THEN db "THEN\z" ; T_TO = T_LAST+2 ;TO TOKEN db T_TO db "TO\z" ; T_STEP = T_LAST+3 ;STEP TOKEN db T_STEP db "STEP\z" ; T_ELSE = T_LAST+4 ;ELSE TOKEN db T_ELSE db "ELSE\z" ; T_SPC = T_LAST+5 ;SPACE TOKEN db T_SPC db "SPC\z" ; T_CR = T_LAST+6 db T_CR db "CR\z" ; db T_CR+1 db "IDLE\z" ; db T_CR+2 db "ST@\z" ; db T_CR+3 db "LD@\z" ; ;db T_CR+4 ;db "PGM\z" ; ;db T_CR+5 ;db "RROM\z" ; ;$EJECT ; Operator tokens ; T_LPAR = 0xE0 ;LEFT PAREN db T_LPAR db "(\z" ; db T_LPAR+1 ;EXPONENTIAN db "**\z" ; db T_LPAR+2 ;FP MULTIPLY db "*\z" ; T_ADD = T_LPAR+3 db T_LPAR+3 ;add TOKEN db "+\z" ; db T_LPAR+4 ;DIVIDE TOKEN db "/\z" ; T_SUB = T_LPAR+5 ;SUBTRACT TOKEN db T_SUB db "-\z" ; db T_LPAR+6 ;LOGICAL EXCLUSIVE OR db ".XOR.\z" ; db T_LPAR+7 ;LOGICAL AND db ".AND.\z" ; db T_LPAR+8 ;LOGICAL OR db ".OR.\z" ; T_NEG = T_LPAR+9 ; T_EQU = T_LPAR+10 ;EQUAL db T_EQU db "=\z" ; db T_LPAR+11 ;GREATER THAN OR EQUAL db ">=\z" ; db T_LPAR+12 ;LESS THAN OR EQUAL db "<=\z" ; db T_LPAR+13 ;NOT EQUAL db "<>\z" ; db T_LPAR+14 ;LESS THAN db "<\z" ; db T_LPAR+15 ;GREATER THAN db ">\z" ; ; T_UOP = 0xB0 ;UNARY OP BASE TOKEN ; db T_UOP ;ABS TOKEN db "ABS\z" ; db T_UOP+1 ;INTEGER TOKEN db "INT\z" ; db T_UOP+2 ;SIGN TOKEN db "SGN\z" ; db T_UOP+3 ;GET TOKEN db "NOT\z" ; db T_UOP+4 ;COSINE TOKEN db "COS\z" ; db T_UOP+5 ;TANGENT TOKEN db "TAN\z" ; db T_UOP+6 ;SINE TOKEN db "SIN\z" ; db T_UOP+7 ;SQUARE ROOT TOKEN db "SQR\z" ; db T_UOP+8 ;CBYTE TOKEN db "CBY\z" ; db T_UOP+9 ;EXP (E TO THE X) TOKEN db "EXP\z" ; db T_UOP+10 db "ATN\z" ; db T_UOP+11 db "LOG\z" ; T_P3B = T_UOP+12 db T_UOP+12 ;T_P3B TOKEN db "P3B\z" ; T_P1B = T_UOP+13 db T_UOP+13 ;T_P1B TOKEN db "P1B\z" ; db T_UOP+14 ;DBYTE TOKEN db "DBY\z" ; db T_UOP+15 ;XBYTE TOKEN db "XBY\z" ; T_ULAST = T_UOP+16 ;LAST OPERATOR NEEDING PARENS ; db T_ULAST db "PI\z" ; db T_ULAST+1 ;RND TOKEN db "RND\z" ; db T_ULAST+2 ;GET TOKEN db "GET\z" ; db T_ULAST+3 ;FREE TOKEN db "FREE\z" ; db T_ULAST+4 ;LEN TOKEN db "LEN\z" ; T_XTAL = T_ULAST+5 ;CRYSTAL TOKEN db T_XTAL db "XTAL\z" ; T_MTOP = T_ULAST+6 ;MTOP db T_MTOP db "MTOP\z" ; T_IE = T_ULAST+8 ;IE REGISTER db T_IE db "IE\z" ; T_IP = T_ULAST+9 ;IP REGISTER db T_IP db "IP\z" ; TMR0 = T_ULAST+10 ;TIMER 0 db TMR0 db "TIMER0\z" ; TMR1 = T_ULAST+11 ;TIMER 1 db TMR1 db "TIMER1\z" ; TMR2 = T_ULAST+12 ;TIMER 2 db TMR2 db "TIMER2\z" ; T_TIME = T_ULAST+7 ;TIME db T_TIME db "TIME\z" ; TT2C = T_ULAST+13 ;T2CON db TT2C db "T2CON\z" ; TTC = T_ULAST+14 ;TCON db TTC db "TCON\z" ; TTM = T_ULAST+15 ;TMOD db TTM db "TMOD\z" ; TRC2 = T_ULAST+16 ;RCAP2 db TRC2 db "RCAP2\z" ; T_P1 = T_ULAST+17 ;P1 db T_P1 db "P1\z" db T_P1 db "PORT1\z" ; T_PC = T_ULAST+18 ;PCON db T_PC db "PCON\z" ; T_P3 = T_ULAST+19 ;P3 db T_P3 db "P3\z" db T_P3 db "PORT3\z" ; T_ASC = T_ULAST+20 ;ASC TOKEN db T_ASC db "ASC(\z" ; T_USE = T_ULAST+21 ;USING TOKEN db T_USE db "USING(\z" db T_USE db "U.(\z" ; T_CHR = T_ULAST+22 ;CHR TOKEN db T_CHR db "CHR(\z" ; ;$EJECT T_CMND = 0xf0 ;COMMAND BASE ; db 0xf0 ;RUN TOKEN db "RUN\z" ; db 0xF1 ;LIST TOKEN db "LIST\z" ; db 0xF2 ;NULL TOKEN db "NULL\z" ; db 0xF3 ;NEW TOKEN db "NEW\z" ; db 0xF4 ;CONTINUE TOKEN db "CONT\z" ; ;db 0xF5 ;PROGRAM TOKEN ;db "PROG\z" ; ;db 0xF6 ;TRANSFER TOKEN ;db "XFER\z" ; ;db 0xF7 ;RAM MODE ;db "RAM\z" ; ;db 0xF8 ;ROM MODE ;db "ROM\z" ; ;db 0xF9 ;INTELLIGENT PROM PROGRAMMING ;db "FPROG\z" ; db 0xff ;END OF TABLE ; ; END OF INCLUDE LOOK52 ;$INCLUDE(:F2:LOOK52.SRC) ; EIG: db "EXTRA IGNORED" ; EXA: db "a-STACK" ; EXC: db "c-STACK" ; ;$EJECT ;$INCLUDE(:F2:BAS52.RST) ; BEGINNING START_BASIC: ;************************************************************** ; CRST: ; This performs system initialzation, it was moved here so the ; new power on reset functions could be tested in an 8751. ; ;************************************************************** ; ; First, initialize SFR"s ; jnb ti, . ; finish echoing text mov IE, #0 mov SCON,#0x5A ;INITIALIZE SFR"S mov TMOD,#0x10 mov TCON,#0x54 mov T2CON, #0x34 ; ; ; mov dptr,#0x2001 ;READ CODE AT 2001H ; clr a ; movc a,@a+dptr ; cjne a,#0xAA,.+6 ;IF IT IS AN AAH, DO USER RESET ; lcall 0x2090 ; mov r0,#IRAMTOP ;PUT THE TOP OF RAM IN r0 clr a ;ZERO THE ACC ; Q1: mov @r0,a ;CLEAR INTERNAL MEMORY djnz r0,Q1 ;LOOP TIL DONE ; ; mov vtint0l, #BTINT0&0xff ; hook into the main ISRs mov vtint0h, #BTINT0>>8 mov vint0l, #BINT0&0xff mov vint0h, #BINT0>>8 mov vint1l, #BINT1&0xff mov vint1h, #BINT1>>8 ; ; Now, test the external memory ; mov SPSAV,#CMNDSP ;SET UP THE STACK mov SP,SPSAV ; ; mov BOFAH,#ROMADR>>8 ; mov BOFAL,#(ROMADR&0xff)+17 ; mov dptr,#ROMADR ;GET THE BYTE AT 8000H ; movx a,@dptr ; clr c ; subb a,#0x31 ;FOR BIAS mov a, #0xff ; - mark it invalid mov MT1,a ;SAVE IN DIRECT MATH LOC clr ACC.2 ;SAVE FOR RESET mov r7,a ;SAVE IT IN r7 ; inc dptr ; lcall L31DPI ;SAVE BAUD RATE ; lcall RCL mov RCAP2H, #0xff ; 9600 baud mov RCAP2L, #0xdd ; inc dptr ;GET MEMTOP ; lcall L31DPI ; mov dptr,#0x0x805F ;READ THE EXTERNAL BYTE ; movx a,@dptr mov dptr,#0x8000 ;ESTABLISH BASE FOR CLEAR ; cjne a,#0xA5,CRS ; mov a,MT1 ; clr ACC.0 ;CLEAR BIT ONE ; xrl a,#4 ; jz CR2 ; ;CRS: cjne r7,#2,Q20 ; ajmp Q21 ;Q20: cjne r7,#3,CR0x ;Q21: lcall CL_1 ; ajmp CR1x ; CR0x: mov r3,DPH ;SAVE THE dptr mov r1,DPL inc dptr mov a,#0x5A movx @dptr,a movx a,@dptr cjne a,#0x5A,CR1x clr a movx @dptr,a cjne r3,#0xff,CR0x ; CR1x: cjne r3,#0x83,Q22 ;NEED THIS MUCH RAM Q22: jc CRST mov dptr,#MEMTOP ;SAVE MEMTOP acall S31DP2 ;SAVE MEMTOP AND SEED RCELL lcall CNEW ;CLEAR THE MEMORY AND SET UP POINTERS ; CR2: lcall RC1 ;SET UP STACKS IF NOT DONE ; lcall AXTAL0 ;DO THE CRYSTAL ; mov a,MT1 ;GET THE RESET BYTE ; cjne a,#5,Q23 ; lcall 0x4039 Q23:; jnc BG1 ;CHECK FOR 0,1,2,3, OR 4 ; jnb ACC.0,BG3 ;NO RUN IF WRONG TYPE ; mov dptr,#ROMADR+16 ; movx a,@dptr ;READ THE BYTE ; cjne a,#0x55,BG3 ; ljmp CRUN ; ;BG1: clr a ;DO BAUD RATE ; mov r3,a ; mov r1,a ; mov r0,#4 ; jb ri,. ;LOOP UNTIL a CHARACTER IS RECEIVED ; ;BG2: djnz r0,. ;FOUR CLOCKS, IN LOOP ; lcall DEC3210_4 ;NINE CLOCKS ; mov r0,#2 ;ONE CLOCK ; jnb ri,BG2 ;TWO CLOCKS, LOOP UNTIL DONE ; jb ri,. ;WAIT FOR STOP CHARACTER TO END ; jnb ri,. ; lcall RCL ;LOAD THE TIMER ; mov RCAP2H, #0xff ; 9600 baud ; mov RCAP2L, #0xdd ; BG3: mov dptr,#S_N ;GET THE MESSAGE lcall CRP ;PRINT IT ljmp CRAM ; END ;$INCLUDE(:F2:BAS52.RST) ; ;$EJECT ;*************************************************************** ; ; CIPROG AND CPROG - Program a prom ; ;*************************************************************** ; ;$INCLUDE(:F2:BAS52.PGM) ;BEGINNING ;PG8: mov r7,#0x00 ;PROGRAM ONE BYTE AT a TIME ; mov r6,#0x01 ; mov r2,#(ROMADR-1)>>8 ; mov r0,#(ROMADR-1)&0xff ;LOAD PROM ADDRESS ; acall PG1_3 ; inc r6 ; mov a, RCAP2H ; acall PG1_3 ; mov a, RCAP2L ; mov r6,#3 ; mov r1,#(MEMTOP-1)&0xff ; mov r3,#MEMTOP>>8 ; acall PG1_3 ;SAVE MEMTOP ; ajmp PGR ; ; ;CIPROG: mov dptr,#IPROGS ;LOAD IPROG LOCATION ; setb INTELB ; ajmp Q24 ;GO DO PROG ; ; ;CPROG: mov dptr,#PROGS ;LOAD PROG LOCATION ;Q24: clr INTELB ; ; ; lcall LD_T ;LOAD THE TIMER ; clr PROMV ;TURN ON THE PROM VOLTAGE ; lcall DELTST ;SEE IF a CR ; jnz PG8 ;SAVE TIMER IF SO ; mov r4,#0xFE ; setb INBIT ; lcall ROMFD ;GET THE ROM ADDRESS OF THE LAST LOCATION ; lcall TEMPD ;SAVE THE ADDRESS ; mov a,r4 ;GET COUNT ; cpl a ; lcall TWO_R2 ;PUT IT ON THE STACK ; lcall FLOATING_POINT_OUTPUT ;OUTPUT IT ; acall CCAL ;GET THE PROGRAM ; lcall CRLF ;DO CRLF ; mov r0,TEMP4 ;GET ADDRESS ; mov r2,TEMP5 ; mov a,#0x55 ;LOAD SIGNIFIER ; inc r6 ;LOAD LEN + 1 ; cjne r6,#00,Q25 ; inc r7 ;Q25: acall PG2_2 ; ; ;$EJECT ;PGR: setb PROMV ; ljmp C_K ; ; ;PG1: mov P2,r3 ;GET THE BYTE TO PROGRAM ; movx a,@r1 ;PG1_3: lcall INC3210 ;BUMP POINTERS ;PG2_2: mov r5,#1 ;SET UP INTELLIGENT COUMTER ; ; ;PG2: mov r4,a ;SAVE THE BYTE IN r4 ; acall PG7 ;PROGRAM THE BYTE ; acall PG9 ; jb INTELB,PG4 ;SEE IF INTELLIGENT PROGRAMMING ; ; ;PG3: xrl a,r4 ; jnz PG6 ;ERROR IF NOT THE SAME ; lcall DEC76 ;BUMP THE COUNTERS ; jnz PG1 ;LOOP IF NOT DONE ; anl PSW,#0xe7 ;INSURE RB0 ;Q922: ret ; ;PG4: xrl a,r4 ;SEE IF PROGRAMMED ; jnz PG5 ;JUMP IF NOT ; mov a,r4 ;GET THE DATA BACK ; acall PG7 ;PROGRAM THE LOCATION ;Q2: acall ZRO ;AGAIN ; acall ZRO ;AND AGAIN ; acall ZRO ;AND AGAIN ; djnz r5,Q2 ;KEEP DOING IT ; acall PG9 ;RESET PROG ; ajmp PG3 ;FINISH THE LOOP ; ; ;PG5: inc r5 ;BUMP THE COUNTER ; mov a,r4 ;GET THE BYTE ; cjne r5,#25,PG2 ;SEE IF TRIED 25 TIMES ; ; ;PG6: setb PROMV ;TURN OFF PROM VOLTAGE ; mov PSW,#0 ;INSURE RB0 ; jnb DIRF,Q922 ;EXIT IF IN RUN MODE ; mov dptr,#E16X ;PROGRAMMING ERROR ; ; ;ERRLK: ljmp ERROR ;PROCESS THE ERROR ; ; ;;$EJECT ;PG7: mov P0,r0 ;SET UP THE PORTS ; mov P2,r2 ;LATCH LOW ORDER ADDRESS ; acall PG11 ;DELAY FOR 8748/9 ; clr ALED ; mov P0,a ;PUT DATA ON THE PORT ; ; ZRO: nop ;SETTLEING TIME + FP ZERO nop nop nop nop nop ; acall PG11 ;DELAY a WHILE ; clr PROMP ;START PROGRAMMING ; acall TIMER_LOAD ;START THE TIMER ; jnb TF1,. ;WAIT FOR PART TO PROGRAM ; ret ;EXIT ; ; ;PG9: setb PROMP ; acall PG11 ;DELAY FOR a WHILE ; jnb P3.2,. ;LOOP FOR EEPROMS ; mov P0,#0xff ; clr P3.7 ;LOWER READ ; acall PG11 ; mov a,P0 ;READ THE PORT ; setb P3.7 ; setb ALED ; ret ; ; ;PG11: mov TEMP5,#12 ;DELAY 30uS AT 12 MHZ ; djnz TEMP5,. ; ret ; ; ;END ;$INCLUDE(:F2:BAS52.PGM) ;$EJECT ; ;************************************************************** ; ; ;PGU: ;PROGRAM a PROM FOR THE USER ; ; ; ;************************************************************** ; ; ; clr PROMV ;TURN ON THE VOLTAGE ; mov PSW,#0x18 ;SELECT RB3 ; acall PG1 ;DO IT ; setb PROMV ;TURN IT OFF ; ret ; ; ; ; ; ;************************************************************* ; ; CCAL: ; Set up for prom moves ; r3:r1 gets source ; r7:r6 gets # of bytes ; ;************************************************************* ; acall GETEND ;GET THE LAST LOCATION inc dptr ;BUMP TO LOAD EOF mov r3,BOFAH mov r1,BOFAL ;RESTORE START clr c ;PREPARE FOR subb mov a,DPL ;SUB dptr - BOFA > r7:r6 subb a,r1 mov r6,a mov a,DPH subb a,r3 mov r7,a ret ; ; ; ; ;;$INCLUDE(:F2:BAS52.TL) ;BEGINNING ; ; ;************************************************************** ; TIMER_LOAD:; Load the timer ; ;************************************************************* ; acall Q3 ;DELAY FOUR CLOCKS TIMER_LOAD_2: clr TR1 ;STOP IT WHILE IT"S LOADED mov TH1,T_HH mov TL1,T_LL clr TF1 ;CLEAR THE OVERFLOW FLAG setb TR1 ;START IT NOW Q3: ret ; ;END ;$INCLUDE(:F2:BAS52.TL) ;$EJECT ; ;*************************************************************** ; ; ;CROM: ; The command action routine - ROM - Run out of rom ; ; ; ;*************************************************************** ; ; ; clr CONB ;CAN"T CONTINUE IF MODE CHANGE ; acall RO1 ;DO IT ; ; ;C_K: ljmp CL3 ;EXIT ; ; ;RO1: lcall INTGER ;SEE IF INTGER PRESENT ; mov r4,R0B0 ;SAVE THE NUMBER ; jnc Q26 ; mov r4,#0x01 ;ONE IF NO INTEGER PRESENT ;Q26: acall ROMFD ;FIND THE PROGRAM ; cjne r4,#0,RFX ;EXIT IF r4 <> 0 ; inc dptr ;BUMP PAST TAG ; mov BOFAH,DPH ;SAVE THE ADDRESS ; mov BOFAL,DPL ; ret ; ; ;ROMFD: mov dptr,#ROMADR+16 ;START OF USER PROGRAM ; ; ;RF1: movx a,@dptr ;GET THE BYTE ; cjne a,#0x55,RF3 ;SEE IF PROPER TAG ; djnz r4,RF2 ;BUMP COUNTER ; ; ;RFX: ret ;dptr HAS THE START ADDRESS ;; ; ;RF2: inc dptr ;BUMP PAST TAG ; acall XXG5 ; inc dptr ;BUMP TO NEXT PROGRAM ; ajmp RF1 ;DO IT AGAIN ; ; ;RF3: jbc INBIT,RFX ;EXIT IF SET ; ; NOGO: mov dptr,#NOROM ljmp ERROR ; ;$EJECT ;*************************************************************** ; L20DPI: ; load r2:r0 with the location the dptr is pointing to ; ;*************************************************************** ; movx a,@dptr mov r2,a inc dptr movx a,@dptr mov r0,a ret ;DON"T BUMP dptr ; ;*************************************************************** ; X31DP: ; swap r3:r1 with dptr ; ;*************************************************************** ; xch a,r3 xch a,DPH xch a,r3 xch a,r1 xch a,DPL xch a,r1 ret ; ;*************************************************************** ; LD_T: ; Load the timer save location with the value the dptr is ; pointing to. ; ;**************************************************************** ; movx a,@dptr mov T_HH,a inc dptr movx a,@dptr mov T_LL,a ret ; ;$EJECT ; ;*************************************************************** ; ;GETLIN - FIND THE LOCATION OF THE LINE NUMBER IN r3:r1 ; IF ACC = 0 THE LINE WAS NOT FOUND I.E. r3:r1 ; WAS TOO BIG, ELSE ACC <> 0 AND THE dptr POINTS ; AT THE LINE THAT IS GREATER THAN OR EQUAL TO THE ; VALUE IN r3:r1. ; ;*************************************************************** ; GETEND: setb ENDBIT ;GET THE END OF THE PROGRAM ; GETLIN: lcall DP_B ;GET BEGINNING ADDRESS ; XXG1: lcall B_C jz XXG3 ;EXIT WITH a ZERO IN a IF AT END inc dptr ;POINT AT THE LINE NUMBER jb ENDBIT,XXG2 ;SEE IF WE WANT TO FIND THE END acall DCMPX ;SEE IF (dptr) = r3:r1 acall DECDP ;POINT AT LINE COUNT movx a,@dptr ;PUT LINE LENGTH INTO ACC jb UBIT,XXG3 ;EXIT IF EQUAL jc XXG3 ;SEE IF LESS THAN OR ZERO ; XXG2: acall ADdptr ;add IT TO DPTR ajmp XXG1 ;LOOP ; XXG3: clr ENDBIT ;RESET ENDBIT ret ;EXIT ; XXG4: mov dptr,#PSTART ;DO RAM ; XXG5: setb ENDBIT ajmp XXG1 ;NOW DO TEST ; ;$EJECT ;*************************************************************** ; ; LdptrI - Load the DATA POINTER with the value it is pointing ; to - DPH = (dptr) , DPL = (DPTR+1) ; ; acc gets wasted ; ;*************************************************************** ; LdptrI: movx a,@dptr ;GET THE HIGH BYTE push ACC ;SAVE IT inc dptr ;BUMP THE POINTER movx a,@dptr ;GET THE LOW BYTE mov DPL,a ;PUT IT IN DPL pop DPH ;GET THE HIGH BYTE ret ;GO BACK ; ;*************************************************************** ; ;L31DPI - LOAD r3 WITH (dptr) AND r1 WITH (DPTR+1) ; ;ACC GETS CLOBBERED ; ;*************************************************************** ; L31DPI: movx a,@dptr ;GET THE HIGH BYTE mov r3,a ;PUT IT IN THE REG inc dptr ;BUMP THE POINTER movx a,@dptr ;GET THE NEXT BYTE mov r1,a ;SAVE IT ret ; ;*************************************************************** ; ;DECDP - DECREMENT THE DATA POINTER - USED TO SAVE SPACE ; ;*************************************************************** ; DECDP2: acall DECDP ; DECDP: xch a,DPL ;GET DPL jnz Q27 ;BUMP IF ZERO dec DPH Q27: dec a ;DECREMENT IT xch a,DPL ;GET a BACK ret ;EXIT ; ;$EJECT ;*************************************************************** ; ;DCMPX - DOUBLE COMPARE - COMPARE (dptr) TO r3:r1 ;r3:r1 - (dptr) = SET CARRY FLAG ; ;IF r3:r1 > (dptr) THEN c = 0 ;IF r3:r1 < (dptr) THEN c = 1 ;IF r3:r1 = (dptr) THEN c = 0 ; ;*************************************************************** ; DCMPX: clr UBIT ;ASSUME NOT EQUAL movx a,@dptr ;GET THE BYTE cjne a,R3B0,D1 ;IF a IS GREATER THAN r3 THEN NO CARRY ;WHICH IS r3<@dptr = NO CARRY AND ;r3>@dptr CARRY IS SET inc dptr ;BUMP THE DATA POINTER movx a,@dptr ;GET THE BYTE acall DECDP ;PUT dptr BACK cjne a,R1B0,D1 ;DO THE COMPARE cpl c ;FLIP CARRY ; cpl UBIT ;SET IT D1: cpl c ;GET THE CARRY RIGHT ret ;EXIT ; ;*************************************************************** ; ; ADdptr - Add acc to the dptr ; ; acc gets wasted ; ;*************************************************************** ; ADdptr: add a,DPL ;add THE ACC TO DPL mov DPL,a ;PUT IT IN DPL jnc Q29 ;JUMP IF NO CARRY inc DPH ;BUMP DPH Q29: ret ;EXIT ; ;$EJECT ;************************************************************* ; LCLR: ; Set up the storage allocation ; ;************************************************************* ; lcall ICLR ;CLEAR THE INTERRUPTS acall XXG4 ;PUT END ADDRESS INTO dptr mov a,#6 ;ADJUST MATRIX SPACE acall ADdptr ;add FOR PROPER BOUNDS acall X31DP ;PUT MATRIX BOUNDS IN r3:r1 mov dptr,#MT_ALL ;SAVE r3:r1 IN MATRIX FREE SPACE acall S31DP ;dptr POINTS TO MEMTOP acall L31DPI ;LOAD MEMTOP INTO r3:r1 mov dptr,#STR_AL ;GET MEMORY ALLOCATED FOR STRINGS acall LdptrI lcall DUBSUB ;r3:r1 = MEMTOP - STRING ALLOCATION mov dptr,#VARTOP ;SAVE r3:r1 IN VARTOP ; ; FALL THRU TO S31DP2 ; ;*************************************************************** ; ;S31DP - STORE r3 INTO (dptr) AND r1 INTO (DPTR+1) ; ;ACC GETS CLOBBERED ; ;*************************************************************** ; S31DP2: acall S31DP ;DO IT TWICE ; S31DP: mov a,r3 ;GET r3 INTO ACC movx @dptr,a ;STORE IT inc dptr ;BUMP DPTR mov a,r1 ;GET r1 movx @dptr,a ;STORE IT inc dptr ;BUMP IT AGAIN TO SAVE PROGRAM SPACE ret ;GO BACK ; ; ;*************************************************************** ; STRING: ; Allocate memory for strings ; ;*************************************************************** ; lcall TWO ;r3:r1 = NUMBER, r2:r0 = LEN mov dptr,#STR_AL ;SAVE STRING ALLOCATION acall S31DP inc r6 ;BUMP mov S_LEN,r6 ;SAVE STRING LENGTH ljmp RCLEAR ;CLEAR AND SET IT UP ; ;$EJECT ;*************************************************************** ; ; F_VAR - Find the variable in symbol table ; r7:r6 contain the variable name ; If not found create a zero entry and set the carry ; r2:r0 has the address of variable on return ; ;*************************************************************** ; F_VAR: mov dptr,#VARTOP ;PUT VARTOP IN DPTR lcall LdptrI lcall DECDP2 ;ADJUST dptr FOR LOOKUP ; F_VAR0: movx a,@dptr ;LOAD THE VARIABLE jz F_VAR2 ;TEST IF AT THE END OF THE TABLE inc dptr ;BUMP FOR NEXT BYTE cjne a,R7B0,F_VAR1 ;SEE IF MATCH movx a,@dptr ;LOAD THE NAME cjne a,R6B0,F_VAR1 ; ; Found the variable now adjust and put in r2:r0 ; DLD: mov a,DPL ;r2:r0 = dptr-2 subb a,#2 mov r0,a mov a,DPH subb a,#0 ;CARRY IS CLEARED mov r2,a ret ; F_VAR1: mov a,DPL ;SUBTRACT THE STACK SIZE+ADJUST clr c subb a,#STESIZ mov DPL,a ;RESTORE DPL jnc F_VAR0 dec DPH ljmp F_VAR0 ;CONTINUE COMPARE ; ;$EJECT ; ; Add the entry to the symbol table ; F_VAR2: lcall R76S ;SAVE r7 AND r6 clr c lcall DLD ;BUMP THE POINTER TO GET ENTRY ADDRESS ; ; Adjust pointer and save storage allocation ; and make sure we aren"t wiping anything out ; First calculate new storage allocation ; mov a,r0 subb a,#STESIZ-3 ;NEED THIS MUCH RAM mov r1,a mov a,r2 subb a,#0 mov r3,a ; ; Now save the new storage allocation ; mov dptr,#ST_ALL lcall S31DP ;SAVE STORAGE ALLOCATION ; ; Now make sure we didn"t blow it, by wiping out MT_ALL ; lcall DCMPX ;COMPARE STORAGE ALLOCATION jc CCLR3 ;ERROR IF CARRY setb c ;DID NOT FIND ENTRY ret ;EXIT IF TEST IS OK ; ;$EJECT ;*************************************************************** ; ; Command action routine - NEW ; ;*************************************************************** ; CNEW: mov dptr,#PSTART ;SAVE THE START OF PROGRAM mov a,#EOF ;END OF FILE movx @dptr,a ;PUT IT IN MEMORY ; ; falls thru ; ;***************************************************************** ; ; The statement action routine - CLEAR ; ;***************************************************************** ; RCLEAR_2: clr LINEB ;SET UP FOR RUN AND GOTO ; RCLEAR: lcall LCLR ;CLEAR THE INTERRUPTS, SET UP MATRICES mov dptr,#MEMTOP ;PUT MEMTOP IN r3:r1 lcall L31DPI lcall XXG4 ;dptr GETS END ADDRESS acall CL_1 ;CLEAR THE MEMORY ; RC1: mov dptr,#(CSTKAH<<8)+STACKTP ;POINT AT CONTROL STACK TOP clr a ;CONTROL UNDERFLOW ; RC2: movx @dptr,a ;SAVE IN MEMORY mov CSTKA,#STACKTP mov ASTKA,#STACKTP clr CONB ;CAN"T CONTINUE ret ; ;$EJECT ;*************************************************************** ; ; Loop until the memory is cleared ; ;*************************************************************** ; CL_1: inc dptr ;BUMP MEMORY POINTER clr a ;CLEAR THE MEMORY movx @dptr,a ;CLEAR THE RAM movx a,@dptr ;READ IT jnz CCLR3 ;MAKE SURE IT IS CLEARED mov a,r3 ;GET POINTER FOR COMPARE cjne a,DPH,CL_1 ;SEE TO LOOP mov a,r1 ;NOW TEST LOW BYTE cjne a,DPL,CL_1 ; CL_2: ret ; CCLR3: ljmp TB ;ALLOCATED MEMORY DOESN"T EXSIST ; ;************************************************************** ; SCLR: ;Entry point for clear return ; ;************************************************************** ; lcall DELTST ;TEST FOR a CR jnc RCLEAR lcall GCI1 ;BUMP THE TEST POINTER cjne a,#'I',RC1 ;SEE IF I, ELSE RESET THE STACK ; ;************************************************************** ; ICLR: ; Clear interrupts and system garbage ; ;************************************************************** ; jnb INTBIT,Q30 ;SEE IF BASIC HAS INTERRUPTS clr EX1 ;IF SO, CLEAR INTERRUPTS Q30: anl 34,#0x20 ;SET INTERRUPTS + CONTINUE reti ; ;$EJECT ;*************************************************************** ; ;OUTPUT ROUTINES ; ;*************************************************************** ; CRLF2: acall CRLF ;DO TWO CRLF"S ; CRLF: mov r5,#SCR ;LOAD THE CR acall TEROT ;lcall TERMINAL OUT mov r5,#LF ;LOAD THE LF ajmp TEROT ;OUTPUT IT AND RETURN ; ;PRINT THE MESSAGE ADDRESSED IN ROM OR RAM BY THE dptr ;ENDS WITH THE CHARACTER IN r4 ;dptr HAS THE ADDRESS OF THE TERMINATOR ; CRP: acall CRLF ;DO a CR THEN PRINT ROM ; ROM_P: clr a ;CLEAR a FOR LOOKUP movc a,@a+dptr ;GET THE CHARACTER clr ACC.7 ;CLEAR MS BIT cjne a,#'"',Q31 ;EXIT IF TERMINATOR ret Q31: cjne a, #0, Q310 ret Q310; setb C0ORX1 ; PN1: mov r5,a ;OUTPUT THE CHARACTER acall TEROT inc dptr ;BUMP THE POINTER ajmp PN0 ; UPRNT: lcall X31DP ; PRNTCR: mov r4,#SCR ;OUTPUT UNTIL a CR ; PN0: jbc C0ORX1,ROM_P movx a,@dptr ;GET THE RAM BYTE jz Q33 cjne a,R4B0,Q34 ;SEE IF THE SAME AS TERMINATOR Q33: ret ;EXIT IF THE SAME Q34: cjne a,#SCR,PN1 ;NEVER PRINT a CR IN THIS ROUTINE ljmp E1XX ;BAD SYNTAX ; ;$EJECT ;*************************************************************** ; ; INLINE - Input a line to IBUF, exit when a CR is received ; ;*************************************************************** ; INL2: cjne a,#CNTRLD,INL2B ;SEE IF a CONTROL D ; INL0: acall CRLF ;DO a CR ; INLINE: mov P2,#IBUF>>8 ;IBUF IS IN THE ZERO PAGE mov r0,#IBUF&0xff ;POINT AT THE INPUT BUFFER ; INL1: acall INCHAR ;GET a CHARACTER mov r5,a ;SAVE IN r5 FOR OUTPUT cjne a,#0x7f,INL2XX ;SEE IF a DELETE CHARACTER Q791: cjne r0,#IBUF&0xff,INL6 INLX_2: mov r5,#BELL ;OUTPUT a BELL ; INLX: acall TEROT ;OUTPUT CHARACTER ajmp INL1 ;DO IT AGAIN INL2XX: cjne a,#BS,INL2 ajmp Q791 ; INL2B: movx @r0,a ;SAVE THE CHARACTER cjne a,#SCR,Q35 ;IS IT a CR ajmp CRLF ;OUTPUT a CRLF AND EXIT Q35: cjne a,#0x20,Q36 Q36: jc INLX ;ONLY ECHO CONTROL CHARACTERS inc r0 ;BUMP THE POINTER cjne r0,#(IBUF+79)&0xff,INLX dec r0 ;FORCE 79 ajmp INLX_2 ;OUTPUT a BELL ; INL6: dec r0 ;dec THE RAM POINTER mov r5,#BS ;OUTPUT a BACK SPACE acall TEROT acall STEROT ;OUTPUT a SPACE mov r5,#BS ;ANOTHER BACK SPACE ajmp INLX ;OUTPUT IT ; PTIME: db 128-2 ; PROM PROGRAMMER TIMER db 0x00 db 0x00 db 0x50 db 0x67 db 0x41 ; ;$EJECT ;$INCLUDE(:F2:BAS52.OUT) ;BEGINNING ;*************************************************************** ; ; TEROT - Output a character to the system console ; update PHEAD position. ; ;*************************************************************** ; STEROT: mov r5,#' ' ;OUTPUT a SPACE ; TEROT: push ACC ;SAVE THE ACCUMULATOR push DPH ;SAVE THE dptr push DPL Q4: jnb CNT_S,Q38 ;WAIT FOR a CONTROL Q acall BCK ;GET SERIAL STATUS ajmp Q4 Q38: mov a,r5 ;PUT OUTPUT BYTE IN a ; jnb BO,Q39 ;CHECK FOR MONITOR ; lcall 0x2040 ;DO THE MONITOR ; ljmp TEROT1 ;CLEAN UP ;Q39: jnb COUB,Q40 ;SEE IF USER WANTS OUTPUT ; lcall 0x4030 ; ljmp TEROT1 ;Q40: jnb UPB,T_1 ;NO AT IF NO XBIT ; jnb LPB,T_1 ;AT PRINT ; lcall 0x403C ;lcall AT LOCATION ; ljmp TEROT1 ;FINISH OFF OUTPUT ; T_1: jnb COB,TXX ;SEE IF LIST SET mov dptr,#SPV ;LOAD BAUD RATE lcall LD_T clr LP ;OUTPUT START BIT lcall TIMER_LOAD ;LOAD AND START THE TIMER mov a,r5 ;GET THE OUTPUT BYTE setb c ;SET CARRY FOR LAST OUTPUT mov r5,#9 ;LOAD TIMER COUNTDOWN ; LTOUT1: rrc a ;ROTATE a jnb TF1,. ;WAIT TILL TIMER READY mov LP,c ;OUTPUT THE BIT lcall TIMER_LOAD ;DO THE NEXT BIT djnz r5,LTOUT1 ;LOOP UNTIL DONE jnb TF1,. ;FIRST STOP BIT lcall TIMER_LOAD jnb TF1,. ;SECOND STOP BIT mov r5,a ;RESTORE r5 ajmp TEROT1 ;BACK TO TEROT ; ;$EJECT TXX: jnb TI,. ;WAIT FOR TRANSMIT READY clr TI mov SBUF,r5 ;SEND OUT THE CHARACTER ; TEROT1: cjne r5,#SCR,Q41 ;SEE IF a CR mov PHEAD,#0x00 ;IF a CR, RESET PHEAD AND ; Q41: cjne r5,#LF,NLC ;SEE IF a LF mov a,NULLCT ;GET THE NULL COUNT jz NLC ;NO NULLS IF ZERO ; TEROT2: mov r5,#NULL ;PUT THE NULL IN THE OUTPUT REGISTER acall TEROT ;OUTPUT THE NULL dec a ;DECREMENT NULL COUNT jnz TEROT2 ;LOOP UNTIL DONE ; NLC: cjne r5,#BS,Q42 ;dec PHEAD IF a BACKSPACE dec PHEAD Q42: cjne r5,#0x20,Q43 ;IS IT a PRINTABLE CHARACTER? Q43: jc Q44 ;DON"T INCREMENT PHEAD IF NOT PRINTABLE inc PHEAD ;BUMP PRINT HEAD Q44: pop DPL ;RESTORE dptr pop DPH pop ACC ;RESTORE ACC ret ;EXIT ; ;END ;$INCLUDE(:F2:BAS52.OUT) ; BCK: acall CSTS ;CHECK STATUS jnc Q491 ;EXIT IF NO CHARACTER ; ;$EJECT ;*************************************************************** ; ;INPUTS a CHARACTER FROM THE SYSTEM CONSOLE. ; ;*************************************************************** ; INCHAR:; jnb BI,Q45 ;CHECK FOR MONITOR (BUBBLE) ; lcall 0x2060 ; ljmp INCH1 ;Q45: jnb CIUB,Q46 ;CHECK FOR USER ; lcall 0x4033 ; ljmp INCH1 Q46: jnb RI,. ;WAIT FOR RECEIVER READY. mov a,SBUF clr RI ;RESET READY clr ACC.7 ;NO BIT 7 ; INCH1: cjne a,#0x13,Q47 setb CNT_S Q47: cjne a,#0x11,Q48 clr CNT_S Q48: cjne a,#CNTRLC,Q49 jnb NO_C,C_EX ;TRAP NO CONTROL c ret ; Q49: clr JKBIT cjne a,#0x17,CI_RET ;CONTROL W setb JKBIT ; CI_RET: setb c ;CARRY SET IF a CHARACTER Q491: ret ;EXIT ; ;************************************************************* ; ;RROM - The Statement Action Routine RROM ; ;************************************************************* ; ;RROM: setb INBIT ;SO NO ERRORS ; acall RO1 ;FIND THE LINE NUMBER ; jbc INBIT,CRUN ; ret ;EXIT ; ;$EJECT ;*************************************************************** ; CSTS: ; RETURNS CARRY = 1 IF THERE IS a CHARACTER WAITING FROM ; THE SYSTEM CONSOLE. IF NO CHARACTER THE READY CHARACTER ; WILL BE CLEARED ; ;*************************************************************** ; ; jnb BI,.+6 ;BUBBLE STATUS ; ljmp 0x2068 ; jnb CIUB,.+6 ;SEE IF EXTERNAL CONSOLE ; ljmp 0x4036 mov c,RI ret ; Q926: mov dptr,#WB ;EGO MESSAGE acall ROM_P ; C_EX: clr CNT_S ;NO OUTPUT STOP acall SPRINT4 ;ASSURE CONSOLE acall CRLF jbc JKBIT,Q926 ; jnb DIRF,xx3 ljmp CL3 ;CLEAR COB AND EXIT xx3: ajmp SSTOP0 ; T_CMP: mov a,TVH ;COMPARE TIMER TO SP_H AND SP_L mov r1,TVL cjne a,TVH,T_CMP xch a,r1 subb a,SP_L mov a,r1 subb a,SP_H ret ; ;************************************************************* ; BR0: ; Trap the timer interrupt ; ;************************************************************* ; acall T_CMP ;COMPARE TIMER jc BCHR_6 ;EXIT IF TEST FAILS setb OTI ;DOING THE TIMER INTERRUPT clr OTS ;CLEAR TIMER BIT mov c,INPROG ;SAVE IN PROGRESS mov ISAV,c mov dptr,#TIV ajmp BR2 ; ;$EJECT ;*************************************************************** ; ; The command action routine - RUN ; ;*************************************************************** ; CRUN: acall RCLEAR_2 ;CLEAR THE STORAGE ARRAYS acall SRESTR_2 ;GET THE STARTING ADDRESS acall B_C jz CMNDLK ;IF NULL GO TO COMMAND MODE ; lcall T_DP lcall B_TXA ;BUMP TO STARTING LINE ; CILOOP: acall SP0 ;DO a CR AND a LF ILOOP_2: clr DIRF ;NOT IN DIRECT MODE ; ;INTERPERTER DRIVER ; ILOOP: mov SP,SPSAV ;RESTORE THE STACK EACH TIME jb DIRF,Q50 ;NO INTERRUPTS IF IN DIRECT MODE mov INTXAH,TXAH ;SAVE THE TEXT POINTER mov INTXAL,TXAL Q50: acall BCK ;GET CONSOLE STATUS jb DIRF,I_L ;DIRECT MODE anl c,/GTRD ;SEE IF CHARACTER READY jnc BCHR ;NO CHARACTER = NO CARRY ; ; DO TRAP OPERATION ; mov dptr,#GTB ;SAVE TRAP CHARACTER movx @dptr,a setb GTRD ;SAYS READ a BYTE ; BCHR: jb OTI,I_L ;EXIT IF TIMER INTERRUPT IN PROGRESS jb OTS,BR0 ;TEST TIMER VALUE IF SET BCHR_6: jnb INTPEN,I_L ;SEE IF INTERRUPT PENDING jb INPROG,I_L ;DON"T DO IT AGAIN IF IN PROGRESS mov dptr,#INTLOC ;POINT AT INTERRUPT LOCATION ; BR2: mov r4,#GTYPE ;SETUP FOR a FORCED GOSUB acall SGS1 ;PUT TXA ON STACK setb INPROG ;INTERRUPT IN PROGRESS ; ERL4: lcall L20DPI ajmp D_L1 ;GET THE LINE NUMBER ; I_L: acall ISTAT ;LOOP lcall CLN_UP ;FINISH IT OFF jnc ILOOP ;LOOP ON THE DRIVER jnb DIRF,CMNDLK ;CMND1 IF IN RUN MODE ljmp CMNDR ;DON"T PRINT READY ; CMNDLK: ljmp CMND1 ;DONE ;$EJECT ;************************************************************** ; ; The Statement Action Routine - STOP ; ;************************************************************** ; SSTOP: lcall CLN_UP ;FINISH OFF THIS LINE mov INTXAH,TXAH ;SAVE TEXT POINTER FOR CONT mov INTXAL,TXAL ; SSTOP0: setb CONB ;CONTINUE WILL WORK mov dptr,#STP ;PRINT THE STOP MESSAGE setb STOPBIT ;SET FOR ERROR ROUTINE ljmp ERRS ;JUMP TO ERROR ROUTINE ; ;$EJECT ;************************************************************** ; ; ITRAP - Trap special function register operators ; ;************************************************************** ; ITRAP: cjne a,#TMR0,Q51 ;TIMER 0 mov TH0,r3 mov TL0,r1 ret ; Q51: cjne a,#TMR1,Q52 ;TIMER 1 mov TH1,r3 mov TL1,r1 ret ; Q52: cjne a,#TMR2,Q53 ;TIMER 2 mov TH2, r3 mov TL2, r1 ret ; Q53: cjne a,#TRC2,Q54 ;RCAP2 TOKEN RCL: mov RCAP2H, r3 mov RCAP2L, r1 ret ; Q54: acall R3CK ;MAKE SURE THAT r3 IS ZERO cjne a,#TT2C,Q55 mov T2CON, r1 ret ; Q55: cjne a,#T_IE,Q56 ;IE TOKEN mov IE,r1 ret ; Q56: cjne a,#T_IP,Q57 ;IP TOKEN mov IP,r1 ret ; Q57: cjne a,#TTC,Q58 ;TCON TOKEN mov TCON,r1 ret ; Q58: cjne a,#TTM,Q59 ;TMOD TOKEN mov TMOD,r1 ret ; Q59: cjne a,#T_P1,Q591 ;P1 TOKEN mov P1,r1 ret Q591: cjne a,#T_P3,T_T2 ;P3 TOKEN mov P3,r1 ret ; ;*************************************************************** ; ; T_TRAP - Trap special operators ; ;*************************************************************** ; T_T: mov TEMP5,a ;SAVE THE TOKEN lcall GCI1 ;BUMP POINTER acall SLET2 ;EVALUATE AFTER = mov a,TEMP5 ;GET THE TOKEN BACK cjne a,#T_XTAL,Q60 ljmp AXTAL1 ;SET UP CRYSTAL ; Q60: lcall IFIXL ;r3:r1 HAS THE TOS mov a,TEMP5 ;GET THE TOKEN AGAIN cjne a,#T_MTOP,T_T1 ;SEE IF MTOP TOKEN mov dptr,#MEMTOP lcall S31DP ajmp RCLEAR ;CLEAR THE MEMORY ; T_T1: cjne a,#T_TIME,ITRAP ;SEE IF a TIME TOKEN mov c,EA ;SAVE INTERRUPTS clr EA ;NO TIMER 0 INTERRUPTS DURING LOAD mov TVH,r3 ;SAVE THE TIME mov TVL,r1 mov EA,c ;RESTORE INTERRUPTS ret ;EXIT ; T_T2: cjne a,#T_PC,INTERX ;PCON TOKEN mov PCON, r1 ret ;EXIT ; T_TRAP: cjne a,#T_ASC,T_T ;SEE IF ASC TOKEN lcall IGC ;EAT IT AND GET THE NEXT CHARACTER cjne a,#'$',INTERX ;ERROR IF NOT a STRING acall CSY ;CALCULATE ADDRESS lcall X3120 lcall TWO_EY acall SPEOP_4 ;EVALUATE AFTER EQUALS ajmp ISTAX1 ;SAVE THE CHARACTER ; ;$EJECT ;************************************************************** ; ;INTERPERT THE STATEMENT POINTED TO BY TXAL AND TXAH ; ;************************************************************** ; ISTAT: lcall GC ;GET THR FIRST CHARACTER ; jnb XBIT,IAT ;TRAP TO EXTERNAL RUN PACKAGE ; cjne a,#0x20,Q61 ;Q61: jnc IAT ; lcall 0x2070 ;LET THE USER SET UP THE dptr ; lcall GCI1 ; anl a,#0x0F ;STRIP OFF BIAS ; ljmp ISTA1 ; IAT: cjne a,#T_XTAL,Q62 Q62: jnc T_TRAP cjne a,#T_P1B, Q631 ajmp P1B_R Q631: cjne a,#T_P3B, Q632 ajmp P3B_R Q632: jnb ACC.7,GSLET ;IMPLIED LET IF BIT 7 NOT SET cjne a,#T_UOP+12,ISTAX ;DBYTE TOKEN acall SPEOP ;EVALUATE SPECIAL OPERATOR acall R3CK ;CHECK LOCATION mov @r1,a ;SAVE IT ret GSLET: ajmp SLET ; ISTAX: cjne a,#T_UOP+13,ISTAY ;XBYTE TOKEN acall SPEOP ; ISTAX1: mov P2,r3 movx @r1,a ret ; ISTAY: cjne a,#T_CR+1,Q63 ;TRAP NEW OPERATORS Q63: jc I_S cjne a,#0xB0,Q64 ;SEE IF TOO BIG Q64: jnc INTERX add a,#0xF9 ;BIAS FOR LOOKUP TABLE ajmp ISTA0 ;DO THE OPERATION ; I_S: cjne a,#T_LAST,Q65 ;MAKE SURE AN INITIAL RESERVED WORD Q65: jc Q66 ;ERROR IF NOT ; INTERX: ljmp E1XX ;SYNTAX ERROR ; Q66: jnb DIRF,ISTA0 ;EXECUTE ALL STATEMENTS IF IN RUN MODE cjne a,#T_DIR,Q67 ;SEE IF ON TOKEN Q67: jc ISTA0 ;OK IF DIRECT cjne a,#T_GOSB+1,Q68 ;SEE IF FOR ajmp ISTA0 ;FOR IS OK Q68: cjne a,#T_REM+1,Q69 ;NEXT IS OK ajmp ISTA0 Q69: cjne a,#T_STOP+6,INTERX ;SO IS REM ; ;$EJECT ISTA0: lcall GCI1 ;ADVANCE THE TEXT POINTER mov dptr,#STATD ;POINT DPTR TO LOOKUP TABLE cjne a,#T_GOTO-3,Q70 ;SEE IF LET TOKEN ajmp ISTAT ;WASTE LET TOKEN Q70: anl a,#0x3f ;STRIP OFF THE GARBAGE ; ISTA1: rl a ;ROTATE FOR OFFSET add a,DPL ;BUMP mov DPL,a ;SAVE IT jnc Q823 inc DPH Q823: clr a movc a,@a+dptr ;GET HIGH BYTE push ACC ;SAVE IT inc dptr clr a movc a,@a+dptr ;GET LOW BYTE pop DPH mov DPL,a ; AC1: clr a jmp @a+dptr ;GO DO IT ; ; ; ; code to write an arbitrary bit to a port ; ; P3B_R: lcall GCI1 ;BUMP POINTER mov r7,#T_LPAR ;WASTE THE open paren acall EATC lcall ONE ;GET THE NEXT EXPRESSION mov a,r1 ;CHECK FOR BOUNDS push acc mov r7,#')' ;WASTE THE open paren acall EATC acall SLET2 ;EVALUATE AFTER = lcall IFIXL ;r3:r1 HAS THE TOS rrc a pop acc jb acc.2, aP3_4 jb acc.1, aP3_2 jb acc.0, aP3_1 mov P3.0, c ret aP3_1: mov P3.1, c ret aP3_2: jb acc.0, aP3_3 mov P3.2, c ret aP3_3: mov P3.3, c ret aP3_4: jb acc.1, aP3_6 jb acc.0, aP3_5 mov P3.4, c ret aP3_5: mov P3.5, c ret aP3_6: jb acc.0, aP3_7 mov P3.6, c ret aP3_7: mov P3.7, c ret P1B_R: lcall GCI1 ;BUMP POINTER mov r7,#T_LPAR ;WASTE THE open paren acall EATC lcall ONE ;GET THE NEXT EXPRESSION mov a,r1 push acc mov r7,#')' ;WASTE THE open paren acall EATC acall SLET2 ;EVALUATE AFTER = lcall IFIXL ;r3:r1 HAS THE TOS rrc a pop acc jb acc.2, aP1_4 jb acc.1, aP1_2 jb acc.0, aP1_1 mov P1.0, c ret aP1_1: mov P1.1, c ret aP1_2: jb acc.0, aP1_3 mov P1.2, c ret aP1_3: mov P1.3, c ret aP1_4: jb acc.1, aP1_6 jb acc.0, aP1_5 mov P1.4, c ret aP1_5: mov P1.5, c ret aP1_6: jb acc.0, aP1_7 mov P1.6, c ret aP1_7: mov P1.7, c ret ;$EJECT ;*************************************************************** ; ; The statement action routine - LET ; ;*************************************************************** ; SLET: lcall S_C ;CHECK FOR POSSIBLE STRING jc SLET0 ;NO STRING clr LINEB ;USED STRINGS ; lcall X31DP ;PUT ADDRESS IN dptr mov r7,#T_EQU ;WASTE = acall EATC lcall GC ;GET THE NEXT CHARACTER cjne a,#'"',S_3 ;CHECK FOR a " mov r7,S_LEN ;GET THE STRING LENGTH ; S_0: lcall GCI1 ;BUMP PAST " lcall DELTST ;CHECK FOR DELIMITER jz GIN ;EXIT IF CARRIAGE RETURN movx @dptr,a ;SAVE THE CHARACTER cjne a,#'"',S_1 ;SEE IF DONE ; S_E: mov a,#SCR ;PUT a CR IN a movx @dptr,a ;SAVE CR ljmp GCI1 GIN: ajmp GIN ; S_3: push DPH push DPL ;SAVE DESTINATION lcall S_C ;CALCULATE SOURCE jc GIN ;ERROR IF CARRY pop R0B0 ;GET DESTINATION BACK pop R2B0 ; SSOOP: mov r7,S_LEN ;SET UP COUNTER ; S_4: lcall TBYTE ;TRANSFER THE BYTE cjne a,#SCR,Q72 ;EXIT IF a CR ret Q72: djnz r7,S_5 ;BUMP COUNTER mov a,#SCR ;SAVE a CR movx @r0,a ljmp EIGP ;PRINT EXTRA IGNORED ; ;$EJECT ; S_5: lcall INC3210 ;BUMP POINTERS ajmp S_4 ;LOOP ; S_1: djnz r7,Q73 ;SEE IF DONE acall S_E lcall EIGP ;PRINT EXTRA IGNORED ljmp FINDCR ;GO FIND THE END Q73: inc dptr ;BUMP THE STORE POINTER ajmp S_0 ;CONTINUE TO LOOP ; E3XX: mov dptr,#E3X ;BAD ARG ERROR ajmp EK ; SLET0: acall SLET1 ljmp POPAS ;COPY EXPRESSION TO VARIABLE ; SLET1: lcall VAR_ER ;CHECK FOR a"VARIABLE" ; SLET2: push R2B0 ;SAVE THE VARIABLE ADDRESS push R0B0 mov r7,#T_EQU ;GET EQUAL TOKEN lcall WE pop R1B0 ;pop VARIABLE TO r3:r1 pop R3B0 ret ;EXIT ; R3CK: cjne r3,#0x00,E3XX ;CHECK TO SEE IF r3 IS ZERO ret ; SPEOP: lcall GCI1 ;BUMP TXA acall P_E ;EVALUATE PAREN SPEOP_4: acall SLET2 ;EVALUATE AFTER = lcall TWOL ;r7:r6 GETS VALUE, r3:r1 GETS LOCATION mov a,r6 ;SAVE THE VALUE ; cjne r7,#0x00,E3XX ;r2 MUST BE = 0 ret ; ;$EJECT ;************************************************************** ; ; ST_CAL - Calculate string Address ; ;************************************************************** ; IST_CAL:; ; lcall I_PI ;BUMP TEXT, THEN EVALUATE acall R3CK ;ERROR IF r3 <> 0 inc r1 ;BUMP FOR OFFSET mov a,r1 ;ERROR IF r1 = 255 jz E3XX mov dptr,#VARTOP ;GET TOP OF VARIABLE STORAGE mov B,S_LEN ;MULTIPLY FOR LOCATION acall VARD ;CALCULATE THE LOCATION mov dptr,#MEMTOP ;SEE IF BLEW IT lcall FUL1 mov DPL,S_LEN ;GET STRING LENGTH, DPH = 0x00 mov DPH, #0 ;DPH = 0 ; DUBSUB: clr c mov a,r1 subb a,DPL mov r1,a mov a,r3 subb a,DPH mov r3,a orl a,r1 ret ; ;*************************************************************** ; ;VARD - Calculate the offset base ; ;*************************************************************** ; VARB: mov B,#FPSIZ ;SET UP FOR OPERATION ; VARD: lcall LdptrI ;LOAD DPTR mov a,r1 ;MULTIPLY BASE mul ab add a,DPL mov r1,a mov a,B addc a,DPH mov r3,a ret ; ;$EJECT ;************************************************************* ; CSY: ; Calculate a biased string address and put in r3:r1 ; ;************************************************************* ; acall IST_CAL ;CALCULATE IT push R3B0 ;SAVE IT push R1B0 mov r7,#',' ;WASTE THE COMMA acall EATC lcall ONE ;GET THE NEXT EXPRESSION mov a,r1 ;CHECK FOR BOUNDS cjne a,S_LEN,Q74 Q74: jnc Q775 ;MUST HAVE a CARRY dec r1 ;BIAS THE POINTER pop ACC ;GET VALUE LOW add a,r1 ;add IT TO BASE mov r1,a ;SAVE IT pop R3B0 ;GET HIGH ADDRESS jnc Q75 ;PROPAGATE THE CARRY inc r3 Q75: ajmp ERPAR ;WASTE THE RIGHT PAREN Q775: ajmp E3XX ; ;$EJECT ;*************************************************************** ; ; The statement action routine FOR ; ;*************************************************************** ; SFOR: acall SLET1 ;SET UP CONTROL VARIABLE push R3B0 ;SAVE THE CONTROL VARIABLE LOCATION push R1B0 lcall POPAS ;pop ARG STACK AND COPY CONTROL VAR mov r7,#T_TO ;GET TO TOKEN lcall WE lcall GC ;GET NEXT CHARACTER cjne a,#T_STEP,SF2 lcall GCI1 ;EAT THE TOKEN lcall EXPRB ;EVALUATE EXPRESSION ajmp Q76 ;JUMP OVER ; SF2: lcall PUSH_ONE ;PUT ONE ON THE STACK ; Q76: mov a,#(-FSIZE)&0xff;ALLOCATE FSIZE BYTES ON THE CONTROL STACK acall PUSHCS ;GET CS IN r0 acall CSC ;CHECK CONTROL STACK mov r3,#CSTKAH ;IN CONTROL STACK mov r1,R0B0 ;STACK ADDRESS lcall POPAS ;PUT STEP ON STACK lcall POPAS ;PUT LIMIT ON STACK lcall DP_T ;dptr GETS TEXT mov r0,R1B0 ;GET THE POINTER acall T_X_S ;SAVE THE TEXT pop TXAL ;GET CONTROL VARIABLE pop TXAH mov r4,#FTYPE ;AND THE TYPE acall T_X_S ;SAVE IT ; SF3: lcall T_DP ;GET THE TEXT POINTER ajmp ILOOP ;CONTINUE TO PROCESS ; ;$EJECT ;************************************************************** ; ; The statement action routines - push and pop ; ;************************************************************** ; SPUSH: lcall EXPRB ;PUT EXPRESSION ON STACK lcall C_TST ;SEE IF MORE TO DO jnc SPUSH ;IF a COMMA push ANOTHER ret ; ; SPOP: lcall VAR_ER ;GET VARIABLE lcall XPOP ;FLIP THE REGISTERS FOR POPAS lcall C_TST ;SEE IF MORE TO DO jnc SPOP ; Q950: ret ; ;*************************************************************** ; ; The statement action routine - IF ; ;*************************************************************** ; SIF: acall RTST ;EVALUATE THE EXPRESSION mov r1,a ;SAVE THE RESULT lcall GC ;GET THE CHARACTER AFTER EXPR cjne a,#T_THEN,Q78 ;SEE IF THEN TOKEN lcall GCI1 ;WASTE THEN TOKEN Q78: cjne r1,#0,T_F1 ;CHECK R_OP RESULT ; E_FIND: mov r7,#T_ELSE ;FIND ELSE TOKEN lcall FINDC jz Q950 ;EXIT IF a CR lcall GCI1 ;BUMP PAST TOKEN cjne a,#T_ELSE,E_FIND;WASTE IF NO ELSE ; T_F1: lcall INTGER ;SEE IF NUMBER jnc D_L1 ;EXECUTE LINE NUMBER ajmp ISTAT ;EXECUTE STATEMENT IN NOT ; B_C: movx a,@dptr dec a jb ACC.7,Q6 ret ; ;$EJECT ;*************************************************************** ; ; The statement action routine - GOTO ; ;*************************************************************** ; SGOTO: acall RLINE ;r2:r0 AND dptr GET INTGER ; SGT1: lcall T_DP ;TEXT POINTER GETS dptr ; jbc RETBIT,SGT2 ;SEE IF reti EXECUTED ; jnb LINEB,SGT2 ;SEE IF a LINE WAS EDITED acall RCLEAR_2 ;CLEAR THE MEMORY IF SET ajmp ILOOP_2 ;CLEAR DIRF AND LOOP ; SGT2: jbc OTI,Q79 ;SEE IF TIMER INTERRUPT anl 34,#0xBD ;CLEAR INTERRUPTS ajmp ILOOP ;EXECUTE Q79: mov c,ISAV mov INPROG,c ajmp ILOOP ;RESTORE INTERRUPTS AND ret ; ; ;************************************************************* ; RTST: ; Test for ZERO ; ;************************************************************* ; lcall EXPRB ;EVALUATE EXPRESSION lcall INC_ASTKA ;BUMP ARG STACK jz Q80 ;EXIT WITH ZERO OR 0xff mov a,#0xff Q80: ret ; ;$EJECT ; ;************************************************************** ; ; GLN - get the line number in r2:r0, return in dptr ; ;************************************************************** ; GLN: lcall DP_B ;GET THE BEGINNING ADDRESS ; FL1: movx a,@dptr ;GET THE LENGTH mov r7,a ;SAVE THE LENGTH djnz r7,FL3 ;SEE IF END OF FILE ; Q6: mov dptr,#E10X ;NO LINE NUMBER ajmp EK ;HANDLE THE ERROR ; D_L1: acall GLN ;GET THE LINE ajmp SGT1 ;EXECUTE THE LINE ; FL3: jb ACC.7,Q6 ;CHECK FOR BIT 7 inc dptr ;POINT AT HIGH BYTE movx a,@dptr ;GET HIGH BYTE cjne a,R2B0,FL2 ;SEE IF MATCH inc dptr ;BUMP TO LOW BYTE dec r7 ;ADJUST AGAIN movx a,@dptr ;GET THE LOW BYTE cjne a,R0B0,FL2 ;SEE IF LOW BYTE MATCH inc dptr ;POINT AT FIRST CHARACTER ret ;FOUND IT ; FL2: mov a,r7 ;GET THE LENGTH COUNTER lcall ADdptr ;add a TO DATA POINTER ajmp FL1 ;LOOP ; ; ;************************************************************* ; ;RLINE - Read in ASCII string, get line, and clean it up ; ;************************************************************* ; RLINE: lcall INTERR ;GET THE INTEGER ; RL1: acall GLN ljmp CLN_UP ; ; ;$EJECT ;*************************************************************** ; ; The statement action routines WHILE and UNTIL ; ;*************************************************************** ; SWHILE: acall RTST ;EVALUATE RELATIONAL EXPRESSION cpl a ajmp S_WU ; SUNTIL: acall RTST ;EVALUATE RELATIONAL EXPRESSION ; S_WU: mov r4,#DTYPE ;DO EXPECTED mov r5,a ;SAVE R_OP RESULT ajmp SR0 ;GO PROCESS ; ; ;*************************************************************** ; CNULL: ; The Command Action Routine - NULL ; ;*************************************************************** ; lcall INTERR ;GET AN INTEGER FOLLOWING NULL mov NULLCT,r0 ;SAVE THE NULLCOUNT ajmp CMNDLK ;JUMP TO COMMAND MODE ; ;$EJECT ;*************************************************************** ; ; The statement action routine - reti ; ;*************************************************************** ; SRETI: setb RETBIT ;SAYS THAT reti HAS BEEN EXECUTED ; ;*************************************************************** ; ; The statement action routine - RETURN ; ;*************************************************************** ; SRETRN: mov r4,#GTYPE ;MAKE SURE OF GOSUB mov r5,#0x55 ;TYPE RETURN TYPE ; SR0: acall CSETUP ;SET UP CONTROL STACK movx a,@r0 ;GET RETURN TEXT ADDRESS mov DPH,a inc r0 movx a,@r0 mov DPL,a inc r0 ;pop CONTROL STACK movx a,@dptr ;SEE IF GOSUB WAS THE LAST STATEMENT cjne a,#EOF,Q81 ajmp CMNDLK Q81: mov a,r5 ;GET TYPE jz QQ99 ;EXIT IF ZERO mov CSTKA,r0 ;pop THE STACK cpl a ;OPTION TEST, 0x00, 0x55, 0xff, NOW 0x55 jnz QQ99 ;MUST BE GOSUB ret ;NORMAL FALL THRU EXIT FOR NO MATCH QQ99: ajmp SGT1 ; ;$EJECT ;*************************************************************** ; ; The statement action routine - GOSUB ; ;*************************************************************** ; SGOSUB: acall RLINE ;NEW TXA IN dptr ; SGS0: mov r4,#GTYPE acall SGS1 ;SET EVERYTHING UP ajmp SF3 ;EXIT ; SGS1: mov a,#(-3)&0xff ;ALLOCATE 3 BYTES ON CONTROL STACK acall PUSHCS ; T_X_S: mov P2,#CSTKAH ;SET UP PORT FOR CONTROL STACK mov a,TXAL ;GET RETURN ADDRESS AND SAVE IT movx @r0,a dec r0 mov a,TXAH movx @r0,a dec r0 mov a,r4 ;GET TYPE movx @r0,a ;SAVE TYPE ret ;EXIT ; ; CS1: mov a,#3 ;pop 3 BYTES acall PUSHCS ; CSETUP: mov r0,CSTKA ;GET CONTROL STACK mov P2,#CSTKAH movx a,@r0 ;GET BYTE cjne a,R4B0,Q82 ;SEE IF TYPE MATCH inc r0 ret Q82: jz E4XX ;EXIT IF STACK UNDERFLOW cjne a,#FTYPE,CS1 ;SEE IF FOR TYPE acall PUSHCS_2 ;WASTE THE FOR TYPE ajmp CSETUP ;LOOP ; ;$EJECT ;*************************************************************** ; ; The statement action routine - NEXT ; ;*************************************************************** ; SNEXT: mov r4,#FTYPE ;FOR TYPE acall CSETUP ;SETUP CONTROL STACK mov TEMP5,r0 ;SAVE CONTROL VARIABLE ADDRESS mov r1,#TEMP1 ;SAVE VAR + RETURN IN TEMP1-4 ; XXI: movx a,@r0 ;LOOP UNTIL DONE mov @r1,a inc r1 inc r0 cjne r1,#TEMP5,XXI ; lcall VAR ;SEE IF THE USER HAS a VARIABLE jnc Q83 mov r2,TEMP1 mov r0,TEMP2 Q83: mov a,r2 ;SEE IF VAR"S AGREE cjne a,TEMP1,E4XX mov a,r0 cjne a,TEMP2,E4XX lcall PUSHAS ;PUT CONTROL VARIABLE ON STACK mov a,#FPSIZ+FPSIZ+2;COMPUTE ADDRESS TO STEP VALUE SIGN add a,TEMP5 ;add IT TO BASE OF STACK mov r0,a ;SAVE IN r0 mov r2,#CSTKAH ;SET UP TO push STEP VALUE mov P2,r2 ;SET UP PORT movx a,@r0 ;GET SIGN inc r0 ;BACK TO EXPONENT push ACC ;SAVE SIGN OF STEP lcall PUSHAS ;PUT STEP VALUE ON STACK push R0B0 ;SAVE LIMIT VALUE LOCATION lcall AADD ;add STEP VALUE TO VARIABLE lcall CSTAKA ;COPY STACK mov r3,TEMP1 ;GET CONTROL VARIABLE mov r1,TEMP2 lcall POPAS ;SAVE THE RESULT mov r2,#CSTKAH ;RESTORE LIMIT LOCATION pop R0B0 lcall PUSHAS ;PUT LIMIT ON STACK lcall FLOATING_COMP ;DO THE COMPARE pop ACC ;GET LIMIT SIGN BACK jz Q84 ;IF SIGN NEGATIVE, TEST "BACKWARDS" cpl c Q84: orl c,F0 ;SEE IF EQUAL jc N4 ;STILL SMALLER THAN LIMIT? PUSHCS_2: mov a,#FSIZE ;REmovE CONTROL STACK ENTRY ; ; Fall thru to PUSHCS ; ;$EJECT ;*************************************************************** ; ; PUSHCS - push frame onto control stack ; acc has - number of bytes, also test for overflow ; ;*************************************************************** ; PUSHCS: add a,CSTKA ;BUMP CONTROL STACK cjne a,#(CONVT+17)&0xff,Q85 ;SEE IF OVERFLOWED Q85: jc E4XX ;EXIT IF STACK OVERFLOW xch a,CSTKA ;STORE NEW CONTROL STACK VALUE, GET OLD dec a ;BUMP OLD VALUE mov r0,a ;PUT OLD-1 IN r0 ; Q951: ret ;EXIT ; CSC: lcall CLN_UP ;FINISH OFF THE LINE jnc Q951 ;EXIT IF NO TERMINATOR ; E4XX: mov dptr,#EXC ;CONTROL STACK ERROR ajmp EK ;STACK ERROR ; N4: mov TXAH,TEMP3 ;GET TEXT POINTER mov TXAL,TEMP4 ajmp ILOOP ;EXIT ; ;*************************************************************** ; ; The statement action routine - RESTORE ; ;*************************************************************** ; SRESTR: acall X_TR ;swap POINTERS SRESTR_2: lcall DP_B ;GET THE STARTING ADDRESS lcall T_DP ;PUT STARTING ADDRESS IN TEXT POINTER lcall B_TXA ;BUMP TXA ; ; Fall thru ; X_TR: ;swap txa and rtxa ; xch a,TXAH xch a,RTXAH xch a,TXAH xch a,TXAL xch a,RTXAL xch a,TXAL ret ;EXIT ; ;$EJECT ;*************************************************************** ; ; The statement action routine - READ ; ;*************************************************************** ; SREAD: acall X_TR ;swap POINTERS ; SRD0: lcall C_TST ;CHECK FOR COMMA jc SRD4 ;SEE WHAT IT IS ; SRD: lcall EXPRB ;EVALUATE THE EXPRESSION lcall GC ;GET THE CHARACTER AFTER EXPRESSION cjne a,#',',SRD1 ;SEE IF MORE DATA ajmp SRD2 ;BYBASS CLEAN UP IF a COMMA ; SRD1: lcall CLN_UP ;FINISH OFF THE LINE, IF AT END ; SRD2: acall X_TR ;RESTORE POINTERS lcall VAR_ER ;GET VARIABLE ADDRESS lcall XPOP ;FLIP THE REGISTERS FOR POPAS lcall C_TST ;SEE IF a COMMA jnc SREAD ;READ AGAIN IF a COMMA Q957: ret ;EXIT IF NOT ; SRD4: cjne a,#T_DATA,SRD5 ;SEE IF DATA lcall GCI1 ;BUMP POINTER ajmp SRD ; SRD5: cjne a,#EOF,SRD6 ;SEE IF YOU BLEW IT Q734: acall X_TR ;GET THE TEXT POINTER BACK mov dptr,#E14X ;READ ERROR ; EK: ljmp ERROR ; SRD6: lcall FINDCR ;WASTE THIS LINE lcall CLN_UP ;CLEAN IT UP jc Q734 ;ERROR IF AT END ajmp SRD0 ; NUMC: lcall GC ;GET a CHARACTER cjne a,#'#',NUMC1 ;SEE IF a # setb COB ;VALID LINE PRINT ljmp IGC ;BUMP THE TEXT POINTER ; NUMC1: cjne a,#'@',Q957 ;EXIT IF NO GOOD setb LPB ljmp IGC ; ;$EJECT ;*************************************************************** ; ; The statement action routine - PRINT ; ;*************************************************************** ; SPH0: setb ZSURP ;NO ZEROS ; SPH1: setb HMODE ;HEX MODE ; SPRINT: acall NUMC ;TEST FOR a LINE PRINT acall Q86 ;PROCEED SPRINT4:anl 35,#0xf5 ;CLEAR COB AND LPB anl 38,#0x3f ;NO HEX MODE ; ret ; Q86: lcall DELTST ;CHECK FOR a DELIMITER jc SP1 ; SP0: ajmp CRLF ;EXIT WITH a CR IF SO ; SP2: lcall C_TST ;CHECK FOR a COMMA jc SP0 ;EXIT IF NO COMMA ; SP1: lcall CPS ;SEE IF a STRING TO PRINT jnc SP2 ;IF a STRING, CHECK FOR a COMMA ; SP4: cjne a,#T_TAB,SP6 lcall I_PI ;ALWAYS CLEARS CARRY subb a,PHEAD ;TAKE DELTA BETWEEN TAB AND PHEAD jc SP2 ;EXIT IF PHEAD > TAB ajmp SP7 ;OUTPUT SPACES ; SP6: cjne a,#T_SPC,SM lcall I_PI ;SET UP PAREN VALUE ; SP7: jz SP2 acall STEROT ;OUTPUT a SPACE dec a ;DECREMENT COUNTER ajmp SP7 ;LOOP ; ;$EJECT SM: cjne a,#T_CHR,SP8 lcall IGC cjne a,#'$',Q87 lcall CNX ;PUT THE CHARACTER ON THE STACK lcall IFIXL ;PUT THE CHARACTER IN r1 ajmp Q88 Q87: lcall ONE ;EVALUATE THE EXPRESSION, PUT IN r3:r1 acall ERPAR Q88: mov r5,R1B0 ;BYTE TO OUTPUT ajmp SQ ; SP8: cjne a,#T_CR,SX lcall GCI1 ;EAT THE TOKEN mov r5,#SCR ; SQ: acall TEROT ajmp SP2 ;OUTPUT a CR AND DO IT AGAIN ; SX: cjne a,#T_USE,SP9 ;USING TOKEN lcall IGC ;GE THE CHARACTER AFTER THE USING TOKEN cjne a,#'F',U4 ;SEE IF FLOATING mov FORMAT,#0xf0 ;SET FLOATING lcall IGC ;BUMP THE POINTER AND GET THE CHARACTER lcall GCI1 ;BUMP IT AGAIN anl a,#0x0F ;STRIP OFF ASCII BIAS jz U3 ;EXIT IF ZERO cjne a,#3,Q89 ;SEE IF AT LEAST a THREE Q89: jnc U3 ;FORCE a THREE IF NOT a THREE mov a,#3 ; U3: orl FORMAT,a ;PUT DIGIT IN FORMAT ajmp U8 ;CLEAN UP END ; U4: cjne a,#'0',U5 mov FORMAT,#0 ;FREE FORMAT lcall GCI1 ;BUMP THE POINTER ajmp U8 ; U5: cjne a,#'#',U8 ;SEE IF INTGER FORMAT acall U6 mov FORMAT,r7 ;SAVE THE FORMAT cjne a,#'.',U8A ;SEE IF TERMINATOR WAS RADIX lcall IGC ;BUMP PAST . acall U6 ;LOOP AGAIN mov a,r7 ;GET COUNT add a,FORMAT ;SEE IF TOO BIG add a,#0xF7 jnc U5A ; ;$EJECT SE0: ajmp INTERX ;ERROR, BAD SYNTAX ; U5A: mov a,r7 ;GET THE COUNT BACK swap a ;ADJUST orl FORMAT,a ;GET THE COUNT ; U8A: mov a,FORMAT ; U8B: swap a ;GET THE FORMAT RIGHT mov FORMAT,a ; U8: acall ERPAR ajmp SP2 ;DONE ; U6: mov r7,#0 ;SET COUNTER ; U7: cjne a,#'#',SP9A ;EXIT IF NOT a # inc r7 ;BUMP COUNTER lcall IGC ;GET THE NEXT CHARACTER ajmp U7 ;LOOP ; SP9: lcall DELTST_2 ;CHECK FOR DELIMITER jnc SP9A ;EXIT IF a DELIMITER ; cjne a,#T_ELSE,SS ; SP9A: ret ;EXIT IF ELSE TOKEN ; ;************************************************************** ; ; P_E - Evaluate an expression in parens ( ) ; ;************************************************************** ; P_E: mov r7,#T_LPAR lcall WE ; ERPAR: mov r7,#')' ;EAT a RIGHT PAREN ; EATC: lcall GCI ;GET THE CHARACTER cjne a,R7B0,SE0 ;ERROR IF NOT THE SAME ret ; ;$EJECT ;*************************************************************** ; S_ON: ; ON Statement ; ;*************************************************************** ; lcall ONE ;GET THE EXPRESSION lcall GCI ;GET THE NEXT CHARACTER cjne a,#T_GOTO,XXC0 acall XXC1 ;EAT THE COMMAS ajmp SF3 ;DO GOTO ; XXC0: cjne a,#T_GOSB,SE0 acall XXC1 ajmp SGS0 ;DO GOSUB ; XXC1: cjne r1,#0,XXC2 lcall INTERR ;GET THE LINE NUMBER lcall FINDCR ajmp RL1 ;FINISH UP THIS LINE ; XXC2: mov r7,#',' lcall FINDC cjne a,#',',SE0 ;ERROR IF NOT a COMMA dec r1 lcall GCI1 ;BUMP PAST COMMA ajmp XXC1 ; ;$EJECT ; SS: lcall S_C ;SEE IF a STRING jc SA ;NO STRING IF CARRY IS SET acall UPRNT ;PUT POINTER IN dptr ajmp SP2 ;SEE IF MORE ; SA: lcall EXPRB ;MUST BE AN EXPRESSION mov a,#72 cjne a,PHEAD,Q90 ;CHECK PHEAD POSITION Q90: jnc Q91 acall SP0 ;FORCE a CRLF Q91: jnb HMODE,S13 ;HEX MODE? lcall FCMP ;SEE IF TOS IS < 0FFFH jc S13 ;EXIT IF GREATER lcall AABS ;GET THE SIGN jnz OOPS ;WASTE IF NEGATIVE lcall IFIXL lcall HEXOUT ;PRINT HEXMODE ajmp SP2 OOPS: lcall ANEG ;MAKE IT NEGATIVE ; S13: lcall FLOATING_POINT_OUTPUT ;DO FP OUTPUT mov a,#1 ;OUTPUT a SPACE ajmp SP7 ; ;$EJECT ;*************************************************************** ; ; ANU - Get variable name from text - set carry if not found ; if succeeds returns variable in r7:r6 ; r6 = 0 if no digit in name ; ;*************************************************************** ; ANU: lcall IGC ;INCREMENT AND GET CHARACTER lcall DIGIT_CHECK ;CHECK FOR DIGIT jc Q92 ;EXIT IF VALID DIGIT cjne a,#'_',AL ;SEE IF a _ ret ; AL: cjne a,#'A',Q93 ;IS IT AN ASCII a? Q93: jc Q94 ;EXIT IF CARRY IS SET cjne a,#'Z'+1,Q92 ;IS IT LESS THAN AN ASCII Z Q92: cpl c ;FLIP CARRY Q94: ret ; Q941: jnb F0,VAR2 ; SD0: mov dptr,#E6X ljmp EK ; SDIMX: setb F0 ;SAYS DOING a DIMENSION ajmp VAR1 ; VAR: clr F0 ;SAYS DOING a VARIABLE ; VAR1: acall GC ;GET THE CHARACTER lcall AL ;CHECK FOR ALPHA jnc Q95 ;ERROR IF IN DIM jb F0,SD0 ret Q95: mov r7,a ;SAVE ALPHA CHARACTER clr a ;ZERO IN CASE OF FAILURE mov r5,a ;SAVE IT ; VY: mov r6,a lcall ANU ;CHECK FOR ALPHA OR NUMBER jc VX ;EXIT IF NO ALPHA OR NUM ; xch a,r7 add a,r5 ;NUMBER OF CHARACTERS IN ALPHABET xch a,r7 ;PUT IT BACK mov r5,#26 ;FOR THE SECOND TIME AROUND ajmp VY ; VX: clr LINEB ;TELL EDITOR a VARIABLE IS DECLARED cjne a,#T_LPAR,V4 ;SEE IF a LEFT PAREN ; orl R6B0,#0x80 ;SET BIT 7 TO SIGINIFY MATRIX lcall F_VAR ;FIND THE VARIABLE push R2B0 ;SAVE THE LOCATION push R0B0 jnc Q941 ;DEFAULT IF NOT IN TABLE jb F0,SDI ;NO DEFAULT FOR DIMENSION mov r1,#10 mov r3,#0 acall D_CHK ; VAR2: acall PAREN_INT ;EVALUATE INTEGER IN PARENS cjne r3,#0,SD0 ;ERROR IF r3<>0 pop DPL ;GET VAR FOR LOOKUP pop DPH movx a,@dptr ;GET DIMENSION dec a ;BUMP OFFSET subb a,r1 ;a MUST BE > r1 jc SD0 lcall DECDP2 ;BUMP POINTER TWICE lcall VARB ;CALCULATE THE BASE ; X3120: xch a,r1 ;swap r2:r0, r3:r1 xch a,r0 xch a,r1 xch a,r3 xch a,r2 xch a,r3 ret ; V4: jb F0,SD0 ;ERROR IF NO LPAR FOR DIM lcall F_VAR ;GET SCALAR VARIABLE clr c ret ; ;$EJECT ; SDI: acall PAREN_INT ;EVALUATE PAREN EXPRESSION cjne r3,#0,SD0 ;ERROR IF NOT ZERO pop R0B0 ;SET UP r2:r0 pop R2B0 acall D_CHK ;DO DIM acall C_TST ;CHECK FOR COMMA jnc SDIMX ;LOOP IF COMMA ret ;RETURN IF NO COMMA ; D_CHK: inc r1 ;BUMP FOR TABLE LOOKUP mov a,r1 jz SD0 ;ERROR IF 0FFFFH mov r4,a ;SAVE FOR LATER mov dptr,#MT_ALL ;GET MATRIX ALLOCATION lcall VARB ;DO THE CALCULATION mov r7,DPH ;SAVE MATRIX ALLOCATION mov r6,DPL mov dptr,#ST_ALL ;SEE IF TOO MUCH MEMORY TAKEN lcall FUL1 ;ST_ALL SHOULD BE > r3:r1 mov dptr,#MT_ALL ;SAVE THE NEW MATRIX POINTER lcall S31DP mov DPL,r0 ;GET VARIABLE ADDRESS mov DPH,r2 mov a,r4 ;DIMENSION SIZE movx @dptr,a ;SAVE IT lcall DECDP2 ;SAVE TARGET ADDRESS ; R76S: mov a,r7 movx @dptr,a inc dptr mov a,r6 ;ELEMENT SIZE movx @dptr,a ret ;r2:r0 STILL HAS SYMBOL TABLE ADDRESS ; ;$EJECT ;*************************************************************** ; ; The statement action routine - INPUT ; ;*************************************************************** ; SINPUT: acall CPS ;PRINT STRING IF THERE ; acall C_TST ;CHECK FOR a COMMA jnc IN2A ;NO CRLF lcall SP0 ;DO a CRLF ; IN2: mov r5,#'?' ;OUTPUT a ? lcall TEROT ; IN2A: setb INP_B ;DOING INPUT lcall INLINE ;INPUT THE LINE clr INP_B mov TEMP5,#IBUF>>8 mov TEMP4,#IBUF&0xff ; IN3: acall S_C ;SEE IF a STRING jc IN3A ;IF CARRY IS SET, NO STRING acall X3120 ;FLIP THE ADDRESSES mov r3,TEMP5 mov r1,TEMP4 lcall SSOOP acall C_TST ;SEE IF MORE TO DO jnc IN2 ret ; IN3A: lcall DTEMP ;GET THE USER LOCATION lcall GET_NUM ;GET THE USER SUPPLIED NUMBER jnz IN5 ;ERROR IF NOT ZERO lcall TEMPD ;SAVE THE DATA POINTER acall VAR_ER ;GET THE VARIABLE acall XPOP ;SAVE THE VARIABLE lcall DTEMP ;GET dptr BACK FROM VAR_ER acall C_TST ;SEE IF MORE TO DO jc IN6 ;EXIT IF NO COMMA movx a,@dptr ;GET INPUT TERMINATOR cjne a,#',',IN5 ;IF NOT a COMMA DO a CR AND TRY AGAIN inc dptr ;BUMP PAST COMMA AND READ NEXT VALUE lcall TEMPD ajmp IN3 ; ;$EJECT ; IN5: mov dptr,#IAN ;PRINT INPUT a NUMBER lcall CRP ;DO a CR, THEN, PRINT FROM ROM ljmp XCC1 ;TRY IT AGAIN ; IN6: movx a,@dptr cjne a,#SCR,EIGP ret ; EIGP: mov dptr,#EIG lcall CRP ;PRINT THE MESSAGE AND EXIT ljmp SP0 ;EXIT WITH a CRLF ; ;*************************************************************** ; SOT: ; On timer interrupt ; ;*************************************************************** ; acall TWO ;GET THE NUMBERS mov SP_H,r3 mov SP_L,r1 mov dptr,#TIV ;SAVE THE NUMBER setb OTS ajmp R76S ;EXIT ; ; ;*************************************************************** ; SCALL: ; Call a user rountine ; ;*************************************************************** ; acall INTERR ;CONVERT INTEGER cjne r2,#0,S_C_1 ;SEE IF TRAP mov a,r0 jb ACC.7,S_C_1 add a,r0 mov dptr,#0x4100 mov DPL,a ; S_C_1: lcall AC1 ;JUMP TO USER PROGRAM anl PSW,#0xe7 ;BACK TO BANK 0 ret ;EXIT ; ;$EJECT ;************************************************************** ; THREE: ; Save value for timer function ; ;************************************************************** ; acall ONE ;GET THE FIRST INTEGER lcall CBIAS ;BIAS FOR TIMER LOAD mov T_HH,r3 mov T_LL,r1 mov r7,#',' ;WASTE a COMMA lcall EATC ;FALL THRU TO TWO ; ;************************************************************** ; TWO: ; Get two values seperated by a comma off the stack ; ;************************************************************** ; acall EXPRB mov r7,#',' ;WASTE THE COMMA acall WE ajmp TWOL ;EXIT ; ;************************************************************* ; ONE: ; Evaluate an expression and get an integer ; ;************************************************************* ; acall EXPRB ;EVALUATE EXPERSSION ; IFIXL: acall IFIX ;INTEGERS IN r3:r1 mov a,r1 ret ; ; ;************************************************************* ; I_PI: ; Increment text pointer then get an integer ; ;************************************************************* ; acall GCI1 ;BUMP TEXT, THEN GET INTEGER ; PAREN_INT:; Get an integer in parens ( ) ; lcall P_E ajmp IFIXL ; ;$EJECT ; DP_B: mov DPH,BOFAH mov DPL,BOFAL ret ; DP_T: mov DPH,TXAH mov DPL,TXAL ret ; Q234: ajmp NOPASS CPS: acall GC ;GET THE CHARACTER cjne a,#'"',Q234 ;EXIT IF NO STRING acall DP_T ;GET TEXT POINTER inc dptr ;BUMP PAST " mov r4,#'"' lcall PN0 ;DO THE PRINT inc dptr ;GO PAST QUOTE clr c ;PASSED TEST ; T_DP: mov TXAH,DPH ;TEXT POINTER GETS dptr mov TXAL,DPL ret ; ;************************************************************* ; S_C: ; Check for a string ; ;************************************************************* ; acall GC ;GET THE CHARACTER cjne a,#'$',NOPASS ;SET CARRY IF NOT a STRING ljmp IST_CAL ;CLEAR CARRY, CALCULATE OFFSET ; ; ; ;************************************************************** ; C_TST: acall GC ;GET a CHARACTER cjne a,#',',NOPASS ;SEE IF a COMMA ; ;$EJECT ;*************************************************************** ; ;GC AND GCI - GET a CHARACTER FROM TEXT (NO BLANKS) ; PUT CHARACTER IN THE ACC ; ;*************************************************************** ; IGC: acall GCI1 ;BUMP POINTER, THEN GET CHARACTER ; GC: setb RS0 ;USE BANK 1 mov P2,r2 ;SET UP PORT 2 movx a,@r0 ;GET EXTERNAL BYTE clr RS0 ;BACK TO BANK 0 ret ;EXIT ; GCI: acall GC ; ; This routine bumps txa by one and always clears the carry ; GCI1: setb RS0 ;BANK 1 inc r0 ;BUMP TXA cjne r0,#0,Q96 inc r2 Q96: clr RS0 ret ;EXIT ; ;$EJECT ;************************************************************** ; ; Check delimiters ; ;************************************************************** ; DELTST: acall GC ;GET a CHARACTER DELTST_2: cjne a,#SCR,DT1 ;SEE IF a CR clr a ret ; DT1: cjne a,#':',NOPASS ;SET CARRY IF NO MATCH ; L_RET: ret ; ; ;*************************************************************** ; ; FINDC - Find the character in r7, update TXA ; ;*************************************************************** ; FINDCR: mov r7,#SCR ;KILL a STATEMENT LINE ; FINDC: acall DELTST jnc L_RET ; cjne a,R7B0,FNDCL2 ;MATCH? ret ; FNDCL2: acall GCI1 ajmp FINDC ;LOOP ; Q987: acall GCI1 ; WCR: acall DELTST ;WASTE UNTIL a "REAL" CR jnz Q987 ret ; ;$EJECT ;*************************************************************** ; ; VAR_ER - Check for a variable, exit if error ; ;*************************************************************** ; VAR_ER: acall VAR ajmp INTERR_2 ; ; ;*************************************************************** ; ; S_D0 - The Statement Action Routine DO ; ;*************************************************************** ; S_DO: lcall CSC ;FINISH UP THE LINE mov r4,#DTYPE ;TYPE FOR STACK lcall SGS1 ;SAVE ON STACK ljmp ILOOP ;EXIT ; ;$EJECT ;*************************************************************** ; ; CLN_UP - Clean up the end of a statement, see if at end of ; file, eat character and line count after CR ; ;*************************************************************** ; C_2: cjne a,#':',C_1 ;SEE IF a TERMINATOR ajmp GCI1 ;BUMP POINTER AND EXIT, IF SO ; C_1: cjne a,#T_ELSE,EP5X acall WCR ;WASTE UNTIL a CR ; CLN_UP: acall GC ;GET THE CHARACTER cjne a,#SCR,C_2 ;SEE IF a CR acall IGC ;GET THE NEXT CHARACTER cjne a,#EOF,B_TXA ;SEE IF TERMINATOR ; NOPASS: setb c ret ; B_TXA: xch a,TXAL ;BUMP TXA BY THREE add a,#3 xch a,TXAL jbc CY,Q97 ret Q97: inc TXAH ret ; ;$EJECT ;*************************************************************** ; ; Get an INTEGER from the text ; sets CARRY if not found ; returns the INTGER value in dptr and r2:r0 ; returns the terminator in ACC ; ;*************************************************************** ; INTERR: acall INTGER ;GET THE INTEGER INTERR_2: jc EP5X ;ERROR IF NOT FOUND ret ;EXIT IF FOUND EP5X: clr c ;NO RECOVERY ljmp E1XX_2 ; INTGER: acall DP_T lcall CONVERT_ASCII_STRING_TO_BINARY ;CONVERT THE INTEGER acall T_DP mov DPH,r2 ;PUT THE RETURNED VALUE IN THE dptr mov DPL,r0 ; ITRET: ret ;EXIT ; ; WE: lcall EATC ;WASTE THE CHARACTER ; ; Fall thru to evaluate the expression ; ;$EJECT ;*************************************************************** ; ; EXPRB - Evaluate an expression ; ;*************************************************************** ; EXPRB: ;mov r2,#OPBOL&0xff ;BASE PRECEDENCE mov r2, #0 ; EP1: push R2B0 ;SAVE OPERATOR PRECEDENCE clr ARGF ;RESET STACK DESIGNATOR ; EP2: mov a,SP ;GET THE STACK POINTER add a,#12 ;NEED AT LEAST 12 BYTES jnc Q296 ljmp ERROR_3 Q296: mov a,ASTKA ;GET THE ARG STACK subb a,#(TM_TOP+12)&0xff;NEED 12 BYTES ALSO jnc Q297 ajmp E4YY Q297: jb ARGF,EP4 ;MUST BE AN OPERATOR, IF SET acall VAR ;IS THE VALUE a VARIABLE? jnc EP3 ;PUT VARIABLE ON STACK ; acall CONST ;IS THE VALUE a NUMERIC CONSTANT? jnc EP4 ;IF SO, CONTINUE, IF NOT, SEE WHAT acall GC ;GET THE CHARACTER cjne a,#T_LPAR,EP4 ;SEE IF a LEFT PAREN ;mov a,#(OPBOL+1)&0xff mov a,#1 ajmp XLPAR ;PROCESS THE LEFT PAREN ; EP3: acall PUSHAS ;SAVE VAR ON STACK ; EP4: acall GC ;GET THE OPERATOR ; cjne a,#T_LPAR,Q98 ;IS IT AN OPERATOR Q98: jnc XOP ;PROCESS OPERATOR cjne a,#T_UOP,Q99 ;IS IT a UNARY OPERATOR Q99: jnc XBILT ;PROCESS UNARY (BUILT IN) OPERATOR pop R2B0 ;GET BACK PREVIOUS OPERATOR PRECEDENCE jb ARGF,Q323 ;OK IF ARG FLAG IS SET ; EP5: clr c ;NO RECOVERY ljmp E1XX_2 ; ; Process the operator ; XOP: anl a,#0x1F ;STRIP OFF THE TOKE BITS jb ARGF,XOP1 ;IF ARG FLAG IS SET, PROCESS cjne a,#T_SUB-T_LPAR,XOP3 mov a,#T_NEG-T_LPAR ; ;$EJECT XOP1: ;add a,#(OPBOL+1)&0xff ;BIAS THE TABLE add a, #1 mov r2,a mov dptr,#OPBOL movc a,@a+dptr ;GET THE CURRENT PRECEDENCE mov r4,a pop ACC ;GET THE PREVIOUS PRECEDENCE mov r5,a ;SAVE THE PREVIOUS PRECEDENCE movc a,@a+dptr ;GET IT cjne a,R4B0,Q100 ;SEE WHICH HAS HIGHER PRECEDENCE cjne a,#12,Q323 ;SEE IF ANEG setb c Q100: jnc Q323 ;PROCESS NON-INCREASING PRECEDENCE ; ; Save increasing precedence ; push R5B0 ;SAVE OLD PRECEDENCE ADDRESS push R2B0 ;SAVE NEW PRECEDENCE ADDRESS acall GCI1 ;EAT THE OPERATOR acall EP1 ;EVALUATE REMAINING EXPRESSION XOP2_2: pop ACC ; ; r2 has the action address, now setup and perform operation ; XOP2: mov dptr,#OPTAB-2 ;add a,#(~ OPBOL)&0xff lcall ISTA1 ;SET UP TO RETURN TO EP2 ajmp EP2 ;JUMP TO EVALUATE EXPRESSION Q323: ret ; ; Built-in operator processing ; XBILT: acall GCI1 ;EAT THE TOKEN ;add a,#(0x50+(UOPBOL&0xff))&0xff add a,#(0x50+(UOPBOL-OPBOL))&0xff jb ARGF,EP5 ;XBILT MUST COME AFTER AN OPERATOR cjne a,#(STP-OPBOL)&0xff,Q101 ;cjne a,#(STP&0xff,Q101 Q101: jnc XOP2 ; XLPAR: push ACC ;PUT ADDRESS ON THE STACK lcall P_E ajmp XOP2_2 ;PERFORM OPERATION ; XOP3: cjne a,#T_ADD-T_LPAR,EP5 acall GCI1 ajmp EP2 ;WASTE + SIGN ; ;$EJECT XPOP: acall X3120 ;FLIP ARGS THEN pop ; ;*************************************************************** ; ; POPAS - Pop arg stack and copy variable to r3:r1 ; ;*************************************************************** ; POPAS: acall INC_ASTKA ajmp VARCOP ;COPY THE VARIABLE ; AXTAL: mov r2,#CXTAL>>8 mov r0,#CXTAL&0xff ; ; fall thru ; ;*************************************************************** ; PUSHAS: ; Push the Value addressed by r2:r0 onto the arg stack ; ;*************************************************************** ; acall DEC_ASTKA setb ARGF ;SAYS THAT SOMTHING IS ON THE STACK ajmp VARCOP ; ; ;*************************************************************** ; ST_A: ; Store at expression ; ;*************************************************************** ; acall ONE ;GET THE EXPRESSION ajmp POPAS ;SAVE IT ; ; ;*************************************************************** ; LD_A: ; Load at expression ; ;*************************************************************** ; acall ONE ;GET THE EXPRESSION acall X3120 ;FLIP ARGS ajmp PUSHAS ; ;$EJECT ;*************************************************************** ; CONST: ; Get a constant fron the text ; ;*************************************************************** ; acall GC ;FIRST SEE IF LITERAL cjne a,#T_ASC,C0C ;SEE IF ASCII TOKEN acall IGC ;GET THE CHARACTER AFTER TOKEN cjne a,#'$',CN0 ;SEE IF a STRING ; CNX: lcall CSY ;CALCULATE IT ajmp AXBYTE_2 ;SAVE IT ON THE STACK ; CN0: acall TWO_R2 ;PUT IT ON THE STACK acall GCI1 ;BUMP THE POINTER ljmp ERPAR ;WASTE THE RIGHT PAREN ; ; C0C: acall DP_T ;GET THE TEXT POINTER lcall GET_NUM ;GET THE NUMBER cjne a,#0xff,C1C ;SEE IF NO NUMBER setb c C2C: ret ; C1C: jnz FPTST clr c setb ARGF ; C3C: ajmp T_DP ; FPTST: anl a,#0x0b ;CHECK FOR ERROR jz C2C ;EXIT IF ZERO ; ; Handle the error condition ; mov dptr,#E2X ;DIVIDE BY ZERO jnb ACC.0,Q102 ;UNDERFLOW mov dptr,#E7X Q102: jnb ACC.1,Q102 ;OVERFLOW mov dptr,#E11X ; FPTS: ljmp ERROR ; ;$EJECT ;*************************************************************** ; ; The Command action routine - LIST ; ;*************************************************************** ; CLIST: lcall NUMC ;SEE IF TO LINE PORT acall FSTK ;PUT 0FFFFH ON THE STACK acall INTGER ;SEE IF USER SUPPLIES LN clr a ;LN = 0 TO START mov r3,a mov r1,a jc CxL1 ;START FROM ZERO ; lcall TEMPD ;SAVE THE START ADDTESS acall GCI ;GET THE CHARACTER AFTER LIST cjne a,#T_SUB,Q103 ;CHECK FOR TERMINATION ADDRESS "-" acall INC_ASTKA ;WASTE 0FFFFH acall INTERR ;GET TERMINATION ADDRESS acall TWO_EY ;PUT TERMINATION ON THE ARG STACK Q103: mov r3,TEMP5 ;GET THE START ADDTESS mov r1,TEMP4 ; CxL1: lcall GETLIN ;GET THE LINE NO IN r3:r1 jz CL3 ;ret IF AT END ; CL2: acall C3C ;SAVE THE ADDRESS inc dptr ;POINT TO LINE NUMBER lcall PMTOP_3 ;PUT LINE NUMBER ON THE STACK acall CMPLK ;COMPARE LN TO END ADDRESS jc CL3 ;EXIT IF GREATER lcall BCK ;CHECK FOR a CONTROL c acall DEC_ASTKA ;SAVE THE COMPARE ADDRESS acall DP_T ;RESTORE ADDRESS acall UPPL ;UN-PROCESS THE LINE acall C3C ;SAVE THE CR ADDRESS acall CL6 ;PRINT IT inc dptr ;BUMP POINTER TO NEXT LINE movx a,@dptr ;GET LIN LENGTH djnz ACC,CL2 ;LOOP acall INC_ASTKA ;WASTE THE COMPARE BYTE ; CL3: ljmp CMND1 ;BACK TO COMMAND PROCESSOR ; CL6: mov dptr,#IBUF ;PRINT IBUF lcall PRNTCR ;PRINT IT acall DP_T ; CL7: ljmp CRLF ; UPPL_3: lcall X31DP ;$EJECT ;*************************************************************** ; ;UPPL - UN PREPROCESS a LINE ADDRESSED BY dptr INTO IBUF ; RETURN SOURCE ADDRESS OF CR IN dptr ON RETURN ; ;*************************************************************** ; UPPL: mov r3,#IBUF>>8 ;POINT r3 AT HIGH IBUF mov r1,#IBUF&0xff ;POINT r1 AT IBUF inc dptr ;SKIP OVER LINE LENGTH acall C3C ;SAVE THE dptr (DP_T) lcall L20DPI ;PUT LINE NUMBER IN r2:r0 lcall CONVERT_BINARY_TO_ASCII_STRING ;CONVERT r2:r0 TO INTEGER acall DP_T inc dptr ;BUMP DPTR PAST THE LINE NUMBER ; UPP0: cjne r1,#(IBUF+6)&0xff,Q105 Q105: jc Q923 ;PUT SPACES IN TEXT inc dptr ;BUMP PAST LN HIGH movx a,@dptr ;GET USER TEXT mov r6,a ;SAVE a IN r6 FOR TOKE COMPARE jb ACC.7,UPP1 ;IF TOKEN, PROCESS cjne a,#0x20,Q106 ;TRAP THE USER TOKENS Q106 jnc Q107 cjne a,#SCR,UPP1 ;DO IT IF NOT a CR Q107: cjne a,#'"',UPP9 ;SEE IF STRING acall UPP7 ;SAVE IT Q7: acall UPP8 ;GET THE NEXT CHARACTER AND SAVE IT cjne a,#'"',Q7 ;LOOP ON QUOTES ajmp UPP0 ; UPP9: cjne a,#':',UPP1A ;PUT a SPACE IN DELIMITER acall UPP7A mov a,r6 acall UPP7 Q923: acall UPP7A ajmp UPP0 ; UPP1A: acall UPP8_2 ;SAVE THE CHARACTER, UPDATE POINTER ajmp UPP0 ;EXIT IF a CR, ELSE LOOP ; UPP1: acall C3C ;SAVE THE TEXT POINTER mov c,XBIT mov F0,c ;SAVE XBIT IN F0 Q924: mov dptr,#TOKTAB ;POINT AT TOKEN TABLE ; jnb F0,UPP2 ; lcall 0x2078 ;SET UP dptr FOR LOOKUP ; UPP2: clr a ;ZERO a FOR LOOKUP movc a,@a+dptr ;GET TOKEN inc dptr ;ADVANCE THE TOKEN POINTER cjne a,#0xff,UP_2 ;SEE IF DONE jbc F0,Q924 ;NOW DO NORMAL TABLE ljmp CMND1 ;EXIT IF NOT FOUND ; UP_2: cjne a,R6B0,UPP2 ;LOOP UNTIL THE SAME ; UP_3: cjne a,#T_UOP,Q108 Q108: jnc UPP3 acall UPP7A ;PRINT THE SPACE IF OK ; UPP3: clr a ;DO LOOKUP movc a,@a+dptr jb ACC.7,UPP4 ;EXIT IF DONE, ELSE SAVE jz UPP4 ;DONE IF ZERO acall UPP7 ;SAVE THE CHARACTER inc dptr ajmp UPP3 ;LOOP ; UPP4: acall DP_T ;GET IT BACK mov a,r6 ;SEE IF a REM TOKEN xrl a,#T_REM jnz Q109 Q8: acall UPP8 ajmp Q8 Q109: jnc UPP0 ;START OVER AGAIN IF NO TOKEN acall UPP7A ;PRINT THE SPACE IF OK ajmp UPP0 ;DONE ; UPP7A: mov a,#' ' ;OUTPUT a SPACE ; UPP7: ljmp PPL9_1 ;SAVE a ; UPP8: inc dptr movx a,@dptr UPP8_2: cjne a,#SCR,UPP7 ljmp PPL7_1 ; ;$EJECT ;************************************************************** ; ; This table contains all of the floating point constants ; ; The constants in ROM are stored "backwards" from the way ; basic normally treats floating point numbers. Instead of ; loading from the exponent and decrementing the pointer, ; ROM constants pointers load from the most significant ; digits and increment the pointers. This is done to 1) make ; arg stack loading faster and 2) compensate for the fact that ; no decrement data pointer instruction exsist. ; ; The numbers are stored as follows: ; ; BYTE X+5 = MOST SIGNIFICANT DIGITS IN BCD ; BYTE X+4 = NEXT MOST SIGNIFICANT DIGITS IN BCD ; BYTE X+3 = NEXT LEAST SIGNIFICANT DIGITS IN BCD ; BYTE X+2 = LEAST SIGNIFICANT DIGITS IN BCD ; BYTE X+1 = SIGN OF THE ABOVE MANTISSA 0 = +, 1 = - ; BYTE X = EXPONENT IN TWO"S COMPLEMENT BINARY ; ZERO EXPONENT = THE NUMBER ZERO ; ;************************************************************** ; ATTAB: db 128-2 ; ARCTAN LOOKUP db 0x00 db 0x57 db 0x22 db 0x66 db 0x28 ; db 128-1 db 0x01 db 0x37 db 0x57 db 0x16 db 0x16 ; db 128-1 db 0x00 db 0x14 db 0x96 db 0x90 db 0x42 ; db 128-1 db 0x01 db 0x40 db 0x96 db 0x28 db 0x75 ; db 128 db 0x00 db 0x64 db 0x62 db 0x65 db 0x10 ; db 128 db 0x01 db 0x99 db 0x88 db 0x20 db 0x14 ; db 128 db 0x00 db 0x51 db 0x35 db 0x99 db 0x19 ; db 128 db 0x01 db 0x45 db 0x31 db 0x33 db 0x33 ; db 129 db 0x00 db 0x00 db 0x00 db 0x00 db 0x10 ; db 0xff ;END OF TABLE ; NTWO: db 129 db 0 db 0 db 0 db 0 db 0x20 ; TTIME: db 128-4 ; CLOCK CALCULATION db 0x00 db 0x00 db 0x00 db 0x04 db 0x13 ; ;$EJECT ;*************************************************************** ; ; COSINE - Add pi/2 to stack, then fall thru to SIN ; ;*************************************************************** ; ACOS: acall POTWO ;PUT PI/2 ON THE STACK lcall AADD ;TOS = TOS+PI/2 ; ;*************************************************************** ; ; SINE - use taylor series to calculate sin function ; ;*************************************************************** ; ASIN: acall PIPI ;PUT PI ON THE STACK acall RV ;REDUCE THE VALUE mov a,MT2 ;CALCULATE THE SIGN anl a,#0x01 ;SAVE LSB xrl MT1,a ;SAVE SIGN IN MT1 acall CSTAKA ;NOW CONVERT TO ONE QUADRANT acall POTWO acall CMPLK ;DO COMPARE jc Q110 acall PIPI lcall ASUB Q110: acall AABS mov dptr,#SINTAB ;SET UP LOOKUP TABLE acall POLYC ;CALCULATE THE POLY acall STRIP ajmp SIN0 ; ; Put PI/2 on the stack ; POTWO: acall PIPI ;PUT PI ON THE STACK, NOW DIVIDE ; DBTWO: mov dptr,#NTWO acall PUSHC ;mov a,#2 ;BY TWO ;acall TWO_R2 ajmp ADIV ; ;$EJECT ;************************************************************* ; POLYC: ; Expand a power series to calculate a polynomial ; ;************************************************************* ; acall CSTAKA2 ;COPY THE STACK acall AMUL ;SQUARE THE STACK acall POP_T1 ;SAVE X*X acall PUSHC ;PUT CONSTANT ON STACK ; POLY1: acall PUSH_T1 ;PUT COMPUTED VALUE ON STACK acall AMUL ;MULTIPLY CONSTANT AND COMPUTED VALUE acall PUSHC ;PUT NEXT CONSTANT ON STACK lcall AADD ;add IT TO THE OLD VALUE clr a ;CHECK TO SEE IF DONE movc a,@a+dptr cjne a,#0xff,POLY1 ;LOOP UNTIL DONE ; AMUL: lcall FLOATING_MUL ajmp FPTST ; ;************************************************************* ; RV: ; Reduce a value for Trig and a**X functions ; ; value = (value/x - INT(value/x)) * x ; ;************************************************************* ; acall Cx_T2 ;COPY TOS TO T2 acall ADIV ;TOS = TOS/TEMP2 acall AABS ;MAKE THE TOS a POSITIVE NUMBER mov MT1,a ;SAVE THE SIGN acall CSTAKA2 ;COPY THE STACK TWICE acall IFIX ;PUT THE NUMBER IN r3:r1 push R3B0 ;SAVE r3 mov MT2,r1 ;SAVE THE LS BYTE IN MT2 acall AINT ;MAKE THE TOS AN INTEGER lcall ASUB ;TOS = TOS/T2 - INT(TOS/T2) acall P_T2 ;TOS = T2 acall AMUL ;TOS = T2*(TOS/T2 - INT(TOS/T2) pop R3B0 ;RESTORE r3 ret ;EXIT ; ;$EJECT ;************************************************************** ; ; TAN ; ;************************************************************** ; ATAN: acall CSTAKA ;DUPLACATE STACK acall ASIN ;TOS = SIN(X) acall SWAP_ASTKA ;TOS = X acall ACOS ;TOS = COS(X) ajmp ADIV ;TOS = SIN(X)/COS(X) ; STRIP: acall SETREG ;SETUP r0 mov r3,#1 ;LOOP COUNT ajmp AI2_1 ;WASTE THE LSB ; ;************************************************************ ; ; ARC TAN ; ;************************************************************ ; AATAN: acall AABS mov MT1,a ;SAVE THE SIGN acall SETREG ;GET THE EXPONENT add a,#0x7f ;BIAS THE EXPONENT mov UBIT,c ;SAVE CARRY STATUS jnc Q210 ;SEE IF > 1 acall RECIP ;IF > 1, TAKE RECIP Q210: mov dptr,#ATTAB ;SET UP TO CALCULATE THE POLY acall POLYC ;CALCULATE THE POLY jnb UBIT,SIN0 ;JUMP IF NOT SET acall ANEG ;MAKE X POLY NEGATIVE acall POTWO ;SUBTRACT PI/2 lcall AADD ; SIN0: mov a,MT1 ;GET THE SIGN jz SRT ajmp ANEG ; E4YY: mov dptr,#EXA ajmp FPTS ;ARG STACK ERROR ; ;$EJECT ;************************************************************* ; ; FCOMP - COMPARE 0FFFFH TO TOS ; ;************************************************************* ; FCMP: acall CSTAKA ;COPY THE STACK acall FSTK ;MAKE THE TOS = 0FFFFH acall SWAP_ASTKA ;NOW COMPARE IS 0FFFFH - X ; CMPLK: ljmp FLOATING_COMP ;DO THE COMPARE ; ;************************************************************* ; DEC_ASTKA: ;Push ARG STACK and check for underflow ; ;************************************************************* ; mov a,#(-FPSIZ)&0xff add a,ASTKA cjne a,#(TM_TOP+6)&0xff,Q111 Q111 jc E4YY mov ASTKA,a mov r1,a mov r3,#ASTKAH ; SRT: ret ; ; AXTAL3: acall PUSHC ;push CONSTANT, THEN MULTIPLY acall AMUL ; ; Fall thru to IFIX ; ;$EJECT ;*************************************************************** ; IFIX: ; Convert a floating point number to an integer, put in r3:r1 ; ;*************************************************************** ; clr a ;RESET THE START mov r3,a mov r1,a mov r0,ASTKA ;GET THE ARG STACK mov P2,#ASTKAH movx a,@r0 ;READ EXPONENT clr c subb a,#0x81 ;BASE EXPONENT mov r4,a ;SAVE IT dec r0 ;POINT AT SIGN movx a,@r0 ;GET THE SIGN jnz SQ_ERR ;ERROR IF NEGATIVE jc INC_ASTKA ;EXIT IF EXPONENT IS < 0x81 inc r4 ;ADJUST LOOP COUNTER mov a,r0 ;BUMP THE POINTER REGISTER subb a,#FPSIZ-1 mov r0,a ; I2: inc r0 ;POINT AT DIGIT movx a,@r0 ;GET DIGIT swap a ;FLIP lcall MULNUM10 ;ACCUMULATE jc SQ_ERR djnz r4,Q112 ajmp INC_ASTKA Q112: movx a,@r0 ;GET DIGIT lcall MULNUM10 jc SQ_ERR djnz r4,I2 ; ;$EJECT ;************************************************************ ; INC_ASTKA: ; Pop the ARG STACK and check for overflow ; ;************************************************************ ; mov a,#FPSIZ ;NUMBER TO pop ajmp SETREG_1 ; SETREG: clr a ;DON"T pop ANYTHING SETREG_1: mov r0,ASTKA mov r2,#ASTKAH mov P2,r2 add a,r0 jc E4ZZ mov ASTKA,a movx a,@r0 A_D: ret SQ_ERR: ljmp E3XX ;LINK TO BAD ARG E4ZZ: ajmp E4YY ; ; ;************************************************************ ; ; EBIAS - Bias a number for E to the X calculations ; ;***************