.TITLE	BARON	;BARON GAME
	.IDENT	'V001C'
;
; PROGRAM TO PLAY THE BARON GAME (DERIVED FROM FOCAL VERSION FROM OMSI).
;
; LINKS TO SGAS:
; (4K) RO LIBRARY: SYSRES -- FOR FCS ROUTINES
;
; TASK ATTRIBUTES: /AB /CP /DS /FP /FX /HD /MU /-PI /-PR /-TA /-TR
;
; LUN ASSIGNMENTS:
; MO:1 (MESSAGE OUTPUT)
; TI:2 (INPUT)
; TI:3 (OUTPUT)
;
; TASKNAME:   BARON
; PARTITION:  GEN
; POOL LIMIT: 40
; PRIORITY:   30
; STACK:      256
; UIC:        [221,44]
; UNITS:      3
;
; MACRO CALLS:
; RSXMAC:
	.MCALL	GTIM$S,EXIT$S
	.MCALL	FSRSZ$,FDBDF$,FDAT$A,FDRC$A,FDOP$A,FDBF$A,NMBLK$
	.MCALL	FINIT$,OPEN$W,CLOSE$,PUT$
	.MCALL	GCMLB$,GCML$
; SYSMAC:
	.MCALL	FDBERR
;
; FLOATING-POINT REGISTER DEFINITIONS:
;
F0	=	%0
F1	=	%1
F2	=	%2
F3	=	%3
;

; OTHER DEFINITIONS:
;
EOT	=	4		;ASCII EOT CHARACTER
OUTEF	=	1		;OUTPUT FILE I/O EVENT FLAG
CMILUN	=	2		;INPUT LUN
OUTLUN	=	3		;OUTPUT LUN
NTITS	=	14.		;NO. OF LINES OF TITLES
POPUI	=	95.		;INITIAL POPULATION
STORI	=	2800.		;INITIAL BUSHELS IN STORE
HARVI	=	3000.		;INITIAL BUSHELS HARVESTED
RATSI	=	200.		;INITIAL BUSHELS EATEN BY RATS
BUSHI	=	3		;INITIAL BUSHELS PER ACRE HARVESTED
ACREI	=	1000.		;INITIAL ACRES OWNED
ARRVI	=	5		;INITIAL PEOPLE ARRIVED
POPWIN	=	250.		;POPULATION NEEDED TO WIN
BUSHMN	=	9.		;MINIMUM PRICE OF LAND (BUSHELS/ACRE)
ACRPP	=	10.		;MAXIMUM ACRES CAN PLANT PER PERSON
ACR3	=	10000.		;ACRES AT WIN TIME LEVEL 3
ACR2	=	5000.		;ACRES AT WIN TIME LEVEL 2
ACR1	=	2500.		;ACRES AT WIN TIME LEVEL 1
NEST	=	1		;MAXIMUM COMMAND NEST DEPTH
LINLEN	=	72.		;LENGTH OF OUTPUT LINE
NBUF	=	1		;NO. OF OUTPUT BUFFERS
;
; READ/WRITE DATA AREA:
;
	.PSECT	BARRW,D
;
SAVESP:	.WORD	0		;INITIAL STACK POINT
TIMBLK:				;GTIM$ DATA BLOCK (NEXT 8 WORDS...)
POPU:	.WORD	0		;POPULATION
STOR:	.WORD	0		;BUSHELS IN STORE
HARV:	.WORD	0		;BUSHELS HARVESTED
RATS:	.WORD	0		;BUSHELS EATEN BY RATS
BUSH:	.WORD	0		;BUSHELS HARVESTED PER ACRE
ACRE:	.WORD	0		;ACRES OWNED
ARRV:	.WORD	0		;PEOPLE ARRIVED
PLAG:	.WORD	0		;PLAGUE FLAG (ZERO -> PLAGUE!)
STRV:	.WORD	0		;PEOPLE DIED OF STARVATION
YEAR:	.WORD	0		;YEAR NUMBER
I1:	.WORD	0		;RANDOM NO. WORD 1
I2:	.WORD	0		;RANDOM NO. WORD 2
X:	.WORD	0,0		;RANDOM NO. RESULT
;
; OUTPUT FILE FDB:
;
OUTFDB:	FDBDF$
	FDAT$A	R.VAR,FD.CR	;VARIABLE RECORDS WITH CARRIAGE CTL
	FDRC$A	FD.PLC,LINEBF,LINLEN;LOCATE MODE; BUFFER ADDR., LENGTH
	FDOP$A	OUTLUN,,OUTDFN	;OUTPUT LUN; DEFAULT FILENAME BLOCK
	FDBF$A	OUTEF,,NBUF	;OUTPUT EVENT FLAG & NO. OF BUFFERS
