perm filename UP[S,AIL]1 blob sn#000827 filedate 1972-09-22 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00005 PAGES VERSION 15-2(1)
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	HISTORY
 00003 00003	↓SEGS←1
 00005 00004	
 00009 00005	SMTAB:	XWD	2,0		BLOCK TYPE (SYMBOLS)
 00010 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  201700000001  ⊗;


COMMENT ⊗
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

⊗;
↓SEGS←1
↓LOWER←0
↓UPPER←1
IFNDEF GLOBSW,<↓GLOBSW←←0>
	TITLE UPPER
EXTERNAL MYFIL,SLOF,LOCSM	;PARAMETERS FOR CREATING SEGMENTS
BEGIN UPPER1

A←1
B←2
C←3
D←4
E←5

↑UPWRT:	CALLI			;RESET!
UPGOT:	SETZM	FIRLOC+11	;NO 2D SEGMENT SYMBOL TABLE
	HLRZ	A,JOBSA		;DELETE SYMBOL TABLE
	MOVEI	A,-FIRLOC-1(A)
	HRRZM	A,ASIZ		;SIZE OF SEC. SEG. -1
	TRO	A,400000	;TURN IT OT.
	HRRZM	A,FIRLOC+12	;TOP2 WORD.....

	INIT 1,17
	SIXBIT /DSK/		;THE FILE SYSTEM!
	0			;NO BUFFERS.
	PRINT	<NO DISK TODAY>
	
	SETZM	MYFIL+2 ↔ SETZM MYFIL+3

	ENTER	1,MYFIL		;THE VERY SAME.
	PRINT	<NO DISK TODAY>

	MOVN	A,ASIZ
	HRLI	A,-1(A)		;MAKE UP IOWD.
	HRRI	A,FIRLOC-1	;LIKE SO......
	MOVEM	A,DUMPR
	OUTPUT	1,DUMPR
	RELEASE	1,
COMMENT ⊗
 THE INTERNAL SYMBOLS FROM THIS UPPER SEGMENT WILL NOW BE
COPIED INTO THE LOWER SEGMENT .REL FILE, TO PROVIDE UPPER/LOWER
LINKAGES.  THIS ELIMINATES THE NEED FOR THE LOADER TO KNOW ANYTHING 
ABOUT STRANGE SAIL UPPER SEGMENTS
⊗

	INIT	1,14		;INPUT
	'DSK   '
	IBUF
	PRINT	<NO DISK TODAY>
	SETZM	SLOF1+2
	SETZM	SLOF1+3
	LOOKUP	1,SLOF1		;GET SAILOW.REL OR SOMETHING
	PRINT	<WHERE IS LOWER?>
	INIT	2,14		;OUTPUT
	'DSK   '
	XWD	OBUF,0
	PRINT	<NO DISK TODAY>
	SETZM	SLOF+2
	SETZM	SLOF+3
	ENTER	2,SLOF		;PUT SAME
	PRINT	<CAN'T MAKE NEW SAILOW>
	HLRE	3,JOBSYM
	MOVMS	3
	HRRZ	2,JOBSYM
	ADD	2,3		;→PAST END OF SYMBOL TABLE
	HRRZM	2,JOBFF		;IF NO DDT, LOADER HAS WIPED SYMTAB
	INBUF	1,2
	OUTBUF	2,2
	HLLZS	SMTAB		;SOME INITIALIZATION (NOT MUCH)
FOR II←1,4 <
	JSP	1,COPY		;COPY FIRST FOUR WORDS (NAME BLOCK)
>
	LSH	3,-1		;#SYMBOLS
	MOVE	TEMP,[RADIX50 0,UPPER] ;LOOK FOR THIS PROGRAM
LP1:	CAMN	TEMP,(2)
	JRST	LOOP
	SUBI	2,2
	SOJG	3,LP1
	HALT			;DIDN'T FIND IT
LOOP:	SUBI	2,2		;BACK UP ONE ENTRY
	JSP	6,COPSYM	;COPY ONE ENTRY IF INTERNAL
	SOJG	3,LOOP		;GET ALL OF THEM
	JSP	6,FORSYM	;FORCE REMAINING OUT
	JSP	1,COPY		;COPY REST OF FILE
	JRST	.-1		;WILL NOT RETURN ON EOF

COPY:	SOSLE	IBUF+2		;INPUT ROUTINE
	JRST	OKIN
	INPUT	1,0		;SURELY YOU'VE SEEN THESE BEFORE?
	STATZ	1,20000		;EOF?
	CALLI	12		;YES, DONE
	STATZ	1,740000	;ERROR?
	PRINT	<INPUT DATA ERROR IN SAILOW UPDATE>
OKIN:	ILDB	4,IBUF+1	;GET ONE
OUTWD:	SOSG	OBUF+2		;OUTPUT ROUTINE
	OUTPUT	2,
	IDPB	4,OBUF+1
	JRST	(1)

COPSYM:	LDB	4,[POINT 4,(2),3] ;SYMBOL TYPE
	JUMPE	4,1(6)		;ANOTHER PROG, QUIT
	SKIPE	LOCSM		;LOAD ALL IF LOCAL SYMBOLS WANTED
	 JRST	 ALLTHM
	CAIE	4,1		;INTERNAL?
	JRST	(6)		;NO
	HRRZ	4,1(2)
	CAIGE	4,400000	;SECOND SEGMENT SYMBOL?
	JRST	(6)		;NO AGAIN
ALLTHM:	AOS	SMTAB		;MAKE ROOM FOR 2
	AOS	5,SMTAB
	HRRZS	5		;INDEX TO SYMBOL BLOCK
	MOVE	4,(2)
	MOVEM	4,SMTAB(5)
	MOVE	4,1(2)		;MAKE THE TRANSFERS
	MOVEM	4,SMTAB+1(5)
	CAIGE	5,22		;FULL?
	JRST	(6)		;NO, DONE
FORSYM:	HRRZ	5,SMTAB		;GET COUNT
	JUMPE	5,(6)		;RETURN IF EMPTY
	MOVNI	5,2(5)		;FOR BLOCK TYPE AND RELOC WORDS
	HRLS	5		;AOBJN PTR
	HRRI	5,SMTAB
OLP:	MOVE	4,(5)		;WORD TO GO OUT
	JSP	1,OUTWD		;OUT IT GOES
	AOBJN	5,OLP		;GET ALL
	HLLZS	SMTAB
	JRST	(6)		;THAT'S ALL
SMTAB:	XWD	2,0		;BLOCK TYPE (SYMBOLS)
	0			;NEVER RELOCATE THESE
	BLOCK	22		;ROOM FOR SYMBOLS

IBUF:	BLOCK	3
OBUF:	BLOCK	3

;SLOF, MYFIL ARE NOW IN FILE `TAILOR', LOADED AHEAD OF THIS

SLOF1:	SIXBIT	/LOWER/		;ALWAYS
	SIXBIT	/REL/		;LOWER FOR INPUT
	0↔0

DUMPR:	BLOCK	2
	ASIZ:	0
	AONE:	XWD FIRLOC,400000

	LIT
FIRLOC:

BEND UPPER1
↓%FIRLOC:
PHASE 400000		;MAGIC ....
	REPEAT 11,<-1>	;REMAIN COMPATIBLE (?) WITH DEC -- 10 WORD.
	0		;400011 -- JOBSYM POINTER.
↓TOP2:	0		;400012 -- TOP SEC SEG ADDRESS.
GLOB <
↓GLBPNT:	0	;400013
	BLOCK GLBAR	;400014 -- GLOBAL AREA ..... !!!!
>;GLOB

INTERNAL %ALLOC