Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-07 - 43,50460/xglob.mac
There are no other files named xglob.mac in the archive.
	TITLE	XGLOB	GENERATE REVERSE GLOBS FOR OVERLAY SETUP %1
	SUBTTL	B. SCHREIBER
	SEARCH	JOBDAT,UUOSYM,MACTEN,SCNMAC
	.DIREC	.XTABM
	SALL

	AC=	0	;TMP
	T1=	1	;ALSO
	T2=	2	;
	T3=	3
	T4=	4
	P1=	5
	P2=	6
	P3=	<N=7>	;NAME SCANNED
	P4=	<C=10>	;LAST CHARACTER
	F=	11	;FLAGS
	B=	12	;CURRENT TITLE BLOCK POINTER
	P=	17	;PUSHDOWN AC

	;FLAGS IN LH OF F

	FL.NAM==(1B0)		;ON WHEN BLOCK TYPE 6 (NAME) SEEN
	FL.SKP==(1B1)		;ON WHEN SKIPING A MULT DEFINED BLOCK
	FL.TTO==(1B2)		;ON IF TTY IS OUTPUT DEVICE
	FL.PP==	(1B3)		;ON FOR PRETTY PRINT (FFEED EVERY 60 LINES)
	FL.FSA==(1B4)		;ON IF FILE SPACE ALLOCATED
;	FL.NAR==(1B5)		;ON IF /NARROW (SET BY SCAN)
	FL.HSE==(1B6)		;ON IF BLOCK 3 (HISEG) SEEN

	OPDEF	CALL	[PUSHJ	P,]
	OPDEF	RETURN	[POPJ	P,]

	SW.LIB==1B18		;THIS IS A LIBRARY
	SW.NAR==1B5		;THIS OUTPUT IS IN NARROW FORMAT
	FL.NAR==SW.NAR		;THE VALUE IN THE FLAG WORD
	.FXLIB==.FXLEN		;-1 IF A LIBRARY FILE
	ND	FTDDT,1		;1 FOR DEBUG FEATURES (SLIM)
	ND	FTCPU,0		;1 TO PRINT CPU PGM WILL RUN ON
	ND	FT2SEG,0	;1 FOR TWOSEGMENT VERSION
	ND	PDSIZ,^D50	;PUSHDOWN LIST LENGTH
	ND	FBLKSZ,.FXLEN+1	;LENGTH OF SCAN FILE BLOCK
				;LAST WORD IS FLAGS
	ND	NIBUF,6		;INPUT BUFFER COUNT
	ND	NOBUF,2		;OUTPUT BUFFER COUNT

	EXT	<.ISCAN,.TSCAN,.TSTRG,.TCHAR,.STOPN,.LKWLD,.MNRET,.TCRLF,
		.SAVE1,.SAVE2,.SAVE3,.SAVE4,.TSPAC,
		.POPJ,.POPJ1,.TSIXN,.TTABC,.TOLEB,.TOCTW,.TYOCH,.TTIME,
		.TTIMN,.TDATE,.TDATN,.FMSG,.FMSGN,.FMSGD,.FMSGO,.FMSGF,
		E.DFL,F.NAM,.TDECW>

	ICH==	1	;INPUT CHANNEL
	OCH==	2	;OUTPUT CHANNEL
	TTY==	3	;CHANNEL FOR BUFFERED TTY OUTPUT

	;VERSION INFORMATION

	XGBWHO==0		;LOCAL UPDATE
	XGBVER==2		;MAJOR VERSION
	XGBMIN==0		;MINOR VERSION
	XGBEDT==4		;EDIT LEVEL

COMMENT	\	REVISION HISTORY
1	CREATION
2	FIX UP F40 SO IT HANDLES MAIN PGMS OK
3	FIX LISTING--GRQ'S MISSING CALL TO INIEGO
2(4)	ADD CODE TO SUPPORT COMMON INFORMATION
	\

IFN FT2SEG,<
	TWOSEG
	RELOC	400000
>
IFE FT2SEG,<
	RELOC	0
>

	LOC	.JBVER
	VRSN.	XGB
	RELOC

DEFINE	SAVE ($X)<
XLIST
IRP $X,<PUSH P,$X>
LIST
>

DEFINE	RESTOR ($X)<
XLIST
IRP $X,<POP P,$X>
LIST
>
	SUBTTL	DEFINE THE DATA STRUCTURE

COMMENT	\THERE ARE TWO TYPES OF DATA STRUCTURES: 1) THE TITLE BLOCK,
	WHICH CONTAINS LINKS TO THE GLOBAL REQUEST LIST AND THE ENTRY
	LIST, AS WELL AS THE FILE SPECIFICATION FOR THE SOURCE OF THIS
	MODULE. 2) ENTRY, GLOBAL REQUEST, LOCAL SYMBOL BLOCK. THESE BLOCKS ARE IN A
	LIST OFF OF THE TITLE BLOCK. EACH LINK CONTAINS NAME, FLAGS, AND
	A FEW POINTERS.

\

;DEFINE THE TITLE BLOCK

PHASE	0

TL$BAK:!			;LH LINK BACKWARDS
TL$NXT:!BLOCK	1		;RH LINK FORWARDS
TL$FLG:!BLOCK	1		;LH COMPILER TYPE AND PROCESSOR CODE
				;RH FLAGS
TL$NAM:!BLOCK	1		;SIXBIT TITLE NAME
TL$ENT:!BLOCK	1		;LH 0, R PTR TO ENTRY LIST
TL$GRQ:!BLOCK	1		;LH 0, RH PTR TO GLBL REQ LIST
TL$SIZ:!BLOCK	1		;LH=HISEG SIZE,RH=LOWSEG SIZE
TL$COM:!BLOCK	1		;LH TOTAL COMMON SIZE, RH PTR TO LIST
TL$DEV:!BLOCK	1		;SIXBIT DEVICE
TL$PPN:!BLOCK	1		;PPN
TL$FIL:!BLOCK	1		;SIXBIT FILENAME
TL$EXT:!			;SIXBIT EXTENSION
TL$END:!
TTLSIZ==TL$END+1		;SIZE OF A TITLE BLOCK
	DEPHASE

;NOW DEFINE THE ENTRY, GLOBAL REQUEST, AND COMMON LISTS

PHASE	0

EG$BAK:!			;LH LINK BACKWARDS
EG$NXT:!BLOCK	1		;RH LINK FORWARDS
EG$FLG:!BLOCK	1		;FLAGS
EG$NAM:!BLOCK	1		;SIXBIT NAME
EG$TTL:!			;RH LINK TO TITLE BLOCK
EG$ORD:!EG$END:!		;LH LINK TO NEXT ENTRY OR GRQ IN ALPHA ORDER
EGLSIZ==EG$END+1		;SIZE OF AN EGR BLOCK
	DEPHASE

;DEFINE THE FLAGS USED IN THESE BLOCKS

FT$LIB==1B18			;ON IF THIS IS FROM A LIBRARY 
FT$REF==1B19			;ON IF THIS LIB MODULE HAS BEEN REFERENCED
FT$SCN==1B20			;THIS LIBRARY MODULE HAS BEEN SCANED
	SUBTTL	MAIN PROGRAM

XGLOB:	TDZA	T1,T1		;NORML ENTRY
	MOVEI	T1,1		;CCL ENTRY
	RESET			;STOP THE WORLD
	MOVEM	T1,OFFSET	;SAVE START OFFSET FOR SCAN
	MOVEM	.SGNAM,SGNAM	;SAVE INITIAL SPECS
	MOVEM	.SGPPN,SGPPN
	MOVEM	.SGDEV,SGDEV
	MOVEM	.SGLOW,SGLOW
	MOVEI	T1,XGLOB2	;RESET START ADDR
	HRRM	T1,.JBSA	;SO ^C START WILL WORK
XGLOB1:	MOVE	P,[IOWD PDSIZ,PDLIST] ;INIT PUSHDOWN LIST
	STORE	T1,F.ZER,L.ZER,0 ;CLEAR CORE

	INIT	TTY,.IOASC	;GET THE TTY FOR OUTPUT
	SIXBIT	/TTY/
	XWD	TOBHR,0
	HALT			;CAN'T HAPPEN!!
	OUTBUF	TTY,2		;SETUP BUFFERS NOW
	OUTPUT	TTY,		;DUMMY OUTPUT
	MOVE	T1,[3,,[0	;ARGBLOCK FOR SCAN -- NO RESCAN
		XWD OFFSET,'XGB';STARTING OFFSET, CCL NAME
		XWD 0,TOCHAR	;DEFAULT INPUT, BUFFERED OUTPUT ROUTINE
		]
		]
	CALL	.ISCAN		;INITIALIZE THE SCANNER
	MOVE	T1,.JBFF	;SAVE INITIAL CORE END
	HRL	T1,.JBREL	;AND END OF CORE
	MOVEM	T1,SAVJFF	;...
	JRST	GBXSCN

