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