old

早期freebsd实现

Berkeley Pascal PI -- Version 3.1 (9/7/85)

Sun Jul 21 14:56 1985  insan.p

    0	TRA4	0 
     1  program insane(input, output);
     2  label
    6	GOTO:1	6 
     3  	1;
     4  type
     5  	alfa = packed array[1..10] of char;
     6  	metaface = (notaface, front, back, top, bottom, left, right);
     7  	face = front .. right;
     8  	metapair = (notapair, one2, three4, five6);
     9  	pair = one2 .. five6;
    10  	metacolor = (notacolor, red, blue, green, white);
    11  	color = red .. white;
    12  	blockno = 1..4;
    13  var
    14  	nosolutions: Boolean;
    15  	index, halfindex: integer;
    16  	pointr: integer;
    17  	datas: array[blockno, face] of alfa;
    18  	sum: array[blockno, pair, color] of integer;
    19  	halfsolution: array[blockno, 1..30] of pair;
   12	TRA4	12 

    21  function word(alf: alfa): color;
    22  begin
    23  	if alf = 'red' then
    24  		word := red else
    25  	if alf = 'blue' then
    26  		word := blue else
    27  	if alf = 'green' then
    28  		word := green else
    29  		word := white;
	patch 12 18
   18	BEG:20	0 
   24	CASE4	12 
   28	CASE4	1 
   32	CASE2	22
   34		"word"
   40	LINO:23
   42	RV:5	32 10 
   48	CONG:10
   50		"red"
   62	RELG	EQ	10 
   66	IF	-2 
   70	LINO:24
   72	LV:5	44 
   76	CON1:1
   78	RANG2:1	4 
   82	AS2
   84	TRA	-2 
	patch 66 20
   88	LINO:25
   90	RV:5	32 10 
   96	CONG:10
   98		"blue"
  110	RELG	EQ	10 
  114	IF	-2 
  118	LINO:26
  120	LV:5	44 
  124	CON1:2
  126	RANG2:1	4 
  130	AS2
  132	TRA	-2 
	patch 114 20
  136	LINO:27
  138	RV:5	32 10 
  144	CONG:10
  146		"green"
  158	RELG	EQ	10 
  162	IF	-2 
  166	LINO:28
  168	LV:5	44 
  172	CON1:3
  174	RANG2:1	4 
  178	AS2
  180	TRA	-2 
	patch 162 20
  184	LINO:29
  186	LV:5	44 
  190	CON1:4
  192	RANG2:1	4 
  196	AS2
	patch 180 16
	patch 132 64
	patch 84 112
  198	END
	patch 18 0
    30  end;
  200	TRA4	200 

    32  procedure readin;
    33  var
    34  	hue: alfa;
    35  	ch: char;
    36  	cube: blockno;
    37  	position: face;
  206	TRA4	206 

    39  procedure tone;
    40  begin
    41  	case ch of
    42  	'r': hue := 'red';
    43  	'w': hue := 'white';
    44  	'g': hue := 'green';
    45  	'b': hue := 'blue';
    46  	end;
	patch 206 214
  214	BEG:20	0 
  220	CASE4	0 
  224	CASE4	1 
  228	CASE2	40
  230		"tone"
  236	LINO:41
  238	RV1:4	-13 
  242	CASE1OP:4
  244	.=.+8
  252	CASE1	114
  253	CASE1	119
  254	CASE1	103
  255	CASE1	98
  256	TRA	-2 
	patch 242 16
  260	LINO:42
  262	LV:4	-12 
  266	CONG:10
  268		"red"
  280	AS:10
  282	TRA	-28 
	patch 244 42
  286	LINO:43
  288	LV:4	-12 
  292	CONG:10
  294		"white"
  306	AS:10
  308	TRA	-54 
	patch 246 68
  312	LINO:44
  314	LV:4	-12 
  318	CONG:10
  320		"green"
  332	AS:10
  334	TRA	-80 
	patch 248 94
  338	LINO:45
  340	LV:4	-12 
  344	CONG:10
  346		"blue"
  358	AS:10
  360	TRA	-106 
	patch 256 106
  364	END
	patch 214 0
    47  end;

    49  begin
    50  	for cube := 1 to 4 do
    51  	begin
    52  		for position := front to right do
    53  		begin
    54  			read(ch);
    55  			tone;
    56  			datas[cube, position] := hue;
    57  		end;
    58  		readln;
    59  	end;
	patch 200 366
  366	BEG:22	0 
  372	CASE4	0 
  376	CASE4	1 
  380	CASE2	49
  382		"readin"
  390	LINO:50
  392	LV:4	-20 
  396	CON1:1
  398	AS24
  400	LV:4	-24 
  404	CON1:4
  406	AS24
  408	RV4:4	-20 
  412	RV4:4	-24 
  416	REL4	LE
  418	IF	-2 
  422	LV:4	-25 
  426	RV4:4	-24 
  430	RANG42:1	4 
  434	AS41
  436	LV:4	-25 
  440	RV4:4	-20 
  444	RANG42:1	4 
  448	AS41
  450	LV:4	-14 
  454	RV14:4	-25 
  458	AS41
  460	LINO:52
  462	LV:4	-32 
  466	CON1:1
  468	AS24
  470	LV:4	-36 
  474	CON1:6
  476	AS24
  478	RV4:4	-32 
  482	RV4:4	-36 
  486	REL4	LE
  488	IF	-2 
  492	LV:4	-37 
  496	RV4:4	-36 
  500	RANG42:1	6 
  504	AS41
  506	LV:4	-37 
  510	RV4:4	-32 
  514	RANG42:1	6 
  518	AS41
  520	LV:4	-15 
  524	RV14:4	-37 
  528	AS41
  530	LINO:54
  532	UNITINP
  534	LV:4	-13 
  538	READC
  540	RSNG2:127
  542	AS21
  544	LINO:55
  546	CALL:2	206 
  552	LINO:56
  554	LV:2	-256 
  558	RV1:4	-25 
  562	INX2:60	1 4 
  568	RV1:4	-37 
  572	INX2:10	1 6 
  578	RV:4	-12 10 
  584	AS:10
  586	LINO:52
  588	RV4:4	-36 
  592	LV:4	-37 
  596	FOR1U:-78
	patch 488 108
  598	LINO:58
  600	UNITINP
  602	READLN
  604	LINO:50
  606	RV4:4	-24 
  610	LV:4	-25 
  614	FOR1U	-168 
	patch 418 198
  618	END
	patch 366 40
    60  end;
  620	TRA4	620 

    62  procedure sumcolors;
    63  var
    64  	cube: blockno;
    65  	side: face;
  626	TRA4	626 
    66  function facepair(aface: face): pair;
    67  begin
    68  	case aface of
    69  	front, back: facepair := one2;
    70  	top, bottom: facepair := three4;
    71  	left, right: facepair := five6
    72  	end;
	patch 626 634
  634	BEG:24	0 
  640	CASE4	4 
  644	CASE4	1 
  648	CASE2	67
  650		"facepair"
  660	LINO:68
  662	RV1:7	33 
  666	CASE1OP:6
  668	.=.+12
  680	CASE1	1
  681	CASE1	2
  682	CASE1	3
  683	CASE1	4
  684	CASE1	5
  685	CASE1	6
  686	TRA	-2 
	patch 666 22
	patch 668 22
  690	LINO:69
  692	LV:7	36 
  696	CON1:1
  698	RANG2:1	3 
  702	AS2
  704	TRA	-20 
	patch 670 40
	patch 672 40
  708	LINO:70
  710	LV:7	36 
  714	CON1:2
  716	RANG2:1	3 
  720	AS2
  722	TRA	-38 
	patch 674 58
	patch 676 58
  726	LINO:71
  728	LV:7	36 
  732	CON1:3
  734	RANG2:1	3 
  738	AS2
  740	TRA	-56 
	patch 686 56
  744	END
	patch 634 0
    73  end;
  746	TRA4	746 

    75  procedure initializesum;
    76  var
    77  	cube: blockno;
    78  	side: face;
    79  	technicolor: color;
    80  begin
    81  	for cube := 1 to 4 do
    82  		for side :=  front to right do
    83  			for technicolor := red to white do
    84  				sum[cube, facepair(side), technicolor] := 0;
	patch 746 754
  754	BEG:28	0 
  760	CASE4	0 
  764	CASE4	1 
  768	CASE2	80
  770		"initializesum"
  784	LINO:81
  786	LV:6	-8 
  790	CON1:1
  792	AS24
  794	LV:6	-12 
  798	CON1:4
  800	AS24
  802	RV4:6	-8 
  806	RV4:6	-12 
  810	REL4	LE
  812	IF	-2 
  816	LV:6	-13 
  820	RV4:6	-12 
  824	RANG42:1	4 
  828	AS41
  830	LV:6	-13 
  834	RV4:6	-8 
  838	RANG42:1	4 
  842	AS41
  844	LV:6	-1 
  848	RV14:6	-13 
  852	AS41
  854	LINO:82
  856	LV:6	-20 
  860	CON1:1
  862	AS24
  864	LV:6	-24 
  868	CON1:6
  870	AS24
  872	RV4:6	-20 
  876	RV4:6	-24 
  880	REL4	LE
  882	IF	-2 
  886	LV:6	-25 
  890	RV4:6	-24 
  894	RANG42:1	6 
  898	AS41
  900	LV:6	-25 
  904	RV4:6	-20 
  908	RANG42:1	6 
  912	AS41
  914	LV:6	-2 
  918	RV14:6	-25 
  922	AS41
  924	LINO:83
  926	LV:6	-32 
  930	CON1:1
  932	AS24
  934	LV:6	-36 
  938	CON1:4
  940	AS24
  942	RV4:6	-32 
  946	RV4:6	-36 
  950	REL4	LE
  952	IF	-2 
  956	LV:6	-37 
  960	RV4:6	-36 
  964	RANG42:1	4 
  968	AS41
  970	LV:6	-37 
  974	RV4:6	-32 
  978	RANG42:1	4 
  982	AS41
  984	LV:6	-3 
  988	RV14:6	-37 
  992	AS41
  994	LINO:84
  996	LV:2	-448 
 1000	RV1:6	-13 
 1004	INX2:48	1 4 
 1010	PUSH:-4
 1012	RV1:6	-25 
 1016	RANG2:1	6 
 1020	CALL:2	626 
 1026	INX2:16	1 3 
 1032	RV1:6	-37 
 1036	INX2:4	1 4 
 1042	CON1
 1044	AS24
 1046	LINO:83
 1048	RV4:6	-36 
 1052	LV:6	-37 
 1056	FOR1U:-74
	patch 952 104
 1058	LINO:82
 1060	RV4:6	-24 
 1064	LV:6	-25 
 1068	FOR1U	-158 
	patch 882 188
 1072	LINO:81
 1074	RV4:6	-12 
 1078	LV:6	-13 
 1082	FOR1U	-242 
	patch 812 272
 1086	END
	patch 754 40
    85  end;

    87  begin
    88  	initializesum;
    89  	for cube := 1 to 4 do
    90  		for side := front to right do
    91  			sum[cube, facepair(side), word(datas[cube,side])] :=
    92  			sum[cube, facepair(side), word(datas[cube,side])] + 1;
	patch 620 1090
 1090	BEG:24	0 
 1096	CASE4	0 
 1100	CASE4	1 
 1104	CASE2	87
 1106		"sumcolors"
 1116	LINO:88
 1118	CALL:2	746 
 1124	LINO:89
 1126	LV:4	-8 
 1130	CON1:1
 1132	AS24
 1134	LV:4	-12 
 1138	CON1:4
 1140	AS24
 1142	RV4:4	-8 
 1146	RV4:4	-12 
 1150	REL4	LE
 1152	IF	-2 
 1156	LV:4	-13 
 1160	RV4:4	-12 
 1164	RANG42:1	4 
 1168	AS41
 1170	LV:4	-13 
 1174	RV4:4	-8 
 1178	RANG42:1	4 
 1182	AS41
 1184	LV:4	-1 
 1188	RV14:4	-13 
 1192	AS41
 1194	LINO:90
 1196	LV:4	-20 
 1200	CON1:1
 1202	AS24
 1204	LV:4	-24 
 1208	CON1:6
 1210	AS24
 1212	RV4:4	-20 
 1216	RV4:4	-24 
 1220	REL4	LE
 1222	IF	-2 
 1226	LV:4	-25 
 1230	RV4:4	-24 
 1234	RANG42:1	6 
 1238	AS41
 1240	LV:4	-25 
 1244	RV4:4	-20 
 1248	RANG42:1	6 
 1252	AS41
 1254	LV:4	-2 
 1258	RV14:4	-25 
 1262	AS41
 1264	LINO:91
 1266	LV:2	-448 
 1270	RV1:4	-13 
 1274	INX2:48	1 4 
 1280	PUSH:-4
 1282	RV1:4	-25 
 1286	RANG2:1	6 
 1290	CALL:2	626 
 1296	INX2:16	1 3 
 1302	PUSH:-4
 1304	LV:2	-256 
 1308	RV1:4	-13 
 1312	INX2:60	1 4 
 1318	RV1:4	-25 
 1322	INX2:10	1 6 
 1328	IND:10
 1330	CALL:1	12 
 1336	INX2:4	1 4 
 1342	LV:2	-448 
 1346	RV1:4	-13 
 1350	INX2:48	1 4 
 1356	PUSH:-4
 1358	RV1:4	-25 
 1362	RANG2:1	6 
 1366	CALL:2	626 
 1372	INX2:16	1 3 
 1378	PUSH:-4
 1380	LV:2	-256 
 1384	RV1:4	-13 
 1388	INX2:60	1 4 
 1394	RV1:4	-25 
 1398	INX2:10	1 6 
 1404	IND:10
 1406	CALL:1	12 
 1412	INX2:4	1 4 
 1418	IND4
 1420	CON1:1
 1422	ADD24
 1424	AS4
 1426	LINO:90
 1428	RV4:4	-24 
 1432	LV:4	-25 
 1436	FOR1U	-186 
	patch 1222 216
 1440	LINO:89
 1442	RV4:4	-12 
 1446	LV:4	-13 
 1450	FOR1U	-270 
	patch 1152 300
 1454	END
	patch 1090 28
    93  end;
 1456	TRA4	1456 

    95  procedure find2222;
    96  var
    97  	subtotals: array[red..white] of integer;
    98  	pair1, pair2, pair3, pair4: pair;
 1462	TRA4	1462 

   100  function two222(pair1, pair2, pair3, pair4: pair): Boolean;
   101  var
   102  	hue: color;
   103  begin
   104  	for hue := red to white do
   105  		subtotals[hue] :=
   106  			sum[1, pair1, hue]+
   107  			sum[2, pair2, hue]+
   108  			sum[3, pair3, hue]+
   109  			sum[4, pair4, hue];
   110  	if (subtotals[red]=2) and
   111  	   (subtotals[blue]=2) and
   112  	   (subtotals[green]=2) and
   113  	   (subtotals[white]=2) then
   114  		two222 := true else
   115  		two222 := false;
	patch 1462 1470
 1470	BEG:22	0 
 1476	CASE4	16 
 1480	CASE4	1 
 1484	CASE2	103
 1486		"two222"
 1494	LINO:104
 1496	LV:6	-8 
 1500	CON1:1
 1502	AS24
 1504	LV:6	-12 
 1508	CON1:4
 1510	AS24
 1512	RV4:6	-8 
 1516	RV4:6	-12 
 1520	REL4	LE
 1522	IF	-2 
 1526	LV:6	-13 
 1530	RV4:6	-12 
 1534	RANG42:1	4 
 1538	AS41
 1540	LV:6	-13 
 1544	RV4:6	-8 
 1548	RANG42:1	4 
 1552	AS41
 1554	LV:6	-1 
 1558	RV14:6	-13 
 1562	AS41
 1564	LINO:105
 1566	LV:4	-16 
 1570	RV1:6	-13 
 1574	INX2:4	1 4 
 1580	LV:2	-448 
 1584	RV1:7	45 
 1588	INX2:16	1 3 
 1594	RV1:6	-13 
 1598	INX2:4	1 4 
 1604	IND4
 1606	LV:2	-448 
 1610	CON1:48
 1612	ADD24
 1614	RV1:7	41 
 1618	INX2:16	1 3 
 1624	RV1:6	-13 
 1628	INX2:4	1 4 
 1634	IND4
 1636	ADD4
 1638	LV:2	-448 
 1642	CON1:96
 1644	ADD24
 1646	RV1:7	37 
 1650	INX2:16	1 3 
 1656	RV1:6	-13 
 1660	INX2:4	1 4 
 1666	IND4
 1668	ADD4
 1670	LV:2	-448 
 1674	CON2	144 
 1678	ADD24
 1680	RV1:7	33 
 1684	INX2:16	1 3 
 1690	RV1:6	-13 
 1694	INX2:4	1 4 
 1700	IND4
 1702	ADD4
 1704	AS4
 1706	LINO:104
 1708	RV4:6	-12 
 1712	LV:6	-13 
 1716	FOR1U	-166 
	patch 1522 196
 1720	LINO:110
 1722	LV:4	-16 
 1726	IND4
 1728	CON1:2
 1730	REL24	EQ
 1732	LV:4	-16 
 1736	CON1:4
 1738	ADD24
 1740	IND4
 1742	CON1:2
 1744	REL24	EQ
 1746	AND
 1748	LV:4	-16 
 1752	CON1:8
 1754	ADD24
 1756	IND4
 1758	CON1:2
 1760	REL24	EQ
 1762	AND
 1764	LV:4	-16 
 1768	CON1:12
 1770	ADD24
 1772	IND4
 1774	CON1:2
 1776	REL24	EQ
 1778	AND
 1780	IF	-2 
 1784	LINO:114
 1786	LV:7	48 
 1790	CON1:1
 1792	RSNG2:1
 1794	AS2
 1796	TRA	-2 
	patch 1780 18
 1800	LINO:115
 1802	LV:7	48 
 1806	CON1
 1808	RSNG2:1
 1810	AS2
	patch 1796 14
 1812	END
	patch 1470 16
   116  end;
 1814	TRA4	1814 

   118  procedure listsolution;
   119  begin