/ 
/ 
/                   FIRST PRINTING, FEBRUARY 1974
/ 
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO 
/ CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
/ AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPON-
/ SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS
/ DOCUMENT.
/ 
/ THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR-
/ NISHED TO THE PURCHASER UNDER A LICENSE FOR USE ON
/ A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
/ INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR 
/ USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PRO-
/ VIDED IN WRITING BY DIGITAL.
/ 
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/ FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP-
/ MENT THAT IS NOT SUPPLIED BY DIGITAL.
/ 
/ COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
        .EJECT
	.TITLE	FNEW
/
/FOCAL EXTERNAL FUNCTION PROGRAM
/
/COPYRIGHT 1969,1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754
/
/DAVE LENEY
/2-7-69
/
/EDIT 004
/
	.GLOBL	.NEWF		/FUNCTION TABLE
	.GLOBL	XPUSHJ		/PUSH JUMP
	.GLOBL	XPUSHA		/PUSH AC
	.GLOBL	PD2		/PUSH FP
	.GLOBL	PD3		/POP FP
	.GLOBL	UTRA		/GET CHAR
	.GLOBL	XSPNOR		/SKIP SPACE & ZEROS
	.GLOBL	FUNERR		/FUNCTION ERROR
	.GLOBL	EFUN3		/FUNCTION RETURN
	.GLOBL	FINT		/FLOATING ARITH
	.GLOBL	CHAR		/CHAR STORAGE
	.GLOBL	EVAL		/EXPRESSION EVALUATOR
	.GLOBL	.AA		/EXPONENT (2'S COMP)
	.GLOBL	.AB		/SIGN AND HIGH ORDER MANTISSA
	.GLOBL	.AC		/LOW ORDER MANTISSA
	.GLOBL	.BA		/NEGATE
	.GLOBL	.AX		/FIX
	.GLOBL	.AW		/FLOAT
FPOW=000000
FADD=100000
FSUB=200000
FMUL=300000
FDIV=400000
FGET=500000
FPUT=600000
FNOR=700000
FXIT=000000
/
	.EJECT
/
/FOCAL OPERATIONS (FOCAL SOURCE EQUIVALENT IN PARENS)
/
/PUSH JUMP TO EXPRESSION EVALUATOR (PUSHJ EVAL)
/	LAC	EVAL
/	DAC	.+2
/	JMS*	XPUSHJ
/	XX
/
/PUSH THE HARDWARE ACCUMULATOR (PUSHA)
/	JMS*	XPUSHA
/
/POP THE HARDWARE ACCUMULATOR (POPA)
/	LAC*	13
/
/PUSH FLOATING ACCUMULATOR (PUSHF.AA)
/	LAC	.AA
/	DAC	.+2
/	JMS*	PD2
/	XX
/POP FLOATING ACCUMULATOR (POPF .AA)
/	LAC	.AA
/	DAC	.+2
/	JMS*	PD3
/	XX
/
/PUSH FLOATING VARIABLE (PUSHF VAR)
/	JMS*	PD2
/	.DSA	VAR		/WHERE VAR IS THE FIRST OF
/				/THREE(3) REGISTER BLOCK
/
/POP FLOATING VARIABE (POPF VAR)
/	JMS*	PD3
/	.DSA	VAR		/SAME AS FOR PUSHF VAR
/
/FETCH CURRENT CHARACTER
/	LAC*	CHAR
/
/FETCH NEXT CHARACTER (GETC)
/	JMS*	UTRA		/CHARACTER IN BOTH CHAR AND AC
/
/IGNORE LEADING SPACES AND ZEROS (SPNOR)
/	JMS*	XSPNOR		/NEXT CHARACTER IN BOTH CHAR AND AC
/
/INDICATE A FUNCTION ERROR (ERROR NN)
/	.DEC
/	LAW	NN		/NN=TWO DIGIT (DECIMAL) ERROR CODE
/	.OCT
/	JMP*	FUNERR		/ERROR WILL HAVE DOUBLE QUESTION MARK
/
/RETURN FROM FUNCTION (RETURN)
/	JMP*	EFUN3		/VALUE OF FUNCTION IN FLOATING AC
/
/ENTER FLOATING POINT INTERPRETER (JMS FINT)
/	JMS*	FINT		/FROM HERE ON ALL INSTRUCTIONS
/	FNN	A		/ARE ASSUMED TO BE FLOATING POINT
/	FNN*	B		/UNTIL FXIT IS REACHED - FNN
/	FNN	C		/REFERS TO FLOATING POINT OPERATIONS
/	FXIT			/LISTED NEXT.
/
/FLOATING POINT OPERATIONS (USE * FOR INDIRECT)
/	FPOW	VAR		/RAISE F.P. AC TO VAR/CONSTANT
/	FADD	VAR		/ADD F.P. VARIABLE/CONSTANT TO F.P. AC
/	FSUB	VAR		/SUBTRACT FROM F.P. AC
/	FMUL	VAR		/MULTIPLY THE F.P. AC
/	FDIV	VAR		/DIVIDE INTO THE F.P. AC
/	FGET	VAR		/LOAD INTO THE F.P. AC
/	FPUT	VAR		/STORE THE F.P. AC
/	FNOR			/NORMALIZE THE F.P. AC
/	FXIT			/EXIT FROM FLOATING POINT MODE
/
/NEGATE THE FLOATING ACCUMULATOR
/	JMS*	.BA
/
/FIX THE FLOATING ACCUMULATOR INTO THE HARDWARE ACCUMULATOR
/	JMS*	.AX
/
/FLOAT THE HARDWARE ACCUMULATOR INTO THE FLOATING ACCUMULATOR
/	JMS*	.AW
/
/
/EXTERNAL FUNCTION TABLE FORMAT
/	WORD 0: TWO'S COMPLEMENT COUNT OF NUMBER OF ENTRIES
/	WORDS 1 TO 2N: N TWO WORD ENTRIES
/		EACH ENTRY:	WORD0: .SIXBT THREE LETTER FUNCTION NAME
/				WORD1: JMP TO FUNCTION ADDRESS
/
/
	.EJECT
/
/TABLE OF NAMES OF EXTERNAL FUNCTIONS
/
.NEWF	.NEWFE-.-1/2\777777+1	/TWO'S COMP COUNT OF NAMES
	.SIXBT	/DXS/
	JMP	SETX		/SET X COORDINATE
	.SIXBT	/DIS/
	JMP	SETYI		/SET Y COORDINATE AND INTENSIFY
	.SIXBT	/DXY/
	JMP	SETXYI		/SET X AND Y AND INTENSIFY
	.SIXBT	/ADC/		
	JMP	SETADC		/SET MULTIPLEXER AND CONVERT
	.SIXBT	/DAC/		
	JMP	SETDAC		/LOAD D/A CONVERTER
	.SIXBT	/RLB/		
	JMP	SETRLB		/SET RELAY BUFFER
	.SIXBT	/RND/
	JMP	RAND		/RANDOM NUMBER ROUTINE
.NEWFE=.
/
/IOT DEFINITIONS
/
DYL=700606			/LOAD Y COORDINATE
DXS=700546			/LOAD X COORDINATE AND INTENSIFY
ADSF=701301			/SKIP ON A/D FLAG
ADSC=701304			/SELECT AND CONVERT
ADRB=701312			/READ A/D BUFFER
ADSM=701103			/SET MULTIPLEXER
DAL1=705501			/LOAD D/A CHANNEL ONE
ORC=702101			/CLEAR RELAY BUFFER
ORS=702104			/SET RELAY BUFFER
/
	.EJECT
SETX	JMS*	.AX		/SET X COORDINATE
	DAC	XCOORD		/SAVE
	JMP*	EFUN3		/RETURN
SETYI	JMS*	.AX		/SET Y COORDINATE
	DYL			/LOAD REG WITH Y
	LAC	XCOORD
	DXS			/LOAD WITH X AND INTENSIFY
	JMP*	EFUN3		/RETURN
SETXYI	JMS*	.AX		/SET X COORDINATE
	DAC	XCOORD		/SAVE
	JMS	GETARG
	JMP	SETYI		/NOW SAME AS FDIS
SETADC	JMS*	.AX		/GET MULTIPLEXER CHANNEL
	ADSM			/NOTE: WILL USE LOW ORDER
				/SIX BITS AS CHANNEL NUMBER
	IOF			/TURN OFF INTERRUPT SYSTEM
	ISA+10		
	ADSC			/SELECT AND CONVERT
	ADSF			/WAIT FOR FLAG
	JMP	.-1
	ADRB			/READ A/D BUFFER
////CODE REMOVED WHICH PROPAGATED SIGN BIT ASSUM. 12 BIT A/D
///WAD AUGUST 1969...
	JMS*	.AW		/FLOAT RESULT
	LAC	(400000		/TURN ON INTEVVUPT SYSTEM
	ISA
	ION
	JMP*	EFUN3		/RETURN
SETDAC	JMS*	.AX		/GET VALUE AS INTEGER
	DAL1
	JMP*	EFUN3
SETRLB	JMS*	.AX		/GET VALUE
	SMA			/IS IT MINUS
	JMP	.+4		/NO - GO FIND BIT POSITION
	DZM	RELAYB
	ORC			/YES - CLEAR WHOLE RELAY BUFFER
	JMP*	EFUN3		/RETURN
	CMA			/FORM ONE'S COMP
	DAC	TEMP		/SAVE AS COUNT
	.DEC
	TAD	(18		/MUST BE RELAY 0 TO 17
	.OCT
	SMA			/IS IT LEGAL POSITION
	JMP	.+3		/YES
	.DEC
	LAW	2		/NO
	.OCT
	JMP*	FUNERR		/??02 ERROR
	CLA!CLL!CML			/INITIALIZE AC
	RAR
	ISZ	TEMP		/PUT BIT IN RIGHT
	JMP	.-2		/POSITION
	DAC	TEMP		/SAVE BIT POSITION
	JMS	GETARG
	LAC	TEMP		/CLEAR OLD RELAY VALUE
	CMA
	AND	RELAYB
	DAC	RELAYB		/SAVE NEW BUFFER
	JMS*	.AX	
	SZA!CLA			/CLEAR OR SET RELAY
	LAC	TEMP		/IF NON ZERO SET
	XOR	RELAYB
	DAC	RELAYB
	ORS			/LOAD BUFFER
	JMP*	EFUN3		/RETURN
/
GETARG	0			/GET ARGUMENT
	JMS*	XSPNOR		/SKIP SPACES
	SAD	(254		/IS IT A COMMA?
	JMP	.+3		/YES
	.DEC
	LAW	1		/NO - ??01 ERROR
	.OCT
	JMP*	FUNERR		/EXTERNAL FUNCTION ERROR
	JMS*	UTRA		/SKIP COMMA
	LAC	EVAL
	DAC	.+2
	JMS*	XPUSHJ		/CALL EXPRESSION EVALUATOR
	XX
	JMP*	GETARG		/RETURN
/
XCOORD	0			/X COORDINATE STORAGE
RELAYB	0			/RELAY BUFFER STORAGE
TEMP	0			/TEMPORARY STORAGE
/
/ROUTINE TO GENERATE A RANDOM NUMBER	//DEC. 1970 
/NUMBER SEQUENCE CAN BE INITIALIZED
/BY HAVING A NON-ZERO FUNCTION ARGUMENT
/
/USES A SIMULATED 18BIT SHIFT REGESTER
/WHICH IS SHIFTED 1 BIT RIGHT WITH FEEDBACK
/FROM THE 7'TH&18'TH STAGES TO THE 1'ST STAGE
/THROUGH AN EXCLUSIVE OR GATE
/
RAND	JMS*	.AX		/GET ARGUMENT IN AC
	SZA			/IS IT 0
	JMP	STGEN		/NO  GENERATE RANDOM NUMBER
	LAC	RANPT		/YES  IS LAST RANPT 0
	SNA
	LAW	-1			/YES  INITIALIZE RANPT
STGEN	DAC	RANPT		/START TO GENERATE
	RCR			/NEW RANDOM NUMBER
	DAC	RANPT		/BY SHIFTING ONE BIT RIGHT
	GLK			/GET BIT17 AND STORE (STAGE18)
	DAC	BITSAV
	LAC	RANPT
	RTR			/GET BIT6 (STAGE 7)
	RTR			/SETUP TO FEEDBACK TO BIT0
	RTR			/(STAGE 1) THROUGH XOR GATE
	RTR
	RTR
	AND	(1
	XOR	BITSAV
	SZA
	TAD	(377777		/FEEDBACK A ONE
	TAD	RANPT		/MAKEUP NEW RANDOM NUMBER
	DAC	RANPT		/STORE FOR FUTURE USE
	DAC*	.AB		/SET SIGN AND HIGH ORDER MANTISSA
	DZM*	.AA		/SET EXPONENT=0
	DZM*	.AC		/SET LOW ORDER MANTISSA=0
	JMP*	EFUN3		/EXIT TO FUNCTION RETURN
BITSAV	0
RANPT	0
/
	.END
