ast@cs.vu.nl (Andy Tanenbaum) (09/28/88)
: This is a shar archive. Extract with sh, not csh.
: This archive ends with exit, so do not worry about trailing junk.
: --------------------------- cut here --------------------------
PATH=/bin:/usr/bin:/usr/ucb
echo Extracting 'floppy.c.cdif'
sed 's/^X//' > 'floppy.c.cdif' << '+ END-OF-FILE ''floppy.c.cdif'
X*** /local/ast/minix/tape3b/kernel/floppy.c Wed Jul 13 16:59:18 1988
X--- floppy.c Mon Sep 26 23:34:08 1988
X***************
X*** 120,126 ****
X vir_bytes fl_address; /* user virtual address */
X char fl_results[MAX_RESULTS]; /* the controller can give lots of output */
X char fl_calibration; /* CALIBRATED or UNCALIBRATED */
X! char fl_density; /* 0 = 360K/360K; 1 = 360K/1.2M; 2= 1.2M/1.2M */
X } floppy[NR_DRIVES];
X
X #define UNCALIBRATED 0 /* drive needs to be calibrated at next use */
X--- 120,126 ----
X vir_bytes fl_address; /* user virtual address */
X char fl_results[MAX_RESULTS]; /* the controller can give lots of output */
X char fl_calibration; /* CALIBRATED or UNCALIBRATED */
X! char fl_density; /* 0 = 360K/360K; 1 = 360K/1.2M; 2= 1.2M/1.2M*/
X } floppy[NR_DRIVES];
X
X #define UNCALIBRATED 0 /* drive needs to be calibrated at next use */
X***************
X*** 158,164 ****
X PRIVATE int steps_per_cyl[NT] =
X {1, 1, 2, 1, 2, 1}; /* 2 = dbl step */
X PRIVATE int mtr_setup[NT] =
X! {HZ/4,3*HZ/4,HZ/4,HZ/4,3*HZ/4,3*HZ/4};/* in ticks */
X
X /*===========================================================================*
X * floppy_task *
X--- 158,164 ----
X PRIVATE int steps_per_cyl[NT] =
X {1, 1, 2, 1, 2, 1}; /* 2 = dbl step */
X PRIVATE int mtr_setup[NT] =
X! {HZ/4,3*HZ/4,HZ/4,2*HZ/4,3*HZ/4,3*HZ/4};/* in ticks */
X
X /*===========================================================================*
X * floppy_task *
X***************
X*** 204,210 ****
X {
X /* Carry out a read or write request from the disk. */
X register struct floppy *fp;
X! int r, drive, errors, stop_motor();
X long block;
X
X /* Decode the message parameters. */
X--- 204,210 ----
X {
X /* Carry out a read or write request from the disk. */
X register struct floppy *fp;
X! int r, sectors, drive, errors, stop_motor();
X long block;
X
X /* Decode the message parameters. */
X***************
X*** 238,243 ****
X--- 238,247 ----
X if (errors % (MAX_ERRORS/NT) == 0) {
X d = (d + 1) % NT; /* try next density */
X fp->fl_density = d;
X+ sectors = nr_sectors[d];
X+ fp->fl_cylinder = (int) (block / (NR_HEADS * sectors));
X+ fp->fl_sector = (int) interleave[(int)(block % sectors)];
X+ fp->fl_head = (int)(block%(NR_HEADS*sectors)) / sectors;
X need_reset = 1;
X }
X if (block >= nr_blocks[d]) continue;
X***************
X*** 259,265 ****
X r = transfer(fp);
X if (r == OK) break; /* if successful, exit loop */
X if (r == ERR_WR_PROTECT) break; /* retries won't help */
X-
X }
X
X /* Start watch_dog timer to turn motor off in a few seconds */
X--- 263,268 ----
X***************
X*** 385,391 ****
X * positioned on the correct cylinder.
X */
X
X! int r;
X
X /* Are we already on the correct cylinder? */
X if (fp->fl_calibration == UNCALIBRATED)
X--- 388,394 ----
X * positioned on the correct cylinder.
X */
X
X! int r, send_mess();
X
X /* Are we already on the correct cylinder? */
X if (fp->fl_calibration == UNCALIBRATED)
X***************
X*** 407,412 ****
X--- 410,419 ----
X if (r != OK)
X if (recalibrate(fp) != OK) return(ERR_SEEK);
X fp->fl_curcyl = (r == OK ? fp->fl_cylinder : -1);
X+ if (r == OK && ps) { /* give head time to settle on PS/2 */
X+ clock_mess(2, send_mess);
X+ receive(CLOCK, &mess);
X+ }
X return(r);
X }
X
X***************
X*** 567,572 ****
X--- 574,583 ----
X } else {
X /* Recalibration succeeded. */
X fp->fl_calibration = CALIBRATED;
X+ if (ps) { /* give head time to settle on PS/2 */
X+ clock_mess(2, send_mess);
X+ receive(CLOCK, &mess);
X+ }
X return(OK);
X }
X }
X***************
X*** 621,627 ****
X
X mess.m_type = SET_ALARM;
X mess.CLOCK_PROC_NR = FLOPPY;
X! mess.DELTA_TICKS = ticks;
X mess.FUNC_TO_CALL = func;
X sendrec(CLOCK, &mess);
X }
X--- 632,638 ----
X
X mess.m_type = SET_ALARM;
X mess.CLOCK_PROC_NR = FLOPPY;
X! mess.DELTA_TICKS = (long) ticks;
X mess.FUNC_TO_CALL = func;
X sendrec(CLOCK, &mess);
X }
X***************
X*** 634,639 ****
X {
X /* This routine is called when the clock task has timed out on motor startup.*/
X
X- mess.m_type = MOTOR_RUNNING;
X send(FLOPPY, &mess);
X }
X--- 645,649 ----
+ END-OF-FILE floppy.c.cdif
chmod 'u=rw,g=r,o=r' 'floppy.c.cdif'
set `wc -c 'floppy.c.cdif'`
count=$1
case $count in
4225) :;;
*) echo 'Bad character count in ''floppy.c.cdif' >&2
echo 'Count should be 4225' >&2
esac
echo Extracting 'glo.h.cdif'
sed 's/^X//' > 'glo.h.cdif' << '+ END-OF-FILE ''glo.h.cdif'
X*** /local/ast/minix/tape3b/kernel/glo.h Fri Jul 15 20:26:02 1988
X--- glo.h Mon Sep 26 23:34:09 1988
X***************
X*** 11,15 ****
X EXTERN message int_mess; /* interrupt routines build message here */
X
X /* CPU type. */
X! EXTERN int olivetti; /* TRUE for Olivetti-style keyboard */
X! EXTERN int pc_at; /* PC-AT type diskette drives (360K/1.2M) ? */
X--- 11,22 ----
X EXTERN message int_mess; /* interrupt routines build message here */
X
X /* CPU type. */
X! EXTERN int pc_at; /* PC-AT type diskette drives (360K/1.2M) ? */
X! EXTERN int ps; /* are we dealing with a ps? */
X! EXTERN int port_65; /* saved contents of Planar Control Register */
X!
X! /* Video cards and keyboard types. */
X! EXTERN int color; /* 1 if console is color, 0 if it is mono */
X! EXTERN int ega; /* 1 if console is EGA, 0 if not */
X! EXTERN int need_ega_int; /* ask clock for ega interrupt */
X! EXTERN int scan_code; /* scan code of key pressed to start minix */
+ END-OF-FILE glo.h.cdif
chmod 'u=rw,g=r,o=r' 'glo.h.cdif'
set `wc -c 'glo.h.cdif'`
count=$1
case $count in
951) :;;
*) echo 'Bad character count in ''glo.h.cdif' >&2
echo 'Count should be 951' >&2
esac
echo Extracting 'klib88.s.cdif'
sed 's/^X//' > 'klib88.s.cdif' << '+ END-OF-FILE ''klib88.s.cdif'
X*** /local/ast/minix/tape3b/kernel/klib88.s Thu Jul 21 22:08:49 1988
X--- klib88.s Mon Sep 26 23:40:35 1988
X***************
X*** 3,16 ****
X |
X | phys_copy: copies data from anywhere to anywhere in memory
X | cp_mess: copies messages from source to destination
X- | port_out: outputs data on an I/O port
X- | port_in: inputs data from an I/O port
X | lock: disable interrupts
X | restore: restore interrupts (enable/disabled) as they were before lock()
X | build_sig: build 4 word structure pushed onto stack for signals
X | csv: procedure prolog to save the registers
X | cret: procedure epilog to restore the registers
X | get_chrome: returns 0 if display is monochrome, 1 if it is color
X | vid_copy: copy data to video ram (on color display during retrace only)
X | scr_up: scroll screen a line up (in software, by copying)
X | scr_down: scroll screen a line down (in software, by copying)
X--- 3,15 ----
X |
X | phys_copy: copies data from anywhere to anywhere in memory
X | cp_mess: copies messages from source to destination
X | lock: disable interrupts
X | restore: restore interrupts (enable/disabled) as they were before lock()
X | build_sig: build 4 word structure pushed onto stack for signals
X | csv: procedure prolog to save the registers
X | cret: procedure epilog to restore the registers
X | get_chrome: returns 0 if display is monochrome, 1 if it is color
X+ | get_ega: returns 1 if display is EGA, 0 otherwise
X | vid_copy: copy data to video ram (on color display during retrace only)
X | scr_up: scroll screen a line up (in software, by copying)
X | scr_down: scroll screen a line down (in software, by copying)
X***************
X*** 20,38 ****
X | dma_read: transfer data between HD controller and memory
X | dma_write: transfer data between memory and HD controller
X | em_xfer: read or write AT extended memory using the BIOS
X
X | The following procedures are defined in this file and called from outside it.
X! .globl _phys_copy, _cp_mess, _port_out, _port_in, _lock, _restore
X .globl _build_sig, csv, cret, _get_chrome, _vid_copy, _get_byte, _reboot
X .globl _wreboot, _dma_read, _dma_write, _em_xfer, _scr_up, _scr_down
X
X! | The following external procedure is called in this file.
X .globl _panic
X
X | Variables and data structures
X! .globl _color, _cur_proc, _proc_ptr, splimit, _vec_table, _vid_mask
X
X-
X |*===========================================================================*
X |* phys_copy *
X |*===========================================================================*
X--- 19,43 ----
X | dma_read: transfer data between HD controller and memory
X | dma_write: transfer data between memory and HD controller
X | em_xfer: read or write AT extended memory using the BIOS
X+ | wait_retrace: waits for retrace interval, and returns int disabled
X+ | wait_no_retrace: waits for not retrace interval, and returns int disabled
X+ | ack_char: acknowledge character from keyboard
X+ | save_tty_vec: save tty interrupt vector 0x71 for PS/2
X
X | The following procedures are defined in this file and called from outside it.
X! .globl _phys_copy, _cp_mess, _lock, _restore
X .globl _build_sig, csv, cret, _get_chrome, _vid_copy, _get_byte, _reboot
X .globl _wreboot, _dma_read, _dma_write, _em_xfer, _scr_up, _scr_down
X+ .globl _ack_char, _save_tty_vec, _get_ega, _wait_retrace, _wait_no_retrace
X
X!
X! | The following external procedures are called in this file.
X .globl _panic
X
X | Variables and data structures
X! .globl _color, _cur_proc, _proc_ptr, splimit
X! .globl _port_65, _ps, _vec_table, _vid_mask, _vid_port
X
X |*===========================================================================*
X |* phys_copy *
X |*===========================================================================*
X***************
X*** 41,47 ****
X
X _phys_copy:
X pushf | save flags
X! cli | disable interrupts
X cld | clear direction flag
X push bp | save the registers
X push ax | save ax
X--- 46,52 ----
X
X _phys_copy:
X pushf | save flags
X! | cli | disable interrupts
X cld | clear direction flag
X push bp | save the registers
X push ax | save ax
X***************
X*** 130,136 ****
X |*===========================================================================*
X |* cp_mess *
X |*===========================================================================*
X! | This routine makes a fast copy of a message from anywhere in the address
X | space to anywhere else. It also copies the source address provided as a
X | parameter to the call into the first word of the destination message.
X | It is called by:
X--- 135,141 ----
X |*===========================================================================*
X |* cp_mess *
X |*===========================================================================*
X! | This routine is makes a fast copy of a message from anywhere in the address
X | space to anywhere else. It also copies the source address provided as a
X | parameter to the call into the first word of the destination message.
X | It is called by:
X***************
X*** 138,223 ****
X | where all 5 parameters are shorts (16-bits).
X |
X | Note that the message size, 'Msize' is in WORDS (not bytes) and must be set
X! | correctly. Changing the definition of message in type file and not changing
X | it here will lead to total disaster.
X! | This routine destroys ax. It preserves the other registers.
X
X Msize = 12 | size of a message in 16-bit words
X _cp_mess:
X- push bp | save bp
X push es | save es
X push ds | save ds
X! mov bp,sp | index off bp because machine can't use sp
X pushf | save flags
X cli | disable interrupts
X- cld | clear direction flag
X- push cx | save cx
X push si | save si
X push di | save di
X!
X! mov ax,8(bp) | ax = process number of sender
X! mov di,16(bp) | di = offset of destination buffer
X! mov es,14(bp) | es = clicks of destination
X! mov si,12(bp) | si = offset of source message
X! mov ds,10(bp) | ds = clicks of source message
X seg es | segment override prefix
X mov (di),ax | copy sender's process number to dest message
X add si,*2 | don't copy first word
X add di,*2 | don't copy first word
X mov cx,*Msize-1 | remember, first word doesn't count
X rep | iterate cx times to copy 11 words
X movw | copy the message
X-
X pop di | restore di
X pop si | restore si
X! pop cx | restore cs
X! popf | restore flags
X pop ds | restore ds
X! pop es | restore es
X! pop bp | restore bp
X ret | that's all folks!
X
X
X |*===========================================================================*
X- |* port_out *
X- |*===========================================================================*
X- | port_out(port, value) writes 'value' on the I/O port 'port'.
X-
X- _port_out:
X- push bx | save bx
X- mov bx,sp | index off bx
X- push ax | save ax
X- push dx | save dx
X- mov dx,4(bx) | dx = port
X- mov ax,6(bx) | ax = value
X- out | output 1 byte
X- pop dx | restore dx
X- pop ax | restore ax
X- pop bx | restore bx
X- ret | return to caller
X-
X-
X- |*===========================================================================*
X- |* port_in *
X- |*===========================================================================*
X- | port_in(port, &value) reads from port 'port' and puts the result in 'value'.
X- _port_in:
X- push bx | save bx
X- mov bx,sp | index off bx
X- push ax | save ax
X- push dx | save dx
X- mov dx,4(bx) | dx = port
X- in | input 1 byte
X- xorb ah,ah | clear ah
X- mov bx,6(bx) | fetch address where byte is to go
X- mov (bx),ax | return byte to caller in param
X- pop dx | restore dx
X- pop ax | restore ax
X- pop bx | restore bx
X- ret | return to caller
X-
X-
X- |*===========================================================================*
X |* lock *
X |*===========================================================================*
X | Disable CPU interrupts. Return old psw as function value.
X--- 143,187 ----
X | where all 5 parameters are shorts (16-bits).
X |
X | Note that the message size, 'Msize' is in WORDS (not bytes) and must be set
X! | correctly. Changing the definition of message the type file and not changing
X | it here will lead to total disaster.
X! |
X! | This routine only preserves the registers the 'C' compiler
X! | expects to be preserved (es, ds, si, di, sp, bp).
X
X Msize = 12 | size of a message in 16-bit words
X _cp_mess:
X push es | save es
X push ds | save ds
X! mov bx,sp | index off bx because machine can't use sp
X pushf | save flags
X cli | disable interrupts
X push si | save si
X push di | save di
X! mov di,14(bx) | di = offset of destination buffer
X! les si,10(bx) | use 32 bit load(ds is our base)
X! | si = offset of source message
X! | es = clicks of destination
X! lds ax,6(bx) | use 32 bit load ....
X! | ax = process number of sender
X! | ds = clicks of source message
X seg es | segment override prefix
X mov (di),ax | copy sender's process number to dest message
X add si,*2 | don't copy first word
X add di,*2 | don't copy first word
X mov cx,*Msize-1 | remember, first word doesn't count
X+ cld | clear direction flag
X rep | iterate cx times to copy 11 words
X movw | copy the message
X pop di | restore di
X pop si | restore si
X! popf | restore flags (resets interrupts to old state)
X pop ds | restore ds
X! pop es | restore es
X ret | that's all folks!
X
X
X |*===========================================================================*
X |* lock *
X |*===========================================================================*
X | Disable CPU interrupts. Return old psw as function value.
X***************
X*** 332,337 ****
X--- 296,318 ----
X ret | monochrome return
X
X |*===========================================================================*
X+ |* get_ega *
X+ |*===========================================================================*
X+ | This routine calls the BIOS to find out if the display is ega. This
X+ | is needed because scrolling is different.
X+ _get_ega:
X+ movb bl,*0x10
X+ movb ah,*0x12
X+ int 0x10 | call the BIOS to get equipment type
X+
X+ cmpb bl,*0x10 | if reg is unchanged, it failed
X+ je notega
X+ mov ax,#1 | color = 1
X+ ret | color return
X+ notega: xor ax,ax | mono = 0
X+ ret | monochrome return
X+
X+ |*===========================================================================*
X |* dma_read *
X |*===========================================================================*
X _dma_read:
X***************
X*** 392,401 ****
X | 'videobase' is 0xB800 for color and 0xB000 for monochrome displays
X | 'offset' tells where within video ram to copy the data
X | 'words' tells how many words to copy
X! | if buffer is zero, the fill char (BLANK) is used
X
X- BLANK = 0x0700 | controls color of cursor on blank screen
X-
X _vid_copy:
X push bp | we need bp to access the parameters
X mov bp,sp | set bp to sp for indexing
X--- 373,380 ----
X | 'videobase' is 0xB800 for color and 0xB000 for monochrome displays
X | 'offset' tells where within video ram to copy the data
X | 'words' tells how many words to copy
X! | if buffer is zero, the fill char (blank_color) is used
X
X _vid_copy:
X push bp | we need bp to access the parameters
X mov bp,sp | set bp to sp for indexing
X***************
X*** 423,428 ****
X--- 402,409 ----
X
X vid.1: test _color,*1 | skip vertical retrace test if display is mono
X jz vid.4 | if monochrome then go to vid.2
X+ test _ega,*1 | if ega also don't need to wait
X+ jnz vid.4
X
X |vid.2: in | with a color display, you can only copy to
X | test al,*010 | the video ram during vertical retrace, so
X***************
X*** 432,438 ****
X jz vid.3 | until it comes on (start of retrace)
X
X vid.4: pushf | copying may now start; save flags
X! cli | interrupts just get in the way: disable them
X cld | clear direction flag
X mov es,6(bp) | load es now: int routines may ruin it
X
X--- 413,419 ----
X jz vid.3 | until it comes on (start of retrace)
X
X vid.4: pushf | copying may now start; save flags
X! | cli | interrupts just get in the way: disable them
X cld | clear direction flag
X mov es,6(bp) | load es now: int routines may ruin it
X
X***************
X*** 464,481 ****
X pop bp | restore bp
X ret | return to caller
X
X! vid.7: mov ax,#BLANK | ax = blanking character
X rep | copy loop
X stow | blank screen
X jmp vid.5 | done
X
X |*===========================================================================*
X |* scr_up *
X |*===========================================================================*
X | This routine scrolls the screen up one line on an EGA display
X |
X | The call is:
X! | scr_up(org)
X | where
X | 'org' is the video segment origin of the desired page
X
X--- 445,506 ----
X pop bp | restore bp
X ret | return to caller
X
X! vid.7: mov ax,_blank_color | ax = blanking character
X rep | copy loop
X stow | blank screen
X jmp vid.5 | done
X
X |*===========================================================================*
X+ |* wait_retrace *
X+ |*===========================================================================*
X+ | Wait until we're in the retrace interval. Return locked (ints off).
X+ | But enable them during the wait.
X+
X+ _wait_ret: push dx
X+ pushf
X+ mov dx,_vid_port
X+ or dx,#0x000A
X+ wtre.3: sti
X+ nop
X+ nop
X+ cli
X+ in | 0x3DA bit 3 is set during retrace.
X+ testb al,*010 | Wait until it is on.
X+ jz wtre.3
X+
X+ pop ax | return flags for restoration later
X+ pop dx
X+ ret | return to caller
X+
X+ |*===========================================================================*
X+ |* wait_no_retrace *
X+ |*===========================================================================*
X+ | Wait until we're not in the retrace interval. Return locked (ints off).
X+ | But enable then during the wait.
X+
X+ _wait_no_ret: push dx
X+ pushf
X+ mov dx,_vid_port
X+ or dx,#0x000A
X+ wtnre: sti
X+ nop
X+ nop
X+ cli
X+ in | 0x3DA bit 3 is set during retrace.
X+ testb al,*010 | Wait until it is off.
X+ jnz wtnre
X+
X+ pop ax | return flags for restoration later
X+ pop dx
X+ ret | return to caller
X+
X+ |*===========================================================================*
X |* scr_up *
X |*===========================================================================*
X | This routine scrolls the screen up one line on an EGA display
X |
X | The call is:
X! | scr_up(org,source,dest,count)
X | where
X | 'org' is the video segment origin of the desired page
X
X***************
X*** 487,498 ****
X push cx | save cx
X push es | save es
X push ds | save ds
X! mov si,#160 | si = pointer to data to be copied
X! mov di,#0 | di = offset within video ram
X! mov cx,#1920 | cx = word count for copy loop
X
X pushf | copying may now start; save flags
X! cli | interrupts just get in the way: disable them
X cld | clear diretion flag
X mov ax,4(bp)
X mov es,ax | load es now: int routines may ruin it
X--- 512,523 ----
X push cx | save cx
X push es | save es
X push ds | save ds
X! mov si,6(bp) | si = pointer to data to be copied
X! mov di,8(bp) | di = offset within video ram
X! mov cx,10(bp) | cx = word count for copy loop
X
X pushf | copying may now start; save flags
X! | cli | interrupts just get in the way: disable them
X cld | clear diretion flag
X mov ax,4(bp)
X mov es,ax | load es now: int routines may ruin it
X***************
X*** 528,539 ****
X push cx | save cx
X push es | save es
X push ds | save ds
X! mov si,#3838 | si = pointer to data to be copied
X! mov di,#3998 | di = offset within video ram
X! mov cx,#1920 | cx = word count for copy loop
X
X pushf | copying may now start; save flags
X! cli | interrupts just get in the way: disable them
X mov ax,4(bp)
X mov es,ax | load es now: int routines may ruin it
X mov ds,ax
X--- 553,564 ----
X push cx | save cx
X push es | save es
X push ds | save ds
X! mov si,6(bp) | si = pointer to data to be copied
X! mov di,8(bp) | di = offset within video ram
X! mov cx,10(bp) | cx = word count for copy loop
X
X pushf | copying may now start; save flags
X! | cli | interrupts just get in the way: disable them
X mov ax,4(bp)
X mov es,ax | load es now: int routines may ruin it
X mov ds,ax
X***************
X*** 704,712 ****
X--- 729,785 ----
X pop bp
X ret
X
X+ |*===========================================================================
X+ |* ack_char
X+ |*===========================================================================
X+ | Acknowledge character from keyboard for PS/2
X
X+ _ack_char:
X+ push dx
X+ mov dx,#0x69
X+ in
X+ xor ax,#0x10
X+ out
X+ xor ax,#0x10
X+ out
X
X+ mov dx,#0x66
X+ movb ah,#0x10
X+ in
X+ notb ah
X+ andb al,ah
X+ out
X+ jmp frw1
X+ frw1: notb ah
X+ orb al,ah
X+ out
X+ jmp frw2
X+ frw2: notb ah
X+ andb al,ah
X+ out
X+
X+ pop dx
X+ ret
X+
X+
X |*===========================================================================*
X+ |* save_tty_vec *
X+ |*===========================================================================*
X+ | Save the tty vector 0x71 (PS/2)
X+ _save_tty_vec:
X+ push es
X+ xor ax,ax
X+ mov es,ax
X+ seg es
X+ mov ax,452
X+ mov tty_vec1,ax
X+ seg es
X+ mov ax,454
X+ mov tty_vec2,ax
X+ pop es
X+ ret
X+
X+ |*===========================================================================*
X |* reboot & wreboot *
X |*===========================================================================*
X | This code reboots the PC
X***************
X*** 718,726 ****
X--- 791,803 ----
X call _eth_stp | stop the ethernet chip
X call resvec | restore the vectors in low core
X mov ax,#0x40
X+ push ds
X mov ds,ax
X mov ax,#0x1234
X mov 0x72,ax
X+ pop ds
X+ test _ps,#0xFFFF
X+ jnz r.1
X mov ax,#0xFFFF
X mov ds,ax
X mov ax,3
X***************
X*** 728,733 ****
X--- 805,819 ----
X mov ax,1
X push ax
X reti
X+ r.1:
X+ mov ax,_port_65 | restore port 0x65
X+ mov dx,#0x65
X+ out
X+ mov dx,#0x21 | restore interrupt mask port
X+ mov ax,#0xBC
X+ out
X+ sti | enable interrupts
X+ int 0x19 | for PS/2 call bios to reboot
X
X _wreboot:
X cli | disable interrupts
X***************
X*** 738,746 ****
X--- 824,836 ----
X xor ax,ax | wait for character before continuing
X int 0x16 | get char
X mov ax,#0x40
X+ push ds
X mov ds,ax
X mov ax,#0x1234
X mov 0x72,ax
X+ pop ds
X+ test _ps,#0xFFFF
X+ jnz wr.1
X mov ax,#0xFFFF
X mov ds,ax
X mov ax,3
X***************
X*** 748,753 ****
X--- 838,853 ----
X mov ax,1
X push ax
X reti
X+ wr.1:
X+ mov ax,_port_65 | restore port 0x65
X+ mov dx,#0x65
X+ out
X+ mov dx,#0x21 | restore interrupt mask port
X+ mov ax,#0xBC
X+ out
X+ sti | enable interrupts
X+ int 0x19 | for PS/2 call bios to reboot
X+
X
X | Restore the interrupt vectors in low core.
X resvec: cld
X***************
X*** 757,762 ****
X--- 857,870 ----
X mov es,di
X rep
X movw
X+
X+ mov ax,tty_vec1 | Restore keyboard interrupt vector for PS/2
X+ seg es
X+ mov 452,ax
X+ mov ax,tty_vec2
X+ seg es
X+ mov 454,ax
X+
X ret
X
X | Some library routines use exit, so this label is needed.
X***************
X*** 771,773 ****
X--- 879,883 ----
X tmp: .word 0 | count of bytes already copied
X stkoverrun: .asciz "Kernel stack overrun, task = "
X _vec_table: .zerow 142 | storage for interrupt vectors
X+ tty_vec1: .word 0 | sorage for vector 0x71 (offset)
X+ tty_vec2: .word 0 | sorage for vector 0x71 (segment)
+ END-OF-FILE klib88.s.cdif
chmod 'u=rw,g=r,o=r' 'klib88.s.cdif'
set `wc -c 'klib88.s.cdif'`
count=$1
case $count in
19718) :;;
*) echo 'Bad character count in ''klib88.s.cdif' >&2
echo 'Count should be 19718' >&2
esac
echo Extracting 'main.c.cdif'
sed 's/^X//' > 'main.c.cdif' << '+ END-OF-FILE ''main.c.cdif'
X*** /local/ast/minix/tape3b/kernel/main.c Wed Jul 13 16:59:19 1988
X--- main.c Tue Sep 27 08:51:13 1988
X***************
X*** 28,34 ****
X--- 28,39 ----
X #define CPU_TY1 0xFFFF /* BIOS segment that tells CPU type */
X #define CPU_TY2 0x000E /* BIOS offset that tells CPU type */
X #define PC_AT 0xFC /* IBM code for PC-AT (in BIOS at 0xFFFFE) */
X+ #define PS 0xFA /* IBM code for PS/2 (in BIOS at 0xFFFFE) */
X #define EM_VEC 0x15 /* vector for extended memory BIOS calls */
X+ #define CMASK1 0x00 /* interrupt mask: ptr, dsk, keybd, clk, PIC */
X+ #define CMASK2 0xBF /* interrupt mask for secondary PIC */
X+ #define CMASK3 0x3C /* interrupt mask for PS/2 */
X+ #define CMASK4 0x9E /* Planar Control Register */
X #define HIGH_INT 16 /* limit of the interrupt vectors */
X
X extern int int00(), int01(), int02(), int03(), int04(), int05(), int06(),
X***************
X*** 54,60 ****
X int stack_size;
X int * ktsb; /* kernel task stack base */
X extern unsigned sizes[8]; /* table filled in by build */
X! extern int color, vec_table[], get_chrome();
X extern int s_call(), disk_int(), tty_int(), clock_int(), disk_int();
X extern int wini_int(), lpr_int(), trp(), rs232_int(), secondary_int();
X extern phys_bytes umap();
X--- 59,65 ----
X int stack_size;
X int * ktsb; /* kernel task stack base */
X extern unsigned sizes[8]; /* table filled in by build */
X! extern int port_65, ega, color, vec_table[], get_chrome();
X extern int s_call(), disk_int(), tty_int(), clock_int(), disk_int();
X extern int wini_int(), lpr_int(), trp(), rs232_int(), secondary_int();
X extern phys_bytes umap();
X***************
X*** 84,98 ****
X for (ktsb = t_stack, t = -NR_TASKS, rp = &proc[0];
X rp <= &proc[NR_TASKS+LOW_USER]; rp++, t++) {
X for (i = 0; i < NR_REGS; i++) rp->p_reg[i] = 0100 * i; /* debugging */
X! if (t < 0)
X! {
X stack_size = tasktab[t+NR_TASKS].stksize;
X ktsb += stack_size / sizeof (int);
X rp->p_sp = ktsb;
X rp->p_splimit = ktsb - (stack_size - SAFETY) / sizeof(int);
X! }
X! else
X! {
X rp->p_sp = INIT_SP;
X rp->p_splimit = rp->p_sp;
X }
X--- 89,100 ----
X for (ktsb = t_stack, t = -NR_TASKS, rp = &proc[0];
X rp <= &proc[NR_TASKS+LOW_USER]; rp++, t++) {
X for (i = 0; i < NR_REGS; i++) rp->p_reg[i] = 0100 * i; /* debugging */
X! if (t < 0) {
X stack_size = tasktab[t+NR_TASKS].stksize;
X ktsb += stack_size / sizeof (int);
X rp->p_sp = ktsb;
X rp->p_splimit = ktsb - (stack_size - SAFETY) / sizeof(int);
X! } else {
X rp->p_sp = INIT_SP;
X rp->p_splimit = rp->p_sp;
X }
X***************
X*** 141,156 ****
X--- 143,162 ----
X
X /* Determine if display is color or monochrome and CPU type (from BIOS). */
X color = get_chrome(); /* 0 = mono, 1 = color */
X+ ega = get_ega();
X t = (int)get_byte(CPU_TY1, CPU_TY2) & 0xFF; /* is this PC, XT, AT ... ? */
X if (t == PC_AT) pc_at = TRUE;
X+ else if (t == PS) ps = TRUE;
X
X /* Save the old interrupt vectors. */
X phys_b = umap(proc_addr(HARDWARE), D, (vir_bytes) vec_table, VECTOR_BYTES);
X phys_copy(0L, phys_b, (long) VECTOR_BYTES); /* save all the vectors */
X+ if (ps) save_tty_vec(); /* save tty vector 0x71 for reboot() */
X
X /* Set up the new interrupt vectors. */
X for (t = 0; t < HIGH_INT; t++) set_vec(t, int_vec[t], base_click);
X for (t = HIGH_INT; t < 256; t++) set_vec(t, trp, base_click);
X+
X set_vec(SYS_VECTOR, s_call, base_click);
X set_vec(CLOCK_VECTOR, clock_int, base_click);
X set_vec(KEYBOARD_VECTOR, tty_int, base_click);
X***************
X*** 166,184 ****
X if (pc_at) {
X set_vec(AT_WINI_VECTOR, wini_int, base_click);
X phys_copy(phys_b + 4L*EM_VEC, 4L*EM_VEC, 4L); /* extended mem vec */
X! } else {
X set_vec(XT_WINI_VECTOR, wini_int, base_click);
X- }
X
X /* Put a ptr to proc table in a known place so it can be found in /dev/mem */
X set_vec( (BASE - 4)/4, proc, (phys_clicks) 0);
X
X bill_ptr = proc_addr(HARDWARE); /* it has to point somewhere */
X pick_proc();
X
X /* Now go to the assembly code to start running the current process. */
X- port_out(INT_CTLMASK, 0); /* do not mask out any interrupts in 8259A */
X- port_out(INT2_MASK, 0); /* same for second interrupt controller */
X restart();
X }
X
X--- 172,200 ----
X if (pc_at) {
X set_vec(AT_WINI_VECTOR, wini_int, base_click);
X phys_copy(phys_b + 4L*EM_VEC, 4L*EM_VEC, 4L); /* extended mem vec */
X! } else
X set_vec(XT_WINI_VECTOR, wini_int, base_click);
X
X+ if (ps) /* PS/2 */
X+ set_vec(PS_KEYB_VECTOR, tty_int, base_click);
X+
X /* Put a ptr to proc table in a known place so it can be found in /dev/mem */
X set_vec( (BASE - 4)/4, proc, (phys_clicks) 0);
X
X bill_ptr = proc_addr(HARDWARE); /* it has to point somewhere */
X pick_proc();
X
X+ /* Mask out interupts except ptr, disk, clock, keyboard, PIC */
X+ if (ps) {
X+ port_in(PCR, &port_65); /* save Planar Control Register */
X+ port_out(0x65, CMASK4); /* set Planar Control Register */
X+ port_out(INT_CTLMASK, CMASK3);
X+ } else {
X+ port_out(INT_CTLMASK, CMASK1); /* mask out unwanted 8259 interrupts */
X+ port_out(INT2_MASK, CMASK2); /* same for second intr controller */
X+ }
X+
X /* Now go to the assembly code to start running the current process. */
X restart();
X }
X
X***************
X*** 268,274 ****
X phys_copy(phys_b, (phys_bytes) vec_nr*4, (phys_bytes) 4);
X }
X #endif
X-
X
X /*===========================================================================*
X * networking *
X--- 284,289 ----
+ END-OF-FILE main.c.cdif
chmod 'u=rw,g=r,o=r' 'main.c.cdif'
set `wc -c 'main.c.cdif'`
count=$1
case $count in
5620) :;;
*) echo 'Bad character count in ''main.c.cdif' >&2
echo 'Count should be 5620' >&2
esac
echo Extracting 'makefile.cdif'
sed 's/^X//' > 'makefile.cdif' << '+ END-OF-FILE ''makefile.cdif'
X*** /local/ast/minix/tape3b/kernel/makefile Wed Jul 13 16:59:14 1988
X--- makefile Tue Sep 27 08:51:14 1988
X***************
X*** 6,35 ****
X # This is because they have to be in /lib on a PC; the diskette is too small
X # for them to be in /usr/lib. You can change this by editing commands/cc.c.
X #
X! # Normally, MINIX scrolls the screen using the 6845's registers. However,
X! # on some EGA cards (those that are not IBM compatible), the 6845 is not
X! # properly emulated. On these machines, it is necessary to scroll in
X! # software by copying. This is much slower, but it works. The CFLAGS flags are:
X! #
X # -Di8088 - required on an 8088/80286/80386 CPU; forbidden on a 68000
X # -F - run cpp and cem sequentially (used when memory is tight)
X # -T. - put temporaries in working directory (when RAM disk is small)
X #
X! # In the standard distribution, the following defaults are set
X! # PC: CFLAGS = -Di8088 -F -T.
X! # AT: CFLAGS = -Di8088 -F
X! #
X! CFLAGS= -Di8088 -F
X h=../h
X! l=/usr/lib
X
X obj = mpx88.s main.s tty.s floppy.s wini.s system.s proc.s clock.s memory.s \
X! printer.s table.s klib88.s dmp.s
X
X cobjs = main.s tty.s floppy.s wini.s system.s proc.s clock.s memory.s \
X! printer.s table.s dmp.s
X
X-
X kernel: makefile $(obj) $l/libc.a
X @echo "Start linking Kernel."
X @asld -o kernel $(obj) $l/libc.a $l/end.s
X--- 6,26 ----
X # This is because they have to be in /lib on a PC; the diskette is too small
X # for them to be in /usr/lib. You can change this by editing commands/cc.c.
X #
X! # The CFLAGS values are:
X # -Di8088 - required on an 8088/80286/80386 CPU; forbidden on a 68000
X # -F - run cpp and cem sequentially (used when memory is tight)
X # -T. - put temporaries in working directory (when RAM disk is small)
X #
X! CFLAGS= -Di8088 -F
X h=../h
X! l=/lib
X
X obj = mpx88.s main.s tty.s floppy.s wini.s system.s proc.s clock.s memory.s \
X! console.s rs232.s printer.s table.s klib88.s dmp.s
X
X cobjs = main.s tty.s floppy.s wini.s system.s proc.s clock.s memory.s \
X! console.s rs232.s printer.s table.s dmp.s
X
X kernel: makefile $(obj) $l/libc.a
X @echo "Start linking Kernel."
X @asld -o kernel $(obj) $l/libc.a $l/end.s
X***************
X*** 46,51 ****
X--- 37,53 ----
X clock.s: glo.h
X clock.s: proc.h
X
X+ console.s: const.h type.h $h/const.h $h/type.h
X+ console.s: $h/callnr.h
X+ console.s: $h/com.h
X+ console.s: $h/error.h
X+ console.s: $h/sgtty.h
X+ console.s: $h/signal.h
X+ console.s: glo.h
X+ console.s: proc.h
X+ console.s: tty.h
X+ console.s: ttymaps.h
X+
X floppy.s: const.h type.h $h/const.h $h/type.h
X floppy.s: $h/callnr.h
X floppy.s: $h/com.h
X***************
X*** 99,104 ****
X--- 101,107 ----
X table.s: const.h type.h $h/const.h $h/type.h $h/com.h
X table.s: glo.h
X table.s: proc.h
X+ table.s: tty.h
X
X tty.s: const.h type.h $h/const.h $h/type.h
X tty.s: $h/callnr.h
X***************
X*** 108,113 ****
X--- 111,120 ----
X tty.s: $h/signal.h
X tty.s: glo.h
X tty.s: proc.h
X+ tty.s: tty.h
X+ tty.s: ttymaps.h
X+ tty.s: tty.h
X+ tty.s: ttymaps.h
X
X wini.s: const.h type.h $h/const.h $h/type.h
X wini.s: $h/callnr.h
+ END-OF-FILE makefile.cdif
chmod 'u=rw,g=r,o=r' 'makefile.cdif'
set `wc -c 'makefile.cdif'`
count=$1
case $count in
3083) :;;
*) echo 'Bad character count in ''makefile.cdif' >&2
echo 'Count should be 3083' >&2
esac
echo Extracting 'memory.c.cdif'
sed 's/^X//' > 'memory.c.cdif' << '+ END-OF-FILE ''memory.c.cdif'
X*** /local/ast/minix/tape3b/kernel/memory.c Wed Jul 13 16:59:19 1988
X--- memory.c Tue Sep 27 08:51:14 1988
X***************
X*** 99,110 ****
X /* Get minor device number and check for /dev/null. */
X device = m_ptr->DEVICE;
X if (device < 0 || device >= NR_RAMS) return(ENXIO); /* bad minor device */
X! if (device==NULL_DEV) return(m_ptr->m_type == DISK_READ ? EOF : m_ptr->COUNT);
X
X /* Set up 'mem_phys' for /dev/mem, /dev/kmem, or /dev/ram. */
X if (m_ptr->POSITION < 0) return(ENXIO);
X mem_phys = ram_origin[device] + m_ptr->POSITION;
X! if (mem_phys >= ram_limit[device]) return(EOF);
X count = m_ptr->COUNT;
X if(mem_phys + count > ram_limit[device]) count = ram_limit[device] - mem_phys;
X
X--- 99,110 ----
X /* Get minor device number and check for /dev/null. */
X device = m_ptr->DEVICE;
X if (device < 0 || device >= NR_RAMS) return(ENXIO); /* bad minor device */
X! if (device==NULL_DEV) return(m_ptr->m_type == DISK_READ ? 0 : m_ptr->COUNT);
X
X /* Set up 'mem_phys' for /dev/mem, /dev/kmem, or /dev/ram. */
X if (m_ptr->POSITION < 0) return(ENXIO);
X mem_phys = ram_origin[device] + m_ptr->POSITION;
X! if (mem_phys >= ram_limit[device]) return(device == RAM_DEV ? EOF : 0);
X count = m_ptr->COUNT;
X if(mem_phys + count > ram_limit[device]) count = ram_limit[device] - mem_phys;
X
+ END-OF-FILE memory.c.cdif
chmod 'u=rw,g=r,o=r' 'memory.c.cdif'
set `wc -c 'memory.c.cdif'`
count=$1
case $count in
1335) :;;
*) echo 'Bad character count in ''memory.c.cdif' >&2
echo 'Count should be 1335' >&2
esac
echo Extracting 'mpx88.s.cdif'
sed 's/^X//' > 'mpx88.s.cdif' << '+ END-OF-FILE ''mpx88.s.cdif'
X*** /local/ast/minix/tape3b/kernel/mpx88.s Thu Jul 21 22:08:49 1988
X--- mpx88.s Tue Sep 27 08:51:15 1988
X***************
X*** 70,76 ****
X mov ax,4 | build has loaded this word with ds value
X mov ds,ax | ds now contains proper value
X mov ss,ax | ss now contains proper value
X! mov _scan_code,bx | save scan code for '=' key from bootstrap
X mov sp,#_k_stack | set sp to point to the top of the
X add sp,#K_STACK_BYTES | kernel stack
X
X--- 70,76 ----
X mov ax,4 | build has loaded this word with ds value
X mov ds,ax | ds now contains proper value
X mov ss,ax | ss now contains proper value
X! mov _scan_code,bx | save scan code from bootstrap
X mov sp,#_k_stack | set sp to point to the top of the
X add sp,#K_STACK_BYTES | kernel stack
X
X***************
X*** 269,274 ****
X--- 269,275 ----
X |* save *
X |*===========================================================================*
X save: | save the machine state in the proc table.
X+ cld | set direction flag to a known value
X push ds | stack: psw/cs/pc/ret addr/ds
X push cs | prepare to restore ds
X pop ds | ds has now been set to cs
X***************
X*** 300,305 ****
X--- 301,307 ----
X add sp,#K_STACK_BYTES | set sp to top of temporary stack
X mov splimit,#_k_stack | limit for temporary stack
X add splimit,#8 | splimit checks for stack overflow
X+ cld
X mov ax,ret_save | ax = address to return to
X jmp (ax) | return to caller; Note: sp points to saved ax
X
+ END-OF-FILE mpx88.s.cdif
chmod 'u=rw,g=r,o=r' 'mpx88.s.cdif'
set `wc -c 'mpx88.s.cdif'`
count=$1
case $count in
1482) :;;
*) echo 'Bad character count in ''mpx88.s.cdif' >&2
echo 'Count should be 1482' >&2
esac
echo Extracting 'printer.c.cdif'
sed 's/^X//' > 'printer.c.cdif' << '+ END-OF-FILE ''printer.c.cdif'
X*** /local/ast/minix/tape3b/kernel/printer.c Wed Jul 13 16:59:19 1988
X--- printer.c Tue Sep 27 08:51:16 1988
X***************
X*** 134,139 ****
X--- 134,140 ----
X break;
X }
X }
X+ restore(old_state);
X }
X
X /* Reply to FS, no matter what happened. */
+ END-OF-FILE printer.c.cdif
chmod 'u=rw,g=r,o=r' 'printer.c.cdif'
set `wc -c 'printer.c.cdif'`
count=$1
case $count in
263) :;;
*) echo 'Bad character count in ''printer.c.cdif' >&2
echo 'Count should be 263' >&2
esac
echo Extracting 'proc.c.cdif'
sed 's/^X//' > 'proc.c.cdif' << '+ END-OF-FILE ''proc.c.cdif'
X*** /local/ast/minix/tape3b/kernel/proc.c Wed Jul 13 16:59:20 1988
X--- proc.c Tue Sep 27 08:51:16 1988
X***************
X*** 36,41 ****
X--- 36,43 ----
X
X #ifdef i8088
X /* Re-enable the 8259A interrupt controller. */
X+ if (ps && task==FLOPPY)port_out(0x3C, ENABLE);/* Nonspecific End-Of-Int ps */
X+
X port_out(INT_CTL, ENABLE); /* this re-enables the 8259A controller chip */
X if (pc_at && task == WINCHESTER)
X /* this re-enables the second controller chip */
+ END-OF-FILE proc.c.cdif
chmod 'u=rw,g=r,o=r' 'proc.c.cdif'
set `wc -c 'proc.c.cdif'`
count=$1
case $count in
474) :;;
*) echo 'Bad character count in ''proc.c.cdif' >&2
echo 'Count should be 474' >&2
esac
echo Extracting 'ps_wini.c.new'
sed 's/^X//' > 'ps_wini.c.new' << '+ END-OF-FILE ''ps_wini.c.new'
X/* This file contains a driver for the IBM-PS/2 winchester controller.
X * It was written by Wim van Leersum.
X *
X * The driver supports two operations: read a block and
X * write a block. It accepts two messages, one for reading and one for
X * writing, both using message format m2 and with the same parameters:
X *
X * m_type DEVICE PROC_NR COUNT POSITION ADRRESS
X * ----------------------------------------------------------------
X * | DISK_READ | device | proc nr | bytes | offset | buf ptr |
X * |------------+---------+---------+---------+---------+---------|
X * | DISK_WRITE | device | proc nr | bytes | offset | buf ptr |
X * ----------------------------------------------------------------
X *
X * The file contains one entry point:
X *
X * winchester_task: main entry when system is brought up
X *
X */
X
X#include "../h/const.h"
X#include "../h/type.h"
X#include "../h/callnr.h"
X#include "../h/com.h"
X#include "../h/error.h"
X#include "const.h"
X#include "type.h"
X#include "proc.h"
X
X/* I/O Ports used by winchester disk controller. */
X#define DATA 0x320 /* data register */
X#define ASR 0x322 /* Attachment Status Register */
X#define ATT_REG 0x324 /* Attention register */
X#define ISR 0x324 /* Interrupt status register */
X#define ACR 0x322 /* Attachment control register */
X
X/* Winchester disk controller status bits. */
X#define BUSY 0x04 /* controler busy? */
X#define DATA_REQUEST 0x10 /* controler asking for data */
X#define IR 0x02 /* Interrupt Request */
X
X/* Winchester disk controller command bytes. */
X#define CSB0 0x03 /* Command Specify Block byte 0 */
X#define CSB 0x40 /* Get controlers attention for a CSB */
X#define DR 0x10 /* Get controlers attention for data transfer */
X#define CCB 0x80 /* same for command control block */
X#define WIN_READ (char)0x15 /* command for the drive to read */
X#define WIN_WRITE (char)0x95 /* command for the drive to write */
X
X/* Miscellaneous. */
X#define SECTOR_SIZE 512 /* physical sector size in bytes */
X#define ERR -1 /* general error */
X#define MAX_ERRORS 4 /* how often to try rd/wt before quitting */
X#define NR_DEVICES 10 /* maximum number of drives */
X#define MAX_WIN_RETRY 10000 /* max # times to try to input from WIN */
X#define PART_TABLE 0x1C6 /* IBM partition table starts here in sect 0 */
X#define DEV_PER_DRIVE 5 /* hd0 + hd1 + hd2 + hd3 + hd4 = 5 */
X
X#define DMA_READ 0x47 /* DMA read opcode */
X#define DMA_WRITE 0x4B /* DMA write opcode */
X#define DMA_ADDR 0x006 /* port for low 16 bits of DMA address */
X#define DMA_TOP 0x082 /* port for top 4 bits of 20-bit DMA addr */
X#define DMA_COUNT 0x007 /* port for DMA count (count = bytes - 1) */
X#define DMA_M2 0x00C /* DMA status port */
X#define DMA_M1 0x00B /* DMA status port */
X#define DMA_INIT 0x00A /* DMA init port */
X
X/* Variables. */
XPRIVATE struct wini { /* main drive struct, one entry per drive */
X int wn_heads; /* maximum number of heads */
X int wn_maxsec; /* maximum number of sectors per track */
X long wn_low; /* lowest cylinder of partition */
X long wn_size; /* size of partition in blocks */
X} wini[NR_DEVICES];
X
XPRIVATE int w_need_reset = FALSE; /* set to 1 when controller must be reset */
XPRIVATE int nr_drives; /* Number of drives */
X
XPRIVATE message w_mess; /* message buffer for in and out */
X
XPRIVATE char command[14]; /* Common command block */
X
XPRIVATE unsigned char buf[BLOCK_SIZE]; /* Buffer used by the startup routine */
X
X/*===========================================================================*
X * winchester_task *
X *===========================================================================*/
XPUBLIC winchester_task()
X{
X/* Main program of the winchester disk driver task. */
X
Xint r, caller, proc_nr;
X
X /* First initialize the controller */
X init_params();
X
X /* Here is the main loop of the disk task. It waits for a message, carries
X * it out, and sends a reply.
X */
X
X while (TRUE) {
X /* First wait for a request to read or write a disk block. */
X receive(ANY, &w_mess); /* get a request to do some work */
X if (w_mess.m_source < 0) {
X printf("winchester task got message from %d ", w_mess.m_source);
X continue;
X }
X caller = w_mess.m_source;
X proc_nr = w_mess.PROC_NR;
X
X /* Now carry out the work. */
X switch(w_mess.m_type) {
X case DISK_READ:
X case DISK_WRITE: r = w_do_rdwt(&w_mess); break;
X default: r = EINVAL; break;
X }
X
X /* Finally, prepare and send the reply message. */
X w_mess.m_type = TASK_REPLY;
X w_mess.REP_PROC_NR = proc_nr;
X
X w_mess.REP_STATUS = r; /* # of bytes transferred or error code */
X send(caller, &w_mess); /* send reply to caller */
X }
X}
X
X
X/*===========================================================================*
X * w_do_rdwt *
X *===========================================================================*/
XPRIVATE int w_do_rdwt(m_ptr)
Xmessage *m_ptr; /* pointer to read or write w_message */
X{
X/* Carry out a read or write request from the disk. */
Xregister struct wini *wn;
Xint r, drive, device, errors = 0;
Xlong sector;
X
X /* Decode the w_message parameters. */
X device = m_ptr->DEVICE;
X if (device < 0 || device >= NR_DEVICES)
X return(EIO);
X if (m_ptr->COUNT != BLOCK_SIZE)
X return(EINVAL);
X wn = &wini[device]; /* 'wn' points to entry for this drive */
X drive = device/DEV_PER_DRIVE; /* save drive number */
X if (drive >= nr_drives)
X return(EIO);
X if (m_ptr->POSITION % BLOCK_SIZE != 0)
X return(EINVAL);
X sector = m_ptr->POSITION/SECTOR_SIZE;
X if ((sector+BLOCK_SIZE/SECTOR_SIZE) > wn->wn_size)
X return(EOF);
X
X ch_select(); /* Select fixed disk chip */
X
X /* This loop allows a failed operation to be repeated. */
X while (errors <= MAX_ERRORS) {
X r = OK;
X errors++; /* increment count once per loop cycle */
X if (errors > MAX_ERRORS) {
X ch_unselect();
X return(EIO);
X }
X
X /* First check to see if a reset is needed. */
X if (w_need_reset) r = w_reset();
X
X if (r != OK) break;
X
X r = w_transfer(wn); /* Perform the transfer. */
X if (r == OK) break; /* if successful, exit loop */
X }
X
X ch_unselect(); /* Do not select fixed disk chip anymore */
X
X return(r == OK ? BLOCK_SIZE : EIO);
X}
X
X
X/*===========================================================================*
X * ch_select *
X *==========================================================================*/
XPRIVATE ch_select()
X{
X/* select fixed disk chip */
Xint i;
X
X port_in(PCR, &i);
X port_out(PCR, i | 1); /* bit 1 of Planar Control Reg selects hard disk chip*/
X}
X
X/*===========================================================================*
X * ch_unselect *
X *==========================================================================*/
XPRIVATE ch_unselect()
X{
Xint i;
X
X port_in(PCR, &i);
X port_out(PCR, i&0xFE); /*bit 1 of Planar Control Reg selects hard disk chip*/
X}
X
X/*===========================================================================*
X * w_dma_setup *
X *==========================================================================*/
XPRIVATE w_dma_setup()
X{
X/* The IBM PC can perform DMA operations by using the DMA chip. To use it,
X * the DMA (Direct Memory Access) chip is loaded with the 20-bit memory address
X * to by read from or written to, the byte count minus 1, and a read or write
X * opcode. This routine sets up the DMA chip. Note that the chip is not
X * capable of doing a DMA across a 64K boundary (e.g., you can't read a
X * 512-byte block starting at physical address 65520).
X */
X
X int lock_var, mode, low_addr, high_addr, top_addr, low_ct, high_ct, top_end;
X vir_bytes vir, ct;
X phys_bytes user_phys;
X extern phys_bytes umap();
X
X mode = (w_mess.m_type == DISK_READ ? DMA_READ : DMA_WRITE);
X vir = (vir_bytes) w_mess.ADDRESS;
X ct = (vir_bytes) BLOCK_SIZE;
X user_phys = umap(proc_addr(w_mess.PROC_NR), D, vir, BLOCK_SIZE);
X
X low_addr = (int) user_phys & BYTE;
X high_addr = (int) (user_phys >> 8) & BYTE;
X top_addr = (int) (user_phys >> 16) & BYTE;
X low_ct = (int) (ct - 1) & BYTE;
X high_ct = (int) ( (ct - 1) >> 8) & BYTE;
X
X /* Check to see if the transfer will require the DMA address counter to
X * go from one 64K segment to another. If so, do not even start it, since
X * the hardware does not carry from bit 15 to bit 16 of the DMA address.
X * Also check for bad buffer address. These errors mean FS contains a bug.
X */
X if (user_phys == 0)
X panic("FS gave winchester disk driver bad addr", (int) vir);
X top_end = (int) (((user_phys + ct - 1) >> 16) & BYTE);
X if (top_end != top_addr) panic("Trying to DMA across 64K boundary", top_addr);
X
X /* Now set up the DMA registers. */
X lock_var = lock();
X port_out(DMA_M2, mode); /* set the DMA mode */
X port_out(DMA_M1, mode); /* set it again */
X port_out(DMA_ADDR, low_addr); /* output low-order 8 bits */
X port_out(DMA_ADDR, high_addr);/* output next 8 bits */
X port_out(DMA_TOP, top_addr); /* output highest 4 bits */
X port_out(DMA_COUNT, low_ct); /* output low 8 bits of count - 1 */
X port_out(DMA_COUNT, high_ct); /* output high 8 bits of count - 1 */
X restore(lock_var);
X}
X
X/*===========================================================================*
X * w_transfer *
X *===========================================================================*/
XPRIVATE int w_transfer(wn)
Xstruct wini *wn; /* pointer to the drive struct */
X{
Xextern phys_bytes umap();
Xregister int i, old_state;
Xint r;
Xmessage dummy;
X
X if (w_mess.m_type == DISK_READ)
X set_command(WIN_READ, wn); /* build command table */
X else
X set_command(WIN_WRITE, wn);
X
X if (com_out(6, CCB) != OK) return(ERR); /* output command table */
X
X for (i = 0; i < MAX_WIN_RETRY; i++) {
X port_in(ASR, &r);
X if (r & IR) break; /* interrupt request */
X delay();
X }
X
X if (i == MAX_WIN_RETRY) {
X w_need_reset = TRUE;
X return(ERR);
X }
X
X if (win_results() != OK) {
X w_need_reset = TRUE;
X return(ERR);
X }
X
X w_dma_setup(); /* set up dma controler */
X
X port_out(ACR, 3); /* enable interrupts and dma */
X port_out(DMA_INIT, 3); /* initialize DMA */
X
X port_in(INT_CTLMASK, &r); /* do not mask out fixed disk interrupt */
X port_out(INT_CTLMASK, r & 0xDF);
X
X if (com_out(0, DR) != OK) return(ERR); /* ask for data transfer */
X
X receive(HARDWARE, &dummy);
X port_out(INT_CTLMASK, r); /* mask out fixed disk interrupt */
X port_out(ACR, 0); /* disable interrupt and dma */
X
X if (win_results() != OK) {
X w_need_reset = TRUE;
X return(ERR);
X }
X
X return(OK);
X}
X
X/*===========================================================================*
X * w_reset *
X *===========================================================================*/
XPRIVATE w_reset()
X{
X/* Issue a reset to the controller. This is done after any catastrophe,
X * like the controller refusing to respond.
X */
X
X int i;
X message dummy;
X
X port_out(ACR, 0x80); /* Strobe reset bit high. */
X port_out(ACR, 0); /* Strobe reset bit low. */
X
X for (i = 0; i < MAX_WIN_RETRY; i++) {
X if((status() & IR) == IR) break;
X delay();
X }
X if (i == MAX_WIN_RETRY) {
X printf("Winchester won't reset\n");
X return(ERR);
X }
X
X /* Reset succeeded. Tell WIN drive parameters. */
X if (win_init() != OK) { /* Initialize the controler */
X printf("Winchester wouldn't accept parameters\n");
X return(ERR);
X }
X
X w_need_reset = FALSE;
X return(OK);
X}
X
X/*===========================================================================*
X * win_init *
X *===========================================================================*/
XPRIVATE win_init()
X{
X/* Routine to initialize the drive parameters after boot or reset */
X
Xregister int i;
Xmessage dummy;
X
X command[0] = CSB0; /* set command bytes */
X for (i = 1; i < 14; i++)
X command[i] = 0;
X
X if (com_out(14, CSB) != OK) { /* Output command block */
X printf("Can't output command block to winchester controler\n");
X return(ERR);
X }
X
X port_out(ACR, 0); /* no interrupts and no dma */
X return(OK);
X}
X
X/*============================================================================*
X * win_results *
X *============================================================================*/
XPRIVATE win_results()
X{
X/* Routine to check if controller has done the operation succesfully */
X int r;
X
X port_in(ISR, &r);
X if ((r & 0xFD) != 0) return(ERR);
X return(OK);
X}
X
X/*============================================================================*
X * set_command *
X *============================================================================*/
XPRIVATE set_command(r_w, wn)
Xchar r_w;
Xregister struct wini *wn;
X{
X/* Set command block to read or write */
Xlong sector;
Xunsigned rw_sector, cylinder, head;
X
X sector = w_mess.POSITION/SECTOR_SIZE;
X sector += wn->wn_low;
X cylinder = sector / (wn->wn_heads * wn->wn_maxsec);
X rw_sector = (sector % wn->wn_maxsec) + 1;
X head = (sector % (wn->wn_heads * wn->wn_maxsec) )/wn->wn_maxsec;
X
X command[0] = r_w; /* WIN_READ or WIN_WRITE */
X command[1] = ((head << 4) & 0xF0) | ((cylinder >> 8) & 0x03);
X command[2] = cylinder;
X command[3] = rw_sector;
X command[4] = 2;
X command[5] = BLOCK_SIZE/SECTOR_SIZE; /* Number of sectors */
X}
X
X/*============================================================================*
X * com_out *
X *============================================================================*/
XPRIVATE com_out(nr_bytes, attention)
Xint nr_bytes;
Xint attention;
X{
X
X/* Output the command block to the winchester controller and return status */
X
Xregister int i, j;
Xint r;
Xmessage dummy;
X
X port_out(ATT_REG, attention); /* get controler's attention */
X
X if (nr_bytes == 0) return(OK);
X
X for (i = 0; i < nr_bytes; i++) { /* output command block */
X for (j = 0; j < MAX_WIN_RETRY; j++) /* wait for data request */
X if (status() & DATA_REQUEST) break;
X
X if (j == MAX_WIN_RETRY) {
X w_need_reset = TRUE;
X return(ERR);
X }
X port_out(DATA, (int) command[i]);
X }
X
X for (i = 0; i < MAX_WIN_RETRY; i++) {
X if ((status() & BUSY) != BUSY) break;
X delay();
X }
X if (i == MAX_WIN_RETRY) {
X w_need_reset = TRUE;
X return(ERR);
X }
X
X return(OK);
X}
X
X/*============================================================================*
X * status *
X *============================================================================*/
XPRIVATE int status()
X{
X/* Get status of the controler */
Xint r;
X
X port_in(ASR, &r);
X return r;
X}
X
X/*============================================================================*
X * init_params *
X *============================================================================*/
XPRIVATE init_params()
X{
X/* This routine is called at startup to initialize the partition table,
X * the number of drives and the controller
X*/
Xunsigned int i, j, segment, offset;
Xphys_bytes address;
Xextern phys_bytes umap();
Xextern int vec_table[];
X
X /* Copy the parameter vector from the saved vector table */
X offset = vec_table[2 * 0x41];
X segment = vec_table[2 * 0x41 + 1];
X
X /* Calculate the address off the parameters and copy them to buf */
X address = ((long)segment << 4) + offset;
X phys_copy(address, umap(proc_addr(WINCHESTER), D, (vir_bytes)buf, 16), 16L);
X
X /* Copy the parameters to the structures */
X copy_params(buf, &wini[0]);
X
X /* Copy the parameter vector from the saved vector table */
X offset = vec_table[2 * 0x46];
X segment = vec_table[2 * 0x46 + 1];
X
X /* Calculate the address off the parameters and copy them to buf */
X address = ((long)segment << 4) + offset;
X phys_copy(address, umap(proc_addr(WINCHESTER), D, (vir_bytes)buf, 16), 16L);
X
X /* Copy the parameters to the structures */
X copy_params(buf, &wini[5]);
X
X /* Get the nummer of drives from the bios */
X phys_copy(0x475L, umap(proc_addr(WINCHESTER), D, (vir_bytes)buf, 1), 1L);
X nr_drives = (int) *buf;
X
X if (nr_drives > 1) nr_drives = 1; /* Only one supported */
X
X /* Set the parameters in the drive structure */
X wini[0].wn_low = wini[5].wn_low = 0L;
X
X ch_select(); /* select fixed disk chip */
X win_init(); /* output parameters to controler */
X ch_unselect();
X
X /* Read the partition table for each drive and save them */
X for (i = 0; i < nr_drives; i++) {
X w_mess.DEVICE = i * 5;
X w_mess.POSITION = 0L;
X w_mess.COUNT = BLOCK_SIZE;
X w_mess.ADDRESS = (char *) buf;
X w_mess.PROC_NR = WINCHESTER;
X w_mess.m_type = DISK_READ;
X if (w_do_rdwt(&w_mess) != BLOCK_SIZE) {
X printf("Can't read partition table on winchester %d\n",i);
X for (j = 0; j < 1000; j++) delay();
X continue;
X }
X if (buf[510] != 0x55 || buf[511] != 0xAA) {
X printf("Invalid partition table on winchester %d\n",i);
X for (j = 0; j < 1000; j++) delay();
X continue;
X }
X copy_prt((int)i*5);
X }
X}
X
X/*============================================================================*
X * copy_params *
X *============================================================================*/
XPRIVATE copy_params(src, dest)
Xregister unsigned char *src;
Xregister struct wini *dest;
X{
X/* This routine copies the parameters from src to dest
X * and sets the parameters for partition 0 and 5
X*/
X register int i;
X long cyl, heads, sectors;
X
X for (i=0; i<5; i++) {
X dest[i].wn_heads = (int)src[2];
X dest[i].wn_maxsec = (int)src[14];
X }
X cyl = (long)(*(int *)src);
X heads = (long)dest[0].wn_heads;
X sectors = (long)dest[0].wn_maxsec;
X dest[0].wn_size = cyl * heads * sectors;
X}
X
X/*============================================================================*
X * copy_prt *
X *============================================================================*/
XPRIVATE copy_prt(drive)
Xint drive;
X{
X/* This routine copies the partition table for the selected drive to
X * the variables wn_low and wn_size
X */
X
X register int i, offset;
X struct wini *wn;
X long adjust;
X
X for (i=0; i<4; i++) {
X adjust = 0;
X wn = &wini[i + drive + 1];
X offset = PART_TABLE + i * 0x10;
X wn->wn_low = *(long *)&buf[offset];
X if ((wn->wn_low % (BLOCK_SIZE/SECTOR_SIZE)) != 0) {
X adjust = wn->wn_low;
X wn->wn_low = (wn->wn_low/(BLOCK_SIZE/SECTOR_SIZE)+1)*(BLOCK_SIZE/SECTOR_SIZE);
X adjust = wn->wn_low - adjust;
X }
X wn->wn_size = *(long *)&buf[offset + sizeof(long)] - adjust;
X }
X sort(&wini[drive + 1]);
X}
X
X/*============================================================================*
X * sort *
X *============================================================================*/
XPRIVATE sort(wn)
Xregister struct wini wn[];
X{
X register int i,j;
X struct wini tmp;
X
X for (i=0; i<4; i++)
X for (j=0; j<3; j++)
X if ((wn[j].wn_low == 0 && wn[j+1].wn_low != 0) ||
X (wn[j].wn_low > wn[j+1].wn_low && wn[j+1].wn_low != 0)) {
X tmp = wn[j];
X wn[j] = wn[j+1];
X wn[j+1] = tmp;
X }
X}
X
X/*============================================================================*
X * delay *
X *============================================================================*/
XPRIVATE delay()
X{
X int i;
X
X for (i = 0; i < 1000; i++)
X ;
X}
+ END-OF-FILE ps_wini.c.new
chmod 'u=rw,g=r,o=r' 'ps_wini.c.new'
set `wc -c 'ps_wini.c.new'`
count=$1
case $count in
18813) :;;
*) echo 'Bad character count in ''ps_wini.c.new' >&2
echo 'Count should be 18813' >&2
esac
exit 0