spamsink | Этюд для программистов-шампольонов

Под катом приведена вроде бы цельная программа на мёртвом языке POP-2, делающая вид, что играет в крестики-нолики 4х4х4. Пока не выяснено, имеется ли в нашем распоряжении работающий компилятор для этого конкретного диалекта языка. Желающим предлагается по наитию перевести эту программу на какой-нибудь более современный язык и выяснить, насколько сильно она играет.

Не удивляйтесь, программа начинается и кончается по нынешним меркам внезапно (но с обоих концов логично, так что, по всей видимости, ничего не утрачено).

ERASE->CUCHOUT;
VARS MYLIST FORCEMOVES LINES POINTS OWNER LENS USEDPTS
     BOARD A1 LINEO THISLINE COUNT1 COUNT2 X3 X2 COUNT3 X1
     A3 A2 COUNT SCALE RANSEED
     FORMLINES GETSPACE MOVEVALUE VALUES
     TESTFORCE FREEPT FINDL UNMOVE UNWRAP MOVEIT HISMOVE
     PRINTBOARD MYITEMREAD CNTFOR;
  
FUNCTI SETUP;VARS X;
  INIT(64)->BOARD; INIT(64)->USEDPTS;
  INIT(76)->LENS;INIT(76)->OWNER;
  INIT(64)->POINTS; 76->X;
L1: 4->SUBSCR(X,LENS); 0->SUBSCR(X,OWNER);
  IF X<65 THEN
    INIT(8)->SUBSCR(X,POINTS); 1->SUBSCR(X,USEDPTS);
     0->SUBSCR(X,BOARD)
  CLOSE;
  X-1->X; IF X>0 THEN GOTO L1 CLOSE;
  INIT(76)->LINES; .FORMLINES;
  NIL->FORCEMOVES; 0->MYLIST;
END;
  
FUNCTI MOVE X A B;VARS T U V W Y Z;
   SUBSCR(X,POINTS)->Y; 1->Z;0->U;
  IF B THEN .GETSPACE->T; CLOSE;
L1: SUBSCR(Z,Y)->W;
  IF W<0 THEN
    IF B THEN T;X CLOSE;
    0->SUBSCR(X,USEDPTS); U EXIT;
  SUBSCR(W,LENS)->V;
  IF B THEN V+SUBSCR(W,OWNER)->SUBSCR(Z,T) CLOSE;
  IF SUBSCR(W,OWNER)=0 THEN
    IF V=0 THEN GOTO L2 CLOSE;
    A->SUBSCR(W,OWNER);3->SUBSCR(W,LENS);
  ELSEIF SUBSCR(W,OWNER)=A THEN 
   V-1->SUBSCR(W,LENS);
   IF V=1 THEN 1->U CLOSE;
  ELSE 0->SUBSCR(W,OWNER);0->SUBSCR(W,LENS);
  CLOSE;
L2: Z+1->Z; GOTO L1;
END;
  
FUNCTI LINEFORM; VARS Y Z;
  4->COUNT1; INIT(4)->THISLINE;
L1: X+1->SUBSCR(COUNT1,THISLINE);
     SUBSCR(X+1,USEDPTS)->Y; SUBSCR(X+1,POINTS)->Z;
   LINEO->SUBSCR(Y,Z); -1->SUBSCR(Y+1,Z);
   Y+1->SUBSCR(X+1,USEDPTS); X+A1->X;
   COUNT1-1->COUNT1; IF COUNT1>0 THEN GOTO L1 CLOSE;
   THISLINE->SUBSCR(LINEO,LINES);
  LINEO+1->LINEO
END;
  
FUNCTI GETSPACE;
  IF MYLIST=0 THEN INIT(8)
  ELSE MYLIST; SUBSCR(8,MYLIST)->MYLIST
  CLOSE;
END;
  
FUNCTI FREESPACE X;
  MYLIST->SUBSCR(8,X);X->MYLIST;
END;
  
FUNCTI FORMLINES;
  1->A1;4->A2;16->A3;1->LINEO;
