Class new title: Generator
	subclassof: Object
	fields: 'literals nTemps maxTemp local environment parser supered root requestor sourceStream sourceParagraph'
	declare: '';
	sharing: ByteCodes

abortWith: t1 | t2 
	[[WhatFlag  [user notify: t1]].
	NoteTaker 
		[parser terminate.
		user restoredisplay.
		requestor notify: t1 at: sourceStream position in: sourceStream.
		root eval]
	t2 _ thisContext swapSender: root sender.
	root sender_ nil.
	root _ nil.
	parser terminate.
	t2 release.
	t2 _ nil.
	user restoredisplay.
	requestor notify: t1 at: sourceStream position in: sourceStream]

assignment: t1 expr: t2 
	[ParsedAssignment new var: t1 expr: t2]

balance [nTemps]

block 
	[ParsedBlock default]

comment: t1 
	[]

compile: t1 in: t2 under: t3 notifying: t4 | t5 
	[sourceParagraph _ t1.
	requestor _ t4.
	user displayoffwhile 
		[sourceStream _ sourceParagraph asStream.
		t5 _ self compileIn: t2.
		[t5  [t2 organization classify: t5 under: t3]
		nil]].
	t5]

compileIn: t1 | t2 t3 t4 t5 t6 
	[[NoteTaker  [self setRoot [nil]]
	root _ thisContext].
	parser _ Parser new.
	parser from: sourceStream to: self.
	self initSymbols: t1.
	t2 _ ParsedBlock default.
	t5 _ parser pattern: t2.
	t4 _ nTemps.
	parser temporaries: t2.
	t6 _ parser body: t2.
	parser mustBeDone.
	parser _ nil.
	t2 mustReturn: true.
	t3 _ (t6 = 0 and t4 = 0) and t2 quickCode.
	[t3  []
	t3 _ self generate: t2 in: t1 prim: t6 nargs: t4].
	t1 install: t5 method: t3 literals: literals code: sourceStream asArray backpointers: nil.
	[HuhFlag 
		[Huh _ nil.
		Huh _ (self decompile: t3 onto: Stream default) contents.
		HuhFlag _ false]].
	t5]

contents

declaration: t1 name: t2 asArg: t3 | t4 t5 
	[t5 _ self newTemp.
	t4 _ local lookup: t2.
	t4 
		[t3 and t4 isField  [t1 next_ ParsedAssignment new var: t4 expr: t5]
		parser notify: 'NAME ALREADY IN USE']
	local insert: t2 with: t5]

decompile: t1 onto: t2 
	[t1 length < 6 
		[t2 append: 'Quick code: '.
		t2 append: t1 asBytes.
		t2]
	t2 print: t1  4.
	t2 append: ' args; '.
	t2 print: t1  5.
	t2 append: ' temps; '.
	t2 print: t1  3 - (t1  5).
	t2 append: ' stack; '.
	t2 print: t1  6 - 6 / 2.
	t2 append: ' literals; '.
	[t1  2 > 0 
		[t2 append: ' primitive: '.
		t2 print: t1  2.
		t2 append: ';']].
	t2 print: t1 length.
	t2 append: ' bytes total.'.
	t2 cr.
	t1  2 = 40  [t2]
	self decompileBytes: t1 onto: t2]

decompileBytes: t1 onto: t2 | t3 t4 t5 t6 t7 t8     
	[t3 _ Dictionary new init: 64.
	t3 insertall: ((128 to: 131) copy , 125 concat: (144 to: 175) copy) with: ('_^' '_' '^' '' 'end' 'jmp1' 'jmp2' 'jmp3 ' 'jmp4' 'jmp5' 'jmp6' 'jmp7' 'jmp8' 'bfp1' 'bfp2' 'bfp3 ' 'bfp4' 'bfp5' 'bfp6' 'bfp7' 'bfp8' 'jmp' 'jmp' 'jmp' 'jmp' 'jmp' 'jmp' 'jmp' 'jmp' 'bfp' 'bfp' 'bfp' 'bfp' 'bfp' 'bfp' 'bfp' 'bfp' ).
	for t4 from: local contents do
		[t5 _ local  t4.
		t8 _ t5 land: 255.
		[t5 > 255 and t8 < 16  [t5 _ ((t5 lshift: 8) - 1 lshift: 4) + t8]].
		t3 insert: t5 with: t4].
	for t4 from: stdSelectors contents do
		[t3 insert: stdSelectors  t4 with: [t4 is: Integer  [t4 inString]
		t4]].
	for t5 to: 5 do
		[t3 insert: toLoadConst + t5 - 1 with: ('1' '0' '1' '2' '10' )  t5].
	t7 _ (t1  (t1  6 + 1 to: t1 length)) asStream.
	for t8 from: t7 do
		[[t8  toLoadFieldLong and t8 
 toSendLitLong  [t8 _ (t8 - 135 lshift: 8) + t7 next]].
		t6 _ t3 lookup: t8.
		[t6  [t2 append: t6]
		t2 append: '#'.
		t2 append: t8 base8].
		t2 space.
		t8 < toLongJmp  []
		t8  176  []
		t2 print: t8 \ 8 - 4 * 256 + t7 next.
		t2 space].
	t2 cr.
	t2]

