Transactor/Transactor_26_1988_Transactor_Publishing.d64/kernal++.src

Commodore BASIC | 2023-02-26 | 15KB | 715 lines

1000 goto1055
1005 open15,8,15,"s0:kernal++.src":close15:save"0:kernal++.src",8:end
1010 ;
1015 ; --------------------------------
1020 ; "[203][197][210][206][193][204]++ [214]1.0    ([195]) 14 [202][213][206][197] 87
1025 ; "(NULL)illiam lenoleman 1431 (NULL)acetti (NULL)d
1030 ; "      aka       [199]reen [195]ove [211]pgs
1035 ; "(NULL)aster peeklaster  asclorida   32043
1040 ; --------------------------------
1045 ;
1050 ; these 2 lines copy the roms into ram
1055 : for i=57344 to 65535:pokei,peek(i):next
1060 : for i=40960 to 49151:pokei,peek(i):next
1065 sys32768
1070 .opt oo
1075 .page 65
1080 ; above is for abacus assembler. for pal, use sys 700, delete .page line
1085 ;
1090 ; *** kernal equates ***
1095 ;
1100 second = $ff93
1105 tksa = $ff96
1110 acptr = $ffa5
1115 ciout = $ffa8
1120 untalk = $ffab
1125 unlsn = $ffae
1130 listen = $ffb1
1135 talk = $ffb4
1140 readst = $ffb7
1145 open = $f3d5
1150 close = $f642
1155 chrout = $ffd2
1160 load = $f49e
1165 stop = $ffe1
1170 clall = $ffe7
1175 ;
1180 ; *** other equates ***
1185 ;
1190 basinit = $e3bf;    initialize basic
1195 basmsg = $e422;     power-up message
1200 vecp3 = $e453;      restore pg 3 vectors
1205 setpnts = $e56c;    set charout pntrs
1210 chardone = $e6a8;   exit 4 screen charout
1215 chkcodes = $e72a;   charout (after patch)
1220 clrline = $e9ff;    clear screenline
1225 upordown = $ec44;   chk for case change
1230 save = $e159
1235 border = $d020
1240 backrnd = $d021
1245 ciapra = $dc00
1250 ciaprb = $dc01
1255 outnum = $bdcd;     print integer
1260 strout = $ab1e;     outputs a string
1265 newstt = $a7ae;     set up statement
1270 runc = $a68e;       set up for run
1275 clear = $a659;      clear basic
1280 crunch = $a57c;     tokenize line
1285 link = $a533;       relink basic
1290 crvec = $0304;      crunch vector
1295 spckey = $028d;     ctrl,shift,or c=
1300 repeat = $028a;     keybrd repeat flag
1305 inbuf = $0200;      input buffer
1310 ;
1315 ; *** zero page equates ***
1320 ;
1325 cpnt = $f3;         pntr to color mem
1330 llynx = $d9;        line link table
1335 insert = $d8;       >0 = insert mode
1340 row = $d6;          cursor row (0-24)
1345 lmax = $d5;         max chars in line
1350 quote = $d4;        >0 = quote mode
1355 column = $d3;       cursor column
1360 rpnt = $d1;         pntr to video matrix
1365 keycnt = $c6;       keybrd buffer count
1370 wejdev = $be;       wedge device #
1375 fname = $bb
1380 device = $ba;       current device
1385 snd = $b9;          secondary addr
1390 length = $b7;       length of filename
1395 eal = $ae;          end of load
1400 kflag = $9d;        kernal message flag
1405 st = $90
1410 txtptr = $7a
1415 sov = $2d;          start of variables
1420 sob = $2b;          start of basic
1425 misc = $22
1430 flag = $02;         flag for autoboot
1435 ;
1440 ctrlret = 21;       ctrl-return
1445 ctrlhm = 22;        ctrl-home
1450 ctrlins = 23;       ctrl-ins/del
1455 ctrlvcr = 25;       ctrl-vert cursor
1460 ctrlhcr = 26;       ctrl-hori cursor
1465 ; ---------------------------------------
1470 ;
1475 ; -- patches default device # --
1480 ;
1485 *= $e1da
1490 .byte 8;   load"file" = load"file",8
1495 *= $e228
1500 .byte 4;   open4 = open4,4,7
1505 ldy #7
1510 ;
1515 ; -- patches vector table --
1520 ;
1525 *= $e44b
1530 .word wedge
1535 ;
1540 ; -- modify power up message --
1545 ;
1550 *= $e488
1555 .asc "[203]ernal++ [214]1.0 "
1560 ;
1565 ; -- text for load --
1570 ;
1575 *= $e4b7
1580 loadtxt .asc "load"
1585 .byte 34
1590 .asc "0:*"
1595 .byte 34
1600 .asc ",8,1"
1605 ;
1610 ; -- patch to for stop keys --
1615 ;
1620 *= $e5ea
1625 jmp onekeys
1630 nop
1635 ldx #5
1640 ;
1645 ; -- patch to print routine --
1650 ;
1655 *= $e725
1660 jmp chkquote
1665 nop
1670 nop
1675 *= $e7d1
1680 jmp newcodes
1685 ;
1690 *= $e962
1695 jmp wait
1700 ;
1705 ; -- patch to ctrl table --
1710 ;
1715 *= $ec42
1720 .byte $84
1725 *= $ec78
1730 .byte ctrlins,ctrlret,ctrlhcr
1735 *= $ec7f
1740 .byte ctrlvcr
1745 *= $ecab
1750 .byte ctrlhm
1755 *= $ecb7
1760 .byte $85
1765 ;
1770 ; -- patch shift-run/stop --
1775 ;
1780 *= $ece7
1785 .byte 13
1790 .asc "run"
1795 .byte 13
1800 ;
1805 ; -- patch out cassette --
1810 ;
1815 *= $f2ce
1820 jmp $f271
1825 *= $f38b
1830 jmp $f713
1835 *= $f539
1840 jmp $f713
1845 *= $f65a
1850 nop
1855 nop
1860 ;
1865 ; -- do stop keys --
1870 ;
1875 *= $f65f
1880 onekeys cmp #$83;   shifted
1885 bne ok1
1890 jmp $e5ee
1895 ok1 cmp #$84;       c= key
1900 bne ok2
1905 ldx #13
1910 bne stickit;        always
1915 ok2 cmp #$85;       ctrl key
1920 bne ok3
1925 ldx #9
1930 stickit sei
1935 stx keycnt
1940 okloop lda loadtxt-1,x
1945 sta $0276,x
1950 dex
1955 bne okloop
1960 jmp $e5cd
1965 ok3 jmp $e5fe
1970 ;
1975 ; -- activates wedge --
1980 ;
1985 *= $f72c
1990 wedgeon jsr vecp3
1995 lda #$08
2000 sta wejdev
2005 rts
2010 ;
2015 ;
2020 ; -- wedge proper --
2025 ;
2030 wedge ldx txtptr;   if not input buffer
2035 bne doreg;          then crunch
2040 cmp #"@"
2045 beq doat
2050 cmp #">"
2055 beq doat
2060 cmp #"_"
2065 beq dosave
2070 wdge cmp #"%";        entry from autoboot
2075 beq doml
2080 cmp #"^"
2085 beq doload
2090 cmp #"/"
2095 beq doload
2100 cmp #"="
2105 beq doload
2110 cmp #"!"
2115 beq jdobas
2120 cmp #"#"
2125 beq seq
2130 doreg jmp crunch;   normal crunching
2135 ;
2140 jdobas jmp dobas;   springboard
2145 ;
2150 ; -- save routine _ --
2155 ;
2160 dosave jsr setup;   set up file params
2165 jsr save;           save program
2170 frmseq jsr prntret; print return
2175 jmp disperr;        display error chan.
2180 ;
2185 ; -- set up for load --
2190 ;
2195 doml lda #1
2200 .byte $2c
2205 doload lda #0
2210 jmp loadit
2215 ;
2220 ; -- read seq file --
2225 ;
2230 seq lda inbuf+1
2235 beq done;         exit if just #
2240 jsr setup;        set up file parameters
2245 ldy length;       length of filename
2250 iny
2255 lda #","
2260 sta inbuf,y
2265 iny;              add two
2270 lda #"s"
2275 sta inbuf,y;      append ',s'
2280 sty length;       save new length
2285 jsr yoohoo;       tell drive to talk
2290 lda #25;          ctrl-return
2295 jsr chrout;       clear to bottom
2300 seql lda st
2305 bne sqout;        exit if st set
2310 jsr stop
2315 beq sqout;        also check stop key
2320 jsr acptr;        get a byte
2325 jsr chrout;       and print it
2330 jmp seql;         loop back
2335 ;
2340 sqout jsr close;  close file
2345 jmp frmseq;       exit
2350 ;
2355 ; -- parse @ commands --
2360 ;
2365 doat jsr setup;  set up file parameters
2370 lda inbuf+1
2375 beq jdisperr;    just @
2380 cmp #"#"
2385 beq chgdev
2390 cmp #"q"
2395 beq quit
2400 cmp #"$"
2405 beq dir
2410 cmp #"\"
2415 beq jwprot
2420 ;
2425 ; -- send string to error channel --
2430 ;
2435 jsr hello;          make drive listen
2440 ldy #0
2445 daloop lda inbuf+1,y; send string
2450 jsr ciout;            to drive
2455 iny
2460 cpy length
2465 bne daloop
2470 jsr unlsn
2475 done jmp bye
2480 jdisperr jmp disperr; read error chan.
2485 ;
2490 jwprot beq wprot;     springboard
2495 ;
2500 ; -- disable wedge --
2505 ;
2510 quit lda #<crunch;  restore default
2515 sta crvec        ;  crunch vector
2520 lda #>crunch
2525 sta crvec+1
2530 ;
2535 ; -- change wedge device --
2540 ;
2545 chgdev lda inbuf+2
2550 and #$0f
2555 sta wejdev
2560 ;
2565 ; -- common exit point --
2570 ;
2575 bye jsr $a67a;      part of clear
2580 jmp $a47b;          main basic loop
2585 ;
2590 ; -- list directory to screen --
2595 ;
2600 dir jsr yoohoo;   make drive talk
2605 lda #3;           load addr,link,blocks
2610 linein sta $9c
2615 suk jsr acptr;    get byte from drive
2620 sta $9e;          store
2625 jsr acptr;        get another
2630 sta $9f;          store it too
2635 ldx st
2640 bne ddone;        check st
2645 dec $9c;          loop to read in
2650 bne suk;          $9c pairs
2655 ldx $9e;          print decimal
2660 ldy $9f;          number, i.e.
2665 jsr outnum;       number of blks
2670 lda #" "
2675 jsr chrout;       print space
2680 dloop jsr acptr;  get a byte
2685 beq endline;      loop till zero (eol)
2690 jsr chrout
2695 jmp dloop
2700 endline jsr prntret
2705 jsr stop;         check stop key
2710 beq ddone
2715 lda #2
2720 bne linein;       link,blocks
2725 ddone jsr close
2730 jmp bye
2735 ;
2740 prntret lda #13
2745 jmp chrout;       print return
2750 ;
2755 ; -- write (un)protect disk --
2760 ;
2765 ; this routine sends to commands to the
2770 ; drive. the first writes some code and
2775 ; the second one executes that code.
2780 ;
2785 wprot jsr hello
2790 ldy #0
2795 wloop lda protstr,y
2800 jsr ciout
2805 iny
2810 cpy #31
2815 bne wloop
2820 jsr unlsn
2825 jsr hello
2830 ldy #0
2835 wloop2 lda exestr,y
2840 jsr ciout
2845 iny
2850 cpy #5
2855 bne wloop2
2860 jsr unlsn
2865 jmp disperr
2870 ;
2875 ; these two commands are sent to the
2880 ; drive. the first is a memory write
2885 ; and the second is a memory execute
2890 ;
2895 protstr .asc "m-w"; m-w 00 06 25
2900 .word $0600
2905 .byte 25
2910 jsr $d042;          load bam
2915 lda $0702;          get dos version
2920 eor #4;             a to e/e to a
2925 sta $0702;          store it back
2930 sta $07a6;          directory (2a/e)
2935 lda #$41;           make sure drive
2940 sta $0101;          will write
2945 jsr $ef07;          bam to disk
2950 jmp $d042;          reread bam and exit
2955 ;
2960 exestr .asc "m-e";  m-e 00 06
2965 .word $0600
2970 ;
2975 ; -- load routine % / ^ = --
2980 ;
2985 loadit sta snd
2990 jsr setup;       set up file parameters
2995 ldx sob
3000 ldy sob+1;       get start of basic
3005 lda inbuf;       if verify then
3010 cmp #"=";        accum > 0
3015 beq ver
3020 lda #0
3025 ver jsr load;    load program
3030 bcs lbad;        branch on error
3035 lda st
3040 and #$10
3045 bne lbad2;       branch on st
3050 lda inbuf
3055 cmp #"%"
3060 beq ldone;       if ml load then done
3065 lda eal
3070 sta sov
3075 lda eal+1
3080 sta sov+1;       set end of load pntrs
3085 jsr clear;       reset remaining pntrs
3090 jsr link;        re-link program
3095 jsr runc;        partial clear
3100 lda inbuf
3105 cmp #"^"
3110 bne ldone;       if not ^ then done
3115 lda #0
3120 sta kflag;       suppress kernal mess.
3125 sta inbuf
3130 jmp newstt;      execute next statement
3135 ;
3140 lbad tax
3145 bne lfini
3150 ldx #$1e
3155 .byte $2c
3160 lbad2 ldx #$1c
3165 .byte $2c
3170 ldone ldx #$80;   no error
3175 lda #$ff
3180 sta $3a;          set direct mode
3185 lfini jmp ($0300)
3190 ;
3195 ; -- parse command string --
3200 ;
3205 ; this routine set length and addr
3210 ; parameters of filename in buffer.
3215 ; %    "filename"  will become
3220 ; %filenamelname
3225 ;     this ^^^^^ will be ignored
3230 ;
3235 parse ldy #$02
3240 sty fname+1
3245 dey
3250 sty fname;          filename at $0201
3255 dey; now zero
3260 ploop1 lda inbuf+1,y
3265 beq pdone
3270 cmp #$22
3275 beq quot
3280 iny
3285 bpl ploop1
3290 quot ldx #0
3295 pmove lda inbuf+2,y; shift string to
3300 sta inbuf+1,x;       start of buffer.
3305 beq x2y;             no trailing quote
3310 cmp #$22
3315 beq x2y
3320 iny
3325 inx
3330 cpx #$25
3335 bne pmove
3340 x2y txa
3345 tay
3350 pdone sty length
3355 rts
3360 ;
3365 ; -- display error channel --
3370 ;
3375 disperr jsr clrst
3380 lda device
3385 jsr talk
3390 lda #%01101111;     $60+0f
3395 jsr tksa
3400 errloop jsr acptr
3405 jsr chrout
3410 cmp #13
3415 beq errdone
3420 lda st
3425 beq errloop
3430 errdone jsr untalk
3435 jbye jmp bye
3440 ;
3445 ; -- make disk listen --
3450 ;
3455 hello lda device
3460 jsr listen
3465 lda #%01101111;     $60+0f
3470 jmp second
3475 ;
3480 ; -- make drive talk --
3485 ;
3490 yoohoo lda #%01100000;   $60+0
3495 sta snd;          2ndary addr
3500 jsr open;         open channel
3505 lda device
3510 jsr talk;         make drive talk
3515 lda snd
3520 jmp tksa;         2ndary addr
3525 ;
3530 ; -- setup for drive routines --
3535 ;
3540 setup jsr parse;  parse filename
3545 lda wejdev
3550 sta device;       set drive #
3555 clrst lda #0
3560 sta st;           clear status
3565 rts
3570 ;
3575 ; -- parse ! routines --
3580 ;
3585 dobas lda inbuf+1
3590 beq jbye;           just !
3595 cmp #"d"
3600 beq default
3605 cmp #"*"
3610 beq unnew
3615 cmp #"0"
3620 bcc jbye
3625 cmp #"<"
3630 bcs jbye
3635 sta border
3640 ldy inbuf+2
3645 beq scolor
3650 clc
3655 tya
3660 adc #10
3665 sta border
3670 scolor sta backrnd
3675 jmp bye
3680 ;
3685 default jsr color
3690 jmp bye
3695 ;
3700 ; -- unnew basic --
3705 ;
3710 unnew lda #1
3715 tay
3720 sta (sob),y;   set first link
3725 jsr link;      re-link program
3730 lda misc
3735 sta sov;       link provides the
3740 lda misc+1;    end of program.
3745 sta sov+1;     just move it.
3750 jsr clear
3755 jmp bye
3760 ;
3765 ; -- set default screen colors --
3770 ; -- modify to suit your taste --
3775 ;
3780 color lda #$80
3785 sta repeat;         make all keys repeat
3790 lda #0;             backround
3795 sta border
3800 nop;                you can insert a
3805 nop;                a lda #xx here.
3810 sta backrnd
3815 lda #153;           char color
3820 jsr chrout
3825 lda #14;            lowercase
3830 jmp chrout
3835 ;
3840 ; -- check for autoboot --
3845 ;
3850 autoboot jsr wedgeon
3855 jsr basinit;        initialize basic
3860 jsr color
3865 jsr basmsg;         power up message
3870 ;
3875 ldx #251
3880 txs; clear stack
3885 lda #1
3890 sta flag;           init load type flag
3895 lda spckey
3900 cmp #1
3905 beq auto1;          if shift key
3910 cmp #4
3915 beq auto2;          if ctrl key
3920 bne fini;           always if no match
3925 auto1 lsr flag;     flag now zero
3930 auto2 jsr clall
3935 ldy #$ff
3940 bootl iny;          tranfer "0:?*"
3945 lda star,y;         to input buffer.
3950 sta inbuf+1,y
3955 bne bootl
3960 jsr parse;          parse buffer
3965 lda flag
3970 bne mlload
3975 lda #"^"
3980 .byte $2c
3985 mlload lda #"%"
3990 sta inbuf;          use the wedge
3995 jmp wdge;           to load program.
4000 fini jmp $e386;     to basic
4005 star .asc "0:?*"
4010 .byte 0
4015 ;
4020 ; -- power up default colors --
4025 ;
4030 setclr jsr color
4035 jmp ($a002)
4040 ;
4045 ; -- stop scroll if shift --
4050 ;
4055 wait sta $ac
4060 sei
4065 w1 lda #$fd
4070 sta ciapra
4075 lda ciaprb
4080 cmp #%01111111
4085 beq w1;             loop if shift
4090 cli
4095 rts
4100 ;
4105 ; -- quote toggle --
4110 ;
4115 chkquote bpl chkq;  part of reg kernal
4120 jmp $e7d4;          key > 128
4125 chkq cmp #ctrlins;  "ctrl-ins pressed?
4130 beq q[164]g;           yep
4135 jmp chkcodes;       nope
4140 q[164]g lda insert;    "insert mode?
4145 beq tryq;           nope
4150 qoff lda #0
4155 sta insert;         clear insert
4160 sta quote;          clear quote
4165 beq qdone;          always
4170 tryq lda quote;     "quote mode?
4175 bne qoff;           yep, clear it
4180 inc quote;          nope, set it
4185 qd[145]e jmp chard[145]e
4190 ;
4195 ; [171][171] parse [162] ctrl codes [171][171]
4200 ;
4205 [162]codes cmp #ctrlret
4210 beq [156]2eol
4215 cmp #ctrlhm
4220 beq bothome
4225 cmp #ctrlvcr
4230 beq [156]2bot
4235 cmp #ctrlhcr
4240 beq [156]2[164]p
4245 jmp up[176]down;      check [129] case change
4250 ;
4255 ; [171][171] clear [164] [128] of line [171][171]
4260 ;
4265 [156]2eol lda #$20;  put a space
4270 sta (rpnt),y;      in video matrix
4275 lda back[187];       put backround col[176]
4280 sta (cpnt),y;      in col[176] mem[176]y
4285 iny
4290 cpy lmax;          check [129] eol
4295 bcc [156]2eol
4300 beq [156]2eol
4305 bcs jchrd[145]e
4310 ;
4315 ; [171][171] curs[176] [164] bot[164]m [171][171]
4320 ;
4325 bothome ldy #0
4330 ldx #24
4335 jsr $e50c;       jump [181]o clear screen
4340 jchrd[145]e jmp chard[145]e
4345 ;
4350 ; [171][171] clear [164] bot[164]m of screen [171][171]
4355 ;
4360 [156]2bot ldx #$19
4365 c2b1 dex;        from the bot[164]m up
4370 cpx row
4375 beq c2b2
4380 lda llynx,x;     clear line links
4385 [176]a #$80
4390 sta llynx,x
4395 jsr [156]line;     clear line
4400 bmi c2b1;        always
4405 c2b2 jsr $e9f0;  reset po[181]ers
4410 jsr $ea24
4415 ldy column;      clear line the
4420 jmp [156]2eol;     curs[176]s [145].
4425 ;
4430 ; [171][171] clear [164] [164]p of screen [171][171]
4435 ;
4440 [156]2[164]p ldx #$ff
4445 c2t1 inx;        from the [164]p down
4450 lda llynx,x;     clear line links
4455 [176]a #$80
4460 sta llynx,x
4465 jsr [156]line;     clear line
4470 cpx row
4475 bne c2t1
4480 beq jchrd[145]e;    always
4485 ;
4490 ; [171][171] various patches [171][171]
4495 ;
4500 [172][178] $fcff
4505 jmp au[164]boot
4510 [172][178] $fe6f
4515 jmp set[156]
4520 [172][178] $ff80
4525 .byte $10;   versi[145] byte (1.0)
4530 ;
4535 ; [171][171] [158]65526 [164] reactivate [171][171]
4540 ;
4545 [172][178] $fff6;    last jump table entry
4550 jmp wedge[145]; is n[176]mally unused.
4555 ;
4560 ;
4565 .[128]