L1: 0->X;1->X1;4->COUNT3;
L5: X->X2;X->X3;
L2: 4->COUNT2;
L3: .LINEFORM;
  X2+A2->X2;
  X2->X;COUNT2-1->COUNT2;
 IF COUNT2>0 THEN GOTO L3 CLOSE;
 X3+A3->X3;X3->X2;X3->X;COUNT3-1->COUNT3;
 IF COUNT3>0 THEN GOTO L2 CLOSE;
 IF X1>0 THEN X1-1->X1;A3;A2;A1;A2+A1;
    A3->A2->A1;0->X;GOTO L5
 CLOSE;
 IF X1=0 THEN X1-1->X1;->X;A1-X-X->A1;X;
   IF A1>0 THEN A1->X
   ELSE -A1->A1;3->X;
   CLOSE;GOTO L5
 CLOSE;
 ->A3->A1->A2;
 IF A1>1THEN GOTO L1 CLOSE;
 0->X; 21->A1; .LINEFORM;
 3->X;19->A1; .LINEFORM;
 12->X;13->A1; .LINEFORM;
 15->X;11->A1; .LINEFORM;
1->X;
L4: 1->SUBSCR(X,USEDPTS);
    X+1->X;IF X<65 THEN GOTO L4 CLOSE;
END;
   
FUNCTI TESTMOVES; VARS X A B C D P1 P2;
  FINDL(1,0)->X;
  IF X/=0 THEN
L4: X.FREEPT->A;
    IF SUBSCR(X,OWNER)=8 THEN A EXIT;
   FINDL(1,X)->B;
   IF B/=0 THEN B->X; GOTO L4 CLOSE;
   IF FORCEMOVES.NULL THEN
L5:    A
   EXIT;
   IF A=HD(FORCEMOVES) THEN GOTO L0 CLOSE;
PR('i}iTE O{ibKY B TESTFORCE');
   NIL->FORCEMOVES;GOTO L5
 CLOSE;
 IF NOT(NULL(FORCEMOVES)) THEN 
L0: HD(FORCEMOVES); TL(FORCEMOVES)->FORCEMOVES;
 EXIT;
 8->P1;16->P2;
  100->CNTFOR;
 IF .TESTFORCE THEN GOTO L0 CLOSE;
 P1;P2->P1;->P2;
  50->CNTFOR;
 IF .TESTFORCE THEN HD(FORCEMOVES); NIL->FORCEMOVES; EXIT;
 INTOF(SCALE* .RANDOM)->COUNT; COUNT->COUNT1;
 IF SCALE>4 THEN SCALE//2->SCALE->X;
 CLOSE;
  -1000000->X; .VALUES; 1->D;
L1: IF D=65 THEN C EXIT;
  IF SUBSCR(D,USEDPTS)=0 THEN GOTO L2 CLOSE;
 MOVEVALUE(D,Y,Z,V,W)->B;
 IF B>X THEN
   COUNT1->COUNT;
L3: B->X;D->C;
   ELSEIF B=X THEN
     IF COUNT>1 THEN COUNT-1->COUNT;GOTO L3 CLOSE;
 CLOSE;
L2: D+1->D; GOTO L1
END;
   
FUNCTI TESTFORCE; VARS X W FIRST;
  CNTFOR-1->CNTFOR;
  0->X;
L4: FINDL(2,X)->X;
   IF X=0 THEN 0 EXIT;
   IF SUBSCR(X,OWNER)=P2 THEN GOTO L4 CLOSE;
   1->FIRST;
   X.FREEPT->Y->W;
L2: MOVE(W,P1,1)->V; MOVE(Y,P2,1)->V;
L3: FINDL(1,0)->Z;
  IF Z>0 THEN
L5:IF SUBSCR(Z,OWNER)=P1 THEN Z.FREEPT::NIL->FORCEMOVES; .UNWRAP EXIT;
   FINDL(1,Z)->V;
   IF V THEN V->Z; GOTO L5 CLOSE;
   MOVE(Z.FREEPT,P1,1)->V;
   FINDL(1,0)->V;
   IF V=0 THEN GOTO L7 CLOSE;
L6:IF SUBSCR(V,OWNER)=P2 THEN
L7:  .UNMOVE; GOTO L1;
   CLOSE;
   FINDL(1,V)->Z;
   IF Z THEN Z->V; GOTO L6 CLOSE;
   MOVE(V.FREEPT,P2,1)->V;
   GOTO L3
CLOSE;
  IF CNTFOR AND .TESTFORCE THEN .UNWRAP EXIT;
L1: .UNMOVE; ->Y; Y.UNMOVE; IF Y/=W THEN GOTO L1 CLOSE;
   IF FIRST THEN
     0->FIRST; X.FREEPT->W->Y; GOTO L2
