00100	COMMENT ⊗   VALID 00005 PAGES VERSION 15-2(1)
00200	RECORD PAGE   DESCRIPTION
00300	 00001 00001
00400	 00002 00002	HISTORY
00500	 00003 00003	↓SEGS←1
00600	 00005 00004	
00700	 00009 00005	SMTAB:	XWD	2,0		BLOCK TYPE (SYMBOLS)
00800	 00010 ENDMK
00900	⊗;
     

00100	COMMENT ⊗HISTORY
00200	AUTHOR,REASON
00300	021  201700000001  ⊗;
00400	
00500	
00600	COMMENT ⊗
00700	VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
00800	
00900	⊗;
     

00100	↓SEGS←1
00200	↓LOWER←0
00300	↓UPPER←1
00400	IFNDEF GLOBSW,<↓GLOBSW←←0>
00500		TITLE UPPER
00600	EXTERNAL MYFIL,SLOF,LOCSM	;PARAMETERS FOR CREATING SEGMENTS
00700	BEGIN UPPER1
00800	
00900	A←1
01000	B←2
01100	C←3
01200	D←4
01300	E←5
01400	
01500	↑UPWRT:	CALLI			;RESET!
01600	UPGOT:	SETZM	FIRLOC+11	;NO 2D SEGMENT SYMBOL TABLE
01700		HLRZ	A,JOBSA		;DELETE SYMBOL TABLE
01800		MOVEI	A,-FIRLOC-1(A)
01900		HRRZM	A,ASIZ		;SIZE OF SEC. SEG. -1
02000		TRO	A,400000	;TURN IT OT.
02100		HRRZM	A,FIRLOC+12	;TOP2 WORD.....
02200	
02300		INIT 1,17
02400		SIXBIT /DSK/		;THE FILE SYSTEM!
02500		0			;NO BUFFERS.
02600		JRST [PRINT	<NO DISK TODAY>
02605		    JRST .+1
02610		    ]
02700		
02800		SETZM	MYFIL+2 ↔ SETZM MYFIL+3
02900	
03000		ENTER	1,MYFIL		;THE VERY SAME.
03100		JRST [PRINT	<NO DISK TODAY>
03105	   	     JRST .+1]
03200	
03300		MOVN	A,ASIZ
03400		HRLI	A,-1(A)		;MAKE UP IOWD.
03500		HRRI	A,FIRLOC-1	;LIKE SO......
03600		MOVEM	A,DUMPR
03700		OUTPUT	1,DUMPR
03800		RELEASE	1,
     

