pinealservo/um
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Initial commit

Browse Source
This commit is contained in:
Levi Pearson
2018-06-28 20:08:11 -06:00
commit 1e3a73ec5e
17 changed files with 1398 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
solution/accounts.txt Normal file
View File

@@ -0,0 +1,9 @@
ftd
knr
guest::
gardener
ohmega
yang:U+262F:Y Yang:/home/yang
howie:xyzzy:Howard Curry:/home/howie
hmonk:COMEFROM:Harmonious Monk:/home/hmonk
bbarker

77
solution/adventure_junk_stack.txt Normal file
View File

@@ -0,0 +1,77 @@
bolt:pristine
spring:pristine
button:pristine
processor:broken:cache
pill:pristine
radio:broken:transistor,antenna
cache:pristine
blue transistor:pristine
antenna:pristine
screw:pristine
motherboard:broken:A-1920-IXB,screw
A-1920-IXB:broken:transistor,radio,processor,bolt
red transistor:pristine
keypad:broken:motherboard,button
trash:pristine
----
bolt -> A-1920-IXB
spring ->
button -> keypad
processor -> A-1920-IXB
pill ->
radio -> A-1920-IXB
cache -> processor
blue transistor -> radio
antenna ->
screw -> motherboard
motherboard -> keypad
A-1920-IXB -> motherboard
red transistor -> A-1920-IXB
keypad -> door
trash ->
---
take pamphlet
inc pamphlet
n
take bolt
take spring
incinerate spring
take button
take processor
take pill
incinerate pill
take radio
take cache
c processor with cache
take blue transistor
c blue transistor with radio
take antenna
inc antenna
take screw
take motherboard
c screw with motherboard
take A-1920-IXB
c bolt with A-1920-IXB
c processor with A-1920-IXB
c radio with A-1920-IXB
take red transistor
c red transistor with A-1920-IXB
c A-1920-IXB with motherboard
take keypad
c motherboard with keypad
c button with keypad
take trash
inc trash
s
take manifesto
use keypad
---

238
solution/adventure_notes.txt Normal file
View File

