WriteChar is ok, WriteLn not

[Nils]

Hi,

i want to program a Kernel in Pascal. There are two functions: WriteChar (print a char) and WriteLn (print strings):

Code: Select all

type 
  TScreen = Array[1..25, 1..80] of record
    c    : Char;
    attr : Byte;
  end;

Code: Select all

procedure WriteChar(c : Char);
begin
  Screen^[X, Y].c := c;
  inc(Y);
end;

procedure WriteLn(s : String);
var i : Integer;
begin
  for i := 1 to Length(s) do
    WriteChar(s[i]);
end;

If I would write a line like this one, there would be a "a" on the screen WriteChar('a');
If I would write WriteLn('a'); there would be nothing.

I found out, that there ist maybe a Problem with the string (s : String) or Length(s)/s.
If I would print s[1] on the screen, there would be also nothing. Length(s) is also wrong, because this code prints nothing:

Code: Select all

procedure WriteLn(s : String);
var i : Integer;
begin
  for i := 1 to Length(s) do
    WriteChar('a');
end;

But Length(s)+3 and there are 3 characters..

Have someone any idea, why WriteLn is not working ?

Maybe there is a mistake in following lines, but I found nothing:

Code: Select all

unit system;

interface

type
  ValSInt = LongInt;
  SizeInt = LongInt;

procedure FPC_INITIALIZEUNITS; compilerproc;
procedure FPC_DO_EXIT; compilerproc;
procedure fpc_shortstr_assign(len: longint; src, dst: pointer);
function fpc_shortstr_concat(const s1, s2 : ShortString) : ShortString; compilerproc;
function fpc_shortstr_to_shortstr(len : LongInt; const sstr : ShortString) : ShortString; compilerproc;

implementation

procedure FPC_INITIALIZEUNITS; alias: 'FPC_INITIALIZEUNITS'; compilerproc;
begin

end;

...

[Laksen]

Why don't you just use the generic fpc rtl? With a bit of fiddling you can use all the standard functions

Are your compilerproc's correct?

[Dex]

Try this:

Code: Select all

unit vgatxt;

interface

const
     C_Base=$000B8000;
     C_XSize=80;
     C_YSize=25;
     C_LENGTH=C_XSize*C_YSize;

     C_AT_BLACK=0;
     C_AT_BLUE=1;
     C_AT_GREEN=2;
     C_AT_CYAN=3;
     C_AT_RED=4;
     C_AT_MAGENTA=5;
     C_AT_YELLOW=6;
     C_AT_WHITE=7;
     C_crtc_adr =$3D4;


procedure C_Init;
procedure C_set_attribs(a:integer);
procedure C_set_colours(fg,bg:integer);
procedure C_scroll_up;
procedure C_scroll_down;
procedure C_clear;
procedure C_putchar(c:char);
function C_getchar:char;
procedure C_locate(x,y:longint);

function C_GetX:integer;
function C_GetY:integer;

implementation

uses includes, ports, interupts;

type
     vdu=packed array [1..C_LENGTH] of word;
     pvdu=^vdu;



var
     XPos,YPos:longint;
     Attribs:integer;
     screen:pvdu;

procedure setcursor;
var
        i:word;
begin
        i:=(xpos-1)+(ypos*C_XSize)-C_XSize;
        outb(14,C_crtc_adr);
        outb(i div 256, C_crtc_adr + 1);
        outb(15,C_crtc_adr + 0);
        outb(i and $ff,C_crtc_adr + 1);
end;

procedure C_clear;
var
     i:longint;
begin
     for i:=1 to C_LENGTH do
     begin
          screen^[i]:=$0720;
     end;
     XPos:=1;YPos:=1;
     setcursor;
end;

procedure C_Init;
var err:KRetCode;
        a:cardinal;
begin
     screen:=C_Base;
     C_clear;
     C_set_colours(C_AT_WHITE,C_AT_BLACK);
     setcursor;
     a:=inb_p($61);
     outb_p(a or $80,$61);
     outb(a,$61);
end;

procedure C_set_attribs(a:integer);
begin
     Attribs:=(a and 255)
end;

