fbad:
    proc options(main);

/* ---------------------------------------------------------------- */
/* This program does the standard findbad function by getting all   */
/* the disk parameters then doing reads to test the sectors.        */
/*								    */
/*	Written by     Richard Holmes    23-11-84		    */
/* 	Last Update    Richard Holmes    14-12-84		    */
/* ---------------------------------------------------------------- */

%replace true by '1'b,
	false by '0'b,
	maxer by 1000;			/* Maximum error number		*/

/* -------------------------- */
/* External assembler modules */
/* as well as DPB declaration */
/* -------------------------- */

%include 'pliutil.dcl';

/* ------------------------- */
/* General purpose variables */
/* ------------------------- */

dcl
    buffer(1:1024)	bit(8),
    extent		bin(15),	/* The extent number    */
    cur_rec		bin(15),
    cur_sec		bin(15),	/* current sector 	*/
    cur_trk		bin(15),	/* Current track	*/
    cur_blk		bin(15);	/* Current block	*/


dcl
    dir_blk	bin(15),	/* Blocks in the directory	*/
    blk_siz	bin(15),	/* physical sectors per block	*/
    sec_siz	bin(15),	/* physical sector size in bytes*/
    sec_sec	bin(15),	/* 128 byte sectors / phys sec  */
    tot_blk	dec(8),		/* Total blocks per disk	*/
    tot_siz	dec(8),		/* Kbytes per disk		*/
    tot_trk	dec(10),	/* Tracks per disk		*/
    sec_blk	bin(15),	/* Phs sec / block    		*/
    siz_dir	bin(15),	/* records in the directory 	*/
    phs_sec	bin(15),
    phs_spt	bin(15),	/* physical sectors / trk	*/
    phs_trk	bin(15),
    log_sec	bin(15),	/* Logical sector		*/
    max_off	bin(15),	/* maximum offset allowable	*/
    i		bin(15),
    (t1,t2,t3)	dec(12,2),
    fst_blk	bin(15),	/* First block number 		*/
    lst_blk	bin(15),	/* Last block number to test    */
    rec_blk	bin(15),	/* 128 byte records per block   */
    temp	dec(8);		/* Temporary large variable     */

dcl
    dsknam	char(1),	/* Disk name to test		*/
    option	char(1);

dcl
    t_diag	bit(1),		/* track and sector diagnostics	*/
    not_dir	bit(1),		/* No directory bad sector 	*/
    m_diag	bit(1);		/* Mapping diagnostic flag	*/

/* ---------------- */
/* Error data areas */
/* ---------------- */

dcl
    errno	bin(15);	/* Number of errors */

dcl
    1 bad(0:maxer),
	2 blk	bin(15);	/* Error sector numbers */

dcl
    status	bin(15),	/* get put status 	*/
    badfil	file,		/* Bad file name 	*/
    badnam	char(14) var;

badnam = 'bad ';		/* The name. Careful here */

/* ---------------- Start ---------------- */

call setdma(addr(buffer));
t_diag = false;

get_name:
put edit('^z')(a);
put edit('**********************************')(skip(2),col(20),a);
put edit('*  SME Systems Find Bad Program  *')(skip,col(20),a);
put edit('* ---- Version 1.1 14-12-84 ---- *')(skip,col(20),a);
put edit('**********************************')(skip,col(20),a);
   
put edit('This program will read your disk and look for BAD SECTORS')
    (skip(3),col(4),a);
put edit('then  it  will allocate all these  to a file so that they ')
    (skip,col(4),a);
put edit('are hidden from the operating system.')
    (skip,col(4),a);

put edit('Enter the DISK DRIVE to FINDBAD on : ')(skip(2),col(4),a);
get edit(dsknam)(a);
if (dsknam = ' ') then
    stop;
dsknam = caps(dsknam);
if (dsknam < 'A' ! dsknam > 'P') then
    begin;
    put edit('ERROR = Poor Drive name')(skip(2),a);
    goto get_name;
    end;

xlt = setdsk(dsknam);				/* Get translation address */
status = getdpb(addr(dpb),dsknam);		/* Load  the DPB from disk */
if (status ^= 0) then
    begin;
    put edit('ERROR - Disk Not Found')(skip(2),a);
    goto get_name;
    end;

