Google
 

Trailing-Edge - PDP-10 Archives - ap-c796e-sb - glob.mac
There are 4 other files named glob.mac in the archive. Click here to see a list.
TITLE	GLOB -- GLOBAL CROSS-REFERENCE DIRECTORY LISTING
SUBTTL	PARAMETERS AND DEFINITIONS    D.PLUMMER/DJB/CAM/PFC/DAL

;COPYRIGHT 1968,1969,1970,1971,1972, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.

%GLOB==5
VWHO==0
VMINOR==2
VEDIT==127

;. . . EDIT HISTORY . . .
; VERSION 5:
;  EDIT#117 - CHANGES /H PROCESSOR TO USE HELPER
;             CHANGES VERSION DEFINITION TO STANDARD FORMAT
;             AREAS AFFECTED: HELPSW AND PROGRAM HEADER


;  EDIT#120 - ADDS DEFENSIVE CODE TO HANDLE REL FILES
;             WITH NO NAME BLOCKS OR MULTIPLE NAME BLOCKS.
;             AREAS AFFECTED: CROSS,PRGTYP,MODCNT


;  EDIT#121 - CLEANS UP PROBLEM WITH REINITIALIZATION AFTER
;             COMPLETING OUTPUT.


;  EDIT#122 - MAKES /X ON DEST SIDE WORK


;  EDIT#123 - MAKES /X ON SOURCE SIDE WORK


;  EDIT#124 - MAKES GLOB GET LENGTH OF SECOND AND SUBSEQUENT
;             RELOCATION GROUPS OF A BLOCK CORRECT


;  EDIT#125 - MAKES GLOB HANDLE BLOCK TYPE 0 CORRECTLY


;  EDIT#126 - ALLOWS ASCII TEXT IN THE .REL FILE SINCE
;             THAT IS WHAT THE .TEXT PSEUDO-OP
;             DOES IN MACRO V50


;  EDIT#127 - SUPPORT BLOCK TYPE 100