XGLOB2:	RESET			;HERE ON ^C START
	JRST	XGLOB1
GBXSCN:	SETZ	F,		;CLEAR THE FLAGS
	CALL	UPSCN		;MAKE SURE HISEG IS THERE
	MOVEI	B,LSTHED	;INITIALIZE THE POINTER
	MOVE	T1,[11,[IOWD GBXSWL,GBXSWN ;ARGBLOCK FOR .TSCAN
		XWD GBXSWD,GBXSWM
		EXP GBXSWP	;POINTER TO SWITCH POINTERS
		EXP	-1	;USE JOB TABLE FOR NAME
		XWD CLRANS,CLRFIL
		XWD ALCIN,ALCOUT
		XWD 0,0		;MEMSTK,APLSTK
		0
		EXP SWTSTO	;STORE SWITCHES
		]
		]
	CALL	.TSCAN		;PARSE A LINE
	IOR	F,FLAGS		;GET THE FLAGS
	CALL	SCNCHK		;LEGALIZE THE SCAN BLOCKS
	SETZM	WLDTMP		;CLEAR TEMP STORE FOR WILD
	MOVEI	T1,O.AREA	;BEGINNING OF OUTPUT SPEC
	MOVEI	T2,OPNBLK	;ADDRESS OF 3 WORD OPEN BLOCK
	MOVE	T3,[.RBSIZ+1,,LKPBLK] ;SIZE,,ADDRESS OF LOOKUP BLOCK
	HLRZM	T3,LKPBLK	;SET SIZE INTO LOOKUP BLOCK
	CALL	.STOPN		;CONVERT SCAN BLOCK TO OPEN/ENTER BLOCK
	 JRST	[MOVE T1,OPNBLK+.OPDEV ;GET DEVICE
		DEVCHR T1,	;FIND WHAT SORT IT IS
		TXNE T1,DV.DIR	;HAVE A DIRECTORY?
		JRST E.WOI	;YES, ERROR THEM
		JRST DOXGLB]	;NO, FORGE AHEAD

DOXGLB:	HLRZ	T1,OPNBLK+.OPDEV;GET THE DEVICE NAME
	CAIN	T1,'TTY'	;TTY IS DIFFERENT
	 JRST	[TLO	F,FL.TTO;YES, OUTPUT TO TTY
		JRST	DOXGL1]	;BUT INPUT IS THE SAME
	MOVEI	T1,.IOASC	;OPEN OUTPUT IN ASCII
	IORM	T1,OPNBLK+.OPMOD
	MOVSI	T1,OUTBHR	;BUFFER HEADER
	MOVEM	T1,OPNBLK+.OPBUF
	OPEN	OCH,OPNBLK	;GET THE DEVICE
	 JRST	E.OPN		;CAN'T
	ENTER	OCH,LKPBLK	;WRITE THE FILE
	 JRST	E.ENT		;CAN'T
	MOVEI	T1,OUTBUF	;SET UP BUFFERS
	EXCH	T1,.JBFF
	OUTBUF	OCH,NOBUF
	MOVEM	T1,.JBFF	;RESTORE JOBFF
;	SETZ	T1,		;GET MY RUNTIME
;	RUNTIM	T1,
;	MOVEM	T1,TIMEON

;HERE TO GET NEXT INPUT FILE

DOXGL1:	CALL	UPSCN		;MAKE SURE SCAN IS THERE
	MOVE	T1,[4,,[INBEG,,INEND ;INPUT START,INPUT END
		OPNBLK,,LKPBLK	;
		FBLKSZ,,.RBSIZ+1;INPUT SIZE,,OUTPUT SIZE
		EXP 1B0+WLDTMP
		]
		]
	CALL	.LKWLD		;FIND A FILE
	 JRST	DOXGLF		;FINISH UP, NO MORE FILES
	HRR	F,WLDTMP	;GET ADDRESS OF CURRENT SCAN BLOCK
	MOVEI	T1,.IOBIN	;DO THE INPUT IN BINARY
	IORM	T1,OPNBLK+.OPMOD
	MOVEI	T1,INPBHR	;INPUT HEADER
	MOVEM	T1,OPNBLK+.OPBUF
	OPEN	ICH,OPNBLK	;OPEN THE DEVICE
	 JRST	E.OPN		;CAN'T
	LOOKUP	ICH,LKPBLK
	 JRST	E.LKP
	MOVEI	T1,INPBUF	;SETUP BUFFERS
	EXCH	T1,.JBFF
	INBUF	ICH,NIBUF
	MOVEM	T1,.JBFF

	CALL	DWNSCN		;DOWN WITH HISEG
	CALL	DOFILE		;PROCESS THE FILE
	JRST	DOXGL1		;DO NEXT FILE

DOXGLF:	CALL	DWNSCN		;.TOUTS IS IN THE LOWSEG
	CALL	LISTIT		;OUTPUT THE LISTING
	TLNE	F,FL.TTO	;IF TTY OUTPUT
	 JRST	XGLF1		;SKIP AHEAD
	MOVEI	T1,.CHFFD	;BOOT TO NEW PAGE AT END
	CALL	OBYTE		;...
	CLOSE	OCH,
	RELEASE	OCH,
XGLF1:	RELEASE	ICH,
;	SETZ	T1,
;	RUNTIM	T1,		;SEE HOW LONG IT TOOK
;	SUB	T1,TIMEON	;IN MILLISECS
;	CALL	.TTIME		;TYPE THE TIME
;	MOVEI	T1,[ASCIZ\ CPU TIME
;\]
;	CALL	.TSTRG		;OUTPUT IT
	JRST	GBXSCN		;NEXT COMMAND
	SUBTTL	SCNCHK VERIFIES SCANNED COMMAND

SCNCHK:	CALL	.SAVE1		;
	MOVEI	T2,O.AREA	;GET POINTER TO OUTPUT SPEC
	MOVSI	T1,'LPT'	;YES, GET DEFAULT DEVICE
	SKIPN	.FXDEV(T2)	;DID USER SPECIFY ONE?
	 MOVEM	T1,.FXDEV(T2)	;NO, USE DEFAULT
	SKIPN	P1,INBEG	;GET ADDRESS OF INPUT SPEC
	 JRST	E.NIS		;WASN'T ANY?
	SKIPN	T1,.FXNAM(P1)	;WAS THERE A NAME?
	 JRST	E.NFI		;NO
	SKIPN	.FXNAM(T2)	;WAS THERE AN OUTPUT NAME?
	 MOVEM	T1,.FXNAM(T2)	;NO, USE FIRST INPUT NAME 
	MOVSI	T1,-1		;SET TO CHECK NAME
	TDNE	T1,.FXEXT(T2)	;WAS EXTENSION GIVEN?
	 JRST	SCNCK1		;YES, DON'T DIDDLE
	MOVE	T4,.FXMOD(T2)	;NO, GET FLAG
	HRLOI	T1,'LST'	;INCASE DEFAULT NEEDED
	TXNE	T4,FX.NUL	;EXPLICITLY NULL?
	 MOVEM	T1,.FXEXT(T2)	;NO, STORE DEFAULT

SCNCK1:	SKIPN	.FXNAM(P1)	;INPUT NAME SPECIFIED?
	 JRST	E.NFI
	MOVSI	T1,-1		;
	TDNE	T1,.FXEXT(P1)	;GIVEN?
	 JRST	SCNCK2		;YES, CHECK NEXT BLOCK
	MOVE	T2,.FXMOD(P1)	;GET FLAGS
	HRLOI	T1,'REL'	;INCASE NEEDED
	TXNE	T2,FX.NUL	;SPECIFICALLY NULL?
	 MOVEM	T1,.FXEXT(P1)	;NO, STORE DEFAULT
SCNCK2:	CAMN	P1,INEND	;DONE SCANNING INPUT BLOCKS?
	 RETURN			;YES
	ADDI	P1,FBLKSZ	;NO, MOVE TO NEXT ONE
	JRST	SCNCK1		;CHECK IT OUT

E.NFI:	M.FAIL	(NULL FILENAME ILLEGAL)
E.WOI:	M.FAIL	(WILD CARD ON OUTPUT ILLEGAL)
E.NIS:	M.FAIL	(NULL INPUT SPEC ILLEGAL)
E.TMO:	M.FAIL	(TOO MANY OUTPUT SPECS)
E.OPN:	MOVE	N,OPNBLK+.OPDEV	;GET DEVICE NAME
	M.FAIN	(OPEN ERROR FOR DEVICE )
E.ENT:	MOVEI	N,O.AREA	;POINT AT THE SPEC
	M.FAIF	(ENTER ERROR FOR )
