100 	TMUAC=	NICODE+5^10+IOT	2	/M<0:5>=>AC<6:11>
 110 	TACLU=	NICODE+5^10+IOT	4	/AC<6:11>=>L<0:5>
 120 	TMLAC=	NICODE+6^10+IOT	1	/M<6:17>=>AC
 130 	TACLL=	NICODE+6^10+IOT	2	/AC=>L<6:17>
 140 	TDISP=	NICODE+6^10+IOT	4	/LOAD X, Y FROM ADDRESS AND ADDER
 150 	CCCF=	NICODE+7^10+IOT	1	/CLEAR COMPUTER CONTROL
 160 	SCCF=	NICODE+7^10+IOT	2	/SET COMPUTER CONTROL
 170 /	    =	NICODE+7^10+IOT	4	/NOT USED
 180 
 190 	FIELD	0			/ENSURE FIELD ZERO
 200 
 210 	*FNTABL+14			/PUT IN HASHED NAMES
 220 
 230 	"B^2+"L^2+"K			/BLK
 240 	"W^2+"R^2+"D			/WRD
 250 	"N^2+"I^2+"C			/NIC
 260 	EJECT
 270 	*NSTART			/START PATCH HERE FOR DIRECT LOADING
 280 
 290 /	DISK I/O FUNCTION:	FBLK(BLOCKNUMBER[,WRITEINDICATOR]).
 300 
 310 XBLK,	JMS I	INTEGER		/GET BLOCK ARGUMENT
 320 	PUSHA			/SAVE IT
 330 	PUSHJ			/FIND OUT IF WE WRITE
 340 LARG1,	ARG			/**** RELOCATE ****
 350 	NL4000			/MAKE IT A READ
 360 	TAD	IOWORD		/MAKE IT A WRITE
 370 	DCA	FUN		/PUT IN-LINE EITHER WAY
 380 	POPA			/RESTORE BLOCK ARGUMENT
 390 	DCA	TBLK		/PUT IN-LINE ALSO
 400 	JMS I	PSYSIO/(SYSIO)	/CALL FOR READ OR WRITE
 410 	0000			/CORE
 420 FUN,	.-.			/FILLED IN
 430 TBLK,	.-.			/FILLED IN
 440 	ION			/MAKE SURE INTERRUPTS ARE STILL ON
 450 	RETURN			/BACK TO FOCAL
 460 
 470 /	MEMORY REFERENCE FUNCTION:	FWRD(ADDRESS[,NEWVALUE]).
 480 
 490 XWRD,	JMS I	INTEGER		/GET ADDRESS ARGUMENT
 500 	PUSHA			/SAVE IT
 510 	PUSHJ			/EVALUATE SECOND IF ANY
 520 LARG2,	ARG			/**** RELOCATE ****
 530 	JMP	GET		/NONE, JUST GET VALUE
 540 	POPA			/RESTORE ADDRESS
 550 	AND	(N^200-1)	/MASK OFF BAD BITS
 560 	DCA	TBLK		/SAVE AS POINTER
 570 	JMS I	INTEGER		/GET REPLACEMENT VALUE
 580 	CDF	BUFFLD		/GOTO BUFFER FIELD
 590 	DCA I	TBLK		/STORE IT
 600 	JMP	GET2		/FINISH UP
 610 
 620 GET,	POPA			/GET BACK ADDRESS
 630 	AND	(N^200-1)	/MASK OFF BAD BITS
 640 	DCA	TBLK		/SAVE IT
 650 	CDF	BUFFLD		/GOTO BUFFER FIELD
 660 GET2,	TAD I	TBLK		/GET VALUE
 670 	SPA CLA			/IS IT POSITIVE?
 680 	NL7777			/NO, EXTEND NEGATIVE SIGN
 690 	DCA	FLAC+1		/SAVE HIGH-ORDER EITHER WAY
 700 	TAD I	TBLK		/GET IT AGAIN
 710 	CDF	00		/BACK TO US
 720 NWEXIT,	DCA	FLAC+2		/STORE LOW-ORDER
 730 NREXIT,	TAD	(27)		/GET EXPONENT VALUE
 740 	DCA	FLAC		/STORE EXPONENT
 750 	RETURN			/RETURN TO FOCAL
 760 	EJECT
 770 /	AVERAGER FUNCTION:	FNIC(ADDRESS[,NEWVALUE]).
 780 
 790 XNIC,	JMS I	INTEGER		/GET ADDRESS ARGUMENT
 800 	PUSHA			/SAVE IT
 810 	SCCF			/SET COMPUTER CONTROL
 820 	STOP			/STOP HARDWIRE PROGRAM
 830 	TSTOP			/IS IT STOPPED?
 840 	JMP	.-1		/NO, WAIT FOR IT
 850 	PUSHJ			/FIND OUT IF WE WRITE
 860 LARG3,	ARG			/**** RELOCATE ****
 870 	JMP	GETVALUE	/NO, WE READ
 880 	JMS	SETADRESS	/SETUP ADDRESS
 890 	JMS I	INTEGER		/GET SECOND ARGUMENT
 900 	RMRL			/RESET M, L REGISTERS
 910 	TACLL!TDISP		/TRANSFER AC, LOAD X, Y
 920 	CLA			/CLEAN UP
 930 	TAD	FLAC+1		/GET MOST SIGNIFICENT BITS
 940 	TACLU			/LOAD UPPER L BITS
 950 	LANDM!WRITE		/M<=M+L, MEM(ADDRESS)<=C(M)
 960 	CLA			/CLEAN UP
 970 	CCCF			/CLEAR COMPUTER CONTROL
 980 	RMRL			/RESET M, L
 990 	STARTR			/START READOUT PROGRAM
1000 	DCA	FLAC+1		/CLEAR HIGH-ORDER
1010 	JMP	NWEXIT		/EXIT WITH CLEAR FLAC
1020 
1030 GETVALU,JMS	SETADRESS	/SETUP ADDRESS
1040 	WRITE			/C(M)=>MEM(ADDRESS)
1050 	TMLAC!TDISP		/READ M, LOAD X, Y
1060 	DCA	FLAC+2		/SAVE LOW-ORDER BITS
1070 	TMUAC			/GET HIGH-ORDER BITS
1080 	DCA	FLAC+1		/SAVE HIGH-ORDER BITS
1090 	TAD	FLAC+1		/GET IT BACK
1100 	AND	(40)		/JUST SIGN BIT
1110 	SZA CLA			/SKIP IF POSITIVE
1120 	TAD	P7700/[-100]	/ELSE SET SIGN EXTENSION BITS
1130 	TAD	FLAC+1		/ADD ON OTHER BITS
1140 	DCA	FLAC+1		/STORE BACK COMPOSITE
1150 	CCCF			/CLEAR COMPUTER CONTROL
1160 	RMRL			/RESET M, L
1170 	STARTR			/START READOUT PROGRAM
1180 	JMP	NREXIT		/FINISH THERE
1190 
1200 SETADRE,.-.			/SETUP ADDRESS ROUTINE
1210 	POPA			/GET ADDRESS VALUE
1220 	RMRL			/RESET M, L