;
; GET COMMAND LINE BLOCK:
;
GCLBLK:	GCMLB$	NEST,BAR,,CMILUN;NEST LEVEL, PROMPT, LUN
;
; OUTPUT LINE BUFFER:
;
LINEBF:	.BLKB	LINLEN		;LENGTH "LINLEN"
;

; READ-ONLY DATA AREA:
;
	.PSECT	BARRD,RO,D
;
; FLOATING POINT CONSTANTS:
;
BUSHRG:	.FLT2	16.		;RANGE OF LAND PRICE
POPADJ:	.FLT2	5.		;POPULATION ADJUSTMENT FOR "Q" FACTOR
STARV:	.FLT2	20.		;BUSHELS PER PERSON TO PREVENT STARVATION
BSHPA:	.FLT2	4.5		;AVERAGE BUSHELS PER ACRE HARVESTED
EATFR:	.FLT2	5.		;FRACTION OF STORES EATEN BY RATS
POPACR:	.FLT2	20.		;POPULATION INCREASE PER ACRE FACTOR
POPCOR:	.FLT2	40.		;POPULATION CORRECTION FOR ARRIVAL CALC
INCCON:	.FLT2	20.		;POPULATION INCREASE CONSTANT
PLGPRB:	.FLT2	4500.		;PLAGUE PROBABILITY CONSTANT
PLGSTV:	.FLT2	20.		;PLAGUE FROM STARVATION CONSTANT
PLGMIN:	.FLT2	150.		;MINIMUM PLAGUE CONSTANT
;
; SUBROUTINE "RAN" ARGUMENT LIST:
;
RANARG:	.WORD	3		;2 ARGUMENTS
	.WORD	I1		;RANDOM NO. 1
	.WORD	I2		;RANDOM NO. 2
	.WORD	X		;RESULTING RANDOM NO.
;
; OUTPUT FILE DEFAULT FILE NAME BLOCK:
;
OUTDFN:	NMBLK$	BAROUT,LST	;BAROUT.LST
;

; STRINGS:
;
TITF:	.ASCIZ	<EOT>'*** BARON GAME ***'
	.ASCIZ	' '
	.ASCIZ	'THIS PROGRAM ALLOWS YOU TO BE THE BARON OF A SMALL TOWN'
	.ASCII	'WHERE EVERYONE IS DEPENDENT ON YOU.  HOW YOU MANAGE'
	.ASCIZ	' YOUR'
	.ASCIZ	'LAND WILL DEPEND ON HOW YOU ANSWER THE QUESTIONS IN THE'
	.ASCII	'PROGRAM, AND ON THOSE ANSWERS WILL DEPEND YOUR FATE'
	.ASCIZ	' AS WELL.'
	.ASCIZ	' '
	.ASCIZ	'RULES:'
	.ASCIZ	' '
	.ASCIZ	'** YOU CAN ONLY PLANT 10 ACRES PER PERSON'
	.ASCIZ	'** YOU MUST HAVE AT LEAST ONE BUSHELS FOR FOOD'
	.ASCIZ	'** TO PREVENT STARVATION, EACH PERSON NEEDS 20 BUSHELS.'
	.ASCIZ	'** YOU CAN ONLY PLANT 2 ACRES PER BUSHEL'
	.ASCII	'** YOU ARE PROMOTED WHEN YOU GET A POPULATION GREATER '
	.ASCIZ	'THAN 250.'
YRMF:	.ASCIZ	'YEAR '
	.ASCIZ	'LORD BARON:  LAST YEAR '
	.ASCIZ	' STARVED, '
	.ASCIZ	' ARRIVED.'
	.ASCIZ	'**PLAGUE**'
POPF:	.ASCIZ	'POPULATION IS '
	.ASCIZ	','
	.ASCIZ	'THE CITY OWNS '
	.ASCIZ	' ACRES.'
	.ASCIZ	'WE HARVESTED '
	.ASCIZ	' BUSHELS PER ACRE.'
RATF:	.ASCIZ	'RATS ATE '
	.ASCIZ	' BUSHELS, YOU HAVE '
	.ASCIZ	' BUSHELS IN STORE.'
	.ASCIZ	'LORD BARON:  LAND IS TRADING AT '
	.ASCIZ	' BUSHELS PER ACRE.'
