Language: Pascal


Author:  Wang TianXing (gztxwang@public1.guangzhou.gd.cn)

program s;const p='program s;const p=';a='a';aa=''';';aaa='a=''';aaaa
='''';aaaaa='begin	write(p,aaaa,p,aa,aaa,a,aa,a,aaa,aaaa,aa,aa,a,a,
aaa,aaa,aaaa,aa,a,a,a,aaa,aaaa,aaaa,aa,a,a,a,a,aaa,aaaaa,aa,aaaaa)
end.';begin	write(p,aaaa,p,aa,aaa,a,aa,a,aaa,aaaa,aa,aa,a,a,aaa,aaa,
aaaa,aa,a,a,a,aaa,aaaa,aaaa,aa,a,a,a,a,aaa,aaaaa,aa,aaaaa)end.

Author:  Geoffrey A Swift (blimey@toke.com)

const a='const a=';b='begin write(a,#39,a,#39#59#98#61#39,b,#39#59#10,b) end.';
begin write(a,#39,a,#39#59#98#61#39,b,#39#59#10,b) end.


Author: Wang TianXing (gztxwang@public1.guangzhou.gd.cn)

const a='const a=';b=';begin write(a,#39,a,#39#59#98#61#39,b,
#39,b)end.';begin write(a,#39,a,#39#59#98#61#39,b,#39,b)end.


Author: Oliver Heen
Notes: This program works in Borland Turbo-Pascal (not std Pascal or ucsd). 


CONST T=';BEGIN WRITE(#67#79#78#83#84#32#84#61#39,T,#39,T)END.';BEGIN WRITE(#67#79#78#83#84#32#84#61#39,T,#39,T)END.


Author: Torben Mogensen

const a=''';begin write(be,b,a:1,a,a:4,b,be,a:3,b,b,a:1,a)end.';be='const a';b='=''';begin write(be,b,a:1,a,a:4,b,be,a:3,b,b,a:1,a)end.



Author: Torben Mogensen
Notes: Some compilers may choke without a declaration of input

program s;const a=''';begin writeln(be,b,a:1,a,a:4,b,be,a:3,b,b,a:1,a)end.';be='program s;const a';b='=''';begin writeln(be,b,a:1,a,a:4,b,be,a:3,b,b,a:1,a)end.


Author: Torben Mogensen
Notes: Fixes the above problem

program s(output);const a='program s(output);const a';b
=''';begin writeln(a,p,a,b:3);writeln(p,b:1,b,b:2);writeln(a:1,p,p,b:1,b)end.';
p='=''';begin writeln(a,p,a,b:3);writeln(p,b:1,b,b:2);writeln(a:1,p,p,b:1,b)end.


Author: Gary Lewandowski

program Fixedpoint(output); const A='program Fixedpoint(output); const A='; B='; begin writeln(A,chr(39),A,chr(39),chr(59),chr(32),chr(66),chr(61),chr(39),B,chr(39),B) end.'; begin writeln(A,chr(39),A,chr(39),chr(59),chr(32),chr(66),chr(61),chr(39),B,chr(39),B) end.


Author:  Martin Sheppard (sheppard@apanix.apana.org.au)