00100	COMMENT ⊗
00200	 THE INTERNAL SYMBOLS FROM THIS UPPER SEGMENT WILL NOW BE
00300	COPIED INTO THE LOWER SEGMENT .REL FILE, TO PROVIDE UPPER/LOWER
00400	LINKAGES.  THIS ELIMINATES THE NEED FOR THE LOADER TO KNOW ANYTHING 
00500	ABOUT STRANGE SAIL UPPER SEGMENTS
00600	⊗
00700	
00800		INIT	1,14		;INPUT
00900		'DSK   '
01000		IBUF
01100		JRST [PRINT	<NO DISK TODAY>
01105		     JRST .+1]
01200		SETZM	SLOF1+2
01300		SETZM	SLOF1+3
01400		LOOKUP	1,SLOF1		;GET SAILOW.REL OR SOMETHING
01500		JRST [PRINT	<WHERE IS LOWER?>
01505		      JRST .+1]
01600		INIT	2,14		;OUTPUT
01700		'DSK   '
01800		XWD	OBUF,0
01900		JRST [PRINT	<NO DISK TODAY>
01905		      JRST .+1]
02000		SETZM	SLOF+2
02100		SETZM	SLOF+3
02200		ENTER	2,SLOF		;PUT SAME
02300		JRST [PRINT	<CAN'T MAKE NEW SAILOW>
02305		     JRST .+1]
02400		HLRE	3,JOBSYM
02500		MOVMS	3
02600		HRRZ	2,JOBSYM
02700		ADD	2,3		;→PAST END OF SYMBOL TABLE
02800		HRRZM	2,JOBFF		;IF NO DDT, LOADER HAS WIPED SYMTAB
02900		INBUF	1,2
03000		OUTBUF	2,2
03100		HLLZS	SMTAB		;SOME INITIALIZATION (NOT MUCH)
03200	FOR II←1,4 <
03300		JSP	1,COPY		;COPY FIRST FOUR WORDS (NAME BLOCK)
03400	>
03500		LSH	3,-1		;#SYMBOLS
03600		MOVE	TEMP,[RADIX50 0,UPPER] ;LOOK FOR THIS PROGRAM
03700	LP1:	CAMN	TEMP,(2)
03800		JRST	LOOP
03900		SUBI	2,2
04000		SOJG	3,LP1
04100		HALT			;DIDN'T FIND IT
04200	LOOP:	SUBI	2,2		;BACK UP ONE ENTRY
04300		JSP	6,COPSYM	;COPY ONE ENTRY IF INTERNAL
04400		SOJG	3,LOOP		;GET ALL OF THEM
04500		JSP	6,FORSYM	;FORCE REMAINING OUT
04600		JSP	1,COPY		;COPY REST OF FILE
04700		JRST	.-1		;WILL NOT RETURN ON EOF
04800	
04900	COPY:	SOSLE	IBUF+2		;INPUT ROUTINE
05000		JRST	OKIN
05100		INPUT	1,0		;SURELY YOU'VE SEEN THESE BEFORE?
05200		STATZ	1,20000		;EOF?
05300		CALLI	12		;YES, DONE
05400		STATZ	1,740000	;ERROR?
05500		JRST [PRINT	<INPUT DATA ERROR IN SAILOW UPDATE>
05505		     JRST .+1]
05600	OKIN:	ILDB	4,IBUF+1	;GET ONE
05700	OUTWD:	SOSG	OBUF+2		;OUTPUT ROUTINE
05800		OUTPUT	2,
05900		IDPB	4,OBUF+1
06000		JRST	(1)
06100	
06200	COPSYM:	LDB	4,[POINT 4,(2),3] ;SYMBOL TYPE
06300		JUMPE	4,1(6)		;ANOTHER PROG, QUIT
06400		SKIPE	LOCSM		;LOAD ALL IF LOCAL SYMBOLS WANTED
06500		 JRST	 ALLTHM
06600		CAIE	4,1		;INTERNAL?
06700		JRST	(6)		;NO
06800		HRRZ	4,1(2)
06900		CAIGE	4,400000	;SECOND SEGMENT SYMBOL?
07000		JRST	(6)		;NO AGAIN
07100	ALLTHM:	AOS	SMTAB		;MAKE ROOM FOR 2
07200		AOS	5,SMTAB
07300		HRRZS	5		;INDEX TO SYMBOL BLOCK
07400		MOVE	4,(2)
07500		MOVEM	4,SMTAB(5)
07600		MOVE	4,1(2)		;MAKE THE TRANSFERS
07700		MOVEM	4,SMTAB+1(5)
07800		CAIGE	5,22		;FULL?
07900		JRST	(6)		;NO, DONE
08000	FORSYM:	HRRZ	5,SMTAB		;GET COUNT
08100		JUMPE	5,(6)		;RETURN IF EMPTY
08200		MOVNI	5,2(5)		;FOR BLOCK TYPE AND RELOC WORDS
08300		HRLS	5		;AOBJN PTR
08400		HRRI	5,SMTAB
08500	OLP:	MOVE	4,(5)		;WORD TO GO OUT
08600		JSP	1,OUTWD		;OUT IT GOES
08700		AOBJN	5,OLP		;GET ALL
08800		HLLZS	SMTAB
08900		JRST	(6)		;THAT'S ALL
     

00100	SMTAB:	XWD	2,0		;BLOCK TYPE (SYMBOLS)
00200		0			;NEVER RELOCATE THESE
00300		BLOCK	22		;ROOM FOR SYMBOLS
00400	
00500	IBUF:	BLOCK	3
00600	OBUF:	BLOCK	3
00700	
00800	;SLOF, MYFIL ARE NOW IN FILE `TAILOR', LOADED AHEAD OF THIS
00900	
01000	SLOF1:	SIXBIT	/LOWER/		;ALWAYS
01100		SIXBIT	/REL/		;LOWER FOR INPUT
01200		0↔0
01300	
01400	DUMPR:	BLOCK	2
01500		ASIZ:	0
01600		AONE:	XWD FIRLOC,400000
01700	
01800		LIT
01900	FIRLOC:
02000	
02100	BEND UPPER1
02200	↓%FIRLOC:
02300	IFE SEG3SW,<
02400	PHASE 400000		;MAGIC ....
02500	>;
02600	IFN SEG3SW,<
02700	PHASE 650000
02800	>;
02900		REPEAT 11,<-1>	;REMAIN COMPATIBLE (?) WITH DEC -- 10 WORD.
03000		0		;400011 -- JOBSYM POINTER.
03100	↓TOP2:	0		;400012 -- TOP SEC SEG ADDRESS.
03200	GLOB <
03300	↓GLBPNT:	0	;400013
03400		BLOCK GLBAR	;400014 -- GLOBAL AREA ..... !!!!
03500	>;GLOB
03600	
03700	INTERNAL %ALLOC
03800