Оптимальный алгоритм спиральной матрицы Опции

[Akusov]

Здравствуйте! Есть задача - написать оптимизированную по размеру исполняемого файла без ассемблерных вставок(можно использовать прерывания) программу для заполнения матрицы по спирали для случаев от 1 до 9. Задачу решил и написал самый оптимизированный алгоритм, который я смог из себя выдавить. Скажите, что ещё здесь можно оптимизировать или уже стоит приступать к замене ввода на безэховый и вывода через прерывания? Может от каких переменных избавиться? Или циклы оптимизировать можно?

 
program spiral;
var
 m: array [1..9, 1..9] of word; //Сама матрица
 n: word; //Размерность матрицы
 i: word; //Индексы матрицы
 j: word;
 c: word; //Вводимое число
 l: word; //Длина стороны
 s: integer; //Флаг меняющийся между значениями -1 и 1
 t: word; //Координата поворота
 p: ^word; //Указатель на координаты
begin
 readln(n);
 l := n;
 t := n;
 s := 1;
 i := 1;
 p := @j;
 repeat
  p^ := p^ + s;
  c := c + 1;
  //Если достигнута точка поворота
  if p^ = t then begin
   //Меняем изменяемую координату
   if p = @j
    then begin
     p := @i;
     l := l - 1;
    end else begin 
     p := @j;
     s := -s;
    end;
   //Узнаём координату следующего поворота
   t := p^ + s*(l);
  end;
  m[i,j] := c;
 until l = 0;
 //Обычный вывод
 for i:=1 to n do begin
  for j:=1 to n do write(m[i,j]:3);
  writeln;
 end;
end.

[Akusov]

Пораскинув мозгами, смог ужать итоговый екзешник до 1952 байт, но дальше чего-то не двигается. Может я чего-то в этом коде просто в упор не вижу, как оптимизировать? Любое удаление if или mod с div приводит к существенном ощутимому уменьшению. Есть какие-нибудь идеи?

uses dos;
var
 m: array [1..81] of word;
 s: integer;
 r: registers;
 f: boolean;
begin
 with r do begin
  ah := 7;
  msdos®;
  di := al - 48;
  ah := 2;
  bx := di;
  es := di;
  s := 1;
  repeat
   cx := cx + 1;
   si := si + s;
   if cx = es then begin
     if abs(s) = 1
      then begin
       s := di;
       bx := bx - 1;
      end else begin
       s := 1;
       f := not f;
      end;
    if f then s := -s;
    es := cx + bx;
   end;
   m[si] := cx;
  until bx = 0;
  repeat
   bx := bx + 1;
   dl := m[bx] div 10 + 48;
   msdos®;
   dl := m[bx] mod 10 + 48;
   msdos®;
   dl := 32;
   msdos®;
   if bx mod di = 0 then begin
   dl := 10;
   msdos®;
   end;
 until bx = cx;
 end;
end.