Neues von SMON

100 rem *******************************
110 rem *                             *
120 rem *      smon - erweiterung     *
130 rem *                             *
140 rem *  von   mark richters        *
150 rem *        allerstr.4           *
160 rem *        2806 oyten           *
170 rem *        tel.: 04207/1870     *
180 rem *                             *
190 rem *******************************
200 :
210 print"bitte die startadresse"
220 print"ihrer smon-version eingeben!"
230 input h :al=h:h=h/4096
240 if h<>int(h) then 210
250 pokeal+38,0
260 :
270 dim w(75)
280 for i=0 to 9
290 :  w(48+i)=i
300 :  w(65+i)=i+10
310 next i
320 :
330 for i=1 to 4
340 :  read k,z : k=k+h*4096
350 :  for j=k to k+z-1
360 :    read a$
370 :    a=w(asc(a$))
380 :    b=w(asc(right$(a$,1)))
390 :    s=s+a+b
400 :    if asc(a$)=42 then a=h
410 :    p=a*16+b : poke j,p
420 :  next j
430 next i
440 :
450 if s=7031 then print"ok!":goto470
460 print"fehler in datas !"
470 stop
480 :
490 data97,7
500 data27,3a,3b,2c,28,29,21
510 :
520 data739,28
530 dataa2,06,dd,61,*0,f0,08,ca
540 data10,f8,a9,2e,20,d2,ff,20
550 dataca,*2,c9,2e,f0,f9,4c,85
560 data*f,4c,b2,*f
570 :
580 data781,2
590 dataf0,ed
600 :
610 data3593,503
620 dataa9,80,2c,a9,00,85,ab,20
630 data64,*2,24,ab,10,03,a2,29
640 data2c,a2,28,20,40,*3,20,23
650 data*3,a0,06,a2,00,a1,fb,0a
660 data48,b0,03,a9,2e,2c,a9,2a
670 data91,d1,ad,86,02,91,f3,68
680 datac8,e8,e0,08,d0,e9,20,67
690 data*3,24,ab,30,04,c0,1e,90
700 datada,20,5d,*4,90,c4,60,a0
710 data08,2c,a0,18,20,7e,*2,20
720 datab8,*2,a2,08,a9,00,85,aa
730 data20,ca,*2,c9,2e,f0,07,c9
740 data2a,f0,04,4c,d1,*2,18,26
750 dataaa,88,ca,d0,eb,a5,aa,81
760 datafb,c1,fb,d0,ee,20,67,*3
770 datac0,00,d0,d6,60,a9,80,2c
780 dataa9,00,85,ab,20,64,*2,20
790 data51,*3,24,ab,10,0b,a9,21
800 data20,d2,ff,20,23,*3,a0,08
810 data2c,a0,00,a2,00,a1,fb,20
820 data4f,*4,d0,f9,20,5d,*4,90
830 datade,60,20,7e,*2,a2,00,a0
840 data08,b1,d1,81,fb,c1,fb,d0
850 dataaa,20,56,*4,90,f3,60,20
860 data8d,*2,29,f0,85,ff,20,3c
870 data*f,20,d6,*9,20,3c,*f,a9
880 data14,85,fb,a9,02,05,ff,85
890 datafc,a9,d1,85,fd,a9,0f,05
900 dataff,85,fe,20,68,*a,a0,00
910 dataa2,0d,bd,f2,*f,05,ff,85
920 datafc,ca,bd,f2,*f,85,fb,b1
930 datafb,29,0f,05,ff,91,fb,ca
940 data10,e8,a9,2b,85,fb,a9,00
950 data05,ff,85,fc,a0,35,b1,fb
960 data29,0f,05,ff,91,fb,88,88
970 data10,f4,a9,de,85,fb,a9,0f
980 data05,ff,85,fc,a0,13,b1,fb
990 data29,0f,05,ff,91,fb,88,88
1000 data10,f4,60,a5,ff,85,a9,20
1010 data43,*f,68,68,29,f0,85,a5
1020 data18,69,10,85,a7,a9,00,85
1030 dataa4,85,a6,85,a8,60,20,7a
1040 data*2,a9,00,4c,c7,*9,20,7e
1050 data*2,a0,00,a9,d0,84,fd,85
1060 datafe,78,a9,03,85,01,a2,10
1070 datab1,fd,91,fb,c8,d0,f9,e6
1080 datafc,e6,fe,ca,d0,f2,a9,27
1090 data85,01,58,60,48,c9,4a,d0
1100 data10,a0,27,b9,00,02,91,d1
1110 data88,10,f8,68,c6,d6,4c,d6
1120 data*2,a0,06,d9,d7,*f,d0,0a
1130 dataa0,27,b1,d1,99,00,02,88
1140 data10,f8,88,10,ee,68,4c,ff
1150 data*2,a2,0a,dd,d0,*f,f0,06
1160 dataca,d0,f8,4c,d1,*2,20,c5
1170 data*f,4c,d6,*2,8a,0a,aa,bd
1180 datadd,*f,48,bd,dc,*f,48,60
1190 data28,29,21,45,59,51,48,5a
1200 data4e,55,44,4b,4d,52,*e,4f
1210 data*e,b2,*e,56,*f,c7,*e,5e
1220 data*f,0b,*e,08,*e,85,*e,88
1230 data*e,06,00,87,03,2d,0c,5c
1240 data0c,f5,0c,a2,0d,04,0e