E.LKP:	CALL	E.DFL
SCNERR:	MOVE	P,[IOWD PDSIZ,PDLIST] ;RESET PDLIST
	CALL	.CLRBF##	;CLEAR THE INPUT TYPE AHEAD
	JRST	GBXSCN		;FORGE ONWARD
	SUBTTL CLRANS/ALCOUT/ALCINP

CLRFIL:	SKIPL	T1,INXTZ	;BLOCK ALLOC?
	 JRST	CLRFL1		;NO
	HRRZS	T1		;YES, CLEAR LH
	HRRZ	T2,SAVJFF	;START OF LIST
	CAMN	T1,T2		;THIS THE FIRST?
	 SETZM	INBEG		;YES, START OVER
	SUBI	T1,FBLKSZ	;COMPUTE END OF CORE
	MOVEM	T1,.JBFF
CLRFL1:	SETZM	INXTZ
	RETURN

CLRANS:
	STORE	T1,SCN.F,SCN.Z,0 ;CLEAR SCANNER INFO
	MOVE	T1,SAVJFF	;RESTORE JOBFF
	HRRZM	T1,.JBFF
	HLRZS	T1		;GET JOBREL BACK
	CAME	T1,.JBREL	;IS IT THE SAME?
	CORE	T1,		;NO, SHRINK IT BACK
	 JFCL			;IGNORE THE ERROR
	RETURN			;BACK TO SCAN

ALCOUT:	MOVEI	T1,O.AREA	;GET ADDRESS
	MOVEI	T2,O.SIZE	;AND SIZE
	SETOM	OUTDON		;FLAG OUTPUT SIDE DONE
	RETURN

ALCIN:	SKIPGE	INXTZ		;FUNNY IN PROGRESS?
	 JRST	ALCIN1		;YES
	MOVEI	T1,FBLKSZ	;SIZE OF BLOCK
	CALL	GETCOR		;GET SOME SPACE
	SKIPN	INBEG		;FIRST ONE?
	 MOVEM	T1,INBEG	;YES, REMEMBER WHERE IT IS
	MOVEM	T1,INEND	;SAVE ADDRESS OF LAST
ALCIN2:	HRR	F,T1		;BLOCK ADDRESS INTO F
	MOVEI	T2,.FXLEN	;RETURN SIZE
	RETURN
ALCIN1:	HRRZS	T1,INXTZ	;CLEAR FUNNY FLAG
	JRST	ALCIN2		;BLOCK IS ALREADY ALLOCATED

SWTSTO:	SKIPL	OUTDON		;GOT OUTPUT?
	 RETURN			;NO,IGNORE
	SKIPE	F.NAM		;GLOBAL SWTCHES?
	 JRST	SWTLOC		;NO
	MOVX	T1,SW.LIB	;YES, GET LIB SWITCH
	IORM	T1,FLAGS
	IORM	T1,FLAGS+1
	RETURN
SWTLOC:	SKIPN	T1,INXTZ	;BLOCK SET UP?
	 JRST	SWTLC1		;NO
SWTLC2:	SETOM	.FXLIB(T1)	;STORE FLAG ON
	RETURN
SWTLC1:	CALL	ALCIN		;GET A BLOCK
	HRROM	T1,INXTZ	;FLAG FUNNY
	JRST	SWTLC2		;GO STORE

;GETCOR
;CALL:	MOVEI  	T1,WORDS
;	CALL	GETCOR
;	*RETURN T1=ADDR OF CORE*

GETCOR:	MOVE	T2,T1		;COPY # WORDS
	MOVE	T1,.JBFF	;GET ADDRESS OF BLOCK
	ADDB	T2,.JBFF	;UPDATE NEW END OF CORE
	CAMG	T2,.JBREL	;OK?
	 RETURN			;YES, IN MY MEMORY
	CORE	T2,		;NO, GET SOME MORE
	 SKIPA			;???CAN'T
	RETURN
	CALL	UPSCN		;SEE ABOUT THE HISEG
	MOVEI	T1,[ASCIZ\?GBXNEC NOT ENOUGH CORE
\]
	CALL	.TSTRG
	CALL	.MNRET
	JRST	.-1		;NO HOPE

IFN FT2SEG,<
	DWNSCN=	.POPJ		;WE'RE UP THERE TOO!
	UPSCN=	.POPJ
>
IFE FT2SEG,<	;ARE WE IN THE LOWSEGMENT?
DWNSCN:	SKIPGE	SCNDWN		;WHERE IS THE LITTLE RASCAL?
	RETURN			;HE WENT AWAY
	MOVSI	T1,1		;STILL HERE,
	CORE	T1,		;BUT THIS SHOULD GET HIM
	RETURN			;DIDN'T? SNH
	SETOM	SCNDWN		;SAY SCAN HAS GONE AWAY
	RETURN			;AND GO AWAY

UPSCN:	SKIPL	SCNDWN		;IS SCAN MISSING?
	 RETURN			;NO, HE'S RIGHT ABOVE ME
	MOVEM	17,SAV17	;SAVE ACS OVER GETSEG UUO
	MOVEI	17,SAV0		;STASH THEM AWAY
	BLT	17,SAV0+16	;...
	MOVE	T1,SGDEV	;GET DEVICE
	MOVEM	T1,SEGBLK	;PUT IN SEG BLOCK
	MOVE	T1,SGNAM	;DITTO FOR THE REST
	MOVEM	T1,SEGBLK+1
	SETZM	SEGBLK+2
	SETZM	SEGBLK+3
	MOVE	T1,SGPPN
	MOVEM	T1,SEGBLK+4
	SETZM	SEGBLK+5
SEGAGN:	MOVEI	T1,SEGBLK
	GETSEG	T1,
	SKIPA
	JRST	[SETZM	SCNDWN
		MOVSI	17,SAV0
		BLT	17,17
		RETURN]
	OUTSTR	[ASCIZ\?XGBNGS CANNOT GET HISEG BACK
\]
	EXIT	1,
	JRST	SEGAGN
SEGBLK:	BLOCK	6	;ARGLIST FOR GETSEG UUUO
SAV0:	BLOCK	20	;SAVE ACS OVER GETSEG UUO
	SAV17=.-1
SCNDWN:	BLOCK	1	;-1 WHEN SCAN HAS TAKEN A VACATION
>;END IFE FT2SEG
	SUBTTL	DO ONE FILE

DOFILE:	CALL	.SAVE2		;NEED P1,P2
	SETZM	HSEGOR		;CLEAR ORIGINS
	SETZM	LSEGOR		;...
	TLZ	F,FL.NAM!FL.SKP!FL.HSE	;CLEAR VITAL FLAGS
FILREAD:JSP	T2,IBYTEJ	;GET NEXT BLOCK TYPE
	HLRZ	P1,T1		;GET BLOCK CODE
	HRRZ	P2,T1		;AND SIZE
	CAIN	P1,14		;IF INDEX BLOCK
	 JRST	RDNDXB		;DO SPECIAL
	CAIE	P1,400		;CHECK FOR F40
	CAIN	P1,401		;OR MANTIS
	 JRST	RDF40		;YES
	MOVSI	T3,-NBLKTY	;AOBJN
	CAME	P1,BLKTYP(T3)	;THIS IT/
	 AOBJN	T3,.-1		;NO, LOOP FOR ALL
	 JUMPGE	T3,FILRD4	;JUMP IF NOT FOUND YET
	JSP	T2,IBYTEJ	;SKIP RELOC WORD
	CAIGE	P1,100		;LEGAL BLOCK TYPE (OLDSTYLE)
	 CALL	COUNT		;YES, GET CORRECT COUNT
	SOJG	P2,@BLKDIS(T3)	;COUNT RELOC WORD AND JUMP OFF
	JRST	FILREAD		;NULL BLOCK (RELOC WORD ONLY)
FILRD4:	CAIL	P1,100		;OLD TYPE LEGAL?
	 JRST	FILRD2		;NO, MUST CHECK SOME MORE
FILRD1:	CALL	COUNT		;COMPUTE CORRECT SIZE
FILRD3:	SOJL	P2,FILREAD	;JUMP IF DONE
	JSP	T2,IBYTEJ
	JRST	FILRD3		;MORE

FILRD2:	CAIL	P1,1000		;IS IT A NEW BLOCK TYPE?
	 CAIL	P1,1777		;...
	  SKIPA			;NO, SEE IF ASCII
	JRST	FILRD3		;YES, SKIP IT
	CAIG	P1,3777		;IS IT ASCII?
	 JRST	E.BLKT		;NO, ILLEGAL TYPE
	JSP	T2,IBYTEJ
	JUMPN	T1,.-2		;WATCH FOR THE 'Z' IN ASCIZ
	JRST	FILREAD		;GET NEXT BLOCK

BLKTYP:	EXP	4		;ENTRY BLOCK
	EXP	1001		;ENTRY BLOCK
	EXP	1002		;LONG ENTRY BLOCK
	EXP	3		;HISEG BLOCK
	EXP	6		;NAME BLOCK
	EXP	1003		;NAME BLOCK
	EXP	2		;SYMBOL
	EXP	20		;COMMON ALLOCATION
	EXP	5		;END BLOCK
	EXP	1040		;END BLOCK