procedure C_set_colours(fg,bg:integer);
begin
     Attribs:=(bg and 15)*16 + (fg and 15)
end;

procedure C_scroll_up;
var
     i:longint;
begin
     for i:=C_XSize to C_LENGTH do screen^[i-C_XSize]:=screen^[i];
     for i:=(C_LENGTH-C_XSize)+1 to C_LENGTH do screen^[i]:=$20;
end;

procedure C_scroll_down;
var
     i:longint;
begin
     for i:=(C_LENGTH-C_XSize) downto 1 do screen^[i+C_XSize]:=screen^[i];
     for i:=1 to C_XSize do screen^[i]:=$20;
end;

procedure checkandscroll;
begin
     if XPos<1 then
     begin
          XPos:=C_XSize;
          YPos:=YPos-1
     end else if XPos>C_XSize then
     begin
          XPos:=1;
          YPos:=YPos+1
     end;
     if YPos<1 then
     begin
          YPos:=1;
          C_scroll_down
     end else if YPos>C_YSize then
     begin
          YPos:=C_YSize;
          C_scroll_up
     end;
     setcursor;
end;

procedure C_putchar(c:char);
var
     pos:longint;
     data:word;
begin
     if c=#13 then begin
             XPos:=1;
     end else if c=#10 then begin
             YPos:=Ypos+1;
     end else begin
             pos:=(YPos-1)*C_XSize+XPos;
             data:=ord(c)+256*attribs;
             screen^[pos]:=data;
             XPos:=XPos+1;
     end;

     checkandscroll;
end;

function C_getchar:char;
var
     pos:longint;
     data:word;
begin
     pos:=(YPos-1)*C_XSize+XPos;
     data:=screen^[pos];
     C_getchar:=char(data and $ff)
end;

function C_GetX:integer;
begin
     C_GetX:=XPos
end;

function C_GetY:integer;
begin
     C_GetY:=YPos
end;

procedure C_locate(x,y:longint);
begin
     if (x<1) then x:=1 else if (x>C_XSize) then x:=C_XSize;
     if (y<1) then y:=1 else if (y>C_YSize) then y:=C_YSize;
     XPos:=x;
     YPos:=y;
     setcursor;
end;


//initialization
//        C_init;

end.

Code: Select all

procedure readchar(params :PParameters);
begin
        params^[0]:=0;
        params^[1]:=cardinal(ord(inkey));
end;

procedure writechar(params :PParameters);
var
        c:char;
begin
        params^[0]:=0;
        c:=char(params^[1] and $ff);
        C_putchar(c);
end;

But inflater is the one to answer your ?.

[Nils]

I understood the code, but not the way to write a line. What is PParameters ?

[inflater]

Hi,

But inflater is the one to answer your ?.

We-ell.. I try to do my best.

Try this code:

Code: Select all

type
  TScreen = Array[1..80, 1..25] of record
    c    : Char;
    attr : Byte;
  end; 

procedure WriteChar(c : Char);
begin
  Screen^[X, Y].c := c;
  inc(X);
end;

It seems that you've forgot to set the attribute; or (s: String) points to a invalid location in memory.
If even that doesn't work, try Dex's code.

Regards
inflater

[LordMage]

Well, I think the others tried to make things a little too complicated. If your writechar function works and you writeln function doesn't it is because arrays in programming begin with a 0 not a 1.

Code: Select all

procedure WriteLn(s : String); 
var i : Integer; 
begin 
  for i := 0 to (Length(s) -1) do 
    WriteChar(s[i]); 
end;

[inflater]

arrays in programming begin with a 0 not a 1

In Pascal, a standard String has on the 0th byte it's size (TString has max. 255 characters). The actual ASCII characters in the string are starting from 1st byte. So "Length(s)" can be replaced with "s[0]", but I don't think this will solve the problem...

Regards
inflater

[LordMage]

okay, ignore my post then. I guess that shows how long it's been since I programmed with pascal. Haven't touched it since 1998.

[Nils]

I thought I would have implemented fpc_shortstr_assign, but it was not there.... I'm new with Pascal on Kernel-Dev (but I program with Pascal a long time). The functions of Dex are very helpful to find a good structure.

Thx to all !