Obfuscatory Xmas Fun

In the Delphi Developer group on fb, Erik Johnson provided ths very interesting, antique, snippet.

// This obfuscated pascal code worked in delphi last I tried.  
// I recommend running it today or tomorrow as its message is best today or tomorrow.  
// I wish I could provide credit... I found this in the 1990s as a winner of some contest for 
// obfuscated pascal.  

{$APPTYPE CONSOLE}
program XMas;

function t_ (t, _ : Integer; a : PChar) : Integer;
begin
  if t>1 then
   begin
     if t<3 then
       t_(-79,-13,a+t_(-87,1-_,t_(-86,0,a+1)+a));
     if t<_ then
        t_(t+1,_,a);
     if (t_(-94,-27+t,a)<>0) and (t=2) then
        if _< 13 then
           result:=t_(2,_+1,'%s %d %d'#13)
        else result:=9
        else result:=16
   end
  else
  if t<0 then
    if t<-72 then
       result:=t_(_,t,'@n''+,#''/*{}w+/w#cdnr/+,'+
                      '{}r/*de}+,/*{*+,/w{%+,/w#q#n+,/#{l+,/n{n+,/+#n+,/#;#q#n+,/+k#;*+,/''r :'''  +
                      'd*''3,}{w+K w''K:''+}e#'';dq#''l q#''+d''K#!/+k#;q#''r}eKK#}w''r}eKK{nl]''' +
                      '/#;#q#n''){)#}w''){){nl]''/+#n'';d}rw'' i;# ){nl]!/n{n#''; r{#w''rnc{nl]'   +
                      '''/#{l,+''K {rw'' iK{;[{nl]''/w#q#n''wk nw'' iwk{KK{nl]!/w{%''l##w#'' i;'   +
                      ':{nl]''/*{q#''ld;r''}{nlwb!/*df}''c ;;{nl''-{}rw]''/+,}##''*}#nc,'',#nw]''' +
                      '/+kd''+e}+;#''rdq#w! nr''/ '') }+}{rl#''{n'' '')# }''+}##(!!/')
  else if t<-50 then
     if _=Ord(a^) then begin
        result:=Ord(a[31]);
        if a[31]=#13 then
           WriteLn
        else
           Write(a[31]);
     end else
  result:=t_(-65,_,a+1) else
  result:=t_(Ord(a^='/')+t,_,a+1) else
  if 0<t then
     result:=t_(2,2,'%s')
 else
     result:=Ord((a^='/') or (t_(0,t_(-61,Ord(a^),
                                       '!ek;dc i@bK''(q)-[w]*%n+r3#l,{}:'#13'uwloc' +
                                       'a-O;m .vpbks,fxntdCeghiry'),a+1)<>0))
end;

begin
  t_ (1, 10000, '');
  Readln;
end.

Running the code results in a (possibly surprising) …

On the first day of Christmas my true love gave to me
a partridge in a pear tree.

On the second day of Christmas my true love gave to me
two turtle doves
and a partridge in a pear tree.

etc etc

1 Like

I tried getting Claude.io to provide some insight … I dunno if we could have made much progress …

But the solution has been worked out long ago. Erik added :

I guess it was ported from C and is really from the 80s.
https://stackoverflow.com/.../logic-of-12-days-of-christmas

The stackoverflow link from 2012 is a good start.

It notes that there is a character string used as a cypher to translate normal ascii characters into less meaningful chars.

And the included archive.org link from Microsoft Research, 29th December 2008, sets it out pretty nicely.

https://web.archive.org/web/20081229212711/http://research.microsoft.com/en-us/um/people/tball/papers/xmasgift/final.html

#include <stdio.h>

/* the original set of strings */

static char *strings = 

"@n'+,#'/*{}w+/w#cdnr/+,{}r/*de}+,/*{*+,/w{%+,/w#q#n+,/#{l+,/n{n+,/+#n+,/#\
;#q#n+,/+k#;*+,/'r :'d*'3,}{w+K w'K:'+}e#';dq#'l \
q#'+d'K#!/+k#;q#'r}eKK#}w'r}eKK{nl]'/#;#q#n'){)#}w'){){nl]'/+#n';d}rw' i;# \
){nl]!/n{n#'; r{#w'r nc{nl]'/#{l,+'K {rw' iK{;[{nl]'/w#q#n'wk nw' \
iwk{KK{nl]!/w{%'l##w#' i; :{nl]'/*{q#'ld;r'}{nlwb!/*de}'c \
;;{nl'-{}rw]'/+,}##'*}#nc,',#nw]'/+kd'+e}+;#'rdq#w! nr'/ ') }+}{rl#'{n' ')# \
}'+}##(!!/";

/* the translation mapping */

static char *translate =
                                
"!ek;dc i@bK'(q)-[w]*%n+r3#l,{}:\nuwloca-O;m .vpbks,fxntdCeghiry";

#define FIRST_DAY  1
#define LAST_DAY  12

/* the original "indices" of the various strings */

enum {
   ON_THE = 0,
   FIRST = -1,
   TWELFTH = -12,
   DAY_OF_CHRISTMAS = -13,
   TWELVE_DRUMMERS_DRUMMING = -14,
   ELEVEN_PIPERS_PIPING = -15, 
   TWO_TURTLE_DOVES_AND_A = -24,
   PARTRIDGE_IN_A_PEAR_TREE = -25
};

/* skip -n strings (separator is /), where n is a negative value */

char* skip_n_strings(int n,char *s) {
  if (n == 0)
    return s;

  if (*s=='/')
    return skip_n_strings(n+1,s+1);
  else
    return skip_n_strings(n,s+1);
}

/* find the character in the translation buffer matching c and output
   the translation */

void translate_and_put_char(char c, char *trans) {
  if (c == *trans)
    putchar(trans[31]);
  else
    translate_and_put_char(c,trans+1);
}

void output_chars(char *s) {
  if (*s == '/')
    return;
  translate_and_put_char(*s,translate);
  output_chars(s+1);
}

/* skip to the "n^th" string and print it */

void print_string(int n) {
     output_chars(skip_n_strings(n,strings));
}

void inner_loop(int count_day, int current_day) {
  if (count_day == FIRST_DAY) {
    print_string(ON_THE);               /* "On the " */
    print_string(-current_day);         /* twelve days, ranges from -1 to -12 */
    print_string(DAY_OF_CHRISTMAS);     /* "day of Christmas ..." */
  }

  if (count_day < current_day)     /* inner iteration */
    inner_loop(count_day+1,current_day);

  print_string(PARTRIDGE_IN_A_PEAR_TREE+(count_day-1));   /* print the gift */
}

void outer_loop(int count_day, int current_day) {
  inner_loop(count_day,current_day);
  if (count_day == FIRST_DAY && current_day < LAST_DAY)  /* outer iteration */
    outer_loop(1,current_day+1);
}

void main() {
  outer_loop(1,1);
}
1 Like

This is the translation scheme …

Encoded : !ek;dc i@bK'(q)-[w]*%n+r3#l,{}:
Decoded : ♀uwloca-O;m .vpbks,fxntdCeghiry

where ‘:female_sign:’ means Carriage Return ($13, 0x13).

So the long string is actually :

On the /first/second/third/fourth/fifth/sixth/seventh/eigth/ninth/tenth/eleventh/twelfth/
day of Christmas my true love gave to me /twelve drummers drumming,
/eleven pipers piping, /ten lords a-leaping, /nine ladies dancing,
/eight maids a-milking, /seven swans a-swimming, /six geese a-laying,
/five gold rings; /four calling birds, /three french hens,
/two turtle doves and /a partridge in a pear tree. /

Getting back to Claude …

After I found out about the decoding / encoding pairing, I gave that info to Claude.

It didn’t get there on its own (neither did I) … but I thought the last part was a pretty good effort.

Actually, on closer inspection, it’s kinda right AND wrong at the same time. :slight_smile:

1 Like

That is a quite remarkable attempt by Claude though. Very impressive.