blk_siz = divide(dpb.blm + 1,8,15);			/* Block size in Kb */
tot_siz = blk_siz + (dpb.dsm * blk_siz);		/* total disk size   */
tot_blk = dpb.dsm + 1;					/* total blocks/disk */
tot_trk = ceil(decimal(dpb.off) + (decimal(tot_siz) * 8 / decimal(dpb.spt)));
sec_siz = (dpb.phm * 128) + 128;			/* byte sector size  */
sec_sec = sec_siz / 128;              			/* 128 records/sector*/
sec_blk = (blk_siz * 1024)/(sec_siz);			/* phs_sec / block   */
siz_dir = 1 + (dpb.drm)/4;		/* 128 byte sectors in directory*/
max_off = 4 * sec_sec;			/* directory items in a sector	     */
rec_blk = sec_blk * sec_sec;
dir_blk = divide(siz_dir,rec_blk,15);
phs_spt = divide(dpb.spt,sec_sec,15);			/* Physical spt	     */

put edit('^z')(a);
put edit('---------------------------')(skip(2),col(20),a);
put edit('Disk Parameters for drive ',dsknam)(skip,col(20),a,a);
put edit('---------------------------')(skip,col(20),a);
put edit('       Disk Size = ',tot_siz,' k')(skip,col(20),a,p'ZZZZZ9',a);
put edit('Number of Tracks = ',tot_trk)(skip,col(20),a,p'ZZZZZ9');
put edit('     Sector Size = ',sec_siz,' Bytes')(skip,col(20),a,p'ZZZZZ9',a);
put edit('      Block Size = ',blk_siz,' k')(skip,col(20),a,p'ZZZZZ9',a);
put edit('  Records/sector = ',sec_sec)(skip,col(20),a,p'ZZZZZ9');
put edit('Directory Blocks = ',dir_blk)(skip,col(20),a,p'ZZZZZ9');
put edit('    Physical SPT = ',phs_spt)(skip,col(20),a,p'ZZZZZ9');
put edit('---------------------------')(skip,col(20),a);

put edit('Enter FIRST BLOCK number to test : 0^h')(skip(2),col(10),a);
get edit(fst_blk)(a);
if (fst_blk < 0) then
    fst_blk = 0;

put edit(' Enter LAST BLOCK number to test : ',tot_blk-1,'^h^h^h^h^h')
    (skip,col(10),a,p'ZZZZ9',a);

get edit(lst_blk)(a);
if (lst_blk <= 0) then
    lst_blk = tot_blk-1;			/* Do all if asked	*/

errno = 0;
put edit('    +---------------------------------------------+')(skip(3),a);
put edit('    | Press T to toggle Track and Sector Displays |')(skip,a);
put edit('    |       Q to quit the checking                |')(skip,a);
put edit('    |---------------------------------------------|')(skip,a);
put edit('    +---------------- Testing Blocks -------------+')(skip,a);
put skip;

    do i = fst_blk to lst_blk;
    put edit('^m          Testing B = ',i)(a,p'ZZZZ9');
    call check_block(i);		/* test it */
    if (const() = true) then
        begin;
        option = caps(conin());
        if (option = 'Q') then
            goto check_end;
        if (option = 'T') then
	    if (t_diag = true) then
		t_diag = false;
	    else
	        t_diag = true;
        end;
    end;
put edit('           ------------------------------------')(skip,a);

check_end:
if (errno < 1) then
    put edit('NO BAD BLOCKS found')(skip(2),a);
else
    put edit(errno,' BAD BLOCKS found')(skip(2),p'ZZZZ9',a);

put edit('PRESS <CR> TO PROCEED')(skip(2),a);
get edit(option)(a);
if (errno < 1) then
    goto get_name;

