Google
 

Trailing-Edge - PDP-10 Archives - BB-JF16A-SB_1986 - check.mac
There are 4 other files named check.mac in the archive. Click here to see a list.
;<MICRO-LEWINE>CHECK.MAC.143, 19-Jan-78 10:47:47, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.142, 19-Jan-78 10:32:09, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.141, 19-Jan-78 10:08:04, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.140, 18-Jan-78 17:02:10, EDIT BY LEWINE
;ADD CODE TO FIND DUPLICATES WITH DIFFERENT JUMP ADDRESSES
;<MICRO-LEWINE>CHECK.MAC.139, 30-Nov-77 15:01:02, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.138, 30-Nov-77 13:35:49, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.137, 30-Nov-77 11:45:19, EDIT BY LEWINE
;1. IMPROVE CHECK FOR WRITING CONSTANT REGISTERS
;2. REMOVE CHECKS FOR ADDING .25
;3. PMAP 10 PAGES AT A TIME
;<MICRO-LEWINE>CHECK.MAC.135,  9-Nov-77 13:57:33, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.134,  9-Nov-77 13:45:44, EDIT BY LEWINE
;CHECK FOR CORRECT USE OF TRAP FLAGS
;<MICRO-LEWINE>CHECK.MAC.132, 28-Oct-77 17:05:02, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.131, 28-Oct-77 17:01:22, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.129, 28-Oct-77 09:59:49, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.128, 28-Oct-77 09:45:43, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.127, 27-Oct-77 16:32:11, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.126, 27-Oct-77 11:32:13, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.125, 27-Oct-77 11:31:45, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.124, 27-Oct-77 10:27:58, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.123, 26-Oct-77 17:55:16, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.120, 26-Oct-77 17:27:48, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.118, 25-Oct-77 19:14:43, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.117, 25-Oct-77 17:48:58, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.116, 25-Oct-77 17:40:54, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.115, 25-Oct-77 17:29:43, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.114, 25-Oct-77 17:23:07, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.112, 25-Oct-77 17:20:13, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.111, 25-Oct-77 17:19:06, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.109, 25-Oct-77 16:47:04, EDIT BY LEWINE
;CONVERT TIME CALCULATION TO WORK FOR PROTO
;<MICRO-LEWINE>CHECK.MAC.107, 19-Oct-77 15:50:02, EDIT BY LEWINE
;FIX EAMODE DISP TO BE 16-WAY
;<MICRO-LEWINE>CHECK.MAC.106, 14-Oct-77 15:00:18, EDIT BY LEWINE
;FIX CRY2 TIME
;<MICRO-LEWINE>CHECK.MAC.103, 10-Oct-77 14:32:30, EDIT BY LEWINE
;REDO FOR PROTO MACHINES
;<MICRO-LEWINE>CHECK.MAC.102,  2-Sep-77 14:08:54, EDIT BY LEWINE
;1. CHECK FOR WRITING CONSTANTS
;<MICRO-LEWINE>CHECK.MAC.101, 10-Aug-77 16:36:13, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.100, 31-Jul-77 16:19:11, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.99, 31-Jul-77 16:02:48, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.98, 31-Jul-77 15:54:42, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.97, 29-Jul-77 17:04:26, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.96, 29-Jul-77 15:33:21, Edit by LEWINE
;<MICRO-LEWINE>CHECK.MAC.96, 29-Jul-77 15:33:17, Edit by LEWINE
;<MICRO-LEWINE>CHECK.MAC.92, 25-Jul-77 14:04:40, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.91, 25-Jul-77 14:00:41, EDIT BY LEWINE
;1. MAKE RETURN TABLE CRAMSZ
;2. FIX ASKYN TO USE RDTTY JSYS
;3. ADD A ROUTINE TO LOOK FOR DUPLICATE INSTRUCTIONS
;<MICRO-LEWINE>CHECK.MAC.89, 17-Jul-77 18:04:21, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.88, 15-Jul-77 12:42:19, EDIT BY LEWINE
;	MAKE NICOND BE 2-TICK INSTRUCTION
;<MICRO-LEWINE>CHECK.MAC.87,  6-Jul-77 10:09:23, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.86,  6-Jul-77 09:47:51, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.85,  6-Jul-77 09:42:17, EDIT BY LEWINE
;MAKE SURE FILES GET CLOSED CORRECTLY
;<MICRO-LEWINE>CHECK.MAC.84,  1-Jul-77 15:58:31, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.81,  1-Jul-77 15:11:01, EDIT BY LEWINE
;ALLOW TABLES TO BE APPENDED TO INPUT LISTING
;MAKE "HERE FROM" TABLE OPTIONAL
;<MICRO-LEWINE>CHECK.MAC.78, 29-Jun-77 17:27:59, EDIT BY LEWINE
;REMOVE "COULD GO IN 1 TICK MESSAGE"
;<MICRO-LEWINE>CHECK.MAC.77, 29-Jun-77 17:21:12, EDIT BY LEWINE
;MAKE PAGE FAIL DISP BE 16-WAYS
;FIX T-FIELD CALC TO NOT GENERATE A WARNING IF T-FIELD IS .GT. 2
; TICKS BUT THERE IS AN MB WAIT.
;<MICRO-LEWINE>CHECK.MAC.76, 12-May-77 14:53:54, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.75, 12-May-77 11:14:22, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.74, 12-May-77 10:39:36, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.73, 12-May-77 10:19:22, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.72, 12-May-77 09:16:29, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.71, 11-May-77 10:44:33, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.70, 11-May-77 10:29:18, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.69, 10-May-77 13:21:35, EDIT BY LEWINE
;	EA MODE DISPATCH FIX WAS WRONG. 
;<MICRO-LEWINE>CHECK.MAC.68,  9-May-77 17:52:26, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.66,  9-May-77 16:05:01, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.65,  9-May-77 13:37:26, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.64,  9-May-77 13:05:17, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.63,  9-May-77 11:42:35, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.60,  8-May-77 14:10:18, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.59,  8-May-77 13:48:58, EDIT BY LEWINE
;	STILL DOING T-FIELD CHECK
;<MICRO-LEWINE>CHECK.MAC.56,  6-May-77 17:13:36, EDIT BY LEWINE
;<MICRO-LEWINE>CHECK.MAC.55,  6-May-77 17:11:46, EDIT BY LEWINE
;	MORE T-FIELD WORK
;<MICRO-LEWINE>CHECK.MAC.48,  6-May-77 16:42:04, EDIT BY LEWINE
;	START T-FIELD CHECK
;<MICRO-LEWINE>CHECK.MAC.42, 11-Apr-77 10:24:24, EDIT BY LEWINE
;	TEST MEMORY AND NICOND INTERACTION
;<MICRO-LEWINE>CHECK.MAC.40, 27-Mar-77 16:15:33, EDIT BY LEWINE
;	TEST FOR LOAD VMA ON MEM CYCLE WITHOUT # BITS 16 OR 17
;<MICRO-LEWINE>CHECK.MAC.38, 25-Mar-77 15:17:09, EDIT BY LEWINE
;	MAKE EA MODE DISPATCH MATCH THE CRA BOARD
;<MICRO-LEWINE>CHECK.MAC.36,  7-Mar-77 10:51:41, EDIT BY LEWINE
;	UNMAP INPUT BUFFER SO CONTROL-C/START WORKS
;<MICRO-LEWINE>CHECK.MAC.33,  3-Feb-77 11:43:20, EDIT BY LEWINE
;	REMOVE CHECK FOR MEM WAIT BUT RAM ADDRESS NOT VMA BECAUSE
;	MEM WAITS ARE NOW GENERATED ON ALL START MEMS ALSO
;<LEWINE>CHECK.MAC.24, 19-Jan-77 16:49:37, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.22, 19-Jan-77 16:38:49, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.21, 19-Jan-77 16:37:31, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.20, 19-Jan-77 16:21:36, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.19, 10-Jan-77 18:35:29, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.17,  5-Jan-77 11:32:28, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.15,  4-Jan-77 18:29:22, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.14,  4-Jan-77 17:45:57, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.12,  4-Jan-77 16:07:09, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.11,  4-Jan-77 16:04:05, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.9,  4-Jan-77 15:57:07, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.8,  4-Jan-77 15:53:40, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.4, 16-Nov-76 09:21:23, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.2, 15-Nov-76 17:10:46, EDIT BY LEWINE
;<LEWINE>CHECK.MAC.1, 15-Nov-76 10:47:43, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.40,  4-Nov-76 17:45:01, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.37,  3-Nov-76 14:42:28, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.36,  3-Nov-76 11:37:15, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.35,  3-Nov-76 11:24:44, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.34,  3-Nov-76 09:35:38, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.33,  2-Nov-76 17:47:07, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.32,  2-Nov-76 17:16:14, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.31,  2-Nov-76 17:06:39, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.30,  2-Nov-76 13:03:14, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.23,  1-Oct-76 17:14:49, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.21,  1-Oct-76 16:54:15, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.20,  1-Oct-76 16:46:38, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.19,  1-Oct-76 16:36:04, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.17,  1-Oct-76 14:03:59, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.15,  1-Oct-76 13:28:32, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.14,  1-Oct-76 13:17:52, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.13,  1-Oct-76 11:41:02, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.12,  1-Oct-76 11:22:51, EDIT BY LEWINE
;<LEWINE>UCHK.MAC.11,  1-Oct-76 11:00:48, EDIT BY LEWINE
	TITLE	CHECK (FORMERLY UCHK) - MICROCODE CHECKS
	SUBTTL	JUD LEONARD & DON LEWINE

	SEARCH	MACSYM,MONSYM
	.REQUI	SYS:MACREL
	RELOC	0

F=0	;FLAGS
A=1
B=2
C=3
D=4
RP=6	;POINTER INTO RAM BUFFERS
R=7	;CO-ROUTINE ADDRESS
W1=10
W2=11
W3=12
W4=13
W5=14
FP=15
CX=16
P=17

;FLAGS IN F
F.ARD==1
F.NARD==2
F.MBW==4
F.TYO==10		;OUTPUT LIST CHARS TO TTY, TOO.
F.NXB==20
F.TO==40
F.ERR==100		;ERROR OR WARNING GIVEN
RP.D==1B18	;DROM FLAG IN RP

PAGESZ==1000		;WORDS/PAGE
DROMSZ==^D512
CRAMSZ==4000

N.RET==2		;NUMBER OF LINE TO SCAN LOOKING
			; FOR A RETURN

VEDIT==45		;EDIT NUMBER
;FIXED CORE ALLOCATION

DEFINE	ASGN(NAME,SIZE),<
	NAME=..FCA
	..FCA==..FCA+SIZE
>

	..FCA==20000	;START OF FREE CORE AREA


ASGN(FCA,0)		;START OF FREE CORE AREA
ASGN(INBUF,PAGESZ*10)	;INPUT BUFFER
IBPAG==INBUF/PAGESZ
ASGN(DLINE,DROMSZ)	;LH=UNUSED, RH=LINE#
ASGN(CBUF1,CRAMSZ)	;UWORD BITS 0-35
ASGN(CBUF2,CRAMSZ)	;UWORD BITS 36-71
ASGN(CBUF3,CRAMSZ)	;UWORD BITS 72-107
ASGN(CLINE,CRAMSZ)	;UWORD LINE #
ASGN(CLINK,CRAMSZ)	;LH=LINE ORDER LIST, RH=FROM LIST
ASGN(CLNK2,CRAMSZ)	;LH=UNUSED, RH="TO" LIST
ASGN(CRTN,CRAMSZ)	;LIST OF RETURN POINTS
ASGN(RTNTAB,CRAMSZ)	;NUMBER OF RETURNS OF EACH TYPE
ASGN(DUPTAB,CRAMSZ)	;FLAGS FOR DUPLICATE WORD SCAN
ASGN(TIMETB,^D751)	;TIME HISTOGRAM
ASGN(IFREE,0)		;START OF FREE CORE

	OPDEF	NOP[JFCL]


	DEFINE	PUSHM(AC),<
IRP AC,<
	PUSH	P,AC
>>
	DEFINE	POPM(AC),<
IRP AC,<
	POP	P,AC
>>
;LIST FIELD NAMES AND POSITIONS IN LISTING WORD
	DEFINE	FIELD,<
	FLD	J,12,11,0
	FLD	AD,6,17,44
	IFLD	LSRC,3,17,0
	FLD	RSRC,3,20,0
	FLD	DEST,3,23,3
	FLD	A,4,29,0
	FLD	B,4,35,0
	FLD	RAMADR,3,38,4
	FLD	DBUS,2,41,1
	FLD	DBM,3,44,7
	FLD	CLKL,1,45,0
	FLD	GENL,1,46,0
	FLD	CHKL,1,47,0
	FLD	CLKR,1,48,0
	FLD	GENR,1,49,0
	FLD	CHKR,1,50,0
	FLD	SPEC,6,56,0
	IFLD	BYTE,3,56,0
	IFLD	SHSTYLE,3,56,0
	FLD	DISP,6,62,70
	FLD	SKIP,6,68,70
	FLD	T,3,71,0
	FLD	CRY38,1,72,0
	FLD	LDSC,1,73,0
	FLD	LDFE,1,74,0
	FLD	FMWRITE,1,75,0
	FLD	MEM,1,76,0
	FLD	DIVIDE,1,77,0
	FLD	MULTIPREC,1,78,0
	FLD	SHIFT,1,79,0
	FLD	CALL,1,80,0
	FLD	NO,18,107,0
	DFLD	A,4,5,0
	DFLD	B,4,11,0
	DFLD	ROUND,1,8,0
	DFLD	MODE,1,9,0
	DFLD	FLB,2,11,0
	DFLD	J,12,23,0
	DFLD	ACDISP,1,24,0
	DFLD	I,1,25,0
	DFLD	READ,1,26,0
	DFLD	TEST,1,27,0
	DFLD	WRITE,1,28,0
	DFLD	VMA,1,29,1
	DFLD	AWRITE,1,30,0
