1000 ! * DUMP.BAC
1020 ; '** Dump utility **'
1040 ; ' Ver 6.04, 1985-05-08'
1060 ;
1100 ! * Written by G|ran Nordenborg
1120 ! ** ** ** ** ** ** ** ** ** ** **
1140 ! *
1160 ! * Ver date / Ver nb / Sign / Note
1180 ! * 82-07-07 / X.00 / GN / Main
1200 ! * 82-09-23 / 6.00 / GN / Release
1220 ! * 83-01-26 / 6.01 / GN / Device 'BW*:' included
1240 ! * 83-09-27 / 6.02 / GN / RAM read through DOS
1260 ! * 84-01-04 / 6.03 / GN / Cmd 'C' and 'F' and new device name scan
1261 ! * 85-05-08 / 6.04 / GN / New insert mode positioning
1280 ! *
1300 ! ** ** ** ** ** ** ** ** ** ** **
1320 ! *
1330 INTEGER : EXTEND
1340 ! EJECT
1360 ! ********************************
1380 ! *
1400 ! * Main routine
1420 ! *
1440 Q7=FNInitialize
1460 ; 'Command "H" will diplay some HELP'
1480 ;
1500 INPUT 'Input device/filename : 'Source$
1520 ; CHR$(12);
1540 ! *
1560 WHILE LEN(Source$)<>0
1580 IF INSTR(1,Source$,':')=LEN(Source$) THEN 2040
1600 ! *
1620 ! * Filename found
1640 ! *
1660 Source=File
1680 Lfn=16
1700 Pos=6
1720 ! *
1740 WHILE PEEK(-704+1+Lfn)<>255
1760 Lfn=Lfn+16
1780 WEND
1800 ! *
1820 ON ERROR GOTO 2000
1840 OPEN Source$ AS FILE 1
1860 Devicenb=PEEK(-767)
1880 GET #1 Dummy$
1900 ON ERROR GOTO
1920 POKE VAROOT(Q0$)+2,(62720+16*Lfn) AND 255,(62720+16*Lfn)/256
1940 Buffer$=Q0$
1960 GOTO 2460
1980 ! *
2000 ; 'Error' ERRCODE 'during fileopening'
2020 RESUME 1500
2040 ! *
2060 ! * Device found
2080 ! *
2100 Source=Device
2120 FOR I=1 TO LEN(Source$)
2140 IF MID$(Source$,I,1)>='a' THEN MID$(Source$,I,1)=CHR$(ASCII(MID$(Source$,I,1)) AND 223)
2160 NEXT I
2180 Devpointer=PEEK2(-133)
2200 Devicenb=254
2220 WHILE Devpointer<>0 AND Devicenb=254
2240 Dev$=CHR$(PEEK(Devpointer+2),PEEK(Devpointer+3),PEEK(Devpointer+4))
2260 IF Dev$+':'=Source$ THEN Devicenb=PEEK(Devpointer+7) ELSE Devpointer=PEEK2(Devpointer)
2280 WEND
2300 ! *
2320 IF Devicenb=254 THEN ; "Device not found!" CHR$(7) : GOTO 1500
2340 POKE VAROOT(Q0$)+2,62720 AND 255,62720/256
2360 POKE -767,Devicenb
2380 Q7=FNRead(0)
2400 ! *
2420 ! EJECT
2440 ! ********************************
2460 ! *
2480 ! * Main command loop
2500 ! *
2520 Q7=FNClearscr
2540 Record=0
2560 ! *
2580 WHILE Cmd$<>Pf8$
2600 Q7=FNListbuffer
2620 IF Cmd$<>'C' OR SYS(5) THEN GET Cmd$
2640 IF Cmd$<>'C' AND Cmd$<>'c' THEN Oldcmd$=Cmd$ ELSE Cmd$='C'
2660 ; Oldcmd$;
2680 Q7=FNCmd(Oldcmd$)
2700 WEND
2720 ! *
2740 Cmd$=''
2760 CLOSE 1
2780 Q7=FNClearscr
2800 ; : ;
2820 INPUT 'Input device/filename : 'Source$
2840 WEND
2860 ! *
2880 ! EJECT
2900 ! ********************************
2920 ! *
2940 ! * Execute a command
2960 ! *
2980 DEF FNCmd(Cmd$)
3000 ON INSTR(1,Cmds$,Cmd$)+1 GOTO 3080,3400,3500,3500,3560,3560,3900,3900,4320,4320,4740,4740,4920,4920,5360,5360,5540,5720,5720,5920,5920,6140
3020 ! *
3040 ! * Command not found or number
3060 ! *
3080 ON ERROR GOTO 3340
3100 Rec=0
3120 ! *
3140 Rec$=Cmd$
3160 WHILE Rec$<>CHR$(13)
3180 Rec=Rec*10+VAL(Rec$)
3200 GET Rec$
3220 ; Rec$;
3240 WEND
3260 ! *
3280 ON ERROR GOTO
3300 RETURN FNRead(Rec)
3320 ! *
3340 ; CHR$(7);
3360 RESUME 3380
3380 RETURN 0
3400 ! *
3420 ! * Read next record
3440 ! *
3460 RETURN FNRead(Record+1)
3480 ! *
3500 ! * Edit command
3520 ! *
3540 RETURN FNEdit
3560 ! *
3580 ! * Get old sector
3600 ! *
3620 Q7=FNClearscr
3640 ; : ;
3660 INPUT 'Name : ';Secname$
3680 IF LEN(Secname$)=0 THEN RETURN 0
3700 ! *
3720 FOR I=0 TO Mxstore
3740 IF Secname$=Secname$(I) THEN 3840
3760 NEXT I
3780 ! *
3800 ; 'Name not found. Try library'
3820 GOTO 3660
3840 Buffer$=Secbuffer$(I)
3860 RETURN 0
3880 ! *
3900 ! * Some help texts
3920 ! *
3940 Q7=FNClearscr
3960 ; : ;
3980 ; ' Display next record'
4000 ; '- Backwards one record'
4020 ; 'E Edit (In edit, PF6 gives help)'
4040 ; 'G Get old sector'
4060 ; 'H This help text'
4080 ; 'L Library listing'
4100 ; 'R Read RIB'
4120 ; 'S Save present sector'
4140 ; 'W Write sector on disk'
4160 ; 'P Print sector on printer'
4180 ; 'F Print sector as ref. on screen'
4200 ;
4220 ; 'Press any char to continue :';
4240 GET Dummy$
4260 Q7=FNClearscr
4280 RETURN 0
4300 ! *
4320 ! * Library listing
4340 ! *
4360 Q7=FNClearscr
4380 ; : ;
4400 Libcount=0
4420 ! *
4440 FOR I=0 TO Mxstore
4460 IF Secname$(I)='' THEN 4560
4480 IF Libcount=0 THEN ; 'Name','Owner',' Rec' : ; STRING$(39,ASCII('='))
4500 Libcount=Libcount+1
4520 ; Secname$(I),
4540 ; Secowner$(I)
4560 NEXT I
4580 ! *
4600 IF Libcount=0 THEN ; "Library is empty"
4620 ;
4640 ; 'Press any char to continue :';
4660 GET Dummy$
4680 Q7=FNClearscr
4700 RETURN 0
4720 ! *
4740 ! * Read rib
4760 ! *
4780 IF Source=Device THEN ; CHR$(7); : RETURN 0
4800 Source=Device
4820 Q7=FNRead(PEEK2(-704+8+Lfn))
4840 Source=File
4860 Record=-1
4880 RETURN 0
4900 ! *
4920 ! * Save sector in mem
4940 ! *
4960 Q7=FNClearscr
4980 ; : ;
5000 INPUT 'Name : ';Secname$
5020 ! *
5040 FOR I=0 TO Mxstore
5060 IF Secname$=Secname$(I) THEN 5260
5080 NEXT I
5100 ! *
5120 FOR I=0 TO Mxstore
5140 IF LEN(Secname$(I))=0 THEN 5260
5160 NEXT I
5180 ; 'Directory full';CHR$(7);
5200 FOR I=0 TO 1000 : NEXT I
5220 RETURN 0
5240 ! *
5260 Secname$(I)=Secname$
5280 Secowner$(I)=LEFT$(Source$+SPACE$(18),18)+NUM$(Record)
5300 Secbuffer$(I)=Buffer$
5320 RETURN 0
5340 ! *
5360 ! * Write sector on disk
5380 ! *
5400 IF Source=File THEN POSIT #1 Record*253. : PUT #1 MID$(Buffer$,4,253) : RETURN 0
5420 POKE -767,Devicenb
5440 Q0$=LEFT$(Buffer$,256)
5460 ! IF Devicenb=29 THEN POKE -747,CALL(Ramwr,Record) ELSE Q7=CALL(24675,Record)
5480 Q7=CALL(24675,Record)
5500 RETURN 0
5520 ! *
5540 ! * Backwards one record
5560 ! *
5580 Record=Record-1
5600 IF Source=Device AND Record<0 THEN Record=Record+1 : ; CHR$(7); : RETURN 0
5620 IF Record=-1 THEN GOTO 4800 ! Rib
5640 IF Record<0 THEN Record=Record+1 : ; CHR$(7); : RETURN 0
5660 RETURN FNRead(Record)
5680 ! *
5700 ! *
5720 ! * Print sector on printer
5740 ! *
5760 OPEN "PR:" AS FILE 4
5780 ; #4 'Source :';Source$,,'Sector' Record
5800 ; #4 : ; #4
5820 ; #4 MID$(Conv$,201,838)
5840 ; #4
5860 CLOSE 4
5880 RETURN 0
5900 ! *
5920 ! * Print out referense sector
5940 ! *
5960 FOR I=0 TO 23
5980 ; CUR(I,40) MID$(Conv$,201+35*I,33);
6000 NEXT I
6020 ; CUR(Recy,Recx+40)+" Rec"+CUR(Recy+1,Recx+40);
6040 ; USING "#####";-(Record AND 32768)*2.+Record;
6060 ; CUR(Erby,Erbx+40)+" Err"+CUR(Erby+1,Erbx+40);
6080 ; USING "#####";PEEK(-747)
6100 RETURN 0
6120 ! *
6140 ! * Get new input device/filename
6160 ! *
6180 RETURN 0
6200 FNEND
6220 ! ********************************
6240 ! *
6260 ! * Read a record to buffer
6280 ! *
6300 DEF FNRead(Rec)
6320 Errc=0
6340 Record=Rec
6360 IF Source=Device THEN 6640
6380 Pos=6
6400 POSIT #1,253.*Rec
6420 ON ERROR GOTO 6540
6440 GET #1 Dummy$
6460 Buffer$=Q0$
6480 ON ERROR GOTO
6500 RETURN 0
6520 ! *
6540 IF PEEK(-747)=0 THEN POKE -747,ERRCODE
6560 RESUME 6480
6580 ! *
6600 ! * Read physical
6620 ! *
6640 ! IF Devicenb=29 THEN POKE -747,CALL(Ramrd,Rec) ELSE Q7=CALL(24678,Rec)
6660 Q7=CALL(24678,Rec)
6680 Root=PEEK2(VAROOT(Q0$)+2)
6700 POKE VAROOT(Q0$)+2,62720 AND 255,62720/256
6720 Buffer$=Q0$
6740 POKE VAROOT(Q0$)+2,Root AND 255,Root/256
6760 Pos=0
6780 RETURN 0
6800 ! *
6820 FNEND
6840 ! ********************************
6860 ! *
6880 ! * Edit buffer
6900 ! *
6920 DEF FNEdit
6940 Edit=-1
6960 Mode=Hexmode
6980 Ecmd$=''
7000 ! *
7020 WHILE Ecmd$<>Pf8$
7040 Q7=CALL(Codestart,Buffer)
7060 Q7=FNListbuffer
7080 Y=Pos/32
7100 X=MOD(Pos,32)
7120 IF Mode=Hexmode THEN Y=8+Pos/32 : X=MOD(Pos,32) ELSE Y=Pos/64 : X=MOD(Pos,64)/2
7140 IF X>=16 THEN X=X+1
7160 ; CUR(Y,X);
7180 GET Ecmd$
7200 Q7=FNEditcmd
7220 WEND
7240 ! *
7260 Edit=0
7280 RETURN 0
7300 ! *
7320 FNEND
7340 ! ********************************
7360 ! *
7380 ! * List buffer on screen
7400 ! *
7420 DEF FNListbuffer
7440 Q7=CALL(Codestart,Buffer)
7460 ; CUR(0,0) MID$(Conv$,201,838);
7480 ; CUR(Recy,Recx)+" Rec"+CUR(Recy+1,Recx);
7500 ; USING "#####";-(Record AND 32768)*2.+Record;
7520 ; CUR(Rety,Retx)+" Ret"+CUR(Rety+1,Retx);
7540 ; USING "#####" 3-PEEK(-744);
7560 ; CUR(Erby,Erbx)+" Err"+CUR(Erby+1,Erbx);
7580 ; USING "#####" PEEK(-747);
7600 IF Errc THEN ; CUR(Erby+2,Erbx); : ; USING '#####' Errc; ELSE ; CUR(Erby+2,Erbx) ' ';
7620 IF Edit ; USING CUR(Posy,Posx)+" Pos"+CUR(Posy+1,Posx)+"#####" Pos/2; ELSE ; CUR(Posy,Posx) " " : ; CUR(Posy+1,Posx) " ";
7640 IF Edit AND Insert THEN ; CUR(Mesy,Mesx) "Insert"; ELSE ; CUR(Mesy,Mesx) " ";
7660 IF Edit=0 AND PEEK(-747) OR Errc THEN ; CHR$(7);
7680 ; CUR(Cmdy,Cmdx) "> ";CUR(Cmdy,Cmdx+1);
7700 IF Edit THEN ; "Edit";
7720 RETURN 0
7740 ! *
7760 FNEND
7780 ! *********************************
7800 ! *
7820 ! * Edit command executor
7840 ! *
7860 DEF FNEditcmd
7880 ON INSTR(1,Ecmds$,Ecmd$)+1 GOTO 7900,7920,7940,7960,7980,8000,8020,8040,8060,8080,8100
7900 IF Insert THEN RETURN FNInsert ELSE RETURN FNChange
7920 IF Insert THEN Insert=0 : ; CUR(Mesy,Mesx) " "; : RETURN 0 ELSE RETURN FNSetinsert
7940 RETURN 0
7960 RETURN FNDelete
7980 IF Mode=Ascmode THEN Mode=Hexmode : RETURN 0 ELSE Mode=Ascmode : Pos=Pos AND -2 : RETURN 0
8000 FOR I=0 TO 31 : Q7=FNBack : NEXT I : RETURN 0
8020 RETURN FNHelp
8040 FOR I=0 TO 31 : Q7=FNForw : NEXT I : RETURN 0
8060 Insert=0 : RETURN 0
8080 RETURN FNBack
8100 RETURN FNForw
8120 ! *
8140 FNEND
8160 ! *********************************
8180 ! *
8200 ! * Delete next byte in buffer
8220 ! *
8240 DEF FNDelete
8260 Pos=Pos AND -2
8280 Buffer$=LEFT$(Buffer$,Pos/2)+RIGHT$(Buffer$,Pos/2+2)
8300 IF LEN(Buffer$)=255 THEN Buffer$=Buffer$+CHR$(0)
8320 RETURN 0
8340 ! *
8360 FNEND
8380 ! *********************************
8400 ! *
8420 ! * Position backwards on step
8440 ! *
8460 DEF FNBack
8480 Pos=Pos-1+(Mode=Ascmode)
8500 IF Pos<0 THEN IF Mode=Hexmode THEN Pos=511 ELSE Pos=510
8520 RETURN 0
8540 ! *
8560 FNEND
8580 ! *********************************
8600 ! *
8620 ! * Position forward one step
8640 ! *
8660 DEF FNForw
8680 Pos=Pos+1-(Mode=Ascmode)
8700 IF Pos>=512 THEN Pos=0
8720 RETURN 0
8740 ! *
8760 FNEND
8780 ! ********************************
8800 ! *
8820 ! * Init insert mode
8840 ! *
8860 DEF FNSetinsert
8880 Insert=-1
8900 Pos=Pos AND -2
8920 RETURN 0
8940 FNEND
8960 ! ********************************
8980 ! *
9000 ! * Insert a character intotext
9020 ! *
9040 DEF FNInsert
9060 ON ERROR GOTO 9220
9080 IF MOD(Pos,2)=0 THEN Buffer$=LEFT$(Buffer$,Pos/2)+CHR$(0)+RIGHT$(Buffer$,Pos/2+1)
9100 ON ERROR GOTO
9120 IF FNChange THEN RETURN FNDelete
9180 RETURN 0
9200 ! *
9220 Buffer$=LEFT$(Buffer$,LEN(Buffer$)-1)
9240 RESUME 9080
9260 FNEND
9280 ! *********************************
9300 ! *
9320 ! * Change one character
9340 ! *
9360 DEF FNChange
9380 IF Mode=Hexmode THEN 9460
9400 MID$(Buffer$,Pos/2+1,1)=Ecmd$
9420 RETURN FNForw
9440 ! *
9460 Numb=ASCII(Ecmd$)-48
9480 IF Numb<0 OR Numb>9 Numb=(Numb AND -33)-7 : IF Numb<10 OR Numb>15 THEN 9600
9500 Oldnumb=ASCII(MID$(Buffer$,Pos/2+1,1))
9520 IF MOD(Pos,2)=0 THEN MID$(Buffer$,Pos/2+1,1)=CHR$(Numb*16+(Oldnumb AND 15)) ELSE MID$(Buffer$,Pos/2+1,1)=CHR$(Numb+(Oldnumb AND 240))
9540 ; CUR(Erry,Errx) " ";
9560 RETURN FNForw
9580 ! *
9600 ; CUR(Erry,Errx) "Bad nb";CHR$(7) : RETURN -1
9620 ! *
9640 FNEND
9660 ! ********************************
9680 ! *
9700 ! * Some help texts
9720 ! *
9740 DEF FNHelp
9760 ; CHR$(12) Signon$
9780 ; : ; 'Edit commands:'
9800 ; 'Insert mode PF1 PF2'
9820 ; 'Delete char PF3 PF4 Ascii/Hex mode'
9840 ; 'Up one line PF5 PF6 Help'
9860 ; 'Down one line PF7 PF8 Exit edit mode'
9880 ;
9900 ; 'Press char to continue..';
9920 GET Dummy$
9940 ; CHR$(12);
9960 RETURN 0
9980 ! *
10000 FNEND
10020 ! *********************************
10040 ! *
10060 ! * Clead screen
10080 ! *
10100 DEF FNClearscr
10120 FOR I=0 TO 23
10140 ; CUR(I,0) SPACE$(40);
10160 NEXT I
10180 ; CUR(0,0) Signon$
10200 RETURN 0
10220 FNEND
10240 ! ******************************
10260 ! *
10280 ! * All initialisations
10300 ! *
10320 DEF FNInitialize
10340 File=0
10360 Device=-1
10380 ! *
10400 Errx=34
10420 Erry=12
10440 ! *
10460 Erbx=34
10480 Erby=3
10500 ! *
10520 Posx=34
10540 Posy=9
10560 ! *
10580 Mesx=34
10600 Mesy=15
10620 ! *
10640 Recx=34
10660 Recy=0
10680 ! *
10700 Retx=34
10720 Rety=6
10740 ! *
10760 Cmdx=34
10780 Cmdy=22
10800 ! *
10820 Ascmode=0
10840 Hexmode=-1
10860 ! *
10880 Pf1$=CHR$(192)
10900 Pf2$=CHR$(193)
10920 Pf3$=CHR$(194)
10940 Pf4$=CHR$(195)
10960 Pf5$=CHR$(196)
10980 Pf6$=CHR$(197)
11000 Pf7$=CHR$(198)
11020 Pf8$=CHR$(199)
11040 Ecmds$=Pf1$+Pf2$+Pf3$+Pf4$+Pf5$+Pf6$+Pf7$+Pf8$+CHR$(8,9)
11060 Cmds$=CHR$(13)+"EeGgHhLlRrSsWw-PpFf"+Pf8$
11080 Signon$='** Dump utility **'
11100 Mxstore=15
11120 DIM Conv$=1040,Buffer$=512,Q0$=256,Ecmd$=1,Secname$(Mxstore)=16,Secowner$(Mxstore)=32,Secbuffer$(Mxstore)=LEN(Buffer$)
11140 Conv$=SPACE$(1040)
11160 Q0$=SPACE$(256)
11180 RESTORE 11440
11200 ! *
11220 FOR I=1 TO 120
11240 READ A
11260 MID$(Conv$,I,1)=CHR$(A)
11280 NEXT I
11300 ! *
11320 Codestart=VARPTR(Conv$)
11340 Buffer=VARPTR(Buffer$)
11360 RETURN 0
11380 ! *
11400 ! * Binary to ASCII conversion code
11420 ! *
11440 DATA 213,17,200,0,25,209,6,0,26,230
11460 DATA 127,254,32,62,46,56,1,26,119,19
11480 DATA 35,5,62,31,160,32,8,54,13,35
11500 DATA 54,10,35,24,8,62,15,160,32,3
11520 DATA 54,32,35,4,16,218,6,0,21,26
11540 DATA 15,15,15,15,230,15,198,48,254,58
11560 DATA 56,2,198,7,119,35,26,19,230,15
11580 DATA 198,48,254,58,56,2,198,7,119,35
11600 DATA 5,62,15,160,32,8,54,13,35,54
11620 DATA 10,35,24,8,62,7,160,32,3,54
11640 DATA 32,35,4,16,200,201,252,201,33,154
11660 DATA 202,205,6,192,33,176,202,55,201,58
11680 FNEND