Mercurial > hg > index.cgi
changeset 75:5f8f0b0781e8
Split some code into separate files for easier management (3)
Because the source for lwbasic is so large, split it into several
different files to make it easier to navigate and modify. This is
part three of the split. Includes a file missing from part one.
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Sun, 06 Aug 2023 00:41:26 -0600 |
| parents | e74d00ac6b79 |
| children | eb2681108660 |
| files | Makefile src/error.s src/expr.s src/interp.s src/lwbasic.s src/print.s |
| diffstat | 6 files changed, 364 insertions(+), 236 deletions(-) [+] |
line wrap: on
line diff
--- a/Makefile Sun Aug 06 00:36:48 2023 -0600 +++ b/Makefile Sun Aug 06 00:41:26 2023 -0600 @@ -1,7 +1,7 @@ .PHONY: all all: bin/lwbasic.rom bin/lwbasic-coco2b.rom bin/lwbasic-coco3.rom bin/coco2.zip bin/coco2b.zip bin/coco3.zip -lwb_srcs := consscr.s defs.s genio.s init.s interp.s irq.s keyb.s miscdata.s print.s progctrl.s vars.s +lwb_srcs := consscr.s defs.s error.s expr.s genio.s init.s interp.s irq.s keyb.s miscdata.s print.s progctrl.s vars.s lwb_srcs := $(addprefix src/,$(lwb_srcs)) bin/lwbasic.rom: src/lwbasic.s $(lwb_srcs)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/error.s Sun Aug 06 00:41:26 2023 -0600 @@ -0,0 +1,64 @@ + *pragmapush list + *pragma list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; The error handler +; +; Enter with the error number in B. This routine will do some cleanup and handle any ON ERROR GOTO handler that +; may be active. +; +; Note the error message lookup does not need to be efficient which is why the lookup just runs through the list +; of error messages in sequence looking for NUL terminators. The specific handling of B (error number) below avoids +; issues if there happen to be error codes above 128. +ERROR clr filenum ; reset display device to console + jsr writecondnl ; do a newline if needed (will preserve B) + ldx #errormsg ; point to error message list + incb ; account for decb below + bra ERROR1 ; go search for correct message +ERROR0 lda ,x+ ; end of message? + bne ERROR0 ; brif not end of message +ERROR1 decb ; at the correct one? + bne ERROR0 ; brif not - skip to next one +ERROR2 jsr writestrconduc ; output error message + ldu curline ; are we in immediate mode? + beq ERROR3 ; brif so + ldx #inmsg ; point to " in " + jsr writestrconduc ; output " in " + ldd 2,u ; get line number + jsr print_uint16d ; display the line number +ERROR3 lds freetop ; reset the stack pointer (error routine could be called anywhere) + clr ,-s ; reset the call stack + sts stackptr + jmp immediate ; go back to immediate mode +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Error messages +; +; Each error begins with a deferr macro invocation which will define a symbol err_slug with the next error number +; +; deferr slug +; +; This is then followed by the error message defined with fcn. +; +; Real error numbers start at 1; 0 is used to indicate no error. + *pragmapush list + *pragma nolist +__errnum set 0 +deferr macro noexpand +err_{1} equ __errnum +__errnum set __errnum+1 + endm + *pragmapop list +errormsg deferr none + fcn 'No error' + deferr nf + fcn 'NEXT without FOR' + deferr sn + fcn 'Syntax error' + deferr ul + fcn 'Undefined line number' + deferr rg + fcn 'RETURN without GOSUB' + deferr ov + fcn 'Overflow' + deferr tm + fcn 'Type mismatch' + *pragmapop list
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/expr.s Sun Aug 06 00:41:26 2023 -0600 @@ -0,0 +1,176 @@ + *pragmapush list + *pragma list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; The LET command which is the default if no token begins a statement +cmd_let jmp SNERROR ; not yet implemented +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Expression Evaluation Package +; +; This is the expression evaluator. It handles everything from parsing numbers to dispatching function calls. The main +; entry point is eval_expr which will evaluate an arbitrary expression. It returns as soon as it reaches something it +; doesn't understand as part of an expression. +; +; The special handling for relational operators is required because Basic allows them in all +eval_expr clrb ; flag previous operator as minimum precdence (end of expression) +eval_expraux jsr eval_term ; evaluate the first term of the expression +eval_expr0 jsr curchar ; fetch current input + beq eval_expr1 ; brif end of expression - we're done + cmpa #tok_or ; is it above operators? + bhi eval_expr1 ; brif so + suba #tok_plus ; offset to zero for first operator token + bcc eval_expr2 ; brif it is an operator +eval_expr1 rts +eval_expr2 pshs b ; save previous operator precedence + ldx #oper_tab ; point to operator table + tfr a,b ; shift to B for "ABX" + abx ; add three times (3 bytes per entry) + abx ; OBS: TFR + ABX + ABX + ABX is faster than LDB + MUL + ABX + abx ; now X points to the operator entry in the table + ldb ,x ; get precedence of current operation + cmpb ,s ; is it higher than the current operation? + bhi eval_expr3 ; brif so - process this operator + puls b,pc ; return current value to complete previous operation +eval_expr3 jsr nextchar ; eat the operator token + ldx 1,x ; get handler address of this operator + leas -val.size,s ; make room for the result accumulator + pshs x ; save handler address for later + lda val0+val.type ; get current value type + ldx val0 ; get value accumlator contents (6 bytes) + ldy val0+2 + ldu val0+4 + pshs a,x,y,u ; save it on the stack + jsr eval_expraux ; evaluate the following term and higher precedence expressions + puls a,x,y,u ; get back saved value + stx val1 ; save it to the second value accumulator + sty val1+2 + stu val1+4 + sta val1+val.type ; save previous value type + ldx #val1 ; point to left operand + ldu #val0 ; point to right operand + leay 2,s ; point to return value location + jsr [,s++] ; go handle the operator + puls a,x,y,u ; get return value + sta val0 + stx val0+1 + sty val0+3 + stu val0+5 + puls b ; get back the previous operator precedence + bra eval_expr0 ; go process another operator or end of expression +eval_term jsr curchar ; get current input character + beq eval_term0 ; brif end of input - this is an error + bcs eval_number ; brif digit - we have a number +; bmi eval_func ; brif we have a token - handle function call + cmpa #'. ; decimal point? + beq eval_number ; brif so - evaluate number + cmpa #'- ; negative sign? + beq eval_number ; brif so - evaluate number + cmpa #'+ ; positive sign? + beq eval_number ; brif so - evaluate number +eval_term0 jmp SNERROR ; we have something unrecognized - raise error +; Evaluate a number constant. Currently this only handles 32 bit integers. +eval_number ldb #valtype_int ; start with integer value + stb val0+val.type ; set return value + ldx zero ; blank out the value + stx val0 + stx val0+2 + stx val0+4 + bra eval_number1 ; go do the parsing +eval_number0 jsr nextchar ; fetch next input + beq eval_numberr ; brif end of expression - bail +eval_number1 cmpa #'- ; negative (ascii sign)? + beq eval_number3 ; brif so + cmpa #tok_minus ; negative (operator negative)? + bne eval_number2 ; brif not +eval_number3 com val0+val.fpsign ; invert sign + bra eval_number0 ; deal with next input +eval_number2 cmpa #'+ ; unary +? + beq eval_number0 ; brif so - skip it +eval_number5 cmpa #'. ; decimal point? + beq eval_float ; brif decimal - force float + cmpa #'0 ; is it a number? + blo eval_numberr ; brif below digit + cmpa #'9 ; is it still a number? + bhi eval_numberr ; brif above digit + suba #'0 ; offset to binary digit value + pshs a ; save digit value + ldx val0+val.int ; get current value for later (for quick multiply by 10) + ldd val0+val.int+2 + pshs d,x ; stored with words swapped on stack for efficiency for later + lsl val0+val.int+3 ; times 2 + rol val0+val.int+2 + rol val0+val.int+1 + rol val0+val.int + bcs OVERROR ; brif overflowed + lsl val0+val.int+3 ; times 4 + rol val0+val.int+2 + rol val0+val.int+1 + rol val0+val.int + bcs OVERROR ; brif overflowed + ldd val0+val.int+2 ; times 5 (add original value) + addd ,s++ + std val0+val.int+2 + ldd val0+val.int + adcb 1,s + adca ,s++ + std val0+val.int + bcs OVERROR + lsl val0+val.int+3 ; times 10 + rol val0+val.int+2 + rol val0+val.int+1 + rol val0+val.int + bcs OVERROR ; brif overflowed + ldd val0+val.int+2 ; get low word + addb ,s+ ; add in current digit + adca #0 + std val0+val.int+2 + ldd val0+val.int + adcb #0 + adca #0 + std val0+val.int + bcs OVERROR ; brif overflowed + bpl eval_number4 ; brif we haven't wrapped negative + cmpd #0x8000 ; is it valid negative two's complement? + bhi OVERROR ; brif not + ldd val0+val.int+2 ; is it still valid two's complement (max negative)? + bne OVERROR ; brif so +eval_number4 jsr nextchar ; fetch next input character + bra eval_number5 ; go handle it +OVERROR ldb #err_ov ; flag overflow + jmp ERROR +eval_numberr ldb val0+val.fpsign ; is the number we want negative? + beq eval_numberr0 ; brif not + jsr val_negint32 ; negate the integer +eval_numberr0 rts +eval_float jmp SNERROR ; we don't handle floating point yet +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Operator table +; +; Each entry starts with the precedence value followed by the handler routine. Each handler will receive its left +; operand in val1 and its right operand in val0 and should return its result in val0. +oper_tab fcb 0x79 ; addition + fdb oper_plus + fcb 0x79 ; subtraction + fdb oper_minus + fcb 0x7b ; multiplication + fdb SNERROR + fcb 0x7b ; division + fdb SNERROR + fcb 0x7f ; exponentiation + fdb SNERROR + fcb 0x64 ; less than + fdb SNERROR + fcb 0x64 ; equal to + fdb SNERROR + fcb 0x64 ; greater than + fdb SNERROR + fcb 0x64 ; less than or equal to + fdb SNERROR + fcb 0x64 ; greater than or equal to + fdb SNERROR + fcb 0x64 ; not equal to + fdb SNERROR + fcb 0x50 ; boolean AND + fdb SNERROR + fcb 0x46 ; boolean OR + fdb SNERROR + *pragmapop list
--- a/src/interp.s Sun Aug 06 00:36:48 2023 -0600 +++ b/src/interp.s Sun Aug 06 00:41:26 2023 -0600 @@ -43,35 +43,6 @@ suba #-'0 curcharraw0 rts ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; The error handler -; -; Enter with the error number in B. This routine will do some cleanup and handle any ON ERROR GOTO handler that -; may be active. -; -; Note the error message lookup does not need to be efficient which is why the lookup just runs through the list -; of error messages in sequence looking for NUL terminators. The specific handling of B (error number) below avoids -; issues if there happen to be error codes above 128. -ERROR clr filenum ; reset display device to console - jsr writecondnl ; do a newline if needed (will preserve B) - ldx #errormsg ; point to error message list - incb ; account for decb below - bra ERROR1 ; go search for correct message -ERROR0 lda ,x+ ; end of message? - bne ERROR0 ; brif not end of message -ERROR1 decb ; at the correct one? - bne ERROR0 ; brif not - skip to next one -ERROR2 jsr writestrconduc ; output error message - ldu curline ; are we in immediate mode? - beq ERROR3 ; brif so - ldx #inmsg ; point to " in " - jsr writestrconduc ; output " in " - ldd 2,u ; get line number - jsr print_uint16d ; display the line number -ERROR3 lds freetop ; reset the stack pointer (error routine could be called anywhere) - clr ,-s ; reset the call stack - sts stackptr - ; fall through to immediate mode intentional -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Immediate mode handler immediate jsr writecondnl ; do newline if required ldx #prompt ; point to prompt string
--- a/src/lwbasic.s Sun Aug 06 00:36:48 2023 -0600 +++ b/src/lwbasic.s Sun Aug 06 00:41:26 2023 -0600 @@ -45,215 +45,12 @@ include interp.s include progctrl.s include print.s - + include error.s + include expr.s + include miscdata.s *pragmapop list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Error messages -; -; Each error begins with a deferr macro invocation which will define a symbol err_slug with the next error number -; -; deferr slug -; -; This is then followed by the error message defined with fcn. -; -; Real error numbers start at 1; 0 is used to indicate no error. - *pragmapush list - *pragma nolist -__errnum set 0 -deferr macro noexpand -err_{1} equ __errnum -__errnum set __errnum+1 - endm - *pragmapop list -errormsg deferr none - fcn 'No error' - deferr nf - fcn 'NEXT without FOR' - deferr sn - fcn 'Syntax error' - deferr ul - fcn 'Undefined line number' - deferr rg - fcn 'RETURN without GOSUB' - deferr ov - fcn 'Overflow' - deferr tm - fcn 'Type mismatch' -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; The LET command which is the default if no token begins a statement -cmd_let jmp SNERROR ; not yet implemented -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Expression Evaluation Package -; -; This is the expression evaluator. It handles everything from parsing numbers to dispatching function calls. The main -; entry point is eval_expr which will evaluate an arbitrary expression. It returns as soon as it reaches something it -; doesn't understand as part of an expression. -; -; The special handling for relational operators is required because Basic allows them in all -eval_expr clrb ; flag previous operator as minimum precdence (end of expression) -eval_expraux jsr eval_term ; evaluate the first term of the expression -eval_expr0 jsr curchar ; fetch current input - beq eval_expr1 ; brif end of expression - we're done - cmpa #tok_or ; is it above operators? - bhi eval_expr1 ; brif so - suba #tok_plus ; offset to zero for first operator token - bcc eval_expr2 ; brif it is an operator -eval_expr1 rts -eval_expr2 pshs b ; save previous operator precedence - ldx #oper_tab ; point to operator table - tfr a,b ; shift to B for "ABX" - abx ; add three times (3 bytes per entry) - abx ; OBS: TFR + ABX + ABX + ABX is faster than LDB + MUL + ABX - abx ; now X points to the operator entry in the table - ldb ,x ; get precedence of current operation - cmpb ,s ; is it higher than the current operation? - bhi eval_expr3 ; brif so - process this operator - puls b,pc ; return current value to complete previous operation -eval_expr3 jsr nextchar ; eat the operator token - ldx 1,x ; get handler address of this operator - leas -val.size,s ; make room for the result accumulator - pshs x ; save handler address for later - lda val0+val.type ; get current value type - ldx val0 ; get value accumlator contents (6 bytes) - ldy val0+2 - ldu val0+4 - pshs a,x,y,u ; save it on the stack - jsr eval_expraux ; evaluate the following term and higher precedence expressions - puls a,x,y,u ; get back saved value - stx val1 ; save it to the second value accumulator - sty val1+2 - stu val1+4 - sta val1+val.type ; save previous value type - ldx #val1 ; point to left operand - ldu #val0 ; point to right operand - leay 2,s ; point to return value location - jsr [,s++] ; go handle the operator - puls a,x,y,u ; get return value - sta val0 - stx val0+1 - sty val0+3 - stu val0+5 - puls b ; get back the previous operator precedence - bra eval_expr0 ; go process another operator or end of expression -eval_term jsr curchar ; get current input character - beq eval_term0 ; brif end of input - this is an error - bcs eval_number ; brif digit - we have a number -; bmi eval_func ; brif we have a token - handle function call - cmpa #'. ; decimal point? - beq eval_number ; brif so - evaluate number - cmpa #'- ; negative sign? - beq eval_number ; brif so - evaluate number - cmpa #'+ ; positive sign? - beq eval_number ; brif so - evaluate number -eval_term0 jmp SNERROR ; we have something unrecognized - raise error -; Evaluate a number constant. Currently this only handles 32 bit integers. -eval_number ldb #valtype_int ; start with integer value - stb val0+val.type ; set return value - ldx zero ; blank out the value - stx val0 - stx val0+2 - stx val0+4 - bra eval_number1 ; go do the parsing -eval_number0 jsr nextchar ; fetch next input - beq eval_numberr ; brif end of expression - bail -eval_number1 cmpa #'- ; negative (ascii sign)? - beq eval_number3 ; brif so - cmpa #tok_minus ; negative (operator negative)? - bne eval_number2 ; brif not -eval_number3 com val0+val.fpsign ; invert sign - bra eval_number0 ; deal with next input -eval_number2 cmpa #'+ ; unary +? - beq eval_number0 ; brif so - skip it -eval_number5 cmpa #'. ; decimal point? - beq eval_float ; brif decimal - force float - cmpa #'0 ; is it a number? - blo eval_numberr ; brif below digit - cmpa #'9 ; is it still a number? - bhi eval_numberr ; brif above digit - suba #'0 ; offset to binary digit value - pshs a ; save digit value - ldx val0+val.int ; get current value for later (for quick multiply by 10) - ldd val0+val.int+2 - pshs d,x ; stored with words swapped on stack for efficiency for later - lsl val0+val.int+3 ; times 2 - rol val0+val.int+2 - rol val0+val.int+1 - rol val0+val.int - bcs OVERROR ; brif overflowed - lsl val0+val.int+3 ; times 4 - rol val0+val.int+2 - rol val0+val.int+1 - rol val0+val.int - bcs OVERROR ; brif overflowed - ldd val0+val.int+2 ; times 5 (add original value) - addd ,s++ - std val0+val.int+2 - ldd val0+val.int - adcb 1,s - adca ,s++ - std val0+val.int - bcs OVERROR - lsl val0+val.int+3 ; times 10 - rol val0+val.int+2 - rol val0+val.int+1 - rol val0+val.int - bcs OVERROR ; brif overflowed - ldd val0+val.int+2 ; get low word - addb ,s+ ; add in current digit - adca #0 - std val0+val.int+2 - ldd val0+val.int - adcb #0 - adca #0 - std val0+val.int - bcs OVERROR ; brif overflowed - bpl eval_number4 ; brif we haven't wrapped negative - cmpd #0x8000 ; is it valid negative two's complement? - bhi OVERROR ; brif not - ldd val0+val.int+2 ; is it still valid two's complement (max negative)? - bne OVERROR ; brif so -eval_number4 jsr nextchar ; fetch next input character - bra eval_number5 ; go handle it -OVERROR ldb #err_ov ; flag overflow - jmp ERROR -eval_numberr ldb val0+val.fpsign ; is the number we want negative? - beq eval_numberr0 ; brif not - jsr val_negint32 ; negate the integer -eval_numberr0 rts -eval_float jmp SNERROR ; we don't handle floating point yet -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Operator table -; -; Each entry starts with the precedence value followed by the handler routine. Each handler will receive its left -; operand in val1 and its right operand in val0 and should return its result in val0. -oper_tab fcb 0x79 ; addition - fdb oper_plus - fcb 0x79 ; subtraction - fdb oper_minus - fcb 0x7b ; multiplication - fdb SNERROR - fcb 0x7b ; division - fdb SNERROR - fcb 0x7f ; exponentiation - fdb SNERROR - fcb 0x64 ; less than - fdb SNERROR - fcb 0x64 ; equal to - fdb SNERROR - fcb 0x64 ; greater than - fdb SNERROR - fcb 0x64 ; less than or equal to - fdb SNERROR - fcb 0x64 ; greater than or equal to - fdb SNERROR - fcb 0x64 ; not equal to - fdb SNERROR - fcb 0x50 ; boolean AND - fdb SNERROR - fcb 0x46 ; boolean OR - fdb SNERROR -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Set carry if upper/lower case alpha setcifalpha cmpa #'z+1 ; is it above lower case Z? bhs setcifalpha0 ; brif so, C clear
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/print.s Sun Aug 06 00:41:26 2023 -0600 @@ -0,0 +1,120 @@ + *pragmapush list + *pragma list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Print out an unsigned 16 bit value in D to the selected output stream +print_uint16d pshs d,x,y,u ; save number and make some temporaries on the stack + leay 2,s ; point to start of buffer + ldu #10000 ; do the 10000s digit + bsr print_uint16d4 + ldu #1000 ; do the 1000s digit + bsr print_uint16d4 + ldu #100 ; do the 100s digit + bsr print_uint16d4 + ldu #10 ; do the 10s digit + bsr print_uint16d4 + puls d ; get back number residue and clean up stack + addb #0x30 ; convert 1s digit to number + stb ,y ; stash it + clr 1,y ; NUL terminate it + leay ,s ; point to start of converted number +print_uint16d0 lda ,y ; get digit at start + cmpa #0x30 ; zero digit? + bne print_uint16d1 ; brif not - we can just show the number from here + ldb 1,y ; end of number? + beq print_uint16d1 ; brif so - show the zero anyway + leay 1,y ; move past the zero + bra print_uint16d0 ; see if we have more zeroes to skip +print_uint16d1 lda ,y+ ; get number digit + beq print_uint16d2 ; brif end of number + jsr writechr ; output the digit + bra print_uint16d1 ; handle next digit +print_uint16d2 leas 6,s ; clean up the stack + rts +print_uint16d4 lda #0x30-1 ; init digit value + pshs a,u ; save the digit position and digit value + ldd 5,s ; get back residue +print_uint16d5 inc ,s ; bump digit + subd 1,s ; subtract out place value + bcc print_uint16d5 ; brif we haven't got the right digit yet + addd 1,s ; restore residue + std 5,s ; save new residue + puls a,u ; get back digit and place value off stack + sta ,y+ ; save digit in buffer + rts + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; PRINT command +cmd_print beq cmd_printeol ; brif no argument - do a newline +cmd_print0 cmpa #'; ; semicolon? + bne cmd_print1 ; brif not + jsr nextchar ; skip the semicolon + bne cmd_print0 ; brif not end of the statement + rts +cmd_print1 jsr eval_expr ; evaluate the expression + ldb val0+val.type ; get value type + cmpb #valtype_int ; integer? + beq cmd_printint ; brif so - print integer + lda #'! ; flag unknown expression type + jsr console_outchr + jsr console_outchr + jsr console_outchr +cmd_printnext jsr curchar ; see what we have here + bra cmd_print ; and go process +cmd_printeol jmp console_outnl ; do a newline and return +cmd_printint leas -12,s ; make a buffer + leay ,s ; point to buffer + lda #0x20 ; default sign (positive) + ldb val0+val.int ; is it negative? + bpl cmd_printint0 ; brif not + jsr val_negint32 ; negate the integer + lda #'- ; negative sign +cmd_printint0 sta ,y+ ; save sign + ldu #cmd_printintpc ; point to positive constant table + ldx #10 ; there are 10 constants to process +; subtraction loop - positive residue +cmd_printint1 lda #'0-1 ; initialize digit + sta ,y +cmd_printint2 inc ,y ; bump digit + ldd val0+val.int+2 ; subtract constant + subd 2,u + std val0+val.int+2 + ldd val0+val.int + sbcb 1,u + sbca ,u + std val0+val.int + bcc cmd_printint2 ; brif we didn't go negative + ldd val0+val.int+2 ; undo last subtract + addd 2,u + std val0+val.int+2 + ldd val0+val.int + adcb 1,u + adca ,u + std val0+val.int + leay 1,y ; move to next digit in buffer + leau 4,u ; move to next constant + leax -1,x ; done all constants? + bne cmd_printint1 ; brif not - done all +cmd_printint5 clr ,y ; NUL terminate the string + leax 1,s ; point past the sign +cmd_printint6 lda ,x+ ; get digit + beq cmd_printint8 ; brif end of number + cmpa #'0 ; is it a zero? + beq cmd_printint6 ; brif so - skip it +cmd_printint7 lda ,s ; get the sign + sta ,--x ; put it at the start of the number + jsr console_outstr ; display the number + leas 12,s ; clean up stack + bra cmd_printnext ; go print the next thing +cmd_printint8 leax -1,x ; restore one of the zeros + bra cmd_printint7 ; go finish up +cmd_printintpc fqb 1000000000 ; 10^9 + fqb 100000000 ; 10^8 + fqb 10000000 ; 10^7 + fqb 1000000 ; 10^6 + fqb 100000 ; 10^5 + fqb 10000 ; 10^4 + fqb 1000 ; 10^3 + fqb 100 ; 10^2 + fqb 10 ; 10^1 + fqb 1 ; 10^0 + *pragmapop list