encodeSel: t1 | t2 
	[t2 _ stdSelectors lookup: t1.
	t2  [t2]
	codeSendLit + (self litIndex: [t1 class  Integer  [UST1  (t1 + 1)]
	t1 unique])]

evalKeyword: t1 
	[t1]

evaluate: t1 in: t2 to: t3 notifying: t4 | t5 t6 t7 t8 
	[sourceStream _ t1.
	requestor _ t4.
	t5 _ user displayoffwhile [self evaluateIn: t2 to: t3].
	root  true  false  [t5]
	t6 _ nTemps.
	NoteTaker 
		[t2  [t5 run: t3 in: t2 mclass]
		t5 run: t3 in: t3 class]
	t2 
		[t8 _ t2 tempframe  (1 to: t6) copyto: (Vector new: t5  3).
		t7 _ t2 interpret: t5 with: t8.
		t8  (1 to: t6) copyto: t2 tempframe.
		t7]
	Context new have: t3 interpret: t5]

evaluateIn: t1 to: t2 | t3 t4 t5 t6 
	[[NoteTaker  [self setRoot [nil]]
	root _ thisContext].
	t3 _ ParsedBlock default.
	parser _ Parser new.
	parser from: sourceStream to: self.
	[t1 
		[t5 _ t1 mclass.
		self initSymbols: t5.
		t1 variableNamesInto: self with: ParsedBlock default.
		t6 _ nTemps.
		NoteTaker  [self setRoot [nil]]
		root _ thisContext]
	t5 _ t2 class.
	self initSymbols: t5].
	parser temporaries: t3.
	parser statements: t3.
	parser mustBeDone.
	parser _ nil.
	t3 mustReturn: false.
	t4 _ self generate: t3 in: t5 prim: 0 nargs: 0.
	[HuhFlag 
		[Huh _ nil.
		Huh _ (self decompile: t4 onto: Stream default) contents.
		HuhFlag _ false]].
	root _ true.
	nTemps _ t6.
	t4]

for: t1 from: t2 to: t3 do: t4 on: t5 | t6 
	[t6 _ self newTempForMacro.
	t5 next_ ParsedAssignment new var: t6 expr: t3.
	t5 next_ ParsedAssignment new var: t1 expr: t2.
	t5 next_ ParsedLoop new whileExpr: (ParsedMessage new rcvr: t6 op: toGeq args: (ParsedAssignment new var: t1 expr: (ParsedMessage new rcvr: toLoad1 op: toPlus args: t1))) doExpr: t4]

forfromdo: t1 args: t2 | t3 t4 t5 t6 
	[t3 _ (t2  1) local.
	t4 _ t2  2.
	t5 _ (t2  3) local.
	t6 _ self newTempForMacro.
	t1 next_ ParsedAssignment new var: t6 expr: (ParsedMessage new rcvr: t4 op: toAsStream args: false).
	t1 next_ ParsedLoop new whileExpr: (ParsedAssignment new var: t3 expr: (ParsedMessage new rcvr: t6 op: toNext args: false)) doExpr: t5]

forfromtobydo: t1 args: t2 
	[t2  2 _ self rcvr: t2  2 selector: 'to:by:' args: (t2  (3 to: 4)) copy.
	self forfromdo: t1 args: (t2  (1 2 5 )) copy]

forfromtodo: t1 args: t2 
	[self for: (t2  1) local from: (ParsedMessage new rcvr: t2  2 op: toMinus args: toLoad1) to: t2  3 do: (t2  4) local on: t1]

fortodo: t1 args: t2 
	[self for: (t2  1) local from: toLoad0 to: t2  2 do: (t2  3) local on: t1]

generate: t1 in: t2 prim: t3 nargs: t4 | t5 t6 t7 t8 t9 t10 
	[t7 _ literals find: nil.
	[t7 > 0  [literals _ (literals  (1 to: t7 - 1)) copy]].
	[NoteTaker  []
	supered  [literals _ literals , (Smalltalk ref: t2 title unique)]].
	t5 _ String new: t1 sizeForValue.
	t6 _ t5 asStream.
	t8 _ ParseStack init.
	t1 emitForValue: t6 on: t8.
	[t8 position  1  [user notify: 'Compiler stack discrepancy']].
	[t6 position  t5 length  [user notify: 'Compiler code size discrepancy']].
	t9 _ maxTemp - t4.
	[NoteTaker 
		[t4 > 15 or t9 > 31  [user notify: 'Methods are limited to 15 args and 31 temps']]].
	t10 _ (CompiledMethod new: 2) numArgs: t4 numTemps: t9 numStack: t8 length literals: literals primitive: t3 bytes: t5.
	NoteTaker  [t10]
	t10 freeLiterals.
	t5 _ String new: t10 length.
	t10 copyto: t5 asStream.
	t5]

