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   ; '<CR>  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