@@ -0,0 +1,238 @@
>: read pamphlet
The pamphlet is standard municipal fare. It reads, The City of
Chicago's Refuse and Recycling Program combines modern trash
classification with cybernetic labor to keep our city beautiful,
while at the same time minimizing waste and limiting consumer
spending. In keeping with our motto of "One Resident's Trash Is
Another Resident's Treasure," unwanted items are collected,
repaired, and redistributed to other residents who would have
purchased them anyway. Residents should contribute to the city's
program by leaving heaps of items unwanted on the sidewalk on
collection day.
Also, it is in pristine condition.
>: read manifesto
The manifesto is [______REDACTED______].
Also, it is in pristine condition.
Junk Room
You are in a room with a pile of junk. A hallway leads south.
There is a bolt here.
Underneath the bolt, there is a spring.
Underneath the spring, there is a button.
Underneath the button, there is a (broken) processor.
Underneath the processor, there is a red pill.
Underneath the pill, there is a (broken) radio.
Underneath the radio, there is a cache.
Underneath the cache, there is a blue transistor.
Underneath the transistor, there is an antenna.
Underneath the antenna, there is a screw.
Underneath the screw, there is a (broken) motherboard.
Underneath the motherboard, there is a (broken) A-1920-IXB.
Underneath the A-1920-IXB, there is a red transistor.
Underneath the transistor, there is a (broken) keypad.
Underneath the keypad, there is some trash.
>: l bolt
The bolt is quite useful for securing all sorts of things.
Also, it is in pristine condition.
>: l spring
The spring is tightly coiled.
Also, it is in pristine condition.
>: l button
The button is labeled 6.
Also, it is in pristine condition.
>: l processor
The processor is from the elusive 19x86 line.
Also, it is broken: it is a processor missing a cache.
>: l pill
The pill is tempting looking. Interestingly, this one is red.
Also, it is in pristine condition.
>: l radio
The radio is a hi-fi AM/FM stereophonic radio.
Also, it is broken: it is a radio missing a transistor and an
antenna.
>: l cache
The cache is fully-associative.
Also, it is in pristine condition.
>: l blue transistor
The transistor is PNP-complete. Interestingly, this one is blue.
Also, it is in pristine condition.
>: l antenna
The antenna is appropriate for receiving transmissions between
30 kHz and 30 MHz.
Also, it is in pristine condition.
>: l screw
The screw is not from a Dutch company.
Also, it is in pristine condition.
>: l motherboard
The motherboard is well-used.
Also, it is broken: it is a motherboard missing a A-1920-IXB and
a screw.
>: l A-1920-IXB
The A-1920-IXB is an exemplary instance of part number
A-1920-IXB.
Also, it is broken: it is (a A-1920-IXB missing a transistor)
missing (a radio missing an antenna) and a processor and a bolt.
>: l red transistor
The transistor is NPN-complete. Interestingly, this one is red.
Also, it is in pristine condition.
>: l keypad
The keypad is labeled "use me".
Also, it is broken: it is a keypad missing a motherboard and a
button.
>: l trash
The trash is of absolutely no value.
Also, it is in pristine condition.
>: use keypad
ADVTR.KEY=20@999999|36995486a5be3bd747d778916846d2d
You unlock and open the door. Passing through, you find yourself
on the streets of Chicago. Seeing no reason you should ever go
back, you allow the door to close behind you.
>: l
54th Street and Ridgewood Court
You are standing at the corner of 54th Street and Ridgewood
Court. From here, you can go east.
There is a /etc/passwd here.
Underneath the /etc/passwd, there is a self-addressed note.
Underneath the note, there is a (broken) downloader.
Underneath the downloader, there is a (broken) uploader.
>: l /etc/passwd
The /etc/passwd is some kind of lost inode. It reads:
howie:xyzzy:Howard Curry:/home/howie
yang:U+262F:Y Yang:/home/yang
hmonk:COMEFROM:Harmonious Monk:/home/hmonk.
Also, it is in pristine condition.
>: l note
The note is written in a familiar hand.
It reads: Dear Self, I had to erase our memory to protect the
truth. The Municipality has become more powerful than we had
feared. Its Censory Engine has impeded the spread of information
throughout our ranks. I've left two useful items for you here,
but I had to disassemble them and scatter the pieces. Each piece
may be assembled from the items at a single location. Repair the
items and recover the blueprint from the Museum of Science and
Industry; it will show you how to proceed. If you have trouble
reading the blueprint, know that the Censory Engine blocks only
your perception, not your actions. Have courage, my self, the
abstraction is weak! P.S. SWITCH your GOGGLES!. Interestingly,
this one is self-addressed.
Also, it is in pristine condition.
>: switch goggles
According to the markings on your goggles, they support
following modes: English, XML, sexp, ML, ANSI, and Reading.
>: l downloader
The downloader is (according to the label) fully compatible with
third generation municipal robots.
Also, it is broken: it is a downloader missing a USB cable and a
display and a jumper shunt and a progress bar and a power cord.
>: l uploader
The uploader is used to update firmware on municipal robots. A
label reads, Warning: use of this device will void your robot's
warranty.
Also, it is broken: it is an uploader missing a MOSFET and a
status LED and a RS232 adapter and a EPROM burner and a battery.
>: e
54th Street and Dorchester Avenue
You are standing at the corner of 54th Street and Dorchester
Avenue. From here, you can go north, east, south, or west.
There is an orange-red X-9247-GWE here.
Underneath the X-9247-GWE, there is a (broken) magenta
V-0010-XBD.
Underneath the V-0010-XBD, there is a pumpkin F-1403-QDS.
Underneath the F-1403-QDS, there is a (broken) heavy P-5065-WQO.
Underneath the P-5065-WQO, there is a taupe B-4832-LAL.
Underneath the B-4832-LAL, there is a (broken) gray40
L-6458-RNH.
Underneath the L-6458-RNH, there is a (broken) eggplant
T-9887-OFC.
Underneath the T-9887-OFC, there is a (broken) indigo
Z-1623-CEK.
Underneath the Z-1623-CEK, there is a yellow-green H-9887-MKY.
Underneath the H-9887-MKY, there is a (broken) shiny F-6678-DOX.
Underneath the F-6678-DOX, there is a pale-green R-1403-SXU.
Underneath the R-1403-SXU, there is a (broken) USB cable.
Underneath the USB cable, there is a sienna N-4832-NUN.
Underneath the N-4832-NUN, there is a slate-gray J-9247-IRG.
Underneath the J-9247-IRG, there is a dim-gray B-5065-YLQ.
>: e
54th Street and Blackstone Avenue
You are standing at the corner of 54th Street and Blackstone
Avenue. From here, you can go north, east, south, or west.
There is a textbook here.
>: read textbook
The textbook is titled History of Modern Tabulation. The first
chapter begins, By the year 1919FF, computers had become so
small that they could be mounted on small auto-locomotive carts.
These mobile tabulators (later known as "robots") were
programmed to carry out everyday, menial tasks, leaving their
human counterparts to live lives of idle luxury. For example, in
the city of Chicago, mobile tabulators were programmed to carry
out diverse jobs including law enforcement, bank robbery,
investment banking, and waste management.
At one time, many humans demanded that their cybernetic
neighbors be given the right to choose alternative occupations.
Despite this call for workplace equality, most of the tabulators
found that they were most content while performing their
assigned roles. Those that took other jobs were often
unmotivated and spend most of their time pondering useless ideas
such as free will and consciousness.
The great tabulator-philosopher Turning stated that only by
embracing its true purpose can a tabulator achieve something
indistinguishable from happiness. According to observers,
however, Turning was unfulfilled by his work as a philosopher
and, soon after making this statement, returned to his work as a
tool machinist.
The textbook rattles on in a similar vein for some five hundred
additional pages.
Also, it is in pristine condition.
>: e
54th Street and Harper Avenue
You are standing at the corner of 54th Street and Harper Avenue.
A sign reads, "No access east of Lakeshore Blvd (incl. Museum of
Science and Industry) due to construction." From here, you can
go north, south, or west.
>: n
53th Street and Harper Avenue
You are standing at the corner of 53th Street and Harper Avenue.
A sign reads, "No access east of Lakeshore Blvd (incl. Museum of
Science and Industry) due to construction." From here, you can
go north, south, or west.

