! FILE 'LOAD7S'
!**************
!* LOAD17S  *
!* 14.JUN.82  *
!**************

PERMINTEGERFNSPEC  SVC(INTEGER  EP, INTEGER  P1, INTEGER  P2)
PERMINTEGERMAPSPEC  INTEGER(INTEGER  X)
PERMBYTEINTEGERMAPSPEC  BYTEINTEGER(INTEGER  X)
PERMINTEGERFNSPEC  ADDR(INTEGERNAME  X)
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   *
!*  8 -  REQUESTED SHARED SEG DOES NOT EXIST
!************************************


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  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:8))

     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  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  MAX2, LOAD PT, NCHAR, STK, OSEG
      INTEGER  PT, GLA DISP, OLD, TFLAG, TTFLAG, LTYPE, KILL
     BYTEINTEGER  CHAR, CKSM
     OWNINTEGER  UNIT = 0, FSYS = 0, NPC, FAULT = 0
     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  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)

           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 

           KILL = 0

           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
                  IF  SEGS = 0 START ; ! SPECIAL TO LOAD SHARED SEG
                     KILL = 1;         !KILL THE LOADING PROGRAM
                     MAP VIRT(NEWID, 0, 0); ! HOLD THE SEGMENT
                  FINISH 
                 -> READ ONLY IF  ENTRY = 5
              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)
READ ONLY:
                S == NEW PSECT_SEG(SEGS)
                S_PDR = S_PDR&(¬4); ! DELETE WRITE BIT
               IF  S_PDR = 0 THEN  FAULT = 8 AND  -> ERROR
              FINISH 
           REPEAT 

           !! ALL SPACE ALLOCATED
            IF  BC = 2 START ;        ! FOR NON-DEFAULT PC
               NPC = WORD
            ELSE 
               NPC = K'020010';      ! DEFAULT PC
               IF  BC # 0 THEN  FAULT = 2 AND  -> ERROR
            FINISH 
            SKIPSYMBOL;         ! SKIP THE CHECKSUM OF 1ST BLOCK

           !! 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
                 BC = 0;     ! FOR PARITY, FORCES A MOV TO STORE IN CLEAR
                 CYCLE  I = 0, 2, I-2
                    D1_X = K'100000'!I;  D3_Z = BC
                 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>>1 >= GLADISP>>1 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  KILL # 0 THEN  -> ERROR;  ! SHARED LIB PROG
           IF  TFLAG = K'101010' THEN  I = K'140020' ELSE  I = K'140000'
           NEWPSECT_PRIO = 1;          ! ONE IS STD PRIO FOR TASKS
           NEWPSECT_URS_PC = NPC
           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)
        ->CLSE IF  KILL # 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 
CLSE:
      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 
     RECORD  (PSECTF) MAP  GET PSECT(INTEGER  ID)
                 -> NO IF  CHAR # MATCH