NBLKTY==.-BLKTYP

BLKDIS:	EXP	RDNTRY
	EXP	RDNTRY
	EXP	RDNTRY
	EXP	RDHSEG
	EXP	RDNAME
	EXP	RDNAME
	EXP	RDSYMB
	EXP	RDCOMM
	EXP	RDEND
	EXP	RDEND

IBYTEJ:	CALL	IBYTE		;GET A BYTE
	RETURN			;EOF
	JRST	(T2)		;OK, RETURN

RDNDXB:	HRRZ	T3,T1		;GET SIZE OF BLOCK
	JSP	T2,IBYTEJ	;SKIP ONE
	SOJG	T3,.-1		;SKIP THEM ALL
	JRST	FILREAD		;CONTINUE

RDHSEG:	TLO	F,FL.HSE	;FLAG HISEG SEEN
	JSP	T2,IBYTEJ	;GET HIGH SEG ORIGIN
	SOS	P2		;COUNT HISEG ORIGIN
	SETZM	LSEGOR		;CLEAR IN CASE NONE
	HRRZM	T1,HSEGOR	;SAVE HISEG ORIGIN
	SOJL	P2,FILREAD	;JUMP IF NO 2ND WORD
	JSP	T2,IBYTEJ	;GET LOWSEG ORIGIN
	HRRZM	T1,LSEGOR	;...
	JRST	FILRD3		;CONTINUE

;HERE TO READ COMMON ALLOCATION BLOCK

RDCOMM:	JSP	T2,IBYTEJ	;GET NAME
	SOS	P2
	CALL	R50T6		;CONVERT TO SIXBIT
	CALL	NTRCOM		;ENDTER IN THE LIST
	 JRST	[JSP T2,IBYTEJ	;ALREADY DEFINED IN THIS MODULE
		JRST RDCOM1]	;IGNORE IT
	MOVE	P1,T1		;REMEMBER WHERE BLOCK IS
	JSP	T2,IBYTEJ	;GET SIZE
	HLRZ	T2,TL$COM(B)	;GET TOTAL COMMON ALLOC SO FAR
	ADDI	T2,(T1)		;TOTAL NEW
	HRLM	T2,TL$COM(B)	;SAVE
	HRLM	T1,EG$FLG(P1)	;STORE COMMON ALLOCATION IN COMMON BLOC
RDCOM1:	SOJLE	P2,FILREAD	;EXIT IF ENOUGH
	JRST	RDCOMM		;THERE IS MORE
RDSYMB:	JSP	T2,IBYTEJ	;GET THE SYMBOL
	LDB	T2,[POINT 4,T1,3] ;GET CODE
	CAIE	T2,14		;GLOBAL REQUEST?
	 JRST	RDSYM1		;***NO, IGNORE THIS SYMBOL
	CALL	R50T6		;CONVER TO SIXBIT IN T1
	CALL	NTRGRQ		;ENTER THIS REQUEST INTO THE CHAIN

RDSYM1:	SOJL	P2,FILREAD	;COUNT SYMBOL AND JUMP IF AT END OF BLOCK
	JSP	T2,IBYTEJ	;SKIP VALUE
	SOJG	P2,RDSYMB	;JUMP IF MORE SYMBOLS
	JRST	FILREAD		;NO, READ NEXT BLOCK TYPE

RDEND:	TLZ	F,FL.SKP	;CLEAR SKIP FLAG
	TLZN	F,FL.NAM	;HAVE A NAME BLOCK?
	 JRST	RDEND1		;NO NOT TODAY
	JSP	T2,IBYTEJ	;GET FIRST DATA WORD
	SOS	P2		;COUNT IT
	TLZN	F,FL.HSE	;YES, HAVE A HISEG BLOCK?
	 JRST	RDEND2		;NO, LOWSEG ONLY
	SUB	T1,HSEGOR	;YES, COMPUTE HISEG SIZE
	HRLM	T1,TL$SIZ(B)	;SAVE IN TITLE BLOCK
	SOJL	P2,FILREAD	;JUMP IF DONE
	JSP	T2,IBYTEJ	;GET LOWSEG BREAK
	SUB	T1,LSEGOR	;COMPUTE SIZE
	HRRM	T1,TL$SIZ(B)
RDEND1:	SOJL	P2,FILREAD
	JSP	T2,IBYTEJ	;SKIP ANY LEFT
	JRST	RDEND1

RDEND2:	SUB	T1,LSEGOR	;COMPUTE LOWSEG SIZE
	HRRZM	T1,TL$SIZ(B)	;SAVE
	JRST	RDEND1		;CONTINUE

RDNTRY:	TLNE	F,FL.NAM	;HAVE A TITLE BLOCK?
	 JRST	RDNT1		;YES
	SETZ	T1,		;NO, REQUEST ONE
	CALL	NTRTTL		;WITH NULL NAME
	HALT	.		;DIAGNOSTIC
	TLO	F,FL.NAM	;WE HAVE ONE NOW
RDNT1:	MOVSI	P1,-22		;RELOC WORD EVERY 18
RDNT2:	JSP	T2,IBYTEJ	;GET ENTRY NAME
	CALL	R50T6		;CONVERT TO SIXBIT
	CALL	NTRENT		;PUT IT IN THE LIST OF ENTRIES
	SOJLE	P2,FILREAD	;JUMP IF END OF BLOCK
	AOBJN	P1,RDNT2	;JUMP IF NOT RELOC TIME
	JSP	T2,IBYTEJ	;GET RELOC WORD
	SOJG	P2,RDNT1	;JUMP IF MORE ENTRIES
	JRST	FILREAD		;NO, GET NEXT BLOCK
RDNAME:	JSP	T2,IBYTEJ	;GET THE NAME
	SOS	P2		;COUNT THE NAME
	CALL	R50T6		;CONVERT TO SIXBIT
	TLNN	F,FL.NAM	;ALREADY HAVE TITLE BLOCK?
	 JRST	RDNAM1		;NO, CONTINUE
	SKIPE	TL$NAM(B)	;YES, IS THERE A NAME?
	 HALT			;DIAGNOSTIC
	MOVEM	T1,TL$NAM(B)	;NO, STORE IT
	JRST	RDNAM2		;CONTINUE
RDNAM1:	CALL	NTRTTL		;ENTER IT
	TLO	F,FL.SKP	;ALREADY DEFINED
	TLO	F,FL.NAM	;WE HAVE NAME BLOCK
RDNAM2:	SOJL	P2,FILREAD	;JUMP IS NO FLAG WORD
	JSP	T2,IBYTEJ	;GET FLAG WORD
	HLLM	T1,TL$FLG(B)	;STORE CPU/XLATR FLAGS
	LDB	T2,[POINT 12,T1,17] ;GET XLATOR TYPE
	CAIN	T2,CBLXLT	;IS IT COBOL?
	 JRST	FILRD3		;YES--RH IS SIZE OF STATIC LOW SEG
	HRRZ	P1,T1		;GET POSSIBLE BLANK COMMON ALLOC
	JUMPE	P1,FILRD3	;JUMP IF NONE
	MOVE	T1,[SIXBIT/.COMM./] ;BLANK COMMON NAME
	PUSHJ	P,NTRCOM	;ENTER IT
	 JRST	FILRD3		;??ALREADY DEFINED??
	HRLM	P1,EG$FLG(T1)	;STORE BLANK COMMON SIZE
	HLRZ	T2,TL$COM(B)	;CURRENT SIZE THIS MODULE
	ADDI	T2,(P1)		;ADD NEW
	HRLM	T2,TL$COM(B)	;STORE
	JRST	FILRD3		;CONTINUE

RDF40:	JSP	T2,IBYTEJ	;SKIP OVER CODE
	HLRZ	T2,T1		;[2] GET CODE BITS
	ANDI	T2,770000	;[2] TRIM TO TYPE
	CAIN	T2,40000	;[2] GLOBAL DEFINITION?
	 JRST	[		;[2] YES--ENTER IT
		CALL	R50T6	;[2] CONVERT TO SIXBIT
		CALL	NTRENT	;[2] ENTER THE ENTRY
		JRST	RDF40	;[2] CONTINUE THE  SCAN
		]
	CAME	T1,[-2]		;
	JRST	RDF40		;NOT YYET
	MOVEI	T3,3		;SKIP TWO WORDS
	JSP	T2,IBYTEJ
	SOJG	T3,.-1
	MOVE	T3,T1		;GET LAST WORD
	JUMPE	T3,RDF40A	;JUMP IS NULL SECTION
	JSP	T2,IBYTEJ
	SOJG	T3,.-1