HMAF:	.ASCIZ	'HOW MANY ACRES DO YOU WANT TO BUY?'
	.ASCIZ	'YOU MAY BUY ONLY '
SELF:	.ASCIZ	'HOW MANY ACRES DO YOU WANT TO SELL?'
FODF:	.ASCIZ	'HOW MANY BUSHELS TO USE AS FOOD?'
SEDF:	.ASCIZ	'HOW MANY ACRES TO PLANT WITH SEED?'
NEPF:	.ASCIZ	'BUT, LORD BARON, YOU HAVE ONLY '
	.ASCIZ	' PEOPLE AVAILABLE.'
NGSF:	.ASCIZ	'LORD BARON, YOU HAVE NO GRAIN LEFT AS SEED!'
REVF:	.ASCIZ	'REVOLUTION!!!'
BCTF:	.ASCIZ	'YOU ARE PROMOTED TO PRIME MINISTER OF BIRTH CONTROL!'
AGCF:	.ASCIZ	'YOU ARE PROMOTED TO PRIME MINISTER OF AGRICULTURE!'
FLSF:	.ASCIZ	'VERY GOOD! YOU SHOULD GO INTO THE REAL-ESTATE BUSINESS!'
NBPF:	.ASCII	'CONGRATULATIONS! YOU ARE AWARDED THE 1978 NOBEL PRIZE'
	.ASCIZ	' IN ECONOMICS!!!'
JSTF:	.ASCIZ	'PLEASE, LORD BARON, I AM IN NO MOOD FOR JESTING!'
NEBF:	.ASCIZ	'BUT, LORD BARON, YOU HAVE ONLY '
	.ASCIZ	' BUSHELS IN STORE.'
NEAF:	.ASCIZ	'BUT, LORD BARON, YOU HAVE ONLY '
	.ASCIZ	' ACRES.'
;
; DEFINE FCS STORAGE AREA:
;
	FSRSZ$	2,512.*<NBUF+1>	;TWO FILES (INPUT & OUTPUT)
;

; READ-ONLY INSTRUCTION AREA:
;
	.PSECT	BARRO,RO
;
BARON::	SETI			;SET 1 WORD INTEGER MODE
	SETF			;SET SINGLE PRECISION FLTG. PT.
	MOV	SP,SAVESP	;SAVE STACK POINT
	FINIT$			;INITIALIZE FCS
	MOV	#TIMBLK,R0	;ADDRESS OF TIME DATA BLOCK
	GTIM$S	R0		;GET TIME OF DAY
	MOV	G.TICT(R0),R1	;CLOCK TICKS...
	MUL	G.TISC(R0),R1	;...TIMES SECONDS
	BIC	#176000,R1	;TAKE LOW ORDER PART
	INC	R1		;MAKE NON-ZERO
1$:	JSR	PC,RANDNO	;GET A RANDOM NO.
	SOB	R1,1$		;REPEAT A FEW TIMES
	OPEN$W	#OUTFDB		;OPEN OUTPUT FILE
	FDBERR	,XIT		;QUIT IF CAN'T
	MOV	F.NRBD+2(R0),R0	;GET LINE ADDRESS
	MOV	#TITF,R5	;ADDR. OF TITLES
	MOV	#NTITS,R4	;NO. OF TITLE LINES
2$:	JSR	PC,MOVE		;MOVE TITLE TO BUFFER
	JSR	PC,PUT		;WRITE IT OUT
	SOB	R4,2$		;DO ALL TITLES
	JSR	PC,PUT2		;2 BLANK LINES
	MOV	#POPUI,POPU	;SET UP POPULATION,
	MOV	#STORI,STOR	;STORES,
	MOV	#HARVI,HARV	;HARVEST,
	MOV	#RATSI,RATS	;RATS,	
	MOV	#BUSHI,BUSH	;BUSHELS PER ACRE,
	MOV	#ACREI,ACRE	;ACRES,
	MOV	#ARRVI,ARRV	;& NO. OF ARRIVALS
	MOV	#1,PLAG		;NO PLAGUE AT FIRST
	CLR	STRV		;NO PEOPLE STARVED
	CLR	YEAR		;SET YEARS ELAPSED TO ZERO

