!***************************
!*   sin010                *
!* date: 22.jun.82         *
!* supervisor initialiser  *
!*  supervisor release 10  *
!***************************
%control X'4001'
%recordformat dummy(%integer x)
%constrecord (*) %name null == 0

     %constinteger initial sp disp = k'1530';  ! position in i/o seg of initial
                                        ! sp - new compiler - may change !!!!!!!!!!!!!!!!!

     %constinteger task low limit = 30
     %constinteger task user limit  =  35
     %constinteger task limit = 70
     %constinteger free cells = 80
     %constinteger no of services = 50
     %constinteger frag no = 15
     %constinteger psect length = 52
     %constinteger svc limit = 23
     %constinteger int limit = -50
     %constinteger k seg limit = 110

     %constintegername max core pt  ==  k'40';  ! actual loc'n of ptr

     %constinteger highest priority  =  3

     %constinteger ttid = 30;           ! task lo limit
     %constinteger dkid = 31;           !   "   "    " +1
     %constinteger dirid = 32;          !   "   "    " +2
     %constinteger loadid = 33;         !   "   "    " +2
     %constinteger cli = 34;            !   "   "    " +3
     %constinteger mother = 35;         !   "   "    " +4

     %constintegername ps == k'177776'; ! status word
     %constintegername stack limit == k'177774'

     %recordformat ef(%record (ef) %name link, %integer id, a1)
     %recordformat qf(%record (ef) %name e)
     %recordformat tf(%record (tf) %name link, %integer id, t)

     %recordformat ksegf(%integer use, dadd, par, pdr)
     %recordformat kseglf(%record (kseglf) %name l, %integer b, c, d)

     %recordformat uregsf(%integer r0, r1, r2, r3, r4, r5, pc, %c
                                   ps, sp)
     %recordformat segf(%integer par, pdr, %record (ksegf) %name ksl, %c
       %integer use)
     %recordformat psectf(%record (qf)%name e,%byteinteger id, state,  %c
       %byteintegerarray name(0:3), %c
       %byteinteger prio, %record (qf) poffq, %c
       %record (uregsf) urs, %integer trapv, %c
       %record (segf) %array seg(0:8))
     %recordformat pstf(%record (psectf) %name p)

     %recordformat pf(%byteinteger service, reply, %c
       %integer a1, a2, a3)
     %recordformat p2f(%integer d, a1, a2, a3)
     %recordformat mainpf(%record (mainpf) %name l, %record (p2f) p)

     %recordformat storef(%integer len, block no)
     %recordformat addrfn(%record (addrfn) %name psecta, last32, corea, %c
       %integer core)
     %constrecord (addrfn) %name adds == k'130'

     %recordformat d1f(%integer x)
     %recordformat d2f(%record (qf) %name x)




     %externalrecord (kseglf) %namespec free segl
     %externalrecord (qf) %arrayspec cpuq(0:highest priority)
     !*
     %externalrecord (pstf) %arrayspec psecta(task low limit:task limit)
     %externalrecord (tf) %arrayspec ontmq(task low limit:task limit)

     %externalrecord (mainpf) %arrayspec params(0:free cells)

     %externalrecord (storef) %arrayspec store(0:frag no)

     %externalrecord (kseglf) %arrayspec ksegl(1:k seg limit)