RDF40A:	JSP	T2,IBYTEJ	;GET # GLOBAL REQUESTS
	JUMPE	T1,RDF40C	;JUMP IF NONE
	MOVE	P2,T1		;COPY IT
RDF40B:	JSP	T2,IBYTEJ	;GET SYMBOL
	CALL	R50T6		;CONVERT TO SIXBIT
	CALL	NTRGRQ		;PUT IN GLOBAL REQUEST LIST
	SOJG	P2,RDF40B	;GET ALL OF THEM

RDF40C:	JSP	T2,IBYTEJ	;# WORDS IN SCLAR SECTION
	JUMPE	T1,RDF40D	;JUMP IF NONE
	MOVE	T3,T1		;COPY IT
	JSP	T2,IBYTEJ	;GET ONE
	SOJG	T3,.-1		;SKIP THEM ALL

RDF40D:	JSP	T2,IBYTEJ	;GET # WORDS IN ARRAY SECTION
	JUMPE	T1,RDF40E	;JUMP IF NONE
	MOVE	T3,T1
	JSP	T2,IBYTEJ
	SOJG	T3,.-1

RDF40E:	JSP	T2,IBYTEJ	;NUMBER WORDS IN NEXT SECTION
	JUMPE	T1,RDF40F	;JUMP IF EMPTY
	MOVE	T3,T1
	JSP	T2,IBYTEJ
	SOJG	T3,.-1

RDF40F:	JSP	T2,IBYTEJ	;SKIP A WORD
	JSP	T2,IBYTEJ	;GET # WORDS IN COMMON SECTION
	JUMPE	T1,RDF40G	;JUMP IF NONE
	MOVE	T3,T1
	JSP	T2,IBYTEJ
	SOJG	T3,.-1

RDF40G:	TLZ	F,FL.NAM	;THIS IS THE END
	JRST	FILREAD		;READ NEXT BLOCK

;E.BLKT:	CALL	UPSCN		;PUT SCAN BACK
E.BLKT:	MOVEI	T1,[ASCIZ\%GBXUBA UNKNOWN BLOCK TYPE \]
	CALL	.TSTRG
	MOVE	T1,P1
	CALL	.TOCTW		;TELL WHAT SORT IT IS
	MOVEI	T1,[ASCIZ\, ATTEMPTING RECOVERY
\]
	CALL	.TSTRG
;	CALL	DWNSCN		;MAKE SCAN DISAPPEAR
	JRST	FILRD3		;IGNORE ILLEGAL BLOCK TYPES
;CALL WITH SYMBOL IN T1 IN RADIX 50
;RETURN WITH SIXBIT SYMBOL IN T1
;USES T1-3

R50T6:	TLZ	T1,740000	;CLEAR CODE BITS
	SETZ	T3,		;CLEAR RESULT
;CODED INLINE FOR SPEED
REPEAT	4,<
XLIST
	IDIVI	T1,50		;PEEL OFF A DIGIT
	SKIPE	T2,R50TAB(T2)	;LOAD UP SIXBIT
	LSHC	T2,-6		;ADD INTO T3
	CAIG	T1,50		;DOWN TO LAST DIGIT?
	 JRST	R50T6X		;YES
LIST
>;END REPEAT 4
	IDIVI	T1,50		;GET NEXT TO LAST DIGIT
	SKIPE	T2,R50TAB(T2)	;GET FIFTH CHAR
	LSHC	T2,-6		;STORE IT
R50T6X:	SKIPE	T2,R50TAB(T1)	;ONCE MORE
	LSHC	T2,-6
	MOVE	T1,T3		;POSITION
	RETURN

DEFINE R50 (C)<
XLIST
 IRPC C,<
  ''C''
>
LIST
>

R50TAB:	R50	( 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$% )

;CALL WITH COUNT IN P2
;RETURN WITH CORRECT COUNT (INCLUDING RELOC WORDS IN P2)

COUNT:	HRRZ	T1,P2		;GET COUNT
	IDIVI	T1,22		;COUNT #18 GROUUPS
	ADDI	P2,(T1)		;ONE RELOC WORD FOR EACH
	SKIPE	T2		;ANY STRAGGLERS?
	 AOS	P2		;YES, ONE MORE RELOC WORD
	RETURN			;BACK
	SUBTTL	NTRTTL/NTRGRQ/NTRENT

;NTRTTL
;CALL:	MOVE	T1,SIXBIT NAME
;	CALL	NTRTTL
;	*RETURN IF ALREADY DEFINED*
;	*RETURN THIS DEFINES IT*

NTRTTL:	CALL	IFDFIN		;SEE IF MODULE DEFINED
	AOSA	(P)		;NO, ENTER IT
	RETURN			;YES, RETURN CPOPJ
	SAVE	T1		;SAVE THE SYMBOL
	MOVEI	T1,TTLSIZ	;GET CORE FOR IT
	CALL	GETCOR		;...
	EXCH	B,T1		;SAVE LAST, GET NEW
	SETZM	(B)		;CLEAR THE BLOCK
	MOVSI	T2,(B)
	HRRI	T2,1(B)		;FORM BLT WORD
	BLT	T2,TTLSIZ-1(B)	;CLEAR THE BLOCK
	RESTOR	TL$NAM(B)	;ENTER THE NAME
	MOVE	T2,OPNBLK+.OPDEV;GET THE DEVICE
	MOVEM	T2,TL$DEV(B)	;STORE 
	MOVE	T2,LKPBLK+.RBNAM;FILENAME
	MOVEM	T2,TL$FIL(B)	;
	MOVE	T2,LKPBLK+.RBEXT;EXTENSION
	HLLZM	T2,TL$EXT(B)
	MOVE	T2,LKPBLK+.RBPPN;AND THE PPN
	MOVEM	T2,TL$PPN(B)
	MOVX	T2,FT$LIB	;GET BIT FOR LIBRARY
	SKIPE	.FXLIB(F)	;LIBRARY?
	IORM	T2,TL$FLG(B)	;YES, INDICATE IT
	HRRM	B,(T1)		;STORE LINK TO THIS ONE
	HRLM	T1,(B)		;STORE BACK LINK
	RETURN			;SKIP BACK

;CALL WITH T1 SIXBIT NAME
;SKIP IF TITLE BLOCK DEFINED, NO SKIP IF NOT

IFDFIN:	MOVEI	T2,LSTHED	;START THE SEARCH
IFDF1:	HRRZ	T2,(T2)		;MOVE ALONG THE LIST
	JUMPE	T2,.POPJ	;JUMP IF NOT FOUND
	CAME	T1,TL$NAM(T2)	;IS THIS ME?
	 JRST	IFDF1		;NO, KEEP SEARCHING
	JRST	.POPJ1		;YES, SKIP BACK
;NTRENT TO ENTER AN ENTRY
;NTRGRQ TO ENTER A GLOBAL REQUEST
;NTRLOC TO ENTER A LOCAL SYMBOL (FUTURE)

NTRENT:	TLNE	F,FL.SKP	;IGNORING THIS BLOCK?
	 RETURN
	MOVEI	T2,TL$ENT(B)	;INIT THE POINTER
	CALL	ENTRIT		;PUT IT ON THE LIST
	RETURN			;ALREADY DEFINED
	MOVEI	T2,ENTLST-EG$ORD;POINT AT LIST MINUS OFFSET
	PJRST	ENTSRT		;PUT THIS ENTRY IN THE SORTED LIST NOW

NTRGRQ:	TLNE	F,FL.SKP
	RETURN
	MOVEI	T2,TL$GRQ(B)
	CALL	ENTRIT		;PUT IN THE TABLE
	RETURN			;ALREADY THERE
	MOVEI	T2,GLBLST-EG$ORD;PUT THIS ENTRY IN ALPHA LIST
	PJRST	ENTSRT		;...

NTRCOM:	TLNE	F,FL.SKP	;SKIPPING?
	 RETURN			;YES
	MOVEI	T2,TL$COM(B)	;GET THE LIST
	CALL	ENTRIT		;ENTER COMMON IN THE LIST
	 RETURN			;ALREADY DEFINED
	AOS	(P)
	RETURN			;RETURN WITH ADDR IN T1

;CALL HERE TO PUT ITEM IN THE LIST
;RETURN CPOPJ IF  ALREADY IN
;RETURN CPOPJ1 IN JUST INSERTED WITH PTR IN T1

ENTRIT:	MOVE	T3,T2		;REMEMBER WHERE WE CAME FROM
	HRRZ	T2,(T2)		;GET NEXT
	JUMPE	T2,ENTRT2	;JUMP IF AT END OF LIST
	CAMN	T1,EG$NAM(T2)	;IS THIS IT?
	 RETURN			;YES, RETURN
	CAMLE	T1,EG$NAM(T2)	;NO, SHOULD IT GO IN HERE ALPHABETICALY?
	JRST	ENTRIT		;NO, KEEP LOOKING

