perm filename UP[IMS,AIL] blob
sn#051747 filedate 1973-07-03 generic text, type T, neo UTF8
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