Systémová jednotka(unit) v Pascalu

Kategorie >>Programování>> Systémová jednotka(unit) v Pascalu


unit sys;
{ FUNCTIONS AND PROCEDURES NOW:
7  SYS
10 VIDEO
20 KEYBOARD
3  TIMER (delay,sound,..)
6  POMOCNE(word2hex,srovnej,..)
}

interface
                { SYSTEM}
{1}function GetCOM1:word;            {RS_232}
{2}function GetLPT1:word;
{3}function GetConventionalMem:word;{640 jinak virus!}
{4}function GetPcCode:byte;
{5}function GetHDDs :byte;{vraci pocet fyzickych HDD}
{6}function ChecksumOk:boolean;{testuje platnost kontrolniho souctu CMOS}
{7}function GetHDD1id:byte;{cte typ instalovaneho HDD}
{7}function GetHDD2id:byte;{cte typ instalovaneho HDD}
{8}function GetFDD1id:byte;
{9}function GetFDD2id:byte;
            {0 =no, 1 =360k(5.25"), 2 =1.2M, 3 =720k(3.5"), 4 =1.44M}
{10}function GetCRC  :word;{Crc CMOS pameti}
{11}function InstalledDrive:boolean;{instalovana mechanika?}
{12}function InstalledFPU:boolean;{instalovana 80287 koprocesor?}
{13}function PrimarniDisplay:byte;
             {0 zadny or EGA,1 40-sl.CGA,2 80-sl.CGA,3 TTL mono.}
{14}function PocetMechaniK:byte;{1 1,2 2,..}
{15}function GetXtendetMem:word;{v kilobytech}


                { VIDEO }
{1}function GetVideoMode:byte;
{2}function GetVideoSIze:word;
{3}function Get_Ofset_Active_Page:word;{od videosegmentu b800}
{4}function GetActivePage:byte;
{5}function Get6845Addr:word;{adresa portu videokontroleru 6845}
{6}function GetCrtModeValue:byte;{6845}
{7}function GetCrtPaletteValue:byte;{6845}
{8}function GetX:byte;
{9}function GetY:byte;
{10}function GetSloupcu:word;

