[ENH] DES with Plugin

Duane Maxwell dmaxwell at entrypoint.com
Thu Jan 27 02:09:57 UTC 2000


Change Set:		DES
Date:			26 January 2000
Author:			Duane Maxwell

This class implements the Data Encryption Standard (DES) block cipher per
ANSI X3.92.  It requires the presence of the 'DESPlugin'.  At some future
date the functionality of the plugin may be provided in pure Smalltalk, but
the slowness would be prohibitive for anything other than trivial usage.
The main barrier to translation is the heavy use of zero-based indexing of
arrays.

How to use: you first provide an 8-byte key which will be used to encode
and decode the data. Internally, this is 'cooked' into a 32-word format to
speed up the encryption process.  The data is then sent in 8-byte packets
to be encoded or decoded.  You must externally account for padding.  See
the 'testing' category on the class side for examples.

As of this date (1/26/2000), the U.S. Government has lifted many of the
previous restrictions on the export of encryption software, but you should
check before exporting anything including this code.

Macintosh plugin included.
-------------- next part --------------
'From Squeak2.7 of 5 January 2000 [latest update: #1782] on 26 January 2000
at 6:08:42 pm'!
"Change Set:		DES
Date:			26 January 2000
Author:			Duane Maxwell

This class implements the Data Encryption Standard (DES) block cipher per
ANSI X3.92.  It requires the presence of the 'DESPlugin'.  At some future
date the functionality of the plugin may be provided in pure Smalltalk, but
the slowness would be prohibitive for anything other than trivial usage.
The main barrier to translation is the heavy use of zero-based indexing of
arrays.

How to use: you first provide an 8-byte key which will be used to encode
and decode the data. Internally, this is 'cooked' into a 32-word format to
speed up the encryption process.  The data is then sent in 8-byte packets
to be encoded or decoded.  You must externally account for padding.  See
the 'testing' category on the class side for examples.

As of this date (1/26/2000), the U.S. Government has lifted many of the
previous restrictions on the export of encryption software, but you should
check before exporting anything including this code."!

Object subclass: #DES
	instanceVariableNames: 'cookedKey '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Data Encryption Standard'!
InterpreterPlugin subclass: #DESPlugin
	instanceVariableNames: 'byteBit bigByte pc1 pc2 totRot sp1 sp2 sp3
sp4 sp5 sp6 sp7 sp8 '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Data Encryption Standard'!

!DES commentStamp: '<historical>' prior: 0!
This class implements the Data Encryption Standard (DES) block cipher per
ANSI X3.92.  It requires the presence of the 'DESPlugin'.  At some future
date the functionality of the plugin may be provided in pure Smalltalk, but
the slowness would be prohibitive for anything other than trivial usage.
The main barrier to translation is the heavy use of zero-based indexing of
arrays.

How to use: you first provide an 8-byte key which will be used to encode
and decode the data. Internally, this is 'cooked' into a 32-word format to
speed up the encryption process.  The data is then sent in 8-byte packets
to be encoded or decoded.  You must externally account for padding.  See
the 'testing' category on the class side for examples.

As of this date (1/26/2000), the U.S. Government has lifted many of the
previous restrictions on the export of encryption software, but you should
check before exporting anything including this code.

Submitted by Duane Maxwell.

!

!DES reorganize!
('public' key:encode: transform:)
('primitives' primCookKey:mode:to: primPluginAvailable primTransform:using:)
!


!DES methodsFor: 'public' stamp: 'DSM 1/26/2000 16:33'!
key: aByteArray encode: aBoolean
	self primPluginAvailable ifFalse: [self error: 'DES plugin missing'].
	aByteArray size = 8 ifFalse: [ self error: 'DES key must be 8 bytes'].
	cookedKey _ WordArray new: 32.
	cookedKey atAllPut: 0.
	self primCookKey: aByteArray mode: (aBoolean ifTrue: [1] ifFalse:
[0]) to: cookedKey.

	! !