!     %externalrecord (p2f) %arrayspec last thirty2(0:15)

     %externalbyteintegerarrayspec ser map(int limit:no of services)
     %externalroutine initialise
     %routinespec pnt(%integer i)
     %routinespec fill seg(%integer segno, par, pdr)
     !*
     %externalroutinespec push(%record (*) %name q, %record (*) %name e)

     !***********************************************
     !*          supervisor states                  *
     !***********************************************
     %constinteger idle st = -1
     %constinteger task st = 0

     !**********************************************
     !*                task states                 *
     !**********************************************
     %constinteger t wait = 1
     %constinteger t poff = 2
     %constbyteinteger t cpuq = 8
     %constbyteinteger t run = 16
     %constbyteinteger t susp = k'200'



     !************************************************
     !*          static core locations               *
     !************************************************
     %constintegername int value == k'40'
     %constintegername alarm f == k'44'
     %constintegername psect area == k'50'
     %constintegername fault type == k'52'
     %constrecord (pstf) %name last psect  ==  k'54'
     %constintegername extra int info  ==  k'56'

     !*************************************************

     %ownintegerarray preset(0:311)= %c
     0(2),M'TT',M'00',1,0,0(6),K'20012',K'140000',K'120200',0,0(36),
     0(2),M'ID',M'CS',3,0,0(6),K'20012',K'140000',K'120200',0,0(36),
     0(2),M'ID',M'TR',3,0,0(6),K'20012',K'140000',K'120200',0,0(36),
     0(2),M'OL',M'DA',1,0,0(6),K'20010',K'140000',K'120300',0,0(36),
     0(2),M'LC',M' I',1,0,0(6),K'20010',K'140000',K'120200',0,0(36),
     0(2),M'OM',M'HT',3,0,0(6),K'20010',K'140000',K'120200',0,0(36)

     !***************************************************
     %record (psectf) %name psect
     %record  (ksegf) %name ks1
     %externalrecord(qf) %namespec free param

     %constintegername ftrap  ==  4, f flag == k'115210'
     %constintegername fp  ==  k'120000'
     %integer sftp






        %recordformat sf(%integerarray seg(0:7))
        %constrecord (sf) %name k par == k'172340'
        %constrecord (sf) %name k pdr == k'172300'
        %constrecord (sf) %name u par == k'177640'
        %constrecord (sf) %name u pdr == k'177600'

        %constintegername sr0 == k'177572'
        %constintegername sr2 == k'177576'

        %constintegername clock v == k'177546'

        %recordformat dedloc f(%integerarray d(0:4))
        %constrecord (dedlocf) %name dedloc == k'115000'

         %recordformat saveaf(%integerarray a(0:20))

        %integer i, pt, base, top core, id, top, perm, perml, stk, tc, seg7
        %integer kst, stkl, char, ioseg, max core, sperm, sperml
        %recordformat d1f(%integername x)
        %recordformat d2f(%record (qf) %name x)
        %record (d1f) %name d1
        %record (d2f) d2

        max core = max core pt;       ! pick up amount of core
        %cycle i=0, 1, 7
           k par_seg(i)=i<<7;  k pdr_seg(i)=k'77406'
        %repeat
        k par_seg(7)=k'7600';      ! map to hardware vectors

        integer(k'115200') = k'5037'
        integer(k'115202') = k'115210'
        integer(k'115204') = 2;        ! rti

        sr0=1;                       ! get it going
        ps=k'340';                   ! ensue uninterruptable
        clockv=k'100'
        !! stack limit=k'400'


        d1==d2
        kst = 3;                ! leave 2 holes for perm(s)

        alarm f=0
        %for i=task low limit, 1, task limit %cycle
           ontmq(i)_id=i
        %repeat
        id=task low limit
        perm=dedloc_d(8)>>6;   ! pickup addr of perm
        top=dedloc_d(12)>>6
        perml=((top-perm-1)<<8)&k'177400'!2;  ! read only
        sperm = dedloc_d(4)>>6
        sperml = (((dedloc_d(8)>>6)-sperm-1)<<8)&k'177400'!2; ! also read only
        top core=dedloc_d(0);  tc=top core
        %cycle i=k'115500', 2, k'137336'
           integer(i)=0
        %repeat
        psect area=top core
        top core=top core+(task limit-task user limit)*psect length*2
        i = 12;               ! dedicated location of CODE of 1st vm
        %cycle
           %exitif dedloc_d(i)=tc
           d1_x==preset(pt)
           psecta(id)_p==d2_x
           psect==d2_x
           psect_id=id
           pt=pt+psect length
           base=dedloc_d(i)>>6
           stk=dedloc_d(i+1)>>6
           top=dedloc_d(i+4)>>6
            seg7 = dedloc_d(i+2)>>6
           fill seg(2, base, (stk-base-1)<<8!2)
           kst = kst+1;               ! fill in code address
           fill seg(6, stk, (seg7-stk-1)<<8!6)
           kst = kst+1;               ! fill in stack area
           psect_seg(7)_par=k'7600'
           psect_seg(7)_pdr=k'77406'
           ser map(id)=id
           psect_seg(1)_par=perm;  psect_seg(1)_pdr=perml
           psect_seg(1)_ksl==ksegl(1)
           psect_seg(0)_par = sperm; psect_seg(0)_pdr = sperml
           psect_seg(0)_ksl == ksegl(2)
           psect_urs_r1=k'140000';   ! virt add of top of stk
           psect_urs_sp=k'140000'+(seg7-stk)<<6
           %if id >= loadid %or dedloc_d(i+3)#0 %start
               %if dedloc_d(i+3) = 0 %start;    ! old compiler
                  %if id=loadid %then ioseg=k'1400' %and char=x'0a41' %elsec
                     ioseg=k'200' %and char=x'000a'
                  fill seg(7, %c
                     top core>>6, (ioseg-k'100')<<2!6);     ! fill in i/o seg
                  top core=top core+ioseg
                  psect_urs_r2=2;        ! indicate loader to perm
                  integer(stk<<6+k'10')=char;   ! a,nl
                  psect_urs_r0=k'140010'; ! points to above
               %else;                   ! new compiler
                  psect_urs_pc = dedloc_d(i+3)
                  fill seg(7, seg7, (top-seg7-1)<<8!6)
                   psect_urs_r0 = k'160112';  ! point at nl in i/o seg
                  psect_urs_sp = integer(dedloc_d(i+2)+initial sp disp)
               %finish
               kst = kst+1
               psect_urs_r4 = x'0100';     ! and use main tt handler
           %finish
           !! routine schedulr put in line
           psect_state=(psect_state&t susp)!t cpuq
           push(cpuq(psect_prio), psect)
           !! end of roputine schedule
           i=i+4;  id=id+1
        %repeat

       !! the next section determins the top of store

       sftp = ftrap;            ! remember the address error trap addr
       ftrap = k'115200';          ! set it to interrupt to 115200
       f flag = 1; i=k'1000';  ! f flag is address fault flag
       %cycle
          kpar_seg(5) = i
          %if fp # 0 %then pt = 0; ! access it (1 word instr)
          %exit %if f flag = 0;    ! trapped out
          i = i+k'200';           ! next 4k
       %repeat
       max core = i
       adds_core = i
       ftrap = sftp;            ! restore address error trap
       i=top core>>6
        store(0)_block no=i
        store(0)_len=max core-i
        adds_psecta==psecta(task low limit)