{ KEYBOARD }
{1}function GetALT_Numkey:byte;
{2}function GetHeadBuffer:word;{prave na rade}
{3}function GetEndBuffer:word;{konec bufferu klavesnice}
              {status klavesnice:}
{4}function JePlnyVystupniBuffer:boolean;
                 {na datovem portu jsou neprevzana Data}
{5}function JePlnyVstupniBuffer:boolean;
                         {mikropocitac 8042 jeste neprevzal data z pocitace}
{6}function sysFlag8042:boolean;{systemova vlajka(Flag 0 Procesoru 8042}
{7}function PrikazVdat_Buf:boolean;{prikaz/data (flag 1 procesoru 8042)
je-li 1,byte v datovem bufferu je prikaz(pres port 64h)
      0=data or parametr (port 60h)}
{8}function EnabledKeyboard:boolean;{klavesnice povolena or zakazana}
{9}function BylTimeOut:boolean;{obecny time-out.1 znamena , ze pri prenosu
         dat mezi klavesnici a 8042 doslo k time-outu(vycerpani casu)}
{10}function ErrParity:boolean;{chyba parity ,1 znamena ,ze posledni prijaty
                            byte z klavesnice mel spatnou paritu}

{11}procedure cmd_KEYB(cmd_code,data_value:byte);{prikazy keyb LED,speed,..}
                  {oba do prikazoveho reg}
{12}procedure cmd_kontrolerKeyb(cmd_code,data_value:byte);
                   {cmd_code do 64h,data_val do 60h}
{13}procedure wrt_8048_64h(cmd_code:byte);{jen prikazy bez      }
{14}procedure wrt_8048_60h(cmd_code:byte);{jakehokoliv parametru}

{15}procedure FlushKeyb;{vyprazdni keyb forntu}
{16}procedure vypr;
{17}procedure pause;
              (*s vyprazdnenim buf:*)
{18}function je_k_buf(scan,ascii:byte):boolean;{key v bufferu klavesnice?}
{19}function je_znak_buf(scan,ascii:byte):boolean;{v buf. upcase(ascii)znak?}
  { predchzi jsou neprakticke-testuje se jen 1x 1 klavesa a vyprazdni se buf}
               (* bez vyprazdneni bufferu *)
{20}function Je_v_buf(scan,ascii:byte):boolean;{bez vyprazdneni bufferu}
{21}function keyPressed:boolean;
{JOYSTIC}
{1}function GetJoy:byte;{vraci bity 4-7 tlacitka}
    {bity [ 7 ] [ 6 ] [ 5 ] [ 4 ] ş [ 3 ] [ 2 ] [ 1 ] [ 0 ]
           B2    B1    A2    A1   ş  By    Bx    Ay    Ax
tlacitka/spinace(digitalni vstupy)ş souradnice odporove/casove}


{ TIMER }
{1}procedure Nosound;
{2}procedure sound( hertz : word);
{3}procedure delay(ms:word);

{POMOCNE}
{1}function GetValW(segmentX,offsetX:word):word;
{2}function GetValB(segmentX,offsetX:word):byte;
{3}procedure PutValW(segmentX,offsetX,co:word);
{4}procedure PutValB(segmentX,offsetX:word;co:byte);
{5}function word2Hex(w: Word):string;
{6}procedure SrovnejW(var vetsi,mensi:word);

(****************************************************************************)
implementation

procedure pause;assembler;asm  mov ah,00h;int 16h;end;

function word2Hex(w: Word):string;
var sx:string;
const
  hexChars: array [0..$F] of Char ='0123456789ABCDEF';
begin
sx:=(hexChars[Hi(w) shr 4]);
sx:=sx+(hexChars[Hi(w) and $F]);
sx:=sx+(hexChars[Lo(w) shr 4]);
sx:=sx+(hexChars[Lo(w) and $F]);
word2Hex:=sx;
end;

function GetCom1:word;            {RS_232}assembler;asm
xor cx,cx
mov es,cx
mov bx,0400h
mov ax,word PTR es:[bx]
end;

function GetLPT1:word;      assembler;asm
xor cx,cx
mov es,cx
mov bx,0408h
mov ax,word PTR es:[bx]
end;

function GetConventionalMem:word;assembler;asm
xor cx,cx
mov es,cx
mov bx,0413h
mov ax,word PTR es:[bx]
end;

function GetVideoMode:byte;assembler;asm
xor cx,cx
mov es,cx     ;{es :=cx (=0)}
mov bx,0449h
mov al,byte PTR es:[bx] ;{ 0 : 0449h}
end;

function GetALT_Numkey:byte;{get Alt + Num Key }assembler;asm
xor cx,cx
mov es,cx     ;{es :=cx (=0)}
mov bx,0419h
mov al,byte PTR es:[bx] ;
end;

function GetHeadBuffer:word;{prave na rade}assembler;asm
xor cx,cx
mov es,cx     ;{es :=cx (=0)}
mov bx,041Ah
mov ax,word PTR es:[bx] ;
end;

function GetEndBuffer:word;assembler;asm
xor cx,cx
mov es,cx
mov bx,041ch
mov ax,word PTR es:[bx] ;
end;
(*
procedure GetBuffer(var vys:buffer);assembler;
asm
push ds

mov bx,020h ;{velikost stringu[20h]}
mov di,offset vys
mov si,seg vys
mov ds,si
mov ds:[di],bl

mov bx,0
@here:
xor cx,cx
mov es,cx
mov di,041Eh
mov si,offset vys

mov al,byte PTR es:[di+bx] ;
mov [si+bx+1],al
inc bx

cmp bx,21h   ;{20h +1}
je @konec
jmp @here

@konec:
pop ds
{MOV   SP,BP      ;{P©ˇtomen, kdy‘ Lok lnˇ <> 0}
{POP   BP         ;{P©ˇtomen, kdy‘ Lok lnˇ <> 0 nebo Param <> 0}
{RET   Param      ;{V‘dy p©ˇtomen}

end;
*)
procedure FlushKeyb;{vyprazdni keyb forntu}assembler;
asm
Push ax
@dalsi_znak:
mov ah,1 ;   int 16h{pritomnost znaku ve fronte?};
Jz @navrat
xor ah,ah
int 16h{odstranit znak z fronty prectenim}
JMP @dalsi_znak
@navrat:
pop ax
end;

function GetSloupcu:word;assembler;asm
xor cx,cx
mov es,cx
mov bx,044Ah
mov ax,word PTR es:[bx] ;
end;

function GetVideoSIze:word;assembler;asm
xor cx,cx
mov es,cx
mov bx,044Ch
mov ax,word PTR es:[bx] ;
end;

function Get_Ofset_Active_Page:word;{od videosegmentu b800}assembler;asm
xor cx,cx
mov es,cx
mov bx,044eh
mov ax,word PTR es:[bx] ;
end;

function GetX:byte;assembler;asm
xor cx,cx
mov es,cx
mov bx,0450h
mov al,byte PTR es:[bx] ;
{dolni byte : sloupec}
end;

function GetY:byte;assembler;asm
xor cx,cx
mov es,cx
mov bx,0450h
mov al,byte PTR es:[bx+1] ;
{horni byte : radek}
end;

function GetActivePage:byte;assembler;asm
xor cx,cx
mov es,cx
mov bx,0450h
mov al,byte PTR es:[bx] ;
end;

function Get6845Addr:word;{adresa portu videokontroleru 6845}assembler;asm
xor cx,cx
mov es,cx
mov bx,0463h
mov ax,word PTR es:[bx] ;
end;

function GetCrtModeValue:byte;assembler;asm
xor cx,cx
mov es,cx
mov bx,0465h
mov al,byte PTR es:[bx] ;
end;

function GetCrtPaletteValue:byte;assembler;asm
xor cx,cx
mov es,cx
mov bx,0466h
mov ax,word PTR es:[bx] ;
end;

function GetPcCode:byte;assembler;asm
mov cx,0f000h
mov es,cx
mov bx,0fffeh
mov al,byte PTR es:[bx] ;
end;

procedure Nosound;assembler;
asm
    in    al,61h            ;{ port 61h, 8255 port B, read}
    and    al,0FCh
    out    61h,al            ; {port 61h, 8255 B - spkr, etc}
                    ;  {al = 0, disable parity}
end;
procedure sound( hertz : word); Assembler;
asm MOV BX,SP;MOV BX,&hertz;MOV AX,34DDh;MOV DX,0012h;CMP DX,BX;JNB @J1;DIV BX;MOV BX,AX;IN AL,61h;TEST AL,03h
JNZ @J2;OR AL,03h;OUT 61h,AL;MOV AL,-4Ah;OUT 43h,AL;@J2: MOV AL,BL;OUT 42h,AL;MOV AL,BH;OUT 42h,AL;@J1:
end;

procedure delay(ms:word);assembler;asm mov ax,1000;mul ms;mov cx,dx;mov dx,ax;mov ah,$86;int $15;end;

procedure vypr;assembler;asm mov ah,$0c; mov al,$06; mov dl,$ff;int 21h end;

function GetValW(segmentX,offsetX:word):word;assembler;asm
mov es,segmentX
mov bx,offsetX
mov ax,word PTR es:[bx] ;
end;

function GetValB(segmentX,offsetX:word):byte;assembler;asm
mov es,segmentX
mov bx,offsetX
mov al,byte PTR es:[bx] ;
end;

procedure SrovnejW(var vetsi,mensi:word);
var pom:word;
begin
if vetsi<mensi then begin pom:=vetsi;
                          vetsi:=mensi;
                          mensi:=pom;
                    end;
end;
procedure PutValW(segmentX,offsetX,co:word);assembler;asm
mov es,segmentX
mov bx,offsetX
mov ax,co
mov word PTR es:[bx],ax ;
end;

procedure PutValB(segmentX,offsetX:word;co:byte);
assembler;asm
mov es,segmentX
mov bx,offsetX
mov al,co
mov byte PTR es:[bx],al ;
end;

function JePlnyVystupniBuffer:boolean;assembler;asm
in al,64h
and al,00000001b  {abych zjistil posledni bit}
end;

function JePlnyVstupniBuffer:boolean;assembler;asm
in al,64h
and al,00000010b  {abych zjistil posledni bit}
{shr al,1{neni potreba}
end;
function sysFlag8042:boolean;assembler;asm
in al,64h
and al,00000100b  {abych zjistil posledni bit}
{shr al,2{neni potreba}
end;

function PrikazVdat_Buf:boolean;assembler;asm
in al,64h
and al,0001000b  {abych zjistil posledni bit}
{shr al,3{neni potreba}
end;

function EnabledKeyboard:boolean;assembler;asm
in al,64h
and al,00010000b  {abych zjistil posledni bit}
{shr al,4{neni potreba}
end;

function BylTimeOut:boolean;assembler;asm
in al,64h
and al,01000000b  {abych zjistil posledni bit}
{shr al,6{neni potreba}
end;

function ErrParity:boolean;assembler;asm
in al,64h
and al,10000000b  {abych zjistil posledni bit}
{shr al,7} {neni potreba}
end;

procedure cmd_KEYB(cmd_code,data_value:byte);assembler;asm
{pockat na klavesnici}
xor cx,cx      ;{max . 65536x cekat}
@waCycl:
in al,64h      ;{cist status keyb}
and al,2       ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCycl ;{jeste ne}
{hotovo}
mov al,cmd_code
out 60h,al
{pockat na klavesnici}
xor cx,cx      ;{max . 65536x cekat}
@waCykl:
in al,64h      ;{cist status keyb}
and al,2       ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCykl ;{jeste ne}
{hotovo}
mov al,data_value
out 60h,al
end;

procedure cmd_kontrolerKeyb(cmd_code,data_value:byte);assembler;asm
{pockat na klavesnici}
xor cx,cx      ;{max . 65536x cekat}
@waCycl:
in al,64h      ;{cist status keyb}
and al,2       ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCycl ;{jeste ne}
{hotovo}
mov al,cmd_code
out 64h,al
{pockat na klavesnici}
xor cx,cx      ;{max . 65536x cekat}
@waCykl:
in al,64h      ;{cist status keyb}
and al,2       ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCykl ;{jeste ne}
{hotovo}
mov al,data_value
out 60h,al
end;

procedure wrt_8048_64h(cmd_code:byte);{jen prikazy bez      }assembler;asm
{pockat na klavesnici}
xor cx,cx      ;{max . 65536x cekat}
@waCycl:
in al,64h      ;{cist status keyb}
and al,2       ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCycl ;{jeste ne}
{hotovo}
mov al,cmd_code
out 64h,al
end;


procedure wrt_8048_60h(cmd_code:byte);{jakehokoliv parametru}assembler;asm
{pockat na klavesnici}
xor cx,cx      ;{max . 65536x cekat}
@waCycl:
in al,64h      ;{cist status keyb}
and al,2       ;{=10 -"vymaskovat bit 1"-prevzal 8042 uz data?}
loopNz @waCycl ;{jeste ne}
{hotovo}
mov al,cmd_code
out 64h,al
end;

function je_k_buf(scan,ascii:byte):boolean;assembler;
asm
@znova:
 mov ah,11h
 int 16h
    jz @bad      ;{buffer je prazdny , tak vyskocit}
 cmp al,ascii
    jnz @znovaX    ;{neni to spravna klavesa ,dalsi}
 cmp ah,scan
    jnz @znovaX    ;{neni to spravna klavesa,dalsi}
    jz @ok          ;{ascii i scan byly ok ->exit}
 @znovaX:
    mov ah,10h
    int 16h       ;{a odstranit ji z bufferu,lepe to zatim neumim nez INT 16H}
jmp @znova        ;{dokud neni spravna key or empty buffer}

@Ok:
mov ax,1
jmp @konec

@bad:
xor ax,ax
jmp @konec

@konec:
end;

function keyPressed:boolean;assembler;
asm
@znova:
 mov ah,11h
 int 16h
    xor ax,ax
    jz @bad      ;{buffer je prazdny , tak vyskocit}
     mov ax,1
@bad:
end;


function je_znak_buf(scan,ascii:byte):boolean;{je v buf. upcase(znak)ascii?}assembler;
asm
@znova:
 mov ah,11h
 int 16h
    jz @bad      ;{buffer je prazdny , tak vyskocit}

 { v AH , AL je PISMENO}
   cmp ah,scan
    jnz @znovuX    ;{neni to spravna klavesa,dalsi}
    {jz @ok          ;{ascii i scan byly ok ->exit}

 {nejprve zjistim zda 'a'..'Z' pismeno }
 {kdyz je <65;90>.. velke pismeno}{<97;122> ..male je o 32 vetsi jak velke}
 cmp ascii,90
 jg @v2           ;{muze to byt take male pismeno}
 cmp ascii,65
 jl @nepismeno   ;{ <0;65) neni znak}
 add ascii,32    ;{udelam male}

      jmp @male  ;{ok a muzu cmparovat}
 @v2:{jestli je to male}
 cmp ascii,97
 jl @nepismeno
 cmp ascii,122
 jg @nepismeno

 @male:
 {v ascii je male pismeno:}
 cmp ascii,al
 jz @ok
 add al,32
 cmp ascii,al
 jz @ok
 jnz @znovuX

 @nepismeno:
 cmp ascii,al
 jz @ok

  @znovuX:
    mov ah,10h
    int 16h       ;{a odstranit ji z bufferu,lepe to zatim neumim nez INT 16H}
jmp @znova        ;{dokud neni spravna key or empty buffer}
@Ok:
mov ax,1
jmp @konec
@bad:
xor ax,ax
jmp @konec
@konec:
end;

function Je_v_buf(scan,ascii:byte):boolean;assembler;var head,tail:word;asm
push di
xor di,di
mov es,di     ;{es :=cx (=0)}

mov bx,041Ah
mov ax,word PTR es:[bx] ;
mov head,ax    ;{mam Head}
mov ax,word PTR es:[bx+2] ;
mov tail,ax   ;{a tail}

cmp head,ax  ;{s tail}
je @prazdny ;{if head=tail then exit}
mov bx,041Eh    ;{offset zacatku bufferu klavesnice}
mov di,head     ;{DI  := Head div 2}
sub di,01Eh     ;{a udelam z toho relat.posunuti}

{shr di,1      ;{v DI je rel.offset 1. znaku od BX}

@tady:
  mov ax,word PTR ES:[bx+di]  ;{znak z 41eh+DI -> AX}
  cmp ah,scan
  jne @dalsi;{if ah<>scan then if bx<EndBuffer thne inc(bx,2)}
  {a ascii}
  cmp al,ascii
  je @ok

 @dalsi:
    cmp di,20h
    jne @dal ;{jestli bx+di je 41Eh+20H  + ->41Eh}
    xor di,di
 @dal:
     mov dx,di
     add dx,1Eh
     cmp dx,Tail
     je @prazdny   ;{if buffer cely prosel then exit(false)}
   add di,1
jmp @tady    ;{rep until najdes or neni_vubec v bufferu}


@ok:
mov ax,1
jmp @konec

@prazdny:
mov ax,0

@konec:

pop di
end;

function GetJoy:byte;assembler;asm
mov dx,201h
out dx,al   ;{cokoliv ,inicializace prenosu}
in al,dx
end;

function GetHDDs :byte;{vraci pocet fyzickych HDD}assembler;asm
xor cx,cx
mov es,cx
mov bx,0475h
mov al,byte PTR es:[bx] ;
end;

function ChecksumOk:boolean;{testuje platnost kontrolniho souctu CMOS}assembler;asm
mov al,0eh
out 70H,al
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in  al,71H
and al,64
mov ax,1
je @ok
xor ax,ax
@ok:
end;

function GetHDD1id:byte;{cte typ instalovaneho HDD}assembler;asm
mov al,12h
out 70h,al ;{urci adresu Cmos 12h}
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in al,71h         ;{typ drive 1-14}
and al,00001111b

cmp al,14         ;{jinak na adrese Cmos 19h}
jg @jiny
cmp al,0
je @jiny
jmp @end         ;{jmp if 14 greater}

@jiny:
mov al,19h
out 70h,al ;{urci adresu Cmos 12h}
     mov cx,2
     @dd2:
        nop
     loop @dd2    ;{chvili pockat,aby to stihl}
in al,71h         ;{typ drive}
@end:
end;

function GetHDD2id:byte;{cte typ instalovaneho HDD}assembler;asm
mov al,12h
out 70h,al ;{urci adresu Cmos 12h}
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in al,71h         ;{typ drive 1-14}
shr al,4

cmp al,14         ;{jinak na adrese Cmos 19h}
jg @jiny
cmp al,0
je @jiny
jmp @end         ;{jmp if 14 greater}

@jiny:{ neg<1;14>}
mov al,1ah
out 70h,al ;{urci adresu Cmos 12h}
     mov cx,2
     @dd2:
        nop
     loop @dd2    ;{chvili pockat,aby to stihl}
in al,71h         ;{typ drive}
@end:
end;


function GetFDD1id:byte;{cte typ instalovaneho FDD}assembler;asm
mov al,10h
out 70h,al ;
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in al,71h         ;{typ drive}
shr al,4
end;

function GetFDD2id:byte;{cte typ instalovaneho FDD2}assembler;asm
mov al,10h
out 70h,al ;
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in al,71h         ;{typ Fdrive}
and al,00001111b
end;

function GetCRC  :word;{Crc CMOS pameti}assembler;asm
      mov al,2eh
out 70h,al ;
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in al,71h
mov dh,al       ;{vyssi byte zatim ulozim do dh ,mov rychlejsi jak push a pop}
      mov al,2fh
out 70h,al ;
     mov cx,2
     @dd2:
        nop
     loop @dd2    ;{chvili pockat,aby to stihl}
in al,71h         ;{a nizsi byte AX}
mov ah,dl
end;

function InstalledDrive:boolean;{instalovana mechanika?}assembler;asm
mov al,14h ;{byte vybaveni}
out 70h,al ;
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in al,71h
and al,00000001b
end;

function InstalledFPU:boolean;{instalovana 80287 koprocesor?}assembler;asm
mov al,14h ;{byte vybaveni}
out 70h,al ;
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in al,71h
{and al,00000010b} ;{neni potreba al>0 true}
shr al,1
end;
function PrimarniDisplay:byte;assembler;asm
mov al,14h ;{byte vybaveni}
out 70h,al ;
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in al,71h
and al,00110000b ;
shr al,4
end;
function PocetMechaniK:byte;{0 0,1 1,..}assembler;asm
mov al,14h ;{byte vybaveni}
out 70h,al ;
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in al,71h
and al,11000000b ;
shr al,6
inc al
end;

function GetXtendetMem:word;assembler;asm
mov al,18h
out 70h,al
     mov cx,2
     @dd:
        nop
     loop @dd     ;{chvili pockat,aby to stihl}
in al,71h
mov dh,al ;{nizsi byte}

mov al,18h
out 70h,al
     mov cx,2
     @dd2:
        nop
     loop @dd2    ;{chvili pockat,aby to stihl}
in al,71h
mov ah,dh
end;


end.






Vloženo: 08.01.2009 16:50
Přečteno:2035
Autor: David Mizera

Hlasů: 0 Hodnocení(jako ve škole): nehlasováno
 

Komentáře (0)

   -     Nový Komentář