if (errno > 0) then
    begin;
    put edit('^z')(a);
    put edit('There were ',errno,' BAD BLOCKS')(skip(2),col(15),a,p'ZZZ9',a);
    put edit('--------------------------')(skip,col(15),a);
    put edit('Display bad blocks ? ')(skip(2),a);
    get edit(option)(a);

    if (option = 'Y' ! option = 'y') then
        begin;
        put edit('---------- Bad List ----------')(skip(2),a);
            do i = 1 to errno;
            put edit('Bad sector at block ',bad(i).blk)(skip,a,p'ZZZ9');
            end;
        put edit('------------------------------')(skip,a);
        end;

    not_dir = true;			/* No bad blocks in directory YET */
        do i = 1 to errno;
        if (bad(i).blk <= dir_blk) then
            not_dir = false;		/* A bad block in the directory */
        end;

    if ((tot_siz > 256) & (not_dir = true)) then
        begin;
        put edit('Do You Want to Mark these into the Directory ? ')(skip(2),a);
        get edit(option)(a);
        if (option = 'y' ! option = 'Y') then
            begin;
	    call logdsk(dsknam);
            put edit('Erasing any EXISTING BAD marking files')(skip(2),a);
	    status = delfil(addr(badnam));
	        do while(status = 0);			/* ^= 0 = no file */
		status = delfil(addr(badnam));		/* Delete it */
		put edit('X')(a);
		end;
            put edit('Please Wait - Patching Directory ')(skip,a);
            call mark_block;
            call logdsk(dsknam);
	    call ressys();				/* Reset disk system */
            end;
        else
            put edit('O.K.')(skip,a);
        end;
    else
	put edit('CANNOT mark directories with BAD sectors or SMALL DISKS')
	    (skip,a);
    end;

put edit('PRESS <CR> TO PROCEED')(skip(2),a);
get edit(option)(a);
goto get_name;

/* ---------------------------------------------------------------- */
/* This routine must check a block on the disk by reading only the  */
/* required sectors. In the event of large sectors, only a single   */
/* read may be necessary to verify a block.			    */
/* ---------------------------------------------------------------- */

check_block:
    proc(block_no);
dcl
    i		bin(15),		/* counts sectors		*/
    t		bin(15),		/* Test number			*/
    block_no	bin(15);		/* block to be read		*/

call setdma(addr(buffer));
call deblock(block_no,log_sec,phs_trk);
phs_sec = sectrn(log_sec,xlt);
call settrk(phs_trk);

    do t = 1 to sec_blk;		/* all phys sec / block		*/
    call setsec(phs_sec);
    if (t_diag = true) then
        put edit('T ',phs_trk,'  PS ',phs_sec,'  LS ',log_sec)
	    (col(36),a,f(5),a,f(5),a,f(5)); 
    status = getsec();
    if (status ^= 0) then
        begin;
        put edit('Error at Block ',block_no)(col(36),a,p'ZZZZ9');
        put skip;
        errno = errno + 1;
        bad(errno).blk = block_no;
        if (errno > maxer) then
            stop;
        goto check_end;			/* Exit quick if an error	*/
        end;
    log_sec = log_sec + 1;		/* Next sector */
    if (log_sec >= phs_spt) then	/* logicals from 0..spt - 1 */
        begin;
        phs_trk = phs_trk + 1;
        call settrk(phs_trk);
        log_sec = 0;
        end;
    phs_sec = sectrn(log_sec,xlt);
    end;

check_end:
if (t_diag = true) then
    put skip;
end check_block;

/* ---------------------------------------------------------------- */
/* Mark all the blocks in error by writing them to the directory    */
/* ---------------------------------------------------------------- */

mark_block:
    proc;

dcl
    max_sec		bin(15),	
    flush		bit(1),		/* buffer needs re-writing	*/
    offset		bin(15),
    (i,j)		bin(15);

