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