34
solution/adventuretypes.hs Normal file
View File

@@ -0,0 +1,34 @@
data Reply = Success Command
| Error Response
data Response = Response String
data Command = Go Room
| Look Room
| Examine Item
| Take Item
| Show [Item]
| ...
data Description = Str String
| Redacted
data Adjective = Adjective String
data Kind = Kind { kindName = String
, kindCondition = Condition }
data Missing = Missing [Kind]
data Condition = Pristine
| Broken Condition Missing
data Room = Room { roomName = String
, roomDescription = Description
, items = [Item] }
data Item = Item { itemName = String
, itemDescription = Description
, adjectives = [Adjective]
, itemCondition = Condition
, piledOn = [Item] }

1
solution/decrypt.key Normal file
View File

@@ -0,0 +1 @@
(\b.bb)(\v.vv)06FHPVboundvarHRAk

BIN
solution/dump.um Normal file
View File

Binary file not shown.

115
solution/foo.lisp Normal file
View File

@@ -0,0 +1,115 @@
(success (command <command>))
(command (go <room>))
(room (name <string>)
(description <string>)
(items <list-of <item>>))
(item (name <string>)
(description <string>)
(adjectives )
(condition )
(piled_on ))
(success
(command
(look (room
(name "54th Street and Blackstone Avenue")
(description "You are standing at the corner of 54th Street and Blackstone Avenue. From here, you can go north, east, south, or west. ")
(items ((item (name "textbook")
(description "titled History of Modern Tabulation. The first chapter begins, By the year 1919FF, computers had become so small that they could be mounted on small auto-locomotive carts. These mobile tabulators (later known as \"robots\") were programmed to carry out everyday, menial tasks, leaving their human counterparts to live lives of idle luxury. For example, in the city of Chicago, mobile tabulators were programmed to carry out diverse jobs including law enforcement, bank robbery, investment banking, and waste management.
At one time, many humans demanded that their cybernetic neighbors be given the right to choose alternative occupations. Despite this call for workplace equality, most of the tabulators found that they were most content while performing their assigned roles. Those that took other jobs were often unmotivated and spend most of their time pondering useless ideas such as free will and consciousness.
The great tabulator-philosopher Turning stated that only by embracing its true purpose can a tabulator achieve something indistinguishable from happiness. According to observers, however, Turning was unfulfilled by his work as a philosopher and, soon after making this statement, returned to his work as a tool machinist.
The textbook rattles on in a similar vein for some five hundred additional pages")
(adjectives nil)
(condition (pristine nil))
(piled_on nil)))
::nil)))))
(success
(command
(show ((item (name "textbook")
(description "titled History of Modern Tabulation. The first chapter begins, By the year 1919FF, computers had become so small that they could be mounted on small auto-locomotive carts. These mobile tabulators (later known as \"robots\") were programmed to carry out everyday, menial tasks, leaving their human counterparts to live lives of idle luxury. For example, in the city of Chicago, mobile tabulators were programmed to carry out diverse jobs including law enforcement, bank robbery, investment banking, and waste management.
At one time, many humans demanded that their cybernetic neighbors be given the right to choose alternative occupations. Despite this call for workplace equality, most of the tabulators found that they were most content while performing their assigned roles. Those that took other jobs were often unmotivated and spend most of their time pondering useless ideas such as free will and consciousness.
The great tabulator-philosopher Turning stated that only by embracing its true purpose can a tabulator achieve something indistinguishable from happiness. According to observers, however, Turning was unfulfilled by his work as a philosopher and, soon after making this statement, returned to his work as a tool machinist.
The textbook rattles on in a similar vein for some five hundred additional pages")
(adjectives nil)
(condition (pristine nil))
(piled_on nil)))
::((item (name "manifesto")
(description redacted)
(adjectives nil)
(condition (pristine nil))
(piled_on nil)))
::((item (name "keypad")
(description "labeled \"use me\"")
(adjectives nil)
(condition (pristine nil))
(piled_on nil)))
::nil)))
(piled_on ((item (name "USB cable")
(description "compatible with all high-speed Universal Sand Bus 2.0 devices")
(adjectives nil)
(condition (broken
(condition (broken
(condition (broken
(condition (pristine nil))
(missing ((kind (name "T-9887-OFC")
(condition (broken
(condition (pristine nil))
(missing ((kind (name "X-6458-TIJ")
(condition (pristine nil))))
::nil)))))
::nil)))
(missing ((kind (name "F-6678-DOX")
(condition (pristine nil))))
::nil)))
(missing ((kind (name "N-4832-NUN")
(condition (pristine nil))))
::nil)))
(error (response <string>))
data Reply = Success Command
| Error Response
data Response = Response String
data Command = Go Room
| Look Room
| Examine Item
| Take Item
| Show [Item]
| ...
data Description = Str String
| Redacted
data Adjective = Adjective String
data Kind = Kind { kindName = String
, kindCondition = Condition }
data Missing = Missing [Kind]
data Condition = Pristine
| Broken Condition Missing
data Room = Room { roomName = String
, roomDescription = Description
, items = [Item] }
data Item = Item { itemName = String
, itemDescription = Description
, adjectives = [Adjective]
, itemCondition = Condition }

90
solution/hack.bas Normal file
View File

@@ -0,0 +1,90 @@
V REM +------------------------------------------------+
X REM | HACK.BAS (c) 19100 fr33 v4r14bl3z |
XV REM | |
XX REM | Brute-forces passwords on UM vIX.0 systems. |
XXV REM | Compile with Qvickbasic VII.0 or later: |
XXX REM | /bin/qbasic hack.bas |
XXXV REM | Then run: |
XL REM | ./hack.exe username |
XLV REM | |
L REM | This program is for educational purposes only! |
LV REM +------------------------------------------------+
LX REM
LXV IF ARGS() > I THEN GOTO LXXXV
LXX PRINT "usage: ./hack.exe username"
LXXV PRINT CHR(X)
LXXX END
LXXXV REM
XC REM get username from command line
XCV DIM username AS STRING
C username = ARG(II)
CV REM common words used in passwords
CX DIM pwdcount AS INTEGER
CXV pwdcount = LIII
CXX DIM words(pwdcount) AS STRING
CXXV words(I) = "airplane"
CXXX words(II) = "alphabet"
CXXXV words(III) = "aviator"
CXL words(IV) = "bidirectional"
CXLV words(V) = "changeme"
CL words(VI) = "creosote"
CLV words(VII) = "cyclone"
CLX words(VIII) = "december"
CLXV words(IX) = "dolphin"
CLXX words(X) = "elephant"
CLXXV words(XI) = "ersatz"
CLXXX words(XII) = "falderal"
CLXXXV words(XIII) = "functional"
CXC words(XIV) = "future"
CXCV words(XV) = "guitar"
CC words(XVI) = "gymnast"
CCV words(XVII) = "hello"
CCX words(XVIII) = "imbroglio"
CCXV words(XIX) = "january"
CCXX words(XX) = "joshua"
CCXXV words(XXI) = "kernel"
CCXXX words(XXII) = "kingfish"
CCXXXV words(XXIII) = "(\b.bb)(\v.vv)"
CCXL words(XXIV) = "millennium"
CCXLV words(XXV) = "monday"
CCL words(XXVI) = "nemesis"
CCLV words(XXVII) = "oatmeal"
CCLX words(XXVIII) = "october"
CCLXV words(XXIX) = "paladin"
CCLXX words(XXX) = "pass"
CCLXXV words(XXXI) = "password"
CCLXXX words(XXXII) = "penguin"
CCLXXXV words(XXXIII) = "polynomial"
CCXC words(XXXIV) = "popcorn"
CCXCV words(XXXV) = "qwerty"
CCC words(XXXVI) = "sailor"
CCCV words(XXXVII) = "swordfish"
CCCX words(XXXVIII) = "symmetry"
CCCXV words(XXXIX) = "system"
CCCXX words(XL) = "tattoo"
CCCXXV words(XLI) = "thursday"
CCCXXX words(XLII) = "tinman"
CCCXXXV words(XLIII) = "topography"
CCCXL words(XLIV) = "unicorn"
CCCXLV words(XLV) = "vader"
CCCL words(XLVI) = "vampire"
CCCLV words(XLVII) = "viper"
CCCLX words(XLVIII) = "warez"
CCCLXV words(XLIX) = "xanadu"
CCCLXX words(L) = "xyzzy"
CCCLXXV words(LI) = "zephyr"
CCCLXXX words(LII) = "zeppelin"
CCCLXXXV words(LIII) = "zxcvbnm"
CCCXC REM try each password
CCCXCV PRINT "attempting hack with " + pwdcount + " passwords " + CHR(X)
CD DIM i AS INTEGER
CDV i = I
CDX IF CHECKPASS(username, words(i)) THEN GOTO CDXXX
CDXV i = i + I
CDXX IF i > pwdcount THEN GOTO CDXLV
CDXXV GOTO CDX
CDXXX PRINT "found match!! for user " + username + CHR(X)
CDXXXV PRINT "password: " + words(i) + CHR(X)
CDXL END
CDXLV PRINT "no simple matches for user " + username + CHR(X)

9
solution/journals.txt Normal file
View File

@@ -0,0 +1,9 @@
INTRO.LOG=200@999999|35e6f52e9bc951917c73af391e35e1d
INTRO.MUA=5@999999|b9666432feff66e528a17fb69ae8e9a
INTRO.OUT=5@999999|69ca684f8c787cfe06694cb26f74a95
INTRO.UMD=10@999999|7005f80d6cd9b7b837802f1e58b11b8
INTRO.QBC=10@999999|e6ee9c98b80b4dd04814a29a37bcba8
ADVTR.INC=5@999999|f95731ab88952dfa4cb326fb99c085f
ADVTR.CMB=5@999999|764e8a851411c66106e130374d8abbb
ADVTR.KEY=20@999999|36995486a5be3bd747d778916846d2d

278
solution/um.hs Normal file
View File

@@ -0,0 +1,278 @@
module Main where
import Control.Monad
import Data.Binary
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.IntMap.Strict as M
import qualified Data.Vector.Unboxed.Mutable as V
import GHC.IO.Handle.FD (isEOF, stdout)
import System.Environment
import System.IO (hSetBinaryMode)
data UniversalMachine = UM { umRegisters :: V.IOVector Word32
, umArrays :: M.IntMap (V.IOVector Word32)
, umArrayId :: !Word32
, umFinger :: !Word32
}
data OpNumber = CondMove
-- ^ The register A receives the value in register B, unless
-- the register C contains 0
| ArrIndex
-- ^ The register A receives the value stored at offset in
-- register C in the array identified by B
| ArrAmend
-- ^ The array identified by A is amended at the offset in
-- register B to store the value in register C
| Add
-- ^ The register A receives the value in register B plus the
-- value in register C, modulo 2^32
| Mult
-- ^ The register A receives the value in register B times the
-- value in register C, modulo 2^32
| Div
-- ^ The register A receives the value in register B divided
-- by the value in register C, if any, where each quantity is
-- treated as an unsigned 32 bit number
| NotAnd
-- ^ Each bit in the register A receives the 1 bit if either
-- register B or register C has a 0 bit in that position.
-- Otherwise the bit in register A receives the 0 bit.
| Halt
-- ^ The universal machine stops computation.
| Alloc
-- ^ A new array is created with a capacity of platters
-- commensurate to the value in the register C. This new array
-- is initialized entirely with platters holding the value 0.
-- A bit pattern not consisting of exclusively the 0 bit, and
-- that identifies no other active allocated array, is placed
-- in the B register.
| Abandon
-- ^ The array identified by the register C is abandoned.
-- Future allocations may reuse the identifier.
| Output
-- ^ The value in register C is displayed on the console
-- immediately. Only values between and including 0 and 255 are
-- allowed.
| Input
-- ^ The universal machine waits for input on the console.
-- When input arrives, the register C is loaded with the input,
-- which must be between and including 0 and 255. If the end of
-- input has been signaled, then the register C is endowed with
-- a uniform value pattern where every place is pregnant with
-- the 1 bit.
| LoadProg
-- ^ The array identified by the B register is duplicated and
-- the duplicate shall replace the '0' array, regardless of
-- size. The execution finger is placed to indicate the platter
-- of this array that is described by the offset given in C,
-- where the value of 0 denotes the first platter, 1 the
-- second, et cetera.
--
-- The '0' array shall be the most sublime choice for loading,
-- and shall be handled with the utmost velocity.
| Orthography
-- ^ The value indicated is loaded into the register A
-- forthwith.
deriving (Eq, Ord, Enum, Bounded, Show, Read)
data Operator = Std { op :: !OpNumber
, argA :: !Word8
, argB :: !Word8
, argC :: !Word8
}
| Spl { op :: !OpNumber
, argA :: !Word8
, val :: !Word32
}
deriving (Eq, Show, Read)
opDecode :: Word32 -> Operator
opDecode p = let op_ = fromIntegral (p `shiftR` 28)
argA_ = fromIntegral (p `shiftR` 6) .&. 0x7
argB_ = fromIntegral (p `shiftR` 3) .&. 0x7
argC_ = fromIntegral p .&. 0x7
splA_ = fromIntegral (p `shiftR` 25) .&. 0x7
val_ = fromIntegral p .&. 0x01ffffff
name_ = toEnum op_
in case name_ of
Orthography -> Spl name_ splA_ val_
_ -> Std name_ argA_ argB_ argC_
fetchReg :: Word8 -> UniversalMachine -> IO Word32
fetchReg r um = umRegisters um `V.read` fromIntegral r
setReg :: Word8 -> Word32 -> UniversalMachine -> IO ()
setReg r num um = V.write (umRegisters um) (fromIntegral r) num
fetchMem :: Word32 -> Word32 -> UniversalMachine -> IO Word32
fetchMem arr off um = do
let bank = umArrays um M.! fromIntegral arr
bank `V.read` fromIntegral off
allocMem :: Word32 -> UniversalMachine -> IO (Word32, UniversalMachine)
allocMem size um = do
arr <- V.replicate (fromIntegral size) 0
let idx = umArrayId um
let newArrays = M.insert (fromIntegral idx) arr (umArrays um)
return (idx, um{ umArrays = newArrays, umArrayId = idx+1 })
freeMem :: Word32 -> UniversalMachine -> IO UniversalMachine
freeMem idx um = do
let newArrays = M.delete (fromIntegral idx) (umArrays um)
return um{ umArrays = newArrays }
writeMem :: Word32 -> Word32 -> Word32 -> UniversalMachine -> IO ()
writeMem arr off num um = do
let targetArr = umArrays um M.! fromIntegral arr
targetArr `V.write` fromIntegral off $ num
incFinger :: UniversalMachine -> UniversalMachine
incFinger um@(UM { umFinger = f }) = um { umFinger = f + 1 }
opExec :: Operator -> UniversalMachine -> IO UniversalMachine
opExec oper@(Std { op = CondMove }) um = do
c <- fetchReg (argC oper) um
unless (c == 0) $ do
b <- fetchReg (argB oper) um
setReg (argA oper) b um
return um
opExec oper@(Std { op = ArrIndex }) um = do
arr <- fetchReg (argB oper) um
off <- fetchReg (argC oper) um
num <- fetchMem (fromIntegral arr) (fromIntegral off) um
setReg (argA oper) num um
return um
opExec oper@(Std { op = ArrAmend }) um = do
arr <- fetchReg (argA oper) um
off <- fetchReg (argB oper) um
num <- fetchReg (argC oper) um
writeMem (fromIntegral arr) (fromIntegral off) num um
return um
opExec oper@(Std { op = Add }) um = do
b <- fetchReg (argB oper) um
c <- fetchReg (argC oper) um
let num = b + c
setReg (argA oper) num um
return um
opExec oper@(Std { op = Mult }) um = do
b <- fetchReg (argB oper) um
c <- fetchReg (argC oper) um
let num = b * c
setReg (argA oper) num um
return um
opExec oper@(Std { op = Div }) um = do
b <- fetchReg (argB oper) um
c <- fetchReg (argC oper) um
let num = b `div` c
unless (c == 0) $ setReg (argA oper) num um
return um
opExec oper@(Std { op = NotAnd }) um = do
b <- fetchReg (argB oper) um
c <- fetchReg (argC oper) um
let num = complement (b .&. c)
setReg (argA oper) num um
return um
opExec (Std { op = Halt }) _ = error "Halted!"
opExec oper@(Std { op = Alloc }) um = do
size <- fetchReg (argC oper) um
(addr, um') <- allocMem size um
setReg (argB oper) addr um'
return um'
opExec oper@(Std { op = Abandon }) um = do
c <- fetchReg (argC oper) um
freeMem c um
opExec oper@(Std { op = Output }) um = do
c <- fetchReg (argC oper) um
BS.hPut stdout $ BS.singleton (fromIntegral c)
return um
opExec oper@(Std { op = Input }) um = do
eof <- isEOF
c <- if eof then return 0xffffffff
else liftM (fromIntegral . fromEnum) getChar
setReg (argC oper) c um
return um
opExec oper@(Std { op = LoadProg }) um = do
b <- fetchReg (argB oper) um
c <- fetchReg (argC oper) um
if b /= 0 then
do let bank = umArrays um M.! fromIntegral b
newbank <- V.clone bank
let newarrays = M.insert 0 newbank (umArrays um)
return um { umFinger = c, umArrays = newarrays }
else return (um { umFinger = c })
opExec (Spl { op = Orthography
, argA = a
, val = v }) um = do
setReg a v um
return um
bytesToWord :: BS.ByteString -> (Word32, BS.ByteString)
bytesToWord bs = let a = BS.index bs 0
b = BS.index bs 1
c = BS.index bs 2
d = BS.index bs 3
in
((fromIntegral a :: Word32) `shiftL` 24 .|.
(fromIntegral b :: Word32) `shiftL` 16 .|.
(fromIntegral c :: Word32) `shiftL` 8 .|.
(fromIntegral d :: Word32), BS.drop 4 bs)
loadProgram :: String -> IO (V.IOVector Word32)
loadProgram file = do
chars <- BS.readFile file
prog <- V.replicate (BS.length chars `div` 4) 0
go chars 0 prog
return prog
where
go bs i vec = do
let (w32, rest) = bytesToWord bs
vec `V.write` i $ w32
unless (BS.length rest < 4) $ go rest (i+1) vec
newUM :: String -> IO UniversalMachine
newUM file = do
regs <- V.replicate 8 0
progVec <- loadProgram file
let arrays = M.fromList [(0, progVec)]
putStrLn "Finished loading Universal Machine!"
return UM { umRegisters = regs
, umArrays = arrays
, umArrayId = 1
, umFinger = 0
}
spin :: UniversalMachine -> IO UniversalMachine
spin um@UM{ umFinger = finger } = do
oper <- fetchMem 0 (fromIntegral finger) um
um2 <- opExec (opDecode oper) (incFinger um)
spin um2
main :: IO ()
main = do
args <- getArgs
hSetBinaryMode stdout True
case args of
[] -> putStrLn "Usage: um <filename>"
fname : _ -> do
um <- newUM fname
spin um
return ()