cur_sec = 0;				/* First sector			*/
cur_blk = 0;				/* start of directory		*/
offset = 0;
extent = 0;				/* No extents written yet 	*/
status = 0;
flush = false;				/* Absatively posilutely vital	*/
call setdma(addr(buffer));		/* Restore buffer DMA address   */
call deblock(cur_blk,log_sec,phs_trk);		/* load phs_sec & trk	*/
call settrk(phs_trk);

    do while((errno > 0) & (cur_blk < dir_blk));  /* do all sectors in dir */
    phs_sec = sectrn(log_sec,xlt);		/* sector translate	*/
    call setsec(phs_sec);
    status = getsec();
    if (status ^= 0) then
        begin;
        put edit('Bad sector in directory - cannot read')(skip(2),a);
        stop;
        end;

    offset = 0;
        do while((offset < max_off) & (errno > 0));
        if (buffer((offset * 32) + 1) = 'E5'b4) then
            begin;
            call patch(offset);
            flush = true;
            end;

        offset = offset + 1;
        end;

    if (flush = true) then
        begin;
        status = putsec();		/* Write sector out to disk */
        flush = false;
        if (status ^= 0) then
            begin;
            put edit('Unable to mark disk - write failed')(skip(2),a);
            end;
        end;

    log_sec = log_sec + 1;
    cur_sec = cur_sec + 1;			/* bump do while counter  */
    if (mod(cur_sec,sec_blk) = 0) then		/* Goto the next block	  */
        begin;
        cur_blk = cur_blk + 1;
        call deblock(cur_blk,log_sec,phs_trk);
        call settrk(phs_trk);
        end;
    else
    if (log_sec >= phs_spt) then
        begin;
        log_sec = 0;      			/* first sector per track */
        phs_trk = phs_trk + 1;
        call settrk(phs_trk);
        end;
    end;

if (errno > 0) then
    put edit('Unable to complete bad block marking - ERRNO =',errno)
        (skip,a,f(4));

end mark_block;

/* --------------------------------------------- */
/* Patch the sector at offset to make a bad file */
/* Use the block  numbers in bad(errno).blk to   */
/* mark the group numbers in the file.		 */
/* --------------------------------------------- */

patch:
    proc(offset);

dcl
    ch			char(1),
    i			bin(15),
    ext			bit(16),
    blk			bit(16),
    bpnt		bin(15),
    sp			bin(15),
    offset		bin(15);


bpnt = 1 + offset * 32;			/* buffer entry pointer 	*/
if (buffer(bpnt) ^= 'E5'b4) then
    begin;
   put edit('ERROR - Program attempting Illegal Directory Write - Terminating')
        (skip(2),a);
    stop;
    end;

    do i = 0 to 31;			/* Clear whole directory entry  */
    buffer(i + bpnt) = '00'b4;
    end;

    do i = 1 to 11;			/* Load the bad name	*/
    buffer(i + bpnt) = '20'b4;		/* load a space now	*/
    end;

    buffer(bpnt + 1) = '42'b4;
    buffer(bpnt + 2) = '41'b4;
    buffer(bpnt + 3) = '44'b4;

buffer(bpnt) = '00'b4;			/* force user number */
i = 0;
    do while((i < 8) & (errno > 0));	/* 8 groups per block	*/
    blk = bit(bad(errno).blk,15);
    blk = shr16(blk,1);			/* shift right by 1	*/
    sp = (i * 2) + bpnt + 16;
    buffer(sp) = substr(blk,9,8);
    buffer(sp+1) = substr(blk,1,8);
    i = i + 1;
    errno = errno - 1;			/* a marked block, one less 	*/
    end;

ext = bit(extent,15);
buffer(bpnt + 12) = substr(ext,8,8);	/* The extent , divide by 2 	*/

if (errno > 0) then			/* More to come later flag	*/
    buffer(bpnt + 15) = '80'b4;		/* Last entry flag		*/
else
    buffer(bpnt + 15) = '7E'b4;		/* Not Last entry record flag	*/

extent = extent + 1;

end patch;

/* ---------------------------------------------------------------- */
/* From a block number, convert to absolute physical track and      */
/* and sector numbers.						    */
/* ---------------------------------------------------------------- */

deblock:
    proc(blk,sec,trk);

dcl
    i			bin(15),
    temp		dec(10),
    temp2		dec(10),
    (blk,sec,trk)	bin(15);

temp = blk;
    do i = 1 to dpb.bsh;
    temp = temp + temp;
    end;

temp2 = divide(temp,decimal(dpb.spt),15) + decimal(dpb.off);
trk = binary(temp2);

temp2 = 1 + mod(temp,decimal(dpb.spt));
sec = binary(temp2);
sec = divide(sec,sec_sec,15);		/* scale around rec/sec */

end deblock;

/* ---------------- */
/* OOOOXXXXXXXXOOOO */
/* ---------------- */

end fbad;