ENTRT3:	CALL	ENTRT5		;PUT NAME IN THE CORE WE WILL GET
	MOVE	T2,(T3)		;GET PTR TO NEXT LINK
	HRRM	T2,(T1)		;MAKE THIS ONE POINT AT IT
	HRLM	T3,(T1)		;SET IN THE BACK LINK
	HRLM	T1,(T2)		;SET IN BACK LINK ON NEXT LINK
	HRRM	T1,(T3)		;MAKE PREDECESSOR POINT AT ME
	JRST	ENTRTX		;GO FINISH UP


ENTRT2:	CALL	ENTRT5		;GET CORE AND INSERT NAME
	HRRM	T1,(T3)		;SET THIS LINK INTO TH CHAIN
	HRLZM	T3,(T1)		;SET IN BACK LINK,,CLEAR FORWARD LINK
ENTRTX:	SETZM	EG$FLG(T1)	;CLEAR THE FLAGS
	HRRZM	B,EG$TTL(T1)	;AND POINT TO TITLE BLOCK
	JRST	.POPJ1		;SKIP BACK--WE JUST INSERTED IT

ENTRT5:	SAVE	T1		;SAVE NAME
	MOVEI	T1,EGLSIZ	;GET BLOCK SIZE
	CALL	GETCOR		;GET NEEDED CORE
	RESTORE	EG$NAM(T1)	;PUT THE NAMEIN THE TABLE
	RETURN

;CALL HERE TO ENTER ENTRY OR GLOBAL REF INTO LINKED ALPHABETICAL TABLE
;T1=PTR TO THIS ENTRY
;T2=PTR TO ENTLST OR GLBLST

ENTSRT:
ENTSR2:	MOVE	T3,T2		;SAVE LAST
	HLRZ	T2,EG$ORD(T2)	;GET NEXT
	JUMPE	T2,ENTSR1	;JUMP IF AT END
	MOVE	T4,EG$NAM(T1)	;GET NAME WE ARE AT
	 CAMLE	T4,EG$NAM(T2)	;DOES IT GO IN HERE?
	JRST	ENTSR2		;NO, SEARCH SOME MORE

ENTSR1:	HRLM	T2,EG$ORD(T1)	;SAVE LINK
	HRLM	T1,EG$ORD(T3)	;PUT THIS ONE IN THE LIST
	RETURN
	SUBTTL	LISTING ROUTINES

LISTIT:	CALL	.SAVE4		;MIGHT AS WELL...
	CALL	LINKER		;GO LINK EVERYTHING UP
	MOVEI	B,ENTLST-EG$ORD	;INIT THE PERM POINTER
	TLNE	F,FL.TTO	;OUTPUTTING TO TTY?
	 JRST	LSTIT1		;YES, SKIP AHEAD
	MOVEI	T1,OBYTE	;SET UP OUTPUT ROUTINE
	CALL	.TYOCH		;WITH SCAN
	SAVE	T1		;BUT REMEMBER WHAT IT WAS
	MOVEI	T1,^D60		;SET UP LINES/PAGE
	MOVEM	T1,LINKNT
	TLO	F,FL.PP		;PRETTY PRINT

LSTIT1:	MOVEI	T1,[ASCIZ\XGLOB %\]
	CALL	.TSTRG
	MOVE	T1,.JBVER	;MY VERSION
	CALL	.TVERW##	;TYPE IT
	MOVEI	T1,HEDMSG	;OUTPUT FIRST MESSAGE
	CALL	.TSTRG		;OUTPUT THE HEADER

LSTNXT:	HLRZ	B,EG$ORD(B)	;GET THE NEXT IN THE LIST
	JUMPE	B,LSTDUN	;QUIT AT THE END (AS USUAL)
	HRRZ	P2,EG$TTL(B)	;LINK TO TITLE BLOCK
	MOVE	T1,TL$FLG(P2)	;GET FLAGS
	TRNN	T1,FT$LIB	;IS THIS A LIBRARY
	 JRST	LSTNX1		;NO
	TRNN	T1,FT$REF	;YES, WAS IT REF?
	 JRST	LSTNXT		;NO
	MOVE	T1,EG$FLG(B)	;GET FLAGS FOR THIS ENTRY
	TRNN	T1,FT$REF	;HAS IT BEEN REFERENCED?
	 JRST	LSTNXT		;NO, DON'T PRINT IT
LSTNX1:	SETZ	P4,		;CLEAR COUNT OF REFERENCES TO THIS ENTRY
	MOVE	P3,.JBFF	;REMEMBER THE START OF THE LIST
	CALL	FNDREF		;FIND ALL REFERENCES, MAKE LIST AT END OF CORE
				;POINTING TO TITLE BLOCKS OF REFERENCING MODULS
	MOVEM	P3,.JBFF	;***RESTORE .JBFF  NOW, WHILE WE THINK OF IT
;	HRRZ	P2,EG$TTL(B)	;GET LINK TO TITLE BLOCK
;	MOVE	T1,TL$FLG(P2)	;GET THE FLAGS
;	TRNE	T1,FT$LIB	;IS THIS A LIBRARY?
;	 JUMPE	P4,LSTNXT	;YES, AND IF WE JUMP IT WAS NEVER REFERENCED
	CALL	LSTENT		;NO, LIST THIS ENTRY
	JRST	LSTNXT		;AND GO ON TO THE NEXT ONE
LSTDUN:	TLNE	F,FL.TTO	;TTY OUTPUT?
	 RETURN			;YES, ALLDONE
	RESTOR	T1		;GET TYPEOUT ADDRESS BACK
	PJRST	.TYOCH		;RESTORE AND RETURN
LINKER:	MOVEI	B,LSTHED ;POINT AT TITLE LIST
LINK1:	HRRZ	B,(B)		;LINK TO NEXT
	JUMPE	B,LINK2		;JUMP IF DONE WITH PHASE ONE
	MOVE	T1,TL$FLG(B)	;NO, GET FLAGS
	TRNE	T1,FT$LIB	;LIBRARY?
	 JRST	LINK1		;YES, IGNORE IT
	MOVEI	P1,TL$GRQ(B)	;NO, POINT AT GLOBAL REQUEST LIST
	CALL	LNKSAT		;FLAG ALL MODULES THAT SATISFY GLB REQ
	JRST	LINK1		;DO ALL NON-LIB MODULES

LINK2:	MOVEI	B,LSTHED	;NOW DO ALL LIBRARY MODULES
	SETZM	FOUND1		;CLEAR THE FLAG TO GO AGAIN
LINK3:	HRRZ	B,(B)		;CHAIN TO NEXT
	JUMPE	B,LINK4		;JUMP AT THE END
	MOVE	T1,TL$FLG(B)	;GET THE FLAGS
	TRNE	T1,FT$LIB	;IS IT A LIBRARY?
	 TRNN	T1,FT$REF	;YES, HAS IT BEEN REFERENCED?
	  JRST	LINK3		;NO TO ONE OF ABOVE
	TRNE	T1,FT$SCN	;BEEN SCANED YET/
	 JRST	LINK3		;YES, ONLY DO IT ONCE
	MOVEI	P1,TL$GRQ(B)	;NO, GET GRQ LIST
	CALL	LNKSAT		;FIND SATISFYING MODULES
	JRST	LINK3

LINK4:	SKIPE	FOUND1		;DO ANYTHING?
	 JRST	LINK2		;YES, GO AGAIN
	RETURN			;NO, RETURN

LNKSAT:
LSAT1:	HRRZ	P1,(P1)		;MOVE ALONG GRQ LIST
	JUMPE	P1,.POPJ	;RETURN ON NULL
	MOVE	T4,EG$NAM(P1)	;GET THE NAME
	MOVEI	T3,LSTHED	;POINT AT THE LIST
LSAT2:	HRRZ	T3,(T3)		;CHAIN TO NEXT
	JUMPE	T3,LSAT1	;FINISED?
	MOVE	T2,TL$FLG(T3)	;NO, GET FLAGS
	TRNE	T2,FT$LIB	;LIBRARY?
	 TRNE	T2,FT$REF	;YES, REFERENCED?
	 JRST	LSAT2		;NOT LIB OR ALREADY REF
	MOVEI	T2,TL$ENT(T3)	;POINT AT ENTRY LST
LSAT3:	HRRZ	T2,(T2)		;LINK TO NEXT
	JUMPE	T2,LSAT2	;JUMP ON END
	CAME	T4,EG$NAM(T2)	;ENTRY SATISFY GRQ?
	 JRST	LSAT3		;NO
	MOVEI	T1,FT$REF	;YES, GET FLAG BIT
	IORM	T1,TL$FLG(T3)	;FLAG IN TITLE BLOCK
	IORM	T1,EG$FLG(T2)	;SET ENTRY ENTRY REFERENCED
	MOVEI	T2,FT$SCN	;GET SCANNED FLAG
	IORM	T2,TL$FLG(P1)	;FLAG THIS BLOCK SCANNED
	SETOM	FOUND1		;FLAG TO GO AGAIN
	JRST	LSAT2		;FIND MORE
