Google
 

Trailing-Edge - PDP-10 Archives - BB-H138E-BM - 6-1-sources/maklib.mac
There are 31 other files named maklib.mac in the archive. Click here to see a list.
; UPD ID= 142, SNARK:<6.1.UTILITIES>MAKLIB.MAC.2,   6-Jun-85 16:23:59 by DMCDANIEL
TITLE MAKLIB - RELOCATABLE BINARY FILE MANIPULATION PROGRAM
	SUBTTL	DAVID MCDANIEL/IGNORE REL BLOCK TYPE 100/25-APR-85
	SUBTTL	/HRB/CLRH/MFB/MS 28-SEP-80
	SUBTTL  I.L. GOVERMAN (VERSION 2A, PATCHING TOOL)  18-AUG-78
	SUBTTL  JANET EGAN (SCAN INTERFACE)/JIE 10-JAN-75
	SUBTTL  E. YOURDON (FUDGE2 PROGRAM)

;COPYRIGHT (C) 1975,1976,1977,1978,1980,1984 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	CUSTVR==0
	DECVER==2
	DECMVR==2
	DECEDT==105

;	VERSION NUMBER TO .JBVER
	LOC   137
	EXP	<<CUSTVR>B2+<DECVER>B11+<DECMVR>B17+<DECEDT>>
	RELOC


	;LOAD SYSTEM WIDE SYMBOLS FROM APPROPRIATE PLACES

	SEARCH  SCNMAC,UUOSYM,MACTEN


	;LOAD MODULES THAT WE REQUIRE

	.REQUEST REL:SCAN, REL:WILD, REL:HELPER

	;DEFAULT TO TWO-SEGMENT CODE

	ND PURESW,1
	IFN	PURESW,<TWOSEGMENTS
	LOW:	RELOC	400000>

COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1975,1984.
	

	;MAKE CLEAN LISTING, UNLESS SOME MACRO BLOWS UP

	ND BIGLST,0
	IFE BIGLST, <SALL>
	IFN BIGLST, <LALL>
SUBTTL EDIT HISTORY FOR MAKLIB


;EDIT	SPR	DESCRIPTION
;----   ---     -----------
;
;7	(NONE)	PRESERVE T2 ACROSS CALL TO CORE UUO IN ALLOC ROUTINE
;10	(NONE)	FIX ?FILE NOT FOUND MESSAGE
;	** END OF VERSION 1 **
;11	(NONE)	ADD BINARY PATCHING TOOL
;12	(NONE)	FIX HANDLING OF .TEXT ASCIZ 
;13	(NONE)	MAKE WILD CARDS WORK FOR TRANSACTION FILES
;14	(NONE)	MAKE WILD CARDS WORK FOR MASTER ON /L,/T AND /P
;15	(NONE)	ALLOW USE OF THE FULL RADIX50 CHARACTER SET
;16	(NONE)	DONT INCREMENT 2ND WORD OF HISEG PRODUCED TYPE 3 BLOCK
;17	(NONE)	MKLNIO  (NO INDEX) MESSAGE GIVES WRONG FILENAME
;20	(19567)	"?ILL UUO ..." WHEN DOING INSERT CORRECTED
;21	(35090)	BYPASS SPACES BETWEEN COMMA AND INSERT KEYWORD
;22	(20391)	CUSTOMER VERSION NUMBER OMITTED FROM .JBVER SETUP
;23	(35009)	MAKE .DATE PSEUDO-OP A LITTLE MORE USEFUL
;24	(20355)	MACPEK DOES NOT KNOW ABOUT LOWER CASE INPUT
;25	(35038)	FIX FILE PROCESSOR DOES NOT KNOW ABOUT LINE NUMBERED FILES
;26	(20357)	BAD ARITHMETIC IN .INSERT PROCESSOR FOR REPLACE KEYWORD
;27	(20156)	FIX COMBINATIONS OF /NOLOCALS AND /INDEX
;30	(NONE)	ADD .ALTER PSEUDO-OP
;31	(28328)	INDEX BLOCK COUNT WRONG FOR 2ND AND SUBSEQUENT FILES INDEXED
;32	(NONE)	MAKE MAKLIB ABLE TO ASSEMBLE WITH MACRO V52
;33	(NONE)	ADD IFX TYPE CONDITIONALS
;34	(NONE)	ADD .VERSION PSEUDO-OP TO SET UP .JBVER
;35	(NONE)	DON'T FOLLOW GLOBAL REFERENCE CHAINS INTO ABSOLUTE CODE
;36	(NONE)	FIX EDIT CONFLICT MESSAGE
;37	(NONE)	ADD A WAY TO REMOVE SYMBOLS USING BPT
;40	(NONE)	ADD /LOAD COMMAND TO TYPE OUT LOADING INSTRUCTIONS (REQ???&.TEXT)
;41	(20814)	PERFORMANCE IMPROVEMENT IN WRDSRC AND SYMSRC
;42	(NONE)	FURTHER IMPROVEMENT WITH CHANGE TO SYMSRC
;43	(20817)	SLIGHT SPEEDUP IN OPSRC FOR HALF WORD VALUES
;44	(NONE)	FIX TO COUNT FOR INDEX BLOCKS IN /TRACE AND /LOAD
;45	(20796)	FILTER BLANKS OUT OF RADIX50 CORRECTLY IN READ11
;46	(NONE)	DON'T PRE-ALLOCATE SYMBOL AND CODE AREA
;47	(20885)	EXPAND SIZE OF "NUMBER OF INSTRS INSERTED" PART OF TRACE BLOCK
;50	(20884)	EDIT 26 BROKE INSERTION AT START OF CORE-IMAGE
;51	(NONE)	DONT USE XCOUNT IN READ, IT MUST BE PRESERVED
;52	(NONE)	COUNT MUST RETURN 0 LENGTH FOR 0 HEADER, NOT 1
;53	(NONE)	MAKE MAKLIB ABLE TO PATCH REL FILES ASSEMBLED WITH MACRO 52+
;54	(21346)	INSURE PROPER MODE ON OPEN BY REPLACING MODE WORD
;55	(20628)	HAVE FIX COMPILER DO THE IO INSTRUCTIONS (7XX) CORRECTLY
;56	(NONE)	USE SCAN.REL RATHER THAN SCN7B.REL
;57	(NONE)	DON'T GENERATE 0 WORDS FOR LITERAL LINES CONTAINING NO CODE
;60	(NONE)	ADD AN IMPLEMENTATION OF 'BLOCK' OPERATOR TO FIX ASSEMBLER
;61	(NONE)	HAVE '#' AFTER SYMBOL DEFINE A LOW SEG LOCATION LIKE MACRO
;62	(NONE)	MAKE POLISH HANDLING CODE BETTER
;63	(21547)	/MASTER ALONE WITH NO TRANSACTIONS FILE SHOULD BE ILLEGAL
;64	(21930) TEST CORRECT BITS FOR LAST BYTE=NULL
;65		DON'T ALLOW "*" TO BE USED AS OUTPUT FILE NAME.
;66		GIVE WARNING THAT TRANSACTION FILE IS IGNORED WITH /INDEX
;67	(25691)	PREVENT ALLOCATION OF NEW BUFFER SPACE FOR EACH SWITCH.
;70	(22997)	ALLOW THE STANDARD SCAN/WILD SWITCHES (SINCE,BEFORE,ETC.)
;		TO WORK.
;71	(27130)	FIX INDEXING OF BLOCK EXACTLY 200(8) WORDS LONG (TWO
;		OFF-BY-ONE BUGS).
;72	-----	REPLACE THE ORIGINAL EDIT 70 (LOST SOMEHOW)
;73	12886	GET FILE NAME RIGHT IN NIO ERROR MESSAGE (NEEDS EDIT 17).
;74	(NONE)	FIX "ILL MEM REF" CAUSED BY USING INVALID POLISH POINTER
;		WHEN TRYING TO CHANGE GLOBAL CHAINS WHEN A WORD'S POSITION
;		IS CHANGED IN THE REL FILE.
;75	(NONE)	WARN USER IF TRYING TO REMOVE EDIT THAT HAS NO CODE.
;76	(NONE)	GIVE CORRECT DEVICE IN LOOKUP ERROR MESSAGE
;		IN SWTDIS.
;77	(NONE)	INCREASE NUMBER OF MODULES THAT CAN BE SPECIFIED
;		(MAXMOD) FROM ^D20 TO ^D100.  NOTE THAT THIS WILL INCREASE
;		THE SIZE OF THE EXE FILE BY ONE PAGE.  THIS PATCH ONLY NEEDS
;		TO BE INSTALLED IF THE MESSAGE "TOO MANY MODULE .."
;		BECOMES BOTHERSOME.
;100	(NONE)	SPECIFY IF THE ERROR MESSAGE "TOO MANY MODULE.." HOW FAR 
;		THE MODULES ARE BEING ACCEPTED BY CLARIFYING THE MESSAGE 
;		"TOO MANY MODULE.. STOPPED AT [MODULE]
;101	(NONE)	ADD EDIT NUMBER TO THE ERROR MESSAGE TO ?MKLBDA.
;102	(NONE)	DISPLAY THE ERROR MKLNPC ONLY IF THE USER TRIES TO USE
;		INSERT OR ALTER ON FIX SWITCH.
;103	(NONE)	MKLIAL ERROR PRINTS MODULE NAME INSTEAD OF EDIT NUMBER
;104	(NONE)	USE 11 BITS FOR CORRECT CREATION TIME ON .RBPRV
;		WHILE DISPLAYING THE HEADING ON LIST AND POINT SWITCH.
;105	(NONE)	ADD A CHECK FOR REL BLOCK TYPE 100 AT READ2B+5 AND YANK2+5.
;		JUST IGNORE REL BLOCK TYPE 100.  QAR #838228.
;******		END OF REVISION HISTORY		********
SUBTTL DEFINE THE ACCUMULATORS

;MAKLIB ACCUMULATOR DEFINITIONS

	F==0		;FLAGS
	T1==1		;SCAN INTERFACE AC
	T2==T1+1	;   "
	T3==T2+1	;	"
	T4==T3+1	;	"
	R==5		;SYMBOL NAME
	T==6		;HISTORICAL AC
	N==7		;NUMBER OR WORD FOR IO
	CC==10		;CHARACTER AC FOR INPUT
	A==11		;ARGUMENT AC, USED BY ROUTINES
	B==12		;..
	C==13		;..
	D==14		;..
	IOC==15		;IO CHANNEL FOR ACTIVE FILE
	FPT==16		;POINTER TO FILE AREA FOR CURRENT FILE
	P==17		;STACK POINTER
SUBTTL SCAN INTERFACE BIT DECLARATIONS

SW.APP==1B18		;APPEND
SW.DEL==1B19		;DELETE
SW.EXT==1B20		;EXTRACT
SW.INS==1B21		;INSERT
SW.MAS==1B22		;MASTER
SW.REP==1B23		;REPLACE
SW.FIX==1B24		;FIX
SW.WHO==1B25		;WHO
SW.LST==1B35		;LIST
SW.NOL==1B34		;DELETE LOCAL SYMBOLS
SW.POI==1B33		;LIST ENTRY POINTS
SW.IND==1B32		;INDEX
SW.TRC==1B31		;TRACE
SW.LOA==1B30		;LOAD
SW.EOT==1B29
SW.REW==1B28
SW.ZER==1B27
SUBTTL DECLARATION OF PARAMETERS

;INPUT-OUTPUT CHANNELS

SCNCHN==0	;RESERVED FOR SCAN
OCHN==1		;OUTPUT CHANNEL
MIN==2		;MASTER FILE INPUT CHANNEL
TRIN==3		;TRANSACTION FILE INPUT (ALSO USED FOR PATCH FILE)

; SYMBOL TABLE BITS THAT AGREE WITH THE DEFINITIONS THAT LINK USES

	R5.DDT==400000,,0	;SUPRESSED TO DDT
	R5.REQ==600000,,0	;GLOBAL REQUEST
	R5.LCL==100000,,0	;LOCAL SYMBOL
	R5.GLB==040000,,0	;GLOBAL DECLARATION

	R5.FXA==1B0		;GLOBAL FIXUP WORD 2,ADDITIVE FIXUP
	R5.FXL==1B1		;  "      "      "   ", TO LEFT HALF
	R5.FXS==1B2		;  SYMBOL TABLE FIXUP

	CBSIZE==^D20		; NUMBER OF WORDS IN LINK CODE BLOCK (TYPE 1)
	SBSIZE==^D20		; NUMBER OF WORDS IN LINK SYMBOL BLOCK (TYPE 2)


; DEFINAEABLE PARAMETERS

;**; [77] CHANGE AT DEFINITION OF MAXMOD	MFB	30-JUL-80
	ND MAXMOD,^D100	;[77]NUMBER OF ARGS MAXIMUM FOR SWITCHES
	ND FSSIZE,<.FXLEN+1+MAXMOD> ;TOTAL SIZE OF SPEC AREA
	.FXPRG==.FXLEN+1	;OFFSET IN SPEC AREA TO PROGRAM NAMES
	ND SIZE,200	;SIZE OF ENTRY BLOCK THAT PROGRAM CAN HAVE
	ND MTBSIZ,200	;SIZE OF MASTER AND/OR TRANSACTION FILE BUFFER
	ND TABS1,20	;NUMBER OF TAB STOPS FOR NON-TTY DEVICE
	ND TABS2,11	;FOR TTY
	ND FTBPT,1	;DEFAULT TO INCLUDE BPT
	IFE FTBPT,<DEBUG==0>  ;NO DEBUGGING IF NO BPT
	ND CREMAX,^D200	;MAXIMUM NUMBER OF NEW SYMBOLS
	    CREMAX==<CREMAX+^D8>/^D9*^D9	;ROUND UP TO NEXT LINK BLOCK
	    NSBMAX==CREMAX/^D9			;NUMBER OF SYMBOL BLOCKS NEEDED
	ND PATMAX,^D1000 ;MAXIMUM NUMBER OF NEW CODE WORDS 
	     PATMAX==<PATMAX+^D16>/^D17*^D17	;ROUND UP TO NEXT LINK BLOCK
	     NCBMAX==PATMAX/^D17		;NUMBER OF CODE BLOCKS NEEDED
	ND NPBMAX,1	;MAXIMUM NUMBER OF NEW POLISH BLOCKS
	ND TRCMAX,^D150 ;MAX. NUMBER OF TRACE WORDS AVAILABLE
	ND ISTMAX,^D75	;MAXIMUM NUMBER OF FORWARD REFERENCES OUTSTANDING
	ND OPRSIZ,^D40	;SIZE OF OPERAND STACK (4 WDS PER OPERAND)
	ND OPTSIZ,^D10	;SIZE OF OPERATOR STACK (1 WD PER OPERATOR)
	ND MACSIZ,^D100	;MAX. NR. OF MACRO CHARACTERS PER LINE
	ND DEBUG,0	;DEFAULT DEBUGGING STATUS
	ND LI$TRC,1060	;HEADER ID FOR TRACE BLOCK IN REL FILE
	ND $EOL,12	;CONVERT ALL BREAKS TO THIS
	ND PD$LEN,^D150	;DEFAULT PUSHDOWN LIST SIZE
SUBTTL FLAGS


; MACRO TO DEFINE FLAG BITS

	DEFINE BIT($NAME)<
	IFE $1BIT,<PRINTX ?TOO MANY FLAG BITS DEFINED>
	$NAME==$1BIT
	$1BIT==$1BIT*2
> ; END OF BIT DEFINITION
	$1BIT==1	;INIT


	BIT(DEVTTY)		;ON MEANS OUTPUT DEVICE IS THE TTY
	BIT(FOTTY)		;ON MEANS FORCE OUTPUT TO TTY
	BIT(NOLOCB)		;ON MEANS DELETE LOCAL SYMBOLS
	BIT(ERRB)		;ON MEANS PROGRAM ENTRY BLOCK TOO LARGE
	BIT(IAE)		;ON MEAN BETWEEN .EDIT AND .ENDE
	BIT(IAI)		;ON MEANS BETWEEN .INSERT AND .ENDI
	BIT(F4IB)		;ON MEANS IGNORE F4 OUTPUT
	BIT(XFLG)		;ON MEANS INDEX REQUESTED FOR FILE
	BIT(DTAFLG)		;ON MEANS OUTPUT DEVICE IS DTA (SPECIAL INDEX)
	BIT(NOWARN)		;ON MEANS DELETE "INDEX DELETED" MSG.
	BIT(LSTENT)		;ON MEANS LIST ENTRY BLOCKS
	BIT(FIXMOD)		;ON MEANS /FIX SWITCH WAS GIVEN
	BIT(FSTMOD)		;ON MEANS [EDIT] SEEN SINCE LAST [MODULE]
	BIT(CPASS2)		;ON MEANS WE'VE ALREADY REWOUND MASTER FILE
	BIT(QUOTE)		;ON MEANS DONT EDIT CHARACTERS IN INPUT
	BIT(REGET)		;ON MEANS GIVE LAST PATCH CHARACTER AGAIN
	BIT(DEBMOD)		;ON MEANS IN DEBUGGING MODE
	BIT(DEBIMC)		;ON MEANS DEBUGGING INTERNAL MACRO CODE
	BIT(XACTF)		;[70] ON MEANS AT LEAST ONE TRANACTION FILE USED
SUBTTL ERROR MESSAGE MACRO

; THESE MACROS INTERFACE WITH SCAN'S ERROR MESSAGE PROCESSOR.
; ALL BEHAVE ROUGHLY THE SAME. ALL USE T1-T4.
; $WARN IS USED TO PUT OUT A MESSAGE "%MKLXYZ TEXT"
; $TELL IS USED TO PUT OUT A MESSAGE OF THE FORM "[MKLXYZ TEXT]"
; $KILL IS USED TO PUT OUT A MESSAGE OF THE FORM "?MKLXYZ TEXT"
;
;
; ALL THREE MACROS TAKE UP TO FOUR ARGUMENTS;
;
; $PFX- THE UNIQUE 3 LETTER CODE FOR THIS ERROR. A LABEL IS CREATED
;	OF THE FORM "E$$'$PFX"
;
; $TXT-  THE REST OF THE MESSAGE TO BE TYPED OUT.
;
; $TYPO-  A ROUTINE TO BE CALLED FOR TYPEOUT OF AC N. (OPTIONAL)
;	  IF PRESENT, IT IS PUSHJ P'ED TO AFTER THE TEXT IS TYPED.
;
; $CONT-IF THIS FIELD IS NON-BLANK, THEN MESSAGE CONTINUES. THE FINAL
;	   CALL TO .TCRLF SHOULD BE LABELED "X$$'$PFX"
;	IF $CONT IS NON-BLANK AND NO LABEL X$$'$PFX EXISTS THEN
;	ON SHORT ERROR STATUS CONTROL PASSES TO LABEL "DONERR"
;	NOTE: ON A CONTINUED MESSAGE, FLAG BIT "FOTTY" IS STILL SET
;	SO THAT AT THE LABEL "X$$'$PFX" AN INSTRUCTION LIKE
;	TXZ F,FOTTY MUST BE PRESENT, UNLESS THE PROGRAM RESTARTS.
;


	DEFINE $ERR($FLG,$PFX,$TXT,$TYPO,$CONT)<
	IFB <$TXT>, <..TMP1==[EXP 0]>
	IFNB <$TXT>,	<..TMP1==[ASCIZ \$TXT\]>
	..TMP2==0
	..TMP3==0

	IFNB <$TYPO>, <..TMP2==$TYPO>
	IFNB <$CONT>,<
		IF1,<..TMP3==-1>
		IF2,<  IFDEF X$$'$PFX,<..TMP3==X$$'$PFX>
		       IFNDEF X$$'$PFX,<..TMP3==DONERR>
		     >>

E$$'$PFX:	JSP	T1,$FLG
	IFE BIGLST,<XLIST>
	JUMP	[XWD <''$PFX''>,..TMP1
		 XWD ..TMP2,..TMP3]
	LIST
	> ;END OF $ERR DEFINITION


; FATAL ERROR:

	DEFINE $KILL($PFX,$TXT,$TYPO,$CONT)<
	$ERR(E$KIL,$PFX,<$TXT>,$TYPO,$CONT)>

; WARNING:
	DEFINE $WARN($PFX,$TXT,$TYPO,$CONT)<
	$ERR(E$WRN,$PFX,<$TXT>,$TYPO,$CONT)>

; COMMENTARY:

	DEFINE $TELL($PFX,$TXT,$TYPO,$CONT)<
	$ERR(E$TEL,$PFX,<$TXT>,$TYPO,$CONT)>

; ROUTINES TO USE FOR TYPOUT OF AC N. NOTE THAT THESE ROUTINES ARE
;	PUSHJ'ED TO AFTER AC T1 IS LOADED FROM AC N.
;
	N$DEC==.TDECW##		;DECIMAL OUTPUT
	N$OCT==.TOCTW##		;OCTAL
	N$SIX==.TSIXN##		;SIXBIT
	N$STRG==.TSTRG##	;STRING
	N$50==	PTYPO		;RADIX 50
	N$CHR==.TCHAR##		;CHARACTER
	N$PPN==.TPPNW##		;PPN
	N$XWD==.TXWDW##		;XWD
 IFN FTBPT,< N$EDIT==SAYED1>	;CURRENT EDIT NAME
SUBTTL INTERNAL FAILURE (STOPCODE) ERROR MACRO

; MAKLIB MAKES CHECKS ON ITS OWN BEHAVIOR AND REPORTS FAILURES
; AND INCONSITENCIES VIA THE $STPCD MACRO AND PROCESSOR.

	DEFINE $STPCD($MSG)<

	PUSHJ	P,[MOVEI N,[ASCIZ \$MSG\]
		   PUSHJ P,STOPCD]
> ; END OF $STPCD MACRO
; MACROS AND PSEUDO-INTSTRUCTIONS USED BY BINARY PATCHING TOOL
;
IFN FTBPT,<				;DONT DEFINE IF BPT NOT INCLUDED


				;MACRO TO GET FIRST NON-BLANK CHARACTER
	DEFINE BYPASS<
	PUSHJ P,MIC   
	XLIST
	CAIN	CC," "
	JRST     .-2
	LIST >

				;SOME COMMON INSTRUCTIONS

	OPDEF SKPNUM  [PUSHJ P,TDIGIT]	;SKIP IF CHARACTER IS NUMERIC
	OPDEF SKPR50  [PUSHJ P,TR50]	;SKIP IF CHARACTER IS RADIX50
	OPDEF SKPABC  [PUSHJ P,TABC]	;SKIP IF CHARACTER IS ALPHABETIC
	OPDEF SKPCM   [CAIE CC,","]	;SKIP IF CHARACTER IS COMMA
	OPDEF SKPNCM  [CAIN CC,","]	;SKIP IF CHARACTER IS NOT COMMA


	;SPECIAL CHARACTERS WHICH ARE HARD TO PUT IN-LINE

	LABRKT=="<"			;LEFT ANGLE BRACKET
	RABRKT==">"			;RIGHT ANGLE BRACKET
	LSBRKT=="["			;LEFT SQUARE BRACKET
	RSBRKT=="]"			;RIGHT SQUARE BRACKET
	SCOLON==";"			;SEMI COLON
	LPAREN=="("			;LEFT PAREN
	RPAREN==")"			;RIGHT PARENTHESIS
	SQUOTE=="'"			;SINGLE QUOTE
	DQUOTE==42			;DOUBLE QUOTE

>  ; NFI FTBPT
COMMENT \


	FORMAT OF TRACE BLOCK    (LINK ITEM TYPE 1060)


THE LINK ITEM TYPE, "TRACE BLOCK DATA" IS USED TO INCLUDE IN
THE REL FILE INFORMATION THAT CAN BE USED TO BOTH VERIFY AND CHANGE
THE PATCH STATUS OF A PROGRAM. THE FORMAT OF THE TRACE BLOCK FOLLOWS:


THE FIRST PART OF THE TRACE BLOCK IS THE STATIC AREA. THIS AREA APPEARS
IN EACH MODULE THAT IS AFFECTED BY THE PARTICULAR EDIT. THE STATIC AREAS
GIVE INFORMATION COMMON TO ALL MODULES AFFECTED BY AN EDIT AND
THE VARIABLE AREA GIVES THE CHANGING DATA ON THE
PARTICULAR EDIT AS IT GOES FROM MODULE TO MODULE.

	!=====================================!
TB$HED	! LINK ITEM NUMBER ! LENGTH OF BLOCK  !
	!-------------------------------------!
TB$EDT	!   SIXBIT EDIT NAME (UP TO 6 CHRS)   !
	!-------------------------------------!
TB$STA	!   -1 IF ACTIVE   !WHO LAST AFFECTED !
	!-------------------------------------!
TB$MAK	!   WHO CREATED    !  DATE (15 BIT)   !
	!-------------------------------------!
TB$INS	!  WHO INSTALLED   !  DATE (15 BIT)   !
	!-------------------------------------!
TB$FUT	!       RESERVED FOR FUTURE USE       !
	!-------------------------------------!
TB$LEN	! # OF ASS. EDITS  !  # OF PCO GROUPS !
	!=====================================!



	THE STATIC AREA, WHICH IS REPEATED IN EACH MODULE, IS FOLLOWED
BY A VARIABLE AREA. THE VARIABLE AREA CONSISTS OF TWO PARTS, THE
FIRST GIVING DATA ON THE ASSOCIATED EDIT STATUS FOR THIS MODULE AND
THE NEXT GIVING THE ACTUAL PROGRAM CHANGE ORDERS (PCO'S). THE
LENGTH OF EACH OF THESE AREAS APPEARS IN THE STATIC AREA OF THE TRACE 
BLOCK.

          FOR EACH ASSOCIATED EDIT, THE FOLLOWING GROUP APPEARS:

	!=====================================!
TB$AEN	!      SIXBIT EDIT NAME OF A.E.       !
	!-------------------------------------!
TB$AES	!X!        RESERVED FOR FUTURE        ! X=0 IF MUST NOT BE PRESENT
	!=====================================!  =1 IF MUST BE PRESENT

	AFTER THE ASSOCIATED EDIT GROUPS APPEAR, IF THERE ARE ANY, THE
PCO GROUPS FOR THAT MODULE APPEAR. THERE ARE CURRENTLY THREE TYPES
OF PCO GROUPS;  INSERT,REMOVE AND RE-INSERT. THEY CAN
APPEAR IN ANY ORDER AND THE TOTAL NUMBER IS OF COURSE VARIABLE.

		INSERT PCO:
	!=====================================!
TB$PCO	!PCO TYPE CODE (1) ! LENGTH OF GROUP  !
	!-------------------------------------!
TB$DAT	!    INSTRS  INSRTD! ADDR. OF INSERT  ! 
	!-------------------------------------!
TB$PAT	!  NEW ADDR OF ORG !  ADDR OF PAT CODE!
	!=====================================!


		REMOVE PCO:
	!=====================================!
TB$PCO	!PCO TYPE CODE (2) ! LENGTH OF GROUP  !
	!-------------------------------------!
TB$REN	!          SIXBIT EDIT NAME           !
	!=====================================!
	
	
		RE-INSERT PCO:
	!=====================================!
TB$PCO	!PCO TYPE CODE (3) ! LENGTH OF GROUP  !
	!-------------------------------------!
TB$RIN	!          SIXBIT EDIT NAME           !
	!=====================================!


		ALTER PCO:
	!=====================================!
TB$PCO	!PCO TYPE CODE (4) ! LENGTH OF GROUP  !
	!-------------------------------------!
TB$DAT	!      UNUSED      ! ADDR. OF INSERT  ! 
	!-------------------------------------!
TB$PAT	!  NEW ADDR OF ORG !      UNUSED     !
	!=====================================!



\
SUBTTL DEFINED MNEMONICS FOR THE TRACE BLOCK DATA

	DEFINE TBDA($NAME)<
	 TB$'$NAME==$OFFSET
	$OFFSET==TB$'$NAME+1
	>

	$OFFSET==0	;INIT
	
	TBDA(HED)	;HEADER		
	TBDA(EDT)	;EDIT NAME	
	TBDA(STA)	;STATUS		
	TBDA(MAK)	;MAKER		
	TBDA(INS)	;INSERTER
	TBDA(FUT)	;RESERVED	
	TBDA(LEN)	;LENGTH OF AREA	
	TBDA(VAR)	;VARIABLE AREA
	  TB$SIZ==$OFFSET-2	;SIZE OF BLOCK STATIC AREA COUNT

	$OFFSET==0	;RELATIVE ADDRESS

	TBDA(AEN)	;ASSOCIATED EDIT NAME
	TBDA(AES)	;ASSOCIATED EDIT STATUS REQUIRED
	  AESIZ==$OFFSET	;SIZE OF ASSOCIATED EDIT

	$OFFSET==0	;RELATIVE ADDRESS

			;PCO TYPE 1, INSERT
	TBDA(PCO)	;ALWAYS THERE
	TBDA(DAT)	;INSERTION DATA
	TBDA(PAT)	;NEW ADDR OF DISPLACED INSTR,,1ST INSTRUCTION OF PATCH
	    PCO1SZ==$OFFSET	;SIZE OF PCO TYPE 1 GROUP

	$OFFSET==0	;PCO TYPE 2,REMOVE

	TBDA(PCO)	;SAME AS ABOVE
	TBDA(REN)	;SIXBIT EDIT TO REMOVE
		PCO2SZ==$OFFSET
	
	$OFFSET==0	;PCO TYPE 3,RE-INSERT

	TBDA(PCO)	;
	TBDA(RIN)	;RE-INSERT EDIT NAME
		PCO3SZ==$OFFSET

		$OFFSET==0
	
	TBDA(PCO)	;PCO TYPE 4, ALTER
	TBDA(DAT)	;INSERTION DATA
	TBDA(PAT)	;PATCH AREA DATA
		PCO4SZ==$OFFSET

		PCOMAX==4		;MAXIMUM DEFINED PCO NUMBER

	SUBTTL INITIALIZE AND SETUP OF MAKLIB

MAKLIB:	TDZA	T1,T1			; IN CASE OF CCL ENTRY
	MOVEI	T1,1		;COMPUTE STARTING OFFSET
	RESET			;RESET I/O DEVICES
	MOVE	[XWD	LOW,LOW+1]
	SETZM	LOW
	BLT	LOWTOP-1
IFN	PURESW,<
	MOVE	[XWD	HIGH,LOW]
	BLT	LOWBLK>
	MOVE	P,[IOWD PD$LEN,PDLIST] ;SET UP PUSHDOWN POINTER
	MOVEM	T1,OFFSET	;STORE STARTING OFFSET

	MOVE	T1,[3,,[0
			XWD	OFFSET,'LIB' ;MY OFFSET AND CCL NAME
			XWD      0,BOUT   ]  ;USE BOUT   FOR TYPEOUT
		]
	TXO	F,FOTTY		;FORCE ANY OUTPUT TO TTY
	PUSHJ	P,.ISCAN##	;INITIALIZE SCAN
	MOVE	T1,.JBFF##	;SAVE .JBFF
	MOVEM	T1,ORGFF	;  FOR LATER
	MOVEM	P,ORGPP		;
	SUBTTL	MAKLIB COMMAND SCANNER

MAKSCN:	MOVX	F,FOTTY		;CLEAR FLAGS , FORCE OUTPUT TO TTY
	MOVE	P,ORGPP		;RESET PDL PHASE
	RESET	0		;CLEAR ALL I/O DEVICES
	MOVE	T1,ORGFF	;IF HAVE WE SWOLLEN
	MOVEM	T1,.JBFF##	;WE MUST REDUCE
IFE DEBUG,<			;DONT GET RID OF CORE IF DEBUGGING
	SOS	T1		;OUR MINIMUM LEGAL SIZE
	CORE	T1,		;REDUCE OUR SIZE
	 JFCL			;WELL, WE TRIED
> ;EFI DEBUG
	MOVE	T1,[11,,[IOWD MKLSWL,MKLSWN
			XWD MKLSWD,MKLSWM
			XWD  0,MKLSWP
			-1
			XWD  CLRANS,0
			XWD ALLIN,ALLOUT
				0
				0
			XWD 0,STORER ]]
	PUSHJ	P,.TSCAN##		;SCAN THE COMMAND LINE
	MOVE	T1,[5,,[IOWD MKLSWL,MKLSWN
			XWD MKLSWD, MKLSWM
			XWD      0 ,MKLSWP
			-1
			0]]		;SET TO FILL IN FROM SWITCH.INI
	PUSHJ	P,.OSCAN##		;FILL IN FROM THERE
	PUSHJ	P,CHECK		;SEE IF EVERYTHING IS THERE
	SETZM	WLDTMP		;CLEAR OUT TEMPORARY AREA FOR WILD
	MOVE	T1,OUTBEG		;TELL SCAN START OF OUTPUT SPEC
	MOVEI	T2,OPNBLK		;  NAME OF OPEN BLOCK
	MOVE	T3,[.RBSIZ+1,,LKPBLK]	;   LOOKUP BLOCK
	HLRZM	T3,LKPBLK
	PUSHJ	P,.STOPN##		;SCAN BLKS TO OPEN &LOOKUP BLKS
	  $KILL(WIO,Wild cards illegal for OUTPUT file specification)
	TXZ	F,FOTTY			;NO LONGER FORCE OUTPUT TO TTY
					;ERROR MSG WILL SET THIS WHEN NEEDED
	JRST	SWTPRC			;NOW TO PROCESS THE SWITCHES

OPNFAI:	TXO	F,FOTTY
	PUSHJ	P,E.DFO##
	JRST	MAKSCN			;GO PROMPT AGAIN

LKPFAI:	MOVEI	T1,LKPBLK
	MOVEI	T2,6
	MOVE	T3,INBEG		;POINT TO INPUT SPEC
	TXO	F,FOTTY			;FORCE TO TTY
	PUSHJ	P,E.LKEN##
	JRST	MAKSCN
DM	XXX,1,0,0
;;**[15] CHANGE SWTCHS DEFINITION TO USE INTERNAL PROCESSOR

DEFINE	SWTCHS,<
	SP	*APPEND,SW.APP,SYMSW,XXX
	SP	*DELETE,SW.DEL,SYMSW,XXX
	SP	*EXTRAC,SW.EXT,SYMSW,XXX
	SP	*INSER,SW.INS,SYMSW,XXX
	SP	*MASTER,SW.MAS,SYMSW,XXX,FS.VRQ
	SP	*REPLAC,SW.REP,SYMSW,XXX
	SP	*FIX,SW.FIX,SYMSW,XXX
	SP	*WHO,SW.WHO,SYMSW,XXX,FS.VRQ
	SS	*LIST,<POINTR (SWIWRD,SW.LST)>,1,FS.NUE
	SS	*NOLOC,<POINTR (SWIWRD,SW.NOL)>,1,FS.NUE
	SS	*POINTS,<POINTR (SWIWRD,SW.POI)>,1,FS.NUE
	SS	INDEX,<POINTR (SWIWRD,SW.IND)>,1,FS.NUE
	SS	*TRACE,<POINTR (SWIWRD,SW.TRC)>,1,FS.NUE
	SS	LOAD  ,<POINTR(SWIWRD,SW.LOA)>,1,FS.NUE
>
DOSCAN(MKLSW)
CLRANS:	SETZM	SCNBEG			;CLEAR ANSWER AREA
	MOVE	T1,[SCNBEG,,SCNBEG+1]	;STANDARD ZERO-AREA BLT
	BLT	T1,SCNEND		;CLEAR OUT CURRENT ANSWER
	MOVE	T1,ORGFF		;RESTORE
	MOVEM	T1,.JBFF##		;  .JBFF
	POPJ	P,

ALLOUT:	MOVE	T1,.JBFF##		;POINT TO
	MOVEM	T1,OUTEND		;  END OF OUTPUT AREA
	SKIPN	OUTBEG			;HAVE WE STARTED ALREADY?
	MOVEM	T1,OUTBEG		;NO--THIS IS THE BEGINNING
	JRST	ALLOC1
ALLIN:	MOVE	T1,.JBFF##		;POINT TO
	MOVEM	T1,INEND		; END OF INPUT AREA
	SKIPN	INBEG			; IF WE HAVEN'T STARTED YET
	MOVEM	T1,INBEG		;  THIS IS THE BEGINNING
ALLOC1:	MOVEM	T1,A			;SAVE AWAY CURRENT FILE POINTER
	MOVEI	T2,FSSIZE-1(T1)
	CAMG	T2,.JBREL##
	JRST	ALLOC2
	PUSH	P,T2			;PRESERVE T2, WE NEED IT
	CORE	T2,			;AND EXPAND CORE
	  JRST	NECERR			;?NOT EVEN ENOUGH CORE FOR SWITCHES
	POP	P,T2			;RESTORE ALLOCATION POINTER
ALLOC2:	HRLI	T1,TMAREA
	BLT	T1,(T2)
	MOVE	T1,A			;RESTORE CURRENT FILE POINTER
	SETZM	TMAREA+.FXLEN
	MOVEI	T2,FSSIZE
	ADDM	T2,.JBFF##
	POPJ	P,

STORER:	TLZ	T2,-1
	TXNE	T2,SW.WHO			;IS THIS /WHO?
	JRST	[ SKIPN WHO			;DONT OVERWRITE
		  HLRZM N,WHO			;ELSE STORE IT
		  POPJ P,]			;AND DONT CONFLICT
	TRC	T2,-1
	TDNE	T2,TMAREA+.FXLEN
	 $KILL(TMS,Too many switches)
	TRC	T2,-1
	IORM	T2,TMAREA+.FXLEN
	JUMPE	N,CPOPJ
	HLRZ	T2,TMAREA+.FXLEN
	CAIL	T2,MAXMOD
;**; [100] CHANGE @ STORER + 13L	MS	15-SEP-80
;**; [100] ADD THE MODULE NAME IN THE FOLLOWING MESSAGE
;**; [100] TO INDICATE HOW FAR THE MODULES CAN BE ACCEPTED.
	    $KILL(TMN,Too many module names - stopped at MODULE:,N$SIX) ;[100]
	AOS	T2
	HRLM	T2,TMAREA+.FXLEN
	MOVEM	N,TMAREA+.FXLEN(T2)
	POPJ	P,
; THIS ROUTINE INPUTS IN SIXBIT FORM 1 WORD WHICH CONTAINS
; A RADIX50 CHARACTER SET SYMBOL. THE ROUTINE CONFORMS
; TO SCAN STANDARDS AND UPDATES THE TERMINATOR.
;

SYMSW:	PUSHJ	P,.TICQT##		;ALLOW QUOTING
	MOVEI	N,0			;START WITH NULL RESULT
	MOVEI	T1,.TSIXN##		;FOR ERROR MESSAGES
	MOVEM	T1,.LASWD##		;TELL SCAN WHAT TO DO
	MOVE	T1,[POINT 6,N]		;BYTE POINTER INITED
SYMS1:	PUSHJ	P,.TIAUC##		;GET A CHARACTER
	PUSHJ	P,.TIMUC##		;CONVERT TO UPPER CASE
	SKIPLE	.QUOTE##		;QUOTED?
	JRST	SYMS2			;YES
	PUSHJ	P,TICSY			;IN RADIX50 SET?
	  JRST	[ MOVEM N,.NMUL##	;NO,SO DEPOSIT INTO RESULT
		  POPJ P,]		;AND RETURN
SYMS2:	CAIL	CC,40			;IN PROPER RANGE AT LEAST?
	CAILE	CC,137			;
	JRST	E.ILSC##		;NO, "?ILLEGAL CHAR."
	SUBI	CC," "-' '		;CONVERT TO SIXBIT
	TLNE	T1,(77B5)		;DISCARD PAST FIRST WORD
	IDPB	CC,T1			;DEPOSIT IN INTERMEDIATE RESULT
	JRST	SYMS1			;GO BACK FOR MORE

TICSY:	CAIE	CC,"%"			;ALLOW %.$
	CAIN	CC,"$"			;
	JRST	CPOPJ1			;TAKE GOOD RETURN
	PUSHJ	P,.TICAN##		;IS IT ALPHANUMERIC
	 CAIN	CC,"."			;NO, IS IT DOT?
	AOS	0(P)			;YES,TAKE GOOD RETURN
	POPJ	P,			;RETURN IN EITHER CASE
CHECK:	SKIPN	T1,OUTBEG		;IS THERE  AN OUTPUT SPEC?
	$KILL(MCE,Command error)
	SKIPN	T2,INBEG		;POINT TO INPUT AREA
	 JRST E$$MCE
	SKIPE	.FXNAM(T1)		;IS THERE A FILENAME?
	JRST	CHECK1			;YES--GOOD
	SKIPN	T3,.FXNAM(T2)		;[065] IF THERE'S A MASTER
	$KILL(NEA,Not enough arguments specified)
	MOVE	T4,.FXDEV(T1)		;[065] GET OUTPUT DEVICE
	DEVCHR	T4,			;[065]
	TXNE	T4,DV.TTY		;[065] IS IT  TTY: ?
	JRST	CHECK0		;[065] YES, SO USE INPUT FILNAM FOR OUTPUT
	CAMN	T3,[120000,,0]		;[065] ELSE CHECK FOR "*"
	$KILL(ANA,Asterisk not allowed as output file spec)
CHECK0:	MOVEM	T3,.FXNAM(T1)		;[065] USE NAME OF MASTER INSTEAD
	SETOM	T3,.FXNMM(T1)		;MASK IT 'CAUSE NOT WILD
CHECK1:	SKIPE	T3,.FXEXT(T1)		;IS THERE AN EXT SPECIFIED?
	JRST	CHECK2			;EXT ALREADY THERE GO ON
	MOVE	C,.FXMOD(T1)		;CHECK MODIFIER WORD TO SEE
	TXNN	C,FX.NUL		; IF EXPLICITLY NULL EXT
	JRST 	CHK1A
	MOVE	T4,SWIWRD		;GET THE SWITCHES
	TXNE	T4,SW.LST!SW.POI!SW.TRC!SW.LOA	;SOME SORT OF LISTING SPECIFIED?
	JRST	CHK1B		;IF YES LST IS DEFAULT
	HRLOI	T3,'REL'		;IF NONE--REL IS DEFAULT
CHK1A:	MOVEM	T3,.FXEXT(T1)		;SO FILL IT IN
	JRST	CHECK2
CHK1B:	 HRLOI	T3,'LST'
	MOVEM T3,.FXEXT(T1)
CHECK2:	SKIPE	T3,.FXLEN(T1)		;ANY SWITCH SEEN?
	$KILL(SIO,Switches are illegal on output)
	SKIPN	T3,.FXNAM(T2)		;MASTER FILENAME THERE?
	   JRST E$$NEA			;NOT ENOUGH ARGUMENTS
	SKIPE	T3,.FXEXT(T2)		;NO EXT SPECIFIED?
	JRST	CHECK4			;EXT ALREADY THERE
	MOVE	C,.FXMOD(T2)		;CHECK MODIFIER WORD TO SEE
	TXNE	C,FX.NUL		;IF NULL EXT SPECIFIED
	HRLOI	T3,'REL'		;IF NONE .REL IS DEFAULT
	MOVEM	T3,.FXEXT(T2)		;SO FILL IN DEFAULT
CHECK4:	MOVE	T3,.FXLEN(T2)		;ANY SWITCH THERE?
	JUMPE	T3,CHECK6		;NO SWITCH,SEE IF THAT'S OK
	TXNE	T3,SW.INS+SW.REP+SW.FIX	;INSERT OR REPLACE OR FIX?
	$KILL(ISM,</INSERT,/REPLACE and /FIX are illegal switches on MASTER>)
	TXNN	T3,SW.MAS		;WAS THIS /MASTER?
	JRST	CHK4A			;NO,CONTINUE
	CAMN	T2,INEND		;YES,MUST HAVE A TRANSACTION FILE
	JRST	E$$NEA			;DONT, SO COMPLAIN
CHK4A:	TXNN	T3,SW.APP		;APPEND SPECIFIED?
	JRST	CHECKE			;NO-DON'T WORRY ABOUT IT
	CAIE	 T3,400000		;IF NO COUNT WE'RE O.K.
	$WARN(EMA,Entire MASTER file will be appended)
	JRST	CHECKE			;AND CONTINUE
CHECK5:	MOVE	T3,.FXLEN(T2)		;POINT TO SWITCHES
	JUMPE	T3,CHECK6		;NONE THERE
	TXNE	T3,SW.MAS		;MASTER?
	$KILL(MTF,/MASTER switch cannot be used on TRANSACTION file)
	TXNE	T3,SW.FIX		;IS PATCHING WANTED?
	TXO	F,FIXMOD		;YES- MARK FIX MODE
	SKIPE	T3,.FXEXT(T2)		;IS AN EXT SPECIFIED?
	JRST	CHECKE			;EXT ALREADY THERE
	MOVE	C,.FXMOD(T2)		;SEE IF NULL EXT
	TXNE	C,FX.NUL		;ALREADY SPECIFIED
	JRST	[HRLOI	T3,'REL'	;USE "REL" FOR DEFAULT
		 TXNE	F,FIXMOD	;OR "FIX" IF WE ARE READING
		 HRLOI	T3,'FIX'	;A PATCH FILE
		 JRST	.+1]
	MOVEM	T3,.FXEXT(T2)		;SO FILL IT IN
	JRST	CHECKE			;AND FINISH UP
CHECK6:	CAME	T2,INBEG		;IS THIS THE MASTER FILE?
	$KILL(CSR,Command switch is required)
	CAME	T2,INEND		;SEE IF ANY TRANS FILES
	JRST	CHECKE			;YES THEN CONTINUE
	MOVE	T1,SWIWRD		;GET SWITCHES
	JUMPE	T1,E$$CSR		;ERROR IF NONE
	JRST	CHECKE			;CONTINUE IF NO ERROR

CHECKE:	ADDI	T2,FSSIZE	;INCREMENT THE POINTER
	CAMG	T2,INEND	;RUN OUT OF ROOM OR TRANS FILES YET?
	JRST	CHECK5		;MORE TRANS	FILES
	POPJ	P,
SUBTTL COMMAND SWITCH PROCESSOR

SWTPRC:	MOVE	T2,SWIWRD		;GET SWITCH BITS
	TXNE	T2,SW.LST!SW.POI!SW.TRC!SW.LOA	;WANT LISTING?
	JRST	OLIST			;YES,GO DO IT
	TXNN	T2,SW.IND		;WANT INDEXING?
	JRST	NOLCHK			;NO--OTHER THINGS
	MOVE 	T1,INBEG		;GET POINTER TO INPUT SPEC
	SKIPE	.FXLEN(T1)		;ANOTHER SWITCH THERE?
	   JRST	E$$TMS			;INDEX MUST BE ALONE
	CAME	T1,INEND		;[66] IS THERE A TRANSACTION FILE
	$WARN(TFI,TRANSACTION file ignored)	;[66] YES - ISSUE WARNING
	PUSHJ	P,INDOPN		;OPEN I/O STUFF
	PUSHJ	P,INDEX			;DO THE INDEXING
	PUSHJ	P,INDCLS		;FINISHED  SO CLOSE
	JRST	MAKSCN			;AND BEGIN AGAIN

NOLCHK:	TXNN	T2,SW.NOL		;DELETE LOCAL SYMBOLS?
	JRST	SWTDIS			;NO--OTHER THINGS
	MOVE	T1,INBEG		;POINTER TO INPUT SPEC
	SKIPE	.FXLEN(T1)		;NOLOCALS MUST BE ALONE
	   JRST	E$$TMS			;TELL HER TOO MANY SWITCHES
	PUSHJ	P,INDOPN		;OPEN BINARY OUTPUT
	PUSHJ	P,DELCPY		;GO DELETE AND COPY
	JRST	RSTRT			; BEGIN AGAIN
SUBTTL DO OUTPUT LISTINGS FOR /TRACE, /POINTS AND /LIST

OLIST:	MOVE T1,INBEG			;GET POINTER TO INPPUT FILE
	SKIPE	.FXLEN(T1)		;IS THERE FILE-SPECIFIC SWITCH?
	   JRST	E$$TMS			;YES,LEGAL ONLY FOR SWITCHES IN SWIWRD
	TXZ	F,LSTENT		;CLEAR LIST ENTRIES FLAG
	TXNE	T2,SW.POI		;LIST ENTRY POINTS?
	TXO	F,LSTENT		;SET FLAG TO LIST ENTRIES
	MOVE	T1,OUTBEG		;POINT  TO THE OUTPUT SPEC
	MOVE	T1,.FXDEV(T1)		;PUT THE OUTPUT DEVICE IN T1
	DEVCHR	T1,			;DO A DEVCHR
	TXNE	T1,DV.TTY		;IS OUTPUT DEVICE A TTY?
	TXO	F,DEVTTY		;YES,REMEMBER THAT
	PUSHJ	P,OPNLKO		;OPEN OUTPUT FILE
	MOVEI	T1,[ASCIZ "	Listing of "]
	PUSHJ	P,.TSTRG##		;GIVE SOME IDENTIFICATION
	MOVE	T2,SWIWRD		;GET SWITCHES
	TXNE	T2,SW.POI!SW.LST	;IF POINT OR LIST
	JRST	[  MOVEI T1,[ASCIZ "Modules"]
		  TXNE  T2,SW.POI	;IF BOTH,SAY SO
		  MOVEI T1,[ASCIZ "Modules and Entry points"]
		  JRST  OLIST0]
	TXNE	T2,SW.LOA		;IS IT A /LOAD LISTING?
	SKIPA	T1,[[ASCIZ "Internal loading instructions"]]
	MOVEI	T1,[ASCIZ "TRACE blocks"] ;NO, SO ASSUME /TRACE
OLIST0:	PUSHJ	P,.TSTRG##		;OUTPUT WHAT WE HAVE
	PUSHJ	P,.TCRLF##		;END LINE
	MOVEI	T1,[ASCIZ "Produced by MAKLIB Version "]
	PUSHJ	P,.TSTRG##		;
	MOVE	T1,.JBVER##		;GIVE VERSION NUMBER
	PUSHJ	P,.TVERW##		;FOR LISTING
	MOVEI	T1,[ASCIZ " on "]	;DATE TOO
	PUSHJ	P,.TSTRG##		;
	PUSHJ	P,.TDATN##		;OUTPUT DATE AND
	MOVEI	T1,[ASCIZ " at "]	;TIME TOO
	PUSHJ	P,.TSTRG##
	PUSHJ	P,.TTIMN##		;
	PUSHJ	P,.TCRLF##		;END WITH CRLF
OLIST1:	PUSHJ	P,LIOCLS		;OPEN NEXT MASTER FILE
	  JRST  MAKSCN			;ALL DONE
	MOVEI	T1,[ASCIZ "
	**************************

"]
	PUSHJ	P,.TSTRG##		;SEPARATE FILES
	MOVEI	T1,OPNBLK		;SET UP T1/ADDR OF OPEN BLOCK
	MOVEI	T2,LKPBLK		; "   " T2/ADDR OF LOOKUP BLOCK
	PUSHJ	P,.TOLEB##		;TYPE THE DATA THERE
	MOVEI	T1,[ASCIZ " Created on "]
	PUSHJ	P,.TSTRG##
	LDB	T2,[POINT 3,.RBEXT+LKPBLK,20] ;GET HI-ORDER CREATION DATE
	LDB	T1,[POINT 12,.RBPRV+LKPBLK,35] ;AND LOW ORDER PART
	DPB	T2,[POINT 3,T1,23] 	;MERGE THE TWO PARTS
	PUSHJ	P,.TDATE##		;AND PRINT IT
	MOVEI	T1,[ASCIZ " at "]
	PUSHJ	P,.TSTRG##		;ALSO GIVE THE TIME
;**; [104] INSERT @ OLIST + 17L	MS	28-SEPT-80
	LDB	T1,[POINT 11,.RBPRV+LKPBLK,23] ;[104]FROM THE LOOKUP BLOCK
	IMULX	T1,<^D60*^D1000>	;CONVERT TO MS FROM MINUTES
	PUSHJ	P,.TTIME##		;
	PUSHJ	P,.TCRLF##		;END WITH CRLF
	PUSHJ	P,.TCRLF##		
	MOVE	T2,SWIWRD		;FETCH SWITCH WORD
	TXNE	T2,SW.TRC		;WANT TRACE?
	JRST	OLIST2			;YES,GO DO IT
	TXNE	T2,SW.LOA		;WANT LOAD FILES?
	JRST	OLIST3			;YES,GO DO THAT
	PUSHJ	P,LIST			;CALL LISTING ROUTINE
	JRST	OLIST1			;GO BACK FOR NEXT FILE

OLIST2:	PUSHJ	P,TRACE			;DO THE TRACE
	JRST	OLIST1			;AND GO BACK FOR NEXT FILE
OLIST3:	PUSHJ	P,TLOAD			;TYPE OUT ANY REQ??? BLOCKS
	JRST	OLIST1			;THEN BACK FOR NEXT FILE OR END
SUBTTL FILE MANIPULATION ROUTINES FOR LISTING ROUTINES

OPNLKO:	MOVX	T1,.IOASC		;ASCII OUTPUT FOR LISTING
	DPB	T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
	MOVSI	T1,OBUF			;CALCULATE BUFFER HEADER PTR
	MOVEM	T1,OPNBLK+.OPBUF	; FOR OPEN BLOCK
	OPEN	OCHN,OPNBLK		;OPEN OUTPUT FOR LISTING
	  JRST	OPNFAI			;CANT DO IT
	ENTER	OCHN,LKPBLK		;NOW ENTER THE OUTPUT
	 JRST	LKPFAI			;FAILURE
;**; [73] INSERT AT OPNLKO + 7 1/2	CLRH	1-AUG-79
	MOVE	T1,[XWD	OPNBLK,BCKBLK]	;[73] SET UP AND
	BLT	T1,BCKBLK+<.RBSIZ+2+3>-1	;[73] ... SAVE OUTPUT FILESPEC.
	OUTBUF	OCHN,			;OPEN OUTPUT BUFFERS
	MOVE	T1,.JBFF##		;REMEMBER WHERE OUTPUT BUFFER ENDS
	MOVEM	T1,LSTFF		;FOR MULTIPLE INPUT FILES
	POPJ	P,			;THEN RETURN



 ; LIOCLS IS CALLED AFTER EACH INPUT FILE IS PROCESSED (EOF SEEN)
; IT SKIPS AFTER NEXT FILE IS OPENED , OR NON-SKIPS IF ITS THE END,
; AFTER FINISHING UP BY CLOSING FILES.

LIOCLS:	CLOSE	MIN,			;CLOSE MASTER FILE
	MOVE	T1,LSTFF		;RECLAIM MASTER BUFFER SPACE
	MOVEM	T1,.JBFF##		;BY RESTORING FIRST-FREE
	MOVE	T1,[4,,[INBEG,,INEND	;POINTERS TO INPUT AREA
			OPNBLK,,LKPBLK	;OPEN & LOOKUP BLOCKS
			FSSIZE,,.RBSIZ+1;SIZE OF INSPEC&LKPBLK
			WLDTMP+1B0]]	;ALL FOR LKWLD
	PUSHJ	P,.LKWLD##		;WILD LOOKS FOR MASTER FILE
	   JRST  LSTEND			;END OF LISTINGS
	MOVX	T1,.IOBIN		;BINARY FOR MASTER INPUT
	DPB	T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
	MOVEI	T1,MBUF			;MASTER FILE BUFFER
	MOVEM	T1,OPNBLK+.OPBUF
	OPEN	MIN,OPNBLK		;MASTER INPUT ON CHANNEL MIN
	   JRST	OPNFAI			;CAN'T DO IT
	LOOKUP	MIN,LKPBLK		;DO THE LOOKUP
	   JRST	LKPFAI			;CAN'T
	INBUF	MIN,			;SET UP THE BUFFER
	PUSHJ	P,.CHKTM##		;[70] CHECK /SINCE,/BEFORE,ETC.
	  JRST	LIOCLS			;[70] DOESN'T MEET SPECIFIED CONDITIONS
	JRST	CPOPJ1			;TAKE SKIP RETURN

LSTEND:	CLOSE	OCHN,			;DONE WITH THIS CHANNEL
	STATZ	OCHN,760000		;CHECK FOR ERROR
	  JRST	FSOERR			;ERROR
	POPJ	P,			;NEXT COMMAND
SUBTTL FILE MANIPULATION ROUTINES FOR INDEXING AND DELETING LOCAL SYMBOLS


INDOPN:	MOVX	T1,.IOBIN		; FOR TRANSACTION OUTPUT TOO
	DPB	T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
	MOVSI	T1,OBUF			;OUTPUT BUFFER HEADER
	MOVEM	T1,OPNBLK+.OPBUF	;PUT POINTER IN THE OPEN BLOCK
	OPEN	OCHN,OPNBLK		;BINARY OUTPUT ON CH. OCHN
	   JRST OPNFAI
  			;CAN'T OPEN
	ENTER	OCHN,LKPBLK		;ENTER THE FILE
	   JRST   LKPFAI 			;CAN'T
;**; [73] INSERT BEFORE INDOP2	CLRH	1-AUG-79
	MOVE	T1,[XWD	OPNBLK,BCKBLK]	;[73] SET UP AND
	BLT	T1,BCKBLK+<.RBSIZ+2+3>-1	;[73] ... SAVE OUTPUT FILESPEC.
INDOP2:	MOVE	T1,[4,,[INBEG,,INEND	;[70] INFO FOR WILD
			OPNBLK,,LKPBLK
			FSSIZE,,.RBSIZ+1
			WLDTMP+1B0]]
	PUSHJ	P,.LKWLD##		;WILD
	  POPJ	P,			;THE END
	SETZM	NAMCTR			;CLEAR PROGRAM NAME COUNTER
	MOVX	T1,.IOBIN
	DPB	T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
	MOVEI	T1,MBUF			;HEADER FOR MASTER FILE
	MOVEM	T1,OPNBLK+.OPBUF	;AND PUT IT IN THE OPEN BLOCK
	OPEN	MIN,OPNBLK		;OPEN
	      JRST	OPNFAI		;CAN'T
	LOOKUP	MIN,LKPBLK		;LOOKUP
	      JRST	LKPFAI		;CAN'T
	INBUF	MIN,
	PUSHJ	P,.CHKTM##		;[70] CHECK /SINCE,/BEFORE,ETC
	  JRST	INDOP2			;[70] DOESN'T MEET CONDITIONS
	POPJ	P,



INDCLS:	CLOSE	OCHN,			;DO LAST BLOCK
	STATZ	OCHN,760000		;CHECK FOR ERROR
	  JRST	FSOERR			;ERROR
	CLOSE	MIN,			;DONE WITH INPUT TOO
	STATZ	MIN,760000		;CHECK FOR ERROR
	  JRST	FSMERR
	JRST	 MAKSCN

TRNCLS:	CLOSE	TRIN,
	STATZ	TRIN,760000
	  JRST	FSTERR			;FILE STATUS ERROR FOR TRANSACTION
	POPJ	P,
SUBTTL DISPATCH FOR SWITCHES USING TRANSACTION FILES

SWTDIS:	MOVE	T1,OUTBEG		;GET OUTPUT SPEC
	MOVE	T1,.FXDEV(T1)		;WHAT DEVICE?
	DEVCHR	T1,			;MAKE SURE ITS LEGAL
	TXNN	T1,<DV.DSK!DV.DTA>	;MAKE SURE DISK OR DECTAPE
	$KILL(ODD,Output device must be DISK or DECTAPE)
	MOVX	T1,.IOBIN		;BINARY OUTPUT
	DPB	T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
	MOVSI	T1,OBUF			;BUFFER HEADER LOCATION
	MOVEM	T1,OPNBLK+.OPBUF	;AND PUT IT IN THE OPEN BLOCK
	MOVE	T2,[XWD OPNBLK,BCKBLK]
	BLT	T2,BCKBLK+<.RBSIZ+2+3>-1 ;SAVE OUTPUT SPECS
	SETZM	JBFSAV			;[67] TO HOLD .JBFF
	MOVE	T1,.JBFF##		;SAVE JOBFF FOR LATER THINGS
	MOVEM	T1,BCKFF		;SAVE FOR BACKING UP.
	OPEN	OCHN,OPNBLK
	   JRST	OPNFAI
	ENTER	OCHN,LKPBLK
	   JRST   LKPFAI
	OUTBUF	OCHN,
SWTDI2:	MOVE	T1,INBEG		;[70] GET INPUT
	MOVE	T1,.FXDEV(T1)		;GET MASTER DEVICE
	DEVCHR	T1,
	TXNN	T1,1B<^D35-.IOBIN>	;SEE IF BINARY AND DIRECT
	$KILL(MCB,MASTER device must be capable of binary IO)
	MOVE	T1,[4,,[INBEG,,INEND
			OPNBLK,,LKPBLK
			FSSIZE,,.RBSIZ+1
			WLDTMP+1B0]]
	PUSHJ	P,.LKWLD##
	  $STPCD(Master file spec was missing)
	MOVE	T1,WLDTMP		;[70] PICK UP SPEC WE ARE LOOKING AT
	CAME	T1,INBEG		;[70] IS IT THE MASTER FILE?
	  $KILL (MFR, MASTER file rejected by conditions)	;[70] NO!
	SETZM	NAMCTR			;CLEAR PROG NAME COUNTER
	MOVX	T1,.IOBIN
	DPB	T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
	MOVEI	T1,MBUF			;GET BUFFER HEADER
	MOVEM	T1,OPNBLK+.OPBUF	;  FOR THE OPEN BLOCK
	OPEN	MIN,OPNBLK
	   JRST	OPNFAI
	LOOKUP	MIN,LKPBLK
	    JRST	LKPFAI
	INBUF	MIN,
	PUSHJ	P,.CHKTM##		;[70] CHECK /SINCE,/BEFORE,ETC
	  JRST SWTDI2			;[70] DOESN'T MEET CONDITIONS
	MOVE	T1,WLDTMP		;SEE IF ANY TRANSACTION FILES
	CAMN	T1,INEND		;WERE SPECIFIED
	JRST	SWT2			;NO,SO DONT OPEN ANY
SWT1:	MOVE	T1,[4,,[INBEG,,INEND
			OPNBLK,,LKPBLK
			FSSIZE,,.RBSIZ+1
			WLDTMP+1B0]]
	PUSHJ	P,.LKWLD##
	  JRST	SWTEXT			;[70] SEE IF ANY MET CONDITIONS
	SETZM	TNMCTR			;CLEAR TRANS PROG NAME COUNTER
	MOVX	T1,.IOBIN
	TXNE	F,FIXMOD		;IN PATCH MODE?
	MOVX	T1,.IOASC		;YES,SO WE WANT ASCII MODE
	DPB	T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
	MOVEI	T1,TBUF			;GET BUFFEER HEADER POINTER
	MOVEM	T1,OPNBLK+.OPBUF	;  FOR THE OPEN BLOCK
	OPEN	TRIN,OPNBLK
	   JRST	OPNFAI
	LOOKUP	TRIN,LKPBLK
;**; [72] CHANGE AT SWT1 + 15	CLRH	27-JUL-79
	 JRST	SWTLKE			;[72] TRY TO RECOVER FROM MISSING FILE
	MOVE	T1,.JBFF##		;[67] SAVE .JBFF
	MOVEM	T1,JBFSAV		;[67] SO BUFFERS DONT EXPAND FOREVER
	INBUF	TRIN,
	PUSHJ	P,.CHKTM##		;[70] CHECK /SINCE,/BEFORE,ETC
	  JRST	SWT1			;[70] DIDN'T MEET CONDITIONS
SWT2:	TXO	F,XACTF			;[70] XACTION FILE MET CONDIT!
	MOVE	T3,WLDTMP
	HRLZ	T1,.FXLEN(T3)
	JFFO	T1,.+2
	JRST	E$$CSR			;ERROR IF NO SWITCH
	CAILE	T2,SWTBLL		;WITHIN RANGE OF TABLE?
	$STPCD(Dispatch index out of range)
	PUSHJ	P,@SWTBL(T2)		;PROCESS THE SWITCH
	JRST	SWT3			;[67] REMEMBER .JBFF
	$STPCD(A COMMAND processor took the skip return)
SWT3:	SKIPE	T1,JBFSAV		;[67] DID WE DO INBUF ?
	MOVEM	T1,.JBFF##		;[67] YES - RESTORE  .JBFF
	JRST	SWT1			;[67] NO - CONTINUE

SWTEXT:	TXZN	F,XACTF			;[70] ANY XACT FILES MET CONDIT?
	$WARN (TFR, all TRANSACTION files rejected by conditions)	;[70] NO.
	JRST	INDCLS			;[70] CLOSE UP SHOP

;**; [72] INSERT BEFORE SWTBL	CLRH	27-JUL-79
SWTLKE:	MOVEI	T1,LKPBLK		;[72] GET INFORMATION
	MOVEI	T2,6			;[72] TO PUT OUT ERROR MESSAGE
;**; [76] CHANGE @ SWTLKE + 2L	MFB	30-JUL-80
	MOVE	T3,INEND		;[76][72]
	TXO	F,FOTTY			;[72] FORCE ERROR MESSAGE TO TTY
	PUSHJ	P,E.LKEN##		;[72] ROUTINE TO OUTPUT MESSAGE
	TXZ	F,FOTTY			;[72] DON'T DO REGULAR OUTPUT TO TTY
	JRST	SWT1			;[72] AND CONTINUE

SWTBL:	APPEND
	DELETE
	EXTRCT
	INSERT
	CPOPJ				;IN CASE /MASTER
	REPLCE
	FIXX

	SWTBLL==.-SWTBL-1
SUBTTL	MAKLIB COMMAND PROCESSORS

SUBTTL  LIST & POINTS PROCESSOR

;LIST PROCESSOR
;THIS ROUTINE PROCESSES THE L COMMAND IN MAKLIB. BINARY
;PROGRAMS ARE READ, AND THEIR NAMES OUTPUT, UNTIL AN END
;OF FILE IS REACHED.


LIST:	MOVE	A,INBEG		;POINT TO INPUT AREA
	MOVE	T,.FXNAM(A)	;GET MASTER FILE NAME
	SETOM	END2		;SIGNAL FIRST TIME THROUGH
	PUSHJ	P, MSTGET	;GET THE MASTER DEVICE
	JRST	E$$NEA		;NOT ENOUGH ARGUMENTS
	TXO	F,NOWARN	;DON'T GIVE WARNING MESSAGE IF INDEX SEEN
LIST2:	PUSHJ	P, READ		;READ A PROGRAM NAME
	JRST	[TXNN	F,LSTENT	;LISTED ENTRIES?
		PUSHJ	P,LIST5	;NO, SO LIST RELOCATION
		POPJ   P,0  ]   ;FINISHED
	TXNE	F,LSTENT	;LIST ENTRIES
	JRST	LIST4		;YES, SO NO SIZE
	SKIPL	END2		;BUT NOT FIRST TIME (NOT SET UP YET)
	PUSHJ	P,LIST5		;LIST RELOCATION WORDS
LIST4:	MOVE	T1, A		;GET THE PROGRAM NAME IN B
	PUSHJ	P, PTYPO	;TYPE IT OUT
	TXNE	F,LSTENT	;ENTRY BLOCK AS WELL?
	JRST	LISTE		;YES
	JRST	LIST2		;RETURN FOR MORE PROGRAM NAMES

LISTE:	HRRZ	C,ENTBLK	;GET NUMBER OF ENTRIES
	JUMPE	C,LIST3		;NONE IN THIS PROGRAM
	MOVNS	C		;NEGATE
	MOVSS	C		;PUT IN LEFT HALF
	HRRI	C,ENTBLK+2	;START OF ENTRIES
	MOVEI	D,TABS1		;ASSUME NOT TTY
	TXNE	F,DEVTTY	;WAS IT?
	MOVEI	D,TABS2		;TTY HAS SHORTER LINE
	MOVEM	D,TABCNT	;STASH IT
LISTE1:	SKIPN	T1,(C)		;GET AN ENTRY
	AOJA	C,.-1		;IGNORE RELOCATION WORD
	PUSHJ	P,TYPTAB	;OUTPUT A TAB
	PUSHJ	P,PTYPO		;FOLLOWED BY SYMBOL
	AOBJN	C,LISTE1	;FOR ALL OF BLOCK
LIST3:	PUSHJ	P, CRLF		;TYPE A CRLF
	JRST	LIST2		;RETURN FOR MORE PROGRAM NAMES

LIST5:	PUSH	P,A		;SAVE NAME
	MOVE	B,END1		;GET FIRST END WORD
	TRNE	B,-1		;KLUDGE FOR FORTRAN
	JRST	LISTF		;YES, IT WAS
	PUSHJ	P,TYPTB1	;ALWAYS LEAD WITH TAB
	HLRZ	T1,B		;OUTPUT OCTAL HALF WORD
	PUSHJ	P,OUTHW		;
	SKIPN	B,END2		;IF SECOND WORD ZERO,
	JRST	LISTF		;DONT BOTHER TO LIST IT
	PUSHJ P,TYPTB1		;PRINT SECOND WORD
	HLRZ  T1,B
	PUSHJ P,OUTHW
LISTF:	PUSHJ	P,CRLF		;TYPE CRLF AND RETURN
	POP	P,A		;RESTORE NAME
	TXZ	F,LSTENT	;CLEAR ENTRY POINT FLAG
	POPJ	P,
SUBTTL TRACE PROCESSOR

; /TRACE/ - THE COMMAND PROCESSOR TO TRACE THE PATCH BLOCKS
;
; THIS ROUTINE  TRACES ALL EDIT/PATCH BLOCKS IN THE MASTER FILE.
;

TRACE:	PUSHJ	P,MSTGET		;SET UP INPUT IO CHANNEL
	  JRST	E$$NEA			;IF ERROR RETURN
	SETZM	CURMOD			;START WITH NO KNOWN MODULE

TRC1:	PUSHJ	P,GETIN			;GET FIRST WORD
	HLRZ	B,A			;OF BLOCK AND EXAMINE HEADER
	CAIN	B,LI$TRC		;TRACE BLOCK?
	JRST	TRC5			;YES,PROCESS IT
	CAIN	B,6			;IS THIS THE PROGRAM NAME BLOCK?
	JRST	TRC3			;YES, GO HANDLE IT
	CAIE	B,400			;HANDLE F40 FUNNY TYPE
	CAIN	B,401			;BLOCKS BY
	JRST	TRC3A			;CALLING SPECIAL ROUTINE
	CAILE	B,3777			;NOT ASCIZ TEXT IS IT?
	JRST	TRC4			;YES,DAMMIT
	PUSHJ	P,COUNT			;NO, SO COUNT WORDS IN BLOCK
TRC2:	JUMPE	B,TRC1			;IF ZERO COUNT,IGNORE
	PUSHJ	P,GETIN			;DISCARD WORDS
	SOJG	B,.-1			;TO CLEAR BLOCK
	JRST	TRC1			;GET NEXT BLOCK

TRC3:	PUSHJ	P,COUNT			;COUNT SIZE OF NAME BLOCK
	PUSHJ	P,GETIN			;GET RELOC WORD
	PUSHJ	P,GETIN			;GET PROGRAM NAME
	MOVEM	A,CURMOD		;STORE PROGRAM NAME
	SUBI	B,2			;ACCOUNT FOR TWO LOST WORDS
	JRST	TRC2			;AND EAT ANY REMAINING PART OF BLOCK

TRC3A:	TXO	F,F4IB			;DON'T OUTPUT THE READ IN WORDS
	PUSHJ	P,F4			;BECAUSE REL FILE IS READ ONLY
	JRST	TRC1			;ON RETURN, GET NEXT HEADER

TRC4:	ANDI	A,177			;DISCARD ALL BUT LAST BYTE
	JUMPE	A,TRC1			;IF NULL BYTE, ITS OVER
	PUSHJ	P,GETIN			;GET A WORD
	JRST	TRC4			;AND TRY AGAIN

TRC5:	HRRZ	D,A			;GET COUNT IN SAFER PLACE
	PUSHJ	P,.TCRLF##
	MOVEI	T1,[ASCIZ "Module: "]
	PUSHJ	P,.TSTRG##		;MODULE NAME
	MOVE	T1,CURMOD		;IS IN RAD50
	PUSHJ	P,PTYPO		;
	SOJL	D,E$$TBF		;ERROR IF NO WORDS LEFT
	PUSHJ	P,GETIN			;GET WORD 1
	MOVEI	T1,[ASCIZ "  Edit: "]
	PUSHJ	P,.TSTRG##
	MOVE	T1,A			;GET EDIT NAME
	PUSHJ	P,.TSIXN##		;OUTPUT IN SIXBIT
	MOVEI	T1,[ASCIZ "
  Status is "]
	PUSHJ	P,.TSTRG##
	SOJL	D,E$$TBF
	PUSHJ	P,GETIN			;GET WORD 2
	MOVEI	T1,[ASCIZ "Active"]
	TLNN	A,400000		;SEE IF LH IS -1
	MOVEI	T1,[ASCIZ "Inactive"]
	PUSHJ	P,.TSTRG##
	TRNN	A,-1			;IF RH IS BLANK,NO /WHO WAS USED
	JRST	TRC5A			;AND SO WE SKIP OUTPUTING IT
	MOVEI	T1,[ASCIZ "
  Last affected by "]
	PUSHJ	P,.TSTRG##
	HRLZ	T1,A			;OUTPUT THE INITIALS
	PUSHJ	P,.TSIXN##		;IN SIXBIT
	
TRC5A:	PUSHJ	P,.TCRLF##		;END CURRENT LINE
	SOJL	D,E$$TBF		;NEG WORD COUNT INDICATES ERROR
	PUSHJ	P,GETIN			;READ WORD 3
	JUMPE	A,TRC5D			;ALL OPTIONAL INFO IN TB$MAK
	MOVEI	T1,[ASCIZ "  Created"]
	PUSHJ	P,.TSTRG##		;CREATION DATA
	TLNN	A,-1			;WERE INITIALS SPECIFIED?
	JRST	TRC5B			;NO,SO SKIP IT
	MOVEI	T1,[ASCIZ " By "]	;
	PUSHJ	P,.TSTRG##		;
	HLLZ	T1,A			;GET LH OF WORD 3,SIXBIT INITIALS
	PUSHJ	P,.TSIXN##
	
TRC5B:	TRNN	A,-1			;DATE SPECIFIED?
	JRST	TRC5C			;NO SO SKIP IT
	MOVEI	T1,[ASCIZ " On "]
	PUSHJ	P,.TSTRG##
	HRRZ	T1,A			;GET 15 BIT DATE
	PUSHJ	P,.TDATE##		;AND PRINT IT
TRC5C:	PUSHJ	P,.TCRLF##		;END LINE
TRC5D:	SOJL	D,E$$TBF		;
	PUSHJ	P,GETIN			;GET  WORD 4
	JUMPE	A,TRC5G			;IF BLANK
	MOVEI	T1,[ASCIZ "  Installed"]
	PUSHJ	P,.TSTRG##
	TLNN	A,-1			;SEE IF INSTALLERS INITIALS THERE
	JRST	TRC5E			;NO, THEY ARE NOT
	MOVEI	T1,[ASCIZ " By "]
	PUSHJ	P,.TSTRG##
	HLLZ	T1,A			;INSTALLERS INITIALS FROM /WHO
	PUSHJ	P,.TSIXN##
TRC5E:	TRNN	A,-1			;SEE IF DATE THERE
	JRST	TRC5F			;NO,GO FINISH LINE
	MOVEI	T1,[ASCIZ " On "]
	PUSHJ	P,.TSTRG##
	HRRZ	T1,A			;GET 15 BIT 'DATE UUO' FORMAT DATE
	PUSHJ	P,.TDATE##		;USE SCAN OUTPUT ROUTINE
	
TRC5F:	PUSHJ	P,.TCRLF##		;END THE LINE
TRC5G:	SOJL	D,E$$TBF		;GET WORD 5 (CURRENTLY UNUSED)
	PUSHJ	P,GETIN			;
	SOJL	D,E$$TBF		;GET WORD 6
	PUSHJ	P,GETIN			;COUNT OF A.E.S AND PCOS
	PUSH	P,A			;SAVE THE COUNT
	TLNN	A,-1			;ARE THERE ANY A.SSOCIATED E.DITS?
	JRST	TRC7			;NO,GO PROCESS PCOS
	HLRZ	C,A			;COUNT OF PCOS
	MOVEI	T1,[ASCIZ "  Associated edits:
"]
	PUSHJ	P,.TSTRG##
	
TRC6:	SUBI	D,AESIZ			;SUBTRACT SIZE OF ASSOCIATED EDIT
	JUMPL	D,E$$TBF		;NOT THERE THOUGH
	PUSHJ	P,TYPTB1		;OUTPT THE TAB
	PUSHJ	P,GETIN			;GET FIRST WORD
	PUSH	P,A			;SAVE IT
	PUSHJ	P,GETIN			;GET SECOND WORD
	MOVEI	T1,[ASCIZ "Requires edit "]
	TLNN	A,(1B0)			;IF 1B0 IS ON,REQUIRED
	MOVEI	T1,[ASCIZ "Precludes edit "]; ELSE ITS PRECLUDED
	PUSHJ	P,.TSTRG##		;
	POP	P,T1			;RESTORE EDIT NAME
	PUSHJ	P,.TSIXN##
	PUSHJ	P,.TCRLF##		;END LINE
	SOJG	C,TRC6			;IF MORE ASSOCIATED EDITS

TRC7:	POP	P,A			;RESTORE THE COUNT
	HRRZ	C,A			;GET COUNT OF PCOS
	JUMPE	C,TRC8			;IF NO CHANGE ORDERS
	MOVEI	T1,[ASCIZ "  Program changes:
"]
	PUSHJ	P,.TSTRG##
	
TRC7A:	SOJL	D,E$$TBF		;IF NO WORDS LEFT
	PUSHJ	P,GETIN			;GET THE WORD
	PUSHJ	P,TYPTB1		;START WITH TAB
	HRRZ	B,A			;GET LENGTH OF PCO GROUP
	HLRZ	T1,A			;GET PCO INDEX
	CAILE	T1,PCOMAX		;UNDER THE MAXIMUM?
	JRST	E$$TBF			;NO.
	JRST	@[ TRC71
		  TRC72
		  TRC73
		  TRC74 ]-1(T1)		;DISPATCH TO RIGHT PROCESS
	
TRC71:					;FOR PCO TYPE 1
	SUBI	D,2			;MUST HAVE TWO WORDS LEFT
	JUMPL	D,E$$TBF
	PUSHJ	P,GETIN			;GET WORD
	MOVEI	T1,[ASCIZ "Inserts "]
	PUSHJ	P,.TSTRG##		;CODE INSERT
	HLRZ	T1,A			;GET NR. OF INSTRUCTIONS INSERTED
	PUSHJ	P,.TDECW##		;OUTPUT IT
	MOVEI	T1,[ASCIZ " instruction(s) at location "]
TRC71A:	PUSHJ	P,.TSTRG##
	HRRZ	T1,A			;GET THE ADDRESS
	PUSHJ	P,OUTHW			;AND OUTPUT IT
	MOVEI	T1,"'"			;FLAG AS RELOCATABLE
	PUSHJ	P,.TCHAR##		;IN CASE THEY LOOK
	PUSHJ	P,GETIN			;EAT THE NEXT WORD
	JRST	TRC7B			;AND THATS IT
	
TRC72:					;FOR PCO TYPE 2
	MOVEI	T1,[ASCIZ "Removes edit "]
TRC72A:	PUSHJ	P,.TSTRG##
	SOJL	D,E$$TBF		;INSURE PROPER COUNT
	PUSHJ	P,GETIN			;GET THE EDIT NAME
	MOVE	T1,A			;FOR OUTPUT
	PUSHJ	P,.TSIXN##		;OUTPUT IT
	JRST	TRC7B			;END OF PCOS 2 AND 3

TRC73:					;FOR PCO TYPE 3
	MOVEI	T1,[ASCIZ "Reinserts edit "]
	JRST	TRC72A			;CONTINUE AS PER PCO 2

TRC74:					;FOR PCO TYPE 4 (ALTER)
	SUBI	D,2			;DATA BASE IS SAME AS FOR 1
	JUMPL	D,E$$TBF		;SO MAKE SAME CHECKS
	PUSHJ	P,GETIN			;GET FIRST WORD
	MOVEI	T1,[ASCIZ "Alters contents of location "]
	JRST	TRC71A			;SAVE SOME STEPS,FINISH AS FOR PCO 1

TRC7B:	PUSHJ	P,.TCRLF##		;END LINE
	SOJG	C,TRC7A			;IF MORE PCOS LEFT

TRC8:	JUMPN	D,E$$TBF		;SHOULD BE NO MORE WORDS LEFT
	JRST	TRC1			;GET NEXT BLOCK

TRC9:	POPJ	P,			;RETURN TO COMMAND LEVEL

$WARN(TBF,TRACE block is badly formatted in module,,$MORE)
	MOVE	T1,CURMOD
	PUSHJ	P,PTYPO			;GIVE MODULE NAME
X$$TBF:	PUSHJ	P,.TCRLF##		;END WITH CR-LF
	TXZ	F,FOTTY			;NO MORE FORCED TO TTY
	JRST	TRC1			;TRY TO CONTINUE
SUBTTL LOAD PROCESSOR FOR LISTING .TEXT ARGS AND .REQUIRE AND .REQUEST BLOCKS

; /TLOAD/ - THE COMMAND PROCESSOR TO TYPE THE .REQ??? BLOCKS IN A REL FILE
;	    ALONG WITH ALL .TEXT STRINGS
;
; THIS ROUTINE GIVES AN INDICATION OF WHAT FILES REQURE WHAT
; ALONG WITH SPECIAL INSTRUCTIONS THAT THE REL FILE GIVES TO LINK

TLOAD:	PUSHJ	P,MSTGET		;SET UP MASTER IO CHANNEL
	  JRST	E$$NEA			;SHOULD BE ABLE TO
	SETZM	CURMOD			;START WITH NO MODULE KNOWN

TLD1:	PUSHJ	P,GETIN			;GET FIRST WORD OF BLOCK
	HLRZ	B,A			;GET TYPE CODE OUT
	CAIN	B,16			;IS BLOCK TYPE FOR REQUIRE?
	JRST	TLD16			;YES,GO DO IT
	CAIN	B,17			;IS BLOCK TYPE FOR REQUEST?
	JRST	TLD17			;YES,GO DO IT
	CAIN	B,6			;IS THIS THE NAME BLOCK?
	JRST	TLD2A			;YES,PROCESS IT
	CAIE	B,400			;MAKE CHECK FOR F40 CODE
	CAIN	B,401			;SINCE IT IS HANDLED DIFFERENTLY
	JRST	TLD2B			;WE JUST GET TO END BLOCK
	CAILE	B,3777			;MAKE CHECK FOR ASCIZ
	JRST	TLD3			;IT IS,GO HANDLE IT
	PUSHJ	P,COUNT			;COUNT REMAINING WORDS
TLD2:	JUMPE	B,TLD1			;IF NONE TO EAT,GET NEXT BLOCK
	PUSHJ	P,GETIN			;GET REST OF BLOCK
	SOJG	B,.-1
	JRST	TLD1			;GET NEXT BLOCK

TLD2A:	PUSHJ	P,COUNT			;COUNT SIZE OF NAME BLOCK
	PUSHJ	P,GETIN			;GET RELOC WORD
	PUSHJ	P,GETIN			;GET PROGRAM NAME
	MOVEM	A,CURMOD		;STORE PROGRAM NAME
	SUBI	B,2			;ADJUST BLOCK COUNT
	JRST	TLD2			;AND FINISH BLOCK OFF

TLD2B:	TXO	F,F4IB			;IGNORE THE F40 INPUT
	PUSHJ	P,F4			;EAT THE F40 CODE
	JRST	TLD1			;AND THEN GET NEXT BLOCK

TLD3:	SKIPE	CURMOD			;IF NO MODULE HEADER LINE GIVEN YET,
	PUSHJ	P,TLDTMH		;GIVE IT NOW
	MOVEI	T1,[ASCIZ "  Text string: "] ;TELL TYPE OF INSTRUCTION
	PUSHJ	P,.TSTRG##		;ASCIZ TEXT
TLD3A:	MOVEI	T1,A			;POINT TO ASCIZ WORD
	SETZ	B,			;CLEAR WORD AFTER TO MAKE IT ASCIZ
	PUSHJ	P,.TSTRG##		;OUTPUT THE WORD
	ANDI	A,177			;GET DOWN TO LAST BYTE ONLY
	JUMPE	A,[ PUSHJ P,.TCRLF##	;IF OVER WITH .TEXT, BIND OF W/CRLF
		    JRST TLD1 ]		;AND GET NEXT BLOCK
	PUSHJ	P,GETIN			;ELSE GET NEXT WORD OF STRING
	JRST	TLD3A			;AND REPEAT TYPE-OUT LOOP

TLD16:	SKIPA	C,[[ASCIZ "  Requires "]]; FOR REQUEST LOAD (REQUIRE)
TLD17:	MOVEI	C,[ASCIZ "  Requests "] ; FOR REQUIRED LIBRARY (REQUEST) FILES
	SKIPE	CURMOD			;TYPED OUT MODULE HEADER ALREADY?
	PUSHJ	P,TLDTMH		;NO,TYPE IT OUT
	PUSHJ	P,COUNT			;COUNT WORDS IN BLOCK
	PUSHJ	P,GETIN			;EAT RELOCATION WORD
	SUBI	B,1			;BACK OFF ONE FOR RELOCATION
TLD4:	JUMPLE	B,TLD1			;GET THE NEXT BLOCK WHEN DONE
	CAIGE	B,3			;MUST HAVE TRIPLET FOR REQ??? BLOCK
	JRST	E$$RBF
	MOVE	T1,C			;GET APPROPRIATE MESSAGE
	PUSHJ	P,.TSTRG##		;AND PRINT IT
	PUSHJ	P,GETIN			;GET FIRST WORD (FILENAME)
	PUSH	P,A			;STASH FOR NOW
	PUSHJ	P,GETIN			;GET 2ND WORD (UFD NAME)
	EXCH	A,0(P)			;MAKE REVERSE ORDER
	PUSH	P,A			;STASH FOR NOW
	PUSHJ	P,GETIN			;GET SIXBIT DEVICE NAME
	JUMPE	A,TLD5			;IF NULL,DONT PRINT IT
	MOVE	T1,A			;GET IN PROPER PLACE
	PUSHJ	P,.TSIXN##		;OUTPUT DEVICE NAME
	MOVEI	T1,":"			;STANDARD SEQUENCE
	PUSHJ	P,.TCHAR##		;OUTPUT IT AS "DEV:"
TLD5:	POP	P,T1			;GET FILE NAME
	PUSHJ	P,.TSIXN##		;PRINT IT OUT
	POP	P,T1			;GET UFD NAME
	JUMPE	T1,TLD6			;IF NULL, DONT PRINT UFD
	PUSHJ	P,.TPPNW##		;ELSE PRINT IT OUT VIA SCAN
TLD6:	PUSHJ	P,.TCRLF##		;AND END LINE
	SUBI	B,3			;USED THREE WORDS FROM INPUT FILE
	JRST	TLD4			;SEE IF MORE IN SAME BLOCK

TLDTMH:	PUSHJ	P,.TCRLF##		;NEW MODULE ON NEW LINE
	MOVEI	T1,[ASCIZ "Module: "]
	PUSHJ	P,.TSTRG##		;
	SETZ	T1,			;START WITH ZERO FOR DEPOSIT
	EXCH	T1,CURMOD		;SO WE ONLY DO THIS ONCE
	PUSHJ	P,PTYPO			;OUTPUT RADIX50 MODULE NAME
	PJRST	.TCRLF##		;RETURN WITH NEW LINE SET UP

	$KILL(RBF,REQUEST or REQUIRE block is badly formatted)
SUBTTL REPLACE PROCESSOR

;THIS ROUTINE PROCESSES THE R COMMAND IN MAKLIB. THE TOTAL
;COMMAND STRING IS BROKEN INTO A LIST OF PROGRAMS FOR THE MASTER
;DEVICE, AND A LIST OF PROGRAMS FOR THE TRANSACTION DEVICES.
;THE ROUTINE READS THE MASTER FILE UNTIL ONE OF THE DESIRED
;REPLACEMENT PROGRAMS IS REACHED, THEN SWITCHES TO THE 
;TRANSACTION DEVICE TO FIND THE PROGRAM WHICH IS TO REPLACE THE
;PROGRAM IN THE MASTER FILE. AFTER THE REPLACEMENT HAS BEEN
;EFFECTED, RESET IS CALLED TO RESTORE THE MASTER DEVICE TO ITS
;OLD POSITION.

REPLCE:	PUSHJ	P, MSTGET	;GET A PROGRAM FROM MASTER DEVICE
	JRST	[PUSHJ P,COPY   ;NO MORE, COPY REST OF MASTER
		 JRST INDCLS]	;
	PUSHJ	P, COPYTO	;COPY UP TO THE PROGRAM NAME
	PUSHJ	P, TRNGET	;GET A PROGRAM FROM TRANSACTION
	  $KILL(NTM,Not enough TRANSACTION modules were specified)
	PUSHJ	P, FINDCP	;FIND THE PROGRAM AND COPY IT
	JRST	REPLCE		;LOOK FOR MORE REPLACEMENTS
SUBTTL INSERT PROCESSOR
;THIS SUBROUTINE PROCESSES THE I COMMAND IN FUDGE. IT READS AND
;WRITES PROGRAMS FROM THE MASTER FILE UNTIL IT FINDS THE
;PROGRAM NAME CURRENTLY POINTED TO, AT WHICH TIME IT STARTS READING
;FROM THE TRANSACTION DEVICE, MAKING AN INSERTION AT THE
;PROPER PLACE.

INSERT:	PUSHJ	P, MSTGET	;GET FIRST PROGRAM FROM MASTER FILE
	  $KILL(IRM,/INSERT requires at least one /MASTER specification)
INSER1:	MOVEM	R,NAMSAV	;COPY NAME TO SAFE PLACE
	PUSHJ	P, COPYTO	;COPY UP TO A PROGRAM NAME
	MOVEM	C, SAVEAC	;SAVE SPECIAL ACCUMULATOR
	MOVE	D, [XWD ENTBLK,SVEBLK]
	BLT	D,SVEBLK-ENTBLK(C) ;[20]MOVE ENTRY BLOCK TO SAVE BLOCK
INSER2:	PUSHJ	P, TRNGET	;GET NEXT TRANSACTION FILE
	  JRST	E$$NTM		;FATAL - NOT ENOUGH TRANSACTION MODS
	PUSHJ	P, FINDCP	;FIND TRANSACTION FILE AND COPY
	PUSHJ	P,MSTGET	;GET NEXT MASTER FILE
	JRST	[PUSHJ P,FIXUP	;COPY OUT THE LAST MASTER PROG
		 PUSHJ P,COPY	;COPY THE REST OF THE FILE
		 JRST INDCLS]	;FINISH UP
	CAMN	R,NAMSAV	;THIS MODULE SAME AS LAST
	JRST	INSER2		;YES,NO NEED TO TOUCH MASTER
	PUSHJ	P,FIXUP		;DIFFERS SO WRITE OUT CURRENT MASTER PRG.
	JRST	INSER1		;AND GET NEXT

FIXUP:	MOVE	C, SAVEAC	;RESTORE SPECIAL AC
	MOVS	D, [XWD ENTBLK,SVEBLK]
	BLT	D, (C)		;RESTORE ENTRY BLOCK
	MOVEI	IOC,MIN		;SET UP CHANNEL AC
	MOVEI	T,MBUF+1	;COUNT
	MOVEM	T,IBUF1		;SET UP
	AOS	T
	MOVEM	T,IBUF2		;DONE
	MOVE	FPT,INBEG	;
	PUSHJ	P, WRITE	;WRITE OUT THE CURRENT FILE
	POPJ	P,		;RETURN TO CALLER
 SUBTTL EXTRACT & DELETE  PROCESSORS

;THIS ROUTINE PROCESSES THE E COMMAND IN FUDGE. RATHER THAN
;ONE MASTER AND SEVERAL TRANSACTION FILES, ALL FILES ARE
;TREATED THE SAME. AFTER A CALL TO EITHER MSTGET OR TRNGET
;PROGRAMS ARE SEARCHED FOR AND WRITTEN ON THE OUTPUT DEVICE.

EXTRCT:	TXO	F,NOWARN	;NO WARNING MESSAGE
	PUSHJ	P, MSTGET	;GET A PROGRAM FROM MASTER DEVICE
	JRST	EPROC1		;ALL DONE WITH MASTER DEVICE
	JUMPN	R,.+3		;ANY PROGRAMS THIS FILE? **VJC
	PUSHJ	P,COPY		;NO, COPY ENTIRE FILE ***VJC
	JRST	EPROC1		; ***VJC
	PUSHJ	P, FINDCP	;FIND THE PROGRAM AND COPY IT
	JRST	EXTRCT		;RETURN FOR MORE MASTER PROGRAMS
EPROC1:	PUSHJ	P, TRNGET	;GET PROGRAM FROM TRANS FILES
	POPJ	P,		;ALL DONE
	JUMPN	R,.+3		;ANY PROGRAMS THIS FILE?  ***VJC
	PUSHJ	P,COPY		;NO, COPY ENTIRE FILE ***VJC
	JRST	EPROC1		; ***VJC
	PUSHJ	P, FINDCP	;FIND THE PROGRAM AND COPY IT
	JRST	EPROC1		;RETURN FOR MORE TRANS FILES

SUBTTL DELETE PROCESSOR
;THIS ROUTINE PROCESSES THE DELETE COMMAND IN MAKLIB.  
; NOTE: ONLY ONE INPUT FILE WILL BE READ, AND THE PROGRAM NAMES ASSOCIATED
;WITH ITS LIST WILL BE DELETED.

DELETE:	MOVEI	T1,INDCLS	; RESET RETURN ADDRESS
	HRRM	T1,(P)		;BECAUSE DELETE IS ONE TIME ONLY
DELET1:	PUSHJ	P,MSTGET	; GET A PROGRAM FROM MASTER FILE
	  JRST	DELET3		; NO MORE SPECIFIED-FINISH OFF MASTER
	PUSHJ	P,RAD50		;CONVERT R TO RADIX 50
DELET2:	PUSHJ	P,READ		; READ A PROGRAM
	  JRST  MNFERR		; EOF - PROGRAM NOT IN FILE
	CAMN	R,A		; IS THIS THE RIGHT PROGRAM
	JRST	DELET1		; YES - DELETE IT AND CONTINUE
	PUSHJ	P,WRITE		; NO - COPY THIS ONE
	JRST	DELET2		; AND CONTINUE LOOKING

DELET3:	PUSHJ	P,COPY		; COPY OUT REST OF MASTER FILE
	POPJ	P,		; AND GO HOME
SUBTTL APPEND PROCESSOR

;THIS ROUTINE HANDLES THE APPEND COMMAND IN MAKLIB.
;IT WILL COPY THE ENTIRE MASTER FILE, THEN START OBTAINING TRANSACTION
;FILES WITH CALLS TO TRNGET, APPENDING ONE OR MORE
;PROGRAMS FROM EACH FILE.

APPEND:	PUSHJ	P,MSTGET	;GET A PROGRAM  FROM MASTER FILE
	 $STPCD(APPEND can't  find MASTER specifications)
				;FATAL SINCE WE JUST WANT TO SET UP
	PUSHJ	P,COPY		;COPY ENTIRE MASTER
APPND1:	PUSHJ	P,TRNGET	;GET A PROGRAM NAME FROM TRANSACTION 
	  POPJ	P,		;NO MORE PROG NAMES IN THIS FILE
	PUSHJ	P,FINDCP	;FIND PROGRAM AND COPY IT
	JUMPE	R,CPOPJ		;ZERO NAME DON'T LOOP
	JRST	APPND1		;LOOP FOR MORE PROGRAMS
SUBTTL INDEX AND DELETE LOCAL SYMBOLS PROCESSOR

;THESE ROUTINES PROCESS THE /INDEX COMMAND AND THE /NOLOCALS COMMAND.
; THEY GIVE COMBINATIONS OF INDEXED FILES WITH AND WITHOUT LOCALS
; AND CAN ALSO JUST DELETE LOCAL SYMBOLS.

INDEX:	MOVE	A,OUTBEG	;GET OUTPUT DEVICE
	MOVE	A,.FXDEV(A)	
	DEVCHR	A,		;GET ITS CHARACTERISTICS
	TXNN	A,DV.DSK!DV.DTA ;ONLY ALLOW DSK AND DTA
	JRST	E$$ODD		;GIVE ERROR MESSAGE
;**[27]   INDEX+6    ILG    12-JUL-76
	TXO	F,NOWARN!XFLG	;[27]NO LOST INDEX WARNING, INDEX NOW
	MOVE	T1,SWIWRD	;[27]FETCH SWITCH WORD
	TXNE	T1,SW.NOL	;[27]/NOLOCALS SPECIFIED?


				;ENTRY POINT FOR /NOLOCALS W/OUT /INDEX

DELCPY:	TXO	F, NOLOCB	;SET FLAG TO DELETE LOCAL SYMBOLS
	PUSHJ	P, MSTGET	;GET A PROGRAM FROM MASTER FILE
	JRST	E$$NEA		;NOT ENOUGH ARGUMENTS
;**[27]   DELCPY+3   ILG   12-JUL-76
	TXNE	F,XFLG		;[27]IF DOING INDEXING
	PUSHJ	P,INDEX0	;SET UP POINTERS FOR INDEXING
	PUSHJ	P, COPY		;COPY ENTIRE FILE
	TXNN	F,XFLG		;INDEX FLAG ON?
	JRST	RSTRT		;ALL DONE
	JRST	INDEX3		;YES DO PASS 2
SUBTTL DUMMY "FIX" PROCESSOR TO HANDLE COMMAND IF NOT ASSEMBLED

IFE FTBPT,<
FIXX:	$KILL(BNI,Binary patching tool not included in MAKLIB)
> ;EFI FTBPT
SUBTTL FIX PROCESSOR	(STARTS LONG 'IFN FTBPT' CONDITIONAL)

IFN FTBPT,<

FIXX:	MOVEM	P,FIXXP			;SAVE P, EOF CAN COME FROM ANYWHERE
	MOVE	FPT,WLDTMP		;GET ADDRESS OF TRANS FILE STUFF
	HLRZ	T1,.FXLEN(FPT)		;ANY ARGS SPECIFIED?
	SKIPE	T1			;IF 0, ITS OK
	$WARN(AFI,Arguments to /FIX switch are ignored)
	MOVE	FPT,INBEG		;SEE IF /MASTER SPECIFIED
	HLRZ	FPT,.FXLEN(FPT)		;BECAUSE WE IGNORE IT
	SKIPE	FPT			;IF 0, WAS NOT SPECIFIED
	$WARN (MNI,/MASTER module names are ignored when patching)
	SETZM	CURMOD			;CLEAR CURRENT MODULE NAME
	SETZM	LLABEL			;CLEAR LAST LABEL SEEN
	SETZM	NSTLVL			;CLEAR CURRENT NESTING OF <>
	TXZ	F,IAE!IAI		;NOT IN EDIT OR INSERT
	SETZM	PRGINC			;NO PROGRAM IN CORE RIGHT NOW
	MOVEI	T1,TRCBLK		;SET UP AREA FOR TRACE BLOCK
	MOVEM	T1,TRCVAP		;
	PUSHJ	P,ISTINI		;INITIALIZE THE IST
	MOVEI	T1,^D8			;INITIAL RADIX IS RADIX 8.(10)
	MOVEM	T1,CRADIX		;DONE

FIXLL:	PUSHJ	P,ISTSAV		;SAVE IST ACROSS IN CASE OF ERROR
	PUSHJ	P,EVAL			;EVALUATE CODE
IFN DEBUG,<
	TXNE	F,DEBMOD		;IN DEBUGGING MODE?
	JRST	[PUSHJ P,LSTCOD		;YES,JUST LIST CODE
		 PUSHJ P,ISTRST		;RESTORE IST POINTERS
		 JRST FIXLL ]		;AND GET MORE
 > ; NFI DEBUG
	TXNN	F,IAI			;RETURNED WITH CODE,INSIDE INSERT?
	JRST	FIX9			;NO, SO COMPLAIN
	MOVE	C,R%V			;VALUE RETURNED
	MOVE	B,R%R			;RELOCATION
	TLNE	B,1			;LH RELOCATED TOO?
	TRO	B,<1B34>		;YES,INDICATE THAT
	TLZ	B,-1			;AND CLEAR LEFT HALF
	PUSHJ	P,NEWCODE		;INSERT CODE
	  JRST	INSERR			;TOO LITTLE ROOM
	PUSHJ	P,PMEXT			;FIXUP ANY EXTERNALS
	PUSHJ	P,PMMWS			;FIXUP ANY MULTI-WORD STRINGS
	AOS	CPINST			;ONE MORE INSTRUCTION INSERTED
	SKIPN	BARFLG			;IF REPLACING,
	AOS	CPRET			;UPDATE RETURN
	JRST	FIXLL			;BACK FOR MORE CODE

FIX1:	TXNE	F,IAE			;WERE WE BETWEEN EDITS?
	JRST	PEFERR			;NO,SO EOF WAS PREMATURE
	PUSHJ	P,PUTPG			;PUSH OUT PROGRAM IN CORE (IF ANY)
	PUSHJ	P,MSTGET		;RESET INPUT IO TO MASTER
	  JFCL				;DONT CARE IF NO FILE NAMES
	PUSHJ	P,COPY			;COPY OUT THE REST OF FILE
	MOVE	P,FIXXP			;RESTORE PUSHDOWN LIST POINTER
	POPJ	P,			;AND RETURN

FIX9:	$WARN(CII,Code generated outside of range of .INSERT was ignored:,,$MORE)
	PUSHJ	P,.TCRLF##
	PUSHJ	P,TYPTB1
	MOVEI	T1,MACBUF
	PUSHJ	P,.TSTRG##
	SKIPA
X$$CII:	PUSHJ	P,.TCRLF##
	TXZ	F,FOTTY
	PUSHJ	P,ISTRST		;RESTORE IST TO STATE BEFORE CALL
	JRST	FIXLL			;BACK FOR NEXT LINE


; NOTE WELL:  *******
;	STILL UNDER IFN FTBPT WHICH CONTINUES FOR QUITE A FEW PAGES
;
SUBTTL YANKPG-  ROUTINE TO YANK ONE PROGRAM INTO CORE 

;THIS ROUTINE LOADS THE PROGRAM INTO CORE, SETTING UP POINTERS TO
;VARIOUS AREAS OF INTEREST IN THE FILE. NOTE THAT THE ENTRY AND
;NAME BLOCKS HAVE ALREADY BEEN PLACED IN ENTBLK.

YANKPG:	MOVEM	C,SAVEAC		;SAVE C, IT GIVES END OF ENTBLK
	SETZM	FMZLOC			;CLEAR FIRST MODULE ZERO
	MOVE	C,[XWD FMZLOC,FMZLOC+1]	;AND CLEAR REST OF AREA
	BLT	C,LMZLOC		;CLEAR TO LAST
	MOVE	C,.JBFF##		;GET END OF CORE USED
	MOVEM	C,PSLOC			;SAVE START OF PROGRAM
	SOS	C			;BACK OFF ONE SO DEPWRD CAN INCREMENT
YANK1:	PUSHJ	P,GETIN			;GET A WORD OF REL FILE
	PUSHJ	P,DEPWRD		;DEPOSIT INTO CORE
	HLRZ	B,A			;GET BLOCK TYPE
	CAILE	B,3777			;IS IT ASCIZ .TEXT?
	JRST	YANK3			;YES,HANDLE IT DIFFERENTLY
	MOVSI	T,-BLKLEN		;GET READY TO LOOK IT UP
YANK2:	CAMN	B,BLKCOD(T)		;A CODE
	JRST	@YTABLE(T)		;MATCHES!
	AOBJN	T,YANK2			;NO MATCH,TRY AGAIN
	CAIG	B,37			;IN RANGE 0-37?
	JRST	YANK2A			;YES,SO ITS LEGAL OLD TYPE
	CAIN	B,100			;IS IT A REL BLOCK TYPE 100(.ASSIGN)?
	 JRST	YANK2A			;YES, PROCESS AS A LEGAL BLOCK TYPE
	CAIL	B,1000			;CHECK RANGE 1000-1777 FOR
	CAILE	B,1777			;NEW TYPE LINK ITEMS
	JRST	IBTERR			;NOT A RECOGNIZED BLOCK TYPE
YANK2A:	PUSHJ	P,COUNT			;COUNT WORDS THAT FOLLOW
YANK2B:	JUMPE	B,YANK1			;IF NULL BLOCK
	PUSHJ	P,GETIN			;GET A WORD
	PUSHJ	P,DEPWRD		;PUT INTO CORE
	SOJG	B,.-2			;MORE TO DO?
	JRST	YANK1			;NO, GET NEXT BLOCK

YANK3:	PUSHJ	P,GETIN			;GET A WORD OF ASCIZ BLOCK
	PUSHJ	P,DEPWRD		;DEPOSIT IT
	ANDI	A,177			;GET RID OF ALL BUT LAST BYTE
	JUMPE	A,YANK1			;IF NULL, WE ARE DONE
	JRST	YANK3			;ELSE LOOP
SUBTTL TABLE AND PROCESSORS FOR YANK MODULE

;THIS TABLE SETS UP CORRESPONDENCE BETWEEN CODES AND WHAT WE DO
;WHEN WE SEE EACH TYPE OF BLOCK. MOST BLOCKS ARE JUST YANKED INTO CORE
;BUT SEVERAL TYPES GET SPECIAL HANDLING.

BLKCOD:	1		;A CODE BLOCK
	2		;A SYMBOL BLOCK
	11		;A POLISH BLOCK
	5		;END BLOCK
	1040		;END BLOCK
	3		;HI SEGMENT ITEM
	400		;F40 ITEM
	401		;F40 ITEM
	LI$TRC		;TRACE ITEM

YTABLE:	PRGCOD
	PRGSYM
	POLFIX	
	ENDPRG
	ENDPRG
	HISEGI
	E$$FF4
	E$$FF4
	TRACEI
	BLKLEN==.-YTABLE

	$KILL(FF4,Cannot apply FIX to F40 produced REL file)

;HERE TO HANDLE THE CODE BLOCK ITEMS. WE STORE A POINTER TO THE FIRST ONE
;OF THESE.

PRGCOD:	SKIPN	SPCLOC			;FIRST TIME HERE?
	MOVEM	C,SPCLOC		;NO,SAVE POINTER
	PUSHJ	P,COUNT			;GET SIZE OF BLOCK
	MOVE	T,C			;SO WE CAN KNOW THE END
	ADD	T,B			;
	MOVEM	T,EPCLOC		;
	AOS	CBHEAD			;ADD ONE TO NUMBER OF LINK CODE BLOCKS
	JRST	YANK2B			;THEN POLISH OFF BLOCK

;HERE TO HANDLE SYMBOL BLOCK ITEMS. STORE POINTER TO BEGINNING AND END

PRGSYM:	SKIPN	SSTLOC			;FIRST TIME?
	MOVEM	C,SSTLOC		;YES, STORE POINTER
	PUSHJ	P,COUNT			;GET SIZE OF BLOCK
	MOVE	T,C			;START OF BLOCK
	ADD	T,B			;AND NOW (T) IS LAST WORD USED
	MOVEM	T,ESTLOC		;END OF SYMBOL TABLE
	AOS	SBHEAD			;INCREMENT NUMBER OF KNOWN SYMBOL BLOCKS
	JRST	YANK2B			;FINISH UP

;HERE WHEN END OF PROGRAM IS SEEN

ENDPRG:	MOVEM	A,SEB			;STORE IN SAFE PLACE
	SOS	C			;BACK OFF ONE
	MOVEM	C,PELOC			;AND MARK END OF PROGRAM
	PUSHJ	P,COUNT			;SIZE OF BLOCK
	MOVEI	T,SEB+1			;STORE IN SAVE-END-BLOCK
ENDPR1:	PUSHJ	P,GETIN			;INPUT WORD
	MOVEM	A,(T)			;AND INTO SAVE BLOCK
	AOS	T			;UPDATE
	SOJG	B,ENDPR1		;MORE TO DO?
	PUSHJ	P,ICBSET		;SET UP INDEX TO IN-CORE BLOCKS
	SETOM	PRGINC			;CURRENTLY A PROGRAM IN CORE
	JRST	CPOPJ1			;NO,RETURN OVER EOF RETURN


;ROUTINE TO SET UP POINTER TO HI SEGMENT ITEM 

HISEGI:	SKIPN	HSILOC			;MARK HISEGMENT ITEM LOCATION
	MOVEM	C,HSILOC		;
	JRST	YANK2A


;ROUTINE TO SET UP POINTER TO BEGINNING AND END OF TRACE BLOCK AREA

TRACEI:	SKIPN	STBLOC			;MARKED START OF TRACE BLOCKS?
	MOVEM	C,STBLOC		;NOT YET, DO SO NOW
	PUSHJ	P,COUNT			;AND GET COUNT
	MOVE	T,C			;POINT TO END
	ADD	T,B			;
	MOVEM	T,ETBLOC		;AND MARK IT
	JRST	YANK2B			;FINISH UP READING BLOCK

; HERE TO ADD ONE TO COUNT OF POLISH BLOCKS IN PROGRAM

POLFIX:	AOS	PBHEAD			;ANOTHER POLISH BLOCK
	JRST	YANK2A			;POLISH OFF THE BLOCK


;ROUTINE TO DEPOSIT A WORD FROM REGISTER A INTO THE END OF CORE. (C)
;IS THE ADDRESS TO DEPOSIT INTO. MORE CORE IS OBTAINED AS NEEDED.

DEPWRD:	AOS	C			;UPDATE DEPOSIT ADDRESS
	MOVEM	C,.JBFF##		;AND MAKE IT BE NEXT FREE
DEPWD1:	CAMG	C,.JBREL##		;ARE WE PAST OUR MEMORY?
	JRST	DEPWD2			;NO,DEPOSIT
	PUSH	P,C			;SAVE C
	CORE	C,			;GET CORE
	  JRST NECERR			;NOT ENOUGH CORE
	POP	P,C			;RESTORE C
	JRST	DEPWD1			;BE SAFE, CHECK AGAIN
DEPWD2:	MOVEM	A,(C)			;DEPOSIT WORD
	POPJ	P,			;AND RETURN
; ROUTINE TO SET UP INDICES TO BLOCKS REFERENCED OFTEN

ICBSET:	MOVE	T1,CBHEAD		;GET COUNT OF BLOCKS
	MOVEM	T1,CBINIT		;REMEMBER NUMBER OF INITIAL BLOCKS
	ADDI	T1,NCBMAX		;ADJUST FOR MAX NR. OF NEW BLOCKS
	PUSHJ	P,GETCOR		;GET THAT CORE
	MOVEM	T1,CBHEAD		;STORE STARTING LOCATION OF INDEX
	MOVE	T1,PBHEAD		;GET NUMBER OF EXISTING POLISH BLOCKS
	MOVEM	T1,PBINIT		;STORE NR. OF INITIAL BLOCKS
	ADDI	T1,NPBMAX		;ADD IN MAX. NEW BLOCKS
	PUSHJ	P,GETCOR		;GET ENOUGH CORE FOR INDEX
	MOVEM	T1,PBHEAD		;STORE IT AWAY FOR NOW
	MOVE	T1,SBHEAD		;DO SAME FOR SYMBOL BLOCKS
	MOVEM	T1,SBINIT		;REMEMBER NUMBER OF EXISTING BLOCKS
	ADDI	T1,NSBMAX		;ADD EXISTING+MAX. NEW
	PUSHJ	P,GETCOR		;ALLOCATE CORE
	MOVEM	T1,SBHEAD		;STORE THE HEADER ADDRESS PART
	MOVE	T2,CBHEAD		;T1 IS SYMBOLS, T2 IS CODE & T3 POLISH 
	MOVE	T3,PBHEAD		;
	MOVE	C,PSLOC			;START WITH FIRST WORD OF LOADED PROGRAM

ICBSE1:	HLRZ	A,0(C)			;GET A HEADER WORD
	CAIN	A,1			;IS IT CODE BLOCK?
	JRST	ICBSE3			;YES, GO HANDLE IT
	CAIN	A,2			;IS IT SYMBOL BLOCK?
	JRST	ICBSE4			;YES, GO HANDLE IT
	CAIN	A,11			;IS IT POLISH BLOCK?
	JRST	ICBSE5			;YES, GO HANDLE IT
	CAILE	A,3777			;ASCIZ TEXT?
	JRST	ICBS2A			;YES, GO HANDLE IT

ICBSE2:	MOVE	A,0(C)			;GET HEADER SET UP AGAIN
	PUSHJ	P,COUNT			;COUNT ADDITIONAL WORDS
	ADDI	C,1(B)			;GET TO NEXT BLOCK
	CAML	C,PELOC			;OVER END OF PROGRAM?
	JRST	ICBSE6			;YES, FINISH UP AND RETURN
	JRST	ICBSE1			;ELSE GET HEADER

ICBS2A:	MOVE	B,0(C)			;GET WORD IN QUESTION
	AOS	C			;INCREMENT POINTER
	ANDI	B,177			;MASK TO LAST ASCII BYTE
	JUMPE	B,ICBSE1		;IF NULL, STRING IS OVER
	JRST	ICBS2A			;ELSE GET NEXT WORD

ICBSE3:	LDB	B,[POINT 2,1(C),1]	;GET RELOCATION OF START ADDRESS
	JUMPE	B,ICBSE2		;IGNORE IF ABSOLUTE CODE
	MOVEM	C,0(T2)			;STORE LOCATION OF CODE BLOCK
	AOBJP	T2,ICBSE2		;DISCARD REST OF BLOCK

ICBSE4:	MOVEM	C,0(T1)			;STORE LOCATION OF SYMBOL BLOCK
	AOBJP	T1,ICBSE2		;DISCARD REST OF BLOCK

ICBSE5:	MOVEM	C,0(T3)			;REMEMBER STARTING ADDRESS OF BLOCK
	MOVEI	B,2(C)			;POINT TO FIRST DATA WORD
	HRLI	B,(POINT 18,)		;CONVERT TO HALFWORD BYTE POINTER
	SETZ	D,			;CLEAR COUNTER
ICBS5A:	ILDB	A,B			;GET A BYTE
	ADDI	D,1			;INCREMENT THE COUNT
	TRNE	A,1B18			;IS THIS THE STORE OPERATOR?
	JRST	ICBS5B			;YES, THIS IS THE POINTER WE WANT
	CAIE	A,1			;IS THIS "FULL WORD FOLLOWS"?
	CAIN	A,2			;  OR "SYMBOL NAME FOLLOWS"?
	PUSHJ	P,ICBS5C		;YES, SKIP FIRST OF TWO BYTES
	CAIG	A,2			;FOR HW,FW OR SYM (0,1,2) SKIP A BYTE
	PUSHJ	P,ICBS5C		;SINCE ITS DATA
	JRST	ICBS5A			;LOOP FOR NEXT BYTE
ICBS5B:	HRLM	D,0(T3)			;STORE OFFSET TO STORE OPERATOR BYTE
	HRRZS	B			;CLEAR POINTER PART
	CAMLE	B,PELOC			;MAKE A SAFETY CHECK FOR RANGE
	$STPCD(LOST PLACE IN POLISH FIXUP BLOCK) ;SINCE NEW CODES COULD BREAK US
	AOBJP	T3,ICBSE2		;PROCEED TO NEXT BLOCK

ICBS5C:	IBP	B			;INCREMENT TO SKIP A BYTE
	ADDI	D,1			;INCREMENT ILDB'S TO STORE OP.
	POPJ	P,			;RETURN

ICBSE6:	HLRZS	T1			;ISOLATE COUNT
	CAME	T1,SBINIT		;AGREE WITH FIRST COUNT?
	$STPCD(COUNTS OF SYMBOL BLOCKS DON'T AGREE)
	MOVNS	T1			;NEGATE FOR AOBJN PTR
	HRLM	T1,SBHEAD		;STORE PTR FOR LATER USE
	HLRZS	T2			;ISOLATE CODE BLOCK COUNT
	CAMLE	T2,CBINIT		; MUST BE .LE. (DUE TO IGNORING ABS CODE)
	$STPCD(COUNTS OF CODE BLOCKS DON'T AGREE)
	MOVEM	T2,CBINIT		;STORE CORRECTED COUNT
	MOVNS	T2			;NEGATE FOR PTR
	HRLM	T2,CBHEAD		;STORE IT AWAY FOR LATER USE
	HLRZS	T3			;ISOLATE COUNT
	CAME	T3,PBINIT		;SHOULD MATCH PREVIOUS COUNT
	$STPCD(COUNTS OF POLISH BLOCKS DON'T AGREE)
	MOVNS	T3			;GET NEGATIVE COUNT
	HRLM	T3,PBHEAD		;STORE AS -COUNT,,ADDR
	POPJ	P,			;RETURN TO CALLER
SUBTTL PUTPG - ROUTINE TO WRITE BACK OUT THE CORRECTED PROGRAM

;/PUTPG/ - A ROUTINE TO WRITE OUT THE CORRECTED PROGRAM
;	PUTPG COLLECTS THE VARIOUS NEW AND OLD BLOCKS AND RE-WRITES
;	THEM INTO THE OUTPUT FILE. PUTPG COLLECTS CODE
;	FROM THE FOLLOWING PLACES IN THE FOLLOWING ORDER:
;	1-ITEMS STORED IN THE BUFFER "ENTBLK", USUALLY ENTRY AND NAME ITEMS
;	2-EXISTING PROGRAM CODE 
;	3-NEW PROGRAM CODE (FROM PATCOD)
;	3A-VERSION BLOCK (IF ANY) ,WHICH IS ACTUALLY A CODE BLOCK
;	4-OLD SYMBOL TABLE
;	5-NEW SYMBOL TABLE (FROM CRESYM)
;	6-ANYTHING ELSE TO END OF OLD PROGRAM
;	7-NEW TRACE BLOCKS
;	8-UPDATED END BLOCK (FROM SEB)
;

PUTPG:	SKIPL	PRGINC			;ANYTHING TO DO?
	POPJ	P,			;NO, SO JUST RETURN
	SETZM	PRGINC			;CLEAR FLAG
	SOS	B,SAVEAC		;GET OLD POINTER,ADJ BACK ONE
	CAIGE	B,ENTBLK		;ANYTHING TO DO?
	JRST	PUTPG3			;NO, SO GO TO NEXT SECTION
	MOVEI	C,ENTBLK		;ELSE PUT BUFFER OUT
	PUSHJ	P,PUTTO			;FROM (C) TO (B)

PUTPG3:	MOVE	C,PSLOC			;GET START OF READ-IN STUFF
	MOVE	B,EPCLOC		;AND END OF OLD CODE
	PUSHJ	P,PUTTO			;COPY OUT
	MOVEM	C,SAVEAC		;SAVE POINTER
	SKIPN	NCBNUM			;ANY PATCH CODE?
	JRST	PTPG3A			;NO,GO TO NEXT SECTION
	MOVE	T,CBHEAD		;GET INDEX PTR
	MOVE	B,CBINIT		;GET COUNT OF OLD BLOCKS
	HRLS	B			;MAKE COUNT,,COUNT
	ADD	T,B			;NOW HAVE AOBJN PTR TO NEW BLOCKS
PTPG30:	MOVE	C,0(T)			;GET ADDRESS OF BLOCK
	MOVE	A,0(C)			;GET ACTUAL HEADER
	PUSHJ	P,COUNT			;COUNT WORDS
	ADDI	B,0(C)			;FROM (C) TO (B) PUTS OUT
	PUSHJ	P,PUTTO			;THE ENTIRE BLOCK
	AOBJN	T,PTPG30		;ANOTHER BLOCK TO DO?

PTPG3A:	SKIPN	VERBLK			;WAS .VERSION DONE?
	JRST	PUTPG4			;NO, GO TO NEXT SECTION
	MOVEI	C,VERBLK		;GET VERSION BLOCK START
	MOVEI	B,3(C)			;AND VERSION BLOCK END
	PUSHJ	P,PUTTO			;OUTPUT THE 4 WORD BLOCK

PUTPG4:	MOVE	C,SAVEAC		;RESTORE C
	SKIPN	B,ESTLOC		;ANY SYMBOL TABLE?
	JRST	PUTPG5			;NO, SKIP IT
	PUSHJ	P,PUTTO			;ELSE COPY IT OUT

PUTPG5:	SKIPN	NSBNUM			;ANY CREATED SYMBOLS?
	JRST	PUTPG6			;NO,NEXT SECTION
	MOVEM	C,SAVEAC		;SAVE C
	MOVE	T,SBHEAD		;GET PTR TO SYMBOL INDEX
	MOVE	B,SBINIT		;COUNT OF INITIAL BLOCKS
	HRLS	B			;PROPAGATE TO BOTH HALVES
	ADD	T,B			;ADJUST POINTER TO JUST NEW BLOCKS
PTPG50:	MOVE	C,0(T)			;GET AN INDEX ENTRY
	MOVE	A,0(C)			;GET HEADER
	PUSHJ	P,COUNT			;COUNT NUMBER OF WORDS AFTER HEADER
	ADDI	B,0(C)			;FROM AND TO POINTERS SET UP
	PUSHJ	P,PUTTO			;OUTPUT THE BLOCK
	AOBJN	T,PTPG50		;BACK FOR ALL BLOCKS
	MOVE	C,SAVEAC		;RESTORE C

PUTPG6:	MOVE	B,ETBLOC		;GET END OF TRACE BLOCK
	PUSHJ	P,PUTTO			;SHOULD END STUFF
	SKIPN	B,TRCVAP		;AND NEXT COPY OUT ANY NEW BLOCKS
	JRST	PUTPG7			;IN CASE
	TXNE	F,FSTMOD		;CHANGED EDIT?
	MOVE	B,TRCPTR		;YES,DONT COPY STATIC AREA
					;FOR NEW EDIT INTO OLD MODULE
	SOS	B			;BACK OFF ONE FROM END
	MOVEM	C,SAVEAC		;SAVE C
	MOVEI	C,TRCBLK		;WRITE IT OUT
	PUSHJ	P,PUTTO			;FROM TRCBLK TO END OF TRCBLK
	MOVEI	A,TRCBLK		;MAKE SURE ONLY ONE EDIT IN CORE
	CAMN	A,TRCPTR		;
	JRST	PTPG6A			;ITS OK.
	MOVS	B,TRCPTR		;FROM TRCPTR TO
	HRRI	B,TRCBLK		;TRCBLK
	BLT	B,TRCBLK+TB$SIZ-1	;SAVE ONLY THE STATIC AREA
	MOVEI	B,TRCBLK		;AND RESET POINTER
	MOVEM	B,TRCPTR		;TO CURRENT AREA

PTPG6A:	MOVE	B,[LI$TRC,,TB$SIZ]	;RESET STATIC HEADER
	MOVEM	B,TB$HED(A)		;
	SETZM	TB$LEN(A)		;AND THE LEN WORD FOR VARIABLE
	ADDI	A,TB$VAR		;UPDATE
	MOVEM	A,TRCVAP		;VARIABLE POINTER
	MOVE	C,SAVEAC		;
PUTPG7:	MOVE	B,PELOC			;COPY REST OF PROGRAM (IF ANY)
	PUSHJ	P,PUTTO			;AS A SAFETY MEASURE
	MOVEI	C,SEB			;AND LAST COMES THE END BLOCK
	MOVE	A,SEB			;PICK UP HEADER
	PUSHJ	P,COUNT
	ADDI	B,SEB			;END OF BLOCK
	PUSHJ	P,PUTTO		;
	MOVE	C,PSLOC			;RESTORE JBFF
	MOVEM	C,.JBFF##		;SO WE DONT SWELL TOO MUCH
	POPJ	P,			;RETURN TO CALLER


PUTTO:	CAMLE	C,B			;ANY MORE TO DO?
	POPJ	P,			;NO
	MOVE	T1,0(C)			;GET A WORD
	PUSHJ	P,BOUT			;AND WRITE IT
	AOJA	C,PUTTO			;AND LOOP
SUBTTL PROCESSORS AND ROUTINES FOR PATCHING

; /SYMSRC/  - ROUTINE TO FIND A SYMBOL IN REL FILE'S SYMBOL TABLE
;		WHERE SYMBOL IN AC R IS SIXBIT
; /SYMSRN/   -ROUTINE TO FIND NEXT SYMBOL IN REL FILE'S SYMBOL TABLE
;		WHERE SYMBOL IS NEXT OCCURANCE OF SYMBOL IN LAST CALL TO SYMSRC
;
; /SYMSRA/    - SAME AS SYMSRC, ONLY SYMBOL IS IN RADIX50
;
; INPUT- AC R CONTAINS SYMBOL IN SIXBIT OR RADIX50
;	 IF AC R IS 0, THEN ANY GLOBAL REQUEST (TYPE 60) SYMBOL IS A MATCH
; OUTPUT- AC A CONTAINS VALUE OF SYMBOL ( 2ND WORD OF PAIR)
;         AC B CONTAINS 4 BIT CODE OF SYMBOL IN BITS 30-33
;         AC C POINTS TO IN-CORE LOCATION OF 1ST WORD OF SYMBOL PAIR
;	  AC D CONTAINS THE RIGHT JUSTIFIED 2 BIT RELOC BYTE FOR CONTENTS OF AC A
;		AC R IS PRESERVED, UNLESS IT WAS 0. IF IT WAS 0
;		THEN RADIX50 NEXT GLOBAL SYMBOL NAME IS RETURNED
;
; RETURNS- CPOPJ=SYMBOL NOT FOUND    CPOPJ1=SYMBOL FOUND

SYMSRC:	JUMPE	R,SYMSRA		;HANDLE 0 (WILD CARD) SAME 
					;FOR SIXBIT OR RADIX50
	PUSH	P,R			;SAVE SIXBIT OF SYMBOL
	PUSHJ	P,RAD50			;CONVERT TO RADIX 50
	PUSHJ	P,SYMSRA		;NOW CONTINUE, WITH R50
	 CAIA				;FAILURE RETURN
	AOS	-1(P)			;SKIP RETURN
	POP	P,R			;RESTORE ORIG AC R
	POPJ	P,			;RETURN

SYMSRA:	SKIPL	T,SBHEAD		;ANY SYMBOL TABLE LINK BLOCKS?
	POPJ	P,			;NO, JUST RETURN W/FAILURE
	PUSH	P,T1			;SAVE T1-2
	PUSH	P,T2			;...

SYMSR1:	MOVE	C,0(T)			;GET LOCATION OF SYMBOL BLOCK
	MOVE	A,(C)			;GET A HEADER
	PUSHJ	P,COUNT			;GET LENGTH OF BLOCK
	MOVEI	D,23(C)			;POINT TO NEXT RELOCATION WORD
	MOVE	T2,1(C)			;T2 GETS RELOC WORD
	ADDI	C,2			;NOW POINT TO FIRST SYMBOL PAIR
	SOS	B			;AND ACCOUNT FOR SKIPPED WORD

SYMSR2:	JUMPLE	B,SYMSR4		;END OF THIS BLOCK?
	CAMN	D,C			;TIME TO IGNORE RELOC WORD?
	JRST	[ SOS B			;YES
		 MOVE	T2,0(C)	        ;GET RELOCATION WORD
                 MOVEI D,22(C)          ;AND PTR
		 AOS C
                 JRST SYMSR2]	      	;AND TRY AGAIN
	MOVE	A,(C)			;GET A SYMBOL
	TLZ	A,740000		;TURN OFF CODE BITS
	LSHC	T1,4			;GET RELOC BYTE
	JUMPE	R,SYMS2B		;IF R/0 THEN DIFFERENT TEST FOR MATCH
	CAMN	R,A			;A MATCH?
	JRST	SYMSR3			;YES,SET PTRS AND RETURN
SYMS2A:	ADDI	C,2			;SKIP PAIR
	SUBI	B,2			;DECREMENT COUNT
	JRST	SYMSR2			;AND TRY AGAIN

SYMS2B:	LDB	R,[ POINT 4,0(C),3]	;GET TYPE CODE
	CAIE	R,60_-2			;IS THIS A GLOBAL REQUEST?
	SETZ	R,			;NO, WE WILL CONTINUE W/NEXT SYMBOL
	JUMPE	R,SYMS2A		;IF NO MATCH, TRY NEXT
	SETZ	R,			;CLEAR FOR SAVE
					;... AND FALL INTO "MATCH" CODE

SYMSR3:	PUSH	P,A			;SAVE AC
	MOVE	A,[XWD T1,SYMBLK]	;SAVE STATE
	BLT	A,SYMBLK+D		;FOR SYMSRN ROUTINE
	POP	P,R			;RESTORE SYMBOL NAME
	MOVE	A,1(C)			;GET VALUE OF SYMBOL INTO REG. A
	LDB	B,[POINT 4,0(C),3]	;AND BITS INTO B
	LSH	B,2			;GET IT INTO BITS 30-33
	LDB	D,[POINT 2,T1,35]	;GET RELOCATION BYTE
	AOSA	-2(P)			;FORCE SKIP RETURN
SYMSR4:	AOBJN	T,SYMSR1		;IF MORE SYMBOL BLOCKS, CONTINUE
T2POPJ:	POP	P,T2			;RETURN, RESTORING
T1POPJ:	POP	P,T1			;THE TWO ACS
	POPJ	P,			;

SYMSRN:	PUSH	P,T1			;ALT. ENTRY POINT FOR REPEAT SYMBOL
	PUSH	P,T2			;SAVE ACS FOR GOOD PDL PHASE
	MOVS	A,[XWD T1,SYMBLK]	;RESTORE ACS
	BLT	A,D			;FROM LAST SEARCH
	JRST	SYMS2A			;AND CONTINUE
; /WRDSRC/ - ROUTINE TO TAKE A VALUE AND FIND THE WORD IN THE
;		REL FILE THAT CORRESPONDES TO THAT VALUE. I.E.
;		GIVEN A VALUE OF N, FIND THE WORD IN THE REL FILE
;		THAT WILL BE LOADED INTO WORD N OF THE CORE IMAGE.
;
; INPUT-  AC A SHOULD CONTAIN A VALUE  (PRESERVED)
; OUTPUT- AC C WILL CONTAIN THE IN-CORE POSITION OF THE DESIRED WORD
;         AC B WILL CONTAIN THE IN-CORE POSITION OF THE HEADER WORD
;              THE CODE ITEM THAT THE WORD APPEARS IN.
;
; RETURNS-  CPOPJ=WORD IS NOT IN FILE,   CPOPJ1=WORD IS IN FILE
;

WRDSRC:	SKIPL	T,CBHEAD		;LOAD AOBJN PTR TO CODE BLOCK INDEX
	POPJ	P,			;IF NONE,JUST RETURN

WRDSR1:	MOVE	B,0(T)			;GET ENTRY FROM INDEX
	HLRZ	C,0(B)			;GET BLOCK TYPE
	MOVE	D,2(B)			;POINT TO FIRST START ADDR WORD
	CAMLE	D,A			;IS START ADDR .GT. VALUE?
	JRST	WRDSR3			;YES,SO CANT BE IN THIS BLOCK
	HRRZ	C,0(B)			;GET NR. OF DATA WORDS IN BLOCK
	SUBI	C,2			;BACK OFF TWO AS ADDITIVE ADJ.
					;I.E. SO S.ADDRESS OF BLOCK + (C)
					;IS HIGHEST ADDR THIS BLOCK
	ADD	D,C			;GET HIGHEST ADDRESS THIS BLOCK
	CAMGE	D,A			;IF .LT. VALUE ,NOT IN BLOCK
	JRST	WRDSR3			;SO GET NEXT ONE
	MOVE	D,A			;DESIRED VALUE
	SUB	D,2(B)			;MINUS START ADDRESS
	ADDI	D,3(B)			;PLUS BASE GIVES CORE POSITION
	MOVE	C,D			;RETURN IT IN C
	JRST	CPOPJ1			;AND RETURN

WRDSR3:	AOBJN	T,WRDSR1		;MORE TYPE 1 BLOCKS LEFT?
	POPJ	P,			;NO, RETURN W/FAILURE
; /FGREF/  - ROUTINE TO FIND THE IN-CORE ADDRESS OF THE SYMBOL TABLE
;		OR CODE WORD THAT IS THE IMMEDIATE PREDECESSOR OF THE
;		WORD WHOSE RELOCATABLE ADDRESS IS (A) , IN THE GLOBAL
;		FIXUP CHAIN THAT STARTS WITH THE SYMBOL (R).
;
; INPUTS-	AC A CONTAINS THE RELOCATABLE (LOAD) ADDRESS OF
;		WORD WE THINK IS IN A GLOBAL CHAIN
;		AC R CONTAINS A SIXBIT SYMBOL NAME THAT IS A GLOBAL
;		WE THINK HEADS SOME CHAIN THAT WE THINK (A) IS
;		A PART OF.
;

; OUTPUTS-	AC C CONTAINS A 36 BIT VALUE THAT IS A BYTE POINTER
;		TO BE USED TO ACCESS THE POINTER (PREV) THAT POINTS TO
;		THE RELOCATABLE ADDRESS (A).
;		THIS MAY BE A MEMBER OF A CHAIN, A SYMBOL TABLE ENTRY OR
;		A BYTE IN A POLISH FIXUP BLOCK.
;
; RETURNS-	CPOPJ=CANNOT FIND REFERENCE
;		CPOPJ1 = REFERENCE FOUND.
;
; NOTE:	ALT. ENTRY FGREFN FINDS NEXT GLOBAL REFERENCE
; NOTE: IF (R) IS 0 THEN ANY GLOBAL IS A MATCH.
;
;

FGREF:	SETZM	PBLAST			;CLEAR LAST USED POLISH BLOCK
	MOVEM	A,SAVEA			;SAVE REFERENCE
	PUSHJ	P,SYMSRC		;FIND FIRST REFERENCE TO SYM.
	  JRST	FGREF6			;NO SYMBOL TABLE ENTRY , TRY POLISH
FGREF1:	CAIE	B,60			;IS IT A GLOBAL SYMBOL?
	JRST	FGREF5			;NO,SKIP IT
	JUMPE	D,FGREF5		;IF NO FIXUP, OR ABS. FIXUP, IGNORE IT
	ADD	C,[POINT 18,1,35]	;MAKE ACCESS TO RIGHT HALF
	HRRZS	A			;CLEAR BITS IN LH
	CAMN	A,SAVEA			;A MATCH?
	JRST	CPOPJ1			;YES
	MOVE	A,0(C)			;FOLLOW CHAIN
	CAIE	A,-1			;IF THIS IS SPECIAL FLAG OR
	TXNE	A,R5.FXA		;IF THERE IS ADDITIVE PROCESSING
	JRST	FGREF5			;THEN THERE IS NO CHAIN

FGREF2:	PUSHJ	P,WRDSRC		;LOOKUP WORD WE POINT TO
	 $STPCD(GLOBAL chain points outside of REL file)
	HRRZ	A,0(C)			;GET ADDRESS FIELD
	PUSHJ	P,GETREL		;GET THE RELOCATION OF THE ADDRESS
	TRNN	D,1			;IS IT RELOCATABLE ADDR TO FIXUP?
	JRST	FGREF5			;NO. CALL IT END OF THIS CHAIN
FGREF3:	HRLI	C,(POINT 18,0,35)	;MAKE INTO RH ACCESS BYTE POINTER
	CAMN	A,SAVEA			;A MATCH?
	JRST	CPOPJ1			;YES,TAKE GOOD RETURN
	JRST	FGREF2			;NO,FOLLOW CHAIN

FGREF5:
FGREFN:	SKIPE	B,PBLAST		;INTO POLISH STUFF?
	JRST	FGREF7			;YES, PROCESS IT
	PUSHJ	P,SYMSRN		;GET NEXT INSTANCE OF SYMBOL
	  JRST	FGREF6			;EXHAUSTED SYMBOLS, TRY POLISH
	JRST	FGREF1			;PROCESS IT

FGREF6:	SKIPL	B,PBHEAD		;[74] FETCH POINTER TO POLISH LIST
FGREF7:	JUMPGE	B,CPOPJ			;IF NONE OR FINISHED , FAIL
	HRRZ	C,0(B)			;GET THE ADDRESS OF THE BLOCK
	ADD	C,[POINT 18,2]		;OFFSET TO DATA, MAKE B.P.
	HLRZ	A,0(B)			;GET OFFSET TO STORE OPERATOR
	ILDB	D,C			;GET A BYTE
	SOJG	A,.-1			;REPEAT TILL PROPER POSITION
	TRNE	D,1B18			;MUST BE NEGATIVE AND
	CAIGE	D,-3			;A WORD FIXUP (NOT SYMBOL)
	JRST	FGREF8			;DISCARD BLOCK
	AOBJP	B,.+1			;INCREMENT BOTH HALVES OF PTR
	MOVEM	B,PBLAST		;THIS IS LAST ONE EXAMINED
	ILDB	A,C			;GET THE ADDRESS TO STORE INTO
	CAMN	A,SAVEA			;IS THIS A MATCH?
	JRST	CPOPJ1			;TAKE GOOD RETURN ON MATCH
	CAIE	D,-2			;IS THIS A LEFT HALF FIXUP?
	JRST	FGREF2			;NO,FOLLOW CHAIN
	JRST	FGREF7			;ELSE GET NEXT BLOCK

FGREF8:	AOBJN	B,FGREF7		;YES, NO CHAIN TO FOLLOW
	POPJ	P,			;RETURN FAIL WHEN DONE
; /GFIXUP/ - ROUTINE TO CHANGE GLOBAL CHAINS WHEN A WORDS POSITION IS CHANGED
;
;  	GFIXUP HUNTS DOWN THE GLOBAL CHAINS (AT MOST TWO,AT LEAST 0)
;	 THAT POINT TO A WORD AND UPDATES THEM TO POINT TO THE CORRECT
;	 PLACE. THIS ROUTINE  SHOULD BE USED WHEN ANY WORD IS CHANGED
;	 IN LOCATION IN THE REL FILE.
;
; INPUTS-	AC A SHOULD CONTAIN THE PRESENT RELOCATABLE ADDRESS OF 
;		  WORD IN QUESTION.
;		AC B SHOULD CONTAIN THE RELOCATABLE ADDRESS WHERE THE WORD
;		  IS GOING.
;
; OUTPUTS-	UPDATED SYMBOL TABLE AND / OR CHAINS.
;
; RETURNS-	ALWAYS CPOPJ
;
;

GFIXUP:	PUSH	P,B			;SAVE B ACROSS CALLS
	PUSH	P,A			;SAVE A ACROSS CALLS
	SETZ	R,			;DONT KNOW SYMBOL NAME
	PUSHJ	P,FGREF			;FIND FIRST REFERENCE
	  JRST	GFIXU2			;NOT IN ANY CHAIN
	MOVE	B,-1(P)			;GET NEW ADDRESS
	DPB	B,C			;UPDATE ADDRESS
	MOVE	A,0(P)			;RESTORE ADDRESS
	PUSHJ	P,FGREFN		;GET 2ND REFERENCE
	  JRST GFIXU2			;NOT THERE
	MOVE	B,-1(P)			;GET NEW ADDRESS
	DPB	B,C			;STORE NEW LOCATION
GFIXU2:	POP	P,A			;RESTORE A
	POP	P,B			;RESTORE B
	POPJ	P,			;RETURN
; /NEWSYM/ - ROUTINE TO INSERT A SYMBOL PAIR INTO THE CREATED SYMBOL BLOCK
;		FOR LATER MERGING WITH EXISTING SYMBOL BLOCK
;
; INPUT- AC R SHOULD CONTAIN A RADIX 50 SYMBOL NAME WITH APPROPRIATE
;	    BITS SET IN 0-3. IF NONE ARE SET, FLAGS ARE INSERTED WITH
;		MEANING [LOCAL SYMBOL].
;        AC A SHOULD CONTAIN THE VALUE (WORD 2 OF PAIR) DESIRED. NOTE
;	THAT FOR LOCAL SYMBOLS THIS IS THE VALUE OF THE SYMBOL AND
;	FOR GLOBAL REQUESTS, THIS IS THE ADDRESS TO DO THE FIXUP TO.
;	AC B SHOULD CONTAIN THE 2 BIT RELOCATION BYTE FOR THIS
;	  SYMBOLS'S VALUE.  THE USUAL WILL BE 01(2) MEANING
;	  RELOCATE THE RIGHT HALF.
;
;
;
; OUTPUT- UPDATED CRESYM AND CREPTR. 
;
; RETURNS-  CPOPJ=NO ROOM FOR SYMBOL    CPOPJ1=SYMBOL INSERTED
;

NEWSYM:	TLNN	R,740000		;SOME BITS ON?
	TXO	R,R5.LCL		;NO, MAKE IT A LOCAL SYMBOL
	SKIPN	NSBNUM			;FIRST TIME THRU HERE?
	JRST	NEWSY1			;YES,NEED NEW BLOCK
	HRRZ	D,@LSYMHW		;GET COUNT OF CURRENT BLOCK
	CAIE	D,22			;TIME FOR A NEW BLOCK
	JRST	NEWSY2			;ELSE GO PROCESS

NEWSY1:	AOS	T,NSBNUM		;UNDER MAXIMUM NUMBER
	CAILE	T,NSBMAX		;OF SYMBOL BLOCKS AVAILABLE?
	POPJ	P,			;NO, OUT OF ROOM
	PUSH	P,T1			;SAVE THE AC
	MOVEI	T1,SBSIZE		;GET ENOUGH CORE FOR FULL BLOCK
	PUSHJ	P,GETCOR		;FROM THE SYSTEM
	MOVEM	T1,LSYMHW		;REMEMBER WHERE BLOCK STARTS
	MOVSI	D,2			;2 IS SYMBOL CODE
	MOVEM	D,(T1)			;STORE HEADER 	(0)
	MOVE	D,[BYTE (2) 0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1]
	MOVEM	D,1(T1)			;STORE RELOC		(1)
	HLRE	C,SBHEAD		;GET FULL NEG. COUNT OF SYMBOL BLOCKS
	HRRZ	D,SBHEAD		;AND BASE ADDRESS OF INDEX
	SUB	D,C			;GET FIRST FREE WORD OF INDEX
	MOVEM	T1,0(D)			;STORE LOCATION OF THIS BLOCK
	SUBI	C,1			;ONE WORD ADDED TO INDEX
	HRLM	C,SBHEAD		;RESTORE UPDATED POINTER
	ADDI	T1,2			;UPDATE THE POINTER
	MOVEM	T1,CREPTR		;AND STORE IT
	POP	P,T1			;RESTORE AC

NEWSY2:	MOVE	T,CREPTR		;FETCH POINTER
	MOVEM	R,0(T)			;STORE SYMBOL NAME
	MOVEM	A,1(T)			;AND ITS VALUE
	MOVEI	T,2			;UPDATE COUNTERS
	ADDM	T,CREPTR		;TO CURRENT LOCATION
	ADDM	T,@LSYMHW		;TO BLOCK HEADER
	CAIN	B,1			;CHECK FOR LABEL TYPE RELOC
	JRST	NEWSY3			;USUAL CASE OF 01(2),SKIP THIS
	MOVE	T,LSYMHW		;LOAD ADDRESS OF BLOCK HEADER
	HRRZ	C,0(T)			;PICK UP RH OF HEADER (WORD COUNT)
	ADD	T,[POINT 2,1]		;CONVERT AC T TO BYTE POINTER TO
					;RELOCATION WORD
	IBP	T			;UPDATE TO POINT TO RIGHT PLACE
	SOJG	C,.-1			;
	CAILE	B,3			;MAKE SURE WE DONT HAVE GARBAGE
	$STPCD(Relocation argument incorrect)
	DPB	B,T			;STORE THE RELOCATION 
NEWSY3:	TLZ	R,740000		;TURN FLAGS OFF AGAIN
	JRST	CPOPJ1			;TAKE GOOD RETURN


; THESE ARE AUXIALLIARY ENTRY POINTS TO NEWSYM. 
; /GLRSYM/ - TURNS ON BITS TO INDICATE SYMBOL IS GLOBAL REQUEST
; /GLDSYM/ - TURNS ON BITS TO INDICATE SYMBOL IS GLOBAL DECLARATION
;
; INPUTS - SAME AS FOR ROUTINE NEWSYM


GLRSYM:	TXOA	R,R5.REQ		;FLAG AS GLOBAL REQUEST
GLDSYM:	TXO	R,R5.GLB		;FLAG AS GLOBAL DECLARATION
	JRST	NEWSYM			;AND CONTINUE
;/NEWCOD/ - ROUTINE TO INSERT A CODE WORD INTO THE PATCH CODE
;     		BLOCK FOR LATER MERGING WITH EXISTING CODE.
;
; INPUTS - AC C CONTAINS THE WORD OF CODE TO BE INSERTED.
;	   AC B CONTAINS THE 2 BIT RELOCATION FOR THIS WORD
;
; OUTPUTS- UPDATED PATCOD,PATPTR AND THEIR ASSOCIATED DATA ITEMS
;		NOTE::: CPADDR MUST BE SET UP WITH LOCATION TO PATCH
;	INTO. CPADDR,HI SEGMENT AND END BLOCKS WILL BE UPDATED ON
;	EACH CALL. ALSO NOTE THAT CPSFLG MUST BE SET
;	TO INDICATE THE SEGMENT TO PATCH INTO.
;
; RETURNS-  CPOPJ=NO ROOM LEFT IN PATCOD      CPOPJ1=WORD INSERTED.

NEWCOD:	MOVE	A,CPADDR		;LOAD PATCH ADDRESS
	SKIPN	NCBNUM			;IS PATCH POINTER INITED?
	JRST	NEWCO1			;NO, NEED NEW BLOCK
	HRRZ	T,@LCODHW		;PICK UP COUNT
	CAIE	T,22			;TIME FOR OUR FRIEND THE RELOC?
	JRST	NEWCO2			;YES,FORCE NEW BLOCK

NEWCO1:	AOS	T,NCBNUM		;INCREMENT NUMBER OF NEW CODE BLOCKS
	CAILE	T,NCBMAX		;UNDER THE MAXIMUM AVAILABLE?
	POPJ	P,			;NO, RETURN WITH FAILURE
	PUSH	P,T1			;SAVE AN AC
	MOVEI	T1,CBSIZE		;NUMBER OF WORDS PER LINK CODE BLOCK
	PUSHJ	P,GETCOR		;ASSIGN THE CORE
	MOVE	T,[XWD 1,1]		;HERE TO SET UP NEW BLOCK
	MOVEM	T,(T1)			;1)HEADER WORD
	HRLZI	T,(1B1)			;2)RELOCATION WORD
	MOVEM	T,1(T1)			;RELOCATE STARTING ADDRESS
	MOVEM	A,2(T1)			;3)STARTING ADDRESS
	MOVEM	A,LCADDR		;AND SAVE AS LAST ADDRESS USED
	MOVEM	T1,LCODHW		;SAVE POINTER TO LAST HEADER WD
	PUSH	P,A			;GET SOME ACS
	PUSH	P,B			;FOR UPDATING INDEX BLOCK
	HLRE	A,CBHEAD		;GET NEG. COUNT OF INDEX SIZE
	HRRZ	B,CBHEAD		;AND BASE ADDRESS OF INDEX
	SUB	B,A			;GET FIRST FREE LOCATION
	MOVEM	T1,0(B)			;STORE LOCATION OF HEADER
	SUBI	A,1			;INDEX INCREASES IN SIZE BY ONE
	HRLM	A,CBHEAD		;RESTORE ADJUSTED HEADER
	POP	P,B			;RESTORE ACS
	POP	P,A			;FOR USE
	ADDI	T1,3			;POINT TO FIRST FREE
	MOVEM	T1,PATPTR		;AND SAVE
	POP	P,T1			;RESTORE AC
	MOVE	D,PATPTR		;SET UP DEPOSIT POINTER
	JRST	NEWCO3			;GO INSERT CODE

NEWCO2:	MOVE	D,PATPTR		;PICK UP THE POINTER
	SUB	A,LCADDR		;SEE IF WORKING CONTIGUOSLY
	CAIE	A,1			;WHICH IS USUAL
	JRST	[ADD A,LCADDR		;NOT CONTIGUUS, FORCE NEW BLOCK
		 JRST NEWCO1]
	AOS	A,LCADDR

NEWCO3:	MOVEM	C,0(D)			;STORE WORD OF CODE
	AOS	PATPTR			;AND IN-CORE BLOCK INDEX TOO
	AOS	CPADDR			;UPDATE THE ADDRESS TO PATCH
	SKIPGE	CPSFLG			;HI-SEGMENT FLAG UP?
	JRST	NEWC3A			;NO,SO USE LOW SEGMENT UPDATE
	MOVSI	T,1			;ADD 1 TO LEFT HALF OF FIRST
	MOVE	A,HSILOC		;
	SKIPE	2(A)			;[16]HISEG TYPE 3 BLOCK HAS 0
					;[16]SO DONT INCREMENT IT
	ADDM	T,2(A)			;DATA WORD
	AOS	SEB+2			;UPDATE END BLOCK TOO
	JRST	NEWC3B			;AND FINISH
	
NEWC3A:	MOVEI	T,SEB+2			;POINT TO FIRST "END" DATA WORD
	SKIPE	HSILOC			;BUT IF HAVE A HI-SEGMENT,
	AOS	T			;POINT TO SECOND DATA WORD
	AOS	0(T)			;UPDATE PROGRAM LOW-SEG BREAK

NEWC3B:	AOS	T,@LCODHW		;UPDATE NR WORDS IN HEADER
	HRRZS	T			;T NOW HAS THAT COUNT
	JUMPE	B,CPOPJ1		;IF RELOC BITS 0, WE ARE DONE
	LSH	T,1			;SHIFT BITS TO 36.-INDEX*2
	MOVEI	D,^D36			;
	SUB	D,T
	LSH	B,(D)			;BITS NOW IN POSITION
	MOVE	T,LCODHW		;GET ADDRESS OF BLOCK HEADER
	IORM	B,1(T)			;RELOC IS ONE BELOW
	JRST	CPOPJ1			;AND RETURN
; /CHGREL/ - ROUTINE TO CHANGE THE RELOCATION BITS FOR A WORD
;	IN THE REL FILE.
;
; INPUT-	AC B CONTAINS ADDRESS OF THE HEADER WORD OF THE
;		 LINK ITEM TYPE BLOCK THAT WORD IS IN.
;		AC C CONTAINS THE ADDRESS OF THE WORD ITSELF WHOSE RELOCATION
;		 BYTE WE ARE CHANGING.
;		AC D CONTAINS THE 2 BIT RELOCATION BYTE DESIRED ( IN BITS 34-35)
;
; ACS ARE PRESERVED
;
; RETURN-	ALWAYS CPOPJ
;


CHGREL:	PUSH	P,T1			;SAVE ACS T1-2 ,C
	PUSH	P,T2
	PUSH	P,C			;SAVE ACS

	SUBI	C,1(B)			;GET INDEX OF WORD IN THIS BLOCK
	MOVE	T1,1(B)			;GET ORIGINAL RELOC WORD
	LSH	C,1			;DOUBLE THE INDEX
	LSHC	T1,-^D36(C)		;POSITION RELOC BYTE IN BITS 34-5 OF T1
	TRZ	T1,3			;TURN THEM OFF
	IOR	T1,D			;MAKE THEM THE NEW ONES
	MOVNS	C			;NEGATE C
	LSHC	T1,^D36(C)		;REVERSE SHIFT (SHIFT INTO REVERSE?)
	MOVEM	T1,1(B)			;STORE RESULT
	POP	P,C			;RESTORE AC C
	PJRST	T2POPJ			;RETURN,RESTOREING T1-T2


; /GETREL/ - ROUTINE TO READ RELOCATION BYTE FOR A WORD
;
; INPUTS - AC B CONTAINS IN-CORE LOCATION OF HEADER
;	     AC C CONTAINS IN-CORE LOCATION OF WORD ITSELF
;
; OUTPUTS -	AC D WILL CONTAIN IN BITS 34-35 THE TWO BIT RELOC. BYTE
;
GETREL:	PUSH	P,C			;SAVE AC C
	SUBI	C,1(B)			;GET INDEX
	ASH	C,1			;MULT. * 2
	MOVE	D,1(B)			;GIVE D THE RELOCATION WORD
	LSH	D,-^D36(C)		;GET INTO RIGHT PLACE
	ANDI	D,3			;MASK IT
	POP	P,C			;RESTORE C
	POPJ	P,			;RETURN
;/FNDEDT/ - ROUTINE TO FIND AN EDIT IN THE CURRENT MODULE
;	IN CORE.
;
; INPUTS- AC A CONTAINS THE SIXBIT NAME OF THE EDIT TO LOOK FOR
;
; OUTPUTS- AC B CONTAINS THE POINTER TO THE TRACE BLOCK CONTAINING
;		THE EDIT-TRACE INFORMATION.
;
; RETURNS-	CPOPJ=EDIT WAS NOT FOUND	CPOPJ1=EDIT WAS FOUND
;

FNDEDT:	MOVE	T,ETBLOC		;LOAD T WITH END OF OLD TRACE BLOCKS
	SKIPN	B,STBLOC		;ANY OLD TRACE BLOCKS?
	JRST	FNDED3			;NO, SEE IF ANY ADDED

FNDED1:	CAMN	A,TB$EDT(B)		;A MATCH?
	JRST	CPOPJ1			;YES, SO RETURN
	PUSH	P,A
	PUSH	P,B			;SAVE A-B
	MOVE	A,TB$HED(B)		;LOAD HEADER
	PUSHJ	P,COUNT			;AND COUNT
	ADD	B,0(P)			;GET ADDRESS NEXT HEADER
	AOS	B			;PAST END OF THIS BLOCK
	POP	P,A			;POP OFF
	POP	P,A			;RESTORE A
	CAMG	B,T			;OVER THE END OF CURRENT SEARCH
	JRST	FNDED1			;NO, SEE IF MATCH ETC...
FNDED3:	CAMN	T,ETBLOC		;ARE WE DOING PART A?
	SKIPN	T,TRCPTR		;YES,DO WE HAVE PART B?
	POPJ	P,			;EITHER WERE DOING ADDED OR DONT HAVE
	MOVEI	B,TRCBLK		;BEGINNING OF IT
	SUBI	T,2			;-1 TO ADJ PTR
					;-1 BECAUSE DONT WANT TO SEE THIS
					;EDIT
	CAMLE	B,T			;END .GT. BEGINNING?
	POPJ	P,			;RETURN /FAIL
	JRST	FNDED1			;NO,SO CONTINUE SEARCH
					;IS SET TO FIRST.FREE
; /CHKCNF/ -	ROUTINE TO SEE IF THE ACT OF INSERTING,RE-INSERTING OR
;		 REMOVING AN EDIT CONFLICTS WITH THE [ASSOCIATED]
;		 SPECIFICATION OF AN EXISTING,ACTIVE EDIT IN THE
;		 CURRENT MODULE.
;
; INPUTS-	AC A SHOULD CONTAIN THE SIXBIT NAME OF THE EDIT CURRENTLY
;		 BEING REMOVED OR INSERTED OR RE-INSERTED.
;		AC B SHOULD CONTAIN :
;				1B0 IF THIS EDIT IS BEING REMOVED
;				1B1 IF REINSERTED OR INSERTED
;
; NOTE: CONFLICT WARNINGS ARE GENERATED INSIDE THE ROUTINE ITSELF.
;	SO THERE IS ONLY ONE RETURN. CURRENTLY THE MESSAGES ARE ONLY
;	WARNINGS, BUT A CHANGE TO FATAL INVOLVES ONLY CHANGEING THE
;	MACRO TO "$KILL" AND CHANGING X$$CNF+1 TO JRST RSTRT1
;
; RETURNS-	ALWAYS CPOPJ
;


CHKCNF:	PUSH	P,B			;SAVE AC B, IT HAS ARG
	PUSHJ	P,FRED			;FIND FIRST REFERENCE
	 JRST	T1POPJ			;CLEAN STACK AND RETURN
	JRST	CHKCN2			;FOUND REFERENCE, SO PROCESS

CHKCN1:	PUSHJ	P,FREDN			;HERE TO FIND NEXT REFERENCE
	 JRST	T1POPJ			;TO RETURN WITH PDL PHASE CORRECT

CHKCN2:	SKIPL	0(P)			;WAS ARG 1B1?
	JRST	CHKCN3			;NO,SO EDIT IS BEING REMOVED
	JUMPL	C,CHKCN1		;NO CONFLICT IS TB$AES WAS 1B1
	MOVEI	N,[ASCIZ/Insertion of edit /] ;ERROR MESSAGE
	JRST	CHKCN4			;USE COMMON ERROR MESSAGE

CHKCN3:	JUMPE	C,CHKCN1		;IS THERE A COMMON CONFLICT?
	MOVEI	N,[ASCIZ/Removal of edit /]

CHKCN4:	$WARN(CNF,,N$STRG,$MORE)	;GIVE THE APPROPRIATE WARNING
	MOVE	T1,A			;GIVE EDIT NAME
	PUSHJ	P,.TSIXN##
	CAMN	T1,CUREDT		;IS THIS EDIT CURRENT EDIT?
	JRST	CHKC4A			;YES,DONT SAY WHO THEN
	MOVEI	T1,[ASCIZ / by edit /]
	PUSHJ	P,.TSTRG##		;SAY WHAT EDIT DOES THIS
	MOVE	T1,CUREDT		;ITS THE CURRENT EDIT
	PUSHJ	P,.TSIXN##
CHKC4A:	MOVEI	T1,[ASCIZ/ conflicts with edit /]
	PUSHJ	P,.TSTRG##		;
	MOVE	T1,D			;GIVE REFERENCE EDIT NAME
	PUSHJ	P,.TSIXN##		;
X$$CNF:	PUSHJ	P,.TCRLF##
	TXZ	F,FOTTY			;RESTORE NORMAL IO MODE
	JRST	CHKCN1			;SEE IF MORE CONFLICTS
; /FRED/ - ROUTINE TO FIND FIRST REFERENCE TO A SPECIFIC EDIT
; /FREDN/- ROUTINE TO FIND NEXT REFERENCE TO A SPECIFIC EDIT
;		THESE ROUTINES ARE USED TO FIND , IN THE TRACE
;		BLOCKS OF THE MODULE IN CORE, ALL REFERENCES TO A SPEFICIC
;		EDIT.  FRED IS USED TO FIND THE FIRST SUCH REFERENCE AND
;		SUCCESSIVE CALLS ARE TO FREDN TO FIND ANY OTHERS.
;
; INPUTS-	AC A SHOULD CONTAIN A SIXBIT EDIT NAME, REFERENCE TO IT
;		ARE WHAT TO LOOK FOR.
;
; OUTPUTS-	AC A IS PRESERVED.
;		AC B CONTAINS THE ADDRESS OF THE TRACE BLOCK IN WHICH THE
;		 REFERENCE WAS FOUND.
;		AC C CONTAINS THE STATUS WORD (TB$AES) OF THE ASSOCIATED
;		 EDIT PAIR OF THE REFERENCE.
;		AC D CONTAINS THE SIXBIT NAME OF THE EDIT THAT REFERS
;		 TO THE EDIT IN AC A.
;
; RETURNS-	CPOPJ=NO REFERENCE FOUND OR ALL REFERENCES EXHAUSTED
;		CPOPJ1 MEANS THAT THE ACS ARE SET UP WITH A REFERENCE.
;
;

FRED:	MOVE	T,ETBLOC		;LOAD T WITH FIRST PART SEARCH END
	SKIPN	B,STBLOC		;ANY TRACE BLOCKS?
	JRST	FRED4			;NO, SEARCH ADDED BLOCKS
	
FRED1:	MOVE	C,TB$STA(B)		;GET IF ACTIVE WORD
	JUMPE	C,FRED3			;IF NOT ACTIVE,IGNORE IT
	HLRZ	C,TB$LEN(B)		;GET THE VARIABLE AREA LENGTH
	JUMPE	C,FRED3			;IF NO ASSOCIATED EDITS,SKIP BLOCK
	
	MOVEI	D,TB$VAR(B)		;START OF ASSOC EDIT AREA
FRED2:	MOVE	T1,0(D)			;GET AN A.E. NAME
	CAMN	T1,A			;SAME?
	JRST	[ MOVEM B,SAVEB		;SAVE ACS B-D FOR FREDN
		  MOVEM C,SAVEC		;
		  MOVEM D,SAVED		;
		  MOVE  C, 1(D)		;LOAD WITH STATUS
		  MOVE	D,TB$EDT(B)	;LOAD D WITH EDIT NAME
		  JRST CPOPJ1  ]	;TAKE GOOD RETURN
FRED2A:	SOJLE	C,FRED3			;ANY MORE A.E.S THIS BLOCK?
	ADDI	D,AESIZ			;YES,GET NEXT
	JRST	FRED2			;

FRED3:	PUSH	P,A			;SAVE A,B
	PUSH	P,B			;OVER CALL TO COUNT
	MOVE	A,TB$HED(B)		;GET HEADER
	PUSHJ	P,COUNT			;AND COUNT WORDS TO SKIP
	ADD	B,0(P)			;
	AOS	B
	POP	P,A
	POP	P,A			;CLEAR STACK,RESTORE A
	CAMG	B,T			;ARE WE DONE?
	JRST	FRED1			;NO,SO EXAMINE THIS BLOCK

FRED4:	CAMN	T,ETBLOC		;END OF ORIG TRACE CODE?
	SKIPN	T,TRCPTR		;AND HAVE NEW TRACE CODE?
	POPJ	P,			;NO,WE ARE DONE.
	MOVEI	B,TRCBLK		;LOAD B WITH ADDRESS OF NEW STUFF
	SUBI	T,2			;ADJUST POINTER
	CAMLE	B,T			;IS ONLY NEW T.B. CURRENT T.B.?
	POPJ	P,			;YES,SO DONT EXAMINE IT
	JRST	FRED1			;NO, PROCESS IT

					;ALTERNATE ENTRY FOR NEXT EDIT
FREDN:	MOVE	B,SAVEB			;RESTORE B-D
	MOVE	C,SAVEC
	MOVE	D,SAVED
	JRST	FRED2A			;CONTINUE
SUBTTL END OF CONDITIONAL (IFN FTBPT)

> ;NFI FTBPT
SUBTTL	MAKLIB IO SUBROUTINES

;ROUTINES TO COPY FILES, COPY UP TO A GIVEN PROGRAM IN A FILE
;AND TO FIND A GIVEN PROGRAM IN A FILE AND COPY IT.

;THE COPY ROUTINE WILL COPY BINARY PROGRAMS FROM WHEREVER THE
;INPUT DEVICE HAPPENS TO BE WHEN IT IS CALLED, UP TO THE
;END OF FILE. SINCE COPY IS CALLED WITH A PUSHJ, THE END-OF-
;FILE EXIT IN INGET WILL EXIT TO THE PLACE THAT CALLED COPY.

COPY:	PUSHJ	P, READ		;READ A PROGRAM
	POPJ	P,		;EXIT WHEN ALL THROUGH FILE
	PUSHJ	P, WRITE	;WRITE OUT THE PROGRAM
	JRST	COPY		;RETURN FOR MORE PROGRAMS

;THE COPYTO ROUTINE WILL READ AND WRITE PROGRAMS FROM THE
;INPUT DEVICE UNTIL THE PROGRAM WHOSE NAME IS IN ACCUMULATOR
;R IS FOUND, AT WHICH TIME IT EXITS

COPYTO:	PUSHJ	P,RAD50		;CHANGE NAME TO RADIX 50
COPYT1:	PUSHJ	P, READ		;READ A PROGRAM
	JRST	MNFERR		;EOF - MODULE NOT FOUND ERROR
	CAMN	R, A		;IS IT THE CORRECT PROGRAM?
	POPJ	P,		;YES, EXIT
	PUSHJ	P, WRITE	;NO, WRITE IT OUT
	JRST	COPYT1		;READ SOME MORE PROGRAMS
;THE FINDCP ROUTINE WILL SEARCH THE INPUT FILE FOR A PROGRAM
;WHOSE NAME IS IN ACCUMULATOR R, AND HAVING FOUND IT, WILL
;WRITE IT OUT. IF THE CONTENTS OF AC R ARE ZERO, THE ENTIRE
;FILE IS COPIED.

FINDCP:	JUMPE	R, COPY		;COPY ENTIRE FILE?
	PUSHJ	P,RAD50		;CONVERT NAME TO RADIX 50
FIND1:	PUSHJ	P, READ		;READ A PROGRAM FROM INPUT FILE
	JRST	MNFERR		;EOF, TRY REWINDING AND TRYING AGAIN
	CAME	R, A		;IS THIS THE RIGHT ONE?
	JRST	FIND1		;NO, TRY AGAIN
	JRST	WRITE		;YES, WRITE IT OUT AND EXIT

;ROUTINE MSTGET RETRIEVES A PROGRAM NAME FROM THE MASTER
;DEVICE SPECIFICATIONS. IT SAVES THE POINTER IN FILBUF, 
;CHANGES IT TO POINT TO ITS OWN BLOCK, THEN CALLS GETDEV

MSTGET:	MOVE	FPT, INBEG	;GET THE POINTER TO CURRENT FILE
	MOVEI	IOC,MIN		;SET FOR INPUT ON MASTER CHANNEL
	JRST	GETDEV		;CALL COMMON ROUTINE


;ROUTINE TRNGET RETRIEVES A PROGRAM NAME FROM THE TRANSACTION
;FILES. IT RESETS THE POINTER THAT MSTGET WIPED OUT, AND CALLS
;THE COMMON PROGRAM RETRIEVAL PROGRAM GETDEV.

TRNGET:	MOVE	FPT, WLDTMP	;GET SAVED POINTER
	CAMN	FPT,INBEG	;IS THIS REALLY THE MASTER FILE?
	JRST	CPOPJ		;YES-LOSE NOW
	MOVEI	IOC,TRIN	;INPUT ON TRANSACTION CHANNEL
	JRST	GETDEV		;CALL COMMON ROUTINE
GETDEV:	DPB	IOC,[POINT 4,INGET2,12]	;STORE CHAN NR. FOR IN UUO
	DPB	IOC,[POINT 4,INGET3,12]	;AND FOR STATUS READING UUO
	MOVEI	T,MBUF+1	;START WITH MASTER FILE BUFFER
	CAIE	IOC,MIN		;IS IT REALLY MASTER?
	MOVEI	T,TBUF+1	;NO,ITS TRANSACTION
	MOVEM	T,IBUF1		;STORE LOCATION OF INPUT BYTE POINTER
	AOS	T
	MOVEM	T,IBUF2		;AND CURRENT BYTE COUNTER TOO.
	SETZ	R,		;IN CASE OF NO PROGRAM NAMES
	HLRZ	T2,.FXLEN(FPT)	;GET COUNT OF PROG NAMES
	JUMPE	T2,CPOPJ1	;RETURN WITH R=0 IF NONE
	CAIN	IOC,TRIN	;DID WE COME HERE FROM TRNGET?
	JRST	GET1		;YES SO USE DIFFERENT COUNTER
	CAMG	T2,NAMCTR	;ANY MORE NAMES TO RETURN?
	POPJ	P,		;NO MORE
	MOVEI	T2,.FXPRG(FPT)	;GET POINTER TO BASE OF NAMES
	ADD	T2,NAMCTR	;INDEX TO CURRENT NAME
	MOVE	R,(T2)		;RETURN NAME IN R
	AOS	NAMCTR		;INCREMENT COUNTER
	JRST 	CPOPJ1		;GOOD RETURN

GET1:	CAMG	T2,TNMCTR	;MORE TRANS NAMES TO RETURN?
	PUSHJ	P,GET2		;MAYBE SOME IN ANOTHER FILE
	MOVEI	T2,.FXPRG(FPT)	;GET POINTER TO BASE OF TRN NAMES
	ADD	T2,TNMCTR	;INDEX TO CURRENT NAME
	MOVE	R,(T2)		;RETURN THE NAME IN R
	AOS	TNMCTR		;INCREMENT THE COUNTER
	JRST	CPOPJ1		;SKIP RETURN

GET2:	CAMN	FPT,INEND	;ARE THERE MORE TRANS FILES?
	JRST	POPOUT		;NO MORE--NON SKIP RETURN
GET2A:	PUSHJ	P,TRNCLS	;[70] CLOSE CURRENT TRANS FILE
	MOVE	T1,[4,,[INBEG,,INEND
			OPNBLK,,LKPBLK
			FSSIZE,,.RBSIZ+1
			WLDTMP+1B0]]
	PUSHJ	P,.LKWLD##	;WILD LOOKUP FOR NEXT TRANS FILE
	JFCL
	SETZM	TNMCTR		;CLEAR COUNTER
	MOVX	T1,.IOBIN	;ASSUME BINARY INPUT
	DPB	T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
	MOVEI	T1,TBUF		;BUFFER HEADER POINTER
	MOVEM	T1,OPNBLK+.OPBUF	;PUT THIS STUFF IN THE OPEN BLOCK
	OPEN	TRIN,OPNBLK	;OPEN A NEW TRANS FILE CHANNEL
	   JRST  OPNFAI
	LOOKUP	TRIN,LKPBLK	;LOOKUP THE NEW TRANS FILE
	   JRST  LKPFAI		;LOOKUP FAILED
	INBUF	TRIN,		;SET UP BUFFER
	PUSHJ	P,.CHKTM##	;[70] CHECK /SINCE,/BEFORE,ETC
	  JRST	GET2A		;[70] DIDN'T MEET CONDITIONS
	MOVE	FPT,WLDTMP	;SET UP FILE POINTER
	JRST	CPOPJ		;GO BACK TO GETDEV CODE
CPOPJ1:	AOSA	(P)		;GOOD RETURN
POPOUT:	POP	P,(P)		;POP UP ONE LEVEL
CPOPJ:	POPJ	P,		;EXIT
SUBTTL ROUTINE TO INPUT ONE PROGRAM AT A TIME
;THE FIRST WORD THAT THE PROGRAM READS WILL BE A BLOCK HEADER.
;BLOCKS ARE READ UNTIL AN ENTRY BLOCK IS FOUND, AND THE ENTIRE
;ENTRY BLOCK IS STORED IN AN INTERNAL BUFFER,SIZE PERMITTING.
;FOLLOWING THAT, THE NAME BLOCK IS READ, AND THE NAME OF THE 
;PROGRAM IS RETURNED IN ACCUMULATOR A. PROVISION IS MADE FOR
;BLOCKS OF WORD COUNT ZERO. THE SECTION OF CODING AROUND READ2
;DELIBERATELY OMITS THIS CHECK IN ORDER TO READ IN THE NEXT
;BLOCK HEADER WITH A MINIMUM OF INSTRUCTIONS. ORDINARILY, EACH
;PROGRAM WILL BEGIN WITH AN ENTRY BLOCK, BUT THE ROUTINE WILL
;ALSO ALLOW THE PROGRAM TO BEGIN WITH A NAME BLOCK IF NO
;ENTRY BLOCK IS SEEN.

READ:	MOVEI	C,ENTBLK	;SET UP POINTER TO BUFFER

READ1:	PUSHJ	P,GETIN		;GET A BLOCK HEADER
	HLRZ	B, A		;GET THE BLOCK CODE
	CAILE	B,3777		;IS IT ASCIZ TEXT BLOCK?
	JRST	READ17		;YES,HANDLE IT DIFFERENTLY
	MOVSI	T,-BLKTYL	;MAKE UP AOBJN POINTER
READ2B:	CAMN	B,BLKTYP(T)	;SEARCH THE TABLE OF BLOCKTYPES AND COMPARE
	JRST	@RTABLE(T)	;FOUND A MATCH--GO PROCESS IT
	AOBJN	T,READ2B	;NOT  END YET--KEEP SEARCHING
	CAIG	B,37		;TEST FOR LEGAL BLOCKTYPES
	JRST	READ2D		; THESE ARE CLEARLY LEGAL
	CAIN	B,100		;IS IT A REL BLOCK TYPE 100 (.ASSIGN)?
	 JRST	READ2D		;YES, PROCESS AS A LEGAL BLOCK TYPE
	CAIL	B,1000		;IF 1000-1777 ALSO LEGAL
	CAILE	B,1777		;NEW TYPES
	JRST	IBTERR		;ELSE ITS AN ERROR
READ2D:	PUSHJ	P, COUNT	;CALCULATE SIZE OF BLOCK
	JUMPE	B, READ1	;WORD COUNT OF ZERO?
READ2:	CAML	B,@IBUF2	;DOES BLOCK OVERLAP IO BUFFERS?
	JRST	READ3		;ADJUST B AND GET ANOTHER BUFFER
	MOVE	A,@IBUF2	;NO, DIDDLE BUFFER HEADER COUNT
	SUB	A, B		;ELIMINATE BLOCK OF LENGTH C(B)
	MOVEM	A,@IBUF2	;PUT NEW WORD COUNT BACK
	ADDM	B,@IBUF1	;MOVE BYTE POINTER PAST BLOCK
	JRST	READ1		;GET NEXT BLOCK
READ3:	SUB	B,@IBUF2	;ACCOUNT FOR REST OF THIS BUFFER
	SETZM	@IBUF2		;FORCE ANOTHER BUFFER
	PUSHJ	P,GETIN		;GET ANOTHER BUFFER OF INPUT
	JRST	READ2		;CHECK AGAIN

;CODE MODIFIED TO HANDLE MORE THAN ONE ENTRY BLOCK.
;FAIL AND SAIL BOTH ISSUE MULTIPLE ENTRY BLOCKS.

SIZZ==SIZE-<<SIZE+21>/22>-4	;ACCOUNT FOR HDR BLKS, RELOC WDRS, PROGNAME
READ4:	SETZM	ENTBLK		;SAME AS (C) AT PRESENT
	HRLI	C,-1		;AOBJN WILL OVERFLOW FIRST TIME
	TRNE	A,-1		;TEST FOR ZERO WORD COUNT
	JRST	READ5		;NO
	PUSHJ	P,GETIN		;YES, THROW AWAY RELOCATION WORD
	ADDI	C,1		;UPDATE INSERT COUNTER
	SETZB	A,(C)		;ENTRY BLOCK RELOCATION IS ALWAYS ZERO

;BACK HERE FOR EACH NEW BLOCK

READ5:	MOVNI	B,400000(A)	;-1 IN LH, 377777-CT IN RH
	HRRZS	A
	ADD	A,ENTBLK	;NEW COUNT IF IT FITS
	CAILE	A,SIZZ		;TOO MUCH NOW?
	TXOA	F,ERRB		;YES, MARK ENTRY BLOCK TOO BIG
	MOVEM	A,ENTBLK	;NO, UPDATE USED COUNT
;HERE FOR EACH NEW WORD
READ6:	TRNN	B,377777	;END OF LOADER BLOCK?
	JRST	READ8		;YES, CHECK NEXT
	AOBJN	B,NXTWRD	;TIME FOR SOME RELOC BITS?
	PUSHJ	P,GETIN		;YES, GET THEN AND TOSS THEM AWAY
	HRLI	B,-22		;AND RESET COUNT
NXTWRD:	PUSHJ	P,GETIN		;GET A DATA WORD
;ROUTINE TAKEN FROM LOADER
	AOBJN	C,READ7		;NEED TO INSERT RELOC WORD?
	TXNN	F,ERRB		;YES, UNLESS NOT INSERTING
	SETZM	(C)		;ALL ENTRY RELOCS ARE 0
	ADD	C,[-22,,1]	;LH 0 BEFORE ADD, SET UP NEXT
READ7:	TXNN	F,ERRB		;ARE WE INSERTING?
	MOVEM	A,(C)		;YES, PUT IT AWAY
	JRST	READ6		;LOOP

READ8:	PUSHJ	P,GETIN		;GET NEXT HEADER WORD
	HLRZ	B,A		;TYPE
	CAIN	B,4		;ANOTHER ENTRY?
	JRST	READ5		;YES, STORE IT

;PROGRAM NAME - FINISH ENTRY OUT
	MOVEI	B,4		;ENTRY BLOCK TYPE
	HRLM	B,ENTBLK	;NOW CORRECT TYPE,,COUNT
	HRLI	C,0		;CLEAR LH COUNT
	AOJA	C,READ9		;STORE NAME BLOCK HEADER AND CONTINUE
READ9:	MOVEM	A, (C)		;STORE NAME BLOCK HEADER
	ADDI	C,1
	PUSHJ	P, COUNT	;CALCULATE SIZE OF BLOCK
	JUMPE	B, READ13	;WORD COUNT OF ZERO?
	HRROI	A,-2		;SECOND WORD READ WILL BE
	MOVEM	A,MCOUNT	;WILL BE PROGRAM NAME
READ11:	PUSHJ	P,GETIN		;GET A WORD
	MOVEM	A, (C)		;STORE IT
	AOSN	MCOUNT		;IF SECOND WORD READ,
	MOVEM	A,TMPMOD	;STORE MODULE NAME
	AOJ	C,		;INCREMENT BUFFER POINTER
	SOJG	B,READ11	;DONE READING YET?
	PUSHJ	P,READ18	;FILTER OUT NULLS FROM PROGRAM NAME
	MOVE	A,TMPMOD	;AND USE FILTERED NAME
READ13:	MOVE	N,A		;SET UP FOR PRINT OUT
	TXNE	F, ERRB		;ERROR CONDITION?
	$KILL(ETL,ENTRY block is too large to read in for module,N$50)
	TXNN	F,XFLG		;INDEX FLAG ON?
	JRST	CPOPJ1		;NO, SKIP EXIT
	JRST	INDEX1		;YES SAVE ENTRIES

READ14:	TXO	F,F4IB		;DONT OUTPUT DURING F4 SEARCH
	PUSH	P,C		;SAVE ENTRY BLOCK
	PUSHJ	P,F4		;PASS F4 BLOCKS
	POP	P,C		;RESTORE ENTRY BLOCK
	TXZ	F,F4IB		;TURN OFF IGNORE BIT
	HRRZM	C,END1		;FORTRAN CANNOT DO ANY BETTER
	SETZM	END2		;CLEAR FIRST TIME FLAG
	JRST	READ1		;GO PROCESS NEXT PROGRAM

READ15:	PUSHJ	P,COUNT		;GET SIZE OF BLOCK
	SETZM	END1		;CLEAR STORAGE
	SETZM	END2
	SOJE	B,READ1		;SHOULD N'T BE
	PUSHJ	P,GETIN		;GET RID OF BYTE WORD
	PUSHJ	P,GETIN		;GET FIRST END WORD
	HRLZM	A,END1		;STORE IT
	SOJE	B,READ1		;ONLY ONE WORD?
	PUSHJ	P,GETIN		;NO
	HRLZM	A,END2		;STORE 2ND
	SOJE	B,READ1		;SHOULD BE END
	JRST	READ2		;JUST IN CASE

READ16:	TXOE	F,NOWARN	;DO WE WANT A MESSAGE?
	JRST	RD16B		;SKIP MESSAGE
	$WARN(NIO,OUTPUT file ,,$MORE)
	MOVEI	T1,BCKBLK	;POINT TO SAVED OUTPUT SPEC
	MOVEI	T2,BCKBLK+3	;T1/OPEN INFO  T2/FILE INFO
	PUSHJ	P,.TOLEB##	;AND TELL USER
	MOVEI	T1,[ASCIZ " will not be INDEXed"]
	PUSHJ	P,.TSTRG##	;OUTPUT REST OF LINE
X$$NIO:	PUSHJ	P,.TCRLF##	;FINISH MESSAGE
	TXZ	F,FOTTY		;NO MORE FORCED IO TO TELETYPE
RD16B:	SETZM	@IBUF2		;FORCE NEXT BUFFER
	PUSHJ	P,GETIN		;INPUT THE NEXT BLOCK
	JRST	READ1+1		;AND RETURN TO CODE
READ17:	ANDI	A,376		;[64] GET RID OF ALL BUT LAST BYTE (376 NOT 177)
	JUMPE	A,READ1		;IF STRING EXHAUSTED,GET NEXT BLOCK
	PUSHJ	P,GETIN		;ELSE GET THE NEXT BYTE
	JRST	READ17		;AND REPEAT LOOP

READ18:	PUSH	P,T1		;GET A REGISTER TO COUNT IN
	MOVEI	T1,1		;FOR KEEPING RADIX POSITION STRAIGHT
	MOVE	A,TMPMOD	;GET UNFILTERED PROGRAM NAME
	SETZM	TMPMOD		;CLEAR RESULT
RD18A:	JUMPE	A,T1POPJ	;RETURN IF DONE, RESTORING TEMP AC
	IDIVI	A,50		;GET A CHARACTER
	JUMPE	B,RD18A		;IF NULL, THROW IT OUT
	IMUL	B,T1		;GET INTO RIGHT POSITION
	ADDM	B,TMPMOD	;AND STORE INTO RESULT
	IMULI	T1,50		;FOR NEXT DIGIT,GET POSITION RIGHT
	JRST	RD18A		;REPEAT AGAIN
;BLKTYP IS A TABLE OF LEGAL BLOCKTYPES RECOGNIZED BY FUDGE.
;WHEN A MATCH BETWEEN THE CODE IN THE LEFT HALF OF THE BLOCK
;HEADER AND A VALUE IN THE TABLE IS FOUND THE 
;CORRESPONDING PART OF THE READ ROUTINE IS JUMPED TO.
;RTABLE IS A TABLE OF LABELS FOR THE APPROPRIATE SECTIONS OF CODE
;IN THE READ ROUTINE. THESE SECTIONS OF CODE ARE ACCESSED BY A
;JRST @RTABLE(T) WHERE T IS USED AS AN INDEX.

BLKTYP:	EXP	14		;INDEX BLOCK
	EXP	4		;ENTRY BLOCK
	EXP	1001		;ENTRY BLOCK
	EXP	1002		;LONG ENTRY BLOCK
	EXP	6		;NAME BLOCK
	EXP	1003		;NAME BLOCK
	EXP	401		;SPECIAL MANTIS(F40)DEBUGGER
	EXP	400		;FORTRAN 4 SIGNAL WORD
	EXP	5		;END BLOCK
	EXP	1040		;END BLOCK
BLKTYL==	.-BLKTYP		; TABLE LENGTH

RTABLE:	READ16
	READ4
	READ4
	READ4
	READ9
	READ9
	READ14
	READ14
	READ15
	READ15
SUBTTL ROUTINE TO OUTPUT ONE PROGRAM AT A TIME
;THE WRITE SUBROUTINE WILL OUTPUT AN ENTIRE BINARY RE-
;LOCATABLE PROGRAM AS WRITTEN BY MACRO6. IT ASSUMES THAT THE
;ENTRY BLOCK AND NAME BLOCK FOR THE PROGRAM ARE IN THE
;INTERNAL BUFFER ENTBLK, AND OUTPUTS THESE BEFORE PICKING UP
;MORE BLOCKS FROM THE CURRENT INPUT DEVICE. BLOCKS ARE READ
;AND WRITTEN UNTIL THE END BLOCK HAS BEEN PROCESSED. PROVISION I
;IS MADE FOR BLOCKS WITH A WORD COUNT OF ZERO.

WRITE:	SUBI	C, ENTBLK	;GET COUNT OF ENTRY BLOCK
	JUMPE	C, WRITE3	;NOTHING TO OUTPUT?
	MOVEI	B, ENTBLK	;GET A POINTER IN B
WRITE2:	MOVE	T1, (B)		;GET A BINARY WORD
	PUSHJ	P, BOUT		;OUTPUT IT
	AOJ	B,		;INCREMENT POINTER
	SOJG	C, WRITE2	;KEEP GOING UNTIL BUFFER EMPTY
WRITE3:	PUSHJ	P,GETIN		;GET A BLOCK HEADER
	HLRZ	B,A		;GET THE BLOCK TYPE CODE 
	TXNN	F,NOLOCB	;DELETE LOCAL SYMBOLS? 
	JRST	.+3		;NO
	CAIN	B,2		;IS IT A SYMBOL BLOCK? 
	JRST	DELLOC		;GO DELETE LOCAL SYMBOL 
				;COME BACK TO WRITE3 
				;UNLESS EXIT ON END-OF-FILE 

	MOVE	T1,A
	PUSHJ	P,BOUT		;OUTPUT IT
	CAIE	B, 401		;SPECIAL MANTIS F4?
	CAIN	B, 400		;IS THIS A FORTRAN IV SIGNAL WORD?
	JRST	F4		;YES, PROCESS F4 OUTPUT
	CAILE	B,3777		;IS THIS ASCIZ TEXT?
	JRST	WRITE5		;YES,HANDLE SPECIALLY
	MOVEM	B, SAVEBT	;SAVE THE BLOCK TYPE
	PUSHJ	P, COUNT	;NO, GET SIZE OF BLOCK
	JUMPE	B, WRITE3	;WORD COUNT OF ZERO?
WRITE4:	PUSHJ	P,GETIN		;OUTPUT THE BLOCK
	MOVE	T1,A
	PUSHJ	P, BOUT		;...
	SOJG	B, WRITE4	;LOOP BACK UNTIL DONE
	MOVE	A, SAVEBT	;RETRIEVE THE BLOCK TYPE
	CAIE	A,1040		;WAS IT AN END BLOCK?
	CAIN	A, 5		;WAS IT AN END BLOCK?
	POPJ	P,		;EXIT
	JRST	WRITE3		;NO, RETURN FOR MORE BLOCKS

WRITE5:	ANDI	A,177		;DISCARD ALL BUT LAST BYTE
	JUMPE	A,WRITE3	;IF NULL, WE ARE DONE
	PUSHJ	P,GETIN		;ELSE GET NEXT WORD
	MOVE	T1,A		;AND THEN WRITE
	PUSHJ	P,BOUT		;IT OUT ,THEN REPEAT 
	JRST	WRITE5		;LOOP
; /COUNT/ - THIS ROUTINE CALCULATES THE LENGTH OF THE VARIOUS BLOCKS
; USED BY THE TRANSLATORS. THE ROUTINE ESSENTIALLY JUST RETURNS
; THE CONTENTS OF THE RIGHT HALF OF THE HEADER WORD FOR 
; NEW LINK ITEM TYPES (1000-3777) AND RETURNS A COUNT ADJUSTED FOR
; HIDDEN RELOCATION WORDS FOR OLD LINK ITEM TYPES (0-777).
;
; INPUT-	AC A SHOULD CONTAIN THE CONTENTS OF THE
;		BLOCK HEADER WORD
;
; OUTPUT- 	AC B WILL CONTAIN THE POSITIVE NUMBER OF
;		WORDS THAT FOLLOW THE BLOCK HEADER WORD.
;

COUNT:	PUSH	P,A		;SAVE HEADER
	JUMPE	A,CEXIT		;ZERO WORD HAS ZERO LENGTH
	HLRZ	B,A		;GET TYPE INTO B
	HRRZS	A		;A GETS RAW WORD COUNT
	CAILE	B,3777		;IN RANGE OF REASON?
	$STPCD(Attempt to compute length of ASCIZ text block)
	CAIE	B,14		;IS THIS INDEX TYPE BLOCK OR
	CAIL	B,1000		;NEW LINK TYPE?
	JRST	CEXIT		;YES, HEADER COUNT ALREADY CORRECT
	CAIG	A,22		;IF LE 18 WORDS, JUST
	AOJA	A,CEXIT		;ADD ONE AND EXIT
	IDIVI	A, 22		;1 SUBHEADER PER 18 DATA WORDS
	SKIPE	B		;IF REMAINDER,
	ADDI	A,1		;ROUND UP
	HRRZ	B,0(P)		;ADD TO RAW COUNT
	ADDI	A,0(B)		;TO GET ADJ TOTAL
CEXIT:	MOVE	B, A		;RESULTS IN AC B
	POP	P,A		;RESTORE HEADER
	POPJ	P,		;EXIT
SUBTTL ROUTINE TO HANDLE FORTRAN OUTPUT

;SUBSECTION OF THE WRITE ROUTINE TO HANDLE OUTPUT FROM THE
;FORTRAN IV COMPILER. THE MAIN OBJECT OF THE ROUTINE IS TO
;LOOK FOR THE END BLOCK. OTHER BLOCKS ARE MERELY COPIED OUT.
;THE BLOCK TYPES ARE GIVEN BY THE FOLLOWING TABLE
;----------------------------------------------------------------
;BITS 0-17	BITS18-23	BITS 24-35		TYPE

;777777		70		N	   DATA STATEMENT
;777777		50		N	    ABSOLUTE MACHINE CODE
;777777		77		N	   MANTIS DATA
;777777		0		-	    PROGRAMMER LABELS
;777777		31		-	    MADE LABELS
;777777		60		-	    ENTRY LABELS
;777777			777776		    END BLOCK
;-----------------------------------------------------------------
F4:	PUSHJ	P,GETIN		;GET A FORTRAN IV BLOCK HEADER
	PUSHJ	P, OUT4		;OUTPUT IT
	TLC	A, -1		;TURN ONES TO ZEROES IN LEFT HALF
	TLNE	A, -1		;NO, WAS LEFT HALF ALL ONES?
	JRST	F4		;NO, IT WAS CALCULATED MACHINE CODE
	CAIN	A, -2		;YES, IS RIGHT HALF = 777776?
	JRST	ENDST		;YES, PROCESS F4 END BLOCK
	LDB	B, [POINT 6,A,23];GET CODE BITS FROM BITS 18-23
	TRZ	A, 770000	;THEN WIPE THEM OUT
	CAIE	B, 70		;IS IT A DATA STATEMENT?
	CAIN	B, 50		;IS IT ABSOLUTE MACHINE CODE?
	JRST	MACHCD		;YES, TREAT IT LIKE DATA STATEMENTS
	CAIN	B, 77		;SPECIAL MANTIS DEBUGGER DATA?
	JRST	MACHCD		;YES, TREAT IT LIKE DATA
	PUSHJ	P,GETIN		;NO, ITS A LABEL OF SOME SORT
	PUSHJ	P, OUT4		;WHICH CONSISTS OF ONE WORD
	JRST	F4		;LOOK FOR NEXT BLOCK HEADER

MACHCD:	HRRZ	B, A		;GET THE WORD COUNT IN AC B
	PUSHJ	P,GETIN		;INPUT A WORD
	PUSHJ	P, OUT4		;OUTPUT IT

	SOJG	B, MACHCD+1	; LOOP BACK FOR REST OF THE BLOCK
	JRST	F4		;GO LOOK FOR NEXT BLOCK

ENDST:	MOVEI	B,1		;TWO WORDS, FIVE TABLES, ONE WORD, ONE TABLE
	MOVEI	C,6		;TO GO
F4LUP1:	PUSHJ	P,GETIN		;GET TABLE MEMBER
F4LUP3:	PUSHJ	P,OUT4		;OUTPUT WORD
	SOJGE	B,F4LUP1	;LOOP WITHIN A TABLE
	JUMPL	C,CPOPJ		;LAST TABLE - RETURN
	SOJG	C,F4LUP2	;FIRST TWO WORDS AND FIVE TABLES
	JUMPE	C,F4LUP1	;COMMON LENGTH WORD
F4LUP2:	PUSHJ	P,GETIN		;READ HEADER WORD
	MOVE	B,A		;COUNT TO COUNTER
	JRST	F4LUP3		;STASH

OUT4:	MOVE	T1,A		;GET WORD INTO OUTPUT POSITION
	TXNN	F,F4IB		;DONT DO OUTPUT?
	PUSHJ	P,BOUT		;YES, DO OUTPUT
	POPJ	P,		;RETURN
SUBTTL ROUTINE TO DELETE LOCAL SYMBOLS FROM SYMBOL BLOCK

;ALL LOCAL AND SUPPRESSED LOCAL SYMBOLS ARE DELETED
;EXTERNALS,INTERNAL AND SUPPRESSED INTERNALS ARE NOT DELETED.

DELLOC:	HRRZM	A,BSZ		;SIZE OF SYMBOL BBLE
	PUSHJ	P,DELINI	;CLEAR NEW HEADER & RELOC WORDS
				;SET PB = SYMBLK+2
DELGTR:	PUSHJ	P,GETIN		;GET RELOCATION WORD
	MOVEM	A,RELOCS	;SAVE IT
	MOVE	A,[POINT 4,RELOCS] ;INIT POINTER TO GET
	MOVEM	A,PTGRS		;RELOCATION WORD

DELGT1:	PUSHJ	P,GETIN		;GET FIRST WORD OF PAIR
	ILDB	B,PTGRS		;GET RELOCATION BITS & HOLD
	TXNE	A,R5.LCL	;IS SYMBOL LOCAL?
	JRST	DELDEC		;YES, DON'T COPY
	MOVEM	A,0(T)		;STORE FIRST WORD
	PUSHJ	P,GETIN		;GET SECOND WORD INTO A
	MOVEM	A,1(T)		;STORE SECOND WORD
	IDPB	B,PTSRS		;STORE RELOCATION BITS
	MOVEI	A,2		;COUNT WORDS STORED
	ADDM	A,SYMBLK	;I.E. UPDATE WORD COUNT
	ADDI	T,2		;UPDATE NEXT LOCATION TO STORE
	MOVE	A,PTSRS		;HAVE WE STORED 9
	TLNN	A,770000	;SYMBOL PAIRS?
	PUSHJ	P,DELWRT	;YES, WRITE IT OUT
	JRST	DELDEC+1	;ALREADY HAVE 2ND WORD

DELDEC:	PUSHJ	P,GETIN		;GET SECOND WORD INTO A
	SOS	BSZ		;HAVE WE EXHAUSTED
	SOSG	BSZ		;ALL WORDS IN BLOCK?
	JRST	DELFIN		;YES, NONE LEFT
	MOVE	A,PTGRS		;HAVE WE GOT 9
	TLNE	A,770000	;SYMBOL PAIRS YET?
	JRST	DELGT1		;NO, GET NEXT PAIR
	JRST	DELGTR		;YES, GET RELOCATION

DELFIN:	PUSHJ	P,DELWRT	;ORIGINAL BLOCK EMPTY NOW
	JRST	WRITE3		;GET NEXT BLOCK
SUBTTL ROUTINE TO WRITE OUT NEW SYMBOL TABLE

DELWRT:	SKIPN	A,SYMBLK	;ANYTHING TO WRITE
	JRST	DELINI		;NO, CAN LEAVE
	HRRZ	C,A		;GET WORD COUNT
	HRLI	A,2		;PUT IN BLOCK TYPE
	MOVE	T1,A		;INTO OUTPUT POSITION
	PUSHJ	P,BOUT		;WRITE BLOCK HEADER
	MOVEI	B,SYMBLK	;LOC OF FIRST WORD
DELWRU:	ADDI	B,1		;LOC OF RELOC WORD
	MOVE	T1,0(B)		;GET WORD
	PUSHJ	P,BOUT		;OUTPUT
	SOJGE	C,DELWRU	;ALL THROUGH?

;ROUTINE TO INITIALIZE NEW SYMBOL TABLE
DELINI:	SETZM	SYMBLK		;YES, CLEAR COUNT
	SETZM	SYMBLK+1	;CLEAR RELOCATION
	MOVE	A,[POINT 4,SYMBLK+1]	;INIT POINTER
	MOVEM	A,PTSRS		;FOR STORING NEW RELOC
	MOVEI	T,SYMBLK+2	;SET TO STORE FIRST GLOBAL
	POPJ	P,
SUBTTL ROUTINES TO INDEX THE LIBRARY

COMMENT	*	THE INDEXING OF LIBRARY FILES IS DONE IN TWO PASSES.
	ON PASS 1 THE LIBRARY FILE IS COPIED AND ALL ENTRIES STORED
	IN CORE ALLONG WITH A POINTER TO THE BEGINING OF THE BLOCK.
	A DUMMY INDEX BLOCK (TYPE 14) IS OUTPUT AT THE BEGINING OF THE
	NEW LIBRARY AND ONE IS OUTPUT WHENEVER THE CURRENT INDEX BLOCK
	FILLS A BUFFER.
	ON PASS 2 THE DUMMY INDEX BLOCKS ARE REPLACED BY REAL ONES.
	MAKLIB USED USETO'S AND DUMP MODE.
	IF THE OUTPUT DEVICE IS DTA MAKLIB USES UGETF UUO'S TO FIND
	THE NEXT BLOCK AND NON-STANDARD DUMP MODE TO WRITE THE INDICES.
	DESIGN AND CODING BY D.M.NIXON JULY 1970
*

INDEX0:	MOVE	A,INDEXH	;BLOCK HEADER
	TXNE	F,DTAFLG	;DTA IS 1 WORD LESS
	SUBI	A,1
	AOS	BLKCNT		;START ON BLOCK #1
	MOVE	T1,A
	PUSHJ	P,BOUT		;OUTPUT IT
	OUTPUT	OCHN,		;FORCE OUTPUT
	MOVE	T,OBUF+2	;BUFFER SIZE
	MOVEM	T,XCOUNT
	MOVEM	T,BUFSIZ	;SAVE IT AWAY
	AOS	OBUF+2 		;COUNT IS OFF BY ONE BECAUSE OF OUT UUO
	AOS	T,.JBREL	;TO GET 1K MORE
	MOVEM	T,XPNTR
	MOVEM	T,XBEG		;START OF INDEX BUFFERS
	CORE	T,
	JRST	NECERR		;NOT ENUF CORE
	MOVEI	A,1		;START ON BLOCK #1 (IF DSK)
	MOVEM	A,@XPNTR	;STORE FIRST BLOCK #
	AOS	XPNTR
	MOVE	A,INDEXH
	MOVEM	A,@XPNTR
	AOS	XPNTR
	SOS	XCOUNT
	SOS	XCOUNT		;RESERVE SPACE FOR NEXT LINK WORD
	POPJ	P,		;RETURN
;HERE ON PASS 1 TO STORE ENTRIES AND POINTERS.

INDEX1:	AOS	(P)		;SET SKIP RETURN
	HRRZ	T,ENTBLK	;GET SIZE OF BLOCK
	JUMPE	T,CPOPJ		;IF NO ENTRIES, JUST RETURN
	MOVN	A,T
	ADDI	T,1		;WORD OF INFO
	CAML	T,XCOUNT	;ENUF ROOM IN BLOCK?
	JRST	NOROOM		;NO
	MOVE	T,ENTBLK	;GET HEADER WORD
	MOVEM	T,@XPNTR
	AOS	XPNTR
	SOS	XCOUNT
	HRLS	A
	HRRI	A,ENTBLK+1
INDEXA:	SKIPN	T,(A)
	AOJA	A,.-1
	MOVEM	T,@XPNTR
	SOS	XCOUNT
	AOS	XPNTR
	AOBJN	A,INDEXA
INDEX2:	MOVE	T,BUFSIZ
	SUB	T,OBUF+2
	HRLI	T,1(T)		;WORD COUNT IS CORRECT FOR LOADER
	HRR	T,BLKCNT
	MOVEM	T,@XPNTR
	SOS	XCOUNT
	AOS	XPNTR
	POPJ	P,

;HERE WHEN CURRENT INDEX BLOCK IS FULL.

NOROOM:	MOVE	A,INDEXH	;HEADER BLOCK OF INDEX FOR LOADER
	TXNE	F,DTAFLG	;DTA IS 1 WORD LESS
	SUBI	A,1
	MOVE	T1,A
	PUSHJ	P,BOUTGO
	OUTPUT	OCHN,
	AOS	OBUF+2		;COUNT IS OUT BY ONE BECAUSE OF OUTPUT UUO
	MOVE	T,BLKCNT	;GET INDEX BLOCK #
	HRROM	T,@XPNTR	;STORE IT WITH -1 IN LEFT HALF
	MOVE	A,XCOUNT	;PART OF BLOCK NOT FILLED
	ADDB	A,XPNTR		;START OF NEW BLOCK
	ADD	A,BUFSIZ	;ENSURE NEXT BUFFER WILL FIT IN CORE
;**; [71] INSERT AT NOROOM + 13 1/2	CLRH	27-JUL-79
	ADDI	A,1		;[71] PLUS ONE FOR THE TRAILING -1 (LAST)
	CAMG	A,.JBREL	;WILL IT?
	JRST	.+3		;YES
	CORE	A,		;GET ENOUGH CORE
	JRST	NECERR		;NOT ENOUGH CORE
	MOVE	A,BUFSIZ
	MOVEM	A,XCOUNT
				;MARK IT AS AN INDEX INCASE BLOCK FULL
	HRROM	T,@XPNTR	;SAVE BLOCK # FOR PASS 2
	AOS	XPNTR
	TXNN	F,DTAFLG	;NOT IF DTA
	AOS	BLKCNT		;ONE FOR OUTPUT
	MOVE	A,INDEXH
	TXNE	F,DTAFLG	;DTA IS 1 WORD LESS
	SUBI	A,1
	MOVEM	A,@XPNTR
	AOS	XPNTR
	SOS	XCOUNT
	SOS	XCOUNT		;SPACE FOR LINK WORD TO NEXT INDEX
	JRST	INDEX1+1
;HERE FOR PASS 2. WRITE OUT THE INDEX BLOCKS

INDEX3:	SETOM	@XPNTR		;TERMINATE WITH END OF INDEX MARKER
	OUTPUT	OCHN,		;SO LAST BLOCK IS WRITTEN
	TXNE	F,DTAFLG	;IS IT DTA?
	JRST	INDEX5		;YES, TREAT DIFFERENTLY
	SETSTS	OCHN,16
	MOVNI	A,200
	HRLM	A,XBEG
INDEX4:	SETZM	XBEG+1
	MOVE	A,@XBEG
	USETO	OCHN,(A)
	OUTPUT	OCHN,XBEG
	STATZ	OCHN,760000
	JRST	FSOERR		;FILE STATUS ERROR
	MOVEI	A,200
	ADDB	A,XBEG
	HRRZS	A
;**; [71] CHANGE AT INDEX4 + 11	CLRH	27-JUL-79
	CAMGE	A,XPNTR		;[71] REACHED END?
	JRST	INDEX4
	JRST	RSTRT

INDEX5:	CLOSE	OCHN,		;AND A SEPARATE EOF BLOCK
	SETSTS	OCHN,116	;NON STANDARD MODE
	MOVNI	A,200		;IOWD COUNT
	HRLM	A,XBEG		;SET IT UP FOR OUTPUT
	USETI	OCHN,@BLKCNT	;SET ON LAST BLOCK
	INPUT	OCHN,DIRIOW	;READ IT IN
	LDB	A,[POINT 10,DIRBLK,27]	;GET FIRST BLOCK #
	HRRM	A,@XBEG		;STORE IT FOR COMMON LOOP
	SETZM	XBEG+1		;MAKE SURE IT'S ZERO
INDEX6:	MOVE	A,@XBEG		;GET BLOCK NUMBER
	USETI	OCHN,(A)	;SET FOR INPUT
	INPUT	OCHN,DIRIOW	;INPUT BLOCK
	MOVE	T,DIRBLK	;TO FIND LINK WORD
	EXCH	T,@XBEG		;PUT IT IN OUTPUT BLOCK
	SOS	XBEG		;BACK UP POINTER
	USETO	OCHN,(A)	;NOW FOR OUTPUT
	OUTPUT	OCHN,XBEG	;OUT IT GOES
	STATZ	OCHN,760000	;UNLESS IN ERROR
	JRST	FSOERR		;FILE STATUS ERROR
	MOVEI	A,200		;GET TO NEXT DUMP BLOCK
	ADDB	A,XBEG		;ADVANCE POINTER
	HRRZS	A		;JUST WORD LOCATION
	CAMG	A,XPNTR		;ALL DONE?
	JRST	INDEX6		;NO, LOOP
	SETSTS	OCHN,16		;BACK TO STANDARD MODE TO UPDATE DIR.
	JRST	RSTRT		;YES, FINISH UP

INDEXH:	XWD	14,177		;USED TO SIGNAL INDEX BLOCK TO LOADER
SUBTTL INPUT SERVICE ROUTINE
;THE INPUT ROUTINE GETS CHARACTERS FROM THE DEVICE WHOSE
;CHANNEL NUMBER IS IN ACCUMULATOR D. IT CALCULATES THE POSITION
;OF THE BUFFER HEADER OF THE DEVICE, THEN EITHER LOADS AC A
;FROM THE BYTE POINTER, OR DOES AN INPUT. IF AN END OF FILE
;IS FOUND, THE ROUTINE EXITS WITH A POPJ, SINCE THE READ ROUTINE
;IS CALLED WITH A PUSHJ, FOLLOWED BY AN EOF RETURN. THE NORMAL
;EXIT FROM GETIN IS BY A JRST @GETIN.

GETIN:	SOSG	@IBUF2		;IS APPROPRIATE BUFFER EMPTY?
	JRST	INGET2		;YES, GET ANOTHER BUFFER
GETIN1:	ILDB	A,@IBUF1		;LOAD AC A WITH A CHARACTER
	POPJ	P,

; /BOUT/ - ROUTINE TO TAKE A BYTE FROM AC T1 AND PLACE IT
;	IN THE CHANNEL OCHN. THE MODE IS PREDETERMINED AT
;	OPEN TIME. THIS ROUTINE IS USED FOR BOTH ASCII AND BINARY
;	OUTPUT.
;

BOUT:	TXNE	F,FOTTY			;IS SCAN IN COMMAND OF THE OUTPUT?
	JRST	[ OUTCHR T1		;YES,DO TTCALL AND RETURN
		  POPJ  P,]		;
	SOSG	OBUF+2			;IS THERE  ROOM IN THE BUFFER?
	JRST	BOUTGO			;NO,SO OUTPUT BUFFER
BOUT1:	IDPB	T1,OBUF+1		;UNLOAD THE CHARACTER
	TXNE	F,DEVTTY		;IF OUTPUT IS TO TTY
	CAIE	T1,12			;AND THIS IS LINEFEED
	POPJ	P,			;BUT ITS NOT,SO RETURN
	OUTPUT	OCHN,			;OUTPUT BUFFER
	POPJ	P,			;AND RETURN

BOUTGO:					;HERE TO UNLOAD BUFFER
	TXNN	F,XFLG			;CURRENTLY INDEXING?
	JRST	BOUTG1			;NO,SKIP THIS
	TXNN	F,DTAFLG		;IF INDEXING TO DSK
	AOSA	BLKCNT			;INCREMENT COUNT, BUT FOR DECTAPE
	UGETF	OCHN,BLKCNT		;GET NEXT FREE BLOCK
BOUTG1:	OUT	OCHN,			;OUTPUT THE BUFFER
	  JRST	BOUT1			;DO UNLOAD THE CHARACTER/BYTE
	JRST	FSOERR			;SOME SORT OF ERROR ON THAT OUTPUT
SUBTTL GO UNDER IFN FTBPT CONDITIONAL THAT LASTS FOR MANY PAGES



IFN FTBPT,<
; /GETCOR/ - ROUTINE TO ALLOCATE FREE CORE
; 
; INPUT- T1 CONTAINS THE NUMBER OF WORDS TO ALLOCATE
; OUTPUT- T1 CONTAINS THE FIRST WORD OF THE BLOCK ALLOCATED
;
; RETURNS- POPJ OR TO LABEL NECERR IF NO CORE AVAILABLE
;
GETCOR:	SKIPG	T1			;CHECK OUR ARGUMENT
	$STPCD(Negative amount of core requested)
	PUSH	P,.JBFF##		;SAVE ORIGINAL FFREE
	ADDB	T1,.JBFF##		;UPDATE THE CORE MARKER
	SOS	T1			;BACK OFF ONE TO GET LAST WORD USED
	CAMG	T1,.JBREL##		;IN BOUNDS?
	PJRST	T1POPJ			;YES,RETURN WITH T1 CONTAINING ADDRESS
	CORE	T1,			;ELSE ALLOCATE THE CORE
	  JRST	NECERR			;IF NO CORE AVAILABLE
	PJRST	T1POPJ			;RETURN, RESTORING T1 FROM
					;ORIGINAL .JBFF



SUBTTL BIN- INPUT A BYTE IN ASCII FROM TRANSACTION FILE



;/BIN/ - ROUTINE TO GET A BYTE FROM INPUT (FIX FILE) AND LOAD
; IT INTO CC. 

BIN:	SOSG	TBUF+2		;ANYTHING IN THE BUFFER
	PUSHJ	P,BIN2		;NO, GET ANOTHER
	ILDB	CC,TBUF+1	;LOAD BYTE
	JUMPE	CC,BIN		;IGNORE NULLS
	POPJ	P,		;RETURN

BIN2:	IN	TRIN,		;GET A BUFFER
	POPJ	P,		;NO ERRORS,JUST RETURN
	STATZ	TRIN,IO.EOF	;EOF?
	JRST	FIX1		;YES,TRAP TO EOF HANDLER
	JRST	FSTERR		;ERROR MESSAGE FOR OTHER ERROR STATUSES
SUBTTL MACLOD- ROUTINE TO GET A LINE OF MACRO CODE INTO MACBUF

; /MACLOD/- SINCE FOR ERROR PROCESSING AND FOR SYNTAX CHECKING
;	IT IS USEFUL TO BE ABLE TO RESCAN MACRO CODE,
;	THE PROCESSOR (EVAL) USES AN INPUT STREAM FROM AN INTERNAL
;	BUFFER. MACLOD READS AN INPUT STREAM INTO THE MACRO CODE BUFFER
;	"MACBUF"
;
; INPUTS-	NONE
;
; OUTPUT-	MACBUF IS LOADED WITH ASCIZ STRING OF MACRO CODE
;		MACPTR IS A BYTE POINTER TO THIS STRING
;		MACCNT IS THE COUNT OF CHARACTERS IN BUFFER,UP TO EOL
;		
; RETURNS:	ALWAYS CPOPJ
;

MACLOD:	TXNE	F,DEBIMC		;USING INTERNAL BUFFER?
	POPJ	P,			;YES,SO JUST RETURN
	PUSH	P,T1			;SAVE REGISTER T1
	SETZM	MACCNT			;RESET COUNT
	MOVE	T1,[POINT 7,MACBUF]	;SET UP POINTER
	MOVEM	T1,MACPTR		;SAVE IT FOR RE-READS
;**;[25]   MACLOD+5     ILG    9-JUL-76
	PUSHJ	P,BIN			;[25]INSURE BUFFER IS SET UP
	MOVE	T1,@TBUF+1		;[25]GET CURRENT WORD
	TRNE	T1,1			;[25]CHECK FOR LSN BIT
	AOS	MACPTR			;[25]GOT LSN. SKIP THE WORD
	SKIPA	T1,[POINT 7,MACBUF]	;[25]RESTORE T1,SKIP THE LOAD CHAR

MACLD1:	PUSHJ	P,BIN   		;GET CHARACTER
	IDPB	CC,T1			;DEPOSIT CHARACTER
	AOS	MACCNT			;UPDATE COUNT
	SKIPE	MACLST			;NOT INTO SAFETY WORD,ARE WE?
	JRST	MACLD2			;YES,ERROR
	CAIL	CC,12			;WATCH FOR END OF LINE
	CAILE	CC,14			;ITS OUR DELIMITER
	JRST	MACLD1			;NOT END OF LINE,GET NEXT CHARACTER
	SETZ	CC,			;DEPOSIT NULL AFTER LINE
	IDPB	CC,T1			;FOR ERROR MESSAGES
	POP	P,T1			;RESTORE T1
	AOS	LLOFF			;LINES SINCE LAST LABEL
	POPJ	P,			;RETURN

MACLD2:	MOVEI	CC,.CHLFD		;FINISH LINE WITH BREAK
	IDPB	CC,T1			;SO ERROR MESSAGE IS GOOD
	$KILL(LTL,MACRO code line is too long,,$MORE)
	JRST	MCCOMM			;CONTINUE WITH ERROR
SUBTTL MIC - ROUTINE TO LOAD CHARACTER (AND EDIT IT) FROM MACRO CODE BUFFER


 ; /MIC/ - THIS ROUTINE READS CHARACTERS FROM THE BUFFER "MACBUF"
; POINTED TO BY MACPTR.  A COUNT IS DECREMENTED , AND CHECKED
; OF CHARACTERS LEFT, AND IF NOT EXHAUSTED, A CHARACTER
; IS LOADED. THE FLAG, "REGET" IS TESTED AND READ ALSO.
;
; SOME EDITTING OF THE CHARACTERS IS DONE ALSO.
;

MIC:	TXZN	F,REGET			;IS REGET OF CHARACTER ON?
	PUSHJ	P,MIC5			;NO,LOAD CHARACTER
	CAIL	CC,12			;CONVERT END-OF-LINE
	CAILE	CC,14			;TO $EOL
	CAIA
	JRST	[ MOVEM CC,REOL		;SAVE "REAL" END OF LINE
		  MOVEI CC,$EOL		;AND REPLACE WITH FAKE ONE
		  JRST .+1 ]		;AND CONTINUE
	TXNE	F,QUOTE			;CONVERION SUPRESSED?
	POPJ	P,			;YES,SO JUST RETURN
	CAIN	CC,"	"		;CONVERT <TAB>
	MOVEI	CC," "			;TO <SPACE>
	CAIL	CC,"a"			;LOWER CASE LETTER?
	SUBI	CC,"a"-"A"		;YES,CONVERT
	CAIE	CC,$EOL			;END OF LINE OR
	CAIL	CC," "			;NOT LESS THAN BLANK
	POPJ	P,			;JUST RETURN
	JRST	MIC			;ELSE LOAD ANOTHER CHARACTER

MIC5:	SOSGE	MACCNT			;DONT LET CHARACTER COUNT GO NEGATIVE
	 $STPCD(MACRO evaluator read past its end of buffer)
	ILDB	CC,MACPTR		;LOAD CHARACTER
	POPJ	P,			;RETURN TO CALLER
SUBTTL ROUTINES TO MANIPULATE THE MACRO CODE BUFFER

; /MACPEK/- ROUTINE TO RETURN THE CHARACTER AFTER THE NEXT ONE
;
; INPUT- NONE
; OUTPUT-  AC A WILL CONTAIN THE CHARACTER AFTER THE CURRENT ONE
;		IE. CHARACTER NEXT ILDB WILL GET
;

MACPEK:	PUSH	P,T1		;SAVE T1
	MOVE	T1,MACPTR	;GET THE POINTER
	ILDB	A,T1		;GET CHARACTER
	CAIL	A,"a"		;[24]CHARACTER LESS THAN LC "A"?
	CAILE	A,"z"		;[24]NO, SO IS IT LESS THAN LC "Z"?
	SKIPA			;[24]NOT IN RANGE LC A-Z
	SUBI	A,"a"-"A"	;[24]ELSE CONVERT TO UPPER CASE 
	PJRST	T1POPJ		;RESTORE AND RETURN


; /MACSAV/ AND /MACRST/ - ROUTINES TO SAVE AND RESTORE THE STATE OF
;	THE BUFFER POINTER AND COUNT.
;
; MACSAV- SAVES AWAY THE COUNT AND POINTER WORDS
; MACRST- RESTORES COUNT AND POINTER FROM LAST CALL TO MACSAV
;

MACSAV:	PUSH	P,MACPTR	;GET POINTER
	POP	P,MACSV1	;STORE IT
	PUSH	P,MACCNT	;GET COUNT
	POP	P,MACSV2	;SAVE IT ALSO
	POPJ	P,		;RETURN

MACRST:	PUSH	P,MACSV1	;GET POINTER
	POP	P,MACPTR	;RESTORE IT
	PUSH	P,MACSV2	;GET COUNT
	POP	P,MACCNT	;RESTORE IT
	TXZ	F,REGET		;INVALIDATE ANY REGET
	POPJ	P,		;RETURN
SUBTTL ROUTINE TO BACK UP THE REL FILE

;/BACKUP/ - THIS ROUTINE CLOSES THE MASTER AND OUTPUT FILES. IT THEN
;		OPENS AS THE NEW MASTER THE OLD OUTPUT.
;		IT THEN ENTERS AS NEW OUTPUT A NEW FILE WITH
;		THE SAME NAME AS THE OLD OUTPUT. THIS HAS THE EFFECT
;		OF BACKING US UP INTO WHAT WAS THE OLD MASTER WITHOUT
;		ACTUALLY DESTROYING THE OLD MASTER.


BACKUP:	PUSHJ	P,COPY			;INSURE THAT ALL DONE
	CLOSE	MIN,			;CLOSE OMASTER
	STATZ	MIN,760000		;CHECK FOR ERRORS
	  JRST	FSMERR
	RELEAS	MIN,
	CLOSE	OCHN,			;CLOSE OUTPUT
	STATZ	OCHN,760000		;
	  JRST	FSOERR			;
	RELEASE	OCHN,

	MOVE	T1,[XWD BCKBLK,OPNBLK]	;RESTORE OUTPUT SPECS
	BLT	T1,OPNBLK+<.RBSIZ+2+3>-1	;FOR RE-OPENS
	MOVE	T1,BCKFF		;RESTORE CORE MARKER
	EXCH	T1,.JBFF##		;
	MOVEM	T1,BCKFF+1		;SO WE DONT SWELL
	OPEN	OCHN,OPNBLK		;OPEN OUTPUT
	 JRST	OPNFAI			;
	ENTER	OCHN,LKPBLK		;ENTER IT
	  JRST	LKPFAI			;
	OUTBUF	OCHN,			;SET UP BUFFER

	MOVE	T1,[BCKBLK,,OPNBLK]	;RESTORE SPECS AGAIN
	BLT	T1,OPNBLK+<.RBSIZ+2+3>-1 ;
	MOVEI	T1,MBUF			;CORRECT HEADER POINTER
	MOVEM	T1,OPNBLK+2		;
	OPEN	MIN,OPNBLK		;OPEN MASTER FOR INPUT AGAIN
	 JRST	OPNFAI
	LOOKUP	MIN,LKPBLK		;AND LOOKUP
	 JRST	LKPFAI
	INBUF	MIN,
	MOVE	T1,BCKFF+1		;RESTORE FIRST FREE
	MOVEM	T1,.JBFF##		;DONE
	POPJ	P,			;RETURN
SUBTTL OCTIN,DECIN,CRADIN - ROUTINES TO DO NUMERIC INPUT FROM FIX FILE

; /DECIN/ - ROUTINE TO INPUT A DECIMAL (10.) NUMBER FROM
;		FIX FILE INTO AC A.
; /OCTIN/ - SAME AS ABOVE, OCTAL (8.)
; /CRADIN/ - READ NUMBER IN USING VALUE IN LOCATION
;	CRADIX AS THE CURRENT RADIX.
;
;  DELIMITER IS LEFT IN CC. IT IS THE FIRST NON-DIGIT (0-9) ENCOUNTERED.
; IF A DIGIT GREATER THAN THE CURRENT RADIX IS FOUND, THE INPUT
; IS AUTOMATICALLY CHANGED TO RADIX10.
;

OCTIN:	SKIPA	T,[^D8]			;FOR BASE 8 INPUT
DECIN:	MOVEI	T,^D10			;FOR DECIMAL
	SKIPA				;RADIX LOADED
CRADIN:	MOVE	T,CRADIX		;T IS LOADED WITH CURRENT RADIX
	SETZ	A,			;CLEAR RESULT
	SETZM	DECNUM			;CLEAR FORCED RADIX 10 NUMBER
RADI1:	PUSHJ	P,MIC   		;GET A CHARACTER
	SKPNUM				;IS IT A DIGIT?
	 POPJ	P,			;NO,SO RETURN
	SUBI	CC,"0"			;CONVERT TO NUMBER
	CAMGE	CC,T			;OVER OR AT CURRENT RADIX?
	JRST	RADI2			;NO, LEAVE IT ALONE
	MOVEI	T,^D10			;CONVERT TO RADIX 10
	MOVE	A,DECNUM		;GET WHAT WE HAVE READ IN SO FAR
RADI2:	IMULI	A,(T)			;SHIFT OVER
	ADDI	A,0(CC)			;
	EXCH	A,DECNUM		;MAKE RADIX10 NUMBER
	IMULI	A,^D10
	ADDI	A,0(CC)			;
	EXCH	A,DECNUM		;
	JRST	RADI1			;AND GO BACK FOR NEXT
SUBTTL SYMIN - ROUTINE TO FORM A SYMBOL FROM THE INPUT STREAM 

;/SYMIN/ - THIS ROUTINE LOADS CHARACTERS INTO AC A FORMING A
;	SYMBOL THAT IS LEFT JUSTIFIED. THE SYMBOL IS DELIMITED
;	BY THE FIRST CHARACTER NOT IN THE RADIX-50 CHARACTER
;	SET.
;	THE DELIMITING CHARACTER IS LEFT IN AC CC.    THE SYMBOL 
;	IS LEFT IN SIXBIT FORM. THE DELIMITER IS IN ASCII
;  CHARACTERS IN EXCESS OF THE MAX. OF 6 ARE EATEN AND DISCARDED.
;

SYMIN:	SETZM	A			;START WITH NO SYMBOL
	PUSH	P,T1			;SAVE T1
	MOVE	T1,[POINT 6,A]		;AND GIVE IT A POINTER TO A
SYMIN1:	PUSHJ	P,MIC   		;READ A CHAR FROM PATCH FILE
	SKPR50				;IS IT RADIX50?
	 JRST	T1POPJ			;NO,SO RETURN,RESTORING T1
SYMIN2:	TRNE	A,77			;HAVE WE GOT ROOM?
	JRST	SYMIN1			;NO,JUST DISCARD CHARACTER
	SUBI	CC,40			;CONVERT TO SIXBIT
	ANDI	CC,77			;FOR SYMBOL STORAGE
	IDPB	CC,T1			;AND INCLUDE CHARACTER
	JRST	SYMIN1			;GET NEXT CHARACTER
; /TDIGIT/-  ROUTINE TO TEST IF CHARACTER IN AC CC IS A VALID DIGIT (0-9)
;
; SKIP RETURN IF DIGIT, NON-SKIP IF NOT
;

TDIGIT:	CAIL	CC,"0"			;LESS THAN 0?
	CAILE	CC,"9"			;.GT. 9?
	POPJ	P,			;NOT DIGIT
	PJRST	CPOPJ1			;DIGIT


; /TABC/ - ROUTINE TO TEST IF CHARACTER IS IN THE RANGE OF A-Z
;
; SKIP IF CHARACTER IS ALPHABETIC, NON-SKIP IF IT ISN'T
;

TABC:	CAIL	CC,"A"			;LESS THAN 'A'?
	CAILE	CC,"Z"			;OR GREATER THAN 'Z'?
	POPJ	P,			;YES, SO NOT ALPHABETIC
	JRST	CPOPJ1			;ELSE TAKE ALPHABETIC RETURN


;/TR50/ - ROUTINE TO TEST IF A CHARACTER IS IN THE RADIX50 SET.
;
;

TR50:	PUSHJ	P,TDIGIT		;NUMBERS ARE
	 CAIN	CC,"."			;AND SO ARE PERIODS
	JRST	CPOPJ1			;SO TAKE GOOD RETURN
	PUSHJ	P,TABC			;ALPHABETIC IS LEGAL
	CAIN	CC,"$"			;AS IS DOLLAR SIGN
	JRST	CPOPJ1			;SO TAKE GOOD RETURN
	CAIN	CC,"%"			;CHECK PERCENT SIGN
	JRST	CPOPJ1
	POPJ	P,			;NOT IN 0-9,A-Z,$,%,.
SUBTTL DESCRIPTION OF INTERIM SYMBOL TABLE (IST)

COMMENT \

	THE INTERIM SYMBOL TABLE (IST) CONTAINS PAIRS OF WORDS
THAT DESCRIBE ACTIONS TO BE TAKEN FOR FIXING UP FORWARD REFERENCES TO
SYMBOLS, EXTERNALS AND LITERALS.
THE IST IS ALSO USED FOR ASCII,ASCIZ AND SIXBIT STRINGS THAT
EXTEND FOR MORE THAN ONE WORD.


WHEN EVAL FINDS A SYMBOL THAT IS UNDEFINED:

1) SET OPERAND RESULT (AC A) TO 0
2) SET SYMBOL FIXUP POINTER (AC C) TO BE POINTER TO ENTRY IN IST
3) SET IST WORD 1 TO BE SIXBIT THIS SYMBOL NAME
4) SET 2ND WORD OF IST PAIR TO IS.UDF, ALSO IS.DER IFF SYMBOL FOLLOWED BY ##
	ALSO, RELOC IS CLEARED IF EXTERNAL.
5) THE RELOC AND SYMBOL FIXUP ARE CARRIED THRU ALL LATER OPERATIONS
6) AT THE END OF EVAL, THE RH OF IST ENTRY WORD 2 IS REVERSED TO POINT
  BACK AT THE LOCATION THAT CODE WORD IS STORED IN. 
8) WHEN SYMBOL IS RESOLVED, ITS VALUE IS STORED INTO THE APPROPRIATE
  HALF OF THE WORD.


WHEN EVAL FINDS A REFERENCE TO AN EXTERNAL:
 
1) RESULT,RELOCATABILTY ARE SET TO 0.
2) SYMFIX (AC C ) IS SET TO POINT TO FIRST FREE IST PAIR
3) WORD 1 OF PAIR GETS SIXBIT SYMBOL NAME
4) WORD 2 GETS FLAG OF IS.DER (DEFFERED EXTERNAL REFERENCE)
5) OPERAND IS CARRIED THRU LATER OPERATIONS
6) AT END OF EVAL, POINTER IS REVERSED TO INDICATE FIXUP ADDRESS
7) IF ALL GOES WELL, A SYMBOL TABLE ENTRY IS MADE LATER TO HOOK
   REQUEST INTO GLOBAL CHAIN.


 WHEN EVAL FINDS A REFERENCE TO AN LITERAL:

1) THE EXPRESSION WITHIN BRACKETS IS EVALUATED.
    A LINKED LIST OF WORDS IS FORMED FOR THE LITERAL.
1A) THE EXPRESSION RESULT,ITS RELOC AND SYMFIX ARE STORED IN
	FREE CORE AS A LINKED LIST

2) A POINTER TO THE LINKED LIST IS PUT INTO THE FIRST WORD OF THE IST PAIR
4)  RESULT IS SET TO 0, RELOC TO RH ONLY (1), SYMFIX (AC C) IS SET TO
    POINT BACK AT THE IST PAIR. FLAG (AC D) IS SET TO C.LIT
5)  THE OPERAND IS PASSED BACK FOR FURTHER USE.
6)  AT THE END, THE LITERAL WORD IS TO BE INSERTED WITH APPROPRIATE
    RELOCATION AND THEN THE POINTER IS USED TO DUE THE NORMAL FIXUP.


WHEN EVAL FINDS THAT A STRING EXTENDS FOR MORE THAN ONE WORD:

1) THE FIRST WORD OF THE STRING IS LEFT ALONE
2) AN IST PAIR ENTRY IS MADE. THE FIRST WORD IS:
	XWD -COUNT OF WORDS, ADDRESS OF STRING
3) THE EXCESS WORDS ARE GENERATED INTO FREE CORE (THAT WORD 1 OF IST PAIR
	POINTS TO)
4) THE USUAL STUFF IS DONE WITH IST POINTER CARRIED AROUND BY THE
	EXPRESSION AND REVERSED AT EXIT FROM EVAL.
	THE SECOND WORD OF THE IST IS THEN:  IS.MWS,,ADDRESS 1ST WORD GENERATED INTO
5) AT FIXUP TIME, THE STRING IS GENERATED.

\

; FLAGS IN LH OF WORD TWO OF IST PAIR

	$1BIT=1B17		;LEAVE RH FREE

	BIT(IS.UDF)		;THIS SYMBOL IS NOT IN SYMBOL TABLE
	BIT(IS.DEF)		;THIS WAS REQUEST TO DEFINE SYMBOL (SINGLE #)
	BIT(IS.LH)		;THIS FIXUP IS TO LEFT HALF OF WORD
	BIT(IS.FW)		;THIS IS OK AS A FULLWORD FIXUP
	BIT(IS.DER)		;THIS IS A DEFERRED EXTERNAL REQUEST
	BIT(IS.NEG)		;THIS IS A REQUEST TO SUBTRACT
	BIT(IS.LIT)		;THIS IS A PSEUDO-LITERAL
	BIT(IS.MWS)		;THIS IS THE CONTINUANCE OF A MULTI-WORD STRING
	BIT(IS.BLK)		;THIS IS A BLOCK FORM OF IS.MWS
	BIT(IS.GEN)		;OK TO GENERATE FIXUP NOW
SUBTTL ROUTINES FOR MANIPULATING THE IST (INTERIM SYMBOL TABLE)

; /ISTINI/- ROUTINE TO ZERO THE IST MAP
;

ISTINI:	PUSH	P,T1			;SAVE T1
	MOVE	T1,[XWD ISTMAP,ISTMAP+1]
	SETZM	ISTMAP
	BLT	T1,ISTMAP+<<ISTMAX+^D35>/^D36>-1
	PJRST	T1POPJ




; /ISTGET/ - ROUTINE TO FIND THE FIRST AVAILABLE SLOT ON THE IST
;
; THIS ROUTINE IS USED FOR ALLOCATING A SLOT IN THE INTERIM SYMBOL TABLE
;
; INPUTS-NONE
;
; OUTPUTS- AC C WILL CONTAIN THE ADDRESS OF THE SLOT IN THE IST
;	   OR THE FATAL ERROR MESSAGE FOR ROOM EXHAUSTED IS GIVEN
;
; RETURNS- ALWAYS POPJ, OR TO ERROR PROCESSOR
;

ISTGET:	PUSH	P,T1			;SAVE T1-2
	PUSH	P,T2
	MOVE	T1,[POINT 1,ISTMAP]	;POINTER TO BIT MAP
	MOVEI	C,IST			;INITIAL GUESS AS TO FREE SLOT
ISTGE1:	ILDB	T2,T1			;GET BIT
	JUMPE	T2,[ SETOM T2		;MARK AS IN USE
		     DPB T2,T1		;
		     PJRST T2POPJ ]	;AND RETURN
	ADDI	C,2			;NOT THIS PAIR
	CAIG	C,ISTLST		;OVER THE END?
	JRST	ISTGE1			;NO
	$KILL(IST,<Interim symbol table overflowed, Code too complex in edit>,N$SIX)




; /ISTVAL/ - ROUTINE TO SEE IF PARTICULAR PAIR OF IST IS IN USE
;
; INPUT- AC T1 CONTAINS POINTER TO PAIR IN IST
; OUTPUT - AC T1 IS PRESERVED
;
; RETURNS - CPOPJ= PAIR IS NOT IN USE
;	    CPOPJ1 = PAIR IS IN USE
;

ISTVAL:	PUSH	P,T1			;SAVE INPUT ARG
	PUSH	P,T2
	SUBI	T1,IST			;MAKE INDEX
	LSH	T1,-1			;TWO WORDS PER PAIR
	MOVE	T2,[POINT 1,ISTMAP]	;
	IBP	T2			;ADJUST BYTE POINTER
	SOJGE	T1,.-1
	LDB	T2,T2
	SKIPE	T2			;IF IN USE
	AOS	-2(P)			;UPDATE TO BE SKIP RETURN
	PJRST	T2POPJ			;RETURN , RESTORE THE ACS
;
; /ISTSAV/ & /ISTRST/  - ROUTINE TO SAVE AND RESTORE THE STATE OF
;	THE IST SO THAT UPON ERRORS AND CODE COMPARE, WE CAN DE-ALLOCATE
;	IST SPACE TEMPORARILY USED.
;
ISTSAV:	PUSH	P,T1			;SAVE T1
	MOVE	T1,[XWD ISTMAP,ISTALT]	;
	BLT	T1,ISTALT+<<ISTMAX+^D35>/^D36>-1
	PJRST	T1POPJ			;RESTORE T1,RETURN

ISTRST:	PUSH	P,T1			;SAVE T1
	MOVS	T1,[XWD ISTMAP,ISTALT]
	BLT	T1,ISTMAP+<<ISTMAX+^D35>/^D36>-1
	PJRST	T1POPJ			;RESTORE,RETURN
SUBTTL ROUTINES TO DO POST-FIXUPS FOR THE INTERIM SYMBOL TABLE

; THE FOLLOWING ROUTINES REMOVE ENTRIES FROM THE INTERIM FIXUP TABLE
; WHEN THINGS ARE DEFINED. THINGS DEFINED INCLUDE EXTERNAL AND LOCAL FIXUPS
;  LITERAL AND STRING CONTINUATION FIXUPS.
 
;
; /PMLOC/ - ROUTINE TO REMOVE ENTRIES FROM THE IST REFERRING TO
;	A LOCAL SYMBOL (LABEL)  
;
; INPUTS- NONE
;
; OUTPUTS- IF THERE ARE FORWARD REFERENCES, THEY ARE REMOVED,FIXED UP
;		AND THE IST IS COLLAPSED.
;
; RETURNS- ALWAYS CPOPJ
;

PMLOC:	MOVEI	T1,ISTLST+1		;GET POINTER TO NON-EXISTENT PAIR
	
PMLOC1:	CAIN	T1,IST			;ARE WE AT FRONT OF TABLE?
	POPJ	P,			;YES , RETURN
	SUBI	T1,2			;ADJ TO POINT TO CURRENT ENTRY
	MOVE	T2,1(T1)		;FETCH FLAG,,ADDR
	TXNE	T2,IS.GEN		;ADDRESS AVAILABLE TO FIXUP?
	TXNE	T2,IS.LIT!IS.DER!IS.MWS!IS.DEF	;IGNORE IF NOT LOCAL SYMBOL FIXUP
	JRST	PMLOC1
	PUSHJ	P,ISTVAL		;SEE IF VALID
	  JRST	PMLOC1			;ITS NOT
	MOVE	R,0(T1)			;GET THE SYMBOL NAME
	PUSHJ	P,SYMSRC		;LOOKUP THE SYMBOL
	  JRST	PMLOC1			;NOT DEFINED YET
	MOVE	T2,A			; LOAD T2 WITH SYMBOL VALUE
	MOVE	T3,D			;T3 GETS RELOCATION
	MOVE	T4,1(T1)		;GET FLAG WORD AGAIN
	TXNN	T4,IS.LH		;MAKE CHECK IF LH FIXUP
	TXNN	T4,IS.FW		;SKIP CHECK IF FULL WORD
	JRST	[ TLNE	T2,-1		;INSURE NULL LH
		  TLC	T2,-1		;TRY MAKING HALFWORD NEGATIVES
		  TLNE	T2,-1		;
		  TLZ   T2,-1		;JUST TRUNCATE IT THEN
		  JRST	.+1 ]		;
	PUSHJ	P,PMFIX			;PATCH REL FILE,COLLAPSE IST
	JRST	PMLOC1			;AND RE-ITERATE
; /PMDEF/ - ROUTINE TO DEFINE A LOCAL SYMBOL BEFORE IT CAN BE FIXED UP
;	PMDEF IS CALLED FOR SYMBOLS WHICH ARE UNDEFINED AND WERE FOLLOWED
;	BY '#' WHEN REFERENCED. A LOCAL VARIABLE IS DEFINED IN THE LOW
;	SEG VIA THE MACRO BLOCK TYPE MECHANISM AND THEN THE IS.DEF BIT
;	IS TURNED OFF, ALLOWING THE ROUTINE PMLOC TO RESOLVE ALL FIXUPS
;	FOR THIS SYMBOL
; INPUT - IST ENTRY OF THE FORM:	1/SYMBOL NAME IN SIXBIT
;				        2/IS.DEF!IS.UDF,,0 OR ADDRESS TO FIXUP
; RETURNS WITH CPOPJ ALWAYS

PMDEF:	MOVEI	T1,ISTLST+1		;GET POINTER TO NON-EXISTENT PAIR

PMDEF1:	CAIN	T1,IST			;ARE WE DONE?
	POPJ	P,			;YES, SO RETURN NOW
	SUBI	T1,2			;BACK DOWN ONE PAIR
	MOVE	T2,1(T1)		;GET THE FLAGS FOR THIS ONE
	TXNE	T2,IS.DEF		;WANT TO DEFINE VARIABLE?
	PUSHJ	P,ISTVAL		;AND ITS CURRENTLY VALID?
	  JRST	PMDEF1			;ONE OR THE OTHER NOT TRUE
	MOVEI	T3,SEB+2		;ASSUME NO HIGH SEGMENT
	SKIPE	HSILOC			;IS THERE ONE?
	AOS	T3			;YES, SO END BLOCK HAS DIFFERENT FORM
	MOVE	R,0(T1)			;GET SYMBOL NAME
	PUSHJ	P,SYMSRC		;MAKE SURE ITS UNDEFINED
	  SKIPA				;TO PREVENT XWD FOO#,FOO#
	JRST	MERROR			;COMPLAIN IF NOT UNDEFINED
	HRRZ	A,0(T3)			;GET BREAK FROM END BLOCK
	AOS	0(T3)			;AND UPDATE THE END BLOCK
	MOVEI	B,1			;RELOCATABLE ADDRESS
	PUSHJ	P,RAD50			;CONVERT SYMBOL TO RADIX 50
	PUSHJ	P,NEWSYM		;REGISTER THE SYMBOL
	  JRST	STOERR			;OUT OF ROOM
	MOVX	A,IS.DEF		;TURN OFF THE DEFINE BIT
	ANDCAM	A,1(T1)			;SO PMLOC WONT IGNORE IT
	PUSH	P,T1			;SAVE INDEX
	PUSHJ	P,PMLOC			;ALLOW PMLOC TO DO THE FIXUP
	POP	P,T1			;RESTORE INDEX
	JRST	PMDEF1			;AND CONTINUE
; /PMLIT/ - ROUTINE TO GENERATE LITERAL WORDS AND TO
;	DO THE FIXUP NECESSARY SINCE LITERALS ARE FORWARD REFERENCES
; INPUT- IST PTR TO CHAIN OF LITERAL BLOCKS
; OUTPUTS - APPROPRIATE WORDS OF CODE AND COLLAPSED IST
; NOTE: DO NOT CHANGE BACK TO FRONT SWEEP OF IST FOR LITERAL FIXUPS.
;       THIS WILL BREAK NESTED LITERALS.
; RETURNS- ALWAYS CPOPJ
;

PMLIT:	MOVEI	T1,ISTLST+1		;GET POINTER TO NON-EXISTENT PAIR
	
PMLIT1:	CAIN	T1,IST			;AT FRONT?
	POPJ	P,			;YES,SO RETURN
	SUBI	T1,2			;BACK UP OVER PAIR
	MOVE	T2,1(T1)		;GET FLAGS,,FIXUP DESTINATION 
	TXNE	T2,IS.GEN		;IF NOT READY YET OR
	TXNN	T2,IS.LIT		;NOT A LITERAL
	JRST	PMLIT1			;JUST IGNORE
	PUSHJ	P,ISTVAL		;VALID?
	  JRST	PMLIT1			;NO,SO SKIP IT
	MOVE	A,0(T1)			;GET ADDRESS OF CODE TRIPLET
	PUSH	P,CPADDR		;SAVE ADDRESS OF START OF LITERAL
PMLIT2:	MOVE	C,0(A)			;LOAD WORD OF CODE
	MOVE	B,1(A)			;GET RELOCATION WORD
	TLNE	B,1			;IS LEFT HALF RELOCATED?
	TRO	B,1B34			;YES,SO FLAG IT SO
	HRRZS	B			;
	MOVE	T2,CPADDR		;GET ADDRESS THIS WORD WILL GO TO
	TXO	T2,IS.GEN		;FLAG THAT WORD IS GENERATED
	HRRZ	D,2(A)			;GET RIGHT HALF OF SYMBOL FIXUP WORD
	JUMPE	D,.+2			;IF 0,NO RH FIXUP REQUIRED
	IORM	T2,1(D)			;FIXUP NEEDED, DEPOSIT ADDRESS
	HLRZ	D,2(A)			;DO THE SAME FOR THE LEFT HALF
	JUMPE	D,.+3
	TXO	T2,IS.LH		;FLAG AS LEFT HALF FIXUP
	IORM	T2,1(D)			;DEPOSIT ADDRESS AND FLAG
	HRRZS	T2
	PUSH	P,3(A)			;SAVE LINK WORD
	PUSHJ	P,NEWCODE		;INSERT THE CODE
	  JRST	INSERR
	PUSH	P,T1			;PRESERVE T1
	PUSHJ	P,PMMWS			;SEE IF MORE TO FOLLOW
	POP	P,T1			;RESTORE T1
	POP	P,A			;RESTORE LITERAL LINK
	JUMPN	A,PMLIT2		;IF NON-ZERO, FOLLOW IT
	POP	P,T2			;T2 GETS ADDRESS OF LITERAL
	SETZ	T3,			;RELOC IS ALREADY SET
	PUSHJ	P,PMFIX			;DO THE FIXUP 
	PUSH	P,T1			;INVOKE LOCAL AND EXTERNAL FIXUPS
	PUSHJ	P,PMLOC			;SINCE FIXUP IS DEFERRED UNTIL
	PUSHJ	P,PMEXT			;LITERAL ACTUALLY GENERATED
	POP	P,T1			;RESTORE CURRENT IST POINTER
	JRST	PMLIT1			;AND RE-ITERATE
; /PMEXT/ - ROUTINE TO REMOVE EXTERNAL REFERENCES FROM THE IST
;
; INPUTS- NONE
;
; OUTPUTS- PROGRAM SYMBOL TABLE IS UPDATED TO MAKE REQUEST AND THE
;	IST IS COLLAPSED.
;
; NOTE THAT EXTERNAL REFERENCES IN PATCH CODE ARE ALWAYS ADDED USING
;	AN ADDITIVE GLOBAL REQUEST (LINK TYPE 2) OF FORM:
;	1ST WORD /      60 RADIX50-NAME
;	2ND WORD/       1B0+(POSSIBLY 1B1)+ADDRESS OF REQUEST
;
; 1B1 IS ON FOR LEFT HALF FIXUP, OFF IF FIXUP IS TO RIGHT HALF
;
; RETURNS- ALWAYS CPOPJ
;

PMEXT:	MOVEI	T1,ISTLST+1		;GET POINTER TO NON-EXISTENT PAIR

PMEXT1:	CAIN	T1,IST			;AT FRONT?
	POPJ	P,			;YES,SO RETURN
	SUBI	T1,2			;BACK OVER THE FRAME
	MOVE	T2,1(T1)		;PICK UP FLAG WORD,,ADDRESS OF REQUESTING WORD
	TXNE	T2,IS.GEN		;WORD HAS BEEN GENERATED AND
	TXNN	T2,IS.DER		;THIS IS A REQUEST, RIGHT?
	JRST	PMEXT1			;NO,SO SKIP IT
	PUSHJ	P,ISTVAL		;CHECK FOR EMPTINESS
	  JRST	PMEXT1			;EMPTY,SO SKIP IT
	MOVE	R,0(T1)			;GET SYMBOL NAME
	PUSHJ	P,RAD50			;CONVERT TO RADIX 50
	HRRZ	A,T2			;GET ADDRESS OF FIXUP
	TXO	A,R5.FXA		;INDICATE ADDITIVE GLOBAL
	TXNE	T2,IS.LH		;IS REQUEST TO LEFT HALF?
	TXO	A,R5.FXL		;YES,INDICATE SO
	MOVEI	B,1			;RELOCATE PTR TO FIXUP
	PUSHJ	P,GLRSYM		;ADD GLOBAL REQUEST SYMBOL
	  JRST	STOERR			;IF NO ROOM LEFT
	PUSHJ	P,PMFIX1		;COLLAPSE INTERIM TABLE
	JRST	PMEXT1			;AND CONTINUE
; /PMMWS/ - ROUTINE TO GENERATE 2ND THRU NTH WORDS OF MULTI-WORD STRING
;		ALSO DOES MULTIPLE WORD GENERATION FOR THE "BLOCK" PSEUDO-OP
;
; INPUTS- IST ENTRY OF FORMAT:
;	1/ AOBJN PTR TO STRING OR -COUNT,,0 FOR BLOCK PSEUDO OP
;	2/ IS.MWS,,ADDRESS THAT 1ST WORD OF STRING OR BLOCK WENT INTO.
;	 OR IS.MWS!IS.BLK,,ADDRESS THAT FIRST WORD OF BLOCK WENT INTO
;
; OUTPUTS- 2ND THRU NTH WORD GENERATED
;
; RETURNS- ALWAYS CPOPJ
;

PMMWS:	MOVEI	T1,ISTLST+1		;GET POINTER TO NON-EXISTENT PAIR

PMMWS1:	CAIN	T1,IST			;ALL DONE?
	POPJ	P,			;YES,RETURN
	SUBI	T1,2			;GET TO FRONT OF PAIR
	MOVE	T2,1(T1)		;GET SECOND WORD OF PAIR
	TXNE	T2,IS.GEN		;IF WORD NOT GENERATED YET
	TXNN	T2,IS.MWS		;OR NOT STRING
	JRST	PMMWS1			;IGNORE THE ENTRY
	PUSHJ	P,ISTVAL		;
	  JRST	PMMWS1			;IGNORE NULL ENTRIES
	MOVE	T3,CPADDR		;ELSE CONFIRM THAT WE
	CAIE	T3,1(T2)		;CAN GENERATE INTO PROPER PLACE
	 $STPCD(Multiple word generator called at wrong time)
	MOVE	T4,0(T1)		;GET AOBJN POINTER

PMMWS2:	TXNE	T2,IS.BLK		;IS THIS FOR BLOCK OPERATOR?
	TDZA	C,C			;YES,GENERATE A WORD OF ZEROS
	MOVE	C,0(T4)			;ELSE LOAD WORD OF STRING
	SETZ	B,			;WITH NO RELOCATION
	PUSHJ	P,NEWCOD		;GENERATE INTO MODULE
	 JRST	INSERR
	AOBJN	T4,PMMWS2		;LOOP FOR ALL WORDS
	PUSHJ	P,PMFIX1		;REMOVE ENTRY FROM IST
	JRST	PMMWS1			;SEE IF MORE IS.MWS ENTRIES
; /PMFIX/ -PATCH A VALUE AND RELOCATION INTO THE REL FILE
; /PMFIX1/ - REMOVE AN ENTRY FROM THE IST
;
; NOTE THAT A CALL TO PMFIX GENERATES ONE TO PMFIX1
;
; INPUTS- AC T1  SHOULD CONTAIN PTR TO WORD 1 OF CURRENT IST PAIR
;	  AC T2  SHOULD CONTAIN THE VALUE OF TOKEN BEING FIXED UP
;	  AC T3 SHOULD CONTAIN  IN BITS 34-35 A TWO BIT RELOCATION TO
;		'OR' IN WITH EXISTING BITS
;
; OUTPUTS- ACS T1 & T2 ARE PRESERVED
;	THE ENTRY POINTED TO IS REMOVED FROM THE IST AND THE
;	TABLE IS COLLAPSED WITH ISTPTR BEING DECREMENTED.
;

PMFIX:	TRNE	T3,2			;CONVERT TO HALFWORD RELOCATION
	TLO	T3,1
	TRZ	T3,2			;I.E. 1,,0 ETC INSTED OF 1B34
	PUSH	P,T3			;SAVE RELOCATION
	MOVE	T3,1(T1)		;GET FLAG WORD OF PAIR
	TXNN	T3,IS.LH		;IS THIS A LEFT HALF FIXUP?
	JRST	.+3			;NO,SKIP SWAP
	HRLZS	T2			;YES,GET IT INTO POSITION
	HRLZS	0(P)			;THE VALUE AND RELOCATION
	TXNN	T3,IS.NEG		;IS THIS A NEGATIVE REQUEST?
	JRST	.+3			;NO,SKIP NEGATION OF VALUE,RELOC
	MOVNS	T2			;YES,NEGATE VALUE
	MOVNS	0(P)			;AND RELOCATION
	HRRZ	A,1(T1)			;PICK UP LOCATION TO BE FIXED UP
	PUSHJ	P,WRDSRC		;MAP IT IN CORE
	 $STPCD(INTERIM SYMBOL TABLE fouled up)
	MOVE	T4,0(C)			;PICK UP ORIGINAL
	ADDM	T2,0(C)			;ADD IN OUR STUFF
	TXNN	T3,IS.LH!IS.FW		;IF NOT  LH OR FULLWORD
	HLLM	T4,0(C)			;INSURE LH NOT DISTURBED
	PUSHJ	P,GETREL		;GET RELOCATION FROM (B) &(C)
	POP	P,T4			;GET NEW RELOCATION
	TRNE	D,2			;CONVERT TO USEABLE FORMAT
	TLO	D,1			;FOR ADDITION
	TRZ	D,2
	PUSH	P,D			;SAVE IT
	ADD	D,T4			;MERGER RELOCATIONS
	TXNN	T3,IS.LH!IS.FW		;UNLESS LH OR FULL WORD
	HLL	D,0(P)			;RESTORE LH OF RELOCATION
	POP	P,0(P)			;
	TDNE	D,[^-<1,,1>]		;MAKE SURE ITS VALID
	JRST	FXRERR			;
	TLNE	D,1			;RESET TO RELOCATION IN BITS 34-5
	TRO	D,2			;
	HRRZS	D
	PUSHJ	P,CHGREL		;AND RE-DEPOSIT RELOCATION
	
PMFIX1:	PUSH	P,T1			;SAVE T1 ACROSS CALL
	MOVE	T2,[POINT 1,ISTMAP]	;POINTER TO MAP
	SUBI	T1,IST			;GET INDEX INTO IST
	LSH	T1,-1			;TWO WORDS PER PAIR
	IBP	T2			;INCREMENT BYTE POINTER
	SOJGE	T1,.-1			;TO BE IN RIGHT PLACE
	SETZM	T1
	DPB	T1,T2			;DEPOSIT BYTE
	PJRST	T1POPJ			;RETURN, RESTORING BYTE POINTER

FXRERR:	MOVE N,0(T1)			;PICK UP SYMBOL NAME
	$KILL(IRF,Illegal relocation in FORWARD reference to,N$SIX,$MORE)
	JRST	SAYEDT
SUBTTL MACRO STATMENT EVALUATOR

; /EVAL/  -	THIS ROUTINE TAKES INPUT FROM THE SOURCE STREAM
;	AND RETURNS A FULL WORD THAT IS THE RESULT OF EVALUATING IT
;	AS MACRO-10 ASSEMBLY LANGUAGE.
;	IT ALSO SETS UP THE IST (INTERIM SYMBOL TABLE) AND THE
;	SYMBOL TABLE .
;

EVAL:	MOVEM	P,EVLPP			;SAVE PDL POINTER ON ENTRY
	PUSHJ	P,MACLOD		;GET A LINE OF MACRO CODE

EVAL0:	PUSHJ	P,MACSAV		;SAVE BUFFER POINTER
	BYPASS				;GET FIRST NON-BLANK CHARACTER
	CAIN	CC,";"			;IF INTO COMMENT,
	PUSHJ	P,FINLIN		;FINISH THE LINE OFF
	CAIN	CC,$EOL			;END OF LINE?
	JRST	EVAL			;YES,IGNORE LINE

	TXO	F,REGET			;REGET CHARACTER

EVAL1:	SKPNUM				;IS NEXT CHARACTER A DIGIT?
	  SKPR50			;NO, IS IT RADIX50 SYMBOL?
	  JRST	EVAL5			;NOT LABEL
	CAIN	CC,"."			;"." FOLLOWED BY 0-9 IS A NUMBER
	JRST	[PUSHJ P,MACPEK		;LOOK AHEAD ONE CHARACTER
		 CAIL  A,"0"
		 CAILE A,"9"		;BASE 10
		 JRST  .+1		;NOT NUMERIC
		 JRST  EVAL5]		;WAS NUMERIC
	PUSHJ	P,SYMIN			;GET A SYMBOL
	CAIE	CC,":"			;DID IT END WITH COLON?
	JRST  [	PUSHJ	 P,MACRST	;RESTORE
		 JRST	EVAL5]		;AND CONTINUE
	MOVE	R,A			;LOAD R WITH SYMBOL NAME
	PUSHJ	P,SYMSRC		;AND LOOK IT UP
	  CAIA				;NOT THERE SO ITS OK
	JRST	MERROR			;DONT ALLOW REDEF OF EXISTING LABEL
	SETZ	B,			;START WITH NO SYMBOL FLAGS
	PUSHJ	P,MACPEK		;LOOK BEHIND THE ":"
	CAIE	A,":"			;IS IT A COLON TOO?
	JRST	EVAL2			;NO
	PUSHJ	P,MIC			;YES,SWALLOW IT
	TXO	 B,R5.GLB		;FLAG AS GLOBAL DECLARATION
	PUSHJ P,MACPEK			;LOOK BEHIND THE SECOND COLON
EVAL2:	CAIE	A,"!"			;EXCL PT. BEHIND COLON?
	JRST	EVAL3			;NO
	PUSHJ	P,MIC			;YES,SWALLOW IT
	TXO	B,R5.DDT		;AND FLAG AS SUPRESSED
EVAL3:	MOVEM	R,LLABEL		;STORE LAST LABEL
	SETZM	LLOFF			;AND ZERO THE OFFSET
	PUSHJ	P,RAD50			;CONVERT TO RADIX50
	IOR	R,B			;TURN ON ANY FLAGS COLLECTED
	MOVE	A,CPADDR		;GET VALUE FOR THIS SYMBOL
	TXNN	F,IAI			;ARE WE IN AN INSERT?
	JRST	[ MOVE N,LLABEL
           $WARN(LII,LABEL outside of .INSERT was ignored:,N$SIX)
	    JRST EVAL0]
	MOVEI	B,1			;RELOCATE THE ADDRESS OF SYMBOL
	PUSHJ	P,NEWSYM		;REGISTER THE SYMBOL
	  JRST	STOERR			;SYMBOL TABLE OVERFLOW
	PUSHJ	P,PMLOC			;CLEAR ANY LOCAL FIXUPS ON THIS SYMBOL
	JRST	EVAL0			;CHECK FOR MORE LABELS,ETC.

EVAL5:	MOVEI	A,ETCERR		;GET PDL OVERFLOW TRAP LOCATION
	MOVEM	A,.JBAPR##		;AND SET FOR APR INTERUPT
	MOVX	A,AP.POV		;TRAP ONLY PDL OVERFLOW
	APRENB	A,			;DO IT
	SETZM	OPRPTR			;CLEAR STACK POINTERS
	SETZM	OPTPTR			;FOR OPERATORS AND OPERANDS

	PUSHJ	P,EVALPS		;EVALUATE PRIMARY STATEMENT

	CAIE	CC,$EOL			;SHOULD ONLY RETURN ON $EOL
	JRST	QERROR			;ILLEGAL TERMINATOR
	SKIPE	NULFLG			;IF NULL STATEMENT,GO GET
	JRST	EVAL			;GET ANOTHER ONE
	SETZM	.JBAPR##		;UN-DO THE TRAP
	SETZ	A,			;FOR PDL OVERFLOW
	APRENB	A,			;SINCE IT COULD BE MISLEADING
	MOVE	C,CPADDR		;CURRENT ADDRESS
	TXO	C,IS.GEN		;FLAG THAT WORD HAS BEEN GENERATED
	HRRZ	B,R%S			;SEE IF IST NEEDS FIXUP
	JUMPE	B,.+2
	IORM	C,1(B)			;SET IT UP
	HLRZ	B,R%S			;
	JUMPE	B,.+3			;SAME FOR LEFT HALF
	TXO	C,IS.LH			;LEFT HALF FIXUP FLAG
	IORM	C,1(B)			;DONE
	MOVE	D,R%R			;MAKE CHECK ON RELOCATABILITY
	TDNE	D,[^-<1,,1>]		;CAN BE 0,,0 1,,1  1,,0 OR 0,,1
	JRST	RERROR			;BUT IT WASNT, CALL IT ERROR
	POPJ	P,			;RETURN
COMMENT  \

THIS ROUTINE IS A RECURSIVE MACRO STATMENT EVALUATOR
WHICH IS CALLED WHENEVER :

1) THERE IS A PRIMARY STATEMENT (IE JUST LEFT LABEL FIELD)
2) A LEFT BRACKET 74  WAS SEEN
3) A LEFT PARENTHESIS WAS SEEN "("
4) A LEFT BRACKET WAS  SEEN "["

THE CURRENT STATE IS SAVED ON ENTRY, AS REFLECTED BY THE
ACS %F,%V,%R,%S. THE RESULT IS RETURNED ON EXIT IN THE MEMORY LOCATIONS
R%F,R%V,R%R,R%S.

USAGE:	%V	CONTAINS THE VALUE OF THE STATEMENT
	%R	CONTAINS IN EACH HALF THE MULTIPLIER OF RELOC CONSTANT
		WHICH CAN BE EITHER 0 OR 1
	%S	CONTAINS IN EACH HALF EITHER 0 OR THE ADDRESS OF A 
		TWO WORD ENTRY IN THE IST FOR FIXING UP FORWARD REFERENCES
	%F	CONTAINS FLAGS INDICATING OUR POSITION
		IN THE MACRO-10 STATEMENT.


EVALUATION OF THE MACRO-10 EXPRESSIONS IS DONE USING A TWO STACK
PRECEDENCE GRAMMAR EVALUATOR. ONE STACK CONTAINS THE OPERANDS
AND THE OTHER CONTAINS THE OPERATORS.
EACH OPERAND ENTRY CONTAINS 4 WORDS,SIMILIAR
IN USE TO THE ACS %F,%V,%R,AND %S. THESE ARE COMBINED
TO FORM LARGER EXPRESSIONS AND FINALLY A FULL MACRO-10 STATEMENT.


\



; LOCAL ACS
	%V==T1
	%R==T2
	%S==T3
	%F==T4

; FLAGS IN %F

	$1BIT==1
	BIT(C.SYM)		;CURRENT CELL IS A SYMBOL
	BIT(C.NUM)		;CURRENT CELL IS A NUMBER
	BIT(C.AT)		;CURRENT CELL WAS "@"
	BIT(C.IDX)		;CURRENT CELL WAS "(...)"
	BIT(C.FLT)		;CURRENT CELL IS FLOATING POINT
	BIT(C.UDF)		;CURRENT CELL IS AN UNDEFINED SYMBOL
	BIT(C.EXT)		;CURRENT CELL IS EXTERNAL SYMBOL
	BIT(C.LHNZ)		;CURRENT CELL HAS DATA IN LH
	BIT(C.NULL)		;CURRENT CELL IS NOT THERE
	BIT(C.OP)		;CURRENT CELL IS AN OP CODE SYMBOL
	BIT(C.ASG)		;CURRENT CELL IS SYMBOL TO ASSIGN VALUE TO
	BIT(C.POP)		;CURRENT CELL IS A PSEUDO-OP SYMBOL
	BIT(C.LIT)		;CURRENT CELL IS A PSEUDO-LITERAL

	; BITS USED IN %F REGISTER FOR CURRENT CONTEXT
	$1BIT==1
	BIT(S.AT)	;SEEN A @
	BIT(S.ADR)	;SAW AN ADDRESS
	BIT(S.IDX)	;SAW AN INDEX
	BIT(S.AC)	;SAW AN AC
	BIT(S.OP)	;SEEN AN OPCODE
	BIT(S.ASG)	;THIS STATEMENT ASSIGNS VALUE
	BIT(S.DC)	;SAW A ,,
	BIT(S.DC1)	;TEMP BIT FOR ,, PROCESSING
	BIT(S.IOWD)	;SEEN AN IOWD
	BIT(S.XWD)	;SEEN AN XWD
	BIT(S.EXT)	;SAW "##" AFTER SYMBOL NAME
	BIT(S.DEF)	;SAW "#" AFTER SYMBOL NAME
	BIT(S.NNUL)	;STATEMENT IS NOT NULL
	BIT(S.IOI)	;STATEMENT CONTAINS AN IO TYPE INSTRUCTION
	BIT(S.NPS)	;STATEMENT IS NOT PRIMARY,IE. "<>" OR "[]" OR "()"
	BIT(I.OP)	;IN OP-CODE FIELD
	BIT(S.ASCZ)	;CURRENT ASCII GETS NULL AT END
	BIT(P.IOWD)	;IOWD PSEUDO OP PENDING
	BIT(P.XWD)	;XWD PENDING
	BIT(P.AT)	;@ INDICATOR PENDING
	BIT(S.CN1)	;CURRENT NESTING LEVEL
	BIT(S.CN2)	;..
	BIT(S.CN3)	;..
	BIT(S.CN4)	;..
	BIT(S.CN5)	;..
	BIT(S.CN6)	;..
	  S.CNL==S.CN1!S.CN2!S.CN3!S.CN4!S.CN5!S.CN6 ; MAKE ACCESS MASK
; EVALUATE A STATEMENT

EVALPS:	TDZA	D,D			;EVALUATE PRIMARY STATEMENT
EVALS:	SETO	D,			;EVALUATE NON-PRIMARY STATEMENT
	PUSH	P,%F			;SAVE CURRENT STATE
	PUSH	P,%S
	PUSH	P,%R
	PUSH	P,%V			;ACS %(F,S,R,V)
	SETZB	%R,%F			;CLEAR THE ACS
	SETZB	%V,%S			;FOR CURRENT USE
	SKIPE	D			;ARE WE JUST AFTER LABEL FIELD?
	TXO	%F,S.NPS		;NO, SO NOT PRIMARY STATEMENT
	MOVE	D,NSTLVL		;GET CURRENT NESTING LEVEL OF <>
	DPB	D,[POINTR(%F,S.CNL)]	;STORE INTO CONTEXT REGISTER
	TXO	%F,I.OP			;START IN OP CODE FIELD
EVALS1:	PUSHJ	P,EVALEX		;GET FIRST EXPRESSION
	TXNN	D,C.ASG			;IS THIS ASSIGNMENT?
	JRST	EVLS1A			;NO,SO SKIP SETTING UP
	TXOE	%F,S.ASG		;REMEMBER THIS FOR LATER
	JRST	QERROR			;ERROR IF WE ALREADY KNOW
	PUSH	P,ASGSYM		;SAVE OLD SYMBOL TO ASSIGN TO
	PUSHJ	P,ASGEVL		;GO EVALUATE PLETHORA OF TYPES
	JRST	EVALS1			;NOW GO DO THE STATMENT ITSELF

EVLS1A:	TXNN	D,C.NULL		;IF NOT NULL CELL,
	TXO	%F,S.NNUL		;TURN ON NOT NULL BIT
	TXZN	%F,P.AT			;INDIRECT BIT INDICATOR SEEN?
	JRST	EVALS2			;NO,SKIP TEST,TURN ON
	TXOE	%F,S.AT			;ONLY ONE INDIRECT BIT PER STATEMENT
	JRST	QERROR			;FILTER OUT DUPLICATES
	TXO	%V,<@>			;TURN IT ON IN THE WORD RETURNED
	TXO	%F,S.OP			;ILLEGAL TO SEE OPCODE NOW
	TXZ	%F,I.OP			;AND WE ARE NOT IN THAT FIELD
EVALS2:	TXNE	%F,I.OP			;IN OPCODE FIELD?
	TXNN	D,C.OP			;WITH AN OPCODE RETURNED?
	CAIA
	JRST	EVALS4			;YES,SO ITS NOT AN AC
	BYPASS				;GET NEXT CHARACTER
	SKPCM				;END WITH COMMA?
	JRST	[TXO F,REGET		;NO
		 JRST EVALS4]		;SO ITS NOT AN AC
	TXNE	%F,P.XWD!P.IOWD		;IF IOWD OR XWD SEEN,
	JRST	EVLS2B			;PROCESS IT
	PUSH	P,A			;SAVE AC A
	PUSHJ	P,MACPEK		;LOOK AHEAD ONE CHARACTER
	CAIN	A,","			;OR IS IT ANOTHER COMMA?
	JRST	EVLS2A			;YES,HANDLE IT
	POP	P,A			;NO,RESTORE VALUE
	TXNN	D,C.IDX+C.AT		;TRY TO CATCH SOME JUNK
	TXOE	%F,S.AC			;AND CHECK FOR STUFF
	JRST	QERROR			;ONLY 1 AC FIELD ALLOWED
	JUMPN	B,RERROR		;MUST BE ABSOLUTE AND DEFINED
	JUMPN	C,FERROR		;TO BE USED AS AN AC
	ANDI	A,177			;MASK TO MAXIMUM
	TXNN	%F,S.IOI		;IS THIS AN IO INSTRUCTION?
	TXZA	A,<^-17>		;NO,MASK TO AC WIDTH AND DON'T LSH
	LSH	A,1			;1+LATER 23 IS PROPER LSH FOR IO DEVICE
	LSH	A,^D23			;GET IT INTO POSITION
	ADD	%V,A			;AND ADD INTO IT
	JRST	EVALS7

EVLS2A:	POP	P,A			;RESTORE VALUE
	PUSHJ	P,MIC			;EAT THE SECOND COMMA
EVLS2B:	TXOE	%F,S.DC!S.AC!S.XWD!S.IOWD	;MAKE SYNTAX CHECK
	JRST	QERROR			;
	TXO	%F,S.DC1		;MORE PROCESSING LATER
	JRST	EVALS5			;CONTINUE

EVALS4:	TXNN	D,C.IDX			;INDEX?
	JRST	EVALS5			;NO
	TXOE	%F,S.IDX		;PREVENT DUPLICATES
	JRST	QERROR
	TXO	%F,S.OP!S.AC!S.AT!S.ADR ;PREVENT ANY FURTHER STUFF
	ADD	%V,A			;ADD IN
	ADD	%R,B			;ALSO THE RELOCATABILITY
	JRST	EVALS6			;CHECK IST AND CONTINUE

EVALS5:	TXZN	%F,I.OP			;STILL IN OPCODE FIELD?
	JRST	EVLS5A			;NO,MUST BE ADDRESS FIELD
	TXOE	%F,S.OP			;FLAG OPCODE SEEN AND
	JRST	QERROR			;KILL ON DUPLICATE
	MOVE	%V,A			;LOAD VALUE
	MOVE	%R,B			;RELOCATABILITY
	JRST	EVALS6			;CONTINUE AS USUAL

EVLS5A:	TXOE	%F,S.ADR		;ADDRESS?
	JRST	QERROR			;BY DEFAULT , I GUESS IT IS
	TXO	%F,S.OP!S.AC!S.AT	;PREVENT REDUNDANT STUFF
	TLNE	A,-1			;IS LEFT HALF ZERO?
	TLC	A,-1			;NO,TRY COMPLEMENT
	TLNE	A,-1			;AND REPEAT TEST
	JRST	QERROR			;ERROR IF NOT -1,,VALUE OR 0,,VALUE
	TLNE	C,-1			;CANT BE A FIXUP ON LH
	JRST	QERROR
	MOVX	T,IS.FW			;SET UP FOR FULL WORD FLAG
	SKIPE	C			;DOES THIS HALF HAVE FIXUP?
	ANDCAM	T,1(C)			;YES,CLEAR FULL WORD BIT
	MOVE	T,%V			;DO HALF WORD ADDITION
	ADD	T,A			;SO DONT WIPE OUT
	HRRM	T,%V			;OPCODE ETC.
	ADD	%R,B			;ADD IN THE RELOCATION TOO
EVALS6:	TLNE	%S,-1			;DONT ALLOW 2 RHALVES OR 2 LHALVES ON
	TLNN	C,-1
	CAIA
	JRST	FERROR
	TRNE	%S,-1
	TRNN	C,-1
	CAIA
	JRST	FERROR			;IE LH(%S) + RH(C) IS OK,ETC
	IOR	%S,C			;MERGE THE TWO
	TXZN	%F,S.DC1		;HALFWORD SWAP INDICATED?
	JRST	EVALS7			;NO,SO CHECK DELIMITERS
	TLNN	%R,-1			;IF FIXED UP OR RELOCATED LH
	TLNE	%S,-1			;
	JRST	QERROR			;THEN CANT DO WITHOUT LOSING DATA
	TLNE	%V,-1			;IS VALUE ITSELF 0 IN LH?
	TLC	%V,-1			;NO,TRY TO SEE IF ITS -1
	TLNE	%V,-1			;AND REPEAT TEST
	JRST	QERROR			;INDICATE LOST DATA
	MOVSS	%V			;SWAP VALUE
	MOVSS	%R			;RELOCATION
	MOVSS	%S			;AND FIXUP
					;FALL INTO EVALS7

EVALS7:	TXZ	%F,I.OP			;NOT IN OPCODE AFTER FIRST TOKEN
	BYPASS				;GET NEXT NON BLANK
	CAIN	CC,RABRKT		;CHECK FOR R. ANGLE BRACKET
	JRST	[ LDB T,[POINTR(%F,S.CNL)] ; GET ENTRY NESTING LEVEL
		  CAMN T,NSTLVL		;ARE WE AT THAT LEVEL NOW?
		  JRST EVALS9		;YES, SO THIS BRACKET ENDS STATEMENT
		  SOS	NSTLVL		; ELSE DECREMENT NST LEVEL
		  JRST	EVALS7 ]	; AND TRY AGAIN
	CAIN	CC,";"			;IS THIS COMMENT START?
	PUSHJ	P,FINLIN		;YES,FINISH LINE OFF
	CAIE	CC,")"			;RIGHT PARENTHESIS OR
	CAIN	CC,$EOL			; END OF LINE FINISHES STATEMENT
	JRST	EVALS9			;
	CAIN	CC,"]"			;ALSO , END OF LITERAL DOES TOO
	JRST	EVALS9
	TXO	F,REGET			;NOT A TERMINATOR, REGET IT
	JRST	EVALS1			;AND RE-ITERATE

EVALS9:	TXNN	%F,P.IOWD		;IOWD SEEN?
	JRST	EVLS9A			;NO,SO SKIP THE FIX UP
	TLNE	%R,-1			;ABSOLUTE REQUIRED
	JRST	RERROR
	TLNE	%S,-1			;MUST BE KNOWN TOO
	JRST	FERROR
	HLRZ	T,%V			;GET VALUE TO NEGATE
	MOVNS	T			;NEGATE IT
	SOS	%V			;BACK ADDRESS BACK ONE
	HRLM	T,%V			;RESTORE VALUE (LH)
EVLS9A:	MOVEM	%V,R%V			;RETURN ACS INTO R%<AC>
	MOVEM	%R,R%R			;
	MOVEM	%S,R%S
	MOVEM	%F,R%F			;FOR LATER EXAMINATION
	SETZM	NULFLG			;CLEAR "THIS IS NULL STATEMENT" FLAG
	TXNN	%F,S.NNUL		;IS NOT NULL FLAG ON?
	SETOM	NULFLG			;NO,SO IT IS NULL
	TXNN	%F,S.ASG		;WAS THIS BEING ASSIGNED TO SYMBOL?
	JRST	EVLS9B			;NO,SO DONT CALL ASGMAK
	PUSHJ	P,ASGMAK		;MAKE THE ASSIGNMENT
	POP	P,ASGSYM		;RESTORE PREVIOUS VALUE
EVLS9B:	POP	P,%V			;RESTORE PREVIOUS VALUES
	POP	P,%R
	POP	P,%S
	POP	P,%F			;
	POPJ	P,			;AND THEN RETURN
; /EVADR/ - ROUTINE TO EVALUATE STANDARD ADDRESS FORMAT
;
; THIS ROUTINE RETURNS IN THE AC BLOCK  A-D AN EXPRESSION
; CREATED BY EVALUATING A STRING OF THE FORM:
;	(WITH ALL PARTS OPTIONAL)
;	<@>  <EXPRESSION>  <(EXPRESSION)>

EVADR:	SETZ	A,			;START WITH 0
	BYPASS
	CAIN	CC,"@"			;INDIRECT BIT WOULD COME FIRST
	SKIPA	A,[<@>]			;MARK PROPER BIT ON
	TXO	F,REGET			;OTHERWISE,REGET CHARACTER
	PUSH	P,A			;SAVE PARTIAL RESULT
	PUSHJ	P,EVALEX		;EVALUATE ADDRESS PART
	TLNE	A,-1			;INSURE LH=0
	TLC	A,-1
	TLNE	A,-1
	JRST	QERROR			;
	IORM	A,0(P)			;UPDATE PARTIAL RESULT
	PUSH	P,B			;SAVE RELOC
	PUSH	P,C			;SAVE FIXUP
	CAIE	CC,"("			;DO WE HAVE INDEX NEXT?
	JRST	EVADR2			;NO,SO SKIP IT
	PUSHJ	P,EVALEX		;EVALUATE IT
	CAIN	CC,")"			;MAKE SURE OF MATCHING PARENS
	JRST	QERROR			;ELSE BOMB OUT
	BYPASS				;LOAD NEXT CHARACTER
	TXO	F,REGET			;FOR CHECKS LATER
	MOVE	T,0(P)			;GET FIXUP WORD
	TLNE	T,-1			;PREVENT FOULUPS
	JRST	[TLNE C,-1
		 JRST FERROR
		 JRST .+1]
	TRNE	T,-1
	JRST	[TRNE C,-1
		 JRST FERROR
		 JRST .+1]
	ADDM	A,-2(P)			;UPDATE VALUE
	ADDM	B,-1(P)			;UPDATE RELOCATION
	ADDM	C,0(P)			;UPDATE FIXUP
EVADR2:	POP	P,C			;RETURN WITH FIXUPS HERE
	POP	P,B			;RELOC HERE
	POP	P,A			;VALUE HERE
	TLNE	C,-1			;DONT ALLOW LH FIXUPS
	JRST	QERROR
	MOVX	T,IS.FW			;GET FULLWORD FIXUP FLAG
	SKIPE	C			;IS THERE A FIXUP HERE?
	ANDCAM	T,1(C)			;YES,SHUT OFF FULLWORD OK FLAG
	TDNE	A,[<^-<Z @ -1(17)>>]	;GENERATE Q ERROR IF NON-ADDR
	JRST	QERROR			;AREN'T 0
	MOVX	D,C.NUM			;CALL IT A NUMBER
	POPJ	P,			;AND RETURN
; /EVALEX/ - THIS ROUTINE COMBINES CELLS SEPARATED BY BINARY OPERATORS
;	INTO EXPRESSIONS. THE ROUTINE USES A TABLE OF OPERATORS AND
;	THEIR RELATIVE PRECEDENCE TO KNOW WHEN TO STACK AND WHEN TO EXECUTE
;	AND COLLAPSE. THE ROUTINE EXITS WHEN THE SYMBOL AFTER
;	A READ IN CELL IS NOT RECOGNIZED AS A VALID BINARY OPERATOR.
;	TWO STACKS ARE USED: OPRSTK FOR OPERANDS AND OPTSTK FOR
;	OPERATORS. SPECIAL SAFETY CHECKS ARE MAINTAINED TO INSURE PHASE OF THESE STACKS
;	ROUTINE CELL RETURNS THE 4 REGISTER BLOCK OF
; VALUE,RELOCATION,FIXUP , FLAGS IN ACS A-D AND EVALEX IN TURN RETURNS ONE
; VALUE FOR THE WHOLE EXPRESSION, IN THESE ACS.
;

	IMPCHR==200			;IMPOSSIBLE ASCII CHARACTER
					;USED TO MAKE CHARACTER ENTRY IN TABLES
					;FOR TWO CHARACTER OPS (IE ^!)

EVALEX:	PUSH	P,OPRTOP		;SAVE LAST TOP OF STACK
	PUSH	P,OPTTOP		;FOR OPERANDS AND OPERATORS
	MOVE	T,OPTPTR		;SET OUR CURRENT STACK FRAME START
	MOVEM	T,OPTTOP
	MOVE	T,OPRPTR		;SO WE KNOW OUR LIMITS
	MOVEM	T,OPRTOP
	PUSHJ	P,CELL			;GET FIRST CELL
	TXNE	D,C.NULL		;IS IT THE NULL CELL?
	JRST	EVLXX1			;YES,RETURN 0
	SKIPA				;PROCESS EXPRESSION
EVALXB:	PUSHJ	P,CELL			;GET A CELL
EVLXB1:	TXNE	D,C.NULL		;DONT ALLOW NULL CELLS HERE
	JRST	QERROR
	PUSHJ	P,PSHOPR		;PUSH OPERAND QUARTET ONTO STACK
	TXNN	%F,I.OP			;SPECIAL CHECK FOR OPCODE FIELD
	JRST	EVLXB2			; NOT IN THAT FIELD
	TXNE	D,C.OP!C.ASG		;IS THIS OPCODE OR ASSIGNMENT SYMBOL?
	JRST	[SETZ A,		;YES,SO FORCE END OF EXPRESSION
		 JRST EVALX2]		;
EVLXB2:	BYPASS				;GET FIRST NON-BLANK CHAR
	TXNE	D,C.NUM			;SKIP THIS IF CELL NON-NUMERIC
	CAIE	CC,"B"			;DID CELL TERMINATE ON "B"?
	JRST	EVLXB3			;NO,SO SKIP THIS
	PUSH	P,A			;SAVE A
	PUSH	P,CC			;SAVE CC
	PUSHJ	P,MACPEK		;LOOK AHEAD ONE CHARACTER
	SETZ	T,			;ZERO FLAG
	MOVE	CC,A			;GET INTO POSITION
	SKPNUM				;SEE IF NEXT CHARACTER IS DIGIT
	  SKPR50			;SEE IF NEXT CHARACTER IS RADIX50
	    SETO    T,			;TURN FLAG ON IF NUMERIC OR NOT RADIX50
	POP	P,CC			;RESTORE CC
	POP	P,A			;RESTORE A
	JUMPL	T,EVALXN		;PROCESS BIT POSITIONER
EVLXB3:	CAIN	CC,"^"			;IF CHARACTER IS UPARROW
	JRST	[  PUSHJ P,MACPEK	;LOOK AHEAD
		  CAIE  A,"!"		;CURRENT BOP FOLLOWING ^ IS !
		  JRST  .+1
		   PUSHJ P,MIC   
		   MOVEI  CC,IMPCHR+"!"
		  JRST .+1]
	MOVSI	A,-BOPLEN		;LENGTH OF TABLE
EVALX1:	LDB	B,[POINT 8,BOPTAB(A),7]	;GET A CHARACTER FROM TABLE
	CAMN	B,CC			;IS IT A MATCH?
	JRST	EVALX2			;YES,WE HAVE A BOP
	AOBJN	A,EVALX1		;NO. ANY MORE LEFT?
	TXO	F,REGET			;RE-EAT THE CHARACTER
	SKIPA	A,[0]			;USE FAKE INDEX OF 0
EVALX2:	HRRZS	A			;A IS NOW INDEX TO TABLE
	MOVE	T,OPTPTR		;GET POINTER TO OPTSTAK
	CAMN	T,OPTTOP		;IS IT THE EMPTY STACK?
	JRST	[JUMPLE A,EVALXX	;YES,IF A.LE.0,SIMPLE CELL
		 MOVE  T,A		;SO SAVE OPERAND,OPERATOR ON STACK
		 PUSHJ	P,PSHOPT	;FOR LATER EVALUATION
		 JRST	EVALXB]		;AND GET RH OF EXPRESSION
	LDB	B,[POINT 5,BOPTAB(A),12] ;GET PRECEDENCE OF WINDOW OP
	PUSHJ	P,POPOPT		;POP OP ON TOP OF STACK
	LDB	C,[POINT 5,BOPTAB(T),12];GET ITS PRECEDENCE
	CAML	C,B			;EXECUTE TIME?
	JRST	EVALX4			;YES,GO DOIT
	PUSHJ	P,PSHOPT		;NO,RESTORE OLD OP TO TOP OF STACK
	MOVE	T,A			;GET INDEX OF CURRENT OP 
	PUSHJ	P,PSHOPT		;STACK IT TOO
	JRST	EVALXB			;GET NEXT CELL

EVALX4:	PUSH	P,A			;SAVE WINDOW OP'S INDEX
	PUSHJ	P,$XCT			;EXECUTE THE OPERATOR
	POP	P,A			;RESTORE INDEX
	JRST	EVALX2			;AND RE-ITERATE

EVALXX:PUSHJ	P,POPOPR		;LOAD A-D WITH FINAL OPERAND QUARTET
	MOVE	T,OPRPTR		;FINAL CONSISTENCY CHECK
	CAME	T,OPRTOP		;STACK SHOULD BOTH BE EMPTY
	JRST	QERROR

EVLXX1:	POP	P,OPTTOP		;RESTORE TOP OF STACKS
	POP	P,OPRTOP		;FOR LAST CALLER
	TLNN	A,-1			;SEE IF ANY DATA IN LEFT HALF OF
	TLNE	B,-1			;RETURNED EXPRESSION
	TXO	D,C.LHNZ		;FOR EASE OF CHECK VALIDITY
	TLNE	C,-1			;LATER
	TXO	D,C.LHNZ		;
	POPJ	P,			;AND RETURN

EVALXN:					;HERE FOR <NUMBER>B<CELL>
	PUSHJ	P,CELL10		;EVALUATE NEXT CELL,RADIX10.
	TXNE	D,C.NULL		;IF NULL CELL
	JRST	NERROR			;ITS AN ERROR
	JUMPN	B,RERROR		;MUST BE ABSOLUTE
	JUMPN	C,FERROR		;IN CASE WE DONT KNOW IT
	MOVEI	T,^D35			;SET UP FOR SHIFT
	SUB	T,A			;SHIFT 36-<CELL>
	PUSHJ	P,POPOPR		;GET THE OPERAND
	LSH	A,(T)			;SHIFT INTO PLACE
	LSH	B,(T)			;ALSO SHIFT RELOCATABLE BITS
	JRST	EVLXB1			;AND CONTINUE

EVLX10:					;HERE TO CALL EVALEX WITH RADIX=^D10
	PUSH	P,CRADIX		;SAVE CURRENT RADIX
	MOVEI	T,^D10			;USE BASE 10.
	MOVEM	T,CRADIX		;FOR RADIX IN THIS EXPRESSION
	PUSHJ	P,EVALEX		;NOW EVALUATE EXPRESSION
	POP	P,CRADIX		;RESTORE RADIX
	POPJ	P,			;AND RETURN
; SUBROUTINE TO EXECUTE BINARY OPERATORS IN MACRO STATEMENTS
;
; ENTER WITH AC T BEING THE INDEX INTO BOPTAB
; TOP TWO OPERAND QUARTETS ON OPRSTK ARE EVALUTED AND THE RESULT
; PUSHED BACK ONTO OPRSTK
;

; LOCAL REGISTER ASSIGNMENTS

	%LV==A		;LEFT HAND VALUE
	%LR==B		;LEFT HAND RELOC
	%LS==C		;LEFT HAND SYMBOL FIXUP
	%LF==D		;LEFT HAND FLAGS

	%RV==T1		;RIGHT HAND VALUE
	%RR==T2		;RIGHT HAND RELOC
	%RS==T3		;RIGHT HAND SYMBOL FIXUP
	%RF==T4		;RIGHT HAND FLAGS


$XCT:	PUSHJ	P,.PSH4T##		;SAVE ACS,WE NEED THEM
	PUSHJ	P,POPOPR		;GET OPERAND (LH)
	MOVE	%RV,A			;STORE RIGHT HAND SIDE AWAY
	MOVE	%RR,B
	MOVE	%RS,C
	MOVE	%RF,D
	PUSHJ	P,POPOPR		;POP LEFT HAND OPERAND
	JRST	@BOPTAB(T)		;DISPATCH ON TABLE

$ADD:	ADD	%LV,%RV			;ADD IS LV+RV
	ADD	%LR,%RR			;ADD IS RELOC+RELOC
	TLNE	%LS,-1			;ALLOW EITHER HALF TO BE FIXED UP
	JRST	[ TLNE %RS,-1
		  JRST FERROR
		  JRST .+1]
	TRNE	%LS,-1
	JRST	[ TRNE %RS,-1
		  JRST FERROR
		   JRST .+1]
	IOR	%LS,%RS			;INCLUSIVE OR THE SYMBOL FIXUPS
	JRST	$XCT2			;DONE

$SUB:	MOVE	T,%RS			;GET RH SYMBOL FIXUP
	JUMPN	T,[JUMPN %LS,FERROR	;CHECK FORWARD REFERENCE
		PUSH P,A
		MOVX	A,IS.DER	;DONT ALLOW SUBTRACTION OF EXTERNAL
		TDNE	A,1(T)
		JRST	FERROR
		MOVX	A,IS.NEG	;NEGATE FIXUP
		IORM	A,1(T)		;SET FLAG TO INDICATE IT
		HLRZS	T
		POP   P,A
		JRST .]			;TRY OTHER HALF
	IOR	%LS,%RS
	SUB	%LV,%RV			;DO THE SUBTRACTION
	SUB	%LR,%RR			;ALSO THE RELOCATION
	JRST	$XCT2			;AND CONTINUE


$MUL:	JUMPE	%LR,.+3			;MUST HAVE ONE SIDE FIXED
	JUMPE	%RR,.+2			;
	JRST	RERROR			;BUT WE DONT
	JUMPN	%LS,FERROR		;CANT LET 
	JUMPN	%RS,FERROR		;EITHER SIDE BE DEFERRED
	TXNN	%LF,C.FLT		;CANT MULTIPLY FLOATING POINT
	TXNE	%RF,C.FLT		;
	JRST	NERROR			;
	IOR	%LR,%RR			;
	JUMPE	%RR,.+2			;MAKE RIGHT SIDE BE FIXED VALUE
	EXCH	%RV,%LV			;SO RELOC COMES OUT RIGHT
	IMUL	%LV,%RV			;DO THE MULTIPLICATION
	IMUL	%LR,%RV			;ALSO ON THE RELOC BITS
	JRST	$XCT2			;DONE


$DIV:	JUMPN	%LS,FERROR		;BOTH SIDES MUST BE KNOWN
	JUMPN	%RS,FERROR
	JUMPN	%RR,RERROR		;DENOMINATOR MUST BE FIXED
	TXNN	%LF,C.FLT		;CANT DIVIDE FLOATING POINT
	TXNE	%RF,C.FLT		;
	JRST	NERROR			;
	PUSH	P,%LV+1			;COVER UP 
	IDIV	%LV,%RV			;DIVIDE
	POP	P,%LV+1
	IDIV	%LR,%RV			;
	SETZM	%LS			;INCASE DIVIDE OF %LR PUTS ANYTHING HERE
	JRST	$XCT2			;DONE

$AND:	JUMPN	%LS,FERROR		;FOR AND MUST HAVE BOTH SIDES
	JUMPN	%RS,FERROR
	IOR	%LR,%RR			;FOR LATER CHECK
	AND	%LV,%RV			;AND THE VALUES
	JRST	$XCT1			;THATS ALL

$OR:	JUMPN	%LS,FERROR		;MUST KNOW BOTH
	JUMPN	%RS,FERROR
	IOR	%LV,%RV			;OR THE VALUES
	IOR	%LR,%RR			;AND RELOC
	JRST	$XCT1			;DONE

$XOR:	JUMPN	%LS,FERROR		;CANT USE DEFERRED VALUES
	JUMPN	%RS,FERROR
	XOR	%LV,%RV			;XOR
	IOR	%LR,%RR			;FOR LATER CHECK
	JRST	$XCT1

$LSH:	JUMPN	%LS,FERROR		;
	JUMPN	%RS,FERROR		;BOTH MUST BE KNOWN
	JUMPN	%RR,RERROR		;SHIFT VALUE MUST BE FIXED
	LSH	%LV,(%RV)		;DO THE SHIFT
	LSH	%LR,(%RV)		;ALSO ON THE RELOC
	JRST	$XCT2

$XCT1:	JUMPN	%LR,RERROR		;CHECK FOR FIXED RESULT
$XCT2:	IOR	%LF,%RF			;COMBINE FLAGS
	PUSHJ	P,PSHOPR		;
	PUSHJ	P,.POP4T##		;RESTORE THE ACS
	POPJ	P,			;RETURN
; TABLE OF BINARY OPERATORS AND THEIR PRECEDENCES
;
; FORMAT OF EACH ENTRY IS AS FOLLOWS:
;
; BITS:
;	0-7	ASCII CHARACTER OF OPERATOR,NOTE THAT ITS 8 BITS TO ALLOW
;		FOR FAKE CHARACTERS.
;	8-12	THE RELATIVE PRECEDENCE FOR THIS OPERATOR, IN RANGE 0-32
;	13	LEAVE IT OFF, SO CAN USE INDIRECT SAFELY
;	18-35	ADDRESS OF ROUTINE TO EXECUTE THIS OPERATOR
;

	DEFINE  DBOP<

	X 0,0,0		;FAKE ENTRY TO FORCE REDUCTION
	X "+",2,$ADD
	X "-",2,$SUB
	X "*",4,$MUL
	X "/",4,$DIV
	X "&",6,$AND
	X "!",6,$OR
	X "!"+IMPCHR,6,$XOR
	X "_",8,$LSH       

>	; END OF DBOP DEFINITION

	DEFINE X($A,$B,$C)<

	IFG <$B>-^D32, <PRINTX PRECEDENCE TOO GREAT IN BOPTAB>
	<$A>B7+<$B>B12+<$C>  
>


BOPTAB:	DBOP

	BOPLEN==.-BOPTAB
; /CELL/- THIS ROUTINE EVALUATES THE LOWEST LEVEL OF MACRO TOKEN.
;	SUCH AS SYMBOL,NUMBER, CONSTANT ETC. THESE ARE COMBINED BY
;	EVALEX WITH EVALS DOING THE CONTEXT SENSITIVE INTERPRETATION.
; 	CELL INTERPRETS THE LOW LEVEL TOKENS BY LOOKING AT THE
;	FIRST CHARACTER OF THE CELL AND THEN DISPATCHING TO THE APPROPRIATE
;	PROCESSOR FOR THAT CELL. THE VALUE ETC OF THE CELL IS RETURNED
;	IN A FOUR WORD AC BLOCK.
;
; OUTPUTS:
;	AC A CONTAINS THE VALUE OF THE READ IN CELL
;	AC B CONTAINS THE RELOCATION MULTIPLIER IN EACH HALF WORD
;	AC C CONTAINS , IN EACH HALFWORD POSSIBLE POINTERS TO THE
;	IST FOR FIXUPS ON LITERALS,EXTERNALS AND FORWARD REFERENCES
;	AC D CONTAINS FLAG(S) WHICH TELL HIGHER ROUTINES WHAT KIND
;	OF CELL WAS JUST READ IN.
;
;	IF THE FIRST CHARACTER IS NOT RECOGNIZED, A Q ERROR IS GENERATED.

CELL:	PUSHJ	P,MIC   		;GET A CHARACTER
	SKPNUM				;TEST FOR NUMERIC
	 CAIA				;SKIP IF NOT
	JRST	EVLP1			;PROCESSOR 1 (NUMBER)
	CAIN	CC,"."			;PERIOD?
	JRST	CELL1C			;YES,SHORT CIRCUIT THE SYMBOL CUTOUT
	SKPR50				;RADIX50 SYMBOL?
	 SKIPA				;NO
	JRST	EVLP2			;PROCESSOR 2 (SYMBOL)
CELL1C:	MOVSI	A,-FCDSPL		;LENGTH OF FIRST CHARACTER TABLE
CELL1D:	LDB	B,[POINT 7,FCDSP(A),6]	;GET CHARACTER
	CAMN	CC,B			;A MATCH?
	JRST	@FCDSP(A)		;YES,GO TO IT
	AOBJN	A,CELL1D		;MORE LEFT?
	JRST	QERROR			;NO,SO GIVE ERROR MESSAGE

ECELL:	POPJ	P,			;RETURN (COMMON CELL EXIT POINT)

NCELL:	TXO	F,REGET			;REGET THE DELIMITER
	SETZB	A,B			;CLEAR RESULT
	SETZ	C,
	MOVX	D,C.NULL		;FLAG IT AS NULL
	JRST	ECELL			;AND RETURN

CELL10:	MOVEI	A,^D10			;USE RADIX 10.
	PUSH	P,CRADIX		;SAVE CURRENT RADIX
	MOVEM	A,CRADIX		;
	PUSHJ	P,CELL			;EVALUATE CELL
	POP	P,CRADIX		;RESTORE RADIX
	POPJ	P,			;AND RETURN

MECELL:	TXO	F,REGET			;THIS CELL MUST END LINE,THIS CHARACTER
MCELL1:	BYPASS				;START W/NEXT CHARACTER
	CAIN	CC,";"			;INTO COMMENT?
	PUSHJ	P,FINLIN		;YES,FINISH OFF THE LINE
	CAIN	CC,$EOL			;AT END OF LINE?
	JRST	NCELL			;ITS A NULL CELL
	JRST	QERROR			;ITS A QERROR

	DEFINE	FC <			;DEFINE FIRST CHARACTER DISPATCH
					;TABLE FOR EVALUATOR
	IFE BIGLST,<XLIST>

	X " ",CELL		;SKIP BLANKS
	X "+",CELL		;AND UNARY "+"
	X "@",EVLP3		;AT SIGN (INDIRECT BIT)
	X "-",EVLP4		;UNARY MINUS "-"
	X SQUOTE,EVLP5		;SINGLE QUOTE,SIXBIT RIGHT JUSTIFIED
	X DQUOTE,EVLP5A		;DOUBLE QUOTE ASCII  RIGHT JUSTIFIED
	X LPAREN,EVLP6		;(  MEANS INDEXING 
	X LSBRKT,EVLP7		;[ MEANS START PSEUDO-LITERAL
	X LABRKT,EVLP8		;L. BRACKET,START EXPRESSION
	X ".",EVLP9		;PERIOD. NUMBER,CURRENT LOC, OR SYMBOL
	X "^",EVLP12		;UP-ARROW QUALIFIER
	X RABRKT, EVLP13	;CLOSE ANGLE BRACKET
	X SCOLON,NCELL		;IF INTO COMMENT,NULL CELL
	X $EOL,NCELL		;SAME FOR END OF LINE
	X RSBRKT , NCELL	;AND LITERAL
	X RPAREN , NCELL	;AND INDEX
	X 54,NCELL		;ALLOWS THINGS LIKE SETZM,FOO
	LIST

> ; END OF FC DEFINITION

; NOW LETS CREATE THE TABLE

	DEFINE X($A,$B)<
	<$A>B6+$B>

FCDSP:	FC
	FCDSPL==.-FCDSP
; PROCESSOR 1  - PROCESS NUMBER

EVLP1:	PUSH	P,CC			;SAVE FIRST CHARACTER
	TXO	F,REGET			;REGET FIRST DIGIT
	PUSHJ	P,MACSAV		;SAVE POSITION
	PUSHJ	P,CRADIN		;GET NUMBER
	CAIN	CC,"."			;IS TERMINATOR A PERIOD?
	JRST	EVLP1A			;YES,GO HANDLE IT
	POP	P,0(P)			;CLEAN STACK
	SETZB	B,C			;NOT RELOCATABLE OR A SYMBOL
	MOVX	D,C.NUM			;FLAG CELL AS NUMERIC
	TXO	F,REGET			;REGET OUR DELIMITER
	JRST	ECELL			;END OF CELL

EVLP1A:	PUSHJ	P,MACRST		;START NUMBER OVER AGAIN
	POP	P,CC			;RESTORE CHARACTER
	TXO	F,REGET			;AND REGET IT
	SETZ	A,			;CLEAR RESULT
EVLN1A:	PUSHJ	P,MIC   		;GET CHARACTER
	CAIN	CC,"."			;PERIOD?
	JRST	EVLN2			;YES,HANDLE FRACTION
	SKPNUM				;IS IT A DIGIT?
	  JRST	NERROR			;NO,BADLY FORMED DIGIT
	SUBI	CC,"0"			;MAKE NUMBER
	TLO	CC,233000		;FLOAT IT
	FMPR	A,[10.0]		;SHIFT OVER
	FADR	A,CC			;ADD IN OUR PART
	JRST	EVLN1A			;GO BACK FOR MORE

EVLN1B:	SETZ	A,			;NUMBER FRACTION ONLY
EVLN2:	MOVE	D,[0.1]			;FIRST FRACTION DIGIT
EVLN2A:	PUSHJ	P,MIC   		;GET CHARACTER
	SKPNUM				;IS IT NUMERIC?
	  JRST	EVLNF			;NO,FINISH UP
	SUBI	CC,"0"			;NUMBER IT
	TLO	CC,233000		;FLOAT IT
	FMPR	CC,D			;MULTIPLY TO GET IT FRACTIONAL
	FADR	A,CC			;ADD IN THIS PART
	FDVR	D,[10.]			;MAKE OUR FRACTION SMALLER
	JRST	EVLN2A			;BACK FOR MORE

EVLNF:	CAIN	CC,"E"			;END IN EXPONENT?
	PUSHJ	P,NUMEXP		;YES,GO PROCESS
	SETZB	B,C			;NO FIXUP OR RELOC
	TXO	F,REGET			;REGET DELIMITER
	MOVX	D,C.NUM+C.FLT		;
	JRST	ECELL			;END IT

NUMEXP:	PUSH	P,A			;SAVE VALUE OF NUMBER
	PUSHJ	P,CELL10		;GET EXPONENT IN RADIX10
	JUMPE	A,QERROR		;E0 IS ILLEGAL
	TXNN	D,C.FLT+C.IDX+C.LIT+C.SYM+C.NULL ;FILTER OUT SOME JUNK
	TXNN	D,C.NUM			;BUT MUST BE NUMERIC
	JRST	NERROR

	CAIG	A,^D38			;DONT LET IT BE TOO BIG
	CAMGE	A,[-^D38]		;OR TOO SMALL
	JRST	NERROR			;
	JUMPN	C,FERROR		;MUST BE COMPLETELY KNOWN
	JUMPN	B,NERROR		;AND NON-RELOCATABLE
	MOVE	C,[1.0]			;START C WITH EXP MULTIPLIER
	MOVE	B,[10.0]		;FOR POSITIVE EXPONENT
	JUMPG	A,NUMEX1		;WAS IT POSITIVE?
	MOVMS	A			;NO,MAKE IT SO
	MOVE	B,[0.1]			;AND MAKE IT FRACTIONAL
NUMEX1:	FMPR	C,B			;MULTIPLY BY EXPONENT (10. OR  0.1)
	SOJG	A,.-1			;GO BACK <EXP> TIMES
	FMPRM	C,0(P)			;EXPONENTIATE PREVIOUS VALUE
	POP	P,A			;AND RESTORE IT
	CAIN	CC,76 			;IF EXPRESSION WAS EXPONENT
	PUSHJ	P,MIC   		;EAT IT
	POPJ	P,			;THEN RETURN
; PROCESSOR 2 -PROCESS A SYMBOL

EVLP2:	TXZ	%F,S.EXT!S.DEF		;CLEAR FLAGS
	TXO	F,REGET			;REGET THE CHARACTER
	PUSHJ	P,SYMIN			;GET THE SYMBOL
	CAIN	CC,"="			;IS THIS "SYMBOL="?
	JRST	EVLP2D			;YES,GO HANDLE IT
	CAIN	CC,"#"			;DOES SYMBOL END WITH #?
	JRST	[PUSHJ P,MIC   		;YES,GET NEXT CHARACTER
		 TXO	%F,S.DEF	;CALL IT DEFINING REFERENCE
		 CAIE  CC,"#"		;NEXT CHAR. ALSO A POUND SIGN?
		 JRST	.+1		;NO,RETURN HAVING EATEN SINGLE #
		 TXZ	%F,S.DEF	;CLEAR FIRST FLAG
		 TXO	%F,S.EXT	;AND,FLAG AS EXTERNAL
		 PUSHJ P,MIC   		;GET NEXT CHARACTER
		 JRST   .+1 ]		;AND RETURN
	TXO	F,REGET			;REGET DELIMITER OF SYMBOL
	MOVE	R,A			;PREPARE TO LOOK UP SYMBOL
	TXNE	%F,I.OP			;IN OPCODE FIELD?
	JRST	[PUSHJ P,MACSRC		;YES,SEARCH THAT FIRST
		   JRST .+1		;SEARC FAILED
		 JRST EVLP20 ]		;SEARCH WAS SUCCESSFUL
	PUSHJ	P,SYMSRC		;
	JRST	[ TXNN %F,I.OP		;IN OPCODE FIELD?
		 PUSHJ P,MACSRC		;NO,HAVENT TRIED BUILT IN STUFF YET
		 JRST EVLP2A	   	;SEARCH EXHAUSTED
		 JRST EVLP20 ]		;FOUND IN BUILT IN TABLES
	CAIN	B,60			;GLOBAL REQUEST TYPE SYMBOL?
	JRST	EVLP2C			;YES,PROCESS AS SUCH
	MOVE	B,D			;RELOCATION OF THE SYMBOL
	TRNE	D,2			;CONVERT LH RELOCATION TO THIS FORMAT
	TLO	B,1			;OF 1,,1 ETC
	TRZ	B,^-<1>			;DONT ALLOW ANYMORE IN RH
	SETZ	C,			;NO SYMBOL FIXUP NEEDED
	MOVX	D,C.SYM			;PUSH THE OPERAND
EVLP20:	TXNE	%F,S.EXT!S.DEF		;WAS USER SAYING ITS EXTERNAL OR NEW?
	JRST	MERROR			;BUT ITS LOCAL AND EXISTING,SO COMPLAIN
	TXNN	D,C.POP			;IS THIS A PSEUDO-OP?
	JRST	ECELL			;NO, EXIT THE CELL
	JRST	0(A)			;RETURNED VALUE IS NAME (IE ADDRESS)
					;OF PROCESSOR FOR THIS PSEUDO-OP
	JRST	ECELL

EVLP2A:	PUSHJ	P,ISTGET		;GET SLOT IN INTERIM SYMBOL TABLE
	MOVEM	R,0(C)			;STORE SYMBOL NAME
	SETZM	1(C)			;CLEAR SECOND WORD
	MOVX	D,C.UDF+C.SYM		;FLAG AS UNDEFINED
	MOVX	A,IS.UDF+IS.FW		;FLAG AS FULLWORD, UNDEFINED
	TXNE	%F,S.EXT		;WAS IT UNDEFINED EXTERNAL?
	TXO	A,IS.DER		;YES,DEFERRED EXTERNAL REQUEST
	TXNE	%F,S.DEF		;WAS THIS DEFINING OCCURENCE?
	TXO	A,IS.DEF		;YES,REMEMBER FOR LATER
	MOVEM	A,1(C)			;STORE AWAY THE FLAGS
	SETZB	A,B			;CLEAR RESULT AND RELOC
	JRST	ECELL			;END OF CELL

EVLP2C:	TXNE	%F,S.DEF		;WASNT FOLLOWED BY "#"?
	JRST	MERROR			;ELSE ITS ERROR
	PUSHJ	P,ISTGET		;GET SLOT ON IST
	MOVEM	R,0(C)			;STORE SYMBOL NAME
	MOVX	A,IS.DER		;DEFFERED EXTERNAL REFERENCE
	MOVEM	A,1(C)			;STORE IT
	SETZB	A,B			;CLEAR VALUE,RELOCATION
	MOVX	D,C.EXT+C.SYM		;EXTERNAL SYMBOL
	JRST	ECELL			;END OF CELL

					;HERE FOR "SYMBOL="
EVLP2D:	TXNN	%F,I.OP			;ONLY ALLOW IT IN OPCODE FIELD
	JRST	QERROR			;ELSE ITS ERROR
	MOVX	D,C.SYM+C.ASG		;FLAG IT THE RIGHT WAY
	SETZB	B,C			;CLEAR RELOC AND SYMFIX
	JRST	ECELL			;AND RETURN
; PROCESSOR 3 -PROCESS AN AT-SIGN ( @ )

EVLP3:	TXOE	%F,P.AT			;INDIRECT BIT PENDING ALREADY?
	JRST	QERROR			;YES,SO THIS IS AN ERROR
	JRST	CELL			;AND CONTINUE TO PROCESS THE CELL


; PROCESSOR 4 -PROCESS UNARY MINUS

EVLP4:	PUSHJ	P,CELL			;GET CELL
	TXNE	D,C.OP!C.POP!C.AT!C.IDX!C.NULL ;FILTER OUT SOME STUFF
	JRST	QERROR			;ELSE ITS AN ERROR
	JUMPN	B,RERROR		;CANT NEGATE ADDRESS
	JUMPN	C,RERROR		;OR FORWARD REFERENCE
	TXO	D,C.NUM			;ITS A NUMBER
	MOVNS	A			;NEGATE CELL VALUE
	JRST	ECELL			;AND RETURN
; PROCESSOR 5 -PROCESS SIXBIT COMPRESSED ASCII

EVLP5:	SETZ	A,			;CLEAR RESULT
	MOVEI	B,6			;SET MAXIMUM
EVLP56:	PUSHJ	P,MIC   		;LOAD A CHARACTER
	CAIN	CC,"'"			;IS IT THE END?
	JSP	C,EVLP5C		;YES,DO END WORK
	CAIN	CC,$EOL			;DONT ALLOW END OF LINE
	JRST	QERROR			;INSIDE QUOTE
	SOJL	B,QERROR		;IF MAXIMUM EXCEEDED
	SUBI	CC," "-' '		;CONVERT TO SIXBIT
	ANDI	CC,77			;MAKE SURE IT COMES OUT RIGHT
	LSH	A,6			;MAKE ROOM
	IORI	A,(CC)			;OR IN THE NEW CHARACTER
	JRST	EVLP56			;GO AGAIN


; PROCESSOR 5A -PROCESS ASCII SEVEN BIT CHARACTERS

EVLP5A:	SETZ	A,			;CLEAR RESULT
	MOVEI	B,5			;5 CHARACTERS
	TXO	F,QUOTE			;DONT CONVERT CHARACTERS
EVLP57:	PUSHJ	P,MIC   		;GET A CHARACTER
	CAIN	CC,""""			;IS THIS THE END?
	JSP	C,EVLP5C		;YES,DO FINISH UP WORK
	SOJL	B,QERROR		;IF MORE THAN 5 CHARACTERS
	CAIN	CC,$EOL			;END OF LINE?
	JRST	QERROR
	LSH	A,7			;MAKE ROOM
	IORI	A,(CC)			;OR IN THE NEW CHARACTER
	JRST	EVLP57			;NEXT CHARACTER

EVLP5C:	MOVEM	A,T			;SAVE RESULT AWAY
	PUSHJ	P,MACPEK		;LOOK AHEAD ONE CHARACTER
	EXCH	A,T			;RESTORE RESULT, CHAR TO SAFE PLACE
	CAME	CC,T			;IS THIS CASE OF DOUBLE DELIMITER?
	JRST	EVLP5D			;NO,SO CONTINUE WITH END
	PUSHJ	P,MIC   		;EAT THE SECOND OCCURENCE
	JRST	0(C)			;AND CONTINUE PROCESSING
	
EVLP5D:	SETZB	B,C			;CLEAR RELOC,SYMFIXUP
	MOVX	D,C.NUM			;CALL IT A NUMBER
	TXZ	F,QUOTE			;RESTORE NORMAL MODE
	JRST	ECELL			;END OF CELL
; PROCESSOR 6  -PROCESS AN INDEX EXPRESSION "(...)"

EVLP6:	PUSHJ	P,EVALS			;CALL EVALUATE AGAIN
	CAIE	CC,")"			;SHOULDNT BE HERE TILL )
	JRST	QERROR			;IF NOT,ERROR
	MOVS	A,R%V			;SWAP HALVES OF RETURNED VALUE
	MOVS	B,R%R			;AND RELOCATION
	MOVS	C,R%S			;ALSO FORWARD REFERENCES
	MOVX	D,C.NUM+C.IDX		;NUMERIC,INDEX
	JRST	ECELL			;END OF CELL
; PROCESSOR 7  - PROCESS A PSEUDO-LITERAL  "[......]"

EVLP7:	PUSH	P,T1			;SAVE ORIGINAL AC T1
	MOVEI	T1,4			;GET 4 WORDS OF CORE
	PUSHJ	P,GETCOR		;FROM FREE MEMORY
	PUSH	P,T1			;SAVE START ADDRESS AS START OF CHAIN
	PUSH	P,T1			;SAVE START ADDRESS ACROSS EVALUTATION
	
EVLP7A:	PUSHJ	P,EVALS			;EVALUATE STATEMENT
	SKIPE	NULFLG			;DID LINE HAVE ANYTHING?
	JRST	[ CAIN CC,"]" 		;NO,WASN'T CLOSING LINE WAS IT?
		  JRST QERROR		;YES,DON'T KNOW HOW TO HANDLE THAT
		  JRST EVLP7B ]		;ELSE JUST GET NEXT LINE
	MOVE	A,R%V			;RETURNED VALUE
	MOVE	B,R%R			;RETURNED RELOCATION
	MOVE	C,R%S			;RETURNED FIXUP
	POP	P,T1			;GET POINTER TO 4-WORD BLOCK
	MOVEM	A,0(T1)			;WORD 0 GETS VALUE
	MOVEM	B,1(T1)			;WORD 1 GETS RELOCATION
	MOVEM	C,2(T1)			;WORD 2 GETS FIXUP
	SETZM	3(T1)			;LINK TO NEXT BLOCK IS ZERO FOR NOW
	TDNE	B,[^-<1,,1>]		;CHECK FOR VALID RELOCATION
	JRST	RERROR			;BETTER TO GIVE ERROR MSG NOW
	CAIN	CC,"]"			;IS THIS CLOSE LITERAL?
	JRST	EVLP7C			;YES,SO GO FINISH UP
	CAIN	CC,";"			;INTO THE COMMENT FIELD?
	PUSHJ	P,FINLIN		;YES,SO FINISH UP THE LINE
	CAIE	CC,$EOL			;AT THE END OF THE LINE?
	JRST	QERROR			;NO, NOT ONE OF ($EOL, ; , ] ) IS ERROR
	ADDI	T1,3			;T1 GETS POINTER TO LINK WORD OF BLOCK
	PUSH	P,T1			;SAVE IT
	MOVEI	T1,4			;GET NEXT BLOCK
	PUSHJ	P,GETCOR
	MOVEM	T1,@0(P)		;STORE THE LINK FROM PREV TO NXT
	MOVEM	T1,0(P)			;AND STORE THE BASE OF BLOCK
EVLP7B:	PUSHJ	P,MACLOD		;LOAD NEXT LINE
	JRST	EVLP7A			;AND EVALUATE IT

EVLP7C:	PUSHJ	P,ISTGET		;GET POINTER TO IST SLOT
	POP	P,0(C)			;WORD 1 OF PAIR IS POINTER TO 1ST
					;BLOCK OF STRING OF BLOCKS
	MOVX	A,IS.LIT		;SET FLAGS IN WORD 2 OF PAIR
	MOVEM	A,1(C)			;
	SETZ	A,			;RETURN VALUE OF 0
	MOVEI	B,1			;RELOCATED IN RH (WILL BE ADDRESS OF LITERAL)
	MOVX	D,C.LIT			;FLAG AS LITERAL
	POP	P,T1			;RESTORE T1 TO ITS VALUE ON ENTRY
	JRST	ECELL			;END OF CELL
; PROCESSOR 8  -PROCESS A BRACKETED EXPRESSION   "<.....>"

EVLP8:	PUSHJ	P,EVALS			;EVALUATE STATEMENT
	CAIE	CC,RABRKT 		;RETURN VIA RIGHT A.BRACKET?
	JRST	QERROR			;NO,SO RETURN
	MOVE	A,R%V			;VALUE
	MOVE	B,R%R			;RELOCATION
	SKIPN	C,R%S			;GET IST POINTER
	JRST	EVLP8A			;IF NONE, MAKE NO CHECKS
	MOVX	T,IS.MWS		;DONT ALLOW MWS IN <> PAIR
	TDNE	T,1(C)			;CHECK RH OF FIXUP PAIR
	JRST	QERROR			;GIVE ERROR IF FOUND
EVLP8A:	MOVX	D,C.NUM			;NUMERIC
	JRST	ECELL			;END OF CELL
; PROCESSOR 9  - PROCESS THE CELL STARTING WITH  .  (PERIOD)

EVLP9:	PUSHJ	P,MACPEK		;LOOK AHEAD ONE CHARACTER
	EXCH	CC,A			;PLACE WHERE TEST ROUTINES GET IT
	SKPNUM				;A DIGIT FOLLOWS IT?
	  JRST  .+2			;NO
	JRST	EVLN1B			;PROCESS FLT PT NUMBER FRACTION
	SKPR50				;IN RADIX50 SET?
	  JRST   .+3			;NO
	EXCH	CC,A			;RESET CHARACTER AC
	JRST	EVLP2			;PROCESS AS SYMBOL
	MOVE	A,CPADDR		;CURRENT LOCATION
	MOVEI	B,1			;WHICH IS ADDRESS (IE RIGHT RELOC)
	SETZ	C,			;NO FORWARD REFERENCE
	MOVX	D,C.SYM			;ITS A SYMBOL
	JRST	ECELL			;DONE
; PROCESSOR 12  -PROCESS ^ (UP-ARROW) QUALIFIER.

EVLP12:	BYPASS				;LOAD NEXT NON-BLANK CHARACTER
	SETZ	T,			;CLEAR RADIX
	CAIN	CC,"D"			;BASE 10.?
	MOVEI	T,^D10			;YES,SET IT
	CAIN	CC,"B"			;BASE 2.?
	MOVEI	T,^D2			;YES,SET IT
	CAIN	CC,"O"			;BASE 8.?
	MOVEI	T,^D8			;YES,SET IT
	CAIN	CC,"F"			;DECIMAL FRACTION?
	$KILL(FNI,Qualifier ^F not implemented)
	CAIN	CC,"L"			;JFFO INST?
	JRST	EVP12A			;YES,GO HANDLE IT
	CAIN	CC,"-"			;UNARY .NOT. ?
	JRST	EVP12B			;YES,GO HANDLE IT
	JUMPE	T,NERROR		;IF HERE WITH T=0,ITS ERROR
	PUSH	P,CRADIX		;SAVE CURRENT RADIX
	MOVEM	T,CRADIX		;AND REPLACE IT WITH OURS
	PUSHJ	P,CELL			;GET NEXT CELL,UNDER THIS RADIX
	POP	P,CRADIX		;RESET RADIX
	TXNE	D,C.NULL		;ILLEGAL TO QUALIFY NOTHING
	JRST	QERROR			;
	
EVP12Z:	TXNN	D,C.NUM			;WAS GOTTEN CELL A NUMBER?
	JRST	NERROR			;NO,COMPLAIN
	JRST	ECELL			;ELSE RETURN


; ^L PROCESSOR

EVP12A:	PUSHJ	P,CELL			;GET FOLLOWING CELL
	TXNE	D,C.NULL
	JRST	QERROR
	JUMPN	C,FERROR		;IF FORWARD REFERENCE , CANT HANDLE
	JFFO	A,.+2			;COUNT ZEROES TO FIRST 1
	MOVEI	B,^D36			;IF WHOLE WORD IS ZERO
	MOVE	A,B			;RETURNED VALUE IS RESULT
	SETZ	B,			;AND IT IS NOT RELOCATED
	JRST	EVP12Z			;RETURN


; ^- PROCESSOR

EVP12B:	PUSHJ	P,CELL			;GET CELL
	TXNE	D,C.NULL
	JRST	QERROR
	JUMPN	C,FERROR		;CANT HANDLE FORWARD REFERENCE
	JUMPN	B,RERROR		;ERROR IF ITS RLOCATABLE
	SETCA	A,			;COMPLEMENT AC A (AC A,YOU'RE GREAT)
	JRST	EVP12Z			;AND FINISH,WITH USUAL CHECKS
; PROCESSOR 13 - PROCESS RIGHT ANGLE BRACKET

EVLP13:	SKIPE	NSTLVL			;DONT MAKE LEVEL NEGATIVE
	SOSA	NSTLVL			;MATCHING OPEN BRACKETS?
	JRST	NCELL			;NO, SO LEAVE IT HERE
	TXZ	F,REGET			;EAT THIS CHARACTER
	BYPASS
	JRST	NCELL			;AND CLAIM ITS NULL CELL
; PROCESSORS 70-89 ARE RESERVED FOR PSEUDO-OPERATORS
;
;

; PROCESSOR 70 - PROCESS THE PSEUDO-OPERATOR   'ASCII'

EVP70:	MOVE	C,[POINT 7,A]		;POINTER TO VALUE
	MOVE	D,[POINT 7,5]		;D GETS XWD PTR,BYTES PER WORD
	SETZB	A,WRDCNT		;CLEAR VALUE AND WORD COUNT
	BYPASS				;GET DELIMITER
	CAIN	CC,$EOL			;IS IT END OF LINE?
	JRST	QERROR			;YES,RETURN ERROR
	MOVEM	CC,T			;SAVE DELIMITER
	MOVEI	B,5			;BYTE COUNTER
	TXO	F,QUOTE			;NO CHARACTER CONVERSION
EVP70A:	PUSHJ	P,MIC			;INPUT THE BYTE
	CAMN	CC,T			;A MATCH ON DELIMITER?
	JRST	EVP70D			;YES, END IT
	PUSHJ	P,NWCHK			;SEE IF NEW WORD NEEDED
	CAIE	CC,$EOL			;IS THIS AN END OF LINE?
	JRST	EVP70B			;NO
	PUSHJ	P,MACLOD		;YES,SO LOAD NEXT LINE
	MOVE	CC,REOL			;RESTORE REAL END OF LINE
EVP70B:	IDPB	CC,C			;STORE THE CHARACTER
	JRST	EVP70A			;AND BACK FOR MORE


; PROCESSOR 71  - PROCESS THE PSEUDO-OPERATOR    'SIXBIT'

EVP71:	MOVE	C,[POINT 6,A]		;POINTER TO VALUE
	MOVE	D,[POINT 6,6]		;D GETS PTR,,BYTES PER WORD
	SETZB	A,WRDCNT		;CLEAR VALUE,,OVERFLOW COUNT
	BYPASS				;GET DELIMITER
	CAIN	CC,$EOL			;IS IT END OF LINE?
	JRST	QERROR			;YES,RETURN ERROR
	MOVEM	CC,T			;SAVE DELIMITER
	MOVEI	B,6			;CURRENT BYTE COUNT
EVP71A:	PUSHJ	P,MIC			;INPUT THE BYTE
	CAMN	CC,T			;A MATCH ON DELIMETER?
	JRST	EVP70D			;YES , SO END IT
	PUSHJ	P,NWCHK			;SEE IF NEW WORD NEEDED
	SUBI	CC," "-' '		;CONVERT TO SIXBIT
	JUMPL	CC,AERROR		;IF NO SIXBIT REPRESENTATION
	IDPB	CC,C			;STORE THE CHARACTER
	JRST	EVP71A			;AND BACK FOR MORE

EVP70D:	TXZN	%F,S.ASCZ		;HERE ON END OF STRING. SPECIAL ASCIZ ?
	JRST	EVP70E			;NO, DONT END WITH NULL
	SETZ	CC,			;YES, GET A NULL TO DEPOSIT
	PUSHJ	P,NWCHK			;MAY CAUSE NEW WORD
	IDPB CC,C			;DEPOSIT IT
EVP70E:	TXZ	F,QUOTE			;NO MORE QUOTED STRING
	MOVX	D,C.NUM			;NUMERIC
	SETZ	C,			;NO FIXUP
	SKIPN	B,WRDCNT		;WAS IT MORE THAN ONE WORD?
	JRST	ECELL			;NO,JUST RETURN
	PUSHJ	P,ISTGET		;GET SLOT ON IST
	HLRZM	B,0(C)			;STORE ADDRESS OF STRING IN RH OF WORD 1
	HRRZS	B			;WORD COUNT ALONE NOW
	MOVNS	B			;NEGATE IT
	HRLM	B,0(C)			;WORD 1/  -COUNT,,ADDRESS
	MOVX	B,IS.MWS		;FLAG TYPE OF ENTRY
	MOVEM	B,1(C)			;AND STORE IT
	SETZ	B,			;NOT RELOCATED
	JRST	ECELL			;END OF THIS CELL

					;HERE TO CHECK FOR NEW WORD NEEDED
					;NOTE- DONT CALL GETCOR DURING
					;STRING EVALUATION,EXCEPT HERE
NWCHK:	SOJGE	B,CPOPJ			;IF COUNT OK,JUST RETURN
	PUSH	P,T1			;SAVE AC
	MOVEI	T1,1			;GET WORD
	PUSHJ	P,GETCOR		;ALLOCATE IT
	HRRZ	C,T1			;RH OF NEW BYTE POINTER
	HLL	C,D			;LH OF NEW BYTE POINTER
	MOVEI	B,-1(D)			;ALSO RESET COUNT,ADJ BY 1
	SKIPN	WRDCNT			;IF FIRST OVERFLOW,
	HRLZM	T1,WRDCNT		;STORE THE STRING'S ADDRESS
	AOS	WRDCNT			;UPDATE COUNT
	PJRST	T1POPJ			;RESTORE T1,RETURN
; PROCESSOR 70Z - PROCESS THE PSEUDO-OPERATOR  'ASCIZ'
;

EVP70Z:	TXO	%F,S.ASCZ		;TURN ON FLAG BIT
	JRST	EVP70			;NOW GO HANDLE LIKE ASCII



; PROCESSOR 72 - PROCESS THE PSEUDO-OPERATOR   'IOWD'
; PROCESSOR 73 -  PROCESS THE PSEUDO-OPERATOR   'XWD'

EVP72:	SKIPA	T,[P.IOWD]		;FLAG AS IOWD PSEUDO-OP
EVP73:	MOVX	T,P.XWD			;
	TDOE	%F,T			;TURN ON BIT,TEST FOR DUPLICATE
	JRST	QERROR			;THIS IS LEGAL BUT WE DONT HANDLE IT
	JRST	CELL			;PROCESS MORE OF THE CELL
; PROCESSOR 74  - PROCESS THE PSEUDO OPERATORS 'SQUOZE' & 'RADIX50'

EVP74:	PUSHJ	P,EVALEX		;READ IN AND EVALUATE BITS
	SKPNCM				;END WITH COMMA?
	TDNE	A,[^-74]		;AND PROPER VALUE?
	JRST	QERROR			;NO,FAILS SYNTAX CHECK
	JUMPN	B,RERROR		;CANT BE RELOCATABLE
	JUMPN	C,FERROR		;OR UNKNOWN/EXTERNAL
	LSH	A,^D30			;GET IT INTO BITS 0-3
	PUSH	P,A			;SAVE THE CODE BITS AWAY
	TXZ	F,REGET			;DONT EAT THE , AGAIN
	PUSHJ	P,SYMIN			;READ THE SYMBOL IN
	MOVE	R,A			;GET INTO ARG FOR RAD50
	PUSHJ	P,RAD50			;CONVERT TO RADIX50
	IORM	R,0(P)			;MERGE BITS AND SYMBOL
	POP	P,A			;VALUE OF CELL TO RETURN
	SETZB	B,C			;NO RELOC OR FIXUP
	MOVX	D,C.NUM			;TAG AS NUMBER
	TXO	F,REGET			;REGET SYMBOL DELIMITER
	JRST	ECELL			;AND END THE CELL
; PROCESSOR 75  - PROCESS THE PSEUDO-OPERATOR   'POINT'

EVP75:	PUSH	P,[0]			;PUSH 3 PLACE HOLDERS ON STACK
	PUSH	P,[0]
	PUSH	P,[<^D36>B5]		;DEFAULT BYTE POSITION
	PUSHJ	P,EVLX10		;GET BYTE SIZE IN RADIX 10.
	JUMPN	B,RERROR		;MUST BE ABSOLUTE
	JUMPN	C,FERROR		;AND KNOWN
	DPB	A,[POINT 6,0(P),11]	;STORE THE BYTE SIZE
	SKPCM				;DELIMITED BY COMMA?
	JRST	EVP75A			;NO,SO WE ARE DONE
	TXZ	F,REGET			;INSURE WE DONT SEE THAT COMMA AGAIN
	PUSHJ	P,EVADR			;EVALUATE ADDRESS
	DPB	A,[POINT 23,0(P),35]	;DEPOSIT ADDRESS
	MOVEM	B,-1(P)			;STORE RELOCATION
	MOVEM	C,-2(P)			;AND THE FIXUP
	SKPCM				;END WITH COMMA?
	JRST	EVP75A			;NO,DONE
	TXZ	F,REGET			;DONT GET THE COMMA AGAIN
	PUSHJ	P,EVLX10		;EVALUATE BYTE POSITION
	TXNE	D,C.NULL		;WAS ANYTHING THERE?
	JRST	EVP75A			;NO
	JUMPN	B,RERROR		;MUST BE ABSOLUTE
	JUMPN	C,FERROR		;AND KNOWN
	MOVEI	T,^D35			;TRANSLATE TO HARDWARE POSITION
	SUB	T,A			;
	JUMPL	T,QERROR		;CALL THIS AN ERROR
	DPB	T,[POINT 6,0(P),5]	;UPDATE BYTE POSITION
EVP75A:	POP	P,A			;RETURN VALUE
	POP	P,B			;RETURN RELOCATION OF POINTER
	POP	P,C			;RESTORE FIXUP WORD
	MOVX	D,C.NUM			;CALL IT A NUMBER
	JRST	ECELL			;EXIT THE CELL
 ; PROCESSOR 76 -  PROCESS THE PSEUDO-OPERATOR     'COMMENT'

EVP76:	BYPASS				;GET FIRST NON-BLANK CHARACTER
	CAIN	CC,$EOL			;ERROR IF ITS END OF LINE
	JRST	QERROR
	MOVEM	CC,T			;SAVE DELIMITER
EVP76A:	PUSHJ	P,MIC			;LOAD BYTE FROM INPUT
	CAIN	CC,$EOL			;IS IT END OF LINE?
	JRST	[  PUSHJ P,MACLOD	;THE NEXT LINE
		  JRST EVP76A]		;AND GET BYTE, ETC..
	CAME	CC,T			;MATCHES DELIMITER?
	JRST	EVP76A			;NO
	JRST	CELL			;


; PROCESSOR 77 -  PROCESS THE PSEUDO-OPERATOR		'REMARK'


EVP77:	PUSHJ	P,MIC			;GET A CHARACTER
	CAIE	CC,$EOL			;END OF LINE?
	JRST	EVP77			;NO,TRY AGAIN
	JRST	NCELL			;YES,EOL SEEN,SO CALL IT NULL CELL
; PROCESSOR 78 - PROCESS THE PSEUDO-OPERATOR	'EXP'

EVP78:	PUSHJ	P,EVALEX		;EVALUATE EXPRESSION
EVP78A:	MOVX	D,C.NUM			;FLAG AS NUMERIC
	SKPCM				;IF NOT COMMA,
	JRST	ECELL			;ITS END OF CELL
	JRST	WERROR			;ELSE TOO MANY WORDS FOR CURRENT




; PROCESSOR 79 - PROCESS THE PSEUDO-OPERATOR     'DEC'

EVP79:	PUSHJ	P,EVLX10		;EVALUATE EXPRESSION USING RADIX 10.
	JRST	EVP78A			;MAKE CHECKS




; PROCESSOR 80 -  PROCESS THE PSEUDO-OPERATOR	'OCT'

EVP80:	PUSH	P,CRADIX		;STORE CURRENT RADIX
	MOVEI	A,^D8			;SET IT AS BASE (8)
	MOVEM	A,CRADIX		;
	PUSHJ	P,EVALEX		;EVALUATE EXPRESSION
	POP	P,CRADIX		;AND RESTORE RADIX
	JRST	EVP78A			;MAKE COMMON CHECKS
; PROCESSOR 81 - PROCESS THE PSEUDO-OPERATOR		'BYTE'

EVP81:	REPEAT 3,<PUSH P,[0]>		;MAKE ROOM FOR CODE TRIPLET
	PUSH	P,[POINT 0,0(P)]	;STORE BYTE POINTER
	BYPASS				;GET FIRST NON-BLANK
	CAIE	CC,"("			;MUST START WITH BYTE SIZE
	JRST	AERROR			;BUT ITS NOT
EVP81A:	PUSHJ	P,EVLX10		;READ EXPRESSION IN DECIMAL
	JUMPN	B,RERROR		;CANT BE RELOCATABLE
	JUMPN	C,FERROR		;OR UNKNOWN
	CAIE	CC,")"			;END IN MATCHING R PARENS?
	JRST	AERROR			;NO,SO FLAG ERROR
	CAILE	A,0			;IF NOT IN RANGE 1-36 (10.)
	CAILE	A,^D36			;
	JRST	AERROR			;FLAG ERROR
	DPB	A,[POINT 6,0(P),11]	;STORE SIZE INTO POINTER
EVP81B:	TXZ	F,REGET			;DONT REGET THE R PARENS
	PUSHJ	P,EVALEX		;EVALUATE THE EXPRESSION
	IBP	0(P)			;INCREMENT THE BYTE POINTER
	SKIPN	B			;MAKE SURE IF FIXUP OR RELOC
	SKIPE	C			;THAT BYTE ALIGNED ON BOUNDARY
	JRST	[ LDB	T,[POINT 6,0(P),11]	;GET SIZE
		  CAIE	T,^D36			;MUST BE 18. OR 36.
		  CAIN	T,^D18			;ELSE ITS ERROR
		  JRST  .+1			;
		  JRST  RERROR ]		;DONE
	MOVE	T,0(P)			;PICK UP THE POINTER
	TRNE	T,-1			;IF INTO NEXT WORD,CANT HANDLE
	JRST	WERROR			;BECAUSE IT GENERATES MULTI-WORD
	HRRI	T,-1			;STORE VALUE INTO -1(P)
	DPB	A,T			;
	HRRI	T,-2			;STORE RELOC INTO -2(P)
	DPB	B,T			;
	HRRI	T,-3			;STORE SYMFIX INTO -3(P)
	DPB	C,T			;
	SKPNCM				;COMMA DELIMITS EXPRESSION?
	JRST	EVP81B			;YES,GET NEXT PIECE
	CAIN	CC,"("			;IS IT L PARENS?
	JRST	[TXZ F,REGET		;YES,CHANGE BYTE SIZE
		 JRST EVP81A]		;AFTER EATING THE "("
	POP	P,0(P)			;CLEAR BP OFF STACK
	POP	P,A			;SET UP EXPRESSION
	POP	P,B			;
	POP	P,C
	MOVX	D,C.NUM			;FLAG NUMERIC
	JRST	ECELL			;END OF CELL
; PROCESSOR 82 - PROCESS  THE PSEUDO-OPERATOR        'RADIX'

EVP82:	PUSHJ	P,EVLX10		;EVALUATE EXPRESSION USING BASE 10.
	JUMPN	B,RERROR		;MUST BE ABSOLUTE AND
	JUMPN	C,FERROR		;MUST BE KNOWN
	CAIL	A,2			;AND IT MUST BE IN RANGE 2-10
	CAILE	A,^D10			;
	JRST	AERROR			;ELSE ITS AN ARG ERROR
	MOVEM	A,CRADIX		;CHANGE RADIX
	JRST	MECELL			;MUST END LINE WITH THIS CELL
; PROCESSOR 83  -  HANDLE THE IFXX CONDITIONALS: IFXX EXP,<  STUFF...>

EVP83:					;ALL IFXX CONDITIONALS

EVP83A:	AOS	IFIDX			;IFN	CONDITIONAL
EVP83B:	AOS	IFIDX			;IFE	CONDITIONAL
EVP83C:	AOS	IFIDX			;IFL	CONDITIONAL
EVP83D:	AOS	IFIDX			;IFG	CONDITIONAL
EVP83E:	AOS	IFIDX			;IFLE	CONDITIONAL
EVP83F:					;IFGE 	CONDITIONAL
	PUSHJ	P,EVALEX		;EVALUATE EXPRESSION
	JUMPN	C,FERROR		;IF FORWARD OR EXTERNAL, ITS ERROR
EVP83K:	SKPCM				;DELIMITED BY COMMA?
	JRST	QERROR			;NO, STOP NOW
	TXZ	F,REGET			;EAT THE COMMA
EVP83M:	BYPASS				;AND GET NEXT NON-BLANK
	CAIE	CC,LABRKT		;IS IT A LEFT ANGLE BRACKET?
	JRST	[ CAIE CC,$EOL		;NO. IS IT END OF LINE?
		  JRST QERROR
		  PUSHJ P,MACLOD	;LOAD NEW LINE
		  JRST EVP83M ]		;AND TRY AGAIN
	SETZ	D,			;CLEAR A REGISTER
	EXCH	D,IFIDX			;GET INDEX AND CLEAR INDEX
	XCT	IFTST(D)		;DO THE PROPER TEST
	AOS	NSTLVL			;TEST SUCCEEDED. BUMP COUNT
	JRST	CELL			;AND PRETEND WE WEREN'T HERE
EVP83L:	PUSHJ	P,MIC			;GET A CHARACTER
	CAIN	CC,LABRKT		;ANOTHER LEFT ANGLE BRACKET?
	AOJA	C,EVP83L		;YES, WE ARE DEEPER AND CONTINUE
	CAIN	CC,RABRKT		;A RIGHT ANGLE BRACKET?
	SOJA	C,[ JUMPGE C,EVP83L	;UPDATE COUNT. DONE?
		    JRST  CELL ]	;YES, CONTINUE FROM HERE
	CAIN	CC,$EOL			;IS IT THE END OF THE LINE
	PUSHJ	P,MACLOD		;YES, LOAD NEXT LINE
	JRST	EVP83L			;AND TRY AGAIN

EVP83G:	AOS	IFIDX			;IFDEF, SET INDEX TO IFLE
EVP83H:	PUSHJ	P,IFSYM			;IFNDEF, GET SYMBOL LOADED
	MOVEM	A,R			;INTO SEARCH INPUT PLACE
	PUSHJ	P,SYMSRC		;LOOK IT UP
	  SKIPA	A,[1]			; 1 IF NOT DEFINED
	SETO	A,			;-1 IF DEFINED
	JRST	EVP83K			;JOIN COMMON CODE

EVP83P:	AOS	IFIDX			;IFEDIT ENTRY
EVP83Q:	PUSHJ	P,IFSYM			;IFNEDIT , LOAD SYMBOL
	PUSHJ	P,FNDEDT		;LOOK UP THE EDIT TO SEE IF THERE
	  SKIPA	A,[1]			;NOT THERE, CREATE POS. VALUE
	SETO	A,			;THERE, CREATE NEG. VALUE
	JRST	EVP83K			;JOIN COMMON CODE

EVP83R:	AOS	IFIDX			;IFACTIVE ENTRY
EVP83S:	PUSHJ	P,IFSYM			;IFNACTIVE ENTRY
	PUSHJ	P,FNDEDT		;LOOK UP THE EDIT
	 JRST	AERROR			;IF NOT THERE, ITS ERROR
	SKIPL	A,TB$STA(B)		;IS IT ACTIVE?
	MOVEI	A,1			;NO, POS. VALUE INDICATES INACTIVE
	JRST	EVP83K			;JOIN COMMON CODE

IFSYM:	CAIE	CC," "			;WAS DELIMITER A SPACE?
	JRST	QERROR			;NO
	BYPASS				;GET FIRST NON-BLANK
	TXO	F,REGET			;AND START THAT AS SYMBOL
	PUSHJ	P,SYMIN			;LOAD THE SYMBOL
	JUMPE	A,AERROR		;IF NOT THERE, FLAG THE ERROR
	TXO	F,REGET			;START WITH THIS CHARACTER
	BYPASS				;AND EAT TRAILING SPACES
	POPJ	P,			;RETURN

IFTST:	JUMPL	A,EVP83L		;IFGE	TEST
	JUMPG	A,EVP83L		;IFLE	TEST
	JUMPLE	A,EVP83L		;IFG	TEST
	JUMPGE	A,EVP83L		;IFL	TEST
	JUMPN	A,EVP83L		;IFE	TEST
	JUMPE	A,EVP83L		;IFN 	TEST
; PROCESSOR 84 - PROCESS THE PSEUDO-OPERATOR    'PURGE'

EVP84:	PUSHJ	P,.PSH4T##		;SAVE T1-4
EVP84A:	BYPASS				;GET FIRST ARGUMENT
	TXO	F,REGET			;STARTING WITH FIRST NON-BLANK
	PUSHJ	P,SYMIN			;LOAD SYMBOL NAME
	JUMPE	A,AERROR		;IF NOT R50 SYMBOL, BAD ARGUMENT
	MOVE	R,A			;INPUT ARG TO SYMSRC
	PUSHJ	P,SYMSRC		;LOOK THE SYMBOL UP
	  JRST  EVP84C			;MACRO ALLOWS PURGE OF NON-DEFINED SYMBOL
	CAIE	B,60			;IS THIS A GLOBAL SYMBOL?
	JRST	EVP84B			;NO, ALL IS OK
	MOVE	N,R			;GIVE WARNING SINCE CHAIN MAY BE
	$WARN(PES,Purging EXTERNAL symbol,N$SIX,$MORE) ;DESTROYED
	MOVEI	T1,[ASCIZ / may give bad REL file /]
	PUSHJ	P,.TSTRG##		;OUTPUT REST OF MESSAGE
	PUSHJ	P,SAYED1		;SAY "IN EDIT BLAH"
X$$PES:	PUSHJ	P,.TCRLF##
	TXZ	F,FOTTY
EVP84B:	MOVE	T1,[RADIX50 10,.]	;SET IMPOSSIBLE SYMBOL NAME,MAKE IT LOCAL
	MOVEM	T1,0(C)			;STORE IT OVER EXISTING SYMBOL NAME
	SETZM	1(C)			;CLEAR VALUE TOO
	PUSHJ	P,SYMSRN		;SEE IF MORE OCCURENCES OF SAME SYMBOL
	  SKIPA
	JRST	EVP84B			;YES,PROCESS THEM
EVP84C:	TXO	F,REGET			;STARTING WITH CURRENT DELIMITER
	BYPASS				;GET NEXT NON-BLANK CHARACTER
	SKPNCM				;COMMA?
	JRST	EVP84A			;YES, GET NEXT ARGUMENT
	PUSHJ	P,.POP4T##		;ELSE RESTORE TEMP ACS
	JRST	MECELL			;AND RETURN
; PROCESSOR 85 - PROCESS THE PSEUDO-OPERATOR   'BLOCK'
; 
; NOTE: A TRUE "BLOCK" OPERATION IS NOT PERFORMED, INSTEAD A MULTIPLE WORD
;	STRING OF 0 WORDS IS GENERATED TO SIMULATE BLOCK TYPE ACTION

EVP85:	PUSHJ	P,EVALEX		;EVALUATE ARGUMENT TO OPERATOR
	JUMPN	B,RERROR		;CANT BE RELOCATABLE
	JUMPN	C,FERROR		;OR UNKNOWN
	JUMPLE	A,AERROR		;DON'T ALLOW BLOCK 0 OR NEGATIVE ARG
	CAIN	A,1			;WAS THIS A BLOCK 1?
	JRST	EVP85A			;YES,NO NEED FOR MULTIPLE GENERATION
	PUSHJ	P,ISTGET		;GET A SLOT FROM THE IST
	MOVNI	A,-1(A)			;ADJUST COUNT,NEGATE IT
	HRLZM	A,0(C)			;STORE -COUNT,,0 FOR PMMWS
	MOVX	A,IS.MWS+IS.BLK		;FLAG AS BLOCK TYPE OF MULTI-WORD
	MOVEM	A,1(C)			;STRING GENERATION
EVP85A:	SETZB	A,B			;CLEAR RESULT
	MOVX	D,C.NUM			;RETURN FIRST WORD NOW AS 0
	JRST	ECELL			;END THE CELL
; /FP.EDT/ - THIS FIX PSEUDO-OP TAKES AS AN ARGUMENT THE EDIT NAME,
;	WHICH CAN BE UP TO SIX RADIX-50 CHARACTERS LONG.
;	IT ALSO ALLOCATES THE STATIC AREA FOR THE TRACE BLOCK
;	AND RESETS THE INTERIM SYMBOL TABLE
;
;

FP.EDT:	PUSHJ	P,.PSH4T##		;SAVE ACS
	TXNE	F,IAE			;INSIDE AN EDIT?
	JRST	[MOVE N,CUREDT
		$KILL(MEP,Missing .ENDE for edit,N$SIX)]
	BYPASS				;SKIP OVER BLANKS
	TXO	F,REGET			;AND REGET FIRST NON-BLANK
	PUSHJ	P,SYMIN			;GET EDIT NUMBER
	JUMPE	A,[$KILL(NEI,Null argument to .EDIT is illegal)]
	TXO	F,IAE!FSTMOD		;INSIDE EDIT,FIRST MODULE THIS EDIT
	MOVEM	A,CUREDT		;STORE CURRENT EDIT NAME
	SETZM	CPPART			;RESET EDIT PART ID
	PUSHJ	P,ISTINI		;RESET IST
	MOVE	T1,TRCVAP		;MAKE TRACE BLOCK FOLLOW
	MOVEM	T1,TRCPTR		;LAST ONE
	CAILE	T1,TRCLST-TB$SIZ	;ROOM LEFT?
	$KILL(ITS,Insufficient TRACE block storage,N$EDIT)
	MOVE	T2,[LI$TRC,,TB$SIZ]	;PICK UP A HEADER
	MOVEM	T2,TB$HED(T1)		;STORE IT
	MOVEM	A,TB$EDT(T1)		;STORE CURRENT EDIT NAME
	MOVE	T2,WHO			;AND OUR INITIALS
	HRROM	T2,TB$STA(T1)		;DEPOSIT AND MARK ACTIVE
	HRLM	T2,TB$INS(T1)		;ALSO AS PERSON INSTALLING
	DATE	T2,			;GET SYSTEM DATE
	HRRM	T2,TB$INS(T1)		;DEPOSIT DATE INSERTED
	SETZM	TB$LEN(T1)		;ZERO THE VAR. AREA LENGTH
	SETZM	TB$MAK(T1)		;ZERO THE CREATION DATE/INITIALS
	MOVEI	T2,TB$VAR(T1)		;START OF VARIABLE AREA
	MOVEM	T2,TRCVAP		;STORED
	PUSHJ	P,.POP4T##		;RESTORE ACS
	JRST	MECELL			;MUST END CELL
; /FP.MOD/-  ROUTINE TO GET THE NAME OF MODULE TO BE PATCHED AND THEN
;		EITHER RETURN TO DISPATCH (IF ALREADY IN CORE) OR
;		ELSE SEARCH FOR IT IN THE REL FILE. NOTE THAT WE
;		CAN SEARCH BACFPARDS HERE BUT GIVE AN ERROR MESSAGE
;		IF THE MODULE IS NOT FOUND AT ALL.
;**;[101]	DELETE TWO LINES  @ MOD3 6L +	MS	16-SEPT-80
FP.MOD:	PUSHJ	P,.PSH4T##		;SAVE ACS
	TXNN	F,IAE			;IN ACTIVE EDIT?
	$KILL(EPM,.EDIT pseudo-op is missing from FIX file)
	BYPASS				;
	TXO	F,REGET
	PUSHJ	P,SYMIN			;GET THE MODULE NAME
	SKIPN	A			;IF NO MODULE NAME GIVEN,
	$KILL(NMS,Null specification to .MODULE,N$EDIT)
	CAMN	A,CURMOD		;SAME MODULE NAME AS ONE IN CORE?
	JRST	MOD5			;YES, JUST MAKE CHECKS
	PUSHJ	P,UDFCHK		;CHECK FOR UNDEFINED LABELS
	MOVEM	A,CURMOD		;MAKE THIS MODULE BE CURRENT
	PUSHJ	P,PUTPG			;UNLOAD PROGRAM IN CORE
	PUSHJ	P,MSTGET		;SET UP IO ROUTINES
	 JFCL				;DONT CARE
	MOVE	R,CURMOD		;GET MODULE NAME
	PUSHJ	P,RAD50			;CONVERT TO RADIX 50
	TXZ	F,CPASS2		;FIRST PASS

MOD2:	PUSHJ	P,READ			;READ A PROGRAM
	   JRST [  TXOE	F,CPASS2	;EOF. ARE WE DOING 2ND PASS?
		  JRST	MNFERR		;YES,REALLY NOT THERE
		  PUSHJ	P,BACKUP	;REWIND THE FILES
		  JRST	MOD2  ]		;AND MAKE 2ND PASS
	CAMN	R,A			;IS THIS THE RIGHT MODULE?
	JRST	MOD3			;YES!
	PUSHJ	P,WRITE			;NO, SO WRITE IT OUT
	JRST	MOD2			;AND TRY AGAIN

MOD3:	PUSHJ	P,YANKPG		;YANK ALL OF PROGRAM INTO CORE
	 JRST	[MOVE N,R
	$KILL(EFF,End of file found before END block in module,N$50)]
	MOVE	N,CURMOD		;SET MODULE NAME INTO TYPEOUT
	SKIPN	SSTLOC			;SYMBOLS FOUND?
	$WARN (SNF,Symbols not found for module,N$SIX)
;**;[101]	DELETE TWO LINES  @ MOD3 6L +	MS	16-SEPT-80
MOD5:	TXZ	F,FSTMOD		;SEEN A .MODULE SINCE LAST .EDIT
	MOVE	A,CUREDT		;SEE IF THIS MODULE HAS THIS EDIT
	PUSHJ	P,FNDEDT		;ALREADY. THIS IS AN ERROR
	 JRST	MOD6			;NO. ITS OK, EDIT NOT THERE
	MOVE	N,CURMOD		;BLOW THEM AWAY
	$KILL (MHE,Module,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ/ already has an edit /]
	PUSHJ	P,.TSTRG##		;FINISH MESSAGE
	MOVE	T1,CUREDT		;IDENTIFY EDIT
	PUSHJ	P,.TSIXN##		;
	JRST	DONERR			;END MESSAGE

MOD6:	MOVE	A,CUREDT		;SEE IF THERE ARE CONFLICTS
	MOVSI	B,400000		;WITH THIS EDIT BEING INSERTED
	PUSHJ	P,CHKCNF		;
	PUSHJ	P,.POP4T##		;RESTORE ACS
	JRST	MECELL			;END OF CELL,I HOPE
; /FP.ASC/ - FIX-PSEUDO-OP PROCESSOR FOR LINE OF FORM:
;	.ASSOCIATED EDIT,+EDIT,-EDIT,EDIT,+EDIT....	;ASSOC. EDITS
;
; 	NOTE THAT A .MODULE FIX-PSEUDO-OP MUST BE PRESENT
;	BEFORE THE .ASSOCIATE  FIX-PSEUDO-OP, TO SELECT THE CURRENT MODULE
;

FP.ASC:	PUSHJ	P,.PSH4T##		;FREE SOME ACS
	TXNN	F,IAE			;INSIDE AN ACTIVE EDIT?
	JRST	E$$EPM			;NO,COMPLAIN
	TXNE	F,FSTMOD		;[MODULE]SEEN YET?
	JRST	MKMERR			;NO,COMPLAIN
	MOVE	D,TRCVAP		;GET POINTER TO VARIABLE AREA
ASC1:	BYPASS				;SKIP OVER BLANKS
	MOVE	N,CUREDT		;SET UP FOR EDIT NAME
	SETZ	T4,			;MARK FOR "-" ASSOCIATION
	CAIN	CC,"-"			;IS IT?
	JRST	ASC2			;YES

	MOVSI	T4,400000		;SET FOR "+" ASSOCIATION
	CAIE	CC,"+"			;EXPLICIT?
	TXO	F,REGET			;NO,IMPLIED,REGET FIRST CHAR
ASC2:	PUSHJ	P,SYMIN			;LOAD EDIT NAME
	JUMPE	A,AERROR
	MOVE	T1,TRCPTR		;GET POINTER
	HRRZ	T2,TB$LEN(T1)		;GET RH OF LENGTH
	JUMPN	T2,[$KILL(AAC,<.ASSOCIATED seen after .INSERT,.REMOVE or .REINSERT>,N$EDIT)]
	MOVSI	T2,1			;ADD 1 TO LH OF TB$LEN
	ADDM	T2,TB$LEN(T1)		;FOR A.E. COUNT
	AOS	TB$HED(T1)		;UPDATE WORD COUNT
	AOS	TB$HED(T1)		;BY TWO FOR AN A.E.
	CAILE	D,TRCLST-1		;ROOM FOR THIS A.E.?
	JRST	E$$ITS			;NO,COMPLAIN
	MOVEM	A,TB$AEN(D)		;STORE ASSOCIATED NAME
	MOVEM	T4,TB$AES(D)		;AND REQUIRED STATUS
	ADDI	D,2			;UPDATE POINTER
	MOVEM	D,TRCVAP		;AND STORE IT
	PUSHJ	P,FNDEDT		;LOOK IT UP
	  JRST	ASC3			;NOT FOUND
	SKIPL	TB$STA(B)		;WAS FOUND, IS IT ACTIVE?
	JRST	ASC3A			;NO
	JUMPL	T4,ASC4			;IS ACTIVE, WANTED ACTIVE?
	MOVE	N,A			;WARN
	$WARN(PEP,Precluded edit,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ/ is present in module /]
ASC2A:	PUSHJ	P,.TSTRG##		;REST OF MESSAGE
	MOVE	T1,CURMOD		;GET MODULE NAME
	PUSHJ	P,.TSIXN##		;
X$$PEP:X$$REM:
X$$RER:	PUSHJ	P,.TCRLF##		;CLOSE MESSAGE
	TXZ	F,FOTTY			;
	JRST	ASC4

ASC3:	JUMPGE	T4,ASC4			;IS NOT ACTIVE.WANTED THIS?
	MOVE	N,A			;YES,SO WARN THAT ISNT THERE
	$WARN(REM,Required edit,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ/ is missing from module /]
	JRST	ASC2A

ASC3A:	JUMPGE	T4,ASC4			;THERE BUT INACTIVE,WANTED THIS?
	MOVE	N,A			;NO,GIVE WARNING
	$WARN(RER,Required edit,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ " is inactive in module "]
	JRST	ASC2A

ASC4:	TXO	F,REGET			;STARTING WITH DELIMITER OF EDIT NAME,
	BYPASS				;GET NEXT NON-BLANK CHARACTER
	SKPNCM				;IS IT A COMMA?
	JRST	ASC1			;YES,INDICATES ANOTHER EDIT
	PUSHJ	P,.POP4T##		;RESTORE THE ACS
	JRST	MECELL			;AND RETURN

SAYEDT:	PUSHJ	P,.TSPAC##		;SEPARATE BY ONE SPACE
	PUSHJ	P,SAYED1		;CALL COMMON ROUTINE
	PUSHJ	P,.TCRLF##
	JRST	DONERR
SAYED1:	MOVEI	T1,[ASCIZ "in edit "]
	PUSHJ	P,.TSTRG##
	MOVE	T1,CUREDT
	PJRST	.TSIXN##
; /FP.NAM/  - PSEUDO-OP TO GET THE PATCH CREATOR'S
;	INITIALS OUT OF THE PATCH FILE
;	.NAME III		;PERSON WHO CREATED THE PATCH
;

FP.NAM:	TXNN	F,IAE			;IN AN EDIT
	JRST	E$$EPM			;NO, COMPLAIN
	BYPASS				;LOAD INITIALS FROM
	TXO	F,REGET			;INPUT FILE, INDICATES
	PUSHJ	P,SYMIN			;PATCH CREATOR NAME
	MOVE	D,TRCPTR		;AND GET POINTER
	HLLM	A,TB$MAK(D)		;SET IT DOWN
	JRST	MECELL			;
; /FP.DAT/ - GET THE DATE OF THE PATCH FROM THE PSEUDO-OP .DATE
;
; FORMAT:	.DATE DD-MON-YY		;THIS IS THE DATE OF THE THING
;		.DATE DD-MON		;OR DEFAULT THE YEAR

FP.DAT:	PUSHJ	P,.PSH4T##		;SAVE ACS T1-4
	BYPASS				;SKIP BLANKS BEFORE ARGUMENT
	TXO	F,REGET			;
	PUSHJ	P,DECIN			;GET A DECIMAL NUMBER
;**; [101] INSERT @ FP.DAT + 5L	MS	15-SEPT-80
;**; [101] CHANGE @ FP.DAT +6L
;**; [101] THE EDIT NUMBER WILL INDICATE WHICH EDIT IS WRONG IN THE FIX FILE.
	MOVE	N, CUREDT		;[101] GET THE EDIT NUMBER
	JUMPE	A,[$KILL(BDA,Bad .DATE argument for EDIT:, N$SIX)] ;[101]
	CAIE	CC,"-"			;SPECIAL SEPARATOR
	JRST	E$$BDA			;ELSE COMPLAIN
	PUSH	P,A			; STORE IT
	PUSHJ	P,SYMIN			;GET MONTH NAME
	MOVE	T1,[IOWD ^D12,MTAB]	;GET POINTER TO TABLE
	MOVE	T2,A			;WHAT TO LOOK FOR
	PUSHJ	P,.LKNAM##		;HOW TO LOOK
	  JRST	E$$BDA			;BAD FORMAT
	HRRZ	B,T1			;GET RH
	SUBI	B,MTAB			;AND GET INTO PROPER RELATIVE
	CAIN	CC,"-"			;DASH?
	JRST	DAT1			;YES, YEAR SUPPLIED
	DATE	T2,			;GET DATE RIGHT NOW
	IDIVI	T2,^D12*^D31		;ONLY INTERESTED IN YEAR
	JRST	DAT2			;SKIP THE READ IN
DAT1:	PUSHJ	P,DECIN			;GET YEAR
	MOVE	T1,A			;GET FROM ARG AC
	IDIVI	T1,^D100		;MAKE 2 DIGIT
	SUBI	T2,^D64			;SINCE 1964
	JUMPE	T2,E$$BDA		;IF .LE. 0
DAT2:	IMULI	T2,^D12			;MULTIPLY TO GET RIGHT
	ADD	T2,B			;ADD THE (MONTH-1)
	IMULI	T2,^D31			;GET OVER
	ADD	T2,0(P)			;ADD IN PARTIAL RESULT
	SOS	T2			;ADJUST FOR THE MINUS ONE
	POP	P,0(P)
	MOVE	T3,TRCPTR		;STORE IN STATIC AREA OF TRACE BLOCK
	HRRM	T2,TB$MAK(T3)		;
	PUSHJ	P,.POP4T##		;RESTORE T1-T4
	JRST	MECELL			;END IT

MTAB:	SIXBIT/JANUAR/			;TABLE OF MONTHS OF THE YEAR
       	SIXBIT/FEBRUA/
	SIXBIT/MARCH/
	SIXBIT/APRIL/
	SIXBIT/MAY/
	SIXBIT/JUNE/
	SIXBIT/JULY/
	SIXBIT/AUGUST/
	SIXBIT/SEPTEM/
	SIXBIT/OCTOBE/
	SIXBIT/NOVEMB/
	SIXBIT/DECEMB/
; /FP.VER/ - GET THE VERSION TO SET UP IN LOCATION .JBVER(137)
;
; FORMAT:	.VERSION  777BK(777777)-7 OR SOME SUBSET THEREOF
;  THE RESULT IS "LOC"ED INTO WORD 137(ABSOLUTE) OF REL FILE CORE IMAGE

FP.VER:	PUSHJ	P,.PSH4T##		;SAVE TEMP ACS
	SETZ	T4,			;PLACE TO BUILD VERSION NUMBER
	BYPASS				;GET FIRST NON-BLANK
	TXO	F,REGET
	SKPNUM				;IS IT NUMBER?
	JRST	VER1			;NO,THEN CANT BE MAJOR VERSION
	PUSHJ	P,OCTIN			;LOAD THE NUMBER
	CAILE	A,777			;SMALL ENOUGH?
	JRST	AERROR			;NO,SO COMPLAIN
	DPB	A,[POINT 9,T4,11]	;ELSE STORE IT
VER1:	SKPABC				;IS CHARACTER ALPHABETIC?
	JRST	VER2			;NO,SO CANT BE MINOR VERSION
	MOVEI	A,-"A"+1(CC)		;CONVERT FIRST PART OF MINOR VERSION
	DPB	A,[POINT 6,T4,17]	;STORE IT AWAY
	TXZ	F,REGET			;INSURE ITS NEW CHARACTER
	PUSHJ	P,MIC			;GET IT
	SKPABC				;MINOR VERSION CAN BE TWO LETTERS
	JRST	VER2			;BUT THIS ONE ISN'T
	IMULI	A,^D26			;RADIX 26 ARITHMETIC
	ADDI	A,-"A"+1(CC)		;ADD IN THE SECOND PART
	CAILE	A,77			;ONLY SIX BITS WIDE
	JRST	AERROR			;ELSE REPORT THE ERROR
	DPB	A,[POINT 6,T4,17]	;STORED AWAY FOR NOW
	BYPASS				;GET NEXT CHARACTER PRIMED
VER2:	CAIE	CC,LPAREN		;CHECK FOR (77777) ,EDIT NUMBER
	JRST	VER3			;NOT SUPPLIED
	TXZ	F,REGET			;SUPPLIED, EAT THE LPAREN
	PUSHJ	P,OCTIN			;GET THE OCTAL NUMBER
	CAIG	A,777777		;GREATER THAN HALFWORD
	CAIE	CC,RPAREN		;OR NOT DELIMITED PROPERLY
	JRST	AERROR			;IS AN ERROR
	HRRI	T4,0(A)			;MERGE INTO VERSION WORD
	BYPASS				;GET NEXT PART
VER3:	CAIE	CC,"-"			;IS IT "WHO MODIFIED"?
	JRST	VER4			;NO
	PUSHJ	P,OCTIN			;GET OCTAL PART
	CAILE	A,7			;3 BITS WIDE
	JRST	AERROR
	DPB	A,[POINT 3,T4,2]	;STORE INTO OUR WORD
VER4:	MOVE	T1,[1,,2]		;CODE BLOCK, TWO WORDS LONG
	MOVEM	T1,VERBLK+0		;GOES INTO TOP OF BLOCK
	MOVX	T1,<BYTE (2)0,0>	;NEITHER LOCATION OR DATA IS TO
	MOVEM	T1,VERBLK+1		;BE RELOCATABLE
	MOVEI	T1,.JBVER##		;THIS IS WHERE TO
	MOVEM	T1,VERBLK+2		;LOCATE THE DATA
	MOVEM	T4,VERBLK+3		;AND FINALLY,THIS IS THE DATA
	PUSHJ	P,.POP4T##		;RESTORE THE ACS
	JRST	MECELL			;END OF IT
; /FP.INS/ - ROUTINE TO INSERT A NEW EDIT. THIS ROUTINE PROCESSES
;		FIX-PSEUDO-OPS OF THE FORMAT:
;	.INSERT   location,  POSITION:arg, <code to match>
;
;	WHERE THE FIRST FIELD (REQUIRED) IS THE LOCATION TO PATCH, (IE
;	THE LOCATION THAT GETS THE "JUMPA <LOCATION-OF-PATCH-CODE>"
;	WHERE THE SECOND FIELD (REQUIRED) IS THE POSITION OF THE PATCH
;	IN RELATION TO THE DISPLACED INSTRUCTION (THE INSTRUCTION
;	OVERWRITTEN WITH THE "JUMPA <LOCATION-OF-PATCH-CODE>"
;	IF "POSITION"   IS:
;	   AFTER	THEN DISPLACED INSTR IS FIRST INSTRUCTION OF PATCH
;	   BEFORE	THEN DISPLACED INSTR IS LAST  INSTRUCTION OF PATCH
;	   REPLACE	THEN FOR EACH INSTRUCTION TYPED IN, ONE IS DELETED
;			AND NEVER EXECUTED
;	  REPLACE:n	THEN n INSTRUCTIONS ARE NOT EXECUTED , REGARDLESS
;			OF HOW MANY INSTRUCTIONS ARE INSERTED.
;	NOTE: THE POSITION ARGUMENT CAN BE UNIQUE AT ONE LETTER (A,B,R)
;
;	WHERE THE THIRD FIELD (OPTIONAL) IS THE WORD OF CODE AT THE
;	LOCATION OF THE PATCH. IF PRESENT, THE ANGLE BRACKETS ARE
;	REQUIRED.  IF THE CODE DOES NOT MATCH THE ACTUAL CODE AT THE
;	LOCATION SPECIFIED IN FIELD 1, A FATAL ERROR MESSAGE IS GIVEN.

FP.INS:	PUSHJ	P,.PSH4T##		;SAVE ACS
;**; [102] INSERT @ FP.INS + 1L	MS	16-SEPT-80
;**; [102] GIVE THE ERROR IF THE INSERT PSEUDO-OP
;**; [102] IS USED ON THE MODULE WITH NO PROGRAM CODE
	SKIPN	SPCLOC			;[102]ANY PROGRAM CODE?	
	$KILL (NPC,No program code was found for module,N$EDIT)	;[102]
	TXNN	F,IAE			;INSIDE EDIT?
	JRST	E$$EPM			;".EDIT FIX-PSEUDO-OP IS MISSING"
	TXOE	F,IAI			;INSIDE INSERT,WAS INSIDE?
	$KILL(IIA,.INSERT pseudo-op illegal inside range of .INSERT,N$SIX)
	TXNE	F,FSTMOD		;SEEN .MODULE FOR THIS EDIT?
	JRST	MKMERR			;NO,SO COMPLAIN
	PUSHJ	P,EVALEX		;EVALUATE EXPRESSION FOR LOCATION
	TXNE	D,C.NULL		;DONT ALLOW NULL
	$KILL(IUN,Illegal to have null address in .INSERT,N$EDIT)
	JUMPN	C,FERROR		;DONT ALLOW LIT,EXT OR UDF
	TLNN	A,-1			;MAKE SURE ITS VALID 18 BIT ADDRESS
	TLNE	B,-1			;AND LH NOT RELOCATED
	$KILL(IAI,Illegal address in .INSERT,N$EDIT)
;**; [103] INSERT @ FP.INS + 18L	MS	16-SEPT-80
	MOVE	N, CUREDT		;[103] GET EDIT NUMBER
	PUSHJ	P,WRDSRC		;MAKE SURE ITS VALID AS AN ADDRESS
	  $KILL(IAL,.INSERT address is not in current module in edit,N$SIX)
	MOVE	T1,TRCPTR		;DO SOME HOUSEKEEPING
	AOS	TB$LEN(T1)		;INDICATE NEW PCO GROUP
	MOVEI	T2,PCO1SZ		;UPDATE SIZE OF BLOCK
	ADDM	T2,TB$HED(T1)		;FOR LINK ITEM TYPE HEADER
	MOVE	T2,[1,,PCO1SZ]		;MAKE A PCO TYPE 1 HEADER
	MOVE	T1,TRCVAP		;SET TO UPDATE VARIABLE AREA
	CAILE	T1,TRCLST-PCO1SZ+1	;
	JRST	E$$ITS			;NOT ENUFF TRACE STOREAGE LEFT
	MOVEM	T2,TB$PCO(T1)		;STORE IT
	HRRZM	A,TB$DAT(T1)		;STORE THE ADDRESS OF THE PATCH
	MOVE	A,0(C)			;PICK UP ORIG INSTRUCTION
	MOVEM	A,SAVCOD		;STORE IT FOR LATER
	PUSHJ	P,GETREL		;GET RELOCATION BYTE FROM (C) AND (B)
	MOVEM	D,SAVREL			;STORE SAVED ORIG. RELOCATION
	SKPCM				;SHOULD HAVE COMMA HERE
	JRST	AERROR			;NOT ENOUGH ARGUMENTS
	TXZ	F,REGET			;DONT REGET COMMA
	BYPASS				;[21]SKIP ANY SPACES
	TXO	F,REGET			;[21]AND GET THE NEXT CHARACTER
	PUSHJ	P,SYMIN			;GET THE SYMBOL
	SKIPN	A			;FIND ANYTHING?
	$KILL(BAM,<BEFORE, AFTER or REPLACE missing from .INSERT>,N$EDIT)
	MOVE	T2,A			;
	MOVE	T1,[IOWD 3,[SIXBIT/BEFORE/
			    SIXBIT/REPLAC/
			    SIXBIT/AFTER/]]
	HRRZI	A,2(T1)			;FOR LATER ADJUSTMENT
	PUSHJ	P,.LKNAM##		;LOOK IT UP
	 JRST	[MOVE N,T2
		 $KILL(NRP,Not a recognized position switch:,N$SIX)]
	TLZ	T1,-1			;GET RID OF AOBJN LEFT HALF
	SUBI	T1,(A)			;CONVERT TO -1,0,+1
	SETZM	CPINST			;NO INSTRUCTIONS INSERTED YET
	MOVEM	T1,BARFLG		;AND STORE IT
	SETZM	CPREPI			;DEFAULT NUMBER FOR REPLACE:N
	JUMPN	T1,INS4			;IF NOT /REPLACE DONT LOOK FOR ARG
	CAIE	CC,":"			;ARG THERE?
	JRST	INS4			;NO,LEAVE IT 0
	BYPASS
	TXO	F,REGET
	PUSHJ	P,EVALEX		;GET NUMBER OF INSTRS TO SKIP ON RETURN FROM PATCH
	JUMPN	B,RERROR		;CAN'T BE RELOCATABLE
	JUMPN	C,FERROR		;OR FORWARD REFERENCE
	JUMPL	A,E$$RTL		;[26]DON'T ALLOW A NEGATIVE OFFSET
	MOVEM	A,CPREPI		;DEPOSIT IT
	MOVE	T1,TRCVAP		;GET PCO POINTER AGAIN
	HRRZ	T2,TB$DAT(T1)		;GET ADDRESS OF PATCH BREAK
	SOS	T2			;[50] BACK OFF ONE
	ADD	A,T2			;[26]GET LAST LOCATION USED
	PUSHJ	P,WRDSRC		;MAKE SURE THIS IS NOT A CROQUE
	  SKIPA  N,CPREPI		;RETURN PC NOT IN BOUNDS
	JRST	INS4			;ITS OK
	$KILL(RTL,.INSERT'S REPLACE argument of,N$OCT,$MORE)
	MOVEI	T1,[ASCIZ " too large for module "]
	PUSHJ	P,.TSTRG##
	MOVE	T1,CURMOD
	PUSHJ	P,.TSIXN##
	JRST	SAYEDT

INS4:	TXO	F,REGET			;SKIP BLANKS
	BYPASS				;
	SKPNCM				;END WITH COMMA?
	PUSHJ	P,ORGCOD		;YES, SO EVALUATE THE COMPARE CODE
	PUSHJ	P,SETPT			;ELSE JUST SET UP FOR PATCHING
	PUSHJ	P,.POP4T##
	JRST	MECELL			;CHARACTER ENDS CELL
; /FP.ENI/ - PROCESSOR TO HANDLE .ENDI FIX-PSEUDO-OP 
;  THIS PSEUDO-OP IS USED TO INDICATE THE END OF AN INSERT.  WE
;	DO SOME BOOKEEPING, FINISH THE PATCH WITH TWO
;	INSTRUCTIONS OF FORM:
;		JUMPA 1,CPRET
;		JUMPA 2,CPRET+1
;
;    	AFTER THESE TWO INSTRUCTIONS, ALL "PSEUDO-LITERALS" ARE
;	GENERATED.
;

FP.ENI:	PUSHJ	P,.PSH4T##		;SAVE THE TEMPS
	TXZN	F,IAI			;OFF INSERT,WAS IT ON?
	JRST	[MOVE N,CUREDT
	$KILL(IPM,.ENDI seen without .INSERT in edit,N$SIX)]
	MOVE	T1,TRCVAP		;GET VARIABLE AREA POINTER
	SKIPL	BARFLG			;WAS THIS A /BEFORE PATCH?
	JRST	ENI3			;NO, MUST BE /AFTER OR /REPLACE
	MOVE	C,CPADDR		;GET ADDRESS INSTRUCTION GOES TO
	HRLM	C,TB$PAT(T1)		;PUT IT AWAY FOR NOW
	MOVE	C,SAVCOD		;GET DISPLACED INSTRUCTION
	MOVE	B,SAVREL		;GET RELOCATION FOR INSTRUCTION
	PUSHJ	P,NEWCOD		;GENERATE THE INSTRUCTION
	  JRST	INSERR
ENI3:	HRRZ	A,TB$DAT(T1)		;MOVING ORIG INSTR [FROM]
	HLRZ	B,TB$PAT(T1)		;ORIG INSTR [TO]
	PUSHJ	P,GFIXUP		;DO THE FIXUPS IF ANY
	SKIPN	BARFLG			;IF NOT /REPLACE OR
	SKIPN	CPREPI			;OR NO ARG TO /REPLACE
	JRST	ENI4			;SKIP RETURN FIXUP
	ADD	A,CPREPI		;UPDATE BY NUMBER THEY SAID TO SKIP ON RETURN
	MOVEM	A,CPRET			;THIS IS RETURN PC TO USE
ENI4:	HRRZ	T2,TB$DAT(T1)		;FETCH ADDRESS OF INSERT
	CAMGE	T2,CPRET		;RETURN IS TO GREATER ADDRESS ,RIGHT?
	JRST	ENI5			;THATS RIGHT,SO ALL IS OK
	SKIPE	BARFLG			;IF NOT "REPLACE"
	$STPCD(Patch return PC is incorrect)
	AOS CPRET			;ITS REPLACE:1 WITH NULL (DELETE)
ENI5:	MOVE	T2,CPINST		;NUMBER OF INSTRUCTIONS INSERTED
	HRLM	T2,TB$DAT(T1)		;DEPOSIT INTO CURRENT TRACE AREA
	ADDI	T1,PCO1SZ		;UPDATE SIZE OF VARIABLE AREA POINTER
	MOVEM	T1,TRCVAP		;SO NEXT PCO DOES NOT OVERWRITE THIS ONE
	MOVSI	C,(JUMPA 1,)		;GENERATE RETURNS
	HRR	C,CPRET			;
	MOVEI	B,1			;RIGHT RELOCATED
	PUSHJ	P,NEWCOD		;GENERATE NEW CODE
	  JRST	INSERR			;NO MORE ROOM
	ADD	C,[Z 1,1]		;SECOND RETURN INSTRUCTION
	MOVEI	B,1			;ALSO RELOCATABLE
	PUSHJ	P,NEWCOD		;INSERT IT TOO
	  JRST	INSERR
	PUSHJ	P,PMLIT			;DO LITERAL FIXUPS
	PUSHJ	P,PMDEF			;DO ANY DEFINITIONS THAT OCCUR
	PUSHJ	P,.POP4T##		;RESTORE T1-4
	JRST	MECELL			;AND END IT
; /FP.REM/ - ROUTINE TO HANDLE .REMOVE FIX-PSEUDO-OP
;
; 	THIS FIX-PSEUDO-OP IS OF THE FORM :
;	 .REMOVE EDIT,EDIT , EDIT...
;
; THE PROCESSOR CHECKS FOR ERRORS, REPORTS CONFLICTS AND
; ALSO UPDATES POINTERS BESIDES REMOVING THE EDIT SPECIFIED.
;

FP.REM:	PUSHJ	P,.PSH4T##		;SAVE T1-T4
	TXNN	F,IAE			;INSIDE AN EDIT?
	JRST	E$$EPM			;NO,ITS AN ERROR
	TXNE	F,FSTMOD		;.MODULE SEEN?
	JRST	MKMERR			;NO,ITS AN ERROR

REM1:	BYPASS				;SKIP BLANKS
	TXO	F,REGET
	PUSHJ	P,SYMIN			;GET EDIT NAME
	JUMPE	A,AERROR		;IF NULL NAME
	CAMN	A,CUREDT		;NOT TRYING TO DIDDLE THIS EDIT,ARE WE?
	JRST	ERIERR			;YES,COMPLAIN
	MOVE	T1,TRCVAP		;CURRENT VARIABLE POINTER
	CAILE	T1,TRCLST-<PCO2SZ-1>	;ENUFF ROOM LEFT?
	JRST	E$$ITS			;NO.
	MOVE	T2,[2,,PCO2SZ]		;HEADER FOR CHANGE ORDER
	MOVEM	T2,TB$PCO(T1)		;STORE IT
	MOVEM	A,TB$REN(T1)		;AND EDIT NAME REMOVED
	ADDI	T1,PCO2SZ		;UPDATE POINTER
	MOVEM	T1,TRCVAP		;TO REFLECT PCO
	MOVE	T1,TRCPTR		;UPDATE STATIC AREA SIZE
	MOVEI	T2,PCO2SZ		;BY RIGHT NUMBER OF WORDS
	ADDM	T2,TB$HED(T1)		;ALSO THE LINK ITEM HEADER
	AOS	TB$LEN(T1)		;AND COUNTER OF PCO GROUPS
	PUSHJ	P,FNDEDT		;FIND EDIT
	 JRST	REM9			;NOT THERE!
	SKIPL	TB$STA(B)		;IS IT ACTIVE?
	JRST	REM8			;NO,SO CANT REMOVE IT
	PUSH	P,B			;SAVE POINTER TO EDIT
	SETZ	B,			;AND CHECK FOR CONFLICTS
	PUSHJ	P,CHKCNF		;REPORT ANY
	POP	P,T1			;T1 IS NOW PTR TO REMOVED EDIT TRACE BLOCK
	MOVE	T2,WHO			;RESET WHO TOUCHED AND ACTIVE FLG
	HRRZM	T2,TB$STA(T1)		;XWD 0,,WHO
	MOVEI	T3,TB$VAR(T1)		;T3 GETS START OF VARIABLE AREA
	HLRZ	T4,TB$LEN(T1)		;T4 GETS NR. OF ASSOC EDIT COUPLETS
	IMULI	T4,AESIZ		;NUMBER OF WORDS PER A.E.
	ADD	T3,T4			;POINT PAST THE A.E.S (IF ANY)
	HRRZ	T4,TB$LEN(T1)		;GET NR OF PCO GROUPS
;**; [75] INSERT @ REM2 - 1L		MFB	9-JUN-80
	JUMPE	T4,REM10		;[75] MUST HAVE SOMETHING TO REMOVE
	MOVE	T1,T3			;GET ADDRESS OF FIRST PCO INTO T1
REM2:	JUMPE	T4,REM3			;ANY PCOS LEFT TO DO?
	HLRZ	T3,TB$PCO(T1)		;YES,GET PCO TYPE
	CAIE	T3,1			;IS IT INSERT PCO?
	CAIN	T3,4			;OR ALTER PCO?
	SKIPA
	JRST	REM2A			;NOT EITHER ONE
	HLRZ	B,TB$PAT(T1)		;GET ONE ADDRESS
	HRRZ	 A,TB$DAT(T1)		;AND THE OTHER
	PUSHJ	 P,SWPWRD		;GO CHANGE IT
REM2A:	HRRZ	T3,TB$PCO(T1)		;GET PAST THE PCO
	ADDI	T1,0(T3)		;TO NEXT ONE (IF ANY)
	SOJG	T4,REM2			;AND UPDATE COUNT
REM3:	TXO	F,REGET			;START WITH SYMBOL DELIMITER
	BYPASS				;
	SKPNCM				;A COMMA?
	JRST	REM1			;YES,GET NEXT EDIT NAME
	PUSHJ	P,.POP4T##
	JRST	MECELL			;

ERIERR:	$KILL(ERI,Edit,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ " tried to .REMOVE or .REINSERT itself"]
	PUSHJ	P,.TSTRG##
	JRST	DONERR


REM8:	MOVE	N,CUREDT
	$WARN(RIE,Edit,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ " tried to .REMOVE already inactive edit "]
REM8A:	PUSHJ	P,.TSTRG##
	MOVE	T1,A
	PUSHJ	P,.TSIXN##
;**; [75] CHANGE @ X$$RIE		MFB	9-JUN-80
X$$RIE:X$$RNE:X$$REE:
	PUSHJ	P,.TCRLF##
	TXZ	F,FOTTY
	JRST	REM3

REM9:	MOVE	N,CUREDT
	$WARN(RNE,Edit,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ " tried to .REMOVE non-existent edit "]
	JRST	REM8A
;**; [75] INSERT @ REM9 + 4L		MFB	9-JUN-80
REM10:	MOVE	N,CUREDT		;[75] GET CURRENT EDIT NUMBER
	$WARN(REE,Edit,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ " tried to .REMOVE edit "]	;[75]
	PUSHJ	P,.TSTRG##		;[75] TYPE THE STRING
	MOVE	T1,A			;[75]
	PUSHJ	P,.TSIXN##		;[75] AND EDIT TRYING TO REMOVE
	MOVEI	T1,[ASCIZ " that has no code"]	;[75]
	PUSHJ	P,.TSTRG##		;[75] PLUS FINAL STRING
	JRST	X$$REE			;[75] JOIN COMMON CODE
; /FP.RNS/ -  PROCESSOR FOR .REINSERT FIX-OP
;
;  	THIS FIX-PSEUDO-OP IS OF THE FORM :
;	  .REINSERT EDIT,EDIT...
;
; 	THE MODULES SPECIFIED ARE RE-ACTIVATED IF THEY HAVE BEEN
;	REMOVED.
;

FP.RNS:	PUSHJ	P,.PSH4T##		;SAVE T1-4
	TXNN	F,IAE			;INSIDE EDIT?
	JRST	E$$EPM			;NO
	TXNE	F,FSTMOD		;[MODULE] SEEN?
	JRST	MKMERR			;NO,ITS AN ERROR

RNS1:	BYPASS				;EAT BLANKS
	TXO	F,REGET
	PUSHJ	P,SYMIN			;GET AN EDIT NAME
	JUMPE	A,AERROR		;IF NULL,THIS IS ERROR
	CAMN	A,CUREDT		;CHECK FOR TRYING TO RE-INSERT ITSELF
	JRST	ERIERR			;THATS FATAL ERROR
	MOVE	T1,TRCVAP		;NOW ADD PCO
	CAILE	T1,TRCLST-<PCO3SZ-1>	;IF ROOM, ELSE
	JRST	E$$ITS			;ABORT ON INSUFFICIENT SPACE
	MOVE	T2,[3,,PCO3SZ]		;PCO HEADER
	MOVEM	T2,TB$PCO(T1)		;DEPOSIT IT
	MOVEM	A,TB$RIN(T1)		;ALSO THE EDIT NAME
	ADDI	T1,PCO3SZ		;UPDATE POINTER
	MOVEM	T1,TRCVAP		;AND STORE IT
	MOVE	T1,TRCPTR		;GET TRACE POINTER
	MOVEI	T2,PCO3SZ		;UPDATE SIZE
	ADDM	T2,TB$HED(T1)		;OF LINK BLOCK HEADER
	AOS	TB$LEN(T1)		;INCREMENT COUNT OF PCO'S
	PUSHJ	P,FNDEDT		;NOW FIND THE EDIT
	  JRST	RNS9			;NOT THERE. ITS AN ERROR
	SKIPGE	TB$STA(B)		;CHECK IF ITS NOT ACTIVE
	JRST	RNS8
	PUSH	P,B			;SAVE POINTER
	MOVSI	B,400000		;RE-INSERTION FLAG ON
	PUSHJ	P,CHKCNF		;GENERATE WARNINGS FOR CONFLICTS
	POP	P,T1			;POINT TO TRACE BLOCK
	MOVE	T2,WHO			;WHO IS AFFECTING STATUS
	HRROM	T2,TB$STA(T1)		;-1,,WHO
	MOVEI	T3,TB$VAR(T1)		;GET T3 LOADED WITH ADDRESS OF VARIABLE AREA
	HLRZ	T4,TB$LEN(T1)		;GET NUMBER OF ASSOC EDITS
	IMULI	T4,AESIZ		;NUMBER OF WORDS PER AE
	ADD	T3,T4			;UPDATE IT
	HRRZ	T4,TB$LEN(T1)		;GET NR. OF PCO GROUPS
	MOVE	T1,T3			;T1 HAS ADDR OF FIRST PCO

RNS2:	JUMPE	T4,RNS3			;ANY PCOS LEFT TO DO?
	HLRZ	T3,TB$PCO(T1)		;YES,GET PCO TYPE
	CAIE	T3,1			;IS IT INSERT PCO?
	CAIN	T3,4			;OR ALTER PCO?
	SKIPA
	JRST	RNS2A			;NOT EITHER ONE
	HLRZ	A,TB$PAT(T1)		;GET ONE ADDRESS
	HRRZ	 B,TB$DAT(T1)		;AND THE OTHER
	PUSHJ	 P,SWPWRD		;GO CHANGE IT
RNS2A:	HRRZ	T3,TB$PCO(T1)		;GET PAST THE PCO
	ADDI	T1,0(T3)		;TO NEXT ONE (IF ANY)
	SOJG	T4,RNS2			;AND UPDATE COUNT
RNS3:	TXO	F,REGET			;CHECK DELIMITER
	BYPASS
	SKPNCM				;COMMA?
	JRST	RNS1			;YES,GET NEXT NAME
	PUSHJ	P,.POP4T##
	JRST	MECELL			;ELSE BETTER END CELL

RNS8:	MOVE	N,CUREDT
	$WARN(RIA,Edit,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ " tried to .REINSERT already active edit "]
RNS8A:	PUSHJ	P,.TSTRG##
	MOVE	T1,A
	PUSHJ	P,.TSIXN##
X$$RIA:X$$RIN:
	PUSHJ	P,.TCRLF##
	TXZ	F,FOTTY
	JRST	RNS3

RNS9:	MOVE	N,CUREDT
	$WARN(RIN,Edit,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ " tried to .REINSERT non-existent edit "]
	JRST	RNS8A
; /FP.ALT/ - ROUTINE TO HANDLE INLINE ALTERATION OF A WORD IN THE FILE
;		GENERATED BY PSEUDO-OPS OF THE FORM:
;	.ALTER location, <NEW VALUE> , <ORIGINAL VALUE>
; 	THE FIRST FIELD (REQUIRED) IS THE LOCATION TO PATCH THE
;	VALUE INTO. THE SECOND ARGUMENT IS EVALUATED AND PATCHED
;	INTO THE LOCATION IDENTIFIED BY THE FIRST.
;	THE THIRD ARGUMENT , WHICH MAY BE OMITTED, IS THE VALUE 
;	THAT IS CURRENTLY IN THE LOCATION SPECIFIED.
;	THIS IS COMPARED ALONG THE SAME LINES AS THE THIRD ARGUMENT
;	TO THE .INSERT PSEUDO-OP.
;


FP.ALT:	PUSHJ	P,.PSH4T##		;GET SOME ACS TO WORK WITH
;**; [102] INSERT @ FP.ALT + 1L		MS	16-SEPT-80
;**; [102] GIVE THE ERROR IF THE ALTER PSEUDO-OP
;**; [102] IS USED ON THE MODULE WITH NO PROGRAM CODE
	SKIPN	SPCLOC			;ANY PROGRAM CODE?	;[102]
	JRST	E$$NPC			;[102]
	TXNN	F,IAE			;INSIDE AN EDIT?
	JRST	E$$EPM			;?EDIT PSEUDO OP IS MISSING?
	TXNE	F,FSTMOD		;MODULE SELECTED FOR THIS ALTERATION?
	JRST	MKMERR			;NO. DO NOT PROCEED

	PUSHJ	P,EVALEX		;EVALUATE FIRST ARGUMENT
	TXNE	D,C.NULL		;NO ARGUMENT THERE?
	JRST	AERROR			;NO. SAY ARGUMENT ERROR
	JUMPN	C,FERROR		;UNKNOWN LOCATION LOSES
	TLNN	A,-1			;DONT ALLOW FUNNY VALUE
	TLNE	B,-1			;IE LH AND LH(RELOC) ARE 0
	$KILL(IAA,Illegal address in .ALTER,N$EDIT)
	PUSHJ	P,WRDSRC		;LOOK IT UP IN FILE
	  $KILL(AAL,.ALTER address is not in current module,N$EDIT)
	MOVE	T1,TRCPTR		;GET CURRENT TRACE BLOCK
	AOS	TB$LEN(T1)		;INDICATE NEW PCO GROUP
	MOVEI	T2,PCO4SZ		;UPDATE SIZE OF BLOCK
	ADDM	T2,TB$HED(T1)		;FOR LINK 
	MOVE	T2,[4,,PCO4SZ]		;SET UP FOR CREATING PCO
	MOVE	T1,TRCVAP		;FETCH VARIABLE AREA POINTER
	CAILE	T1,TRCLST-PCO4SZ+1	;DO WE STILL HAVE ROOM?
	JRST	E$$ITS			;NO, INSUFFICIENT ROOM
	MOVEM	T2,TB$PCO(T1)		;STORE HEADER AWAY
	HRRZM	A,TB$DAT(T1)		;ALSO STORE AWAY LOCATION
	MOVE	A,0(C)			;GET ACTUAL WORD
	MOVEM	A,SAVCOD		;STORE IT AWAY FOR NOW
	PUSHJ	P,GETREL		;GET THAT WORD'S RELOCATION
					;NOTE C,B SET UP BY WRDSRC
	MOVEM	D,SAVREL		;SALT AWAY THE RELOCATION TOO
	SKPCM				;DO WE HAVE A COMMA?
	JRST	AERROR			;NO,THIS IS AN ERROR
	SETZM	BARFLG			;SET UP FLAG FOR /AFTER
	AOS	BARFLG			;TYPE INSERT TO FAKE OUT SETPT
	PUSHJ	P,SETPT			;SET UP FOR PATCHING
	PUSH	P,CPADDR		;SAVE LOCATION OLD INST. PLACED IN
	HRRZ	A,TB$DAT(T1)		;LOAD CURRENT ADDRESS
	MOVEM	A,CPADDR		;FOR . (DOT) OPERATOR
	TXZ	F,REGET			;DONT REGET THE COMMA
	BYPASS				;LOAD FIRST CHARACTER
	CAIE	CC,74			;START WITH LEFT ANGLE BRACKET?
	JRST	QERROR			;NO
	TXO	F,REGET			;LET IT HAPPEN AGAIN
	PUSHJ	P,CELL			;EAT THE CELL
	CAIE	CC,76			;END WITH RIGHT ANGLE BRACKET?
	JRST	QERROR			;NO
	POP	P,CPADDR		;RESTORE LAST GENNED ADDRESS
	HRRZ	T3,TB$DAT(T1)		;GET THE LOCATION TO PATCH INTO
	TXO	T3,IS.GEN		;FLAG THAT WORD EXISTS
	HRRZ	T2,C			;GET RH OF SYMFIX
	JUMPE	T2,ALT2			;IF 0, DONT DO ANY FIXUP
	IORB	T3,1(T2)		;ELSE STORE ADDRESS
	TXNE	T3,IS.MWS		;ILLEGAL TO HAVE STRING OR BLOCK HERE
	JRST	[$KILL(ILS,Illegal use of long string or BLOCK in .ALTER,,$MORE)
		 JRST MCCOMM]
ALT2:	HRRZ	T3,TB$DAT(T1)		;GET THE LOCATION TO PATCH INTO
	HLRZ	T2,C			;GET LH OF SYMFIX
	JUMPE	T2,ALT3			;IF 0, NO LH FIXUP
	TXO	T3,IS.LH!IS.GEN		;STORE THAT ITS A LH FIXUP
	IORB	T3,1(T2)		;REMEMBER IT IN IST
	TXNE	T3,IS.MWS		;CATCH ILLEGAL MULT-WORD STRING
	JRST	E$$ILS			;
ALT3:	TDNE	B,[^-<1,,1>]		;FLAG IMPROPER RELOCATION
	JRST	RERROR
	HLRZ	D,B			;CONVERT XWD RELOC TO BITS 35,35
	LSH	D,1			;..
	ORI	D,(B)			;RESULT INTO D
	PUSH	P,A			;SAVE VALUE OF EXPRESSION
	MOVEI	A,0(T3)			;GET ADDRESS TO CHANGE
	PUSH	P,D			;SAVE RELOCATION AWAY
	PUSHJ	P,WRDSRC		;WRDSRC FOR RELOCATION
	  $STPCD(ALTER LOST ITS POINTERS)
	POP	P,D			;RESTORE RELOCATION
	POP	P,0(C)			;AND STORE NEW VALUE INTO WORD
	PUSHJ	P,CHGREL		;SET DOWN NEW RELOCATION
	BYPASS				;EAT CHARACTERS
	SKPNCM				;IS IT A COMMA?
	PUSHJ	P,ORGCOD		;YES,GO COMPARE CODE
	HRRZ	A,TB$DAT(T1)		;SET UP FOR (FROM) LOCATION
	HLRZ	B,TB$PAT(T1)		;SET UP THE (TO)
	PUSHJ	P,GFIXUP		;AND DO THE GLOBAL CHAIN FIXUPS
	ADDI	T1,PCO4SZ		;GET PCOSIZE
	MOVEM	T1,TRCVAP		;STORE IT AWAY
	PUSHJ	P,PMLIT			;GENERATE ANY LITERALS NEEDED
	PUSHJ	P,PMDEF			;ALSO ANY DEFINITIONS
	PUSHJ	P,PMEXT			;DO ANY EXTERNAL FIXUPS
	PUSHJ	P,PMLOC			;AND ANY LOCAL ONES
	PUSHJ	P,.POP4T##		;RESTORE THE TEMPS
	JRST	MECELL			;CURRENT CHARACTER ENDS CELL
; /FP.ENE/ - THIS ROUTINE PROCESSES THE ENE OF THE PATCH. ALL PATCHES
;		START WITH THE FIX-PSEUDO-OP ".EDIT" AND END WITH THE
;		FIX-PSEUDO-OP ".ENDE".
;		FLAG "IAE" IS CLEARED TO INDICATE THAT
;		WE ARE NOT IN AN EDIT. IT ALSO CHECKS FOR
;		UNDEFINED SYMBOLS AND PRINTS AN ERROR MS. IF ANY EXIST.


FP.ENE:	MOVE	N,CUREDT		;IN CASE OF ERROR
	TXZN	F,IAE			;ARE WE IN AN EDIT
	JRST	E$$EPM			;NO,ERROR
	TXZE	F,IAI			;WERE NOT IN INSERT WERE WE?
	$KILL(EEI,.ENDE seen before .ENDI in edit,N$SIX)
	PUSHJ	P,UDFCHK		;CHECK FOR UNDEFINED LABELS
	JRST	MECELL			;END OF CELL
IFE DEBUG,<XLIST>		;IF NOT DEBUGGING, CANT TEST
IFN DEBUG, <

; /FP.TST/ - INTERNAL CHECKING ROUTINE
; THIS ROUTINE IS AN INTERNAL TESTING PACKAGE FOR SOME OF THE BPT
; ROUTINES. TO USE IT, THE FOLLOWING SHOULD BE DONE.
;	FOO.REL=MAKLIB.REL,TTY:/FIX		;COMMAND TO MAKLIB
;	.EDIT XXXXX				;SOME SORT OF EDIT
;	.MODULE MAKLIB				;USE CURRENT REL FILE
;	.MKLTST					;START TESTS
;
; NOTE: DO NOT PATCH BEFORE OR AFTER TEST PACKAGE IS RUN BECAUSE
;	ASSUMPTIONS ARE MADE AND TABLES CHANGED BY THIS ROUTINE.
;
;

	DEFINE $TSTFAI, <JSP N,TELERR>	;REPORT TEST FAILURE
	DEFINE $TSTDON,<
	PUSHJ	P,TELDON
 >
	DEFINE $TSTLBL($A)<TST.'$A:>

	DEFINE 	$TSTGO($A),<
	.ZZZ=.ZZZ+1
	$TSTLBL(\.ZZZ)
	MOVEI	N,[ASCIZ "$A"]
	MOVEM	N,DEBROU
	PUSHJ	P,TELGO  
>
	.ZZZ==0

FP.TST:	PUSHJ	P,.PSH4T##		;SAVE T1-T4
	MOVE	A,[SIXBIT /MAKLIB/]	;MAKE SURE THEY SET US UP
	CAME	A,CURMOD		;BY READING IN MODULE MAKLIB
	  $KILL(TNI,<Tests not initialized, load MAKLIB>)
	$TELL (ITC,MAKLIB internal tests commencing...)
	SETZM	DEBFAI			;0 FAILURES SO FAR

	$TSTGO(CODE INSERT)
	MOVE	A,SEB+2			;GET A PROGRAM BREAK
	MOVEI	B,PATMAX		;AND A LIMIT

TST4:	PUSH	P,A			;SAVE ACS
	PUSH	P,B
	MOVEI	B,1			;RELOC
	MOVEM	A,CPADDR
	SETOM	CPSFLG
	MOVE	C,[JFCL 17,17]		;UNLIKELY CODE FOR LATER TEST
	PUSHJ	P,NEWCODE		;INSERT IT
	  $TSTFAI			;FAILURE
	POP	P,B			;RESTORE ACS
	POP	P,A			;
	SOSE	B			;DONE?
	AOJA	A,TST4			;NO
	AOS	A
	PUSHJ	P,NEWCOD		;TEST THAT IT CATCHES OVERFLOW
	 CAIA
	$TSTFAI
	$TSTDON

	$TSTGO(SYMBOL INSERT)
	MOVE	A,SEB+2			;GET A STARTING ADDRESS
	MOVEI	B,CREMAX		;AND LIMIT

TST5:	PUSH	P,A			;SAVE ACS
	PUSH	P,B			;
	MOVE	R,[RADIX50 0,..S000]	;MAKE BASE OF SYMBOL
	ADD	R,A			;UPDATE IT
	SUB	R,SEB+2			;TO BE ..S<ADR>

	MOVEI	B,1			;RELOCATION IS 01(2) I.E. RH
	PUSHJ	P,NEWSYM		;DO IT
	  $TSTFAI			;REPORT FAILURE
	POP	P,B
	POP	P,A
	SOSE	B
	AOJA	A,TST5			;IF MORE TO DO
	AOJ	A,
	MOVEI	B,1			;RELOCATED IN RH ONLY
	PUSHJ	P,NEWSYM		;SEE IF WE OVERFLOWED
		CAIA
	  $TSTFAI			;SHOULD CATCH IT
	$TSTDON

	$TSTGO(INTEGRATED LOOK/SEARCH/MAP)
	MOVE	R,[SIXBIT /..S000/]	;LOOKUP A NEW SYMBOL
	PUSHJ	P,SYMSRC		;LOOK IT UP
	  $TSTFAI			;REPORT FAILURE
	CAIE	B,10			;SEE IF LOCAL SYMBOL
	  $TSTFAI
	CAIE	D,1			;MAKE SURE RELOC IS RIGHT
	  $TSTFAI
	CAME	A,SEB+2			;SEE IF THE SAME
	  $TSTFAI			;NOT RIGHT VALUE
	PUSHJ	P,WRDSRC		;NOW GET THE NEW WORD
	   $TSTFAI			;HAS TO BE THERE,WE PUT IT THERE
	MOVE	A,[JFCL 17,17]		;SEE IF THE RIGHT WORD IS THERE
	CAME	A,0(C)			;IN THE SPECIFIED PLACE
	  $TSTFAI			;IF WHAT IS THERE IS NOT WHAT WE PUT THERE
	$TSTDON

	$TSTGO(SYMBOL SEARCH)
	MOVE	D,.JBSYM##		;GET SYMBOL TABLE ADDRESS
TSTA:	MOVE	A,(D)			;FIND MAKLIB
	CAMN	A,[RADIX50 0,MAKLIB]	;SEARCH FOR HEADER
	JRST	TSTB			;IF FOUND
	AOBJN	D,TSTA
	$WARN(NST,Cannot find MAKLIB symbol table,,$MORE)
X$$NST:	JRST	TST99			;ABORT TESTS


TSTB:	HLRE	B,1(D)			;GET NEG LENGTH INTO B
	ADD	D,B			;D IS START ADDRESS OF MAKLIB S.T.
	HRL	D,B			;D IS AOBJN PTR NOW
	ADD	D,[2,,2]		;ADJUST POINTER
TST1:	MOVE	R,(D)			;LOAD A SYMBOL NAME
	PUSH	P,D			;SAVE D
	TLZ	R,740000		;MASK OFF BITS
	PUSHJ	P,SYMSRA		;SEARCH FOR IT
	  $TSTFAI
	POP	P,D			;RESTORE D
	ADD	D,[2,,2]		;ADD FOR PAIR
	JUMPL	D,TST1
	MOVE	R,[RADIX50 0,$....$]	;MAKE SURE IT CAN FAIL
	PUSHJ	P,SYMSRA		;WHEN IT SHOULD
	  CAIA				;I.E. SYMBOL ISN'T THERE
	$TSTFAI				;FAILURE MESSAGE
	$TSTDON

	$TSTGO(WORD SEARCH & MAP)
	HRRZ	A,.JBSA##		;GET STARTING ADDRESS
TST3A:
	PUSHJ	P,WRDSRC		;LOOK IT UP IN REL FILE
	  $TSTFAI
	AOS	A			;UPDATE A
	CAIG	A,DHISIZ		;TOO BIG?
	JRST TST3A			;NO
	MOVEI	A,377777		;MAKE SURE IT FAILS WHEN IT SHOULD
	PUSHJ	P,WRDSRC		;LOOK IT UP
	 CAIA
	$TSTFAI
	$TSTDON

	$TSTGO(GLOBAL REFERENCE SEARCH)
	MOVE	R,[SIXBIT/TST6X/]	;MAP WORD IN REL FILE FIRST
	PUSHJ	P,SYMSRC		;LOOK IT UP
	 $TSTFAI
	PUSHJ	P,WRDSRC		;MAP IT
	  $TSTFAI
	PUSH	P,A			;SAVE A
	JRST	TST6B			;SKIP OVER TEST DATA

TST6X:	707070,,.TCRLF##		;XWD UNLIKELY CODE,REFERENCE
TST6B:	SETZB	R,T1
	PUSHJ	P,FGREF			;HUNT THRU CHAIN WITHOUT
					;KNOWING SYMBOL NAME
	  $TSTFAI
	CAME	R,[RADIX50 0,.TCRLF]	;CORRECT SYMBOL FOUND?
	$TSTFAI
	HRRZ	A,0(C)			;GET POINTER FROM RESULT
	PUSHJ	P,WRDSRC		;MAP IT INTO REL FILE
	  $TSTFAI
	HLRZ	A,0(C)			;
	CAIE	A,707070		;FOUND RIGHT WORD?
	$TSTFAI				;NO,CONTENTS OF WORD ARE WRONG
	MOVE R,[SIXBIT/.TCRLF/]		;KNOW REPEAT,WITH SYMBOL KNOWN
	MOVE A,0(P)
	PUSHJ	P,FGREF			;HUNT THRU CHAIN 
					;KNOWING SYMBOL NAME
	  $TSTFAI			;IF NOT FOUND
	CAME	R,[SIXBIT ".TCRLF"]	;CORRECT SYMBOL FOUND?
	$TSTFAI				;FOUND REFERENCE,BUT NOT RIGHT ONE
	HRRZ	A,0(C)			;GET POINTER FROM RESULT
	PUSHJ	P,WRDSRC		;MAP IT INTO REL FILE
	  $TSTFAI			;MAPPING FAILED
	HLRZ	A,0(C)			;
	CAIE	A,707070		;FOUND RIGHT WORD?
	$TSTFAI				;MAPPED WRONG WORD
	MOVE	R,[SIXBIT/$....$/]	;LOOK FOR NON-EX SYMBOL
	POP	P,A			;WITH RIGHT ADDRESS
	PUSHJ	P,FGREF			;SHOULD FAIL
	 SKIPA
	$TSTFAI				;FOUND NON-EX REFERENCE SYMBOL
	MOVE	R,[SIXBIT/.TCRLF/]	;LOOK FOR RIGHT SYMBOL
	MOVEI	A,2			;WITH WRONG ADDRESS
	PUSHJ	P,FGREF			;SHOULD FAIL
	 SKIPA
	$TSTFAI				;FOUND NON-EX REFERENCE CHAIN
	$TSTDON


	$TSTGO(IST MANIPULATION)

	PUSHJ	P,ISTINI		;START WITH FRESH IST
	MOVEI	A,ISTMAX		;NUMBER OF IST ENTRIES
	MOVEI	C,IST			;SHOULD BE FIRST ALLOCATED
TST7:	PUSH	P,A			;DONT ASSUME COUNT SAVED
	MOVE	T1,C			;SEE IF WE THINK ITS ALREADY VALID
	PUSHJ	P,ISTVAL		;WHICH IS AN ERROR
	  CAIA				;OK, CAUSE WE THINK ITS FREE
	$TSTFAI				;REPORT FAILURE
	PUSHJ	P,ISTGET		;RETURN IN C THE ADDRESS OF IST PAIR
	CAME	T1,C			;DID WE GET THE ONE WE EXPECT?
	$TSTFAI				;NO,NEXT IN ORDER NOT ALLOCATED!
	PUSHJ	P,ISTVAL		;NOW SEE IF ITS VALID.
	  $TSTFAI			;NO, AND IT SHOULD HAVE BEEN.
	ADDI	C,2			;UPDATE ADDRESS
	POP	P,A			;RESTORE COUNT
	SOJG	A,TST7			;IF MORE TO DO,TRY AGAIN
	MOVE	A,[^-<1B1>]		;FORCE DEALLOCATION OF 2ND PAIR ON
	MOVEM	A,ISTMAP		;BY ZEROING 2ND BIT IN MAP
	MOVEI	T1,IST+2		;THIS WILL BE PAIR ALLOCATED
	PUSHJ	P,ISTVAL		;NOT VALID RIGHT NOW,RIGHT?
	  CAIA
	$TSTFAI				;OH, OH, WELL REPORT ERROR
	PUSHJ	P,ISTSAV		;FORCE SAVE OF MAP
	PUSHJ	P,ISTGET		;NOW ALLOCATE
	CAIE	C,IST+2			;GOT RIGHT PAIR?
	$TSTFAI				;NO,SO SOMETHING IS WRONG
	PUSHJ	P,ISTVAL		;NOW IT IS VALID,OR SHOULD BE
	  $TSTFAI			;
	PUSHJ	P,ISTRST		;RESTORE MAP
	PUSHJ	P,ISTVAL		;NOW IT SHOULD NOT BE VALID
	  CAIA
	$TSTFAI				;BECAUSE WE DID <SAVE><GET><RESTORE>
					;SEQUENCE.
	$TSTDON				;THATS OVER WITH

	$TSTGO(OPCODE SEARCH)
	MOVSI	B,-OPNSIZ		;TEST OF TABLE FOR OPERATORS
	MOVE	C,[POINT 9,OPC]	;POINTER TO CODE TABLE
	MOVE	D,[POINT 18,OPH]	;POINTER TO AUX CODE  TABLE
	
TST7A:	MOVE	R,OPN(B)		;LOAD AN OPERATOR NAME
	PUSH	P,B			;SAVE INDEX
	PUSH	P,C			;AND POINTER
	PUSH	P,D			;AND POINTER
	PUSHJ	P,OPSRC			;LOOK IT UP
	  $TSTFAI
	POP	P,D			;RESTORE D
	POP	P,C			;RESTORE C
	POP	P,B			;RESTORE B
	ILDB	T4,C			;GET OPERATOR
	LSH	T4,^D27			;PUT IT INTO POSITION
	TLC	T4,700000		;
	TLCE	T4,700000
	JRST	TST77			;HANDLE HALFWORD STUFF DIFFERENTLY
	ILDB	T4,D			; GET IT
	HRLZS	T4
TST77:	CAME	T4,A			;
	$TSTFAI				;FOUND,BUT INCORRECT CODE FOUND
	AOBJN	B,TST7A			;SEE IF MORE TO DO
	SETZ	R,			;MAKE SURE IT CAN FAIL
	PUSHJ	P,OPSRC			;WHEN IT SHOULD
	 CAIA
	$TSTFAI				;FOUND NON-EXISTENT OP
	$TSTDON

	$TSTGO(MACRO CODE EVALUATION)		;CURSORY MACRO EVALUATION TEST

	MOVEI	B,400000		;USE 400000 AS "."
	MOVEM	B,CPADDR
	MOVSI	B,-TST8CL		;NUMBER OF LINES TO DEBUG
	
TST8A:	TXO	F,DEBMOD!DEBIMC		;TRAP ANY ERRORS,USE INTERNAL CODE
	MOVE	C,[POINT 7,MACBUF]	;LOAD MACRO BUFFER
	MOVEM	C,MACPTR		;POINTER
	SETZM	MACCNT			;AND CLEAR CHARACTER COUNTER
	HRLI	D,(POINT 7,)		;SET UP INPUT POINTER
	HRR	D,TST8C(B)
TST8B:	ILDB	A,D			;GET A BYTE
	AOS	MACCNT			;UPDATE COUNTER
	IDPB	A,C			;STORE BYTE
	CAIE	A,.CHLFD		;END OF STRING?
	JRST	TST8B			;NO,GET NEXT BYTE
	PUSHJ	P,ISTINI		;NO IST YET
	PUSH	P,B			;SAVE INDEX ACROSS CALL
	PUSHJ	P,EVAL			;CALL EVALUATOR
	POP	P,B			;RESTORE POINTER
	MOVE	C,R%V			;CHECK VALUE
	CAME	C,TST8V(B)		;A MATCH?
	$TSTFAI				;NO,REPORT FAILURE
	MOVE	C,R%R			;AND RELOCATION
	CAME	C,TST8R(B)		;CHECK MATCH HERE TOO
	$TSTFAI				;IF FAILS, REPORT IT
	SKIPE	R%S			;MAKE SURE IST NOT INVOLVED
	$TSTFAI				;ANOTHER FAILURE
	AOBJN	B,TST8A			;BACK FOR NEXT
	TXZ	F,DEBMOD!DEBIMC!REGET	;CLEAR FLAGS
	JRST	TST8X			;DONE WITH TEST
	IFE PURESW, <$RELOC==140>	;RELOCATION IF 1 SEGMENT
	IFN PURESW, <$RELOC==10>	;RELOCATION IF NORMAL 2 SEGMENT

; MACRO ENTRY HAS FORM, CODE TO READ,CODE TO MATCH, RELOC TO MATCH
	DEFINE TST8M,<

	IFE BIGLST, <XLIST>

X <12345>,<12345>,0	;;SIMPLE NUMBER
X <<   >>,0,0		;;NULL EXPRESSION
X < IFN F,<3>+IFE F,<4>>,4,0	;;CONDITIONAL
X <MAKLIB>,<MAKLIB-$RELOC>,1	;;SIMPLE SYMBOL
X <1+2*2!1-<1!2*2+1>>, <1+2*2!1-<1!2*2+1>>,0	;;CHECK PRECEDENCE
X <1.1>,<1.1>,0		;;CHECK FLOATING POINT
X <^L<1>>, <^L<1>>,0	;;JFFO OP
X < ^-<1B1>>,  <^-<1B1> >,0	;;COMPLEMENT
X <<SIXBIT "123"+ '456'>>, <'123456'>,0	;;SIXBIT
X <<ASCII "123Ab">>,<<ASCII "123Ab">>,0	;;ASCII
X <<IOWD PD$LEN,1000>>, << <-PD$LEN>B17+777>>,0  ;;IOWD
X <<RADIX50 4,MAKLIB>>,<<RADIX50 4,MAKLIB>>,0	;;RADIX50
X <<POINT 10,FP.TST,^O10>>,<<POINT 10,FP.TST-$RELOC,^O10>>,1 ;;POINT OP
X   <<99.99E<1>>>,  <<99.99E1>>,0	;;EXPONENT
X   <<1^!2>>,  <3>,0	;;XOR
X   <<EXP <1+3>>>,  4,0
X	<<BYTE (6)33(12)-1(9)5,5>>,<<337777005005>>,0
X	<<DEC 10>>,12,0
X	<<OCT 10>>,10,0
X	<<CONSO>>,<<CONSO>>,0
X	<<DATAI 1,>>,<<DATAI 1,>>,0
	LIST
> ; END OF TST8M DEFINITION

	DEFINE X ($A,$B,$C)<  [ASCIZ \ $A
 \]>
TST8C:	TST8M
	TST8CL==.-TST8C
	DEFINE X($A,$B,$C) <  EXP <$B>   >
TST8V:	TST8M
	DEFINE X ($A,$B,$C) <  EXP  <$C>   >
TST8R:	TST8M
TST8X:	$TSTDON

					;HERE WHEN ALL TESTS DONE
TST99:	MOVE	N,DEBFAI		;GET NUMBER OF FAILURES
	$TELL(ITF,Internal tests finished. Failures:,N$DEC)
	PUSHJ	P,.POP4T##		;RESTORE T1-T4
	JRST	MECELL			;MUST END CELL

TELERR:	AOS	DEBFAI			;UPDATE NUMBER OF FAILURES
	MOVEI	N,-1(N)			;GET PC OF ERROR CALL
	PUSH	P,N			;SAVE IT
	MOVE	N,DEBROU		;GET ERROR ROUTINE NAME
	$WARN(TED,Test error detected in,N$STRG,$MORE)
	MOVEI	T1,[ASCIZ " routine. PC = "]
	PUSHJ	P,.TSTRG##		;
	MOVE	T1,0(P)			;GET ADDRESS
	PUSHJ	P,OUTHW			;AND PRINT IT
X$$TED:	PUSHJ	P,.TCRLF##		;END WARNING
	JRST	CPOPJ1			;RETURN

TELGO:
X$$EIT:	$TELL(STO,Starting test of,N$STRG,$MORE)
	MOVEI	T1,[ASCIZ " routine"]
	PUSHJ	P,.TSTRG##
X$$SIT:
	MOVEI	T1,[ASCIZ "]
"]
	PUSHJ	P,.TSTRG##
	POPJ	P,			;REPORT AND RETURN

TELDON:	$TELL(EOT,End of test)
	POPJ    P,

> ; NFI DEBUG
	IFE DEBUG,<LIST>		;RESUME LISTING
IFN DEBUG, <					;ONLY IF DEBUGGING

; /FP.DME/ - ROUTINE TO HELP DEBUG MACRO EVALUATOR
;
; TO USE, INCLUDE PSEUDO-OP  ".DMON" IN FIX FILE.
; INSTEAD OF GENERATING CODE, CODE IS EVALUATED AND THE RESULT PRINTED
; OUT. ALSO, THE MACRO CODE ERRORS, USUALLY FATAL, ARE RETURNED WITHOUT
; ABORTING THE RUN.
; TO GET OUT OF THIS MODE, US THE PSEUDO-OP ".DMOFF" IN THE FIX FILE.
;

FP.DME: FP.DMN:
	TXO	F,DEBMOD			;PUT IT INTO DEBUG MODE
	JRST	MECELL				;END OF CELL

FP.DMF:	TXZ	F,DEBMOD			;NO MORE DEBUG MODE
	JRST	MECELL				;END OF CELL


; /.GODDT/ - THIS PSEUDO-OP CAUSES MAKLIB TO ENTER DDT
;	IF IT IS LOADED.  TO EXIT FROM DDT, USE THE
;	COMMAND "CONTIN$X".
;
	OPDEF   CONTIN [JRST  .GODD1]

.GODDT:	SKIPN	T,.JBDDT##			;SEE IF DDT LOADED
	JRST	MECELL				;NO,SO FORGET IT
	PUSHJ	P,.PSH4T##			;SAVE ACS
	$TELL(DDT,Entering DDT)
	JRST	0(T)				;GO TO DDT
.GODD1:	PUSHJ	P,.POP4T##			;RESTORE T1-4
	JRST	MECELL				;MUST BE STANDING ALONE

 >  ; NFI DEBUG
SUBTTL UTILITY ROUTINES FOR THE MACRO STATEMENT EVALUATOR
; /PSHOPR/ - ROUTINE TO PUSH ACS A,B,C,D ONTO THE OPERAND STACK
; /POPOPR/ - COMPLIMENTARY POP ROUTINE
; 	BOTH ROUTINES USE STACK "OPRSTK" AND TRAP PDL OVER AND
;	UNDERFLOW.
;

PSHOPR:	EXCH	T,OPRPTR		;SAVE T,GET POINTER
	CAILE	T,OPRSIZ-3		;4 LOCATIONS LEFT?
	JRST	ETCERR			;EXPRESSION TOO COMPLEX
	MOVEM	A,OPRSTK(T)		;STORE A-D
	MOVEM	B,OPRSTK+1(T)		;
	MOVEM	C,OPRSTK+2(T)		;
	MOVEM	D,OPRSTK+3(T)
	ADDI	T,4			;UPDATE AND
	EXCH	T,OPRPTR		;STORE
	POPJ	P,			;RETURN

POPOPR:	EXCH	T,OPRPTR		;GET POINTER
	SUBI	T,4			;GET BOTTOM OF POP
	CAMGE	T,OPRTOP		;UNDERFLOW INTO NEXT FRAME?
	 $STPCD(Expression stack underflowed)
	MOVE	A,OPRSTK(T)		;LOAD A-D
	MOVE	B,OPRSTK+1(T)		;FROM STOREAGE
	MOVE	C,OPRSTK+2(T)		;
	MOVE	D,OPRSTK+3(T)
	EXCH	T,OPRPTR		;STORE THE UPDATED POINTER
	POPJ	P,			;AND TAKE RETURN
; /PSHOPT/- ROUTINE TO PUSH OPERATOR INDEX IN AC T ONTO STACK
; /POPOPT/- COMPLIMENTARY POP ROUTINE
;

PSHOPT:	EXCH	D,OPTPTR		;GET POINTER
	CAILE	D,OPTSIZ		;ROOM LEFT?
	JRST	ETCERR			;EXPRESSION TO COMPLEX ERROR
	MOVEM	T,OPTSTK(D)		;
	EXCH	D,OPTPTR		;REPLACE POINTER
	AOS	OPTPTR			;UPDATE POINTER
	POPJ	P,			;RETURN

POPOPT:	EXCH	D,OPTPTR		;GET POINTER
	SOS	D			;
	CAMGE	D,OPTTOP		;UNDERFLOW?
	 $STPCD(Expression stack undeflowed)
	MOVE	T,OPTSTK(D)		;DO IT
	EXCH	D,OPTPTR		;RESTORE
	POPJ	P,			;RETURN
; /ASGEVL/ - ROUTINE TO EVALUATE OPS AFTER "SYMBOL="
;
; THIS ROUTINE STORES THE SYMBOL AND FLGS FOR THE CASE OF:
;	SYMBOL='????' WHERE '????' IS ONE OF:
;	  =,   =:,    :,  !  ,  :!
;
; INPUTS-  AC A IS SIXBIT SYMBOL NAME
;	  
; OUTPUTS- ASGSYM IS SET UP AS FLAGS IN BITS 0-3+<RADIX50 SYMBOL>
;

ASGEVL:	MOVE	R,A			;GET SYMBOL NAME
	PUSHJ	P,RAD50			;CONVERT TO RADIX50
	TXO	R,R5.LCL		;START AS LOCAL SYMBOL
	PUSHJ	P,MIC			;GET CHARACTER AFTER FIRST =
	CAIN	CC,"="			;IS IT ANOTHER = (NODDT)?
	JRST	[TXO R,R5.DDT		;YES,SUPRESS IT
		 PUSHJ P,MIC		;AND EAT THE CHARACTER
		 JRST .+1]		;
ASGEV1:	CAIN	CC,"!"			;IS IT "!" (ALSO SUPRESS)
	JRST	[TXOE R,R5.DDT		;YES,SUPRESS IT
		 JRST QERROR		;IF ALREADY ON
		 PUSHJ P,MIC		;EAT THE CHARACTER
		 JRST .+1]		;CONTINUE
	CAIN	CC,":"			;IS IT COLON?
	JRST	[TXOE R,R5.GLB		;YES,FLAG AS AVAILABLE
		 JRST QERROR		;TO OTHERS, IF NOT ALREADY
		 TXZ  R,R5.LCL		;IF GLOBAL,ITS NOT LOCAL
		 PUSHJ P,MIC		;EAT IT
		 JRST ASGEV1]		;HANDLE CASE OF "=:!"
	MOVEM	R,ASGSYM		;STORE FLAGS+SYMBOL
	TXO	F,REGET			;REGET CHARACTER
	POPJ	P,			;RETURN TO CALLER
; /ASGMAK/ - ROUTINE TO MAKE THE ACTUAL ASSIGNMENT OF 'SYMBOL==EXPRESSION'
; THIS ROUTINE ASSIGNS THE VALUE OF THE CURRENT STATEMENT TO THE
; SYMBOL IN LOCATION "ASGSYM" . IN ADDITION, IT SETS THE NULL
; STATMENT FLAG IF THIS WAS A PRIMARY STATEMENT, SINCE IN THAT
; CASE WE DO NOT WISH TO GENERATE ANY CODE.
;

ASGMAK:	MOVE	R,ASGSYM		;GET SYMBOL NAME
	TLZ	R,740000		;CLEAR NON-SYMBOL BITS
	TXNE	F,IAE			;INSIDE EDIT AND
	TXNE	F,FSTMOD		;IS THERE A MODULE SELECTED?
	JRST	ASGWNM			;YES,THATS A MISTAKE
	PUSHJ	P,SYMSRA		;LOOK IT UP IN RADIX50
	 CAIA				;DONT ALLOW RE-DEFINES
	JRST	MERRO1			;
	JUMPN	%S,ASGERR		;OR FORWARD AND/OR EXT REFERENCES
	MOVE	R,ASGSYM		;RESET AS SYMBOL+FLAGS
	TDNE	%R,[^-<1,,1>]		;MAKE SURE RELOCATION IS OK
	JRST	RERROR			;ELSE FLAG ERROR
	MOVE	A,%V			;PICK UP THE VALUE
	HRRZ	B,%R			;AND RELOCATION
	TLNE	%R,1			;CONVERT TO RIGHT FORMAT
	TRO	B,1B34			;FOR NEWSYM
	PUSHJ	P,NEWSYM		;REGISTER THE SYMBOL
	  JRST	STOERR			;IF NO ROOM, BOMB OUT
	TXNN	%F,S.NPS		;SKIP IF NOT PRIMARY
ASGMA1:	SETOM	NULFLG			;DISCARD CODE
	PUSHJ	P,PMLOC			;TRY TO REDUCE SIZE OF IST
	POPJ	P,			;RETURN

ASGERR:	MOVE	N,R			;GET SYMBOL
$KILL(ASG,FORWARD/EXTERNAL assignment to,N$50,$MORE)
	JRST MCCOMM

ASGWNM:	MOVE N,R
	$WARN(AMI,Assignment to,N$50,$MORE)
	MOVEI	T1,[ASCIZ " with no module selected was ignored:
"]
	PUSHJ	P,.TSTRG##
	PUSHJ	P,TYPTB1
	MOVEI	T1,MACBUF
	PUSHJ	P,.TSTRG##
	SKIPA
X$$AMI:	PUSHJ	P,.TCRLF##
	TXZ	F,FOTTY
	JRST	ASGMA1
; /FINLIN/ - ROUTINE TO FINISH UP THE LINE WHENEVER A COMMENT IS SEEN
; USED TO KEEP NSTLVL UP TO DATE AND TO GET TO $EOL
;

FINLIN:	PUSHJ	P,MIC			;GET A CHARACTER
	CAIN	CC,$EOL			;IS IT END OF LINE?
	POPJ	P,			;YES, RETURN
	CAIE	CC,RABRKT		;IS IT A RIGHT ANGLE BRACKET?
	JRST	FINLIN			;NO, TRY NEXT CHARACTER
	SKIPE	NSTLVL			;IF COUNT IS NON-ZERO,
	SOS	NSTLVL			;DECREMENT IT
	JRST	FINLIN			;AND TRY NEXT CHARACTER
; /MACSRC/ - ROUTINE TO SEARCH ALL THE BUILT IN CODES FOR MACRO-10
;
; INPUTS-  AC R SHOULD CONTAIN A SIXBIT SYMBOL
;
; OUTPUTS- AC A WILL CONTAIN THE PROPERLY SET UP MACRO-10 INSTRUCTION
;	   AC B & AC C WILL CONTAIN 0
;	   AC D WILL CONTAIN THE APPROPRIATE FLAGS INDICATING WHAT
;		TYPE OF CELL IS BEING RETURNED.
;		SHOULD BE ONE OF:  C.OP,  C.POP
;
; RETURNS:   CPOPJ=NO MATCH AT ALL       CPOPJ1=MATCH FOUND SOMEPLACE
;
; ORDER OF SEARCH IS:  MACHINE OPS,CALLIS,TTCALLS,MTAPES,PSEUDO-OPS
;

MACSRC:	PUSHJ	P,OPSRC			;FIRST LOOK AT MACHINE CODES
	  CAIA				;NOT THERE
	JRST	MACSR9			;A MATCH!

	MOVE	A,[XWD -CALNTH,CALTBL]	;LOOK AT CALLI TABLE NOW
MACSR1:	CAMN	R,0(A)			;CHECK FOR MATCH
	JRST	[ SUBI  A,CALLI0	;ADJUST CODE
		  HRLI  A,(CALLI)	;SET INSTR. PART
		  JRST  MACSR9]		;END IT
	AOBJN	A,MACSR1		;LOOP BACK FOR MORE

	MOVSI	A,-TTCLTH		;NOW TRY THE TTCALLS
MACSR2:	CAMN	R,TTCTBL(A)		;A MATCH?
	JRST	[ LSH A,5		;YES,SET UP IN AC FIELD
		  ANDI A,(Z 17,)	;CLEAR OUT THE JUNK
		  HRLZI A,<(TTCALL)>(A)	;
		  JRST MACSR9 ]		;FINISH AS USUAL
	AOBJN	A,MACSR2		;IF MORE TTCALLS LEFT

	MOVSI	A,-MTALTH		;NOW THE MTAPE CODES
	MOVE	B,[POINT 9,MTACOD]	;POINTER TO CODES USED
MACSR3:	ILDB	C,B			;GET BITS FOR THIS CODE
	CAMN	R,MTATBL(A)		;LOOK UP IN TABLE
	JRST	[ MOVSI A,(MTAPE)	;UUO CODE
		  HRRI  A,(C)		;AND PARTICULAR FUNCTION CODE
		  JRST MACSR9]		;END IT
	AOBJN	A,MACSR3

	MOVSI	B,-POPLTH


	;DEFINE BITS FOR PSEUDO-OP CHARACTERISTIC FLAGS
	$1BIT==1B17			;LEAVE RH FREE FOR ADDRESS
	
	BIT($INP)	;THIS PSEUDO-OP NOT DEFINED OUTSIDE OF PRIMARY STATEMENT
	BIT($III)	;THIS PSEUDO-OP ILLEGAL INSIDE OF .INSERT
	BIT($COF)	;BEFORE RETURNING, CLEAR "IN-OP FIELD" FLAG

MACSR4:	MOVE	A,POPDO(B)		;LOAD FLAGS,,ADDRESS OF PROCESSOR
	CAMN	R,POPNAM(B)		;IS IT A MATCH?
	JRST	MCSR4B			;YES,RETURN
MCSR4A:	AOBJN	B,MACSR4		;TEST FOR MORE TRIES LEFT
	
	SETZB	A,B			;CLEAR RESULTS
	SETZB	C,D			;SINCE GARBAGE IN ACS
	POPJ	P,			;NO MATCH RETURN

MCSR4B:	TXNN	A,$INP			;IS IGNORE IF NOT PRIMARY BIT ON?
	JRST	MCSR4C			;NO,SO FORGET THIS
	TXNE	%F,I.OP			;MUST BE IN OPCODE FIELD
	TXNE	%F,S.NPS		;OF PRIMARY STATEMENT
	JRST	MCSR4A			;ELSE IGNORE IT
MCSR4C:	TXNE	A,$III			;IS POP ILLEGAL IN RANGE OF INSERT?
	TXNN	F,IAI			;YES,ARE WE IN THAT?
	CAIA
	JRST	IIIERR			;YES,TRAP IT
	TXNE	A,$COF			;WANT OPCODE FIELD CLEARED?
	TXZ	%F,I.OP			;YES, CLEAR IT
	SKIPA	D,[C.POP]		;A PSEUDO-OP WAS FOUND
MACSR9:	MOVX	D,C.OP			; SOME SORT OF OPCODE OR UUO FOUND
	SETZB	B,C			;CLEAR RELOCATION AND SYMBOL FIXUP
	JRST	CPOPJ1			;TAKE SUCCESSFUL RETURN

IIIERR:	MOVE	N,R			;FOR ERROR MESSAGE
	$KILL(III,Illegal pseudo-op in range of .INSERT: ,N$SIX,$MORE)
	JRST	MCCOMM
; /OPSRC/ - ROUTINE TO LOOKUP THE 9 BIT OPCODE FOR A SYMBOL, IF IT IS AN DEC-10 OPERATOR
;
; INPUTS-  AC R CONTAINS SIXBIT SYMBOL
;
; OUTPUTS- IF SYMBOL IS -10 OPERATOR:
;	   AC A CONTAINS INSTRUCTION CODE IN BITS 0-8
;	   AC B & AC C CONTAIN 0
;	   AC D CONTAINS C.OP FLAG ON,ALL OTHERS OFF
;
; RETURNS:	CPOPJ= SYMBOL NOT AN OPERATOR    CPOPJ1=MATCH FOUND
;


OPSRC:	SETZB	B,D			;START LOCATION OF LIST
	MOVEI	C,OPNSIZ		;AND END OF LIST
OPSRC1:	MOVE	A,B			;GUESS IS (HIGH+LOW)/2
	ADD	A,C			;
	ASH	A,-1			;
	CAMN	A,D			;SAME AS LAST GUESS?
	POPJ	P,			;YES,SO NO MATCH
	MOVEM	A,D			;STORE THIS GUESS INDEX
	CAMLE	R,OPN(A)		;GUESSED TOO LOW?
	JRST	[MOVE B,A		;YES,CORRECT LOW BOUND
		 JRST OPSRC1]		;
	CAME	R,OPN(A)		;A MATCH?
	JRST	[MOVE C,A		;NO,CORRECT UPPER BOUND
		 JRST OPSRC1]		;AND GO AGAIN
	IDIVI	A,4			;FOUR CODES PER WORD OF OPC
	MOVE	A,OPC(A)		;GET CORRECT WORD
	IMULI	B,^D9			;GET OPCODE IN BITS 26-35.
	ROT	A,^D9(B)		;FOR COMPARES ETC.
	ANDI	A,777			;GET RID OF EXTRA STUFF
	CAIGE	A,700			;"FAKE" OPCODE?
	JRST	OPSRC2			;NO, SKIP HALFWORD STUFF
	LSHC	A,-1			;CONVERT TO INDEX, HALF OFFSET
	MOVE	A,OPH-<700/2>(A)	;GET PROPER WORD
	SKIPGE	B			;WAS IT RIGHT HALF?
	MOVSS	A			;YES, REVERSE HALVES
	HLRZ	B,A			;GET THE OPCODE
	CAIL	B,700			;IS THIS AN IO INSTRUCTION?
	TXO	%F,S.IOI		;YES,REMEMBER THAT
	TRZA	A,-1			;CLEAR RIGHT HALF, SKIP SHIFT
OPSRC2:	LSH	A,^D27			;PUT 9 BIT OPCODE INTO PLACE
	SETZB	B,C			;CLEAR RELOC AND FIXUP
	JRST	CPOPJ1			;TAKE GOOD RETURN
; TABLE OF OPCODE NAMES AND THEIR ASSOCIATED VALUES
; EACH ENTRY IN THE  LIST SHOULD CONTAIN THE NAME OF THE
; OPCODE AND ITS ASSOCIATED 9 BIT CODE
; THE ENTRIES MUST BE IN ALPHABETIC ORDER.
;
;
; OPCODES THAT ARE NOT IN BITS 0-8 INCLUSIVE (I.E. IO INSTRUCTIONS AND
; AND PSEUDO-INSTRUCTIONS SHOULD USE THE Y MACRO RATHER THAN
; THE X. THE FIRST ARGUMENT TO Y IS SAME AS X, BUT THE SECOND
; IS A VALUE TO BE PLACE IN LH OF INSTRUCTION. EXAMPLE:
;	Y  HALT,<JRST 4,>
;
;

; THE FOLLOWING HANDWAVING IS USED TO AVOID STORING ALL THE OPCODES
; AND THEIR NAMES AS A MACRO, WHICH WOULD SLOW UP COMPILATION CONSIDERABLY
; INSTEAD, ON PASS1 WE RESERVE SPACE FOR CODES AND NAMES, AND ON
; PASS2 WE ACTUALLY GENERATE CODE IN THE PROPER PLACES.
; THE THREE TABLES GENERATED ARE:
;	OPN- TABLE OF SIXBIT NAMES OF OPCODES
;	OPC- TABLE OF 9 BIT OPCODES
;	OPH- TABLE OF AUX. HALFWORD VALUES
;
	.XCREF				;TOO MESSY TO CREF


IF1,<
	OPNSIZ==0
	OPHSIZ==0
	DEFINE X($A,$B)<
	OPNSIZ==OPNSIZ+1>
	DEFINE Y($A,$B)<
	OPHSIZ==OPHSIZ+1
	X($A,$B)       >
>

IF2,<	NLOC==OPN
	CLOC==OPC
	HLOC==OPH
	..TMP1==-1
	..TMP2==0
	..TMP3==700
	..TMP4==0
	DEFINE X($A,$B)<
	.ORG NLOC
	SIXBIT/$A/
	NLOC==NLOC+1
	.ORG CLOC
	$CODE($B)
	CLOC==.  >
	DEFINE Y($A,$B)<
	.ORG HLOC
	IFE ..TMP3&1,<..TMP4==<$B>>
	IFN ..TMP3&1,< EXP ..TMP4+<<$B>_-^D18>>
	HLOC==.
	X($A,..TMP3)
	..TMP3==..TMP3+1
                       >
>

X	ADD   ,	270
X	ADDB  ,	273
X	ADDI  ,	271
X	ADDM  ,	272

X	AND   ,	404
X	ANDB  ,	407
X	ANDCA ,	410
X	ANDCAB,	413
X	ANDCAI,	411
X	ANDCAM,	412
X	ANDCB ,	440
X	ANDCBB,	443
X	ANDCBI,	441
X	ANDCBM,	442
X	ANDCM ,	420
X	ANDCMB,	423
X	ANDCMI,	421
X	ANDCMM,	422
X	ANDI  ,	405
X	ANDM  ,	406

X	AOBJN ,	253
X	AOBJP ,	252

X	AOJ   ,	340
X	AOJA  ,	344
X	AOJE  ,	342
X	AOJG  ,	347
X	AOJGE ,	345
X	AOJL  ,	341
X	AOJLE ,	343
X	AOJN  ,	346

X	AOS   ,	350
X	AOSA  ,	354
X	AOSE  ,	352
X	AOSG  ,	357
X	AOSGE ,	355
X	AOSL  ,	351
X	AOSLE ,	353
X	AOSN  ,	356
X	ASH   ,	240
X	ASHC  ,	244

Y	BLKI  ,	BLKI
Y	BLKO  ,	BLKO
X	BLT   ,	251


X	CAI   ,	300
X	CAIA  ,	304
X	CAIE  ,	302
X	CAIG  ,	307
X	CAIGE ,	305
X	CAIL  ,	301
X	CAILE ,	303
X	CAIN  ,	306

X	CALL  ,	040
X	CALLI ,	047

X	CAM   ,	310
X	CAMA  ,	314
X	CAME  ,	312
X	CAMG  ,	317
X	CAMGE ,	315
X	CAML  ,	311
X	CAMLE ,	313
X	CAMN  ,	316

X	CLEAR ,	400
X	CLEARB,	403
X	CLEARI,	401
X	CLEARM,	402

X	CLOSE ,	070


Y	CONI  ,	CONI
Y	CONO  ,	CONO
Y	CONSO ,	CONSO
Y	CONSZ ,	CONSZ
Y	DATAI ,	DATAI
Y	DATAO ,	DATAO
X	DFAD  , 110
X	DFDV  , 113
X	DFMP  , 112
X	DFN   ,	131
X	DFSB  , 111

X	DIV   ,	234
X	DIVB  ,	237
X	DIVI  ,	235
X	DIVM  ,	236

X	DMOVE , 120
X	DMOVEM, 124
X	DMOVN , 121
X	DMOVNM, 125
X	DPB   ,	137

X	ENTER ,	077

X	EQV   ,	444
X	EQVB  ,	447
X	EQVI  ,	445
X	EQVM  ,	446

X	EXCH  ,	250

X	FAD   ,	140
X	FADB  ,	143
X	FADL  ,	141
X	FADM  ,	142

X	FADR  ,	144
X	FADRB ,	147
X	FADRI ,	145
X	FADRM ,	146

X	FDV   ,	170
X	FDVB  ,	173
X	FDVL  ,	171
X	FDVM  ,	172

X	FDVR  ,	174
X	FDVRB ,	177
X	FDVRI ,	175
X	FDVRM ,	176
X	FIX   , 122
X	FIXR  , 126
X	FLTR  , 127

X	FMP   ,	160
X	FMPB  ,	163
X	FMPL  ,	161
X	FMPM  ,	162

X	FMPR  ,	164
X	FMPRB ,	167
X	FMPRI ,	165
X	FMPRM ,	166

X	FSB   ,	150
X	FSBB  ,	153
X	FSBL  ,	151
X	FSBM  ,	152

X	FSBR  ,	154
X	FSBRB ,	157
X	FSBRI ,	155
X	FSBRM ,	156

X	FSC   ,	132

X	GETSTS,	062
Y	HALT  ,	HALT
X	HLL   ,	500
X	HLLE  ,	530
X	HLLEI ,	531
X	HLLEM ,	532
X	HLLES ,	533
X	HLLI  ,	501
X	HLLM  ,	502
X	HLLO  ,	520
X	HLLOI ,	521
X	HLLOM ,	522
X	HLLOS ,	523
X	HLLS  ,	503
X	HLLZ  ,	510
X	HLLZI ,	511
X	HLLZM ,	512
X	HLLZS ,	513

X	HLR   ,	544
X	HLRE  ,	574
X	HLREI ,	575
X	HLREM ,	576
X	HLRES ,	577
X	HLRI  ,	545
X	HLRM  ,	546
X	HLRO  ,	564
X	HLROI ,	565
X	HLROM ,	566
X	HLROS ,	567
X	HLRS  ,	547
X	HLRZ  ,	554
X	HLRZI ,	555
X	HLRZM ,	556
X	HLRZS ,	557

X	HRL   ,	504
X	HRLE  ,	534
X	HRLEI ,	535
X	HRLEM ,	536
X	HRLES ,	537
X	HRLI  ,	505
X	HRLM  ,	506
X	HRLO  ,	524
X	HRLOI ,	525
X	HRLOM ,	526
X	HRLOS ,	527
X	HRLS  ,	507
X	HRLZ  ,	514
X	HRLZI ,	515
X	HRLZM ,	516
X	HRLZS ,	517

X	HRR   ,	540
X	HRRE  ,	570
X	HRREI ,	571
X	HRREM ,	572
X	HRRES ,	573
X	HRRI  ,	541
X	HRRM  ,	542
X	HRRO  ,	560
X	HRROI ,	561
X	HRROM ,	562
X	HRROS ,	563
X	HRRS  ,	543
X	HRRZ  ,	550
X	HRRZI ,	551
X	HRRZM ,	552
X	HRRZS ,	553

X	IBP   ,	133

X	IDIV  ,	230
X	IDIVB ,	233
X	IDIVI ,	231
X	IDIVM ,	232

X	IDPB  ,	136

X	ILDB  ,	134

X	IMUL  ,	220
X	IMULB ,	223
X	IMULI ,	221
X	IMULM ,	222

X	IN    ,	056
X	INBUF ,	064
X	INIT  ,	041
X	INPUT ,	066

X	IOR   ,	434
X	IORB  ,	437
X	IORI  ,	435
X	IORM  ,	436

Y	JCRY  ,  JCRY
Y	JCRY0 , JCRY0
Y	JCRY1 ,	JCRY1
Y	JEN   ,	JEN
X	JFCL  ,	255
X	JFFO  , 243
Y	JFOV  ,	JFOV
Y	JOV   ,	JOV
X	JRA   ,	267
X	JRST  ,	254

Y	JRSTF ,	JRSTF
X	JSA   ,	266
X	JSP   ,	265
X	JSR   ,	264
X	JSYS  , 104

X	JUMP  ,	320
X	JUMPA ,	324
X	JUMPE ,	322
X	JUMPG ,	327
X	JUMPGE,	325
X	JUMPL ,	321
X	JUMPLE,	323
X	JUMPN ,	326


X	LDB   ,	135

X	LOOKUP,	076

X	LSH   ,	242
X	LSHC  ,	246
X	MAP   , 257
X	MOVE  ,	200
X	MOVEI ,	201
X	MOVEM ,	202
X	MOVES ,	203
X	MOVM  ,	214
X	MOVMI ,	215
X	MOVMM ,	216
X	MOVMS ,	217
X	MOVN  ,	210
X	MOVNI ,	211
X	MOVNM ,	212
X	MOVNS ,	213
X	MOVS  ,	204
X	MOVSI ,	205
X	MOVSM ,	206
X	MOVSS ,	207


X	MTAPE ,	072
X	MTOP. , 024

X	MUL   ,	224
X	MULB  ,	227
X	MULI  ,	225
X	MULM  ,	226

X	OPEN  ,	050

X	OR    ,	434
X	ORB   ,	437
X	ORCA  ,	454
X	ORCAB ,	457
X	ORCAI ,	455
X	ORCAM ,	456
X	ORCB  ,	470
X	ORCBB ,	473

X	ORCBI ,	471
X	ORCBM ,	472
X	ORCM  ,	464
X	ORCMB ,	467
X	ORCMI ,	465
X	ORCMM ,	466
X	ORI   ,	435
X	ORM   ,	436

X	OUT   ,	057
X	OUTBUF,	065
X	OUTPUT,	067


X	POP   ,	262
X	POPJ  ,	263
Y	PORTAL,	PORTAL
X	PUSH  ,	261
X	PUSHJ ,	260


X	RELEAS,	071

X	RENAME,	055

X	ROT   ,	241
X	ROTC  ,	245

Y	RSW   ,	RSW
X	SETA  ,	424
X	SETAB ,	427
X	SETAI ,	425
X	SETAM ,	426
X	SETCA ,	450
X	SETCAB,	453
X	SETCAI,	451
X	SETCAM,	452
X	SETCM ,	460
X	SETCMB,	463
X	SETCMI,	461
X	SETCMM,	462
X	SETM  ,	414
X	SETMB ,	417
X	SETMI ,	415
X	SETMM ,	416
X	SETO  ,	474
X	SETOB ,	477
X	SETOI ,	475
X	SETOM ,	476
X	SETSTS,	060
X	SETZ  ,	400
X	SETZB ,	403
X	SETZI ,	401
X	SETZM ,	402

X	SKIP  ,	330
X	SKIPA ,	334
X	SKIPE ,	332
X	SKIPG ,	337
X	SKIPGE,	335
X	SKIPL ,	331
X	SKIPLE,	333
X	SKIPN ,	336

X	SOJ   ,	360
X	SOJA  ,	364
X	SOJE  ,	362
X	SOJG  ,	367
X	SOJGE ,	365
X	SOJL  ,	361
X	SOJLE ,	363
X	SOJN  ,	366

X	SOS   ,	370
X	SOSA  ,	374
X	SOSE  ,	372
X	SOSG  ,	377
X	SOSGE ,	375
X	SOSL  ,	371
X	SOSLE ,	373
X	SOSN  ,	376

X	STATO ,	061
X	STATUS,	062
X	STATZ ,	063

X	SUB   ,	274
X	SUBB  ,	277
X	SUBI  ,	275
X	SUBM  ,	276

X	TDC   ,	650
X	TDCA  ,	654
X	TDCE  ,	652
X	TDCN  ,	656
X	TDN   ,	610
X	TDNA  ,	614
X	TDNE  ,	612
X	TDNN  ,	616
X	TDO   ,	670
X	TDOA  ,	674
X	TDOE  ,	672
X	TDON  ,	676
X	TDZ   ,	630
X	TDZA  ,	634
X	TDZE  ,	632
X	TDZN  ,	636

X	TLC   ,	641
X	TLCA  ,	645
X	TLCE  ,	643
X	TLCN  ,	647
X	TLN   ,	601
X	TLNA  ,	605
X	TLNE  ,	603
X	TLNN  ,	607
X	TLO   ,	661
X	TLOA  ,	665
X	TLOE  ,	663
X	TLON  ,	667
X	TLZ   ,	621
X	TLZA  ,	625
X	TLZE  ,	623
X	TLZN  ,	627

X	TRC   ,	640
X	TRCA  ,	644
X	TRCE  ,	642
X	TRCN  ,	646
X	TRN   ,	600
X	TRNA  ,	604
X	TRNE  ,	602
X	TRNN  ,	606
X	TRO   ,	660
X	TROA  ,	664
X	TROE  ,	662
X	TRON  ,	666
X	TRZ   ,	620
X	TRZA  ,	624
X	TRZE  ,	622
X	TRZN  ,	626

X	TSC   ,	651
X	TSCA  ,	655
X	TSCE  ,	653
X	TSCN  ,	657
X	TSN   ,	611
X	TSNA  ,	615
X	TSNE  ,	613

X	TSNN  ,	617
X	TSO   ,	671
X	TSOA  ,	675
X	TSOE  ,	673
X	TSON  ,	677
X	TSZ   ,	631
X	TSZA  ,	635
X	TSZE  ,	633
X	TSZN  ,	637
X	TTCALL, 051
X	UFA   ,	130
X	UGETF ,	073
X	UJEN  , 100
X	UMOVE , 100
X	UMOVEI, 101
X	UMOVEM, 102
X	UMOVES, 103

X	USETI ,	074
X	USETO ,	075

X	XCT   ,	256
X	XOR   ,	430
X	XORB  ,	433
X	XORI  ,	431
X	XORM  ,	432
X	Z     ,	000


IF1,<
OPN:	BLOCK	OPNSIZ
OPC:	BLOCK	<OPNSIZ+3>/4
OPH:	BLOCK	<OPHSIZ+1>/2
>

IF2,<
	.ORG CLOC
	IFG ..TMP1,< EXP ..TMP2>
	.ORG HLOC
	IFN ..TMP3&1, <EXP ..TMP4>
>


	DEFINE $CODE($B)<
	IFE ^D35-..TMP1,<
		EXP ..TMP2
		..TMP1==-1
		..TMP2==0 >
	..TMP1==..TMP1+^D9
	..TMP2==..TMP2!<$B>B<..TMP1>
	> ;END OF $CODE DEFINITION

	.CREF			;RESUME CREF OUTPUT

;TABLES FOR OTHER BUILT - IN MNEMONIC CODES, CALLI'S ETC.

;TABLE OF CALL IMMEDIATE MNEMONICS

CALTBL:				;USER DEFINED CALLI'S GO HERE
	SIXBIT	/LIGHTS/	;-1
CALLI0:	SIXBIT	/RESET/		; 0
	SIXBIT	/DDTIN/		; 1
	SIXBIT	/SETDDT/	; 2
	SIXBIT	/DDTOUT/	; 3
	SIXBIT	/DEVCHR/	; 4
	SIXBIT	/DDTGT/		; 5
	SIXBIT	/GETCHR/	; 6
	SIXBIT	/DDTRL/		; 7
	SIXBIT	/WAIT/		;10
	SIXBIT	/CORE/		;11
	SIXBIT	/EXIT/		;12
	SIXBIT	/UTPCLR/	;13
	SIXBIT	/DATE/		;14
	SIXBIT	/LOGIN/		;15
	SIXBIT	/APRENB/	;16
	SIXBIT	/LOGOUT/	;17
	SIXBIT	/SWITCH/	;20
	SIXBIT	/REASSI/	;21
	SIXBIT	/TIMER/		;22
	SIXBIT	/MSTIME/	;23
	SIXBIT	/GETPPN/	;24
	SIXBIT	/TRPSET/	;25
	SIXBIT	/TRPJEN/	;26
	SIXBIT	/RUNTIM/	;27
	SIXBIT	/PJOB/		;30
	SIXBIT	/SLEEP/		;31
	SIXBIT	/SETPOV/	;32
	SIXBIT	/PEEK/		;33
	SIXBIT	/GETLIN/	;34
	SIXBIT	/RUN/		;35
	SIXBIT	/SETUWP/	;36
	SIXBIT	/REMAP/		;37
	SIXBIT	/GETSEG/	;40
	SIXBIT	/GETTAB/	;41
	SIXBIT	/SPY/		;42
	SIXBIT	/SETNAM/	;43
	SIXBIT	/TMPCOR/	;44
	SIXBIT	/DSKCHR/	;45
	SIXBIT	/SYSSTR/	;46
	SIXBIT	/JOBSTR/	;47
	SIXBIT	/STRUUO/	;50
	SIXBIT	/SYSPHY/	;51
	SIXBIT	/FRECHN/	;52
	SIXBIT	/DEVTYP/	;53
	SIXBIT	/DEVSTS/	;54
	SIXBIT	/DEVPPN/	;55
	SIXBIT	/SEEK/		;56
	SIXBIT	/RTTRP/		;57
	SIXBIT	/LOCK/		;60
	SIXBIT	/JOBSTS/	;61
	SIXBIT	/LOCATE/	;62
	SIXBIT	/WHERE/		;63
	SIXBIT	/DEVNAM/	;64
	SIXBIT	/CTLJOB/	;65
	SIXBIT	/GOBSTR/	;66
	0			;67
	0			;70
	SIXBIT	/HPQ/		;71
	SIXBIT	/HIBER/		;72
	SIXBIT	/WAKE/		;73
	SIXBIT	/CHGPPN/	;74
	SIXBIT	/SETUUO/	;75
	SIXBIT	/DEVGEN/	;76
	SIXBIT	/OTHUSR/	;77
	SIXBIT	/CHKACC/	;100
	SIXBIT	/DEVSIZ/	;101
	SIXBIT	/DAEMON/	;102
	SIXBIT	/JOBPEK/	;103
	SIXBIT	/ATTACH/	;104
	SIXBIT	/DAEFIN/	;105
	SIXBIT	/FRCUUO/	;106
	SIXBIT	/DEVLNM/	;107
	SIXBIT	/PATH./		;110
	SIXBIT	/METER./	;111
	SIXBIT	/MTCHR./	;112
	SIXBIT	/JBSET./	;113
	SIXBIT	/POKE./		;114
	SIXBIT	/TRMNO./	;115
	SIXBIT	/TRMOP./	;116
	SIXBIT	/RESDV./	;117
	SIXBIT	/UNLOK./	;120
	SIXBIT	/DISK./		;121
	SIXBIT	/DVRST./	;122
	SIXBIT	/DVURS./	;123
	SIXBIT	/XTTSK./	;124
	SIXBIT	/CAL11./	;125
	SIXBIT	/MTAID./	;126
	SIXBIT	/IONDX./	;127
	SIXBIT	/CNECT./	;130
	SIXBIT	/MVHDR./	;131
	SIXBIT	/ERLST./	;132
	SIXBIT	/SENSE./	;133
	SIXBIT	/CLRST./	;134
	SIXBIT	/PIINI./	;135
	SIXBIT	/PISYS./	;136
	SIXBIT	/DEBRK./	;137
	SIXBIT	/PISAV./	;140
	SIXBIT	/PIRST./	;141
	SIXBIT	/IPCFR./	;142
	SIXBIT	/IPCFS./	;143
	SIXBIT	/IPCFQ./	;144
	SIXBIT	/PAGE./		;145
	SIXBIT	/SUSET./	;146
	SIXBIT	/COMPT./	;147
	SIXBIT  /SCHED./	;150
	SIXBIT  /ENQ./		;151
	SIXBIT  /DEQ./		;152
	SIXBIT  /ENQC./		;153
	SIXBIT  /TAPOP./	;154
	SIXBIT  /FILOP./	;155
	SIXBIT  /CAL78./	;156
	SIXBIT  /NODE./		;157
	SIXBIT  /ERRPT./	;160
	SIXBIT  /ALLOC./	;161
	SIXBIT  /PERF./		;162
	SIXBIT	/DIAG./		;163
	SIXBIT	/DVPHY./	;164
	SIXBIT	/GTNTN./	;165
	SIXBIT	/GTXTN./	;166
	SIXBIT	/ACCT./		;167
	SIXBIT	/DTE./		;170
	SIXBIT	/DEVOP./	;171

CALNTH==.-CALTBL

;TABLE OF TTCALL MNEMONICS
TTCTBL:	SIXBIT	/INCHRW/	; 0	INPUT A CHAR. AND WAIT
	SIXBIT	/OUTCHR/	; 1	OUTPUT A CHAR.
	SIXBIT	/INCHRS/	; 2	INPUT A CHAR. AND SKIP
	SIXBIT	/OUTSTR/	; 3	OUTPUT A STRING
	SIXBIT	/INCHWL/	; 4	INPUT CHAR., WAIT, LINE MODE
	SIXBIT	/INCHSL/	; 5	INPUT CHAR., SKIP, LINE MODE
	SIXBIT	/GETLCH/	; 6	GET LINE CHARACTERISTICS
	SIXBIT	/SETLCH/	; 7	SET LINE CHARACTERISTICS
	SIXBIT	/RESCAN/	;10	RESET INPUT STREAM TO COMMAND
	SIXBIT	/CLRBFI/	;11	CLEAR TYPEIN BUFFER
	SIXBIT	/CLRBFO/	;12	CLEAR TYPEOUT BUFFER
	SIXBIT	/SKPINC/	;13	SKIPS IF A CHAR. CAN BE INPUT
	SIXBIT	/SKPINL/	;14	SKIPS IF A LINE CAN BE INPUT
	SIXBIT	/IONEOU/	;15	OUTPUT AS AN IMAGE CHAR.

TTCLTH==.-TTCTBL

;TABLE OF MTAPE MNEMONICS

MTATBL:	SIXBIT	/MTWAT./	;  0
	SIXBIT	/MTREW./	;  1
	SIXBIT	/MTEOF./	;  3
	SIXBIT	/MTSKR./	;  6
	SIXBIT	/MTBSR./	;  7
	SIXBIT	/MTEOT./	; 10
	SIXBIT	/MTUNL./	; 11
	SIXBIT	/MTBLK./	; 13
	SIXBIT	/MTSKF./	; 16
	SIXBIT	/MTBSF./	; 17
	SIXBIT	/MTDEC./	;100
	SIXBIT	/MTIND./	;101

MTALTH==.-MTATBL

MTACOD:	BYTE	(9) 0,1,3,6
	BYTE	(9) 7,10,11,13
	BYTE	(9) 16,17,100,101
; PSEUDO-OPERATOR TABLE FOR THE MACRO EVALUATOR.
; THIS TABLE CONTAINS THE NAMES,CHARACTERISTICS AND THE ADDRESS
; OF THE PROCESSOR FOR EACH OF THE MACRO PSEUDO-OPS. THESE PSEUDO
; OPS ARE HANDLED AT THE LEVEL OF PRIMARY CELL, WHEN MACSRC
; FINDS THAT THE SYMBOL IT IS SEARCHING ON
; IS IN THIS TABLE.
;
; THERE ARE CURRENTLY THREE CHARACTERISTICS FOR PSEUDO-OPS
; 
; 1) $INP - DONT FIND THIS PSEUDO-OP IF NOT PRIMARY STATEMENT
	; THIS MEANS PRETEND ITS NOT FOUND IF WE HAVE:
	;    ['PSEUDO-OP' ...]
	;    ('P.O.'...)
	;    <'P.O.'...>
      ;IN OTHER WORDS, ANY CASE BUT  :
	;  LABEL:   PSEUDO-OP ....
	;OR     PSEUDO-OP.....

;	2) $III -  MEANS IF THIS PSEUDO-OP IS FOUND INSIDE THE RANGE
;	   OF '.INSERT' .......  '.ENDI' THEN ITS A FATAL ERROR.

; 3) $COF - BEFORE RETURNING FROM EXECUTING PSEUDO-OP, CLEAR
;	    THE BIT THAT SAYS WE ARE IN THE OP CODE FIELD OF THE
;	    CURRENT STATEMENT. THIS IS USED FOR PSEUDO-OPS
;	    THAT "EAT" THE REST OF THE LINE, BUT WISH TO
;	    USE EVALEX TO DO EXPRESSION EVALUATION. TURNING OFF
;	    THE I.OP FLAG MEANS THAT EXPRESSIONS INVOLVING LABELS THAT
;	     ARE THE SAME AS BUILT IN SYMBOLS, WILL GET EVALUATED RIGHT.


	DEFINE POPMAK<
	IFE BIGLST,<XLIST>
	X (ASCII,EVP70)
	X (ASCIZ,EVP70Z)
	X (BLOCK,EVP85)
	X (SIXBIT,EVP71)
	X (IOWD,EVP72)
	X (XWD,EVP73)
	X (RADIX5,EVP74)
	X (IFN,EVP83A)
	X (IFE,EVP83B)
	X (IFL,EVP83C)
	X (IFG,EVP83D)
	X (IFLE,EVP83E)
	X (IFGE,EVP83F)
	X (IFDEF,EVP83G)
	X (IFNDEF,EVP83H)
	X (IFEDIT,EVP83P)
	X (IFNEDI,EVP83Q)
	X (IFACTI,EVP83R)
	X (IFNACT,EVP83S)
	X (PURGE, EVP84,$INP)
	X (SQUOZE,EVP74)
	X (POINT,EVP75)
	X (COMMEN,EVP76,$INP)
	X (REMARK,EVP77,$INP)
	X (TITLE, EVP77,$INP)
	X (SUBTTL,EVP77,$INP)
	X (EXP,	  EVP78)
	X (DEC,	  EVP79)
	X (OCT,	  EVP80)
	X (BYTE,  EVP81)
	X (RADIX, EVP82,$INP)		

	X(.EDIT,FP.EDT,$III!$INP)
	X (.MODUL, FP.MOD, $III!$INP)
	X(.NAME,FP.NAM,$INP)
	X(.DATE,FP.DAT,$INP)
	X(.ASSOC,FP.ASC,$III!$INP)
	X(.REMOV,FP.REM,$III!$INP)
	X(.VERSI,FP.VER,$INP)
	X (.REINS, FP.RNS,$III!$INP)
	X (.INSER, FP.INS,$INP!$COF)
	X (.ENDI,  FP.ENI,$INP)
	X (.ENDE,  FP.ENE,$INP)
	X (.ALTER, FP.ALT,$INP!$III!$COF)
IFN DEBUG,<
	X (.MKLTS, FP.TST,$INP!$III) 	;;RUN INTERNAL ROUTINE TEST PACKAGE
	X (.DMON, FP.DMN, $INP)		;;ENTER DEBUG MODE FOR MACRO INTERPRETER
	X (.DMOFF,FP.DMF, $INP)		;;LEAVE DEBUG MODE FOR MACRO INTERPRETER
	X (.GODDT,.GODDT, $INP)		;;ENTER DDT, LEAVE VIA "CONTIN$X"
> ; NFI DEBUG

   	LIST
   >   ;END OF POPMAK DEFINTION

	DEFINE X($A,$B,$C)< SIXBIT /$A/>	;;DEFINE THE NAME TABLE
POPNAM:	POPMAK
	POPLTH==.-POPNAM

	DEFINE X($A,$B,$C)< EXP <$B+$C>>	;;DEFINE THE PROCESSOR ADDRESS LIST
POPDO:	POPMAK
; /ORGCOD/ -  ROUTINE TO PROCESS THE ORIGINAL CODE MATCH
;				WHERE HERE WE COMPARE THE MACRO
;				CODE GIVEN TO WHAT IS THERE AND
;				FILTER OUT ERRORS. 
; INPUTS-	NONE
; OUTPUTS- NONE
;
; 

ORGCOD:	PUSHJ	P,.PSH4T##		;SAVE T1-T4
	PUSH	P,CPADDR		;SAVE CURRENT PATCH ADDRESS
	MOVE	T1,TRCVAP		;GET CURRENT LOCATION
	HRRZ	T1,TB$DAT(T1)		;OF PATCH BREAK FOR EVALS TO  USE
	MOVEM	T1,CPADDR		;CURRENT PATCH ADDRESS
	PUSHJ	P,ISTSAV		;SAVE STATE OF IST
	BYPASS				;EAT TILL THE "L.BRACKET"
	TXO	F,REGET			;REGET FIRST CHARACTER AGAIN
	CAIE	CC,74 			;MAKE SURE THATS WHATS THERE
	JRST	ORG0			;IF NOT,SKIP EVALUATION
	PUSHJ	P,CELL			;GET EXPRESSION "<.....>"
	CAIE	CC,76 			;INSURE PROPER CLOSE
	JRST	QERROR
	PUSHJ	P,MIC			;GET NEXT CHARACTER LOADED
	PUSHJ	P,COMCOD		;COMPARE CODE

ORG0:	POP	P,CPADDR		;RESTORE THE CURRENT PATCH ADDRESS
	PUSHJ	P,.POP4T##		;RESTORE THE ACS
	PJRST	ISTRST			;RESTORE STATE OF IST
					;AND RETURN TO CALLER
; /SETPT/ -  ROUTINE TO SET UP FOR PATCHING
;	THIS ROUTINE SETS UP THE BOOKKEEPING NECESSARY
;	TO DO PATCHING WHEN AN .INSERT OR OTHER CHANGE
;	PSEUDO-OP IS DONE. THE MAIN THINGS SET UP
;	ARE LOCATIONS OF THE CP????? (CURRENT PATCH)
;	FLAVOR

; INPUTS - NONE, EXCEPT THE CURRENT TRACE BLOCK
; OUTPUTS - CPADDR, CPSFLG,  AND PATCH LABEL
;

SETPT:	PUSHJ	P,.PSH4T##		;SAVE ACS ON ALT. ENTRY
	MOVE	T1,TRCVAP		;GET VARIABLE AREA POINTER
	HRRZ	T2,TB$DAT(T1)		;GET PATCH ADDRESS
	SKIPN	T3,HSILOC		;DOES PROGRAM HAVE HI-SEG?
	JRST	SETPT1			;NO,THAT SORT OF DECIDES IT
	HRRZ	T4,2(T3)		;GET FIRST DATA WORD (RH)
	CAMGE	T2,T4			;PATCH LOC .GE. HISEG ORIGIN?
	JRST	SETPT1			;NO,PATCH TO LOW SEGMENT
	SETZM	CPSFLG			;SET FLAG FOR HI-SEG PATCH
	MOVE	T4,SEB+2		;GET HI-SEG  BREAK FROM END BLOCK
	JRST	SETPT2			;AND BACK INTO COMMON CODE

SETPT1:	SETOM	CPSFLG			;PATCH TO LOW SEGMENT
	MOVE	T4,SEB+2		;LOAD WITH FIRST DATA WORD
	SKIPE	HSILOC			;UNLESS HAS HI-SEGMENT WHICH
	MOVE	T4,SEB+3		;LOWSEG BREAK IS IN SECOND DATA WORD

SETPT2:	MOVEM	T4,CPADDR		;STORE CURRENT PATCH ADDRESS
	SKIPGE	BARFLG			;WAS IT /AFTER OR /REPLACE?
	JRST	SETP2A			;NO,SO JUST GO ON
	HRLM	T4,TB$PAT(T1)		;STORE WHERE ORIGINAL WENT
	MOVE	C,SAVCOD		;ORIGINAL CODE
	MOVE	B,SAVREL		;GET ORIG. INST. RELOCATION
	PUSHJ	P,NEWCOD		;INSERT NEW CODE
	 JRST	INSERR			;INSERT ERROR
	MOVE	T4,CPADDR		;GET UPDATED ADDRESS
	SKIPE	BARFLG			;IF /AFTER POINT TO ORIG
	SOS	T4			;CODE SO WE EXECUTE IT
SETP2A:	HRRM	T4,TB$PAT(T1)		; FOR TRACE BLOCK .
	MOVSI	T3,(JUMPA 0,)		;BREAK EXISTING CODE FLOW
	HRR	T3,T4			;TO POINT TO PATCH BLOCK
	MOVE	A,T2			;GET IN-CORE ADDRESS OF WORD
	PUSHJ	P,WRDSRC		;TO BE CHANGED FOR PATCH LINK
	 $STPCD(.INSERT lost its pointers)
	MOVEM	T3,0(C)			;DONE.
	MOVEI	D,1			;RESET RELOCATION TO BE
	PUSHJ	P,CHGREL		;01 (IE. RELOCATE RH)
	SKIPE	BARFLG			;EXCEPT FOR /REPLACE
	AOS	T2			;SET RETURN PC TO JUMPA+1
	MOVEM	T2,CPRET		;FOR NOW

	MOVSI	R,'%  '			;START AC R ON  ITS LABEL
	MOVE	T3,CUREDT		;CURENT EDIT NAME
	TRNN	T3,77			;RIGHT JUSTIFY IT
	JRST	[ LSH T3,-6
		  JRST .-1 ]		;TO GET LEAST SIG. BITS
	LSH	T3,6			;NOW MAKE ROOM FOR "<PART>"
	TLZ	T3,770000
	AOS	T2,CPPART		;GET PART ID
	CAILE	T2,^D26			;CHECK FOR 26TH PART
	JRST	SETPT3			;YES,SO FORGET THIS
	IORI	T3,'A'-1(T2)		;T3 NOW HAS ' EDIT<PART>'
	IOR	R,T3			;R NOW HAS "%EDIT<PART>"
	PUSHJ	P,SYMSRC		;LOOK UP THE SYMBOL
	 CAIA				;NOT FOUND RETURN
	JRST	SETPT3			;CONFLICTS, FORGET IT
	HRRZ	A,TB$PAT(T1)		;PATCH ADDRESS
	PUSHJ	P,RAD50			;CONVERT SYMBOL TO RADIX50
	MOVEI	B,1			;ITS A LABEL,SO RELOCATE RH
	PUSHJ	P,NEWSYM		;INSERT THE SYMBOL
	 JFCL				;IF FAILS,JUST FORGET IT
SETPT3:	PUSHJ	P,.POP4T##		;RESTORE T1-T4
	POPJ	P,			;RETURN
; /COMCOD/ - ROUTINE TO CHECK FOR MATCH BETWEEN CODES
;
; THE IDEA IS TO FIND OUT IF THERE IS MATCH BETWEEN THE CODE
; GIVEN BY THE PATCH FILE AND THE CODE IN REL FILE.
; THE INPUT IS FROM EVALS, SAVCOD AND THE IST.
; THIS CODE CATCHES MOST ERRORS, BUT PROBABLY NOT ALL OF THEM.
;
; INPUTS- AC A CONTAINS CODE RETURNED BY EVALS
;	AC C CONTAINS THE IST POINTER FOR THE CODE FOURPLET
;	CPADDR CONTAINS LOCATION OF INSERT
;	SAVCOD CONTAINS THE ORIGINAL CODE AT THAT LOCATION
;
; OUTPUTS: NONE
; RETURNS: ALWAYS CPOPJ, OR TO FATAL ERROR HANDLER
;
COMCOD:	CAMN	A,SAVCOD		;TAKE CARE OF 90% OF CASES RIGHT AWAY
	POPJ	P,			;MATCHES RIGHT OFF
	PUSHJ	P,.PSH4T##		;SAVE T1-T4
	MOVEM	P,SAVEP			;SAVE PDL POINTER
	JUMPE	C,COMC99		;IF NO IST POINTER,THERE IS NO HOPE
	MOVE	T1,SAVCOD		;LOAD T1 WITH ORIG
	MOVE	T2,A			;T2 WITH NEW CODE
	MOVE	T3,C			;T3 WITH FIXUP POINTER
	MOVE	T4,CPADDR		;T4 WITH LOCATION WE ARE LOOKING AT
	PUSHJ	P,COM1			;CALL LOCAL ROUTINE
	PUSHJ	P,.POP4T##		;RESTORE TEMPS
	POPJ	P,			;AND RETURN



;/COM1/ - RECURSIVE MATCH CHECKER
; 	THIS ROUTINE TRIES TO MATCH CODE, TRACING LITERAL AND EXTERNAL POINTERS
; INPUTS: T1-ORIGINAL CODE
;	  T2-NEW CODE THAT TRIES TO MATCH
;	  T3-FIXUP WORD ON T2
;	  T4 ADDRESS THAT CONTENTS OF T1 CAME FROM
;

COM1:	SETZM	COMDON			;START WITH LEFT HALF
	HLRZ	A,T1			;LOAD A-D WITH T1-T4 LH
	HLRZ	B,T2
	HLRZ	C,T3
	HLRZ	D,T4
COM1A:	CAMN	A,B			;DOES CODE MATCH?
	JRST	COM2			;YES,TRY OTHER HALF OR QUIT
	JUMPE	C,COMC99		;IF NOT IST,QUIT
	MOVE	D,1(C)			;GET 2ND WORD OF IST PAIR
	TXNN	D,IS.MWS		;MULTI-WORD STRING WONT SAVE US
	TXNE	D,IS.UDF		;SHOULD NOT BE AN UNDEFINED SYMBOL
	JRST	COMC99			;IF IT IS,THERE IS ERROR
	TXNN	D,IS.DER		;IS  THIS AN INDICATOR OF EXTERNAL REQUEST?
	JRST	COM1B			;NO,TRY LITERAL
	MOVE	R,0(C)			;GET SYMBOL NAME FROM IST
	MOVE	A,T4			;MUST POINT TO THIS ADDRESS
	PUSHJ	P,FGREF			;LOOK UP THE REFERENCE
	  JRST	COMC99			;CANT FIND ONE
	JRST	COM2			;CONTINUE

COM1B:	TXNN	D,IS.LIT		;IS THIS A LITERAL?
	  $STPCD(INTERIM SYMBOL TABLE has illegal flags)
	PUSHJ	P,.PSH4T##		;SAVE T1-T4
	MOVE	T4,A			;ADDRESS IS CONTENTS A
	MOVE	C,0(C)			;GET POINTER TO LIT TRIPLET
	MOVE	T2,0(C)			;NEW CODE IS THE LITERAL
	MOVE	T3,2(C)			;AND IT HAS ITS OWN FIXUP POINTER
	PUSHJ	P,WRDSRC		;MAP WORD THAT A POINTS TO
	  JRST	COMC99			;IF OUT OF BOUNDS,FORCE NOT MATCH
	MOVE	T1,0(C)			;PICK UP WORD AT THAT LOCATION
	PUSH	P,COMDON		;SAVE HALF WORD INDICATOR
	PUSHJ	P,COM1			;AND EVALUATE NEXT LEVEL
	POP	P,COMDON		;RESTORE
	PUSHJ	P,.POP4T##		;ALL THAT WE DESTROYED
					;FALL INTO COM2

COM2:	SKIPE	COMDON			;DOING RIGHT HALF ?
	POPJ	P,			;YES,DONE
	SETOM	COMDON			;FLAG AS DOING RIGHT HALF
	HRRZ	A,T1			;GET RIGHT HALVES
	HRRZ	B,T2
	HRRZ	C,T3
	JRST	COM1A			;CONTINUE

COMC99:	MOVE	P,SAVEP			;GET POINTER
	$KILL(CDM,Existing code does not match original code,,$MORE)
	PUSHJ	P,.POP4T##		;RESTORE THE ACS
	JRST	MCCOMM			;TYPE OUT CURRENT LINE
;/SWPWRD/ - ROUTINE TO TAKE TWO WORDS AND SWAP THEIR POSITIONS
;		AROUND IN THE REL FILE. THIS INCLUDES CHANGEING
;		CONTENTS,RELOCATION AND GLOBAL FIXUP CHAINS.
;
; INPUTS:	A CONTAINS LOCATION OF 1 WORD
;		B CONTAINS RELOCATABLE LOCATION OF 2ND WORD
; RETURN:	ALWAYS CPOPJ

		;LOCAL DEFINITIONS
			DEFINE $WRD1,<-1(P)>
			DEFINE $WRD2,<0(P)>

SWPWRD:	PUSH	P,A			;SAVE CALLED ARGUMENT
	PUSH	P,B			;AND OTHER LOCATION TOO.
	PUSHJ	P,WRDSRC		;LOOKUP FIRST WORD IN FILE
	  $STPCD(TRACE BLOCK fouled up)
	PUSHJ	P,GETREL		;GET ITS RELOCATION
	MOVE	B,0(C)			;AND ITS CONTENTS
	MOVEM	B,SAVCOD		;SAVE CODE
	MOVEM	D,SAVREL		;AND RELOCATION
	MOVEI	B,-1			;TEMPORARILY RELOCATE GLOBALS
	PUSHJ	P,GFIXUP		;TO NON-EXISTENT ADDRESS
	MOVE	A,$WRD2			;GET SECOND WORDS ADDRESS
	PUSHJ	P,WRDSRC		;MAP IT INTO FILE
	  $STPCD(TRACE BLOCK fouled up)
	PUSHJ	P,GETREL		;GET ITS RELOCATION
	EXCH	D,SAVREL		;EXCHANGE THE RELOCATION
	PUSHJ	P,CHGREL		;WITH THE OTHER
	MOVE	B,0(C)			;NOW GET THE CONTENTS
	EXCH	B,SAVCOD		;GET OTHER CONTENTS,STORE THESE
	MOVEM	B,0(C)			;STORE UPDATED CONTENTS
	MOVE	B,$WRD1			;NOW GET FIRST ADDRESS AGAIN 
	MOVE	A,$WRD2			;AND SECOND
	PUSHJ	P,GFIXUP		;RELOCATE FROM 2ND TO FIRST
	MOVE	A,$WRD1			;LOCATION OF FIRST WORD
	PUSHJ	P,WRDSRC		;MAP IT
	   $STPCD(ERROR IN SWPWRD ROUTINE)
	MOVE	D,SAVREL		;GET RELOCATION
	PUSHJ	P,CHGREL		;CHANGE WORD ONE'S RELOCATION
	MOVE	D,SAVCOD		;GET CODE CONTENTS
	MOVEM	D,0(C)			;STORE INTO THIS ADDRESS
	MOVEI	A,-1			;FIXUP GLOBAL CHAINS
	MOVE	B,$WRD2			;FROM -1 TO LOC OF WORD2
	PUSHJ	P,GFIXUP		;FIXUP THE GLOBAL CHAINS
	POP	P,B			;RESTORE ARG2
	POP	P,A			;RESTORE ARG1
	POPJ	P,			;RETURN
IFN DEBUG,<

; /LSTCOD/ - THIS ROUTINE LISTS THE RESULTS OBTAINED IN CALL TO EVAL
;	THE VALUES OF R%R,R%V AND SUCH ARE USED HERE TO PRINT OUT
;	THE NUMERIC RESULT OF THE CALL TO EVAL
;
LSTCOD:	PUSHJ	P,.PSH4T##		;SAVE T1-T4
	TXO	F,FOTTY			;OUTPUT IS TO TTY
	LDB	T1,[POINT 9,R%V,8]	;GET INST
	CAIN	T1,777			;IF 777,PROBABLY NEG NUMBER
	JRST	MAC0
	HLRZ	T2,R%R			;IF LEFT RELOC THEN NOT INSTR
	JUMPN	T2,MAC0
	JUMPE	T1,MAC0			;IF NO INSTR., USE HALFWORD ONLY
	PUSHJ	P,.TOCTW##		;OUTPUT IN INSTRUCTION FORMAT
	PUSHJ	P,.TSPAC##		;
	LDB	T1,[POINT 4,R%V,12]	;AC FIELD
	PUSHJ	P,FILLO			;2 DIGIT FILLED OCTAL
	LDB	T1,[POINT 1,R%V,13]	;INDIRECT BIT
	PUSHJ	P,.TOCTW##
	PUSHJ	P,.TSPAC##
	LDB	T1,[POINT 4,R%V,17]	;GET INDEX REGISTER
	PUSHJ	P,FILLO			;2 DIGIT ,0 FILLED OCTAL
	HRRZ	T1,R%V			;FINALLY THE VALUE
	PUSHJ	P,OUTHW			;OF THE ADDRESS FIELD
	HRRZ	T2,R%R			;SEE IF RIGHT RELOC
	MOVEI	T1,"'"			;IF RELOCATED , PRINT "'"
	SKIPE	T2
	PUSHJ	P,.TCHAR##
	PUSHJ	P,TYPTB1		;TAB OVER
MAC0:	HLRZ	T1,R%V			;HALFWORD FORMAT
	PUSHJ	P,OUTHW		;
	HLRZ	T2,R%R			;
	MOVEI	T1,[ASCIZ ",,"]		;PRETEND ITS NOT RELOCTATED
	SKIPE	T2			;RELOCATION FLAG
	MOVEI	T1,[ASCIZ "',,"]	;IF LEFT HALF RELOCATED
	PUSHJ	P,.TSTRG##		;INDICATE SO
	HRRZ	T1,R%V
	PUSHJ	P,OUTHW			;SAME FOR RIGHT HALF
	HRRZ	T2,R%R
	MOVEI	T1,"'"			;SINGLE QUOTE IS RELOCATED
	SKIPE	T2
	PUSHJ	P,.TCHAR		;RELOCATION FLAG
	PUSHJ	P,.TCRLF##		;END LINE NOW
	PUSHJ	P,.POP4T##		;RESTORE ACS
	TXZ	F,FOTTY			;
	POPJ	P,			;AND RETURN

FILLO:	CAIL	T1,10			;2 DIGITS ALREADY?
	JRST	FILLO1			;YES,SKIP "0" FILL
	PUSH	P,T1			;SAVE VALUE
	MOVEI	T1,"0"			;
	PUSHJ	P,.TCHAR##		;OUTPUT ASCII 0
	POP	P,T1			;RESTORE VALUE
FILLO1:	PUSHJ	P,.TOCTW##		;OUTPUT OCTAL AC VALUE
	PJRST	.TSPAC##		;FOLLOWED BY SPACE
> ; NFI DEBUG
; /UDFCHK/ - THIS ROUTINE CHECKS FOR ENTRIES STILL IN IST AFTER ALL DEFINTION DONE
;	THIS ROUTINE EXAMINES IST AND COMPLAINS ABOUT ANY ENTRIES
;	REMAINING IN IT. THIS ASSUMES THAT ALL EXTERNAL AND LITERAL
;	GENERATIONS HAVE BEEN DONE ALREADY.
; THE CALLS TO UDFCHK ARE MADE FROM FIX-PSEUDO-OPS ".ENDE" AND ".MODULE"
; TO INSURE PROPER DEFINITIONS HAVE BEEN MADE FOR ALL SYMBOLS.
; INPUTS-  ONLY THE IST. REMEMBER TO DO ALL DEFINITIONS FIRST
; OUTPUTS-  FATAL ERROR MESSAGE
; RETURN-  POPJ
;

UDFCHK:	MOVE	T1,[POINT 1,ISTMAP]	;ZERO UNUSED ENTRIES
	MOVEI	T2,IST			;SO DONT GET CONFUSED
	SETZM	T			;CLEAR T
UDF0:	ILDB	T3,T1			;GET BIT OF MAP
	JUMPN	T3,UDF00		;IN USE
	SETZM	0(T2)			;
	JRST	UDF01			;NOT IN USE, SO SKIP CHECKS
UDF00:	MOVEI	T,2(T2)			;UPDATE POINTER TO LAST IN-USE
	MOVE	T4,1(T2)		;GET FLAG WORD
	TXNE	T4,IS.LIT!IS.MWS!IS.DER!IS.DEF ;MAKE SURE ITS USER NOT PROGRAM ERROR
	$STPCD(A necessary forward fixup was not done)
UDF01:	ADDI	T2,2			;TWO WORDS PER ENTRY
	CAIG	T2,ISTLST		;OVER THE END?
	JRST	UDF0			;NO
	JUMPE	T,CPOPJ			;IF NO SLOTS IN USE,JUST RETURN
	MOVE	N,CURMOD		;GET MODULE
	$KILL(UDF,Module,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ/ in edit /]
	PUSHJ	P,.TSTRG##		;GIVE MOD AND EDIT
	MOVE	T1,CUREDT		;
	PUSHJ	P,.TSIXN##
	MOVEI	T1,[ASCIZ/ contains undefined symbol(s):
/]
	PUSHJ	P,.TSTRG##		;OUTPUT IT
UDF1:	CAIG	T,IST			;AT FRONT OF LIST?
	JRST	DONERR			;YES,SO CLOSE UP
	SUBI	T,2			;GET TO FRONT OF PAIR
	SKIPN	T1,0(T)			;LOAD LABEL NAME
	JRST	UDF1			;IGNORE NULL LABELS
	PUSHJ	P,TYPTB1		;OUTPUT TAB
	PUSHJ	P,.TSIXN##		;AND LABEL NAME
	PUSHJ	P,.TCRLF##
	MOVE	B,T			;DONT PRINT DUPLICATE LABELS
UDF2:	CAIG	B,IST			;WAS THIS LAST ONE?
	JRST	UDF1			;YES,BACK TO MAIN LOOP
	SUBI	B,2			;KEEP BACKTRACKING
	MOVE	C,0(B)			;GET LABEL NAME
	CAMN	C,0(T)			;IS THIS DUPLICATE?
	SETZM	0(B)			;YES,SO ZERO IT
	JRST	UDF2			;AND LOOP BACK
SUBTTL ERROR MESSAGES FOR THE MACRO PROCESSOR

MERROR:	PUSHJ	P,RAD50			;CONVERT SIXBIT TO RAD50
MERRO1:					;HERE IF ALREADY RAD50
	MOVE	N,R			;SYMBOL FOR MUL DEF
	$KILL(MCM,Attempt to redefine value of symbol,N$50,$MORE)
	JRST	MCCOMM

WERROR:	$KILL(MCW,<BYTE,EXP,DEC,or OCT more than one word>,,$MORE)
	JRST	MCCOMM

AERROR:	$KILL(MCA,Pseudo-operator argument error,,$MORE)
	JRST	MCCOMM

QERROR:	$KILL(MCQ,MACRO code is questionable,,$MORE)
	JRST	MCCOMM

NERROR:	$KILL(MCN,MACRO code numeric error,,$MORE)
	JRST	MCCOMM

ETCERR:	SKIPL	P			;IF MASTER STACK OVERFLOWED THEN
	MOVE	P,EVLPP			;WE NEED EMERGENCY FIXUP
	$KILL(ETC,MACRO code expression too complex,,$MORE)
	JRST	MCCOMM

FERROR:	$KILL(MCF,Illegal forward or external reference,,$MORE)
	JRST	MCCOMM

UERROR:	MOVE	N,R			;LOAD SYMBOL IN QUESTION
	$KILL(MCU,Undefined symbol:,N$SIX,$MORE)
	JRST	MCCOMM

RERROR:	$KILL(MCR,MACRO code relocation error,,$MORE)

MCCOMM:	MOVE	P,EVLPP			;RESTORE POINTER
	MOVEI	T1,[ASCIZ " at "]	;GIVE LABEL+OFFSET
	PUSHJ	P,.TSTRG##		;OUTPUT IT
	SKIPN	T1,LLABEL		;DO WE HAVE A LABEL?
	JRST	MCCOM1			;NO,CANT GIVE LABEL
	PUSHJ	P,.TSIXN##		;
	MOVEI	T1,"+"			;PLUS OFFSET
	PUSHJ	P,.TCHAR##		;
	JRST	MCCOM2			;AND CONTINUE
MCCOM1:	MOVEI	T1,[ASCIZ "line "]
	PUSHJ	P,.TSTRG##		;IF NO LABEL, GIVE JUST LINE NUMBER
MCCOM2:	MOVE	T1,LLOFF		;IN ANY CASE, GIVE OFFSET
	PUSHJ	P,.TDECW		;IN DECIMAL
	SKIPN	N,CUREDT		;ARE WE INSIDE AN EDIT NOW?
	JRST	MCCOM3			;NO,JUST END MESSAGE
	MOVEI	T1,[ASCIZ " (Edit "]
	PUSHJ	P,.TSTRG##		;OUTPUT EDIT NAME
	MOVE	T1,N			;EDIT NAME
	PUSHJ	P,.TSIXN##		;ITS IN SIXBIT
	MOVEI	T1,")"			;CLOSE IT OFF
	PUSHJ	P,.TCHAR##		;WITH RIGHT PAREN.
MCCOM3:	PUSHJ	P,.TCRLF##
	PUSHJ	P,TYPTB1		;OUTPUT <CR><LF><TAB>
	MOVEI	T1,MACBUF		;OUTPUT CURRENT MACRO LINE
	PUSHJ	P,.TSTRG##		;AS AN ASCIZ STRING
X$$MCM:  X$$MCQ: X$$MCN:  X$$ETC: X$$MCF:  X$$MCR: X$$MCA: X$$III:
X$$MCW:	X$$CDM: X$$ASG: X$$MCU:
	TXZ	F,REGET!FOTTY		;CLEAR SOME FLAGS

IFN DEBUG,<
	TXNE	F,DEBMOD		;IN DEBUG MODE?
	POPJ	P,			;YES, GO BACK
>; NFI DEBUG
	JRST	DONERR			;END AS USUAL
SUBTTL END OF LONG,LONG CONDITIONAL UNDER IFN FTBPT

> ; NFI FTBPT
	SUBTTL  RADIX50 CONVERSION ROUTINE

RAD50:	PUSHJ	P,.PSH4T##	;SAVE T1-T4
	MOVE	T3,[POINT 6,R]	;SET UP SIXBIT POINTER TO R
	MOVEI	T2,6		;SET COUNTER TO SIX
	MOVEI	T4,0
	JUMPE	R,RAD504	;NULL SYMBOL?
RAD501:	TRNE	R,77		;RIGHT-JUSTIFIED?
	JRST	RAD502		;YES-CONVERT TO RADIX50
	ROT	R,-6		;NO-SHIFT IT ONE PLACE RIGHT
	JRST	RAD501		;CHECK	AGAIN

RAD502:	ILDB	T1,T3		;PICK UP NEXT CHARACTER IN R
	JUMPE	T1,RAD503	;A BLANK IS A BLANK IN ANY RADIX
	IMULI	T4,50		;CONVERT TO RADIX50
	CAIE	T1,'%'		;IS IT A '%'?
	CAIN	T1,'$'		;IS IT A $ ?
	ADDI	T1,70		;YES-COMPENSATE FOR SUBTRACTION
	CAIN	T1,'.'		;IS IT A '.' ?
	ADDI	T1,55		;YES-COMPENSATE
	CAILE	T1,31		;TRANSLATE RADIX50 CODE
	SUBI	T1,7		;LETTER-SUBTRACT 26
	SUBI	T1,17		;NUMBER-SUBTRACT 17
	ADD	T4,T1		;COMBINE WITH PARTIAL WORD
RAD503:	SOJG	T2,RAD502	;LOOP FOR SIX CHARACTERS
RAD504:	MOVE	R,T4		;PUT SYMBOL BACK IN R
	PUSHJ	P,.POP4T##	;RESTORE OUR TEMPS
	POPJ	P,		;GIVE IT TO WHOEVER WANTED IT
	
SUBTTL ERROR ROUTINES



; /E$TEL/ - COMMENT MESSAGE
; /E$WRN/ - WARNING MESSAGE
; /E$KIL/ - FATAL MESSAGE AND RESTART

; CALLED VIA MACROS $KILL,$WARN,$TELL (SEE FRONT OF LISTING)
;
; INPUT - T1 POINTS TO INSTRUCTION OF JUMP [LITERAL]
; WHERE LITERAL IS TWO WORDS LONG OF FORMAT:
;   XWD CODE OF ERROR (SIXBIT),ADDRESS OF STRING FOR ERROR
;   XWD TYPEOUT ROUTINE OR 0  ,SKIP CONTINUATION (OR 0)
;
; RETURNS- NORMALLY AT CALL + 1
; UNLESS THIS IS A FATAL ERROR MESSAGE, IN WHICH CASE WE RESTART.
;
; IF THE CONTINUATION FIELD IS NON-ZERO AND WE HAVE
; MESSAGE BITS SET FOR SHORT MESSAGE, WE JRST TO THE
; ADDRESS SPECIFIED IN RH OF LITERAL+1
; NOTE: FOR DEBUGGING, LOCATION ERRPC CONTAINS XWD FLAGS,PC OF ERROR CALL


	FTEL==1B19	;TEMPORARY BITS STORED IN ERRPC(LH)
	FWRN==1B20
	FKIL==1B21

E$TEL:	MOVSI	T2,"["+FTEL		;COMMENT MESSAGE
	JRST	E$COM			;CONTINUE

E$WRN:	SKIPA	T2,["%"+FWRN,,0]	;WARNING MESSAGE
E$KIL:	MOVSI	T2,"?"+FKIL		;FATAL ERROR
E$COM:	TXO	F,FOTTY			;FORCED OUTPUT TO TTY
	PUSH	P,A			;SAVE ORIGINAL A
	HRRZ	A,0(T1)			;GET THE REAL ADDRESS OF ARGS
	MOVEM	T1,ERRPC		;SAVE ERROR PC
	HLLM	T2,ERRPC		;AND ERROR TYPE FLAG
	TLZ	T2,<FWRN+FTEL+FKIL>	;TURN OFF FLAGS
	ANDCAM	T2,ERRPC		;LEAVE ONLY FLAGS & ADDRESS IN ERRPC
	HRR	T2,0(A)			;RH T2 GETS TEXT ADDRESS
	MOVEI	T3,-1(T1)		;GIVE T3 ADDRESS OF THE CALL
	HRLI	T1,'MKL'		;GIVE ME AN IDENTITY
	HLR	T1,0(A)			;AND AN ERROR NAME
	PUSHJ	P,.ERMSA##		;DO THE MESSAGE
	TXNN	T1,JWW.FL		;WANT MORE?
	JRST	E$COM2			;NO.
	HLRZ	T3,1(A)			;GET TYPOUT ROUTINE (IF ANY)
	JUMPN	T3,[ PUSHJ P,.TSPAC##   ;TYPE A SPACE
		     MOVE  T1,N		;GET DATA
		     PUSHJ P,0(T3)	;DO THE ROUTINE
		     JRST .+1]		;AND BACK INTO LINE
	HRRZ	T3,1(A)			;ANY CONTINATION?
	JUMPE	T3,E$COM2		;NO, CONTINUE ON
	POP	P,A			;RESTORE A
	JRST	@ERRPC			;RETURN TO CALLER

E$COM2:	MOVE	T1,ERRPC		;RESTORE PC
	TLNE	T1,FTEL			;WANT TO CLOSE COMMENT?
	TTCALL	1,["]"]			;YES,DO SO
	HRRZ	T3,1(A)			;GET CONTINUATION FIELD
	POP	P,A			;RESTORE A
	JUMPN	T3,0(T3)		;IF SHORT FORM, JUMP AROUND MESSAGE
	PUSHJ	P,.TCRLF##		;END THE LINE
	TLNE	T1,FKIL			;WAS ERROR FATAL?
	JRST	RSTRT1			;YES,RESTART PROGRAM
	TXZ	F,FOTTY			;OFF WITH THE FLAG
	JRST	@ERRPC			;NO,SO CONTINUE
SUBTTL LONGER ERROR MESSAGES

MNFERR:	JUMPE	R,MNF2			;MODULE NOT FOUND, IF NO NAME
	MOVE	N,R			;LOAD N WITH RADIX50 NAME
	$KILL(MNF,Module,N$50,$MORE)
	MOVEI	T1,[ASCIZ/ was not found in file /]
	TXNN	F,FIXMOD		;IF NOT FIX MODE,ORDER
	MOVEI	T1,[ASCIZ/ was not found or incorrect order in file /]
	PUSHJ	P,.TSTRG##		;OUT
MNF1:	MOVE	T1,FPT			;GET POINTER TO SCAN STYLE BLOCK
	PUSHJ	P,.TFBLK##		;AND TALK ABOUT IT
DONERR:	PUSHJ	P,.TCRLF##	;
	JRST	RSTRT1

MNF2:	$KILL(NPS,No program names were specified for file ,,$MORE)
	JRST	MNF1

PEFERR:	MOVE	N,CUREDT		;PREMATURE EOF IN PATCH FILE
	$KILL(PEF,premature end-of-file during edit,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ/ in file /]
	PUSHJ	P,.TSTRG##
	MOVE	FPT,WLDTMP
	JRST	MNF1
FSIERR:	MOVE	N,[GETSTS 0,N]
	DPB	IOC,[POINT 4,N,12]
	XCT	N
	$KILL(FSI,<File status error on input (>,N$OCT,$MORE)
FSERR:	MOVEI	T1,[ASCIZ " ) for file "]
	PUSHJ	P,.TSTRG##	;
	JRST	MNF1		;TYPE OUT CURRENT FILE SPEC

FSOERR:	GETSTS	OCHN,N		;GET STATUS
	MOVE	FPT,OUTBEG	;SET UP REST OF MESSAGE
	$KILL(FSO,<File status  error on output (>,N$OCT,$MORE)
	JRST	FSERR

FSTERR:	MOVEI	IOC,TRIN	;TRANSACTION OR PATCH FILE ERROR
	MOVE	FPT,WLDTMP
	JRST	FSIERR

FSMERR:	MOVEI	IOC,MIN		;MASTER INPUT ERROR
	MOVE	FPT,INBEG
	JRST	FSIERR


IBTERR:	MOVE	N,B		;ILLEGAL BLOCK TYPE.
	$KILL(IBT,<Illegal block type (> ,N$OCT,$MORE)
	MOVEI	T1,[ASCIZ " ) was seen in file "]
	PUSHJ	P,.TSTRG##
	JRST	MNF1		;FINISH WITH CURRENT FILE

NECERR:	$KILL(NEC,Not enough core is available)

INSERR:	MOVE	N,CUREDT
	$KILL (SCE,Storage for patch code was exhausted in edit,N$SIX)

STOERR:	MOVE N,CUREDT
	$KILL(SSE,Storage for patch symbols was exhausted during edit,N$SIX)

MKMERR:	MOVE	N,R
	$KILL(MKM,,N$SIX,$MORE)
	MOVEI	T1,[ASCIZ/ pseudo-op in edit /]
	PUSHJ	P,.TSTRG##
	MOVE	T1,CUREDT
	PUSHJ	P,.TSIXN##
	MOVEI	T1,[ASCIZ/ without preceding .MODULE/]
	PUSHJ	P,.TSTRG##
	JRST	DONERR
STOPCD:	$KILL(IED,<Internal error detected:
 	>,N$STRG,$MORE)
	MOVEI	T1,[ASCIZ "
	 At location "]
	PUSHJ	P,.TSTRG##
	MOVE	T1,-1(P)		;GET PC OF ERROR
	SOS	T1			;CORRECT IT
	PUSHJ	P,OUTHW			;OUTPUT IT AS ADDRESS
	MOVEI	T1,[ASCIZ " in MAKLIB"]
	PUSHJ	P,.TSTRG##
	MOVE	N,@0(P)			;GET SIXBIT CODE
X$$IED:	JRST	DONERR		;
SUBTTL VARIOUS ERROR ROUTINES AND SMALL TYPE-OUT ROUTINES

PTYPO:	PUSHJ	P,.PSH4T##	;SAVE THE TEMPS
	PUSHJ	P,PTYPO1	;DO THE OUTPUT
	PUSHJ	P,.POP4T##	;RESTORE T1-T4
	POPJ	P,		;RETURN

PTYPO1:	MOVE	T2,T1		;GET NAME INTO TEMP
	MOVEI	T1, 6		;SIX CHARACTERS TO GET
	TLZ	T2,740000	;CLEAR CODE BITS
PTYPO2:	IDIVI	T2, 50		;CONVERT TO SIXBIT CODE
	HRLM	T3, (P)		;STORE CHARACTER ON PD LIST
	SOJLE	T1,.+2		;ALL DONE?
	PUSHJ	P, PTYPO2	;NO, DIVIDE SOME MORE
	HLRZ	T1, (P)		;POP CHARACTERS OFF STACK
	JUMPE	T1, CPOPJ	;IGNORE BLANKS
	CAILE	T1, 12		;LETTER OR NUMBER?
	ADDI	T1, 7		;LETTER - ADD 66
	ADDI	T1, 57		;NUMBER - ADD 57
	CAIE	T1, 135		;PERCENT SIGN?
	CAIN	T1, 134		;DOLLAR SIGN?
	SUBI	T1, 70		;YES, SPECIAL CASE
	CAIN	T1, 133		;PERIOD?
	SUBI	T1, 55		;YES, SPECIAL CASE
	PJRST	BOUT  		;RECURSIVE EXIT FOR MORE CHARS
CRLF:	PUSH	P,T1		;SAVE T1
	MOVEI	T1, 15		;CARRIAGE RETURN
	PUSHJ	P,BOUT  	;OUTPUT IT
	MOVEI	T1, 12		;LINE FEED
	PUSHJ	P,BOUT  	;OUTPUT IT 
	JRST	T1POPJ		;RESTORE T1 AND RETURN

; OUTPUT A FULL HALFWORD, USING 0 FILLERS

OUTHW:	PUSHJ	P,.PSH4T##	;SAVE TEMP ACS
	LSHC	T1,-22		;SET UP THE ACS
	MOVEI	T3,6		;NUMBER OF DIGITS TO OUTPUT
OUTHW1:	SETZ	T1,		;CLEAR T1
	LSHC	T1,3		;GET AN OCTAL DIGIT
	ADDI	T1,"0"		;MAKE ASCII FOR OUTPUT
	PUSHJ	P,BOUT  	;OUTPUT THE CHARACTER
	SOJG	T3,OUTHW1	;BACK FOR MORE?
	PUSHJ	P,.POP4T##	;RESTORE THE TEMPS
	POPJ	P,		;AND RETURN

TYPTAB:	SOSLE	TABCNT		;NEED A NEW LINE?
	JRST	TYPTB1		;NO
	PUSHJ	P,CRLF		;YES, OUTPUT ONE FIRST
	MOVEI	T4,TABS1-1	;RESET THE COUNT
	TXNE	F,DEVTTY
	MOVEI	T4,TABS2-1	;TTY
	MOVEM	T4,TABCNT	;AND STORE IT
TYPTB1:	PUSH	P,T1		;SAVE T1
	MOVEI	T1,11		;A TAB
	PUSHJ	P,BOUT  	;OUTPUT IT
	JRST	T1POPJ		;AND RETURN, RESTORING T1

RSTRT:	CLOSE	OCHN,		;CLOSE OUTPUT CHANNELS

RSTRT1:	TXO	F,FOTTY		;ENSURE TTY GETS CRLF
	PUSHJ	P,.TCRLF##	;OUTPUT IT
	JRST	MAKSCN		;SCAN NEXT COMMAND LINE
SUBTTL IMPURE CODE

	IFN DEBUG, <DHISIZ== .  >

IFN PURESW,<
HIGH:	PHASE	LOW>

INGET2:	IN	.-.,		;INPUT A BUFFER OF DATA
	JRST	GETIN1		;NO ERRORS
INGET3:	STATZ	.-., IO.EOF	;END OF FILE?
	JRST	POPOUT		;YES, HIGH LEVEL EXIT
	JRST	FSIERR		;ERROR

DIRIOW:	IOWD	200,DIRBLK	;IOWD FOR DIRECTORY INPUT
	0			;MUST BE IN LOW SEGMENT
IFN PURESW,<
LOWBLK:	DEPHASE>
SUBTTL STORAGE AND BUFFERS

IFN PURESW,<	RELOC LOW>
LOW:
IFN PURESW,<	BLOCK	LOWBLK-LOW>

PDLIST:	BLOCK	PD$LEN	;MASTER PUSH DOWN LIST
OFFSET:	BLOCK	1	;CCL OR REGULAR ENTRY FLAG TO SCAN
ERRPC:	BLOCK	1	;PC OF LAST CALL TO ERROR PROCESSOR

IFN DEBUG, <		;LOCATIONS FOR DEBUGGING
DEBFAI:	BLOCK	1	;NUMBER OF FAILURES DURING INTERNAL TESTS
DEBROU:	BLOCK	1	;POINTER TO ASCIZ NAME OF ROUTINE BEING TESTED
  > ;NFI DEBUG

ORGFF:	BLOCK	1	;ORIGINAL CONTENTS OF .JBFF
ORGPP:	BLOCK	1	;ORIGINAL PUSHDOWN POINTER
LSTFF:	BLOCK	1	;FIRST FREE AFTER LISTING OUTPUT BUFFERS

SCNBEG:			;START OF AREA THAT CLRANS CLEARS
TMAREA:	BLOCK	FSSIZE	;AREA FOR STORING NAMES
SWIWRD:	BLOCK	2	;PLACE FOR SCAN TO STORE SWITCH BITS FOR NON-ARG SWITCHES
WHO:	BLOCK	1	;VALUE OF /WHO SWITCH
INBEG:	BLOCK	1	;START OF INPUT FILE-SPECS
INEND:	BLOCK	1	;END OF INPUT FILE-SPECS (FROM SCAN)
OUTBEG:	BLOCK	1	;START OF OUTPUT FILE-SPECS
OUTEND:	BLOCK	1	;END OF OUTPUT FILE-SPECS
TMPMOD:	BLOCK	1	;TEMP STOREAGE FOR MODULE NAME
MCOUNT:	BLOCK	1
CURMOD:	BLOCK	1	;CURRENT MODULE READ IN
CUREDT:	BLOCK	1	;CURENT EDIT (/FIX) FOR ERROR MSG.
OPNBLK:	BLOCK	.RBSIZ+2+3	;OPEN UUO BLOCK
	LKPBLK=OPNBLK+3		;AND LOOKUP BLOCK (DEFINED AS TO NOT SEPARATE THEM)
BCKBLK:	BLOCK	.RBSIZ+2+3	;SAVED OUTPUT FILE SPECS
BCKFF:	BLOCK	2	;SAVED AND CURRENT JOBFF
WLDTMP:	BLOCK	1	;POINTER TO CURRENT TRANSACTION FILE
NAMCTR:	BLOCK	1
TNMCTR: BLOCK	1
;**;[31] SCNEND-1   ILG   20-JUL-76
BLKCNT:	BLOCK	1	;NUMBER OF BUFFERS OUTPUT

SCNEND:			;END OF AREA THAT CLRANS CLEARS ON EACH COMMAND

SAVEAC:	BLOCK	1	;SAVE C (POINTER TO ENTBLK)
SAVEBT:	BLOCK	1	;SAVED BLOCK TYPE
SAVEP:	BLOCK	1	;SAVED PUSHDOWN POINTER
ENTBLK:	BLOCK	SIZE+6	;PLACE TO SAVE LINK ITEM TYPE 'ENTRY BLOCK'
				;SVEBLK AND TRCBLK OVERLAP
				;BECAUSE NEVER USED AT SAME TIME
IFN FTBPT,<
	ZZ==TRCMAX+2*<TRCMAX+21>/22	;REQUIREMENTS FOR TRACE BLOCK STOREAGE
> ; NFI FTBPT
IFE FTBPT, <ZZ==0>

	IFG <SIZE+6>-ZZ,<ZZ==SIZE+6>	;IF ENTRY BLOCK MAX LARGER,USE THAT
TRCBLK:
SVEBLK:	BLOCK	ZZ
	TRCLST==.-1			;LAST LOCATION AVAILABLE FOR TRACE STORAGE
IFN FTBPT,<
TRCPTR:	BLOCK	1	;POINTER TO CURRENT STATIC AREA
TRCVAP:	BLOCK	1	;POINTER TO CURRENT LOCATION IN VARIABLE AREA
> ;NFI FTBPT
OBUF:	BLOCK	3	;IO HEADER FOR OUTPUT
MBUF:	BLOCK	3	;INPUT BUFFER HEADER FOR MASTER FILE
TBUF:	BLOCK	3	;INPUT BUFFER HEADER FOR TRANSACTION FILE
IBUF1:	BLOCK	1	;ADDRESS OF CURRENT BYTE COUNTER
IBUF2:	BLOCK	1	;ADDRESS OF CURRENT BYTE POINTER
DSKHDR:	BLOCK MTBSIZ+2	;TWO WORDS OF OVERHEAD [P,P]+EXT
	DIRBLK=DSKHDR+2
	DIRNAM=DIRBLK+123	;FILENAMES IN DTA DIRECTORY START HERE

JBFSAV:	BLOCK	1		;[67] TO SAVE .JBFF AROUND INBUF
BSZ:	BLOCK	1	;SIZE OF OLD SYMBOL BLOCK
PTGRS:	BLOCK	1	;PTGR SAVED
PTSRS:	BLOCK	1	;PTSR SAVED
RELOCS:	BLOCK	1	;ORIGINAL RELOC
SYMBLK:	BLOCK	^D20	;NEW SYMBOL BLOCK (ALSO AC STORAGE FOR SYMSRC)
XCOUNT:	BLOCK	1
XPNTR:	BLOCK	1
BUFSIZ:	BLOCK	1
XBEG:	BLOCK	2
END1:	BLOCK	1	;FIRST WORD OF END BLOCK
END2:	BLOCK	2	;SECOND WORD OF END BLOCK
TABCNT:	BLOCK	1	;COUNTS TABS LEFT FOR THIS LINE
NAMSAV:	BLOCK	1


;; CONDITIONAL STOREAGE FOR BINARY PATCHING TOOL

IFN FTBPT,<		;DONT ALLOCATE IF NOT INCLUDED
FIXXP:	BLOCK	1	;PUSHDOWN POINTER ON ENTRY TO FIX PROCESSOR
CRADIX:	BLOCK	1	;CURRENT DEFAULT INPUT RADIX (MACRO)
DECNUM:	BLOCK	1	;SIMULTANEOUSLY BUILT RADIX 10. NUMBER (MACRO)
NULFLG:	BLOCK	1	;-1 IF STATMENT GENERATES NO CODE (MACRO)
PRGINC:	BLOCK	1	;-1 WHEN A PROGRAM IS IN BUFFER
BARFLG:	BLOCK	1	;-1,0,+1 FOR INSERT BEFORE,REPLACE,AFTER
SAVCOD:	BLOCK	1	;INSTR REPLACED BY "JUMPA PATCH-CODE"
SAVREL:	BLOCK	1	;SAVED RELOCATION FOR ABOVE INSTRUCTION
CPPART:	BLOCK	1	;PART OF CURRENT PATCH
CPSFLG:	BLOCK	1	;-1 IF PATCH IN LOWSEG,0 FOR HISEG
CPADDR:	BLOCK	1	;ADDRESS TO WRITE NEXT PATCH CODE WORD INTO
CPRET:	BLOCK	1	;PC TO RETURN TO AFTER PATCH
CPREPI:	BLOCK	1	;SPECIFIC NUMBER OF LOCATIONS TO SKIP ON RETURN FROM PATCH
CPINST:	BLOCK	1	;NUMBER OF INSTRUCTIONS IN CURRENT PATCH
MACBUF:	BLOCK	<MACSIZ+4>/5+1	;PLACE TO PUT MACRO CODE
	MACLST==.-1	;LOCATION OF TERMINATING ZERO WORD
MACCNT:	BLOCK	1	;COUNT OF CHARACTERS LEFT
MACPTR:	BLOCK	1	;BYTE POINTER TO MACBUF
MACSV1:	BLOCK	1	;SAVED POINTER FOR RESCAN
MACSV2:	BLOCK	1	;ALSO SAVED FOR RESCAN, THE COUNT
REOL:	BLOCK	1	;"REAL" BREAK CHARACTER REPLACED BY MIC WITH $EOL VALUE
COMDON:	BLOCK	1	;TEMP FLAG FOR CODE COMPARE ROUTINE
WRDCNT:	BLOCK	1	;COUNT OF WORDS IN STRING,AFTER 1ST ONE
EVLPP:	BLOCK	1	;PDL POINTER AT ENTRY TO EVAL
LLABEL:	BLOCK	1	;R50 LAST LABEL MACRO PROCESSOR SAW
LLOFF:	BLOCK	1	;OFFSET SINCE LAST LABEL
R%V:	BLOCK	1	;EVALS RETURNS VALUE HERE
R%R:	BLOCK	1	;EVALS RETURNS RELOCATION HERE
R%S:	BLOCK	1	;EVALS RETURNS PTRS TO IST HERE
R%F:	BLOCK	1	;EVALS RETURNS FLAGS HERE
ASGSYM:	BLOCK	1	;RADIX50 SYMBOL+FLAGS TO ASSIGN VALUE TO
IFIDX:	BLOCK	1	;INDEX INTO IFXX CONDITIONAL TABLE
NSTLVL:	BLOCK	1	;CURRENT DEPTH IN CONDITIONAL PROCESSING
OPRSTK:	BLOCK	OPRSIZ	;BLOCK FOR STACKING OPERANDS
OPTSTK:	BLOCK	OPTSIZ	;BLOCK FOR STACKING OPERATORS
OPRPTR:	BLOCK	1	;SAVED PDL POINTER TO OPERANDS
OPTPTR:	BLOCK	1	;SAVED PDL POINTER TO OPERATORS
OPRTOP:	BLOCK	1	;IN CURRENT FRAME,TOP OF OPERAND STACK
OPTTOP:	BLOCK	1	;SAME FOR OPERATORS
SAVCHR:	BLOCK	1	;PLACE TO SAVE CHARACTER IN AC CC
SAVEA:	BLOCK	1	;PLACE TO SAVE ACS FOR REPEATED EDIT SEARCH
SAVEB:	BLOCK	1
SAVEC:	BLOCK	1
SAVED:	BLOCK	1
FMZLOC:		;AREA TO ZERO WHEN NEW PROGRAM READ IN
			;DO NOT SEPARATE TO LMZLOC
SPCLOC:	BLOCK	1	;POINTS TO FIRST WORD OF 1ST PROGRAM CODE BLOCK
SSTLOC:	BLOCK	1	;SAME AS ABOVE,FOR SYMBOL BLOCKS
HSILOC:	BLOCK	1	;SAME AS ABOVE FOR HI-SEGMENT BLOCK TYPE
STBLOC:	BLOCK	1	;SAME AS ABOVE , FOR TRACE TYPE BLOCK
PSLOC:	BLOCK	1	;FIRST WORD USED FOR STORING REL FILE
PELOC:	BLOCK	1	;LAST WORD USED FOR STORING REL FILE
EPCLOC:	BLOCK	1	;LOCATION OF LAST WORD IN YANKED REL FILE
ESTLOC:	BLOCK	1	;LOCATION OF LAST WORD OF LAST YANKED SYMBOL BLOCK
ETBLOC:	BLOCK	1	;LOCATION OF LAST WORD OF LAST YANKED TRACE ITEM
VERBLK:	BLOCK	4	;PLACE TO CREATE CODE BLOCK FOR VERSION  NUMBER
SEB:	BLOCK	4	;PLACE TO PUT END LINK ITEM OF YANKED PROGRAM
LSYMHW:	BLOCK	1	;POINTS TO LAST HEADER WORD IN SYMBOL AREA
LCODHW:	BLOCK	1	;LAST CODE BLOCK HEADER WORD
LCADDR:	BLOCK	1	;LAST NEW CODE WORD ADDRESS
CREPTR:	BLOCK	1	;POINTER TO CURRENT WORD IN SYMBOL BLOCK
PATPTR:	BLOCK	1	;POINTER TO CURRENT WORD IN CODE BLOCK
CBHEAD:	BLOCK	1	;AOBJN PTR TO TYPE 1 INDEX TABLE
CBINIT:	BLOCK	1	;NUMBER OF CODE BLOCKS READ IN
NCBNUM:	BLOCK	1	;NUMBER OF NEW CODE BLOCKS ADDED
SBHEAD:	BLOCK	1	;AOBJN PTR TO TYPE 2 INDEX TABLE
SBINIT:	BLOCK	1	;NUMBER OF SYMBOL BLOCKS READ IN
NSBNUM:	BLOCK	1	;NUMBER OF NEW SYMBOL BLOCKS ADDED
PBHEAD:	BLOCK	1	;NUMBER OF POLISH FIXUP BLOCKS READ IN
PBINIT:	BLOCK	1	;NUMBER OF POLISH BLOCKS READ IN
NPBNUM:	BLOCK	1	;NUMBER OF CREATED POLISH BLOCKS
PBLAST:	BLOCK	1	;LAST POLISH BLOCK EXAMINED
IST:	BLOCK	2*ISTMAX ;INTERIM SYMBOL TABLE
	ISTLST==.-1	;LAST LOCATION OF ABOVE
ISTMAP:	BLOCK	<ISTMAX+^D35>/^D36	;MAP FOR IST
ISTALT:	BLOCK	<ISTMAX+^D35>/^D36	;SAVED MAP OF IST
	LMZLOC==.-1

> ; NFI FTBPT		;END OF CONDITIONAL AREA FOR BPT

LOWTOP:	IFN PURESW,<	RELOC>

	END	MAKLIB