.title dynpri .ident /9.2.01/ .include /SY:[1,2]COMMON.MAC/ .include /SY:[1,2]KERNEL.MAC/ .psect .enabl gbl ; This was, under RSTS/E v7 and 8, a pseudo device driver For ; V9, we will simply map 0-117777 of the exec to get fast ; access to the job data. ; ; This is tested under 9.1 and 9.2; for 9.1 you MUST set the ; symbol R$$9.1 equal to 1 and rebuild the image; if 9.2 you ; MUST set the symbol R$$9.1 to zero and rebuild the image. ; This is due to the executive data structures that moved a ; bit. ; R$$9.1 == 0 ; 9.2-06 V$MAJ$MAX == '9 V$MIN$MAX == '4 ; ; ; It COULD need reassembly and task build for later versions ; of RSTS/E if data structures change. It could even stop ; functioning under a later release of RSTS/E. This warning ; is here because this code maps executive data space. ; ; Building: $ mac dyn ; $ tkb dyn=dyn ; $ run dyn ; DYN>GO ; ; Other commands: SET BURST1 n Run burst for priority -8 ; SET BURST2 n Run burst for priority -16 ; SET BURST3 n Run burst for priority -24 and -32 ; SET SLEEP n Set scan interval ; KILLDET Kills detached jobs with group > 10 ; KILLHIB Same as KILLDET but iif hibernating ; ; The default: SET BURST1 6 ; SET BURST2 5 ; SET BURST3 4 ; SET SLEEP 2 ; ; The KILLxxx code is called once every five minutes ; ; copyright (C) 1981 1982 1986 Brian Nelson ; .sbttl more comments and things ; ; edits: ; ; date ver who why ; ; xx-apr-81 01 bdn initial coding ; 15-mar-82 02 bdn Reduce df$lev to 1 ; Check for odd addresses in case we interupted ; 'ttijob' in the middle of job creation. ; Save jobtbl to reduce conflicts with 'ttijob' ; to nill. ; 03-jun-82 03 bdn Force priv jobs to go down to lowest ; Skip push to -32 if no cputime @ -24 ; ; 31-oct-82 04 bdn allow bubble up to -16 if @ -24 and no cpu ; ; 18-nov-82 05 bdn skip bubble up to -16 if load is too high ; (as i write this, my job count is 59) ; also raise priority if swapped, runnable ; and the job has been at -32 for a long ; time (computed from jobcount) ; ; 26-Feb-86 06 bdn No longer a driver, map the exec. ; 27-Feb-86 BDN Command interface. ; 01-Mar-86 BDN 9.2 Field Test support ; 16-Jun-87 BDN Update support level to 9.4 ; ; ; Brian Nelson ; Computer Services ; University of Toledo ; 2801 West Bancroft ; Toledo, Ohio 43606 ; ; (419) 537-2841 ; (419) 537-2511 ; ; This software is furnished in an as-is condition, with no ; committments of support or updates. This software may NOT ; be sold for profit nor can it be included in any package to ; be sold for profit without the written consent of the ; author. This software may be used only within the above ; conditions of use. The information in contained herein is ; subject to change or revision at any time without notice. .sbttl more info ; Data space APR usage: ; ; 0 Maps image data ; 1-5 Maps executive low core ; 6 Maps Job Control Region (9.2 and later) ; 7 Unused ; ; This image can be linked for I/D support if you CPU supports ; such. It may be the case in the future that this mode is the ; only supported mode. ; ; ; Changing parameters ; ; ; CYCLES is the number of scan periods to wait before ; dropping the priority of a runnable job from -16 to -24. A ; reasonable value is one (1) or two (2). This value is ; tightly linked to the scan interval. ; ; LEVEL is the minimum amount of cpu time (in 1/10 seconds) ; that the job must get before it's priority will be dropped ; from -8 to -16. A resonable value is one (1) or two (2). ; ; SLEEP is the value that is placed in the timeout. Values ; of two or three seconds are reasonable. Anything less than ; that (ie, 1 second) and dynpri may be unable to get enough ; useful information about the jobs on the system to make ; any kind of intelligent priority choices. ; ; The default values are DF$LEV, DF$CYC and DF$SLP. ; ; ; Current Command interface: ; ; DYN>GO ; DYN>START ; DYN>SET SLEEP N ; DYN>SET BURST1 N ; DYN>SET BURST2 N ; DYN>SET BURST3 N ; DYN>KILL .mcall gtsk$s ,qiow$s ,exit$s ,exst$s .iif NDF, CR , CR = 15 .iif NDF, LF , LF = 12 .iif NDF, BELL , BELL = 7 STRING = 0 NUMBER = 1 .save .psect comdat ,rw,d,lcl,rel,con comhea: .blkw 1 comdat: .restore $comlas = comhea ; Generate first link .macro cmddef command,dispat,nargs,type=0 .save ; save current psect context .psect comdat ,rw,d,lcl,rel,con $$ = . ; Save current location .asciz /command/ ; Insert command text .even ; Always do this $com1 = . ; save current pc in 'comdat' .word 0 ; link to next is zero .word $$ ; Insert text address .word dispat ; Insert dispatch routine address .word nargs .word type .even ; must do $compc = . ; save the current pc . = $comlast ; backup to link word from previous .word $com1 ; insert address of new entry . = $compc ; restore correct pc $comlast = $com1 ; lastlink = current_entry .restore ; restore old psect context .endm ; thats it .macro strcat dst,src ; Concatonate two asciz string mov src ,-(sp) ; Stuff source address mov dst ,-(sp) ; Stuff destination jsr pc ,strcat ; Do it .globl strcat ; In case .endm strcat ; All done .macro strcmp s1,s2 ; Compare two asciz strings mov s2 ,-(sp) mov s1 ,-(sp) call strcmp .globl strcmp .endm strcmp .macro strcpy dst,src ; Copy asciz string mov src ,-(sp) mov dst ,-(sp) jsr pc ,strcpy .globl strcpy .endm strcpy .macro moverr e ; Die on error function movb e ,r0 ; If no error, all is well beq .+6 ; call error ; Error, it's fatal .endm moverr ; Thats all. .macro mapjcr job2,dst=r0 ; Insure JCR is currently mapped mov job2 ,-(sp) ; Do it call mapjcr ; Simple mov r0 ,dst ; Return address of it .endm mapjcr ; Done .macro GETEXEC off,base,dst=r0 ; Get a word from executive mapped mov base ,r0 ; data (ie, first 20KW). .if nb, off ; Again, if offset is there, us add off ,r0 ; it else ignore it .endc ; Addressing for executive low add #20000 ,r0 ; memory is biased off of APR1 mov (r0) ,dst ; thus we add 20000 into every .endm GETEXEC ; address. .macro save list ; Register saves, inline code. .if b , ; If no passed arguments then .ift ; recursivly call ourself to save ; generate the instructions. .iff ; Otherwise run through the .irp x, ; argument list. mov x,-(sp) ; .... .endr ; ..... .endc ; .endm save ; Alldone .macro unsave list ; Opposite of SAVE .if b , ; These two macros ARE order .ift ; dependent, ie: unsave ; SAVE .iff ; ..... .irp x, ; UNSAVE mov (sp)+,x ; Generate the code in-line .endr ; .endc ; .endm unsave ; All done .sbttl more macros .macro clrfqb ; Clear the FIRQB out call $clrfq ; Do it .endm clrfqb ; Thats all .macro clrxrb ; Clear the XRB out call $clrxr ; ... .endm clrxrb ; All done .macro putdec v ; Print a number on the terminal mov r0 ,-(sp) ; Save a register mov v ,r0 ; Stuff passed value into it call putdec ; Do the work mov (sp)+ ,r0 ; Pop something .endm putdec ; and all done .macro putoct v ; Save as PUTDEC but in octal mov r0 ,-(sp) ; format. Save a register mov v ,r0 ; Load value call putoct ; Dump and exit mov (sp)+ ,r0 ; Pop the register .endm putoct ; Done .macro getlin s ; Read a line from the terminal mov s ,-(sp) ; Stuff string address call getlin ; Call someone to read the data tst (sp)+ ; Pop arg .endm getlin ; Done .macro putbin s,l ; Dump (in pass-all mode) to .if b ,l ; the terminal. Can be invoked as: .ift ; PUTBIN #STRING clr -(sp) ; or: .iff ; PUTBIN #STRING,LENGTH mov l ,-(sp) ; Passed length, stuff it on stack .endc ; mov s ,-(sp) ; Push string address onto stack call putbin ; Dump it cmp (sp)+ ,(sp)+ ; Pop parameter list .endm putbin ; Done .macro getval s ; Parse a asciz string thats mov s ,r0 ; supposedly a number. GETVAL call getval ; returns 'C' set on error. .endm getval ; Done .sbttl error codes BADDIR =: 1 BADNAM =: 2 INUSE =: 3 NOROOM =: 4 NOSUCH =: 5 NODEVC =: 6 NOTCLS =: 7 NOTAVL =: 10 NOTOPN =: 11 PRVIOL =: 12 EOF =: 13 ABORT =: 14 DATERR =: 15 HNGDEV =: 16 HNGTTY =: 17 FIEXST =: 20 DTOOOF =: 21 BADFUO =: 22 INTLCK =: 23 WRGPAK =: 24 NOTMNT =: 25 PAKLCK =: 26 BADCLU =: 27 PRIVAT =: 30 INTPAK =: 31 BADPAK =: 32 DETKEY =: 33 CTRLCE =: 34 SATTBD =: 35 DEVNFS =: 36 BADCNT =: 37 NOBUFS =: 40 B.4 =: 41 B.10 =: 42 B.250 =: 43 B.STAK =: 44 B.SWAP =: 45 B.PRTY =: 46 MAGSEL =: 47 MAGRLE =: 50 NRRTS =: 51 .sbttl the ddb defined ; Some of this is historical, I am leaving it in place ; so I won't have to change other code here. .psect rwdata ,rw,d,lcl,rel,con .dsect ddidx: .blkb ; driver index ddsts: .blkb ; status and access control byte ddjbno: .blkb ; owner job number times 2 (0 if free) ddunt: .blkb ; device unit number ddtime: .blkw ; time assigned or inited ddcnt: .blkw ; init count and assignment control ddflag: .blkw ; device flags ddlev: .blkw ; cpu time level word ddcyc: .blkw ddslp: .blkw ; time to wait between scans ddbur1: .blkw ; burst for level 1 priority ddbur2: .blkw ; burst for level 2 priority ddbur3: .blkw ; burst for level 3 priority ddpri: .blkw ; save the job's priority state: .blkw elptim: .blkw ; j2cpu-timevector savtim: .blkw ddcycv: .blkw 64. ; cycle count vector for all jobs ddtimv: .blkw 64. ; lsw of total job time for all jobs ddjobt: .blkw 64. ; save old jobtbl here .blkw 1 ; reserved ddend = . ddsize = . - ddidx .psect rwdata ,rw,d,lcl,rel,con ddb: .blkb ddsize+2 myjob2: .word 0 ; My job numbers times two mapsts: .word 0 ; Status word mapid: .word 0 ; Region ID of low memory mapping apr6: .word 0 ; Current apr6 mapping address (in mmu's) MYJCR =: 1030 ; My offset into APR6 mapping MMUJCR =: 1032 ; Fixed location of JCR base in MMU's jcrsiz: .word 0 ; Size of a JCR $$jcr6: .word 0 ; MMU address of first JCR jcmapid:.word 0 ; Region ID of JCR mapping tim.sh: .word 0 ; Timeout value $jobtbl:.word 0 ; Save JOBTBL address here $jbstat:.word 0 ; Save JBSTAT address here $jbwait:.word 0 ; Save JBWAIT address here $jobcnt:.word 0 ; Save JOBCNT address here cmdbuf: .blkb 80. ; Command buffer argptr: .blkw 40. ; Command arg addresses kbiost: .word 0,0,0,0 ; I/O Status block for read QIO's kildet: .word 0 ; If <> then purge jobs kiltmo: .word 0 ; If it's time to kill jobs kilcnt: .word 0 ; Ditto hibreq: .word 0 ; If <>, require killed jobs to be in HB .psect code ,ro,i,lcl,rel,con df$cyc = 1 ; default for minimum cycles df$lev = 1 ; default for minimum cpu time df$slp = 2 ; default for scan sleep time prior1 = -8. ; normal job priority prior2 = -16. ; and then some prior3 = -24. ; even lower still prior4 = -32. ; the pits burst1 = 6. ; default runburst for prior1 burst2 = 5. ; default runburst for prior2 burst3 = 4. ; default runburst for prior3 waitb = 32766. ; mask for jbwait .sbttl get started cmddef START ,cmdgo ,0 ; Trivial cmddef GO ,cmdgo ,0 ; Ditto... cmddef KILLDET ,cmdkil ,0 ; For deleting jobs cmddef KILLHIB ,cmdhib ,0 ; Delete iif HIBERNATING cmddef SET ,cmdset ,2,STRING ; Setting parameters cmddef BURST1 ,cmdbu1 ,1,NUMBER ; Run burst setting cmddef BURST2 ,cmdbu2 ,1,NUMBER ; .... cmddef BURST3 ,cmdbu3 ,1,NUMBER ; .... cmddef SLEEP ,cmdsle ,1,NUMBER ; Sleep time start:: call checkversion ; Make sure we can run call init ; Init the world 10$: call getcmd ; Get a command tst r0 ; Success? beq 10$ ; No jsr pc ,@r0 ; Yes, do the command now br 10$ ; And get another .enabl lsb cmdgo:: putbin #200$ ; Detach CLRFQB ; Insure cleared out movb #UU.DET ,FIRQB+FQFUN ; Do it .UUO ; ... mov #5*60. ,r1 ; intervals for waiting to kill clr r0 ; Setup for divide div tim.sh ,r0 ; Get interval count mov r0 ,kiltmo ; Save it mov r0 ,kilcnt ; Init counter 10$: mov tim.sh ,XRB+0 ; Sleep .SLEEP ; Nap time call tmo$sh ; Go do some work call kill ; Perhaps delete jobs br 10$ ; Some more .save .psect rwdata ,d 200$: .asciz /Detaching/<15><12><15><12> .even .restore .dsabl lsb .sbttl More commands cmdkil: mov sp ,kildet ; For deleting detached jobs return ; Exit cmdhib: mov sp ,kildet mov sp ,hibreq return .enabl lsb cmdset: sub #120 ,sp ; Allocate a buffer mov sp ,r4 ; And a pointer for it clrb @r4 ; Null string mov #argptr ,r5 ; Argument pointers 10$: strcat r4 ,(r5)+ ; Move first arg into CMDBUF tst (r5) ; Move next arg address back beq 20$ ; And concat the next arg strcat r4 ,#200$ ; Stuff a space in there br 10$ ; Next please 20$: strcpy #cmdbuf ,r4 ; Copy back into command buffer call prsbuf ; Find the command tst r0 ; Success? beq 90$ ; No cmp 10(r1) ,#STRING ; Should we look for a value beq 30$ ; No getval argptr ; Yes, do it please bcs 90$ ; Oops 30$: mov 4(r1) ,r1 ; Go do the command jsr pc ,@r1 ; Call it br 100$ ; Exit 90$: putbin #210$ ; Error br 100$ ; Exit now 100$: add #120 ,sp ; Pop buffer and exit return .save .psect rwdata ,d 200$: .asciz / / 210$: .asciz /Bad SET command or bad number/<15><12> .even .restore .dsabl lsb .enabl lsb cmdbu1: mov #ddbur1 ,r1 br setpar cmdbu2: mov #ddbur2 ,r1 br setpar cmdbu3: mov #ddbur3 ,r1 br setpar cmdsle: mov #ddslp ,r1 br setpar setpar: getval argptr bcs 90$ mov r0 ,ddb(r1) putbin #210$ putdec ddb(r1) putbin #220$ br 100$ 90$: putbin #200$ 100$: return .save .psect rwdata ,d 200$: .asciz /Bad number/<15><12> 210$: .asciz /Parameter set to / 220$: .byte 15,12,0 .even .restore .dsabl lsb .sbttl getcmd .enabl lsb getcmd: putbin #200$ ; A prompt mov #cmdbuf ,r5 ; Point to a buffer getlin r5 ; Read something tst r0 ; Anything? beq 120$ ; No, the read failed prsbuf: mov #argptr ,r4 ; Arg pointers mov #cmdbuf ,r5 ; Point to a buffer clr (r4) ; Init the field clr r2 ; Arg count clr r3 ; Flag tstb @r5 ; Read ok, read anything? beq 110$ ; No 10$: tstb (r5) ; End of the line yet? beq 50$ ; Yes, exit please mov r3 ,(r4) ; Stuff new address for args? beq 15$ ; No tst (r4)+ ; Yes, and point to NEXT field clr (r4) ; Insure NEXT is NULL clr r3 ; No longer need new address inc r2 ; Count args 15$: cmpb (r5) ,#'A!40 ; Convert case? blo 20$ ; No cmpb (r5) ,#'Z!40 ; Well? bhi 20$ ; No bicb #40 ,(r5) ; Yep, make it upper case 20$: cmpb (r5) ,#40 ; A space in command line? bne 30$ ; No mov r5 ,r3 ; Get set to insert next addr clrb (r3)+ ; Yes, turn it into a NULL 30$: inc r5 ; Point to NEXT character br 10$ ; Get next character 50$: call findcm ; Get command matched up tst r0 ; Success bne 100$ ; Yes, exit putbin #210$ ; Nothing, error message time br 110$ ; Exit 100$: cmp r2 ,6(r1) ; Enough command line args? bge 105$ ; Yes putbin #220$ ; No, error time. clr r0 ; Failure 105$: return ; Bye 110$: clr r0 ; No data, return failure return 120$: exst$s #EX$SUC .save .psect rwdata ,d 200$: .asciz /DYN>/ 210$: .asciz /Unknown command/<15><12> 220$: .asciz /Insufficient arguments/<15><12> .even .restore .dsabl lsb findcm: mov r2 ,-(sp) ; Save this mov comhea ,r2 ; Get listhead for commands 10$: strcmp 2(r2) ,#cmdbuf ; Find the command? tst r0 ; Well? beq 100$ ; Yes, exit with address in R0 mov (r2) ,r2 ; No, get next command in the list bne 10$ ; Something was there clr r0 ; Failure br 110$ ; Exit 100$: mov 4(r2) ,r0 ; Success, return dispatch addr mov r2 ,r1 ; Return block address also 110$: mov (sp)+ ,r2 ; Pop it return ; Exit .sbttl Check version(s) out .enabl lsb checkv::CLRFQB ; Insure FIRQB zapped movb #ERRFQ ,FIRQB+FQFUN ; Get error text for system ID CALFIP ; Simple mov #FIRQB+4,r1 ; A pointer to the returned text clrb FIRQB+37 ; Insure it's asciz 10$: tstb (r1) ; End of the string? beq 100$ ; Yes, ignore checks (fubarred txt) cmpb (r1)+ ,#'. ; A DOT found bne 10$ ; No cmpb -2(r1) ,#'8 ; Version 8 (???) bne 20$ ; No putbin #200$ ; A message br 90$ ; Exit 20$: cmpb -2(r1) ,#'9 ; Currently major release 9 ? bne 100$ ; No (******!!!!!!!!) cmpb (r1) ,#V$MIN$MAX ; Is this past the current field test? blos 30$ ; No putbin #210$ ; Yes, issue a WARNING message!! br 100$ ; Exit 30$: cmpb (r1) ,#'1 ; 9.1 (or even 9.0) today? bhi 40$ ; No tstb #R$$9.1 ; Yes, assembled for 9.1 ? beq 80$ ; No, must be sys 9.1 and DYN 9.2 br 100$ ; Exec 9.1 and DYN 9.1 40$: cmpb (r1) ,#'2 ; What about 9.2 ? bne 100$ ; No, ignore tst #R$$9.1 ; 9.2, Assembled for 9.2 ? bne 80$ ; No, EXEC 9.2 and DYN 9.1 br 100$ ; Exit ; 80$: putbin #220$ ; Exit 90$: EXST$S #EX$SEV ; Die 100$: return .save .psect rwdata ,d 200$: .asciz /I can not run under version 8/ 210$: .ascii /Warning ......./ .ascii /This version of DYN has not been tested under this/ .asciz / version of RSTS/ 220$: .ascii /Fatal error..../ .ascii /DYN assembly flags do not match EXECUTIVE version number/ .byte CR,LF,0 .even .restore .dsabl lsb .sbttl init code init: mov #^R... ,FIRQB+FQNAM1 ; Change our name mov #^RDYN ,FIRQB+FQNAM1+2 ; to ...dyn .NAME ; Trivial mov #ddb ,r1 ; /05/May as well leave the code alone mov #ddcyc ,r2 ; first, clear out accumulated mov #ddend ,r3 ; cycle count and total jobtime add r1 ,r2 ; point to the cycles vector add r1 ,r3 ; point to the end of the DDB 10$: clr (r2)+ ; clear a word from ddb cmp r2 ,r3 ; reach the end of it all ? blo 10$ ; no mov r1 ,r2 ; stuff the ddb address in add #ddlev ,r2 ; point to the area mov #df$lev ,(r2)+ ; set default cputime minimum mov #df$cyc ,(r2)+ ; set default cycle count. mov #df$slp ,(r2)+ ; default sleep mov #burst1 ,(r2)+ ; burst for level 1 mov #burst2 ,(r2)+ ; burst for level 2 mov #burst3 ,(r2)+ ; burst for level 3 mov #df$slp ,tim.sh ; enable once a second timeouts movb #UU.TB1 ,FIRQB+FQFUN ; Get some needed base address .UUO ; .... movb FIRQB+2 ,myjob2 ; Save my job number also mov FIRQB+14,$jobtbl ; Save base address of JOBTBL mov FIRQB+16,$jbstat ; Save base address of JBSTAT mov FIRQB+20,$jbwait ; Save base address of JBWAIT movb #UU.TB2 ,FIRQB+FQFUN ; More needed addresses .UUO ; ... mov FIRQB+16,$jobcnt ; Save base address of JOBCNT CLRFQB ; Clear FIRQB out please movb #CRAFQ ,FIRQB+4 ; Create address window movb #1 ,FIRQB+7 ; Use APR 1 mov #40*24 ,FIRQB+12 ; Map 20 KW please .PLAS ; Do it moverr FIRQB ; If failure then DIE movb FIRQB+6 ,mapid ; Save ID for the window CLRFQB ; Clear the firqb out please movb #MAPFQ ,FIRQB+4 ; Map the exec data structures movb mapid ,FIRQB+6 ; Window ID mov #-4 ,FIRQB+14 ; Flag a map of physical memory mov #40*24 ,FIRQB+20 ; 20 KW to map, starting at 0 .PLAS ; and readonly access moverr FIRQB ; If failure then DIE .IF EQ ,R$$9.1 ; If 9.2, we have to map the JCR .IFT CLRFQB ; Create address window for APR6, movb #CRAFQ ,FIRQB+4 ; which will be user to map JCR's movb #6 ,FIRQB+7 ; Use APR 6 mov #40*4 ,FIRQB+12 ; Map 4 KW please .PLAS ; Do it moverr FIRQB ; If failure then DIE movb FIRQB+6 ,jcmapid ; Save ID for the window moverr FIRQB ; If failure then DIE GETEXEC base=#MYJCR,dst=r1 ; Get my JCR APR6 mapping sub #140000 ,r1 ; Compute JCRSIZ now clr r0 ; ... div myjob2 ,r0 ; Done mov r0 ,jcrsiz ; Save JCR size please GETEXEC base=#MMUJCR,dst=$$jcr6 ; Save base address (in MMU's) for JCR .ENDC ; for 9.2 support 100$: return .sbttl MAP a JCR entry ; Passed: 2(sp) job number times 2 ; Return: R0 Address, already biased for APR6 mapping ; ; Code for determining offsets taken from GETJCR using DOB ; Double check this code for new releases of RSTS/E ; ; I'm not real sure, but I think that the value @1032 will ; not always be the same as $$JCR6, as the value @1030 can ; not exceed 147200, thus I will refetch the JCR MMU base ; address (in MMUs) after possibly recomputing the offset. ; Will try to confirm from disassembly or (if lucky) DEC. mapjcr::save ; Save registers mov $$jcr6 ,r2 ; Get MMU address of JCR region mov 2+4(sp) ,r1 ; Get job number times 2 mul jcrsiz ,r1 ; Compute offset 10$: cmp r1 ,#17200 ; See if it fits in 4KW mapping blo 20$ ; It does add #172 ,r2 ; No, so move up a bit sub #17200 ,r1 ; The '17200' is from GETJCR br 10$ ; Check again please 20$: cmp r2 ,apr6 ; Is this mapping current? beq 100$ ; Yes, no need to remap then. CLRFQB ; Clear the firqb out please movb #MAPFQ ,FIRQB+4 ; Map the exec data structures movb jcmapid ,FIRQB+6 ; Window ID mov #-4 ,FIRQB+14 ; Flag a map of physical memory mov r2 ,FIRQB+16 ; MMU address to map into mov #40*4 ,FIRQB+20 ; 4KW window .PLAS ; and readonly access moverr FIRQB ; If failure then DIE mov r2 ,apr6 ; Save mapping context 100$: mov r1 ,r0 ; Return JCR address in R0 add #140000 ,r0 ; Done unsave ; Pop registers mov (sp)+ ,(sp) ; Move return address up and exit return ; And exit now .assume ddcyc eq .assume ddslp eq .assume ddbur1 eq .assume ddbur2 eq .assume ddbur3 eq .sbttl kill nonpriv detached jobs ; I know that we should base this on some job priv but ; this program must never exceed 4KW. Also, we are still ; using the old [1,*] convention. .iif ndf, MAXGRO ,MAXGRO = 10 kill:: tst kildet ; Delete things? beq 100$ ; No dec kilcnt ; Time to scan? bne 100$ ; No mov kiltmo ,kilcnt ; Yes, reset clr r5 ; Job number 10$: inc r5 ; Next job please CLRFQB ; Insure cleared out movb #UU.SYS ,FIRQB+FQFUN ; Get some job data movb r5 ,FIRQB+4 ; Insert JOB number .UUO ; Get the job data movb FIRQB ,r1 ; Success? bne 20$ ; No, ignore it bitb #200 ,FIRQB+5 ; Detached? beq 20$ ; No cmpb FIRQB+27,#MAXGRO ; Allowed to be detached? blos 20$ ; Yes, ignore ; tst hibreq ; Require job to be hibernating? beq 15$ ; No CLRFQB ; Insure cleared out movb #UU.SYS ,FIRQB+FQFUN ; Get some job data movb r5 ,FIRQB+4 ; Insert JOB number incb FIRQB+5 ; Subfuction 1 .UUO ; Get the job data movb FIRQB ,r1 ; Success? bne 20$ ; No, ignore it tst FIRQB+14 ; Is JBWAIT entry zero? bne 20$ ; No, not hibernating then ; 15$: CLRFQB ; Trash the firqb please movb #UU.CHU ,FIRQB+FQFUN ; Kill a job call movb r5 ,FIRQB+4 ; Job number to delete movb #377 ,FIRQB+35 ; Flag kill call .UUO ; Do it 20$: cmpb r1 ,#BADFUO ; Time to leave? bne 10$ ; No 100$: return ; Exit .sbttl timeouts ; tmo$sh ; ; r0 = unit number times 2 (always 0) ; r1 > ddb/fcb rot = 180. ; patchable, 'rot' cycle count tmo$sh::mov #ddb ,r1 ; Point to r/w data mov ddslp(r1),tim.sh ; reset the timeout please mov r0 ,-(sp) ; save a few registers mov r2 ,-(sp) ; mov r3 ,-(sp) ; mov r4 ,-(sp) mov r5 ,-(sp) ; clr r5 ; r5 is the current job number 10$: add #2 ,r5 ; next job please cmpb r5 ,myjob2 ; Don't fix myself up please beq 10$ ; Ignore GETEXEC base=$jobtbl,off=r5,dst=r2 beq 10$ ; no job of this number active cmp r2 ,#-1 ; is this the end of jobtbl ? beq 20$ ; yes, so exit back to RSTS mov r1 ,r3 ; check to see if this job is the add r5 ,r3 ; same as one as last time to avoid cmp ddjobt(r3),r2 ; potential confict with 'ttijob' bne 15$ ; job creation in ttdvr. skip if ne mov r2 ,-(sp) ; call dyn ; no, check this job out please mov (sp)+ ,r2 ; 15$: mov r1 ,r3 ; save the jobs jdb address for the add r5 ,r3 ; next time thru mov r2 ,ddjobt(r3) ; save jdb address br 10$ ; next job please 20$: mov (sp)+ ,r5 ; pop the registers now please mov (sp)+ ,r4 ; mov (sp)+ ,r3 ; mov (sp)+ ,r2 ; mov (sp)+ ,r0 ; return ; for now .sbttl check out the current job (r2 > jdb) ; register usage ; ; r1 > ddb/fcb ; r2 > jdb+20000 ; r3 > jdb2 ; r4 > ddb + jobnumbertimes2 ; r5 = job number*2 dyn: add #20000 ,r2 ; Correct for APR1 biasing bit #JFNOPR ,JDFLG(r2) ; Job not logged in ? bne 100$ ; no, could have been 'ttijob' mov r1 ,r4 ; point to the timvec offset by add r5 ,r4 ; the job number times two. .IF NE ,R$$9.1 ; If 9.0 or 9.1, the JBD2 is .IFT ; in low core, else map the jcr mov JDJDB2(r2),r3 ; address of job's JDB2 block add #20000 ,r3 ; Correction for APR1 basing bit #1 ,r3 ; avoid crash if 'ttijob' was bne 100$ ; interupted in the middle. mov J2CPU(r3),r0 ; compute elasped cpu time. .IFF ; This must be 9.2 MAPJCR job2=r5 ; So thus map the user's JCR bit #1 ,r0 ; Insure valid please bne 100$ ; Not valid, then exit asap mov JCCPU(r0),r0 ; Fetch the cpu time. .ENDC ; mov r0 ,SAVTIM(r1) ; Save it please sub DDTIMV(r4),r0 ; subtract off time last used. mov r0 ,ELPTIM(r1) ; save elapsed cpu time now. .IF NE ,R$$9.1 ; Old RSTS/E today? .IFT ; Yes, priority is in the JDB clr r0 ; r3 now has pointer to jdb2 bisb JDPRI(r2),r0 ; the job's current priority .IFF ; No, we must map the JCR instead mov r1 ,-(sp) ; Save this MAPJCR job2=r5,dst=r1 ; Map this jobs JCR please clr r0 ; r3 now has pointer to jdb2 bisb JCPRI(r1),r0 ; And extract priority now mov (sp)+ ,r1 ; Pop r1 .ENDC ; cmp r0 ,#128. ; would like this as a signed blt 10$ ; integer please sub #256. ,r0 ; make it into -128....128 10$: mov r0 ,DDPRI(r1) ; we may need this later bge 100$ ; > -8 priority, so do nothing cmp r0 ,#PRIOR4 ; at the lowest priority we blt 100$ ; are looking at today ? bit #4 ,r0 ; job has special run priority? bne 100$ ; yep bit #JFCC!JF2CC!JFSPCL,JDFLG(r2) ; a special condition exist beq 20$ ; no jmp d.rst ; yes, restore job to -08 prior 20$: clr -(sp) ; next figure out if stalled GETEXEC base=$jbstat,off=r5,dst=-(sp) ; mov JBSTAT(job*2),-(sp) GETEXEC base=$jbwait,off=r5,dst=-(sp) ; mov jbwait(job*2),-(sp) bit (sp)+ ,(sp)+ ; Is the job stalled for something? bne 30$ ; Yes com (sp) ; No, so lag as being runnable 30$: GETEXEC base=$jbwait,off=r5 ; It's stalled, but why is it? bit #WAITB ,r0 ; .... bne 40$ ; Stalled for non disk waits. clr (sp) ; Flag as being stalled 40$: mov (sp)+ ,STATE(r1) ; save the 'job stalled' flag br d.chek ; ok, set new priority up please 100$: return .sbttl actually do the changes now. ; r1 > ddb / fcb ; r2 > jdb ; r3 > jdb2 d.chek: inc DDCYCV(r4) ; at last mov DDPRI(r1),r0 ; get the current job priority sub #PRIOR4 ,r0 ; change -32...-8 to 0..24 ash #-3 ,r0 ; /8 to 0...3 dec r0 ; to -1...2 dec r0 ; to -2...1 bgt d.hip ; job is at the highest prior tst STATE(r1) ; at a lower priority, is the bne d.rst ; stalled (but not for FIP) tst r0 ; again, 0 if priority eq -16 beq d.midp ; blt d.lowp ; again, lt 0 if prior lt -16 d.hip: clr DDCYCV(r4) ; clear out job's cycle count tst STATE(r1) ; is the job stalled ? bne skipjb ; yes, skip this one then. cmp ELPTIM(r1),DDLEV(r1) ; did they get the minimum time ble skipjb ; no, skip the job then mov #PRIOR2 ,-(sp) ; yes, drop the job's priority mov DDBUR2(r1),r0 ; and set the new run burst br d.chan ; do it then d.midp: cmp DDCYCV(r4),DDCYC(r1) ; lower priority, have we made ble skipjb ; a reasonable (?) # of passes? mov #PRIOR3 ,-(sp) ; perhaps, so drop the priority mov DDBUR3(r1),r0 ; some more and set run burst. br d.chan ; and change it ! d.lowp: cmp #PRIOR4 ,DDPRI(r1) ; for very long cpu bound jobs. beq 20$ ; priority is currently -32 ? mov #PRIOR4 ,-(sp) ; -24. assume move down to -32 tst ELPTIM(r1) ; any cpu time accumuated here? bne 10$ ; yes, allow drop to -32 then mov #PRIOR2 ,@sp ; no, move up to -16 for a while 10$: clr r0 ; no change for the run burst. br d.chan ; and change it 20$: tst ELPTIM(r1) ; no cpu time increment yet ? bne skipjb ; yes, do not bubble up 1 level. mov DDPRI(r1),-(sp) ; no, so set new prior eq old GETEXEC base=$jobcnt ; Get current jobcount swab r0 ; Get count into low byte bic #^C377 ,r0 ; Drop the garbage asl r0 ; how long to wait before we drop asl r0 ; the cpu time checking of a job asl r0 ; at priority -32 cmp DDCYCV(r4),r0 ; ok, how long at lowest prior? blos 30$ ; ok so far .IF NE ,R$$9.1 ; If 9.1, swap location is in JDB .IFT ; otherwise its in JOB CONTROL REGION tstb JDSWAP(r2) ; been below -8 for a while, are we .IFF ; Must be 9.2 or later MAPJCR job2=r5 ; Map the JCR please tstb JCSWAP(r0) ; And see if they are swapped out. .ENDC ; for 9.1 vs 9.2 beq 40$ ; swapped. if so, avoid sched bug. 30$: add #8. ,(sp) ; priority plus 8 40$: clr r0 ; no change in run burst though. br d.chan ; and do it d.rst: mov #PRIOR1 ,-(sp) ; restore priority to sys def. mov DDBUR1(r1),r0 ; same for the job's run burst. clr DDCYCV(r4) ; and clear out cycle count. d.chan: bic #^C3 ,DDPRI(r1) ; mask off exec's priority bits bisb DDPRI(r1),(sp) ; and stuff those bits in. CLRFQB ; Clear the FIRQB out please mov #FIRQB+FQFUN,r2 ; Setup to change the job settings movb #UU.PRI ,(r2)+ ; Stuff the subfunction code movb r5 ,(r2) ; Job number times 2 asrb (r2)+ ; But we don't want job*2 here incb (r2)+ ; We want to change the priority movb (sp)+ ,(r2)+ ; The new priority setup movb r0 ,1(r2) ; New run burst beq 10$ ; Don't change it incb (r2) ; Flag we want to change it 10$: .UUO ; At last .br skipjb skipjb: mov SAVTIM(r1),DDTIMV(r4) ; save the current cpu time return ; at last .sbttl odds and ends $clrxr::save ; Clear the XRB out mov #xrb ,r0 ; Point to it 10$: clr (r0)+ ; Clear a word cmp r0 ,#xrb+14 ; See if done blos 10$ ; Not yet, try again unsave ; Pop registers return ; and exit $clrfq::save mov #FIRQB ,r0 10$: clr (r0)+ cmp r0 ,#FIRQB+36 blos 10$ unsave return putoct: save mov #$cbomg ,r3 br pcom putdec: save mov #$cbdmg ,r3 pcom: save sub #20 ,sp mov r0 ,r1 mov sp ,r0 clr r2 jsr pc ,@r3 mov r0 ,r1 mov sp ,r0 sub r0 ,r1 qiow$s #io.wal,#5,,,,, add #20 ,sp unsave return putbin: save mov 2+4(sp) ,r0 mov 4+4(sp) ,r1 bne 20$ mov r0 ,r1 10$: tstb (r1)+ bne 10$ sub r0 ,r1 dec r1 20$: qiow$s #io.wal,#5,,,,, ; rsx and p/os unsave return .enabl lsb error: putbin #200$ ; VERY crude error reporting putdec r0 putbin #210$ exst$s #EX$SEV .save .psect rwdata ,d 200$: .asciz /Exec directive returned error / 210$: .byte cr,lf,0 .even .restore .dsabl lsb .enabl lsb getlin: mov 2(sp) ,r0 ; Read a command line QIOW$S #io.rvb,#5,,,#kbiost,, cmpb kbiost ,#IS.SUC bne 100$ add kbiost+2,r0 clrb (r0) mov #1 ,r0 br 110$ 100$: movb #32 ,(r0)+ clrb (r0) clr r0 110$: putbin #200$ return .save .psect rwdata ,d 200$: .byte 12,0 .restore .dsabl lsb .sbttl strcat and strcpy ; input: ; 0(sp) return address ; 2(sp) dst address ; 4(sp) src address ; output: r0 dest address strcpy::save ; save temp registers please mov 2+2(sp) ,r0 ; destination address mov 2+4(sp) ,r1 ; source .asciz address 10$: movb (r1)+ ,(r0)+ ; copy until a null bne 10$ ; not done mov 2+2(sp) ,r0 ; return the dst address unsave ; pop r1 and exit mov (sp) ,4(sp) ; move return address up now cmp (sp)+ ,(sp)+ ; pop junk and exit return strcat::save ; save temp registers please mov 2+2(sp) ,r0 ; destination address mov 2+4(sp) ,r1 ; source .asciz address 5$: tstb (r0)+ ; look for the end of the dst string bne 5$ ; not found yet dec r0 ; found it, fix the pointer 10$: movb (r1)+ ,(r0)+ ; copy until a null bne 10$ ; not done mov 2+2(sp) ,r0 ; return the dst address unsave ; pop r1 and exit mov (sp) ,4(sp) ; move return address up now cmp (sp)+ ,(sp)+ ; pop junk and exit return strcmp::mov 2(sp) ,r0 ; Pick up 'a' mov 4(sp) ,r1 ; And 'b' 10$: cmpb (r0)+ ,(r1) ; Are they the same bne 20$ ; No tstb (r1)+ ; At the end of the string bne 10$ ; No clr r0 ; Equal return br 100$ 20$: blo 30$ ; Br if ab return br 100$ 30$: mov #-1 ,r0 ; A ; Save temps clr r1 ; Init accum 5$: cmpb @r0 ,#40 ; Eat leading spaces bne 10$ ; No inc r0 ; Next br 5$ ; ... 10$: clr -(sp) ; Positive cmpb @r0 ,#'- ; Leading minus sign? bne 20$ ; No com (sp) ; Yes, flag inc r0 ; Next char now 20$: tstb @r0 ; End of it all ? beq 100$ ; Yes, exit cmpb @r0 ,#'0 ; In range ? blo 90$ ; No, thats an error cmpb @r0 ,#'9 ; Keep looking bhi 90$ ; Error again mul #12 ,r1 ; Ok, shift over old number bvs 90$ ; Overflowed movb (r0)+ ,r2 ; Get number sub #'0 ,r2 ; Convert add r2 ,r1 ; And add the digit in bcc 20$ ; Ok, get another digit 90$: tst (sp)+ ; Pop sign indicator sec ; Error exit br 120$ ; Exit 100$: mov r1 ,r0 ; Success, return result tst (sp)+ ; Negative?? beq 110$ ; No neg r0 ; Make < 0 110$: clc ; Clear for success 120$: unsave ; Pop registers and exit return ; Bye crlfou: putbin #crlf ; Simple carriage return/line feed return ; Dumper .save ; Save current psect context .psect rwdata ,d ; Switch to data space psect crlf: .byte 15,12,0 ; Data .even ; Nice to use word boundaries .restore ; Pop back to code psect .end start