;ASSEMBLY INSTRUCTIONS:
;
;	.LOAD GLOB,SYS:HELPER     ;[ED#117]
;	.SSAVE DSK:GLOB


.JBVER==137
LOC .JBVER
	BYTE	(3)VWHO(9)%GLOB(6)VMINOR(18)VEDIT  ;[ED#117]
RELOC

INTERNAL GLOB,.JBVER,%GLOB

EXTERNAL .JBFF,.JBREL,.JBREN


;PARAMETERS

IFNDEF	PURESW,<PURESW==1>	;ASSEMBLE REENTRANT VERSION
IFNDEF	PDLEN,<PDLEN==20>	;LENGTH OF PUSH DOWN LIST
IFNDEF	SYMLIN,<SYMLIN==^D11>	;NUMBER OF REFERENCES PER LINE
IFNDEF	PGLINE,<PGLINE==^D50>	;NUMBER OF LINES PER PAGE


	IFN	PURESW,<TWOSEG
			RELOC	400000>	;SWITCH TO HIGH SEG
;ACS

F=0		;FLAGS 
A=1		;LOCAL TEMPORARY
SW=2		;TEMPORARY FOR CHARACTER SCREENING
B=3		;RETURN BINARY WORD ON CALLS TO GETBIN
PN=4		;POINTER TO CURRENT PROGRAM NAME
NX=5		;NEXT ITEM IN LINKED CHAIN
V=6		;VALUE OF CURRENT SYMBOL
MC=7		;MODULE COUNT FOR OUTPUT LINE
BG=10		;ADDRESS OF BEG LOC OF FREE STORAGE
EN=11		;ADDRESS OF LAST LOC. IN FREE STORAGE
PT=12		;SYMBOL TABLE POINTER SETUP BY CROSS
S=13		;PC FOR JSP CALLS
T=14		;1 CAHR. ON CALLS TO LSTOUT AND TTYOUT
T1=T+1		;A TEMPORARY
R=16		;RELOCATION BITS FOR CURRENT INPUT BLOCK
P=17		;PUSH DOWN POINTER
C==A		;COUNT OF BINARY WORDS IN CURRENT BLOCK
C1==SW		;COUNT OF BINARY WORDS IN CURRENT SUB-BLOCK
LOC==C1		;LOCATION COUNTER
SP==V		;SAVED SYMBOL POINTER

;ACS USED (IN SCAN ONLY)

CH==1		;CHARACTER
NM==2		;FILE NAME OR EXTENSION
CC==3		;BREAK CHAR. INDEX
FC==4		;COUNT OF FILE DESCRIPTORS
SWT==5		;SWITCHS FOR CURRENT FILE
SWTBYT==6	;BYTE POINTER TO SWITCH AC(SWT)
;LH FLAGS

ALTF==1		;ALTMODE SEEN
ENDL==2		;OTHER TERMINATOR SEEN
DEST==4		;DESTINATION FILE TYPED
FST==10		;FIRST TIME CROSS CALLED FLAG
TITL==20	;TITLES ON LISTING CONTROL FLOP
COMMAF==40	;COMMA PRINTED FLAG
LSWIT==100	;LIBRARY SEARCH MODE
LSKIP==200	;SKIPPING PROGRAM
NOFIL==400	;FILE NOT FOUND ON LOOKUP
FCOM==1000	;ENTERING COMMON BLOCK SYMBOL
FFLAG==2000	;DOING FORTRAN IV FORM
MSPSW==4000	;INCLUDE MULTIPLY SPECIFIED ROUTINES

;RH FLAGS

RSWIT==1	;RELOCATABLE SYMBOLS ONLY
FSWIT==2	;FIXED SYMBOLS ONLY
ESWIT==4	;ERRORS (UNDEF & MULDEF) ONLY
SSWIT==10	;MULTIPLY SPECIFIED SYMBOLS ONLY
NSWIT==20	;NEVER REFERENCED SYMBOLS ONLY
ASWIT==40	;PRINT ALL SYMBOLS

;RH FLAGS IN SCAN ROUTINE ONLY

PERF==1		;PERIOD SEEN IN CURRENT FILE DESCRIPTOR
COLONF==2	;COLON SEEN IN CURRENT FILE DESCRIPTOR
CRF==4		;CARRIAGE RETURN(END OF STRING) SEEN
SRC==10		;SOURCE=1,DESTINATION=0
ALF==20		;ALTMODE SEEN FLAG
ALTS==40	;ALTMODE SEEN DURING PRESCAN
NCHF==100	;NO CHARACTER SEEN FLAG

;OTHER FLAGS

MULSPC==400000	;"SYMBOL IS MULTIPLY SPECIFIED" FLAG
PTD==200000	;"SYMBOL ALREADY PRINTED" FLAG
RELOC==100000	;"SYMBOL IS RELOCATABLE" FLAG
MULDEF==40000	;"SYMBOL IS MULTIPLY DEFINED" FLAG
;IO CHANNEL ASSIGNMENTS

TTYCHN==0	;TTY CHANNEL
DESCHN==1	;DESTINATION CHANNEL
SRCCHN==2	;SOURCE CHANNEL

;OTHER PARAMETERS

AMODE==0	;ASCII MODE
ALMODE==1	;ASCII LINE MODE
BMODE==14	;BINARY MODE

ERRORS==740000	;ERROR STATUS BITS
BUFSIZ==2*204	;MAX. SIZE OF 2 INPUT BUFFERS

DEVWRD==1	;DEVICE WORD IN OPEN UUO ARRAY
FILWRD==3	;FILE NAME WORD
EXTWRD==4	;EXTENSION WORD
DIRWRD==6	;DIRECTORY WORD
BUFST==7	;FIRST BUFFER ORIGIN WORD

;SOME SPECIAL ASCII CODES

CTLC==3
CTLZ==32
CR==15
FF==14
VT==13
LF==12
ALTM1==175
ALTM2==176
ALTM3==33
LEFARR==137
SUBTTL	CROSSX--MAIN PROGRAM AND I/O MODULE

GLOB:	MOVEI	EN,0		;FLAG NO TABLE TO OUTPUT YET
	SETZM	FWAZER		;CLEAR OUT SCRATCH AREA
	MOVE	T,[FWAZER,,FWAZER+1]
	BLT	T,LWAZER
	MOVEI	T,AMODE		;PRESET I/O BLOCKS
	MOVEM	T,OPENO		;FILE MODE
	MOVSI	T,OBUF		;BUFFER
	MOVEM	T,OPENO+2	; ..
	MOVEI	T,BMODE		;FILE MODE
	MOVEM	T,OPENI		; ..
	MOVEI	T,IBUF		;BUFFER
	MOVEM	T,OPENI+2	; ..
	MOVE	T,.JBREL	;GET INITIAL CORE SIZE
	MOVEM	T,SAVREL	;SAVE IT FOR LATER
;HERE ON A REENTER

CROSX0:	RESET			;STOP AND RELEASE ALL I/O
	MOVE	P,[IOWD PDLEN,PDLIST]	;SET PUSH DOWN POINTER
	MOVE	F,[MSPSW,,ASWIT]	;CLEAR FLAGS
	MOVEI	T,CROSX0	;REENTRY ADDRESS
	HRRM	T,.JBREN	;SAVE FOR REENTER COMMAND
	INIT	TTYCHN,ALMODE	;INITIALIZE TTY FOR I&O
TTYSIX:	SIXBIT	/TTY/
	XWD	TOBUF,TIBUF
	HALT			;SHOULD NEVER HAPPEN
	INBUF	TTYCHN,1	;SETUP LINE AT A TIME BUFFER
	OUTBUF	TTYCHN,2	;SETUP TWO TTY OUTPUT BUFFERS
	MOVE	T,.JBFF		;POINTS JUST BEYOND TTY BUFFERS
	MOVEM	T,OPENO+BUFST	;SAVE AS OUTPUT BUFFER ORIGIN
	ADDI	T,BUFSIZ	;ADD MAX SIZE OF TWO OUTPUT BUFFERS
	MOVEM	T,OPENI+BUFST	;SAVE AS INPUT BUFFER ORIGIN
	MOVEI	BG,BUFSIZ(T)	;POINTER TO FREE STORAGE ORIGIN
;**AT TTYSIX+10 INSERTED 1 INSTRUCTION [EDIT#121]
	MOVEM	BG,SAVBG	;SAVE ADDRESS OF FREE STORAGE ORIGIN	[ED#121]
	CAMLE	BG,SAVREL	;SEE IF BIGGER THAN INITIAL
	MOVEM	BG,SAVREL	;YES--UP MEMORY

CROSX1:	PUSHJ	P,NEXLIN	;GET FIRST LINE FROM TTY
	PUSHJ	P,SRCINI	;INITIALIZE FIRST SOURCE
	JRST	CROSX2		;INITIAL ALTMODE RETURN
	HRRZ	EN,SAVREL	;SETUP END POINTER
	MOVE	T,EN		;DROP CORE
	CORE	T,		; TO LET OTHERS
	  JFCL			; IN (IGNORE ERROR)
	PUSHJ	P,CROSS		;CALL CROSS REFERENCE PROGRAM
FINISH:	RELEAS	SRCCHN,		;RELEASE SOURCE FOR OTHER USERS
	CLOSE	DESCHN,		;CLOSE OUTPUT FILE
	TLNN	F,DEST		;SEE IF ANY OUTPUT
	JRST	.+3		;NO--SKIP ERROR TEST
	STATZ	DESCHN,ERRORS	;YES--CHECK FOR ANY LAST ERRORS
	  PUSHJ	P,OUTPTE	;YES--GIVE A MESSAGE
	RELEAS	DESCHN,		;MAKE SURE OUTPUT COMPLETE
	CLOSE	TTYCHN,2	;CLOSE ONLY OUTPUT IN CASE TTY IS DEST
	JRST	CROSX1		;ASK FOR MORE COMMAND INPUT

CROSX2:	JUMPGE	EN,CROSX1	;IGNORE ALTMODE IF NO TABLE TO PRINT
	PUSHJ	P,STOUT		;GO PRINT LISTING AGAIN
	JRST	FINISH		;CROSSP ALWAYS RETURNS HERE
NEXLIN:	TLZ	F,ALTF+ENDL+LSWIT+400000	;CLEAR END, ALTMODE SEEN,
				;LIBRARY SEARCH FLAGS AND SIGN BIT
	MOVSI	T,'DSK'		;DEFAULT OUTPUT DEVICE
	MOVEM	T,OPENO+DEVWRD	; ..
	MOVEM	T,OPENI+DEVWRD	;AND INPUT DEVICE
	MOVSI	T,'GLB'		;DEFAULT OUTPUT EXTENSION
	MOVEM	T,OPENO+EXTWRD	; ..
	MOVE	T,[SIXBIT /GLOB/]  ;PRESET DEFAULT OUTPUT FILE NAME
	MOVEM	T,LASTIN	; ..
	PUSHJ	P,TCRLF		;TYPE CRLF
	PUSHJ	P,PSTAR		;PRINT ASTERISK
	OUTPUT	TTYCHN,		;DO IT
	INPUT	TTYCHN,		;GET COMMAND STRING
	MOVSI	T,OPENO		;ADDRESS OF OPEN UUO ARRAY
	MOVSI	T1,OPENI	;SET ADDRESS AND COUNT FOR SOURCE SCAN
	MOVEM	T1,OPENCT	;SAVE SOURCE FILE COUNT
	MOVE	T1,TIBUF+1	;GET INPUT BYTE POINTER
	PUSHJ	P,DSCAN		;SCAN FOR DESTINATION FILE
	JRST	SYNTAX		;SYNTAX ERROR
	TLOA	F,400000	;FLAG NO DEST FILE SPECIFIED
	TLO	F,400000	;FLAG NO DEST FILE SPECIFIED
;**AT NEXLIN+20 [EDIT#122]
	JUMPL	F,LAB1		;IF NO DESTINATION SPECIFIED	[ED#122]
	MOVE	A,TTYSIX	;SPECIAL CHECK FOR TTY		[ED#122]
	CAME	A,OPENO+DEVWRD	;IS TTY OUTPUT DEVICE?		[ED#122]
	TLOA	F,DEST+TITL	;NO, FLAG DESTINATION SPECIFIED
LAB1:	TLZ	F,DEST+TITL	;YES, CLEAR DEST SPECIFIED FLAG	[ED#122]
	PUSHJ	P,SWITCH	;SET FLAGS ACCORDING TO SWITCHES	[ED#122]
	POPJ	P,		;RETURN



STOUT:	TLNN	F,DEST		;ANY DESTINATION TO INIT?
	JRST	CROSSP		;NO, GO PRINT LISTING ON TTY
	OPEN	DESCHN,OPENO	;INIT OUTPUT DEVICE
	JRST	NOTAVO		;DEVICE NOT AVAILABLE
	MOVE	T,OPENO+BUFST	;ORIGIN OF OUTPUT BUFFERS
	MOVEM	T,.JBFF		;SET .JBFF TO RECLAIM OLD SPACE
	OUTBUF	DESCHN,2	;SETUPT 2 OUTPUT BUFFERS
	MOVE	T,LASTIN	;GET LAST INPUT NAME JUST
	SKIPN	OPENO+FILWRD	;  IN CASE NO OUTPUT NAME SPECIFIED
	MOVEM	T,OPENO+FILWRD	;  RIGHT--SO USE IT
	HLLZS	OPENO+EXTWRD	;CLEAR AREA FOR ERROR CODE
	ENTER	DESCHN,OPENO+FILWRD	;ENTER FILE NAME
	JRST	DIRFUL		;DIRECTORY FULL
	JRST	CROSSP		;GO PRINT LISTING
;ROUTINE TO INITIALIZE NEXT SOURCE

;CALL:	PUSHJ P,SRCINI
;	XXX NO MORE SOURCE FILES - ALTMODE SEEN
;	XXX NEXT ONE INITED

SRCINI:
SRCIN1:	AOS	T,OPENCT	;INCREMENT SOURCE FILE COUNT
	MOVSI	T1,'REL'	;DEFAULT INPUT EXTENSION
	HLLM	T1,OPENI+EXTWRD	; ..
	SETZM	OPENI+FILWRD	;CLEAR INPUT FILE NAME
	SETZM	OPENI+DIRWRD	;CLEAR INPUT DIRECTORY
	MOVE	T1,TIBUF+1	;BP TO COMMAND STRING
	PUSHJ	P,SSCAN		;SCAN FOR NEXT SOURCE FILE
	JRST	SYNTAX		;SYNTAX ERROR
	TLOA	F,ALTF		;FLAG ALTMODE SEEN
	TLO	F,ENDL		;FLAG CR SEEN
	PUSHJ	P,SWITCH	;SET ANY SWITCHES SEEN
	TLNE	F,ALTF		;WAS ALTMODE SEEN?
	POPJ	P,		;YES,NO MORE SOURCE RETURN
	TLNN	F,ENDL		;WAS CR SEEN?
	JRST	SRCIN2		;NO, GO INIT THIS FILE
	PUSHJ	P,NEXLIN	;YES, TRY FOR ANOTHER COMMAND LINE
	JRST	SRCIN1		;AND SCAN FOR FIRST SOURCE FILE

SRCIN2:	OPEN	SRCCHN,OPENI	;INIT THIS FILE
	JRST	NOTAVI		;DEVICE NOT AVAILABLE
	MOVE	T,OPENI+BUFST	;GET ORIGIN OF INPUT BUFFERS
	MOVEM	T,.JBFF		;SET .JBFF TO RECLAIM USED SPACE
	INBUF	SRCCHN,2	;SETUP TWO INPUT BUFFERS
	SKIPE	T,OPENI+FILWRD	;GET INPUT FILE NAME
	MOVEM	T,LASTIN	;IF NON-ZERO, STORE FOR OUTPUT DEFAULT
	TLZ	F,NOFIL		;CLR FLAGS EACH TIME
	HLLZS	OPENI+EXTWRD	;CLEAR ROOM FOR ERROR BITS
	LOOKUP	SRCCHN,OPENI+FILWRD	;IN CASE DIRECTORY DEVICE
	JRST	NOTFND		;FILE NOT FOUND ERROR
	JRST	CPOPJ1		;SKIP RETURN
;ROUTINE TO RETURN NEXT BINARY SOURCE WORD
;CALL:	PUSHJ P,GETBIN
;	SOURCE BINARY WORD RETURNED IN AC B

GETBIN:	SOSG	IBUF+2		;DECREMENT ITEM COUNT
	JRST	INPUT		;FINISHED THIS INPUT BUFFER
GETB1:	ILDB	B,IBUF+1	;GET NEXT BINARY WORD
	POPJ	P,		;RETURN

INPUT:	TLNE	F,NOFIL		;WAS FILE FOUND?
	JRST	GETBNX		;NO
	IN	SRCCHN,		;GET NEXT INPUT BUFFER
	  JRST	GETB1		;OK RETURN FROM INPUT UUO
	STATZ	SRCCHN,ERRORS	;ANY ERROR BITS?
	  JRST	SRCERR		;YES
				;NO, ASSUME END OF FILE AND...
GETBNX:	PUSHJ	P,SRCINI	;INIT NEXT BINARY FILE
	JRST	INEND		;NONE LEFT - ALTMODE SEEN
	TLZ	F,LSKIP		;CLEAR SKIPPING FLAG IN CASE LEFT FROM BEFORE
	JRST	INPUT		;NEXT ONE READY

SRCERR:	PUSHJ	P,PRFILE	;PRINT FILE NAME
	JSP	T1,ENDMES	;PRINT ERROR MESSAGE
	ASCIZ	/ input error/


INEND:	POP	P,A		;MATCHES PUSHJ CALL TO GETBIN
				;FROM WHICH WE NEVER RETURN
	HRRZ	A,A		;GET ADDRESS
	CAIE	A,SCR1		;SEE IF GETWRD
	CAIN	A,SCR2		; ..
	POP	P,A		;YES--REMOVE ONE MORE
	HRROM	PT,EN		;TABLE COMPLETE - SAVE ITS END - SET FLAG
	PUSHJ	P,TCRLF		;START NEW TTY LINE
	LDB	T,[POINT 8,EN,25]	;GET CURRENT NUMBER OF CORE BLOCKS
	ADDI	T,1		;MAKE IT ACCURATE
	PUSHJ	P,DECOUT	;PRINT AS DECIMAL NUMBER
	MOVEI	T1,CORM2	;PRINT "K OF CORE"
	PUSHJ	P,MESS		;DO IT
	OUTPUT	TTYCHN,		;MAKE SURE OUTPUT HAPPENS
	JRST	STOUT		;GO PRINT LISTING
CORM2:	ASCIZ	/K of core used/
SWITCH:	MOVE	T1,[POINT 6,T]
SWITA:	ILDB	SW,T1		;GET NEXT SIXBIT CHAR.
	JUMPE	SW,CPOPJ	;NULL TERMINATES

	MOVSI	A,-SW1TBL	;SEARCH FIRST TABLE
SWIT1B:	HLRZ	B,SW1TAB(A)	;GET SWITCH
	CAME	B,SW		;IS IT THE RIGHT ONE?
	AOBJN	A,SWIT1B	;NO--LOOP
	HRRZ	B,SW1TAB(A)	;GET DISPATCH ADDRESS
	JUMPLE	A,(B)		;GO DO IT IF MATCH

	MOVSI	A,-SWTABL	;TRY SECOND TABLE
SWITB:	HLRZ	B,SWTAB(A)	;SET SWITCH IN B
	CAME	B,SW		;IS IT THE WANTED SWITCH
	AOBJN	A,SWITB		;NO,TRY NEXT SWITCH
	JUMPG	A,ILLSW		;ILLEGAL SWITCH FOUND
	HRR	F,SWTAB(A)	;SET LATEST FLAG IN F

SWITC:	TLNE	T1,770000	;FINISHED BYTE POINTER?
	JRST	SWITA		;NO
	POPJ	P,		;YES

SWITX:	TLC	F,TITL		;INVERT TITLE CONTROL FLAG
	JRST	SWITC

SWITM:	TLZA	F,LSWIT		;CLEAR LIBRARY SEARCH MODE (SKIP)
SWITL:	TLO	F,LSWIT		;SET LIBRARY SEARCH MODE
	JRST	SWITC		;BACK FOR THE REST OF THE SWITCHES

MSPOFF:	TLZA	F,MSPSW		;TURN OF MULT SPEC SYMBOLS
MSPON:	TLO	F,MSPSW		;TURN ON MULT SPEC SYMBOLS
	JRST	SWITC		;LOOP BACK FOR NEXT SWITCH

;TABLE OF LEGAL SWITCHES

SW1TAB:			;TABLE WITH SPECIAL PROCESSING
	XWD	'H',HELPSW
	XWD	'L',SWITL
	XWD	'M',SWITM
	XWD	'P',MSPON
	XWD	'Q',MSPOFF
	XWD	'X',SWITX
	SW1TBL==.-SW1TAB

SWTAB:			;MUTUALLY EXCLUSIVE CONTROL SWITCHES
	XWD	'A',ASWIT
	XWD	'E',ESWIT
	XWD	'F',FSWIT
	XWD	'N',NSWIT
	XWD	'R',RSWIT
	XWD	'S',SSWIT
	SWTABL== .-SWTAB
;HERE WHEN /H TYPED

HELPSW:	MOVE	1,['GLOB  ']	;[ED#117]   TYPE HELP TEXT
	PUSHJ	P,.HELPR##	;[ED#117]
	JRST	CROSX0		;[ED#117]    REENTER PROGRAM

;HELPMS: REMOVED ENTIRE HELP MESSAGE [ED#117]

ENDMES:	PUSHJ	P,MESS		;MOVE ASCIZ MESSAGE TO OUTPUT BUFFER
	PUSHJ	P,TCRLF
ENDMS1:	CLOSE	TTYCHN,		;MAKE SURE OUTPUT COMPLETE
	TLNE	F,FST		;WAS CROSS CALLED BEFORE ERROR?
	HRROM	PT,EN		;YES, ENABLE PARTIAL PRINT
	JRST	CROSX0		;START OVER AGAIN

ILLSW:	JSP	T1,ENDMES
	ASCIZ	"
?Illegal Switch
"

SYNTAX:	JSP	T1,ENDMES
	ASCIZ	\
? Command syntax error
Type /H for help
\

NOTAVO:	TLOA	F,400000	;SET OUTPUT DEV FLAG
NOTAVI:	TLZ	F,400000	;CLEAR OUTPUT DEV FLAG
	MOVEI	T1,DOTMS	;PRINT ERROR DOTS
	PUSHJ	P,MESS		;DO IT
	TLZE	F,400000	;GET EITHER I OR O DEV NAME
	SKIPA	T1,OPENO+DEVWRD	;OUTPUT DEV NOT AVAILABLE
	MOVE	T1,OPENI+DEVWRD	;INPUT DEVICE NOT AVAILABLE
	PUSHJ	P,SIXOUT	;PRINT SIXBIT NAME
	JSP	T1,ENDMES
	ASCIZ	/: not available
/

DIRFUL:	HRRZ	T,OPENO+EXTWRD	;GET ERROR CODE
	JUMPE	T,DIRFLL	;DTA DIRECTORY IF 0
	MOVEI	T1,ENTERR	;ELSE, MUST BE DISK ERROR
	PUSHJ	P,MESS		;ISSUE MESSAGE
	HRRZ	T,OPENO+EXTWRD	;GET ERROR CODE
	PUSHJ	P,OCTOUT	;AND ISSUE IT
	JRST	TCRLF		;END LINE AND RETURN
DIRFLL:	JSP	T1,ENDMES	;DIRECTORY FULL
	ASCIZ	/
? Directory full
/

ENTERR:	ASCIZ	/
? Enter error /
NOTFND:	TLO	F,NOFIL		;SET FLAG TO SKIP INPUT
	PUSHJ	P,PRFILE	;PRINT FILE NAME
	HRRZ	T,OPENI+EXTWRD	;GET ERROR NUMBER
	JUMPE	T,NOTFNN	;NOT FOUND
	MOVEI	T1,LKERR	;ESOTERIC DISK ERROR
	PUSHJ	P,MESS		;TYPE MESSAGE
	HRRZ	T,OPENI+EXTWRD	;GET ERROR NUMBER
	PUSHJ	P,OCTOUT	;TYPE IT
	PUSHJ	P,TCRLF		;END LINE
	JRST	CPOPJ1		;CONTINUE WITH NEXT FILE
NOTFNN:	MOVEI	T1,NFMS		;PRINT "NOT FOUND"
	PUSHJ	P,MESS		;PRINT
	JRST	CPOPJ1		;CONTINUE WITH NEXT FILE
NFMS:	ASCIZ	/ not found
/
LKERR:	ASCIZ	/ lookup error /

CORFUL:	MOVEI	T1,CORM1
	PUSHJ	P,MESS
	LDB	T,[POINT 8,.JBREL,25]
	ADDI	T,2
	MOVEI	T1,"K"-"0"
	PUSHJ	P,DECOUK
	PUSHJ	P,TCRLF		;END LINE
	JRST	ENDMS1

CORM1:	ASCIZ	/
? Table overflow - CORE UUO failed
trying to expand to /


DOTMS:	ASCIZ	/
? /
;ROUTINE TO OUTPUT ON LISTING FILE
;CALL:	MOVE T, CHARACTER
;	PUSHJ P,LSTOUT

LSTOUT:	TLNN	F,DEST		;WAS DESTINATION FILE INITED?
	JRST	TTYOUT		;NO, SEND OUTPUT TO TTY
	SOSG	OBUF+2		;DECREMENT COUNT OF ITEMS LEFT
	JRST	OUTPT		;NO MORE ROOM IN THIS BUFFER
LST1:	IDPB	T,OBUF+1	;STORE NEXT CHARACTER AWAY
	POPJ	P,

OUTPT:	OUTPUT	DESCHN,		;OUTPUT THIS BUFFER
	GETSTS	DESCHN,A	;CHECK FOR ERRORS
	TRNN	A,ERRORS
	JRST	LST1		;OK
OUTPTE:	JSP	T1,ENDMES	;ERROR PRINT
	ASCIZ	/
Destination device error/

;OCTAL OUTPUT ROUTINE

OCTOUT:	IDIVI	T,10		;GET NEXT DIGIT
	HRLM	T1,(P)		;STORE AWAY
	SKIPE	T		;SEE IF DONE
	PUSHJ	P,OCTOUT	;NO--DO NEXT ONE
	JRST	DIGOUT		;YES--PRINT DIGIT

;DECIMAL OUTPUT ROUTINE

DECOUT:	IDIVI	T,12
DECOUK:	HRLM	T1,(P)
	JUMPE	T,.+2
	PUSHJ	P,DECOUT
DIGOUT:	HLRZ	T,(P)
	ADDI	T,"0"		;FALL INTO TTYOUT


;ROUTINE TO OUTPUT ON TTY
;CALL:	MOVE T,CHAR.
;	PUSHJ P,TTYOUT

TTYOUT:	SOSG	TOBUF+2
	OUTPUT	TTYCHN,
	IDPB	T,TOBUF+1
	POPJ	P,
;ROUTINE TO PRINT SIXBIT WORD
;CALL:	MOVE T1,SIXBIT WORD
;	PUSHJ P,SIXOUT

SIXOUT:	MOVEI	T,0
	LSHC	T,6
	JUMPE	T,CPOPJ		;IS IT NULL(END)?
	ADDI	T,40		;NO, CONVERT TO ASCIZ
	PUSHJ	P,TTYOUT	;OUTPUT
	JRST	SIXOUT



EXPAND:	MOVEI	S,1		;PREPARE POINTER TO CLEAR NEW CORE
	ADD	S,.JBREL	;FIRST LOC OF NEW CORE
	HRLS	S		;BLT POINTER
	AOS	S		;TO ZERO A BLOCK
	PUSH	P,S		;SAVE POINTER
	MOVE	S,.JBREL	;GET CURRENT REL MAX
	ADDI	S,2000		;INCREASE BY 1K DECIMAL
	CORE	S,		;EXECUTE CORE UUO
	JRST	CORFUL		;ERROR RETURN
	HRRZ	EN,.JBREL	;SUCCESSFUL EXPANSION, UPDATE END POINTER
	POP	P,S		;SET UP BLT POINTER
	SETZM	-1(S)		;CLEAR FIRST WORD
	BLT	S,(EN)		;CLEAR 1K BLOCK
	POPJ	P,		;RETURN FROM INCPT IN CROSS
;ROUTINE TO TYPE CRLF

CRLFM:	ASCIZ	/
/

TCRLF:	MOVEI	T1,CRLFM


;ROUTINE TO PRINT AN ASCIZ MESSAGE
;CALL:	MOVE T1, ADDRESS OF ASCIZ MESSAGE
;	PUSHJ P,MESS

MESS:	HRLI	T1,440700
MESS1:	ILDB	T,T1
	JUMPE	T,CPOPJ
	PUSHJ	P,TTYOUT
	JRST	MESS1

;ROUTINE TO PRINT *
PSTARM:	ASCIZ	/*/
PSTAR:	MOVEI	T1,PSTARM
	JRST	MESS

;ROUTINE TO PRINT FILE NAME

PRFILE:	MOVEI	T1,FILE		;PRINT "FILE "
	PUSHJ	P,MESS
	MOVE	T1,OPENI+DEVWRD	;GET DEVICE NAME
	PUSHJ	P,SIXOUT
	MOVEI	T,":"		;FOLLOW BY COLON
	PUSHJ	P,TTYOUT	;PRINT IT
	MOVE	T1,OPENI+FILWRD	;PRINT FILE NAME
	PUSHJ	P,SIXOUT
	MOVEI	T,"."		;PRINT PERIOD
	PUSHJ	P,TTYOUT
	HLLZ	T1,OPENI+EXTWRD	;PRINT EXTENSION
	JRST	SIXOUT

FILE:	ASCIZ	/
? File /
SUBTTL	CROSS PART 1--FILE PROCESSOR

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THIS SECTION READS THE .REL FILES AND BUILDS A CORE TABLE ;;;
;;; IN THE FOLLOWING FORMAT:				      ;;;
;;;	THERE IS NO ORDER TO THE TABLE			      ;;;
;;;							      ;;;
;;;	EACH PROGRAM OR SUBROUTINE NAME OCCUPIES ONE WORD     ;;;
;;;		0,RADIX50 NAME				      ;;;
;;;	EACH REFERENCE TO A SYMBOL OCCUPIES ONE WORD	      ;;;
;;;		REFERENCE CHAIN,,X+ADDR. OF PROGRAM NAME      ;;;
;;;	EACH SYMBOL DEFINITION OCCUPIES THREE WORDS	      ;;;
;;;		FLAGS,RADIX50 SYMBOL NAME		      ;;;
;;;		VALUE					      ;;;
;;;		REFERENCE CHAIN,,X+ADDR. OF DEFINING PROG.    ;;;
;;;	    WHERE:					      ;;;
;;;		X=400000 IF MULT.SPEC.			      ;;;
;;;		F=1B0:	1 (MEANS DEFINITION)		      ;;;
;;;		  1B1:	PRINTED				      ;;;
;;;		  1B2:	RELOCATABLE SYMBOL		      ;;;
;;;		  1B3:	MULTIPLY DEFINED		      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;**AT CROSS INSERTED 4 INSTRUCTIONS [EDIT#121]
CROSS:	SETZM	HSHTBL		;PREPARE TO CLEAR HSHTBL	[ED#121]
	MOVE	S,[HSHTBL,,HSHTBL+1]	;MAKE BLT-AC		[ED#121]
	BLT	S,HSHEND	;AND CLEAR ALL HSHTBL		[ED#121]
	MOVE	BG,SAVBG	;GET ADR OF FREE STORAGE ORIGIN	[ED#121]
	MOVEI	PT,-1(BG)	;SET INITIAL POINTER
	MOVEI	S,1(BG)		;DESTINATION HALF OF BLT POINTER
	HRL	S,BG		;SOURCE HALF
	SETZM	(BG)		;CLEAR FIRST WORD OF STORAGE
	BLT	S,(EN)		;CLEAR REST OF STORAGE
	TLO	F,FST		;FLAG CROSS CALLED
;CROSS+6 INSERTED 4 INSTRUCTIONS [ED#120]
	PUSHJ	P,INCPT		;BUMP POINTER		[ED#120]
	AOS	B,MODCNT	;FORM DUMMY NAME	[ED#120]
	MOVEM	B,(PT)		;STORE AS PROG NAME	[ED#120]
	MOVE	PN,PT		;REMEMBER ADDR OF NAME	[ED#120]
CLRFTN:	TLZA	F,FFLAG		;CLEAR FORTRAN IV FLAG
INDXBL:	SETZM	IBUF+2		;CLEAR COUNT TO FORCE NEW READ (IGNORE INDEX BLK)
NXTBLK:	PUSHJ	P,GETBIN	;GET BLOCK TYPE WORD - MAY NOT RETURN
;**AT NXTBLK+1 INSERTED 1 INSTRUCTION [EDIT#125]
;**AT NXTBLK+1 [EDIT#126]
	TLNE	B,(177B6)	;[126] IS THIS ASCII TEXT?
	JRST	NXTBLK		;[126] YES--THROW IT AWAY
	JUMPE	B,NXTBLK	;IF BOTH BLOCK TYPE AND WORD COUNT=0,GET	[ED#125]
 				;NEXT BLOCK TYPE WORD
	HRRZM	B,C		;COUNT OF WORDS IN THIS BLOCK
	HLRZM	B,T		;BLOCK TYPE
;**AT NXTBLK+3 DELETED 1 INSTRUCTION [EDIT#125]
	CAIN	T,14		;SEE IF INDEX BLOCK
	JRST	INDXBL		;YES--GO SKIP IT
	PUSHJ	P,GETBIN	;GET RELOCATION WORD
	MOVE	R,B		;SAVE IN R
	MOVEI	C1,^D18		;SUB-BLOCK COUNT
	CAIN	T,4		;ENTRY BLOCK?
	JRST	ENTYP		;YES, MAY HAVE TO CHECK FOR ENTRY POINTS
	CAIE	T,401		;MANTIS?
	CAIN	T,400		;FORTRAN IV CALL?
	JRST	FORCAL		;YES
	TLNE	F,LSKIP		;TEST IF SKIPPING THIS PROGRAM
	JRST	IGNORE		;YES, IGNORE THIS BLOCK
	CAIN	T,2		;SYMBOL TABLE BLOCK TYPE?
	JRST	SYMTYP		;YES
	CAIN	T,6		;NO, PROGRAM NAME BLOCK TYPE?
	JRST	PRGTYP		;YES
	CAIN	T,100		;IS THIS A .ASSIGN BLOCK	[127]
	JRST	ASSIGN		;YES--GO PROCESS IT
IGNORE:	PUSHJ	P,GETWRD	;NO,IGNORE REST OF BLOCK
	JRST	NXTBLK		;FINISHED THIS BLOCK
	JRST	.-2		;IGNORE REST OF THIS BLOCK
PRGTYP:	PUSHJ	P,GETWRD	;GET PROGRAM NAME
	HALT			;SHOULD NEVER HAPPEN
	TLZ	B,740000	;CLEAR ALL BUT RADIX50 NAME
;PRGTYP+3 INSERTED 4 INSTRUCTIONS [ED#120]
	HRRZ	T,PN		;INDEX TO NAME IN TBL	[ED#120]
	MOVE	T1,(T)		;GET NAME		[ED#120]
	CAMN	T1,MODCNT	;IS IT DUMMY NAME?	[ED#120]
	JRST	PRGTY1		;YES,SUBSTITUTE 	[ED#120]
	PUSHJ	P,INCPT		;INCR & CHECK POINTER
	MOVEM	B,(PT)		;STORE NAME IN TABLE
	MOVE	PN,PT		;REMEMBER ADDRESS OF CURRENT NAME
	JRST	IGNORE		;IGNORE REST OF BLOCK
;ENTYP-1 INSERTED 2 INSTRUCTIONS [ED#120]
PRGTY1:	MOVEM	B,(T)		;REPLACE NAME		[ED#120]
	JRST IGNORE		;CONTINUE		[ED#120]


ENTYP:	TLNN	F,LSWIT		;TEST IF IN LIBRARY SEARCH MODE
	JRST	IGNORE		;IF NOT, IGNORE ENTRY BLOCK
	TLO	F,LSKIP		;SET SKIP FLAG UNLESS FORCED TO LOAD THIS PROG
ENTYP1:	PUSHJ	P,GETWRD	;GET NEXT ENTRY POINT
	JRST	NXTBLK		;NONE LEFT, SKIP THIS PROGRAM
	PUSHJ	P,SYMJUS	;FOUND ONE, MAKE IT LIKE WOULD BE IN THE LIST
	PUSHJ	P,SFIND		;SEE IF IT MATCHES AN UNDEFINED GLOBAL REQ
	JRST	ENTYP1		;HASNT BEEN REQUESTED, DONT FORCE LOADING
	HRRZ	R,2(MC)		;HAS BEEN REQUESTED, SEE IF IT HAS BEEN DEFINED
	JUMPN	R,ENTYP1	;YES IF POINTER TO PROGRAM NAME NONZERO
	TLZ	F,LSKIP		;FORCE LOADING THIS PROG, SATISFY GLOBAL REQ
	JRST	IGNORE		;SEEN ENOUGH, SKIP THE REST OF THIS BLOCK

;THIS ROUTINE TAKES THE RADIX 50 SYMBOL IN B AND 
;LEFT JUSTIFIES IT IN THE 6 CHARACTER FIELD.

SYMJUS:	TLZ	B,740000	;ONLY SYMBOL NAME IN B
	SKIPA	T,B		;COPY SYMBOL INTO T
JUSTF1:	MOVE	T,T1		;USE LOW ORDER PART OF PRODUCT
	MULI	T,50		;MULTIPLY BY 50 OCTAL
	JUMPN	T,JUSTF2	;DONE IF NON-ZERO HIGH ORDER PART
	CAMGE	T1,[50*50*50*50*50*50]	;DOES LOOP EXCEED 50^6?
	JRST	JUSTF1		;NO, KEEP MULTIPLYING
JUSTF2:	DIVI	T,50		;YES, MULTIPLIED ONCE TOO OFTEN
	MOVE	B,T		;RESTORE SYMBOL TO B
	POPJ	P,		;RETURN
SYMTYP:	PUSHJ	P,GETWRD	;GET SYMBOL WORD
	JRST	NXTBLK		;NONE LEFT
	MOVEM	B,V		;SAVE SYMBOL
	PUSHJ	P,GETWRD	;GET VALUE OR POINTER
	HALT			;SHOULD NEVER HAPPEN
	EXCH	B,V		;SYMBOL IN B,VALUE IN V
JUSTF0:	LDB	NX,[POINT 4,B,3]	;GET CODE BITS
JUSTFZ:	PUSHJ	P,SYMJUS	;LEFT JUSTIFY SYMBOL IN 6 CHAR FIELD
	CAIE	NX,11		;SUPPRESSED GLOBAL DEFINITION?
	CAIN	NX,1		;IS IT A GLOBAL DEFINITION?
	JRST	SYMDEF		;YES
	CAIE	NX,14		;NO,IS IT A GLOBAL REQUEST?
	JRST	SYMTYP		;NO,MUST BE LOCAL,IGNORE
	MOVEI	V,0		;INDICATE NOT MULT.SPEC.
	PUSHJ	P,SYMREQ	;EXECUTE SYMBOL REQUEST
	TLNN	F,FFLAG		;SKIP IF DOING FORTRAN IV FORM
	JRST	SYMTYP		;GO BACK FOR MORE SYMBOLS
	JRST	GLOBRQ		;GO BACK FOR MORE GLOBAL REQUESTS

SYMDEF:	PUSHJ	P,SFIND		;IS SYMBOL ALREADY IN TABLE?
	JRST	NEWSYM		;NO,ADD IT
	HRRZ	T,2(MC)		;YES,GET NAME POINTER
	JUMPE	T,DEFIN		;HAS IT BEEN DEFINED?
SYMDF1:	CAMN	V,1(MC)		;YES ARE VALUES THE SAME?
	JRST	MNAME		;YES,GO FLAG AS MULTIPLY SPECIFIED
	MOVSI	T,MULDEF	;NO,FLAG AS MULTIPLY DEFINED
	IORM	T,(MC)
	HLL	PN,2(MC)	;SAVE POINTER TO REQUESTS
	PUSHJ	P,SFINDC	;IS SYMBOL IN TABLE FURTHER ON?
	JRST	NEWMUL		;NO,ADD NEW DEFINITION
	JRST	SYMDF1		;YES GO CHECK VALUES
;HERE TO PROCESS ASSIGN BLOCK				[127]
ASSIGN:	PUSHJ	P,GETWRD	;GET FIRST WORD		[127]
	  JRST	NXTBLK		;SHOULD NEVER HAPPEN[127]
	MOVEM	B,ASGNT1	;SAVE WORD		[127]
	PUSHJ	P,GETWRD	;GET SECOND WORD	[127]
	  JRST	NXTBLK		;SHOULD NEVER HAPPEN	[127]
	MOVEM	B,ASGNT2	;SAVE SECOND WORD	[127]
	PUSHJ	P,GETWRD	;NOW DO THE SAME THING	[127]
	  JRST	NXTBLK		; FOR THE THIRD WORD	[127]
	MOVEM	B,ASGNT3	; ..			[127]
	MOVE	B,ASGNT2	;GET SYMBOL TO FIND	[127]
	PUSHJ	P,SFIND		;LOOK UP IN TABLE	[127]
	  JRST	IGNORE		;FLUSH BLOCK IF UNDEF	[127]
	MOVE	V,ASGNT3	;GET ADDON VALUE	[127]
	ADDB	V,1(MC)		;UPDATE VALUE	[127]
	MOVE	B,ASGNT1	;GET SYMBOL TO DEFINE	[127]
	PUSHJ	P,SYMJUS	;JUSTIFY SYMBOL		[127]
ASIGN1:	JUMPE	C,SYMDEF	;DEFINE NEW SYMBOL	[127]
	PUSH	P,B		;SAVE SYMBOL		[127]
	PUSHJ	P,GETWRD	;READ A WORD OF REL FILE [127]
	  HALT			;CAN NOT HAPPEN		[127]
	POP	P,B		;IGNORE WHAT WE READ	[127]
	JRST	ASIGN1		;SEE IF DONE YET	[127]
SYMREQ:	PUSHJ	P,INCPT		;INCREMENT POINTER
	HRRZM	PN,(PT)		;STORE REQUEST WORD
	IORM	V,(PT)		;INCLUDE MULT.SPEC. FLAG
	MOVE	V,PT		;SAVE REQUEST ADDRESS
	PUSHJ	P,SFIND		;IS SYMBOL DEFINED IN TABLE?
	JRST	PARDEF		;NO,GENERATE PARTIAL DEFINITION
	MOVEI	T,2(MC)		;YES,SET ADDRESS OF CHAIN POINTER
SYMRQ1:	MOVE	NX,T		;CONTINUE ALONG CHAIN
	HLRZ	T,(NX)		;GET NEXT WORD IN CHAIN
	HRRZ	B,(NX)		;B = POINTER TO PROGRAM NAME
	CAMN	B,PN		;SEE IF SAME AS CURRENT PROGRAM
				;(PROBLEM IS ADDITIVE GLOBALS)
	SOJA	PT,CPOPJ	;ALREADY BEEN DEFINED IN THIS PROG
	JUMPN	T,SYMRQ1	;END OF CHAIN YET?
	HRLM	V,(NX)		;YES,STORE POINTER TO REQUEST
	POPJ	P,

PARDEF:	TLO	B,400000	;SET SIGN BIT
	PUSHJ	P,INCPT		;INCREMENT POINTER
	MOVEM	B,(PT)		;STORE SYMBOL NAME
	MOVEM	PT,3(T)		;LINK IN TO LAST SYMBOL
	PUSHJ	P,INCPT		;LEAVE VALUE ZERO
	SETZM	(PT)		; ..
	PUSHJ	P,INCPT		;INCREMENT POINTER AGAIN
	HRLZM	V,(PT)		;STORE POINTER TO REQUEST
	PUSHJ	P,INCPT		;GET ANOTHER CELL
	MOVEM	MC,(PT)		;AND LINK IT IN
	POPJ	P,
NEWMUL:	TLO	B,MULDEF	;FLAG AS MULTIPLY DEFINED
NEWSYM:	TLO	B,400000	;SET SIGN BIT
	TRNE	R,1		;IS SYMBOL RELOCATABLE?
	TLO	B,RELOC		;YES,SET RELOCATABLE FLAG
	PUSHJ	P,INCPT		;INCREMENT AND CHECK POINTER
	MOVEM	B,(PT)		;STORE SYMBOL NAME
	MOVEM	PT,3(T)		;LINK IN LAST SYMBOL
	PUSHJ	P,INCPT		;INCREMENT POINTER AGAIN
	MOVEM	V,(PT)		;STORE VALUE
	PUSHJ	P,INCPT		;INCREMENT POINTER AGAIN
	HRRZM	PN,(PT)		;STORE POINTER TO DEFINING PROGRAM NAME
	TLNE	B,MULDEF	;IS SYMBOL MULTIPLY DEFINED?
	HLLM	PN,(PT)		;YES,STORE POINTER TO REQUESTS
	PUSHJ	P,INCPT		;INC PTR AGAIN
	MOVEM	MC,(PT)		;AND CHAIN TO NEXT SYMBOL
	TLNN	F,FFLAG		;SKIP IF DOING FORTRAN IV FORM
	JRST	SYMTYP		;GO BACK FOR MORE REQUESTS
	JRST	TEXTR		;GO BACK FOR MORE TEXT


DEFIN:	MOVSI	T,RELOC		;SET UP RELOCATABLE BIT
	TRNE	R,1		;IS THIS SYMBOL RELOCATABLE?
	IORM	T,(MC)		;YES,SET FLAG
	MOVEM	V,1(MC)		;STORE VALUE
	HRRM	PN,2(MC)	;STORE POINTER TO PROGRAM NAME
	TLNN	F,FFLAG		;SKIP IF FORTRAN IV FORM
	JRST	SYMTYP		;GO BACK FOR MORE SYMBOLS
	JRST	TEXTR		;GO BACK FOR MORE FORTRAN IV TEXT


MNAME:	MOVEI	V,MULSPC	;SET FLAG FOR MULTIPLY...
	IORM	V,2(MC)		;SPECIFIED SYMBOL
	TLNE	F,MSPSW		;SEE IF SAVING MULT.SPEC. REFERENCES
	PUSHJ	P,SYMREQ	;YES--GO TREAT AS REFERENCE
	TLNN	F,FFLAG		;SKIP IF FORTRAN IV FORM
	JRST	SYMTYP		;GO BACK FOR MORE SYMBOLS
	JRST	TEXTR		;GO BACK FOR MORE FORTRAN IV TEXT
;THIS SECTION PROCESSES FORTRAN IV REL INPUT AND PULLS OFF
;GLOBAL SYMBOL DEFINITIONS AND REQUESTS AND PUTS APPROPRIATE
;INFORMATION ON THE PUSHDOWN LIST.  IT MUST ALSO KEEP THE
;LOCATION COUNTER - THE REST IT CAN IGNORE.


FORCAL:	SETZ	LOC,		;CLEAR LOCATION COUNTER
	TLO	F,FFLAG		;SET FORTRAN IV FLAG
	JRST	TEXTR1		;B ALREADY = NEXT WORD
IGNOR1:	PUSHJ	P,GETBIN	;IGNORE NEXT WORD
TEXTR:	PUSHJ	P,GETBIN	;NEXT WORD TO B
	TLNE	F,FCOM		;SKIP UNLESS ENTERED A COMMON SYMBOL
	JRST	COM2		;BACK INTO COMMON SECTION
TEXTR1:	HLRZ	NX,B		;NX=LEFT HALF
	CAIE	NX,-1		;SKIP IF HEADER FORM
	AOJA	LOC,TEXTR	;NO, REGULAR CODE - BUMP LOCATION
				;COUNTER AND LOOP
	CAMN	B,[-2]		;TEST IF END OF DATA
	JRST	ENDF		;YES
	LDB	NX,[POINT 12,B,35]	;GET SIZE OF BLOCK
	ANDI	B,770000	;PICK OFF TYPE OF BLOCK
	JUMPE	B,IGNOR1	;JUMP IF PROGRAMMER LABEL
	CAIN	B,600000	;TEST IF GLOBAL DEFINITION
	JRST	GLOBDF		;YES
	CAIN	B,500000	;TEST IF ABSOLUTE CODE
	JRST	ABSI		;YES
	CAIN	B,310000	;TEST IF MADE LABEL
	JRST	IGNOR1		;YES (DEFINED BY FTN)
	CAIE	B,770000	;MANTIS DATA STATMT?
	CAIN	B,700000	;TEST IF DATA STATEMENT
	JRST	DATAS		;YES, IGNORE (NX) WORDS
	JRST	CLRFTN		;ERROR - EXIT
ABSI:	ADD	LOC,NX		;BUMP LOCATION COUNTER FOR THIS
				;BLOCK OF ABSOLUTE CODE
DATAS:	PUSHJ	P,GETBIN	;GET NEXT WORD
	SOJG	NX,.-1		;IGNORE THE WORDS
	JRST	TEXTR		;GO BACK FOR MORE
GLOBDF:	PUSHJ	P,GETBIN	;GET SYMBOL WORD IN B
				;GLOBAL DEFINTION CODE IS ALSO SET
	TLNE	F,LSKIP		;TEST IF SKIPPING THIS PROGRAM
	JRST	TEXTR		;YES WE ARE
GLOBD1:	MOVEI	R,1		;NO, SET RELOCATABLE FLAG
	MOVE	V,LOC		;V=CURRENT VALUE OF THE LOCATION COUNTER
	JRST	JUSTF0		;BACK INTO MAINSTREAM - RETURNS TO TEXTR
ENDF:	PUSHJ	P,GETBIN	;GET AND IGNORE STARTING ADDRESS
	PUSHJ	P,GETBIN	;ALSO NUMBER OF PERM. TEMPS
	MOVEI	C,1		;SET TO IGNORE 1 TABLE
	PUSHJ	P,TABIG		;IGNORE CONSTANTS TABLE
	PUSHJ	P,GETBIN	;GET NUMBER OF GLOBAL REQUESTS
	MOVE	C,B		;C=NUMBER OF REQUESTS (POSSIBLY 0)
GLOBRQ:	TLNE	F,FCOM		;SKIP UNLESS CAME HERE AFTER
	JRST	TEXTR		;A COMMON BLOCK REQUEST.
	SOJL	C,ENDF1		;JUMP IF LAST REQUEST DONE
	PUSHJ	P,GETBIN	;GET NEXT SYMBOL IN B
	TLNE	F,LSKIP		;TEST IF SKIPPING THIS PROGRAM
	JRST	GLOBRQ		;YES, DONT DO ANYTHING ABOUT THE GLOBAL REQUESTS
	MOVEI	NX,14		;SET GLOBAL REQUEST FLAG
	JRST	JUSTFZ		;BACK INTO MAINSTREAM -RETURNS TO GLOBRQ
ENDF1:	MOVEI	C,3		;SET TO IGNORE 3 TABLES
	PUSHJ	P,TABIG		;SCALARS, ARRAYS, AND ARRAY OFFSETS
	PUSHJ	P,GETBIN	;GET AND IGNORE COMBINED STORAGE NEEDED
	ADD	LOC,B		;ADD TO LOCATION COUNTER
	TLNE	F,LSKIP		;NO NEED TO WORRY IF SKIPPING THIS PROG
	JRST	ENDF2		;JUST SKIP THE COMMON TABLE
	TLO	F,FCOM		;WE ARE ENTERING A COMMON BLOCK SYMBOL
	PUSHJ	P,GETBIN	;GET SIZE OF COMMON TABLE
	MOVE	C,B		;SET IT IN C
COM1:	SOJL	C,COM3		;IF DONE, CLEAR FFLAG, START NEXT ROUTINE
	PUSHJ	P,GETBIN	;GET NEXT COMMON BLOCK SYMBOL
	PUSHJ	P,SYMJUS	;CLEAR CODE BITS, LEFT JUSTIFY SYMBOL
	PUSHJ	P,SFIND		;IS THIS BLOCK ALREADY IN SYMBOL TABLE?
	JRST	COM1A		;NO, DEFINE THE SYMBOL
	HRRZ	T,2(MC)		;YES, IS IT DEFINED?
	JUMPE	T,COM1A		;NO, THIS IS THE DEFN
	TLOA	B,600000	;YES, THIS IS ONLY A REQUEST
COM1A:	TLO	B,040000
	JRST	GLOBD1		;GO DO IT
COM2:	ADD	LOC,B		;COMES BACK HERE, ADD COMMN SIZE TO LOC
	SOJG	C,COM1		;LOOP TILL COMMON BLOCKS EXHAUSTED
COM3:	TLZ	F,FCOM		;CLEAR COMMON FLAG
	JRST	CLRFTN		;CLEAR FFLAG AND START NEXT ROUTINE
ENDF2:	PUSHJ	P,TABIG		;C KNOWN LE 0, IGNORE 1 TABLE, THE COMMON TABLE
	JRST	CLRFTN		;CLEAR FFLAG AND LOOK FOR NEXT ROUTINE


;ROUTINE TO SKIP OVER THE NUMBER OF TABLES IN C

TABIG:	PUSHJ	P,GETBIN	;GET SIZE OF TABLE (POSSIBLY 0)
	SKIPE	NX,B		;NX=SIZE, SKIP IF 0
	PUSHJ	P,GETBIN	;GET, IGNORE NEXT WORD
	SOJG	NX,.-1		;LOOP FOR TABLE
	SOJG	C,TABIG		;NUMBER OF TABLES TO IGNORE
	POPJ	P,		;EXIT

;GET NEXT BINARY WORD WITHIN CURRENT BLOCK
;	CALL:	PUSHJ P,GETWRD
;		XXX NO MORE WORDS IN BLOCK
;		XXX NEXT WORD IN B, RELOC BIT IN R35

GETWRD:	SOJL	C,CPOPJ		;FINISHED THIS BLOCK?
	SOJGE	C1,GETW1	;NO, FINISHED SUB BLOCK?
	PUSHJ	P,GETBIN	;YES, GET NEXT RELOCATION BITS
SCR1==.			;FOR INEND CODING
	MOVE	R,B		;RELOCATION BITS IN R
;**AT GETWRD+4 [EDIT#124]
	MOVEI	C1,21		;RESET SUB-BLOCK COUNT	[ED#124]
GETW1:	PUSHJ	P,GETBIN	;GET NEXT DATA WORD
SCR2==.			;FOR INEND CODING
	ROT	R,2		;SET BIT 35 OF R FOR THIS WORD
CPOPJ1:	AOS	(P)		;INCREMENT RETURN PC
CPOPJ:	POPJ	P,		;RETURN

;FIND A GIVEN SYMBOL IN TABLE
;	CALL:	MOVE B,<SYMBOL SOUGHT>
;		PUSHJ P,SFIND
;		XXX  NOT FOUND RETURN
;;		XXX  SUCCESSFUL RETURN, MC SET

SFIND:	MOVE	MC,B		;GET THE SYMBOL
	PUSH	P,MC+1		;SAVE REGISTER FOR DIVIDE
	IDIV	MC,[50*50*50*50]	;GET 1ST TWO CHARS
	POP	P,MC+1		;RESTORE AC
	MOVEI	T,HSHTBL-3(MC)	;SET UP LETTER CHAIN IN CASE NULL
	SKIPE	MC,HSHTBL(MC)	;GET 1ST ENTRY FOR THIS LETTER PAIR
SFIND1:	SKIPN	NX,(MC)		;GET A SYMBOL
	POPJ	P,		;DIDN'T FIND ANY
	TLZ	NX,740000	;MASK OUT FLAG BITS
	CAMN	NX,B		;IS IT THE DESIRED SYMBOL?
	JRST	CPOPJ1		;YES, SKIP RETURN
	CAMLE	NX,B		;HIGHER IN ALPHABET?
	POPJ	P,		;YES, RETURN FAIL
SFINDC:	HRRZ	T,MC		;STORE WHERE WE ARE
	HRRZ	MC,3(MC)	;GET NEXT SYMBOL
	JUMPN	MC,SFIND1	;AT END OF CHAIN?
	POPJ	P,		;YES,,NOT FOUND RETURN

;INCREMENT FREE STORAGE POINTER
;	CALL:	PUSHJ P,INCPT
;		XXX  SUCCESSFUL RETURN
;	WILL NEVER RETURN IF INSUFFICIENT SPACE

INCPT:	ADDI	PT,1		;INCREMENT POINTER
	CAILE	PT,(EN)		;OUT OF TABLE SPACE YET?
	JRST	EXPAND		;YES, GO TRY TO EXPAND CORE
	POPJ	P,		;NO, OK RETURN FROM INCPT
SUBTTL	CROSS PART 2--PRINT SYMBOL LISTING

;CLEAR "ALREADY PRINTED" BITS IN TABLE

CROSSP:	MOVEI	S,0		;ENTER INTO THE HASH TABLE
CROS01:	CAIL	S,50*50		;ARE WE FINISHED?
	JRST	CRLF		;YES
	SKIPN	BG,HSHTBL(S)	;GET NEXT LETTER PAIR BUCKET
	AOJA	S,CROS01	;EMPTY, GET NEXT LETTER PAIR
	JRST	OUT1		;DO THE 1ST SYMBOL
OUT0:	SKIPN	BG,3(BG)	;GET NEXT SYMBOL IN THIS LETTER BUCKET
	AOJA	S,CROS01	;NO MORE, GET NEXT LETTER
OUT1:	MOVE	NX,2(BG)	;1ST LINK OF REF. CHAIN
	MOVE	SP,BG		;AND ADDR OF SYMBOL
	;FALL TO OUTLIN
			;FALLS HERE FROM PREVIOUS PAGE
OUTLIN:	TLZ	F,COMMAF	;NEW LINE 
	JUMPE	SP,CRLF		;RETURN TO CROSSX IF NO MORE TO PRINT
	MOVSI	T1,PTD		;SET ALREADY PRINTED BIT
	IORM	T1,(SP)		;MARK SYMBOL AS PRINTED
	MOVE	B,(SP)		;GET SYMBOL AND CODE BITS
	PUSHJ	P,PRCHK		;CHECK PRINT CONTROL FLAGS
	JRST	OUT0		;DONT PRINT THIS SYMBOL
	PUSHJ	P,CRLFT		;START NEW LINE - WITH TITLE IF NECC
	TLNE	B,MULDEF	;IS SYMBOL MULTIPLY DEFINED?
	PUSHJ	P,PRNTM		;YES, PRINT M
	MOVE	NX,2(SP)	;GET POINTERS
	TRNN	NX,-1		;IS IT UNDEFINED?
	PUSHJ	P,PRNTU		;YES, PRINT U
	TRNE	NX,MULSPC	;IS IT MULTIPLY SPECIFIED?
	PUSHJ	P,PRNTS		;YES,PRINT S
	TLNN	NX,-1		;IS IT UNREFERENCED?
	PUSHJ	P,PRNTN		;YES, PRINT N
	PUSHJ	P,TAB		;FOLLOW FLAGS BY TAB
	MOVE	PT,SP		;SET POINTER FOR OUTSYM
	PUSHJ	P,OUTSYM	;PRINT SYMBOL
	PUSHJ	P,TAB		;FOLLOW BY TAB
	HRRE	PT,2(SP)	;GET NAME POINTER, EXTEND MULSPC
	JUMPE	PT,NOVAL	;SKIP VALUE AND NAME IF UNDEFINED
	PUSHJ	P,OCTPNT	;PRINT VALUE OF SYMBOL
	MOVE	T1,(SP)		;GET CODE BITS AGAIN
	TLNE	T1,RELOC	;IS SYMBOL RELOCATABLE?
	PUSHJ	P,QUOTE		;YES, PRINT SINGLE QUOTE
	PUSHJ	P,TAB		;FOLLOW BY TAB
	TRZ	PT,MULSPC	;RH OF PT POINTS TO PROGRAM NAME
	PUSHJ	P,OUTSYM	;PRINT PROGRAM NAME
	SKIPGE	PT		;WAS SYMBOL MULTIPLY SPECIFIED?
	PUSHJ	P,PPLUS		;YES, PRINT PLUS SIGN
	PUSHJ	P,TAB1		;FOLLOW BY TAB AND FOUR SPACES
	JRST	PRREF		;GO PRINT REFERENCES TO IT

NOVAL:	PUSHJ	P,TAB3		;UNDEFINED, PRINT THREE TABS INSTEAD
PRREF:	HLRZ	NX,2(SP)	;NX POINTS TO FIRST REQUEST
PRRF1:	JUMPE	NX,OUT0		;DONE IF NO MORE REQUESTS
	MOVE	PT,(NX)		;GET REQUEST WORD
	TLOE	F,COMMAF	;HAS A COMMA BEEN TYPED?
	PUSHJ	P,COMMA		;YES, TYPE ANOTHER, CHECK FOR OVERFLOW
	TRZE	PT,MULSPC	;SEE IF MULT. SPECIFIER
	PUSHJ	P,PPLUS		;YES--SET FLAG
	PUSHJ	P,OUTSYM	;PRINT PROGRAM NAME
	HLRZ	NX,PT		;NX POINTS TO NEXT REQUEST
	JRST	PRRF1		;CONTINUE ALONG REQUEST CHAIN

PRCHK:	TRNE	F,ASWIT		;PRINT ALL SYMBOLS?
	JRST	CPOPJ1		;YES
	MOVE	T1,2(SP)	;GET POINTERS FOR THIS SYMBOL
	TRNE	T1,-1		;IS SYMBOL UNDEFINED?
	TLNE	B,MULDEF	;NO, IS IT MULTIPLY DEFINED?
	JRST	PRCHKE		;YES, ERROR SYMBOL
	TRNE	F,ESWIT		;IS THIS ERRORS ONLY PRINT?
	POPJ	P,		;YES, THEN DONT PRINT
	TRNN	F,RSWIT		;RELOCATABLES ONLY?
	JRST	PRCHK1		;NO, CONTINUE TESTS
	TLNE	B,RELOC		;YES, IS THIS SYMBOL RELOCATABLE?
	JRST	CPOPJ1		;YES, PRINT IT
	POPJ	P,		;NO, DONT PRINT IT

PRCHK1:	TRNN	F,FSWIT		;FIXED SYMBOLS ONLY?
	JRST	PRCHK2		;NO,CONTINUE TESTS
	TLNN	B,RELOC		;YES, IS THIS SYMBOL FIXED?
	JRST	CPOPJ1		;YES, PRINT IT
	POPJ	P,		;NO, DONT PRINT IT

PRCHK2:	TRNN	F,SSWIT		;MULTIPLY SPECIFIED ONLY?
	JRST	PRCHK4		;NO, CONTINUE TESTS
	HRRE	T1,2(SP)	;YES, IS THIS SYMBOL MULSPC?
	JUMPL	T1,CPOPJ1	;YES, PRINT IT
	POPJ	P,		;NO, DONT

PRCHK4:	TRNN	F,NSWIT		;NEVER REFERENCED ONLY?
	JRST	CPOPJ1		;NO, SOMETHING WRONG, PRINT IT
	TLNN	T1,-1		;WAS SYMBOL REFERENCED?
	TRNE	T1,MULSPC	;NO, IS IT MULSPC?
	POPJ	P,		;YES, DONT PRINT
	JRST	CPOPJ1		;NO, PRINT IT

PRCHKE:	TRNE	F,ESWIT		;ERRORS ONLY PRINT?
	JRST	CPOPJ1		;YES, PRINT THIS ONE
	POPJ	P,		;NO, DONT PRINT
OUTSYM:	MOVE	T,(PT)		;PICK UP RADIX50 SYMBOL
	TLZ	T,740000	;CLEAR CODE BITS
OUTSY1:	IDIVI	T,50		;DIVIDE BY RADIX
	HRLM	T1,(P)		;SAVE REMAINDER
	JUMPE	T,.+2		;START TO UNWIND IF ZERO QUOTIENT
	PUSHJ	P,OUTSY1	;RECURSIVE CALL
	HLRZ	T,(P)		;GET REMAINDER FROM LIST
	JUMPE	T,CPOPJ		;IGNORE BLANKS
	CAIG	T,44		;LETTER OR NUMBER?
	ADDI	T,57		;YES
	CAILE	T,12+57		;LETTER?
	ADDI	T,101-13-57	;YES
	CAIN	T,45		;PERIOD?
	MOVEI	T,"."		;YES
	CAIN	T,46		;$?
	MOVEI	T,"$"		;YES
	CAIN	T,47		;%?
	MOVEI	T,"%"		;YES
	JRST	LSTOUT		;FALL INTO OUTPUT



OCTPNT:	MOVSI	PN,440300+T1
	HRROI	T1,-7		;PRESET DIGIT COUNTER
	MOVEM	T1,DIGCNT	; ..
	MOVEI	T1,1(SP)	;RH= ADDRESS OF OCTAL NUMBER,LH= CLEARED FLAG
OCTPT1:	MOVEI	T," "		;PREPARE A SPACE
	AOSN	DIGCNT		;INCREMENT DIGIT COUNT
	PUSHJ	P,LSTOUT	;HALF-WAY--PRINT SPACE
	ILDB	T,PN		;GET OCTAL DIGIT
	ADDI	T,"0"		;CONVERT TO ASCII
	TLNN	PN,770000	;IS THIS THE LAST DIGIT?
	JRST	LSTOUT		;YES,LSTOUT POPJS BACK TO OUTLIN
	TLO	T1,(T)		;SET FLAG FOR NON ZERO CHARACTER TYPED
	TLNN	T1,7		;IS THIS A ZERO WITH NO NON ZEROS TYPED?
	MOVEI	T," "		;YES, PRINT SPACE INSTEAD
	PUSHJ	P,LSTOUT	;GO PRINT OCTAL DIGIT
	JRST	OCTPT1		;CONTINUE


PMESS:	HRLI	T1,440700	;GENERAL MESSAGE PRINT ROUTINE
PMESS1:	ILDB	T,T1
	JUMPE	T,CPOPJ
	PUSHJ	P,LSTOUT
	JRST	PMESS1

COMMA:	MOVEI	T,","		;PRINT COMMA
	AOJL	MC,LSTOUT	;PRINT ONLY COMMA IF NO LINE OVERFLOW
	PUSHJ	P,LSTOUT	;ON OVERFLOW, PRINT COMMA THEN...
	PUSHJ	P,CRLF		;CR AND FIVE TABS
	PUSHJ	P,TAB
	PUSHJ	P,TAB
TAB3:	PUSHJ	P,TAB		;ENTRY TO PRINT 3 TABS
	PUSHJ	P, TAB
TAB1:	MOVEI	T1,TABMS
	JRST	PMESS

TAB:	MOVEI	T,11		;ENTRY TO PRINT SINGLE TAB
	JRST	LSTOUT


CRLF:	AOSA	C1		;NEVER PRINT TITLE EVEN IF TOO MANY LINES
CRLFT:	AOJGE	C1,PTITLE	;START NEW PAGE IF TOO MANY LINES
	MOVNI	MC,SYMLIN	;NUMBER OF REFERENCES PER LINE
	MOVEI	T,15		;CR
	PUSHJ	P,LSTOUT
	MOVEI	T,12		;LF
	JRST	LSTOUT

QUOTE:	MOVEI	T,"'"		;SINGLE QUOTE
	JRST	LSTOUT

PPLUS:	MOVEI	T,"+"		;PLUS SIGN
	JRST	LSTOUT

PRNTM:	MOVEI	T,"M"
	JRST	LSTOUT

PRNTU:	MOVEI	T,"U"
	JRST	LSTOUT

PRNTS:	MOVEI	T,"S"
	JRST	LSTOUT

PRNTN:	MOVEI	T,"N"
	JRST	LSTOUT

TABMS:	ASCIZ	/	    /		;TAB AND FOUR SPACES
PTITLE:	PUSHJ	P,CRLF		;MAKE SURE AT LEFT MARGIN
	MOVNI	C1,PGLINE	;NUMBER OF LINES PER PAGE
	TLNN	F,TITL		;TITLE PRINT SURPRESSED?
	POPJ	P,		;YES
	MOVEI	T,14		;FORM FEED
	PUSHJ	P,LSTOUT	;TOP OF NEW PAGE
	MOVEI	T1,TLINE	;MESSAGE ADDRESS
	PUSHJ	P,PMESS
	TRNE	F,ASWIT
	MOVEI	T1,ALINE
	TRNE	F,ESWIT
	MOVEI	T1,ELINE
	TRNE	F,RSWIT
	MOVEI	T1,RLINE
	TRNE	F,FSWIT
	MOVEI	T1,FLINE
	TRNE	F,NSWIT
	MOVEI	T1,NLINE
	TRNE	F,SSWIT
	MOVEI	T1,SLINE
	PUSHJ	P,PMESS
	JRST	CRLF
;VARIOUS TEXTS FOR TITLE LINES

TLINE:	ASCIZ	/Flags	Symbol	 Octal Value	Defined in  Referenced in		/

ALINE:	ASCIZ	/(all symbols)
/
ELINE:	ASCIZ	/(errors only)
/
RLINE:	ASCIZ	/(relocatable symbols only)
/
FLINE:	ASCIZ	/(fixed symbols only)
/
NLINE:	ASCIZ	/(never referenced symbols only)
/
SLINE:	ASCIZ	/(multiply specified only)
/
SUBTTL	SCAN--COMMAND SCANNER

;THIS IS A REENTRANT TYPE 2 SUBROUTINE
;IT USES NO TEMPORARY LOC EXCEPT 6 LOC ON PD LIST
;IT PRESERVES ALL ACS
;THERE ARE TWO CALLS, ONE FOR SOURCE AND ONCE FOR DESTINATION
;SSCAN SCANS FOR LEFT ARROW FIRST BEFORE USING COUNT
;DSCAN STARTS SCANNING IMMEDIATELY,LEFT ARROW MUST BE PRESENT

;CALLING SEQUENCE:
;	MOVE T,[XWD REL ADR OF OPEN UUO ARRAY,NTH FILE DESIRED]
;		N=0 IS EQUIVALENT TO N=1 IE FIRST FILE WANTED
;	MOVE T1,BYTE POINTER TO STRING OR FIRST REL ADR OF STRING
;	PUSHJ P,DSCAN -OR- SSCAN
;	XXX	;SYNTAX ERROR
;	XXX	;NTH FILE NOT SPEIFIED - ALTMODE SEEN
;	XXX	;NTH FILE NOT SPECIFIED - OTHER TERMINATOR SEEN
;	XXX	;SUCCESSFUL RETURN, OPEN UUO ARRAY SET
;SIXBIT SWITCHES ARE RETURNED IN AC T LEFT JUSTIFIED
;BYTE POINTER IN AC T1 POINTS TO LAST CHAR SCANNED ON ALL RETURNS

;THE DEVICE NAME,FILE NAME AND EXTENSION ARE SET TO ZERO
;BEFORE EACH SCAN IS BEGUN

;THE OPEN UUO ARRAY HAS FOLLOWING FORMAT:
;WORD 0 NOT ALTERED
;WORD 1 RECEIVES DEVICE NAME
;WORD 2 UNALTERED
;WORD 3 RECEIVES FILE NAME
;WORD 4 RECEIVES EXTENSION IN LH, RH UNALTERED
;WORD 5 UNALTERED
;WORD 6 RECEIVES DIRECTORY
;SOURCE FILE ENTRY POINT

SSCAN:	PUSHJ	P,SAVACS	;SAVE ACS AND CLEAR FLAGS
	TROA	F,SRC		;SET SOURCE FLAG

;DESTINATION FILE ENTRY POINT

DSCAN:	PUSHJ	P,SAVACS	;SAVE ACS
ARRCHK:	MOVE	NM,T1		;COPY STRING BP
ARRCK1:	ILDB	CH,NM
	MOVSI	CC,-IDSPLN
ARRCK2:	HLRZ	T,IDSPTB(CC)
	CAME	T,CH
	AOBJN	CC,ARRCK2
	MOVE	CC,IDSPTB(CC)
	JRST	(CC)

;SCAN NEXT FILE FIELD

ARPR:	TRNE	F,SRC		;IS THIS SOURCE SCAN?
	MOVE	T1,NM		;YES, CHANGE BP TO BEGIN AFTER ARROW
LOOPI:	HLRZ	T,(P)		;GET ADR OF OPEN UUO ARRAY
	TRO	F,NCHF		;SET BEGINNING OF LINE FLAG
			;FALL INTO LOOP0
LOOP0:	TRZ	F,PERF+COLONF	;CLEAR SUBFIELD BREAK CHAR FLAGS
;**AT LOOP0+1 EDIT#123 INSERTED TWO INSTRUCTIONS
	MOVE	SWTBYT,[POINT 6,SWT]	;RESET BYTE POINTER TO BUILD SWITCHES	[ED#123
	MOVEI	SWT,0		;CLEAR SWITCH REGISTER			[ED#123]
	TRNE	F,ALF		;HAS AN ALTMODE BEEN SEEN?
	JRST	ALTRTN		;YES, NOT FOUND RETURN
	TRNE	F,CRF		;HAS A CR BEEN SEEN?
	JRST	NTFOND		;YES, FIELD NOT FOUND RETURN
;**AT LOOP0+5 EDIT#123 DELETED TWO INSTRUCTIONS
;SCAN NEXT SUBFIELD

LOOP1:	MOVE	T,[POINT 6,NM]	;BYTE POINTER TO BUILD NAME
	MOVEI	NM,0		;CLEAR NAME REGISTER

;GET NEXT CHAR IN SUBFIELD

LOOP2:	ILDB	CH,T1		;GET NEXT CHARACTER IN COMMAND STRING
	CAIL	CH,"A"+40	;CHECK FOR LOWER CASE
	CAILE	CH,"Z"+40	; ALPHABETICS
	JRST	.+2		;NO
	SUBI	CH,40		;YES--CONVERT TO UPPER CASE
	CAIL	CH,"0"		;NUMBER OR LETTER?
	CAILE	CH,"Z"
	JRST	BREAK		;NO, BREAK OR ILLEGAL?
	CAILE	CH,"9"
	CAIL	CH,"A"
	JRST	BUILD		;YES, BUILD NAME IN AC NM
BREAK:	CAIN	CH,"/"		;SLASH?
	JRST	SLASH		;YES
	CAIN	CH,"("		;NO, LEFT PAREN?
	JRST	LEFPAR		;YES
	MOVSI	CC,-DISPLN	;NO, SEARCH BREAK CHAR TABLE
			;NAME FINISHED(DESTROY BYTE POINTER)
BRK1:	HLRZ	T,DISPTB(CC)	;GET NEXT BREAK CHAR.
	CAME	T,CH		;IS IT THIS ONE?
	AOBJN	CC,BRK1		;NO, KEEP LOOKING
	HLRZ	T,(P)		;SETUP REL. ADR. OF OPEN UUO ARRAY
	MOVE	CC,DISPTB(CC)	;DISPATCH ACCORDING TO BREAK
	JRST	(CC)
;BREAK CHARACTER DISPATCH TABLE (FOR PRESCAN)

IDSPTB:	XWD	ALTM1,EOLA
	XWD	ALTM2,EOLA
	XWD	ALTM3,EOLA
	XWD	LEFARR,ARPR	;LOOK FOR PRESENCE OF LEFT ARROW
	XWD	"=",ARPR
	XWD	CR,EOL
	XWD	LF,EOL
	XWD	FF,EOL
	XWD	VT,EOL
	XWD	CTLC,DONE
	XWD	CTLZ,DONE
IDSPLN==.-IDSPTB
	JRST	ARRCK1		;IF WE FALL THRU DISPATCH TABLE

;BREAK CHARACTER DISPATCH TABLE (FOR REAL SCAN)

DISPTB:	XWD	":",COLON
	XWD	".",PER
	XWD	",",COMMR
	XWD	"[",DIR
	XWD	ALTM1,FINA
	XWD	ALTM2,FINA
	XWD	ALTM3,FINA
	XWD	CR,FIN
	XWD	LF,FIN
	XWD	FF,FIN
	XWD	VT,FIN
	XWD	LEFARR,FIN
	XWD	"=",FIN
DISPLN==.-DISPTB
	JRST	SYNTAS		;ILLEGAL CHARACTER

;BUILD NAME IN AC NM

BUILD:	TRZ	F,NCHF
	TRC	CH,40		;CONVERT TO SIXBIT
	TLNE	T,770000	;IS THERE ROOM IN NM?
	IDPB	CH,T		;YES, STORE CHAR IN NM
	JRST	LOOP2		;GO GET NEXT CHAR.
;COLON

COLON:	TRZ	F,NCHF
	TRZN	F,PERF		;PERIOD PREVIOUS BREAK?
	TROE	F,COLONF	;NO, COLON PREVIOUS BREAK?
	JRST	SYNTAS		;YES, SYNTAX ERROR
	ADDI	T,DEVWRD	;NO, STORE DEVICE NAME
	JRST	PER1

;PERIOD

PER:	TRZ	F,NCHF
	TROE	F,PERF		;WAS PERIOD PREVIOUS BREAK?
	JRST	SYNTAS		;YES, SYNTAX ERROR
	ADDI	T,FILWRD	;NO, STORE FILE NAME
PER1:	MOVEM	NM,(T)		;I IN INDEX FIELD
	JRST	LOOP1		;SCAN NEXT SUB FIELD

EOLA:	TRO	F,ALTS		;SET A/M SEEN FLAG
EOL:	TRNE	F,SRC		;IS THIS SOURCE SCAN?
	JRST	LOOPI		;YES, START AT BEGINNING OF LINE
	TRNE	F,ALTS		;NO, WAS A/M SEEN?
	JRST	ALTRTN		;A/M RETURN FOR NO DEST SPEC
	JRST	NTFOND		;NORMAL RETURN FOR NO DEST SPEC

;LEFT SQUARE BRACKET

DIR:	PUSHJ	P,OCTIN		;GET PROJECT NUMBER
	HRLZM	CC,DIRWRD(T)	;STORE AWAY
	CAIE	CH,","		;VERIFY COMMA SEPARATOR
	JRST	SYNTAS		;NO--ERROR
	PUSHJ	P,OCTIN		;GET PROGRAMMER NUMBER
	HRRM	CC,DIRWRD(T)	;STORE AWAY
	CAIL	CH,ALTM1	;SEE IF ALTMODE
	MOVEI	CH,ALTM3	;YES--CHANGE TO ESCAPE
	CAIE	CH,"]"		;VERIFY CORRECT END
	CAIG	CH,40		;NO--CHECK FOR END OF LINE
	JRST	.+2		;YES--OK
	JRST	SYNTAS		;NO--ERROR
	CAIN	CH,"]"		;IF ], THEN
	ILDB	CH,T1		;  GET NEXT CHAR
	JRST	BREAK		;AND CHECK BREAKS

;GET OCTAL NUMBER FROM INPUT

OCTIN:	MOVEI	CC,0		;CLEAR RESULT
OCTIN1:	ILDB	CH,T1		;GET NEXT DIGIT
	CAIL	CH,"0"		;CHECK FOR OCTAL
	CAILE	CH,"7"		; ..
	POPJ	P,		;NO--RETURN AS SEPARATOR
	LSH	CC,3		;MULTIPLY RESULT
	ADDI	CC,-"0"(CH)	;INCREMENT RESULT
	JRST	OCTIN1		;AND GO AROUND LOOP
;CR,LF,FF,VT,ALTMODE,LEFTARROW

FINA:	TROA	F,ALF		;SET ALTMODE SEEN FLAG
FIN:	TRO	F,CRF		;SET OTHER TERMINATOR SEEN FLAG
	TRNE	F,NCHF		;IS TERMINATOR FIRST CHAR OF LINE?
	JRST	LOOP0		;YES,GIVE NOT FOUND RETURN

;COMMA

COMMR:	TRZ	F,NCHF
	SOJG	FC,LOOP0	;IS THIS THE DESIRED FILE FIELD?
	TRNN	F,PERF		;WAS PERIOD PREVIOUS BREAK?
	JRST	STONAM		;NO, STORE FILE NAME
	ADDI	T,EXTWRD	;YES, STORE EXTENSION
	HLLM	NM,(T)
	JRST	OKRET		;OK RETURN TO CALLER

STONAM:	ADDI	T,FILWRD	;STORE FILE NAME
	MOVEM	NM,@T		;I IN INDEX FIELD

OKRET:	AOS	-NOACS(P)	;OK RETURN
NTFOND:	AOS	-NOACS(P)	;NOT FOUND RETURN
ALTRTN:	AOS	-NOACS(P)	;NOT FOUND RETURN - ALTMODE SEEN
SYNTAS:	POP	P,T		;REMOVE INPUT ARG FROM PD LIST
	MOVE	T,SWT		;RETURN SWITCHES IN AC T
	POP	P,SWTBYT	;RESTORE ACS SAVED ON CALL
	POP	P,SWT
	POP	P,CC
	POP	P,FC
	POP	P,NM
	POP	P,F
	POP	P,CH		;RESTORE CH(MATCHES EXCH IN SAVACS)
	POPJ	P,		;RETURN TO CALLER OF DSCAN/SSCAN


;HERE IF ^Z OR ^C TYPED

DONE:	RESET			;RESET I/O
	EXIT	1,		;RETURN TO MONITOR
	JRST	CROSX0		;IF CONT, DO A REENTER
;SLASH - BUILD SWITCH WORD

SLASH:	JSP	CC,STOSWT	;STORE SWITCH CHARACTER
	JRST	LOOP2		;CONTINUE SUBFIELD SCAN

;LEFT PARENTHESIS - BUIILD SWITCHES UNTIL RT PAREN.

LEFPAR:	JSP	CC,STOSWT	;STORE NEXT SWITCH CHARACTER
	JRST	.-1		;STORE SWITCH CHARS. UNTIL )

STOSWT:	ILDB	CH,T1		;GET NEXT CHAR.
	CAIN	CH,")"		;IS IT RIGHT PAREN?
	JRST	LOOP2		;YES, GO GET NEXT CHAR IN MAIN SCAN
	CAIGE	CH,140		;SEE IF LOWER CASE
	TRC	CH,40		;NO, CONVERT TO SIXBIT
	TLNE	SWTBYT,770000	;IS THERE ROOM IN SYTBYT?
	IDPB	CH,SWTBYT	;YES, BUILD SWITCH CHARS.
	JRST	(CC)		;RETURN

;SAVE ACS ROUTINE

SAVACS:	EXCH	CH,(P)		;SAVE CH, GET RETURN
	PUSH	P,F		;SAVE ACS MAY BE REMOVED IF NOT NECESSARY
	PUSH	P,NM
	PUSH	P,FC
	PUSH	P,CC
	PUSH	P,SWT
	PUSH	P,SWTBYT
	PUSH	P,T		;SAVE REL ADR OF OPEN UUO ARRAY (LH)
NOACS==.-SAVACS	;NUMBER OF ACS SAVED
	TLNN	T1,-1		;IS LH OF BYTE POINTER SET?
	HRLI	T1,440700	;NO, FIRST BYTE
	HRRZ	FC,T
	MOVEI	F,0
	MOVEI	SWT,0		;CLEAR SWITCH REGISTER
	JRST	(CH)		;RETURN - MATCHES PUSHJ CALL TO SAVACS
SUBTTL	STORAGE

XLIST	;LITERALS
LIT
LIST

IFN	PURESW,<RELOC>	;SWITCH TO LOW SEG

FWAZER:!		;START OF AREA TO ZERO ON START
MODCNT:	BLOCK	1		;MODULE COUNT (DUMMY NAME) [ED#120]
ASGNT1:	BLOCK	1		;3 WORDS USED BY BLOCK TYPE	[127]
ASGNT2:	BLOCK	1		; 100				[127]
ASGNT3:	BLOCK	1		;				[127]
PDLIST:	BLOCK	PDLEN+1		;PUSH DOWN LIST
OPENO:	BLOCK	10		;OUTPUT OPEN UUO ARRAY
OPENI:	BLOCK	10		;INPUT OPEN UUO ARRAY
OPENCT:	BLOCK	1		;ARGUMENT TO SSCAN
DIGCNT:	BLOCK	1		;DIGIT COUNT FOR OUTPUT
LASTIN:	BLOCK	1		;DEFAULT FILE NAME FOR OUTPUT
SAVREL:	BLOCK	1		;ORIGINAL CORE SIZE		[ED#121]
SAVBG:	BLOCK	1		;FREE STORAGE ORIGIN		[ED#121]
TIBUF:	BLOCK	3		;TTY INPUT BUFFER HEADER
TOBUF:	BLOCK	3		;TTY OUTPUT BUFFER HEADER
IBUF:	BLOCK	3		;SOURCE BUFFER HEADER
OBUF:	BLOCK	3		;DESTINATION BUFFER HEADER
LWAZER==.-1		;END OF AREA TO ZERO ON START
HSHTBL:	BLOCK	50*50		;TABLE OF LETTER CHAIN PTRS
HSHEND==.-1			;TO USE FOR ZEROING HSHTBL	[ED#121]



IFN PURESW,<RELOC>

PATCH:	END	GLOB