;:sys36864 ;.opt oo *= $c000 tmp =2 basanf =43 basend =45 bsout =$ffd2 cint =65409 vic =$d000 keybuf =631 key =198 tgoto =137 trem =143 axout =$bdcd return =$aad7 getin =65508 space =$ab3f tcont =154 tnew =162 tstop =144 tlet =136 tif =139 tgo =203 tto =164 tlist =155 trun =138 tspc =166 ttab =163 thoch =174 buffer =$100 ay10 =$bf0c fac =$62 intflt =$bc49 fltasc =$bddf ton =145 tprint =153 setnam =$ffbd name =820 bsin =$ffcf open =$ffc0 close =$ffc3 chkout =$ffc9 clrchn =$ffcc setpar =$ffba tdata =131 puffer =$ce00 beftab =$a09e tgosub =141 tthen =167 vers1 =5 vers2 =0 common =$cf00 anzfe =28 begfe =12 ; beginn der fehler im common-ber. jmp anfang title .byte "\x1a\x93\x8e\x08\x05\x04\x12\x19- basic - kontroll - system v" .byt 48+vers1,46,48+vers2 .byte "\x19\x0a \x19\x1e\xa3\x19\x0a" .byte " von n.heusler / (c) nss 171087\x19- \x1a\x03" nodrin .byte "bitte laden sie erst ein basic-programm" .byte "in den speicher. dann koennen sie die" .byte "testroutine mit sys 49152 starten.\x1a\x03" keytab .byte "loA" .byt 34 errtxt .byte "\x1afehler nr. \x03" errt2 .byte " in zeile \x03" listfrg .byte "ueberfluessige spaces listen\x03" listf2 .byte "\x1a\x1afehler # 8 (goto -> rem) listen\x03" jant .byte " ? \x19\x05\x9d\x03" outfrg .byte "\x1a\x1aausgabe auf \x12s\x92chirm, \x12d\x92rucker, \x12f\x92loppy ? \x03" diskfrg .byte "\x1afilename ? \x03" filevor .byte "doc." anh .byte ",p,w" end .byte "\x19\x04 ==== ende ====\x03" f1 .byte "\x19\x04 leichte fehler: \x03" f2 .byte "\x19\x04 schwere fehler: \x03" outask .byte "\x1a\x1afalsche zeilen auch listen\x03" hipr .byte "\x1a\x1abasic-kontroll-system v" .byt 48+vers1,46,48+vers2 .byte " (c) nss87/88\x1a\x1a\x03" code .byte "nss88" listf3 .byte "\x1a\x1afehler #17 und #7 listen\x03" listf4 .byte "\x1a\x1afehler #12, #13 und #14 listen\x03" suchline .word 0 flag brk quotfg brk remfg brk aktline .word 0 point brk errnum brk zahl .word 0 altzahl .word 0 listflg =common+7 merktok brk merkp brk bracket brk ziffer brk thenflg brk onfg brk outadr brk lowerr .word 0 higerr .word 0 datfg brk olddat brk sa brk hochk brk outflg brk listptr brk first brk refline .word 0 temp brk merkp2 brk onquote brk merkp3 brk char brk achtfg =common+8 siebfg =common+10 beffg =common+11 bef .byt 128,tgoto,138,142,144,tcont,155,tnew bef2 .byt tgoto,trun,141,tlist,tthen bef3 .byt 129,133,134,135,tlet,139,ton,146,148 .byt 150,151,152,157,158,159,160,161 bef4 =* fe1 .byte "formatfehler\x03" fe2 .byte "sprungfehler\x03" fe3 .byte "unerlaubter befehl\x03" fe4 .byte "ueberfluessiger befehl\x03" fetab .word fe1,fe1,fe2,fe2,fe2,fe1,fe2,fe2,fe1,fe2 .word fe3,fe3,fe3,fe4,fe1,fe1,fe4,fe1,fe3,fe4 .word fe1,fe3,fe1,fe1,fe1,fe1,fe1,fe1 sevtab .byte "1122221122211112122121222221" head .byt 12,8,0,0,0,58,58,58,58,155,0,48,8,0 .byt 0,34,13,145,145 .byte "testergebnis:" .byt 13 .byte "------------" .byt 13,13 .byte "(c)reated by" .byt 13 .byte "\x12nss basic-kontroll-system v" .byt 48+vers1,46,48+vers2 .byte " nh211087" .byt 32,0 hend =* suchxy lda tmp pha lda tmp+1 pha stx suchline sty suchline+1 lda basanf ldy basanf+1 sta tmp sty tmp+1 test1 ldy #1 ldx #1 lda (tmp),y beq err clc lda #2 adc tmp sta tmp bcc test2 inc tmp+1 test2 ldy #0 lda (tmp),y cmp suchline bne test3 iny lda (tmp),y cmp suchline+1 beq found test3 ldy #1 test4 iny beq err2 lda (tmp),y bne test4 cpy #2 bne test5 ldy #6 bne test4 test5 iny tya clc adc tmp sta tmp bcc test1 inc tmp+1 bne test1 err2 ldx #2 .byt $2c err3 ldx #3 err stx flag pla sta tmp+1 pla sta tmp lda suchline cmp aktline bne achso lda suchline+1 cmp aktline+1 bne achso lda #5 sta flag achso rts found iny lda (tmp),y breit ldx #4 cmp #trem beq err cmp #58 beq doerr ldx #bef2-bef-1 found1 cmp bef,x beq err3 dex bpl found1 inx beq err doerr iny beq err lda (tmp),y beq err cmp #32 beq doerr bne breit testthen cmp #tif bne rrt inc thenflg rrt cmp #thoch bne rrrt tya pha ldx #22 jsr error pla tay lda #thoch rrrt cmp #tdata bne nodata inc datfg nodata cmp #tthen bne nothn ldx thenflg bne nothn tya pha ldx #27 jsr error pla tay lda #tthen nothn rts raus ldx #2 jmp chkout bs2 jsr bsout .byt $2c bs0 lda #0 jmp bsout neunum lda aktline sta refline lda aktline+1 sta refline+1 iny lda (tmp),y sta aktline iny lda (tmp),y sta aktline+1 lda first bne war inc first bne pooh war lda refline+1 cmp aktline+1 bcc pooh bne baeh lda refline cmp aktline bcc pooh baeh ldx #24 .byt $2c e25 ldx #25 jmp error pooh ldy #3 ne0 iny beq ne1 lda (tmp),y bne ne0 ne1 cpy #4 beq ne0 iny tya clc adc tmp sta temp lda tmp+1 adc #0 ldy #1 cmp (tmp),y bne e25 dey lda temp cmp (tmp),y bne e25 rts atn20 lda point pha d jsr get cmp #58 beq d cmp #trem beq brav cmp #tdata beq brav ldx #20 jsr error brav pla sta point rts strout tax lda tmp pha lda tmp+1 pha stx tmp sty tmp+1 st1 ldy #0 lda (tmp),y beq st6 cmp #"\x03" beq st6 cmp #"\x1a" bne st2 lda #13 st2 cmp #"\x19" bne st3 iny lda (tmp),y tax iny lda (tmp),y st4 jsr bsout dex bne st4 clc lda #3 adc tmp sta tmp bcc st1 inc tmp+1 bne st1 st3 jsr bsout st5 inc tmp bne st1 inc tmp+1 bne st1 st6 pla sta tmp+1 pla sta tmp rts mal10 pha lda zahl asl sta altzahl lda zahl+1 rol bcs fehl sta altzahl+1 ldx #3 rot10 asl zahl rol zahl+1 bcs fehl dex bne rot10 lda zahl clc adc altzahl sta zahl lda zahl+1 adc altzahl+1 bcs fehl sta zahl+1 pla clc rts fehl pla sec rts get inc point ldy point lda (tmp),y cmp #32 beq get rts getpar lda #listfrg jsr strout lda #0 sta sa jsr getjn stx listflg jmp rucksack getjn lda #jant jsr strout getjn2 jsr getin ldx #0 cmp #"n" beq na cmp #"j" bne getjn2 ldx #1 na jsr bsout ldy #3 sp jsr space dey bpl sp rts weiter lda #outfrg jsr strout getfdb jsr getin cmp #"s" beq n3 cmp #"f" beq n8 cmp #"d" bne getfdb ldx #4 .byt $2c n8 ldx #8 .byt $2c n3 ldx #3 stx outadr jsr bsout jsr return cpx #8 bne nodisk lda #diskfrg jsr strout ldx #4 stx key stx sa fill2 lda filevor,x sta keybuf,x dex bpl fill2 ldx #0 namein jsr bsin cmp #13 beq cer sta name,x inx cpx #16 bcc namein cer ldy #0 anha lda anh,y sta name,x inx iny cpy #4 bcc anha txa ldx #name .byt $2c nodisk lda #0 jsr setnam ldx outadr lda #2 ldy sa jsr setpar jsr open jsr raus ldx outadr cpx #8 bne noflip lda #1 jsr bsout lda #8 jsr bsout ldx #0 ho lda head,x jsr bsout inx cpx #hend-head bcc ho bcs noflap noflip lda #hipr jsr strout noflap jsr clrchn jmp return rucksack lda #listf2 jsr strout jsr getjn stx achtfg lda #listf3 jsr strout jsr getjn stx siebfg lda #listf4 jsr strout jsr getjn stx beffg lda #outask jsr strout jsr getjn stx outflg jmp weiter anfang jsr cint lda #title jsr strout jsr makecomm lda #6 sta vic+32 sta vic+33 ldy #1 lda (basanf),y bne drin ldx #4 stx key fillin lda keytab,x sta keybuf,x dex bpl fillin lda #<nodrin ldy #>nodrin jmp strout drin lda #2 jsr close jsr getpar lda basanf sta tmp lda basanf+1 sta tmp+1 lda #0 ldx #3 l sta lowerr,x dex bpl l sta bracket stx puffer+3 sta first newline inc vic+32 lda bracket beq nw2 lda datfg bne nw2 ldx #21 jsr error nw2 ldy #1 lda (tmp),y bne gawader jmp fertig gawader jsr neunum lda #0 sta thenflg sta quotfg sta remfg sta bracket sta onfg sta datfg lda #4 setpoint sta point main ldy point lda (tmp),y bne noend cpy #4 bne realend ldx #1 jsr error lda #9 bne setpoint realend iny tya clc adc tmp sta tmp bcc newline inc tmp+1 bne newline noend cmp #34 bne no34 lda quotfg eor #-1 sta quotfg jmp next flow ldx #9 jmp outnum no34 ldx quotfg bne next ldx remfg bne re cmp #tnew bne nnew ldx #13 bne en nnew cmp #tcont bne noct ldx #11 bne en noct cmp #32 bne nosp ldx #2 lda listflg beq next lda datfg bne next beq en nosp cmp #tstop bne nostop ldx #12 en jsr error next inc point beq flow jmp main re jmp anmerkung nostop cmp #trem bne trenker inc remfg bne next qgotnum lda merktok cmp #trun beq atn cmp #tgoto beq atn cmp #tlist beq atn cmp #tthen bne gotnum atn jsr atn20 jmp gotnum trenker jsr testthen ldx #bef3-bef2-1 tr1 cmp bef2,x beq tr2 dex bpl tr1 bmi qnobef tr2 sta merktok jsr fetchnum dex beq qgotnum dex beq gotnum dex beq out5 over lda merkp2 sta point ldx #4 bne outnum out5 cmp #","-"0" bne qout5 lda onfg bne gotnum qout5 lda merkp2 sta point ldx #5 lda merktok cmp #tthen beq qqnobef outnum jsr error qqnobef ldy point lda (tmp),y qnobef jmp nobef gotnum ldx zahl ldy zahl+1 cpy #250 bcs over jsr suchxy lda flag beq qmain cmp #1 bne no1 ldx #3 lda merktok cmp #tlist beq qmain cmp #trun bne qoutnum lda ziffer bne qoutnum qmain jmp main no1 cmp #2 bne no2 ldx #6 bne qoutnum no2 cmp #5 bne no5 ldx #10 lda merkp2 sta point lda thenflg bne qqnobef lda merktok cmp #tlist beq qqnobef bne outnum no5 cmp #3 bne nee3a ldx onfg bne qmain ldx #7 .byt $2c nee3 ldx #8 qoutnum lda merkp2 sta point bne outnum nee3a lda merktok cmp #tlist beq qmain cmp #trun bne nee3 lda ziffer bne nee3 beq qmain nobef cmp #tlet bne nolet ldx #14 jmp en nolet cmp #255 beq gut cmp #204 bcc vg2 falsch ldx #16 bne qen vg2 cmp #128 bcs gut cmp #96 bcs falsch cmp #32 bcc falsch gut cmp #tthen bne nothen ldx point jsr get stx point cmp #tgoto bne wnothen ldx #17 bne qen wnothen ldy point lda (tmp),y nothen cmp #tgo bne nog lda point sta merkp jsr get cmp #tto beq jato ldx #19 .byt $2c fahl18 ldx #18 lda merkp sta point qen jmp en jato lda #tgoto jmp tr2 nog cmp #204 bcs okay cmp #128 bcc okay cmp #163 bcs must ldx #bef4-bef3-1 mumu cmp bef3,x beq must dex bpl mumu bmi okay must lda point sta merkp g jsr get cmp #58 beq fahl18 tax beq fahl18 ldy merkp sty point lda (tmp),y okay cmp #"(" bne noauf inc bracket noauf cmp #")" bne nozu dec bracket nozu cmp #":" bne nopoint ldx datfg stx olddat ldx #0 stx onfg stx datfg ldx bracket beq nopoint ldx #0 stx bracket ldx olddat bne nopoint ldx #21 qqen bne qen nopoint cmp #tspc bne nospc inc bracket nospc cmp #ttab bne notab inc bracket notab cmp #ton bne noon inc onfg noon cmp #tprint bne noprint lda point sta merkp jsr get ldy merkp sty point cmp #"#" bne printon ldx #23 bne qqen printon jmp next noprint cmp #ton bne printon lda #0 sta onquote lda point sta merkp3 suchst jsr get tax bne noze early ldx #26 jsr error onesc lda merkp3 sta point bne printon noze cmp #34 bne nom34 lda onquote eor #-1 sta onquote jmp suchst nom34 ldx onquote bne suchst cmp #58 beq early cmp #tgoto beq kay cmp #tgosub bne suchst kay sta merktok agan jsr fetchnum dex beq gtnum1 dex beq gtnum1 dex beq out51 over1 ldx #4 bne eresc out51 cmp #","-"0" beq gtnum1 ldx #5 eresc jsr error jmp again gtnum1 sta char ldx zahl ldy zahl+1 cpy #250 bcs over1 jsr suchxy lda flag beq again cmp #1 bne no11 ldx #3 bne eresc no11 cmp #2 bne no21 ldx #6 bne eresc no21 cmp #5 bne no51 ldx #10 lda thenflg bne again beq eresc no51 cmp #3 beq again ldx #8 bne eresc again lda char beq lineend cmp #","-"0" beq agan lda merktok cmp #tgosub beq lineend jsr atn20 lineend jmp onesc anmerkung cmp #204 bne noel ldx #15 jmp en noel jmp next berror ldx aktline lda aktline+1 jsr numin lda #":" jsr bsout jsr space ldx errnum lda #0 jsr axfac lda buffer+1 bne ok0 lda buffer sta buffer+1 lda #0 sta buffer+2 lda #32 sta buffer ok0 jsr ay10 jsr strout lda #"[" jsr bsout ldx errnum lda sevtab-1,x jsr bsout jsr eva lda #"]" jsr bsout jsr space ldx errnum dex txa asl tax lda fetab+1,x tay lda fetab,x jsr strout ldx outadr cpx #8 beq aha jsr return aha lda #0 jsr bsout jmp clrchn eva sec sbc #"1" tax inc lowerr,x bne ee inc higerr,x ee rts numin jsr axfac ldx #0 such0 lda buffer,x beq fo0 inx bne such0 fo0 cpx #5 bcs sat ldy #5 fo1 lda buffer,x sta buffer,y dey dex bpl fo1 lda #32 fo2 sta buffer,y dey bpl fo2 sat jsr ay10 jmp strout axfac sta fac stx fac+1 ldx #144 sec jsr intflt jmp fltasc error cpx #8 bne n8error lda achtfg bne n8error off rts n8error cpx #7 bne n7error lda siebfg beq off n7error cpx #17 bne n17error lda siebfg beq off n17error cpx #12 bcc oderr cpx #15 bcs oderr lda beffg beq off oderr lda #1 sta common+begfe-1,x stx errnum jsr makebuf jsr raus ldx outadr cpx #8 bne ndisk jsr flopy ndisk jmp berror flopy lda #1 jsr bs2 jsr bsout jsr bs0 lda #20 jmp bs2 makebuf lda outflg bne okbuf rts okbuf lda puffer+2 cmp aktline bne neu lda puffer+3 cmp aktline+1 bne neu rts neu jsr puffout ldy #-1 trans iny beq gh lda (tmp),y sta puffer,y bne trans gh cpy #4 bcc trans rts puffout ldx puffer+3 inx bne okout rts okout jsr raus lda outadr cmp #8 bne normal jsr flopy jsr hokus ldy #3 ras iny beq sg lda puffer,y jsr bsout tax bne ras sg cpy #4 bcc ras bcs ch0 hokus ldx puffer+2 lda puffer+3 jsr numin jmp space normal jsr hokus ldy #3 sty hochk sty listptr lda #0 elpi ldy listptr and #127 elpi2 jsr bsout cmp #34 bne nohk lda hochk eor #-1 sta hochk nohk iny lda puffer,y bne lisst cpy #4 beq lisst jsr return ch0 jmp clrchn lisst tax bpl elpi2 cmp #-1 beq elpi2 bit hochk bmi elpi2 sec sbc #127 tax sty listptr ldy #-1 elpi3 dex beq elpi4 elpi5 iny lda beftab,y bpl elpi5 bmi elpi3 elpi4 iny lda beftab,y bmi elpi jsr bsout bcc elpi4 fertig jsr test43 lda vic+33 sta vic+32 jsr ende lda #222 sta common+9 lda #2 jmp close ende jsr puffout jsr raus jsr hang2 jsr hang lda #<end ldy #>end jsr strout jsr hang jsr hang lda #<f1 ldy #>f1 jsr strout ldx lowerr lda higerr jsr axout jsr hang lda #<f2 ldy #>f2 jsr strout ldx lowerr+1 lda higerr+1 jsr axout jsr hang jsr bs0 jsr bs2 jmp clrchn hang jsr bs0 hang2 ldx outadr cpx #8 beq sonny jmp return sonny lda #1 jsr bs2 lda #2 jsr bsout jsr bs0 lda #20 jmp bs2 fetchnum lda #0 sta zahl sta zahl+1 sta ziffer gnum lda point sta merkp2 jsr get cmp #58 beq of1 tax beq of2 sec sbc #"0" cmp #10 bcs of3 inc ziffer jsr mal10 bcs of4 adc zahl sta zahl bcc gnum inc zahl+1 bne gnum of4 ldx #4 rts of1 ldx #1 rts of2 ldx #2 rts of3 ldx #3 rts makecomm ldx #4 makeco lda code,x sta common,x dex bpl makeco lda #vers1 sta common+5 lda #vers2 sta common+6 lda #123 sta common+9 lda #0 ldx #anzfe-1 clrt sta common+begfe,x dex bpl clrt rts test43 lda tmp clc adc #2 bcc test34 inc tmp+1 test34 cmp basend bne bobo lda tmp+1 cmp basend+1 bne bobo rts bobo ldx #28 jmp error