# HG changeset patch # User boisy # Date 1040942511 0 # Node ID 21e8bbf8d074b6c1aaf5fdf5c73b39909205581f # Parent 9904c8db123084c10fb363b58d9200c73a9be259 Chris Dekker's 6309 RunB, used for reference diff -r 9904c8db1230 -r 21e8bbf8d074 3rdparty/packages/basic09/runbcd.asm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/3rdparty/packages/basic09/runbcd.asm Thu Dec 26 22:41:51 2002 +0000 @@ -0,0 +1,5999 @@ + NAM Basic09Runtime + + IFP1 + USE defsfile + ENDC + +* RunB from BASICBOOST from Chris Dekker - 6309'ized version of RunB + +edition equ 1 +membase equ $00 +memsize equ $02 +moddir equ $04 +ResTop equ $08 top of reserved space +freemem equ $0C +table1 equ $0E +table2 equ $10 +table3 equ $12 +table4 equ $14 +extnum equ $18 +Vsys equ $20 +Vinkey equ $22 +holdnum equ $25 +errpath equ $2E +PGMaddre equ $2F starting address program +WSbase equ $31 base address workspace +errcode equ $36 +DATApoin equ $39 address DATA item +VarAddr equ $3C address of variable +fieldsiz equ $3E it's max. size +ArrBase equ $42 +SStop equ $44 top of string space area +userSP equ $46 subroutine stackpointer +exprSP equ $48 current expression +exprBase equ $4A expr.stack's base +callex equ $5D +callcode equ $5F +VarPtrba equ $62 +vectorba equ $66 +excoffse equ $6A module exec.offset +excEnd equ $6C +expneg equ $75 +digits equ $76 +decpoint equ $77 +negativ equ $78 +decimals equ $79 +charcoun equ $7D length output string +IOpath equ $7F +Sstack equ $80 start of current string +Spointer equ $82 end of current string +subrcode equ $85 +fieldwid equ $86 +justify equ $87 +BUPaddr equ $FB +BUPsize equ $FD + +MODMEM equ $2000 + + mod MODEND,MODNAM,Prgrm+Objct,$82,ENTRY,MODMEM + +MODNAM fcs /RunB/ + fcb edition + +* interrupt processing * +L93 lda 5,s native mode + bra L95 + +L94 LDA 3,S emulation mode +L95 TFR A,DP + STB <$35 +* oim #$80,<$34 + fcb 1,$80,$34 + RTI + +* Check for processor type? +procID pshs d + comd Will only do COMA on 6809 + cmpb 1,s + beq L6809 + puls pc,d + +L6809 leax $2829, changed since seemed wrong +* cmpw #'(*256+') Just ()? + cmpw $2829 + bne L141 No, go process parameters + leax -2,x + sta ,x delete empty string + subb #2 +L141 clre + tfr b,f string length + leay -1,y + tfm x-,y- copy -> org. position + leax 1,y + rts + +quote tste + beq L137 + ste ,x+ + incb +L137 rts + +ENTRY lbsr procID check processor + tfr u,d + ldw #256 + clr ,-s + tfm s,u+ + LEAU ,X + STD membase + INCA + STA <$D9 + STD Sstack + STD Spointer + inca + inca + STD userSP + STD SStop + INCA + TFR D,S + STD moddir + INCA + STD ResTop + STD exprBase + tfr x,y + lbsr skpblank +L90 lda ,y+ + cmpa #32 + beq L89 + cmpa #13 + beq L97 no params + bra L90 skip modulename + +L89 lbsr skpblank + cmpa #40 left par.?? + beq L97 format OK + lbsr L302 check char + bcc L99 = letter or number + cmpa #45 = - + beq L99 + cmpa #47 = / + bne L97 do not adjust format +L99 lbsr chprm +L97 TFR X,D + SUBD membase + STD memsize + LDB #1 default errpath + STB <$2E + LDA #3 Close all paths 4-16 +L92 os9 I$Close + INCA + CMPA #$10 + BLO L92 + CLR <$35 + PSHS X,DP + pshs x,y Setup up a stack big enough for 6309 RTI + pshs u,y,x,dp,d,cc + leax -$FE,S + JMP [-2,U] + +err43 LDB #$2B +L118 LBSR PRerror +L116 LDS <$B7 + PULS d + STD <$B7 +ClrSstac lde #1 + ste charcoun + LDW Sstack + STW Spointer + rts + +L108 LDD <$B7 + PSHS d + STS <$B7 + LDD 2,S + STX 2,S + TFR D,PC +L106 BSR L102 + BRA BYE + +* ----------------------- * +L134 LBSR skpblank + LBSR link + BCS err43 + LDX ,X + STX PGMaddre + LDA 6,X + BEQ L144 + ANDA #$0F + CMPA #2 B09 program? + BNE err51 + BRA L148 + +L144 LDA <$17,X BASIC09 program has no errors? + RORA + BCS err51 Errors, report it +L148 LBSR L230 check prmlist + LDY exprBase + LDB ,Y + CMPB #$3D + BEQ err51 + STY excoffse + LDX <$AB + STX excEnd + LDX PGMaddre + LDA <$17,X + RORA + BCS err51 + LEAS >$0102,S + LDD membase + ADDD memsize + TFR D,Y + STD userSP + STD SStop + LDU #0 + STU WSbase + STU <$B3 + INC <$B4 + CLR errcode + LDD exprBase + LDX freemem + PSHS X,d + LEAX number + EXG X,Y + BCS err22 + LDA ,X+ + CMPA #2 + RTS + +err22 LDA #$16 + BRA L288 + +L17 BSR L272 + BRA L290 + +L294 BSR L222 +L290 LDA ,Y+ + CMPA #$0D + BEQ err41 + CMPA #$22 " ?? + BNE L294 + CMPA ,Y+ + BEQ L294 + LEAY -1,Y + LDA #$FF +L278 BRA L222 + +err41 LDA #$29 +L288 LBRA L252 + + LDA #$31 error 49 (HOW DOES IT GET HERE?) + BRA L288 + +L222 PSHS X,D + LDX <$AB + STA ,X+ + STX <$AB + LDD <$AB + SUBD exprBase + CMPB #$FF + BCC err13 + CLRA + PULS PC,X,D + +err13 LDA #$0D + LBSR PRerror + LBRA L116 + +* +skpblank LDA ,Y+ + CMPA #$20 + BEQ skpblank skip blanks + CMPA #$0A + BEQ skpblank and LF's + LEAY -1,Y + RTS + +L302 BSR ISlett + BCC L308 +ISnum CMPA #$30 0 ?? + BCS L308 + CMPA #$39 9 ?? + BLS L310 + BRA L312 + +ISlett ANDA #$7F + CMPA #$41 A ?? + BCS L308 + CMPA #$5A Z ?? + BLS L310 + CMPA #$5F _ ?? + BEQ L308 + CMPA #$61 a ?? + BCS L308 + CMPA #$7A z ?? + BLS L310 +L312 ORCC #1 NO + RTS + +L310 ANDCC #$FE YES +L308 RTS + +* search prm list for special chars * +L266 PSHS U,Y,X,A + LDU -3,X + LDB -1,X +L326 STX 1,S + CMPU #0 USE CMPR 0,U (SAME SPEED, 2 BYTES SHORTER) + BEQ L320 + LEAU -1,U + LDY 3,S + LEAX B,X +L328 LDA ,X+ + EORA ,Y+ + BEQ L322 + CMPA ,S + BEQ L322 + LEAX -1,X +L324 LDA ,X+ + BPL L324 + BRA L326 + +L322 TST -1,X + BPL L328 + STY 3,S +L320 PULS PC,U,Y,X,A + +L710 fdb L1900-L710 table @ L204 + fdb L1900-L710 PARAM + fdb L1900-L710 TYPE + fdb L1900-L710 DIM + fdb L1900-L710 DATA + fdb STOP-L710 + fdb BYE-L710 + fdb L386-L710 TRON + fdb L386-L710 TROFF + fdb L386-L710 PAUSE + fdb DEG-L710 + fdb RAD-L710 + fdb RETURN-L710 + fdb L370-L710 + fdb LET-L710 + fdb POKE-L710 + fdb IF-L710 + fdb GOTO-L710 = ELSE + fdb ENDIF-L710 + fdb FOR-L710 + fdb NEXT-L710 table @ L388 + fdb UNTIL-L710 = WHILE + fdb GOTO-L710 = ENDWHILE + fdb L370-L710 = REPEAT + fdb UNTIL-L710 + fdb L370-L710 = LOOP + fdb GOTO-L710 = ENDLOOP + fdb UNTIL-L710 = EXITIF + fdb GOTO-L710 = ENDEXIT + fdb ON-L710 + fdb ERROR-L710 + fdb errs51-L710 + fdb GOTO-L710 + fdb errs51-L710 + fdb GOSUB-L710 + fdb RUN-L710 + fdb KILL-L710 + fdb INPUT-L710 + fdb PRINT-L710 + fdb CHD-L710 + fdb CHX-L710 + fdb CREATE-L710 + fdb OPEN-L710 + fdb SEEK-L710 + fdb READ-L710 + fdb WRITE-L710 + fdb GET-L710 + fdb PUT-L710 + fdb CLOSE-L710 + fdb RESTORE-L710 + fdb DELETE-L710 + fdb CHAIN-L710 + fdb SHELL-L710 + fdb BASE0-L710 + fdb BASE1-L710 + fdb 386-L710 REM + fdb 386-L710 + fdb END-L710 +* From here on is added from original BASIC09 table @ L1D60 + fdb L1943-L710 go to next instruction + fdb L1943-L710 + fdb L1944-L710 jump to [regs.x] + fdb errs51-L710 + fdb L386-L710 RTS + fdb L386-L710 + fdb CpMbyte-L710 + fdb CpMint-L710 + fdb CpMreal-L710 + fdb CpMbyte-L710 + fdb CpMstrin-L710 + fdb CpMarray-L710 +L448 fcc /STOP Encountered/ + fcb 10,255 + +* +* setup workspace for module +L676 LDA $17,X + BITA #1 + BEQ L346 + LBRA errs51 + +L346 TFR S,D + deca + CMPD Sstack + BCC L350 + LDB #$39 error 57 (system stack overflow) + BRA L348 + +L350 LDD freemem + SUBD $0B,X + BCS err32 + CMPD #$0100 + BCC L354 +err32 LDB #$20 +L348 LBRA L356 + +L354 STD freemem + TFR Y,D + SUBD $0B,X + EXG D,U + STS 5,U + STD 7,U + STX 3,U +L344 LDD #1 default:base 1 + STD ArrBase + STA 1,U default: radians + STA <$13,U + STU $14,U + BSR L358 + LDD <$13,X + BEQ L360 + ADDD excoffse +L360 STD DATApoin + LDW $0B,X + LDD <$11,X + LEAY D,U + subr d,w + bls L362 + clr ,-s + tfm s,y+ + LEAS 1,S +L362 LDX PGMaddre + LDD excoffse + ADDD <$15,X + TFR D,X + BRA L366 start execution + +* +L358 STX PGMaddre + STU WSbase + LDD $0D,X + ADDD PGMaddre + STD VarPtrba + LDD $0F,X + ADDD PGMaddre + STD vectorba + STD excEnd + LDD 9,X + ADDD PGMaddre + STD excoffse + LDD $14,U + STD userSP + STD SStop + RTS + +*** MAIN LOOP +L372 LDA <$34 Check if signal received + BPL L368 No, execute next instruction + ANDA #$7F flag signal received + STA <$34 + LDB <$35 + BNE L348 process it +L368 BSR L370 +L366 CMPX excEnd + BCS L372 + BRA L374 + +* +END LDB ,X + LBSR nextinst + BEQ L374 + LBSR PRINT +L374 LDU WSbase + LDS 5,U + LDU 7,U +L386 RTS + +L1943 LEAX 2,X +L370 LDB ,X+ + BPL L382 + ADDB #$40 +L382 ASLB + CLRA + LDU table1 = L710 + LDD D,U + JMP D,U go to instruction + +* +IF JSR table4 if.... + TST 2,Y + BEQ GOTO = FALSE + LEAX 3,X THEN + LDB ,X + CMPB #$3B + BNE L386 + LEAX 1,X ELSE +GOTO LDD ,X + ADDD excoffse + TFR D,X + RTS + +ENDIF LEAX 1,X + RTS + +UNTIL JSR table4 + TST 2,Y + BEQ GOTO = FALSE + LEAX 3,X + RTS + +* +L388 fdb L70-L388 int. step 1 + fdb L71-L388 int. step x + fdb L72-L388 real step 1 + fdb L73-L388 real step x + +* +NEXT LEAY next instruction + rts + +SYSCALL ldd 2,x + cmpa #$4D marker + lbne err56 + cmpb #$0E + bne L401 + leax 4,x callcode = variable + jsr table4 + lda ,u + sta callcode + bra L403 + +L401 lda 5,x callcode = static + sta callcode + leax 6,x +L403 bsr L391 + ldd fieldsiz + cmpd #10 + lbne err56 wrong data structure + pshs x + pshs u + ldd 1,u u -> data + ldx 4,u + ldy 6,u + ldu 8,u + jsr prmstack + LDD <$40 + subr y,d stacksize + lsrd + lsrd + PSHS d number of elements + LDD 9,X + LEAY L676,PC + JSR D,X run ML subroutine + LDU WSbase + LDS 5,U + PULS X + STX 5,U + BCC L678 no error on exit + LBRA L356 + +* run Basic09 subroutine * +B09subr fcb 2,$7f,$34 +* aim #$7F,<$34 + ldd #$FFFF + std Vsys clear links + std Vinkey + LBSR L676 + LDA ,U + BITA #1 + BEQ L678 no error on exit + LDA ,U + STA <$34 +L678 LDQ $0D,U reset DP pointers + STD exprBase + STW <$40 + LDD 9,U + STD DATApoin + LDB 2,U + SEX + STD ArrBase + LDX 3,U + LBSR L358 + LDX $0B,U + LDD SStop + SUBD exprBase + STD freemem + ldd #$FFFF + std Vinkey + std Vsys + RTS + +ISinkey leax stack + BRA L704 + +L684 LDY userSP + STY <$40 +L704 TFR Y,D + SUBD exprBase + LBCS err32 + STD freemem + puls x,a + PULS PC,U,D + +********************************* + fdb MID$-L1386 + fdb LEFT$-L1386 + fdb RIGHT$-L1386 + fdb CHR$-L1386 + fdb STR$int-L1386 + fdb STR$rl-L1386 + fdb DATE$-L1386 + fdb TAB-L1386 + fdb FIX-L1386 + fdb fixN1-L1386 + fdb fixN2-L1386 + fdb FLOAT-L1386 + fdb float2-L1386 + fdb LNOTB-L1386 + fdb NEGint-L1386 + fdb NEGrl-L1386 + fdb LANDB-L1386 + fdb LORB-L1386 + fdb LXORB-L1386 + fdb Igt-L1386 + fdb Rgt-L1386 + fdb Sgt-L1386 + fdb Ilo-L1386 + fdb Rlo-L1386 + fdb Slo-L1386 + fdb Ine-L1386 + fdb Rne-L1386 + fdb Sne-L1386 + fdb Bne-L1386 + fdb Ieq-L1386 + fdb Req-L1386 + fdb Seq-L1386 + fdb Beq-L1386 + fdb Ige-L1386 + fdb Rge-L1386 + fdb Sge-L1386 + fdb Ile-L1386 + fdb Rle-L1386 + fdb Sle-L1386 + fdb INTADD-L1386 + fdb RLADD-L1386 + fdb STRconc-L1386 + fdb INTSUB-L1386 + fdb RLSUB-L1386 + fdb INTMUL-L1386 + fdb RLMUL-L1386 + fdb INTDIV-L1386 + fdb RLDIV-L1386 + fdb POWERS-L1386 + fdb POWERS-L1386 + fdb DIM-L1386 + fdb DIM-L1386 + fdb DIM-L1386 + fdb DIM-L1386 + fdb PARAM-L1386 + fdb PARAM-L1386 + fdb PARAM-L1386 + fdb PARAM-L1386 + fcb 0,0,0,0,0,0,0,0,0,0,0,0 + +******************************* +L1386 fdb BCPVAR-L1386 + fdb ICPVAR-L1386 + fdb L2102-L1386 copy real number + fdb BlCPVAR-L1386 + fdb SCPVAR-L1386 + fdb L2105-L1386 copy DIM array + fdb L2105-L1386 + fdb L2105-L1386 + fdb L2105-L1386 + fdb L2106-L1386 copy PARAM array + fdb L2106-L1386 + fdb L2106-L1386 + fdb L2106-L1386 + fdb BCPCNST-L1386 + fdb ICPCNST-L1386 + fdb RCPCNST-L1386 + fdb SCPCNST-L1386 + fdb ICPCNST-L1386 + fdb ADDR-L1386 + fdb ADDR-L1386 + fdb SIZE-L1386 + fdb SIZE-L1386 + fdb POS-L1386 + fdb ERR-L1386 + fdb MODint-L1386 + fdb MODrl-L1386 + fdb RND-L1386 + fdb PI-L1386 + fdb SUBSTR-L1386 + fdb SGNint-L1386 + fdb SGNrl-L1386 + fdb L2122-L1386 transc. functions + fdb L2123-L1386 + fdb L2124-L1386 + fdb L2125-L1386 + fdb L2126-L1386 + fdb L2127-L1386 + fdb EXP-L1386 + fdb ABSint-L1386 + fdb ABSrl-L1386 + fdb LOG-L1386 ln + fdb LOG10-L1386 + fdb SQRT-L1386 + fdb SQRT-L1386 + fdb FLOAT-L1386 + fdb INTrl-L1386 + fdb L1058-L1386 RTS + fdb FIX-L1386 + fdb FLOAT-L1386 + fdb L1058-L1386 RTS + fdb SQint-L1386 + fdb SQrl-L1386 + fdb PEEK-L1386 + fdb LNOTI-L1386 + fdb VAL-L1386 + fdb LEN-L1386 + fdb ASC-L1386 + fdb LANDI-L1386 + fdb LORI-L1386 + fdb LXORI-L1386 + fdb equTRUE-L1386 + fdb equFALSE-L1386 + fdb EOF-L1386 + fdb TRIM$-L1386 + +***************************** +L1388 fdb BtoI-L1388 + fdb INTCPY-L1388 + fdb RCPVAR-L1388 + fdb L13-L1388 + fdb L14-L1388 + fdb L15-L1388 + +***************************** +L1390 LDY userSP = table4 + LDD exprBase + STD exprSP clear expr.stack + BRA L724 + +L726 ASLB + LDU table2 -> L1386 + LDD B,U + JSR D,U +L724 LDB ,X+ + BMI L726 next part + CLRA clear carry + LDA ,Y + RTS instruction done + +* get size of DIM array +L2105 BSR L728 +L732 PSHS PC,U + LDU table3 -> L1388 + ASLA + LDD A,U + LEAU D,U + STU 2,S + PULS PC,U + +* get size of PARAM array +L2106 BSR L730 + BRA L732 + +DIM LEAS 2,S + LDA #$F2 + BRA L734 + +PARAM LEAS 2,S + LDA #$F6 + BRA L736 + +L730 LDA #$89 +L736 STA <$A3 + CLR <$3B + BRA L738 + +L728 LDA #$85 +L734 STA <$A3 + STA <$3B +L738 LDD ,X++ + ADDD VarPtrba + STD <$D2 + LDU <$D2 points to var. marker + LDA ,U + ANDA #$E0 + STA <$CF + EORA #$80 + STA <$CE + LDA ,U + ANDA #7 + LDB -3,X + SUBB <$A3 + PSHS d + LDA ,U + ANDA #$18 + LBEQ L740 + LDD 1,U + ADDD vectorba + TFR D,U + LDD ,U + STD VarAddr + LDA 1,S + BNE L742 first access + LDA #5 + STA ,S + LDD 2,U + STD fieldsiz + clrd + BRA L744 + +L742 LEAY -6,Y + clrd + STD 1,Y + LEAU 4,U + BRA L746 + +L754 LDD ,U should be able to change to raw MULD? + STD 1,Y + LBSR INTMUL +L746 LDD 7,Y + SUBD ArrBase adjust to base 0 + CMPD ,U++ + BLO L750 + LDB #$37 error 55 + LBRA L356 + +L750 ADDD 1,Y + STD 7,Y + DEC 1,S + BNE L754 next element + LDA ,S + BEQ L756 bytes + CMPA #2 + BCS L758 integers + BEQ L760 real numbers + CMPA #4 + BCS L756 boolean + LDD ,U string + STD fieldsiz + BRA L762 + +L756 LDD 7,Y number of elements + BRA L764 + +L758 LDD 7,Y + asld x 2 +L764 LEAY $0C,Y + BRA L744 + +L760 LDD #5 +L762 STD 1,Y + LBSR INTMUL x 5 (change to internal MULD) + LDD 1,Y array size + LEAY 6,Y Eat temp var +L744 TST <$CE + BNE L766 + LDW VarAddr + ADDW WSbase + CMPW <$40 + BCC err56 too big! + TFR W,U + CMPD 2,U + BHI err56 too big! + ADDD ,U + BRA L770 + +L766 ADDD VarAddr + TST <$3B + BNE L772 +L776 ADDD 1,Y + LEAY 6,Y + BRA L770 + +L740 LDA ,S + CMPA #4 + LDD 1,U + BCS L774 + ADDD vectorba + TFR D,U + LDQ ,U + STW fieldsiz +L774 TST <$3B + BEQ L776 PARAM + ADDD WSbase + TFR D,U + TST <$CE + BNE L778 + CMPD <$40 + BCC err56 too big! + LDD fieldsiz + CMPD 2,U + BLO L780 + LDD 2,U + STD fieldsiz reset fieldwidth +L780 LDU ,U + BRA L778 + +L772 ADDD WSbase +L770 TFR D,U +L778 CLRA + PULS PC,d + +err56 LDB #$38 + LBRA L356 + +BCPCNST LEAU ,X+ + BRA BtoI + +BCPVAR LDD ,X++ + ADDD WSbase + TFR D,U +BtoI LDB ,U + CLRA + LEAY -6,Y + STD 1,Y + LDA #1 + STA ,Y + RTS + +ICPCNST LEAU ,X++ + BRA INTCPY + +ICPVAR LDD ,X++ + ADDD WSbase + TFR D,U +INTCPY LDD ,U + LEAY -6,Y + STD 1,Y + LDA #1 + STA ,Y + RTS + +NEGint clrd + SUBD 1,Y + STD 1,Y + RTS + +INTADD LDD 7,Y + ADDD 1,Y + LEAY 6,Y + STD 1,Y + RTS + +INTSUB LDD 7,Y + SUBD 1,Y + LEAY 6,Y + STD 1,Y + RTS + +INTMUL LDD 7,Y + BEQ L786 + muld 1,y + stw 7,y +L786 LEAY 6,Y + RTS + +INTDIV clre + ldd 1,y + bne L801 + LDB #$2D error 45 + LBRA L356 + +L801 cmpd #1 + beq L803 + bpl L800 + come + negd + std 1,y +L800 cmpd #2 + bne L810 + LDD 7,Y divide by 2 + BEQ L803 + bpl L802 + negd + come +L802 ste ,y + clrw + asrd + rolw + BRA L806 + +L810 ldd 7,y + bne L812 +L803 clrd always 0 + STD 9,Y + LEAY 6,Y + RTS + +L812 bpl L814 + come + negd +L814 ste ,y + tfr d,w + clrd + divq 1,y + exg d,w +L806 tst ,y + bpl L820 answer = pos. + negd + comw + incw +L820 STQ 7,Y +L822 LEAY 6,Y + RTS + +RCPCNST LEAY -6,Y + LDB ,X+ + LDA #2 + STD ,Y + LDQ ,X + STQ 2,Y + leax 4,x + RTS + +L2102 LDD ,X++ + ADDD WSbase + TFR D,U +RCPVAR LEAY -6,Y + LDA #2 + LDB ,U + STD ,Y + LDQ 1,U + STQ 2,Y + RTS + +* invert sign of real number +NEGrl fcb $62,1,$25 +* eim #1,5,y + rts + +RLSUB fcb $62,1,$25 +* eim #1,5,y +RLADD TST 2,Y + BEQ L824 = +0 + TST 8,Y + BNE L826 +L830 LDQ 1,Y = 0+x + STQ 7,Y + LDA 5,Y + STA $0B,Y +L824 LEAY 6,Y + rts + +* compare exponents +L826 LDA 7,Y + SUBA 1,Y + BVC L828 + BPL L830 + BRA L824 + +L828 BMI L832 + CMPA #$1F + BLE L834 + BRA L824 change insignif. + +L832 CMPA #$E1 + BLT L830 change insignif. + LDB 1,Y + STB 7,Y +* calc. sign of answer +L834 LDB $0B,Y + ANDB #1 + STB ,Y + EORB 5,Y + ANDB #1 + STB 1,Y sign of answer +* clear original signs +* aim #$FE,11,y +* aim #$FE,5,y + fcb $62,$fe,$2b + fcb $62,$fe,$25 +* calc. answer + TSTA + BEQ L836 + tfr y,w + BPL L838 + NEGA + addw #6 + BSR L840 + TST 1,Y + BEQ L842 +* substract mantissas +L848 SUBW 4,Y + sbcd 2,Y + BCC L844 + comd + comw + addw #1 + adcd #0 +L846 DEC ,Y + BRA L844 + +L838 BSR L840 + STQ 2,Y +L836 LDQ 8,Y + TST 1,Y + BNE L848 +* add mantissas +L842 ADDW 4,Y + adcd 2,Y + BCC L844 + rord + rorw + INC 7,Y +L844 TSTA + BMI L850 + andcc #^Carry clear carry +L854 DEC 7,Y shift to proper form + BVS equ0 + rolw + rold + BPL L854 +L850 addw #1 + adcd #0 + BCC L856 + RORA + INC 7,Y +L856 STD 8,Y + TFR W,D + lsrb + lslb + orb ,y add sign +L858 STD $0A,Y + LEAY 6,Y + rts + +L840 SUBA #$10 + BCS L860 + SUBA #8 + BCS L862 + PSHS A + CLRA + LDB 2,W + BRA L864 + +L862 ADDA #8 + PSHS A + LDD 2,W +L864 clrw + TST ,S + BEQ L866 + exg d,w + BRA L872 +L860 ADDA #8 + BCC L870 + PSHS A + CLRA + LDB 2,W + LDW 3,W + TST ,S + BNE L872 + BRA L866 + +L870 ADDA #8 + PSHS A + LDQ 2,W +L872 lsrd + rorw + DEC ,S + BNE L872 +L866 LEAS 1,S + RTS + +RLMUL LDA 2,Y + BPL equ0 + LDA 8,Y + BMI L876 +equ0 clrd + clrw + STQ 7,Y + STA $0B,Y + LEAY 6,Y + rts + +L876 LDA 1,Y + ADDA 7,Y + BVC L878 +L916 BPL equ0 + LDB #$32 error 50 + lbra L356 + +L878 STA 7,Y + LDB $0B,Y + EORB 5,Y + ANDB #1 + STB ,Y + LDA $0B,Y + ANDA #$FE + STA $0B,Y + LDB 5,Y + ANDB #$FE + STB 5,Y + MUL + clrw + clr extnum + tfr a,f + LDA $0B,Y + LDB 4,Y + MUL + addr d,w + BCC L880 + inc extnum +L880 LDA $0A,Y + LDB 5,Y + MUL + addr d,w + BCC L882 + inc extnum +L882 tfr e,f + lde extnum + clr extnum + LDA $0B,Y + LDB 3,Y + MUL + addr d,w + BCC L884 + inc extnum +L884 LDA $0A,Y + LDB 4,Y + MUL + addr d,w + BCC L886 + inc extnum +L886 LDA 9,Y + LDB 5,Y + MUL + addr d,w + BCC L888 + inc extnum +L888 tfr e,f + lde extnum + clr extnum + LDA $0B,Y + LDB 2,Y + MUL + addr d,w + BCC L890 + inc extnum +L890 LDA $0A,Y + LDB 3,Y + MUL + addr d,w + BCC L892 + inc extnum +L892 LDA 9,Y + LDB 4,Y + MUL + addr d,w + BCC L894 + inc extnum +L894 LDA 8,Y + LDB 5,Y + MUL + addr d,w + BCC L896 + inc extnum +L896 stf 11,y + tfr e,f + lde extnum + clr extnum + LDA $0A,Y + LDB 2,Y + MUL + addr d,w + BCC L898 + inc extnum +L898 LDA 9,Y + LDB 3,Y + MUL + addr d,w + BCC L900 + inc extnum +L900 LDA 8,Y + LDB 4,Y + MUL + addr d,w + BCC L902 + inc extnum +L902 stf 10,y + tfr e,f + lde extnum + clr extnum + LDA 9,Y + LDB 2,Y + MUL + addr d,w + BCC L904 + inc extnum +L904 LDA 8,Y + LDB 3,Y + MUL + addr d,w + BCC L906 + inc extnum +L906 LDA 8,Y + LDB 2,Y + MUL + tfr w,u + tfr e,f + lde extnum + exg d,u + addr u,w + BMI L908 + asl 11,y + rol 10,y + rolb + rolw + DEC 7,Y + LBVS L916 +L908 tfr b,a + LDB $0A,Y + exg d,w + ADDW #1 + adcd #0 + BNE L914 + rora + INC 7,Y +L914 exg d,w + lsrb + lslb + ORB ,Y + STD $0A,Y + stw 8,y + LEAY 6,Y + rts + +RLDIV TST 2,Y + BNE L920 + LDB #$2D error 45 + lbra L356 + +L920 TST 8,Y + LBEQ equ0 + LDA 7,Y + SUBA 1,Y + LBVS L916 + STA 7,Y + LDA #$21 + LDB 5,Y + EORB $0B,Y + ANDB #1 + STD ,Y + ldq 2,y + lsrd + rorw + stq 2,y + LDQ 8,Y + lsrd + rorw + CLR $0B,Y +L932 SUBW 4,Y + sbcd 2,y + BEQ L926 + BMI L928 +L936 ORCC #1 +L938 DEC ,Y + BEQ L930 + ROL $0B,Y + ROL $0A,Y + ROL 9,Y + ROL 8,Y + andcc #^Carry + rolw + rold + BCC L932 + ADDW 4,Y + adcd 2,y + BEQ L926 + BPL L936 +L928 ANDCC #$FE + BRA L938 + +L926 tstw + BNE L936 + LDB ,Y + DECB + SUBB #$10 + BLT L940 + SUBB #8 + BLT L942 + STB ,Y + LDA $0B,Y + LDB #$80 + andcc #^Carry + BRA L946 + +L942 ADDB #8 + STB ,Y + LDW #$8000 + LDD $0A,Y + andcc #^Carry + BRA L946 + +L940 ADDB #8 + BLT L948 + STB ,Y + LDQ 9,Y + LDF #$80 + andcc #^Carry + BRA L946 + +L948 ADDB #7 + STB ,Y + LDQ 8,Y + ORCC #1 +L950 rolw + rold +L946 DEC ,Y + BPL L950 + TSTA + BRA L952 + +L930 LDQ 8,Y +L952 BMI L954 + rolw + rold + DEC 7,Y + LBVS equ0 +L954 addw #1 + adcd #0 + BCC L956 + RORA + INC 7,Y + LBVS equ0 +L956 STD 8,Y + TFR W,D + lsrb + lslb + ORB 1,Y + STD $0A,Y + INC 7,Y + LBVS L916 +L958 LEAY 6,Y + rts + +POWERS LDD 7,Y + BEQ L958 + LDW 1,Y + BNE L960 + LEAY 6,Y +L1152 LDD #$0180 + clrw + STQ 1,Y + ste 5,y + rts + +L960 STD 1,Y + STW 7,Y + LDD 9,Y + LDW 3,Y + STD 3,Y + STW 9,Y + LDA $0B,Y + LDB 5,Y + STA 5,Y + STB $0B,Y + LBSR LOG = ln + LBSR RLMUL + LBRA EXP + +BlCPVAR LDD ,X++ + ADDD WSbase + TFR D,U +L13 LDB ,U + CLRA + LEAY -6,Y + STD 1,Y + LDA #3 + STA ,Y + RTS + +LANDB LDB 8,Y + ANDB 2,Y + BRA L968 + +LORB LDB 8,Y + ORB 2,Y + BRA L968 + +LXORB LDB 8,Y + EORB 2,Y +L968 LEAY 6,Y + STD 1,Y + RTS + +LNOTB COM 2,Y + RTS + +StrCMP PSHS Y,X + LDX 1,Y + LDY 7,Y + STY exprSP +L972 LDA ,Y+ + CMPA ,X+ + BNE L970 + CMPA #$FF + BNE L972 +L970 INCA + INC -1,X + CMPA -1,X + PULS PC,Y,X + +Slo BSR StrCMP + BLO L976 + BRA L978 + +Sle BSR StrCMP + BLS L976 + BRA L978 + +Seq BSR StrCMP + BEQ L976 + BRA L978 + +Sne BSR StrCMP + BNE L976 + BRA L978 + +Sge BSR StrCMP + BHS L976 + BRA L978 + +Sgt BSR StrCMP + BHI L976 + BRA L978 + +Ilo LDD 7,Y + SUBD 1,Y + BLT L976 + BRA L978 + +Ile LDD 7,Y + SUBD 1,Y + BLE L976 + BRA L978 + +Ine LDD 7,Y + SUBD 1,Y + BNE L976 + BRA L978 + +Ieq LDD 7,Y + SUBD 1,Y + BEQ L976 + BRA L978 + +Ige LDD 7,Y + SUBD 1,Y + BGE L976 + BRA L978 + +Igt LDD 7,Y + SUBD 1,Y + BLE L978 +L976 LDB #$FF + BRA L980 + +L978 clrb +L980 CLRA + LEAY 6,Y + STD 1,Y + LDA #3 + STA ,Y + RTS + +Beq LDB 8,Y + CMPB 2,Y + BEQ L976 + BRA L978 + +Bne LDB 8,Y + CMPB 2,Y + BNE L976 + BRA L978 + +Rlo BSR RLCMP + BLO L976 + BRA L978 + +Rle BSR RLCMP + BLS L976 + BRA L978 + +Rne BSR RLCMP + BNE L976 + BRA L978 + +Req BSR RLCMP + BEQ L976 + BRA L978 + +Rge BSR RLCMP + BHS L976 + BRA L978 + +Rgt BSR RLCMP + BHI L976 + BRA L978 + +RLCMP PSHS Y + LDA $0B,Y Get sign of 2nd # + ANDA #1 + ldb 5,y Get sign of 1st # + andb #1 + cmpr a,b Same sign? + bne L996 No, skip ahead +L988 LEAU 6,Y signs are the same + tsta + BEQ L994 positive numbers + EXG U,Y invert them +L994 LDQ 1,U + CMPD 1,Y + bne L993 + CMPW 3,Y + BNE L996 + LDA 5,U + CMPA 5,Y +L996 PULS PC,Y + +L993 pshs cc + eora 1,y + bpl L992 no/both fractions + tstb + beq L992 n1 = 0 + tst 2,y + beq L992 n2 = 0 +* eim #1,0,s + fcb $65,1,$60 +L992 puls pc,y,cc + +* copy string +SCPCNST CLRB + LDU exprSP + LEAY -6,Y + STU 1,Y starting address + STY SStop +L1004 cmpr y,u + BCC err47 + LDA ,X+ + STA ,U+ + CMPA #$FF + BEQ L1001 + INCB + BNE L1004 + LDA #$FF + STA ,U+ +L1001 clra + std 3,y size of string +L1002 STU exprSP + LDA #4 + STA ,Y type: string + RTS + +err47 LDB #$2F + LBRA L356 + +L14 tfr u,d + ldw fieldsiz + bra L1007 +* copy string to expression stack +SCPVAR LDD ,X++ + ADDD vectorba + TFR D,U array vector + LDQ ,U address,size target + ADDD WSbase + stw fieldsiz +L1007 ldu exprSP + leay -6,y + stu 1,y starting address + sty SStop + cmpd BUPaddr + beq L1009 + addr w,u + cmpr y,u + bhs err47 too big + ldu 1,y + pshs x + tfr d,x origin + stx BUPaddr +L1003 lda ,x+ + sta ,u+ + cmpa #$FF + beq L1005 + decw + bne L1003 + lda #$FF + sta ,u+ +L1005 comw negate left-over + incw + addw fieldsiz + stw 3,y size of string + stw BUPsize + puls x + bra L1002 + +L1009 ldw BUPsize + stw 3,y + tfm d+,u+ + lda #$FF + sta ,u+ + bra L1002 + +STRconc LDU 1,Y + ldw 3,y + incw + tfr u,d + decd + tfm u+,d+ + STD exprSP + ldd 3,y + leay 6,y + addd 3,y + std 3,y length new string + RTS + +L15 LDD fieldsiz + LEAY -6,Y + STD 3,Y + STU 1,Y + LDA #5 + STA ,Y + RTS + +FLOAT clrd + STD 4,Y + LDD 1,Y + BNE L1012 + STB 3,Y + LDA #2 + STA ,Y + RTS + +L1012 LDW #$0210 + TSTA + BPL L1014 + negd + INC 5,Y +L1014 TSTA + BNE L1016 + LDW #$0208 + EXG A,B +L1016 TSTA + BMI L1018 +L1020 decw + asld + BPL L1020 +L1018 STD 2,Y + STW ,Y + RTS + +float2 LEAY 6,Y + BSR FLOAT + LEAY -6,Y + RTS + +FIX ldw 1,y + ldd 4,y + tste + BGT L1024 + BMI L1026 + tstf + BPL L1026 + LDW #1 + BRA L1028 + +L1026 clrw + BRA L1030 + +L1024 SUBE #$10 + BHI err52 + BNE L1034 + LDW 2,Y + rorb + BCC L1030 + CMPW #$8000 + BNE err52 + tsta + BPL L1030 + BRA err52 + +L1034 pshs b + tfr e,b + ldw 2,y + cmpb #$F8 + BHI L1036 + tfr f,a + tfr e,f + clre + ADDB #8 + BEQ L1038 +L1036 lsrw + rora + INCB + BNE L1036 +L1038 puls b + tsta + BPL L1028 + incw + BVC L1028 +err52 LDB #$34 + LBRA L356 + +L1028 RORB + BCC L1030 + comw + incw +L1030 STW 1,Y + std 4,y + LDA #1 + STA ,Y + RTS + +fixN1 LEAY 6,Y + BSR FIX + LEAY -6,Y + RTS + +fixN2 LEAY $0C,Y + BSR FIX + LEAY -$0C,Y + RTS + +ABSrl fcb $62,$fe,$25 +* AIM #$FE,5,y + RTS + +ABSint LDD 1,Y + BPL L1042 + NEGD + STD 1,Y +L1042 RTS + +PEEK CLRA + LDB [1,Y] + STD 1,Y + RTS + +SGNrl LDA 2,Y + BEQ L1044 + LDA 5,Y + ANDA #1 + BNE L1046 +L1050 LDB #1 + BRA L1048 + +SGNint LDD 1,Y + BMI L1046 + BNE L1050 +L1044 CLRB + BRA L1048 + +L1046 LDB #$FF +L1048 SEX + BRA L1052 + +ERR LDB errcode + CLR errcode +L1054 CLRA + LEAY -6,Y +L1052 STD 1,Y + LDA #1 + STA ,Y +L1058 RTS + +POS LDB charcoun + BRA L1054 + +SQRT LDB 5,Y + ASRB + LBCS err67 + LDB #$1F + STB <$6E + LDD 1,Y + BEQ L1058 + INCA + ASRA + STA 1,Y + LDQ 2,Y + BCS L1060 + lsrd + rorw +L1060 STQ -4,Y + clrd + clrw + STQ 2,Y + STQ -8,Y + BRA L1064 + +L1070 ORCC #1 + ldq 2,y + rolw + rold + DEC <$6E + BEQ L1066 + stq 2,y + BSR L1068 +L1064 LDB -4,Y + SUBB #$40 + STB -4,Y + LDD -6,Y + sbcd 4,Y + STD -6,Y + LDD -8,Y + sbcd 2,Y + STD -8,Y + BPL L1070 +L1072 ANDCC #$FE + ldq 2,y + rolw + rold + DEC <$6E + BEQ L1066 + stq 2,y + BSR L1068 + LDB -4,Y + ADDB #$C0 + STB -4,Y + LDD -6,Y + adcd 4,Y + STD -6,Y + LDD -8,Y + adcd 2,Y + STD -8,Y + BMI L1072 + BRA L1070 + +L1066 andcc #^Carry + BRA L1074 + +L1076 DEC 1,Y + LBVS equ0 +L1074 rolw + rold + BPL L1076 + STQ 2,Y + RTS + +L1068 ldq -8,y + ASL -1,Y + ROL -2,Y + ROL -3,Y + ROL -4,Y + rolw + rold + asl -1,y + rol -2,y + rol -3,y + rol -4,y + rolw + rold + stq -8,y + RTS + +MODint LBSR INTDIV + LDD 3,Y + STD 1,Y + RTS + +MODrl LEAU -$0C,Y + ldw #12 + tfm y+,u+ + LEAY -$0C,U + LBSR RLDIV + BSR INTrl + LBSR RLMUL + LBRA RLSUB + +INTrl LDA 1,Y + BGT L1090 + clrd + clrw + STQ 1,Y + STB 5,Y +L1092 RTS + +L1090 CMPA #$1F + BCC L1092 + LEAU 6,Y + LDB -1,U + ANDB #1 + PSHS U,B + LEAU 1,Y +L1094 LEAU 1,U + SUBA #8 + BCC L1094 + BEQ L1096 + LDB #$FF +L1098 ASLB + INCA + BNE L1098 + ANDB ,U + STB ,U+ + BRA L1100 + +L1096 LEAU 1,U +L1102 STA ,U+ +L1100 CMPU 1,S + BNE L1102 + PULS U,B + ORB 5,Y + STB 5,Y + RTS + +SQint LEAY -6,Y If embedding, skip LEAY -6,y + LDD 7,Y Get # to square + STD 1,Y Multiply it by itself (could embed MULD) + LBRA INTMUL + +SQrl LEAY -6,Y + LDQ 8,Y + STQ 2,Y + LDD 6,Y + STD ,Y + LBRA RLMUL + +VAL LDD Sstack + LDU Spointer + PSHS U,D + LDD 1,Y + STD Sstack + STD Spointer + STD exprSP + LEAY 6,Y + LBSR L2008 + PULS U,D + STD Sstack + STU Spointer + LBCS err67 + RTS + +ADDR LBSR L724 + LEAY -6,Y + STU 1,Y +L1112 LDA #1 + STA ,Y + LEAX 1,X + RTS + +* Table of var type sizes +L1108 fcb 1,2,5,1 + +SIZE LBSR L724 + leay -6,y + CMPA #4 + BCC L1106 + LEAU degrees +L1236 CLR <$9B + LDB 5,Y + ANDB #1 + STB <$9C + EORB 5,Y + STB 5,Y + BSR PI + INC 1,Y + LBSR RLCMP + BLT L1240 + LBSR MODrl + BSR PI + BRA L1244 + +L1240 DEC 1,Y +L1244 LBSR RLCMP + BLT L1246 + INC <$9B +* eim #1,$9C + fcb 5,1,$9c + LBSR RLSUB + BSR PI +L1246 DEC 1,Y + LBSR RLCMP + BLE L1248 +* eim #1,$9B + fcb 5,1,$9c + INC 1,Y +* oim #1,11,y + fcb $61,1,$2b + LBSR RLADD + LEAY -6,Y +L1248 LEAY -$14,Y + LEAX L1250,PC + STX <$19,Y + LEAX <$1B,Y + LEAU <$14,Y + BSR cprXU + LBSR L1124 + LDD #$1000 + clrw + STQ ,Y + CLRA + STA 4,Y + STQ $0A,Y + STA $0E,Y +L1214 LEAX L1252,PC + STX <$95 + LEAX <$41,X + STX <$97 + CLR <$9A +L1168 LDB #$25 + STB <$99 + CLR <$9D +L1264 LEAU <$1B,Y + LDX <$95 + CMPX <$97 + BCC L1254 + BSR cprXU + LEAX 5,X + STX <$95 + BRA L1256 + +L1254 ldq ,u + asrd + rorw + stq ,u + ror 4,u +L1256 LEAX ,Y + LEAU 5,Y + BSR L1260 + TST <$9A + BNE L1262 + LEAX $0A,Y + LEAU $0F,Y + BSR L1260 +L1262 JSR [$19,Y] + INC <$9D + DEC <$99 + BNE L1264 + RTS + +cprXU LDQ 1,X + STQ 1,U + LDA ,X + STA ,U + rts + +L1260 LDB ,X + SEX + LDB <$9D + LSRB + LSRB + LSRB + BCC L1266 + INCB +L1266 PSHS B + BEQ L1268 +L1270 STA ,U+ + DECB + BNE L1270 +L1268 LDB #5 + SUBB ,S+ + BEQ L1272 +L1274 LDA ,X+ + STA ,U+ + DECB + BNE L1274 +L1272 LEAU -5,U + LDB <$9D + ANDB #7 + BEQ L1276 + ldw 1,u + CMPB #4 + BCS L1258 + SUBB #8 + LDA ,X +L1278 ASLA + ROL 4,U + ROL 3,U + rolw + ROL ,U + INCB + BNE L1278 + stw 1,u + RTS + +L1258 ASR ,U + rorw + ROR 3,U + ROR 4,U + DECB + BNE L1258 + stw 1,u +L1276 RTS + +L1212 LDA $0A,Y + EORA ,Y + COMA + BRA L1280 + +L1250 LDA <$14,Y +L1280 TSTA + BPL L1282 + LEAX ,Y + LEAU $0F,Y + BSR L1284 + LEAX $0A,Y + LEAU 5,Y + BSR L1286 + LEAX <$14,Y + LEAU <$1B,Y + BRA L1284 + +L1282 LEAX ,Y + LEAU $0F,Y + BSR L1286 + LEAX $0A,Y + LEAU 5,Y + BSR L1284 + LEAX <$14,Y + LEAU <$1B,Y + BRA L1286 + +L1164 LEAX <$14,Y + LEAU <$1B,Y + BSR L1286 + BMI L1284 + BNE L1288 + LDD 1,X + BNE L1288 + LDD 3,X + BNE L1288 + LDB #1 + STB <$99 +L1288 LEAX ,Y + LEAU 5,Y + BRA L1284 + +L1126 LEAX ,Y + LEAU 5,Y + BSR L1284 + CMPA #$20 + BCC L1286 + LEAX <$14,Y + LEAU <$1B,Y +L1284 ldq 1,x + addw 3,u + adcd 1,u + STQ 1,X + LDA ,X + ADCA ,U + STA ,X + RTS + +L1286 ldq 1,x + subw 3,u + sbcd 1,u + STQ 1,X + LDA ,X + SBCA ,U + STA ,X + RTS + +L1124 LDB ,U + CLR ,U + clra + ldw 1,u + ADDB #4 + BGE L1294 + NEGB + LBRA L1258 + +L1296 ASL 4,U + ROL 3,U + rolw + rola + DECB +L1294 BNE L1296 + sta ,u + stw 1,u + RTS + +L1130 LDA ,U + BPL L1298 + clrd + clrw + STQ ,U + STA 4,U + RTS + +L1298 ldq ,u + beq L1304 + pshs x + ldx #4 +L1302 leax -1,x + asl 4,u + rolw + rold + BPL L1302 +L1300 std 1,u + exg d,w + tfr x,w + stf ,u + puls x + addd #1 + ANDB #$FE + STD 3,U + BCC L1304 + INC 2,U + BNE L1304 + INC 1,U + BNE L1304 + ROR 1,U + INC ,U +L1304 RTS + +L1252 fcb 12,144,253,170,34 + fcb 7,107,25,193,88 + fcb 3,235,110,191,38 + fcb 1,253,91,169,171 + fcb 0,255,170,221,185 + fcb 0,127,245,86,239 + fcb 0,63,254,170,183 + fcb 0,31,255,213,86 + fcb 0,15,255,250,171 + fcb 0,7,255,255,85 + fcb 0,3,255,255,235 + fcb 0,1,255,255,253 + fcb 0,1,0,0,0 +L1222 fcb 0,155,116,237,168 +L1166 fcb 11,23,33,127,126 + fcb 6,124,200,251,48 + fcb 3,145,254,248,243 + fcb 1,226,112,118,227 + fcb 0,248,81,134,1 + fcb 0,126,10,108,58 + fcb 0,63,129,81,98 + fcb 0,31,224,42,107 + fcb 0,15,248,5,81 + fcb 0,7,254,0,170 + fcb 0,3,255,128,21 + fcb 0,1,255,224,3 + fcb 0,0,255,248,0 + fcb 0,0,127,254,0 + fcb 0,0,63,255,128 + fcb 0,0,31,255,224 + fcb 0,0,15,255,248 + fcb 0,0,7,255,254 + fcb 0,0,4,0,0 +L1382 fcb 14,18,20,162,187,64 + fcb 230,45,54,25,98,233 + fcb 0,16,63,0,57 + +RND clrw + STW <$4C + clr ,-s + LDA 2,Y + BEQ L1312 + LDB 5,Y + BITB #1 + BNE L1314 + COM ,S + BRA L1312 + +L1314 ADDB #$FE + ADDB 1,Y + LDA 4,Y + STD <$52 + LDD 2,Y + STD <$50 +L1312 LDA <$53 + LDB <$57 + MUL + STD <$4E + tfr a,f + LDA <$52 + LDB <$57 + MUL + addr d,w + BCC L1316 + INC <$4C +L1316 LDA <$53 + LDB <$56 + MUL + addr d,w + BCC L1318 + INC <$4C +L1318 stw <$4D + ldw <$4C + LDA <$51 + LDB <$57 + MUL + addr d,w + LDA <$52 + LDB <$56 + MUL + addr d,w + LDA <$53 + LDB <$55 + MUL + addr d,w + LDA <$50 + LDB <$57 + MUL + addr b,e + LDA <$51 + LDB <$56 + MUL + addr b,e + LDA <$52 + LDB <$55 + MUL + addr b,e + LDA <$53 + LDB <$54 + MUL + addr b,e + LDD <$4E + ADDD <$5A + exg d,w + adcd <$58 + STQ <$50 + TST ,S+ + BNE L1320 +L1326 CLR 1,Y + sta 2,y + LDA #$1F + PSHS A + lda 2,y + BMI L1322 + andcc #^Carry +L1324 DEC ,S + BEQ L1322 + DEC 1,Y + rolw + rold + BPL L1324 +L1322 STQ 2,Y +* aim #$FE,5,y + fcb $62,$fe,$25 + PULS PC,B + +L1320 leay -6,y + rorw + clr ,y + rolw sign now + + BSR L1326 + LBRA RLMUL + +LEN LDQ 1,Y + STD exprSP +L1328 STW 1,Y + LDA #1 + STA ,Y + RTS + +ASC LDD 1,Y + STD exprSP + LDF [1,Y] + CLRE + BRA L1328 + +CHR$ LDD 1,Y + TSTA + LBNE err67 + LDU exprSP + STU 1,Y + STB ,U+ + LBSR L1366 + ldd #1 + std 3,y + STY SStop + cmpr y,u + LBCC err47 + RTS + +LEFT$ LDD 1,Y + BLE isNull + ADDD 7,Y + TFR D,U address new end + CMPD exprSP + BCC L1334 + BSR L1336 shorten current string + ldd 1,y + std 9,y +L1334 LEAY 6,Y + RTS + +isNull LEAY 6,Y + LDU 1,Y + clrd + std 3,y + BRA L1336 + +RIGHT$ LDW 1,Y + BLE isNull + LDD exprSP + subr w,d + decd new starting address + CMPD 7,Y current start address + BLS L1338 + stw 9,y + incw terminate also + LDU 7,Y + tfm d+,u+ + STU exprSP +L1338 LEAY 6,Y + rts + +MID$ LDD 1,Y size of piece + BLE L1342 + LDD 7,Y it's starting offset + BGT L1344 +L1342 LDD 1,Y = LEFT$ + LEAY 6,Y + STD 1,Y + BRA LEFT$ + +L1344 decd + BEQ L1342 + ADDD $0D,Y start address piece + CMPD exprSP + BCS L1348 piece exists + LEAY 6,Y + BRA isNull + +L1348 clrw + ldf 2,y + LEAY $0C,Y + stw 3,y + ldu 1,Y + tfm d+,u+ + bra L1337 + +TRIM$ LDU exprSP + ldw 3,y + incw adjust for loop struct. + LEAU -1,U +L1354 decw + BEQ L1336 + LDA ,-U + CMPA #$20 + BEQ L1354 + LEAU 1,U +L1336 stw 3,y +L1337 LDA #$FF + STA ,U+ + STU exprSP + RTS + +SUBSTR PSHS Y,X + LDW exprSP + SUBW 1,Y + ADDW 7,Y + incw + LDX 7,Y + LDY 1,Y + bra L1356 + +* compare strings * +L202 PSHS Y,X +L200 LDA ,X+ + CMPA #$FF + BEQ L198 + CMPA ,Y+ + BEQ L200 + PULS Y,X + LEAY 1,Y +L1356 CMPR W,Y + BLS L202 + clrd no match + BRA L1360 + +L198 PULS Y,X + TFR Y,D + LDX 2,S + SUBD 1,X + incd starting offset +L1360 PULS Y,X + LEAY 6,Y + STD 1,Y + LDA #1 + STA ,Y + RTS + +STR$int LDB #2 + BRA L1362 + +STR$rl LDB #3 +L1362 LDA charcoun + LDU Spointer + PSHS U,X,A + LBSR L46 + BCS err67 + LDX 3,S + ldu exprSP + leay -6,y + stu 1,y + sty SStop + ldw Spointer + subr x,w + tfr w,d string length + addr u,d + cmpr y,d + lbcc err47 string too long + stw 3,y + tfm x+,u+ copy to expression stack + LDA #$FF + STA ,U+ +L1361 stu exprSP + lda #4 + sta ,y + PULS U,X,A reset pointers + STA charcoun + STU Spointer + RTS + +err67 LDB #$43 + LBRA L356 + +TAB LDW 1,Y + BLT err67 + STY SStop + LDU exprSP + STU 1,Y + ldb charcoun + clra + subr d,w W = number spaces + bhi L1365 + clrw +L1365 stw 3,y + beq L1366 + tfr u,d + addr w,d + cmpr y,d + lbcc err47 too big + lda #$20 + pshs a + tfm s,u+ assemble string + leas 1,s +L1366 LDA #$FF + STA ,U+ + STU exprSP + LDA #4 + STA ,Y + rts + +DATE$ PSHS X + LEAY -6,Y + LEAX -6,Y + LDU exprSP + STU 1,Y + ldd #17 + std 3,y + os9 F$Time + BCS L1371 + BSR L1370 + LDA #$2F + BSR L1372 + LDA #$2F + BSR L1372 + LDA #$20 + BSR L1372 + LDA #$3A + BSR L1372 + LDA #$3A + BSR L1372 +L1371 puls x + BRA L1366 + +L1372 STA ,U+ +* byte to ascii +L1370 LDA ,X+ + LDB #$2F +L1374 INCB + SUBA #$0A + BCC L1374 + STB ,U+ + LDB #$3A +L1376 DECB + INCA + BNE L1376 + STB ,U+ + RTS + +EOF LDA 2,Y + LDB #6 + os9 I$GetStt + BCC L1378 + CMPB #$D3 + BNE L1378 + LDB #$FF + BRA L1380 + +L1378 LDB #0 +L1380 CLRA + STD 1,Y + LDA #3 + STA ,Y + RTS + +L46 PSHS PC,X,D + ASLB + LEAX internal repr. * +L2009 PSHS X + LEAY -6,Y + LDA #3 + STA ,Y + CLR 2,Y + LDX Spointer + BSR L1418 + BCS L1528 + leax 3,x + anda #$DF + CMPA #$54 = T(rue) + BEQ L1530 + leax 1,x + EORA #$46 = F(alse) + BEQ L1532 + bra err58 +L1530 COM 2,Y +L1532 BSR L1418 +L1528 STX Spointer + CLRA + PULS PC,X +* validate characters * +L1514 LDA ,X+ + CMPA #$20 = space? + BNE L1522 + BSR L1418 + BCC L1534 + BRA L1536 +L1418 LDA ,X+ + CMPA #$20 = space? + BEQ L1418 skip them +L1522 CMPA <$DD + BEQ L1536 + CMPA #$0D = CR? + BEQ L1534 + CMPA #$FF = end of string? + BEQ L1534 + ANDCC #$FE + RTS +L1534 LEAX -1,X +L1536 ORCC #1 + RTS + +* integer to ASCII * +ItoA PSHS U,X + clrw + STE digits + STE negativ + LDA #4 + STA <$7E + LDD 1,Y + BPL L1538 + negd + INC negativ +L1538 LEAU L1540,PC +L1552 clrf + LEAU 2,U +L1544 SUBD ,U + BCS L1542 + incf + BRA L1544 + +L1542 ADDD ,U + tstw + BEQ L1548 +L1546 ince + addf #$30 convert to ASCII + stf ,x+ + inc digits +L1548 DEC <$7E + BNE L1552 + orb #$30 convert to ASCII + stb ,x + inc digits + LEAY 6,Y + PULS PC,U,X + +* real to ASCII * +RtoA PSHS U,X + clrw + stw expneg + digits + stw negativ + decimals + stw <$7B + LEAU ,X + ldb #$30 ASCII 0 + pshs b + ldw #10 Fill buffer with 10 of them + tfm s,u+ + leas 1,s + LDD 1,Y + BNE L1556 + INCA + LBRA L1558 + +L1556 LDB 5,Y + BITB #1 + BEQ L1560 + STB negativ + ANDB #$FE + STB 5,Y +L1560 LDD 1,Y + BPL L1562 + INC expneg + NEGA +L1562 CMPA #3 + BLS L1564 + LDB #$9A + MUL + LSRA + TFR A,B + TST expneg + BEQ L1566 + NEGB +L1566 STB decimals + CMPA #$13 + BLS L1568 + PSHS A + LEAU L1486,PC + LBSR L1488 + PULS A + SUBA #$13 +L1568 LEAU L1490,PC + DECA + LDB #5 + MUL + LEAU D,U + LBSR L1488 +L1564 LDQ 2,Y + TST 1,Y + BEQ L1580 + BPL L1572 +L1574 lsrd + rorw + ROR <$7C + INC 1,Y + BNE L1574 + BRA L1580 + +L1572 andcc #^Carry + rolw + rold + ROL <$7B + DEC 1,Y + BNE L1572 + STA 2,Y + INC decimals + LDA <$7B + BSR L1550 + LDA 2,Y +L1580 CLR <$7B + rolw + rold + rol <$7B + STQ 2,Y + LDA <$7B + STA <$7C + lda 2,y + rolw + rold + ROL <$7B + rolw + rold + ROL <$7B + ADDW 4,Y + adcd 2,Y + PSHS A + LDA <$7B + ADCA <$7C + BSR L1550 + LDA digits + CMPA #9 + PULS A + BEQ L1578 + tstd + BNE L1580 + tstw + BNE L1580 +L1578 STA ,Y + LDA digits + CMPA #9 + BCS L1582 + LDB ,Y + BPL L1582 +L1584 LDA ,-X + INCA + STA ,X + CMPA #$39 = 9? + BLS L1582 + LDA #$30 =0 + STA ,X + CMPX ,S + BNE L1584 + INC ,X + INC decimals +L1582 LDA #9 +L1558 STA digits + LEAY 6,Y + PULS PC,U,X + +L1550 ORA #$30 to ASCII + STA ,X+ + INC digits + RTS + +READLN PSHS Y,X + LDX Sstack + STX Spointer + LDA #1 + STA charcoun + LDY #$0100 + LDA IOpath + os9 I$ReadLn + BRA L1586 + +WRITLN PSHS Y,X + LDX Sstack + LDY Spointer + subr x,y + beq L1588 + STX Spointer + LDA IOpath + os9 I$WritLn +L1586 BCC L1588 + STB errcode +L1588 PULS PC,Y,X + +setFP PSHS U,X + LDD ,Y type of filepointer + CMPA #2 + BEQ L1590 real + LDU 1,Y integer + BRA L1592 + +L1590 tstb If exponent is <=0, Seek to 0 + BGT L1594 Positive value, go calculate longint for SEEK + LDU #0 seek #0 +L1592 LDX #0 + BRA L1596 + +L1594 SUBB #$20 Only up to 2^32 allowed + BCS L1597 Good, continue + LDB #$4E error 78 (seek error) + COMA + BRA L1600 + +L1597 lda #$FF Force Value to -1 to -32 + tfr d,x Move into X for counter + ldq 2,y Get mantissa +L1598 lsrd Calculate to power of exponent + rorw + leax 1,x Do until done + BNE L1598 + tfr d,x Move 32 bit result to proper regs for SEEK + tfr w,u +L1596 LDA IOpath Do the seek + os9 I$Seek + BCC L1602 +L1600 STB errcode +L1602 PULS PC,U,X + +* print real numbers * +PRreal PSHS U,X + LEAS -10,S + LEAX ,S + LBSR RtoA + PSHS X + LDA #9 + LEAX 9,X +L1608 LDB ,-X + CMPB #$30 + BNE L1606 + DECA + CMPA #1 + BNE L1608 skip 0s +L1606 STA digits + PULS X + LDB decimals + BGT L1610 + NEGB + TFR B,A + CMPB #9 + BHI L1612 + ADDB digits + CMPB #9 + BHI L1612 +* 0 < x < 1 * + PSHS A + LBSR L1614 + CLRA + LBSR L1616 + PULS B + TSTB + BEQ L1618 + LBSR L1620 +L1618 LDA digits + BRA L1622 + +* real number * +L1610 CMPB #9 + BHI L1612 + LBSR L1614 + TFR B,A + BSR L1624 + LBSR L1616 + LDA digits + SUBA decimals + BLS L1626 +L1622 BSR L1624 +L1626 LEAS 10,S + CLRA + PULS PC,U,X + +* exponential number * +L1612 LBSR L1614 + LDA #1 + BSR L1624 + BSR L1616 + LDA digits + DECA + BNE L1628 + INCA +L1628 BSR L1624 + BSR L1630 + BRA L1626 + +* exponent * +L1630 LDE #$45 = E + LDA decimals + DECA + PSHS A + BPL L1634 + NEG ,S + ldf #$2D = - + BRA L1638 + +L1634 ldf #$2B = + +L1638 PULS B + CLRA +L1644 SUBB #$0A + BCS L1642 + INCA + BRA L1644 +L1642 ADDB #$0A exp. in D + addd #$3030 -> ASCII + pshs d + pshsw exp. on stack + ldb #4 + bsr L1650 + cmpw #4 space left to print it? + beq L1646 + leas 4,s no, clean up stack + rts + +L1646 tfm s+,d+ + std Spointer + rts + +* +L1624 TFR A,B +L1625 TSTB + BEQ L1648 + bsr L1650 + tfm x+,d+ +L1649 std Spointer +L1648 RTS + +* +L1650 tfr s,w + subw #64 + subw Spointer w holds max. length + clra + cmpr w,d + bhs L1651 too long: truncate + tfr d,w +L1651 ldb charcoun + addr f,b update counter + stb charcoun + ldd Spointer destination + rts + +* ---------------- * +L1660 LDA #$20 = space + BRA L1632 + +L1616 LDA #$2E = . +L1632 PSHS U,A + LEAU <-$40,S + CMPU Spointer + BHI L1652 space left!! + CMPA #$0D CR ?? + BEQ L1652 + LDA #47 error 47 + STA errcode + coma + BRA L1654 + +L1652 LDU Spointer + STA ,U+ + STU Spointer + INC charcoun +L1654 PULS PC,U,A + +* +spacing LDA #$20 = space +L1662 TSTB 0 chars? + BEQ L1656 Yes, return + pshs a + bsr L1650 + tfm s,d+ + leas 1,s + std Spointer +L1656 RTS + +* NOTE: Should use LDA + BNE L1690 + INCB + BRA L1688 + +L1690 CMPA #$5E = ^ + BNE ckmarker + DECB +L1688 STB justify + LDA ,X+ +ckmarker CMPA #$2C = , + BEQ L1694 + CMPA #$FF + BNE L1696 + LDA <$94 + BEQ L1698 + LEAX -1,X + BRA L1700 + +L1698 LDX <$8E + TST <$DC + BEQ L1702 + CLR <$DC + BRA L1694 + +L1696 CMPA #$29 = ) + BEQ L1704 +L1702 ORCC #1 + RTS + +L1704 LDA <$94 + BEQ L1702 +L1700 DEC <$92 + BNE L1706 + LDU userSP + PULU Y,A + STA <$92 + STY <$90 + STU userSP + LDA ,X+ + DEC <$94 + BRA ckmarker + +L1706 LDX <$90 +L1694 STX <$8C + ANDCC #$FE + RTS + +* chars recognized by PRINT USING +L1726 fcb 73 Integer + fdb L2050-L1726 +L2051Bas equ * + fcb 72 Hexadecimal + fdb L2051 +L2052Bas equ * + fcb 82 Real + fdb L2052 +L2053Bas equ * + fcb 69 Exponential + fdb L2053 +L2054Bas equ * + fcb 83 String + fdb L2054 +L2055Bas equ * + fcb 66 Boolean + fdb L2055 +L2056Bas equ * + fcb 84 Tab + fdb L2056 +L2057Bas equ * + fcb 88 X - space + fdb L2057 +L2058Bas equ * + fcb 39 ' - literal string + fdb L2058 + fcb 0 end of table + +* Tab function +L2056 equ *-L2056Bas + BSR ckmarker + BCS err63 + LDB fieldwid + LBSR L1712 + BRA L1714 + +* print spaces (X) * +L2057 equ *-L2057Bas + BSR ckmarker + BCS err63 + LDB fieldwid + LBSR spacing + BRA L1714 + +* print literal string * +L2058 equ *-L2058Bas + pshs x + clrb +L1718 CMPA #$FF + BEQ err63 + CMPA #$27 = ' + beq L1716 + incb + LDA ,X+ + BRA L1718 +L1716 puls x + leax -1,x + lbsr L1625 + leax 1,x + LDA ,X+ + LBSR ckmarker + BCS err63 + BRA L1714 + +PRNTUSIN PSHS Y,X + CLR <$DC + INC <$DC +L1714 LDX <$8C + BSR L1720 + BCS L1722 + CMPA #$28 + BNE err62 + LDA <$92 + STB <$92 + BEQ err62 + INC <$94 + LDU userSP + LDY <$90 + PSHU Y,A + STU userSP + STX <$90 + LDA ,X+ +L1722 LEAY dec. +L1738 ANDCC #$FE + RTS + +L1736 ORCC #1 + RTS + +L1740 PSHS A + LDA #10 + MUL 10*B+A + ADDB ,S+ + ADCA #0 + RTS + +L2052 equ *-L2052Bas +L2053 equ *-L2053Bas + CMPA #$2E format as real or exp. + BNE err63 + BSR L1720 + BCS err63 + STB <$89 + +L2051 equ *-L2051Bas +L2054 equ *-L2054Bas +L2055 equ *-L2055Bas +L2050 LBSR L1744 Int, Hex, String, Boolean + BCS err63 + PULS Y,X + INC <$DC +L2018 LDB subrcode + LBEQ FMTint + DECB + BEQ FMThex + DECB + LBEQ FMTreal + DECB + LBEQ FMTexp + DECB + LBEQ FMTstr + LBRA FMTbool + +FMThex JSR table4 + pshs y + CMPA #4 + BCS L1758 + LDU 1,Y source: string + ldd 3,y + bra L1686 + +L1758 LEAU 1,Y + LDA ,Y + CMPA #2 + BNE L1764 + LDB #5 source: real number + BRA L1686 + +L1764 CMPA #1 + BNE L1766 + LDB #2 source: integer + CMPB fieldwid + BCS L1768 +L1766 LDB #1 byte, boolean + LEAU 1,U +L1768 TFR B,A + ASLA + CMPA fieldwid + BLS L1686 + ANDA #$0F + CMPA #9 + BLS L1784 + ADDA #7 +L1784 LBSR L1646 + DEC fieldwid + bra L1782 + +L1686 TST justify + pshs b + BEQ L1776 left justify + BMI L1774 center digits + ASLB right justify + PSHS B + LDB fieldwid + SUBB ,S+ + BCS L1776 + BRA L1778 + +L1774 ASLB + PSHS B + LDB fieldwid + SUBB ,S+ + BCS L1776 + ASRB +L1778 LDA fieldwid + subr b,a + STA fieldwid + LBSR spacing +L1776 ldb fieldwid + lbsr L1650 + tfr d,y + PULS B +L1772 LDA ,U + LSRA + LSRA + LSRA + LSRA + cmpa #9 + bls L1773 + adda #7 +L1773 adda #$30 + sta ,y+ + decw + BEQ L1782 +L1770 LDA ,U+ + anda #15 + cmpa #9 + bls L1771 + adda #7 +L1771 adda #$30 + sta ,y+ + decw + BEQ L1782 + DECB + BNE L1772 + lda #$20 Space + pshs a + tfm s,y+ + leas 1,s +L1782 sty Spointer + puls y + CLRA + sta fieldwid + RTS + +L1788 COMA + RTS + +FMTint JSR table4 + CMPA #2 + BCS L1786 + BNE L1788 wrong var. type + LBSR FIX +L1786 PSHS U,X + LEAS -5,S + LEAX ,S + LBSR ItoA + LDB fieldwid + DECB + SUBB digits + BPL L1792 + LEAS 5,S + PULS U,X + LBRA ovflow + +L1792 TST justify + BEQ L1796 left justify + BMI L1798 leading zeroes + LBSR spacing right justify + LBSR L1800 + BRA L1802 + +L1796 LBSR L1800 + PSHS B + LDA digits + LBSR L1624 + PULS B + LBSR spacing + BRA L1804 + +L1798 LBSR L1800 + LBSR L1620 +L1802 LDA digits + LBSR L1624 +L1804 LEAS 5,S + CLRA + PULS PC,U,X + +FMTbool JSR table4 + CMPA #3 + BNE L1788 wrong type + PSHS U,X + LEAX L1668,PC + LDB #4 + LDA 2,Y + BNE L1806 + LEAX L1672,PC + LDB #5 + BRA L1806 + +FMTstr JSR table4 + CMPA #4 + BNE L1788 wrong type + PSHS U,X + LDX 1,Y + ldd 3,y + TSTA + BNE L1808 +L1806 CMPB fieldwid + BLS L1810 +L1808 LDB fieldwid +L1810 TFR B,A + NEGB + ADDB fieldwid + TST justify + BEQ L1812 left justify + BMI L1814 center text + PSHS A right justify + LBSR spacing + PULS A + LBSR L1624 + BRA L1816 + +L1812 PSHS B + BRA L1818 + +L1814 LSRB + BCC L1820 + INCB +L1820 PSHS d + LBSR spacing + PULS A +L1818 LBSR L1624 + PULS B + LBSR spacing +L1816 CLRA + PULS PC,U,X + +FMTreal JSR table4 + CMPA #2 + BEQ L1822 + LBCC L1788 wrong type + LBSR FLOAT +L1822 PSHS U,X + LEAS -$0A,S + LEAX ,S + LBSR RtoA + LDA decimals + CMPA #9 + BGT L1824 + LBSR L1826 + LDA fieldwid + SUBA #2 + BMI L1824 + SUBA <$89 + BMI L1824 + SUBA <$8A + BPL L1828 +L1824 LEAS $0A,S + PULS U,X + BRA ovflow + +L1828 STA <$88 + LEAX ,S + LDB justify + BEQ L1830 left justify + BMI L1832 fin. format + BSR L1834 right justify + BSR L1836 + BRA L1838 + +L1830 BSR L1836 + BSR L1834 + BRA L1838 + +L1832 BSR L1834 + BSR L1840 + LBSR L1800 +L1838 LEAS $0A,S + CLRA + PULS PC,U,X + +L1836 LBSR L1800 +L1840 LDA <$8A + LBSR L1624 + LBSR L1616 + LDB decimals + BPL L1842 + NEGB + CMPB <$89 + BLS L1844 + LDB <$89 +L1844 PSHS B + LBSR L1620 + LDB <$89 + SUBB ,S+ + STB <$89 + LDA <$8B + CMPA <$89 + BLS L1846 NOTE: SHOULD BE BLS L1848 + LDA <$89 +L1846 BRA L1848 + +L1834 LDB <$88 + LBRA spacing +L1862 LBSR L1800 + LDA <$8A + LBSR L1624 + LBSR L1616 +L1842 LDA <$8B +L1848 LBSR L1624 + LDB <$89 + SUBB <$8B + BLE L1850 + LBRA L1620 + +ovflow LDB fieldwid + LDA #$2A = * + LBSR L1662 + CLRA +L1850 RTS + +FMTexp JSR table4 + CMPA #2 + BEQ L1852 + LBCC L1788 wrong type + LBSR FLOAT +L1852 PSHS U,X + LEAS -$0A,S + LEAX ,S + LBSR RtoA + LDA decimals + PSHS A + LDA #1 + STA decimals + BSR L1826 + PULS A + LDB decimals + CMPB #1 + BEQ L1854 + INCA +L1854 LDB #1 + STB <$8A + STA decimals + LDA fieldwid + SUBA #6 + BMI L1856 + SUBA <$89 + BMI L1856 + SUBA <$8A + BPL L1858 +L1856 LEAS $0A,S + PULS U,X + BRA ovflow + +L1858 STA <$88 + LDB justify + BEQ L1860 left justify + BSR L1834 right justify + BSR L1862 + LBSR L1630 + BRA L1864 + +L1860 BSR L1862 + LBSR L1630 +L1864 LBRA L1838 + +L1826 PSHS X + LDA decimals + ADDA <$89 + BNE L1866 + LDA ,X + CMPA #$35 + BCC L1868 +L1866 DECA + BMI L1870 + CMPA #7 + BHI L1870 + LEAX A,X + LDB 1,X + CMPB #$35 + BCS L1870 +L1872 INC ,X + LDB ,X + CMPB #$39 +L1310 BLS L1870 +L1868 LDB #$30 + STB ,X + LEAX -1,X + CMPX ,S + BCC L1872 + LDX ,S + LEAX 8,X +L1874 LDA ,-X + STA 1,X + CMPX ,S + BHI L1874 + LDA #$31 + STA ,X + INC decimals +L1870 PULS X + LDA decimals + BPL L1876 + CLRA +L1876 STA <$8A + NEGA + ADDA #9 + BPL L1878 + CLRA +L1878 CMPA <$89 + BLS L1880 + LDA <$89 +L1880 STA <$8B + RTS + +err48 LDB #$30 + STB errcode + COMA + RTS + + emod +MODEND equ * + end +