;CALL HERE TO LIST ONE ENTRY

LSTENT:	CALL	.TCRLF		;START WITH NEW LINE
	MOVEI	T1,STARS	;START OUT WITH SOME STARS
	CALL	.TSTRG
	MOVE	T1,EG$NAM(B)	;GET THE NAME
	CALL	.TSIXN		;OUTPUT IT
	MOVEI	T1,STARS	;MORE STARS
	CALL	.TSTRG
	MOVEI	T1,[ASCIZ\
FOUND IN \]
	CALL	.TSTRG
	CALL	LISFLS		;OUTPUT THE FILE SPEC
	MOVEI	T1,[ASCIZ\, MODULE \]
	CALL	.TSTRG
	MOVE	T1,TL$NAM(P2)	;THE MODULE NAME
	CALL	.TSIXN
	MOVEI	T1,[ASCIZ\, COMPILED BY \]
	CALL	.TSTRG
	LDB	T1,[POINT 12,TL$FLG(P2),17] ;COMPILER VALUE
	CAILE	T1,MXLATR	;CHECK FOR ONE WE KNOW
	MOVEI	T1,0		;NO, USE ???
	MOVE	T1,XLATOR(T1)	;GET STRING ADDRESS
	CALL	.TSTRG
IFN FTCPU,<
	MOVEI	T1,[ASCIZ\ FOR \]
	CALL	.TSTRG
	LDB	T1,[POINT 6,TL$FLG(P2),5] ;CPU IT WILL RUN ON
	CAILE	T1,MAXCPU
	MOVEI	T1,0		;MUST BE KL
	MOVE	T1,CPUTYP(T1)
	CALL	.TSTRG
>;END IFN FTCPU
	CALL	.TCRLF		;NEXT LINE
	MOVEI	T1,[ASCIZ\MODULE SIZE IS \]
	CALL	.TSTRG		;TELL THE SIZZE
	HLRZ	T1,TL$SIZ(P2)	;GET HISEG SIZE
	JUMPE	T1,LSTEN1	;JUMP IF NO HISEG
	CALL	TOCDEC		;TYPE OCTAL AND DECIMAL
	MOVEI	T1,[ASCIZ\ [HISEG] \]
	CALL	.TSTRG
LSTEN1:	HRRZ	T1,TL$SIZ(P2)
	CALL	TOCDEC
	MOVEI	T1,[ASCIZ\ [LOWSEG] \]
	CALL	.TSTRG
	HLRZ	T1,TL$COM(P2)	;GET COMMON ALLOCATION
	JUMPE	T1,[CALL .TCRLF	;JUMP IF NONE
		JRST LSTEN2]	;AND CONTINUE
	CALL	TOCDEC		;TYPE THE SIZE
	MOVEI	T1,[ASCIZ\ [COMMON]
\]
	CALL	.TSTRG		;
LSTEN2:	CALL	LSENTR		;LIST ENTRY POINTS
	CALL	LSGRQ		;LIST GLOBAL REQUESTS
	CALL	LSTCOM		;LIST COMMON ALLOCATION THIS MODULE
	CALL	LISREF		;LIST REFERENCES TO THIS ENTRY POINT
	RETURN			;***END LIST ONE ENTRY

STARS:	ASCIZ	\***\		;PRETTY!
HEDMSG:	ASCIZ	\

E - ENTRY POINTS INTO THE MODULE
G - GLOBAL REFERENCES
C - COMMON DECLARED IN THIS MODULE
    NOTE: COMMON LENGTH NOT INCLUDED IN MODULE SIZE
R - MODULES THAT REFERENCE THIS ONE