NEWYR:	INC	YEAR		;COUNT ANOTHER YEAR
	CLR	R2		;FLAG FOR SUPPRESS LEADING ZEROES
	MOV	#YRMF,R5	;ADDR. OF YEAR NO. MESSAGE
	JSR	PC,MOVE		;MOVE TO LINE
	MOV	YEAR,R1		;GET YEAR NO.
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,PUT2		;WRITE IT OUT
	JSR	PC,MOVE		;MOVE LAST YEAR MESSAGE
	MOV	STRV,R1		;NO. OF PEOPLE STARVING
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,MOVE		;MOVE STARVED MESSAGE
	MOV	ARRV,R1		;NO. OF PEOPLE ARRIVED
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,MOVE		;MOVE ARRIVED MESSAGE
	JSR	PC,PUT		;WRITE OUT LINE
	ADD	ARRV,POPU	;UPDATE POPULATION
	TST	PLAG		;PLAGUE THIS YEAR?
	BNE	1$		;NO
	ASR	POPU		;YES, CUT POPULATION IN HALF
	JSR	PC,PUT		;BLANK LINE
	JSR	PC,MOVE		;MOVE PLAGUE MESSAGE
	JSR	PC,PUT2		;WRITE IT OUT
1$:	MOV	#POPF,R5	;ADDR. OF POPULATION MESSAGE
	JSR	PC,MOVE		;MOVE IT TO LINE
	MOV	POPU,R1		;GET POPULATION
	JSR	PC,$CBDSG	;CONVERT IT TO ASCII
	JSR	PC,MOVE		;MOVE COMMA
	JSR	PC,PUT		;WRITE LINE
	JSR	PC,MOVE		;MOVE CITY OWNS MESSAGE
	MOV	ACRE,R1		;GET NO. OF ACRES
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,MOVE		;MOVE ACRES MESSAGE
	JSR	PC,PUT2		;WRITE LINE
	TST	HARV		;ANY HARVEST?
	BEQ	2$		;NO!
	MOV	BUSH,R1		;GET NO. OF BUSHELS PER ACRE
	BEQ	2$		;NONE!
	JSR	PC,MOVE		;MOVE HARVESTED MESSAGE
	JSR	PC,$CBDSG	;CONVERT BUSHELS TO ASCII
	JSR	PC,MOVE		;MOVE BUSHELS PER ACRE MESSAGE
	JSR	PC,PUT2		;WRITE OUT LINE
2$:	MOV	#RATF,R5	;ADDR. OF RATS MESSAGE
	JSR	PC,MOVE		;MOVE TO LINE
	MOV	RATS,R1		;GET BUSHELS RATS ATE
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,MOVE		;MOVE BUSHELS MESSAGE
	MOV	STOR,R1		;GET BUSHELS IN STORE
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,MOVE		;MOVE BUSHELS IN STORE MESSAGE
	JSR	PC,PUT2		;WRITE OUT LINE
	CMP	POPU,#POPWIN	;ENOUGH PEOPLE TO WIN?
	BLE	3$		;NO, NOT YET
	JMP	WON		;YES, WON THE GAME!
3$:	JSR	PC,MOVE		;MOVE LAND TRADING MESSAGE
	JSR	PC,RANDNO	;GET A RANDOM NO. BETWEEN 0 & 1
	MULF	BUSHRG,F0	;MULTIPLY BY RANGE OF PRICES
	STCFI	F0,R4		;CONVERT TO INTEGER
	ADD	#BUSHMN,R4	;ADD MINIMUM PRICE
	MOV	R4,R1		;GET PRICE IN BUSHELS PER ACRE
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,MOVE		;MOVE BUSHELS PER ACRE MESSAGE
	JSR	PC,PUT2		;WRITE IT OUT

4$:	MOV	#HMAF,R5	;ADDR. OF ACRES TO BUY MESSAGE
	JSR	PC,MOVE		;MOVE IT TO LINE
	JSR	PC,PUT		;WRITE LINE
	JSR	PC,GETNUM	;READ NUMERIC RESPONSE
	TST	R1		;CHECK NO. OF ACRES ENTERED
	BGT	5$		;POSITIVE & NON-ZERO
	BEQ	8$		;ZERO, SEE IF WANTS TO SELL
	JSR	PC,JEST		;NEGATIVE, COMPLAIN
	BR	4$		;TRY FOR A SERIOUS ANSWER
5$:	MOV	R1,R3		;GET NO. OF ACRES BOUGHT
	MUL	R4,R3		;TIMES PRICE IN BUSHELS PER ACRE
	BCS	6$		;OVERFLOWED!
	CMP	R3,STOR		;SEE IF ENOUGH BUSHELS IN STORE
	BLE	7$		;OK