var a,b:string;begin a:='var a,b:string;begin a:=';
b:='write(a,#39,a,#39#59#98#58#61#39,b,#39#59,b);end.';
write(a,#39,a,#39#59#98#58#61#39,b,#39#59,b);end.


Author: Chris Burns (chris-b@cs.auckland.ac.nz)
Note: THINK pascal

program y;const t='program y;const t=;q=chr(39);begin
write(t:18,q,t,q,omit(t,0,19))end.';q=chr(39);begin
write(t:18,q,t,q,omit(t,0,19))end.


Author: Dan Hoey(hoey@aic.nrl.navy.mil)

program s;const bbb='program s;const bbb';a='a';b='b';bb=');writeln(';
aa='''';ab='=''';ba=''';';
aaa='begin writeln(bbb,ab,bbb,ba,a,ab,a,ba,b,ab,b,ba,b,b,ab,bb,ba';
aba='a,a,ab,aa,aa,ba,a,b,ab,ab,aa,ba,b,a,ab,aa,ba,ba';
abb='a,a,a,ab,aaa,ba);writeln(a,b,a,ab,aba,ba);writeln(a,b,b,ab,abb,ba';
baa='b,a,a,ab,baa,ba);writeln(b,a,b,ab,bab,ba);writeln(aaa,bb';
bab='aba,bb);writeln(abb);writeln(bb,baa);writeln(bb,bab)end.';
begin writeln(bbb,ab,bbb,ba,a,ab,a,ba,b,ab,b,ba,b,b,ab,bb,ba);writeln(
a,a,ab,aa,aa,ba,a,b,ab,ab,aa,ba,b,a,ab,aa,ba,ba);writeln(
a,a,a,ab,aaa,ba);writeln(a,b,a,ab,aba,ba);writeln(a,b,b,ab,abb,ba
);writeln(b,a,a,ab,baa,ba);writeln(b,a,b,ab,bab,ba);writeln(aaa,bb
);writeln(aba,bb);writeln(abb);writeln(bb,baa);writeln(bb,bab)end.


Author: Unknown

program ritchie; const ma = 12; a: array[1..ma] of string = (
'var j : integer;',
'procedure p (s : string; c : boolean); var i : integer; begin',
'  if c then write ('''''''');',
'  for i := 1 to length (s) do',
'  if c and (s[i]='''''''') then write ('''''''''''') else write (s[i]);',
'  if c then begin',
'    if j < ma then writeln ('''''','') else writeln ('''''');'')',
'  end else writeln; end ;',
'begin writeln',
'  (''program ritchie; const ma='', ma, ''; a: array[1..ma] of string = ('');',
'  for j := 1 to ma do p (a[j], true);',
'  for j := 1 to ma do p (a[j], false); end.');
var j : integer;
procedure p (s : string; c : boolean); var i : integer; begin
  if c then write ('''');
  for i := 1 to length (s) do
  if c and (s[i]='''') then write ('''''') else write (s[i]);
  if c then begin
    if j < ma then writeln (''',') else writeln (''');')
  end else writeln; end ;
begin writeln
  ('program ritchie; const ma=', ma, '; a: array[1..ma] of string = (');
  for j := 1 to ma do p (a[j], true);
  for j := 1 to ma do p (a[j], false); end.


Author: Luca Caucci (caucci@cs.unibo.it)


program SelfReproducing(Input, Output);
{
        Questo programma visualizza il suo codice sorgente.
        Autore: Luca Caucci (e-mail: caucci@cs.unibo.it)
}

type
        StrType = array[1..24] of array[1..60] of char;

const
        Str: StrType = (
                'program SelfReproducing(Input, Output);%n{%n%tQuesto progra#',
                'mma visualizza il suo codice sorgente.%n%tAutore: Luca Cauc#',
                'ci (e-mail: caucci@cs.unibo.it)%n}%n%ntype%n%tStrType = arr#',
                'ay[1..24] of array[1..60] of char;%n%nconst%n%tStr: StrType#',
                ' = (%n%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n\#',
                '%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q\#',
                '%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n#',
                '%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q\#',
                '%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n%t%t%q%s%q,%n#',
                '%t%t%q%s%q,%n%t%t%q%s%q%n%t);%n%tSingleQuotes: char = %q%q\#',
                '%q%q;%n%nvar%n%ti, j, k, h: integer;%n%nbegin%n%ti := 1;%n\#',
                '%th := 1;%n%twhile Str[i, 1] <> %q%\%q do begin%n%t%tj := 1#',
                ';%n%t%twhile Str[i, j] <> %q%#%q do begin%n%t%t%tif Str[i, #',
                'j] = %q%%%q then begin%n%t%t%t%tinc(j);%n%t%t%t%tcase Str[i#',
                ', j] of%n%t%t%t%t%t%q%#%q : write(%q%#%q);%n%t%t%t%t%t%q%\\#',
                '%q : write(%q%\%q);%n%t%t%t%t%t%q%%%q : write(%q%%%q);%n%t\#',
                '%t%t%t%t%qq%q : write(SingleQuotes);%n%t%t%t%t%t%qn%q : wri#',
                'teln;%n%t%t%t%t%t%qt%q : write(%q%t%q);%n%t%t%t%t%t%qs%q : #',
                'begin%n%t%t%t%t%t%tfor k := 1 to 60 do%n%t%t%t%t%t%t%twrite#',
                '(Str[h, k]);%n%t%t%t%t%t%tinc(h);%n%t%t%t%t%tend;%n%t%t%t%t#',
                'end;%n%t%t%tend else%n%t%t%t%tif Str[i, j] <> %q%\%q then%n#',
                '%t%t%t%t%twrite(Str[i, j]);%n%t%t%tinc(j);%n%t%tend;%n%t%ti#',
                'nc(i);%n%tend;%nend.%n%n\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\#',
                '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\#'
        );
        SingleQuotes: char = '''';

var
        i, j, k, h: integer;

begin
        i := 1;
        h := 1;
        while Str[i, 1] <> '\' do begin
                j := 1;
                while Str[i, j] <> '#' do begin
                        if Str[i, j] = '%' then begin
                                inc(j);
                                case Str[i, j] of
                                        '#' : write('#');
                                        '\' : write('\');
                                        '%' : write('%');
                                        'q' : write(SingleQuotes);
                                        'n' : writeln;
                                        't' : write('        ');
                                        's' : begin
                                                for k := 1 to 60 do
                                                        write(Str[h, k]);
                                                inc(h);
                                        end;
                                end;
                        end else
                                if Str[i, j] <> '\' then
                                        write(Str[i, j]);
                        inc(j);
                end;
                inc(i);
        end;
end.






Author: Unknown

program self(input, output);
type s = string[255]; n=integer;
var a : array [1..100] of s; i,j : integer;
function t(a:integer):integer; begin if a<7 then t:=a else t:=a+11 end; function q(a:s):s;
 var j:n;begin for j:=strlen(a)downto 1 do if a[j]=#39 then strinsert(#39,a,j);q:=a;end;
begin
   a[1] := 'program self(input, output);';
   a[2] := 'type s = string[255]; n=integer;';
   a[3] := 'var a : array [1..100] of s; i,j : integer;';
   a[4] := 'function t(a:integer):integer; begin if a<7 then t:=a else t:=a+11 end; function q(a:s):s;';
   a[5] := ' var j:n;begin for j:=strlen(a)downto 1 do if a[j]=#39 then strinsert(#39,a,j);q:=a;end;';
   a[6] := 'begin';
   a[18] := '   for i := 1 to 11 do begin setstrlen(a[i+6], 0);';
   a[19] := '      strwrite(a[i+6],1,j,''   a['',t(i):1,''] := '''''', q(a[t(i)]), '''''';'');';
   a[20] := '   end;';
   a[21] := '   for i := 1 to 22 do writeln(a[i]);';
   a[22] := 'end.';
   for i := 1 to 11 do begin setstrlen(a[i+6], 0);
      strwrite(a[i+6],1,j,'   a[',t(i):1,'] := ''', q(a[t(i)]), ''';');
   end;
   for i := 1 to 22 do writeln(a[i]);
end.


Author: Daniel Martin

Program Dolly;
const
  prelines = 9;
  numlines = 23;
var
  myself : array [1..numlines] of string[100];
  i, j : integer;

begin
  myself[1] := 'Program Dolly;';
  myself[2] := 'const';
  myself[3] := '  prelines = 9;';
  myself[4] := '  numlines = 23;';
  myself[5] := 'var';
  myself[6] := '  myself : array [1..numlines] of string[100];';
  myself[7] := '  i, j : integer;';
  myself[8] := '';
  myself[9] := 'begin';
  myself[10] := '';
  myself[11] := '  for i := 1 to prelines do writeln(myself[i]);';
  myself[12] := '  for i := 1 to numlines do';
  myself[13] := '    begin';
  myself[14] := '      write(''  myself['', i:1, ''] := '''''');';
  myself[15] := '      for j := 1 to length(myself[i]) do';
  myself[16] := '        begin';
  myself[17] := '          if myself[i,j] = '''''''' then write('''''''');';
  myself[18] := '	  write(myself[i,j]);';
  myself[19] := '	end;';
  myself[20] := '      writeln('''''';'');';
  myself[21] := '    end;';
  myself[22] := '  for i := prelines+1 to numlines do writeln(myself[i]);';
  myself[23] := 'end.';

  for i := 1 to prelines do writeln(myself[i]);
  for i := 1 to numlines do
    begin
      write('  myself[', i:1, '] := ''');
      for j := 1 to length(myself[i]) do
        begin
          if myself[i,j] = '''' then write('''');
	  write(myself[i,j]);
	end;
      writeln(''';');
    end;
  for i := prelines+1 to numlines do writeln(myself[i]);
end.



Author:Francois Grieu (fgrieu@micronet.fr)

PROGRAM AUTO;
TYPE
  STR=STRING[255];
VAR
  C:ARRAY[0..15] OF STR;
  I:INTEGER;
BEGIN
  C[ 0]:='''';
  C[ 1]:='  C[';
  C[ 2]:=']:=';
  C[ 3]:=';';
  C[ 4]:='PROGRAM AUTO;';
  C[ 5]:='TYPE';
  C[ 6]:='  STR=STRING[255];';
  C[ 7]:='VAR';
  C[ 8]:='  C:ARRAY[0..15] OF STR;';
  C[ 9]:='  I:INTEGER;';
  C[10]:='BEGIN';
  C[11]:='  FOR I:=4 TO 10 DO WRITELN(C[I]);';
  C[12]:='  WRITELN(C[1],0:2,C[2],C[0],C[0],C[0],C[0],C[3]);';
  C[13]:='  FOR I:=1 TO 15 DO WRITELN(C[1],I:2,C[2],C[0],C[I],C[0],C[3]);';
  C[14]:='  FOR I:=11 TO 15 DO WRITELN(C[I]);';
  C[15]:='END.';
  FOR I:=4 TO 10 DO WRITELN(C[I]);
  WRITELN(C[1],0:2,C[2],C[0],C[0],C[0],C[0],C[3]);
  FOR I:=1 TO 15 DO WRITELN(C[1],I:2,C[2],C[0],C[I],C[0],C[3]);
  FOR I:=11 TO 15 DO WRITELN(C[I]);
END.


Author: Antti T Tuominen (attuomin@cc.Helsinki.FI)

program Itsekehu(output);
const Moritz=23;
var komennot:array[1..Moritz] of string[50];
    i,j:integer;
procedure tulosta;
begin
  for i:=1 to Moritz do writeln(komennot[i]);
end;
procedure tulkkaa;
begin
  for i:=1 to Moritz do begin
    write('  komennot[',i:1,']:=''');
    for j:=1 to length(komennot[i]) do begin
      if komennot[i][j]='''' then write('''''')
      else write(komennot[i][j]);
    end;
    writeln(''';');
  end;
  writeln('  tulosta;');
  writeln('  tulkkaa;');
  writeln('end.');
end;
begin
  komennot[1]:='program Itsekehu(output);';
  komennot[2]:='const Moritz=23;';
  komennot[3]:='var komennot:array[1..Moritz] of string[50];';
  komennot[4]:='    i,j:integer;';
  komennot[5]:='procedure tulosta;';
  komennot[6]:='begin';
  komennot[7]:='  for i:=1 to Moritz do writeln(komennot[i]);';
  komennot[8]:='end;';
  komennot[9]:='procedure tulkkaa;';
  komennot[10]:='begin';
  komennot[11]:='  for i:=1 to Moritz do begin';
  komennot[12]:='    write(''  komennot['',i:1,'']:='''''');';
  komennot[13]:='    for j:=1 to length(komennot[i]) do begin';
  komennot[14]:='      if komennot[i][j]='''''''' then write('''''''''''')';
  komennot[15]:='      else write(komennot[i][j]);';
  komennot[16]:='    end;';
  komennot[17]:='    writeln('''''';'');';
  komennot[18]:='  end;';
  komennot[19]:='  writeln(''  tulosta;'');';
  komennot[20]:='  writeln(''  tulkkaa;'');';
  komennot[21]:='  writeln(''end.'');';
  komennot[22]:='end;';
  komennot[23]:='begin';
  tulosta;
  tulkkaa;
end.


Author: Oliver Heen
Notes: This program is described by the author as "Self Recognizing". The output is true if and only if the input is the
same as the source code. Turbo Pascal. 

CONST A=';VAR S,T:STRING;BEGIN READLN(S);READLN(T); WRITELN(S+T=#67#79#78#83#84#32#65#61#39+A+#39+A)END.'
;VAR S,T:STRING;BEGIN READLN(S);READLN(T);WRITELN(S+T=#67#79#78#83#84#32#65#61#39+A+#39+A)END.

Author: Geoffrey A. Swift
Note: Palindromic

program margrop(output);

const
  quote=char(39);
  semicolon=char(59);
  prefix=char(97)+char(91);
  suffix=char(93)+char(58)+char(61);

function reverse(s:String) : String;
var
  r: String;
  i: Integer;

begin
  r := Copy(s, 0, 0);
  for i := 1 to length(s) do
    r := s[i] + r;
  reverse := r
end;

var
  a:array[0..40] of string;

procedure display(i:integer;reversed:boolean);
begin
  if reversed then
    writeln(semicolon,quote,reverse(a[i]),quote,reverse(suffix),i mod 10,i div 10,reverse(prefix))
  else
    writeln(prefix,i div 10,i mod 10,suffix,quote,a[i],quote,semicolon)
end;

var
  i: Integer;
begin
a[00]:='program margrop(output);';
a[01]:='';
a[02]:='const';
a[03]:='  quote=char(39);';
a[04]:='  semicolon=char(59);';
a[05]:='  prefix=char(97)+char(91);';
a[06]:='  suffix=char(93)+char(58)+char(61);';
a[07]:='';
a[08]:='function reverse(s:String) : String;';
a[09]:='var';
a[10]:='  r: String;';
a[11]:='  i: Integer;';
a[12]:='';
a[13]:='begin';
a[14]:='  r := Copy(s, 0, 0);';
a[15]:='  for i := 1 to length(s) do';
a[16]:='    r := s[i] + r;';
a[17]:='  reverse := r';
a[18]:='end;';
a[19]:='';
a[20]:='var';
a[21]:='  a:array[0..40] of string;';
a[22]:='';
a[23]:='procedure display(i:integer;reversed:boolean);';
a[24]:='begin';
a[25]:='  if reversed then';
a[26]:='    writeln(semicolon,quote,reverse(a[i]),quote,reverse(suffix),i mod 10,i div 10,reverse(prefix))';
a[27]:='  else';
a[28]:='    writeln(prefix,i div 10,i mod 10,suffix,quote,a[i],quote,semicolon)';
a[29]:='end;';
a[30]:='';
a[31]:='var';
a[32]:='  i: Integer;';
a[33]:='begin';
a[34]:='  for i := 0 to 33 do writeln(a[i]);';
a[35]:='  for i := 0 to 40 do display(i,false);';
a[36]:='  for i := 34 to 40 do writeln(a[i]);';
a[37]:='  for i := 40 downto 34 do writeln(reverse(a[i]));';
a[38]:='  for i := 40 downto 0 do display(i,true);';
a[39]:='  for i := 33 downto 0 do writeln(reverse(a[i]));';
a[40]:='end.';
  for i := 0 to 33 do writeln(a[i]);
  for i := 0 to 40 do display(i,false);
  for i := 34 to 40 do writeln(a[i]);
  for i := 40 downto 34 do writeln(reverse(a[i]));
  for i := 40 downto 0 do display(i,true);
  for i := 33 downto 0 do writeln(reverse(a[i]));
end.
.dne
;))]i[a(esrever(nletirw od 0 otnwod 33 =: i rof  
;)eurt,i(yalpsid od 0 otnwod 04 =: i rof  
;))]i[a(esrever(nletirw od 43 otnwod 04 =: i rof  
;)]i[a(nletirw od 04 ot 43 =: i rof  
;)eslaf,i(yalpsid od 04 ot 0 =: i rof  
;)]i[a(nletirw od 33 ot 0 =: i rof  
;'.dne'=:]04[a
;';))]i[a(esrever(nletirw od 0 otnwod 33 =: i rof  '=:]93[a
;';)eurt,i(yalpsid od 0 otnwod 04 =: i rof  '=:]83[a
;';))]i[a(esrever(nletirw od 43 otnwod 04 =: i rof  '=:]73[a
;';)]i[a(nletirw od 04 ot 43 =: i rof  '=:]63[a
;';)eslaf,i(yalpsid od 04 ot 0 =: i rof  '=:]53[a
;';)]i[a(nletirw od 33 ot 0 =: i rof  '=:]43[a
;'nigeb'=:]33[a
;';regetnI :i  '=:]23[a
;'rav'=:]13[a
;''=:]03[a
;';dne'=:]92[a
;')nolocimes,etouq,]i[a,etouq,xiffus,01 dom i,01 vid i,xiferp(nletirw    '=:]82[a
;'esle  '=:]72[a
;'))xiferp(esrever,01 vid i,01 dom i,)xiffus(esrever,etouq,)]i[a(esrever,etouq,nolocimes(nletirw    '=:]62[a
;'neht desrever fi  '=:]52[a
;'nigeb'=:]42[a
;';)naeloob:desrever;regetni:i(yalpsid erudecorp'=:]32[a
;''=:]22[a
;';gnirts fo ]04..0[yarra:a  '=:]12[a
;'rav'=:]02[a
;''=:]91[a
;';dne'=:]81[a
;'r =: esrever  '=:]71[a
;';r + ]i[s =: r    '=:]61[a
;'od )s(htgnel ot 1 =: i rof  '=:]51[a
;';)0 ,0 ,s(ypoC =: r  '=:]41[a
;'nigeb'=:]31[a
;''=:]21[a
;';regetnI :i  '=:]11[a
;';gnirtS :r  '=:]01[a
;'rav'=:]90[a
;';gnirtS : )gnirtS:s(esrever noitcnuf'=:]80[a
;''=:]70[a
;';)16(rahc+)85(rahc+)39(rahc=xiffus  '=:]60[a
;';)19(rahc+)79(rahc=xiferp  '=:]50[a
;';)95(rahc=nolocimes  '=:]40[a
;';)93(rahc=etouq  '=:]30[a
;'tsnoc'=:]20[a
;''=:]10[a
;';)tuptuo(porgram margorp'=:]00[a
nigeb
;regetnI :i  
rav

;dne
)nolocimes,etouq,]i[a,etouq,xiffus,01 dom i,01 vid i,xiferp(nletirw    
esle  
))xiferp(esrever,01 vid i,01 dom i,)xiffus(esrever,etouq,)]i[a(esrever,etouq,nolocimes(nletirw    
neht desrever fi  
nigeb
;)naeloob:desrever;regetni:i(yalpsid erudecorp

;gnirts fo ]04..0[yarra:a  
rav

;dne
r =: esrever  
;r + ]i[s =: r    
od )s(htgnel ot 1 =: i rof  
;)0 ,0 ,s(ypoC =: r  
nigeb

;regetnI :i  
;gnirtS :r  
rav
;gnirtS : )gnirtS:s(esrever noitcnuf

;)16(rahc+)85(rahc+)39(rahc=xiffus  
;)19(rahc+)79(rahc=xiferp  
;)95(rahc=nolocimes  
;)93(rahc=etouq  
tsnoc

;)tuptuo(porgram margorp