\
DEFINE P(A)<[ASCIZ\'A\]>

XLATOR:	P UNKNOWN
	P F40
	P COBOL
CBLXLT==.-XLATOR-1	;COBOL COMPILER TYPE
	P ALGOL-60
	P NELIAC
	P PL/1
	P BLISS-10
	P SAIL
	P FORTRAN-10
	P MACRO
	P FAIL
MXLATR==.-XLATOR

IFN FTCPU,<
CPUTYP:	P <EITHER CPU>
	P <KA10 CPU>
	P <KI10 CPU>
MAXCPU==.-CPUTYP
>;END IFN FTCPU

LISFLS:	MOVEI	T2,TL$PPN-.RBPPN(P2) ;FAKE OUT .TOLEB A BIT
	MOVEI	T1,TL$DEV-.OPDEV(P2) ;AND SOME MORE TRICKERY
	PJRST	.TOLEB		;GO TYPE THE FILE SPEC

FNDREF:	MOVEI	T3,GLBLST-EG$ORD ;INIT THE POINTER
FNDRF1:	MOVE	T4,EG$NAM(B)	;GET NAME WE ARE LOOKING FOR
FNDNXT:	HLRZ	T3,EG$ORD(T3)	;NEXT LINK
	JUMPE	T3,.POPJ	;EXIT ON NULL LINK
	CAME	T4,EG$NAM(T3)	;FIND IT?
	 JRST	FNDNXT		;NO, KEEP LOOKING
	HRRZ	P1,EG$TTL(T3)	;GET LINK TO TITLE BLOCK
	MOVE	T1,TL$FLG(P1)	;GET THE FLAGS
	TRNN	T1,FT$LIB	;IS THIS A LIBRARY?
	 JRST	FNDRF3		;NO, GO AHEAD
	TRNN	T1,FT$REF	;YES, HAS IT BEEN REFERENCED ?
	 JRST	FNDNXT		;NO, MOVE ALONG
FNDRF3:	JUMPE	P4,FNDRF2	;JUMP IF THIS IS THE FIRST
	MOVN	T4,P4		;NO, GET - COUNT OF REFERENCES
	HRLZS	T4		;POSITION IN LH
	HRR	T4,P3		;POINT AT THE LIST ON THE END OF CORE
	CAME	P1,(T4)		;IS THIS IT (ALREADY REQUESTED?)
	AOBJN	T4,.-1		;NO, LOOP FOR ALL
	JUMPL	T4,FNDRF1	;JUMP IF WE FOUND ONE
	MOVE	T4,EG$NAM(B)	;NO, RESTORE THE NAME
FNDRF2:	MOVEI	T1,1		;ADD 1 TO THE LIST
	CALL	GETCOR		;WHICH ALSO DESTROYS T2
	MOVEM	P1,(T1)		;STORE ON LIST AT END OF CORE
	AOJA	P4,FNDNXT	;COUNT AND GO FOR MORE
LSENTR:	MOVEI	T1,[ASCIZ\E	\] ;START THE LINE
	CALL	.TSTRG
	MOVEI	P1,TL$ENT(P2)	;LINK TO ENTRYS
LSEGGO:	CALL	INIEGO		;INITIALIZE THE FORMATTER

LSENXT:	HRRZ	P1,(P1)		;GET THE NEXT ONE
	JUMPE	P1,.TCRLF	;QUIT ON NULL
	MOVE	T1,EG$NAM(P1)	;GET THE NAME
	CALL	.TSIXN		;TYPE IT
	SOSG	MODKNT		;CHECK IF TIME FOR NEW LINE
	JRST	[CALL	.TCRLF	;YES, FORCE ONE
		CALL	INIEGO	;INIT THE NEW LINE
		HRRZ	T1,(P1)	;GET LINK TO NEXT
		JUMPE	T1,.POPJ;JUMP IF NO MORE TO PRINT
		JRST	.+1]	;YES, TAB OVER AND CONTINUE
	CALL	.TTABC		;MOVE TO NEXT TAB STOP
	JRST	LSENXT		;LIST NEXT ENTRY

LSGRQ:	MOVEI	T1,[ASCIZ\G	\] ;START FOR GLOBAL REQUESTS
	CALL	.TSTRG
	MOVEI	P1,TL$GRQ(P2)	;LINK TO GLOBAL REQUESTS
	JRST	LSEGGO		;[3] GO DO IT

LISREF:	JUMPN	P4,LISRF1	;CHECK FOR NEVER REFERENCED
	MOVEI	T1,[ASCIZ\NEVER REFERENCED
\]
	PJRST	.TSTRG		;OUTPUT AND RETURN
LISRF1:	MOVEI	T1,[ASCIZ\R	\] ;START THE LINE
	CALL	.TSTRG
	CALL	INIRFL		;INIT FOR TYPEOUT
LISRF2:	MOVE	P2,(P3)		;GET THE POINTER TO TITLE BLOCK
	CALL	LISFLS		;OUTPUT THE NAME
	CALL	.TSLSH		;AND A SLASH
	MOVE	T1,EG$NAM(P2)	;GET THE MODULE NAME
	CALL	.TSIXN		;OUTPUT IT
	CALL	.TSLSH		;ANOTHER SLASH
	SOSG	MODKNT		;CHEK IF END OF LINE
	JRST	[CALL	.TCRLF	;YES, NEW LINE
		SOJLE	P4,.POPJ;RETURN IF DONE
		CALL	INIRFL	;INIT FOR A NEW LINE
		CALL	.TTABC	;ELSE, SPACE OVER
		AOJA	P3,LISRF2] ;AND CONTINUE
	CALL	.TTABC		;SPACE OVER
	SOJLE	P4,.TCRLF	;QUIT WHEN DONE
	AOJA	P3,LISRF2	;NO, BUMP POINTER AND GET NEXT

.TSLSH:	MOVEI	T1,"/"
	PJRST	.TCHAR

TOCDEC:	SAVE	T1		;SAVE THE NUMBER
	CALL	.TOCTW		;TYPE OCTAL
	MOVEI	T1,[ASCIZ\ (\]
	CALL	.TSTRG
	RESTORE	T1		;GET NUMBER BACK
	CALL	.TDECW		;TYPE DECIMAL
	MOVEI	T1,[ASCIZ\.) \]
	PJRST	.TSTRG		;OUTPUT AND RETURN

INIEGO:	MOVEI	T1,^D15		;PUT 15 ENTRIES AND GLBREQ / LINE
	TXNE	F,FL.NAR	;/NARROW?
	MOVEI	T1,^D8		;THEN ONLY 8
	MOVEM	T1,MODKNT	;STORE
	RETURN

INIRFL:	MOVEI	T1,3		;THREE ACROSS
	TXNE	F,FL.NAR	;IF /NAROW
	MOVEI	T1,2		;THEN ONLY 2
	MOVEM	T1,MODKNT
	RETURN

;HERE TO LIST COMMON DECLARED HERE

LSTCOM:	HLRZ	T1,TL$COM(P2)	;SEE IF ANY
	JUMPE	T1,.POPJ	;JUMP IF NOT
	MOVEI	T1,[ASCIZ\C	\] ;START THE LINE
	CALL	.TSTRG
	MOVEI	P1,TL$COM(P2)	;INIT THE PTR
	CALL	INIRFL		;INIT THE FORMATTER
COMNXT:	HRRZ	P1,(P1)		;GET NEXT
	JUMPE	P1,.TCRLF	;QUIT ON NULL
	CALL	.TSLSH		;SLASH
	MOVE	T1,EG$NAM(P1)	;THE NAME
	CALL	.TSIXN		;OUTPUT IT
	CALL	.TSLSH		;SLASH
	CALL	.TSPAC		;SPACE
	HLRZ	T1,EG$FLG(P1)	;SIZE
	CALL	TOCDEC		;LIST IT
	SOSG	MODKNT		;CHECK FOR NEW LINE
	JRST	[CALL	.TCRLF	;YES
		CALL	INIRFL
		HRRZ	T1,(P1)	;SEE IF ANOTHER
		JUMPE	T1,.POPJ;JUMP IF AT END
		CALL	.TTABC	;TAB OVER
		JRST	.+1]	;NO--FORGE ON
	CALL	.TSPAC		;SPACE OVER
	JRST	COMNXT		;CONTINUE
	SUBTTL I/O ROUTINES

;CALL WITH T1 ASCII BYTE FOR OUTPUT

OBYTE:	SOSG	OUTBHR+2	;ROOM?
	 JRST	OBYBUF		;NO
OBYTE1:	IDPB	T1,OUTBHR+1
	TLNE	F,FL.PP		;PRETTY PRINT?
	CAIN	T1,.CHLFD	;YES--IS THIS  A LINEFFEED?
	 SOSLE	LINKNT		;YES--TIME TO FORMFEED?
	  RETURN		;NOT A LINEFEED OR NOT TIME
	MOVEI	T1,^D60		;YES, RESET THE COUNTER
	MOVEM	T1,LINKNT	;...
	MOVEI	T1,.CHFFD	;GET A FORMFEED
	JRST	OBYTE		;AND SEND IT
;	AOS	BYTCNT		;COUNT FOR FORMATTING
	RETURN
OBYBUF:	OUT	OCH,
	JRST	OBYTE1		;NO ERRORS
	JRST	OBYTE1		;***FIXUP LATER

;CALL HERE TO GET 36-BIT BYTE INTO T1
;SKIP RETURN WITH THE BYTE, OR CPOPJ IF EOF

IBYTE:	SOSGE	INPBHR+2	;ANYTHING THERE/
	 JRST	IBYTEN		;NO
	ILDB	T1,INPBHR+1
	AOS	(P)
	RETURN
IBYTEN:	IN	ICH,		;GET NEW BUFFER
	 JRST	IBYTE		;OK, GO GET DATA
	GETSTS	ICH,T1		;OOPS, GET STATUS BITS
	SAVE	T1		;REMEMBER THEM
	TXZ	T1,IO.ERR	;CLEAR ERROR BITS
	SETSTS	ICH,(T1)	;CLEAR WITH MON
	RESTOR	T1		;GET BITS BACK
	TXNN	T1,IO.EOF	;END OF FILE?
	 JRST	IBYTE		;NO, GO PROCESS DATA
	RETURN			;YES, POPJ BACK

;CALL WITH CHAR FOR TTY OUTPUT IN T1

TOCHAR:	SOSG	TOBHR+2		;ROOM?
	OUTPUT	TTY,		;NO, BOOT THE BUFFER
	IDPB	T1,TOBHR+1	;STORE IN THE BUFFER
;	AOS	BYTCNT		;COUNT FOR FORMATTING
	CAIN	T1,.CHLFD	;IF A LINEFEED
	OUTPUT	TTY,		;OUTPUT IT ANYWAY
	RETURN
	SUBTTL	SCAN SWITCH TABLES

DEFINE SWTCHS,<
SS	*LIBRAR,.FXLIB,1
SN	*NARROW,<POINTR(FLAGS,SW.NAR)>,FS.NUE
>

DOSCAN (GBXSW)
	SUBTTL	STORAGE

IFN FT2SEG,<RELOC>

SGNAM:	BLOCK	1		;SAVE-GET ARGS
SGPPN:	BLOCK	1
SGDEV:	BLOCK	1
SGLOW:	BLOCK	1
PDLIST:	BLOCK	PDSIZ		;PUSHDOWN LIST
SAVJFF:	BLOCK	1		;ORIG. .JBFF
OFFSET:	BLOCK	1		;START OFFSET FOR CCL
F.ZER==.
OUTBHR:	BLOCK	3		;OUTPUT BUFFER HEADER
INPBHR:	BLOCK	3		;INPUT BUFFER HEADER
LKPBLK:	BLOCK	.RBSIZ+1	;EXTENDED LOOKUP BLOCK
WLDTMP:	BLOCK	1		;WILD STORES CURRENT BLOCK ADR HERE
OPNBLK:	BLOCK	3		;DEVICE OPEN BLOCK
OUTBUF:	BLOCK	203*NOBUF	;OUTPUT BUFFERS
INPBUF:	BLOCK	203*NIBUF	;INPUT BUFFERS
BYTCNT:	BLOCK	1		;REGISTER FOR FORMATTING OUTPUT
LINKNT:	BLOCK	1		;COUNTER FOR LINES/PAGE
MODKNT:	BLOCK	1		;NO. MODULES /LINE
TIMEON:	BLOCK	1		;FOR COUNTING CPU USAGE
FOUND1:	BLOCK	1		;-1 IF NEED ANOTHER PASS IN LINKER
LSEGOR:	BLOCK	1		;LOWSEG ORIGIN
HSEGOR:	BLOCK	1		;HISEG ORIGIN

SCN.F==.			;START OF SCAN INFO AREA
FLAGS:	BLOCK	2		;PERMANENT FLAGS DURING SCAN
O.AREA:	BLOCK	.FXLEN		;OUTPUT SPEC SIZE
	O.SIZE==.FXLEN
SWTWRD:	BLOCK	2		;SWITCH STORE AREA
INBEG:	BLOCK	1		;ADDRESS OF START OF INPUT SPECS
INEND:	BLOCK	1		;ADDRESS OF LAST INPUT SPEC
INXTZ:	BLOCK	1		;CURRENT BLOCK
LSTHED:	BLOCK	1		;POINTER TO FIRST TITLE BLOCK
ENTLST:	BLOCK	1		;POINTER TO SORTED ENTRY LIST
GLBLST:	BLOCK	1		;POINTER TO SORTED GLOBAL LIST
OUTDON:	BLOCK	1		;OUTPUT HAS BEEN SETUP
SCN.Z==.-1			;END OF SCANINFO AREA

TOBHR:	BLOCK	3		;TTY OUTPUT BUFFER HEADER
L.ZER==.-1

	END	XGLOB