!        adds_last32==last thirty2(0)
        adds_corea==store(0)
        params(i)_l==params(i+1) %for i=0, 1, free cells-1
        free param==params(0)
        %cycle i=kst, 1, k seg limit-1
           ksegl(i)=0
           ksegl(i)_l==ksegl(i+1)
        %repeat
        free segl==ksegl(kst)
        ks1==ksegl(1)
        ks1_par=perm;  ks1_pdr=perml
        ks1_use = 100
        ks1 == ksegl(2)
        ks1_par = sperm; ks1_pdr = sperml; ks1_use = 100
        k pdr_seg(i)=0 %for i=5, 1, 6
        pnt(13); pnt(nl)
        pnt('d'); pnt('e'); pnt('i'); pnt('m'); pnt('o'); pnt('s')
        pnt(' '); pnt('v'); pnt('s'); pnt('n'); pnt(' ')
        pnt('1'); pnt('0'); pnt(13); pnt(nl); pnt(nl)



     %routine pnt(%integer i)
        %constintegername tts  ==  k'177564'
        %constintegername ttd  ==  k'177566'
        ttd = i
        %while tts&k'200' = 0 %cycle; %repeat
     %end


     %routine fill seg(%integer seg no, par, pdr)
      %record (segf) %name seg
      %record (ksegf) %name ks

      seg == psect_seg(seg no)
      ks == ksegl(kst)

        seg_par=par;  seg_pdr=pdr; seg_ksl==ks
        ks_use=1
        ks_par=par;  ks_pdr=pdr
        ks_dadd=0
     %end
%end
%endoffile