Initial commit of unchanged sources from pdst version 0004 as found in pdst_20070506_01.zip at https://github.com/kyle-github/littlesmalltalk/tree/master/archive NOTE: This version doesn't build out of the box on modern compilers, needs a couple of small fixes.
This commit is contained in:
parent
1710026d78
commit
fce0bdb742
34
Makefile
Normal file
34
Makefile
Normal file
@ -0,0 +1,34 @@
|
||||
CC = gcc
|
||||
XSOPT =
|
||||
SOPT = -Wall -O2 -fno-defer-pop
|
||||
CPY = cp -a
|
||||
DEL = rm -f
|
||||
|
||||
pdst.s: pdst.c
|
||||
$(CC) $(XSOPT) $(SOPT) -S pdst.c
|
||||
|
||||
pdst.o: pdst.s
|
||||
$(CC) -c pdst.s
|
||||
|
||||
pdst: pdst.o
|
||||
$(CC) -o pdst pdst.o -lm
|
||||
|
||||
systemImage: initial.st
|
||||
./pdst -c initial.st
|
||||
|
||||
.PHONY: test1
|
||||
test1:
|
||||
$(CPY) snapshot snapshot.1
|
||||
./pdst -w snapshot <test1.kbd
|
||||
|
||||
.PHONY: test2
|
||||
test2:
|
||||
$(CPY) snapshot snapshot.2
|
||||
./pdst -w snapshot <test2.kbd
|
||||
|
||||
.PHONY: clean
|
||||
clean:
|
||||
$(DEL) snapshot.2 test2.one.out test2.all.out
|
||||
$(DEL) snapshot.1
|
||||
$(DEL) snapshot transcript systemImage
|
||||
$(DEL) pdst pdst.o pdst.s
|
2974
initial.st
Normal file
2974
initial.st
Normal file
File diff suppressed because it is too large
Load Diff
50
queen.st
Normal file
50
queen.st
Normal file
@ -0,0 +1,50 @@
|
||||
Object
|
||||
subclass: #NullQueen
|
||||
instanceVariableNames: ''!
|
||||
{!
|
||||
NullQueen methods!
|
||||
checkRow: row column: column
|
||||
" we can't attack anything "
|
||||
|
||||
^ false!
|
||||
first
|
||||
^ true!
|
||||
next
|
||||
^ true!
|
||||
result
|
||||
^ List new!
|
||||
}!
|
||||
Object
|
||||
subclass: #Queen
|
||||
instanceVariableNames: 'row column neighbor'!
|
||||
{!
|
||||
Queen methods!
|
||||
advance
|
||||
(row = 8)
|
||||
ifTrue: [ (neighbor next) ifFalse: [ ^ false ].
|
||||
row <- 0 ].
|
||||
row <- row + 1.
|
||||
^ true!
|
||||
checkRow: testRow column: testColumn | columnDifference |
|
||||
columnDifference <- testColumn - column.
|
||||
(((row = testRow) or:
|
||||
[ row + columnDifference = testRow]) or:
|
||||
[ row - columnDifference = testRow])
|
||||
ifTrue: [ ^ true ].
|
||||
^ neighbor checkRow: testRow column: testColumn!
|
||||
first
|
||||
neighbor first.
|
||||
row <- 1.
|
||||
^ self testPosition!
|
||||
next
|
||||
^ (self advance) and: [ self testPosition ]!
|
||||
result
|
||||
^ neighbor result addLast: row!
|
||||
setColumn: aNumber neighbor: aQueen
|
||||
column <- aNumber.
|
||||
neighbor <- aQueen!
|
||||
testPosition
|
||||
[neighbor checkRow: row column: column]
|
||||
whileTrue: [ (self advance) ifFalse: [ ^ false ]].
|
||||
^ true!
|
||||
}!
|
3
test1.kbd
Normal file
3
test1.kbd
Normal file
@ -0,0 +1,3 @@
|
||||
stdout print: 'echoInput <- true'. echoInput <- true
|
||||
File new fileIn: 'test1.st'
|
||||
Test1 new all
|
123
test1.st
Normal file
123
test1.st
Normal file
@ -0,0 +1,123 @@
|
||||
test1note <- '
|
||||
Derived from:
|
||||
Little Smalltalk, version 2
|
||||
Written by Tim Budd, Oregon State University, July 1987
|
||||
|
||||
Function:
|
||||
A few test cases.
|
||||
|
||||
Example:
|
||||
File new fileIn: ''test1.st''
|
||||
Test1 new all'!
|
||||
Object
|
||||
subclass: #One
|
||||
instanceVariableNames: ''!
|
||||
{!
|
||||
One methods!
|
||||
result1
|
||||
^ self test!
|
||||
test
|
||||
^ 1!
|
||||
}!
|
||||
One
|
||||
subclass: #Two
|
||||
instanceVariableNames: ''!
|
||||
{!
|
||||
Two methods!
|
||||
test
|
||||
^ 2!
|
||||
}!
|
||||
Two
|
||||
subclass: #Three
|
||||
instanceVariableNames: ''!
|
||||
{!
|
||||
Three methods!
|
||||
result2
|
||||
^ self result1!
|
||||
result3
|
||||
^ super test!
|
||||
}!
|
||||
Three
|
||||
subclass: #Four
|
||||
instanceVariableNames: ''!
|
||||
{!
|
||||
Four methods!
|
||||
test
|
||||
^ 4!
|
||||
}!
|
||||
Object
|
||||
subclass: #Test1
|
||||
instanceVariableNames: ''!
|
||||
{!
|
||||
Test1 methods!
|
||||
all
|
||||
self super.
|
||||
self conversions.
|
||||
self collections.
|
||||
self factorial.
|
||||
self filein.
|
||||
'all tests completed' print!
|
||||
collections
|
||||
" test the collection classes a little"
|
||||
( (#(1 2 3 3 2 4 2) asSet = #(1 2 3 4) asSet) and: [
|
||||
(#(1 5 3 2 4) sort asArray = #(1 2 3 4 5)) and: [
|
||||
(1 "(#+ respondsTo occurrencesOf: Float)" = 1) and: [
|
||||
('First' < 'last') ] ] ] )
|
||||
ifFalse: [^smalltalk error: 'collection failure'].
|
||||
'collection test passed' print.!
|
||||
conversions
|
||||
" test a few conversion routines "
|
||||
( (#abc == #abc asString asSymbol) and: [
|
||||
($A == $A asInteger asCharacter) and: [
|
||||
(12 == 12 asDigit digitValue) and: [
|
||||
(237 == 237 asString asInteger) and: [
|
||||
(43 = 43 asFloat truncated) and: [
|
||||
$A == ($A asString at: 1) ] ] ] ] ] )
|
||||
ifFalse: [^ smalltalk error: 'conversion failure'].
|
||||
'conversion test passed' print.!
|
||||
factorial | t |
|
||||
t <- [:x | (x = 1) ifTrue: [ 1 ]
|
||||
ifFalse: [ x * (t value: x - 1) ] ].
|
||||
((t value: 5) = 5 factorial)
|
||||
ifFalse: [ smalltalk error: 'factorial failure'].
|
||||
'factorial test passed' print!
|
||||
filein
|
||||
(File name: 'queen.st' open: 'r') fileIn; close.
|
||||
( (#QueenMeta value class ~~ Metaclass)
|
||||
or: [ (#Queen value class ~~ #QueenMeta value)
|
||||
or: [#Queen value name ~~ #Queen] ] )
|
||||
ifTrue: [ smalltalk error: 'fileIn failure'].
|
||||
((classes includesKey: #Queen) and: [(classes at: #Queen) == Queen])
|
||||
ifFalse: [ smalltalk error: 'fileIn failure'].
|
||||
'file in test passed' print.
|
||||
self queen!
|
||||
queen | lastQueen |
|
||||
lastQueen <- NullQueen new.
|
||||
(1 to: 8) do: [:i | lastQueen <- Queen new
|
||||
setColumn: i neighbor: lastQueen;
|
||||
yourself ].
|
||||
lastQueen first.
|
||||
(lastQueen result asArray = #(1 5 8 6 3 7 2 4) )
|
||||
ifTrue: ['8 queens test passed' print]
|
||||
ifFalse: [smalltalk error: '8queen test failed']!
|
||||
super
|
||||
(self super2 asArray = #(1 1 2 2 2 4 2 4 2 2) )
|
||||
ifTrue: ['super test passed' print]
|
||||
ifFalse: [ smalltalk error: 'super test failed']!
|
||||
super2 | x1 x2 x3 x4 |
|
||||
x1 <- One new.
|
||||
x2 <- Two new.
|
||||
x3 <- Three new.
|
||||
x4 <- Four new.
|
||||
^ List new addLast: x1 test;
|
||||
addLast: x1 result1;
|
||||
addLast: x2 test;
|
||||
addLast: x2 result1;
|
||||
addLast: x3 test;
|
||||
addLast: x4 result1;
|
||||
addLast: x3 result2;
|
||||
addLast: x4 result2;
|
||||
addLast: x3 result3;
|
||||
addLast: x4 result3;
|
||||
yourself!
|
||||
}!
|
4
test2.kbd
Normal file
4
test2.kbd
Normal file
@ -0,0 +1,4 @@
|
||||
stdout print: 'echoInput <- true'. echoInput <- true
|
||||
File new fileIn: 'test2.st'
|
||||
Test2 new tryOne
|
||||
Test2 new tryAll
|
76
test2.st
Normal file
76
test2.st
Normal file
@ -0,0 +1,76 @@
|
||||
Object
|
||||
subclass: #Test2
|
||||
instanceVariableNames: ''!
|
||||
{!
|
||||
Test2 methods!
|
||||
on: s
|
||||
"try all classes"
|
||||
| f t k |
|
||||
(f <- File name: s mode: 'w') open.
|
||||
t <- 9 asCharacter asString.
|
||||
k <- classes sort: [ :x :y | x name asString < y name asString ].
|
||||
k do: [ :e | self on: f tab: t put: e ].
|
||||
f close!
|
||||
on: s put: c
|
||||
"try one class"
|
||||
| f t |
|
||||
(f <- File name: s mode: 'w') open.
|
||||
t <- 9 asCharacter asString.
|
||||
self on: f tab: t putCN: c.
|
||||
self on: f tab: t putSN: c.
|
||||
self on: f tab: t putVN: c.
|
||||
self on: f tab: t putCM: c.
|
||||
self on: f tab: t putIM: c.
|
||||
f close!
|
||||
on: f tab: t put: c
|
||||
"try all classes"
|
||||
self on: f tab: t putCN: c.
|
||||
self on: f tab: t putSN: c.
|
||||
self on: f tab: t putVN: c.
|
||||
self on: f tab: t putCM: c.
|
||||
self on: f tab: t putIM: c!
|
||||
on: f tab: t putCM: c
|
||||
| n v |
|
||||
n <- 10 asCharacter.
|
||||
f print: 'class methods'.
|
||||
v <- c class methods sort: [ :x :y | x name asString < y name asString ].
|
||||
f print: '==='.
|
||||
v do: [ :e |
|
||||
f print: e trimmedText.
|
||||
f print: '===' ]!
|
||||
on: f tab: t putCN: c
|
||||
f print: 'class name' , t , c name asString!
|
||||
on: f tab: t putIM: c
|
||||
| n v |
|
||||
n <- 10 asCharacter.
|
||||
f print: 'methods'.
|
||||
v <- c methods sort: [ :x :y | x name asString < y name asString ].
|
||||
f print: '==='.
|
||||
v do: [ :e |
|
||||
f print: e trimmedText.
|
||||
f print: '===' ]!
|
||||
on: f tab: t putSN: c
|
||||
| v |
|
||||
v <- c superClass.
|
||||
v isNil ifTrue: [
|
||||
v <- '<nil>' ]
|
||||
ifFalse: [
|
||||
v <- v asString ].
|
||||
f print: 'superclass name' , t , v!
|
||||
on: f tab: t putVN: c
|
||||
| v |
|
||||
v <- c variables.
|
||||
v isNil ifTrue: [
|
||||
v <- #('<nil>') ]
|
||||
ifFalse: [
|
||||
v <- (v collect: [ :e | e asString ]) sort ].
|
||||
v inject: 'variable names' into: [ :x :y |
|
||||
f print: x , t , y.
|
||||
' ' ]!
|
||||
tryAll
|
||||
"try all classes"
|
||||
self on: 'test2.all.out'!
|
||||
tryOne
|
||||
"try one class"
|
||||
self on: 'test2.one.out' put: self class!
|
||||
}!
|
Loading…
x
Reference in New Issue
Block a user