identifier: t1 
	[nTemps _ nTemps + 1.
	local insert: t1 with: nTemps]

ifExpr: t1 thenExpr: t2 elseExpr: t3 
	[ParsedConditional new ifExpr: t1 thenExpr: t2 elseExpr: t3]

ifthen: t1 args: t2 
	[t1 next_ self ifExpr: (t2  1) local thenExpr: (t2  2) local elseExpr: (self nullStatement: ParsedBlock default)]

ifthenelse: t1 args: t2 
	[t1 next_ self ifExpr: (t2  1) local thenExpr: (t2  2) local elseExpr: (t2  3) local]

initSymbols: t1 | t2  
	[environment _ t1 wholeEnvironment , Smalltalk.
	local _ Dictionary new copyfrom: stdPrimaries.
	nTemps _ codeLoadField - 1.
	for t2 from: t1 instvars do
		[nTemps _ nTemps + 1.
		local insert: t2 with: nTemps].
	maxTemp _ 0.
	nTemps _ maxTemp.
	literals _ Vector new: 123.
	supered _ false]

juggle | t1 
	[t1 _ maxTemp.
	maxTemp _ nTemps.
	t1]

keywordMessage: t1 selector: t2 args: t3 
	[t2 = 'and'  [ParsedConjunct new left: t1 right: t3 local]
	t2 = 'or'  [ParsedDisjunct new left: t1 right: t3 local]
	self rcvr: t1 selector: t2 args: (t3 remote: self)]

litIndex: t1 | t2 t3  
	[for t2 to: 123 do
		[t3 _ literals  t2.
		t3  nil 
			[literals  t2 _ t1.
			t2 - 1]
		t3 class  t1 class 
			[t3 sameAs: t1  [t2 - 1]]].
	parser notify: 'MORE THAN 123 LITERALS REFERENCED']

literal: t1 | t2 
	[[t1 class  Integer 
		[t2 _ (1 0 1 2 10 ) find: t1.
		0  t2  [toLoadConst + t2 - 1]]].
	codeLoadLit + (self litIndex: t1)]

macro: t1 selector: t2 args: t3 | t4 
	[t4 _ inLineMsgs lookup: t2.
	t4  [self perform: t4 with: t1 with: t3]
	Context canunderstand: t2 unique  [t1 next_ self rcvr: toLoadThisCtxt selector: t2 args: (t3 remote: self)]
	false]

newTemp 
	[nTemps _ nTemps + 1.
	nTemps > maxTemp and [maxTemp _ nTemps.
	maxTemp > 256]  [parser notify: 'MORE THAN 256 TEMPS REQUIRED']
	codeLoadTemp + nTemps - 1]

newTempForMacro 
	[nTemps _ maxTemp.
	self newTemp]

noEvalKeyword: t1 
	[t1 asRemoteCode: self]

notify: t1 
	[parser notify: t1]

nullStatement: t1 
	[t1 next_ toLoadNil.
	t1]

rcvr: t1 selector: t2 args: t3 
	[[t1  toSuper  [supered _ true]].
	ParsedMessage new rcvr: t1 op: (self encodeSel: t2) args: t3]

receivingVar: t1 | t2 t3 
	[t2 _ t1 emittedReceiver.
	t2 
		[t3 _ t2 emittedVariable.
		t3  [t3]
		t3 _ self newTemp.
		t1 emittedReceiver_ ParsedAssignment new var: t3 expr: t2.
		t3]
	parser notify: 'MAY ONLY FOLLOW A MESSAGE']

separator: t1 
	[]

setRoot t1 
	[root _ t1]

terminate 
	[NoteTaker  []
	root _ nil]

trailer: t1 
	[]

unbalance: t1 
	[nTemps _ t1]

unjuggle: t1 
	[maxTemp _ t1 max: maxTemp]

untildo: t1 args: t2 
	[t1 next_ ParsedLoop new whileExpr: (ParsedNegation new rcvr: (t2  1) local op: toEq args: toLoadFalse) doExpr: (t2  2) local]

variable: t1 | t2 t3 t4 t5  
	[t2 _ local lookup: t1.
	t2  [t2]
	t5 _ t1 hasBeenUniqued.
	[t5  [for t3 from: environment do
			[t4 _ t3 lookupRef: t5.
			t4  [codeLoadLitInd + (self litIndex: t4)]]]].
	requestor interactive  [parser notify: 'Smalltalk declare: ' + t1 + ' as: nilTO DECLARE GLOBAL']
	user show: ' (' + t1 + ' is Undeclared) '.
	t5 _ t1 unique.
	Undeclared declare: t5.
	codeLoadLitInd + (self litIndex: (Undeclared ref: t5))]

whiledo: t1 args: t2 
	[t1 next_ ParsedLoop new whileExpr: (t2  1) local doExpr: (t2  2) local]