>;END FIELD DEFINITION
;	DISPATCH CODES
 ADISP==36
 AREAD==13
 BDISP==37
 BYTE==65
 CONSOLE==0
 DP==35
 DPLEFT==31
 DROM==12
 EAMODE==66
 MUL==62
 NICOND==64
 NORM==34
 PAGEFAIL==63
 RETURN==41
 SCAD0==67
;	SKIP CONDITIONS
 AC0==36
 ADEQ0==62
 ADLEQ0==32
 ADREQ0==33
 CRY0==31
 CRY1==56
 CRY2==51
 DP0==52
 DP18==53
 EXECUTE==64
 FPD==35
 INT==37
 IOLGL==4
 IOT==54
 JFCL==55
 KERNEL==34
 LE==42
 SC==63
 TXXX==57
 NOTCONTINUE==66
 NOTIOBUSY==65
;	SPECIAL FUNCTIONS
 APREN==25
 APRFLAGS==23
 ASHOV==44
 CLRCLK==11
 CLRCSH==24
 EXPTST==45
 FLAGS==46
 INHCRY2==40
 LDACBLK==47
 LDINST==61
 LDPAGE==14
 LDPI==43
 LDPXCT==16
 LOADIR==41
 LOADXR==21
 MEMCLR==27
 PREV==20
 PXCTOFF==36
 SWEEP==34
 WAIT==17
 NO==10
;UNUSED BIT MASKS

;THERE IS ONE MASK FOR EACH WORD. A 1 IN ANY POSITION INDICATES A BIT
; WHICH MUST BE ZERO

CMASK1:	3B25+3B31
CMASK2:	1B<^D39-^D36>+1B<^D69-^D36>
CMASK3:	777B<^D89-^D72>
DMASK:	3B1+3B7+1B12+1B30-1


DEFINE	WARN(A),<
	XLIST
	PUSHJ	P,REPORT
	NOP	[ASCIZ \% A AT \]
	LIST
>

DEFINE	ERR(A),<
	XLIST
	PUSHJ	P,REPORT
	NOP	[ASCIZ \? A AT \]
	LIST
>

DEFINE	MAX(AC,ARGS),<
	XLIST
	MOVX	AC,1B0
IRP ARGS,<
	CAMGE	AC,ARGS
	MOVE	AC,ARGS
>
	LIST
>
DEFINE	TMAX(AC,ARGS),<
	XLIST
	MOVX	AC,1B0
IRP ARGS,<
	CAMGE	AC,T$'ARGS
	JRST   [MOVE AC,T$'ARGS
		MOVEI AC+1,X$'ARGS
		JRST .+1]
>
	LIST
>

	SALL
;INITIALIZATION

;ENTRY VECTOR
ENTRYV:	JRST	1,START		;MAIN STARTING ADDRESS
	HALTF			;REENTER ADDRESS
	BYTE	(3)1(9)2(6)2(18)VEDIT


START:	RESET
	SETOM	A		;UNMAP ANY INPUT
	MOVE	B,[.FHSLF,,IBPAG] ; PAGE
	MOVX	C,PM%CNT+10
	PMAP
	ERJMP	.
	SETZM	FIRZER
	MOVE	A,[FIRZER,,FIRZER+1]
	BLT	A,ENDZER	;CLEAR OUT LOW CORE
	SETZM	FCA		;CLEAR BUFFERS
	MOVE	A,[XWD FCA,FCA+1]
	BLT	A,IFREE-1
	MOVEI	A,IFREE		;INITIAL FREE ADDR
	MOVEM	A,FREE#		;SETUP FREE SPACE POINTER
	MOVE	P,[IOWD 100,PDL]

;COMMAND PROCESSING
	HRROI	A,[ASCIZ /
INPUT: /]
	PSOUT
	MOVEI	A,GTIJFN		;ARG BLOCK
	MOVEI	B,0
	GTJFN				;GET JFN FOR INPUT
	ERMSG	<BAD INPUT FILE SPECIFICATION>
	MOVEM	A,INJFN#		;SAVE INPUT JFN
	MOVX	B,7B5+OF%APP
	OPENF
	ERJMP  [MOVX B,7B5+OF%RD
		MOVE A,INJFN
		JRST OPNIN]
	RFPTR
	ERMSG	<CAN NOT READ FILE POINTER>
	MOVEM	B,APPPTR#
	TXO	A,CO%NRJ+CZ%ABT+CZ%NUD
	CLOSF
	ERMSG	<SYSTEM ERROR: CLOSF FAILED>
	MOVE	A,INJFN
	MOVX	B,7B5+OF%RD+OF%WR