CLOSE;
  GOTO L4
END
   
FUNCTI UNMOVE T X;VARS Z U V W;
  1->SUBSCR(X,USEDPTS);
  SUBSCR(X,POINTS)->Z; 1->U;
L1: SUBSCR(U,Z)->V;
   IF V<0 THEN FREESPACE(T) EXIT;
   SUBSCR(U,T)->W;
   LOGAND(W,7)->SUBSCR(V,LENS);
   LOGAND(W,24)->SUBSCR(V,OWNER);
  U+1->U; GOTO L1
END;
  
FUNCTI UNWRAP;
L1: .UNMOVE; ->X;X.UNMOVE;
  X::FORCEMOVES->FORCEMOVES;
  IF X/=W THEN GOTO L1 CLOSE;
1 END;
  
FUNCTI FINDL Y X;
L1: X+1->X; IF X=77 THEN 0 EXIT;
   IF SUBSCR(X,LENS)=Y THEN X EXIT;
   GOTO L1;
END;
   
FUNCTI VALUES; VARS X;
  0->Y;0->Z;0->V;0->W;1->X;
L1: IF SUBSCR(X,LENS)=2 THEN
    IF SUBSCR(X,OWNER)=P2 THEN Y+1->Y
    ELSE Z+1->Z
    CLOSE;
 ELSEIF SUBSCR(X,LENS)=3 THEN
    IF SUBSCR(X,OWNER)=P2 THEN V+1->V
    ELSE W+1->W
    CLOSE;
  CLOSE;
  X+1->X; IF X<77 THEN GOTO L1 CLOSE;
END;
  
FUNCTI MOVEVALUE X A B C D;VARS W Y Z;
SUBSCR(X,POINTS)->X; 1->Z;
L1: SUBSCR(Z,X)->W;
   IF W<0 THEN C-4 *D+16 *A-32  *B EXIT;
   SUBSCR(W,LENS)->Y;
   IF Y=4 THEN C+1->C
   ELSEIF Y=3 THEN
    IF SUBSCR(W,OWNER)=P2 THEN A+1->A ELSE D-1->D CLOSE;
   ELSEIF Y=2 THEN
    IF SUBSCR(W,OWNER)=P1 THEN B-1->B CLOSE
   CLOSE;
  Z+1->Z;GOTO L1
END;
  
FUNCTI FREEPT X;VARS Y Z;
1->Y; SUBSCR(X,LINES)->X;
  L1: SUBSCR(Y,X)->Z;
  IF SUBSCR(Z,USEDPTS)=1 THEN Z CLOSE;
Y+1->Y; IF Y<5 THEN GOTO L1 CLOSE;
END;
  
