Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Squid
Last updated at 1:41 pm UTC on 16 January 2006
Authors: Anthony Hannan

Squid is a programmable, persistent, distributed, secure, object system. Everything, including low level functionality that is traditionally found in a VM, is implemented as objects and coded in Smalltalk or Squid assembly (bytecodes). Native C libraries can be loaded and called directly from Smalltalk. Bytecodes are low-level and are translated to machine code before being executed. An optimizer watches execution and optimizes (inlines) methods that are called frequently.

Objects are stored in files or disk partitions called sites. Each native process runs a single site and connects to the network. Objects in one site may point to objects in other sites. A site is identified by network address and port number, which must be unique for each site. Sites never move, only objects and threads may move between sites. An exception is raised when trying to access a site that does not respond.

Methods are implemented for a class but are organized by module. A module exports chosen methods that only dependent modules (those that import the module) may call. Likewise, a module exports chosen classes that only dependent modules may subclass or add methods too (class extensions). Multiple inheritance is allowed. Instance variables are implemented as primitive methods so they can be overridden. Class, pool and global variables are replaced by module variables, which may also be exported.

Squid's first target machine will be Squeak. That is, a squid site will be loaded into a Squeak WordArray, the network and other devices will be accessible from a special Squid environment implemented in Squeak, and Squid bytecodes will be translated to Squeak bytecodes that manipulate the words inside the Squeak WordArray. This will support a fully functional Squid system that will be able to communicate with other Squid systems over the Internet.

The following are some of the core modules needed for Squid. This list will grow. Italicized phrases are the module's exported method signatures.

SquidInterface

This module allows native C code to call squid methods. This module has to be in native executable format so it can be called from C (All other modules are squid objects stored in squid sites).

site = loadSite(filename)
Load the squid site at filename and return its base address.

methodOop = bootMethod(site)
Return oop of boot method in site. It is stored in a well known field of the site header object, which is the first object in the site's heap.

callMethod(site, methodOop, numArgs, argOopsArray, resultAddr)
Call Squid method from native C. Result is place is resultAddr.

main(argc, argv)
The first arg is expected to be the squid site filename. Load the named site file and invoke its boot method with the rest of the command line string as its sole argument.

CInterface

This module allows Squid to call C library functions.

cLibrary := filename cLibrary
Load library at filename.

cFunction := cLibrary functionNamed: functionName
Return the named C function.

cFunction callWith: argsWordArray resultVar: resultWordArray
Calls native C function with words in argsWordArray as args. Result is stored in first word of resultWordArray.

Interrupts

device eventHandler: block
Register block as the device's signal/interrupt handler. When device signals, block will be executed. On a single processor computer, the current execution will be suspended before block is called.

Segments

segment := object extract
Move object and its free children into its own segment (a mini site). This can then be transmitted and installed in another site. The segment's out-pointers may be replicas or just stubs.

segment install
Add segment's root object and free children to home site. Return the root object after it is installed.

SiteNetwork

Squid listen
Register a network handler to receive messages from other sites.

remoteSite install: segment
Transmit segment to remoteSite and install it there. Raise error if site not responding.

remoteSite installAndRun: segment
Transmit segment to remoteSite, install it, then run segment's root object, which is expected to be a block, from there. Raise error if site not responding.

RemoteObjects

remoteObject perform: message
Extract message and install and run it on remoteObject's site. Wait for return.

Assembly

Squid assembly is a simple temp transfer language that translates directly to bytecodes.

Squid assembler
Return a new Assembler that responds to Smalltalk assembly messages and generates bytecodes.

assembler label: labelNum
Label current instruction for gotos.

assembler goto: labelNum
Jump to labelNum.

assembler if: registerNum is: boolean goto: labelNum
if register = boolean then jump to labelNum.

assembler temp: tempNum assignNum: integer
temp := integer.

assembler temp: tempNum1 assignTemp: tempNum2 plus: integer
temp1 := temp2 + integer.

assembler temp: tempNum1 assignMem: tempNum2 offset: offset
temp1 := Memory at: temp2 + offset.

assembler mem: tempNum1 offset: offset assignTemp: tempNum2
Memory at: temp1 + offset put: temp2.

assembler call: tempNumM
Push IP and FP then jump to method in temp. There must be two slot reserved before tempNum for IP and FP to be pushed. Method and args are expected to be on stack starting at tempNum. So the stack frame looks like (growing down to higher addresses):
        callerFP
        nextIP
FP:     method
temp1:  arg1 (receiver)
temp2:  arg2
...     ...
...     argL
...     localTemp
...     localTemp
...     ...
...     reserved
...     reserved
tempM:  calleeMethod
...     arg1
...     arg2
...     ...
tempN:  argK
The call code looks like (notice tempNum is used directly as fp offset):
Memory at: FP - 1 put: IP.
Memory at: FP + tempNumM - 2 put: FP.
FP := FP + tempNumM.
SP - FP  MaxFrameSize ifTrue: [
    "stack overflow"
    temp16 := StartNewStack.
    assembler call: 16.  "actually inlined without overflow test"
].
IP := Memory at: (Memory at: FP) + CodeIndex.
Every method points to its machine code or the translator via its CodeIndex field. The translator will translate the method, update the method pointer, then executed the newly translated code.

assembler return
Pops FP and IP and jumps to IP. The return result is expected be in method temp slot. The code is:
reg := Memory at: FP - 2.
reg = 0 ifTrue: [
    "stack underflow"
    temp16 := StartPreviousStack.
    self call: 16.
    reg := Memory at: FP - 2.
].
FP := reg.
IP := Memory at: FP - 1.

assembler temp: tempNum0 assignOp: selector temp1: tempNum1 temp2: tempNum2
temp0 := temp1 selector temp2.
selector is one of: +, -, *, //, \\, =, ~=, <, >, <=, =>, <<, >>, bitAnd:, bitOr:, bitXor:.

IR

The IR (intermediate representation) language is higher-level than assembly language but lower-level than Smalltalk. It generates assembly language.

Squid irBuilder
Return a new IRBuilder that responds to IR instructions and generates assembly language.

irBuilder args: tempIds
Give arg ids for later reference.

irBuilder literal: object store: tempId
Store literal in tempId.

irBuilder call: tempId withArgs: tempIds
Call method in tempId with args in tempIds. Result will be stored in tempId, if one is returned.

irBuilder return: tempIdOrNil
Return to sender with tempId as result, or no result if nil.

irBuilder jumpAheadTarget: labelId
Label current instruction for previous [ifTrue:/ifFalse:]jumpAheadTo: instruction. There must be exactly one jump for every target.

irBuilder if: tempId is: boolean jumpAheadTo: labelId
If temp = boolean then jump ahead to target with labelId.

irBuilder jumpAheadTo: labelId
Jump ahead to target with labelId.

irBuilder jumpBackTarget: labelId
Label current instruction for later jumpBackTo: instruction. There must be exactly one jump for every target.

irBuilder jumpBackTo: labelId
Jump back to target with labelId.

NativePlatform

platform := Squid hostPlatform
Return a platform object describing the machine this site is running on.

cpuLanguage := platform cpuLanguage
Return the CPU instruction set of platform. Examples are Intelx86, SqueakVM, etc.

BytecodeTranslation

This module translates bytecodes to machine code.

translator := cpuLanguage bytecodeTranslator
Return a translator from bytecodes to cpuLanguage.

machineCode := translator translate: bytecodes
Generate machine code from bytecodes. MachineCode is a word array.

Squid