!DES methodsFor: 'public' stamp: 'DSM 1/25/2000 19:09'!
transform: aByteArray
	self primPluginAvailable ifFalse: [self error: 'DES plugin missing'].
	cookedKey ifNil: [ self error: 'DES key not provided'].
	cookedKey size = 32 ifFalse: [ self error: 'DES cooked key damaged'].
	aByteArray size = 8 ifFalse: [ self error: 'DES block must be 8
bytes'].
	self primTransform: aByteArray using: cookedKey

	! !

!DES methodsFor: 'primitives' stamp: 'DSM 1/25/2000 23:10'!
primCookKey: aByteArray mode: flag to: cooked
	<primitive: 'primitiveDESCookKey' module: 'DESPrims'>
	^ self primitiveFailed

	! !

!DES methodsFor: 'primitives' stamp: 'DSM 1/25/2000 18:32'!
primPluginAvailable
	<primitive: 'primitiveDESPluginAvailable' module: 'DESPrims'>
	^ true! !

!DES methodsFor: 'primitives' stamp: 'DSM 1/25/2000 17:40'!
primTransform: aByteArray using: cooked
	<primitive: 'primitiveDESTransform' module: 'DESPrims'>
	^ self primitiveFailed! !


!DES class methodsFor: 'testing' stamp: 'DSM 1/26/2000 17:43'!
test1
	"
	DES test1
	"
	| d plain key |
	plain _ ByteArray new: 8.
	key _ ByteArray new: 8.
	#(16r01 16r23 16r45 16r67 16r89 16rAB 16rCD 16rE7) doWithIndex: [ :c :i |
		plain at: i put: c ].
	#(16r01 16r23 16r45 16r67 16r89 16rAB 16rCD 16rEF) doWithIndex: [
:c :i |
		key at: i put: c ].
	d _ DES new key: key encode: true.
	d transform: plain.
	#(16rC9 16r57 16r44 16r25 16r6A 16r5E 16rD3 16r1D) doWithIndex: [
:c :i |
		c = (plain at: i) asInteger ifFalse: [self error: 'failed']].
! !