OPNIN:	OPENF				;OPEN INPUT
	ERMSG	<CAN NOT OPEN INPUT FILE>
	FFFFP				;FIND # OF PAGES IN INPUT FILE
	ADDI	A,10			;FUDGE FACTOR
	HRRZM	A,INSIZ#		;SAVE IT
	MOVE	A,[POINT 7,IFILE]
	HRRZ	B,INJFN
	MOVX	C,11111B14+JS%TMP+JS%CDR+JS%PSD+JS%PAF
	JFNS
	HRROI	A,[ASCIZ "
APPEND CHECK OUTPUT? "]
	PUSHJ	P,ASKYN
	  JRST	ASKOUT
	MOVE	A,INJFN
	MOVEM	A,OUTJFN
	MOVE	B,APPPTR
	SFPTR
	ERMSG	<CAN NOT SET FILE POINTER FOR APPEND>
	JRST	OPNOUT
ASKOUT:	HRROI	A,[ASCIZ /
OUTPUT: /]
	PSOUT
	MOVEI	A,GTOJFN
	MOVEI	B,0
	GTJFN				;GET JFN FOR OUTPUT
	ERMSG	<BAD OUTPUT FILE SPECIFICATION>
	MOVEM	A,OUTJFN#		;SAVE IT
	MOVX	B,7B5+OF%APP
	OPENF				;OPEN OUTPUT
	ERMSG	<CAN NOT OPEN OUTPUT FILE>
OPNOUT:	MOVEI	B,"L"-100
	BOUT
	ERMSG	<CAN NOT OUTPUT FORM FEED>
	MOVE	A,[POINT 7,OFILE]
	HRRZ	B,OUTJFN
	MOVX	C,11111B14+JS%TMP+JS%CDR+JS%PSD+JS%PAF
	JFNS
	MOVNI	A,10
	MOVEM	A,INPAG#
	SETZM	INBCT#

	SETZM	VERPOS#
	MOVE	A,[POINT 7,CBUF]
	MOVEM	A,CBPNT#

	SETOM	FRSTCW#		;FLAG NO CONTROL WORDS SEEN
	MOVEI	A,FRSTCW-CLINK	;GET ADDR OF FIRST CONTROL WORD ADDR
	MOVEM	A,LASTCW#	;SO FIRST UWORD BACK-LINKS TO FRSTCW
	SETZM	DJLIST#		;DROM J DISP LIST IS EMPTY
;FIND TITLE OF LISTING AND USE IT FOR THIS LISTING

	MOVE	W1,[POINT 7,TTLBUF]	;ADDRESS OF TITLE BUFFER
	MOVEI	W2,^D71		;BYTE COUNT
TTL1:	PUSHJ	P,GETC		;GET A CHAR
	CAIE	A,")"		;END OF EDIT #
	JRST	TTL1		;NO--KEEP LOOKING
	PUSHJ	P,GETC		;SKIP DELIMITER
TTL2:	PUSHJ	P,GETC		;GET A TITLE BYTE
	CAIN	A,"P"		;START OF WORD PAGE
	JRST	TTL3		;YES--ALL DONE
	IDPB	A,W1		;STORE IN TITLE BUFFER
	SOJG	W2,TTL2		;LOOP FOR FULL TITLE
TTL3:	PUSHJ	P,GETC
	CAIE	A,"A"		;STILL LOOK LIKE PAGE?
	JRST   [MOVEI B,"P"
		IDPB B,W1
		SOJLE W2,.+1
		IDPB A,W1
		SOJG W2,TTL2
		JRST .+1]
	MOVEI	A,0		;MAKE ASCIZ STRING
	IDPB	A,W1		; ..
	MOVEI	A,[ASCIZ "
ERRORS AND WARNINGS

"]
	MOVEM	A,SUBTTL
	PUSHJ	P,NEWPAG
	JRST	COMMNT		;EAT REST OF LINE
;HERE BEGIN SCAN OF MICRO LISTING

SCAN:	PUSHJ	P,SKPST			;GET NEXT CHAR FROM FILE
	CAIN	A,";"			;COMMENT?
	JRST	COMMNT
	CAIE	A,"U"			;U WORD?
	CAIN	A,"V"
	JRST	UWORD
	CAIN	A,"D"			;D WORD?
	JRST	DWORD
	CAIN	A,"E"			;END?
	JRST 	CHKEND
	CAIL	A,12			;IS IT LF, VT, FF, OR CR?
	CAILE	A,15
	JRST	BADSCN			;NO, TROUBLE
	JRST	SCAN

BADSCN:	PUSHJ	P,ILLCHR		;TELL WOES
	HRROI	A,[ASCIZ / IN SCAN
/]
	PSOUT

;FALL INTO COMMENT SCAN OFF

COMMNT:	PUSHJ	P,GETC			;GET NEXT CHAR
	CAIL	A,12			;LOOK FOR PAPER MOTION
	CAILE	A,14
	JRST	COMMNT			;NOPE, LOOK FURTHER
	JRST	SCAN
;HERE IS HANDLER FOR U AND V

UWORD:	AOS	UCNT#		;COUNT UP MICROWORDS
	PUSHJ	P,SKPST		;IGN SP AND TAB
	PUSHJ	P,GETOCZ	;COLLECT CRAM ADDR
	MOVEI	RP,(B)		;SAVE ADDR IN RAM
	CAILE	RP,CRAMSZ	;IN RANGE?
	JRST	ULOSE		;NOPE

	TRZ	F,F.NXB
	PUSHJ	P,SKPST
	PUSHJ	P,GETOCZ
	PUSHJ	P,GETOCT
	PUSHJ	P,GETOCT	;36 BITS IN B
	MOVEM	B,CBUF1(RP)
	TDNE	B,CMASK1	;CHECK FOR NON-X-BIT
	TRO	F,F.NXB

	PUSHJ	P,GETOCT
	PUSHJ	P,GETOCT
	PUSHJ	P,GETOCT
	MOVEM	B,CBUF2(RP)
	TDNE	B,CMASK2
	TRO	F,F.NXB

	PUSHJ	P,GETOCT
	PUSHJ	P,GETOCT
	PUSHJ	P,GETOCT
	MOVEM	B,CBUF3(RP)
	TDNE	B,CMASK3
	TRO	F,F.NXB

	PUSHJ	P,GTLINN	;GET LINE NUMBER
	HRRM	B,CLINE(RP)	;SAVE

	TRZE	F,F.NXB		;UNUSED BIT PROBLEMS?
	PUSHJ	P,REPORT	;REPORT IT
	NOP	[ASCIZ	/? UNUSED BITS SET IN CRAM AT /]

;CONTINUE CHECKS OF CRAM WORD

	LDB	A,C.A
;	CAILE	A,15
;	ERR	A REGISTER IS TOO LARGE
	LDB	A,C.B
;	CAILE	A,15
;	ERR	B REGISTER IS TOO LARGE
	SKIPN	[EXP -1,0,0,0,0,0,0,7,0,0,12,0,0,15,0,0](A)
	JRST	UCHK1
	LDB	B,C.DEST
	TRC	B,2
	CAIGE	B,2
	JRST	UCHK1
	MOVE	B,UCNT		;GET COUNT OF INSTRUCTIONS
	CAIGE	B,^D25		;IN STARTUP CODE?
	JRST	UCHK1		;YES--OK THEN
	JUMPE	A,WRTMAG	;WRITING MAG?
	CAIE	A,12		;WRITING MASK
	JRST	WRTERR		;NO--ERROR
	LDB	A,C.A
	JUMPN	A,WRTERR	;MUST BE FROM MAG
	LDB	A,C.DEST	;GET DEST FIELD
	CAIE	A,4		;Q_Q*2?
	CAIN	A,5		;AD*2
	JRST	WTMAG1		;YES
	JRST	WRTERR		;NO

WRTMAG:	LDB	A,C.A		;GET SRC
	CAIE	A,12		;SEE IF MAG
	JRST	WRTERR		;ERROR IF NOT
	LDB	A,C.DEST	;GET DEST FIELD
	CAIE	A,7		;AD*2
	CAIN	A,6		;Q_Q*.5?
	JRST	WTMAG1		;YES
	JRST	WRTERR		;NO
WTMAG1:	LDB	A,C.SHSTYLE	;GET SHIFT STYLE
	JUMPE	A,UCHK1		;JUMPE IF OK

WRTERR:	ERR	WIPING OUT A CONSTANT REGISTER
UCHK1:	LDB	A,C.CLKR
	JUMPN	A,UCHK2
	LDB	A,C.CLKL
	JUMPN	A,UCHK1A
	ERR	BOTH LEFT AND RIGHT CLOCKS INHIBITED
UCHK1A:	LDB	A,C.AD		;GET ALU FUNCTION
	CAILE	A,4		;ARITHMETIC OPERATION
	CAIL	A,30		; ..
	JRST	UCHK2		;NOT DOING ANY MATH
	LDB	A,C.SPEC	;GET SPECIAL CODE
	CAIE	A,INHCRY	;INHIBITING CRY18
	ERR	LEFT HALF ARITHMETIC WITHOUT INHIBITING CRY 18
UCHK2:	LDB	A,C.RAMADR
	SKIPE	[EXP 0,0,0,3,0,5,0,0](A)
	ERR	RAM ADDRESS IS UNDEFINED (3 OR 5)
	LDB	A,C.CALL	;IS THIS A CALL INSTRUCTION
	JUMPE	A,UCHK3		;NO--CHARGE AHEAD
	MOVE	W1,[-17,,1]	;ASSUME UP TO 16 WAY RETURN
UCALL:	HRRZ	A,RP		;COPY CURRENT ADDRESS
	TRO	A,(W1)		;PUT IN RETURN BITS
	PUSHJ	P,RTNTO		;PUT ON RETURN LIST
	AOBJN	W1,UCALL	;LOOP OVER ALL POSSIBLE
UCHK3:	LDB	A,C.DISP	;LOOK AT THE RETURN BIT
	CAIE	A,RETURN	;RETURN
	JRST	UCHK4		;NO--DO NEXT TEST
	LDB	A,C.J		;GET TARGET ADDRESS
	CAIL	A,77		;SEEM REASONABLE
	WARN	RETURN .GE. 100
	AOSA	RTNTAB(A)	;COUNT THE RETURN
	JRST	COMMNT		;DO NOT PUT IN JUMP TO LIST
UCHK4:	;ADD DBUS CHECKS HERE
UCHK5:	;ADD DBM CHECKS HERE
UCHK6:	;ADD BYTE CHECKS HERE
UCHK7:	LDB	B,C.SPEC	;GET SPECIAL CODE
	CAIE	B,WAIT		;MEMORY WAIT
	JRST	UCHK8		;NO--NOT SPEC MEM WAIT
	MOVEI	A,3777		;MAY PAGE FAIL
	PUSHJ	P,JMPTO		;MARK JUMP
	LDB	A,C.MEM		;MEM WAIT?
	JUMPE	A,UCHK10	;JUMP IF NOT
	WARN	BOTH MEM/1 AND SPEC/WAIT

UCHK8:	LDB	A,C.MEM		;MEM WAIT?
	JUMPE	A,UCHK10	;JUMP IF NOT
	MOVEI	A,3776		;POSSIBLE JUMP TO 3776
	PUSHJ	P,JMPTO		;MARK IT
	MOVEI	A,3777		;WE MIGHT SKIP TO HERE
	LDB	B,C.SKIP	;SEE IF THIS IS A SKIP
	CAIE	B,70		;??
	PUSHJ	P,JMPTO		;YES--GO MARK 3777
UCHK9:	LDB	A,C.NO		;GET MAGIC #
	ANDI	A,3		;MASK TO LOW 2 BITS
	JRST	@[EXP MEMER0,UCHK10,UCHK10,MEMER3](A)
MEMER0:	LDB	C,C.NO		;GET NUMBER
	TRNE	C,10		;LOADING VMA ALSO?
	JRST	UCHK10		;YES--ALL OK
	ERR	MEM CYCLE WITHOUT NUMBER BITS 16 OR 17 SET OR LOAD VMA
	JRST	UCHK10
MEMER3:	ERR	MEM CYCLE WITH BOTH NUMBER BITS 16 AND 17 SET
UCHK10:	LDB	A,C.CRY38	;INJECTING A CARRY?
;	JUMPE	A,UCK11A	;NO
;	LDB	A,C.AD		;YES--GET ADDER CODE
;	CAILE	A,7		;IS THE ADDER DOING A SUBTRACT
;	CAIL	A,27		; ..
;	WARN	ADDING .25 WHEN NOT DOING A SUBTRACT
;	JRST	UCHK11		;DO NEXT CHECK
;UCK11A:	LDB	A,C.AD		;DOING A SUBTRACT?
;	CAILE	A,7		; ..
;	CAIL	A,27		; ..
;	JRST	UCHK11		;NO--ALL SET
;	WARN	DOING A SUBTRACT WITHOUT ADDING .25
UCHK11:	LDB	A,C.FMWR	;WRITING THE RAM FILE
	JUMPE	A,UCHK12	;NO
	LDB	A,C.RAMA	;USING THE VMA
	CAIN	A,4		; ..
	WARN	FM WRITE USING VMA
UCHK12:	LDB	A,C.SPEC	;GET SPECIAL FUNCTION CODE
	XCT	CKSPEC(A)	;CHECK IT
;****	PUSHJ	P,BUMCK		;CHECK FOR NOP
	LDB	B,C.DISP	;GET DISPATCH CODE
	LDB	A,C.J		;GET JUMP ADDRESS
	XCT	DSPFNC(B)	;PROCESS DISPATCH
	LDB	B,C.SKIP	;ANY SKIP?
	CAIN	B,70		; ??
	JRST	UCHKX		;NO
	TROE	A,1		;YES--MARK SKIP LOCATION
	ERR	SKIP TO AN ODD LOCATION
	PUSHJ	P,JMPTO		;MARK JUMP ADDRESS
	LDB	B,C.SKIP	;GET SKIP AGAIN
	TRNN	B,7		;MUST NOT SELECT 0
	ERR	ILLEGAL SKIP CONDITION
UCHKX:	MOVE	A,LASTCW	;ADDRESS OF LAST CRAM WORD SEEN
	HRLM	RP,CLINK(A)	;LINK IT TO THIS
	MOVEM	RP,LASTCW	;SAVE THIS FOR NEXT
	HRROS	CLINK(RP)	;MARK THIS AS LAST
	JRST	COMMNT		;SCAN OFF REST AS COMMENT
;TABLE BUILDING MACROS

DEFINE	TBLST(NAME,SIZE,FILL),<
	XLIST
NAME:	REPEAT SIZE,<
	FILL
>
	..TBL==NAME
	..TBLE==.
	LIST
>


DEFINE	TBL(OFFSET,ADDR),<
	XLIST
	RELOC	..TBL+OFFSET
	PUSHJ	P,ADDR
	LIST
>

DEFINE	TBLEND,<
	RELOC	..TBLE
>
;DISPATCH TABLE


	TBLST	DSPFNC,100,<JRST ILLDSP>
	TBL	RETURN,CPOPJ
	TBL	1,CPOPJ
	TBL	DROM,DSPROM
	TBL	AREAD,DSPARD
	TBL	MUL,DSP8
	TBL	NICOND,DSPNI		;NICOND
	TBL	BYTE,DSP8		;BYTE
	TBL	EAMODE,DSPEA		;EA MODE
	TBL	SCAD0,DSPSCD		;SCAD
	TBL	DPLEFT,DSP16		;DPLEFT
	TBL	NORM,DSP9		;NORM
	TBL	DP,DSP16		;DP
	TBL	ADISP,DSP16		;DROM-A
	TBL	BDISP,DSP16		;DROM-B
	TBL	70,JMPTO		;DO NOT DISP
	TBLEND

ILLDSP:	ERR	ILLEGAL DISPATCH FUNCTION
	JRST	UCHKX
DSPSCD:	LDB	B,C.SKIP	;IS THERE A SKIP ALSO?
	CAIE	B,70		; ??
	JRST	DSP4		;YES--THEN IT IS A 4-WAY DISP
	PUSHJ	P,JMPTO
	TROE	A,2
	WARN	DISP/SCAD0 WITH A DEST ADDRESS WITH 1* PATTERN
	JRST	JMPTO

DSPARD:	PUSH	P,A
	MOVSI	W1,-20
DSPAR1:	MOVEI	A,40(W1)
	IOR	A,0(P)
	PUSHJ	P,JMPTO
	AOBJN	W1,DSPAR1
	POP	P,A
	JUMPE	A,DSPROM
	WARN	DISP/AREAD WITH NON-ZERO J FIELD
DSPROM:	MOVE	C,FREE
	AOS	FREE
	MOVE	D,DJLIST
	HRLI	D,(RP)
	MOVEM	D,(C)
	MOVEM	C,DJLIST
	POPJ	P,0

DSPEA:	LDB	B,C.SKIP	;IS THER A SKIP ALSO?
	CAIE	B,70
	JRST	DSP8
	MOVSI	W1,-20
	MOVEI	W2,1
	JRST	DSPNW0

DSPNI:	PUSHJ	P,ISFLAG	;DOES THIS GUY CHANGE FLAGS
	  SKIPA			;NO
	ERR	NICOND AND TRAP FLAGS IN SAME INSTRUCTION
	LDB	B,C.J		;GET J FIELD
	TRNE	B,7		;FULL 8-WAY DISPATCH
	WARN	STRANGE DISP/NICOND
	TRNN	B,10		;STARTING A FETCH
	JRST	DSPNI1		;NO
	CAIE	B,200		;STARTING A FETCH
	LDB	B,C.MEM		;MEMORY CYCLE BIT
	SKIPN	B		;SET?
	ERR	<"NEXT INST FETCH" WITHOUT MEM/1>
	LDB	B,C.NO
	TRNN	B,100000	;FETCH CYCLE?
	ERR	<"NEXT INST FETCH" WITHOUT FETCH>
	JRST	DSP16

DSPNI1:	LDB	B,C.MEM		;MEMORY CYCLE?
	JUMPE	B,DSP16		;NO
	LDB	B,C.NO		;GET NUMBER
	TRNE	B,170000	;STARTING ANYTHING?
	ERR	DISP/NICOND AND J/0 AND STARTING MEMORY
	JRST	DSP16
;PROCESS DISPATCHES

DSP16:	MOVSI	W1,-20
	JRST	DSPNW

DSP9:	SKIPA	W1,[XWD -^D9,0]
DSP8:	MOVSI	W1,-10
	JRST	DSPNW

DSP4:	MOVSI	W1,-4
	JRST	DSPNW

DSP2:	MOVSI	W1,-2
	JRST	DSPNW

DSPNW:	MOVEI	W2,0
DSPNW0:	PUSH	P,A
DSPNB:	MOVE	A,0(P)
	MOVEI	B,(W1)
	TDZ	B,W2
	IORI	A,(B)
	PUSHJ	P,JMPTO
	AOBJN	W1,DSPNB	;DO THEM ALL
	POP	P,A
	POPJ	P,
;TABLE OF SPECIAL FUNCTIONS

	TBLST	CKSPEC,100,<JFCL>
	TBL	PREV,S$PREV
	TBL	FLAGS,S$FLAGS
	TBL	ASHOV,S$ASHOV
	TBLEND
;CHECK PC FLAG UPDATES

S$FLAGS:
	LDB	A,C.DBM		;LOOK AT DBM MIXER
	CAIE	A,7		;SELECTING MAGIC #
	ERR	DBM NOT SELECTING # FOR SPEC/FLAGS
	LDB	B,C.NO		;GET NUMBER
	TRNE	A,700000	;TRAP 1 TYPE THING?
	TRNE	A,001000	;WANT TRAP 1?
	SKIPA			;HAVE BOTH
	ERR	SETTING OVERFLOW WITHOUT TRAP FLAGS
	POPJ	P,0		;OK


;CHECK SPEC/PREV
S$PREV:	LDB	A,C.MEM		;GET MEM BIT
	CAIE	A,1		;MUST BE SET
	ERR	SPEC/PREV BUT NOT MEM/1
	LDB	A,C.NO		;GET THE NUMBER
	TRNN	A,10		;LOADING VMA
	ERR	<SPEC/PREV REQUIRES THE "LOAD VMA" MACRO>
	POPJ	P,0

;CHECK SPEC/ASHOV
S$ASHOV:
	LDB	A,C.DEST	;GET THE DESTINATION
	TRC	A,2
	CAIGE	A,6		;SHIFTING LEFT
	ERR	SPEC/ASHOV BUT NOT SHIFTING LEFT
	POPJ	P,0
;CHECK FOR CODE BUMS
BUMCK:	LDB	A,C.AD		;GET AD FUNCTION
	CAIE	A,44		;IS THIS THE DEFAULT
	POPJ	P,0		;NO--ASSUME OK
	LDB	A,C.DEST	;SOMETHING COMMING OUT A, OR Q SHIFT
	TRNN	A,1		; ..
	POPJ	P,0		;YES--DOES SOMETHING
	LDB	A,C.SPEC	;ANY SPECIAL FUNCTIONS
	CAILE	A,7		; ..
	POPJ	P,0
	LDB	A,C.SKIP	;GET SKIP
	CAIE	A,70
	POPJ	P,0
	LDB	A,C.DISP
	CAIE	A,70
	POPJ	P,0
	MOVE	A,CBUF3(RP)
	TDNN	A,[EXP 177B<^D84-^D72>]
	WARN	INSTRUCTIONS CAN BE COMBINED
	POPJ	P,0
;HERE TO MARK MICRO WORD AS JUMPED-TO FROM ANOTHER
; A CONTAINS ADDR JUMPED-TO, RP CONTAINS ADDR JUMPED-FROM

JMPTO:	MOVEI	B,CLINK(A)	;BEGINNING OF LIST
	HRRZ	C,CLINK(A)	;GET FIRST LINK
	JUMPE	C,JMPTO2	;IF NONE, PLUG THIS IN HERE
JMPTO1:	MOVEI	B,(C)		;COPY LIST ADDR
	HRRZ	C,0(B)		;POINTER TO NEXT
	JUMPN	C,JMPTO1	;SEARCH FOR END OF LIST
	HLRZ	C,0(B)		;GET LAST RECORDED JUMP-FROM
	CAIN	C,0(RP)		;EQUAL THIS ONE?
	POPJ	P,		;YES, DON'T RECORD TWICE
JMPTO2:	MOVE	C,FREE		;NO, GET SPACE FOR ANOTHER ENTRY
	AOS	FREE		;NOTE SPACE USED
	HRRM	C,0(B)		;LINK LAST TO THIS
	HRLZM	RP,0(C)		;NOTE JUMP-FROM ADDR
	TRNE	RP,RP.D		;DROM ADDRESS?
	POPJ	P,		;YES, DON'T BUILD DEST LIST

	MOVE	C,FREE		;NOW SPACE FOR ANOTHER DESTINATION
	AOS	FREE
	MOVE	B,CLNK2(RP)	;GET CURRENT DEST LIST
	MOVEM	B,0(C)		;HANG OFF NEW ITEM
	HRRM	C,CLNK2(RP)	;PUT NEW ITEM AT HEAD OF LIST
	HRLM	A,0(C)		;OH, YES, THE DATA FOR THE NEW ITEM
	POPJ	P,

;HERE IS SUBROUTINE TO PROCESS THE LIST BUILT BY JMPTO.
; CALL WITH RP CONTAINING CRAM ADDR, AND R CONTAINING ADDRESS
; OF CO-ROUTINE WHICH WILL PROCESS EACH ADDRESS PASSED IN RP

HEREFM:	TRZA	F,F.TO
HERETO:	TRO	F,F.TO
	TRNE	RP,RP.D		;CAN'T GET FROM OR TO DROM
	POPJ	P,
	PUSH	P,RP		;SAVE THIS ADDRESS
	PUSH	P,R		;SAVE CO-ROUTINE ADDRESS
	AOS	A,NVIA		;LENGTHEN RECORDED PATH
	HRRZM	RP,VIA-1(A)	; TO PUT THIS AT END
	TRNN	F,F.TO		;WHICH DIRECTION?
	SKIPA	RP,CLINK(RP)	;GET JUMP-FROM LIST POINTER
	MOVE	RP,CLNK2(RP)	;GET JUMP-TO LIST POINTER
	ANDI	RP,777777	; ALONE, PLEASE
	JUMPE	RP,HRFM2	;ANYTHING IN IT?
HRFM1:	PUSH	P,RP		;SAVE CURRENT LIST POINTER
	HLRZ	RP,0(RP)	;GET JUMP-FROM LOCATION
	PUSHJ	P,@-1(P)	;CALL JUMP-FROM HANDLER
	POP	P,RP		;GET LIST POINTER BACK
	HRRZ	RP,0(RP)	;LOOK AT NEXT ON LIST
	JUMPN	RP,HRFM1	;LOOP IF MORE
HRFM2:	SOS	NVIA		;POP THIS LOC OFF PATH
	POP	P,R		;RESTORE CO-ROUTINE ADDR
	POP	P,RP		;RESTORE DESTINATION
	POPJ	P,
;HERE TO MARK A WORD AS A POSSIBLE RETURN POINT

RTNTO:	HRRZ	B,A		;COPY RETURN POINT
	CAIN	B,(RP)		;SAME AS CALL?
	POPJ	P,0		;YES--IGNORE
	MOVEI	B,CRTN(A)	;BEGINNING OF LIST
	HRRZ	C,CRTN(A)	;GET FIRST LINK
	JUMPE	C,RTNTO2	;IF NONE, PLUG THIS IN HERE
RTNTO1:	MOVEI	B,(C)		;COPY LIST ADDR
	HRRZ	C,0(B)		;POINTER TO NEXT
	JUMPN	C,RTNTO1	;SEARCH FOR END OF LIST
	HLRZ	C,0(B)		;GET LAST RECORDED JUMP-FROM
	CAIN	C,0(RP)		;EQUAL THIS ONE?
	POPJ	P,		;YES, DON'T RECORD TWICE
RTNTO2:	MOVE	C,FREE		;NO, GET SPACE FOR ANOTHER ENTRY
	AOS	FREE		;NOTE SPACE USED
	HRRM	C,0(B)		;LINK LAST TO THIS
	HRLZM	RP,0(C)		;NOTE JUMP-FROM ADDR
	POPJ	P,
;HERE IS HANDLER FOR D

DWORD:	PUSHJ	P,SKPST
	PUSHJ	P,GETOCZ
	MOVEI	RP,(B)		;HOLD RAM ADDRESS
	CAILE	RP,DROMSZ
	JRST	ULOSE		;ENFORCE SIZE LIMIT
	PUSHJ	P,SKPST
	PUSHJ	P,GETOCZ
	PUSHJ	P,GETOCT
	PUSHJ	P,GETOCT
	CAMN	B,DBUF(RP)
	JRST	DWORD1
	MOVEM	B,DBUF(RP)
	ERR	DISPATCH ROM CHANGED

DWORD1:	PUSHJ	P,GTLINN	;COLLECT LINE #
	HRRZM	B,DLINE(RP)	;SAVE IT

	MOVE	B,DBUF(RP)
	TDNE	B,DMASK		;ANY UNUSED BITS SET?
	PUSHJ	P,REPORT	;YES, TELL
	NOP	[ASCIZ	/? UNUSED BITS SET IN DROM AT /]

	LDB	A,D.J		;GET THE J FIELD
	TRO	RP,RP.D		;FLAG AS DROM ADDRESS
	CAIGE	A,1400		;HIGH ENOUGH
	PUSHJ	P,REPORT	;NO. ERROR
	NOP	[ASCIZ /? DROM ADDRESS TOO LOW AT /]
	CAILE	A,1777		;TOO HIGH
	PUSHJ	P,REPORT
	NOP	[ASCIZ /? DROM ADDRESS TOO HIGH AT /]

	PUSHJ	P,JMPTO		;MARK WHERE IT GOES

	TRZ	RP,RP.D		;CLEAR FLAG BIT
	LDB	W1,D.ACDISP
	TRO	RP,RP.D		;PUT FLAG BACK
	JUMPE	W1,COMMNT	;EXIT IF NOT AC DISP
	TRNE	A,17		;BLOCK OF 20 WORDS?
	ERR	DROM AC DISP DOES NOT GO TO A 20 WORD BLOCK
	MOVEI	W1,1(A)		;MARK 17 WORDS THAT FOLLOW
	HRLI	W1,-17		; THIS WORD
ACDISP:	HRRZ	A,W1		;COPY ADDRESS
	PUSHJ	P,JMPTO		;MARK IT
	AOBJN	W1,ACDISP	;LOOP OVER ALL WORDS

	JRST	COMMNT
;SUBR TO REPORT TROUBLE IN MICROWORD

REPORT:	PUSHM	<A,B,C,D>
	TRO	F,F.TYO!F.ERR	;OUTPUT TO TTY, TOO
	HRRZ	B,@-4(P)	;NOW PUT IT IN LISTING
	AOS	C,CKSUM1
	IMUL	C,B
	ADDM	C,CKSUM2
	PUSHJ	P,PUTSTR
	MOVEI	C,(RP)
	PUSHJ	P,LINLOC	;WITH ADDRESS
	PUSHJ	P,NEWLIN		;AND CRLF
	SKIPN	D,NVIA		;IS A PATH RELEVANT?
	JRST	REPX		;NO
	MOVEI	B,[ASCIZ /  VIA:/]
	PUSHJ	P,PUTSTR
REPVIA:	MOVEI	A," "
	PUSHJ	P,PUTC
	MOVE	C,VIA-1(D)	;GET PATH
	PUSHJ	P,LINLOC
	SOJG	D,REPVIA
	PUSHJ	P,NEWLIN
REPX:	TRZ	F,F.TYO
	POPM	<D,C,B,A>
	AOS	0(P)		;BUMP RETURN
	POPJ	P,


;SUBR TO CHECK PARITY OF W1

PARCHK:	HLRZ	W2,W1
	XORB	W1,W2		;FOLD TO R.H.
	LSH	W2,-11		;FOLD TO 9 BITS
	XORI	W1,(W2)		;9 LOW BITS OF W1
	ANDI	W1,777		; ONLY
	MOVEI	W3,0
	MOVNI	W2,(W1)
	TRZE	W1,(W2)		;CLEAR LOW BIT IF ANY
	AOJA	W3,.-2		;COUNT IT INTO PARITY
	TRNN	W3,1		;TEST PARITY
	PUSHJ	P,REPORT
	NOP	[ASCIZ /? EVEN PARITY AT /]
	POPJ	P,		;OK
;HERE IF OUT-OF-BOUNDS RAM ADDR USED

ULOSE:	PUSHJ	P,REPORT
	NOP	[ASCIZ /? RAM ADDR OUT OF BOUNDS /]
	JRST	COMMNT		;IGNORE THAT WORD

;HERE WHEN "E" FOUND

CHKEND:	PUSHJ	P,GETC		;NEXT CHAR
	CAIE	A,"N"
	JRST	BADSCN
	PUSHJ	P,GETC
	CAIE	A,"D"
	JRST	BADSCN

;HERE ON END OF INPUT

	SKIPN	DJLIST		;ANY DROM J JUMPS?
	JRST	SCNCON		;NO, LIST INTERCONNECT

	MOVSI	W1,-DROMSZ	;LOOP THROUGH RAM
DSCAN:	MOVEI	RP,(W1)		;GET DROM ADDR
	SKIPN	A,DBUF(RP)	;ANYTHING THERE?
	PUSHJ	P,REPORT	;NOPE...
	NOP	[ASCIZ	\? NOTHING IN DROM LOC \]
DSCN2:	AOBJN	W1,DSCAN	;CHECK WHOLE DROM
;HERE TO PROCESS DJ LIST TO MARK LOCATIONS JUMPED-TO BY WAY OF
; AREAD OR DROM J DISPATCHES

	MOVE	W1,DJLIST	;START AT TOP OF LIST
DJL1:	HLRZ	RP,0(W1)	;ADDR OF WORD WITH AREAD OR DROM
	LDB	A,C.DISP
	CAIE	A,DROM	;WHICH?
	JRST	DJL2		;A READ
	MOVEI	R,CHKARD	;IR DISP.  CHECK IF JUMPED-TO BY AREAD ONLY
	TRZ	F,F.ARD!F.NARD	;INIT FLAGS
	PUSHJ	P,HEREFM	;LOOK AT ALL WAYS TO GET HERE
	TRNE	F,F.NARD	;ANYTHING NON-AREAD?
	JRST	DJL3		;YES, ALLOW ANY DROM LOC
	MOVEI	R,ALOWEQ
	JRST	DJL4		;SCAN DROM
DJL2:	MOVEI	R,ALOW01
	JRST	DJL4
DJL3:	MOVEI	R,ALOWNY	;ALLOW ANYTHING
DJL4:	MOVSI	W4,-DROMSZ	;READY TO SCAN DROM
DJL5:	PUSH	P,RP
	MOVEI	RP,(W4)		;GET DROM LOC
	LDB	B,D.A		;GET A FIELD
	LDB	A,D.J		;AND JUMP ADDR
	LDB	C,D.I		;GET IMMEDIATE DISP BIT
	POP	P,RP
	PUSH	P,B		;SAVE D.A
	PUSHJ	P,0(R)		;SHOULD WE MARK JUMP?
	PUSHJ	P,JMPTO		;YES
	TRO	A,1		;POSSIBLE SKIP?
	POP	P,B		;SEE WHICH KIND OF DISP
	CAIE	B,5		;IS THIS A SHIFT?
	CAIN	B,4		; ??
	PUSHJ	P,JMPTO
	AOBJN	W4,DJL5		;LOOK AT NEXT IN DROM

	HRRZ	W1,0(W1)	;NEXT IN DJLIST
	JUMPN	W1,DJL1		;LOOP IF MORE
	JRST	SCNCON		;ELSE, GO LIST CONNECTIONS

CHKARD:	TRNE	RP,RP.D		;DROM ADDRESS?
	POPJ	P,		;YES, IGNORE
	PUSH	P,A
	LDB	A,C.DISP
	CAIE	A,AREAD	;IS THIS AREAD?
	TROA	F,F.NARD	;NO
	TRO	F,F.ARD		;YES
	POP	P,A
	POPJ	P,

ALOWEQ:	CAIE	B,-40(RP)	;POSSIBLE AREAD GOT HERE BY THIS ONE?
	AOS	0(P)		;NO, DISALLOW
	POPJ	P,
ALOW01:	CAIE	C,1
	AOS	0(P)		;NO
ALOWNY:	POPJ	P,
;HERE TO PROCESS INTERCONNECT GRAPH

SCNCON:	MOVEI	RP,FRSTCW-CLINK	;POINT TO HEAD OF LIST
SCNCAL:	HLRE	RP,CLINK(RP)	;POINT TO NEXT ENTRY
	JUMPL	RP,LSTCON	;JUMP IF DONE
	PUSHJ	P,CHECKT	;CHECK T-FIELD
	LDB	A,C.CALL	;IS THIS A CALL INSTRUCTION
	JUMPE	A,SCNCAL	;NO--KEEP LOOKING
	PUSHJ	P,FNDRTN	;FIND THE RETURN POINT
	  ERR	NO RETURN FOR CALL
	JRST	SCNCAL		;KEEP LOOKING
;TABLES FOR T-FIELD CALCULATION

DEFINE	TIMETB,<
	T	DP,<DP>
	T	2901,<2901>
	T	SCAD,<SCAD>
	T	DBM,<DBM>
	T	RAMA,<RAM ADDRESS>
	T	RA,<RAM READ>
	T	DBUS,<DBUS>
	T	PAR,<PARITY>
	T	PC,<PC>
	T	IR,<IR>
	T	PI,<PI>
	T	SCFE,<SC AND FE>
	T	VMA,<VMA>
	T	MEM,<MEM DP FUNC>
	T	APR,<APR>
	T	RAMW,<RAM WRITE>
	T	DISP,<DISPATCH>
	T	SKIP,<SKIP>
>
DEFINE	T(A,B),<
T$'A:	0	;STORAGE FOR B TIME
>

	XALL
	TIMETB
DEFINE	T(A,B),<
D$'A:	POINT	7,[ASCIZ "B"]
	X$'A==D$'A-TIMTXT
>

TIMTXT:	TIMETB

DEFINE	T(A,B),<
N$'A:	0	;NUMBER OF TIMES B WAS BIGGEST
>
TIMNUM:	TIMETB
DEFINE	T(A,B),<
O$'A:	0	;NUMBER OF TIMES B WAS BIGGEST AND OVER 300
>
TIMOVR:	TIMETB
	SALL
;SUBROUTINE TO CHECK FOR CORRECT T-FIELD
;CALL WITH:
;	RP/ POINTER TO CRAM
;	PUSHJ	P,CHECKT
;	RETURN HERE
CHECKT:	PUSHJ	P,CALCT		;CALCULATE TIME
	MOVE	C,B		;SAVE MAX TIME
	CAIG	A,^D750		;FIT IN TABLE
	AOS	TIMETB(A)	;YES--COUNT IT UP
	AOS	TIMNUM(B)	;COUNT NUMBER OF EACH MAX
	IDIVI	A,^D150		;CONVERT TO TICKS
	SKIPE	B		;EXACT NUMBER OF TICKS?
	ADDI	A,1		;ROUND UP
	MOVE	B,A		;COUNT TICKS OVER 2
	SUBI	B,2		; ..
	CAIG	B,3
	ADDM	B,TIMOVR(C)	; ..
	CAILE	A,5		;WAY TOO MUCH?
	JRST   [ERR INSTRUCTION TAKES MORE THAN 750 NS.
		POPJ P,0]
	JRST	@[EXP TICK0,TICK1,TICK2,TICK3,TICK4,TICK5](A)
TICK0:	ERR	INSTRUCTION TAKES NO TIME
	POPJ	P,0

TICK1:;	PUSHJ	P,REPORT
;	NOP	[ASCIZ "COULD GO IN 1 TICK AT "]

TICK2:	LDB	A,C.T
	CAIN	A,0
	POPJ	P,0
	CAIE	A,1
	JRST	WARN2
	PUSHJ	P,ISFLAG
	  JRST	TICK2A
	LDB	A,C.DISP
	CAIN	A,NICOND
	POPJ	P,0
TICK2A:	LDB	A,C.MEM
	JUMPE	A,WARN2
	LDB	A,C.NO
	TRNN	A,2
WARN2:	WARN	T-FIELD ALLOWS EXTRA TIME (SHOULD BE 2 TICKS)
	POPJ	P,0

TICK3:	LDB	A,C.T
	CAIN	A,0
	ERR	T-FIELD IS TOO SMALL (3 TICKS NEEDED)
	CAILE	A,1
	WARN	T-FIELD ALLOWS EXTRA TIME (SHOULD BE 3 TICKS)
	POPJ	P,0

TICK4:	LDB	A,C.T
	CAILE	A,2
	WARN	T-FIELD ALLOWS 5 TICKS BUT ONLY 4 ARE NEEDED
	CAIE	A,2
	ERR	T-FIELD IS TOO SMALL (4 TICKS NEEDED)
	POPJ	P,0

TICK5:	LDB	A,C.T
	CAIE	A,3
	ERR	T-FIELD IS TOO SMALL (5 TICKS NEEDED)
	POPJ	P,0
;SUBROUTINE TO CALCULATE TIME FOR A MICRO INSTRUCTION
;CALL WITH
;	PUSHJ	P,CALCT
;	RETURN HERE TIME IN A
;		INDEX OF LONGEST PATH IN B
;
CALCT:	PUSHJ	P,C$DP		;COMPUTE DP TIME
	PUSHJ	P,C$SCAD	;COMPUTE SCAD TIME
	PUSHJ	P,C$DBM		;COMPUTE DBM TIME
	PUSHJ	P,C$RA		;COMPUTE RAM ADDRESS TIME
	PUSHJ	P,C$DBUS	;COMPUTE DBUS TIME
	PUSHJ	P,C$PAR		;COMPUTE PARITY TIME
	PUSHJ	P,ISDPFN	;IS DATAPATH  A FUNCTION OF DBUS?
	  PUSHJ	P,C$DP7		;YES--COMPUTE DP TIME AGAIN
	PUSHJ	P,C$PC		;PC TIME
	PUSHJ	P,C$IR		;IR LOAD TIME
	PUSHJ	P,C$PI		;PI LOAD TIME
	PUSHJ	P,C$SCFE	;SC AND FE TIME
	PUSHJ	P,C$VMA		;VMA TIME
	PUSHJ	P,C$2901	;2901 REG WRITE TIME
	PUSHJ	P,C$MEM		;MEM SETUP TIME
	PUSHJ	P,C$APR		;APR TIME
	PUSHJ	P,C$RAMW	;RAM FILE WRITE
	PUSHJ	P,C$DISP	;DISPATCH TIME
	PUSHJ	P,C$SKIP	;SKIP TIME
	TMAX	A,<PAR,2901,PC,IR,PI,SCFE,VMA,VMA,MEM,APR,RAMW,DISP,SKIP>
	ADDI	A,^D7		;CLOCK SKEW
	POPJ	P,0
;COMPUTE DP TIME

C$DP:	MOVEI	A,^D100000	;SET DP TIME TO
	MOVEM	A,T$DP		; HUGE
	PUSHJ	P,ISDPFN	;IS IT A FUNCTION OF D-BUS
	  POPJ	P,0		;YES--CALCULATE LATER
	MOVEI	A,^D103		;FUDGE DBUS TIME
	MOVEM	A,T$DBUS	; ..
C$DP7:	MOVEI	B,0		;ASSUME BOOLEAN
	LDB	A,C.AD		;GET ALU FUNCTION
	CAIGE	A,30		;BOOLEAN?
	MOVEI	B,1		;NO--ARITHMETIC
	LDB	A,C.DEST	;GET DESTINATION
	TRC	A,2
	ADD	B,[EXP 0,0,-1,0,2,2,2,2](A)
;AT THIS POINT B HAS ONE OF THE FOLLOWING VALUES:
;	VALUE		ARITHMETIC FN	SHIFTING	DP VIA A
;	-----		-------------	--------	--------
;	-1		NO		NO		YES
;	0		NO (OR NA)	NO		IF ARITH
;	1		YES		NO		NO
;	2		NO		YES		NO
;	3		YES		YES		NO
	MOVE	A,DPTIME(B)	;GET CORRECT TIME
	ADD	A,T$DBUS
	MOVEM	A,T$DP
	POPJ	P,0

	EXP	^D60
DPTIME:	EXP	^D60
	EXP	^D60+^D68
	EXP	^D60+^D00
	EXP	^D60+^D00+^D68
;COMPUTE SCAD TIME

C$SCAD:	LDB	D,C.NO		;GET NUMBER
	LDB	A,[POINT 3,D,23]
	MOVE	B,T$DP
	ADDI	B,^D41
	CAIG	A,1
	MOVEI	B,^D114
	LDB	A,[POINT 2,D,25]
	MOVE	C,T$DP
	XCT	[MOVEI C,^D102
		 ADDI  C,^D80
		 ADDI  C,^D33
		 ADDI  C,^D33](A)
;WE NOW HAVE THE SCADA TIME IN B AND THE SCADB TIME IN C, FIND MAX
	MOVE	D,B
	CAMGE	D,C
	MOVE	D,C
	LDB	A,[POINT 3,D,20]
	MOVE	B,@[EXP B,D,D,D,D,D,B,B](A)
	ADD	B,[EXP ^D72,^D40,^D72,^D72,^D72,^D40,^D72,^D72](A)
	MOVEM	B,T$SCAD
	POPJ	P,0
;COMPUTE DBM TIME

C$DBM:	STKVAR	<DBMSCD,DBMDP>
	MOVE	A,T$SCAD	;GET SCAD TIME
	ADDI	A,^D35
	MOVEM	A,DBMSCD
	MOVE	A,T$DP
	ADDI	A,^D41
	MOVEM	A,DBMDP
	LDB	A,C.DBM		;GET DBM SELECT
	JRST	@[EXP C$DBM0,C$DBM1,C$DBM2,C$DBM3,C$DBM4,C$DBM5,C$DBM6,C$DBM7](A)

C$DBM0:
C$DBM1:	MAX	A,<[^D116],DBMSCD>
	JRST	C$DBMX

C$DBM2:
C$DBM3:	MAX	A,<[^D130],DBMSCD,DBMDP>
	JRST	C$DBMX

C$DBM4:	MAX	A,<[^D116],DBMDP>
	JRST	C$DBMX

C$DBM5:	MOVEI	A,^D116
	JRST	C$DBMX

C$DBM6:
C$DBM7:	MOVEI	A,^D130
C$DBMX:	MOVEM	A,T$DBM
	POPJ	P,0
;COMPUTE RAM READ TIME

C$RA:	SETZM	T$RA		;ASSUME ADDRESS UNCHANGED
	SETZM	T$RAMA		; ..
	LDB	A,C.DBUS	;IS DBUS LOOKING AT RAM
	CAIGE	A,2		; ..
	POPJ	P,0		;NO--IGNORE RAM READ TIME
	CAIN	A,3		;SELECTING DBM?
	JRST   [LDB A,C.DBM	;YES--SELECTING MEMORY
		CAIE A,6	; ..
		POPJ P,0	;NO--WILL NOT READ RAM
		JRST .+1]	;YES--WILL READ RAM
	PUSHJ	P,RAMCOD	;GET RAM CODE
	MOVEM	A,RAMADR	;SET IT
	SETOM	RACHNG		;ASSUME IT DID NOT CHANGE
	MOVEI	R,RACHK		;CHECK ADDRESS CHANGES
	PUSHJ	P,HEREFM	; ..
	SKIPN	RACHNG		;ANY CHANGES?
	POPJ	P,0		;NO--RAM IS ALREADY SETUP
	MOVE	A,T$DBM		;GET DBM TIME
	LDB	B,C.RAMADR	;GET RAM ADDRESS
	XCT    [MOVEI A,^D112
		ADDI A,^D77
		MOVEI A,^D112
		MOVEI A,^D10000
		MOVEI A,^D116
		MOVEI A,^D10000
		MOVEI A,^D116
		ADDI A,^D38](B)
	MOVEM	A,T$RAMA	;SAVE ADDRESS TIME
	ADDI	A,^D80		;RAM SPEED
	MOVEM	A,T$RA		;SAVE AS RAM ACCESS TIME
	POPJ	P,0		;DONE

RACHK:	SKIPGE	RACHNG		;FIRST CALL?
	SETZM	RACHNG		;YES--CLEAR FLAG
	PUSHJ	P,RAMCOD	;GET ADDRESS CODE
	CAME	A,RAMADR	;SAME?
	AOS	RACHNG		;NO
	POPJ	P,0		;..

RAMCOD:	LDB	A,C.RAMADR	;GET THE ADDRESS
	JRST	@[EXP RCAC,RCACNO,RCXR,RCERR,RCVMA,RCERR,RCVMA,RCNO](A)

RCERR:	ERR	ILLEGAL RAM ADDRESS
RCPUNT:	AOS	A,RCUNIQ
	POPJ	P,0
RCAC:	LDB	A,C.SPEC
	CAIN	A,LOADIR
	JRST	RCPUNT
	MOVEI	A,0
	POPJ	P,0

RCACNO:	LDB	B,C.SPEC
	CAIN	B,LOADIR
	JRST	RCPUNT
RCNO:	LDB	B,C.NO
	HRL	A,B
	POPJ	P,0

RCXR:	LDB	B,C.SPEC
	CAIN	B,LOADXR
	JRST	RCPUNT
	POPJ	P,0

RCVMA:	LDB	B,C.MEM
	JUMPE	B,CPOPJ
	LDB	B,C.NO
	TRNE	B,10
	JRST	RCPUNT
	POPJ	P,0

RCUNIQ:	0
RAMADR:	0
RACHNG:	0
;HERE TO CALCULATE  D-BUS TIME

C$DBUS:	LDB	A,C.DBUS	;WHICH SOURCE
	JRST   @[EXP DBUS0,DBUS1,DBUS2,DBUS3](A)

DBUS0:	MOVEI	A,^D103
	JRST	DBUSX

DBUS1:	MOVE	A,T$DP
	ADDI	A,^D33
	JRST	DBUSX

DBUS2:	MOVE	A,T$RA
	ADDI	A,^D25
	JRST	DBUSX

DBUS3:	MOVE	B,T$DBM
	ADDI	B,^D33
	MAX	A,<[^D197],B>
DBUSX:	CAIGE	A,^D103
	MOVEI	A,^D103
	MOVEM	A,T$DBUS
	POPJ	P,0
;HERE FOR PARITY TIME

C$PAR:	LDB	A,C.CHKL
	JUMPN	A,DOPAR
	LDB	A,C.CHKR
	JUMPN	A,DOPAR
	LDB	A,C.GENL
	JUMPN	A,DOPAR
	LDB	A,C.GENR
	JUMPN	A,DOPAR
	SETZM	T$PAR
	POPJ	P,0

DOPAR:	MOVE	A,T$DBUS
	ADDI	A,^D65
	MOVEM	A,T$PAR
	POPJ	P,0

;HERE TO COMPUTE PC/IR/PI TIMES

C$PC:	SETZM	T$PC
	LDB	A,C.SPEC
	CAIN	A,ASHOV
	JRST	PCASH
	CAIN	A,EXPTST
	JRST	PCEXP
	CAIE	A,FLAGS
	POPJ	P,0
	MOVE	A,T$DP
	ADDI	A,^D103
	MOVEM	A,T$PC
	POPJ	P,0

PCASH:	MOVE	A,T$DP
	ADDI	A,^D126
	MOVEM	A,T$PC
	POPJ	P,0

PCEXP:	MOVE	A,T$SCAD
	ADDI	A,^D71
	MOVEM	A,T$PC
	POPJ	P,0

C$IR:	SETZM	T$IR
	LDB	A,C.SPEC
	CAIE	A,LOADIR
	POPJ	P,0
	MOVE	A,T$DP
	ADDI	A,^D22
	MOVEM	A,T$IR
	POPJ	P,0

C$PI:	SETZM	T$PI
	LDB	A,C.SPEC
	CAIE	A,LDPI
	POPJ	P,0
	MOVE	A,T$DP
	ADDI	A,^D30
	MOVEM	A,T$PI
	POPJ	P,0
;HERE TO COMPUTE SC AND FE TIME

C$SCFE:	PUSHJ	P,C$SCAD	;REDO SCAD TIME
	LDB	A,C.LDSC
	JUMPN	A,DOSCFE
	LDB	A,C.LDFE
	JUMPN	A,DOSCFE
	SETZM	T$SCFE
	POPJ	P,0


DOSCFE:	MOVE	A,T$SCAD	;GET SCAD TIME
	ADDI	A,^D25		;ADD SETUP TIME
	MOVEM	A,T$SCFE	; ..
	POPJ	P,0
;COMPUTE VMA AND SCAD TIME

C$VMA:	SETZM	T$VMA		;CLEAR OUT VMA TIME
	LDB	B,C.MEM		;DOING ME FUNCTION
	JUMPE	B,CPOPJ		;NO
	LDB	B,C.NO		;GET NUMBER
	TRNN	B,10		;LOAD VMA?
	POPJ	P,0		;NO
	MOVE	A,T$DP		;GET DP TIME
	ADDI	A,^D55		;TIME TO GET TO VMA
	MOVEM	A,T$VMA		;SAVE AS VMA TIME
	POPJ	P,0

C$2901:	SETZM	T$2901
	MOVE	B,T$DP
	LDB	A,C.DEST
	TRNE	A,4		;SHIFTING
	ADDI	B,^D60
	SKIPE	A
	MOVEM	B,T$2901
	POPJ	P,0

C$MEM:	SETZM	T$MEM		;ASSUME NO MEM TIME
	LDB	A,C.MEM		;MEM CYCLE
	JUMPE	A,CPOPJ		;NO
	LDB	A,C.NO		;GET THE NUMBER
	TRNN	A,20		;DOING A MEM FUNCTION?
	POPJ	P,0
	MOVE	A,T$DP		;GET DP TIME
	ADDI	A,^D138		;SETUP TIME
	MOVEM	A,T$MEM		;SAVE MEM TIME
	POPJ	P,0
;HERE FOR APR TIME

C$APR:	SETZM	T$APR
	POPJ	P,0
;HERE FOR RAM FILE WRITE

C$RAMW:	SETZM	T$RAMW
	LDB	A,C.FMWRITE
	JUMPE	A,CPOPJ
	MOVE	A,T$DBUS
	ADDI	A,^D92
	MOVEM	A,T$RAMW
	POPJ	P,0
;HERE TO COMPUTE TIME FOR DISPATCHES

C$DISP:	MOVEI	A,^D240
	MOVEM	A,T$DISP
	LDB	A,C.DISP
	MOVEI	B,^D270
	CAIN	A,BYTE
	JRST	DPDISP
	MOVEI	B,^D170
	CAIE	A,DPLEFT
	CAIN	A,DP
	JRST	DPDISP
	MOVEI	B,^D184
	CAIN	A,NORM
	JRST	DPDISP
	MOVE	B,T$SCAD
	ADDI	B,^D167
	CAIN	A,SCAD0
	MOVEM	B,T$DISP
	POPJ	P,0

DPDISP:	ADD	B,T$DP
	MOVEM	B,T$DISP
	POPJ	P,0
;HERE FOR SKIP TIME

C$SKIP:	MOVEI	A,^D185
	MOVEM	A,T$SKIP
	LDB	A,C.SKIP
	MOVEI	B,^D170
	CAIE	A,LE
	CAIN	A,ADEQ0
	JRST	DPSKIP
	MOVEI	B,^D63
	CAIE	A,CRY1
	CAIN	A,CRY0
	JRST	DPSKIP
	MOVEI	B,^D128
	CAIE	A,ADLEQ0
	CAIN	A,ADREQ0
	JRST	DPSKIP
	MOVEI	B,^D78
	CAIN	A,CRY2
	JRST	DPSKIP
	MOVEI	B,^D128
	CAIE	A,DP18
	CAIN	A,DP0
	JRST	DPSKIP
	MOVEI	B,^D198
	CAIN	A,TXXX
	JRST	DPSKIP
	MOVE	B,T$DBM
	ADDI	B,^D210
	CAIN	A,JFCL
	MOVEM	B,T$SKIP
	POPJ	P,0

DPSKIP:	ADD	B,T$DP
	MOVEM	B,T$SKIP
	POPJ	P,0
;CHECK TO SEE IF DP DEPENDS ON DBUS
;CALL WITH:
;	PUSHJ	P,ISDPFN
;	  HERE IF YES
;	HERE IF NO
;
ISDPFN:	LDB	A,C.DEST
	TRC	A,2
	CAIN	A,2
	JRST	CPOPJ1
	LDB	A,C.RSRC
	PUSHJ	P,DPSRC
	  POPJ	P,0
	LDB	A,C.LSRC
	PUSHJ	P,DPSRC
	  POPJ	P,0
	JRST	CPOPJ1

;ROUTINE TO DECIDE IS DP IS A FUNCTION OF DBUS 
;CALLED ONLY FROM ABOVE. SKIPS IF DBUS NOT INVOLVED OR
; RESULT IS A CONSTANT (D.AND.0)
DPSRC:	CAIGE	A,5
	JRST	CPOPJ1
	LDB	B,C.AD
	ANDI	B,70
	TRO	A,(B)
	CAIE	A,47
	CAIN	A,57
	JRST	CPOPJ1
	POPJ	P,0
;HERE TO SEE IF A MICRO INSTRUCTION CAN CAUSE A TRAP FLAG TO SET
;CALL WITH:
;	PUSHJ	P,ISFLAG
;	  HERE IF NO
;	HERE IF YES
;
;PRESERVES EVERYTHING BUT B
;
ISFLAG:	LDB	B,C.SPEC	;GET SPECIAL CODE
	CAIE	B,ASHOV		;ASH TEST
	CAIN	B,EXPTST	;EXPONENT TEST
	JRST	CPOPJ1		;YES--THIS GUY SETS FLAGS
	CAIE	B,FLAGS		;DOES THIS SET FLAGS?
	POPJ	P,0		;NO
	LDB	B,C.NO		;MAYBE--LOOK AT # BITS
	TRNE	B,703005	; ??
	AOS	(P)		;YES
	POPJ	P,0		;RETURN
;HERE TO PRINT INTER-CONNECT LISTING

LSTCON:	MOVEI	B,[ASCIZ "
NO PROBLEMS HAVE BEEN DETECTED
"]
	TRNN	F,F.ERR		;ANY ERRORS?
	PUSHJ	P,PUTSTR	;NO--SAY THAT
	TRNN	F,F.ERR
	JRST	LSTCN1
	TRO	F,F.TYO
	MOVEI	B,[ASCIZ "
[NUMBER OF ITEMS: "]
	PUSHJ	P,PUTSTR
	MOVE	B,CKSUM1
	PUSHJ	P,PUTDC
	MOVEI	B,[ASCIZ " CHECKSUM: "]
	PUSHJ	P,PUTSTR
	MOVE	B,CKSUM2
	PUSHJ	P,PUTDC
	MOVEI	B,[ASCIZ "]
"]
	PUSHJ	P,PUTSTR
	TRZ	F,F.TYO
LSTCN1:	MOVEI	A,[ASCIZ "
LINE(ADDR)	MICROWORD
		PLACES THAT MAY TRANSFER TO HERE [LINE(ADDR)]

"]
	MOVEM	A,SUBTTL#
	SKIPGE	FRSTCW		;ANY CONTROL WORDS SEEN?
	JRST	NOCW		;NO
	HRROI	A,[ASCIZ "WANT FULL HERE FROM LISTING? "]
	PUSHJ	P,ASKYN
	  JRST	PATSCN		;NO--PRINT TABLES
	PUSHJ	P,NEWPAG	;PAGE HEADER, ETC
	MOVEI	RP,FRSTCW-CLINK
INTERC:	HLRE	RP,CLINK(RP)	;GET NEXT CONTROL WORD ASSEMBLED
	JUMPL	RP,PATSCN

	MOVEI	C,(RP)		;POINT TO THIS WORD
	PUSHJ	P,LINLOC	;PRINT LINE(LOC)
	PUSHJ	P,UPRINT	;PRINT INSTRUCTION
	PUSHJ	P,TPRINT	;PRINT TIMES
	SETZM	LCNT#		;START COUNTING ITEMS ON LINE
	HRRZ	W1,CLINK(RP)	;START LIST SCAN
	JUMPE	W1,NOJMP2	;NOTHING JUMPS HERE
	PUSHJ	P,PTAB		;SPACE OUT
	JRST	JMPF1		;LIST FIRST PLACE

JMPFRM:	AOS	A,LCNT
	CAIGE	A,^D10		;ROOM FOR ANOTHER ON THIS LINE?
	JRST	JMPF1		;YES
	PUSHJ	P,NEWLIN	;GO TO NEW LINE
	PUSHJ	P,PTAB
	SETZM	LCNT
JMPF1:	PUSHJ	P,PSPAC2	;SPACE OVER
	HLRZ	C,0(W1)		;ADDR OF JUMP-FROM WORD
	PUSHJ	P,LINLOC	;PRINT ITS LINE(LOC)
	HRRZ	W1,0(W1)	;LINK TO NEXT
	JUMPN	W1,JMPFRM	;LIST THAT
	PUSHJ	P,NEWLIN	;END LINE
	JRST	JMPF2		;CHECK FOR END OF PAGE
NOJMP2:	PUSHJ	P,ANYRTN	;ANY RETRUNS TO HERE
	SKIPA			;NO--THIS IS UNREACHABLE
	JRST	JMPF2A		;YES--LIST THEM
	MOVEI	B,[ASCIZ \  * * * * * * * * * * * * * * * * * * UNREACHABLE INSTRUCTION * * * * * * * * * * * * * * * * * *\]
	PUSHJ	P,PUTSTR
	PUSHJ	P,NEWLIN
	JRST	INTERC		;DO NEXT WORD
JMPF2:	PUSHJ	P,ANYRTN	;ANY RETURNS TO HERE?
	  JRST	INTERC		;NO--DO NEXT WORD
JMPF2A:	PUSHJ	P,OKRTN		;IS THIS ONE ANY GOOD?
	  JRST	JMPF2B		;NO--KEEP LOOKING
	PUSHJ	P,PTAB		;PUT IN A TAB
	MOVEI	B,[ASCIZ \  POSSIBLE RETURN \]
	PUSHJ	P,PUTSTR	;ADD TEXT
	MOVEI	B,(RP)		;THIS MICRO INSTRUCTION
	TSZ	B,(W1)		;MASK OUT ADDRESS OF CALL
	PUSHJ	P,PUTOV		;OUTPUT THE DELTA
	MOVEI	B,[ASCIZ \ FROM CALL AT \]
	PUSHJ	P,PUTSTR
	HLRZ	C,(W1)		;ADDRESS OF CALL
	PUSHJ	P,LINLOC	;OUTPUT LINE AND LOCATION
	PUSHJ	P,NEWLIN	;ADD IN CRLF
JMPF2B:	HRRZ	W1,(W1)		;SCAN LIST
	JUMPN	W1,JMPF2A	;MORE?
	JRST	INTERC		;NO--MOVE ON

NOCW:	HRROI	A,[ASCIZ \NO CONTROL WORDS IN INTERCONNECT LIST
\]
	PSOUT
	JRST	DONE
;SUBROUTINE TO SEE IF THERE IS ANY RETURN POINT FOR A CALL
;CALL WITH:
;	RP/ ADDRESS OF CALL
;	PUSHJ	P,FNDRTN
;	  HERE IF NO RETURN
;	HERE IF RETURN FOUND
FNDRTN:	PUSHM	<W2,W1,RP>	;SAVE SOME REGISTERS
	MOVEI	W2,N.RET	;SEE IF WITHIN N.RET LINES
FNDRA:	HLRE	RP,CLINK(RP)	;GO TO NEXT LINE
	JUMPL	RP,FNDERR	;QUIT ON END-OF-LIST
	PUSHJ	P,ANYRTN	;ANY RETURN TO HERE?
	  SOJG	W2,FNDRA	;NO--KEEP LOOKING
	JUMPL	W2,FNDERR	;JUMP IF NO RETURN
FNDRT2:	HLRZ	A,(W1)		;ADDRESS OF CALL
	CAMN	A,(P)		;IS THIS US?
	JRST	FNDOK		;YES
FNDRT3:	HRRZ	W1,(W1)		;NEXT RETURN
	JUMPE	W1,FNDERR	;NONE IF END OF LIST
	PUSHJ	P,OKRTN		;IS THIS ANY GOOD
	  JRST	FNDRT3		;NO--KEEP LOOKING
	JRST	FNDRT2		;YES--SEE IF IT IS A MATCH

FNDOK:	AOS	-3(P)
FNDERR:	POPM	<RP,W1,W2>
	POPJ	P,0
;SUBROUTINE TO SEE IF ANY RETURNS CAN COME HERE
;CALL WITH:
;	RP/ MICRO WORD ADDRESS
;	PUSHJ	P,ANYRTN
;	  HERE IF NO GOOD RETURN
;	HERE WITH W1 POINTING TO HEAD OF LIST
ANYRTN:	SKIPN	W1,CRTN(RP)	;ANY ENTRIES AT ALL?
	POPJ	P,0		;NO
ANYRA:	PUSHJ	P,OKRTN		;IS THIS ONE OK?
	  JRST	ANYRT2		;NO
CPOPJ1:	AOS	(P)		;SKIP RETURN
	POPJ	P,0

ANYRT2:	HRRZ	W1,(W1)		;GET NEXT ENTRY
	JUMPN	W1,ANYRA	;KEEP LOOKING
	POPJ	P,0		;NO GOOD RETURNS

;SUBROUTINE TO SEE IF THIS RETURN IS ANY GOOD
;CALL WITH:
;	W1/ CRTN POINTER
;	PUSHJ	P,OKRTN
;	  HERE IF BAD
;	HERE IF OK
OKRTN:	MOVEI	B,(RP)		;OUR ADDRESS
	TSZ	B,(W1)		;GET DELTA
	MOVEI	A,^D6		;UP TO 64-WAY RETURN
	SKIPN	RTNTAB(B)	;EVER USED?
	JRST   [SOJL A,CPOPJ	;NEVER USED
		MOVEM B,OKTEMP#	;SAVE AN AC
		LSH B,-1	;SHIFT OVER
		IOR B,OKTEMP
		JRST .-1]
	HLRZ	A,(W1)		;ADDRESS OF CALL
	MOVE	B,CLINE(RP)	;GET OUR LINE NUMBER
	SUB	B,CLINE(A)	;SUBTRACT ADDRESS OF CALL
	JUMPL	B,CPOPJ		;CALL IS AFTER RETURN
	CAIGE	B,^D20		;CLOSE ENOUGH IN LISTING
	AOS	(P)		;YES
	POPJ	P,0		;RETURN
;DISPLAY THE MICRO WORD

DEFINE	DFLD(A,B,C,D,E),<>
DEFINE	IFLD(FLDN,FLDS,FLDP,FLDD),<>

DEFINE	FLD(FLDN,FLDS,FLDP,FLDD,FLDT,%DULL),<
	XLIST
	LDB	B,C.'FLDN
	CAIN	B,FLDD
	JRST	%DULL
	MOVEI	B,[ASCIZ " FLDN/"]
	PUSHJ	P,PUTSTR
	LDB	B,C.'FLDN
	PUSHJ	P,PUTOV
%DULL:	LIST
>

UPRINT:	FIELD
	JRST	NEWLIN
;HERE TO PRINT TIMES

DEFINE	T(ITEM,TEXT,%C,%D),<
	XLIST
	SKIPN	T$'ITEM
	JRST	%C
	SOJG	W5,%D
	PUSHJ	P,NEWLIN
	PUSHJ	P,PTAB
	MOVEI	W5,^D10
%D:!	MOVEI	B,[ASCIZ " TEXT="]
	PUSHJ	P,PUTSTR
	MOVE	B,T$'ITEM
	PUSHJ	P,PUTD3
	MOVEI	A,X$'ITEM
	MOVEI	B,[ASCIZ "***"]
	CAMN	A,CRPATH
	PUSHJ	P,PUTSTR
%C:!
	LIST
>
TPRINT:	STKVAR	<CRPATH>
	PUSHJ	P,CALCT
	MOVEM	B,CRPATH
	MOVEI	B,[ASCIZ "TIMES:	"]
	PUSHJ	P,PUTSTR
	MOVEI	W5,^D10
	TIMETB
	PUSHJ	P,NEWLIN
	POPJ	P,0
;HERE TO LOOK FOR PATTERNS

PATSCN:	HRROI	A,[ASCIZ "
LOOK FOR DUPLICATE INSTRUCTIONS (SLOW)? "]
	PUSHJ	P,ASKYN
	  JRST	PNTTAB
	MOVEI	A,[ASCIZ "
WORD		OTHER PLACES WHICH USE THE SAME WORD
"]
	MOVEM	A,SUBTTL
	SETOM	DUPMS1#
	SETOM	DUPMS2#
	SETOM	DUPMS3#
	MOVEI	A,1
	MOVEM	A,MATLEN#
	PUSHJ	P,DUPSCN
	HRLOI	A,77
	MOVEM	A,DUPMS1
	MOVEI	A,[ASCIZ "
WORD		OTHER PLACES WHICH USE THE SAME WORD
		BUT MAY NOT HAVE SAME JUMP ADDRESS
"]
	MOVEM	A,SUBTTL
	PUSHJ	P,DUPSCN
	MOVEI	A,[ASCIZ "
WORD		OTHER PLACES THIS 2 INSTRUCTION BLOCK IS USED
"]
	MOVEM	A,SUBTTL
	MOVEI	A,2
	MOVEM	A,MATLEN
	PUSHJ	P,DUPSCN
	JRST	PNTTAB
;SUBROUTINE TO LOOK FOR DUPLICATE MICRO INSTRUCTIONS
;CALL WITH:
;	SUBTTL/ ADDRESS OF SUBTITLE STRING
;	MATLEN/ NUMBER OF WORDS IN MATCH
;	DUPMS1-3/ MASK FOR COMPARE
;	PUSHJ	P,DUPSCN
;	RETURN HERE REPORT WRITTEN
DUPSCN:	SETZM	DUPTAB
	MOVE	A,[DUPTAB,,DUPTAB+1]
	BLT	A,DUPTAB+CRAMSZ
SCNLP1:	MOVEI	W1,0
SCNLP2:	MOVEI	W2,1(W1)
SCNLP3:	SKIPN	A,CBUF1(W1)
	JRST	SCNEXT
	PUSHJ	P,MATCH		;SEE IF MATCH
	  JRST	SCNEXT		;NO MATCH
;AT THIS POINT W1 AND W2 POINT TO DUPLICATE INSTRUCTIONS
; DUPTAB(W1)/	FIRST DUPLICATE,,LAST DUPLICATE
	SKIPN	DUPTAB(W1)	;ANY YET?
	HRLM	W2,DUPTAB(W1)	;NO--POINT TO HEAD OF LIST
	HRRZ	A,DUPTAB(W1)	;PREVIOUS TAIL
	MOVEM	W2,DUPTAB(A)	;PUT INTO LIST
	HRRM	W2,DUPTAB(W1)	;POINT TO NEW TAIL
SCNEXT:	ADDI	W2,1
	CAIGE	W2,CRAMSZ
	JRST	SCNLP3
SCNLP4:	ADDI	W1,1
	CAIL	W1,CRAMSZ
	JRST	PNTDUP		;PRINT ALL DUPLICATES
	SKIPE	DUPTAB(W1)	;IS THIS ALREADY IN SOME LIST?
	JRST	SCNLP4		;YES--SAVE A PASS
	JRST	SCNLP2		;NO--FIND DUPLICATES
;SUBROUTINE TO LOOK FOR A MATCH
;	W1/	BLOCK 1
;	W2/	BLOCK 2
;	DUPMS1-3/ MASKS
;	MATLEN/	NUMBER OF WORDS IN BLOCK
;	PUSHJ	P,MATCH
;	  NOT MATCH
;	MATCH
MATCH:	MOVE	W3,MATLEN	;GET ARGUMENT
MATCH1:	SOJL	W3,CPOPJ1	;ALL WORDS MATCH
	MOVEI	A,CBUF1		;FIRST BUFFER
	MOVEI	B,CBUF1		; ..
	MOVE	C,DUPMS1	;MASK
	PUSHJ	P,MATSUB	;SEE IF MATCH
	  POPJ	P,0		;NO
	MOVEI	A,CBUF2		;FIRST BUFFER
	MOVEI	B,CBUF2		; ..
	MOVE	C,DUPMS2	;MASK
	PUSHJ	P,MATSUB	;SEE IF MATCH
	  POPJ	P,0		;NO
	MOVEI	A,CBUF3		;FIRST BUFFER
	MOVEI	B,CBUF3		; ..
	MOVE	C,DUPMS3	;MASK
	PUSHJ	P,MATSUB	;SEE IF MATCH
	  POPJ	P,0		;NO
	JRST	MATCH1		;LOOP BACK

MATSUB:	MOVE	W4,W1
	PUSHJ	P,MATNXT
	ADD	A,D
	MOVE	A,(A)
	MOVE	W4,W2
	PUSHJ	P,MATNXT
	ADD	B,D
	XOR	A,(B)
	AND	A,C
	JUMPE	A,CPOPJ1
	POPJ	P,0

MATNXT:	MOVE	W5,W3
	MOVE	D,W4
MTNXT1:	SOJL	W5,CPOPJ
	HLRZ	D,CLINK(D)
	JRST	MTNXT1
;HERE WHEN LIST IS BUILD

PNTDUP:	PUSHJ	P,NEWPAG
	MOVSI	W1,-CRAMSZ
DUPLUP:	SKIPN	DUPTAB(W1)
DUPNXT:	AOBJN	W1,DUPLUP
	JUMPGE	W1,DUPDON
	HLRZ	RP,DUPTAB(W1)
	JUMPE	RP,DUPNXT
	PUSHJ	P,NEWLIN
	HRRZ	RP,W1
	SETZM	LCNT
	PUSHJ	P,LOCTAB
	SETZM	LCNT
	HLRZ	RP,DUPTAB(W1)
DUPMOR:	PUSHJ	P,LOCTAB
	HRRZ	RP,DUPTAB(RP)
	JUMPE	RP,DUPNXT
	JRST	DUPMOR

LOCTAB:	MOVEI	C,(RP)
	PUSHJ	P,LINLOC
	PUSHJ	P,PTAB
	AOS	A,LCNT
	CAIE	A,7
	POPJ	P,0
	SETZM	LCNT
	PUSHJ	P,NEWLIN
	PUSHJ	P,PTAB
	JRST	PTAB

DUPDON:	JRST	NEWLIN
;HERE TO PRINT SOME TABLES

PNTTAB:	MOVEI	A,[ASCIZ "
RETURN		NUMBER OF PLACES
TYPE		USED
"]
	MOVEM	A,SUBTTL
	PUSHJ	P,NEWPAG
	MOVSI	W1,-CRAMSZ
RTNLP:	SKIPN	RTNTAB(W1)
	JRST	RTNLPX
	HRRZ	B,W1
	PUSHJ	P,PUTO4
	PUSHJ	P,PTAB2
	MOVE	B,RTNTAB(W1)
	PUSHJ	P,PUTD3
	PUSHJ	P,NEWLIN
RTNLPX:	AOBJN	W1,RTNLP

	MOVEI	A,[ASCIZ "
TIME		NUMBER OF PLACES
 NS.		 THAT USE IT
"]
	MOVEM	A,SUBTTL
	PUSHJ	P,NEWPAG
	MOVSI	W1,-^D751
TIMELP:	SKIPN	TIMETB(W1)
	JRST	TIMLPX
	HRRZ	B,W1
	PUSHJ	P,PUTD3
	PUSHJ	P,PTAB2
	MOVE	B,TIMETB(W1)
	PUSHJ	P,PUTD3
	PUSHJ	P,NEWLIN
TIMLPX:	AOBJN	W1,TIMELP
DEFINE	T(A,DESC),<
	XLIST
	MOVE	B,N$'A
	PUSHJ	P,PUTD3
	PUSHJ	P,PTAB2
	MOVE	B,O$'A
	PUSHJ	P,PUTD3
	PUSHJ	P,PTAB2
	HRRZ	B,D$'A
	PUSHJ	P,PUTSTR
	PUSHJ	P,NEWLIN
	LIST
>

	MOVEI	A,[ASCIZ "
NUMBER		NUMBER		PATH
OF TIMES	OF TICKS
AS MAX.		AS MAX OVER
		300 NS.
"]
	MOVEM	A,SUBTTL
	PUSHJ	P,NEWPAG
	TIMETB
	MOVEI	A,[ASCIZ "
MICRO		NUMBER OF	NUMBER OF
BIT		ZEROS		ONES
"]
	MOVEM	A,SUBTTL
	PUSHJ	P,NEWPAG
	SETZM	BITNUM#

DEFINE	BITSCN(N,%A),<
	XLIST
	MOVSI	W1,-^D36
	MOVE	W2,[POINT 1,CBUF'N(RP),0]
%A:	MOVEI	RP,CMASK'N-CBUF'N
	LDB	A,W2
	SKIPN	A
	PUSHJ	P,BITCNT
	AOS	BITNUM
	IBP	W2
	AOBJN	W1,%A
	LIST
>
	BITSCN(1)
	BITSCN(2)
	BITSCN(3)
	MOVEI	B,[ASCIZ "
TOTAL		"]
	PUSHJ	P,PUTSTR
	MOVE	B,TOTZER
	PUSHJ	P,PUTD5
	PUSHJ	P,PTAB2
	MOVE	B,TOTONE
	PUSHJ	P,PUTD5
	PUSHJ	P,NEWLIN
	JRST	DONE
;SUBROUTINE TO COUNT THE BITS
;BITNUM/ BIT NUMBER
;W2/ BYTE POINTER
;
BITCNT:	MOVSI	RP,-CRAMSZ
	SETZB	W4,W5
BTCNT1:	SKIPN	CBUF1(RP)
	SKIPE	CBUF2(RP)
	JRST	BTCNT2
	SKIPN	CBUF3(RP)
	JRST	BTCNT3
BTCNT2:	LDB	A,W2
	ADD	W4,A
	ADDI	W5,1
BTCNT3:	AOBJN	RP,BTCNT1
	MOVE	B,BITNUM
	PUSHJ	P,PUTD3
	PUSHJ	P,PTAB2
	MOVE	B,W5
	SUB	B,W4
	ADDM	B,TOTZER#
	PUSHJ	P,PUTD5
	PUSHJ	P,PTAB2
	MOVE	B,W4
	ADDM	B,TOTONE#
	PUSHJ	P,PUTD5
	JRST	NEWLIN
;SUBROUTINE TO COLLECT AN OCTAL NUMBER IN B
;B IS NOT CLEARED, EXCEPT ON ENTRY AT GETOCZ

GETOCZ:	TDZA	B,B
GETOCT:	PUSHJ	P,GETC
GETOC1:	CAIL	A,"0"
	CAILE	A,"7"
	JRST	GETOC2			;NOT AN OCTAL DIGIT
	ROT	A,-3
	ROTC	A,3			;BITS TO B LOW
	JRST	GETOCT

GETOC2:	CAIE	A,","
	CAIN	A,40
	POPJ	P,
	CAIN	A,11
	POPJ	P,

	PUSHJ	P,ILLCHR
	HRROI	A,[ASCIZ / IN NUMERIC FIELD
/]
	PSOUT
	POPJ	P,

;COLLECT DECIMAL NUMBER IN B

GETDZ:	TDZA	B,B
GETDEC:	PUSHJ	P,GETC
	CAIL	A,"0"
	CAILE	A,"9"
	JRST	GETOC2		;CHECK FOR REASONABLE TERMINATOR
	IMULI	B,^D10
	ADDI	B,-"0"(A)
	JRST	GETDEC

ILLCHR:	PUSH	P,A
	HRROI	A,[ASCIZ /? ILLEGAL CHAR /]
	PSOUT
	MOVE	A,0(P)		;GET THE CHAR
	PBOUT			;PRINT IT
	HRROI	A,[ASCIZ / (/]
	PSOUT
	MOVEI	A,101
	POP	P,B		;GET CHAR AGAIN
	MOVEI	C,10		;PRINT IN OCTAL
	NOUT
	ERMSG	<PROGRAM BUG: NOUT JSYS FAILED>
	MOVEI	A,")"
	PBOUT
	POPJ	P,
;HERE TO COLLECT LINE NUMBER AFTER SCANNING OF BINARY

GTLINN:	PUSHJ	P,SKPST		;GET PAST SPACE & TAB
	CAIN	A,";"		;BETTER BE A SOURCE LINE HERE
	JRST	GTLN1
	PUSHJ	P,ILLCHR	;COMPLAIN
	HRROI	A,[ASCIZ \ SCANNING FOR LINE NUMBER
\]
	PSOUT
	MOVEI	B,0
	POPJ	P,
GTLN1:	PUSHJ	P,SKPST		;PASS ANOTHER
	JRST	GETDZ		;GO COLLECT LINE # & RETURN
;INPUT ROUTINES

SKPST:	PUSHJ	P,GETC			;HERE TO SKIP SPACES & TABS
	CAIE	A,40
	CAIN	A,11
	JRST	SKPST			;SKIP IT
	POPJ	P,

GETC:	SOSLE	INBCT			;ANY CHARS LEFT IN BUFFER?
	JRST	GETC1			;YES
	PUSHJ	P,INMAP			;NO, MAP IN ANOTHER PAGE
	MOVE	A,[POINT 7,INBUF]	;RESET BYTE POINTER
	MOVEM	A,INPT#
	MOVEI	A,5*PAGESZ*10		;5 BYTES PER WORD, 8 PAGES
	MOVEM	A,INBCT
GETC1:	ILDB	A,INPT			;GET CHAR
	JUMPE	A,GETC			;IGNORE NULLS
	CAIL	A,"a"			;LOWER CASE A
	CAILE	A,"z"			;LOWER CASE Z
	POPJ	P,0			;NOT LOWER CASE
	SUBI	A,"a"-"A"		;CONVERT TO UPPER CASE
	POPJ	P,

;HERE TO MAP IN INPUT

INMAP:	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	MOVEI	A,10		;GET NEXT PAGE #
	ADDB	A,INPAG		; ..
	CAMLE	A,INSIZ		;PAST EOF?
	JRST	INEOF		;YES
	HRL	A,INJFN
	MOVE	B,[XWD 400000,IBPAG]
	MOVX	C,PM%CNT+PM%RD+PM%PLD+10
	PMAP
POP3J:	POP	P,C
	POP	P,B
	POP	P,A
CPOPJ:	POPJ	P,

INEOF:	HRROI	A,[ASCIZ /?UNEXPECTED EOF ON INPUT
/]
	PSOUT
	JRST	DONE
;OUTPUT ROUTINES

NEWLIN:	PUSHJ	P,PCRLF
	MOVE	A,VERPOS
	CAIGE	A,^D52
	POPJ	P,0
NEWPAG:	MOVEI	A,14		;FORM FEED
	SKIPE	VERPOS		;TOP OF PAGE?
	PUSHJ	P,PUTC		;NO, GET THERE
	SETZM	VERPOS
	MOVEI	B,TTLBUF
	PUSHJ	P,PUTSTR
	MOVEI	B,[ASCIZ \ --  CHECKLIST	PAGE \]
	PUSHJ	P,PUTSTR
	AOS	B,PAGENO#
	PUSHJ	P,PUTD3
	MOVEI	B,[ASCIZ "
INPUT FROM: "]
	PUSHJ	P,PUTSTR
	MOVEI	B,IFILE
	PUSHJ	P,PUTSTR
	MOVEI	B,[ASCIZ \	OUTPUT TO: \]
	PUSHJ	P,PUTSTR
	MOVEI	B,OFILE
	PUSHJ	P,PUTSTR
	MOVE	B,SUBTTL
	JRST	PUTSTR
LINLOC:	PUSH	P,C		;SAVE ADDR
	TRZE	C,RP.D		;DROM ADDR?
	SKIPA	B,DLINE(C)	;YES
	HRRZ	B,CLINE(C)	;GET LINE #
	PUSHJ	P,PUTD4		;OUTPUT DECIMAL
	MOVEI	A,"("
	PUSHJ	P,PUTC
	POP	P,B		;GET LOC
	TRZN	B,RP.D		;DROM?
	JRST	LINL1		;NO, CRAM
	MOVEI	A,"D"		;MARK AS SUCH
	PUSHJ	P,PUTC
	PUSHJ	P,PUTO3		;OUTPUT 3-DIGIT ADDR
	SKIPA
LINL1:	PUSHJ	P,PUTO4		;OUTPUT OCTAL
	MOVEI	A,")"
	JRST	PUTC		;FINISH

PUTD5:	CAIGE	B,^D10000	;FIVE DIGITS?
	PUSHJ	P,PSPACE	;NO, SPACE OVER
PUTD4:	CAIGE	B,^D1000	;FOUR DIGITS?
	PUSHJ	P,PSPACE	;NO, SPACE OVER
PUTD3:	CAIGE	B,^D100
	PUSHJ	P,PSPACE
PUTD2:	CAIGE	B,^D10
	PUSHJ	P,PSPACE

PUTDC:	IDIVI	B,^D10
	PUSH	P,C
	SKIPE	B
	PUSHJ	P,PUTDC
	POP	P,A
	ADDI	A,"0"
	JRST	PUTC
PUTOV:	MOVE	C,[POINT 3,B]
	ILDB	A,C
	TLNE	C,(77B5)	;FORCE OUT IF LAST OIT
	JUMPE	A,.-2		;WAIT FOR NON-ZERO
	JRST	PUTOC1		;THEN PRINT IT

PUTO3:	SKIPA	C,[POINT 3,B,26]
PUTO4:	MOVE	C,[POINT 3,B,23]

PUTOC:	ILDB	A,C
PUTOC1:	ADDI	A,"0"
	PUSHJ	P,PUTC
	TLNE	C,(77B5)	;END OF WORD?
	JRST	PUTOC		;NO, DO ANOTHER
	POPJ	P,

PSPAC2:	PUSHJ	P,.+1
PSPACE:	MOVEI	A," "
	JRST	PUTC

PTAB2:	PUSHJ	P,.+1
PTAB:	MOVEI	A,11

;HERE TO OUTPUT A CHARACTER

PUTC:	IDPB	A,CBPNT		;JUST PUT IT INTO BUFFER
	POPJ	P,

PCRLF:	AOS	VERPOS
	MOVEI	B,[ASCIZ \
\]
;HERE TO OUTPUT AN ASCIZ STRING

PUTSTR:	PUSHM	<A,B,C>
	SKIPGE	CBPNT		;ANY CHARACTERS WAITING TO GO?
	JRST	PUTS1		;NO
	MOVEI	B,0
	IDPB	B,CBPNT		;TERMINATE WAITING STRING
	MOVE	B,[POINT 7,CBUF]
	MOVEM	B,CBPNT		;RESET BUFFER POINTER
	PUSHJ	P,PUTSUB	;OUTPUT WAITING STRING FIRST
	MOVE	B,-1(P)		;NOW THE REQUESTED STRING
PUTS1:	PUSHJ	P,PUTSUB
	POPM	<C,B,A>
	POPJ	P,

PUTSUB:	HRROS	A,B		;MAKE ASCII STRING POINTER
	TRNE	F,F.TYO
	PSOUT

	MOVE	A,OUTJFN
	MOVEI	C,0		;STOP ON ZERO
	SOUT
	ERMSG	<ERROR WRITING OUTPUT FILE>
	POPJ	P,
;HERE TO CLOSE WHEN DONE

DONE:	SETOM	A		;UNMAP ANY INPUT
	MOVE	B,[.FHSLF,,IBPAG] ; PAGE
	MOVX	C,PM%CNT+10
	PMAP
	ERJMP	.
	MOVE	A,INJFN
	CAMN	A,OUTJFN
	SETZM	OUTJFN
	CLOSF
	ERMSG	<CAN NOT CLOSE INPUT FILE>
	SKIPE	A,OUTJFN
	CLOSF
	ERMSG	<CAN NOT CLOSE OUTPUT FILE>
	TMSG	<
STATISTICS:
	FIXED STORAGE: >
	MOVEI	B,IFREE
	SUBI	B,FCA
	PUSHJ	P,TYPEP
	TMSG	<P
	FREE SPACE: >
	MOVE	B,FREE
	SUBI	B,IFREE
	PUSHJ	P,TYPEP
	TMSG	<P
	MICROWORDS PROCESSED: >
	MOVE	B,UCNT
	PUSHJ	P,TYPEN
	TMSG	<
	PAGES OF LISTING: >
	MOVE	B,PAGENO
	PUSHJ	P,TYPEN
	TMSG	<

>
STOP:	HALTF				;QUIT
	JRST	START
;TYPE NUMBER OF PAGES IN B
TYPEP:	ADDI	B,777
	LSH	B,-^D9
TYPEN:	MOVX	A,.PRIOU
	MOVEI	C,^D10
	NOUT
	ERMSG	<TYPEN: NOUT FAILED>
	POPJ	P,0
;ASK A QUESTION

;CALL WITH:
;	A/ POINTER TO ASCIZ STRING
;	PUSHJ	P,ASKYN
;	  HERE IF NO
;	HERE IF YES
;
ASKYN:	STKVAR	<YORN,PROMPT>
	HRLI	A,440700	;MAKE BYTE POINTER
	MOVEM	A,PROMPT
ASKYN1:	MOVE	A,PROMPT
	PSOUT
	HRROI	A,YORN
	MOVX	B,RD%BEL+RD%CRF+RD%RAI+4
	MOVE	C,PROMPT
	RDTTY
	ERMSG	<ASKYN: RDTTY FAILED>
	TXNN	B,RD%BTM
	JRST	ASKYNE
	LDB	A,[POINT 7,YORN,6]
	CAIN	A,"Y"	
	JRST	CPOPJ1
	CAIN	A,"N"
	POPJ	P,0
ASKYNE:	HRROI	A,[ASCIZ "Y<CR> OR N<CR> PLEASE
"]
	ESOUT
	JRST	ASKYN1
;GTJFN BLOCKS

GTIJFN:	GJ%OLD+GJ%MSG+GJ%CFM+GJ%XTN
	.PRIIN,,.PRIOU
	0
	0
	-1,,[ASCIZ "KS10"]
	-1,,[ASCIZ "MCR"]
	0
	0
	0
	500
	-1,,TXTBUF
	500
	-1,,[ASCIZ "INPUT: "]
	-1,,TXTBUF

GTOJFN:	GJ%FOU+GJ%NEW+GJ%MSG+GJ%CFM+GJ%XTN
	.PRIIN,,.PRIOU
	0
	0
	-1,,[ASCIZ "KS10"]
	-1,,[ASCIZ "CHK"]
	0
	0
	0
	500
	-1,,TXTBUF
	500
	-1,,[ASCIZ "OUTPUT: "]
	-1,,TXTBUF

TXTBUF:	BLOCK	100
;TABLES

	DEFINE	OTBL,<
XLIST
.T==1B0
REPEAT ^D36,<	EXP	.T
.T==.T_-1	>
LIST	>
ONES:	OTBL	;DEFINE TABLE OF SINGLE BITS INDEXED BY BIT #

	DEFINE	FLD(NAM,SIZ,POS,DVAL,DFLT),<
	RADIX	^D10
IFL POS-36,<
C.'NAM:	POINT	SIZ,CBUF1(RP),POS
>
IFGE POS-36,<	IFL POS-72,<
C.'NAM:	POINT	SIZ,CBUF2(RP),POS-36
>>
IFGE POS-72,<
C.'NAM:	POINT	SIZ,CBUF3(RP),POS-72
>
	RADIX	8	>;END DEFINITION OF FLD

	DEFINE	DFLD(NAM,SIZ,POS,DFLT),<
	RADIX	^D10
D.'NAM:	POINT	SIZ,DBUF(RP),POS
	RADIX	8	>

DEFINE	IFLD(A,B,C,D,E),<
	FLD(A,B,C,D,E)
>
	XALL
	FIELD	;EXPAND THE LIST OF FIELDS

	XLIST	;LITERAL POOL
	LIT
	LIST
FIRZER:!
PDL:	BLOCK	100
NVIA:	BLOCK	1	;NUMBER OF ITEMS CURRENTLY IN VIA LIST
VIA:	BLOCK	100	;HOW WE GOT WHERE WE ARE
CKSUM1:	BLOCK	1
CKSUM2:	BLOCK	1
IFILE:	BLOCK	50
OFILE:	BLOCK	50
TTLBUF:	BLOCK	<^D75/^D5>+1
CBUF:	BLOCK	40	;BOUT AVOIDANCE BUFFER
	VAR
ENDZER==.-1

DBUF:	BLOCK	^D512

DEFINE	U(PC,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T),<
>

DEFINE	D(PC,A,B,C),<
	RELOC	DBUF+PC
	BYTE	(12)A,B,C
	RELOC
>

DEFINE	END,<
	PURGE	END
	END	<3,,ENTRYV>
>

IF2,<	XLIST>