100 sys9*4096
110 .opt oo
130 ;
140 ; !smon-erweiterung
150 ; erweitert smon um folgende
160 ; befehle   - h adr1 (adr2)
170 ;           - z adr1 (adr2)
180 ;           - n adr1 (adr2)
190 ;           - u adr1 (adr2)
200 ;           - e adr1  adr2
210 ;           - y byte
220 ;           - q adr1
230 ;           - j
240 ;
250 ;------------------------------
260 ; 'h'
270 ;
280 ;     bildet jeweils drei bytes
290 ;     in binaerdarstellung ab.
300 ;     (fuer sprite-daten)
310 ;------------------------------
320 ; 'z' (zeichen)
330 ;
340 ;     bildet jeweils ein byte
350 ;     in binaerdarstellung ab.
360 ;     (fuer character-daten)
370 ;------------------------------
380 ; 'n' (normal)
390 ;
400 ;     bildet 32 bytes als bild-
410 ;     schirm-code ab.(+ adr!)
420 ;------------------------------
430 ; 'u' (uebersicht)
440 ;
450 ;     bildet 40 bytes als bild-
460 ;     schirm-code ab.       
470 ;------------------------------
480 ; 'e' (erase)
490 ;
500 ;     fuellt bereich von adr1
510 ;     bis adr2 mit $00.
520 ;------------------------------
530 ; 'y'
540 ;
550 ;     schreibt smon auf
560 ;     $byte00 um.
570 ;------------------------------
580 ; 'q'
590 ;
600 ;     kopiert zeichensatz
610 ;     nach adr1.
620 ;------------------------------
630 ; 'j'
640 ;
650 ;     holt letzten ausgabe-
660 ;     befehl (h,z,n,u,k,m,d)
670 ;     zurueck.
680 ;------------------------------
690 ;
700 s = $c000      ;basisadresse smon
710 ;
720 hch      ="("  ;hidden commands
730 hcz      =")"
740 hcn      ="!"
750 ;
760 flag     =$aa
770 temp     =$ab
780 pcl      =$fb
790 pch      =$fc
800 hinibble =$ff
810 ;
820 cmds     =s+$02b
830 get12adr =s+$264
840 get2adr  =s+$27a
850 getadr1  =s+$27e
860 getbyt   =s+$28d
870 skipspac =s+$2b8
880 getret   =s+$2c2
890 getchrer =s+$2ca
900 error    =s+$2d1
910 execute  =s+$2d6
920 cmdstore =s+$2ff
930 charret  =s+$340
940 return   =s+$351
950 hexout   =s+$323
960 pcinc    =s+$367
970 ascii4   =s+$44f
980 ascii5   =s+$456
990 contin   =s+$45d
1000 occupy   =s+$9c7
1010 ;-------------
1011 *= s+38
1012 .byte 00      ;alten z-befehl loeschen
1013 ;
1020 *= s+$61
1030 ;
1040 hcmdtab .asc "':;,"
1050 .byte hch,hcz,hcn
1060 ;
1070 *=s+$2e3
1080 ;
1090 ldx #6        ;zeilenanfang
1100 f1 cmp hcmdtab,x
1110 beq exec1
1120 dex
1130 bpl f1
1140 lda #"."
1150 jsr $ffd2
1160 ;
1170 exec1 jsr getchrerr
1180 cmp #"."
1190 beq exec1
1200 jmp linstore
1210 weiter jmp morecmd
1220 ;
1230 *=s+$30d      ;weitere befehle
1240 ;
1250 beq weiter
1260 ;
1270 *=s+$e09      ;neue routinen
1280 ;
1290 ;-------------
1300 ;
1310 zcmd lda #$80 ;flag setzen
1320 .byte $2c
1330 ;
1340 hcmd lda #0
1350 sta temp
1360 jsr get12adr  ;start/end-adresse
1370 ;
1380 l1 bit temp
1390 bpl w8
1400 ldx #hcz      ;hidden command
1410 .byte $2c     ;ausgeben
1420 w8 ldx #hch
1430 jsr charret
1440 jsr hexout    ;pc ausgeben
1450 ldy #6        ;spalte 6
1460 ;
1470 l2 ldx #0
1480 lda (pcl,x)
1490 ;
1500 l3 asl
1510 pha           ;byte merken
1520 bcs bitset    ;bit=1, dann *
1530 lda #"."      ;bit=0, dann .
1540 .byte $2c     ;ausgeben
1550 bitset lda #"*"
1560 sta ($d1),y
1570 lda $286
1580 sta ($f3),y
1590 ;
1600 pla           ;byte zurueckholen
1610 iny           ;cursor weiter
1620 inx           ;naechstes byte
1630 cpx #8        ;8 bit
1640 bne l3        ;byte weiterschieben
1650 ;
1660 jsr pcinc     ;zaehler erhoehen
1670 bit temp      ;flag fuer 1*8 bit
1680 bmi w9        ;zeile fertig
1690 cpy #30       ;3 bytes
1700 bcc l2
1710 w9 jsr contin ;tasten-abfrage
1720 bcc l1
1730 rts
1740 ;
1750 ;-------------
1760 ;
1770 zcmdh   ldy #8
1780 .byte $2c     ;1 byte
1790 ;
1800 hcmdh ldy #24 ;3 byte
1810 jsr getadr1
1820 jsr skipspace ;spaces ueberlesen
1830 a1 ldx #8
1840 lda #0
1850 sta flag
1860 ;
1870 a2 jsr getchrerr
1880 cmp #"."      ;. => bit=0
1890 beq bit0      ;* => bit=1
1900 cmp #"*"
1910 beq bit1
1920 err1 jmp error ;anderes zeichen
1930 ;
1940 bit0 clc
1950 bit1 rol flag
1960 dey
1970 dex           ;byte
1980 bne a2        ;noch nicht fertig
1990 ;
2000 lda flag      ;in speicher
2010 sta (pcl,x)   ;schreiben
2020 cmp (pcl,x)
2030 bne err1
2040 jsr pcinc
2050 ;
2060 cpy #0
2070 bne a1        ;noch nicht fertig
2080 rts
2090 ;
2100 ;-------------
2110 ;
2120 ncmd lda #$80
2130 .byte $2c
2140 ucmd lda #0
2150 sta temp
2160 jsr get12adr
2170 ;
2180 l5 jsr return
2190 bit temp
2200 bpl u
2210 lda #hcn      ;hidden command
2220 jsr $ffd2
2230 jsr hexout
2240 ldy #8        ;spalte 8
2250 .byte $2c
2260 ;
2270 u ldy #0      ;spalte 0
2280 ldx #0
2290 ;
2300 l4 lda (pcl,x)
2310 jsr ascii4    ;als bildschirm-code
2320 bne l4        ;ausgeben
2330 ;
2340 jsr contin
2350 bcc l5        ;naechste zeile
2360 rts
2370 ;-------------
2380 ncmdh jsr getadr1
2390 ldx #0
2400 ldy #8        ;spalte 8
2410 c1 lda ($d1),y
2420 sta (pcl,x)   ;in speicher
2430 cmp (pcl,x)   ;schreiben
2440 bne err1
2450 jsr ascii5    ;pc erhoehen
2460 bcc c1
2470 rts           ;zeile fertig
2480 ;
2490 ;-------------
2500 ;
2510 ycmd jsr getbyt
2520 and #%11110000
2530 sta hinibble  ;neuer 4k-block
2540 jsr setptr    ;adressen setzen
2550 jsr $79d6     ;w-befehl
2560 ;
2570 jsr setptr
2580 lda #$14      ;bereich ohne
2590 sta $fb       ;tabellen
2600 lda #2
2610 ora hinibble
2620 sta $fc
2630 lda #<newcmds
2640 sta $fd
2650 lda #(newcmds>8 & $f)
2660 ora hinibble
2670 sta $fe
2680 jsr $7a68     ;v-befehl
2690 ;
2700 ldy #0        ;lade-befehle
2710 ldx #13       ;anpassen
2720 d3 lda change,x
2730 ora hinibble
2740 sta pch       ;adresse als zeiger
2750 dex
2760 lda change,x
2770 sta pcl
2780 lda (pcl),y
2790 and #%00001111
2800 ora hinibble
2810 sta (pcl),y
2820 dex
2830 bpl d3
2840 ;
2850 lda #<cmds    ;zeiger auf
2860 sta pcl       ;befehlsadressen
2870 lda #(cmds>8 & $f)
2880 ora hinibble
2890 sta pch
2900 ;
2910 ldy #53
2920 d1 lda (pcl),y
2930 and #%00001111
2940 ora hinibble  ;hibytes
2950 sta (pcl),y   ;angleichen
2960 w1 dey
2970 dey
2980 bpl d1
2990 ;
3000 lda #<newadr  ;zeiger auf neue
3010 sta pcl       ;befehlsadressen
3020 lda #(newadr>8 & $f)
3030 ora hinibble
3040 sta pch
3050 ;
3060 ldy #tabend-newadr-1
3070 d2 lda (pcl),y
3080 and #%00001111
3090 ora hinibble  ;hibytes
3100 sta (pcl),y   ;angleichen
3110 dey
3120 dey
3130 bpl d2
3140 rts
3150 ;
3160 ;
3170 setptr lda hinibble
3180 sta $a9       ;neuer start hi
3190 jsr gethi
3200 gethi pla
3210 pla
3220 and #%11110000
3230 sta $a5       ;alter start hi
3240 clc
3250 adc #$10
3260 sta $a7       ;altes ende hi
3270 ;
3280 lda #0        ;lo-bytes loeschen
3290 sta $a4
3300 sta $a6
3310 sta $a8
3320 rts
3330 ;
3340 ;---------
3350 ;
3360 ecmd jsr get2adr
3370 lda #0
3380 jmp occupy
3390 ;
3400 ;---------
3410 ;
3420 qcmd jsr getadr1
3430 ldy #0
3440 lda #$d0      ;zeiger auf
3450 sty $fd       ;zeichenrom
3460 sta $fe
3470 ;
3480 sei
3490 lda #%011     ;rom einblenden
3500 sta 1
3510 ldx #16       ;4k uebertragen
3520 e1 lda ($fd),y
3530 sta (pcl),y
3540 iny
3550 bne e1
3560 inc pch
3570 inc $fe
3580 dex
3590 bne e1
3600 lda #$27      ;normaleinstellung
3610 sta 1
3620 cli
3630 rts
3640 ;
3650 ;---------
3660 ;
3670 linstore pha  ;befehl merken
3680 cmp #"j"
3690 bne store
3700 ;
3710 ldy #39
3720 g1 lda $0200,y
3730 sta ($d1),y   ;zeile auf
3740 dey           ;bildschirm
3750 bpl g1        ;schreiben
3760 pla
3770 dec $d6       ;cursor 1 hoch
3780 jmp execute
3790 ;
3800 store ldy #6
3810 g3 cmp outcmds,y
3820 bne w3
3830 ;
3840 ok1 ldy #39
3850 g2 lda ($d1),y
3860 sta $0200,y   ;zeile nur bei
3870 dey           ;h,z,n,u,k,m,d
3880 bpl g2        ;speichern
3890 ;
3900 w3 dey
3910 bpl g3
3920 stend pla     ;befehl zurueckholen
3930 jmp cmdstore
3940 ;
3950 ;+++++++++
3960 ;
3970 morecmd ldx #newadr-newcmds-3
3980 b1 cmp newcmds-1,x
3990 beq found
4000 dex
4010 bne b1
4020 jmp error
4030 ;
4040 found jsr cmdexec2
4050 jmp execute
4060 ;
4070 cmdexec2 txa
4080 asl
4090 tax
4100 lda newadr-1,x
4110 pha
4120 lda newadr-2,x
4130 pha
4140 rts
4150 ;
4160 newcmds .byte hch,hcz,hcn
4170 .asc "eyq"
4180 outcmds .asc "hznudkm"
4190 ;
4200 newadr .word hcmdh-1
4210 .word zcmdh-1
4220 .word ncmdh-1
4230 .word ecmd-1             ;e
4240 .word ycmd-1             ;y
4250 .word qcmd-1             ;q
4260 .word hcmd-1             ;!
4270 .word zcmd-1             ;z
4280 .word ncmd-1             ;n
4290 .word ucmd-1             ;u
4300 tabend = *
4310 ;
4320 change .word $0005+1
4330 .word $0386+1
4340 .word $0c2c+1
4350 .word $0c5b+1
4360 .word $0cf4+1
4370 .word $0da1+1
4380 .word $0e03+1