!DES class methodsFor: 'testing' stamp: 'DSM 1/26/2000 17:50'!
test2
	"
	DES test2
	"
	| d plain key |
	plain _ 'Squeaker'.
	key _ 'Bite me!!'.
	d _ DES new key: key encode: true.
	d transform: plain.
	#(254 141 73 104 43 44 242 206) doWithIndex: [ :c :i |
		c = ((plain at: i) asInteger) ifFalse: [self error: 'DES
failed on encode!!']].
	d _ DES new key: key encode: false.
	d transform: plain.
	plain = 'Squeaker' ifFalse: [ self error: 'DES failed on decode!!']
! !


!DESPlugin commentStamp: '<historical>' prior: 0!
This plugin implements the Data Encryption Standard (DES).

You should build this plugin with the module name 'DESPrims'.

See class comments for 'DES' for usage.

Submitted by Duane Maxwell
!

!DESPlugin reorganize!
('support' checkedBytePtrOf: checkedWordPtrOf: cookKey:to: encrypt:with:
processKey:mode:to: scrunch:to: unscrunch:to:)
('primitives' primitiveDESCookKey primitiveDESPluginAvailable
primitiveDESTransform)
!


!DESPlugin methodsFor: 'support' stamp: 'DSM 1/24/2000 23:32'!
checkedBytePtrOf: oop
	"Return the first indexable word of oop which is assumed to be
variableByteSubclass"
	self returnTypeC:'unsigned char *'.
	interpreterProxy success: (interpreterProxy isBytes: oop).
	^self cCoerce: (interpreterProxy firstIndexableField: oop) to:
'unsigned char *'
! !

!DESPlugin methodsFor: 'support' stamp: 'DSM 1/24/2000 23:32'!
checkedWordPtrOf: oop
	"Return the first indexable word of oop which is assumed to be
variableWordSubclass"
	self returnTypeC:'unsigned long *'.
	interpreterProxy success: (interpreterProxy isWords: oop).
	^self cCoerce: (interpreterProxy firstIndexableField: oop) to:
'unsigned long *'
! !

!DESPlugin methodsFor: 'support' stamp: 'DSM 1/25/2000 23:01'!
cookKey: rawPtr to: cookPtr
	"preprocess the key to more useful format"

	| raw0 raw1 cook |
	self var: 'cook' declareC: 'unsigned long cook'.
	self var: 'cookPtr' declareC: 'unsigned long *cookPtr'. "32 words"
	self var: 'rawPtr' declareC: 'unsigned long *rawPtr'. "32 words"
	self var: 'raw0' declareC: 'unsigned long raw0'.
	self var: 'raw1' declareC: 'unsigned long raw1'.
	0 to: 15 do: [ :i |
		raw0 _ rawPtr at: i*2.
		raw1 _ rawPtr at: i*2 + 1.
		cook _ (raw0 bitAnd: 16r00FC0000) << 6.
		cook _ cook bitOr: (raw0 bitAnd: 16r00000FC0) << 10.
		cook _ cook bitOr: (raw1 bitAnd: 16r00FC0000) >> 10.
		cook _ cook bitOr: (raw1 bitAnd: 16r00000FC0) >> 6.
		cookPtr at: (i * 2) put: cook.
		cook _ (raw0 bitAnd: 16r0003F000) << 12.
		cook _ cook bitOr: (raw0 bitAnd: 16r0000003F) << 16.
		cook _ cook bitOr: (raw1 bitAnd: 16r0003F000) >> 4.
		cook _ cook bitOr: (raw1 bitAnd: 16r0000003F).
		cookPtr at: (i*2+1) put: cook.
		].

! !

!DESPlugin methodsFor: 'support' stamp: 'DSM 1/26/2000 16:35'!
encrypt: dataPtr with: key
	| fVal work right left |
	self var: 'dataPtr' declareC: 'unsigned long *dataPtr'.
	self var: 'key' declareC: 'unsigned long *key'.
	self var: 'fVal' declareC: 'unsigned long fVal'.
	self var: 'work' declareC: 'unsigned long work'.
	self var: 'right' declareC: 'unsigned long right'.
	self var: 'left' declareC: 'unsigned long left'.

	left _ dataPtr at: 0.
	right _ dataPtr at: 1.

	"perform required but otherwise pointless bit twizzling"
	work _ ((left >> 4) bitXor: right) bitAnd: 16r0F0F0F0F.
	right _ right bitXor: work.
	left _ left bitXor: (work << 4).
	work _ ((left >> 16) bitXor: right) bitAnd: 16r0000FFFF.
	right _ right bitXor: work.
	left _ left bitXor: (work << 16).
	work _ ((right >> 2) bitXor: left) bitAnd: 16r33333333.
	left _ left bitXor: work.
	right _ right bitXor: (work << 2).
	work _ ((right >> 8) bitXor: left) bitAnd: 16r00FF00FF.
	left _ left bitXor: work.
	right _ right bitXor: (work << 8).
	right _ ((right << 1) bitOr: ((right >> 31) bitAnd: 1)) bitAnd: 16rFFFFFFFF.
	work _ (left bitXor: right) bitAnd: 16rAAAAAAAA.
	left _ left bitXor: work.
	right _ right bitXor: work.
	left _ ((left << 1) bitOr: ((left >> 31) bitAnd: 1)) bitAnd:
16rFFFFFFFF.

	"perform the 8 rounds of real encryption"
	0 to: 28 by: 4 do: [ :round |
		work _ right << 28 bitOr: right >> 4.
		work _ work bitXor: (key at: round).
		fVal _ sp7 at: (work bitAnd: 16r3F).
		fVal _ fVal bitOr: (sp5 at: (work >> 8 bitAnd: 16r3F)).
		fVal _ fVal bitOr: (sp3 at: (work >> 16 bitAnd: 16r3F)).
		fVal _ fVal bitOr: (sp1 at: (work >> 24 bitAnd: 16r3F)).

		work _ right bitXor: (key at: round+1).
		fVal _ fVal bitOr: (sp8 at: (work bitAnd: 16r3F)).
		fVal _ fVal bitOr: (sp6 at: (work >> 8 bitAnd: 16r3F)).
		fVal _ fVal bitOr: (sp4 at: (work >> 16 bitAnd: 16r3F)).
		fVal _ fVal bitOr: (sp2 at: (work >> 24 bitAnd: 16r3F)).
		left _ left bitXor: fVal.

		work _ left << 28 bitOr: left >> 4.
		work _ work bitXor: (key at: round+2).
		fVal _ sp7 at: (work bitAnd: 16r3F).
		fVal _ fVal bitOr: (sp5 at: (work >> 8 bitAnd: 16r3F)).
		fVal _ fVal bitOr: (sp3 at: (work >> 16 bitAnd: 16r3F)).
		fVal _ fVal bitOr: (sp1 at: (work >> 24 bitAnd: 16r3F)).

		work _ left bitXor: (key at: round+3).
		fVal _ fVal bitOr: (sp8 at: (work bitAnd: 16r3F)).
		fVal _ fVal bitOr: (sp6 at: (work >> 8 bitAnd: 16r3F)).
		fVal _ fVal bitOr: (sp4 at: (work >> 16 bitAnd: 16r3F)).
		fVal _ fVal bitOr: (sp2 at: (work >> 24 bitAnd: 16r3F)).
		right _ right bitXor: fVal.
		].

	"undo the pointless twizzling"
	right _ right<<31 bitOr: right>>1.
	work _ (left bitXor: right) bitAnd: 16rAAAAAAAA.
	left _ left bitXor: work.
	right _ right bitXor: work.
	left _ left<<31 bitOr: left>>1.
	work _ (left>>8 bitXor: right) bitAnd: 16r00FF00FF.
	right _ right bitXor: work.
	left _ left bitXor: work<<8.
	work _ (left >> 2 bitXor: right) bitAnd: 16r33333333.
	right _ right bitXor: work.
	left _ left bitXor: work<<2.
	work _ (right>>16 bitXor: left) bitAnd: 16r0000FFFF.
	left _ left bitXor: work.
	right _ right bitXor: work<<16.
	work _(right>>4 bitXor: left) bitAnd: 16r0F0F0F0F.
	left _ left bitXor: work.
	right _ right bitXor: work<<4.

	dataPtr at: 0 put: right.
	dataPtr at: 1 put: left.

	! !

!DESPlugin methodsFor: 'support' stamp: 'DSM 1/26/2000 00:32'!
processKey: keyPtr mode: encode to: cookedPtr
	| l m n pc1m pcr rawKey |
	self var: 'cookedPtr' declareC: 'unsigned long *cookedPtr'.
	self var: 'keyPtr' declareC: 'unsigned char *keyPtr'.
	self var: 'pc1m' declareC: 'unsigned char pc1m[56]'.
	self var: 'pcr' declareC: 'unsigned char pcr[56]'.
	self var: 'rawKey' declareC: 'unsigned long rawKey[32]'.
	self cCode: '/* Who is Keyser Soze? */' inSmalltalk: [pcr _ 1. pc1m
_ 1. rawKey _ 1].
	0 to: 55 do: [ :j |
		l _ pc1 at: j.
		m _ l bitAnd: 7.
		((((keyPtr at: (l >> 3)) bitAnd: (byteBit at: m))) ~= 0)
			ifTrue: [ pc1m at: j put: 1 ]
			ifFalse: [ pc1m at: j put: 0].
		].
	0 to: 15 do: [ :i |
		encode ifFalse: [ m _ 15 - i << 1] ifTrue: [m _ i << 1].
		n _ m + 1.
		rawKey at: m put: (rawKey at: n put: 0).
		0 to: 27 do: [ :j |
			l _ j + (totRot at: i).
			l<28 ifTrue: [pcr at: j put: (pc1m at: l)] ifFalse:
[pcr at: j put: (pc1m at: l-28)].
			].
		28 to: 55 do: [ :j |
			l _ j + (totRot at: i).
			l<56 ifTrue: [pcr at: j put: (pc1m at: l)] ifFalse:
[pcr at: j put: (pc1m at: l-28)].
			].
		0 to: 23 do: [ :j |
			(pcr at: (pc2 at: j)) ~= 0 ifTrue:
				[rawKey at: m put: ((rawKey at: m) bitOr:
(bigByte at: j))].
			(pcr at: (pc2 at: j+24)) ~= 0 ifTrue:
				[rawKey at: n put: ((rawKey at: n) bitOr:
(bigByte at: j))].
			].
		].
	self cookKey: rawKey to: cookedPtr! !

!DESPlugin methodsFor: 'support' stamp: 'DSM 1/25/2000 00:28'!
scrunch: bytePtr to: wordPtr
	self var: 'bytePtr' declareC: 'unsigned char *bytePtr'.
	self var: 'wordPtr' declareC: 'unsigned long *wordPtr'.
	wordPtr at: 0 put:
		(bytePtr at: 0) << 24 +
		((bytePtr at: 1) << 16) +
		((bytePtr at: 2) << 8) +
		(bytePtr at: 3).
	wordPtr at: 1 put:
		(bytePtr at: 4) << 24 +
		((bytePtr at: 5) << 16) +
		((bytePtr at: 6) << 8) +
		(bytePtr at: 7)! !

!DESPlugin methodsFor: 'support' stamp: 'DSM 1/25/2000 00:31'!
unscrunch: wordPtr to: bytePtr
	self var: 'bytePtr' declareC: 'unsigned char *bytePtr'.
	self var: 'wordPtr' declareC: 'unsigned long *wordPtr'.
	bytePtr at: 0 put: (((wordPtr at: 0)>>24) bitAnd: 16rFF).
	bytePtr at: 1 put: (((wordPtr at: 0)>>16) bitAnd: 16rFF).
	bytePtr at: 2 put: (((wordPtr at: 0)>>8) bitAnd: 16rFF).
	bytePtr at: 3 put: ((wordPtr at: 0) bitAnd: 16rFF).
	bytePtr at: 4 put: (((wordPtr at: 1)>>24) bitAnd: 16rFF).
	bytePtr at: 5 put: (((wordPtr at: 1)>>16) bitAnd: 16rFF).
	bytePtr at: 6 put: (((wordPtr at: 1)>>8) bitAnd: 16rFF).
	bytePtr at: 7 put: ((wordPtr at: 1) bitAnd: 16rFF).
! !

!DESPlugin methodsFor: 'primitives' stamp: 'DSM 1/25/2000 23:04'!
primitiveDESCookKey
	"preprocess the key to more useful format

	param1 = raw key: ByteArray[8]
	param2 = 1->encode 0->decode
	param3 = cooked key:  WordArray[32]"

	| raw cooked encode |
	self export: true.
	self var: 'raw' declareC: 'unsigned char *raw'.
	self var: 'cooked' declareC: 'unsigned long *cooked'.
	interpreterProxy methodArgumentCount = 3
		ifFalse:[^interpreterProxy primitiveFail].
	raw _ self checkedBytePtrOf: (interpreterProxy stackValue: 2).
	encode _ interpreterProxy stackIntegerValue: 1.
	cooked _ self checkedWordPtrOf: (interpreterProxy stackValue: 0).
	interpreterProxy failed
		ifTrue: [ ^nil ].
	self processKey: raw mode: encode to: cooked.
	interpreterProxy pop: 3
	! !

!DESPlugin methodsFor: 'primitives' stamp: 'DSM 1/25/2000 18:30'!
primitiveDESPluginAvailable
	self export: true.
	interpreterProxy pop: 1.
	interpreterProxy pushBool: true
! !

!DESPlugin methodsFor: 'primitives' stamp: 'DSM 1/25/2000 18:19'!
primitiveDESTransform
	"encrypt/decrypt some data

	param1 = data key: ByteArray[8]
	param2 = cooked key:  WordArray[32]"

	| data work cooked |
	self export: true.
	self var: 'data' declareC: 'unsigned char *data'.
	self var: 'cooked' declareC: 'unsigned long *cooked'.
	self var: 'work' declareC: 'unsigned long work[2]'.
	self cCode: '/* Hi ho, Hi ho...*/' inSmalltalk: [work _ 1].
	interpreterProxy methodArgumentCount = 2
		ifFalse:[^interpreterProxy primitiveFail].
	data _ self checkedBytePtrOf: (interpreterProxy stackValue: 1).
	cooked _ self checkedWordPtrOf: (interpreterProxy stackValue: 0).
	interpreterProxy failed
		ifTrue: [ ^nil ].
	self scrunch: data to: work.
	self encrypt: work with: cooked.
	self unscrunch: work to: data.
	interpreterProxy pop: 2
	! !


!DESPlugin class reorganize!
('translation' declareCVarsIn: moduleName)
!


!DESPlugin class methodsFor: 'translation' stamp: 'DSM 1/26/2000 00:06'!
declareCVarsIn: cg
	cg var: 'byteBit' declareC: 'unsigned short byteBit[8] = {
128,64,32,16,8,4,2,1 }'.
	cg var: 'bigByte' declareC:
		(String streamContents:[:s|
			s nextPutAll:'unsigned long bigByte[24] = { '.
			23 to: 0 by: -1 do: [ :i |
				s nextPutAll: (1<<i) asString, ','].
			s nextPutAll:' }']).
	cg var: 'pc1' declareC: 'unsigned char pc1[56] = {
		56, 48, 40, 32, 24, 16,  8,	 0, 57, 49, 41, 33, 25, 17,
		 9,  1, 58, 50, 42, 34, 26,	18, 10,  2, 59, 51, 43, 35,
		62, 54, 46, 38, 30, 22, 14,	 6, 61, 53, 45, 37, 29, 21,
		13,  5, 60, 52, 44, 36, 28,	20, 12,  4, 27, 19, 11,  3 }'.
	cg var: 'pc2' declareC: 'unsigned char pc2[48] = {
		13, 16, 10, 23,  0,  4,	 2, 27, 14,  5, 20,  9,
		22, 18, 11,  3, 25,  7,	15,  6, 26, 19, 12,  1,
		40, 51, 30, 36, 46, 54,	 29, 39, 50, 44, 32, 47,
		43, 48, 38, 55, 33, 52, 45, 41, 49, 35, 28, 31 }'.
	cg var: 'totRot' declareC:
