1 REM Ins{nd av Kristoffer Eriksson <5357>    1988-05-13 15.18.46 (KERMIT)
1000 ! * DUMP.BAC
1001 ! [ndrad s} att man kan l{sa CRC och AM fel p} sektor  Okt-83/TC
1002 ! * Klarar alla device i DOSNET / BJ, LDAB / 83-12-01
1003 ! * B{ttre hardcopy / BJ / LDAB / 84-03-26
1020 ; '** Dump utility  1982-05-19 **'
1050 ; '   Copyright Dataindustrier AB'
1060 ; 
1080 ! **********************************
1100 ! *
1120 EXTEND 
1140 INTEGER 
1160 ! FNEND
1180 Q7=FNInitialize
1190 ; 'Command "H" will display some HELP'
1195 ; 
1200 INPUT 'Input device/filename : 'Source$
1209 ! *
1210 WHILE LEN(Source$)<>0
1220   IF INSTR(1,Source$,':')=LEN(Source$) THEN 1620
1240   ! *
1260   ! *  Filename founde
1280   ! *
1300   Source=File
1340   Lfn=16
1360   ! *
1380   WHILE PEEK(-704+1+Lfn)<>255
1400     Lfn=Lfn+16
1420   WEND 
1440   ! *
1450   ON ERROR GOTO 1580
1460   OPEN Source$ AS FILE 1
1470   Devicenb=PEEK(-767)
1480   GET #1 Dummy$
1490   ON ERROR GOTO 
1500   POKE VAROOT(Q0$)+2,(62720+16*Lfn) AND 255,(62720+16*Lfn)/256
1520   Buffer$=Q0$
1540   GOTO 2180
1560   ! *
1580   ; 'Error' ERRCODE 'during fileopening'
1600   RESUME 1200
1620   ! *
1640   ! *  Device found
1660   ! *
1680   Source=Device
1700   RESTORE 1960
1720   ! *
1740   FOR I=1 TO 37
1760     READ Devicenb,D$
1780     IF D$=Source$ THEN 1860
1800   NEXT I 
1820   ! *
1840   ; "Device not found!" CHR$(7) : GOTO 1200
1860   POKE VAROOT(Q0$)+2,62720 AND 255,62720/256
1880   POKE -767,Devicenb
1900   Q7=FNRead(0)
1940   ! *
1960   DATA 255,'    '
1962   DATA 4,'HD0:',4,'hd0:'
1964   DATA 5,'HD1:',5,'hd1:'
1966   DATA 6,'HD2:',6,'hd2:'
1968   DATA 7,'HD3:',7,'hd3:'
1970   DATA 16,'SF0:',16,'sf0:'
1972   DATA 17,'SF1:',17,'sf1:'
1974   DATA 18,'SF2:',18,'sf2:'
1976   DATA 19,'SF3:',19,'sf3:'
1978   DATA 8,'MF0:',8,'mf0:'
1980   DATA 9,'MF1:',9,'mf1:'
1982   DATA 10,'MF2:',10,'mf2:'
1983   DATA 11,'MF3:',11,'mf3:'
1984   DATA 12,'MO0:',12,'mo0:'
1986   DATA 13,'MO1:',13,'mo1:'
1988   DATA 14,'MO2:',14,'mo2:'
1990   DATA 15,'MO3:',15,'mo3:'
1991   DATA 4,'PM0:',4,'pm0:'
1992   DATA 29,'RAM:',29,'ram:'
2180   ! *
2200   ! *  Main command loop
2220   ! *
2230   ; CHR$(12);
2240   Record=0
2250   ! *
2260   WHILE Cmd$<>Pf8$
2280     Q7=FNListbuffer
2300     GET Cmd$
2320     ; Cmd$;
2340     Q7=FNCmd
2360   WEND 
2364   ! *
2366   Cmd$=''
2367   CLOSE 1
2368   ; CHR$(12) ' - - > ABC dump program < - -'
2370   ; : ; 
2372   INPUT 'Input device/filename : 'Source$
2376 WEND 
2380 ! *
2384 ! * FNEND
2388 ! ********************************
2400 ! *
2420 ! *  Execute a command
2440 ! *
2460 DEF FNCmd
2480   ON INSTR(1,Cmds$,Cmd$)+1 GOTO 2560,2860,2960,2960,3020,3020,3360,3360,3700,3700,4080,4080,4180,4180,4610,4610,4642,4652,4652,4710,2541,2541
2500   ! *
2520   ! *  Command not found or number
2540   ! *
2541   Z=FNOut+FNPtr : RETURN 0
2560   ON ERROR GOTO 2800
2580   Rec=0
2600   ! *
2620   WHILE Cmd$<>CHR$(13)
2640     Rec=Rec*10+VAL(Cmd$)
2660     GET Cmd$
2680     ; Cmd$;
2700   WEND 
2720   ! *
2740   ON ERROR GOTO 
2760   RETURN FNRead(Rec)
2780   ! *
2800   ; CHR$(7);
2820   RESUME 2840
2840   RETURN 0
2860   ! *
2880   ! *  Read next record
2900   ! *
2920   RETURN FNRead(Record+1)
2940   ! *
2960   ! *  Edit command
2980   ! *
3000   RETURN FNEdit
3020   ! *
3040   ! * Get old sector
3060   ! *
3080   ; CHR$(12) ' - - > ABC dump program < - -'
3100   ; : ; 
3120   INPUT 'Name : ';Secname$
3140   IF LEN(Secname$)=0 THEN RETURN 0
3160   ! *
3180   FOR I=0 TO Mxstore
3200     IF Secname$=Secname$(I) THEN 3300
3220   NEXT I 
3240   ! *
3260   ; 'Name not found. Try library'
3280   GOTO 3120
3300   Buffer$=Secbuffer$(I)
3320   RETURN 0
3340   ! *
3360   ! *  Some help texts
3380   ! *
3400   ; CHR$(12) ' - - > ABC dump program < - -'
3420   ; : ; 
3440   ; '<CR>  Display next record'
3450   ; '-     Backwards one record'
3460   ; 'E     Edit present record'
3480   ; 'G     Get old sector'
3500   ; 'H     This help text'
3520   ; 'L     Library listing'
3540   ; 'R     Read RIB'
3560   ; 'S     Save present sector'
3580   ; 'W     Write sector on disk'
3585   ; 'P     Print sector on printer'
3586   ; 'C     Read sector with CRC or AM error'
3600   ; 
3620   ; 'Press any char to continue :';
3640   GET Cmd$
3650   PRINT CHR$(12)
3660   RETURN 0
3680   ! *
3700   ! *  Library listing
3720   ! *
3740   ; CHR$(12) ' - - > ABC dump program < - -'
3760   ; : ; 
3780   Libcount=0
3785   ! *
3800   FOR I=0 TO Mxstore
3820     IF Secname$(I)='' THEN 3920
3840     IF Libcount=0 THEN ; 'Name','Owner','    Rec' : ; STRING$(39,ASCII('='))
3860     Libcount=Libcount+1
3880     ; Secname$(I),
3900     ; Secowner$(I)
3920   NEXT I 
3940   ! *
3960   IF Libcount=0 THEN ; "Library is empty"
3980   ; 
4000   ; 'Press any char to continue :';
4020   GET Cmd$
4030   ; CHR$(12);
4040   RETURN 0
4060   ! *
4080   ! *  Read rib
4100   ! *
4120   IF Source=Device THEN ; CHR$(7); : RETURN 0
4130   Source=Device
4140   Q7=FNRead(PEEK2(-704+8+Lfn))
4145   Source=File
4147   Record=-1
4149   RETURN 0
4160   ! *
4180   ! *  Save sector in mem
4200   ! *
4220   ; CHR$(12) ' - - > ABC dump program < - -'
4240   ; : ; 
4260   INPUT 'Name : ';Secname$
4280   ! *
4300   FOR I=0 TO Mxstore
4320     IF Secname$=Secname$(I) THEN 4520
4340   NEXT I 
4360   ! *
4380   FOR I=0 TO Mxstore
4400     IF LEN(Secname$(I))=0 THEN 4520
4420   NEXT I 
4440   ; 'Directory full';CHR$(7);
4460   FOR I=0 TO 1000 : NEXT I 
4480   RETURN 0
4500   ! *
4520   Secname$(I)=Secname$
4540   Secowner$(I)=LEFT$(Source$+SPACE$(18),18)+NUM$(Record)
4560   Secbuffer$(I)=Buffer$
4580   RETURN 0
4600   ! *
4610   ! *  Write sector on disk
4620   ! *
4622   IF Source=File THEN POSIT #1. Record*253. : PUT #1. MID$(Buffer$,4,253) : RETURN 0
4624   POKE -767,Devicenb
4625   Q0$=LEFT$(Buffer$,256)
4630   Q7=CALL(24675,Record)
4640   RETURN 0
4641   ! *
4642   ! *  Backwards one record
4643   ! *
4644   Record=Record-1
4645   IF Source=Device THEN 4648
4646   IF Record=-1 THEN GOTO 4130 ! Rib
4647   IF Record<0 THEN Record=Record+1 : ; CHR$(7); : RETURN 0
4648   RETURN FNRead(Record)
4650   ! *
4651   ! *
4652   ! *  Print sector on printer
4653   ! *
4654   Q7=FNPrintbuf(Source$,Sector,MID$(Conv$,201,838))
4696   RETURN 0
4697   ! *
4700   ! *
4710   ! *  Get new input device/file
4720   ! *
4730   RETURN 0
5000 FNEND 
5020 ! ********************************
5040 ! *
5060 ! *  Read a record to buffer
5080 ! *
5100 DEF FNRead(Rec)
5110   Errc=0
5130   Record=Rec
5140   IF Source=Device THEN 5221
5145   Pos=6
5150   POSIT #1,253.*Rec
5155   ON ERROR GOTO 5204
5160   GET #1 Dummy$
5170   Buffer$=Q0$
5180   ON ERROR GOTO 
5200   RETURN 0
5202   ! *
5204   IF PEEK(-747)=0 THEN POKE -747,ERRCODE
5206   RESUME 5180
5218   ! *
5219   ! *  Read physical
5220   ! *
5221   Q7=CALL(24678,Rec)
5223   Root=PEEK2(VAROOT(Q0$)+2)
5224   POKE VAROOT(Q0$)+2,62720 AND 255,62720/256
5225   Buffer$=Q0$
5226   POKE VAROOT(Q0$)+2,Root AND 255,Root/256
5228   Pos=0
5230   RETURN 0
5239   ! *
5240 FNEND 
5260 ! ********************************
5280 ! *
5300 ! *  Edit buffer
5320 ! *
5340 DEF FNEdit
5360   ; CUR(Cmdy,Cmdx+1) "EDIT";
5380   Edit=-1
5400   Mode=Hexmode
5420   Ecmd$=''
5440   ! *
5460   WHILE Ecmd$<>Pf8$
5480     Q7=CALL(Codestart,Buffer)
5500     Q7=FNListbuffer
5520     Y=Pos/32
5540     X=MOD(Pos,32)
5560     IF Mode=Hexmode THEN Y=8+Pos/32 : X=MOD(Pos,32) ELSE Y=Pos/64 : X=MOD(Pos,64)/2
5580     IF X>=16 THEN X=X+1
5600     ; CUR(Y,X);
5620     GET Ecmd$
5640     Q7=FNEditcmd
5660   WEND 
5680   ! *
5700   Edit=0
5720   RETURN 0
5740   ! *
5760 FNEND 
5780 ! **********************************
5800 ! *
5820 ! *  List buffer on screen
5840 ! *
5860 DEF FNListbuffer
5880   Q7=CALL(Codestart,Buffer)
5900   ; CUR(0,0) MID$(Conv$,201,838);
5920   ; CUR(Recy,Recx)+"  Rec"+CUR(Recy+1,Recx);
5940   ; USING "#####" FNUnsign.(Record);
5960   ; CUR(Rety,Retx)+"  Ret"+CUR(Rety+1,Retx);
5980   ; USING "#####" 3-PEEK(-744);
6000   ; CUR(Erby,Erbx)+"  Err"+CUR(Erby+1,Erbx);
6020   ; USING "#####" PEEK(-747);
6030   IF Errc THEN ; CUR(Erby+2,Erbx); : ; USING '#####' Errc; ELSE ; CUR(Erby+2,Erbx) '     ';
6040   IF Edit ; USING CUR(Posy,Posx)+"  Pos"+CUR(Posy+1,Posx)+"#####" Pos/2; ELSE ; CUR(Posy,Posx) "     " : ; CUR(Posy+1,Posx) "     ";
6060   IF Edit AND Insert THEN ; CUR(Mesy,Mesx) "Insert"; ELSE ; CUR(Mesy,Mesx) "      ";
6070   IF Edit=0 AND PEEK(-747) OR Errc THEN ; CHR$(7);
6080   ; CUR(Cmdy,Cmdx) ">     ";CUR(Cmdy,Cmdx+1);
6100   IF Edit THEN ; "Edit";
6120   RETURN 0
6140   ! *
6160 FNEND 
6180 ! *********************************
6200 ! *
6220 ! *  Edit command executor
6240 ! *
6260 DEF FNEditcmd
6280   ON INSTR(1,Ecmds$,Ecmd$)+1 GOTO 6300,6320,6340,6360,6380,6400,6420,6440,6460,6480,6500
6300   IF Insert THEN RETURN FNInsert ELSE RETURN FNChange
6320   IF Insert THEN Insert=0 : ; CUR(Mesy,Mesx) "      "; : RETURN 0 ELSE RETURN FNSetinsert
6340   RETURN 0
6360   RETURN FNDelete
6380   IF Mode=Ascmode THEN Mode=Hexmode : RETURN 0 ELSE Mode=Ascmode : Pos=Pos AND -2 : RETURN 0
6400   FOR I=0 TO 31 : Q7=FNBack : NEXT I : RETURN 0
6420   RETURN FNHelp
6440   FOR I=0 TO 31 : Q7=FNForw : NEXT I : RETURN 0
6460   Insert=0 : RETURN 0
6480   RETURN FNBack
6500   RETURN FNForw
6520   ! *
6540 FNEND 
6560 ! *********************************
6580 ! *
6600 ! *  Delete next byte in buffer
6620 ! *
6640 DEF FNDelete
6660   Pos=Pos AND -2
6680   Buffer$=LEFT$(Buffer$,Pos/2)+RIGHT$(Buffer$,Pos/2+2)
6700   IF LEN(Buffer$)=255 THEN Buffer$=Buffer$+CHR$(0)
6720   RETURN 0
6740   ! *
6760 FNEND 
6780 ! *********************************
6800 ! *
6820 ! *  Position backwards on step
6840 ! *
6860 DEF FNBack
6880   Pos=Pos-1+(Mode=Ascmode)
6900   IF Pos<0 THEN IF Mode=Hexmode THEN Pos=511 ELSE Pos=510
6920   RETURN 0
6940   ! *
6960 FNEND 
6980 ! *********************************
7000 ! *
7020 ! *  Position forward one step
7040 ! *
7060 DEF FNForw
7080   Pos=Pos+1-(Mode=Ascmode)
7100   IF Pos>=512 THEN Pos=0
7120   RETURN 0
7140   ! *
7160 FNEND 
7180 ! ********************************
7200 ! *
7220 ! *  Init insert mode
7240 ! *
7260 DEF FNSetinsert
7280   Insert=-1
7300   Pos=Pos AND -2
7320   RETURN 0
7340 FNEND 
7360 ! ********************************
7380 ! *
7400 ! *  Insert a character intotext
7420 ! *
7440 DEF FNInsert
7460   ON ERROR GOTO 7620
7480   IF MOD(Pos,2)=0 THEN Buffer$=LEFT$(Buffer$,Pos/2)+CHR$(0)+RIGHT$(Buffer$,Pos/2+1)
7500   ON ERROR GOTO 
7520   IF FNChange THEN RETURN FNDelete
7540   IF Mode=Ascmode THEN RETURN FNBack
7560   IF MOD(Pos,2)=0 THEN Q7=FNBack : Q7=FNBack
7580   RETURN 0
7600   ! *
7620   Buffer$=LEFT$(Buffer$,LEN(Buffer$)-1)
7640   RESUME 7480
7660 FNEND 
7680 ! *********************************
7700 ! *
7720 ! *  Change one character
7740 ! *
7760 DEF FNChange
7780   IF Mode=Hexmode THEN 7860
7800   MID$(Buffer$,Pos/2+1,1)=Ecmd$
7820   RETURN FNForw
7840   ! *
7860   Numb=ASCII(Ecmd$)-48
7880   IF Numb<0 OR Numb>9 Numb=(Numb AND -33)-7 : IF Numb<10 OR Numb>15 THEN 8000
7900   Oldnumb=ASCII(MID$(Buffer$,Pos/2+1,1))
7920   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))
7940   ; CUR(Erry,Errx) "      ";
7960   RETURN FNForw
7980   ! *
8000   ; CUR(Erry,Errx) "Bad nb";CHR$(7) : RETURN -1
8020   ! *
8040 FNEND 
8060 ! ********************************
8080 ! *
8100 ! *  Some help texts
8120 ! *
8140 DEF FNHelp
8160   ; CHR$(12) ' - - > ABC dump program < - -'
8180   ; : ; 'Edit commands:'
8200   ; 'Insert mode   PF1  PF2'
8220   ; 'Delete char   PF3  PF4  Ascii/Hex mode'
8240   ; 'Up one line   PF5  PF6  Help'
8260   ; 'Down one line PF7  PF8  Exit edit mode'
8280   ; 
8300   ; 'Press char to continue..';
8320   GET Dummy$
8340   ; CHR$(12);
8360   RETURN 0
8380   ! *
8400 FNEND 
8405 DEF FNOut LOCAL Cs,I
8410   ! *****************************
8420   ! *
8430   ! * Read one sector with OUT and INP 
8440   ! * use only if CRC or AM error
8450   ! *
8460   Cs=PEEK(65332)
8470   IF Cs=0 THEN INPUT 'Cardselct #: 'Cs
8480   OUT 1,Cs,2,0
8490   WHILE INP(1) AND 2
8500   WEND 
8510   OUT 0,2,0,0,0,0,0,0
8520   WHILE (INP(1) AND 5)<>1
8530   WEND 
8535   WHILE I<256
8540     WHILE (INP(1) AND 5)<>1
8550     WEND 
8560     POKE 62720+I,INP(0)
8570     I=I+1
8575   WEND 
8580   RETURN 0
8590 FNEND 
8600 ! *************************
8610 ! *
8620 ! * Set some pointers
8630 ! *
8640 DEF FNPtr
8650   Root=PEEK2(VAROOT(Q0$)+2)
8660   POKE VAROOT(Q0$)+2,62720 AND 255,62720/256
8670   Buffer$=Q0$
8680   POKE VAROOT(Q0$)+2,Root AND 255,Root/256
8690   Pos=0
8700   RETURN 0
8710 FNEND 
9000 ! *
9010 DEF FNUnsign.(X)=-(X AND 32768)*2.+X 
9020 ! *
10000 ! ******************************
10020 ! *
10040 ! *  All initialisations
10060 ! *
10080 DEF FNInitialize
10100   File=0
10120   Device=-1
10140   ! *
10160   Errx=34
10180   Erry=12
10200   ! *
10220   Erbx=34
10240   Erby=3
10260   ! *
10280   Posx=34
10300   Posy=9
10320   ! *
10340   Mesx=34
10360   Mesy=15
10380   ! *
10400   Recx=34
10420   Recy=0
10440   ! *
10460   Retx=34
10480   Rety=6
10500   ! *
10520   Cmdx=34
10540   Cmdy=22
10560   ! *
10580   Ascmode=0
10600   Hexmode=-1
10620   ! *
10640   Pf1$=CHR$(192)
10660   Pf2$=CHR$(193)
10680   Pf3$=CHR$(194)
10700   Pf4$=CHR$(195)
10720   Pf5$=CHR$(196)
10740   Pf6$=CHR$(197)
10760   Pf7$=CHR$(198)
10780   Pf8$=CHR$(199)
10800   Ecmds$=Pf1$+Pf2$+Pf3$+Pf4$+Pf5$+Pf6$+Pf7$+Pf8$+CHR$(8,9)
10820   Cmds$=CHR$(13)+"EeGgHhLlRrSsWw-Pp"+Pf8$+'Cc'
10830   Mxstore=15
10840   DIM Conv$=1040,Buffer$=512,Q0$=256,Ecmd$=1,Secname$(Mxstore)=16,Secowner$(Mxstore)=32,Secbuffer$(Mxstore)=LEN(Buffer$)
10860   Conv$=SPACE$(1040)
10880   Q0$=SPACE$(256)
11000   RESTORE 11200
11020   ! *
11040   FOR I=1 TO 120
11060     READ A
11080     MID$(Conv$,I,1)=CHR$(A)
11100   NEXT I 
11120   ! *
11130   Codestart=VARPTR(Conv$)
11140   RESTORE 30001
11141   FOR I=1 TO 47
11142     READ A
11143     Ramrd$=Ramrd$+CHR$(A)
11144   NEXT I 
11145   Ramrd=VARPTR(Ramrd$)
11146   RESTORE 32030
11147   FOR I=1 TO 47
11148     READ A
11149     Ramwr$=Ramwr$+CHR$(A)
11150   NEXT I 
11151   Ramwr=VARPTR(Ramwr$)
11160   Buffer=VARPTR(Buffer$)
11180   RETURN 0
11200   DATA 213,17,200,0,25,209,6,0,26,230
11220   DATA 127,254,32,62,46,56,1,26,119,19
11240   DATA 35,5,62,31,160,32,8,54,13,35
11260   DATA 54,10,35,24,8,62,15,160,32,3
11280   DATA 54,32,35,4,16,218,6,0,21,26
11300   DATA 15,15,15,15,230,15,198,48,254,58
11320   DATA 56,2,198,7,119,35,26,19,230,15
11340   DATA 198,48,254,58,56,2,198,7,119,35
11360   DATA 5,62,15,160,32,8,54,13,35,54
11380   DATA 10,35,24,8,62,7,160,32,3,54
11400   DATA 32,35,4,16,200,201,252,201,33,154
11420   DATA 202,205,6,192,33,176,202,55,201,58
29990   ! *
29991   ! *  RAM: read routine
29999   ! *
30001   DATA 243,62,1,211,49,58,0,0,254,195
30002   DATA 40,26,62,52,211,1,62,1,211,0
30003   DATA 58,0,0,254,195,62,128,32,12,205
30004   DATA 102,0,111,175,211,0,251,201,205,102
30005   DATA 0,111,175,211,49,251,201
32000   ! *
32010   ! *  RAM: write routine
32020   ! *
32030   DATA 243,62,1,211,49,58,0,0,254,195
32040   DATA 40,26,62,52,211,1,62,1,211,0
32050   DATA 58,0,0,254,195,62,128,32,12,205
32060   DATA 99,0,111,175,211,0,251,201,205,99
32070   DATA 0,111,175,211,49,251,201
32080 FNEND 
32090 ! *********************************
32100 ! *
32110 ! * Print buffer on printer
32120 ! *
32130 DEF FNPrintbuf(Source$,Sector,Text$) LOCAL Pos,C
32140   PREPARE 'pr:' AS FILE 4
32150   ; #4,'Source :' Source$,,'Sector' Sector
32160   ; #4
32170   ; #4
32175   Pos=1
32180   WHILE Pos<=LEN(Text$)
32190     C=ASCII(MID$(Text$,Pos,1))
32200     IF (C>31 AND C<127) OR C=13 OR C=10 THEN ; #4,CHR$(C); ELSE ; #4,'.';
32210     Pos=Pos+1
32220   WEND 
32230   CLOSE 4
32240   RETURN 0
32250   ! *
32260 FNEND