{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ This program needs to be compiled with the following switches in order   ³
³ to create an executable which is as small as possible.                   ³
³ Most compiler options can be changed, especially for debugging. However, ³
³ short circuit boolean evaluation is needed to avoid runtime errors!      ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
{$M 2048,0,0}

program BCL;


{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄ¿
³ BCL: Atari Portfolio BCL Compiler    ³ Rev: 1.3á     ³ 91-10-03 ³  PB    ³
ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄ´
³ Copyright (c) Baltus Computer Systems 1989 -- All rights reserved        ³
ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
³ This program implements the Baltus Computer Language, a minimal FP       ³
³ forth implementation with double indirection in the thread to achieve    ³
³ byte codes for minimum image size and as a first step towards a full     ³
³ object oriented language.                                                ³
³ This program is optimized for the Atari Portfolio in basic configuration,³
³ but will run on just about any PC compatible.                            ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

uses Dos;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³  System Constants -- this is where you change the limits of BCL          ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

const StackSize     = 20;                { Size of evaluation stack }
      ScreenHeight  = 8;                 { Height of text screen in lines }
      ScreenWidth   = 40;                { Width of text screen in chars }
      StackDisplay  = ScreenHeight-3;    { Number of stack items displayed }
      MemSize       = 4096;              { Size of program & data memory }
      NrOfPrimitives= 51;                { >= than actual number of
                                           primitives }
      WordNameSize  = 20;                { Maximum length of the name of a
                                           word }
      WordTableSize = 256;               { Maximum number of primitives
                                           + user defined words }
      Rsize         = 40;                { Maximum number of nested (macro)
                                           word invocations: size of the
                                           return stack }
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ The following constants should not be changed, because the consistency   ³ ¶µ
³ of the MPL program depends on these values.                              ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
      NumberChars   = ['0'..'9','.','-'];{ These characters are used to
                                           recognize numbers }
      cr            = Chr(13);           { Carriage return }
      lf            = Chr(10);           { Line feed }
      Delimiters    = [' ',cr,lf];       { These delimiters will force
                                           breaks in input stream }
      PrimPrimitiveNr = 0;               { Nr of the primitive which
                                           implements a primitive }
      PrimLiteralNr = 1;                 { Nr of the primitive which builds
                                           a literal }
      PrimJmpNr     = 2;                 { Nr of the primitive which
                                           implements unconditional jump }
      PrimJzNr      = 3;                 { Nr of the primitive which
                                           implements jump on zero}
      NoMatch       = WordTableSize;     { WordIndex for word which is not
                                           recognized }
      ReturnPrim    = WordTableSize-1;   { Return primitive; this word is
                                           hardwired and not visible for the
                                           user. It terminates a macro }
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Type definitions for the main datastructures in MPL. The use of objects  ³
³ is intended for encapsulation only. Polymorphism does not seem           ³
³ applicable for systems of this size built on top of a mixed language     ³
³ like TP5.5 (both procedural and object oriented)                         ³
³ The various type of words in BCL (constant, variable, macro) are         ³
³ candidates for implementation as subclasses of a general type of word.   ³
³ However, because they need to be projected into a user-visible memory    ³
³ which can be saved and loaded to and from a file system, such an         ³
³ implementation is cumbersome. Therefore, they are implemented in a more  ³
³ traditional way, using records & case statements.                        ³
ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
³ The user visible parts of the BCL data structures are the ValueStack and ³
³ the datamemory, which holds the BCL image. Other data structures are     ³
³ hidden either because they only serve efficiency purposes (e.g. the      ³
³ WordTable), or because they need to be protected from tampering by the   ³
³ user in order to maximize the reliability of BCL without sacrificing too ³
³ much it's flexibility.                                                   ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
type  DataItem      = Byte;              { This is the basic entity of BCL
                                           memory }
      Address       = Word;              { pointer to a DataItem in
                                           DataMemory }
      FpType        = Real;              { Basic component of a stack value.
                                           Corresponds to several dataitems,
                                           depending on the system }
      ScreenString  = String[ScreenWidth]; { Screenstrings are used for
                                             displaying messages }
      WordString    = String[WordNameSize];{ names of words }
      WordIndex     = 0..WordTableSize-1;  { Points to exisiting words }
      WordFIndex    = -1..WordTableSize;   { Points to exisiting words, new
                                             word, or no word (-1) }
      PrimIndex     = 0..NrOfPrimitives-1; { Points to exisiting primitive }
      WordClass     = (empty,primitive,compiled,constant,variable);
      WordType      = packed record
                        wClass: WordClass;
                        args:  0..15;      { Number of inline arguments
                                             following this word when
                                             compiled in a macro }
                        immediate: Boolean;{ if true, the word will always be
                                             executed, even when compiling }
                      end;
      WordHeader    = record               { This is the fixed data structure
                                             which preceeds each word in
                                             DataMemory }
                        wtype:  WordType;
                        size:   Address;   { The name of the word is at the
                                             end, i.e. "size" bytes beyond
                                             the WordHeader in DataMemory }
                      end;
      NumberPtr     = ^Number;
      WordTPtr      = ^WordType;
      PrimProc      = procedure;           { Pointer to the implementation
                                             of a primitive }
      DataArray     = Array [0..MemSize-1] of DataItem;
      StdObject     = Object               { Methods common to all data
                                             structures: writing all kinds
                                             of (error) messages to the
                                             screen }
                        procedure Msg(aMsg: ScreenString);
                        procedure Error(aMsg: ScreenString);
                        procedure StackOvf;
                        procedure StackUnf;
                        procedure MemOvf;
                        procedure NotImplemented(aMsg: ScreenString);
                        procedure Unrecognized(name: WordString);
                        procedure InvArg;  { Invalid argument }
                      end;
      DataMemory    = Object(StdObject)
                        data:     DataArray;
                        ip:       Address;    { Points to next macro
                                                instruction to be executed }
                        ipStack:  Array [1..Rsize] of Address;
                                              { Return Stack }
                        ipPtr:    0..Rsize+1; { Return stack pointer }
                        used:     Address;    { first empty memory location }
                        function  instruction: DataItem; { data @ ip }
                        procedure execute;    { execute instruction&incr ip }
                        procedure pushIp;     { for executing nested macro }
                        procedure popIp;
                        procedure add(anItem: DataItem); { to data @ used &
                                                           incr used }
                        procedure addF(aFloat: FpType);  { same for FpType }
                        constructor initialize;{ "Clear" memory, ip }
                      end;
      PrimTable     = Object(StdObject)       { For decoding invocations of
                                                primitives }
                        prim: Array [0..NrOfPrimitives-1] of PrimProc;
                        constructor initialize;
                      end;
      WordArray     = Array [0..WordTableSize-1] of Address;
      WordTable     = Object(StdObject)       { For translating byte codes
                                                to addresses in DataMemory }
                        addr: WordArray;
                        size: WordFIndex;     { First unused entry }
                        function isPrimitive(index: WordIndex): Boolean;
                        function isImmediate(index: WordIndex): Boolean;
                        function pfa(index: WordIndex;
                                     offset: Address): Address;
                        function name(index: WordIndex): WordString;
                        function find: Integer; {Word on InputLine }
                        function add(aName: WordString): WordIndex;
                        function addHeader(args:  Integer;
                                           imm:   Boolean;
                                           wClass: wordClass): Address;
                        procedure execute(index: WordIndex);
                        function wType(index: WordIndex): WordTPtr;
                        function locatePrim(aPrimNr: PrimIndex): WordFIndex;
                        procedure update;
                        constructor initialize;
                      end;
      Number        = Object(StdObject)
                        value: FpType;
                        procedure mul(aNumber: Number);   { * }
                        procedure quo(aNumber: Number);   { / }
                        procedure add(aNumber: Number);   { + }
                        procedure sub(aNumber: Number);   { - }
                        procedure clr;                    { -> 0 }
                        procedure sin;                    { sine }
                        procedure exp;                    { e^self }
                        procedure ln;                     { Natural Log }
                        procedure atn;                    { Arc Tangent }
                        procedure print;                  { On screen }
                      end;
      Stack         = Object(StdObject)
                        data:  Array [1..StackSize] of Number;
                        ptr:   0..StackSize;
                        function  top: NumberPtr;
                        function  at(i: Integer): NumberPtr; { Top = at(1) }
                        procedure needs(aNumber: Integer); { if not: error! }
                        procedure push(aValue: FpType);
                        procedure drop(anInteger: Integer);
                        procedure pop;
                        procedure clr;
                        procedure swap;
                        procedure dup;
                        procedure print;
                      end;
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Global variables of the threaded language engine                         ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
var   InputLn:      WordString;    { The last word entered on the keyboard }
      Words:        WordTable;     { Pointers to the addresses of all words }
      Primitives:   PrimTable;     { Pointers to implementations of
                                     primitives }
      Memory:       DataMemory;    { Holds image (all words) }
      Compiling:    Boolean;       { True if compiling }
      CurrentWord:  WordString;    { Name of the word (macro) currently
                                     being compiled }
      BitBlt:       Byte;          { Code for pixel operations: set,
                                     clr, xor etc.}
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Global variables of the calculator software                              ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
      ValueStack:   Stack;
      DisplayStack: Boolean;       { True if stack is displayed following
                                     each user action (c.f. show) }
      Stop:         Boolean;       { True if the current input terminates
                                     the BCL session. Set by 'quit' }


{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Bios interface for keyboard & screen control. Using the TP units results ³
³ in larger code. Moreover, they sometimes circumvent the bios, resulting  ³
³ in compatibility problems on the Portfolio. At some future version,      ³
³ the portfoli.tpu unit will be used to replace this and provide additional³
³ additional functionality.                                                ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

procedure SetMode(mode: Integer);
{ Sets the screen mode: graphics or text }
var r: Registers;
begin
  r.ah:=0;
  r.al:=mode;
  Intr($10,r);
end;

procedure CursorXY(x,y: Integer);
{ Moves the cursor to the coordinates indicated. (0,0) is topleft }
var r: Registers;
begin
  r.ah:=02;
  r.bh:=0;
  r.dh:=y;
  r.dl:=x;
  Intr($10,r);
end;

function ReadKey: Char;
{ Wait until a key has been pressed and return it's ascii value }
var r: Registers;
begin
  r.AH:=$08;
  intr($21,r);
  ReadKey:=Char(r.AL);
end;

procedure SetPixel(x,y: integer);
{ Set, clear, or invert a pixel depending on the value of BitBlt }
var r: Registers;
begin
  r.ah:=$C;
  r.al:=BitBlt;
  r.bh:=0;
  r.cx:=x;
  r.dx:=y;
  Intr($10,r);
end;

procedure Line(x1,y1,x2,y2: Integer);
{ Draw a line in graphics mode. Implemented for efficiency. Lines shouldn't
  be zero length, this will cause a runtime error }
var x,y: integer;
begin
  if Abs(x2-x1)>Abs(y2-y1)
  then
   if x1<x2
   then
    for x:=x1 to x2
    do
     SetPixel(x,y1+(x-x1)*(y2-y1) div (x2-x1))
   else
    for x:=x1 downto x2
    do
     SetPixel(x,y1+(x-x1)*(y2-y1) div (x2-x1))
  else
   if y1<y2
   then
    for y:=y1 to y2
    do
     SetPixel(x1+(y-y1)*(x2-x1) div (y2-y1),y)
   else
    for y:=y1 downto y2
    do
     SetPixel(x1+(y-y1)*(x2-x1) div (y2-y1),y)
end;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Basic Calculator operations                                              ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

procedure GetInput;
{ Compose a word in InputLine from separate key inputs. Also handles
  error correction (backspace key). }
var s: String[2];
    i: integer; x: real;
begin
  InputLn:='';
  s:=' ';
  repeat
    s[1]:=ReadKey;
    { skip initial delimiters; occurs when typing several successive
      delimiter characters, e.g. <cr> <lf> ... }
    while (Length(InputLn)=0) and (s[1] in Delimiters)
    do
     begin
       if s[1]<>lf then Write(s[1]);
       if s[1]=cr then Write(lf);
       s[1]:=ReadKey;
     end;
    if s[1]=Chr(27) then Halt; {esc}
    if ord(s[1])=8  {backspace}
    then
     if Length(InputLn) = 0
     then
      ValueStack.error('No input')
     else
      Delete(InputLn,Length(InputLn),1)
    else
     InputLn:=InputLn+s;
    if s[1]<>lf then Write(s[1]);
    if s[1]=cr then Write(lf);
  until s[1] in delimiters;
  Delete(InputLn,Length(InputLn),1);
end;

procedure Number.mul(aNumber: Number);
begin
  value := value*aNumber.value;
end;

procedure Number.quo(aNumber: Number);
begin
  if (aNumber.value = 0)
  then
   error('Division by zero')
  else
   value := value/aNumber.value;
end;

procedure Number.add(aNumber: Number);
begin
  value:=value+aNumber.value;
end;

procedure Number.sub(aNumber: Number);
begin
  value:=value-aNumber.value;
end;

procedure Number.sin;
begin
  value:=System.Sin(value);
end;

procedure Number.exp;
begin
  value:=System.Exp(value);
end;

procedure Number.Ln;
begin
  if value <= 0
  then
   InvArg
  else
   value:=System.Ln(value);
end;

procedure Number.atn;
begin
  value:=System.ArcTan(value);
end;

procedure Number.clr;
begin
  value:=0;
end;

procedure Number.print;
{ Semi-intelligent: chooses format based on value of number }
begin
  if (Abs(value) > 1e-3) and (Abs(value) < 1e4)
  then
   if Round(value)=value
   then
    WriteLn(Round(value):(ScreenWidth-2))
   else
    WriteLn(value:(ScreenWidth-2):12)
  else
   if value=0
   then
    WriteLn('0':(ScreenWidth-2))
   else
    WriteLn(value:(ScreenWidth-2));
end;

procedure Stack.needs(aNumber: integer);
var i: Integer;
begin
  if ptr < aNumber
  then
   begin
     StackUnf;
     for i:=ptr+1 to aNumber
     do
      push(1);
   end;
end;

procedure Stack.drop(anInteger: integer);
begin
  needs(anInteger);
  ptr:=ptr-anInteger;
end;

function Stack.top: NumberPtr;
begin
  needs(1);
  top:=@data[ptr];
end;

function Stack.at(i: Integer): NumberPtr;
begin
  needs(i);
  at:=@data[ptr-i+1];
end;

procedure Stack.swap;
var tmp: Number;
begin
  needs(2);
  tmp:=at(1)^;
  at(1)^:=at(2)^;
  at(2)^:=tmp;
end;

procedure Stack.dup;
begin
  needs(1);
  push(top^.value);
end;

procedure Stack.push(aValue: FpType);
var aNumber: Number;
begin
  aNumber.value:=aValue;
  if ptr=StackSize
  then
   StackOvf
  else
   begin
     ptr:=ptr+1;
     data[ptr]:=aNumber;
   end;
end;

procedure Stack.pop;
begin
  needs(1);
  ptr:=ptr-1;
end;

procedure Stack.clr;
var i: Integer;
begin
  for i:=1 to StackSize
  do
   data[i].clr;
  ptr:=0;
end;

procedure Stack.print;
var i: integer;
begin
  for i:=StackDisplay downto 1
  do
   if i>ptr
   then
    WriteLn
   else
    at(i)^.print;
end;

procedure StdObject.msg(aMsg: ScreenString);
begin
  if DisplayStack
  then
    CursorXY(0,ScreenHeight-1)
  else
    WriteLn;
  Write(aMsg);
  if DisplayStack
  then
   Write(ReadKey)
  else
   WriteLn;
end;

procedure StdObject.error(aMsg: ScreenString);
begin
  Write(Chr(7));
  Msg(Concat('*** Error: ',aMsg));
end;

procedure StdObject.StackOvf;
begin
  Error('Stack Overflow');
end;

procedure StdObject.StackUnf;
begin
  Error('Stack Underflow');
end;

procedure StdObject.MemOvf;
begin
  Error('Memory Overflow');
end;

procedure StdObject.NotImplemented(aMsg: ScreenString);
begin
  Error(Concat(aMsg,' is not implemented'));
end;

procedure StdObject.Unrecognized(name: WordString);
begin
  Error('couldn''t find '+name);
end;

procedure StdObject.InvArg;
begin
  Error('Invalid argument');
end;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Basic operations in the language engine                                  ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

procedure SavIt;
{ Save image (DataMemory + WordTable) to file.
  Note that we have to use untyped files because TP5.5 does not support
  writing files of object types }
var f: file;
begin
  assign(f,InputLn+'.bcl');
  rewrite(f,1);
  blockwrite(f,Memory.used,SizeOf(Address));
  blockwrite(f,Memory.data,Memory.used*SizeOf(DataItem));
  blockwrite(f,Words.size,SizeOf(WordFIndex));
  blockwrite(f,Words.addr,(Words.size+1)*SizeOf(Address));
  close(f);
end;

procedure LoadIt;
var f: file;
begin
  assign(f,InputLn+'.bcl');
  reset(f,1);
  blockread(f,Memory.used,SizeOf(Address));
  blockread(f,Memory.data,Memory.used*SizeOf(DataItem));
  blockread(f,Words.size,SizeOf(WordFIndex));
  blockread(f,Words.addr,(Words.size+1)*SizeOf(Address));
  close(f);
end;

function DataMemory.Instruction: DataItem;
begin
  Instruction:=data[ip];
end;

procedure DataMemory.PushIp;
begin
  if ipPtr = RSize
  then
    StackOvf
  else
   begin
     ipPtr:=ipPtr+1;
     ipStack[ipPtr]:=ip;
   end;
end;

procedure DataMemory.popIp;
begin
  if ip=0
  then
   StackUnf
  else
   begin
     ip:=ipStack[ipPtr];
     ipPtr:=ipPtr-1;
   end;
end;

procedure DataMemory.Execute;
var i: Integer;
    fPtr: ^FpType;
    ipincr: Address;
begin
  { Execute an instruction in memory as part of a word definition }
  while instruction <> ReturnPrim
  do
   begin
     ipincr:=1;
     for i:=1 to Words.wType(instruction)^.args
     do
      begin
        fPtr:=@Memory.data[ip+1];
        ValueStack.push(fPtr^);
        inc(ipincr,SizeOf(FpType));
      end;
     Words.Execute(instruction);
     Inc(ip,ipincr);
   end;
end;

procedure DataMemory.Add(anItem: DataItem);
begin
  data[used]:=anItem;
  inc(used);
  if used > MemSize
  then
   MemOvf;
end;

procedure DataMemory.AddF(aFloat: FpType);
var fPtr: ^FpType;
begin
  fPtr:=@data[used];
  fPtr^:=aFloat;
  inc(used,sizeOf(FpType));
  if used > MemSize
  then
   MemOvf;
end;

constructor DataMemory.Initialize;
var   pfaAddr: Address;
      newIndex: WordIndex;
begin
  ip:=0;
  ipPtr:=0;
  used:=0;
  { Insert the word 'primitive' as the 1st word in memory }
  pfaAddr:=Words.addHeader(0,False,primitive);
  Memory.add(primPrimitiveNr);
  newIndex:=Words.add('primitive');
end;

procedure WordTable.update;
{ replace the first word from the start with a name identical to the
  last-defined word by the code for this word. This involves updating
  datamemory and word tables.
  This can be done without going through too much trouble because:
  1. only the last-defined word will be replaced: no references to this
     word can exist yet.
  2. all code is relocatable, because:
     a. local jumps are ip-relative
     b. global references are redirected through the wordtable
}
var oldBegin, oldEnd, newBegin, newEnd: Address;
    var oldIndex, newIndex, i: WordFIndex;
    var oldSize, newSize: Integer;
begin
  newIndex:=size-1;
  oldIndex:=-1;
  repeat
    oldIndex:=oldIndex+1;
  until (oldIndex = newIndex) or (name(newIndex) = name(oldIndex));
  if oldIndex=newIndex
  then
   { No other word with the same name as the last-defined word exists }
   Unrecognized(name(oldIndex))
  else
   begin
     { Now we can start replacing stuff }
     { First find location and size of old and new word }
     oldBegin:=addr[oldIndex];
     oldEnd:=addr[oldIndex+1];
     newBegin:=addr[newIndex];
     newEnd:=addr[newIndex+1];
     oldSize:=oldEnd-oldBegin;
     newSize:=newEnd-newBegin;
     { Now move all words following the old word up to and including the
       new word in order to adjust the room left by the old word to just
       the right size for the new word }
     move(Memory.data[oldEnd],Memory.data[oldEnd-oldSize+newSize],
          newEnd-oldEnd+1);
     { Now move the new word on top of (part of) the old word. Remember that
       the new word already moved as part of the previous move }
     move(Memory.data[newBegin+newSize-oldSize],
          Memory.data[oldBegin],newSize);
     { now remove the reference to the old word }
     size:=size-1;
     { Update all references in my address table to point to the words
       which moved around. }
     for i:= oldIndex+1 to newIndex+1
     do
      addr[i]:=addr[i]+newSize-oldSize;
     { Release the memory occupied by the original copy of the new word. }
     Memory.used:=addr[size];
   end;
end;

constructor WordTable.initialize;
begin
  size:=0;
  addr[size]:=0;
end;

function WordTable.locatePrim(aPrimNr: PrimIndex): WordFIndex;
var i: WordFindex;
begin
  i:=-1;
  repeat
    inc(i)
  until (i=size) or isPrimitive(i) and (Memory.data[pfa(i,0)]=aPrimNr);
  if i=size
  then
   locatePrim:=NoMatch
  else
   locatePrim:=i;
end;

procedure WordTable.execute(index: WordIndex);
var fPtr: ^FpType;
begin
  case wType(index)^.wClass of
  primitive: Primitives.prim[Memory.data[pfa(index,0)]];
  compiled:  begin
               Memory.pushIp;
               Memory.Ip:=pfa(index,0);
               Memory.execute;
               Memory.popIp;
             end;
  constant:  begin
               fPtr:=@Memory.data[pfa(index,0)];
               ValueStack.push(fPtr^);
             end;
  variable:  begin
               ValueStack.push(pfa(index,0));
             end;
  end;
end;

function WordTable.isPrimitive(index: WordIndex): Boolean;
begin
  isPrimitive:=(wType(index)^.wClass = primitive);
end;

function WordTable.isImmediate(index: WordIndex): Boolean;
begin
  isImmediate:=wType(index)^.immediate;
end;

function WordTable.pfa(index: WordIndex; offset: Address): Address;
begin
  pfa:=addr[index]+SizeOf(WordHeader)+offset;
end;

function WordTable.wType(index: WordIndex): WordTPtr;
begin
  wType:=@Memory.data[addr[index]];
end;

function WordTable.name(index: WordIndex): WordString;
var wsPtr: ^WordString;
    whPtr: ^WordHeader;
begin
  whPtr:=@Memory.data[addr[index]];
  wsPtr:=@Memory.data[pfa(index,whPtr^.size)];
  name:=wsPtr^;
end;

function WordTable.find: Integer;
var i: Integer;
begin
  i:=size;
  repeat
    i:=i-1;
  until (i = -1) or (InputLn = name(i));
  if i=-1
  then
   find:=NoMatch
  else
   find:=i;
end;

function WordTable.addHeader(args:  Integer;
                              imm:   Boolean;
                              wClass: WordClass): Address;
begin
  wType(size)^.args:=args;
  wType(size)^.immediate:=imm;
  wType(size)^.wClass:=wClass;
  Memory.used:=pfa(size,0);
  addHeader:=Memory.used;
end;

function WordTable.add(aName: WordString): WordIndex;
var whPtr: ^WordHeader;
    wsPtr: ^WordString;
    aSize: Address;
begin
  if size = WordTableSize-1
  then
   error('WordTable full')
  else
   begin
     aSize:=Memory.used-pfa(size,0);
     whPtr:=@Memory.data[addr[size]];
     whPtr^.size:=aSize;
     wsPtr:=@Memory.data[Memory.used];
     wsPtr^:=aName;
     inc(size);
     Memory.used:=addr[size-1]+SizeOf(WordHeader)+aSize+Length(aName)+1;
     addr[size]:=Memory.used;
   end;
end;


{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Implementations of BCL primitives.                                       ³
³ Add your own primitives here, but also add them to PrimTable.Initialize  ³
³ Don't forget to update NrOfPrimitives in the constant section at the top ³
³ of this program.                                                         ³
ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
³ These procedures need to be compiled in far mode, because they will be   ³
³ referenced from the PrimTable.                                           ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

{$F+}
procedure primStore;
var fPtr: ^FpType;
begin
  ValueStack.needs(2);
  fPtr:=@Memory.data[trunc(ValueStack.top^.value)];
  fPtr^:=ValueStack.at(2)^.value;
  ValueStack.drop(2);
end;

procedure primDrop;
begin
  ValueStack.pop;
end;

procedure primSwap;
begin
  ValueStack.swap;
end;

procedure primImmediate;
begin
  Words.wType(Words.size-1)^.immediate:=True;
end;

procedure primArgs;
begin
  Words.wType(Words.size-1)^.args:=trunc(ValueStack.top^.value);
end;

procedure primSave;
begin
  GetInput;
  Savit;
end;

procedure primLoad;
begin
  GetInput;
  LoadIt;
end;

procedure primQuit;
begin
  Stop:=True;
end;

procedure primVlist;
var i: WordIndex;
begin
  WriteLn('Commands: ');
  for i:=0 to Words.size-1
  do
   Write(Words.name(i):WordNameSize);
  WriteLn;
  WriteLn('Memory used: ',Memory.used:4,' bytes out of ',Memsize);
  WriteLn('Words used:  ',Words.size:4,' entries out of 255');
  if DisplayStack then WriteLn(ReadKey);
end;

procedure primTMode;
begin
  SetMode(3);
end;

procedure primGMode;
begin
  SetMode(6);
end;

procedure primPlot;
begin
  ValueStack.needs(2);
  SetPixel(trunc(ValueStack.at(2)^.value),
           trunc(ValueStack.at(1)^.value));
  ValueStack.drop(2);
end;

procedure primLine;
begin
  ValueStack.needs(4);
  Line(trunc(ValueStack.at(4)^.value),
       trunc(ValueStack.at(3)^.value),
       trunc(ValueStack.at(2)^.value),
       trunc(ValueStack.at(1)^.value));
  ValueStack.drop(4);
end;

function makeWord(size: Address; wClass: WordClass): Address;
var newIndex:   WordIndex;
    newAddress: Address;
    i:          Integer;
begin
  GetInput;
  newAddress:=Words.addHeader(0,False,wClass);
  for i:=1 to size
  do
   Memory.add(0);
  newIndex:=Words.add(InputLn);
  makeWord:=newAddress;
end;

procedure primKey;
begin
  ValueStack.push(Ord(ReadKey));
end;

procedure primEmit;
begin
  ValueStack.needs(1);
  Write(Chr(trunc(ValueStack.top^.value)));
  ValueStack.pop;
end;

procedure primPrimitive;
begin
  ValueStack.needs(1);
  Memory.data[makeWord(1,primitive)]:=trunc(ValueStack.top^.value);
  ValueStack.pop;
end;

procedure primLiteral;
begin
 { No action: needs args set to 1; will push next words in the code
   onto the stack }
end;

procedure primVariable;
var fPtr: ^FpType;
begin
  ValueStack.needs(1);
  fPtr:=@Memory.data[makeWord(SizeOf(FpType),variable)];
  fPtr^:=ValueStack.top^.value;
  ValueStack.pop;
end;

procedure primConstant;
var fPtr: ^FpType;
begin
  ValueStack.needs(1);
  fPtr:=@Memory.data[makeWord(SizeOf(FpType),constant)];
  fPtr^:=ValueStack.top^.value;
  ValueStack.pop;
end;

procedure primRecall;
var fPtr: ^FpType;
begin
  ValueStack.needs(1);
  fPtr:=@Memory.data[trunc(ValueStack.top^.value)];
  ValueStack.top^.value:=fPtr^;
end;

procedure primSub;
begin
  ValueStack.needs(2);
  ValueStack.at(2)^.sub(ValueStack.top^);
  ValueStack.pop;
end;

procedure primQuo;
begin
  ValueStack.needs(2);
  ValueStack.at(2)^.quo(ValueStack.top^);
  ValueStack.pop;
end;

procedure primMul;
begin
  ValueStack.needs(2);
  ValueStack.at(2)^.mul(ValueStack.top^);
  ValueStack.pop;
end;

procedure primAdd;
begin
  ValueStack.needs(2);
  ValueStack.at(2)^.add(ValueStack.top^);
  ValueStack.pop;
end;

procedure primEquals;
begin
  ValueStack.needs(2);
  if ValueStack.at(1)^.value= ValueStack.at(2)^.value
  then
   ValueStack.at(2)^.value:=1
  else
   ValueStack.at(2)^.value:=0;
  ValueStack.pop;
end;

procedure primLT;
begin
  ValueStack.needs(2);
  if ValueStack.at(1)^.value > ValueStack.at(2)^.value
  then
   ValueStack.at(2)^.value:=1
  else
   ValueStack.at(2)^.value:=0;
  ValueStack.pop;
end;

procedure primLE;
begin
  ValueStack.needs(2);
  if ValueStack.at(1)^.value >= ValueStack.at(2)^.value
  then
   ValueStack.at(2)^.value:=1
  else
   ValueStack.at(2)^.value:=0;
  ValueStack.pop;
end;

procedure primSin;
begin
  ValueStack.needs(1);
  ValueStack.top^.sin;
end;

procedure primExp;
begin
  ValueStack.needs(1);
  ValueStack.top^.exp;
end;

procedure primLn;
begin
  ValueStack.needs(1);
  ValueStack.top^.Ln;
end;

procedure primAtn;
begin
  ValueStack.needs(1);
  ValueStack.top^.atn;
end;

procedure primClr;
begin
  ValueStack.clr;
end;

procedure primDup;
begin
  ValueStack.needs(1);
  ValueStack.dup;
end;

procedure primAllot;
begin
  ValueStack.needs(1);
  Inc(Memory.used,trunc(ValueStack.top^.value));
  ValueStack.pop;
end;

procedure primBitBlt;
begin
  ValueStack.needs(1);
  BitBlt:=trunc(ValueStack.top^.value);
  ValueStack.pop;
end;

procedure primStack;
begin
  DisplayStack:=True;
end;

procedure primNoStack;
begin
  DisplayStack:=False;
end;

procedure primPrint;
begin
  ValueStack.needs(1);
  ValueStack.top^.Print;
  ValueStack.pop;
end;

procedure primJmp;
begin
  Memory.ip:=Memory.ip+trunc(ValueStack.top^.value)
             -SizeOf(DataItem)-SizeOf(FpType);
  { ip will be incremented at the end of the Jmp instruction by the amount
    of bytes in the jump instruction and it's inline argument, hence the
    subtraction }
  primDrop;
end;

procedure primJz;
var condition: FpType;
begin
  primSwap;
  condition:=ValueStack.top^.value;
  primDrop;
  if condition=0
  then
   primJmp
  else
   primDrop;
end;

procedure primHere;
begin
  ValueStack.push(Memory.used);
end;

procedure primUntil;
var primNr: WordIndex;
    origin: Address;
begin
  primNr:=Words.locatePrim(primJzNr);
  if primNr=NoMatch
  then
   Words.NotImplemented('Jz')
  else
   begin
     origin:=Memory.used;
     Memory.add(primNr);
     Memory.addF(ValueStack.top^.value-origin);
     primDrop;
   end;
end;

procedure primIf;
var primNr: WordIndex;
begin
  primNr:=Words.locatePrim(primJzNr);
  if primNr=NoMatch
  then
   Words.NotImplemented('Jz')
  else
   begin
     Memory.add(primNr);
     ValueStack.push(Memory.used);
     Memory.addF(0);
     { Destination is unknown yet; push a dummy address and wait for
       patching later on by else or endif }
   end;
end;

procedure primEndif;
begin
  ValueStack.dup;
  ValueStack.top^.value:=ValueStack.top^.value-SizeOf(DataItem);
  { The top of the stack reflects now the location of the 'if' instruction }
  primHere;
  primSwap;
  primSub;
  { Store this address (the destination of the IF jump) in the
    slot space following IF, whose address is already on the stack
  }
  primSwap;
  primStore;
end;

procedure primElse;
var primNr: WordIndex;
begin
  primNr:=Words.locatePrim(primJmpNr);
  if primNr=NoMatch
  then
   Words.NotImplemented('Jmp')
  else
   begin
     Memory.add(primNr);
     ValueStack.push(Memory.used);
     Memory.addF(0);
     { Destination is unknown yet; push a dummy address and wait for
       patching later on by endif }
     primSwap;
     { Now the address from the jz operand of the 'if' word is on top
       of the stack, and can be patched }
     primEndif;
   end;
end;

procedure primForget;
var command: WordIndex;
begin
  GetInput;
  command:=Words.find;
  if command=NoMatch
  then
   Words.Unrecognized(InputLn)
  else
   begin
     Words.size:=command;
     Memory.used:=Words.addr[command];
   end;
end;

procedure primColon;
var newAddress: Address;
begin
  GetInput;
  CurrentWord:=InputLn;
  newAddress:=Words.addHeader(0,False,Compiled);
  Compiling:=True;
end;

procedure primSemiColon;
var newIndex: WordIndex;
begin
  Memory.add(ReturnPrim);
  newIndex:=Words.add(CurrentWord);
  Compiling:=False;
end;

procedure primOffset;
begin
  ValueStack.needs(1);
  ValueStack.top^.value:=ValueStack.top^.value*SizeOf(FpType);
end;

procedure primUpdate;
begin
  Words.update;
end;

procedure primVersion;
begin
  ValueStack.msg('BCL 1.3á Copyright Peter Baltus 1991');
end;
{$F-}

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ End of primitives.                                                       ³
ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
³ Some housekeeping functions and procedures for the user interface follow ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

procedure RefreshDisplay;
var i: Integer;
begin
  primTMode; {Clears display}
  ValueStack.print;
  for i:=1 to ScreenWidth-1
  do
   Write('Ä');
  WriteLn;
end;

function makeNumber: FpType;
var resultCode: Integer;
    resultNr:   FpType;
begin
  Val(InputLn,resultNr,resultCode);
  makeNumber:=resultNr;
end;

function isNumber: Boolean;
var resultCode: Integer;
    resultNr:   FpType;
begin
  Val(InputLn,resultNr,resultCode);
  isNumber:=(resultCode = 0);
end;


{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Command Interpreter -- This routine is the top level handler for user    ³
³ input, comparable to a very primitive shell or command.com               ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

procedure InterpretCommand;
var command: Integer;
    result:  Integer;
    primNr:  WordIndex;
begin
  command:=Words.find;
  if Compiling
  then
   if command=NoMatch
   then
    begin
      if isNumber
      then
       begin
         primNr:=Words.locateprim(PrimLiteralNr);
         if primNr=NoMatch
         then
           Words.NotImplemented('Literal')
         else
          begin
            Memory.add(primNr);
            Memory.addF(makeNumber);
          end;
       end
      else
       ValueStack.Unrecognized(InputLn);
    end
   else
    if Words.isImmediate(command)
    then
     Words.execute(command)
    else
     Memory.add(command)
  else
   begin
     if command=NoMatch
     then
      begin
        if isNumber
        then
         ValueStack.push(makeNumber)
        else
         ValueStack.Unrecognized(InputLn);
      end
     else
      Words.execute(command);
   end;
end;


{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Initialization procedures executed at program startup                    ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

constructor PrimTable.initialize;
begin
  prim[primPrimitiveNr] :=primPrimitive;
  prim[primLiteralNr]   :=primLiteral;
  prim[primJmpNr]       :=primJmp;
  prim[primJzNr]        :=primJz;
  prim[4] :=primSin;
  prim[5] :=primImmediate;
  prim[6] :=primAtn;
  prim[7] :=primExp;
  prim[8] :=primAdd;
  prim[9] :=primSub;
  prim[10]:=primMul;
  prim[11]:=primQuo;
  prim[12]:=primStack;
  prim[13]:=primNoStack;
  prim[14]:=primTMode;
  prim[15]:=primGMode;
  prim[16]:=primPlot;
  prim[17]:=primLine;
  prim[18]:=primDrop;
  prim[19]:=primVlist;
  prim[20]:=primVariable;
  prim[21]:=primConstant;
  prim[22]:=primSave;
  prim[23]:=primLoad;
  prim[24]:=primQuit;
  prim[25]:=primLn;
  prim[26]:=primStore;
  prim[27]:=primRecall;
  prim[28]:=primPrint;
  prim[29]:=primKey;
  prim[30]:=primEmit;
  prim[31]:=primColon;
  prim[32]:=primSemiColon;
  prim[33]:=primForget;
  prim[34]:=primSwap;
  prim[35]:=primArgs;
  prim[36]:=primEquals;
  prim[37]:=primAllot;
  prim[38]:=primDup;
  prim[39]:=primClr;
  prim[40]:=primHere;
  prim[41]:=primUntil;
  prim[42]:=primBitBlt;
  prim[43]:=primLT;
  prim[44]:=primLE;
  prim[45]:=primIf;
  prim[46]:=primEndIf;
  prim[47]:=primOffset;
  prim[48]:=primVersion;
  prim[49]:=primElse;
  prim[50]:=primUpdate;
end;

procedure initialize;
var i: WordIndex;
begin
  DisplayStack:=True;
  Stop:=False;
  Compiling:=False;
  CurrentWord:='';
  BitBlt:=1;
  Words.initialize;
  Primitives.initialize;
  Memory.initialize;
  if ParamCount >= 1
  then
   begin
     InputLn:=ParamStr(1);
     LoadIt;
   end;
  ValueStack.clr;
  if ParamCount >= 2
  then
   begin
     InputLn:=ParamStr(2);
     InterpretCommand;
   end;
end;

procedure CmdLoop;
begin
  repeat
    if not Compiling and DisplayStack then RefreshDisplay;
    GetInput;
    InterpretCommand;
  until Stop=True;
end;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Main Program ...                                                         ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

begin
  Initialize;
  CmdLoop;
end.