'unsigned char totRot[16] = { 1,2,4,6,8,10,12,14,15,17,19,21,23,25,27,28 }'.
	cg var: 'sp1' declareC: 'unsigned long sp1[64] = {
		0x01010400L, 0x00000000L, 0x00010000L, 0x01010404L,
		0x01010004L, 0x00010404L, 0x00000004L, 0x00010000L,
		0x00000400L, 0x01010400L, 0x01010404L, 0x00000400L,
		0x01000404L, 0x01010004L, 0x01000000L, 0x00000004L,
		0x00000404L, 0x01000400L, 0x01000400L, 0x00010400L,
		0x00010400L, 0x01010000L, 0x01010000L, 0x01000404L,
		0x00010004L, 0x01000004L, 0x01000004L, 0x00010004L,
		0x00000000L, 0x00000404L, 0x00010404L, 0x01000000L,
		0x00010000L, 0x01010404L, 0x00000004L, 0x01010000L,
		0x01010400L, 0x01000000L, 0x01000000L, 0x00000400L,
		0x01010004L, 0x00010000L, 0x00010400L, 0x01000004L,
		0x00000400L, 0x00000004L, 0x01000404L, 0x00010404L,
		0x01010404L, 0x00010004L, 0x01010000L, 0x01000404L,
		0x01000004L, 0x00000404L, 0x00010404L, 0x01010400L,
		0x00000404L, 0x01000400L, 0x01000400L, 0x00000000L,
		0x00010004L, 0x00010400L, 0x00000000L, 0x01010004L }'.
	cg var: 'sp2' declareC: 'unsigned long sp2[64] = {
		0x80108020L, 0x80008000L, 0x00008000L, 0x00108020L,
		0x00100000L, 0x00000020L, 0x80100020L, 0x80008020L,
		0x80000020L, 0x80108020L, 0x80108000L, 0x80000000L,
		0x80008000L, 0x00100000L, 0x00000020L, 0x80100020L,
		0x00108000L, 0x00100020L, 0x80008020L, 0x00000000L,
		0x80000000L, 0x00008000L, 0x00108020L, 0x80100000L,
		0x00100020L, 0x80000020L, 0x00000000L, 0x00108000L,
		0x00008020L, 0x80108000L, 0x80100000L, 0x00008020L,
		0x00000000L, 0x00108020L, 0x80100020L, 0x00100000L,
		0x80008020L, 0x80100000L, 0x80108000L, 0x00008000L,
		0x80100000L, 0x80008000L, 0x00000020L, 0x80108020L,
		0x00108020L, 0x00000020L, 0x00008000L, 0x80000000L,
		0x00008020L, 0x80108000L, 0x00100000L, 0x80000020L,
		0x00100020L, 0x80008020L, 0x80000020L, 0x00100020L,
		0x00108000L, 0x00000000L, 0x80008000L, 0x00008020L,
		0x80000000L, 0x80100020L, 0x80108020L, 0x00108000L }'.
	cg var: 'sp3' declareC: 'unsigned long sp3[64] = {
		0x00000208L, 0x08020200L, 0x00000000L, 0x08020008L,
		0x08000200L, 0x00000000L, 0x00020208L, 0x08000200L,
		0x00020008L, 0x08000008L, 0x08000008L, 0x00020000L,
		0x08020208L, 0x00020008L, 0x08020000L, 0x00000208L,
		0x08000000L, 0x00000008L, 0x08020200L, 0x00000200L,
		0x00020200L, 0x08020000L, 0x08020008L, 0x00020208L,
		0x08000208L, 0x00020200L, 0x00020000L, 0x08000208L,
		0x00000008L, 0x08020208L, 0x00000200L, 0x08000000L,
		0x08020200L, 0x08000000L, 0x00020008L, 0x00000208L,
		0x00020000L, 0x08020200L, 0x08000200L, 0x00000000L,
		0x00000200L, 0x00020008L, 0x08020208L, 0x08000200L,
		0x08000008L, 0x00000200L, 0x00000000L, 0x08020008L,
		0x08000208L, 0x00020000L, 0x08000000L, 0x08020208L,
		0x00000008L, 0x00020208L, 0x00020200L, 0x08000008L,
		0x08020000L, 0x08000208L, 0x00000208L, 0x08020000L,
		0x00020208L, 0x00000008L, 0x08020008L, 0x00020200L }'.
	cg var: 'sp4' declareC: 'unsigned long sp4[64] = {
		0x00802001L, 0x00002081L, 0x00002081L, 0x00000080L,
		0x00802080L, 0x00800081L, 0x00800001L, 0x00002001L,
		0x00000000L, 0x00802000L, 0x00802000L, 0x00802081L,
		0x00000081L, 0x00000000L, 0x00800080L, 0x00800001L,
		0x00000001L, 0x00002000L, 0x00800000L, 0x00802001L,
		0x00000080L, 0x00800000L, 0x00002001L, 0x00002080L,
		0x00800081L, 0x00000001L, 0x00002080L, 0x00800080L,
		0x00002000L, 0x00802080L, 0x00802081L, 0x00000081L,
		0x00800080L, 0x00800001L, 0x00802000L, 0x00802081L,
		0x00000081L, 0x00000000L, 0x00000000L, 0x00802000L,
		0x00002080L, 0x00800080L, 0x00800081L, 0x00000001L,
		0x00802001L, 0x00002081L, 0x00002081L, 0x00000080L,
		0x00802081L, 0x00000081L, 0x00000001L, 0x00002000L,
		0x00800001L, 0x00002001L, 0x00802080L, 0x00800081L,
		0x00002001L, 0x00002080L, 0x00800000L, 0x00802001L,
		0x00000080L, 0x00800000L, 0x00002000L, 0x00802080L }'.
	cg var: 'sp5' declareC: 'unsigned long sp5[64] = {
		0x00000100L, 0x02080100L, 0x02080000L, 0x42000100L,
		0x00080000L, 0x00000100L, 0x40000000L, 0x02080000L,
		0x40080100L, 0x00080000L, 0x02000100L, 0x40080100L,
		0x42000100L, 0x42080000L, 0x00080100L, 0x40000000L,
		0x02000000L, 0x40080000L, 0x40080000L, 0x00000000L,
		0x40000100L, 0x42080100L, 0x42080100L, 0x02000100L,
		0x42080000L, 0x40000100L, 0x00000000L, 0x42000000L,
		0x02080100L, 0x02000000L, 0x42000000L, 0x00080100L,
		0x00080000L, 0x42000100L, 0x00000100L, 0x02000000L,
		0x40000000L, 0x02080000L, 0x42000100L, 0x40080100L,
		0x02000100L, 0x40000000L, 0x42080000L, 0x02080100L,
		0x40080100L, 0x00000100L, 0x02000000L, 0x42080000L,
		0x42080100L, 0x00080100L, 0x42000000L, 0x42080100L,
		0x02080000L, 0x00000000L, 0x40080000L, 0x42000000L,
		0x00080100L, 0x02000100L, 0x40000100L, 0x00080000L,
		0x00000000L, 0x40080000L, 0x02080100L, 0x40000100L }'.
	cg var: 'sp6' declareC: 'unsigned long sp6[64] = {
		0x20000010L, 0x20400000L, 0x00004000L, 0x20404010L,
		0x20400000L, 0x00000010L, 0x20404010L, 0x00400000L,
		0x20004000L, 0x00404010L, 0x00400000L, 0x20000010L,
		0x00400010L, 0x20004000L, 0x20000000L, 0x00004010L,
		0x00000000L, 0x00400010L, 0x20004010L, 0x00004000L,
		0x00404000L, 0x20004010L, 0x00000010L, 0x20400010L,
		0x20400010L, 0x00000000L, 0x00404010L, 0x20404000L,
		0x00004010L, 0x00404000L, 0x20404000L, 0x20000000L,
		0x20004000L, 0x00000010L, 0x20400010L, 0x00404000L,
		0x20404010L, 0x00400000L, 0x00004010L, 0x20000010L,
		0x00400000L, 0x20004000L, 0x20000000L, 0x00004010L,
		0x20000010L, 0x20404010L, 0x00404000L, 0x20400000L,
		0x00404010L, 0x20404000L, 0x00000000L, 0x20400010L,
		0x00000010L, 0x00004000L, 0x20400000L, 0x00404010L,
		0x00004000L, 0x00400010L, 0x20004010L, 0x00000000L,
		0x20404000L, 0x20000000L, 0x00400010L, 0x20004010L }'.
	cg var: 'sp7' declareC: 'unsigned long sp7[64] = {
		0x00200000L, 0x04200002L, 0x04000802L, 0x00000000L,
		0x00000800L, 0x04000802L, 0x00200802L, 0x04200800L,
		0x04200802L, 0x00200000L, 0x00000000L, 0x04000002L,
		0x00000002L, 0x04000000L, 0x04200002L, 0x00000802L,
		0x04000800L, 0x00200802L, 0x00200002L, 0x04000800L,
		0x04000002L, 0x04200000L, 0x04200800L, 0x00200002L,
		0x04200000L, 0x00000800L, 0x00000802L, 0x04200802L,
		0x00200800L, 0x00000002L, 0x04000000L, 0x00200800L,
		0x04000000L, 0x00200800L, 0x00200000L, 0x04000802L,
		0x04000802L, 0x04200002L, 0x04200002L, 0x00000002L,
		0x00200002L, 0x04000000L, 0x04000800L, 0x00200000L,
		0x04200800L, 0x00000802L, 0x00200802L, 0x04200800L,
		0x00000802L, 0x04000002L, 0x04200802L, 0x04200000L,
		0x00200800L, 0x00000000L, 0x00000002L, 0x04200802L,
		0x00000000L, 0x00200802L, 0x04200000L, 0x00000800L,
		0x04000002L, 0x04000800L, 0x00000800L, 0x00200002L }'.
	cg var: 'sp8' declareC: 'unsigned long sp8[64] = {
		0x10001040L, 0x00001000L, 0x00040000L, 0x10041040L,
		0x10000000L, 0x10001040L, 0x00000040L, 0x10000000L,
		0x00040040L, 0x10040000L, 0x10041040L, 0x00041000L,
		0x10041000L, 0x00041040L, 0x00001000L, 0x00000040L,
		0x10040000L, 0x10000040L, 0x10001000L, 0x00001040L,
		0x00041000L, 0x00040040L, 0x10040040L, 0x10041000L,
		0x00001040L, 0x00000000L, 0x00000000L, 0x10040040L,
		0x10000040L, 0x10001000L, 0x00041040L, 0x00040000L,
		0x00041040L, 0x00040000L, 0x10041000L, 0x00001000L,
		0x00000040L, 0x10040040L, 0x00001000L, 0x00041040L,
		0x10001000L, 0x00000040L, 0x10000040L, 0x10040000L,
		0x10040040L, 0x10000000L, 0x00040000L, 0x10001040L,
		0x00000000L, 0x10041040L, 0x00040040L, 0x10000040L,
		0x10040000L, 0x10001000L, 0x10001040L, 0x00000000L,
		0x10041040L, 0x00041000L, 0x00041000L, 0x00001040L,
		0x00001040L, 0x00040040L, 0x10000000L, 0x10041000L }'.


! !

!DESPlugin class methodsFor: 'translation' stamp: 'DSM 1/24/2000 23:40'!
moduleName
	"
	Time millisecondsToRun: [ DESPlugin translateDoInlining: true]
	"

	^ 'desPlugin'! !


-------------- next part --------------
A non-text attachment was scrubbed...
Name: DESPlugin
Type: application/octet-stream
Size: 5089 bytes
Desc: not available
Url : http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20000126/4710a5f9/DESPlugin.obj


More information about the Squeak-dev mailing list