FUNCTI MOVEIT X; MOVE(X,8,0);
  8->SUBSCR(X,BOARD);
  (((X-1)//4)//4).PR;.PR;.PR; .PRINTBOARD;
END;
   
FUNCTI HISMOVE; VARS L M N;
L0: PRSTRING('YOUR MOVE');
L1: .MYITEMREAD->L; IF L="RESIGN" THEN L EXIT;
   IF L="HELP" THEN
     IF NOT(NULL(FORCEMOVES)) THEN
      PRSTRING('I CAN WIN NO MATTER WHAT YOU DO.');
      GOTO L0
     CLOSE;
        FINDL(1,0)->L;IF L>0 THEN L.FREEPT->C;GOTO L8 CLOSE;
      16->P1;8->P2;
  100->CNTFOR;
      IF TESTFORCE() THEN
        LENGTH(FORCEMOVES)->M;HD(FORCEMOVES)->N;
        PRSTRING('YOU CAN FORCE A WIN IN');PR(M);
        PRSTRING(' MOVES, STARTING AT');
L5:    (((N-1)//4)//4).PR;.PR;.PR;
        1.NL;NIL->FORCEMOVES; GOTO L0
      CLOSE;
      P1;P2->P1;->P2;
  50->CNTFOR;
      IF .TESTFORCE THEN
       HD(FORCEMOVES)->N;
       PRSTRING('I AM IN A STRONG POSITION. HOWEVER, TRY');
       GOTO L5
      CLOSE;
      -1000000->X; .VALUES; 1->D;
L6: IF D=65 THEN
L8:      PRSTRING('TRY');(((C-1)//4)//4).PR;.PR;.PR;
         1.NL;GOTO L0
       CLOSE;
      IF SUBSCR(D,USEDPTS)=0 THEN GOTO L7 CLOSE;
      MOVEVALUE(D,Y,Z,V,W)->B;
     IF B>X THEN B->X; D->C CLOSE;
L7: D+1->D; GOTO L6
  CLOSE;
  IF ISCOMPND(L) THEN GOTO L1 CLOSE;
  IF L<0 OR L>3 THEN
L2:      PRSTRING('NO SUCH POSITION. PLEASE RETYPE.');
     GOTO L0;
    CLOSE;
L3: .MYITEMREAD->M;
    IF ISCOMPND(M) THEN GOTO L3 CLOSE;
    IF M<0 OR M>3 THEN GOTO L2 CLOSE;
L4: .MYITEMREAD->N;
    IF ISCOMPND(N) THEN GOTO L4 CLOSE;
    IF N<0 OR N>3 THEN GOTO L2 CLOSE;
    16*L+4*M+N+1->L;
    IF SUBSCR(L,BOARD)/=0 THEN
      PRSTRING('THAT POSITION IS ALREADY OCCUPIED. STOP
TRYING TO CHEAT.');
    GOTO L0
CLOSE;
    MOVE(L,16,0);
    16->SUBSCR(L,BOARD);
END;
    
FUNCTI PRINTBOARD; VARS X Y Z;
   2.NL;5.SP;0.PR;8.SP;1.PR;8.SP;2.PR;8.SP;3.PR;
   2.NL;4->X;
L1: 2.SP;0.PR;1.PR;2.PR;3.PR;X-1->X; IF X>0 THEN GOTO L1 CLOSE;
   0->Y;1->Z;
L2: 1.NL;Y.PR;4->X;4->W;
L3: 1.SP;
   IF SUBSCR(Z,BOARD)=0 THEN PR(".")
   ELSEIF SUBSCR(Z,BOARD)=16 THEN PR("X")
   ELSE PR("O")
   CLOSE;
   Z+1->Z;X-1->X;
   IF X>0 THEN GOTO L3 CLOSE;
   W-1->W;
IF W>0 THEN 4->X;Z+12->Z;2.SP;GOTO L3 CLOSE;
   Y+1->Y;
   IF Y<4 THEN Z-48->Z;GOTO L2 CLOSE;
   2.NL;
END;
   
ITEMREAD->MYITEMREAD;
   
FUNCTI PLAY;
    .SETUP; INTOF(100*POPTIM())->RANSEED;
L1: 1.NL;
  PRSTRING('DO YOU KNOW HOW TO PLAY AGAINST THIS PROGRAM');
    .MYITEMREAD->X;
    IF X="YES" THEN GOTO L3 CLOSE;
L2: PRSTRING('THE GAME IS PLAYED ON A 4*4*4 CUBE. THE OBJECT
BEING TO PLACE 4 PIECES IN A STRAIGHT LINE; YOUR
PIECES ARE SHOWN AS X , MINE AS O . TO MAKE A
MOVE YOU HAVE TO TYPE IN 3 NUMBERS, INDICATING
PLANE, ROW AND COLUMN; EACH IN THE RANGE 0 TO 3.
THUS IN THE BOARD SHOWN BELOW, YOU HAVE A PIECE
AT 1 3 2  AND I HAVE ONE AT 2 0 3.');
   16->SUBSCR(31,BOARD); 8->SUBSCR(36,BOARD);
   .PRINTBOARD;
    0->SUBSCR(31,BOARD); 0->SUBSCR(36,BOARD);
'YOU CAN ASK THEN COMPUTER TO SUGGEST A MOVE BY TYPING  HELP
AND CAN CONCEDE BY TYPING  RESIGN
'.PRSTRING;
L3: 'DO YOU WANT TO START
'.PRSTRING;
   .MYITEMRE->X; .PRINTBOARD;
   IF X="YES" THEN 16->SCALE; GOTO L4 ELSE 8->SCALE; GOTO L6 CLOSE;
L4: .HISMOVE->X;
    IF X="RESIGN" THEN
     IF NULL(FORCEMOVES) THEN
      PRSTRING('I HAD NOT REALISED THAT MY POSITION WAS IMPREGNABLE.
')  ELSE  PRSTRING('FAIR ENOUGH.  ')
   CLOSE;
   GOTO L5
   CLOSE;
IF X THEN .PRINTBOARD; PRSTRING('YOU WIN.  ');GOTO L5 CLOSE;
L6: 1.NL;PRSTRING('MY MOVE'); .TESTMOVES;
  IF .MOVEIT THEN 1.NL;PRSTRING('I WIN.  '); GOTO L5 CLOSE;
  GOTO L4;
L5: PRSTRING('DO YOU WANT TO PLAY AGAIN');
  .MYITEMREAD->X;
   IF X="YES" THEN .SETUP; GOTO L3 CLOSE;
   PRSTRING('BACK TO POP2 THEN');
END;
   
VARS RANSEED;FUNCTI RANDOM;
(125*RANSEED+1)//16384; .ERASE;->RANSEED;
RANSEED/16384;END;
CHAROUT->CUCHOUT;4.NL;
PRSTRING('TO ENTER PROGRAM, TYPE  FOURS;
');
VARS OPERATION 1 FOURS;
PLAY->NONOP FOURS;

Публикуется, если верить гуглопоиску по текстовым сообщениям, впервые.

Flat | Top-Level Comments Only

From:

yatur.livejournal.com

Hwæt! We Gardena in geardagum,
þeodcyninga, þrym gefrunon,
hu ða æþelingas ellen fremedon.
Oft Scyld Scefing sceaþena þreatum?

spamsink

Примерно так и читается, да. Хотя прошло более чем на порядок меньше лет.

b0p0h0k.livejournal.com

Зять-датчанин говорит, что разбирает лишь редкие отдельные слова.
Вот бы живого исландца спросить.

bangor-flying.livejournal.com

Это же Беовульф. Современный исландец по идее и не должен такое понимать на архаичном чужом языке, если он не лингвист. Я не исландец, но в принципе, если читать внимательно подстрочник, обнаруживается достаточно много сходства с немецким - почти как "Слово о полку Игореве" для русского или что-то из этой серии.

Ну уж и чужом!
Пусть специалисты меня поправят (стр.41), но я не думаю, что древнеанглийский Х-го века так уж сильно отличался от древнескандинавского того же периода (dansk tunga).
В то же время известно, что современные исландцы довольно свободно читают древнескандинавские тексты.

В сети до сих пор где-то есть (в часности в ru-etymology) простыни дискуссий , в которых я отстаиваю точку зрения о том, что древние исландцы и донорманнские англосаксы вполне понимали языки друг друга. Но сейчас я поменял свою точку зрения или просто подхожу теперь к вопросу более строго и формально, оставляя точные заключения профильным специалистам. В принципе, я считал, что по состоянию на десятый век все носители живых на тот момент германских языков, включая скандинавов, могли при необходимости объяснится друг с другом. С момента начала распада группы прошла тогда примерно тысяча лет, это видимо, примерно крайний срок для сохранения понимания и есть, плюс-минус столетие. Примерно так же если славянские начали распадаться в шестом, то полное взаимпонимание между всеми потомками должно было исчезнуть где-то к шестнадцатому веку, что вроде бы близко к реальной картине.

Edited Date: 2016-12-20 09:44 pm (UTC)

amigofriend.livejournal.com

Поймать бы гада и выбить на скрижалях.

Скрижали жалко!

vak

PR('i}iTE O{ibKY B TESTFORCE');

Тут русские буквы были, очевидно.

Конечно. Я нарочно не стал исправлять.

softmaster.livejournal.com

неожиданно выяснилось, что моя школьная "Агатовская" рапира - это Расширенный Адаптированный Поплан-Интерпретатор, Редактор, Архив, а ПОПЛАН — интерпретатора языка POP-2.

пойду в резюме писать, что работал c POP-2 %)

Не поймут-с. Или по крайней мере не оценят-с. А декларированная прелесть оригинального POP-2 была в том, что у него был не интерпретатор, а инкрементный компилятор.

Playing poohsticks in the Styx

For entertainment purposes only

Этюд для программистов-шампольонов

Этюд для программистов-шампольонов

no subject

no subject

no subject

no subject

no subject

no subject

no subject

no subject

no subject

no subject

no subject

no subject

Profile

April 2026

Most Popular Tags

Page Summary

Active Entries

Style Credit

Expand Cut Tags