Google
 

Trailing-Edge - PDP-10 Archives - BB-H138B-BM - language-sources/macro.mac
There are 45 other files named macro.mac in the archive. Click here to see a list.
TITLE MACRO %53A(1152)	19-JUL-1979
SUBTTL EDIT BY MCHC/JBC/EGM

;COPYRIGHT (C) 1968, 1979 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.

	VMACRO==53		;VERSION NUMBER
	VUPDATE==1		;DEC UPDATE LEVEL
	VEDIT==1152		;EDIT NUMBER
	VCUSTOM==0		;NON-DEC UPDATE LEVEL


	LOC <.JBVER==137>
	<VCUSTOM>B2+<VMACRO>B11+<VUPDATE>B17+VEDIT
	RELOC

COMMENT * ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)

	SWITCHES ON (NON-ZERO) IN DEC VERSION
PURESW		GIVES TWO SEGMENT MACRO
CCLSW		GIVES RAPID PROGRAM GENERATION FEATURE
TEMP		TMPCOR UUO IS TO BE USED
FORMSW		USE MORE READABLE FORMATS FOR LISTING (ICCSW)
DFRMSW		DEFAULT CONDITION OF FORMAT PRINTING (MULTI-FORM IF ON)
KI10		GIVES KI10 OP-CODES
KL10		GIVES KL10 OP-CODES
POLISH		GIVES EXTERNAL ARITHMETIC EXPRESSIONS

	SWITCHES OFF (ZERO) IN DEC VERSION
FTPSEC		GIVES .PSECT PSEUDO-OPS AND PSECT MULTIPLE RELOCATION COUNTERS
STANSW		GIVES STANFORD FEATURES
LNSSW		GIVES LNS VERSION
IIISW		GIVES III FEATURES
OPHSH		GIVES HASH SEARCH OF OPCODES
F40		GIVES F40 UUOS
TOPS20		PROCESSES LONG FILES, REMOVES TOPS10 SYMBOLS
TSTCD		GIVES LINK DEBUGGING SAND DEVELOPMENT DIRECTIVES

	OTHER SWITCHES
UUOSYM		DEFINES TOPS10 UUO'S, CALLI'S, TTCALL'S
*
SUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS

   IFNDEF PURESW,<PURESW==1>

   IFNDEF STANSW,<STANSW==0>
   IFN STANSW,<CCLSW==1>

   IFNDEF LNSSW,<LNSSW==0>

   IFNDEF CCLSW,<CCLSW==1>

   IFNDEF TEMP,<TEMP==1>


   IFNDEF IIISW,<IIISW==0>
   IFN IIISW,<
   IFNDEF DFRMSW,<DFRMSW==0>>

   IFNDEF DFRMSW,<DFRMSW==1>
   IFN DFRMSW,<FORMSW==1>

   IFNDEF FORMSW,<FORMSW==1>

   IFNDEF OPHSH,<OPHSH==0>

   IFNDEF KI10,<KI10==1>
   IFNDEF KL10,<KL10==1>
   IFN KL10,<KI==1>

   IFNDEF POLISH,<POLISH==1>

   IFNDEF F40,<F40==0>
   IFNDEF TOPS20,<TOPS20==0>
   IFNDEF UUOSYM,<UUOSYM==^-TOPS20>

   IFNDEF FTPSEC,<FTPSEC==1>
   IFN FTPSEC,<POLISH==1>

   IFNDEF TSTCD,<TSTCD==0>

;DEFAULT LISTING CONTROL DIRECTIVES
.DIRECTIVE FLBLST
SUBTTL REVISION HISTORY

;START OF VERSION 53
;552		DON'T SEARCH UNIVERSALS WHEN PROCESSING LABEL,FOO##,END,
;		EXTERN,OPDEF,ASSIGN,SYN,INTEGER,ARRAY,.COMMON,& DEFINE.
;553	(22193)	FLAG NON-SIXBIT IN SINGLE-QUOTE STRINGS WITH Q-ERROR
;554	(10382)	DON'T REPLACE ^Z WITH LF UNLESS INPUT DEV IS TTY
;555	(10202)	WARN USER IF CODE STORED BEFORE .COMMON
;556	(22425)	ALLOW LEADING NUMERIC CHAR IN ARGUMENTS TO "SEARCH"
;557	(22491)	GENERATE -X (WHERE X IS RELOCATABLE) PROPERLY
;560	(22488)	PLACE ALL OCCURENCES OF FLAGS 'INASGN','INANGL' UNDER POLISH FEATURE TEST
;561	(22490)	GENERATE -1^!X (WHERE X IS RELOCATABLE) PROPERLY
;562	(22544)	FIX PAGE OFFSET AFTER PRGEND
;563	(22495)	FIX ;; COMMENTS LISTING WHEN DEFINED UNDER LALL
;564	(22493)	PREVENT "IO TO UNASSIGNED CHANNEL" ERROR AFTER "?POLISH TOO COMPLEX" ERROR MESSAGE
;565	(22489)	PREVENT TERMINAL WAIT AFTER PRGEND AFTER BEING DETACHED OR CCONTED
;566	(22498)	REMOVE EDIT 531; BROKE LISTING OF EMBEDDED MACRO CALLS UNDER XALL
;567	(22500)	ENHANCEMENT EDIT/REQUEST REL:HELPER,LC SYMBOL TYPES,U-LC MONTHS
;570	(10570)	PREVENT E-ERRORS AFTER PURGE OF UNDEF OR EXT SYMBOL
;571	(22676)	FORCE HISEG TO START ON PAGE BOUNDARY, NOT K-BOUNDARY
;572	(22748)	REPLACE EDIT 556 BY ALTERNATE EDIT ACCOMPLISHING SAME PURPOSE
;573	(22321)	FIX LOC/RELOC IN TWOSEG RELOC PROGRAMS
;574	(22501)	ADD "ILLEGAL SYNTAX IN MACRO DEFINITION" ERROR MESSAGE
;575	(22492)	PUT ALL PSECT-RELATED CODE UNDER FTPSECT SWITCH
;576	(22485)	FIX LABEL+OFFSET ACROSS SEGMENTS, AND WHEN OFFSET > 1000
;577	(22187)	FIX LISTING OF MACRO EXPANSION WITH ERRORS UNDER SALL
;600		TURN ON FTPSEC
;601		FIX TAGS IN LIT USED WITH PSECTS
;602		ALLOW .PSECT/.ENDPS IN LIT
;603		FORCE EXPRESSION EVALUATION IN CONDITIONAL.
;604		COMMENT OUT 1LINE @BOUT20+5 (NEEDS RE-WORK)
;605		FIX BUG WITH WRONG RELOC VALUE FOR PSECT @%SWSG2+6
;606		E-ERROR IF FOO##=EXP @ASSIG3+6
;607		GENERATE A WORD OF 0 FOR [SIXBIT\\] @SIXB20+
;610		DO EXPRESSION OF POLISH SYMBOLS FROM UNV IN PASS2 @EVNUM+
;611		ALPHABETIZE .IF/.IFN ATTRIBUTE TABLE.
;612		FIX BUG WITH "IOWD A##,FOO" WHEN USED WITH PSECT
;613		STORE CURRENT RADIX IN CURADX AND FREE UP RX AS FRR.
;614		OUTPUT "#" IN BINARY LISTING TO INDICATE POLISH FIXUP.
;615		OUTPUT NUMBER OF PAGES USED INSTEAD.
;616		DON'T ALLOW POLISH FOR "BLOCK" & "RELOC" PSEUDO-OPS.
;617		DON'T MAKE LTAGF SYMBOLS EXTERNALS AT END OF PASS1.
;620		Q-ERROR IF EXTERNALS PURGED.
;621		ADD .IF FOO,REFERENCED,<...>
;622		FIX BUG WITH OUTPUTTING "#"
;623		ALLOW EXPRESSIONS OF EXTERNALS AND PSECT-SYMBOLS.
;624		ALLOW POLISH WITH OPDEF
;625		GENERATE POLISH FWF FOR [A##]
;626		ADD .IF FOO,NEEDED,<...>
;627		UPDATE KL INSTRUCTIONS
;630		MORE ON EDIT 625 TO CHECK FOR LH=0,INDIRECT,INDEX,& POLISH
;631		GENERATE A SET OF BLOCK23'S BEFORE ALL THE SYMBOLS
;632		(SAME AS 577)
;633		OUTPUT "#" AND "*" FOR ASSIGNMENTS AND SYMBOL TABLES.
;634		ALLOW  "A FOO##+1(1)".
;635		ADD SPECIAL CHARS \' AND \" IN A MACRO CALL.
;636		ALLOW POLSH AND INDEXING
;637		DON'T DO FWF FOR OPDEF A[B##]
;640		SAVE AC FR ON STACK BEFORE DOING EXPONENT IN NUMBER PROCESSING.
;641		CHECK FOR PSECT WHEN DOING FWF @OCTFW+
;642		SET PSECT INDEX TO 0 BEFORE GENERATING BLOCK 5
;643		FIX BUG WITH F00##(1)
;644		FIX BUG WITH EXP FOO##,FOO##,FOO##
;645		FWF FOR UNDEFINED SYMBOL IN OPERATOR FIELD.
;646		ILLEGAL TO USE PRGEND WITH PSECT, TREAT IT AS END
;647		OUTPUT PSECT INDEX IN LISTING
;650	(22327) FIX DISAPPEARING MACRO CALLS WITH FF UNDER SALL
;651	(22226)	FIX VARIETY OF LISTING BUGS TIED TO ERROR-FLAGGING
;652	(22999)	FIX "ENTRY FOO" WHERE FOO IS ALSO AN OPDEF
;653	(22497) FLAG "VERSION SKEW" IF OLD-STYLE UNV WITH SYN
;654		FIX TYPOGRAPHICAL ERROR IN PUBLISHED EDIT 564
;655	(22482)	FIX TOO MANY LINES/PAGE WITH XLIST INSIDE SALL MACRO
;656	(22499)	FIX "?ILL MEM REF" WHILE EXPANDING MACRO CALLS WITH EMBEDDED COMMAS
;657	(Q1382)	EXTEND NEW MACRO ARG HANDLING TO PARENTHESIZED ARG STRING
;660	(23098)	RESTORE IFE/IFN A## HANDLING TO OLD (PRE-52) WAY
;661	(22515)	PREVENT ILL MEM REF ON UNCLOSED TEXT IN MULTI-LINE ASSIGNMENT
;662		SIMPLIFY EDIT 561
;663	(23170)	FIX LOST ERRORS IN PASS1 DURING LINE "IMAGE" TYPEOUT
;664		SPEED AND EFFICIENCY ENHANCEMENTS;ROUTINES:GETCHR,PRINT,CHARAC,READ1A
;665	(23246)	DON'T TREAT LEADING COMMAS AS SEMICOLONS
;666		FIX VARIOUS BUGS TIED TO "LABEL+OFFSET" TYPEOUT
;667		FIX BAD ASCIZ IN LITERALS (SIDE-EFFECT OF EDIT 661)
;670		ALLOW .NODDT OF OPDEF (I.E. .NODDT PJRST,CALL,ETC.)
;671		REMOVE EDIT 657 (I.E. TAKE FAMILIAR PATH OF LEAST RESISTANCE
;		WITH REGARD TO EXISTING PROGRAMS)
;672		IGNORE REDUNDANT SEARCH ARGS, ADD "SEARCH TABLE OVERFLOW" ERROR MESSAGE
;673	(Q1286)	LIST CRLFS IN PARENTHESIZED MACRO ARGS CORRECTLY
;674		GIVE E-ERROR FOR EXTERNAL ARRAY NAME
;675		HANDLE INTERN OF MIXED ARG TYPES CORRECTLY
;676		PREVENT THE USE OF ARGUMENTS < 4 TO /NNL
;677		ALLOW .IF EXPRESSION,QUALIFIER<CODE> (OMITTING COMMA)
;700		ALTER "CORE ALLOCATION PROBLEM" ERROR MESSAGE, FORCE
;		REALLOCATION UNLESS /U (MEMORY-RESIDENT UNIVERSALS)
;701		FLAG NON-SIXBIT IN SIXBIT PSEUDO-OP CORRECTLY, TERMINATING STRING
;702		REPLACE MBR,MBC,MBI MESSAGES WITH ISR,ISC,ISI (SYNTAX CHECKS)
;703	(22939)	HANDLE COMPLEX FORWARD REF OF SYM WHERE SYM=POLISH CORRECTLY
;704		FIX BAD CREF OUTPUT WHEN LISTING MACRO ARGS W/CRLFS AND "\"
;705	(23527)	FIX ILL MEM REF WITH IFX <POLISH SYMBOL> (SIDE EFFECT OF 660)
;706	(22484)	MAKE <LH,,POLISH>,<POLISH,,RH>,<POLISH,,POLISH> WORK
;707		FIX BUG WITH LITERAL PC WHEN DOING PSECT CHANGES AT END.
;710		GET CORRECT RELOCATION WHEN EVALUATING "!".
;711		ENTER PSECT-NAMES AS EXTERNAL SYMBOLS.
;712		COLLAPSE 2 INSTRUCTIONS INTO EXTRN2 ROUTINE
;713		MOVE NO UNV SEARCH FLAG INTO AC FRR.
;714		RESET SYMBOL TABLE POINTER WHEN A TAG HAS OTHER USE IN DIFF PSECTS
;715		SEARCH ONLY CURRENT SYMBOL TABLE IN LOOKING FOR VARS.
;716		RESET REL1P POINTER AT PASS INITIALIZATION
;717		BUG FIX WITH PSECT OUTPUT FORMAT
;720		FLAG .DIREC NO NO ARG WITH Q-ERROR
;721		FIX BUG IN EDIT 573 WITH RELOC/RELOC/LOC/RELOC ARG
;722	(10945)	FLAG IOWD A,B WHERE A IS RELOC WITH R-ERROR
;723	(10929)	FIX TRUNCATING OR GARBLING OF LONG PRINTX TEXT
;724	(23826)	GIVE "UNASSIGNED" ERROR MESSAGE FOR UNDEFINED SYMBOLS
;		WITH UNRESOLVED 36BIT VALUES (E.G. B=B+1000000).
;725	(23588)	DON'T COLLAPSE LITERALS WHICH CONTAIN LABELS.  THIS EDIT
;		SHOULD BE REMOVED WHEN A FACILITY IS ADDED TO UPDATE
;		LABEL VALUES AFTER LITERAL POOLING.
;726		IMPLEMENT "LTL LITERAL TOO LONG" ERROR MESSAGE.
;727		GENERATE CORRECT POLISH FOR -<POL>.
;730		GENERATE CORRECT POLISH FOR <IOWD POL,POL>
;731	BBN	BUG FIX WITH GETCHR
;732		INCLUDE S-ERROR IN DEFINITION OF ERRORS.
;733	(24065)	FIX BAD ENTRY BLOCK CAUSED BY BAD SEARCH/ENTRY INTERACTION
;734	(23987)	HANDLE NEGATIVE RELOCATION CORRECTLY WITH POLISH
;735		ALLOW FORWARD-REF OF TAGS IN LIT(GENERATE 10-BLOCKS).
;736		FIXUP SYMTAB AFTER FORWARD-REF TO USER-DEFINED OPERATOR.
;		(MACRO,OPDEF,SYN)
;737		FIX BUG WITH THE NEW IOWD CODE.
;740		CHECK FOR NON-REFERENCED LITERAL TAGS.
;741		A-ERROR WHEN LH-TRUNCATED WITH RELOC.
;742		VARF (TREF) USED WITH LTAGF MEAN TAG REFERENCED
;743		SUPPRESS PASS1 IFX V-ERROR.
;744	(Q2191)	MAKE SURE LTGSW GETS CLEARED EACH TIME.
;745		CHECK FOR SPTR BEFORE UPDATE IN ASSIGN.
;746		GIVE ERRMSG WHEN MRP POINTS TO 0 DUE TO MACRO EXPANSION ERR.
;747		GENERATE CORRECT POLISH FOR <E,,K>,<K,,E>, & <E,,E>.
;750		FIX BUG WITH @POL(K).
;751		<POINT K,POL,POL> TO USE ANGFP ROUTINES.
;752		RESOLVE EDITS 736 &675 CONFLICT IN OPDEF HANDLING.
;753	(18606)	PREVENT EXTRA LINE LISTING WITH FF INSIDE REPEAT 0 OR
;		FAILING CONDITIONAL.
;754	(22804)	CLEAR XLIST AFTER END/PRGEND (DOESN'T AFFECT LITS,ETC.).
;755	(22442)	OUTPUT TITLE ".MAIN" FOR UNTITLED PRGEND MODULES DURING RPG ASSEMBLY.
;756		(24473)	FIX TOO FEW LINES/LISTING-PAGE WITH PRINTX
;757(REMOVED)	MAKE SURE ^- HAS HIGHER PRECEDENCE OVER BINARY OPERATORS.
;760		OUTPUT BINARY ON BLOCK STATEMENT IN A LONG LINE INSIDE MACRO.
;761	(Q2201)	FIX BUG IN EOUT THAT GENERATED WRONG COUNT FOR BLOCK 4.
;762	(Q2204)	E-ERROR FOR BYTE (N)...POL... WHERE N .NE. ^D36.
;763	(Q2211)	GENERATE BLOCK22 WITH SYMBOL TABLE INSTEAD OF BLOCK23.
;764		CHECK FOR INTERNAL OPDEF AT IFDEF.
;765	(Q2195)	DON'T GENERATE EMPTY ENTRY BLOCK.(REMOVED)

;766		SAME AS 761
;767	(Q2185)	RE-DO CALCULATION OF RC IN EVADR
;770	(Q2210)	FIX BUG WITH FLAGGING MULTIPLY DEFINED TAGS IN DIFFERENT PSECTS.
;771		TEST FOR NOPSW AT CLOSING ANGLE BRACKET
;772		FIX BUG WITH REFERENCING POLISH OPDEF
;773		REPLACE EDIT 747
;774		MAKE LABEL+OFFSET HANDLING CONSISTANT
;775	(Q2200)	CHECK CPU VALUE BEFORE  TYPEOUT OF SIZE INFO.
;776		DON'T DO PSECT CHECK FOR PHASED LABEL.
;777		ALLOW BYTE(18) OF POLISH IF HALF WORD ALIGNED.
;1000		ADD 2 CELLS FOR BUILDING OPDEF CODE TO AVOID PROBLEM WITH NESTED LITERALS.
;1001		DON'T LET MACRO EXPANSIONS CHANGE LABEL+OFFSET SETTINGS.
;1002 (Q2235)	DON'T STORE UNV NAME UNTIL IT'S VERIFIED.
;1003 (24751)	MAKE FF LIST CORRECTLY (SUPERSEDES EDIT 753)
;1004		MINOR SOURCE CHANGES: TABS IN LONG LINE, PAGE, ETC.
;1005		DON'T GENERATE GLOBAL REQUEST FOR A SYMBOL WHERE SYMBOL=UND.
;1006		SAVE INOPDF @SQBRK+ TO ALLOW LITERAL IN OPDEF DEFINITION.
;1007		GIVE EPP MESSAGE DUE TO TYPOS CAUSING ILLEGAL POLISH.
;1010		ADD A WORDS TO DIFFERENCIATE <0,,POL> WITH <POL>
;1011	(Q2276)	SAVE INOPDF @ANGLB+ TO ALLOW NESTED <...> IN OPDEF DEFINITION.
;1012		RECOVER EXTPNT IF NEEDED AT OP3.
;1013		MOVE LEFT POLISH TO FREE SPACE BEFORE STORING THE PTR IN XWDANG.
;1014		ALLOW ENTRY,INTER STATEMENTS TO APPEAR IN DIFF. PSECT THEN THE TAG.
;1015		FIX BUG WITH SETTING UP CORRECT MP FOR MACROS NEXTED IN CONDTIONALS.
;1016		DEFINE A RELOCATABLE PSECT BIT FOR PSECTS WITH NO FIXED ORIGIN.
;1017		CARRY UNDEFINED BIT ACROSS ASSIGMENT DURING PASS1.
;1020		MODIFY BLOCK 22'S AND BLOCK 23'S AND ADD BLOCK 24'S.
; MACRO 53 RELEASE IN SPRING 1978
;START OF VERSION 53A
;FOLLOWING 3 PATCHES ARE DOCUMENTED IN THE MACRO 53 BWR FILE
;1021		WHEN MULTIPLE .PSECT STMNTS EXIST FOR THE SAME PSECT, ORIGIN NEED ONLY BE IN ONE.
;1022		IN ARRAY PSEUDO OP, ALLOW UNV-SEARCHING OF SYMBOLS USED IN DIMENSION ARGUMENT.
;1023		CORRECT ASSEMBLY OF STMNTS LIKE: "FOO=IFNB <>,<BAR=5>".
;1024		SOME CLEANUP
;1025		DON'T GO POLISH CALCULATING "REPEAT" COUNT
;1026		FIX BUG CAUSED BY EDIT 1010 ( <POINT K,POL> )
;1027		MAKE SURE UOUT ROUTINE SEARCHES ALL PSECT SYMBOL TABLES.
;1030		AC0 TO AC2 IN PART OF EDIT1021; CAUSE P-ERROR IN PSECT PROGAM
;1031		TURN OFF FLAG IN RC TO INDICATE UNDEF IN LITERAL IN STOLIT 
;1032	(25358)	FIX .XTABM WITH PARENTHESIZED MACRO CALL ARG LISTS
;1033	(25358)	CLEAR MACMPD AND .XTABM/.ITABM SETTINGS ACROSS PASSES
;1034	(25555)	FIX FATAL ERRORS CAUSED BY BAD RECOVERY FROM N-ERRORS.
;1035	(26078)	FIX OPDEF WITH TEXT PSEUDO-OPS AND INSIDE LITS (REWORK
;		EDIT 1000)
;1036		UP CTLSIZ TO 1000 CHARACTERS
;1037		ADD CODE TO USE FORCEP FOR <POLISH>B<EXP> WHEN NOT IN LARGER EXP.
;1040		MOVE EMBEDDED POLISH INTO FREE SPACE WHEN DOING POLPSH.
;1041		ADD .DIRECTIVE .NOUUO
;1042		CALCULATE TOTAL SYMBOL COUNT BEFORE TURNING ON ATTRIBUTE BITS
;		(MOVE EDIT 1021 ONE INSTRUCTION LOWER AND REMOVE EDIT 1027)
;1043		CHANGE .DIRECTIVE .NOUUO TO .DIRECTIVE .NOCALLIS
;1044	(25015)	FIX BAD LOAD-TIME RELOCATION FOR EXPRESSIONS OF THE FORM
;		"A+B" OR "A-B" WHERE A OR B IS RELOCATABLE.
;1045	(25581)	PRESERVE SYMBOL CHARACTERISTICS ACROSS NESTED
;		ASSIGNMENTS (E.G., A==:<B==2>)
;1046	(11716)	FIX "ILL MEM REF" TO ADDR 777777 DUE TO BAD MACRO
;		CALL SYNTAX
;1047		MAKE EXPRESSIONS OF THE FORM <A##,,POLISH> WHERE POLISH
;		IS A POLISH EXPRESSION ASSEMBLE CORRECTLY
;1050		FIX "?MCREPP" ERROR DURING PROCESSING OF EXPRESSIONS
;		WITH COMPLEX EXTERNAL LEFT HALVES (E.G., <EXT##+1,,0>)
;1051		FIX "?ILL MEM REF" AFTER "?MCREPP" (EXPAND EDIT 1007)
;1052	(26137)	FIX "?ILL MEM REF" WITH LARGE PRGENDED FILES
;1053		GENERATE X-ERROR IF EXCEEDED MAX OF CREATED SYMBOL (..7777);
;		START OVER FROM ..0000 RATHER THAN CREATING ./0000
;1054	(25910)	GIVE UNARY OPERATORS PRECEDENCE OVER SHIFT OPERATORS AND
;		LOGICAL OPERATORS.
;1055	(26428)	DON'T GENERATE POLISH FOR REL-ABS IN SINGLE-SEGMENT,
;		NON-HISEG, NON-PSECT PROGRAM.
;1056	(25357)	MAKE MACRO MORE FLEXIBLE IN HANDLING ANGLE-BRACKETED
;		ARGS TO .IF/.IFN; IMPLEMENT "EXPRESSION" ATTRIBUTE.
;1057	(12055)	RESTORE CORRECT .PSECT/.ORG INTERACTION IN WAKE OF EDIT 573
;1060	(25477)	IMPROVE "?MCRPTC POLISH TOO COMPLEX" ERROR MESSAGE BY
;		APPENDING "FOR SYMBOL XXXXXX" OR "FOR LOCATION XXXXXX"
;1061	(25715)	RE-DO "ERROR WHILE EXPANDING" ERROR-TRAPPING (SUPERSEDES
;		EDITS 1046,746)
;1062	(25907)	FIX LISTING OF LIT INSIDE SALL MACRO EXPANSION
;1063	(25777)	MAKE .XCREF, .CREF WORK INSIDE LITERALS
;1064	(25777)	FIX LISTING OF LALL INSIDE SALL MACRO
;1065	(25777)	MAKE LALL, XALL, SALL, LIST, XLIST, .DIREC WORK INSIDE
;		LITERALS (REQUIRES EDIT 1064)
;1066	(25838)	MAKE MACRO OBSERVE THE SETTINGS OF MESSAGE LEVEL BITS DURING
;		ERROR MESSAGE TYPEOUT (SEE GETTAB 35 MONITOR TABLE)
;1067	(26529)	BYTE PSUEDO OP SPECIFYING EXTERNALS ON OTHER THAN FULL OR HALF
;		WORD BOUNDARIES PRODUCES EPP ERRORS AND ILL MEM REF.
;1070	(26571)	CORRECTLY INDICATE EXTERN/INTERN CONFLICTS AS E ERRORS INSTEAD
;		OF P OR A ERRORS
;1071	(26690)	SET POLISH FLAG IN CORRECT HALF OF FR WHEN DOING FORCED
;		RIGHT HALF POLISH IN ANGLE BRACKETS
;1072	(26749)	LIST COMPLETE MACRO CALL LINE WHEN XALL IS IN EFFECT
;1073	(26884)	FIX ?ILL MEM REF AND E ERRORS DURING POLISH INDEXING
;1074	(12239)	FORCE PAIRING OF LIT BRACKETS WITHIN .PSECT/.ENDPS
;		MAKE END ILLEGAL WITHIN LITERAL OF ANY PSECT, NOT JUST CURRENT
;		CORRECT ERROR MSG. TAG OFFSET IF WITHIN NESTED LITS WITH LABELS
;1075	(27082)	LIST COMMENT ON MACRO CALL LINE WHEN XALL IS IN EFFECT
;1076	(27099)	DO NOT ALLOW '@' IN AC FIELD, FLAG AS QUESTIONABLE
;1077		ALLOW RIGHT JUSTIFIED RELOCATABLES TO BE GTR. 18 BITS FOR BYTE
;		MAKE BYTE ALLOW POLISH SYMBOLS ONLY FOR FULL AND HALF WORDS
;		ENHANCEMENT TO EDIT 1067.
;1100		ELIMINATE PHASE ERRORS PRODUCED BY EDIT 1074
;1101		FIX BAD POLISH FOR EXPRESSIONS INVOLVING INTER-PSECT REFERENCES
;		OF RELOCATABLES. ADDITION TO EDIT 1040.
;1102		KEEP DDT SUPPRESS BITS WHEN SYMBOL DEFINED AS INTERNAL HAS AN
;		EXTERNAL OR POLISH VALUE
;1103		REWORK REL+ABS, REL+REL, REL-ABS, REL-REL CODE ADDED BY EDITS
;		1044 AND 1055 TO HANDLE RH RELOCATABLES ONLY
;1104	(12505)	DO NOT GENERATE POLISH FWF WHEN DOING POLISH INDEXING
;1105	(12506)	MAKE  OP AC,-<POL> GENERATE CORRECT RH FIXUP
;1106	(12637)	DO NOT GENERATE FULLWORD FIXUP UNLESS EXTERNAL IS OF THE
;		FORM 0,,EXT
;1107	(27389)	DO NOT ALLOW POLISH IN INDEX FIELD, DO NOT ALLOW EXTERNALS IN OP
;		CODE INDEX, MAKE PSUEDO-OP IN INDEX FIELD WORK IN ALL CASES
;1110		GENERATE CORRECT POLISH FOR V=EXT##+K WHEN V IS STILL DEFINED
;		BY A SPECIAL EXTERNAL POINTER (NOT YET DEFINED IN PASS 2)
;		MORE OF EDIT 703.
;1111		AUGMENT EDIT 1103 TO GENERATE LESS POLISH. CASES IMPROVED
;		INVOLVE NEGATIVE RELOCATABLES AND RELOCATABLES SLIGHTLY LESS
;		THAN HMIN (RANGE HMIN-400).
;1112	(27167)	EXPAND .IF/.IFN FEATURE BY ADDING "NAME" ATTRIBUTE INDICATING
;		A SINGLE RADIX50 NAME (SYMBOL) HAS BEEN PASSED AS AN ARGUMENT.
;1113	(27418)	ELIMINATE OPDEF PROCESSING INCONSISTENCIES
;1114	(27388)	ADD THE SWAPPED LEFT HALF VALUE OF THE INDEX TO THE POLISH
;		GENERATED FOR STATEMENTS OF THE FORM 'OPCODE AC,POLISH(LH,,RH)'
;1115	(27544)	FOR DEC/EXP/OCT, GIVE Q ERROR FOR UNBRACKETED EXPRESSIONS
;		INVOLVING '@'. FORCES USE OF BRACKETS FOR FULL ADDRESS CALC.
;1116		FIX INTER-PSECT REFERENCES TO SPECIAL POINTERS OF EXTERNALS
;		SO THE EXTERNAL CHAIN DOES NOT CROSS PSECTS.
;1117	(27728)	MAKE .PSECT HANDLE ATTRIBUTE SPECIFICATIONS CORRECTLY
;1120	(12962)	RESET RP AND MP IN THE END CODE SINCE MACROS MUST BE COMPLETED
;1121		INCREASE THE NUMBER OF EXTRA (XTRA) LOCATIONS TO SAVE FOR PRGEND
;		TO 8 TO PREVENT POSSIBLE ?ILL MEM REFS
;1122	(27813)	DO NOT COPY NULLS INTO STATEMENT OUTPUT BUFFER
;1123	(27976)	GENERATE Q ERROR FOR MULTIPLE TITLES/OR TITLE/UNIVERSAL
;		CONFLICTS, INSTEAD OF M ERROR DURING ONLY PASS 1
;1124	(Q3051)	INCREASE .UNIV TO 50.
;1125	(Q3038)	RE-INSTALL MACROS FOR DIRECTIVE ARGS AND ROUTINES
;1126	(Q3045)	FLAG MOST ASSIGMENTS INVOLVING A LABEL DEFINED WITHIN A LITERAL
;		AS L ERRORS. LABEL MAY NOT BE DEFINED TILL END OF PASS2.
;1127	(Q3053)	GENERATE THE DESIRED ASCII STRING FOR MACRO CALL ARG ' \N '
;		WHEN N IS A SYMBOL OR EXPRESSION - BROKEN BY EDIT 137
;1130		RESET ASSEMBLY MODE TO RELOCATABLE (1) AT PASS INITIALIZATION.
;1131		REMOVE EDIT 646, MAKE PRGEND WORK WITH PSECTS
;1132		FIX NUMEROUS PSECT BUGS - PSECT FOO,1000 / PSECT FOO LOSES ORIG.
;		PSECT AND LOC INCONSISTENCIES, PSECT AND PHASE INCONSISTENCIES.
;1133	(Q3047)	FIX RSW3 TO PROPERLY DETECT WHEN THE LISTING OUTPUT BUFFER IS
;		FULL - HANDLE TABS PROPERLY AFTER THE 128 CHARACTER LIMIT
;1134		MAKE LOCO STAY IN SYNC. WITH LOCA DURING PASS 1. PSECTS NESTED
;		WITHIN LITERALS CAUSE OUT-OF-SYNC.
;1135	(28104)	DO 'OP' PROCESSING INSTEAD OF A FULL WORD FIXUP FOR CASES SUCH
;		AS 'OP## AC,ADDR'. THIS AND POLISH OPCODES WILL NOT PRODUCE THE
;		PROPER CODE FOR LEFT HALF EXTERNALS.
;1136		CLEAR PSECT NESTING COUNTER AND OTHER PSECT ITEMS AT PRGEND,
;		PLUS CHECK FOR PRGEND INSIDE LITERALS
;1137		FLAG NON-ABSOLUTE PSECT ORIGINS AS AN 'A' ERROR
;1140		EDIT 1123 BROKE 5 CHARACTER TITLES IN PRGENED FILES, CLEAR OUT
;		2ND WORD OF TITLE WHEN LOADING DEFAULT TITLE OF .MAIN
;1141	(Q3085)	FOR PRGENDED PROGRAMS, PRINT BREAK, CPU TIME, CORE USED DATA
;		FOR EACH PROGRAM MODULE
;1142	(Q3181)	REPEAT THE EOL CHAR. IF A TERMINATING ANGLE BRACKET IS MISSING.
;1143		SYN A,B WILL NOT CREF B AS DEFINING OCCURANCE
;1144		SAVE/CLEAR/AND RESTORE CPU TYPE OVER PRGENDS
;1145		EDIT 1135 STOPPED GENERATION OF FULL WORD FIXUP FOR [FOO##]
;1146		ALLOW NUL: AS CREF DEVICE
;1147		EDIT 1113 CAUSED THE OPDEF IN "EXP OPDEF AC,ADDR" TO BE
;		PROCESSED AS AN ADDRESS, DISCARDING THE REMAINING FIELDS.
;1150	(Q3261)	XLIST UNDER SALL PUTS EXTRA CHARACTERS IN THE LISTING FILE
;1151		DO NOT OUTPUT BLOCK 22'S AFTER THE END BLOCK FOR PRGEND.
;1152	(Q3410)	EDIT 1143 CAUSED BAD CREF DATA TO BE GENERATED FOR A SYN
;		SUCH AS "SYN IFE,IF".
;*****END OF REVISION HISTORY*****
SUBTTL OTHER PARAMETERS

.PDP==^D100			;BASIC PUSH-DOWN POINTER
   IFN POLISH,<.PDP==^D250>	;BE GENEROUS WITH STACK
   IFNDEF LPTWID,<LPTWID==^D132> ;DEFAULT WIDTH OF PRINTER
.LPTWD==8*<LPTWID/8>		;USEFUL WIDTH IN MAIN LISTING
.CPL==.LPTWD-^D32		;WIDTH AVAILABLE FOR TEXT WHEN
				;BINARY IS IN HALFWORD FORMAT
.CPLX==LPTWID-.LPTWD		;EXCESS SPACE IN LAST TAB STOP
   IFNDEF .LPP,<
	IFE STANSW,<.LPP==^D57>	;LINES/PAGE
	IFN STANSW,<.LPP==^D52>	;LINES/PAGE
   >
.STP==^D100			;STOW SIZE
.TBUF==^D80			;TITLE BUFFER
.SBUF==^D80			;SUB-TITLE BUFFER
.IFBLK==^D20			;IFIDN COMPARISON BLOCK SIZE
.R1B==^D18
.UNIV==^D50			;[1124] NUMBER OF UNIVERSAL SYMBOL TABLES ALLOWED
.LEAF==4			;SIZE OF BLOCKS IN MACRO TREE
.SFDLN==5			;NUMBER OF SFD'S ALLOWED

NCOLS==LPTWID/^D32		;NUMBER OF COLUMNS IN SYMBOL TABLE
IFN FTPSECT,<			;[575]
SGNSGS==^D64			;MAX # OF DISTINCT PSECTS ALLOWED
				;IN ONE ASSEMBLY
SGNDEP==^D16			;MAX PSECT DEPTH ALLOWED
>				;END IFN FTPSECT
   IFN CCLSW,<IFNDEF CTLSIZ,<CTLSIZ==^D1000>>	;[1036]
   IFN OPHSH,<IFNDEF PRIME,<PRIME==^D701>>
   IFNDEF NUMBUF,<NUMBUF==5>	;NUMBER OF INPUT BUFFERS

EXTERN .JBREL,.JBFF,.JBAPR,.JBSA,.JBERR
EXTERN .HELPR
   IFE TOPS20,<
      IFDEF .REQUEST,<.REQUEST REL:HELPER  >> ;[567]
   IFN TOPS20,<
      IFDEF .REQUEST,<.REQUEST SYS:HELPER  >> ;[567]

LOWL:!				;START OF LOW SEGMENT
   IFN PURESW,<TWOSEGMENTS
	RELOC 400000>

	SALL			;SUPPRESS ALL MACROS

;SOME ASCII CHARACTERS

HT==11
LF==12
VT==13
FF==14
CR==15
CZ==32
EOL==33
CLA==37
OBRCKT=="<"

				;ACCUMULATORS
AC0==	0
AC1=	AC0+1
AC2=	AC1+1
SDEL=	3			;SEARCH INCREMENT
SX=	SDEL+1			;SEARCH INDEX
ARG=	5			;ARGUMENT
V=	6			;VALUE
C=	7			;CURRENT CHARACTER
CS=	C+1			;CHARACTER STATUS BITS
RC=	11			;RELOCATION BITS
MWP=	12			;MACRO WRITE POINTER
MRP=	13			;MACRO READ POINTER
IO=	14			;IO REGISTER (LEFT)
ER==	IO			;ERROR REGISTER (RIGHT)
FR=	15			;FLAG REGISTER (LEFT)
FRR==	FR			;[613] MOVE FLAGS (RIGHT)
MP=	16			;MACRO PUSHDOWN POINTER
P=	17			;BASIC PUSHDOWN POINTER

%OP==	3
%MAC==	5
%DSYM==	2
%SYM==	1
%DMAC==	%MAC+1
%ERR==	%MAC

OPDEF RESET	[CALLI  0]
OPDEF SETDDT	[CALLI   2]
OPDEF DDTOUT	[CALLI  3]
OPDEF DEVCHR	[CALLI  4]
OPDEF CORE	[CALLI 11]
OPDEF EXIT	[CALLI 12]
OPDEF UTPCLR	[CALLI 13]
OPDEF DATE	[CALLI 14]
OPDEF APRENB	[CALLI 16]
OPDEF MSTIME	[CALLI 23]
OPDEF PJOB	[CALLI 30]
OPDEF RUN	[CALLI 35]
OPDEF TMPCOR	[CALLI 44]
OPDEF MTWAT.	[MTAPE  0]
OPDEF MTREW.	[MTAPE  1]
OPDEF MTEOT.	[MTAPE 10]
OPDEF MTSKF.	[MTAPE 16]
OPDEF MTBSF.	[MTAPE 17]
				;FR  FLAG REGISTER (FR/RX)
IOSCR==000001			;NO CR AFTER LINE
POLSW==000002			;DOING POLISH ON GLOBALS
MTAPSW==000004			;MAG TAPE
ERRQSW==000010			;IGNORE Q ERRORS
LOADSW==000020			;END OF PASS1 & NO EOF YET
DCFSW==000040			;DECIMAL FRACTION
RIM1SW==000100			;RIM10 MODE
NEGSW==000200			;NEGATIVE ATOM
RIMSW==000400			;RIM OUTPUT
PNCHSW==001000			;RIM/BIN OUTPUT WANTED
CREFSW==002000
R1BSW==004000			;RIM10 BINARY OUTPUT
TMPSW==010000			;EVALUATE CURRENT ATOM
INDSW==020000			;INDIRECT ADDRESSING WANTED
RADXSW==040000			;RADIX ERROR SWITCH
FSNSW==100000			;NON BLANK FIELD SEEN
MWLFLG==200000			;ON FOR DON'T ALLOW MULTI-WORD LITERALS
P1==400000			;PASS1


				;[613] FRR FLAGS (RIGHT HALF OF FR)
NOPSW==400000			;[613] NO-POLISH IN CONDITIONAL
LHPSW==200000			;[613] OUTPUT "#" AFTER LH OF BINARY LISTING
RHPSW==100000			;[613] OUTPUT "#" AFTER RH OF BINARY LISTING
FWPSW==040000			;[613] FULL WORD FORMAT + "#" IN BINARY LISTING
WD2SW==020000			;[607] PROCESSING 2ND WORD OF MULTIPLE WORD DATA
EXPSW==010000			;[634] DOING EXP, KEEP FULL WORD FIXUP
PIDXSW==004000			;[636] DOING POLISH AND INDEXING
NOUNVS==002000			;[713] DON'T SEARCH UNIVERSALS
LTGSW==001000			;[735] GOT A TAG IN LITERAL
IDXSW==000400			;[1107] DOING OP INDEXING
				;IO FLAG REGISTER (IO/ER)
FLDSW==400000			;ADDRESS FIELD
IOMSTR==200000
ARPGSW==100000			;ALLOW RAPID PROGRAM GENERATION
IOPROG==040000			;SUPRESS LISTING (LIST/XLIST PSEUDO OP)
NUMSW==020000
IOMAC==010000			;MACRO EXPANSION IN PROGRESS
IOPALL==004000			;SUPRESS LISTING OF MACRO EXPANSIONS
IONCRF==002000			;SUPRESS OUTPUT OF CREF INFORMATION
CRPGSW==001000			;CURRENTLY IN PROGRESS ON RPG
IOCREF==000400			;WE ARE NOW OUTPUTTING CREF INFO
IOENDL==000200			;BEEN TO STOUT
IOPAGE==000100
DEFCRS==000040			;THIS IS A DEFINING OCCURANCE (MACROS)
IOIOPF==000020			;IOP INSTRUCTION SEEN
MFLSW==000010			;MULTI-FILE MODE,PRGEND SEEN
IORPTC==000004			;REPEAT CURRENT CHARACTER
RSASSW==000002			;REFERENCE IS TO A SYMBOL IN ANOTHER PSECT
IOSALL==000001			;SUPPRESS MACRO LISTING EVEN IF BINARY IS GENERATED

OPDEF CALL [PUSHJ P,]		;FUNCTIONAL MNEMONIC
OPDEF RET [POPJ P,]		;FUNCTIONAL MNEMONIC

OPDEF JUMP1 [JUMPL FR,]		;JUMP IF PASS 1
OPDEF JUMP2 [JUMPGE FR,]	;JUMP IF PASS 2

OPDEF JUMPOC [JUMPGE IO,]	;JUMP IF IN OP-CODE FIELD
OPDEF JUMPAD [JUMPL IO,]	;JUMP IF IN ADDRESS FIELD

OPDEF JUMPCM [JUMPL CS,]	;JUMP IF CURRENT CHAR IS COMMA
OPDEF JUMPNC [JUMPGE CS,]	;JUMP IF CURRENT CHAR IS NON-COMMA

OPDEF PJRST [JRST]		;JUMP TO RET	;RETURN
OPDEF HALT [HALT]		;TO PUT IN CREF TABLE

.NODDT PJRST,CALL
				;ER ERROR REGISTERS (IO/ER)
TTYSW==000001
LPTSW==000002
ERRF==000004			;FAKE ERROR TO PREVENT LITERALS BEING COLLAPSED

ERRS==000010			;ILLEGAL PSECT USAGE
ERRM==000020			;MULTIPLY DEFINED SYMBOL
ERRE==000040			;ILLEGAL USE OF EXTERNAL
ERRP==000100			;PHASE DISCREPANCY
ERRO==000200			;UNDEFINED OP CODE
ERRN==000400			;NUMBER ERROR
ERRV==001000			;VALUE PREVIOUSLY UNDEFINED
ERRU==002000			;UNDEFINED SYMBOL
ERRR==004000			;RELOCATION ERROR
ERRL==010000			;LITERAL ERROR
ERRD==020000			;REFERENCE TO MULTIPLY DEFINED SYMBOL
ERRA==040000			;PECULIAR ARGUMENT
ERRX==100000			;MACRO DEFINITION ERROR
ERRQ==200000			;QUESTIONABLE, NON-FATAL ERROR
ERROR1==ERRP!ERRM!ERRV!ERRX	;ERRORS THAT PRINT ON PASS 1
ERRORS==777770			;[732]

				;SYMBOL TABLE FLAGS
SYMF==400000			;SYMBOL		!(LTAGF)
TAGF==200000			;TAG		!(LTAGF)
NOOUTF==100000			;NO DDT OUTPUT WFW
SYNF==040000			;SYNONYM	!(SIXF)
MACF==SYNF_-1			;MACRO
OPDF==SYNF_-2			;OPDEF
PNTF==004000			;"VALUE" IN SYMBOL TBL IS PNTR TO 36BIT VALUE	!(SIXF)
UNDF==002000			;UNDEFINED	!(LTAGF)
EXTF==001000			;EXTERNAL
INTF==000400			;INTERNAL
ENTF==000200			;ENTRY
VARF==000100			;VARIABLE	!(LTAGF, SIXF)
NCRF==000040			;DO NOT CREF THIS SYMBOL
MDFF==000020			;MULTIPLY DEFINED
SPTR==000010			;SPECIAL EXTERNAL POINTER
SUPRBT==000004			;SUPRESS OUTPUT TO REL AND LISTING
LELF==000002			;LEFT HAND RELOCATABLE
RELF==000001			;RIGHT HAND RELOCATABLE
LTAGF==SYMF+TAGF+UNDF		;[601] TAG IN LITERAL DURING PASS 1
 TREF==VARF			;[742] TREF+LTAGF MEANS TAG NOT REF'ED
SIXF==SYNF+PNTF+VARF		;USED WITH SYN IN UNV FILE
				;POINTER TO A SIXBIT OPERATOR

LITF==200000			;FLAG FOR PSEUDO-OPS INVALID IN LIT'S
ADDF==100000			;FLAG FOR PSEUDO-OPS INVALID IN ADDRESSES
TNODE==200000			;TERMINAL NODE FOR EVALEX

;FLAGS IN BLSW
BLOFF==1B0			;BINARY LISTING OFF (MUST BE B0)
FLBLST==1B1			;FIRST-LINE BINARY ONLY MODE
;POLISH FIXUP CODES

POLRHF==-1			;RIGHT-HALF FIXUP
POLLHF==-2			;LEFT-HALF FIXUP
POLFWF==-3			;FULL-WORD FIXUP

;UNIVERSAL VERSION BIT DEFINITION


;THE FIRST WORD OF A UNV FILE MUST CONTAIN:
;	LEFT HALF	777
;	RIGHT HALF	UNIVERSAL VERSION NUMBER
;WHEN WRITING A UNV FILE, MACRO WRITES OUT:
;	777,,UWVER	FOR THE FIRST WORD
;	.JBVER		FOR THE SECOND WORD( MACRO VERSION NUMBER)
;WHEN READING A UNV FILE, MACRO READS THE FIRST WORD AND CHECKS FOR:
;	777 IN LEFT HALF, AND
;	CHECKS THE RIGHT HALF AGAINST MASK .URVER
;	WILL SKIP THE SECOND WORD IF A VERSION NUMBER IS EXPECTED THERE
;

UMACV==000020			;HAS MACRO VERSION IN 2ND WORD
USYN==000010			;NEW SYN HANDLING IN UNIVERSAL
UBAS==000004			;MUST HAVE THIS BASIC BIT ON
				;SAME AS THE FIRST VERSION #4
UPOL==000002			;POLISH INCLUDED
UMAD==000001			;MACRO ARG DEFAULT VALUE BUG FIXED

UALL==UBAS+UMAD+UPOL+USYN+UMACV	;EVERYTHING

   IFN POLISH,<.URVER==^-UALL>	;WILL READ EVERY KIND OF UNV
   IFE POLISH,<.URVER==^-<UALL-UPOL>> ;WILL NOT READ POLISH STUFF IN UNV 

;USEFUL MACROS

DEFINE FORERR(AC,ABC)<
	MOVE AC,[PAGENO,,ABC'PG]
	BLT AC,ABC'PG+3
   >

DEFINE BITON(BIT,ADR)<
	PUSH P,0
	MOVEI 0,BIT
	IORM 0,ADR
	POP P,0
   >
SUBTTL START ASSEMBLING

ASSEMB:	CALL INZ		;INITIALIZE FOR PASS
	SKIPA AC1,.+1		;LOCALIZED CODE
	ASCII /.MAIN/
	MOVEM AC1,TBUF
	SETZM TBUF+1		;[1140] CLEAR 2ND WORD FOR ASCIZ TITLE
	SETZM TTLFND		;[1123] NO TITLE SPECIFIED YET
	MOVEI SBUF
	HRRM SUBTTX

ASSEM1:	CALL CHARAC		;TEST FOR FORM FEED
	SKIPGE LIMBO		;CRLF FLAG?
	JRST ASSEM1		;YES ,IGNORE LF
	CAIN C,14
	SKIPE SEQNO
	JRST ASSEM2
	TLNE IO,IOSALL		;[650] IGNORE FF IF SALL IN MACRO
	JUMPN MRP,ASSEM1	;[650]
	CALL OUTFF3		;[774]
	JRST ASSEM1

ASSEM2:	CAIN C,"\"		;BACK-SLASH?
	TLZA IO,IOMAC		;YES, LIST IF IN MACRO
	TLO IO,IORPTC
	CALL STMNT		;OFF WE GO
	TLZN IO,IOENDL		;WAS STOUT PRE-EMPTED?
	CALL STOUT		;NO, POLISH OFF LINE
	JRST ASSEM1
SUBTTL STATEMENT PROCESSOR

STMNT:
   IFN POLISH,<
	SKIPLE POLTYP		;INIT POLISH
	SETZM POLTYP
	TRZ FRR,LTGSW!LHPSW!RHPSW!FWPSW> ;[744][614]
	TLZ FR,INDSW!FSNSW!POLSW
	SETZM UPARROW		;CLEAR SPECIAL REPEAT CHARACTER
	TLZA IO,FLDSW
STMNT1:	CALL LABEL
STMNT2:	CALL ATOM		;GET THE FIRST ATOM
	CAIN C,'='		;"="?
	JRST ASSIGN		;YES
	CAIN C,':'		;":"?
	JRST STMNT1		;YES
	JUMPAD STMNT9		;NUMERIC EXPRESSION
	JUMPN AC0,STMN2A	;JUMP IF NON NULL FIELD
	CAIE C,EOL		;[665] END OF LINE?
	CAIN C,']'		;CLOSING LITERAL?
	RET			;YES
	JRST STMNT9		;NO,AT LEAST SKIP ALL THIS NONSENSE
STMN2A:	SKIPE C
	TLO IO,IORPTC		;REPEAT TERMINATOR IF NOT BLANK
	CALL MSRCH		;SEARCH FOR MACRO/OPDEF/SYN
	  JRST STMNT3		;NOT FOUND, TRY OP CODE
	LDB SDEL,[POINT 3,ARG,5]
	JUMPE SDEL,ERRAX	;ERROR IF NO FLAGS
	SOJE SDEL,[ TLNE CS,(17B5)	;[1113] TERMINATED WITH OPERATOR (+,-..)
		    JRST STMNT9		;[1113] YES - TREAT AS SYMBOL
		    JRST OPD1]		;[1113] NO - PROCESS OPDEF IF 1
	SOJE SDEL,CALLM		;MACRO IF 2
	JRST STMNT4		;SYNONYM, PROCESS WITH OP-CODES

STMNT3:	CALL OPTSCH		;SEARCH OP CODE TABLE
	  JRST STMNT5		;NOT FOUND
STMNT4:	TLNE CS,(17B5)		;TERMINATED WITH OPERATOR? (+,-,ETC.)
	JRST [	HRRZ AC1,V	;YES
		TRZ AC1,ADDF+LITF
		CAIE AC1,OP	;REGULAR OPCODE?
		JRST .+1	;NO, MUST EXECUTE IT
		JRST STMNT9]	;YES, TREAT AS SYMBOL
	HLLZ AC0,V		;PUT CODE IN AC0
	TRZ V,ADDF		;CLEAR ADDRESS NON-VALID FLAG
	TRZE V,LITF		;VALID IN LITERAL?
	SKIPN LITLVL		;NO, ARE WE IN A LITERAL?
	JRST 0(V)		;EXECUTE APPROPRIATE PROCESSOR
	RET			;YES,EXIT

STMNT5:	CALL SSRCH		;TRY SYMBOLS
	  JRST STMNT8		;NOT FOUND
STMNT9:
   IFN POLISH,<
	PUSH P,[0,,POLFWF]	;MARK AS TEMP FULL WORD FIXUP
	POP P,POLTYP		;IN CASE WE GO POLISH
   >
	TLO IO,FLDSW		;[636] MUST BE DOING ADDR FIELD(NOT OPTR)
	TLZ IO,IORPTC		;EVAL WILL HANDLE TERMINATOR IN C
	CALL EVALHA		;EVALUATE EXPRESSION
   IFN FORMSW,< MOVE AC1,HWFORM> ;USE STANDARD FORM
	TLNE FR,FSNSW		;FIELD SEEN?
	JRST STOW		;YES,STOW THE CODE AND EXIT
	CAIE C,']'		;CLOSING LITERAL?
	CAIN C,'>'		;[1023] CLOSING ANGLE-BRACKET?
	RET			;[1023] YES, RETURN
	TRO ER,ERRQ		;NO, GIVE "Q" ERROR
	RET			;EXIT
STMNT8:
   IFN UUOSYM,<			;ALL THIS ONLY IF TOPS10 SYMS WANTED
	SKIPE NOUUO		;[1043][1041] .DIRECTIVE .NOCALLIS SEEN?
	JRST STMN8A		;[1041] YES, JUMP OUT OF UUO SEARCH CODE
	MOVEI V,0		;ALWAYS START SCAN WITH 0
	CAIL V,CALNTH		;END OF TABLE?
	JRST STMN8C		;YES, TRY TTCALLS
	CAME AC0,CALTBL(V)	;FOUND IT?
	AOJA V,.-3		;NO,TRY AGAIN
	SUBI V,NEGCAL		;CALLI'S START AT -1
	HRLI V,(CALLI)		;PUT IN UUO
STMN8D:	MOVSI ARG,OPDF		;SET FLAG FOR OPDEF
STMN8B:	CALL INSERT		;PUT OPDEF IN TABLE
	JRST OPD		;AND TREAT AS OPDEF

STMN8C:	SETZ V,			;START WITH ZERO
	CAIL V,TTCLTH		;END OF TABLE?
	JRST STMN8E		;TRY MTAPES
	CAME AC0,TTCTBL(V)	;MATCH?
	AOJA V,.-3		;NO, KEEP TRYING
	LSH V,5			;PUT IN AC FIELD (RIGHT HALF)
	HRLZI V,<(TTCALL)>(V)	;PUT UUO IN LEFT HALF
	JRST STMN8D		;SET OPDEF FLAG

STMN8E:	SETZ V,			;START AT ZERO
	CAIL V,MTALTH		;END OF TABLE?
	JRST STMN8A		;YES, ERROR
	CAME AC0,MTATBL(V)	;MATCH
	AOJA V,.-3		;NOT YET
	PUSH P,AC0		;SAVE IT
	MOVE AC0,[POINT 9,MTACOD]
	IBP AC0			;GET TO RIGHT ONE
	SOJGE V,.-1		;EVENTUALLY
	LDB V,AC0		;GET FUNCTION
	HRLI V,(MTAPE)		;FILL IN OPCODE
	POP P,AC0
	JRST STMN8D

STMN8A:
   >				;END UUOSYM
   IFN POLISH,<			;[645]
	JRST STMNT9		;[645]
   >				;[645]
   IFE POLISH,<
	SETZB V,RC		;CLEAR VALUE AND RELOCATION
	TRO ER,ERRO		;FLAG AS UNDEFINED OP-CODE
	JUMP1 OPD		;TREAT AS STANDARD OP ON PASS1
	MOVSI ARG,OPDF!UNDF!EXTF ;SET A FEW FLAGS
	JRST STMN8B		;[664] TO FORCE OUT A MESSAGE
   >
	SUBTTL LABEL PROCESSOR

LABEL:	JUMPAD LABEL4		;COMPARE IF NON-SYMBOLIC
	JUMPE AC0,LABEL5	;ERROR IF BLANK
	TLO IO,DEFCRS		;THIS IS A DEFINITION
	JUMPN MRP,LABL10	;[1001] IF EXPANDING, DON'T RESET OFFSET
	SKIPN LITLVL		;LABEL IN LITERAL?
	JRST LABL10		;NO
	SETOM LBLFLG		;SET FLAG
	PUSH P,TAGINC		;[774]
	POP P,LTGINC		;SET MARKER
LABL10:	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	CALL SSRCH		;SEARCH FOR OPERAND
   IFE FTPSECT,<		;[714]
	 MOVSI ARG,SYMF!UNDF!TAGF ;[714] NOT FOUND
   >				;[714]
   IFN FTPSECT,<		;[714]
	 JRST [	MOVSI ARG,SYMF!UNDF!TAGF ;[714] NOT FOUND
		SKIPE SGNMAX	;[714] DOING PSECTS?
		CAMN AC1,SGWFND	;[714] AC1 HAS CURENT PSECT#
		JRST LABL12	;[714] JUMP IF ALREADY POINTS TO CURRENT TABLE
		CALL SRCHI	;[714] OTHERWISE, RESET SYMBOL PTR
		CALL SRCH	;[714] TO CURRENT PSECT TABLE
		 JFCL		;[714] 
		JRST LABL12]	;[714]
   >				;[714]
LABL12:	TRZ FRR,NOUNVS		;[713] SEARCH UNIVERSALS AGAIN
	TLZN ARG,EXTF		;WAS EXTERNAL?
	JRST LABEL0		;NO
	TLON ARG,UNDF		;[735] YES, BECAUSE UNDEFINED?
	JUMP2 LABEL3		;NO, ERROR
LABEL0:	TLZN ARG,UNDF!VARF	;WAS IT PREVIOUSLY DEFINED?
	JRST LABEL2		;YES, CHECK EQUALITY
	MOVE V,LOCA		;WFW
	MOVE RC,MODA		;[601]
LABL11:	TLO ARG,TAGF
	CALL PEEK		;GET NEXT CHAR.
	CAIE C,":"		;SPECIAL CHECK FOR  ::
	JRST LABEL1		;NO MATCH
	TLO ARG,INTF		;MAKE IT INTERNAL
	CALL GETCHR		;PROCESS NEXT CHAR.
	CALL PEEK		;PREVIEW NEXT CHAR.
LABEL1:	CAIE C,"!"		;HALF-KILL SIGN
	JRST LABEL6		;NO
	TLO ARG,NOOUTF		;YES, SUPPRESS IT
	CALL GETCHR		;AND GET RID OF IT
LABEL6:	SKIPN MRP		;[1001] IF EXPANDING, DON'T RESET TAG
	MOVEM AC0,TAG		;[774] SAVE FOR ERRORS
	SKIPN LITLVL		;[774] IN LITERAL?
	JRST [	JUMPN MRP,INSERT ;[1001] DON'T RESET IF EXPANDING
		SETZM TAGINC	;[774] NO RESET OFFSET
		JRST INSERT]	;[774] INSERT/UPDATE AND EXIT
	TRO ER,ERRF		;[774] YES, PREVENT COLLAPSING
	JUMP2 LBLFIX		;[774] RETURN TO STMNT PROCESSING
	MOVSI ARG,LTAGF		;[774] PASS1, SET FLAGS
	SETZ V,			;[774]
	MOVE RC,MODA		;[774] CURRENT RELOCATION
	JRST INSERT		;INSERT/UPDATE AND EXIT
;HERE IF TAGS ENCOUNTERED INSIDE A LITERAL ON PASS2
;3-WORD-BLOCK PER TAG IS ADDED IN FRONT OF A CHAIN
;THE START OF THE CHAIN IS POINTED BY LBLPNT
; THE FORMAT OF THE 3-WORD-BLOCK IS:
;	LITLVL,,POINTER TO NEXT BLOCK (OR 0 FOR END)
;	NAME OF TAG IN SIXBIT
;	ARG FLAGS,,OFFSET INTO CURRENT LITERAL
;
LBLFIX:	PUSH P,AC0
	MOVE AC1,FREE		;GET 3 WORDS FROM FREE CORE
	ADDI AC1,3
	CAML AC1,SYMBOL		;ENOUGH?
	CALL XCEEDS		;NO, GET MORE
	EXCH AC1,FREE		;UPDATE FREE
	HRR AC0,LBLPNT		;UPDATE THE NEXT BLOCK POINTER
	HRL AC0,LITLVL		;GET LITERAL LEVEL
	MOVEM AC0,0(AC1)	;STORE IN WORD1
	MOVE AC0,STPX		;CURRENT DEPTH IN LITERAL
	SUB AC0,STPY		;MINUS THE START
	TLZ ARG,EXTF+PNTF	;[740] MAKE SURE THEY ARE OFF
	HLL AC0,ARG		;ARG FLAG IN LEFT HALF
	MOVEM AC0,2(AC1)	;STORE FLAGS,,OFFSET IN WORD 3
	POP P,AC0		;RESTORE TAG NAME
	MOVEM AC0,1(AC1)	;STORE IN WORD 2
	MOVEM AC1,LBLPNT	;UPDATE START POINTER
	RET			;[735] RETURN TO STMNT PROCESSING
;HERE IF TAG ALREADY DEFINED

LABEL2:	SKIPE LITLVL		;IN LITERAL?
	JRST LABEL3		;YES, DEFINITE ERROR
	HRLOM V,LOCBLK		;SAVE LIST LOCATION
   IFN FTPSECT,<		;[575]
	SKIPN SGNMAX		;[770] DOING PSECT?
	JRST LABEL8		;[770] NO, DON'T NEED TO CHECK PSECTS
	SKIPN MODA		;[776] RELOCATABLE?
	JRST LABEL8		;[776] NO, JUMP, DON'T DO PSECT CHECK
	MOVE AC1,SGNCUR		;[770] GET CURRENT PSECT
	CAME AC1,SGWFND		;[770] SAME PSECT?
	JRST LABEL3		;[770] NO, FLAG MULTIPLY DEFINED
LABEL8:>			;[770]
	CAMN V,LOCA		;DOES IT COMPARE WITH PREVIOUS? WFW
	CAME RC,MODA
LABEL3:	TLOA ARG,MDFF		;NO, FLAG MULTIPLY DEFINED AND SKIP
	JRST LABEL7		;YES, GET RID OF EXTRA CHARS.
	TRO ER,ERRM		;FLAG MULTIPLY DEFINED ERROR 
	CALL UPDATE		;UPDATE AND EXIT
	JRST LABEL9		;GET RID OF EXTRA CHARS.

;HERE IF EXPRESSION PRECEEDING COLON

LABEL4:	CAMN AC0,LOCA		;DO THEY COMPARE?
	CAME RC,MODA
LABEL5:	TRO ER,ERRP		;NO, FLAG PHASE ERROR
	JRST LABEL9		;GET RID OF EXTRA CHARS.

LABEL7:	JUMPN MRP,LABEL9	;[1001] DON'T RESET OFFSET IF EXPANDING
	MOVEM AC0,TAG		;SAVE FOR ERRORS
	SKIPN LITLVL		;[774] DON'T RESET OFFSET IN LITERAL
	SETZM TAGINC		;[576]
LABEL9:	CALL PEEK		;INSPECT A CHAR.
	CAIN C,":"		;COLON?
	CALL GETCHR		;YES, DISPOSE OF IT
	CALL PEEK		;EXAMINE ONE MORE CHAR.
	CAIN C,"!"		;EXCLAMATION?
	JRST GETCHR		;YES, INDEED
	RET
SUBTTL ATOM PROCESSOR

ATOM:	CALL CELL		;GET FIRST CELL
	SETZ PR,		;[747]
	TLNE IO,NUMSW		;IF NON-NUMERIC
ATOM1:	CAIE C,42		;OR NOT A BINARY SHIFT,
	RET			;EXIT

	PUSH P,AC0		;STACK REGISTERS, ITS A BINARY SHIFT
	PUSH P,AC1
	PUSH P,RC
	PUSH P,CURADX		;[613] PUSH CURRENT RADIX
	HRRI AC0,^D10		;[613] COMPUTE SHIFT IN RADIX 10
	HRRZM AC0,CURADX	;[613] STORE IN CURRENT RADIX
	SETOM BSHFLG		;[1054] IN CASE <ARG>B^-ARG
	CALL CELLSF		;GET SHIFT
	SETZM BSHFLG		;[1054]
	MOVE ARG,RC		;SAVE RELOCATION
	POP P,CURADX		;[613] RESTORE CURRENT RADIX
	POP P,RC
	POP P,AC1
	MOVN SX,AC0		;USE NEGATIVE OF SHIFT
	POP P,AC0
	JUMPN ARG,NUMER2	;IF NOT ABSOLUTE
	TLNN IO,NUMSW		;AND NUMERIC,
	JRST NUMER2		;FLAG ERROR
   IFN POLISH,<
	CAME SX,[-^D35]		;SPECIAL TEST FOR <EXP>B35
	JUMPN RC,ATOM3		;[1037] JUMP IF RELOCATABLE OR POLISH
   >
	LSHC AC0,^D35(SX)
	LSH RC,^D35(SX)
	JRST ATOM1		;TEST FOR ANOTHER
   IFN POLISH,<
;HERE IF WE HAVE RELOCATABLE OR POLISH VALUES TO BE B-SHIFTED
;CONVERT TO A POLISH EXPRESSION USING UNDER-SCORE SHIFT


ATOM3:	HRRZ PS,(P)		;[1037] GET RETURN ADDRESS
	CAIN PS,EVATOM+1	;[1037] IF IN EXPRESSION EVAL
	JRST ATOM2		;[1037] YES
	PUSH P,CS		;[1037]
	PUSH P,C		;[1037]
	HRREI AC0,POLFWF	;[1037]
	MOVEM AC0,POLTYP	;[1037]
	MOVEI AC0,^D35(SX)	;[1037] NO
	MOVE PS,CSTAT+'_'	;[1037]
	TLNE CS,17000		;[1037] PART OF LARGER EXPRESSION
	SETOM BSHIFT		;[1037] YES, FLAG IT
	CALL FORCEP		;[1037] POLISH OF <RC>_<AC>
	SETZM BSHIFT		;[1037]
	POP P,C			;[1037]
	POP P,CS		;[1037]
	TLNE CS,170000		;[1037] OPERATOR FOLLOWING, THUS PART OF EXP?
	CALL MOVSTK		;[1037]
	TLZ FR,POLSW		;[1037]
	JRST ATOM1		;[1037]

ATOM2:	POP P,(P)		;REMOVE TOP ADDRESS
	MOVE PS,(P)		;GET NODE
	CAME PS,[TNODE,,0]	;NOTHING THERE YET?
	JRST .+3		;YES, BYPASS INITIALIZATION
	MOVSI PS,4000		;NO, FAKE IT
	ADDM PS,(P)		;PS
	PUSH P,AC0		;CV
	PUSH P,RC		;RC
	PUSH P,CSTAT+'_'	;CS
	SETZB RC,EXTPNT
	MOVEI AC0,^D35(SX)	;SHIFT ARG
	JRST EVGETD		;EVALUATE
   >
CELLSF:	TLO IO,FLDSW
CELL:	SETZB AC0,RC		;CLEAR RESULT AND RELOCATION
	SETZB AC1,AC2		;CLEAR WORK REGISTERS
	MOVEM P,PPTEMP		;SAVE PUSHDOWN POINTER
	TLZ IO,NUMSW
	TLZA FR,NEGSW!DCFSW!RADXSW

CELL1:	TLO IO,FLDSW
	AOSLE UPARRO		;SKIP GETCHR IF RE-EATING ^
	CALL BYPASS		;[664]
	SKIPE .IFFLG		;[1112] DOING .IF/.IFN?
	JRST %IFCHK		;[1112] YES - DO "NAME" CHECKING
CELL1A:				;[1112]  AND POSSIBLY RESUME HERE
	LDB V,[POINT 4,CSTAT(C),14] ;GET CODE
	XCT .+1(V)		;EXECUTE, INDEX VIA BITS 11,12,13,14 OF CSTAT TABLE
	JRST CELL1		;0; BLANK, (TAB OR "+")
	JRST LETTER		;1; LETTER  ] $ % ( ) , ; >
	TLC FR,NEGSW		;2; "-"
	TLO FR,INDSW		;3; "@"
	JRST NUM1		;4; NUMERIC   0 - 9
	JRST ANGLB		;5; "<"
	JRST SQBRK		;6; "["
	JRST QUOTES		;7; ""","'" 
	JRST QUAL		;10; "^"
	JRST PERIOD		;11; "."
	TROA ER,ERRQ		;12; ERROR, FLAG AND TREAT AS DELIMITER
				;12;	! # & * / : =? \ _
LETTER:	TLOA AC2,(POINT 6,AC0,)	;SET BYTE POINTER
LETTE1:	CALL GETCHR		;GET CHARACTER
	TLNN CS,6		;ALPHA-NUMERIC?
	JRST LETTE3		;NO,TEST FOR VARIABLE
	TLNE AC2,770000		;STORE ONLY SIX BYTES
LETTE2:	IDPB C,AC2		;RETURN FROM PERIOD
	JRST LETTE1

LETTE3:	CAIE C,03		;"#"?
	RET
	SETZM .IFNAM		;[1112] NOT SIMPLE RADIX50 NAME
	JUMPE AC0,CPOPJ		;[664] TEST FOR NULL
	CALL PEEK		;PEEK AT NEXT CHAR.
	CAIN C,"#"		;IS IT 2ND #?
	JRST LETTE4		;YES, THEN IT'S AN EXTERN
	TLO IO,DEFCRS
	CALL SSRCH		;YES, SEARCH FOR SYMBOL (OPERAND)
	  MOVSI ARG,SYMF!UNDF	;NOT FOUND, FLAG AS UNDEFINED SYM.
	TLNN ARG,UNDF		;UNDEFINED?
	JRST LETTE5		;NO, BUT SEE IF ALREADY DEFINED AS EXTERNAL
	TLC ARG,LTAGF		;[742] PART OF LTAGF?
	TLCN ARG,LTAGF		;[742]
	JRST GETCHR		;[742] YES, GET NEXT CHR AND RETURN
	TLO ARG,VARF		;YES, FLAG AS A VARIABLE
	TRO ER,ERRU		;SET UNDEFINED ERROR FLAG
	CALL INSERZ		;INSERT IT WITH A ZERO VALUE
	JRST GETDEL

LETTE4:	CALL GETCHR		;AND SCAN PAST IT
	TLZ IO,DEFCRS		;MAKE SURE NOT A DEFINITION
	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	CALL EXTER5		;PUT IN SYMBOL TABLE
	JRST GETCHR		;GET RID OF #

LETTE5:	TLNE ARG,EXTF		;EXTERNAL
	TRO ER,ERRQ		;YES, FLAG WITH "Q" ERROR
	JRST GETCHR		;GET NEXT CHAR AND RETURN

NUMER1:	SETZB AC0,RC		;RETURN ZERO
NUMER2:	TROA ER,ERRN		;[1034] FLAG ERROR

GETDEL:	CALL GETCHR
GETDE1:	JUMPE C,.-1
	MOVEI AC1,0
GETDE3:	TLO IO,NUMSW!FLDSW	;FLAG NUMERIC
	TLNN FR,NEGSW		;IS ATOM NEGATIVE?
	RET			;NO, EXIT
	JUMPE AC1,GETDE2
	MOVNS AC1
	TDCA AC0,[-1]
GETDE2:	MOVNS AC0		;YES, NEGATE VALUE
	MOVNS RC		;AND RELOCATION
	RET			;[664] EXIT
QUOTES:	CAIE C,"'"-40		;IS IT  "'"
	JRST QUOTE		;NO MUST BE """
	JRST SQUOTE		;YES

QUOTE0:	TLNE AC0,376000		;5 CHARACTERS STORED ALREADY?
	TRO ER,ERRQ		;YES, GIVE WARNING
	ASH AC0,7
	IOR AC0,C
QUOTE:	CALL CHARAC		;GET 7-BIT ASCII
	CAIG C,15		;TEST FOR LF, VT, FF OR CR
	CAIGE C,12
	JRST .+2		;NO, SO ALL IS WELL
	JRST QUOTE2		;ESCAPE WITH Q ERROR
	CAIE C,42
	JRST QUOTE0
	CALL PEEK		;LOOK AT NEXT CHAR.
	CAIE C,42
	JRST QUOTE1		;RESTORE REPEAT LEVEL AND QUIT
	CALL CHARAC		;GET NEXT CHAR.
	JRST QUOTE0		;USE IT

QUOTE2:	TRO ER,ERRQ		;SET Q ERROR
QUOTE1:	JRST GETDEL

SQUOT0:	CAIL C,"a"		;TEST FOR LOWER CASE
	CAILE C,"z"		;...
	JRST .+2		;NO
	SUBI C," "
	TLNE AC0,770000		;SIX CHARS. STORED ALREADY ?
	TRO ER,ERRQ		;YES
	LSH AC0,6
	IORI AC0,-40(C)		;OR IN SIXBIT CHAR.

SQUOTE:	CALL CHARAC
	CAIGE C," "		;VALID SIXBIT?
	JRST QUOTE2		;FLAG WITH "Q" ERROR
	CAIE C,"'"
	JRST SQUOT0
	CALL PEEK
	CAIE C,"'"
	JRST QUOTE1
	CALL CHARAC
	JRST SQUOT0
QUAL:	CALL BYPASS		;[664] SKIP BLANKS, GET NEXT CHARACTER
	CAIN C,'B'		;"B"?
	JRST QUAL2		;YES, RADIX=D2
	CAIN C,'O'		;"O"?
	JRST QUAL8		;YES, RADIX=D8
	CAIN C,'F'		;"F"?
	JRST NUMDF		;YES, PROCESS DECIMAL FRACTION
	CAIN C,'L'		;"L"?
	JRST QUALL		;YES
	CAIN C,'-'		;"^-" IS NOT
	JRST QUALN
	CAIE C,'D'		;"D"?
	JRST NUMER1		;NO, FLAG NUMERIC ERROR
	ADDI AC2,2
QUAL8:	ADDI AC2,6
QUAL2:	ADDI AC2,2
	PUSH P,FR		;[613] PUSH CURRENT FLAGS
	PUSH P,CURADX		;[613] PUSH CURRENT RADIX
	HRRM AC2,CURADX		;[613]
	CALL CELLSF
	POP P,CURADX		;[613] RESTORE TO ORIGINAL RADIX
QUAL2A:	POP P,FR		;[613] RESTORE FLAGS
	TLNN IO,NUMSW
	JRST NUMER1
	JRST GETDE1

QUALL:	PUSH P,FR
	CALL CELLSF
	MOVE AC2,AC0
	MOVEI AC0,^D36
	SETZ RC,		;IN CASE ARG IS RELOCATABLE
	JUMPE AC2,QUAL2A
	LSH AC2,-1
	SOJA AC0,.-2

QUALN:
	SKIPN BSHFLG		;[1054] DOING B-SHIFT?
	JRST QUALN1		;[1054] NO, EVALUATE AT EXP-LEVEL
;[1054] THIS IS A KLUDGE TO ALLOW ^- TO INTERACT CORRECTLY WITH
;THE B-SHIFT OPERATOR.  B-SHIFT OPERATIONS, UNLIKE UNDERSCORE-SHIFT
;OPERATIONS, MUST BE PERFORMED AT CELL-LEVEL (AS THEY ARE SEEN)
;SINCE NOT EVERY CASE CAN BE HANDLED AT EXPRESSION-EVALUATION
;LEVEL (E.G., ^F123.45B17, ^F123.45B17B35, <EXT##>B35,
;100B<EXT##>, ETC.).  UNARY OPERATORS, HOWEVER, ARE SUPPOSED TO
;TAKE PRIORITY OVER SHIFT OPERATORS.  THEREFORE, IF A UNARY
;OPERATOR IS SEEN DURING THE EVALUATION OF A B-SHIFT
;ARGUMENT, THE UNARY OPERATION MUST BE PERFORMED IMMEDIATELY.
	PUSH P,FR		;[1054] YES, HAVE TO DO IT NOW
	CALL CELLSF		;[1054] GET CELL
	SETCA AC0,		;[1054] COMPLEMENT IT
	JRST QUAL2A		;[1054] CONTINUE
QUALN1:	MOVE CS,CSTATN		;[1054] GET CHARACTERISTICS FOR "^-"
	JRST GETDE1		;THEN GET DELIMITER
SUBTTL LITERAL PROCESSOR

SQBRK:	PUSH P,LBLFLG		;[1074] SAVE PREVIOUS LABEL-IN-LIT FLAG
	SETZM LBLFLG		;[1074] CLEAR CURRENT LABEL-IN-LIT FLAG
	PUSH P,TAG		;[1074] SAVE CURRENT TAG
	PUSH P,FR
	PUSH P,EXTPNT		;ALLOW EXTERN TO PRECEDE LIT IN XWD
	SETZM EXTPNT
	PUSH P,INOPDF		;[1006] TO ALLOW LITERAL IN OPDEF DEFINITION
	SETZM INOPDF		;[1006]
IFN FORMSW,<	PUSH P,IOSEEN>	;SAVE I/O INSTRUCTION SEEN VALUE
IFN POLISH,<			;[560]
	PUSH P,INANGL		;SAVE INANGL
	SETZM INANGL
	PUSH P,INASGN		;SAVE INASGN
	SETZM INASGN
	PUSH P,POLTYP		;SAVE AND INIT POLTYP
	SETZM POLTYP
	PUSH P,POLITS		;SAVE PTR TO LITS STILL TO FIXUP
	SETZM POLITS		;START AFRESH
   >
	SKIPE LITLVL		;FIRST TIME IN LIT?
	JRST SQB5		;NO, ALREADY IN LIT, DOING NESTING
	FORERR (C,LIT)		;YES, FIRST TIME, SAVE SEQNO AND PAGE
	MOVE AC0,LITABX		;SAVE POINTER INTO LITERAL POOL
	MOVEM AC0,SQBST		;AS THE START OF LITERAL TAG FIXUP
SQB5:	AOS LITLVL		;BUMP NESTING OF LITERALS
    IFN FTPSECT,<		;[1074]
	AOS SGLITL		;[1074] BUMP 'ALL PSECT' NESTING LEVEL
    >				;[1074]
	PUSH P,STPX		;SAVE STATE OF BINARY BUFFER
	PUSH P,STPY
	PUSH P,LSTPY		;SAVE CURRENT LITERAL VARIABLES
	MOVE AC0,STPX
	MOVEM AC0,STPY
	MOVEM AC0,LSTPY
	PUSH P,[0]		;MAKE PLACE TO KEEP ERROR FLAG
	HRRM ER,0(P)		;SAVE CURRENT ERROR FLAGS
	TRZ ER,ERRF		;START WITH CLEAN SLATE
SQB3:	CALL STMNT
	TRNE ER,ERRORS+ERRF	;ANY ERRORS THIS WORD?
	HRROS 0(P)		;YES, REMEMBER FOR STOLIT
	TLO IO,IORPTC		;REPEAT TERMINATOR, UNLESS...
	CAIN C,75		;IT WAS A CLOSE BKT
	TLZ IO,IORPTC
	MOVEI AC1,0		;SAY "]" NOT SEEN, UNLESS...
	CAIE C,75		;"]" TERMINATED STATMENT?
	TLNE FR,MWLFLG		;OR NO MULTI-LINE LITS?
	TRO AC1,1		;YES, NOTE LITERAL TERMINATED
	SKIPN LITLST		;NEW FORMAT LISTING?
	JUMPN AC1,SQB2A		;NO, JUMP IF LITERAL DONE
	SKIPE AC1		;LITERAL TERMINATED?
	SOS LITLVL		;YES, MUST NOT CONFUSE CHARAC
SQB4:	CALL CHARAC		;BYPASS NON-SIGNIFICANT CHARS
	CAIE C," "		;SPACE
	CAIN C,HT		;TAB
	JRST SQB4
	CAIN C,";"		;COMMENT?
	JRST SQB6		;YES, IGNORE SQUARE BRACKETS
SQB4A:	SKIPE AC1		;LITLVL SOS'D ABOVE?
	AOS LITLVL		;YES, PUT IT BACK
	CAILE C,CR		;LOOK FOR END OF LINE
	JRST [	JUMPN AC1,SQB2	;JUMP IF SOMETHING AFTER "]"
		CAIN C,"]"	;POSSIBLY A LITERAL TERM?
		JRST SQB2A	;YES
		TRO ER,ERRQ	;JUNK ON LINE, OTHER THAN "]"
		JRST SQB4]	;SKIP IT AND LOOK FOR EOL
	PUSH P,AC1		;SAVE LITERAL TERMINATED FLAG
	CALL OUTIML		;DUMP
	SKIPN LITLVL		;[1134] NESTED IN PSECT WITH NO LITS?
	JRST [ 	JUMP2 .+1	;[1134] YES - ONLY DURING PASS 1
		AOS CS,STPX	;[1134] NO. OF LOCATIONS STOWED
		ADDM CS,LOCO	;[1134] UPDATE OUTPUT LOC
		CALL STOWI	;[1134] INITIALIZE FOR NEXT STOW
		JRST .+1]	;[1134]
	POP P,AC1		;RECOVER FLAG
	JUMPN AC1,SQB1		;JUMP IF LITERAL TERMINATED
	CALL CHARAC		;GET ANOTHER CHAR.
	SKIPGE LIMBO		;[1003] IF CRLF, CHECK FOR FF
	CALL [	CALL CHARAC	;[1003]
		CAIN C,FF	;[1003]
		JRST OUTFF3	;[1003]
		RET]		;[1003]
	TLO IO,IORPTC		;[1003] SET REPEAT
	JRST SQB3

SQB6:	CALL CHARAC		;GET A CHARACTER
	CAIG C,CR
	CAIN C,HT		;LOOK FOR END OF LINE CHAR.
	JRST SQB6		;NOT YET
	JRST SQB4A		;GOT IT
SQB1:	TLNE IO,IOSALL		;SALL AND IN MACRO?
	JUMPN MRP,SQB2		;IF SO, DON'T REPEAT TERMINATOR
	HRRZ C,LIMBO		;GET TERMINATOR
	SOSG CPL		;PUT IT IN IMAGE BUFFER
	CALL RSW5
	IDPB C,LBUFP
SQB2:	TLO IO,IORPTC		;REPEAT TERMINATOR
SQB2A:	SKIPGE 0(P)		;ERROR ANYWHERE IN LITERAL?
	TRO ER,ERRF		;YES, PREVENT COMPRESSION
	MOVE AC1,LITNUM		;SAVE LITNUM BEFORE UPDATED IN
	MOVEM AC1,LITN		;STOLIT IN CASE NEEDED FOR SQBTGS
	CALL STOLIT
	SKIPE LBLPNT		;ANY TAGS IN LITERAL TO FIX UP?
	CALL SQBTGS		;YES, (ONLY ON PASS2)
	POP P,AC1		;RECOVER ER AS BEFORE LIT
	TRNE AC1,ERRORS+ERRF	;ANY ERRORS?
	TRO ER,ERRF		;YES, KEEP ONLY ERRF
	POP P,LSTPY		;RESTORE LITERAL VARIABLES
	POP P,STPY		;RESTORE PREVIOUS STATE OF CODE BUFFER
	POP P,STPX
	SOS LITLVL		;ONE LESS NESTING OF LITERALS
    IFN FTPSECT,<		;[1074]
	SOS SGLITL		;[1074] ONE LESS 'ALL PSECT' LIT LEVEL
    >				;[1074]
   IFN POLISH,<
	SKIPE POLITS		;NEED TO FIXUP ANY POLISH?
	CALL SQBPOL		;YES
	POP P,POLITS		;RESTORE NEXT LEVEL PTR
	POP P,POLTYP		;RESTORE POLTYP
	POP P,INASGN		;RESTORE NEXT LEVEL INASGN
	POP P,INANGL		;RESTORE NEXT LEVEL INANGL
   >				;[560]
   IFN FORMSW,<	POP P,IOSEEN>	;RESTORE IOSEEN FOR LISTING
	POP P,INOPDF		;[1006] RESTORE INOPDF SETTING
	POP P,EXTPNT
	POP P,FR
	POP P,TAG		;AND LABEL
	POP P,LBLFLG		;[1074] AND LABEL-IN-LITERAL FLAG
	SKIPE LITLVL		;WERE WE NESTED?
	JUMP1 SQB2F		;YES, FORCE ERROR IF PASS 1
	JUMP2 GETDEL		;USE VALUE GIVEN IF PASS 2
	TRO ER,ERRU		;VALUE IS UNDEFINED ON PASS 1
	TDZA AC0,AC0		;SO SET IT TO 0
SQB2F:	TRO ER,ERRF		;SET FAKE ERROR FLAG
	JRST GETDEL
;HERE DURING PASS2 TO STORE REAL VALUES FOR TAGS IN LITERAL.
;IF NO REFERRENCES YET, THE TAG IS INSERTED INTO SYMTAB WITH REAL-V.
;IF THERE ARE FORWARD REFERENCES, A POINTER TO A 2-WORD LOCAL BLOCK
;REPLACES THE EXTERNAL NAME OF THE ORIGINAL 2WORD PAIR.  LOCAL BLOCKS
;ARE CHAINED IN CHNLOC ROUTINE AT THE END OF PASS2,
;AND HAS THE FOLLOWING FORMAT WHEN IT IS FIRST CREATED HERE:
;
;	TAG-REAL-VALUE,,TAG-FLAGS
;	TAG-RELOCATION..0
;
;ALL MEMORY LOCATIONS RELATED TO THE PROCESSING OF TAGS IN LITERALS
;ARE CLEARED WHEN THE OUTER MOST (LEVEL 1) LITERAL IS BEING CLOSED.
;
SQBTGS:	PUSH P,RC		;SAVE BUNCH OF ACS THAT WE NEED
	PUSH P,V
	PUSH P,AC0
	PUSH P,AC1
	PUSH P,ARG
	PUSH P,SX
	MOVE AC2,LITHDX		;GET HEADER BLOCK
	HLRZ RC,-1(AC2)		;GET BLOCK RELOCATION
	MOVEM RC,LITRC		;SAVE IT
	HRRZ AC0,-1(AC2)
	ADD AC0,LITN		;COMPUTE ACTUAL LOCATION
	MOVEM AC0,LITV		;ACTUAL START LOCATION OF THIS LITERAL
	MOVE AC1,LBLPNT		;GET START OF LITERAL TAG CHAIN
SQBTG1:	HRRZ AC0,(AC1)
	MOVEM AC0,LBLNXT	;ADDRESS OF NEXT BLOCK IN CHAIN
	HLRZ AC0,(AC1)		;GET LIT LEVEL
	CAME AC0,LITLVL		;SAME AS THE LITERAL BEING CLOSED?
	JRST [	MOVEM AC1,LBLPNT ;NO, UPDATE CHAINS STARTING ADDR
		JRST SQBTG3]	;GO RESTORE ACS AND RETURN
	MOVE AC0,1(AC1)		;YES, GET TAG NAME
	PUSH P,AC1		;SSRCH USES AC1
	CALL SSRCH		;SETUP POINTER INTO SYMBOL TABLE
	 JFCL			;[740]
SQBTG5:	POP P,AC1
	HRRZ V,2(AC1)		;GET OFFSET
	ADD V,LITV		;ADD IN THE START LOCATION
	MOVEI RC,-1		;PUT -1 AS LIT LEVEL
	HRLM RC,(AC1)		;TO FLAG THIS TAG HAS BEEN PROCESSED
	MOVE RC,LITRC		;GET BLOCK RELOCATION
	TLZE ARG,TREF		;[740] WAS IT REFERENCED? CLEAR FLAG
	JRST [	PUSH P,AC2	;[735] NEED AN AC FOR A WHILE
		MOVEI AC2,2	;[735] GET 2 WORDS
		ADDB AC2,FREE	;[735] FROM FREE SPACE
		CAML AC2,SYMBOL	;[735] CHECK TO SEE IF ENOUGH
		CALL XCEEDS	;[735]
		SUBI AC2,2	;[735] 
		HRRZM AC2,1(ARG) ;[735] MAKE 2ND WORD POINT TO IT
		HLL V,2(AC1)	;[735] GET SYMBOL FLGS OF THE TAG
		MOVSM V,0(AC2)	;[735] STORE IN 1ST WORD OF NEW PAIR
		MOVE V,LITRC	;[735] GET RELOCATION OF TAG
		MOVSM V,1(AC2)	;[735] STORE IN 2ND WORD OF NEW PAIR
		POP P,AC2	;[735] RESTURE AC2
		JRST SQBTG2]	;[735]
	HLLZ ARG,2(AC1)		;[735] NO REFERRENCES, GET FLAGS
	TLZ ARG,EXTF+PNTF	;[740] MAKE SURE THEY ARE OFF
	CALL INSERT		;[735] JUST ADD TO SYMBOL TABLE
SQBTG2:	SKIPE AC1,LBLNXT	;ARE THERE ANY MORE TAGS TO FIXUP?
	JRST SQBTG1		;YES,
SQBTG3:	MOVE SX,LITLVL		;OUTERMOST LITERAL BEING CLOSED?
	SOJG SX,SQBTG4		;NO, JUMP
	SETZM LBLPNT		;YES, CLEAR MEMORY LOCATIONS
	SETZM LBLNXT
	SETZM LITV
SQBTG4:	POP P,SX		;NO, RESTORE ACS
	POP P,ARG
	POP P,AC1
	POP P,AC0
	POP P,V
	POP P,RC
	RET
   IFN POLISH,<
;HERE TO FIXUP POLISH EXPRESSIONS INSIDE CURRENT LIT
;AS EACH ONE IS FIXED MOVE IT TO POLIST
SQBPOL:	PUSH P,CS		;GET SOME FREE ACCS
	PUSH P,AC0		;SAVE LOC
SQBPL1:	MOVE CS,@POLITS		;GET A BLOCK POINTER
	EXCH CS,POLITS		;SET FOR NEXT TIME
	MOVE AC0,CS		;GET A COPY
	EXCH AC0,POLIST		;STORE IN LIST OF "GOOD" POLISH
	MOVEM AC0,(CS)		;LINK IN
SQBPL2:	ADDI CS,1		;FIRST WORD
	MOVE AC0,(CS)		;GET SOMETHING
	JUMPL AC0,SQBPL5	;THIS IS AN OPERATOR
	JUMPE AC0,SQBPL4	;18 BIT VALUE
	SOJE AC0,SQBPL3		;36 BIT VALUE
	AOJA CS,SQBPL2		;SYMBOL

SQBPL3:	ADDI CS,1		;SKIP OVER 2 WORDS
SQBPL4:	AOJA CS,SQBPL2		;GET NEXT

SQBPL5:	HRRZ AC0,AC0		;GET OPERATOR ONLY
	CAIGE AC0,-6		;CHECK FOR STORE OP
	JRST SQBPL2		;ITS NOT
	MOVE AC0,0(P)		;GET ADDRESS
	ADDM AC0,1(CS)		;ADD TO OFFSET
	HRLM RC,1(CS)		;SET RELOCATION
	SKIPE POLITS		;MORE TO DO?
	JRST SQBPL1		;YES
	POP P,AC0		;RESTORE LOC
	POP P,CS		;AND SAVED AC
	RET
   >
SUBTTL NUMBER PROCESSOR

ANGLB:   IFN POLISH,<
	PUSH P,XWDANG		;[706] PUSH PTR TO LH POL
	SETZM XWDANG		;[706] ZERO LH POL
	PUSH P,INANGL		;PUSH CURRENT STACK PTR OR MARKER
	SETOM INANGL		;NOTE STARTING ANG BKTS
	SETOM .IFANG		;[1056] SET FLAG FOR .IF(N)
	PUSH P,INXWD		;[1010] SAVE XWD SETTING
	SETZM INXWD		;[1010] AND CLEAR
	PUSH P,POLTYP		;[634] PUSH CURRENT POLISH FIXUP TYPE
   >
	PUSH P,INOPDF		;[1011] SAVE DOING OPDEF SETTING
	SETZM INOPDF		;[1011]
	SETZM BSHFLG		;[1054] CLEAR FLAG FOR QUALN
	PUSH P,FR
	TLZ FR,INDSW+POLSW
	CALL ATOM
	SKIPN .IFFLG		;[1112] DOING .IF/.IFN?
	JRST ANGLB7		;[1112] NO
	SKIPN .IFNAM		;[1112] STILL LOOKING AT RADIX50 NAME?
	JRST ANGLB7		;[1112] NO
	CAIE C,'>'		;[1112] MUST HAVE CLOSE BRACKET NEXT
	JRST ANGLB6		;[1112] DON'T - NOT A "NAME"
	SKIPG .IFNAM		;[1112] NESTED ANGLE BRACKETS?
	JRST ANGLB5		;[1112] NO - FIRST SET
	SKIPN AC0		;[1112] "NAME" MUST BE THE ONLY ATOM
	JRST ANGLB7		;[1112] IT IS - CONTINUE
	JRST ANGLB6		;[1112] NOT JUST "NAME"
ANGLB5:	SKIPN AC0		;[1112] MUST HAVE ATOM FOR "NAME"
	JRST ANGLB6		;[1112] DON'T
	MOVNS .IFNAM		;[1112] "NAME" FOUND IN ANGLE BRACKETS
	SKIPA			;[1112] SKIP CLEAR
ANGLB6:	SETZM .IFNAM		;[1112] ELSE CAN'T BE A SIMPLE RADIX50 NAME
ANGLB7:				;[1112]
	TLNN IO,NUMSW
	CAIE C,35		;=
	JRST ANGLB1
	CALL ASSIG1
	MOVE AC0,V
	JRST ANGLB2

ANGLB1:	CALL EVALHA
ANGLB2:	POP P,FR
   IFN POLISH,<
	JUMP1 ANGLB4		;[747] JUMP OVER THESE CODE IN PASS1
	TRNE FRR,NOPSW		;[771] DOING NO POLISH?
	JRST ANGLB4		;[771] YES, JUMP OVER
	PUSH P,[0,,POLFWF]	;[706] SET POLTYP
	POP P,POLTYP		;[706]
	SETCM AC1,INANGL	;GET FLAG
	JUMPN AC1,[CALL ANGPOL	;[773] JUMP IF POLISH
		JRST ANGNEG]	;[773]
	TDNN RC,[-2,,-2]	;[747] NO POLISH, BUT ANY EXTERNALS?
	JRST ANGLB4		;[747] NO EXTERNALS EITHER, JUMP
	CALL ANGEXT		;[773] NO POLISH BUT HAVE EXTERNALS
ANGNEG:	TLZN FR,NEGSW		;[747] NEGATIVE?
	JRST ANGLB3		;[1105][727] NO, JUMP
	CALL FNEGP		;[727] YES, DO IT
	MOVE RC,INANGL		;[727]
	CALL MOVSTK		;[727]
	SETZM INANGL		;[727]
	TLO FR,POLSW		;[727] 
ANGLB3:	TRZ FRR,FWPSW		;[1105] CLEAR FULLWORD FIXUP
ANGLB4:	POP P,INOPDF		;[1011] RESTORE
	POP P,POLTYP		;[727] RESTORE POLISH FIXUP TYPE TO BEFORE
	POP P,INXWD		;[1010] RESTORE XWD SETTING TO BEFORE
	POP P,INANGL		;GET CURRENT STATUS
	POP P,XWDANG		;[706] RESTORE PTR TO LH POL
   >
	CAIE C,36		;CLOSE ANGBKT?
	JRST [	TRO ER,ERRN	;[1142] FLAG ERROR
		CAIN C,EOL	;[1142] END OF LINE SEEN?
		TLO IO,IORPTC	;[1142] YES - DO NOT DISCARD
		JRST .+1]	;[1142]
	JRST GETDEL

;HERE IF WE HAVE POLISH IN ANGLE BRACKETS-- MUST DECIDE WHICH CASE
;WE HAVE AND SETUP XWDLRC, XWDRRC, XWDLV, XWDRV:
;	
;	CASES		RC	XWDANG	INANGL
;	-----		--	------	------
;	<POL>		0	0	POL
;		INXWD/0 	DIFFERENCIATE FROM <0,,POL>
;	<POL1,,POL2>	0,,0	POL1	POL2
;	<POL1,,POL1>	0,,0	POL1	POL1
;		XWDRRC/POL1	TO DIFFERENTCIATE FROM <POL1,,0>
;	<POL1,,EXT>	0,,EXT	POL1	POL1
;	<POL1,,K>	0,,0	POL1	POL1
;	<POL1,,REL>	0,,1	POL1	POL1
;	<EXT,,POL2>	EXT,,0	0	POL2
;	<K,,POL2>	0,,0	0	POL2
;	<REL,,POL2>	1,,0	0	POL2

   IFN POLISH,<
ANGPOL:	JUMPN CV,.+4		;[1026] JUMP IF CURRENT VALUE NOT ZERO
	SKIPN INXWD		;[1010] DOING XWD?
	JRST ANGFW		;[1010] NO, JUMP
	SETZM INXWD		;[1010] YES, CLEAR FLAG FIRST AND PROCESS
	MOVEM CV,XWDRV		;[773] STORE RIGHT VALUE
	MOVEM CV,XWDLV		;[773] STORE LEFT VALUE
	PUSH P,RC		;[773] NEED AN AC TO WORK
	SKIPN RC,XWDANG		;[773] DO WE HAVE <POL,,..>?
	JRST [	POP P,RC	;[773] RESTORE ORIGINAL RC
		PUSH P,INANGL	;[773] SAVE RIGHT PTR
		CALL ANGEXL	;[773] GO CHECK LEFT EXTERNAL
		POP P,RC	;[773] GET RIGHT PTR
		JRST ANGPO1]	;[773]
	MOVEM RC,SAVRC		;[1013][773]
	MOVEM RC,SAVCV		;[773]
	PUSH P,INANGL		;[773] SAV RT PTR
	PUSH P,XWDRRC		;[773] SAVE ORIGINAL XWDRRC
	CALL ANGFPL		;[773] DO LEFT SHIFT POLISH
	POP P,XWDRRC		;[773]
	MOVEM RC,XWDLRC		;[773] TO FREE SPACE & UPDATE LEFT RC
	MOVEM RC,XWDLV		;[773] AND LEFT VALUE
	POP P,RC		;[773] GET INANGLE INTO RC
	CAMN RC,XWDANG		;[773] INANGLE = XWDANG?
	JRST [	CAMN RC,XWDRRC	;[773] YES, IS IT <POL,,POL> WHERE LEFT POL=RIGHT POL?
		JRST [	POP P,0(P) ;[773] YES,
			JRST ANGPO1+1] ;[773]
		POP P,RC	;[773] NO, THEN THERE IS NO RIGHT POL
		CALL ANGEXR	;[773] RESTORE RC & GO CHECK RIGHT EXT
		CALL ANGFPB	;[773] ADDING BOTH HALVES
		JRST ANGEND]	;[773] RETURN
	POP P,0(P)		;[773] NO, FIXUP STK PTR
ANGPO1:	CALL MOVSTK		;[773] WE HAVE <POL1,,POL2> RC/RT PTR
	MOVEM RC,SAVRC		;[773]
	MOVEM RC,SAVCV		;[773]
	CALL ANGFPR		;[773] DO AND RIGHT HALF POLISH
	MOVEM RC,XWDRV		;[773] UPDATE RT V
	MOVEM RC,XWDRRC		;[773] UPDATE RT RC
	CALL ANGFPB		;[773] GO ADD
	JRST ANGEND		;[773]

;HERE IF NO POLISH IN ANGLE BRACKETS, BUT EXTERNALS--
;MUST ALSO SETUP XWDLRC, XWDRRC, XWDLV, XWDRV:
;THE CASES THAT COME THRU HERE ARE:
;
;	<EXT1,,EXT2>
;	<EXT1,,K>	<K,,EXT2>
;	<EXT1,,REL>	<REL,,EXT2>

ANGEXT:	TLNN RC,-1		;[773] DO WE HAVE <0,,EXT>?
	JUMPE CV,CPOPJ		;[773] YES, RETURN
	MOVEM CV,XWDLV		;[773] LEFT VALUE
	MOVEM CV,XWDRV		;[773] RIGHT VALUE
	PUSH P,RC		;[773]
	CALL ANGEXL		;[773] GO CHECK LEFT EXTERNAL
	POP P,RC		;[773]
	CALL ANGEXR		;[773] GO CHECK RIGHT EXTERNAL
	CALL ANGFPB		;[773] GO ADD

ANGEND:	SETZM XWDLRC		;[773] ALL ANGXXX ROUTINE RETURN THRU HERE
	SETZM XWDLV		;[773] ZERO ALL WORKING ADDRS
	SETZM XWDRRC		;[773]
	SETZM XWDRV		;[773]
	SETZM SAVRC		;[773]
	SETZM SAVCV		;[773]
	RET			;[773]
ANGEXL:	TLNN RC,-2		;[773]
	JRST [	HLLZM RC,XWDLRC	;[773] JUMP IF LEFT NOT EXTERNAL
		RET]		;[773]
	HLRZM RC,SAVRC		;[773]
	SETZM SAVCV		;[773]
	CALL ANGFPL		;[773] FORCE LEFT POLISH
	MOVEM RC,XWDLV		;[773] UPDATE LEFT VALUE
	MOVEM RC,XWDLRC		;[773] SET UP LEFT RD
	RET			;[773]


ANGEXR:	TRNN RC,-2		;[773]
	JRST [	HRRZM RC,XWDRRC	;[773] JUMP IF RIGHT NOT EXTERNAL
		RET]		;[773]
	HRRZM RC,SAVRC		;[773]
	SETZM SAVCV		;[773]
	CALL ANGFPR		;[773] GO FORCE RIGHT POLISH
	MOVEM RC,XWDRV		;[773] UPDATE RIGHT VALUE
	MOVEM RC,XWDRRC		;[773] SET UP RIGHT RC
	RET			;[773]


;HERE ARE ROUTINES TO DO FORCED POLISH FOR
;RIGHT HALF, LEFT HALF, AND ADDING BOTH HALVES:


ANGFPL:	TLO FR,POLSW		;[773] DOING POLISH
	MOVEI CV,^D18		;[773] OPERAND2
	SETZ RC,		;[773]
	MOVE PS,CSTAT+'_'	;[773] SHIFT OPERATOR
	PJRST ANGLFP		;[773]

ANGFPR:	TLO FR,POLSW		;[1071][773] DOING POLISH
	HRRZI CV,-1		;[773] OPERAND2
	SETZ RC,		;[773]
	MOVE PS,CSTAT+'&'	;[706] FORCE AND WITH EXISTING
	PJRST ANGLFP		;[706]

ANGFPB:	PUSH P,XWDRRC		;[773] RIGHT RC
	POP P,SAVRC		;[773] IN SAVRC
	PUSH P,XWDRV		;[773] GET RIGHT VALUE
	POP P,SAVCV		;[773] IN SAVCV
	MOVE CV,XWDLV		;[773] LEFT VALUE IN CV
	MOVE RC,XWDLRC		;[773] LEFT RC IN RC
	MOVE PS,CSTAT+'+'	;[706] FORCE ADD

ANGLFP:	PUSH P,CS		;[773]
	CALL FORCPP		;[773]
	POP P,CS		;[773]
ANGFW:	TLO FR,POLSW		;[1010][773] FLAG POLISH
	MOVE RC,INANGL		;[706]
	PJRST MOVSTK		;[706] FORCE FIXUP, EXIT THRU MOVSTK

   >				;[706] END IFN POLISH
PERIOD:	CALL GETCHR		;LOOK AT NEXT CHARACTER
	TLNN CS,2		;ALPHABETIC?
	JRST PERNUM		;NO, TEST NUMERIC
	MOVSI AC0,'.  '		;YES, PUT PERIOD IN AC0
	MOVSI AC2,(POINT 6,AC0,5) ;SET BYTE POINTER
	JRST LETTE2		;AND TREAT AS SYMBOL

PERNUM:	SETZM .IFNAM		;[1112] NOT SIMPLE RADIX50 NAME
	TLNE CS,4		;IS IT A NUMBER
	JRST NUM32		;YES
	MOVE AC0,LOCA		;NO. CURRENT LOC SYMBOL (.)
	MOVE RC,MODA		;SET TO CURRENT ASSEMBLY MODE
	JRST GETDE1		;GET DELIMITER
NUMDF:	TLO FR,DCFSW		;SET DECIMAL FRACTION FLAG
NUM:	CALL GETCHR		;GET A CHARACTER
	TLNN CS,4		;NUMERIC?
	JRST NUM10		;NO
NUM1:	SETOM .IFNUM		;[1056] FLAG NUMBER SEEN FOR .IF(N)
	SUBI C,20		;CONVERT TO OCTAL
	PUSH P,C		;STACK FOR FLOATING POINT
	SKIPE AC0		;ARE WE ABOUT TO LOSE SOME DATA?
	TRO ER,ERRQ		;YES, AT LEAST WARN USER
	MOVE AC0,AC1
	MUL AC0,CURADX		;[613]
	ADD AC1,C		;ADD IN LAST VALUE
	CAML C,CURADX		;[613] IS NUMBER LESS THAN CURRENT RADIX?
	TLO FR,RADXSW		;NO, SET FLAG
	AOJA AC2,NUM		;YES, AC2=NO. OF DECIMAL PLACES
NUM10:	CAIE C,'.'		;PERIOD?
	TLNE FR,DCFSW		;OR DECIMAL FRACTION?
	JRST NUM30		;YES, PROCESS FLOATING POINT
	SETZ CS,		;AND CLEAR IT
	CAIN C,'K'		;SEE IF SUFFIX THERE
	MOVEI CS,3
	CAIN C,'M'
	MOVEI CS,6
	CAIN C,'G'
	MOVEI CS,9
	JUMPE CS,NUM12		;NO SUFFIX?
	MOVE AC0,AC1		;SCALE THE NUMBER
	MUL AC0,CURADX		;[613]
	SOJG CS,.-2
	CALL GETCHR		;SKIP THE SUFFIX
NUM12:	MOVE CS,CSTAT(C)	;RESTORE STATUS
	LSH AC1,1		;NO, CLEAR THE SIGN BIT
	LSHC AC0,^D35		;AND SHIFT INTO AC0
	MOVE P,PPTEMP		;RESTORE P
	SOJE AC2,GETDE1		;NO RADIX ERROR TEST IF ONE DIGIT
	TLNE FR,RADXSW		;WAS ILLEGAL NUMBER ENCOUNTERED?
	TRO ER,ERRN		;YES, FLAG N ERROR
	JRST GETDE1

NUM30:	CAIE C,'B'		;IF "B" THEN MISSING  "."
NUM31:	CALL GETCHR
	TLNN CS,4		;NUMERIC?
	JRST NUM40		;NO
NUM32:	SUBI C,20
	PUSH P,C
	JRST NUM31

NUM40:	PUSH P,CURADX		;[613] STACK VALUES
	PUSH P,FR		;[640]
	PUSH P,AC2
	HRRI AC2,^D10		;[613]
	HRRZM AC2,CURADX	;[613]
	PUSH P,PPTEMP
	CAIE C,45		;[1034] 'E'?
	JRST [MOVEI AC0,0	;[1034] NO, ZERO EXPONENT
		JRST NUM41]	;[1034]
	CALL PEEK		;[1034] YES, GET NEXT CHAR
	PUSH P,C		;[1034] SAVE NEXT CHAR
	CALL CELL		;[1034] GET EXPONENT
	POP P,C			;[1034] RESTORE FIRST CHAR AFTER E
	CAIE V,4		;[1034] MUST HAVE NUMERIC STATUS
	CAIN C,"<"		;[1034] ALLOW <EXP>
	JRST NUM41		;[1034]
	SKIPN AC0		;[1034] ERROR IF NON-ZERO EXPRESSION
	TROA ER,ERRQ		;[1034] ALLOW E+,E-
	SETOM RC		;[1034] FORCE NUMERICAL ERROR
NUM41:	POP P,PPTEMP		;[1034] UNSTACK VALUES
	POP P,SX
	POP P,FR		;[640]
	POP P,CURADX		;[613]
	HRRZ V,P
	MOVE P,PPTEMP
	JUMPN RC,NUMER1		;EXPONENT MUST BE ABSOLUTE
	ADD SX,AC0
	HRRZ ARG,P
	ADD SX,ARG
	SETZB AC0,AC2
	TLNE FR,DCFSW
	JRST NUM60
	JOV NUM50		;CLEAR OVERFLOW FLAG
NUM50:	JSP SDEL,NUMUP		;FLOATING POINT
	JRST NUM52		;END OF WHOLE NUMBERS
	FMPR AC0,[10.0]		;MULTIPLY BY 10
	TLO AC1,233000		;CONVERT TO FLOATING POINT
	FADR AC0,AC1		;ADD IT IN
	JRST NUM50

NUM52:	JSP SDEL,NUMDN		;PROCESS FRACTION
	FADR AC0,AC2
	JOV NUMER1		;TEST FOR OVERFLOW
	JRST GETDE1

	TLO AC1,233000
	TRNE AC1,-1
	FADR AC2,AC1		;ACCUMULATE FRACTION
	FDVR AC2,[10.0]
	JRST NUM52

NUM60:	JSP SDEL,NUMUP
	JRST NUM62
	IMULI AC0,^D10
	ADD AC0,AC1
	JRST NUM60

NUM62:	LSHC AC1,-^D36
	JSP SDEL,NUMDN
	LSHC AC1,^D37
	CALL BYPAS2
	JRST GETDE3

	DIVI AC1,^D10
	JRST NUM62

NUMUP:	MOVEI AC1,0
	CAML ARG,SX
	JRST 0(SDEL)
	CAMGE ARG,V
	MOVE AC1,1(ARG)
	AOJA ARG,1(SDEL)

NUMDN:	MOVEI AC1,0
	CAMG V,SX
	JRST 0(SDEL)
	CAMLE V,ARG
	MOVE AC1,0(V)
	SOJA V,3(SDEL)
SUBTTL GETSYM

GETSYM:	CALL BYPASS		;[664][572] SKIP LEADING BLANKS
GETSY0:	MOVEI AC0,0		;CLEAR AC0
	MOVSI AC1,(POINT 6,AC0)	;PUT POINTER IN AC1
	TLNN CS,2		;ALPHABETIC?
	JRST GETSY1		;NO, ERROR
	CAIE C,16		;PERIOD?
	JRST GETSY2		;NO, A VALID SYMBOL
	IDPB C,AC1		;STORE THE CHARACTER
	CALL GETCHR		;YES, TEST NEXT CHARACTER
	TLNN CS,2		;ALPHABETIC?
GETSY1:	TROA ER,ERRA
GETSY2:	AOS 0(P)		;YES, SET SKIP EXIT
GETSY3:	TLNN CS,6		;ALPHA-NUMERIC?
	JRST GETSY4		;NO
	TLNE AC1,770000		;YES, HAVE WE STORED SIX?
	IDPB C,AC1		;NO, STORE IT
	CALL GETCHR
	JRST GETSY3

	CALL GETCHR		;TRY AGAIN FOR TERMINATOR
GETSY4:	JUMPE C,.-1		;BYPASS TRAILING TAB/SP
	TLNE CS,6		;ALPHANUMERIC?
	TLO IO,IORPTC		;YES, PUT IT BACK
	RET
SUBTTL EXPRESSION EVALUATOR

CV==AC0				;CURRENT VALUE
PV==AC1				;PREVIOUS VALUE
RC=RC				;CURRENT RELOCATABILITY
PR==AC2				;PREVIOUS RELOCATABILITY
CS=CS				;CURRENT STATUS
PS==SDEL			;PREVIOUS STATUS

EVALHA:	TLO FR,TMPSW
EVALCM:	CALL EVALEX		;EVALUATE FIRST EXPRESSION
	JUMPCM EVALC3		;[625] JUMP IF COMMA
   IFN POLISH,<
	JUMPOC EVALC2		;[625] SKIP FULL WORD TEST IF IN OP FIELD
	JUMPL RC,EVALC2		;[625] JUMP IF ALREADY POLISH
	CAIE C,']'		;[1145] CURRENTLY AT END OF LITERAL?
	CAIN C,EOL		;[1145] OR END OF LINE?
	SKIPA			;[1145] YES - TRY FULLWORD FIXUP
	JRST EVALC2		;[1135] NO - MAY BE OPCODE, PROCESS IN OP
	TLNN RC,-1		;[1106] IS LEFT HALF ABSOLUTE
	TRNN RC,-2		;[1106] AND RIGHT HALF EXTERNAL
	JRST EVALC2		;[1106] NO, DON'T WANT FULLWORD
	TLNE AC0,-1		;[1106] IS LEFT HALF ABSOLUTE 0?
	JRST EVALC2		;[630] NO, JUMP
	SKIPN INASGN		;[630] IF DOING EITHER ASSIGNMENT
	SKIPE INANGL		;[630]  OR IN ANGLE BRACKETS
	JRST EVALC2		;[630]  JUMP
	TRZN FRR,LTGSW		;[735] DON'T DO FWF IF GOT A TAG IN LIT
	SKIPE INOPDF		;[637] IN OPDEF?
	JRST EVALC2		;[637] YES,
	TLNN FR,INDSW		;[630] IF DOING INDIRECT OR
	CAIN C,'('		;[630]  INDEXING
	JRST EVALC2		;[630]  JUMP
	TRNE FRR,PIDXSW		;[1104] IF DOING POLISH INDEXING
	JRST EVALC2		;[1104] JUMP
	TRNE FRR,IDXSW		;[1107] DOING OP INDEXING?
	JRST EVALC2		;[1107] YES - JUMP
	PUSH P,[POLFWF]		;[630] PASS ALL TESTS, MAKE IT FWF
	POP P,POLTYP		;[625]  INPOLTYP
	CALL OCTFW		;[625]  AS IF WE DID A EXP
	SETZM POLTYP		;[630] CLEAR IT AFTERWARDS
EVALC2:
   >
	PUSH P,[0]		;MARK PDL
	TLO IO,IORPTC		;IT'S NOT,SO REPEAT
	JRST OP			;PROCESS IN OP

EVALC3:	PUSH P,[0]		;[625] MARK PDL
   IFN POLISH,<
	TLNN FR,POLSW		;POLISH FIXUP SEEN?
	JRST EVALC4		;NO
	SETOM POLTYP		;REST MUST BE RIGHT HALF
	TRZ FRR,FWPSW		;[614]
	TRO FRR,LHPSW		;[614]
	MOVNI AC2,2		;CHANGE THIS TO LEFT HALF
	SKIPE INASGN		;BUT IF SYMBOLIC
	MOVNI AC2,4		;USE CORRECT STORE OP
	MOVEM AC2,@LSTOPR
EVALC4:>
   IFN FORMSW,<PUSH P,INFORM>	;PUT FORM WORD ON STACK
	PUSH P,[0]		;STORE ZERO'S ON PDL
	PUSH P,[0]		;.......
	MOVSI AC2,(POINT 4,(P),12)
	JRST OP1B		;PROCESS IN OP
EVALEX:				;[634]
   IFN POLISH,<
	TLNN FR,TMPSW		;UNLESS FIRST ATOM ALREADY READ,
	TLZ FR,POLSW		;CLEAR EVALUATING POLISH FLAG
   >
	PUSH P,[TNODE,,0]	;MARK THE LIST 200000,,0
	TLZN FR,TMPSW
EVATOM:	CALL ATOM		;GET THE NEXT ATOM
	JUMPE AC0,EVGETD	;TEST FOR NULL/ZERO
	TLOE IO,NUMSW		;SET NUMERIC, WAS IT PREVIOUSLY?
	JRST EVGETD+1		;YES, TREAT ACCORDINGLY
	CALL SEARCH		;SEARCH FOR MACRO OR SYMBOL
	  JRST EVOP		;NOT FOUND, TRY FOR OP-CODE
	JUMPGE ARG,EVAS1	;JUMP IF HAVE OPERATOR
	CAME AC0,1(SX)		;HAVE SYMBOL, OPERATOR ALSO DEFINED?
	JRST EVAS2		;NO, USE WHAT WE HAVE
	ADDI SX,2		;CHECK OPERATOR FIRST
	CALL SRCH5		;LOAD REGISTERS
EVAS1:	SKIPN MACPRF		;MACRO DEF PREFERRED?
	JRST EVAS3		;NO
	TLNE ARG,MACF+SYNF	;MACRO OR SYN?
	JRST [	TLO IO,FLDSW	;[634] YES, USE IT AND SET FLAG
		JRST EVAS2]	;[634]
EVAS3:	CAME AC0,-3(SX)		;NO, PROBABLY OPDEF.  SYMBOL ALSO DEFINED?
	JRST [	TLNE ARG,MACF+SYNF	;[1147] NO, USE WHAT WE HAVE
		TLO IO,FLDSW		;[634][1147] AND SET FLAG FOR
		JRST EVAS2]		;[634][1147] MACROS AND SYNS
	SUBI SX,2		;YES, SYMBOL BEFORE OPDEFS HERE
	CALL SRCH5		;LOAD REGISTERS
EVAS2:	SKIPE .IFFLG		;[1056] DOING .IF(N)?
	IORM ARG,IFSRCH		;[1056] MERGE ARG BITS WITH PREVIOUS
	CALL QSRCH		;CREF WHAT WE FOUND
   IFN POLISH,<
	JUMPL RC,[TRNN FRR,NOPSW ;[705] IF A FIXUP, FLAG IT UNLESS NOPSW
		TLO FR,POLSW	;[705]
		JRST .+1]	;[705]
   >
	JUMPG ARG,EVMAC		;BRANCH IF OPERATOR
	MOVE AC0,V		;SYMBOL, SET VALUE
	JRST EVTSTS		;TEST STATUS

EVMAC:	TLNE FR,NEGSW		;UNARY MINUS?
	JRST EVERRZ		;YES, INVALID BEFORE OPERATOR
	LDB SDEL,[POINT 3,ARG,5] ;GET MACF/OPDF/SYNF
	SOJL SDEL,EVERRZ	;ERROR IF NO FLAGS
	SKIPE C			;[664] NON-BLANK?
	TLO IO,IORPTC		;YES, REPEAT CHARACTER
	SOJE SDEL,EVMAC1	;MACRO IF 2
	JUMPG SDEL,EVOPS	;SYNONYM IF 4
	MOVE AC0,V		;OPDEF
	MOVEI V,OP		;SET TRANSFER VECTOR
	JRST EVOPD
EVMAC1:	SKIPE .IFFLG		;[1056] DOING .IF(N)?
	JRST EVGETD		;[1056] YES, DON'T ALLOW EXPANSION
	SKIPL MACENL		;ALREADY IN CALLM?
	JRST CALLM		;NO, EVALUATE MACRO
	SETZB RC,AC0		;ZERO VALUE
	TRO ER,ERRA		;SET "A" ERROR
	JRST EVGETD		;CONTINUE EVALUATION

EVOP:	CALL OPTSCH		;SEARCH OP TABLE
	  JRST EVOPX		;NOT FOUND
	TLNE FR,NEGSW		;OPCODE, UNARY MINUS?
	JRST EVERRZ		;YES, ERROR
EVOPS:	TRZ V,LITF		;CLEAR LIT INVALID FLAG
	TRZE V,ADDF		;SYNONYM
	JRST EVOPX		;PSEUDO-OP THAT GENERATES NO DATA JUMPS
	HLLZ AC0,V
EVOPD:	JUMPCM .+3		;[1113] TERMINATED WITH COMMA OR
	TLNN IO,FLDSW		;[1113] PART OF ADDRESS FIELD OR
	TLNE CS,(17B5)		;TERMINATED WITH OPERATOR? (+,-,ETC.)
	JRST [	HRRZ AC1,V	;YES
		CAIE AC1,OP	;REGULAR OP?
		JRST .+1	;NO, MUST EXECUTE IT
		TLZ IO,IORPTC	;[1113] TERMINATOR HAS BEEN USED
		JRST EVTSTS]	;YES, TREAT AS SYMBOL
	TLO IO,FLDSW		;[1147] REST IS ADDRESS
	SKIPE C			;NON-BLANK DELIMITER?
	TLO IO,IORPTC		;YES, REPEAT CHARACTER
	PUSH P,LOCA		;SAVE CURRENT LOCATION
	PUSH P,STPX		;SAVE CURRENT CODE BUFFER STATE
	PUSH P,STPY
	MOVE AC1,STPX
	MOVEM AC1,STPY
	CALL 0(V)		;DO OP
	MOVE AC2,STPX		;SEE HOW MANY WORDS GENERATED
	SUB AC2,STPY
;AFTER EDIT 1035, THIS CHECK CAN PROBABLY BE REENABLED AS CAILE AC2,1.
;	CAIE AC2,1		;SHOULD BE ONE, BUT MANY PROGRAMS
;	TRO ER,ERRQ		;USE <> TO TRUNCATE, E.G. ASCII
	JUMPE AC2,[SETZ AC0,	;[1023] SKIP IF NOTHING WAS GENERATED
		JRST .+3]	;[1023][1107]
	CALL DSTOW		;AC0 = WORD OF CODE GENERATED
	TLO FR,FSNSW		;[1107] SET FIELD SEEN FLAG
	POP P,STPY		;RESTORE CODE BUFFER
	POP P,STPX
	POP P,LOCA		;RESTORE CURRENT LOCATION
	TRNE RC,-2
	HRRM RC,EXTPNT
	TLNE RC,-2
	HLLM RC,EXTPNT
	JRST EVNUM

EVOPX:	MOVSI ARG,SYMF!UNDF
	CALL INSERZ
EVERRZ:	SETZB AC0,RC		;CLEAR CODE AND RELOCATION
EVERRU:	TRO ER,ERRU
	JRST EVGETD
EVTSTS:	TLNN ARG,UNDF		;[740]
	JRST EVTST1		;[740]
	TLC ARG,LTAGF		;[740] IS IT A TAG IN LIT?
	TLCE ARG,LTAGF		;[740]
	TROA ER,ERRU		;[740] NO, UNDEFINED
	JRST [	TRO FRR,LTGSW	;[740] YES, FLAG IT
		JUMP1 EVGETD	;[740] TREAT AS UNDF ON PASS1
		TLO ARG,TREF	;[740] FLAG IT REFERENCED
		HLLM ARG,(SX)	;[740] UPDATE SYMBOL TABLE AS REF'ED
		JRST EVTST1]	;[740]
	JUMP1 EVGETD		;TREAT AS UNDF ON PASS1
EVTST1:	TLNN ARG,EXTF		;[740] 
	JRST EVTSTR
	HRRZ RC,ARG		;GET ADRES WFW
	HRRZ ARG,EXTPNT		;SAVE IT WFW
	HRRM RC,EXTPNT		;WFW
   IFE POLISH,<			;NOT NEEDED SINCE POLISH WILL TAKE CARE OF EXTERNS
	TRNE ARG,-1		;WFW
	TRO ER,ERRE
   >
	SETZB AC0,ARG

EVTSTR:	TLNE ARG,MDFF		;MULTIPLY DEFINED?
	TRO ER,ERRD		;YES, FLAG IT
	TLNN FR,NEGSW		;NEGATIVE ATOM?
	JRST EVGETD		;NO
   IFN POLISH,< JUMPN RC,NEGEXT> ;UNARY MINUS, JUMP IF NOT ABS
	CALL GETDE2		;NO, JUST NEGATE
EVGETD:	TLNE IO,NUMSW		;NON BLANK FIELD
	TLO FR,FSNSW		;YES,SET FLAG
	CALL BYPAS2
	TLNE CS,6		;ALPHA-NUMERIC?
	TLO IO,IORPTC		;YES, REPEAT IT
	CAIN C,'^'		;IS THIS THE SPECIAL ESCAPE CHAR?
	JRST EVUPAR		;YES, SEE WHAT FOLLOWS

EVUPAT:				;LABEL FOR RETURN FROM ^
   IFN FTPSECT,<		;[575]
	TLZN IO,RSASSW		;INTER-PSECT REFERENCE?
	JRST EVNUM		;NO
	PUSH P,SGWFND		;INX OF PSECT REFERRED TO
	PUSH P,[-2]		;[613] DUMMY RELOCATION, DON'T USE -1
	PUSH P,CSTATP>		;ADDITIVE PSECT OPERATION
EVNUM:	POP P,PS		;POP THE PREVIOUS DELIMITER/TNODE
	TLO PS,4000
   IFN POLISH,<
	TLC PS,110000		;TEST FOR BITS 2 AND 5
	TLCN PS,110000		;BOTH ON - MEANS ADDITIVE
	JRST EVXCT>		;PSECT OPERATION
	CAMGE PS,CS		;OPERATION REQUIRED?
	JRST EVPUSH		;NO, PUT VALUES BACK ON STACK
	TLNN PS,TNODE		;YES, HAVE WE REACHED TERMINAL NODE?
	JRST EVXCT		;NO, EXECUTION REQUIRED
	TLNE CS,170000		;YES, ARE WE POINTING AT DEL? (& ! * / + - _)
	JRST EVPUSH		;NO,FALL INTO EVPUSH
   IFN POLISH,<
	TLNE FR,POLSW		;BEEN RESOLVING POLISH?
	JUMP2 POLPOP		;[610] YES, OUTPUT IT IN PASS2
   >
	RET			;NO, EXIT

;HERE TO HANDLE "^!"
EVUPAR:	SETZM UPARRO		;CLEAR ^ COUNTER ONCE IN A WHILE
	CALL PEEK		;SEE WHAT CHARACTER AFTER ^ IS
	SETZ CS,		;AND CHECK FOR ! AFTER IT
	CAIN C,"!"		;IS IT ! FOR ^!
	SKIPA CS,CSTATX		;YES, GET SPECIAL POINTER
	JRST EVUPAN		;NOT ^!
	TLZ IO,IORPTC		;CLEAR REREAD
	SKIPE MRP		;IF IN A MACRO
	CALL MREAD		;BETTER DO THIS
	SUBI C,40		;YES, CHANGE TO SIXBIT
	JRST EVNUM		;AND EVALUATE

EVUPAN:	CAIN C,"-"		;WAS IT ^-
	TRO ER,ERRQ		;GIVE A Q ERROR IF ^- IS USED AS BINARY OPTR
	MOVEI C,'^'		;RESTORE C
	MOVE CS,CSTAT(C)	;AND CS
	SETOM UPARRO		;SET FLAG FOR CELL1 TO RE-EAT ^
	JRST EVUPAT		;AND CONTINUE FROM ^
EVPUSH:	PUSH P,PS		;STACK VALUES
	PUSH P,CV
	PUSH P,RC
	PUSH P,CS
	JRST EVATOM		;GET NEXT ATOM

EVXCT:	POP P,PR		;POP PREVIOUS RELOCATABILITY
	POP P,PV		;AND PREVIOUS VALUE
	LDB PS,[POINT 4,PS,29]	;TYPE OF OPERATION TO PS
   IFE POLISH,<
	XCT EVTAB(PS)		;PERFORM PROPER OPERATION
	JUMPN RC,.+2		;COMMON RELOCATION TEST
EVXCT1:	JUMPE PR,EVNUM
	TRO ER,ERRR		;BOTH MUST BE FIXED
	JRST EVNUM		;GO TRY AGAIN

EVTAB:	JRST ASSEM1		;0; SHOULD NEVER GET HERE ;DMN
	JRST XMUL		;1;
	JRST XDIV		;2;
	JRST XADD		;3;
	JRST XSUB		;4;
	JRST XLRW		;5; "_"
	IOR CV,PV		;6; MERGE PV INTO CV
	AND CV,PV		;7; AND PV INTO CV
	XOR CV,PV		;10; XOR PV INTO CV
	SETCM CV,CV		;11; NOT (ONE'S COMPLIMENT)
REPEAT 6,<CALL EVXERR>		;12-17; JUST IN CASE
   >
   IFN POLISH,<
	TRNE FRR,NOPSW		;[603] WANT POLISH?
	JRST EVXCT1		;[603] NO,
	CAILE PS,11		;OPS 12 AND 13
	JRST POLPSH		; REQUIRE POLISH FIXUPS
	TDNN RC,[777700,,777700] ;CHECK FOR EXTERNALS IN EITHER 
	TDNE PR,[777700,,777700] ;OPERAND -- .LE. 100 ALLOWED
	JRST [	SKIPN UWVER	;[603] WRITING UNV FILE?
		JRST POLPSH	;[603] NO,
		BITON UPOL,UWVER ;[603] YES, SET FLAG FIRST
		JRST POLPSH]	;[603]
	XCT PRTAB(PS)		;TEST PREVIOUS RELOCATION
	JUMPN RC,POLPSH		;GO POLISH IF BOTH OPERANDS RELOC'L

EVXCT1:	JFCL 17,.+1		;CLEAR OVERFLOW FOR * AND /
	XCT EVTAB(PS)		;PERFORM PROPER OPERATION
	SKIPL OKOVFL		;OVERFLOW OK?
	JOV .+2			;SKIP IF * OR / OVERFLOWED
	SKIPA			;IT'S OK
	TRO ER,ERRN		;SET N ERROR FOR OVERFLOW
	JRST EVNUM		;GO TRY AGAIN

EVTAB:	JRST ASSEM1		;0; SHOULD NEVER GET HERE ;DMN
	IMULM PV,CV		;1; MUL
	IDIVM PV,CV		;2; DIV
	JRST XADD		;3;
	JRST XSUB		;4;
	CALL XLRW		;5; "_"
	IOR CV,PV		;6; MERGE PV INTO CV
	AND CV,PV		;7; AND PV INTO CV
	XOR CV,PV		;10; XOR PV INTO CV
	SETCM CV,CV		;11; NOT (ONE'S COMPLIMENT)
	MOVN CV,CV		;12; NEGATE (TWO'S COMPLEMENT)
	JFCL			;13; ADDITIVE PSECT OPERATION
REPEAT 4,<CALL EVXERR>		;14-17; JUST IN CASE
NEGEXT:	MOVSI PS,4000		;FAKE UP EVPUSH OF
	ADDM PS,(P)		; PS
	PUSH P,[0]		; CV
	PUSH P,[0]		; RC
	PUSH P,CSTATM		; CS
	TLZ FR,NEGSW		;CLEAR FLAG
	JRST EVGETD		;NOW EVALUATE

PRTAB:	JFCL			;0
	JRST CHKPR		;1 MUL
	JRST CHKPRD		;2 DIV
	JRST CHKADD		;[1044] 3 ADD
	JUMPN PR,CHKSUB		;[734] 4 SUB
	JRST CHKPRD		;5 SHIFT
	JRST CHKIOR		;6 IOR
	JUMPN PR,POLPSH		;[662] 7 AND
	JUMPN PR,POLPSH		;[662] 10 XOR
	JFCL			;[662] 11 NOT

;CHECK RELOCATION WHERE SECOND OPERAND MUST BE ABSOLUTE
CHKPRD:	JUMPN RC,POLPSH		;GO POLISH IF SECOND ARG NOT ABSOLUTE

;CHECK RELOCATION FOR MULTIPLICATIVE OPERATORS
CHKPR:	SKIPN PR		;FIRST OPERAND RELOCATABLE?
	JRST [	JUMPE RC,EVXCT1	;NO, JUMP IF SECOND ALSO NOT RELOC
		PUSH P,PV	;SAVE VALUES
		PUSH P,CV
		SETZ CV,	;CONSTRUCT EQUIVALENT RELOCATABLE VALUE
		TRNE RC,-1	;RH?
		HRRI CV,-1	;YES
		TLNE RC,-1	;LH?
		HRLI CV,-1	;YES
		JRST CHKPR2]	;DO OPERATION AND TEST RESULTS
	JUMPN RC,POLPSH		;POLISH REQUIRED IF BOTH RELOCATABLE
	PUSH P,PV		;SAVE VALUES
	PUSH P,CV
	SETZ PV,		;CONSTRUCT EQUIVALENT RELOCATABLE VALUE
	TRNE PR,-1		;RH?
	HRRI PV,-1		;YES
	TLNE PR,-1		;LH?
	HRLI PV,-1		;YES
CHKPR2:	XCT EVTAB(PS)		;DO OPERATION ON RELOCATION EQUIVALENT
	SETO RC,		;FIGURE OUT WHAT HAPPENED...
	TLCN CV,-1		;LH 0?
	HRLI RC,0		;YES
	TLCN CV,-1		;LH 1?
	HRLI RC,1		;YES
	TRCN CV,-1		;RH 0?
	HRRI RC,0		;YES
	TRCN CV,-1		;RH 1?
	HRRI RC,1		;YES
	POP P,CV		;RECOVER VALUES
	POP P,PV
	TDNN RC,[-2,,-2]	;RELOC COUNTS OTHER THAN 0 OR 1?
	JRST EVXCT1		;ALL IS WELL, DO OPERATION
	SETZ RC,		;YES, GO POLISH
	JRST POLPSH

;CHECK RELOCATION FOR IOR
CHKIOR:	TDNE RC,PR		;ANY HALFWORDS IN COMMON?
	JRST POLPSH		;YES, GO POLISH

;CHECK EACH HALFWORD AGAINST THE RELOCATION COUNT IN THAT HALFWORD
;FOR THE OTHER OPERAND
DEFINE TST (OP,RR,VV)<
	OP RR,-1		;;RELOCATION NON-0?
	JRST [	OP VV,-1	;;YES, VALUE NON-0?
		JRST POLPSH	;;YES, GO POLISH
		JRST .+1]>	;;NO, CONTINUE

	TST TRNE,RC,PV
	TST TLNE,RC,PV
	TST TRNE,PR,CV
	TST TLNE,PR,CV
	IOR RC,PR		;[710] GET RELOCATION
	JRST EVXCT1		;PASSED ALL TESTS, DO OPERATION

XLRW:	EXCH PV,CV
	LSH CV,0(PV)
	RET
;HERE TO SEE IF POLISH IS REQUIRED FOR PROPER LOAD-TIME
;RELOCATION OF REL+ABS,REL+REL OR ABS+REL

CHKADD:	JUMPN PR,[ JUMPN RC,POLPSH	;[1103] REL+REL - GOES POLISH
		   CALL CHKAD0		;[1103] REL+ABS - POLISH NEEDED?
		   JRST EVXCT1		;[1103] NO
		   JRST POLPSH]		;[1103] YES
	JUMPE RC,EVXCT1			;[1103] ABS+ABS - NO POLISH
	EXCH PV,CV			;[1103] ABS+REL SWAP VALUES
	EXCH PR,RC			;[1103] AND RELOCATIONS
	CALL CHKAD0			;[1103] REL+ABS - POLISH NEEDED?
	JRST [	EXCH PV,CV		;[1103] NO - SWAP BACK VALUES
		EXCH PR,RC		;[1103] RELOCATIONS...
		JRST EVXCT1]		;[1103] NO POLISH
	EXCH PV,CV			;[1103] POLISH - SWAP BACK VALUES
	EXCH PR,RC			;[1103] RELOCATIONS...
	JRST POLPSH			;[1103] GO POLISH

;[1103] ROUTINE TO SEE IF REL+ABS REQUIRES POLISH
;[1103] EXPECTS VALUE OF REL IN PV, VALUE OF ABS IN CV
;[1103] RETURNS +1 FOR NO POLISH, +2 FOR POLISH REQUIRED

CHKAD0:	JUMPL CV,[ MOVNS CV		;[1103] NEGATIVE ABS, NEGATE
		   CALL CHKSB1		;[1103] AND SEE IF REL-ABS NEEDS POLISH
		   SKIPA		;[1103] NO
		   AOS (P)		;[1103] YES - SKIP RETURN
		   MOVNS CV		;[1103] RESTORE ABS
		   RET]			;[1103]

;[1103] CHECKS REL+ABS, ENTRY FOR REL-(-ABS)
CHKAD1:	SKIPN HMIN			;[1103] TWOSEG PROG?
	RET				;[1103] NO - FORGET POLISH
	TLNE PR,1			;[1111] YES - IS REL IN LH?
	JRST CPOPJ1			;[1111] YES - GO POLISH TO BE SURE
	JUMPGE PV,.+3			;[1111] DOES REL APPEAR TO BE NEGATIVE
	CAMLE PV,[-1,,0]		;[1111] IN RANGE -1 TO -262143
	JRST CPOPJ1			;[1111] YES - GO POLISH TO BE SURE
	CALL SRHMIN			;[1111] SETUP HMIN-400 BOUND
	PUSH P,PV			;[1103] SAVE REL VALUE
	PUSH P,CV			;[1103] AND ABS VALUE
	HRRZS PV			;[1103] GUARANTEE ONLY RH REL
	HRRZS CV			;[1103] ONLY RH ABS IS USEFUL
	CAMGE PV,RLHMIN			;[1111] IS REL HISEG OR LOWSEG?
	JRST [	ADD PV,CV		;[1111] LOW - NEED POLISH WHEN REL+ABS
		CAMGE PV,RLHMIN		;[1111] IS .GE. HISEG ORIGIN-400
		JRST CHKAD3		;[1103] FORGET POLISH
		JRST CHKAD2]		;[1103] POLISH NEEDED
	ADD PV,CV			;[1103] HISEG - NEED POLISH
	TLNE PV,1			;[1103] WHEN REL+ABS .GT. 777777
CHKAD2:	AOS -2(P)			;[1103] POLISH - SKIP RETURN
CHKAD3:	POP P,CV			;[1103] RESTORE ABS
	POP P,PV			;[1103] AND REL
	RET				;[1103]

;[1103] HERE TO SEE IF POLISH IS REQUIRED FOR PROPER LOAD-TIME
;[1103] RELOCATION OF REL-ABS

CHKSUB:	JUMPN RC,CHKSB4			;[1103] REL-REL - SPECIAL CHECKS
	JUMPGE CV,[ CALL CHKSB1		;[1103] REL-(+ABS) - NEED POLISH?
		    JRST EVXCT1		;[1103] NO
		    JRST POLPSH]	;[1103] YES
	MOVNS CV			;[1103] -ABS, NEGATE
	CALL CHKAD1			;[1103] SEE IF REL+ABS NEEDS POLISH
	JRST [	MOVNS CV		;[1103] NO - RESTORE ABS
		JRST EVXCT1]		;[1103] FORGET POLISH
	MOVNS CV			;[1103] POLISH - RESTORE ABS
	JRST POLPSH			;[1103] GO POLISH

;[1103] ROUTINE TO SEE IF REL-ABS REQUIRES POLISH
;[1103] EXPECTS VALUE OF REL IN PV, VALUE OF ABS IN CV
;[1103] RETURNS +1 FOR NO POLISH, +2 FOR POLISH REQUIRED

CHKSB1:	SKIPN HMIN			;[1103] TWOSEG PROG?
	JRST [  SKIPN HISNSW		;[1103] NO - HISEG OR
		SKIPE SGNMAX		;[1103] PSECT PROG
		JRST .+1		;[1103] YES - CHECK FURTHER
		RET]			;[1103] NO - FORGET POLISH
	TLNE PR,1			;[1111] IS REL IN LH?
	JRST CPOPJ1			;[1111] YES - GO POLISH TO BE SURE
	JUMPGE PV,.+3			;[1111] DOES REL APPEAR TO BE NEGATIVE
	CAMLE PV,[-1,,0]		;[1111] IN RANGE -1 TO -262143
	JRST CPOPJ1			;[1111] YES - GO POLISH TO BE SURE
	CALL SRHMIN			;[1111] SETUP HMIN-400 BOUND
	PUSH P,PV			;[1103] SAVE REL
	HRRZS PV			;[1103] ASSURE ONLY RH REL
	SKIPE HMIN			;[1103] TWOSEG PROG?
	CAMGE PV,RLHMIN			;[1111] YES - HISEG OR LOWSEG?
	JRST [	SKIPN HISNSW		;[1103] LOWSEG, OR NOT TWOSEG, IS
		SKIPE SGNMAX		;[1103] IT A HISEG OR PSECT PROG?
		CAMGE PV,CV		;[1103] YES - IS REL .GE. ABS
		AOS -1(P)		;[1103] NO - NEED POLISH SKIP RETURN
		POP P,PV		;[1103] RESTORE REL
		RET]			;[1103]
	SUB PV,CV			;[1111] HISEG - NEED POLISH WHEN REL-ABS
	CAMGE PV,RLHMIN			;[1111] IS .LT. HISEG ORIGIN-400
	AOS -1(P)			;[1103] YES - POLISH NEEDED
	POP P,PV			;[1103] RESTORE REL
	RET				;[1103]

;[1103] ROUTINE TO SEE IF REL-REL REQUIRES POLISH

CHKSB4:	SKIPN HMIN			;[1103] TWOSEG PROG?
	JRST EVXCT1			;[1103] NO - FORGET POLISH
	TLNN PR,1			;[1103] DOES EITHER REL APPEAR IN THE
	TLNE RC,1			;[1103] LH, OR AS LH,,RH?
	JRST POLPSH			;[1103] YES - GO POLISH TO BE SURE
	JUMPGE PV,.+3			;[1111] DOES REL APPEAR TO BE NEGATIVE
	CAMLE PV,[-1,,0]		;[1111] IN RANGE -1 TO -262143
	JRST POLPSH			;[1111] YES - GO POLISH TO BE SURE
	JUMPGE CV,.+3			;[1111] DOES REL APPEAR NEG.
	CAMLE CV,[-1,,0]		;[1111] RANGE -1 TO -262143
	JRST POLPSH			;[1111] YES - GO POLISH
	CALL SRHMIN			;[1111] SETUP HMIN-400 BOUND
	PUSH P,PV			;[1103] SAVE BOTH RELS
	PUSH P,CV			;[1103] ...
	HRRZS PV			;[1103] GUARANTEE RH ONLY
	HRRZS CV			;[1103] ...
	CAMGE PV,RLHMIN			;[1111] IS FIRST REL HISEG OR LOWSEG?
	JRST [	CAMGE CV,RLHMIN		;[1111] ARE BOTH RELS IN LOWSEG?
		JRST CHKSB5		;[1103] YES - FORGET POLISH
		JRST CHKSB6]		;[1103] NO - POLISH NEEDED
	CAML CV,RLHMIN			;[1111] ARE BOTH RELS IN HISEG?
CHKSB5:	JRST [	POP P,CV		;[1103] BOTH RELS IN SAME SEGMENT
		POP P,PV		;[1103] RESTORE RELS
		JRST EVXCT1]		;[1103] FORGET POLISH
CHKSB6:	POP P,CV			;[1103] RELS IN DIFFERENT SEGMENTS
	POP P,PV			;[1103] RESTORE RELS
	JRST POLPSH			;[1103] GO POLISH

;[1111] ROUTINE TO SETUP HMIN-400 PRIOR TO CHECKING REL+ABS, REL-ABS,
;[1111] AND REL-REL TO SEE IF POLISH IS NEEDED
SRHMIN:	PUSH P,CV			;[1111] SAVE AC
	MOVE CV,HMIN			;[1111] GET HI SEG ORIGIN
	SUBI CV,400			;[1111] REDUCE TO LOWEST BOUND
	MOVEM CV,RLHMIN			;[1111] SAVE FOR COMPARES
	POP P,CV			;[1111] RESTORE
	RET				;[1111]
   >

;HERE IF THERE IS PROBLEM WITH EXPRESSION PARSING AND EVALUATION
;GETTING ILLEGAL OPERATORS
EVXERR:	PUSH P,['MCREPP']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT/ EXPRESSION PARSING PROBLEM@/] ;[1066]
	JRST ERRNE4		;[702] GIVE FATAL ERROR, CONTINUE
XSUB:	SUBM PV,CV
	SUBM PR,RC
	JRST EVNUM

XADD:	ADDM PV,CV
	ADDM PR,RC
	JRST EVNUM

   IFE POLISH,<
XDIV:	IDIV PR,CV		;CORRECT RELOCATABILITY
	JFCL 17,.+1		;CLEAR OVERFLOW
	IDIVM PV,CV
	SKIPL OKOVFL		;SKIP IF OVERFLOW OK
	JOV .+2			;SEE IF OVERFLOWED
	SKIPA			;NO
	TRO ER,ERRN		;YES, SET N ERROR
XDIV1:	EXCH PR,RC		;TAKE RELOCATION OF NUMERATOR
	JRST EVXCT1

XMUL:	JUMPE PR,XMUL1		;AT LEAST ONE OPERAND
	JUMPE RC,XMUL1		;MUST BE FIXED
	TRO ER,ERRR
XMUL1:	IORM PR,RC		;GET RELOCATION TO RC
	CAMGE PV,CV		;FIND THE GREATER
	EXCH PV,CV		;FIX IN CASE CV=0,OR 1
	IMULM PV,RC
	JFCL 17,.+1		;CLEAR OVERFLOW
	IMULM PV,CV
	SKIPL OKOVFL		;SKIP IF OVERFLOW OK
	JOV .+2			;SEE IF OVERFLOW
	SKIPA			;NO
	TRO ER,ERRN		;YES, SET N ERROR
	JRST EVNUM

XLRW:	EXCH PV,CV
	LSH CV,0(PV)
	LSH PR,0(PV)
	JRST XDIV1
   >
;HERE FOR EXTERNAL ARITHMETIC
;CONVERS TO POLISH BLOCK TYPE 11
   IFN POLISH,<
POLPSH:	JUMP1 [SKIPE LITLVL	;ONLY SAVE POLISH ON PASS2
		TRO ER,ERRF	;SET FAKE FLAG IF IN LITERAL
		JRST EVXCT1]
	SKIPE INBYTE		;[762] DOING BYTE?
	JRST [	TRO ER,ERRE	;[762] YES,
		JRST EVXCT1]	;[762] CAN'T HANDLE POLISH
	TRNE FRR,LTGSW		;[735] DOING POLISH WITH LIT-TAG?
	TRO ER,ERRA		;[735] YES, A-ERROR
	TLO FR,POLSW		;SIGNAL STORING POLISH
	CAMN PR,[-1]		;DO WE HAVE A -1 RELOCATION?
	CALL POLPPR		;YES,
	CAMN RC,[-1]		;HOW ABOUT THE OTHER OPERAND?
	CALL POLPRC		;YES,
	JUMPL PR,[CAMN PR,[-2]	;[1040] PREVIOUS VALUE WAS A POLISH?
		JRST .+1	;[1040] NO INTER-PSECT DUMMY RELOCATION
		PUSH P,RC	;[1040] YES, MOVE PV & PR INTO CV AND RC
		PUSH P,CV	;[1040] FOR MOVING THE ENBEDDED POLISH
		MOVE RC,PR	;[1040] INTO FREE SPACE
		MOVE CV,PV	;[1040] VIA MOVSTK
		CALL MOVSTK	;[1040]
		MOVE PR,RC	;[1040] THE NEW RC INTO FREE SPACE
		MOVE PV,RC	;[1040] BECOMES PR & PV
		POP P,CV	;[1040] RESTORE REAL CV & RC
		POP P,RC	;[1040]
		JRST .+1]	;[1040]
	JUMPL RC,[CAMN RC,[-2]	;[1040]
		JRST .+1	;[1040]
		CALL MOVSTK	;[1040]
		JRST .+1]	;[1040]
	SKIPE SGNMAX		;[1101] IF NO PSECTS
	CAMN PR,[-2]		;[1101] OR DOING SIMPLE INTER-PSECT REF
	JRST POLPS2		;[1101] SKIP RELOCATABLE CHECKS
	TDNN PR,[-2,,-2]	;[1101] IF PREVIOUS IS EXTERNAL
	SKIPN PR		;[1101] OR NOT RELOCATABLE
	JRST POLPS1		;[1101] GO CHECK CURRENT
	PUSH P,CV		;[1101] PREVIOUS IS RELOCATABLE, SAVE ACS
	PUSH P,RC		;[1101] .....
	MOVE CV,PV		;[1101] MAKE PREVIOUS CURRENT
	MOVE RC,PR		;[1101] ....
	CALL POLROR		;[1101] CREATE POLISH WITH PSECT OF ORIGIN
	MOVE PV,CV		;[1101] STORE NEW PREVIOUS
	MOVE PR,RC		;[1101] ....
	POP P,RC		;[1101] RESTORE CURRENT
	POP P,CV		;[1101] ....
POLPS1:	TDNN RC,[-2,,-2]	;[1101] IF CURRENT IS EXTERNAL
	SKIPN RC		;[1101] OR NOT RELOCATABLE
	SKIPA			;[1101] CONTINUE WITH POLISH GENERATION
	CALL POLROR		;[1101] ELSE CREATE POLISH WITH PSECT OF ORIGIN
POLPS2:				;[1101]
	PUSH P,POLSTK		;[1040] SAVE STACK POINTER
	EXCH P,POLSTK		;[1040] SAVE P AND SET UP POLISH STACK
	PUSH P,POLTBL-1(PS)	;STACK OPERATOR
	PUSH P,PR		;STACK PREVIOUS RELOCATION
	PUSH P,PV		;AND VALUE
	PUSH P,RC		;STACK CURRENT
	PUSH P,CV
	EXCH P,POLSTK		;GET P BACK
	POP P,CV		;USE STACK POINTER FOR VALUE
	MOVE RC,CV		;AND RELOCATION (ENSURES EXTERNAL)
	CAILE PS,11		;[1101] WAS THIS A FORCED POLISH OPERATION?
	CALL MOVSTK		;[1101] YES - MOVE POLISH TO SAFE PLACE
	JRST EVNUM

POLPPR:	CAIE PS,3		;DOING +?
	JRST [	CAIN PS,4	;NO, DOING -?
	 	MOVEI PS,3	;YES, MAKE IT +
		JRST .+2]	;GO NEGATE THE VALUE
	MOVEI PS,4		;ITS +, MAKE IT -
	MOVEI PR,1		;MAKE RELOCATION 1
	MOVNS PV,PV		;NEGATE VALUE
	RET

POLPRC:	CAIE PS,3		;DOING +?
	JRST [	CAIN PS,4	;NO, DOING -?
		MOVEI PS,3	;YES, MAKE IT +
		JRST .+2]	;GO NEGATE THE VALUE
	MOVEI PS,4		;ITS +, MAKE IT -
	MOVEI RC,1		;MAKE RELOCATION 1
	MOVNS CV,CV		;NEGATE VALUE
	RET


;[1101] HERE TO CREATE A POLISH BLOCK FOR THE CURRENT RELOCATABLE ATOM
;[1101]	CONTAINING ITS PSECT OF ORIGIN - IN CASE THIS RELOCATABLE IS EVER
;[1101] IMBEDDED WITHIN POLISH DURING AN INTER-PSECT REFERENCE.
POLROR:	PUSH P,POLSTK		;[1101] SAVE STACK POINTER
	EXCH P,POLSTK		;[1101] SETUP POLISH STACK, SAVE P
	PUSH P,[15]		;[1101] OPERATOR IS PSECT OPERATOR
	PUSH P,[-2]		;[1101] INTER-PSECT DUMMY RELOC
	PUSH P,SGNCUR		;[1101] PSECT OF ORIGIN
	PUSH P,RC		;[1101] CURRENT RELOC
	PUSH P,CV		;[1101] AND VALUE
	EXCH P,POLSTK		;[1101] RESTORE P, SAVE POLISH STACK PTR
	POP P,RC		;[1101] NEW RELOC - POLISH
	CALL MOVSTK		;[1101] PUT POLISH BLOCK IN SAFE PLACE
	MOVE CV,RC		;[1101] USE STACK POINTER FOR VALUE
	RET			;[1101]
		;TRY NEXT ITEM
;HERE TO STORE THE POLISH LIST
;RC  (AND CV) HAVE POINTER TO TOP ITEM IN PUSHDOWN STACK
POLPOP:	CALL POLFRR		;[636] SET UP FRR POLISH FLAGS
	SKIPE INBYTE		;[1077] DOING BYTE?
	JRST [	TRO ER,ERRE	;[1077] YES - CAN'T BE POLISH
		RET]		;[1077]
	SKIPE BYTESW		;[1114] DOING BYTE PSEUDO-OP?
	TRNE FRR,FWPSW		;[1114] YES - SKIP IF NOT FULLWORD FIXUP
	TRNN FRR,FWPSW!RHPSW	;[1114] FULL OR RIGHT HALF POLISH FIXUP?
	JRST POLPO1		;[636] NO,
	CAIN C,'('		;[636] DOING INDEXING?
	JRST POLIDX		;[636] YES, JUMP
	CAIN C,')'		;[636] A CLOSE PARENT?
	JRST [	TRZE FRR,PIDXSW	;[636] YES, FINISHING UP INDEX CALC?
		CALL GETCHR	;[636] YES, 
		JRST .+1]	;[636]
	TRNE FRR,RHPSW		;[1114] RIGHT HALF FIXUP?
	JRST POLPO1		;[1114] YES - DO IT IN OP
	TLZE FR,INDSW		;INDIRECT?
	JRST POLIND		;YES,
POLPO1:	SKIPE INANGL		;STILL IN EVALUATION?
	JRST [	CAMN RC,XWDANG ;[773] WE HAVE LEFT POL, SUCH THAT LEFT POL=RIGHT POL?
		MOVEM RC,XWDRRC	;[773] FLAG IT
		MOVEM RC,INANGL	;YES, MARK STACK
		SETZB RC,CV	;0 SO OP NOT CONFUSED
		SETZM EXTPNT
		TLZ FR,POLSW
		RET]		;WILL MOVE LATER
	TRNE FRR,IDXSW		;[1107] DOING OP INDEXING?
	JRST [	SETZB RC,CV	;[1107] YES - CLEAR VALUE AND RELOC
		SETZM EXTPNT	;[1107] CLEAR ANY EXTERNALS
		TLZ FR,POLSW	;[1107] ....
		RET]		;[1107] RETURN WITH FRR FLAGS
	SKIPN BSHIFT		;[1037] JUST RETURN IF DOING B-SHIFT
	SKIPE INIOWD		;[730] DOING IOWD?
	RET			;[730] YES, RETURN
	SKIPN INASGN		;[624] IF DEFINING A SYMBOL JUST SAVE
	SKIPE INOPDF		;[624] DOING OPDEF?
	JRST POLASG		;[624]
POLSYM:	MOVE PV,FREE		;GET NEXT FREE LOCATION
	EXCH PV,POLIST		;SWAP STACK POINTER
	CALL POLSTR		;STORE POINTER TO NEXT POLISH BLOCK
	CALL POLOPF		;STORE FIRST OPERATOR
	CALL POLFST		;STORE FIRST PART
	CALL POLSND		;STORE SECOND PART
POLOCT:	CALL POLFRR		;[644][636] SET UP FRR POLISH FLAGS
	XCT 3+[SETZM EXTPNT	;FULL WORD
		HRRZS EXTPNT	;LEFT HALF
		HLLZS EXTPNT](PV) ;RIGHT HALF
	SKIPN INASGN		;[624] DEFINING A SYMBOL?
	SKIPE INOPDF		;[624] OPDEF?
	JRST POLSTS		;YES
	CALL POLSTO		;STORE IT
	SKIPE PHALVL		;INSIDE PHASE?
	JRST [	MOVE PV,LOCO	;YES, USE ORIGINAL LOC
		HRL PV,MODO	;AND MODE
		JRST POLOC1]
	MOVE PV,LOCA		;LOCATION
	HRL PV,MODA		;AND MODE
POLOC1:	SKIPN LITLVL		;HOWEVER IF IN A LITERAL
	JRST POLPOR
	MOVE PV,POLIST		;WE CAN NOT SUPPLY THE STORE ADDRESS YET
	MOVE CV,(PV)		;SO PUT IN A SPECIAL LIST
	MOVEM CV,POLIST		;REMOVE FROM REGULAR LIST
	EXCH PV,POLITS		;STORE IN POLIST LIT LIST
	MOVEM PV,@POLITS	;LINK TOGETHER
	MOVE PV,STPX		;STORE DEPTH IN THIS LIT
	SUB PV,STPY		;WITH NO RELOCATION YET
	TRO ER,ERRF		;SET FAKE FLAG
POLPOR:	CALL POLSTR
	SETZB RC,CV		;USE ZERO VALUE AND RELOCATION
POLRET:	MOVE PV,POLPTR		;RESET INITIAL POLISH POINTER
	MOVEM PV,POLSTK
	RET			;RETURN
;HERE FOR POLISH SYMBOL FIXUPS
POLSTS:	SUBI PV,3		;DIFFERENT STORE OPERATOR
	CALL POLSTO		;STORE IT
	SKIPE INASGN		;[624]
	MOVE PV,INASGN		;GET RADIX-50 SYMBOL
	MOVE AC0,POLIST		;GET BLOCK
	JRST POLPOR		;STORE IT

;[636] HERE TO MOVE POLTYP INTO AC PV AND SET APPROPRIATE FLAGS IN FRR
POLFRR:	SKIPE PV,POLTYP		;USE PRESET TYPE
	JRST [JUMPL PV,POLFR1	;SET AND PERMANENT
		HRRO PV,PV	;COMPLETE OPERATOR
		JRST POLFR1]	;FINALLY
	HRREI PV,POLRHF		;ASSUME RH FIXUP
	JUMPNC POLFR1		;COMMA?
	HRREI PV,POLLHF		;YES, LH FIXUP
POLFR1:	XCT 3+[TRO FRR,FWPSW	;[614] FULL FOWRD
		TRO FRR,LHPSW	;[614] LEFT HALF
		TRO FRR,RHPSW](PV) ;[614] RIGHT HALF
	RET			;[636]

;HERE TO DO FULL WORD FIXUP OF POLISH AND INDIRECT
POLIND:				;[750]
	SETZ AC0,		;ZERO VALUE
	TLO AC0,(Z @)		;TURN ON INDIRECT BIT
	MOVE PS,CSTAT+'!'	;FORCE IOR 
	JRST FORCEP		;GO DO IT

;HERE TO DO FULL WORD FIXUP OF POLISH AND INDEX
POLIDX:				;[750]
	TRO FRR,PIDXSW		;[636] FLAG IT
	TLZE FR,INDSW		;[1114] IF INDIRECTION, CLEAR FOR NOW
	SETOM PINDFL		;[1114] BUT REMEMBER IT FOR LATER
	PUSH P,RC		;[636] STORE AWAY RC FOR WHILE
	PUSH P,EXTPNT		;[1073] ALONG WITH EXTERNAL POINTERS
	SETZM EXTPNT		;[1073] CLEAR RELOC
	TRO FRR,NOPSW		;[1107] DO NOT ALLOW POLISH
	CALL EVALCM		;[636] GO DO INDEX CALCULATION
	TRZ FRR,NOPSW		;[1107] ALLOW POLISH AGAIN
	TRNN FRR,RHPSW		;[1114] RIGHT HALF POLISH FIXUP
	JRST POLID1		;[1114] NO - DO FULL WORD
	SETOM PLHIDX		;[1114] INDICATE LH INDEX FROM POLISH
	HRRZM AC0,PIDXVL	;[1114] SAVE SWAPPED LH OF INDEX
	HLLZS AC0		;[1114] KEEP RH
	HRRZM RC,PIDXRC		;[1114] SAVE SWAPPED RC OF LH
	HLLZS RC		;[1114] KEEP RH
	JRST POLID2		;[1114] AND CONTINUE
POLID1:	PUSH P,[0,,POLFWF]	;[1114] MAKE SURE ITS FWF
	POP P,POLTYP		;[1114] ...
POLID2:	SKIPE PINDFL		;[1114] INDIRECTION SAVED?
	JRST [	TLO FR,INDSW	;[1114] YES - REPLACE IT
		SETZM PINDFL	;[1114] AND CLEAR FLAG
		JRST .+1]	;[1114]
	SKIPE RC		;[636] DO WE HAVE ABS VALUE?
	TRO ER,ERRR		;[636] NO, RELOCATION ERROR
	TLNE AC0,-1		;[1107] IS THERE A LEFT HALF?
	TRO ER,ERRQ		;[1107] YES - FLAG ERROR
	MOVSS AC0		;[1114] SWAP VALUE
	POP P,EXTPNT		;[1073] RESTORE EXTERNAL RELOC
	POP P,RC		;[636] GET BACK RC WHICH HAS POLISH PTR
	MOVE PS,CSTAT+'+'	;[1114] FORCE ADDITIONAL ADD
	JRST FORCEP		;[636] GO DO IT
;HERE TO STORE CURRENT POLISH STACK
;WE MUST MOVE IT TO A SAFE PLACE
POLASG:	CALL MOVSTK		;MOVE STACK
	JRST POLRET

MOVSTK:	JUMPGE RC,CPOPJ		;[1010] RETURN IF NOT POLISH
	PUSH P,SDEL		;SAVE ACC
	PUSH P,AC1		;...
	HRRZ AC1,POLSTK		;GET TOP OF STACK
	HRRZ SDEL,RC		;GET RH OF RC
	CAMLE SDEL,AC1		;RH(RC) .LE. RH(POLSTK)?
	JRST MOVNOT		;NO, JUMP, SINCE ADDITIONAL POLISH
	CAME RC,POLPTR		;[623] POLISH OF POLISH?
	HRRM AC1,POLPTR		;[623] YES, READ JUST BEGINNING POINTER
	SUBI AC1,(RC)		;GET + LENGTH - 1
	HRRZI SDEL,1(AC1)	;+ LENGTH
	ADD SDEL,FREE		;NEW TOP
	CAML SDEL,SYMBOL	;WILL IT FIT
	CALL XCEED		;NOT YET
	EXCH SDEL,FREE		;BASE IN SDEL
	HRL SDEL,RC		;FROM
	HRR RC,SDEL		;NEW RELOC PTR
	MOVE CV,AC1		;COPY LENGTH
	HRL CV,CV		;INTO BOTH HALVES
	MOVE AC1,FREE		;TOP +1
	BLT SDEL,-1(AC1)	;MOVE IT
	MOVE AC1,POLSTK		;GET STACK PTR
	SUB AC1,CV		;BACKUP
	MOVEM AC1,POLSTK
	SETZ CV,		;[730] SET CURRENT VALUE TO 0
MOVNOT:	POP P,AC1		;RESTORE
	POP P,SDEL		;...
	RET
;THIS IS A KLUDGE TO PRODUCE ADDITIVE GLOBALS FOR THE FEW CASES THAT THEY
;CAN HANDLE. I.E. K+GLOBAL, GLOBAL+K, GLOBAL-K
;SO THAT OLD PROGRAMS WILL COMPIL THE SAME WAY AND LOAD WITH THE
;OLD LOADER WITHOUT THE FAILSW CODE
;APART FROM ADDITIVE SYMBOL FIXUPS POLISH BLOCKS ARE MORE POWERFUL
;***** REMOVE SOMEDAY
POLOPF:	SKIPE POLTYP		;IF ALREADY SETUP THEN
	JRST POLOPX		;WE MUST USE POLISH (EXP OR OCT)
	JUMPL RC,POLOPX		;TOO COMPLEX IF ALREADY A POINTER
	HRRZ PS,1(RC)		;GET FIRST OPERATOR
	CAIE PS,3		;CAN ONLY HANDLE ADD
	CAIN PS,4		;AND SUBTRACT
	JRST POLOP2		;ITS ONE OF THOSE  GIVE IT A TRY
;*****
POLOPX:				;[575]
IFN FTPSECT,<			;[575]
	SKIPN SGNMAX		;PSECTS USED?
	JRST POLOPR		;NO
	PUSH P,PV		;SAVE FIRST OP
	HRRO PV,SGNCUR		;GET CUR PSECT INX
	TRO PV,400000		;MAKE POLISH OP
	CALL POLSTR		;STORE IT
	POP P,PV		;GET FIRST OP
>				;END IFN FTPSECT
POLOPR:	HRRZ PV,RC		;[1051] GET RH OF RC
	CAMLE PV,.JBREL		;[1051] ABOUT TO ILL MEM REF?
	JRST [	TLO FR,LOADSW	;[1051]
		CALL EVXERR	;[1051][1007] YES, THIS SHOULDN'T HAPPEN.  GIVE MSG.
		TLZ FR,LOADSW	;[1051] LOADSW ENSURED THAT WE RETURNED
		SETZB AC0,RC	;[1007] MUST HAVE TYPOS..  CLEAR AC'S
		JRST POLRET]	;[1007] JUST RETURN.
	HRRZ PV,1(RC)		;GET OPERATOR
	CAIL PV,OTLEN		;A VALID OPERATOR INDEX?
	JRST EVXERR		;NO, GIVE ERROR
	XCT OPRTBL-3(PV)	;ANYTHING SPECIAL?
	HRRO PV,1(RC)		;GET OPERATOR AND FLAG IT
	JRST POLSTR		;STORE IT AND EXIT

POLAPO:	AOS 0(P)		;SKIP FIRST OPERAND
	MOVE PV,3(RC)		;[1101] GET PSECT INDEX
	CAMN PV,SGNCUR		;[1101] SAME AS CURRENT (GLOBAL) PSECT?
	RET			;[1101] YES - NO NEED TO STORE IT
	TDO PV,[-1,,400000]	;[1101] NO - MAKE POLISH OP
	JRST POLSTR		;STORE AND EXIT

;***** MORE OF THIS KLUDGE
POLOP2:	SUBI PS,3		;MAKES LIFE EASIER
	MOVE CV,4(RC)		;GET 2ND OPERAND
	JUMPL CV,POLOPX		;ITS A POINTER, THEREFORE TOO COMPLEX
	MOVE PV,2(RC)		;AND 1ST OPERAND
	JUMPL PV,POLOPX		;THIS IS A POINTER
	TDNN CV,[-2,,-2]	;TEST FOR EXTERN
	JRST [TRNE CV,1		;TEST FOR BOTH RELOCATABLE
		TRNN PV,1
		JRST POLOP3	;THIS IS NOT EXTERN SO OTHER CAN BE
		JRST POLOPX]	;CANNOT HANDLE HERE, USE POLISH
	JUMPN PS,POLOPX		;CAN NOT HANDLE -GLOBAL
	TDNE PV,[-2,,-2]	;TEST FOR EXTERN HERE
	JRST POLOPX		;GLOBAL+GLOBAL TOO COMPLEX
POLOP3:	SOS FREE		;BACKUP FREE COUNTER
	MOVE PV,@FREE		;GET LAST POINTER
	MOVEM PV,POLIST		;SET POINTER BACK
	POP P,PV		;POP RETURN OFF STACK
	TLZ FR,POLSW		;CLEAR FLAG JUST IN CASE
;RELOAD RC, CV, PV, AND PR FROM STACK
;AND EXECUTE OPERATOR
	MOVE PR,2(RC)
	MOVE PV,3(RC)
	MOVE CV,5(RC)
	MOVE RC,4(RC)		;THIS ONE LAST OF COURSE
	JUMPN PS,POLOP5		;DO MINUS
	ADDM PV,CV
	ADDM PR,RC
	JRST POLRET		;RESTORE STACK AND RETURN

POLOP5:	SUBM PV,CV
	SUBM PR,RC
	JRST POLRET
;***** END OF THIS KLUDGE
;HERE TO HANDLE FIRST OPERAND
;HIGHLY RECURSIVE
POLFST:	SKIPGE PV,2(RC)		;GET RELOCATION
	JRST POLFSR		;THIS IS ANOTHER POINTER
	TDNE PV,[-2,,-2]	;IS IT EXTERNAL?
	JRST [SKIPN 3(RC)	;[703] IF VALUE.NE.0, FUDGE IN CONSTANT
		JRST POLFS2	;[703]
		HRRZ CV,3(RC)	;[703] GET VALUE
		HRROI PV,3	;[703]
		CALL POLSTR	;[703] STORE
		CALL POLFS3	;[703] USE COMMON CODE
		MOVE PV,2(RC)	;[703] GET BACK RELOCATION
		JRST POLFS2]	;[703]
	MOVE CV,3(RC)		;GET VALUE
POLFS4:	TLNN PV,-1		;CHECK FOR LEFT HALF VALUE
	TLNE CV,-1
	JRST POLFS1		;YES, NEED FULL WORD
	HRL CV,PV		;XWD RELOC ,, VALUE
POLFS3:	SETZ PV,		;[703] OPERAND IS 0 FOR 18 BIT VALUE
	CALL POLSTR
	MOVE PV,CV
	JRST POLSTR		;STORE AND EXIT

POLFS1:	MOVEI PV,1		;OPERAND IS 1 FOR 36 BIT VALUE
	CALL POLSTR
	MOVE PV,2(RC)		;RELOCATION
	CALL POLSTR
	MOVE PV,CV		;VALUE
	JRST POLSTR

POLSN2:
POLFS2:	MOVE CV,1(PV)		;GET SIXBIT SYMBOL INTO AC0
	MOVEI PV,2		;OPERAND IN 2 FOR SYMBOL
	CALL POLSTR
	MOVEI ARG,4		;MAKE GLOBAL REQUEST
	CALL SQOZE		;TO RADIX-50
	MOVE PV,CV		;PUT IN RIGHT ACC
	JRST POLSTR		;STORE IT

POLFSR:;	CAME PV,3(RC)	;CHECK TO MAKE SURE IT REALLY IS A POINTER
;	JRST POLFSN		;NO, ITS A NEGATIVE GLOBAL
	PUSH P,RC		;SAVE THIS POINTER
	MOVE RC,PV		;GET NEXT POINTER
	CALL POLOPR		;GET OPERATOR
	CALL POLFST		;GET FIRST OPERAND
	CALL POLSND		;GET SECOND OPERAND
	POP P,RC		;GET BACK PREVIOUS POINTER
	RET			;RETURN TO PREVIOUS LEVEL

POLFSN:	HRROI PV,14		;TWO'S COMPLIMENT NEGATIVE
	CALL POLSTR		;STORE OPERATOR
	MOVN PV,2(RC)		;GET RELOCATION
	TDNE PV,[-2,,-2]	;CHECK FOR EXTERN
	JRST POLFS2		;IT IS, CONVERT TO RADIX-50
	MOVN CV,3(RC)		;GET VALUE
	JRST POLFS4		;AND STORE IT
;HERE TO HANDLE 2ND OPERAND, ALSO RECURSIVE
POLSNR:;	CAME PV,5(RC)	;MAKE SURE IT REALLY IS
;	JRST POLSNN		;ITS A NEGATIVE GLOBAL
	MOVE RC,PV		;GET NEXT POINTER
	CALL POLOPR		;STORE OPERATOR
	CALL POLFST		;GET 1ST OPERAND, THEN ON TO 2ND

POLSND:	SKIPGE PV,4(RC)		;GET RELOCATION
	JRST POLSNR		;THIS IS A POINTER
	TDNE PV,[-2,,-2]	;IS IT EXTERNAL?
	JRST [SKIPN 5(RC)	;[1110] IF VALUE.NE.0, FUDGE IN CONSTANT
		JRST POLSN2	;[1110]
		HRRZ CV,5(RC)	;[1110] GET VALUE
		HRROI PV,3	;[1110]
		CALL POLSTR	;[1110] STORE
		CALL POLSN3	;[1110] USE COMMON CODE
		MOVE PV,4(RC)	;[1110] GET BACK RELOCATION
		JRST POLSN2]	;[1110]
	MOVE CV,5(RC)		;GET VALUE
POLSN4:	TLNN PV,-1		;CHECK FOR LEFT HALF VALUE
	TLNE CV,-1
	JRST POLSN1		;YES, NEED FULL WORD
	HRL CV,PV		;XWD RELOC ,, VALUE
POLSN3:	SETZ PV,		;[1110] OPERAND IS 0 FOR 18 BIT VALUE
	CALL POLSTR
	MOVE PV,CV
	JRST POLSTR		;STORE AND EXIT

POLSNN:	HRROI PV,14		;TWO'S COMPLIMENT NEGATIVE
	CALL POLSTR		;STORE OPERATOR
	MOVN PV,4(RC)		;GET RELOCATION
	TDNE PV,[-2,,-2]	;CHECK FOR EXTERN
	JRST POLSN2		;IT IS, CONVERT TO RADIX-50
	MOVN CV,5(RC)		;GET VALUE
	JRST POLSN4		;AND STORE IT

POLSN1:	MOVEI PV,1		;OPERAND IS 1 FOR 36 BIT VALUE
	CALL POLSTR
	MOVE PV,4(RC)		;RELOCATION
	CALL POLSTR
	MOVE PV,CV		;VALUE
	JRST POLSTR

POLSTO:	MOVE SDEL,FREE		;GET NEXT FREE WORD
	MOVEM SDEL,LSTOPR	;STORE POINTER TO STORE OP
POLSTR:	AOS SDEL,FREE		;GET A FREE WORD
	CAML SDEL,SYMBOL	;ENOUGH?
	CALL XCEED		;NO
	MOVEM PV,-1(SDEL)	;STORE ONE WORD
	RET
;TABLE OF CORRESPONDENCE BETWEEN MACRO-10 OPERATORS AND BLOCK 11 OPERATORS
POLTBL:				;POLISH VALUE MACRO-10 OPERATOR
	5			;1		MULTIPLY
	6			;2		DIVIDE
	3			;3		ADD
	4			;4		SUBTRACT
	11			;5		LEFT SHIFT
	10			;6		LOGICAL IOR
	7			;7		LOGICAL AND
	12			;10		LOGICAL XOR
	13			;11		NOT
	14			;12		NEGATE
	15			;13		ADDITIVE PSECT OPERATION
	REPEAT 3,<CALL EVXERR>	;IN CASE OF BAD OPERATOR

OPRTBL:
	JFCL			;3		ADD
	JFCL			;4		SUBTRACT
	JFCL			;5		MULTIPLY
	JFCL			;6		DIVIDE
	JFCL			;7		LOGICAL AND
	JFCL			;10		LOGICAL IOR
	JFCL			;11		LEFT SHIFT
	JFCL			;12		LOGICAL XOR
	AOS (P)			;13		NOT
	AOS (P)			;14		NEGATE
	JRST POLAPO		;15		ADDITIVE PSECT OPERATION
OTLEN==.-OPRTBL+3		;LENGTH OF THIS TABLE + 3
   >;END OF IFN POLISH
	SUBTTL LITERAL STORAGE HANDLER

STOLER:
   IFE FORMSW,< SETZB AC0,RC	;ERROR, NO CODE STORED
	CALL STOW>		;STOW ZERO
   IFN FORMSW,< MOVEI AC0,0
	CALL STOWZ1>
	TRO ER,ERRL		;AND FLAG THE ERROR

STOLIT:	MOVE SDEL,STPX
	SUB SDEL,STPY		;COMPUTE NUMBER OF WORDS
	JUMPE SDEL,STOLER	;ERROR IF NONE STORED
	TRNN ER,ERRORS!ERRF	;ANY ERRORS?
	JRST STOL06		;NO
	TRNN ER,ERRORS-ERRU	;ONLY ERRF!ERRU, THEN BRANCH
	JRST STOL22
	JUMP2 STOL22		;YES, NO SEARCH.  BRANCH IF PASS2
	ADDM SDEL,LITCNT	;PASS ONE, UPDATE COUNT
	TRZ ER,ERRF		;CLEAR FAKE FLAG
	JRST STOWI		;INITIALIZE STOW

STOL06:	MOVEI SX,LITAB		;PREPARE FOR SEARCH
	MOVE ARG,STPX		;SAVE IN THE EVENT OF MULTIPLE-WORD
	HRL ARG,STPY
	MOVE AC2,LITNUM
	MOVEI SDEL,0
STOL08:	CALL DSTOW		;GET VALUE WFW

STOL10:	SOJL AC2,STOL24		;TEST FOR END
	MOVE SX,0(SX)		;NO, GET NEXT STORAGE CELL
	MOVE V,-1(SX)		;GET RELOCATION BITS WFW
	CAMN AC0,-2(SX)		;DO CODES COMPARE? WFW
	CAME RC,V		;YES, HOW ABOUT RELOCATION?
	AOJA SDEL,STOL10	;NO, TRY AGAIN
	SKIPGE STPX		;YES, MULTI-WORD?
	JRST STOL13		;NO, JUST RETURN LOCATION
	MOVEM AC2,SAVBLK+AC2	;YES, SAVE STARTING INFO
	MOVEM SX,SAVBLK+SX

STOL12:	SOJL AC2,STOL23		;TEST FOR END
	CALL DSTOW		;GET NEXT WORD WFW
	MOVE SX,0(SX)		;UPDATE POINTER
	MOVE V,-1(SX)		;GET RELOCATION WFW
	CAMN AC0,-2(SX)		;COMPARE VALUE WFW
	CAME RC,V		;AND RELOCATION
	JRST STOL14		;NO MATCH, TRY AGAIN
	SKIPL STPX		;MATCH, HAVE WE FINISHED SEARCH?
	JRST STOL12		;NO, TRY NEXT WORD
STOL13:				;YES, RETURN LOCATION
   IFN POLISH,<
	SETZM POLITS		;CLEAR ANY POLISH PENDING
   >
	JRST STOL26

STOL14:	MOVE AC2,SAVBLK+AC2	;RESTORE STOW POINTERS
	MOVE SX,SAVBLK+SX
	HRREM ARG,STPX
	HLREM ARG,STPY
	AOJA SDEL,STOL08	;BETTER LUCK NEXT TIME
STOL22:	MOVE SDEL,LITNUM
STOL23:	CALL DSTOW		;DSTOW AND CONVERT
STOL24:	MOVE SX,LITABX		;GET CURRENT STORAGE
	CALL GETTOP		;GET NEXT CELL
	MOVEM AC0,-2(SX)	;STORE CODE WFW
   IFN POLISH,<
	JUMPN RC,STOL25		;[1031] JUMP IF NOT ABS
	TRNN ER,ERRF		;[1031] FAKE ERROR FOR POLISH?
	JRST STOL25		;[1031] NO, JUMP
	MOVSI AC0,(1B0)		;[1031] YES, FIX RC SO WE CAN TELL FROM [0]
	MOVEM AC0,-1(SX)	;[1031] USE AC0 TO KEEP AC RC AS IS
	JRST STOL25+1		;[1031]
STOL25:				;[1031]
   >
	MOVEM RC,-1(SX)		;WFW
   IFN FORMSW,<
	MOVE AC0,FORM
	MOVEM AC0,-3(SX)>
	MOVEM SX,LITABX		;SET POINTER TO CURRENT CELL
	AOS LITNUM		;INCREMENT NUMBER STORED
	AOS LITCNT		;INCREMENT NUMBER RESERVED
	SKIPL STPX		;ANY MORE CODE?
	JRST STOL23		;YES
STOL26:	TRZ ER,ERRF		;CLEAR FAKE FLAG
	JUMP1 CPOPJ		;[664] EXIT IF PASS ONE
	MOVE SX,LITHDX		;GET HEADER BLOCK
	HLRZ RC,-1(SX)		;GET BLOCK RELOCATION
	HRRZ AC0,-1(SX)
	ADDI AC0,0(SDEL)	;COMPUTE ACTUAL LOCATION
	RET			;EXIT
SUBTTL INPUT ROUTINES

GETCHR:	PUSH P,V		;[731] V IS USED IN MREAD -> DSEND
	CALL CHARAC		;GET ASCII CHARACTER
   IFN STANSW,<
	CAIN C,32
	MOVEI C,136		;^
	CAIN C,30
	MOVEI C,137		;_
	CAIN C,176
	MOVEI C,134		;~
	CAIN C,140
	MOVEI C,100>		;@
	SUBI C,40		;CONVERT TO SIXBIT
	CAIG C,77		;CHAR GREATER THAN SIXBIT?
	JUMPGE C,GETCS		;TEST FOR VALID SIXBIT
	CAIL C,"A"		;[664] RETURN LOWERCASE AS SIXBIT
	CAILE C,"Z"		;[664]
	JRST GETCS3		;[664] OTHERWISE SPECIAL HANDLING
	SUBI C,40		;[664]
	JRST GETCS		;[664]

GETCS3:	ADDI C,40		;[664] BACK TO ASCII
	CAIN C,HT		;CHECK FOR TAB
	JRST GETCS2		;MAKE IT LOOK LIKE SPACE
	CAIG C,CR		;GREATER THAN CR
	CAIG C,HT		;GREATER THAN TAB
	JRST GETCS1		;IS NOT FF,VT,LF OR CR
	MOVEI C,EOL		;LINE OR FORM FEED OR V TAB
	TLOA IO,IORPTC		;REPEAT CHARACTER
GETCS2:	MOVEI C,0		;BUT TREAT AS BLANK

GETCS:	MOVE CS,CSTAT(C)	;GET STATUS BITS
	POP P,V			;[731] RESTORE TO ORIGINAL VALUE
	RET			;EXIT

GETCS1:	JUMPE C,GETCS		;IGNORE NULS
	TRC C,100		;MAKE CHAR. VISIBLE
	MOVEI CS,"^"
	DPB CS,LBUFP		;PUT ^ IN OUTPUT
	CALL RSW2		;ALSO MODIFIED CHAR.
	TRO ER,ERRQ		;FLAG Q ERROR
	JRST GETCHR+1		;[731] BUT IGNORE CHAR.
CHARAC:	TLZE IO,IORPTC		;REPEAT REQUESTED?
	JRST [HRRZ C,LIMBO	;[664] GET LAST CHARACTER
		RET]		;[664] EXIT
RSW0:	JUMPN MRP,MREAD		;BRANCH IF TREE POINTER SET
	CALL READ
RSW1:	SKIPE RPOLVL		;ARE WE IN "REPEAT ONCE"?
	JRST REPO1		;YES
RSW2:	CAIN C,LF		;LF?
	JRST [MOVE CS,LIMBO	;[664] YES, GET LAST CHAR
		CAIE CS,CR	;[664] CR?
		JRST .+1	;[664] NO
		HRROM C,LIMBO	;[664] YES, FLAG
		RET]		;[664] AND EXIT
	MOVEM C,LIMBO		;STORE THIS CHAR. FOR RPTC
RSW3:	TLNE IO,IOSALL		;MACRO SUPPRESS ALL?
	JUMPN MRP,CPOPJ		;YES,DON'T LIST IN MACRO
	JUMPE C,CPOPJ		;[1122] DO NOT COPY NULS TO LINE BUFFER
	SKIPG CPL		;[1133] ANY ROOM IN THE IMAGE BUFFER?
	CALL RSW5		;NO, BUT SEE IF ANY EXCESS WE CAN USE
	IDPB C,LBUFP		;YES, STORE IN PRINT AREA
	SOS CPL			;[1133] UPDATE BUFFER COUNT
	CAIE C,HT		;TAB?
	RET			;NO, EXIT
	MOVEI CS,7		;TAB COUNT MASK
	ANDCAM CS,CPL		;MASK TO TAB STOP
	RET

RSW5:	CAIN C,HT		;[1133] TAB?
	JRST RSW6		;[1133] YES - NOT ENOUGH ROOM
	MOVNI CS,.CPLX		;[1133][664] GET EXCESS SPACE
	CAMGE CS,CPL		;[664] ANY ROOM?
	RET			;[664] YES, JUST RETURN
RSW6:	SKIPN LITLVL		;[1133][664] IF IN LITERAL
	SKIPL STPX		;[664] OR CODE GENERATED
	JRST OUTIM		;[664] JUST OUTPUT THE IMAGE
	SKIPN ASGBLK		;[760]ASSIGNMENT
	SKIPE LOCBLK		;[760] OR A BLOCK RESERVATION?
	JRST .+2		;[760] YES, GO OUTPUT BINARY
	JRST OUTIM		;[664] OTHERWISE OUTPUT IMAGE
	CALL SAVEXS		;[760] SAVE AC0 AND C
	MOVEI C,CR		;[664]
	IDPB C,LBUFP		;[664]
	CALL OUTLIN		;[664] OUTPUT PARTIAL LINE
	CALL RSTRXS		;[664] RESTORE ACS
	JRST OUTLI2		;[664] INITIALIZE REST OF LINE

CHARL:	CALL CHARAC		;GET AND TEST 7-BIT ASCII
	CAIG C,FF		;LINE OR FORM FEED OR VT?
	CAIGE C,LF
	RET			;NO,EXIT
CHARL1:	CALL SAVEXS		;[667] SAVE REGISTERS
	SKIPE LITLVL		;[661] IN LITERAL?
	JRST [CALL OUTIML	;[667] YES
		JRST RSTRXS]	;[667] RESTORE ACS AND EXIT
	CALL OUTLIN		;NO, DUMP THE LINE
	JRST RSTRXS		;RESTORE REGISTERS AND EXIT
;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT)
;UNTIL A LINE TERMINATOR IS SEEN.
STOUTS:	TLOA IO,IOENDL!IORPTC
STOUT:	TLO IO,IORPTC
	CALL BYPASS		;[664]
	CAIE C,EOL		;MOST LIKELY A ; OR EOL CH
	JRST STOUT2		;IT WASN'T, SEE WHY!
	HRRZ C,LIMBO		;GET CHARACTER IN CASE EOL
	TLZE IO,IORPTC		;[1075] IF EOL
	JRST STOUT4		;[1075] SKIP NEXT GET
STOUT1:	SKIPN MRP		;[1075] STILL IN A MACRO?
	TLZ IO,IOMAC		;[1075] NO - CLEAR OUTPUT SUPPRESSION
	CALL RSW0		;[1075]
STOUT4:	CAIN C,CR		;[1075] NEED SPECIAL TEST FOR CR
	JRST STOUT3		;IN CASE NOT FOLLOWED BY LF
	CAIG C,FF
	CAIGE C,LF
	JRST STOUT1
	JRST OUTLIN		;OUTPUT THE LINE (BIN AND LST)

STOUT2:	CAIN C,14		;COMMA?
	SKIPL STPX		;YES, ERROR IF CODE STORED
	TRO ER,ERRQ
	JRST STOUT1		;PASS OUT TIL END OF LINE

STOUT3:	CALL RSW0		;GET NEXT CHAR.
	CAIG C,FF		;GENUINE EOL CHARACTER?
	CAIGE C,LF
	TLOA IO,IORPTC		;NO, SO REPEAT IT
	JRST OUTLIN		;AND DUMP LINE IN ANY CASE
REPEAT 0,<			;DON'T FLAG IT
	TRO ER,ERRQ		;FLAG EXTRA <CR> WITH "Q" ERROR
   >
	SETZ C,
	DPB C,LBUFP		;CLEAR LOOK-AHEAD CHAR OUT OF BUFFER
	CALL OUTLIN		;DUMP UPTO CR AS LINE
	HRRZ C,LIMBO		;GET C BACK
	JRST RSW3		;AND PUT CHAR IN NEW  BUFFER
SUBTTL CHARACTER STATUS TABLE

	DEFINE GENCS (OPLVL,ATOM,AN,SQUOZ,OPTYPE,SEQNO)
<BYTE (6)OPLVL (9)ATOM (3)AN (6)SQUOZ,OPTYPE,SEQNO>
	;OPLVL PRIORITY OF BINARY OPERATORS
	;ATOM INDEX TO JUMP TABLE AT CELL1
	;AN TYPE OF CHARACTER
	;	1=OTHER, 2=ALPHA, 4=NUMERIC
	;SQUOZ VALUE IN RADIX 50
	;OPTYPE INDEX TO JUMP TABLE AT EVXCT
	;SEQNO VALUE IN SIXBIT

CSTAT:
	GENCS 00,00,1,00,00,00	;' '
	GENCS 04,12,1,00,06,01	;'!'
	GENCS 00,07,1,00,00,02	;'"'
	GENCS 00,12,1,00,00,03	;'#'
	GENCS 00,01,2,46,00,04	;'$'
	GENCS 00,01,2,47,00,05	;'%'
	GENCS 04,12,1,00,07,06	;'&'
	GENCS 00,07,1,00,00,07	;'''

	GENCS 00,01,1,00,00,10	;'('
	GENCS 00,01,1,00,00,11	;')'
	GENCS 02,12,1,00,01,12	;'*'
	GENCS 01,00,1,00,03,13	;'+'
	GENCS 40,01,1,00,00,14	;','
	GENCS 01,02,1,00,04,15	;'-'
	GENCS 00,11,2,45,00,16	;'.'
	GENCS 02,12,1,00,02,17	;'/'

	GENCS 00,04,4,01,00,20	;'0'
	GENCS 00,04,4,02,00,21	;'1'
	GENCS 00,04,4,03,00,22	;'2'
	GENCS 00,04,4,04,00,23	;'3'
	GENCS 00,04,4,05,00,24	;'4'
	GENCS 00,04,4,06,00,25	;'5'
	GENCS 00,04,4,07,00,26	;'6'
	GENCS 00,04,4,10,00,27	;'7'

	GENCS 00,04,4,11,00,30	;'8'
	GENCS 00,04,4,12,00,31	;'9'
	GENCS 00,12,1,00,00,32	;':'
	GENCS 00,01,1,00,00,33	;';'
	GENCS 00,05,1,00,00,34	;'<'
	GENCS 00,12,1,00,00,35	;'='
	GENCS 00,01,1,00,00,36	;'>'
	GENCS 00,12,1,00,00,37	;'?'
	GENCS 00,03,1,00,00,40	;'@'
	GENCS 00,01,2,13,00,41	;'A'
	GENCS 00,01,2,14,00,42	;'B'
	GENCS 00,01,2,15,00,43	;'C'
	GENCS 00,01,2,16,00,44	;'D'
	GENCS 00,01,2,17,00,45	;'E'
	GENCS 00,01,2,20,00,46	;'F'
	GENCS 00,01,2,21,00,47	;'G'

	GENCS 00,01,2,22,00,50	;'H'
	GENCS 00,01,2,23,00,51	;'I'
	GENCS 00,01,2,24,00,52	;'J'
	GENCS 00,01,2,25,00,53	;'K'
	GENCS 00,01,2,26,00,54	;'L'
	GENCS 00,01,2,27,00,55	;'M'
	GENCS 00,01,2,30,00,56	;'N'
	GENCS 00,01,2,31,00,57	;'O'

	GENCS 00,01,2,32,00,60	;'P'
	GENCS 00,01,2,33,00,61	;'Q'
	GENCS 00,01,2,34,00,62	;'R'
	GENCS 00,01,2,35,00,63	;'S'
	GENCS 00,01,2,36,00,64	;'T'
	GENCS 00,01,2,37,00,65	;'U'
	GENCS 00,01,2,40,00,66	;'V'
	GENCS 00,01,2,41,00,67	;'W'

	GENCS 00,01,2,42,00,70	;'X'
	GENCS 00,01,2,43,00,71	;'Y'
	GENCS 00,01,2,44,00,72	;'Z'
	GENCS 00,06,1,00,00,73	;'['
	GENCS 00,12,1,00,00,74	;'\'
	GENCS 00,01,1,00,00,75	;']'
	GENCS 00,10,1,00,00,76	;'^'
	GENCS 06,12,1,00,05,77	;[1054] '_'

CSTATX:	GENCS 04,12,1,00,10,01	;'^!'
CSTATN:	GENCS 10,12,1,00,11,15	;[1054] '^-'
   IFN POLISH,<
CSTATM:	GENCS 10,12,1,00,12,15	;[1054] UNARY MINUS
   >				;END IFN POLISH
   IFN FTPSECT,<		;[575]
CSTATP:	GENCS 11,12,1,00,13,13	;ADDITIVE PSECT OPERATION
   >
SUBTTL LISTING ROUTINES

OUTLIN:	TRNN ER,ERRORS-ERRQ	;ANY ERRORS?
	TLNE FR,ERRQSW		;NO, IGNORE Q ERRORS?
	TRZ ER,ERRQ		;YES, ZERO THE Q ERROR
	HRLZ AC0,ER		;PUT ERROR FLAGS IN AC0 LEFT
	TLZ AC0,ERRF		;CLEAR FAKE FLAG
	TDZ ER,TYPERR
	JUMP1 OUTL30		;BRANCH IF PASS ONE
	TLNE FR,IOSCR		;[663] GCHAR ERROR TYPEOUT?
	JRST OUTL02		;[663] YES, FORCE PRINTING
	SKIPE LITLVL		;WITHIN NOLIST LITERAL?
	SKIPE LITLST
	JRST OUTL04		;NO
	TLNE IO,IOSALL		;YES, SALL MODE?
	JUMPN MRP,OUTLI5	;[1065] YES, EXIT IF IN MACRO EXPANSION
OUTL04:	JUMPN AC0,OUTL02	;IF ANY ERRORS, FORCE PRINTING
	MOVE AC1,STPX
	CAME AC1,STPY		;ANY CODE GENERATED?
	JRST OUTL01		;YES
	TLNN IO,IOSALL		;YES,SUPPRESS ALL?
	JRST OUTL03		;NO
	MOVE AC1,IOFLGS		;[1150] IF SETTING XLIST AFTER OUTPUT
	TLNN AC1,IOPROG		;[1150] FORCE THE LINE OUT
	JUMPN MRP,OUTLI5	;[1065] YES,EXIT IF IN MACRO
	LDB C,[XWD 350700,LBUF]
	CAIE C,CR		;FIRST CHAR CR?
OUTL01:	TLZ IO,IOMAC		;FORCE MACRO PRINTING
OUTL03:	TLNN IO,IOMSTR!IOPROG!IOMAC
OUTL02:	IOR ER,OUTSW		;FORCE IT.
	IDPB AC0,LBUFP		;STORE ZERO TERMINATOR AFTER ASCII SRC LINE
	TSO ER,AC0		;RE-FLAG THE ERRORS FOR %....X
	TLNN FR,CREFSW		;CREF?
	CALL CLSCRF		;YES, WRITE END OF CREF DATA (177,003)
	MOVE C,TYPERR		;NOW RESTORE FLAGS AS
	ANDI C,ERRORS		;THEY WERE SO TTY LISTING IS
	TDZ ER,C		;WHAT THEY ASKED FOR
	JUMPE AC0,OUTL20	;BRANCH IF NO ERRORS
	TLZE AC0,ERRM		;M ERROR?
	TLO AC0,ERRP		;M ERROR SET - SET P ERROR.
	CALL OUTLER		;PROCESS ERRORS

OUTL20:	TLNE FR,IOSCR		;[663] GCHAR ERROR TYPEOUT?
	JRST OUTL28		;[663] YES, SKIP BINARY
	MOVE AC1,STPX
	SKIPN C,ASGBLK
	SKIPE CS,LOCBLK
	CAME AC1,STPY		;ANY CODE GENERATED?
	JRST OUTL23		;YES, JUMP
	JUMPE C,OUTL22		;SEQUENCE BREAK AND NO BINARY JUMPS
	ILDB C,TABP		;ASSIGNMENT FALLS THROUGH
	CALL OUTL		;OUTPUT A TAB.
	ILDB C,TABP		;OUTPUT 2ND TAB, LOCATION FIELD
	CALL OUTC		;NEXT IS BINARY LISTING FIELD
   IFN FTPSECT,<		;[647]
	SKIPE SGNMAX		;[647] DOING PSECTS?
	JRST [	MOVEI C," "	;[647] DO SPACES INSTEAD
		CALL OUTC	;[647]
		CALL OUTC	;[647]
		CALL OUTC	;[647]
		JRST .+1]	;[647]
   >				;[647]
   IFN POLISH,<
	JUMPL RC,[IBP TABP	;[647] FIX FOR OFF-CENTER FIXUP LISTING
		HRRZI CS,-1	;[633] OUTPUT 6 ZEROS
		CALL ONC1	;[633]
		HRRZI CS,-5	;[633] NO TAB, 6 MORE ZEROS AND #
		CALL ONC1	;[633]
		JRST OUTL33]	;[717] SKIP SINGLE QUOTE TEST
   >
	HLLO CS,LOCBLK		;LEFT HALF OF A 36BIT VALUE
	HLR C,ASGBLK		;[633] GET LEFT HALF RELOCATION
	SKIPL ASGBLK		;SKIP IF LEFT HALF IS NOT RELOC
	TRZA CS,0(C)		;[633]
	TLNE CS,-1		;SKIP IF ITS A 18BIT VALUE, OTHERWISE
	JRST [	CALL ONC1	;[647] PRINT LH OF A 36 BIT VALUE IN CS
   IFN FTPSECT,<		;[717]
		SKIPE SGNMAX	;[717]
		IBP TABP	;[717]
   >				;[717]
		JRST OUTL2A]	;[647]
   IFN FTPSECT,<		;[647]
	SKIPN SGNMAX		;[647] DOING PSECT?
	JRST OUTL2A		;[647] NO,
	ILDB C,TABP		;[647] YES, EXTRA TAB
	CALL OUTC		;[647]
	MOVEI C," "		;[647]
	CALL OUTC		;[647]
   >				;[647]
OUTL2A:	HRLO CS,LOCBLK		;[647] PICK UP THE RIGHT (18BIT VALUE)
	MOVE C,ASGBLK		;GET RIGHT HALF RELOCATION
	TRZ CS,0(C)
	CALL ONC		;PRINT IT
	JRST OUTL23		;SKIP SINGLE QUOTE TEST
OUTL22:
   IFN FTPSECT,<		;[717]
	SKIPE SGNMAX		;[717]
	JRST [	ILDB C,TABP	;[717]
		CALL OUTL	;[717]
		CALL ONC1	;[717]
		JRST .+2]	;[774]
   >				;[717]
	CALL ONC		;TAB TO RH AND PRINT IT
	CALL OUTCSQ		;[717] GO OUTPUT "'"
OUTL33:				;[717]
   IFN FTPSECT,<		;[717]
		SKIPE SGNMAX	;[717]
		IBP TABP	;[717]
   >				;[717]
OUTL23:
	MOVE AC1,STPX		;ANY BINARY
	CAMG AC1,STPY
	JRST [	MOVE AC1,NOTFL	;NO,
		CAMN AC1,[-2]	;LAST LINE?
		SETZM NOTFL	;YES, RE-SET TO FIRST
		JRST OUTL29]
	SKIPE INASGN		;[661] SKIP BINARY IF IN  ASSIGNMENT
	JRST OUTL29		;[661]
	MOVSI AC1,(BLOFF)
	ANDCAM AC1,BLSW		;ASSUME WE WANT BINARY LISTING
	SKIPE LITLVL		;IN LITERAL?
	JRST [	SKIPN LITLST	;YES, IS LITLST REQUESTED
		JRST OUTL21	;NO, GO SUPPRESS BINARY LISTING
		JRST .+1]	;YES,
	SKIPL NOTFL		;NOT THE FIRST LINE?
	JRST OUTL27		;FIRST LINE, GO OUTPUT BINARY
	MOVE AC1,NOTFL		;NOT FIRST,
	CAMN AC1,[-2]		;LAST LINE?
	SETZM NOTFL		;YES, RE-SET TO FIRST
	MOVSI AC1,(FLBLST)	;NOT FIRST LINE,
	TDNN AC1,BLSW		;FIRST LINE BINARY ONLY REQUESTED?
	JRST OUTL27		;NO, FLBLST NOT REQUESTED
OUTL21:	MOVSI AC1,(BLOFF)	;YES
	IORM AC1,BLSW		;SUPPRESS BINARY LISTING
OUTL27:	CALL BOUT		;OUTPUT BINARY
OUTL29:	MOVE CS,[POINT 7,LBUF]
OUTL24:	ILDB C,CS
	CAILE C," "
	JRST OUTL28		;FOUND A PRINTING CHARACTER
	JUMPN C,OUTL24		;TRY AGAIN UNLESS TERMINAL 0
	SKIPN SEQNO		;SEQUENCE NO. ARE WORTH PRINTING
	JRST OUTL25		;BUT JUST TABS AREN'T
OUTL28:	MOVE CS,TABP
	CALL OUTASC		;OUTPUT TABS & SEQ. NO.
OUTL25:	MOVEI CS,LBUF
	CALL OUTAS0		;DUMP THE LINE
	TLNE IO,IOSALL		;SUPPRESSING ALL
	JUMPN MRP,[CALL OUTCR	;YES, CR NOT OTHERWISE PROVIDED
		JRST .+1]
	TLNE FR,IOSCR		;[663] GCHAR ERROR TYPEOUT?
	JRST OUTLI1		;[663] YES, READY TO CLEAN UP
	SKIPE INASGN		;[774] SKIP BINARY IF IN ASSIGNMENT
	JRST OUTLI		;[774]
	SKIPE LITLVL		;[774] IN NON-LITLSTED LITERAL?
	SKIPE LITLST		;[774]
	JRST .+2		;[774] NO,
	JRST OUTLI		;[774] YES, CLEAN UP AND EXIT
OUTL26:	MOVE AC1,STPX		;[774] ANY BINARY?
	CAMG AC1,STPY
	JRST OUTLI		;NO, CLEAN UP AND EXIT
	MOVSI AC1,(FLBLST)
	TDNE AC1,BLSW		;FIRST LINE BINARY ONLY?
	JRST [	MOVSI AC1,(BLOFF)
		IORM AC1,BLSW	;YES, SWITCH OFF BINARY
		CALL BOUT	;OUTPUT TO REL ONLY
		JRST OUTL26]
	CALL OUTLI2		;YES, INITIALIZE FOR NEXT LINE
	TLNN FR,CREFSW		;CREF REQUESTED?
	TLNE IO,IOPROG		;YES, THEN IS XLIST ON?
	JRST .+2		;CREF NOT BEING PRINTED
	CALL CLSCRF		;CLOSE OUT THIS CREF LINE
	CALL BOUT		;YES, DUMP IT
	CALL OUTCR		;OUTPUT CARRIAGE RETURN
	JRST OUTL26		;TEST FOR MORE BINARY
;HERE ON PASS 1 ONLY

OUTL30:	CAIN C,FF		;[1004] FORM-FEED?
	CALL OUTFF2		;[1004] YES, COUNT PAGES FOR PASS1 ERROR
	TLNN FR,IOSCR		;[663] SKIP BOOKKEEPING IF FROM GCHAR
	CALL [AOS CS,STPX	;[663] PASS ONE
		ADDM CS,LOCO	;[663] INCREMENT OUTPUT LOCATION
		JRST STOWI]	;[663] INITIALIZE STOW AND CONTINUE
	TLZ AC0,ERRORS-ERROR1
	JUMPN AC0,OUTL32	;JUMP IF ERRORS
OUTL31:	TLNE IO,IOSALL		;SUPPRESSING ALL
	JUMPN MRP,CPOPJ		;YES,EXIT
	JRST OUTLI1		;NO,INIT LINE

OUTL32:	IDPB AC0,LBUFP		;ZERO TERMINATOR
	IOR ER,OUTSW		;LIST ERRORS
	CALL OUTLER		;OUTPUT TAG AND FLAGS
	CALL OUTTAB
	MOVEI CS,SEQNO		;ADDRESS OF SEQUENCE NO.
	SKIPE SEQNO		;FILE NOT SEQUENCED
	CALL OUTAS0		;OUTPUT IT
	JRST OUTL25		;OUTPUT BASIC LINE
;OUTPUT ERROR HEADER AND SETUP ERROR FLAG LETTERS
; AC0/ ERROR FLAGS IN LH (NOTE: NOT RH LIKE ER)

OUTLER:	PUSH P,ER		;SAVE LISTING SWITCHES FOR LATER
	TRNE ER,TTYSW		;IF THIS IS ON, LISTING IS ON TTY
	TRZ ER,ERRORS		;SO SUPPRESS ON TTY
	TDZ ER,OUTSW		;BUT THIS SHOULD ONLY GO TO THE TTY
	MOVE CS,TAG
	CALL OUTSY1
	MOVEI C,"+"
	CALL OUTL
	HRRZ C,TAGINC		;[774] GET OFFSET
	SKIPE LBLFLG		;[774] HAVE WE SEEN LABEL IN LIT?
	SUB C,LTGINC		;[774] YES, GET CORRECT OFFSET FROM IT
	CALL DNC		;[666][576] CONVERT INCREMENT TO DECIMAL
	CALL OUTTAB		;OUTPUT TAB
	MOVE CS,INDIR		;GET FILE NAME
	CAME CS,LSTFIL		;AND SEE IF SAME
	SETOM LSTPGN		;ISN'T, GET IT TYPED
	MOVE CS,PAGENO		;NOW CHECK PAGE NUMBER
	CAMN CS,LSTPGN		;SAME?
	JRST OUTLE8		;YES, DON'T PRINT AGAIN
	MOVE CS,INDIR		;REMEMBER LAST FILE
	MOVEM CS,LSTFIL
	MOVEI CS,LSTFIL
	CALL OUTSIX		;TYPE FILE NAME
	MOVEI C," "
	CALL OUTL
	MOVE CS,PAGENO		;REMEMBER LAST PAGE NUMBER
	MOVEM CS,LSTPGN
	MOVEI CS,[ASCIZ /PAGE /]
	CALL OUTAS0
	MOVE C,PAGENO
	CALL DNC		;TYPE PAGE NUMBER
OUTLE8:	CALL OUTCR		;CR AFTER TAG AND PAGE
	HLLM ER,(P)		;RESTORE ER BUT NOT IO (LEFT HALF OF AC)
	POP P,ER
	MOVE CS,[POINT 7,[ASCII / QXADLRUVNOPEMS/]]
OUTLE2:	ILDB C,CS		;GET ERROR MNEMONIC
	JUMPGE AC0,OUTLE4	;BRANCH IF NOT FLAGGED
	CAIN C,"Q"		;"Q" ERROR?
	AOSA QERRS		;YES, JUST COUNT AS WARNING
	AOS ERRCNT		;INCREMENT ERROR COUNT
	CALL OUTL		;OUTPUT THE CHARACTER
OUTLE4:	LSH AC0,1		;SHIFT NEXT FLAG INTO SIGN BIT
	JUMPN AC0,OUTLE2	;TEST FOR END
	RET			;EXIT
OUTIM1:	TLOA FR,IOSCR		;SUPPRESS CRLF AFTER LINE
OUTIM:	TLZ FR,IOSCR		;DON'T FOR PARTIAL LINE
	TLNE IO,IOSALL		;SUPPRESSING ALL?
	JUMPN MRP,[TLZ FR,IOSCR	;[663] YES, EXIT IF IN MACRO
			PJRST OUTLI5] ;[1065]
	JUMP1 [	CAIN C,FF	;[1004] FORM-FEED?
		CALL OUTFF2	;[1004] COUNT FOR PASS1 ERROR
		JRST OUTLI1]	;[1004] BYPASS IF PASS ONE
	PUSH P,ER
	TDZ ER,TYPERR
	TLNN IO,IOMSTR!IOPROG!IOMAC
	IOR ER,OUTSW
	PUSH P,C		;OUTPUT IMAGE
	TLNN FR,CREFSW
	CALL CLSCRF
	MOVE CS,TABP
	CALL OUTASC		;OUTPUT TABS
	IDPB C,LBUFP		;STORE ZERO TERMINATOR
	MOVEI CS,LBUF
	CALL OUTAS0		;OUTPUT THE IMAGE
	TLZN FR,IOSCR		;CRLF SUPPRESS?
	CALL OUTCR		;NO,OUTPUT
	POP P,C
	HLLM ER,0(P)
	POP P,ER
	JRST OUTLI4		;[774] GO INCREMENT LINE COUNT

OUTLI:	TLNE IO,IOSALL		;SUPPRESSING ALL
	JUMPN MRP,OUTLI3	;YES,SET FLAG IN REPEATS ALSO
	TLNE IO,IOPALL		;MACRO EXPANSION SUPRESS REQUESTED?
	SKIPN MACLVL		;YES, ARE WE IN MACRO?
	TLZA IO,IOMAC		;NO, CLEAR MAC FLAG
OUTLI3:	TLO IO,IOMAC		;YES, SET FLAG

OUTLI1:	TRZ ER,ERRORS!LPTSW!TTYSW
	TLZ FR,IOSCR		;[663] ZERO IMAGE/CRLF FLAG
OUTLI4:	SKIPN MRP		;[1001] IF EXPANDING, DON'T BUMP OFFSET
	AOS TAGINC		;[774] BUMP OFFSET
OUTLI2:	SKIPE IOFLGS		;[1065] LISTING FLAG TO SET?
	CALL OUTLI5		;[1065] YES
	MOVE CS,[POINT 7,LBUF]	;INITIALIZE BUFFERS
	MOVEM CS,LBUFP
   IFN FORMSW,<MOVE CS,[POINT 7,TABI]
	MOVSS HWFMT		;PUT FLAG IN LEFT HALF
	SKIPGE HWFMT>		;BUT IF ONLY HALF-WORD FORMAT
	MOVE CS,[POINT 7,TABI,6]
	MOVEM CS,TABP
	MOVEI CS,.CPL
   IFN FORMSW,<SKIPL HWFMT	;IF MULTI-FORMAT
	SUBI CS,8		;LINE IS ONE TAB SHORTER
	MOVSS HWFMT>		;BACK AS IT WAS
	SKIPE SEQNO		;A SEQUENCED FILE?
	SUBI CS,8		;YES, SEQ NO TAKES UP SPACE
	MOVEM CS,CPLSAV		;[1003] SAVE VALUE FOR FF CHECK
	MOVEM CS,CPL
	MOVSI CS,(ASCII /	/)
	SKIPE SEQNO		;HAVE WE SEQUENCE NUMBERS?
	MOVEM CS,SEQNO		;YES, STORE TAB IN CASE OF MACRO
	MOVEM CS,SEQNO+1	;STORE TAB AND TERMINATOR
	SETZM ASGBLK
	SETZM LOCBLK
	RET

OUTLI5:	JUMP1 CPOPJ		;[1065]
	SKIPGE IOFLGS		;[1065] SETTING LALL UNDER SALL?
	JRST [TLZ IO,IOMAC!IOPALL!IOSALL ;[1065] YES, "SET" FLAGS
		SETZM IOFLGS	;[1065]
		SKIPN CRLFSN	;[1065] NEED CRLF STILL?
		PJRST OUTIM	;[1065] YES
		RET]		;[1065]
	TDO IO,IOFLGS		;[1065] NO, XALL,XLIST,SALL (OR NULL)
	SETZM IOFLGS		;[1065]
	RET			;[1065]
OUTIML:	JUMP2 [	PUSH P,STPX	;SAVE CURRENT BUFFER VARIABLES
		PUSH P,EXTPNT	;..
		PUSH P,STPY	;..
		MOVE AC0,STPX	;PRINT ONLY LITERALS SINCE
		EXCH AC0,LSTPY	;LAST TIME
		MOVEM AC0,STPY	;..
		CALL OUTLIN	;LIST THE LINE
		POP P,STPY	;RESTORE CURRENT BUFFER VARIABLES
		POP P,EXTPNT	;..
		POP P,STPX	;..
		RET]
	TRNN ER,ERRORS-ERRQ
	TLNE FR,ERRQSW
	TRZ ER,ERRQ
	HRLZ AC0,ER
	TLZ AC0,ERRORS-ERROR1-ERRL+ERRF ;ANY ERRORS TO PRINT ON PASS1?
	CAIN C,FF		;[1004] FORM-FEED?
	CALL OUTFF2		;[1004] COUNT FOR PASS1 ERROR
	JUMPE AC0,OUTL31	;[664] NONE
	PUSH P,ER		;SAVE
	PUSH P,C		;SAVE THIS
	TDZ ER,TYPERR
	IOR ER,OUTSW
	CALL OUTLER		;DO NOT FORGET ERRORS
	CALL OUTTAB
	SETZ AC0,		;SET A ZERO TERMINATOR
	IDPB AC0,LBUFP		;IN THE OUTPUT BUFFER
	MOVEI CS,LBUF		;PRINT REST OF LINE
	CALL OUTCR0		;[664]
	POP P,C
	POP P,ER
	JRST OUTLI1
SUBTTL OUTPUT ROUTINES

UOUT:	SETZM UNDCNT		;CLEAR UNDEFINED SYMBOL COUNT
	CALL LOOKUP		;SET FOR TABLE SCAN
	JUMP2 UOUT13		;[735] GO CHECK FOR TAGS IN LIT
	TRNN ARG,PNTF		;WFW
UOUT0:	TRNN ARG,UNDF		;[735]
	RET			;[724] RECYCLE IF DEFINED OF PNTF SET ON PASS1
	JUMP2 UOUT10
	TLNN IO,IOIOPF		;ANY IOP'S SEEN
	JRST UOUT12		;NO,MAKE EXTERNAL
	MOVSI CS,PRMTBL-PRMEND	;YES LOOKUP IN TABLE
UOUT1:	CAME AC0,PRMTBL(CS)	;HAVE WE A MATCH?
	AOBJN CS,UOUT2		;NO,INCREMENT AND JUMP
	MOVE ARG,PRMTBL+1(CS)	;YES,GET VALUE
	MOVEM ARG,(SX)		;UPDATE SYMBOL TABLE
	RET			;EXIT

UOUT2:	AOBJN CS,UOUT1		;TEST FOR END
UOUT12:	TRNE ARG,ENTF		;[735] SEE IF FORWARD DEFINED?
	RET			;[617] YES, DON'T MAKE IT EXTERNAL
	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	TRC ARG,LTAGF		;[735] TAG IN LIT?
	TRCN ARG,LTAGF		;[735]
	JRST [	PUSH P,ARG	;[735] YES, SAVE ARG
		CALL EXTRN1	;[735] SETUP AS IF EXTERNAL
		CALL EXTRN2	;[735]
		POP P,ARG	;[735]
		MOVSS ARG,ARG	;[735] EXCEPT FLAGS NEED TO BE ADJUSTED
		IORM ARG,(SX)	;[735]
		TRZ FRR,NOUNVS	;[735] CAN SEARCH UNVS AGAIN
		RET]		;[735]
	CALL EXTRN1		;[1070] SET UP EXTERN
	CALL EXTRN2		;[1070] INSERT/UPDATE IT
	TRZ FRR,NOUNVS		;[1070] SEARCH UNIVERSALS AGAIN
	MOVSI ARG,UNDF		;BUT PUT UNDF BACK ON
	IORM ARG,(SX)		;SO MESSAGE WILL COME OUT
	RET			;GET NEXT SYMBOL

UOUT10:	AOS UNDCNT		;INCREMENT UNDEFINED SYMBOL COUNT
	CALL OUTSYM		;OUTPUT THE SYMBOL
	CALL OUTTAB		;THEN A TAB
	MOVEI CS,[SIXBIT /UNASSIGNED, DEFINED AS IF EXTERNAL@/]
	CALL OUTSIX
	JRST OUTCR		;POPJ FOR NEXT SYMBOL

;HERE TO UPDATE SYMBOL TABLE TO THE ACTUAL VALUE FOR TAGS IN LITERALS
;AND CHAIN LOCAL BLOCKS INTO A LIST. A LOCAL BLOCK FORMAT IS CONVERTED:

;
;	FROM:	VALUE,,FLAGS		TO:	VALUE,,CHAIN
;		RELOC,,0			JOIN-RELOC,,NXT-LOCAL
;					
;					WHERE JOIN-RELOC IS:
;						BIT16 - RELOC OF CHAIN
;						BIT17 - RELOC OF VALUE
;

UOUT13:
CHNLOC:	TRC ARG,LTAGF		;[735] TAG IN LIT?
	TRCE ARG,LTAGF		;[735]
	JRST UOUT0		;[735] NO,
	HRRZ V,(SX)		;[735] GET VALUE(PTR TO FIRST PAIR)
	MOVE AC1,1(V)		;[735] GET PTR TO CURRENT LOCAL BLOCK
	TLNE AC1,-1		;[735] ANYTHING IN LH?
	JRST UOUT0		;[735] YESILL UNRESOLVED
   IFE FTPSECT,<		;[735]
	SETZ ARG,		;[735] CLEAR INDEX AC
   >
   IFN FTPSECT,<		;[735]
	SKIPN ARG,SGNMAX	;[735] DOING PSECTS?
	JRST UOUT15		;[735] NO, JUMP
	MOVE ARG,SGNCUR		;[735]
UOUT14:	MOVEM ARG,SGNCUR	;[735]
	CALL SRCHI		;[735] GET PSECT SYMTAB BOUNDARY
	CAMG SX,SGSTOP		;[735] IN THE RANGE?
	CAMGE SX,SGSBOT		;[735]
	AOJA ARG,UOUT14		;[735] NO, NEXT PSECT SYMTAB
   >				;[735]
	HRRZ AC1,1(V)		;[735] GET LOCAL BLOCK PTR AGAIN
UOUT15:	HLLZ AC2,0(V)		;[735] CHAIN-RELOC IN LH
	LSH AC2,1		;[735] SHIFT TO LEFT BY 1 ON BIT16
	MOVS AC0,0(AC1)		;[735] GET FLG,,VALUE
	IOR AC0,1(AC1)		;[735] OR IN RELOC WITH FLG,,VALUE
	MOVEM AC0,(SX)		;[735] UPDATE SYMTAB WITH REAL FLG,,V
	HRL AC0,0(V)		;[735] GET CHAIN,,V
	MOVSM AC0,0(AC1)	;[735] SWAP HALVES AND STORE IN WORD1
	HRR AC2,LOCAL(ARG)	;[735] PTR OF PREVIOUS LOCAL IN RH
	ADDM AC2,1(AC1)		;[735] JOIN-RELOC,,NEXT-LOCAL IN WORD2
	MOVEM AC1,LOCAL(ARG)	;[735] UPDATE LOCAL TO CURRENT PAIR
	HLRZ ARG,0(SX)		;[735] REAL FLAGS IN RH
	RET			;[735]
				;OUTPUT THE ENTRIES

EOUT:	MOVEI C,0		;INITIALIZE THE COUNT
	MOVE SX,SYMBOL
	MOVE SDEL,0(SX)
EOUT1:	SOJL SDEL,EOUT2		;TEST FOR END
	ADDI SX,2
	HLRZ ARG,0(SX)
	TRNE ARG,EXTF!SYNF	;[733] DON'T COUNT ILLEGAL ENTRY
	JRST EOUT1		;[733]
	ANDCAI ARG,SYMF!INTF!ENTF
	JUMPN ARG,EOUT1		;IF INVALID, DON'T COUNT
	AOJA C,EOUT1		;BUMP COUNT

EOUT2:
;(REMOVED)	JUMPE C,CPOPJ	;[765] DON'T GENERATE EMPTY ENTRY BLOCK
	HRLI C,4		;BLOCK TYPE 4
	CALL OUTBIN
	SETZB C,ARG
	CALL OUTBIN
	MOVE SX,SYMBOL
	MOVE SDEL,0(SX)
	MOVEI V,^D18

EOUT3:	SOJL SDEL,CPOPJ		;[664]
	ADDI SX,2
	HLRZ C,0(SX)
	TRNE C,EXTF!SYNF	;[761][733] DON'T OUTPUT ILLEGAL ENTRY
	JRST EOUT3		;[733]
	ANDCAI C,SYMF!INTF!ENTF
	JUMPN C,EOUT3
	SOJGE V,EOUT4		;TEST END OF BLOCK
	CALL OUTBIN
	MOVEI V,^D17		;WFW
EOUT4:	MOVE AC0,-1(SX)
	CALL SQOZE
	MOVE C,AC0
	CALL OUTBIN
	JRST EOUT3

;HERE TO GENERATE BLOCK-10 FROM CHAIN LOCAL BLOCKS HAVING THE FORMAT:
;
;	VALUE,,CHAIN-VALUE
;	JOIN-RELOC,,NXT-LOCAL
;
LSOUT:
   IFE FTPSECT,<		;[735]
	SETZ AC1,		;[735] CLEAR INDEX AC
   >				;[735]
   IFN FTPSECT,<		;[735]
	MOVE AC1,SGNCUR		;[735] ONLY FOR CURRENT PSECT
   >				;[735]
	SKIPN C,LOCAL(AC1)	;[725] ANY LOCAL FIXUPS REQUIRED?
	RET			;NO
	MOVS AC0,(C)		;GET VALUE RIGHT WAY ROUND
	MOVS RC,1(C)		;AND RELOCATION
	HLRZM RC,LOCAL(AC1)	;[735] STORE NEXT POINTER
	CALL COUT		;OUTPUT THIS WORD
	JRST LSOUT		;LOOK FOR MORE
				;OUTPUT THE SYMBOLS
SOUT:	SKIPN IONSYM		;SKIP IF NOSYM SEEN
	TRNN ER,LPTSW!TTYSW	;A LISTING REQUIRED?
	JRST SOUT2		;NO
	MOVEI [ASCIZ /SYMBOL TABLE/]
	HRRM SUBTTX		;SET NEW SUB-TITLE
	MOVEI ARG,NCOLS		;SET UP FOR NCOLS ACROSS SYMBOL TABLE
	TRNE ER,TTYSW		;IS TTY LISTING DEVICE?
	MOVEI ARG,2		;YES,ONLY 2 COLLUMNS
	MOVEM ARG,NCOLLS	;STORE ANSWER
   IFE FTPSECT,<		;[575]
	MOVE SX,SYMBOL		;START OF TABLE
	MOVE SDEL,(SX)		;COUNT OF SYMBOLS
   >
   IFN FTPSECT,<		;[575]
	MOVE SX,SGSBOT		;START OF TABLE
	MOVE SDEL,SGNCUR	;CUR PSECT INX
	JUMPE SDEL,SOUTBS	;IS THIS THE BLANK PSECT?
	MOVE ARG,[XWD SGTTLB,SGLIST]
	BLT ARG,SGTTLE-SGTTLB+SGLIST-1 ;MOVE SUBTTL
	MOVE AC1,SGTTLE		;'TO' POINTER
	MOVE AC2,SGTTLF		;'FROM' POINTER
SGTTLL:	ILDB AC0,AC2		;GET A SIXBIT CHAR
	ADDI AC0,40		;FORM ASCII
	IDPB AC0,AC1		;PUT IN SUBTTL
	TLNE AC2,770000		;DONE SIX CHARS?
	JRST SGTTLL		;NOT DONE YET
	SETZ AC0,		;TERMINATE SUBTTL
	IDPB AC0,AC1		;WITH NULL BYTE
	MOVEI AC0,SGLIST	;POINTER TO
	HRRM AC0,SUBTTX		;NEW SUBTTL
SOUTBS:	HRRZ SDEL,SGSCNT(SDEL)	;COUNT OF SYMBOLS
   >				;END OF FTPSECT
	ADDI SX,2		;SKIP COUNT
	MOVEM SX,SXSV		;SAVE PLACE
	MOVEM SDEL,SDELSV
	MOVE SX,PAGEN.		;GET LAST PAGE-OFFSET
	MOVEM SX,SPAGN.		;AND SAVE IN CASE PRGEND
	MOVE SX,SPAGNO		;GET LAST SYMBOL PAGE NUMBER
	EXCH SX,PAGENO		;SWAP WITH OUTPUT PAGE NUMBER
	MOVEM SX,SPAGNO		;AND STORE IT
	MOVE SX,[BYTE (7) 0,0,<"S">,<"-">,0]
	IORM SX,DBUF+4		;FIXUP TITLE

SOUT0:	CALL SOUTP		;GET PAGE SET UP
	  JRST SOUT1		;NOTHING TO OUTPUT
	CALL SOUTF		;DUMP ONE PAGE
	  JRST SOUT1		;DIDN'T FILL PAGE-DONE
	JRST SOUT0

   IFN FTPSECT,<		;[575]
SGTTLB:	ASCII /SYMBOL TABLE FOR PSECT   /
SGTTLE:	POINT 7,SGTTLE-SGTTLB+SGLIST
SGTTLF:	POINT 6,SGNAME(SDEL)
   >
SOUTT:	MOVE ARG,(SX)		;GET FLAGS
	TLNE ARG,SUPRBT		;SURPRESSED?
	RET			;YES
	TLNN ARG,SYMF		;SYMBOL IS OK
	TLNN ARG,SYNF!MACF	;BUT MACRO OR SYNONYM AREN'T
	AOS (P)
	RET
SOUTP:	MOVE AC1,NCOLLS		;GET COLUMN COUNT
	MOVE SX,SXSV		;GET POSITION
	MOVE SDEL,SDELSV	;AND COUNT

SOUTP0:	MOVEM SX,SYMBLK(AC1)
	HRLM SDEL,SYMBLK(AC1)	;SAVE IN TABLE
	MOVE AC0,..LPP		;LINE COUNT

SOUTP1:	JUMPE SDEL,SOUTP2	;IF NONE LEFT, GO ELSEWHERE
	CALL SOUTT		;SYMBOL OK?
	  TDZA RC,RC		;NO
	SETO RC,		;YES
	ADDI SX,2		;SET UP FOR NEXT NOW
	SUBI SDEL,1
	JUMPGE RC,SOUTP1	;SKIP SYMBOL
	SOJG AC0,SOUTP1		;COUNT IN SYMBOL
	SOJG AC1,SOUTP0		;START NEXT COLUMN
	MOVEM SX,SXSV		;SAVE POSITION
	MOVEM SDEL,SDELSV
	JRST CPOPJ1		;[664] SKIP EXIT
SOUTP2:	CLEARM SDELSV		;FLAG DONE
	CAME AC1,NCOLLS		;IF ON 1ST COLUMN
	JRST .+3
	CAMN AC0,..LPP		;AND FIRST LINE
	RET			;THEN SKIP PRINTING
	SOJLE AC1,CPOPJ1	;ALREADY GOT THIS LINE
	CLEARM SYMBLK(AC1)
	SOJG AC1,.-1		;ZERO ALL OTHERS
	JRST CPOPJ1
SOUTF:	CALL OUTFF		;GET TO TOP OF PAGE
	MOVE AC1,..LPP
	MOVEM AC1,COLSIZ

SOUTF1:	CALL SOUTL		;DUMP ONE LINE
	  RET			;WAS BLANK
	SOSLE COLSIZ		;ONE MORE DONE
	JRST SOUTF1		;MORE TO GO
SOUTF2:	JRST CPOPJ1

SOUTL:	MOVE AC1,NCOLLS		;SET COLUME COUNT
SOUTL0:	HRRZ SX,SYMBLK(AC1)
	HLRZ SDEL,SYMBLK(AC1);GET POSITION IN TABLE
	JUMPE SDEL,SOUTL3	;NOTHING THERE

SOUTL1:	CALL SOUTT		;SYMBLE PRINTABLE?
	  JRST SOUTL2		;CENCOR!!
	CALL SOUTE		;DUMP OUT ENTRY
	ADDI SX,2
	SUBI SDEL,1		;UP TP NEXT ONE
	HRL SX,SDEL		;SAVE OUR PLACE
	MOVEM SX,SYMBLK(AC1)
	SOJG AC1,SOUTL0		;NEXT!
	AOS (P)
	JRST OUTCR		;POLISH OFF LINE

SOUTL2:	ADDI SX,2
	SOJG SDEL,SOUTL1	;KEEP SEARCHING
SOUTL3:	CAME AC1,NCOLLS		;BLANK LINE?
	AOS (P)			;NO
	JRST OUTCR
SOUTE:	MOVE AC0,-1(SX)
	CALL OUTSYM		;DUMP SYMBOL OUT
	CALL OUTTAB		;THEN A TAB
	CALL SRCH7		;GET VALUE
	JUMPL RC,[HRRZI CS,-1	;[633] IF POLISH, OUTPUT 6 ZEROS
		CALL ONC1	;[633]
		HRRZI CS,-5	;[633] NO TAB, 6 MORE ZEROS, AND #
		CALL ONC1	;[633]
		CALL OUTTAB	;[633] A TAB
		MOVEI CS,[ASCII\pol\] ;[633] SYMBOL TYPE
		CALL OUTAS0	;[633]
		JRST OUTTAB]	;[633] LAST TAB
	TLNN ARG,EXTF		;EXTERNAL?
	JRST .+5
	HLRZ RC,V		;YES, NEED FIXUP
	TRNE RC,-2
	MOVS RC,(RC)
	HLL V,RC

	HLLO CS,V
	TLNE RC,-1
	TRZ CS,1
	TLNE RC,-2
	TRZ CS,EXTF
	TLNN V,-1
	TLNE RC,-1
	CALL ONC1
	CALL OUTTAB
	HRLO CS,V
	TRNE RC,-1
	TRZ CS,1
	TRNE RC,-2
	TRZ CS,EXTF
	CALL ONC1
	CALL OUTTAB		;AND TAB, OF COURSE
	CALL SOUTE8		;ABBREVIATION FOR TYPE
	JRST OUTTAB		;FINAL TAB

SOUTE8:	TLNN ARG,INTF!EXTF!ENTF!UNDF!NOOUTF
	 RET			;SKIP JUNK FOR SIMPLE STUFF
	SETZ CS,
	TLNE ARG,INTF		;INTERNAL
	MOVEI CS,1
	TLNE ARG,EXTF		;EXTERNAL
	MOVEI CS,-1
	TLNE ARG,ENTF		;ENTRY
	MOVEI CS,-5
	TLNE ARG,NOOUTF		;DDT SURPRESSED
	ADDI CS,3
	TLNE ARG,UNDF		;UNDEFINED
	MOVEI CS,-3		;SET FOR UDF
	MOVEI CS,SOUTC(CS)	;GET ABREVIATION
	JRST OUTAS0
SOUT1:	MOVE SX,PAGENO		;GET LAST SYMBOL PAGE NUMBER
	EXCH SX,SPAGNO		;SWAP WITH OUTPUT PAGE NUMBER
	MOVEM SX,PAGENO		;AND STORE IT
	MOVE SX,[BYTE (7) 0,0,<"S">,<"-">,0]
	ANDCAM SX,DBUF+4	;FIXUP TITLE
SOUT2:	CALL SGLKUP		;SET FOR TABLE SCAN
	TRNN ARG,SYMF
	TRNN ARG,MACF!SYNF
	TDZA MRP,MRP		;SKIP AND CLEAR MRP
	RET			;NO, TRY AGAIN
	TRNE ARG,INTF
	MOVEI MRP,1
	TRNE ARG,EXTF
	MOVNI MRP,1		;MRP=-1 FOR EXTERNAL
	TRNE ARG,SYNF		;SYNONYM?
	JUMPL MRP,CPOPJ		;[664] YES, DON'T OUTPUT IF EXTERNAL
	TRNE ARG,SUPRBT		;IF SUPRESSED
	RET			;DO NOT OUTPUT
	JUMPGE MRP,SOUT10	;BRANCH IF NOT EXTERNAL
	HLRZ RC,V		;PUT POINTER/FLAGS IN RC
	TRNE RC,-2		;POINTER?
	MOVS RC,0(RC)		;YES
	HLL V,RC		;STORE LEFT VALUE

SOUT10:	PUSH P,RC		;SAVE FOR LATER
	MOVEI AC1,0
	JUMPLE MRP,SOUT15	;SET DEFFERRED BITS IF INTERN=EXTERN
   IFN POLISH,<
	JUMPL RC,.+3		;ONLY SET RHS FIXUP FLAG IF POLISH
   >
	TLNE RC,-2		;CHECK FOR LEFT FIXUP
	IORI AC1,40		;AND SET BITS
	TRNE RC,-2		;CHECK FOR RIGHT FIXUP
	IORI AC1,20		;AND SET BITS
SOUT15:	TLNE RC,-2		;FIX RELOC AS 0 IF EXTERNAL
	HRRZS RC
	TRNE RC,-2
	HLLZS RC
	TLZE RC,-1
	TRO RC,2
	HRL MRP,RC
	MOVEI RC,0
	TRNE ARG,ENTF		;ENTRY DMN
	HRRI MRP,-5
	TRNE ARG,NOOUTF		;SUPRESS OUTPUT? WFW
	ADDI MRP,3		;YES WFW
	TRNE ARG,UNDF		;UNDEFINED IS EXTERNAL
	HRRI MRP,2		;SO FLAG AS UDF
	IOR AC1,SOUTC(MRP)
	MOVE ARG,AC1
	CALL NOUT2		;SQUOZE AND DUMP THE SYMBOL
	MOVEM AC0,SVSYM		;SAVE IT
	MOVE AC0,V		;GET THE VALUE
	HLRZ RC,MRP		;AND THE RELOCATION
	CALL COUT
	POP P,RC		;GET BACK RELOC AND CHECK EXTERNAL
	TRNN RC,-2		;IS IT?
	JRST SOUT50		;NO
   IFN POLISH,<
	JUMPL RC,SOUT70		;SPECIAL POLISH SYMBOL FIXUP
   >
	MOVE AC0,1(RC)		;GET NAME
	MOVEI ARG,60		;EXTERNAL REQ
	CALL SQOZE
	HLLZS RC		;NO RELOC
	CALL COUT		;OUTPUT IT
	MOVE AC0,SVSYM		;GET SYMBOL NAME
	TLO AC0,500000		;SET AS ADDITIVE SYMBOL
	TLZ AC0,200000		;BUT NOT LEFT HALF ETC
	CALL COUT
SOUT50:	MOVSS RC		;CHECK LEFT HALF
	TRNN RC,-2
	RET
	MOVE AC0,1(RC)
	MOVEI ARG,60
	CALL SQOZE
	MOVEI RC,0
	CALL COUT
	MOVE AC0,SVSYM
	TLO AC0,700000
	JRST COUT
   IFN POLISH,<
SOUT70:	CALL COUTD		;DUMP CURRENT BLOCK
	PUSH P,SYMBOL		;SAVE CURRENT SYMBOL TABLE ORIGIN
	PUSH P,FREE		;SAVE FREE STORAGE ORIGIN
	PUSH P,BLKTYP		;SAVE CURRENT BLOCK TYPE
	MOVEI AC0,11		;SET TO POLISH
	MOVEM AC0,BLKTYP
	PUSH P,POLIST		;SAVE REAL LIST
	SETZM POLIST		;INITIALIZE
	SKIPE (RC)
	JFCL
	MOVNI AC0,3		;ASSUME FULL WORD FIXUP
	MOVEM AC0,POLTYP
	MOVE AC0,SVSYM		;RADIX-50 SYMBOL
	TLZ AC0,740000		;CLEAR CODE BITS
	MOVEM AC0,INASGN	;FLAG SYMBOL FIXUP
	CALL POLSYM		;NOW CONVERT
	CALL POUT		;DUMP THIS BLOCK
	CALL COUTD		;FORCE BLOCK OUT
	MOVSI AC0,(POINT 2)	;RESET BYTE FIELD
	HLLM AC0,COUTP
	POP P,POLIST		;PUT LIST BACK
	POP P,BLKTYP		;PREVIOUS BLOCK TYPE
	POP P,FREE		;GIVE BACK FREE STG USED BY POLSYM
	POP P,AC0		;RECOVER SYMTAB ORIGIN
	SUB AC0,SYMBOL		;COMPUTE DIFFERENCE IN CASE SYMTAB MOVED
	SUB SX,AC0		;ADJUST LOCAL PTR ACCORDINGLY
	RET
   >

	<ASCII /ent/>!04	;DMN
	0
	<ASCII /udf/>!60	;UNDEFINED EXTERNAL
	<ASCII /sen/>!44	;SUPRESSED ENTRY
	<ASCII /ext/>!60
SOUTC:	EXP 10
	<ASCII /int/>!04
	<ASCII /sex/>!60	;SUPPRESSED EXTERNAL (NOT USED YET)
	<ASCII /spd/>!50
	<ASCII /sin/>!44	;DMN
				;OUTPUT THE BINARY
BOUT:	HRRZ CS,LOCA		;PICKUP THE LOCATION
	SUB CS,STPX		;MINUS START
	ADD CS,STPY		;PLUS END
	HRLO CS,CS		;TO GET ASSEMBLY LOCATION
	SKIPGE BLSW		;BINARY LISTING OFF?
	JRST BOUT1		;YES
	ILDB C,TABP		;DO A TAB
	CALL OUTL
	SKIPLE LITLVL		;IN LITERAL?
	JRST BOUT1		;YES, DON'T LIST LOCATION
	CALL ONC1		;OUTPUT IT TO THE LISTING FILE
	CALL OUTCSQ		;[717] GO OUTPUT "'"
BOUT1:	CALL DSTOW		;GET THE CODE
   IFN POLISH,<
	JUMPL RC,[TLO FR,POLSW	;[614] WE HAVE A POLISH FIXUP
		TRO FRR,LHPSW	;[614]
		HRRZS RC	;[614] CLEAR LH(RC)
		JRST .+1]	;[614] RETURN
	PUSH P,RC		;[614] STORE AWAY RC
	HRRES RC		;[614] BEFORE CHECKING RH
	JUMPL RC,[TLO FR,POLSW	;[614] DOING POLISH
		TRO FRR,RHPSW	;[614]
		POP P,RC	;[614] RESTORE RC
		HLLZS RC	;[614] CLEAR RH(RC)
		JRST .+2]	;[614] SKIP RETURN
	POP P,RC		;[614]
   >
	PUSH P,RC		;SAVE RELOC
	PUSH P,RC		;AND AGAIN
	TLNE RC,-2		;CHECK LEFT EXTERNAL
	HRRZS RC		;MAKE LEFT NON-RELOC
	SKIPG LITLVL		;NOT IN LITERAL?
	TRNN RC,-2		;RIGHT EXT?
	JRST BOUT30		;NO
	HRRZ AC1,AC0		;YES
	JUMPE AC1,BOUT20	;PROCESS IF ZERO CODE THERE
	HLLZS RC		;MAKE NON-RELOC
	JRST BOUT30		;PROCESS

BOUT20:	HRRM AC1,-1(P)		;FIX RC IN STACK SO NO CONFUSION WFW (AC1 HAS 0)
	HRR AC0,0(RC)		;NO, SET ADDRESS LINK
	MOVE AC1,LOCO		;GET CURRENT LOCATION
	HRRM AC1,0(RC)		;SET NEW LINK
	HLRZ AC1,0(RC)		;GET FLAGS/POINTER
;[604]	TRNN AC1,-2		;POINTER?
	HRR AC1,RC		;NO, SET TO FLAGS
	HLR RC,0(AC1)		;PUT FLAGS IN RC
	HRL AC1,MODO		;GET CURRENT MODE
	TRZE RC,-2		;LEFT HALF RELOCATABLE+
	TLO AC1,2		;YES, SET FLAG
	HLLM AC1,0(AC1)		;STORE NEW FLAGS
BOUT30:	HLLO CS,AC0
	TLZE RC,1		;PACK RELOCATION BITS
	TRO RC,2
	TRNE RC,2		;LEFT HALF RELOCATABLE?
	TRZ CS,1		;YES, RESET BIT
	SKIPGE BLSW		;BINARY LISTING OFF?
	JRST BOUT3I		;YES
	PUSH P,AC0		;NEED AN AC
	HLRZ AC0,-1(P)		;AC0 = LEFT RELOCATION
	CAILE AC0,1		;EXTERNAL?
	XORI CS,EXTF!1		;YES, SET SWITCH
   IFN FORMSW,<
	OR AC0,HWFMT
	JUMPN AC0,BOUT3H	;EDIT IN HALF WORD FORMAT IF NOT 0
	MOVE AC0,FORM		;GET FORM WORD
	MOVEI C,0		;ZERO FIELD SIZE
BOUT3A:	JFFO AC0,BOUT3B		;AC1 = FIELD SIZE -1
	JRST BOUT3C		;NO FIELDS LEFT, JUMP
BOUT3B:	LSH AC0,1(AC1)		;SHIFT OFF FORM FIELD
	MOVEI AC1,6(AC1)
	IDIVI AC1,3		;AC1 = COLUMNS USED + 1
	ADDI C,(AC1)		;INCREMENT FIELD SIZE
	CAIG C,^D23		;IS FIELD SIZE GTR 23?
	JRST BOUT3A		;NO.  CONTINUE
	MOVE AC1,HWFORM		;USE STANDARD FORM
	MOVEM AC1,FORM
	MOVEI C,^D13		;SET FIELD SIZE TO 13
BOUT3C:	MOVEM C,FLDSIZ		;STORE FIELD SIZE
	MOVE AC0,FORM		;AC0 = FORM WORD
	TRNN RC,2		;IS LEFT HALF RELOCATED?
	CAMN AC0,HWFORM		;NO.  IS FORM HALF WORD?
	JRST BOUT3H		;YES.  EDIT IN OLD WAY
	IBP TABP
	CAIL C,^D16
	IBP TABP
   IFN FTPSECT,<		;[647]
	SKIPE SGNMAX		;[647] DOING PSECTS?
	JRST [	CAIL C,^D16	;[717]
		IBP TABP	;[717]
		MOVEI C," "	;[647] USE 2 SPACES INSTEAD OF A TAB
		CALL OUTC	;[647]
		CALL OUTC	;[647]
		IBP TABP	;[647]
		JRST BOUT01]	;[647]
   >				;[647]
	ILDB C,TABP		;GET A TAB
	CALL OUTL		;OUTPUT IT
BOUT01:	MOVE AC2,(P)		;[647] AC2 = INFO TO BE EDITED
	PUSH P,CS		;SAVE CS = C+1
BOUT3D:	JFFO AC0,BOUT3E		;AC1 = FIELD LENGTH - 1
BOUT3E:	LSH AC0,1(AC1)		;SHIFT OFF FORM FIELD
	MOVEI C,3(AC1)
	MOVEI AC1,0
	LSHC AC1,-2(C)		;AC1 = FIELD INFO
	IDIVI C,3		;C = # OF OCTAL DIGITS
	MOVE C+1,AC0		;SAVE AC0
   IFN FTPSECT,<		;[717]
	SKIPE SGNMAX		;[717]
	IBP TABP		;[717]
   >				;[717]
	SKIPE IOSEEN		;IS THIS A I/O INST.
	CALL BOUT3J		;YES,SET FIELDS CORRECTLY
	MOVNS C
	ROT AC1,(C)
	ROT AC1,(C)
	ROT AC1,(C)
	MOVNS C
BOUT3F:	MOVEI AC0,6		;EDIT A DIGIT
	LSHC AC0,3
	EXCH AC0,C
	CALL OUTC		;OUTPUT IT
	MOVE C,AC0
	SOJG C,BOUT3F		;IF MORE DIGITS,  GO BACK
	JUMPE C+1,BOUT3G	;JUMP IF END OF WORD
	MOVE AC0,C+1		;RESTORE AC0
	MOVEI C," "
	CALL OUTC		;OUTPUT A SPACE
	JRST BOUT3D		;PROCESS NEXT FIELD
BOUT3G:	POP P,CS		;RESTORE CS = C+1
	MOVEI C," "
	TRNE RC,1		;RELOCATABLE?
	MOVEI C,"'"		;YES
	HRRZ AC0,-1(P)		;AC0 = RIGHT RELOCATION
	CAILE AC0,1		;EXTERNAL?
	MOVEI C,"*"		;YES
	TLNE FR,POLSW		;POLISH?
	MOVEI C,"#"		;YES,
	CALL ONC2		;STORE POSSIBLE INDICATOR
	POP P,AC0
	JRST BOUT3I		;CONTINUE

BOUT3H:
   IFN FTPSECT,<		;[717]
	SKIPE SGNMAX		;[717]
	IBP TABP		;[717]
   >				;[717]
	MOVEI C,^D15		;SET SIZE TO 15
	MOVEM C,FLDSIZ
	SETZM IOSEEN		;CLEAR IN CASE HWFMT WAS SET
   >
	POP P,AC0		;RESTORE
   IFN POLISH,<
	TRZE FRR,LHPSW		;[614] LEFT HALF POLISH?
	HRRI CS,-5		;[614] YES, WE WANT A "#"
   >
	CALL ONC
	HRLO CS,AC0
	TDZ CS,RC		;SET RELOCATION
	HRRZ C,(P)		;C = RIGHT RELOCATION
	CAILE C,1		;EXTERNAL
	XORI CS,EXTF!1		;YES, SET SWITCH
   IFN POLISH,<
	TRZE FRR,RHPSW		;[614] RIGHT HALF POLISH?
	HRRI CS,-5		;[614] YES, MAKE SURE WE GET "#"
   >
	CALL ONC
BOUT3I:	POP P,CS		;GET RID OF ENTRY ON STACK
	SKIPLE LITLVL		;IN LITERAL?
	JRST [	POP P,RC	;YES, CLEAR STACK
		RET]		;DON'T OUTPUT TO REL
	HRRZ CS,LOCO
	TLNE FR,RIMSW!RIM1SW!R1BSW ;RIM OUTPUT?
	JRST ROUT		;YES, GO PROCESS
	HRL CS,MODO
	CAME CS,MODLOC		;SEQUENCE OR RELOCATION BREAK?
	CALL COUTD		;YES, DUMP THE BUFFER
	SKIPL COUTX		;NEW BUFFER?
	JRST BOUT40		;NO, STORE CODE AND EXIT
	MOVEM CS,MODLOC		;YES, STORE NEW VALUES
	EXCH AC0,LOCO
	EXCH RC,MODO
	CALL COUT		;STORE BLOCK LOCATION AND MODE
	EXCH RC,MODO		;RESTORE CURRENT VALUES
	EXCH AC0,LOCO
BOUT40:	CALL COUT		;EMIT CODE
	POP P,RC		;RETRIEVE EXTERNAL BITS
	TRNN RC,-2		;RIGHT EXTERNAL?
	JRST BOUT50		;TRY FOR LEFT
	CALL COUTD
	PUSH P,BLKTYP		;TERMINATE TYPE AND SAVE
	MOVEI AC0,2		;BLOCK TYPE 2
	MOVEM AC0,BLKTYP
	MOVE AC0,1(RC)		;GET SYMBOL
	MOVEI ARG,60		;CODE BITS
	CALL SQOZE		;CONVERT TO RADIX 50
	HLLZS RC		;SYMBOL HAS NO RELOCATION
	CALL COUT		;EMIT
	MOVE AC0,LOCO		;GET CURRENT LOC
	HRLI AC0,400000		;ADDITIVE REQ
	HRR RC,MODO		;CURRENT MODE
	CALL COUT		;EMIT
	MOVSS RC		;NOW FOR LEFT
	TRNN RC,-2
	JRST BOUT60
	JRST BOUT70

BOUT50:	MOVSS RC		;CHECK OTHER HALF
	TRNN RC,-2		;LEFT HALF EXTERNAL?
	JRST BOUT80		;NO, FALSE ALARM
	CALL COUTD		;CHANGE MODE
	PUSH P,BLKTYP
	MOVEI AC0,2
	MOVEM AC0,BLKTYP
BOUT70:	MOVE AC0,1(RC)
	TLNN AC0,-1		;[735] EXTERNAL NAME?
	JRST [	MOVEI AC0,10	;[735] NO, LH=0 MUST BE PTR TO LOCAL BLK
		MOVEM AC0,BLKTYP ;[735] GENERATE A BLOCK 10
		MOVE ARG,RC	;[735]
		SETZ RC,	;[735]
		SETO AC0,	;[735]
		CALL COUT	;[735] OUTPUT -1 FOR LEFT 
		MOVE AC1,1(ARG)	;[735] GET LOCAL BLK PTR
		HLRZ AC0,0(AC1)	;[735] VALUE IN RH
		HRL AC0,LOCO	;[735] FIXUP ADDR IN LH
		MOVE RC,MODO	;[735] FIXUP RELOC
		LSH RC,1	;[735] SHIFT ONE
		MOVS ARG,1(AC1)	;[735] GET RELOC IN RH
		ADD RC,ARG	;[735] MAKE IT JOIN-RELOC
		CALL COUT	;[735] EMIT
		JRST BOUT60]	;[735]
	MOVEI ARG,60
	CALL SQOZE
	HLLZS RC
	CALL COUT
	MOVE AC0,LOCO
	HRLI AC0,600000		;LEFT HALF ADD
	HRR RC,MODO
	CALL COUT		;EMIT
BOUT60:	CALL COUTD		;CHANGE MODE
	POP P,BLKTYP		;TO OLD ONE
BOUT80:	AOS LOCO
	AOS MODLOC
   IFN POLISH,< TLZ FR,POLSW	;[761]
	TRZ FRR,LTGSW!LHPSW!RHPSW!FWPSW> ;[761]
	RET
   IFN FORMSW,<
BOUT3J:	MOVSS IOSEEN		;SWAP
	SKIPGE IOSEEN		;SKIP IF NOT FIRST FIELD
	JRST [HLLZS IOSEEN	;CLEAR RIGHT HALF
		RET]		;AND RETURN
	MOVSS IOSEEN		;SWAP BACK
	LSH AC1,2		;CORRECT  MNEMONIC AND OP CODE
	CAIE C,1		;IS IT OP CODE?
	RET			;NO,JUST RETURN
	MOVEI C,2		;TWO CHAR. WIDE NOW
	SETZM IOSEEN		;DON'T COME AGAIN
	RET			;RETURN
   >

;HERE TO OUTPUT "'" FOR RELOCATABLE ADDRESSES

OUTCSQ:	MOVEI C,"'"		;[717]
   IFN FTPSECT,<		;[717]
	SKIPE SGNMAX		;[717]
	JRST OUTIDX		;[717]
   >
	SKIPE MODA		;[717] SKIP IF ABSOLUTE
	PJRST OUTC		;[717] NO
	RET			;[717]

;HERE TO OUTPUT PSECT INDES

   IFN FTPSECT,<
OUTIDX:	SKIPN MODA		;[717] ABSOLUTE?
	JRST [	MOVEI C,40	;[717] YES,
		CALL OUTC	;[717] 3 SPACES INSTEAD
		CALL OUTC	;[717]
		PJRST OUTC]	;[717]
	CALL OUTC		;[717] OUT WITH "'"
	MOVE C,SGNCUR		;[647] GET CURRENT PSECT INDES
	CAIL C,100		;[647] DO WE HAVE A 3-DIGIT INDEX#?
	PJRST OUTOCT		;[647] YES, USE OUTOCT
	MOVE CS,[POINT 3,SGNCUR,29] ;[647] NO, LESS
	ILDB C,CS		;[647] PICK UP FIRST DIGIT
	ADDI C,"0"		;[647] CONVERT TO ASCII
	CALL OUTC		;[647] AND OUTPUT IT
	ILDB C,CS		;[647] SECOND DIGIT
	ADDI C,"0"		;[647]
	PJRST OUTC		;[647]
   >
NOUT:	MOVE V,[POINT 7,TBUF]	;POINTER TO ASCII LINE
	MOVSI CS,(POINT 6,AC0)	;POINTER TO SIXBIT AC0
	SETZB ARG,AC0
NOUT1:	ILDB C,V		;GET ASCII
	CAIL C,"A"+40
	CAILE C,"Z"+40
	JRST .+2
	TRZA C,100		;LOWER CASE TO SIXBIT
	SUBI C,40		;CONVERT TO SIXBIT
	JUMPLE C,NOUT3		;TEST FORM NON-SIXBIT
	CAILE C,77		;AND NOT GREATER THAN SIXBIT
	JRST NOUT3		;...
	LDB AC1,[POINT 6,CSTAT(C),23] ;INDEX TO CSTAT
	SKIPN AC1		;RADIX 50?
	JRST NOUT3		;NO, ASSUME TERMINATOR
	IDPB C,CS		;DEPOSIT IN AC0
	TLNE CS,770000		;TEST FOR SIX CHARACTERS
	JRST NOUT1		;NO, GET ANOTHER
NOUT3:	SKIPGE UNIVSN		;IF A UNIVERSAL PROG
	RET			;RETURN TO PUT IT IN THE TABLE

	CALL NOUT2		;DUMP NAME
	MOVSI AC0,11		;TYPE MARKER
	IOR AC0,CPUTYP		;CPU  TYPE
	PJRST COUT		;DUMP AND EXIT

NOUT2:	CALL SQOZE		;CONVERT TO SIXBIT
	JRST COUT		;DUMP AND EXIT

HOUT:
   IFN FTPSECT,<		;[575]
	SETZB AC0,SGNCUR	;[642] FORCE TO PSECT 0
	SKIPE SGNMAX		;NO PSECTS
	CALL SGOUTN		;PUT IT OUT
   >
	MOVEI RC,1		;RELOCATABLE
	MOVE AC0,HHIGH		;GET HIGH SEG IF TWO SEGMENTS
	JUMPE AC0,.+2		;NOT TWO SEGMENTS
	CALL COUT		;OUTPUT IT 
	MOVE AC0,SGATTR
	SKIPE HHIGH		;ANY TWOSEG HIGH STUFF
	JRST COUT		;YES,SO NO ABS.
	CALL COUT		;OUTPUT THE HIGHEST LOCATION
	MOVE AC0,ABSHI
				;PUT OUT ABS PORTION OF PROGRAM BREAK
	SOJA RC,COUT		;OUTPUT A WORD OF ZERO AND EXIT
   IFN POLISH,<
;HERE TO OUTPUT BLOCK TYPE 11
POUT:	SKIPN POLIST		;ANY POLISH TO OUTPUT?
	RET			;NO
	TLO FR,POLSW		;SET FLAG
	CALL COUTD		;DUMP BUFFER UNLESS EMPTY
	MOVE CS,@POLIST		;GET A BLOCK POINTER
	EXCH CS,POLIST		;SET FOR NEXT TIME
	SKIPE SGNMAX		;[1060] ANY PSECTS?
	JRST [HRRZ AC0,1(CS)	;[1060] YES, SAVE INDEX OF CURRENT
		TRZ AC0,400000	;[1060] (SEE POLOPF:)
		MOVEM AC0,POLPS0 ;[1060]
		JRST .+1]	;[1060]
POUTA:	ADDI CS,1		;FIRST WORD
	MOVE AC0,(CS)		;GET SOMETHING
	SETZ RC,		;CLEAR RELOCATION
	JUMPL AC0,POUTOP	;THIS IS AN OPERATOR
	CALL PCOUT		;STORE THIS HALF WORD
	JUMPE AC0,POUT0		;18 BIT VALUE
	SOJE AC0,POUT1		;36 BIT VALUE
	HLRZ AC0,1(CS)		;GET HALF OF SYMBOL
	CALL PCOUT
	HRRZ AC0,1(CS)		;GET OTHER HALF
	CALL PCOUT
	AOJA CS,POUTA

POUT0:	HLRZ RC,1(CS)		;GET RELOCATION
	HRRZ AC0,1(CS)		;AND VALUE
	CALL PCOUT
	AOJA CS,POUTA		;GET NEXT

POUT1:	HLRZ RC,1(CS)		;GET LEFT HALF
	HLRZ AC0,2(CS)
	CALL PCOUT
	HRRZ RC,1(CS)		;RIGHT HALF
	HRRZ AC0,2(CS)
	CALL PCOUT
	ADDI CS,2		;SKIP OVER 2 WORDS
	JRST POUTA

POUTOP:	HRRZ AC0,AC0		;GET OPERATOR ONLY
	CALL PCOUT		;OUTPUT
	CAIGE AC0,-6		;CHECK FOR STORE OP
	JRST POUTA		;ITS NOT
	CAIGE AC0,-3		;CHECK FOR SYMBOL FIXUP
	JRST POUTSY		;IT IS
	HLRZ RC,1(CS)		;GET RELOCATION
	HRRZ AC0,1(CS)		;AND STORE ADDRESS
	HRLM RC,POLAD0		;[1060] SAVE ADDR AND RELOCATION
	HRRM AC0,POLAD0		;[1060] IN CASE ERROR
POUTOQ:	CALL PCOUT
	SKIPE POLERR		;[1060] PROCESSING ERROR?
	CALL [MOVEI C,POLLIM	;[1060] YES, FORCE TERMINATION IN
		MOVEM C,POLERR	;[1060] CASE WE HAVE GARBAGE
		PJRST POLER4]	;[1060] GIVE MESSAGE AND RETURN
POUTQ1:	TLZ FR,POLSW		;[1060] CLEAR FLAG IN CASE END
	SETZM POLAD0		;[1060] CLEAR ERROR INFO
	SETZM POLSY0		;[1060]
	JRST POUT		;SEE IF MORE TO GO

POUTSY:	PUSH P,1(CS)		;[1060] SAVE SYMBOL NAME IN
	POP P,POLSY0		;[1060] CASE OF ERROR
	HLRZ AC0,1(CS)		;GET LHS SYMBOL
	SETZ RC,		;NO RELOCATION
	CALL PCOUT		;OUTPUT IT
	HRRZ AC0,1(CS)		;GET RHS
	CALL PCOUT
	SETZ AC0,		;FOLLOW WITH 0 FOR BLOCK LEVEL (FAIL COMPATIBLE)
	CALL PCOUT		;LHS
	PJRST POUTOQ		;RHS

PCOUT:	MOVE C,COUTP		;GET POINTER
	TLNE C,010000		;LEFT OR RIGHT HALF?
	JRST PCOUTR		;JUST THE RIGHT HALF
	AOS C,COUTX		;INCREMENT INDEX
	HRLZM AC0,COUTDB(C)	;STORE LEFT HALF
	IDPB RC,COUTP		;AND RELOCATION
	RET

PCOUTR:	MOVE C,COUTX		;GET CURRENT INDEX
	HRRM AC0,COUTDB(C)	;STORE RIGHT HALF
	IDPB RC,COUTP		;AND RELOCATION
	CAIE C,^D17		;IS THE BUFFER FULL
	RET			;NO
;HERE TO GIVE BEST ERROR MESSAGE POSSIBLE FOR POLISH BLOCK
;EXCEEDING 18 WORDS (OR CURRENT LIMIT)
POLLIM==1	;[1060] THIS VALUE DENOTES THE NUMBER OF 18-WORD
		;[1060] BLOCKS (BEYOND THE FIRST) WE ARE WILLING
		;[1060] TO PERUSE FOR A FIXUP TYPE;
		;[1060] CAN BE CHANGED FOR DEBUGGING PURPOSES.
POLER4:	SKIPN POLERR		;[1066] FIRST TIME THROUGH?
	JRST [PUSH P,['MCRPTC']	;[1066] YES, SET PREFIX
		POP P,PREFIX	;[1066]
		SETZ RC,	;[1066] ZERO RC FOR TEST AFTER CALL
		PUSH P,CS	;[1066] SAVE PTR TO LIST
		CALL EFATAL	;[1066] FATAL ERROR
		POP P,CS	;[1066] RESTORE CS
		CAMN RC,[-1]	;[1066] TEXT TO BE SUPPRESSED?
		PJRST POLER6	;[1066] YES, GIVE CRLF AND EXIT
		JRST .+1]	;[1066] NO, CONTINUE
	SKIPE POLAD0		;[1060] LOCATION FIXUP?
	JRST POLER1		;[1060] YES, GIVE APPROPRIATE MESSAGE
	SKIPE POLSY0		;[1060] SYMBOL FIXUP?
	JRST POLER2		;[1060] GIVE APPROPRIATE MESSAGE
	MOVE C,POLERR		;[1060] WE DON'T KNOW FIXUP TYPE YET,
	CAIL C,POLLIM		;[1060] CAN WE LOOK FURTHER?
	JRST POLER5		;[1060] NO, GIVE UP
	AOS POLERR		;[1060] YES, INITIALIZE FOR NEXT BLOCK
	PJRST COUTI		;[1060] AND LOOK FOR FIXUP TYPE
POLER5:	HRROI  RC,[SIXBIT / POLISH TOO COMPLEX@/] ;[1066][1060]
	CALL TYPMSG		;PRINT MESSAGE
POLER0:	SUB P,[1,,1]		;[1060][654] ADJUST STACK POINTER AND
	SETZM POLERR		;[1060] CLEAR ERROR-PROCESSING COUNT
	SETOM COUTX		;[1060] RE-INIT WORD COUNT
	JRST POUTQ1		;[1060] FORGET ABOUT THIS BLOCK

POLER1:	HRRZI CS,[SIXBIT / POLISH TOO COMPLEX FOR LOCATION@/] ;[1066]
	CALL TYPM2		;[1060]
	HRRZ AC0,POLAD0		;[1060] TYPE OUT ADDRESS
	CALL TYPOCT		;[1060]
	HLRZ C,POLAD0		;[1060] GET RELOCATION
	CAIN C,1		;[1060] APPEND "'" IF NECESSARY
	CALL [MOVEI C,"'"	;[1060]
		CALL TYO	;[1060]
		MOVE AC0,POLPS0	;[1060] APPEND PSECT INDEX IF
		JUMPE AC0,CPOPJ	;[1060] NECESSARY
		CAIL AC0,10	;[1060]
		PJRST TYPOCT	;[1060]
		MOVEI C,"0"	;[1060]
		CALL TYO	;[1060]
		MOVE C,POLPS0	;[1060]
		ADDI C,"0"	;[1060]
		PJRST TYO]	;[1060]
POLER6:	CALL CRLF		;[1066][1060] AND CRLF
	JRST POLER0		;[1060] COMMON EXIT

   DEFINE R50CHR(CHR),<IRPC CHR,<"CHR"-40
   >>
R50TAB:	R50CHR( 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$% )
POLER2:	HRRZI CS,[SIXBIT / POLISH TOO COMPLEX FOR SYMBOL@/] ;[1066]
	CALL TYPM2		;[1060]
	MOVE C,POLSY0		;[1060] GET RADIX-50 OF SYMBOL
	TLZ C,740000		;[1060] CLEAR 4-BIT SYMBOL CODE
	SETZ RC,		;[1060] CLEAR RELOCATION
	MOVEI AC0,5		;[1060] SET ITERATION COUNT
POLER3:	IDIVI C,50		;[1060] CONVERT TO SIXBIT
	SKIPE CS,R50TAB(CS)	;[1060]
	LSHC CS,-6		;[1060]
	CAILE C,50		;[1060]
	SOJG AC0,POLER3		;[1060] LOOP BACK IF MORE
	SKIPE CS,R50TAB(C)	;[1060]
	LSHC CS,-6		;[1060] LAST CHAR
	MOVE CS,RC		;[1060] TYPE RESULT
	CALL TYPSYM		;[1060]
	PJRST POLER6		;[1066]
>				;END IFN POLISH
IFN FTPSECT,<			;[575]
;HERE TO OUTPUT BLOCK TYPE 24 - PSECT NAME, ATTRIBUTE AND ORIGIN
SGOUTN:	CALL COUTD		;FINISH OFF CURRENT BLOCK
	PUSH P,BLKTYP		;SAVE CURRENT BLOCK TYPE
	SKIPL BLK24		;[1020] FIRST TIME?
	JRST SGOUTS		;[1020] NO, OUTPUT BLOCK 22
	SETZM BLK24		;[1020] CLEAR BLOCK 24 FLAG
	MOVEI AC0,24		;BLOCK TYPE 22 IS A
	MOVEM AC0,BLKTYP	;PSECT NAME
	MOVE C,SGNCUR		;GET CUR PSECT INX
	MOVE AC0,SGNAME(C)	;GET PSECT NAME
	SETZ RC,		;CLEAR RELOCATION
	CALL COUT		;OUTPUT THE BLOCK
	MOVE C,SGNCUR		;[1020] GET CURRENT PSECT INDEX
	HLLZ AC0,SGATTR(C)	;[1020] GET ATTRIBUTE
	HRR AC0,C		;[1020] PSECT INDEX IN RIGHT HALF
	SETZ RC,		;[1020] CLEAR RELOCATION
	SKIPGE AC0		;[1020] RELOCATABLE PSECT?
	JRST SGOUT1		;[1020] YES, DON'T BOTHER WITH ORIGIN
	CALL COUT		;[1020] OUTPUT ATTRIBUTE
	MOVE C,SGNCUR		;INDEX AGAIN
	HRRZ AC0,SGORIG(C)	;GET ORIGIN IF SPECIFIED
SGOUT1:	CALL COUT		;[1020]
	CALL COUTD		;FINISH IT OFF
	POP P,BLKTYP		;RESTORE CURRENT BLOCK TYPE
	RET			;RETURN

;HERE TO OUTPUT BLOCK TYPE 22 - SWITCH CURRENT RELOC COUNTER TO THE PSECT
SGOUTS:	MOVEI AC0,22		;[1020] BLOCK 24
	MOVEM AC0,BLKTYP	;[1020]
	MOVE AC0,SGNCUR		;[1020] CURRENT PSECT INDEX
	SETZ RC,		;[1020] CLEAR RELOCATION
	JRST SGOUT1		;[1020] THAT'S IT

;HERE TO OUTPUT BLOCK TYPE 23 - PSECT LENGTH
SGOUTL:	CALL COUTD		;FINISH OFF CURRENT BLOCK
	PUSH P,BLKTYP		;SAVE CURRENT BLOCK TYPE
	MOVEI AC0,23		;BLOCK TYPE 23 IS A
	MOVEM AC0,BLKTYP	;PSECT LENGTH
	MOVE RC,SGNCUR		;GET CUR PSECT INX
	MOVE AC0,SGNAME(RC)	;GET PSECT NAME
	SETZ RC,		;CLEAR RELOCATION
	CALL COUT		;OUTPUT THE NAME
	MOVE RC,SGNCUR		;GET CUR PSECT INX
	HRRZ AC0,SGATTR(RC)	;GET PSECT LENGTH
	MOVEI RC,1		;BREAK IS RELOCATED
	CALL COUT		;OUTPUT THE LENGTH AND ATTRS
	CALL COUTD		;FINISH IT OFF
	POP P,BLKTYP		;RESTORE CURRENT BLOCK TYPE
	RET			;RETURN
   >
HSOUT:	SETZM HISNSW		;CLEAR FOR PASS2
	MOVE AC0,SVTYP3		;GET HISEG ARG
	JUMPGE AC0,.+4		;JUMP IF ONLY HISEG
	HRL AC0,HIGH1		;GET BREAK FROM PASS 1
	JUMPL AC0,.+2		;OK IF GREATER THAN 400000
	HRLS AC0		;SIGNAL TWO SEGMENT TO LOADER
	MOVEI RC,1		;ASSUME RELOCATABLE
	JRST COUT		;OUTPUT THE WORD

VOUT:	SKIPN RC,VECREL		;IS VECTOR ABSOLUTE ZERO?
	SKIPE VECTOR		;ALSO CHECK RELOCATION
	JRST .+3
	SKIPN VECSYM		;SEE IF SYMBOLIC
	RET			;YES, EXIT
   IFN FTPSECT,<		;[575]
	MOVE AC0,VECFND		;GET START ADR PSECT INX
	MOVEM AC0,SGNCUR	;POINT CUR PSECT THERE
	SKIPE SGNMAX		;IF PSECTS WERE USED
	CALL SGOUTN		;THEN PUT OUT PSECT BLOCK
	MOVE RC,VECREL>		;GET RELOCATION
	MOVE AC0,VECTOR		;AC0 SHOULD BE FLAGS
	SKIPN VECSYM		;2 WORDS IF SYMBOLIC
	JRST COUT
	CALL COUT		;OUTPUT CONSTANT
	MOVE AC0,VECSYM		;GET SYMBOL
	MOVEI ARG,60		;MAKE REQUEST
	CALL SQOZE		;IN RADIX-50
	SETZ RC,

COUT:	AOS C,COUTX		;INCREMENT INDEX
	MOVEM AC0,COUTDB(C)	;STORE CODE
	IDPB RC,COUTP		;STORE RELOCATION BITS
	CAIE C,^D17		;IS THE BUFFER FULL?
	RET			;NO, EXIT

COUTD:	AOSG C,COUTX		;DUMP THE BUFFER
	JRST COUTI		;BUFFER WAS EMPTY
	HRL C,BLKTYP		;SET BLOCK TYPE
COUTT:				;ENTER FROM .TEXT PSEUDO-OP
	CALL OUTBIN		;OUTPUT COUNT AND TYPE
	SETOB C,COUTY		;INITIALIZE INDEX

COUTD2:	MOVE C,COUTDB(C)	;GET RELOCATION BITS/CODE
	CAMN SDEL,[XWD 440000,0] ;IF .TEXT, ONLY OUTPUT THE RELOCATION
	TRZN C,1		;WORD IF HAS DATA OR NEEDED FOR NULL STR TERMINATOR
	CALL OUTBIN		;DUMP IT
	AOS C,COUTY		;INCREMENT INDEX
	CAMGE C,COUTX		;TEST FOR END
	JRST COUTD2		;NO, GET NEXT WORD

COUTI:	SETOM COUTX		;INITIALIZE BUFFER INDEX
	SETZM COUTRB		;ZERO RELOCATION BITS
   IFN POLISH,<
	HRRZ C,BLKTYP		;IF WE ARE OUTPUTING
	CAIN C,11		;POLISH BLOCK TYPE 11
	SKIPA C,[POINT 1,COUTRB] ; USE HALF WORDS
   >
	MOVE C,[POINT 2,COUTRB]
	MOVEM C,COUTP		;INITIALIZE BIT POINTER
	RET			;EXIT
STOWZ1:
   IFN FORMSW,< MOVE AC1,HWFORM> ;USE STANDARD FORM
STOWZ:	MOVEI RC,0
STOW:
   IFN FORMSW,< MOVEM AC1,FORM>	;STORE FORM WORD
   IFN TSTCD,<
	SKIPE TCDFLG		;TESTING NEW LINK CODES?
	JRST STOWTC		;YES.
   >
	JUMP1 STOW20		;SKIP TEST IF PASS ONE
   IFN POLISH,<
	JUMPL RC,STOW20		;[624] JUMP IF POLISH
   >
	TRNE RC,-2		;RIGHT HALF ZERO OR 1?
	CALL STOWT		;NO, HANDLE EXTERNAL
	TLNN RC,-2		;LEFT HALF ZERO OR 1? WFW
	JRST STOW10		;YES, SKIP TEST
	MOVSS RC		;SWAP HALVES
	CALL STOWT1		;HANDLE EXTERNAL WFW
	MOVSS RC		;RESTORE VALUES

STOW10:	SKIPE EXTPNT		;ANY EXTERNALS REMAINING?
	TRO ER,ERRE		;YES, SET EXTERNAL ERROR FLAG

STOW20:	SKIPN INOPDF		;[1035] OPDEF OR ASSIGN?
	SKIPE INASGN		;[1035]
	JRST [MOVE AC1,STPX	;[1035] YES, STOW FIRST WORD ONLY
		SUB AC1,STPY	;[1035]
		JUMPLE AC1,.+1	;[1035] KEEP FIRST
		RET]		;[1035] IGNORE REST
	AOS AC1,STPX		;[667][661] OTHERWISE INCREMENT POINTER
	MOVEM AC0,STCODE(AC1)	;STOW CODE
   IFN POLISH,<
	TRNN FRR,PIDXSW		;[1073] DOING POLISH INDEXING OR
	SKIPE INANGL		;[751] STILL IN EXP EVALUATION?
	JRST STOW23		;[751] YES, NOT FINAL STOW, SO JUMP
	TLNE RC,-1		;[614] ONLY IF LH(RC)=0
	JRST STOW2R		;[614] OTHERWISE, JUMP
	TRZE FRR,LHPSW		;[614] CHECK FOR LEFT HALF FIXUP
	HRLI RC,-2		;[614] STORE -2 FOR RELOC
STOW2R:	TRNE RC,-1		;[614] ONLY IF RH(RC)=0
	JRST STOW2F		;[614] OTHERWISE, JUMP
	TRZE FRR,RHPSW		;[614] CHECK FOR RIGHT HALF FIXUP
	HRRI RC,-2		;[614] STORE -2 FOR RELOC
STOW2F:	JUMPN RC,STOW23		;[614] RC=0? , JUMP IF NOT
	TRZN FRR,FWPSW		;[614] FULL WORD FIXUP?
	JRST STOW23		;[614] NO, FINISH CHECKING
	HRRZI RC,-2		;[614] -2 FOR RELOCATION
	SETZM STFORM(AC1)	;[614]
	AOS STFORM(AC1)		;[614]
	MOVEM RC,STOWRC(AC1)	;[614]
	SETZ RC,		;[614]
	JRST STOW22		;[614]
   >

STOW23:	MOVEM RC,STOWRC(AC1)	;[614] STOW RELOCATION BITS
   IFN FORMSW,<
	PUSH P,FORM
	POP P,STFORM(AC1)	;STORE FORM WORD
   >
STOW22:	SKIPN LITLVL		;[614] ARE WE IN LITERAL?
	JRST [AOS LOCA		;NO, INCREMENT ASSEMBLY LOCATION
		SETOM BNSN	;AND FLAG CODE STORED
		JRST .+1]	;[555]
	CAIGE AC1,.STP-1	;OVERFLOW?
	RET			;NO, EXIT

	SKIPN LITLVL		;[726] ARE WE IN A LITERAL?
	JRST CHARL1		;NO, SAVE REGISTERS AND DUMP THE BUFFER
	PUSH P,['MCRLTL']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT / LITERAL TOO LONG@/] ;[1066][726] YES, ERROR
	CALL ERRNE4		;[726] DON'T DUMP THE BUFFER
	JRST STOWI		;INITIALIZE BUFFER
;GET ONE WORD FROM CODE BUFFER
DSTOW:	AOS AC1,STPY		;INCREMENT POINTER
	MOVE AC0,STCODE(AC1)	;FETCH CODE
	MOVE RC,STOWRC(AC1)	;FETCH RELOCATION BITS
   IFN FORMSW,<
	PUSH P,STFORM(AC1)
	POP P,FORM		;GET FORM WORD
   >
	CAMGE AC1,STPX		;IS THIS THE END?
	RET			;NO, EXIT

STOWI:	SETOM STPX		;INITIALIZE FOR INPUT
	SETOM STPY		;INITIALIZE FOR OUTPUT
	SETZM EXTPNT
	RET			;EXIT

;EXTERNAL RIGHT
STOWT:	HRRZ AC1,EXTPNT		;GET RIGHT POINTER
	CAIE AC1,(RC)		;DOES IT MATCH 
	CALL QEXT		;EXTERNAL OR RELOCATION ERROR
	HLLZS EXTPNT
	RET			;EXIT

;EXTERNAL LEFT
STOWT1:	HLRZ AC1,EXTPNT		;GET LEFT HALF
	CAIE AC1,(RC)		;SEE ABOVE
	CALL QEXT
	HRRZS EXTPNT
	RET			;EXIT

   IFN TSTCD,<
STOWTC:
	SKIPE RC		;RELOCATABLE OR EXTERNAL?
	CALL QEXT		;YES, FLAG ERROR
	JUMP1 CPOPJ		;IF PASS 1, RETURN
	MOVE C,AC0		;GET VALUE
	JRST OUTBIN		;DEPOSIT INTO REL FILE AND RETURN
   >
ONC:	ILDB C,TABP		;ENTRY TO ADVANCE TAB POINTER
   IFN FTPSECT,<		;[647]
	SKIPE SGNMAX		;[647] DOING PSECTS?
	JRST [	MOVEI C," "	;[647] YES, 2 SPACES INSTEAD OF A TAB
		CALL OUTC	;[647]
		CALL OUTC	;[647]
		JRST ONC1]	;[647]
   >
	CALL OUTL		;OUTPUT A TAB
				;OUTPUT 6 OCT NUMBERS FROM CS LEFT
ONC1:	MOVEI C,6		;CONVERT TO ASCII
	LSHC C,3		;SHIFT IN OCTAL
	CALL OUTL		;OUTPUT ASCII FROM C
	TRNE CS,-1		;ARE WE THROUGH?
	JRST ONC1		;NO, GET ANOTHER
	MOVEI C,0		;CLEAR C
	TLNN CS,1		;RELOCATABLE?
	MOVEI C,"'"		;YES
	TLNN CS,EXTF		;OR EXTERNAL
	MOVEI C,"*"		;YES
   IFN POLISH,<
	TLNN CS,4		;[614] POLISH?
	MOVEI C,"#"		;[614] YES
   >
ONC2:	JUMPN C,OUTC		;OUTPUT IF EXTERN OR RELOCATABLE
   IFN FORMSW,< SOS FLDSIZ>	;DECREMENT FIELD SIZE
	RET			;EXIT

DNC:	IDIVI C,^D10
	HRLM CS,0(P)
	JUMPE C,.+2
	CALL DNC		;RECURSE IF NON-ZERO
	HLRZ C,0(P)
	ADDI C,"0"		;FORM ASCII
	JRST PRINT		;DUMP AND TEST FOR END

;OCTAL OUTPUT FROM C
OUTOCT:	IDIVI C,^D8
	HRLM CS,0(P)
	SKIPE C
	CALL OUTOCT		;RECURSE UNTIL QUOTIENT 0
	HLRZ C,0(P)
	ADDI C,"0"		;CONVERT TO ASCII
	JRST PRINT

OUTAS0:	HRLI CS,(POINT 7,,)	;ENTRY TO SET POINTER
OUTASC:	ILDB C,CS		;GET NEXT BYTE
	JUMPE C,CPOPJ		;[664] EXIT ON ZERO DELIMITER
	CALL PRINT
	JRST OUTASC

OUTSIX:	HRLI CS,(POINT 6,,)	;OUTPUT SIXBIT
	ILDB C,CS		;GET SIXBIT
	CAIN C,40		;"@" DELIMITER?
	RET			;YES, EXIT
	ADDI C,40		;NO, FORM ASCII
	CALL OUTL		;OUTPUT ASCII CHAR FROM C
	JRST OUTSIX+1

OUTSYM:	MOVE CS,AC0		;PLACE NAME IN CS
OUTSY1:	MOVEI C,0		;CLEAR C
	LSHC C,6		;MOVE NEXT SIXBIT CHARACTER IN
	JUMPE C,CPOPJ		;TEST FOR END
	ADDI C,40		;CONVERT TO ASCII
	CALL OUTL		;OUTPUT
	JRST OUTSY1		;LOOP
OUTSET:	AOS SX,0(P)		;GET RETURN LOCATION
	MOVE SX,-1(SX)		;GET XWD CODE
	HLRM SX,BLKTYP		;SET BLOCK TYPE
	SETZB ARG,RC
	CALL 0(SX)		;GO TO PRESCRIBED ROUTINE
	JRST COUTD		;TERMINATE BLOCK AND EXIT

	;LOOKUP SCANS ALL THE SYMBOLS IN THE SYMBOL TABLE
LOOKUP:	POP P,LOOKX		;INTERCEPT RETURN POP
	MOVE SX,SYMBOL
	PUSH P,0(SX)		;SET FOR TABLE SCAN
LOOKL:	SOSGE 0(P)		;TEST FOR END
	JRST [POP P,AC0		;DONE, EXIT
		RET]		;[575]
	ADDI SX,2
	MOVE AC0,-1(SX)
	CALL SRCH7		;LOAD REGISTERS
	HLRZS ARG
	CALL @LOOKX		;RETURN TO CALLING ROUTINE
	JRST LOOKL		;TRY AGAIN

   IFE FTPSECT,<SYN LOOKUP,SGLKUP>	;[575]
   IFN FTPSECT,<		;[575]
SGLKUP:	POP P,LOOKX		;INTERCEPT RETURN POP
	MOVE SX,SGNCUR		;GET CUR PSECT INX
	PUSH P,SGSCNT(SX)	;SAVE SYM CNT
	HRRZS 0(P)		;DON'T WANT LEFT HALF
	MOVE SX,SGSBOT		;GET INIT SYM TAB PTR
	JRST LOOKL		;REST IS SAME AS FOR FULL CASE
   >
SUBTTL END ROUTINES

END0:
   IFN FTPSECT,<		;[575]
	SKIPE SGLITL		;[1074] ANY LITERALS UNTERMINATED IN ANY PSECT?
	RET			;[1074] YES - ILLEGAL IN ANY LITERAL
	HRROS SGNCUR		;FORCE EVALUATION IN ITS OWN PSECT
   >
	CALL EVALCM		;GET A WORD
   IFN FTPSECT,<		;[575]
	HRRZS SGNCUR		;BACK TO NORMAL
   >
	SKIPN V,AC0		;NON-ZERO?
	JUMPE RC,.+2		;OR RELOC?
	CALL ASSIG7		;YES, LIST THE VALUE
	SETZM VECSYM		;IN CASE NOT SYMBOLIC
	SKIPN EXTPNT		;EXTERNAL?
	JRST END00		;NO
	CAME RC,EXTPNT		;MAKE SURE SAME
	JRST [SETZB AC0,VECSYM	;NO, CLEAR
		TRO ER,ERRE	;FLAG ERROR
		JRST .+3]
	MOVE RC,1(RC)		;GET SIXBIT NAME
	MOVEM RC,VECSYM		;STORE SYMBOL NAME
	SETZB RC,EXTPNT		;AND CLEAR RELOC
END00:	MOVEM AC0,VECTOR
	MOVEM RC,VECREL
   IFN FTPSECT,<		;[575]
	MOVE AC1,SGWFND		;GET START ADR PSECT INX
	MOVEM AC1,VECFND	;SAVE IT
   >
	SKIPN LITNUM		;LITERALS TO FOLLOW?
	CALL VARP		;NO, DO EARLY CHECK FOR VAR AREA
	SETOM ENDSN		;FLAG BEEN HERE AND
	CALL STOUTS		;DUMP THE LINE
END01:	TLZ IO,IOPROG		;[754] SHOULDN'T BE XLISTED AND
	SETZ MRP,		;SHOULDN'T BE IN A MACRO BY NOW
	MOVE MP,SAVERP		;[1120] GET SAVED MACRO CALL PTR.
	MOVEM MP,RP		;[1120] RESET RP
	MOVE MP,SAVEMP		;[1120] RESET REPEAT PTR. ALSO
   IFN FTPSECT,<		;[575]
	MOVE AC1,SGNMAX		;GET HIGHEST PSECT USED
	PUSH P,AC1		;SAVE IT
	CAME AC1,SGNCUR		;[715] IF NOT CURRENT
END02:	CALL %SWSEG		;[715] SWAP IT
   >
	SKIPE ENDSN		;HAVE WE CHECKED VAR AREA
	SKIPE LITNUM		;PHASE ERRORS?
	CALL VARP		;NO, DO SO
	CALL VARA		;FILL OUT SELF-DEFINED VARIABLES
	SETZM ENDSN		;RESET ENDSN
   IFE IIISW,<PUSH P,IO		;SAVE FLAGS
	TLO IO,IOPROG>		;XLIST LITS
	CALL LIT1		;RETURN VALUE IN AC2
   IFE IIISW,<POP P,IO>		;GET FLAG BACK
   IFN FTPSECT,<		;[575]
	SOSL AC1,0(P)		;DONE YET?
	JRST END02		;NO
	POP P,AC1		;GET JUNK OFF STACK
   >
	JUMP2 ENDP2

	MOVE HHIGH		;GET HIGH SEG BREAK
	MOVEM HIGH1		;SAVE FOR TWOSEG/HISEG BLOCK TYPE 3
	CALL UOUT		;[1042]
	TLNN IO,MFLSW		;SKIP IF ONLY PSEND
	CALL REC2
	MOVE INDIR		;SET UP FIRST AS LAST
	MOVEM LSTFIL		;PRINTED
	SETZM LSTPGN
	CALL INZ1
	SKIPN TTLFND		;[1123] HAVE WE SEEN A TITLE YET?
	CALL PRNAM		;[1123] NO - PRINT DEFAULT TITLE
	SETZM TTLFND		;[1123] CLEAR TITLE SPECIFIED FLAG
	TLNE IO,MFLSW		;IF PSEND
	RET			;BACK TO PSEND0
	SKIPE PRGPTR		;HAVE ANY PRGEND'S BEEN SEEN
	CALL PSEND3		;YES,GO SET UP AGAIN

PASS20:	SETZM CTLSAV
	CALL COUTI
	CALL EOUT		;OUTPUT THE ENTRIES
	CALL OUTSET
	XWD 6,NOUT		;OUTPUT THE NAME (BLKTYP-6)
	SKIPN HISNSW		;PUT OUT BLOCK TYPE 3?
	JRST PASS21		;NO
	CALL OUTSET
	XWD 3,HSOUT		;OUTPUT THE HISEG BLOCK
PASS21:
   IFN FTPSECT,<
	SETZM SGNCUR		;[1020]
	SKIPN SGNMAX		;[1020] DOING PSECTS
	JRST PASS22		;[1020] NO, JUMP
PASS23:	SETOM BLK24		;[1020] GENERATE A SET OF BLOCK 24'S
	AOS SX,SGNCUR		;[1020] SKIP BLANK PSECT
	CALL SGOUTN		;[1020]
	CAMGE SX,SGNMAX		;[1020] FINISHED?
	JRST PASS23		;[1020] NO, LOOP
	SETZM SGNCUR		;[1020] RESET PSECT TO 0
PASS22:
   >
	MOVEI 1
	HRRM BLKTYP		;SET FOR TYPE 1 BLOCK
	TLZ FR,P1		;SET FOR PASS 2 AND TURN OFF FLAG
	TLO IO,IOPALL		;PUT THESE BACK
	TLZ IO,IOPROG!IOCREF!DEFCRS!IONCRF ; SO LISTINGS WILL BE THE WAY THEY SHOULD
	TLNN FR,R1BSW
	JRST STOWI
	MOVE CS,[XWD $ST-1-$CKSM,R1BLDR]
	MOVE C,0(CS)
	CALL PTPBIN
	AOBJN CS,.-2
	CALL R1BI
	JRST STOWI
ENDP2:	CALL COUTD		;DUMP THE BUFFER
	MOVE AC0,LOCO		;CHECK TO SEE IF LIT DIFFERED
	SKIPN MODO		;AND USE SMALLER SINCE AT END
	JRST [CAMN AC0,ABSHI
		HRRZM AC2,ABSHI
		JRST ENDP2W]
	SKIPE HHIGH		;SKIP IF NOT TWO SEGMENTS
	JRST [CAMN AC0,HHIGH
		HRRZM AC2,HHIGH
		JRST ENDP2W]
ENDP2W:
   IFE FTPSECT,<		;[575]
	CAMN AC0,HIGH
	HRRZM AC2,HIGH
   >
   IFN FTPSECT,<		;[575]
	MOVE AC1,SGNCUR
	CAMN AC0,HIGH
	HRRM AC2,SGATTR(AC1)
   >
REPEAT 1,<TLNE IO,IOCREF>	;CLOSE CREF IF NECESSARY
REPEAT 0,<TLNE FR,CREFSW	;IF CREFFING
	JRST ENDP2Q
	MOVEI SDEL,0
	PUSH P,DBUF+3		;SO NO PAGE INFO
	DPB SDEL,[POINT 7,DBUF+3,13]
	IOR ER,OUTSW		;MAKE SURE OF OUTPUT
	CALL CREF
	MOVEI C,20		;CODE FOR TITLE
	CALL OUTLST
	PUSH P,IO		;SAVE THIS
	TLZ IO,IOPAGE		;AND PREVENT PAGE DURING TITLE
	MOVEI CS,TBUF
	CALL OUTAS0
	MOVEI CS,VBUF
	CALL OUTAS0
	POP P,IO		;RESTORE THE IO WORD
	POP P,DBUF+3>		;NEEDS FIX TO CREF
	CALL CLSCR2		;CLOSE IT UP
ENDP2Q:	HRR ER,OUTSW		;[1042] SET OUTPUT SWITCH
	SKIPN TYPERR		;[1042]
	TRO ER,TTYSW		;[1042]
	CALL UOUT		;[1042] OUTPUT UNDEFINEDS
	TRO ER,TTYSW
	MOVE C,CTOBUF+2		;SKIP OUTPUT IF BUFFER EMPTY
	CAIE C,120		;[565]
	OUTPUT CTL,		;CLEAR JUNK OUT OF BUFFER
	SKPINC C		;SEE IF WE CAN INPUT A CHAR.
	  JFCL			;BUT ONLY TO DEFEAT ^O
	SKIPG C,QERRS		;ANY Q ERRORS SEEN?
	JRST ENDPER		;NO, TRY REAL ERRORS
	CALL OUTCR		;NEW LINE
	MOVEI C,"%"		;WARNING CHARACTER
	CALL OUTL
	MOVE C,QERRS		;GET COUNT
	CAIN C,1		;1 IS SPECIAL
	JRST ONERQ
	CALL DNC		;OUTPUT IT
	SKIPA CS,[EXP ERRMQ2]
ONERQ:	MOVEI CS,ERRMQ1
	CALL OUTSIX
ENDPER:	MOVE C,ERRCNT		;GET ERROR COUNT
	CAMGE C,UNDCNT		;.GE. UNDEFINED SYMBOL COUNT?
	MOVE C,UNDCNT		;USE UND SYMBOL COUNT INSTEAD
	JUMPE C,NOERW		;ZERO COUNT, PRINT NO ERR MSG
   IFN CCLSW,<ADDM C,.JBERR>	;REMEMBER ERROR COUNT FOR EXECUTION DELETION
	PUSH P,C		;STORE ERROR COUNT FOR A WHILE
	CALL OUTCR
	MOVEI C,"?"		;? FOR BATCH
	CALL OUTL		;...
	POP P,C			;RESTORE ERROR COUNT FROM STACK
	CAIN C,1		;1 IS A SPECIAL CASE
	JRST  ONERW		;PRINT MESSAGE
	CALL DNC
	SKIPA CS,[EXP ERRMS1]	;LOAD TO PRINT
ONERW:	MOVEI CS,ERRMS2		;ONE ERROR DETECTED
ONERW1:	CALL OUTSIX		;PRINT
	JRST ENDP2A

NOERW:	SKIPE QERRS		;IF "Q" ERRORS
	CALL OUTCR		;CLOSE LINE NOW
	MOVEI CS,ERRMS3
   IFN CCLSW,<			;[1141]
	TLNE IO,CRPGSW		;[1141] IF RPG
	TRZ ER,TTYSW		;[1141]  NO TTY OUTPUT
   >				;[1141]
	IOR ER,OUTSW		;UNLESS NEEDED FOR LISTING
	SKIPN QERRS		;ALREADY DONE
	CALL OUTCR
	JRST ONERW1
ENDP2A:	CALL OUTCR
   IFN CCLSW,<			;[1141]
	TLNE IO,CRPGSW		;[1141] ONLY IF RPG
	JRST [	MOVE C,QERRS	;[1141] TOTAL UP
		ADD C,ERRCNT	;[1141]  ANY ERRORS THAT
		ADD C,UNDCNT	;[1141]  WERE FOUND
		JUMPE C,ENDP2D	;[1141] IF NONE - SUPPRESS PROGRAM NAME
		JRST .+1]	;[1141] ELSE OK TO TYPE IT
   >				;[1141]
	SKIPE PGENDF		;[1141] HAVE WE SEEN ANY PRGENDS?
	JRST [	MOVE C,OUTSW	;[1141] YES - GET OUTPUT SWITCHS
		CAIN C,TTYSW	;[1141] LISTING GOING TO TTY?
		JRST .+1	;[1141] YES - NO NEED TO PRINT PROGRAM NAME
		PUSH P,OUTSW	;[1141] SAVE OUTPUT SWITCHS
		PUSH P,ER	;[1141] AND CURRENT OUTPUT SETTING
		HRRI ER,TTYSW	;[1141] OUTPUT TO TTY ONLY
		HRRM ER,OUTSW	;[1141] IN ALL CASES
		MOVEI CS,[ASCIZ /PROGRAM /]	;[1141]
		CALL OUTAS0	;[1141] TYPE PREFIX
		MOVEI CS,TBUF	;[1141] TITLE BUFFER
		CALL OUTAS0	;[1141] TYPE IT
		CALL OUTCR	;[1141] END LINE
		POP P,ER	;[1141] RESTORE ERROR AND OUTPUT SETTINGS
		POP P,OUTSW	;[1141] RESTORE OUTPUT SWITCHS
		JRST .+1]	;[1141]
ENDP2D:
   IFN CCLSW,<TLNE IO,CRPGSW	;IF RPG, DON'T PRINT PGM BREAK
	TRZ ER,TTYSW>		;...
   IFE CCLSW,< SKIPA>		;SO PRGEND CODE CAN WORK
	IOR ER,OUTSW		;...
	CALL OUTCR
	MOVEI CS,[SIXBIT /HI-SEG. BREAK IS @/]
	SKIPN HHIGH		;DON'T PRINT IF ZERO
	JRST ENDP2C		;IT WAS
	CALL OUTSIX
	HRLO CS,HHIGH		;GET THE BREAK
	CALL ONC1
	CALL OUTCR
ENDP2C:	MOVEI CS,[SIXBIT /PROGRAM BREAK IS @/]
	CALL OUTSIX		;OUTPUT PROGRAM BREAK
	HRLO CS,SGATTR		;GET PROGRAM BREAK
	CALL ONC1
	CALL OUTCR
   IFN FTPSEC,<
	SKIPN AC1,SGNMAX	;GET PSECT CNT
	JRST ENDP2E		;PSECTS NOT USED?
	MOVEI AC2,1
ENDP2F:	MOVEI CS,[SIXBIT /PSECT @/] ;[647]
	CALL OUTSIX		;OUTPUT PSECT BREAK
	MOVE C,AC2		;[647] GET PSECT INDEX
	CALL OUTOCT		;[647] OUTPUT IT
	MOVEI CS,[SIXBIT / BREAK IS @/] ;[647]
	CALL OUTSIX		;[647]
	HRLO CS,SGATTR(AC2)	;GET PSECT BRK
	CALL ONC1
	MOVE CS,[SIXBIT / FOR  /]
	MOVEM CS,SGLIST
	MOVE CS,SGNAME(AC2)	;GET PSECT NAME
	MOVEM CS,SGLIST+1
	MOVSI CS,SIXBIT/   @  /
	MOVEM CS,SGLIST+2
	MOVEI CS,SGLIST
	CALL OUTSIX
	CALL OUTCR
	AOS AC2
	SOJG AC1,ENDP2F		;LOOP THRU PSECT.S
ENDP2E:>
	HRRZ CS,ABSHI		;GET ABS. BREAK
	CAIG CS,140		;ANY ABS. CODE
	JRST ENDP2B		;NO, SO DON'T PRINT
	MOVEI CS,[SIXBIT /ABSOLUTE BREAK IS @/]
	CALL OUTSIX
	HRLO CS,ABSHI
	CALL ONC1
	CALL OUTCR
ENDP2B:	MOVEI CS,[SIXBIT /CPU TIME USED @/]
	CALL OUTSIX		;PRINT THE TIME IT TOOK TO ASSEMBLE
	SETZ C,			;SO AS TO GET THE RIGHT TIME
	RUNTIM C,		;GET THE TIME NOW
	SUB C,RTIME		;MINUS TIME WHEN STARTED
	IDIVI C,^D1000		;GET MS.
	PUSH P,C+1		;SAVE
	IDIVI C,^D60		;GET SEC. IN C+1, MIN. IN C
	PUSH P,C+1		;SAVE SECONDS
	IDIVI C,^D60		;GET HOURS IN C, MINS. IN C+1
	PUSH P,C+1		;SAVE MINS
	JUMPE C,NOHOUR		;SKIP IF LESS THAN 1 HOUR
	CALL DNC		;PRINT HOURS
	MOVEI C,":"		;SEPARATOR
	CALL OUTC
NOHOUR:	POP P,CS		;GET MINS
	CALL DECPT2		;PRINT THEM
	MOVEI C,":"
	CALL OUTC
	POP P,CS		;A LITTLE DIFFERENT FOR MS
	CALL DECPT2		;PRINT SECONDS
	MOVEI C,"."		;A POINT FOR MS.
	CALL OUTC
	POP P,CS		;GET MS.
	CALL DECPT3		;PRINT MS.
	CALL OUTCR		;AND A CRLF
	TLNE FR,RIMSW!R1BSW	;RIM MODE?
	CALL RIMFIN		;YES, FINISH IT
   IFN CCLSW,<TLNN IO,CRPGSW> ;[1141] IF NOT IN CCL MODE
	TRO ER,TTYSW		;PRINT SIZE
	CALL OUTCR
	MOVE C,CPUV		;[775] GET CPU VALUE
	CAIGE C,3		;[775] KI-10 = 3
	JRST [	MOVE C,.JBREL	;[775]
		LSH C,-^D10	;[775]
		ADDI C,1	;[775]
		CALL DNC	;[775]
		MOVEI CS,[SIXBIT /K CORE USED@/] ;[775]
		JRST CORSIZ]	;[775]
	MOVE C,.JBREL
	LSH C,-^D9		;[615]
	ADDI C,1
	CALL DNC
	MOVEI CS,[SIXBIT /P CORE USED@/] ;[615]
CORSIZ:	CALL OUTSIX		;[775]
	CALL OUTCR
	HRR ER,OUTSW
   IFN FTPSECT,<		;[575]
	SETZM SGNCUR		;SET TO BLANK PSECT
	SKIPN SGNMAX		;WERE PSECTS USED?
	JRST ENDP2H		;NO
ENDP23:	CALL SGOUTL		;[631] OUTPUT A SET OF BLOCK 23'S FIRST
	AOS SX,SGNCUR		;[631] NEXT ONE
	CAMG SX,SGNMAX		;[631] ALL DONE?
	JRST ENDP23		;[631] NO, LOOP
	SETZM SGNCUR		;[631] YES, RESET TO BLANK PSECT
ENDP2G:	CALL SRCHI		;SET UP SRCHX,SGSBOT,SGSTOP
	CALL SGOUTN		;[762] BLOCK-24 BEFORE ITS SYMBOLS
ENDP2H:
   >
	CALL OUTSET		;[735] BLOCK-10 FOR EACH PSECT
	XWD 10,LSOUT		;[735] OUTPUT THE LOCALS (..-10)
	CALL OUTSET
	XWD 2,SOUT		;OUTPUT THE SYMBOLS (BLKTYP-2)
   IFN FTPSECT,<		;[575]
	AOS SX,SGNCUR		;INCR PSECT INX
	CAMG SX,SGNMAX		;LAST PSECT DONE?
	JRST ENDP2G		;NO, DO NEXT PSECT
	SETZM SGNCUR		;SET TO BLANK PSECT
>				;[575]
   IFN POLISH,<			;[575]
	CALL OUTSET
	XWD 11,POUT		;OUTPUT THE POLISH (..-11)
	MOVSI SX,(POINT 2)	;RESET BYTE COUNT
	HLLM SX,COUTP		;AFTER END OF POLISH
   >
	CALL OUTSET
	XWD 7,VOUT		;OUTPUT TRANSFER VECTOR (..-7)
	CALL OUTSET
	XWD 5,HOUT		;OUTPUT HIGHEST RELOCATABLE (..-5)
	CALL COUTD
	TLNN IO,MFLSW		;IS IT PRGEND?
	JRST FINIS		;ALAS, FINISHED
	MOVEI CS,SBUF		;RESET SBUF POINTER
	HRRM CS,SUBTTX		;TO SUBTTL
	SETZM PASS2I		;CLEAR PASS2 VARIABLES
	MOVE [XWD PASS2I,PASS2I+1]
	PUSH P,PAGENO		;SAVE PAGE NUMBER IN CASE PRGEND
	BLT PASS2Z-1		;BUT NOT ALL OF VARIABLES
	POP P,PAGENO		;RESTORE IT
	MOVE CS,SPAGN.		;RESTORE PAGE OFFSET
	MOVEM CS,PAGEN.		;[562]
;	JRST INZ		;RE-INITIALIZE FOR NEXT PROG
				;FALL THROUGH
SUBTTL PASS INITIALIZE

INZ:	SETZ C,			;GET CURRENT JOB NUMBER
	RUNTIM C,		;GET RUNTIME FOR LATER
	MOVEM C,RTIME		;SAVE
INZ1:	MOVEI AC1,1		;[1130] RELOCATABLE MODE IS 1
	MOVEM AC1,MODA		;[1130] RESET ADDRESS MODE
	MOVEM AC1,MODO		;[1130] AND OUTPUT MODE
   IFN FTPSECT,<		;[575]
	TLNE IO,MFLSW		;[1151] IF RESETTING FOR PRGEND
	JUMP2 INZ3		;[1151]  DURING PASS2 - SKIP PSECT INIT
	MOVE AC1,SGNMAX
	MOVSI AC0,1
	MOVEM AC0,SGRELC(AC1)
	SOJGE AC1,.-1
	MOVE AC1,SGNMAX		;GET HIGHEST PSECT USED
	PUSH P,AC1		;SAVE IT
INZ2:	CAME AC1,SGNCUR		;IF NOT CURRENT
	CALL %SWSEG		;SWAP IT
   >
	MOVEI VARHD
	MOVEM VARHDX
	MOVEI LITHD
	MOVEM LITHDX
	CALL LITI
   IFN FTPSECT,<		;[575]
	SOSL AC1,0(P)		;DONE YET?
	JRST INZ2		;NO
	POP P,AC1		;GET JUNK OFF STACK
INZ3:				;[1151]
   >
	MOVEI AC1,RELLOC	;[716] RESET POINTER
	MOVEM AC1,REL1P+1	;[716]
	SETZM SEQNO
	PUSH P,[^D8]		;[613] INIT TO DEFAULT RADIX
	POP P,CURADX		;[613]
	CALL STOWI
   IFN FORMSW,<
	SETZM IOSEEN		;[717] CLEAR IO FORMAT SWITCH
	HRRES HWFMT>		;SET DEFAULT VALUE BACK
	CALL OUTLI		;[774] INIT NEW LINE
	SETZM LBLFLG		;[1074] CLEAR LABEL-IN-LITERAL FLAG
	SETZM TAGINC		;[774] REINIT TAG OFFSET
	RET			;[774]
; ROUTINE TO PRINT CPU TIME USED
DECPT3:	MOVEI C,"0"		;FILL WITH ZERO
	CAIG CS,^D99		;3 DIGITS?
	CALL OUTC		;NO
DECPT2:	MOVEI C,"0"		;FILL WITH ZERO
	CAIG CS,^D9		;2 DIGITS?
	CALL OUTC		;NO
	MOVE C,CS		;GET VALUE
	PJRST DNC		;OUTPUT IN DECIMAL AND RETURN

RIMFIN:	TLNE FR,R1BSW
	CALL R1BDMP
	SKIPN C,VECTOR
	MOVSI C,(JRST 4,)
	TLNN C,777000
	TLO C,(JRST)
	CALL PTPBIN
	MOVEI C,0
	JRST PTPBIN
SUBTTL PSEUDO-OP HANDLERS

TAPE0:	CALL STOUTS		;FINISH THIS LINE
	SETZM EOFFLG		;CLEAR END OF FILE FLAG
	CALL PEEK		;LOOK AT NEXT CHARACTER
	CAIE C,VT		;PRINT IF V TAB
	CAIN C,FF		;OR FORM FEED
	CALL STOUTS
	SKIPE EOFFLG		;EOF SEEN DURING PEEKING?
	RET			;YES
	TLZ IO,IORPTC		;NO, CLEAR CHARACTER FROM LOOK-AHEAD
	CALL OUTLI2		;AND FROM LINE BUFFER
	JRST GOTEND		;IGNORE THE REST OF THIS FILE

%NOBIN:	TLZE FR,PNCHSW		;IS REL FILE OPEN?
	CLOSE BIN,40		;YES, GET RID OF IT
	RET

RADIX0:	CALL EVAL10		;EVALUATE RADIX D10
	CAIG AC0,^D10		;IF GREATER THAN 10
	CAIG AC0,1		;OR LESS THAN 2,
ERRAX:	TROA ER,ERRA		;FLAG ERROR AND SKIP
	HRRZM AC0,CURADX	;[613] SET NEW RADIX
	RET

XALL0:	JUMP1 CPOPJ		;[664] IGNORE ON PASS 1
	TLZN IO,IOSALL		;TURN OFF MACRO SUPPRESS ALL
	JRST IOSET		;NOT SALL ON SO NOTHING TO WORRY ABOUT
	CAIE C,EOL		;END OF LINE SEEN?
	JRST IOSET		;[1150] NO
	LDB C,LBUFP		;GET LAST CHARACTER
	CAIN C,CR		;UNDER SPECIAL CIRCUMSTANCES IT GETS REMOVED
	JRST IOSET		;[1150] NO, ALL IS WELL
	SOSG CPL		;ANY ROOM?
	CALL RSW5		;NO, SEE IF ANY EXCESS IN IT
	MOVEI C,CR		;NOW FOR TERMINATOR
	IDPB C,LBUFP		;WILL GET REMOVED LATER

IOSET:	JUMP1 .+2		;[1065] EXIT IN PASS1
	HLLZM AC0,IOFLGS	;[1065] SAVE FLAGS FOR OUTLI5
	RET			;[1065] OUTPUT LINE BEFORE SETTING FLAGS

IOLSET:	JUMP1 CPOPJ		;[664] SPECIAL FOR LALL, TO SEE IF IN MACRO UNDER SALL
	TLNE IO,IOSALL		;SEE IF SALL
	JUMPN MRP,IOLSE1	;AND IN MACRO
IORSET:	TDZ IO,AC0		;NO, SET FLAG
	RET			;AND RETURN

IOLSE1:	SKIPE CRLFSN		;[1065] HAVE WE SEEN A CRLF?
	TLZA IO,IOPALL!IOSALL	;[1065] YES, SET FLAGS AND EXIT
	SETOM IOFLGS		;[1065] WAIT TO SET LALL TILL
	RET			;[1065] LINE IS OUTPUT

BLOCK0:	CALL HIGHQ
   IFN POLISH,< TRO FRR,NOPSW>	;[616] DON'T ALLOW POLISH
	CALL EVALEX		;EVALUATE
   IFN POLISH,< TRZ FRR,NOPSW>	;[616] UNDO NO POLISH SWITCH
	TLNE AC0,-1		;SEE IF VALID ARG TYPE
	JRST ERRAX		;NO, GIVE ERROR
	TRZE RC,-1		;EXTERNAL OR RELOCATABLE?
	CALL QEXT		;YES, DETERMINE TYPE
	ADDM AC0,LOCO		;UPDATE ASSEMBLY LOCATION
BLOCK1:	EXCH AC0,LOCA		;SAVE START OF BLOCK
	ADDM AC0,LOCA		;UPDATE OUTPUT LOCATION
BLOCK2:	HRLOM AC0,LOCBLK
	JUMP2 CPOPJ		;[664]
	TRNE ER,ERRU
	TRO ER,ERRV
	RET
PRNTX0:	CALL BYPASS		;[664] GET FIRST CHAR.
	TLOA IO,IORPTC		;REPEAT IT AND SKIP
PRNTX4:	CALL PRINT		;PRINT THE CHAR.
	TRZ ER,TTYSW!LPTSW	;[723] IN CASE OF LONG LINE
	CALL CHARAC		;GET ASCII CHAR.
	TRO ER,TTYSW		;[723] SET OUTPUT TO TTY
	JUMP2 .+2		;[723] BUT NOT ON PASS2 IF LSTDEV=TTY
	TDOA ER,OUTSW		;[723] SET OUTPUT TO LSTDEV
	ANDCM ER,OUTSW		;[723]
	CAIG C,CR		;IF GREATER THAN CR
	CAIG C,HT		;OR LESS THAN LF
	JRST PRNTX4		;THEN CONTINUE
	CALL OUTCR		;OUTPUT A CRLF
	TRZ ER,TTYSW!LPTSW	;[664] TURN OFF OUTPUT
	RET			;[664] EXIT

REMAR0:	CALL GETCHR		;GET A CHARACTER
REMAR1:	CAIE C,EOL
	JRST REMAR0
	RET			;EXIT

PAGE0:	CALL STOUTS		;PAGE PSEUDO-OP
PAGE1:	TLNE IO,IOCREF		;CURRENTLY DOING CREF?
	TLNE IO,IOPROG		;AND NOT XLISTED?
	JRST PAGE2		;NO
	HRR ER,OUTSW
	CALL CLSCRF
	CALL OUTCR
	HRRI ER,0
PAGE2:	TLO IO,IOPAGE
	RET
LIT0:	CALL BLOCK1
	CALL STOUTS
LIT1:	JUMP2 LIT20
   IFN FTPSECT,<		;[707]
	SKIPN SGNMAX		;[707] DOING PSECTS?
	JRST LIT2		;[707] NO, JUMP
	MOVE V,HIGH		;[707] CHECK PC WITH HIGHEST ADDR
	CAMG V,LOCA		;[707] HIGH IS LARGER?
	JRST LIT2		;[707] NO, JUMP
	MOVEM V,LOCA		;[707] YES, UPDATE PC
	MOVEM V,LOCO		;[707]
LIT2:				;[707]
   >

;ON PASS ONE, WE JUST STEP THE LOCATION COUNTER AND CLEAR
	MOVE AC0,LITCNT
	MOVE SX,LITHDX
	HRLM AC0,0(SX)
	MOVE V,LOCA
	HRL V,MODA
	MOVEM V,-1(SX)
	JRST LIT24

LIT20:	PUSH P,LOCA
	PUSH P,LOCO
	SKIPN LITNUM
	JRST LIT20A
	MOVE SX,LITHDX
	HRRZ AC0,-1(SX)
	CAME AC0,LOCA
	TRO ER,ERRP
LIT20A:	MOVE SX,LITAB
LIT21:	SOSGE LITNUM
	JRST LIT22
   IFN FORMSW,<
	MOVE AC0,-3(SX)
	MOVEM AC0,FORM
   >
	MOVE AC0,-2(SX)		;WFW
	MOVE RC,-1(SX)		;WFW
   IFN POLISH,<
	CAMN RC,[1B0]		;SPECIAL FAKE RELOC?
	SETZ RC,		;YES
   >
	MOVE  SX,(SX)		;WFW POINTER TO THE NEXT LIT
	CALL STOW20		;STOW CODE
	TLNE IO,IOSALL		;[1062] IF IN SALL MACRO, FORGET
	JUMPN MRP,.+3		;[1062] LINE-FEED (SEE OUTL25+2)
	MOVEI C,12		;SET LINE FEED
	IDPB C,LBUFP
	CALL OUTLIN		;OUTPUT THE LINE
	JRST LIT21
LIT22:	HRRZ AC2,LOCO
	POP P,LOCO
	POP P,LOCA
	MOVE SX,LITHDX
	HLRZ AC0,0(SX)
	SUB AC2,LOCO		;COMPUTE LENGTH USED
	CAMGE AC0,AC2		;USE LARGER
	MOVE  AC0,AC2
	ADD AC2,LOCO
LIT24:	ADDM AC0,LOCA
	ADDM AC0,LOCO
	CALL GETTOP
	HRRM SX,LITHDX
LITI:	SETZM LITCNT
	SETZM LITNUM
	MOVEI LITAB
	MOVEM LITABX
	JRST HIGHQ

GETTOP:	HRRZ AC1,SX		;VARHD
	HRRZ SX,0(SX)
	JUMPN SX,CPOPJ		;[664]
   IFE FORMSW,< MOVEI SX,3>	;WFW
   IFN FORMSW,< MOVEI SX,4>	;ICC
	ADDB SX,FREE
	CAML SX,SYMBOL
	CALL XCEED
	SUBI SX,1		;MAKE SX POINT TO LINK
	SETZM 0(SX)		;CLEAR FORWARD LINK
	HRRM SX,0(AC1)		;STORE ADDRESS IN LAST LINK
	RET
VAR0:	CALL BLOCK1		;PRINT LOCATION
	CALL VARP		;CHECK VAR AREA FOR PHASE ERROR
	CALL VARA
	JRST STOUTS

VARP:	JUMP1 CPOPJ		;[664] DO NOT CHECK START ON PASS1
	SKIPN VARCNT		;ANY VARIABLE?
	RET			;NO, RETURN
	MOVE SX,VARHDX
	MOVE AC0,LOCA		;GET LOCATION FOR CHECK
	CAMN AC0,-1(SX)		;SAME START FOR BOTH PASSES?
	RET			;YES,
	CAML AC0,-1(SX)		;NO,BIGGER IN PASS2
	JRST [	TRO ER,ERRP	;GIVE P ERROR
		RET]
	HLRZ AC0,0(SX)		;SMALLER ON PASS2
	JUMPE AC0,CPOPJ		;[664] RETURN IF NO VAR
	MOVE AC0,-1(SX)		;OTHERWISE, ADJUST  LOCA & LOCO
	MOVEM AC0,LOCA		;TO PASS1 VALUES
	MOVEM AC0,LOCO
	RET			;AND RETURN

VARA:	MOVE SX,VARHDX
	MOVE AC0,LOCA		;GET LOCATION FOR CHECK
	MOVEM AC0,-1(SX)	;SAVE START FOR PASS 2
	HLRZ AC0,0(SX)
	ADDM AC0,LOCA
	ADDM AC0,LOCO
	CALL GETTOP
	HRRM SX,VARHDX
	JUMP2 CPOPJ		;[664]
	SETZM VARCNT		;CLEAR VARIABLE COUNTER
   IFN FTPSECT,<		;[715]
	SKIPE SGNMAX		;[715] DOING PSECTS?
	JRST [	CALL SGLKUP	;[715] YES, LOOKUP ONLY CURRENT TABLE
		 TRNN ARG,VARF	;[715] GOT A VARIABLE?
		RET		;[715] NO, EXIT
		JRST VARA2]	;[715] MAYBE, CHECK MORE
   >				;[715]
	CALL LOOKUP		;SET FOR TABLE SCAN
	TRNN ARG,VARF		;GOT A VARIABLE?
	RET			;NO, E EXIT
VARA2:	TRC ARG,LTAGF		;[742] MAKE SURE NOT USED WITH LTAGF
	TRCN ARG,LTAGF		;[742]
	RET			;[742]
	TRC ARG,SIXF		;MAKE SURE VARF IS NOT PART OF SIXF
	TRCN ARG,SIXF
	RET			;IT'S SIXF, SO IGNORE THIS ONE
	AOS VARCNT		;INCREMENT VARIABLE COUNTER
	TRZ ARG,UNDF+VARF	;TURN OFF FLAGS NOW
	MOVSI AC0,1(V)		;NUMBER TO ADD TO
	ADDM AC0,0(AC1)		;UPDATE COUNT
VARA1:	ADDI V,1		;GET LENGTH OF DESIRED BLOCK
	ADDM V,LOCO
	EXCH V,LOCA
	ADDM V,LOCA
	HRL ARG,V		;GET STARTING LOCATION AND UPDAT PCS
	IOR ARG,MODA		;SET TO ASSEMBLY MODE
	MOVSM ARG,0(SX)		;UPDATE 2ND WRD OF SYM TAB ENTRY
	JRST HIGHQ1
IF:	PUSH P,AC0		;SAVE AC0
	PUSH P,IO
   IFN POLISH,< TRO FRR,NOPSW>	;[613] DON'T WANT POLISH HERE
	CALL EVALXQ		;EVALUATE AND TEST EXTERNAL
	POP P,AC1
	JUMP2 .+2		;[743]
	TRZ ER,ERRV		;[743] SUPRESS V-ERROR IF PASS1
	IORI ER,(AC1)		;RESTORE PREVIOUS ERROR FLAGS
	JUMPL AC1,IFPOP
	TLZ IO,FLDSW
IFPOP:	POP P,AC1		;RETRIEVE SKIP INSTRUCTION
IFSET:	TLO IO,IORPTC		;REPEAT CHARACTER
IFXCT:	XCT AC1			;[660] EXECUTE INSTRUCTION
IFXF:	TDZA AC0,AC0		;FALSE
IFXT:	MOVEI AC0,1		;TRUE
IFEXIT:	SETZM EXTPNT		;JUST IN CASE
   IFN POLISH,< TRZ FRR,NOPSW>	;[613] UNDO NO-POLISH SWITCH
   IFN FTPSECT,< TLZ IO,RSASSW>	;[575]
	JUMPAD IFEX1		;[664] BRANCH IF IN ADDRESS FIELD
IFDO:	CALL BYPASS		;[664] GET NEXT NON-BLANK
	CAIN C,EOL		;AT EOL?
	JRST  REPEA1		;YES, USE OLD METHOD
	CAIE C,','		;ARE WE AT THE COMMA?
	CAIN C,'<'		;OR START OF CONDITIONAL?
	CAIA			;YES
	JRST IFDO		;NOT YET AT COMMA OR ANGLE BRKT
	CAIN C,','		;IGNORE THE COMMA
	CALL BYPASS		;[664] AND GET SOMETHING ELSE
	TLO IO,IORPTC		;REPEAT LAST CHAR.
	CAIE C,'<'		;OLD METHOD USED ANGLES
	CAIN C,EOL		;ALSO OLD IF NEW LINE SEEN
	JRST REPEA1		;ASSEMBLE CODE BETWEEN ANGLES
	JUMPLE AC0,REMAR0	;FALSE, TREAT AS COMMENT
	JRST STMNT		;TRUE, ASSEMBLE IT

IFPASS:	HRRI AC0,P1		;MAKE IT TLNX IO,P1
	MOVE AC1,AC0		;PLACE IT IN AC1
	JRST IFSET		;EXECUTE INSTRUCTION
IFB0:	HLLO AC1,AC0		;FORM AND STORE TEST INSTRUCTION
IFB1:	CALL CHARL		;GET FIRST NON-BLANK
	CAIE C," "
	CAIN C,HT
	JRST IFB1		;SKIP BLANKS AND TABS
	CAIG C,CR		;CHECK FOR CARRET AS DELIM.
	CAIGE C,LF
	CAIA
	JRST ERRAX
	FORERR (SX,CND)
	SETOM INCND		;SAVE INFO. FOR PASS 1 ERRORS
	CAIN C,"<"		;LEFT BRACKET?
	SETZB C,RC		;YES, PREPARE FOR OLD FORMAT
	SKIPA SX,C		;SAVE FOR COMPARISON
IFB3:	TRO AC0,1		;SET FLAG
IFB2:	CALL CHARL		;GET ASCII CHARACTER AND LIST
	CAMN C,SX		;TEST FOR DELIMITER
	JRST IFXCT		;FOUND
	CAIE C," "		;BLANK?
	CAIN C,HT		;OR TAB?
	JRST IFB2		;YES
	JUMPN SX,IFB3		;JUMP IF NEW FORMAT
	CAIN C,"<"		;<?
	AOJA RC,IFB2		;YES, INCREMENT COUNT
	CAIN C,">"		;>?
	SOJL RC,IFXCT		;YES, DECREMENT AND EXIT IF DONE
	JRST IFB3		;GET NEXT CHARACTER

IFDEF0:	HRRI AC0,UNDF		;MAKE IT TLNX ARG,UNDF
	PUSH P,AC0		;STACK IT
   IFN FTPSECT,<		;[575]
	HRROS SGNCUR		;DON'T COPY IF FOUND
   >
	CALL GETSYM		;TAKES SKIP RETURN IF SYM NAME IS LEGAL
	  TROA ER,ERRA		;ILLEGAL!
	CALL SEARCH		;ANYTHING IN THE SYMBOL TABLE?
	  JRST [CALL OPTSCH	;NO, HOW ABOUT OP TABLE?
		TLO ARG,UNDF
		JRST IFDEF1]	;[764] FINISH CHECKING
	JUMPG ARG,[CAME AC0,-3(SX) ;[764] IF OPDEF, GO CHECK FOR SYMBOL
		JRST IFDEF1	;[764] NO SYMBOL
		SUBI SX,2	;[764] SYMBOL ALSO
		CALL SRCH5	;[764] SYMBOL PREFERRED, SO POINT TO SYMBOL
		JRST .+1]	;[764]
	TLNE ARG,UNDF		;[764] UNDEFINED SYMBOL?
	CAME AC0,1(SX)		;[764] YES, WAS IT AN OPDEF TOO?
	JRST IFDEF1		;[764] NO, FINISH CHECKING
	ADDI SX,2		;[764] HERE IF BOTH OPDEF AND UNDEFINED SYMBOL
	CALL SRCH5		;[764] IN THIS CASE, OPDEF IS PREFERED
	TLNE ARG,UNDF		;[764] BUT WAS IT UNDEFINED OPDEF?
	CALL [	SUBI SX,2	;[764] UNDEFINED OPDEF & UNDEFINED SYMBOL
		PJRST SRCH5]	;[764] THEN POINT TO UNDEFINED SYMBOL
IFDEF1:				;[664]
   IFN FTPSECT,<		;[575]
	HRRZS SGNCUR		;CLEAR FLAG
   >
	CALL SSRCH3		;EMIT TO CREF ANYWAY
	JRST IFPOP		;POP AND EXECUTE INSTRUCTION
IFIDN0:	HLRZS AC0
	MOVEI V,2*.IFBLK-1
	SETZM IFBLK(V)		;CLEAR COMPARISON BLOCK
	SOJGE V,.-1
	SETZM .TEMP		;CLEAR STORED DELIMETER
	MOVEI RC,IFBLK		;SET FOR FIRST BLOCK
	CALL IFCL		;GET FIRST STRING
	MOVEI RC,IFBLKA
	CALL IFCL		;GET SECOND STRING
	MOVEI V,.IFBLK-1
	MOVE SX,IFBLK(V)	;GET WORD FROM FIRST STRING
	CAMN SX,IFBLKA(V)	;COMPARE WITH SECOND STRING
	SOJGE V,.-2		;EQUAL, TRY NEXT WORD
	JUMPL V,IFEXIT		;DID WE FINISH STRING
	XORI AC0,1		;NO, TOGGLE REQUEST
	JRST IFEXIT		;DO NOT TURN ON IORPTC WFW

IFCL:	CALL CHARAC		;GET AND LIST CHARACTER
	CAIE C," "		;SKIP SPACES
	CAIG C,CR		;ALSO SKIP CR-LF
	CAIGE C,HT		;AND TAB
	JRST .+2		;NOT ONE OF THEM
	JRST IFCL		;SO LONG COMPARISONS WILL WORK
;*** A CROCK SO THAT IFIDN <X>,<X>,<INST.> WILL WORK ***
	CAIE C,","		;IS IT A COMMA?
	JRST .+3		;NO
	SKIPN .TEMP		;YES, WAS PREVIOUS FIELD OLD METHOD?
	JRST IFCL		;YES, IGNORE COMMA AND SPACES
;	***
	CAIN C,"<"		;WAS IT LEFT BRACKET?
	SETO C,			;SIGNAL OLD METHOD, LOOK FOR RIGHT BRACKET
	MOVEM C,.TEMP		;STORE TERMINATOR FOR COMPARISON
	MOVEI SX,5*.IFBLK-1	;LIMIT SEARCH
	HRLI RC,(POINT 7,,)	;SET UP BYTE IN RC
IFCLR:	CALL CHARAC
	SKIPLE .TEMP		;NEW METHOD?
	JRST IFCLR1		;YES, IGNORE ANGLE BRACKET COUNTING
	CAIN C,"<"		;ANOTHER LEFT ANGLE?
	SOS .TEMP		;YES, KEEP COUNT
	CAIN C,">"		;CLOSING ANGLE
	AOSGE .TEMP		;MATCHING COUNT?
IFCLR1:	CAMN C,.TEMP		;TEST FOR DELIMITER
	RET			;EXIT ON RIGHT DELIMITER
	SOJG SX,.+2		;ANY ROOM IN COMPARISON BLOCK?
	TROA ER,ERRA		;NO, FLAG ERROR BUT KEEP ON GOING
	IDPB C,RC		;DEPOSIT BYTE
	JRST IFCLR
IFEX1:	CALL GETCHR		;SEARCH FOR "<"
	CAIN C,EOL		;ERROR IF END OF LINE
	JRST ERRAX
	CAIE C,'<'
	JRST IFEX1
	JUMPE AC0,IFEX2		;TEST FOR 0
	TLO IO,IORPTC		;NO, PROCESS AS CELL
	CALL CELL
   IFN FORMSW,<MOVE AC1,HWFORM>	;USE STANDARD FORM
	SETZM INCND		;NOT ANY MORE
	JRST STOW		;STOW CODE AND EXIT

IFEX2:	CALL GETCHR
	CAIN C,EOL		;EXIT WITH ERROR IF END OF LINE
	JRST ERRAX
	CAIN C,34		;"<"?
	AOJA AC0,IFEX2		;YES, INCREMENT COUNT
	CAIE C,36		;">"?
	JRST IFEX2		;NO, TRY AGAIN
	SOJGE AC0,IFEX2		;YES, TEST FOR MATCH
	CALL BYPASS		;[664] YES, MOVE TO NEXT DELIMITER
	SETZM INCND		;OUT OF CONDITIONAL NOW
	AOJA AC0,STOWZ1		;STOW ZERO
INTER0:	HLLZM AC0,INTENT	;AC0 CONTAINS INTF/ENTF FLAGS
INTER1:	CALL GETSYM		;GET A SYMBOL
	JRST INTER3		;INVALID, SKIP
	JUMP1 INTER2		;[675] IF PASS1 INSERT AS UNDF SYM
	MOVE AC1,INTENT		;[675] GET INTF/ENTF FLAGS
	TLNE AC1,ENTF		;[675] CAN'T "ENTRY" OPDEF
	JRST INTER2		;[675]
	CALL SSRCH		;[675] IN SYMBOL TABLE?
	JRST [CALL MSRCH	;[675] NO, CHECK OPDEF IN CASE NO PASS1
		SKIPA		;[675] ELSE FLAG AS UNDF SYM
		TLNN ARG,OPDF	;[675]
		MOVSI ARG,SYMF!UNDF	;[675]
		JRST INTER4]	;[675]
	TLNN ARG,UNDF		;[675] YES, UNDEFINED?
	JRST INTER4		;[675] NO, ALL IS FINE
	PUSH P,SX		;[675] UHOH, SAVE SX FOR REMOVE
	CALL MSRCH		;[675] IF OPDEF, PHYSICALLY REMOVE UNDF SYM
	JRST INTER5		;[675]
	TLNN ARG,OPDF		;[675]
	JRST INTER5		;[675]
	EXCH SX,(P)		;[675] GET OLD SX, SAVE NEW FOR CONTINUE
	PUSH P,AC0		;[675] SAVE NAME
	CALL REMOVE		;[675] REMOVE UNDF SYM
	POP P,AC0		;[675]
INTER5:	POP P,SX		;[675] RESTORE OPDEF TABLE PTR
INTER4:	CALL SUPSYM		;[675] SEE IF "!" SEEN
	TLNN ARG,UNDF		;ALLOW FORWARD REFERENCE
	JRST [TLNN ARG,SYNF!EXTF	;[1070][733] GIVE ERROR IF ARG IS EXTERN
		JRST .+1	;[733] OR SYN
		MOVE AC1,INTENT	;[733]
		TLNN AC1,ENTF	;[733]
		JRST INTER8	;[1070][733] ERROR
		TRO ER,ERRA	;[733]
		JUMP1 .+1	;[733] IF ENTRY, SET ENTF IN CASE FIXED UP LATER
		TDZ ARG,INTENT	;[733] ON PASS2, TURN OFF ENTF IF ILLEGAL
		JRST INTER6]	;[733] UPDATE SYMTAB
	TDO ARG,INTENT		;[1014] SET APPROPRIATE FLAGS
   IFN FTPSECT,<
INTER6:	SKIPE SGNMAX		;[1014] DOING PSECTS?
	TLNE ARG,UNDF!VARF	;[1024][1014] UNDEFINED?
	JRST [	CALL INSERQ	;[1014] NOT DOING PSECT, OR SYMBOL UNDEFINED
		JRST INTER7]	;[1014] NEXT SYMBOL
	PUSH P,SGNCUR		;[1014] DEFINED AND DOING PSECTS
	MOVE AC1,SGWFND		;[1014] MAKE PSECT OF THE LABEL CURRENT PSECT
	MOVEM AC1,SGNCUR	;[1014] SO, THE SYMBOL WON'T CHANGE PSECT
	CALL INSERQ		;[1024][1014] JUST FOR INSERT/UPDATE
	POP P,SGNCUR		;[1014] RECOVER THE REAL CURRENT PSECT
   >
   IFE FTPSECT,<
INTER6:	CALL INSERQ		;[1014] INSERT/UPDATE
   >
INTER7:	JUMPCM INTER1		;[1014] LOOP BACK
	SETZM EXTPNT		;JUST IN CASE, SO AS NOT TO CONFUSE WORLD
   IFN FTPSECT,<		;[575]
	TLZ IO,RSASSW		;...
   >
	RET			;NO, EXIT

INTER2:	CALL SSRCH		;[675] SEE IF IN SYM TAB
	MOVSI ARG,SYMF!UNDF!INTF ;[675] ELSE FLAG AS UNDF
	JRST INTER4		;[675]

INTER8:	TLNE ARG,EXTF		;[1070] DEFINED AS EXTERNAL?
	TROA ER,ERRE		;[1070] YES - GIVE E-ERROR INSTEAD
INTER3:	TRO ER,ERRA		;[1014] FLAG ARG EROR AND SKIP
	JRST INTER7		;[1014] GO CHECK FOR NEXT SYMBOL
;.IF/.IFN SYMBOL ATTRIBUTE
NUMF==1B18			;LOCAL FLAG - ATOM IS A NUMBER
OPCF==1B19			;LOCAL FLAG - ATOM IS AN OPCODE
NOTF==1B20			;[621] NOT FOUND IN SYMBOL TABLE

%IF:	TDZA AC0,AC0		;.IF = 0
%IFN:	MOVEI AC0,1		;.IFN = 1
	PUSH P,AC0		;STORE WHICH
	PUSH P,IO		;SAVE CURRENT FLAGS
	TRZ ER,ERRORS		;RESET ERROR FLAGS
	SETOM .IFFLG		;[1056] FLAG "EVALUATING .IF(N) ARG"
	SETZM .IFNUM		;[1056] ZERO APPROPRIATE FLAGS
	SETZM IFSRCH		;[1056]
	SETZM .IFANG		;[1056]
	SETOM .IFNAM		;[1112] ASSUME THIS IS A SIMPLE RADIX50 NAME
	CALL ATOM		;GET THE ATOM TO BE TESTED
	SETZM .IFFLG		;[1056] CLEAR ".IF(N)" FLAG
	MOVE AC1,IO		;GET FLAGS FOR THE ATOM
	POP P,IO		;RESTORE PREVIOUS FLAGS
	TLNE AC1,IORPTC		;[1056] ALLOW .IF<EXP>,...
	TLO IO,IORPTC		;[1056]
	JUMPNC IFERRA		;MAKE SURE TERMINATOR WAS A COMMA
	TLNE AC1,NUMSW		;WAS IT A NUMBER?
	JRST %IF2		;[1056] DO NUMERIC CHECKS
	CALL SEARCH		;GENERAL SEARCH
	  JRST [CALL OPTSCH	;NOT SYMBOL, SEE IF OPCODE
		 SKIPA ARG,[UNDF+NOTF] ;[621] NOT OPCODE, ATOM UNDEFINED
		MOVE ARG,[SYMF,,OPCF] ;OPCODE, IS ALSO SYMBOL
		JRST %IF1]	;GO GET TYPE AND TEST
	JUMPL ARG,IFS1		;JUMP IF HAVE SYMBOL DEFINITION
	CAME AC0,-3(SX)		;HAVE OPDEF, SYMBOL ALSO PRESENT?
	JRST IFS2		;NO
	SUBI SX,2		;YES, POINT TO IT
	CALL SRCH5		;RESET REGISTERS
IFS1:	CAMN AC0,1(SX)		;HAVE SYMBOL, OPDEF ALSO PRESENT?
	IOR ARG,2(SX)		;YES, MERGE FLAGS
IFS2:	HRRI ARG,0		;NO RH LOCAL FLAGS IF SYMBOL
%IF1:	CALL GETSYM		;GET ATTRIBUTE
	  JRST IFERRA		;MUST BE A SYMBOL
	CAIE C,'<'		;[677] IF "<", SET REPEAT AND CONTINUE
	JUMPNC IFERRA		;[677] ELSE TERMINATE WITH COMMA
	TLO IO,IORPTC		;[677]
	CALL %IFSTM		;SETUP MASK
	MOVSI AC2,-IFLEN	;AOBJN PTR
IFLOOP:	MOVE SDEL,IFATAB(AC2)	;GET NAME
	ANDCM SDEL,AC1		;MASK
	CAMN AC0,SDEL		;MATCH
	JRST IFOUND		;GOT IT
	AOBJN AC2,IFLOOP	;LOOP
	JRST IFERRA		;[611] NOT FOUND, A-ERROR

;SETUP MASK TO LOOK AT ONLY AS MANY LETTERS AS USER TYPED.   ALLOWS
;ATTRIBUTE TO BE UNIQUELY ABBREVIATED.
%IFSTM:	SETO AC1,		;START WITH ALL
	TDNE AC0,AC1		;STILL SEEING USERS CHARS?
	JRST [LSH AC1,-6	;YES, SHIFT OUT ONE SIXBIT CHAR
		JRST .-1]	;TRY AGAIN
	RET			;MASK NOW IN AC1

;ANY DETECTED ERROR IN THIS PSEUDOOP GIVES "A" ERROR
IFERRA:	POP P,AC0		;CLEAR STACK
	JRST ERRAX		;ERROR "A"

IFOUND:	MOVE SDEL,IFATAB+1(AC2) ;[611] CHECK NEXT ENTRY IN TABLE
	ANDCM SDEL,AC1		;[611] MASK
	CAMN AC0,SDEL		;[611] MATCH?
	JRST IFERRA		;[611] YES, ABBR. NOT UNIQUE, A-ERROR
	POP P,AC0		;[611] GET WHICH
	JUMPN AC0,IFNTST	;[611] .IFN
;	JRST IFTST		;[611] .IF

IFTST:	XCT IFJTAB(AC2)		;MAKE TEST
	  JRST IFXF		;FALSE
	JRST IFXT		;TRUE

IFNTST:	XCT IFJTAB(AC2)		;MAKE TEST
	  JRST IFXT		;TRUE
	JRST IFXF		;FALSE

%IF2:	TRNE AC1,ERRORS		;[1056] ERRORS IN ATOM?
	JRST [MOVEI ARG,UNDF+NOTF ;[1056]
		JRST %IF1]	;[1056] SKIP SEARCH
	SKIPN IFSRCH		;[1056] SEARCH PERFORMED ALREADY?
	JRST [MOVEI ARG,NUMF	;[1056] NO, IT'S REALLY A NUMBER
		JRST %IF1]	;[1056] SKIP SEARCH
	HLLZ ARG,IFSRCH		;[1056] GET MERGED ARG BITS
	SKIPE .IFNUM		;[1056] NUMBER SEEN TOO?
	TRO ARG,NUMF		;[1056] YES, MERGE IT IN
	TDNE RC,[-2,,-2]	;[1056] DO RELOCATION CHECKS
	JRST [TLO ARG,EXTF	;[1056] ANY FIXUP RETURNS EXTERNAL
		JRST %IF1]	;[1056] (ALONG WITH MERGED BITS)
	TLNE RC,1		;[1056] LH RELOCATABLE?
	TLOA ARG,LELF		;[1056] SET FLAG
	TLZ ARG,LELF		;[1056] ELSE FORCE FLAG OFF
	TRNE RC,1		;[1056] SAME TEST FOR RIGHT-HALF
	TLOA ARG,RELF		;[1056]
	TLZ ARG,RELF		;[1056]
	JRST %IF1		;[1056] GET ATTRIBUTE
;[611] KEEP ATTRIBUTE TABLE ALPHABETICAL
DEFINE IFATRIB <
XX ABSOLUTE,<TLNE ARG,LELF!RELF!SYNF!MACF!EXTF!UNDF!SPTR>
XX ASSIGNMENT
XX ENTRY,<TLNN ARG,ENTF>
XX EXPRESSION,<SKIPN .IFANG>	;;[1056] ANGLE-BRACKET SEEN?
XX EXTERNAL,<TLNN ARG,EXTF!SPTR>
XX GLOBAL,<TLNN ARG,ENTF!EXTF!INTF!SPTR>
XX INTERNAL,<TLNN ARG,INTF>
XX LABEL,<TLNN ARG,TAGF>
XX LOCAL
XX LRELOCATABLE,<TLNN ARG,LELF>
XX MACRO,<TLNN ARG,MACF>
XX NAME,<SKIPN .IFNAM>		;;[1112] SINGLE RADIX50 NAME SEEN?
XX NEEDED
XX NUMERIC,<TRNN ARG,NUMF>
XX OPCODE,<TRNN ARG,OPCF>
XX OPDEF,<TLNN ARG,OPDF>
XX REFERENCED
XX RELOCATABLE,<TLNN ARG,LELF!RELF>
XX RRELOCATABLE,<TLNN ARG,RELF>
XX SYMBOL,<TLNN ARG,SYMF>
XX SYNONYM,<TLNN ARG,SYNF>
   >

DEFINE XX (A,B)<
	<SIXBIT /A/>
   >
IFATAB:	IFATRIB
   IFLEN==.-IFATAB

DEFINE XX (A,B)<
 IFB <B>,<
	CALL %IF'A
   >
 IFNB <B>,<
	B
   >>
IFJTAB:	IFATRIB
%IFLOCAL:
	TLNN ARG,EXTF!SPTR!UNDF!MACF!SYNF
	TLNN ARG,SYMF		;NOT EXTERNAL, BUT MUST BE SYMBOL
	RET
	JRST CPOPJ1

%IFASSIGNMENT:
	TLNE ARG,SYMF
	TLNE ARG,TAGF!UNDF!MACF!SYNF
	RET
	JRST CPOPJ1

%IFREFERENCED:
	CAMN ARG,[UNDF+NOTF]	;[621] NOT FOUND?
	RET			;[621]
	JRST CPOPJ1		;[621]

%IFNEEDED:
	CAME ARG,[UNDF+NOTF]	;[626] NOT FOUND?
	TLNN ARG,UNDF		;[626] FOUND, BUT UNDEFINED?
	RET			;[626]
	JRST CPOPJ1		;[626] CONDITION SATISFIED

;[1112] HERE FROM CELL LEVEL TO RULE OUT CASES WHERE THE CURRENT
;[1112] ATOM CANNOT BE A SIMPLE RADIX50 NAME (I.E. SYMBOL)
%IFCHK:	CAIN C,' '		;[1112] SPACE OR TAB?
	JRST CELL1		;[1112] KEEP SCANNING
	CAIN C,'.'		;[1112] PERIOD
	JRST PERIOD		;[1112] CHECK IT OUT
	CAIE C,'$'		;[1112] DOLLAR SIGN
	CAIN C,'%'		;[1112] OR PERCENT SIGN
	JRST LETTER		;[1112] VALID NAME CHARACTER
	CAIL C,'A'		;[1112] LETTERS ARE ALSO
	CAILE C,'Z'		;[1112]  VALID NAME CHARACTERS
	SKIPA			;[1112] BUT OTHERS AREN'T
	JRST LETTER		;[1112] HANDLE LETTERS
	CAIN C,'<'		;[1112] NAME MAY BE BRACKETED
	JRST ANGLB		;[1112] HANDLE EXPRESSIONS
	CAIN C,'>'		;[1112] END OF EXPRESSION
	JRST LETTER		;[1112] SCAN FURTHER
	SETZM .IFNAM		;[1112] OTHER THAN RADIX50 NAME
	JRST CELL1A		;[1112] CONTINUE USUAL DISPATCH
;ASSIGN PSEUDO-OP
;ASSIGN SYM1,SYM2,INCR
ASGN:	CALL COUTD		;DUMP BUFFER
	PUSH P,BLKTYP		;SAVE BLOCK TYPE
	MOVEI AC0,100		;ASSIGN BLOCK TYPE
	MOVEM AC0,BLKTYP
	CALL GETSYM		;HERE TO ASGN6 COPIED FROM EXTERN
	JRST ASGN2
	TLO IO,DEFCRS		;FLAG AS DEFINITION
	CALL SSRCH
	JRST ASGN1
	TLNN ARG,EXTF!VARF!UNDF
	JRST ASGN2
	TLNE ARG,EXTF
	JRST [JUMP1 ASGN6
		TLZN ARG,UNDF
		JRST ASGN6
		ANDM ARG,(SX)
		JRST ASGN1]
ASGN1:	CALL EXTRN1		;[664]
	CALL EXTRN2		;[664][712]
ASGN6:	MOVE AC0,-1(SX)
	SETZ ARG,
	CALL SQOZE		;CONVERT TO SQUOZE
	CALL COUT		;OUTPUT FIRST SYMBOL
	JUMPNC ASGN2		;MUST BE COMMA HERE
	CALL GETSYM		;SECOND SYMBOL
	JRST ASGN2
	MOVEI SDEL,%SYM		;OUTPUT TO CREF
	CALL CREF
	SETZ ARG,
	CALL SQOZE		;CONVERT TO SQUOZE
	CALL COUT
	JUMPNC ASGN3		;COMMA?
	CALL EVALXQ		;YES, EVALUATE INCREMENT
ASGN4:	CALL COUT
	JUMP1 ASGN7		;DON'T OUTPUT IF PASS1
	CALL COUTD		;OUTPUT 3 WORDS
ASGN5:	POP P,BLKTYP		;RESTORE BLOCK TYPE
	RET

ASGN3:	MOVEI AC0,1		;INCREMENT IS 1 IF NOT SPECIFIED
	JRST ASGN4

ASGN2:	TRO ER,ERRE		;INDICATE
ASGN7:	CALL COUTI		;CLEAR OUTPUT BUFFER
	JRST ASGN5
EXTER0:	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	CALL GETSYM		;GET A SYMBOL
	 JRST [	TRO ER,ERRA	;[712] FLAG AS ERROR
		JRST EXTERC]	;[1070][712]
EXTER1:	TLO IO,DEFCRS		;FLAG THIS AS A DEFINITION
EXTER5:	CALL SSRCH		;OK, SEARCH SYMBOL TABLE
	  JRST EXTER2		;NOT THERE, INSERT IT
	TLNN ARG,INTF		;[1070] PREVIOUSLY DEFINED AS INTERNAL
	TLNN ARG,EXTF!VARF!UNDF ;[1070] BUT NOT EXTERNAL OR UNDEFINED
	JRST [	TRO ER,ERRE	;[1070] FLAG ERROR
		JRST EXTERC]	;[1070] AND BYPASS
	TLNE ARG,EXTF		;VALID, ALREADY DEFINED?
	JRST [JUMP1 EXTER3	;YES, BYPASS
		TLZN ARG,UNDF	;SKIP IF UNDEFINED ALSO
		JRST EXTER3	;CONTINUE
		ANDM ARG,(SX)	;CLEAR UNDF ON PASS 2
		JRST EXTER2]	;SET UP EXTERNAL NOW
EXTER2:	CALL EXTRN1		;[664] SET UP EXTERNAL
	CALL SUPSYM		;SEE IF "!" SEEN
	CALL EXTRN2		;[664] [712] INSERT/UPDATE IT
	MOVE ARG,AC0		;[712]
EXTER3:				;[1070]
   IFN FTPSECT,<		;[575] IF PSECT MUST SEARCH FOR ALL OCCURANCES
	SKIPN SGNMAX		;ANY PSECTS?
	JRST EXTER9		;NO
	PUSH P,SGNCUR		;SAVE CURRENT PSECT
	SETOM SGSRCH		;[1070] SEARCH ONLY CURRENT PSECT
	SETZB AC1,SGNCUR	;[1070] START WITH BLANK PSECT
EXTER6:	CAMN AC1,0(P)		;[1070] SAME AS CURRENT PSECT?
	JRST EXTER7		;[1070] YES - SKIP IT
	CALL SSRCH		;LOOK FOR EXTERN
	  JRST EXTER7		;[1070] NOT FOUND IN THIS PSECT
	TLNE ARG,EXTF		;ALREADY EXTERN?
	JRST [JUMP1 EXTER7	;YES, BYPASS
		TLZN ARG,UNDF	;UNDEF ALSO
		JRST EXTER7	;NO
		ANDM ARG,(SX)	;YES, CLEAR FLAG
		JRST .+1]	;AND SETUP AS EXTERN
	CALL EXTRN1		;[664] SET UP EXTERN
	CALL EXTRN2		;[664] INSERT/UPDATE IT
	MOVE ARG,AC0		;[712]
EXTER7:	AOS AC1,SGNCUR		;NEXT PSECT
	CAMG AC1,SGNMAX		;ALL DONE?
	JRST EXTER6		;NO
	SETZM SGSRCH		;[1070] SEARCH ALL PSECTS
	POP P,SGNCUR		;[1070] BACK TO NORMAL
EXTER9:>			;[575] END IFN FTPSECT
EXTERC:	CALL SUPSYM		;[1070] SEE IF "!" SEEN
	JUMPCM EXTER0
	TRZ FRR,NOUNVS		;[713] SEARCH UNIVERSALS AGAIN
	RET			;NO, EXIT

EXTRN1:	MOVEI V,2		;[664] GET 2 CELLS FROM TREE
	ADDB V,FREE		;[664]
	CAML V,SYMBOL		;[664] HAVE WE RUN OUT OF CORE
	CALL XCEEDS		;[664] YES, TRY TO BORROW SOME MORE
	SUBI V,2		;[664] GET RIGHT CELL FOR POINTER
	SETZB RC,0(V)		;[664] ALL SET, ZERO VALUES
	MOVSI ARG,SYMF!EXTF	;[664]
	RET			;[664] RETURN TO INSERT/UPDATE

EXTRN2:	CALL INSERT		;[664] INSERT/UPDATE
	MOVSI ARG,PNTF		;[664]
	IORM ARG,0(SX)		;[664]
	MOVE AC0,-1(SX)		;[712] GET THE SIXBIT FOR THE NAME
	MOVEM AC0,1(V)		;[712] STORE IT FOR ADDITIVE GLOBAL FIXUPS
	RET			;[664] RETURN TO GET SIXBIT
EVAL10:	PUSH P,CURADX		;[613] PUSH CURRENT RADIX
	PUSH P,[^D10]		;[613] MAKE IT RADIX 10
	POP P,CURADX		;[613]
	CALL EVALEX		;EVALUATE
	POP P,CURADX		;[613] RESET RADIX
	JUMPE RC,CPOPJ		;[664] EXIT IF ABSOLUTE

QEXT:
   IFN POLISH,<
	TLNE FR,POLSW		;ANY POLISH EXTERNAL EXPRESSIONS
	JRST QPOL		;YES, REMOVE  AND FLAG ERROR
   >
	SKIPE EXTPNT		;ANY POSSIBILITIES?
	TROA ER,ERRE		;YES, FLAG EXTERNAL ERROR
	TRO ER,ERRR		;NO, FLAG RELOCATION ERROR
	HLLZS RC		;CLEAR RELOCATION/EXTERNAL
	RET

   IFN POLISH,<
QPOL:	TRO ER,ERRE		;FLAG EXTERNAL ERROR
	PUSH P,AC1		;GET AN AC
	SKIPE LITLVL		;IN A LITERAL?
	SKIPA AC1,POLITS	;YES, USE LAST LIT ITEM
	MOVE AC1,POLIST		;GET LAST ITEM IN LIST
	JUMPE AC1,QPOL1		;IF ZERO, DON'T GO BACK
	MOVEM AC1,FREE		;RESET FREE CORE POINTER
	MOVE AC1,(AC1)		;GET PREVIOUS ITEM
	SKIPE LITLVL		;IN A LITERAL?
	JRST [MOVEM AC1,POLITS	;YES
		JRST .+2]
	MOVEM AC1,POLIST	;MAKE IT TOP OF LIST
QPOL1:	POP P,AC1
	RET
   >

EVALXQ:	PUSH P,IO		;SAVE ERROR STATUS
	TRZ ER,-1		;START AFRESH
	CALL EVALQ		;EVALUATE EXPRESSION
	TRNE ER,ERRU		;TEST FOR UNDEF
	TRO ER,ERRV		;FLAG "V" ERROR
	HLLM IO,(P)		;STORE STATUS FLAGS
	IORM ER,(P)		;COMPOUND ERRORS
	POP P,IO		;RESTORE THEM
	RET

EVALQ:				;[1025]
   IFN POLISH,< TRO FRR,NOPSW >	;[1025] DON'T ALLOW POLISH
	CALL EVALEX		;EVALUATE EXPRESSION
   IFN POLISH,< TRZ FRR,NOPSW >	;[1025] REST FLAG
	TDZE RC,[-2,,-2]	;WAS AN EXTERNAL FOUND?
	TRO ER,ERRE		;YES, FLAG ERROR
	RET			;RETURN
OPDEF0:	CALL GETSYM		;GET THE FIRST SYMBOL
	  RET			;ERROR IF INVALID SYMBOL
	CAIE C,73		;"["?
	JRST ERRAX		;NO, ERROR
	MOVEM AC0,INOPDF	;[624]
	PUSH P,AC0		;STACK MNEMONIC
	AOS LITLVL		;SHORT OUT LOCATION INCREMENT
	PUSH P,STPY		;[1035] SAVE CODE BUFFER SETTINGS AND
	PUSH P,STPX		;[1035] POINT OUTPUT SETTING AT CURRENT
	PUSH P,STPX		;[1035] INPUT SETTING
	POP P,STPY		;[1035]
	CALL STMNT		;EVALUATE STATEMENT
	MOVE AC1,STPX		;[1035] MAKE SURE CODE WAS GENERATED
	SUB AC1,STPY		;[1035]
	SKIPG AC1		;[1035]
	TROA ER,ERRA		;[1035] ELSE FLAG ERROR
	CALL DSTOW		;[1035]
	POP P,STPX		;[1035] RESTORE CODE BUFFER SETTINGS
	POP P,STPY		;[1035]
	SOS LITLVL
	SETZM INOPDF		;[624]
	EXCH AC0,0(P)		;EXCHANGE VALUE FOR MNEMONIC
	PUSH P,RC		;STACK RELOCATION
	TLO IO,DEFCRS		;SAY WE ARE DEFINING IT
	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	CALL SSRCH		;[752] SEE IF FORW-REFED
	 JRST OPDEF1		;[752] NO, JUMP
	TLNN ARG,UNDF		;[752]
	JRST OPDEF1		;[752]
	TLNN ARG,INTF		;[752]
	CALL OPCFX1		;[752]
OPDEF1:				;[752]
	CALL MSRCH		;SEARCH SYMBOL TABLE
	MOVSI ARG,OPDF		;[675] OPDEF
	TRZ FRR,NOUNVS		;[713] SEARCH UNIVERSALS AGAIN
	POP P,RC		;RESTORE VALUES
	POP P,V
	TLNE ARG,SYNF!MACF
	TRO ER,ERRA		;YES "A" ERROR
	TRNN ER,ERRA		;ERROR?
	CALL INSERT		;NO, INSERT/UPDATE
	CALL ASSIGL		;LIST VALUE LIKE =
	TLZ IO,DEFCRS		;JUST IN CASE
	CALL BYPASS		;[664]
	SETZM EXTPNT		;[1000] CLEAR EXTERNAL POINTER
	RET			;[1000] NO LONGER NEEDED TO RESET STOW

OPCFIX:	CALL SSRCH		;[736] SEE IF WAS FORW-REF'ED
	RET			;[736] NO, CONTINUE
	TLNN ARG,UNDF		;[736]
	RET			;[736] NO, CONTINUE
OPCFX1:	PUSH P,AC0		;[752] YES, IT WAS UNDEFINED, DO REMOVE
	CALL REMOVE		;[736]
	POP P,AC0		;[736]
	RET			;[736] CONTINUE WITH NAME IN AC0
DEPHA0:	SETZM PHALVL		;NOT IN PHASE
	MOVE AC0,LOCO
	MOVE RC,MODO		;SET TO OUTPUT VALUES AND SKIP
	JRST PHASE1

PHASE0:	SETOM PHALVL		;IN PHASE
	CALL EVALXQ		;EVALUATE AND CHECK FOR EXTERNAL
PHASE1:	MOVEM AC0,LOCA		;SET ASSEMBLY LOCATION COUNTER
	MOVEM RC,MODA
	JRST BLOCK2
ASSIGN:	JUMPAD ERRAX		;NO, ERROR
	JUMPE AC0,ERRAX		;NO SYMBOL ON THE LEFT OF=
	CALL ASSIG1
ASSIGL:	TLNE IO,IOSALL		;SUPPRESS ALL?
	JUMPN MRP,CPOPJ		;IF IN MACRO
ASSIG7:	MOVEM RC,ASGBLK
	JUMP1 CPOPJ		;[633] DON'T NEED THIS FOR PASS1
   IFN POLISH,<
	JUMPL RC,CPOPJ		;[633] DON'T NEED THIS FOR POLISH ASSIGN
   >
	PUSH P,AC0		;[633] NEED AN AC FOR A WHILE
	MOVEI AC0,EXTF		;[633] EXTERNAL FLAG
	TRNE RC,-2		;[633] RIGHT HALF EXTERNAL?
	HRRM AC0,ASGBLK		;[633] YES, USE THE FLAG
	TLNE RC,1		;[633] LEFT HALF NOT RELOC?
	JRST [	TLNE RC,-2	;[633] NO, EXTERNAL?
		HRLM AC0,ASGBLK	;[633] YES, SET FLAG
		JRST .+2]	;[633] SKIP RETURN
	HRROS ASGBLK		;[633] LEFT HALF NOT RELOC, MAKT IT -1
	POP P,AC0		;[633] RESTORE AC
	MOVEM V,LOCBLK
	RET

ASSIG1:	PUSH P,AC0		;SAVE SYMBOL
   IFN POLISH,<
	MOVEM AC0,INASGN	;IN CASE POLISH FIXUP REQUIRED
   >
	SETZB AC0,EXTPNT	;SPECIAL CHECK FOR == WFW
ASSIG4:	CALL PEEK		;IS THE NEXT ON =
	CAIE C,"="
	CAIN C,"!"
	CAIA			;WANT TO SUPRESS SYMBOL
	JRST ASSIG5		;NOT "=" OR "!", SO SEE IF COLON
	TLOE AC0,NOOUTF		;TURN ON "NO-OUTPUT" FLAG
	TRO ER,ERRQ		;IF ALREADY ON, GIVE ERROR
	CALL GETCHR		;PROCESS THE CHAR.
	CALL PEEK		;CHECK FOR ==: DMN
ASSIG5:	CAIE C,":"		;IS IT
	JRST ASSIG6		;NO
	TLOE AC0,INTF		;FLAG AS INTERNAL
	TRO ER,ERRQ		;IF ALREADY ON, ITS AN ERROR
	CALL GETCHR		;REPEAT IT
	JRST ASSIG4		;TRY AGAIN (MIGHT BE =:!)

ASSIG6:	PUSH P,AC0		;[1045] SAVE SYMTAB BITS ACROSS CALL
   IFN POLISH,<
	HRREI AC0,POLFWF	;ASSUME FULL WORD FIXUP
	MOVEM AC0,POLTYP	;UNLESS OTHERWISE SPECIFIED
   >
	CALL EVALCM		;EVALUATE EXPRESSION
	POP P,HDAS		;[1045] RESTORE SYMTAB BITS FOR LATER MERGE
	TRNE FRR,LTGSW		;[1126] ASSIGNMENT INVOLVING LABEL IN LITERAL?
	TRO ER,ERRL		;[1126] YES - FLAG ERROR SINCE MAY BE UNDEFINED
	TDNN RC,[-2,,-2]	;RC IS 0 OR 1?
	JRST ASSIG0		;YES,
	CAIGE RC,100		;NO, RC HAVING VALUES BETWEEN -100 AND
	CAMG RC,[-100]		;100 GETS R ERROR
	SKIPA			;SINCE IT IS NOT PART OF A LARGER EXP
	TRO ER,ERRR		;GIVE R ERROR
ASSIG0:	EXCH AC0,0(P)		;SWAP VALUE FOR SYMBOL
	PUSH P,RC
   IFN POLISH,<
	JUMPL RC,ASSIG3		;POLISH, BYPASS EXTERN TESTS
   >
	TRNN RC,-2		;CHECK EXTERNAL AGREEMENT
	JRST ASSIG2
	HRRZS RC
	HRRZ ARG,EXTPNT
	CAME RC,ARG
	CALL QEXT		;EXTERNAL OR RELOCATION ERROR
ASSIG2:	HLRZ RC,(P)
	TRNN RC,-2
	JRST ASSIG3
	HLRZ ARG,EXTPNT
	CAME RC,ARG
	CALL QEXT
ASSIG3:	TLO IO,DEFCRS
	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	CALL SSRCH
	  MOVSI ARG,SYMF
	TRZ FRR,NOUNVS		;[713] SEARCH UNIVERSALS AGAIN
	TLC ARG,EXTF+PNTF	;[606] REAL EXTERNAL UP TIL NOW?
	TLCE ARG,EXTF+PNTF	;[606]
	SKIPA			;[606] NO,
	JRST [	TLNN ARG,UNDF	;[606] NOT BECAUSE UNDEFINED?
		TRO ER,ERRE	;[606] YES,  E-ERROR, CAN'T DO FOO##=
		JRST .+1]	;[606] UNDEFINED
	TLZ ARG,^-<SYMF!TAGF!NOOUTF!INTF!ENTF!NCRF!MDFF!SUPRBT!SPTR> ;[745] KEEP THESE
	IOR ARG,HDAS		;SET BITS DETERMINED ABOVE
	SETZM EXTPNT		;FOR REST OF WORLD
   IFN POLISH,<
	SETZM INASGN		;FINISHED WITH POLISH BY NOW
	SETZM POLTYP
  >				;[575]
   IFN FTPSECT,<		;[575]
	TLZ IO,RSASSW		;...
   >
	POP P,RC
	TRNE ER,ERRORS-ERRQ-ERRU ;[1005]
	SETZ RC,		;CLEAR RELOCATION
	POP P,V
	JUMP2 .+3		;[1017] DON'T CARRY UNDF ACROSS IN PASS 2
	TRNE ER,ERRU		;WAS VALUE UNDEFINED?
	TLO ARG,UNDF		;YES,SO TURN UNDF ON
	TLNE ARG,TAGF
	JRST ERRAX
	TLNN ARG,SPTR		;[745] WAS SPTR ON?
	JRST INSERT		;[745] NO,
	JUMPL RC,INSERT		;[745] YES, AND STILL GOOD
	TLZ ARG,SPTR		;[745] NO LONGER NEEDED
	JRST INSERT
;LOC, RELOC, AND ORG COME HERE

%ORG:	MOVEM AC0,MODN		;SAVE TYPE
	CALL HIGHQ		;GET LATEST PC
	CALL BYPASS		;[664] SKIP BLANKS
	TLO IO,IORPTC		;REPEAT LAST
	CAIN C,EOL		;USE PREVIOUS VALUE IF NULL ARGUMENT
	JRST [HRRZ AC0,ORGMOD	;GET PREV MODE IN CASE ORG
		SKIPGE MODN	;ORG?
		HRLM AC0,MODN	;YES, SAVE IT
		HLRZ AC1,MODN	;NEW MODE
		MOVE AC0,@REL1P(AC1)	;GET PREV VALUE
		JRST ORG01]	;[573]
   IFN POLISH,< TRO FRR,NOPSW>	;[616] DON'T ALLOW POLISH
	CALL EVALXQ		;GET EXPRESSION AND TEST EXTERNAL
   IFN POLISH,< TRZ FRR,NOPSW>	;[616] UNDO NO-POLISH SWITCH
	TLNE AC0,-1		;[714] STUFF IN LH?
	TRO ER,ERRA		;[741] YES, A-ERROR
	SKIPGE MODN		;ORG?
	HRLM RC,MODN		;YES, SAVE RELOC OF ARG
	SETOM RELARG		;[721] FLAG EXPLICIT ARGUMENT
ORG01:	HRRM AC0,MODN		;STORE NEW VALUE
	HLRZ AC0,MODN		;AC0=NEW MODE
	MOVE AC1,MODO		;AC1=OLD MODE
	SKIPN AC1		;[721] OLD=LOC?
	CALL [	JUMPE AC0,CPOPJ1 ;[721] YES, SKIPE IF NEW=LOC
		SKIPE RELARG	;[721] OR IF NEW=RELOC <ARG>
		AOS (P)		;[721]
		RET]		;[721]
	CALL ORG02		;[721] ELSE ADJUST RELOC BLOCK PTR
	SETZM RELARG		;[721] ZERO EXPLICIT ARG FLAG
	HRRZ AC0,LOCO		;GET LAST PC TO PROPER BLOCK
	MOVEM AC0,@REL1P(AC1)	;[573]
	MOVEM AC1,ORGMOD	;SAVE OLD MODE
   IFN FTPSECT,<		;[575]
	MOVE AC1,SGNCUR		;CURRENT PSECT INDEX
	MOVE AC0,HIGH		;SAVE PSECT BREAK
	HRRM AC0,SGATTR(AC1)
	CALL ORG03		;ADJUST RELOC PTR IF NECESSARY
	HRR AC0,@REL1P+1	;SAVE PSECT REL PC
	HRL AC0,ORGMOD		;SAVE PSECT MODE
	MOVEM AC0,SGRELC(AC1)
	CALL ORG03		;READJUST PTR IF NECESSARY
   >
	MOVE AC0,MODN		;GET RESULT
	HLRZM AC0,MODA		;SET MODES
	HLRZM AC0,MODO
	HRRZM AC0,LOCA		;AND LOCATIONS
	HRRZM AC0,LOCO
	JRST BLOCK2

ORG02:	MOVE AC0,REL1P+1	;ADJUST RELOC BLOCK PTR
	CAIN AC0,RELLOC		;[573]
	AOSA REL1P+1		;[573]
	SOS REL1P+1		;[573]
	RET			;[573]

   IFN FTPSECT,<		;[575][573]
ORG03:	HLRZ AC0,MODN		;[573]
	SKIPE AC0		;IF LOC TO RELOC
	SKIPE MODO		;[573]
	RET			;[573]
	JRST ORG02		;ADJ REL PTR
  >				;[575][573] END IFN FTPSECT
;	.PSECT NAME /ATTRIB,ORIGIN
   IFN FTPSEC,<
%SEGME:	SKIPN HISNSW		;CAN'T HAVE PSECTS WITH
	SKIPE UNIVSN		;HISEG, TWOSEG OR
	JRST ERRSX		;UNIVERSAL
	MOVE AC2,SGDMAX		;CHECK IF MAX PSECT
	CAILE AC2,SGNDEP-1	;NESTING DEPTH EXCEEDED
	JRST ERRSX		;YES
	SETZM SGSWPT		;[1074] INDICATE .PSECT FOR PSECT SWAP
	CALL GETSYM		;GET PSECT NAME
	  CALL [SETZ AC0,	;NONE SPECIFIED, BLANK NAME
		TRZ ER,ERRA	;UNDO GETSYM'S ERR FLAG
		RET]
	MOVE AC1,SGNMAX		;GET PSECT COUNT
%SEGM1:	CAMN AC0,SGNAME(AC1)	;SEEN THIS NAME BEFORE?
	JRST %SEGM2		;YES
	SOJGE AC1,%SEGM1	;LOOP THRU KNOWN NAMES
	MOVE AC1,SGNMAX		;CHECK IF MAX DISTINCT PSECT
	CAILE AC1,SGNSGS-1	;LIMIT EXCEEDED
	JRST ERRSX		;YES
	AOS AC1,SGNMAX		;INCR PSECT COUNT
	SETOM BLK24		;[1020] FIRST TIME, OUTPUT BLOCK 24
	MOVEM AC0,SGNAME(AC1)	;STORE PSECT NAME
	MOVSI AC2,1		;SET MODE TO RELOC
	MOVEM AC2,SGRELC(AC1)	;AND PC TO ZERO
	HRRZS SGORIG(AC1)	;[1131] INCASE NOT GIVEN
%SEGM4:	MOVE SDEL,SYMBOL	;ROOM TO INIT
	SUBI SDEL,LENGTH	;SYM TAB
	CAMLE SDEL,FREE		;FOR NEW PSECT?
	JRST %SEGM3		;YES
	CALL XCEEDS		;TRY FOR MORE CORE
	JRST %SEGM4		;START OVER
%SEGM3:	MOVEM SDEL,SYMBOL	;NEW SYM TAB BOT
	HRLI SDEL,LENGTH(SDEL)	;OLD SYM TAB BOT
	MOVE SX,SYMTOP		;SYM TAB TOP
	BLT SDEL,-LENGTH(SX)	;MOVE SYM TAB DOWN
	HRLI SDEL,SYMNUM+1	;PTR TO PERM SYM TAB
	HRRI SDEL,1-LENGTH(SX)	;PERM SYMS GO HERE
	BLT SDEL,0(SX)		;MOVE PERM SYMS TO NEW PSECT
	MOVE AC2,SYMNUM		;PERM SYM CNT
	MOVEM AC2,SGSCNT(AC1)	;SET SYM CNT
	ADDM AC2,@SYMBOL	;[1042] ADJUST TOTAL SYM CNT
	MOVSI AC2,<SG.RP==400000> ;[1042][1021] SET RELOC PSECT BIT
	MOVEM AC2,SGATTR(AC1)	;[1042][1021] DEFAULT PSECT BRK AND ATTRS
	TLO IO,DEFCRS		;[711] FLAG AS DEFINITION
	PUSH P,AC1		;[711] SAVE AC1 FOR A WHILE
	CALL SSRCH		;[711] ADD PSECT-NAME AS EXTERN SYMBOL
	 JRST %SEG10		;[711] COPIED FROM EXTERN CODE
	TLNN ARG,EXTF!VARF!UNDF	;[711]
	JRST [	TRO ER,ERRE	;[711]
		JRST %SEG11]	;[711]
	TLNE ARG,EXTF		;[711]
	JRST [	JUMP1 %SEG11	;[711]
		TLZN ARG,UNDF
		JRST %SEG11	;[711]
		ANDM ARG,(SX)	;[711]
		JRST %SEG10]	;[711]
%SEG10:	CALL EXTRN1		;[711]
	CALL EXTRN2		;[711]
%SEG11:	POP P,AC1		;[711] RESTORE AC1
%SEGM2:	AOS AC2,SGDMAX		;INCR PSECT DEPTH
	MOVEM AC0,SGLIST(AC2)	;STORE PSECT NAME
	SETZM SGLTLV(AC2)	;[1074] CLEAR PSECT ENTRY LITERAL LEVEL
%SEGM5:	CAIE C,'/'		;ATTRIBUTES SPECIFIED?
	JRST %SEGM9		;NO, TRY VALUE
	PUSH P,AC1		;SAVE PSECT INX
	CALL GETSYM		;GET ATTRIBUTE
	  JRST %SEGM8		;TOO BAD
; THE BELOW ATTRIBUTES ARE PAIRED; A CONFLICT IS
; FLAGGED IF BOTH OF ANY PAIR ARE SEEN (CUMMULATIVELY)
	MOVE AC1,AC0		;ATRIB NAME
	SETO AC2,		;MASK
	LSH AC1,6		;SHIFT UP 1 CHAR AT A TIME
	LSH AC2,-6		;[1117] SAME FOR MASK
	JUMPN AC1,.-2		;UNTIL CHAR ALL GONE, MASK LEFT
	PUSH P,[-1]		;[1117] STACK NO TABLE MATCH FOUND
	PUSH P,AC2		;[1117]  AND ATTRIBUTE MASK
	MOVSI AC1,-%SGATL	;[1117] SETUP AOBJN COUNTER
%SEGM6:	CAMN AC0,%SGATN(AC1)	;[1117] EXACT MATCH ON ATTRIBUTE?
	JRST %SEGM7		;[1117] YES, CHECK IT OUT
	MOVE AC2,%SGATN(AC1)	;[1117] GET TABLE ATTRIBUTE
	ANDCM AC2,0(P)		;[1117] MASK IT
	CAME AC0,AC2		;[1117] MATCH YET?
	JRST %SEG12		;[1117] NO - KEEP CHECKING
	SKIPL -1(P)		;[1117] HAS IT BEEN FOUND BEFORE?
	JRST %SEG13		;[1117] ERROR BECAUSE AMBIGUOUS
	HRRZM AC1,-1(P)		;[1117] SAVE INDEX WHERE FOUND
%SEG12:	AOBJN AC1,%SEGM6	;[1117] LOOP THRU TABLE
	MOVE AC1,-1(P)		;[1117] GET INDEX WHERE FOUND
	JUMPGE AC1,%SEGM7	;[1117] OK IF FOUND
%SEG13:	SUB P,[2,,2]		;[1117] ERROR - CLEAN UP STACK
	POP P,AC1		;[1117] RESTORE PSECT INDEX
	TRO ER,ERRQ		;[1117] FLAG QUESTIONABLE ERROR
	JRST %SEGM5		;[1117] AND TRY AGAIN
%SEGM7:	SUB P,[2,,2]		;[1117] DISCARD MASK AND INDEX
	MOVE AC2,%SGATB(AC1)	;[1117] GET ATTRIBUTE DEF AND CONFLICT BITS
	MOVE AC1,0(P)		;[1117] GET PSECT INDEX
	HLRZ AC0,SGATTR(AC1)	;[1117]  AND CURRENT ATTRIBUTES
	AND AC0,AC2		;[1117] SEE IF ANY CONFLICTS
	SKIPE AC0		;[1117] SKIP IF NONE
	JRST [ TRO ER,ERRQ	;[1117] FLAG QUESTIONABLE ERROR
	       JRST %SEGM8]	;[1117] AND IGNORE CONFLICT
	HLLZS AC2		;[1117] CLEAR RIGHT HALF
	IORM AC2,SGATTR(AC1)	;MERGE ATTRIBUTES
%SEGM8:	POP P,AC1		;RESTORE PSECT INX
	JRST %SEGM5		;[1117] CHECK FOR MORE ATTRIBUTES

%SEGM9:	JUMPNC %SWSEG		;[1021] NO VALUE
	PUSH P,AC1		;SAVE INDEX
	CALL EVALCM		;GET IT
	TRNN FRR,RHPSW!LHPSW!FWPSW	;[1137] IS ORIGIN POLISH
	SKIPE RC			;[1137]  OR EXTERNAL OR RELOC?
	TRO ER,ERRA			;[1137] YES - FLAG ARG ERROR
	POP P,AC1		;RESTORE INDEX
	HRRM AC0,SGORIG(AC1)	;STORE IT
	SKIPL AC2,SGATTR(AC1)	;[1030][1021] RELOCATABLE PSECT?
	JRST %SWSEG		;[1030][1021] NO,
	TLZ AC2,SG.RP		;[1030][1021] YES, NO LONGER TRUE
	MOVEM AC2,SGATTR(AC1)	;[1030][1021] MAKE IT FIX-ORIGIN
	JRST %SWSEG		;SWAP PC AND MODE

;[1117] PSECT ATTRIBUTE DEFINITION
;[1117] VALS:	ATTRIBUTE NAME - SIXBIT
;[1117]		ATTRIBUTE SYMBOL - DEFINED FROM BIT 17 TO BIT 1
;[1117]		CONFLICTING ATTRIBUTE SYMBOLS - ORED TOGETHER
DEFINE %SGATD,<					;[1117]
	%SGATV	RWRITE,AT.RW,AT.RO		;[1117] READ-WRITE
	%SGATV	RONLY,AT.RO,AT.RW		;[1117] READ-ONLY
	%SGATV	OVERLAID,AT.OV,AT.CN		;[1117] OVERLAY
	%SGATV	CONCATENATED,AT.CN,AT.OV	;[1117] CONCATENATE
	%SGATV	PALIGNED,AT.PA			;[1117] PAGE-ALIGNED
>						;[1117]

DEFINE %SGATV(ATB,DEF,CON),<		;[1117]
	<SIXBIT /ATB/>			;[1117]
	DEF==1B<ATC>			;[1117]
	ATC==ATC-1>			;[1117]

	ATC==^D17			;[1117] START FROM BIT 17
%SGATN:	%SGATD				;[1117] NAMES AND ASSIGNMENTS
%SGATL==.-%SGATN			;[1117]
	PURGE ATC			;[1117]

DEFINE %SGATV(ATB,DEF,CON<0>),<		;[1117]
	DEF+<CON_-^D18>>		;[1117]

%SGATB:	%SGATD				;[1117] VALUES,,CONFLICT VALUES
%ENDSE:	SKIPN HISNSW		;CAN'T HAVE PSECTS WITH
	SKIPE UNIVSN		;HISEG, TWOSEG OR
	JRST ERRSX		;UNIVERSAL
	MOVE AC2,SGDMAX		;IF DEPTH IS ALREADY ZERO
	JUMPE AC2,ERRSX		;THEN .ENDPS IS ILLEGAL
	SETOM SGSWPT		;[1074] INDICATE .ENDPS FOR PSECT SWAP
	CALL GETSYM		;GET PSECT NAME
	JRST %ENDS1		;NONE SPECIFIED, IGNORE CHECK
	CAME AC0,SGLIST(AC2)	;DOES IT MATCH CORRES .PSECT NAME
	TRO ER,ERRQ		;NO, FLAG WARN AND DO IT ANYWAY
%ENDS1:	TRZ ER,ERRA		;UNDO GETSYM'S ERR FLAG
	MOVE AC1,LITLVL		;[1074] IS CURRENT LITERAL LEVEL
	CAME AC1,SGLTLV(AC2)	;[1074] THE SAME AS AT PSECT ENTRY?
	JRST [	TRO ER,ERRL	;[1074] NO - FLAG LIT LEVEL MISMATCH
		PUSH P,AC0	;[1074] AND SAVE SPECIFIED PSECT NAME
		JRST .+1]	;[1074]
	SOS AC2,SGDMAX		;DECR PSECT DEPTH
	MOVE AC0,SGLIST(AC2)	;NAME OF PSECT TO RESUME
	MOVE AC1,SGNMAX		;GET PSECT COUNT
	CAME AC0,SGNAME(AC1)	;NAME MATCH?
	SOJGE AC1,.-1		;NO, TRY NEXT
	TRNN ER,ERRL		;[1074] ANY PSECT LIT LEVEL MISMATCH?
	JRST %SWSEG		;[1074] NO - CONTINUE SWAP
	SETZM LITLVL		;[1074] YES - CLEAR LIT LEVEL
	CALL %SWSEG		;[1074] LET SWAP HAPPEN
	MOVE AC0,['MCRLNI']	;[1074] SETUP FOR ERROR
	MOVEM AC0,PREFIX	;[1074] .....
	CALL EFATAL		;[1074] SEND PREFIX
	HRRZI CS,[SIXBIT / LITERAL NESTING INCORRECT AT END OF PSECT@/] ;[1074]
	CALL TYPM2		;[1074] SEND TEXT
	POP P,CS		;[1074] GET PSECT NAME
	CALL TYPSYM		;[1074] SEND PSECT NAME IF ANY
	CALL CRLF		;[1074] TYPE ERROR
	PUSH P,PAGENO		;[1074] SETUP 4 WORD BLOCK
	PUSH P,SEQNO2		;[1074] FOR ERROR LOC TYPEOUT
	PUSH P,TAG		;[1074] .....
	MOVE AC0,TAGINC		;[1074] GET CURRENT OFFSET
	SKIPE LBLFLG		;[1074] FOUND A LABEL IN THIS LITERAL?
	SUB AC0,LTGINC		;[1074] YES - CORRECT OFFSET
	PUSH P,AC0		;[1074] COMPLETE 4 WORD BLOCK
	HRLI V,[SIXBIT /@/]	;[1074] SETUP NO ERROR TEXT
	HRRI V,-3(P)		;[1074] AND POINTER TO ERROR BLOCK
	JRST ERRNE3		;[1074] FINISH OFF ERROR

;HERE TO SWAP TO NEW PSECT
;ENTER WITH OLD PSECR IN SGNCUR, NEW PSECT IN AC1
%SWSEG:	PUSH P,AC1		;SAVE NEW PSECT INX
	MOVE AC2,SGNCUR		;GET OLD PSECT INX
	HLRZ SDEL,SGORIG(AC2)	;ALREADY SETUP LIT/VAR BLOCK
	JUMPN SDEL,%SWSG1	;YES
	MOVEI SDEL,.SGLVL	;[1131] NO
	ADDB SDEL,FREE		;TRY TO GET IT
	CAML SDEL,SYMBOL	;WILL IT FIT?
	CALL XCEED		;NO, XPAND
	SUBI SDEL,.SGLVL	;[1131] GET ORIGIN
	HRLM SDEL,SGORIG(AC2)	;NOW STORE IT
%SWSG1:	MOVSI AC0,.SGLVZ	;START OF LIT/VAR AREA
	HRR AC0,SDEL		;[1131] SAVE AREA
	BLT AC0,.SGLVL-1(SDEL)	;[1131] STORE IT
	MOVE AC0,LITLVL		;GET LITLVL
	MOVEM AC0,(SDEL)	;STORE IT
	SKIPE LITLVL		;[602] IN A LITERAL?
	JRST [	MOVE AC0,STPX	;[602] YES, SAVE DEPTH
		MOVEM AC0,1(SDEL) ;[602]
		MOVE AC0,STPY	;[602]
		MOVEM AC0,2(SDEL) ;[602]
		JRST .+1]
	HLLZ AC0,SGORIG(AC1)	;RESTORE NEW LIT/VAR
	JUMPE AC0,[MOVE AC0,[.SGLVZ,,.SGLVZ+1] ;NOT YET SETUP
		SETZM .SGLVZ	;CLEAR FIRST WORD
		BLT AC0,.SGLVZ+.SGLVL-1 ;[1131] PLUS REST
		MOVEI AC0,VARHD	;SET UP AREA
		MOVEM AC0,VARHDX
		MOVEI AC0,LITHD
		MOVEM AC0,LITHDX
		SETZM LITLVL
		CALL LITI
		CALL STOWI	;[602]
		JRST %SWSG2]	;JOIN COMMON CODE
	TLNE FR,P1		;[1134] ONLY DURING PASS 1
	CALL STOWI		;[1134] RESET STOW COUNTERS
	HRRI AC0,.SGLVZ		;TO LIT/VAR AREA
	ADD AC0,[3,,3]		;[1131] BYPASS FIRST 3 WORDS
	BLT AC0,.SGLVZ+.SGLVL-1
	HLRZ SDEL,SGORIG(AC1)	;POINTER TO LIT INFO
	MOVE AC0,(SDEL)		;GET LITLVL
	MOVEM AC0,LITLVL	;WE ARE NOW IN
	SKIPN SGSWPT		;[1074] SWAPPING DUE TO .ENDPS
	JRST [	MOVE AC1,SGDMAX		;[1074] NO - .PSECT, GET DEPTH
		MOVEM AC0,SGLTLV(AC1)	;[1074] SAVE ENTRY LITERAL LEVEL
		MOVE AC1,0(P)		;[1100] RESTORE CURRENT PSECT NO.
		JRST .+1]		;[1074]
	SKIPE LITLVL		;[602] IN A LITERAL PREVIOUSLY?
	JRST [	MOVE AC0,1(SDEL) ;[602] YES, RESTORE DEPTH
		MOVEM AC0,STPX	;[602]
		MOVE AC0,2(SDEL) ;[602]
		MOVEM AC0,STPY	;[602]
		JRST .+1]	;[602]
	CALL HIGHQ		;SET CURRENT PROG BRK
%SWSG2:	HRRZ AC0,LOCO		;[1132] GET OUTPUT LOC
	MOVE AC1,MODO		;[1132] AND MODE
	MOVEM AC0,@REL1P(AC1)	;[1132] SAVE OLD VALUE
	MOVE AC1,SGNCUR		;CURRENT PSECT INDEX
	MOVE AC0,HIGH		;SAVE PSECT BREAK
	HRRM AC0,SGATTR(AC1)
	HRR AC0,@REL1P+1	;[1057] SAVE PSECT REL PC
	HRL AC0,MODO		;[1132] GET OUTPUT MODE
	MOVEM AC0,SGRELC(AC1)	;[1132] SAVE MODE AND PC
	MOVE AC1,(P)		;[1132] GET NEW PSECT IDX.
	MOVE AC0,SGRELC(AC1)	;[1132] GET NEW MODE AND PC
	TLNE AC0,-1		;[1132] IS NEW MODE ABSOLUTE?
	JRST %SWSG3		;[1132] NO
	HRRM AC0,@REL1P+1	;[1132] YES - SAVE RELOC PC
	HRR AC0,ABSLOC		;[1132] AND USE CURRENT ABSOLUTE PC
%SWSG3:	PUSH P,AC0		;[1132] SAVE NEW MODE AND PC
	MOVEM AC1,SGNCUR	;[1132] SET NEW CURRENT PSECT
	JUMP1 .+2		;IF PASS 2 THEN
	CALL SGOUTN		;OUTPUT PSECT NAME BLOCK
	POP P,AC0		;GET RESULT
	HLRZM AC0,MODA		;SET MODES
	HLRZM AC0,MODO
	HRRZM AC0,LOCA		;AND LOCATIONS
	HRRZM AC0,LOCO
	POP P,SGNCUR		;STORE NEW PSECT INX
	MOVE AC1,SGNCUR		;NEW PSECT INX
	HRRZ AC0,SGATTR(AC1)	;GET PSECT BRK
	MOVEM AC0,HIGH		;RESTORE IT
	JRST SRCHI		;[664] SET UP SRCHX, EXIT

ERRSX:	TRO ER,ERRS		;FLAG PSECT USAGE ERROR
	RET			;DONE
  >				;END IFN FTPSECT
HISEG1:
   IFN FTPSECT,<		;[575]
	SKIPE SGNMAX		;IF PSECTS USED THEN CAN'T USE
	JRST ERRSX		;HISEG OR TWOSEG
   >
	CALL HIGHQ		;SET CURRENT PROGRAM BREAK
	CALL COUTD		;DUMP CURRENT TYPE OF BLOCK
	SKIPN HISNSW		;IF WE HAVE SEEN IT BEFORE
	SKIPE HIGH		;OR ANY RELOC CODE PUT OUT
	TRO ER,ERRQ		;FLAG AS AN ERROR
	CALL BYPASS		;[664] GO GET EXPRESSION
	TLO IO,IORPTC
	CALL EVALXQ		;CHECK FOR EXTERNAL
	ANDCMI AC0,777		;ONLY ALLOWED TO START ON NEW P BOUND
	HRRZM AC0,LOCA		;SET LOC COUNTERS
	HRRZM AC0,LOCO
	MOVEI RC,1		;ASSUME RELOCATABLE
	RET

TWSEG0:	CALL HISEG1		;COMMON CODE
	JUMPN AC0,.+2		;ARGUMENT SEEN
	MOVEI AC0,400000	;ASSUME 400000
	HRRZM AC0,HMIN		;SET OFSET OF HIGH SEG.
	HRRZM AC0,HHIGH		;IN CASE NO HISEG CODE
	TLOA AC0,(1B0)		;SIGNAL TWO SEGMENTS AND SKIP

HISEG0:	CALL HISEG1		;COMMON CODE
HISEG2:	MOVEM AC0,SVTYP3	;SAVE THE HISEG ARG
	MOVEM RC,MODA		;SET MODES
	MOVEM RC,MODO
	SETOM HISNSW		;WE HAVE ALREADY PUT ONE OUT
	JRST BLOCK2		;MAKE LISTING HAPPEN RIGHT

   IFN FORMSW,<
ONFORM:	HRRES HWFMT		;ALLOW MULTI-FORMAT LISTING
	RET
OFFORM:	HRROS HWFMT		;HALF-WORD FORMAT ONLY
	RET >

   IFE FORMSW,<
	SYN CPOPJ,ONFORM
	SYN CPOPJ,OFFORM>
HIGHQ:
HIGHQ1:	MOVE V,LOCO		;GET ASSEMBLY LOCATION
	SKIPN MODO		;IF ASSEMBLY MODE IS ABSOLUTE
	JRST [CAMLE V,ABSHI	;RECORED ABS HIGHEST ALSO
		MOVEM V,ABSHI
		RET]
	SKIPE HMIN		;IS IT A TWO SEGMENT PROGRAM?
	JRST [CAMGE V,HMIN	;YES,IS THIS HIGH SEG.?
		JRST .+1	;NO,STORE LOW SEGMENT
		CAMLE V,HHIGH	;YES,IS IT GREATER THAN "HHIGH"?
		MOVEM V,HHIGH	;YES,REPLACE WITH LARGER VALUE
		RET]
	CAMLE V,HIGH		;IS IT GREATER THAN "HIGH"?
	MOVEM V,HIGH		;YES, REPLACE WITH LARGER VALUE
	RET

ONML:	TLZA FR,MWLFLG		;MULTI-WORD LITERALS OK
OFFML:	TLO FR,MWLFLG		;NO
	RET

OFFSYM:	SETOM IONSYM		;SUPRESS SYMBOL TABLE LISTING
	RET

SUPRE0:	CALL GETSYM		;GET A SYMBOL TO SUPRES
	JRST SUPRE1		;ERROR
	CALL SSRCH		;SYMBOL ONLY
	  JRST SUPRE1		;GIVE ERROR MESSAGE
	CALL SUPSYM		;SEE IF "!" SEEN
	TLOA ARG,SUPRBT		;SET THE SUPRESS BIT
SUPRE1:	TROA ER,ERRA
	IORM ARG,(SX)		;PUT BACK
	JUMPCM SUPRE0		;ANY MORE?
	JRST SUPRS1

SUPRSA:	CALL LOOKUP		;SUPRESS ALL
	MOVSI ARG,SUPRBT
	IORM ARG,(SX)
SUPRS1:	SETZM EXTPNT		;JUST IN CASE WE LOOKED ONE UP
   IFN FTPSECT,<		;[575]
	TLZ IO,RSASSW		;...
   >
	RET

XPUNG0:	JUMP1 CPOPJ		;[664]
	CALL LOOKUP
	MOVE ARG,(SX)		;GET SYMBOL FLAGS
	TLNN ARG,INTF!ENTF!EXTF!SPTR
	TLOA ARG,SUPRBT		;LOCAL SYMBOL,SO SUPPRESS IT
	SETZM EXTPNT
   IFN FTPSECT,<		;[575]
	TLZ IO,RSASSW		;...
   >
	MOVEM ARG,(SX)		;RESTORE FLAGS
	RET

NODDT0:	CALL GETSYM		;GET A SYMBOL TO SUPRES
	  JRST NODDT1		;ERROR
	CALL SSRCH		;SYMBOL ONLY
	JRST [CALL MSRCH	;[670] ALLOW OPDEF
		JRST NODDT1	;[670] OTHERWISE GIVE ERROR
		TLNE ARG,OPDF	;[670]
		JRST .+1	;[670]
		JRST NODDT1]	;[670]
	CALL SUPSYM		;SEE IF "!" SEEN
	TLOA ARG,NOOUTF		;SET THE NO-DDT BIT
NODDT1:	TROA ER,ERRA
	IORM ARG,(SX)		;PUT BACK
	JUMPCM NODDT0		;ANY MORE?
	JRST SUPRS1

SUPSYM:	CAIE C,'!'		;WANT NO DDT OUTPUT FOR THIS SYMBOL?
	RET			;NO
	TLO ARG,NOOUTF		;YES, SET FLAG
	PJRST BYPASS		;[664] SKIP "!" AND RETURN

; .CREF SYMBOL,SYMBOL,ETC
ONCRF:	CALL GETSYM		;SEE IF A SYMBOL SPECIFIED
	  JRST [MOVSI AC0,IONCRF ;NO, PUT FLAG BACK
		TRZ ER,ERRA	;CLEAR "A" ERROR
		TLZ IO,DEFCRS	;CLEAR ANY WAITING DEFINING OCCURENCES
		JRST IORSET]
ONCRF0:	CALL SEARCH		;GENERAL SEARCH
	  JRST ONCRFE		;ERROR
	MOVSI ARG,NCRF		;NO CREF FLAG IN ARG
	ANDCAM ARG,(SX)		;TURN OFF NO CREF BIT
	CAMN AC0,1(SX)		;OTHER ENTRY IN SYMBOL TABLE?
	 ANDCAM ARG,2(SX)	;TURN OFF NCRF
	CAMN AC0,-3(SX)		;OTHER ENTRY IN SYMBOL TABLE
	 ANDCAM ARG,-2(SX)	;TURN OFF NCRF
	CAIA
ONCRFE:	TRO ER,ERRA		;SET ERROR CONDITION
	JUMPNC SUPRS1		;GIVE UP IF NO MORE
	CALL GETSYM		;GET NEXT SYMBOL
	  JRST ONCRFE		;ERROR
	JRST ONCRF0

; .XCREF SYMBOL,SYMBOL,ETC
OFFCRF:	CALL GETSYM		;SEE IF A SYMBOL SPECIFIED
	  JRST [MOVSI AC0,IONCRF ;PUT FLAG BACK
		TRZ ER,ERRA	;CLEAR "A" ERROR
		JUMP1 CPOPJ	;[1063] EXIT ON PASS1
		TDO IO,AC0	;[1063] SET APPROPRIATE FLAGS
		RET]		;[1063]
OFCRF0:	CALL SEARCH		;GENERAL SEARCH
	  JRST OFCRFE		;ERROR
	MOVSI ARG,NCRF		;NO CREF FLAG IN ARG
	IORM ARG,(SX)		;SET NO CREF BIT
	CAMN AC0,1(SX)		;OTHER ENTRY IN SYMBOL TABLE?
	 IORM ARG,2(SX)		;SET BIT
	CAMN AC0,-3(SX)		;OTHER ENTRY IN SYMBOL TABLE?
	 IORM ARG,-2(SX)	;SET BIT
	CAIA
OFCRFE:	TRO ER,ERRA		;FLAG ERROR
	JUMPNC SUPRS1		;GIVE UP IF NO MORE SYMBOLS
	CALL GETSYM		;GET NEXT SYMBOL
	  JRST OFCRFE		;ERROR
	JRST OFCRF0
TITLE0:	SKIPE TTLFND		;[1123] TITLE ALREADY SEEN FOR THIS MODULE?
	JRST [  TRO ER,ERRQ	;[1123] YES - GENERATE Q ERROR
		JRST REMAR0]	;[1123] AND IGNORE THE REST
	MOVEI SX,.TBUF
	HRRI AC0,TBUF
	CALL SUBTT1		;GO READ IT
	MOVEM SX,TCNT		;SAVE COUNT OF CHARS. WRITTEN
	SETOM TTLFND		;[1123] INDICATE TITLE SEEN
	JUMP2 REMAR0		;[1123] SKIP REST DURING PASS 2
	SKIPE UNIVSN		;[1123] WAS IT A UNIVERSAL?
	CALL ADDUNV		;[1123] YES - ADD TO TABLE
   IFN CCLSW,<JRST PRNAM>	;PRINT NAME IF FIRST ONE
   IFE CCLSW,<RET>		;EXIT OTHERWISE

SUBTT0:	JUMP1	[SKIPE SBUF	;PASS1, FIRST SUBTTL?
		JRST REMAR0	;NO,
		MOVE SX,PAGENO	;YES, CHECK PAGE NUMBER
		CAIE SX,1	;PAGE 1?
		JRST REMAR0	;NO,
		JRST .+1]	;YES,
	MOVEI SX,.SBUF
	HRRI AC0,SBUF
SUBTT1:	CALL BYPASS		;[664] BYPASS LEADING BLANKS
	TLO IO,IORPTC
SUBTT3:	CALL CHARAC		;GET ASCII CHARACTER
	IDPB C,AC0		;STORE IN BLOCK
	CAIGE C,40		;TEST FOR TERMINATOR
	CAIN C,HT
	SOJG SX,SUBTT3		;TEST FOR BUFFER FULL
	DPB RC,AC0		;END, STORE TERMINATOR
	SOJA SX,REMAR1		;COUNT NULL AND EAT UP ANY REMAINING CHARS.
   IFN CCLSW,<
PRNAM:	TLNN IO,CRPGSW		;NOT IF NOT RPG
	RET
	PUSH P,AC0		;SAVE AC0 DMN
	PUSH P,RC		;AND RC
	MOVE AC0,[POINT 7,TBUF]
	MOVE SX,[POINT 7,OTBUF]
	MOVEI RC,6		;MAX OF SIX CHRS
	MOVEI C,HT		;START WITH A TAB
	IDPB C,SX
PN1:	ILDB C,AC0
	CAILE C," "		;CHECK FOR LEGAL
	CAILE C,"Z"+40		;CHECK AGAINST LOWER CASE Z
	JRST PN2
	PUSH P,C		;SAVE CHAR
	CAILE C,137		;GET RADIX-50 VALUE FROM CSTAT
	SUBI C,40
	SUBI C,40
	LDB CS,[POINT 6,CSTAT(C),23]
	POP P,C
	SKIPN CS		;RADIX-50?
	JRST PN2		;NO, TREAT AS TERMINATOR
	IDPB C,SX		;PUT IN OUTPUT BUFFER
	SOJG RC,PN1		;GET MORE
PN2:	MOVEI C,CR		;END WITH CR-LF
	IDPB C,SX
	MOVEI C,LF
	IDPB C,SX
	SETZ C,			;TERMINATOR
	IDPB C,SX
	TTCALL 3,OTBUF
	POP P,RC
	POP P,AC0		;RESTORE AC0 DMN
	RET
   >
SYN0:	CALL GETSYM		;GET THE FIRST SYMBOL
	  JRST ERRAX		;ERROR, EXIT
	CALL MSRCH		;TRY FOR MACRO/OPDEF
	  JRST SYN3		;NO, TRY FOR OPERAND
SYN1:	MOVEI SX,MSRCH		;YES, SET FLAG
SYN2:	JUMPNC ERRAX		;ERROR IF NO COMMA
	PUSH P,ARG		;SAVE SOME REGISTERS
	PUSH P,RC
	PUSH P,V
	PUSH P,SX		;SAVE SEARCH ROUTINE
	CALL GETSYM		;GET THE SECOND SYMBOL
	  JRST [SUB P,[4,,4]	;PUT STACK BACK
		RET]		;AND GIVE UP
	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	TLO IO,IONCRF		;[1143] DO NOT CREF FIRST SEARCH
	CALL OPCFIX		;[736] FIX UP SYMTAB IF FORW-REF'ED
	TLZ IO,IONCRF		;[1143] ALLOW CREFFING AGAIN
	TLO IO,DEFCRS		;[1143] INDICATE DEFINITION
	POP P,SX		;RESTORE SEARCH ROUTINE
	CALL @SX		;SEARCH FOR SECOND SYMBOL
	  JFCL
	TRZ FRR,NOUNVS		;[713] SEARCH UNIVERSALS AGAIN
	POP P,V			;RESTORE VALUES
	POP P,RC
	POP P,ARG
	TLNE ARG,MACF		;MACRO?
	CALL REFINC		;YES, INCREMENT REFERENCE
	JRST INSERT		;INSERT AND EXIT

SYN3:	CALL SSRCH		;SEARCH FOR OPERAND
	  JRST SYN4		;NOT FOUND, TRY OP CODE
	TLO ARG,SYNF		;FLAG AS SYNONYM
	TLNE ARG,EXTF		;EXTERNAL?
	HRRZ V,ARG		;YES, RELPACE WITH POINTER
	MOVEI SX,SSRCH		;SET FLAG
	TLNN ARG,VARF		;DO NOT LET HIM SYN A VARIABLE
	JRST SYN2
	JRST ERRAX

SYN4:	CALL OPTSCH		;SEARCH FOR OP-CODE
	  JRST ERRAX		;NOT FOUND, EXIT WITH ERROR
	MOVSI ARG,SYNF		;FLAG AS SYNONYM
	SKIPN UWVER		;WRITING A UNIVERSAL FILE?
	JRST SYN1		;NO,
	MOVE AC1,FREE		;YES, GET A FREE WORD
	ADDI AC1,1
	CAML AC1,SYMBOL		;NO MORE ROOM?
	CALL XCEEDS		;GET MORE ROOM
	EXCH AC1,FREE		;UPDATE FREE
	MOVEM AC0,(AC1)		;KEEP THE SIXBIT OPERATOR
	MOVE V,AC0
	HRR ARG,AC1		;KEEP THE POINTER
	TLO ARG,SIXF		;SET FLAGS FOR POINTER TO SIXBIT
	BITON USYN,UWVER	;SET NEW-SYN-HANDLING BIT IN UNV VERSION #
	JRST SYN1		;CONTINUE...
PURGE0:	CALL GETSYM		;GET A MNEMONIC
	  JRST [TRZ ER,ERRA	;CLEAR ERROR
		RET]		;AND RETURN
	CALL MSRCH		;SEARCH MACRO SYMBOL TABLE
	  JRST PURGE2		;NOT FOUND, TRY SYMBOLS
	PUSH P,CS		;SAVE CS AS IT MAY GET GARBAGED
	TLNE ARG,MACF		;MACRO?
	CALL REFDEC		;YES, DECREMENT THE REFERENCE
	POP P,CS
	JRST PURGE4		;REMOVE SYMBOL FROM TABLE

PURGE2:	CALL SSRCH		;TRY OPERAND SYMBOL TABLE
	JRST PURGE5		;NOT FOUND GET NEXT SYMBOL
PURGE4:	CALL REMOVE		;REMOVE FROM THE SYMBOL TABLE
	SETZM EXTPNT		;IN CASE UNDEF OR EXT SYMBOL
PURGE5:	JUMPCM PURGE0		
	RET			;EXIT
OPD1:	TLNE ARG,UNDF		;IF OPDEF IS UNDEFINED
	TRO ER,ERRO		;GIVE "O" ERROR
OPD:	MOVE AC0,V		;PUT VALUE IN AC0
   IFE POLISH,< JRST OP>	;[772]
   IFN POLISH,<			;[772]
	JUMPGE RC,OP		;[772] 
	PUSH P,[POLFWF]		;[772] HERE ONLY IF POLISH OPDEF REFC'ED
	POP P,POLTYP		;[772] MUST BE FULL WORD FIXUP
	CALL POLPOP		;[772] GO FINISH UP THE POLISH STACK
	SETZB RC,EXTPNT		;[772] CLEAR RELOCATION AND EXTERNAL PTR
	JRST STOW>		;[772] EXIT THRU STOW

IOP:	MOVSI AC2,(POINT 9,0(P),11)
   IFE FORMSW,< TLOA IO,IOIOPF>	;SET "IOP SEEN" AND SKIP
   IFN FORMSW,< PUSH P,IOFORM	;USE I/O FORM
	JUMPAD .+2		;IF IN ADDRESS FIELD, SKIP
	SETOM IOSEEN		;SIGNAL  FOR BOUT TO ADJUST FIELDS
	TLO IO,IOIOPF		;SET "IOP" SEEN
	JRST OP+2>

OP:	MOVSI AC2,(POINT 4,0(P),12)
   IFN FORMSW,< PUSH P,INFORM>	;USE INST. FORM
   IFN POLISH,<
	TRZN FRR,EXPSW		;[634] SKIPE IF DOING EXP
	SETOM POLTYP		;[634] REST MUST BE RIGHT HALF FIXUP
   >
	TLO IO,FLDSW		;[634] WE HAVE A OPTR, REST IS ADDR.
	PUSH P,RC
	PUSH P,AC0		;STACK CODE 
	PUSH P,AC2
	CALL EVALEX		;EVALUATE FIRST EXPRESSION
	POP P,AC2
	JUMPNC OP2
OP1B:	CALL GETCHR		;GET A CHARACTER
   IFE FORMSW,<JUMPCM XWD5>	;PROCESS COMMA COMMA IN XWD
   IFN FORMSW,<JUMPNC .+4	;JUMP IF NO COMMA
	MOVE AC2,HWFORM		;GET FORM WORD FOR XWD
	MOVEM AC2,-2(P)		;REPLACE INSTRUCTION FORM
	JRST XWD5>		;PROCESS COMMA COMMA IN XWD
	TLO IO,IORPTC		;NOT A COMMA,REPEAT IT
	TLZE FR,INDSW		;[1076] HAS '@' BEEN SEEN?
	TRO ER,ERRQ		;[1076] YES - CLEAR AND GIVE 'Q' ERROR
	LDB AC1,AC2
	ADD AC1,AC0
	DPB AC1,AC2
   IFN POLISH,<
	TLNN FR,POLSW		;DON'T ALLOW EXTERNAL ACS
   >
	JUMPE RC,OP1A		;EXTERNAL OR RELOCATABLE?
	CALL QEXT		;YES, DETERMINE WHICH AND FLAG AN ERROR

OP1A:	CALL EVALEX		;GET ADDRESS PART
OP2:	CALL EVADR		;EVALUATE STANDARD ADDRESS
OP3:	POP P,AC0		;PUT IN AC0
	POP P,RC
	JUMPL RC,OP3A		;[1012] JUMP IF POLISH
	TLNN RC,-2		;[1012] LEFT EXTERNAL?
	SKIPA			;[1012] NO,
	HLLM RC,EXTPNT		;[1047][1012] YES, RECOVER EXTPNT FROM RC
OP3A:				;[1012]
   IFN FORMSW,< POP P,AC1>	;GET FORM WORD
   IFN POLISH,<
	JUMPGE RC,OP4		;[624] JUMP IF NOT POLISH
	SKIPN INOPDF		;[624] OPDEF?
	JRST OP4		;[624] NO, JUMP
	MOVE PS,CSTAT+'+'	;[624] YES, ADD OP FIELD AND ADR FILED
	CALL CFORCP		;[706][624] IN A POLISH BLOCK
   >
OP4:	SETZ PR,		;[747]
	SKIPE (P)		;[624] CAME FROM EVALCM?
	JRST STOW		;NO,STOW CODE AND EXIT
	POP P,AC1		;YES,EXIT IMMEDIATELY
	RET

   IFN FORMSW,<
INFORM:	BYTE  (9) 1 (4) 1 (1) 1 (4) 1 (18) 1
IOFORM:	BYTE (3) 1 (7) 1 (3) 1 (1) 1 (4) 1 (18) 1
   >
EVADR:				;EVALUATE STANDARD ADDRESS
   IFE IIISW,<TLNN AC0,-1	;OK IF ALL 0'S
	JRST .+4		;IT WAS
	TLC AC0,-1		;CHANGE ALL ONES TO ZEROS
	TLCE AC0,-1		;OK IF ALL 1'S
	TRO ER,ERRQ>		;NO,FLAG Q ERROR
	ADD AC0,-1(P)		;ADD ADDRESS PORTIONS
	HLL AC0,-1(P)		;GET LEFT HALF
	TLZE FR,INDSW		;INDIRECT BIT?
	TLO AC0,(Z @)		;YES, PUT IT IN
	MOVEM AC0,-1(P)		;RE-STACK CODE
	JUMPE RC,[MOVE RC,-2(P)	;[767] UPDATE RELOCATION
		JRST EVADR4]	;[767]
	SKIPE -2(P)		;[767] MAKE SURE ONE OF THEM IS ZERO
	JRST [	TDNE RC,-2(P)	;[767] OTHERWISE ,MAKE SURE NOT IN THE SAME HALF
		TROA ER,ERRR	;[767] STUFF IN SAME HALF, RELOCATION ERROR
		ADD RC,-2(P)	;[767] DIFFERENT HALVES, ADD THEM
		JRST .+1]	;[767]
	MOVEM RC,-2(P)		;[767]
EVADR4:				;[767]
   IFN POLISH,<
	JUMPGE RC,EVADR1	;[634] JUMP IF NOT POLISH
	JUMPE AC0,EVADR2	;[634] DOING POLISH, JUMP IF NO CODE
	SKIPE INANGL		;[730] IN <...>?
	JRST EVADR2		;[730] YES,
	PUSH P,RC		;[634] THERE IS SOMETHING, WE NEED AN AC
	HRRZ RC,POLTYP		;[634]  FOR THE TYPE OF FIXUPS
	CAIN RC,-3		;[634] FULLWORD?
	JRST [TRO ER,ERRQ	;[634] YES, ERROR
		JRST EVADR3]	;[634] JUMP
	CAIN RC,-1		;[634] RIGHT HALF FIXUP?
	TRNN AC0,-1		;[634]  AND STUFF IN RIGHT HALF?
	SKIPA			;[634] NO, O.K. THEN
	JRST [TRO ER,ERRQ	;[634] YES, ERROR
		JRST EVADR3]	;[634] JUMP
	CAIN RC,-2		;[634] LEFT HALF FIXUP?
	TLNN AC0,-1		;[634]  AND STUFF IN LEFT HALF?
	SKIPA			;[634] NO,
	TRO ER,ERRQ		;[634] YES, ERROR
EVADR3:	POP P,RC		;[634] RESTORE AC RC
EVADR2:	SKIPN INOPDF		;[634] POLISH IN OPDEF?
	SKIPE INASGN		;[634] NO, DOING ASSIGN?
	MOVEM RC,-2(P)		;[634] YES, USED POLISH PTR
   >
EVADR1:				;[634]
    IFN POLISH,<		;[1114]
	SKIPE PLHIDX		;[1114] LH INDEX VALUE SAVED FROM POLISH?
	JRST [	MOVE AC0,PIDXVL	;[1114] YES - GET VALUE
		MOVE RC,PIDXRC	;[1114] AND RC
		TRNE RC,-2	;[1114] EXTERNAL PTR?
		HRLM RC,EXTPNT	;[1114] YES - FIXUP EXTERN PTR
		JRST EVADR6]	;[1114] REJOIN INDEX CODE
    >				;[1114]
	CAIE C,10		;"("?
	RET			;NO, EXIT

	TRO FRR,IDXSW		;[1107] SET OP INDEXING
   IFN POLISH,<			;[1107]
	PUSH P,POLTYP		;[1107] SAVE FIXUP TYPE
	PUSH P,[POLFWF]		;[1107] DO FULL WORD FIXUP
	POP P,POLTYP		;[1107] IN CASE OF POLISH
   >				;[1107]
	MOVSS EXTPNT		;WFW
	CALL EVALCM		;EVALUATE
	MOVSS EXTPNT		;WFW
   IFN POLISH,<			;[1107]
	POP P,POLTYP		;[1107] RESTORE FIXUP TYPE
	TRNE FRR,FWPSW		;[1107] WAS POLISH GENERATED?
	TRO ER,ERRR		;[1107] YES - FLAG ERROR
   >				;[1107]
	TRZ FRR,IDXSW		;[1107] CLEAR OP INDEXING
EVADR6:				;[1114] HANDLE THE INDEXING EXPRESSION
	MOVSS V,AC0		;SWAP HALVES
   IFE IIISW,<MOVSS SX,RC
	IOR SX,V		;MERGE RELOCATION
	TRNN SX,-1		;RIGHT HALF ZERO?
	JRST OP2A		;YES, DO SIMPLE ADD
	MOVE ARG,RC>		;NO, SWAP RC INTO ARG
   IFN IIISW,<MOVSS ARG,RC>
	ADD V,-1(P)		;ADD RIGHT HALVES
	ADD ARG,-2(P)
	HRRM V,-1(P)		;UPDATE WITHOUT CARRY
	HRRM ARG,-2(P)
	HLLZS AC0		;PREPARE LEFT HALVES
	HLLZS RC
   IFE IIISW,<TLNE SX,-1	;IS LEFT HALF ZERO?
	TRO ER,ERRQ		;NO FLAG FORMAT ERROR
OP2A:	TLNE RC,-1		;RELOCATION FOR LEFT HALF?
	CALL OP2A1		;YES,IS IT LEGAL?
	TLNE AC0,777000		;OP CODE FIELD USED?
	JRST [EXCH AC0,-1(P)	;YES, GET STORED CODE
		TLNE AC0,777000	;OP CODE FIELD BEEN SET?
		TRO ER,ERRQ	;YES, MOST LIKELY AN ERROR
		EXCH AC0,-1(P)
		JRST .+1]>	;RETURN TO ADD 
	ADDM AC0,-1(P)		;MERGE WITH PREVIOUS VALUE
	ADDM RC,-2(P)
    IFN POLISH,<		;[1114]
	SKIPE PLHIDX		;[1114] LH INDEX SAVED FROM POLISH?
	JRST [	SETZM PLHIDX	;[1114] YES - CLEAR FLAG
		TLO IO,IORPTC	;[1114] NEXT CHAR MAY BE SIGNIFICANT
		JRST BYPASS]	;[1114] AND SKIP CHECK
    >				;[1114]
	CAIE C,11		;")"?
	JRST ERRAX		;NO, FLAG ERROR
				;YES, BYPASS PARENTHESIS
BYPASS:	CALL GETCHR		;[664]
BYPAS2:	JUMPE C,.-1		;SKIP TRAILING BLANKS
	RET			;EXIT
   IFE IIISW,<
OP2A1:	EXCH RC,-2(P)		;GET STORED CODE
	TLNN RC,-1		;OK IF ALL ZERO
	JRST OP2A2		;OK SO RETURN
	TLC RC,-1		;CHANGE ALL ONES TO ZEROS
	TLCE RC,-1		;OK IF ALL ONES
	TRO ER,ERRQ		;OTHERWISE A "Q" ERROR
OP2A2:	EXCH RC,-2(P)		;GET RC,BACK
	RET>			;AND RETURN

EXPRES:	HRLZ AC0,CURADX		;[613] FUDGE FOR OCT0
OCT0:	PUSH P,CURADX		;[613] PUSH CURRENT RADIX
	HLRM AC0,CURADX		;[613]
   IFN POLISH,<
	HRREI AC0,POLFWF	;PRESET POLISH TYPE SINCE WE
	MOVEM AC0,POLTYP	;NEED FULL WORD FIXUPS IF POLISH
	TRO FRR,EXPSW		;[634] FLAG FOR DOING EXP, DON'T CHANGE FWF
   >
OCT1:	CALL EVALEX		;EVALUATE
	TLZE FR,INDSW		;[1115] INDIRECT DANGLING?
	TRO ER,ERRQ		;[1115] ERROR IF NOT ENCLOSED IN BRACKETS
   IFN POLISH,<
	TLNN RC,-1		;[1106] DO WE HAVE ABSOLUTE LEFT HALF
	TRNN RC,-2		;[1106] AND EXTERNAL RIGHT HALF
	JRST OCT1A		;[1106] NO - DON'T DO FULLWORD
	TLNN AC0,-1		;[1106] WAS ABSOLUTE SPECIFIED
	CALL OCTFW		;[1106] NO - CAN DO FULL WORD FIXUP
OCT1A:				;[1106]
   >
   IFN FORMSW,< MOVE AC1,HWFORM>
	CALL STOW		;STOW CODE
	JUMPCM OCT1
	POP P,CURADX		;[613] YES, RESTORE RADIX
   IFN POLISH,<
	SETZM POLTYP		;CLEAR FLAG
   >
	RET			;EXIT

;HERE TO GENERATE FULL WORD FIXUPS FOR EXP EXTERN
;NOTE THIS GENERATES BLOCK TYPE 11 POLISH FIXUPS
;THESE CANNOT BE LOADER BY LOADER UNLESS FAILSW IS ON
   IFN POLISH,<
OCTFW:	JUMP1 [	TRO ER,ERRF
		RET]		;IGNORE ON PASS1
	MOVE PV,FREE		;COPY CODE FROM POLPOP
	EXCH PV,POLIST		;TO SET UP A NEW BLOCK
	CALL POLSTR		;STORE POINTER TO LAST
   IFN FTPSECT,<		;[641]
	SKIPN SGNCUR		;[641] DOING PSECTS?
	JRST OCTFW1		;[641] NO,
	HRRO PV,SGNCUR		;[641] YES, GET CURRENT PSECT NUMBER
	TRO PV,400000		;[641] MAKE IT INTO PSECT INDEX
	CALL POLSTR		;[641] AND STORE IN BLOCK
OCTFW1:
   >
	SKIPE CV		;[1110] IF EXTERNAL + VALUE
	JRST [	HRROI PV,3	;[1110] POLISH ADD OPERATION
		CALL POLSTR	;[1110] STORE IT
		MOVEI PV,1	;[1110] 36 BIT VALUE
		CALL POLSTR	;[1110] STORE
		SETZ PV,	;[1110] ABSOLUTE RELOCATION
		CALL POLSTR	;[1110] STORE
		MOVE PV,CV	;[1110] VALUE
		CALL POLSTR	;[1110] STORE IT
		JRST .+1]	;[1110]
	MOVE PV,EXTPNT		;GET POINTER TO EXTERNAL SYMBOL
	CALL POLFS2		;STORE EXTERNAL
	JRST POLOCT		;FIXUP ADDRESS, AND RETURN
   >
SIXB10:	MOVSI RC,(POINT 6,AC0)	;SET UP POINTER
	MOVEI AC0,0		;CLEAR WORD

SIXB20:	CALL CHARL		;GET NEXT CHARACTER
	CAMN C,SX		;IS THIS PRESET DELIMITER?
   IFE FORMSW,< JRST ASC60>	;YES
   IFN FORMSW,<
	JRST [	CALL BYPASS	;[664]
		ANDCM RC,STPX
		MOVE AC1,SXFORM
		SETZM INTXT	;NO LONGER IN TEXT
		TRZN FRR,WD2SW	;[607] DOING 2ND WORD?
		JRST STOWZ	;[607] NO, GENERATE A NULL WORD
		JUMPGE RC,STOWZ
		RET]>
	CAIL C,"A"+40
	CAILE C,"Z"+40
	JRST .+2		;[701]
	TRZA C,100		;[701] CONVERT LOWER CASE TO SIXBIT
	SUBI C,40		;[701] CONVERT UC TO SIXBIT
	JUMPL C,SIXB30		;[701] IF NOT LEGAL SIXBIT,
	CAILE C,77		;[701] FLAG A-ERROR AND TERMINATE
	JRST SIXB30		;[701]
	IDPB C,RC		;NO, DEPOSIT THE BYTE
	TLNE RC,770000		;IS THE WORD FULL?
	JRST SIXB20		;NO, GET NEXT CHARACTER
   IFN FORMSW,<
	SKIPA AC1,SXFORM	;SIXBIT FORM
SXFORM:	BYTE (6) 1,1,1,1,1,1
   >
	CALL STOWZ		;YES, STORE
	TRO FRR,WD2SW		;[607] SECOND WORD
	JRST SIXB10		;GET NEXT WORD

SIXB30:	TRO ER,ERRA		;[701]
	TRZ FRR,WD2SW		;[1024] CLEAR 2ND-WORD SWITCH
	TDZ CS,CS		;[701] IN CASE NESTED
	MOVE AC1,SXFORM		;[701]
	JRST ASC51		;[701]
%TEXT1:	TLC AC0,240000		;CONVERT .TEXT TO COMMENT ON PASS1
ASCII0:	HLLZ SDEL,AC0		;STORE ASCII/ASCIZ FLAG
ASC10:	CALL CHARL		;GET FIRST NON-BLANK
	SETZM NOTFL		;INITIALIZE TO FIRST LINE
	CAIE C," "
	CAIN C,HT
	JRST ASC10
	CAIG C,CR		;CHECK FOR CRRET AS DELIM
	CAIGE C,LF
	CAIA
	JRST ERRAX
	FORERR (SX,TXT)
	SETOM INTXT
	MOVE SX,C		;SAVE FOR COMPARISON
	JUMPG SDEL,SIXB10	;BRANCH IF SIXBIT

ASC20:	MOVSI RC,(POINT 7,AC0)	;SET UP POINTER
	TLNE SDEL,200000	;THIS BIT (AND BIT0) IN FOR COMMENT
	MOVSI RC,440000		;SO NOTHING WILL BE DEPOSITED
   IFE IIISW,<MOVEI AC0,0>	;CLEAR WORD
   IFN IIISW,<TLNE SDEL,100000	;ASCID?
	TLZA SDEL,400000	;YES, ZERO ASCIZ BIT
	TDZA AC0,AC0		;NO, ZERO WORD
	MOVE AC0,[BYTE (7) 10,10,10,10,10 (1) 1] >;YES, A WORD FULL OF BACKSPACES
ASC30:	CALL CHARL		;GET ASCII CHARACTER AND LIST
	JUMP1 ASC31		;JUMP ON PASS1
	SKIPL NOTFL		;FIRST LINE?
	AOS NOTFL		;YES, COUNT CHARS IF FIRST LINE
	CAIG C,FF		;LF, FF, OR VT?
	CAIGE C,LF
	JRST ASC31		;JUMP IF NO
	SKIPE LITLVL		;JUMP IF LITERAL AND NOT LITLST
	SKIPE LITLST
	JRST .+2		;ELSE
	JRST ASC31
	EXCH C,NOTFL		;EXCHANGE TEMPORARILY
	CAILE C,5		;WE HAVE AT LEAST 5 CHARS?
	SETO C,			;YES, NO LONGER FIRST LINE
	EXCH C,NOTFL		;RESTORE FROM THE EXCHANGE
ASC31:	CAMN C,SX		;TEST FOR DELIMITER
	JRST ASC50		;FOUND
	IDPB C,RC		;DEPOSIT BYTE
	TLNE RC,760000		;HAVE WE FINISHED WORD?
	JRST ASC30		;NO,GET NEXT CHARACTER
   IFN FORMSW,<
	SKIPA AC1,ASCIIF	;USE ASCII FORM WORD
ASCIIF:	BYTE (7) 1,1,1,1,1
   >
	TLNE SDEL,040000	;.TEXT ?
	JRST [CALL STOTXT	;YES, STORE IN REL FILE
		JRST ASC20]	;CONTINUE
	CALL STOWZ		;YES, STOW IT
	JRST ASC20		;GET NEXT WORD

ASC50:	TDZ RC,SDEL		;TEST FOR ASCIIZ
   IFE FORMSW,<ASC60:>		;[1024]
	CALL BYPASS		;[664] POLISH OFF TERMINATOR
	SKIPGE NOTFL		;FIRST LINE?
	SOS NOTFL		;NO, MAKE IT LAST LINE
   IFN FORMSW,< MOVE AC1,ASCIIF> ;USE ASCII FORM WORD
   IFN IIISW,<TLNN SDEL,100000>	;NO EXTRA WORDS FOR ASCID
ASC51:	ANDCM RC,STPX		;[701] STORE AT LEAST ONE WORD
	SETZM INTXT		;[701] FLAG OUT OF IT
	TLNN SDEL,200000	;GET OUT WITHOUT STORING
	JUMPGE RC,[TLNN SDEL,040000 ;.TEXT?
		JRST STOWZ	;NO, STOW
		JRST STOTXT]	;YES, STORE IN REL FILE
	RET			;ASCII, NO BYTES STORED, SO EXIT
; .TEXT PSEUDO-OP
%TEXT0:	JUMP1 %TEXT1		;IGNORE ON PASS1
	PUSH P,BLKTYP		;SAVE CURRENT TYPE
	CALL COUTD		;DUMP CURRENT BLOCK
	HLLZ SDEL,AC0		;FLAG BITS FOR ASCII
	SETZM BLKTYP		;DON'T KNOW IT YET
	CALL ASC10		;START PROCESSING
	CALL STOTXD		;FINISH BLOCK
	POP P,BLKTYP		;RESTORE PREVIOUS
	RET

STOTXT:	SKIPN BLKTYP		;FIRST WORD?
	JRST [MOVEM AC0,BLKTYP
		RET]		;SAVE AS BLOCK TYPE
	SKIPN COUTRB		;2ND WORD
	JRST [MOVEM AC0,COUTRB
		RET]
	AOS C,COUTX		;NO, JUST STORE AS NORMAL
	MOVEM AC0,COUTDB(C)
	CAIE C,^D17		;BUFFER FULL?
	RET			;NO

STOTXD:	SKIPN C,BLKTYP		;SEE IF ANY TEXT TO OUTPUT
	JRST COUTI		;NO JUST CLEAR COUNTS
	AOS COUTX		;ACCOUNT FOR STARTING FROM -1
	SETZM BLKTYP		;CLEAR BLOCKTYPE WORD FOR NEXT BLOCK
	TRNN C,177_1		;SEE IF RELOCATION WORD IS NEEDED
	AOS COUTRB		;FIRST WORD OF BLOCK WAS NOT FULL,
				;2ND WAS 0, PUT THE LSN BIT ON FOR
				;COUTD2 TO CHECK SO THERE WON'T BE
				;AN EXTRA 0 WORD IN THE FILE
	JRST COUTT		;DUMP BLOCK
POINT0:
   IFN FORMSW,< PUSH P,BPFORM>	;USE BYTE POINTER FORM WORD
	PUSH P,RC		;STACK REGISTERS
	PUSH P,AC0
   IFN POLISH,< TRO FRR,NOPSW>	;[751] NO POLISH FOR SIZE
	CALL EVAL10		;EVALUATE RADIX 10
   IFN POLISH,< TRZ FRR,NOPSW>	;[751]
	DPB AC0,[POINT 6,0(P),11] ;STORE BYTE SIZE
	JUMPNC POINT2
   IFN POLISH,< SETOM POLTYP>	;FORCE RIGHT-HALF FIXUP IF POLISH
	CALL EVALEX		;NO, GET ADDRESS
	CALL EVADR		;EVALUATE STANDARD ADDRESS
   IFN POLISH,< SETZM POLTYP>	;BACK TO NORMAL
	JUMPNC POINT2
   IFN POLISH,< TRO FRR,NOPSW>	;[751] NO POLISH FOR BYTE POSITION
	CALL EVAL10		;EVALUATE RADIX 10
   IFN POLISH,<TRZ FRR,NOPSW>	;[751] CLEAR FLAG
	TLNE IO,NUMSW		;IF NUMERIC
	TDCA AC0,[-1]		;POSITION=D35-RHB
POINT2:	MOVEI AC0,0		;OTHERWISE SET TO D36
	ADDI AC0,^D36
	LSH AC0,^D30
	ADDM AC0,0(P)		;UPDATE VALUE
	JRST OP3

IFN FORMSW,<
BPFORM:	BYTE (6) 1,1 (2) 1 (4) 1 (18) 1
   >

   IFN POLISH,<

;USE TO FORCE POLISH OPERATION CONTAINED IN PS
;	RC/	POL PTR
;	AC0/	CONSTANT
;	PS/	OPERATOR
;
FORCEP:	MOVEM RC,SAVRC		;[773]
	SETZB RC,SAVCV		;[773]
;	JRST FORCPP		;[733]

;THIS IS A GENERALIZE FORCEP-- 
;ASSUMES CV,RC,SAVCV, SAVRC ARE SETUP

FORCPP:	PUSH P,[TNODE,,0]	;[706]
	PUSH P,SAVCV		;[706] POPPED AS PV
	PUSH P,SAVRC		;[773] POPPED AS PR
	PUSH P,PS		;[733]
	MOVE CS,[11,33]		;[733] FAKE END
	JRST EVGETD		;[733]


CFORCP:	PUSH P,CS		;[706] CS GETS DESTROYED
	CALL FORCEP		;[706]
	POP P,CS		;[706]
	RET			;[706]
;HERE TO NEGATE A POLISH 
;	RC/	POL PTR
;SETS UP:
;	AC0/	0
;	PS/	'-'
;
FNEGP:	SETZB AC0,SAVCV		;[773]
	SETZM SAVRC		;[773]
	MOVE PS,CSTAT+'-'	;[727]
	PUSH P,CS		;[727]
	CALL FORCPP		;[773]
	POP P,CS		;[727]
	RET			;[727]
   >
XWD0:
   IFN FORMSW,< PUSH P,HWFORM>	;USE HALF WORD FORM
	PUSH P,RC
	PUSH P,AC0		;STORE ZERO ON STACK
   IFN POLISH,<
	MOVNI AC0,2		;FORCE LEFT HALF STORE
	MOVEM AC0,POLTYP	;IF POLISH
   >
	CALL EVALEX		;EVALUATE EXPRESSION
XWD5:				;[614]
   IFN POLISH,<
	SETOM INXWD		;[1010] DOING XWD
	TLNN FR,POLSW		;[614] USED POLISH?
	JRST XWD1		;[614] NO,
	SETZM EXTPNT		;CLEAR RHS NOW
	TRZ FRR,FWPSW		;[614] NOT FULL WORD
	TRO FRR,LHPSW		;[614] MAKE IT LEFT HALF FIXUP
XWD1:	SKIPE INANGL		;[706] IF IN ANGBRKTS, SEE IF POL
	CALL [	PUSH P,RC	;[1013][706] NEED AN AC
		MOVE RC,INANGL	;[1013][706] IF INANGL IS A PTR,
		CAMN RC,[-1]	;[1013][706]
		JRST [	POP P,RC ;[1013] -1, RECOVER RC
			RET]	;[1013] AND RETURN
		CALL MOVSTK	;[1013] MOVE TO FREE SPACE
		MOVEM RC,INANGL	;[1050] RECOVER PREVIOUS INANGL
		MOVEM RC,XWDANG	;[1013][706] AND SAVE IN XWDANG (FOR ANGPOL)
		POP P,RC	;[1013][706]
		RET]		;[706]
XWD2:>				;[706] END IFN POLISH
	JUMPNC OP2		;[706][614]
	SKIPN (P)		;ANY CODE YET?
	JRST XWD10		;NO,USE VALUE IN AC0
	JUMPE AC0,.+2		;ANYTHING IN AC0?
	TRO ER,ERRQ		;YES,FLAG "Q"ERROR
	MOVE AC0,(P)		;USE PREVIOUS VALUE
	MOVE RC,-1(P)		;AND RELOCATION
XWD10:	TLNN AC0,-1		;LEFT HALF SHOULD BE ZERO
	JRST XWD11		;IT IS
	TLC AC0,-1		;OR AT LEST ALL ONES
	TLCE AC0,-1		;FOR XWD -1,-2 ETC
	TRO ER,ERRQ		;NO, WARN USER
XWD11:	HRLZM AC0,0(P)		;SET LEFT HALF
	HRLZM RC,-1(P)
	MOVSS EXTPNT		;WFW
   IFN POLISH,<
	SETOM POLTYP		;FORCE RHS FIXUP
   >
	JRST OP1A		;EXIT THROUGH OP
IOWD0:
   IFE POLISH,< CALL EVALQ >	;EVALUATE AND TEST FOR EXTERNAL

   IFN POLISH,<
	SKIPN INANGL		;[730] IN ANGLE-BRACKETS?
	SETOM INIOWD		;[730] NO,
	MOVNI AC0,2		;FORCE LEFT HALF STORE
	MOVEM AC0,POLTYP	;IF POLISH
	CALL EVALEX		;EVALUATE ALLOWING EXTERNS
   >				;[730]
	CAIN RC,1		;[730] RELOCATABLE VALUE
   IFN POLISH,<			;[730]
	JRST IOWD02		;[730] GO SET R-ERROR
	SKIPN AC1,INANGL	;[730] IN ANGLE-BRACKETS?
	JRST IOWD01		;[730] NO,
	AOJGE AC1,IOWD01	;[730] JUMP IF NOT POLISH
	MOVE RC,INANGL		;[730] UPDATE RC
IOWD01:	JUMPE RC,IOWD1		;[730] DON'T BOTHER IF ABSOLUTE
	JUMP1 IOWD1		;[730] DON'T BOTHER IN PASS1
	CALL FNEGP		;[730] NEGATE EXTERNAL OR POLISH
	SKIPN INANGL		;[730] IN ANGLE-BRACKETS?
	JRST [	CALL POLSYM	;[730] NO, COMPLETE LH POLISH
		JRST IOWD1]	;[730]
	MOVE RC,INANGL		;[730] 
	CALL MOVSTK		;[730] YES, MOVE TO FREE SPACE
	MOVEM RC,XWDANG		;[730] SAVE LH POLISH PTR
	MOVEM RC,INANGL		;[730] UPDATE INANGL
	SETZ RC,		;[730]
	JRST IOWD1		;[730]
IOWD02:>			;[730]
	TRO ER,ERRR		;[730] R-ERROR
IOWD1:	JUMPNC [TRZ ER,ERRR	;[730] IN CASE SET BEFORE
		SKIPN AC0	;IF NZERO AND NO "," SEEN
		TRO ER,ERRQ	;TREAT AS Q ERROR
   IFN FORMSW,< MOVE AC1,HWFORM> ;USE HALF WORD FORM
		SOJA AC0,STOW]	;NO, TREAT AS RIGHT HALF
	MOVNS AC0		;[730] NEGATE LEFT HALF
	PUSH P,AC0		;YES, STACK LEFT HALF
				;[730] FALL THRU
;HERE FOR RIGHT HALF
	SETZM EXTPNT		;[730] CLEAR EXTERNAL POINTER
   IFN POLISH,< SETZM POLTYP>	;RIGHT HALF STORE BY DEFAULT
	CALL EVALEX		;WFW
   IFN POLISH,<
	SKIPN AC1,INANGL	;[730] IN ANGLE BRACKETS?
	JRST IOWD11		;[730] NO,
	CAMN AC1,XWDANG		;[730] YES,
	JRST IOWD12		;[730] JUMP IF LH POLISH
	AOJGE AC1,IOWD12	;[730] JUMP IF NOT POLISH
	MOVE RC,INANGL		;[730] GET POLISH PTR
	SKIPA			;[730]  AND SKIP
IOWD11:	TLZE FR,POLSW		;[730] DOING POLISH?
	JRST [	CALL MOVSTK	;[730] YES, MOVE CURRENT POLISH TO FREE SPACE
		JRST IOWDRP]	;[730] DO RH-1 POLISH
IOWD12:	SKIPE RC		;[730] ABSOLUTE?
	JUMP2 [	SKIPN INANGL	;[730] NO, MUST BE REL OR EXT
		JUMPN AC0,.+1	;[730] JUMP IF ADDITIVE GLOBAL NOT IN <>
		CAIN RC,1	;[730] JUMP IF
		JRST .+1	;[730]  RELOCATABLE
		SETZM EXTPNT	;[730] EXTERNAL
		JRST IOWDRP]	;[730] GO DO RH-1
   >
	SUBI AC0,1
IOWD2:	POP P,AC1		;RETRIEVE LEFT HALF
	HRL AC0,AC1
   IFN FORMSW,< SKIPA AC1,HWFORM ;USE HALF WORD FORM
HWFORM:	BYTE (18) 1,1>	;END IFN FORMSW
   IFN POLISH,< SETZM INIOWD>	;[730] CLEAR IOWD FLAG
	JRST STOW		;STOW CODE AND EXIT


;HERE IF  IOWD K,E  OR  IOWD K,POL SO THAT POLISH OF RH-1 IS NEEDED
;
   IFN POLISH,<			;[730]
IOWDRP:	MOVEI AC0,1		;[730]
	MOVE PS,CSTAT+'-'	;[730]
	CALL CFORCP		;[730] GO DO IT
	SKIPE INANGL		;[730]
	MOVE RC,INANGL		;[730]
	CALL MOVSTK		;[730]
	SKIPN INANGL		;[730] IN ANGLE-BRACKETS?
	JRST IOWDR1		;[730] NO,
	MOVEM RC,INANGL		;[730]
	SKIPA			;[737] CLEAR RC AND RETURN
IOWDR1:	CALL POLSYM		;[730] COMPLETE RH POLISH
	SETZ RC,		;[737] CLEAR RC
	JRST IOWD2		;[730]
   >				;[730]

BYTE0:	CALL BYPASS		;[664] GET FIRST NON-BLANK
   IFN POLISH,< SETZM BYTEAC>	;[777] ACCUMULATED BYTE SIZE SO FAR
	CAIE C,10		;"("?
	JRST ERRAX		;NO, FLAG ERROR AND EXIT
	SETOM BYTESW		;[1114] DOING BYTE PSEUDO-OP
   IFN FORMSW,< PUSH P,[1]
	MOVEI AC0,0>
	PUSH P,RC
	PUSH P,AC0		;INITIALIZE STACK TO ZERO
	MOVSI ARG,(POINT -1,(P))

BYTE1:	PUSH P,ARG
	CALL EVAL10		;EVALUATE RADIX 10
	POP P,ARG
	CAIG AC0,^D36		;TEST SIZE
	JUMPGE AC0,.+2
	TRO ER,ERRA
	DPB AC0,[POINT 6,ARG,11] ;STORE BYTE SIZE
   IFN POLISH,<			;[1067]
	MOVEM AC0,BYTESZ	;[1067] STORE CURRENT BYTE SIZE
	JRST BYTE2A		;[1067] FIRST TIME THROUGH
   >				;[1067]

BYTE2:
   IFN POLISH,<
	MOVE AC0,BYTESZ		;[777] GET CURRENT BYTE SIZE
BYTE2A:	CAIN AC0,^D36		;[1067] FULL WORD?
	JRST [	HRREI AC1,POLFWF ;[1067] YES, MAKE SURE FWF INCASE POLISH
		MOVEM AC1,POLTYP ;[1067] 
		SETZM INBYTE	;[1067] POLISH ALLOWED
		JRST BYTE2B]	;[1067]
	CALL HWCHK		;[1067] NOT FULL WORD, GO CHECK HALF WORD
	 SETOM INBYTE		;[1067] NO POLISH
BYTE2B:>			;[1067]
	IBP ARG			;INCREMENT BYTE
	TRZN ARG,-1		;OVERFLOW?
	JRST BYTE3		;NO
	SETZB AC0,RC		;YES
	EXCH AC0,0(P)		;GET CURRENT VALUES
	EXCH RC,-1(P)		;AND STACK ZEROS
   IFN FORMSW,<
	MOVE AC1,HWFORM		;USE STANDARD FORM
	EXCH AC1,-2(P)		;GET FORM WORD
   >
	CALL STOW		;STOW FULL WORD

BYTE3:	PUSH P,ARG
	CALL EVALEX		;COMPUTE NEXT BYTE
	POP P,ARG
   IFN POLISH,<			;[1067]
	SKIPN INBYTE		;[1067] POLISH ALLOWED?
	JRST BYTE3A		;[1067] YES
	TDNN RC,[-1,,-1]	;[1067][1077] RELOC OR EXTERN?
	JRST BYTE3A		;[1067] NEITHER
	TDNE RC,[-1,,-2]	;[1077] RH RELOCATABLE?
	JRST BYTE3B		;[1077] NO - ERROR FOR ANYTHING ELSE
	MOVE AC1,BYTESZ		;[1077] GET RELOC BYTE SIZE
	CAIG AC1,^D18		;[1077] MUST BE MORE THAN 18 BITS
	JRST BYTE3B		;[1077] TOO SMALL
	ADD AC1,BYTEAC		;[1077] ADD IN BYTE SIZE SO FAR
	CAIN AC1,^D36		;[1077] MUST BE RIGHT JUSTIFIED
	TLNE AC0,-1		;[1077] AND LH MUST BE ZERO
BYTE3B:	CALL QEXT		;[1067][1077] ERROR
BYTE3A:>			;[1067]
	DPB AC0,ARG		;STORE BYTE
	HLLO AC0,ARG
	DPB RC,AC0		;STORE RELOCATION

   IFN FORMSW,<
	MOVEI AC0,1
	HRRI ARG,-2
	DPB AC0,ARG		;STORE FORM BYTE
	HRRI ARG,0
   >
   IFN POLISH,<			;[777]
	MOVE AC1,BYTEAC		;[777] GET ACCUMULATED BYTE SIZE SO FAR
	ADD AC1,BYTESZ		;[777] ADD CURRENT BYTE SIZE
	CAIL AC1,^D36		;[777] EXCEEDED WORD SIZE?
	SUBI AC1,^D36		;[777] YES, ADJUST TO BYTE SIZE IN A WORD
	MOVEM AC1,BYTEAC	;[777] USED TO TEST HALFWORD ALIGNMENT
   >				;[777]
	JUMPCM BYTE2
   IFN POLISH,< SETZM INBYTE>	;[761] FLAG NO LONGER IN BYTE
	CAIN C,10		;"("?
	JRST BYTE1		;YES, GET NEW BYTE SIZE
	SETZM BYTESW		;[1114] DONE WITH BYTE
	JRST OP3		;NO, EXIT

;HERE TO CHECK IF WE HAVE HALF WORD BYTE AND IF IS HALF WORD ALIGNED
;SKIP RETURN IF OK, AND NON-SKIP RETURN IF NO POLISH

   IFN POLISH,<
HWCHK:	CAIE AC0,^D18		;[777] NOT FULL WORD, BUT HALF WORD?
	RET			;[777] NOT HALF WORD
	SKIPN AC1,BYTEAC	;[777] YES, BUT ALIGNED?
	JRST [	HRREI AC1,POLLHF ;[777] YES, IN LEFT HALF
		JRST HWCHK1]	;[777]
	CAIE AC1,^D18		;[777]
	RET			;[777] NO, NOT ALIGNED
	HRREI AC1,POLRHF	;[777] YES, IN RIGHT HALF
HWCHK1:	MOVEM AC1,POLTYP	;[777] UPDATE FIXUP TYPE IN CASE POLISH
	SETZM INBYTE		;[777] POLISH ALLOWED
	AOS 0(P)		;[777] SKIP RETURN
	RET			;[777]
   >
RADX50:	CALL EVALEX		;EVALUATE CODE
	JUMPN RC,ERRAX		;ERROR IF NOT ABSOLUTE
	JUMPNC ERRAX
	TDZE AC0,[EXP ^-74]	;MAKE SURE ONLY 74 BITS ON
	TRO ER,ERRQ		;NOPE, LIGHT Q ERROR
	PUSH P,AC0		;SAVE CODE BITS
	CALL GETSYM		;YES, GET SYMBOL
	TRZ ER,ERRA		;CLEAR ERROR
	POP P,ARG		;PUT CODE INTO ARG
	CALL SQOZE		;SQUOZE SIXBIT AND ADD CODE
   IFN FORMSW,< MOVE AC1,HWFORM> ;USE STANDARD FORM
	JRST STOW		;STOW CODE AND EXIT

SQOZE:	MOVE AC1+1,AC0		;PUT SIXBIT IN AC1+1
	MOVEI AC0,0		;CLEAR RESULT
SQOZ1:	MOVEI AC1,0
	LSHC AC1,6		;PUT 6-BIT CHARACTER IN AC1
	LDB AC1,[POINT 6,CSTAT(AC1),23] ;CONVERT TO RADIX50
	IMULI AC0,50		;MULTIPLY PREVIOUS RESULT
	ADD AC0,AC1		;ADD NEW CHARACTER
	JUMPN AC1+1,SQOZ1	;TEST FOR END
	LSH ARG,^D30		;LEFT-JUSTIFY CODE
	IOR AC0,ARG		;MERGE WITH RESULT
	RET
%LINK:	PUSH P,BLKTYP		;SAVE BLOCK TYPE
	PUSH P,AC0
	JUMP1 LINK1		;SKIP CODE GEN IF P1
	CALL COUTD
	MOVEI AC0,12		;LINK TYPE
	MOVEM AC0,BLKTYP
LINK1:	CALL EVALEX		;EVAL CHECK EXT
	POP P,AC1		;GET BITS BACK
	JUMPN RC,LNKERR		;MUST BE ABS
	JUMPNC LNKERR		;GRNTEE COMMA
	TLNE AC1,400000		;LNKEND?
	MOVN AC0,AC0		;YES, NEGATE RESULT
	JUMP1 LINK2		;SKIP IF P1
	CALL COUT
LINK2:	CALL EVALXQ		;NO EXTERNALS
	JUMPNC LINK2A		;THIRD ARGUMENT SPECIFIED?
	HRL AC0,RC		;YES, MUST FIRST SAVE THE
	PUSH P,AC0		;OLD VALUES OF RC, AC0
	CALL EVALXQ		;READ IN THIRD ARGUMENT
	MOVS AC0,AC0		;LINK EXPECTS LNKNXT IN THE
	MOVS RC,RC		;LEFT HELF OF SECOND WORD
	HRR AC0,(P)		;RESTORE LNKLOC VALUE
	HLR RC,(P)		;AND ITS RELOCATION BIT
	TLNE RC,1		;LNKXNT RELOCATABLE?
	 TRO RC,2		;YES, SET FOR COUT TO DEPOSIT
	SUB P,[1,,1]		;"POP" BOGUS WORD OF STACK
LINK2A:	JUMP1 LINK3
	CALL COUT		;DUMP LOC
	CALL COUTD		;FINISH BLOCK
LINK3:	POP P,BLKTYP		;RESTORE BLKTYP
	RET

LNKERR:	POP P,BLKTYP		;RESTORE BLOCK TYPE
	PJRST ERRAX		;GIVE ERROR RETURN
%INTEG:	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	CALL GETSYM		;GET A SYMBOL
	JRST INTG2		;BAD SYMBOL ERROR
	TLO IO,DEFCRS		;THIS IS A DEFINTION
	CALL SSRCH		;SEE IF THERE
	MOVSI ARG,SYMF!UNDF	;SET SYMBOL AND UNDEFINED IF NOT
	TLNN ARG,UNDF		;IF ALREADY DEFINED
	JRST INTG1		;JUST IGNORE
	TLOA ARG,VARF		;SET VARIABLE FLAG
INTG2:	TROA ER,ERRA		;SYMBOL ERROR
	CALL INSERZ		;PUT IN WITH ZERO VALUE (LENGTH OF 1)
INTG1:	JUMPCM %INTEG
	TRZ FRR,NOUNVS		;[713] SEARCH UNIVERSALS AGAIN
	RET

%ARAY:	MOVEM P,ARAYP		;SAVE PUSHDOW POINTER
ARAY2:	CALL GETSYM
	JRST ARAY1		;BAD SYMBOL GIVE ERROR AND ABORT
	PUSH P,AC0		;SAVE NAME
	JUMPCM ARAY2		;AND GO ON IF A COMMA
	CAIE C,"["-40		;MUST BE A [
	JRST ARAY1
	CALL BYPASS		;[664] OH, WELL
	TLO IO,IORPTC
	CALL EVALXQ		;GET A SIZE
	CAIE C,"]"-40		;MUST END RIGHT
	JRST ARAY1
	CALL BYPASS		;[664] ??
	HRRZ V,AC0		;GET VALUE
	SUBI V,1
NXTVAL:	POP P,AC0
	PUSH P,V		;SAVE OVER SEARCH
	TLO IO,DEFCRS
	TRO FRR,NOUNVS		;[1022][713] DON'T SEARCH UNIVERSALS
	CALL SSRCH		;FIND IT
	MOVSI ARG,SYMF!UNDF
	TRZ FRR,NOUNVS		;[1022][713] SEARCH UNIVERSALS AGAIN
	POP P,V			;GET VALUE BACK
	TLNE ARG,EXTF		;[674] E-ERROR IF EXTERNAL
	TRO ER,ERRE		;[674]
	TLNN ARG,UNDF
	JRST ARAY3
	TLO ARG,VARF
	MOVEI RC,0		;NO RELOC
	CALL INSERT
ARAY3:	CAME P,ARAYP
	JRST NXTVAL		;STILL NAMES STACKED
	JUMPCM ARAY2
	RET

ARAY1:	TRO ER,ERRA		;ERROR EXIT
	MOVE P,ARAYP
	TRZ FRR,NOUNVS		;[713] SEARCH UNIVERSALS AGAIN
	RET			;RESET PDL AND GO
; .COMMON SYMBOL [SIZE]
SYN ARAYP,COMMP			;SAVE SPACE

COMM0:	JUMP1 COMM1		;WASTE OF TIME ON PASS1
	CALL COUTD		;DUMP CURRENT BLOCK
	PUSH P,BLKTYP		;SAVE TYPE
	MOVEI AC0,20		;COMMON BLOCK TYPE
	MOVEM AC0,BLKTYP	;SET NEW
COMM1:	MOVEM P,COMMP		;SAVE PUSHDOWN POINTER
COMM2:	CALL GETSYM		;GET A 6-BIT SYMBOL NAME
	  JRST COMM7		;BAD SYMBOL, GIVE UP
	PUSH P,AC0		;SAVE SYMBOL NAME
	JUMPCM COMM2		;AND GET ANOTHER IF COMMA
	CAIE C,'['		;MUST BE A [
	JRST COMM7		;YOU LOSE
	CALL BYPASS		;[664] SKIP ANY LEADING SPACES
	TLO IO,IORPTC		;BUT NOT LAST CHAR
	CALL EVALXQ		;GET SIZE OF COMMON
	CAIE C,']'		;MUST END RIGHT
	JRST COMM7
	HRRZ V,AC0		;GET VALUE
				;PUSHDOWN STACK IS IN WRONG ORDER, REVERSE IT
	HRRZ RC,P		;TOP ITEM
	HRRZ ARG,COMMP		;BOTTOM ITEM
	ADDI ARG,1		;WELL ALMOST
COMM6:	CAIG RC,(ARG)		;ANYTHING TO MOVE?
	JRST COMM3		;NO
	MOVE 0,(RC)		;MOVE TOP
	EXCH 0,(ARG)		;TO BOTTOM
	MOVEM 0,(RC)
	SUBI RC,1		;DECREMENT
	AOJA ARG,COMM6		;AND TRY AGAIN

COMM3:	MOVE AC0,0(P)		;GET SYMBOL
	JUMP2 COMM3B		;DIFF CHECKS FOR EACH PASS
	CALL SEARCH		;PERFORM GENERAL SEARCH
	  JRST COMM3A		;NOT FOUND, GOOD
	JUMPL ARG,CMNERR 	;FOUND, OPERAND, WARN
	CAME AC0,-3(SX)		;MACRO, LOOK ONE SLOT BELOW
	JRST COMM3A		;NOT FOUND, CONTINUE
	JRST CMNERR		;WARNING

COMM3B:	SKIPE BNSN		;CODE STORED?
	JRST CMNERR		;YES, WARN USER
COMM3A:	POP P,AC0		;GET SYMBOL
	JUMP1 .+2		;IGNORE V ON PASS 1
	PUSH P,V		;SAVE VALUE
	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	CALL EXTER1		;DEFINE AS EXTERNAL(CLEAR NOUNVS)
				;NOTE, CS IS NOT ON A COMMA, SO WILL RETURN
	JUMP1 COMM4		;ALL DONE IF PASS1
	SETZ RC,		;NO RELOCATION
	MOVEI ARG,4		;FORM RADIX50 04,SYMBOL
	CALL SQOZE		;IN AC0
	CALL COUT		;OUTPUT SYMBOL
	POP P,V			;GET VALUE BACK
	MOVE AC0,V		;AND INTO AC0
	CALL COUT		;SECOND PART OF PAIR
COMM4:	CAME P,COMMP		;FINISHED WITH STACKED SYMBOLS
	JRST COMM3		;NO MORE TO GO
	CALL BYPASS		;[664] GET NEXT DELIMITER
	JUMPCM COMM2		;MORE TO GO IF COMMA NEXT
COMM5:	JUMP1 CPOPJ
	CALL COUTD		;DUMP THIS BLOCK
	POP P,BLKTYP		;RESTORE LAST
	RET

COMM7:	TRO ER,ERRA		;FLAG ERROR
	MOVE P,COMMP		;RESET PUSHDOWN POINTER
	JRST COMM5		;RESTORE BLKTYP AND EXIT

CMNERR:	PUSH P,['MCRSOC']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / STATEMENT OUT OF ORDER .COMMON@/] ;[1066] SYMBOL IN AC0
	CALL EWARN		;[1066] WARNING
	CALL TYPMSG
	AOS QERRS		;COUNT AS WARNING
	JRST COMM3A		;CONTINUE
; .REQUEST DEV:FILENAME[PPN]
REQUIR:	SKIPA CS,[16]		;BLOCK TYPE 16
REQUES:	MOVEI CS,17		;BLOCK TYPE 17
	JUMP1 REMAR0		;IGNORE ON PASS 1
	CALL COUTD		;DUMP CURRENT
	PUSH P,BLKTYP		;SAVE LAST BLOCK TYPE
	MOVEM CS,BLKTYP		;SET NEW
REQU0:
REPEAT 3,<PUSH P,[0]>		;STACK A NULL SPEC IN CASE OF ERROR
	CALL BYPASS		;[664] FLUSH EXTRA TABS AND SPACES
	TLO IO,IORPTC		;BACK OFF BECAUSE SCHGET
	CALL SCHGET		;GET PART OF A FILE SPEC
	JUMPE AC0,REQUER	;ERROR IF NOTHING
	CAIE C,':'		;WAS THERE A DEVICE
	JRST REQU1		;NO, GOOD GUESS
	MOVEM AC0,-2(P)		;SAVE DEVICE
	CALL SCHGET		;GET THE FILE NAME
	JUMPE AC0,REQUER	;ERROR IF NOTHING
REQU1:	MOVEM AC0,(P)		;STORE FILE NAME
	CAIN C,'.'		;SEE IF AN EXTENSION GIVEN
	JRST REQU4		;YES, GO SKIP IT AND MAKE SURE IT'S
REQU3:				;A .REL FILE, CAUSE THAT'S ALL IT CAN BE
	CAIE C,'['		;WAS THERE A PPN
	JRST REQU2		;NO, AS EXPECTED
	CALL BYPASS		;[664] SKIP ANY BLANKS
	TLO IO,IORPTC
	CALL EVALXQ		;GET HALF A PPN
	HRLM AC0,-1(P)		;STORE IT
	CALL EVALXQ		;GET OTHER HALF
	HRRM AC0,-1(P)		;STORE IT
	CAIE C,']'		;MUST END ON ]
	JRST REQUER		;IT DIDN'T
	CALL BYPASS		;[664] SCAN AFTER RIGHT BRACKET
REQU2:	SETZ RC,		;NO RELOCATION
	POP P,AC0		;GET FILE NAME
	CALL COUT
	POP P,AC0		;AND PPN
	CALL COUT
	POP P,AC0		;FINALLY DEVICE
	CALL COUT
	JUMPCM REQU0		;MORE TO COME
	CALL COUTD		;DUMP BLOCK
	POP P,BLKTYP		;RESTORE BLOCK TYPE
	RET			;NO

REQU4:	CALL SCHGET		;GO SCAN OUT EXTENSION
	HLRZ AC0,AC0		;SWAP FOR CAIE
	CAIE AC0,'REL'		;SEE IF IT'S FOR .REL
	TRO ER,ERRQ		;NOPE, TELL HIM ABOUT IT
	JRST REQU3		;BACK TO LOOK FOR PPN

REQUER:	SUB P,[3,,3]		;REMOVE THE THREE ITEMS
	POP P,BLKTYP		;RESTORE BLOCK TYPE
	JRST ERRAX		;AND GIVE UP
; NEW .DIRECTIVE PSEUDO-OP 
; ARGS ARE FUNCTIONS TO BE DONE
%DIREC:	MOVEI AC2,0		;INIT FLAG TO 'YES'
DIREC1:	CALL GETSYM		;GET THE SYMBOL
	  JRST ERRAX		;MISSING, GIVE ERROR
	CAMN AC0,[SIXBIT /NO/]	;'NO ...' ?
	JRST [	SKIPE AC2	;[720] FLAG NO NO ...WITH Q-ERROR
		TROA ER,ERRQ	;[720]
		SETO AC2,	;REVERSE FLAG
		JRST DIREC1]	;TRY AGAIN FOR FUNCTION
	MOVSI ARG,-DIRLEN	;AOBJN WORD
	CAMN AC0,DIRARG(ARG)	;LOOK FOR MATCH
	JRST DIRFND		;GOT IT
	AOBJN ARG,.-2		;LOOP FOR ALL OF TABLE
	JRST ERRAX		;NOT FOUND, GIVE ERROR

DIRFND:	XCT DIRXCT(ARG)		;DO FUNCTION
	JUMPCM %DIREC		;MORE IF COMMA
	RET			;OTHERWISE RETURN

;[1125] DEFINITION OF THE .DIRECTIVE PSEUDO-OP
;[1125] ARGS:	SIXBIT NAME OF ARGUMENT
;[1125]		INSTRUCTION TO EXECUTE WHEN THAT DIRECTIVE IS SPECIFIED
	DEFINE DIRMAK,<			;;[1125]
	X (.NOBIN,<CALL SETNOB>)	;;[1125] DON'T GENERATE REL FILE
	X (.ITABM,<SETCAM AC2,ITABM>)	;;[1125] INCLUDE TAB/SPACE IN MACRO ARGS
	X (.XTABM,<MOVEM AC2,ITABM>)	;;[1125] EXCLUDE TAB/SPACE IN MACRO ARGS
	X (SFCOND,<SETCAM AC2,IFXLSW>)	;;[1125] XLIST IN IF (FALSE)
	X (LITLST,<SETCAM AC2,LITLST>)	;;[1125] LIST BINARY IN LITERALS
	X (FLBLST,<CALL SETFLB>)	;;[1125] FIRST LINE BINARY LISTING ONLY
	X (MACPRF,<SETCAM AC2,MACPRF>)	;;[1125] MACRO DEF PREFERED OVER SYMBOL
	X (MACMPD,<CALL SETMPD>)	;;[1125] NEW MACRO ARG HANDLING
	X (KA10,<CALL SETKA>)		;;[1125] PUT KA10 TYPE IN HEADER BLOCK
	X (KI10,<CALL SETKI>)		;;[1125] PUT KI10 TYPE IN HEADER BLOCK
	X (KL10,<CALL SETKL>)		;;[1125] PUT KL10 TYPE IN HEADER BLOCK
	X (.OKOVL,<SETCAM AC2,OKOVFL>)	;;[1125] ALLOW /,* OVERFLOW
	X (.EROVL,<MOVEM AC2,OKOVFL>)	;;[1125] DON'T ALLOW /,* OVERFLOW
	X (.NOCAL,<SETOM NOUUO>)	;;[1125][1043][1041] DON'T SEARCH UUO TABLES
    IFN TSTCD,<				;;[1125]
	X (.TCDON,<CALL TCDSET>)	;;[1125][575] SET LINK DEBUGGING FLAG
	X (.TCDOF,<MOVEM AC2,TCDFLG>)	;;[1125] TURN LINK DEBUGGING OFF
    > ;END OF IFN TSTCD			;;[1125]
	> ;END OF DIRMAK		;;[1125]

	DEFINE X(A,B),<			;;[1125]
	SIXBIT \A\>			;;[1125]

;[1125] GENERATE THE .DIRECTIVE ARGUMENT NAME TABLE
DIRARG:	DIRMAK				;[1125]
DIRLEN==.-DIRARG			;[1125]

	DEFINE X(A,B),<			;;[1125]
	B>				;;[1125]

;[1125] GENERATE THE .DIRECTIVE INSTRUCTION TABLE (FOR XCT)
DIRXCT:	DIRMAK				;[1125]

SETKA:	SKIPA ARG,[1B5]
SETKI:	MOVSI ARG,(2B5)
	SKIPA			;SET FOR KI OR KA
SETKL:	MOVSI ARG,(4B5)		;KA=1 KI=2 KL=4
	IORM ARG,CPUTYP		;MAKE INCLUSIVE WITH WHAT IS THERE
	RET			;THEN RETURN

;SET FLBLST SWITCH.  WHEN ON, IT CAUSES ONLY ONE LINE OF BINARY TO BE
;LISTED FOR MULTI-WORD STATEMENTS, E.G. ASCIZ.
SETFLB:	MOVSI AC1,(FLBLST)
	ANDCAM AC1,BLSW
	SKIPN AC2		;USER WANTS IT?
	IORM AC1,BLSW		;YES, SET FLAG
	RET

;[1125] SET NO BINARY SWITCH - GENERATES NO REL FILE
SETNOB:	JUMPE AC2,%NOBIN	;[1125] 'NO' GIVEN?
	TRO ER,ERRQ		;[1125] YES, ILLEGAL
	RET			;[1125]

;[1125] SET MACRO ARG HANDLING SWITCH - MATCH PAIRED DELIMITERS
SETMPD:	MOVEM AC2,MACTAB	;[1125] SET MACRO ARG DELIMITER FLAG
	MOVEM AC2,ITABM		;[1125] IMPLIES ITABM ALSO
	RET			;[1125]

   IFN TSTCD,<
TCDSET:	SETCAM AC2,TCDFLG	;SET FLAG ON
	JRST COUTD		;[664] BIND OFF LAST BLOCK, EXIT
>	
; PSEUDO-END STATEMENT FOR MULTI-FILE CAPABILITY

; HERE IF PRGEND (PASS 1)
PSEND0:   IFN FTPSECT,<		;[1136]
	SKIPE SGLITL		;[1136] INSIDE A LITERAL OF ANY PSECT?
	RET			;[1136] YES - JUST RETURN
   >				;[1136]
	TLO IO,MFLSW		;[1131] PSEND SEEN
	SETOM PGENDF		;[1141] INDICATE PRGEND SEEN
	CALL END0		;AS IF END STATEMENT
	HLLZS IO		;CLEAR ER(RH)
	SETZM ERRCNT		;CLEAR ERROR COUNT FOR EACH PROG.
	SETZM QERRS		;...
	JUMP2 PSEND2		;DIFFERENT ON PASS2
	SKIPE UNIVSN		;SEEN A UNIVERSAL
	CALL UNISYM		;YES, STORE SYMBOLS
	CALL PSEND4		;SAVE SYMBOLS, POINTERS AND TITLE
	MOVE AC0,[ASCII /.MAIN/] ;GET DEFAULT TITLE
	MOVEM AC0,TBUF		;AND MAKE IT CURRENT TITLE
	SETZM TBUF+1		;[1140] CLEAR 2ND WORD FOR ASCIZ TITLE
	SETZM TTLFND		;[1123] MAKE SURE TITLE FLAG IS CLEARED
	SETZM RELLOC		;CLEAR TO PREVENT EFFECTS ACROSS PRGEND
	SETZM RELLOC+1		;[573]
PSEND1:	TLZ IO,MFLSW		;FOR NEXT FILE
	SETZM UNISCH		;CLEAR UNIVERSAL SEARCH TABLE
	MOVE AC0,[UNISCH,,UNISCH+1]
	BLT AC0,UNISCH+.UNIV-1
	TLO IO,IOPAGE		;SIGNAL NEW PAGE BUT DON'T CHANGE NUMBER
	MOVSI AC0,1		;SET SO RELOC 0 WORKS
	HRRZM AC0,LOCA		;SET ASSEMBLY LOCATION
	HRRZM AC0,LOCO		;AND OUTPUT LOCATION
	HLRZM AC0,MODA		;SET MODE
	HLRZM AC0,MODO
	RET

; HERE IF PRGEND (PASS 2)
PSEND2:	SETZM SBUF		;SO SUBTTL IS NOT WRONG
	SETZM UNIVSN		;IN CASE IN UNIVERSAL
	TLZ FR,R1BSW!RIMSW!RIM1SW
	CALL PSEND5		;PUT TITLE BACK
	CALL PSEND1		;COMMON  CODE
	JRST PASS20		;OUTPUT THE ENTRIES

; HERE IF END (PASS 1)
PSEND3:	CALL PSEND4		;SAVE LAST PROGRAM 
	HLRS PRGPTR		;REINITIALIZE POINTER
	PJRST PSEND5		;READ BACK FIRST PROGRAM
;HERE TO SAVE AND RESTORE SYMBOL TABLE, TITLE AND OTHER USEFUL LOCATIONS
	XTRA==^D9		;[1144] NUMBER OF OTHER LOCATIONS TO SAVE

PSEND4:	MOVE V,FREE		;GET  NEXT FREE LOCATION
	ADDI V,LENGTH+.TBUF/5+XTRA
   IFN FTPSECT,<		;[575]
	ADDI V,1		;[1052] ALLOW FOR PSECT COUNT
	SKIPN SGNMAX		;[1052] IF COUNT IS 0, WILL LOOP ONCE
	JRST [ADDI V,5		;[1131][1052] SO ALLOW FOR IT
		JRST PSEND7]	;[1052]
	ADD V,SGNMAX		;[1131] SAVE 5 PSECT TABLES
	ADD V,SGNMAX
	ADD V,SGNMAX
	ADD V,SGNMAX
	ADD V,SGNMAX
PSEND7:				;[1052]
   >
	CAML V,SYMBOL		;WILL WORST CASE FIT?
	CALL XCEED		;NO, EXPAND
	MOVS V,FREE
	HRR V,PRGPTR		;LAST PRGEND BLOCK
	HLRM V,(V)		;LINK THIS BLOCK
	SKIPN PRGPTR		;IF FIRST TIME
	HLLZM V,PRGPTR		;SET LINK TO START OF CHAIN
	HLRM V,PRGPTR		;POINTER TO IT
	SETZM @FREE		;CLEAR LINK WORD
	AOS FREE		;THIS LOCATION USED NOW
	MOVS AC0,SYMBOL		;BOTTOM OF SYMBOL TABLE
	HRR AC0,FREE		;FREE SPACE
	MOVE V,@SYMBOL		;GET NUMBER OF SYMBOLS
	ASH V,1			;TWO WORDS PER SYMBOL
	ADDI V,1		;ONE MORE FOR COUNT
	ADDB V,FREE		;END OF TABLE WHEN MOVED
	BLT AC0,(V)		;MOVE TABLE
	HRRZ AC0,.JBREL		;TOP OF CORE
	SUBI AC0,1
	MOVEM AC0,SYMTOP	;FOR NEXT SYMBOL TABLE
	SUBI AC0,LENGTH		;LENGTH OF INITIAL SYMBOLS
	MOVEM AC0,SYMBOL	;SET POINTER TO COUNT OF SYMBOLS
	HRLI AC0,SYMNUM		;BLT POINTER
	BLT AC0,@SYMTOP		;SET UP INITIAL SYMBOL TABLE
	CALL SRCHI		;SET UP SEARCH POINTER
	MOVEI AC0,.TBUF		;MAX NUMBER OF CHARS. IN TITLE
	SUB AC0,TCNT		;ACTUAL NUMBER
	IDIVI AC0,5		;NUMBER OF WORDS
	SKIPE AC1		;REMAINDER?
	ADDI AC0,1		;YES
	MOVEM AC0,@FREE		;STORE COUNT
	AOS FREE		;THIS LOCATION USED NOW
	EXCH AC0,FREE		;SET UP AC0 FOR BLT
	ADDM AC0,FREE		;WILL BE AFTER TITLE MOVES
	HRLI AC0,TBUF		;BLT POINTER
	BLT AC0,@FREE		;MOVE TITLE
   IFN FTPSECT,<		;[575]
	MOVE AC2,SGNMAX		;PSECT COUNT
	MOVE AC0,AC2
	CALL STORIT		;SAVE PSECT COUNT
PSEND8:	MOVE AC0,SGNAME(AC2)	;[1052] START OF STORE LOOP
	CALL STORIT		;SAVE PSECT NAME
	MOVE AC0,SGRELC(AC2)
	CALL STORIT		;SAVE MODE AND PC
	MOVE AC0,SGSCNT(AC2)
	CALL STORIT		;SAVE SYM CNT
	MOVE AC0,SGATTR(AC2)
	CALL STORIT		;SAVE BREAK AND ATTRS
	MOVE AC0,SGORIG(AC2)	;[1131] SAVE LIT PTR,,ORIGIN
	CALL STORIT		;[1131]
	HRRZS SGORIG(AC2)	;[1131] CLEAR LIT PTR. FOR NEXT PROG
	SOJGE AC2,PSEND8	;[1052]
	SETZM SGNMAX		;ZERO PSECT CNT
	SETZM SGNCUR		;[1136] ZERO CURRENT PSECT
	SETZM SGDMAX		;[1136] ZERO PSECT NESTING COUNT
	SETZM SGLIST		;[1136] FIRST PSECT IS ALWAYS THE BLANK PSECT
	SETZM SGNAME		;BLANK PSECT NAME
	MOVSI AC0,1		;SET RELOCATION
	MOVEM AC0,SGRELC	;TO RELATIVE ZERO
	SETZM SGATTR		;[1131] CLEAR PSECT BREAK
	MOVE AC0,@SYMBOL	;GET SYM CNT
	MOVEM AC0,SGSCNT	;SAVE PSECT SYM CNT
	CALL SRCHI		;SET UP SEARCH POINTER
   >
	MOVE AC0,LITHD		;LENGTH ,, START
	CALL STORIT
	MOVE AC2,LITHDX		;POINTER TO LIT INFO.
	MOVE AC0,-1(AC2)	;SIZE OF PASS1 LOCO
	CALL STORIT		;SAVE IT IN SYMBOL TABLE
	MOVE AC2,VARHDX		;SAME FOR VARS
	MOVE AC0,-1(AC2)
	CALL STORIT
	MOVE AC0,(AC2)
	CALL STORIT
	SETZM (AC2)		;CLEAR NUMBER OF VARIABLES SEEN
	MOVE AC0,CPUTYP		;[1144] CPU TYPE BITS
	CALL STORIT		;[1144] SAVE
	SETZM CPUTYP		;[1144] CLEAR
	MOVE AC0,HISNSW		;GET TWOSEG/HISEG FLAG
	HRR AC0,HIGH1		;AND PASS1 BREAK
	CALL STORIT
	SETZM HISNSW		;CLEAR HISEG FLAG FOR NEXT PROGRAM
	SETZM HIGH		;[1131] CLEAR LOW SEG BREAK
	JUMPGE AC0,PSEND6	;NOT TWOSEG
	MOVE AC0,SVTYP3		;HIGH SEGMENT OFFSET
	CALL STORIT		;SAVE IT ALSO
PSEND6:	MOVE AC0,FREE		;GET NEXT FREE LOCATION
	SUBI AC0,1		;LAST ONE USED
	HRRZ V,PRGPTR		;POINTER TO START OF DATA BLOCK
	HRLM AC0,(V)		;LINK TO END OF BLOCK
	RET			;RETURN
PSENDX:	CALL XCEED		;NEED TO EXPAND CORE FIRST
PSEND5:	HRRZ V,.JBREL		;GET TOP OF CORE
	SETZM (V)		;CLEAR OR GET ILL MEM REF
	MOVEI AC0,-1(V)
	MOVEM AC0,SYMTOP	;TOP OF NEW SYMBOL TABLE
	HRRZ V,PRGPTR		;ADDRESS OF THIS BLOCK
	JUMPE V,PSNDER		;ERROR LINK NOT SET UP
	MOVE AC1,(V)		;NEXT LINK
	MOVE V,1(V)		;GET ITS SYMBOL COUNT
	ASH V,1			;NUMBER OF WORDS
	ADDI V,1		;PLUS ONE FOR COUNT
	SUBI AC0,(V)		;START OF NEW SYMBOL TABLE
	CAMG AC0,FREE		;WILL IT FIT
	JRST PSENDX		;NO, NEED TO EXPAND AND RESET AC0
	ADD V,PRGPTR		;POINT TO END OF SYMBOL TABLE
	MOVEI V,1(V)		;THEN TO BEG OF TITLE
	MOVEM AC0,SYMBOL	;BOTTOM OF NEW TABLE
	HRL AC0,PRGPTR		;ADDRESS OF FIRST WORD OF BLOCK
	ADD AC0,[1,,0]		;MAKE BLT POINTER
	HRRM AC1,PRGPTR		;POINT TO NEXT BLOCK
	BLT AC0,@SYMTOP		;MOVE TABLE
	CALL SRCHI		;SET UP POINTER
	MOVE AC1,(V)		;NUMBER OF WORDS OF TITLE
	MOVEI AC0,1(V)		;START OF STORED TITLE
	ADD V,AC1		;INCREMENT PAST TITLE
	ADDI AC1,TBUF-1		;END OF TITLE
	HRLI AC0,TBUF		;WHERE TO PUT IT
	MOVSS AC0		;BLT POINTER
	BLT AC0,(AC1)		;MOVE TITLE
	SETZM TTLFND		;[1123] INDICATE TITLE NOT YET SEEN
   IFN FTPSECT,<		;[575]
	CALL GETIT		;GET PSECT COUNT
	MOVE AC2,AC0
	MOVEM AC2,SGNMAX
PSEND9:	CALL GETIT		;[1052] GET PSECT NAME
	MOVEM AC0,SGNAME(AC2)
	CALL GETIT		;GET MODE AND PC
	MOVEM AC0,SGRELC(AC2)
	CALL GETIT		;GET SYM CNT
	MOVEM AC0,SGSCNT(AC2)
	CALL GETIT		;GET BREAK AND ATTRS
	MOVEM AC0,SGATTR(AC2)
	CALL GETIT		;[1131] GET LIT PTR,,ORIGIN
	MOVEM AC0,SGORIG(AC2)	;[1131]
	SOJGE AC2,PSEND9	;[1052]
	SETZM SGNCUR		;SET TO BLANK PSECT
	CALL SRCHI		;SET UP POINTER
   >
	CALL GETIT
	MOVEM AC0,LITHD
	MOVE AC2,LITHDX		;INVERSE OF ABOVE
	CALL GETIT
	MOVEM AC0,-1(AC2)
	MOVE AC2,VARHDX		;SAME FOR VARS
	CALL GETIT
	MOVEM AC0,-1(AC2)
	CALL GETIT
	MOVEM AC0,(AC2)		;RESTORE COUNT OF VARS
	CALL GETIT		;[1144] CPU TYPE BITS
	MOVEM AC0,CPUTYP	;[1144]
	CALL GETIT		;GET TWO HALF WORDS
	HRRZM AC0,HIGH1		;PASS1 BREAK
	HLLEM AC0,HISNSW	;TWOSEG/HISEG FLAG
	JUMPGE AC0,CPOPJ	;NOT TWOSEG
	CALL GETIT
	MOVEM AC0,SVTYP3	;BLOCK 3 WORD
	RET

STORIT:	MOVEM AC0,@FREE		;STORE IT IN DATA BLOCK
	AOS FREE		;ADVANCE POINTER
	RET

GETIT:	MOVE AC0,1(V)		;FILL AC0 OUT OF PRGEND BLOCK
	AOJA V,CPOPJ		;INCREMENT AND RETURN

PSNDER:	PUSH P,['MCRPGE']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT / PRGEND ERROR@/] ;[1066]
	JRST ERRFIN
;MULTIPLE SYMBOL TABLE FEATURE PSEUDO-OPS
UNIV0:	JUMP2 UNIV2		;DO PROPER PASS2 STUFF
	BITON UBAS+UMACV,UWVER	;WRITING UNV, INCLUDE UBAS AND VERSION
	HRRZ SX,UNIVNO		;GET NUMBER OF UNIVERSALS SEEN
	CAIL SX,.UNIV		;ALLOW ONE MORE?
	JRST UNVERR		;NO, GIVE FATAL ERROR
	SETOM UNIVSN		;AND SET SEEN A UNIVERSAL
	JRST TITLE0		;CONTINUE AS IF TITLE

UNIV2:	HLLOS UNIVSN		;ENSURE SET UP FOR UNIVERSAL
	JRST TITLE0		;[1123] AND CONTINUE AS IF TITLE

ADDUNV:	PUSH P,RC		;AN AC TO USE
	CALL NOUT		;CONVERT TO SIXBIT
	HRRZ RC,UNIVNO		;GET ENTRY INDEX
	MOVEM AC0,UNITBL+1(RC)	;STORE SIXBIT NAME IN TABLE
	MOVEM AC0,UNVDIR	;AND FOR ENTER LATER
	HRRZS UNIVSN		;ONLY DO IT ONCE
	POP P,RC		;RESTORE RC
	RET			;AND RETURN

UNVERR:	PUSH P,['MCRTMU']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT / TOO MANY UNIVERSALS@/] ;[1066]
	JRST ERRFIN

UNISYM:	CALL SUPRSA		;TURN ON SUPPRESS BIT
	SKIPE UNVSKP		;[700] IF /U, SET FLAG FOR
	JRST [SETOM MRUNV	;[700] LATER ASSEMBLIES
		JRST .+2]	;[700] AND SKIP .UNV FILE
	CALL UNVOUT		;OUTPUT SYMBOL TABLE
	TLNN IO,MFLSW		;ALSO IN PRGEND?
	JRST UNISYN		;NO
	MOVE AC0,@SYMBOL	;GET NO. OF SYMBOLS
	LSH AC0,1		;2 WORDS EACH
	ADDI AC0,1		;PLUS COUNT
	ADD AC0,FREE		;HOW MUCH WE WILL NEED
	CAML AC0,SYMBOL		;WILL IT FIT IN WHAT WE HAVE
UNISYK:	CALL XCEED		;NO, EXPAND
	CAML AC0,SYMBOL		;ENOUGH?
	JRST UNISYK		;NO, EXPAND
UNISYN:	PUSH P,SYMBOL		;NEED TO SAVE IN CASE PRGEND
	MOVE AC0,SYMTOP		;TOP OF TABLE
	SUB AC0,SYMBOL		;GET LENGTH OF TABLE
	HRL ARG,SYMBOL		;BOTTOM OF TABLE
	HRR ARG,FREE		;WHERE TO GO
	HRRZ RC,UNIVNO		;GET TABLE INDEX
	HRRM ARG,SYMBOL		;WILL BE THERE SOON
	HRRZM ARG,UNIPTR+1(RC)	;STORE IN CORRESPONDING PLACE
	ADDB AC0,FREE		;WHERE TO END
	HRLM AC0,UNIPTR+1(RC)	;SAVE NEW SYMTOP
	BLT ARG,@FREE		;MOVE TABLE
	HRRZM AC0,UNITOP	;SAVE TOP OF TABLES+1
	CAMLE AC0,MACSIZ	;IN CASE OVER A K BOUND
	MOVEM AC0,MACSIZ	;DON'T REDUCE SO FAR NOW
	MOVE AC0,SRCHX		;SAVE OLD SEARCH POINTER
	CALL SRCHI		;GET SEARCH POINTER
	EXCH AC0,SRCHX
	MOVEM AC0,UNISHX+1(RC)	;SAVE IT
	POP P,SYMBOL		;RESTORE OLD VALUE
	SETZM UNIVSN		;CLEAR FLAG IN CASE PRGEND
	AOS UNIVNO		;SIGNAL ANOTHER UNIVERSAL SAVED
	RET			;RETURN
SERCH0:	CALL BYPASS		;[664][572] SKIP LEADING BLANKS
	TLNE CS,4		;FIRST CHAR NUMERIC?
	TLO CS,2		;YES, FIX UP FOR GETSYM
	CALL GETSY0		;GET A SYMBOL
	  JRST ERRAX		;ERROR IF NOT VALID
	MOVE RC,UNIVNO		;NUMBER OF UNIVERSALS AVAILABLE
	JUMPE RC,UNVINP		;TRY TO READ SYMBOLS FROM DSK
	CAME AC0,UNITBL(RC)	;LOOK FOR MATCH
	SOJA RC,.-2		;NOT FOUND YET

SERCH1:	MOVE AC0,RC		;STORE TABLE ENTRY NUMBER
	MOVEI RC,1		;START AT ENTRY ONE
SERCH5:	CAIL RC,.UNIV		;[672] CHECK FOR CONSISTENCY ERROR
	JRST SCHOVL		;[672] GIVE ERROR
	SKIPN UNISCH(RC)	;[672] LOOK FOR AN EMPTY SLOT
	JRST [MOVEM AC0,UNISCH(RC)	;[672] STORE INDEX IN TABLE
		JRST SERCH6]	;[672]
	CAME AC0,UNISCH(RC)	;[672] SAME INDEX?
	AOJA RC,SERCH5		;[672] NO, NOT FOUND YET
SERCH6:	CAIE C,'('		;[672] GIVING FILE SPEC?
	JRST SERCH4		;NO
SERCH2:	CALL GETCHR		;YES, GET RID OF IT
	CAIN C,')'		;LOOK FOR END
	JRST SERCH3		;FOUND IT
	CAIE C,EOL		;REACHED END OF LINE?
	JRST SERCH2		;NO, KEEP LOOKING
	TROA ER,ERRQ		;GIVE UP AND FLAG ERROR
SERCH3:	CALL GETCHR		;GET NEXT CHAR
SERCH4:	JUMPCM SERCH0		;LOOK FOR MORE NAMES
	RET			;FINISHED

VERSKW:	PUSH P,['MCRUVS']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / UNIVERSAL VERSION SKEW, REASSEMBLE UNIVERSAL@/] ;[1066]
	JRST ERRFIN		;NAME IN AC0

SCHERR:	PUSH P,['MCRCFU']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / CANNOT FIND UNIVERSAL@/] ;[1066]
	JRST ERRFIN		;NAME IN AC0

SCHOVL:	PUSH P,['MCTSTO']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / SEARCH TABLE OVERFLOW, CANNOT SEARCH UNIVERSAL@/]	;[1066][672]
	MOVE AC0,UNVDIR		;[672]
	JRST ERRFIN		;[672]

;MESSAGE FOR CASE WHERE FILES AFTER UNIVERSAL USED MORE BUFFER SPACE THAN FIRST UNIVERSAL
UNIERR:	PUSH P,['MCRCAP']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT / CORE ALLOCATION PROBLEM WITH MEMORY-RESIDENT UNIVERSAL(S)@/]	;[1066][700]
	MOVEI P,JOBFFI		;[1004] GET SAFE TEMP PDL PTR
	JRST ERRFIN

SCHGET:	SETZ AC0,		;INITIALIZE
	MOVSI AC1,(POINT 6,AC0)
SCHGNX:	CALL GETCHR		;GET NEXT CHARACTER
	CAIE C,'.'		;SPECIAL TEST FOR END OF NAME
	TLNN CS,6		;OR ANY NON-ALPHANUMERIC
	PJRST BYPAS2		;SKIP ALL SPACES AND QUIT
	TLNE AC1,770000		;ALL SIX IN YET?
	IDPB C,AC1		;NO, STORE THIS ONE
	JRST SCHGNX		;GET NEXT

SCHOCT:	SETZ AC0,		;INITIALIZE
SCHONX:	CALL GETCHR		;GET NEXT CHAR
	TLNN CS,4		;NUMBER
	PJRST BYPAS2		;NO, SKIP TRAILING SPACES
	LSH AC0,3		;MAKE SPACE
	ADDI AC0,-'0'(C)	;AND STOW DIGIT
	JRST SCHONX		;GET NEXT
SUBTTL MACRO/REPEAT HANDLERS

REPEA0:	CALL EVALXQ		;EVALUATE REPEAT EXP, EXTERNS ARE ILL.
	JUMPNC ERRAX
	SETZM NESTED		;ASSUME NOT NESTED
	SKIPN LITLVL		;IN LITERAL?
	SKIPE MACLVL		;IN MACRO?
	SKIPA
	SKIPE RPOLVL		;IN REPEAT 1 OR IF'S?
	SETOM NESTED		;YES, IT IS NESTED IN ONE OF THEM

REPEA1:	SETZM COMSW		;SET COMMENT SWITCH
	JUMPLE AC0,REPZ		;PASS THE EXP., DONT PROCESS
	SOJE AC0,REPO		;REPEAT ONCE
REPEA2:	CALL GCHARQ		;GET STARTING "<"
	CALL COMTST		;IGNORE COMMENTS
	SKIPN COMSW		;INSIDE A COMMENT?
	CAIG C," "		;TEXT FORMATTING CHARACTER?
	JRST REPEA2		;YES, GET NEXT
	CAIE C,"<"		;"<"?
	JRST REPMAB		;NO, ERROR
	CALL SKELI1		;INITIALIZE SKELETON
	PUSH MP,REPEXP
	MOVEM AC0,REPEXP
	PUSH MP,REPPNT		;STACK PREVIOUS REPEAT POINTER
	MOVEM ARG,REPPNT	;STORE NEW POINTER
	TDZA SDEL,SDEL		;YES, INITIALIZE BRACKET COUNT AND SKIP

REPEA4:	CALL WCHAR		;[664] WRITE A CHARACTER
	CALL GCHARQ		;GET A CHARACTER
	CAIN C,"<"		;"<"?
	AOJA SDEL,REPEA4	;YES, INCREMENT AND WRITE
	CAIE C,">"		;">"?
	JRST REPEA4		;NO, WRITE THE CHARACTER
	SOJGE SDEL,REPEA4	;YES, WRITE IF NON-NEGATIVE COUNT
	MOVSI CS,(BYTE (7) 177,3) ;SET "REPEAT" END
	CALL WWRXE		;WRITE END
	SKIPE NESTED		;NESTED?
	JRST REPEA5		;YES, REST OF LINE, SOMETHING ELSE MAY END HERE
	CALL BYPASS		;[664]
	CALL STOUTS		;POLISH OF LINE BEFORE PROCESSING REPEAT
	SOS TAGINC		;[1001] RECOVER CORRECT OFFSET
;(NOTE: THIS IS NECESSARY FOR MRP IS NOT YET NON-ZERO WHEN THE EARLY CALL
; TO STOUT OCCURS.  THIS FOULS UP THE CHECK AT OUTLI4.)

REPEA5:	PUSH MP,MRP		;STACK PREVIOUS READ POINTER
	PUSH MP,RCOUNT		;SAVE WORD COUNT
	HRRZ MRP,REPPNT		;SET UP READ POINTER
	ADDI MRP,1		;BYPASS ARG COUNT
	SKIPE NESTED		;NESTED?
	JRST REPEA8		;YES
	RET			;[664] NO 

REPEA7: HRRZ MRP,REPPNT		;SET UP READ POINTER
	ADDI MRP,1		;BYPASS ARG COUNT
REPEA8:	MOVEI C,LF
	JRST RSW2

REPEND:	SOSL REPEXP
	JRST REPEA7
	HRRZ V,REPPNT		;GET START OF TREE
	CALL REFDEC		;DECREMENT REFERENCE
	POP MP,RCOUNT
	POP MP,MRP
	POP MP,REPPNT
	POP MP,REPEXP
	SKIPE NESTED		;NESTED?
	JRST RSW0		;YES, FINISH OF LINE NOW
	JRST REPEA8

REPMAB:	PUSH P,['MCRISR']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT \ ILLEGAL SYNTAX IN REPEAT@\]	;[1066][702]
	JRST ERRNE4		;[702]
REPZ:	FORERR (SDEL,REP)
	PUSH P,IO		;SAVE STATE OF IOPROG
	SETOM INREP
REPZ0:	CALL GCHAR0		;[1003][753] GET STARTING <
	CALL COMTST		;IGNORE COMMENTS
	SKIPN COMSW		;INSIDE A COMMENT?
	CAIG C," "		;TEXT-FORMATING CHAR?
	JRST REPZ0		;YES, GET NEXT
	CAIE C,"<"		;<?
	JRST CORMAB		;NO, ERROR
	MOVEI SDEL,1		;SET COUNT
REPZ1:	CALL GCHAR0		;[1003][753] GET NEXT CHARACTER
	CAIG C,FF		;END OF LINE?
	CAIGE C,LF
	JRST REPZ3		;NO
	SKIPE IFXLSW		;YES, XLISTING IN IF?
	TLO IO,IOPROG		;YES, DO IT
REPZ3:	CAIN C,"<"		;"<"?
	AOJA SDEL,REPZ1		;YES, INCREMENT COUNT
	CAIN C,">"		;">"?
	SOJLE SDEL,REPZ2	;YES, EXIT IF MATCHING
	JRST REPZ1		;NO, RECYCLE
REPZ2:	POP P,AC1		;RECOVER ORIGINAL IOPROG
	TLNN AC1,IOPROG		;ORIGINALLY 0?
	TLZ IO,IOPROG		;YES, RESTORE IT
	SETZM INREP		;FLAG OUT OF IT
	SETZM INCND		;AND CONDITIONAL ALSO
	JRST STMNT		;AND EXIT

REPO:	CALL GCHAR		;GET "<"
	CALL COMTST		;IGNORE COMMENTS
	SKIPN COMSW		;INSIDE A COMMENT?
	CAIG C," "		;TEXT-FORMATTING CHAR?
	JRST REPO		;YES, GET NEXT
	CAIE C,"<"		;<?
	JRST CORMAB		;NO, ERROR
	SKIPE RPOLVL		;ARE WE NESTED?
	AOS RPOLVL		;YES, DECREMENT CURRENT
	PUSH MP,RPOLVL
	SETOM RPOLVL
	JRST STMNT

REPO1:	CAIN C,"<"
	SOS RPOLVL
	CAIN C,">"
	AOSE RPOLVL
	JRST RSW2
	POP MP,RPOLVL
	CALL RSW2
	JRST RSW0

CORMAB:	PUSH P,['MCRISC']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT / ILLEGAL SYNTAX IN CONDITIONAL OR REPEAT@/] ;[1066][702]
	JRST ERRNE4		;[702]

COMTST:	CAIG C,FF		;SEARCH FOR END OF LINE
	CAIGE C,LF		;LF, VT OR FF?
	JRST .+2		;WASN'T ANY OF THEM
	SETZM COMSW		;RESET COMMENT SWITCH
	CAIN C,";"		;COMMENT?
	SETOM COMSW		;YES, SET COMMENT SWITCH
	RET
	SUBTTL MACRO PROCESSOR

	COMMENT \
THE FOLLOWING IS A PARTIAL DESCRIPTION OF THE DATA STRUCTURES USED
BY THE MACRO PROCESSOR.  

FREE STORAGE IS OBTAINED IN GROUPS OF .LEAF (4 PRESENTLY) WORDS.
SUCH A BLOCK IS CALLED A 'LEAF' AND IS FORMATTED AS FOLLOWS FOR
STORING TEXT:

	!-------------------------------------------!
	!  LINK TO NEXT LEAF   !//! CHAR 0 ! CHAR 1 !
	!-------------------------------------------!
	!  CHAR 2 ...				    !
	!-------------------------------------------!
	!					    !
	!-------------------------------------------!
	!					    !
	!-------------------------------------------!

THE FIRST LEAF OF A MACRO DEFINITION CONTAINS SOME ADDITIONAL INFORMATION
ABOUT THE MACRO:
  1. DEFAULT ARGUMENT POINTER
  2. ARGUMENT COUNT
  3. REFERENCE COUNT

	!-------------------------------------------!
	!   LINK	      !			    !
	!-------------------------------------------!
	! DEF ARG PTR         !    ARG CNT ! REF CNT!
	!-------------------------------------------!
	! CHAR 0 ! CHAR 1 ! ...			    !
	!-------------------------------------------!
	!					    !
	!-------------------------------------------!

THE FIRST LEAF OF A MACRO ARGUMENT ALSO CONTAINS A REF COUNT:

	!-------------------------------------------!
	!  LINK		      !			    !
	!-------------------------------------------!
	!		      !      1    ! REF CNT !
	!-------------------------------------------!
	!					    !
	!-------------------------------------------!
	!					    !
	!-------------------------------------------!

MP - POINTER TO STACK USED FOR REPEATS
RP - POINTER TO STACK USED FOR MACRO CALLS
MACPNT - POINTER TO LIST OF ARG POINTERS (I.E. RP AT FIRST ARG)

A MACRO CALL PRODUCES THE FOLLOWING STACK FRAME:

MACPNT/ ---)    PTR TO MACRO DEFINITION BODY
		ARG 1
		ARG 2
		..
		0
		OLD MACPNT
		OLD C
		OLD RCOUNT
RP/ ---)	OLD MRP

IRP VARIABLES:

  IRPARP	POINTER TO ORIGINAL MACRO ARG
  IRPCF		B0: 0=IRP, 1=IRPC
  IRPSW
  IRPARG	ORIGINAL MACRO ARG
  IRPCNT	READ COUNT
  IRPPOI	ORIGIN OF BODY OF IRP RANGE
\				;END OF COMMENT
DEFIN0:	SKIPN UWVER	;WRITING UNV FILE?
	JRST DEF01		;NO
	BITON UMAD,UWVER	;MACRO ARG DEF VALUE FIXED BIT
DEF01:	CALL GETSYM		;GET MACRO NAME
	 JRST ERRAX		;EXIT ON ERROR
	MOVEM P,PPTMP1		;SAVE POINTER
	MOVEM AC0,PPTMP2	;SAVE NAME
	TLO IO,IORPTC
	FORERR (SX,DEF)
	SETOM INDEF		;AND FLAG IN DEFINE
	SETZB SX,.TEMP		;SET ARGUMENT AND REFERENCE COUNT
	SETZM COMSW		;AND COMMENT SWITCH
DEF02:	CALL GCHAR0		;[1003] SEARCH FOR "(" OR "<"
	CALL COMTST		;IGNORE COMMENTS
	SKIPE COMSW		;INSIDE A COMMENT?
	JRST DEF02		;YES, IGNORE CHARACTER
	CAIE C,")"		;MISSING "("?
	CAIN C,">"		;OR "<"?
	JRST DEFERR		;YES, GIVE ERROR, GET OUT OF DEF
	CAIN C,"<"		;"<"?
	JRST DEF20		;YES
	CAIE C,"("		;"("?
	JRST DEF02		;NO
DEF10:	CALL GETSYM		;YES, GET DUMMY SYMBOL
	 TRO ER,ERRA		;FLAG ERROR
	ADDI SX,1		;INCREMENT ARG COUNT
	PUSH P,AC0		;STACK IT
	JUMPCM DEF10		;GET NEXT DUMMY SYMBOL IF COMMA
	CAIN C,'<'		;A DEFAULT ARGUMENT COMING UP?
	JRST DEF80		;YES, STORE IT AWAY
	CAIE C,11		;")"?
	JRST DEFERR		;NO, SYNTAX ERROR
DEF12:	CALL GCHAR0		;[1003]
	CALL COMTST		;IGNORE COMMENTS
	SKIPE COMSW		;GET NEXT IF INSIDE COMMENT
	JRST DEF12		;[574]
	CAIN C,">"		;MISSING "<"?
	JRST DEFERR		;YES, GIVE ERROR, LEAVE DEFINITION
	CAIE C,"<"		;"<"?
	JRST DEF12		;NO
DEF20:	PUSH P,[0]		;YES, MARK THE LIST
	LSH SX,9		;SHIFT ARG COUNT
	AOS ARG,SX
	CALL SKELI		;INITIALIZE MACRO SKELETON
	MOVE AC0,PPTMP2		;GET NAME
	TLO IO,DEFCRS
	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	CALL OPCFIX		;[736] FIX UP SYMTAB IF FORW-REF'ED
	CALL MSRCH		;SEARCH THE TABLE
	JRST DEF24		;NOT FOUND
	TLNN ARG,MACF		;FOUND, IS IT A MACRO?
	TROA ER,ERRX		;NO, FLAG ERROR AND SKIP
	CALL REFDEC		;YES, DECREMENT THE REFERENCE
DEF24:	TRZ FRR,NOUNVS		;[713] SEARCH UNIVERSALS AGAIN
	HRRZ V,WWRXX		;GET START OF TREE
	SKIPN .TEMP		;ANY DEFAULT ARGUMENTS TO TAKE CARE OF?
	JRST DEF25		;NO
	HRRZ C,1(V)		;GET SHIFTED ARG COUNT
	LSH C,-9		;GET ARG COUNT BACK
	ADDI C,1		;ONE MORE FOR TERMINAL ZERO
	ADD C,.TEMP		;NUMBER OF ITEMS IN STACK
	HRLS C			;MAKE XWD
	MOVE SDEL,.TEMP		;NUMBER OF WORDS NEEDED
	ADDI SDEL,1		;PLUS THE 0 AT THE END
	ADDB SDEL,FREE		;FROM FREE CORE
	CAML SDEL,SYMBOL	;MORE CORE NEEDED
	CALL XCEEDS		;YES, TRY TO GET IT
	SUB SDEL,.TEMP		;FORM POINTER
	SUBI SDEL,1		;MINUS THE 0
	SUB P,C			;BACK UP STACK TO START OF ARGS
	HRLM SDEL,1(V)		;STORE IT WITH ARG COUNT IN MACRO
	SUBI SDEL,1		;TO USE FOR PUSHING POINTER INTO STORAGE
	MOVEI C,1(P)		;POINT TO START OF STACK
DEF26:	MOVE ARG,(C)		;GET AN ITEM OFF STACK
	TLNN ARG,-40		;A POINTER?
	JUMPN ARG,[PUSH SDEL,ARG ;YES, STORE IT
		AOJA C,DEF26]	;GET NEXT
	PUSH P,ARG		;RESTACK ARGUMENT
	SKIPE ARG		;FINISHED IF ZERO
	AOJA C,DEF26		;GET NEXT
	PUSH SDEL,ARG		;STORE ZERO IN DEFAULT LIST ALSO
DEF25:	MOVSI ARG,MACF
	MOVEM P,PPTMP2		;STORE TEMP STORAGE POINTER
	CALL INSERT		;INSERT/UPDATE
	TLZ IO,DEFCRS		;JUST IN CASE
	SETZM ARGF		;NO ARGUMENT SEEN
	SETZM SQFLG		;AND NO ' SEEN
	TDZA SDEL,SDEL		;CLEAR BRACKET COUNT
DEF30:	CALL WCHAR		;WRITE CHARACTER
DEF31:	CALL GCHAR0		;[1003] GET A CHARACTER
DEF32:	MOVE CS,C		;GET A COPY
	CAIN C,";"		;IS IT A COMMENT
	JRST CPEEK		;YES CHECK FOR ;;
DEF33:	CAIG CS,"Z"+40		;CONVERT LOWER CASE
	CAIGE CS,"A"+40
	JRST .+2
	SUBI CS,40
	CAIGE CS,40		;TEST FOR CONTROL CHAR.
	JRST [SKIPN SQFLG	;HAS SINGLE QUOTE BEEN SEEN?
		JRST DEF30	;NO, OUTPUT THIS CHAR.
		PUSH P,C	;YES, SAVE CURRENT CHAR
		MOVEI C,47	;SET UP QUOTE
		CALL WCHAR	;WRITE IT
		POP P,C		;GET BACK CURRENT CHAR.
		SETZM SQFLG	;RESET FLAG
		JRST DEF30]	;AND CONTINUE 
	CAILE CS,77+40
	JRST DEF30		;TEST FOR SPECIAL
	MOVE CS,CSTAT-40(CS)	;GET STATUS BITS
	TLNE CS,6		;ALPHA-NUMERIC?
	JRST DEF40		;YES
	SKIPN SQFLG		;WAS A ' SEEN?
	JRST DEF36		;NO, PROCESH
	PUSH P,C		;YES, SAVE CURRENT CHARACTER
	MOVEI C,47		;AND PUT IN A '
	CALL WCHAR		;...
	POP P,C			;RESTORE CURRENT CHARACTER
	SETZM SQFLG		;AND RESET FLAG
DEF36:	CAIE C,47		;IS THIS A '?
	JRST DEF35		;NOPE
	SKIPN ARGF		;YES, WAS LAST THING SEEN AN ARG?
	SETOM SQFLG		;IF NOT, SET SNGL QUOT FLAG
	SETZM ARGF		;BUT NOT ARGUMENT IN ANY CASE
	JRST DEF31		;GO GET NEXT CHARACTER

DEF35:	SETZM ARGF		;THIS IS NOT AN ARGUMENT
	CAIN C,"<"		;"<"?
	AOJA SDEL,DEF30		;YES, INCREMENT COUNT AND WRITE
	CAIN C,">"		;">"?
	SOJL SDEL,DEF70		;YES, TEST FOR END
	JRST DEF30		;NO, WRITE IT
CPEEK:	PUSH P,CS		;NEED TO SAVE CS, SINCE CHARAC MAY DESTROY IT
	CALL PEEK		;LOOK AT NEXT CHAR.
	POP P,CS		;RESTORE CS
	CAIN C,";"		;IS IT ;;?
	JRST CPEEK0		;YES, GO SCAN LINE MATCHING ANGLE BRACKETS
	MOVE C,CS		;RESTORE C
	JRST DEF33		;AND RETURN

CPEEK0:	SETZM CPEEKC		;CLEAR MATCHING ANGLE COUNTER
CPEEK1:	CALL GCHAR		;GET A CHARACTER
	CAIN C,"<"		;SEE IF LEFT ANGLE
	AOJA SDEL,CPEEKL	;YES, GO ADD TO COUNT
	CAIN C,">"		;SEE IF RIGHT ANGLE
	SOJA SDEL,CPEEKR	;YES, GO SUBTRACT FROM COUNT
	CAIG C,CR		;SEE IF AN
	CAIGE C,LF		;END OF LINE CHARACTER
	JRST CPEEK1		;NO, CONTINUE
CPEK1A:	SKIPL CPEEKC		;YES, SEE IF UNMATCHED ANGLES
	JRST CPEEK3		;NO, GO SEE IF END OF MACRO
	PUSH P,C		;SAVE EOL CHARACTER
CPEEK2:	MOVEI C,">"		;SET TO PUT IN SOME RIGHTS
	CALL WCHAR		;GO DO ONE
	AOSGE CPEEKC		;SEE IF ENOUGH
	JRST CPEEK2		;NO, LOOP
	POP P,C			;RECOVER EOL CHARACTER
CPEEK3:	JUMPL SDEL,DEF70	;IF END OF MACRO, LEAVE COMPLETELY
	JRST DEF32		;AND GET OUT OF LINE

CPEEKL:	AOS CPEEKC		;ADD IN LEFT ANGLE BRACKET
	JRST CPEEK1		;TO NEXT CHARACTER

CPEEKR:	JUMPL SDEL,CPEK1A	;JUMP IF END OF MACRO
	SOS CPEEKC		;SUBTRACT OUT RIGHT BRACKET
	JRST CPEEK1		;CONTINUE
DEF40:	MOVEI AC0,0		;CLEAR ATOM
	MOVSI AC1,(POINT 6,AC0)	;SET POINTER
DEF42:	PUSH P,C		;STACK CHARACTER
	TLNE AC1,770000		;HAVE WE STORED 6?
	IDPB CS,AC1		;NO, STORE IN ATOM
	CALL GCHAR		;GET NEXT CHARACTER
	MOVE CS,C
	CAIG CS,"Z"+40
	CAIGE CS,"A"+40
	JRST .+2
	SUBI CS,40		;CONVERT LOWER TO UPPER
	CAIL CS,40
	CAILE CS,77+40
	JRST DEF44		;TEST SPECIAL
	MOVE CS,CSTAT-40(CS)	;GET STATUS
	TLNE CS,6		;ALPHA-NUMERIC?
	JRST DEF42		;YES, GET ANOTHER
DEF44:	PUSH P,[0]		;NO, MARK THE LIST
	MOVE SX,PPTMP1		;GET POINTER TO TOP

DEF46:	SKIPN 1(SX)		;END OF LIST?
	JRST DEF50		;YES
	CAME AC0,1(SX)		;NO, DO THEY COMPARE?
	AOJA SX,DEF46		;NO, TRY AGAIN
	SUB SX,PPTMP1		;YES, GET DUMMY SYMBOL NUMBER
	LSH SX,4
	MOVSI CS,<(BYTE (7) 177,101)>(SX) ;SET ESCAPE CODE MACEND
	LSH AC0,-^D30
	CAIN AC0,5		;"%"?
	TLO CS,1000		;YES, SET CRESYM FLAG
	CALL WWORD		;WRITE THE WORD
	SETOM ARGF		;SET ARGUMENT SEEN FLAG
	SETZM SQFLG		;AND IGNORE ANY ' WAITING TO GET INTO STRING
DEF48:	MOVE P,PPTMP2		;RESET PUSHDOWN POINTER
	TLO IO,IORPTC		;ECHO LAST CHARACTER
	JRST DEF31		;RECYCLE

DEF50:	SKIPN SQFLG		;HAVE WE SEEN A '?
	JRST DEF51		;NOPE
	MOVEI C,47		;YES, PUT IT IN
	CALL WCHAR		;...
	SETZM SQFLG		;AND CLEAR FLAG
DEF51:	MOVE C,2(SX)		;GET CHARACTER
	JUMPE C,DEF48		;CLEAN UP IF END
	CALL WCHAR		;WRITE THE CHARACTER
	AOJA SX,DEF51		;GET NEXT

DEF70:	MOVE P,PPTMP1		;RESTORE PUSHDOWN POINTER
	MOVSI CS,(BYTE (7) 177,1)
	CALL WWRXE		;WRITE END
	SETZM INDEF		;OUT OF IT
	JRST BYPASS		;[664]
; HERE TO STORE DEFAULT ARGUMENTS
DEF80:	AOS .TEMP		;COUNT ONE MORE
	CALL SKELI1		;INITIALIZE SKELETON
	HRL V,SX		;SYMBOL NUMBER
	PUSH P,V		;STORE POINTER
	TDZA SDEL,SDEL		;ZERO BRACKET COUNT
DEF81:	CALL WCHAR		;[664] WRITE A CHARACTER
	CALL GCHAR0		;[1003] GET A CHARACTER
	CAIN C,"<"		;ANOTHER "<"?
	AOJA SDEL,DEF81		;YES, INCREMENT AND WRITE
	CAIE C,">"		;CLOSING ANGLE?
	JRST DEF81		;NO, JUST WRITE THE CHAR.
	SOJGE SDEL,DEF81	;YES, WRITE IF NOT END
	MOVSI CS,(BYTE (7) 177,2)
	CALL WWRXE		;WRITE END OF DUMMY ARGUMENT
	CALL GCHAR		;READ AT NEXT CHAR.
	CAIE C,")"		;END OF ARGUMENT LIST?
	JRST DEF10		;NO, GET NEXT SYMBOL
	JRST DEF12		;YES, LOOK FOR "<"

DEFERR:	PUSH P,['MCRISD']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / ILLEGAL SYNTAX IN MACRO DEFINITION@/]	;[1066][574]
	MOVE AC0,PPTMP2		;GET MACRO NAME
	SETZM INDEF		;[702] WANT MORE USEFUL INFO
	JRST ERRNE4		;[702] GIVE ERROR, RESET STACK, LEAVE DEF
SUBTTL MACRO CALL PROCESSOR

CALLM:	SKIPGE MACENL		;ARE WE TRYING TO RE-ENTER?
	JRST ERRAX		;YES, BOMB OUT WITH ERROR
	SETZM CRLFSN		;[1064] INIT FLAG IN CASE WE SEE LALL
	HRROS MACENL		;FLAG "CALLM IN PROGRESS"
	EXCH MP,RP
	PUSH MP,V		;STACK FOR REFDEC
	EXCH MP,RP
	MOVEM AC0,CALNAM	;SAVE MACRO NAME IN CASE OF ERROR
	FORERR (SDEL,CAL)
	ADDI V,1		;POINT TO DUMMY SYMBOL COUNT
	AOS SDEL,0(V)		;INCREMENT ARG COUNT
	HLLZM SDEL,.TEMP	;DEFAULT ARG POINTER IF NON-ZERO
	LDB SX,[POINT 9,SDEL,26] ;GET ARG COUNT
	MOVEI SDEL,0		;INIT PAREN COUNTER
	SKIPE .TEMP		;IF AT LEAST ONE DEFAULT ARG
	HRRM SX,.TEMP		;STORE COUNT OF ARGS
	PUSH P,V		;STACK FOR MRP
	PUSH P,RP		;STACK FOR MACPNT
	JUMPE SX,MAC20		;TEST FOR NO ARGS
MAC13:	CALL CHARAC
	SKIPN MACTAB		;IF MACTAB=0..NEW ARG HANDLING V51
	JRST .+3		;ASSUME ITABM=0
	SKIPE ITABM		;NEW FORMAT ARG HANDLING?
	JRST MAC13A		;NO, DON'T FLUSH TAB/SP
	CAIE C," "		;FLUSH LEADING TABS AND SPACES
	CAIN C,HT
	JRST MAC13
MAC13A:	CAIE C,"("		;"("
	TLOA SDEL,-1		;NO, FUDGE PAREN COUNT AND SKIP

MAC10:	CALL GCHAR		;GET A CHARACTER, LOOK FOR AN ARG
	JUMPGE SDEL,MAC11	;SKIP TEST IF IN ()
	CAIG C,CR
	CAIGE C,LF
	CAIN C,";"		;";"?
	JRST MAC21		;YES, END OF ARGUMENT STRING

MAC11:	SKIPN MACTAB		;IF MACTAB=0..NEW ARG HANDLING V51
	JRST [JUMPL SDEL,.+3	;[1032] .XTABM IF NOT IN (),
		JRST MAC11A]	;[1032] .ITABM IF IN ().
	SKIPE ITABM		;MAC51 ARG HANDLING?
	JRST MAC11A		;NO
	CAIE C," "		;YES, ELIMINATE LEADING TABS AND SPACES
	CAIN C,HT
	JRST MAC10		;[1032]
MAC11A:	SKIPLE SX		;SKIP IF NO ARGS LEFT
	CALL SKELI1		;NO, INITIALIZE SKELETON
	CAIN C,"<"		;"<"?
	JRST MAC30		;YES, PROCESS AS SPECIAL
	CAIE C,176
	CAIN C,134		;"\"
	JRST MAC40		;YES, PROCESS SYMBOL
	;..
MAC14:	CAIN C,","		;","?
	JRST [JUMPG SDEL,MAC14B	;[656] YES, IGNORE IF PART OF ARG
		JRST MAC16]	;[656] OTHERWISE END OF ARG
	JUMPGE SDEL,[CAIN C,"("	;IF IN (), CHECK AND COUNT
		AOS SDEL	;..
		CAIN C,")"	;..
		SOJL SDEL,MAC16	;JUMP IF END OF ARGLIST
		SKIPE MACTAB	;[1032] IF NOT MACMPD,
		JRST MAC14C	;[1032] DO .XTABM/.ITABM TEST
		JRST MAC14B]	;[1032] ELSE FORCE .ITABM IN ()
	SKIPN MACTAB		;[671] NEW ARG HANDLING IF MACTAB=0
	JRST .+3		;[671] ASSUME ITABM=0
MAC14C:	SKIPE ITABM		;[1032] OLD FORMAT WANTED?
	JRST MAC14B		;YES, NO FURTHER CHECKS
	CAIE C," "		;SPACE OR TAB?
	CAIN C,HT
	JRST MACTB		;YES, GO SEE WHAT FOLLOWS
	SKIPE MACTAB		;[671] SKIP REST IF OLD FORMAT
	JRST MAC14B		;NO
	JUMPGE SDEL,MAC14B	;[1032] IF IN PARENS NO FURTHER CHECKS
	CAIN C,42		;A QUOTE MARK?
	JRST MAC12B		;YES, GO QUOTE TIL ANOTHER QUOTE
	CAIN C,"<"		;OPEN ANG BKT?
	JRST MAC12		;YES, QUOTE TO CLOSE
	CAIE C,"("
	CAIN C,"["		;CHECK FOR BKTS AND PARENS
	JRST MAC12		;OPEN BKT, GO SCAN TO CLOSE BKT
	CALL SKPNTM		;CHECK FOR UNMATCHED TERMINATORS
	 JRST MAC9		;FOUND ONE, END OF ARG LIST
MAC14B:	SKIPLE SX		;IGNORE IF NO ARGS LEFT
	CALL WCHAR		;WRITE INTO SKELETON
MAC14A:	JUMPGE SDEL,[CALL GCHAR	;[673] IF IN (), LIST CRLFS CORRECTLY
		JRST .+2]	;[673] THEN SKIP LOCAL CALL
	CALL CHARAC		;GET NEXT CHARACTER
	CAIE C,177		;RUB-OUT?
	JRST MAC14E		;NO,
	MOVSI CS,(BYTE (7) 177,5) ;YES, A REAL RUBOUT, PUT INTO SKELETON
	CALL WWRXE		;(177,5)
	JRST MAC14A
MAC14E:	JUMPGE SDEL,MAC14	;IGNORE TEST IF IN ()
	CAIG C,CR
	CAIGE C,LF
	CAIN C,";"
	JRST MAC15
	JRST MAC14		;JUMP IF NOT END OF LINE

MAC9:	SETOM SDEL		;FORCE END OF ARG LIST
MAC15:	TLO IO,IORPTC
MAC16:	JUMPLE SX,MAC17		;SKIP IF NO ARGS LEFT
	MOVSI CS,(BYTE (7) 177,2)
	CALL WWRXE		;WRITE END
	EXCH MP,RP
	PUSH MP,WWRXX
	EXCH MP,RP
MAC17:	SUBI SX,1		;DECREMENT ARG COUNT
	JUMPGE SDEL,MAC10	;IF IN () KEEP LOOKING
	TRNN SDEL,1B18		;SKIP LOOKING IF SEEN ")"
	JUMPG SX,MAC10		;NO, BUT MORE ARGS TO COME
MAC20:	TLZN IO,IORPTC
	CALL CHARAC
MAC21:	EXCH MP,RP
	JUMPE SX,MAC21B		;NO MISSING ARGS
MAC21A:	PUSH MP,[-1]		;FILL IN MISSING ARGS
	SKIPN .TEMP		;ANY DEFAULT ARGS?
	JRST MAC21C		;NO
	HRRZ C,.TEMP		;GET ARG COUNT
	SUBI C,-1(SX)		;ACCOUNT FOR THOSE GIVEN
	HRLZS C			;PUT IN LEFT HALF
	HLRZ SDEL,.TEMP		;ADDRESS OF TABLE
MAC21D:	SKIPN (SDEL)		;END OF LIST
	JRST MAC21C		;YES
	XOR C,(SDEL)		;TEST FOR CORRECT ARG
	TLNN C,-1		;WAS IT?
	JRST MAC21E		;YES
	XOR C,(SDEL)		;BACK THE WAY IT WAS
	AOJA SDEL,MAC21D	;AND TRY AGAIN

MAC21E:	MOVEM C,(MP)		;REPLACE -1 WITH TREE POINTER
	AOS 1(C)		;INCREMENT REFERENCE
MAC21C:	SOJG SX,MAC21A
MAC21B:	PUSH MP,[0]		;SET TERMINAL
	EXCH MP,RP		;[1015] 
	HRRZ C,LIMBO
	TLNN IO,IOSALL		;SUPPRESSING ALL?
	JRST MAC23		;NO
	JUMPN MRP,MAC27		;IN MACRO?
	CALL SEMSRC		;CHECK FOR IMMEDIATE COMMENT
	  JRST MAC26		;NOT FOUND, CONTINUE
MAC22:	CALL CHARAC		;YES,GET IT INTO THE LBUF
	CAIG C,CR		;LESS THAN CR?
	CAIGE C,LF		;AND GREATER THAN LF?
	JRST MAC22		;NO GET ANOTHER
MAC26:	CALL DECLBP		;DECREMENT LINE BUFFER POINTER
MAC27:	HRLI C,-1		;SET FLAG
	JRST MAC25
MAC23:	SKIPN MRP		;[1072] INSIDE A MACRO?
	TLZ IO,IOMAC		;[1072] NO - CLEAR EXPANSION FLAG FOR LISTING
	MOVEI SX,"^"
	DPB SX,LBUFP		;SET ^ INTO LINE BUFFER
	JUMPAD MAC25		;BRANCH IF ADDRESS FIELD
	JUMPN MRP,MAC25		;BRANCH IF ALREADY IN A MACRO
	SKIPN LITLVL		;BRANCH IF WITHIN A LITERAL
	SKIPE RPOLVL		;OR IN A REPEAT
	JRST MAC25
	CALL RSW3		;OUTPUT C AGAIN (OVERWRITTEN BY "^")
	CALL SEMSRC		;LOOK FOR A COMMENT
	  JRST MAC24		;NO COMMENT CONTINUE
	CALL STOUT		;LIST COMMENT OR CR-LF
	TLNE IO,IOPALL		;MACRO EXPANSION SUPPRESSION?
	TLO IO,IOMAC		; NO, SET TEMP BIT
	TDOA C,[-1]		;FLAG LAST CHARACTER
MAC24:	CALL DECLBP		;DECREMENT BYTE POINTER
MAC25:	EXCH MP,RP		;[1015]
	PUSH MP,MACPNT
	POP P,MACPNT
	PUSH MP,C
	PUSH MP,RCOUNT		;STACK WORD COUNT
	PUSH MP,MRP		;STACK MACRO POINTER
	POP P,MRP		;SET NEW READ POINTER
	EXCH MP,RP
	AOS MACLVL
	HRRZS MACENL		;RESET "CALLM IN PROGRESS"
	JUMPOC STMNT2		;OP-CODE FIELD
	JRST EVATOM		;ADDRESS FIELD

;ROUTINE TO LOOK FOR A SEMICOLON, IGNORING SPACES AND TABS
; SKIP IF FOUND
	CALL CHARAC		;FETCH ANOTHER CHARACTER
SEMSRC:	CAIE C," "		;SPACE?
	CAIN C,HT		;OR TAB?
	JRST .-3		;YES, GET ANOTHER CHARACTER
	CAIN C,";"		;NO, SEMICOLON?
CPOPJ1:	AOS (P)			;[664] YES, SKIP RETURN
CPOPJ:	RET			;[664]

;ROUTINE TO DECREMENT BYTE POINTER LBUFP
DECLBP:	HRLZI SX,70000		;INCREASE P FIELD BY 1 BYTE
	ADDB SX,LBUFP
	JUMPGE SX,CPOPJ		;RETURN IF NO OVERFLOW
	HRLOI SX,347777		;OVERFLOW, BACKUP ONE WORD
	ADDM SX,LBUFP
	RET
;HERE WHEN ENCOUNTERED UNQUOTED TAB OR SPACE IN MACRO ARGUMENT.
;"LOOK AHEAD" TO SEE IF END OF ARG LIST COMING UP.
;IF ARG LIST END FOUND, FLUSH TRAILING TABS/SPACES, OTHERWISE
;KEEP THEM.  BUFFER TAB/SPACE STRING ON STACK.
MACTB:	MOVE AC2,P		;SAVE CURRENT STACK PTR
	HRRZ AC1,AC2		;CONSTRUCT BYTE PTR TO STACK
	HRLI AC1,(<POINT 7,0,34>) ;..
	MOVEI AC0,0		;INIT CHAR COUNT
MACTB1:	TLNN AC1,(76B5)		;NEED ANOTHER STACK WORD?
	PUSH P,[0]		;YES, GET IT
	IDPB C,AC1		;BUILD TEMP STRING
	AOS AC0			;COUNT CHARS STORED
	CALL CHARAC		;GET NEXT CHAR
	CAIE C," "		;ANOTHER SPACE OR TAB?
	CAIN C,HT		;..
	JRST MACTB1		;YES, KEEP SCANNING
	PUSH P,C		;NO, SAVE IT
	JUMPGE SDEL,[CAIE C,","	;[1032] SPECIAL CHECKS FOR PARENS
		CAIN C,")"	;[1032] ARG TERMINATORS ARE
		JRST MACTB2	;[1032] COMMA AND CLOSE PAREN
		JRST MACTB4]	;[1032] ELSE RETAIN TAB/SPACE
	CAIG C,CR		;END OF LINE?
	CAIGE C,LF		;..
	CAIN C,";"		;OR SEMICOLON?
	JRST MACTB2		;YES, FLUSH TEMP STRING
	CAIE C,","		;END OF ARGUMENT?
	CALL [SKIPE MACTAB	;[664] OR ARG LIST TERMINATOR?
		JRST CPOPJ1	;[664] (SKIP RETURN IF OLD FORMAT)
		PJRST SKPNTM]	;[664]
	 JRST MACTB2		;YES
MACTB4:	HRRZ AC1,AC2		;[1032] NO, MUST KEEP TEMP STRING
	HRLI AC1,(<POINT 7,0,34>) ;REINIT BYTE PTR
MACTB3:	ILDB C,AC1		;COPY TEMP STRING TO SKELETON
	SKIPLE SX		;UNLESS HAVE ALL ARGS NOW
	CALL WCHAR		;..
	SOJG AC0,MACTB3		;..
MACTB2:	POP P,C			;RECOVER LAST CHAR
	MOVEM AC2,P		;FLUSH TEMP STRING FROM STACK
	JRST MAC14E		;CONTINUE PROCESSING

;TEST FOR UNMATCHED BRACKETING PAIR - TERMINATES ARG LIST IF NOT
;QUOTED.
SKPNTM:	CAIE C,")"		;[664] PAIRS ARE PARENS, BRACKETS, AND
	CAIN C,"]"		;ANG BKTS
	RET			;TERMINATOR, NOSKIP
	CAIE C,">"
	AOS 0(P)		;[664] NON-TERMINATOR, SKIP
	RET
;HERE ON OPEN ANG BKT AS FIRST CHAR IN ARG
MAC30:	MOVEI AC0,0		;INITIALIZE BRACKET COUNTER
MAC31:	CALL GCHAR		;GET A CHARACTER
	CAIN C,"<"		;"<"?
	ADDI AC0,1		;YES, INCREMENT COUNT
	CAIN C,">"		;">"?
	SOJL AC0,MAC14A		;YES, EXIT IF MATCHING
	SKIPLE SX		;IGNORE IF NO ARGS LEFT
	CALL WCHAR		;WRITE INTO SKELETON
	JRST MAC31		;GO BACK FOR ANOTHER

;HERE IF ENCOUNTERED UNQUOTED "<", "[", OR "(".  SCAN TO MATCHING
;CLOSE WITHOUT TERMINATING ARG.
MAC12:	MOVEI AC0,0		;INIT BKT COUNT
	PUSH P,C		;SAVE CHAR
	CAIN C,"<"		;GET MATCHING CLOSE CHARACTER
	MOVEI C,">"
	CAIN C,"["
	MOVEI C,"]"
	CAIN C,"("
	MOVEI C,")"
	PUSH P,C		;SAVE TERMINATOR
	MOVE C,-1(P)		;GET ORIG CHAR
MAC12A:	SKIPLE SX		;FLUSH CHAR IF NO ARGS LEFT
	CALL WCHAR		;STOR CHAR
	CAMN C,-1(P)		;ANOTHER OPEN?
	AOS AC0			;YES, COUNT UP
	CAMN C,0(P)		;A CLOSE?
	SOJLE AC0,[SUB P,[2,,2]	;YES. IF MATCH, CLEAR STACK
		JRST MAC14A]	;AND RESUME NORMAL SCAN
	CALL GCHAR		;GET NEXT CHAR
	JRST MAC12A		;CONTINUE SCAN

;HERE IF ENCOUNTERED UNQUOTED QUOTED MARK.
;SCAN TO ANOTHER QUOTE MARK WITHOUT TERMINATING ARG.
MAC12B:	PUSH P,C		;SAVE THE QUOTE MARK
MAC12C:	SKIPLE SX		;FLUSH CHAR IS NO ARGS LEFT
	CALL WCHAR		;WRITE IT OUT
	CALL GCHAR		;GET NEXT CHAR
	CAME C,0(P)		;ANOTHER QUOTE MARK?
	JRST MAC12C		;NO, LOOP
	SKIPLE SX		;YES, DECIDE TO WRITE OR SKIP
	CALL WCHAR		;WRITE QUOTE MARK OUT
	POP P,0(P)		;CLEAR STACK
	JRST MAC14A		;RESUME NORMAL SCAN
;HERE ON BACKSLASH AS FIRST CHAR IN ARG
MAC40:	PUSH P,SX		;STACK REGISTERS
	PUSH P,SDEL
	PUSH P,IO		;SAVE IO FLAGS
	PUSH P,CURADX		;[635] DEFAULT VALUES
	POP P,MACDVR		;[635] FOR DIVISOR
	MOVEI AC1,"0"		;[635] AND ADDER
	MOVEM AC1,MACADR	;[635]
	CALL PEEK		;[635] CHECK NEXT CHAR
	CAIN C,47		;[635] SINGLE-QUOTE?
	JRST [	CALL GETCHR	;[635] YES,
		MOVEI AC1,100	;[635]
		MOVEM AC1,MACDVR ;[635]
		MOVEI AC1,40	;[635]
		MOVEM AC1,MACADR ;[635]
		JRST MAC43]	;[635]
	CAIN C,42		;[635] DOUBLE-QUOTE?
	JRST [	CALL GETCHR	;[635] YES,
		MOVEI AC1,200	;[635]
		MOVEM AC1,MACDVR ;[635]
		SETZM MACADR	;[635]
		JRST MAC43]	;[635]
MAC43:	CALL CELL		;[635] GET AN ATOM
	MOVE V,AC0		;ASSUME NUMERIC
	TLNE IO,NUMSW		;GOOD GUESS?
	JRST MAC41		;YES
	CALL SSRCH		;SEARCH THE SYMBOL TABLE
	 TROA ER,ERRX		;NOT FOUND, ERROR
MAC41:	CALL MAC42		;FORM ASCII STRING
	TLNE IO,IOCREF		;[704] IOCREF SET DURING CALL TO SSRCH?
	JRST [HLL IO,0(P)	;[704] YES, DON'T LOSE IT
		TLO IO,IOCREF	;[704]
		JRST .+2]	;[704]
	HLL IO,0(P)		;RESTORE IO FLAGS
	POP P,0(P)		;FLUSH TEMP
	POP P,SDEL
	POP P,SX
	TLO IO,IORPTC		;REPEAT LAST CHARACTER
	JRST MAC14A		;RETURN TO MAIN SCAN

MAC42:	MOVE SX,-3(P)		;[1127] GET ARG COUNT
	JUMPLE SX,CPOPJ		;[1127] NO ARGS LEFT
	MOVE C,V
MAC44:	LSHC C,-^D35
	LSH CS,-1
	DIV C,MACDVR		;[635] DIVIDE BY THE RIGHT DIVISOR
	HRLM CS,0(P)
	JUMPE C,.+2		;TEST FOR END
	CALL MAC44
	HLRZ C,0(P)
	ADD C,MACADR		;[635] ADD THE RIGHT ADDER TO FORM TEXT
	JRST WCHAR		;WRITE INTO SKELETON
MACEN0:	SOS MACENL
MACEND:	HRRZ C,0(P)		;GET TOP ADDRESS
	CAIN C,MAC14E		;WERE WE LOOKING FOR CLOSE PAREN?
	JUMPGE SDEL,MPAERR	;YES, GIVE USEFUL ERROR MESSAGE
	SKIPGE C,MACENL		;TEST "CALLM IN PROGRESS"
	AOS MACENL		;INCREMENT END LEVEL AND EXIT
	JUMPL C,REPEA8
	EXCH MP,RP
	POP MP,MRP		;RETRIEVE READ POINTER
	POP MP,RCOUNT		;AND WORD COUNT
	MOVEI C,"^"
	SKIPL 0(MP)		;TEST FLAG
	CALL RSW2		;MARK END OF SUBSTITUTION
	POP MP,C
	POP MP,ARG
	SKIPA MP,MACPNT		;RESET MP AND SKIP
MACEN1:	CALL REFDEC		;DECREMENT REFERENCE
MACEN2:	AOS V,MACPNT		;GET POINTER
	MOVE V,0(V)
	JUMPG V,MACEN1		;IF >0, DECREMENT REFERENCE
	JUMPL V,MACEN2		;IF <0, BYPASS
	POP MP,V		;IF=0, RETRIEVE POINTER
	CALL REFDEC		;DECREMENT REFERENCE
	MOVEM ARG,MACPNT
	EXCH MP,RP
	SOS MACLVL
	SKIPN MACENL		;CHECK UNPROCESSED END LEVEL
	JRST MACEN3		;NONE TO PROCESS
	TRNN MRP,-1		;MRP AT END OF TEXT
	JRST MACEN0		;THEN POP THE MACRO STACK NOW
MACEN3:	TRNN C,77400		;SALL FLAG?
	HRLI C,0		;YES,TURN IT OFF
	JUMPL C,REPEA8		;IF FLAG SET SUBSTITUTE
	JRST RSW2
IRP0:	SKIPN MACLVL		;ARE WE IN A MACRO?
	JRST ERRAX		;NO, BOMB OUT
IRP10:	CALL MREADS		;YES, GET DATA SPEC
	CAIE C,40		;SKIP LEADING BLANKS
	CAIN C,"("		;"("?
	JRST IRP10		;YES, BYPASS
	CAIE C,"<"
	CAIN C,11
	JRST IRP10
	CAIE C,177		;NO, IS IT SPECIAL?
	JRST ERRAX		;NO, ERROR
	CALL MREADS		;YES
	TRZN C,100		;CREATED?
	JRST ERRAX
	CAIL C,40		;TOO BIG?
	JRST ERRAX
	ADD C,MACPNT		;NO, FORM POINTER TO STACK
	PUSH MP,IRPCF		;STACK PREVIOUS POINTERS
	PUSH MP,IRPSW
	PUSH MP,IRPARP
	PUSH MP,IRPARG
	PUSH MP,IRPCNT
	PUSH MP,0(C)
	PUSH MP,IRPPOI
	HRRZM C,IRPARP
	MOVEM AC0,IRPCF		;IRPC FLAG FOUND IN AC0
	SETOM IRPSW		;RESET IRP SWITCH
	MOVE CS,0(C)
	MOVEM CS,IRPARG

IRP15:	CALL MREADS		;GET A CHARACTER LOOKING FOR "<"
	CAIE C,"<"		;"<"?
	JRST [	CAIE C,","	;ALLOW COMMA
		CAIG C," "	;ALLOW TEST FORMATTING CHARS
		JRST IRP15	;IT WAS ONE, JUST GET ANOTHER
		CAIE C,")"	;ALLOW )
		CAIN C,">"	;ALLOW RIGHT ANGLE BRACKET
		JRST IRP15	;GO BACK FOR ANOTHER
		JRST IRPMBI]	;CAN'T FIND BRACKET, IT'S AN ERROR
	CALL SKELI1		;INITIALIZE NEW STRING
	MOVEM ARG,IRPPOI	;SET NEW POINTER
	TDZA SDEL,SDEL		;ZERO BRACKET COUNT AND SKIP

IRP20:	CALL WCHAR		;[664]
	CALL MREADS
	CAIN C,"<"		;"<"?
	AOJA SDEL,IRP20		;YES, INCREMENT COUNT AND WRITE
	CAIE C,">"		;">"?
	JRST IRP20		;NO, JUST WRITE IT
	SOJGE SDEL,IRP20	;YES, WRITE IF NOT MATCHING
	MOVE CS,[BYTE (7) 15,177,4]
	CALL WWRXE		;WRITE END
	PUSH MP,MRP		;STACK PREVIOUS READ POINTER
	PUSH MP,RCOUNT		;AND WORD COUNT
	SKIPG CS,IRPARG
	JRST IRPPOP		;EXIT IF NOT VALID ARGUMENT
	MOVEI C,1(CS)		;INITIALIZE POINTER
	MOVEM C,IRPARG
IRPSET:	EXCH MRP,IRPARG		;SWAP READ POINTERS
	MOVE SX,RCOUNT		;SWAP COUNT OF WORDS TO READ
	EXCH SX,IRPCNT
	MOVEM SX,RCOUNT
	CALL SKELI1		;INITIALIZE SKELETON FOR DATA
	HRRZM ARG,@IRPARP	;STORE NEW DS POINTER
	SETZB SX,SDEL		;ZERO FOUND FLAG AND BRACKET COUNT
	LDB C,MRP		;GET LAST CHAR
	CAIN C,","
	SKIPE IRPCF		;IN IRPC
	JRST IRPSE1		;NO
	MOVEI SX,1		;FORCE ARGUMENT
IRPSE1:	CALL MREADS
	CAIE C,177		;SPECIAL?
	AOJA SX,IRPSE2		;NO, FLAG AS FOUND
	CALL PEEKM		;LOOK AT NEXT CHARACTER
	SETZM IRPSW		;SET IRP SWITCH
	JUMPG SX,IRPSE4		;IF ARG FOUND, PROCESS IT
	JRST IRPPOP		;NO, CLEAN UP AND EXIT

IRPSE2:	SKIPE IRPCF		;IRPC?
	JRST IRPSE3		;YES, WRITE IT
	CAIN C,","		;NO, IS IT A COMMA?
	JUMPE SDEL,IRPSE4	;YES, EXIT IF NOT NESTED
	CAIN C,"<"		;"<"?
	ADDI SDEL,1		;YES, INCREMENT COUNT
	CAIN C,">"		;">"?
	SUBI SDEL,1		;YES, DECREMENT COUNT

IRPSE3:	CALL WCHAR
	SKIPN IRPCF		;IRPC?
	JRST IRPSE1		;NO, GET NEXT CHARACTER

IRPSE4:	MOVSI CS,(BYTE (7) 177,2)
	CALL WWRXE		;WRITE END
	MOVEM MRP,IRPARG	;SAVE POINTER
	MOVE MRP,RCOUNT		;SAVE COUNT
	MOVEM MRP,IRPCNT
	HRRZ MRP,IRPPOI		;SET FOR NEW SCAN
	AOJA MRP,REPEA8		;ON ARG COUNT

IRPMBI:	PUSH P,['MCRISI']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	SKIPN IRPCF		;IRPC?
	JRST [MOVSI RC,[SIXBIT / ILLEGAL SYNTAX IN IRP INSIDE MACRO@/] ;[1066][702]
		JRST IRPERR]
	MOVSI RC,[SIXBIT / ILLEGAL SYNTAX IN IRPC INSIDE MACRO@/] ;[1066][702]
IRPERR:	MOVE AC0,CALNAM		;[702] FETCH MACRO NAME
	CALL EFATAL		;[1066] FATAL ERROR, TYPE PREFIX
	CALL TYPMSG		;OUTPUT MESSAGE
	JUMP1 .+2		;ONLY COUNT ERROR ONCE
	AOS ERRCNT		;DO DURING PASS 2
	JRST ERRNE2		;COMMON MESSAGE
STOPI0:	SKIPN IRPARP		;IRP IN PROGRESS?
	JRST ERRAX		;NO, ERROR
	SETZM IRPSW		;YES, SET SWITCH
	RET

IRPEND:	MOVE V,@IRPARP
	CALL REFDEC
	SKIPE IRPSW		;MORE TO COME?
	JRST IRPSET		;YES

IRPPOP:	MOVE V,IRPPOI
	CALL REFDEC		;DECREMENT REFERENCE
	POP MP,RCOUNT
	POP MP,MRP		;RESTORE CELLS
	POP MP,IRPPOI
	POP MP,@IRPARP
	POP MP,IRPCNT
	POP MP,IRPARG
	POP MP,IRPARP
	POP MP,IRPSW
	POP MP,IRPCF
	JRST REPEA8
GETDS:				;GET DUMMY SYMBOL NUMBER
	MOVE CS,C		;USE CS FOR WORK REGISTER
	ANDI CS,37		;MASK
	ADD CS,MACPNT		;ADD BASE ADDRESS
	MOVE V,0(CS)		;GET POINTER FLAG
	JUMPG V,GETDS1		;BRANCH IF POINTER
	TRNN C,40		;NOT POINTER, SHOULD WE CREATE?
	JRST RSW0		;NO, FORGET THIS ARG
	PUSH P,WWRXX
	PUSH P,MWP		;STACK MACRO WRITE POINTER
	PUSH P,WCOUNT		;SAVE WORD  COUNT
	CALL SKELI1		;INITIALIZE SKELETON
	MOVEM ARG,0(CS)		;STORE POINTER
	MOVE CS,[BYTE (7) 0,170,170,170,171] ;CREATE A SYMBOL
	ADD CS,LSTSYM		;LSTSYM= # OF LAST CREATED
	TDZ CS,[BYTE (7) 0,170,170,170,170]
	MOVEM CS,LSTSYM
	TLZE CS,774000		;[1053] ZERO ANY OVERFLOW INTO ".." FIELD
	TRO ER,ERRX		;[1053] X-ERROR FOR EXCEEDING "..7777"
	IOR CS,[ASCII /.0000/]
	MOVEI C,"."
	CALL WCHAR
	CALL WWORD		;WRITE INTO SKELETON
	MOVSI CS,(BYTE (7) 177,2)
	CALL WWRXE		;WRITE END CODE
	POP P,WCOUNT		;RESTORE WORD COUNT
	POP P,MWP		;RESTORE MACRO WRITE POINTER
	POP P,WWRXX
	MOVE V,ARG		;SET UP FOR REFINC

GETDS1:	CALL REFINC		;INCREMENT REFERENCE
	HRL V,RCOUNT		;SAVE WORD COUNT
	PUSH MP,V		;STACK V FOR DECREMENT
	PUSH MP,MRP		;STACK READ POINTER
	MOVEI MRP,1(V)		;FORM READ POINTER
	JRST RSW0		;EXIT

DSEND:	POP MP,MRP
	POP MP,V
	HLREM V,RCOUNT		;RESTORE WORD COUNT
	HRRZS V			;CLEAR COUNT
	CALL REFDEC		;DECREMENT REFERENCE
	JRST RSW0		;EXIT
SKELI1:	MOVEI ARG,1		;ENTRY FOR SINGLE ARG
SKELI:	SETZ MWP,		;SIGNAL FIRST TIME THROUGH
	CALL SKELWL		;GET POINTER WORD
	HRRZM MWP,WWRXX		;SAVE FIRST ADDRESS
	HRRZM MWP,LADR		;SAVE START OF LINKED LIST
	HRRZM ARG,1(MWP)	;STORE COUNT
	SOS WCOUNT		;ACCOUNT FOR WORD
	HRRZ ARG,WWRXX		;SET FIRST ADDRESS
	ADDI MWP,2		;BUMP POINTER
	HRLI MWP,(POINT 7)	;SET FOR 5 ASCII BYTES
	;SKELW RETURNS WITH ADR OF NEXT FREE LOC IN V (RIGHT)

SKELW:	SOSLE WCOUNT		;STILL SOME SPACE IN LEAF?
	RET			;YES, RETURN
SKELWL:	SKIPE V,NEXT		;GET FIRST FREE ADDRESS
	JRST SKELW1		;IF NON-ZERO, UPDATE FREE
	MOVE V,FREE		;GET FREE
	ADDI V,.LEAF		;INCREMENT BY LEAF SIZE
	CAML V,SYMBOL		;OVERFLOW?
	CALL XCEED		;YES, BOMB OUT
	EXCH V,FREE		;UPDATE FREE
	SETZM (V)		;CLEAR LINK

SKELW1:	HLL V,0(V)		;GET ADDRESS
	HLRM V,NEXT		;UPDATE NEXT
	SKIPE MWP		;IF FIRST TIME
	HRLM V,1-.LEAF(MWP)	;STORE LINK IN FIRST WORD OF LEAF
	MOVEI MWP,.LEAF		;SIZE OF LEAF
	MOVEM MWP,WCOUNT	;STORE FOR COUNT DOWN
	MOVEI MWP,(V)		;SET UP WRITE POINTER
	TLO MWP,(POINT 7,,20)	;2 ASCII CHARS
	RET

	;WWRXX POINTS TO END OF TREE
	;MWP IDPB POINTER TO NEXT HOLE
	;NEXT FIRST OF A LINKED PORTION THAT IS NOT BEING USED (LEAVES)
	;FREE POINTS TO FREE CORE BETWEEN TREE AND SYM-TABLE
	;LADR POINTS TO BEG OF LINKED PORTION.
GCHARQ:	JUMPN MRP,MREADS	;IF GETTING CHAR. FROM TREE
GCHAR0:	CALL CHARAC		;[1003] GET ASCII CHAR
	CAIE C,FF		;[1003] FF?
	JRST GCHAR1		;[1003] NO, CHECK RANGE
	PUSH P,C		;[1003] YES, SET IF AT START OF LINE
	MOVE C,CPL		;[1003]
	ADDI C,1		;[1003] COMPENSATE FOR FF
	CAME C,CPLSAV		;[1003]
	JRST [	POP P,C		;[1003] NO, ALL IS OK
		JRST GCHAR2]	;[1003] CHECK FOR ERRORS, LIST
	POP P,C			;[1003]
OUTFF3:	CALL OUTFF1		;[1003] COMMON ROUTINE TO SET IOPAGE
	CALL OUTLI		;[1003] CLEAR LBUF
	SOS TAGINC		;[1003] RECOVER CORRECT OFFSET
	RET			;[1003] RETURN WITH FF IN C

GCHAR:	CALL CHARAC		;GET ASCII CHARACTER
GCHAR1:	CAIG C,FF		;[753] TEST FOR LF, VT OR FF
	CAIGE C,LF
	RET			;NO
GCHAR2:	TRNN ER,ERRORS		;[1003][663] YES, ERRORS?
	JRST OUTIM1		;[663] NO, NORMAL IMAGE
	TRNN ER,ERROR1		;[663] ONLY PASS1 ERRORS IN PASS1
	JUMP1 OUTIM1		;[663]
	TLO FR,IOSCR		;[663] SET IMAGE/CRLF FLAG
	JRST OUTLIN		;[663] OUTPUT LINE, EXIT BY OUTLI1

WCHAR:	TLNN MWP,760000		;[664] END OF WORD?
	CALL SKELW		;YES, GET ANOTHER
	IDPB C,MWP		;STORE CHARACTER
	RET

WWORD:	LSHC C,7		;MOVE ASCII INTO C
	CALL WCHAR		;[664] STORE IT
	JUMPN CS,WWORD		;TEST FOR END
	RET			;YES, EXIT

WWRXE:	CALL WWORD		;WRITE LAST WORD
	ADD MWP,WCOUNT		;GET TO END OF LEAF
	SUBI MWP,.LEAF		;NOW POINT TO START OF IT
	HRRZS (MWP)		;ZERO LEFT HALF OF LAST LEAF
	HRRM MWP,@WWRXX		;SET POINTER TO END
	RET

MREAD:	CALL MREADS		;READ ONE CHARACTER
	CAIE C,177		;SPECIAL?
	JRST RSW1		;NO, EXIT
	CALL MREADS		;YES, GET CODE WORD
	TRZE C,100		;SYMBOL?
	JRST GETDS		;YES
	CAILE C,5		;POSSIBLY ILLEGAL
	JRST ERRAX		;YUP
	HRRI MRP,0		;NO, SIGNAL END OF TEXT
	JRST .+1(C)
	CALL XCEED
	JRST MACEND		;1; END OF MACRO
	JRST DSEND		;2; END OF DUMMY SYMBOL
	JRST REPEND		;3; END OF REPEAT
	JRST IRPEND		;4; END OF IRP
	JRST RSW1		;5; RUBOUT

MREADI:	HRLI MRP,700		;SET UP BYTE POINTER
	MOVEI C,.LEAF-1		;NUMBER OF WORDS
	MOVEM C,RCOUNT
MREADS:	TLNN MRP,-1		;FIRST TIME HERE?
	JRST MREADI		;YES, SET UP MRP AND RCOUNT
	TRNN MRP,400000		;[1061] IF MRP IS ZERO, NEGATIVE OR
	TRNN MRP,-1		;[1061] GREATER THAN 400000,
	JRST DECERR		;[1061] CONFUSED WHILE EXPANDING (E.G.,
				;[1061] UNQUOTED, UNMATCHED "[","(",ETC)
	TLNN MRP,760000		;HAVE WE FINISHED WORD?
	SOSLE RCOUNT		;YES, STILL ROOM IN LEAF?
	JRST MREADC		;STILL CHAR. IN LEAF
	HLRZ MRP,1-.LEAF(MRP)	;YES, GET LINK
	HRLI MRP,(POINT 7,,20)	;SET POINTER
	MOVEI C,.LEAF		;RESET COUNT
	MOVEM C,RCOUNT
MREADC:	ILDB C,MRP		;GET CHARACTER
	RET			;[1061]

PEEK:	JUMPN MRP,PEEKM		;THIS IS A MACRO READ
	CALL CHARAC		;READ AN ASCII CHAR.
	TLO IO,IORPTC		;REPEAT  FOR NEXT
	RET			;AND RETURN

PEEKM:	PUSH P,MRP		;SAVE MACRO READ POINTER
	PUSH P,RCOUNT		;SAVE WORD COUNT
	CALL MREADS		;READ IN A CHAR.
	POP P,RCOUNT		;RESTORE WORD COUNT
	POP P,MRP		;RESET READ POINTER
	RET			;IORPTC IS NOT SET
REFINC:	AOS 1(V)		;INCREMENT REFERENCE
	RET

REFDEC:	TRNN V,400000		;[1061] IF V IS 0, NEGATIVE OR
	TRNN V,-1		;[1061] GREATER THAN 400000,
	JRST DECERR		;[1061] CATASTROPHIC ERROR SOMEWHERE
	SOS CS,1(V)		;DECREMENT REFERENCE
	TRNE CS,000777		;IS IT ZERO?
	RET			;NO, EXIT
	CAMGE V,UNITOP		;IS THIS IN UNIV AREA?
	JRST REFINC		;YES, PUT IT BACK, DON'T DELETE
	HRRZ CS,0(V)		;YES, GET POINTER TO END
	HRL CS,NEXT		;GET POINTER TO NEXT RE-USABLE
	HLLM CS,0(CS)		;SET LINK
	HRRM V,NEXT		;RESET NEXT
	RET

DECERR:	PUSH P,['MCREWE']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / ERROR WHILE EXPANDING@/] ;[1066]
	JRST IRPERR		;[702] COMMON MESSAGE

MPAERR:	PUSH P,['MCRMPA']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / MISSING CLOSE PAREN AROUND ARG LIST OF@/] ;[1066]
	JRST IRPERR		;[702] COMMON MESSAGE
A== 0				;ASCII MODE
AL== 1				;ASCII LINE MODE
IB== 13				;IMAGE BINARY MODE
B== 14				;BINARY MODE

;  ==   0			;USED BY HELPER AND GETSEGS
CTL== 1				;CONTROL DEVICE NUMBER
   IFN CCLSW,<CTL2==5>		;INPUT DEV FOR CCL FILE
BIN== 2				;BINARY DEVICE NUMBER
CHAR== 3			;INPUT DEVICE NUMBER
LST== 4				;LISTING DEVICE NUMBER
UNV== 6				;SYMBOL TABLE FILE (UNIVERSAL)

;	COMMAND STRING ACCUMULATORS

ACDEV== 1			;DEVICE
ACFILE==2			;FILE
ACEXT== 3			;EXTENSION
ACPPN== 4			;PPN
ACDEL== 4			;DELIMITER
ACPNTR==5			;BYTE POINTER

TIO== 6

TIORW== 1000
TIOLE== 2000
TIOCLD==20000

DIRBIT==4			;DIRECTORY DEVICE
TTYBIT==10			;TTY
MTABIT==20			;MTA
DTABIT==100			;DTA
DISBIT==2000			;DISPLAY
CONBIT==20000			;CONTROLING TTY
LPTBIT==40000			;LPT
DSKBIT==200000			;DSK

;GETSTS ERROR BITS

IOIMPM==400000			;IMPROPER MODE (WRITE LOCK)
IODERR==200000			;DEVICE DATA ERROR
IODTER==100000			;CHECKSUM OR PARITY ERROR
IOBKTL== 40000			;BLOCK TOO LARGE
ERRBIT==IOIMPM!IODERR!IODTER!IOBKTL

SYN .TEMP,PPN
SUBTTL I/O ROUTINES

BEG:
   IFN CCLSW,<TLZA IO,ARPGSW	;DON'T ALLOW RAPID PROGRAM GENERATION
	TLO IO,ARPGSW>		;ALLOW RAPID PROGRAM GENERATION
   IFN PURESW,<
	MOVE MRP,[XWD LOWL,LOWL+1] ;START OF DATA
	SETZM LOWL		;ZERO FIRST WORD
	BLT MRP,LOWEND		;AND THE REST
	MOVE MRP,[XWD LOWH,LOWL] ;PHASED CODE
	BLT MRP,LOWL+LENLOW>	;MOVE IT IN
	HRRZ MRP,.JBREL		;GET LOWSEG SIZE
	MOVEM MRP,MACSIZ	;SAVE CORE SIZE
				;DECODE VERSION NUMBER
	MOVEI P,JOBFFI		;TEMP PUSH DOWN STACK
	PUSH P,[0]		;MARK BOTTOM OF STACK
	LDB 0,[POINT 3,.JBVER,2] ;GET USER BITS
	JUMPE 0,GETE		;NOT SET IF ZERO
	ADDI 0,"0"		;FORM NUMBER
	PUSH P,0		;STACK IT
	MOVEI 0,"-"		;SEPARATE BY HYPHEN
	PUSH P,0		;STACK IT ALSO
GETE:	HRRZ 0,.JBVER		;GET EDIT NUMBER
	JUMPE 0,GETU		;SKIP ALL THIS IF ZERO
	MOVEI 1,")"		;ENCLOSE IN PARENS.
	PUSH P,1
GETED:	IDIVI 0,8		;GET OCTAL DIGITS
	ADDI 1,"0"		;MAKE ASCII
	PUSH P,1		;STACK IT
	JUMPN 0,GETED		;LOOP TIL DONE
	MOVEI 0,"("		;OTHER PAREN.
	PUSH P,0
GETU:	LDB 0,[POINT 6,.JBVER,17] ;UPDATE NUMBER
	JUMPE 0,GETV		;SKIP IF ZERO
	IDIVI 0,^D26		;MIGHT BE TWO DIGITS
	ADDI 1,"@"		;FORM ALPHA
	PUSH P,1
	JUMPN 0,GETU+1		;LOOP IF NOT DONE
GETV:	LDB 0,[POINT 9,.JBVER,11] ;GET VERSION NUMBER
	IDIVI 0,8		;GET DIGIT
	ADDI 1,"0"		;TO ASCII
	PUSH P,1		;STACK
	JUMPN 0,GETV+1		;LOOP
	MOVE 1,[POINT 7,VBUF+1,20] ;POINTER TO DEPOSIT IN VBUF
	POP P,0			;GET CHARACTER
	IDPB 0,1		;DEPOSIT IT
	JUMPN 0,.-2		;KEEP GOING IF NOT ZERO
   IFN FORMSW,<IFE DFRMSW,<
	SETOM PHWFMT>>		;HALF WORD UNLESS CHANGED BY SWITCH
   IFN CCLSW,<
	TLZA IO,CRPGSW		;SET TO INIT NEW COMMAND FILE
M:	TLNN IO,CRPGSW>		;CURRENTLY DOING RPG?
   IFE CCLSW,<M:>
	RESET			;INITIALIZE PROGRAM
	SETZM LITLST		;NOLIST LITERALS INLINE UNLESS CHANGED
	SETZM BLSW
	SETZM IFXLSW
	SETZM MACPRF		;DEFAULT IS OLD WAY
	SETZM BINDEV		;CLEAR IN CASE NOT USED NEXT TIME
	SETZM LSTDEV		;SAME REASON
	SETZM INDEV		;IN CASE OF ERROR
   IFN TOPS20,<			;FOR LONG FILES
	SETZM DINDEV		;NO STICKY DEVICE
	SETZM DINDIR		;NO STICKY INPUT DIRECTORY
   >				;[1024]
	HRRZ MRP,MACSIZ		;GET INITIAL SIZE
	CORE MRP,		;BACK TO ORIGINAL SIZE
	  JFCL			;SHOULD NEVER FAIL
	SKIPE UNIFLG		;[700] DOING RESCAN?
	JRST [SETZB MRP,PASS1U	;[700] YES, SAVE CTLBUF, CLEAR UNIVS
		SETZM UNISIZ	;[700]
		MOVE [XWD UNISIZ,UNISIZ+1]	;[700]
		BLT UWVER	;[700]
		MOVE [XWD PASS1U,PASS1U+1]	;[700]
		JRST CTLS0]	;[700]
	SETZB MRP,PASS1I
	MOVE [XWD PASS1I,PASS1I+1]
CTLS0:	BLT PASS2X-1		;[700] ZERO THE PASS1 AND PASS2 VARIABLES
;   IFE TOPS20,<			;TOPS20 DEFAULT IS NEW WAY
;	SETOM MACTAB>		;TOPS10 DEFAULT IS OLD WAY
	MOVEI P,JOBFFI		;SET TEMP PUSH-DOWN POINTER
   IFN FORMSW,<
	MOVE CS,PHWFMT		;GET DEFAULT VALUE (PERMANENT)
	MOVEM CS,HWFMT>		;SET IT (TEMP) 
	MOVE CS,[POINT 7,DBUF,6] ;INITIALIZE FOR DATE
	MSTIME 2,		;GET TIME FROM MONITOR
	CALL TIMOUT		;TIME FORMAT OUTPUT
	DATE 1,			;GET DATE
	IBP CS			;PASS OVER PRESET SPACE
	CALL DATOUT		;DATE FORMAT OUTPUT
	MOVSI FR,P1!CREFSW
   IFN CCLSW,<TLNE IO,CRPGSW	;RPG IN PROGRESS?
	JRST GOSET		;YES, GO READ NEXT COMMAND
	TLNE IO,ARPGSW		;NO, RPG ALLOWED?
	JRST RPGSET		;YES, GO TRY
CTLSET:	RELEASE CTL2,>		;IN CASE OF LOOKUP FAILURE
   IFE CCLSW,<CTLSET:>
	MOVSI IO,IOPALL		;ZERO FLAGS
	INIT CTL,AL		;INITIALIZE USER CONSOLE
	SIXBIT /TTY/
	XWD CTOBUF,CTIBUF
	  EXIT			;NO TTY, NO ASSEMBLY
	MOVSI C,'TTY'
	DEVCHR C,		;GET CHARACTERISTICS
	TLNN C,10		;IS IT REALLY A TTY
	EXIT			;NO
	INBUF CTL,1		;INITIALIZE SINGLE CONTROL
	OUTBUF CTL,1		;BUFFERS
	SKIPE UNIFLG		;[700] DOING RESCAN?
	JRST [MOVE AC2,CTL2SV	;[700] YES, GET CHAR COUNT
		SETZM UNIFLG	;[700]
		JRST CTLS3]	;[700] SET PTRS
	CALL CRLF		;OUTPUT CARRIAGE RETURN - LINE FEED
	MOVEI C,"*"
	IDPB C,CTOBUF+1
	OUTPUT CTL,
	MOVE AC1,[POINT 7,CTLBUF] ;BYTE POINTER TO STORE COMMAND
	MOVEI AC2,1		;INITIALIZE CHARACTER COUNT
CTLS2:	SOSGE CTIBUF+2		;USUAL SOSG LOOP ON TTY INPUT
	INPUT CTL,		;GET NEXT BUFFER
	ILDB 0,CTIBUF+1		;GET CHARACTER
	CAIL AC2,CTLSIZ		;NUMBER OF CHARS. ALLOWED
	JRST COMERR		;COMMAND LINE TOO LONG
	CAIN 0,CZ		;TEST FOR ^Z
	JRST CZSTOP		;MONRET TYPE EXIT
	IDPB 0,AC1		;STORE CHAR.
	CAIE 0,33		;TEST FOR ALTMODE
	CAIG 0,FF		;TEST FOR EOL CHAR
	CAIGE 0,LF		;ONE OF FF, VT, OR LF
	AOJA AC2,CTLS2		;NOT END OF LINE YET
	MOVEM AC2,CTL2SV	;[700] SAVE CHAR COUNT IN CASE UNIERR
CTLS3:	MOVEM AC2,CTIBUF+2	;[700] RESET CHAR. COUNT
	MOVE AC1,[POINT 7,CTLBUF] ;BYTE POINTER TO STORE COMMAND
	MOVEM AC1,CTIBUF+1	;RESET BYTE POINTER
   IFN CCLSW,<JRST BINSET	;BEGIN WITH BINARY FILE

RPGSET:
   IFN TEMP,<HRRZ 3,.JBFF	;GET START OF BUFFER AREA
	HRRZ 0,.JBREL		;GET TOP OF CORE
	CAIGE 0,200(3)		;WILL BUFFER FIT?
	JRST [ADDI 0,200	;NO, GET ENUF CORE
		CORE 0,		;CORE UUO
		JRST XCEED2	;FAILED, SO GIVE UP
		JRST .+1]	;CONTINUE
	HRRM 3,TMPFIL+1		;STORE IN TMPCOR UUO IOWD
	SOS TMPFIL+1		;MAKE IT THE PROPER IOWD FORMAT
	HRRM 3,CTLBLK+1		;DUMMY UP BUFFER HEADER
	MOVE 0,[2,,TMPFIL]	;SET UP FOR TEMP CORE READ
	TMPCOR			;READ AND DELETE FILE "MAC"
	  JRST RPGTMP		;NO SUCH FILE IN CORE TRY DISK
	ADD 3,0			;CALCULATE END OF BUFFER
	MOVEM 3,.JBFF		;FIX JOBFF SO FILE WONT BE KILLED
	IMULI 0,5		;CALCULATE CHARACTER COUNT
	ADDI 0,1		;SINCE SOSG HAPPENS AFTER NOT BEFORE
	MOVEM 0,CTLBLK+2	;SET UP CHAR CNT IN BUFFER HEADER
	MOVEI 0,440700		;SET UP BYTE POINTER IN HEADER
	HRLM 0,CTLBLK+1		;BUFFER HEADER NOW SET UP
	SETOM TMPFLG		;MARK THAT A TMPCOR UUO WAS DONE
	JRST RPGS2A		;CONTINUE IN MAIN STREAM
RPGTMP:	SETZM TMPFLG>		;JUST IN CASE
	INIT CTL2,AL		;LOOK FOR DISK
	SIXBIT /DSK/		;...
	XWD 0,CTLBLK		;...
	  JRST CTLSET		;DSK NOT THERE
	HRLZI 3,'MAC'		;###MAC
	MOVEI 3			;COUNT
	PJOB AC1,		;RETURNS JOB NO. TO AC1
RPGLUP:	IDIVI AC1,12		;CONVERT
	ADDI AC2,"0"-40		;SIXBITIZE IT
	LSHC AC2,-6
	SOJG 0,RPGLUP		;3 TIMES
	MOVEM 3,CTLBUF		;###MAC
	HRLZI 'TMP'
	MOVEM CTLBUF+1		;TMP
	SETZM CTLBUF+3		;PROG-PRO
	LOOKUP CTL2,CTLBUF	;COMMAND FILE
	  JRST CTLSET		;NOT THERE
	HLRM EXTMP		;SAVE THE EXTENSION

RPGS2:	INBUF CTL2,1		;SINGLE BUFFERED
RPGS2A:	INIT CTL,AL		;TTY FOR CONSOLE MESSAGES
	SIXBIT /TTY/		;...
	XWD CTOBUF,0		;...
	  EXIT			;NO TTY, NO ASSEMBLY
	OUTBUF CTL,1		;SINGLE BUFFERED
	MOVE .JBFF		;REMEMBER WHERE BINARY BUFFERS BEGIN
	MOVEM SAVFF		;...
	HRRZ .JBREL		;TOP OF CORE
	CAMLE MACSIZ		;SEE IF IT HAS GROWN
	MOVEM MACSIZ		;PREVENTS ADDRESS CHECK ON EXIT
	TLNE IO,CRPGSW		;ARE WE ALREADY IN RPG MODE?
	JRST M			;MUST HAVE COME FROM @ COMMAND, RESET
GOSET:	MOVSI IO,IOPALL!CRPGSW	;SET INITIAL FLAGS
	SKIPE UNIFLG		;[700] IF UNIERR DO RESCAN
	JRST [MOVE AC1,[POINT 7,CTLBUF]	;[700] PTR TO STRING
		MOVEM AC1,CTIBUF+1	;[700]
		MOVE AC2,CTL2SV	;[700] GET COUNT
		MOVEM AC2,CTIBUF+2	;[700]
		SETZM UNIFLG	;[700]
		JRST GOSET3]	;[700]
	MOVEI CS,CTLSIZ		;MAXIMUM CHARS IN A LINE
	MOVE AC1,CTLBLK+2	;NUMBER OF CHARACTERS
	MOVEM AC1,CTIBUF+2	;SAVE FOR PASS 2
	MOVE AC1,[POINT 7,CTLBUF] ;WHERE TO STASH CHARS
	MOVEM AC1,CTIBUF+1	;...
GOSET1:	SOSG CTLBLK+2		;ANY MORE CHARS?
	CALL [IFN TEMP,<SKIPE TMPFLG ;TMPCOR UUO IN PROGRESS?
		   EXIT>	;YES EXIT
		   IN CTL2,	;READ ANOTHER BUFFERFUL
		     RET	;EVERYTHING OK, RETURN
		   STATO CTL2,20000 ;EOF?
		   JRST [PUSH P,['MCRECF'] ;[1066] SET UP PREFIX
			POP P,PREFIX	;[1066]
			HRROI RC,[SIXBIT / ERROR READING COMMAND FILE@/] ;[1066]
			JRST ERRFIN] ;GO COMPLAIN
		   CALL DELETE	;CMD FILE
		   EXIT]	;EOF AND FINISHED
	ILDB C,CTLBLK+1		;GET NEXT CHAR
	MOVE RC,@CTLBLK+1	;CHECK FOR SEQUENCE NUMBERS
	TRNE RC,1		;...
	JRST [AOS CTLBLK+1	;SKIP OVER ANOTHER 5 CHARS
		MOVNI RC,5	;...
		ADDM RC,CTLBLK+2 ;...
		JRST GOSET1 ]	;GO READ ANOTHER CHAR
	JUMPE C,GOSET1		;IGNORE NULLS
	CAIE C," "		;IGNORE SPACES
	CAIN C,HT		;AND TABS
	JRST GOSET1		;ALSO, SAVES SPACE AND COMMAND ERROR
	IDPB C,CTIBUF+1		;STASH AWAY
	AOS CTIBUF+2		;INCREMENT CHAR. COUNT
	CAIE C,12		;LINE FEED OR
	CAIN C,175		;ALTMODE?
	JRST GOSET2		;YES, FINISHED WITH COMMAND
	CAIE C,176
	CAIN C,33
	JRST GOSET2		;ALTMODE.
	SOJG CS,GOSET1		;GO READ ANOTHER
	JRST COMERR		;GO COMPLAIN

GOSET2:	MOVEI C,12		;MAKE SURE THERE'S A LF
	IDPB C,CTIBUF+1		;...
	MOVEM AC1,CTIBUF+1	;SET POINTER TO BEGINNING
	AOS CTIBUF+2		;ADD I TO COUNT
	MOVE CTIBUF+2		;[700] SAVE IN CASE UNIERR
	MOVEM CTL2SV		;[700]
GOSET3:	MOVE SAVFF		;[700] RESET JOBFF FOR NEW BINARY
	MOVEM .JBFF		;...
	JRST BINSET
RPGS1:	CALL DELETE		;DELETE COMMAND FILE
IFE TOPS20,<			;FOR  SHORT FILES
	MOVEM ACDEV,RPGDEV	;GET SET TO INIT
	OPEN CTL2,RPGINI	;DO IT
	JRST EINIT		;ERROR
	MOVEM ACFILE,INDIR	;USE INPUT BLOCK
	MOVEM ACPPN,INDIR+3	;SET PPN 
	HLLZM ACEXT,INDIR+1	;SET FILE EXTENSION
	JUMPN ACEXT,RPGS1A	;EXPLICIT EXTENSION GIVEN, USE IT
   IFE STANSW,<MOVSI ACEXT,'CCL'> ;IF BLANK TRY CCL
   IFN STANSW,<MOVSI ACEXT,'RPG'> ;IF BLANK TRY RPG
	HLLZM ACEXT,INDIR+1	;STORE DEFAULT EXT
	LOOKUP CTL2,INDIR
	  SKIPA ACEXT,INDIR+1	;FAILED, PICKUP EXT AND ERROR CODE
	JRST RPGS1B		;SUCCESS
	TRNE ACEXT,-1		;CHECK FOR ERROR CODE OTHER THAN 0
	JRST RPGLOS		;YES, YOU LOSE
	SETZB ACEXT,INDIR+1	;TRY NULL EXT
RPGS1A:	LOOKUP CTL2,INDIR
	  JRST RPGLOS		;TOTAL FAILURE
>				;END OF TOPS20 EQ CONDITIONAL

IFN TOPS20,<			;FOR LONG FILES
	SKIPN FILNAM		;HAVE A NAME YET?
	CALL NAME1		;NO GO GET THE NAME
	 JFCL			;LET COMPT GENERATE THE ERROR
	MOVE ACPPN,[10,,RPGADR]	;TO GET THE FILE
	COMPT. ACPPN,		;GO GET IT
	 JRST RPGLOS		;NOT THERE
>				;END OF TOPS20 NE CONDITIONAL
RPGS1B:	HLRM ACEXT,EXTMP	;SAVE THE EXTENSION
	HLRZ .JBSA		;RESET JOBFF TO ORIGINAL
	MOVEM .JBFF
	TLO IO,CRPGSW		;TURN ON SWITCH SO WE RESET WORLD
	JRST RPGS2		;AND GO

RPGLOS:	RELEAS CTL2,0
	TLZ IO,CRPGSW		;STOPS IO TO UNASGD CHAN
	JRST ERRCF		;NO FILE FOUND
   >
BINSET:	CALL NAME1		;GET FIRST NAME
	  JRST BINSE3		;NO FILE HERE
	HLLZ ACEXT,ACEXT	;DISALLOW NULL EXTENSION
   IFN CCLSW,<CAIN C,"!"	;WAS THIS AN IMPERATIVE?
	JRST NUNSET		;GET THEE TO A NUNNERY
	CAIN C,"@"		;CHECK FOR A NEW RPG FILE
	JRST RPGS1>
	TLNN FR,CREFSW		;CROSS REF REQUESTED?
	JRST LSTSE1		;YES, SKIP BINARY
   IFN TOPS20,<			;CODE FOR LONG FILE NAMES
	LDB ACDEV,[POINT 7,FILNAM,6] ;GET FIRST ASCII BYTE
	JUMPE ACDEV,[	CAIN C,"," ;IF NULL AND TERM WITH COMMA
			JRST LSTSET ;THEN GO READ LISTING FILE
			CAIN C,"_" ;IF NULL AND TERM WITH _
			JRST GETSEN ;THEN GO READ INPUT FILE
			JRST M]	;ELSE, START OVER
	CAIE C,CR		;NOT NULL. END IN CR?
	CAIN C,LF		;OR LF?
	JRST GETSET		;YES. IT IS AN INPUT FILE

   >				;END OF TOPS20 CONDITIONAL

   IFE TOPS20,<			;CONDITIONAL FOR TOPS10 FILES
	CAIN C,","		;COMMA?
	JUMPE ACDEV,LSTSET	;YES, SKIP BINARY IF NO DEVICE SPECIFIED
	CAIN C,"_"		;LEFT ARROW?
	JUMPE ACDEV,LSTSE1	;YES, SKIP BINARY IF NO DEVICE SPECIFIED
	JUMPE ACDEV,M		;IGNORE IF JUST CR-LF
   >				;END OF TOPS20 EQ CONDITIONAL
	TLO FR,PNCHSW		;OK, SET SWITCH
   IFN TOPS20,<			;CONDITIONAL FOR LONG FILES
	MOVE ACDEV,[10,,BINADR]	;COMPT. ARGS
	COMPT. ACDEV,		;DO UUO
	JRST EINIT1		;REL FILE OPEN ERROR
   >				;END OF CONDITIONAL NE TOPS20
   IFE TOPS20,<			;FOR SHORT FILES
	MOVEM ACDEV,BINDEV	;STORE DEVICE NAME
	MOVEM ACFILE,BINDIR	;STORE FILE NAME IN DIRECTORY
	JUMPN ACEXT,.+2		;EXTENSION SPECIFIED?
	MOVSI ACEXT,'REL'	;NO, ASSUME RELOCATABLE BINARY
	MOVEM ACEXT,BINDIR+1	;STORE IN DIRECTORY
	CAIE ACPPN,SFDADD	;SFD?
	JRST BINSE4
	MOVE ACPPN,[0,,BINSFD]	;RESET POINTER AND
	MOVE AC0,[SFDADD,,BINSFD] ;BLT TO APPROPRIATE BLOCK
	BLT AC0,BINSFD+2+.SFDLN ;
BINSE4:	MOVEM ACPPN,BINDIR+3	;SET PPN
	OPEN BIN,BININI		;INITIALIZE BINARY
	  JRST EINIT		;ERROR
   >				;END OF EQ TOPS20 CONDITIONAL
   IFN TOPS20,<			;FOR LONG FILES
	SETZM FILNAM		;CLEARED
	MOVEI ACDEV,BIN		;CHANNEL
	MOVEM BINDEV		;FOR DEVCHR
   >
	TLZE TIO,TIOLE		;SKIP TO EOT
	MTEOT. BIN,
	TLZE TIO,TIORW		;REWIND REQUESTED?
	MTREW. BIN,		;YES
	JUMPGE CS,BINSE2	;BRANCH IF NO BACK-SPACE
	MTBSF. BIN,		;BACK-SPACE A FILE
	AOJL CS,.-1		;TEST FOR END
	MTWAT. BIN,
	STATO BIN,1B24		;LOAD POINT?
	MTSKF. BIN,		;NO, GO FORWARD ONE
BINSE2:	SOJG CS,.-1		;TEST FORWARD SPACING

	TLNE TIO,TIOCLD		;DIRECTORY CLEAR REQUESTED?
	UTPCLR BIN,		;YES, CLEAR IT
	OUTBUF BIN,2		;SET UP TWO RING BUFFER
BINSE3:	CAIN C,"_"
	JRST GETSET		;NO LISTING
LSTSET:	CALL NAME1		;GET NEXT DEVICE
	  JRST GETSET		;NO FILE HERE
	HLLZ ACEXT,ACEXT	;DISALLOW NULL EXTENSION
LSTSE1:	CAIE C,"_"
	JRST ERRCM
   IFN TOPS20,<			;CONDITIONAL FOR LONG FILE NAMES
	SETZM LSTNAM		;NO DEFAULT LISTING NAME
	HRROI ACDEV,[ASCIZ /LST/] ;DEFAULT EXTENSION
	MOVEM ACDEV,LSTEXT	;TO ARG BLOCK
   >				;END OF NE CONDITIONAL
	TLNE FR,CREFSW		;CROSS-REF REQUESTED?
   IFE TOPS20,<			;FOR SHORT FILES
	JRST LSTSE2		;NO, BRANCH
	JUMPN ACDEV,.+2		;YES, WAS DEVICE SPECIFIED?
	MOVSI ACDEV,'DSK'	;NO, ASSUME DSK
	JUMPN ACFILE,.+2
	MOVE ACFILE,[SIXBIT /CREF/]
	JUMPN ACEXT,.+2
	MOVSI ACEXT,'CRF'
LSTSE2:	JUMPE ACDEV,GETSET	;FORGET LISTING IF NO DEVICE SPECIFIED
	MOVE AC0,ACDEV
   >				;END OF EQ TOPS20 CONDITIONAL

   IFN TOPS20,<			;FOR LONG FILES
	JRST [	LDB ACDEV,[POINT 7,FILNAM,6] ;GET FIRST ASCII BYTE
		JUMPE ACDEV,GETSET ;IF NONE, GO DO INPUT
		JRST LSTSE2]	;IF ONE, USE IT
	HRROI ACDEV,[ASCIZ /CREF/] ;XREF REQUESTED
	MOVEM ACDEV,LSTNAM	;SET UP DEFAULT NAME
	HRROI ACDEV,[ASCIZ /CRF/] ;EXTENSION NAME
	MOVEM ACDEV,LSTEXT	;TO ARG BLOCK
LSTSE2:	MOVE ACDEV,[10,,LSTARG]	;[1024] COMPT. ARGS
	COMPT. ACDEV,		;OPEN FILE
	 JRST EINIT2		;BAD, LST FILE OPEN ERROR
	SETZM FILNAM		;MADE IT
	MOVEI AC0,LST
	MOVEM AC0,LSTDEV	;FOR OTHER GUYS
   >				;END OF CONDITIONAL
	DEVCHR AC0,		;GET CHARACTERISTICS
	TLNE AC0,LPTBIT!DISBIT!TTYBIT
	JRST [	TLNE FR,CREFSW	;[1146] CROSS-REF REQUESTED?
		JRST .+1	;[1146] NO
		TLC AC0,DSKBIT+MTABIT  ;[1146] IF BOTH DSK: AND MTA: THEN
		TLCE AC0,DSKBIT+MTABIT ;[1146] DEVICE IS OK (NUL:)
		JRST ERRCM	;[1146] CAN'T CREF IF NO DIRECTORY
		JRST .+1]	;[1146] DEV WAS NULL, CARRY ON
	AOSA OUTSW+0*TTYSW	;NO, ASSUME TTY
	JRST ERRCM		;YES, ERROR - CREF DEV MUST NOT BE LPT, DIS, OR TTY
	TLNE AC0,CONBIT		;CONTROLING TELETYPE LISTING?
	JRST GETSET		;YES, BUFFER ALREADY SET
	MOVEM ACDEV,LSTDEV	;STORE DEVICE NAME
	AOS OUTSW+0*LPTSW	;SET FOR LPT
   IFE TOPS20,<			;FOR SHORT FILES
	MOVEM ACFILE,LSTDIR	;STORE FILE NAME
	JUMPN ACEXT,.+2
	MOVSI ACEXT,'LST'
	MOVEM ACEXT,LSTDIR+1
	CAIE ACPPN,SFDADD	;SFD?
	JRST LSTSE5
	MOVE ACPPN,[0,,LSTSFD]	;YES, REST POINTER AND
	MOVE AC0,[SFDADD,,LSTSFD] ;BLT TO APPROPRIATE
	BLT AC0,LSTSFD+2+.SFDLN ;
LSTSE5:	MOVEM ACPPN,LSTDIR+3	;SET PPN
	OPEN LST,LSTINI		;INITIALIZE LISTING OUTPUT
	  JRST EINIT		;ERROR
   >				;END OF EQ CONDITIONAL
	TLZE TIO,TIOLE
	MTEOT. LST,
	TLZE TIO,TIORW		;REWIND REQUESTED?
	MTREW. LST,		;YES
	JUMPGE CS,LSTSE3
	MTBSF. LST,
	AOJL CS,.-1
	MTWAT. LST,
	STATO LST,1B24
	MTSKF. LST,
LSTSE3:	SOJG CS,.-1
	TLNE TIO,TIOCLD		;DIRECTORY CLEAR REQUESTED?
	UTPCLR LST,		;YES, CLEAR IT
	OUTBUF LST,2		;SET UP A TWO RING BUFFER
   IFN TOPS20,<
GETSEN:	SETZM FILNAM		;INIT CODE FOR LONG FILES
   >
GETSET:	MOVEI 3,PDPERR
	HRRM 3,.JBAPR		;SET TRAP LOCATION
	MOVEI 3,1B19		;SET FOR PUSH-DOWN OVERFLOW
	APRENB 3,
	SOS 3,PDP		;GET PDP REQUEST MINUS 1
	IMULI 3,.PDP		;COMPUTE SIZE (50*<NUMBER OF /P'S +1>)
	HRLZ MP,3
	HRR MP,.JBFF		;SET BASIC POINTER
	MOVE P,MP
	SUB P,3
	MOVEM P,RP		;SET RP
	MOVEM P,SAVERP
	SUB P,3
   IFN POLISH,<
	MOVEM P,POLSTK		;SAVE INITIAL POLISH FIXUP STACK
	MOVEM P,POLPTR		;ONLY CHANGE IF STACK MOVES
	SUB P,3
   >
	ASH 3,1			;DOUBLE SIZE OF BASIC POINTER
	HRL P,3
	MOVEM P,SAVEPP
	MOVEM MP,SAVEMP
	SUBM P,3		;COMPUTE TOP LOCATION
	SKIPN UNITOP		;IF ANY UNIVERSALS HAVE BEEN SEEN
	JRST GETSE0		;NO
	HRRZS 3			;GET TOP OF BUFFERS AND STACKS
	CAMLE 3,UNISIZ		;HOPE ITS NOT BIGGER THAN UNIVERSAL ONE
	JRST [SKIPE MRUNV	;[700] IT WAS, GIVE ERROR IF
		JRST UNIERR	;[700] DISK-RESIDENT UNIVS
		SETOM UNIFLG	;[700] ELSE FORCE REALLOCATION
		JRST M]		;[700]
	SKIPA 3,UNITOP		;DON'T LOSE THEM
GETSE0:	HRRZM 3,UNISIZ		;STORE UNTIL A UNIVERSAL IS SEEN
	HRRZM 3,LADR		;SET START OF MACRO TREE
	HRRZM 3,FREE

GETSE1:	HRRZ .JBREL
	SUBI 1
	MOVEM SYMTOP		;SET TOP OF SYMBOL TABLE
	SUBI LENGTH		;SET POINTER FOR INITIAL SYMBOLS
	CAMLE LADR		;HAVE WE ROOM?
	JRST GETSE2		;YES

	HRRZ 2,.JBREL		;NO, TRY FOR MORE CORE
	ADDI 2,2000
	CORE 2,
	  JRST XCEED2		;NO MORE, INFORM USER
	JRST GETSE1		;TRY AGAIN
GETSE2:	MOVEM SYMBOL		;SET START OF SYMBOL TABLE
	HRLI SYMNUM
	BLT @SYMTOP		;STORE SYMBOLS
   IFN FTPSECT,<		;[575]
	MOVE @SYMBOL		;SYMBOL COUNT
	MOVEM SGSCNT		;FOR THIS PSECT
   >
	CALL SRCHI		;INITIALIZE TABLE

; ;HERE TO TEST FOR CPU AND SET VALUE IN .CPU.
;PDP-6 = 1
;KA-10 = 2
;KI-10 = 3
;KL-10 = 4
	MOVEI V,1		;START WITH PDP-6
	JFCL 1,.+1		;CLEAR PC CHANGE FLAG
	JRST .+1		;THEN CHANGE PC
	JFCL 1,.PDP6.		;IF FLAG ON, ITS A PDP6
	HRLOI 1,-2		;CHECK FOR KA-10
	AOBJP 1,.KA10.		;CHECK CARRY BETWEEN HALVES
	SETZ 1,			;CLEAR AC
	BLT 1,0			;AND TRY BLT, KI WILL BE 0 AND
	JUMPE 1,.KI10.		;LK WILL HAVE 1,,1
;	JRST .KL10.

.KL10.:	AOS V
.KI10.:	AOS V
.KA10.:	AOS V
.PDP6.:	MOVE AC0,['.CPU. ']
	MOVEM V,CPUV		;[775] SAVE IT FOR CORE SIZE TYPEOUT
	CALL SSRCH		;SEE IF THERE ALREADY AND IF NOT
	  CALL [MOVSI ARG,SYMF!NOOUTF!SUPRBT
		SETZ RC,
		JRST INSERT]	;PUT IT IN TABLE

	GETPPN V,		;GET LOGGED IN PPN
	  JFCL			;ALT. RETURN
	MOVEM V,MYPPN		;AND REMEMBER IR
; END OF EDIT
   IFN FTPSECT,<		;[575]
	SETZM SGNMAX		;INIT TO ONE .PSECT
	SETZM SGNCUR		;IT IS THE CURRENT .PSECT
	SETZM SGNAME		;IT IS THE BLANK .PSECT
	MOVSI 1
	MOVEM SGRELC		;SET THE RELOCATION COUNTER
	SETZM SGATTR		;ZERO PSECT BRK AND ATTRS
	SETZM SGDMAX		;ONE .PSECT DEEP
	SETZM SGLIST		;IT IS THE BLANK .PSECT
   >
	MOVE [XWD CTIBUF+1,CTLSAV] ;SAVE CONTROL INPUT BUFFER
	BLT CTLS1		;FOR RESCAN ON PASS 2
	MOVSI 'DSK'		;SET INPUT TO TAKE DSK AS DEV
	MOVEM ACDEVX
	CALL COUTI		;INIT OUTPUT JUST IN CASE
	CALL INSET		;GET FIRST INPUT FILE
	  JRST GETSE3		;ERROR

   IFN CCLSW,<TLNE IO,CRPGSW	;BUT ONLY IF DOING RPG
	TTCALL 3,[ASCIZ /MACRO:/] >;PUBLISH COMPILER NAME
	MOVE CS,INDIR		;SET UP NAME OF FIRST FILE
	MOVEM CS,LSTFIL		;AS LAST PRINTED
	SETZM LSTPGN
	JRST ASSEMB		;START ASSEMBLY

GETSE3:	CALL ERRNE
	JRST ERRFN2		;[1066] START OVER
FINIS:	CLOSE BIN,		;DUMP BUFFER
	TLNE FR,PNCHSW		;PUNCH REQUESTED?
	CALL TSTBIN		;YES, TEST FOR ERRORS
	RELEAS BIN,
	CLOSE LST,
	SOSLE OUTSW+0*LPTSW	;LPT TYPE OUTPUT?
	CALL TSTLST		;YES, TEST FOR ERRORS
	RELEAS LST,
	RELEAS CHAR,
	MOVE C,CTOBUF+2		;SKIP OUTPUT IF BUFFER EMPTY
	CAIE C,120		;[565]
	OUTPUT CTL,0		;FLUSH TTY OUTPUT
	SKIPE UNIVSN		;SKIP IF NOT ASSEMBLING UNIVERSAL
	CALL UNISYM		;STORE SYMBOLS ETC. FIRST
	JRST M			;RETURN FOR NEXT ASSEMBLY
   IFN CCLSW,<
   IFE TOPS20,<			;FOR SHORT FILES
NUNSET:	JUMPN ACDEV,.+2
	MOVSI ACDEV,'SYS'	;USE SYS IF NONE SPECIFIED
	MOVEM ACDEV,RUNDEV
	MOVEM ACFILE,RUNFIL	;STORE FILE NAME
	SKIPN SFDADD		;ANY SFD'S?
	JRST NUNPP		;NO
	HRLI ACPPN,RUNSFD	;FORM BLT WORD
	MOVSS ACPPN		;BUT WRONG WAY ROUND
	BLT ACPPN,RUNSFD+2+.SFDLN
	MOVEI ACPPN,RUNSFD	;SET UP ADDRESS AGAIN
NUNPP:	MOVEM ACPPN,RUNPP	;IN PPN
	CALL DELETE		;COMMAND FILE
	SETZM RUNFIL+1		;LET MONITOR CHOOSE EXT
	SETZM RUNFIL+2		;CLEAR ALSO
	SETZM RUNPP+1		;ZERO CORE ARG
	MOVEI 16,RUNDEV		;XWD 0,RUNDEV
	TLNE IO,CRPGSW		;WAS RPG IN PROGRESS?
	HRLI 16,1		;YES. START NEXT AT C(.JBSA)+1

;REDUCE THE LOW SEGMENT TO 1K AND DELETE THE HIGH
;BEFORE THE RUN UUO, SAVES CORE AND TIME
	MOVE 1,[1,,RUNEND-1]	;DELETE HIGH & LOW
	MOVE 2,[RUNHI,,RUNLO]
	BLT 2,RUNDEV-1		;BLT CODE DOWN
	JRST RUNLO		;GO TO IT

RUNHI:	PHASE LOWL
RUNLO:! CORE 1,			;CUT DOWN TO 1K
	  JFCL			;TOO BAD
	RUN 16,			;DO "RUN DEV:NAME"
	  HALT			;SHOULDN'T RETURN. HALT IF IT DOES

RUNDEV:! BLOCK 1
RUNFIL:! BLOCK 3
RUNPP:!		BLOCK 2
RUNSFD:! BLOCK 3+.SFDLN
RUNEND:!
	DEPHASE
   >				;END OF CONDITIONAL
   IFN TOPS20,<			;FOR LONG FILES
NUNSET:	CALL DELETE		;GET RID OF COMMAND FILE
	MOVE ACDEV,[4,,RUNARG]	;FOR COMPT.
	COMPT. ACDEV,		;DO IT
	 HALT			;LET PA1050 COMPLAIN
   >				;END OF CONDITIONAL

DELETE:	HRRZ EXTMP		;IF THE EXTENSION
	CAIE 'TMP'		;IS  .TMP
	RET			;RETURN.
	CLOSE CTL2,		;DELETE
	SETZB 4,5		;THE COMMAND FILE.
	SETZB 6,7
	RENAME CTL2,4
	  JFCL
	RET
   >
INSET:	MOVEI JOBFFI		;POINTER TO INPUT BUFFER
	HRRM .JBFF		;INFORM SYSTEM OF BUFFER AREA
   IFN TOPS20,<			;FOR LONG FILES
	SKIPE FILNAM		;ALREADY HAVE A NAME?
	JRST INSET9		;YES. GO USE IT
   >
	CALL NAME2		;GET NEXT COMMAND NAME
	  RET			;ERROR RETURN IF NONE LEFT
INSET9:	AOS (P)			;SUCCESS
   IFE TOPS20,<			;FOR SHORT FILES
	MOVEM ACDEV,INDEV	;STORE DEVICE
	MOVEM ACFILE,INDIR	;STORE FILE IN DIRECTORY
	MOVEM ACPPN,INDIR+3	;STORE PPN BEFORE WE LOSE IT
	OPEN CHAR,INDEVI
   >				;END OF EQ TOPS20 CONDITIONAL
   IFN TOPS20,<			;FOR LONG FILES
	MOVE ACDEV,[10,,INARG]	;COMPT. ARGS
	COMPT. ACDEV,		;OPEN THE FILE
   >				;END OF NE TOPS20
	  JRST EINIT		;ERROR
   IFN TOPS20,<			;FOR LONG FILES
	MOVEI ACDEV,CHAR	;THE CHANNEL
	MOVEM ACDEV,INDEV	;FAKE THIS AS THE DEVICE CODE
   >
	DEVCHR ACDEV,		;TEST CHARACTERISTICS
	TLNN ACDEV,MTABIT	;MAG TAPE?
	JRST INSET3		;NO
	TLZN FR,MTAPSW		;FIRST MAG TAPE IN PASS 2?
	JRST INSET1		;NO
	TLNN TIO,TIORW		;YES, REWIND REQUESTED?
	SUB CS,RECCNT		;NO, PREPARE TO BACK-SPACE TAPE
INSET1:	AOS RECCNT		;INCREMENT FILE COUNTER
	ADDM CS,RECCNT		;UPDATE  COUNT
	TLZE TIO,TIOLE
	MTEOT. CHAR,
	TLZE TIO,TIORW		;REWIND?
	MTREW. CHAR,		;YES
	JUMPGE CS,INSET2
	MTBSF. CHAR,
	MTBSF. CHAR,
	AOJL CS,.-1
	MTWAT. CHAR,
	STATO CHAR,1B24
	MTSKF. CHAR,
INSET2:	SOJGE CS,.-1

INSET3:	INBUF CHAR,1
	MOVEI ACPNTR,JOBFFI
	EXCH ACPNTR,.JBFF
	SUBI ACPNTR,JOBFFI
	MOVEI ACDEL,NUMBUF*203+1
	IDIV ACDEL,ACPNTR
	INBUF CHAR,(ACDEL)
   IFN TOPS20,<			;FOR LONG FILES
	SETZM FILNAM		;CLEAR THIS FOR NEXT TRY
   >
   IFE TOPS20,<			;FOR SHORT FILES
	JUMPN ACEXT,INSET4	;TAKE USER'S EXTENSION IF NON-BLANK
	MOVSI ACEXT,'MAC'	;BLANK, TRY .MAC FIRST
	CALL INSETI
INSET4: CALL INSETI
	  JUMPE ACEXT,ERRCF	;ERROR IF ZERO
	TLNE ACDEV,TTYBIT	;TELETYPE?
	SETSTS CHAR,AL		;YES, CHANGE TO ASCII LINE

				;DO ALL ENTERS HERE FOR LEVEL D
	SKIPE ENTERS		;HAVE ENTERS BEEN DONE ALREADY?
   >				;END OF EQ TOPS20
	JRST ENTRDN		;YES, DON'T DO TWICE
	SKIPN ACEXT,LSTDEV	;IS THERE A LIST DEVICE?
	JRST BINSE5		;NO SO DON'T DO ENTER
	SKIPE ACFILE,LSTDIR	;GET FILE NAME IN CASE OF ERROR
	JRST LSTSE4
	DEVCHR ACEXT,
	TLNE ACEXT,DIRBIT	;DOES IT HAVE A DIRECTORY?
	JRST LSTSE4		;YES, GIVE UP BEFORE HARM IS DONE
	SKIPE ACFILE,INDIR	;USE INPUT FILE NAME
	MOVEM ACFILE,LSTDIR	;TOO BAD IF ZERO ALSO
LSTSE4:	HLLZS ACEXT,LSTDIR+1	;EXT ALSO
	ENTER LST,LSTDIR	;SET UP DIRECTORY
	  JRST ERRCL		;ERROR
BINSE5:	SKIPN ACEXT,BINDEV	;A BINARY DEVICE THEN ?
	JRST ENTRDN		;NO
	SKIPE ACFILE,BINDIR	;IN CASE OF ERROR
	JRST BINSE6
	DEVCHR ACEXT,
	TLNE ACEXT,DIRBIT	;DOES IT HAVE A DIRECTORY?
	JRST BINSE6		;YES, GIVE UP BEFORE HARM IS DONE
	SKIPE ACFILE,INDIR	;USE INPUT FILE NAME
	MOVEM ACFILE,BINDIR	;TOO BAD IF ZERO ALSO
BINSE6:	HLLZS ACEXT,BINDIR+1
	ENTER BIN,BINDIR	;ENTER FILE NAME
	  JRST ERRCB		;ERROR

ENTRDN:	SETOM ENTERS		;MAKE SURE ONLY DONE ONCE
	MOVE CS,[POINT 7,DEVBUF]
	PUSH P,1		;SAVE THE ACCS
	PUSH P,2
	PUSH P,3
   IFE TOPS20,<			;FOR SHORT FILES
	SKIPN 2,INDIR		;GET INPUT NAME
	JRST FINDEV		;FINISHED WITH DEVICE
	SETZ 1,			;CLEAR FOR RECEIVING
	LSHC 1,6		;SHIFT ONE CHAR. IN
	ADDI 1,40		;FORM ASCII
	IDPB 1,CS		;STORE CHAR.
	JUMPN 2,.-4		;MORE TO DO?
   >				;END OF EQ TOPS20
   IFN TOPS20,<			;FOR LONF FILES
	MOVE 1,[3,,[	CHAR,,5	;GET FILE NAME
			-1,,BIGBUF
			1B8+1B11+1]] ;NAME AND EXTENSION
	COMPT. 1,		;GET THEM
	 JFCL
	MOVE 1,[POINT 7,BIGBUF]
DONME:	ILDB 2,1
	JUMPE 2,NOEXT		;ALL DONE THE NAME
	CAIN 2,"."		;TO THE EXT?
	JRST EXXT		;YES
	IDPB 2,CS		;STORE IT
	JRST DONME
EXXT:	MOVEI 3,HT		;SEPARATOR
	IDPB 3,CS		;FOR THE EXTENSION
DOEXT:	ILDB 2,1		;THE EXTENSION
	JUMPE 2,NOEXT
	IDPB 2,CS		;TO THE OUTPTU
	JRST DOEXT
NOEXT:	DMOVE 1,INRIB+3		;THE DATE
	DMOVEM 1,INDIR+1	;FOR THE REST
	MOVEI 1,HT
	IDPB 1,CS
   >				;END OF CONDITIONAL
   IFE TOPS20,<
	MOVEI 1,HT		;SEPARATE BY TAB
	IDPB 1,CS
	HLLZ 2,INDIR+1		;GET EXT
	JUMPE 2,FINEXT		;NO EXT
	SETZ 1,
	LSHC 1,6		;SAME LOOP AS ABOVE
	ADDI 1,40
	IDPB 1,CS
	JUMPN 2,.-4
	MOVEI 1,HT
	IDPB 1,CS		;SEPARATE BY TAB
   >				;END OF CONDITIONAL
FINEXT:	LDB 1,[POINT 12,INDIR+2,35] ;GET LOW 12 BITS OF DATE
	LDB 2,[POINT 3,INDIR+1,20] ;GET HIGH 3 BITS OF DATE
	DPB 2,[POINT 3,1,23]	;MERGE TO BITS 
	JUMPE 1,FINDEV		;NO DATE?
	CALL DATOUT		;STORE IT
	LDB 2,[POINT 11,INDIR+2,23] ;GET CREATION TIME
	JUMPE 2,FINDEV		;NO TIME (DECTAPE)
	MOVEI 1," "		;SEPARATE BY SPACE
	IDPB 1,CS
	CALL TIMOU1		;STORE TIME
FINDEV:	SETZ 1,
	MOVEI 2,HT		;FINAL TAB
	IDPB 2,CS
	IDPB 1,CS		;TERMINATE FOR NOW
	POP P,3			;RESTORE ACCS
	POP P,2
	POP P,1
	SKIPN PAGENO		;IF FIRST TIME THRU
	JRST OUTFF		;START NEW PAGE
	SETZM PAGENO		;ON NEW FILE, RESET PAGES
	JRST OUTFF2		;DON'T START NEW PAGE UNLESS FF

INSETI:	HLLZM ACEXT,INDIR+1	;STORE EXTENSION
	MOVE ACPPN,INDIR+3	;SAVE PPN
	LOOKUP CHAR,INDIR
	  SKIPA ACEXT,INDIR+1	;GET ERROR CODE
	JRST CPOPJ1		;SKIP-RETURN IF FOUND
	TRNE ACEXT,-1		;ERROR CODE OF 0 IS FILE NOT FOUND
	JRST ERRCF		;FILE THERE BUT NOT READABLE
	SETZ ACEXT,		;CLEAR EXT AND TRY AGAIN
	MOVEM ACPPN,INDIR+3	;RESTORE PPN
	RET
REC2:	MOVS [CTIBUF+1,,CTLSAV]	;RESCAN CONTROL (FROM PASS1 END STMNT)
	BLT CTIBUF+2		;INPUT BUFFER
	MOVEI "_"
	HRLM ACDELX		;FUDGE PREVIOUS DELIMITER
	SETZM PASS2I
	MOVE [XWD PASS2I,PASS2I+1]
	BLT PASS2X-1		;ZERO PASS2 VARIABLES
	TLO FR,MTAPSW!LOADSW	;SET FLAGS 

GOTEND:	MOVE INDEV		;GET LAST DEVICE
	DEVCHR			;GET ITS CHARACTERISTICS
	TLNE 4			;TEST FOR DIRECTORY (DSK OR DTA)
	JRST EOT		;YES, SO DON'T WASTE TIME
	JRST .+3		;NO, INPUT BUFFER BY BUFFER
	IN CHAR,
	JRST .-1		;NO ERRORS
	STATO CHAR,1B22		;TEST FOR EOF
	JRST .-3		;IGNORE ERRORS

EOT:	CALL SAVEXS		;SAVE REGISTERS
	SETOM EOFFLG		;GOING THRU EOF PROCEDURE
	CALL INSET		;GET THE NEXT INPUT DEVICE
	  JRST EOT0		;ERROR
	PUSH P,['MCREP1']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT / END OF PASS 1]@/] ;[1066] ASSUME END OF PASS
	TLZN FR,LOADSW		;ZERO ONLY ON END OF PASS 1
	JRST [HRROI RC,[SIXBIT / LOAD THE NEXT FILE]@/] ;[1066] NOT END OF PASS
		PUSH P,['MCRLNF'] ;[1066] SET UP PREFIX
		POP P,PREFIX	;[1066]
		JRST .+1]	;[1066]
	TLNE ACDEV,(1B13!1B15)	;WAS ALL THAT WORK NECESSARY?
	JRST RSTRXS		;NO
	CALL EINFO		;CR-LF [
	CAMN RC,[-1]		;[1066] IF TEXT SUPPRESSED,
	HRROI RC,[SIXBIT /]@/]	;[1066] FUDGE IN CLOSE BRACKET
	CALL TYPMSG		;YES

RSTRXS:	MOVSI RC,SAVBLK		;SET POINTER
	BLT RC,RC-1		;RESTORE REGISTERS
	MOVE RC,SAVERC		;RESTORE RC
	RET			;EXIT

SAVEXS:	MOVEM RC,SAVERC		;SAVE RC
	MOVEI RC,SAVBLK		;SET POINTER
	BLT RC,SAVBLK+RC-1	;BLT ALL REGISTERS BELOW RC
	RET			;EXIT

EOT0:	JUMP1 [TLON FR,LOADSW	;PRINT MESSAGE ONCE
		CALL ERRNE	;ON PASS1
		JRST EOT1]
	TLO FR,LOADSW		;USED TO SIGNAL  POPJ RET FROM ERRNE
	CALL ERRNE		;PRINT ERROR MESSAGE
EOT1:	TLZ IO,IORPTC
	MOVE P,SAVEPP		;RESTORE STACKS
	MOVE MP,SAVERP
	MOVEM MP,RP		;[774]
	MOVE MP,SAVEMP
	CALL END01		;[774] FAKE END SEEN
	JRST ASSEM1		;[774] CONTINUE ASSEMBLY AT START OF LINE
NAME1:	SETZM ACDEVX		;ENTRY FOR DESTINATION
NAME2:	SETZB ACDEV,INDIR+2	;ENTRY FOR SOURCE
	SETZB ACFILE,PPN	;CLEAR FILE AND PPN
	HLRZ ACDEL,ACDELX	;GET PREVIOUS DELIMITER
	SETZB TIO,CS
   IFE TOPS20,<			;FOR SHORT FILES
	SETZB ACEXT,INDIR+3	;RESET EXTENSION AND PROGRAM-NUMBER PAIR
	SETZM SFDADD		;CLEAR FIRST WORD OF SFD BLOCK
	MOVE AC0,[SFDADD,,SFDADD+1]
	BLT AC0,SFDADD+2+.SFDLN	;AND REST OF IT
NAME3:	MOVSI ACPNTR,(POINT 6,AC0) ;SET POINTER
   >				;END OF EQ TOPS20
   IFN TOPS20,<			;FOR LONG FILES
NAME3:	MOVE ACPNTR,[POINT 7,FILNAM] ;ASCII POINTER
	SETZ ACPPN,		;NOT IN A PPN TO START
   >
	SETZ AC0,		;CLEAR SYMBOL
	JRST GETIOC		;GO GET INPUT CHARACTER

SLASH:	SETO CS,		;CS=-1 GET RID OF ALPHAS AT END
	CALL SW0
GETIOC:	CALL TTYIN		;GET INPUT CHARACTER
	CAIN C,"/"
	JRST SLASH
	CAIN C,"("
	JRST [	SETZ CS,	;CS=0 EVERY CHAR COUNT
		JRST SWITCH]
   IFE TOPS20,<			;FOR SHORT FILES
	CAIN C,":"
	JRST DEVICE
	CAIN C,"."
	JRST NAME
   >				;END OF EQ TOPS20
	CALL TRMTST		;TERMINATOR?
	JRST TERM		;YES,
   IFE TOPS20,<			;FOR SHORT FILES
	CAIE C,OBRCKT		;AN OPEN BRACKET?
	CAIN C,"["
	JRST PROGNP		;GET PROGRAMER NUMBER PAIR
   >				;END OF CONDITIONAL
   IFN TOPS20,<			;FOR LONG FILES
	CAIN C,","		;A COMMA?
	JUMPL ACPPN,INPPN	;YES. IN A PPN?
   >				;END OF EQ TOPS20
	CAIN C,"="		;EQUALS IS SAME AS LEFT ARROW
	TRCA C,142		;SO MAKE IT A "_" AND SKIP
	CAIE C,","
	CAIN C,"_"
	JRST TERM
	JUMPL C,TERME		;ERROR RETURN FROM TTYIN?
   IFE TOPS20,<			;FOR SHORT FILES
	CAIGE C,40		;VALID AS SIXBIT?
	JRST [CAIN C,CZ		;NO,IS IT ^Z
		JRST CZSTOP	;YES,EXIT FOR BATCH
		JRST GETIOC]	;JUST IGNORE
	CAIL C,"0"		;ERROR IF NOT ALPHANUMERIC
	CAILE C,"Z"
	JRST ERRCM
	CAILE C,"9"
	CAIL C,"A"
	CAIA
	JRST ERRCM
	SUBI C,40		;CONVERT TO 6-BIT
	TLNE ACPNTR,770000	;HAVE WE STORED SIX BYTES?
	IDPB C,ACPNTR		;NO, STORE IT
	JRST GETIOC		;GET NEXT CHARACTER
   >				;END OF EQ TOPS20
   IFN TOPS20,<			;FOR LONG FILES
	CAIN C,"["		;START OF A PPN?
	SETOM ACPPN		;YES. REMEMBER THUIS
	CAIN C,"]"		;END OF A PPN?
	SETZ ACPPN,		;YES. REMEMBER THIS
	CAIN C,CZ		;^Z?
	JRST CZSTOP		;YES
INPPN:	IDPB C,ACPNTR		;NO. SAVE BYTE
	JRST GETIOC		;AND GO GET MORE
   >				;END OF NE TOPS20

TRMTST:				;TERMINATOR TEST
   IFN CCLSW,<CAIE C,"!"	;IS CHAR AN IMPERATIVE?
	CAIN C,"@"
	RET>			;YES, GO DO IT
	CAIE C,33		;CHECK FOR THREE FLAVORS OF ALT-MODE
	CAIN C,176		;...
	RET
	CAIG C,CR		;LESS THAN CR?
	CAIGE C,LF		;AND GREATER THAN LF?
	CAIN C,175		;OR 3RD ALTMOD
	RET
	CAIN C,";"		;SEMI-COLON?
	RET			;YES,
	JRST CPOPJ1		;NOT A TERMINATOR, SKIP RETURN
DEVICE:	JUMPN ACDEV,ERRCM	;ERROR IF ALREADY SET
	MOVE ACDEV,AC0		;DEVICE NAME
	JRST DEVNAM		;COMMON CODE

NAME:	JUMPN ACFILE,ERRCM	;ERROR IF ALREADY SET
	MOVE ACFILE,AC0		;FILE NAME
DEVNAM:	MOVE ACDEL,C		;SET DELIMITER
	JRST NAME3		;GET NEXT SYMBOL

TERME:	TLZA C,-1		;MAKE INTO 33 BUT GIVE ERROR RET
TERM:	AOS (P)			;GIVE SKIP RETURN ON VALID TERMINATOR
   IFN TOPS20,<			;FOR LONG FILES
	SETZ ACDEV,		;GET A NULL
	IDPB ACDEV,ACPNTR	;TIE OFF ASCII STRING
   >
	JUMPE ACDEL,TERM1	;IF NO PREVIOUS TERMINATOR, THEN FILENAME
	CAIN ACDEL,"_"		;...
	JRST TERM1		;...
	CAIE ACDEL,":"		;IF PREVIOUS DELIMITER
	CAIN ACDEL,","		;WAS COLON OR COMMA
TERM1:	MOVE ACFILE,AC0		;SET FILE
	CAIN ACDEL,"."		;IF PERIOD,
	HLLO ACEXT,AC0		;SET EXTENSION
	HRLM C,ACDELX		;SAVE PREVIOUS DELIMITER
   IFN TOPS20,<RET>		;ALL DONE IF LONG FILES
	JUMPN ACDEV,.+2		;IF DEVICE SET USE IT
	SKIPA ACDEV,ACDEVX	;OTHERWISE USE LAST DEVICE
	MOVEM ACDEV,ACDEVX	;AND DEVICE
	SKIPN ACPPN,PPN		;PUT PPN IN RIGHT PLACE
	SKIPN PPPN		;DO WE HAVE A DEFAULT?
	JRST TERM2		;PPN IS SETUP

	MOVE ACPPN,[PSFD,,SFDADD] ; MOVE DEFAULT SFD
	BLT ACPPN,SFDE
	MOVE ACPPN,PPPN		;AND PPN
TERM2:	CAIN C,"!"		;IMPERATIVE?
	RET			;YES, DON'T ASSUME DEV
	JUMPE ACFILE,CPOPJ	;IF THERE IS A FILE,
	JUMPN ACDEV,.+2		;BUT NO DEVICE
	MOVSI ACDEV,'DSK'	;THEN ASSUME DISK
	RET			;EXIT

CZSTOP:	EXIT 1,			;MONRET
	JRST M			;CONTINUE
ERRCM:	PUSH P,['MCRCME']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT / COMMAND ERROR@/] ;[1066]
	JRST ERRFIN

PROGNP:	CALL GETOCT		;GET AN OCTAL NUMBER IN RC
	SKIPN RC		;IF ITS 0, USE
	HLRZ RC,MYPPN		;USE LOGGED IN PROJECT NUMBER
	HRLZM RC,PPN		;STORE IT
	CAIE C,","		;MORE?
	JRST PPNTST		;NO, GIVE UP
	CALL GETOCT		;GET AN OCTAL NUMBER
	SKIPN RC		;IF ITS 0, USE
	HRRZ RC,MYPPN		;MY PROGRAMMER NUMBER
	HRRM RC,PPN		;STORE IT
	CAIE C,","		;SFD'S?
	JRST PPNTST		;NO
	MOVEI C,SFDADD		;POINT TO DDDSFD BLOCK
	EXCH C,PPN		;SWAP WITH PPN
	MOVEM C,SFDADD+2	;STORE IT
	MOVEI RC,SFDADD+3	;START OF SFD AREA
SFD1:	HRRZS RC		;CLEAR BYTE POINTER
	CAILE RC,SFDADD+2+.SFDLN
	JRST ERRCM		;PATH TOO LONG
	HRLI RC,(POINT 6)	;BYTE POINTER SETUP
SFD2:	CALL TTYIN		;GET CHAR
	CAIE C,">"		;ALT FORM
	CAIN C,"]"		;END?
	JRST PPNTST		;YES
	CALL TRMTST		;OR TERMINATOR?
	 JRST PPNTST		;YES
	CAIN C,","		;NEXT SFD
	AOJA RC,SFD1		;YES, INCREMENT STORE ADDRESS
	SUBI C,40		;CONVERT TO SIXBIT
	JUMPL C,ERRCM		;ERROR
	TLNE RC,770000		;SPACE IN WORD
	IDPB C,RC		;YES, STORE CHAR.
	JRST SFD2		;GET NEXT CHAR

GETOCT:	SETZ RC,		;START WITH ZERO
GETOC1:	CALL TTYIN
	CAIE C,","		;TEST FOR COMMA
	CAIN C,"]"		;AND CLOSE SQB
	RET			;YES, WEVE GOT SOMETHING
	CAIN C,">"		;ALSO ALT FORM
	RET
	CALL TRMTST
	 RET
   IFE STANSW,<
	CAIL C,"0"		;CHECK FOR VALID NUMBERS
	CAILE C,"7"
	JRST ERRCM		;NOT VALID
	LSH RC,3		;SHIFT PREVIOUS RESULT
	ADDI RC,-"0"(C)>	;ADD IN NEW NUMBER
   IFN STANSW,<LSH RC,6		;SHIFT PREVIOUS RESULT
	ADDI RC,-40(C)>		;PUT IN NEW CHARACTER
	JRST GETOC1		;GET NEXT CHARACTER

; HERE TO TEST FOR DEFAULT PPN
PPNTST:	SKIPN ACFILE		;SEEN FILE NAME YET?
	SKIPE AC0		;OR PENDING
	JRST PPNTS1		;NO
	PUSH P,AC0		;GET AN AC
	MOVE AC0,PPN		;GET PPN
	MOVEM AC0,PPPN		;MAKE IT PERMANENT
	MOVE AC0,[SFDADD,,PSFD]
	BLT AC0,PSFDE		;SAME FOR SFDS
	POP P,AC0
PPNTS1:	CALL TRMTST
	JRST TERM
	JRST GETIOC
; END OF EDIT
SWITC0:	CALL SW1		;PROCESS CHARACTER
SWITCH:	CALL TTYIN		;GET NEXT CHARACTER
	CAIE C,")"		;END OF STRING?
	JRST SWITC0		;NO
	JRST GETIOC		;YES

SW0:	CALL TTYIN
SW1:	HRREI C,-"A"(C)		;CONVERT FROM ASCII TO NUMERIC
	JUMPL C,SEELPP		;NUMERIC VALUE MAYBE?
	CAILE C,"Z"-"A"		;WITHIN BOUNDS? (IS IT ALPHA?)
	JRST ERRCM		;NO, LT. Z, ERROR
	MOVE RC,[POINT 5,BYTAB]
	IBP RC
	SOJGE C,.-1		;MOVE TO PROPER BYTE
	LDB C,RC		;PICK UP BYTE
	JUMPE C,ERRCM		;TEST FOR VALID SWITCH
	CAIG C,SWTABT-SWTAB	;LEGAL ON SOURCE?
	JUMPL P,ERRCM		;NO, TEST FOR SOURCE
	LDB RC,[POINT 4,SWTAB-1(C),12]
	CAIN RC,IO
	SKIPN CTLSAV		;IF PASS2 OR IO SWITCH,
	XCT SWTAB-1(C)		;EXECUTE INSTRUCTION
	SKIPA
	TLZ IO,IOSALL		;TAKE CARE OF /X
	JUMPN CS,SW2		;DOING A SLASH? IF YES, JUMP
	RET

SW2:	SETZ CS,
	CALL TTYIN		;NEXT CHAR
	CAIL C,"A"
	CAILE C,"z"
	JRST CPOPJ1		;SKIP RETURN, SO NOT TO DO ANOTHER TTYIN
	CAILE C,"Z"		;HERE IS BETWEEN A AND z
	CAIL C,"a"		;NOW, IS IT BETWEEN Z AND a?
	JRST SW2+1		;NO, IT'S ALPHA
	JRST CPOPJ1		;YES, NOT ALPHA, SKIP RETURN

HELP:	PUSH P,.JBFF		;SAVE REAL .JBFF
	MOVE 1,.JBREL		;USE JOBREL
	MOVEM 1,.JBFF		;SO HELPER DOESN'T DESTROY SYMBOL TABLE
	MOVE 1,['MACRO ']	;GET MACRO.HLP
	CALL .HELPR		;CALL HELPER
	POP P,.JBFF		;RESTORE JOBFF IN CASE CCL MODE
	JRST M			;RESTART
; HERE FOR /nnL SWITCH TO SET LINES/PAGE

SEELPP:	ADDI C,"A"-"0"		;TO NUMERIC RANGE
	CAIG C,9		;IS IT
	JUMPGE C,.+2
	JRST ERRCM		;NO, BARF
	MOVE RC,C		;MOVE VALUE

SEELP1:	CALL TTYIN		;GET NEXT
	CAIG C,"9"		;IS IT NUMERIC
	CAIGE C,"0"		;...
	JRST SEELP2		;NO, CHECK END
	IMULI RC,^D10		;MAKE SPACE
	ADDI RC,-"0"(C)		;AND PUT DIGIT
	JRST SEELP1		;AND CONTINUE

SEELP2:	CAIE C,"L"		;END PROPERLY?
	JRST ERRCM		;NO, BARF
	SUBI RC,4		;EASIER FOR SYMBOL OUTPUT ROUTINES
	JUMPL RC,[PUSH P,['MCRATS'] ;[1066] SET UP PREFIX
		POP P,PREFIX	;[1066]
		HRROI RC,[SIXBIT \ LINES/PAGE ARGUMENT TOO SMALL@\] ;[1066]
		JRST ERRFIN]	;[676] PREVENT INFINITE LOOP
	MOVEM RC,..LPP		;SAVE IN "READ-ONLY"
	RET			;ALL DONE
	DEFINE SETSW (LETTER,INSTRUCTION) < INSTRUCTION
J= <"LETTER"-"A">-7*<I=<"LETTER"-"A">/7>
	SETCOD \I,J>

	DEFINE SETCOD		(I,J)
	<BYTAB'I=BYTAB'I!<.-SWTAB>B<5*J+4>>

BYTAB0= 0			;INITIALIZE TABLE
BYTAB1= 0
BYTAB2= 0
BYTAB3= 0

SWTAB:
	SETSW Z,<TLO TIO,TIOCLD>
	SETSW C,<TLZ FR,CREFSW>
	SETSW P,<SOS PDP>
SWTABT:				;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY
	SETSW A,<ADDI CS,1>
	SETSW B,<SUBI CS,1>
	SETSW E,<TLZ IO,IOPALL!IOSALL>
   IFN FORMSW,< SETSW F,<SETZM HWFMT>
		SETSW G,<SETOM HWFMT>>
	SETSW H,<JRST HELP>
	SETSW L,<TLZ IO,IOMSTR>
	SETSW M,<TLO IO,IOPALL!IOSALL>
	SETSW N,<HLLOS TYPERR>
	SETSW O,<XCT OFFML>
	SETSW Q,<TLO FR,ERRQSW>
	SETSW S,<TLO IO,IOMSTR>
	SETSW T,<TLO TIO,TIOLE>
	SETSW U,<SETOM UNVSKP>
	SETSW W,<TLO TIO,TIORW>
	SETSW X,<TLOA IO,IOPALL>
   IFG .-SWTAB-37,<PRINTX SWITCH TABLE TOO LONG, CHANGE BYTE SIZE>

BYTAB:				;BYTAB CONTAINS AN INDEX TO SWTAB
				;IT CONSIST OF 7 5BIT BYTES/WORD
				;OR ONE BYTE FOR EACH LETTER

	+BYTAB0			;A-G BYTE = 1 THROUGH 17 = INDEX
	+BYTAB1			;H-N BYTE = 0 = COMMAND ERROR
	+BYTAB2			;O-U
	+BYTAB3			;V-Z

   IF2,<PURGE I,J,BYTAB0,BYTAB1,BYTAB2,BYTAB3>
TTYIN:	SOSGE CTIBUF+2		;ENUF CHAR.?
	JRST TTYERR		;NO
	ILDB C,CTIBUF+1		;GET CHARACTER
	CAIE C," "		;SKIP BLANKS
	CAIN C,HT		;AND TABS
	JRST TTYIN
	CAIN C,15		;CR?
	SETZM CTIBUF+2		;YES,IGNORE REST OF LINE
	CAIG C,"Z"+40		;CHECK FOR LOWER CASE
	CAIGE C,"A"+40
	RET			;NO,EXIT
	SUBI C,40
	RET			;YES, EXIT

COMERR:	PUSH P,['MCRCTL']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT / COMMAND LINE TOO LONG@/] ;[1066]
	JRST ERRFIN

TTYERR:	SKIPN INDEV		;INPUT DEVICE SEEN?
	JRST ERRCM		;NO, SO MISSING "_"
	HRROI C,EOL		;SIGNAL ERROR
	RET			;AND RETURN

ERRNE:	PUSH P,['MCRNES']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT / NO END STATEMENT ENCOUNTERED ON INPUT FILE@/] ;[1066]
ERRNE4:	JUMP1 .+2		;[702] COUNT ERROR ON PASS2
	AOS ERRCNT		;[702]
ERRNE0:	CALL EFATAL		;OUTPUT CR-LF ?MCR
	CALL TYPMSG		;OUTPUT IT
	SKIPE LITLVL		;SEE IF IN LITERAL
	SKIPN LITPG		;PAGE 0 MEANS NOT IN A LITERAL REALLY
	JRST ERRNE1		;NO, TRY OTHERS
	MOVE V,[XWD [SIXBIT /IN LITERAL@/],LITPG]
	CAME RC,[-1]		;[1066] SUPPRESS INFO IF REQUIRED BY
				;[1066] MESSAGE LEVEL BITS
	CALL PRNUM		;GO PRINT INFORMATION
ERRNE1:	MOVEI V,0		;CHECK FOR OTHER PLACES
	SKIPE INDEF
	MOVE V,[XWD [SIXBIT /IN DEFINE@/],DEFPG]
	SKIPE INTXT
	MOVE V,[XWD [SIXBIT /IN TEXT@/],TXTPG]
	SKIPE INREP
	MOVE V,[XWD [SIXBIT /IN CONDITIONAL OR REPEAT@/],REPPG]
	SKIPE INCND
	MOVE V,[XWD [SIXBIT /IN CONDITIONAL@/],CNDPG]
	SKIPGE MACENL
ERRNE2:	MOVE V,[XWD [SIXBIT /IN MACRO CALL@/],CALPG]
	SETOM UNVSKP		;SET /U IN CASE CONTINUE ASSEMBLY
	JUMPN V,ERRNE3
	MOVE V,[XWD [SIXBIT /@/],PAGENO] ;BETTER THAN NOTHING
	SKIPE LITLVL		;HAD ONE PAGE NUMBER ALREADY
	RET
ERRNE3:	CAME RC,[-1]		;[1066] SUPPRESS TEXT IF REQUIRED BY
				;[1066] MESSAGE LEVEL BITS
	CALL PRNUM
	TLNE FR,LOADSW		;SEEN END OF FILE YET?
	RET			;YES
	MOVE P,SAVEPP		;NO RESET STACK
	MOVE MP,SAVERP
	MOVEM MP,RP
	MOVE MP,SAVEMP
	SETZ MRP,
	SETZM LBLFLG		;[1074] CLEAR LABEL-IN-LITERAL FLAG
	JRST ASSEM2		;AND CONTINUE

ERRMS1:	SIXBIT / ERRORS DETECTED@/
ERRMS2:	SIXBIT /1 ERROR DETECTED@/
ERRMS3:	SIXBIT /NO ERRORS DETECTED@/
ERRMQ1:	SIXBIT /1 WARNING GIVEN@/
ERRMQ2:	SIXBIT / WARNINGS GIVEN@/
   IFE TOPS20,<			;FOR SHORT FILES
EINIT:	PUSH P,['MCRDNA']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVE RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE @/]]
	CALL EFATAL		;[1066] OUTPUT PREFIX
	MOVEI C," "		;[1066] FORCE A SPACE
	CALL TYO		;[1066]
	JRST ERRFN1		;REST OF MESSAGE
   >				;END OF EQ TOPS20
   IFN TOPS20,<			;FOR LONG FILES
EINIT:	OUTSTR [ASCIZ /
?MCRFNF FILE NOT FOUND-/]
EINIT0:	OUTSTR FILNAM		;AND THE FILE NAME
	OUTSTR [ASCIZ /
/]
	JRST M			;AND START OVER

EINIT1:	OUTSTR [ASCIZ/
?MCRRFO REL FILE OPEN ERROR - /]
	JRST EINIT0
EINIT2:	OUTSTR [ASCIZ/
?MCRLFO LST FILE OPEN ERROR - /]
	JRST EINIT0
   >				;END OF NE TOPS20 CONDITIONAL
ERRCL:	HRRZ RC,LSTDIR+1	;GET LST DEV ERROR CODE
	JRST .+2		;GET ERROR MESSAGE
ERRCB:	HRRZ RC,BINDIR+1	;GET BIN DEV ERROR CODE
	JUMPN RC,ERRTYP
	SOJA RC,ERRTYP		;SPECIAL CASE IF ERROR CODE 0

ERRCF:	HRRZ RC,INDIR+1		;GET INPUT DEV ERROR CODE
	HLLZ ACEXT,INDIR+1	;SET UP EXT

ERRTYP:	CAIL RC,TABLND-TABLE	;IS ERROR CODE LEGAL?
	SKIPA RC,TABLND		;NO, GIVE CATCH ALL MESSAGE
	MOVE RC,TABLE(RC)	;YES, PICK UP MESSAGE
	PUSH P,['MCRLRE']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]

ERRFIN:	CALL EFATAL
ERRFN1:	CALL TYPMSG
ERRFN2:	CLOSE LST,		;[1066] GIVE USER A PARTIAL LISTING
	CLOSE BIN,40		;BUT NEVER A BUM REL FILE
	JRST M

EFATAL:				;[1066]
   IFN CCLSW,<AOS .JBERR>	;RECORD ERROR SO EXECUTION DELETED
	MOVEI CS,"?"		;[1066]
ECOMMN:	SKPINC C		;[1066] SEE IF WE CAN INPUT A CHAR.
	  JFCL			;[1066] BUT ONLY TO DEFEAT ^O
	CALL CRLF		;[1066]
	MOVE C,CS		;[1066] GET LEADING CHARACTER
	CALL TYO		;[1066] OUTPUT IT
   IFE TOPS20,<			;[1066] FORCE DEFAULT ON TOPS20
	HRROI C,35		;[1066] GET MESSAGE LEVEL BITS
	GETTAB C,		;[1066] RETURN THEM IN C
	  MOVEI C,0		;[1066] RETURN ZERO IF ERROR
	TLNN C,700		;[1066] IF NO BITS SET,
	TLO C,300		;[1066] SET DEFAULT (PREFIX!FIRST)
	TLNE C,400		;[1066] IF CONTINUATION,
	TLO C,200		;[1066] FORCE FIRST
	TLNN C,200		;[1066] WANT MESSAGE?
	SETOM RC		;[1066] NO, OBLITERATE IT
	TLNN C,100		;[1066] WANT PREFIX?
	RET			;[1066] NO, EXIT NOW
   >				;[1066] END IFE TOPS20
	MOVE CS,PREFIX		;[1066] OUTPUT PREFIX
	PJRST TYPSYM		;AND RETURN

EWARN:	MOVEI CS,"%"		;[1066]
	JRST ECOMMN		;[1066] JOIN COMMON ROUTINE

EINFO:	MOVEI CS,"["		;[1066]
	JRST ECOMMN		;[1066] JOIN COMMON ROUTINE
	[SIXBIT /(0) ILLEGAL FILE NAME@/],,ACFILE
TABLE:	[SIXBIT /(0) FILE WAS NOT FOUND@/],,ACFILE
	[SIXBIT /(1) NO DIRECTORY FOR PROJECT-PROGRAMMER NUMBER@/],,ACFILE
	[SIXBIT /(2) PROTECTION FAILURE@/],,ACFILE
	[SIXBIT /(3) FILE WAS BEING MODIFIED@/],,ACFILE
	[SIXBIT /(4) RENAME FILE NAME ALREADY EXISTS@/],,ACFILE
	[SIXBIT /(5) ILLEGAL SEQUENCE OF UUOS@/],,ACFILE
	[SIXBIT /(6) BAD UFD OR BAD RIB@/],,ACFILE
	[SIXBIT /(7) NOT A SAV FILE@/],,ACFILE
	[SIXBIT /(10) NOT ENOUGH CORE@/],,ACFILE
	[SIXBIT /(11) DEVICE NOT AVAILABLE@/],,ACFILE
	[SIXBIT /(12) NO SUCH DEVICE@/],,ACFILE
	[SIXBIT /(13) NOT TWO RELOC REG. CAPABILITY@/],,ACFILE
	[SIXBIT /(14) NO ROOM OR QUOTA EXCEEDED@/],,ACFILE
	[SIXBIT /(15) WRITE LOCK ERROR@/],,ACFILE
	[SIXBIT /(16) NOT ENOUGH MONITOR TABLE SPACE@/],,ACFILE
	[SIXBIT /(17) PARTIAL ALLOCATION ONLY@/],,ACFILE
	[SIXBIT /(20) BLOCK NOT FREE ON ALLOCATION@/],,ACFILE
	[SIXBIT /(21) CAN'T SUPERSEDE (ENTER) AN EXISTING DIRECTORY@/],,ACFILE
	[SIXBIT /(22) CAN'T DELETE (RENAME) A NON-EMPTY DIRECTORY@/],,ACFILE
	[SIXBIT /(23) SFD NOT FOUND@/],,ACFILE
	[SIXBIT /(24) SEARCH LIST EMPTY@/],,ACFILE
	[SIXBIT /(25) SFD NESTED TOO DEEPLY@/],,ACFILE
	[SIXBIT /(26) NO-CREATE ON FOR SPECIFIED PATH@/],,ACFILE

TABLND:	[SIXBIT /(?) LOOKUP, ENTER, OR RENAME ERROR@/],,ACFILE
TYPMSG:	HLRZ CS,RC		;GET FIRST MESSAGE
	CAIE CS,-1		;SKIP IF MINUS ONE
	CALL TYPM2		;TYPE MESSAGE
	HRRZ CS,RC		;GET SECOND HALF
	CAIE CS,-1		;[1066] SKIP IF -1
	CALL TYPM2

CRLF:	MOVEI C,CR		;OUTPUT CARRIAGE RETURN
	CALL TYO
	MOVEI C,LF		;AND LINE FEED

TYO:	SOSG CTOBUF+2		;BUFFER FULL?
	OUTPUT CTL,0		;YES, DUMP IT
	IDPB C,CTOBUF+1		;STORE BYTE
	CAIG C,FF		;FORM FEED?
	CAIGE C,LF		;V TAB OR LINE FEED?
	RET			;NO
	OUTPUT CTL,0		;YES
	RET			;AND EXIT

TYPM2:	MOVSI C,(1B0)		;ANTICIPATE REGISTER WORD
	CAIN CS,ACFILE		;FILE NAME ?
	JRST [JUMPE ACEXT,.+1	;YES, TEST FOR EXT
		LSH ACEXT,-6	;MAKE SPACE FOR "."
		IOR ACEXT,[SIXBIT /.   @/]
		JRST TYPM2A]
	CAIG CS,17		;IS IT?
	MOVEM C,1(CS)
TYPM2A:	HRLI CS,(POINT 6,,)	;FORM BYTE POINTER

TYPM3:	ILDB C,CS		;GET A SIXBIT BYTE
	CAIN C,40		;"@"?
	JRST TYO		;YES, TYPE SPACE AND EXIT
	ADDI C,40		;NO, FORM 7-BIT ASCII
	CALL TYO		;OUTPUT CHARACTER
	JRST TYPM3

TYPSYM:	MOVEI C,0		;CLEAR C
	LSHC C,6		;MOVE NEXT SIXBIT CHARACTER IN
	JUMPE C,CPOPJ		;TEST FOR END
	ADDI C,40		;CONVERT TO ASCII
	CALL TYO		;OUTPUT
	JRST TYPSYM		;LOOP

;TYPE OUT OCTAL NUMBER (SEE DP1:)
TYPOCT:	IDIVI AC0,^D8		;[1060]
	HRLM AC1,(P)		;[1060]
	JUMPE AC0,.+2		;[1060]
	CALL TYPOCT		;[1060]
	HLRZ C,(P)		;[1060]
	ADDI C,"0"		;[1060]
	JRST TYO		;[1060]
XCEEDS:	ADDI SX,2000		;ADJUST SYMBOL POINTER
XCEED:	CALL SAVEXS		;SAVE THE REGISTERS
	HRRZ 1,.JBREL		;GET CURRENT TOP
	MOVEI 0,2000(1)
	CORE 0,			;REQUEST MORE CORE
	  JRST XCEED2		;ERROR, BOMB OUT
	HRRZ 2,.JBREL		;GET NEW TOP

XCEED1:	MOVE 0,0(1)		;GET ORIGIONAL
	MOVEM 0,0(2)		;STORE IN NEW LOCATION
	SUBI 2,1		;DECREMENT UPPER
	CAMLE 1,SYMBOL		;HAVE WE ARRIVED?
	SOJA 1,XCEED1		;NO, GET ANOTHER
	MOVEI 1,2000
	ADDM 1,SYMBOL
	ADDM 1,SYMTOP
	CALL SRCHI		;RE-INITIALIZE SYMBOL TABLE
	JRST RSTRXS		;RESTORE REGISTERS AND EXIT

XCEED2:	PUSH P,['MCRNEC']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT / INSUFFICIENT CORE@/] ;[1066]
XCEED3:	TLO FR,LOADSW		;MAKE SURE IT COMES BACK
	CALL ERRNE0		;GO PRINT HERE
	JRST ERRFN2		;[1066] START OVER
PDPERR:	PUSH P,['MCRPDL']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	HRROI RC,[SIXBIT . PDP OVERFLOW, TRY /P@.] ;[1066]
	MOVE P,SAVEPP		;GET A VALID STACK POINTER
	JRST XCEED3		;DON'T CONTINUE ASSEMBLY
PRNUM:	HLRZ CS,V		;GET MESSAGE
	CALL TYPM2
	MOVEI CS,[SIXBIT /ON PAGE@/]
	CALL TYPM2
	MOVE AC0,(V)		;GET PAGE
	CALL DP1		;PRINT NUMBER
	MOVEI C,40
	CALL TYO
	SKIPN AC1,1(V)		;GET SEQ NUM IF THERE
	JRST PRNUM1		;NO, TRY FOR TAG
	MOVEM AC1,OUTSQ
	MOVEI CS,[SIXBIT /LINE@/]
	CALL TYPM2
	OUTPUT CTL,0		;TO MAKE THINGS PRINT IN RIGHT ORDER
	OUTSTR OUTSQ		;PRINT SEQUENCE NUMBER
	MOVEI C," "		;ADD SPACE
	CALL TYO

PRNUM1:	MOVEI CS,[SIXBIT /AT@/]
	CALL TYPM2
	MOVE CS,2(V)
	CALL TYPSYM		;PRINT TAG
	MOVEI CS,[SIXBIT / +@/]
	CALL TYPM2
	HRRZ AC0,3(V)		;[666]
	CALL DP1		;PRINT DECIMAL INCREMENT
	PJRST CRLF		;END LINE

DP1:	IDIVI AC0,^D10
	HRLM AC1,(P)
	JUMPE AC0,.+2
	CALL DP1
	HLRZ C,(P)
	ADDI C,"0"
	JRST TYO
RIM0:	TDO FR,AC0		;SET RIM/RIM10 FLAG
	TLNE FR,PNCHSW		;FORGET IT IF PUNCH RESET
	SETSTS BIN,IB		;SET TO IMAGE BINARY MODE
	RET

ROUT:	EXCH CS,RIMLOC
	SUB P,[XWD 1,1]		;CLEAR OUT STACK WFW
	TLNE FR,R1BSW
	JRST ROUT6
	TLNN FR,RIM1SW
	JRST ROUT1
	JUMPE CS,ROUT1		;RIM10 OUTPUT
	SUB CS,RIMLOC
	JUMPE CS,ROUT1
	JUMPG CS,ERRAX
	MOVEI C,0
	CALL PTPBIN
	AOJL CS,.-1
ROUT1:	MOVSI C,(DATAI PTR,)	;RIM OUTPUT
	HRR C,LOCO		;GET ADDRESS
	TLNE FR,RIM1SW		;NO DATAI IF RIM10
	AOSA RIMLOC
	CALL PTPBIN		;OUTPUT
	MOVE C,AC0		;CODE
	AOSA LOCO		;INCREMENT CURRENT LOCATION

OUTBIN:	TLNN FR,RIMSW!RIM1SW!R1BSW ;EXIT IF RIM MODE
PTPBIN:	TLNN FR,PNCHSW		;EXIT IF PUNCH NOT REQUESTED
	RET
	SOSG BINBUF+2		;TEST FOR BUFFER FULL
	CALL DMPBIN		;YES, DUMP IT
	IDPB C,BINBUF+1		;DEPOSIT BYTE
	RET			;EXIT
DMPBIN:	OUT BIN,0		;DUMP THE BUFFER
	RET			;NO ERRORS
TSTBIN:	GETSTS BIN,C		;GET STSTUS BITS
	TRNN C,ERRBIT		;ERROR?
	RET			;NO, EXIT
	MOVE AC0,BINDEV		;YES, GET TAG
	JRST ERRLST		;TYPE MESSAGE AND ABORT

DMPLST:	OUT LST,0		;OUTPUT BUFFER
	RET			;NO ERRORS
TSTLST:	GETSTS LST,C		;ANY ERRORS?
	TRNN C,ERRBIT
	RET			;NO, EXIT
	MOVE AC0,LSTDEV
ERRLST:	PUSH P,['MCRWLE']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / OUTPUT WRITE-LOCK ERROR DEVICE@/] ;[1066]
	TRNE C,IOIMPM		;IMPROPER MODE?
	JRST ERRFIN		;YES
	PUSH P,['MCRODE']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / OUTPUT DATA ERROR DEVICE@/] ;[1066]
	TRNE C,IODERR		;DEVICE DATA ERROR?
	JRST ERRFIN		;YES
	PUSH P,['MCROCP']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / OUTPUT CHECKSUM OR PARITY ERROR DEVICE@/] ;[1066]
	TRNE C,IODTER		;IS IT
	JRST ERRFIN		;YES
	MOVE CS,AC0		;GET DEVICE
	DEVCHR CS,		;FIND OUT WHAT IT IS
	PUSH P,['MCROQE']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / OUTPUT QUOTA EXCEEDED ON DEVICE@/] ;[1066]
	TLNN CS,DSKBIT		;SKIP IF DSK OUTPUT
	PUSH P,['MCROBL']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / OUTPUT BLOCK TOO LARGE DEVICE@/] ;[1066]
	JRST ERRFIN
R1BDMP:	SETCM CS,R1BCNT
	JUMPE CS,R1BI
	HRLZS C,CS
	HRR C,R1BLOC
	HRRI C,-1(C)
	MOVEM C,R1BCHK
	CALL PTPBIN
	HRRI CS,R1BBLK
R1BDM1:	MOVE C,0(CS)
	ADDM C,R1BCHK
	CALL PTPBIN
	AOBJN CS,R1BDM1
	MOVE C,R1BCHK
	CALL PTPBIN
R1BI:	SETOM R1BCNT
	PUSH P,LOCO
	POP P,R1BLOC
	RET

ROUT6:	CAME CS,RIMLOC
	CALL R1BDMP
	AOS C,R1BCNT
	MOVEM AC0,R1BBLK(C)
	AOS LOCO
	CAIN C,.R1B-1
	CALL R1BDMP
	AOS RIMLOC
	RET

R1BLDR:
	PHASE 0
	IOWD $ADR,$ST
$ST:	CONO PTR,60
	HRRI $A,$RD+1
$RD:	CONSO PTR,10
	JRST .-1
	DATAI PTR,@$TBL1-$RD+1($A)
	XCT $TBL1-$RD+1($A)
	XCT $TBL2-$RD+1($A)
$A:	SOJA $A,
$TBL1:	CAME $CKSM,$ADR
	ADD $CKSM,1($ADR)
	SKIPL $CKSM,$ADR
$TBL2:	JRST 4,$ST
	AOBJN $ADR,$RD
$ADR:	JRST $ST+1
$CKSM:
	DEPHASE

   IF2,< PURGE $ST,$RD,$A,$TBL1,$TBL2,$ADR,$CKSM>
READ0:	CALL EOT		;END OF TAPE

READ:	SOSGE IBUF+2		;BUFFER EMPTY?
	JRST READ3		;YES
READ1:	ILDB C,IBUF+1		;PLACE CHARACTER IN C
	MOVE CS,@IBUF+1		;CHECK FOR SEQUENCE NUMBER
	TRNN CS,1
	JRST READ1A
	CAMN CS,[<ASCII /     />+1] ; HOWEVER IF AN SOS PAGE MARK
	SETZ CS,		;CLEAR SEQ NO. SO LINE NOT COUNTED
	MOVEM CS,SEQNO
	MOVEM CS,SEQNO2
	MOVNI CS,4
	ADDM CS,IBUF+2		;ADJUST WORD COUNT
REPEAT 4,< IBP IBUF+1>		;SKIP SEQ NO
	CALL READ		;AND THE TAB
	JRST READ		;GET NEXT CHARACTER

READ1A:	JUMPE C,READ		;IGNORE NULL
	CAIG C,CLA		;[664] CHECK RANGE
	CAIGE C,CZ		;[664]
	RET			;[664] FAST EXIT FOR TYPICAL CASE
	CAIE C,CZ		;IF IT'S A "^Z"
	JRST READ1B		;[554]
	MOVE CS,INDEV		;CHECK DEVICE
	DEVCHR CS,		;[554]
	TLNE CS,10		;IF TTY,
	MOVEI C,LF		;TREAT IT AS A "LF"
	RET			;EXIT
READ1B:	CAIE C,CLA		;CONTROL _
	RET
	MOVEI C,"^"		;MAKE CONTROL _ VISIBLE
	CALL RSW2
	MOVEI C,"_"
	CALL RSW2
	CALL PEEK		;LOOK AT NEXT CHAR
	CAIG C,CR		;IF IT IS END OF LINE
	CAIGE C,LF
	JRST [POP P,CS		;GET RETURN ADDRESS
		PUSH P,LIMBO	;SAVE NEXT CHAR,RSW1 DESTROYS IT
		MOVEI C,CLA	;RESTORE ^_
		CALL (CS)	;RETURN TO LIST CHAR ETC
		POP P,LIMBO	;SAFE TO STORE NOW
		RET]		;RETURN TO PROGRAM
	TLZ IO,IORPTC		;USE THE CHAR IN C NOW
	JRST READ2A		;BUT DON'T LIST TWICE

READ2:	CALL READ		;YES, TEST FOR LINE FEED
	CALL RSW2		;LIST IN ANY EVENT
READ2A:	CAIG C,FF		;IS IT ONE OF
	CAIGE C,LF		;LF, VT, OR FF?
	JRST READ2		;NO
	CALL OUTIM1		;YES, DUMP THE LINE
	JRST READ		;RETURN NEXT CHARACTER

READ3:	IN CHAR,0		;GET NEXT BUFFER
	  JRST READ		;NO ERRORS
	GETSTS CHAR,C
	TRNN C,ERRBIT!2000	;ERRORS?
	JRST READ0		;EOF
	MOVE AC0,INDEV
READ4:	PUSH P,['MCRPET']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / INPUT PHYSICAL END OF TAPE DEVICE@/] ;[1066]
	TRNE C,2000
	JRST ERRFIN		;E-O-T
	PUSH P,['MCRMDE']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / MONITOR DETECTED SOFTWARE INPUT ERROR DEVICE@/] ;[1066]
	TRNE C,IOIMPM		;IMPROPER MODE?
	JRST ERRFIN		;YES
	PUSH P,['MCRIDE']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / INPUT DATA ERROR DEVICE@/] ;[1066]
	TRNE C,IODERR		;DEVICE DATA ERROR?
	JRST ERRFIN		;YES
	PUSH P,['MCRICP']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / INPUT CHECKSUM OR PARITY ERROR DEVICE@/] ;[1066]
	TRNN C,IODTER
	PUSH P,['MCRIBL']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / INPUT BLOCK TOO LARGE DEVICE@/] ;[1066]
	JRST ERRFIN
OUTTAB:	MOVEI C,HT
	JRST OUTL		;[664] AVOID CHECKS
PRINT:	CAIG C,CR		;[664] RANGE CHECK
	CAIGE C,LF		;[664]
	JRST OUTL
	JRST @PRINTB-12(C)	;[664] CALL PROPER ROUTINE
PRINTB:	EXP OUTCR,OUTVT,OUTFF0,OUTCR	;[1003][664]

OUTVT:	PUSH P,C+1		;NEED ADJACENT ACC
	MOVEI C,.LPP		;NO. OF LINES WE STARTED WITH
	SUB C,LPP		;MINUS NO. OF LINES LEFT
	IDIVI C,^D20		;HOW MANY WILL VT TAKE
	SUBI C+1,^D20		;TO GET TO NEXT TAB STOP
	ADDM C+1,LPP		;ACCOUNT FOR THEM
	POP P,C+1
	MOVEI C,VT		;PUT CHAR BACK
	SKIPLE LPP		;DID WE END PAGE?
	JRST OUTL		;NO, OUTPUT IT
	TLO IO,IOPAGE		;YES, NEXT TIME
	CALL OUTC		;[1003] YES, OUTPUT CHAR
	SETOM CRFLG		;[1003] PAGE NEXT, ADDING CRLF
	RET			;[1003]

OUTCR0:	CALL OUTAS0		;[664]
OUTCR:	TRNN ER,ERRORS!LPTSW!TTYSW
	RET
	SETOM CRLFSN		;[1064] SET FLAG IN CASE WE SEE LALL
	MOVEI C,CR		;CARRIAGE RETURN, LINE FEED
	CALL OUTL
	TRNE ER,LPTSW		;[756] GOING TO LISTING?
	JRST OUTCR1		;[756] YES, COUNT THIS LINE
	TRNN ER,TTYSW		;[756] GOING TO TTY?
	JRST OUTCR2		;[756] NO, DON'T COUNT IT
	MOVE C,OUTSW		;[756] SEE IF TTY IS LIST DEV
	CAIN C,TTYSW		;[756] IF SO, COUNT IT
OUTCR1:	SOSL LPP		;[756] END OF PAGE?
	JRST OUTCR2		;[756]
	TLO IO,IOPAGE		;[756] YES, SET FLAG
	SETOM INTPGR		;[756] AND FLAG INTERNAL PAGE REQUEST
OUTCR2:	MOVEI C,LF		;[756] SET LF, EXIT THRU OUTC
	PJRST OUTC		;[756]

OUTL:	TLZN IO,IOPAGE		;NEW PAGE REQUESTED?
	JRST OUTC		;NO
	JUMP1 OUTC		;YES, BYPASS IF PASS ONE
	TLNE IO,IOMSTR+IOPROG	;XLIST IN EFFECT
	JRST [	SKIPN INTPGR	;[655] BYPASS UNLESS IN SALL MACRO AND
		JRST OUTC	;[655] PAGE REQUEST WAS INTERNAL
		TLNE IO,IOSALL	;[655]
		JUMPN MRP,.+1	;[655]
		SETZM INTPGR	;[655]
		JRST OUTC]	;[655]
	SETZM INTPGR		;[655] CLEAR INT PAGE-REQUEST JUST IN CASE
	PUSH P,C		;SAVE C AND CS
	PUSH P,CS
	PUSH P,ER
	HRR ER,OUTSW
	TLNE IO,IOCREF		;IF DOING CREF OUTPUT NOW
	TLNE FR,CREFSW		;AND CREFFING (JUST IN CASE)
	JRST .+2
	CALL CLSC3		;CLOSE IT OUT
	HLLM IO,(P)		;SAVE THIS NEW STATE OF IO
	MOVE C,..LPP
	ADDI C,2		;PUT BACK THE 2 LINES
	MOVEM C,LPP		;SET NEW COUNTER
	SKIPE CRFLG		;[1003] CRLF NEEDED?
	CALL OUTCR		;[1003] YES,
	MOVEI C,FF
	CALL OUTC		;OUTPUT FORM FEED
	MOVEI CS,TBUF
	CALL OUTAS0		;OUTPUT TITLE
	MOVEI CS,VBUF
	CALL OUTAS0		;OUTPUT VERSION
	MOVEI CS,DBUF
	CALL OUTAS0		;AND DATE
	MOVE C,PAGENO
	CALL DNC		;OUTPUT PAGE NUMBER
	AOSG PAGEN.		;FIRST PAGE OF THIS NUMBER?
	JRST OUTL1		;YES
	MOVEI C,"-"		;NO, PUT OUT MODIFIER
	CALL OUTC
	MOVE C,PAGEN.
	CALL DNC
OUTL1:	CALL OUTCR
	MOVEI CS,DEVBUF
	CALL OUTAS0
	HRRZ CS,SUBTTX		;SWITCH FOR SUB-TITLE
	SKIPE 0(CS)		;IS THERE A SUB-TITLE?
	CALL OUTTAB		;YES, OUTPUT A TAB
	CALL OUTCR0		;[664] OUTPUT ASCII WITH CARRIAGE RETURN
	CALL OUTCR
	POP P,ER
	POP P,CS		;RESTORE REGISTERS
	POP P,C

OUTC:	SETZM CRFLG		;[1003] CLEAR CRLF REQUEST
	TRNE ER,ERRORS!TTYSW
	CALL TYO
	TRNN ER,LPTSW
	RET
OUTLST:	SOSG LSTBUF+2		;BUFFER FULL?
	CALL DMPLST		;YES, DUMP IT
   IFN STANSW,< CAIN C,"@"
	MOVEI C,140
	CAIN C,"_"
	MOVEI C,30
	CAIN C,"^"
	MOVEI C,32
	CAIE C,"\"
	JRST OUTLSS
	MOVEI C,177
	IDPB C,LSTBUF+1
	JRST OUTLST
OUTLSS:	>
	IDPB C,LSTBUF+1		;STORE BYTE
	RET			;EXIT
OUTFF0:	SETOM CRFLG		;[1003] CRLF WILL BE NEEDED
OUTFF:	TLOA IO,IOPAGE
OUTFF1:	CALL PAGE1		;CLOSE CREF
OUTFF2:	SETOM PAGEN.
	AOS PAGENO
	RET

TIMOUT:	IDIVI 2,^D60*^D1000
TIMOU1:	IDIVI 2,^D60
	PUSH P,3		;SAVE MINUTES
	CALL OTOD		;STORE HOURS
	MOVEI 3,":"		;SEPARATE BY COLON
	IDPB 3,CS
	POP P,2			;STORE MINUTES
OTOD:	IDIVI 2,^D10
	ADDI 2,60		;FORM ASCII
	IDPB 2,CS
	ADDI 3,60
	IDPB 3,CS
	RET

DATOUT:	IDIVI 1,^D31		;GET DAY
	ADDI 2,1
	CAIG 2,^D9		;TWO DIGITS?
	ADDI 2,7760*^D10	;NO, PUT IN SPACE
	CALL OTOD		;STORE DAY
	IDIVI 1,^D12		;GET MONTH
	MOVE 2,DTAB(2)		;GET MNEMONIC
	IDPB 2,CS		;DEPOSIT RIGHT MOST 7 BITS
	LSH 2,-7		;SHIFT NEXT IN
	JUMPN 2,.-2		;DEPOSIT IFIT EXISTS
	MOVEI 2,^D64(1)		;GET YEAR
	JRST OTOD		;STORE IT

DTAB:	"-naJ-"		;[567]
	"-beF-"
	"-raM-"
	"-rpA-"
	"-yaM-"
	"-nuJ-"
	"-luJ-"
	"-guA-"
	"-peS-"
	"-tcO-"
	"-voN-"
	"-ceD-"
; BINARY UNIVERSALS
;HERE TO WRITE OUT UNIVERSAL SYMBOL FILE
;SYMBOL TABLE PLUS MACROS

UNVOUT:	HRRZ AC0,FREE		;GET HIGHEST FREE LOCATION
	MOVEM AC0,.JBFF		;INTO JOBFF
	INIT UNV,B		;INIT DSK FOR OUTPUT
	SIXBIT /DSK/
	XWD UNVBUF,0		;OUTPUT ONLY
	 JRST UNVINT		;ERROR
	MOVSI AC0,'UNV'		;STANDARD EXT
	MOVEM AC0,UNVDIR+1
	SETZM UNVDIR+2
	SETZM UNVDIR+3		;CLEAR PPN
	ENTER UNV,UNVDIR	;ENTER FILE
	 JRST UNVENT		;ERROR
	MOVEI SDEL,2*203	;STANDARD DOUBLE BUFFERING
	ADD SDEL,FREE		;FROM FREE CORE
	CAML SDEL,SYMBOL	;MORE CORE NEEDED?
	CALL XCEED		;YES
	SUBI SDEL,2*203		;BACK TO START OF BUFFER
	MOVEM SDEL,.JBFF	;SETUP FOR BUFFERS
	OUTBUF UNV,2		;SET THEM UP
	MOVSI AC1,777		;SPECIAL MARKER FIRST WORD
	HRR AC1,UWVER		;STORE VERSION NUMBER
	CALL UNVBIN		;LOADER BLOCK 777?
	MOVE AC1,.JBVER		;GET MACRO VERSION NUMBER
	CALL UNVBIN		;AND OUTPUT IT AS THE SECOND WORD
	MOVE AC1,@SYMBOL	;GET NUMBER OF SYMBOLS
	MOVN SDEL,AC1
	HRLZS SDEL
	HRR SDEL,SYMBOL		;FORM AOBJN POINTER
	CALL UNVBIN		;OUTPUT NUMBER OF SYMBOLS
	ADDI SDEL,1		;BYPASS COUNT
UNVLUP:	MOVE AC1,(SDEL)		;GET SYMBOL
	CALL UNVBIN
	ADDI SDEL,1
	MOVE AC1,(SDEL)		;GET VALUE
	TLNE AC1,SPTR		;SPECIAL EXTERNAL POINTER?
	JRST UNVSPT		;YES
	TLNE AC1,EXTF		;EXTERNAL (BUT NOT SPTR)?
	JRST UNVEXT		;YES, OUTPUT 2 WORDS
	TLNE AC1,MACF		;MACRO
	JRST UNVMAC		;YES, SAVE MACRO TEXT ALSO
	TLNE AC1,PNTF		;ONLY A POINTER TO VALUE?
	JRST UNVPTF		;YES
	CALL UNVBIN		;OUTPUT VALUE
UNVNXT:	AOBJN SDEL,UNVLUP	;FOR ALL SYMBOLS
	RELEASE UNV,
	RET
UNVINT:	PUSH P,['MCRUWU']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	AOS QERRS		;INCREMENT WARNING COUNT
	MOVE AC0,UNVDIR		;FILNAM IN AC0
	MOVSI RC,[SIXBIT / UNABLE TO WRITE UNIVERSAL FILE@/] ;[1066]
	CALL EWARN		;[1066] NOT FATAL
	PJRST TYPMSG		;TYPE MESSAGE AND EXIT

UNVENT:	AOS QERRS		;INCREMENT WARNING COUNT
	PUSH P,['MCREFU']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	SETZ RC,		;[1066] ZERO RC FOR TEST AFTER CALL
	CALL EWARN		;[1066] GIVE WARNING
	CAMN RC,[-1]		;[1066] SUPPRESS REST IF REQUIRED BY
	PJRST CRLF		;[1066] MESSAGE LEVEL BITS
	HRRZ RC,UNVDIR+1	;GET ERROR BITS
	SKIPN RC
	SOS RC			;=0 SPECIAL CASE
	CAIL RC,TABLND-TABLE	;WITHIN BOUND?
	JRST [	HLRZ CS,TABLND	;CATCH-ALL ERR MESS
		JRST .+2]
	HLRZ CS,TABLE(RC)	;REFERENCE TABLE
	CALL TYPM2		;GIVE APPROPRIATE MESSAGE
	MOVE AC0,UNVDIR		;FILENAME
	MOVSI RC,[SIXBIT /UNIVERSAL FILE@/]
	PJRST TYPMSG		;FINISH OFF AND EXIT
;HERE FOR EXTERNAL (NOT SPTR)
UNVEXT:	MOVE AC2,AC1		;GET POINTER
	HLLZ AC1,AC1		;CLEAR POINTER
	CALL UNVBIN		;OUTPUT FLAGS
	MOVE AC1,0(AC2)		;GET FIRST WORD (VALUE)
	CALL UNVBIN
	MOVE AC1,1(AC2)		;GET SECOND WORD (SYMBOL)
	CALL UNVBIN
	JRST UNVNXT

;HERE FOR 36 BIT VALUE
UNVPTF:	MOVE AC2,AC1		;GET COPY
	HLLZ AC1,AC1		;CLEAR POINTER
	CALL UNVBIN		;OUTPUT FLAGS
	MOVE AC1,(AC2)		;GET VALUE
	CALL UNVBIN		;OUTPUT IT
	JRST UNVNXT

;HERE FOR SPECIAL EXTERNAL SYMBOL
UNVSPT:	MOVE AC2,AC1		;COPY POINTER
	HLLZ AC1,AC1		;CLEAR POINTER
	CALL UNVBIN		;OUTPUT FLAGS
	MOVE AC1,(AC2)		;GET FIRST WORD
	CALL UNVBIN		;STORE VALUE
	MOVE AC1,1(AC2)		;GET RELOCATION WORD
	MOVE AC2,AC1		;COPY IT
	CALL UNVBIN
   IFN POLISH,<
	JUMPL AC2,UNVWPL	;IF POLISH JUMP
   >
	TRNN AC2,-1		;RIGHT HALF RELOCATION?
	JRST .+5		;NO
	MOVE AC1,(AC2)		;GET VALUE
	CALL UNVBIN
	MOVE AC1,1(AC2)		;EXTERNAL SYMBOL
	CALL UNVBIN
	TLNN AC2,-1		;LEFT HALF RELOCATION?
	JRST UNVNXT		;NO
	HLRZS AC2		;YES, SWAP
	JRST .-7		;AND OUTPUT
   IFN POLISH,<

;HERE IF POLISH
UNVWPL:	PUSH P,SDEL		;SAVE ORIGINAL SDEL
	PUSH P,AC2		;SAVE ORIGINAL AC2
	PUSH P,[-1]		;TO INDICATE THE END OF SAVED POINTERS
UNVWP1:	MOVEM AC2,UNVPOL	;SAVE THE POLISH PTR AT THE BEG OF STACK
	SETZ AC1,		;OUTPUT ZERO FOR 1ST WORD OF OPERATOR PAIR
	CALL UNVBIN		;WRITE IT OUT
	MOVE AC1,1(AC2)		;GET 2ND WORD -- THE OPERATOR
	CALL UNVBIN		;WRITE IT OUT
	MOVE SDEL,DESTB-3(AC1)	;GET # OF OPERANDS FOR THAT OPERATOR
UNVWP2:	ADDI AC2,2		;NEXT 2 WORDS PAIR
	MOVE AC1,(AC2)		;GET FIRST WORD
	CALL UNVBIN		;WRITE IT OUT
	JUMPN AC1,[	PUSH P,AC1 ;NOT ZERO, MUST BE A POINTER; SAVE IT
		SETZ AC1,	;ZERO FOR 2ND WORD
		JRST UNVWP5]
	MOVE AC1,1(AC2)		;GET 2ND WORD OF THE PAIR
UNVWP5:	CALL UNVBIN
	SOJG SDEL,UNVWP2	;ANY MORE OPERAND?
	SETZ AC1,
	CALL UNVBIN
	MOVE AC1,UNVPOL
	CALL UNVBIN

UNVWP3:	POP P, AC2		;NO, ANY PTRS SAVED ON STACK?
	CAME AC2,[-1]		;END OF SAVED PTRS?
	JRST UNVWP4		;NO, GO CHECK PTR
	POP P, AC2		;YES, RESTORE ORIGINAL AC2 COMING INTO UNVWPL
	POP P,SDEL		;RESTORE ORIGINAL SDEL
	JRST UNVNXT

UNVWP4:	JUMPL AC2,UNVWP1	;IF IT'S POLISH JUMP
	MOVE AC1,(AC2)		;GET 1ST WORD
	CALL UNVBIN
	SKIPE AC1
	PUSH P,AC2
	MOVE AC1,1(AC2)
	CALL UNVBIN
	JRST UNVWP3
;NUMBER OF OPERANDS FOR EACH OPERATOR
DESTB:	EXP 2,2,2,2,2,2,2,2,1,2,1,2,1,100

   >
;HERE FOR MACRO
UNVMAC:	MOVE AC2,AC1		;GET POINTER TO TEXT
	HLLZ AC1,AC1		;CLEAR POINTER
	CALL UNVBIN		;OUTPUT FLAGS
	HLRZ AC1,1(AC2)		;GET DEFAULT VALUES, IF ANY
	MOVEM AC1,UNVDFA	;SAVE STARTING ADRESS
	CALL UNVMCP		;GO DUMP MACRO ITSELF
	SKIPN AC2,UNVDFA	;SEE IF ANY DEFAULT VALUES (LEFT)
	JRST UNVNXT		;NO, CONTINUE WITH NEXT SYMBOL
	HRROI AC1,(AC2)		;SET UP AOBJP POINTER FOR # OF DEFAULTS
	SKIPE (AC1)		;ARE THERE ANY MORE?
	AOBJP AC1,.-1		;YES, COUNT AND TRY NEST
	CALL UNVBIN		;OUTPUT COUNT WORD
UNVMC1:	HLRZ AC1,(AC2)		;GET THE AGUMENT # OF THIS DEFAULT
	CALL UNVBIN		;OUTPUT THE ARGUMENT NUMBER
	MOVE AC2,(AC2)		;GET ADDRESS OF DEFAULT
	CALL UNVMCP		;GO OUTPUT, IT LOOKS LIKE MACRO
	AOS AC2,UNVDFA		;UP POINTER TO DEFAULT BLOCK
	SKIPE (AC2)		;SEE IF ANY MORE
	JRST UNVMC1		;YES, GO WRITE THEM OUT
	JRST UNVNXT		;NO, GO DO NEXT SYMBOL

UNVMCP:	HLL AC2,(AC2)		;PUT ADDRESS OF NEXT BLOCK IN LEFT
	QQ==0
REPEAT .LEAF,<
	MOVE AC1,QQ(AC2)
	CALL UNVBIN
	QQ==QQ+1>
	HLRZS AC2
	JUMPN AC2,UNVMCP	;MORE LEAFS TO PROCESS
	RET			;RETURN

UNVBIN:	SOSG UNVBUF+2
	CALL DMPUNV
	IDPB AC1,UNVBUF+1
	RET

DMPUNV:	OUT UNV,0
	  RET
	GETSTS UNV,C		;GET STATUS BITS
	TRNN C,ERRBIT		;ERRORS?
	RET			;NO, EXIT
	MOVSI AC0,'DSK'		;DEVICE ALWAYS DSK
	JRST ERRLST		;GIVE ERROR MESSAGE
;HERE TO READ IN UNIVERSAL SYMBOL TABLE

UNVINP:	MOVEM AC0,UNVDIR	;FILE WE NEED
	PUSH P,AC0		;SAVE REAL NAME OF UNV
	MOVSI AC1,'DSK'		;DEFAULT DEVICE
	MOVEM AC1,UNVDEV
	MOVSI AC1,'UNV'		;REQUIRED EXT
	MOVEM AC1,UNVDIR+1
	SETZM UNVDIR+2
	SETZM UNVDIR+3
	CAIE C,'('		;SEE IF USER SUPPLIED FILE SPEC
	JRST UNVOPN		;NO, USE DEFAULT
	CALL SCHGET		;GET A NAME
	CAIE C,':'		;IS IT A DEVICE?
	JRST UNVCKN		;NO TRY NAME
	MOVEM AC0,UNVDEV	;YES, SAVE DEVICE
	CALL SCHGET		;TRY NEXT NAME
UNVCKN:	MOVEM AC0,UNVDIR	;SAVE NAME
	CAIE C,'.'		;DOES EXT FOLLOW?
	JRST .+3		;NO
	CALL SCHGET		;YES, GET IT
	MOVEM AC0,UNVDIR+1	;AND STORE IT
	CAIE C,'['		;A DIRECTORY SPECIFIED?
	JRST SCHCLP		;NO
	CALL SCHOCT		;GET PPN
	HRLZM AC0,UNVDIR+3	;AND SAVE IT
	CAIE C,','		;CHECK PROG NO.
	TROA ER,ERRQ		;WARN USER
	CALL SCHOCT		;GET IT
	HRRM AC0,UNVDIR+3
	CAIE C,','		;AN SFD GIVEN?
	JRST SCHCLB		;NO
	MOVEI AC0,UNVPTH	;GET PATH PTR
	EXCH AC0,UNVDIR+3	;SWAP WITH PPN
	MOVEM AC0,UNVPTH+2	;AND PUT IN PATH
	MOVSI RC,-.SFDLN	;AOBJN PTR FOR SFDS
SCHSFD:	CALL SCHGET		;GET SFD NAME
	AOBJP RC,SCHCLB+1	;SEE IF ENOUGH ROOM
	MOVEM AC0,UNVPTH+2(RC)	;YES, STORE
	CAIN C,','		;DOES PATH CONTINUE ON?
	JRST SCHSFD		;YES
SCHCLB:	CAIE C,']'		;DOES PATH FINISH PROPERLY?
	TROA ER,ERRQ		;NO
	CALL BYPASS		;[664] EAT UP THE "]"
SCHCLP:	CAIE C,')'		;FILE SPEC END PROPERLY?
	TROA ER,ERRQ		;NO
	CALL BYPASS		;[664] EAT IT
UNVOPN:	POP P,AC0		;UNV NAME BACK IN 0
	OPEN UNV,UNVINI		;TRY USER SPECIFICATION
	  JRST UNVUNV		;FAILED
	LOOKUP UNV,UNVDIR	;SEE IF THERE
	  JRST UNVUNV		;TRY UNV:
	MOVEM AC0,UNVDIR	;RESTORE NAME OF UNV 
UNVFND:	MOVE RC,UNIVNO		;[1002] GET NUM OF CURRENT UNIV TABLES IN CORE
	CAILE RC,.UNIV-1	;[1002] SEE IF ROOM IN TABLES
	JRST UNVERR		;NO, GIVE ERROR
	SKIPN UNIVSN		;IS CURRENT PROG A UNIVERSAL
	JRST UNVNOT		;NO
	CAIL RC,.UNIV-1		;[1002] YES, ROOM FOR IT AS WELL?
	JRST UNVERR		;NO
	MOVE AC1,UNITBL+1(RC)	;[1002] GET CURRENT NAME
	MOVEM AC1,UNITBL+2(RC)	;[1002] STORE IT IN NEXT SLOT
UNVNOT:	PUSH P,AC0		;[1002] SAVE NAME
	HLRE SDEL,UNVDIR+3	;GET SIZE OF FILE
	MOVMS SDEL		;IN WORDS
	ADD SDEL,FREE		;AT TOP OF FREE CORE
	HRRZM SDEL,UNIPTR+1(RC)	;[1002] SAVE NEW SYMTOP (IN WRONG HALF)
	ADDI SDEL,2*203		;PLUS  2 BUFFERS
	CAML SDEL,SYMBOL	;WILL IT FIT?
	CALL XCEED		;NO, TRY FOR MORE
	CAML SDEL,SYMBOL	;DID WE GET ENOUGH?
	JRST .-2		;NO TRY AGAIN
	SUBI SDEL,2*203		;START OF BUFFERS
	MOVEM SDEL,.JBFF
	INBUF UNV,2		;STANDARD DOUBLE BUFFERING
	CALL UNVREAD		;READ 
	TLC AC1,777		;[1002] LEFT HALF OF FIRST WORD OF UNV FILE
	TLCE AC1,777		;[1002] MUST BE A 777 MARKER
	JRST UNVFAKE		;[1002] ERROR FOR FAKE UNV
	TLNE AC1,777000		;[1002]
	JRST UNVFAKE		;[1002] ERROR
	AOS RC,UNIVNO		;[1002] BUMP COUNT OF UNIVERSALS
	POP P,UNITBL(RC)	;[1002] ADD NAME TO TABLE
	HRRZS AC1		;GET UNV VERSION #
	SETOM UNVER%		;KLUDGE SWITCH TO ALLOW VERSION 4
	CAIE AC1,4		;SEE IF 4 (MIGHT BOMB DEFAULT ARGUMENTS)
	AOS UNVER%		;NO, UNVER% IS 0 FOR GOOD FILES
	TRNE AC1,.URVER		;MAKE SURE EXTRA BITS ARE NOT ON
	JRST VERSKW		;YOU LOSE
	TRNE AC1,UMACV		;MACRO VERSION EXPECTED?
	CALL UNVREAD		;YES, SKIP OVER IT
	CALL UNVREAD		;READ SYMBOL COUNT (SECOND WORD)
	MOVE SDEL,AC1		;GET COPY
	LSH SDEL,1		;TWO WORDS PER SYMBOL
	ADDI SDEL,1		;PLUS ONE FOR COUNT
	MOVNS SDEL		;NEGATE
	MOVE AC2,SDEL		;STORE IT
	ADD AC2,UNIPTR(RC)	;ADD SYMTOP
	HRLM AC2,UNIPTR(RC)	;TO FORM SYMBOL
	MOVSS UNIPTR(RC)	;NOW PUT IN CORRECT HALVES
	MOVN SDEL,AC1		;GET NO. OF SYMBOLS
	HRLZ SDEL,SDEL		;TO FORM AOBJN POINTER
	HRR SDEL,AC2		;POINT TO WHERE TO STORE THEM
	MOVEM AC1,(SDEL)	;STORE COUNT
	ADDI SDEL,1		;AND GET PAST IT
UNVRLO:	CALL UNVREAD		;GET A SYMBOL
	MOVEM AC1,(SDEL)	;STORE IT
	ADDI SDEL,1		;INCREMENT PAST IT
	CALL UNVREAD		;GET  VALUE
	MOVEM AC1,(SDEL)	;STORE IT
	TLNE AC1,SPTR		;SPECIAL EXTERNAL POINTER?
	JRST UNVRSP		;YES
	TLNE AC1,EXTF		;EXTERNAL (NOT SPTR)?
	JRST UNVREX		;YES
	TLNE AC1,MACF		;MACRO?
	JRST UNVRMC		;YES
	TLNE AC1,PNTF		;36 BIT VALUE
	JRST UNVRPT		;YES
UNVRNX:	AOBJN SDEL,UNVRLO	;GET NEXT
	RELEASE UNV,
	MOVE RC,UNIVNO		;POINT TO LAST ENTRY
	MOVE AC1,UNITBL+1(RC)	;GET NAME IN CASE IN UNIV NOW
	SKIPE UNIVSN		;ARE WE?
	MOVEM AC1,UNVDIR	;YES, RESET NAME OF OUTPUT FILE
   IFN FTPSECT,<		;[575]
	PUSH P,SGSBOT
	PUSH P,SGSTOP
	PUSH P,SGSCNT
	PUSH P,SGNCUR
   >
	PUSH P,SYMBOL
	PUSH P,SYMTOP		;SAVE EXISTING VALUES
	PUSH P,SRCHX
	MOVE AC1,UNIPTR(RC)	;GET SYMTOP,,SYMBOL
	HLRZM AC1,SYMTOP
	HLRZM AC1,FREE		;DON'T FORGET TO SET FREE BEYOND SYMTOP
	HRRZM AC1,SYMBOL
	HLRZ AC1,AC1		;TOP LOCATION
	MOVEM AC1,UNITOP	;SAVE NEW TOP FOR UNIVERSALS
	CAMLE AC1,MACSIZ	;HAVE WE INCREASED?
	MOVEM AC1,MACSIZ	;YES, STOP ILL MEM REFS
   IFN FTPSECT,<		;[575]
	SETZM SGNCUR
	MOVE AC0,@SYMBOL
	MOVEM AC0,SGSCNT
   >
	CALL SRCHI		;SETUP SEARCH POINTER
	MOVE AC1,SRCHX		;LOAD IT
	MOVEM AC1,UNISHX(RC)	;SAVE IT
	POP P,SRCHX		;RESTORE
	POP P,SYMTOP
	POP P,SYMBOL
   IFN FTPSECT,<		;[575]
	POP P,SGNCUR
	POP P,SGSCNT
	POP P,SGSTOP
	POP P,SGSBOT
   >
	JRST SERCH1		;AND RETURN

;HERE FOR 36 BIT VALUE
UNVRPT:	CALL UNVREAD
	AOS AC2,FREE		;GET A FREE LOC
	SUBI AC2,1
	MOVEM AC1,(AC2)		;STORE IT
	HRRM AC2,(SDEL)		;FIXUP SYMBOL POINTER
	JRST UNVRNX		;GET NEXT
;HERE FOR EXTERNAL (NOT SPTR)
UNVREX:	MOVEI AC2,2		;NEED 2 LOCS
	ADDB AC2,FREE
	SUBI AC2,2		;POINT TO START OF 2 WORDS
	CALL UNVREAD		;GET VALUE
	MOVEM AC1,0(AC2)	;MOST LIKELY 0
	CALL UNVREAD		;GET NAME
	MOVEM AC1,1(AC2)
	HRRM AC2,(SDEL)		;POINT TO VALUE
	JRST UNVRNX		;GET NEXT

;HERE FOR SPECIAL EXTERNAL SYMBOL
UNVRSP:	CALL UNVR2W		;GET 2 LOCATIONS
	CALL UNVREAD		;GET VALUE
	MOVEM AC1,(AC2)
	CALL UNVREAD		;GET RELOCATION
	HRRM AC2,(SDEL)		;STORE POINTER
	MOVEI RC,1(AC2)		;POINT TO RELOCATION WORD
	SETZM (RC)		;CLEAR RELOCATION
   IFN POLISH,<
	JUMPL AC1,UNVRPL	;JUMP IF IT'S POLISH
   >
	MOVE AC2,AC1		;STORE PREVIOUS RELOCATION
	TRNN AC2,-1		;RIGHT HALF RELOCATION?
	JRST UNVRS2		;NO
	HRR AC2,FREE		;POINT TO NEXT 2 WORD BLOCK
	HRRM AC2,(RC)		;POINT TO BLOCK (RELOCATION)
UNVRS1:	CALL UNVREAD		;GET VALUE
	MOVEM AC1,(AC2)
	CALL UNVREAD		;GET EXTERNAL SYMBOL
	MOVEM AC1,1(AC2)
	HRRI AC2,2(AC2)		;INCREMENT RIGHT HALF BY 2 WORDS USED
	HRRZM AC2,FREE		;INCREMENT FREE
UNVRS2:	TLZN AC2,-1		;LEFT HALF RELOCATION?
	JRST UNVRNX		;NO, GET NEXT SYMBOL
	HRLM AC2,(RC)		;FIX LEFT RELOCATION
	JRST UNVRS1		;AND FILL IN VALUE

UNVR2W:	MOVEI AC2,2		;GET 2 LOCATIONS
	ADDB AC2,FREE		;FROM FREE CORE
	SUBI AC2,2		;POINT TO START OF 2 WORDS
	RET
   IFN POLISH,<

;HERE FOR POLISH
UNVRPL:	PUSH P,[-1]		;END OF LOCATIONS TO BE ADJUSTED
	MOVEM AC1,UNVPOL	;STORE PTR, USED TO FIND END OF POL STK
	CALL UNVR2W		;GET 2 LOCATIONS
UNVRP0:	SETOM (RC)		;-1 IN LEFT HALF
	HRRM AC2,(RC)		;TO SET UP A NEW POLISH POINTER
	MOVE AC1,(RC)	
	MOVEM AC1,UNVNPL	;SAVE THE NEW POLISH POINTER
UNVRP1:	CALL UNVREAD		;READ 1ST WORD OF THE PAIR
	MOVEM AC1,(AC2)	
	JUMPE AC1,UNVRP2
	SKIPG AC1		;SKIP IF NOT POLISH
	PUSH P,AC1		;STORE POLISH PTR WITH ORIGINAL ADDR
	MOVEI RC,(AC2)
	HLL RC,AC1
	PUSH P,RC		;STORE LOCATIONS TO BE ADJUSTED ON STACK
UNVRP2:	CALL UNVREAD		;READ 2ND WORD OF THE PAIR
	CAME AC1,UNVPOL		;END OF POLISH STACK?
	JRST [	MOVEM AC1,1(AC2)
		CALL UNVR2W
		JRST UNVRP1]	;GET 2 LOCATIONS AND LOOP BACK
	MOVE AC1,UNVNPL		;ADJUSTED NEW POL STR IN 2ND WORD
	MOVEM AC1,1(AC2)

;HERE AT END OF POLISH STACK READ
UNVRP3:	POP P,AC1		;GET LOCATION TO BE ADJUSTED
	CAMN AC1,[-1]		;NO MORE?
	JRST UNVRNX
	CALL UNVR2W		;GET 2 LOCATIONS
	HRRM AC2,(AC1)		;SO ADJUST IT
	JUMPL AC1,[POP P, AC1	;GET POL PTR WITH ORIGINAL ADDR
		MOVEM AC1,UNVPOL ;SAVE IT
		SETZM (AC2)	;ZERO THE FIRST WORD
		MOVEI RC,1(AC2)
		JRST UNVRP0]
	MOVEI RC,(AC2)
	CALL UNVREAD		;READ 1ST WORD
	MOVEM AC1,(AC2)
	JUMPE AC1,UNVRP4
	HLL RC,AC1
	PUSH P,RC
UNVRP4:	CALL UNVREAD
	MOVEM AC1,1(AC2)
	JRST UNVRP3

   >
;HERE FOR MACRO
UNVRMC:	MOVE AC2,FREE		;FREE LOC COUNTER
	HRRM AC2,(SDEL)		;IS WHERE MACRO STARTS

	MOVEM AC2,UNVDFA	;SAVE STARTING ADDRESS OF MACRO
	CALL UNVRML		;GO READ IN MACRO DEFINITION
	MOVE AC1,UNVDFA		;GET STARTING ADDRESS BACK
	HLRZ AC2,1(AC1)		;GET POINTER FOR ANY DEFAULTS
	JUMPE AC2,UNVRNX	;NONE, GO DO NEXT SYMBOL
	SKIPE UNVER%		;MAKE SURE WE WROTE THEM ON DISK
	JRST UNVRER		;NO, TELL USER
	PUSH P,SDEL		;SAVE AOBJN POINTER
	MOVE AC2,FREE		;GET NEXT FREE ADDRESS
	HRLM AC2,1(AC1)		;POINT TO IT IN MACRO BODY
	CALL UNVREAD		;GO READ COUNT OF DEFAULTS
	MOVN SDEL,AC1		;COPY COUNT TO AOBJN POINTER
	HRRI SDEL,(AC2)		;SET AOBJN ADDRESS INTO SDEL
	HLRZ AC2,AC1		;GET COUNT-1 OF DEFAULTS
	ADDI AC2,2		;CHANGE TO COUNT+1 (+0 WORD)
	ADDB AC2,FREE		;BUMP FREE BY DEFAULT POINTER BLOCK LENGTH
UNVRM1:	CALL UNVREAD		;GO READ ARGUMENT NUMBER
	HRLM AC1,(SDEL)		;SAVE IN POINTER BLOCK
	HRRM AC2,(SDEL)		;SAVE START OF VALUE (MAY BE SET UP BY UNVRML)
	CALL UNVRML		;GO COPY DEFAULT VALUE
	AOBJN SDEL,UNVRM1	;DO ALL DEFAULTS
	SETZM (SDEL)		;CLEAR END OF BLOCK WORD
	POP P,SDEL		;RESTORE BIG AOBJN WORD
	JRST UNVRNX		;GO DO NEXT SYMBOL

UNVRML:	QQ==0
REPEAT .LEAF,<
	CALL UNVREAD
	MOVEM AC1,QQ(AC2)	;STORE
QQ==QQ+1>
	MOVE AC1,(AC2)		;SEE WHAT FIRST WORD WAS
	TLNN AC1,-1		;IF ZERO THEN FINISHED
	JRST UNVRMF		;SET LAST BLOCK POINTER
	MOVEI AC1,.LEAF(AC2)	;POINT TO NEXT BLOCK
	HRLM AC1,(AC2)		;FILL IT IN
	ADDI AC2,.LEAF		;POINT TO IT
	JRST UNVRML		;AND LOOP

UNVRMF:	MOVE AC1,(SDEL)		;GET FIRST BLOCK
	HRRM AC2,(AC1)		;POINT TO LAST
	ADDI AC2,.LEAF		;POINT TO NEXT FREE
	MOVEM AC2,FREE
	RET			;RETURN

UNVRER:	PUSH P,['MCROUF']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / UNIVERSAL FILE DEFAULT ARGUMENTS LOST, REASSEMBLE@/] ;[1066]
	JRST ERRFIN		;PRINT THAT HAD DEFAULTS WHICH WERE LOST
UNVFAKE: PUSH P,['MCRNUF']	;[1066] SET UP PREFIX
	POP P,PREFIX		;[1066]
	MOVSI RC,[SIXBIT / NOT A REAL UNIVERSAL FILE@/] ;[1066]
	JRST ERRFIN		;NAME IN AC0
UNVREA:	SOSG UNVBUF+2
	CALL UNVRIN
	ILDB AC1,UNVBUF+1
	RET

UNVRIN:	IN UNV,
	  RET
	GETSTS UNV,C		;GET STATUS BITS
	TRNN C,ERRBIT!2000	;ERRORS?
	JRST [PUSH P,['MCRERU'] ;[1066] SET UP PREFIX
		POP P,PREFIX	;[1066]
		MOVSI RC,[SIXBIT / UNEXPECTED END-OF-FILE READING UNIVERSAL FILE@/] ;[1066]
		JRST ERRFIN]	;GIVE ERROR MESSAGE,NAME IN AC0
	MOVE AC0,UNVDEV		;GET DEVICE
	JRST READ4		;GIVE I/O ERROR MESSAGE

UNVUNV:	MOVEM AC0,UNVDIR	;RESTORE REAL NAME
	MOVSI AC1,'UNV'		;AND DEFAULT EXT
	MOVEM AC1,UNVDIR+1
	SETZM UNVDIR+2
	SETZM UNVDIR+3		;DEFAULT PATH
	INIT UNV,B
	SIXBIT /UNV/
		UNVBUF
	  JRST UNVSYS
	LOOKUP UNV,UNVDIR
	  JRST UNVSYS
	JRST UNVFND

UNVSYS:	INIT UNV,B
	SIXBIT /SYS/
		UNVBUF
	  JRST SCHERR
	LOOKUP UNV,UNVDIR	;SEE IF THERE
	  JRST SCHERR		;NO
	JRST UNVFND		;GOT IT
SUBTTL MACHINE INSTRUCTION SEARCH ROUTINES

   IFE OPHSH,<
OPTSCH:	MOVEI RC,0
	MOVEI ARG,1B^L<OP1END-OP1TOP> ;SET UP INDEX
	MOVEI V,1B^L<OP1END-OP1TOP>/2 ;SET UP INCREMENT

OPT1A:	CAMN AC0,OP1TOP(ARG)	;ARE WE POINTING AT SYMBOL?
	JRST OPT1D		;YES, GET THE CODE
	JUMPE V,CPOPJ		;[664] TEST FOR END
	CAML AC0,OP1TOP(ARG)	;NO, SHOULD WE MOVE DOWN?
	TDOA ARG,V		;NO, INCREMENT
OPT1B:	SUB ARG,V		;YES, DECREMENT
	ASH V,-1		;HALVE INCREMENT
	CAIG ARG,OP1END-OP1TOP	;ARE WE OUT OF BOUNDS?
	JRST OPT1A		;NO, TRY AGAIN
	JRST OPT1B		;YES, BRING IT DOWN A PEG
   >

   IFN OPHSH,<
OPTSCH:	MOVE ARG,AC0		;GET SIXBIT NAME
	TLZ ARG,400000		;CLEAR SIGN BIT
	IDIVI ARG,PRIME		;REM. GOES IN V
	CAMN AC0,OP1TOP(V)	;ARE WE POINTING AT SYMBOL?
	JRST OPT1D		;YES
	SKIPN OP1TOP(V)		;TEST FOR END
	JRST OPT1B		;SYMBOL NOT FOUND
	HLRZ RC,ARG		;SAVE LHS OF QUOTIENT
	SKIPA ARG,RC		;GET IT BACK
OPT1A:	ADDI ARG,(RC)		;INCREMENT ARG
	ADDI V,(ARG)		;QUADRATIC INCREASE TO V
	CAIL V,PRIME		;V IS MODULO PRIME
	JRST [SUBI V,PRIME
		JRST .-1]
	CAMN AC0,OP1TOP(V)	;IS THIS IT?
	JRST OPT1D		;YES
	SKIPE OP1TOP(V)		;END?
	JRST OPT1A		;TRY AGAIN
OPT1B:	SETZ RC,		;CLEAR RELOCATION IN CASE IMPLICIT OPDEF
	RET			;FAILED
   >
OPT1D:
   IFN OPHSH,< SETZ RC,		;CLEAR RELOCATION
	MOVE ARG,V>		;GET INDEX IN RIGHT ACC.
	IDIVI ARG,4		;ARG HAS INDEX USED IN OPTTAB
	LDB V,OPTTAB(V)		;V HAS INDEX TO OPTTAB
	CAIL V,700		;PSEUDO-OP OR IO INSTRUCTION?
	JRST OPT1G		;YES
	ROT V,-^D9		;LEFT JUSTIFY
	HRRI V,OP		;POINT TO BASIC FORMAT
OPT1F:	AOS 0(P)		;SET FOR SKIP EXIT
	MOVEI SDEL,%OP		;SET OP-CODE CROSS-REF FLAG
	JRST CREF		;TEST AND OUTPUT, AC0=SYMBOL, V=VALUE

OPT1G:	JUMPG AC0,[CAME AC0,['.XCREF'] ; DON'T CREF .XCREF
		JRST .+3	;IF ".","$",OR "%" USE TABLE 1
		MOVE V,OP1TAB-700(V) ; USE TABLE 1
		JRST CPOPJ1]	;AND BYPASS CREF
	TLNN AC0,200000		;PSEUDO-OP OR IO INST., TEST FOR PROPER TABLE
	SKIPA V,OP2TAB-700(V)	;2ND TABLE, FIRST LETTER IS "A" TO "O"
	MOVE V,OP1TAB-700(V)	;1ST TABLE, ..."P" TO "Z"
	JRST OPT1F		;EXIT

OPTTAB:
   IFE OPHSH,< POINT 9,OP1COD-1(ARG),35>
	POINT 9,OP1COD  (ARG), 8
	POINT 9,OP1COD  (ARG),17
	POINT 9,OP1COD  (ARG),26
   IFN OPHSH,< POINT 9,OP1COD  (ARG),35>
	.XCREF			;DON'T CREF THIS MESS
   IFE OPHSH,<
	RELOC .-1
OP1TOP:
	RELOC

	IF1,<N1=0
	DEFINE X (SYM,COD)<N1=N1+1>> ;

	IF2, <
	N2=^D36
	CC=0
	RELOC OP1COD
	RELOC
DEFINE X (SYMBOL,CODE)
<SIXBIT /SYMBOL/
CC=CC+CODE_<N2=N2-9>
   IFE N2, <OUTLIT>>

DEFINE OUTLIT <
	RELOC
	+CC
	RELOC
N2=^D36+<CC=0>>>
   >
   IFN OPHSH,<
OP1TOP:	IF1,< BLOCK PRIME>
   IF1,<DEFINE X (SB,CD)<>>
   IF2,<
DEFINE OPSTOR (RM)<.$'RM=.$'RM+<OPCODE_<9*<3-R&3>>>>

DEFINE X (SB,CD)<
SXB=<SIXBIT /SB/>
Q=SXB&-1_-1/PRIME
R=SXB&-1_-1-Q*PRIME
H=Q_-22&777
TRY=1
OPCODE=CD
ITEM Q,\R
   IFL PRIME-TRY,<PRINTX HASH FAILURE>>

DEFINE ITEM (QT,RM)<
   IFN .%'RM,<R=R+H
   IFL PRIME-R,<R=R-R/PRIME*PRIME>
H=H+Q_-22&777
   IFGE PRIME-<TRY=TRY+1>,<ITEM Q,\R>>
   IFE .%'RM,<.%'RM=SXB
OPSTOR \<R/4>>>>
   IF1,<
DEFINE GETSYM (N)<.%'N=0>

N=0
	XLIST
REPEAT PRIME,<GETSYM \N
N=N+1>
DEFINE GETSYM (N)<.$'N=0>
N=0
REPEAT <PRIME/4+1>,<GETSYM \N
N=N+1>
   >
	LIST>

;MACRO TO HANDLE KI10 OP-CODES
   IFE KI10,<
DEFINE XK (SB,CD) <>>		;NUL MACRO
   IFN KI10,<SYN X,XK>		;USUAL X MACRO

;MACRO TO HANDLE KL10 OP-CODES
   IFE KL10,<
DEFINE XL (SB,CD) <>>		;NUL MACRO
   IFN KL10,<SYN X,XL>		;USUAL X MACRO

;MACRO TO HANDLE F40 UUOS
   IFE F40,<
DEFINE XF (SB,CD) <>>		;NUL MACRO
   IFN F40,<SYN X,XF>		;USUAL X MACRO
X ADD   , 270
X ADDB  , 273
X ADDI  , 271
X ADDM  , 272

XL ADJBP , 133
XL ADJSP , 105

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 ARG   , 320
X ARRAY , 771
   IFN IIISW,<X ASCID , 773>
X ASCII , 700
X ASCIZ , 701

X ASH   , 240
X ASHC  , 244

X ASUPPR, 705

X BLKI  , 702
X BLKO  , 703
X BLOCK , 704
X BLT   , 251

X BYTE  , 707

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
XL CMPSE , 002
XL CMPSG , 007
XL CMPSGE, 005
XL CMPSL , 001
XL CMPSLE, 003
XL CMPSN , 006
X COMMEN, 770


X CONI  , 710
X CONO  , 711
   IFN STANSW,<X CONS,257>
X CONSO , 712
X CONSZ , 713

XL CVTBDO, 012
XL CVTBDT, 013
XL CVTDBO, 010
XL CVTDBT, 011
XL DADD  , 114

XF DATA. , 020

X DATAI , 714
X DATAO , 715
XL DDIV  , 117
X DEC   , 716
X DEFINE, 717
X DEPHAS, 720

XK DFAD  , 110
XK DFDV  , 113
XK DFMP  , 112
X DFN   , 131
XK DFSB  , 111

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

XK DMOVE , 120
XK DMOVEM, 124
XK DMOVN , 121
XK DMOVNM, 125
XL DMUL  , 116
X DPB   , 137
XL DSUB  , 115
XL EDIT  , 004

X END   , 721
X ENTER , 077
X ENTRY , 722

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

X EXCH  , 250

X EXP   , 723
XL EXTEND, 123
X EXTERN, 724

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

XF FIN.  , 021

   IFN STANSW,<X FIX   , 130>
   IFE STANSW,<XK FIX   , 122>
XK FIXR  , 126
XK 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
X HALT  , 725
X HISEG , 706

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 IF1   , 726
X IF2   , 727
X IFB   , 730
X IFDEF , 731
X IFDIF , 732
X IFE   , 733
X IFG   , 734
X IFGE  , 735
X IFIDN , 736
X IFL   , 737
X IFLE  , 740
X IFN   , 741
X IFNB  , 742
X IFNDEF, 743

X ILDB  , 134

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

X IN    , 056
XF IN.   , 016
X INBUF , 064
XF INF.  , 026
X INIT  , 041
X INPUT , 066
X INTEGE, 772

X INTERN, 744

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


X IOWD  , 745
X IRP   , 746
X IRPC  , 747
X JCRY  , 750
X JCRY0 , 751
X JCRY1 , 752
X JEN   , 753

X JFCL  , 255

X JFFO  , 243
X JFOV  , 765
X JOV   , 754

X JRA   , 267
X JRST  , 254

X JRSTF , 755

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 LALL  , 756

X LDB   , 135

X LIST  , 757
X LIT   , 760
X LOC   , 761

X LOOKUP, 076

X LSH   , 242
X LSHC  , 246
XK MAP   , 257
X MLOFF , 767
X MLON  , 766
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
XL MOVSLJ, 016
X MOVSM , 206
XL MOVSO , 014
XL MOVSRJ, 017
X MOVSS , 207
XL MOVST , 015


X MTAPE , 072
XF MTOP. , 024

X MUL   , 224
X MULB  , 227
X MULI  , 225
X MULM  , 226
XF NLI.  , 031
XF NLO.  , 032

X NOSYM , 762
X OCT   , 763
X OPDEF , 764

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
XF OUT.  , 017
X OUTBUF, 065
XF OUTF. , 027
X OUTPUT, 067
X PAGE  , 700
X PASS2 , 701
X PHASE , 702
X POINT , 703

X POP   , 262
X POPJ  , 263
X PORTAL, 760

X PRGEND, 714
X PRINTX, 704
X PURGE , 705

X PUSH  , 261
X PUSHJ , 260

X RADIX , 706
X RADIX5, 707

XL RDCLK , 052
X RELEAS, 071

X RELOC , 710
X REMARK, 711

X RENAME, 055

X REPEAT, 712

XF RESET., 015
X RIM   , 715
X RIM10 , 735
X RIM10B, 736

X ROT   , 241
X ROTC  , 245

X RSW   , 716
XF RTB.  , 022
X SALL  , 720
X SEARCH, 721

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 SIXBIT, 717

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

XF SLIST., 025

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

   IFN STANSW,<X SPCWAR,43>
X SQUOZE, 707

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

X STOPI , 722

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

   IF2,<IFE OPHSH,<SUBTL:>>
X SUBTTL, 723
X SUPPRE, 713
X SYN   , 724
X TAPE  , 725
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 TITLE , 726

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 TWOSEG, 731
X UFA   , 130
X UGETF , 073
X UJEN  , 100
X UNIVER, 737
X USETI , 074
X USETO , 075

X VAR   , 727

XF WTB.  , 023

X XALL  , 732

XL XBLT  , 020
X XCT   , 256
XL XJEN  , 761
XL XJRSTF, 762

X XLIST , 733

X XOR   , 430
X XORB  , 433
X XORI  , 431
X XORM  , 432

XL XPCW  , 763
X XPUNGE, 730
XL XSFM  , 764
X XWD   , 734

X Z     , 000

X .ASSIG, 751
X .COMMO, 747
X .CREF , 740
X .DIREC, 750
   IFN FTPSECT,<		;[575]
X .ENDPS, 766
   >
X .HWFRM, 742
X .IF   , 756
X .IFN  , 757
X .LINK , 753
X .LNKEN, 754
X .MFRMT, 743
X .NODDT, 746
X .ORG  , 752
   IFN FTPSECT,<		;[575]
X .PSECT, 765
   >
X .REQUE, 744
X .REQUI, 745
X .TEXT , 755
X .XCREF, 741
   IFE OPHSH,<
   IF1, < BLOCK N1>
OP1END:	-1B36
OP1COD:	BLOCK N1/4
	CC
 IF2,< PURGE N1,N2>
   >
   IFN OPHSH,<
   IF2,<
DEFINE SETVAL (N)<EXP .%'N
PURGE .%'N>
N=0
XLIST
REPEAT PRIME,<SETVAL \N
N=N+1>
LIST
   >
OP1COD:	IF1,< BLOCK <PRIME/4+1>>
   IF2,<
DEFINE SETVAL (N)<EXP .$'N
PURGE .$'N>
N=0
XLIST
REPEAT <PRIME/4+1>,<SETVAL \N
N=N+1>
   >
LIST>

	.CREF			;START CREFFING AGAIN
	SUBTTL PERMANENT SYMBOLS

SYMNUM:	EXP LENGTH/2		;NUMBER OF PERMANENT SYMBOLS

DEFINE PSYM (A,B)<
	XLIST
	SIXBIT /A/
	XWD SYMF!NOOUTF,B
	LIST>

	PSYM @, 0(SUPRBT)
	PSYM ??????, 0(SUPRBT)

LENGTH= .-SYMNUM-1		;LENGTH OF INITIAL SYMBOLS

PRMTBL:				;PERMANENT SYMBOLS
	PSYM ADC, 24
	PSYM ADC2, 30
	PSYM APR, 0
	PSYM CCI, 14
	PSYM CDP, 110
	PSYM CDR, 114
	PSYM CLK, 70
	PSYM CLK2, 74
	PSYM CPA, 0
	PSYM CR, 150
	PSYM CR2, 154
	PSYM DC, 200
	PSYM DC2, 204
	PSYM DCSA, 300
	PSYM DCSB, 304
	PSYM DDC, 270
	PSYM DDC2, 274
	PSYM DF, 270
	PSYM DIS, 130
	PSYM DIS2, 134
	PSYM DLB, 60
	PSYM DLB2, 160
	PSYM DLC, 64
	PSYM DLC2, 164
	PSYM DLS, 240
	PSYM DLS2, 244
	PSYM DPC, 250
	PSYM DPC2, 254
	PSYM DPC3, 260
	PSYM DPC4, 264
	PSYM DSI, 464
	PSYM DSI2, 474
	PSYM DSK, 170
	PSYM DSK2, 174
	PSYM DSS, 460
	PSYM DSS2, 470
	PSYM DTC, 320
	PSYM DTC2, 330
	PSYM DTS, 324
	PSYM DTS2, 334
	PSYM LPT, 124
	PSYM LPT2, 234
	PSYM MDF, 260
	PSYM MDF2, 264
	PSYM MTC, 220
	PSYM MTM, 230
	PSYM MTS, 224
	PSYM PAG, 10
	PSYM PI, 4
	PSYM PLT, 140
	PSYM PLT2, 144
	PSYM PTP, 100
	PSYM PTR, 104
	PSYM TMC, 340
	PSYM TMC2, 350
	PSYM TMS, 344
	PSYM TMS2, 354
	PSYM TTY, 120
	PSYM UTC, 210
	PSYM UTS, 214
PRMEND:				;END OF PERMANENT SYMBOLS
	OPDEF ZL [Z LITF]	;INVALID IN LITERALS
	OPDEF ZA [Z ADDF]	;INVALID IN ADDRESSES
	OPDEF ZAL [Z ADDF!LITF]

OP1TAB:

	ZA PAGE0		;PAGE
	ZAL PASS20		;PASS2
	ZAL PHASE0		;PHASE
	Z POINT0		;POINT
	ZA PRNTX0		;PRINTX
	ZA PURGE0		;PURGE
	ZA RADIX0		;RADIX
	Z RADX50		;RADIX50,SQUOZE
	ZAL %ORG (1)		;RELOC
	ZAL REMAR0		;REMARK
	ZA REPEA0		;REPEAT
	ZA SUPRE0		;SUPRESS
	ZAL PSEND0		;PRGEND
	ZAL RIM0 (RIMSW)	;RIM
	DATAI 0,IOP		;RSW
	Z ASCII0 (1)		;SIXBIT
	ZA IOSET (IOPALL!IOSALL) ;[1065] SALL
	ZAL SERCH0		;SEARCH
	ZA STOPI0		;STOPI
	ZA SUBTT0 (Z (POINT 7,,)) ;SUBTTL
	ZA SYN0			;SYN
	ZAL TAPE0		;TAPE
	ZA TITLE0 (Z (POINT 7,,)) ;TITLE
	ZAL VAR0		;VAR

	Z XPUNG0		;XPUNGE
	ZAL TWSEG0		;TWOSEGMENTS
	ZA XALL0 (IOPALL)	;[1065] XALL
	ZA IOSET (IOPROG)	;[1065][1150] XLIST
	Z XWD0			;XWD
	ZAL RIM0 (RIM1SW)	;RIM10
	ZAL RIM0 (R1BSW)	;RIM10B
	ZA UNIV0 (Z (POINT 7,,)) ;UNIVERSAL
	ZA ONCRF (IONCRF)	;[1063] .CREF
	ZA OFFCRF (IONCRF)	;[1063] .XCREF
	ZA OFFORM		;.HWFRMT
	ZA ONFORM		;.MFRMT
	ZAL REQUEST		;.REQUEST
	ZAL REQUIRE		;.REQUIRE
	ZA NODDT0		;.NODDT
	ZAL COMM0		;.COMMON
	ZA %DIREC		;[1065] .DIRECTIVE
	ZA ASGN			;.ASSIGN
	ZAL %ORG (1B18)		;.ORG
	ZAL %LINK (0)		;.LINK
	ZAL %LINK (1B18)	;.LNKEND
	Z %TEXT0 (1B18+1B21)	;.TEXT
	Z %IF			;.IF
	Z %IFN			;.IFN
	JRST 1,OP		;PORTAL
	JRST 6,OP		;XJEN
	JRST 5,OP		;XJRSTF
	JRST 7,OP		;XPCW
	JRST 14,OP		;XSFM
   IFN FTPSECT,<		;[575]
	ZA %SEGME		;.PSECT
	ZA %ENDSE		;.ENDPS
   >
OP2TAB:

	Z ASCII0 (0)		;ASCII
	Z ASCII0 (1B18)		;ASCIZ
	BLKI IOP		;BLKI
	BLKO IOP		;BLKO
	ZAL BLOCK0		;BLOCK
	ZA SUPRSA		;ASUPPRESS
	ZAL HISEG0		;HISEG
	Z BYTE0			;BYTE
	CONI IOP		;CONI
	CONO IOP		;CONO
	CONSO IOP		;CONSO
	CONSZ IOP		;CONSZ
	DATAI IOP		;DATAI
	DATAO IOP		;DATAO
	Z OCT0 (^D10)		;DEC
	ZA DEFIN0		;DEFINE

	ZAL DEPHA0		;DEPHASE
	ZAL END0		;END
	ZA INTER0 (INTF!ENTF)	;ENTRY
	Z EXPRES		;EXP
	ZA EXTER0		;EXTERN
	JRST 4,OP		;HALT
	TLNN FR,IFPASS		;IF1
	TLNE FR,IFPASS		;IF2

	TRNE AC0,IFB0		;IFB
	TLNE ARG,IFDEF0		;IFDEF
	Z IFIDN0 (0)		;IFDIF
	SKIPE IF		;IFE
	SKIPG IF		;IFG
	SKIPGE IF		;IFGE
	Z IFIDN0 (1)		;IFIDN
	SKIPL IF		;IFL

	SKIPLE IF		;IFLE
	SKIPN IF		;IFN
	TRNN AC0,IFB0		;IFNB
	TLNN ARG,IFDEF0		;IFNDEF
	ZA INTER0 (INTF)	;INTERN
	Z IOWD0			;IOWD
	Z IRP0 (0)		;IRP
	Z IRP0 (400000)		;IRPC

	JFCL 6,OP		;JCRY
	JFCL 4,OP		;JCRY0
	JFCL 2,OP		;JCRY1
	JRST 12,OP		;JEN
	JFCL 10,OP		;JOV
	JRST 2,OP		;JRSTF
	ZA IOLSET (IOPALL!IOSALL) ;[1065] LALL
	ZA IORSET (IOPROG)	;[1065] LIST
	ZAL LIT0		;LIT
	ZAL %ORG (0)		;LOC
	ZA OFFSYM		;NOSYM
	Z OCT0 (^D8)		;OCT
	ZA OPDEF0		;OPDEF
	JFCL 1,OP		;JFOV
	ZA ONML			;MLON
	ZA OFFML		;MLOFF
	Z ASCII0 (3B19)		;COMMENT
	ZAL %ARAY		;ARRAY
	ZAL %INTEG		;INTEGER
   IFN IIISW,<
	Z ASCII0 (5B20)>	;ASCID
   IFN UUOSYM,<
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
CALNTH==.-CALTBL
NEGCAL==CALLI0-CALTBL		;NUMBER OF NEGATIVE CALLI'S
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

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
   >			;END UUOSYM
	SUBTTL USER-DEFINED SYMBOL SEARCH ROUTINES

;SEARCH FOR OPERATOR DEFINITION (MACRO, SYN, OPDEF)

MSRCH:	CALL SEARCH		;PERFORM GENERAL SEARCH
	  RET			;NOT FOUND, EXIT
	JUMPG ARG,MSRCH2	;SKIP-EXIT AND CROSS-REF IF FOUND
	CAME AC0,1(SX)		;WE ARE LOOKING AT SYMBOL, TRY ONE ABOVE
	RET			;NO, EXIT
	ADDI SX,2		;YES, POINT TO IT
	SETZM EXTPNT		;RESET EXTERNAL POINTER WORD
	CALL SRCH5		;LOAD REGISTERS
MSRCH2:	AOSA 0(P)		;SET SKIP-EXIT
QSRCH:	JUMPL ARG,SSRCH3	;BRANCH IF OPERAND
	TLC ARG,SIXF		;DO WE HAVE A SIXF?
	TLCN ARG,SIXF
	CALL SYNFIX		;YES, GO TAKE CARE OF IT FIRST
QSRCH1:	MOVEI SDEL,%MAC		;SET OPERATOR FLAG
	TLZE IO,DEFCRS		;IS IT A DEFINITION?
	MOVEI SDEL,%DMAC	;YES
	JRST CREF		;CROSS-REF AND EXIT

;HERE IF WE HAVE A SYN AND ITS VALUE IS A POINTER TO A SIXBIT OPERATOR NAME
SYNFIX:	PUSH P,AC0		;SAVE CURRENT SYMBOL
	PUSH P,IO		;[1152] SAVE CURRENT SYN BITS
	TLZ IO,DEFCRS		;[1152] THIS IS NOT A DEFINITION
	MOVE AC0,(ARG)		;AND GET SIXBIT SYMBOL NAME
	PUSH P,ARG		;SAVE SIXBIT POINTER
	CALL OPTSCH		;GET ITS VALUE
	  JRST [TRO ER,ERRA	;GIVE A-ERROR
		JRST SYNFI1]
	POP P,ARG		;RESTORE POINTER
	SKIPE UWVER		;WRITING A UNV FILE?
	JRST SYNFI1		;YES, JUMP, DON'T UPDATE SYMBOL TABLE
	MOVEM V,(ARG)		;NO, REPLACE SIXBIT WITH OPERATOR VALUE
	MOVSI ARG,SYNF+PNTF	;SET FLAGS
	HLLM ARG,(SX)		;UPDATE IN SYMBOL TABLE
SYNFI1:	POP P,AC0		;[1152] RETRIEVE SYN BITS
	TLNE AC0,DEFCRS		;[1152] IS THIS A DEFINITION?
	TLO IO,DEFCRS		;[1152] YES - TURN BIT BACK ON
	POP P,AC0		;[1152] RESTORE SYMBOL NAME
	RET
;SEARCH FOR SYMBOL DEFINITION

SSRCH:	CALL SEARCH		;PERFORM GENERAL SEARCH
	RET			;NOT FOUND, EXIT
	JUMPL ARG,SSRCH2	;SKIP-EXIT AND CROSS-REF IF FOUND
SSRCH1:	CAME AC0,-3(SX)		;WE ARE LOOKING AT MACRO, LOOK ONE SLOT BELOW
	RET			;NO DICE, EXIT
	SUBI SX,2		;YES, POINT TO IT
	SETZM EXTPNT		;RESET EXTERNAL POINTERS WORD
	CALL SRCH5		;LOAD REGISTERS
SSRCH2:	AOS 0(P)		;SET FOR SKIP-EXIT
SSRCH3:	MOVEI SDEL,%SYM		;SET OPERAND FLAG

CREF:	TLNE ARG,NCRF		;.XCREF SEEN?
	JRST [TLZ IO,DEFCRS	;CLEAR DEFINITION FLAG
		RET]		;AND DON'T CREF
	TLNN IO,IONCRF		;NO CREFFING FOR THIS SYMBOL?
	TLNE FR,P1!CREFSW	;PASS ONE OR CROSS-REF SUPPRESSION?
	RET			;YES, EXIT
	EXCH SDEL,C		;PUT FLAG IN C, SACE C
	PUSH P,CS
	TLNE IO,IOCREF		;HAVE WE PUT OUT THE 177,102
	JRST CREF3		;YES
	PUSH P,C		;START OF CREF DATA
REPEAT 0,<			;NEEDS CHANGE TO CREF
	MOVEI C,177
	CALL OUTLST
	MOVEI C,102
	CALL OUTLST
	TLO IO,IOCREF		;WE NOW ARE IN THAT STATE
	POP P,C			;WE HAVE NOW
CREF3:	JUMPE C,NOFLG		;JUST CLOSE IT
	CALL OUTLST		;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)
	MOVSI CS,770000		;COUNT CHRS
	TDZA C,C		;STARTING AT 0
	LSH CS,-6		;TRY NEXT
	TDNE AC0,CS		;IS THAT ONE THERE?
	AOJA  C,.-2		;YES
	CALL OUTLST		;PRINT NUMBER OF SYMBOL CONSTITUENTS
	MOVE CS,AC0

CREF2:	MOVEI C,0
	LSHC C,6
	ADDI C,40
	CALL OUTLST		;THE ASCII SYMBOL
	JUMPN CS,CREF2
	MOVEI C,%DSYM
	TLZE IO,DEFCRS
	CALL OUTLST		;MARK IT AS A DEFINING OCCURENCE
NOFLG:	MOVE C,SDEL
	POP P,CS
	RET

CLSCRF:	TRNN ER,LPTSW
	RET			;LEAVE IF WE SHOULD NOT BE PRINTING
CLSCR2:	MOVEI C,177
	CALL PRINT
	TLZE IO,IOCREF		;WAS IT OPEN?
	JRST CLSCR1		;YES, JUST CLOSE IT
	MOVEI C,102		;NO, OPEN IT FIRST
	CALL OUTLST		;MARK BEGINNING OF CREF DATA
	MOVEI C,177
	CALL OUTLST
CLSCR1:	MOVEI C,103
	JRST OUTLST		;MARK END OF CREF DATA

CLSC3:	TLZ IO,IOCREF
	MOVEI C,177
	CALL OUTLST
	MOVEI C,104
	JRST OUTLST		;177,104 CLOSES IT FOR NOW
   >				;END OF REPEAT 0
REPEAT 1,<			;WORKS WITH EXISTING CREF
	TLNE IO,IOPAGE
	CALL CRFHDR		;GET CORRECT SUBTTL
	MOVEI C,177
	CALL OUTLST
	MOVEI C,102
	CALL OUTLST
	TLO IO,IOCREF		;WE NOW ARE IN THAT STATE
	POP P,C			;WE HAVE NOW
CREF3:	CALL OUTLST		;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)
	MOVSI CS,770000		;COUNT CHRS
	TDZA C,C		;STARTING AT 0
	LSH CS,-6		;TRY NEXT
	TDNE AC0,CS		;IS THAT ONE THERE?
	AOJA C,.-2		;YES
	CALL OUTLST		;PRINT NUMBER OF SYMBOL CONSTITUENTS
	MOVE CS,AC0

CREF2:	MOVEI C,0
	LSHC C,6
	ADDI C,40
	CALL OUTLST		;THE ASCII SYMBOL
	JUMPN CS,CREF2
	MOVEI C,%DSYM
	TLZE IO,DEFCRS
	CALL OUTLST		;MARK IT AS A DEFINING OCCURENCE
	MOVE C,SDEL
	POP P,CS
	RET

   IFN OPHSH,<
SUBTL:	SIXBIT /SUBTTL/>
CRFHDR:	CAME AC0,SUBTL		;IS FIRST SYMBOL "SUBTTL"
	JRST CRFHD1		;NO
	HLLZ AC0,V
	CALL SUBTT0		;UPDATE SUBTTL
	MOVE AC0,SUBTL		;RESTORE ARG.
	MOVEI V,CPOPJ
CRFHD1:	MOVEI C,0
	JRST OUTL

CLSC3:
CLSCRF:	TRNN ER,LPTSW
	RET			;LEAVE IF WE SHOULD NOT BE PRINTING
CLSCR2:	TLZE  IO,IOCREF		;FINISH UP LINE
	JRST CLSCR1
	MOVEI C,0
	TLNE IO,IOPAGE		;NEW PAGE?
	CALL OUTL		;YES,GIVE IT A ROUSING SENDOFF!
	MOVEI C,177
	CALL OUTLST
	MOVEI C,102
	CALL OUTLST		;MARK BEGINNING OF CREF DATA
CLSCR1:	TRNN ER,ERRORS		;ANY ERRORS TO CREF
	JRST CLSCR6		;NO, JUST CLOSE OUT
	MOVE C,[POINT 6,[SIXBIT /QXADLRUVNOPEMS/]]
	PUSH P,ER		;SAVE 
	ANDI ER,ERRORS		;ONLY LOOK AT THESE
	HRLZ ER,ER		;PUT FLAGS IN LEFT HALF
CLSCR4:	ILDB CS,C		;GET NEXT ERROR CODE
	LSH ER,1		;SHIFT FLAG IN
	JUMPE ER,CLSCR5		;FINISHED
	JUMPG ER,CLSCR4		;NOT YET
	PUSH P,C		;SAVE BYTE POINTER
	TDO CS,['%.... ']	;MAGIC SYMBOL
	MOVEI C,%ERR		;TYPE
	CALL OUTLST
	MOVEI C,6		;NO OF CHARS.
	CALL OUTLST
	SETZ C,			;CLEAR RECEIVING ACC
	LSHC C,6		;SHIFT IN CHAR
	ADDI C,40		;TO ASCII
	CALL OUTLST
	JUMPN CS,.-4		;MORE TO DO
	POP P,C			;BYTE POINTER BACK
	JUMPN ER,CLSCR4		;GET NEXT
CLSCR5:	POP P,ER		;RESTORE ER
CLSCR6:	MOVEI C,177
	CALL OUTLST
	MOVEI C,103
	JRST OUTLST		;MARK END OF CREF DATA
   >				;END OF REPEAT 1

RCPNTR:	POINT 1,ARG,^L<RELF>-18	;POINT 1,ARG,22
SEARCH:	CALL SRCHI		;SET UP SRCHX
   IFN FTPSECT,<		;[575]
	TLZ IO,RSASSW		;CLR INTER-PSECT REF SWITCH
	HRRZ AC1,SGNCUR		;GET CUR PSECT INX
	MOVEM AC1,SGWFND	;SET PSECT WHERE FOUND
  >				;END IFN FTPSECT
	CALL SRCH		;SEARCH CURRENT PSECT
   IFE FTPSECT,<
	  JRST SRCHU		;SEE IF THERE ARE UNIVERSALS TO SEARCH
	JRST SRCH4S		;COMMON SUCCESSFUL EXIT
   >
   IFN FTPSECT,<
	  JRST [SKIPN SGSRCH	;[1070] SEARCHING ONLY CURRENT PSECT?
		JRST SRCHSG	;[1070] NO -TRY OTHERS
		CALL SRCHI	;[1070] YES - RESET SRCHX
		JRST SRCHU]	;[1070] AND CHECK UNIVERSALS
	JRST SRCH4S		;COMMON SUCCESSFUL EX

SRCHSG:	PUSH P,V		;SAVE V
	PUSH P,SX		;SAVE SX VALUE
	PUSH P,SGNCUR		;SAVE SGNCUR
	PUSH P,SGNMAX		;INIT PSECT INX
SRCHSL:	MOVE V,0(P)		;GET PSECT INX
	CAMN V,-1(P)		;DON'T SEARCH CURRENT
	JRST SRCHSC		;PSECT AGAIN
	MOVEM V,SGNCUR		;FUDGE CUR PSECT
	CALL SRCHI		;SET UP SRCHX
	CALL SRCH		;SEARCH THIS PSECT
	  JRST SRCHSC		;NOT HERE EITHER
	MOVE AC1,SGNCUR		;GET RELEVANT PSECT INX
	MOVEM AC1,SGWFND	;SET PSECT WHERE FOUND
	SKIPGE -1(P)		;WANT TO EVALUATE IN THIS PSECT?
	JRST SRCH4		;YES, JUST EXIT
	MOVE ARG,0(SX)		;GET FLAGS
	TLNE ARG,EXTF		;[1116] EXTERNAL?
	JRST SRCHEX		;[1116] YES - STORE IN REQUESTING PSECT
	TLNE ARG,SPTR		;[1116] SPECIAL POINTER TO EXTERNAL?
	JRST SRCHSP		;[1116] YES - CHECK FOR INTER-PSECT EXTERNAL
	TLNE ARG,LELF!RELF	;IF RELOCATABLE THEN
	TLO IO,RSASSW		;SET INTER-PSECT REF SWITCH
	JRST SRCH4		;COMMON SUCCESSFUL EXIT

SRCHEX:	POP P,AC1		;INDEX
	POP P,SGNCUR		;RESTORE
	POP P,SX		;WHERE IT SHOULD BE
	POP P,V
	MOVEI SDEL,2		;NEEDS 2 WORDS
	ADDB SDEL,FREE
	CAML SDEL,SYMBOL	;WILL IT FIT?
	CALL XCEEDS		;NO
	SETZM -2(SDEL)		;VALUE
	MOVEM AC0,-1(SDEL)	;NAME
	MOVEI V,-2(SDEL)	;POINTER
	HLLZ ARG,ARG		;KEEP FLAGS BUT NOT POINTER
	CALL INSERT		;PUT IT IN
	JRST SEARCH		;TRY AGAIN

;[1116] A SYMBOL REFERENCED IN THE CURRENT PSECT IS DEFINED IN ANOTHER
;[1116] PSECT AS A SPECIAL EXTERNAL POINTER (I.E. FOO=BAR##). IF THE SYMBOL
;[1116] WILL NOT GO POLISH, THEN BOTH IT AND THE EXTERNAL IT POINTS TO MUST
;[1116] BE COPIED INTO THE CURRENT PSECT TO KEEP THE EXTERNAL CHAIN FROM
;[1116] CROSSING PSECTS
SRCHSP:	SKIPL 1(ARG)		;[1116] POINTER TO POLISH DEFINITION?
	SKIPE (ARG)		;[1116] OR EXT+N WHICH WILL GO POLISH
	JRST SRCH4		;[1116] YES - NO NEED TO COPY SYMBOLS
	POP P,AC1		;[1116] DISCARD INDEX
	POP P,SGNCUR		;[1116] NEED PSECT INDEX
	POP P,AC1		;[1116] DISCARD SYMBOL TABLE PTR.
	POP P,AC1		;[1116] AND VALUE
	PUSH P,AC0		;[1116] SAVE SYMBOL
	PUSH P,(ARG)		;[1116] SAVE VALUE ( SHOULD BE 0)
	PUSH P,ARG		;[1116] AND SYMBOL FLAGS
	HRRZ AC1,1(ARG)		;[1116] GET POINTER TO EXTERNAL BLOCK
	MOVE AC0,1(AC1)		;[1116] GET EXTERNAL SYMBOL NAME
	CALL SEARCH		;[1116] FIND EXTERNAL IN SOME OTHER PSECT
	  JFCL			;[1116]  AND PUT IN CURRENT PSECT (CAN'T FAIL)
	HRRZ RC,ARG		;[1116] USE EXTERNAL POINTER AS RELOCATION
	POP P,ARG		;[1116] RESTORE SYMBOL FLAGS
	POP P,V			;[1116] SYMBOL VALUE
	POP P,AC0		;[1116] AND SYMBOL NAME
	CALL SRCHI		;[1116] SETUP FOR INSERT
	CALL SRCH		;[1116] FIND PLACE WHERE SYMBOL GOES
	  JFCL			;[1116] CANNOT FAIL
	CALL INSERT		;[1116] ADD SYMBOL TO CURRENT PSECT
	MOVE AC1,SGNCUR		;[1116] GET CURRENT INDEX
	MOVEM AC1,SGWFND	;[1116] AND SAVE AS PSECT WHERE FOUND
	JRST SRCH4S		;[1116] COMMON SUCCESSFUL EXIT

SRCHSC:	SOS V,0(P)		;BUMP PSECT INX
	JUMPGE V,SRCHSL		;LOOP IF MORE PSECTS
	POP P,AC1		;THROW AWAY PSECT INX
	POP P,SGNCUR		;RESTORE SGNCUR
	CALL SRCHI		;RESET SRCHX
	POP P,SX		;RESTORE SX VALUE
	POP P,V			;RESTORE V
   >
SRCHU:	TRNN FRR,NOUNVS		;[713] WANT TO SEARCH UNVS?
	SKIPN UNISCH+1		;ARE THERE ANY?
	RET			;NO, JUST RETURN
	HRLM SX,UNISCH		;SAVE SX AND SET FLAG
	MOVE ARG,SRCHX		;SEARCH POINTER
	MOVEM ARG,UNISHX	;TO A SAFE PLACE
   IFE FTPSECT,<		;[575]
	HRR ARG,SYMBOL
	HRL ARG,SYMTOP
   >				;END IFE FTPSECT
   IFN FTPSECT,<		;[575]
	HRR ARG,SGSBOT
	HRL ARG,SGSTOP
   >				;END IFN FTPSECT
	MOVEM ARG,UNIPTR	;STORE ALSO
SRCHUL:	AOS V,UNISCH		;GET NEXT INDEX TO TABLE
	MOVE V,UNISCH(V)	;GET TRUE INDEX
	JUMPE V,SRCHKO		;IF ZERO ALL TABLE SCANNED
	MOVE ARG,UNISHX(V)	;NEW SRCHX
	MOVEM ARG,SRCHX		;SET IT UP
	MOVE ARG,UNIPTR(V)	;SGSTOP,,SGSBOT
   IFE FTPSECT,<		;[575]
	HRRZM ARG,SYMBOL
	HLRZM ARG,SYMTOP
   >				;END IFE FTPSECT
   IFN FTPSECT,<		;[575]
	HRRZM ARG,SGSBOT
	HLRZM ARG,SGSTOP
   >				;END IFN FTPSECT
	CALL SRCH		;SEARCH UNIV SYM TAB
	  JRST SRCHUL		;NOPE, TRY NEXT ONE
   IFN FTPSECT,<
	JRST SRCH4S		;COMMON SUCCESSFUL EXIT

SRCH4:	POP P,AC1		;THROW AWAY PSECT INX
	POP P,SGNCUR		;RESTORE SGNCUR
	POP P,AC1		;THROW AWAY SX VALUE
	POP P,AC1		;THROW AWAY V
   >
SRCH4S:	AOS 0(P)		;SET FOR SKIP EXIT
SRCH5:	MOVSI ARG,SUPRBT	;HE IS USING IT, TURN OFF BIT
	ANDCAM ARG,(SX)		;IN THE TABLE
SRCH7:	MOVE ARG,0(SX)		;FLAG AND VALUE TO ARG
	SKIPE UNISCH		;[653] FOUND IN UNV?
	JRST [	TLC ARG,SYNF!PNTF ;[653] YES, CHECK FOR SYN FIXUP
		TLCE ARG,SYNF!PNTF ;[653]
		JRST .+1	;[653]
		TLNE ARG,VARF	;[653] YES, OLD STYLE UNV FILE?
		JRST .+1	;[653]
		MOVE AC0,UNITBL(V) ;[653]
		JRST VERSKW]	;[653] YES, REASSEMBL UNV
	LDB RC,RCPNTR		;POINT 1,ARG,17
	TLNE ARG,LELF		;CHECK LEFT RELOCATE
	TLO RC,1
	HRRZ V,ARG
	TLNE ARG,SPTR		;CHECK SPECIAL EXTESN POINTER
	JRST SRCH6
	TLNE ARG,PNTF
	MOVE V,0(ARG)		;36BIT VALUE TO V
	JRST SRCHOK

SRCH6:	MOVE V,0(ARG)		;VALUE
	MOVE RC,1(ARG)		;AND RELOC
	JUMPL RC,SRCHOK		;[773] JUMP IF POLISH
	TLNE RC,-2		;CHECK AND SET EXTPNT
	HLLM RC,EXTPNT
	TRNE RC,-2
	HRRM RC,EXTPNT
	JRST SRCHOK
SRCHKO:	SETZ ARG,		;CLEAR ARG SO ZERO STORED
SRCHOK:	SKIPN UNISCH		;HAVE WE SEARCH OTHER TABLES
	RET			;NO, JUST RETURN
SYMBCK:	HLRZ SX,UNISCH		;RESTORE SX
	SETZM UNISCH		;CLEAR SYMBCK FLAG
	MOVE SDEL,UNISHX	;SRCHX
	MOVEM SDEL,SRCHX	;RESTORE ORIGINAL
   IFE FTPSECT,<		;[575]
	MOVE SDEL,UNIPTR	;SYMTOP,,SYMBOL
	HRRZM SDEL,SYMBOL
	HLRZM SDEL,SYMTOP
	JUMPE ARG,CPOPJ		;TOTALLY UNDEFINED
   >
   IFN FTPSECT,<		;[575]
	MOVE SDEL,UNIPTR	;SGSTOP,,SGSBOT
	HRRZM SDEL,SGSBOT
	HLRZM SDEL,SGSTOP
	JUMPE ARG,CPOPJ		;TOTALLY UNDEFINED
	PUSH P,SGNCUR		;SAVE CUR PSECT
	SETZM SGNCUR		;SET TO BLANK PSECT
	SETZM SGWFND		;SET PSECT WHERE FOUND
	CALL SRCHI		;SET UP SRCHX
	CALL SRCH		;SET UP SX
	  JFCL
   >
	TLNE ARG,SPTR		;SPECIAL EXTERNAL?
	JRST SYMBKS		;YES
	TLNE ARG,EXTF		;EXTERNAL?
	JRST SYMBKX		;YES, NEED 2 MORE CELLS
	TLNN ARG,PNTF		;36 BIT VALUE FLAG SET?
	JRST .+3		;NO, PUT IN TABLE AND RETURN
	TLNN V,-1		;BUT IS IT ONLY 18 BIT VALUE?
	TLZ ARG,PNTF		;YES, SO ONLY USE 18 BITS
   IFE FTPSECT,<		;[575]
	JRST INSERT
	SYN CPOPJ,SYMBKR
   >
   IFN FTPSECT,<		;[575]
	CALL INSERT		;STILL HAVE 0 PSECT
SYMBKR:	POP P,SGNCUR		;RESTORE CUR PSECT
	RET
   >
SYMBKX:	PUSH P,[EXP SYMBKR]	;RETURN ADDRESS
	PUSH P,1(ARG)		;SAVE SIXBIT NAME
	MOVSI ARG,SYMF!EXTF!PNTF ;SET ONLY THE REQUIRED FLAGS
				;PUT 2 WORDS IN CORE
SYMBKY:	CALL INSERZ		;INSERT SYMBOL IN TABLE
	MOVEI SDEL,2		;GET 2 CELLS FROM FREE CORE
	ADDB SDEL,FREE
	CAML SDEL,SYMBOL	;MORE CORE NEEDED?
	CALL XCEEDS		;YES
	HRRI ARG,-2(SDEL)	;POINTER TO VALUE
	SETZM (ARG)		;AND CLEAR IT
	POP P,1(ARG)		;STORE SIXBIT VALUE
	MOVEM ARG,(SX)		;SET FLAGS AND VALUE AS IT SHOULD BE
	RET			;RETURN

SYMBKS:	PUSH P,V		;SAVE ADDITIVE VALUE
	PUSH P,[Z SYMBKZ]	;SET UP RETURN ADDRESS FOR PJRST
	PUSH P,ARG		;SAVE SYMBOL'S FLAGS
	TRO FRR,NOUNVS		;[713] DON'T SEARCH UNIVERSALS
	PUSH P,AC0		;SAVE SYMBOL WE REALLY WANT
	MOVE ARG,1(ARG)		;GET POINTER TO DEFINING SYMBOL
   IFN POLISH,<
	JUMPL ARG,SYMBKP	;JUMP IF POLISH
   >
	MOVE AC0,1(ARG)		;AND FINALLY SYMBOL
	CALL SEARCH		;SEE IF DEFINING GLOBAL IS IN TABLE
	  CALL [PUSH P,1(ARG)	;SAVE SIXBIT NAME
		MOVSI ARG,SYMF!EXTF!PNTF ;SET ONLY THE REQUIRED FLAGS
		JRST SYMBKY]	;NO, PUT IN SYMBOL TABLE
SYMBS1:	POP P,AC0		;GET SYMBOL BACK
	CALL SEARCH		;SETUP SX AGAIN
	  JFCL			;WILL ALWAYS FAIL
	TRZ FRR,NOUNVS		;[713] SEARCH UNIVERSALS AGAIN
	HLL ARG,0(P)		;RECOVER FLAGS
	HRRZM ARG,0(P)		;STACK POINTER TO GLOBAL
	JRST SYMBKY		;AND DO DUMMY PUSHJ
SYMBKZ:				;FAKE RETURN ADDRESS
	POP P,V			;GET OFFSET
	MOVEM V,0(ARG)		;STORE OFFSET
	JRST SYMBKR		;RETURN
   IFN POLISH,<
;HERE IF POLISH
SYMBKP:	PUSH P,ARG
	PUSH P,SDEL		;SAVE SDEL
	PUSH P,[-1]		;END OF LOWER LEVEL POLISH TO BE CHECKED
SYMBP4:	MOVE AC1,1(ARG)		;GET THE OPERATOR
	MOVE SDEL,DESTB-3(AC1)	;AND NUMBER OF OPERANDS
SYMBP0:	ADDI ARG,2		;GET 1ST OPERAND
	HRRZM ARG,UNVNPL	;REMEMBER CURRENT ADDRESS
	MOVE AC0,(ARG)		;GET 1ST WORD OF THE PAIR
	JUMPE AC0,SYMBP1	;IF 1ST WORD IS 0, GO ONTO NEXT PAIR
	JUMPL AC0,[PUSH P,AC0	;1ST WORD IS POLISH
		JRST SYMBP1]	;STORE LOWER LEVEL POLISH PTR ON STACK
	MOVE ARG,AC0
	MOVE AC0,1(ARG)		;GET SIXBIT SYMBOL
	PUSH P,SDEL		;SAVE NUMBER OF OPERANDS LEFT
	CALL SEARCH
	   CALL [PUSH P,1(ARG)		;NOT FOUND, GO INSERT IT
		TLO ARG,SYMF!EXTF!PNTF
		JRST SYMBKY]
	POP P,SDEL		;RESTORE NUMBER OF OPERANDS LEFT
SYMBP1:	MOVE ARG,UNVNPL	;GET CURRENT LOCATION
	SOJG SDEL,SYMBP0	;ANY MORE OPERANDS? IF YES, GO BACK
	POP P,ARG		;NO, ANY LOWER LEVEL POLISH?
	CAMN ARG,[-1]		;END?
	JRST SYMBP3		;YES,
	JRST SYMBP4

SYMBP3:	POP P,SDEL		;RESTORE ORIGINAL SDEL
	POP P,ARG		;RECOVER ORIGINAL ARG
	POP P,AC0		;AND SYMBOL
	CALL SEARCH		;SET UP SX AGAIN
	  JFCL			;WILL ALWAYS FAIL
	TRZ FRR,NOUNVS		;[713] SEARCH UNIVERSALS AGAIN
	MOVEM ARG,0(P)		;STACK POINTER TO POLISH
	SETZ ARG,
	TLO ARG,SPTR!SYMF	;SET ONLY THE REQUIRED FLAGS
	JRST SYMBKY		;GO INSERT

   >
SRCH:	HLRZ SX,SRCHX
	HRRZ SDEL,SRCHX
SRCH1:	CAML AC0,-1(SX)
	JRST SRCH3
SRCH2:	SUB SX,SDEL
	LSH SDEL,-1
   IFE FTPSECT,<		;[575]
	CAMG SX,SYMTOP
   >				;[575]
   IFN FTPSECT,<		;[575]
	CAMG SX,SGSTOP
   >				;[575]
	JUMPN SDEL,SRCH1
	JUMPN SDEL,SRCH2
	SOJA SX,CPOPJ		;NOT FOUND
SRCH3:	CAMN AC0,-1(SX)
	JRST CPOPJ1		;NORMAL / FOUND EXIT
	ADD SX,SDEL
	LSH SDEL,-1
   IFE FTPSECT,<		;[575]
	CAMG SX,SYMTOP
   >				;[575]
   IFN FTPSECT,<		;[575]
	CAMG SX,SGSTOP
   >				;[575]
	JUMPN SDEL,SRCH1
	JUMPN SDEL,SRCH2
	SOJA SX,CPOPJ		;NOT FOUND
INSERQ:	TLNE ARG,UNDF!VARF
INSERZ:	SETZB RC,V
INSERT:	CAME AC0,-1(SX)		;ARE WE LOOKING AT MATCHING MNEMONIC?
	JRST INSRT2		;NO, JUST INSERT
	JUMPL ARG,INSRT1	;YES, BRANCH IF OPERAND
	SKIPL 0(SX)		;OPERATOR, ARE WE LOOKING AT ONE?
	JRST UPDATE		;YES, UPDATE
	JRST INSRT2		;NO, INSERT

INSRT1:	SKIPG 0(SX)		;OPERAND, ARE WE LOOKING AT ONE?
	JRST UPDATE		;YES, UPDATE
	SUBI SX,2		;NO, MOVE UNDER OPERATOR AND INSERT
INSRT2:	MOVE SDEL,SYMBOL
	SUBI SDEL,2
	CAMLE SDEL,FREE
	JRST INSRT3
	CALL XCEEDS
	ADDI SDEL,2000
INSRT3:	MOVEM SDEL,SYMBOL	;MAKE ROOM FOR A TWO WORD ENTRY
	HRLI SDEL,2(SDEL)
	BLT SDEL,-2(SX)		;PUSH EVERYONE DOWN TWO LOACTIONS
   IFN FTPSECT,<		;[575]
	MOVE AC1,SGNCUR		;CURRENT PSECT INDEX
	AOS SGSCNT(AC1)		;INCREMENT PSECT SYM COUNT
   >
	AOS @SYMBOL		;INCREMENT THE SYMBOL COUNT
	TDNE RC,[-2,,-2]	;SPECIAL LEFT OR RIGHT EXTERNAL?
	JRST INSRT5		;YES, JUMP
	TLNN V,-1		;SKIP IF V IS A 36BIT VALUE
	JRST INSRT4		;JUMP, ITS A 18BIT VALUE
	AOS SDEL,FREE		;36BIT, SO GET A CELL FROM FREE CORE
	CAML SDEL,SYMBOL	;MORE CORE NEEDED?
	CALL XCEEDS		;YES
	HRRI ARG,-1(SDEL)	;POINTER TO ARG
	MOVEM V,0(ARG)		;36BIT VALUE TO FREE CORE
	TLO ARG,PNTF		;NOTE THAT ARG IS A POINTER, NOT A 18BIT VALUE
	JRST INSRT7		;STORE SYMBOL

INSRT4:	HRR ARG,V		;18 BIT VALUE ARG
	TLNN ARG,EXTF		;POSSIBLE TO BE EXT WITH 0 RELOC SO DON'T
	TLZ ARG,PNTF		;CLEAR POINTER FLAG IN CASE SET
INSRT7:	DPB RC,RCPNTR		;FIX RIGHT RELOCATION
	TLNE RC,1
	TLO ARG,LELF		;FIX LEFT RELOCATION
INSRT6:	MOVEM ARG,0(SX)		;INSERT FLAGS AND VALUE.
	MOVEM AC0,-1(SX)	;INSERT SYMBOL NAME.
	CALL SRCHI		;INITILIAZE SRCHX
	JRST QSRCH		;EXIT THROUGH CREF

INSRT5:	MOVEI SDEL,2		;GET TWO CELLS FROM FREE CORE
	ADDB SDEL,FREE
	CAML SDEL,SYMBOL	;MORE CORE NEEDED?
	CALL XCEEDS		;YES
	MOVEM RC,-1(SDEL)
	HRRI ARG,-2(SDEL)	;POINTER TO ARG
	MOVEM V,0(ARG)
	TLO ARG,SPTR		;SET SPECIAL POINTER, POINTS TO TWO CELLS
	JRST INSRT6
REMOVE:
   IFN FTPSECT,<		;[575]
	MOVEI AC2,0(SX)		;ADDRESS OF THE SYMBOL
	SUB AC2,SYMBOL		;- BASE OF SYMBOL TABLE
	LSH AC2,-1		;/ 2 = SYMBOL ORDINAL
	TDZA AC1,AC1		;INIT PSECT INDEX
	ADDI AC1,1		;INCREMENT PSECT INDEX
	HRRZ AC0,SGSCNT(AC1)	;WITHIN THIS PSECT?
	SUB AC2,AC0
	JUMPG AC2,.-3		;TRY NEXT PSECT IF NOT
	SOS SGSCNT(AC1)		;DECREMENT PSECT SYM COUNT
   >
	SUBI SX,2		;MOVE EVERYONE UP TWO LOCATIONS
REMOV1:	MOVE 0(SX)
	MOVEM 2(SX)		;OVERWRITE THE DELETED SYMBOL
	CAME SX,SYMBOL		;SKIP WHEN DONE
	SOJA SX,REMOV1
	ADDI SX,2
	MOVEM SX,SYMBOL
	SOS 0(SX)		;DECREMENT THE SYMBOL COUNT

SRCHI:	MOVEI AC2,0		;THIS CODE SETS UP SRCHX
   IFE FTPSECT,<		;[575]
	FAD AC2,@SYMBOL
   >
   IFN FTPSECT,<		;[575]
	HRRZ AC1,SGNCUR
	HRRZ AC1,SGSCNT(AC1)
	FAD AC2,AC1
   >
	LSH AC2,-^D27
	MOVEI AC1,1000
	LSH AC1,-357(AC2)
	HRRM AC1,SRCHX
	LSH AC1,1
   IFE FTPSECT,<		;[575]
	ADD AC1,SYMBOL
	HRLM AC1,SRCHX
   >
   IFN FTPSECT,<		;[575]
	HRLM AC1,SRCHX
	MOVE AC1,SYMBOL
	MOVEM AC1,SGSBOT
	HRRZ AC2,SGNCUR
	JUMPE AC2,SRCHI2
SRCHI1:	HRRZ AC1,SGSCNT-1(AC2)
	LSH AC1,1
	ADDB AC1,SGSBOT
	SOJG AC2,SRCHI1
SRCHI2:	MOVS AC2,AC1
	ADDM AC2,SRCHX
	MOVE AC2,SGNCUR
SRCHI3:	HRRZ AC1,SGSCNT(AC2)
	LSH AC1,1
	ADD AC1,SGSBOT
	MOVEM AC1,SGSTOP
   >
	RET			;SRCHX=XWD <SYMTBL+LENGTH/2>,LENGTH/4
UPDATE:				;[745] TEST SPTR BEFORE DOING R-RELOC
	TLNE ARG,SPTR		;SKIP IF THERE IS NO SPECIAL POINTER
	JRST UPDAT4		;YES, USE THE TWO CELLS
   IFN POLISH,<			;[1101]
	SKIPL RC		;[1101] SKIP FIXUP IF POLISH
   >				;[1101]
	TDNE RC,[-2,,-2]	;NEED TO CHANGE ANY CURRENT EXTERNS
	JRST UPDAT5		;YES ,JUMP
	DPB RC,RCPNTR		;[1116][745] FIX RIGHT RELOCATION
	TLZ ARG,LELF		;CLEAR LELF
	TLNE RC,1		;LEFT RELOCATABLE?
	TLO ARG,LELF		;YES, SET THE FLAG
	TLNE ARG,PNTF		;WAS THERE A 36BIT VALUE?
	JRST UPDAT2		;YES, USE IT.
	TLNE V,-1		;NO,IS THERE A 36BIT VALUE?
	JRST UPDAT1		;YES, GET A CELL
	HRR ARG,V		;NO, USE RH OF ARG
UPDAT3:	MOVEM ARG,0(SX)		;OVERWRITE THE ONE IN THE TABLE
   IFE FTPSECT,<		;[575]
	RET			;AND EXIT
   >
   IFN FTPSECT,<		;[575]
	JRST UPDAT6		;AND EXIT
   >

UPDAT1:	AOS SDEL,FREE		;GET ONE CELL
	CAML SDEL,SYMBOL	;NEED MORE CORE?
	CALL XCEEDS		;YES
	HRRI ARG,-1(SDEL)	;POINTER TO ARG
	TLO ARG,PNTF		;AND NOTE IT.
UPDAT2:	TLNE ARG,EXTF		;IS THERE A EXTERNAL?
	JRST UPDAT3		;YES, - JUST SAVE A LOCATION
	MOVEM ARG,0(SX)		;NO, OVERWRITE THE POINTER IN THE TABLE
	MOVEM V,0(ARG)		;STORE VALUE AS A 36BIT VALUE
   IFE FTPSECT,<		;[575]
	RET			;AND EXIT
   >
   IFN FTPSECT,<		;[575]
	JRST UPDAT6		;AND EXIT
   >

UPDAT4:	MOVEM ARG,0(SX)		;WE HAVE TWO CELLS, WE USE THEM
	MOVEM V,0(ARG)		;SAVE AS 36BIT VALUE
	MOVEM RC,1(ARG)		;SAVE RELOCATION BITS
	RET			;AND EXIT

UPDAT5:	MOVEI SDEL,2		;THERE IS A EXTERNAL
	ADDB SDEL,FREE		;SO WE NEED TWO LOACTIONS
	CAML SDEL,SYMBOL	;NEED MORE CORE?
	CALL XCEEDS		;YES
	MOVEM RC,-1(SDEL)	;SAVE RELOCATION BITS
	HRRI ARG,-2(SDEL)	;SAVE THE POINTER IN ARG
	MOVEM V,0(ARG)		;SAVE A 36BIT VALUE
	TLO ARG,SPTR		;SET SPECIAL PNTR FLAG
	TLZ ARG,PNTF		;CLEAR POINTER FLAG
   IFN POLISH,<
	TLZE ARG,OPDF		;[624] OPDEF?
	TLO ARG,SYMF		;[624] MAKE IT INTO SYMBOL
   >
	JRST UPDAT3		;SAVE THE POINTER AND EXIT
   IFN FTPSECT,<		;[575]
UPDAT6:	TLNN IO,DEFCRS		;DEFINING OCCURANCE?
	RET			;NO, RETURN
	TLNE ARG,EXTF		;EXTERNAL?
	RET			;YES, RETURN
	MOVE SDEL,SYMBOL	;GET START OF SYM TAB
	SETZ AC1,		;ZERO PSECT INX
UPDAT7:	HRRZ AC2,SGSCNT(AC1)	;PSECT SYM CNT
	LSH AC2,1		;DOUBLE IT
	ADD SDEL,AC2		;END OF PSECT
	CAMGE SDEL,SX		;SYM IN THIS PSECT?
	AOJA AC1,UPDAT7		;NO, TRY NEXT PSECT
	CAMN AC1,SGNCUR		;IF IT'S IN THE CUR PSECT
	RET			;THEN RETURN
	PUSH P,AC1		;SAVE PRESENT PSECT INX
	PUSH P,0(SX)		;SAVE SYMBOL STUFF
	PUSH P,-1(SX)		;AND NAME
	PUSH P,SX		;SAVE PRESENT SYM INX
	CALL SRCHI		;SET UP SRCHX
	CALL SRCH		;SET UP NEW SX
	  JFCL
	POP P,SDEL		;RESTORE PRESENT SYM INX
	MOVE AC1,-2(P)		;GET PRESENT PSECT INX
	CAMG AC1,SGNCUR		;WHICH WAY TO MOVE?
	JRST UPDAT9		;DOWN
	ADDI SX,2		;MUST MOVE THIS ONE ALSO
UPDAT8:	MOVE AC2,-2(SDEL)	;MOVE PART OF
	MOVEM AC2,0(SDEL)	;SYMBOL TABLE
	CAILE SDEL,0(SX)	;ENOUGH MOVED?
	SOJA SDEL,UPDAT8	;NO
	JRST UPDT10		;COMMON EXIT
UPDAT9:	HRLI AC2,1(SDEL)	;FROM HERE
	HRRI AC2,-1(SDEL)	;TO HERE
	BLT AC2,-2(SX)		;UNTIL HERE, MOVE!
UPDT10:	POP P,-1(SX)		;RESTORE SYMBOL NAME
	POP P,0(SX)		;AND STUFF
	POP P,AC1		;OLD PSECT INX
	SOS SGSCNT(AC1)		;DECR ITS SYM CNT
	MOVE AC1,SGNCUR		;CUR PSECT INX
	AOS SGSCNT(AC1)		;INCR ITS SYM CNT
	JRST SRCHI		;[664] SET UP SRCHX, RETURN
   >
	SUBTTL PHASED CODE

   IFN PURESW,<LOWH:
	PHASE LOWL>

   IFN TEMP,<TMPFIL: SIXBIT /MAC/
	XWD -200,0>
LSTFIL:	BLOCK 1
	SIXBIT /@/		;SYMBOL TO STOP PRINTING
TABI:
   IFE FORMSW,< BYTE (7) 0, 11, 11, 11, 11>
   IFN FORMSW,< BYTE (7) 11,11, 11, 11, 11>
SEQNO:	BLOCK 1
	ASCIZ /	/
BININI:	EXP B
BINDEV:	BLOCK 1
	XWD BINBUF,0
LSTINI:	EXP AL
LSTDEV:	BLOCK 1
	XWD LSTBUF,0
   IFN CCLSW,<
RPGINI:	EXP AL
RPGDEV:	BLOCK 1
	XWD 0,CTLBLK
   >
INDEVI:	EXP A
INDEV:	BLOCK 1
	XWD 0,IBUF

UNVINI:	EXP B			;OPEN BLOCK FOR BINARY UNV
UNVDEV:	BLOCK 1			;SO USER CAN SPECIFY
	EXP UNVBUF

..LPP:	EXP .LPP-2		;"READ-ONLY" LINES/PAGE

REL1P:	EXP ABSLOC		;[573]
	EXP RELLOC		;PTR TO RELLOC BLOCK
;DATA AREA FOR COMPT. UUO'S
   IFN TOPS20,<

DEFDIR:	BLOCK ^D8		;DEFAULT DIRECTORY NAME
DEFDEV:	BLOCK ^D8		;DEFAULT DEVICE NAME
BIGBUF:	BLOCK ^D17
FILNAM:	BLOCK ^D26

RUNARG:	4			;RUN ARG
	RUNBLK			;LONG FORM
	-1,,FILNAM
	1
RUNBLK:	100001,,0
	377777,,377777
	-1,,[ASCIZ /SYS/]
	0
	0
	-1,,[ASCIZ /EXE/]	;DEFAULT EXT
	BLOCK 3			;THAT'S ALL
INARG:	CHAR,,1
	INBLK
	-1,,FILNAM
	440000,,200000
	0
	IBUF
	0
	.+1
INRIB:	5			;SIZE OF RIB
	BLOCK 5			;DUMMY
INBLK:	100001,,0
	377777,,377777
DINDEV:	0
DINDIR:	0
	0
	-1,,[ASCIZ /MAC/]
	BLOCK 3
LSTARG:	LST,,1
	LSTBLK
	-1,,FILNAM
	070000,,100000
	1
	0
	LSTBUF
	.+1
	BLOCK 4			;DUMMY RIB
LSTBLK:	400001,,0
	377777,,377777
	0
	0
LSTNAM:	0			;NAME
LSTEXT:	0			;EXTENSION
	BLOCK 3
BINADR:	BIN,,1
	BINSTK			;LONG FORM
	-1,,FILNAM
	440000,,100000		;WRITE ACCESS
	14
	0
	BINBUF
	.+1
	BLOCK 4			;DUMMY RIB
BINSTK:	400001,,0		;FLAGS
	377777,,377777
	0
	0
	0
	-1,,[ASCIZ /REL/]	;DEFAULT EXTENSION
	BLOCK 3			;ALL REST ARE ZERO

RPGADR:	CTL2,,1			;BLOCK FO COMMADN FILE
	RPGBLK
	-1,,FILNAM
	440000,,200000		;OPENF BITS
	0
	CTLBLK
	0
	.+1			;RIB ADDRESS
	5			;SIZE OF BLOCK WHICH FOLLOWS
	BLOCK 5
RPGBLK:	100001,,0		;OLD FILE
	377777,,377777
	BLOCK 3			;NO DEFAULTS HERE
	-1,,[ASCIZ /CCL/]	;DEFAULT EXTTENSION
	BLOCK 3
   >				;END OF TOPS20 CONDITIONAL

DBUF:	ASCIZ / TI:ME DY-MON-YR Page /
VBUF:	ASCIZ /	MACRO %/	;MUST BE LAST LOCATIONS IN BLOCK
   IFE PURESW,< BLOCK 3>	;ALLOW FOR LONG TITLE
   IFN PURESW,< DEPHASE
	LENLOW==.-LOWH>
SUBTTL STORAGE CELLS

   IFN PURESW,< RELOC LOWL
LOWL:	BLOCK LENLOW+3 >
PASS1I:
CTLBUF:	BLOCK <CTLSIZ+5>/5	;[700]
PASS1U:				;[700]
RP:	BLOCK 1
   IFN POLISH,<
POLSTK:	BLOCK 1
POLPTR:	BLOCK 1
   >
LSTBUF:	BLOCK 3
BINBUF:	BLOCK 3
IBUF:	BLOCK 3
UNVBUF:	BLOCK 3
LSTDIR:	BLOCK 4
BINDIR:	BLOCK 4
INDIR:	BLOCK 4
UNVDIR:	BLOCK 4
UNVPTH:	BLOCK 2+.SFDLN		;PATH FOR UNV LOOKUP
MYPPN:	BLOCK 1			;LOGGED IN PPN

ACDELX:				;LEFT HALF
BLKTYP:	BLOCK 1			;RIGHT HALF

COUTX:	BLOCK 1
COUTY:	BLOCK 1
COUTP:	BLOCK 1
COUTRB:	BLOCK 1
COUTDB:	BLOCK ^D18
CURADX:	BLOCK 1			;[613] CURRENT RADIX
MACDVR:	BLOCK 1			;[635] STORE DIVISOR FOR BACKSLASH MACRO ARG
MACADR:	BLOCK 1			;[635] STORE ADDER FOR BACKSLASH MACRO ARG
UPARRO:	BLOCK 1			;-1 == RE-EAT ^ IF NOT FOLLOWED BY ! / -
OKOVFL:	BLOCK 1			;-1 == * OR / OVERFLOW OK
EOFFLG:	BLOCK 1			;END OF FILE SEEN, NEXT FILE OPENED
NOUUO:	BLOCK 1			;[1041] -1 MEANS NO UUO SEARCH
   IFN TSTCD,<
TCDFLG:	BLOCK 1			;-1 MEANS TEST MODE, 0 REGULAR MODE
   >

UNDCNT:	BLOCK 1			;UND SYMBOL COUNT--CLEARED AND INCREMENTED IN UOUT
ERRCNT:	BLOCK 1
QERRS:	BLOCK 1			;COUNT OF "Q" ERRORS
FREE:	BLOCK 1
HIGH1:	BLOCK 1
HISNSW:	BLOCK 1
SVTYP3:	BLOCK 1
HMIN:	BLOCK 1			;START OF HIGH SEG. IN TWO SEG. PROG.
RLHMIN:	BLOCK 1			;[1111] LOWER BOUND FOR HI SEG WHEN COMPARING
				;[1111]  RELOCATABLES... HMIN-400.
SXSV:	BLOCK 1
SDELSV:	BLOCK 1
COLSIZ:	BLOCK 1
SYMBLK:	BLOCK 1
IFBLK:	BLOCK .IFBLK
IFBLKA:	BLOCK .IFBLK
LADR:	BLOCK 1
NCOLLS:	BLOCK 1
LIMBO:	BLOCK 1
LBUFP:	BLOCK 1
LBUF:	BLOCK <.CPL+5>/5
.SGLVZ==.			;START OF LIT /VAR AREA
	BLOCK 1			;[602] CURRENT LITLVL BEFORE PSECT SWITCH
.SGX:	BLOCK 1			;[602] CURRENT STPX BEFORE PSECT SWITCH
.SGY:	BLOCK 1			;[602] CURRENT STPY BEFORE PSECT SWITCH

VARHD:	BLOCK 1
VARHDX:	BLOCK 1
VARCNT:	BLOCK 1			;VARIABLE COUNTER

LITAB:	BLOCK 1
LITABX:	BLOCK 1
	BLOCK 1
LITHD:	BLOCK 1
LITHDX:	BLOCK 1
LITCNT:	BLOCK 1
LITNUM:	BLOCK 1
.SGLVL==.-.SGLVZ		;LENGTH OF LIT/VAR AREA

ENDSN:	BLOCK 1			;-1 IF CHECKED VAR AREA BEFORE LISING END
LOOKX:	BLOCK 1
NEXT:	BLOCK 1
OUTSW:	BLOCK 1
PDP:	BLOCK 1
RECCNT:	BLOCK 1
SAVBLK:	BLOCK RC
SAVERC:	BLOCK 1
SBUF:	BLOCK .SBUF/5
SRCHX:	BLOCK 1
SUBTTX:	BLOCK 1
SVSYM:	BLOCK 1
SYMBOL:	BLOCK 1
SYMTOP:	BLOCK 1
SYMCNT:	BLOCK 1
   IFN FTPSECT,<		;[575]
SGNMAX:	BLOCK 1
SGNAME:	BLOCK SGNSGS+1
SGRELC:	BLOCK SGNSGS+1
SGSCNT:	BLOCK SGNSGS+1
SGATTR:	BLOCK SGNSGS+1
SGORIG:	BLOCK SGNSGS+1		;LIT/VAR AREA ,, ORIGIN OF PSECT
SGSBOT:	BLOCK 1
SGSTOP:	BLOCK 1
SGWFND:	BLOCK 1
   >

STPX:	BLOCK 1
STPY:	BLOCK 1
STCODE:	BLOCK .STP
STOWRC:	BLOCK .STP

   IFN FORMSW,<
STFORM:	BLOCK .STP
FORM:	BLOCK 1
HWFMT:	BLOCK 1
FLDSIZ:	BLOCK 1
IOSEEN:	BLOCK 1
   >
TABP:	BLOCK 1
TCNT:	BLOCK 1			;COUNT OF CHARS. LEFT IN TBUF
TBUF:	BLOCK .TBUF/5
TTLFND:	BLOCK 1			;[1123] -1 IF TITLE/UNIVERSAL SEEN IN MODULE
DEVBUF:	BLOCK 12			;STORE NAME.EXT CREATION DATE AND TIME
TYPERR:	BLOCK 1
PRGPTR:	BLOCK 1			;POINTER TO CHAIN OF PRGEND BLOCKS
PGENDF:	BLOCK 1			;[1141] -1 IF PRGEND FOUND
ENTERS:	BLOCK 1			;-1 WHEN ENTERS HAVE BEEN DONE
UNIVSN:	BLOCK 1			;-1 WHEN A UNIVERSAL SEEN
UNVSKP:	BLOCK 1			;-1 IF /U SEEN (DON'T SAVE UNIV)
CPUTYP:	BLOCK 1			;CPU TYPE FOR HEADER BLOCK
PASS2I:

ABSHI:	BLOCK 1
HIGH:	BLOCK 1
HHIGH:	BLOCK 1			;SAVE BREAK OF HIGH SEG. IN TWO SEG PROG.
   IFN FTPSECT,<		;[575]
BLK24:	BLOCK 1			;[1020] -1 IF TO OUTPUT BLOCK 24
SGNCUR:	BLOCK 1
SGDMAX:	BLOCK 1
SGLIST:	BLOCK SGNDEP+1
SGSRCH:	BLOCK 1			;[1070] -1 IF SEARCHING ONLY CURRENT PSECT
SGLTLV:	BLOCK SGNDEP+1		;[1074] PSECT ENTRY LITERAL LEVEL
SGSWPT:	BLOCK 1			;[1074] PSECT SWAP TYPE, 0 = .PSECT, -1 = .ENDPS
SGLITL:	BLOCK 1			;[1074] TOTAL LITERALS OPEN IN ALL PSECTS
   >
ACDEVX:	BLOCK 1
CPL:	BLOCK 1
CTLSAV:	BLOCK 1
CTLS1:	BLOCK 1
EXTPNT:	BLOCK 1
INTENT:	BLOCK 1
INREP:	BLOCK 1
INDEF:	BLOCK 1
INTXT:	BLOCK 1
INCND:	BLOCK 1
CALNAM:	BLOCK 1
COMSW:	BLOCK 1			;-1 IF IN COMMENT WHILE SCANNING  FOR ANG.BRKT.
;DO NOT SPLIT THIS BLOCK OF 4 WORDS
PAGENO:	BLOCK 1
SEQNO2:	BLOCK 1
TAG:	BLOCK 1
TAGINC:	BLOCK 1
CALPG:	BLOCK 4
DEFPG:	BLOCK 4
LITPG:	BLOCK 4
REPPG:	BLOCK 4
TXTPG:	BLOCK 4
CNDPG:	BLOCK 4
IRPCNT:	BLOCK 1
IRPARG:	BLOCK 1
IRPARP:	BLOCK 1
IRPCF:	BLOCK 1
IRPPOI:	BLOCK 1
IRPSW:	BLOCK 1
LSTPY:	BLOCK 1			;SAVED STPY IN LITERAL
LITLVL:	BLOCK 1
LBLFLG:	BLOCK 1			;-1 IF LABEL HAS OCCURRED INSIDE CURRENT LITERAL
LTGINC:	BLOCK 1			;DEPTH OF LABEL IN LITERAL
LBLPNT:	BLOCK 1			;POINTS TO THE START OF TAGS IN LITERAL CHAIN
LBLNXT:	BLOCK 1			;POINTS TO THE NEXT BLOCK IN CHAIN
LITV:	BLOCK 1			;ACTUAL ADDR OF THIS LITERAL
LITRC:	BLOCK 1			;BLOCK RELOCATION FOR THIS LITERAL
LITN:	BLOCK 1			;SAVE LITNUM BEFORE IT GETS UPDATED IN STOLIT
SQBST:	BLOCK 1			;START OF LIT SCOPE FOR CHECKING TAG FIXUPS IN LITERAL POOL
SQBRC:	BLOCK 1			;KEEP THE FAKE EXT PTR , WHEN DOING LIT TAG FIXUPS

ASGBLK:	BLOCK 1
LOCBLK:	BLOCK 1

LOCA:	BLOCK 1
LOCO:	BLOCK 1
BNSN:	BLOCK 1			;-1 IF CODE STORED
RELLOC:	BLOCK 2			;[573]
ABSLOC:	BLOCK 1
LPP:	BLOCK 1
ORGMOD:	BLOCK 1
MODA:	BLOCK 1
MODLOC:	BLOCK 1
MODO:	BLOCK 1
MODN:	BLOCK 1			;NEW MODE,,NEW PC
NESTED:	BLOCK 1			;-1 IF IN LITERAL, MACRO, REPEAT 1 OR IF'S
   IFN CCLSW,<OTBUF:	BLOCK 2>
OUTSQ:	BLOCK 2
PAGEN.:	BLOCK 1
PPTEMP:	BLOCK 1
PPTMP1:	BLOCK 1
PPTMP2:	BLOCK 1

REPCNT:	BLOCK 1
REPEXP:	BLOCK 1
REPPNT:	BLOCK 1
RPOLVL:	BLOCK 1
R1BCNT:	BLOCK 1
R1BCHK:	BLOCK 1
R1BBLK:	BLOCK .R1B
R1BLOC:	BLOCK 1
RIMLOC:	BLOCK 1
VECREL:	BLOCK 1
VECTOR:	BLOCK 1
VECSYM:	BLOCK 1			;GLOBAL SYMBOLIC START ADDRESS
   IFN FTPSECT,<		;[575]
VECFND:	BLOCK 1
   >
.TEMP:	BLOCK 1			;TEMPORARY STORAGE
UNISCH:	BLOCK .UNIV+1		;SEARCH TABLE FOR UNIVERSALS
SQFLG:	BLOCK 1
ARGF:	BLOCK 1
CPEEKC:	BLOCK 1			;ANGLE COUNT AFTER ;; IN MACRO
MACENL:	BLOCK 1
MACLVL:	BLOCK 1
MACPNT:	BLOCK 1
WWRXX:	BLOCK 1
RCOUNT:	BLOCK 1			;COUNT OF WORDS STILL TO READ IN LEAF
WCOUNT:	BLOCK 1			;COUNT OF WORDS STILL FREE IN LEAF
IONSYM:	BLOCK 1			;-1 SUPRESS LISTING OF SYMBOLS
LOCAL:	BLOCK 1			;LINKED LIST OF LOCAL FIXUPS 
   IFN FTPSECT,<		;[735]
	BLOCK SGNSGS		;[735] ADDITIONAL LOCALS (ONE PER PSECT)
   >				;[735]
INOPDF:	BLOCK 1			;[624] POLISH FIXUP NEEDED FOR THIS OPDEF
   IFN POLISH,<
POLTYP:	BLOCK 1			;PRESET IF POLISH FIXUP TYPE KNOWN
POLIST:	BLOCK 1			;LINKED LIST OF POLISH FIXUP BLOCKS
POLITS:	BLOCK 1			;LINKED LIST OF POLISH FIXUPS TO LITS (TEMP)
BYTEAC:	BLOCK 1			;[777] KEEP ACCUMULATED BYTE SIZE
BYTESZ:	BLOCK 1			;[777] TO KEEP CURRENT BYTE SIZE
BSHIFT:	BLOCK 1			;[1037] -1 IF DOING B-SHIFT & WITH POLISH EXP
BSHFLG:	BLOCK 1			;[1054] -1 IF EVALUATING 2ND ARG TO BSHIFT
INBYTE:	BLOCK 1			;[761] -1 IF DOING BYTE & POLISH NOT ALLOWED
INIOWD:	BLOCK 1			;[730] -1 WHEN DOING IOWD(NOT IN ANGLE-BRACKETS)
INANGL:	BLOCK 1			;-1 WHEN INSIDE ANGLE BRACKETS
INASGN:	BLOCK 1			;HOLDS SYMBOL NAME DURING ASSIGN IN CASE NEEDS POLISH
INXWD:	BLOCK 1			;[1010] -1 IF DOING XWD
LSTOPR:	BLOCK 1			;POINTER TO STORE OP FOR LAST POLISH
PINDFL:	BLOCK 1			;[1114] -1 IF SAVING INDIRECTION DURING POLISH INDEXING
PLHIDX:	BLOCK 1			;[1114] -1 IF INDEX VALUE SAVED FROM POLIDX FOR OP
PIDXVL:	BLOCK 1			;[1114] INDEX VALUE SAVED FROM POLIDX
PIDXRC:	BLOCK 1			;[1114] INDEX RELOCATION SAVED FROM POLIDX
   >
SFDADD:	BLOCK 3+.SFDLN		;FOR LOOKUP/ENTER OF SFD PATH
SFDE==.-1			;END OF SFD
PPPN:	BLOCK 1			;DEFAULT PPN
PSFD:	BLOCK 3*.SFDLN		;DEFAULT SFD
PSFDE==.-1			;LAST ADDRESS IN SFD
BINSFD:	BLOCK 3+.SFDLN
LSTSFD:	BLOCK 3+.SFDLN
LITLST:	BLOCK 1			;LIST BINARY IN LITERALS IF NON-0
BLSW:	BLOCK 1			;BINARY LISTING CONTROL SWITCHES
NOTFL:	BLOCK 1			;-1 IF NOT FIRST LINE.
				;-2 IF LAST LINE.
				;0 OR +N FOR CHAR COUNT OF FIRST LINE.
IFXLSW:	BLOCK 1			;XLIST IN IF SWITCH
INTPGR: BLOCK 1			;[655] -1 IF INTERNAL PAGE REQUEST
XWDANG:	BLOCK 1			;[706] PTR TO LH POL IN <POL,,>
SAVCV:	BLOCK 1			;[773] OPERAND VALUE WHEN DOING FORCED POLISH
SAVRC:	BLOCK 1			;[773] OPERAND RC WHEN DOING FORCED POLISH
XWDLRC:	BLOCK 1			;[773] RELOCATION FOR LEFT HALF OF XWD IN ANGLE BRACKETS
XWDLV:	BLOCK 1			;[773] VALUE FOR LEFT HALF OF XWD IN ANGLE BRACKETS
XWDRRC:	BLOCK 1			;[773] RELOCATION FOR RIGHT HALF
XWDRV:	BLOCK 1			;[773] VALUE FOR RIGHT HALF
RELARG:	BLOCK 1			;[721] -1 IF RELOC OR LOC HAS EXPLICIT ARG
CPLSAV:	BLOCK 1			;[1003]
CRFLG:	BLOCK 1			;[1003] -1 TO REQUEST CRLF AFTER FF
MACTAB:	BLOCK 1			;[1033] -1 == OLD FORMAT MACRO ARGS
ITABM:	BLOCK 1			;[1033] INCLUDE TABS IN MACRO ARGS IF NON-0
IFSRCH:	BLOCK 1			;[1056] NONZERO IF SEARCH DONE DURING .IF(N)
.IFFLG:	BLOCK 1			;[1056] -1 IF EVALUATING .IF(N) ARG
.IFNUM:	BLOCK 1			;[1056] -1 IF SAW NUMBER DURING .IF(N)
.IFANG:	BLOCK 1			;[1056] -1 IF SAW ANGLE-BRACKETED EXP DURING .IF(N)
.IFNAM:	BLOCK 1			;[1112] NON 0 IF WE HAVE A SINGLE RADIX50 NAME DURING .IF(N)
POLAD0:	BLOCK 1			;[1060] FIXUP ADDRESS FOR ?MCRPTC
POLSY0:	BLOCK 1			;[1060] FIXUP SYMBOL FOR ?MCRPTC
POLPS0:	BLOCK 1			;[1060] FIXUP PSECT FOR ?MCRPTC
POLERR:	BLOCK 1			;[1060] POLISH BLOCK COUNT FOR ERROR
				;[1060] ROUTINE (SEE PCOUTR)
CRLFSN:	BLOCK 1			;[1064] -1 IF DON'T NEED CRLF FOR LALL IN SALL
IOFLGS:	BLOCK 1			;[1065] LISTING FLAGS TO BE SET AFTER LINE OUTPUT
PREFIX:	BLOCK 1			;[1066] PREFIX FOR ERROR MESSAGE (MCRxxx)
BYTESW:	BLOCK 1			;[1114] -1 IF DOING BYTE PSEUDO-OP
PASS2Z:				;ONLY CLEAR TO HERE ON PRGEND
LSTSYM:	BLOCK 1
SPAGNO:	BLOCK 1			;PAGE NUMBER FOR SYMBOL TABLES
SPAGN.:	BLOCK 1			;PAGE OFFSET STORAGE DURING SYMBOL OUTPUT
PASS2X:
SUBTTL MULTI-ASSEMBLY STORAGE CELLS

SAVEPP:	BLOCK 1			;SAVE P IN CASE NO END STATEMENT
SAVEMP:	BLOCK 1			;MACRO PNTR FOR SAME REASON
SAVERP:	BLOCK 1			;MACRO READ POINTER
LSTPGN:	BLOCK 1
ARAYP:	BLOCK 1
HDAS:	BLOCK 1
   IFN CCLSW,<EXTMP:	BLOCK 1	;HOLDS EXT OF COMMAND FILE (RH)
SAVFF:	BLOCK 1>
CTLBLK:	BLOCK 3
CTIBUF:	BLOCK 3
CTOBUF:	BLOCK 3
   IFN TEMP,<TMPFLG:	BLOCK 1>
   IFN FORMSW,<PHWFMT:	BLOCK 1>
UNIFLG:	BLOCK 1			;[700] -1 IF UNIERR
CTL2SV:	BLOCK 1			;[700] COMMAND LINE CHAR COUNT
MRUNV:	BLOCK 1			;[700] -1 IF MEM-RES UNVS IN ASSEMBLY
MACSIZ:	BLOCK 1			;INITIAL SIZE OF LOW SEG
UNISIZ:	BLOCK 1			;TOP OF BUFFERS AND STACKS
UNITOP:	BLOCK 1			;TOP OF UNIVERSAL SYMBOL TABLE
UNIVNO:	BLOCK 1			;NUMBER OF UNIVERSALS SEEN
UNITBL:	BLOCK .UNIV+1		;TABLE OF UNIVERSAL NAMES
UNIPTR:	BLOCK .UNIV+1		;TABLE OF SYMBOL POINTERS
UNISHX:	BLOCK .UNIV+1		;TABLE OF SRCHX POINTERS
UNVDFA:	BLOCK 1			;DEFAULT ARGUMENT POINTER FOR UNIVERSAL I/O
UNVER%:	BLOCK 1			;OLD UNIVERSAL FILE IF -1, MAY HAVE LOST DEFAULT ARGUMENTS
UNVPOL:	BLOCK 1		;STORE POLISH PTR, USED TO FIND THE END OF POLISH STACK
UNVNPL:	BLOCK 1			;NEW(ADJUSTED) POLISH PTR WHEN READING UNV FILE
UWVER: BLOCK 1			;ACCUMULATE FEATURE BITS FOR WRITING UNV FILE
RTIME:	BLOCK 1			;CPU TIME AT START OF PASS1
CPUV:	BLOCK 1			;[775] CPU VALUE
MACPRF:	BLOCK 1			;MACRO DEF PREFERRED OVER SYMBOL IF NON-0
PHALVL:	BLOCK 1			;-1 IN PHASE, 0 NOT IN PHASE
	VAR			;CLEAR VARIABLES

   IFE FTPSECT,<SYN HIGH,SGATTR>	;[575]
JOBFFI:	BLOCK 203*NUMBUF+1	;INPUT BUFFER PLUS ONE
   IFN PURESW,<LOWEND==.-1
	RELOC >

	END BEG