6$:	JSR	PC,NOBUSH	;NOT ENOUGH BUSHELS, COMPLAIN
	JSR	PC,MOVE		;MOVE MAY BUY MESSAGE
	MOV	STOR,R3		;GET STORES
	DIV	R4,R2		;DIVIDE BY PRICE
	MOV	R2,R1		;RESULT IS MAXIMUM ACRES CAN BUY
	CLR	R2		;FLAG TO SUPPRESS LEADING ZEROES
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,PUT2		;WRITE LINE
	BR	4$		;REPEAT QUESTION
7$:	ADD	R1,ACRE		;ADD TO ACRES OWNED
	SUB	R3,STOR		;SUBTRACT FROM STORES
	BR	FOOD
8$:	MOV	#SELF,R5	;ADDR. OF ACRES TO SELL MESSAGE
	JSR	PC,MOVE		;MOVE TO LINE
	JSR	PC,PUT		;WRITE LINE
	JSR	PC,GETNUM	;GET ANSWER
	TST	R1		;CHECK NO. OF ACRES TO SELL
	BLT	10$		;NEGATIVE!
	BEQ	FOOD		;ZERO
	CMP	R1,ACRE		;DO WE HAVE THAT MANY ACRES?
	BGT	9$		;NO
	MOV	R1,R3		;NO. OF ACRES
	MUL	R4,R3		;TIMES PRICE PER ACRE
	BCS	10$		;OVERFLOWED!
	ADD	STOR,R3		;ADD AMOUNT IN STORE
	BVS	10$		;OVERFLOWED!
	MOV	R3,STOR		;OK, SAVE NEW STORES
	SUB	R1,ACRE		;FIND NO. OF ACRES LEFT
	BR	FOOD
9$:	JSR	PC,NOACRE	;NOT ENOUGH ACRES
	BR	8$		;REPEAT QUERY
10$:	JSR	PC,JEST		;SURELY YOU JEST
	BR	8$		;BUT TRY AGAIN

FOOD:	MOV	#FODF,R5	;ADDR. OF FOOD MESSAGE
	JSR	PC,MOVE		;MOVE TO LINE
	JSR	PC,PUT		;WRITE LINE
	JSR	PC,GETNUM	;GET ANSWER
	MOV	R1,R3		;NO. OF BUSHELS AS FOOD
	BLT	2$		;NEGATIVE!
	BNE	1$		;IT'S OK
	JMP	REVOL		;ZERO!!
1$:	CMP	R3,STOR		;ENOUGH IN STORE?
	BLT	3$		;YES, OK
	BEQ	8$		;JUST BARELY
	JSR	PC,NOBUSH	;NO, COMPLAIN
	BR	FOOD		;TRY AGAIN
2$:	JSR	PC,JEST		;FUNNY, BARON
	BR	FOOD
