! FILE 'LOAD7S'
!**************
!* LOAD17S *
!* 22.APR.80 *
!**************
PERMINTEGERFNSPEC SVC(INTEGER EP, INTEGER P1, INTEGER P2)
PERMINTEGERMAPSPEC INTEGER(INTEGER X)
PERMBYTEINTEGERMAPSPEC BYTEINTEGER(INTEGER X)
PERMINTEGERFNSPEC ADDR(INTEGERNAME X)
CONSTINTEGERNAME DUMMY = 0
SYSTEMINTEGERFNSPEC GETID
CONTROL K'100001'; ! TRUSTED
RECORDFORMAT DUMREC(INTEGER X)
CONSTRECORD (DUMREC) NAME NULL = 0
!***********************************
!* *
!* LOADER FAULTS *
!* *
!* 1 - NO CORE *
!* 2 - INIT BLOCK TOO LONG *
!* 3 - INIT BLOCK SHORT *
!* 4 - CHECKSUM WRONG *
!* 5 - OUT OF RANGE *
!* 6 - END OF FILE/ NO FILE *
!* 7 - MAX NO OF TASKS REACHED *
!************************************
BEGIN
CONSTINTEGER DELETE = 5
CONSTINTEGER GET CORE = 6
CONSTINTEGER SCHEDULE = 9
CONSTINTEGER MAP PSECT = 16
CONSTINTEGER TASK LOW LIMIT = 30
! SEE SUPERVISOR FOR UPDATES
OWNINTEGER TASK LIMIT = 48
CONSTINTEGER T POFF = 2
CONSTINTEGER LOAD SER = 5; ! MAIN LOADER SERVICE
RECORDFORMAT UREGSF(INTEGER R0, R1, R2, R3, R4, R5, PC, PS, SP)
RECORDFORMAT SEGF(INTEGER PAR, PDR, DADD, USE)
RECORDFORMAT PSECTF(INTEGER Q, C
BYTEINTEGER ID, STATE, BYTEINTEGERARRAY C
NAME(0:3), BYTEINTEGER PRIO, INTEGER POFFQ, RECORD (UREGSF C
)URS, INTEGER TRAPV, RECORD (SEGF) ARRAY SEG(0:7))
RECORDFORMAT PSTF(RECORD (PSECTF) NAME P)
RECORDFORMAT PF(BYTEINTEGER SERVICE, REPLY, INTEGER A, B, C)
RECORDFORMAT P2F(BYTEINTEGER SERVICE, REPLY, A1, A2, C
B1, B2, C1, C2)
RECORDFORMAT STRDF(INTEGER RDS, NXY, GETB, BYTEINTEGER SER, C
REPLY, UNIT, FSYS, BYTEINTEGERARRAY NAME(0:5), INTEGER BL, C
N, PT, MAX, BYTEINTEGERARRAY BUFF(0:255))
RECORDFORMAT STRD2F(INTEGER RDS, NXY, GETB, BYTEINTEGER SER, C
REPLY, UNIT, STRING (6)NAME)
RECORDFORMAT GLASF(INTEGERARRAY FIXED(1:12), BYTEINTEGER ID, C
CALLID, INTEGERARRAY STRPTS(0:7), INTEGER TOP, BYTEINTEGER C
UNIT, FSYS, INTEGER GLA, INTCHR, SPARE, INTEGERARRAY GROT C
(1:11), BYTEINTEGERARRAY INPUT(0:70))
CONSTRECORD (GLASF) NAME GLAS = K'100000'
! MAPPED TO MY SEG 4
RECORDFORMAT D1F(INTEGER X)
RECORDFORMAT D2F(BYTEINTEGERNAME B)
RECORDFORMAT D3F(INTEGERNAME Z)
RECORDFORMAT D4F(RECORD (PSECTF) NAME PST)
RECORD (PSECTF) NAME NEWPSECT, SPST
RECORD (PF)P
RECORD (P2F) NAME P2
RECORD (SEGF) NAME S
INTEGER ID, I, LEN, BC, J, SEGS, ENTRY, N, NEWID, INPT
INTEGER MAX, MAX2, LOAD ACT, LOAD PT, NCHAR, STK, FAULT, OSEG
INTEGER PT, GLA DISP, OLD, TFLAG, TTFLAG, LTYPE
BYTEINTEGER CHAR, CKSM
OWNINTEGER READ FLAG = 0, UNIT = 0, FSYS = 0, PROG = 1
OWNINTEGER REPLY TO HERE = LOAD SER
CONSTINTEGERNAME INSTRM0 = K'160032'
CONSTRECORD (STRDF) NAME INSTR1 = K'160062'
CONSTBYTEINTEGERNAME TT NO = K'160061'
OWNBYTEINTEGERARRAY STORE(0:70)
CONSTBYTEINTEGERARRAY MODETR(1:6) = 2, 6, 0(2), 2, 6
CONSTBYTEINTEGERARRAY DISC SER(0:4) = 3, 3, 8, 14, 28
INTEGERFNSPEC WORD
ROUTINESPEC RELEASE(INTEGER SEG)
ROUTINESPEC MAP SHARED SEG(INTEGER ID, SEG, SHARED NO)
RECORD (PSECTF) MAPSPEC INSERT
RECORD (PSECTF) MAP SPEC GET PSECT(INTEGER ID)
RECORD (PSECTF) MAP SPEC GET NAME(BYTEINTEGERNAME ST)
INTEGER DUMMY
RECORD (D1F)D1
RECORD (D2F) NAME D2
RECORD (D3F) NAME D3
INTEGERARRAY LSEGM(0:7); ! HOLDS EXTENT OF USER SEG
SWITCH SW(0:7)
INSTRM0 = 0; ! ENSURE IT IS 'NULL'
D2 == D1; D3 == D2; P2 == P
ID = GETID
CYCLE
GLA DISP = 0
P_SERVICE = 0
POFF(P2)
!* VALID SERVICES ARE:-
!* P_SERVICE = LOADID - LOADER REQUEST
IF P2_A1 = 1 START ; ! REQUEST TO LOAD
! P_A = 1 - REQUEST TO LOAD
! P_B = ADDRESS OF LOAD
! P2_C1 = CALL FLAG
!! TFLAG (CALL FLAG)
!! = 0 - NORMAL LOAD
!! = 1 - SHARED LOAD (IF POSSIBLE)
!! = 3 - SHARED LOAD (LOADER OWNES)
!! = 4 - SHARED LOAD - REPLIES WHEN LOADED
!! = K'101010' - SET T BIT
REPLY TO HERE = P_REPLY
TFLAG = P2_C1; FSYS = P2_A2; TT NO = P2_C2
IF TFLAG = 4 THEN TTFLAG = P_REPLY ELSE TTFLAG = 0
SEGS = P_B >> 13
MAP VIRT(P_REPLY, SEGS, 4)
PT = K'100000'!(P_B&K'17777')
INPT = 1
UNTIL I = NL OR INPT > 40 CYCLE
I = BYTEINTEGER(PT); STORE(INPT) = I
PT = PT+1; INPT = INPT+1
REPEAT
NCHAR = INPT-1
RELEASE(0)
FROM OUT: ! ENTRY FOR EXTERNAL CALLS
OSEG = -1
INSTR1_NAME(I) = ' ' FOR I = 0, 1, 5
INPT = 1; OLD = 0; INSTR1_UNIT = 0
IF STORE(1) = '.' START ; ! PR
INSTR1_NXY = 0; ! TYPE = CHAR
INSTR1_FSYS = 0
INPT = 3; INSTR1_SER = 13
-> INP
FINISH
INSTR1_FSYS = 1; ! TYPE = FILE
IF STORE(2) = '.' START ; ! UNIT SPEC
INSTR1_UNIT = STORE(1)-'0'; INPT = 3
FINISH
INSTR1_SER = DISC SER(INSTR1_UNIT)
CYCLE I = 0, 1, 6
CHAR = STORE(INPT); INPT = INPT+1
EXITIF CHAR < '0' OR CHAR > 'Z'
INSTR1_NAME(I) = CHAR
REPEAT
IF CHAR > ' ' START
PRINTSYMBOL('?')
->STEP DOWN
FINISH
INSTR1_FSYS = FSYS
INP: SELECT INPUT(1); ! CONSIDER EFFECTS OF NO FILE?
READSYMBOL(I) UNTIL I < 0 OR I = 1
IF I < 0 START
EOF:
IF INSTR1_FSYS # 0 START
INSTR1_FSYS = 0
CLOSE INPUT; -> INP
FINISH
FAULT = 3
-> STEP DOWN
FINISH
NEWPSECT == INSERT; ! ALLOCATE THE NEW PSECT
IF NEWPSECT == NULL START
FAULT = 7; -> ERROR
FINISH
READSYMBOL(I); ! SKIP THE '0'
!! READ THE FIRST BLOCK ( TASK DESCRIPTOR BLOCK)
BC = WORD-10; ! BYTE COUNT
I = WORD; ! SKIP LOAD ADDRESS
CYCLE I = 0, 1, 3
READSYMBOL(J)
NEWPSECT_NAME(I) = J; ! FILL IN THE NAME
REPEAT
N = ID
IF TFLAG > 0 START
SPST == GET NAME(NEWPSECT_NAME(0))
IF SPST == NULL THEN TFLAG = 0 ELSESTART
N = SPST_ID
NEWPSECT_NAME(3) = NEWPSECT_NAME(3)+1 C
UNTIL GETNAME(NEWPSECT_NAME(0)) == NULL
!! THIS CHANGES THE NAME UNTIL IT IS UNIQUE
FINISH
FINISH
SPST == GET PSECT(N)
STK = WORD; ! PICKUP INITIAL VALUE OF SP
BC = BC-2; ! AND STEP DOWN BC
CYCLE SEGS = 0, 1, 7
LSEGM(SEGS) = 0
IF BC <= 0 THEN FAULT = 3 AND -> ERROR
S == NEWPSECT_SEG(SEGS)
READSYMBOL(ENTRY); BC = BC-1
IF ENTRY > 3 START ; ! NEW FORMAT
READSYMBOL(I); ! THROW AWAY SPARE BYTE
BC = BC-1; ! -3 EVENTUALLY
FINISH
IF ENTRY = 3 THEN PRINTSYMBOL('*') AND OLD = OLD+1
-> SW(ENTRY) UNLESS ENTRY > 7
SW(4): ! NO SEGMENT (NEW FORMAT)
LEN = WORD; ! THROW DUMMY LEN AWAY
BC = BC-2
SW(0): ! NO SEGMENT
S = 0
CONTINUE
SW(6): ! READ/WRITE (NEW FORMAT)
SW(2): ! READ/WRITE
IF GLA DISP = 0 THEN GLA DISP = SEGS << 13
SW(5): ! READ ONLY (NEW FORMAT)
SW(1): ! NORMAL, 1=READ ONLY
IF TFLAG <= 0 OR GLA DISP #0 START
LEN = WORD+K'77'
BC = BC-2
LSEGM(SEGS) = LEN&K'37700'
LEN = LEN >> 6
N = SVC(GET CORE, LEN, SEGS)
FAULT = 1 AND -> ERROR IF N = 0
ELSE
SW(7): ! SHARED SEG (NEW FORMAT)
SW(3): ! SHARED SEG
N = WORD
BC = BC-2
N = SPST_SEG(SEGS)_DADD
MAP SHARED SEG(NEWID, SEGS, N)
FINISH
REPEAT
!! ALL SPACE ALLOCATED
IF BC # 0 THEN FAULT = 2 AND -> ERROR
!! PLACE REST OF INPUT LINE IN VIRTUAL SPACE (SEG 6)
CYCLE SEGS = 1, 1, 7
I = LSEGM(SEGS)
IF I > 0 START
MAP VIRT(NEWID, SEGS, 4)
! TO LOADER SEG 4
CYCLE I = 0, 2, I-2
D1_X = K'100000'!I; D3_Z = 0
REPEAT
RELEASE(0) UNLESS SEGS = 7
FINISH
REPEAT
GLAS_TOP = I; ! LIMIT OF AREA
IF I > K'200' THEN LTYPE = 0 ELSE LTYPE = 2
D1_X = K'100112'; ! IN STREAM IN(0) BUFFER AREA
WHILE INPT <= NCHAR CYCLE
D2_B = STORE(INPT)
INPT = INPT+1; D1_X = D1_X+1
REPEAT
D2_B = NL; ! FOR SAFETY AND NO PARAMS
RELEASE(0)
!! NOW LOAD IT
CYCLE
READSYMBOL(I) UNTIL I = 1; READSYMBOL(I)
CKSM = 1
BC = WORD-6; LOADPT = WORD
IF BC = 0 THENEXIT ; ! START BLOCK
SEGS = LOADPT >> 13; ! GET SEG NO
NEWSG: D1_X = LOADPT&K'17777'!K'100000'
IF TFLAG <= 0 OR LOADPT <= GLA DISP START
!! 'GLA DISP' IS USUALLY NEGATIVE !
MAX2 = K'100000'!LSEGM(SEGS)
IF OSEG # SEGS START ; ! NEW SEGMENT
RELEASE(OSEG); ! RELEASE IF ALLOCATED
MAP VIRT(NEWID, SEGS, 4)
! MAP TO ME K'100000'-K'117776'
OSEG = SEGS
FINISH
WHILE BC > 0 CYCLE
IF D1_X > MAX2 THEN FAULT = 5 AND -> ERROR
READSYMBOL(N)
-> EOF IF N < 0; ! END OF FILE
CKSM = CKSM+N
D2_B = N
D1_X = D1_X+1; BC = BC-1
IF D1_X&K'17777' = 0 START
SEGS = SEGS+1; LOADPT = 0; -> NEWSG
FINISH
REPEAT
READSYMBOL(N); CKSM = CKSM+N
IF CKSM # 0 AND OLD = 0 START
FAULT = 4; -> ERROR
FINISH
ELSE
!* READ ONLY SEG OF SHARED PROG
READSYMBOL(N) AND BC=BC-1 WHILE BC>=0
FINISH
REPEAT
IF TFLAG = K'101010' THEN I = K'140020' ELSE I = K'140000'
NEWPSECT_PRIO = 1; ! ONE IS STD PRIO FOR TASKS
NEWPSECT_URS_PC = K'20010'
NEWPSECT_URS_PS = I
NEWPSECT_URS_SP = STK
NEWPSECT_URS_R1 = GLA DISP
NEWPSECT_URS_R0 = K'160112'
! MAP TO STREAM DEFINITIONS
NEWPSECT_URS_R2 = LTYPE; ! NORMAL LOAD
NEWPSECT_URS_R3 = UNIT!FSYS << 8
NEWPSECT_URS_R4 = REPLY TO HERE!TT NO<<8
NEWPSECT_URS_R5 = GLA DISP
RELEASE(OSEG)
N = SVC(SCHEDULE, NEWID, 0)
-> DO REPLY
FINISH
CONTINUE
ERROR:
RELEASE(OSEG)
N = SVC(DELETE, NEWID, 0)
STEP DOWN:
NEWID = 0; ! PROG STOPPING TO CLI
TTFLAG = REPLY TO HERE; P_C = 1
DO REPLY:
IF TTFLAG # 0 START ; ! REPLY TO CALLER
P_SERVICE = TTFLAG; P_REPLY = 5
P_A = NEWID; P_B = FAULT
PON(P2)
FINISH
CLOSE INPUT
REPEAT
INTEGERFN WORD
INTEGER S, T
READSYMBOL(S); READSYMBOL(T)
CKSM = CKSM+S+T
RESULT = T << 8+(S&X'FF')
END
ROUTINE RELEASE(INTEGER SEG)
IF SEG #- 1 START
MAP VIRT(0, -1, 4); ! ALWAYS RELEASE LOADER SEG 4
FINISH
END
ROUTINE MAP SHARED SEG(INTEGER ID, SEG, SHARED NO)
!! NOTE: CHANGES TO DISPS MADE ON 5:OCT:76 FOR 'IMPS'
*K'016500'; *8; ! MOV ID, R0
*K'016501'; *6; ! MOV SEG, R1
*K'016502'; *4; ! MOV SHARED NO, R3
*K'104016'; ! EMT MAP SHARED (14)
END
RECORD (PSECTF) MAP INSERT
CONSTINTEGER INSERTC = 4; ! SVC INSERT
RECORDFORMAT XF(INTEGER X)
RECORD (XF) NAME X
RECORD (D4F)X2
RECORD (PSECTF) NAME PS
X == X2
X_X = SVC(INSERTC, 3, 3); ! INSERT AND MAP TO LOAD SEG 3
RESULT == NULL IF X_X = 0
PS == X2_PST; ! MAP PSECT TO IT
NEWID = PS_ID
IF TASK LIMIT < NEWID THEN TASK LIMIT = NEWID
PS = 0; ! ZERO THE PSECT
PS_ID = NEWID; ! REPLACE THE ID
RESULT == PS
END
RECORD (PSECTF) MAP GET PSECT(INTEGER ID)
INTEGER N
RECORD (D4F) NAME D4; RECORD (D1F)D1
D4 == D1
N = SVC(MAP PSECT, ID, 5); ! MAP TO MY K'100000'
D1_X = N
RESULT == D4_PST
END
RECORD (PSECTF) MAP GET NAME(BYTEINTEGERNAME ST)
RECORD (PSECTF) NAME PST
INTEGER PT, ID, J, CHAR, MATCH
RECORDFORMAT D5F(BYTEINTEGERARRAYNAME STR)
RECORD (D2F) NAME D2; RECORD (D5F) D5
D2 == D5
D2_B == ST
CYCLE ID = TASK LOW LIMIT, 1, TASK LIMIT
PST == GET PSECT(ID)
UNLESS PST == NULL START
CYCLE J = 0, 1, 3
CHAR = D5_STR(J); MATCH = PST_NAME(J)
EXITIF CHAR <= ' ' >= MATCH
-> NO IF CHAR # MATCH
REPEAT
RESULT == PST UNLESS PST_STATE = 0
FINISH
NO: REPEAT
RESULT == NULL
END
ENDOFPROGRAM