3$:	SUB	R3,STOR		;DECREASE STORES REMAINING
4$:	MOV	#SEDF,R5	;ADDR. OF ACRES TO PLANT MESSAGE
	JSR	PC,MOVE		;MOVE TO LINE
	JSR	PC,PUT		;WRITE LINE
	JSR	PC,GETNUM	;GET RESPONSE
	MOV	R1,R4		;NO. OF ACRES TO PLANT
	BLT	5$		;NEGATIVE!
	CMP	R4,ACRE		;MORE THAN EXIST?
	BGT	6$		;YES (THAT'S BAD)
	INC	R1		;ADD ONE
	ASR	R1		;DIVIDE BY 2 GIVING SEED NEEDED
	CMP	R1,STOR		;ENOUGH SEED AVAILABLE?
	BLE	7$		;YES, OK
	JSR	PC,NOBUSH	;NO, COMPLAIN
	BR	4$		;TRY AGAIN
5$:	JSR	PC,JEST		;HA, HA
	BR	4$		;TRY FOR SENSE THIS TIME
6$:	JSR	PC,NOACRE	;NOT ENOUGH ACRES, COMPLAIN
	BR	4$		;REPEAT QUESTION
7$:	MOV	POPU,R1		;GET PEOPLE AVAILABLE
	MUL	#ACRPP,R1	;TIMES MAXIMUM ACRES PER PERSON
	CMP	R4,R1		;PLANT TOO MANY ACRES?
	BLE	CALC		;NO, OK
	MOV	#NEPF,R5	;YES, GET NOT ENOUGH PEOPLE MESSAGE
	JSR	PC,MOVE		;MOVE TO LINE
	MOV	POPU,R1		;GET POPULATION
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,MOVE		;MOVE TO LINE
	JSR	PC,PUT2		;WRITE OUT
	BR	4$		;REPEAT
8$:	CLR	STOR		;NO GRAIN LEFT
	MOV	#NGSF,R5	;ADDR. OF NO SEED MESSAGE
	JSR	PC,MOVE		;MOVE TO LINE
	JSR	PC,PUT2		;WRITE LINE
	MOV	#10000,R4	;SET LIMIT
9$:	JSR	PC,RANDNO	;RANDOMIZE
	SOB	R4,9$		;WASTE TIME WHILE THEY READ MESSAGE

CALC:	MOVB	#EOT,(R0)+	;PUT IN EOT (ERASE SCREEN)
	JSR	PC,PUT		;WRITE IT OUT
	MOV	R4,R1		;GET ACRES PLANTED
	INC	R1		;PLUS ONE (ROUND UP)
	ASR	R1		;OVER 2 GIVES BUSHELS USED AS SEED
	SUB	R1,STOR		;DEDUCT FROM STORES
	LDCIF	POPU,F1		;FLOAT THE POPULATION
	ADDF	POPADJ,F1	;ADJUST TO MAKE NON-ZERO
	MULF	STARV,F1	;TIMES BUSHELS TO PREVENT STARVATION
	LDCIF	R3,F0		;CONVERT FOOD TO FLOATING PT.
	DIVF	F1,F0		;RATIO OF FOOD GIVEN TO STARVATION POINT
	MOV	R0,-(SP)	;SAVE LINE ADDRESS
	MOV	R3,-(SP)	;SAVE AMOUNT OF FOOD
	MOV	R4,-(SP)	;SAVE ACRES PLANTED
	STFPS	-(SP)		;SAVE FPP STATUS
	JSR	PC,$$SQRT	;TAKE SQUARE ROOT OF RATIO
	LDFPS	(SP)+		;RESTORE FPP STATUS
	MOV	(SP)+,R4	;RESTORE REGISTERS
	MOV	(SP)+,R3
	MOV	(SP)+,R0
	STF	F0,F3		;SAVE RESULT ("Q-FACTOR")
	JSR	PC,RANDNO	;GET A RANDOM NO.
	MULF	BSHPA,F0	;TIMES AVERAGE BUSHELS PER ACRE
	MULF	F3,F0		;TIMES Q-FACTOR
	STCFI	F0,R5		;INTEGERIZE
	INC	R5		;ADD ONE TO INSURE NON-ZERO
	MOV	R5,BUSH		;NO. OF BUSHELS PER ACRE HARVESTED
1$:	MUL	R4,R5		;MULTIPLY BY ACRES PLANTED
	BCC	2$		;NO OVERFLOW
	DEC	BUSH		;TOO BIG, TRY A SMALLER NO.
	BR	1$		;DO IT AGAIN
2$:	MOV	R5,HARV		;RESULT IS BUSHELS HARVESTED
	CLR	R4		;CLEAR AMOUNT RATS EAT
	JSR	PC,RANDNO	;GET A RANDOM NO.
	MULF	EATFR,F0	;TIMES MAXIMUM "EAT FRACTION"
	STCFI	F0,R1		;CONVERT TO INTEGER
	BIT	#1,R1		;IS IT ODD?	
	BNE	3$		;YES, RATS GET NOTHING
	MOV	STOR,R5		;NO, GET BUSHELS IN STORE
	CLR	R4		;HIGH ORDER ZERO
	DIV	R1,R4		;DIVIDE BY "EAT FRACTION"
3$:	MOV	STOR,R1		;GET STORES
	ADD	HARV,R1		;ADD IN BUSHELS HARVESTED
	BVC	4$		;NO OVERFLOW
	MOV	HARV,R4		;TOO BIG, LET RATS EAT IT ALL
4$:	MOV	R4,RATS		;SET BUSHELS EATEN BY RATS
	SUB	R4,R1		;DEDUCT FROM STORES
	MOV	R1,STOR		;SAVE AMOUNT IN STORES

	LDCIF	ACRE,F1		;CONVERT ACRES TO FLOATING
	MULF	POPACR,F1	;TIMES POPULATION INCREASE PER ACRE
	LDCIF	STOR,F2		;CONVERT STORES TO FLOATING
	ADDF	F2,F1		;ADD IT IN
	MULF	F3,F1		;TIMES Q-FACTOR
	JSR	PC,RANDNO	;GET A RANDOM NO.
	MULF	F0,F1		;TIMES OTHER JUNK
	LDCIF	POPU,F2		;FLOAT POPULATION
	ADDF	POPCOR,F2	;ADD POPULATION CORRECTION CONSTANT
	DIVF	F2,F1		;DIVIDE INTO OTHER STUFF
	DIVF	INCCON,F1	;ALSO DIVIDE BY POPULATION INCREASE
	STCFI	F1,R1		;CONVERT RESULT TO INTEGER
	INC	R1		;ADD ONE
	MOV	R1,ARRV		;RESULT IS NO. OF PEOPLE ARRIVING
	LDCIF	R3,F0		;FLOAT BUSHELS FOR FOOD
	DIVF	STARV,F0	;DIVIDE BY MINIMUM BUSHELS PER PERSON 
	STCFI	F0,R1		;CONVERT RESULT TO INTEGER
	CLR	R4		;NO. OF PEOPLE STARVING
	CMP	POPU,R1		;ENOUGH FOOD THIS YEAR?
	BLT	5$		;YES, EVERYBODY STILL ALIVE
	MOV	POPU,R4		;NO, GET POPULATION...
	SUB	R1,R4		;...MINUS NO. FED IS NO. STARVING
	MOV	R1,POPU		;NEW POPULATION
5$:	MOV	R4,STRV		;SET NO. OF PEOPLE STARVED
	JSR	PC,RANDNO	;GET A RANDOM NO.
	MULF	PLGPRB,F0	;TIMES PLAGUE PROBABILITY
	LDCIF	R4,F1		;FLOAT NO. OF DEAD BODIES
	MULF	PLGSTV,F1	;TIMES COUPLING CONSTANT
	LDCIF	RATS,F2		;FLOAT AMOUNT RATS ATE
	ADDF	F2,F1		;ADD IT IN
	ADDF	PLGMIN,F1	;ADD MINIMUM PLAGUE FREQUENCY
	DIVF	F1,F0		;DIVIDE INTO OTHER STUFF
	STCFI	F0,PLAG		;INTEGERIZE TO GET PLAGUE CONSTANT
	JMP	NEWYR		;NEW YEAR!
REVOL:	MOV	#REVF,R5	;ADDR. OF REVOLUTION MESSAGE
	JSR	PC,PUT		;WRITE OUT BLANK LINE
	JSR	PC,MOVE		;MOVE MESSAGE TO LINE
	JSR	PC,PUT		;WRITE IT OUT
	BR	QUIT		;DONE
WON:	MOV	ACRE,R1		;GET ACRES AT WIN TIME
	CMP	R1,#ACR3	;EXCEED LEVEL 3?
	BGT	3$		;YES!!
	CMP	R1,#ACR2	;HOW ABOUT LEVEL 2?
	BGT	2$		;YES!
	CMP	R1,#ACR1	;TRY LEVEL 1
	BGT	1$		;BETTER THAN THAT ANYWAY
	MOV	#BCTF,R5	;NOTHING SPECTACULAR (BIRTH CONTROL)
	BR	4$
1$:	MOV	#AGCF,R5	;AGRICULTURE AWARD
	BR	4$
2$:	MOV	#FLSF,R5	;GRAND BARON I.S. AGAIN
	BR	4$
3$:	MOV	#NBPF,R5	;NOBEL PRIZE
4$:	JSR	PC,MOVE		;MOVE MESSAGE TO LINE
	JSR	PC,PUT		;WRITE LINE
QUIT:	CLOSE$	#OUTFDB		;CLOSE OUTPUT FILE
	FDBERR			;ERROR CHECK
XIT:	EXIT$S			;AU REVOIR
;

; SUBROUTINES FOR BARON PROGRAM:
;
; SUBROUTINE RANDNO -- GET RANDOM NO. BETWEEN 0.0 AND 1.0
; RETURNS RESULT (FLOATING POINT) IN F0.
;
RANDNO:	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	STFPS	-(SP)		;SAVE FPP STATUS
	MOV	#RANARG,R5	;ADDRESS OF RANDOM NO. SUBR ARGUMENTS
	JSR	PC,RANDU	;CALL F4+ RANDOM NO. GENERATOR
	LDFPS	(SP)+		;RESTORE FPP STATUS
	LDF	X,F0		;PUT RESULT INTO R0.
	MOV	(SP)+,R5	;RESTORE REGISTERS
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	PC		;RETURN
;
; SUBROUTINE PUT -- WRITE OUT CURRENT LINE & SET UP ANOTHER
; ENTERED WITH R0=ADDR. OF NEXT AVAILABLE CHARACTER IN LINE BUFFER
; RETURNS WITH R0=FIRST CHARACTER IN NEW LINE BUFFER
; ON ERROR, EXITS TO LABEL "QUIT" IN MAIN PROGRAM
;
PUT:	MOV	R4,-(SP)	;SAVE R4
	MOV	R0,R4		;OUTPUT LINE ADDRESS (CURRENT)
	MOV	#OUTFDB,R0	;OUTPUT FDB ADDRESS
	SUB	F.NRBD+2(R0),R4	;SUBTRACT START OF LINE GIVING LENGTH
	PUT$	R0,,R4		;WRITE OUT THE LINE
	FDBERR	,1$		;ERROR CHECK
	MOV	F.NRBD+2(R0),R0	;GET NEW LINE ADDRESS
	MOV	(SP)+,R4	;RESTORE R4
	RTS	PC		;RETURN
1$:	MOV	SAVESP,SP	;SET STACK TO INITIAL PLACE
	BR	QUIT		;QUIT PREMATURELY
;
; SUBROUTINE PUT2 -- WRITE OUT LINE PLUS A BLANK LINE
; (ENTERING & EXIT CONVENTIONS AS FOR SUBROUTINE PUT)
;
PUT2:	JSR	PC,PUT		;PUT-PUT
	JSR	PC,PUT
	RTS	PC
;

; SUBROUTINE GETNUM -- GET A NUMBER FROM KEYBOARD
; RETURNS WITH NUMBER IN R1
;
GETNUM:	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R2,-(SP)
1$:	GCML$	#GCLBLK		;GET A "COMMAND" LINE
	BCC	2$		;WORKED
	CMPB	G.ERR(R0),#GE.EOF;CONTROL-Z TYPED?
	BEQ	3$		;YES, LEAVE QUICKLY
	JSR	PC,GCLERR	;NO, TELL PEOPLE WHAT HAPPENED
	BR	1$		;TRY AGAIN
2$:	MOV	G.CMLD(R0),R2	;ANYTHING TYPED?
	BEQ	1$		;NO, IGNORE IT
	MOV	G.CMLD+2(R0),R0	;GET ADDRESS OF COMMAND
	ADD	R0,R2		;POINT PAST LAST CHARACTER TYPED
	CLRB	(R2)		;INSERT TERMINATOR
	JSR	PC,$CDTB	;CONVERT DECIMAL ASCII TO BINARY NO.
	MOV	(SP)+,R2	;RESTORE REGISTERS
	MOV	(SP)+,R0
	RTS	PC		;RETURN
3$:	MOV	SAVESP,SP	;RESTORE STACK POSITION
	BR	QUIT		;QUIT NOW (WHILE STILL AHEAD?)
;
; SUBROUTINE JEST -- PRINT "BARON IS JESTING" MESSAGE
;
JEST:	MOV	R5,-(SP)	;SAVE R5
	MOV	#JSTF,R5	;ADDR. OF JEST MESSAGE
	JSR	PC,MOVE		;MOVE IT TO LINE
	JSR	PC,PUT2		;WRITE IT OUT
	MOV	(SP)+,R5	;RESTORE R5
	RTS	PC		;RETURN
;
; SUBROUTINE NOBUSH -- PRINT "NOT ENOUGH BUSHELS" MESSAGE
;
NOBUSH:	MOV	R1,-(SP)	;SAVE REGISTERS
	MOV	R5,-(SP)
	MOV	#NEBF,R5	;ADDR. OF MESSAGE
	JSR	PC,MOVE		;MOVE TO LINE
	MOV	STOR,R1		;GET NO. OF BUSHELS IN STORES
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,MOVE		;MOVE BUSHELS IN STORE MESSAGE
	JSR	PC,PUT		;WRITE LINE
	MOV	(SP)+,R5	;RESTORE REGISTERS
	MOV	(SP)+,R1	
	RTS	PC		;RETURN
;
; SUBROUTINE NOACRE -- PRINT "NOT ENOUGH ACRES" MESSAGE
;
NOACRE:	MOV	R1,-(SP)	;SAVE REGISTERS
	MOV	R5,-(SP)
	MOV	#NEAF,R5	;ADDR. OF MESSAGE
	JSR	PC,MOVE		;MOVE IT TO LINE
	MOV	ACRE,R1		;GET NO. OF ACRES
	JSR	PC,$CBDSG	;CONVERT TO ASCII
	JSR	PC,MOVE		;MOVE ACRES MESSAGE TO LINE
	JSR	PC,PUT		;WRITE LINE
	MOV	(SP)+,R5	;RESTORE REGISTERS
	MOV	(SP)+,R1
	RTS	PC		;RETURN
;
	.END	BARON